diff --git a/README.md b/README.md deleted file mode 100644 index 3d9864f809cfa6e8e01a20dc90f564a976d2b0bb..0000000000000000000000000000000000000000 --- a/README.md +++ /dev/null @@ -1,8 +0,0 @@ -# Newstar -## The Netherlands East West Synthesis Telescope Array Reduction - -Newstar is the software package to reduce data from the WSRT, the Westerbork Synthese Radio Telescope. - -The WSRT is operated by the Netherlands Foundation for Research in Astronomy (the NFRA), now ASTRON. - -Newstar was mainly written by Wim Brouw. Newstar is not being actively developed anymore. diff --git a/docker/Dockerfile b/docker/Dockerfile deleted file mode 100644 index 2d42c148fc02f90637bc07338e77335331adc7e2..0000000000000000000000000000000000000000 --- a/docker/Dockerfile +++ /dev/null @@ -1,38 +0,0 @@ -# Install the base image through https://github.com/ds82/ubuntu-hardy-8.04-i386-docker -# We use an old ubuntu because g77 is not supported in newer ubuntu's -FROM ubuntu:8.04 - -# Install dependencies -RUN apt-get update && apt-get install -y build-essential git tcsh g77 wget vim libx11-dev libncursesw5-dev sudo - -RUN useradd -ms /bin/tcsh newstar && echo "newstar:newstar" | chpasswd && adduser newstar sudo -RUN echo '%sudo ALL=(ALL) NOPASSWD:ALL' >> /etc/sudoers - -USER newstar - -# Obtain source code -WORKDIR /home/newstar -# Doesn't work anymore due to certificate issues (old wget uses an old protocol that github doesn't accept anymore) -#RUN wget --no-check-certificate -q https://github.com/tammojan/Newstar/archive/master.tar.gz -ADD master.tar.gz /home/newstar -RUN sudo chown -R newstar:newstar Newstar-master && mv Newstar-master/* . && rmdir Newstar-master - -# Set required environment variables for newstar, this replaces the logic in $n_root/src/sys -ENV n_site=docker \ - n_install=li \ - n_hosts=docker-newstar \ - n_ftp=ftp.astron.nl \ - n_root=/home/newstar \ - n_hlp=/home/newstar/hlp - -# Initialize paths etc at tcsh login -RUN echo 'source $n_root/src/sys/newstar_env.csh \nsource $n_root/src/sys/newstar_init.csh' >> /home/newstar/.cshrc - -# Build newstar -WORKDIR /home/newstar/src -RUN tcsh -c 'nup build -u wntinc' -RUN tcsh -c 'nup build -u -t:exe wntinc' -RUN tcsh -c 'nup build -u all' - -WORKDIR /home/newstar -ENTRYPOINT tcsh diff --git a/docker/Dockerfile-doc b/docker/Dockerfile-doc deleted file mode 100644 index b90ada87d0ec55a9a083a4cbedc66f1a08b12f4d..0000000000000000000000000000000000000000 --- a/docker/Dockerfile-doc +++ /dev/null @@ -1,10 +0,0 @@ -FROM newstar - -# The following is only necessary for generating the documentation -USER root -RUN apt-get update && apt-get install -y imagemagick texlive-full -USER newstar -# Documentation: convert xbm into png since modern webbrowsers don't understand xbm -RUN cd $n_hlp && find . -name '*.xbm' -exec sh -c 'convert $0 ${0%.xbm}.png' {} \; -RUN cd $n_hlp && find . -name '*.html' -exec sed -i -e 's/\.xbm/.png/g' {} \; - diff --git a/hlp/agb.gif b/hlp/agb.gif deleted file mode 100644 index 050b197580dadc2959cf26e63dad6ce6841c836c..0000000000000000000000000000000000000000 Binary files a/hlp/agb.gif and /dev/null differ diff --git a/hlp/alpha_32_64.ps b/hlp/alpha_32_64.ps deleted file mode 100644 index 2bf5744eecaf88be5ece89196abdd21ed55b86ff..0000000000000000000000000000000000000000 --- a/hlp/alpha_32_64.ps +++ /dev/null @@ -1,1403 +0,0 @@ -%!PS-Adobe-2.1 -%%Creator: DECwrite T2.0-IFT -%%+Copyright (c) 1990 DIGITAL EQUIPMENT CORPORATION. -%%+All Rights Reserved. -%%DocumentFonts: (atend) -%%EndComments -%%BeginProcSet DEC_WRITE 1.07 -/DEC_WRITE_dict 150 dict def DEC_WRITE_dict begin/$D save def/$I 0 def/$S 0 -def/$C matrix def/$R matrix def/$L matrix def/$E matrix def/pat1{/px exch -def/pa 8 array def 0 1 7{/py exch def/pw 4 string def 0 1 3{pw exch px py 1 -getinterval putinterval}for pa py pw put}for}def/pat2{/pi exch def/cflag -exch def save cflag 1 eq{eoclip}{clip}ifelse newpath{clippath -pathbbox}stopped not{/ph exch def/pw exch def/py exch def/px exch def/px px -3072 div floor 3072 mul def/py py 3072 div floor 3072 mul def px py -translate/pw pw px sub 3072 div floor 1 add cvi def/ph ph py sub 3072 div -floor 1 add cvi def pw 3072 mul ph 3072 mul scale/pw pw 32 mul def/ph ph 32 -mul def/px 0 def/py 0 def pw ph pi[pw 0 0 ph 0 0]{pa py get/px px 32 add -def px pw ge{/px 0 def/py py 1 add 8 mod def}if}pi type/booleantype -eq{imagemask}{image}ifelse}if restore}def/PS{/_op exch def/_np 8 string def -0 1 7{/_ii exch def/num _op _ii get def _np 7 _ii sub num -4 bitshift PX -num 15 and 4 bitshift -4 bitshift PX 4 bitshift or put}for _np}def/PX{[15 7 -11 3 13 5 9 1 14 6 10 2 12 4 8 0]exch get}def/FR{0.7200 0 $E defaultmatrix -dtransform/yres exch def/xres exch def xres dup mul yres dup mul add -sqrt}def/SU{/_sf exch def/_sa exch def/_cs exch def/_mm $C currentmatrix -def/rm _sa $R rotate def/sm _cs dup $L scale def sm rm _mm _mm concatmatrix -_mm concatmatrix pop 1 0 _mm dtransform/y1 exch def/x1 exch def/_vl x1 dup -mul y1 dup mul add sqrt def/_fq FR _vl div def/_na y1 x1 atan def _mm 2 get -_mm 1 get mul _mm 0 get _mm 3 get mul sub 0 gt{{neg}/_sf load -concatprocs/_sf exch def}if _fq _na/_sf load setscreen}def/BO{/_yb exch -def/_xb exch def/_bv _bs _yb _bw mul _xb 8 idiv add get def/_mk 1 7 _xb 8 -mod sub bitshift def _bv _mk and 0 ne $I 1 eq xor}def/BF{DEC_WRITE_dict -begin/_yy exch def/_xx exch def/_xi _xx 1 add 2 div _bp mul cvi def/_yi _yy -1 add 2 div _bp mul cvi def _xi _yi BO{/_nb _nb 1 add def 1}{/_fb _fb 1 add -def 0}ifelse end}def/setpattern{/_cz exch def/_bw exch def/_bp exch def/_bs -exch PS def/_nb 0 def/_fb 0 def _cz 0/BF load SU{}settransfer _fb _fb _nb -add div setgray/$S 1 def}def/invertpattern{$S 0 eq{{1 exch -sub}currenttransfer concatprocs settransfer}if}def/invertscreen{/$I 1 -def/$S 0 def}def/revertscreen{/$I 0 def}def/setrect{/$h exch def/$w exch -def/$y exch def/$x exch def newpath $x $y moveto $w $x add $y lineto $w $x -add $h $y add lineto $x $h $y add lineto closepath}def/concatprocs{/_p2 -exch cvlit def/_p1 exch cvlit def/_pn _p1 length _p2 length add array def -_pn 0 _p1 putinterval _pn _p1 length _p2 putinterval _pn -cvx}def/OF/findfont load def/findfont{dup DEC_WRITE_dict exch -known{DEC_WRITE_dict exch get}if DEC_WRITE_dict/OF get exec}def -mark/ISOLatin1Encoding -8#000 1 8#001{StandardEncoding exch get}for /emdash/endash -8#004 1 8#025{StandardEncoding exch get}for /quotedblleft/quotedblright -8#030 1 8#054{StandardEncoding exch get}for /minus 8#056 1 8#217 -{StandardEncoding exch get}for/dotlessi 8#301 1 8#317{StandardEncoding -exch get}for/space/exclamdown/cent/sterling/currency/yen/brokenbar/section -/dieresis/copyright/ordfeminine/guillemotleft/logicalnot/hyphen/registered -/macron/degree/plusminus/twosuperior/threesuperior/acute/mu/paragraph -/periodcentered/cedilla/onesuperior/ordmasculine/guillemotright/onequarter -/onehalf/threequarters/questiondown/Agrave/Aacute/Acircumflex/Atilde -/Adieresis/Aring/AE/Ccedilla/Egrave/Eacute/Ecircumflex/Edieresis/Igrave -/Iacute/Icircumflex/Idieresis/Eth/Ntilde/Ograve/Oacute/Ocircumflex/Otilde -/Odieresis/multiply/Oslash/Ugrave/Uacute/Ucircumflex/Udieresis/Yacute/Thorn -/germandbls/agrave/aacute/acircumflex/atilde/adieresis/aring/ae/ccedilla -/egrave/eacute/ecircumflex/edieresis/igrave/iacute/icircumflex/idieresis -/eth/ntilde/ograve/oacute/ocircumflex/otilde/odieresis/divide/oslash/ugrave -/uacute/ucircumflex/udieresis/yacute/thorn/ydieresis -256 array astore def cleartomark -/encodefont{findfont dup maxlength dict begin{1 index/FID ne{def}{pop -pop}ifelse}forall/Encoding exch def dup/FontName exch def currentdict -definefont end}def/loads{/$/ISOLatin1Encoding load def/&/encodefont load -def/*/invertpattern load def/+/revertscreen load def/-/invertscreen load -def/:/concatprocs load def/^/setpattern load def/~/pat1 load def/_/pat2 -load def/@/setrect load def/A/arcn load def/B/ashow load def/C/curveto load -def/D/def load def/E/eofill load def/F/findfont load def/G/setgray load -def/H/closepath load def/I/clip load def/J/fill load def/K/kshow load -def/L/lineto load def/M/moveto load def/N/newpath load def/O/rotate load -def/P/pop load def/R/grestore load def/S/gsave load def/T/translate load -def/U/sub load def/V/div load def/W/widthshow load def/X/exch load -def/Y/awidthshow load def/a/save load def/c/setlinecap load def/d/setdash -load def/e/restore load def/f/setfont load def/g/initclip load def/h/show -load def/i/setmiterlimit load def/j/setlinejoin load def/k/stroke load -def/l/rlineto load def/m/rmoveto load def/n/currentfont load -def/o/scalefont load def/p/currentpoint load def/q/setrgbcolor load -def/r/currenttransfer load def/s/scale load def/t/setmatrix load -def/u/settransfer load def/w/setlinewidth load def/x/matrix load -def/y/currentmatrix load def}def -end -%%EndProcSet -%%EndProlog -%%BeginSetup -DEC_WRITE_dict begin -loads -version cvi 23.0 gt { -currentdict {dup type /arraytype eq -{bind def} {pop pop} ifelse} forall} if -0.0100 0.0100 s - -%%EndSetup -%%Page: 1 1 -/$P a D -g N -0 79200 T -S -S -N -7500 -73600 M -53700 -73600 L -S -100 w -0 c -0 j -2 i -0.00 G k -R -R - -R -S -7200 -7200 T -N -0 G -8193 -2100 M -/Helvetica-Bold-ISOLatin1 $ -/Helvetica-Bold & P -/Helvetica-Bold-ISOLatin1 F 2400 o f -(32/64 Bit Portability Issues) h -23400 -5850 M -20387 -11150 M -/Times-Roman-ISOLatin1 $ -/Times-Roman & P -/Times-Roman-ISOLatin1 F 1400 o f -(Ray Lanza) h -15718 -16600 M -n 0.857 o f -(Advanced OSF Software Group) h -21266 -22600 M -(11/19/91) h -3900 -28749 M -/Times-Italic-ISOLatin1 $ -/Times-Italic & P -/Times-Italic-ISOLatin1 F 1399 o f -281.1 0 32 (64\255bit architectures provide extended capabilities such as support) W -3900 -30348 M -231.7 0 32 (for larger address spaces and scalar arithmetic ranges. These en\255) W -3900 -31947 M -281.0 0 32 (hanced capabilities introduce a number of compatibility problems) W -3900 -33546 M -41.1 0 32 (that must be addressed while porting software. Many of the compati\255) W -3900 -35145 M -97.7 0 32 (bility problems can be avoided through careful design and attention) W -3900 -36744 M -(to datatypes.) h -n 0.858 o f -( ) h --7200 7200 T -R - -showpage -$P e - -%%Page: 2 2 -/$P a D -g N -0 79200 T -S -S -7200 -74700 T -N -0 G -22511 -1050 M -/Helvetica-ISOLatin1 $ -/Helvetica & P -/Helvetica-ISOLatin1 F 1000 o f -(\255 ) h -(2) h -( \255) h -300 -2485 M --7200 74700 T -R - -S -N -7500 -73600 M -53700 -73600 L -S -100 w -0 c -0 j -2 i -0.00 G k -R -R - -R -S -7200 -7200 T -N -0 G -3900 -1200 M -300 -3800 M -/Helvetica-BoldOblique-ISOLatin1 $ -/Helvetica-BoldOblique & P -/Helvetica-BoldOblique-ISOLatin1 F 1200 o f -(Overview) h -300 -5400 M -300 -7400 M -/Times-Roman-ISOLatin1 $ -/Times-Roman & P -/Times-Roman-ISOLatin1 F 1200 o f -19.8 0 32 (There is a set of issues involved in porting applications from ULTRIX to OSF1. Another set of) W -300 -8800 M -110.4 0 32 (issues exist in porting applications from a 32\255bit OSF system to a 64\255bit OSF system. These) W -300 -10200 M -17.9 0 32 (are two disjoint sets of issues. This paper deals with the later. Porting ULTRIX applications to) W -300 -11600 M -(OSF is documented in the HERCULES Porting Guide.) h -300 -13600 M -223.1 0 32 (64\255bit architectures provide wider registers to hold larger scalar datatypes and memory ad\255) W -300 -15000 M -69.8 0 32 (dresses. They also provide arithmetic and logical instructions to operate on these registers. It's) W -300 -16400 M -64.4 0 32 (these capabilities that differentiate 64 bit systems from 32\255bit systems. Unfortunately these ca\255) W -300 -17800 M -(pabilities also introduce portability issues. ) h -300 -19800 M -13.6 0 32 (Most applications are written in one or more high level languages. A discussion of portability is) W -300 -21200 M -107.1 0 32 (only practical in the context of one of these languages, as applications written in assembly or) W -300 -22600 M -80.5 0 32 (macro assembly need complete rewrites or translations. For the purpose of this paper the lan\255) W -300 -24000 M -(guage of interest is C but variations of the problems occur with other languages. ) h -300 -26000 M -74.4 0 32 (Much of the information in this paper is a direct result of work done on a port of ULTRIX\25532) W -300 -27400 M -11.3 0 32 (V4.0 to a 64\255bit architecture. The port was done as a research/advanced development effort. In) W -300 -28800 M -143.9 0 32 (addition to the operating system, approximately 280 user level commands and utilities were) W -300 -30200 M -14.2 0 32 (ported. While this represents a considerable body of code, it's not clear if this is truly represen\255) W -300 -31600 M -(tative of user applications.) h -300 -33600 M -(During the port we learned a number of things:) h -300 -35600 M -/Symbol F 1200 o f -(\267) h -2100 -35600 M -/Times-Roman-ISOLatin1 F 1200 o f -(Most well written programs compile and run without change) h -300 -37600 M -/Symbol F 1200 o f -(\267) h -2100 -37600 M -/Times-Roman-ISOLatin1 F 1200 o f -95.1 0 32 (Most 32/64 bit portability problems can be avoided through the use of good programming) W -2100 -39000 M -(practices) h -300 -41000 M -/Symbol F 1200 o f -(\267) h -2100 -41000 M -/Times-Roman-ISOLatin1 F 1200 o f -233.7 0 32 (Most 32/64 bit portability problems are a direct result of changing one or more of the) W -2100 -42400 M -(datatypes) h -300 -44400 M -/Symbol F 1200 o f -(\267) h -2100 -44400 M -/Times-Roman-ISOLatin1 F 1200 o f -(Programs living in a pure 64\255bit environment can ignore most data size issues) h -300 -46400 M -/Symbol F 1200 o f -(\267) h -2100 -46400 M -/Times-Roman-ISOLatin1 F 1200 o f -120.6 0 32 (Programs producing/consuming data from 32\255bit programs may need design and develop\255) W -2100 -47800 M -(ment effort to solve problems) h -300 -49800 M -300 -51800 M -/Helvetica-BoldOblique-ISOLatin1 F 1200 o f -(Datatype Definitions) h -300 -53400 M -300 -55000 M -/Times-Roman-ISOLatin1 F 1200 o f -29.0 0 32 (A 64\255bit system provides support for greater addressibility and larger ranges for scalar arithme\255) W -300 -56400 M -25.9 0 32 (tic operations. Providing this functionality for user applications involves changing one or more) W -300 -57800 M -203.5 0 32 (of the scalar datatypes. Unfortunately these changes result in interoperability problems be\255) W -300 -59200 M -(tween 32/64 bit systems and are the main cause of portability problems. ) h -300 -61200 M -(The primary consideration for the choices outlined in the following table is in fact portability. ) h -300 -62600 M --7200 7200 T -R - -showpage -$P e - -%%Page: 3 3 -/$P a D -g N -0 79200 T -S -S -7200 -74700 T -N -0 G -22511 -1050 M -/Helvetica-ISOLatin1 $ -/Helvetica & P -/Helvetica-ISOLatin1 F 1000 o f -(\255 ) h -(3) h -( \255) h -300 -2485 M --7200 74700 T -R - -S -N -7500 -73600 M -53700 -73600 L -S -100 w -0 c -0 j -2 i -0.00 G k -R -R - -R -S -7200 -7200 T -N -0 G -300 -1200 M -/Times-Roman-ISOLatin1 $ -/Times-Roman & P -/Times-Roman-ISOLatin1 F 1200 o f -83.6 0 32 (With these definitions it is possible to define data structures that do not change size from sys\255) W -300 -2600 M -(tem to system.) h -300 -4600 M -300 -24140 M -S -0 18440 m -p T -0 -18440 27080 18440 @ I N -N -S -150 -150 T -N -0 G -600 -1500 M -/Times-Roman-ISOLatin1 F 1200 o f -(Data Type) h --150 150 T -R - -S -7259 -150 T -N -0 G -1378 -1500 M -/Times-Roman-ISOLatin1 F 1200 o f -(32 Bit System) h --7259 150 T -R - -S -16917 -150 T -N -0 G -1605 -1500 M -/Times-Roman-ISOLatin1 F 1200 o f -(64 Bit System) h --16917 150 T -R - -S -150 -2650 T -N -0 G -600 -1500 M -/Times-Roman-ISOLatin1 F 1200 o f -(char) h -6360 -1500 M -600 -2936 M --150 2650 T -R - -S -7259 -2650 T -N -0 G -4479 -1500 M -/Times-Roman-ISOLatin1 F 1200 o f -(8) h -600 -2936 M --7259 2650 T -R - -S -16917 -2650 T -N -0 G -4706 -1500 M -/Times-Roman-ISOLatin1 F 1200 o f -(8) h -600 -2936 M --16917 2650 T -R - -S -150 -5890 T -N -0 G -600 -1500 M -/Times-Roman-ISOLatin1 F 1200 o f -(short) h --150 5890 T -R - -S -7259 -5890 T -N -0 G -4179 -1500 M -/Times-Roman-ISOLatin1 F 1200 o f -(16) h --7259 5890 T -R - -S -16917 -5890 T -N -0 G -4406 -1500 M -/Times-Roman-ISOLatin1 F 1200 o f -(16) h --16917 5890 T -R - -S -150 -8390 T -N -0 G -600 -1500 M -/Times-Roman-ISOLatin1 F 1200 o f -(int) h --150 8390 T -R - -S -7259 -8390 T -N -0 G -4179 -1500 M -/Times-Roman-ISOLatin1 F 1200 o f -(32) h --7259 8390 T -R - -S -16917 -8390 T -N -0 G -4406 -1500 M -/Times-Roman-ISOLatin1 F 1200 o f -(32) h --16917 8390 T -R - -S -150 -10890 T -N -0 G -600 -1500 M -/Times-Roman-ISOLatin1 F 1200 o f -(long) h --150 10890 T -R - -S -7259 -10890 T -N -0 G -4179 -1500 M -/Times-Roman-ISOLatin1 F 1200 o f -(32) h --7259 10890 T -R - -S -16917 -10890 T -N -0 G -4406 -1500 M -/Times-Roman-ISOLatin1 F 1200 o f -(64) h --16917 10890 T -R - -S -150 -13390 T -N -0 G -600 -1500 M -/Times-Roman-ISOLatin1 F 1200 o f -(long long) h --150 13390 T -R - -S -7259 -13390 T -N -0 G -4179 -1500 M -/Times-Roman-ISOLatin1 F 1200 o f -(64) h --7259 13390 T -R - -S -16917 -13390 T -N -0 G -4406 -1500 M -/Times-Roman-ISOLatin1 F 1200 o f -(64) h --16917 13390 T -R - -S -150 -15890 T -N -0 G -600 -1500 M -/Times-Roman-ISOLatin1 F 1200 o f -(pointer) h --150 15890 T -R - -S -7259 -15890 T -N -0 G -4179 -1500 M -/Times-Roman-ISOLatin1 F 1200 o f -(32) h --7259 15890 T -R - -S -16917 -15890 T -N -0 G -4406 -1500 M -/Times-Roman-ISOLatin1 F 1200 o f -(64) h --16917 15890 T -R - -S -N -7209 0 M -7209 -18640 L -S -100 w -0 c -0 j -2 i -0.00 G k -R -R - -S -N -16867 0 M -16867 -18640 L -S -100 w -0 c -0 j -2 i -0.00 G k -R -R - -S -N -0 -2600 M -27380 -2600 L -S -100 w -0 c -0 j -2 i -0.00 G k -R -R - -S -N -0 -5840 M -27380 -5840 L -S -100 w -0 c -0 j -2 i -0.00 G k -R -R - -S -N -0 -8340 M -27380 -8340 L -S -100 w -0 c -0 j -2 i -0.00 G k -R -R - -S -N -0 -10840 M -27380 -10840 L -S -100 w -0 c -0 j -2 i -0.00 G k -R -R - -S -N -0 -13340 M -27380 -13340 L -S -100 w -0 c -0 j -2 i -0.00 G k -R -R - -S -N -0 -15840 M -27380 -15840 L -S -100 w -0 c -0 j -2 i -0.00 G k -R -R - -S -75.0 -18365.0 26930.0 18290.0 @ -S -150 w -0 c -0 j -0.00 G k -R -R -R -27080 0 m -300 -26190 M -/Times-Roman-ISOLatin1 F 1200 o f -91.3 0 32 (As you can see from the table `long' and `pointer' change from 32 to 64 bits. These changes) W -300 -27590 M -157.7 0 32 (provide the applications developer with support for all of the supported scalar types and ex\255) W -300 -28990 M -(pands addressing beyond the limits imposed by today's 32\255bit systems.) h -300 -30990 M -48.3 0 32 (The `long long' datatype will be supported in future versions of the 32 and 64\255bit C compilers. ) W -300 -32390 M -296.6 0 32 (It provides the ability to read and write 64 bit scalar data and may provide a degree of) W -300 -33790 M -(interoperability for new programs being developed.) h -300 -35790 M -300 -37790 M -/Helvetica-BoldOblique-ISOLatin1 $ -/Helvetica-BoldOblique & P -/Helvetica-BoldOblique-ISOLatin1 F 1200 o f -(Types of problems ) h -300 -39390 M -300 -41390 M -/Times-Roman-ISOLatin1 F 1200 o f -(There are five basic problems or issues that need to be addressed:) h -300 -43390 M -/Symbol F 1200 o f -(\267) h -2100 -43390 M -/Times-Roman-ISOLatin1 F 1200 o f -(Objects change size) h -300 -45390 M -/Symbol F 1200 o f -(\267) h -2100 -45390 M -/Times-Roman-ISOLatin1 F 1200 o f -(Sizeof\( * \) != Sizeof\( int \)) h -300 -47390 M -/Symbol F 1200 o f -(\267) h -2100 -47390 M -/Times-Roman-ISOLatin1 F 1200 o f -(32 <=> 64 bit interoperability) h -300 -49390 M -/Symbol F 1200 o f -(\267) h -2100 -49390 M -/Times-Roman-ISOLatin1 F 1200 o f -(Atomicity) h -300 -51390 M -/Symbol F 1200 o f -(\267) h -2100 -51390 M -/Times-Roman-ISOLatin1 F 1200 o f -(Read/Write ordering) h -300 -53390 M -300 -55390 M -/Helvetica-BoldOblique-ISOLatin1 F 1200 o f -(Objects Change Size) h -300 -56990 M -300 -58590 M -/Times-Roman-ISOLatin1 F 1200 o f -51.4 0 32 (Data objects that include pointers or longs change size. The following is an example of a sim\255) W -300 -59990 M -(plistic linked list data structure.) h -300 -61990 M --7200 7200 T -R - -showpage -$P e - -%%Page: 4 4 -/$P a D -g N -0 79200 T -S -S -7200 -74700 T -N -0 G -22511 -1050 M -/Helvetica-ISOLatin1 $ -/Helvetica & P -/Helvetica-ISOLatin1 F 1000 o f -(\255 ) h -(4) h -( \255) h -300 -2485 M --7200 74700 T -R - -S -N -7500 -73600 M -53700 -73600 L -S -100 w -0 c -0 j -2 i -0.00 G k -R -R - -R -S -7200 -7200 T -N -0 G -300 -1200 M -300 -3200 M -/Times-Roman-ISOLatin1 $ -/Times-Roman & P -/Times-Roman-ISOLatin1 F 1200 o f -(struct foo {) h -300 -5200 M -6060 -5200 M -(struct foo *next, *prev;) h -300 -7200 M -6060 -7200 M -(int mode;) h -300 -9200 M -6060 -9200 M -(char *name;) h -300 -11200 M -(}; ) h -300 -13200 M -300 -15200 M -62.9 0 32 (On a 32\255bit system this structure occupies 16 bytes of memory. On a 64\255bit system this struc\255) W -300 -16600 M -48.6 0 32 (ture will be 32 bytes long. 12 bytes of the growth are a result of the three pointers doubling in) W -300 -18000 M -(length. The other 4 bytes are a result of alignment padding. ) h -n 0.666 o f -0.0 538.0 m -(1) h -0 -538.0 m -300 -20000 M -n 1.502 o f -81.2 0 32 (The fact that this data structure changed size may not be a problem. If the program runs on a) W -300 -21400 M -4.8 0 32 (64\255bit system and the data it produces and consumes remains on 64\255bit systems, no harm occurs) W -300 -22800 M -40.1 0 32 (except for a potential size problem. The problem exists in environments where the 64\255bit pro\255) W -300 -24200 M -33.8 0 32 (gram must consume data produced by a 32\255bit program or it produces data that is consumed by) W -300 -25600 M -(a 32\255bit program.) h -300 -27600 M -79.6 0 32 (The key to defining compatible data structures is to avoid the use of long and pointer declara\255) W -300 -29000 M -78.1 0 32 (tions. This may seem like a difficult task but in fact it's relatively easy. Declarations of long) W -300 -30400 M -0.9 0 32 (can be replaced by int to preserve sizes. In serious database\255oriented applications pointers rarely) W -300 -31800 M -17.4 0 32 (appear in declarations that are written to mass storage devices. These applications are normally) W -300 -33200 M -(concerned about storage efficiency and already avoid pointers.) h -300 -35200 M -152.9 0 32 (In the case where a 64\255bit program must deal with 32\255bit data structures containing pointers) W -300 -36600 M -2.4 0 32 (more work is required. One approach is to define a new data structure that encapsulates the old) W -300 -38000 M -5.1 0 32 (structure while preserving the alignments, and then being careful to perform I/O to and from the) W -300 -39400 M -74.3 0 32 (encapsulated structure. This technique assumes that data written out in pointer fields is irrele\255) W -300 -40800 M -14.9 0 32 (vant and will be filled in when the structure is memory resident. These problems are not limited) W -300 -42200 M -(to files on disk, they can happen with all forms of mass storage including tape. ) h -300 -44200 M -300 -46200 M -/Helvetica-BoldOblique-ISOLatin1 $ -/Helvetica-BoldOblique & P -/Helvetica-BoldOblique-ISOLatin1 F 1200 o f -(Sizeof\( * \) != Sizeof\( int \)) h -300 -47800 M -300 -49800 M -/Times-Roman-ISOLatin1 F 1200 o f -(Of all of the problems anticipated as a result of the datatypes chosen this was the one that con\255) h -300 -51200 M -(cerned most people. The example below results in truncation of the value stored in `buffer') h -300 -52600 M -(inspite of the casts used. There were very few of these problems in the port of ULTRIX\25532 to) h -300 -54000 M -(the 64\255bit architecture. Most instances were in virtual memory related kernel code or the) h -300 -55400 M -(bourne shell, `/bin/sh'.) h -300 -57000 M --7200 7200 T -R - -S -7200 -70200 T -N -0 G -300 -1200 M -/Times-Roman-ISOLatin1 F 1000 o f -0.0 448.0 m -(1) h -0 -448.0 m -900 -1200 M -(OSF and ULTRIX compilers align data on `natural boundaries') h --7200 70200 T -R - -showpage -$P e - -%%Page: 5 5 -/$P a D -g N -0 79200 T -S -S -7200 -74700 T -N -0 G -22511 -1050 M -/Helvetica-ISOLatin1 $ -/Helvetica & P -/Helvetica-ISOLatin1 F 1000 o f -(\255 ) h -(5) h -( \255) h -300 -2485 M --7200 74700 T -R - -S -N -7500 -73600 M -53700 -73600 L -S -100 w -0 c -0 j -2 i -0.00 G k -R -R - -R -S -7200 -7200 T -N -0 G -300 -1200 M -300 -2800 M -/Times-Roman-ISOLatin1 $ -/Times-Roman & P -/Times-Roman-ISOLatin1 F 1200 o f -(int foo;) h -300 -4800 M -(char *buffer;) h -300 -6800 M -6060 -6800 M -(buffer = \(char *\)malloc\(128\);) h -300 -8800 M -6060 -8800 M -(foo = \( int \)buffer;) h -300 -10800 M -6060 -10800 M -(buffer = \(char *\)foo;) h -300 -12800 M -300 -14800 M -300 -16800 M -6.3 0 32 (The 64\255bit version of the product will contain an enhanced version of lint that will issue a warn\255) W -300 -18200 M -(ing when an assignment of this type is attempted.) h -300 -20200 M -85.1 0 32 (Another form of this problem is encountered with aliased data structures. We have seen code) W -300 -21600 M -(that defines multiple structures for the same object instead of using unions.) h -300 -23600 M -300 -25600 M -(struct foo {) h -6060 -25600 M -11820 -25600 M -17580 -25600 M -23340 -25600 M -(struct bar {) h -300 -27600 M -6060 -27600 M -(int src_addr, dst_addr;) h -17580 -27600 M -23340 -27600 M -29100 -27600 M -(struct bar *next, *prev;) h -300 -29600 M -6060 -29600 M -(char *name;) h -17580 -29600 M -23340 -29600 M -29100 -29600 M -(char *name;) h -300 -31600 M -(};) h -6060 -31600 M -11820 -31600 M -17580 -31600 M -23340 -31600 M -(};) h -300 -33600 M -300 -35600 M -0.3 0 32 (This is similar to a problem found in the `ip' portion of the network code. The source and desti\255) W -300 -37000 M -83.7 0 32 (nation internet address are stored as 32 bit integers. As the data is passed up through the net\255) W -300 -38400 M -53.9 0 32 (work layers the fields containing the network addresses are reused as linked list pointers. This) W -300 -39800 M -132.0 0 32 (works well on a system where a pointer is the same size as an int. It doesn't work with the) W -300 -41200 M -(datatype choices made for 64\255bit systems.) h -300 -43200 M -70.7 0 32 (Problems of this type are difficult to find and correct. In the `ip' case lower layers of the sys\255) W -300 -44600 M -69.3 0 32 (tem used the `foo' declaration and upper layers used the `bar' declaration. Running lint on all) W -300 -46000 M -62.8 0 32 (the modules in a program or using ANSI C function prototypes will detect a miss\255match in ar\255) W -300 -47400 M -(guments. Unfortunately an appropriate cast may hide this condition.) h -300 -49400 M -71.5 0 32 (Another form of this problem occurs with function arguments. If you pass a 32\255bit constant or) W -300 -50800 M -135.6 0 32 (an `int' to a function which expects a `long' or a pointer the object is likely to be truncated. ) W -300 -52200 M -(Again using ANSI C function prototypes or `lint' on older programs will solve this problem.) h -300 -54200 M -15.9 0 32 (The final form of this problem involves default types. Constants defined without the `L' suffix,) W -300 -55600 M -34.1 0 32 (variables declared as `unsigned' without a type and function arguments declared without a type) W -300 -57000 M -105.7 0 32 (all default to `int'. In many cases this may be correct however if you attempt to use these to) W -300 -58400 M -(hold a value longer than 32 bits you may observe truncation.) h -300 -60400 M --7200 7200 T -R - -showpage -$P e - -%%Page: 6 6 -/$P a D -g N -0 79200 T -S -S -7200 -74700 T -N -0 G -22511 -1050 M -/Helvetica-ISOLatin1 $ -/Helvetica & P -/Helvetica-ISOLatin1 F 1000 o f -(\255 ) h -(6) h -( \255) h -300 -2485 M --7200 74700 T -R - -S -N -7500 -73600 M -53700 -73600 L -S -100 w -0 c -0 j -2 i -0.00 G k -R -R - -R -S -7200 -7200 T -N -0 G -300 -1200 M -300 -3200 M -/Helvetica-BoldOblique-ISOLatin1 $ -/Helvetica-BoldOblique & P -/Helvetica-BoldOblique-ISOLatin1 F 1200 o f -(Interoperability) h -300 -4800 M -300 -6800 M -/Times-Roman-ISOLatin1 $ -/Times-Roman & P -/Times-Roman-ISOLatin1 F 1200 o f -126.6 0 32 (In previous sections the data portability problems were limited to mass storage devices. The) W -300 -8200 M -53.1 0 32 (mass storage related problems are really just a simple form of more general inter\255process com\255) W -300 -9600 M -108.0 0 32 (munications problems. Any time a 32\255bit program communicates with a 64\255bit program they) W -300 -11000 M -23.5 0 32 (must agree on the format and type of data. Therefore, the same issues can occur over a local or) W -300 -12400 M -112.4 0 32 (wide area network. If the 64\255bit product supported both 32\255bit and 64\255bit execution environ\255) W -300 -13800 M -205.0 0 32 (ments the problem would be extended to include other IPC mechanisms such as System V) W -300 -15200 M -(shared memory and message queues.) h -n 0.666 o f -0.0 538.0 m -(1) h -0 -538.0 m -300 -17200 M -n 1.502 o f -31.4 0 32 (64\255bit systems will support files larger than 2 gigabytes.) W -n 0.666 o f -0.0 538.0 m -31.4 0 32 (2) W -0 -538.0 m -n 1.502 o f -31.4 0 32 ( They will also function as fileservers) W -300 -18600 M -19.1 0 32 (for other systems including existing 32\255bit systems. Files may be created that can't be fully ad\255) W -300 -20000 M -50.9 0 32 (dressed by 32\255bit clients. It will also be possible to mount disks from 64\255bit systems on 32\255bit) W -300 -21400 M -(systems and have the same problem.) h -300 -23400 M -300 -25400 M -/Helvetica-BoldOblique-ISOLatin1 F 1200 o f -(Atomicity) h -300 -27000 M -300 -29000 M -/Times-Roman-ISOLatin1 F 1200 o f -83.7 0 32 (Some 64\255bit architectures do not support byte or word load and store operations. The smallest) W -300 -30400 M -100.3 0 32 (unit of memory access is the longword, which is 32 bits. High level language byte and word) W -300 -31800 M -31.6 0 32 (accesses are accomplished with multiple instructions. In most cases this fact can be ignored by) W -300 -33200 M -148.0 0 32 (an applications developer. It becomes important whenever multiple threads of execution are) W -300 -34600 M -28.1 0 32 (sharing data. This can happen when two or more processes share data via shared memory or in) W -300 -36000 M -(a multi\255threaded application where all threads share a common address space.) h -300 -38000 M -(char byte[16]) h -300 -40000 M -12.5 0 32 (As an example using the declaration above, if threadA attempts to update byte[0] while threadB) W -300 -41400 M -41.9 0 32 (updates byte[1] there is a chance that the access of one thread will affect the other even though) W -300 -42800 M -24.6 0 32 (they aren't trying to update the same variable. The following is an example of the code used to) W -300 -44200 M -(update a single byte.) h -300 -46200 M -300 -48200 M -(8: byte[1] = 5; ) h -300 -50200 M -( [tst.c: 8] 0x120000230: 43e0b40f) h -17580 -50200 M -(addq zero, 0x5, t7) h -300 -51600 M -( [tst.c: 8] 0x120000234: 203e0001) h -17580 -51600 M -(lda at, 1\(sp\)) h -300 -53000 M -( [tst.c: 8] 0x120000238: 2f410000) h -17580 -53000 M -(ldq_u k0, 0\(at\) \255\255\255\255\255\255\255\255\255\255\255) h -300 -54400 M -( [tst.c: 8] 0x12000023c: 49e1017b) h -17580 -54400 M -(insbl t7, at, k1) h -300 -55800 M -( [tst.c: 8] 0x120000240: 4b41005a) h -17580 -55800 M -(mskbl k0, at, k0) h -300 -57200 M -( [tst.c: 8] 0x120000244: 475b041a) h -17580 -57200 M -(bis k0, k1, k0) h -300 -58600 M -( [tst.c: 8] 0x120000248: 3f410000) h -17580 -58600 M -(stq_u k0, 0\(at\) \255\255\255\255\255\255\255\255\255\255\255) h --7200 7200 T -R - -S -7200 -68400 T -N -0 G -300 -1200 M -/Times-Roman-ISOLatin1 F 1000 o f -0.0 448.0 m -(1) h -0 -448.0 m -900 -1200 M -(Not part of the product plans at this time) h -300 -3000 M -0.0 448.0 m -(2) h -0 -448.0 m -900 -3000 M -(32 bit systems are currently limited to 2 gigabytes) h --7200 68400 T -R - -showpage -$P e - -%%Page: 7 7 -/$P a D -g N -0 79200 T -S -S -7200 -74700 T -N -0 G -22511 -1050 M -/Helvetica-ISOLatin1 $ -/Helvetica & P -/Helvetica-ISOLatin1 F 1000 o f -(\255 ) h -(7) h -( \255) h -300 -2485 M --7200 74700 T -R - -S -N -7500 -73600 M -53700 -73600 L -S -100 w -0 c -0 j -2 i -0.00 G k -R -R - -R -S -7200 -7200 T -N -0 G -300 -1200 M -300 -3200 M -/Times-Roman-ISOLatin1 $ -/Times-Roman & P -/Times-Roman-ISOLatin1 F 1200 o f -23.3 0 32 (A 5 instruction sequence is used to load the quadword containing the byte, update the byte with) W -300 -4600 M -9.7 0 32 (the right value and store the result back to memory. If threadA starts this operation and is inter\255) W -300 -6000 M -224.5 0 32 (rupted between the load and store and threadB gets control and updates byte[0] or byte[2]) W -300 -7400 M -(threadB's changes will be overwritten when threadA completes it sequence.) h -300 -9400 M -134.1 0 32 (Programs that work on nonshared data on VAX and MIPS aren't affected because they have) W -300 -10800 M -51.6 0 32 (`atomic' read and write access at the byte granularity level. The same program might fail on a) W -300 -12200 M -29.0 0 32 (64\255bit system and must be coded appropriately by using longword or quadword data aligned on) W -300 -13600 M -(natural boundaries.) h -n 0.667 o f -0.0 538.0 m -(1) h -0 -538.0 m -300 -15600 M -300 -17600 M -/Helvetica-BoldOblique-ISOLatin1 $ -/Helvetica-BoldOblique & P -/Helvetica-BoldOblique-ISOLatin1 F 1200 o f -(Read/Write Ordering) h -300 -19200 M -300 -21200 M -/Times-Roman-ISOLatin1 F 1200 o f -183.7 0 32 (Some 64\255bit multiprocessor systems pose an additional problem for applications developers. ) W -300 -22600 M -134.1 0 32 (They do not guarantee write ordering between multiple processors) W -n 0.667 o f -0.0 538.0 m -134.1 0 32 (2) W -0 -538.0 m -n 1.500 o f -134.1 0 32 (. If variable A and B are) W -300 -24000 M -33.7 0 32 (written to memory in order on one processor they will appear to be written in that order on that) W -300 -25400 M -22.1 0 32 (processor but might appear in a different order on another processor. Multiple programs and/or) W -300 -26800 M -215.6 0 32 (multithreaded programs running on a multiprocessor system sharing data cannot depend on) W -300 -28200 M -(write ordering. They must use memory barrier instructions to order writes.) h -300 -30200 M -300 -32200 M -/Helvetica-BoldOblique-ISOLatin1 F 1200 o f -(Migration Aids) h -300 -33800 M -300 -35800 M -/Times-Roman-ISOLatin1 F 1200 o f -31.2 0 32 (Lint is an effective tool used to find argument mismatches and dubious assignments. Programs) W -300 -37200 M -(written in ANSI C benefit from tighter control in these areas as well.) h -300 -39200 M -37.7 0 32 (64\255bit OSF products will include a 32\255bit to 64\255bit portability guide in addition to the ULTRIX) W -300 -40600 M -(to OSF migration guide.) h -300 -42600 M -300 -44600 M -/Helvetica-BoldOblique-ISOLatin1 F 1200 o f -(Conclusion) h -300 -46200 M -300 -48200 M -/Times-Roman-ISOLatin1 F 1200 o f -16.6 0 32 (Most 32\255bit OSF programs should compile and run normally on 64\255bit OSF systems. Programs) W -300 -49600 M -44.2 0 32 (that do not pay attention to the proper use of datatypes my fail but can be easily fixed with mi\255) W -300 -51000 M -43.8 0 32 (nor changes. The use of lint and/or ANSI C features will detect these abuses and the corrected) W -300 -52400 M -(program will be backwards source compatible.) h -300 -54400 M -79.6 0 32 (Programs that do not read or write data containing pointers or long variables will have a great) W -300 -55800 M -27.9 0 32 (deal of interoperability and are also likely to run unchanged. Programs that do not have to pro\255) W -300 -57200 M -(duce or consume data for 32\255bit programs should run unchanged.) h --7200 7200 T -R - -S -7200 -68400 T -N -0 G -300 -1200 M -/Times-Roman-ISOLatin1 F 1000 o f -0.0 448.0 m -(1) h -0 -448.0 m -900 -1200 M -(longword is equivelent to the int datatype and quadword is equivelent to the long datatype) h -300 -3000 M -0.0 448.0 m -(2) h -0 -448.0 m -900 -3000 M -(I/O devices are defined as processors) h --7200 68400 T -R - -showpage -$P e - -%%Page: 8 8 -/$P a D -g N -0 79200 T -S -S -7200 -74700 T -N -0 G -22511 -1050 M -/Helvetica-ISOLatin1 $ -/Helvetica & P -/Helvetica-ISOLatin1 F 1000 o f -(\255 ) h -(8) h -( \255) h -300 -2485 M --7200 74700 T -R - -S -N -7500 -73600 M -53700 -73600 L -S -100 w -0 c -0 j -2 i -0.00 G k -R -R - -R -S -7200 -7200 T -N -0 G -300 -1200 M -/Times-Roman-ISOLatin1 $ -/Times-Roman & P -/Times-Roman-ISOLatin1 F 1200 o f -67.2 0 32 (Programs that must deal with scalar data produced by 32\255bit programs may require minor data) W -300 -2600 M -102.9 0 32 (definition changes. Programs that must deal with data containing 32\255bit pointers may require) W -300 -4000 M -(significantly more work.) h -300 -6000 M -300 -7400 M -300 -9400 M -300 -10836 M --7200 7200 T -R - -showpage -$P e - -%%Trailer -$D restore -end % DEC_WRITE_dict -%%Pages: 8 -%%DocumentFonts: Helvetica-Bold-ISOLatin1 -%%+ Times-Roman-ISOLatin1 -%%+ Times-Italic-ISOLatin1 -%%+ Helvetica-ISOLatin1 -%%+ Helvetica-BoldOblique-ISOLatin1 -%%+ Symbol - diff --git a/hlp/alpha_portability.ps b/hlp/alpha_portability.ps deleted file mode 100644 index d6685d3db9caf75ad711bd18ed2d9906ffb06b15..0000000000000000000000000000000000000000 --- a/hlp/alpha_portability.ps +++ /dev/null @@ -1,2635 +0,0 @@ -%!PS-Adobe-2.1 -%%Creator: DECwrite T2.0-IFT -%%+Copyright (c) 1990 DIGITAL EQUIPMENT CORPORATION. -%%+All Rights Reserved. -%%DocumentFonts: (atend) -%%EndComments -%%BeginProcSet DEC_WRITE 1.07 -/DEC_WRITE_dict 150 dict def DEC_WRITE_dict begin/$D save def/$I 0 def/$S 0 -def/$C matrix def/$R matrix def/$L matrix def/$E matrix def/pat1{/px exch -def/pa 8 array def 0 1 7{/py exch def/pw 4 string def 0 1 3{pw exch px py 1 -getinterval putinterval}for pa py pw put}for}def/pat2{/pi exch def/cflag -exch def save cflag 1 eq{eoclip}{clip}ifelse newpath{clippath -pathbbox}stopped not{/ph exch def/pw exch def/py exch def/px exch def/px px -3072 div floor 3072 mul def/py py 3072 div floor 3072 mul def px py -translate/pw pw px sub 3072 div floor 1 add cvi def/ph ph py sub 3072 div -floor 1 add cvi def pw 3072 mul ph 3072 mul scale/pw pw 32 mul def/ph ph 32 -mul def/px 0 def/py 0 def pw ph pi[pw 0 0 ph 0 0]{pa py get/px px 32 add -def px pw ge{/px 0 def/py py 1 add 8 mod def}if}pi type/booleantype -eq{imagemask}{image}ifelse}if restore}def/PS{/_op exch def/_np 8 string def -0 1 7{/_ii exch def/num _op _ii get def _np 7 _ii sub num -4 bitshift PX -num 15 and 4 bitshift -4 bitshift PX 4 bitshift or put}for _np}def/PX{[15 7 -11 3 13 5 9 1 14 6 10 2 12 4 8 0]exch get}def/FR{0.7200 0 $E defaultmatrix -dtransform/yres exch def/xres exch def xres dup mul yres dup mul add -sqrt}def/SU{/_sf exch def/_sa exch def/_cs exch def/_mm $C currentmatrix -def/rm _sa $R rotate def/sm _cs dup $L scale def sm rm _mm _mm concatmatrix -_mm concatmatrix pop 1 0 _mm dtransform/y1 exch def/x1 exch def/_vl x1 dup -mul y1 dup mul add sqrt def/_fq FR _vl div def/_na y1 x1 atan def _mm 2 get -_mm 1 get mul _mm 0 get _mm 3 get mul sub 0 gt{{neg}/_sf load -concatprocs/_sf exch def}if _fq _na/_sf load setscreen}def/BO{/_yb exch -def/_xb exch def/_bv _bs _yb _bw mul _xb 8 idiv add get def/_mk 1 7 _xb 8 -mod sub bitshift def _bv _mk and 0 ne $I 1 eq xor}def/BF{DEC_WRITE_dict -begin/_yy exch def/_xx exch def/_xi _xx 1 add 2 div _bp mul cvi def/_yi _yy -1 add 2 div _bp mul cvi def _xi _yi BO{/_nb _nb 1 add def 1}{/_fb _fb 1 add -def 0}ifelse end}def/setpattern{/_cz exch def/_bw exch def/_bp exch def/_bs -exch PS def/_nb 0 def/_fb 0 def _cz 0/BF load SU{}settransfer _fb _fb _nb -add div setgray/$S 1 def}def/invertpattern{$S 0 eq{{1 exch -sub}currenttransfer concatprocs settransfer}if}def/invertscreen{/$I 1 -def/$S 0 def}def/revertscreen{/$I 0 def}def/setrect{/$h exch def/$w exch -def/$y exch def/$x exch def newpath $x $y moveto $w $x add $y lineto $w $x -add $h $y add lineto $x $h $y add lineto closepath}def/concatprocs{/_p2 -exch cvlit def/_p1 exch cvlit def/_pn _p1 length _p2 length add array def -_pn 0 _p1 putinterval _pn _p1 length _p2 putinterval _pn -cvx}def/OF/findfont load def/findfont{dup DEC_WRITE_dict exch -known{DEC_WRITE_dict exch get}if DEC_WRITE_dict/OF get exec}def -mark/ISOLatin1Encoding -8#000 1 8#001{StandardEncoding exch get}for /emdash/endash -8#004 1 8#025{StandardEncoding exch get}for /quotedblleft/quotedblright -8#030 1 8#054{StandardEncoding exch get}for /minus 8#056 1 8#217 -{StandardEncoding exch get}for/dotlessi 8#301 1 8#317{StandardEncoding -exch get}for/space/exclamdown/cent/sterling/currency/yen/brokenbar/section -/dieresis/copyright/ordfeminine/guillemotleft/logicalnot/hyphen/registered -/macron/degree/plusminus/twosuperior/threesuperior/acute/mu/paragraph -/periodcentered/cedilla/onesuperior/ordmasculine/guillemotright/onequarter -/onehalf/threequarters/questiondown/Agrave/Aacute/Acircumflex/Atilde -/Adieresis/Aring/AE/Ccedilla/Egrave/Eacute/Ecircumflex/Edieresis/Igrave -/Iacute/Icircumflex/Idieresis/Eth/Ntilde/Ograve/Oacute/Ocircumflex/Otilde -/Odieresis/multiply/Oslash/Ugrave/Uacute/Ucircumflex/Udieresis/Yacute/Thorn -/germandbls/agrave/aacute/acircumflex/atilde/adieresis/aring/ae/ccedilla -/egrave/eacute/ecircumflex/edieresis/igrave/iacute/icircumflex/idieresis -/eth/ntilde/ograve/oacute/ocircumflex/otilde/odieresis/divide/oslash/ugrave -/uacute/ucircumflex/udieresis/yacute/thorn/ydieresis -256 array astore def cleartomark -/encodefont{findfont dup maxlength dict begin{1 index/FID ne{def}{pop -pop}ifelse}forall/Encoding exch def dup/FontName exch def currentdict -definefont end}def/loads{/$/ISOLatin1Encoding load def/&/encodefont load -def/*/invertpattern load def/+/revertscreen load def/-/invertscreen load -def/:/concatprocs load def/^/setpattern load def/~/pat1 load def/_/pat2 -load def/@/setrect load def/A/arcn load def/B/ashow load def/C/curveto load -def/D/def load def/E/eofill load def/F/findfont load def/G/setgray load -def/H/closepath load def/I/clip load def/J/fill load def/K/kshow load -def/L/lineto load def/M/moveto load def/N/newpath load def/O/rotate load -def/P/pop load def/R/grestore load def/S/gsave load def/T/translate load -def/U/sub load def/V/div load def/W/widthshow load def/X/exch load -def/Y/awidthshow load def/a/save load def/c/setlinecap load def/d/setdash -load def/e/restore load def/f/setfont load def/g/initclip load def/h/show -load def/i/setmiterlimit load def/j/setlinejoin load def/k/stroke load -def/l/rlineto load def/m/rmoveto load def/n/currentfont load -def/o/scalefont load def/p/currentpoint load def/q/setrgbcolor load -def/r/currenttransfer load def/s/scale load def/t/setmatrix load -def/u/settransfer load def/w/setlinewidth load def/x/matrix load -def/y/currentmatrix load def}def -end -%%EndProcSet -%%EndProlog -%%BeginSetup -DEC_WRITE_dict begin -loads -version cvi 23.0 gt { -currentdict {dup type /arraytype eq -{bind def} {pop pop} ifelse} forall} if -0.0100 0.0100 s - -%%EndSetup -%%Page: 1 1 -/$P a D -g N -0 79200 T -S -R -S -7200 -7200 T -N -0 G -5947 -1650 M -/Helvetica-Bold-ISOLatin1 $ -/Helvetica-Bold & P -/Helvetica-Bold-ISOLatin1 F 1800 o f -(Porting C Applications DEC OSF/1 Alpha) h -17298 -4200 M -n 0.667 o f -(Lu Anne Van de Pas ) h -18565 -6600 M -( ) h -300 -11400 M -/Helvetica-ISOLatin1 $ -/Helvetica & P -/Helvetica-ISOLatin1 F 1200 o f -103.3 0 32 (The DEC OSF/1 V1.2 system takes advantage of the full 64\255bit capabilities of the Al\255) W -300 -12800 M -80.2 0 32 (pha architecture. In doing so, it introduces a number of extended capabilities beyond) W -300 -14200 M -311.4 0 32 (32\255bit architectures that can effect the portability and interoperability of programs. ) W -300 -15600 M -186.2 0 32 (Careful coding practices can help reduce these inconsistencies. The following sec\255) W -300 -17000 M -106.2 0 32 (tions will look at specific aspects of the C language and explain certain programming) W -300 -18400 M -70.1 0 32 (techniques that will help in both new program development and the porting of existing) W -300 -19800 M -(programs from DEC ULTRIX to DEC OSF/1 Alpha systems. ) h -300 -23450 M -/Helvetica-Bold-ISOLatin1 F 1400 o f -(Overview) h -300 -26100 M -/Helvetica-ISOLatin1 F 1200 o f -2.8 0 32 (The ease of moving a C program from a 32\255bit VAX or MIPS architecture to a full 64\255bit) W -300 -27500 M -159.3 0 32 (implementation of the Alpha architecture depends upon: 1. the overall coding disci\255) W -300 -28900 M -203.6 0 32 (plines employed in the application, and 2. the use of nonstandard system features. ) W -300 -30300 M -24.1 0 32 (For example, a program written with adherence to the ANSI C standard, using function) W -300 -31700 M -39.2 0 32 (prototypes, and having no assumption about the machine size of data types or system) W -300 -33100 M -100.8 0 32 (architectural specifics, can be ported with ease. Special care may need to be taken) W -300 -34500 M -42.9 0 32 (when mixing 64\255bit and 32\255bit systems through data sharing mechanisms such as net\255) W -300 -35900 M -(works, databases, and shared file systems.) h -300 -37300 M -300 -38700 M -20.7 0 32 (At a high level, the general coding issues can be outlined by examining specifics in the) W -300 -40100 M -60.6 0 32 (host \(build\) and target \(runtime\) environment of the DEC OSF/1 Alpha system. Each) W -300 -41500 M -108.0 0 32 (of the areas described below affects the portability of the application. The program\255) W -300 -42900 M -198.6 0 32 (ming techniques and examples in the remaining sections will show in detail how to) W -300 -44300 M -(code or recode your program.) h -300 -46300 M -/Symbol F 1200 o f -(\267) h -2100 -46300 M -/Helvetica-ISOLatin1 F 1200 o f -(Development environment) h -2100 -47700 M -2100 -49100 M -17.7 0 32 (When you port an application to the DEC OSF/1 Alpha system you must recompile) W -2100 -50500 M -15.0 0 32 (the application or use the binary translator. \(See MX documentation for information) W -2100 -51900 M -(on translating executables from the MIPS architecture to Alpha.\) ) h -2100 -53300 M -6060 -53300 M -2100 -54700 M -25.1 0 32 (The DEC OSF/1 Alpha development environment has a similar compilation, linking,) W -2100 -56100 M -64.9 0 32 (debugging, and performance analysis tools as RISC ULTRIX. The Alpha develop\255) W -2100 -57500 M -31.8 0 32 (ment environment, C compiler and related tools, has additional support for ANSI C,) W -2100 -58900 M -64.8 0 32 (64\255bit data types and addresses, and shared libraries. Lint has additional features) W -2100 -60300 M -309.7 0 32 (to help find 32\255to\25564 bit conversion problems. ) W -2100 -61700 M --7200 7200 T -R - -showpage -$P e - -%%Page: 2 2 -/$P a D -g N -0 79200 T -S -R -S -7200 -7200 T -N -0 G -300 -1200 M -/Symbol F 1200 o f -(\267) h -2100 -1200 M -/Helvetica-ISOLatin1 $ -/Helvetica & P -/Helvetica-ISOLatin1 F 1200 o f -(Compiler optimizations: ) h -2100 -2600 M -2100 -4000 M -89.4 0 32 (The DEC OSF/1 Alpha C compiler has additional optimizations and code schedul\255) W -2100 -5400 M -47.5 0 32 (ing specific to the Alpha architecture. Because of this you may notice different er\255) W -2100 -6800 M -(ror messages between ULTRIX and Alpha systems. ) h -300 -8800 M -/Symbol F 1200 o f -(\267) h -2100 -8800 M -/Helvetica-ISOLatin1 F 1200 o f -(Data Representation: ) h -2100 -10200 M -6060 -10200 M -2100 -11600 M -150.6 0 32 (In order to take advantage of the 64\255bit architecture the C data types have been) W -2100 -13000 M -50.6 0 32 (modified to include a 64\255bit type. In the table below, 'int' is unchanged as a 32 bit) W -2100 -14400 M -123.4 0 32 (entity, and long is redefined to be 64 bits. In order to extend the address space, ) W -2100 -15800 M -(pointers on Alpha are defined to be 64 bits.) h -2100 -17200 M -6060 -17200 M -2100 -18600 M -158.5 0 32 (The DEC OSF/1 Alpha system has also defined a 'long long' data type to be 64) W -2100 -20000 M -47.3 0 32 (bits. It provides the unique name for a 64\255bit data type that may provide additional) W -2100 -21400 M -(interoperability between 32\255bit and 64\255bit systems. ) h -2100 -22800 M -6060 -22800 M -2100 -24200 M -39.8 0 32 (Similar to VAX and MIPS systems, the DEC OSF/1 Alpha system uses right\255to\255left) W -2100 -25600 M -(byte order for integer types \(little\255endian\).) h -29100 -25600 M -2100 -27000 M -300 -54400 M -S -0 26300 m -p T -0 -26300 45901 26300 @ I N -N -S -50 -50 T -N -0 G -5171 -1500 M -/Times-Roman-ISOLatin1 $ -/Times-Roman & P -/Times-Roman-ISOLatin1 F 1200 o f -(Data type ) h -600 -2884 M --50 50 T -R - -S -15325 -50 T -N -0 G -737 -1500 M -/Times-Roman-ISOLatin1 F 1200 o f -(32\255bit MIPS or VAX system) h -( ) h -4521 -2900 M -(\(size in bits\) ) h --15325 50 T -R - -S -30600 -50 T -N -0 G -2609 -1500 M -/Times-Roman-ISOLatin1 F 1200 o f -( 64\255bit Alpha system ) h -4659 -2900 M -(\(size in bits\)) h --30600 50 T -R - -S -50 -3900 T -N -0 G -6605 -1500 M -/Times-Roman-ISOLatin1 F 1200 o f -(char) h --50 3900 T -R - -S -15325 -3900 T -N -0 G -7337 -1500 M -/Times-Roman-ISOLatin1 F 1200 o f -(8) h --15325 3900 T -R - -S -30600 -3900 T -N -0 G -7325 -1500 M -/Times-Roman-ISOLatin1 F 1200 o f -(8) h --30600 3900 T -R - -S -50 -6350 T -N -0 G -6437 -1500 M -/Times-Roman-ISOLatin1 F 1200 o f -(short) h --50 6350 T -R - -S -15325 -6350 T -N -0 G -7037 -1500 M -/Times-Roman-ISOLatin1 F 1200 o f -(16) h --15325 6350 T -R - -S -30600 -6350 T -N -0 G -7025 -1500 M -/Times-Roman-ISOLatin1 F 1200 o f -(16) h --30600 6350 T -R - -S -50 -8800 T -N -0 G -7004 -1500 M -/Times-Roman-ISOLatin1 F 1200 o f -(int) h --50 8800 T -R - -S -15325 -8800 T -N -0 G -7037 -1500 M -/Times-Roman-ISOLatin1 F 1200 o f -(32) h --15325 8800 T -R - -S -30600 -8800 T -N -0 G -7025 -1500 M -/Times-Roman-ISOLatin1 F 1200 o f -(32) h --30600 8800 T -R - -S -50 -11250 T -N -0 G -6570 -1500 M -/Times-Roman-ISOLatin1 F 1200 o f -(long) h --50 11250 T -R - -S -15325 -11250 T -N -0 G -7037 -1500 M -/Times-Roman-ISOLatin1 F 1200 o f -(32) h --15325 11250 T -R - -S -30600 -11250 T -N -0 G -7025 -1500 M -/Times-Roman-ISOLatin1 F 1200 o f -(64) h --30600 11250 T -R - -S -50 -13700 T -N -0 G -5354 -1500 M -/Times-Roman-ISOLatin1 F 1200 o f -(long long) h --50 13700 T -R - -S -15325 -13700 T -N -0 G -4421 -1500 M -/Times-Roman-ISOLatin1 F 1200 o f -(Not available) h --15325 13700 T -R - -S -30600 -13700 T -N -0 G -7025 -1500 M -/Times-Roman-ISOLatin1 F 1200 o f -(64) h --30600 13700 T -R - -S -50 -16150 T -N -0 G -6537 -1500 M -/Times-Roman-ISOLatin1 F 1200 o f -(float) h -600 -2884 M --50 16150 T -R - -S -15325 -16150 T -N -0 G -1037 -1500 M -/Times-Roman-ISOLatin1 F 1200 o f -(32 \( MIPS: IEEE Single\)) h -600 -2900 M -( \(VAX: F float\)) h --15325 16150 T -R - -S -30600 -16150 T -N -0 G -3192 -1500 M -/Times-Roman-ISOLatin1 F 1200 o f -(32 \(IEEE Single\)) h -600 -2900 M -( ) h --30600 16150 T -R - -S -50 -20000 T -N -0 G -6004 -1500 M -/Times-Roman-ISOLatin1 F 1200 o f -(double) h -600 -2884 M --50 20000 T -R - -S -15325 -20000 T -N -0 G -954 -1500 M -/Times-Roman-ISOLatin1 F 1200 o f -(64 \(MIPS: IEEE Double\)) h -600 -2900 M -( \(VAX: G or D float\)) h --15325 20000 T -R - -S -30600 -20000 T -N -0 G -2810 -1500 M -/Times-Roman-ISOLatin1 F 1200 o f -(64 \(IEEE Double\)) h -600 -2884 M --30600 20000 T -R - -S -50 -23850 T -N -0 G -5937 -1500 M -/Times-Roman-ISOLatin1 F 1200 o f -(pointer) h --50 23850 T -R - -S -15325 -23850 T -N -0 G -7037 -1500 M -/Times-Roman-ISOLatin1 F 1200 o f -(32) h --15325 23850 T -R - -S -30600 -23850 T -N -0 G -7025 -1500 M -/Times-Roman-ISOLatin1 F 1200 o f -(64) h --30600 23850 T -R - -S -N -0 -3875 M -46001 -3875 L -S -50 w -0 c -0 j -2 i -0.00 G k -R -R - -S -N -0 -6325 M -46001 -6325 L -S -50 w -0 c -0 j -2 i -0.00 G k -R -R - -S -N -0 -8775 M -46001 -8775 L -S -50 w -0 c -0 j -2 i -0.00 G k -R -R - -S -N -0 -11225 M -46001 -11225 L -S -50 w -0 c -0 j -2 i -0.00 G k -R -R - -S -N -0 -13675 M -46001 -13675 L -S -50 w -0 c -0 j -2 i -0.00 G k -R -R - -S -N -0 -16125 M -46001 -16125 L -S -50 w -0 c -0 j -2 i -0.00 G k -R -R - -S -N -0 -19975 M -46001 -19975 L -S -50 w -0 c -0 j -2 i -0.00 G k -R -R - -S -N -0 -23825 M -46001 -23825 L -S -50 w -0 c -0 j -2 i -0.00 G k -R -R - -R -45901 0 m -300 -56400 M -300 -58400 M -/Symbol F 1200 o f -(\267) h -2100 -58400 M -/Helvetica-ISOLatin1 F 1200 o f -(Data access) h -2100 -59800 M -2701 -59800 M -2100 -61200 M -44.5 0 32 (The VAX and MIPS architectures are both byte and word addressable. Alpha sup\255) W -2100 -62600 M -16.7 0 32 (ports only memory accesses of longword \(32 bits\) or quadword \(64 bits\). Byte and) W -2100 -64000 M -59.3 0 32 (word accesses are accomplished by multiple instructions which load a longword or) W --7200 7200 T -R - -showpage -$P e - -%%Page: 3 3 -/$P a D -g N -0 79200 T -S -R -S -7200 -7200 T -N -0 G -2100 -1200 M -/Helvetica-ISOLatin1 $ -/Helvetica & P -/Helvetica-ISOLatin1 F 1200 o f -23.6 0 32 (quadword, mask, and shift to get the desired entity. This lack of a single operation) W -2100 -2600 M -22.6 0 32 (for byte and word access may produce incorrect results in cases where you are ac\255) W -2100 -4000 M -81.9 0 32 (cessing adjacent byte or word entities in shared memory segments. For instance, ) W -2100 -5400 M -46.7 0 32 (a multi\255threaded application or multiple processes that has access to adjacent byte) W -2100 -6800 M -289.5 0 32 (data through shared memory or shared memory\255mapped files will have to use) W -2100 -8200 M -309.2 0 32 (thread mutual exclusion locking functions or semaphone locks, respectively, to) W -2100 -9600 M -(avoid conflicts with accesses to adjacent byte or word data items. ) h -300 -11600 M -/Symbol F 1200 o f -(\267) h -2100 -11600 M -/Helvetica-ISOLatin1 F 1200 o f -(Data Alignment) h -2100 -13000 M -( ) h -2100 -14400 M -55.6 0 32 (On both MIPS and ALPHA systems the data alignment is implied by the data type. ) W -2100 -15800 M -50.8 0 32 (For instance, an ) W -/Helvetica-Oblique-ISOLatin1 $ -/Helvetica-Oblique & P -/Helvetica-Oblique-ISOLatin1 F 1200 o f -50.8 0 32 (int) W -/Helvetica-ISOLatin1 F 1200 o f -50.8 0 32 ( \(32 bits\) is aligned on a 4 byte boundary. On MIPS systems,) W -2100 -17200 M -2.3 0 32 (a ) W -/Helvetica-Oblique-ISOLatin1 F 1200 o f -2.3 0 32 (long ) W -/Helvetica-ISOLatin1 F 1200 o f -2.3 0 32 (\(32 bits\) is also aligned on a 4 byte boundary. But on Alpha systems, a) W -/Helvetica-Oblique-ISOLatin1 F 1200 o f -2.3 0 32 ( long) W -2100 -18600 M -/Helvetica-ISOLatin1 F 1200 o f -212.9 0 32 (\(64 bits\) is aligned on 8 byte boundaries. If using assembly language, you will) W -2100 -20000 M -85.4 0 32 (need to understand and code according to these alignment restrictions. If using a) W -2100 -21400 M -55.9 0 32 (high\255level language such as C, the compiler will take care of this alignment for you) W -2100 -22800 M -70.5 0 32 (but it is still important that you understand these alignment differences when using) W -2100 -24200 M -137.0 0 32 (long and pointer types in structure definitions that are shared between 32\255bit and) W -2100 -25600 M -(64\255bit systems. ) h -300 -27600 M -/Symbol F 1200 o f -(\267) h -2100 -27600 M -/Helvetica-ISOLatin1 F 1200 o f -(File system) h -2100 -29000 M -6060 -29000 M -2100 -30400 M -150.0 0 32 (On the 32\255bit systems of MIPS and VAX, files and file systems were limited to 2) W -2100 -31800 M -178.3 0 32 (gigabytes in size. This limit was imposed by the programming interface and file) W -2100 -33200 M -65.3 0 32 (system which used a 32\255bit integer to represent the file offset in bytes \() W -/Helvetica-Oblique-ISOLatin1 F 1200 o f -65.3 0 32 (off_t) W -/Helvetica-ISOLatin1 F 1200 o f -65.3 0 32 (\) when) W -2100 -34600 M -101.1 0 32 (navigating within a file or file system. On a 64\255bit DEC OSF/1 Alpha system, you) W -2100 -36000 M -87.7 0 32 (can now build much larger files and file systems. ) W -/Helvetica-Oblique-ISOLatin1 F 1200 o f -87.7 0 32 (off_t ) W -/Helvetica-ISOLatin1 F 1200 o f -87.7 0 32 ( is defined to be a ) W -/Helvetica-Oblique-ISOLatin1 F 1200 o f -87.7 0 32 (long) W -/Helvetica-ISOLatin1 F 1200 o f -87.7 0 32 ( on) W -2100 -37400 M -(Alpha systems. ) h -2100 -38800 M -6060 -38800 M -90.9 0 32 (Given this extended capability, it is possible to build files and files systems) W -2100 -40200 M -61.4 0 32 (that can not be fully accessed by 32\255bit systems. This is very important to keep in) W -2100 -41600 M -4.2 0 32 (mind when working in an distributed environment where file systems are shared be\255) W -2100 -43000 M -(tween 32 and 64 bit systems. ) h -2100 -44400 M -2100 -45800 M -300 -49450 M -/Helvetica-Bold-ISOLatin1 $ -/Helvetica-Bold & P -/Helvetica-Bold-ISOLatin1 F 1400 o f -(Coding Guidelines) h -300 -52100 M -/Helvetica-ISOLatin1 F 1200 o f -34.5 0 32 (When developing or porting C code the RISC ULTRIX and DEC OSF/1 Alpha systems) W -300 -53500 M -111.4 0 32 (are similar in a number of ways. Both systems are little endian. Both support 32\255bit) W -300 -54900 M -81.5 0 32 (integers, 16\255bit shorts, 8\255bit characters, and IEEE single and double floating point for\255) W -300 -56300 M -52.1 0 32 (mats. And both have a similar development environment and C compiler. The major) W -300 -57700 M -36.5 0 32 (differences you need to consider in coding are in the size of addresses, the availability) W -300 -59100 M -9.4 0 32 (of 64\255bit integer types, the data type alignment restrictions, byte and word accessibility,) W -300 -60500 M -(and interoperability between 32\255bit and 64\255bit systems. ) h -300 -62500 M -6060 -62500 M -300 -63900 M -106.2 0 32 (The remainder of this chapter will go through specific C coding examples and outline) W --7200 7200 T -R - -showpage -$P e - -%%Page: 4 4 -/$P a D -g N -0 79200 T -S -R -S -7200 -7200 T -N -0 G -300 -1200 M -/Helvetica-ISOLatin1 $ -/Helvetica & P -/Helvetica-ISOLatin1 F 1200 o f -2.8 0 32 (areas that may need to be changed for this 64\255bit architecture. Many of these changes) W -300 -2600 M -91.0 0 32 (deal with the "cleaning up" of data type usage, so that you can have code that works) W -300 -4000 M -(on both the 32\255bit and 64\255bits systems.) h -300 -7650 M -/Helvetica-Bold-ISOLatin1 $ -/Helvetica-Bold & P -/Helvetica-Bold-ISOLatin1 F 1400 o f -(Header files \255 Constant definitions) h -300 -10300 M -/Helvetica-ISOLatin1 F 1200 o f -131.9 0 32 (On Alpha, there are a few changes to the standard header files that are directly re\255) W -300 -11700 M -(lated to 64\255bit data types. These include: ) h -300 -13100 M -( ) h -300 -14500 M -(/usr/include/limits.h ) h -300 -35700 M -S -0 20700 m -p T -0 -20700 39601 20700 @ I N -N -S -50 -50 T -N -0 G -2835 -1500 M -/Times-Roman-ISOLatin1 $ -/Times-Roman & P -/Times-Roman-ISOLatin1 F 1200 o f -(Constant) h -600 -2884 M --50 50 T -R - -S -10037 -50 T -N -0 G -2502 -1500 M -/Times-Roman-ISOLatin1 F 1200 o f -(Definition) h -600 -2884 M --10037 50 T -R - -S -20024 -50 T -N -0 G -2785 -1500 M -/Times-Roman-ISOLatin1 F 1200 o f -(Value on) h -2769 -2900 M -(ULTRIX) h --20024 50 T -R - -S -30011 -50 T -N -0 G -2437 -1500 M -/Times-Roman-ISOLatin1 F 1200 o f -(Value on ) h -3303 -2900 M -(Alpha) h --30011 50 T -R - -S -50 -3900 T -N -0 G -600 -1500 M -/Times-Roman-ISOLatin1 F 1200 o f -(LONG_BIT) h -600 -2884 M --50 3900 T -R - -S -10037 -3900 T -N -0 G -600 -1500 M -/Times-Roman-ISOLatin1 F 1200 o f -(Number of bits in) h -600 -2900 M -(a long) h --10037 3900 T -R - -S -20024 -3900 T -N -0 G -600 -1500 M -/Times-Roman-ISOLatin1 F 1200 o f -( 32) h -600 -2884 M --20024 3900 T -R - -S -30011 -3900 T -N -0 G -600 -1500 M -/Times-Roman-ISOLatin1 F 1200 o f -( 64) h -600 -2884 M --30011 3900 T -R - -S -50 -7750 T -N -0 G -600 -1500 M -/Times-Roman-ISOLatin1 F 1200 o f -(LONG_MAX) h -600 -2884 M --50 7750 T -R - -S -10037 -7750 T -N -0 G -600 -1500 M -/Times-Roman-ISOLatin1 F 1200 o f -(Maximum value) h -600 -2900 M -(of a long type) h --10037 7750 T -R - -S -20024 -7750 T -N -0 G -600 -1500 M -/Times-Roman-ISOLatin1 F 1200 o f -(0x7fffffff) h -600 -2884 M --20024 7750 T -R - -S -30011 -7750 T -N -0 G -600 -1500 M -/Times-Roman-ISOLatin1 F 1200 o f -(0x7fffffffffffffff) h -600 -2884 M --30011 7750 T -R - -S -50 -11600 T -N -0 G -600 -1500 M -/Times-Roman-ISOLatin1 F 1200 o f -(LONG_MIN) h -600 -2884 M --50 11600 T -R - -S -10037 -11600 T -N -0 G -600 -1500 M -/Times-Roman-ISOLatin1 F 1200 o f -(Minimum value) h -600 -2900 M -(of a long type) h --10037 11600 T -R - -S -20024 -11600 T -N -0 G -600 -1500 M -/Times-Roman-ISOLatin1 F 1200 o f -(0x80000000) h -600 -2884 M --20024 11600 T -R - -S -30011 -11600 T -N -0 G -600 -1500 M -/Times-Roman-ISOLatin1 F 1200 o f -(0x80000000000) h -600 -2900 M -(00000) h --30011 11600 T -R - -S -50 -15450 T -N -0 G -600 -1500 M -/Times-Roman-ISOLatin1 F 1200 o f -(ULONG_MAX) h -600 -2884 M --50 15450 T -R - -S -10037 -15450 T -N -0 G -600 -1500 M -/Times-Roman-ISOLatin1 F 1200 o f -(Maximun value) h -600 -2900 M -(of an unsigned) h -600 -4300 M -(long) h --10037 15450 T -R - -S -20024 -15450 T -N -0 G -600 -1500 M -/Times-Roman-ISOLatin1 F 1200 o f -(4294967295U) h -600 -2884 M --20024 15450 T -R - -S -30011 -15450 T -N -0 G -600 -1500 M -/Times-Roman-ISOLatin1 F 1200 o f -(1844674407370) h -600 -2900 M -(9551615U) h -600 -4284 M --30011 15450 T -R - -S -N -10012 0 M -10012 -20775 L -S -50 w -0 c -0 j -2 i -0.00 G k -R -R - -S -N -19999 0 M -19999 -20775 L -S -50 w -0 c -0 j -2 i -0.00 G k -R -R - -S -N -29986 0 M -29986 -20775 L -S -50 w -0 c -0 j -2 i -0.00 G k -R -R - -S -N -0 -3875 M -39701 -3875 L -S -50 w -0 c -0 j -2 i -0.00 G k -R -R - -S -N -0 -7725 M -39701 -7725 L -S -50 w -0 c -0 j -2 i -0.00 G k -R -R - -S -N -0 -11575 M -39701 -11575 L -S -50 w -0 c -0 j -2 i -0.00 G k -R -R - -S -N -0 -15425 M -39701 -15425 L -S -50 w -0 c -0 j -2 i -0.00 G k -R -R - -S -25.0 -20675.0 39551.0 20650.0 @ -S -50 w -0 c -0 j -2 i -0.00 G k -R -R -R -39601 0 m -40620 -35700 M -300 -38750 M -/Helvetica-Bold-ISOLatin1 F 1400 o f -(Constants) h -300 -41400 M -/Helvetica-ISOLatin1 F 1200 o f -39.5 0 32 (Some constants may have different values between 32\255bit and 64\255bit systems. For in\255) W -300 -42800 M -44.7 0 32 (stance, the hexadecimal value, 0xFFFFFFFF, has the value \2551 on a 32\255bit system and) W -300 -44200 M -60.5 0 32 (the value 4294967295 on Alpha. The table below lists a few other interesting integer) W -300 -45600 M -(constants and their values. ) h -300 -47000 M -300 -63200 M -S -0 15100 m -p T -0 -15100 39204 15100 @ I N -N -S -50 -50 T -N -0 G -2268 -1500 M -/Times-Roman-ISOLatin1 F 1200 o f -(C constant ) h -600 -2884 M --50 50 T -R - -S -10037 -50 T -N -0 G -3235 -1500 M -/Times-Roman-ISOLatin1 F 1200 o f -( Value ) h -600 -2884 M --10037 50 T -R - -S -20024 -50 T -N -0 G -2287 -1500 M -/Times-Roman-ISOLatin1 F 1200 o f -( Value on ) h -3369 -2900 M -(MIPS) h --20024 50 T -R - -S -29614 -50 T -N -0 G -2137 -1500 M -/Times-Roman-ISOLatin1 F 1200 o f -(Value on ) h -3153 -2900 M -(Alpha ) h --29614 50 T -R - -S -50 -3900 T -N -0 G -600 -1500 M -/Times-Roman-ISOLatin1 F 1200 o f -(0xFFFFFFFF) h --50 3900 T -R - -S -10037 -3900 T -N -0 G -600 -1500 M -/Times-Roman-ISOLatin1 F 1200 o f -(\(2^32\) \2551 ) h --10037 3900 T -R - -S -20024 -3900 T -N -0 G -600 -1500 M -/Times-Roman-ISOLatin1 F 1200 o f -( \2551 ) h -6360 -1500 M --20024 3900 T -R - -S -29614 -3900 T -N -0 G -600 -1500 M -/Times-Roman-ISOLatin1 F 1200 o f -(4294967295) h --29614 3900 T -R - -S -50 -6350 T -N -0 G -600 -1500 M -/Times-Roman-ISOLatin1 F 1200 o f -(4294967296) h --50 6350 T -R - -S -10037 -6350 T -N -0 G -600 -1500 M -/Times-Roman-ISOLatin1 F 1200 o f -(2^32) h -6360 -1500 M --10037 6350 T -R - -S -20024 -6350 T -N -0 G -600 -1500 M -/Times-Roman-ISOLatin1 F 1200 o f -(\(0\)) h --20024 6350 T -R - -S -29614 -6350 T -N -0 G -600 -1500 M -/Times-Roman-ISOLatin1 F 1200 o f -(4294967296) h --29614 6350 T -R - -S -50 -8800 T -N -0 G -600 -1500 M -/Times-Roman-ISOLatin1 F 1200 o f -(0x100000000) h --50 8800 T -R - -S -10037 -8800 T -N -0 G -600 -1500 M -/Times-Roman-ISOLatin1 F 1200 o f -(2^32) h --10037 8800 T -R - -S -20024 -8800 T -N -0 G -600 -1500 M -/Times-Roman-ISOLatin1 F 1200 o f -(\(0\)) h -6360 -1500 M --20024 8800 T -R - -S -29614 -8800 T -N -0 G -600 -1500 M -/Times-Roman-ISOLatin1 F 1200 o f -(4294967296) h --29614 8800 T -R - -S -50 -11250 T -N -0 G -600 -1500 M -/Times-Roman-ISOLatin1 F 1200 o f -(0xFFFFFFFFFFF) h -600 -2900 M -(FFFFF) h --50 11250 T -R - -S -10037 -11250 T -N -0 G -600 -1500 M -/Times-Roman-ISOLatin1 F 1200 o f -(\(2^64\) \2551) h -6360 -1500 M -600 -2900 M --10037 11250 T -R - -S -20024 -11250 T -N -0 G -600 -1500 M -/Times-Roman-ISOLatin1 F 1200 o f -(\2551) h -6360 -1500 M -600 -2900 M --20024 11250 T -R - -S -29614 -11250 T -N -0 G -600 -1500 M -/Times-Roman-ISOLatin1 F 1200 o f -(\2551) h -600 -2884 M --29614 11250 T -R - -S -N -10012 0 M -10012 -15175 L -S -50 w -0 c -0 j -2 i -0.00 G k -R -R - -S -N -19999 0 M -19999 -15175 L -S -50 w -0 c -0 j -2 i -0.00 G k -R -R - -S -N -29589 0 M -29589 -15175 L -S -50 w -0 c -0 j -2 i -0.00 G k -R -R - -S -N -0 -3875 M -39304 -3875 L -S -50 w -0 c -0 j -2 i -0.00 G k -R -R - -S -N -0 -6325 M -39304 -6325 L -S -50 w -0 c -0 j -2 i -0.00 G k -R -R - -S -N -0 -8775 M -39304 -8775 L -S -50 w -0 c -0 j -2 i -0.00 G k -R -R - -S -N -0 -11225 M -39304 -11225 L -S -50 w -0 c -0 j -2 i -0.00 G k -R -R - -S -25.0 -15075.0 39154.0 15050.0 @ -S -50 w -0 c -0 j -2 i -0.00 G k -R -R -R -39204 0 m --7200 7200 T -R - -showpage -$P e - -%%Page: 5 5 -/$P a D -g N -0 79200 T -S -R -S -7200 -7200 T -N -0 G -300 -1200 M -300 -2600 M -300 -5650 M -/Helvetica-Bold-ISOLatin1 $ -/Helvetica-Bold & P -/Helvetica-Bold-ISOLatin1 F 1400 o f -(Definitions and Declarations ) h -300 -9200 M -n 0.857 o f -(Structure Size) h -300 -11200 M -/Helvetica-ISOLatin1 $ -/Helvetica & P -/Helvetica-ISOLatin1 F 1200 o f -15.2 0 32 (Structures and unions on DEC OSF/1 Alpha systems change size from 32\255bit systems.) W -300 -12600 M -22.2 0 32 (This is due to the new 64\255bit data sizes and the additional alignment considerations for) W -300 -14000 M -/Helvetica-Oblique-ISOLatin1 $ -/Helvetica-Oblique & P -/Helvetica-Oblique-ISOLatin1 F 1200 o f -151.0 0 32 (long) W -/Helvetica-ISOLatin1 F 1200 o f -151.0 0 32 ( and pointer. In the example below, the structure,) W -/Helvetica-Bold-ISOLatin1 F 1200 o f -151.0 0 32 ( TextNode) W -/Helvetica-ISOLatin1 F 1200 o f -151.0 0 32 (, grows in size be\255) W -300 -15400 M -(cause all of its members double in size from 4 bytes to 8 bytes for pointer types.) h -300 -17400 M -6060 -17400 M -(struct TextNode {) h -300 -18800 M -6060 -18800 M -11820 -18800 M -(char *text;) h -300 -20200 M -6060 -20200 M -11820 -20200 M -(struct TextNode *left;) h -300 -21600 M -6060 -21600 M -11820 -21600 M -(struct TextNode *right;) h -300 -23000 M -6060 -23000 M -11820 -23000 M -(} ;) h -300 -24400 M -300 -25800 M -179.5 0 32 (This change in size is an important consideration if you are sharing data defined in) W -300 -27200 M -12.7 0 32 (structures between 32\255bit and 64\255bit systems. Be careful about using longs and point\255) W -300 -28600 M -89.1 0 32 (ers as members in shared structures. These data types now introduce sizes that are) W -300 -30000 M -216.4 0 32 (not available on 32\255bit systems. One of the most portable methods is to only use) W -300 -31400 M -136.3 0 32 (typedef types in structures and set up the types as appropriate for the system. You) W -300 -32800 M -(can automatically do this by utilizing information in the limits.h header file. ) h -300 -34200 M -300 -35600 M -191.9 0 32 (Additionally, you should be careful when building unions between ints and pointers,) W -300 -37000 M -(since they are no longer the same size. ) h -300 -38400 M -300 -41300 M -/Helvetica-Bold-ISOLatin1 F 1200 o f -(Structure Member Alignment) h -300 -43300 M -/Helvetica-ISOLatin1 F 1200 o f -107.2 0 32 (Members of structures and unions are aligned on their "natural" boundaries. That is,) W -300 -44700 M -251.9 0 32 (char is aligned on a byte boundary, short on a word boundary, int on a longword) W -300 -46100 M -(boundary, and longs and pointers on quadword boundaries. ) h -300 -47500 M -6060 -47500 M -300 -48900 M -65.2 0 32 (This means that additional space will be used for padding member alignment in struc\255) W -300 -50300 M -(tures and unions.) h -300 -52300 M -6060 -52300 M -(struct TextCountNode {) h -300 -53700 M -6060 -53700 M -( char *text; ) h -300 -55100 M -6060 -55100 M -( int size,) h -300 -56500 M -6060 -56500 M -( struct TextCountNode *left;) h -300 -57900 M -6060 -57900 M -( struct TextCountNode *right;) h -29100 -57900 M -300 -59300 M -6060 -59300 M -(};) h -300 -60700 M -300 -62100 M -132.1 0 32 (On 32\255bit systems the size of this structure would be 16 bytes. On 64\255bit Alpha sys\255) W -300 -63500 M -61.4 0 32 (tems the size of the structure would be 32 bytes: 8 bytes for each pointer and 4 bytes) W --7200 7200 T -R - -showpage -$P e - -%%Page: 6 6 -/$P a D -g N -0 79200 T -S -R -S -7200 -7200 T -N -0 G -300 -1200 M -/Helvetica-ISOLatin1 $ -/Helvetica & P -/Helvetica-ISOLatin1 F 1200 o f -(of padding after the member, ) h -/Helvetica-Bold-ISOLatin1 $ -/Helvetica-Bold & P -/Helvetica-Bold-ISOLatin1 F 1200 o f -(size) h -/Helvetica-ISOLatin1 F 1200 o f -(, for the alignment of the pointer, ) h -/Helvetica-Bold-ISOLatin1 F 1200 o f -(left.) h -40620 -1200 M -300 -3200 M -/Helvetica-ISOLatin1 F 1200 o f -167.5 0 32 (Additional padding may also be introduced at the end of structure, to assure proper) W -300 -4600 M -29.4 0 32 (structure alignment for arrays of these structures. The structure must terminate on the) W -300 -6000 M -(same alignment boundary on which it started.) h -300 -7400 M -300 -8800 M -101.1 0 32 (Given these additional alignment considerations, you should always use) W -/Helvetica-Oblique-ISOLatin1 $ -/Helvetica-Oblique & P -/Helvetica-Oblique-ISOLatin1 F 1200 o f -101.1 0 32 ( sizeof) W -/Helvetica-ISOLatin1 F 1200 o f -101.1 0 32 ( to de\255) W -300 -10200 M -132.2 0 32 (termine the size of a structure. Don't assume the size of a structure is the accumu\255) W -300 -11600 M -80.2 0 32 (lated size of all of the objects defined in it. Additional space will be taken up for pad\255) W -300 -13000 M -(ding the member alignment. ) h -300 -15000 M -155.7 0 32 (To minimize the amount of padded needed, you may want to reorder members in a) W -300 -16400 M -(structure. For example, ) h -300 -18400 M -6060 -18400 M -(struct s {) h -300 -19800 M -6060 -19800 M -11820 -19800 M -(int count;) h -300 -21200 M -6060 -21200 M -11820 -21200 M -(struct s *next;) h -300 -22600 M -6060 -22600 M -11820 -22600 M -(int total;) h -300 -24000 M -6060 -24000 M -(}) h -300 -26000 M -(has a ) h -/Helvetica-Oblique-ISOLatin1 F 1200 o f -(sizeo) h -/Helvetica-ISOLatin1 F 1200 o f -(f 24 bytes. This definition can be recoded to ) h -300 -27400 M -6060 -27400 M -300 -28800 M -6060 -28800 M -(struct s{) h -300 -30200 M -6060 -30200 M -11820 -30200 M -(struct s *next;) h -300 -31600 M -6060 -31600 M -11820 -31600 M -(int count;) h -300 -33000 M -6060 -33000 M -11820 -33000 M -(int total;) h -300 -34400 M -6060 -34400 M -(}) h -300 -36400 M -(Which has a ) h -/Helvetica-Oblique-ISOLatin1 F 1200 o f -(sizeof) h -/Helvetica-ISOLatin1 F 1200 o f -( 16 bytes.) h -300 -37800 M -300 -39200 M -300 -42100 M -/Helvetica-Bold-ISOLatin1 F 1200 o f -(Structure Alignment) h -300 -44100 M -/Helvetica-ISOLatin1 F 1200 o f -240.7 0 32 (In order to have specific members aligned on their required boundaries, structures) W -300 -45500 M -(themselves need to have the alignment of the strictest aligned member. ) h -300 -47500 M -6060 -47500 M -(struct {) h -11820 -47500 M -300 -48900 M -6060 -48900 M -11820 -48900 M -(char *text;) h -300 -50300 M -6060 -50300 M -11820 -50300 M -(int count;) h -300 -51700 M -6060 -51700 M -11820 -51700 M -(} CountedString;) h -300 -53700 M -300 -55100 M -13.1 0 32 (In the example above, the sizeof\() W -/Helvetica-Bold-ISOLatin1 F 1200 o f -13.1 0 32 (CountedString) W -/Helvetica-ISOLatin1 F 1200 o f -13.1 0 32 (\) is 16 bytes \(*) W -/Helvetica-Bold-ISOLatin1 F 1200 o f -13.1 0 32 (text) W -/Helvetica-ISOLatin1 F 1200 o f -13.1 0 32 ( = 8 bytes,) W -/Helvetica-Bold-ISOLatin1 F 1200 o f -13.1 0 32 ( count) W -/Helvetica-ISOLatin1 F 1200 o f -13.1 0 32 ( =) W -300 -56500 M -158.9 0 32 (4 bytes, tail padding = 4 bytes.\) This structure needs to be aligned on a quadword) W -300 -57900 M -31.5 0 32 (boundary because the pointer requires quadword alignment. This means that a defini\255) W -300 -59300 M -32.3 0 32 (tion that has ) W -/Helvetica-Bold-ISOLatin1 F 1200 o f -32.3 0 32 (CountedString) W -/Helvetica-ISOLatin1 F 1200 o f -32.3 0 32 ( as a member will have each reference to ) W -/Helvetica-Bold-ISOLatin1 F 1200 o f -32.3 0 32 (CountedString) W -300 -60700 M -/Helvetica-ISOLatin1 F 1200 o f -(on a quadword boundary.) h -300 -62700 M -6060 -62700 M -(CountedString CsArray[10]) h --7200 7200 T -R - -showpage -$P e - -%%Page: 7 7 -/$P a D -g N -0 79200 T -S -R -S -7200 -7200 T -N -0 G -300 -1200 M -6060 -1200 M -/Helvetica-ISOLatin1 $ -/Helvetica & P -/Helvetica-ISOLatin1 F 1200 o f -(struct {) h -300 -2600 M -6060 -2600 M -11820 -2600 M -(char line[MAX_LINE];) h -300 -4000 M -6060 -4000 M -11820 -4000 M -(struct CountedString string;) h -300 -5400 M -6060 -5400 M -(}TextAndString;) h -300 -7400 M -165.2 0 32 (In each of the above examples, the ) W -/Helvetica-Bold-ISOLatin1 $ -/Helvetica-Bold & P -/Helvetica-Bold-ISOLatin1 F 1200 o f -165.2 0 32 (CountedString) W -/Helvetica-ISOLatin1 F 1200 o f -165.2 0 32 ( structure will force alignment of) W -300 -8800 M -53.4 0 32 (the beginning of the structure to be on a quadword boundary. In the first declaration) W -300 -10200 M -162.3 0 32 (above, no additional padding \(beyond 4 bytes of tail padding\) will be introduced be\255) W -300 -11600 M -29.4 0 32 (cause ) W -/Helvetica-Bold-ISOLatin1 F 1200 o f -29.4 0 32 (CountedString) W -/Helvetica-ISOLatin1 F 1200 o f -29.4 0 32 ( will naturally align on a quadword boundary. In the second, ad\255) W -300 -13000 M -40.3 0 32 (ditional padding maybe introduced \(depending upon the value of MAX_LINE\) to insure) W -300 -14400 M -(proper quadword alignment for the structure member, ) h -/Helvetica-Bold-ISOLatin1 F 1200 o f -(string) h -/Helvetica-ISOLatin1 F 1200 o f -(.) h -300 -15800 M -300 -18700 M -/Helvetica-Bold-ISOLatin1 F 1200 o f -(Variable Declarations) h -300 -20100 M -6060 -20100 M -300 -22100 M -/Helvetica-ISOLatin1 F 1200 o f -60.6 0 32 (With the changes in ) W -/Helvetica-Oblique-ISOLatin1 $ -/Helvetica-Oblique & P -/Helvetica-Oblique-ISOLatin1 F 1200 o f -60.6 0 32 (long ) W -/Helvetica-ISOLatin1 F 1200 o f -60.6 0 32 (and pointer type you should be careful to code your applica\255) W -300 -23500 M -14.4 0 32 (tion so that it can work on both 32\255bit and 64\255bit systems. Check your ) W -/Helvetica-Oblique-ISOLatin1 F 1200 o f -14.4 0 32 (int) W -/Helvetica-ISOLatin1 F 1200 o f -14.4 0 32 ( and ) W -/Helvetica-Oblique-ISOLatin1 F 1200 o f -14.4 0 32 (long) W -/Helvetica-ISOLatin1 F 1200 o f -14.4 0 32 ( dec\255) W -300 -24900 M -163.4 0 32 (larations. If you have specific variables that you need to be 32 bits in size on both) W -300 -26300 M -96.5 0 32 (DEC OSF/1 on MIPS and Alpha then define the type to be ) W -/Helvetica-Oblique-ISOLatin1 F 1200 o f -96.5 0 32 (int.) W -/Helvetica-ISOLatin1 F 1200 o f -96.5 0 32 ( If the variable should) W -300 -27700 M -35.6 0 32 (be 32 bits on DEC OSF/1 on MIPS and 64 bits on Alpha then define the variable to be) W -300 -29100 M -/Helvetica-Oblique-ISOLatin1 F 1200 o f -128.1 0 32 (long) W -/Helvetica-ISOLatin1 F 1200 o f -128.1 0 32 (. Remember if the type specifier is missing from a declaration, it defaults to) W -/Helvetica-Oblique-ISOLatin1 F 1200 o f -128.1 0 32 ( int) W -300 -30500 M -/Helvetica-ISOLatin1 F 1200 o f -60.9 0 32 (type. For example, here are six declarations which declare the variables to be of size ) W -300 -31900 M -/Helvetica-Oblique-ISOLatin1 F 1200 o f -(int ) h -/Helvetica-ISOLatin1 F 1200 o f -(and the function to be returning type) h -/Helvetica-Oblique-ISOLatin1 F 1200 o f -( int) h -/Helvetica-ISOLatin1 F 1200 o f -(. ) h -300 -33300 M -6060 -33300 M -300 -34700 M -6060 -34700 M -(extern e;) h -300 -36100 M -6060 -36100 M -(register n;) h -300 -37500 M -6060 -37500 M -(static x;) h -300 -38900 M -6060 -38900 M -(unsigned i;) h -17580 -38900 M -300 -40300 M -6060 -40300 M -(const c;) h -300 -41700 M -6060 -41700 M -(funtion\(\);) h -300 -43100 M -300 -46000 M -/Helvetica-Bold-ISOLatin1 F 1200 o f -(Bit\255Fields) h -300 -48000 M -/Helvetica-ISOLatin1 F 1200 o f -105.5 0 32 (Bit fields are allowed on any integral type on Alpha. \(ANSI C only requires, bit\255fields) W -300 -49400 M -132.1 0 32 (with int, signed int, and unsigned int types.\) In a C declaration, if a bit\255field immedi\255) W -300 -50800 M -34.5 0 32 (ately follows another in a structure declaration the following bit\255field will be packed into) W -300 -52200 M -41.7 0 32 (adjacent bits of the former unit. Since long is now 64 bits in length on Alpha, adjacent) W -300 -53600 M -92.9 0 32 (declarations of bit\255fields of type long may contain multiple bit\255field definitions in cases) W -300 -55000 M -136.5 0 32 (that previously did not on RISC or VAX. This change may cause different results in) W -300 -56400 M -348.3 0 32 (operations on these bit\255fields. To insure the same behavior when porting code,) W -300 -57800 M -(change bit\255field definitions of type ) h -/Helvetica-Oblique-ISOLatin1 F 1200 o f -(long) h -/Helvetica-ISOLatin1 F 1200 o f -( to ) h -/Helvetica-Oblique-ISOLatin1 F 1200 o f -(int) h -/Helvetica-ISOLatin1 F 1200 o f -(.) h --7200 7200 T -R - -showpage -$P e - -%%Page: 8 8 -/$P a D -g N -0 79200 T -S -R -S -7200 -7200 T -N -0 G -300 -1350 M -/Helvetica-Bold-ISOLatin1 $ -/Helvetica-Bold & P -/Helvetica-Bold-ISOLatin1 F 1400 o f -(Statements and Expressions) h -300 -4900 M -n 0.857 o f -(Variable Assignments and Function Arguments) h -300 -6900 M -/Helvetica-ISOLatin1 $ -/Helvetica & P -/Helvetica-ISOLatin1 F 1200 o f -(On DEC OSF/1 Alpha, since) h -/Helvetica-Oblique-ISOLatin1 $ -/Helvetica-Oblique & P -/Helvetica-Oblique-ISOLatin1 F 1200 o f -( int) h -/Helvetica-ISOLatin1 F 1200 o f -( and ) h -/Helvetica-Oblique-ISOLatin1 F 1200 o f -(long) h -/Helvetica-ISOLatin1 F 1200 o f -( are no longer defined to be the same size, ) h -300 -8300 M -111.2 0 32 (you can not freely interchange their use without the possibility of truncation of signifi\255) W -300 -9700 M -65.4 0 32 (cant digits. Use the lint utility to help you find these problems. You should avoid as\255) W -300 -11100 M -(signments such as ) h -300 -12500 M -300 -13900 M -6060 -13900 M -(int i;) h -300 -15300 M -6060 -15300 M -(long l;) h -300 -17300 M -6060 -17300 M -(i = l;) h -300 -18700 M -300 -20100 M -(Also, you should avoid passing long arguments to functions expecting type ) h -/Helvetica-Oblique-ISOLatin1 F 1200 o f -(int) h -/Helvetica-ISOLatin1 F 1200 o f -(. ) h -300 -21500 M -300 -22900 M -6060 -22900 M -(int toascii\(int\); ) h -300 -24300 M -6060 -24300 M -(int i;) h -300 -25700 M -6060 -25700 M -(long l;) h -300 -27700 M -6060 -27700 M -(i= toascii\(l\) ) h -300 -29100 M -300 -30500 M -300 -31900 M -93.6 0 32 (Pointers and ints should not be freely exchanged on DEC OSF/1 Alpha. Assigning a) W -300 -33300 M -81.8 0 32 (pointer to an int, then assigning back to a pointer, and dereferencing the pointer will) W -300 -34700 M -(result in a bus error. ) h -300 -36100 M -6060 -36100 M -300 -37500 M -6060 -37500 M -(int i ;) h -300 -38900 M -6060 -38900 M -(char *buffer;) h -300 -40900 M -6060 -40900 M -(buffer = \(char *\)malloc\(MAX_LINE\)) h -300 -42300 M -6060 -42300 M -(i = \(int\)buffer;) h -17580 -42300 M -300 -43700 M -6060 -43700 M -(buffer = \(char*\)i;) h -300 -45100 M -300 -46500 M -151.1 0 32 (Similarly, passing a pointer to a function expecting an ) W -/Helvetica-Oblique-ISOLatin1 F 1200 o f -151.1 0 32 (int ) W -/Helvetica-ISOLatin1 F 1200 o f -151.1 0 32 (argument will result in lost) W -300 -47900 M -(information.) h -300 -49300 M -6060 -49300 M -(void f\(\);) h -300 -50700 M -6060 -50700 M -(char *cp;) h -300 -52700 M -6060 -52700 M -(f\(cp\);) h -11820 -52700 M -17580 -52700 M -300 -54100 M -300 -55500 M -70.7 0 32 (This nonportable function declaration will produce a compiler warning if you use ANSI) W -300 -56900 M -(C prototypes, such as: ) h -300 -58300 M -300 -59700 M -6060 -59700 M -(void f\(int\); ) h -300 -61100 M -6060 -61100 M -(char *cp;) h -300 -63100 M -6060 -63100 M -(f\(cp\); ) h --7200 7200 T -R - -showpage -$P e - -%%Page: 9 9 -/$P a D -g N -0 79200 T -S -R -S -7200 -7200 T -N -0 G -300 -1200 M -300 -2600 M -/Helvetica-ISOLatin1 $ -/Helvetica & P -/Helvetica-ISOLatin1 F 1200 o f -161.1 0 32 (You can also find these pointer to int assignments by using the \255h flag of the lint\(1\)) W -300 -4000 M -248.5 0 32 (command, which will find pointer to ) W -/Helvetica-Oblique-ISOLatin1 $ -/Helvetica-Oblique & P -/Helvetica-Oblique-ISOLatin1 F 1200 o f -248.5 0 32 (int) W -/Helvetica-ISOLatin1 F 1200 o f -248.5 0 32 ( argument passing and assignments. Even) W -300 -5400 M -106.7 0 32 (though a pointer can be converted to a type ) W -/Helvetica-Oblique-ISOLatin1 F 1200 o f -106.7 0 32 (long) W -/Helvetica-ISOLatin1 F 1200 o f -106.7 0 32 ( on Alpha without a loss of informa\255) W -300 -6800 M -(tion, you should use the ) h -/Helvetica-Oblique-ISOLatin1 F 1200 o f -(void * ) h -/Helvetica-ISOLatin1 F 1200 o f -(type if you need to use a generic pointer type.) h -300 -8200 M -300 -9600 M -4.5 0 32 (Additionally, watch out for poor programming practices such as different multiple defini\255) W -300 -11000 M -30.1 0 32 (tions of the same object. For instance, two structures that are used in different areas) W -300 -12400 M -(of your code to refer to the same object in different ways. Such as) h -300 -14400 M -6060 -14400 M -(struct node {) h -300 -15800 M -6060 -15800 M -( int src_addr, dst_addr; ) h -300 -17200 M -6060 -17200 M -( char *name; ) h -300 -18600 M -6060 -18600 M -( } ; ) h -300 -20000 M -300 -22000 M -6060 -22000 M -(struct node {) h -300 -23400 M -6060 -23400 M -( struct node *src, *dst;) h -300 -24800 M -6060 -24800 M -( char * name;) h -300 -26200 M -6060 -26200 M -( }) h -300 -28200 M -300 -29600 M -79.3 0 32 (This type of nonstandard coding should be replace with a union declaration. Be thor\255) W -300 -31000 M -136.4 0 32 (ough when porting this type of code to a 64\255bit system, the interdependency and in\255) W -300 -32400 M -(compatibilities between these two structures may be difficult to find. ) h -300 -33800 M -300 -35200 M -/Helvetica-Bold-ISOLatin1 $ -/Helvetica-Bold & P -/Helvetica-Bold-ISOLatin1 F 1200 o f -(Integer and Long Constants \255 Assignment and Argument Passing) h -300 -36600 M -300 -38000 M -/Helvetica-ISOLatin1 F 1200 o f -77.7 0 32 (In C, an integer constant is specified like, 543210. To specify a long int constant you) W -300 -39400 M -59.3 0 32 (use the suffix L or l. To specify a unsigned long you use the UL or ul suffix. \(L is pre\255) W -300 -40800 M -113.0 0 32 (ferred since l is easily confused with 1\). Note the example where three different con\255) W -300 -42200 M -(stants are passed to the function, ) h -/Helvetica-Oblique-ISOLatin1 F 1200 o f -(labs\(\)) h -/Helvetica-ISOLatin1 F 1200 o f -(: ) h -300 -44200 M -6060 -44200 M -(labs\(543210\)) h -300 -45600 M -6060 -45600 M -(labs\(543210L\)) h -300 -47000 M -6060 -47000 M -(labs\(543210UL\)) h -300 -48400 M -300 -49800 M -127.7 0 32 (On DEC OSF/1 on MIPS, 543210 would be passed as a 4 byte constant in all three) W -300 -51200 M -35.6 0 32 (examples. On an Alpha system , 543210 would be treated as a 4 byte constant, and) W -300 -52600 M -162.7 0 32 (543210L or 543210UL would be treated as a 8 byte constant. If the ) W -/Helvetica-Oblique-ISOLatin1 F 1200 o f -162.7 0 32 (labs\(\) ) W -/Helvetica-ISOLatin1 F 1200 o f -162.7 0 32 (function) W -300 -54000 M -214.8 0 32 (was expecting a ) W -/Helvetica-Oblique-ISOLatin1 F 1200 o f -214.8 0 32 (long) W -/Helvetica-ISOLatin1 F 1200 o f -214.8 0 32 ( argument each of these invocations would work as expected) W -300 -55400 M -96.1 0 32 (since the ) W -/Helvetica-Oblique-ISOLatin1 F 1200 o f -96.1 0 32 (int ) W -/Helvetica-ISOLatin1 F 1200 o f -96.1 0 32 (constants would be converted to ) W -/Helvetica-Oblique-ISOLatin1 F 1200 o f -96.1 0 32 (long.) W -/Helvetica-ISOLatin1 F 1200 o f -96.1 0 32 ( Problems happen if the function) W -300 -56800 M -/Helvetica-Oblique-ISOLatin1 F 1200 o f -65.1 0 32 (labs\(\) ) W -/Helvetica-ISOLatin1 F 1200 o f -65.1 0 32 (was expecting type int. In this case the long constant would be truncated to an) W -300 -58200 M -38.7 0 32 (integer constant. This truncation would result in the loss of significant digits if the con\255) W -300 -59600 M -31.5 0 32 (stant was greater then maximum integer constant \(INT_MAX\) of +2147483647, or less) W -300 -61000 M -161.9 0 32 (then the minimum integer constant \(INT_MIN\) of \2552147483648, or for unsigned con\255) W -300 -62400 M -672.2 0 32 (stants greater then the maximum unsigned integer constant \(UINT_MAX\) of) W -300 -63800 M -37.1 0 32 (4294967295. This problem would also be present in an assignment expression where) W --7200 7200 T -R - -showpage -$P e - -%%Page: 10 10 -/$P a D -g N -0 79200 T -S -R -S -7200 -7200 T -N -0 G -300 -1200 M -/Helvetica-ISOLatin1 $ -/Helvetica & P -/Helvetica-ISOLatin1 F 1200 o f -158.0 0 32 (a long integer constant was assigned to a variable of type int. In these cases it is) W -300 -2600 M -74.3 0 32 (important to explicitly use the L or UL suffix and make sure the function arguments or) W -300 -4000 M -(variables being assigned to are of the appropriate ) h -/Helvetica-Oblique-ISOLatin1 $ -/Helvetica-Oblique & P -/Helvetica-Oblique-ISOLatin1 F 1200 o f -(long) h -/Helvetica-ISOLatin1 F 1200 o f -( type.) h -300 -6000 M -86.0 0 32 (It is also important to note that when you are passing zero to a pointer argument and) W -300 -7400 M -56.7 0 32 (no function prototype is visible, always use NULL \(Defined in stdio.h\). Using) W -/Helvetica-Oblique-ISOLatin1 F 1200 o f -56.7 0 32 ( 0 ) W -/Helvetica-ISOLatin1 F 1200 o f -56.7 0 32 (will re\255) W -300 -8800 M -42.3 0 32 (sult in using a 4 byte zero instead of a 8 byte zero \(0L\). \(In a comparison, an assign\255) W -300 -10200 M -118.7 0 32 (ment, or a function call where the correct function prototype is in scope, standard C) W -300 -11600 M -(promotion rules will be in effect and the correct value will be assigned.\)) h -300 -13000 M -300 -15900 M -/Helvetica-Bold-ISOLatin1 $ -/Helvetica-Bold & P -/Helvetica-Bold-ISOLatin1 F 1200 o f -(Integer and Long Constants \255 Shift operations) h -300 -17900 M -/Helvetica-ISOLatin1 F 1200 o f -104.5 0 32 (A bit shift operation on a integer constant will yield an 32\255bit constant. If you need a) W -300 -19300 M -96.6 0 32 (result of type long then you need to use the L or UL suffix for long integer constants. ) W -300 -20700 M -(For example, ) h -300 -22100 M -300 -23500 M -6060 -23500 M -(long value;) h -300 -24900 M -300 -26300 M -6060 -26300 M -(value = 10 << 2; ) h -17580 -26300 M -300 -28300 M -300 -29700 M -2.9 0 32 (results in ) W -/Helvetica-Bold-ISOLatin1 F 1200 o f -2.9 0 32 (value) W -/Helvetica-ISOLatin1 F 1200 o f -2.9 0 32 ( getting assigned a 32\255bit constant. The top 32 bits of ) W -/Helvetica-Bold-ISOLatin1 F 1200 o f -2.9 0 32 (value) W -/Helvetica-ISOLatin1 F 1200 o f -2.9 0 32 ( will depend) W -300 -31100 M -157.0 0 32 (on the type of the value shifted. Signed values are sign\255extended; unsigned values) W -300 -32500 M -9.2 0 32 (are zero extended. If you want a 64\255bit constant then be sure to use the L or UL suffix.) W -300 -33900 M -15.1 0 32 (\(Note that only the left operand of a shift operator determines the result type. The type) W -300 -35300 M -(of shift count operand is irrelevant.\) ) h -300 -38200 M -/Helvetica-Bold-ISOLatin1 F 1200 o f -(Sizeof expression) h -300 -40200 M -/Helvetica-ISOLatin1 F 1200 o f -73.2 0 32 (The result of the ) W -/Helvetica-Oblique-ISOLatin1 F 1200 o f -73.2 0 32 (sizeof) W -/Helvetica-ISOLatin1 F 1200 o f -73.2 0 32 ( operator is of type ) W -/Helvetica-Bold-ISOLatin1 F 1200 o f -73.2 0 32 (size_t) W -/Helvetica-ISOLatin1 F 1200 o f -73.2 0 32 (, which is of an ) W -/Helvetica-Oblique-ISOLatin1 F 1200 o f -73.2 0 32 (unsigned ) W -73.2 0 32 (long) W -/Helvetica-ISOLatin1 F 1200 o f -73.2 0 32 ( on Al\255) W -300 -41600 M -(pha. ) h -300 -44500 M -/Helvetica-Bold-ISOLatin1 F 1200 o f -(Pointer Subtraction) h -300 -46500 M -/Helvetica-ISOLatin1 F 1200 o f -36.4 0 32 (The length of the integer required to hold the difference between two pointers to mem\255) W -300 -47900 M -(bers of the same array, ptrdiff_t \(stddef.h\), is an ) h -/Helvetica-Oblique-ISOLatin1 F 1200 o f -(signed long) h -/Helvetica-ISOLatin1 F 1200 o f -( on Alpha.) h -300 -49300 M -300 -52200 M -/Helvetica-Bold-ISOLatin1 F 1200 o f -(Functions with a variable number of arguments) h -300 -54200 M -/Helvetica-ISOLatin1 F 1200 o f -149.8 0 32 (When writing a routine that receives a variable \(context\255dependent\) number of argu\255) W -300 -55600 M -147.5 0 32 (ments you must use the stdargs \(stdarg.h\) or varargs \(varargs.h\) mechanism. See) W -300 -57000 M -(the varargs\(3\) reference page for more information on the use of these macros. ) h -300 -58400 M --7200 7200 T -R - -showpage -$P e - -%%Page: 11 11 -/$P a D -g N -0 79200 T -S -R -S -7200 -7200 T -N -0 G -300 -1350 M -/Helvetica-Bold-ISOLatin1 $ -/Helvetica-Bold & P -/Helvetica-Bold-ISOLatin1 F 1400 o f -(Library Calls) h -300 -4900 M -n 0.857 o f -(printf, scanf functions) h -300 -6900 M -300 -8300 M -/Helvetica-ISOLatin1 $ -/Helvetica & P -/Helvetica-ISOLatin1 F 1200 o f -122.0 0 32 (When using the printf\255type function conversion specifiers for longs use the "l" \(lower\255) W -300 -9700 M -149.7 0 32 (case letter L\) size specification, with the d, u, o, and x operations to specify assign\255) W -300 -11100 M -23.6 0 32 (ment of type long or unsigned long. For instance, when printing a long as signed deci\255) W -300 -12500 M -131.9 0 32 (mal use the %ld instead of %d, when printing a long as a unsigned decimal use the) W -300 -13900 M -6.1 0 32 (%lu instead of %u. If the letter l size specification is not used the type is assumed to be) W -300 -15300 M -98.3 0 32 (int, unsigned int, or int * depending upon the conversion specification. In which case) W -300 -16700 M -(the long types will be converted to the smaller int types and information may be lost. ) h -300 -18700 M -14.4 0 32 (When printing a pointer use %p. If you want to print the pointer as a specific represen\255) W -300 -20100 M -141.1 0 32 (tation then the pointer should be cast to an appropriate integer type \(long for Alpha\)) W -300 -21500 M -32.0 0 32 (before using the desired format specifier. For example, to print a pointer as a long un\255) W -300 -22900 M -(signed decimal number use %lu: ) h -300 -24900 M -6060 -24900 M -(char *p;) h -300 -26900 M -6060 -26900 M -(printf \( "%p %lu\\n", \(void *\)p, \(long\)p \);) h -300 -28300 M -300 -29700 M -85.1 0 32 (For a portable way to print an integer of arbitrary size, case the integer to long or un\255) W -300 -31100 M -(signed long, then use the %L conversion specifier. For example:) h -300 -33100 M -6060 -33100 M -(printf \("%ld\\n", \(unsigned long\) sizeof \(num\)\);) h -300 -34500 M -300 -37400 M -/Helvetica-Bold-ISOLatin1 F 1200 o f -(malloc, calloc functions) h -300 -38800 M -300 -40800 M -/Helvetica-ISOLatin1 F 1200 o f -59.5 0 32 (Memory allocation library functions such as ) W -/Helvetica-Oblique-ISOLatin1 $ -/Helvetica-Oblique & P -/Helvetica-Oblique-ISOLatin1 F 1200 o f -59.5 0 32 (ma) W -/Helvetica-ISOLatin1 F 1200 o f -59.5 0 32 (lloc guarantee to return data aligned to) W -300 -42200 M -79.7 0 32 (the maximum alignment of any object. On Alpha, ) W -/Helvetica-Oblique-ISOLatin1 F 1200 o f -79.7 0 32 (malloc) W -/Helvetica-ISOLatin1 F 1200 o f -79.7 0 32 ( returns a pointer to memory) W -300 -43600 M -(that is quadword aligned.) h -300 -46500 M -/Helvetica-Bold-ISOLatin1 F 1200 o f -(lseek function) h -300 -48500 M -/Helvetica-ISOLatin1 F 1200 o f -2.7 0 32 (When calling the) W -/Helvetica-Oblique-ISOLatin1 F 1200 o f -2.7 0 32 ( lseek ) W -/Helvetica-ISOLatin1 F 1200 o f -2.7 0 32 (system call for setting the current position in a file, use the ) W -/Helvetica-Oblique-ISOLatin1 F 1200 o f -2.7 0 32 (off_t) W -300 -49900 M -/Helvetica-ISOLatin1 F 1200 o f -6.1 0 32 (type defined in ) W -/Helvetica-Oblique-ISOLatin1 F 1200 o f -6.1 0 32 (types.h) W -/Helvetica-ISOLatin1 F 1200 o f -6.1 0 32 ( for the file offset. Passing an int or long constant may work but) W -300 -51300 M -69.4 0 32 (it is not the portable and is not guarantee to continue to work. The following example) W -300 -52700 M -(shows correct uses of ) h -/Helvetica-Oblique-ISOLatin1 F 1200 o f -(lseek) h -/Helvetica-ISOLatin1 F 1200 o f -(.) h -300 -54100 M -300 -55500 M -( lseek function: ) h -300 -56900 M -300 -58300 M -6060 -58300 M -(#include <unistd.h>) h -300 -59700 M -6060 -59700 M -300 -61100 M -6060 -61100 M -(off_t offset, pos;) h -300 -62500 M -( ...) h -300 -63900 M -6060 -63900 M -(pos = lseek\( fd, offset, SEEK_SET \);) h --7200 7200 T -R - -showpage -$P e - -%%Page: 12 12 -/$P a D -g N -0 79200 T -S -R -S -7200 -7200 T -N -0 G -300 -1200 M -6060 -1200 M -/Helvetica-ISOLatin1 $ -/Helvetica & P -/Helvetica-ISOLatin1 F 1200 o f -(pos = lseek\( fd, \(off_t\)0, SEEK_CUR\);) h -300 -2600 M -300 -4000 M -300 -6900 M -/Helvetica-Bold-ISOLatin1 $ -/Helvetica-Bold & P -/Helvetica-Bold-ISOLatin1 F 1200 o f -(fsetpos, fgetpos functions) h -300 -8900 M -/Helvetica-ISOLatin1 F 1200 o f -19.5 0 32 (When setting or getting the file postions for a file with the ANSI C functions of ) W -/Helvetica-Oblique-ISOLatin1 $ -/Helvetica-Oblique & P -/Helvetica-Oblique-ISOLatin1 F 1200 o f -19.5 0 32 (fsetpos\(\)) W -300 -10300 M -/Helvetica-ISOLatin1 F 1200 o f -94.5 0 32 (or) W -/Helvetica-Oblique-ISOLatin1 F 1200 o f -94.5 0 32 ( fgetpos\(\)) W -/Helvetica-ISOLatin1 F 1200 o f -94.5 0 32 ( respectively, the file position is specified by a value of type ) W -/Helvetica-Oblique-ISOLatin1 F 1200 o f -94.5 0 32 (fpos_t) W -/Helvetica-ISOLatin1 F 1200 o f -94.5 0 32 (. This) W -300 -11700 M -(type is defined as a) h -/Helvetica-Oblique-ISOLatin1 F 1200 o f -( long) h -/Helvetica-ISOLatin1 F 1200 o f -( on Alpha. ) h -300 -15350 M -/Helvetica-Bold-ISOLatin1 F 1400 o f -(D) h -(evelopment Tools) h -300 -18000 M -/Helvetica-ISOLatin1 F 1200 o f -111.4 0 32 (The DEC OSF/1 Alpha system supplies a number of development tools that help mi\255) W -300 -19400 M -70.2 0 32 (grate applications to this 64\255bit system. These include an enhanced lint tools, special) W -300 -20800 M -(linker flags to help with truncation of 64\255bit addresses, and a 32\255bit compatibility mode.) h -300 -23700 M -/Helvetica-Bold-ISOLatin1 F 1200 o f -(lint) h -300 -25700 M -/Helvetica-ISOLatin1 F 1200 o f -65.1 0 32 (The lint\(1\) utility on both DEC OSF/1 MIPS and Alpha have been enhanced to find int) W -300 -27100 M -(and pointer assignments and argument passing. ) h -300 -28500 M -300 -31400 M -/Helvetica-Bold-ISOLatin1 F 1200 o f -(ld) h -300 -33400 M -/Helvetica-ISOLatin1 F 1200 o f -132.0 0 32 (The Alpha linker, ld\(1\), loads the program text and data in the high 64 bit virtual ad\255) W -300 -34800 M -94.6 0 32 (dress space of the process by default. This means that no valid addresses will be in) W -300 -36200 M -13.5 0 32 (the range of the 32\255bit address. Therefore. unintended pointer truncations will trap into) W -300 -37600 M -60.9 0 32 (the kernel and cause a runtime error. This diagnostic feature assists in porting appli\255) W -300 -39000 M -77.9 0 32 (cations from 32 bit to 64 bit environments. To override this behavior you can use the) W -300 -40400 M -(\255T/\255D ld options to move the program in the address space. ) h -300 -42400 M -300 -44400 M -300 -46400 M -( ) h -300 -48400 M -300 -49498 M -300 -50815 M --7200 7200 T -R - -showpage -$P e - -%%Trailer -$D restore -end % DEC_WRITE_dict -%%Pages: 12 -%%DocumentFonts: Helvetica-Bold-ISOLatin1 -%%+ Helvetica-ISOLatin1 -%%+ Symbol -%%+ Times-Roman-ISOLatin1 -%%+ Helvetica-Oblique-ISOLatin1 diff --git a/hlp/batch.txt b/hlp/batch.txt deleted file mode 100644 index bcedc4e6a8807a468500ae17878be27419201791..0000000000000000000000000000000000000000 --- a/hlp/batch.txt +++ /dev/null @@ -1,321 +0,0 @@ -Betreft: -Batch processing in Newstar ---------------------------- - -Waarde heren, - -Ik heb wat details van DWARF opgespoord ten behoeve van automatische -processing. Hieronder volgt een voorlopig overzicht. Een aantal zaken -staat al in het Cookbook: Program Descriptions, Common. - - -1e. DWARF Keywords, streams ---------------------------- - -Een gebruiker heeft invloed op de werking van een Newstar programma via -de DWARF user-interface. Alle grootheden/parameters die een gebruiker -in principe kan specificeren corresponderen met keywords, die een -waarde hebben. Die waarde kan op een aantal niveaus bepaald worden: - - 1e. Interne of program defaults: - De programmeur heeft een default waarde meegegeven bij de - definitie van het keyword (in de zgn. PIN-file). In een - (beperkt) aantal gevallen staat er geen default in de PIN-file - maar geeft het programma zelf een default mee. - - 2e. Externe defaults: - De gebruiker heeft, buiten het programma om, een waarde - gegeven aan het keyword door een DWARF symbool te definieren - (met dwspecify, met dwrestore, of door het programma eerder - te gebruiken met de /SAVE switch) - -Voor een aantal algemene keywords wordt de externe default op twee -plaatsten gezocht: eerst in een tabel met defaults voor het programma -(de "local" external default), als daar geen waarde staat in de algemene -tabel (de external default van "NGEN"). - - 3e. Het programma prompt de gebruiker voor het keyword en krijgt - een waarde via toetsenbord of input-file. - -Normaliter gaan de antwoorden die de user geeft op keyword prompts verloren -wanneer het programma wordt verlaten. Er zijn twee manieren om een keyword -te bewaren (alsof het met dwspecify was gegeven): - - - Voor alle keywords de waarde bewaren: start programma met - dwe <programma> /SAVE - - - Voor individuele keywords de waarde bewaren: geef na de prompt - waarde /SAVE [/[NO]ASK] (zie ook onder 3e) - - -Op elk niveau kan een qualifier (switch) /ASK of /NOASK worden meegegeven. -Deze bepaalt of de gebruiker voor het keyword geprompt wordt of niet -(het opgeven van /[NO]ASK bij een prompt heeft alleen zin als ook de -/SAVE switch gegeven wordt). - - -Met de /SAVE optie en dwspecify (= dws) kunnen vaste defaults voor een -programma worden gezet. Omdat het meestal wenselijk is verschillende -sets van defaults te gebruiken voor verschillende procedures kan een -programma in verschillende "streams" (wat was dat andere woord ook al -weer?) gestart worden. Elke "stream" heeft een eigen set defaults. - -Het commando om een programma te starten in een bepaalde "stream" is - - dwe <programma>$<streamname> - -bv - dwe nscan$1 - dwe nmap$standard - dwe nplot default: stream 1 - -Wanneer een keyword geen default heeft in de opgegeven stream wordt -een default in stream 0 gezocht, is daar ook niets dan blijft alleen -de default van de PIN file over. Voor NGEN keywords wordt steeds zowel -in de stream voor het programma als in de stream voor NGEN gezocht. - - - -2e. DWARF Symbols ------------------ - -DWARF slaat externe defaults op als symbolen. Alle symbolen staan -fysiek in de file $DWARF_SYMBOLS (meestal ~/SYMBOL_DIR/SYMBOL.$$). - -Een DWARF keyword correspondeert met een symbool - - <Programma>$<Stream>_<Keyword> - -De waarde van het symbool is de character string die als default -gebruikt zal worden bij user-input, eventueel met de qualifier /ASK -of /NOASK er achter. - -Wanneer achter de waarde <space>/ASK staat, vervangt de waarde de default -van het programma, maar wordt de user toch geprompt voor het keyword. - -Wanneer achter de waarde <space>/NOASK staat, of wanneer er helemaal geen -qualifier staat, dan wordt de user niet meer voor het keyword geprompt. - - -Naast deze keyword symbolen kunnen ook algemene symbolen gezet worden, -die in antwoorden op prompts gebruikt kunnen worden, bv PI = 3.1415, -NATUURLIJK = YES en zo voorts. - - -De volgende utilities zijn beschikbaar om symbolen te manipuleren: - - - dwlet [symbol=value] [/LOG[=long|short] [/NOLOG] (= dwl) - - Geef een waarde aan algemene symbolen. Kan niet gebruikt worden - om DWARF keywords te wijzigen. - - Als er geen symbol=value wordt meegegeven wordt de standard input - gelezen voor regels met "symbol=value", om te stoppen: lege regel - of # of ^D. - - dwspecify program[$stream] [/MENU] [/NOMENU] (= dws) - - Default stream is 1, default mode is /NOMENU. - - Hiermee worden externe defautls voor DWARF keywords opgegeven. - Met /menu wordt voor elk keyword geprompt met de huidige - (externe of interne) default, alleen wijzigingen worden in - een symbool gezet. Met /nomenu worden van de standard input - regels keyword=value gelezen. - - dwclear [program[$stream]keyword,... [/CONFIRM] ... (= dwc) - - Verwijdert de definitie van de keywords, wildcards zijn toegestaan, - erg handig is bijvoorbeeld: dwclear nscan$*_*, om helemaal schoon - te beginnen. - - dwsave [program[$stream]keyword,... [/OUTPUT=file] [/CONFIRM] ... - - Default file is dwarfsave.sav, default extensie is sav - - Schrijft de keywords en hun waarde in de genoemde (ASCII) file, - wildcards zijn toegestaan. Default is *$*_* - - dwrestore file [/CONFIRM] [/OVERWRITE] - - Leest regels keyword=value van de genoemde file en definieert de - corresponderende symbolen. - - dwview symbol,... [/EXTERN] [/GENERAL] [/INPUT=file] (=dwv) - - Laat de waarde van symbolen zien: - - Zonder /GENERAL en /INPUT: - Symbols moeten de vorm [[program]$stream_]keyword hebben, - wildcards toegestaan. Laat zowel interne als externe defaults - zien, als /EXTERN alleen de externe (zowel "local" als "NGEN"). - - Met /INPUT: - Leest als dwrestore van de genoemde file, laat keywords zien - die matchen met de genoemde symbols. - - Met /GENERAL: (optie gemaakt 28/07/93) - Symbols mag zowel DWARF keywords als algemene symbols bevatten, - wildcards toegestaan (bv: dwv /g *). - Voor keywords: alleen externde defaults worden getoond. - Als er precies een symbool is opgegeven is de uitvoer de - waarde van dat symbool, anders regels symbol=value. - - -Een typische manier om standard streams te gebruiken is dus: - - dwe nscan$abc /save [/norun] of dws nscan$abc /menu - dwe nplot$abc /save [/norun] - - dwsave *$abc /output=abc - -Tenslotte commentaar invoegen in abc.sav, eventueel nog wat keywords -van de /ask switch voorzien. - -Dan bij gebruik: - - dwrestore abc /override - - dwe nscan$abc - dwe nplot$abc - - - - - - -3e. Antwoorden op prompts -------------------------- - -Het programma bepaalt (via de PIN file) wat voor antwoorden geldig zijn -(character strings, numeric values). Binnen de grenzen van die geldigheid -kunnen de volgende constructies worden opgegeven: - - ? Geef online help - - # of ^D Exit (meestal: vraag vorige keyword) - - "" Empty answer (meestal: by-pass option) - - * Wildcard (meestal: take all) - - ... ! Comment Alles na een uitroepteken is commentaar - - ...'Symbol'... Het symbol wordt vertaald voor alle verdere - processing - - (1=2)*4 Rekenkundige expressies worden uitgewerkt - (alleen voor numerieke waarden, dus wel voor - INPUT_LABELS, niet voor LOOPS) - - 99 TO 120 BY 2 Reeksen worden gegeven als begin TO eind BY stap - (alleen voor numerieke waarden, dus wel voor - INPUT_LABELS, niet voor LOOPS) - - ... /SAVE [/[NO]ASK] Bewaar deze waarde na afloop van het programma in - een DWARF symbol. De qualifier /ASK of /NOASK - wordt in het symbool bewaard (geen qualifier - betekent in praktijk: /NOASK) - - value1; value2; ... Geef een reeks waardes op, de volgende keer dat - het keyword wordt gevraagd neemt het programma - de eerstvolgende waarde - - value1,value2 Geef een vector op, alle waardes worden meteen - naar het programma doorgegeven - - /ASK=keyword Wanneer het programma het opgegeven keyword - nodig heeft krijgt de gebruiker een prompt; - als deze qualifier gegeven is wordt het - huidige keyword nog een keer gevraagd. - - - -Nota Bene: er is geen snelle manier om hidden keywords te zetten als - het programma al draait. Met dws is dat wel mogelijk. - - - -4e. Scripts en batch processing ------------------------------------------------ - -Er zijn twee manieren om Newstar (of eigenlijk: DWARF) in batch mode -te gebruiken. De simpelste manier lijkt me via shell scripts, waarin -keywords worden gelezen met dwrestore en vervolgens de nodige programma's -worden gedraaid. - -Er is (voor WENSS) een "Batch package" ontworpen om de interactie met -de keyword files te vereenvoudigen. Voor zover ik kan zien is de enige -functie het overnemen van de dwrestore en het zetten van /ASK achter -een aantal keywords. Dit weegt denk ik niet op tegen de extra moeite om -voor elk programma een "batch versie" te maken. Ik zal hier nog wat -beter naar kijken. Je hoort er nog van. - - -5e. Voorstel voor wijzigingen en uitbreidingen ----------------------------------------------- - -De volgende wijzigingen in het huidige systeem lijken me wenselijk: - - - Alternatieve specificatie voor streams omdat $ een Unix special - character is. Ik stel voor om voor stream specificaties zowel - een $ als een . toe te staan (bv dwe nscan.test of dwe nscan$test). - - - Van keywords die als symbol gedefinieerd zijn met /NOASK moet tijdens - de uitvoering van het programma het keyword en de waarde worden - afgedrukt. - - -Een "conditionele" batch processing kan vrij makkelijk worden gerealiseerd -door de Newstar programma's bepaalde interne waarden in een (algemeen) -symbol te laten zetten. Die waarden kunnen dan in het shell script worden -opgevraagd en getest. Bv: bij NSCAN kan het aantal Channels in symbol -NCHAN worden gezet, in het shell script kan dan een test worden gedaan - - if (`dwv /General nchan` == 128) then ... - -of de waarde kan in een shell variabele worden gezet - - set channels=`dwv /g nchan` - -of de waarde kan worden toegekend aan een keyword voor een ander programma - - dws nmap\$1 /NOMENU <_EOD_ -LOOPS='NCHAN',...1 -# -_EOD_ - - -Wanneer jullie doorgeven op welke parameters je wilt testen is het een -kleine moeite die waarden in een symbol te zetten. Wanneer je een -programma met /SAVE draait zijn alle antwoorden van de user in elk -geval beschikbaar in symbolen, dus daar kun je ook op testen. - - ----------- - -Tot zover maar weer even. Ik maak hier nog een fatsoenlijk (Engels) document -van, maar hiermee kunnen jullie denk ik wel even vooruit. - -Hartelijk groeten, - -Marco. - - - --- - - - +--------------------------------------------------------------------------+ - | NFRA/St. ASTRON | eMail: devoscm@astro.rug.nl / cccccccc | - | P.O. Box 2 | or: devoscm@astron.nl / c m m c | - | NL-7900 AA Dwingeloo | / c m m m c | - | | ---------------------------------+ c m m c | - | Phone: +31 5219 7244 \ "If you reinvent the wheel, | v v | - | Fax: +31 5219 7332 \ make sure yours will look | v v | - | Telex: 42043 rzm nl | different..." | v | - +--------------------------------------------------------------------------+ - - - diff --git a/hlp/bug_reports.txt b/hlp/bug_reports.txt deleted file mode 100644 index 0c65ed83723cb931125d341f93cfdd905f4af602..0000000000000000000000000000000000000000 --- a/hlp/bug_reports.txt +++ /dev/null @@ -1,434 +0,0 @@ -Newstar Bug reporting procedure -------------------------------- - - bug_reports.txt 14/06/93 v1.0 CMV - bug_reports.txt 06/09/93 v1.2 CMV - JPH 940621 Add list of contents. Include bug_report.2 (=sec. 6.1) - - -INHOUD -====== -1. Inleiding -2. Procedure -3. Revisions en Releases -4. Functionality Requests -5. Implementatie: nbug -6. Prioriteitsstelling -6.1 Update on priorities -7. Slotopmerkingen - - -1. Inleiding ------------- - -Zolang een programmapakket door een beperkte groep gebruikt wordt, is -er weinig noodzaak voor al te veel formele procedures. Naarmate het -pakket door een grotere groep, met een grotere geografische verspreiding -wordt gebruikt werkt een aantal informele overlegcircuits niet meer en -moet er een aantal afspraken over tijdschema's en rapportage gemaakt worden. - -Die afspraken moeten het volgende garanderen: - - 1e. Gebruikers weten welke versie van het pakket voor hen draait, - en wat de (voornaamste) eigenschappen van die versie zijn. - - 2e. Gebruikers die een "bug" rapporteren worden regelmatig op de - hoogte gehouden van de afhandeling van die bug. - - 3e. Programmeurs weten aan welke programma's gewerkt wordt. - - 4e. Er is een duidelijke prioriteitstelling voor de verschillende - onderhouds- en ontwikkelingstaken, waardoor niet onevenredig - veel tijd wordt besteed aan minder belangrijke klussen. - - 5e. Er zijn duidelijke overleg momenten, waardoor er doorlopend - een optimale werkverdeling is. - - 6e. Er is een rapportage procedure, waardoor ervaring bij debugging - voor het nageslacht bewaard blijft. - -Voor wat betreft Newstar zijn de meeste van die punten nu (informeel) -geregeld. Dit rapport probeert het geheel te structureren, uitgaande -van de afhandeling van bugs. Aangezien in mijn optiek missende -functionaliteit ook een bug is (het jeukt net zo erg...) geldt het -verhaal in hoofdlijnen ook voor functionality requests. - - - -2. Procedure ------------- - -Afhandeling van een bug doorloopt de volgende fasen (tussen haakjes de -status die na deze fase aan de fout wordt toegekend, zie sectie 5): - - 1e. Ontvangst (Received) - 2e. Prioriteitsstelling, toewijzing (Assigned) - 3e. Bevestiging naar gebruiker (Confirmed) - -Tussen 1e. en 3e. mag hooguit twee dagen verstijken. De bevestiging kan -ook inhouden: dit heeft lage prioriteit, we houden u op de hoogte. Een -bevestiging kan ook plaatsvinden voor prioriteitsstelling. - - 4e. Reproductie van de fout - -Als 4e. problemen geeft, wordt teruggekoppeld naar de gebruiker: -architectuur/site specifieke problemen, kan gebruiker reproduceren? -Wanneer dit onderdeel meer dan een dag in beslag neemt, moet de -prioriteitstelling opnieuw worden bekeken. - - 5e. Analyse van de fout (Analysed) - -Hier wordt de set van modules/bestanden waar de fout in kan zitten -afgebakend: tracen van de fout, controleren van asynchrone effecten etc. -Wanneer dit onderdeel meer dan een dag in beslag neemt, moet de -prioriteitstelling opnieuw worden bekeken. Afhankelijk van de locatie -van de fout kan de bug worden doorgeschoven naar een andere programmeur -(bv omdat die de modules geschreven of recent gewijzigd heeft). - - 6e. Formuleren van een oplossing of omleiding - -Wanneer dit onderdeel meer dan een week in beslag neemt, moet de -prioriteitstelling opnieuw bekeken worden. Ook moet de gebruiker -een bericht krijgen dat de zaak wel eens wat langer kon duren. - - 7e. Implementeren van de oplossing of omleiding (Solved) - -Als het implementeren van de geformuleerde oplossing langer dan een week -duurt, moeten we terug naar 6e. - - 8e. Validatie van de oplossing of omleiding (Tested) - -Eventueel worden de wijzigingen gecontroleerd door de oorspronkelijke -auteur van de modules. -De gebruiker wordt verzocht op zijn site een test te draaien met de -gewijzigde modules (evt ftp van executable naar user systeem op die site). - - 9e. Afwikkeling van de fout (Released) - -De wijzigingen worden in de NFRA Master geupdate, inclusief wijzigingen -van de documentatie. -De gebruiker die de bug gemeld had, wordt op de hoogte gesteld, -de master op zijn site wordt bijgewerkt. -Andere sites ontvangen een melding van de wijzigingen, en worden -eventueel bijgewerkt. - - -3. Revisions en releases ------------------------- - -Bij wijzigingen in Newstar kunnen we twee gevallen onderscheiden: - - de wijziging heeft een minimale invloed op het gebruik van de - programma's (afgezien van het ontbreken van crashes etc.); - kleine toevoegingen in functionaliteit vallen hier ook onder - - de wijziging heeft invloed op het gebruik van de programma's - (veranderde keywords, noodzaak om SCN files te converteren etc) - -In het eerste geval spreken we van een revision van Newstar. Bij een -revision is het niet nodig dat elke gebruiker een melding van -dit heuglijke feit ontvangt. Ook is het niet nodig dat alle sites -een revision onmiddelijke ontvangen. Het exporteren van een revision -gebeurt door een beperkt aantal bestanden over te zenden (via een -revision groupfile: update retrieve .....grp) - -In het tweede geval spreken we van een release van Newstar. -Een release wordt expliciet aangekondigd aan alle gebruikers (evt via -locale Newstar managers). Een release wordt ge\"exporteerd naar alle -sites. Voor een release wordt het volledige Master systeem van de site -gecontroleerd: update retrieve all) - - -4. Functionality requests -------------------------- - -Voor functionality requests geldt in principe hetzelfde als voor bug, -met dien verstande dat het reproduceren van de fout vervalt, en dat de -overige stappen een langere tijdschaal hebben. - - -5. Implementatie: nbug ----------------------- - -In de NFRA Master staat een subdirectory $n_src/doc/bug waarin voor -elke bug een bestand wordt bijgehouden. Deze bestanden (project files) -kunnen met de Hypertext browser worden bekeken via een aantal indexen. -Onderlinge verbindingen zijn mogelijk. - -Onafhankelijk van de manier waaop de bug binnenkomt (eMail, formulier AGB, -telefonisch, wandelgangen) wordt een project file gemaakt. Als de bug -elektronisch gerapporteerd werd, kan het betreffende bestand aan de -project file gekoppeld worden, anders moet de essentiele informatie -worden ingevoerd. - -Wanneer nieuwe informatie beschikbaar komt (na toewijzing, bevestiging, -oplossing etc) wordt die toegevoegd aan de project file, eventueel met -een gekoppeld tekstbestand. - -De bug-reports worden bijgehouden middels de utility "nbug", die een -hele reeks opties heeft. De meeste opties corresponderen met de diverse -stadia die een bug in zijn carriere kan doorlopen. - - add Invoeren nieuwe bug (kent nummer toe, vraagt details) - confirm Ontvangstbevestiging - priority Prioriteitstelling (vraagt priority en assignment) - suspend Wordt tijdelijk niet aan gewerkt (behoudt prioriteit) - - analysed Fout is gevonden - solved Fout is opgelost - tested Oplossing is getest - - released Nieuwe software is vrijgegeven (priority wordt -1) - - feedback Bevestiging van contact met melder - status Vraagt status op van bepaalde bug (kan beter via hypertext) - - -Bovenstaande opties vragen allemaal om een associated file en een -comment, en geven de optie om de project file te editen (emacs of $EDITOR). -Ze voeren ook automatisch een index commando uit. Indices kunnen op -ieder moment gemaakt worden met de index optie: - - index Maakt de standard indexen voor de hypertext - - Alle bugs op volgorde van nummer - - Alle bugs op volgorde van prioriteit - - Alle actieve bugs op volgorde van prioriteit - -Naast indices voor on-line toegang zijn (geprinte) lijsten vooralsnog -van groot belang. De volgende lijsten kunnen met de ndoc optie "list" -worden gemaakt: - - list Maakt lijsten voor printout - full Alle bugs op volgorde van nummer - priority Alle bugs op volgorde van prioriteit - active Alle actieve bugs op volgorde van prioriteit - late Alle "vertraagde" bugs, dat is: - - ontvangen en niet binnen twee dagen bevestigd - - niet suspended en geen feedback binnen twee weken - - suspended of released en geen feedback binnen twee dagen - - user Alle bugs van een bepaalde user (Pietje Puk etc) - programmer Alle bugs van een bepaalde programmeur (HjV, WNB, ...) - - -In de lijsten (en indices) verschijnt de bug als volgt: - -ID Pr.ty Origin Worker Status Action/Feedback Description ------------------------------------------------------------------------------- - -0024 10 verheijen None Confirmed 930806/930823 Gridding in .. -0023 200 verheijen CMV Confirmed 930806/930823 NGIDS locks .. -: -0020 0 verheijen None Confirmed 930806/930823 NGIDS much t.. -0019 300 verheijen, WHISP CMV Confirmed 930806/930823 NGIDS flaggi.. -: - -De volgende bestanden zijn van belang voor nbug: - - $n_src/doc/bug/n????.prj Project file - $n_src/doc/bug/detail/n????.* Alle overige documenten - - $n_src/doc/bug/nbug.txt "Home Page" met links naar indices - $n_src/doc/bug/nbug.idx Index op nummer - $n_src/doc/bug/npriority.idx Index op priority - $n_src/doc/bug/nactive.idx Index op priority voor actieve bugs - -Al deze bestanden zijn normale ASCII file die naar believe kunnen worden -bijgewerkt voor veranderingen die niet door nbug worden ondersteund. - - -6. Prioriteitsstelling ----------------------- - -De voorlopige strategie voor de prioriteiten is als volgt: - - - Prioriteiten lopen van 0 tot 900 - - De honderdtallen doen dienst als grove prioriteitsklassen - Bugs uit 900-999 worden in principe het eerst aangepakt - - De tientallen doen dienst als een globaal werkschema binnen de - prioriteitsklassen. Bugs uit 990-999 worden in principe eerder - aangepakt dan bugs uit 980-989 - - De eenheden zijn een kunstmatig middel om een bug omhoog te kunnen - schuiven zonder alle overige project files te moeten wijzigen. - Als een bug met prioriteit 700 zeer urgent wordt, urgenter dan - bestaande bugs met prioriteit 980, dan wordt de prioriteit gewijzigd - naar 981. - - - Een tijdslimiet of schatting kan als commentaar bij de prioriteit- - stelling worden gegeven. - -Een definitief systeem zal worden vastgesteld op basis van ervaringen met -het huidige voorstel. - - -6.1 Update on the priority system: ---------------------------------- - -There are now five priority classes: - - 100 - Critical bugs, that make it impossible to use vital programs - 200 - Urgent requests or bugs - 300 - Desirable things - 400/500 - Pro memori - -The priority scheme does not show any timeslicing, but is complemented -in this respect by the Project Plan. - -The header tag Class has been added to distinguish between Bugs -and Requests, the tag Category shows the program (e.g. NSCAN, NPLOT) -with which the Bug/Request is mainly concerned. - - -7. Slotopmerkingen ------------------- - -Het moge duidelijk zijn dat een dergelijk systeem niet beperkt is tot -gebruik binnen Newstar. Met een aantal triviale wijzigingen in nbug -is het mogelijk voor een willekeurig software project een dergelijke -rapportage op te zetten. - -Ook is deze strategie in principe bruikbaar voor alle processen waarbij -een "checklist" van status veranderingen moet worden bijgehouden. -Desgewenst kan de volgorde van veranderingen worden vastgelegd. - -We kunnen nbug vergelijken met andere bug-reporting systemen (zoals bv het -GNATS systeem van GNU). Deze systemen hebben een grotere nadruk op -automatische interactie/responsies via electronische mail. De on-line -toegankelijkheid is kleiner dan bij nbug, evenals de centrale rapportage -mogelijkheden. Desgewenst kan meer eMail interactie worden ingebouwd in -nbug. Dit lijkt me in de huidige situatie (waar verreweg de meeste -klachten verbaal worden ingediend) nauwelijks de moeite. - - - - - -Appendix A: Casus ------------------ - -> _nbug add_ -Creating bug-report project file with id-number 0036 -Enter name of file with associated eMail: _~devoscm/tmp_ -Enter origin [Pietje Puk]: __ -Enter email address [Unknown]: _puk@rux.timboektoe.edu_ -Enter subject [Unknown]: _Cannot make poststam images anymore_ -Any comments: _Seems the same old problem again_ - -Please confirm the bug within two days and set a priority as soon -as possible. Indices for the bug-database will be updated. - -Edit the project file (y,n)? [n] _n_ -0036 0 Pietje Puk None Received 930909/000000 - Cannot make poststamp images anymore -Updating indices... - -After I called him back, I type... - -> _nbug confirm 36_ -0036 0 Pietje Puk None Received 930909/000000 - Cannot make poststamp images anymore -Any comments: _Called back, Mr. Puk seems quite upset about this_ -Associated file (may be -bugid or detail/...): __ -Edit the project file (y,n)? [n] __ -0036 0 Pietje Puk None Confirmed 930909/930909 - Cannot make poststamp images anymore -Updating indices... - -Then JEN decides this is quite important... - -> _nbug priority_ -Enter bug-id: _36_ -0036 0 Pietje Puk None Confirmed 930909/930909 - Cannot make poststamp images anymore -Enter (new) priority: _900_ -Assign job to: _HjV_ -Any comments: _Must be solved with a week_ -Associated file (may be -bugid or detail/...): __ -Edit the project file (y,n)? [n] __ -0036 1000 Pietje Puk HjV Assigned 930909/930909 - Cannot make poststamp images anymore -Updating indices... - -So it is analysed immediately... - -> _nbug analy 36_ -0036 1000 Pietje Puk HjV Assigned 930909/930909 - Cannot make poststamp images anymore -Any comments: _Missing check on array bounds in NPLSTM_ -Associated file (may be -bugid or detail/...): _test.log_ - -Edit the project file (y,n)? [n] __ -0036 1000 Pietje Puk HjV Analysed 930909/930909 - Cannot make poststamp images anymore -Updating indices... - -And when Dr. Puk calls me occasionally... - -> _nbug feedback 36_ -0036 1000 Pietje Puk HjV Analysed 930909/930909 - Cannot make poststamp images anymore -Any comments: _Pietje called again, told him Henk found it_ -Associated file (may be -bugid or detail/...): __ -Edit the project file (y,n)? [n] __ -0036 1000 Pietje Puk HjV Analysed 930909/930909 - Cannot make poststamp images anymore -Updating indices... - -Etc. - -Appendix B: Format of project file and indices ----------------------------------------------- - -n0036.prj: ------------------------------------------------------------- - <TITLE>Newstar Bug Report # 0036</TITLE> - - <H1>Newstar Bug Report # 0036 </H1> - - <DT><STRONG>Origin:</STRONG> Pietje Puk - <DT><STRONG>Address:</STRONG> puk@rux.timboektoe.edu - <DT><STRONG>Subject:</STRONG> Cannot make poststamp images anymore - <DT><STRONG>Status:</STRONG> Analysed - <DT><STRONG>Priority:</STRONG> 1000 - <DT><STRONG>Worker:</STRONG> <A HREF=../html/people.html#HjV>HjV</A> - <DT><STRONG>Last action:</STRONG> 930909 - <DT><STRONG>Last feedback:</STRONG> 930909 - - <P> - <H2>Detailed description</H2> - - <P> - <H2>History</H2> - - <DT>930909 18:05 - <STRONG>Received</STRONG> by Marco de Vos - <DD>Seems the same old problem again - (<A HREF=detail/n0036.1>detail</A>) - <DT>930909 18:07 - <STRONG>Confirmed</STRONG> by Marco de Vos - <DD>Called back, Mr. Puk seems quite upset about this - <DT>930909 18:07 - <STRONG>Assigned (HjV, priority 1000)</STRONG> by Jan Noordam - <DD>Must be solved with a week - <DT>930909 18:08 - <STRONG>Analysed</STRONG> by Henk Vosmeijer - <DD>Missing check on array bounds in NPLSTM - (<A HREF=detail/n0036.2>detail</A>) - <DT>930909 18:09 - <STRONG>Feedback</STRONG> by Marco de Vos - <DD>Pietje called again, told him Henk found it ------------------------------------------------------------- - - -nbug.idx: ------------------------------------------------------------- - <TITLE>Newstar Bug Index: all keys</TITLE> - <H1>Index of all bugs sorted on ID number</H1> - - <P> - <LI> For an index sorted on priority, click <A HREF=npriority.idx>here</A> - <LI> For an index of active items only, click <A HREF=nactive.idx>here</A> - <P> - - <TT><DT>BugID Pr.ty - Subject - <DD><STRONG>Status...</STRONG> - Action/Feedback - (<EM>Origin</EM> - Worked on)</TT><P> - - <TT><DT><A HREF=n0001.prj>0001</A>: +0000 </TT> - Lines in NPLOT to ... - <TT><DT><A HREF=n0002.prj>0002</A>: +0000 </TT> - Programs stay sile... - ------------------------------------------------------------- - diff --git a/hlp/calculate.txt b/hlp/calculate.txt deleted file mode 100644 index 7c81e21d5d092d92591a10bd58d5acf5cc4017ab..0000000000000000000000000000000000000000 --- a/hlp/calculate.txt +++ /dev/null @@ -1,263 +0,0 @@ -!CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC -! -! -! *********************************************************** -! * * -! * NETHERLANDS FOUNDATION FOR RADIO ASTRONOMY * -! * P.O. BOX 2 * -! * 7990 AA DWINGELOO * -! * THE NETHERLANDS * -! * * -! *********************************************************** -! -! -! MODULE-NAME: CALCULATE -! ------------ -! -! FILE-NAME: CALCULATE.HLP -! ---------- -! -! BRIEF DESCRIPTION: -! ------------------ -! This file defines the help-text for the program CALCULATE. -! CALCULATE is derived from DWARF (Dwingeloo Westerbork -! Astronomical Reduction Facility). -! -! -! HISTORY: -! -------- -! 8-oct-86 Ger van Diepen -! -! -!CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC -! -! -! -! -! -1 CALCULATE - The program CALCULATE is a handy desk-calculator, allowing the use of - expressions (with units), symbols and formulae. - It is derived from the Dutch image processing system DWARF. - (Dwingeloo Westerbork Astronomical Reduction Facility). - Note that DWARF is designed in such a way, that applications can - run outside the DWARF-environment. - - The program is started by the command CALC(ULATE). - Qualifiers can be used to control the program. If they are given - at the CALC command-line, they serve as a global qualifier. - Global qualifiers can be overridden for each individual expression-line - by ending the line with the qualifiers, preceeded by at least one space - (to distinguish it from the division operator). - - The input expressions are read from SYS$INPUT. - The results are listed on SYS$OUTPUT. - Optionally (part of) input and output can be logged. -2 EXPRESSIONS - After having started the program, the program asks you for an expression. - By giving a null-answer the program will be stopped. - Typing a question mark starts a help session. - Typing UNIT=? will show you the available units on printer or terminal. - - Expressions have the normal arithmetical format, using +,-,*,/,** - and parentheses. Blanks and unary signs are allowed. - However, note that / cannot be preceeded by a blank to distinguish - it from the qualifier-indicator. - The relational operators .NOT.,.EQ.,.NE.,.GT.,.GE.,.LE. and .LT. - are also allowed. - Also available are: - - some built-in functions (goniometric, etc.) - - unit specification and conversion - - special format for time or positions (using colons) - - symbol definition and substitution - - As in DCL, integer numbers can be specified in octal or hexadecimal - format (use %O, %X, resp.). -3 FUNCTIONS - The following functions (similar to Fortran) can be used in expressions: - MIN MAX 1-10 arguments - SIN COS TAN - ASIN ACOS ATAN ATAN2 - ABS - EXP LOG LOG10 - SQRT - TRUNC ROUND - MOD - SIGN - - Default unit for goniometric function is degrees, which can be - overridden via the /UNIT-qualifier or by giving the unit in the - expression. - - The result of SIGN is: - -1 for negative values - 0 for zero - 1 for positive values - - Note that conversion to integer format implies rounding. -3 UNITS - CALCULATE is able of converting from one unit to another. - It converts the units given in the expression to the unit given by - the /UNIT-qualifier. The units must belong to the same group (so - conversion from SEC to KM is impossible). - - A unit can be given at several places: - - after a number e.g. 10DEG - - after a subexpression e.g. (10+3)deg - - after a symbol e.g. PI RAD - - Note that in the last case the blank is significant, else it is - optional. -3 TIME_POSITION - Times and positions can be given in HH:MM:SS (or DD:MM:SS) format - using colons as separators. A unit may follow the value. - Each part can be a floating number, which may exceed 60. - - The output can also be listed in that format by giving - /UNIT=HMS or /UNIT=DMS. - - This sexagesimal format allows for easy addition, subtraction and - conversion of times and positions. -3 SYMBOLS - Symbols are very useful for storing results and for handling formulae. - Both symbol substitution and definition is possible in CALCULATE. - CALCULATE will always define global symbols. - It is also possible to use predefined local or global symbols, - either numeric or alphanumeric. - - By defining a formula as a symbol, it is very easy to calculate - the result of the formula for several values of its parameters. - E.g. $ VOLUME = "4/3*pi*r**3" - $ CALC - Expression: r=3 - Expression: volume - Expression: r=10 - Expression: volume -4 DEFINITION - A symbol can be defined by using the construct: - symbol_name = expression - or - symbol_name = "expression" - - In the first case the expression is evaluated and the result - will be assigned to the symbol. - In the second case the expression-text is assigned to the symbol, - which is useful for defining formulae. - - Note that DCL uses the same procedure. -4 SUBSTITUTION - Symbols can be substituted in an expression by - giving its name enclosed in apostrophes - or - giving its name without apostrophes. - - In the first case its value is substituted literally. - In the second case its value is treated as a subexpression. - - E.g. if I=3+4 then 3*'i' results in 3*3+4 = 13 - and 3*i results in 3*(3+4) = 21 - - Note that nested substitution is possible. - Mutual substitution is detected by allowing a maximum of 25 - substitutions. -2 Examples - Convert miles to kilometers - $ calc - 10mile /unit=km - - If a whole serie must be done it would be better to do: - $ calc/unit=km - 10mile - 8 mile - (1.25+3.48)mile - - Convert rigth ascension from HH:MM:SS to degrees. - $ calc/unit=deg - 9:23:48.329 hms - - Convert a time to seconds - $ calc/unit=sec - 9:23:48.329 hr - - Do some time calculation - $ calc/unit=hms - 10:34:48 + 2::45 - :34:56.89 - - Calculate an expression and define the symbol ABC - The result must be an integer - $calc - ABC = (2.34 * pi)+8*-cos(135+pi*28) /unit=deg - - Define a formula and calculate it for several parameters - $calc - VOLUME = "4/3*PI*R**3" - R=2 - VOLUME - R=10 - VOLUME - - Convert from hexadecimal to decimal - %x1a2f - - Convert from decimal to hexadecimal - 2546 /rad=x -2 /UNIT - This qualifier defines the default unit for the given values - and the unit in which the result will be expressed. - In this way it can be used for converting from one unit to another. - Note however that conversion between different groups of units - is not allowed (e.g. seconds to meters is illegal). - - From DCL the available units can be shown via the command PRTUNIT. - From CALCULATE they can be shown via UNIT=?. - - Default is no units. -2 /RADIX - This qualifier defines in which radix the output will be listed. - Possible values are: - D decimal - O octal - X hexadecimal - - The default is D. - O and X force TYPE=J if type is non-integer. -2 /TYPE - This qualifier defines in which format the output will be listed. - Note that all calculations are done in double precision and that - the program tests on integer overflow before conversion to an - integer format. - Possible values are: - B signed byte - I signed word (integer*2) - J signed longword (integer*4) - L logical - R single precision (real*4) - D double precision (real*8) - - The default is D. -2 /STREAM - This qualifier is special to DWARF. - It controls the stream of the application symbols. - The stream-name will be inserted in a symbol-name, if that symbol-name - has the format "image_keyword". - - Default is no stream. -2 /LIST - This qualifier controls if the results will be listed. - Normally you will always list the result, but in command-files - it can be useful to negate this qualifier (i.e. /NOLIST). - - Default is list. -2 /LOG - This qualifier controls if the expressions and results will be written - in the log-file CALCULATE.LOG (in the default directory). - This log-file is written in such a way that it can be executed as a - DCL command-file or can be used as input for the ARCHIVE-programs. - This means that most lines will be flagged with an exclamation mark - (indicating comments), but symbol definitions are valid commands, - which can be executed. - In this way users can calculate complex expressions and define the - results as symbols in a subprocess and execute the log-file in the - main process in order to obtain the results. - - Default is no logging. diff --git a/hlp/calibr_models.txt b/hlp/calibr_models.txt deleted file mode 100644 index 8084547dd901c38e875e126f9aa5d213e50be0db..0000000000000000000000000000000000000000 --- a/hlp/calibr_models.txt +++ /dev/null @@ -1,62 +0,0 @@ -Beste mensen, - -Op /user4/92calib staan 5 modellen voor 325 MHz -van 5 in Westerbork gebruikte calibrators (3C48, 147, -286, 295 en 345) - -Ze bevatten ruim honderd componenten, voldoende voor een -nauwkeurige zelfcalibratie. - -Bedenk echter het volgende: - -1) Ze gelden voor 325 MHz en als je ze in NCALIB -wilt gebruiken op andere banden van het -breedband 92cm systeem moet de BEAM optie aangezet -worden. Dat corrigeert dan in eerste orde (met behulp -van een (cos**6(cfr) functie) voor de veranderende primaire -bundel (met c=0.0629 dat nu geldt voor alle -frequenties beneden 500 MHz). Echter op de laagste frequenties -is de bundel waarschijnlijk breder dan een simpele -frequentie schaling. Daar moet dan dus een nieuwe -coefficient voor worden bepaald alsmede een nieuw frequentie -interval waarvoor die constante geldt voor worden gecreeerd. - -2) De calibratie bronnen zijn in werkelijkheid natuurlijk minder sterk -op de hogere frequenties. Maar om redenen uitgelegd in een -README help file in dezelfde directory wordt daar NIET voor -gecorrigeerd !! Daar moeten de astronomen zelf voor corrigeren -met behulp van de spectrale indices van die bronnen. - - -3) De bron 3C345 mag niet als flux calibrator gebruikt worden omdat -hij in fluxdichtheid varieert. Deze bron wordt slechts zo af en toe -gemeten om dat hij gepolariseerd is waardoor met behulp van het Stokes -U signaal het phase verschil van de XX en YY kanalen gecontroleerd -kan worden onder de aanname dat V=0 (VZERO optie in NCALIB-polar) -Deze bron heeft ook een RM van ongeveer 15-20 rad/m**2 waardoor de -Stokes Q en U percentages afhangen van frequentie. -Deze percentages staan dus ook niet in het model. -Ze zijn trouwens afhankelijk van de ionosferische Faraday draaiiing -die niet nauwkeurig bekend is. - -4) Voor de bron 3C303 (die ook i.v.m. met zijn hoge lineaire -polarisatie wordt waargeneomen, net als 3C345) -wacht ik nog steeds op een aantal metingen -waaruit ik een goede kaart kan maken waaruit een model te halen is. -Verder geldt voor deze bron hetzelfde als voor 3C345 behalve dat hij -niet verandert in flux dichtheid. - -Henk: Kun jij deze modellen neerzetten op de plaats waar NEWSTAR -zijn default modellen weghaalt. - -Als er vragen zijn dan hoor ik het wel. - -Ger --- - -A.G. de Bruyn (Ger) | Internet: ger@astron.nl -NFRA | -Postbus 2 | Phone: (31)-521-595257 -7990 AA Dwingeloo | Fax: (31)-521-597332 -The Netherlands - diff --git a/hlp/cmv.gif b/hlp/cmv.gif deleted file mode 100644 index a219cdce62ff2e7ec92d0bc691df280f74bcfb63..0000000000000000000000000000000000000000 Binary files a/hlp/cmv.gif and /dev/null differ diff --git a/hlp/control_c.txt b/hlp/control_c.txt deleted file mode 100644 index 8f09648f448cff2d8b7f88fdf36c6a44826e8168..0000000000000000000000000000000000000000 --- a/hlp/control_c.txt +++ /dev/null @@ -1,38 +0,0 @@ -Trapping control-C in Newstar programs -------------------------------------- - - (contributed by JPH 941005, gleaned from wndpar_x.fun, wngex.for) - - - - - INCLUDE WXH_DEF ... - XHCC(0)=1 ! inhibit ... - XHCC(0)=0 ! clear - IF (XHCC(1) .NE.0) THEN ! was a control-C caught? - XHCC(1)=0 - <action, typically CALL WNGEX> - ENDIF - - This code has been used to create module WNGCC with entry points - - WNGCCD disable control-C - WNGCCE enable control-C - LOGICAL WNGCCC check and reset 'control-c seen' status - -and several other entry points to check, count and reset the number of -interrupts seen. - - - The implementation is in entry point WNGEX0 in wngex.for. This routine -is declared the handler for signal SIGINT by wngsxh.fsc. Its action is very -simple: - - if xhcc(0) !=0 - xhcc(1)+=1 - else - fall through to WNGEX - - endif - - - diff --git a/hlp/copyright.txt b/hlp/copyright.txt deleted file mode 100644 index 6d061df0b1319b0765c5ae880d738eaffea10792..0000000000000000000000000000000000000000 --- a/hlp/copyright.txt +++ /dev/null @@ -1,157 +0,0 @@ -NEWSTAR - Copyright Notice --------------------------- - - COPYRIGHT (c) 1991, 1994 - by the Netherlands Foundation for Research in Astronomy - - NFRA/St. ASTRON - P.O. Box 2 - 7990 AA Dwingeloo - The Netherlands - - - The information in this document is subject to change without - notice and should not be construed as a commitment by the NFRA. - - The NFRA assumes no responsibility for the use or reliability - of the Newstar package and software exported together with it. - - Permission to use, copy, and distribute Newstar software and its - documentation for any purpose is hereby granted, provided that - this copyright notice appears in all copies. - - Permission to modify the software is granted, but not the right - to distribute the modified code. Modifications are to be distributed - exclusively through the Newstar Master Installation at the NFRA. - Please send any modifications to the Newstar manager who may - include them in the Master Installation for further distribution. - - Requests for copies of the Master Installation, for assistance with - the installation and for support of an unmodified version of the - Master Installation can be directed to the Newstar manager, who - can be reached by electronic mail as newstar@astron.nl or through - the Newstar User Feedback System (refer to the documentation for - details). - - - The Gipsy program gids and the giplib-library are distributed - with Newstar. Gipsy is copyrighted by the Kapteyn Astronomical - Institute, University of Groningen. The original copyright notice - for the Gipsy software is included at the end of this document. - - A binary version of the Mosaic hypertext browser, developed at - the NCSA (Illinois) is distributed with Newstar. The original - copyright notice for Mosaic is included at the end of this document. - - Newstar includes a modified version of the X11-driver originally - developed for the PGPLOT package by Tim Pearson (Caltech). - - - -COPYRIGHT Release 3.5 - - Groningen Image Processing SYstem (GIPSY) - - COPYRIGHT (c) 1978, 1984, 1992, 1993, 1994 - - Kapteyn Astronomical Institute, - University of Groningen - P.O. Box 800 - 9700 AV Groningen - The Netherlands - - - The information in this document is subject to change without - notice and should not be construed as a commitment by the Kapteyn - Astronomical Institute. - - The Kapteyn Astronomical Institute assumes no responsibility for - the use or reliability of its software. - - Permission to use, copy, and distribute GIPSY software and its - documentation for any purpose is hereby granted, provided that - this copyright notice appears in all copies. - - Permission to modify the software is granted, but not the right - to distribute the modified code. Modifications are to be distributed - via the GIPSY source server, which is currently kapteyn.astro.rug.nl. - You can send your modifications to the GIPSY manager, who will take - care of the distribution. - - Permission to install modified or new code directly can be obtained - from the GIPSY Manager. The E-Mail address of the GIPSY Manager - is listed in $gip_sys/manager.mgr. - - Reports of software failures will only be considered when you have - an automatic update of GIPSY sources installed at your site. See - $gip_sys/README. - - -Everything not already copyrighted by CERN is copyrighted by NCSA -(including the contents of the libhtmlw, libnet, libXmx, and src -directories, but not including the contents of libdtm, which is -entirely public domain). - -The official NCSA Mosaic copyright statement follows. - -/**************************************************************************** - * NCSA Mosaic for the X Window System * - * Software Development Group * - * National Center for Supercomputing Applications * - * University of Illinois at Urbana-Champaign * - * 605 E. Springfield, Champaign IL 61820 * - * mosaic@ncsa.uiuc.edu * - * * - * Copyright (C) 1993, Board of Trustees of the University of Illinois * - * * - * NCSA Mosaic software, both binary and source (hereafter, Software) is * - * copyrighted by The Board of Trustees of the University of Illinois * - * (UI), and ownership remains with the UI. * - * * - * The UI grants you (hereafter, Licensee) a license to use the Software * - * for academic, research and internal business purposes only, without a * - * fee. Licensee may distribute the binary and source code (if released) * - * to third parties provided that the copyright notice and this statement * - * appears on all copies and that no charge is associated with such * - * copies. * - * * - * Licensee may make derivative works. However, if Licensee distributes * - * any derivative work based on or derived from the Software, then * - * Licensee will (1) notify NCSA regarding its distribution of the * - * derivative work, and (2) clearly notify users that such derivative * - * work is a modified version and not the original NCSA Mosaic * - * distributed by the UI. * - * * - * Any Licensee wishing to make commercial use of the Software should * - * contact the UI, c/o NCSA, to negotiate an appropriate license for such * - * commercial use. Commercial use includes (1) integration of all or * - * part of the source code into a product for sale or license by or on * - * behalf of Licensee to third parties, or (2) distribution of the binary * - * code or source code to third parties that need it to utilize a * - * commercial product sold or licensed by or on behalf of Licensee. * - * * - * UI MAKES NO REPRESENTATIONS ABOUT THE SUITABILITY OF THIS SOFTWARE FOR * - * ANY PURPOSE. IT IS PROVIDED "AS IS" WITHOUT EXPRESS OR IMPLIED * - * WARRANTY. THE UI SHALL NOT BE LIABLE FOR ANY DAMAGES SUFFERED BY THE * - * USERS OF THIS SOFTWARE. * - * * - * By using or copying this Software, Licensee agrees to abide by the * - * copyright law and all other applicable laws of the U.S. including, but * - * not limited to, export control laws, and the terms of this license. * - * UI shall have the right to terminate this license immediately by * - * written notice upon Licensee's breach of, or non-compliance with, any * - * of its terms. Licensee may be held legally responsible for any * - * copyright infringement that is caused or encouraged by Licensee's * - * failure to abide by the terms of this license. * - * * - * Comments and questions are welcome and can be sent to * - * mosaic-x@ncsa.uiuc.edu. * - ****************************************************************************/ - -For more information on copyright and licensing issues, contact: - -Marc Andreessen -Software Development Group -National Center for Supercomputing Applications -605 E. Springfield, Champaign IL 61820 -marca@ncsa.uiuc.edu diff --git a/hlp/debug_efficiently.txt b/hlp/debug_efficiently.txt deleted file mode 100644 index 9d6ad328325e8dbb362ede302dcae95ebf598ba2..0000000000000000000000000000000000000000 --- a/hlp/debug_efficiently.txt +++ /dev/null @@ -1,36 +0,0 @@ -Efficient use of the dbx debugger on the SUNs ---------------------------------------------- - -(contributed by JPH 940919; based on research by CMV) - - - For the convenience of programmers who want to use dbx with Newstar -programs, the objects in the Newstar libraries are routinely compiled with the --g option (Newstar nsh option 'build -d') which creates objects including the -necessary symbolic information. When an executable is built with this same -option, all this information is carried over, resulting in a .exe file in which -all modules are accessible to dbx. - - This is very convenient for a programmer who needs access not only to -modules that he is modifying in his own shadow system but also to other -unmodified modules in the master libraries; indeed, there is no need for him to -copy master files to his shadow system for the mere purpose of recompiling them. - The disadvantage is that the .exe file carries a huge ballast of -symbolic information (typically several hundred thousands of items) which take -a long time (many minutes) to load at the expense of a more than unmodest -consumption of machine resources. - - CMV found the following simple procedure to load only those symbols -that one actually needs: - - > dbx - dbx> modules select <object_1>.o, <object_2>.o, ... - dbx> debug <$n_exe/<program>.exe - dbx> <set breakpoints or whatever> - dbx> run - -Should one discover in the subsequent debugging session that more modules are -needed, then one may restart the above sequence without leaving dbx. -Breakpoints and the like remain valid, but the modules selected before must -again be spelled out, - this is not nice but usually one needs only a few ... - diff --git a/hlp/doc_organisation.txt b/hlp/doc_organisation.txt deleted file mode 100644 index 4f37612030a1c841c912ceebdf8e8aa56c342538..0000000000000000000000000000000000000000 --- a/hlp/doc_organisation.txt +++ /dev/null @@ -1,776 +0,0 @@ -The Organisation of Newstar documentation ------------------------------------------ - - -@(#) newdoc.txt v1.6 08/09/93 CMV - newdoc.txt v1.5 03/09/93 CMV - newdoc.txt v1.4 05/08/93 CMV - - -1. Introduction ---------------- - - -This document defines the format and organisation of the Newstar -documentation. The next sections describe the way documentation can be -accessed, the way in which the documentation as a whole is organised and -the way in which documentation should be formatted. This corresponds to the -the point of view of a user, a Newstar site manager and a documentation -editor respectively. Appendices give detailed instructions for naming -conventions and editing. - -End-users who are just interested in using the documentation only -need to read section 2, site managers and contributors should read -the remaining sections as well. - - -2. Accessebility ----------------- - -The Newstar user documentation is accessible in three forms: - - 1e. As on-line help from program prompts, either as "dumb-terminal" - text or through NCSA's xmosaic browser decribed below. - - 2e. By browsing the documentation using xmosaic or any other - hypertext reader (e.g. the "dumb-terminal" reader for the - World Wide Web, developed at CERN) - - 3e. By reading the printed form of the documentation (the Newstar - Cookbook) either on paper or using an appropriate Postscript or - dvi viewer. - - -The documentation is organised as a hypertext network, which means that -various smaller pieces of information are connected by "links". This -not only gives flexible index and glossary functions, but also allows for -a menu-like presentation of the on-line documentation (options 1e and -2e). The pieces of information can also be put together in a single -large document, the Newstar Cookbook, where "links" show up as the -usual references like "see also section 1.3". - -To access the on-line documentation, the user enters one or more -questionmarks (?) in response to a prompt. If a single ? is entered, -the help text will be shown on the terminal screen. If more than -one ? is entered, a separate window will be opened in which xmosaic -presents the requested information. If no window could be started, -the help text will be given on the terminal. When an xmosaic window -is open, all help text will be presented there, regardless of the -number of questionmarks typed. The window remains active when the -program quits, so the same window can be used by several programs -(so far only if run on the same host). Xmosaic has been developed at -the NCSA and has many interesting options which fall outside the -scope of this document. - -If the information is shown through xmosaic, the user can access the -remainder of the documentation though that browser. Certain words in -the text will appear underlined. The user can move the mouse on one -of these words and click the left mouse button. Xmosaic will now display -the information that is associated with the underlined word. This can -be a brief explanation of that word (glossary function) or a related -piece of documentation. - -Any help text explaining a prompt will have at least the following links -appended to it (words within underscores will appear underlined): - - More information: - _List of keywords_ for NSCAN - _The Newstar Cookbook_ - Description of _program NSCAN_ - Description of _common keywords_ - The _DWARF User Interface_ - -The list of keywords for any program will have the following list appended -to it: - - More information: - _The Newstar Cookbook_ - Description of _program NSCAN_ - Description of _common keywords_ - -Prompts related to specific file types will also contain links to -documents revealing the secrets of such files. - -The hypertext network can also be accessed from outside a Newstar program -by typing "nhyper" at the command line. This will present you a page -with general information containing links to the table of contents of -the Newstar Cookbook and to some general help files (in particular the -Newstar News file). - - -3. Organisation ---------------- - -There are four different sources of information for the Newstar -documentation: - - - Cookbook sections, which are LaTeX documents (with some restrictions - on the commands to be used, see below). They may contain ordinary - text, terminal scripts (created with help of "nscript", see below) - and may include postscript figures. These LaTeX files are translated - into the HTML format for inclusion in the hypertext network. - - The LaTeX source files are all found in directory $n_src/doc/cook - The HTML versions are found in directory $n_src/doc/html - - - - Descriptive text (help-text) for program keywords, stored in - so called PIN files (extensions .pin, .psc or .pef). The PIN files - are translated into LaTeX (for inclusion in the printed version - of the cookbook) and into HTML for inclusion in the hypertext - network. - - The PIN files are located in $n_src/nscan etc. - The LaTeX versions are found in directory $n_src/doc/cook - The HTML versions are found in directory $n_src/doc/html - - - - Miscellaneous documents called Memo's, which are generally plain - ASCII files. For details on Newstar Memo's, refer to document - newmemo.txt - - The NEWSTAR Memo's are found in directory $n_src/doc/memo - - - Program source files can contain specially marked documentation - which can be extracted. The extracted documentation can be included - in the hypertext network. - - Documentation from file abc.def is stored in $n_src/doc/extractabc.def - - - - Bugreports, with their present status and history, are a separate - issue and are described in document bug_reports.txt. - - Bugreports are found in directory $n_src/doc/bug - - -Apart from these files there are: - - - Files with LaTeX commands used to generated printed versions of the - cookbook or parts thereof. These files are found in $n_src/doc/cook - and have names cb_*.tex - - - Index files for the hypertext network, generated automatically in - directory $n_src/doc/html - - -Files are maintained though utility $n_src/sys/document.csh which uses -the program docaid.c ($n_exe/docaid.exe). - -There is a groupfile $n_src/doc/doc.grp listing files in or below $n_src/doc -that have been created "by hand". A groupfile $n_src/doc/auto.grp will be -updated together with the hypertext indices. - -Note: the files in directories keys and html are derived from files in -the source tree ($n_src). These files are updated automatically when -other files (e.g. ppd-files) are being compiled. -This validates the principle that the source tree contains only all -files needed for installation. The alternative would be to create a -directory in either the library or the executable tree for -documentation. However, I think it is important that a full set of -documentation is available before installation. In my opinion this -outweights the violation of the source tree policy. It also makes -it possible that, at least for the time being, files in the keys -and html directory are explicitly updated at NFRA. - - -An update of the documentation proceeds as follows: - - "ndoc keys all" Convert all pin, psc and pef files to LaTeX and html files - "ndoc extr all" Extract documentation from files in $n_src/sys - "ndoc html all" Convert all cookbook sections to html files - "ndoc index" Make indices for the files in the html directory - -A shorthand for these commands is: "ndoc full" - -Updating the documentation takes a few minutes and needs to be done at -a single host only for all machines that share a filesystem. - -Other options of ndoc are: - - "ndoc script" Start the script utility (see Appendix C) - "ndoc print" Print part of the Newstar Cookbook - "ndoc hyper" Start the hypertext browser at the Newstar Home Page - "ndoc memo" Insert an external file into the Newstar Memo system - -The print command will ask you for a cookbook file to print. - - -4. Formatting -------------- - -Since a large amount of documentation is available already in -LaTeX, we choose to use LaTeX as our principle documentation -format. Although it is probably easier to convert an html document -to a LaTeX source than vice versa, this approach allows us to make -a fast start. To facilate translation we put some constrains on the -infinite flexibility of LaTeX. These are given in the "style guide" -found as Appendix A. - -Appendix A lists the "allowed" LaTeX commands, these are the commands -that will be recognised by the LaTeX to HTML converter. Any other -command will, for the time being, show up as ordinary text in the -xmosaic browser. - -The most important rules for writing documentation are the following: - - 1e. The basic element of Cookbook documentation is the section. - Each section should appear in a separate file. - It is well possible (and in fact preferable) to break - up sections in smaller units. - - 2e. Figures, tables and other blocks containing large amounts - of LaTeX commands not listed in Appendix A should be put in the - Cookbook by means of an \input or \include command. The embedding - commands (like \begin{figure} and \end{figure}) should also be - in that separate file. - - Such figures and tables will be converted to dvi or postscript - files in the html directory. - - 3e. Terminal sessions can be included within cookbook sections. - However, for extended examples it is better to put them in a - separate file which is included by an \input or \include command. - This makes the hypertext more readable and facilates regeneration - if the programs change. - - For a list of the LaTeX commands that will appear in terminal - sessions, refer to Appendix A. - - Refer to Appendix C for instructions on how to make - terminal sessions using the nscript command - - 4e. Within a section, the target of a hypertext link is marked - through the \label command. See the naming conventions in - Appendix B (eg. \label{nscan.descr.general}) - - 5e. Within a section, a hypertext link is made though the \ref, \refn, - \input and \include commands. The \input and \include commands - will translate to a lines: "See also: _Name of the include file_" - in the browser. The \ref command will translate as follows: - - ... This is explained in \ref{nscan.descr} where we see ... -> - ... This is explained in _here_ where we see ... - - ... This is explained in \ref{nscan.descr}{Chapter 4} ... -> - ... This is explained in _Chapter 4_ ... - - The last for will give a somewhat confusing output in the - printed version. - - 6e. Within PIN files, links can also be made through the \ref command. - In the "dumb-terminal" on-line help, these \ref commands show up - as text and may at best serve as an entry in the printed version - of the Cookbook. - - 7e. Filenames and labels should obey a strict naming scheme to - allow for the proper files to be constructed. This naming - scheme is given in Appendix B. - - -5. Contributing to the Newstar documentation --------------------------------------------- - -Contributions to the Newstar documentation are very welcome, in particular -new recipes are appreciated. To contribute a recipe, put your text in a -file either as plain ASCII (with some indication as to sections etc) or -using the LaTeX commands from Appendix A. Preferably you should use the -naming conventions from Appendix B. Send the files to me and we will put -them in their proper place. - - - -Appendix A: Style Guide for the Newstar Cookbook ----------- - -The following conventions should be obeyed when writing LaTeX documents -that should be converted to html using the docaid program: - - - Only commands in the recognised subset (see below) may be used. - - - The \begin{...} and \end{...} commands should be on a line of - their own. - - - To change font temporarily, use something like {\bf ...}, without - any space between the brace and \bf. Curently recognised fonts - are: \rm \bf \it \tt \tiny - - - For verbatim text use either - - \begin{verbatim} - ... - \end{verbatim} - - or {\tt ...} (with special characters escaped). - The commands used by nscript (\sline etc) use the latter strategy. - - - The tabbing environment can be used inside documents with the - following restrictions. There should be a single definition line - (with \= commands), which should follow the \begin{tabbing} line - without intervening empty/comment lines. The definition line will - not be copied to the hypertext, so use the \kill command. - - Since tabbing in HTML is extremely poor, do not expect to much of - presentation in xmosaic. - - -The following subset of LaTeX commands is currently recognised by docaid. - -/* - - Translation table for LaTeX to html - - Format: - - Column 1: name of the command (minimal match) without leading \ - Column 2: length of command (all zero's, set by program) - Column 3: action routine - NULL No special action (just print replacement string) - _PUSH Print closing tag for the replacement string when - closing } is found - _SKIP Skip any arghuments to the command - other Special action, refer to code for details - Column 4: replacement string (or NULL if none) - - - Any LaTeX commands that do not start with a \ are handled separately, - however they are included in this table inside comments. - -*/ - -/* - The following lines correspond to definitions in cb_symbols.tex - Please update this list when cb_symbols.tex is changed -*/ - "cbdir", 0, NULL, "$n_src/doc/cook", - "NEWSTAR", 0, NULL, "<EM>NEWSTAR</EM>", - "Nseries", 0, NULL, "<EM>NEWSTAR</EM>", - - "cVis", 0, NULL, "<EM>V</EM>", - "pvis", 0, NULL, "<EM>Phi</EM>", - "avis", 0, NULL, "<EM>|V|</EM>", - "lavis", 0, NULL, "<EM>rho</EM>", - - "cGain", 0, NULL, "<EM>G</EM>", - "cNoise", 0, NULL, "<EM>N</EM>", - "cCadd", 0, NULL, "<EM>C</EM>", - - "perr", 0, NULL, "<EM>p</EM>", - "gerr", 0, NULL, "<EM>g</EM>", - "lerr", 0, NULL, "<EM>q</EM>", - "dang", 0, NULL, "<EM>phi</EM>", - "derr", 0, NULL, "<EM>Delta</EM>", - "eerr", 0, NULL, "<EM>Theta</EM>", - - "Apol", 0, NULL, "<EM>epsilon</EM>", - "Bpol", 0, NULL, "<EM>eta</EM>", - - "wgt", 0, NULL, "<EM>W</EM>", - "pwgt", 0, NULL, "<EM>W**p</EM>", - "lwgt", 0, NULL, "<EM>W**g</EM>", - - "pzd", 0, NULL, "<EM>psi</EM>", - - "farang", 0, NULL, "<EM>chi</EM>", - -/* - Here are the commands defined in cb_preamble.tex - Please update this list when cb_preamble.tex is changed -*/ - - "cbfile{", 0, _PUSH, "<TT>", - - "skeyword{", 0, _PUSH, "<DD><STRONG>", - "sprompt{", 0, _PUSH, "<EM>", - "sdefault{", 0, _PUSH, NULL, - "suser{", 0, _PUSH, " <KBD>", - "sline{", 0, _PUSH, "<DD><SAMP>", - "slong{", 0, _PUSH, "<DD><SAMP>", - "sskip", 0, NULL, "<P>", - "scmd{", 0, _PUSH, "<DD>> <KBD>", - - "sinline{", 0, _PUSH, " . . . <EM>", - "scomment{", 0, _PUSH, "<EM><P>", - - "setc", 0, NULL, "<P>:<P>:<P>", - "scr", 0, NULL, "<CR>", - "gloshead{", 0, _PUSH, "<H2>", - - -/* - Now follow the supported built-in LaTeX special characters - - A tilde (~, smallspace) is replaced by an normal space character - - Please mind that all commands below are prefixed by a backslash! -*/ - - " ", 0, NULL, " ", - "$", 0, NULL, "$", - "#", 0, NULL, "#", - "&", 0, NULL, "&", - "{", 0, NULL, "{", - "}", 0, NULL, "}", - "%", 0, NULL, "%", - "_", 0, NULL, "_", - "-", 0, NULL, NULL, - "\"o", 0, NULL, "ö", - "wedge", 0, NULL, "^", - - "arctan", 0, NULL, "<STRONG>arctan</STRONG>", - "ast", 0, NULL, "*", - "bigotimes", 0, NULL, "<STRONG>*</STRONG>", - "cdots", 0, NULL, "...", - "circ", 0, NULL, "o", - "copyright", 0, NULL, "(c)", - "delta", 0, NULL, "<EM>delta</EM>", - "div", 0, NULL, "-/-", - "equiv", 0, NULL, "==", - "exp", 0, NULL, "<STRONG>exp</STRONG>", - "gg", 0, NULL, ">>", - "infty", 0, NULL, "<STRONG>inf</STRONG>", - "lambda", 0, NULL, "<EM>lambda</EM>", - "ldots", 0, NULL, "...", - "log", 0, NULL, "<STRONG>log</STRONG>", - "over", 0, NULL, "/", - "phi", 0, NULL, "<EM>phi</EM>", - "pm", 0, NULL, "+/-", - "rightarrow", 0, NULL, "-->", - "sigma", 0, NULL, "<EM>sigma</EM>", - "sqrt", 0, NULL, "<STRONG>sqrt</STRONG>", - "sum", 0, NULL, "<STRONG>SUM</STRONG>", - "theta", 0, NULL, "<EM>theta</EM>", - "times", 0, NULL, ".", - "vdots", 0, NULL, ":", - -/* - Line separating commands - - An empty line will also translate to a <P> tag -*/ - - "\\", 0, NULL, "<DD>", /* Trick to get newline */ - "par", 0, NULL, "<P>", - "newpage", 0, NULL, "<P>", - "vspace", 0, _SKIP, "<P>", - -/* - Math modes - - $>$ and $<$ translate to the > and < entities, - any other $ .... $ construct is identical to \( ... \) - - $$ ... $$ constructs are identical to \[ ... \] -*/ - /* Inline math mode */ - "(", 0, NULL, " <EM> ", - ")", 0, NULL, " </EM> ", - "begin{math}", 0, NULL, " <EM> ", - "end{math}", 0, NULL, " </EM> ", - /* Display math mode */ - "[", 0, NULL, "<P><EM>", - "]", 0, NULL, "</EM><P>", - "begin{displaymath}", 0, NULL, "<P><EM>", - "end{displaymath}", 0, NULL, "</EM><P>", - "begin{equation}", 0, NULL, "<P><EM>", - "end{equation}", 0, NULL, "</EM><P>", - "begin{eqnarray}", 0, NULL, "<P><EM>", - "end{eqnarray}", 0, NULL, "</EM><P>", - -/* - Headings and references -*/ - "title{", 0, _PUSH, "<H1>", - "chapter{", 0, _PUSH, "<H1>", - "section{", 0, _PUSH, "<H1>", - "subsection{", 0, _PUSH, "<H2>", - "subsubsection{", 0, _PUSH, "<H3>", - - "label{", 0, _LABEL, NULL, - "ref{", 0, _ANCHOR, NULL, - "pageref{", 0, _ANCHOR, NULL, - "input{", 0, _ANCINP, NULL, - "include{", 0, _ANCINP, NULL, - - "eqno{", 0, _PUSH, "<EM>", - -/* - Many things are just ignored -*/ - "tableofcontents", 0, NULL, NULL, - "listoffigures", 0, NULL, NULL, - "listoftable", 0, NULL, NULL, - "makeindex", 0, NULL, NULL, - "documentstyle", 0, _SKIP, NULL, - "hskip", 0, _SKIP, NULL, - "hspace", 0, _SKIP, NULL, - "hline", 0, NULL, NULL, - "maketitle", 0, NULL, NULL, - "nonumber", 0, NULL, NULL, - "pagestyle", 0, _SKIP, NULL, - "pagenumbering", 0, _SKIP, NULL, - "parbox", 0, _SKIP, NULL, - -/* - Special handling for some environments -*/ - "begin{thebibliography}",0, NULL, "<H1>Bibliography</H1>\n", - "end{thebibliography}", 0, NULL, "<P>", - "bibitem", 0, _LABBIB, NULL, - "cite", 0, _ANCBIB, NULL, - - "begin{tabbing}", 0, _TABBING, NULL, - "end{tabbing}", 0, _TABBING, "<P>", - ">", 0, NULL, " ", - - "begin{figure", 0, _FIGURE, NULL, - "end{figure", 0, _FIGURE, "<P>", - "begin{tab", 0, _TABLE, NULL, - "end{tab", 0, _TABLE, "<P>", - "caption{", 0, _PUSH, "<EM>", - - "begin{enumerate}", 0, NULL, "<OL>", - "end{enumerate}", 0, NULL, "</OL>", - - "begin{itemize}", 0, NULL, "<UL>", - "end{itemize}", 0, NULL, "</UL>", - "item{", 0, _PUSH, "<LI> <STRONG>", - "itemitem{", 0, _PUSH, "<LI> <STRONG>", - "item", 0, NULL, "<LI>", - "itemitem", 0, NULL, "<LI>", - - "begin{verbatim}", 0, _VERBON, "<PRE>", - "begin{verbatim*}", 0, _VERBON, "<PRE>", - "end{verbatim}", 0, _VERBOF, "</PRE>", - -/* - All other environments are just skipped. - Note: the order in the table is important here! -*/ - "begin{", 0, _SKIP, "<P>", - "end{", 0, _SKIP, "<P>", - "author{", 0, _SKIP, NULL, - - "end", 0, NULL, NULL, - -/* - Font selections. These are special case things, since the required - syntax for a temporary font change is: - - {\bf ... } - - etc, so we test on the {\ rather than on the \ - - "rm", 0, _PUSH, "<STRONG>", - "bf", 0, _PUSH, "<STRONG>", - "em", 0, _PUSH, "<EM>", - "it", 0, _PUSH, "<EM>", - "tt", 0, _PUSH, "<TT>", - - Any isolated occurence of a font change is just ignored. - So you should use \chapter{{\it Something fresh}} - and not \chapter{\it Something fresh} - -*/ - "tiny", 0, NULL, NULL, - "bf", 0, NULL, NULL, - "it", 0, NULL, NULL, - "rm", 0, NULL, NULL, - "tt", 0, NULL, NULL, - -/* - The end of the table should be marked by a NULL command! -*/ - NULL, 0, NULL, NULL - - - -Appendix B: Naming convention for Newstar Documentation ------------ - -***** ALL LABELS AND FILENAMES SHOULD BE IN LOWER CASE ***** - - -1e. Labels - -The following conventions should be used for the naming of labels -and references (commands \ref{...}, \pageref{...} \label{...}): - - - The name of the label should consist of two or more elements - separated by dots. The first two elements uniquely identify the - file to which the reference is made. As a consequence all labels - in a file start with the same two elements. The remaining - elements serve as a reference within the file. - - - The label corresponding to a file a_b is a.b - A label within this file might be a.b.c or a.b.c.d - - The label corresponding to a file a_b_x is a.b_x - A label within this file might be a.b_x.c or a.b_x.c.d_y-z - - - References to keywords should be made as follows: - - \ref{<name of pin/psc/pef file>.<name of keyword>} - - * In general the name of the pin/psc/pef file will be the name of - * the program. For common keywords (including things like SCN_SETS) - * the name of the PEF file should be used! - - - - Figures, tables, formulea and other pieces of "difficult" LaTeX - will be included as GIF images, and should therefore be in separate - files. These files should have names fig_*.tex, tab_*.tex and - eqn_*.tex. Normal labeling conventions apply to such files. - -For bibliographic references (commands \bibitem and \cite) the normal -LaTeX conventions apply. - - -2e. Filenames - -The cookbook is built based on the following tree (all filenames have -extension .tex): - Label - cookbook (tittle page, table of contents) cookbook - | - | - +-- ch_biblio ch.biblio - | - +-- ch_general ch.general - | | - | +-- gen_intro gen.intro - | : - | - +-- ch_recipes ch.recipes - | | - | +-- rcp_line_21cm rcp.line_21cm - | +-- rcp_linear_polarisation rcp.linear_polarisation - | : - | - +-- ch_files ch.files - | | - | +-- files_descr files.descr - | +-- scn_descr scn.descr - | +-- mdl_descr mdl.descr - | : - | - +-- ch_programs ch.programs - | | - | +-- common_descr common.descr - | +-- common_keys common.keys - | | | - | | + ngen_comm ngen.comm - | | : - | | - | +-- nscan_descr nscan.descr - | +-- nscan_keys nscan.keys - | | | - | | + ngen_short ngen.short - | | : - | | - | +-- ncalib_descr ncalib.descr - | +-- ncalib_redun ncalib.redun - | +-- ncalib_polar ncalib.polar - | +-- ncalib_keys ncalib.keys - | | - | : - | - +-- ch_appendices ch.appendices - | - + apx_wsrtfactsheet apx.wsrtfactsheet - + apx_arquery apx.arquery - : - - -Files with keyword descriptions are generated automatically from the -pin/psc/pef files: - - - Each pin, psc and pef file is translated into a single LaTeX file - <name>_keys.tex (for pin/psc) or <name>_comm.tex (for pef). These - files contain the full description of each keyword define in the - pin/psc/pef file. For pef files, a keyword summary is generated - in file <name>_short.tex. An INCLUDE=NAME_PEF keyword in a psc file - will be translated in a \include{name_short} and a \ref{name.comm} - - - Each pin, psc and pef file is translated into a html file with - links to files with information on the individual keywords. - The index file has name <name>_keys.html (for pin/psc) or - <name>_comm.html (for pef). The files with keyword information are - named <name>_<keyword>.html - -Files with names fig_*.tex, tab_*.tex and eqn_*.tex will be included -as GIF figures. - - -Appendix C: Creating scripts of terminal sessions ------------ - -To create a script of a terminal session, the command - - $n_src/sys/document.csh script [file] - -should be used, this is conveniently aliased to "nscript". -If no filename is given, you will be prompted for one. - -This command will start the script command. The user has to initialise -Newstar by typing "$go" (this is not necessary if initialisation is done -in the user's .cshrc file). The initialisation procedure (in -$n_src/sys/newstar_init.csh) notices that the script utility is used -and will switch the DWARF bell "on". The prmpt will be set to "script> ". -You can execute all commands you like and then enter either "exit" or ^D. -The terminal session will now be transformed to a LaTeX file, which you -can edit at wish. - -The nscript command will ask you wether the terminal script should be -"Latex'ed" and printed or displayed (using xdvi, which should be in -your path). Often, you will want to edit the file first and then -view it. This is possible by typing: - - nscript -p [file] - -When answering to system prompts, you can add comments by prefixing -them with a semicolon followed by a hash mark, e.g.: - - script> dwe nscan ;# First we start reading data from tape - script> ls -l ; # This gives a directory listing - -If the hash is the first non-blank character on the line, the comment -will be on a line of it's own. - - script> # To start newstar, just type the following commands: - - -When answering to DWARF prompts, you can add comments by prefixing -them with an exclamation mark, e.g.: - - LEVELS = -20 -10 : 20 ! For this test, we use a single level - OPTION (blabla) = QUIT : ! No further processing needed! - -In the latter example, the second exclamation mark will just show up -as an exclamation mark (of course), the "empty" user respons will -translate to "<CR>" in the output. - - - NB: In order to facilate the script command, the DWARF "bell" is - now rung at the start of the prompt (used to be at the end). - The exclamation-mark comments turned out to be an existing DWARF - feature that had somewhat faded in the mist of times. - -The following LaTeX commands are used in translated terminal sessions; -they are defined for LaTeX in $n_src/doc/cook/cb_preamble.tex: - - \skeyword{ name of keyword } - \sprompt{ text of prompt } - \sdefault{ default value } - \suser{ user response } - - \sline{ line with terminal output } - \slong{ long line with terminal output } - - \scmd{ respons of user to operating system prompt } - - \sinline{ inline comment } - \scomment{ comment that is on a line of it's own } - \setc % Vertical dots replacing terminal output - \scr % Carriage Return in fixed width font - diff --git a/hlp/dwarf/dwarf__ask.html b/hlp/dwarf/dwarf__ask.html deleted file mode 100644 index ed3c9d29412114efba7ad4f4e0867a3ffd87ee17..0000000000000000000000000000000000000000 --- a/hlp/dwarf/dwarf__ask.html +++ /dev/null @@ -1,17 +0,0 @@ -<TITLE>Description of ASK (DWARF)</TITLE> -<H1>Program DWARF: private keyword ASK</H1> - -<DT><EM>Prompt:</EM> YES, NO -<DT><EM>Default:</EM> NO. -<DT><EM>Expected input:</EM> Character(4).<P> - ASK=YES directs DWARF programs to always prompt for parameters, even if <P> -an external default has been defined (through SPECIFY or otherwise). - This setting can be overridden by use of the /NOASK qualifier with the -EXECUTE command or with run-time parameter input. <P> - - <H3> More information: </H3> <UL> -<LI><A HREF="../dwarf/dwarf_keys.html">List of keywords</A> for DWARF -<LI><A HREF="../homepage.html">NEWSTAR Documentation Home page</A> -<LI>Description of <A HREF="../dwarf_descr/dwarf_descr.html">program DWARF</A> -<LI>The <A HREF="../common_descr/common_descr.html">DWARF User Interface</A> -</UL> diff --git a/hlp/dwarf/dwarf__bell.html b/hlp/dwarf/dwarf__bell.html deleted file mode 100644 index f20778621690e5ccb47cb1212de19b17e8d406c7..0000000000000000000000000000000000000000 --- a/hlp/dwarf/dwarf__bell.html +++ /dev/null @@ -1,15 +0,0 @@ -<TITLE>Description of BELL (DWARF)</TITLE> -<H1>Program DWARF: private keyword BELL</H1> - -<DT><EM>Prompt:</EM> ON, OFF Terminal bell with prompts and error messages -<DT><EM>Default:</EM> OFF. -<DT><EM>Expected input:</EM> Character(4).<P> - Controls the sounding of the terminal bell with error messages and <P> -with prompts for parameters <P> - - <H3> More information: </H3> <UL> -<LI><A HREF="../dwarf/dwarf_keys.html">List of keywords</A> for DWARF -<LI><A HREF="../homepage.html">NEWSTAR Documentation Home page</A> -<LI>Description of <A HREF="../dwarf_descr/dwarf_descr.html">program DWARF</A> -<LI>The <A HREF="../common_descr/common_descr.html">DWARF User Interface</A> -</UL> diff --git a/hlp/dwarf/dwarf__curnode.html b/hlp/dwarf/dwarf__curnode.html deleted file mode 100644 index 3ea9b24cb254c8647b1836b7edfb5b829fc65c1d..0000000000000000000000000000000000000000 --- a/hlp/dwarf/dwarf__curnode.html +++ /dev/null @@ -1,15 +0,0 @@ -<TITLE>Description of CURNODE (DWARF)</TITLE> -<H1>Program DWARF: private keyword CURNODE</H1> - -<DT><EM>Prompt:</EM> Current node name -<DT><EM>Default:</EM> 0. -<DT><EM>Expected input:</EM> Character(80).<P> - This is the node name with respect to which relative node names, i.e. <P> -node specifications starting with "." or "-", will be expanded <P> - - <H3> More information: </H3> <UL> -<LI><A HREF="../dwarf/dwarf_keys.html">List of keywords</A> for DWARF -<LI><A HREF="../homepage.html">NEWSTAR Documentation Home page</A> -<LI>Description of <A HREF="../dwarf_descr/dwarf_descr.html">program DWARF</A> -<LI>The <A HREF="../common_descr/common_descr.html">DWARF User Interface</A> -</UL> diff --git a/hlp/dwarf/dwarf__extendsize.html b/hlp/dwarf/dwarf__extendsize.html deleted file mode 100644 index 3cb45832daa6692e180e3071682d05800c6a4ba2..0000000000000000000000000000000000000000 --- a/hlp/dwarf/dwarf__extendsize.html +++ /dev/null @@ -1,16 +0,0 @@ -<TITLE>Description of EXTENDSIZE (DWARF)</TITLE> -<H1>Program DWARF: private keyword EXTENDSIZE</H1> - -<DT><EM>Prompt:</EM> Default extension size in blocks for DWARF data files -<DT><EM>Default:</EM> 64. -<DT><EM>Expected input:</EM> Integer number; min.value: 1.000000; max.value: 512.000000.<P> - Defines the minimum extension size to be applied by DWARF I/O routines. <P> -An actual extension will be the maximum of this parameter and the extension -requested by the program. <P> - - <H3> More information: </H3> <UL> -<LI><A HREF="../dwarf/dwarf_keys.html">List of keywords</A> for DWARF -<LI><A HREF="../homepage.html">NEWSTAR Documentation Home page</A> -<LI>Description of <A HREF="../dwarf_descr/dwarf_descr.html">program DWARF</A> -<LI>The <A HREF="../common_descr/common_descr.html">DWARF User Interface</A> -</UL> diff --git a/hlp/dwarf/dwarf__ibmode.html b/hlp/dwarf/dwarf__ibmode.html deleted file mode 100644 index 7fad9f92b5a4a5aba65d02cd7c6331f703569ec8..0000000000000000000000000000000000000000 --- a/hlp/dwarf/dwarf__ibmode.html +++ /dev/null @@ -1,15 +0,0 @@ -<TITLE>Description of IBMODE (DWARF)</TITLE> -<H1>Program DWARF: private keyword IBMODE</H1> - -<DT><EM>Prompt:</EM> INTERACTIVE, BATCH, NETWORK -<DT><EM>Default:</EM> INTERACTIVE. -<DT><EM>Expected input:</EM> Character(11).<P> - This is the batch/interactive flag maintained by DWARF, It can not be <P> -changed by the user. <P> - - <H3> More information: </H3> <UL> -<LI><A HREF="../dwarf/dwarf_keys.html">List of keywords</A> for DWARF -<LI><A HREF="../homepage.html">NEWSTAR Documentation Home page</A> -<LI>Description of <A HREF="../dwarf_descr/dwarf_descr.html">program DWARF</A> -<LI>The <A HREF="../common_descr/common_descr.html">DWARF User Interface</A> -</UL> diff --git a/hlp/dwarf/dwarf__ident.html b/hlp/dwarf/dwarf__ident.html deleted file mode 100644 index d777cf8b1584b1f419917c79e201d06e2ed4de3f..0000000000000000000000000000000000000000 --- a/hlp/dwarf/dwarf__ident.html +++ /dev/null @@ -1,15 +0,0 @@ -<TITLE>Description of IDENT (DWARF)</TITLE> -<H1>Program DWARF: private keyword IDENT</H1> - -<DT><EM>Prompt:</EM> -<DT><EM>Default:</EM> XYZ. -<DT><EM>Expected input:</EM> Character(3).<P> - This is the process identification used by DWARF. It can not be <P> -changed by the user. <P> - - <H3> More information: </H3> <UL> -<LI><A HREF="../dwarf/dwarf_keys.html">List of keywords</A> for DWARF -<LI><A HREF="../homepage.html">NEWSTAR Documentation Home page</A> -<LI>Description of <A HREF="../dwarf_descr/dwarf_descr.html">program DWARF</A> -<LI>The <A HREF="../common_descr/common_descr.html">DWARF User Interface</A> -</UL> diff --git a/hlp/dwarf/dwarf__iobufsize.html b/hlp/dwarf/dwarf__iobufsize.html deleted file mode 100644 index da74436c55fa9aef2aec70a98fcd02842dbf284e..0000000000000000000000000000000000000000 --- a/hlp/dwarf/dwarf__iobufsize.html +++ /dev/null @@ -1,16 +0,0 @@ -<TITLE>Description of IOBUFSIZE (DWARF)</TITLE> -<H1>Program DWARF: private keyword IOBUFSIZE</H1> - -<DT><EM>Prompt:</EM> Default I/O buffer size in bytes -<DT><EM>Default:</EM> 32768. -<DT><EM>Expected input:</EM> Integer number; min.value: 2048.000000; max.value: 32768.000000.<P> - This is the default size of I/O buffers to be allocated by the DWARF <P> -bulk I/O routines. This parameter is intended primarily for adapting DWARF to -host systems with limited physical memory. <P> - - <H3> More information: </H3> <UL> -<LI><A HREF="../dwarf/dwarf_keys.html">List of keywords</A> for DWARF -<LI><A HREF="../homepage.html">NEWSTAR Documentation Home page</A> -<LI>Description of <A HREF="../dwarf_descr/dwarf_descr.html">program DWARF</A> -<LI>The <A HREF="../common_descr/common_descr.html">DWARF User Interface</A> -</UL> diff --git a/hlp/dwarf/dwarf__logfatal.html b/hlp/dwarf/dwarf__logfatal.html deleted file mode 100644 index b1b43bc6a57f27e563ae6a19ba8ea2faa7557153..0000000000000000000000000000000000000000 --- a/hlp/dwarf/dwarf__logfatal.html +++ /dev/null @@ -1,15 +0,0 @@ -<TITLE>Description of LOGFATAL (DWARF)</TITLE> -<H1>Program DWARF: private keyword LOGFATAL</H1> - -<DT><EM>Prompt:</EM> YES, NO Do you want unsuccessful program runs logged -<DT><EM>Default:</EM> NO. -<DT><EM>Expected input:</EM> Character(4).<P> - This parameter controls the logging of program runs that terminate <P> -with a failure status. If LOGFATAL=NO, only successfull runs will be logged. <P> - - <H3> More information: </H3> <UL> -<LI><A HREF="../dwarf/dwarf_keys.html">List of keywords</A> for DWARF -<LI><A HREF="../homepage.html">NEWSTAR Documentation Home page</A> -<LI>Description of <A HREF="../dwarf_descr/dwarf_descr.html">program DWARF</A> -<LI>The <A HREF="../common_descr/common_descr.html">DWARF User Interface</A> -</UL> diff --git a/hlp/dwarf/dwarf__loglevel.html b/hlp/dwarf/dwarf__loglevel.html deleted file mode 100644 index 56a66d0bab8520963b85b4273bf653658a2dc09e..0000000000000000000000000000000000000000 --- a/hlp/dwarf/dwarf__loglevel.html +++ /dev/null @@ -1,18 +0,0 @@ -<TITLE>Description of LOGLEVEL (DWARF)</TITLE> -<H1>Program DWARF: private keyword LOGLEVEL</H1> - -<DT><EM>Prompt:</EM> Severity threshold for logging messages -<DT><EM>Default:</EM> 4. -<DT><EM>Expected input:</EM> Integer number; min.value: 0.000000; max.value: 8.000000.<P> - This parameter defines the level below which messages will not be <P> -logged. If LOGLEVEL=0, all messages are logged; if it is 8 you get no log at -all. - LOGLEVEL=4 will give you all informational messages from DWARF programs -plus fatal error messages. <P> - - <H3> More information: </H3> <UL> -<LI><A HREF="../dwarf/dwarf_keys.html">List of keywords</A> for DWARF -<LI><A HREF="../homepage.html">NEWSTAR Documentation Home page</A> -<LI>Description of <A HREF="../dwarf_descr/dwarf_descr.html">program DWARF</A> -<LI>The <A HREF="../common_descr/common_descr.html">DWARF User Interface</A> -</UL> diff --git a/hlp/dwarf/dwarf__messagedevice.html b/hlp/dwarf/dwarf__messagedevice.html deleted file mode 100644 index a05613f2a4a617842562cbfb106717dc5529356e..0000000000000000000000000000000000000000 --- a/hlp/dwarf/dwarf__messagedevice.html +++ /dev/null @@ -1,15 +0,0 @@ -<TITLE>Description of MESSAGEDEVICE (DWARF)</TITLE> -<H1>Program DWARF: private keyword MESSAGEDEVICE</H1> - -<DT><EM>Prompt:</EM> TERMINAL, PRINTER Device(s) for messages -<DT><EM>Default:</EM> TERMINAL. -<DT><EM>Expected input:</EM> Character(8), 2 values.<P> - Defines where messages will be shown: On the terminal and/or in a file <P> -to be spooled automatically to the line printer <P> - - <H3> More information: </H3> <UL> -<LI><A HREF="../dwarf/dwarf_keys.html">List of keywords</A> for DWARF -<LI><A HREF="../homepage.html">NEWSTAR Documentation Home page</A> -<LI>Description of <A HREF="../dwarf_descr/dwarf_descr.html">program DWARF</A> -<LI>The <A HREF="../common_descr/common_descr.html">DWARF User Interface</A> -</UL> diff --git a/hlp/dwarf/dwarf__savelast.html b/hlp/dwarf/dwarf__savelast.html deleted file mode 100644 index bc4c058c80d7ab04801d479979cd70c8a37560eb..0000000000000000000000000000000000000000 --- a/hlp/dwarf/dwarf__savelast.html +++ /dev/null @@ -1,17 +0,0 @@ -<TITLE>Description of SAVELAST (DWARF)</TITLE> -<H1>Program DWARF: private keyword SAVELAST</H1> - -<DT><EM>Prompt:</EM> YES, NO -<DT><EM>Default:</EM> NO. -<DT><EM>Expected input:</EM> Character(4).<P> - SAVELAST=YES directs DWARF programs to save the last value typed in <P> -during program execution as an external default for later program runs. - The setting of this paramater can be overriden by use of the -/[NO]SAVELAST qualifier with the EXECUTE command or with parameter input. <P> - - <H3> More information: </H3> <UL> -<LI><A HREF="../dwarf/dwarf_keys.html">List of keywords</A> for DWARF -<LI><A HREF="../homepage.html">NEWSTAR Documentation Home page</A> -<LI>Description of <A HREF="../dwarf_descr/dwarf_descr.html">program DWARF</A> -<LI>The <A HREF="../common_descr/common_descr.html">DWARF User Interface</A> -</UL> diff --git a/hlp/dwarf/dwarf__stream.html b/hlp/dwarf/dwarf__stream.html deleted file mode 100644 index 46e3e2fb38eda2160e66425e657ccbd7c1940a57..0000000000000000000000000000000000000000 --- a/hlp/dwarf/dwarf__stream.html +++ /dev/null @@ -1,15 +0,0 @@ -<TITLE>Description of STREAM (DWARF)</TITLE> -<H1>Program DWARF: private keyword STREAM</H1> - -<DT><EM>Prompt:</EM> Stream name -<DT><EM>Default:</EM> 1. -<DT><EM>Expected input:</EM> Character(11).<P> - Defines the "current stream name" to be used as default for the <P> -stream component in program and DWARF symbol names <P> - - <H3> More information: </H3> <UL> -<LI><A HREF="../dwarf/dwarf_keys.html">List of keywords</A> for DWARF -<LI><A HREF="../homepage.html">NEWSTAR Documentation Home page</A> -<LI>Description of <A HREF="../dwarf_descr/dwarf_descr.html">program DWARF</A> -<LI>The <A HREF="../common_descr/common_descr.html">DWARF User Interface</A> -</UL> diff --git a/hlp/dwarf/dwarf__test.html b/hlp/dwarf/dwarf__test.html deleted file mode 100644 index 70810b00300fd5b6f9c976794c312dc84b4d29cf..0000000000000000000000000000000000000000 --- a/hlp/dwarf/dwarf__test.html +++ /dev/null @@ -1,20 +0,0 @@ -<TITLE>Description of TEST (DWARF)</TITLE> -<H1>Program DWARF: private keyword TEST</H1> - -<DT><EM>Prompt:</EM> YES, NO Set DWARF test mode -<DT><EM>Default:</EM> NO. -<DT><EM>Expected input:</EM> Character(4).<P> - In testing mode: <P> - Parameters with the TEST attribute will be prompted for. - The debugger will be automatically invoked at the instant an -error is reported. (Note that this may already happen during the execution -of the remainder of the SPECIFY DWARF command. In that case, just type "GO" in -reply to debugger prompts, and "EXIT" when the debugger reports program -completion.) <P> - - <H3> More information: </H3> <UL> -<LI><A HREF="../dwarf/dwarf_keys.html">List of keywords</A> for DWARF -<LI><A HREF="../homepage.html">NEWSTAR Documentation Home page</A> -<LI>Description of <A HREF="../dwarf_descr/dwarf_descr.html">program DWARF</A> -<LI>The <A HREF="../common_descr/common_descr.html">DWARF User Interface</A> -</UL> diff --git a/hlp/dwarf/dwarf__userlevel.html b/hlp/dwarf/dwarf__userlevel.html deleted file mode 100644 index b0434f1cd10c81db630aab22a513388c3db71252..0000000000000000000000000000000000000000 --- a/hlp/dwarf/dwarf__userlevel.html +++ /dev/null @@ -1,20 +0,0 @@ -<TITLE>Description of USERLEVEL (DWARF)</TITLE> -<H1>Program DWARF: private keyword USERLEVEL</H1> - -<DT><EM>Prompt:</EM> BEGINNER, AVERAGE, EXPERT How do you rate yourself as a DWARF user -<DT><EM>Default:</EM> BEGINNER. -<DT><EM>Expected input:</EM> Character(8).<P> - Defines the amount of information to be given with parameter prompts: <P> -<DT><STRONG> EXPERT:</STRONG> Keyword name and default only - AVERAGE: Same plus available options where applicable - BEGINNER: Some descriptive information in addition - While being prompted, you may temporarily descend to a "lower" level -by typing a question mark; by adding /KEEP to the "?" you may retain this lower -level until program exit. <P> - - <H3> More information: </H3> <UL> -<LI><A HREF="../dwarf/dwarf_keys.html">List of keywords</A> for DWARF -<LI><A HREF="../homepage.html">NEWSTAR Documentation Home page</A> -<LI>Description of <A HREF="../dwarf_descr/dwarf_descr.html">program DWARF</A> -<LI>The <A HREF="../common_descr/common_descr.html">DWARF User Interface</A> -</UL> diff --git a/hlp/dwarf_keys/dwarf_keys.html b/hlp/dwarf_keys/dwarf_keys.html deleted file mode 100644 index e93d200629b231ddd4cab848f02995cc57ae1a98..0000000000000000000000000000000000000000 --- a/hlp/dwarf_keys/dwarf_keys.html +++ /dev/null @@ -1,54 +0,0 @@ -<TITLE>Index of private keywords for DWARF </TITLE> -<H1>Description of keywords for program DWARF</H1> - -<UL> -<LI> <A HREF="../dwarf/dwarf__stream.html"> - STREAM</A> - Stream name -<LI> <A HREF="../dwarf/dwarf__curnode.html"> - CURNODE</A> - Current node name -<LI> <A HREF="../dwarf/dwarf__ask.html"> - ASK</A> - YES, NO -<LI> <A HREF="../dwarf/dwarf__savelast.html"> - SAVELAST</A> - YES, NO -<LI> <A HREF="../dwarf/dwarf__userlevel.html"> - USERLEVEL</A> - BEGINNER, AVERAGE, EXPERT How do you rate yourself as a DWARF user -<LI> <A HREF="../dwarf/dwarf__bell.html"> - BELL</A> - ON, OFF Terminal bell with prompts and error messages -<LI> <A HREF="../dwarf/dwarf__messagedevice.html"> - MESSAGEDEVICE</A> - TERMINAL, PRINTER Device(s) for messages -<LI> <A HREF="../dwarf/dwarf__extendsize.html"> - EXTENDSIZE</A> - Default extension size in blocks for DWARF data files -<LI> <A HREF="../dwarf/dwarf__iobufsize.html"> - IOBUFSIZE</A> - Default I/O buffer size in bytes -<LI> <A HREF="../dwarf/dwarf__test.html"> - TEST</A> - YES, NO Set DWARF test mode -<LI> <A HREF="../dwarf/dwarf__loglevel.html"> - LOGLEVEL</A> - Severity threshold for logging messages -<LI> <A HREF="../dwarf/dwarf__logfatal.html"> - LOGFATAL</A> - YES, NO Do you want unsuccessful program runs logged -<LI> <A HREF="../dwarf/dwarf__ident.html"> - IDENT</A> - -<LI> <A HREF="../dwarf/dwarf__ibmode.html"> - IBMODE</A> - INTERACTIVE, BATCH, NETWORK -</UL> - - - <H3> More information: </H3> <UL> -<LI><A HREF="../homepage.html">NEWSTAR Documentation Home page</A> -<LI><A HREF="../hb_contents/hb_contents.html">The NEWSTAR Cookbook</A> -<LI>Description of <A HREF="../dwarf_descr/dwarf_descr.html">program DWARF</A> -</UL> diff --git a/hlp/dwarfini.txt b/hlp/dwarfini.txt deleted file mode 100644 index e4e1529cf57459f7cbac99b9f4458befc05653dd..0000000000000000000000000000000000000000 --- a/hlp/dwarfini.txt +++ /dev/null @@ -1,4 +0,0 @@ - -1 Type dwnews to get information about the recent changes in the DWARF system. - -************************************************** 16-Dec-92 WNB *********** diff --git a/hlp/dwarfnews.txt b/hlp/dwarfnews.txt deleted file mode 100644 index ec34bde921b0c94db24c5e81d2420760cd5b9c68..0000000000000000000000000000000000000000 --- a/hlp/dwarfnews.txt +++ /dev/null @@ -1,94 +0,0 @@ -1 DWARFnews - - - 911210 Some improvements have been made to DWARF. - The main improvement is that a program is starting faster because - the symbol handling software is much faster. The number of symbols - allowed is unlimited, but of course you should not let it grow too - much. The symbol files are now located in a separate subdirectory, - which is automatically created by .dwarflogin when it does not exist. - .dwarflogout saves your symbol files and deletes symbol files older - than 1 week. You should therefore use - source $SYSDWARF/.dwarflogout in your logout file. - Secondly the EXEC call is used as much as possible to start the - programs. This has the benefit that no shell is created to run the - program and that EXECUTE disappears after having started the program. - Thirdly some environment variables resembling the VAX logical names - have been defined. These are $SYSDWARF, $RUNDWARF and $LIBDWARF. - These variables should be used as much as possible instead of the - ~dwarf construction, because they are more system independent. - At last a few minor bugs have been removed. - - 910913 The following DWARF command aliases have been defined: - dwc for dwclear (see 910814) - dwe for dwexe (see below) - dwl for dwlet (see 910814) - dwn for dwnews (display this file) - dwr for restore (see 910814) - dws for specify - dwsa for dwsave (see 910814) - dwv for dwview (see 910817) - - The DWARF command dwexe has been installed. It behaves roughly like - the EXE*CUTE command on the VAX, e.g.: - dwexe 'program$stream <qualifiers>' - runs the program in the given stream taking the qualifiers - into account. - The following qualifiers are recognized: - /[no]ask /[no]save /[no]test (as on the VAX); - /input=<file> lets the program read input from the file; - /nowait runs the program in the background (it will - stop when it needs input from the terminal); - /batch runs the program in the background, but lets - the program take its input from the null device - and writes the output to <prognam><stream>.log; - /debug executes the program under dbx; - /norun for N-type programs: runs the program in - specify mode: only asks for parameter input - and saves the answers in external defaults); - for other programs: only saves any ask, save - or test switch given (as on the VAX); - /nolog or /log=<value> - /nodatab - /noinfix - /noapply or /apply=<list> - /node_apply or /de_apply=<list> - are only recognized for N-type programs; first, - defaults for the corresponding program - parameters are specified according to the - qualifiers given. - - 910817 Command dwview installed (similar to DWARF/VAX's VIEW): - Examples: - dwview - lists all external defaults (specified or restored) - dwview 'program$stream' - lists all program parameters and their current defaults - (external or PPD) in the given or current stream - dwview 'program /external' - only lists the program parameters with external defaults - dwview 'name_list /input=save_file' - lists all saved parameter defaults matching the namelist - - 910814 Some more VAX/DWARF commands have been activated on the Alliant. - The command lines given below are meant to show all the possible - qualifiers; all their names can be abbreviated to a single letter. - The quotes suppress the interpretation of meta-characters by the shell. - - dwclear 'list /exclude=list /confirm /log=long' - clears the listed parameter defaults (list required) - dwsave 'list /output=file /exclude=list /confirm /log=short' - saves the listed defaults in the file - (default: save all defaults in .dwarfsave.sav) - restore 'file /include=list /exclude=list /confirm /overwrite /nolog' - restores (all) defaults from the file - dwlet 'name=value /log=short' - defines a global symbol - prtunits - displays DWARF units and conversion factors - - 910806 External defaults are no longer automatically carried over from your - previous session. However, you can activate this option by copying - ~dwarf/protologout to ~/.logout. From then on, when you log out, all - the defaults are saved in the file ~/symbol.sav and, when you log in - again, DWARF's login procedure will restore them. diff --git a/hlp/dwcalc.txt b/hlp/dwcalc.txt deleted file mode 100644 index 9dccc78319cb0089a052f3a7a0ea7d481154b43c..0000000000000000000000000000000000000000 --- a/hlp/dwcalc.txt +++ /dev/null @@ -1,276 +0,0 @@ -The desk-calcutor program DWCALC --------------------------------- - -HISTORY: - This file was originally written as a VAX/VMS HELP file. The program -dwcalc was part of the DWARF infrastructure which has been merged into Newstar. -This file has been taken over essentially as it was found. - - 8-oct-86 Ger van Diepen - JPH 940718 Update for Newstar - JPH 940918 Formatting for line-breaking algorithm - - -DWCALC -====== - -The program DWCALC is a handy desk-calculator, allowing the use of expressions -(with units), symbols and formulae. It is derived from the Dutch image -processing system DWARF. (Dwingeloo Westerbork Astronomical Reduction -Facility). - - The program is started by the command 'dwcalc'. Qualifiers can be used to -control the program. If they are given at the 'dwcalc' command-line, they -serve as a global qualifier. Global qualifiers can be overridden for each -individual expression-line by ending the line with the qualifiers, preceeded -by at least one space (to distinguish it from the division operator). - - The input expressions are read from stdin. The results are listed on stdout. -Optionally (part of) input and output can be logged. All input is converted to -uppercase, therefore input is NOT case-sensitive. - - -EXPRESSIONS -=========== - After having started the program, the program asks you for an expression. By -giving a null-answer the program will be stopped. Typing a question mark -starts a help session. Typing UNIT=? will show you the available units on -printer or terminal. - -Expressions have the normal arithmetical format, using +,-,*,/,** and -parentheses. Blanks and unary signs are allowed. However, note that / cannot -be preceeded by a blank to distinguish it from the qualifier-indicator. The -relational operators .NOT.,.EQ.,.NE.,.GT.,.GE.,.LE. and .LT. are also allowed. - Also available are: - some built-in functions (goniometric, etc.) - unit -specification and conversion - special format for time or positions (using -colons) - symbol definition and substitution - -Integer numbers can be specified in octal or hexadecimal format (use %O, %X, -resp.). - - -FUNCTIONS -========= - -The following functions (similar to Fortran) can be used in expressions: - - MIN MAX (1-10 arguments) - SIN COS TAN - ASIN ACOS ATAN ATAN2 - ABS EXP LOG LOG10 SQRT - TRUNC ROUND MOD SIGN - -Default unit for goniometric function is degrees, which can be overridden via -the /UNIT-qualifier or by giving the unit in the expression. - -The result of SIGN is: - -1 for negative values - 0 for zero - 1 for positive values - -Note that conversion to integer format implies rounding. - - -UNITS -===== - -CALCULATE is able of converting from one unit to another. It converts the -units given in the expression to the unit given by the /UNIT-qualifier. The -units must belong to the same group (so conversion from SEC to KM is -impossible). - -A unit can be given at several places: - - - after a number e.g. 10DEG - - after a subexpression e.g. (10+3)deg - - after a symbol e.g. PI RAD - - Note that in the last case the blank is significant, else it is optional. - - -TIME_POSITION -------------- - -Times and positions can be given in HH:MM:SS (or DD:MM:SS) format using colons -as separators. A unit may follow the value. Each part can be a floating number, -which may exceed 60. - -The output can also be listed in that format by giving /UNIT=HMS or /UNIT=DMS. - -This sexagesimal format allows for easy addition, subtraction and conversion -of times and positions. - - -SYMBOLS -======= - -Symbols are very useful for storing results and for handling formulae. Both -symbol substitution and definition is possible in DWCALC. DWCALC will always -define global symbols. It is also possible to use predefined local or global -symbols, either numeric or alphanumeric. - -By defining a formula as a symbol, it is very easy to calculate the result of -the formula for several values of its parameters. E.g. - - $ VOLUME = "4/3*pi*r**3" - $ CALC - Expression: r=3 - Expression: volume - Expression: r=10 - Expression: volume - - -DEFINITION ----------- - -A symbol can be defined by using the constructS: - - symbol_name = expression - symbol_name = "expression" - -In the first case the expression is evaluated and the result will be assigned -to the symbol. In the second case the expression-text is assigned to the -symbol, which is useful for defining formulae. - -Note that DCL uses the same procedure. - -SUBSTITUTION ------------- - -Symbols can be substituted in an expression by giving its name enclosed in -apostrophes or giving its name without apostrophes. - -In the former case its value is substituted literally. In the latter case its -value is treated as a subexpression. E.g. if I=3+4 then - - 3*'i' results in 3*3+4 = 13 and - 3*i results in 3*(3+4) = 21 - -Note that nested substitution is possible. Circular substitution is detected by -allowing a maximum of 25 substitutions. - - -Examples -======== - -Convert miles to kilometers - - $ dwcalc 10mile /unit=km - -If a whole series must be done it would be better to do: - - $ dwcalc/unit=km - 10mile - 8 mile - (1.25+3.48)mile - -Convert right ascension from HH:MM:SS to degrees. - - $ dwcalc/unit=deg 9:23:48.329 hms - -Convert a time to seconds - - $ dwcalc/unit=sec 9:23:48.329 hr - -Do some time calculation - - $ dwcalc/unit=hms 10:34:48 + 2::45 - :34:56.89 - -Calculate an expression and define the symbol ABC The result must be an integer - - $ dwcalc ABC = (2.34 * pi)+8*-cos(135+pi*28) /unit=deg - -Define a formula and calculate it for several parameters - - $ dwcalc - VOLUME = "4/3*PI*R**3" - R=2 - VOLUME - R=10 - VOLUME - -Convert from hexadecimal to decimal - - %x1a2f - -Convert from decimal to hexadecimal - - 2546 /rad=x - -/UNIT -===== - -This qualifier defines the default unit for the given values and the unit in -which the result will be expressed. In this way it can be used for converting -rom one unit to another. Note however that conversion between different groups -of units is not allowed (e.g. seconds to meters is illegal). - -From DCL the available units can be shown via the command PRTUNIT. From -CALCULATE they can be shown via UNIT=?. - -Default is no units. - - -/RADIX -====== - -This qualifier defines in which radix the output will be listed. Possible -values are: - - D decimal - O octal - X hexadecimal - -The default is D. O and X force TYPE=J if type is non-integer. - - -/TYPE -===== - -This qualifier defines in which format the output will be listed. Note that all -calculations are done in double precision and that the program tests on -integer overflow before conversion to an integer format. Possible values are: - - B signed byte - I signed word (integer*2) - J signed longword (integer*4) - L logical - R single precision (real*4) - D double precision (real*8) - -The default is D. - - -/STREAM -======= - -This qualifier is special to DWARF. It controls the stream of the application -symbols. The stream-name will be inserted in a symbol-name, if that symbol-name - has the format "image_keyword". - -Default is no stream. - - -/LIST -===== - -This qualifier controls if the results will be listed. Normally you will always -list the result, but in command-files it can be useful to negate this -qualifier (i.e. /NOLIST). - -Default is list. - - -/LOG -==== - -This qualifier controls if the expressions and results will be written in the -log-file CALCULATE.LOG (in the default directory). This log-file is written in -such a way that it can be executed as a DCL command-file or can be used as -input for the ARCHIVE-programs. This means that most lines will be flagged with -an exclamation mark (indicating comments), but symbol definitions are valid -commands, which can be executed. In this way users can calculate complex -expressions and define the results as symbols in a subprocess and execute the -log-file in the main process in order to obtain the results. - -Default is no logging. diff --git a/hlp/elsewhere_inst_maint.html b/hlp/elsewhere_inst_maint.html deleted file mode 100644 index f6766aaf37e8481a0d2db99fb9f2171b2f5b3473..0000000000000000000000000000000000000000 --- a/hlp/elsewhere_inst_maint.html +++ /dev/null @@ -1,423 +0,0 @@ -<TITLE>Installation and maintenance of Newstar outside NFRA</TITLE> - -<STRONG>Subject:</STRONG> Installation and maintenance of Newstar outside NFRA -<BR><STRONG>Author:</STRONG> Marco de Vos (CMV), Henk Vosmeijer (HjV) -<BR><STRONG>To:</STRONG> Friends of Newstar -<P><STRONG>Date:</STRONG> 24/11/94 -<P> -<EM>Revision history</EM> -<UL> -<LI>18/06/96 - add Solaris as available machine, correct Building Newstar part -<LI>24/11/94 - add questionnaire new Newstar sites, make html -<LI>16/02/94 - first release -<LI>04/03/94 - prerelease -</UL> - -<PRE></PRE> -<H1>Installation and maintenance of Newstar outside NFRA</H1> -<PRE></PRE> - -<H2>1. About Newstar and this document</H2> - -Newstar is the reduction package for WSRT data. -<BR>It makes optimal use of the specific properties of the WSRT. - -<P>You can use it to: -<UL> -<LI>read, display, calibrate and analyse WSRT data. -<LI>flag bad data interactively or in semi-automatic mode. -<LI>extract and improve parametrised models from the data. -<LI>make and manipulate calibrated maps. -<LI>save raw or calibrated data as UVFITS tapes or files. -<LI>save maps as FITS tapes or files. -</UL> - -General information on Newstar operations can be found in the Newstar -Documentation. This documentation is available on-line. If you are -familiar with World Wide Web browsers like XMosaic, you can get at the -documentation by opening <A HREF=http://www.astron.nl/newstar/hlp/homepage.html>http://www.astron.nl/newstar/hlp/homepage.html</A> -<BR>Otherwise, please send an eMail to <EM>newstar@astron.nl</EM> for assistance. -<P> -This document is concerned with installation and maintenance of Newstar -at institutes other than the NFRA. It descibes our export policy, the -procedure for first time installation and the procedures for local -maintenance. -<PRE></PRE> - -<H2>2. Export policy</H2> - -The master copy of the Newstar software is maintained at the NFRA in -Dwingeloo. Newstar is available for end-users on the following machines: -<UL> -<LI>hp = HP Workstations (9000 series, others at request) -<LI>sw = Sun Workstations (sun4) -<LI>dw = DEC Workstations (DEC3100) -<LI>da = DEC Alpha/OSF1 -<LI>so = Sun Solaris -</UL> - -(the two-letter codes will be used in the remainder of this document) -<P> -This list may be extended with other Unix systems in future. Newstar -can also be run on Convex (cv) systems, but this is not officially -supported by the NFRA. -<P> -If you want to install Newstar on your institute, the Newstar group -will assist with the first time installation of the package. We expect -you to assign a local "Friend of Newstar" who will take care of local -maintenance, using the procedures described in this document. In case -of problems, you can of course contact the Newstar group, who will do -it's best to solve things on a short notice. -<P> -The Newstar maintenance at the radio-observatory in Westerbork is -updated by the Newstar group at a weekly basis. -<PRE></PRE> - -<H2>3. First time installation</H2> - -It should be noted that the Newstar group is available for assistance -with the first time installation of Newstar. Also we can implement such -things as changes in printers and tapeunits. However, this section -describes the installation process in full detail. -<P> -<H3>3A. Before installation</H3> - -Before you can install Newstar, you have to sort out the following -things: -<UL> -<LI>Set up an account for Newstar, or at least a directory where -Newstar can be installed (this directory will be refered to as -the "Newstar root-directory" in the remainder of this document). -<P> -At present, disk-space requirements are: -<UL> -<LI>Sources: 15 ... 27 MByte -<LI>Libraries: 20 ... 25 MByte (for each architecture) -<LI>Executables: 60 ... 90 MByte (for each architecture) -</UL> -<BR>The amount of diskspace varies per architecture. -<BR>Sources, libraries and executables may reside at separate filesystems. -<P> -<LI>Find out the commands to send ASCII and postscript files to -your local printer(s). -<P> -<LI>Find out the names of the tapeunits connected to your hosts -</UL> -You should fill out the form in <STRONG>Appendix A</STRONG> and eMail -it to <EM>newstar@astron.nl</EM> (from this point on the Newstar group -can take care of installation). - - -<H3>3B. Installing the Newstar sources</H3> - -You should have tar-archives nstar_src.tar.Z and nstar_src_aa.tar -(where aa is the abbreviation of the architecture on which you want to -use Newstar, you may need several nstar_src_aa.tar files) from tape or -from anonymous ftp to ftp.astron.nl (directory newstar). -<BR>To unpack this archive, use the following commands: -<PRE> ->>> cd "Newstar root-directory" ->>> mkdir src ->>> cd src ->>> uncompress [directory_with_archive/]nstar_src.tar.Z ->>> tar xvf [directory_with_archive/]nstar_src.tar ->>> tar xvf [directory_with_archive/]nstar_src_aa.tar -</PRE> - -<H3>3C. Adapting to your local situation</H3> - -Assign an abbreviated name for your institute (up to 5 characters). This -name will be refered to as "xxxx" in the remainder of this document. -<P> -Your local situation will be reflected in the following files, all in -directory "Newstar root-directory"/src/sys -<PRE> -newstar_xxxx.csh Directory structure, tape-units, some details -wngfex_xxxx.csh Commands for printing -i_aaxxxx.csh Fine-tuning for compilation on architecture "aa" -</PRE> -In general, the Newstar group will create these files based on information -supplied by you. In case you want to create the files yourself, please use -the versions for the nfra (newstar_nfra.csh etc.) as a template, since -they are extensively documented. -<P> -In newstar_xxxx.csh you should define at least the following: -<OL> -<LI>The Newstar rootdirectory -<BR><TT>(setenv n_root "Newstar root-directory")</TT> -<P> -<LI>The Newstar site -<BR><TT>(setenv n_site xxxx)</TT> -<P> -<LI>The architectures you want to install Newstar for (we distribute -some precompiled binaries and libraries for which you need only the -versions specified here, these are in fact in nstar_src_aa.tar) -<BR><TT>(setenv n_install hp/sw)</TT> -<P> -<LI>The hosts on which Newstar has to be compiled (just one host per -architecture please...) -<BR><TT>(setenv n_hosts host1,host2)</TT> -<P> -The order in n_install and n_hosts is arbitrary, but you best keep it -the same in both variables for your own convenience. -<P> -<LI>Definition of tape-units -<BR><TT>(setenv MAG4 /dev/rmt/0mn)</TT> -<P> -<LI>The location of the executable files and libraries if they -should not reside on the same filesystem as the sources. -You should create those directories yourself. If you do not -specify directories here, they will be created automatically. -</OL> -If you create any files yourself, we would like to receive a copy of them. -The files will then be included in the Newstar master. - - -<H3>3D. Building Newstar</H3> - -If you want to make an executable installation for architecture aa, login -on a host of that architecture and initialise the Newstar environment: -<PRE> ->>> source "Newstar root-directory"/src/sys/newstar_xxxx.csh -</PRE> -You may have received archives nstar_exe_aa.tar or nstar_lib_aa.tar. -If aa matches the name of your architecture, you may just untar these files -in the appropriate directories to get a working system: -<PRE> ->>> nup quit ->>> cd $n_lib ->>> uncompress [directory_with_archive/]nstar_lib_aa.tar.Z ->>> tar xvf [directory with_archive]/nstar_lib_aa.tar ->>> uncompress [directory_with_archive/]nstar_lib_inc.tar.Z ->>> tar xvf [directory with_archive]/nstar_lib_inc.tar ->>> cd $n_exe ->>> uncompress [directory_with_archive/]nstar_exe_aa.tar.Z ->>> tar xvf [directory_with_archive/]nstar_exe_aa.tar -</PRE> -If you need to build Newstar from scratch, use the following commands: -<PRE> ->>> nup build -u wntinc (will give 9 errors for dsc-files which could not be - translated because wntinc does not yet exist.) ->>> nup build -u -t:exe wntinc ->>> nup build -u all -</PRE> -Logs of all transactions and errors are kept in $n_src/updyymmddaa[i].log -where i is an index (e.g. upd930623sw.log, upd930623sw1.log). -<P> -If something goes wrong during the installation, the log-files will be sent -to the Newstar group by eMail. This assumes you have the elm mailer -running at your institute. If you do not have it, you should supply an -alias to e.g. mail or mailx in newstar_xxxx.csh -(add a line like alias elm 'mail -s "\!1" \!2 ') -<PRE></PRE> - -<H2>4. Using Newstar, revisions and releases</H2> - -If someone wants to run Newstar programs, the Newstar environment should -be initialised first: -<PRE> ->>> source "Newstar root-directory"/src/sys/newstar_xxxx.csh -</PRE> -This can be safely done in a .cshrc or .login file. -<P> -You can now display the version of Newstar you are currently using: -<PRE> ->>> nnews -</PRE> -This will display the version number first, followed by a list of -recent changes. The version number consists of a release number followed -by a dot and a revision number. -<PRE> ->>> dwe nscan -</PRE> -Programs are started by typing dwe (or exe) followed by the name of the -program. This will display a line like "NSCAN$1 (v4.21) started ...". -The version number can be lower than the version displayed by nnews, since -a revision may concern only some programs. A full revision history with -the revisions for every program can be found in the on-line documentation -(select "Revision history" from the Newstar home page presented by nhyper). -<P> -A revision of Newstar is a series of minor changes that do not affect -the overall operation of Newstar. Revisions are typically bug repairs, -small additions to the functionality of a program etc. They do not affect -keyword syntax and fileformats. -<P> -A release of Newstar is issued when any of the following occured: -<OL> -<LI>A change of fileformats (so you will have to use the -NVS "New Version" option in some programs) -<LI>A change in keyword syntax (so you will have to type different -things or change batch files in some cases) -<LI>Addition of a new program, or a full rewrite of an existing one. -</OL> -<PRE></PRE> - -<H2>5. Keeping your installation up to date</H2> - -In the following we assume that the Newstar environment has been initialised. -<P> -If we modify the Newstar master at NFRA, all Friends of Newstar that we -know of will receive an eMail describing the changes. This message will -also contain instructions how to upgrade your installation. -<P> -In most cases, upgrading is done through a single command: -<PRE> ->>> nup update -</PRE> -This in fact causes the following commands to be executed, which you may -also execute by hand: -<PRE> - >>> cd $n_import -</PRE> -The default directory is set to $n_import, which is the proper place to -receive new files. This keeps your current sources intact. -<PRE> - >>> nup retrieve all -</PRE> -This will make a fresh version of the file $n_src/sys/database.idx, which -gives a full description of your current installation. -Than it will retrieve the version of database.idx from the NFRA for -comparison. Any files that need to be updated are retrieved in $n_import. -The list of files retrieved is in file retrieved.grp. -<PRE> - >>> nup build -Update -T:^exe retrieved.grp -</PRE> -This will build all files just retrieved, and any files dependent on them. -No executables will be built, this will be done after the library check. -<PRE> - >>> nup clear -NConfirm -</PRE> -This will throw away any source files in the master system that are no -longer needed. -<PRE> - >>> nup check l -</PRE> -This will check your libraries. Experience shows that escpecially on HP -workstations libraries tend to get cluttered. This will be found by the -library check. If necessary, an additional build command will be scheduled -to rebuilt modules. Objects for which no source is present are removed -from the libraries. Duplicate entries are both removed and replaced by -a fresh entry. Out-of-date entries are updated. -<PRE> - >>> nup check e -Update -</PRE> -This will check your executables. Executables that do not yet exist -or are out-of-date with respect to the NFRA are rebuilt. Note that usually -not all versions need to be rebuilt for a new revision. Thus some programs -may show a lower version than the version shown by nnews. -<PRE> - >>> rsh HOST '( source $n_src/sys/newstar_xxxx.csh; nup update rsh) -</PRE> -If $n_hosts (as defined in newstar_xxxx.csh) contains more hosts, the above -command will be issued for each of them. This will carry out the build -and check commands listed above, but not the retrieve. -<P> -The proceedings of the update command will dump a lot of output on your -screen, which is also stored in logfiles $n_src/updyymmdd[i].log (see -above). You may want to redirect the output to a file or /dev/null. -If any errors occur, the log-file will be sent to the Newstar group by eMail. -<P> -<P> -The nup command has many more uses than the ones described above. Most of -them should not be relevant to you, since they are related to partial -rebuilds, making backups etc. In case you are interested though, you can -get more information through the command -<PRE> ->>> nup help -help - -</PRE> -<HR> -<H2>Appendix 1: Questionnaire new Newstar sites</H2> - -Provide the following information, and send it to <EM>newstar@astron.nl</EM> -<OL> - -<H3><LI>Site:</H3> -<OL> -<LI>Institute: -<P> -<LI>Abbreviated institute name (up to 5 char): -<P> -<LI>Address: -<PRE> - -</PRE> -<P> -<LI>Friend of newstar: -<P> -<LI>eMail address: -<P> -<LI>ftp node(s): -<P> -<LI>Phone: -<PRE></PRE> -</OL> - -<H3><LI>Platform:</H3> -<OL> -<LI>Platform(s) and their hostname(s) on which Newstar should run: -<OL> -<LI>Convex (cv) -<LI>DEC Alpha/OSF1 (da) -<LI>DECstation (dw) -<LI>HP workstation (hp) -<LI>SUN (sw) -</OL> -If not in list contact to <EM>newstar@astron.nl</EM> for possible inclusion of -your platform. -<P> -<LI>Do platforms have a common NFS on which to place sources? -<OL> -<LI>Yes -<LI>No -</OL> -(only if more than one platform requested at 2.1) -<P> -<LI>Root directory for Newstar: -<BR>(e.g. /usr/src/newstar ) -<PRE></PRE> -<LI>If object-libraries should be placed on a different file system, -specify here: -<PRE></PRE> -<LI>Idem executables: -<PRE></PRE> -<LI>Could you provide an account on your platform(s) in which we can -login to do some remote checks can be made? -<OL> -<LI>Yes -<LI>No -</OL> -If <STRONG>YES</STRONG>, please specify it: -<PRE></PRE> -</OL> - -<H3><LI>Software:</H3> -<OL> -<LI>Are you using the standard f77, cc and ld provided with your system? -<OL> -<LI>Yes -<LI>No -</OL> -If not, provide details on how to call them, and the switches provided) -<PRE></PRE> -<LI>What is your standard command to print 132 wide ASCII files? -<PRE></PRE> -<LI>What is your standard command to plot A4-format PostScript files? -<PRE></PRE> -<LI>What is your standard command to plot A3-format PostScript files? -<PRE></PRE> -<LI>Which other plotters would you like to use? -<BR>(contact <EM>newstar@astron.nl</EM> to see if support is possible) -<PRE></PRE> -</OL> - -<H3><LI>Input/Output medium:</H3> -<OL> -<LI>Specify the device-names of the available mediums for reading/writing data? -<PRE></PRE> -<LI>Specify on which medium you want to receive Newstar if you cannot -support ftp: -<BR>(9track/density, Exabyte, DAT, ...) -<PRE></PRE> -</OL> -</OL> diff --git a/hlp/flfnode/flfnode__flf_node.html b/hlp/flfnode/flfnode__flf_node.html deleted file mode 100644 index 49d5a8217e7a20e444fb1f6f170b37428ea1b16b..0000000000000000000000000000000000000000 --- a/hlp/flfnode/flfnode__flf_node.html +++ /dev/null @@ -1,18 +0,0 @@ -<TITLE>Description of FLF_NODE (FLFNODE)</TITLE> -<H1>Description of general keyword FLF_NODE</H1> - -<DT><EM>Prompt:</EM> Input/output .FLF file name -<DT><EM>Expected input:</EM> Character(80).<P> -Specify the file name (no extension). <P> -You may enter <P> - [<directory>/]** <P> -to get a list of .SCN files in your current or another directory; then enter <P> - #<n> <P> -to select the <n>'th file from that list. - - <H3> More information: </H3> <UL> -<LI><A HREF="../flfnode/flfnode_comm.html">List of general keywords</A> for FLFNODE -<LI>Description of the <A HREF="../flf_descr/flf_descr.html">FLF file format</A> -<LI><A HREF="../homepage.html">NEWSTAR Documentation Home page</A> -<LI>The <A HREF="../common_descr/common_descr.html">DWARF User Interface</A> -</UL> diff --git a/hlp/flfnode/flfnode__input_flf_node.html b/hlp/flfnode/flfnode__input_flf_node.html deleted file mode 100644 index 2b661d073f202a93b2538471f27362d9bf20b5f8..0000000000000000000000000000000000000000 --- a/hlp/flfnode/flfnode__input_flf_node.html +++ /dev/null @@ -1,18 +0,0 @@ -<TITLE>Description of INPUT_FLF_NODE (FLFNODE)</TITLE> -<H1>Description of general keyword INPUT_FLF_NODE</H1> - -<DT><EM>Prompt:</EM> Input .FLF file name -<DT><EM>Expected input:</EM> Character(80).<P> -Specify the file name (no extension). <P> -You may enter <P> - [<directory>/]** <P> -to get a list of .SCN files in your current or another directory; then enter <P> - #<n> <P> -to select the <n>'th file from that list. - - <H3> More information: </H3> <UL> -<LI><A HREF="../flfnode/flfnode_comm.html">List of general keywords</A> for FLFNODE -<LI>Description of the <A HREF="../flf_descr/flf_descr.html">FLF file format</A> -<LI><A HREF="../homepage.html">NEWSTAR Documentation Home page</A> -<LI>The <A HREF="../common_descr/common_descr.html">DWARF User Interface</A> -</UL> diff --git a/hlp/flfnode/flfnode__output_flf_node.html b/hlp/flfnode/flfnode__output_flf_node.html deleted file mode 100644 index 08b62715cf31acd53e1e1eba5d43c7549f6e3579..0000000000000000000000000000000000000000 --- a/hlp/flfnode/flfnode__output_flf_node.html +++ /dev/null @@ -1,18 +0,0 @@ -<TITLE>Description of OUTPUT_FLF_NODE (FLFNODE)</TITLE> -<H1>Description of general keyword OUTPUT_FLF_NODE</H1> - -<DT><EM>Prompt:</EM> Output .FLF file name -<DT><EM>Expected input:</EM> Character(80).<P> -Specify the file name (no extension). <P> -You may enter <P> - [<directory>/]** <P> -to get a list of .SCN files in your current or another directory; then enter <P> - #<n> <P> -to select the <n>'th file from that list. - - <H3> More information: </H3> <UL> -<LI><A HREF="../flfnode/flfnode_comm.html">List of general keywords</A> for FLFNODE -<LI>Description of the <A HREF="../flf_descr/flf_descr.html">FLF file format</A> -<LI><A HREF="../homepage.html">NEWSTAR Documentation Home page</A> -<LI>The <A HREF="../common_descr/common_descr.html">DWARF User Interface</A> -</UL> diff --git a/hlp/flfnode_comm/flfnode_comm.html b/hlp/flfnode_comm/flfnode_comm.html deleted file mode 100644 index 42f6ff125a76e1c24ef7d47447353a9ff32748d7..0000000000000000000000000000000000000000 --- a/hlp/flfnode_comm/flfnode_comm.html +++ /dev/null @@ -1,20 +0,0 @@ -<TITLE>Index of general keywords from FLFNODE</TITLE> -<H1>Description of general keywords (FLFNODE)</H1> - -<UL> -<LI> <A HREF="../flfnode/flfnode__flf_node.html"> - FLF_NODE</A> - Input/output .FLF file name -<LI> <A HREF="../flfnode/flfnode__input_flf_node.html"> - INPUT_FLF_NODE</A> - Input .FLF file name -<LI> <A HREF="../flfnode/flfnode__output_flf_node.html"> - OUTPUT_FLF_NODE</A> - Output .FLF file name -</UL> - - - <H3> More information: </H3> <UL> -<LI><A HREF="../homepage.html">NEWSTAR Documentation Home page</A> -<LI><A HREF="../hb_contents/hb_contents.html">The NEWSTAR Cookbook</A> -</UL> diff --git a/hlp/global/global__channel.html b/hlp/global/global__channel.html deleted file mode 100644 index b5dcdd78c7c030367a43fac90c235720454b4645..0000000000000000000000000000000000000000 --- a/hlp/global/global__channel.html +++ /dev/null @@ -1,15 +0,0 @@ -<TITLE>Description of CHANNEL (GLOBAL)</TITLE> -<H1>Program GLOBAL: private keyword CHANNEL</H1> - -<DT><EM>Prompt:</EM> <DeAnza Imagechannel Nr> -<DT><EM>Expected input:</EM> I; min.value: 0.000000; max.value: 2.000000.<P> -Defines the image-channel on the DeAnza image-processor <P> - Channel 0 is used as overlay-channel and should (unless necessary) - not be used <P> - - <H3> More information: </H3> <UL> -<LI><A HREF="../global/global_keys.html">List of keywords</A> for GLOBAL -<LI><A HREF="../homepage.html">NEWSTAR Documentation Home page</A> -<LI>Description of <A HREF="../global_descr/global_descr.html">program GLOBAL</A> -<LI>The <A HREF="../common_descr/common_descr.html">DWARF User Interface</A> -</UL> diff --git a/hlp/global/global__database.html b/hlp/global/global__database.html deleted file mode 100644 index ff9a8108903fb5b1e8c1f6684decfa8b3ccac400..0000000000000000000000000000000000000000 --- a/hlp/global/global__database.html +++ /dev/null @@ -1,14 +0,0 @@ -<TITLE>Description of DATABASE (GLOBAL)</TITLE> -<H1>Program GLOBAL: private keyword DATABASE</H1> - -<DT><EM>Prompt:</EM> <DATA BASE NAME> -<DT><EM>Expected input:</EM> Character(80).<P> -Defines the name of the delault database, which all programs will use unless <P> - prompting is forced through the /ASK qualifier <P> - - <H3> More information: </H3> <UL> -<LI><A HREF="../global/global_keys.html">List of keywords</A> for GLOBAL -<LI><A HREF="../homepage.html">NEWSTAR Documentation Home page</A> -<LI>Description of <A HREF="../global_descr/global_descr.html">program GLOBAL</A> -<LI>The <A HREF="../common_descr/common_descr.html">DWARF User Interface</A> -</UL> diff --git a/hlp/global/global__ipunit.html b/hlp/global/global__ipunit.html deleted file mode 100644 index 3239dec03e8c85adbe1e0623c1e38291643a96cf..0000000000000000000000000000000000000000 --- a/hlp/global/global__ipunit.html +++ /dev/null @@ -1,15 +0,0 @@ -<TITLE>Description of IPUNIT (GLOBAL)</TITLE> -<H1>Program GLOBAL: private keyword IPUNIT</H1> - -<DT><EM>Prompt:</EM> <DeAnza-Unitnr> -<DT><EM>Default:</EM> 0 /NOASK. -<DT><EM>Expected input:</EM> I; min.value: 0.000000; max.value: 0.000000.<P> -Defines the unitnr of the DeAnza image-processor <P> - 0 is the DeAnza in the image-room <P> - - <H3> More information: </H3> <UL> -<LI><A HREF="../global/global_keys.html">List of keywords</A> for GLOBAL -<LI><A HREF="../homepage.html">NEWSTAR Documentation Home page</A> -<LI>Description of <A HREF="../global_descr/global_descr.html">program GLOBAL</A> -<LI>The <A HREF="../common_descr/common_descr.html">DWARF User Interface</A> -</UL> diff --git a/hlp/global/global__lutnr.html b/hlp/global/global__lutnr.html deleted file mode 100644 index 1122ebd79a6ada03386bab256968102e3736cfe2..0000000000000000000000000000000000000000 --- a/hlp/global/global__lutnr.html +++ /dev/null @@ -1,16 +0,0 @@ -<TITLE>Description of LUTNR (GLOBAL)</TITLE> -<H1>Program GLOBAL: private keyword LUTNR</H1> - -<DT><EM>Prompt:</EM> <Colour Lookup-Table Nr> -<DT><EM>Default:</EM> 0 /NOASK. -<DT><EM>Expected input:</EM> I; min.value: 0.000000; max.value: 3.000000.<P> -Defines the nr of the colour lookup-table, which drives the colours <P> -on the screen. - 0 should normally be used <P> - - <H3> More information: </H3> <UL> -<LI><A HREF="../global/global_keys.html">List of keywords</A> for GLOBAL -<LI><A HREF="../homepage.html">NEWSTAR Documentation Home page</A> -<LI>Description of <A HREF="../global_descr/global_descr.html">program GLOBAL</A> -<LI>The <A HREF="../common_descr/common_descr.html">DWARF User Interface</A> -</UL> diff --git a/hlp/global/global__tapeunit.html b/hlp/global/global__tapeunit.html deleted file mode 100644 index 75cc15455205be199ed6da3d40372511dba26845..0000000000000000000000000000000000000000 --- a/hlp/global/global__tapeunit.html +++ /dev/null @@ -1,15 +0,0 @@ -<TITLE>Description of TAPEUNIT (GLOBAL)</TITLE> -<H1>Program GLOBAL: private keyword TAPEUNIT</H1> - -<DT><EM>Prompt:</EM> MTA0, MTB0 -<DT><EM>Expected input:</EM> Character(4).<P> -Defines the tapeunit that have to be used <P> - MTA0 is the fast selfloading tapeunit - MTB0 is the slower tapeunit (the left one) <P> - - <H3> More information: </H3> <UL> -<LI><A HREF="../global/global_keys.html">List of keywords</A> for GLOBAL -<LI><A HREF="../homepage.html">NEWSTAR Documentation Home page</A> -<LI>Description of <A HREF="../global_descr/global_descr.html">program GLOBAL</A> -<LI>The <A HREF="../common_descr/common_descr.html">DWARF User Interface</A> -</UL> diff --git a/hlp/global_keys/global_keys.html b/hlp/global_keys/global_keys.html deleted file mode 100644 index 6d60f1cff11d21daf22f961d0f7da9652f95b24f..0000000000000000000000000000000000000000 --- a/hlp/global_keys/global_keys.html +++ /dev/null @@ -1,27 +0,0 @@ -<TITLE>Index of private keywords for GLOBAL </TITLE> -<H1>Description of keywords for program GLOBAL</H1> - -<UL> -<LI> <A HREF="../global/global__database.html"> - DATABASE</A> - <DATA BASE NAME> -<LI> <A HREF="../global/global__tapeunit.html"> - TAPEUNIT</A> - MTA0, MTB0 -<LI> <A HREF="../global/global__ipunit.html"> - IPUNIT</A> - <DeAnza-Unitnr> -<LI> <A HREF="../global/global__channel.html"> - CHANNEL</A> - <DeAnza Imagechannel Nr> -<LI> <A HREF="../global/global__lutnr.html"> - LUTNR</A> - <Colour Lookup-Table Nr> -</UL> - - - <H3> More information: </H3> <UL> -<LI><A HREF="../homepage.html">NEWSTAR Documentation Home page</A> -<LI><A HREF="../hb_contents/hb_contents.html">The NEWSTAR Cookbook</A> -<LI>Description of <A HREF="../global_descr/global_descr.html">program GLOBAL</A> -</UL> diff --git a/hlp/hjv.gif b/hlp/hjv.gif deleted file mode 100644 index a598b9b2e2380ca9c07bb3cf75df5cf3fff6ff71..0000000000000000000000000000000000000000 Binary files a/hlp/hjv.gif and /dev/null differ diff --git a/hlp/homepage.html b/hlp/homepage.html deleted file mode 100644 index 7f054993df83adba62bcafaadb453bf14b778b65..0000000000000000000000000000000000000000 --- a/hlp/homepage.html +++ /dev/null @@ -1,42 +0,0 @@ -<! History: > -<! JPH 960326 Correct NFRA reference > -<! JPH 960426 Correct .gif references; replace gen_intro with > -<! introduction> -<! TJD 180221 Remove dead links> -<! > -<! > -<HEAD> -<TITLE>Newstar Home Page nfra (local version!)</TiTLE> -</HEAD> -<BODY> -<IMG SRC="src/doc/bin/newstar.gif"> - -<H1>Welcome to the upgraded Newstar Documentation Service</H1> - -<H2>Historical reference documentation for Newstar</H1> - -<H2>The Netherlands East West Synthesis Telescope Array Reduction</H2> -<P> - -<A HREF=introduction/introduction.html>Newstar</A> -is the software package to reduce data from the - <A HREF=src/doc/bin/wsrt.gif>WSRT</A>, -the <EM>Westerbork Synthese Radio Telescope</EM>. -<P> -The WSRT is operated by the Netherlands Foundation for Research in -Astronomy (the <A HREF=http://www.astron.nl>NFRA</A>). -<P> - -<P> -This documentation server gives access to: - -<UL> -<LI><A HREF=nnews.txt>The latest news on Newstar</A> (<EM>here at nfra</EM>) -<LI><A HREF=hb_contents/hb_contents.html>The Newstar Documentation Collection</A> -<LI><A HREF=newstar-cookbook.pdf>The Newstar Cookbook</A> by Jan Noordam (editor) -<LI><A HREF=newstar-verheijen.pdf>How to calibrate, flag and transform 21cm line data from the WSRT using NEWSTAR</A> by Marc Verheijen -</UL> - -<HR> -<!-- <ADDRESS><A HREF=people/people.html>The Newstar projectgroup</A></ADDRESS> --> -</BODY> diff --git a/hlp/icons.html b/hlp/icons.html deleted file mode 100644 index 3a45761ac46ac474c723bb6e964c4b9fc441f22b..0000000000000000000000000000000000000000 --- a/hlp/icons.html +++ /dev/null @@ -1,20 +0,0 @@ - -<FORM METHOD="POST" > -<INPUT TYPE="submit" VALUE="Next"> - <P> -<INPUT TYPE="submit" VALUE="Previous"> - <P> -<INPUT TYPE="submit" VALUE="Up"> - <P> -<INPUT TYPE="submit" VALUE="Next Group"> - <P> -<INPUT TYPE="submit" VALUE="Previous Group"> - <P> -<INPUT TYPE="submit" VALUE="Contents"> - <P> -<INPUT TYPE="submit" VALUE="Index"> - <P> - - - -</FORM> diff --git a/hlp/icons/anchor.xbm b/hlp/icons/anchor.xbm deleted file mode 100755 index e9e72aa1acab717f667e01739ad55bfcc731ad00..0000000000000000000000000000000000000000 --- a/hlp/icons/anchor.xbm +++ /dev/null @@ -1,6 +0,0 @@ -#define anchor.xbm_width 16 -#define anchor.xbm_height 16 -static char anchor.xbm_bits[] = { - 0x00, 0x00, 0xe0, 0x07, 0xe0, 0x07, 0x80, 0x05, 0x80, 0x05, 0x80, 0x05, - 0x80, 0x03, 0x80, 0x01, 0x9e, 0x79, 0x8e, 0x71, 0x8e, 0x71, 0x8a, 0x51, - 0x90, 0x09, 0xe0, 0x07, 0x80, 0x01, 0x00, 0x00}; diff --git a/hlp/icons/blank.xbm b/hlp/icons/blank.xbm deleted file mode 100755 index 3c724639131396f04cf2160158a14bb3ee553068..0000000000000000000000000000000000000000 --- a/hlp/icons/blank.xbm +++ /dev/null @@ -1,4 +0,0 @@ -P4 -# CREATOR: XV Version 3.00 Rev: 3/30/93 -1 1 - \ No newline at end of file diff --git a/hlp/icons/contents.xbm b/hlp/icons/contents.xbm deleted file mode 100755 index a3aed9f8625c67129952f83a07497875fd2ab1f5..0000000000000000000000000000000000000000 --- a/hlp/icons/contents.xbm +++ /dev/null @@ -1,12 +0,0 @@ -#define contents_width 63 -#define contents_height 16 -static char contents_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,0xc0,0x01,0x00,0x08,0x00,0x00,0x01,0x00,0x20,0x02,0x00,0x08,0x00, - 0x00,0x01,0x00,0x20,0xe2,0x74,0x7c,0x9c,0x8e,0x8f,0x03,0x20,0x10,0x99,0x08, - 0x22,0x13,0x41,0x04,0x20,0x10,0x89,0x08,0x3e,0x11,0x81,0x03,0x20,0x12,0x89, - 0x08,0x02,0x11,0x01,0x04,0x20,0x12,0x89,0x88,0x22,0x11,0x51,0x04,0xc0,0xe1, - 0x9c,0x71,0x9c,0x33,0x8e,0x03,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}; diff --git a/hlp/icons/contents_motif.gif b/hlp/icons/contents_motif.gif deleted file mode 100644 index ddb24ce671d219174f0e1e0d3c366ff23371d5b8..0000000000000000000000000000000000000000 Binary files a/hlp/icons/contents_motif.gif and /dev/null differ diff --git a/hlp/icons/cross-ref.xbm b/hlp/icons/cross-ref.xbm deleted file mode 100755 index c2ff90eaa3ea1478676a68139f884040f5d0cdb9..0000000000000000000000000000000000000000 --- a/hlp/icons/cross-ref.xbm +++ /dev/null @@ -1,6 +0,0 @@ -#define cross-ref.xbm_width 16 -#define cross-ref.xbm_height 16 -static char cross-ref.xbm_bits[] = { - 0x00, 0x01, 0x80, 0x01, 0xc0, 0x01, 0xe0, 0x01, 0xf0, 0x01, 0xf8, 0x61, - 0xfc, 0x71, 0xfe, 0x79, 0xff, 0x7f, 0x00, 0x7f, 0x00, 0x7f, 0x80, 0x7f, - 0xc0, 0x7f, 0xe0, 0x7f, 0xe0, 0x7f, 0x00, 0x00}; diff --git a/hlp/icons/cross_ref_motif.gif b/hlp/icons/cross_ref_motif.gif deleted file mode 100644 index 1cb5a9b47a64d878d53385636238e12ae0139e65..0000000000000000000000000000000000000000 Binary files a/hlp/icons/cross_ref_motif.gif and /dev/null differ diff --git a/hlp/icons/foot.xbm b/hlp/icons/foot.xbm deleted file mode 100755 index 19952073e20bd30f0d142048523cddfc135f51ea..0000000000000000000000000000000000000000 --- a/hlp/icons/foot.xbm +++ /dev/null @@ -1,6 +0,0 @@ -#define foot.xbm_width 16 -#define foot.xbm_height 16 -static char foot.xbm_bits[] = { - 0x00, 0x00, 0xc0, 0x01, 0xc0, 0x01, 0xc0, 0x01, 0x80, 0x00, 0x98, 0x0c, - 0xf8, 0x0f, 0x98, 0x0c, 0x80, 0x00, 0x80, 0x00, 0x80, 0x00, 0x80, 0x00, - 0x80, 0x00, 0x80, 0x00, 0x80, 0x00, 0x00, 0x00}; diff --git a/hlp/icons/foot_motif.gif b/hlp/icons/foot_motif.gif deleted file mode 100644 index b801393f38c66bcd32af988e8d44de0f605c3a99..0000000000000000000000000000000000000000 Binary files a/hlp/icons/foot_motif.gif and /dev/null differ diff --git a/hlp/icons/index.xbm b/hlp/icons/index.xbm deleted file mode 100755 index 4c8c10616fb3242e52863a04453eeeaa67d43353..0000000000000000000000000000000000000000 --- a/hlp/icons/index.xbm +++ /dev/null @@ -1,10 +0,0 @@ -#define index_width 41 -#define index_height 16 -static char index_bits[] = { - 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, - 0x00,0x00,0x00,0x00,0x00,0x60,0x00,0x00,0x00,0xf0,0x01,0x40,0x00,0x00,0x00, - 0x40,0x00,0x40,0x00,0x00,0x00,0x40,0x74,0x78,0x9c,0x3b,0x00,0x40,0x98,0x44, - 0x22,0x0a,0x00,0x40,0x88,0x44,0x3e,0x04,0x00,0x40,0x88,0x44,0x02,0x0a,0x00, - 0x40,0x88,0x44,0x22,0x11,0x00,0xf0,0x9d,0xb9,0x9c,0x31,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}; diff --git a/hlp/icons/index_motif.gif b/hlp/icons/index_motif.gif deleted file mode 100644 index cab027c0212a65601c3ea6bfa6690c823b661698..0000000000000000000000000000000000000000 Binary files a/hlp/icons/index_motif.gif and /dev/null differ diff --git a/hlp/icons/invis_anchor.xbm b/hlp/icons/invis_anchor.xbm deleted file mode 100755 index cc208a31ff7090c51c647e04d889f7d0eb4490b5..0000000000000000000000000000000000000000 --- a/hlp/icons/invis_anchor.xbm +++ /dev/null @@ -1,4 +0,0 @@ -#define dot_anchor_width 1 -#define dot_anchor_height 1 -static char dot_anchor_bits[] = { - 0xfe}; diff --git a/hlp/icons/latex2html.xbm b/hlp/icons/latex2html.xbm deleted file mode 100755 index d9879963bcf75d353bfd0ef590891ced6ab7d885..0000000000000000000000000000000000000000 --- a/hlp/icons/latex2html.xbm +++ /dev/null @@ -1,16 +0,0 @@ -#define noname_width 84 -#define noname_height 17 -static char noname_bits[] = { - 0x00,0x00,0x00,0x00,0x20,0xc0,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, - 0xe0,0xc0,0x01,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xe0,0xc0,0x01,0x00, - 0x00,0x00,0x00,0x1f,0xfc,0x07,0xfc,0xe7,0xc1,0x07,0x00,0x00,0x00,0x00,0x8c, - 0xcd,0x04,0x38,0xe3,0xc3,0x0f,0x00,0x00,0x00,0x00,0x8c,0xc5,0x0c,0x70,0xe1, - 0xc7,0x1f,0x00,0x00,0x00,0x00,0xcc,0xc5,0x08,0xe0,0xe1,0xff,0x3f,0x00,0x00, - 0x00,0x00,0x4c,0xc3,0xfc,0xe3,0xe0,0xff,0x3f,0x00,0x00,0x00,0x00,0xcc,0xc3, - 0x30,0xc3,0xe0,0xff,0xbf,0xbb,0xff,0xfd,0x01,0xac,0xc2,0x30,0xe6,0xe1,0xc7, - 0x9f,0xbf,0xff,0xfd,0x01,0xfc,0xcf,0xb0,0xa4,0xe3,0xc3,0x0f,0x9b,0xb5,0xcd, - 0x00,0xcc,0xc0,0xb0,0x10,0xe3,0xc1,0x07,0x1b,0x84,0xcf,0x00,0xff,0xf0,0xf3, - 0xbc,0xef,0xc0,0x01,0x1f,0x84,0xcf,0x00,0x00,0x00,0xb0,0x04,0xe0,0xc0,0x01, - 0x1b,0x84,0xcf,0x00,0x00,0x00,0x30,0x04,0x20,0xc0,0x00,0x1b,0x84,0xca,0x0c, - 0x00,0x00,0x30,0x06,0x00,0x00,0x00,0x1b,0x84,0xc8,0x0c,0x00,0x00,0xfc,0x03, - 0x00,0x00,0x80,0x3f,0xdf,0xfd,0x0f}; diff --git a/hlp/icons/next.xbm b/hlp/icons/next.xbm deleted file mode 100755 index 3e99395169322792e3565a62f4ca53e6810dc666..0000000000000000000000000000000000000000 --- a/hlp/icons/next.xbm +++ /dev/null @@ -1,6 +0,0 @@ -#define next.xbm_width 16 -#define next.xbm_height 16 -static char next.xbm_bits[] = { - 0x00, 0x00, 0x00, 0x00, 0x02, 0x03, 0x06, 0x07, 0x0e, 0x0f, 0x1e, 0x1f, - 0x3e, 0x3f, 0xfe, 0x7f, 0xfe, 0x7f, 0x3e, 0x3f, 0x1e, 0x1f, 0x0e, 0x0f, - 0x06, 0x07, 0x02, 0x03, 0x00, 0x00, 0x00, 0x00}; diff --git a/hlp/icons/next_group_motif.gif b/hlp/icons/next_group_motif.gif deleted file mode 100644 index 96d4e5ddfdfbe5cba5c008485fd7daa0189a1ef2..0000000000000000000000000000000000000000 Binary files a/hlp/icons/next_group_motif.gif and /dev/null differ diff --git a/hlp/icons/next_group_motif_gr.gif b/hlp/icons/next_group_motif_gr.gif deleted file mode 100644 index fabf730466e8be49e7b9a1cc33d93856016de06b..0000000000000000000000000000000000000000 Binary files a/hlp/icons/next_group_motif_gr.gif and /dev/null differ diff --git a/hlp/icons/next_motif.gif b/hlp/icons/next_motif.gif deleted file mode 100644 index 9c81e8c92fed7fe851ce02e7854dc26a58eae9b2..0000000000000000000000000000000000000000 Binary files a/hlp/icons/next_motif.gif and /dev/null differ diff --git a/hlp/icons/next_motif_gr.gif b/hlp/icons/next_motif_gr.gif deleted file mode 100644 index 985c857a3e0f66f3bfd06820ef908e76cbfe0ed0..0000000000000000000000000000000000000000 Binary files a/hlp/icons/next_motif_gr.gif and /dev/null differ diff --git a/hlp/icons/next_page.xbm b/hlp/icons/next_page.xbm deleted file mode 100755 index a9b5f23afaf3540a3e7c700d585eade3d5bb95c5..0000000000000000000000000000000000000000 --- a/hlp/icons/next_page.xbm +++ /dev/null @@ -1,13 +0,0 @@ -#define next_page_width 68 -#define next_page_height 16 -static char next_page_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,0x98,0x03,0x00, - 0x04,0xc0,0x07,0x00,0x00,0x00,0x30,0x01,0x00,0x04,0x80,0x0c,0x00,0x00,0x00, - 0x30,0x71,0xee,0x3e,0x80,0xc8,0xc3,0xe5,0x00,0x50,0x89,0x28,0x04,0x80,0x0c, - 0x24,0x12,0x01,0x50,0xf9,0x10,0x04,0x80,0x87,0x27,0xf2,0x01,0x90,0x09,0x28, - 0x04,0x80,0x40,0x24,0x12,0x00,0x90,0x89,0x44,0x44,0x80,0x40,0x24,0x12,0x01, - 0x38,0x71,0xc6,0x38,0xc0,0x83,0xcb,0xe3,0x00,0x00,0x00,0x00,0x00,0x00,0x00, - 0x00,0x02,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x02,0x00,0x00,0x00,0x00, - 0x00,0x00,0x00,0xc0,0x01,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, - 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00}; diff --git a/hlp/icons/previous.xbm b/hlp/icons/previous.xbm deleted file mode 100755 index 2c209a2beabc301ef32b1377f076148f6d76493d..0000000000000000000000000000000000000000 --- a/hlp/icons/previous.xbm +++ /dev/null @@ -1,6 +0,0 @@ -#define previous.xbm_width 16 -#define previous.xbm_height 16 -static char previous.xbm_bits[] = { - 0x00, 0x00, 0x00, 0x00, 0xc0, 0x40, 0xe0, 0x60, 0xf0, 0x70, 0xf8, 0x78, - 0xfc, 0x7c, 0xfe, 0x7f, 0xfe, 0x7f, 0xfc, 0x7c, 0xf8, 0x78, 0xf0, 0x70, - 0xe0, 0x60, 0xc0, 0x40, 0x00, 0x00, 0x00, 0x00}; diff --git a/hlp/icons/previous_group_motif.gif b/hlp/icons/previous_group_motif.gif deleted file mode 100644 index ff93c5920e154e07872c5ca79af1efc137f4f3f3..0000000000000000000000000000000000000000 Binary files a/hlp/icons/previous_group_motif.gif and /dev/null differ diff --git a/hlp/icons/previous_group_motif_gr.gif b/hlp/icons/previous_group_motif_gr.gif deleted file mode 100644 index 9ea0ce3ca756f390fad324d9b7b837c4dea6f56e..0000000000000000000000000000000000000000 Binary files a/hlp/icons/previous_group_motif_gr.gif and /dev/null differ diff --git a/hlp/icons/previous_motif.gif b/hlp/icons/previous_motif.gif deleted file mode 100644 index d43c0320e665dccf4f429d8b9d3448cceee82333..0000000000000000000000000000000000000000 Binary files a/hlp/icons/previous_motif.gif and /dev/null differ diff --git a/hlp/icons/previous_motif_gr.gif b/hlp/icons/previous_motif_gr.gif deleted file mode 100644 index 8d40fd5e0221c056806d5d8467e0e56262cf3bf6..0000000000000000000000000000000000000000 Binary files a/hlp/icons/previous_motif_gr.gif and /dev/null differ diff --git a/hlp/icons/previous_page.xbm b/hlp/icons/previous_page.xbm deleted file mode 100755 index f3ac286bfaab0624357a8f32144a3a0ddee75738..0000000000000000000000000000000000000000 --- a/hlp/icons/previous_page.xbm +++ /dev/null @@ -1,17 +0,0 @@ -#define previous_page_width 98 -#define previous_page_height 16 -static char previous_page_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, - 0x08,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xf0,0x01,0x00,0x00,0x00,0x00, - 0x00,0x00,0xf8,0x00,0x00,0x00,0x00,0x20,0x03,0x00,0x00,0x00,0x00,0x00,0x00, - 0x90,0x01,0x00,0x00,0x00,0x20,0xd2,0x71,0xee,0x0e,0xce,0x8c,0x03,0x10,0x79, - 0xb8,0x1c,0x00,0x20,0x23,0x88,0x44,0x08,0x91,0x48,0x04,0x90,0x81,0x44,0x22, - 0x00,0xe0,0x21,0xf8,0x44,0x08,0x91,0x88,0x03,0xf0,0xf0,0x44,0x3e,0x00,0x20, - 0x20,0x08,0x28,0x08,0x91,0x08,0x04,0x10,0x88,0x44,0x02,0x00,0x20,0x20,0x88, - 0x38,0x08,0x91,0x48,0x04,0x10,0x88,0x44,0x22,0x00,0xf0,0xf0,0x70,0x10,0x3e, - 0x0e,0x97,0x03,0x78,0x70,0x79,0x1c,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, - 0x00,0x00,0x00,0x40,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, - 0x00,0x40,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x38, - 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}; diff --git a/hlp/icons/up.xbm b/hlp/icons/up.xbm deleted file mode 100755 index 8cb4e256a97922a482d1158740d736359dd932e4..0000000000000000000000000000000000000000 --- a/hlp/icons/up.xbm +++ /dev/null @@ -1,6 +0,0 @@ -#define up.xbm_width 16 -#define up.xbm_height 16 -static char up.xbm_bits[] = { - 0x00, 0x00, 0x80, 0x01, 0xc0, 0x03, 0xe0, 0x07, 0xf0, 0x0f, 0xf8, 0x1f, - 0xfc, 0x3f, 0xfc, 0x3f, 0x80, 0x01, 0x80, 0x01, 0xc0, 0x03, 0xe0, 0x07, - 0xf0, 0x0f, 0xf8, 0x1f, 0xfc, 0x3f, 0x00, 0x00}; diff --git a/hlp/icons/up_motif.gif b/hlp/icons/up_motif.gif deleted file mode 100644 index 316d0d2a14b571bea2eb874efd04bfe509f53b34..0000000000000000000000000000000000000000 Binary files a/hlp/icons/up_motif.gif and /dev/null differ diff --git a/hlp/icons/up_motif_gr.gif b/hlp/icons/up_motif_gr.gif deleted file mode 100644 index ef0fb5923faaae8fb2238860664d3d9eb28be26f..0000000000000000000000000000000000000000 Binary files a/hlp/icons/up_motif_gr.gif and /dev/null differ diff --git a/hlp/ionost/ionost__change_f0f2_inp.html b/hlp/ionost/ionost__change_f0f2_inp.html deleted file mode 100644 index 8abb1689611264422450bb0d67f201def5bca311..0000000000000000000000000000000000000000 --- a/hlp/ionost/ionost__change_f0f2_inp.html +++ /dev/null @@ -1,18 +0,0 @@ -<TITLE>Description of CHANGE_F0F2_INP (IONOST)</TITLE> -<H1>Program IONOST: private keyword CHANGE_F0F2_INP</H1> - -<DT><EM>Prompt:</EM> YES, NO (Should foF2 input data be changed?) -<DT><EM>Default:</EM> NO /NOASK. -<DT><EM>Expected input:</EM> Character(3).<P> - change f0F2 input data by used input Faraday rotation data flag: - = NO no change by using ionospheric Faraday rotation - input - = YES change by using ionospheric Faraday rotation - input <P> - - <H3> More information: </H3> <UL> -<LI><A HREF="../ionost/ionost_keys.html">List of keywords</A> for IONOST -<LI><A HREF="../homepage.html">NEWSTAR Documentation Home page</A> -<LI>Description of <A HREF="../ionost_descr/ionost_descr.html">program IONOST</A> -<LI>The <A HREF="../common_descr/common_descr.html">DWARF User Interface</A> -</UL> diff --git a/hlp/ionost/ionost__corrections.html b/hlp/ionost/ionost__corrections.html deleted file mode 100644 index 1d2fdbb6521efcadd330edf9a412b53967edd1d2..0000000000000000000000000000000000000000 --- a/hlp/ionost/ionost__corrections.html +++ /dev/null @@ -1,18 +0,0 @@ -<TITLE>Description of CORRECTIONS (IONOST)</TITLE> -<H1>Program IONOST: private keyword CORRECTIONS</H1> - -<DT><EM>Prompt:</EM> VLBI, RIF, FAR, DELAY (Corrections to be calculated) -<DT><EM>Default:</EM> RIF, FAR /NOASK. -<DT><EM>Expected input:</EM> Character(5), 2 values.<P> - Corrections which should be calculated: - VLBI: VLBI refraction corrections are calculated - RIF: corrections for ionospheic refraction are calculated - FAR: corrections for Faraday rotation are calculated - DELAY: corrections for path length errors are calculated <P> - - <H3> More information: </H3> <UL> -<LI><A HREF="../ionost/ionost_keys.html">List of keywords</A> for IONOST -<LI><A HREF="../homepage.html">NEWSTAR Documentation Home page</A> -<LI>Description of <A HREF="../ionost_descr/ionost_descr.html">program IONOST</A> -<LI>The <A HREF="../common_descr/common_descr.html">DWARF User Interface</A> -</UL> diff --git a/hlp/ionost/ionost__day_number.html b/hlp/ionost/ionost__day_number.html deleted file mode 100644 index af2e98c477f1578c42cf76f0e4cf0953e95a96dd..0000000000000000000000000000000000000000 --- a/hlp/ionost/ionost__day_number.html +++ /dev/null @@ -1,18 +0,0 @@ -<TITLE>Description of DAY_NUMBER (IONOST)</TITLE> -<H1>Program IONOST: private keyword DAY_NUMBER</H1> - -<DT><EM>Prompt:</EM> -<DT><EM>Default:</EM> 0 /ASK. -<DT><EM>Expected input:</EM> Integer number.<P> - day number for which the calculations have to be done. The format is - as YYMMDD, where YY is the year - 1900, MM the month number in the - year and DD the daynumber in the month. Several dates may be specified: - Specify after the last day wanted a "0" (= zero) - then the program - will exit after the last calculations needed. <P> - - <H3> More information: </H3> <UL> -<LI><A HREF="../ionost/ionost_keys.html">List of keywords</A> for IONOST -<LI><A HREF="../homepage.html">NEWSTAR Documentation Home page</A> -<LI>Description of <A HREF="../ionost_descr/ionost_descr.html">program IONOST</A> -<LI>The <A HREF="../common_descr/common_descr.html">DWARF User Interface</A> -</UL> diff --git a/hlp/ionost/ionost__declination.html b/hlp/ionost/ionost__declination.html deleted file mode 100644 index be16e37d0ab8eba7169be6d713c73053e980142b..0000000000000000000000000000000000000000 --- a/hlp/ionost/ionost__declination.html +++ /dev/null @@ -1,14 +0,0 @@ -<TITLE>Description of DECLINATION (IONOST)</TITLE> -<H1>Program IONOST: private keyword DECLINATION</H1> - -<DT><EM>Prompt:</EM> -<DT><EM>Expected input:</EM> Double precision number.<P> - Declination of source for which ionosphere corrections have - to calculated: the value should be given in degrees <P> - - <H3> More information: </H3> <UL> -<LI><A HREF="../ionost/ionost_keys.html">List of keywords</A> for IONOST -<LI><A HREF="../homepage.html">NEWSTAR Documentation Home page</A> -<LI>Description of <A HREF="../ionost_descr/ionost_descr.html">program IONOST</A> -<LI>The <A HREF="../common_descr/common_descr.html">DWARF User Interface</A> -</UL> diff --git a/hlp/ionost/ionost__f2_bottom_height.html b/hlp/ionost/ionost__f2_bottom_height.html deleted file mode 100644 index fcba78c886597035c9d3d02c86b9cbec9e5fce80..0000000000000000000000000000000000000000 --- a/hlp/ionost/ionost__f2_bottom_height.html +++ /dev/null @@ -1,14 +0,0 @@ -<TITLE>Description of F2_BOTTOM_HEIGHT (IONOST)</TITLE> -<H1>Program IONOST: private keyword F2_BOTTOM_HEIGHT</H1> - -<DT><EM>Prompt:</EM> -<DT><EM>Default:</EM> 6440.0 /ASK. -<DT><EM>Expected input:</EM> Double precision number.<P> - Altitude of the bottomside of the F2-layer (in km) <P> - - <H3> More information: </H3> <UL> -<LI><A HREF="../ionost/ionost_keys.html">List of keywords</A> for IONOST -<LI><A HREF="../homepage.html">NEWSTAR Documentation Home page</A> -<LI>Description of <A HREF="../ionost_descr/ionost_descr.html">program IONOST</A> -<LI>The <A HREF="../common_descr/common_descr.html">DWARF User Interface</A> -</UL> diff --git a/hlp/ionost/ionost__f2_max_height.html b/hlp/ionost/ionost__f2_max_height.html deleted file mode 100644 index 55e69dfc21398a7d300bd80e4e25d45b9a22c8e5..0000000000000000000000000000000000000000 --- a/hlp/ionost/ionost__f2_max_height.html +++ /dev/null @@ -1,14 +0,0 @@ -<TITLE>Description of F2_MAX_HEIGHT (IONOST)</TITLE> -<H1>Program IONOST: private keyword F2_MAX_HEIGHT</H1> - -<DT><EM>Prompt:</EM> -<DT><EM>Default:</EM> 6770.0 /ASK. -<DT><EM>Expected input:</EM> Double precision number.<P> - Altitude of the maximum electron density in the F2-layer (in km) <P> - - <H3> More information: </H3> <UL> -<LI><A HREF="../ionost/ionost_keys.html">List of keywords</A> for IONOST -<LI><A HREF="../homepage.html">NEWSTAR Documentation Home page</A> -<LI>Description of <A HREF="../ionost_descr/ionost_descr.html">program IONOST</A> -<LI>The <A HREF="../common_descr/common_descr.html">DWARF User Interface</A> -</UL> diff --git a/hlp/ionost/ionost__f2_p1_height.html b/hlp/ionost/ionost__f2_p1_height.html deleted file mode 100644 index cc41e9f25d4009357563b336e6898eee5f1e09c5..0000000000000000000000000000000000000000 --- a/hlp/ionost/ionost__f2_p1_height.html +++ /dev/null @@ -1,14 +0,0 @@ -<TITLE>Description of F2_P1_HEIGHT (IONOST)</TITLE> -<H1>Program IONOST: private keyword F2_P1_HEIGHT</H1> - -<DT><EM>Prompt:</EM> -<DT><EM>Default:</EM> 6470.0 /ASK. -<DT><EM>Expected input:</EM> Double precision number.<P> - Altitude of the P1 height of the F2-layer (in km) [see ITR-162] <P> - - <H3> More information: </H3> <UL> -<LI><A HREF="../ionost/ionost_keys.html">List of keywords</A> for IONOST -<LI><A HREF="../homepage.html">NEWSTAR Documentation Home page</A> -<LI>Description of <A HREF="../ionost_descr/ionost_descr.html">program IONOST</A> -<LI>The <A HREF="../common_descr/common_descr.html">DWARF User Interface</A> -</UL> diff --git a/hlp/ionost/ionost__f2_p2_height.html b/hlp/ionost/ionost__f2_p2_height.html deleted file mode 100644 index 74567a59b02b17a8a77e6ee29ab656cdf22b4e80..0000000000000000000000000000000000000000 --- a/hlp/ionost/ionost__f2_p2_height.html +++ /dev/null @@ -1,14 +0,0 @@ -<TITLE>Description of F2_P2_HEIGHT (IONOST)</TITLE> -<H1>Program IONOST: private keyword F2_P2_HEIGHT</H1> - -<DT><EM>Prompt:</EM> -<DT><EM>Default:</EM> 7035.0 /ASK. -<DT><EM>Expected input:</EM> Double precision number.<P> - Altitude of the P2 height of the F2-layer (in km) [see ITR-162] <P> - - <H3> More information: </H3> <UL> -<LI><A HREF="../ionost/ionost_keys.html">List of keywords</A> for IONOST -<LI><A HREF="../homepage.html">NEWSTAR Documentation Home page</A> -<LI>Description of <A HREF="../ionost_descr/ionost_descr.html">program IONOST</A> -<LI>The <A HREF="../common_descr/common_descr.html">DWARF User Interface</A> -</UL> diff --git a/hlp/ionost/ionost__f2_top_height.html b/hlp/ionost/ionost__f2_top_height.html deleted file mode 100644 index e020da008e986f98285b124de49507a98b1c48a0..0000000000000000000000000000000000000000 --- a/hlp/ionost/ionost__f2_top_height.html +++ /dev/null @@ -1,14 +0,0 @@ -<TITLE>Description of F2_TOP_HEIGHT (IONOST)</TITLE> -<H1>Program IONOST: private keyword F2_TOP_HEIGHT</H1> - -<DT><EM>Prompt:</EM> -<DT><EM>Default:</EM> 7570.0 /ASK. -<DT><EM>Expected input:</EM> Double precision number.<P> - Altitude of the topside of the F2-layer (in km) <P> - - <H3> More information: </H3> <UL> -<LI><A HREF="../ionost/ionost_keys.html">List of keywords</A> for IONOST -<LI><A HREF="../homepage.html">NEWSTAR Documentation Home page</A> -<LI>Description of <A HREF="../ionost_descr/ionost_descr.html">program IONOST</A> -<LI>The <A HREF="../common_descr/common_descr.html">DWARF User Interface</A> -</UL> diff --git a/hlp/ionost/ionost__faraday_input.html b/hlp/ionost/ionost__faraday_input.html deleted file mode 100644 index 761f4af97a7e394e80e72ef3d3037f2cf7932d44..0000000000000000000000000000000000000000 --- a/hlp/ionost/ionost__faraday_input.html +++ /dev/null @@ -1,15 +0,0 @@ -<TITLE>Description of FARADAY_INPUT (IONOST)</TITLE> -<H1>Program IONOST: private keyword FARADAY_INPUT</H1> - -<DT><EM>Prompt:</EM> YES, NO (Is Faraday rotation input required?) -<DT><EM>Default:</EM> NO /NOASK. -<DT><EM>Expected input:</EM> Character(3).<P> - Faraday input flag: = NO no input data for Faraday rotation are used - = YES input data for Faraday rotation are used <P> - - <H3> More information: </H3> <UL> -<LI><A HREF="../ionost/ionost_keys.html">List of keywords</A> for IONOST -<LI><A HREF="../homepage.html">NEWSTAR Documentation Home page</A> -<LI>Description of <A HREF="../ionost_descr/ionost_descr.html">program IONOST</A> -<LI>The <A HREF="../common_descr/common_descr.html">DWARF User Interface</A> -</UL> diff --git a/hlp/ionost/ionost__frequency.html b/hlp/ionost/ionost__frequency.html deleted file mode 100644 index 41fb1b51d59945baa77fdc6a207fb8430ce2e8ef..0000000000000000000000000000000000000000 --- a/hlp/ionost/ionost__frequency.html +++ /dev/null @@ -1,13 +0,0 @@ -<TITLE>Description of FREQUENCY (IONOST)</TITLE> -<H1>Program IONOST: private keyword FREQUENCY</H1> - -<DT><EM>Prompt:</EM> -<DT><EM>Expected input:</EM> Double precision number.<P> - Observing frequency in MHz <P> - - <H3> More information: </H3> <UL> -<LI><A HREF="../ionost/ionost_keys.html">List of keywords</A> for IONOST -<LI><A HREF="../homepage.html">NEWSTAR Documentation Home page</A> -<LI>Description of <A HREF="../ionost_descr/ionost_descr.html">program IONOST</A> -<LI>The <A HREF="../common_descr/common_descr.html">DWARF User Interface</A> -</UL> diff --git a/hlp/ionost/ionost__geometry.html b/hlp/ionost/ionost__geometry.html deleted file mode 100644 index 1764568c2f2172bc4c30274daabbd9cc6a1d5c2e..0000000000000000000000000000000000000000 --- a/hlp/ionost/ionost__geometry.html +++ /dev/null @@ -1,17 +0,0 @@ -<TITLE>Description of GEOMETRY (IONOST)</TITLE> -<H1>Program IONOST: private keyword GEOMETRY</H1> - -<DT><EM>Prompt:</EM> FIXED, VARIABLE, DEFAULT (Geometry selection) -<DT><EM>Default:</EM> FIXED, DEFAULT /NOASK. -<DT><EM>Expected input:</EM> Character(8), 2 values.<P> - The following options for geometry selection are valid: - FIXED: fixed ionosphere geometry is taken - VARIABLE: variable ionosphere geometry is taken - DEFAULT: default ionosphere is taken <P> - - <H3> More information: </H3> <UL> -<LI><A HREF="../ionost/ionost_keys.html">List of keywords</A> for IONOST -<LI><A HREF="../homepage.html">NEWSTAR Documentation Home page</A> -<LI>Description of <A HREF="../ionost_descr/ionost_descr.html">program IONOST</A> -<LI>The <A HREF="../common_descr/common_descr.html">DWARF User Interface</A> -</UL> diff --git a/hlp/ionost/ionost__latitude_obs.html b/hlp/ionost/ionost__latitude_obs.html deleted file mode 100644 index d8b40ce15c8a3c1e0dbd634a4cc16ef2abbe4299..0000000000000000000000000000000000000000 --- a/hlp/ionost/ionost__latitude_obs.html +++ /dev/null @@ -1,14 +0,0 @@ -<TITLE>Description of LATITUDE_OBS (IONOST)</TITLE> -<H1>Program IONOST: private keyword LATITUDE_OBS</H1> - -<DT><EM>Prompt:</EM> -<DT><EM>Default:</EM> 52.9169152 /NOASK. -<DT><EM>Expected input:</EM> Double precision number.<P> - Geographic latitude observatory (in degrees) <P> - - <H3> More information: </H3> <UL> -<LI><A HREF="../ionost/ionost_keys.html">List of keywords</A> for IONOST -<LI><A HREF="../homepage.html">NEWSTAR Documentation Home page</A> -<LI>Description of <A HREF="../ionost_descr/ionost_descr.html">program IONOST</A> -<LI>The <A HREF="../common_descr/common_descr.html">DWARF User Interface</A> -</UL> diff --git a/hlp/ionost/ionost__latitude_stat.html b/hlp/ionost/ionost__latitude_stat.html deleted file mode 100644 index 43192c74a5819aec8efa9232274daae9902a8977..0000000000000000000000000000000000000000 --- a/hlp/ionost/ionost__latitude_stat.html +++ /dev/null @@ -1,14 +0,0 @@ -<TITLE>Description of LATITUDE_STAT (IONOST)</TITLE> -<H1>Program IONOST: private keyword LATITUDE_STAT</H1> - -<DT><EM>Prompt:</EM> -<DT><EM>Default:</EM> 52.10 /NOASK. -<DT><EM>Expected input:</EM> Double precision number.<P> - Geographic latitude ionosphere station (in degrees) <P> - - <H3> More information: </H3> <UL> -<LI><A HREF="../ionost/ionost_keys.html">List of keywords</A> for IONOST -<LI><A HREF="../homepage.html">NEWSTAR Documentation Home page</A> -<LI>Description of <A HREF="../ionost_descr/ionost_descr.html">program IONOST</A> -<LI>The <A HREF="../common_descr/common_descr.html">DWARF User Interface</A> -</UL> diff --git a/hlp/ionost/ionost__longitude_obs.html b/hlp/ionost/ionost__longitude_obs.html deleted file mode 100644 index cbf4645aed19d123c119e62cf4524985cd2e819d..0000000000000000000000000000000000000000 --- a/hlp/ionost/ionost__longitude_obs.html +++ /dev/null @@ -1,14 +0,0 @@ -<TITLE>Description of LONGITUDE_OBS (IONOST)</TITLE> -<H1>Program IONOST: private keyword LONGITUDE_OBS</H1> - -<DT><EM>Prompt:</EM> -<DT><EM>Default:</EM> 6.6041694 /NOASK. -<DT><EM>Expected input:</EM> Double precision number.<P> - Geographic longitude observatory (in degrees) <P> - - <H3> More information: </H3> <UL> -<LI><A HREF="../ionost/ionost_keys.html">List of keywords</A> for IONOST -<LI><A HREF="../homepage.html">NEWSTAR Documentation Home page</A> -<LI>Description of <A HREF="../ionost_descr/ionost_descr.html">program IONOST</A> -<LI>The <A HREF="../common_descr/common_descr.html">DWARF User Interface</A> -</UL> diff --git a/hlp/ionost/ionost__longitude_stat.html b/hlp/ionost/ionost__longitude_stat.html deleted file mode 100644 index cd47857778d9ba0274fc15a25f03cd8bbf840d51..0000000000000000000000000000000000000000 --- a/hlp/ionost/ionost__longitude_stat.html +++ /dev/null @@ -1,14 +0,0 @@ -<TITLE>Description of LONGITUDE_STAT (IONOST)</TITLE> -<H1>Program IONOST: private keyword LONGITUDE_STAT</H1> - -<DT><EM>Prompt:</EM> -<DT><EM>Default:</EM> 5.18 /NOASK. -<DT><EM>Expected input:</EM> Double precision number.<P> - Geographic longitude ionosphere station (in degrees) <P> - - <H3> More information: </H3> <UL> -<LI><A HREF="../ionost/ionost_keys.html">List of keywords</A> for IONOST -<LI><A HREF="../homepage.html">NEWSTAR Documentation Home page</A> -<LI>Description of <A HREF="../ionost_descr/ionost_descr.html">program IONOST</A> -<LI>The <A HREF="../common_descr/common_descr.html">DWARF User Interface</A> -</UL> diff --git a/hlp/ionost/ionost__next_day.html b/hlp/ionost/ionost__next_day.html deleted file mode 100644 index c4eee456030718c2d79603518c693a86f56234e5..0000000000000000000000000000000000000000 --- a/hlp/ionost/ionost__next_day.html +++ /dev/null @@ -1,15 +0,0 @@ -<TITLE>Description of NEXT_DAY (IONOST)</TITLE> -<H1>Program IONOST: private keyword NEXT_DAY</H1> - -<DT><EM>Prompt:</EM> YES, NO (Next day flag) -<DT><EM>Default:</EM> NO /NOASK. -<DT><EM>Expected input:</EM> Character(3).<P> - next day flag: = NO data not for next day - = YES data for next day. <P> - - <H3> More information: </H3> <UL> -<LI><A HREF="../ionost/ionost_keys.html">List of keywords</A> for IONOST -<LI><A HREF="../homepage.html">NEWSTAR Documentation Home page</A> -<LI>Description of <A HREF="../ionost_descr/ionost_descr.html">program IONOST</A> -<LI>The <A HREF="../common_descr/common_descr.html">DWARF User Interface</A> -</UL> diff --git a/hlp/ionost/ionost__nr_180_deg_steps.html b/hlp/ionost/ionost__nr_180_deg_steps.html deleted file mode 100644 index cd1f094fc3f9e23c19c6cfae8263c95f355a52fb..0000000000000000000000000000000000000000 --- a/hlp/ionost/ionost__nr_180_deg_steps.html +++ /dev/null @@ -1,13 +0,0 @@ -<TITLE>Description of NR_180_DEG_STEPS (IONOST)</TITLE> -<H1>Program IONOST: private keyword NR_180_DEG_STEPS</H1> - -<DT><EM>Prompt:</EM> -<DT><EM>Expected input:</EM> I.<P> - Number of 180 degree steps in Faraday rotation data at UT_TIME <P> - - <H3> More information: </H3> <UL> -<LI><A HREF="../ionost/ionost_keys.html">List of keywords</A> for IONOST -<LI><A HREF="../homepage.html">NEWSTAR Documentation Home page</A> -<LI>Description of <A HREF="../ionost_descr/ionost_descr.html">program IONOST</A> -<LI>The <A HREF="../common_descr/common_descr.html">DWARF User Interface</A> -</UL> diff --git a/hlp/ionost/ionost__observed_far_rot.html b/hlp/ionost/ionost__observed_far_rot.html deleted file mode 100644 index e5e618b50980dc806e809d234094e3fafc12aaf6..0000000000000000000000000000000000000000 --- a/hlp/ionost/ionost__observed_far_rot.html +++ /dev/null @@ -1,13 +0,0 @@ -<TITLE>Description of OBSERVED_FAR_ROT (IONOST)</TITLE> -<H1>Program IONOST: private keyword OBSERVED_FAR_ROT</H1> - -<DT><EM>Prompt:</EM> -<DT><EM>Expected input:</EM> Double precision number.<P> - Observed Faraday rotation values at moments UT_TIME (in degrees) <P> - - <H3> More information: </H3> <UL> -<LI><A HREF="../ionost/ionost_keys.html">List of keywords</A> for IONOST -<LI><A HREF="../homepage.html">NEWSTAR Documentation Home page</A> -<LI>Description of <A HREF="../ionost_descr/ionost_descr.html">program IONOST</A> -<LI>The <A HREF="../common_descr/common_descr.html">DWARF User Interface</A> -</UL> diff --git a/hlp/ionost/ionost__right_ascension.html b/hlp/ionost/ionost__right_ascension.html deleted file mode 100644 index d0de5a66fa68b439cdc66a4b774082ec34986136..0000000000000000000000000000000000000000 --- a/hlp/ionost/ionost__right_ascension.html +++ /dev/null @@ -1,14 +0,0 @@ -<TITLE>Description of RIGHT_ASCENSION (IONOST)</TITLE> -<H1>Program IONOST: private keyword RIGHT_ASCENSION</H1> - -<DT><EM>Prompt:</EM> -<DT><EM>Expected input:</EM> Double precision number.<P> - Right Ascension of source for which ionosphere corrections have - to calculated: the value should be given in degrees <P> - - <H3> More information: </H3> <UL> -<LI><A HREF="../ionost/ionost_keys.html">List of keywords</A> for IONOST -<LI><A HREF="../homepage.html">NEWSTAR Documentation Home page</A> -<LI>Description of <A HREF="../ionost_descr/ionost_descr.html">program IONOST</A> -<LI>The <A HREF="../common_descr/common_descr.html">DWARF User Interface</A> -</UL> diff --git a/hlp/ionost/ionost__source_name.html b/hlp/ionost/ionost__source_name.html deleted file mode 100644 index 2535c5f4764ff5a30ce00c18b84a7de078563d4e..0000000000000000000000000000000000000000 --- a/hlp/ionost/ionost__source_name.html +++ /dev/null @@ -1,14 +0,0 @@ -<TITLE>Description of SOURCE_NAME (IONOST)</TITLE> -<H1>Program IONOST: private keyword SOURCE_NAME</H1> - -<DT><EM>Prompt:</EM> -<DT><EM>Expected input:</EM> Character(12).<P> - Specify the source name for which the ionosphere corrections have - to be calculated <P> - - <H3> More information: </H3> <UL> -<LI><A HREF="../ionost/ionost_keys.html">List of keywords</A> for IONOST -<LI><A HREF="../homepage.html">NEWSTAR Documentation Home page</A> -<LI>Description of <A HREF="../ionost_descr/ionost_descr.html">program IONOST</A> -<LI>The <A HREF="../common_descr/common_descr.html">DWARF User Interface</A> -</UL> diff --git a/hlp/ionost/ionost__srce_altaz_fixed.html b/hlp/ionost/ionost__srce_altaz_fixed.html deleted file mode 100644 index 6d2404daa3610a45530042d6fe551f0f9c8135a2..0000000000000000000000000000000000000000 --- a/hlp/ionost/ionost__srce_altaz_fixed.html +++ /dev/null @@ -1,15 +0,0 @@ -<TITLE>Description of SRCE_ALTAZ_FIXED (IONOST)</TITLE> -<H1>Program IONOST: private keyword SRCE_ALTAZ_FIXED</H1> - -<DT><EM>Prompt:</EM> YES, NO (Is source fixed in altazimuth coordinates?) -<DT><EM>Default:</EM> NO /NOASK. -<DT><EM>Expected input:</EM> Character(3).<P> - source position flag: = NO source not fixed in altazimuth coordinates - = YES source fixed in altazimtuh coordinates <P> - - <H3> More information: </H3> <UL> -<LI><A HREF="../ionost/ionost_keys.html">List of keywords</A> for IONOST -<LI><A HREF="../homepage.html">NEWSTAR Documentation Home page</A> -<LI>Description of <A HREF="../ionost_descr/ionost_descr.html">program IONOST</A> -<LI>The <A HREF="../common_descr/common_descr.html">DWARF User Interface</A> -</UL> diff --git a/hlp/ionost/ionost__ut_time.html b/hlp/ionost/ionost__ut_time.html deleted file mode 100644 index 0e59bab431777af51ddb553131ec4cfb25bd2e7c..0000000000000000000000000000000000000000 --- a/hlp/ionost/ionost__ut_time.html +++ /dev/null @@ -1,16 +0,0 @@ -<TITLE>Description of UT_TIME (IONOST)</TITLE> -<H1>Program IONOST: private keyword UT_TIME</H1> - -<DT><EM>Prompt:</EM> -<DT><EM>Default:</EM> -32767 /ASK. -<DT><EM>Expected input:</EM> I.<P> - Universal Time of observations Faraday rotation [in hours and - fractions of hours - i.e. hh.hhh]. If no more values are given: - specify <CR>. <P> - - <H3> More information: </H3> <UL> -<LI><A HREF="../ionost/ionost_keys.html">List of keywords</A> for IONOST -<LI><A HREF="../homepage.html">NEWSTAR Documentation Home page</A> -<LI>Description of <A HREF="../ionost_descr/ionost_descr.html">program IONOST</A> -<LI>The <A HREF="../common_descr/common_descr.html">DWARF User Interface</A> -</UL> diff --git a/hlp/ionost_keys/ionost_keys.html b/hlp/ionost_keys/ionost_keys.html deleted file mode 100644 index 02fbe296e94e1e8d477a54e514671ade0d4cf655..0000000000000000000000000000000000000000 --- a/hlp/ionost_keys/ionost_keys.html +++ /dev/null @@ -1,81 +0,0 @@ -<TITLE>Index of private keywords for IONOST </TITLE> -<H1>Description of keywords for program IONOST</H1> - -<UL> -<LI> <A HREF="../ionost/ionost__source_name.html"> - SOURCE_NAME</A> - -<LI> <A HREF="../ionost/ionost__day_number.html"> - DAY_NUMBER</A> - -<LI> <A HREF="../ionost/ionost__longitude_obs.html"> - LONGITUDE_OBS</A> - -<LI> <A HREF="../ionost/ionost__latitude_obs.html"> - LATITUDE_OBS</A> - -<LI> <A HREF="../ionost/ionost__longitude_stat.html"> - LONGITUDE_STAT</A> - -<LI> <A HREF="../ionost/ionost__latitude_stat.html"> - LATITUDE_STAT</A> - -<LI> <A HREF="../ionost/ionost__frequency.html"> - FREQUENCY</A> - -<LI> <A HREF="../ionost/ionost__right_ascension.html"> - RIGHT_ASCENSION</A> - -<LI> <A HREF="../ionost/ionost__declination.html"> - DECLINATION</A> - -<LI> <A HREF="../ionost/ionost__corrections.html"> - CORRECTIONS</A> - VLBI, RIF, FAR, DELAY (Corrections to be calculated) -<LI> <A HREF="../ionost/ionost__faraday_input.html"> - FARADAY_INPUT</A> - YES, NO (Is Faraday rotation input required?) -<LI> <A HREF="../ionost/ionost__change_f0f2_inp.html"> - CHANGE_F0F2_INP</A> - YES, NO (Should foF2 input data be changed?) -<LI> <A HREF="../ionost/ionost__srce_altaz_fixed.html"> - SRCE_ALTAZ_FIXED</A> - YES, NO (Is source fixed in altazimuth coordinates?) -<LI> <A HREF="../ionost/ionost__geometry.html"> - GEOMETRY</A> - FIXED, VARIABLE, DEFAULT (Geometry selection) -<LI> <A HREF="../ionost/ionost__f2_bottom_height.html"> - F2_BOTTOM_HEIGHT</A> - -<LI> <A HREF="../ionost/ionost__f2_p1_height.html"> - F2_P1_HEIGHT</A> - -<LI> <A HREF="../ionost/ionost__f2_max_height.html"> - F2_MAX_HEIGHT</A> - -<LI> <A HREF="../ionost/ionost__f2_p2_height.html"> - F2_P2_HEIGHT</A> - -<LI> <A HREF="../ionost/ionost__f2_top_height.html"> - F2_TOP_HEIGHT</A> - -<LI> <A HREF="../ionost/ionost__ut_time.html"> - UT_TIME</A> - -<LI> <A HREF="../ionost/ionost__observed_far_rot.html"> - OBSERVED_FAR_ROT</A> - -<LI> <A HREF="../ionost/ionost__nr_180_deg_steps.html"> - NR_180_DEG_STEPS</A> - -<LI> <A HREF="../ionost/ionost__next_day.html"> - NEXT_DAY</A> - YES, NO (Next day flag) -</UL> - - - <H3> More information: </H3> <UL> -<LI><A HREF="../homepage.html">NEWSTAR Documentation Home page</A> -<LI><A HREF="../hb_contents/hb_contents.html">The NEWSTAR Cookbook</A> -<LI>Description of <A HREF="../ionost_descr/ionost_descr.html">program IONOST</A> -</UL> diff --git a/hlp/jen.gif b/hlp/jen.gif deleted file mode 100644 index 38b07b9858ac2c1948714fe4d53b84fd712e61ca..0000000000000000000000000000000000000000 Binary files a/hlp/jen.gif and /dev/null differ diff --git a/hlp/jph.gif b/hlp/jph.gif deleted file mode 100644 index d25dff2c6e67d9f5efb434fab20e501c5c00a979..0000000000000000000000000000000000000000 Binary files a/hlp/jph.gif and /dev/null differ diff --git a/hlp/mdlnode/mdlnode__input_mdl_node.html b/hlp/mdlnode/mdlnode__input_mdl_node.html deleted file mode 100644 index 6127fbf894d956f4586596b3a0a66d4cbea16172..0000000000000000000000000000000000000000 --- a/hlp/mdlnode/mdlnode__input_mdl_node.html +++ /dev/null @@ -1,16 +0,0 @@ -<TITLE>Description of INPUT_MDL_NODE (MDLNODE)</TITLE> -<H1>Description of general keyword INPUT_MDL_NODE</H1> - -<DT><EM>Prompt:</EM> input .MDL file name -<DT><EM>Expected input:</EM> Character(80).<P> - Specify the input .MDL filee name. <P> -Enter ** (or e.g. /user0/mydata/**) to get a list of .MDL files in your current -(or the indicated) directory; then enter #<n> to select the <n>th file from -such a list. <P> - - <H3> More information: </H3> <UL> -<LI><A HREF="../mdlnode/mdlnode_comm.html">List of general keywords</A> for MDLNODE -<LI>Description of the <A HREF="../mdl_descr/mdl_descr.html">MDL file format</A> -<LI><A HREF="../homepage.html">NEWSTAR Documentation Home page</A> -<LI>The <A HREF="../common_descr/common_descr.html">DWARF User Interface</A> -</UL> diff --git a/hlp/mdlnode/mdlnode__mdl_node.html b/hlp/mdlnode/mdlnode__mdl_node.html deleted file mode 100644 index bba7d6c85f9c81fc9b4bf9fb7b3295d6e82b2f81..0000000000000000000000000000000000000000 --- a/hlp/mdlnode/mdlnode__mdl_node.html +++ /dev/null @@ -1,16 +0,0 @@ -<TITLE>Description of MDL_NODE (MDLNODE)</TITLE> -<H1>Description of general keyword MDL_NODE</H1> - -<DT><EM>Prompt:</EM> input/output .MDL file name -<DT><EM>Expected input:</EM> Character(80).<P> - Specify the .MDL file name. <P> -Enter ** (or e.g. /user0/mydata/**) to get a list of .MDL files in your current -(or the indicated) directory; then enter #<n> to select the <n>th file from -such a list. <P> - - <H3> More information: </H3> <UL> -<LI><A HREF="../mdlnode/mdlnode_comm.html">List of general keywords</A> for MDLNODE -<LI>Description of the <A HREF="../mdl_descr/mdl_descr.html">MDL file format</A> -<LI><A HREF="../homepage.html">NEWSTAR Documentation Home page</A> -<LI>The <A HREF="../common_descr/common_descr.html">DWARF User Interface</A> -</UL> diff --git a/hlp/mdlnode/mdlnode__output_mdl_node.html b/hlp/mdlnode/mdlnode__output_mdl_node.html deleted file mode 100644 index 6e88d5a4f13b7a7fa4a6ccc9de5c2b75bd38c3e8..0000000000000000000000000000000000000000 --- a/hlp/mdlnode/mdlnode__output_mdl_node.html +++ /dev/null @@ -1,16 +0,0 @@ -<TITLE>Description of OUTPUT_MDL_NODE (MDLNODE)</TITLE> -<H1>Description of general keyword OUTPUT_MDL_NODE</H1> - -<DT><EM>Prompt:</EM> output .MDL file name -<DT><EM>Expected input:</EM> Character(80).<P> - Specify the output .MDL file name. <P> -Enter ** (or e.g. /user0/mydata/**) to get a list of .MDL files in your current -(or the indicated) directory; then enter #<n> to select the <n>th file from -such a list. <P> - - <H3> More information: </H3> <UL> -<LI><A HREF="../mdlnode/mdlnode_comm.html">List of general keywords</A> for MDLNODE -<LI>Description of the <A HREF="../mdl_descr/mdl_descr.html">MDL file format</A> -<LI><A HREF="../homepage.html">NEWSTAR Documentation Home page</A> -<LI>The <A HREF="../common_descr/common_descr.html">DWARF User Interface</A> -</UL> diff --git a/hlp/mdlnode_comm/mdlnode_comm.html b/hlp/mdlnode_comm/mdlnode_comm.html deleted file mode 100644 index 54996800af4194da4a2dfdc45928132de7961957..0000000000000000000000000000000000000000 --- a/hlp/mdlnode_comm/mdlnode_comm.html +++ /dev/null @@ -1,20 +0,0 @@ -<TITLE>Index of general keywords from MDLNODE</TITLE> -<H1>Description of general keywords (MDLNODE)</H1> - -<UL> -<LI> <A HREF="../mdlnode/mdlnode__mdl_node.html"> - MDL_NODE</A> - input/output .MDL file name -<LI> <A HREF="../mdlnode/mdlnode__input_mdl_node.html"> - INPUT_MDL_NODE</A> - input .MDL file name -<LI> <A HREF="../mdlnode/mdlnode__output_mdl_node.html"> - OUTPUT_MDL_NODE</A> - output .MDL file name -</UL> - - - <H3> More information: </H3> <UL> -<LI><A HREF="../homepage.html">NEWSTAR Documentation Home page</A> -<LI><A HREF="../hb_contents/hb_contents.html">The NEWSTAR Cookbook</A> -</UL> diff --git a/hlp/memos.txt b/hlp/memos.txt deleted file mode 100644 index 6fc76ebf4f0749ad7556c3bba1ad7c1bdc8c0983..0000000000000000000000000000000000000000 --- a/hlp/memos.txt +++ /dev/null @@ -1,145 +0,0 @@ -The NEWSTAR memo system ------------------------ - -This memo proposes a format for software memo series. -The vital element in this format is the Memo Header which gives -all vital information. The various header elements are described -with their possible values, - -The only implementation currently available is for Newstar memo's. Some -sample headers from this series are added. - - -1. Function of memo's ---------------------- - -The function of a memo series is to document a design process and to -offer a convenient place where notes of various kinds can be dumped. - -In order to achieve this, it is essential that the header of each note -clearly states what the purpose, subject and intended audience is. - -That way, it is sufficient to browse the headers of memo's in order -to find information relevant to a certain person or problem - - -2. Layout of memo headers -------------------------- - -A memo header consists of the following fields, some of which are -required, others are optional: - - * Name of memo series + index number [Required] - - In fact the name of the memo series is a first order - selection of the intended audience. - The serial number should be assigned on a central basis (preferably - some automated procedure) and runs incrementally from 1. - - * Subject [Required] - - The subject or description should be one line of highly descriptive - information. Since this line will show up in overview indices, - it has to contain sufficient information to identify the scope - of the memo. - - * Author [Required] - - This is just a textual identification. Preferably some database - with additional information on Memo authors should exist (including - up to date information on (eMail) addresses). - - * Date [Required] - - This should be the date of issue of the original memo, for - updates see the next section - - * Status [Optional] - - Possible values: Info Proposal Design - - More than one value may be given, the list of possible values - may be extended - - IF MISSING a status of Info should be assumed - - * Action [Optional] - - Possible values: Decision Read Feedback - Optional extension: "before <date>" - - The action should be taken before the specified date, if no date - is given this is NOT equivalent to "as soon as possible" (in that - case a specific date should be given) but to "not necessary" - - IF MISSING a status of Read should be assumed - - - * To [Required] - - The intended audience. This may be a specific name (e.g. Dr. P. Puk), - a generic name (WHISP Project Team) or The ... Memo Series - - * Summary [Required] - - The full header including the summary should not exeed a single - page. Since Memo's are intended to be brief, no more than the - summary will be required in many cases. - - * Replaces [Optional] - - Gives the numbers of the memo's that become obsolete by this one. - - * Update on [Optional] - - Gives the numbers of the memo's are updated by this one. - - -3. An example: the Newstar Memo Series --------------------------------------- - -The Newstar memo series is part of the hypertext network of Newstar -documentation. The header layout in current practice does not follow -the proposal in all details. - -The body of the memo can be in any form (WP, ASCII text, Hypertext, LaTeX). -In order enter the memo into the memo series, one enters the command - - ndoc memo new [file] - -This will assign a unique number to the memo and create an empty memo -header. You will be prompted for all header entries, and in addition -be asked for memo's, bug-reports and source files with which the memo -is concerned. These references appear as hypertext links in the on-line -version of the memo, and in normal text in the memo header. - -The specified file (which may be "none") will be moved into the directory -with memo headers. The final header page will be presented for editing, -together with the associated file. This is the time to fill in the summary -(which may be copied from the associated file). - -After completion, an index of all memo's will be automatically updated. - - -4. Updates on existing memo's ------------------------------ - -If a memo is updated, it is advised to enter the updates as a separate memo, -indicating the differences only. If a modified text is stored, users are -forced to read through the entire memo and the preceding version to find -the differences. - -Only if a memo has been changed substantially, so it is in fact better -to go through the whole text once more, a new memo can be created to -replace the original one. - -The header fields "Replaces" and "Update on" should be used to -indicate such cases. - -In the on-line implementation of the Newstar Memo Series, the headers -of the updated/replaced memo's are modified to reflect this information -as well. People keeping a paper copy can replace their header pages -with the updates. - - - diff --git a/hlp/models_and_maps.txt b/hlp/models_and_maps.txt deleted file mode 100644 index c4b4bd644dd816f2aa9185cd233dba4b269a8d14..0000000000000000000000000000000000000000 --- a/hlp/models_and_maps.txt +++ /dev/null @@ -1,89 +0,0 @@ -How to apply models when making maps ------------------------------------- - -1e. Models and scanfiles ------------------------- - -Models can exist in two places: - - 1e. As a list of model parameters in a Model (MDL) file - 2e. As a list of model parameters and complex uv-data points - in a Scan (SCN) file - -The model-list and the uv-model in a SCN file are always in accordance -with each other. - -Models are update in the SCN files after a respons to the MODEL_ACTION -prompt. MODEL_ACTION is in fact: "What model is actually going to be used -for processing and what model will finally end up in the SCN file?" - -The MODEL_ACTION question is asked in many cases: - 1e. After the NMODEL option SAVE has been choosen - 2e. After the NMAP option SUBTRACT has been choosen - 3e. After the NCALIB option REDUNDANCY has been choosen - 4e. After the NFLAG flagging operation ARESID has been choosen - -In all cases, the MODEL_ACTION is preceded by the MODEL_OPTION prompt. -This allows you to create a temporary model list in memory by reading -MDL files or by creating model components "by hand". The temporary model -list can be editied as well. - -The MODEL_ACTION determines what model is actually used in the -following processing AND what model is stored in the SCN file - - Used Stored -MERGE SCN ^ List SCN ^ List -ADD SCN + List SCN + List -NEW List List -TEMP List SCN -INCR SCN + List SCN - -SCN: Model currently present in the SCN file -List: Model currently in memory (constructed at MODEL_OPTION) - ^ Combination of two models, with common components occuring only - once in the final model - + Addition of the two models, components occuring in both models - are added as well, so they get the double amplitude - -Obviously, options MERGE and NEW will be most commonly used. - -Apart from this choice, MODEL_ACTION lets you decide how the model should -be calculated: should band smearing and time smearing be taken into account, -should instrumental polarisation be taken into account. - - -2. Subtracting models with NMAP -------------------------------- - -There are two ways to subtract a model from uv-data before a map is made: - - 1e. In NMAP, answer SUBTRACT=YES - - You will be asked for MODEL_OPTION to construct a temporary list, - and for MODEL_ACTION to determine what model is to be used. - - This way you cannot use just the model that is present in the SCN file. - - Also, you cannot use different models for different sets or different - SCN files (NMAP allows you to combine various SCN files, and to make - several maps based on several groups etc) - - - 2e. With NMAP, use DEAPPLY=MOD and SUBTRACT=NO - - The uv-model in the SCN file(s) will be subtracted from the uv-data - it corresponds to. The uv-model is considered a modification of the - visibilities corresponding to an empty sky. Deapplying this - modification thus corresponds to subtraction of the uv-model. - - This way, you can only use the model that is present in the SCN file. - This way, you can use different models for different groups in a SCN - file, and different models for different SCN files. - - However, you cannot add sources from another model, and you cannot - control the BAND/TIME/INPOL parameters (you should have done this when - you put the model in the SCN file). - -The same reasoning applies to NCALIB and NFLAG. - - diff --git a/hlp/more_on_batch.txt b/hlp/more_on_batch.txt deleted file mode 100644 index 306b40f416cb11255f2113d065c7b1bf84fe5801..0000000000000000000000000000000000000000 --- a/hlp/more_on_batch.txt +++ /dev/null @@ -1,230 +0,0 @@ -Fm: Marco de Vos (Newstar Project Team) -To: Ulrich Schwarz & Paul Stoppelenburg - -Subject: -Hints for batchprocessing with Newstar --------------------------------------- - - -A. Layout for a batch-script ----------------------------- - -Batch-scripts always have the follwing layout: - ->>>>>>>>>>>>>>>>>>> Example follows below this line >>>>>>>>>>> -#!/bin/csh -f -# -# Startup Newstar -# -source ~newstar/src/sys/newstar_rug.csh - -# -# Maybe some identification -# -echo "Name of the script: $0" # Prints the name of the file -echo "Purpose: ....." # Print the purpose of the file - -# -# Clear all symbols -# -dwc '*$ch0' - -# -# Define the symbols for this job -# -dws nmap\$ch0 /nomenu <<_EOD_ -OPTION=MAKE;QUIT ! The QUIT is for final exit -LOOPS="";# ! The # is in case we want to stop at the SCN_NODE prompt -SCN_NODE=obs2; ""/ask ! Just set the two defaults (/ASK) -SCN_SETS=0.0.0.0.0 -HA_RANGE= -90,90 -SELECT_IFRS= -mm,-ff;"" ! The second answer should be "" -... etc ... -# -_EOD_ - -# -# Start the program -# -dwe nmap\$ch0 - -# -# End -# -<<<<<<<<<<<<<<<< End of example <<<<<<<<<<<<<<<<<<<<<<<<<<<<<< - - -There may be many different dws and dwe commands in a single file. - -In stead of typing nmap\$0 you can also use 'nmap$0' . - - - - -B. Starting a batch-script --------------------------- - -To start such a batch script, just type it's name, eg: - - > nmap0.scr - -This may give a message like: nmap0.scr: Permission denied. - -In that case you sould first type: - - > chmod a+x nmap0.scr - -to change the mode ("protection") of the file such that All users -can eXecute it. You probably created the script from scratch with -an editor, so Unix treated it as an ordinary text file. - - - -C. Starting batch jobs in the background ----------------------------------------- - -To start a batch job in the background, leaving your terminal free -for other work, just type the following: - - > nmap0.scr >& output_file & - -All output that normally was shown on your screen will now end up in -the file named output_file (you can use any name you like). - -To check wether the job is finished you can try: - - > more output_file shows all of the "screen output" - > tail output_file shows the last 20 lines or so - > ps lws | grep nmap0.scr shows the status of the process (with - elapsed time etc.), no output means - the batch is finished - -There is a Newstar command which will execute a job in the background -and send the output to you by mail when it finishes. Just type: - - > nspawn nmap0.scr - -The "screen output" will end up in nmap0.scr.output. -The mail will be sent using elm with the command as subject. - -NOTA BENE: If you start a job in the background, all parameters should - be known in advance. So you should not use /ASK when specifying - parameters. - - - -D. How to set the keywords for a program ----------------------------------------- - -In a batch-script, you can set keywords in two different ways: - -1e. Use the dwspecify (dws) command: - -dws nmap\$ch0 /nomenu <<_EOD_ -OPTION=first_answer;second_answer;third_answer -SCN_NODE=TEST;"" -# -_EOD_ - -The sequence of the keywords is not relevant. -Each keyword should be set like: KEYWORD= value (not: nmap$ch0_keyword=value). -You can only specify the keywords for one program (and one stream). - -You can enter the KEYWORD=value lines by hand, or edit the output -from dwsave (remove the PROGRAM$Stream_ prefixes!) - -Alternatively you can extract keywords from a logfile: - - > grep '^>' NMAP.LOG | sed -e 's/^>//' > output_file - -If this seems an interesting option, I will create a Newstar command -for it (to save innocent Unix users all the '^>' things). - - -2e. Use the dwrestore command: - - -Typically, you will now do the following: - - > dwe ncalib\$ch0 /norun/save - > dwe nmap\$ch0 /norun/save - > dwsave nmap\$ch0 /output=nmap0.keys - -Now you may want to edit nmap0.keys, which contains lines like: - - NMAP$1_LOOPS=""";#" - NMAP$1_OPTION="MAKE;#" - NMAP$1_RUN="YES" - NMAP$1_SCN_NODE="""" - -In the batch script, you say: - -dwrestore nmap0.keys - - -3e. Combine the use of dws and dwrestore - - -Suppose we want to do a job repeatedly with the parameters saved above, -but with only SCN_SETS differing from command to command. We may then -combine dws and dwrestore as follows: - - -#!bin/csh -#!/bin/csh -f -# -# Startup Newstar -# -source ~newstar/src/sys/newstar_rug.csh - -# -# Maybe some identification -# -echo "Name of the script: $0" # Prints the name of the file -echo "Purpose: ....." # Print the purpose of the file - -# -# Clear all symbols -# -dwc '*' - -# -# Set up all "global" symbols for this job -# -dwrestore nmap0.keys - -# -# Start a loop over the sets -# -foreach set ( 0 1 3 4 ) - -# -# Define SCN_SETS for ncalib -# -dws ncalib\$ch0 /nomenu <<_EOD_ -SCN_SETS=0.0.$set -# -_EOD_ - -# -# Run ncalib for this set -# -dwe ncalib\$ch0 - -# -# Define SCN_SETS for nmap -# -dws nmap\$ch0 /nomenu <<_EOD_ -SCN_SETS=0.0.$set -# -_EOD_ - -# -# Run ncalib for this set -# -dwe nmap\$ch0 - -# -# Next set -# -end diff --git a/hlp/natnf/natnf__continuum.html b/hlp/natnf/natnf__continuum.html deleted file mode 100644 index 633dc1a828fa318c823efc7d9ecebfdff0671a32..0000000000000000000000000000000000000000 --- a/hlp/natnf/natnf__continuum.html +++ /dev/null @@ -1,18 +0,0 @@ -<TITLE>Description of CONTINUUM (NATNF)</TITLE> -<H1>Program NATNF: private keyword CONTINUUM</H1> - -<DT><EM>Prompt:</EM> define channels for continuum -<DT><EM>Expected input:</EM> Integer number, 16 values.<P> -A continuum channel can be made by specifying up to 8 pairs of channel numbers. -The channel values will be averaged to produce a single continuum value. Each -pair specifies a low and high channel number to be included. <P> -Special values: - "" No continuum wanted - * Central 75% of channels used <P> - - <H3> More information: </H3> <UL> -<LI><A HREF="../natnf/natnf_keys.html">List of keywords</A> for NATNF -<LI><A HREF="../homepage.html">NEWSTAR Documentation Home page</A> -<LI>Description of <A HREF="../natnf_descr/natnf_descr.html">program NATNF</A> -<LI>The <A HREF="../common_descr/common_descr.html">DWARF User Interface</A> -</UL> diff --git a/hlp/natnf/natnf__input_bands.html b/hlp/natnf/natnf__input_bands.html deleted file mode 100644 index 884c3221416269cacef8ac3ddb0bba4388db0e3b..0000000000000000000000000000000000000000 --- a/hlp/natnf/natnf__input_bands.html +++ /dev/null @@ -1,14 +0,0 @@ -<TITLE>Description of INPUT_BANDS (NATNF)</TITLE> -<H1>Program NATNF: private keyword INPUT_BANDS</H1> - -<DT><EM>Prompt:</EM> input bands in cm -<DT><EM>Expected input:</EM> Real number, 16 values.<P> -Specify the bands to be read (20 etc in octave steps. * specifies all bands on -the tape <P> - - <H3> More information: </H3> <UL> -<LI><A HREF="../natnf/natnf_keys.html">List of keywords</A> for NATNF -<LI><A HREF="../homepage.html">NEWSTAR Documentation Home page</A> -<LI>Description of <A HREF="../natnf_descr/natnf_descr.html">program NATNF</A> -<LI>The <A HREF="../common_descr/common_descr.html">DWARF User Interface</A> -</UL> diff --git a/hlp/natnf/natnf__input_channels.html b/hlp/natnf/natnf__input_channels.html deleted file mode 100644 index ffeb3ed06f821fa870b62064b8f8ea66a0e2a38f..0000000000000000000000000000000000000000 --- a/hlp/natnf/natnf__input_channels.html +++ /dev/null @@ -1,13 +0,0 @@ -<TITLE>Description of INPUT_CHANNELS (NATNF)</TITLE> -<H1>Program NATNF: private keyword INPUT_CHANNELS</H1> - -<DT><EM>Prompt:</EM> input channels -<DT><EM>Expected input:</EM> Integer number, 256 values; min.value: 1.000000.<P> -Specify the channels (1, ..) to be read. * specifies all channels on the tape <P> - - <H3> More information: </H3> <UL> -<LI><A HREF="../natnf/natnf_keys.html">List of keywords</A> for NATNF -<LI><A HREF="../homepage.html">NEWSTAR Documentation Home page</A> -<LI>Description of <A HREF="../natnf_descr/natnf_descr.html">program NATNF</A> -<LI>The <A HREF="../common_descr/common_descr.html">DWARF User Interface</A> -</UL> diff --git a/hlp/natnf/natnf__input_file.html b/hlp/natnf/natnf__input_file.html deleted file mode 100644 index d08c08532b91249caa16f4d5eff6440c1583d785..0000000000000000000000000000000000000000 --- a/hlp/natnf/natnf__input_file.html +++ /dev/null @@ -1,14 +0,0 @@ -<TITLE>Description of INPUT_FILE (NATNF)</TITLE> -<H1>Program NATNF: private keyword INPUT_FILE</H1> - -<DT><EM>Prompt:</EM> input filename -<DT><EM>Expected input:</EM> Character(80).<P> -Specify the input filename (without an extension for the LOAD from disk -option). <P> - - <H3> More information: </H3> <UL> -<LI><A HREF="../natnf/natnf_keys.html">List of keywords</A> for NATNF -<LI><A HREF="../homepage.html">NEWSTAR Documentation Home page</A> -<LI>Description of <A HREF="../natnf_descr/natnf_descr.html">program NATNF</A> -<LI>The <A HREF="../common_descr/common_descr.html">DWARF User Interface</A> -</UL> diff --git a/hlp/natnf/natnf__input_labels.html b/hlp/natnf/natnf__input_labels.html deleted file mode 100644 index a4f83fc6fa3b498afc8c82b4987cd757ae5dc8f1..0000000000000000000000000000000000000000 --- a/hlp/natnf/natnf__input_labels.html +++ /dev/null @@ -1,13 +0,0 @@ -<TITLE>Description of INPUT_LABELS (NATNF)</TITLE> -<H1>Program NATNF: private keyword INPUT_LABELS</H1> - -<DT><EM>Prompt:</EM> input labels -<DT><EM>Expected input:</EM> Integer number, 256 values.<P> -Specify the tape labels to be read. * specifies all labels on the tape <P> - - <H3> More information: </H3> <UL> -<LI><A HREF="../natnf/natnf_keys.html">List of keywords</A> for NATNF -<LI><A HREF="../homepage.html">NEWSTAR Documentation Home page</A> -<LI>Description of <A HREF="../natnf_descr/natnf_descr.html">program NATNF</A> -<LI>The <A HREF="../common_descr/common_descr.html">DWARF User Interface</A> -</UL> diff --git a/hlp/natnf/natnf__input_sources.html b/hlp/natnf/natnf__input_sources.html deleted file mode 100644 index 8c695e40e5f14573434abb4e727ad0fd3313c006..0000000000000000000000000000000000000000 --- a/hlp/natnf/natnf__input_sources.html +++ /dev/null @@ -1,13 +0,0 @@ -<TITLE>Description of INPUT_SOURCES (NATNF)</TITLE> -<H1>Program NATNF: private keyword INPUT_SOURCES</H1> - -<DT><EM>Prompt:</EM> sources to get -<DT><EM>Expected input:</EM> Character(16), 256 values.<P> -Specify the sources to be read. * specifies all sources on the tape <P> - - <H3> More information: </H3> <UL> -<LI><A HREF="../natnf/natnf_keys.html">List of keywords</A> for NATNF -<LI><A HREF="../homepage.html">NEWSTAR Documentation Home page</A> -<LI>Description of <A HREF="../natnf_descr/natnf_descr.html">program NATNF</A> -<LI>The <A HREF="../common_descr/common_descr.html">DWARF User Interface</A> -</UL> diff --git a/hlp/natnf/natnf__integration_time.html b/hlp/natnf/natnf__integration_time.html deleted file mode 100644 index 724c83df5d7adbd037e01b171cb718625ebf0c7f..0000000000000000000000000000000000000000 --- a/hlp/natnf/natnf__integration_time.html +++ /dev/null @@ -1,13 +0,0 @@ -<TITLE>Description of INTEGRATION_TIME (NATNF)</TITLE> -<H1>Program NATNF: private keyword INTEGRATION_TIME</H1> - -<DT><EM>Prompt:</EM> integration time (sec) -<DT><EM>Expected input:</EM> Real number; min.value: 10.000000; max.value: 3600.000000.<P> -Specify the integration time per scan. <P> - - <H3> More information: </H3> <UL> -<LI><A HREF="../natnf/natnf_keys.html">List of keywords</A> for NATNF -<LI><A HREF="../homepage.html">NEWSTAR Documentation Home page</A> -<LI>Description of <A HREF="../natnf_descr/natnf_descr.html">program NATNF</A> -<LI>The <A HREF="../common_descr/common_descr.html">DWARF User Interface</A> -</UL> diff --git a/hlp/natnf/natnf__option.html b/hlp/natnf/natnf__option.html deleted file mode 100644 index 76084239adba669192d281d7e96fbfa0c7a9ca61..0000000000000000000000000000000000000000 --- a/hlp/natnf/natnf__option.html +++ /dev/null @@ -1,15 +0,0 @@ -<TITLE>Description of OPTION (NATNF)</TITLE> -<H1>Program NATNF: private keyword OPTION</H1> - -<DT><EM>Prompt:</EM> LOAD, QUIT -<DT><EM>Expected input:</EM> Character(24).<P> -Specify action to perform: <P> - LOAD load RPFITS data into scan file - QUIT finish <P> - - <H3> More information: </H3> <UL> -<LI><A HREF="../natnf/natnf_keys.html">List of keywords</A> for NATNF -<LI><A HREF="../homepage.html">NEWSTAR Documentation Home page</A> -<LI>Description of <A HREF="../natnf_descr/natnf_descr.html">program NATNF</A> -<LI>The <A HREF="../common_descr/common_descr.html">DWARF User Interface</A> -</UL> diff --git a/hlp/natnf/natnf__start_offset.html b/hlp/natnf/natnf__start_offset.html deleted file mode 100644 index 4d5e377baee14d762c23eac90c1c08e759273776..0000000000000000000000000000000000000000 --- a/hlp/natnf/natnf__start_offset.html +++ /dev/null @@ -1,16 +0,0 @@ -<TITLE>Description of START_OFFSET (NATNF)</TITLE> -<H1>Program NATNF: private keyword START_OFFSET</H1> - -<DT><EM>Prompt:</EM> scan start offset (sec) -<DT><EM>Expected input:</EM> Real number; min.value: 0.000000; max.value: 180.000000.<P> -Often the first 10 sec of a scan are bad. By specifying an offset here, the -first n seconds of a scan will be discarded. E.g. specifying an integration of -70 sec and an offset of 10 sec will produce 4 points for a 5 min observation, -discarding the first and last 10 sec. <P> - - <H3> More information: </H3> <UL> -<LI><A HREF="../natnf/natnf_keys.html">List of keywords</A> for NATNF -<LI><A HREF="../homepage.html">NEWSTAR Documentation Home page</A> -<LI>Description of <A HREF="../natnf_descr/natnf_descr.html">program NATNF</A> -<LI>The <A HREF="../common_descr/common_descr.html">DWARF User Interface</A> -</UL> diff --git a/hlp/natnf_keys/natnf_keys.html b/hlp/natnf_keys/natnf_keys.html deleted file mode 100644 index 2683ea10c2fa498447fdca002bbb4438fcdae410..0000000000000000000000000000000000000000 --- a/hlp/natnf_keys/natnf_keys.html +++ /dev/null @@ -1,55 +0,0 @@ -<TITLE>Index of private keywords for NATNF </TITLE> -<H1>Description of keywords for program NATNF</H1> - -<UL> -<LI> <A HREF="../natnf/natnf__option.html"> - OPTION</A> - LOAD, QUIT -<LI> <A HREF="../natnf/natnf__input_file.html"> - INPUT_FILE</A> - input filename -<LI> <A HREF="../natnf/natnf__input_labels.html"> - INPUT_LABELS</A> - input labels -<LI> <A HREF="../natnf/natnf__input_sources.html"> - INPUT_SOURCES</A> - sources to get -<LI> <A HREF="../natnf/natnf__input_bands.html"> - INPUT_BANDS</A> - input bands in cm -<LI> <A HREF="../natnf/natnf__input_channels.html"> - INPUT_CHANNELS</A> - input channels -<LI> <A HREF="../natnf/natnf__integration_time.html"> - INTEGRATION_TIME</A> - integration time (sec) -<LI> <A HREF="../natnf/natnf__start_offset.html"> - START_OFFSET</A> - scan start offset (sec) -<LI> <A HREF="../natnf/natnf__continuum.html"> - CONTINUUM</A> - define channels for continuum -<P> - -<UL><LI>See also <A HREF="../ngen_comm/ngen_comm.html">NGEN</A> </UL> - - -<UL><LI>See also <A HREF="../scnnode_comm/scnnode_comm.html">SCNNODE</A> </UL> - - -<UL><LI>See also <A HREF="../scnsets_comm/scnsets_comm.html">SCNSETS</A> </UL> - - -<UL><LI>See also <A HREF="../select_comm/select_comm.html">SELECT</A> </UL> - - -<UL><LI>See also <A HREF="../unit_comm/unit_comm.html">UNIT</A> </UL> - -</UL> - - - <H3> More information: </H3> <UL> -<LI><A HREF="../homepage.html">NEWSTAR Documentation Home page</A> -<LI><A HREF="../hb_contents/hb_contents.html">The NEWSTAR Cookbook</A> -<LI>Description of <A HREF="../natnf_descr/natnf_descr.html">program NATNF</A> -</UL> diff --git a/hlp/ncalib/ncalib__option.html b/hlp/ncalib/ncalib__option.html deleted file mode 100644 index bb5da5b1bbc2b069cc9d3c32b4ae9a193ce02074..0000000000000000000000000000000000000000 --- a/hlp/ncalib/ncalib__option.html +++ /dev/null @@ -1,19 +0,0 @@ -<TITLE>Description of OPTION (NCALIB)</TITLE> -<H1>Program NCALIB: private keyword OPTION</H1> - -<DT><EM>Prompt:</EM> Type of action REDUNDANCY, POLAR, SET; SHOW; QUIT -<DT><EM>Expected input:</EM> Character(12).<P> -Specify type of action to perform: <P> - REDUNDANCY create telescope corrections by solving the - redundancy/align/selfcal equations - POLAR operations on polarisation corrections - SET operations on all other corrections <P> - SHOW show (in logfile) average corrections in specified sector(s) - QUIT finish <P> - - <H3> More information: </H3> <UL> -<LI><A HREF="../ncalib/ncalib_keys.html">List of keywords</A> for NCALIB -<LI><A HREF="../homepage.html">NEWSTAR Documentation Home page</A> -<LI>Description of <A HREF="../ncalib_descr/ncalib_descr.html">program NCALIB</A> -<LI>The <A HREF="../common_descr/common_descr.html">DWARF User Interface</A> -</UL> diff --git a/hlp/ncalib/ncalib__polar_option.html b/hlp/ncalib/ncalib__polar_option.html deleted file mode 100644 index fadab9d7d58f5587cbd8555f053aed1bda65d889..0000000000000000000000000000000000000000 --- a/hlp/ncalib/ncalib__polar_option.html +++ /dev/null @@ -1,29 +0,0 @@ -<TITLE>Description of POLAR_OPTION (NCALIB)</TITLE> -<H1>Program NCALIB: private keyword POLAR_OPTION</H1> - -<DT><EM>Prompt:</EM> action on polarisation corrections| CALC, VZERO; COPY, SET, ZERO; SHOW, EDIT; QUIT -<DT><EM>Expected input:</EM> Character(8).<P> -Specify action to perform on polarisation corrections: <P> - Calculate corrections from calibrator visibilities. The new correction values - are ADDED to existing ones: <P> - CALC calculate dipole corrections <P> - VZERO select the set of operations dealing with the phase-zero - difference ('PZD') between the X and Y channel groups <P> - Copy/set corrections. The new corrections values generally OVERWRITE the - existing ones: <P> - COPY create dipole corrections in target sectors by copying them - from one source sector <P> - SET set dipole corrections manually <P> - ZERO zero dipole corrections <P> - Inspection: <P> - SHOW show dipole corrections <P> - EDIT edit dipole corrections <P> - Other: <P> - QUIT exit from POLAR <P> - - <H3> More information: </H3> <UL> -<LI><A HREF="../ncalib/ncalib_keys.html">List of keywords</A> for NCALIB -<LI><A HREF="../homepage.html">NEWSTAR Documentation Home page</A> -<LI>Description of <A HREF="../ncalib_descr/ncalib_descr.html">program NCALIB</A> -<LI>The <A HREF="../common_descr/common_descr.html">DWARF User Interface</A> -</UL> diff --git a/hlp/ncalib/ncalib__vzero_option.html b/hlp/ncalib/ncalib__vzero_option.html deleted file mode 100644 index e69de29bb2d1d6434b8b29ae775ad8c2e48c5391..0000000000000000000000000000000000000000 diff --git a/hlp/ncalib_keys/ncalib_keys.html b/hlp/ncalib_keys/ncalib_keys.html deleted file mode 100644 index e69de29bb2d1d6434b8b29ae775ad8c2e48c5391..0000000000000000000000000000000000000000 diff --git a/hlp/ncalib_vzero.txt b/hlp/ncalib_vzero.txt deleted file mode 100644 index d2b9347543be8855aea80f016bedc91690398e36..0000000000000000000000000000000000000000 --- a/hlp/ncalib_vzero.txt +++ /dev/null @@ -1,82 +0,0 @@ -The VZERO algorithm - JPH 960212 - -Summary -------- - Following a query by Jayaram Chengalur, this note provides an exegesis of W.N. Brouw's algorithm for determining the phase-zero-difference ('PZD') between the XX and YY interferometer subsets as implemeneted in the Newstar program NCALIB. The 180-degree ambiguity suggested by Chengalur appears indeed to exist; I suggest that a check could be implemented to insure selection of the proper value for the PZD. - ------------- - - -Brouw's algorithm ------------------ - I reproduce here the relevant lines of code from the program module NCAPVZ where the PZD is calculated: - - - 1 DO I1=0,STHJ(STH_NIFR_J)-1 !ALL IFRS - 2 IF (WGT(I1,1).GT.0 .AND. WGT(I1,2).GT.0 .AND. !XY/YX PRESENT - 3 1 ABS(DATC(I1,2)).NE.0) THEN !SOME POWER - 4 CF=1 !COEFFICIENT - 5 CW=-DATC(I1,2)*DATC(I1,1) !-YX.XY - 6 R0=ABS(CW) !WEIGHT - 7 IF (R0.NE.0) - 8 1 CALL WNMLMN(MAR,LSQ_C_COMPLEX,CF,R0, - 9 1 (DATC(I1,2)-CONJG(DATC(I1,1)))/SQRT(CW)) - . - solve - . - IF (ABS(CSOL).NE.0) THEN -10 XYDIF=ATAN2(AIMAG(CSOL),REAL(CSOL)) !GET ANGLE - ELSE - XYDIF=0 - END IF -11 CALL WNCTXT(F_TP,'A complex angle of !EC9.2\(!EC9.2) '// - 1 'or !EAR9.2 degrees', - 1 CSOL,CME,XYDIF) -C - - 1: Process all interferometers, I1 = interferometer index - 2: DATC = cpomplex visibility, WGT = weight; the first index is the - interferometer number, second index is 1 for XY, 2 for YX. Check - validity of data: if weight WGT equals 0, point has been deleted. - 3: This check seems to be redundant: If either XY or YX is 0, so will - be R0 in line 6 and consequently lines 8 and 9 will be skipped. - 5: CW = -XY.YX - 6: R0 = weight of this interferometer in the solution. - 7: If the weight is 0, bypass lines 8 and 9 including the division by - sqrt(CW). - 8: Accumulate sum of (XY-YX*)/sqrt(-XY.YX) with weights |XY.YX|. - 10: The result is a complex number, the weighted average of the - quantities of line 9 over all interferometers; its argument is the - phase difference we were after. - 11: The test displaying this result is a bit sloppy! - -So the quantity that is averaged (line 8) is - - P = sqrt(XY/YX) - sqrt(YX*/YX).sqrt(YX/XY) - - -Interpretation --------------- - - I suggest the following interpretation: - -We seek to minimise |V| by multiplying X with a factor a.e^(i.phi), so - - YX' = YX.a^2.e^(2i.phi) - -making - - P' = sqrt(XY/YX) - a.e^(i.phi).sqrt(YX/XY) - -Setting P' = 0 gives us - - a.e^(i.phi) = sum[sqrt(XY/YX)] / sum[sqrt(YX/XY)] - -The amplitude factor a should be 1 after XX and YY Selfcal, and could be used for a consistency check. NCALIB implicity displays its value by printing out a.e^(i.phi) as a 'complex angle', but otherwise ignores it. - - -The PZD ambiguity ------------------ - - The 180-degree ambiguity in the VZERO determination noted by Chengalur is represented in the algorithm above by the sign ambiguity of the sqrt() function. - - It seems to me that whatever algorithm one uses, there is probably no way to avoid the appearance in one form or another of a factor 2 on the unknown phase phi. This means that one must check afterwards in some way that the algorithm selected the right value; for a calibrator there should be enough flux in a single scan to do this straightaway. diff --git a/hlp/nclean/nclean__cmemory_use.html b/hlp/nclean/nclean__cmemory_use.html deleted file mode 100644 index 6e2edc04fa9fad87a5bc20f69cc745a71bf9e3d5..0000000000000000000000000000000000000000 --- a/hlp/nclean/nclean__cmemory_use.html +++ /dev/null @@ -1,19 +0,0 @@ -<TITLE>Description of CMEMORY_USE (NCLEAN)</TITLE> -<H1>Program NCLEAN: private keyword CMEMORY_USE</H1> - -<DT><EM>Prompt:</EM> UV-clean memory size -<DT><EM>Default:</EM> 150000 /NOASK. -<DT><EM>Expected input:</EM> Integer number; min.value: 32000.000000; max.value: 128000000.000000.<P> -Specify the work memory size in bytes for the UV Clean option, to be allowed in -defining the beam patch and to be used in executing the Fourier transforms. <P> -The default shown is normally adequate; a larger value may speed up the -execution of major cycles in UV Clean. -!. -!NCLEAN will not accept a value in excess of 32000000 (32 MB). - - <H3> More information: </H3> <UL> -<LI><A HREF="../nclean/nclean_keys.html">List of keywords</A> for NCLEAN -<LI><A HREF="../homepage.html">NEWSTAR Documentation Home page</A> -<LI>Description of <A HREF="../nclean_descr/nclean_descr.html">program NCLEAN</A> -<LI>The <A HREF="../common_descr/common_descr.html">DWARF User Interface</A> -</UL> diff --git a/hlp/nclean/nclean__dmemory_use.html b/hlp/nclean/nclean__dmemory_use.html deleted file mode 100644 index 26d7d7d94960fa6e229b72c602f73dcb63443db8..0000000000000000000000000000000000000000 --- a/hlp/nclean/nclean__dmemory_use.html +++ /dev/null @@ -1,19 +0,0 @@ -<TITLE>Description of DMEMORY_USE (NCLEAN)</TITLE> -<H1>Program NCLEAN: private keyword DMEMORY_USE</H1> - -<DT><EM>Prompt:</EM> Work memory size -<DT><EM>Default:</EM> 300000. -<DT><EM>Expected input:</EM> Integer number; min.value: 32000.000000; max.value: 32000000.000000.<P> -The memory workspace in bytes needed is 12 times the size of the rectangle -enclosing all selected areas in the map plane. NCLEAN normally allocates up to -300 KB for this purpose. To satisfy the present need, you must either accept -the value suggested here or specify a smaller set of areas, or both. -!. -!NCLEAN will not accept a value in excess of 32000000 (32 MB). - - <H3> More information: </H3> <UL> -<LI><A HREF="../nclean/nclean_keys.html">List of keywords</A> for NCLEAN -<LI><A HREF="../homepage.html">NEWSTAR Documentation Home page</A> -<LI>Description of <A HREF="../nclean_descr/nclean_descr.html">program NCLEAN</A> -<LI>The <A HREF="../common_descr/common_descr.html">DWARF User Interface</A> -</UL> diff --git a/hlp/nclean/nclean__option.html b/hlp/nclean/nclean__option.html deleted file mode 100644 index e69de29bb2d1d6434b8b29ae775ad8c2e48c5391..0000000000000000000000000000000000000000 diff --git a/hlp/nclean_keys/nclean_keys.html b/hlp/nclean_keys/nclean_keys.html deleted file mode 100644 index e69de29bb2d1d6434b8b29ae775ad8c2e48c5391..0000000000000000000000000000000000000000 diff --git a/hlp/ncopy/ncopy__copy_ifdata.html b/hlp/ncopy/ncopy__copy_ifdata.html deleted file mode 100644 index 2b7a979a6fee3c06aaa11d577de20f8ef5d6178f..0000000000000000000000000000000000000000 --- a/hlp/ncopy/ncopy__copy_ifdata.html +++ /dev/null @@ -1,14 +0,0 @@ -<TITLE>Description of COPY_IFDATA (NCOPY)</TITLE> -<H1>Program NCOPY: private keyword COPY_IFDATA</H1> - -<DT><EM>Prompt:</EM> copy IF-data/Total Powers? -<DT><EM>Expected input:</EM> Logical.<P> - Specify YES if you want to copy IF-data (Total Powers) together -with the data <P> - - <H3> More information: </H3> <UL> -<LI><A HREF="../ncopy/ncopy_keys.html">List of keywords</A> for NCOPY -<LI><A HREF="../homepage.html">NEWSTAR Documentation Home page</A> -<LI>Description of <A HREF="../ncopy_descr/ncopy_descr.html">program NCOPY</A> -<LI>The <A HREF="../common_descr/common_descr.html">DWARF User Interface</A> -</UL> diff --git a/hlp/ncopy/ncopy__copy_model.html b/hlp/ncopy/ncopy__copy_model.html deleted file mode 100644 index 71a65e6f4748cbffba8297857ce77ca0c2811c91..0000000000000000000000000000000000000000 --- a/hlp/ncopy/ncopy__copy_model.html +++ /dev/null @@ -1,13 +0,0 @@ -<TITLE>Description of COPY_MODEL (NCOPY)</TITLE> -<H1>Program NCOPY: private keyword COPY_MODEL</H1> - -<DT><EM>Prompt:</EM> copy model data? -<DT><EM>Expected input:</EM> Logical.<P> - Specify YES if you want to copy the model together with the data <P> - - <H3> More information: </H3> <UL> -<LI><A HREF="../ncopy/ncopy_keys.html">List of keywords</A> for NCOPY -<LI><A HREF="../homepage.html">NEWSTAR Documentation Home page</A> -<LI>Description of <A HREF="../ncopy_descr/ncopy_descr.html">program NCOPY</A> -<LI>The <A HREF="../common_descr/common_descr.html">DWARF User Interface</A> -</UL> diff --git a/hlp/ncopy/ncopy__option.html b/hlp/ncopy/ncopy__option.html deleted file mode 100644 index 56fc926fc0eb7aed56c626c6d553467ba04ec72c..0000000000000000000000000000000000000000 --- a/hlp/ncopy/ncopy__option.html +++ /dev/null @@ -1,19 +0,0 @@ -<TITLE>Description of OPTION (NCOPY)</TITLE> -<H1>Program NCOPY: private keyword OPTION</H1> - -<DT><EM>Prompt:</EM> COPY, SHORTCOPY, OVERVIEW, QUIT -<DT><EM>Expected input:</EM> Character(12), 1 values.<P> -Actions: <P> - COPY Copy sectors from one SCN file to another. - SHORTCOPY As copy, but only scans selected by scan number; this option - allows you to cut out the invalid trailing scan from a mosaic - sector <P> - OVERWIEW Display and log an overview of all sectors in a SCN file - QUIT Exit from NCOPY <P> - - <H3> More information: </H3> <UL> -<LI><A HREF="../ncopy/ncopy_keys.html">List of keywords</A> for NCOPY -<LI><A HREF="../homepage.html">NEWSTAR Documentation Home page</A> -<LI>Description of <A HREF="../ncopy_descr/ncopy_descr.html">program NCOPY</A> -<LI>The <A HREF="../common_descr/common_descr.html">DWARF User Interface</A> -</UL> diff --git a/hlp/ncopy/ncopy__polarisation.html b/hlp/ncopy/ncopy__polarisation.html deleted file mode 100644 index 5d7f8727dafbc4840186e666dad041f077dfd8b2..0000000000000000000000000000000000000000 --- a/hlp/ncopy/ncopy__polarisation.html +++ /dev/null @@ -1,19 +0,0 @@ -<TITLE>Description of POLARISATION (NCOPY)</TITLE> -<H1>Program NCOPY: private keyword POLARISATION</H1> - -<DT><EM>Prompt:</EM> XYX, XY, X; [YX] Select polarisations -<DT><EM>Default:</EM> XYX. -<DT><EM>Expected input:</EM> Character(4).<P> -Select polarisations to be copied: - XYX: XX, XY, YX, YY - XY: XX, YY only - X: XX only <P> - YX: for special applications only: - overwrite XX with XY, YY with YX, then output as if XY <P> - - <H3> More information: </H3> <UL> -<LI><A HREF="../ncopy/ncopy_keys.html">List of keywords</A> for NCOPY -<LI><A HREF="../homepage.html">NEWSTAR Documentation Home page</A> -<LI>Description of <A HREF="../ncopy_descr/ncopy_descr.html">program NCOPY</A> -<LI>The <A HREF="../common_descr/common_descr.html">DWARF User Interface</A> -</UL> diff --git a/hlp/ncopy/ncopy__scans.html b/hlp/ncopy/ncopy__scans.html deleted file mode 100644 index c2a7376d50513320f68f3e1298da54d1c2ee858c..0000000000000000000000000000000000000000 --- a/hlp/ncopy/ncopy__scans.html +++ /dev/null @@ -1,19 +0,0 @@ -<TITLE>Description of SCANS (NCOPY)</TITLE> -<H1>Program NCOPY: private keyword SCANS</H1> - -<DT><EM>Prompt:</EM> First and last scan number from each sector -<DT><EM>Default:</EM> 0, 10000. -<DT><EM>Expected input:</EM> Integer number, 2 values.<P> -From all sectors selected, only the scan numbers within the selected scan -number and HA ranges wiull be copied. E.g., the specification <P> - SCANS= 0, 4 <P> -will remove the last scan (number 5) from allo sectors of a mosaic observation -that produces 6-scan sectors. <P> -Remember that the first scan in a sector is numbered 0. <P> - - <H3> More information: </H3> <UL> -<LI><A HREF="../ncopy/ncopy_keys.html">List of keywords</A> for NCOPY -<LI><A HREF="../homepage.html">NEWSTAR Documentation Home page</A> -<LI>Description of <A HREF="../ncopy_descr/ncopy_descr.html">program NCOPY</A> -<LI>The <A HREF="../common_descr/common_descr.html">DWARF User Interface</A> -</UL> diff --git a/hlp/ncopy_keys/ncopy_keys.html b/hlp/ncopy_keys/ncopy_keys.html deleted file mode 100644 index 5b7cdaaf95b884905a279366639c1b2a7f5b7729..0000000000000000000000000000000000000000 --- a/hlp/ncopy_keys/ncopy_keys.html +++ /dev/null @@ -1,81 +0,0 @@ -<TITLE>Index of private keywords for NCOPY </TITLE> -<H1>Description of keywords for program NCOPY</H1> - -<UL> -<LI> <A HREF="../ncopy/ncopy__option.html"> - OPTION</A> - COPY, SHORTCOPY, OVERVIEW, QUIT -<P> - -<UL><LI>See also <A HREF="../scnnode_comm/scnnode_comm.html">SCNNODE</A> </UL> - - -<UL><LI>General keywords from <A HREF="../scnsets_comm/scnsets_comm.html">SCNSETS</A><UL> -<LI><A HREF="../scnsets__scn_sets/scnsets__scn_sets.html">SCN_SETS</A> -<LI><A HREF="../scnsets__overview/scnsets__overview.html">OVERVIEW</A> -<P></UL></UL> - - -<UL><LI>General keywords from <A HREF="../scnsets_comm/scnsets_comm.html">SCNSETS</A><UL> -<LI><A HREF="../scnsets__scn_groups/scnsets__scn_groups.html">SCN_GROUPS</A> -<LI><A HREF="../scnsets__scn_obss/scnsets__scn_obss.html">SCN_OBSS</A> -<LI><A HREF="../scnsets__scn_fields/scnsets__scn_fields.html">SCN_FIELDS</A> -<LI><A HREF="../scnsets__scn_channels/scnsets__scn_channels.html">SCN_CHANNELS</A> -<LI><A HREF="../scnsets__scn_sectors/scnsets__scn_sectors.html">SCN_SECTORS</A> -<P></UL></UL> - - -<UL><LI>General keywords from <A HREF="../select_comm/select_comm.html">SELECT</A><UL> -<LI><A HREF="../select__ha_range/select__ha_range.html">HA_RANGE</A> -<LI><A HREF="../select__select_ifrs/select__select_ifrs.html">SELECT_IFRS</A> -<P></UL></UL> - -<P><LI> <A HREF="../ncopy/ncopy__scans.html"> - SCANS</A> - First and last scan number from each sector -<LI> <A HREF="../ncopy/ncopy__polarisation.html"> - POLARISATION</A> - XYX, XY, X; [YX] Select polarisations -<LI> <A HREF="../ncopy/ncopy__copy_model.html"> - COPY_MODEL</A> - copy model data? -<LI> <A HREF="../ncopy/ncopy__copy_ifdata.html"> - COPY_IFDATA</A> - copy IF-data/Total Powers? -<P> - -<UL><LI>General keywords from <A HREF="../ngen_comm/ngen_comm.html">NGEN</A><UL> -<LI><A HREF="../ngen__x_log/ngen__x_log.html">X_LOG</A> -<LI><A HREF="../ngen__log/ngen__log.html">LOG</A> -<LI><A HREF="../ngen__x_run/ngen__x_run.html">X_RUN</A> -<LI><A HREF="../ngen__run/ngen__run.html">RUN</A> -<LI><A HREF="../ngen__x_infix/ngen__x_infix.html">X_INFIX</A> -<LI><A HREF="../ngen__infix/ngen__infix.html">INFIX</A> -<LI><A HREF="../ngen__x_datab/ngen__x_datab.html">X_DATAB</A> -<LI><A HREF="../ngen__datab/ngen__datab.html">DATAB</A> -<P></UL></UL> - - -<UL><LI>General keywords from <A HREF="../ngen_comm/ngen_comm.html">NGEN</A><UL> -<LI><A HREF="../ngen__x_memory/ngen__x_memory.html">X_MEMORY</A> -<LI><A HREF="../ngen__memory/ngen__memory.html">MEMORY</A> -<P></UL></UL> - - -<UL><LI>General keywords from <A HREF="../ngen_comm/ngen_comm.html">NGEN</A><UL> -<LI><A HREF="../ngen__x_apply/ngen__x_apply.html">X_APPLY</A> -<LI><A HREF="../ngen__apply/ngen__apply.html">APPLY</A> -<LI><A HREF="../ngen__x_de_apply/ngen__x_de_apply.html">X_DE_APPLY</A> -<LI><A HREF="../ngen__de_apply/ngen__de_apply.html">DE_APPLY</A> -<LI><A HREF="../ngen__x_modelb/ngen__x_modelb.html">X_MODELB</A> -<LI><A HREF="../ngen__modelb/ngen__modelb.html">MODELB</A> -<P></UL></UL> - -</UL> - - - <H3> More information: </H3> <UL> -<LI><A HREF="../homepage.html">NEWSTAR Documentation Home page</A> -<LI><A HREF="../hb_contents/hb_contents.html">The NEWSTAR Cookbook</A> -<LI>Description of <A HREF="../ncopy_descr/ncopy_descr.html">program NCOPY</A> -</UL> diff --git a/hlp/newstar-cookbook.pdf b/hlp/newstar-cookbook.pdf deleted file mode 100644 index ede1244c616d04f5c31ada681d9702799b30f481..0000000000000000000000000000000000000000 Binary files a/hlp/newstar-cookbook.pdf and /dev/null differ diff --git a/hlp/newstar-verheijen.pdf b/hlp/newstar-verheijen.pdf deleted file mode 100644 index 878d65a42bb245597a539146b23dacf17fdd3bcc..0000000000000000000000000000000000000000 Binary files a/hlp/newstar-verheijen.pdf and /dev/null differ diff --git a/hlp/newstar.gif b/hlp/newstar.gif deleted file mode 100644 index 1ffc61be43708d40f4e426ccdbca484821138450..0000000000000000000000000000000000000000 Binary files a/hlp/newstar.gif and /dev/null differ diff --git a/hlp/nfilt/nfilt__freq_select.html b/hlp/nfilt/nfilt__freq_select.html deleted file mode 100644 index 41286c4d1fb227dac1b910090b50f5da1dd1028a..0000000000000000000000000000000000000000 --- a/hlp/nfilt/nfilt__freq_select.html +++ /dev/null @@ -1,19 +0,0 @@ -<TITLE>Description of FREQ_SELECT (NFILT)</TITLE> -<H1>Program NFILT: private keyword FREQ_SELECT</H1> - -<DT><EM>Prompt:</EM> Pairs of frequency (MHz) to select solution domain -<DT><EM>Expected input:</EM> Real number, 16 values.<P> - The actual solution of the continuum radiation will be based on a -subset of the input channels. The channels selected will be based on -pairs of frequencies, indicating a range. -E.g. 325, 327, 330, 332 will use channels with frequnecies in the ranges -325-327 and 330-332 MHz. <P> - * indicates all channels. <P> -Note that the corrections are saved for all selected input frequency sets. - - <H3> More information: </H3> <UL> -<LI><A HREF="../nfilt/nfilt_keys.html">List of keywords</A> for NFILT -<LI><A HREF="../homepage.html">NEWSTAR Documentation Home page</A> -<LI>Description of <A HREF="../nfilt_descr/nfilt_descr.html">program NFILT</A> -<LI>The <A HREF="../common_descr/common_descr.html">DWARF User Interface</A> -</UL> diff --git a/hlp/nfilt/nfilt__option.html b/hlp/nfilt/nfilt__option.html deleted file mode 100644 index 8eda3ce575820091f61dbf0f80a6aedc0bcbc13a..0000000000000000000000000000000000000000 --- a/hlp/nfilt/nfilt__option.html +++ /dev/null @@ -1,24 +0,0 @@ -<TITLE>Description of OPTION (NFILT)</TITLE> -<H1>Program NFILT: private keyword OPTION</H1> - -<DT><EM>Prompt:</EM> CONTINUUM, QUIT Action -<DT><EM>Expected input:</EM> Character(24).<P> -Specify the action to be performed by the program NFILT: <P> -<DT><STRONG> CONTINUUM</STRONG> make a UV-based estimate of the continuum in line data. The - algoritm used fits a polynomial to the sine and cosine - components of the residual corrected data, and stores it as - additive interferometer data. Second order effects could - necessitate an iteration for the cross-polarised channels to - properly cater for polarisation correctioons and Faraday - rotation. - Although the program will handle any combination of input sets, - fastest operation is attained if loops are used to select the - fields. <P> -<DT><STRONG> QUIT:</STRONG> leave the program NSCAN - - <H3> More information: </H3> <UL> -<LI><A HREF="../nfilt/nfilt_keys.html">List of keywords</A> for NFILT -<LI><A HREF="../homepage.html">NEWSTAR Documentation Home page</A> -<LI>Description of <A HREF="../nfilt_descr/nfilt_descr.html">program NFILT</A> -<LI>The <A HREF="../common_descr/common_descr.html">DWARF User Interface</A> -</UL> diff --git a/hlp/nfilt/nfilt__poly_degree.html b/hlp/nfilt/nfilt__poly_degree.html deleted file mode 100644 index e389030eda28ba10fe523d8155f2fa4c4e4b64f1..0000000000000000000000000000000000000000 --- a/hlp/nfilt/nfilt__poly_degree.html +++ /dev/null @@ -1,14 +0,0 @@ -<TITLE>Description of POLY_DEGREE (NFILT)</TITLE> -<H1>Program NFILT: private keyword POLY_DEGREE</H1> - -<DT><EM>Prompt:</EM> Polynomial degree -<DT><EM>Expected input:</EM> Integer number; min.value: 0.000000; max.value: 6.000000.<P> -Specify the degree of the polynomial to solve for: 0=constant; 1=slope -etc. - - <H3> More information: </H3> <UL> -<LI><A HREF="../nfilt/nfilt_keys.html">List of keywords</A> for NFILT -<LI><A HREF="../homepage.html">NEWSTAR Documentation Home page</A> -<LI>Description of <A HREF="../nfilt_descr/nfilt_descr.html">program NFILT</A> -<LI>The <A HREF="../common_descr/common_descr.html">DWARF User Interface</A> -</UL> diff --git a/hlp/nfilt_keys/nfilt_keys.html b/hlp/nfilt_keys/nfilt_keys.html deleted file mode 100644 index 6e2faf008b13e0d5bbbabd9c8cb702b42275e1a1..0000000000000000000000000000000000000000 --- a/hlp/nfilt_keys/nfilt_keys.html +++ /dev/null @@ -1,40 +0,0 @@ -<TITLE>Index of private keywords for NFILT </TITLE> -<H1>Description of keywords for program NFILT</H1> - -<UL> -<LI> <A HREF="../nfilt/nfilt__option.html"> - OPTION</A> - CONTINUUM, QUIT Action -<LI> <A HREF="../nfilt/nfilt__poly_degree.html"> - POLY_DEGREE</A> - Polynomial degree -<LI> <A HREF="../nfilt/nfilt__freq_select.html"> - FREQ_SELECT</A> - Pairs of frequency (MHz) to select solution domain -<P> - -<UL><LI>See also <A HREF="../ngen_comm/ngen_comm.html">NGEN</A> </UL> - - -<UL><LI>See also <A HREF="../scnnode_comm/scnnode_comm.html">SCNNODE</A> </UL> - - -<UL><LI>See also <A HREF="../scnsets_comm/scnsets_comm.html">SCNSETS</A> </UL> - - -<UL><LI>See also <A HREF="../select_comm/select_comm.html">SELECT</A> </UL> - - -<UL><LI>See also <A HREF="../mdlnode_comm/mdlnode_comm.html">MDLNODE</A> </UL> - - -<UL><LI>See also <A HREF="../nmodel_comm/nmodel_comm.html">NMODEL</A> </UL> - -</UL> - - - <H3> More information: </H3> <UL> -<LI><A HREF="../homepage.html">NEWSTAR Documentation Home page</A> -<LI><A HREF="../hb_contents/hb_contents.html">The NEWSTAR Cookbook</A> -<LI>Description of <A HREF="../nfilt_descr/nfilt_descr.html">program NFILT</A> -</UL> diff --git a/hlp/nflag/nflag__flag_option.html b/hlp/nflag/nflag__flag_option.html deleted file mode 100644 index 81a005347181e5fda376f74062561a40d0b73290..0000000000000000000000000000000000000000 --- a/hlp/nflag/nflag__flag_option.html +++ /dev/null @@ -1,22 +0,0 @@ -<TITLE>Description of OPTION (NFLAG)</TITLE> -<H1>Program NFLAG: private keyword OPTION</H1> - -<DT><EM>Prompt:</EM> NFLAG main branch FLAG; SHOW, QUIT -<DT><EM>Expected input:</EM> Character(24).<P> - Specify the nature of the operation you want to perform: <P> - FLAG: Set, clear and/or browse data flags in a .SCN file - and/or browse its data statistics <P> - SHOW: Show/edit data and header information in .SCN - file. This -option - is a clone of the SHOW option in NSCAN and is - available here - for convenience. <P> - QUIT: Terminate NFLAG <P> - - <H3> More information: </H3> <UL> -<LI><A HREF="../nflag/nflag_keys.html">List of keywords</A> for NFLAG -<LI><A HREF="../homepage.html">NEWSTAR Documentation Home page</A> -<LI>Description of <A HREF="../nflag_descr/nflag_descr.html">program NFLAG</A> -<LI>The <A HREF="../common_descr/common_descr.html">DWARF User Interface</A> -</UL> diff --git a/hlp/nflag/nflag__input_file.html b/hlp/nflag/nflag__input_file.html deleted file mode 100644 index 4c63a571bf80f6a73270b7ce8b6b0e3684e1c378..0000000000000000000000000000000000000000 --- a/hlp/nflag/nflag__input_file.html +++ /dev/null @@ -1,14 +0,0 @@ -<TITLE>Description of INPUT_FILE (NFLAG)</TITLE> -<H1>Program NFLAG: private keyword INPUT_FILE</H1> - -<DT><EM>Prompt:</EM> Input .FLF file name (including extension) -<DT><EM>Expected input:</EM> Character(80).<P> - Specify the full name of the input binary-flags file. The -recommended filename extension is .FLF. <P> - - <H3> More information: </H3> <UL> -<LI><A HREF="../nflag/nflag_keys.html">List of keywords</A> for NFLAG -<LI><A HREF="../homepage.html">NEWSTAR Documentation Home page</A> -<LI>Description of <A HREF="../nflag_descr/nflag_descr.html">program NFLAG</A> -<LI>The <A HREF="../common_descr/common_descr.html">DWARF User Interface</A> -</UL> diff --git a/hlp/nflag/nflag__option.html b/hlp/nflag/nflag__option.html deleted file mode 100644 index 8d26ec1be5de7e7327097db3c4f5f43c0b6cce46..0000000000000000000000000000000000000000 --- a/hlp/nflag/nflag__option.html +++ /dev/null @@ -1,24 +0,0 @@ -<TITLE>Description of OPTION (NFLAG)</TITLE> -<H1>Program NFLAG: private keyword OPTION</H1> - -<DT><EM>Prompt:</EM> NFLAG main branch FLAG; SHOW, QUIT -<DT><EM>Expected input:</EM> Character(24).<P> - Specify the nature of the operation you want to perform: <P> - FLAG: Set, clear and/or browse data flags in a .SCN file - and/or browse its data statistics <P> - SHOW: Show/edit data and header information in .SCN - file. This -option - is a clone of the SHOW option in NSCAN and is - available here - for convenience. <P> - QUIT: Terminate NFLAG <P> - - <H3> More information: </H3> <UL> -<LI><A HREF="../nflag/nflag_keys.html">List of keywords</A> for NFLAG -<LI><A HREF="../homepage.html">NEWSTAR Documentation Home page</A> -<LI>Description of <A HREF="../nflag_descr/nflag_descr.html">program -NFLAG</A> -<LI>The <A HREF="../common_descr/common_descr.html">DWARF User -Interface</A> -</UL> diff --git a/hlp/nflag/nflag__output_file.html b/hlp/nflag/nflag__output_file.html deleted file mode 100644 index f7fac09473db599cb015ba628dbd3879399546ee..0000000000000000000000000000000000000000 --- a/hlp/nflag/nflag__output_file.html +++ /dev/null @@ -1,14 +0,0 @@ -<TITLE>Description of OUTPUT_FILE (NFLAG)</TITLE> -<H1>Program NFLAG: private keyword OUTPUT_FILE</H1> - -<DT><EM>Prompt:</EM> Output .FLF file name (including extension) -<DT><EM>Expected input:</EM> Character(80).<P> - Specify the full name for the output binary-flags file. The -recommended filename extension is .FLF. <P> - - <H3> More information: </H3> <UL> -<LI><A HREF="../nflag/nflag_keys.html">List of keywords</A> for NFLAG -<LI><A HREF="../homepage.html">NEWSTAR Documentation Home page</A> -<LI>Description of <A HREF="../nflag_descr/nflag_descr.html">program NFLAG</A> -<LI>The <A HREF="../common_descr/common_descr.html">DWARF User Interface</A> -</UL> diff --git a/hlp/nflag/nflag__sub_cube.html b/hlp/nflag/nflag__sub_cube.html deleted file mode 100644 index 61591e3269d8112babece852865d3ba9928b83c2..0000000000000000000000000000000000000000 --- a/hlp/nflag/nflag__sub_cube.html +++ /dev/null @@ -1,28 +0,0 @@ -<TITLE>Description of SUB_CUBE (NFLAG)</TITLE> -<H1>Program NFLAG: private keyword SUB_CUBE</H1> - -<DT><EM>Prompt:</EM> Type of secondary data cube YES, IFR, POL, HA; NO -<DT><EM>Expected input:</EM> Character(24).<P> - You may define a 'secondary cube' that includes only part of the -primary data cube. The current flagging operation will affect only the cross -section of the primary and secondary cubes. <P> -Unlike the primary cube (which can only be redefined through the FLAG_MODE -parameter), the secondary cube definition applies only to the current operation -and will evaporate when it completes. <P> -Specify here how you want to define the secondary cube. You may give ONE option -at a time; the prompt will reappear until you reply with NO. <P> - YES Polarisations, interferometers and hour-angle range. - IFR Interferometers - POL Polarisations - HA Hour-angle range - NO Accept the current settings -!! Check volatility, interpretation of NO, one at a time and -!! defaulting -! \whichref{}{} - - <H3> More information: </H3> <UL> -<LI><A HREF="../nflag/nflag_keys.html">List of keywords</A> for NFLAG -<LI><A HREF="../homepage.html">NEWSTAR Documentation Home page</A> -<LI>Description of <A HREF="../nflag_descr/nflag_descr.html">program NFLAG</A> -<LI>The <A HREF="../common_descr/common_descr.html">DWARF User Interface</A> -</UL> diff --git a/hlp/nflag_keys/nflag_keys.html b/hlp/nflag_keys/nflag_keys.html deleted file mode 100644 index e69de29bb2d1d6434b8b29ae775ad8c2e48c5391..0000000000000000000000000000000000000000 diff --git a/hlp/nfra_config_management.html b/hlp/nfra_config_management.html deleted file mode 100644 index 932207e7343ec4dd59b3b3e092931d6eb37e09a9..0000000000000000000000000000000000000000 --- a/hlp/nfra_config_management.html +++ /dev/null @@ -1,652 +0,0 @@ -<TITLE>Newstar configuration management at NFRA</TITLE> - -<BR><STRONG>Subject:</STRONG> Newstar configuration management at NFRA -<BR><STRONG>Author:</STRONG> Marco de Vos (CMV) and Henk Vosmeyer (HjV) -<BR><STRONG>To:</STRONG> Newstar Support Team (HjV, CMV, JEN, JPH) -<P> <STRONG>Date:</STRONG> 08/11/94 -<P> -<EM>Revision history</EM> -<UL> -<LI>22/01/96 - Change appendix 3 -<LI>11/11/94 - Add appendix 3 -<LI>08/11/94 - Typo's and minor changes -<LI>02/11/94 - Separation of NFRA-Master and Export-Master -<LI>04/03/94 - First release -<LI>21/02/94 - Prerelease -</UL> - - -<H1>Newstar configuration management at NFRA</H1> -<PRE></PRE> - - -<H2>General concerns</H2> - -The Newstar package is not a static product. Major and minor changes are -often being made to the software. These changes should affect the use of -the package in a positive sense only. Therefore we need to guard the -integrity of the package at NFRA and define clear procedures for external -users on how to upgrade their implementation. This document describes -those procedures. -<P> -This document is limited to configuration management on the Unix systems. -The VAX system will be no longer supported at NFRA from 15/03/94, and -can be maintained through the perl-scripts provided by WNB. -<P> -Reference to Newstar directories are made through the usual variables -$n_src, $n_root etc. Refer to Appendix 2 for the details. -<P> -All commands assume one is logged in as the Newstar Master (newstar). -<PRE></PRE> - -<H2>What makes up the Newstar configuration at NFRA</H2> - -The Newstar configuration at NFRA consists of the following: -<P> -<UL> - <LI><STRONG>The NFRA-Master system</STRONG> on the /newstar disk (below $n_root): - <OL> - <LI>The Master source tree (below $n_src) - <LI>The NFRA library and executable areas ($n_inc, $n_lib, - $n_exe and $n_tst for the various architectures) - <LI>The NFRA documentation area ($n_hlp) - <LI>The NFRA import area (below $n_import) - </OL> - <P> - Below /newstar/master we also have an installation of: (1) mongo (in - /newstar/master/mongo), of (2) perl (in /newstar/master/perl) and - (3) a copy of the sources for the VAX-based Remote Tape Daemon (in - /newstar/master/rmtd). - <P> - This is a working system, used by NFRA users and programmers. - <P> - <LI><STRONG>The Export-Master system</STRONG> on the /users disk of ftp.astron.nl: - <OL> - <LI>The Export Master source tree (below $n_src) - <LI>The Server version of the documentation (below $n_www) - <UL> - <LI>server homepage $n_www/homepage.html - <LI>documentation relevant to the Export Master source tree - $n_www/hlp/ - <LI>user feedback system $n_www/bug/ - <LI>link to mail area $n_www/mail/ - </UL> - <LI>Some server programs for ftp.astron.nl (below /users/newstar) - <LI>The import area for sites outside NFRA (/users/ftp/newstar/import) - </OL> - <P> - This is a sources-only system which is never compiled. - The Export Master source tree and the documentation are kept - up-to-date from the NFRA Master system. - <P> - <LI><STRONG>The Newstar account</STRONG> on the NFRA Unix system (~newstar) - <OL> - <LI>Startup files for the newstar account (.cshrc and .login etc.). These - files should not contain commands that are essential for the - functioning of newstar apart from PATH settings and - the startup command: -<PRE> -# -# Initialise Newstar (either NFRA-Master or Export-Master) -# -if (-e /newstar/master/src/sys/newstar_nfra.csh) then - source /newstar/master/src/sys/newstar_nfra.csh -else if (-e /users/newstar/bin/newstar_init.csh) then - source /users/newstar/bin/newstar_init.csh -endif -</PRE> - - <LI>Mail environment (~/Mail and ~/.elm). The elm - alias friends_of_newstar is used to inform on updates. The Newstar - environment variable $n_master points to this eMail account. - <LI>Server interface (~/server). This directory is used to pass commands - to the server programs on ftp.astron.nl - </OL> - <P> - This account is the owner of the NFRA-Master and the Export-Master, and - is the only account that can modify them (apart from $n_import and the - locking database). -</UL> -<PRE></PRE> - -<H2>Relations between NFRA-Master and Export-Master</H2> - -The dynamic relations between Master systems (either the NFRA Master or -another one) and Export-Master are as follows: -<PRE> -+----------------------------------------------------------------------+ -| Master: | -| $n_src <--------+ | -| | | nup build -U (in $n_import) | -| | nup build -U | | -| v | | -| $n_exe, ... <--------+ | -| | | -| $n_import -->--------+ | -| | ^ ^^ | -| | | || | -| | | || (NFRA only) | -| | | |+--------------------+--<-- nsh in | -| | | | | | -+----------------------------------------------------------------------+ -| Export-Master: | | | | | -| | | | nup retrieve ... | (NFRA and others) | -| | | | (NFRA only) | | -| nup release | | | | | -| | | nup retrieve | | -| v | | | | -| $n_src | | | -| $n_import <------------------+ | -| | -+----------------------------------------------------------------------+ -</PRE> -Use of the "<TT>nup release</TT>" command is restricted to the NFRA-Master. -Master systems outside NFRA use the "<TT>nup retrieve</TT>" command to get -updated files from the Export-Master. The "<TT>nup update</TT>" command -combines "<TT>nup retrieve</TT>" and "<TT>nup build -U</TT>". -<BR>The NFRA-Master uses the "<TT>nup retrieve -import ...</TT>" to get -files from the Export-Master's $n_import (files checked in by -programmers outside the NFRA). -<PRE></PRE> - -<H2>Definition of revisions and releases</H2> - -Every modification of files in the Master source tree results in a new -<EM>revision</EM>, even if the modification does not involve changes in the -executables. The procedure for merging modifications in the Master source -tree is described in the next section. -<P> -A <EM>release</EM> is defined as a revision which involves one or more of the -following items: -<OL> - <LI>A change of fileformats, so you will have to use the - NVS (New Version) option in some programs - <LI>A change in keyword syntax (so you will have to type different - things or change batch files in some cases) other than an - additional keyword for which the default can be used. - <LI>Addition of a new program, or a major rewrite of an existing one. -</OL> -The issue of a new release has to be decided upon by at least two members -of the Newstar Project Team. -<P> -The updating of revision numbers is taken care of by the update script. -Releases need to be explicitly indicated. The procedure for this is -described in a later section. -<P> -The version number of the current Newstar configuration is given -by the file $n_src/sys/version.idx -<P> -A full description of the current Newstar configuration is given by -the file $n_src/sys/database.idx after the command "<TT>nup check d</TT>" -<P> -A user-oriented decription of the configuration is given in the -file $n_src/doc/nnews.hlp which is shown by the command "<TT>nnews</TT>" -<P> -The version number of the Newstar executables is given by the -command -<BR>"<TT>what $n_exe/*.exe | grep %NST%</TT>" -<P> -<PRE></PRE> - -<H2>Checking-in modified files</H2> - -When programmers (in or outside the NFRA) want to make a change in files -in their Master source tree they have to use the "<TT>nsh in</TT>" command. -This will ask (among other things) for a list of files to be checked in, for -a comment and for the executables to be rebuilt (seprated by blanks). -<P> -When programmers check in their modified files, these files are copied -into their local $n_import directory, together with a groupfile listing -the files and executables. The same files are copied into the $n_import -directory of the Export-Master. If the "<TT>nsh in</TT>" command is issued for -(modified) files in a Master tree (presumably outside the NFRA), these -files are not copied to the local $n_import. They are copied into the -Export-Master. In all cases, a mail message describing the check-in is -sent to $n_master (currently newstar@astron.nl). -<P> -Testing should be completed before check-in! At the NFRA, an executable -and/or ppd-file supplied by a programmer can at request be copied into -$n_tst for testing by a broader user-group. -<PRE></PRE> - - -<H2>Merging modifications into the NFRA-Master source tree</H2> - -When mail concerning a check-in is received, the following actions -should be taken: -<P> - -<EM> 1e. If files originate from outside the NFRA, they should be - received in $n_import of the NFRA-Master (more than one - groupfile can be handled with a single update command):</EM> -<PRE> - >>> nup retrieve -import updxxx.grp -</PRE> -<STRONG>Any file that has to be ftp'd with binary mode has to be retrieved -separately.</STRONG> -<P> -<EM> 2e. Perform some elementary checks: </EM> -<P> -If psc/pin/pef-files are changed, they should be checked against -changes in keywords. If the meaning of existing keywords have been -changed, the revision should be treated as a release (see the previous -section). -<P> -If keywords have been removed from a psc file, it should be checked wether -they have been removed from the programs as well. In such cases, special -care should be taken that executables are being rebuilt synchroneously -with the ppd-files. In general, removal of keywords is discouraged for -revisions. -<P> -NOTE: The synchronisation of exe/ppd files is not optimal in the present - structure for configuration management, but cannot be improved - without structural changes in the coupling of exe and ppd files. -<P> -<EM> 3e. Update libraries and executables for all architectures:</EM> -<PRE> - >>> nup build -Update updxxx.grp (on rzmws0) - >>> nup build -Update updxxx.grp (on rzmws5) -</PRE> - -Any errors reported by the build command should be reported to -and repaired by the programmer. -<P> -<EM> 4e. At successful compilation, merge the files in the source tree:</EM> -<PRE> - >>> nup build -Update -T:none -Merge updxxx.grp (on rzmws0) -</PRE> - -The revision number will be automatically updated in version.idx. -<P> -The subject from the groupfile(s) is copied in the nnews.hlp file, and a -message to be sent to local Friends of Newstar is composed (so enter -useful information). Both files will -be presented in the MicroEmacs editor (change buffers with ^X X command, -exit with Esc Z). -Comments concerning programmers only should be removed from nnews.hlp, or -be prefixed by "System: ". This checking of nnews.hlp is very important -since most users rely on this file for their information on changes. -The message is kept in $n_import/message.RR.rr where RR is the new Release, -rr the new revision of Newstar. -<P> -The message is not yet sent, this is done after the Export-Master has been -updated. -<BR>This is done with the "<TT>nup release</TT>" command, discussed later. -A mail is sent to $n_master to remind you of this revision after three days. -<PRE></PRE> - -<H2>Special procedure in case a groupfile needs to be deleted</H2> - -If a groupfile needs to be removed from the Master, it should be explicitly -deleted using a command like -<BR>"<TT>rm $n_src/xxx/yyy.grp</TT>" followed by a reconstruction of the -database with "<TT>nup check d</TT>". -<P> -At remote sides, the groupfile will be deleted automatically after the -next update. -<PRE></PRE> - - -<H2>Special procedure for new releases</H2> - -If a modification is to be interpreted as a release, the following -special actions need to be taken: -<OL> - <LI>Check out file $n_src/sys/version.idx - <LI>Increase the release number by hand, set the revision number to 1 - <LI>Check in file $n_src/sys/version.idx - <UL> - <LI>The comment should clearly indicate the new release - <LI>When asked for the executables to be rebuilt, answer: @all - </UL> - <LI>Update the resulting groupfile in the master: - <UL> - <LI>Nnews should clearly reflect the new release - <LI>The mail message has to be edited to mention the release explicitly - </UL> - <LI>The file $n_root/updates.html should be edited - to reflect the new release. An example how to do this should be - taken from header of the previous release. It should be decided - wether the old revision history should still be kept in this file. - If not, the revision information should be replaced by the remark -<PRE> - <EM>Revision history not recorded</EM><P> -</PRE> - The description of previous releases should not be removed. - Add a hypertext link to this release at the beginning of the file. -</OL> -<PRE></PRE> - -<H2>Merging changes into the Export-Master</H2> - -After the changes have been active in Dwingeloo, they have to be made -known to the outside world. This is typically done after three days (to -remind you, the above mentioned at-job is scheduled). -<P> -The procedure to update the Export-Master is as follows: -<P> -<PRE> - >>> telnet wsrt00 - >>> setenv n_remote rzmws0.astron.nl newstar /newstar/master/src - >>> nup update -</PRE> -This will try to update the Westerbork installation from the NFRA-master. -Any errors occurring here will almost certainly occur in other installtions -as well, so they need to be repaired before the next step. Should you choose -to make changes directly in the NFRA-Master, issue the following command -<STRONG>at rzmws0</STRONG> before trying to update wsrt00 again: -<PRE> - >>> nup check d -</PRE> -This will make a fresh version of the database. Once installation on wsrt00 -is successfull, give the following command <STRONG>at rzmws0</STRONG>: -<PRE> - >>> nup release -</PRE> -This will rebuild the documentation, create a fresh database, pack -all sources, libraries and executables and send them over to the -Export-Master. It also tells the server program that files are waiting -to be unpacked. Once this has been done, the message will be sent. In -case more than one release has been pending, a fresh message for the -most recent revision will be composed, containing all the subjects -from previous revisions. The message will be sent to the Friends of Newstar. -This relies on an elm alias friends_of_newstar. -<PRE></PRE> - -<H2>Maintenance of server programs for the Export-Master</H2> - -The server programs for the Export-Master are maintained outside the -normal Newstar routine. All sources (programs, scripts and text-files) -have to be in /users/newstar/src/. They have to be compiled or put in -their proper place by executing the "<TT>make</TT>" command in that directory. -A "<TT>make</TT>" should be done after any change in files in /users/newstar/src. -Refer to file /users/newstar/src/Makefile for details about requirements -for server programs. -<PRE></PRE> - -<H2>Maintenance of the locking database</H2> - -The locking database is there mainly for administrative purposes. -It warns users who check out a locked file, but still makes a copy for them. -However, it will prohibit checking in locked files. Since users sometimes -just delete files without unlocking them, the lock-file will get polluted. -Therefore the weekly routine includes cleaning up of this file. -<PRE></PRE> - - -<H2>Weekly routines for the Newstar Master copy at NFRA</H2> - -Backups are made each Thursday afternoon or Friday morning. The procedure -for backups is: -<PRE> - >>> nup check d -</PRE> -This will build a fresh version of file database.idx -The database will be updated for any direct changes in the Master (that is: -without proper checkin through $n_import). -<PRE> - >>> nup save -</PRE> -This will make a backup of the entire master tree (all files below $n_root). -Three DAT tapes are used for the backups (cyclic use of Newstar_A, Newstar_B -and Newstar_C). The save command will run in the background and notify -by mail when it is ready. -<P> -The two most recent backups are stored at the Bank of Dwingeloo. -Backups of the Export-Master are made as part of the Scissor backup -routine. -<P> - -After the backup, the following command should be entered: -<PRE> - >>> rm $n_exe/*.old $n_tst/*.old -</PRE> -This will throw away old versions, which can be restored from the backup -tape if necessary. -<PRE> - >>> nup clear -Confirm -</PRE> -This will remove any obsolete files from the Master copy. See above for -the deletion of obsolete groupfiles. Removing a file from a groupfile will -cause a prompt for deletion here. In such cases, check wether the file -has become really obsolete (e.g. by using a grep on the subroutine name). -If the file has been accidentally removed from a groupfile, check out -the groupfile, re-insert the file, check-in the groupfile and make a -maintenance revision. -<PRE> - >>> nup check l (on rzmws0) - >>> nup check l (on rzmws5) -</PRE> -This will check the current libraries. If faults are reported, the -libraries should be updated through the groupfile produced by the -check command (instructions are given by the command). The name of -the groupfile will be libyymmdd${n_arch}.grp. -<PRE></PRE> - - -<H2>Appendix 1: Terminology</H2> - -<DL> -<DT> Site:<DD> - on or more computers that share a (Network) File System - -<DT> Master-systeem:<DD> - the officially installed Newstar version on a site - -<DT> NFRA-Master:<DD> - the master system at the Unix network of the NFRA, - -<DT> Export-Master:<DD> - the (sources-only) master system at the Unix network - of the NFRA, distribution is done from this master. - -<DT> User-systeem:<DD> - a (partial) version of Newstar that is made by a user/ - programmer based on the Master-system. When starting - an executable, a version in the user-system has priority - over the Master. - -<DT> Binary-tree:<DD> - a directory tree in a Master or User system containing - the executable files needed to run Newstar (NB: you - also need the startup scripts in $n_src/sys). - -<DT> Source-tree:<DD> - a directory tree in a Master or User system containing - only all files needed to install a binary tree - (excluding the operating system and compilers...). - -<DT> Library-tree:<DD> - a directory tree in a Master or User system with libraries - and (for a User system) object files; one directory in the - library tree contains include files and system independent - pre-processed files, all derived from the source tree. - -<DT> Work-directory:<DD> - a directory for temporary files, for listingss and for - files needed for the debugger. -</DL> -<P> -The Master system has two binary trees: -<UL> - <LI>$n_root/exe No debugging information. - <LI>$n_root/tst Can be used for debugging, will usually be empty. -</UL> -<P> -Executable files are looked for in the current directory first, then -in $n_uexe (if it exists) and finally in $n_exe. -<P> -A user may decide to do "<TT>setenv n_uexe $n_tst</TT>" to get access to test versions, -and programmers will set $n_uexe to the binary tree of their user system. -<PRE></PRE> - -<H2>Appendix 2: Directory trees</H2> - -<PRE> -Master (NFRA or elsewhere): ---------------------------- - -$n_root -+-- src = $n_src Source tree - | - +-- lib -+-- inc = $n_inc Precompiled files - | +-- sun = $n_lib Object libraries - | +-- hp - | - +-- exe -+-- sun = $n_exe Executables and ppd-files - | +-- hp - | | - | +-- html = $n_hlp Hypertext help files (elsewhere) - | - +-- hlp = $n_hlp Hypertext help files (at NFRA) - | - +-- tst -+-- sun = $n_tst Test versions - | +-- hp - | - +-- work -+-- sun = $n_work Intermediate files, files - | +-- hp necessary for debugging - | - +-- import = $n_import Import area for uploading of - revisions and programmers files. - -Sites outside NFRA can have other architectures in $n_lib and $n_exe. -At most sites outside NFRA $n_hlp is a subdirectory of $n_root/exe. - -This structure can be split over various filesystems. The tree can than -be realised through symbolic links. Since all system commands use the -environment variables this is not strictly necessary. - -Additional directories at NFRA only: - - | - +-- mongo Installation of mongo - +-- perl Executables for perl - +-- rmtd Sources for rmtd (VAX) - -Possible files in $n_root: backups.txt Log of backups - updates.log Log of update-commands - updates.html Revision history (NFRA only) - -Source tree: - - $n_src -+-- sys Maintenance system - | - +-- doc -+- ... Documents - | - +-- wng Precompiler, files, I/O etc. - +-- dwarf Parameter interface - +-- n* The various programs - | - +-- data Calibrator models - | - +-- batch Standard batch procedures - -Possible files in $n_src: upd*.log Compilation logs - - -User system: ------------- - -~programmer +... $n_uroot -+-- lib -+-- inc = $n_uinc - : | +-- sun = $n_ulib - : | - +-- exe -+-- sun = $n_uexe - | - +-- work = $n_work - | - [ +-- src = $n_usrc ] - : - +... Arbitrary directories with files - modified by the programmer. - - -Logging in as the owner of $n_root (Newstar manager) causes $n_u... -to point to $n_..., $n_work will point to $n_root/work/$n_arch. -If the Newstar manager uses the -NUpdate switch for update, $n_uexe -will be set to $n_tst, else it will be at $n_exe. - -It is confusing that there is no $n_uwork, this departure from the -general practice may be removed in future. - - -Export Master (NFRA only, at ftp.astron.nl): ------------------------------------------- - -/users/ftp/newstar = $n_root Newstar ftp area -/users/www/newstar = $n_www Newstar www area -/users/newstar Newstar server programs - -$n_root -+-- src = $n_src Source tree - | - +-- import = $n_import Import area for uploading of - revisions and programmers files - (also from non-NFRA sites). - -Files in $n_root: - nstar_src.tar.Z Archive with sources - nstar_src_??.tar Archive with additional sources - for various architectures - nstar_hlp.tar.Z Archive with documentation - nstar_exe_??.tar.Z Archive with executables for - various architectures - nstar_lib_??.tar.Z Archive with libraries for - various architectures - nstar_lib_inc.tar.Z Archive with include files - - - -$n_www -+-- hlp Documentation (from nstar_hlp.tar) - | - +-- bug User Feedback System - | - +-- bin = $n_cgi httpd scripts for Newstar - | (sources in /users/newstar/src) - | - +-- mail Link to Newstar mail area for HjV - -Files in $n_www: - homepage.html Homepage for the server area, - different from hlp/homepage.html - index.html Link to homepage.html, you get this - for http://www.astron.nl/newstar/ - example.* Some sample images - updates.html Revision history (from NFRA master) - - -/users/newstar -+-- src Server programs (sources) - +-- bin = $n_bin Server programs (executables) - -</PRE> -<PRE></PRE> - -<H2>Appendix 3: Other programs and procedures related to Newstar</H2> - -<H3>Mails concerning Newstar</H3> - -A copy of all E-mail correspondention between the different members of the -Newstar group should always be send to HjV (hjvosmeijer@astron.nl). He will -extract those documents and put them in his Newstar mail directory -(~hjv/public_html/newstar/mail). A printed version of the documents will be put in -a special binder which will be kept in HjV's room. -<BR>Every working-day at 07.00 AM a script will create an updated HTML -file (<A HREF=http://www.astron.nl/~hjv/newstar/mail.html>mail.html</A>) -which gives everyone the possibility to read the mails and search for -keywords using Mosaic. - - - -<H3>Newstar use</H3> - -On every site where Newstar is installed, the programs will write an -entry (with username, programname, date a.s.o.) in the file -$n_import/newstar.use. During an update of a site, this file is ftp'ed -to NFRA (/users/ftp/pub/incoming) and a new (empty) version is -created on the updating site. -<BR>At NFRA every working-day at 07.00 AM a script will take care for -moving those new files to ~hjv/newstar/use, compressing the files and -merge them with the already existing files per site, create quarterly -and monthly reports. The script will also update an HTML file -(<A HREF=http://www.astron.nl/~hjv/newstar/use.html>use.html</A>) -which which gives everyone the possibility to view those reports -by using Mosaic. - - diff --git a/hlp/ngcalc/ngcalc__action.html b/hlp/ngcalc/ngcalc__action.html deleted file mode 100644 index e69de29bb2d1d6434b8b29ae775ad8c2e48c5391..0000000000000000000000000000000000000000 diff --git a/hlp/ngcalc_keys/ngcalc_keys.html b/hlp/ngcalc_keys/ngcalc_keys.html deleted file mode 100644 index e69de29bb2d1d6434b8b29ae775ad8c2e48c5391..0000000000000000000000000000000000000000 diff --git a/hlp/ngcalc_lightcurve.txt b/hlp/ngcalc_lightcurve.txt deleted file mode 100644 index a9e08acfe33de90ab86cf5f1616b96082ba049f6..0000000000000000000000000000000000000000 --- a/hlp/ngcalc_lightcurve.txt +++ /dev/null @@ -1,112 +0,0 @@ -I,Q,U,V,p,angle lightcurves using NEWSTAR program NGCALC - - -Ger de Bruyn 15-juni-1994 - -The program NGCALC can extract 1-dimensional (Visibility data versus -time/HA) data from a SCN-file. These can then be processed to yield -lightcurves of all Stokes parameters for a range of baselines. - -A 'typical' run would go as follows: - -1) exe ngcalc/ask - -The /ask qualifier is only required if you wish to subtract the STORED -selfcal MDL from the selfcal'ed visibility data. - -Input: - - the name of the NGF file you wish to create - - select option EXTRACT - - specify the name of the SCN-file - - select the SETS - - select the type of information you want to process (e.g. DATA) - - select the polarizations (specify XYX if you wish to form all - Stokes parameters) - - select the INTERFEROMETERS (e.g. FM) - -This is a slow program! It takes about 20 minutes CPU (on an HP710) -for the extraction of 12 hours of data (720 scans of 1 minute) on 40 -baselines on one frequncy channel for each of the four XX,XY,YX,YY -correlations. This then creates 40x4 files or 'plots' as they are called in -the program. - -These plots will have a six-digit number containing information on the -baselines, polarizations and frequency channel. - -2) Use the option MERGE to merge different HA-sections - -If the 12 hour observations was cut into more than one part, each -HA-sector will get a separate file. You can then merge these two or -more HA-slots into one file, where the appropriate HA information is -preserved. - -You can use a double-loop here. One loop might run over polarization -and one loop over baselines; e.g. 4,...1, 69,....1 if you had -XX,XY,YX,YY and baselines from 9A (a 0 in the fifth digit) through 0D -(a 68 in the fifth digit) - - -3) Use option CALC, SHIFT to shift the visibilities to the source you -wish to study - -Use the position (l,m in arcseconds) as given in your MODEL. You may -(have to) use a loop again. - - -4) Use the option MERGE to average all baselines you wish to use - -After the shift operation the source should be in the phase centre. This -means that the source signal is contained in the COS part of the visibility. -You can check, using the plotting facilities, whether indeed the SIN signal -is consistent with noise around zero. - -You may wish to loop here over the fourth, polarization, index (e.g. -4,...1) - - -5) Use the COMBINE option to form Stokes I,Q,U and V - -Examples: -Q = (#0-#1)/2, where #0 is the YY file and #1 is the XX file. -V = -0.5*imul(#0+#1) where #0 is the XY file and #1 is the YX file - - -6) If required, smooth the data using option CALC, SMOOTH - - -7) You can use the PLOT option at the various stages to see whether the -results look as 'expected' - -8) Use option MON to dump the interesting files in an ASCII file for -further processing with SUPERMONGO. The mongo file will contain as its first -column the HA. - - - ------------------------------------------------------------ -N.B. There are a number of things to watch out for when using NGCALC - -1) Files can be addressed with the full six-digit index or with a # whichever -you find more convenient. Note, however, that when using the #'s you can -NOT use loops. - -2) There is some logic to the index numbering system but it takes a while to -get use to it. - -3) When trying to form the polarization angle 0.5*atan(U/Q) you run into -the problem that this angle as calculated will be within the range -45 to -+45 degrees, while of course the true polarization angle is defined -within boundaries -90 and +90 degrees - -4) Unfortunately, the delete option does not yet work. If you have made a -new file with erroneous specifications you would ideally like to -throw it away because you might forget that it is unusable. - -5) When using the loop system all the plotfiles that will be -tried in the looping must be present. - -E.g. if you have 40 FM baselines in the NGF file they are numbered 0,2,8,9,....68 -with some numbers not occurring (This number is the order in which the -baselines exist in the SCN file). Hence, if you wish to loop over baselines -then you could say 69,....1 but then the program will stop after it has -done the first baseline, because baseline ....1 does not exist. diff --git a/hlp/ngen/ngen__log.html b/hlp/ngen/ngen__log.html deleted file mode 100644 index e69de29bb2d1d6434b8b29ae775ad8c2e48c5391..0000000000000000000000000000000000000000 diff --git a/hlp/ngen/ngen__x_log.html b/hlp/ngen/ngen__x_log.html deleted file mode 100644 index 0bd3e26aec81790d20afaceee92556d2a005f88c..0000000000000000000000000000000000000000 --- a/hlp/ngen/ngen__x_log.html +++ /dev/null @@ -1,12 +0,0 @@ -<TITLE>Description of X_LOG (NGEN)</TITLE> -<H1>Description of general keyword X_LOG</H1> - -<DT><EM>Prompt:</EM> SPOOL, YES, NO, CATEN -<DT><EM>Default:</EM> # /NOASK. -<DT><EM>Expected input:</EM> Character(8).<P> - - <H3> More information: </H3> <UL> -<LI><A HREF="../ngen/ngen_comm.html">List of general keywords</A> for NGEN -<LI><A HREF="../homepage.html">NEWSTAR Documentation Home page</A> -<LI>The <A HREF="../common_descr/common_descr.html">DWARF User Interface</A> -</UL> diff --git a/hlp/ngen_comm/ngen_comm.html b/hlp/ngen_comm/ngen_comm.html deleted file mode 100644 index e69de29bb2d1d6434b8b29ae775ad8c2e48c5391..0000000000000000000000000000000000000000 diff --git a/hlp/ngen_keys/ngen_keys.html b/hlp/ngen_keys/ngen_keys.html deleted file mode 100644 index 8297d2088870645346f01390c2b7482bd547c5a4..0000000000000000000000000000000000000000 --- a/hlp/ngen_keys/ngen_keys.html +++ /dev/null @@ -1,15 +0,0 @@ -<TITLE>Index of private keywords for NGEN </TITLE> -<H1>Description of keywords for program NGEN</H1> - -<UL> - -<UL><LI>See also <A HREF="../ngen_comm/ngen_comm.html">NGEN</A> </UL> - -</UL> - - - <H3> More information: </H3> <UL> -<LI><A HREF="../homepage.html">NEWSTAR Documentation Home page</A> -<LI><A HREF="../hb_contents/hb_contents.html">The NEWSTAR Cookbook</A> -<LI>Description of <A HREF="../ngen_descr/ngen_descr.html">program NGEN</A> -</UL> diff --git a/hlp/ngfsets/ngfsets__ngf_sets.html b/hlp/ngfsets/ngfsets__ngf_sets.html deleted file mode 100644 index e69de29bb2d1d6434b8b29ae775ad8c2e48c5391..0000000000000000000000000000000000000000 diff --git a/hlp/ngfsets_comm/ngfsets_comm.html b/hlp/ngfsets_comm/ngfsets_comm.html deleted file mode 100644 index e69de29bb2d1d6434b8b29ae775ad8c2e48c5391..0000000000000000000000000000000000000000 diff --git a/hlp/ngids/ngids__option.html b/hlp/ngids/ngids__option.html deleted file mode 100644 index e69de29bb2d1d6434b8b29ae775ad8c2e48c5391..0000000000000000000000000000000000000000 diff --git a/hlp/ngids_keys/ngids_keys.html b/hlp/ngids_keys/ngids_keys.html deleted file mode 100644 index e69de29bb2d1d6434b8b29ae775ad8c2e48c5391..0000000000000000000000000000000000000000 diff --git a/hlp/nmap/nmap__fiddle_option.html b/hlp/nmap/nmap__fiddle_option.html deleted file mode 100644 index e69de29bb2d1d6434b8b29ae775ad8c2e48c5391..0000000000000000000000000000000000000000 diff --git a/hlp/nmap/nmap__memory_use.html b/hlp/nmap/nmap__memory_use.html deleted file mode 100644 index eea0f17900f395f4f40d1b6bb3295793214ca119..0000000000000000000000000000000000000000 --- a/hlp/nmap/nmap__memory_use.html +++ /dev/null @@ -1,14 +0,0 @@ -<TITLE>Description of MEMORY_USE (NMAP)</TITLE> -<H1>Description of general keyword MEMORY_USE</H1> - -<DT><EM>Prompt:</EM> Work memory size -<DT><EM>Default:</EM> 200000 /NOASK. -<DT><EM>Expected input:</EM> Integer number; min.value: 20000.000000; max.value: 4000000.000000.<P> -Specify an approximate value for the work memory size to be used in the -transform (bytes). <P> - - <H3> More information: </H3> <UL> -<LI><A HREF="../nmap/nmap_comm.html">List of general keywords</A> for NMAP -<LI><A HREF="../homepage.html">NEWSTAR Documentation Home page</A> -<LI>The <A HREF="../common_descr/common_descr.html">DWARF User Interface</A> -</UL> diff --git a/hlp/nmap/nmap__option.html b/hlp/nmap/nmap__option.html deleted file mode 100644 index 63979d36c3f77b17842b8682567bde45d36b257f..0000000000000000000000000000000000000000 --- a/hlp/nmap/nmap__option.html +++ /dev/null @@ -1,31 +0,0 @@ -<TITLE>Description of OPTION (NMAP)</TITLE> -<H1>Program NMAP: private keyword OPTION</H1> - -<DT><EM>Prompt:</EM> Action| MAKE, FIDDLE; W16FITS, W32FITS, WRLFITS, RFITS; SHOW; QUIT;|-[FROM_OLD, TO_OLD, CVX, NVS] -<DT><EM>Expected input:</EM> Character(8).<P> -Specify action to perform: <P> - Primary operations: - MAKE make map(s) from visibility data in .SCN file - FIDDLE combine or change maps in .WMP file <P> - FITS conversions: - W16FITS write FITS tape/disk with 16 bits data - W32FITS write FITS tape/disk with 32 bits data - WRLFITS write FITS tape/disk with 32 bits float data - RFITS read FITS tape/disk data <P> - Miscellaneous: - SHOW show/edit map data - QUIT finish <P> - Format conversions: - CVX convert a map file from other machine's format to local - machine's - NVS convert a map file to newest version. Needs to be run only if - indicated by program - FROM_OLD convert from R-series format - TO_OLD convert to R-series format <P> - - <H3> More information: </H3> <UL> -<LI><A HREF="../nmap/nmap_keys.html">List of keywords</A> for NMAP -<LI><A HREF="../homepage.html">NEWSTAR Documentation Home page</A> -<LI>Description of <A HREF="../nmap_descr/nmap_descr.html">program NMAP</A> -<LI>The <A HREF="../common_descr/common_descr.html">DWARF User Interface</A> -</UL> diff --git a/hlp/nmap/nmap__qmaps.html b/hlp/nmap/nmap__qmaps.html deleted file mode 100644 index b29cca66496ff84de9af5de4c9084ef6752a1841..0000000000000000000000000000000000000000 --- a/hlp/nmap/nmap__qmaps.html +++ /dev/null @@ -1,18 +0,0 @@ -<TITLE>Description of QMAPS (NMAP)</TITLE> -<H1>Description of general keyword QMAPS</H1> - -<DT><EM>Prompt:</EM> UV taper/convolution details? -<DT><EM>Default:</EM> NO. -<DT><EM>Expected input:</EM> Logical.<P> -The standard defaults used for the taper and convolution functions in the -map-making process will produce maps of excellent quality for normal -applications at an acceptable expense of computing resources. <P> -There may be particular situations, however, where a non-standard taper and/or -convolution function is more suitable. Answer YES if you want to make your own -selection out of the possible options. <P> - - <H3> More information: </H3> <UL> -<LI><A HREF="../nmap/nmap_comm.html">List of general keywords</A> for NMAP -<LI><A HREF="../homepage.html">NEWSTAR Documentation Home page</A> -<LI>The <A HREF="../common_descr/common_descr.html">DWARF User Interface</A> -</UL> diff --git a/hlp/nmap/nmap__uniform.html b/hlp/nmap/nmap__uniform.html deleted file mode 100644 index 0388a9ff0aecc5879a2cd561d9403505fe124cf7..0000000000000000000000000000000000000000 --- a/hlp/nmap/nmap__uniform.html +++ /dev/null @@ -1,29 +0,0 @@ -<TITLE>Description of UNIFORM (NMAP)</TITLE> -<H1>Description of general keyword UNIFORM</H1> - -<DT><EM>Prompt:</EM> NATURAL, STANDARD, FULL Measure function for UV coverage -<DT><EM>Expected input:</EM> Character(8).<P> -Specify the way the UV coverage should be determined: <P> - STANDARD: Weigh each observed point with the track length it covers in - the UV plane, and average sets of redundant baselines. This - method accounts properly for the fact that the density of - measured points is inversely proportional to the baseline, - for the multiplicity of redundant baselines and for - variations in integration times. <P> - FULL: Weigh each point according to the actual UV point density. In - this case care is also taken of all local UV plane density - enhancements, e.g. because there is overlap between - observations. <P> - NATURAL: Take each individual measured point separately, without - weighing for the UV track covered by it. This option gives - the maximum possible signal/noise ratio in your map, but it - generally weighs the short baselines much too heavily which - results in a very fat synthesized beam. <P> -Of these options, FULL gives the cleanest synthesized beam, but it is slower -because it necessitates an extra read pass over the .SCN-file data. <P> - - <H3> More information: </H3> <UL> -<LI><A HREF="../nmap/nmap_comm.html">List of general keywords</A> for NMAP -<LI><A HREF="../homepage.html">NEWSTAR Documentation Home page</A> -<LI>The <A HREF="../common_descr/common_descr.html">DWARF User Interface</A> -</UL> diff --git a/hlp/nmap_comm/nmap_comm.html b/hlp/nmap_comm/nmap_comm.html deleted file mode 100644 index e69de29bb2d1d6434b8b29ae775ad8c2e48c5391..0000000000000000000000000000000000000000 diff --git a/hlp/nmap_keys/nmap_keys.html b/hlp/nmap_keys/nmap_keys.html deleted file mode 100644 index e69de29bb2d1d6434b8b29ae775ad8c2e48c5391..0000000000000000000000000000000000000000 diff --git a/hlp/nmodel/nmodel__action.html b/hlp/nmodel/nmodel__action.html deleted file mode 100644 index d2ff6f36173fb3a1abf6d7bfe8a403c22d7730de..0000000000000000000000000000000000000000 --- a/hlp/nmodel/nmodel__action.html +++ /dev/null @@ -1,43 +0,0 @@ -<TITLE>Description of ACTION (NMODEL)</TITLE> -<H1>Program NMODEL: private keyword ACTION</H1> - -<DT><EM>Prompt:</EM> Action HELP, HANDLE; SAVE, GET; FIND, UPDATE; |-CONVERT, EDIT, REDIT, FEDIT , BEAM, DEBEAM; FROM_OLD, TO_OLD, NVS, CVXL; QUIT| -<DT><EM>Expected input:</EM> Character(24).<P> - Specify action to perform: <P> - General: <P> - HELP show some explanation on model lists - HANDLE select general model-handling branch <P> - Model construction: <P> - FIND find sources in map (.WMP file) - UPDATE update sources by comparison with visibilities (.SCN file) <P> - Transfer of model to/from .SCN file: <P> - SAVE save model data in .SCN file - GET get model from .SCN file <P> - Wholescale conversions of model list: <P> - CONVERT Convert model list from epoch to epoch or coordinate to - coordinate with conversion of l, m coordinates and intensities - if necessary - EDIT Change model-list overall parameters without conversion of - coordinates and intensity (except possible field rotation if - converting from apparant <-> epoch) - REDIT Change reference coordinates and frequency. Intensities will - be corrected for spectral index only. - FEDIT As REDIT, but intensities will also be corrected for the - effect of different beams at different frequencies -!! Primary or synthesised? - BEAM Correct sources for attenuation by primary beam - DEBEAM Apply primary-beam attenuation to sources <P> - Utilities: <P> - FROM_OLD convert old format source list (use B1950 or Apparent by - preference) - TO_OLD convert to old format source list - NVS make new version of model file if necessary - CVXL convert formats between machines <P> - QUIT finish <P> - - <H3> More information: </H3> <UL> -<LI><A HREF="../nmodel/nmodel_keys.html">List of keywords</A> for NMODEL -<LI><A HREF="../homepage.html">NEWSTAR Documentation Home page</A> -<LI>Description of <A HREF="../nmodel_descr/nmodel_descr.html">program NMODEL</A> -<LI>The <A HREF="../common_descr/common_descr.html">DWARF User Interface</A> -</UL> diff --git a/hlp/nmodel/nmodel__model_option.html b/hlp/nmodel/nmodel__model_option.html deleted file mode 100644 index e69de29bb2d1d6434b8b29ae775ad8c2e48c5391..0000000000000000000000000000000000000000 diff --git a/hlp/nmodel_comm/nmodel_comm.html b/hlp/nmodel_comm/nmodel_comm.html deleted file mode 100644 index e69de29bb2d1d6434b8b29ae775ad8c2e48c5391..0000000000000000000000000000000000000000 diff --git a/hlp/nmodel_keys/nmodel_keys.html b/hlp/nmodel_keys/nmodel_keys.html deleted file mode 100644 index e69de29bb2d1d6434b8b29ae775ad8c2e48c5391..0000000000000000000000000000000000000000 diff --git a/hlp/nnews.txt b/hlp/nnews.txt deleted file mode 100644 index 5cc4c64e68184fb046cfc4c969eb1d8c218f7bda..0000000000000000000000000000000000000000 --- a/hlp/nnews.txt +++ /dev/null @@ -1,730 +0,0 @@ -1 NNews - 1000929 Allow reading leiden data from CD-ROM - 1000929 Repair problem locating MDL files - 1000929 Correct bug in COR data display; add stepping over sets in SCAN display - 1000922 Correct double 29 in DCB data from MS - 1000922 Solved rounding problem when flagging mosaic data using CHAN - 1000922 Added the display of polarisation channels if no ap solution - 1000921 Repair milennium bug in update procedure - 000309 NSCAN: Allow for CD-ROM directories - 000309 Add 99A, 99B for project numbers - 000309 NPLOT: phase continuity added - 000309 Changed the MXNCH to 8192 to plot long 10s files - 000309 ALL: Default for MODEL_ACTION now uses BEAM instead of NOBEAM - 000309 NCALIB: fix FCA used for reading data for vzero calculation - 000309 solves a problem with DZB data reported by AGB - 000309 Added loops to SET -- INIT - 000309 NGCALC: Corrected a missing argument that made ngcalc plot crash - 000309 NMODEL: Add extra model update modes (but not implement them yet) - 000309 Add messages that X* updates not yet implemented. - 000309 Corrected update convergence for 'I' only case - 000309 NMAP: [C]MEMORY_USE max. 4 --> 32 MB (request by AGB) - 980707 System: Various changes for logbook and CD-ROM stuff - NFRA: remove ws4, ws5, ws7 stuff, use daw18 for compile/linking - add script to read WSRT-logbook - 980707 NPLOT: change dot pattern for connecting lines - 980707 phase continuity; better connecting lines - 980707 NCALIB: For better calculating MIFR - 970728 NPLOT: modification related to remove control-C plot control - 970605 NPLOT: Make default coordinate contouring grid size 256 - Some changes for plotting exactly on pole - 970530 NPLOT: Correct plotting of coordinates and ticks near pole. - A selectable precision (COORD_PREC) possible. - 970529 NSCAN UVFITS: Allow multiple BITPIXes, - better grouping of sets in labels - Extra prompt for BITPIX - 970529 System: Included check for non-existent conversion from DEC,L to RA,M - 970529 NPLOT: Coordinate plotting near pole - 970509 NSCAN/NFLAG: improve formatting of X/Y arrays - 970509 NCOPY: add new option SHORTCOPY - 970509 NPLOT: plot control through control-C - SPECIAL options: - alternatives for HA scale - hour-angle integration - annotation text - new SORT=INVERT option: transposed interferometer order - new data types AGAIN, PGAIN: ampl. and phase of data/model - plot order XXgain, XXphase ... i.s.o. XXgain, YYgain ... - raster lines on tel/interfmr plots - increase font size for 'PLUVO' plots - nonlinear gain scale to accomodate very large and very small gains - modification related to control-C plot control in NPLOT - correct scales for BAND mode - 970509 NCALIB: New algorithm for VZERO calculation - Add USIGN to resolve sign ambiguity in Stokes U - Calculate and report GZD - Revise gain normalisation algorithm (had never been tested!) - Revise ME calculation in ncalib.for - extend GAIN_NORM help text to include -1 option - 970509 System NFRA: do 'setenv LPDEST jet5' to use new printer - Fixes/changes in record/replay - Small changes for LICK and WSRT - Changes for RUG (add Solaris) - Add IONOST for HP - 970509 NSCAN: Give error-message in case WNFRD return an error - bug 229 - 970509 All: Filename-problem on Solaris solved - bug 224 - Logging of selected IFRs also in logfile - bug 228 - 970509 NMAP: problem in FITS maps created by NMAP solved - bug 221 - 970509 NCLEAN: fixed crash problem when reading visibility data - bug 226 - 961108 NSCAN: Corrections for archive - 961017 NCOPY: add special option for holographic beam measurements - 961017 NCALIB: fix loose ends from earlier change of dispatching codes - CCOPY should now work as advertised - Renormalisation: Leave undefined corrections (TCOR=0) undefined - 961017 NSCAN: Correct use of band8 bandwidth for versions<46 - 961017 NSCAN UVFITS: Use RR,LL etc instead of XX,YY because of problems with UVLOD in AIPS - 961017 All: use . i.s.o. - in interfm display for better visual appearance - 960813 NCALIB: correct VZERO calculation - suppress 'XY constrains' output in log file - correct code for SETCLK (was treated as SETMIFR) - correct SHOW output format - 960813 NPLOT: correct misleading comment - 960813 NSCAN: Add bytecount for CHECK - 960813 System: add files for site LICK, add Dec-Alpha/OSF1 in Bonn - 960626 NPLOT: change plot annotaion format - change interface to ST plot options: ST_ prefix in IFR_MODE - replaced by S_ prefix in OPTION - new keyword HA_MODE for special effects in vertical scale - 960626 NCALIB: For REDUN option: Take all interferometers. (Also 00, 11 etc.) - 960626 NMODEL: show RA and DEC in show header also in decimal format - 960626 NSCAN/NFLAG: fine-tune overview formatting - bug fix in MAXD calculation for NSCSCF - 960626 NSCAN: Read correct OH-length for mosaik observations - 960626 NCOPY: Fix serious bugs - must have been there for several months! - zero IFRMC, IFRAC, emit user message - bug 141 - 960626 System: add files for Solaris system - Situation at RUU changed - 960520 NCALIB: extend help texts for BASEL_xxx parameters - 960513 NCOPY/NPLOT/NGIDS/NCLEAN: warning if /NORUN - 960502 Documentation: Several small bugs fixed - 960422 NMAP: RA,DEC in header within proper ranges - emergency bandage for the HOLOG mess: new keywords OLDHOLOG and NEWHOLOG - report filename on open failures - find free label if * specified (previously * was equivalent to 1) - return to nmadat after most actions - (in batch mode, input EOF will cause nmap to QUIT as before) - 960422 NMODEL: option RMERGE: merges model components that are within radius - removed bug from UPDATE option QUV - 960422 NPLOT: Do not ask IFR_MODE when OPTION=TELESCOPE - bug 161 - Correct MB3 or X exit loop - bug 200 - add plot modes STNORM, STSORT: using ST i.s.o. HA - 960422 NSCAN/NFLAG: Type text for COR/UNCOR and if something NOT present - bug 169 - 960422 NSCAN: corrected a bug in precession angle calculation - bug 0217 - Add pol.code for DXB/DCB IF-sets, Increase max number of sets - 960422 NFLAG: new options: UXY and VXY - 960422 NCOPY: interferometer selection, SELECT_IFRS parameter - 960422 NCALIB: Correct Copy MIFR corrections (SET_OPTION=ICOPY) - bug 181 - 960422 IONOS: Changed averaging (first days, then hours) - 960422 All: truncate '.<number>' in mosaic field name to get correct default MDL name - 960422 System: add I_HPWSRT.CSH - new routine for calculating sidereal time - add dwrec|p|n aliases - 960130 NMAP RFITS: Do not abort when error in FITS header found - 960130 System: correct problem with unlocking of files - bug 142 - System: some small updates, mainly for NFRA purpose - 960130 Documentation: remove FULL command in ndoc: replaced by ALL - 960130 NCLEAN: Move comments to new line - 960130 NSCAN: Change name for Scissor: CONTLINE now OBSMODE - 960130 NMODEL: Reminder if INTERN is on - bug 156 - 960130 NFLAG: Explanation for STATISTICS GROUPS option, correct flow, - IFR output - bug 149 151 153 189 190 - 960130 NCALIB: Add message concerning model selection for REDUN - bug 178 - Reset Scan counter for SET ZERO - bug 185 - 960130 NSCAN: Some explanation for layout - bug 172 - 960130 NMAP: REF_COORD RA always positive - bug 193 - RFITS: Message if Disk files not found - 960130 NPLOT: merge HjV 941031, 950711, 950718 with my own changes. - Fix help text for IFR_MODE - bug 201 - 960130 NFLAG: Comments; add detour into MODE from STATIST branch; - bug 190 - add labels 183, 193 (CMV's fix for bug 190) - 960130 All programs: add OVERVIEW=ALTOBS option - 960130 System: implements the dwre? commands; - 960130 System: Add LD_LIBRARY_PATH for site UCSB - 951215 System: Add new site: AIRUB (Bonn) - 951213 Correct REF_COORD backtrack error - bug 194 - 951213 System: Add environment n_www - Used to specify your favorite WWW browser. - If you don't define it, xmosaic (part of Newstar - distibution) will be used. - You may change n_www in your newstar_<site>.csh - When changing this file, please check it in with: nsh in - 951205 SYSTEM: Add site IRABO, add some missing files - 951205 MODELS:Adding a new model file for 1127-145 at 21cm - 951205 New improved model for 3C295 at 21cm from reduction group - 951205 New improved models for 325 MHz (92cm) - 951205 NMAP: correction of logic for FIELD_SHIFT/FIELD_CENTRE - bug 139 - 951205 NSCAN: Made Scissor interface more robust - 951205 NCALIB: correct REDUN output: last column I (= nr of iterns) decimal - 951205 Correct scaling of errors (/10 instead of *10) - 921205 PPD: Donot remember ?? request, so user retains access to terminal - help trough ? - bug 154 - 951205 System: add DAT-device for DAW13 (NFRA-only) - 951205 NFLAG: correct EXPLAIN bug showing RMS 3 times - 951205 Documentation: - 1. Revision of documentation system - various bug fixes - - more robust - better cross-referencing - 2. groundwork for batch recording system - 951205 NMAP: Implement complex summing/rotation measures - 951205 NSCAN: Add ARC option for LEIDEN tapes - Therefore WARC changed to ARC and added two new sub-options for ARC - 950822 New Newstar release: 6.1 - 950821 NCALIB SET IREF Help text corrected - 950821 Scissor: Improve options for ionos, add filpo option - 950821 NMAP: Rough trial to produce P^2 maps (pol type LI) - Prepare improved polarised intensity map - 950714 NCALIB: Include MIFR setting - New least squares: better mean errors in polarisation calculations - Improved 'complex' solutions for calibration - Change in writing interferometer errors for missing telescopes - Add option ICOPY for SET_OPTION (Copy MIFR-corrections) - 950714 NCLEAN DATA Clean: correct restored map when using DataFactor (new keyword) - 950714 NSCAN: Add MDLNODE_PEF (model keyword was missing) - Add NSCSCY to NSCSCR for UVLIN type operations - 950714 NPLOT: Re-open SCN-file for update when models found - bug 127 - Plot all PHASE residuals in W.U. - Add (hidden) keyword PLOT_HEADING (Def. YES / NOASK) - 950714 NGCALC: Change SET_ACTION in SECTOR_ACTION, add EDIT - 950714 NPLOT/NGCALC: Add A0-plotter, therefore changed options for - keyword PLOTTER and added keyword PLOT_FORMAT - 950714 NMODEL: Update option extended with, a.o., clustering, position only - Add constrained update - Model update correction for constrained clusters of more - than 2 sources - Added looped updates: not always perfect; slow, and most - useful for small number of well separated sources/clusters - 950714 System: some changes for use in Leiden - 950714 Documentation: Use latex2html stuff from Newstar account - Correct some typo's in tex-files - Add plotter_public_intfc.tex and change some other - 950714 NFILT: Create the program to calculate continuum from the UV data - 950714 NGEN: Change (DE_)APPLY so it has the same options as X_(DE_)APPLY - 950530 NSCAN/WARC: Correct handling of Mosaic positions - 950530 Update the LSQ test program twnm.for - 950516 NSCAN: fixed problem with wrong 0X total power. - bug 122 - 950516 Scan-file remembers whether REDUN was done with /DE_APPLY=OTH - 950516 NCLEAN: Add keyword DATA_FACTOR for DATA-clean option - 950503 TWNM: A new set of least squares routines, incorporating proper error - handling and non-linear solutions are provided. - Documentation is available in lsq.tex/lsq.ps - 950502 NCLEAN: DATA clean: HA_RANGE works once more - 950502 NCLEAN: Better error message in case outputfile readonly - 950502 NCLEAN: Data clean: clip_area back again - 950502 NSCAN: Correct AOTH correction if telescopes deleted - 950502 NMAP MAKE: correct binning if position of C,D is zero - 950502 NSCAN: Add option to read LEIDEN-tapes - 950502 Scissor: More client commands, add ionosphere stuff - 950502 Scissor: no messages about succesfull connection - 950502 NSCAN: Check if IF is present - 950303 NSCAN: DE_APPLY corrections set properly if telescope missing - 950224 Add test program TWNM for non-linear and complex LSQ testing - 950224 When elm NOT available, do elm alias '/usr/ucb/mail' - 950224 Make sure that if still logged in after 7 days with - intermediate logins, you can re-init symbol file - 950221 NCALIB: Different limits for manual gain - NCALIB: Account for /DE_APPLY=OTH in different way when writing back corrections - 950220 NPLOT: correction for plotting mosaic IFDATA - 950220 NCALIB: larger range for gain corrections (SET MANUAL etc) - NCALIB: Do not create non-existing SCN files - 950220 NSCAN etc: Giving HA_RANGE=* is equivalent to default range - 950220 NSCAN PFITS: Option for shortlist of multiple labels - 950220 bug fix: allow for comment following '\' null reply - 950220 alert user if he tries to process .psc files - 950220 744 --> 644: data files are not executable - 950220 update of doc system - 950202 NCALIB: restore printing logic to situation before 940912(request by AGB) - 950202 NGEN: Add shift and model again - 950202 System: Use $HOME in directories i.s.o. tilde - 950202 NCALIB: default modelfile back again - 950202 Scissor: improved archiving procedures - 950202 NSCAN WARC: also pass calculated size of label to MEDIAD - 950202 NMAP: RFITS several small bugs fixed - bug 134 - 950126 NSCAN (NFRA): Archiving options - 950126 changes in user interface accumulated over several months - the algorithms have not been touched - minor corrections to prompt/help formatting - format and help-text changes - 950123 ATNF: do not keep old executables (-NKeep switch) - 950123 Correct renaming of log-files etc - 950123 NMAP on Alpha: correct alignment - NMAP on Alpha: Correct RFITS - 950123 complete backtracking on ctrl-D, fix omissions in closing files - 950123 NPLOT: Correct HA_SCALE - 950123 Correct plotting of Y telescope errors - bug 135 - 950123 Correct alignment errors in NMAP common - 950123 NSCAN DUMP: correct size of copied labels - 950112 correct scan number for model visibilities in HA-integration - this fixes a bug reported to JPH personally by AGB - 950112 system: test if we have to rebuild sys_bldppd.exe before - processing psc/pin files - 950111 NSCAN: Option WARC updates Scissor - NSCAN: Put WSRT Gain corrections in DE_APPY OTHERS - 950111 NSCAN: Correction for WARC - 950111 NSCAN: Correct WARC for Mosaic observations - 950111 donot give an error message for wildcard disk input - 950111 NPLOT: Correct scale for pol.vectors - 950111 NPLOT: Fix bug with RA =~ 0.0 (No coordinates plotted) - NATNF: Select all interf. (Not asked anywhere) - System: Add scripts for ESTEC - Documentation: Newstar maintenance inside/outside NFRA as html-file - 950111 NSCAN DUMP: Pass correct size to Scissor - 950111 NMODEL: Option _CONVERT is CONVERT again - 950111 show prompt only on terminal or if environment var N_PSCTEST=1 - 941121 NPLOT: Correct handling of # at WMP_LOOPS - 941121 NFLAG: Correct bug in psc-file, occurring at GET option - 941115 Documentation: include link to Scissor in homepage - 941115 new organisation of program-parameter documentation - 941115 adapt hypertext program-parameter help to new organisation - add sync mechanism to xmosaic restarting - 941115 NFRA: More Scissor commands - 941115 NFRA: Allow override of Owner for medium adminitstration - 941115 prompt-format control in .psc files, see psc_guide.txt - 941115 correct units for correction tables: deg --> rad - 941110 NMAP WFITS: Correct bug in CDELT3 - 941110 NGIDS: Include FLFNODE - 941110 All: allow tape-directories on disk - 941110 NSCAN: update mediumadm. in Scissor for option DUMP - 941110 System: Interface to Scissor - 941031 NCALIB: Repair yet another bug in psc-file - 941031 PPD: Add missing pef-files in psc-files, typo's in for-files - 941027 New Newstar release: 5.1 - 941027 NMAP FIDDLE: Open/close file when asking WMP_SET_2 - 941019 NMAP FIDDLE EXTRACT: Correct fieldsize of extracted map - 941019 NPLOT: Correct default option after IFDATA choosen - 941019 NCOPY: add option to apply corrections to data being copied - (request of AGB; primitive implementation only) - 941019 NMAP: add FIELD_CENTRE for map-making - 940930 NGIDS: Correct plotting of maps with odd-axis length - 940930 NMAP: Corrections in RFITS (for FITS files not produced by NMAP) - 940930 NCALIB: Bug in COPY repaired - 940928 NFLAG: Can use CLIPDATA=2*RMS etc. again. - solved problem with write-protected files - 940928 NMAP: No longer overwrite tapes when aborted - bug 125 - 940928 All: correct default model-file for broadband 92 cm observations - 940928 NCALIB: SET DX etc is now SET OTHERS DX - NCALIB: Option SET OTHERS MULTIPLY added - 940928 NPLOT: Prompts for scales accept * (=default) - 940908 NFLAG: bug in `dryrun' statistics fixed - New NFLAG option RT1 (CLIPDATA group) - 940901 NMODEL: Changed NMODEL UPDATE to include Polarisation - and Linear pol estimator (not written yet) - 940901 NGIDS: New flagging mode CLIPFLAG - bug 115 - 940901 All: specifying SELECT_IFRS= -* also switches off autocorrelations - 940901 Files opened for writing/updating are now write-locked - to prevent multiple writes to the same file - 940901 System: changes in X11 interface - bug 120 - 940901 NPLOT: Keep old user-input as default for next plot, - option to abort a series of plots on X11. - 940901 No more confusing messages about DWARF symbols - 940901 User interface: - LOOPS before SETS like everywhere - Replace reporting of individual cuts by summaries per 100 - 940901 ALL: Improve user interface and list output for LAYOUT/OVERVIEW - 940901 NMODEL: Correction for pol update - 940901 NPLOT: Ask tick-type also if no pixel coordinates asked - 940901 NPLOT: Correct bug in overlay of contour map and pol. vectors - 940901 NSCAN: Load datasets with 512 channels (or more) - 940901 NSCAN/NMAP: UNIT-* now really lists units - 940901 NFILT: Tested writing of IFR errors with Qubes - Still missing: secondary corrections - 940901 NMAP Write FITS: Correct bu causing core dump, correct scale for AP - 940901 NPLOT: More space between annotation and axis - 940821 NFILT: Add interferometer error writing to Qube options - 940821 NMAP: No error if #.. set-specification in FIDDLE - 940821 NSCAN LOAD: Use proper channel numbers for observations <1983 - 940821 NPLOT MAP: Options to suppress annotation with pixel coordinates - 940821 NGCALC: Add BASE option to make plots as function of baseline - NGCALC CALC: Add CPOLY to make plot with data from fit - 940821 NCALIB REDUN: MODEL_OPTION no longer accepts INTERNAL - bug 121 - 940821 NFLAG FLAG: DETERM option ELEVATION added - bug 111 - 940812 NMAP FIDDLE COPY: Keep original comment in map header - 940812 All: NODE specification from list (** first, then #nn) - Giving * as tapeunit generates list of known ones - 940812 NCLEAN: No max. limit on memory size - 940803 NCLEAN: prompt for DMEMORY_SIZE with a default value - (not tested because this code is not normally executed) - 940803 NCLEAN: Bug 67 (Data Clean overwrites input map). - bug 67 - This behaviour is intentional. An explanation - is given in the NCLEAN program description. - 940721 DEC/Alpha: get rid of <unaligned access> from qsort routine - 940721 NFRA: add tape-unit MAG0 (1600 bpi) and MAG1 (6250 bpi) for rzmws0 - 940721 NGCALC: add DEL function - bug 117 - 940721 NPLOT: Add option ISYS to IFDATA to plot Tsys X+Y - 940721 NGCALC: Correct extract of IF-data - NGCALC: Correct bug in subtraction of poly-fit, show also - for HA in hours - 940721 NFLAG: Add MANUAL option HARANGE with repeated prompt - bug 118 - 940721 NMAP: Correct centre of extracted map (FIDDLE EXTRACT) - bug 114 - 940721 NCALIB: bug in SET INIT corrected - bug 116 - 940721 NFLAG: Improved statistics options - 940721 NMAP: Add option to read FITS-files - bug 104 - Only tested on FITS-files written with Newstar - 940721 ndoc Hyper: respect user's Xmosaic window-size settings - 940721 NPLOT: Increase buffers for large DATA plots - 940623 NMAP: Correction in Job Summary - 940623 NMAP: Correct grouping in output map - 940623 WSRT batches: smaller plots - 940623 NGCALC: Correct data copy buffer pointer - bug 113 - 940623 NMAP: Correct for crash during MOSCOM - 940623 NGIDS: Really set data to BLANK if BLANK_FLAGS=YES - 940623 NPLOT: Handle INTERNAL model correctly for RESIDUAL and MODEL - bug 99 - NPLOT: Correct default HA scale for X11 - bug 112 - NPLOT MAP: Option EDIT for PLOT_POSITIONS - NPLOT: Option INTERFEROMETER (corrections per ifr.) - 940613 nhyper: Mosaic 2.4 for DEC workstaton - 940613 NPLOT: different data-types on one page possible - 940613 NMAP: Add job summary log - 940613 NSCAN: Make available for old VAX R-series files - 940524 NMAP: Also symbol SD=Sin(Dec) defined - 940524 NFLAG: Define DWARF symbol RMS after dryrun, this allows - specifications like CLIP_LIMIT=5*rms - 940524 NCALIB SET INIT: Option to select interferometers - bug 110 - 940524 NCOPY: Copy IF-data, option to strip Model, does not complain - bug 109 - if data has less polarisations than expected - 940524 NPLOT: More sensible default for HA-range - 940524 NSCAN LOAD: Adapt for some weird tape-errors - 940524 NPLOT on X11: no more accidental "incorrect datatype" messages - 940524 NMAP: Make available for old VAX R-series files - 940524 NMAP: Extra spaces in output summary (for ABF scripts) - 940524 NSCAN: Small error with LOADIF on HP/WSRT solved - 940516 Prompts for NODE: ** option also matches lowercase files - 940516 NCALIB COPY/SHOW/CCOPY: Hidden keyword CAL_EQUAL to make all - input sectors of equal length (=weight) - 940516 nhyer: Mosaic 2.4 for Sun and Hp - 940516 NMAP FIDDLE MOSCOM: Max. number of input maps increased - 940516 NSCAN LIST: Print duration of measurement - 940516 NSCAN: Correct CATEG output for RUG/sw - 940509 NSCAN: LOADIF option to load Total Power data with uv-data - NSCAN SHOW: TP/GN option for SCAN_ACTION to show T.P./Tsys - 940509 NSCAN/NFLAG SHOW OVERVIEW: Correct bug in listing - 940509 Extensions are now accepted with nodenames (e.g. M31.SCN i.s.o. M31) - Warning if node needs to be converted with CVX - System: allow global DWARF symbols to be defined by Newstar programs - NMAP: handle flaw of Sun tapeunits when winding up to end-of-file - NSCAN: properly handle End-of-File on some Sun tapeunits - 940509 NMAP: Declination stored in DWARF symbol PCDEC - This allows you to specify e.g. GRID_SIZE=4,4/SIN(PCDEC) - 940509 NPLOT: Add option IFDATA (keyword: OPTION) and - keyword IF_MODE to plot Total Power data - 940509 NSCAN LOADIF: Various bugs corrected - 940509 NGCALC: Add option IFDATA (keyword: OPTION) and - keyword IF_MODE to extract Total Power data - 940509 NPLOT: Option to label sources with proper names in map-plot - 940509 All: You can get a list of matching nodes by giving ** - or name_of_directory/* - 940509 NMAP: Increase size of output map for MOSCOM - 940509 NGIDS: Increase buffer size for large MOSCOM maps - 940509 NCALIB SET: Options IFR and MIFR for interf. corrections - bug 98 - NSCAN/NFLAG SHOW: SCAN_OPTION Ifr to list these corrections - 940509 NPLOT: Freq.bands back in plots with IFR_MODE=BAND - 940425 NSCAN UVFITS: Correct labeling of polarisations - bug 88 - 940425 NCLEAN UVCOVER: No crash if Mapsize<FFTsize - 940425 NPLOT: Option to plot identification with sources in maps - 940425 All: proper correction for Faraday rotation once more - bug 102 - 940425 NMAP: Bug removed from NVS and CVX - 940418 NSCAN LOAD: Warning if Leiden tape, comments for old tape versions - 940418 NPLOT MODEL: default model file, INTERN handled correctly - 940418 NMODEL etc: Change in SHOW submenu, SHOW option in MODIFY - 940418 NMAP: Warning if input data with different pointing centra selected - NMAP: Do not create non-existing SCN files - NMAP: INTERN option works with MODEL_OPTION - 940418 System: DWARF startup more reliable, default dir. for models - 940418 NSCAN/NFLAG: Corrected bug in NSCSCM (in NSCSCR) - 940418 NSCAN/NFLAG SHOW: bug in T option corrected, phase shown unscaled - 940418 NGIDS DATA: Phases in range -180,180 (used to be 0,360) - bug 77 - 940418 NGIDS: better text if INTERN option used - bug 94 - 940411 DWARF: Unix environment variables (setenv) now recognised as symbols - 940411 NCALIB: Selection of telescopes possible for ZERO and COPY/CCOPY - 940411 NMAP: Show flux in areas with option SHOW CONT CONT D/N/O - 940411 NPLOT: Solved some little problems - 940411 NSCAN: Reading data period july 1978 - january 1984 possible - bug 73 - 940329 NMODEL/NCALIB: Solved HP bug at WSRT - NSCAN: Proper sequence number in LIST option - 940329 DWARF: ?? also works if you were reading something on a server - 940317 NFLAG: removed bug which caused an extra Scan - NFLAG: added option QXY (to CLIPDATA group) - NFLAG: added switch (use MODE) to disable 'dry-run' - 940317 NSCAN: Do not ask OVERVIEW question for Layout... - 940316 NGIDS: Correct handling of INTERN option for models - bug 79 - 940316 NSCAN: Levels in Overview - 940315 DWARF: proper handling of paths in restore and save - 940304 NMAP etc: Proper sign of V in model subtraction - bug 74 - 940303 NSCAN LIST: Proper date/time - 940303 NSCAN/NFLAG SHOW: Correct negative phases - 940301 NCALIB: Add space between HA and Pol. in output list - 940301 Models: Correct test for equality U,Q,V - 940301 NCALIB: "Flux-unknown" bit in model header determines default - for SOLVE gain - 940301 NSCAN/NFLAG SHOW: Option to display corrected data - bug 53 - 940228 All: Propoer Faraday rotation, model for x+ etc dipoles - 940228 NCOPY: Bug causing segmentation violation removed - 940228 NMODEL: Changed MODEL_OPTION user interface, - default file for READ model is calibrator model - 940228 NCALIB: added (linear) differential shifts - 940228 NGEN: New keyword MODELB: search directory for models - 940224 NPLOT: Problems with mosaick observations solved - 940224 DWARF: Correct handling of quotes and slashes in qualifiers - passed to dwe - 940224 NSCAN: New command LIST to list contents of WSRT tapes - 940223 NSCAN: Proper conversions for reading WSRT data on DECStations - 940223 DWARF: Streams work again - 940223 DWARF: DATAB feature switched off if DATAB set to "*" (including the - quotes, use dws ngen to set this) - 940221 NCOPY now copies all flags i.s.o. removing them - 940218 DWARF: Show version when program is started - 940218 NGIDS: Option to blank flagged datapoints - 940218 NCALIB: Changed format of log-line (tag for Reduce scripts) - 940218 NSCAN Remote tapes: tell server who is calling - 940216 NGEN: Add keyword MEMORY - 940215 NMAP: Default HA-range -90,90 for WSRT - bug 4 - NMAP: Allow specification of Grid size (give "" at FIELD_SIZE) - bug 5 - NCALIB: SOLVE and COMPLEX always asked - bug 60 - NSCAN/NFLAG Show: Give category/type in printout - 940214 NCOPY: remove relics of simulation - 940208 NSCAN: Remote tape-units - 940203 NGIDS: New keyword ALL_POLS, no empty flag files, - Name of input Node and Sets in (ASCII) flag files. - 940203 NMAP: Suppress unnecessary creation of new groups when looping - 940203 Fitting NPLOT to the needs of the reduction group - bug 59 - which means: Plot AP or CS on one page (= 'old' PLOTAP) - More plots on one page - NPLOT: add BANDPASS option to make (ifr, ch) plots - bug 26 - 940202 DWARF/System: Changes for DEC Alpha/OSF1 and general cleanup - bug 57 - 940126 NGIDS: Increase effective size of buffer - 940120 NFLAG: Extended IHAMIN,IHAMAX to 180 degr - 940120 DWARF: open ppd-file readonly - 940117 NGIDS: Correct bug in data-range/model subtraction, better min/max - 940117 NSCAN/NFLAG: Better printing of FREQ in Sector header (no 0.xxxE04) - 931223 NPLOT: Keyword SCN_LOOPS included - 931221 NGIDS: Correct some SUN specific Fortran and typos - 931221 NGIDS: Correct zoom and HA step, some more on-line help - 931220 NSCAN, NMAP, NGCALC: New EDIT format, new OVERVIEW option for SHOW. - Answer L or O to any ???_SETS/LOOPS prompt to get the Layout or an - overview of the corresponding file. - 931217 NSCAN: report which interferometer in case of Format error - 931217 NGIDS: Read SCN files directly and flag them with gids regions - bug 65 - 931216 General: old logfiles (>5 days) no longer purged - 931216 NFLAG: Fully reworked new version - 931216 All: Make LOOPS more specific (SCN_LOOPS etc) - bug 3 - 931215 All: Read special (ACORM=0) tapes - 931215 NCALIB: cater for possible phase ambiguities in complex gain averaging - 931215 NCALIB: Make Complex solution (only a possibility) and some small - text changes - 931215 New (931117) version of giplib and gids for cv - 931215 NMODEL: Add REDIT, FEDIT model action - 931206 NGEN: New dummy program NGEN for use in batch scripts - 931206 NMAP: Changed text - bug 42 - 931202 System: Problem solved with character entry (for HP-UX 09.01) - 931202 NPLOT/X11: Plot crosses in maps (again) - bug 40 - 931130 NGIDS allows SLICE - 931130 NSCAN: correct default label for output disk files - 931130 NSCAN: report old and new indices for each new index being made - 931124 NSCAN/NFLAG: W option shows all weights including values of 0 - 931123 Error with structures in WNTINC. Recompile some DSC - bug 63 - 931123 WNTINC: Proper _T for multiple sub-structures - 931123 NMAP Show: Layout extended (and some minor changes) - 931123 NPLOT: starts with white display - 931117 NCLEAN: Better userinteraction for AREA=, INST corrected in Beam Clean - 931117 System: xmosaic 2.0 and various minor improvements - 931116 DWARF: can now use . as well as $ for stream, dwv: new option /SHORT - 931116 NSCAN/NFLAG SHOW: Sector action does not stop in batch - bug 61 - 931112 All: bug fix to clock correction - 931111 Fire off X11 window right at the beginning and keep it. - bug 27 - 931110 NCALIB: baseline-pole correction fixed - 931105 NSCAN/NFLAG: Changed default for SECTOR_ACTION to NEXT - 931102 Models: Default option for MODEL_ACTION is now NOBEAM!!!! - 931008 Models: Automatic correction for beam shape at different frequencies, - positions, instruments has been included in all model - handling and calculations. - NMODEL EDIT option has been added to be able to change the - model header without conversion (part of the old CONVERT), - NMODEL CONVERT will convert everything - In model data calculations the automatic beaming can be - suppressed by the MODEL_ACTION NOBEAM. Note that if you - specify BEAM with an existing (old) calculated model, the - complete model will be recalculated. - 930924 NGCALC: Bug with 1D plots fixed - 930922 NSCAN: Option SHOW is back in NSCAN (but it also remains in NFLAG) - 930913 NSCAN: Correction of UVFITS output for incomplete data - 930826 NFLAG: New options TOPOL, STAT, ... New sequence in OPERATION_... - (now goes back to FLAG_MODE, OPERATION_0). - Bug in interferometer coding for ASCII files corrected. - 930825 NPLOT: Bug in PS output corrected. Also, printing to A3 should - now switch back to A4 properly - 930806 NFLAG: Option ARESID for flaggin on Selfcal/Align residuals - NFLAG: Option PUT repaired - 930802 NSCAN: NVS handles IQUV to XYX conversion properly for more than - one channel, proper weight check. - 930722 NPLOT: Changed keyword PLUVO in IFR_MODE(normal,spectral,sort) - normal: plot ifr vs ha, ifr order (00,01,...,dd) - spectral: spectral channel vs ha, per ifr (old PLUVO) - sort: ifr vs ha, baseline sort - 930706 NPLOT: RULE plots will now be plotted horizontal (C10) - 930701 New version of NGCALC with more expression functions and SHIFT - Calculate option. The new features can only be used for freshly - extracted data; there is no possibility to add the necessary - data to the existing NGF files by, e.g. NVS option. Old data - can still be used for all other options. - 930628 New NPLOT (NGCALC) X11 driver. You can now select the plotsize as - fraction of screen (default 0.75; value > 0.0, <= 1.0) by: - setenv PGPLOT_XW_WIDTH value - and get all plots without waiting (and without seeing end result) by: - setenv PGPLOT_XW_CLICKLEFT 0 - 930622 New NFLAG SHOW SCAN T option to guess calibrator phases selfcal start - 930622 Add some flagging possibilities to NGIDS for UV data - 930619 A new program: NFLAG contains now the SHOW and FLAG(DELETE) options - originally in NSCAN - 930616 New option added to set a field shift in SCN (in NCALIB), and to - "de-"apply it if wanted (all programs) - 930610 Flagging in NSCAN has been redefined, and options added. Read ? text - for details - 930608 The data format has been changed to cater for multiple flagging layers - and absolute (rather than relative) weights per data point. - SCN files made before this date will give a message: - "run NSCAN/NMAP NVS first". Run NSCAN NVS to convert the data to the - new format. - "DELETE" is now called "FLAGGING", and a new NGEN keyword UFLAG has - been introduced to be able to selectively include flagged data in - your processing. Like other NGEN keywords (e.g. APPLY) it can be - set as a switch on dwe; a dws NGEN or dws "program" or by - dwe "program"/ASK. - NSCAN SHOW has been extended to show the flags set for the DATA W - option, and a SET_ACTION FLAGS has been added to give an overview - of flags per cube slice. - 930606 Added ionospheric refraction, baseline pole, d(x,y,x), clock and - frequency correction. - Limited edges of mosaic output to suppress noisy data - 930524 Many keywords now have a more meaningfull name. - 930519 Read/Write to DAT-devices on HP now possible - 930513 NCALIB/NGCALC: New method for complex Least Squares - NPLOT: Solved problem when plotting with one (positive or negative) - contour causes crashes. (A42) - Problem with keyword DELETE_NODE solved (came in a loop). (A47) - NGIDS: Reorganised the program for future (interactive deleting) - NMODEL: New option: FIND to find sources in map - 930503 NMODEL: Problem with core-dump when type-error solved (A40) - Model update was wrong for fields with negative declination. - NSCAN: Problem with flagging of two polarisations corrected (A41) - NSCAN/NCALIB: Message will be printed when the program creates a new - SCN-file. Happens when name of non existing-file typed in (A43) - NCLEAN: Problems solved with noise values in the latest restore-step of - data-clean (came from original iso. residual map). (A44) - NGIDS: now totally independent from GIPSY (A49) - NATNF: Phase problem solved (A50) - 930304 NMAP: Writing cubes contiguous - 930210 NPLOT: Default contours now available. - Default PLOTTER will now be PSP, default SIZE will be 1.3, 1.3 - 920205 The problems on the HP with default value 0 have been solved. - Also some printout on the screen will fit on one line. - 921222 NPLOT: Display option X11 now partly available for UNIX machines - (Do NOT use halftone; some options will NOT work correct yet) - 921218 Changed KEYWORD=LOG. All programs have now default YES iso. SPOOL - 921106 Programs changed for J2000 and allow HA outside -90 - +90 degrees. - 921022 NATNF, NSCAN and NMAP are now able to use mag-tapes on UNIX system. - Do a setenv to see which mag-tapes are available. - NPLOT and NGCALC can now plot on A3-plotter (B17). - 920903 Many problems solved by WNB during his stay in Dwingeloo - NGCALC: New program for data calculation and plotting (C2) - NATNF: New program to handle RPFITS files - NSCAN: Split mosaic data (B1) - Error in old WSRT-tapes (1987) .. pointing set (A33) - Wrong MJD when not correct ended WSRT observation (A34) - Faster mosaic splitsing (2 times faster) (A35) - Conversion LINOBS (I,Q,U,V) to XX,XY,YX,YY (B14) - NMAP: UV circular weighting function (B5) - A option/loop (in FIDDLE/ADD) for line-data (B6) - MOSCOM option to use noise as weight (B11) - Extended NMAP fits header (B12) - Change coordinates if shift (A23) - Noise for extract/copy in NMAP (A28) - Precission angle calculation (A30) - Calculate offsets in map (A32) - Logics MAP statistics (A36) - NMODEL: Delete of non-clean components (B3) - Delete of sources inside dl,dm box (B13) - Merge source models: sometimes recalculate everything (A31) - RSHOW problem solved (A22) - NPLOT: Option to plot hourangle against frequency for a baseline - polarisation (C7) - Halftone plotting problem solved (A19) - Plot message by selfcal/align residuals with model (A24) - On SUN: Problem plots bigger than A4 solved (A26) - NCLEAN: Changed sign restore beam angle (A20) - 920728 NGIDS: New program to load maps into GIDS - (GIDS = Groningen Image Display System) - 920714 NSCAN updated for Online System nr. 63 (Change in extended FD) - 920626 New delete option DCLOW, same as DNCLOW, but for cleaning components - NMAP: Problem with Beam-option correctred (B4) - Problem with fsum corrected (A18) - Problem with model subtraction for polarisation sources - with RM corrected (A16) - 920623 Name of software-pakket changed from N-series into NEWSTAR - (Netherlands East West Synthesis Telescope Array Reduction-package) - 920609 NSCAN: Problem with flagging of two polarisations corrected (A12) - Layout for MJD(start) corrected (A14) - NMAP: Problem with source subtraction corrected (A15) - Problem with "LAYOUT" option for WMP-file corrected (A13) - 920504 NMAP: Problem with data in HA-baseline format corrected. - NSCAN: Problem with delete options (Rnoise Anoise) corrected (A11) - 920407 Problem with option CVX to DEC-workstation corrected. - NPLOT: Use of double loops for plotting a MAP corrected (A5) - Plotting more than one 'data', 'residuals' or - 'telescope corrections' problem corrected. - NMODEL: Symmetirc extended sources problem corrected (A6) - NCLEAN: Epoche problem corrected (A9) - NMAP: Writing REAL or AMP data from .WMP file to grey-scale - problem corrected. - 920131 NCLEAN with an unsaved residual map corrected - 920131 NCLEAN major cycle statistics printout corrected - 920130 NPLOT re-write to use full page in portrait mode - 920129 NPLOT output to EPS and EPP can be viewed on the DECstation (if files - produced there or ftp'ed) with the command: dxpsview & - or with the PostScript preview application - These files can also be incorporated in WordMarc (and other) documents - 920128 Spool error PS plots - 920128 Change prompt error in NMAP FIDDLE - 920119 NMODEL UPDATE corrected for use of B1950 models - 920119 NCALIB SELFCAL corrected for use of B1950 models - 920117 NCLEN COMPON option - 920117 NCLEAN restoring for extended sources - 920117 NCLEAN restoring for non-clean point sources - 920116 NCLEAN URESTore option for clean components - 920116 NPLOT large plots now ok - 920115 NCLEAN UVCOVER with restore option - 920109 NSCAN UVFITS memory related crashes for large jobs solved - 920109 NMODEL option to delete low-level non-clean changed in definition - 920108 NCLEAN Clark type clean (UVCOVER) please test and comments - 911230 NMODEL UPDATE corrected for logical error for clean components - 911230 NMODEL new option DNCLOW to delete low-level non-clean components - 911230 NPLOT better RA, DEC coordinates - 911227 NPLOT renewed with ruled surface and polarisation vector possibilities - 911227 Correct conversion to/from other coordinates in NMODEL - 911219 A new set of Plot routines incorporated in NPLOT (maybe problems) - 911209 Correct interferometer selection POL NCALIB - 911115 All (de-)beams have a maximum limit of a factor 100 - 911105 MAPs made before today at 10:00 will not properly combine in MOSCOM - 911105 NMAP FIDDLE MOSCOM will combine mosaic fields properly weighted - 911104 Correct de-selection of clean components (X)UPDATE in NMODEL - 911031 WERR option NSCAN will correct mosaic HA tape error - 911025 All HA's on WSRT tape for mosaic wrong - 911024 NMAP reference coordinate (mosaic) option checked - 911023 NPLOT RES definition changed for Ampl and Phase - 911014 NSCAN DELETE new CLIP option - 911009 NCALIB: SET RENORM option added - 911009 NMAP: correct multiple polarisations output - 911008 Default: No complex for NCALIB pure redundancy - 911007 Instrumental polarisation in first version - 911004 NCALIB POLAR VZERO options CALC APPLY MANUAL ASK in first version - 911003 The ncopy command will transfer and convert files from VAX - 910930 NPLOT: repair logics - 910930 NCALIB POLAR COPY has loops - 910930 NCALIB REDUN check on extreme values - 910927 Multiple input sets ok in NMAP; NPLOT option order reversed - 910923 Add SET,COPY,EDIT option to POLAR option in NCALIB - 910923 Correct sign of shift in NMAP - 910918 Add option to NPLOT to only plot XY,YX - 910918 quota directory|filename ... gives size (may have wildcards) (Alliant) - 910917 Correct bug in all programs that mistreated APPLY and DE_APPLY - 910917 Status of options as described in ITR198a - Can be printed (on VAX) by: $ wm/print user5:[wnb.itr]itr2a.wnb - 910917 The following programs exist: - NSCAN, NMODEL, NCALIB, NMAP, NCLEAN, NPLOT (+NGEN for parameters only) diff --git a/hlp/nplot/nplot__option.html b/hlp/nplot/nplot__option.html deleted file mode 100644 index d557c0b458cd0bffafc5a3c5c6b567c447c77729..0000000000000000000000000000000000000000 --- a/hlp/nplot/nplot__option.html +++ /dev/null @@ -1,32 +0,0 @@ -<TITLE>Description of OPTION (NPLOT)</TITLE> -<H1>Program NPLOT: private keyword OPTION</H1> - -<DT><EM>Prompt:</EM> Type of data to plot| MAP; DATA, RESID, MODEL; TELESC, INTERFM, IFDATA;|SPECIAL; QUIT -<DT><EM>Default:</EM> QUIT. -<DT><EM>Expected input:</EM> Character(24).<P> -Specify type of data to plot: <P> - .WMP-file data: <P> - MAP image(s) from .WMP file <P> - .SCN-file visibilities: - DATA observed visibilities - MODEL model visibilities - RESIDUAL visibility residuals (after correction of all known - errors and division by the visibilities of a source - model (yet to be specified) - (sets I=1, QUV=0) <P> - .SCN-file correction parameters: <P> - TELESCOPE telescope phase/gain corrections - INTERFEROMETER interferometer phase/gain corrections (i.e. all - corrections combined per interferometer) -! I rechecked this 960523 - JPH - IFDATA IF-data: total powers, system temperatures etc. <P> - Plotting versus sidereal time i.s.o. hour angle: <P> - SPECIAL will prompt for a special mode <P> - QUIT terminate NPLOT <P> - - <H3> More information: </H3> <UL> -<LI><A HREF="../nplot/nplot_keys.html">List of keywords</A> for NPLOT -<LI><A HREF="../homepage.html">NEWSTAR Documentation Home page</A> -<LI>Description of <A HREF="../nplot_descr/nplot_descr.html">program NPLOT</A> -<LI>The <A HREF="../common_descr/common_descr.html">DWARF User Interface</A> -</UL> diff --git a/hlp/nplot_keys/nplot_keys.html b/hlp/nplot_keys/nplot_keys.html deleted file mode 100644 index e69de29bb2d1d6434b8b29ae775ad8c2e48c5391..0000000000000000000000000000000000000000 diff --git a/hlp/nscan/nscan__option.html b/hlp/nscan/nscan__option.html deleted file mode 100644 index e69de29bb2d1d6434b8b29ae775ad8c2e48c5391..0000000000000000000000000000000000000000 diff --git a/hlp/nscan_keys/nscan_keys.html b/hlp/nscan_keys/nscan_keys.html deleted file mode 100644 index e69de29bb2d1d6434b8b29ae775ad8c2e48c5391..0000000000000000000000000000000000000000 diff --git a/hlp/nshow/nshow__file_action.html b/hlp/nshow/nshow__file_action.html deleted file mode 100644 index c1eb937dac21a3278ac3faf3af25340098beca60..0000000000000000000000000000000000000000 --- a/hlp/nshow/nshow__file_action.html +++ /dev/null @@ -1,21 +0,0 @@ -<TITLE>Description of FILE_ACTION (NSHOW)</TITLE> -<H1>Description of general keyword FILE_ACTION</H1> - -<DT><EM>Prompt:</EM> file-header action LAYOUT, OVERVIEW; SHOW, EDIT; CONT, QUIT | -<DT><EM>Expected input:</EM> Character(24).<P> -Specify interaction with the file header: <P> - Summarise contents of the file: - LAYOUT show counts of groups, fields and channels in the file - OVERVIEW give overview of all sector headers <P> - Details of the file header: - SHOW: display the file header in full - EDIT: edit fields in the file header <P> - Navigation: - CONT go down one level, to interact with Sector headers - QUIT exit from SHOW/EDIT option <P> - - <H3> More information: </H3> <UL> -<LI><A HREF="../nshow/nshow_comm.html">List of general keywords</A> for NSHOW -<LI><A HREF="../homepage.html">NEWSTAR Documentation Home page</A> -<LI>The <A HREF="../common_descr/common_descr.html">DWARF User Interface</A> -</UL> diff --git a/hlp/nshow/nshow__scan_action.html b/hlp/nshow/nshow__scan_action.html deleted file mode 100644 index e69de29bb2d1d6434b8b29ae775ad8c2e48c5391..0000000000000000000000000000000000000000 diff --git a/hlp/nshow/nshow__sector_action.html b/hlp/nshow/nshow__sector_action.html deleted file mode 100644 index b7b95a14f95207a7c97bdc28d4bdf9672934f2d5..0000000000000000000000000000000000000000 --- a/hlp/nshow/nshow__sector_action.html +++ /dev/null @@ -1,25 +0,0 @@ -<TITLE>Description of SECTOR_ACTION (NSHOW)</TITLE> -<H1>Description of general keyword SECTOR_ACTION</H1> - -<DT><EM>Prompt:</EM> Sector-header action | SHOW, EDIT; NAME, IFRS, IFH, FLAGS; NEXT, CONT, QUIT -<DT><EM>Expected input:</EM> Character(24).<P> -Specify interaction with this sector header: <P> - Show details of the sector header: - SHOW show entire sector header - EDIT edit fields (values) in the Sector header by name <P> - Show details associated with the current sector: - NAME index 'name' of the current Sector (if #nr specified) - IFRS the interferometer table - IFH: header of 'IF' data (Total Powers etc) - FLAGS: show the nr of flags per interferometer that are set in the - current Sector <P> - Navigation: - NEXT: proceed to the header for the next sector selected - CONT: descend into the scans of this sector - QUIT: return to the file-header level <P> - - <H3> More information: </H3> <UL> -<LI><A HREF="../nshow/nshow_comm.html">List of general keywords</A> for NSHOW -<LI><A HREF="../homepage.html">NEWSTAR Documentation Home page</A> -<LI>The <A HREF="../common_descr/common_descr.html">DWARF User Interface</A> -</UL> diff --git a/hlp/nshow_comm/nshow_comm.html b/hlp/nshow_comm/nshow_comm.html deleted file mode 100644 index e69de29bb2d1d6434b8b29ae775ad8c2e48c5391..0000000000000000000000000000000000000000 diff --git a/hlp/obscure_bugs.txt b/hlp/obscure_bugs.txt deleted file mode 100644 index fb821540ca2edceb402d15d0710bc909b43d15f9..0000000000000000000000000000000000000000 --- a/hlp/obscure_bugs.txt +++ /dev/null @@ -1,26 +0,0 @@ -obscure_bugs.txt - -A collection of obscure Newstar bugs and their antidotes --------------------------------------------------------- - - Like any system its size, Newstar is sensitive to programming errors -that are eaily made. Some of these may result in very obscure behaviour that -may be difficult to diagnose. This document is meant to formalise our -collective knowledge in this area. Anyone who solves a problem of this type is -invited to record his experience here so others after him may benefit from it. - - -Symptom: When exiting, the program emits a series of messages -------- - mv: <file name> is identical to <filename> - -Cause: The first argument in a WNCTXT call should be a bitmask (normally F_T or -F_TP). Omitting it or putting something else in its place may cause this type -of behaviour. -(JPH 940909) - - -Symptom: Program crashes with IOT 6 (?) -------- -Cause: Division by 0 (and probably other arithmetic exceptions) -(JPH 940909) diff --git a/hlp/plotter/plotter__plot_format.html b/hlp/plotter/plotter__plot_format.html deleted file mode 100644 index 6aa4510a036d63fbc75af91d39c7d6a1af224f29..0000000000000000000000000000000000000000 --- a/hlp/plotter/plotter__plot_format.html +++ /dev/null @@ -1,18 +0,0 @@ -<TITLE>Description of PLOT_FORMAT (PLOTTER)</TITLE> -<H1>Description of general keyword PLOT_FORMAT</H1> - -<DT><EM>Prompt:</EM> A<n>-format of plot 0, 1, 2, 3, 4 -<DT><EM>Default:</EM> 4 /ASK. -<DT><EM>Expected input:</EM> Character(1).<P> - Select format for (Encapsulated) PostScript plots: - 0 = A0 - 1 = A1 - 2 = A2 - 3 = A3 - 4 = A4 - - <H3> More information: </H3> <UL> -<LI><A HREF="../plotter/plotter_comm.html">List of general keywords</A> for PLOTTER -<LI><A HREF="../homepage.html">NEWSTAR Documentation Home page</A> -<LI>The <A HREF="../common_descr/common_descr.html">DWARF User Interface</A> -</UL> diff --git a/hlp/plotter/plotter__plotter.html b/hlp/plotter/plotter__plotter.html deleted file mode 100644 index ed52d46861338864df6ca360de8a540547a406a5..0000000000000000000000000000000000000000 --- a/hlp/plotter/plotter__plotter.html +++ /dev/null @@ -1,31 +0,0 @@ -<TITLE>Description of PLOTTER (PLOTTER)</TITLE> -<H1>Description of general keyword PLOTTER</H1> - -<DT><EM>Prompt:</EM> plotter to use X11; QMS, QMSP; PL, PP, EL, EP;|-REGIS, FREGIS; BIT1, BIT2, BIT3 -<DT><EM>Expected input:</EM> Character(8).<P> - Select device/mode for plotting: <P> - Xwindows: - X11 X11 terminal - The display used is given by (NGEN-) keyword DISPLAY - and/or the environment variable DISPLAY <P> - PostScript printer: - QMS QMS laser printer in landscape orientation - QMSP QMS laser printer in portrait orientation <P> - PostScript files:: - PL Postscript file in landscape mode - PP PostScript file in portrait mode - EL Encapsulated Postscript file in landscape mode - EP Encapsulated Postscript file in portrait mode <P> - Miscellaneous graphics: - REGIS graphics VT terminal - FREGIS (*) REGIS to file <P> - Bitmap graphics: - BIT1 (*) bitmap for 100 dpi - BIT2 (*) bitmap for 200 dpi - BIT3 (*) bitmap for 300 bpi - - <H3> More information: </H3> <UL> -<LI><A HREF="../plotter/plotter_comm.html">List of general keywords</A> for PLOTTER -<LI><A HREF="../homepage.html">NEWSTAR Documentation Home page</A> -<LI>The <A HREF="../common_descr/common_descr.html">DWARF User Interface</A> -</UL> diff --git a/hlp/plotter_comm/plotter_comm.html b/hlp/plotter_comm/plotter_comm.html deleted file mode 100644 index 69e7a5346e8197a4ba3b3e69c8313d95ed57f4c6..0000000000000000000000000000000000000000 --- a/hlp/plotter_comm/plotter_comm.html +++ /dev/null @@ -1,17 +0,0 @@ -<TITLE>Index of general keywords from PLOTTER</TITLE> -<H1>Description of general keywords (PLOTTER)</H1> - -<UL> -<LI> <A HREF="../plotter/plotter__plotter.html"> - PLOTTER</A> - plotter to use X11; QMS, QMSP; PL, PP, EL, EP;|-REGIS, FREGIS; BIT1, BIT2, BIT3 -<LI> <A HREF="../plotter/plotter__plot_format.html"> - PLOT_FORMAT</A> - A<n>-format of plot 0, 1, 2, 3, 4 -</UL> - - - <H3> More information: </H3> <UL> -<LI><A HREF="../homepage.html">NEWSTAR Documentation Home page</A> -<LI><A HREF="../hb_contents/hb_contents.html">The NEWSTAR Cookbook</A> -</UL> diff --git a/hlp/ppd_buffer.txt b/hlp/ppd_buffer.txt deleted file mode 100644 index 0911b64813ab5d032c5abddabed43bc105256ca7..0000000000000000000000000000000000000000 --- a/hlp/ppd_buffer.txt +++ /dev/null @@ -1,41 +0,0 @@ -Aanpassen van de grootte van de ppd help-text buffer ----------------------------------------------------- - -(bijdrage van H.J. Vosmeijer/J.P. Hamaker, 940829) - - -Als het compileren van een .pin/.psc/.pef file stuk loopt op een te kleine -werk-buffer in sys_bldppd, moeten zowel deze buffer als een daarmee -corresponderende buffer in de Newstar executables worden vergroot. Dit veresit -de volgende wijzigingen in files in $n_src/dwarf, gevolgd door een gepaste -reeks 'nsh build's - - -Om de werk-buffer in cpl_2.def te vergroten moet het volgende -gebeuren (b.v. van 5000 naar 10000 bytes): - -In cpl_2.def: - 1. verander 5000 in 10000 in parameter (cpl__wrklmax = 5000) - - 2. verander 5000 in 10000 in parameter (cpl_wrkbuf = 421) !&5000 !#C - - 3. hoog alle adressen op met 5000 (=(nieuw-oud)=(10000-5000)) voor de - variabelen die NA CPL_WRKBUF en VOOR CPL__LENGTH komen. - Dit zijn dus de waarden na het = teken) - - 4. pas CPL__LENGTH aan (=(CPL_ERRNTOT+3)/4) - - 5. verander 5000 in 10000 in CHARACTER*5000 CPL$WRKBUF - - 6. hoog alle waarden op met 5000 (=(nieuw-oud)=(10000-5000)) voor de - variabelen die NA CPL$WRKBUF komen. - -In onderstaande files in genoemde regels 5000 in 10000 veranderen: - cplblock.for: CHARACTER*5000 CPL$WRKBUF - cplread.for: CHARACTER KEYWORD*80, VALUE*5000 - bpdbuild.for: CHARACTER VALUE*5000 - bpdstore.for: CHARACTER STRING*5000, NAME*16 - ppdhelp.fsc: CHARACTER WORK*5000, WORK2*80, LINE*80 - ppdprompt.for: CHARACTER WORK*5000, PROGSTRM*80, KEYWORD*16 - - diff --git a/hlp/psc_guide.txt b/hlp/psc_guide.txt deleted file mode 100644 index 9d668a575afe8627f4f00a0aa5d635dc29f62484..0000000000000000000000000000000000000000 --- a/hlp/psc_guide.txt +++ /dev/null @@ -1,360 +0,0 @@ -Style guide for parameter definition files ------------------------------------------- - -History: - 941110 contributed by JPH - 941117 Style recommendation 7. - 941212 Revise the latter following changes in cplvallist.for, ppdopstr.for. - - -Summary -======= - - This document contains guidelines for writing .psc/.pef parameter -definition files. A few implementation notes are added as an Appendix. The -following subjects are addressed: - - a. Definition of parameter properties - - b. Definition of default values - - c. Prompt formatting - - d. Insertion of hypertext references - - -Related documents -================= - - The reader is assumed to have some knowledge of LaTeX and the way it is -used for Newstar documentation. The latter is described in the Newstar document -"Guide for writing and maintaining Newstar documents". - - -Definition of parameter properties -================================== - - A large number of properties can be defined for each parameter. I -discuss only a few. - - - ATTRIBUTES=<attr>[,<attr>]... - - . LOOP: WNDPAR returns the special status DWC_ENDOFLOOP when no more -parameter values are available. The calling program may detect this status as a -signal for some special action. When LOOP is not specified, the value(s) -specified is/are simply re-used. - - . NULL_VALUES: It is allowed to enter 0 values, either by default or -by the user. A null value is represented by an empty string: "". For a null -reply, WNDPAR returns <number of values>=0. - - . WILD_CARDS: A wildcard, *, is allowed as default or reply. For a -wildcard, WNDPAR returns <number of values>=-1. - -In a proper implementation, the latter two attributes should be defined only -where appropriate. In Newstar, they are declared almost everywhere and -consequently programs must make special checks in many places for illegitimate -null and wildcard values. - - This situation is clearly unsatisfactory, but systematic rectification -is not worth the effort and risk of mistakes. Some efforts in this direction -have been made but are being discontinued. - - -Definition of parameter defaults -================================ - - Defaults in a prompt can be defined in a number of ways. The DWARF -design postulated that the interface presented to the user should be defined as -much as possible in the .psc file; the - - - DEFAULTS=<values> - -clause in a keyword description serves this purpose. As an alternative, dynamic -defaulting can be used. - - Newstar largely ignores this philosophy, by defining most defaults -through the dynamic mechanism, even when the value is a constant. In some cases -both .psc and dynamic defaults are provided, - in which case the latter will -take precedence. - - This situation is clearly unsatisfactory, but systematic rectification -is not worth the effort and risk of mistakes. Some efforts in this direction -have been made but are being discontinued. - - -Prompt and options string formatting -==================================== - - A Newstar prompt is composed of - - <keyword> - - <prompt text> - (<options list>) - =<default>: - -The complete prompt is concatenated from these components and then formatted -into one or more lines on the terminal. - - As of november 1994, the formatting routine has been modified to allow -the programmer more control over the form in which the prompt is displayed, -through the use of some special punctuation: - - - The prompt string may be terminated in a '|' to put the options -string on a new line. - - - The options string may contain the characters ' ,;|/[]' to format it: - - . The '|' can be used to split the string over multiple lines; when -appended at the and of the list, it signals that the <default> must be put on a -new line of its own. - - . ';' and ' ' can be used to group options in functionally related -subsets; - - . '/' can be used to group options that are alternatives, e.g. -BAND/NOBAND. - - . '[]' can be used to indicate options that one would only use in -exceptional situations; - - . '(:)' can be used to insert comments (this may not work, it has not -been tested). - - -Long and short lines --------------------- - - Within Newstar a need exists for text files to be formatted as one line -per full paragraph in some application, and in other uses for the same files to -be formatted in lines that fit a terminal screen. The conversions can be made -automatically, provided a few guidelines are heeded: See item 7 of the Style -Recommendations below. - - -Style recommendations ---------------------- - - 1. The '|' character will signal a line break and therefore cannot be -used otherwise (e.g. as an 'OR' symbol). - - 2. If the prompt, options, and default strings combined leave enough -room for a reply on the same line, donot insert any newlines. - - 3. If the options string must be divided over more than one line, then -put the entire options string on lines of its own (i.e. terminate both the -prompt and options strings in a '|'); - - 4. Use blanks and semicolons to visually group the options, and use the -same grouping in the help text. Insert newlines only between groups, and put a -semicolon before such a newline. - - 5. Remember that the options string will be shown enclosed in -parentheses. Therefore donot terminate it in a semicolon. (If it ends in a '|', -that character will be shifted behind the closing parenthesis.) - - 6. Format the OPTION string in the way you want it to appear in the -prompt, remembering that the prompting routine will indent each new line by 4 -blanks: (So donot insert additional blanks in your .psc file!) - - OPTIONS=- -QUIT; COPY,CCOPY,LINE; ZERO,MANUAL,INIT,RENORM;| - -EXT,REF, IREF,FAR, IFR,MIFR, SHIFT,CLK; DX,DY,DZ, POLE,FREQ - - 7. Make sure the product of the number of options and the LENGTH for -character parameters is less than 512. (All options are extended by CPL_VALLIST -to LENGTH characters and concatenated in a local buffer defined by -PPD_OPSTR_PUT.) - - 8. Newstar's automatic line-formatting mechanism may concatenate -consecutive short lines into a longer one. It does, however, avoid improper -joining of lines by assuming that the following input line types either start a -new output line or terminate the current output line or both: - - - a line starting in whitespace, '-' or a '!' comment character: new - output line; - - - a blank line or a line consisting of a '.' only: copy literally; - - - a line containing an in-line comment or a double quote: terminate - output line. - -Similarly, a line ending in a hyphen (the DWARF 'to be continued' mark) -terminates the current output. - - - -TaTeX/Hypertext conversion of the Help texts -============================================ - - The command 'ndoc Key' translates the files - - <xxx>.psc resp. <xxx>.pef - -into LaTeX files - - $n_doc/intfc/<xxx>_private_intfc.tef - resp. $n_doc/intfc/<xxx>_public_intfc.tef - -It subsequently calls ndoc Cook to process a corresponding .tex file to produce -the hypertext document. - - (NOTE: This is a change w.r.t. the previous situation, in which only -the hypertext translation was available, consisting of one separate small .html -file per keyword. The logistics for the _intfc.tex/tef files is now entirely -identical to that for the other .tex documents, which is advantageous in many -ways.) - - -Cross references ----------------- - - To fully exploit the symmetry between LaTeX sources and the .tef files -provision is made for cross-references in the latter. These take the form of -LaTeX \textref commands on comment lines in the .psc/.pef file, e.g. - - ! {\em see also the}\textref{DWARF}{<file name>} interface description} - -Conversely, references to Help texts can be made both from other Help texts and -LaTeX documents. For this purpose, ndoc Key generates a label for each help -text: - - keyword <XXX>_<YYY>_<ZZZ> --> label .<xxx>.<yyy>.<zzz> - - -Appendix: Prompt formatting -=========================== - - The DWARF susbsytem of NEWSTAR is responsible for displaying prompt -information on the terminal and checking the user's reply. As inherited, the -formatting of the prompts was very clumsy, making them difficult to read, -particularly in those frequent cases where a large number of options must be -chosen from. - - It has proved possible by some very simple changes to give the maker of -the .psc file, - that defines the prompt and options strings -, a great deal of -control over the way a prompt is formatted. This is made possible by the fact -that - - a. Prompt and options strings are copied litterally from the .psc file -to the binary .ppd file that an executable program reads. - - b. Parsing of the options string relies on a string parameter that -defines which characters delimit inidividual options in the options string. By -extending the former string we may allow other characters than ',' to be used -as delimiters. - - c. The prompt is composed by essentially a simple concatenation of the -prompt, options and default strings and then breaking it into lines for output -on the terminal. It is easy to change the line-breaking algorithm to break -lines at a predefined delimiter character; the vertical bar '|' was chosen for -this purpose. - - It has later been found that there are other DWARF routines that assume -that a comma is the only delimiter, such as CPL_VALLIST. These seem to work -correctly, provided only that the parameter's LENGTH is defined large enough -(cf. Style recommendation number 7 above.). This can be safely done since this -attribute is only used to allocate buffer space. - - -Implementation in the prompt and reply paths --------------------------------------------- - - A schematic of the prompt and reply paths is shown in the following -diagram: - -|GP_INP -| calls GP_INP_GET -| -| GP_INP_GET -| | calls PPD_PROMPT -| | -| | PPD_PROMPT -| | calls PPD_PRSTR_GET to get <prompt string> -| | calls PPD_OPSTR_GET to get <options string> -| | returns with -| | PROMPT = <prompt string> (<options string> )' -| | appends '=<default string>' to PROMPT -| | calls DWC_INPUT with PROMPT -| | -| | |DWC_INPUT -| | | calls GEN_INPUT -| | | -| | | |GEN_INPUT -| | | | formats prompt and outputs line by line - prompt -****************************************************************************** - reply - - prompt -****************************************************************************** - reply -| | | | reads answer -| | | | detects DWC_EOFCTRLZ -| | | | returns -| | | -| | | returns -| | -| | does some checks on ANSWER -| | reprompts for some errors -| -| calls GP_INP_PARSE -| ... -| calls GP_INP_DECODE -| -| GP_INP_DECODE -| | calls PV_BLK_DECODE -| | calls PPD_CHECK -| | -| | PPD_CDHECK -| | | if options defined: -| | | calls PPD_OPSTR_MATCH -| | | -| | | PPD_OPSTR_MATCH -| | | | calls STR_MATCH_L -| | | | -| | | | STR_MATCH_L -| | | | | returns <match number> -| | | | -| | | | loop <match number> times -| | | | calls STR_SKIP_U (DELIM=',;|[]',...) -| | | | -| | | | STR_SKIP_U -| | | | | skips up to character in argt DELIM -| | | | -| | | | end loop -| | | | calls STR_SKIP_W -| | | | -| | | | STR_SKIP_W -| | | | | skips whitespace -| | | | -| | | | calls STR_COPY_U (DELIM='.;|[]',...) -| | | | -| | | | STR_COPY_U -| | | | | copies up to character in argt DELIM -| | | | -| | | |returns full OPTION -| | | -| | |end if -| | |... -| | -| |... -| |... - - - In the prompt path GP_INP_GET and PPD_PROMPT concatenate the keyword, -prompt, options and default strings in string PROMPT. These strings are taken -litterally from the .PPD file or WNDPOH without any processing except for the -insertion of a few punctuation marks to delineate the four components. All -punctuation marks in the strings are preserved. - - GEN_INPUT formats PROMPT into lines for the terminal. It interprets one -or more vertical bars '|' as a newline and does not autonomously generate any -additional newlines. Any lines after the first are indented by 4 spaces; apart -from this, the formatting is entirely controlled by the bar characters in the -strings as defined in the .psc file. No checks are made on the lengths of the -lines being output. - - The reply path uses the options string to check the reply and must -therefore recognise all punctuation characters. This is realised extremely -simply by including them in the DELIM argument so STR_SKIP_U and STR_COPY_U diff --git a/hlp/psctest.txt b/hlp/psctest.txt deleted file mode 100644 index 3f5ad6b78d3f9c12bbc1a7c587ef3d6ecad921f6..0000000000000000000000000000000000000000 --- a/hlp/psctest.txt +++ /dev/null @@ -1,82 +0,0 @@ - - -psctest.csh -=========== - - Options to: - - - Create a .pst file by running program under manual control. - - - Create reference numbers on the parameter lines. - - - Run program under control of a .pst file: - = Including backtrack paths - = Including on-line help requests at first appearance of each - parameter. - = Using only a certain range of parameter lines - = In /ASK mode including hidden parameters - - - -.pst file -========= - - Consists of: - - - Preamble: a csh script, ending in the line 'exit'. This script is -executed by psctest.csh to set up initial conditions (i.e. verify accessibility -of input files, remove left-over output files etc.). - - - Parameter input: Lines of the form - - <blanks>[*]<blanks><KEYWORD> = <value> ! <number> - -The lines are indented corresponding to the 'level' of the parameter in its -local context. The asterix is positioned at the level of a preceding parameter -that is the target for a backtrack request. - - - Comment lines starting in a '!'. - - - The simplest way to generate an initial .pst file is through - - psctest -m <program> - -The file may then be manually edited to e.g. - - - insert the initialising script; - - - remove spurious parts (e.g. backtracks accidentally made in the manual - run); - - - change improper backtrack targets to what they should be (Of course, - corresponding changes must be made in the program code!). - -After a change in the parameter lines, they may be renumbered through - - psctest -n. - - -Special cases -============= - -Unconditional backtracking --------------------------- - - To be realised by listing the parameters through which the backtrack is -made with '#' input, at the proper indentation (i.e. indents for a backtrack -chain decrease downward). Do not include '*' backtrack marks! - - -Repetition loop ---------------- - - Occurs e.g. in NSCAN LOAD, NMAP MAKE. Append indices in [] to the -parameter name to show the cycle number. Continue increasing indentation -throughout the loop. - - -Hidden parameters ------------------ - - To be indented at the same level as the subsequent visible parameter. diff --git a/hlp/qube.txt b/hlp/qube.txt deleted file mode 100644 index e6a427d215fc65e17dc4fbc9c28d5cde7e878d25..0000000000000000000000000000000000000000 --- a/hlp/qube.txt +++ /dev/null @@ -1,226 +0,0 @@ -QUBES: Software to make SCN-file UV-data available in various sort orders -------------------------------------------------------------------------- -History: - Contributed by WNB, 940810 - WNB 940812: add interferometer errors - - -Summary (JPH 940810) - - This note documents software created by WNB during his 1994 visit at NFRA as infrastructure for the program NFILTER.) - - -1. Introduction - -To be able to read a one-directional data vector from the Scan data in -any of the possible coordinate direction, a number of NSCQ.. routines -are available, replacing in essence NSCSCR and NMOMU4 and their -initialisers. -The possible directions are: frequency(f), ha(t), interferometer(i). No -possibilty to go in the direction of Mosaic fields has been built in, -mainly because different mosaic fields have no identical ha's: the -4-dimensional structure (mosaic,f,t,i) is not a regular hypercube. -The structure chosen assumes that the dataset to be considered -consists of a series of 3-d cubes (f,t,i) at different mosaic points. -In principle extension to a series of (mosaic,f,i) cubes at different -ha's would be feasable. -A field in the above is a set of observations at the same position on -the sky, with identical (number of) frequencies, interferometers and -hour angles. Note: the actual check on the number of hour angles is -not extensive, to limit the sorting problems, but with actual WSRT -observations this should not be a problem. -An example of the actual use is given in NFIUVL.for, which at the -moment is a simple test program, not an actual UVLIN. - -2. Routines - -To write a program using the NSCQ routines, the basic structure of the -program is identical to programs using NSCSCR, i.e. scans in the -i-direction. The user parameters used by the NSCQ routines are the -same: Node, Sets and, possibly, Loops. Other selection parameters can -be used in the same way as in other programs, and model data has to be -initialised in the same way as well (i.e. NMODAX, NMOMUI and NMOMSC/L -have to be used before the actual data loops can start). - - -To set the field a (short) description of the standard program -structure as it is now (*=optional): - -while WNDXLN do all specified loops(*) - NMOMSL calculate scan model(*) - while NSCSTL do all sectors - NSCSIF get interferometer table(*) - NSCMBL get baseline table(*) - NCARRT get redundant baseline(*) - NMORDH get model parameters(*) - NMOMST calculate some model parameters(*) - for i=ha-range go through (selected) ha scans - NSCSCR get corrected scan data - NMOMUV calculate UV coordinates for scan (*) - NMOMU4 calculate model for scan(*) - action including e.g. NSCSWI - end - end -end - -The structure to go through data in different order is comparable: - -while WNDXLN do all specified loops(*) - NMOMSL calculate scan model(*) - NSCQOP prepare SETs for reading - while NSCQFN get next field in 4-d structure (and - coordinate tables) and select - coordinate order - NSCMBL get baseline table(*) - NCARRT get redundant baselines (*) - - for i=first selected coordinate - for j=second selected coordinate - NSCQSR read selected (pseudo-)scan along 3rd coord - and model, if selected in QFN - action including e.g. NSCQWA/M - end - end - end - NSCQCL close Qube control area -end - -routines to calculate e.g. UV-coordinates etc for the pseudo scans are -easily added if necessary. - - -3. Description interface - - -- NSCQOP_L( QUA_J:O, Qube control area ptr - FCA_J:I, (Scan) file control area - SETS_J(0:SOF__N-1,0:*):I, SETs selected by user - LPOFF_J(0:SOF__N-1) Current Loop offsets - INFO_J(QINFO__L:QINFO__H):O Info about 4-d qube - ) - -QOP analyses the SETs (using also the loop info (LPOFF) and Scan file -(FCA), and makes a sorted list of all Sector pointers. It also -reserves buffers for later use. -The QUA is a pointer to the control area to be used in all subsequent -Q calls. -The INFO array returns the following information (parameters in -CBITS_DEF): - INFO(QINFO_FLD) number of different fields - INFO(QINFO_F) max. number of frequencies found in all fields - INFO(QINFO_T) max. # ha - INFO(QINFO_I) max. # ifrs - -Note: the system works fastest if field selection is done by the Loop -structure. - - -- NSCQCL_L( QUA_J:IO, Qube control area ptr - FCA_J:I, Scan file control area - SETS_J(0:SOF__N-1,0:*):I SETs selected by user - ) - -QCL frees all the buffers and temporary files used - - -- NSCQFN_L( QUA_J:I, Qube control area ptr - FCA_J:I, Scan file control area - ORDER_J:I, Order of data reading - STH_B(0:STH__L-1):O, A Sector header - INFO_J(QINFO__L:QINFO__H):O, Info about 4-d qube - PINFO_J(QINFO__L:QINFO__H):O Pointer to Info about 4-d qube - ) - -QFN selects the next field for processing (or is .false. if no more). -It uses the QUA and FCA, and the ORDER specified. The ORDER can be: - QUB_FTI [+QUB_M] [+QUB_OUT] - TFI - TIF - ITF - FIT - IFT -The ..I uses no sorting file, the I.. may use a large sorting file. -The coding is: I=interferometer, F=frequency, T=ha. The last code -specifies the direction of the 'scan' produced (i.e. FTI is the -'normal' order, TIF produces a scan along the frequency axis); the 1st -code specifies the highest loop direction the user wants to use. Note: -you can loop in a different order than specified, but this will be -rather inefficient in general. -The _M modifier (e.g. QUB_TIF+QUB_M) will in addition to the data also -generate the model data in the same 'scan' direction. -The _OUT modifier will prepare and enable the writing of -interferometer errors. - -The STH returned is one of the STHs of the field. I.e., the -coordinates, number of interferometers etc will be correct, but time, -frequency, ha and data depended on these will be random. It can, -however, be used in routines like NSCMBL. - -The INFO returned is identical to that for QOP, but now the actual -field number(1..), and axis lengths for this field are returned. - -The PINFO (at QINFO_T, QINFO_I, QINFO_F) returns pointers to tables -with the actual coordinates along the axes. These values can be -addressed as: - A_I(PINFO(QINFO_I)+n_i) interferometer codes - A_E(PINFO(QINFO_T)+n_t) ha values - A_D(PINFO(QINFO_F)+n_f) frequencies -with n=0,INFO(QINFO_x)-1 - - -- NSCQFR_L( QUA_J:I, Qube control area ptr - FCA_J:I Scan file control area - ) - -QFR resets the field search to the start of the field list - - -- NSCQSR_L( QUA_J:I, Qube control area ptr - FCA_J:I, Scan file area - AX1_J:I, 1st axis to read - AX2_J:I, 2nd axis to read - CAP_J:I, apply bits - CDAP_J:I, de-apply bits - PWGT_J:O, pointer to scan weights - PDAT_J:O, pointer to scan data - PMOD_J:O, pointer to scan model - POUT_J:O, pointer to area to put - ifr errors - ) - -QSR reads a (pseudo-)scan along the 3rd axis selected in QFN at the -position specified by AX1 and AX2 (axis types determined in QFN). I.e. -with QUB_TIF and AX1,AX2=300,2 a frequency scan will be produced for -the second interferometer in the interferometer table at the 300th ha -point (values for the axes can be 0..INFO(corresponding)-1). - -The data is returned by a pointer to an array. These arrays have -dimensions (0:3,0:length scan-1). Note: the index order is different -from that returned by NSCSCR and NMOCIX, for obvious reasons. -If n_p is the polarisation (0..3) wanted and n_d the data point -(0..INFO()-1),the data can be accessed by: - A_E(PWGT+4*n_d+n_p) - A_X(PDAT+4*n_d+n_p) - A_X(PMOD+4*n_d+n_p) -Interferometer error data (if QUB_OUT included in QFN) can be put into -the array pointed to by POUT, and accessed by: - A_X(POUT+4*n_d+n_p) - -Note: the PMOD has only a valid value if QUB_M was used in QFN -Note: the model data are already converted to XYX format - - -- NSCQWA_L( QUA_J:I, Qube control area ptr - NSCQWM_L FCA_J:I, Scan file area - AX1_J:I, 1st axis to write - AX2_J:I, 2nd axis to write - CAP_J:I, apply bits - CDAP_J:I de-apply bits - ) - -QWA will write the additive interferometer errors set (in pseudo-scan -order in the array POUT obtained from QSR) to the scan data file. -QWM the multiplicative interferometer errors. - - -wnb/940812 diff --git a/hlp/readme.txt b/hlp/readme.txt deleted file mode 100755 index eeb127595e2d68a5b1621fd012d42d2f0a1d46ed..0000000000000000000000000000000000000000 --- a/hlp/readme.txt +++ /dev/null @@ -1,83 +0,0 @@ -Updated December 4 1995 -Ger de Bruyn - -This directory contains MDL files for the primary and secondary WSRT -flux density and position calibrators at the wavelengths of 6cm (4874 -MHZ), 21cm (1412 MHz), 49cm (608.8 MHz) and 92cm (325.125 MHz). - -The WSRT flux density scale is based on the Baars et al. (Astron. -Astrophys. 61, 104, 1977) scale values for the source 3C286. 3C286 -is not known to be variable to more than 1%. The secondary -calibrators 3C48 and 3C147 are, however, known to be variable, by -about a few %, at wavelengths of 6 and 21 cm, and possibly also at -longer wavelengths. The values in the models may therefore have to be -changed somewhat. At 92cm we also have included models for 3C295 and -3C345. 3C295 is a double radio source (4" separation) that CANNOT -vary on human timescales (the source is tens of kpc in diameter) and -will be used in the future to check the variability of all other -calibrators. At 6cm and 21cm 3C295 is strongly resolved across the -array and is therefore less suitable as a calibrator. The source -3C345 is polarized (about 3% at 92cm) and can be used to check any -phase-difference between the X and Y dipoles. In the future we hope to -make regular observations at 92cm of either this source or other -polarized calibrators (e.g. 3C303). - -At frequencies different from the normal ones the values will have to -be changed according to the spectral index of the source. Especially -for 21cm line observations at large heliocentric velocities the -correction may be several % and should not be neglected. The values -for the spectral index (spectral index = dlog(S)/dlog(freq) are: - at 6cm: 3C48 -0.95, 3C147 -0.91, 3C286 -0.62 - at 21cm: 3C48 -0.84, 3C147 -0.70, 3C286 -0.45 - at 92cm: 3C48 -0.68, 3C147 -0.62, 3C286 -0.34, 3C295 -0.60 - -At 49 cm the band is so narrow that you will never have to worry about -the spectral index. - -Especially the low-frequency models contain a varying numbers of -background sources. The fluxdensities of these background sources -obviously need to be adjusted for the frequency dependent primary -beamwidth. You can do this using NMODEL, option FEDIT. This option -will then ask you for a reference epoch (use B1950) and a SCN-file -from which it gets the pointing centre of the calibrator observation. -It then scales the background sources using a COS(cfr)**6 function -(where c=0.0629, r is the radius in degrees and f is the frequency in -MHz) which assumes that the primary beams scale with frequency. This -is a good first order approximation. - -(The spectral indices at 92cm are only approximate. Most of the WSRT -calibrators are socalled SSC sources which show a spectral turnover -around 100-200 MHz). - - -When doing bandpass calibration in line observations it is strongly -advised to use a frequency INDEPENDENT value of the flux density. The -models in this directory do not have a spectral index, so this will be -the default when you use these models for calibration. The reference -frequency in the header of the model is therefore not used. (Note -that if you would use a spectral index then each source in the -synthesized field will adopt the spectral index of the calibrator and -when you subtract images from two sides of the band then part of the -source, and all its side/grating lobes, will remain in the image). - -However, it is possible to give the calibrator a spectral index using -the EDIT command in NMODEL (first go to the MODIFY subgroup of -keywords). (If you want to give all sources in the model the same -spectral index you can use the FEDIT option). This could be useful -when you have data with the broadband 92cm DCB (which permits -observations from 300 -390 MHz) and you want to determine real -spectral indices for sources in your field. But if you wish to -conduct bandwidth synthesis with the broadband 92cm system then again -it is best to only change the models for the different primary beams -but not for the intrinsic spectral index. - - -If you have any questions about using the calibrator models I refer to -NEWSTAR recipe #13 (to be written), or contact me (Ger de Bruyn, -0521-595257, ger@astron.nl)). - - - - - - diff --git a/hlp/remote_tape.txt b/hlp/remote_tape.txt deleted file mode 100644 index 3956a7be5403d63f87c9d40047b662518ed70a31..0000000000000000000000000000000000000000 --- a/hlp/remote_tape.txt +++ /dev/null @@ -1,66 +0,0 @@ - -Transparent reading of the Optical Disks with Newstar ------------------------------------------------------ - -It is now possible to access the optical disk units that are -connected to the VAX while working on a Unix machine. - -In Dwingeloo, the following tape-devices have been defined: - - MAG4 //rzmvx4.astron.nl:1100/RZMVX4$MUA0 - MAG5 //rzmvx4.astron.nl:1101/RZMVX4$MUA1 - -These devives allow you to read data from the units MUA0 and MUA1 -as if they were connected to your Unix machine. - -If you work on e.g. rzmws10 and you want to get data from MUA0, -just run NSCAN and specify unit 4. - - -Note 1: Implementation - - Transparent reading is implemented by a server on the VAX and - an extension of the tape-handling routines in Newstar. - The server on the VAX is USER5:[DEVOSCM.RMTD]RMTD.EXE - The server has to be started on two ports, this can be done - by including in the system-startup: - - @user5:[devoscm.rmtd]rmtd_start.com - - which will submit two jobs on RZMVX4_BATCH. - - The names of the remote units have been defined in the startup file - $n_src/sys/newstar_nfra.csh - - The routines changed for the implementation are $n_src/wng/wnftrw.cun - and $n_src/wng/wnf???_x.cun. The code for the client side of the - network is in wnftrw.cun. The changes in the other files are: (1) all - calls to open, close, read and write now go through a routine in - wnftrw.cun and (2) all calls to routines wnftrw pass the MCA (not FCA) - -Note 2: Suggested testing - - To test the reliability of the transparent tape-reading I suggest - the following. During the next week, all files read from Optical Disk - by the Reduction Group are read two times and then compared - - 1e. Unix: NSCAN LOAD UNIT=4 or 5 - - 2e. VAX: NSCAN LOAD UNIT=4 or 5 - Unix: ftp SCN-file - NSCAN CVX - - 3e. Unix: ~devoscm/tst.csh File1.SCN File2.SCN - - If the files have been loaded identically, no differences should appear. - The tst.csh procedure ignores differences of 1 unit in the data, since - they can be produced by rounding errors during the time-averaging. - - Any differences should be reported to Marco de Vos. - - After testing some 10 SCN files, we are sure that no systematic errors - take place. The remaining test is on reliability of the connection over - a longer period. This can be tested by using only the Unix version of - Newstar to read data from the archive. After a month, we will have a - good impression of the reliability. - diff --git a/hlp/scn_sets.ps b/hlp/scn_sets.ps deleted file mode 100644 index 101b9dba1f3241f8b7e34bcfab36b165be80aece..0000000000000000000000000000000000000000 --- a/hlp/scn_sets.ps +++ /dev/null @@ -1,44 +0,0 @@ -%!PS-Adobe-2.0 EPSF-2.0 -%%Title: scn_sets.tmp -%%Creator: fig2dev -%%CreationDate: Wed Nov 23 11:45:07 1994 -%%For: jph@rzmws0 (johan hamaker) -%%BoundingBox: -10 -10 496 69 -%%Pages: 0 -%%EndComments -/$F2psDict 200 dict def -$F2psDict begin -$F2psDict /mtrx matrix put -/l {lineto} bind def -/m {moveto} bind def -/s {stroke} bind def -/n {newpath} bind def -/gs {gsave} bind def -/gr {grestore} bind def -/clp {closepath} bind def -/graycol {dup dup currentrgbcolor 4 -2 roll mul 4 -2 roll mul -4 -2 roll mul setrgbcolor} bind def -/col-1 {} def -/col0 {0 0 0 setrgbcolor} bind def -/col1 {0 0 1 setrgbcolor} bind def -/col2 {0 1 0 setrgbcolor} bind def -/col3 {0 1 1 setrgbcolor} bind def -/col4 {1 0 0 setrgbcolor} bind def -/col5 {1 0 1 setrgbcolor} bind def -/col6 {1 1 0 setrgbcolor} bind def -/col7 {1 1 1 setrgbcolor} bind def - end -/$F2psBegin {$F2psDict begin /$F2psEnteredState save def} def -/$F2psEnd {$F2psEnteredState restore end} def -%%EndProlog - -$F2psBegin -0 setlinecap 0 setlinejoin --162.0 270.0 translate 0.900 -0.900 scale -0.500 setlinewidth -% Polyline -n 719 299 m 719 234 l 179 234 l 179 299 l clp gs col-1 s gr -/Times-Italic findfont 20.00 scalefont setfont -194 279 m -gs 1 -1 scale (This is a dummy in place of scn_sets.ps) col-1 show gr -$F2psEnd diff --git a/hlp/scnnode/scnnode__output_scn_node.html b/hlp/scnnode/scnnode__output_scn_node.html deleted file mode 100644 index 7baae69b04cd36ad6c90e9072ad9bb972ec987aa..0000000000000000000000000000000000000000 --- a/hlp/scnnode/scnnode__output_scn_node.html +++ /dev/null @@ -1,18 +0,0 @@ -<TITLE>Description of OUTPUT_SCN_NODE (SCNNODE)</TITLE> -<H1>Description of general keyword OUTPUT_SCN_NODE</H1> - -<DT><EM>Prompt:</EM> Output .SCN file name -<DT><EM>Expected input:</EM> Character(80).<P> - Specify the file name (no extension). <P> -You may enter <P> - [<directory>/]** <P> -to get a list of .SCN files in your current or another directory; then enter <P> - #<n> <P> -to select the <n>'th file from that list. <P> - - <H3> More information: </H3> <UL> -<LI><A HREF="../scnnode/scnnode_comm.html">List of general keywords</A> for SCNNODE -<LI>Description of the <A HREF="../scn_descr/scn_descr.html">SCN file format</A> -<LI><A HREF="../homepage.html">NEWSTAR Documentation Home page</A> -<LI>The <A HREF="../common_descr/common_descr.html">DWARF User Interface</A> -</UL> diff --git a/hlp/scnnode/scnnode__scn_node.html b/hlp/scnnode/scnnode__scn_node.html deleted file mode 100644 index 909012e3deabf796e0984eae2d12cc9c46b1ad40..0000000000000000000000000000000000000000 --- a/hlp/scnnode/scnnode__scn_node.html +++ /dev/null @@ -1,34 +0,0 @@ -<TITLE>Description of SCN_NODE (SCNNODE)</TITLE> -<H1>Description of general keyword SCN_NODE</H1> - -<DT><EM>Prompt:</EM> .SCN file name -<DT><EM>Expected input:</EM> Character(80).<P> - Specify the file name (no extension). <P> -You may enter <P> - [<directory>/]** <P> -to get a list of .SCN files in your current or another directory; then enter <P> - #<n> <P> -to select the <n>'th file from that list. -"! -!---------------------------------------------------------------------------- -! Ref: -! -KEYWORD=INPUT_SCN_NODE - DATA_TYP=C - IO=I - LENGTH=80 - SWITCHES=LOOP, NULL_VALUES, WILD_CARDS - SEARCH=L, P - PROMPT="Input .SCN file name Specify the file name (no extension). <P> -You may enter <P> - [<directory>/]** <P> -to get a list of .SCN files in your current or another directory; then enter <P> - #<n> <P> -to select the <n>'th file from that list. - - <H3> More information: </H3> <UL> -<LI><A HREF="../scnnode/scnnode_comm.html">List of general keywords</A> for SCNNODE -<LI>Description of the <A HREF="../scn_descr/scn_descr.html">SCN file format</A> -<LI><A HREF="../homepage.html">NEWSTAR Documentation Home page</A> -<LI>The <A HREF="../common_descr/common_descr.html">DWARF User Interface</A> -</UL> diff --git a/hlp/scnnode_comm/scnnode_comm.html b/hlp/scnnode_comm/scnnode_comm.html deleted file mode 100644 index f01325141eb961d926d2a268d04250caa125e90a..0000000000000000000000000000000000000000 --- a/hlp/scnnode_comm/scnnode_comm.html +++ /dev/null @@ -1,17 +0,0 @@ -<TITLE>Index of general keywords from SCNNODE</TITLE> -<H1>Description of general keywords (SCNNODE)</H1> - -<UL> -<LI> <A HREF="../scnnode/scnnode__scn_node.html"> - SCN_NODE</A> - .SCN file name -<LI> <A HREF="../scnnode/scnnode__output_scn_node.html"> - OUTPUT_SCN_NODE</A> - Output .SCN file name -</UL> - - - <H3> More information: </H3> <UL> -<LI><A HREF="../homepage.html">NEWSTAR Documentation Home page</A> -<LI><A HREF="../hb_contents/hb_contents.html">The NEWSTAR Cookbook</A> -</UL> diff --git a/hlp/scnsets/scnsets__scn_sets.html b/hlp/scnsets/scnsets__scn_sets.html deleted file mode 100644 index e69de29bb2d1d6434b8b29ae775ad8c2e48c5391..0000000000000000000000000000000000000000 diff --git a/hlp/scnsets_comm/scnsets_comm.html b/hlp/scnsets_comm/scnsets_comm.html deleted file mode 100644 index e69de29bb2d1d6434b8b29ae775ad8c2e48c5391..0000000000000000000000000000000000000000 diff --git a/hlp/select/select__ha_range.html b/hlp/select/select__ha_range.html deleted file mode 100644 index 4d653bfe5ffd2a2edc793387692b5df4d85c6625..0000000000000000000000000000000000000000 --- a/hlp/select/select__ha_range.html +++ /dev/null @@ -1,12 +0,0 @@ -<TITLE>Description of HA_RANGE (SELECT)</TITLE> -<H1>Description of general keyword HA_RANGE</H1> - -<DT><EM>Prompt:</EM> HA range -<DT><EM>Expected input:</EM> Real number in DEG, RAD, CIR, HMS, 2 values; min.value: -180.000000; max.value: 180.000000.<P> - Specify the hour-angle range to be selected <P> - - <H3> More information: </H3> <UL> -<LI><A HREF="../select/select_comm.html">List of general keywords</A> for SELECT -<LI><A HREF="../homepage.html">NEWSTAR Documentation Home page</A> -<LI>The <A HREF="../common_descr/common_descr.html">DWARF User Interface</A> -</UL> diff --git a/hlp/select/select__select_ifrs.html b/hlp/select/select__select_ifrs.html deleted file mode 100644 index e69de29bb2d1d6434b8b29ae775ad8c2e48c5391..0000000000000000000000000000000000000000 diff --git a/hlp/select/select__select_xyx.html b/hlp/select/select__select_xyx.html deleted file mode 100644 index 5b0b64a315e2be5f0683951a63d9998a71f51f23..0000000000000000000000000000000000000000 --- a/hlp/select/select__select_xyx.html +++ /dev/null @@ -1,19 +0,0 @@ -<TITLE>Description of SELECT_XYX (SELECT)</TITLE> -<H1>Description of general keyword SELECT_XYX</H1> - -<DT><EM>Prompt:</EM> XYX, XY, Y, X, YX, YYX, XXY polarisations -<DT><EM>Expected input:</EM> Character(4).<P> - Select the polarisation(s) to be used: <P> - XYX all four combinations (XX, YX, YX, YY) - XY XX and YY - X XX only - Y YY only - YX XY and YX - YYX YX - XXY XY <P> - - <H3> More information: </H3> <UL> -<LI><A HREF="../select/select_comm.html">List of general keywords</A> for SELECT -<LI><A HREF="../homepage.html">NEWSTAR Documentation Home page</A> -<LI>The <A HREF="../common_descr/common_descr.html">DWARF User Interface</A> -</UL> diff --git a/hlp/select_comm/select_comm.html b/hlp/select_comm/select_comm.html deleted file mode 100644 index e69de29bb2d1d6434b8b29ae775ad8c2e48c5391..0000000000000000000000000000000000000000 diff --git a/hlp/spefu_type_categ.txt b/hlp/spefu_type_categ.txt deleted file mode 100644 index 6c32b3447afb2353a2a4b13530a14f0863b1a434..0000000000000000000000000000000000000000 --- a/hlp/spefu_type_categ.txt +++ /dev/null @@ -1,65 +0,0 @@ -List of codes in the OHW-fields SPEFU, TYPE, CATEG --------------------------------------------------- - (original Dutch source unknown, - translated litterally into English by JPH, 940621) - -History: - JPH 940914 Format corrections - - - The OH (Observation Header) of an observation file on a WSRT tape is -copied literally into a OHW block asspociated with one or more Sectors in a -.SCN file. It contains several fields describing the natiure of the -observation. The meaning of the ASCII that may occur in these fields is -tabulated below. - - SPEFU= Meaning - ------ ------- - PT Pointing observation - HO Holog observation - OF Offset observation - VL VLBI observation - MO Mosaiking observation - PD Pulsar observation (DCB) - DF Delay offset observation (DCB) - LO LO sweep observation - FS FS frequency switching observation - SD Switched dipole observation - NO No special observation - - - - - TYPE - 1st char Meaning 2nd char Meaning - -------- ------- -------- ------- - C Other A Supplememt to N,M,P or F - F Frequency switch. B Baseline (for C) - M Mosaicking C Gain/phase (for C) - N Norm. astr. D Dipole switch (for C) - P Pulsar E Extinction (for C) - V VLBI F Phase only (for C) - G Gain only (for C) - H Holog (for C) - L LO-delay (for C) - M Monitoring (for N) - N New (for N,M,P of F) - O Redo (for N,M,P of F) - P Parallax (for N of C) - Q Offset (for C) - R Pointing (for C) - S System temp. (for C) - T General Test (for C) - U Universal (for C) - V Videoband (for C) - W Delay (for C) - - - - CATEG= Meaning - ------ ------- - I Instrumental, including all calibrations - N Astronomy: Nearby galaxies - S Astronomy: Solar System - G Astronomy: Galactic Object - E Galactic astronomy not covered by N diff --git a/hlp/unit/unit__input_unit.html b/hlp/unit/unit__input_unit.html deleted file mode 100644 index 352985c48b2a745879c3f331afe03adc613dbce8..0000000000000000000000000000000000000000 --- a/hlp/unit/unit__input_unit.html +++ /dev/null @@ -1,32 +0,0 @@ -<TITLE>Description of INPUT_UNIT (UNIT)</TITLE> -<H1>Description of general keyword INPUT_UNIT</H1> - -<DT><EM>Prompt:</EM> 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, D input 'tape' unit: number or 'D' for 'disk' | -<DT><EM>Expected input:</EM> Character(1).<P> - Specify the input unit for your data: <P> - 0, ..9 Tape/optical disk/DAT unit - D Disk <P> -The correspondence between the unit numbers and the devices on your host -machine is defined by the environment variables MAG<n>. The list below shows -the values with which NEWSTAR is distributed, but your local installation may -be different, so you do wello to check with your local site manager <P> - classic 0.5-inch magtape: - 0 1600 bpi - 1 6250 bpi - 2 800 bpi <P> - optical disk, formatted as a magtape: - 4 - 5 <P> - DAT, ExaByte or similar tape: - 6 - 7 - 8 - 9 <P> -You may enter '*' to get a list of unit numbers available for you, but this -will not tell you to what physical devices these correspond. <P> - - <H3> More information: </H3> <UL> -<LI><A HREF="../unit/unit_comm.html">List of general keywords</A> for UNIT -<LI><A HREF="../homepage.html">NEWSTAR Documentation Home page</A> -<LI>The <A HREF="../common_descr/common_descr.html">DWARF User Interface</A> -</UL> diff --git a/hlp/unit/unit__output_unit.html b/hlp/unit/unit__output_unit.html deleted file mode 100644 index 388a40827d2247dc6c6d3cfc7622ade844a1ab18..0000000000000000000000000000000000000000 --- a/hlp/unit/unit__output_unit.html +++ /dev/null @@ -1,32 +0,0 @@ -<TITLE>Description of OUTPUT_UNIT (UNIT)</TITLE> -<H1>Description of general keyword OUTPUT_UNIT</H1> - -<DT><EM>Prompt:</EM> output 'tape' unit: number or 'D' for 'disk' | 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, D -<DT><EM>Expected input:</EM> Character(1).<P> -Specify the input unit for your data: <P> - 0, ..9 Tape/optical disk/DAT unit - D Disk <P> -The correspondence between the unit numbers and the devices on your host -machine is defined by the environment variables MAG<n>. The list below shows -the values with which NEWSTAR is distributed, but your local installation may -be different, so you do wello to check with your local site manager <P> - classic 0.5-inch magtape: - 0 1600 bpi - 1 6250 bpi - 2 800 bpi <P> - optical disk, formatted as a magtape: - 4 - 5 <P> - DAT, ExaByte or similar tape: - 6 - 7 - 8 - 9 <P> -You may enter '*' to get a list of unit numbers available for you, but this -will not tell you to what physical devices these correspond. - - <H3> More information: </H3> <UL> -<LI><A HREF="../unit/unit_comm.html">List of general keywords</A> for UNIT -<LI><A HREF="../homepage.html">NEWSTAR Documentation Home page</A> -<LI>The <A HREF="../common_descr/common_descr.html">DWARF User Interface</A> -</UL> diff --git a/hlp/unit/unit__output_volume.html b/hlp/unit/unit__output_volume.html deleted file mode 100644 index c2c44c48bfccd70dc10cf652ed336325c957fcf3..0000000000000000000000000000000000000000 --- a/hlp/unit/unit__output_volume.html +++ /dev/null @@ -1,13 +0,0 @@ -<TITLE>Description of OUTPUT_VOLUME (UNIT)</TITLE> -<H1>Description of general keyword OUTPUT_VOLUME</H1> - -<DT><EM>Prompt:</EM> Output volume name -<DT><EM>Expected input:</EM> Character(6).<P> -Specify the full name for the output volume. <P> -This name is used for the administration in MEDIAD <P> - - <H3> More information: </H3> <UL> -<LI><A HREF="../unit/unit_comm.html">List of general keywords</A> for UNIT -<LI><A HREF="../homepage.html">NEWSTAR Documentation Home page</A> -<LI>The <A HREF="../common_descr/common_descr.html">DWARF User Interface</A> -</UL> diff --git a/hlp/unit/unit__overwrite.html b/hlp/unit/unit__overwrite.html deleted file mode 100644 index d543920e1601cdc334eff0abfee511d6c522b58f..0000000000000000000000000000000000000000 --- a/hlp/unit/unit__overwrite.html +++ /dev/null @@ -1,14 +0,0 @@ -<TITLE>Description of OVERWRITE (UNIT)</TITLE> -<H1>Description of general keyword OVERWRITE</H1> - -<DT><EM>Prompt:</EM> Overwrite (YES/NO) -<DT><EM>Default:</EM> YES /ASK. -<DT><EM>Expected input:</EM> Logical.<P> -Specify if one wants to overwrite the current label (YES) or not (NO). <P> -BEWARE: All subsequent labels will also be overwritten. - - <H3> More information: </H3> <UL> -<LI><A HREF="../unit/unit_comm.html">List of general keywords</A> for UNIT -<LI><A HREF="../homepage.html">NEWSTAR Documentation Home page</A> -<LI>The <A HREF="../common_descr/common_descr.html">DWARF User Interface</A> -</UL> diff --git a/hlp/unit/unit__unit.html b/hlp/unit/unit__unit.html deleted file mode 100644 index 46d602289a0e9e24221cff38a5539f31c6cb33f6..0000000000000000000000000000000000000000 --- a/hlp/unit/unit__unit.html +++ /dev/null @@ -1,32 +0,0 @@ -<TITLE>Description of UNIT (UNIT)</TITLE> -<H1>Description of general keyword UNIT</H1> - -<DT><EM>Prompt:</EM> 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, D 'tape' unit: number or 'D' for 'disk' | -<DT><EM>Expected input:</EM> Character(1).<P> - Specify the input unit for your data: <P> - 0, ..9 Tape/optical disk/DAT unit - D Disk <P> -The correspondence between the unit numbers and the devices on your host -machine is defined by the environment variables MAG<n>. The list below shows -the values with which NEWSTAR is distributed, but your local installation may -be different, so you do well to check with your local site manager <P> - classic 0.5-inch magtape: - 0 1600 bpi - 1 6250 bpi - 2 800 bpi <P> - optical disk, formatted as a magtape: - 4 - 5 <P> - DAT, ExaByte or similar tape: - 6 - 7 - 8 - 9 <P> -You may enter '*' to get a list of unit numbers available for you, but this -will not tell you to what physical devices these correspond. <P> - - <H3> More information: </H3> <UL> -<LI><A HREF="../unit/unit_comm.html">List of general keywords</A> for UNIT -<LI><A HREF="../homepage.html">NEWSTAR Documentation Home page</A> -<LI>The <A HREF="../common_descr/common_descr.html">DWARF User Interface</A> -</UL> diff --git a/hlp/unit/unit__volume_type.html b/hlp/unit/unit__volume_type.html deleted file mode 100644 index 3f3ea7c43ae16d783abfb305c5e3b305c3cc4549..0000000000000000000000000000000000000000 --- a/hlp/unit/unit__volume_type.html +++ /dev/null @@ -1,18 +0,0 @@ -<TITLE>Description of VOLUME_TYPE (UNIT)</TITLE> -<H1>Description of general keyword VOLUME_TYPE</H1> - -<DT><EM>Prompt:</EM> Abbreviated medium type -<DT><EM>Expected input:</EM> Character(4).<P> -Specify the type for the output volume. <P> -This name is used for the administration in MEDIAD <P> -<DT><STRONG> DOD</STRONG> - DEC Optical Disk -<DT><STRONG> DAT</STRONG> - Digital Audio Tape -<DT><STRONG> 800</STRONG> - 9-track tape, 800 bpi -<DT><STRONG> 1600</STRONG> - 9-track tape, 1600 bpi -<DT><STRONG> 6250</STRONG> - 9-track tape, 6250 bpi <P> - - <H3> More information: </H3> <UL> -<LI><A HREF="../unit/unit_comm.html">List of general keywords</A> for UNIT -<LI><A HREF="../homepage.html">NEWSTAR Documentation Home page</A> -<LI>The <A HREF="../common_descr/common_descr.html">DWARF User Interface</A> -</UL> diff --git a/hlp/unit_comm/unit_comm.html b/hlp/unit_comm/unit_comm.html deleted file mode 100644 index ba015208d77543204868552748a3d5c6169070b1..0000000000000000000000000000000000000000 --- a/hlp/unit_comm/unit_comm.html +++ /dev/null @@ -1,29 +0,0 @@ -<TITLE>Index of general keywords from UNIT</TITLE> -<H1>Description of general keywords (UNIT)</H1> - -<UL> -<LI> <A HREF="../unit/unit__unit.html"> - UNIT</A> - 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, D 'tape' unit: number or 'D' for 'disk' | -<LI> <A HREF="../unit/unit__input_unit.html"> - INPUT_UNIT</A> - 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, D input 'tape' unit: number or 'D' for 'disk' | -<LI> <A HREF="../unit/unit__output_unit.html"> - OUTPUT_UNIT</A> - output 'tape' unit: number or 'D' for 'disk' | 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, D -<LI> <A HREF="../unit/unit__output_volume.html"> - OUTPUT_VOLUME</A> - Output volume name -<LI> <A HREF="../unit/unit__volume_type.html"> - VOLUME_TYPE</A> - Abbreviated medium type -<LI> <A HREF="../unit/unit__overwrite.html"> - OVERWRITE</A> - Overwrite (YES/NO) -</UL> - - - <H3> More information: </H3> <UL> -<LI><A HREF="../homepage.html">NEWSTAR Documentation Home page</A> -<LI><A HREF="../hb_contents/hb_contents.html">The NEWSTAR Cookbook</A> -</UL> diff --git a/hlp/wmpnode/wmpnode__output_wmp_node.html b/hlp/wmpnode/wmpnode__output_wmp_node.html deleted file mode 100644 index 84acb0bf0616d5e3e5a3ad54d41feea2d294b25d..0000000000000000000000000000000000000000 --- a/hlp/wmpnode/wmpnode__output_wmp_node.html +++ /dev/null @@ -1,15 +0,0 @@ -<TITLE>Description of OUTPUT_WMP_NODE (WMPNODE)</TITLE> -<H1>Description of general keyword OUTPUT_WMP_NODE</H1> - -<DT><EM>Prompt:</EM> Output .WMP file name -<DT><EM>Expected input:</EM> Character(80).<P> -Specify the file name (no extension). <P> -You may enter '[<directory>/]**' to get a list of .WMP files in your current or -another directory; then enter '#<n>' to select the <n>th file from that list. - - <H3> More information: </H3> <UL> -<LI><A HREF="../wmpnode/wmpnode_comm.html">List of general keywords</A> for WMPNODE -<LI>Description of the <A HREF="../wmp_descr/wmp_descr.html">WMP file format</A> -<LI><A HREF="../homepage.html">NEWSTAR Documentation Home page</A> -<LI>The <A HREF="../common_descr/common_descr.html">DWARF User Interface</A> -</UL> diff --git a/hlp/wmpnode/wmpnode__wmp_node.html b/hlp/wmpnode/wmpnode__wmp_node.html deleted file mode 100644 index ca0bb79ba967169a90ea53a447d55e78846501d1..0000000000000000000000000000000000000000 --- a/hlp/wmpnode/wmpnode__wmp_node.html +++ /dev/null @@ -1,29 +0,0 @@ -<TITLE>Description of WMP_NODE (WMPNODE)</TITLE> -<H1>Description of general keyword WMP_NODE</H1> - -<DT><EM>Prompt:</EM> .WMP file name -<DT><EM>Expected input:</EM> Character(80).<P> -Specify the file name (no extension). <P> -You may enter '[<directory>/]**' to get a list of .WMP files in your current or -another directory; then enter '#<n>' to select the <n>th file from that list. -"! -!---------------------------------------------------------------------------- -! Ref: -! -KEYWORD=INPUT_WMP_NODE - DATA_TYP=C - IO=I - LENGTH=80 - SWITCHES=LOOP, NULL_VALUES, WILD_CARDS - SEARCH=L, P - PROMPT="Input .WMP file name -Specify the file name (no extension). <P> -You may enter '[<directory>/]**' to get a list of .WMP files in your current or -another directory; then enter '#<n>' to select the <n>th file from that list. - - <H3> More information: </H3> <UL> -<LI><A HREF="../wmpnode/wmpnode_comm.html">List of general keywords</A> for WMPNODE -<LI>Description of the <A HREF="../wmp_descr/wmp_descr.html">WMP file format</A> -<LI><A HREF="../homepage.html">NEWSTAR Documentation Home page</A> -<LI>The <A HREF="../common_descr/common_descr.html">DWARF User Interface</A> -</UL> diff --git a/hlp/wmpnode_comm/wmpnode_comm.html b/hlp/wmpnode_comm/wmpnode_comm.html deleted file mode 100644 index 1eb6124cc22350d1488cc5b9914e23928dbe52d9..0000000000000000000000000000000000000000 --- a/hlp/wmpnode_comm/wmpnode_comm.html +++ /dev/null @@ -1,17 +0,0 @@ -<TITLE>Index of general keywords from WMPNODE</TITLE> -<H1>Description of general keywords (WMPNODE)</H1> - -<UL> -<LI> <A HREF="../wmpnode/wmpnode__wmp_node.html"> - WMP_NODE</A> - .WMP file name -<LI> <A HREF="../wmpnode/wmpnode__output_wmp_node.html"> - OUTPUT_WMP_NODE</A> - Output .WMP file name -</UL> - - - <H3> More information: </H3> <UL> -<LI><A HREF="../homepage.html">NEWSTAR Documentation Home page</A> -<LI><A HREF="../hb_contents/hb_contents.html">The NEWSTAR Cookbook</A> -</UL> diff --git a/hlp/wmpsets/wmpsets__wmp_sets.html b/hlp/wmpsets/wmpsets__wmp_sets.html deleted file mode 100644 index e69de29bb2d1d6434b8b29ae775ad8c2e48c5391..0000000000000000000000000000000000000000 diff --git a/hlp/wmpsets_comm/wmpsets_comm.html b/hlp/wmpsets_comm/wmpsets_comm.html deleted file mode 100644 index e69de29bb2d1d6434b8b29ae775ad8c2e48c5391..0000000000000000000000000000000000000000 diff --git a/hlp/wnb.gif b/hlp/wnb.gif deleted file mode 100644 index 52ee04e9ca686c6bf869997ab21689a8613531f5..0000000000000000000000000000000000000000 Binary files a/hlp/wnb.gif and /dev/null differ diff --git a/hlp/wndpoh.txt b/hlp/wndpoh.txt deleted file mode 100644 index 86995310d08edde2b6d58312f30e6e85dbd36add..0000000000000000000000000000000000000000 --- a/hlp/wndpoh.txt +++ /dev/null @@ -1,173 +0,0 @@ -Dynamic tailoring of the Newstar program-parameter interface ------------------------------------------------------------- - -Contributed by Johan Hamaker, 940916 - - -Statement of the problem -======================== - - The DWARF parameter interface and the way it is harnessed in the -Newstar programs is plagued by several problems that confuse the user: - - - many keywords are used in multiple places serving multiple, often -quite different, functions ("keyword overloading"); - - - since DWARF allows only static definitions of keyword prompt, options -and help text, the information provided to the user in a prompt is either too -generic (in order to cover all functions for which the keyword is used) or -confusing (when a keyword is re-used in a context that differs from the one it -was designed for); - - - the logic underlying the order in which prompts are presented is in -many places different from a user's natural expectations. - - Following the DWARF design philosophy a proper solution would be to -split overloaded keywords into multiple ones; in addition the order of the -prompts could be made more natural to the uninitiated user. Both of these -options are unacceptable because of their pervasive impact on existing batch -procedures. - - In trying out various ways to patch the situation I noticed that the -only information that a user can hardly avoid noticing is that provided in the -prompts (and in the help texts if he consults these). Everything else is very -easily overlooked. - - The problem, then, is to provide prompts, options and help texts -specific to each of the quite different contexts in which a keyword may be -used, without resorting to changing the keywords themselves. In other words, we -want a method enabling programs to set these prompt components dynamically. As -a practical matter, the method should have a minimal impact on the existing -programs. - - -The new subroutine WNDPOH -========================= - - A new routine WNDPOH has been created that accepts dynamic Prompt, -Options and Help strings. These will be used in the subsequent parameter prompt -(directly through WNDPAR or indirectly through WNDNOD, NSCHAS etc.). The prompt -and options strings replace those in the .ppd file; the help text may either be -inserted in front of the .pps text or replace it. Thus, the call sequence is -simply - - CALL WNDPOH (<prompt>, <options>, <help>) - CALL WNDPAR (... - -or - - CALL WNDPOH (<prompt>, <options>, <help>) - CALL NSCHAS (... - -etc. -There is no need to clear the strings later, this is done automatically once an -answer from the user has been accepted. - - -Details on the call arguments ------------------------------ - - The help text may contain newline directives in the WNCTXT format: !/. -It is recommended to format help text in lines that will fit in single -80-character Fortran lines and extend the quoted string over as many -continuation lines as are necessary, e.g. - - CALL WNDPOH( - 1'Target node to which to write corrections',' ', - 3'SET COPY copies the average telescope corrections from 1 complete!/ - 3input sector to selected parts of any number of output sectors.') - -A help text ending in a line '#-' signals that the text OVERRIDES the .ppd help -text rather than being prepended to it (so the .ppd text will not be shown). - - The <prompt> and <options> strings are limited to 128 characters, the -<help> text to 512 (or a few less). Blank arguments to WNDPOH are ignored, i.e. -they leave the corresponding dynamic text unaltered. - - -Where to program dynamic prompting ----------------------------------- - - The following is a list (possibly still incomplete) of keywords and -subroutine calls that may need dynamic prompting. A complete example of how I -envisage the use of WNDPOH is in ncadat.for. - - all <xxx>_NODE keywords (WNDNOD) - - all <xxx>_SETS keywords (WNDST<x>) - - all <xxx>_LOOPS keywords (WNDXLP) in those cases where the loop controls - more than one ,xxx>_SETS stream - - SELECT_XYX (NSCPL<x>) when used to select telescope rather than - interferometer polarisations. In this case the dynamic options are - 'X,Y,XY', and the subsequent NSCPLS call must read - CALL NSCPLS(XY_P,<pol.mask>) - where XY_P is defined in CBITS_DEF - - SELECT_IFRS (NSCIF<x>), SELECT_TELS (NSCTL<x>) in those cases where it - is not obvious to which stream (input or output) the selection - pertains. - - -Limitations -=========== - - 1. The dynamic information is not included in the hypertext display for -the keyword, because the hypertext source file is a static derivate of the .psc -or .pef file. For this reason the dynamic information is always shown on the -terminal for all forms of on-line help requests. - - 2. As stated before, the method can not change the order in which -prompts appear. - - 3. Since the dynamic texts are provided by the program, they are not -available to dwspecify. I consider this a minor disadvantage since dwspecify is -a primitive program in other ways as well. For interactively setting up -parameter values dwexe/norun is a much better alternative that does have access -to the dynamic texts. - - - -APPENDIX: Implementation -======================== - - WNDPAR through GET_PARM calls on routines PPD_PRSTR_GET, PPD_OPSTR_GET -and PPD_HSTR_GET to fetch the prompt, options and help strings from the .ppd -file. To allow a program to modify e.g. the prompt dynamically, a new entry -point PPD_PRSTR_LSET was created. It takes a prompt string as argument and -stores it in an internal buffer. When PPD_PRSTR_GET is called later, it checks -this buffer and if it finds anything there, uses it instead of the .ppd prompt. -The same method is used to allow dynamic options and help texts; a dynamic help -text may either override the static text or be inserted in front of it. A -terminating line '#-' is inter[reted as an 'override' flag. - - For the programmer's convenience, a single routine is available to set -dynamic information pertaining to the subsequent direct or indirect (through -another routine such as WNDSTA) WNDPAR call. - - The dynamic information will be used in the prompt and any automatic -repeat of it; it will then automatically be cleared. - - -Automatic clearing -================== - - Subroutines like WNDNOD, WNDSTA, NSCIFS are called in various contexts, -so the use of WNDPOH with them is desirable. Internally, these routines call -WNDPAR and may do so repeatedly in case of an incorrect reply. For this reason -WNDPAR can not automatically clear the dynamic strings. - - The solution is for the calling subroutines to set an 'inhibit -clearing' flag. WNDPAR will only clear the dynamic strings if this flag is -clear. Any routine that sets the flag is responsible for clearing both the falg -and the strings, through a call to WNDPOHC. - - The flag must be accessible to several routines and must therefore -reside in a COMMON block. At present the location A_J(0) defined by WNG_DEF is -used because it was available. This solution is sound except that it is -invisible outside the routines that use the flag; an unexpected conflict could -arise later when someone decides that he may use this location for another -purpose. - - diff --git a/hlp/wntinc.txt b/hlp/wntinc.txt deleted file mode 100644 index e3d976b5ff5acb9565de658ef6766c5619659368..0000000000000000000000000000000000000000 --- a/hlp/wntinc.txt +++ /dev/null @@ -1,450 +0,0 @@ -wntinc.txt draft-5 930902/WNB - - - -1. Introduction - -WNTINC is a replacement for WNTAB. The major changes are based on -comments/remarks made by JPH and MdV, and on deficiencies found by myself. -It has been rewritten to make it more modular and to get rid of any -non-described numerical codes. -Main features: -- calculation on local variables -- multiple structure definitions -- structure definitions inside DEFINE -- structures in data statements -- implicit array lengths -- implicit string lengths -- alignment possibilities -- map/union options (not implemented in this version yet) -- deletion of some unused options -- complete C coverage -- continuation lines - -An example of the use can be found in wnt.dsc - - -2. Input structure - -The input file to WNTINC is a NAME.dsc file. The parameter to WNTINC is -NAME, possibly modified by a directory indication. Whatever the case of -NAME, it will be assumed to reference a lc NAME.dsc. -All input lines will be converted to UC, unless enclosed in "". The output -names will all be UC for Fortran and Unix parameters; lc for Unix variable -names. -Blanks in the following indicate 'white space' (i.e. in general spaces -and/or tabs) - -NAME.dsc will consist of a number of lines. Each line consists of a (possibly -empty) command part, followed by an optional comment part which should be -preceded with an !. A line can be continued by having the last non-blank -character in the command part to be a '\'. -An empty line will be considered to be a comment line; a comment not -starting at the beginning of the line will be considered to be a -continuation of the previous line (whether '\' present or not. (This -is to distinguish comments that should precede fields from comments that -should follow fields)). - -Each command can be: -- empty (i.e. comment line only) - can occur everywhere -- the first non-blank character a '%': commands that steer the behaviour - of the compiling process - can occur everywhere -- the first non-blank character a '.': commands that steer the data - interpretation process - can occur only in 'data-blocks'; except .DEFINE: can occur only - once outside a data-block; .STRUCTURE (.BEGIN) that can occur - inside and outside data-blocks and which define the start of - data-blocks; .PARAMETER that can occur everywhere -- data command (starts always with a '-' (dummy name)) or alphabetic character - - -3. Output files - -WNTINC produces the following output files (NAME is the input file name -name, or set by the %NAME) (all filenames in lc): - -a. If .STRUCTURE type data blocks present: - -- NAME_o.def Fortran include file containing parameters and/or comments - and/or 'structure-type' definitions -- NAME_o.inc C include file containing parameters and/or comments and/or - structure definitions -- NAME_t.def Fortran include file containing information for translating - data structures from one representation to another (using - WNTT* routines) -- NAME_t.inc C include file -- NAME_e.def Fortran include file containing information for formatted - printout and/or input of data structures -- NAME_e.inc C include file - -b. If a .DEFINE data block present, or if no .STRUCTURE and no .DEFINE type - present: - -- NAME.def Fortran include file containing comments, parameters (if no - _o present) and/or common blocks and/or data definitions -- NAME.inc C include file containing the same -- NAME_bd.for Common block data-initialisation (if necessary) - -d. Always: - -NAME.LIS describing: -- the input lines -- the offset in and structure of common blocks and data structures. - - -4. Comment lines - - -Commment outside data blocks will be considered to be comments for the .dsc -file only. -Comments inside data blocks will form part of the program output. Lines -starting with a ! will be output proceeding the data items following. Other -comments will always follow the data items they follow. - - -5. % commands - -%name commands steer the compiling process. Some action may be dependent on -wether it is inside or outside data blocks. The following commands are -recognized: - -%NAME=string name of output files to be used. - Default: input file name -%DATE=yymmdd date of producing output - Default: today -%USER=name name of user - Default: login name -%VERSION=num Current version - Default: 1 -%SYSTEM=num Current system - Default;1 - -%%NAME will show currently defined name -%%DATE .. date -%%USER .. user -%%VERSION .. version -%%SYSTEM .. system - -If more than one of the above commands are encountered, the last will be -used - - -%[NO]LIST list lines in log (e.g. to suppress include file listing) - Default: LIST -%[NO]PRINT list comments in output (not fully implemented) - Default: print -%[NO]ALIGN align data items on their lengths (complex data on - their constituant length; structure on the largest - element length included in the structure) - -The above act as switches - -%INSERT=string include specified file -%INCLUDE=string include specified file - As a rule the string will be of the form NAME_DSF, - referencing an include file name.dsf - -The above are identical - -%COMMENT=string include specified comment at begin of output file -%REVISION=nam=yymmdd=string include specified comment as a revision -%FORTRAN=string include the Fortran statement (e.g. IMPLICIT NONE). - If outside data block: at begin of output; if inside: - at end of output -%CC=string include the C statement - -The above act additive - -%LOCAL=name=expr specify a local variable name with a value expr. - The value of the name can be an integer value, or - a character string. If the expr can be evaluated to - an integer constant it will have an integer value, - else a character string value. - In most places were information has to be supplied it - can be supplied as: - - integer expression: containing known variable names, - integer constants (), +-*/, +- unary - - character expression: single known name with a - character value - - string (anything that cannot be interpreted as - one of the above) - Note: an expression starting with a ( will be - deemed to have been ended at the belonging ). This - is for some formatting reason. - Note: / is only recognised if not preceded and or - followed by blanks. This is to recognize the /../ - initialisation - Examples: - 2. is string "2." - 01 is value 1 (and string "1" if appropiate) - (1)*2 is string "(1)*2" - +(1)*2 is value 2 ("2" string) - -%GLOBAL=name=expr identical to the combination: - %LOCAL=name=expr - .PARAMETER - name tp /expr/ - where tp is either J or C(length expr) - - -6. . commands - -. commands define some aspects of the data commands present. Recognized: - - -.END ends blocks starting with .STRUCTURE, .DEFINE, or - .MAP -.DEFINE starts a 'define-block' - Can only occur once outside a data block (define- - or struct-block). The sub-type will initially be - data -.STRUCTURE[=sname] starts a structure block with name sname or NAME - can occur inside or outside a define-block. Many - structure blocks are allowed, but they may not be - nested (there references (see S:) may, of course, - be nested. - Each structure block should have a unique name - (i.e. only one unnamed allowed). The sub-type - will initially be data -.BEGIN[=sname] identical to .STRUCTURE (for historical reasons) - -The above define the type of current data block. It will define the output -files produced, and which sub-types are allowed. - - -.[OFFSET]=nexpr will define a current offset - Only for structure-blocks; assumed to be in data-sub - For define-blocks allowed in common-sub -.ALIGN=nexpr Align offset on specified lengths (note the program - knows the defined local variables LB_B etc) - Allowed in common-sub en structure data-sub -.MAP[=nexpr] will start equivalence structures -.UNION[=nexpr] will start the next structure to be equivalent - The nexpr will serve as an id that can be used in - the WNT translation tables to get the proper - translation of the data; and is used to generate - a name for C. Definition ends at .END - Can only be used in structure-blocks at data-sub - Note: Not implemented yet, but its action can be - made by the equivalence = (except for the translation - choice option) -.PARAMETER Interprets following data lines as parameters -.DATA Interprets following lines as data -.COMMON[=cname] Interprets following lines as to belong to common - cname_COM (or NAME_COM) - Only in define-block - -7. Data commands - -A data command describes a data-item. It consists of two mandatory fields -separated by blanks, and an optional (obligatory for parameters and implied -lengths) initialisation and an optional editing field (only allowed for -structure data-sub). -A full command is: - - name[=rnam] type [/init, ..../] [<edit>] - -Name can be "-" to indicate a dummy name (to be used for filling) or a name -starting with an alphabetic (including _$) character and having only -alphanumeric characters (including _$). -The name can be followed with an '=' followed by a reference name (not valid -for parameter data). The data will be put at the same offset as the data at -the reference name. Limitations: -- rnam should immediately precede name in the same sub-block, i.e. all names - referencing the same rnam should be continuous after rnam -- name should describe an entity not larger than the entity of rnam -- if in ALIGN mode, the alignment of name should be of the same or lesser - value than that of rnam - -Type describes the data entity. It consists of a type indicator, optionally -followed by an array definition. - -The indicator can be: - - B I1 byte - I I2 integer*2 - J I4 integer*4 - K long integer (for now identical to J) - E R4 real*4 - D R8 real*8 - X complex*8 - Y complex*16 - A double length ASCII - Cnexpr character*(nexpr) - C* character*(*) (length from initialisation - string; hence only allowed for parameters - and data in common-sub or define data-sub - S:name structure as defined by name - A:[([start][,inc])] enumeration(add). If in a data-type mode in - define-block, it will generate a character - string array with an implied length from - the initialisation data, containing the - strings provided and a final ' ' string. - This variable can then be used in e.g. - WNCAFU to do a minimax search for its - occurrence. In addition (and in all other - cases only) it will produce a series of - parameters consisting of pre_txt with - values starting at start and incrementing - with inc, where the txt is the first three - (or less if not existing) characters of the - strings, and pre__N will be defined to give - the number of values+1; pre__I the increment - and pre__L and pre__H the lowest and highest - values. The pre__* - will also be available as local variables. - Default start, inc: 1 - E.g.: - cb E: /structure,define,end/ - will produce: - CHARACTER*(10) CB__TXT(4) - DATA CB__TXT/'STRUCTURE','DEFINE','END',' '/ - INTEGER CB_STR,CB_DEF,CB_END,CB__N, - CB__I,CB__H,CB__L - PARAMETER(CB_STR=1,CB_DEF=2,CB_END=3, - CB__N=4,CB__I=1,CB__L=1,CB__H=3) - AR:[([start][,inc])] as A:, but the parameter names will be *_pre - M:[([start][,fac])] enumeration(mul). As A:, but multiplicative - rather than additive. - Default start, fac: 1, 2 - MR:[([start][,fac])] as M:, but *_pre parameters - N:[(val,...)] enumeration(named). As A:, but values are - specified (up to number of array indices - allowed, currently 16). - Default val: 1,2,3,... - Note: No __H,__L and __I produced - NR:[(val,...)] as N:, but *_pre parameters - - [A|M|N][R][F][*]:[...] as A: M: or N:, but Reversed name_ if R present, - full name (rather than 3 first characters) - if F present, no __ names and text if * present. - - - - -Array specification: - - (nexpr[:nexpr],....) The last index (i.e. the high-bound) can be -specified as '*' to indicate an implied length to be deduced from the -initialisation string (if this was allowed). All format types except -A:, M: and N: can have an array index. - - -Initialisation data: - - /init, .../ each init can be an expression, or (nexpr)init. In the -latter case the (nexpr) gives a repeat factor. -If the format was character and the string contains blanks, ',' '/' or -anything that can be but should not be interpreted as an expression (e.g. -'02' which may not be converted to '2'), or is case sensitive, it should be -enclosed in "". - - -Edit data: - - <format,code,units,special> - -Each field may be omitted, trailing ',' may be omitted. - format: WNCTXT (WNCTXI) type format (e.g. AEF12.6) - Default: deduced from item - code: 0: editing of field allowed, >0: not allowed - Default: 0 - units: string specifying units (e.g. "deg") - Default: " " - special: string to indicate something special defined by user - of edit data (e.g. if formatting types are not - sufficient, e.g. to type interferometer names) - Default: " " - The special field is used for S: fields, the default - will be "S:NAME". By definition the user can put - anything in it. The only definition I have now is: - "D:NAME" for a field containing a disk pointer to - to a structure NAME. The editing routine will be - extended to recognise these special codes. - -8. Program changes, omissions - -The following features are not fully implemented yet: - -- initialisation of structures (relatively easy, will do soon) -- MAP/UNION: the = feature caters for everything except the run-time choice - of translation table. This last feature is probably dangerous anyway. - If the need arises, easily to implement. -- C: I have only tested that the .inc files look ok, and are all accepted - by the C compilers. - -The following existing programs need changes: - -- ncomp/ndel.ssc: to change to WNTINC: done -- no _m.mvx output: use existing ones by preserving them. If the f??.dsc files - change, the .mvx has to change. However, the DECalpha has a different - assembler from the VAX, and changes are necessary anyway in the - existing Macro programs (i.e. the I/O routines). - I have done the preservation, and will look at changing the Macro - programs to Fortran. -- no .RECORD: it has been enhanced by the S: data item: scw.dsc and ohw.dsc - uses this: change done -- output now _o.inc rather than -c.inc to get uniform naming: wnf I/O - routines have to change: done - - -9. Detailed program output - - -The output of the program consist of: -- parameters -- structure definitions -- data definitions -- common defintions -- translation tables -- edit tables - -- Parameters - -Parameters are output in Fortran as PARAMETER, with name and type as given. -In C as #define NAME init-text -Note: Maybe they should be given as: - #define NAME (cast) init-text ?? comments please -For A:, M:, N: type the following INTEGER PARAMETERs are produced: - NAME__N # of items in list +1 (==first available - element). Also available as local variable - NAME__L First value (not for N:) - NAME__H Last value (not for N:) - NAME__I Increment(A:) or factor(M:) - NAME_txt For each non-empty init-txt (i.e. not ,, or ,/) - the first 3 char of the text (or less if - shorter text) are taken as txt. - -- Structure definitions - -Structure definitions are given in C as: - struct struct-name { type name [indices]; ,,,}; -All names in lc; indices in reversed order from Fortran. -In Fortran each given name is combined with the struct-name sname to -produce the following INTEGER PARAMETERs: - SNAME__L Byte length of structure - SNAME__V Version - SNAME__S System -In the edit output: - SNAME__EL Length of edit arrays -The above are also available as %LOCAL constants -For historic reasons also available: - snameHDL - snameHDV - snameHDS - snameEDL -For all structure elements: - SNAME_NAME_1 Byte offset from start of structure -In addition for CHARACTER data: - SNAME_NAME_N Length in characters -for STRUCTURE data: - SNAME_NAME_N Length in bytes -for all if the offset from the beginning is an integer multiple of the unit -size of the data type (e.g. LB_J=4 for INTEGER; structure length for structure): - SNAME_NAME_type Offset in unit-length units from start - of structure. Types are the types as given - in the definition (C,J,E,Y,S etc) - - - diff --git a/hlp/wsrt.gif b/hlp/wsrt.gif deleted file mode 100644 index 41d98cfa0feff109bf6a85f7101c73963f4df259..0000000000000000000000000000000000000000 Binary files a/hlp/wsrt.gif and /dev/null differ diff --git a/hlp/xmosaic_restart.txt b/hlp/xmosaic_restart.txt deleted file mode 100644 index 6adc97a418cc72e412e0cdb63bcf2448e0e1831a..0000000000000000000000000000000000000000 --- a/hlp/xmosaic_restart.txt +++ /dev/null @@ -1,51 +0,0 @@ - -Xmosaic restart protocol -======================== - - xmosaic is started by genaid.exe. genaid stores the pid of xmosaic in a -file /tmp/xm-<display name>, where <display name> is derived from the -environment variable DISPLAY by substituting a dot for each colon. - - To access xmosaic from a parameter prompt in a Newstar program, PPDHELP -call genmosaic.cun. The latter routine reads the file created by genaid to -retrieve xmosaic's pid, <pid>. It then follows the protocol defined by xmosaic -to access the appropriate help information in mosaic form: - - - 1. Create a file /tmp/Mosaic.<pid>, containing the lines - - goto - file://localhost/<directory>/file.html - - 2. Sending a SIGUSR1 signal to process <pid>. - -The latter signal causes xmosaic to opend the file /tmp/Mosaic.pid and act on -its contents. - - -Changes, early november 1994 -============================ - - Parameter .html files are now clustered in one .html file per .psc or -.pef file. Finding the right target for display by mosaic requires some -searching, which is done most easily in a .csh script: - - set target = \ - `grep -l <Keyword> $n_hlp/intfc/<program>_private_intfc.psc` - if ($#target != 0) then - set typ = 'private' - else - set target = `grep -l <Keyword> $n_src/*/*.pef` - if ($#target != 0) then - set typ = 'public' - else - <emit error message> - endif - set label = `echo <keyword> sed -e 'y:A...Z_:a...z.:' ` - echo 'goto' >! /tmp/Mosaic.<pid> - echo \ -"file://localhost$n_hlp/<pgm>_${typ}_intfc/<pgm>_${typ}_intfc.html#$target" \ - >> /tmp/Mosaic.<pid> - ln -s /tmp/Mosaic.<pid> /tmp/xmosaic.<pid> - kill -SIGUSR1 <pid> - diff --git a/src/batch/eval_cal.csh b/src/batch/eval_cal.csh deleted file mode 100755 index 1d02fd819326416193dc874a3340a903cb9738d3..0000000000000000000000000000000000000000 --- a/src/batch/eval_cal.csh +++ /dev/null @@ -1,46 +0,0 @@ -#!/bin/csh -f -#CMV 940225 -#+ -# Batch file for on-site analysis of WSRT observations -# -# Usage (make sure Newstar has been initialised): -# -# nbatch eval_cal -# -# This batch file will show the result of the selfcalibration -# -# Dwarf symbols used: -# ROOTFILE The name of the scanfile to use -# FIELD The sector in the scanfile to calibrate -# -# Revisions: -# CMV 940328 Created (does not yet work) -# - -# -# Preliminaries: get date, time, init Newstar, ... -# -source $n_batch/init_batch.csh - -# -# Show the channel, allow flagging -# - -if (-e $ROOTFILE.FLA) then - phistory "eval_cal: Flags file created" - dwe nflag.put | tee -a $Tmpfile - phistory "eval_cal: Flags applied to data" - grep "^ #" $Tmpfile >>$ROOTFILE.status - set Status="calibrate" # Need to redo selfcalibration -else - echo -n "What's the geneal quality of the data? " - set Flag=($<) - phistory "eval_cal: $Flag" - echo -n "Do you want to inspect things in detail (y,n)? [n] " - set Flag=($<) - if ("$Flag" =~ [Yy]*) then - set Status="detail" - else - set Status="ok" - endif -endif diff --git a/src/batch/full_check.csh b/src/batch/full_check.csh deleted file mode 100755 index a6509f0f3d6fdfebca676cc7af995c55e5924bee..0000000000000000000000000000000000000000 --- a/src/batch/full_check.csh +++ /dev/null @@ -1,149 +0,0 @@ -#!/bin/csh -#CMV 940224 -#+ -# Batch file for on-site analysis of WSRT observations -# -# Usage (make sure Newstar has been initialised): -# -# nbatch wsrt_nst [cycleno_start cycleno_end] -# -# If no cyclus numbers are given, they will be asked for. -# Preferably, you should give a range which contains a single -# calibrator-source-calibrator group (casca) -# -# -# This file contains the overall procedure, the details are in: -# load_data.csh -# -# self_cal.csh Self-calibration of single calibrator -# copy_cal.csh Copy calibrator info to mapfile -# make_map.csh Make a map -# -# eval_cal.csh Display calibrated data with NGIDS, allow flagging -# eval_raw.csh Display raw data with NGIDS, allow flagging -# eval_map.csh Display a map with NGIDS -# plot_detail.csh Make detailed plots using NPLOT -# -# -# Revisions: -# CMV 940224 Created -# - -# -# Preliminaries: get date, time, init Newstar, ... -# -set C_Version=1.0 -set Rootfile="casca" -source $n_batch/init_batch.csh - -echo "Welcome to the WSRT on-site analysis (v $C_Version)" - -# -# The off-line programs force us to work in ~/nst -# -cd ~/nst -echo "We are now in directory $cwd for Newstar processing." - -# -# Now we first get some data in a SCN file -# -source $n_batch/load_data.csh -if ("$Status" != "ok") exit - -# -# The next step is to calibrate the calibrators -# - -foreach Field ( `awk '{ if ($2 == "Cal") print $1}' $Rootfile.status `) - - dwlet field=$Field - -# -# Iteratively do the selfcalibration -# - set Status="calibrate" - while ("$Status" == "calibrate") - - source $n_batch/self_cal.csh - -# -# Evaluate the result, do manual flagging if necessary -# - if ("$Status" == "ok") source $n_batch/eval_cal.csh - -# -# Plot details if necessary -# - while ("$Status" == "detail") - source $n_batch/plot_detail.csh - end - - end - -end - -# -# The calibrators are fine, now the sources -# - -foreach Field ( `awk '{ if ($2 == "Src") print $1}' $Rootfile.status `) - - setenv FIELD $Field - -# -# Copy calibration data (if possible!) -# - source $n_batch/copy_cal.csh - -# -# Evaluate the calibration if something could be copied -# - if ("$Status" == "calibrated") then - - source $n_batch/eval_cal.csh - -# -# Or just look at the data if no calibrator available -# - else - - source $n_batch/eval_raw.csh - - endif - -# -# Again we may want to plot the details -# - while ("$Status" == "detail") - source $n_batch/plot_detail.csh - end - -# -# Finally make a map and display it. We start with channel 0 -# - dwlet Channel=0 - source $n_batch/make_map.csh - -# -# Display the map -# - if ("$Status" == "ok") source $n_batch/eval_map.csh - -# -# We may want to make other channels -# - while ("$Status" == "more") then - source $n_batch/make_map.csh - if ("$Status" == "ok") source $n_batch/eval_map.csh - endif - -end - -# -# That is it, tell them where the log-files can be found -# -log "General logging information is in $Logfile" -log "The project status is in $Rootfile.status, the project history," -log "including your quality judgements is in $Rootfile.history" - - diff --git a/src/batch/init_batch.csh b/src/batch/init_batch.csh deleted file mode 100755 index d088cc45b63cc35518306099dba633bbcde5b551..0000000000000000000000000000000000000000 --- a/src/batch/init_batch.csh +++ /dev/null @@ -1,103 +0,0 @@ -#!/bin/csh -f -#CMV 940225 -#+ -# Batch file for on-site analysis of WSRT observations -# -# Used by the other bachfile only -# -# Revisions: -# CMV 940225 Created -# CMV 940329 Changed phistory, always include it -# CMV 940617 Correct setenv ROOTFILE if asked - -# -# Construct the date/time strings, get current version, define logfile -# -set Myname=`awk -F: '{ if ($1 == "'$USER'") print $5 }' /etc/passwd | awk -F, '{ print $1}' ` -if ("$Myname" == "") set Myname=`whoami` - -set dt = (`date`) -if ("$dt[3]" =~ [1-9]) set dt[3] = "0$dt[3]" # day -set mc=( Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec) -foreach mm ( 01 02 03 04 05 06 07 08 09 10 11 12) - if ("$dt[2]" == "$mc[$mm]") break # month -end -@ yy = $dt[$#dt] - 1900 # year -set mh=( `echo $dt[4] | tr -s ":" " "` ) # hh mm ss -set C_Date="$yy$mm$dt[3]" # date: yymmdd -set C_Time="$mh[1]$mh[2]" # time: hhmm -unset dt mc mm yy mh - -# -# Check wether we need to do more -# -if ($?batch_init) exit - -# -# Check wether we can proceed -# -if (! $?n_root || ! $?n_src || ! $?n_site || ! $?n_hlp ) then - echo " " - echo "Getting upset: environment not setup" - echo "First initialise Newstar and then try again" - echo " " - exit -endif - -# -# Initialise Newstar aliases for this site -# -source "$n_src/sys/newstar_$n_site.csh" - -# -# Get current version, define projectname -# -if (! $?C_Version) set C_Version=$C_Date -if (! $?ROOTFILE) then - echo -n "Enter the name for this project: " - set tmp=($<) - setenv ROOTFILE $tmp - unset tmp -endif -set Rootfile=(`echo $ROOTFILE | tr '[a-z]' '[A-Z]' `) - -# -# Define logfile, tmpfile, aliases -# -set Logfile=$cwd/${ROOTFILE}_${C_Date}1.log -@ ii = 1 -while (-e $Logfile) - @ ii = $ii + 1 - set Logfile=$cwd/${ROOTFILE}_${C_Date}$ii.log -end -unset ii - -alias log 'echo \!* | tee -a $Logfile' -alias phistory 'echo $C_Date $C_Time - $Myname - \!* | tee -a $ROOTFILE.history' - -# -# Set temporary file, tell what we are doing -# -set Name=$0; -set Name=$Name:t -set Tmpfile=$cwd/${Name:r}$$.tmp -log "Running $Name for $n_site ($n_arch) on $HOST at $C_Date/$C_Time" -unset Name - -# -# Get the dwarf settings for batch files -# -dwrestore $n_batch/profile.par /overwrite/nolog -if (-e profile.par) then - dwrestore profile.par /overwrite/nolog -endif - -# -# Flag that we initialised -# -set batch_init - -# -# Set the exit status -# -set Status="ok" diff --git a/src/batch/load_data.csh b/src/batch/load_data.csh deleted file mode 100755 index bf746de6916b423416b0f3bd759c215dbbcb74b3..0000000000000000000000000000000000000000 --- a/src/batch/load_data.csh +++ /dev/null @@ -1,125 +0,0 @@ -#!/bin/csh -f -#CMV 940225 -#+ -# Batch file for on-site analysis of WSRT observations -# -# Usage (make sure Newstar has been initialised): -# -# nbatch load_data [cycleno_start cycleno_end] -# -# This batch file loads data into a SCN file -# -# If no cyclus numbers are given, they will be asked for. -# Preferably, you should give a range which contains a single -# calibrator-source-calibrator group (casca). -# -# -# Revisions: -# CMV 940225 Created -# CMV 940328 Separate dista call for each cycleno. -# - -# -# Preliminaries: get date, time, init Newstar, ... -# -source $n_batch/init_batch.csh - -# -# Use findjm to get the range that is available -# -ksh <<_EOD_ >& $Tmpfile -. ~/.kshrc -findjm -exit -_EOD_ - -set Flag=`tail -1 $Tmpfile` -echo "Available cyclus numbers: $Flag[1] - $Flag[2] (seq.nr $Flag[3] - $Flag[4])" - -# -# Get the cycle number range to process: if no arguments given ask from user -# -set cstart="$1" -if ("$cstart" == "") then - echo -n "Enter the first cyclus number to process [$Flag[1]]: " - set cstart="$<" - if ("$cstart" == "") set cstart=$Flag[1] -endif - -set cstop="$2" -if ("$cstop" == "") then - echo -n "Enter the last cyclus number to process [$Flag[2]]: " - set cstop="$<" - if ("$cstop" == "") set cstop=$Flag[2] -endif - - -log "Loading cyclus numbers $cstart - $cstop" - -# -# Remove old files -# -set nonomatch -rm -f $ROOTFILE.* $Rootfile.* -unset nonomatch - -# -# Load through dista, show limited set of output, save the rest -# -set current=$cstart -set label=1 - -if (-e $Tmpfile) rm -f $Tmpfile - -while ($current <= $cstop) - - ksh <<_EOD_ >>$Tmpfile -. ~/.kshrc -dista -2 -$Rootfile -$label -$current,$current - --1,-1 -Y -exit -_EOD_ - - set nonomatch - if (-e $Rootfile.*$label) echo "Loaded $current" - unset nonomatch - - @ current = $current + 1 - @ label = $label + 1 -end - -# -# Check wether we have a file, if so convert to SCN file -# -if (-e $Rootfile.000001) then - log "Data loaded to disk, now converting to a SCAN-file" - dwe nscan.load >> $Logfile - rm -f $Rootfile.?????? -endif - -# -# If no scanfile, show errors and exit -# -if (! -e $Rootfile.SCN) then - log "Error producing SCN file, the following information may help..." - cat $Tmpfile - set Status="No SCN file" -# -# else generate the project status -# -else - rm -f $Tmpfile - log "Created SCAN-file $Rootfile.SCN" - echo "Project status for $ROOTFILE (created $C_Date)" >$ROOTFILE.status - dwe nscan.overview | grep -v NSCAN >>$ROOTFILE.status - set Status="ok" -endif - -phistory "load_data ${cstart},${cstop}: $Status" - diff --git a/src/batch/make_map.csh b/src/batch/make_map.csh deleted file mode 100755 index 10083297e422fb273ec2de456be2e3f49d09983a..0000000000000000000000000000000000000000 --- a/src/batch/make_map.csh +++ /dev/null @@ -1,58 +0,0 @@ -#!/bin/csh -f -#CMV 940329 -#+ -# Batch file for on-site analysis of WSRT observations -# -# Usage (make sure Newstar has been initialised): -# -# nbatch make_map -# -# This batch file will make a map of a single channel -# -# Dwarf symbols used: -# ROOTFILE The name of the scanfile to use -# FIELD The sector in the scanfile to calibrate -# CHANNEL The channel specification for the map -# -# Revisions: -# CMV 940328 Created -# CMV 940705 Optionally ask CHANNEL -# - -# -# Preliminaries: get date, time, init Newstar, ... -# -source $n_batch/init_batch.csh - -if (! $?CHANNEL) then - echo -n "Enter channel(s) to do: " - set noglob - set ans=($<) - setenv CHANNEL $ans - unset noglob -endif - -if (! $?FIELD) then - echo -n "Enter the sector(s) to do (eg 0.0): " - set noglob - set ans=($<) - setenv FIELD $ans - unset noglob -endif - -# -# Call nmap to make the map -# -log "Making map for Channel $CHANNEL" -dwe nmap.chmap >> $Logfile - -# -# Check exit status -# -if (-e $Rootfile.WMP && `genaid size $Rootfile.WMP` > 512) then - set Status="ok" -else - set Status="Could not produce map" -endif - -phistory "make_map $CHANNEL : $Status" diff --git a/src/batch/make_mos.csh b/src/batch/make_mos.csh deleted file mode 100755 index 1c2d3e6687f6121096100e4d2b44ffdcc0c74a0a..0000000000000000000000000000000000000000 --- a/src/batch/make_mos.csh +++ /dev/null @@ -1,86 +0,0 @@ -#!/bin/csh -f -#CMV 940329 -#+ -# Batch file for on-site analysis of WSRT observations -# -# Usage (make sure Newstar has been initialised): -# -# nbatch make_map -# -# This batch file will make a map of a single channel for mosaic data -# -# Dwarf symbols used: -# ROOTFILE The name of the scanfile to use -# FIELD The sector in the scanfile to calibrate -# CHANNEL The channel specification for the map -# -# Revisions: -# CMV 940328 Created -# CMV 940705 Optionally ask CHANNEL and FIELD -# - -# -# Preliminaries: get date, time, init Newstar, ... -# -source $n_batch/init_batch.csh -if (! $?CHANNEL) then - echo -n "Enter channel(s) to do: " - set noglob - set ans=($<) - setenv CHANNEL $ans - unset noglob -endif - -if (! $?FIELD) then - echo -n "Enter the group.observation to do (eg 0.0): " - set noglob - set ans=($<) - setenv FIELD $ans - unset noglob - setenv FIELD `echo $FIELD | awk -F. '{printf("%03d.%03d",$1,$2)}'` -endif - -if (-e $ROOTFILE.status) then - set Flag=( `awk '{ if ($1 == "'$FIELD'") print $9}' $ROOTFILE.status` ) -else - echo -n "Enter the number of fields to do: " - set Flag=($<) -endif -setenv NFIELD $Flag - -# -# Find the reference position -# -@ Flag = $NFIELD / 2 -setenv MIDDLE $Flag -set Flag=(`dwe nscan.mosref | awk '/(1950)/ {if ($2 == "(1950)") printf "%s, ",$3; else printf "%s ",$2}' `) -if ("$Flag" == "") set Flag="40" -setenv MOSCENTR "$Flag" - -# -# Call nmap to make the map -# -log "Making mosaic maps" -if (-e ${Rootfile}_F.WMP) then - 'rm' -f ${Rootfile}_F.WMP -endif -dwe nmap.chmos >> $Logfile - - -# -# Combine the mosaic fields -# -log "Combining mosaic maps in single field" -dwe nmap.moscom >> $Logfile - -# -# Check exit status -# -if (-e $Rootfile.WMP && `genaid size $Rootfile.WMP` > 512) then - 'rm' -f ${Rootfile}_F.WMP - set Status="ok" -else - set Status="Could not produce map" -endif - -phistory "make_map $CHANNEL : $Status" diff --git a/src/batch/profile.par b/src/batch/profile.par deleted file mode 100644 index fc0c0c493223983af99c7fa2de478c64337d474e..0000000000000000000000000000000000000000 --- a/src/batch/profile.par +++ /dev/null @@ -1,204 +0,0 @@ -! -! dwe nscan.load loads data from tape-dump on disk -! - NSCAN$LOAD_CHANNELS="*" - NSCAN$LOAD_HAB_OFFSET="0" - NSCAN$LOAD_INPUT_FILE="'ROOTFILE'" - NSCAN$LOAD_INPUT_LABELS="*;""" - NSCAN$LOAD_INPUT_UNIT="D;#" - NSCAN$LOAD_INTEGRATION_TIME="20" - NSCAN$LOAD_OPTION="LOAD;#" - NSCAN$LOAD_OUTPUT_SCN_NODE="'ROOTFILE'" - NSCAN$LOAD_POINTING_SETS="*" - NSCAN$LOAD_SELECT_XYX="XYX" -! -! dwe nscan.overview shows an overview of the contents of a scanfile -! - NSCAN$OVERVIEW_FILE_ACTION="OVERVIEW;QUIT" - NSCAN$OVERVIEW_INPUT_SCN_NODE="'ROOTFILE';""" - NSCAN$OVERVIEW_OPTION="SHOW;QUIT" - NSCAN$OVERVIEW_OVERVIEW="O" -! -! dwe nflag.shadow flags for shadowing in a scanfile -! - NFLAG$SHADOW_OPTION="FLAG;QUIT" - NFLAG$SHADOW_INPUT_SCN_NODE="'ROOTFILE'" - NFLAG$SHADOW_SCN_SETS="'FIELD'.*.'CHANNEL'" - NFLAG$SHADOW_SELECT_XYX="/NOASK" - NFLAG$SHADOW_HA_RANGE="*" - NFLAG$SHADOW_SELECT_IFRS="/NOASK" - NFLAG$SHADOW_FLAG_OPTION="DETERM;QUIT" - NFLAG$SHADOW_OPS_DETERM="SHAD;QUIT" - NFLAG$SHADOW_SHADOW_DIAM="25" -! -! dwe ncalib.selfcal selfcalibration -! - NCALIB$SELFCAL_OPTION="REDUNDANCY" - NCALIB$SELFCAL_ALIGN_OPTION="SELFCAL" - NCALIB$SELFCAL_SCN_NODE="'ROOTFILE'" - NCALIB$SELFCAL_SCN_LOOPS="'NCHAN', ...'SCHAN' " - NCALIB$SELFCAL_SCN_SETS="'FIELD'.0.'FCHAN'" - NCALIB$SELFCAL_SELECT_XYX="/NOASK" - NCALIB$SELFCAL_HA_RANGE="*" - NCALIB$SELFCAL_SELECT_IFRS="/NOASK" - NCALIB$SELFCAL_HA_INTEGRATION="*" - NCALIB$SELFCAL_SHOW_LEVEL="1.2,1.2" - NCALIB$SELFCAL_COMPLEX="/NOASK" - NCALIB$SELFCAL_SOLVE="/NOASK" - NCALIB$SELFCAL_MWEIGHT_TYPE="STEP" - NCALIB$SELFCAL_MWEIGHT_DATA="0.1" - NCALIB$SELFCAL_QDETAILS="NO" - NCALIB$SELFCAL_INPUT_MDL_NODE="/NOASK" - NCALIB$SELFCAL_MODEL_OPTION="READ;QUIT" - NCALIB$SELFCAL_MODEL_ACTION="MERGE,BAND,TIME,NOINPOL,BEAM" -! -! dwe nmap.chmap make a map based on certain channels -! - NMAP$CHMAP_OPTION="MAKE" - NMAP$CHMAP_SCN_LOOPS="""" - NMAP$CHMAP_SCN_NODE="'ROOTFILE';""" - NMAP$CHMAP_SCN_SETS="'FIELD'.0.'CHANNEL'" - NMAP$CHMAP_HA_RANGE="-90 DEG,90 DEG" - NMAP$CHMAP_SELECT_IFRS="""" - NMAP$CHMAP_USER_COMMENT=""Map for 'ROOTFILE'"" - NMAP$CHMAP_UV_COORDINATES="UV" - NMAP$CHMAP_FIELD_SIZE="/NOASK" - NMAP$CHMAP_FT_SIZE="/NOASK" - NMAP$CHMAP_OUT_SIZE="/NOASK" - NMAP$CHMAP_MAP_COORD="B1950_J2000" - NMAP$CHMAP_MAP_POLAR="L" - NMAP$CHMAP_OUTPUT="MAP" - NMAP$CHMAP_OUTPUT_WMP_NODE="'ROOTFILE'" - NMAP$CHMAP_QDATAS="NO" - NMAP$CHMAP_QMAPS="NO" - NMAP$CHMAP_SUBTRACT="NO" -! -! dwe nmap.plmap plots the maps just produced -! - NPLOT$PLMAP_OPTION="MAP;QUIT" - NPLOT$PLMAP_PLOTTER="'PLOTTER'" - NPLOT$PLMAP_DATA_TYPE="DATA" - NPLOT$PLMAP_DOT_CONT="/NOASK" - NPLOT$PLMAP_FULL_CONT="/NOASK" - NPLOT$PLMAP_PLOT_TYPE="CONT" - NPLOT$PLMAP_SIZE="1.3,1.3" - NPLOT$PLMAP_WMP_LOOPS="""" - NPLOT$PLMAP_WMP_NODE="'ROOTFILE'" - NPLOT$PLMAP_WMP_SETS="*" - NPLOT$PLMAP_AREA="/NOASK" - NPLOT$PLMAP_COORD="RADEC" - NPLOT$PLMAP_COORD_TYPE="DOTTED" - NPLOT$PLMAP_PLOT_POSITIONS="NO" -! -! dwe nscan.mosref find the reference position in a Moasic file -! - NSCAN$MOSREF_FILE_ACTION="CONT;QUIT" - NSCAN$MOSREF_INPUT_SCN_NODE="'ROOTFILE';""" - NSCAN$MOSREF_OPTION="SHOW;QUIT" - NSCAN$MOSREF_SCN_SETS="'FIELD'.'MIDDLE'" - NSCAN$MOSREF_SECTOR_ACTION="QUIT" -! -! dwe nmap.chmos make half-res mosaic maps based on certain channels -! - NMAP$CHMOS_OPTION="MAKE" - NMAP$CHMOS_SCN_LOOPS="'NFIELD',"..1"" - NMAP$CHMOS_SCN_NODE="'ROOTFILE';""" - NMAP$CHMOS_SCN_SETS="0.0.0.'CHANNEL'" - NMAP$CHMOS_SELECT_IFRS=""-9A","-C","-D";""" - NMAP$CHMOS_HA_RANGE="-90 DEG,90 DEG" - NMAP$CHMOS_USER_COMMENT=""Halve resolution map"" - NMAP$CHMOS_FIELD_SIZE="3 DEG,3 DEG" - NMAP$CHMOS_FT_SIZE="256,256" - NMAP$CHMOS_OUT_SIZE="256,256" - NMAP$CHMOS_OUTPUT="MAP" - NMAP$CHMOS_MAP_COORD="REFERENCE" - NMAP$CHMOS_MAP_POLAR="I,Q" - NMAP$CHMOS_OUTPUT_WMP_NODE="'ROOTFILE'_F" - NMAP$CHMOS_REF_COORD="'MOSCENTR'" - NMAP$CHMOS_QDATAS="NO" - NMAP$CHMOS_QMAPS="YES" - NMAP$CHMOS_CONVOLVE="EXPSINC" - NMAP$CHMOS_CWEIGHT_TYPE="NATURAL" - NMAP$CHMOS_DECONVOLVE="YES" - NMAP$CHMOS_TAPER="GAUSS" - NMAP$CHMOS_TAPER_VALUE="1300 M" - NMAP$CHMOS_UNIFORM="STANDARD" - NMAP$CHMOS_UV_COORDINATES="UV" - NMAP$CHMOS_SUBTRACT="NO" -! -! dwe nmap.moscom Combine I and Q maps -! - NMAP$MOSCOM_OPTION="FIDDLE;QUIT" - NMAP$MOSCOM_FIDDLE_OPTION="MOSCOM;MOSCOM;QUIT" - NMAP$MOSCOM_WMP_NODE_1="'ROOTFILE'_F;'ROOTFILE'_F" - NMAP$MOSCOM_WMP_NODE_2="'ROOTFILE';'ROOTFILE'" - NMAP$MOSCOM_WMP_SET_1="0.*.'CHANNEL'.0;0.*.'CHANNEL'.1" - NMAP$MOSCOM_OUT_SIZE="1024,1024;1024,1024" - NMAP$MOSCOM_USE_NOISE="NO;NO" - NMAP$MOSCOM_WGT_LIMIT=".01;.1" - NMAP$MOSCOM_OUT_CENTRE="0,0;0,0" -! -! dwe nplot.plmos Plots a mosaic field (I,Q) -! - NPLOT$PLMOS_OPTION="MAP;QUIT" - NPLOT$PLMOS_PLOTTER="'PLOTTER'" - NPLOT$PLMOS_DATA_TYPE="DATA" - NPLOT$PLMOS_DOT_CONT="-100" - NPLOT$PLMOS_FULL_CONT="/NOASK" - NPLOT$PLMOS_PLOT_TYPE="CONT" - NPLOT$PLMOS_SIZE="2,2" - NPLOT$PLMOS_WMP_LOOPS="""" - NPLOT$PLMOS_WMP_NODE="'ROOTFILE'" - NPLOT$PLMOS_WMP_SETS="0.0.'CHANNEL'.*;1.0.'CHANNEL'.*" - NPLOT$PLMOS_AREA="/NOASK" - NPLOT$PLMOS_COORD="RADEC" - NPLOT$PLMOS_COORD_TYPE="DOTTED" - NPLOT$PLMOS_PLOT_POSITIONS="NO" -! -! dwe ngids.cdataf Show corrected data and allow for flagging -! - NGIDS$CDATAF_OPTION="DOFLAG;DATA;WRITE;QUIT" - NGIDS$CDATAF_ALL_CHAN="YES" - NGIDS$CDATAF_ALL_POLS="YES" - NGIDS$CDATAF_USER_FLAG="MAN" - NGIDS$CDATAF_PLOT_TYPE="BASE" - NGIDS$CDATAF_INPUT_SCN_NODE="'ROOTFILE'" - NGIDS$CDATAF_SCN_SETS="'FIELD'.*.'CHANNEL'" - NGIDS$CDATAF_HA_RANGE="/NOASK" - NGIDS$CDATAF_SELECT_XYX="XY" - NGIDS$CDATAF_MODEL_OPTION="READ;QUIT" - NGIDS$CDATAF_INPUT_MDL_NODE="NGC3782_21CM;#" - NGIDS$CDATAF_BLANK_FLAGS="NO" - NGIDS$CDATAF_DATA_TYPE="AMPLITUDE" - NGIDS$CDATAF_MAP_RANGE="/NOASK" - NGIDS$CDATAF_OUTPUT_FILE="'ROOTFILE'.FLA" -! -! dwe nflag.put Put the flags in $ROOTFILE.FLA on the data -! - NFLAG$PUT_OPTION="FLAG;QUIT" - NFLAG$PUT_INPUT_SCN_NODE="'ROOTFILE'" - NFLAG$PUT_SCN_SETS="'FIELD'.*.'CHANNEL'" - NFLAG$PUT_HA_RANGE="*" - NFLAG$PUT_SELECT_IFRS="""" - NFLAG$PUT_SELECT_XYX="XYX" - NFLAG$PUT_FLAG_OPTION="FLIST;QUIT" - NFLAG$PUT_OPS_FLIST="READ;PUT;QUIT" - NFLAG$PUT_INPUT_FILE="'ROOTFILE'.FLA" - NFLAG$PUT_PUT_EXPAND_CH="0" - NFLAG$PUT_SELECT_FLAG="MAN" - NFLAG$PUT_SUB_CUBE="NO" -! -! dwe ngids.cdata Show corrected data, no flagging -! - NGIDS$CDATA_OPTION="DATA;QUIT" - NGIDS$CDATA_PLOT_TYPE="BASE" - NGIDS$CDATA_INPUT_SCN_NODE="'ROOTFILE'" - NGIDS$CDATA_SCN_SETS="'FIELD'.*.'CHANNEL'" - NGIDS$CDATA_HA_RANGE="/NOASK" - NGIDS$CDATA_SELECT_XYX="XY" - NGIDS$CDATA_MODEL_OPTION="READ;QUIT" - NGIDS$CDATA_INPUT_MDL_NODE="NGC3782_21CM;#" - NGIDS$CDATA_BLANK_FLAGS="NO" - NGIDS$CDATA_DATA_TYPE="AMPLITUDE" - NGIDS$CDATA_MAP_RANGE="/NOASK" - NGIDS$CDATA_NEXT="ALL" diff --git a/src/batch/self_cal.csh b/src/batch/self_cal.csh deleted file mode 100755 index 8a245a3a629d10c4ee668f425a249e5e79229758..0000000000000000000000000000000000000000 --- a/src/batch/self_cal.csh +++ /dev/null @@ -1,51 +0,0 @@ -#!/bin/csh -f -#CMV 940225 -#+ -# Batch file for on-site analysis of WSRT observations -# -# Usage (make sure Newstar has been initialised): -# -# nbatch self_cal -# -# This batch file will self-calibrate a single calibrator. -# -# Dwarf symbols used: -# ROOTFILE The name of the scanfile to use -# FIELD The sector in the scanfile to calibrate -# -# Revisions: -# CMV 940328 Created -# - -# -# Preliminaries: get date, time, init Newstar, ... -# -source $n_batch/init_batch.csh - -# -# First flag on shadowing -# -dwe nflag.shadow -phistory "self_cal shadow: \ - `awk '/# data XX/ {printf "flagged %s%% of %s uv-points",$8,$14}' NFLAG.LOG ` " - -# -# Use NCALIB to do the self-calibration on all channels -# -if (! $?FIELD) setenv FIELD "000.000" - -setenv NCHAN `awk '{ if ($1 == "'$FIELD'") print $8}' $ROOTFILE.status` -setenv SCHAN 1 -setenv FCHAN 0 - -dwe ncalib.selfcal -if (`grep -c 'Pure redundancy used'` == 0) then - phistory "self_cal calibrate: selfcalibration used" -else - phistory "self_cal calibrate: pure redundancy used" -endif - -# -# Assume ok (even if no calibrator model, redundancy will work) -# -set Status=ok diff --git a/src/batch/srt.grp b/src/batch/srt.grp deleted file mode 100644 index 621542a81272a9c1a2c116c21afd1fda95849bb4..0000000000000000000000000000000000000000 --- a/src/batch/srt.grp +++ /dev/null @@ -1,16 +0,0 @@ -!+ srt.grp -! -! Batch procedures for use at the WSRT -! -SRT.GRP -! -PROFILE.PAR !DWARF keyword settings for various tasks -INIT_BATCH.CSH !General initialisation -WSRT_CHECK.CSH !Procedure to make a map automatically -FULL_CHECK.CSH !Procedure for interactive calibration -LOAD_DATA.CSH !Get data from circle file -MAKE_MAP.CSH !Make normal map -MAKE_MOS.CSH !Make mosaic map -SELF_CAL.CSH !Do selfcal -EVAL_CAL.CSH !Evaluate result -!- diff --git a/src/batch/wsrt_check.csh b/src/batch/wsrt_check.csh deleted file mode 100755 index 939a095275d3c9fec2dca042f96e7090837e2d32..0000000000000000000000000000000000000000 --- a/src/batch/wsrt_check.csh +++ /dev/null @@ -1,115 +0,0 @@ -#!/bin/csh -#CMV 940224 -#+ -# Batch file for on-site analysis of WSRT observations -# -# Usage (make sure Newstar has been initialised): -# -# nbatch wsrt_nst cyclusno -# -# If no cyclus number is given, it will be asked for. -# -# This procedure loads the data in a Scan file and selects one of -# several actions depending on the type of data: -# -# Astronomical measurements: make a raw I map of channel 0 -# if Mosaic: make a raw I and Q mosaic maps of channel 0 -# if broadband DCB: make some plots of the data -# -# This batch script just calls procedures that can also be -# invoked "by hand". -# -# load_data.csh Load data from circle-file -# -# make_map.csh Make a map -# make_mos.csh Make mosaic map -# plot_92cal.csh Plot 92cm broadband (9A,8B,7C,6D Amp, phase) -# plot_92src.csh Plot 92cm broadband (9A,8B,7C,6D Cos) -# -# Revisions: -# CMV 940329 Created -# -#set echo -# -# Get the argument -# -if ("$1" == "") then - echo -n "Enter the cyclus number to load: " - set $1=($<) -endif -set argv=( $1 $1 ) # Load just one frame -setenv ROOTFILE "c$1" - -# -# Preliminaries: get date, time, init Newstar, ... -# -set C_Version=1.0 -source $n_batch/init_batch.csh - -echo "Welcome to the WSRT on-site analysis (v $C_Version)" - -# -# The off-line programs force us to work in ~/nst -# -cd ~/nst -echo "We are now in directory $cwd for Newstar processing." - -# -# Now we first get some data in a SCN file -# -source $n_batch/load_data.csh -if ("$Status" != "ok") exit - -# -# Have a look at the data to see what we should do -# -setenv FIELD "000.000" - -# -# Get the obs.type and the number of fields -# -set Flag=(`awk '{ if ($1 == "'$FIELD'") print $2 " " $9}' $ROOTFILE.status `) - -# -# If it's a source with just one pointing centre, make a channel 0 map -# -if ($Flag[1] == "Src" && $Flag[2] == 1) then - - setenv CHANNEL 0 - - source $n_batch/make_map.csh - - if ("$Status" == "ok") then - setenv PLOTTER PSP - dwe nplot.plmap - endif - -# -# If it's a mosaic, first make a mosaic map -# -else if ($Flag[1] == "Src" && $Flag[2] > 1) then - setenv CHANNEL 0 - - source $n_batch/make_mos.csh - - if ("$Status" == "ok") then - setenv PLOTTER PSP - dwe nplot.plmos - endif -endif - -# -# Remove all Newstar LOG and PLT files, any information should -# have been extracted or printed. -# -set nonomatch -'rm' -f *.LOG *.PLT -unset nonomatch - -# -# That is it, tell them where the log-files can be found -# -log "General logging information is in $Logfile" -log "The project status is in $ROOTFILE.status, the project history," -log "is in $ROOTFILE.history" - diff --git a/src/data/1127-145_21cm.mdl b/src/data/1127-145_21cm.mdl deleted file mode 100755 index 5add5ce43d386f4b58400e1c52387da9e27684a0..0000000000000000000000000000000000000000 Binary files a/src/data/1127-145_21cm.mdl and /dev/null differ diff --git a/src/data/3c147_21cm.mdl b/src/data/3c147_21cm.mdl deleted file mode 100755 index 1875589b23a00343dc199412e0545683c0c3a2ba..0000000000000000000000000000000000000000 Binary files a/src/data/3c147_21cm.mdl and /dev/null differ diff --git a/src/data/3c147_49cm.mdl b/src/data/3c147_49cm.mdl deleted file mode 100755 index b422d85412c4922d3d66dbbc3a23cba18af8a430..0000000000000000000000000000000000000000 Binary files a/src/data/3c147_49cm.mdl and /dev/null differ diff --git a/src/data/3c147_6cm.mdl b/src/data/3c147_6cm.mdl deleted file mode 100755 index 40f0d3e2f3a60571df416a21e24ddbf72a5527b4..0000000000000000000000000000000000000000 Binary files a/src/data/3c147_6cm.mdl and /dev/null differ diff --git a/src/data/3c147_92cm.mdl b/src/data/3c147_92cm.mdl deleted file mode 100755 index ac430738765b872eecb61fd13dba109eda3a17ca..0000000000000000000000000000000000000000 Binary files a/src/data/3c147_92cm.mdl and /dev/null differ diff --git a/src/data/3c286_21cm.mdl b/src/data/3c286_21cm.mdl deleted file mode 100755 index bdf782bbdb76083b00e48b0ca541bce9de1a989a..0000000000000000000000000000000000000000 Binary files a/src/data/3c286_21cm.mdl and /dev/null differ diff --git a/src/data/3c286_49cm.mdl b/src/data/3c286_49cm.mdl deleted file mode 100755 index 6de2f0eb4a0544f303a7b8d848887d012888ea46..0000000000000000000000000000000000000000 Binary files a/src/data/3c286_49cm.mdl and /dev/null differ diff --git a/src/data/3c286_6cm.mdl b/src/data/3c286_6cm.mdl deleted file mode 100755 index 6baf967f81f53be6a05350458937a0213bd39442..0000000000000000000000000000000000000000 Binary files a/src/data/3c286_6cm.mdl and /dev/null differ diff --git a/src/data/3c286_92cm.mdl b/src/data/3c286_92cm.mdl deleted file mode 100755 index 44868f746abaa8a612b32b23d3cbdb6173d2d135..0000000000000000000000000000000000000000 Binary files a/src/data/3c286_92cm.mdl and /dev/null differ diff --git a/src/data/3c295_21cm.mdl b/src/data/3c295_21cm.mdl deleted file mode 100755 index 14db3124f2a5e9636d61c6519f7b49252826cd8b..0000000000000000000000000000000000000000 Binary files a/src/data/3c295_21cm.mdl and /dev/null differ diff --git a/src/data/3c295_92cm.mdl b/src/data/3c295_92cm.mdl deleted file mode 100755 index f426d11eaae02ce194f41bbbf657cece558b4d91..0000000000000000000000000000000000000000 Binary files a/src/data/3c295_92cm.mdl and /dev/null differ diff --git a/src/data/3c345_92cm.mdl b/src/data/3c345_92cm.mdl deleted file mode 100755 index c8e34c6e6c3bdaecca8ddad242c3655ad3f75bbc..0000000000000000000000000000000000000000 Binary files a/src/data/3c345_92cm.mdl and /dev/null differ diff --git a/src/data/3c48_21cm.mdl b/src/data/3c48_21cm.mdl deleted file mode 100755 index 93fb95d6e0e4bf566ff913851afadc5fb8b5e2fc..0000000000000000000000000000000000000000 Binary files a/src/data/3c48_21cm.mdl and /dev/null differ diff --git a/src/data/3c48_49cm.mdl b/src/data/3c48_49cm.mdl deleted file mode 100755 index accba85002ce5cf86e27e0f407cfd160b6542996..0000000000000000000000000000000000000000 Binary files a/src/data/3c48_49cm.mdl and /dev/null differ diff --git a/src/data/3c48_6cm.mdl b/src/data/3c48_6cm.mdl deleted file mode 100755 index 6f38486846e482ee014b607c78173f3f7bd11c2e..0000000000000000000000000000000000000000 Binary files a/src/data/3c48_6cm.mdl and /dev/null differ diff --git a/src/data/3c48_92cm.mdl b/src/data/3c48_92cm.mdl deleted file mode 100755 index b776d7d1dd30871bb7959d180c48b503a78a5b65..0000000000000000000000000000000000000000 Binary files a/src/data/3c48_92cm.mdl and /dev/null differ diff --git a/src/data/IQ.WMP b/src/data/IQ.WMP deleted file mode 100644 index 22ac21f1b5b48e4bc2660e320df5082e05424098..0000000000000000000000000000000000000000 Binary files a/src/data/IQ.WMP and /dev/null differ diff --git a/src/data/TEST.SCN b/src/data/TEST.SCN deleted file mode 100644 index 4bf2175e41ed1f8ec98f4418503ade56553a45b5..0000000000000000000000000000000000000000 Binary files a/src/data/TEST.SCN and /dev/null differ diff --git a/src/data/TEST.WMP b/src/data/TEST.WMP deleted file mode 100644 index d4f36a6b7b0f978c385ba6da3a8c5de305236288..0000000000000000000000000000000000000000 Binary files a/src/data/TEST.WMP and /dev/null differ diff --git a/src/data/cal.grp b/src/data/cal.grp deleted file mode 100644 index b86f6cb6c057d685831518240d1321b80c84a26b..0000000000000000000000000000000000000000 --- a/src/data/cal.grp +++ /dev/null @@ -1,30 +0,0 @@ -!+CAL.GRP -! CMV 930922 -! -! Revisions -! CMV 930922 Created -! HjV 960422 Added 1127-145_21CM.MDL -! -! -! This groupfile lists the calibrator models available for use in newstar -! -CAL.GRP -README.TXT -! -1127-145_21CM.MDL -B -3C286_21CM.MDL -B -3C295_21CM.MDL -B -3C147_21CM.MDL -B -3C48_49CM.MDL -B -3C147_49CM.MDL -B -3C286_49CM.MDL -B -3C295_92CM.MDL -B -3C48_6CM.MDL -B -3C147_6CM.MDL -B -3C286_6CM.MDL -B -3C345_92CM.MDL -B -3C48_92CM.MDL -B -3C147_92CM.MDL -B -3C286_92CM.MDL -B -3C48_21CM.MDL -B -!- diff --git a/src/data/readme.txt b/src/data/readme.txt deleted file mode 100755 index eeb127595e2d68a5b1621fd012d42d2f0a1d46ed..0000000000000000000000000000000000000000 --- a/src/data/readme.txt +++ /dev/null @@ -1,83 +0,0 @@ -Updated December 4 1995 -Ger de Bruyn - -This directory contains MDL files for the primary and secondary WSRT -flux density and position calibrators at the wavelengths of 6cm (4874 -MHZ), 21cm (1412 MHz), 49cm (608.8 MHz) and 92cm (325.125 MHz). - -The WSRT flux density scale is based on the Baars et al. (Astron. -Astrophys. 61, 104, 1977) scale values for the source 3C286. 3C286 -is not known to be variable to more than 1%. The secondary -calibrators 3C48 and 3C147 are, however, known to be variable, by -about a few %, at wavelengths of 6 and 21 cm, and possibly also at -longer wavelengths. The values in the models may therefore have to be -changed somewhat. At 92cm we also have included models for 3C295 and -3C345. 3C295 is a double radio source (4" separation) that CANNOT -vary on human timescales (the source is tens of kpc in diameter) and -will be used in the future to check the variability of all other -calibrators. At 6cm and 21cm 3C295 is strongly resolved across the -array and is therefore less suitable as a calibrator. The source -3C345 is polarized (about 3% at 92cm) and can be used to check any -phase-difference between the X and Y dipoles. In the future we hope to -make regular observations at 92cm of either this source or other -polarized calibrators (e.g. 3C303). - -At frequencies different from the normal ones the values will have to -be changed according to the spectral index of the source. Especially -for 21cm line observations at large heliocentric velocities the -correction may be several % and should not be neglected. The values -for the spectral index (spectral index = dlog(S)/dlog(freq) are: - at 6cm: 3C48 -0.95, 3C147 -0.91, 3C286 -0.62 - at 21cm: 3C48 -0.84, 3C147 -0.70, 3C286 -0.45 - at 92cm: 3C48 -0.68, 3C147 -0.62, 3C286 -0.34, 3C295 -0.60 - -At 49 cm the band is so narrow that you will never have to worry about -the spectral index. - -Especially the low-frequency models contain a varying numbers of -background sources. The fluxdensities of these background sources -obviously need to be adjusted for the frequency dependent primary -beamwidth. You can do this using NMODEL, option FEDIT. This option -will then ask you for a reference epoch (use B1950) and a SCN-file -from which it gets the pointing centre of the calibrator observation. -It then scales the background sources using a COS(cfr)**6 function -(where c=0.0629, r is the radius in degrees and f is the frequency in -MHz) which assumes that the primary beams scale with frequency. This -is a good first order approximation. - -(The spectral indices at 92cm are only approximate. Most of the WSRT -calibrators are socalled SSC sources which show a spectral turnover -around 100-200 MHz). - - -When doing bandpass calibration in line observations it is strongly -advised to use a frequency INDEPENDENT value of the flux density. The -models in this directory do not have a spectral index, so this will be -the default when you use these models for calibration. The reference -frequency in the header of the model is therefore not used. (Note -that if you would use a spectral index then each source in the -synthesized field will adopt the spectral index of the calibrator and -when you subtract images from two sides of the band then part of the -source, and all its side/grating lobes, will remain in the image). - -However, it is possible to give the calibrator a spectral index using -the EDIT command in NMODEL (first go to the MODIFY subgroup of -keywords). (If you want to give all sources in the model the same -spectral index you can use the FEDIT option). This could be useful -when you have data with the broadband 92cm DCB (which permits -observations from 300 -390 MHz) and you want to determine real -spectral indices for sources in your field. But if you wish to -conduct bandwidth synthesis with the broadband 92cm system then again -it is best to only change the models for the different primary beams -but not for the intrinsic spectral index. - - -If you have any questions about using the calibrator models I refer to -NEWSTAR recipe #13 (to be written), or contact me (Ger de Bruyn, -0521-595257, ger@astron.nl)). - - - - - - diff --git a/src/doc/anchors.idx b/src/doc/anchors.idx deleted file mode 100644 index 74c04a2f353aba72817fa11cbcf405dccf555e99..0000000000000000000000000000000000000000 --- a/src/doc/anchors.idx +++ /dev/null @@ -1,10 +0,0 @@ -#Syntax: reference institute email -<A HREF=/html/people.html#cmv>de Vos</A> NFRA devoscm@astron.nl -<A HREF=/html/people.html#axc>Coolen</A> NFRA coolen@astron.nl -<A HREF=/html/people.html#jen>Noordam</A> NFRA noordam@astron.nl -<A HREF=/html/people.html#jph>Hamaker</A> NFRA jph@astron.nl -<A HREF=/html/people.html#agb>de Bruyn</A> NFRA ger@astron.nl -<A HREF=/html/people.html#wnb>Brouw</A> ATNF wbrouw@atnf.csiro.au -<A HREF=http://www.astron.nl/nfra.html>NFRA</A> -<A HREF=http://www.astron.nl/nfra.html>WSRT</A> - diff --git a/src/doc/bin/agb.gif b/src/doc/bin/agb.gif deleted file mode 100644 index 050b197580dadc2959cf26e63dad6ce6841c836c..0000000000000000000000000000000000000000 Binary files a/src/doc/bin/agb.gif and /dev/null differ diff --git a/src/doc/bin/alpha_32_64.ps b/src/doc/bin/alpha_32_64.ps deleted file mode 100644 index 2bf5744eecaf88be5ece89196abdd21ed55b86ff..0000000000000000000000000000000000000000 --- a/src/doc/bin/alpha_32_64.ps +++ /dev/null @@ -1,1403 +0,0 @@ -%!PS-Adobe-2.1 -%%Creator: DECwrite T2.0-IFT -%%+Copyright (c) 1990 DIGITAL EQUIPMENT CORPORATION. -%%+All Rights Reserved. -%%DocumentFonts: (atend) -%%EndComments -%%BeginProcSet DEC_WRITE 1.07 -/DEC_WRITE_dict 150 dict def DEC_WRITE_dict begin/$D save def/$I 0 def/$S 0 -def/$C matrix def/$R matrix def/$L matrix def/$E matrix def/pat1{/px exch -def/pa 8 array def 0 1 7{/py exch def/pw 4 string def 0 1 3{pw exch px py 1 -getinterval putinterval}for pa py pw put}for}def/pat2{/pi exch def/cflag -exch def save cflag 1 eq{eoclip}{clip}ifelse newpath{clippath -pathbbox}stopped not{/ph exch def/pw exch def/py exch def/px exch def/px px -3072 div floor 3072 mul def/py py 3072 div floor 3072 mul def px py -translate/pw pw px sub 3072 div floor 1 add cvi def/ph ph py sub 3072 div -floor 1 add cvi def pw 3072 mul ph 3072 mul scale/pw pw 32 mul def/ph ph 32 -mul def/px 0 def/py 0 def pw ph pi[pw 0 0 ph 0 0]{pa py get/px px 32 add -def px pw ge{/px 0 def/py py 1 add 8 mod def}if}pi type/booleantype -eq{imagemask}{image}ifelse}if restore}def/PS{/_op exch def/_np 8 string def -0 1 7{/_ii exch def/num _op _ii get def _np 7 _ii sub num -4 bitshift PX -num 15 and 4 bitshift -4 bitshift PX 4 bitshift or put}for _np}def/PX{[15 7 -11 3 13 5 9 1 14 6 10 2 12 4 8 0]exch get}def/FR{0.7200 0 $E defaultmatrix -dtransform/yres exch def/xres exch def xres dup mul yres dup mul add -sqrt}def/SU{/_sf exch def/_sa exch def/_cs exch def/_mm $C currentmatrix -def/rm _sa $R rotate def/sm _cs dup $L scale def sm rm _mm _mm concatmatrix -_mm concatmatrix pop 1 0 _mm dtransform/y1 exch def/x1 exch def/_vl x1 dup -mul y1 dup mul add sqrt def/_fq FR _vl div def/_na y1 x1 atan def _mm 2 get -_mm 1 get mul _mm 0 get _mm 3 get mul sub 0 gt{{neg}/_sf load -concatprocs/_sf exch def}if _fq _na/_sf load setscreen}def/BO{/_yb exch -def/_xb exch def/_bv _bs _yb _bw mul _xb 8 idiv add get def/_mk 1 7 _xb 8 -mod sub bitshift def _bv _mk and 0 ne $I 1 eq xor}def/BF{DEC_WRITE_dict -begin/_yy exch def/_xx exch def/_xi _xx 1 add 2 div _bp mul cvi def/_yi _yy -1 add 2 div _bp mul cvi def _xi _yi BO{/_nb _nb 1 add def 1}{/_fb _fb 1 add -def 0}ifelse end}def/setpattern{/_cz exch def/_bw exch def/_bp exch def/_bs -exch PS def/_nb 0 def/_fb 0 def _cz 0/BF load SU{}settransfer _fb _fb _nb -add div setgray/$S 1 def}def/invertpattern{$S 0 eq{{1 exch -sub}currenttransfer concatprocs settransfer}if}def/invertscreen{/$I 1 -def/$S 0 def}def/revertscreen{/$I 0 def}def/setrect{/$h exch def/$w exch -def/$y exch def/$x exch def newpath $x $y moveto $w $x add $y lineto $w $x -add $h $y add lineto $x $h $y add lineto closepath}def/concatprocs{/_p2 -exch cvlit def/_p1 exch cvlit def/_pn _p1 length _p2 length add array def -_pn 0 _p1 putinterval _pn _p1 length _p2 putinterval _pn -cvx}def/OF/findfont load def/findfont{dup DEC_WRITE_dict exch -known{DEC_WRITE_dict exch get}if DEC_WRITE_dict/OF get exec}def -mark/ISOLatin1Encoding -8#000 1 8#001{StandardEncoding exch get}for /emdash/endash -8#004 1 8#025{StandardEncoding exch get}for /quotedblleft/quotedblright -8#030 1 8#054{StandardEncoding exch get}for /minus 8#056 1 8#217 -{StandardEncoding exch get}for/dotlessi 8#301 1 8#317{StandardEncoding -exch get}for/space/exclamdown/cent/sterling/currency/yen/brokenbar/section -/dieresis/copyright/ordfeminine/guillemotleft/logicalnot/hyphen/registered -/macron/degree/plusminus/twosuperior/threesuperior/acute/mu/paragraph -/periodcentered/cedilla/onesuperior/ordmasculine/guillemotright/onequarter -/onehalf/threequarters/questiondown/Agrave/Aacute/Acircumflex/Atilde -/Adieresis/Aring/AE/Ccedilla/Egrave/Eacute/Ecircumflex/Edieresis/Igrave -/Iacute/Icircumflex/Idieresis/Eth/Ntilde/Ograve/Oacute/Ocircumflex/Otilde -/Odieresis/multiply/Oslash/Ugrave/Uacute/Ucircumflex/Udieresis/Yacute/Thorn -/germandbls/agrave/aacute/acircumflex/atilde/adieresis/aring/ae/ccedilla -/egrave/eacute/ecircumflex/edieresis/igrave/iacute/icircumflex/idieresis -/eth/ntilde/ograve/oacute/ocircumflex/otilde/odieresis/divide/oslash/ugrave -/uacute/ucircumflex/udieresis/yacute/thorn/ydieresis -256 array astore def cleartomark -/encodefont{findfont dup maxlength dict begin{1 index/FID ne{def}{pop -pop}ifelse}forall/Encoding exch def dup/FontName exch def currentdict -definefont end}def/loads{/$/ISOLatin1Encoding load def/&/encodefont load -def/*/invertpattern load def/+/revertscreen load def/-/invertscreen load -def/:/concatprocs load def/^/setpattern load def/~/pat1 load def/_/pat2 -load def/@/setrect load def/A/arcn load def/B/ashow load def/C/curveto load -def/D/def load def/E/eofill load def/F/findfont load def/G/setgray load -def/H/closepath load def/I/clip load def/J/fill load def/K/kshow load -def/L/lineto load def/M/moveto load def/N/newpath load def/O/rotate load -def/P/pop load def/R/grestore load def/S/gsave load def/T/translate load -def/U/sub load def/V/div load def/W/widthshow load def/X/exch load -def/Y/awidthshow load def/a/save load def/c/setlinecap load def/d/setdash -load def/e/restore load def/f/setfont load def/g/initclip load def/h/show -load def/i/setmiterlimit load def/j/setlinejoin load def/k/stroke load -def/l/rlineto load def/m/rmoveto load def/n/currentfont load -def/o/scalefont load def/p/currentpoint load def/q/setrgbcolor load -def/r/currenttransfer load def/s/scale load def/t/setmatrix load -def/u/settransfer load def/w/setlinewidth load def/x/matrix load -def/y/currentmatrix load def}def -end -%%EndProcSet -%%EndProlog -%%BeginSetup -DEC_WRITE_dict begin -loads -version cvi 23.0 gt { -currentdict {dup type /arraytype eq -{bind def} {pop pop} ifelse} forall} if -0.0100 0.0100 s - -%%EndSetup -%%Page: 1 1 -/$P a D -g N -0 79200 T -S -S -N -7500 -73600 M -53700 -73600 L -S -100 w -0 c -0 j -2 i -0.00 G k -R -R - -R -S -7200 -7200 T -N -0 G -8193 -2100 M -/Helvetica-Bold-ISOLatin1 $ -/Helvetica-Bold & P -/Helvetica-Bold-ISOLatin1 F 2400 o f -(32/64 Bit Portability Issues) h -23400 -5850 M -20387 -11150 M -/Times-Roman-ISOLatin1 $ -/Times-Roman & P -/Times-Roman-ISOLatin1 F 1400 o f -(Ray Lanza) h -15718 -16600 M -n 0.857 o f -(Advanced OSF Software Group) h -21266 -22600 M -(11/19/91) h -3900 -28749 M -/Times-Italic-ISOLatin1 $ -/Times-Italic & P -/Times-Italic-ISOLatin1 F 1399 o f -281.1 0 32 (64\255bit architectures provide extended capabilities such as support) W -3900 -30348 M -231.7 0 32 (for larger address spaces and scalar arithmetic ranges. These en\255) W -3900 -31947 M -281.0 0 32 (hanced capabilities introduce a number of compatibility problems) W -3900 -33546 M -41.1 0 32 (that must be addressed while porting software. Many of the compati\255) W -3900 -35145 M -97.7 0 32 (bility problems can be avoided through careful design and attention) W -3900 -36744 M -(to datatypes.) h -n 0.858 o f -( ) h --7200 7200 T -R - -showpage -$P e - -%%Page: 2 2 -/$P a D -g N -0 79200 T -S -S -7200 -74700 T -N -0 G -22511 -1050 M -/Helvetica-ISOLatin1 $ -/Helvetica & P -/Helvetica-ISOLatin1 F 1000 o f -(\255 ) h -(2) h -( \255) h -300 -2485 M --7200 74700 T -R - -S -N -7500 -73600 M -53700 -73600 L -S -100 w -0 c -0 j -2 i -0.00 G k -R -R - -R -S -7200 -7200 T -N -0 G -3900 -1200 M -300 -3800 M -/Helvetica-BoldOblique-ISOLatin1 $ -/Helvetica-BoldOblique & P -/Helvetica-BoldOblique-ISOLatin1 F 1200 o f -(Overview) h -300 -5400 M -300 -7400 M -/Times-Roman-ISOLatin1 $ -/Times-Roman & P -/Times-Roman-ISOLatin1 F 1200 o f -19.8 0 32 (There is a set of issues involved in porting applications from ULTRIX to OSF1. Another set of) W -300 -8800 M -110.4 0 32 (issues exist in porting applications from a 32\255bit OSF system to a 64\255bit OSF system. These) W -300 -10200 M -17.9 0 32 (are two disjoint sets of issues. This paper deals with the later. Porting ULTRIX applications to) W -300 -11600 M -(OSF is documented in the HERCULES Porting Guide.) h -300 -13600 M -223.1 0 32 (64\255bit architectures provide wider registers to hold larger scalar datatypes and memory ad\255) W -300 -15000 M -69.8 0 32 (dresses. They also provide arithmetic and logical instructions to operate on these registers. It's) W -300 -16400 M -64.4 0 32 (these capabilities that differentiate 64 bit systems from 32\255bit systems. Unfortunately these ca\255) W -300 -17800 M -(pabilities also introduce portability issues. ) h -300 -19800 M -13.6 0 32 (Most applications are written in one or more high level languages. A discussion of portability is) W -300 -21200 M -107.1 0 32 (only practical in the context of one of these languages, as applications written in assembly or) W -300 -22600 M -80.5 0 32 (macro assembly need complete rewrites or translations. For the purpose of this paper the lan\255) W -300 -24000 M -(guage of interest is C but variations of the problems occur with other languages. ) h -300 -26000 M -74.4 0 32 (Much of the information in this paper is a direct result of work done on a port of ULTRIX\25532) W -300 -27400 M -11.3 0 32 (V4.0 to a 64\255bit architecture. The port was done as a research/advanced development effort. In) W -300 -28800 M -143.9 0 32 (addition to the operating system, approximately 280 user level commands and utilities were) W -300 -30200 M -14.2 0 32 (ported. While this represents a considerable body of code, it's not clear if this is truly represen\255) W -300 -31600 M -(tative of user applications.) h -300 -33600 M -(During the port we learned a number of things:) h -300 -35600 M -/Symbol F 1200 o f -(\267) h -2100 -35600 M -/Times-Roman-ISOLatin1 F 1200 o f -(Most well written programs compile and run without change) h -300 -37600 M -/Symbol F 1200 o f -(\267) h -2100 -37600 M -/Times-Roman-ISOLatin1 F 1200 o f -95.1 0 32 (Most 32/64 bit portability problems can be avoided through the use of good programming) W -2100 -39000 M -(practices) h -300 -41000 M -/Symbol F 1200 o f -(\267) h -2100 -41000 M -/Times-Roman-ISOLatin1 F 1200 o f -233.7 0 32 (Most 32/64 bit portability problems are a direct result of changing one or more of the) W -2100 -42400 M -(datatypes) h -300 -44400 M -/Symbol F 1200 o f -(\267) h -2100 -44400 M -/Times-Roman-ISOLatin1 F 1200 o f -(Programs living in a pure 64\255bit environment can ignore most data size issues) h -300 -46400 M -/Symbol F 1200 o f -(\267) h -2100 -46400 M -/Times-Roman-ISOLatin1 F 1200 o f -120.6 0 32 (Programs producing/consuming data from 32\255bit programs may need design and develop\255) W -2100 -47800 M -(ment effort to solve problems) h -300 -49800 M -300 -51800 M -/Helvetica-BoldOblique-ISOLatin1 F 1200 o f -(Datatype Definitions) h -300 -53400 M -300 -55000 M -/Times-Roman-ISOLatin1 F 1200 o f -29.0 0 32 (A 64\255bit system provides support for greater addressibility and larger ranges for scalar arithme\255) W -300 -56400 M -25.9 0 32 (tic operations. Providing this functionality for user applications involves changing one or more) W -300 -57800 M -203.5 0 32 (of the scalar datatypes. Unfortunately these changes result in interoperability problems be\255) W -300 -59200 M -(tween 32/64 bit systems and are the main cause of portability problems. ) h -300 -61200 M -(The primary consideration for the choices outlined in the following table is in fact portability. ) h -300 -62600 M --7200 7200 T -R - -showpage -$P e - -%%Page: 3 3 -/$P a D -g N -0 79200 T -S -S -7200 -74700 T -N -0 G -22511 -1050 M -/Helvetica-ISOLatin1 $ -/Helvetica & P -/Helvetica-ISOLatin1 F 1000 o f -(\255 ) h -(3) h -( \255) h -300 -2485 M --7200 74700 T -R - -S -N -7500 -73600 M -53700 -73600 L -S -100 w -0 c -0 j -2 i -0.00 G k -R -R - -R -S -7200 -7200 T -N -0 G -300 -1200 M -/Times-Roman-ISOLatin1 $ -/Times-Roman & P -/Times-Roman-ISOLatin1 F 1200 o f -83.6 0 32 (With these definitions it is possible to define data structures that do not change size from sys\255) W -300 -2600 M -(tem to system.) h -300 -4600 M -300 -24140 M -S -0 18440 m -p T -0 -18440 27080 18440 @ I N -N -S -150 -150 T -N -0 G -600 -1500 M -/Times-Roman-ISOLatin1 F 1200 o f -(Data Type) h --150 150 T -R - -S -7259 -150 T -N -0 G -1378 -1500 M -/Times-Roman-ISOLatin1 F 1200 o f -(32 Bit System) h --7259 150 T -R - -S -16917 -150 T -N -0 G -1605 -1500 M -/Times-Roman-ISOLatin1 F 1200 o f -(64 Bit System) h --16917 150 T -R - -S -150 -2650 T -N -0 G -600 -1500 M -/Times-Roman-ISOLatin1 F 1200 o f -(char) h -6360 -1500 M -600 -2936 M --150 2650 T -R - -S -7259 -2650 T -N -0 G -4479 -1500 M -/Times-Roman-ISOLatin1 F 1200 o f -(8) h -600 -2936 M --7259 2650 T -R - -S -16917 -2650 T -N -0 G -4706 -1500 M -/Times-Roman-ISOLatin1 F 1200 o f -(8) h -600 -2936 M --16917 2650 T -R - -S -150 -5890 T -N -0 G -600 -1500 M -/Times-Roman-ISOLatin1 F 1200 o f -(short) h --150 5890 T -R - -S -7259 -5890 T -N -0 G -4179 -1500 M -/Times-Roman-ISOLatin1 F 1200 o f -(16) h --7259 5890 T -R - -S -16917 -5890 T -N -0 G -4406 -1500 M -/Times-Roman-ISOLatin1 F 1200 o f -(16) h --16917 5890 T -R - -S -150 -8390 T -N -0 G -600 -1500 M -/Times-Roman-ISOLatin1 F 1200 o f -(int) h --150 8390 T -R - -S -7259 -8390 T -N -0 G -4179 -1500 M -/Times-Roman-ISOLatin1 F 1200 o f -(32) h --7259 8390 T -R - -S -16917 -8390 T -N -0 G -4406 -1500 M -/Times-Roman-ISOLatin1 F 1200 o f -(32) h --16917 8390 T -R - -S -150 -10890 T -N -0 G -600 -1500 M -/Times-Roman-ISOLatin1 F 1200 o f -(long) h --150 10890 T -R - -S -7259 -10890 T -N -0 G -4179 -1500 M -/Times-Roman-ISOLatin1 F 1200 o f -(32) h --7259 10890 T -R - -S -16917 -10890 T -N -0 G -4406 -1500 M -/Times-Roman-ISOLatin1 F 1200 o f -(64) h --16917 10890 T -R - -S -150 -13390 T -N -0 G -600 -1500 M -/Times-Roman-ISOLatin1 F 1200 o f -(long long) h --150 13390 T -R - -S -7259 -13390 T -N -0 G -4179 -1500 M -/Times-Roman-ISOLatin1 F 1200 o f -(64) h --7259 13390 T -R - -S -16917 -13390 T -N -0 G -4406 -1500 M -/Times-Roman-ISOLatin1 F 1200 o f -(64) h --16917 13390 T -R - -S -150 -15890 T -N -0 G -600 -1500 M -/Times-Roman-ISOLatin1 F 1200 o f -(pointer) h --150 15890 T -R - -S -7259 -15890 T -N -0 G -4179 -1500 M -/Times-Roman-ISOLatin1 F 1200 o f -(32) h --7259 15890 T -R - -S -16917 -15890 T -N -0 G -4406 -1500 M -/Times-Roman-ISOLatin1 F 1200 o f -(64) h --16917 15890 T -R - -S -N -7209 0 M -7209 -18640 L -S -100 w -0 c -0 j -2 i -0.00 G k -R -R - -S -N -16867 0 M -16867 -18640 L -S -100 w -0 c -0 j -2 i -0.00 G k -R -R - -S -N -0 -2600 M -27380 -2600 L -S -100 w -0 c -0 j -2 i -0.00 G k -R -R - -S -N -0 -5840 M -27380 -5840 L -S -100 w -0 c -0 j -2 i -0.00 G k -R -R - -S -N -0 -8340 M -27380 -8340 L -S -100 w -0 c -0 j -2 i -0.00 G k -R -R - -S -N -0 -10840 M -27380 -10840 L -S -100 w -0 c -0 j -2 i -0.00 G k -R -R - -S -N -0 -13340 M -27380 -13340 L -S -100 w -0 c -0 j -2 i -0.00 G k -R -R - -S -N -0 -15840 M -27380 -15840 L -S -100 w -0 c -0 j -2 i -0.00 G k -R -R - -S -75.0 -18365.0 26930.0 18290.0 @ -S -150 w -0 c -0 j -0.00 G k -R -R -R -27080 0 m -300 -26190 M -/Times-Roman-ISOLatin1 F 1200 o f -91.3 0 32 (As you can see from the table `long' and `pointer' change from 32 to 64 bits. These changes) W -300 -27590 M -157.7 0 32 (provide the applications developer with support for all of the supported scalar types and ex\255) W -300 -28990 M -(pands addressing beyond the limits imposed by today's 32\255bit systems.) h -300 -30990 M -48.3 0 32 (The `long long' datatype will be supported in future versions of the 32 and 64\255bit C compilers. ) W -300 -32390 M -296.6 0 32 (It provides the ability to read and write 64 bit scalar data and may provide a degree of) W -300 -33790 M -(interoperability for new programs being developed.) h -300 -35790 M -300 -37790 M -/Helvetica-BoldOblique-ISOLatin1 $ -/Helvetica-BoldOblique & P -/Helvetica-BoldOblique-ISOLatin1 F 1200 o f -(Types of problems ) h -300 -39390 M -300 -41390 M -/Times-Roman-ISOLatin1 F 1200 o f -(There are five basic problems or issues that need to be addressed:) h -300 -43390 M -/Symbol F 1200 o f -(\267) h -2100 -43390 M -/Times-Roman-ISOLatin1 F 1200 o f -(Objects change size) h -300 -45390 M -/Symbol F 1200 o f -(\267) h -2100 -45390 M -/Times-Roman-ISOLatin1 F 1200 o f -(Sizeof\( * \) != Sizeof\( int \)) h -300 -47390 M -/Symbol F 1200 o f -(\267) h -2100 -47390 M -/Times-Roman-ISOLatin1 F 1200 o f -(32 <=> 64 bit interoperability) h -300 -49390 M -/Symbol F 1200 o f -(\267) h -2100 -49390 M -/Times-Roman-ISOLatin1 F 1200 o f -(Atomicity) h -300 -51390 M -/Symbol F 1200 o f -(\267) h -2100 -51390 M -/Times-Roman-ISOLatin1 F 1200 o f -(Read/Write ordering) h -300 -53390 M -300 -55390 M -/Helvetica-BoldOblique-ISOLatin1 F 1200 o f -(Objects Change Size) h -300 -56990 M -300 -58590 M -/Times-Roman-ISOLatin1 F 1200 o f -51.4 0 32 (Data objects that include pointers or longs change size. The following is an example of a sim\255) W -300 -59990 M -(plistic linked list data structure.) h -300 -61990 M --7200 7200 T -R - -showpage -$P e - -%%Page: 4 4 -/$P a D -g N -0 79200 T -S -S -7200 -74700 T -N -0 G -22511 -1050 M -/Helvetica-ISOLatin1 $ -/Helvetica & P -/Helvetica-ISOLatin1 F 1000 o f -(\255 ) h -(4) h -( \255) h -300 -2485 M --7200 74700 T -R - -S -N -7500 -73600 M -53700 -73600 L -S -100 w -0 c -0 j -2 i -0.00 G k -R -R - -R -S -7200 -7200 T -N -0 G -300 -1200 M -300 -3200 M -/Times-Roman-ISOLatin1 $ -/Times-Roman & P -/Times-Roman-ISOLatin1 F 1200 o f -(struct foo {) h -300 -5200 M -6060 -5200 M -(struct foo *next, *prev;) h -300 -7200 M -6060 -7200 M -(int mode;) h -300 -9200 M -6060 -9200 M -(char *name;) h -300 -11200 M -(}; ) h -300 -13200 M -300 -15200 M -62.9 0 32 (On a 32\255bit system this structure occupies 16 bytes of memory. On a 64\255bit system this struc\255) W -300 -16600 M -48.6 0 32 (ture will be 32 bytes long. 12 bytes of the growth are a result of the three pointers doubling in) W -300 -18000 M -(length. The other 4 bytes are a result of alignment padding. ) h -n 0.666 o f -0.0 538.0 m -(1) h -0 -538.0 m -300 -20000 M -n 1.502 o f -81.2 0 32 (The fact that this data structure changed size may not be a problem. If the program runs on a) W -300 -21400 M -4.8 0 32 (64\255bit system and the data it produces and consumes remains on 64\255bit systems, no harm occurs) W -300 -22800 M -40.1 0 32 (except for a potential size problem. The problem exists in environments where the 64\255bit pro\255) W -300 -24200 M -33.8 0 32 (gram must consume data produced by a 32\255bit program or it produces data that is consumed by) W -300 -25600 M -(a 32\255bit program.) h -300 -27600 M -79.6 0 32 (The key to defining compatible data structures is to avoid the use of long and pointer declara\255) W -300 -29000 M -78.1 0 32 (tions. This may seem like a difficult task but in fact it's relatively easy. Declarations of long) W -300 -30400 M -0.9 0 32 (can be replaced by int to preserve sizes. In serious database\255oriented applications pointers rarely) W -300 -31800 M -17.4 0 32 (appear in declarations that are written to mass storage devices. These applications are normally) W -300 -33200 M -(concerned about storage efficiency and already avoid pointers.) h -300 -35200 M -152.9 0 32 (In the case where a 64\255bit program must deal with 32\255bit data structures containing pointers) W -300 -36600 M -2.4 0 32 (more work is required. One approach is to define a new data structure that encapsulates the old) W -300 -38000 M -5.1 0 32 (structure while preserving the alignments, and then being careful to perform I/O to and from the) W -300 -39400 M -74.3 0 32 (encapsulated structure. This technique assumes that data written out in pointer fields is irrele\255) W -300 -40800 M -14.9 0 32 (vant and will be filled in when the structure is memory resident. These problems are not limited) W -300 -42200 M -(to files on disk, they can happen with all forms of mass storage including tape. ) h -300 -44200 M -300 -46200 M -/Helvetica-BoldOblique-ISOLatin1 $ -/Helvetica-BoldOblique & P -/Helvetica-BoldOblique-ISOLatin1 F 1200 o f -(Sizeof\( * \) != Sizeof\( int \)) h -300 -47800 M -300 -49800 M -/Times-Roman-ISOLatin1 F 1200 o f -(Of all of the problems anticipated as a result of the datatypes chosen this was the one that con\255) h -300 -51200 M -(cerned most people. The example below results in truncation of the value stored in `buffer') h -300 -52600 M -(inspite of the casts used. There were very few of these problems in the port of ULTRIX\25532 to) h -300 -54000 M -(the 64\255bit architecture. Most instances were in virtual memory related kernel code or the) h -300 -55400 M -(bourne shell, `/bin/sh'.) h -300 -57000 M --7200 7200 T -R - -S -7200 -70200 T -N -0 G -300 -1200 M -/Times-Roman-ISOLatin1 F 1000 o f -0.0 448.0 m -(1) h -0 -448.0 m -900 -1200 M -(OSF and ULTRIX compilers align data on `natural boundaries') h --7200 70200 T -R - -showpage -$P e - -%%Page: 5 5 -/$P a D -g N -0 79200 T -S -S -7200 -74700 T -N -0 G -22511 -1050 M -/Helvetica-ISOLatin1 $ -/Helvetica & P -/Helvetica-ISOLatin1 F 1000 o f -(\255 ) h -(5) h -( \255) h -300 -2485 M --7200 74700 T -R - -S -N -7500 -73600 M -53700 -73600 L -S -100 w -0 c -0 j -2 i -0.00 G k -R -R - -R -S -7200 -7200 T -N -0 G -300 -1200 M -300 -2800 M -/Times-Roman-ISOLatin1 $ -/Times-Roman & P -/Times-Roman-ISOLatin1 F 1200 o f -(int foo;) h -300 -4800 M -(char *buffer;) h -300 -6800 M -6060 -6800 M -(buffer = \(char *\)malloc\(128\);) h -300 -8800 M -6060 -8800 M -(foo = \( int \)buffer;) h -300 -10800 M -6060 -10800 M -(buffer = \(char *\)foo;) h -300 -12800 M -300 -14800 M -300 -16800 M -6.3 0 32 (The 64\255bit version of the product will contain an enhanced version of lint that will issue a warn\255) W -300 -18200 M -(ing when an assignment of this type is attempted.) h -300 -20200 M -85.1 0 32 (Another form of this problem is encountered with aliased data structures. We have seen code) W -300 -21600 M -(that defines multiple structures for the same object instead of using unions.) h -300 -23600 M -300 -25600 M -(struct foo {) h -6060 -25600 M -11820 -25600 M -17580 -25600 M -23340 -25600 M -(struct bar {) h -300 -27600 M -6060 -27600 M -(int src_addr, dst_addr;) h -17580 -27600 M -23340 -27600 M -29100 -27600 M -(struct bar *next, *prev;) h -300 -29600 M -6060 -29600 M -(char *name;) h -17580 -29600 M -23340 -29600 M -29100 -29600 M -(char *name;) h -300 -31600 M -(};) h -6060 -31600 M -11820 -31600 M -17580 -31600 M -23340 -31600 M -(};) h -300 -33600 M -300 -35600 M -0.3 0 32 (This is similar to a problem found in the `ip' portion of the network code. The source and desti\255) W -300 -37000 M -83.7 0 32 (nation internet address are stored as 32 bit integers. As the data is passed up through the net\255) W -300 -38400 M -53.9 0 32 (work layers the fields containing the network addresses are reused as linked list pointers. This) W -300 -39800 M -132.0 0 32 (works well on a system where a pointer is the same size as an int. It doesn't work with the) W -300 -41200 M -(datatype choices made for 64\255bit systems.) h -300 -43200 M -70.7 0 32 (Problems of this type are difficult to find and correct. In the `ip' case lower layers of the sys\255) W -300 -44600 M -69.3 0 32 (tem used the `foo' declaration and upper layers used the `bar' declaration. Running lint on all) W -300 -46000 M -62.8 0 32 (the modules in a program or using ANSI C function prototypes will detect a miss\255match in ar\255) W -300 -47400 M -(guments. Unfortunately an appropriate cast may hide this condition.) h -300 -49400 M -71.5 0 32 (Another form of this problem occurs with function arguments. If you pass a 32\255bit constant or) W -300 -50800 M -135.6 0 32 (an `int' to a function which expects a `long' or a pointer the object is likely to be truncated. ) W -300 -52200 M -(Again using ANSI C function prototypes or `lint' on older programs will solve this problem.) h -300 -54200 M -15.9 0 32 (The final form of this problem involves default types. Constants defined without the `L' suffix,) W -300 -55600 M -34.1 0 32 (variables declared as `unsigned' without a type and function arguments declared without a type) W -300 -57000 M -105.7 0 32 (all default to `int'. In many cases this may be correct however if you attempt to use these to) W -300 -58400 M -(hold a value longer than 32 bits you may observe truncation.) h -300 -60400 M --7200 7200 T -R - -showpage -$P e - -%%Page: 6 6 -/$P a D -g N -0 79200 T -S -S -7200 -74700 T -N -0 G -22511 -1050 M -/Helvetica-ISOLatin1 $ -/Helvetica & P -/Helvetica-ISOLatin1 F 1000 o f -(\255 ) h -(6) h -( \255) h -300 -2485 M --7200 74700 T -R - -S -N -7500 -73600 M -53700 -73600 L -S -100 w -0 c -0 j -2 i -0.00 G k -R -R - -R -S -7200 -7200 T -N -0 G -300 -1200 M -300 -3200 M -/Helvetica-BoldOblique-ISOLatin1 $ -/Helvetica-BoldOblique & P -/Helvetica-BoldOblique-ISOLatin1 F 1200 o f -(Interoperability) h -300 -4800 M -300 -6800 M -/Times-Roman-ISOLatin1 $ -/Times-Roman & P -/Times-Roman-ISOLatin1 F 1200 o f -126.6 0 32 (In previous sections the data portability problems were limited to mass storage devices. The) W -300 -8200 M -53.1 0 32 (mass storage related problems are really just a simple form of more general inter\255process com\255) W -300 -9600 M -108.0 0 32 (munications problems. Any time a 32\255bit program communicates with a 64\255bit program they) W -300 -11000 M -23.5 0 32 (must agree on the format and type of data. Therefore, the same issues can occur over a local or) W -300 -12400 M -112.4 0 32 (wide area network. If the 64\255bit product supported both 32\255bit and 64\255bit execution environ\255) W -300 -13800 M -205.0 0 32 (ments the problem would be extended to include other IPC mechanisms such as System V) W -300 -15200 M -(shared memory and message queues.) h -n 0.666 o f -0.0 538.0 m -(1) h -0 -538.0 m -300 -17200 M -n 1.502 o f -31.4 0 32 (64\255bit systems will support files larger than 2 gigabytes.) W -n 0.666 o f -0.0 538.0 m -31.4 0 32 (2) W -0 -538.0 m -n 1.502 o f -31.4 0 32 ( They will also function as fileservers) W -300 -18600 M -19.1 0 32 (for other systems including existing 32\255bit systems. Files may be created that can't be fully ad\255) W -300 -20000 M -50.9 0 32 (dressed by 32\255bit clients. It will also be possible to mount disks from 64\255bit systems on 32\255bit) W -300 -21400 M -(systems and have the same problem.) h -300 -23400 M -300 -25400 M -/Helvetica-BoldOblique-ISOLatin1 F 1200 o f -(Atomicity) h -300 -27000 M -300 -29000 M -/Times-Roman-ISOLatin1 F 1200 o f -83.7 0 32 (Some 64\255bit architectures do not support byte or word load and store operations. The smallest) W -300 -30400 M -100.3 0 32 (unit of memory access is the longword, which is 32 bits. High level language byte and word) W -300 -31800 M -31.6 0 32 (accesses are accomplished with multiple instructions. In most cases this fact can be ignored by) W -300 -33200 M -148.0 0 32 (an applications developer. It becomes important whenever multiple threads of execution are) W -300 -34600 M -28.1 0 32 (sharing data. This can happen when two or more processes share data via shared memory or in) W -300 -36000 M -(a multi\255threaded application where all threads share a common address space.) h -300 -38000 M -(char byte[16]) h -300 -40000 M -12.5 0 32 (As an example using the declaration above, if threadA attempts to update byte[0] while threadB) W -300 -41400 M -41.9 0 32 (updates byte[1] there is a chance that the access of one thread will affect the other even though) W -300 -42800 M -24.6 0 32 (they aren't trying to update the same variable. The following is an example of the code used to) W -300 -44200 M -(update a single byte.) h -300 -46200 M -300 -48200 M -(8: byte[1] = 5; ) h -300 -50200 M -( [tst.c: 8] 0x120000230: 43e0b40f) h -17580 -50200 M -(addq zero, 0x5, t7) h -300 -51600 M -( [tst.c: 8] 0x120000234: 203e0001) h -17580 -51600 M -(lda at, 1\(sp\)) h -300 -53000 M -( [tst.c: 8] 0x120000238: 2f410000) h -17580 -53000 M -(ldq_u k0, 0\(at\) \255\255\255\255\255\255\255\255\255\255\255) h -300 -54400 M -( [tst.c: 8] 0x12000023c: 49e1017b) h -17580 -54400 M -(insbl t7, at, k1) h -300 -55800 M -( [tst.c: 8] 0x120000240: 4b41005a) h -17580 -55800 M -(mskbl k0, at, k0) h -300 -57200 M -( [tst.c: 8] 0x120000244: 475b041a) h -17580 -57200 M -(bis k0, k1, k0) h -300 -58600 M -( [tst.c: 8] 0x120000248: 3f410000) h -17580 -58600 M -(stq_u k0, 0\(at\) \255\255\255\255\255\255\255\255\255\255\255) h --7200 7200 T -R - -S -7200 -68400 T -N -0 G -300 -1200 M -/Times-Roman-ISOLatin1 F 1000 o f -0.0 448.0 m -(1) h -0 -448.0 m -900 -1200 M -(Not part of the product plans at this time) h -300 -3000 M -0.0 448.0 m -(2) h -0 -448.0 m -900 -3000 M -(32 bit systems are currently limited to 2 gigabytes) h --7200 68400 T -R - -showpage -$P e - -%%Page: 7 7 -/$P a D -g N -0 79200 T -S -S -7200 -74700 T -N -0 G -22511 -1050 M -/Helvetica-ISOLatin1 $ -/Helvetica & P -/Helvetica-ISOLatin1 F 1000 o f -(\255 ) h -(7) h -( \255) h -300 -2485 M --7200 74700 T -R - -S -N -7500 -73600 M -53700 -73600 L -S -100 w -0 c -0 j -2 i -0.00 G k -R -R - -R -S -7200 -7200 T -N -0 G -300 -1200 M -300 -3200 M -/Times-Roman-ISOLatin1 $ -/Times-Roman & P -/Times-Roman-ISOLatin1 F 1200 o f -23.3 0 32 (A 5 instruction sequence is used to load the quadword containing the byte, update the byte with) W -300 -4600 M -9.7 0 32 (the right value and store the result back to memory. If threadA starts this operation and is inter\255) W -300 -6000 M -224.5 0 32 (rupted between the load and store and threadB gets control and updates byte[0] or byte[2]) W -300 -7400 M -(threadB's changes will be overwritten when threadA completes it sequence.) h -300 -9400 M -134.1 0 32 (Programs that work on nonshared data on VAX and MIPS aren't affected because they have) W -300 -10800 M -51.6 0 32 (`atomic' read and write access at the byte granularity level. The same program might fail on a) W -300 -12200 M -29.0 0 32 (64\255bit system and must be coded appropriately by using longword or quadword data aligned on) W -300 -13600 M -(natural boundaries.) h -n 0.667 o f -0.0 538.0 m -(1) h -0 -538.0 m -300 -15600 M -300 -17600 M -/Helvetica-BoldOblique-ISOLatin1 $ -/Helvetica-BoldOblique & P -/Helvetica-BoldOblique-ISOLatin1 F 1200 o f -(Read/Write Ordering) h -300 -19200 M -300 -21200 M -/Times-Roman-ISOLatin1 F 1200 o f -183.7 0 32 (Some 64\255bit multiprocessor systems pose an additional problem for applications developers. ) W -300 -22600 M -134.1 0 32 (They do not guarantee write ordering between multiple processors) W -n 0.667 o f -0.0 538.0 m -134.1 0 32 (2) W -0 -538.0 m -n 1.500 o f -134.1 0 32 (. If variable A and B are) W -300 -24000 M -33.7 0 32 (written to memory in order on one processor they will appear to be written in that order on that) W -300 -25400 M -22.1 0 32 (processor but might appear in a different order on another processor. Multiple programs and/or) W -300 -26800 M -215.6 0 32 (multithreaded programs running on a multiprocessor system sharing data cannot depend on) W -300 -28200 M -(write ordering. They must use memory barrier instructions to order writes.) h -300 -30200 M -300 -32200 M -/Helvetica-BoldOblique-ISOLatin1 F 1200 o f -(Migration Aids) h -300 -33800 M -300 -35800 M -/Times-Roman-ISOLatin1 F 1200 o f -31.2 0 32 (Lint is an effective tool used to find argument mismatches and dubious assignments. Programs) W -300 -37200 M -(written in ANSI C benefit from tighter control in these areas as well.) h -300 -39200 M -37.7 0 32 (64\255bit OSF products will include a 32\255bit to 64\255bit portability guide in addition to the ULTRIX) W -300 -40600 M -(to OSF migration guide.) h -300 -42600 M -300 -44600 M -/Helvetica-BoldOblique-ISOLatin1 F 1200 o f -(Conclusion) h -300 -46200 M -300 -48200 M -/Times-Roman-ISOLatin1 F 1200 o f -16.6 0 32 (Most 32\255bit OSF programs should compile and run normally on 64\255bit OSF systems. Programs) W -300 -49600 M -44.2 0 32 (that do not pay attention to the proper use of datatypes my fail but can be easily fixed with mi\255) W -300 -51000 M -43.8 0 32 (nor changes. The use of lint and/or ANSI C features will detect these abuses and the corrected) W -300 -52400 M -(program will be backwards source compatible.) h -300 -54400 M -79.6 0 32 (Programs that do not read or write data containing pointers or long variables will have a great) W -300 -55800 M -27.9 0 32 (deal of interoperability and are also likely to run unchanged. Programs that do not have to pro\255) W -300 -57200 M -(duce or consume data for 32\255bit programs should run unchanged.) h --7200 7200 T -R - -S -7200 -68400 T -N -0 G -300 -1200 M -/Times-Roman-ISOLatin1 F 1000 o f -0.0 448.0 m -(1) h -0 -448.0 m -900 -1200 M -(longword is equivelent to the int datatype and quadword is equivelent to the long datatype) h -300 -3000 M -0.0 448.0 m -(2) h -0 -448.0 m -900 -3000 M -(I/O devices are defined as processors) h --7200 68400 T -R - -showpage -$P e - -%%Page: 8 8 -/$P a D -g N -0 79200 T -S -S -7200 -74700 T -N -0 G -22511 -1050 M -/Helvetica-ISOLatin1 $ -/Helvetica & P -/Helvetica-ISOLatin1 F 1000 o f -(\255 ) h -(8) h -( \255) h -300 -2485 M --7200 74700 T -R - -S -N -7500 -73600 M -53700 -73600 L -S -100 w -0 c -0 j -2 i -0.00 G k -R -R - -R -S -7200 -7200 T -N -0 G -300 -1200 M -/Times-Roman-ISOLatin1 $ -/Times-Roman & P -/Times-Roman-ISOLatin1 F 1200 o f -67.2 0 32 (Programs that must deal with scalar data produced by 32\255bit programs may require minor data) W -300 -2600 M -102.9 0 32 (definition changes. Programs that must deal with data containing 32\255bit pointers may require) W -300 -4000 M -(significantly more work.) h -300 -6000 M -300 -7400 M -300 -9400 M -300 -10836 M --7200 7200 T -R - -showpage -$P e - -%%Trailer -$D restore -end % DEC_WRITE_dict -%%Pages: 8 -%%DocumentFonts: Helvetica-Bold-ISOLatin1 -%%+ Times-Roman-ISOLatin1 -%%+ Times-Italic-ISOLatin1 -%%+ Helvetica-ISOLatin1 -%%+ Helvetica-BoldOblique-ISOLatin1 -%%+ Symbol - diff --git a/src/doc/bin/alpha_portability.ps b/src/doc/bin/alpha_portability.ps deleted file mode 100644 index d6685d3db9caf75ad711bd18ed2d9906ffb06b15..0000000000000000000000000000000000000000 --- a/src/doc/bin/alpha_portability.ps +++ /dev/null @@ -1,2635 +0,0 @@ -%!PS-Adobe-2.1 -%%Creator: DECwrite T2.0-IFT -%%+Copyright (c) 1990 DIGITAL EQUIPMENT CORPORATION. -%%+All Rights Reserved. -%%DocumentFonts: (atend) -%%EndComments -%%BeginProcSet DEC_WRITE 1.07 -/DEC_WRITE_dict 150 dict def DEC_WRITE_dict begin/$D save def/$I 0 def/$S 0 -def/$C matrix def/$R matrix def/$L matrix def/$E matrix def/pat1{/px exch -def/pa 8 array def 0 1 7{/py exch def/pw 4 string def 0 1 3{pw exch px py 1 -getinterval putinterval}for pa py pw put}for}def/pat2{/pi exch def/cflag -exch def save cflag 1 eq{eoclip}{clip}ifelse newpath{clippath -pathbbox}stopped not{/ph exch def/pw exch def/py exch def/px exch def/px px -3072 div floor 3072 mul def/py py 3072 div floor 3072 mul def px py -translate/pw pw px sub 3072 div floor 1 add cvi def/ph ph py sub 3072 div -floor 1 add cvi def pw 3072 mul ph 3072 mul scale/pw pw 32 mul def/ph ph 32 -mul def/px 0 def/py 0 def pw ph pi[pw 0 0 ph 0 0]{pa py get/px px 32 add -def px pw ge{/px 0 def/py py 1 add 8 mod def}if}pi type/booleantype -eq{imagemask}{image}ifelse}if restore}def/PS{/_op exch def/_np 8 string def -0 1 7{/_ii exch def/num _op _ii get def _np 7 _ii sub num -4 bitshift PX -num 15 and 4 bitshift -4 bitshift PX 4 bitshift or put}for _np}def/PX{[15 7 -11 3 13 5 9 1 14 6 10 2 12 4 8 0]exch get}def/FR{0.7200 0 $E defaultmatrix -dtransform/yres exch def/xres exch def xres dup mul yres dup mul add -sqrt}def/SU{/_sf exch def/_sa exch def/_cs exch def/_mm $C currentmatrix -def/rm _sa $R rotate def/sm _cs dup $L scale def sm rm _mm _mm concatmatrix -_mm concatmatrix pop 1 0 _mm dtransform/y1 exch def/x1 exch def/_vl x1 dup -mul y1 dup mul add sqrt def/_fq FR _vl div def/_na y1 x1 atan def _mm 2 get -_mm 1 get mul _mm 0 get _mm 3 get mul sub 0 gt{{neg}/_sf load -concatprocs/_sf exch def}if _fq _na/_sf load setscreen}def/BO{/_yb exch -def/_xb exch def/_bv _bs _yb _bw mul _xb 8 idiv add get def/_mk 1 7 _xb 8 -mod sub bitshift def _bv _mk and 0 ne $I 1 eq xor}def/BF{DEC_WRITE_dict -begin/_yy exch def/_xx exch def/_xi _xx 1 add 2 div _bp mul cvi def/_yi _yy -1 add 2 div _bp mul cvi def _xi _yi BO{/_nb _nb 1 add def 1}{/_fb _fb 1 add -def 0}ifelse end}def/setpattern{/_cz exch def/_bw exch def/_bp exch def/_bs -exch PS def/_nb 0 def/_fb 0 def _cz 0/BF load SU{}settransfer _fb _fb _nb -add div setgray/$S 1 def}def/invertpattern{$S 0 eq{{1 exch -sub}currenttransfer concatprocs settransfer}if}def/invertscreen{/$I 1 -def/$S 0 def}def/revertscreen{/$I 0 def}def/setrect{/$h exch def/$w exch -def/$y exch def/$x exch def newpath $x $y moveto $w $x add $y lineto $w $x -add $h $y add lineto $x $h $y add lineto closepath}def/concatprocs{/_p2 -exch cvlit def/_p1 exch cvlit def/_pn _p1 length _p2 length add array def -_pn 0 _p1 putinterval _pn _p1 length _p2 putinterval _pn -cvx}def/OF/findfont load def/findfont{dup DEC_WRITE_dict exch -known{DEC_WRITE_dict exch get}if DEC_WRITE_dict/OF get exec}def -mark/ISOLatin1Encoding -8#000 1 8#001{StandardEncoding exch get}for /emdash/endash -8#004 1 8#025{StandardEncoding exch get}for /quotedblleft/quotedblright -8#030 1 8#054{StandardEncoding exch get}for /minus 8#056 1 8#217 -{StandardEncoding exch get}for/dotlessi 8#301 1 8#317{StandardEncoding -exch get}for/space/exclamdown/cent/sterling/currency/yen/brokenbar/section -/dieresis/copyright/ordfeminine/guillemotleft/logicalnot/hyphen/registered -/macron/degree/plusminus/twosuperior/threesuperior/acute/mu/paragraph -/periodcentered/cedilla/onesuperior/ordmasculine/guillemotright/onequarter -/onehalf/threequarters/questiondown/Agrave/Aacute/Acircumflex/Atilde -/Adieresis/Aring/AE/Ccedilla/Egrave/Eacute/Ecircumflex/Edieresis/Igrave -/Iacute/Icircumflex/Idieresis/Eth/Ntilde/Ograve/Oacute/Ocircumflex/Otilde -/Odieresis/multiply/Oslash/Ugrave/Uacute/Ucircumflex/Udieresis/Yacute/Thorn -/germandbls/agrave/aacute/acircumflex/atilde/adieresis/aring/ae/ccedilla -/egrave/eacute/ecircumflex/edieresis/igrave/iacute/icircumflex/idieresis -/eth/ntilde/ograve/oacute/ocircumflex/otilde/odieresis/divide/oslash/ugrave -/uacute/ucircumflex/udieresis/yacute/thorn/ydieresis -256 array astore def cleartomark -/encodefont{findfont dup maxlength dict begin{1 index/FID ne{def}{pop -pop}ifelse}forall/Encoding exch def dup/FontName exch def currentdict -definefont end}def/loads{/$/ISOLatin1Encoding load def/&/encodefont load -def/*/invertpattern load def/+/revertscreen load def/-/invertscreen load -def/:/concatprocs load def/^/setpattern load def/~/pat1 load def/_/pat2 -load def/@/setrect load def/A/arcn load def/B/ashow load def/C/curveto load -def/D/def load def/E/eofill load def/F/findfont load def/G/setgray load -def/H/closepath load def/I/clip load def/J/fill load def/K/kshow load -def/L/lineto load def/M/moveto load def/N/newpath load def/O/rotate load -def/P/pop load def/R/grestore load def/S/gsave load def/T/translate load -def/U/sub load def/V/div load def/W/widthshow load def/X/exch load -def/Y/awidthshow load def/a/save load def/c/setlinecap load def/d/setdash -load def/e/restore load def/f/setfont load def/g/initclip load def/h/show -load def/i/setmiterlimit load def/j/setlinejoin load def/k/stroke load -def/l/rlineto load def/m/rmoveto load def/n/currentfont load -def/o/scalefont load def/p/currentpoint load def/q/setrgbcolor load -def/r/currenttransfer load def/s/scale load def/t/setmatrix load -def/u/settransfer load def/w/setlinewidth load def/x/matrix load -def/y/currentmatrix load def}def -end -%%EndProcSet -%%EndProlog -%%BeginSetup -DEC_WRITE_dict begin -loads -version cvi 23.0 gt { -currentdict {dup type /arraytype eq -{bind def} {pop pop} ifelse} forall} if -0.0100 0.0100 s - -%%EndSetup -%%Page: 1 1 -/$P a D -g N -0 79200 T -S -R -S -7200 -7200 T -N -0 G -5947 -1650 M -/Helvetica-Bold-ISOLatin1 $ -/Helvetica-Bold & P -/Helvetica-Bold-ISOLatin1 F 1800 o f -(Porting C Applications DEC OSF/1 Alpha) h -17298 -4200 M -n 0.667 o f -(Lu Anne Van de Pas ) h -18565 -6600 M -( ) h -300 -11400 M -/Helvetica-ISOLatin1 $ -/Helvetica & P -/Helvetica-ISOLatin1 F 1200 o f -103.3 0 32 (The DEC OSF/1 V1.2 system takes advantage of the full 64\255bit capabilities of the Al\255) W -300 -12800 M -80.2 0 32 (pha architecture. In doing so, it introduces a number of extended capabilities beyond) W -300 -14200 M -311.4 0 32 (32\255bit architectures that can effect the portability and interoperability of programs. ) W -300 -15600 M -186.2 0 32 (Careful coding practices can help reduce these inconsistencies. The following sec\255) W -300 -17000 M -106.2 0 32 (tions will look at specific aspects of the C language and explain certain programming) W -300 -18400 M -70.1 0 32 (techniques that will help in both new program development and the porting of existing) W -300 -19800 M -(programs from DEC ULTRIX to DEC OSF/1 Alpha systems. ) h -300 -23450 M -/Helvetica-Bold-ISOLatin1 F 1400 o f -(Overview) h -300 -26100 M -/Helvetica-ISOLatin1 F 1200 o f -2.8 0 32 (The ease of moving a C program from a 32\255bit VAX or MIPS architecture to a full 64\255bit) W -300 -27500 M -159.3 0 32 (implementation of the Alpha architecture depends upon: 1. the overall coding disci\255) W -300 -28900 M -203.6 0 32 (plines employed in the application, and 2. the use of nonstandard system features. ) W -300 -30300 M -24.1 0 32 (For example, a program written with adherence to the ANSI C standard, using function) W -300 -31700 M -39.2 0 32 (prototypes, and having no assumption about the machine size of data types or system) W -300 -33100 M -100.8 0 32 (architectural specifics, can be ported with ease. Special care may need to be taken) W -300 -34500 M -42.9 0 32 (when mixing 64\255bit and 32\255bit systems through data sharing mechanisms such as net\255) W -300 -35900 M -(works, databases, and shared file systems.) h -300 -37300 M -300 -38700 M -20.7 0 32 (At a high level, the general coding issues can be outlined by examining specifics in the) W -300 -40100 M -60.6 0 32 (host \(build\) and target \(runtime\) environment of the DEC OSF/1 Alpha system. Each) W -300 -41500 M -108.0 0 32 (of the areas described below affects the portability of the application. The program\255) W -300 -42900 M -198.6 0 32 (ming techniques and examples in the remaining sections will show in detail how to) W -300 -44300 M -(code or recode your program.) h -300 -46300 M -/Symbol F 1200 o f -(\267) h -2100 -46300 M -/Helvetica-ISOLatin1 F 1200 o f -(Development environment) h -2100 -47700 M -2100 -49100 M -17.7 0 32 (When you port an application to the DEC OSF/1 Alpha system you must recompile) W -2100 -50500 M -15.0 0 32 (the application or use the binary translator. \(See MX documentation for information) W -2100 -51900 M -(on translating executables from the MIPS architecture to Alpha.\) ) h -2100 -53300 M -6060 -53300 M -2100 -54700 M -25.1 0 32 (The DEC OSF/1 Alpha development environment has a similar compilation, linking,) W -2100 -56100 M -64.9 0 32 (debugging, and performance analysis tools as RISC ULTRIX. The Alpha develop\255) W -2100 -57500 M -31.8 0 32 (ment environment, C compiler and related tools, has additional support for ANSI C,) W -2100 -58900 M -64.8 0 32 (64\255bit data types and addresses, and shared libraries. Lint has additional features) W -2100 -60300 M -309.7 0 32 (to help find 32\255to\25564 bit conversion problems. ) W -2100 -61700 M --7200 7200 T -R - -showpage -$P e - -%%Page: 2 2 -/$P a D -g N -0 79200 T -S -R -S -7200 -7200 T -N -0 G -300 -1200 M -/Symbol F 1200 o f -(\267) h -2100 -1200 M -/Helvetica-ISOLatin1 $ -/Helvetica & P -/Helvetica-ISOLatin1 F 1200 o f -(Compiler optimizations: ) h -2100 -2600 M -2100 -4000 M -89.4 0 32 (The DEC OSF/1 Alpha C compiler has additional optimizations and code schedul\255) W -2100 -5400 M -47.5 0 32 (ing specific to the Alpha architecture. Because of this you may notice different er\255) W -2100 -6800 M -(ror messages between ULTRIX and Alpha systems. ) h -300 -8800 M -/Symbol F 1200 o f -(\267) h -2100 -8800 M -/Helvetica-ISOLatin1 F 1200 o f -(Data Representation: ) h -2100 -10200 M -6060 -10200 M -2100 -11600 M -150.6 0 32 (In order to take advantage of the 64\255bit architecture the C data types have been) W -2100 -13000 M -50.6 0 32 (modified to include a 64\255bit type. In the table below, 'int' is unchanged as a 32 bit) W -2100 -14400 M -123.4 0 32 (entity, and long is redefined to be 64 bits. In order to extend the address space, ) W -2100 -15800 M -(pointers on Alpha are defined to be 64 bits.) h -2100 -17200 M -6060 -17200 M -2100 -18600 M -158.5 0 32 (The DEC OSF/1 Alpha system has also defined a 'long long' data type to be 64) W -2100 -20000 M -47.3 0 32 (bits. It provides the unique name for a 64\255bit data type that may provide additional) W -2100 -21400 M -(interoperability between 32\255bit and 64\255bit systems. ) h -2100 -22800 M -6060 -22800 M -2100 -24200 M -39.8 0 32 (Similar to VAX and MIPS systems, the DEC OSF/1 Alpha system uses right\255to\255left) W -2100 -25600 M -(byte order for integer types \(little\255endian\).) h -29100 -25600 M -2100 -27000 M -300 -54400 M -S -0 26300 m -p T -0 -26300 45901 26300 @ I N -N -S -50 -50 T -N -0 G -5171 -1500 M -/Times-Roman-ISOLatin1 $ -/Times-Roman & P -/Times-Roman-ISOLatin1 F 1200 o f -(Data type ) h -600 -2884 M --50 50 T -R - -S -15325 -50 T -N -0 G -737 -1500 M -/Times-Roman-ISOLatin1 F 1200 o f -(32\255bit MIPS or VAX system) h -( ) h -4521 -2900 M -(\(size in bits\) ) h --15325 50 T -R - -S -30600 -50 T -N -0 G -2609 -1500 M -/Times-Roman-ISOLatin1 F 1200 o f -( 64\255bit Alpha system ) h -4659 -2900 M -(\(size in bits\)) h --30600 50 T -R - -S -50 -3900 T -N -0 G -6605 -1500 M -/Times-Roman-ISOLatin1 F 1200 o f -(char) h --50 3900 T -R - -S -15325 -3900 T -N -0 G -7337 -1500 M -/Times-Roman-ISOLatin1 F 1200 o f -(8) h --15325 3900 T -R - -S -30600 -3900 T -N -0 G -7325 -1500 M -/Times-Roman-ISOLatin1 F 1200 o f -(8) h --30600 3900 T -R - -S -50 -6350 T -N -0 G -6437 -1500 M -/Times-Roman-ISOLatin1 F 1200 o f -(short) h --50 6350 T -R - -S -15325 -6350 T -N -0 G -7037 -1500 M -/Times-Roman-ISOLatin1 F 1200 o f -(16) h --15325 6350 T -R - -S -30600 -6350 T -N -0 G -7025 -1500 M -/Times-Roman-ISOLatin1 F 1200 o f -(16) h --30600 6350 T -R - -S -50 -8800 T -N -0 G -7004 -1500 M -/Times-Roman-ISOLatin1 F 1200 o f -(int) h --50 8800 T -R - -S -15325 -8800 T -N -0 G -7037 -1500 M -/Times-Roman-ISOLatin1 F 1200 o f -(32) h --15325 8800 T -R - -S -30600 -8800 T -N -0 G -7025 -1500 M -/Times-Roman-ISOLatin1 F 1200 o f -(32) h --30600 8800 T -R - -S -50 -11250 T -N -0 G -6570 -1500 M -/Times-Roman-ISOLatin1 F 1200 o f -(long) h --50 11250 T -R - -S -15325 -11250 T -N -0 G -7037 -1500 M -/Times-Roman-ISOLatin1 F 1200 o f -(32) h --15325 11250 T -R - -S -30600 -11250 T -N -0 G -7025 -1500 M -/Times-Roman-ISOLatin1 F 1200 o f -(64) h --30600 11250 T -R - -S -50 -13700 T -N -0 G -5354 -1500 M -/Times-Roman-ISOLatin1 F 1200 o f -(long long) h --50 13700 T -R - -S -15325 -13700 T -N -0 G -4421 -1500 M -/Times-Roman-ISOLatin1 F 1200 o f -(Not available) h --15325 13700 T -R - -S -30600 -13700 T -N -0 G -7025 -1500 M -/Times-Roman-ISOLatin1 F 1200 o f -(64) h --30600 13700 T -R - -S -50 -16150 T -N -0 G -6537 -1500 M -/Times-Roman-ISOLatin1 F 1200 o f -(float) h -600 -2884 M --50 16150 T -R - -S -15325 -16150 T -N -0 G -1037 -1500 M -/Times-Roman-ISOLatin1 F 1200 o f -(32 \( MIPS: IEEE Single\)) h -600 -2900 M -( \(VAX: F float\)) h --15325 16150 T -R - -S -30600 -16150 T -N -0 G -3192 -1500 M -/Times-Roman-ISOLatin1 F 1200 o f -(32 \(IEEE Single\)) h -600 -2900 M -( ) h --30600 16150 T -R - -S -50 -20000 T -N -0 G -6004 -1500 M -/Times-Roman-ISOLatin1 F 1200 o f -(double) h -600 -2884 M --50 20000 T -R - -S -15325 -20000 T -N -0 G -954 -1500 M -/Times-Roman-ISOLatin1 F 1200 o f -(64 \(MIPS: IEEE Double\)) h -600 -2900 M -( \(VAX: G or D float\)) h --15325 20000 T -R - -S -30600 -20000 T -N -0 G -2810 -1500 M -/Times-Roman-ISOLatin1 F 1200 o f -(64 \(IEEE Double\)) h -600 -2884 M --30600 20000 T -R - -S -50 -23850 T -N -0 G -5937 -1500 M -/Times-Roman-ISOLatin1 F 1200 o f -(pointer) h --50 23850 T -R - -S -15325 -23850 T -N -0 G -7037 -1500 M -/Times-Roman-ISOLatin1 F 1200 o f -(32) h --15325 23850 T -R - -S -30600 -23850 T -N -0 G -7025 -1500 M -/Times-Roman-ISOLatin1 F 1200 o f -(64) h --30600 23850 T -R - -S -N -0 -3875 M -46001 -3875 L -S -50 w -0 c -0 j -2 i -0.00 G k -R -R - -S -N -0 -6325 M -46001 -6325 L -S -50 w -0 c -0 j -2 i -0.00 G k -R -R - -S -N -0 -8775 M -46001 -8775 L -S -50 w -0 c -0 j -2 i -0.00 G k -R -R - -S -N -0 -11225 M -46001 -11225 L -S -50 w -0 c -0 j -2 i -0.00 G k -R -R - -S -N -0 -13675 M -46001 -13675 L -S -50 w -0 c -0 j -2 i -0.00 G k -R -R - -S -N -0 -16125 M -46001 -16125 L -S -50 w -0 c -0 j -2 i -0.00 G k -R -R - -S -N -0 -19975 M -46001 -19975 L -S -50 w -0 c -0 j -2 i -0.00 G k -R -R - -S -N -0 -23825 M -46001 -23825 L -S -50 w -0 c -0 j -2 i -0.00 G k -R -R - -R -45901 0 m -300 -56400 M -300 -58400 M -/Symbol F 1200 o f -(\267) h -2100 -58400 M -/Helvetica-ISOLatin1 F 1200 o f -(Data access) h -2100 -59800 M -2701 -59800 M -2100 -61200 M -44.5 0 32 (The VAX and MIPS architectures are both byte and word addressable. Alpha sup\255) W -2100 -62600 M -16.7 0 32 (ports only memory accesses of longword \(32 bits\) or quadword \(64 bits\). Byte and) W -2100 -64000 M -59.3 0 32 (word accesses are accomplished by multiple instructions which load a longword or) W --7200 7200 T -R - -showpage -$P e - -%%Page: 3 3 -/$P a D -g N -0 79200 T -S -R -S -7200 -7200 T -N -0 G -2100 -1200 M -/Helvetica-ISOLatin1 $ -/Helvetica & P -/Helvetica-ISOLatin1 F 1200 o f -23.6 0 32 (quadword, mask, and shift to get the desired entity. This lack of a single operation) W -2100 -2600 M -22.6 0 32 (for byte and word access may produce incorrect results in cases where you are ac\255) W -2100 -4000 M -81.9 0 32 (cessing adjacent byte or word entities in shared memory segments. For instance, ) W -2100 -5400 M -46.7 0 32 (a multi\255threaded application or multiple processes that has access to adjacent byte) W -2100 -6800 M -289.5 0 32 (data through shared memory or shared memory\255mapped files will have to use) W -2100 -8200 M -309.2 0 32 (thread mutual exclusion locking functions or semaphone locks, respectively, to) W -2100 -9600 M -(avoid conflicts with accesses to adjacent byte or word data items. ) h -300 -11600 M -/Symbol F 1200 o f -(\267) h -2100 -11600 M -/Helvetica-ISOLatin1 F 1200 o f -(Data Alignment) h -2100 -13000 M -( ) h -2100 -14400 M -55.6 0 32 (On both MIPS and ALPHA systems the data alignment is implied by the data type. ) W -2100 -15800 M -50.8 0 32 (For instance, an ) W -/Helvetica-Oblique-ISOLatin1 $ -/Helvetica-Oblique & P -/Helvetica-Oblique-ISOLatin1 F 1200 o f -50.8 0 32 (int) W -/Helvetica-ISOLatin1 F 1200 o f -50.8 0 32 ( \(32 bits\) is aligned on a 4 byte boundary. On MIPS systems,) W -2100 -17200 M -2.3 0 32 (a ) W -/Helvetica-Oblique-ISOLatin1 F 1200 o f -2.3 0 32 (long ) W -/Helvetica-ISOLatin1 F 1200 o f -2.3 0 32 (\(32 bits\) is also aligned on a 4 byte boundary. But on Alpha systems, a) W -/Helvetica-Oblique-ISOLatin1 F 1200 o f -2.3 0 32 ( long) W -2100 -18600 M -/Helvetica-ISOLatin1 F 1200 o f -212.9 0 32 (\(64 bits\) is aligned on 8 byte boundaries. If using assembly language, you will) W -2100 -20000 M -85.4 0 32 (need to understand and code according to these alignment restrictions. If using a) W -2100 -21400 M -55.9 0 32 (high\255level language such as C, the compiler will take care of this alignment for you) W -2100 -22800 M -70.5 0 32 (but it is still important that you understand these alignment differences when using) W -2100 -24200 M -137.0 0 32 (long and pointer types in structure definitions that are shared between 32\255bit and) W -2100 -25600 M -(64\255bit systems. ) h -300 -27600 M -/Symbol F 1200 o f -(\267) h -2100 -27600 M -/Helvetica-ISOLatin1 F 1200 o f -(File system) h -2100 -29000 M -6060 -29000 M -2100 -30400 M -150.0 0 32 (On the 32\255bit systems of MIPS and VAX, files and file systems were limited to 2) W -2100 -31800 M -178.3 0 32 (gigabytes in size. This limit was imposed by the programming interface and file) W -2100 -33200 M -65.3 0 32 (system which used a 32\255bit integer to represent the file offset in bytes \() W -/Helvetica-Oblique-ISOLatin1 F 1200 o f -65.3 0 32 (off_t) W -/Helvetica-ISOLatin1 F 1200 o f -65.3 0 32 (\) when) W -2100 -34600 M -101.1 0 32 (navigating within a file or file system. On a 64\255bit DEC OSF/1 Alpha system, you) W -2100 -36000 M -87.7 0 32 (can now build much larger files and file systems. ) W -/Helvetica-Oblique-ISOLatin1 F 1200 o f -87.7 0 32 (off_t ) W -/Helvetica-ISOLatin1 F 1200 o f -87.7 0 32 ( is defined to be a ) W -/Helvetica-Oblique-ISOLatin1 F 1200 o f -87.7 0 32 (long) W -/Helvetica-ISOLatin1 F 1200 o f -87.7 0 32 ( on) W -2100 -37400 M -(Alpha systems. ) h -2100 -38800 M -6060 -38800 M -90.9 0 32 (Given this extended capability, it is possible to build files and files systems) W -2100 -40200 M -61.4 0 32 (that can not be fully accessed by 32\255bit systems. This is very important to keep in) W -2100 -41600 M -4.2 0 32 (mind when working in an distributed environment where file systems are shared be\255) W -2100 -43000 M -(tween 32 and 64 bit systems. ) h -2100 -44400 M -2100 -45800 M -300 -49450 M -/Helvetica-Bold-ISOLatin1 $ -/Helvetica-Bold & P -/Helvetica-Bold-ISOLatin1 F 1400 o f -(Coding Guidelines) h -300 -52100 M -/Helvetica-ISOLatin1 F 1200 o f -34.5 0 32 (When developing or porting C code the RISC ULTRIX and DEC OSF/1 Alpha systems) W -300 -53500 M -111.4 0 32 (are similar in a number of ways. Both systems are little endian. Both support 32\255bit) W -300 -54900 M -81.5 0 32 (integers, 16\255bit shorts, 8\255bit characters, and IEEE single and double floating point for\255) W -300 -56300 M -52.1 0 32 (mats. And both have a similar development environment and C compiler. The major) W -300 -57700 M -36.5 0 32 (differences you need to consider in coding are in the size of addresses, the availability) W -300 -59100 M -9.4 0 32 (of 64\255bit integer types, the data type alignment restrictions, byte and word accessibility,) W -300 -60500 M -(and interoperability between 32\255bit and 64\255bit systems. ) h -300 -62500 M -6060 -62500 M -300 -63900 M -106.2 0 32 (The remainder of this chapter will go through specific C coding examples and outline) W --7200 7200 T -R - -showpage -$P e - -%%Page: 4 4 -/$P a D -g N -0 79200 T -S -R -S -7200 -7200 T -N -0 G -300 -1200 M -/Helvetica-ISOLatin1 $ -/Helvetica & P -/Helvetica-ISOLatin1 F 1200 o f -2.8 0 32 (areas that may need to be changed for this 64\255bit architecture. Many of these changes) W -300 -2600 M -91.0 0 32 (deal with the "cleaning up" of data type usage, so that you can have code that works) W -300 -4000 M -(on both the 32\255bit and 64\255bits systems.) h -300 -7650 M -/Helvetica-Bold-ISOLatin1 $ -/Helvetica-Bold & P -/Helvetica-Bold-ISOLatin1 F 1400 o f -(Header files \255 Constant definitions) h -300 -10300 M -/Helvetica-ISOLatin1 F 1200 o f -131.9 0 32 (On Alpha, there are a few changes to the standard header files that are directly re\255) W -300 -11700 M -(lated to 64\255bit data types. These include: ) h -300 -13100 M -( ) h -300 -14500 M -(/usr/include/limits.h ) h -300 -35700 M -S -0 20700 m -p T -0 -20700 39601 20700 @ I N -N -S -50 -50 T -N -0 G -2835 -1500 M -/Times-Roman-ISOLatin1 $ -/Times-Roman & P -/Times-Roman-ISOLatin1 F 1200 o f -(Constant) h -600 -2884 M --50 50 T -R - -S -10037 -50 T -N -0 G -2502 -1500 M -/Times-Roman-ISOLatin1 F 1200 o f -(Definition) h -600 -2884 M --10037 50 T -R - -S -20024 -50 T -N -0 G -2785 -1500 M -/Times-Roman-ISOLatin1 F 1200 o f -(Value on) h -2769 -2900 M -(ULTRIX) h --20024 50 T -R - -S -30011 -50 T -N -0 G -2437 -1500 M -/Times-Roman-ISOLatin1 F 1200 o f -(Value on ) h -3303 -2900 M -(Alpha) h --30011 50 T -R - -S -50 -3900 T -N -0 G -600 -1500 M -/Times-Roman-ISOLatin1 F 1200 o f -(LONG_BIT) h -600 -2884 M --50 3900 T -R - -S -10037 -3900 T -N -0 G -600 -1500 M -/Times-Roman-ISOLatin1 F 1200 o f -(Number of bits in) h -600 -2900 M -(a long) h --10037 3900 T -R - -S -20024 -3900 T -N -0 G -600 -1500 M -/Times-Roman-ISOLatin1 F 1200 o f -( 32) h -600 -2884 M --20024 3900 T -R - -S -30011 -3900 T -N -0 G -600 -1500 M -/Times-Roman-ISOLatin1 F 1200 o f -( 64) h -600 -2884 M --30011 3900 T -R - -S -50 -7750 T -N -0 G -600 -1500 M -/Times-Roman-ISOLatin1 F 1200 o f -(LONG_MAX) h -600 -2884 M --50 7750 T -R - -S -10037 -7750 T -N -0 G -600 -1500 M -/Times-Roman-ISOLatin1 F 1200 o f -(Maximum value) h -600 -2900 M -(of a long type) h --10037 7750 T -R - -S -20024 -7750 T -N -0 G -600 -1500 M -/Times-Roman-ISOLatin1 F 1200 o f -(0x7fffffff) h -600 -2884 M --20024 7750 T -R - -S -30011 -7750 T -N -0 G -600 -1500 M -/Times-Roman-ISOLatin1 F 1200 o f -(0x7fffffffffffffff) h -600 -2884 M --30011 7750 T -R - -S -50 -11600 T -N -0 G -600 -1500 M -/Times-Roman-ISOLatin1 F 1200 o f -(LONG_MIN) h -600 -2884 M --50 11600 T -R - -S -10037 -11600 T -N -0 G -600 -1500 M -/Times-Roman-ISOLatin1 F 1200 o f -(Minimum value) h -600 -2900 M -(of a long type) h --10037 11600 T -R - -S -20024 -11600 T -N -0 G -600 -1500 M -/Times-Roman-ISOLatin1 F 1200 o f -(0x80000000) h -600 -2884 M --20024 11600 T -R - -S -30011 -11600 T -N -0 G -600 -1500 M -/Times-Roman-ISOLatin1 F 1200 o f -(0x80000000000) h -600 -2900 M -(00000) h --30011 11600 T -R - -S -50 -15450 T -N -0 G -600 -1500 M -/Times-Roman-ISOLatin1 F 1200 o f -(ULONG_MAX) h -600 -2884 M --50 15450 T -R - -S -10037 -15450 T -N -0 G -600 -1500 M -/Times-Roman-ISOLatin1 F 1200 o f -(Maximun value) h -600 -2900 M -(of an unsigned) h -600 -4300 M -(long) h --10037 15450 T -R - -S -20024 -15450 T -N -0 G -600 -1500 M -/Times-Roman-ISOLatin1 F 1200 o f -(4294967295U) h -600 -2884 M --20024 15450 T -R - -S -30011 -15450 T -N -0 G -600 -1500 M -/Times-Roman-ISOLatin1 F 1200 o f -(1844674407370) h -600 -2900 M -(9551615U) h -600 -4284 M --30011 15450 T -R - -S -N -10012 0 M -10012 -20775 L -S -50 w -0 c -0 j -2 i -0.00 G k -R -R - -S -N -19999 0 M -19999 -20775 L -S -50 w -0 c -0 j -2 i -0.00 G k -R -R - -S -N -29986 0 M -29986 -20775 L -S -50 w -0 c -0 j -2 i -0.00 G k -R -R - -S -N -0 -3875 M -39701 -3875 L -S -50 w -0 c -0 j -2 i -0.00 G k -R -R - -S -N -0 -7725 M -39701 -7725 L -S -50 w -0 c -0 j -2 i -0.00 G k -R -R - -S -N -0 -11575 M -39701 -11575 L -S -50 w -0 c -0 j -2 i -0.00 G k -R -R - -S -N -0 -15425 M -39701 -15425 L -S -50 w -0 c -0 j -2 i -0.00 G k -R -R - -S -25.0 -20675.0 39551.0 20650.0 @ -S -50 w -0 c -0 j -2 i -0.00 G k -R -R -R -39601 0 m -40620 -35700 M -300 -38750 M -/Helvetica-Bold-ISOLatin1 F 1400 o f -(Constants) h -300 -41400 M -/Helvetica-ISOLatin1 F 1200 o f -39.5 0 32 (Some constants may have different values between 32\255bit and 64\255bit systems. For in\255) W -300 -42800 M -44.7 0 32 (stance, the hexadecimal value, 0xFFFFFFFF, has the value \2551 on a 32\255bit system and) W -300 -44200 M -60.5 0 32 (the value 4294967295 on Alpha. The table below lists a few other interesting integer) W -300 -45600 M -(constants and their values. ) h -300 -47000 M -300 -63200 M -S -0 15100 m -p T -0 -15100 39204 15100 @ I N -N -S -50 -50 T -N -0 G -2268 -1500 M -/Times-Roman-ISOLatin1 F 1200 o f -(C constant ) h -600 -2884 M --50 50 T -R - -S -10037 -50 T -N -0 G -3235 -1500 M -/Times-Roman-ISOLatin1 F 1200 o f -( Value ) h -600 -2884 M --10037 50 T -R - -S -20024 -50 T -N -0 G -2287 -1500 M -/Times-Roman-ISOLatin1 F 1200 o f -( Value on ) h -3369 -2900 M -(MIPS) h --20024 50 T -R - -S -29614 -50 T -N -0 G -2137 -1500 M -/Times-Roman-ISOLatin1 F 1200 o f -(Value on ) h -3153 -2900 M -(Alpha ) h --29614 50 T -R - -S -50 -3900 T -N -0 G -600 -1500 M -/Times-Roman-ISOLatin1 F 1200 o f -(0xFFFFFFFF) h --50 3900 T -R - -S -10037 -3900 T -N -0 G -600 -1500 M -/Times-Roman-ISOLatin1 F 1200 o f -(\(2^32\) \2551 ) h --10037 3900 T -R - -S -20024 -3900 T -N -0 G -600 -1500 M -/Times-Roman-ISOLatin1 F 1200 o f -( \2551 ) h -6360 -1500 M --20024 3900 T -R - -S -29614 -3900 T -N -0 G -600 -1500 M -/Times-Roman-ISOLatin1 F 1200 o f -(4294967295) h --29614 3900 T -R - -S -50 -6350 T -N -0 G -600 -1500 M -/Times-Roman-ISOLatin1 F 1200 o f -(4294967296) h --50 6350 T -R - -S -10037 -6350 T -N -0 G -600 -1500 M -/Times-Roman-ISOLatin1 F 1200 o f -(2^32) h -6360 -1500 M --10037 6350 T -R - -S -20024 -6350 T -N -0 G -600 -1500 M -/Times-Roman-ISOLatin1 F 1200 o f -(\(0\)) h --20024 6350 T -R - -S -29614 -6350 T -N -0 G -600 -1500 M -/Times-Roman-ISOLatin1 F 1200 o f -(4294967296) h --29614 6350 T -R - -S -50 -8800 T -N -0 G -600 -1500 M -/Times-Roman-ISOLatin1 F 1200 o f -(0x100000000) h --50 8800 T -R - -S -10037 -8800 T -N -0 G -600 -1500 M -/Times-Roman-ISOLatin1 F 1200 o f -(2^32) h --10037 8800 T -R - -S -20024 -8800 T -N -0 G -600 -1500 M -/Times-Roman-ISOLatin1 F 1200 o f -(\(0\)) h -6360 -1500 M --20024 8800 T -R - -S -29614 -8800 T -N -0 G -600 -1500 M -/Times-Roman-ISOLatin1 F 1200 o f -(4294967296) h --29614 8800 T -R - -S -50 -11250 T -N -0 G -600 -1500 M -/Times-Roman-ISOLatin1 F 1200 o f -(0xFFFFFFFFFFF) h -600 -2900 M -(FFFFF) h --50 11250 T -R - -S -10037 -11250 T -N -0 G -600 -1500 M -/Times-Roman-ISOLatin1 F 1200 o f -(\(2^64\) \2551) h -6360 -1500 M -600 -2900 M --10037 11250 T -R - -S -20024 -11250 T -N -0 G -600 -1500 M -/Times-Roman-ISOLatin1 F 1200 o f -(\2551) h -6360 -1500 M -600 -2900 M --20024 11250 T -R - -S -29614 -11250 T -N -0 G -600 -1500 M -/Times-Roman-ISOLatin1 F 1200 o f -(\2551) h -600 -2884 M --29614 11250 T -R - -S -N -10012 0 M -10012 -15175 L -S -50 w -0 c -0 j -2 i -0.00 G k -R -R - -S -N -19999 0 M -19999 -15175 L -S -50 w -0 c -0 j -2 i -0.00 G k -R -R - -S -N -29589 0 M -29589 -15175 L -S -50 w -0 c -0 j -2 i -0.00 G k -R -R - -S -N -0 -3875 M -39304 -3875 L -S -50 w -0 c -0 j -2 i -0.00 G k -R -R - -S -N -0 -6325 M -39304 -6325 L -S -50 w -0 c -0 j -2 i -0.00 G k -R -R - -S -N -0 -8775 M -39304 -8775 L -S -50 w -0 c -0 j -2 i -0.00 G k -R -R - -S -N -0 -11225 M -39304 -11225 L -S -50 w -0 c -0 j -2 i -0.00 G k -R -R - -S -25.0 -15075.0 39154.0 15050.0 @ -S -50 w -0 c -0 j -2 i -0.00 G k -R -R -R -39204 0 m --7200 7200 T -R - -showpage -$P e - -%%Page: 5 5 -/$P a D -g N -0 79200 T -S -R -S -7200 -7200 T -N -0 G -300 -1200 M -300 -2600 M -300 -5650 M -/Helvetica-Bold-ISOLatin1 $ -/Helvetica-Bold & P -/Helvetica-Bold-ISOLatin1 F 1400 o f -(Definitions and Declarations ) h -300 -9200 M -n 0.857 o f -(Structure Size) h -300 -11200 M -/Helvetica-ISOLatin1 $ -/Helvetica & P -/Helvetica-ISOLatin1 F 1200 o f -15.2 0 32 (Structures and unions on DEC OSF/1 Alpha systems change size from 32\255bit systems.) W -300 -12600 M -22.2 0 32 (This is due to the new 64\255bit data sizes and the additional alignment considerations for) W -300 -14000 M -/Helvetica-Oblique-ISOLatin1 $ -/Helvetica-Oblique & P -/Helvetica-Oblique-ISOLatin1 F 1200 o f -151.0 0 32 (long) W -/Helvetica-ISOLatin1 F 1200 o f -151.0 0 32 ( and pointer. In the example below, the structure,) W -/Helvetica-Bold-ISOLatin1 F 1200 o f -151.0 0 32 ( TextNode) W -/Helvetica-ISOLatin1 F 1200 o f -151.0 0 32 (, grows in size be\255) W -300 -15400 M -(cause all of its members double in size from 4 bytes to 8 bytes for pointer types.) h -300 -17400 M -6060 -17400 M -(struct TextNode {) h -300 -18800 M -6060 -18800 M -11820 -18800 M -(char *text;) h -300 -20200 M -6060 -20200 M -11820 -20200 M -(struct TextNode *left;) h -300 -21600 M -6060 -21600 M -11820 -21600 M -(struct TextNode *right;) h -300 -23000 M -6060 -23000 M -11820 -23000 M -(} ;) h -300 -24400 M -300 -25800 M -179.5 0 32 (This change in size is an important consideration if you are sharing data defined in) W -300 -27200 M -12.7 0 32 (structures between 32\255bit and 64\255bit systems. Be careful about using longs and point\255) W -300 -28600 M -89.1 0 32 (ers as members in shared structures. These data types now introduce sizes that are) W -300 -30000 M -216.4 0 32 (not available on 32\255bit systems. One of the most portable methods is to only use) W -300 -31400 M -136.3 0 32 (typedef types in structures and set up the types as appropriate for the system. You) W -300 -32800 M -(can automatically do this by utilizing information in the limits.h header file. ) h -300 -34200 M -300 -35600 M -191.9 0 32 (Additionally, you should be careful when building unions between ints and pointers,) W -300 -37000 M -(since they are no longer the same size. ) h -300 -38400 M -300 -41300 M -/Helvetica-Bold-ISOLatin1 F 1200 o f -(Structure Member Alignment) h -300 -43300 M -/Helvetica-ISOLatin1 F 1200 o f -107.2 0 32 (Members of structures and unions are aligned on their "natural" boundaries. That is,) W -300 -44700 M -251.9 0 32 (char is aligned on a byte boundary, short on a word boundary, int on a longword) W -300 -46100 M -(boundary, and longs and pointers on quadword boundaries. ) h -300 -47500 M -6060 -47500 M -300 -48900 M -65.2 0 32 (This means that additional space will be used for padding member alignment in struc\255) W -300 -50300 M -(tures and unions.) h -300 -52300 M -6060 -52300 M -(struct TextCountNode {) h -300 -53700 M -6060 -53700 M -( char *text; ) h -300 -55100 M -6060 -55100 M -( int size,) h -300 -56500 M -6060 -56500 M -( struct TextCountNode *left;) h -300 -57900 M -6060 -57900 M -( struct TextCountNode *right;) h -29100 -57900 M -300 -59300 M -6060 -59300 M -(};) h -300 -60700 M -300 -62100 M -132.1 0 32 (On 32\255bit systems the size of this structure would be 16 bytes. On 64\255bit Alpha sys\255) W -300 -63500 M -61.4 0 32 (tems the size of the structure would be 32 bytes: 8 bytes for each pointer and 4 bytes) W --7200 7200 T -R - -showpage -$P e - -%%Page: 6 6 -/$P a D -g N -0 79200 T -S -R -S -7200 -7200 T -N -0 G -300 -1200 M -/Helvetica-ISOLatin1 $ -/Helvetica & P -/Helvetica-ISOLatin1 F 1200 o f -(of padding after the member, ) h -/Helvetica-Bold-ISOLatin1 $ -/Helvetica-Bold & P -/Helvetica-Bold-ISOLatin1 F 1200 o f -(size) h -/Helvetica-ISOLatin1 F 1200 o f -(, for the alignment of the pointer, ) h -/Helvetica-Bold-ISOLatin1 F 1200 o f -(left.) h -40620 -1200 M -300 -3200 M -/Helvetica-ISOLatin1 F 1200 o f -167.5 0 32 (Additional padding may also be introduced at the end of structure, to assure proper) W -300 -4600 M -29.4 0 32 (structure alignment for arrays of these structures. The structure must terminate on the) W -300 -6000 M -(same alignment boundary on which it started.) h -300 -7400 M -300 -8800 M -101.1 0 32 (Given these additional alignment considerations, you should always use) W -/Helvetica-Oblique-ISOLatin1 $ -/Helvetica-Oblique & P -/Helvetica-Oblique-ISOLatin1 F 1200 o f -101.1 0 32 ( sizeof) W -/Helvetica-ISOLatin1 F 1200 o f -101.1 0 32 ( to de\255) W -300 -10200 M -132.2 0 32 (termine the size of a structure. Don't assume the size of a structure is the accumu\255) W -300 -11600 M -80.2 0 32 (lated size of all of the objects defined in it. Additional space will be taken up for pad\255) W -300 -13000 M -(ding the member alignment. ) h -300 -15000 M -155.7 0 32 (To minimize the amount of padded needed, you may want to reorder members in a) W -300 -16400 M -(structure. For example, ) h -300 -18400 M -6060 -18400 M -(struct s {) h -300 -19800 M -6060 -19800 M -11820 -19800 M -(int count;) h -300 -21200 M -6060 -21200 M -11820 -21200 M -(struct s *next;) h -300 -22600 M -6060 -22600 M -11820 -22600 M -(int total;) h -300 -24000 M -6060 -24000 M -(}) h -300 -26000 M -(has a ) h -/Helvetica-Oblique-ISOLatin1 F 1200 o f -(sizeo) h -/Helvetica-ISOLatin1 F 1200 o f -(f 24 bytes. This definition can be recoded to ) h -300 -27400 M -6060 -27400 M -300 -28800 M -6060 -28800 M -(struct s{) h -300 -30200 M -6060 -30200 M -11820 -30200 M -(struct s *next;) h -300 -31600 M -6060 -31600 M -11820 -31600 M -(int count;) h -300 -33000 M -6060 -33000 M -11820 -33000 M -(int total;) h -300 -34400 M -6060 -34400 M -(}) h -300 -36400 M -(Which has a ) h -/Helvetica-Oblique-ISOLatin1 F 1200 o f -(sizeof) h -/Helvetica-ISOLatin1 F 1200 o f -( 16 bytes.) h -300 -37800 M -300 -39200 M -300 -42100 M -/Helvetica-Bold-ISOLatin1 F 1200 o f -(Structure Alignment) h -300 -44100 M -/Helvetica-ISOLatin1 F 1200 o f -240.7 0 32 (In order to have specific members aligned on their required boundaries, structures) W -300 -45500 M -(themselves need to have the alignment of the strictest aligned member. ) h -300 -47500 M -6060 -47500 M -(struct {) h -11820 -47500 M -300 -48900 M -6060 -48900 M -11820 -48900 M -(char *text;) h -300 -50300 M -6060 -50300 M -11820 -50300 M -(int count;) h -300 -51700 M -6060 -51700 M -11820 -51700 M -(} CountedString;) h -300 -53700 M -300 -55100 M -13.1 0 32 (In the example above, the sizeof\() W -/Helvetica-Bold-ISOLatin1 F 1200 o f -13.1 0 32 (CountedString) W -/Helvetica-ISOLatin1 F 1200 o f -13.1 0 32 (\) is 16 bytes \(*) W -/Helvetica-Bold-ISOLatin1 F 1200 o f -13.1 0 32 (text) W -/Helvetica-ISOLatin1 F 1200 o f -13.1 0 32 ( = 8 bytes,) W -/Helvetica-Bold-ISOLatin1 F 1200 o f -13.1 0 32 ( count) W -/Helvetica-ISOLatin1 F 1200 o f -13.1 0 32 ( =) W -300 -56500 M -158.9 0 32 (4 bytes, tail padding = 4 bytes.\) This structure needs to be aligned on a quadword) W -300 -57900 M -31.5 0 32 (boundary because the pointer requires quadword alignment. This means that a defini\255) W -300 -59300 M -32.3 0 32 (tion that has ) W -/Helvetica-Bold-ISOLatin1 F 1200 o f -32.3 0 32 (CountedString) W -/Helvetica-ISOLatin1 F 1200 o f -32.3 0 32 ( as a member will have each reference to ) W -/Helvetica-Bold-ISOLatin1 F 1200 o f -32.3 0 32 (CountedString) W -300 -60700 M -/Helvetica-ISOLatin1 F 1200 o f -(on a quadword boundary.) h -300 -62700 M -6060 -62700 M -(CountedString CsArray[10]) h --7200 7200 T -R - -showpage -$P e - -%%Page: 7 7 -/$P a D -g N -0 79200 T -S -R -S -7200 -7200 T -N -0 G -300 -1200 M -6060 -1200 M -/Helvetica-ISOLatin1 $ -/Helvetica & P -/Helvetica-ISOLatin1 F 1200 o f -(struct {) h -300 -2600 M -6060 -2600 M -11820 -2600 M -(char line[MAX_LINE];) h -300 -4000 M -6060 -4000 M -11820 -4000 M -(struct CountedString string;) h -300 -5400 M -6060 -5400 M -(}TextAndString;) h -300 -7400 M -165.2 0 32 (In each of the above examples, the ) W -/Helvetica-Bold-ISOLatin1 $ -/Helvetica-Bold & P -/Helvetica-Bold-ISOLatin1 F 1200 o f -165.2 0 32 (CountedString) W -/Helvetica-ISOLatin1 F 1200 o f -165.2 0 32 ( structure will force alignment of) W -300 -8800 M -53.4 0 32 (the beginning of the structure to be on a quadword boundary. In the first declaration) W -300 -10200 M -162.3 0 32 (above, no additional padding \(beyond 4 bytes of tail padding\) will be introduced be\255) W -300 -11600 M -29.4 0 32 (cause ) W -/Helvetica-Bold-ISOLatin1 F 1200 o f -29.4 0 32 (CountedString) W -/Helvetica-ISOLatin1 F 1200 o f -29.4 0 32 ( will naturally align on a quadword boundary. In the second, ad\255) W -300 -13000 M -40.3 0 32 (ditional padding maybe introduced \(depending upon the value of MAX_LINE\) to insure) W -300 -14400 M -(proper quadword alignment for the structure member, ) h -/Helvetica-Bold-ISOLatin1 F 1200 o f -(string) h -/Helvetica-ISOLatin1 F 1200 o f -(.) h -300 -15800 M -300 -18700 M -/Helvetica-Bold-ISOLatin1 F 1200 o f -(Variable Declarations) h -300 -20100 M -6060 -20100 M -300 -22100 M -/Helvetica-ISOLatin1 F 1200 o f -60.6 0 32 (With the changes in ) W -/Helvetica-Oblique-ISOLatin1 $ -/Helvetica-Oblique & P -/Helvetica-Oblique-ISOLatin1 F 1200 o f -60.6 0 32 (long ) W -/Helvetica-ISOLatin1 F 1200 o f -60.6 0 32 (and pointer type you should be careful to code your applica\255) W -300 -23500 M -14.4 0 32 (tion so that it can work on both 32\255bit and 64\255bit systems. Check your ) W -/Helvetica-Oblique-ISOLatin1 F 1200 o f -14.4 0 32 (int) W -/Helvetica-ISOLatin1 F 1200 o f -14.4 0 32 ( and ) W -/Helvetica-Oblique-ISOLatin1 F 1200 o f -14.4 0 32 (long) W -/Helvetica-ISOLatin1 F 1200 o f -14.4 0 32 ( dec\255) W -300 -24900 M -163.4 0 32 (larations. If you have specific variables that you need to be 32 bits in size on both) W -300 -26300 M -96.5 0 32 (DEC OSF/1 on MIPS and Alpha then define the type to be ) W -/Helvetica-Oblique-ISOLatin1 F 1200 o f -96.5 0 32 (int.) W -/Helvetica-ISOLatin1 F 1200 o f -96.5 0 32 ( If the variable should) W -300 -27700 M -35.6 0 32 (be 32 bits on DEC OSF/1 on MIPS and 64 bits on Alpha then define the variable to be) W -300 -29100 M -/Helvetica-Oblique-ISOLatin1 F 1200 o f -128.1 0 32 (long) W -/Helvetica-ISOLatin1 F 1200 o f -128.1 0 32 (. Remember if the type specifier is missing from a declaration, it defaults to) W -/Helvetica-Oblique-ISOLatin1 F 1200 o f -128.1 0 32 ( int) W -300 -30500 M -/Helvetica-ISOLatin1 F 1200 o f -60.9 0 32 (type. For example, here are six declarations which declare the variables to be of size ) W -300 -31900 M -/Helvetica-Oblique-ISOLatin1 F 1200 o f -(int ) h -/Helvetica-ISOLatin1 F 1200 o f -(and the function to be returning type) h -/Helvetica-Oblique-ISOLatin1 F 1200 o f -( int) h -/Helvetica-ISOLatin1 F 1200 o f -(. ) h -300 -33300 M -6060 -33300 M -300 -34700 M -6060 -34700 M -(extern e;) h -300 -36100 M -6060 -36100 M -(register n;) h -300 -37500 M -6060 -37500 M -(static x;) h -300 -38900 M -6060 -38900 M -(unsigned i;) h -17580 -38900 M -300 -40300 M -6060 -40300 M -(const c;) h -300 -41700 M -6060 -41700 M -(funtion\(\);) h -300 -43100 M -300 -46000 M -/Helvetica-Bold-ISOLatin1 F 1200 o f -(Bit\255Fields) h -300 -48000 M -/Helvetica-ISOLatin1 F 1200 o f -105.5 0 32 (Bit fields are allowed on any integral type on Alpha. \(ANSI C only requires, bit\255fields) W -300 -49400 M -132.1 0 32 (with int, signed int, and unsigned int types.\) In a C declaration, if a bit\255field immedi\255) W -300 -50800 M -34.5 0 32 (ately follows another in a structure declaration the following bit\255field will be packed into) W -300 -52200 M -41.7 0 32 (adjacent bits of the former unit. Since long is now 64 bits in length on Alpha, adjacent) W -300 -53600 M -92.9 0 32 (declarations of bit\255fields of type long may contain multiple bit\255field definitions in cases) W -300 -55000 M -136.5 0 32 (that previously did not on RISC or VAX. This change may cause different results in) W -300 -56400 M -348.3 0 32 (operations on these bit\255fields. To insure the same behavior when porting code,) W -300 -57800 M -(change bit\255field definitions of type ) h -/Helvetica-Oblique-ISOLatin1 F 1200 o f -(long) h -/Helvetica-ISOLatin1 F 1200 o f -( to ) h -/Helvetica-Oblique-ISOLatin1 F 1200 o f -(int) h -/Helvetica-ISOLatin1 F 1200 o f -(.) h --7200 7200 T -R - -showpage -$P e - -%%Page: 8 8 -/$P a D -g N -0 79200 T -S -R -S -7200 -7200 T -N -0 G -300 -1350 M -/Helvetica-Bold-ISOLatin1 $ -/Helvetica-Bold & P -/Helvetica-Bold-ISOLatin1 F 1400 o f -(Statements and Expressions) h -300 -4900 M -n 0.857 o f -(Variable Assignments and Function Arguments) h -300 -6900 M -/Helvetica-ISOLatin1 $ -/Helvetica & P -/Helvetica-ISOLatin1 F 1200 o f -(On DEC OSF/1 Alpha, since) h -/Helvetica-Oblique-ISOLatin1 $ -/Helvetica-Oblique & P -/Helvetica-Oblique-ISOLatin1 F 1200 o f -( int) h -/Helvetica-ISOLatin1 F 1200 o f -( and ) h -/Helvetica-Oblique-ISOLatin1 F 1200 o f -(long) h -/Helvetica-ISOLatin1 F 1200 o f -( are no longer defined to be the same size, ) h -300 -8300 M -111.2 0 32 (you can not freely interchange their use without the possibility of truncation of signifi\255) W -300 -9700 M -65.4 0 32 (cant digits. Use the lint utility to help you find these problems. You should avoid as\255) W -300 -11100 M -(signments such as ) h -300 -12500 M -300 -13900 M -6060 -13900 M -(int i;) h -300 -15300 M -6060 -15300 M -(long l;) h -300 -17300 M -6060 -17300 M -(i = l;) h -300 -18700 M -300 -20100 M -(Also, you should avoid passing long arguments to functions expecting type ) h -/Helvetica-Oblique-ISOLatin1 F 1200 o f -(int) h -/Helvetica-ISOLatin1 F 1200 o f -(. ) h -300 -21500 M -300 -22900 M -6060 -22900 M -(int toascii\(int\); ) h -300 -24300 M -6060 -24300 M -(int i;) h -300 -25700 M -6060 -25700 M -(long l;) h -300 -27700 M -6060 -27700 M -(i= toascii\(l\) ) h -300 -29100 M -300 -30500 M -300 -31900 M -93.6 0 32 (Pointers and ints should not be freely exchanged on DEC OSF/1 Alpha. Assigning a) W -300 -33300 M -81.8 0 32 (pointer to an int, then assigning back to a pointer, and dereferencing the pointer will) W -300 -34700 M -(result in a bus error. ) h -300 -36100 M -6060 -36100 M -300 -37500 M -6060 -37500 M -(int i ;) h -300 -38900 M -6060 -38900 M -(char *buffer;) h -300 -40900 M -6060 -40900 M -(buffer = \(char *\)malloc\(MAX_LINE\)) h -300 -42300 M -6060 -42300 M -(i = \(int\)buffer;) h -17580 -42300 M -300 -43700 M -6060 -43700 M -(buffer = \(char*\)i;) h -300 -45100 M -300 -46500 M -151.1 0 32 (Similarly, passing a pointer to a function expecting an ) W -/Helvetica-Oblique-ISOLatin1 F 1200 o f -151.1 0 32 (int ) W -/Helvetica-ISOLatin1 F 1200 o f -151.1 0 32 (argument will result in lost) W -300 -47900 M -(information.) h -300 -49300 M -6060 -49300 M -(void f\(\);) h -300 -50700 M -6060 -50700 M -(char *cp;) h -300 -52700 M -6060 -52700 M -(f\(cp\);) h -11820 -52700 M -17580 -52700 M -300 -54100 M -300 -55500 M -70.7 0 32 (This nonportable function declaration will produce a compiler warning if you use ANSI) W -300 -56900 M -(C prototypes, such as: ) h -300 -58300 M -300 -59700 M -6060 -59700 M -(void f\(int\); ) h -300 -61100 M -6060 -61100 M -(char *cp;) h -300 -63100 M -6060 -63100 M -(f\(cp\); ) h --7200 7200 T -R - -showpage -$P e - -%%Page: 9 9 -/$P a D -g N -0 79200 T -S -R -S -7200 -7200 T -N -0 G -300 -1200 M -300 -2600 M -/Helvetica-ISOLatin1 $ -/Helvetica & P -/Helvetica-ISOLatin1 F 1200 o f -161.1 0 32 (You can also find these pointer to int assignments by using the \255h flag of the lint\(1\)) W -300 -4000 M -248.5 0 32 (command, which will find pointer to ) W -/Helvetica-Oblique-ISOLatin1 $ -/Helvetica-Oblique & P -/Helvetica-Oblique-ISOLatin1 F 1200 o f -248.5 0 32 (int) W -/Helvetica-ISOLatin1 F 1200 o f -248.5 0 32 ( argument passing and assignments. Even) W -300 -5400 M -106.7 0 32 (though a pointer can be converted to a type ) W -/Helvetica-Oblique-ISOLatin1 F 1200 o f -106.7 0 32 (long) W -/Helvetica-ISOLatin1 F 1200 o f -106.7 0 32 ( on Alpha without a loss of informa\255) W -300 -6800 M -(tion, you should use the ) h -/Helvetica-Oblique-ISOLatin1 F 1200 o f -(void * ) h -/Helvetica-ISOLatin1 F 1200 o f -(type if you need to use a generic pointer type.) h -300 -8200 M -300 -9600 M -4.5 0 32 (Additionally, watch out for poor programming practices such as different multiple defini\255) W -300 -11000 M -30.1 0 32 (tions of the same object. For instance, two structures that are used in different areas) W -300 -12400 M -(of your code to refer to the same object in different ways. Such as) h -300 -14400 M -6060 -14400 M -(struct node {) h -300 -15800 M -6060 -15800 M -( int src_addr, dst_addr; ) h -300 -17200 M -6060 -17200 M -( char *name; ) h -300 -18600 M -6060 -18600 M -( } ; ) h -300 -20000 M -300 -22000 M -6060 -22000 M -(struct node {) h -300 -23400 M -6060 -23400 M -( struct node *src, *dst;) h -300 -24800 M -6060 -24800 M -( char * name;) h -300 -26200 M -6060 -26200 M -( }) h -300 -28200 M -300 -29600 M -79.3 0 32 (This type of nonstandard coding should be replace with a union declaration. Be thor\255) W -300 -31000 M -136.4 0 32 (ough when porting this type of code to a 64\255bit system, the interdependency and in\255) W -300 -32400 M -(compatibilities between these two structures may be difficult to find. ) h -300 -33800 M -300 -35200 M -/Helvetica-Bold-ISOLatin1 $ -/Helvetica-Bold & P -/Helvetica-Bold-ISOLatin1 F 1200 o f -(Integer and Long Constants \255 Assignment and Argument Passing) h -300 -36600 M -300 -38000 M -/Helvetica-ISOLatin1 F 1200 o f -77.7 0 32 (In C, an integer constant is specified like, 543210. To specify a long int constant you) W -300 -39400 M -59.3 0 32 (use the suffix L or l. To specify a unsigned long you use the UL or ul suffix. \(L is pre\255) W -300 -40800 M -113.0 0 32 (ferred since l is easily confused with 1\). Note the example where three different con\255) W -300 -42200 M -(stants are passed to the function, ) h -/Helvetica-Oblique-ISOLatin1 F 1200 o f -(labs\(\)) h -/Helvetica-ISOLatin1 F 1200 o f -(: ) h -300 -44200 M -6060 -44200 M -(labs\(543210\)) h -300 -45600 M -6060 -45600 M -(labs\(543210L\)) h -300 -47000 M -6060 -47000 M -(labs\(543210UL\)) h -300 -48400 M -300 -49800 M -127.7 0 32 (On DEC OSF/1 on MIPS, 543210 would be passed as a 4 byte constant in all three) W -300 -51200 M -35.6 0 32 (examples. On an Alpha system , 543210 would be treated as a 4 byte constant, and) W -300 -52600 M -162.7 0 32 (543210L or 543210UL would be treated as a 8 byte constant. If the ) W -/Helvetica-Oblique-ISOLatin1 F 1200 o f -162.7 0 32 (labs\(\) ) W -/Helvetica-ISOLatin1 F 1200 o f -162.7 0 32 (function) W -300 -54000 M -214.8 0 32 (was expecting a ) W -/Helvetica-Oblique-ISOLatin1 F 1200 o f -214.8 0 32 (long) W -/Helvetica-ISOLatin1 F 1200 o f -214.8 0 32 ( argument each of these invocations would work as expected) W -300 -55400 M -96.1 0 32 (since the ) W -/Helvetica-Oblique-ISOLatin1 F 1200 o f -96.1 0 32 (int ) W -/Helvetica-ISOLatin1 F 1200 o f -96.1 0 32 (constants would be converted to ) W -/Helvetica-Oblique-ISOLatin1 F 1200 o f -96.1 0 32 (long.) W -/Helvetica-ISOLatin1 F 1200 o f -96.1 0 32 ( Problems happen if the function) W -300 -56800 M -/Helvetica-Oblique-ISOLatin1 F 1200 o f -65.1 0 32 (labs\(\) ) W -/Helvetica-ISOLatin1 F 1200 o f -65.1 0 32 (was expecting type int. In this case the long constant would be truncated to an) W -300 -58200 M -38.7 0 32 (integer constant. This truncation would result in the loss of significant digits if the con\255) W -300 -59600 M -31.5 0 32 (stant was greater then maximum integer constant \(INT_MAX\) of +2147483647, or less) W -300 -61000 M -161.9 0 32 (then the minimum integer constant \(INT_MIN\) of \2552147483648, or for unsigned con\255) W -300 -62400 M -672.2 0 32 (stants greater then the maximum unsigned integer constant \(UINT_MAX\) of) W -300 -63800 M -37.1 0 32 (4294967295. This problem would also be present in an assignment expression where) W --7200 7200 T -R - -showpage -$P e - -%%Page: 10 10 -/$P a D -g N -0 79200 T -S -R -S -7200 -7200 T -N -0 G -300 -1200 M -/Helvetica-ISOLatin1 $ -/Helvetica & P -/Helvetica-ISOLatin1 F 1200 o f -158.0 0 32 (a long integer constant was assigned to a variable of type int. In these cases it is) W -300 -2600 M -74.3 0 32 (important to explicitly use the L or UL suffix and make sure the function arguments or) W -300 -4000 M -(variables being assigned to are of the appropriate ) h -/Helvetica-Oblique-ISOLatin1 $ -/Helvetica-Oblique & P -/Helvetica-Oblique-ISOLatin1 F 1200 o f -(long) h -/Helvetica-ISOLatin1 F 1200 o f -( type.) h -300 -6000 M -86.0 0 32 (It is also important to note that when you are passing zero to a pointer argument and) W -300 -7400 M -56.7 0 32 (no function prototype is visible, always use NULL \(Defined in stdio.h\). Using) W -/Helvetica-Oblique-ISOLatin1 F 1200 o f -56.7 0 32 ( 0 ) W -/Helvetica-ISOLatin1 F 1200 o f -56.7 0 32 (will re\255) W -300 -8800 M -42.3 0 32 (sult in using a 4 byte zero instead of a 8 byte zero \(0L\). \(In a comparison, an assign\255) W -300 -10200 M -118.7 0 32 (ment, or a function call where the correct function prototype is in scope, standard C) W -300 -11600 M -(promotion rules will be in effect and the correct value will be assigned.\)) h -300 -13000 M -300 -15900 M -/Helvetica-Bold-ISOLatin1 $ -/Helvetica-Bold & P -/Helvetica-Bold-ISOLatin1 F 1200 o f -(Integer and Long Constants \255 Shift operations) h -300 -17900 M -/Helvetica-ISOLatin1 F 1200 o f -104.5 0 32 (A bit shift operation on a integer constant will yield an 32\255bit constant. If you need a) W -300 -19300 M -96.6 0 32 (result of type long then you need to use the L or UL suffix for long integer constants. ) W -300 -20700 M -(For example, ) h -300 -22100 M -300 -23500 M -6060 -23500 M -(long value;) h -300 -24900 M -300 -26300 M -6060 -26300 M -(value = 10 << 2; ) h -17580 -26300 M -300 -28300 M -300 -29700 M -2.9 0 32 (results in ) W -/Helvetica-Bold-ISOLatin1 F 1200 o f -2.9 0 32 (value) W -/Helvetica-ISOLatin1 F 1200 o f -2.9 0 32 ( getting assigned a 32\255bit constant. The top 32 bits of ) W -/Helvetica-Bold-ISOLatin1 F 1200 o f -2.9 0 32 (value) W -/Helvetica-ISOLatin1 F 1200 o f -2.9 0 32 ( will depend) W -300 -31100 M -157.0 0 32 (on the type of the value shifted. Signed values are sign\255extended; unsigned values) W -300 -32500 M -9.2 0 32 (are zero extended. If you want a 64\255bit constant then be sure to use the L or UL suffix.) W -300 -33900 M -15.1 0 32 (\(Note that only the left operand of a shift operator determines the result type. The type) W -300 -35300 M -(of shift count operand is irrelevant.\) ) h -300 -38200 M -/Helvetica-Bold-ISOLatin1 F 1200 o f -(Sizeof expression) h -300 -40200 M -/Helvetica-ISOLatin1 F 1200 o f -73.2 0 32 (The result of the ) W -/Helvetica-Oblique-ISOLatin1 F 1200 o f -73.2 0 32 (sizeof) W -/Helvetica-ISOLatin1 F 1200 o f -73.2 0 32 ( operator is of type ) W -/Helvetica-Bold-ISOLatin1 F 1200 o f -73.2 0 32 (size_t) W -/Helvetica-ISOLatin1 F 1200 o f -73.2 0 32 (, which is of an ) W -/Helvetica-Oblique-ISOLatin1 F 1200 o f -73.2 0 32 (unsigned ) W -73.2 0 32 (long) W -/Helvetica-ISOLatin1 F 1200 o f -73.2 0 32 ( on Al\255) W -300 -41600 M -(pha. ) h -300 -44500 M -/Helvetica-Bold-ISOLatin1 F 1200 o f -(Pointer Subtraction) h -300 -46500 M -/Helvetica-ISOLatin1 F 1200 o f -36.4 0 32 (The length of the integer required to hold the difference between two pointers to mem\255) W -300 -47900 M -(bers of the same array, ptrdiff_t \(stddef.h\), is an ) h -/Helvetica-Oblique-ISOLatin1 F 1200 o f -(signed long) h -/Helvetica-ISOLatin1 F 1200 o f -( on Alpha.) h -300 -49300 M -300 -52200 M -/Helvetica-Bold-ISOLatin1 F 1200 o f -(Functions with a variable number of arguments) h -300 -54200 M -/Helvetica-ISOLatin1 F 1200 o f -149.8 0 32 (When writing a routine that receives a variable \(context\255dependent\) number of argu\255) W -300 -55600 M -147.5 0 32 (ments you must use the stdargs \(stdarg.h\) or varargs \(varargs.h\) mechanism. See) W -300 -57000 M -(the varargs\(3\) reference page for more information on the use of these macros. ) h -300 -58400 M --7200 7200 T -R - -showpage -$P e - -%%Page: 11 11 -/$P a D -g N -0 79200 T -S -R -S -7200 -7200 T -N -0 G -300 -1350 M -/Helvetica-Bold-ISOLatin1 $ -/Helvetica-Bold & P -/Helvetica-Bold-ISOLatin1 F 1400 o f -(Library Calls) h -300 -4900 M -n 0.857 o f -(printf, scanf functions) h -300 -6900 M -300 -8300 M -/Helvetica-ISOLatin1 $ -/Helvetica & P -/Helvetica-ISOLatin1 F 1200 o f -122.0 0 32 (When using the printf\255type function conversion specifiers for longs use the "l" \(lower\255) W -300 -9700 M -149.7 0 32 (case letter L\) size specification, with the d, u, o, and x operations to specify assign\255) W -300 -11100 M -23.6 0 32 (ment of type long or unsigned long. For instance, when printing a long as signed deci\255) W -300 -12500 M -131.9 0 32 (mal use the %ld instead of %d, when printing a long as a unsigned decimal use the) W -300 -13900 M -6.1 0 32 (%lu instead of %u. If the letter l size specification is not used the type is assumed to be) W -300 -15300 M -98.3 0 32 (int, unsigned int, or int * depending upon the conversion specification. In which case) W -300 -16700 M -(the long types will be converted to the smaller int types and information may be lost. ) h -300 -18700 M -14.4 0 32 (When printing a pointer use %p. If you want to print the pointer as a specific represen\255) W -300 -20100 M -141.1 0 32 (tation then the pointer should be cast to an appropriate integer type \(long for Alpha\)) W -300 -21500 M -32.0 0 32 (before using the desired format specifier. For example, to print a pointer as a long un\255) W -300 -22900 M -(signed decimal number use %lu: ) h -300 -24900 M -6060 -24900 M -(char *p;) h -300 -26900 M -6060 -26900 M -(printf \( "%p %lu\\n", \(void *\)p, \(long\)p \);) h -300 -28300 M -300 -29700 M -85.1 0 32 (For a portable way to print an integer of arbitrary size, case the integer to long or un\255) W -300 -31100 M -(signed long, then use the %L conversion specifier. For example:) h -300 -33100 M -6060 -33100 M -(printf \("%ld\\n", \(unsigned long\) sizeof \(num\)\);) h -300 -34500 M -300 -37400 M -/Helvetica-Bold-ISOLatin1 F 1200 o f -(malloc, calloc functions) h -300 -38800 M -300 -40800 M -/Helvetica-ISOLatin1 F 1200 o f -59.5 0 32 (Memory allocation library functions such as ) W -/Helvetica-Oblique-ISOLatin1 $ -/Helvetica-Oblique & P -/Helvetica-Oblique-ISOLatin1 F 1200 o f -59.5 0 32 (ma) W -/Helvetica-ISOLatin1 F 1200 o f -59.5 0 32 (lloc guarantee to return data aligned to) W -300 -42200 M -79.7 0 32 (the maximum alignment of any object. On Alpha, ) W -/Helvetica-Oblique-ISOLatin1 F 1200 o f -79.7 0 32 (malloc) W -/Helvetica-ISOLatin1 F 1200 o f -79.7 0 32 ( returns a pointer to memory) W -300 -43600 M -(that is quadword aligned.) h -300 -46500 M -/Helvetica-Bold-ISOLatin1 F 1200 o f -(lseek function) h -300 -48500 M -/Helvetica-ISOLatin1 F 1200 o f -2.7 0 32 (When calling the) W -/Helvetica-Oblique-ISOLatin1 F 1200 o f -2.7 0 32 ( lseek ) W -/Helvetica-ISOLatin1 F 1200 o f -2.7 0 32 (system call for setting the current position in a file, use the ) W -/Helvetica-Oblique-ISOLatin1 F 1200 o f -2.7 0 32 (off_t) W -300 -49900 M -/Helvetica-ISOLatin1 F 1200 o f -6.1 0 32 (type defined in ) W -/Helvetica-Oblique-ISOLatin1 F 1200 o f -6.1 0 32 (types.h) W -/Helvetica-ISOLatin1 F 1200 o f -6.1 0 32 ( for the file offset. Passing an int or long constant may work but) W -300 -51300 M -69.4 0 32 (it is not the portable and is not guarantee to continue to work. The following example) W -300 -52700 M -(shows correct uses of ) h -/Helvetica-Oblique-ISOLatin1 F 1200 o f -(lseek) h -/Helvetica-ISOLatin1 F 1200 o f -(.) h -300 -54100 M -300 -55500 M -( lseek function: ) h -300 -56900 M -300 -58300 M -6060 -58300 M -(#include <unistd.h>) h -300 -59700 M -6060 -59700 M -300 -61100 M -6060 -61100 M -(off_t offset, pos;) h -300 -62500 M -( ...) h -300 -63900 M -6060 -63900 M -(pos = lseek\( fd, offset, SEEK_SET \);) h --7200 7200 T -R - -showpage -$P e - -%%Page: 12 12 -/$P a D -g N -0 79200 T -S -R -S -7200 -7200 T -N -0 G -300 -1200 M -6060 -1200 M -/Helvetica-ISOLatin1 $ -/Helvetica & P -/Helvetica-ISOLatin1 F 1200 o f -(pos = lseek\( fd, \(off_t\)0, SEEK_CUR\);) h -300 -2600 M -300 -4000 M -300 -6900 M -/Helvetica-Bold-ISOLatin1 $ -/Helvetica-Bold & P -/Helvetica-Bold-ISOLatin1 F 1200 o f -(fsetpos, fgetpos functions) h -300 -8900 M -/Helvetica-ISOLatin1 F 1200 o f -19.5 0 32 (When setting or getting the file postions for a file with the ANSI C functions of ) W -/Helvetica-Oblique-ISOLatin1 $ -/Helvetica-Oblique & P -/Helvetica-Oblique-ISOLatin1 F 1200 o f -19.5 0 32 (fsetpos\(\)) W -300 -10300 M -/Helvetica-ISOLatin1 F 1200 o f -94.5 0 32 (or) W -/Helvetica-Oblique-ISOLatin1 F 1200 o f -94.5 0 32 ( fgetpos\(\)) W -/Helvetica-ISOLatin1 F 1200 o f -94.5 0 32 ( respectively, the file position is specified by a value of type ) W -/Helvetica-Oblique-ISOLatin1 F 1200 o f -94.5 0 32 (fpos_t) W -/Helvetica-ISOLatin1 F 1200 o f -94.5 0 32 (. This) W -300 -11700 M -(type is defined as a) h -/Helvetica-Oblique-ISOLatin1 F 1200 o f -( long) h -/Helvetica-ISOLatin1 F 1200 o f -( on Alpha. ) h -300 -15350 M -/Helvetica-Bold-ISOLatin1 F 1400 o f -(D) h -(evelopment Tools) h -300 -18000 M -/Helvetica-ISOLatin1 F 1200 o f -111.4 0 32 (The DEC OSF/1 Alpha system supplies a number of development tools that help mi\255) W -300 -19400 M -70.2 0 32 (grate applications to this 64\255bit system. These include an enhanced lint tools, special) W -300 -20800 M -(linker flags to help with truncation of 64\255bit addresses, and a 32\255bit compatibility mode.) h -300 -23700 M -/Helvetica-Bold-ISOLatin1 F 1200 o f -(lint) h -300 -25700 M -/Helvetica-ISOLatin1 F 1200 o f -65.1 0 32 (The lint\(1\) utility on both DEC OSF/1 MIPS and Alpha have been enhanced to find int) W -300 -27100 M -(and pointer assignments and argument passing. ) h -300 -28500 M -300 -31400 M -/Helvetica-Bold-ISOLatin1 F 1200 o f -(ld) h -300 -33400 M -/Helvetica-ISOLatin1 F 1200 o f -132.0 0 32 (The Alpha linker, ld\(1\), loads the program text and data in the high 64 bit virtual ad\255) W -300 -34800 M -94.6 0 32 (dress space of the process by default. This means that no valid addresses will be in) W -300 -36200 M -13.5 0 32 (the range of the 32\255bit address. Therefore. unintended pointer truncations will trap into) W -300 -37600 M -60.9 0 32 (the kernel and cause a runtime error. This diagnostic feature assists in porting appli\255) W -300 -39000 M -77.9 0 32 (cations from 32 bit to 64 bit environments. To override this behavior you can use the) W -300 -40400 M -(\255T/\255D ld options to move the program in the address space. ) h -300 -42400 M -300 -44400 M -300 -46400 M -( ) h -300 -48400 M -300 -49498 M -300 -50815 M --7200 7200 T -R - -showpage -$P e - -%%Trailer -$D restore -end % DEC_WRITE_dict -%%Pages: 12 -%%DocumentFonts: Helvetica-Bold-ISOLatin1 -%%+ Helvetica-ISOLatin1 -%%+ Symbol -%%+ Times-Roman-ISOLatin1 -%%+ Helvetica-Oblique-ISOLatin1 diff --git a/src/doc/bin/cmv.gif b/src/doc/bin/cmv.gif deleted file mode 100644 index a219cdce62ff2e7ec92d0bc691df280f74bcfb63..0000000000000000000000000000000000000000 Binary files a/src/doc/bin/cmv.gif and /dev/null differ diff --git a/src/doc/bin/hjv.gif b/src/doc/bin/hjv.gif deleted file mode 100644 index a598b9b2e2380ca9c07bb3cf75df5cf3fff6ff71..0000000000000000000000000000000000000000 Binary files a/src/doc/bin/hjv.gif and /dev/null differ diff --git a/src/doc/bin/jen.gif b/src/doc/bin/jen.gif deleted file mode 100644 index 38b07b9858ac2c1948714fe4d53b84fd712e61ca..0000000000000000000000000000000000000000 Binary files a/src/doc/bin/jen.gif and /dev/null differ diff --git a/src/doc/bin/jph.gif b/src/doc/bin/jph.gif deleted file mode 100644 index d25dff2c6e67d9f5efb434fab20e501c5c00a979..0000000000000000000000000000000000000000 Binary files a/src/doc/bin/jph.gif and /dev/null differ diff --git a/src/doc/bin/newstar.gif b/src/doc/bin/newstar.gif deleted file mode 100644 index 1ffc61be43708d40f4e426ccdbca484821138450..0000000000000000000000000000000000000000 Binary files a/src/doc/bin/newstar.gif and /dev/null differ diff --git a/src/doc/bin/scn_sets.ps b/src/doc/bin/scn_sets.ps deleted file mode 100644 index 101b9dba1f3241f8b7e34bcfab36b165be80aece..0000000000000000000000000000000000000000 --- a/src/doc/bin/scn_sets.ps +++ /dev/null @@ -1,44 +0,0 @@ -%!PS-Adobe-2.0 EPSF-2.0 -%%Title: scn_sets.tmp -%%Creator: fig2dev -%%CreationDate: Wed Nov 23 11:45:07 1994 -%%For: jph@rzmws0 (johan hamaker) -%%BoundingBox: -10 -10 496 69 -%%Pages: 0 -%%EndComments -/$F2psDict 200 dict def -$F2psDict begin -$F2psDict /mtrx matrix put -/l {lineto} bind def -/m {moveto} bind def -/s {stroke} bind def -/n {newpath} bind def -/gs {gsave} bind def -/gr {grestore} bind def -/clp {closepath} bind def -/graycol {dup dup currentrgbcolor 4 -2 roll mul 4 -2 roll mul -4 -2 roll mul setrgbcolor} bind def -/col-1 {} def -/col0 {0 0 0 setrgbcolor} bind def -/col1 {0 0 1 setrgbcolor} bind def -/col2 {0 1 0 setrgbcolor} bind def -/col3 {0 1 1 setrgbcolor} bind def -/col4 {1 0 0 setrgbcolor} bind def -/col5 {1 0 1 setrgbcolor} bind def -/col6 {1 1 0 setrgbcolor} bind def -/col7 {1 1 1 setrgbcolor} bind def - end -/$F2psBegin {$F2psDict begin /$F2psEnteredState save def} def -/$F2psEnd {$F2psEnteredState restore end} def -%%EndProlog - -$F2psBegin -0 setlinecap 0 setlinejoin --162.0 270.0 translate 0.900 -0.900 scale -0.500 setlinewidth -% Polyline -n 719 299 m 719 234 l 179 234 l 179 299 l clp gs col-1 s gr -/Times-Italic findfont 20.00 scalefont setfont -194 279 m -gs 1 -1 scale (This is a dummy in place of scn_sets.ps) col-1 show gr -$F2psEnd diff --git a/src/doc/bin/wnb.gif b/src/doc/bin/wnb.gif deleted file mode 100644 index 52ee04e9ca686c6bf869997ab21689a8613531f5..0000000000000000000000000000000000000000 Binary files a/src/doc/bin/wnb.gif and /dev/null differ diff --git a/src/doc/bin/wsrt.gif b/src/doc/bin/wsrt.gif deleted file mode 100644 index 41d98cfa0feff109bf6a85f7101c73963f4df259..0000000000000000000000000000000000000000 Binary files a/src/doc/bin/wsrt.gif and /dev/null differ diff --git a/src/doc/doc.grp b/src/doc/doc.grp deleted file mode 100644 index 63d4973be1d0b1bd5b64a78e7f880d304bfaaab7..0000000000000000000000000000000000000000 --- a/src/doc/doc.grp +++ /dev/null @@ -1,371 +0,0 @@ -! doc.grp -! .grp file for all sources of the Newstar documentation collection -! all file specifications are relative to $n_doc unless otherwise noted -! -! History: -! JPH 940627 New version reflecting the grand revision of the -! documentation system -! CMV 940719 Changed newstar_home_page to homepage for -! consistency with httpd server -! CMV 9407.. Add anchors.idx -! JPH 940720 Add build_newstar.txt, dwcalc.txt; remove -! ncalib_matrix.fig -! JPH 940810 Add qube.txt. - Remove duplicate entries -! JPH 940829 Remove build_newstar.txt (obsolete) -! JPH 940914 - arcquery.tex; + ppd_buffer.txt, obscure_bugs.txt -! JPH 940919 remove *.tex, build_newstar.txt; add scn_sector.tex, -! scn_contents.tex, wndpoh.txt -! JPH 941017 nmap_make* -! CMV 941102 Change nfra_config_management.txt to .html -! CMV 941102 Change names of bitmaps to *.bbm -! JPH 941104 intfc/ directory with _interface.tex files -! JPH 941116 Remove nmap_make.cap, nmap_handle.cap -! JPH 941123 Remove ngen_private_intfc.tex -! HjV 941124 txt/newmaint.txt now html/elsewhere_inst_maint.html -! Remove site_questionnaire.txt; now in -! elsewhere_inst_mant.htm -! JPH 941125 gen_intro, gen_start --> introduction -! JPH 950914 update on the basis of ndoc Overview comparisons -! WNB 950419 add lsq.tex -! HjV 950502 Temporary use lsq.ps iso lsq.tex -! HjV 950704 Add plotter_public_intfc.tex -! JPH 951013 Update. Remove bin/lsq.ps -! JPH 951123 doc_release typo. Add record_replay.tex -! JPH 951127 lsq.tex -! JPH 960401 Remove lsq.ps, add several .txt, .fig, .cap files -! Add people.tex, remove people.html -! HjV 960422 Add .tef-files -! HjV 960423 Change names of bitmaps to *.xbm -! HjV 960620 fig/polarisn_calibrn.* -! -! -! Control tables and the like which are not part of the documentation proper -! -doc.grp ! this file -anchors.idx ! database with people we know -latex2html.pls ! init-file for convertor -newstar.hun -B ! library with help texts (Unix only) -! -! Files that are referred to by the documentation system -! Their location is not a priori known and the system manager must create -! a soft link for them in $n_hlp -! -nnews.hlp -! -! -! Figures: .tex files to be processed with ndoc Cook -! -! .cap = caption text with a \fig command to include .fig file -! .fig = xfig drawing -! -fig/basic_functions.cap -fig/basic_functions.fig -fig/clean_vs_find.cap -fig/clean_vs_find.fig -fig/doc_sources_and_hyper.fig -fig/doc_sources_and_hyper.cap -fig/doc_sources_and_print.fig -fig/doc_sources_and_print.cap -fig/dwarf_interface.fig -fig/dwarf_interface.cap -fig/error_model.fig -fig/error_model.cap -fig/general_index.fig -fig/model_update.cap -fig/model_update.fig -fig/mosaic_sectors.cap -fig/mosaic_sectors.fig -fig/natnf_interface.cap -fig/dummy_figure.fig -fig/ncalib_3c48.fig -fig/ncalib_3c48.cap -fig/ncalib_interface.cap < -fig/ncopy_interface.cap < -fig/ngf_scn_indices.fig < -fig/ncalib_matrix.cap -fig/ncalib_scan.fig -fig/ncalib_scan.cap -fig/ncalib_vispace.fig -fig/ncalib_vispace.cap -fig/nclean_interface.fig -fig/nclean_interface.cap -fig/newstar_overview.fig -fig/newstar_overview.cap -fig/nflag_interface.cap -fig/nflag_flag.fig -fig/nflag_flag.cap -fig/nflag_gids.fig -fig/nflag_gids.cap -fig/nflag_inspect.fig -fig/nflag_inspect.cap -fig/nflag_mode.fig -fig/nflag_operate.fig -fig/nflag_operate.cap -fig/nflag_statist.fig -fig/nflag_statist.cap -fig/ngcalc_display.fig -fig/ngcalc_extract.fig -fig/ngcalc_interface.cap -fig/ngcalc_interface.fig -fig/ngids_interface.cap -fig/ngf_scn_indices.cap -fig/nhyper_overview.fig -fig/nmap_handle.fig -fig/nmap_handle.cap -fig/nmap_interface.cap -fig/nmap_interface.fig -fig/nmap_make.fig -fig/nmap_make.cap -fig/nmap_make_q.fig -fig/nmap_make_q.cap -fig/nmodel_convert.fig -fig/nmodel_convert.cap -fig/nmodel_handle.fig -fig/nmodel_handle.cap -fig/nmodel_interface.fig -fig/nmodel_interface.cap -fig/nplot_interface.cap -fig/nscan_interface.cap -fig/scn_contents.fig -fig/scn_contents.cap -fig/scn_hierarchy.cap -fig/scn_hierarchy.fig -fig/scn_indices.cap -fig/scn_indices.fig -fig/scn_sector.fig -fig/scn_sector.cap -fig/scn_sets.cap -! - .fig to be made from cookbook scn-file fig. 2 -fig/scn_wmp_indices.fig -fig/wsrt_layout.fig -fig/wsrt_layout.cap -! -! -! Raw html sources -! For each of these, a soft link with the same name must be defined in $n_hlp -! -html/homepage.html -html/nfra_config_management.html -html/elsewhere_inst_maint.html -! -! Program interface documents -! - -! LaTeX style files: Need no processing -! -latex/hb_cook_preamble.sty -latex/hb_print_preamble.sty -latex/hb_symbols.sty -latex/html.sty ! part of latex2html, copied here so export - ! sites can LaTeX our .tex files -! -! -! LaTeX documents: Process with ndoc Cook -! -!! latex/auto_batch_processing.tex -latex/bibliography.tex -latex/common_descr.tex -latex/doc_guide.tex -latex/doc_release9511.tex -latex/file_indexing.tex -latex/files_descr.tex -latex/files_handle.tex -latex/introduction.tex -latex/hb_contents.tex -latex/lsq.tex -latex/mdl_descr.tex -latex/models_descr.tex -latex/mongo_graphics.tex -latex/ncalib_descr.tex -latex/ncalib_polar.tex -latex/ncalib_redun.tex -latex/nclean_descr.tex -latex/ncopy_descr.tex -latex/nflag_descr.tex -latex/ngcalc_descr.tex -latex/ngids_descr.tex -latex/make_model.tex -latex/nmap_descr.tex -latex/nmap_example.tex -latex/nmodel_descr.tex -latex/nplot_descr.tex -latex/nscan_descr.tex -latex/people.tex -latex/plate_measure.tex -latex/rcp_batch_processing.tex -latex/rcp_circ_polarisation.tex -latex/rcp_continuum_21cm.tex -latex/rcp_dynamic_range.tex -latex/rcp_external_calibrators.tex -latex/rcp_line_21cm.tex -latex/rcp_linear_polarisation.tex -latex/rcp_mosaic_21cm.tex -latex/rcp_mosaic_92cm.tex -latex/rcp_old_data.tex -latex/rcp_pulsar_imaging.tex -latex/rcp_read_data.tex -latex/rcp_simulated_data.tex -latex/rcp_spectral_dr.tex -latex/rcp_uvfits_output.tex -latex/rcp_variability.tex -latex/rcp_very_old_data.tex -latex/record_replay.tex -latex/scn_file.tex -latex/scn_summary.tef -!! latex/scn_descr.tex -latex/selected_papers.tex -latex/show_edit.tex -latex/wmp_descr.tex -latex/wsrt_fact_sheet.tex -! -! interface descriptions - process with ndoc Cook or ndoc Print -! directory intfc/ also contains .tef (tex include) files generated from .psc -! and .pef files through ndoc Keys -! -intfc/dwarf_private_intfc.tex -intfc/dwarf_private_keys.tef -intfc/flfnode_public_intfc.tex -intfc/flfnode_public_keys.tef -intfc/global_private_intfc.tex -intfc/global_private_keys.tef -intfc/mdlnode_public_intfc.tex -intfc/mdlnode_public_keys.tef -intfc/natnf_private_intfc.tex -intfc/natnf_private_keys.tef -intfc/ncalib_private_intfc.tex -intfc/ncalib_private_keys.tef -intfc/nclean_private_intfc.tex -intfc/nclean_private_keys.tef -intfc/ncopy_private_intfc.tex -intfc/ncopy_private_keys.tef -latex/ncopy_progrmr.tex -intfc/nfilt_private_intfc.tex -intfc/nfilt_private_keys.tef -intfc/nflag_private_intfc.tex -intfc/nflag_private_keys.tef -intfc/ngcalc_private_intfc.tex -intfc/ngcalc_private_keys.tef -intfc/ngen_private_intfc.tex -intfc/ngen_public_intfc.tex -intfc/ngen_public_keys.tef -intfc/ngfsets_public_intfc.tex -intfc/ngfsets_public_keys.tef -intfc/ngids_private_intfc.tex -intfc/ngids_private_keys.tef -intfc/nmap_private_intfc.tex -intfc/nmap_private_keys.tef -intfc/nmap_public_intfc.tex -intfc/nmap_public_keys.tef -intfc/nmodel_private_intfc.tex -intfc/nmodel_private_keys.tef -intfc/nmodel_public_intfc.tex -intfc/nmodel_public_keys.tef -intfc/nplot_private_intfc.tex -intfc/nplot_private_keys.tef -intfc/nscan_private_intfc.tex -intfc/nscan_private_keys.tef -intfc/nshow_public_intfc.tex -intfc/nshow_public_keys.tef -intfc/plotter_public_intfc.tex -intfc/plotter_public_keys.tef -intfc/scnnode_public_intfc.tex -intfc/scnnode_public_keys.tef -intfc/scnsets_public_intfc.tex -intfc/scnsets_public_keys.tef -intfc/select_public_intfc.tex -intfc/select_public_keys.tef -intfc/unit_public_intfc.tex -intfc/unit_public_keys.tef -intfc/wmpnode_public_intfc.tex -intfc/wmpnode_public_keys.tef -intfc/wmpsets_public_intfc.tex -intfc/wmpsets_public_keys.tef -! -! -! Miscellaneous pieces of contributed documentation -! These should in due time be converted into or integrated with LaTeX documents -! The only processing they need is the creation of a soft link in $n_hlp; this -! is taken care of by ndoc Overview -! -txt/batch.txt -txt/bug_reports.txt -txt/calibr_models.txt -txt/control_c.txt -txt/copyright.txt ! newstar copyright notice -txt/debug_efficiently.txt -txt/doc_organisation.txt -txt/dwcalc.txt -txt/memos.txt -txt/models_and_maps.txt -txt/more_on_batch.txt -txt/ncalib_vzero.txt -txt/ngcalc_lightcurve.txt -txt/obscure_bugs.txt -txt/ppd_buffer.txt -txt/psc_guide.txt -txt/psctest.txt -txt/qube.txt -txt/remote_tape.txt -txt/spefu_type_categ.txt -txt/wndpoh.txt -txt/wntinc.txt -txt/xmosaic_restart.txt -! -! -! Documents and diagrams that exist only in binary form -! A soft link to each must be created in $n_hlp -! LaTeX documents refer to them through the \htmladdnormallink command -! -bin/agb.gif -B ! portrait -bin/alpha_32_64.ps -B ! public-domain document -bin/alpha_portability.ps -B ! public-domain document -bin/cmv.gif -B ! portrait -bin/hjv.gif -B ! portrait -bin/jen.gif -B ! portrait -bin/jph.gif -B ! portrait -bin/newstar.gif -B ! Newstar logo -bin/scn_sets.ps -B ! old LaTeX diagram still in use? -bin/wnb.gif -B ! portrait -bin/wsrt.gif -B ! WSRT photograph -! -! Icons that are needed by the latex-to-html converter -! -icons/anchor.xbm -B -icons/blank.xbm -B -icons/contents.xbm -B -icons/contents_motif.gif -B -icons/cross-ref.xbm -B -icons/cross_ref_motif.gif -B -icons/foot.xbm -B -icons/foot_motif.gif -B -icons/icons.fig -B -icons/icons.html -B -icons/index.xbm -B -icons/index_motif.gif -B -icons/invis_anchor.xbm -B -icons/latex2html.xbm -B -icons/next.xbm -B -icons/next_group_motif.gif -B -icons/next_group_motif_gr.gif -B -icons/next_motif.gif -B -icons/next_motif_gr.gif -B -icons/next_page.xbm -B -icons/previous.xbm -B -icons/previous_group_motif.gif -B -icons/previous_group_motif_gr.gif -B -icons/previous_motif.gif -B -icons/previous_motif_gr.gif -B -icons/previous_page.xbm -B -icons/up.xbm -B -icons/up_motif.gif -B -icons/up_motif_gr.gif -B -! -! -! Documentation files compiled from other Newstar sources. -! These are created through ndoc Keys and reside below $n_hlp. -! LaTeX documents refer to them through \textref commands -! -!<program>/<program>_keys.html ! list of <program>'s private keywords -!<program>/<program>_comm.html ! list of <program>'s public keywords -!<program>/<program>_<keyword>.html ! online help for <program>'s -! ! parameter <KEYWORD> diff --git a/src/doc/doc_test.tmp.l b/src/doc/doc_test.tmp.l deleted file mode 100644 index bf3458743f32c3577126d4de69ef45790f897877..0000000000000000000000000000000000000000 --- a/src/doc/doc_test.tmp.l +++ /dev/null @@ -1,719 +0,0 @@ -anchors.idx h -bin/alpha_32_64.ps h -bin/alpha_portability.ps h -bin/scn_sets.ps h -doc.grp h -doc_all.log h -doc_test.log h -doc_test.tmp.l h -fig/basic_functions.cap h -fig/basic_functions.fig h -fig/clean_vs_find.cap h -fig/clean_vs_find.fig h -fig/doc_sources_and_hyper.cap h -fig/doc_sources_and_hyper.fig h -fig/doc_sources_and_print.cap h -fig/doc_sources_and_print.fig h -fig/dummy_figure.fig h -fig/dwarf_interface.cap h -fig/dwarf_interface.fig h -fig/error_model.cap h -fig/error_model.fig h -fig/general_index.fig h -fig/model_update.cap h -fig/model_update.fig h -fig/mosaic_sectors.cap h -fig/mosaic_sectors.fig h -fig/natnf_interface.cap h -fig/ncalib_3c48.cap h -fig/ncalib_3c48.fig h -fig/ncalib_interface.cap h -fig/ncalib_matrix.cap h -fig/ncalib_scan.cap h -fig/ncalib_scan.fig h -fig/ncalib_vispace.cap h -fig/ncalib_vispace.fig h -fig/nclean_interface.cap h -fig/nclean_interface.fig h -fig/ncopy_interface.cap h -fig/newstar_overview.cap h -fig/newstar_overview.fig h -fig/nflag_flag.cap h -fig/nflag_flag.fig h -fig/nflag_gids.cap h -fig/nflag_gids.fig h -fig/nflag_inspect.cap h -fig/nflag_inspect.fig h -fig/nflag_interface.cap h -fig/nflag_mode.fig h -fig/nflag_operate.cap h -fig/nflag_operate.fig h -fig/nflag_statist.cap h -fig/nflag_statist.fig h -fig/ngcalc_display.fig h -fig/ngcalc_extract.fig h -fig/ngcalc_interface.cap h -fig/ngcalc_interface.fig h -fig/ngf_scn_indices.cap h -fig/ngf_scn_indices.fig h -fig/ngids_interface.cap h -fig/nhyper_overview.fig h -fig/nmap_handle.cap h -fig/nmap_handle.fig h -fig/nmap_interface.cap h -fig/nmap_interface.fig h -fig/nmap_make.cap h -fig/nmap_make.fig h -fig/nmap_make_q.cap h -fig/nmap_make_q.fig h -fig/nmodel_convert.cap h -fig/nmodel_convert.fig h -fig/nmodel_handle.cap h -fig/nmodel_handle.fig h -fig/nmodel_interface.cap h -fig/nmodel_interface.fig h -fig/nplot_interface.cap h -fig/nscan_interface.cap h -fig/scn_contents.cap h -fig/scn_contents.fig h -fig/scn_hierarchy.cap h -fig/scn_hierarchy.fig h -fig/scn_indices.cap h -fig/scn_indices.fig h -fig/scn_sector.cap h -fig/scn_sector.fig h -fig/scn_sets.cap h -fig/scn_wmp_indices.fig h -fig/wsrt_layout.cap h -fig/wsrt_layout.fig h -html/elsewhere_inst_maint.html h -html/homepage.html h -html/nfra_config_management.html h -icons/blank.pbm h -icons/contents_motif.gif h -icons/cross_ref_motif.gif h -icons/foot_motif.gif h -icons/icons.html h -icons/index_motif.gif h -icons/next_group_motif.gif h -icons/next_group_motif_gr.gif h -icons/next_motif.gif h -icons/next_motif_gr.gif h -icons/previous_group_motif.gif h -icons/previous_group_motif_gr.gif h -icons/previous_motif.gif h -icons/previous_motif_gr.gif h -icons/up_motif.gif h -icons/up_motif_gr.gif h -intfc/dwarf_private_intfc.tex h -intfc/dwarf_private_keys.tef h -intfc/flfnode_public_intfc.tex h -intfc/flfnode_public_keys.tef h -intfc/global_private_intfc.tex h -intfc/global_private_keys.tef h -intfc/mdlnode_public_intfc.tex h -intfc/mdlnode_public_keys.tef h -intfc/natnf_private_intfc.tex h -intfc/natnf_private_keys.tef h -intfc/ncalib_private_intfc.tex h -intfc/ncalib_private_keys.tef h -intfc/nclean_private_intfc.tex h -intfc/nclean_private_keys.tef h -intfc/ncopy_private_intfc.tex h -intfc/ncopy_private_keys.tef h -intfc/nfilt_private_intfc.tex h -intfc/nfilt_private_keys.tef h -intfc/nflag_private_intfc.tex h -intfc/nflag_private_keys.tef h -intfc/ngcalc_private_intfc.tex h -intfc/ngcalc_private_keys.tef h -intfc/ngen_private_intfc.tex h -intfc/ngen_public_intfc.tex h -intfc/ngen_public_keys.tef h -intfc/ngfsets_public_intfc.tex h -intfc/ngfsets_public_keys.tef h -intfc/ngids_private_intfc.tex h -intfc/ngids_private_keys.tef h -intfc/nmap_private_intfc.tex h -intfc/nmap_private_keys.tef h -intfc/nmap_public_intfc.tex h -intfc/nmap_public_keys.tef h -intfc/nmodel_private_intfc.tex h -intfc/nmodel_private_keys.tef h -intfc/nmodel_public_intfc.tex h -intfc/nmodel_public_keys.tef h -intfc/nplot_private_intfc.tex h -intfc/nplot_private_keys.tef h -intfc/nscan_private_intfc.tex h -intfc/nscan_private_keys.tef h -intfc/nshow_public_intfc.tex h -intfc/nshow_public_keys.tef h -intfc/plotter_public_intfc.tex h -intfc/plotter_public_keys.tef h -intfc/scnnode_public_intfc.tex h -intfc/scnnode_public_keys.tef h -intfc/scnsets_public_intfc.tex h -intfc/scnsets_public_keys.tef h -intfc/select_public_intfc.tex h -intfc/select_public_keys.tef h -intfc/unit_public_intfc.tex h -intfc/unit_public_keys.tef h -intfc/wmpnode_public_intfc.tex h -intfc/wmpnode_public_keys.tef h -intfc/wmpsets_public_intfc.tex h -intfc/wmpsets_public_keys.tef h -latex/bibliography.tex h -latex/common_descr.tex h -latex/doc_guide.tex h -latex/doc_release9511.tex h -latex/file_indexing.tex h -latex/files_descr.tex h -latex/files_handle.tex h -latex/hb_contents.tex h -latex/hb_cook_preamble.sty h -latex/hb_print_preamble.sty h -latex/hb_symbols.sty h -latex/html.sty h -latex/introduction.tex h -latex/lsq.tex h -latex/make_model.tex h -latex/mdl_descr.tex h -latex/models_descr.tex h -latex/mongo_graphics.tex h -latex/ncalib_descr.tex h -latex/ncalib_polar.tex h -latex/ncalib_redun.tex h -latex/nclean_descr.tex h -latex/ncopy_descr.tex h -latex/ncopy_progrmr.tex h -latex/nflag_descr.tex h -latex/ngcalc_descr.tex h -latex/ngids_descr.tex h -latex/nmap_descr.tex h -latex/nmap_example.tex h -latex/nmodel_descr.tex h -latex/nplot_descr.tex h -latex/nscan_descr.tex h -latex/people.tex h -latex/plate_measure.tex h -latex/rcp_batch_processing.tex h -latex/rcp_circ_polarisation.tex h -latex/rcp_continuum_21cm.tex h -latex/rcp_dynamic_range.tex h -latex/rcp_external_calibrators.tex h -latex/rcp_line_21cm.tex h -latex/rcp_linear_polarisation.tex h -latex/rcp_mosaic_21cm.tex h -latex/rcp_mosaic_92cm.tex h -latex/rcp_old_data.tex h -latex/rcp_pulsar_imaging.tex h -latex/rcp_read_data.tex h -latex/rcp_simulated_data.tex h -latex/rcp_spectral_dr.tex h -latex/rcp_uvfits_output.tex h -latex/rcp_variability.tex h -latex/rcp_very_old_data.tex h -latex/record_replay.tex h -latex/scn_file.tex h -latex/scn_summary.tef h -latex/selected_papers.tex h -latex/show_edit.tex h -latex/wmp_descr.tex h -latex/wsrt_fact_sheet.tex h -newstar.hun h -nnews.hlp h -nnews.hlp.old h -nnews.hlp~ h -txt/batch.txt h -txt/bug_reports.txt h -txt/calibr_models.txt h -txt/control_c.txt h -txt/copyright.txt h -txt/debug_efficiently.txt h -txt/doc_organisation.txt h -txt/dwcalc.txt h -txt/memos.txt h -txt/models_and_maps.txt h -txt/more_on_batch.txt h -txt/ncalib_vzero.txt h -txt/ngcalc_lightcurve.txt h -txt/obscure_bugs.txt h -txt/ppd_buffer.txt h -txt/psc_guide.txt h -txt/psctest.txt h -txt/qube.txt h -txt/remote_tape.txt h -txt/spefu_type_categ.txt h -txt/wndpoh.txt h -txt/wntinc.txt h -txt/xmosaic_restart.txt h -doc.grp g -doc.grp g -anchors.idx -latex2html.pls -newstar.hun -nnews.hlp -fig/basic_functions.cap g -fig/basic_functions.cap g -fig/basic_functions.fig g -fig/basic_functions.fig g -fig/clean_vs_find.cap g -fig/clean_vs_find.cap g -fig/clean_vs_find.fig g -fig/clean_vs_find.fig g -fig/doc_sources_and_hyper.fig g -fig/doc_sources_and_hyper.fig g -fig/doc_sources_and_hyper.cap g -fig/doc_sources_and_hyper.cap g -fig/doc_sources_and_print.fig g -fig/doc_sources_and_print.fig g -fig/doc_sources_and_print.cap g -fig/doc_sources_and_print.cap g -fig/dwarf_interface.fig g -fig/dwarf_interface.fig g -fig/dwarf_interface.cap g -fig/dwarf_interface.cap g -fig/error_model.fig g -fig/error_model.fig g -fig/error_model.cap g -fig/error_model.cap g -fig/general_index.fig g -fig/general_index.fig g -fig/model_update.cap g -fig/model_update.cap g -fig/model_update.fig g -fig/model_update.fig g -fig/mosaic_sectors.cap g -fig/mosaic_sectors.cap g -fig/mosaic_sectors.fig g -fig/mosaic_sectors.fig g -fig/natnf_interface.cap g -fig/natnf_interface.cap g -fig/dummy_figure.fig g -fig/dummy_figure.fig g -fig/ncalib_3c48.fig g -fig/ncalib_3c48.fig g -fig/ncalib_3c48.cap g -fig/ncalib_3c48.cap g -fig/ncalib_interface.cap < -fig/ncopy_interface.cap < -fig/ngf_scn_indices.fig < -fig/ncalib_matrix.cap g -fig/ncalib_matrix.cap g -fig/ncalib_scan.fig g -fig/ncalib_scan.fig g -fig/ncalib_scan.cap g -fig/ncalib_scan.cap g -fig/ncalib_vispace.fig g -fig/ncalib_vispace.fig g -fig/ncalib_vispace.cap g -fig/ncalib_vispace.cap g -fig/nclean_interface.fig g -fig/nclean_interface.fig g -fig/nclean_interface.cap g -fig/nclean_interface.cap g -fig/newstar_overview.fig g -fig/newstar_overview.fig g -fig/newstar_overview.cap g -fig/newstar_overview.cap g -fig/nflag_interface.cap g -fig/nflag_interface.cap g -fig/nflag_flag.fig g -fig/nflag_flag.fig g -fig/nflag_flag.cap g -fig/nflag_flag.cap g -fig/nflag_gids.fig g -fig/nflag_gids.fig g -fig/nflag_gids.cap g -fig/nflag_gids.cap g -fig/nflag_inspect.fig g -fig/nflag_inspect.fig g -fig/nflag_inspect.cap g -fig/nflag_inspect.cap g -fig/nflag_mode.fig g -fig/nflag_mode.fig g -fig/nflag_operate.fig g -fig/nflag_operate.fig g -fig/nflag_operate.cap g -fig/nflag_operate.cap g -fig/nflag_statist.fig g -fig/nflag_statist.fig g -fig/nflag_statist.cap g -fig/nflag_statist.cap g -fig/ngcalc_display.fig g -fig/ngcalc_display.fig g -fig/ngcalc_extract.fig g -fig/ngcalc_extract.fig g -fig/ngcalc_interface.cap g -fig/ngcalc_interface.cap g -fig/ngcalc_interface.fig g -fig/ngcalc_interface.fig g -fig/ngids_interface.cap g -fig/ngids_interface.cap g -fig/ngf_scn_indices.cap g -fig/ngf_scn_indices.cap g -fig/nhyper_overview.fig g -fig/nhyper_overview.fig g -fig/nmap_handle.fig g -fig/nmap_handle.fig g -fig/nmap_handle.cap g -fig/nmap_handle.cap g -fig/nmap_interface.cap g -fig/nmap_interface.cap g -fig/nmap_interface.fig g -fig/nmap_interface.fig g -fig/nmap_make.fig g -fig/nmap_make.fig g -fig/nmap_make.cap g -fig/nmap_make.cap g -fig/nmap_make_q.fig g -fig/nmap_make_q.fig g -fig/nmap_make_q.cap g -fig/nmap_make_q.cap g -fig/nmodel_convert.fig g -fig/nmodel_convert.fig g -fig/nmodel_convert.cap g -fig/nmodel_convert.cap g -fig/nmodel_handle.fig g -fig/nmodel_handle.fig g -fig/nmodel_handle.cap g -fig/nmodel_handle.cap g -fig/nmodel_interface.fig g -fig/nmodel_interface.fig g -fig/nmodel_interface.cap g -fig/nmodel_interface.cap g -fig/nplot_interface.cap g -fig/nplot_interface.cap g -fig/nscan_interface.cap g -fig/nscan_interface.cap g -fig/scn_contents.fig g -fig/scn_contents.fig g -fig/scn_contents.cap g -fig/scn_contents.cap g -fig/scn_hierarchy.cap g -fig/scn_hierarchy.cap g -fig/scn_hierarchy.fig g -fig/scn_hierarchy.fig g -fig/scn_indices.cap g -fig/scn_indices.cap g -fig/scn_indices.fig g -fig/scn_indices.fig g -fig/scn_sector.fig g -fig/scn_sector.fig g -fig/scn_sector.cap g -fig/scn_sector.cap g -fig/scn_sets.cap g -fig/scn_sets.cap g -fig/scn_wmp_indices.fig g -fig/scn_wmp_indices.fig g -fig/wsrt_layout.fig g -fig/wsrt_layout.fig g -fig/wsrt_layout.cap g -fig/wsrt_layout.cap g -html/homepage.html g -html/homepage.html g -html/nfra_config_management.html g -html/nfra_config_management.html g -html/elsewhere_inst_maint.html g -html/elsewhere_inst_maint.html g -latex/hb_cook_preamble.sty -latex/hb_print_preamble.sty -latex/hb_symbols.sty -latex/html.sty -latex/bibliography.tex g -latex/bibliography.tex g -latex/common_descr.tex g -latex/common_descr.tex g -latex/doc_guide.tex g -latex/doc_guide.tex g -latex/doc_release9511.tex g -latex/doc_release9511.tex g -latex/file_indexing.tex g -latex/file_indexing.tex g -latex/files_descr.tex g -latex/files_descr.tex g -latex/files_handle.tex g -latex/files_handle.tex g -latex/introduction.tex g -latex/introduction.tex g -latex/hb_contents.tex g -latex/hb_contents.tex g -latex/lsq.tex g -latex/lsq.tex g -latex/mdl_descr.tex g -latex/mdl_descr.tex g -latex/models_descr.tex g -latex/models_descr.tex g -latex/mongo_graphics.tex g -latex/mongo_graphics.tex g -latex/ncalib_descr.tex g -latex/ncalib_descr.tex g -latex/ncalib_polar.tex g -latex/ncalib_polar.tex g -latex/ncalib_redun.tex g -latex/ncalib_redun.tex g -latex/nclean_descr.tex g -latex/nclean_descr.tex g -latex/ncopy_descr.tex g -latex/ncopy_descr.tex g -latex/nflag_descr.tex g -latex/nflag_descr.tex g -latex/ngcalc_descr.tex g -latex/ngcalc_descr.tex g -latex/ngids_descr.tex g -latex/ngids_descr.tex g -latex/make_model.tex g -latex/make_model.tex g -latex/nmap_descr.tex g -latex/nmap_descr.tex g -latex/nmap_example.tex g -latex/nmap_example.tex g -latex/nmodel_descr.tex g -latex/nmodel_descr.tex g -latex/nplot_descr.tex g -latex/nplot_descr.tex g -latex/nscan_descr.tex g -latex/nscan_descr.tex g -latex/people.tex g -latex/people.tex g -latex/plate_measure.tex g -latex/plate_measure.tex g -latex/rcp_batch_processing.tex g -latex/rcp_batch_processing.tex g -latex/rcp_circ_polarisation.tex g -latex/rcp_circ_polarisation.tex g -latex/rcp_continuum_21cm.tex g -latex/rcp_continuum_21cm.tex g -latex/rcp_dynamic_range.tex g -latex/rcp_dynamic_range.tex g -latex/rcp_external_calibrators.tex g -latex/rcp_external_calibrators.tex g -latex/rcp_line_21cm.tex g -latex/rcp_line_21cm.tex g -latex/rcp_linear_polarisation.tex g -latex/rcp_linear_polarisation.tex g -latex/rcp_mosaic_21cm.tex g -latex/rcp_mosaic_21cm.tex g -latex/rcp_mosaic_92cm.tex g -latex/rcp_mosaic_92cm.tex g -latex/rcp_old_data.tex g -latex/rcp_old_data.tex g -latex/rcp_pulsar_imaging.tex g -latex/rcp_pulsar_imaging.tex g -latex/rcp_read_data.tex g -latex/rcp_read_data.tex g -latex/rcp_simulated_data.tex g -latex/rcp_simulated_data.tex g -latex/rcp_spectral_dr.tex g -latex/rcp_spectral_dr.tex g -latex/rcp_uvfits_output.tex g -latex/rcp_uvfits_output.tex g -latex/rcp_variability.tex g -latex/rcp_variability.tex g -latex/rcp_very_old_data.tex g -latex/rcp_very_old_data.tex g -latex/record_replay.tex g -latex/record_replay.tex g -latex/scn_file.tex g -latex/scn_file.tex g -latex/scn_summary.tef -latex/selected_papers.tex g -latex/selected_papers.tex g -latex/show_edit.tex g -latex/show_edit.tex g -latex/wmp_descr.tex g -latex/wmp_descr.tex g -latex/wsrt_fact_sheet.tex g -latex/wsrt_fact_sheet.tex g -intfc/dwarf_private_intfc.tex g -intfc/dwarf_private_intfc.tex g -intfc/dwarf_private_keys.tef -intfc/flfnode_public_intfc.tex g -intfc/flfnode_public_intfc.tex g -intfc/flfnode_public_keys.tef -intfc/global_private_intfc.tex g -intfc/global_private_intfc.tex g -intfc/global_private_keys.tef -intfc/mdlnode_public_intfc.tex g -intfc/mdlnode_public_intfc.tex g -intfc/mdlnode_public_keys.tef -intfc/natnf_private_intfc.tex g -intfc/natnf_private_intfc.tex g -intfc/natnf_private_keys.tef -intfc/ncalib_private_intfc.tex g -intfc/ncalib_private_intfc.tex g -intfc/ncalib_private_keys.tef -intfc/nclean_private_intfc.tex g -intfc/nclean_private_intfc.tex g -intfc/nclean_private_keys.tef -intfc/ncopy_private_intfc.tex g -intfc/ncopy_private_intfc.tex g -intfc/ncopy_private_keys.tef -latex/ncopy_progrmr.tex g -latex/ncopy_progrmr.tex g -intfc/nfilt_private_intfc.tex g -intfc/nfilt_private_intfc.tex g -intfc/nfilt_private_keys.tef -intfc/nflag_private_intfc.tex g -intfc/nflag_private_intfc.tex g -intfc/nflag_private_keys.tef -intfc/ngcalc_private_intfc.tex g -intfc/ngcalc_private_intfc.tex g -intfc/ngcalc_private_keys.tef -intfc/ngen_private_intfc.tex g -intfc/ngen_private_intfc.tex g -intfc/ngen_public_intfc.tex g -intfc/ngen_public_intfc.tex g -intfc/ngen_public_keys.tef -intfc/ngfsets_public_intfc.tex g -intfc/ngfsets_public_intfc.tex g -intfc/ngfsets_public_keys.tef -intfc/ngids_private_intfc.tex g -intfc/ngids_private_intfc.tex g -intfc/ngids_private_keys.tef -intfc/nmap_private_intfc.tex g -intfc/nmap_private_intfc.tex g -intfc/nmap_private_keys.tef -intfc/nmap_public_intfc.tex g -intfc/nmap_public_intfc.tex g -intfc/nmap_public_keys.tef -intfc/nmodel_private_intfc.tex g -intfc/nmodel_private_intfc.tex g -intfc/nmodel_private_keys.tef -intfc/nmodel_public_intfc.tex g -intfc/nmodel_public_intfc.tex g -intfc/nmodel_public_keys.tef -intfc/nplot_private_intfc.tex g -intfc/nplot_private_intfc.tex g -intfc/nplot_private_keys.tef -intfc/nscan_private_intfc.tex g -intfc/nscan_private_intfc.tex g -intfc/nscan_private_keys.tef -intfc/nshow_public_intfc.tex g -intfc/nshow_public_intfc.tex g -intfc/nshow_public_keys.tef -intfc/plotter_public_intfc.tex g -intfc/plotter_public_intfc.tex g -intfc/plotter_public_keys.tef -intfc/scnnode_public_intfc.tex g -intfc/scnnode_public_intfc.tex g -intfc/scnnode_public_keys.tef -intfc/scnsets_public_intfc.tex g -intfc/scnsets_public_intfc.tex g -intfc/scnsets_public_keys.tef -intfc/select_public_intfc.tex g -intfc/select_public_intfc.tex g -intfc/select_public_keys.tef -intfc/unit_public_intfc.tex g -intfc/unit_public_intfc.tex g -intfc/unit_public_keys.tef -intfc/wmpnode_public_intfc.tex g -intfc/wmpnode_public_intfc.tex g -intfc/wmpnode_public_keys.tef -intfc/wmpsets_public_intfc.tex g -intfc/wmpsets_public_intfc.tex g -intfc/wmpsets_public_keys.tef -txt/batch.txt g -txt/batch.txt g -txt/bug_reports.txt g -txt/bug_reports.txt g -txt/calibr_models.txt g -txt/calibr_models.txt g -txt/control_c.txt g -txt/control_c.txt g -txt/copyright.txt g -txt/copyright.txt g -txt/debug_efficiently.txt g -txt/debug_efficiently.txt g -txt/doc_organisation.txt g -txt/doc_organisation.txt g -txt/dwcalc.txt g -txt/dwcalc.txt g -txt/memos.txt g -txt/memos.txt g -txt/models_and_maps.txt g -txt/models_and_maps.txt g -txt/more_on_batch.txt g -txt/more_on_batch.txt g -txt/ncalib_vzero.txt g -txt/ncalib_vzero.txt g -txt/ngcalc_lightcurve.txt g -txt/ngcalc_lightcurve.txt g -txt/obscure_bugs.txt g -txt/obscure_bugs.txt g -txt/ppd_buffer.txt g -txt/ppd_buffer.txt g -txt/psc_guide.txt g -txt/psc_guide.txt g -txt/psctest.txt g -txt/psctest.txt g -txt/qube.txt g -txt/qube.txt g -txt/remote_tape.txt g -txt/remote_tape.txt g -txt/spefu_type_categ.txt g -txt/spefu_type_categ.txt g -txt/wndpoh.txt g -txt/wndpoh.txt g -txt/wntinc.txt g -txt/wntinc.txt g -txt/xmosaic_restart.txt g -txt/xmosaic_restart.txt g -bin/agb.gif -bin/alpha_32_64.ps g -bin/alpha_32_64.ps g -bin/alpha_portability.ps g -bin/alpha_portability.ps g -bin/cmv.gif -bin/hjv.gif -bin/jen.gif -bin/jph.gif -bin/newstar.gif -bin/scn_sets.ps g -bin/scn_sets.ps g -bin/wnb.gif -bin/wsrt.gif -icons/anchor.xbm -icons/blank.xbm -icons/contents.xbm -icons/contents_motif.gif g -icons/contents_motif.gif g -icons/cross -icons/cross_ref_motif.gif g -icons/cross_ref_motif.gif g -icons/foot.xbm -icons/foot_motif.gif g -icons/foot_motif.gif g -icons/icons.fig -icons/icons.html g -icons/icons.html g -icons/index.xbm -icons/index_motif.gif g -icons/index_motif.gif g -icons/invis_anchor.xbm -icons/latex2html.xbm -icons/next.xbm -icons/next_group_motif.gif g -icons/next_group_motif.gif g -icons/next_group_motif_gr.gif g -icons/next_group_motif_gr.gif g -icons/next_motif.gif g -icons/next_motif.gif g -icons/next_motif_gr.gif g -icons/next_motif_gr.gif g -icons/next_page.xbm -icons/previous.xbm -icons/previous_group_motif.gif g -icons/previous_group_motif.gif g -icons/previous_group_motif_gr.gif g -icons/previous_group_motif_gr.gif g -icons/previous_motif.gif g -icons/previous_motif.gif g -icons/previous_motif_gr.gif g -icons/previous_motif_gr.gif g -icons/previous_page.xbm -icons/up.xbm -icons/up_motif.gif g -icons/up_motif.gif g -icons/up_motif_gr.gif g -icons/up_motif_gr.gif g diff --git a/src/doc/fig/basic_functions.cap b/src/doc/fig/basic_functions.cap deleted file mode 100644 index 92224ddc0843565ccec6112ab4dd7b56af6a815c..0000000000000000000000000000000000000000 --- a/src/doc/fig/basic_functions.cap +++ /dev/null @@ -1,16 +0,0 @@ -%basic_functions.cap -\begin{figure} - -\fig{basic_functions} - -\caption[]{\it -\label{.basic.functions} -The basic functionality and data files of \NEWSTAR in a Selfcal application. -\\ \\ -Rectangles represent the data files, ovals the programs. The numbers refer to -the description in the text. -\\ -See text for further explanation. -} -\end{figure} - diff --git a/src/doc/fig/basic_functions.fig b/src/doc/fig/basic_functions.fig deleted file mode 100644 index 3a4652a33a2d603997e37e4b481a243319641328..0000000000000000000000000000000000000000 --- a/src/doc/fig/basic_functions.fig +++ /dev/null @@ -1,152 +0,0 @@ -#FIG 3.1 -Portrait -Center -Inches -1200 2 -1 1 0 2 -1 -1 0 0 -1 0.0000000 1 0.000 15600 7500 900 600 15600 7500 16500 8100 -1 1 0 2 -1 -1 0 0 -1 0.0000000 1 0.000 18000 9600 900 600 18000 9600 18900 10200 -1 1 0 2 -1 -1 0 0 -1 0.0000000 1 0.000 20100 9600 900 600 20100 9600 21000 10200 -1 3 0 1 -1 -1 0 0 20 0.0000000 1 0.000 14100 7500 75 75 14100 7500 14100 7575 -1 1 0 2 -1 -1 0 0 -1 0.0000000 1 0.000 14100 10200 900 600 14100 10200 15000 10800 -1 1 0 2 -1 -1 0 0 -1 0.0000000 1 0.000 14100 4800 900 600 14100 4800 15000 5400 -1 1 0 2 -1 -1 0 0 -1 0.0000000 1 0.000 5700 6600 900 600 5700 6600 6600 7200 -1 1 0 2 -1 -1 0 0 -1 0.0000000 1 0.000 5700 8400 900 600 5700 8400 6600 9000 -1 2 0 2 -1 -1 0 0 -1 0.0000000 1 0.000 10950 12300 1350 600 9600 11700 12300 12900 -1 1 0 2 -1 -1 0 0 -1 0.0000000 1 0.000 18000 13800 900 600 18000 13800 18900 14400 -2 1 1 2 -1 -1 0 0 -1 6.000 0 0 -1 0 0 2 - 17700 11700 20400 11700 -2 2 0 2 -1 -1 0 0 -1 0.000 0 0 0 0 0 5 - 20400 12600 20400 10800 17700 10800 17700 12600 20400 12600 -2 1 1 2 -1 -1 0 0 -1 6.000 0 0 -1 0 0 2 - 17700 6900 20400 6900 -2 1 1 2 -1 -1 0 0 -1 6.000 0 0 -1 0 0 2 - 17700 7500 20400 7500 -2 2 0 2 -1 -1 0 0 -1 0.000 0 0 0 0 0 5 - 20400 8100 20400 6000 17700 6000 17700 8100 20400 8100 -2 1 0 2 -1 -1 0 0 -1 0.000 0 0 7 1 0 2 - 0 0 2.00 135.00 255.00 - 11100 7500 14700 7500 -2 1 0 2 -1 -1 0 0 -1 0.000 0 0 7 1 0 2 - 0 0 2.00 135.00 255.00 - 14100 7500 14100 5400 -2 1 0 2 -1 -1 0 0 -1 0.000 0 0 7 1 0 2 - 0 0 2.00 135.00 255.00 - 14100 7500 14100 9600 -2 1 0 2 -1 -1 0 0 -1 0.000 0 0 7 1 0 2 - 0 0 2.00 135.00 255.00 - 17700 12300 12300 12300 -2 1 0 2 -1 -1 0 0 -1 0.000 0 0 7 1 0 4 - 0 0 2.00 135.00 255.00 - 16500 7500 17100 7500 17100 7200 17700 7200 -2 1 0 2 -1 -1 0 0 -1 0.000 0 0 7 1 0 3 - 0 0 2.00 135.00 255.00 - 17100 7500 17100 7800 17700 7800 -2 1 0 2 -1 -1 0 0 -1 0.000 0 0 7 1 0 2 - 0 0 2.00 135.00 255.00 - 18000 8100 18000 9000 -2 1 0 2 -1 -1 0 0 -1 0.000 0 0 7 1 0 2 - 0 0 2.00 135.00 255.00 - 20100 8100 20100 9000 -2 1 0 2 -1 -1 0 0 -1 0.000 0 0 7 1 0 2 - 0 0 2.00 135.00 255.00 - 18000 10200 18000 10800 -2 1 0 2 -1 -1 0 0 -1 0.000 0 0 7 1 0 2 - 0 0 2.00 135.00 255.00 - 20100 10200 20100 10800 -2 1 1 2 -1 -1 0 0 -1 6.000 0 0 -1 0 0 2 - 8400 7200 11100 7200 -2 1 1 2 -1 -1 0 0 -1 6.000 0 0 -1 0 0 2 - 8400 7800 11100 7800 -2 1 1 2 -1 -1 0 0 -1 6.000 0 0 -1 0 0 2 - 8400 8400 11100 8400 -2 2 0 2 -1 -1 0 0 -1 0.000 0 0 7 0 0 5 - 11100 9600 11100 6300 8400 6300 8400 9600 11100 9600 -2 1 1 2 -1 -1 0 0 -1 6.000 0 0 -1 0 0 2 - 8400 9000 11100 9000 -2 2 0 2 -1 -1 0 0 -1 0.000 0 0 0 0 0 5 - 4200 7200 4200 6000 2400 6000 2400 7200 4200 7200 -2 2 0 2 -1 -1 0 0 -1 0.000 0 0 0 0 0 5 - 4200 9000 4200 7800 2400 7800 2400 9000 4200 9000 -2 1 0 2 -1 -1 0 0 -1 0.000 0 0 7 1 0 2 - 0 0 2.00 135.00 255.00 - 4200 6600 4800 6600 -2 1 0 2 -1 -1 0 0 -1 0.000 0 0 7 1 0 2 - 0 0 2.00 135.00 255.00 - 4200 8400 4800 8400 -2 1 0 2 -1 -1 0 0 -1 0.000 0 0 7 1 0 4 - 0 0 2.00 135.00 255.00 - 6600 6600 6900 6600 6900 8400 6600 8400 -2 1 0 2 -1 -1 0 0 -1 0.000 0 0 7 1 0 2 - 0 0 2.00 135.00 255.00 - 6900 7500 8400 7500 -2 1 0 2 -1 -1 0 0 -1 0.000 0 0 7 1 0 4 - 0 0 2.00 135.00 255.00 - 13200 4800 7500 4800 7500 8100 8400 8100 -2 1 0 2 -1 -1 0 0 -1 0.000 0 0 7 1 0 4 - 0 0 2.00 135.00 255.00 - 13200 10200 7500 10200 7500 8700 8400 8700 -2 1 0 2 -1 -1 0 0 -1 0.000 0 0 7 1 0 4 - 0 0 2.00 135.00 255.00 - 9600 12300 7800 12300 7800 9300 8400 9300 -2 1 0 2 -1 -1 0 0 -1 0.000 0 0 7 1 0 3 - 0 0 2.00 135.00 255.00 - 11100 8100 11700 8100 11700 7500 -2 1 0 2 -1 -1 0 0 -1 0.000 0 0 7 1 0 3 - 0 0 2.00 135.00 255.00 - 11100 8700 12000 8700 12000 7500 -2 1 0 2 -1 -1 0 0 -1 0.000 0 0 7 1 0 3 - 0 0 2.00 135.00 255.00 - 11100 9300 12300 9300 12300 7500 -2 1 0 2 -1 -1 0 0 -1 0.000 0 0 -1 1 0 3 - 0 0 2.00 135.00 255.00 - 12900 7500 12900 14100 17100 14100 -2 1 0 2 -1 -1 0 0 -1 0.000 0 0 -1 1 0 3 - 0 0 2.00 135.00 255.00 - 15300 12300 15300 13500 17100 13500 -2 1 0 2 -1 -1 0 0 -1 0.000 0 0 -1 1 0 4 - 0 0 2.00 135.00 255.00 - 18900 13800 21300 13800 21300 12000 20400 12000 -2 1 0 2 -1 -1 0 0 -1 0.000 0 0 7 1 0 2 - 0 0 2.00 135.00 255.00 - 14100 12300 14100 10725 -4 0 -1 0 0 3 20 0.0000000 0 270 1395 18000 12000 list of source\001 -4 0 -1 0 0 3 20 0.0000000 0 225 1365 18000 12300 components\001 -4 0 -1 0 0 2 20 0.0000000 0 195 1125 13500 10200 NCALIB\001 -4 0 -1 0 0 2 20 0.0000000 0 195 720 13800 10500 redun\001 -4 0 -1 0 0 2 20 0.0000000 0 195 1200 18300 11400 .MDL file\001 -4 0 -1 0 0 2 20 0.0000000 0 195 1305 17400 9600 NMODEL\001 -4 0 -1 0 0 2 20 0.0000000 0 195 1230 19500 9600 NCLEAN\001 -4 0 -1 0 0 2 20 0.0000000 0 195 870 15000 7500 NMAP\001 -4 0 -1 0 0 2 20 0.0000000 0 195 645 15600 7800 make\001 -4 0 -1 0 0 2 20 0.0000000 0 195 480 18000 9900 find\001 -4 0 -1 0 0 2 20 0.0000000 0 195 1020 13500 4800 NFLAG\001 -4 0 -1 0 0 0 10 0.0000000 0 150 1485 18900 4200 basic_functions.fig 40%\001 -4 0 -1 0 0 2 20 0.0000000 0 255 450 13800 5100 flag\001 -4 0 -1 0 0 3 20 0.0000000 0 270 1050 18000 7200 sky maps\001 -4 0 -1 0 0 3 20 0.0000000 0 225 1920 18000 7800 antenna patterns\001 -4 0 -1 0 0 2 20 0.0000000 0 195 1260 18300 6600 .WMP file\001 -4 0 -1 0 0 3 20 0.0000000 0 210 2190 8700 7500 observed visibilities\001 -4 0 -1 0 0 3 20 0.0000000 0 210 1905 8700 9300 model visibilities\001 -4 0 -1 0 0 3 20 0.0000000 0 210 1845 8700 8700 correction tables\001 -4 0 -1 0 0 3 20 0.0000000 0 270 1125 8700 8100 data flags\001 -4 0 -1 0 0 3 20 0.0000000 0 210 1305 2700 6900 observation\001 -4 0 -1 0 0 3 20 0.0000000 0 210 1470 2700 8700 Aobservation\001 -4 0 -1 0 0 2 20 0.0000000 0 195 1005 5100 6600 NSCAN\001 -4 0 -1 0 0 2 20 0.0000000 0 195 1005 5100 8400 NATNF\001 -4 0 -1 0 0 2 20 0.0000000 0 195 1110 9000 6900 .SCN file\001 -4 0 -1 0 0 2 20 0.0000000 0 195 855 2700 6600 WSRT\001 -4 0 -1 0 0 2 20 0.0000000 0 195 795 2700 8400 ATNF\001 -4 0 -1 0 0 2 20 0.0000000 0 195 510 5700 6900 load\001 -4 0 -1 0 0 2 20 0.0000000 0 195 510 5700 8700 load\001 -4 0 -1 0 0 3 20 0.0000000 0 270 1980 9900 12600 several programs\001 -4 0 -1 0 0 3 20 0.0000000 0 270 2175 9900 12300 model-handling in\001 -4 0 -1 0 0 2 32 0.0000000 0 330 225 11100 10800 3\001 -4 0 -1 0 0 2 20 0.0000000 0 195 1305 17400 13800 NMODEL\001 -4 0 -1 0 0 2 20 0.0000000 0 255 825 17700 14100 update\001 -4 0 -1 0 0 2 32 0.0000000 0 330 225 18600 14700 6\001 -4 0 -1 0 0 2 32 0.0000000 0 330 225 21000 10200 5\001 -4 0 -1 0 0 2 32 0.0000000 0 330 225 15000 10800 7\001 -4 0 -1 0 0 2 32 0.0000000 0 330 225 15000 5400 8\001 -4 0 -1 0 0 2 32 0.0000000 0 330 225 6300 6000 1\001 -4 0 -1 0 0 2 32 0.0000000 0 330 225 16200 6900 4\001 -4 0 -1 0 0 2 32 0.0000000 0 330 225 15000 9900 2\001 diff --git a/src/doc/fig/clean_vs_find.cap b/src/doc/fig/clean_vs_find.cap deleted file mode 100644 index ec595b18ee4db559b45c980c5a9e4717d8b2dd6a..0000000000000000000000000000000000000000 --- a/src/doc/fig/clean_vs_find.cap +++ /dev/null @@ -1,25 +0,0 @@ -%clean_vs_find.cap - -\begin{figure}[htbp] - -\fig{clean_vs_find} - -\caption{\it -\label{.clean.vs.find} -Comparison of {\em (a)} the iterative CLEAN and {\em (b)} NMODEL FIND/UPDATE -procedures. \\ -Drawn lines show the process loops, dashed lines the auxiliary data involved. \\ -\\ -(a) In CLEAN, both the source finding and subtraction occur in the map and can -therefore be combined in a single program, {\em NCLEAN}. \\ -\\ -(b) In FIND, sources are modeled in the map but their subtraction must take -place in the visibility domain when a new map is made. \\ -In UPDATE, parameters of an existing source model are refined by comparing the -corresponding visibilities against the observed ones. \\ -\\ -In both procedures, the final product is a source model plus a residual map -containing, along with error artefacts, a fraction of the source that has not -(yet) been modeled. -} -\end{figure} diff --git a/src/doc/fig/clean_vs_find.fig b/src/doc/fig/clean_vs_find.fig deleted file mode 100644 index 36e09f753804bf35ff321d60a55d3fb4223fc0a7..0000000000000000000000000000000000000000 --- a/src/doc/fig/clean_vs_find.fig +++ /dev/null @@ -1,105 +0,0 @@ -#FIG 3.1 -Portrait -Center -Inches -1200 2 -1 1 0 2 -1 -1 0 0 -1 0.0000000 1 0.000 9600 7500 900 600 9600 7500 10500 8100 -1 1 0 2 -1 -1 0 0 -1 0.0000000 1 0.000 9600 9300 900 600 9600 9300 10500 9900 -1 1 0 2 -1 -1 0 0 -1 0.0000000 1 0.000 13800 7500 900 600 13800 7500 14700 8100 -1 1 0 2 -1 -1 0 0 -1 0.0000000 1 0.000 19500 9600 900 600 19500 9600 20400 10200 -1 1 0 2 -1 -1 0 0 -1 0.0000000 1 0.000 15000 15600 900 600 15000 15600 15900 16200 -1 1 0 2 -1 -1 0 0 -1 0.0000000 1 0.000 7200 10500 900 600 7200 10500 8100 11100 -2 1 1 2 -1 -1 0 0 -1 6.000 0 0 -1 0 0 2 - 3900 7200 6600 7200 -2 1 1 2 -1 -1 0 0 -1 6.000 0 0 -1 0 0 2 - 3900 7800 6600 7800 -2 2 0 2 -1 -1 0 0 -1 0.000 0 0 0 0 0 5 - 6600 8400 6600 6300 3900 6300 3900 8400 6600 8400 -2 1 0 2 -1 -1 0 0 -1 0.000 0 0 -1 1 0 4 - 0 0 2.00 135.00 255.00 - 6300 10500 3300 10500 3300 7500 3900 7500 -2 1 1 2 -1 -1 0 0 -1 6.000 0 0 -1 0 0 2 - 4800 13200 7500 13200 -2 2 0 2 -1 -1 0 0 -1 0.000 0 0 0 0 0 5 - 7500 14100 7500 12300 4800 12300 4800 14100 7500 14100 -2 1 0 2 -1 -1 0 0 -1 0.000 0 0 -1 1 0 2 - 0 0 2.00 135.00 255.00 - 9600 8100 9600 8700 -2 1 0 3 -1 -1 0 0 -1 0.000 0 0 7 1 0 2 - 0 0 3.00 195.00 375.00 - 6600 7500 8700 7500 -2 1 1 2 -1 -1 0 0 -1 6.000 0 0 7 1 0 3 - 0 0 2.00 135.00 255.00 - 6600 8100 7200 8100 7200 9900 -2 1 1 2 -1 -1 0 0 -1 6.000 0 0 7 1 0 3 - 0 0 2.00 135.00 255.00 - 9600 10500 9600 13500 7500 13500 -2 1 0 2 -1 -1 0 0 -1 0.000 0 0 -1 1 0 3 - 0 0 2.00 135.00 255.00 - 9600 9900 9600 10500 8100 10500 -2 1 0 2 -1 -1 0 0 -1 0.000 0 0 -1 1 0 3 - 0 0 2.00 135.00 255.00 - 18600 7200 19500 7200 19500 9000 -2 1 0 2 -1 -1 0 0 -1 0.000 0 0 -1 1 0 3 - 0 0 2.00 135.00 255.00 - 19500 10200 19500 13500 18600 13500 -2 1 0 2 -1 -1 0 0 -1 0.000 0 0 7 1 0 3 - 0 0 2.00 135.00 255.00 - 15900 13500 13800 13500 13800 8100 -2 1 0 2 -1 -1 0 0 -1 0.000 0 0 7 1 0 2 - 0 0 2.00 135.00 255.00 - 14700 7500 15900 7500 -2 1 1 2 -1 -1 0 0 -1 6.000 0 0 -1 0 0 2 - 15900 13200 18600 13200 -2 2 0 2 -1 -1 0 0 -1 0.000 0 0 0 0 0 5 - 18600 14100 18600 12300 15900 12300 15900 14100 18600 14100 -2 1 1 2 -1 -1 0 0 -1 6.000 0 0 7 1 0 2 - 0 0 2.00 135.00 255.00 - 13800 5700 13800 6900 -2 1 1 2 -1 -1 0 0 -1 6.000 0 0 -1 0 0 2 - 15900 7200 18600 7200 -2 1 1 2 -1 -1 0 0 -1 6.000 0 0 -1 0 0 2 - 15900 7800 18600 7800 -2 2 0 2 -1 -1 0 0 -1 0.000 0 0 0 0 0 5 - 18600 8400 18600 6300 15900 6300 15900 8400 18600 8400 -2 1 1 2 -1 -1 0 0 -1 6.000 0 0 -1 1 0 3 - 0 0 2.00 135.00 255.00 - 12300 5700 12300 15600 14100 15600 -2 1 0 2 -1 -1 0 0 -1 0.000 0 0 -1 1 0 4 - 0 0 2.00 135.00 255.00 - 18600 13800 19500 13800 19500 15600 15900 15600 -2 1 0 2 -1 -1 0 0 -1 0.000 0 0 7 1 0 3 - 0 0 2.00 135.00 255.00 - 15000 15000 15000 13800 15900 13800 -2 1 1 2 -1 -1 0 0 -1 6.000 0 0 -1 0 0 2 - 11700 4800 14400 4800 -2 2 0 2 -1 -1 0 0 -1 0.000 0 0 7 0 0 5 - 14400 5700 14400 3900 11700 3900 11700 5700 14400 5700 -4 0 -1 0 0 2 20 0.0000000 0 195 1260 4500 6900 .WMP file\001 -4 0 -1 0 0 3 20 0.0000000 0 270 930 4200 7500 sky map\001 -4 0 -1 0 0 3 20 0.0000000 0 225 1800 4200 8100 antenna pattern\001 -4 0 -1 0 0 3 20 0.0000000 0 270 1395 5100 13500 list of source\001 -4 0 -1 0 0 3 20 0.0000000 0 225 1365 5100 13800 components\001 -4 0 -1 0 0 2 20 0.0000000 0 195 1200 5400 12900 .MDL file\001 -4 0 -1 0 0 1 20 0.0000000 0 255 1050 9000 7500 find peak\001 -4 0 -1 0 0 1 20 0.0000000 0 195 1260 9000 9300 scale down\001 -4 0 -1 0 0 3 20 0.0000000 0 210 900 3300 9000 subtract\001 -4 0 -1 0 0 3 32 0.0000000 0 435 525 16200 18000 (b)\001 -4 0 -1 0 0 3 32 0.0000000 0 435 540 5700 18000 (a)\001 -4 0 -1 0 0 2 20 0.0000000 0 195 870 13200 7500 NMAP\001 -4 0 -1 0 0 2 20 0.0000000 0 195 645 13800 7800 make\001 -4 0 -1 0 0 3 20 0.0000000 0 270 1395 16200 13500 list of source\001 -4 0 -1 0 0 3 20 0.0000000 0 225 1365 16200 13800 components\001 -4 0 -1 0 0 2 20 0.0000000 0 195 1200 16500 12900 .MDL file\001 -4 0 -1 0 0 2 20 0.0000000 0 195 1305 18900 9600 NMODEL\001 -4 0 -1 0 0 2 20 0.0000000 0 195 480 19200 9900 find\001 -4 0 -1 0 0 2 20 0.0000000 0 195 1260 16500 6900 .WMP file\001 -4 0 -1 0 0 3 20 0.0000000 0 270 930 16200 7500 sky map\001 -4 0 -1 0 0 3 20 0.0000000 0 210 900 13800 9000 subtract\001 -4 0 -1 0 0 2 20 0.0000000 0 195 1305 14400 15600 NMODEL\001 -4 0 -1 0 0 2 20 0.0000000 0 255 825 14700 15900 update\001 -4 0 -1 0 0 2 20 0.0000000 0 195 1110 12000 4500 .SCN file\001 -4 0 -1 0 0 3 20 0.0000000 0 210 2190 12000 5400 observed visibilities\001 -4 0 -1 0 0 1 20 0.0000000 0 255 1125 6600 10800 peak posn\001 -4 0 -1 0 0 1 20 0.0000000 0 195 810 6600 10500 shift to\001 -4 0 -1 0 0 0 10 0.0000000 0 150 1380 3600 15600 clean_vs_find.fig 45%\001 diff --git a/src/doc/fig/doc_sources_and_hyper.cap b/src/doc/fig/doc_sources_and_hyper.cap deleted file mode 100644 index 156833420035ee71f18d52f4586542c0f8434453..0000000000000000000000000000000000000000 --- a/src/doc/fig/doc_sources_and_hyper.cap +++ /dev/null @@ -1,19 +0,0 @@ -%doc_sources_and_hyper.tex - -\begin{figure}[hbtp] - -\fig{doc_sources_and_hyper} -\caption{ \it -\label{.doc.sources.and.hyper} On-line Help files in the \NEWSTAR -documentation system and their origins. -\\ Files shown in boldface are the documentation and program sources, those -shown in regular print are the derived Help files. -\\ The full-drawn arrows indicate hypertext links for diagrams. The links to -the other files types are not shown. The dotted arrow indicate links to in-line -picture files that contain \Textref{formulas and tables}{.formulas}. -\\ The dashed arrows indicate the relations between the files: Straight arrows -represent a direct derivation, merging arrows a source-file inclusion. The -capital letters on the arrows show in which procedure the derivation is -implemented: -\\ C= ndoc Cook; F= ndoc Fig; T= ndoc Test; P= ndoc Print. } -\end{figure} diff --git a/src/doc/fig/doc_sources_and_hyper.fig b/src/doc/fig/doc_sources_and_hyper.fig deleted file mode 100644 index fca215be64aa908f80551784cbcaa4bbe6c51f7c..0000000000000000000000000000000000000000 --- a/src/doc/fig/doc_sources_and_hyper.fig +++ /dev/null @@ -1,122 +0,0 @@ -#FIG 3.1 -Portrait -Center -Inches -1200 2 -6 10501 8701 13501 11101 -4 0 -1 0 0 1 20 0.0000000 0 255 2400 10504 10204 src/doc/bin/<subj>.ps\001 -4 0 -1 0 0 1 20 0.0000000 0 255 2460 10504 10804 src/doc/bin/<subj>.gif\001 -4 0 -1 0 0 1 20 0.0000000 0 255 2430 10504 9004 src/doc/txt/<subj>.txt\001 -4 0 -1 0 0 1 20 0.0000000 0 255 2880 10504 9604 src/doc/html/<subj>.html\001 --6 -6 1202 8702 3602 11102 -4 0 -1 0 0 2 20 0.0000000 0 255 1605 1204 10204 bin/<subj>.ps\001 -4 0 -1 0 0 2 20 0.0000000 0 255 1650 1204 10804 bin/<subj>.gif\001 -4 0 -1 0 0 2 20 0.0000000 0 255 1665 1204 9004 txt/<subj>.txt\001 -4 0 -1 0 0 2 20 0.0000000 0 255 2175 1204 9604 html/<subj>.html\001 --6 -2 2 2 2 7 7 0 0 -1 4.500 0 0 0 0 0 5 - 6600 12000 6600 11100 6600 11100 6600 12000 6600 12000 -2 1 1 2 -1 7 0 0 19 6.000 0 0 -1 1 0 2 - 1 1 2.00 120.00 240.00 - 7501 3301 10201 3301 -2 1 1 2 -1 7 0 0 19 6.000 0 0 -1 1 0 2 - 1 1 2.00 120.00 240.00 - 7501 4201 10201 4201 -2 1 1 2 -1 7 0 0 19 6.000 0 0 -1 1 0 2 - 1 1 2.00 120.00 240.00 - 8402 7202 10201 7201 -2 1 0 2 -1 7 0 0 19 0.000 0 0 -1 1 0 2 - 1 1 2.00 120.00 240.00 - 11101 3601 11401 3901 -2 1 1 2 -1 7 0 0 19 6.000 0 0 -1 1 0 2 - 1 1 2.00 120.00 240.00 - 7501 5101 11701 5101 -2 1 0 2 -1 7 0 0 19 0.000 0 0 -1 1 0 2 - 1 1 2.00 120.00 240.00 - 12001 4501 12301 4801 -2 1 1 2 -1 7 0 0 19 6.000 0 0 -1 1 0 2 - 1 1 2.00 120.00 240.00 - 4201 9001 10201 9001 -2 1 1 2 -1 7 0 0 19 6.000 0 0 -1 1 0 2 - 1 1 2.00 120.00 240.00 - 3601 9601 10201 9601 -2 1 1 2 -1 7 0 0 19 6.000 0 0 -1 1 0 2 - 1 1 2.00 120.00 240.00 - 3601 10201 10201 10201 -2 1 1 2 -1 7 0 0 19 6.000 0 0 -1 1 0 2 - 1 1 2.00 120.00 240.00 - 3601 10801 10201 10801 -2 1 1 2 -1 7 0 0 19 6.000 0 0 -1 1 0 2 - 1 1 2.00 120.00 240.00 - 3601 9001 10201 9001 -2 1 1 2 -1 7 0 0 19 6.000 0 0 -1 1 0 2 - 1 1 2.00 120.00 240.00 - 3601 11401 10201 11401 -2 2 1 1 -1 -1 0 0 -1 4.000 0 0 0 0 0 5 - 6902 12302 6902 12302 6902 12302 6902 12302 6902 12302 -2 1 0 1 -1 7 0 0 19 0.000 0 0 -1 0 0 2 - 1201 2401 15901 2401 -2 1 1 2 -1 7 0 0 19 6.000 0 0 -1 1 0 2 - 1 1 2.00 120.00 240.00 - 3001 7801 4502 7802 -2 1 1 2 -1 7 0 0 -1 6.000 0 0 -1 1 0 3 - 1 1 2.00 120.00 240.00 - 8401 6601 8701 6601 9001 6001 -2 1 1 2 -1 7 0 0 -1 6.000 0 0 -1 1 0 3 - 1 1 2.00 120.00 240.00 - 8401 7801 8701 7801 9001 7201 -2 1 1 2 -1 7 0 0 19 6.000 0 0 -1 1 0 2 - 1 1 2.00 120.00 240.00 - 8400 6000 10200 6000 -2 1 0 1 -1 7 0 0 19 0.000 0 0 -1 0 0 2 - 3900 900 3900 12000 -2 1 0 1 -1 7 0 0 19 0.000 0 0 -1 0 0 2 - 9600 900 9600 12000 -2 1 1 2 -1 7 0 0 19 6.000 0 0 -1 1 0 2 - 1 1 2.00 120.00 240.00 - 3000 6600 4501 6601 -2 1 2 2 -1 7 0 0 -1 4.500 0 0 -1 1 0 2 - 1 1 2.00 120.00 240.00 - 12900 3300 13800 3300 -2 1 1 2 -1 7 0 0 -1 6.000 0 0 -1 1 0 4 - 1 1 2.00 120.00 240.00 - 9000 3300 9300 3600 13800 3600 14100 3300 -4 0 -1 0 0 2 20 0.0000000 0 195 210 8101 3301 C\001 -4 0 -1 0 0 2 20 0.0000000 0 195 210 8101 4201 C\001 -4 0 -1 0 0 2 20 0.0000000 0 255 3600 4802 6002 intfc/<pgm>_private_intfc.tex\001 -4 0 -1 0 0 2 20 0.0000000 0 255 3495 4803 7203 intfc/<pgm>_public_intfc.tex\001 -4 0 -1 0 0 0 20 0.0000000 0 255 5505 10502 6002 <pgm>_private_intfc/<pgm>_private_intfc.html\001 -4 0 -1 0 0 0 20 0.0000000 0 255 5295 10503 7203 <pgm>_public_intfc/<pgm>_public_intfc.html\001 -4 0 -1 0 0 0 20 0.0000000 0 255 1935 10503 4203 <fig>/<fig>.html\001 -4 0 -1 0 0 2 20 0.0000000 0 255 1920 4803 3303 latex/<subj>.tex\001 -4 0 -1 0 0 2 20 0.0000000 0 255 1500 4803 4203 fig/<fig>.cap\001 -4 0 -1 0 0 2 20 0.0000000 0 255 1395 4801 5101 fig/<fig>.fig\001 -4 0 -1 0 0 2 20 0.0000000 0 195 180 8101 5101 F\001 -4 0 -1 0 0 1 20 0.0000000 0 255 1815 8401 5101 (called by )\001 -4 0 -1 0 0 2 20 0.0000000 0 240 465 9601 5101 C,P\001 -4 0 -1 0 0 2 20 0.0000000 0 195 195 6901 9001 T\001 -4 0 -1 0 0 2 20 0.0000000 0 195 195 6901 9601 T\001 -4 0 -1 0 0 2 20 0.0000000 0 195 195 6901 10201 T\001 -4 0 -1 0 0 2 20 0.0000000 0 195 195 6901 10801 T\001 -4 0 -1 0 0 0 20 0.0000000 0 255 1950 10501 11401 .../<name>.<ext>\001 -4 0 -1 0 0 2 20 0.0000000 0 195 195 6901 11401 T\001 -4 0 -1 0 0 2 20 0.0000000 0 195 2070 1202 11402 .../<name>.<ext>\001 -4 0 -1 0 0 0 20 0.0000000 0 255 3345 4802 6602 intfc/<pgm>_private_keys.tef\001 -4 0 -1 0 0 0 20 0.0000000 0 255 3240 4802 7802 intfc/<pgm>_public_keys.tef\001 -4 0 -1 0 0 2 20 0.0000000 0 255 1605 1201 7801 .../<pgm>.pef\001 -4 0 -1 0 0 2 20 0.0000000 0 255 1620 1201 6601 .../<pgm>.psc\001 -4 0 -1 0 0 3 20 0.0000000 0 195 2070 4802 1502 Document sources\001 -4 0 -1 0 0 3 20 0.0000000 0 270 2370 10502 1502 On-line Help system\001 -4 0 -1 0 0 2 20 0.0000000 0 270 930 4802 2102 $n_doc/\001 -4 0 -1 0 0 2 20 0.0000000 0 270 930 10502 2102 $n_hlp/\001 -4 0 -1 0 0 2 20 0.0000000 0 270 870 1201 2101 $n_src/\001 -4 0 -1 0 0 3 20 0.0000000 0 255 1935 1201 1501 Program sources\001 -4 0 -1 0 0 0 20 0.0000000 0 255 1305 12001 5101 fig/<fig>.ps\001 -4 0 -1 0 0 2 20 0.0000000 0 195 225 9202 7202 K\001 -4 0 -1 0 0 2 20 0.0000000 0 195 225 9201 6001 K\001 -4 0 -1 0 0 0 10 0.0000000 0 150 1965 13500 12000 doc_sources_and_hyper.fig 50%\001 -4 0 -1 0 0 2 20 0.0000000 0 195 225 3603 6603 K\001 -4 0 -1 0 0 2 20 0.0000000 0 195 225 3603 7803 K\001 -4 0 -1 0 0 0 20 0.0000000 0 255 2265 10500 3300 <subj>/<subj>.html\001 -4 0 -1 0 0 1 20 0.0000000 0 255 2160 14100 3300 <subj>/<xxx>.xbm\001 diff --git a/src/doc/fig/doc_sources_and_print.cap b/src/doc/fig/doc_sources_and_print.cap deleted file mode 100644 index dd74c2e8f2eb5e9154f43ce6397584de4c3c7f54..0000000000000000000000000000000000000000 --- a/src/doc/fig/doc_sources_and_print.cap +++ /dev/null @@ -1,15 +0,0 @@ -%doc_sources_and_print.tex - -\begin{figure}[hbtp] - -\fig{doc_sources_and_print} -\caption{ \it -\label{.doc.sources.and.print} Printable documents in the \NEWSTAR -documentation system and their origins. -\\ Files shown in boldface are the documentation and program sources, those -shown in regular print are the derived printable files in the Help system. -\\ The dashed arrows indicate the relations between the files: Straight arrows -represent a direct derivation, merging arrows a source-file inclusion. The -capital letters on the arrows show in which procedure the derivation is -implemented: F= ndoc Fig; T= ndoc Test; P= ndoc Print. } -\end{figure} diff --git a/src/doc/fig/doc_sources_and_print.fig b/src/doc/fig/doc_sources_and_print.fig deleted file mode 100644 index 0ed2ffb2536aa5b654b05850c5dca819fa7078a9..0000000000000000000000000000000000000000 --- a/src/doc/fig/doc_sources_and_print.fig +++ /dev/null @@ -1,98 +0,0 @@ -#FIG 3.1 -Portrait -Center -Inches -1200 2 -2 1 1 2 -1 7 0 0 19 6.000 0 0 -1 1 0 2 - 1 1 2.00 120.00 240.00 - 7200 3300 10201 3301 -2 1 0 1 -1 7 0 0 19 0.000 0 0 -1 0 0 2 - 1201 2401 13800 2400 -2 1 0 1 -1 7 0 0 19 0.000 0 0 -1 0 0 2 - 3900 900 3900 12000 -2 1 0 1 -1 7 0 0 19 0.000 0 0 -1 0 0 2 - 9600 900 9600 12000 -2 1 1 2 -1 7 0 0 -1 6.000 0 0 -1 1 0 3 - 1 1 2.00 120.00 240.00 - 7200 4200 8700 4200 9300 3300 -2 1 1 2 -1 7 0 0 -1 6.000 0 0 -1 1 0 5 - 1 1 2.00 120.00 240.00 - 12000 5400 12300 5400 12300 4800 8100 4800 8475 4200 -2 2 2 2 7 7 0 0 -1 4.500 0 0 0 0 0 5 - 6601 12301 6601 11401 6601 11401 6601 12301 6601 12301 -2 1 1 2 -1 7 0 0 19 6.000 0 0 -1 1 0 2 - 1 1 2.00 120.00 240.00 - 8403 7503 10202 7502 -2 1 1 2 -1 7 0 0 19 6.000 0 0 -1 1 0 2 - 1 1 2.00 120.00 240.00 - 4202 9302 10202 9302 -2 1 1 2 -1 7 0 0 19 6.000 0 0 -1 1 0 2 - 1 1 2.00 120.00 240.00 - 3602 10502 10202 10502 -2 1 1 2 -1 7 0 0 19 6.000 0 0 -1 1 0 2 - 1 1 2.00 120.00 240.00 - 3602 9302 10202 9302 -2 1 1 2 -1 7 0 0 19 6.000 0 0 -1 1 0 2 - 1 1 2.00 120.00 240.00 - 3602 11702 10202 11702 -2 2 1 1 -1 -1 0 0 -1 4.000 0 0 0 0 0 5 - 6903 12603 6903 12603 6903 12603 6903 12603 6903 12603 -2 1 1 2 -1 7 0 0 19 6.000 0 0 -1 1 0 2 - 1 1 2.00 120.00 240.00 - 3002 8102 4503 8103 -2 1 1 2 -1 7 0 0 -1 6.000 0 0 -1 1 0 3 - 1 1 2.00 120.00 240.00 - 8402 6902 8702 6902 9002 6302 -2 1 1 2 -1 7 0 0 -1 6.000 0 0 -1 1 0 3 - 1 1 2.00 120.00 240.00 - 8402 8102 8702 8102 9002 7502 -2 1 1 2 -1 7 0 0 19 6.000 0 0 -1 1 0 2 - 1 1 2.00 120.00 240.00 - 8401 6301 10201 6301 -2 1 1 2 -1 7 0 0 19 6.000 0 0 -1 1 0 2 - 1 1 2.00 120.00 240.00 - 3001 6901 4502 6902 -2 1 1 2 -1 7 0 0 19 6.000 0 0 -1 1 0 2 - 1 1 2.00 120.00 240.00 - 7201 5401 10200 5400 -4 0 -1 0 0 2 20 0.0000000 0 240 1485 4803 3303 latex/<subj>.tex\001 -4 0 -1 0 0 2 20 0.0000000 0 240 1170 4803 4203 fig/<fig>.cap\001 -4 0 -1 0 0 3 20 0.0000000 0 165 1620 4802 1502 Document sources\001 -4 0 -1 0 0 3 20 0.0000000 0 225 1890 10502 1502 On-line Help system\001 -4 0 -1 0 0 2 20 0.0000000 0 255 705 4802 2102 $n_doc/\001 -4 0 -1 0 0 2 20 0.0000000 0 255 705 10502 2102 $n_hlp/\001 -4 0 -1 0 0 2 20 0.0000000 0 255 675 1201 2101 $n_src/\001 -4 0 -1 0 0 3 20 0.0000000 0 225 1500 1201 1501 Program sources\001 -4 0 -1 0 0 0 20 0.0000000 0 225 900 10500 3300 /<subj>.ps\001 -4 0 -1 0 0 2 20 0.0000000 0 165 135 8101 3301 P\001 -4 0 -1 0 0 2 20 0.0000000 0 255 2820 4803 6303 intfc/<pgm>_private_intfc.tex\001 -4 0 -1 0 0 2 20 0.0000000 0 255 2730 4804 7504 intfc/<pgm>_public_intfc.tex\001 -4 0 -1 0 0 2 20 0.0000000 0 240 1080 4802 5402 fig/<fig>.fig\001 -4 0 -1 0 0 2 20 0.0000000 0 165 165 6902 9302 T\001 -4 0 -1 0 0 2 20 0.0000000 0 165 165 6902 9902 T\001 -4 0 -1 0 0 2 20 0.0000000 0 165 165 6902 10502 T\001 -4 0 -1 0 0 2 20 0.0000000 0 165 165 6902 11102 T\001 -4 0 -1 0 0 0 20 0.0000000 0 210 1485 10502 11702 .../<name>.<ext>\001 -4 0 -1 0 0 2 20 0.0000000 0 165 165 6902 11702 T\001 -4 0 -1 0 0 2 20 0.0000000 0 180 1590 1203 11703 .../<name>.<ext>\001 -4 0 -1 0 0 0 20 0.0000000 0 240 2550 4803 6903 intfc/<pgm>_private_keys.tef\001 -4 0 -1 0 0 0 20 0.0000000 0 240 2460 4803 8103 intfc/<pgm>_public_keys.tef\001 -4 0 -1 0 0 2 20 0.0000000 0 240 1260 1202 8102 .../<pgm>.pef\001 -4 0 -1 0 0 2 20 0.0000000 0 240 1275 1202 6902 .../<pgm>.psc\001 -4 0 -1 0 0 2 20 0.0000000 0 165 180 3604 6904 K\001 -4 0 -1 0 0 2 20 0.0000000 0 165 180 3604 8104 K\001 -4 0 -1 0 0 2 20 0.0000000 0 210 345 9001 5401 C,P\001 -4 0 -1 0 0 0 20 0.0000000 0 225 960 10501 5401 fig/<fig>.ps\001 -4 0 -1 0 0 0 20 0.0000000 0 240 2055 10503 6303 <pgm>_private_intfc.ps\001 -4 0 -1 0 0 0 20 0.0000000 0 240 1965 10504 7504 <pgm>_public_intfc.ps\001 -4 0 -1 0 0 1 20 0.0000000 0 225 1860 10505 10505 src/doc/bin/<subj>.ps\001 -4 0 -1 0 0 1 20 0.0000000 0 225 1860 10505 9305 src/doc/txt/<subj>.txt\001 -4 0 -1 0 0 0 10 0.0000000 0 120 1545 11401 12601 doc_sources_and_print.fig 50%\001 -4 0 -1 0 0 2 20 0.0000000 0 195 180 9202 6302 P\001 -4 0 -1 0 0 2 20 0.0000000 0 195 180 9203 7503 P\001 -4 0 -1 0 0 1 20 0.0000000 0 225 1275 7801 5401 (called by )\001 -4 0 -1 0 0 2 20 0.0000000 0 165 165 7503 5403 F\001 -4 0 -1 0 0 2 20 0.0000000 0 240 1245 1205 10505 bin/<subj>.ps\001 -4 0 -1 0 0 2 20 0.0000000 0 240 1275 1205 11105 bin/<subj>.gif\001 -4 0 -1 0 0 2 20 0.0000000 0 240 1245 1205 9305 txt/<subj>.txt\001 -4 0 -1 0 0 2 20 0.0000000 0 240 1665 1205 9905 html/<subj>.html\001 diff --git a/src/doc/fig/dummy_figure.fig b/src/doc/fig/dummy_figure.fig deleted file mode 100644 index 1227d27e88ca4fc6456694ff4c3a0f10827e6bf3..0000000000000000000000000000000000000000 --- a/src/doc/fig/dummy_figure.fig +++ /dev/null @@ -1,8 +0,0 @@ -#FIG 3.1 -Portrait -Center -Inches -1200 2 -2 2 0 1 -1 -1 0 0 -1 0.000 0 0 0 0 0 5 - 10800 4500 10800 3525 2700 3525 2700 4500 10800 4500 -4 0 -1 0 0 3 20 0.0000000 0 270 3420 2925 4200 This is a dummy in place of ##\001 diff --git a/src/doc/fig/dwarf_interface.cap b/src/doc/fig/dwarf_interface.cap deleted file mode 100644 index 57b77b1be3a10c4f44e07c47afdb017b95b61284..0000000000000000000000000000000000000000 --- a/src/doc/fig/dwarf_interface.cap +++ /dev/null @@ -1,22 +0,0 @@ -%dwarf_interface.cap -\begin{figure} - -\fig{dwarf_interface} - -\caption[]{\it -\label{.dwarf.interface} -Schematic of the logistics of program-parameter values in Newstar. -\\ \\ -When requiring user input, the program will look for default values in the -prompting call, the program-parameter-definition (PPD) file and the process -symbol table, in this order. The prompt includes this default if one is found; -the user may replace it with a value of his own. -\\ \\ -The commands shown to the left are used to manipulate the process symbol table. -Parameters from a program run may be stored in the symbol table by using the -/save qualifier on the dwe[xecute] command. -\\ \\ -See text for further explanation. -} -\end{figure} - diff --git a/src/doc/fig/dwarf_interface.fig b/src/doc/fig/dwarf_interface.fig deleted file mode 100644 index d8d1ef94efff0ec5dff289bf06fc015462534c9e..0000000000000000000000000000000000000000 --- a/src/doc/fig/dwarf_interface.fig +++ /dev/null @@ -1,126 +0,0 @@ -#FIG 3.1 -Portrait -Center -Inches -1200 2 -6 6901 6301 8401 6901 -4 0 0 1 0 2 24 0.0000000 0 255 630 6902 6602 dws\001 -4 0 -1 0 0 0 20 0.0000000 0 255 675 7577 6602 pecify\001 --6 -6 7801 6901 9001 7501 -4 0 0 1 0 2 24 0.0000000 0 255 645 7802 7202 dwc\001 -4 0 -1 0 0 0 20 0.0000000 0 195 435 8477 7202 lear\001 --6 -6 6301 7201 7501 7801 -4 0 0 1 0 2 24 0.0000000 0 255 660 6303 7503 dwv\001 -4 0 -1 0 0 0 20 0.0000000 0 195 405 6977 7502 iew\001 --6 -6 6901 9601 8101 10201 -4 0 0 1 0 2 24 0.0000000 0 255 810 6902 9902 dwsa\001 -4 0 -1 0 0 0 20 0.0000000 0 135 255 7727 9902 ve\001 --6 -6 9902 4652 13202 6452 -2 2 0 2 0 1 1 0 -1 0.000 0 0 0 0 0 5 - 9903 4653 12903 4653 12903 6153 9903 6153 9903 4653 -4 0 0 1 0 2 20 0.0000000 0 195 1185 10203 5253 PPD-file \001 -4 0 0 1 0 1 20 0.0000000 0 195 1785 10203 5553 default value in\001 -4 0 0 1 0 1 20 0.0000000 0 255 2340 10203 5853 parameter definition\001 --6 -6 3600 10500 6000 12000 -2 2 0 2 -1 7 0 0 -1 0.000 0 0 0 0 0 5 - 3601 10501 5701 10501 5701 11701 3601 11701 3601 10501 -4 0 -1 0 0 2 20 0.0000000 0 255 840 4201 11101 symbol\001 -4 0 -1 0 0 2 20 0.0000000 0 195 945 4201 11401 save file\001 --6 -6 6900 10801 8551 11250 -4 0 0 1 0 2 27 0.0000000 0 280 710 6901 11026 dwr\001 -4 0 -1 0 0 0 22 0.0000000 0 182 742 7643 11026 estore\001 --6 -2 2 0 2 -1 7 0 0 -1 0.000 0 0 0 0 0 5 - 3301 3901 5701 3901 5701 5701 3301 5701 3301 3901 -2 4 0 2 -1 7 0 0 -1 0.000 0 0 7 0 0 5 - 5536 5566 5536 4066 3451 4066 3451 5566 5536 5566 -2 1 0 2 -1 7 0 0 -1 0.000 0 0 -1 0 0 5 - 3001 6301 2701 6901 4801 6901 5101 6301 3001 6301 -2 1 0 2 -1 7 0 0 -1 0.000 0 0 -1 0 0 5 - 5101 6301 5101 6526 4801 6976 2701 6976 2701 6901 -2 1 0 2 -1 7 0 0 -1 0.000 0 0 -1 1 0 2 - 0 0 2.00 120.00 240.00 - 6001 6001 9601 8401 -2 1 0 2 -1 7 0 0 -1 0.000 0 0 -1 1 0 2 - 0 0 2.00 120.00 240.00 - 9601 8701 6001 6301 -2 1 0 2 -1 7 0 0 -1 0.000 0 0 -1 1 0 2 - 0 0 2.00 120.00 240.00 - 6000 11100 9601 9601 -2 1 0 2 0 1 1 0 -1 0.000 0 0 -1 1 0 2 - 1 1 2.00 120.00 240.00 - 12902 5402 15002 5402 -2 1 0 2 0 1 1 0 -1 0.000 0 0 -1 0 0 5 - 15902 4502 15002 5402 15902 6302 16802 5402 15902 4502 -2 1 0 2 0 1 1 0 -1 0.000 0 0 -1 1 0 2 - 1 1 2.00 120.00 240.00 - 15902 6302 15902 8102 -2 2 0 2 0 1 1 0 -1 0.000 0 0 0 0 0 5 - 9903 8403 12903 8403 12903 9603 9903 9603 9903 8403 -2 1 0 2 0 1 1 0 -1 0.000 0 0 -1 1 0 2 - 1 1 2.00 120.00 240.00 - 12903 9003 15002 9002 -2 1 0 2 0 1 1 0 -1 0.000 0 0 -1 0 0 5 - 15902 8102 15002 9002 15902 9902 16802 9002 15902 8102 -2 1 0 2 0 1 1 0 -1 0.000 0 0 -1 1 0 2 - 1 1 2.00 120.00 240.00 - 15902 9902 15903 10803 -2 2 0 2 0 1 1 0 -1 0.000 0 0 0 0 0 5 - 14403 10803 17403 10803 17403 11703 14403 11703 14403 10803 -2 1 0 2 0 1 1 0 -1 0.000 0 0 -1 1 0 2 - 1 1 2.00 120.00 240.00 - 15902 8402 15902 9302 -2 1 0 2 0 1 1 0 -1 0.000 0 0 -1 1 0 2 - 1 1 2.00 120.00 240.00 - 15902 4802 15902 5702 -2 1 0 2 0 1 1 0 -1 0.000 0 0 -1 1 0 3 - 1 0 2.00 120.00 240.00 - 15302 5402 15602 5402 15902 5702 -2 1 0 2 0 1 1 0 -1 0.000 0 0 -1 1 0 3 - 1 0 2.00 120.00 240.00 - 15302 9002 15602 9002 15902 9302 -2 1 0 2 0 1 1 0 -1 0.000 0 0 -1 1 0 2 - 1 1 2.00 120.00 240.00 - 15902 3602 15902 4502 -2 2 0 2 -1 7 0 0 -1 0.000 0 0 0 0 0 5 - 14401 12001 17401 12001 17401 12901 14401 12901 14401 12001 -2 1 0 2 -1 7 0 0 -1 0.000 0 0 -1 1 0 3 - 0 0 2.00 120.00 240.00 - 17401 12451 18301 12451 18301 3601 -2 2 0 2 -1 7 0 0 -1 0.000 0 0 0 0 0 5 - 9600 2100 18900 2100 18900 3600 9600 3600 9600 2100 -2 1 1 2 -1 7 0 0 -1 6.000 0 0 -1 1 0 3 - 0 0 2.00 120.00 240.00 - 14400 12600 11400 12600 11400 9600 -2 1 0 2 -1 7 0 0 -1 0.000 0 0 -1 1 0 2 - 0 0 2.00 120.00 240.00 - 9600 9300 6000 10800 -2 1 0 2 -1 7 0 0 -1 0.000 0 0 -1 0 0 1 - 3525 13725 -3 2 0 2 -1 7 0 0 -1 0.000 0 0 0 9 - 4201 5701 4201 6001 3901 6151 3526 5926 3151 5926 2776 6076 - 2551 6451 2626 6676 2851 6676 - 1201.00 2101.00 4237.66 5866.68 4237.66 5941.68 4146.35 6089.43 - 4000.10 6154.81 3771.79 6146.04 3630.42 5954.92 3436.46 5901.20 - 3238.54 5909.14 3056.71 5944.16 2854.90 6008.81 2690.57 6148.76 - 2564.27 6330.09 2543.80 6516.57 2562.19 6630.01 2671.40 6708.72 - 2727.65 6708.72 1201.00 2101.00 -4 0 0 1 0 2 20 0.0000000 0 255 2460 10203 9003 Process symbol table\001 -4 0 0 1 0 1 20 0.0000000 0 195 2340 10203 9303 user-defined default\001 -4 0 0 1 0 2 20 0.0000000 0 255 2430 14703 11403 Prompt on terminal\001 -4 0 0 1 0 1 20 0.0000000 0 255 6885 9902 3302 GET_PARM (keyword, ,value-buffer, ..., [default value], ...)\001 -4 0 0 1 0 1 20 0.0000000 0 255 825 13202 5702 (static)\001 -4 0 0 1 0 1 20 0.0000000 0 255 1095 13202 9302 (process-\001 -4 0 0 1 0 1 20 0.0000000 0 255 1410 13202 9602 permanent)\001 -4 0 -1 0 0 2 20 0.0000000 0 255 2265 14701 12601 user's input values\001 -4 0 -1 0 0 1 20 0.0000000 0 255 1920 10500 12900 dwe <program> \001 -4 0 -1 0 0 2 24 0.0000000 0 255 780 12450 12900 /save\001 -4 0 -1 0 0 2 24 0.0000000 0 330 1425 12900 2700 Program\001 -4 0 0 1 0 1 20 0.0000000 0 255 1185 16050 4275 (dynamic)\001 -4 0 -1 0 0 0 10 0.0000000 0 150 1515 3300 13800 dwarf_interface.fig 45%\001 diff --git a/src/doc/fig/error_model.cap b/src/doc/fig/error_model.cap deleted file mode 100644 index 85d46d30ccef2cae314cbb3ddb4a1db3368278c8..0000000000000000000000000000000000000000 --- a/src/doc/fig/error_model.cap +++ /dev/null @@ -1,20 +0,0 @@ -%error_model.cap -\begin{figure} - -\fig{error_model} - -\caption[]{\it -\label{.error.model} -% -NEWSTAR's Selfcal error model. -\\ -The sums of all phase and gain errors that occur in the path between the source -and the correlator differ per telescope and polarisation, i.e. per IF channel. -Each IF channel contributes one and the same error to all interferometers in -which it is connected. The correlator is assumed in first instance to be -error-free; this is almost perfectly true for the WSRT in most observing modes. -\\ -See text for further explanation. -} -\end{figure} - diff --git a/src/doc/fig/error_model.fig b/src/doc/fig/error_model.fig deleted file mode 100644 index 10590b4036360b39c9cb303e06eb8833f25e8f95..0000000000000000000000000000000000000000 --- a/src/doc/fig/error_model.fig +++ /dev/null @@ -1,255 +0,0 @@ -#FIG 3.1 -Portrait -Center -Inches -1200 2 -6 300 300 22500 13800 -5 1 0 3 -1 7 0 0 -1 0.000 0 1 0 0 9302.000 5702.000 9002 5402 9002 6002 9602 6002 -5 1 0 3 -1 7 0 0 -1 0.000 0 1 0 0 6302.000 5702.000 6002 5402 6002 6002 6602 6002 -5 1 0 3 -1 7 0 0 -1 0.000 0 1 0 0 2401.000 5701.000 2101 5401 2101 6001 2701 6001 -5 1 0 3 -1 7 0 0 -1 0.000 0 0 0 0 6301.000 65701.000 301 7201 5401 6901 12301 7201 -5 1 0 3 -1 7 0 0 -1 0.000 0 0 1 0 5813.500 28276.000 3301 7351 5701 7201 8326 7351 - 1 1 3.00 180.00 360.00 -6 600 6900 2400 9900 -3 2 0 2 -1 7 0 0 -1 0.000 0 0 0 8 - 1651 6901 1651 7501 1201 7801 901 8176 901 8701 1126 9001 - 1351 9226 1351 9601 - -5999.00 1.00 1713.19 7234.80 1713.19 7384.80 1576.26 7640.66 - 1294.41 7715.36 1118.06 7877.05 942.14 8058.71 856.03 8304.22 - 858.49 8573.48 931.36 8792.08 1069.69 8936.07 1173.78 9056.09 - 1318.16 9146.72 1380.03 9296.07 1380.03 9389.82 -5999.00 1.00 -3 2 0 2 -1 7 0 0 -1 0.000 0 0 0 10 - 1951 6901 1951 7351 2101 7801 2026 8176 1726 8401 1576 8776 - 1726 9076 2026 9226 2251 9451 2251 9601 - -5999.00 1.00 1938.30 7160.24 1938.30 7272.74 1968.85 7460.99 - 2093.74 7684.43 2106.85 7894.98 2079.83 8090.58 1973.21 8259.77 - 1782.62 8327.11 1665.01 8480.58 1571.36 8664.59 1579.85 8868.52 - 1665.28 9015.28 1786.72 9136.72 1962.08 9179.93 2086.64 9269.71 - 2218.16 9371.72 2262.61 9479.03 2262.61 9516.53 -5999.00 1.00 --6 -6 4501 6901 6301 9901 -3 2 0 2 -1 7 0 0 -1 0.000 0 0 0 8 - 5552 6902 5552 7502 5102 7802 4802 8177 4802 8702 5027 9002 - 5252 9227 5252 9602 - -2098.00 2.00 5614.19 7235.80 5614.19 7385.80 5477.26 7641.66 - 5195.41 7716.36 5019.06 7878.05 4843.14 8059.71 4757.03 8305.22 - 4759.49 8574.48 4832.36 8793.08 4970.69 8937.07 5074.78 9057.09 - 5219.16 9147.72 5281.03 9297.07 5281.03 9390.82 -2098.00 2.00 -3 2 0 2 -1 7 0 0 -1 0.000 0 0 0 10 - 5852 6902 5852 7352 6002 7802 5927 8177 5627 8402 5477 8777 - 5627 9077 5927 9227 6152 9452 6152 9602 - -2098.00 2.00 5839.30 7161.24 5839.30 7273.74 5869.85 7461.99 - 5994.74 7685.43 6007.85 7895.98 5980.83 8091.58 5874.21 8260.77 - 5683.62 8328.11 5566.01 8481.58 5472.36 8665.59 5480.85 8869.52 - 5566.28 9016.28 5687.72 9137.72 5863.08 9180.93 5987.64 9270.71 - 6119.16 9372.72 6163.61 9480.03 6163.61 9517.53 -2098.00 2.00 --6 -6 7501 6901 9301 9901 -3 2 0 2 -1 7 0 0 -1 0.000 0 0 0 8 - 8552 6902 8552 7502 8102 7802 7802 8177 7802 8702 8027 9002 - 8252 9227 8252 9602 - 902.00 2.00 8614.19 7235.80 8614.19 7385.80 8477.26 7641.66 - 8195.41 7716.36 8019.06 7878.05 7843.14 8059.71 7757.03 8305.22 - 7759.49 8574.48 7832.36 8793.08 7970.69 8937.07 8074.78 9057.09 - 8219.16 9147.72 8281.03 9297.07 8281.03 9390.82 902.00 2.00 -3 2 0 2 -1 7 0 0 -1 0.000 0 0 0 10 - 8852 6902 8852 7352 9002 7802 8927 8177 8627 8402 8477 8777 - 8627 9077 8927 9227 9152 9452 9152 9602 - 902.00 2.00 8839.30 7161.24 8839.30 7273.74 8869.85 7461.99 - 8994.74 7685.43 9007.85 7895.98 8980.83 8091.58 8874.21 8260.77 - 8683.62 8328.11 8566.01 8481.58 8472.36 8665.59 8480.85 8869.52 - 8566.28 9016.28 8687.72 9137.72 8863.08 9180.93 8987.64 9270.71 - 9119.16 9372.72 9163.61 9480.03 9163.61 9517.53 902.00 2.00 --6 -2 1 0 3 -1 7 0 0 -1 0.000 0 0 -1 0 0 3 - 8852 5777 8702 6302 9227 6152 -2 1 0 3 -1 7 0 0 -1 0.000 0 0 -1 0 0 3 - 8402 6902 8702 6302 9002 6902 -2 1 0 3 -1 7 0 0 -1 0.000 0 0 -1 0 0 3 - 8852 5702 9452 5552 9302 6152 -2 1 1 3 -1 7 0 0 -1 8.000 0 0 -1 0 0 2 - 9152 5852 14102 602 -2 1 0 3 -1 7 0 0 -1 0.000 0 0 -1 0 0 3 - 5852 5777 5702 6302 6227 6152 -2 1 0 3 -1 7 0 0 -1 0.000 0 0 -1 0 0 3 - 5852 5702 6452 5552 6302 6152 -2 1 1 3 -1 7 0 0 -1 8.000 0 0 -1 0 0 2 - 6152 5852 11102 602 -2 1 0 3 -1 7 0 0 -1 0.000 0 0 -1 0 0 3 - 1951 5776 1801 6301 2326 6151 -2 1 0 3 -1 7 0 0 -1 0.000 0 0 -1 0 0 3 - 1501 6901 1801 6301 2101 6901 -2 1 0 3 -1 7 0 0 -1 0.000 0 0 -1 0 0 3 - 1951 5701 2551 5551 2401 6151 -2 1 1 3 -1 7 0 0 -1 8.000 0 0 -1 0 0 2 - 2251 5851 7201 601 -2 1 1 2 -1 7 0 0 -1 6.000 0 0 7 0 0 2 - 9901 4801 9301 6901 -2 1 1 2 -1 7 0 0 -1 6.000 0 0 7 0 0 2 - 10201 4801 9601 6901 -2 1 1 2 -1 7 0 0 -1 6.000 0 0 7 0 0 2 - 10501 4501 9901 6901 -2 1 1 2 -1 7 0 0 -1 6.000 0 0 7 0 0 2 - 10801 4801 10201 6901 -2 1 1 2 -1 7 0 0 -1 6.000 0 0 7 0 0 2 - 11101 4501 10501 6901 -2 1 1 2 -1 7 0 0 -1 6.000 0 0 7 0 0 2 - 11401 4801 10801 6901 -2 1 1 2 -1 7 0 0 -1 6.000 0 0 7 0 0 2 - 11701 4801 11101 6901 -2 1 1 2 -1 7 0 0 -1 6.000 0 0 7 0 0 2 - 12001 4501 11401 6901 -2 1 2 2 -1 7 0 0 -1 4.500 0 0 -1 0 0 1 - 14102 4502 -2 1 2 2 -1 7 0 0 -1 4.500 0 0 -1 0 0 1 - 11402 8102 -2 2 0 2 -1 7 0 0 -1 0.000 0 0 7 0 0 5 - 3602 12002 7202 12002 7202 13502 3602 13502 3602 12002 -2 2 0 2 -1 7 0 0 -1 0.000 0 0 0 0 0 5 - 1052 9602 1652 9602 1652 10802 1052 10802 1052 9602 -2 2 0 2 -1 7 0 0 -1 0.000 0 0 0 0 0 5 - 1952 9602 2552 9602 2552 10802 1952 10802 1952 9602 -2 2 0 2 -1 7 0 0 -1 0.000 0 0 0 0 0 5 - 4953 9603 5553 9603 5553 10803 4953 10803 4953 9603 -2 2 0 2 -1 7 0 0 -1 0.000 0 0 0 0 0 5 - 5853 9603 6453 9603 6453 10803 5853 10803 5853 9603 -2 2 0 2 -1 7 0 0 -1 0.000 0 0 0 0 0 5 - 7953 9603 8553 9603 8553 10803 7953 10803 7953 9603 -2 2 0 2 -1 7 0 0 -1 0.000 0 0 0 0 0 5 - 8853 9603 9453 9603 9453 10803 8853 10803 8853 9603 -2 1 0 2 -1 7 0 0 -1 0.000 0 0 7 0 0 3 - 5402 6902 5702 6302 6002 6902 -3 3 0 2 -1 7 0 0 -1 0.000 0 0 0 16 - 6601 3901 7201 4201 7501 3301 7801 3301 8101 3601 8101 3901 - 8401 3901 8701 4501 8401 4801 7801 4801 7501 4501 6901 4801 - 6601 4801 6301 4201 6601 3901 6601 3901 - 6601.00 3901.00 6759.34 3938.38 6977.66 4293.51 7516.85 4070.17 - 7245.78 3484.96 7581.71 3242.83 7726.26 3270.04 7906.70 3344.78 - 8057.21 3495.30 8131.96 3675.74 8018.50 3818.50 8183.50 3983.50 - 8321.90 3852.12 8577.87 4010.31 8736.63 4281.41 8678.46 4639.88 - 8506.71 4757.21 8251.51 4862.92 7950.49 4862.92 7695.29 4757.22 - 7639.88 4523.54 7281.41 4465.37 7059.34 4763.62 6830.19 4817.72 - 6680.10 4849.89 6424.13 4691.69 6265.37 4420.59 6323.54 4062.12 - 6495.29 3944.78 6601.00 3901.00 6601.00 3901.00 6759.34 3938.38 -3 3 0 2 -1 7 0 0 -1 0.000 0 0 0 19 - 9901 4501 10201 4201 9901 3901 10201 3601 10501 3601 10501 3301 - 10801 3001 11101 3301 11701 3301 12001 3901 11701 4201 12001 4501 - 11701 4801 11101 4501 10801 4801 10501 4501 10201 4801 9901 4501 - 9901 4501 - 9901.00 4501.00 10006.71 4457.22 10201.00 4366.00 10201.00 4036.00 - 9901.00 4066.00 9901.00 3736.00 10095.29 3644.78 10275.74 3570.04 - 10418.50 3683.50 10583.50 3518.50 10470.04 3375.74 10544.79 3195.30 - 10636.00 3001.00 10966.00 3001.00 10995.29 3257.22 11250.49 3362.92 - 11542.80 3203.23 11877.87 3410.31 12036.63 3681.41 11978.46 4039.88 - 11701.00 4036.00 11701.00 4366.00 12001.00 4336.00 12001.00 4666.00 - 11839.88 4778.46 11481.41 4836.64 11320.59 4465.36 10962.12 4523.54 - 10966.00 4801.00 10636.00 4801.00 10666.00 4501.00 10336.00 4501.00 - 10366.00 4801.00 10036.00 4801.00 9866.83 4583.50 9901.00 4501.00 - 9901.00 4501.00 10006.71 4457.22 -3 3 0 2 -1 7 0 0 -1 0.000 0 0 0 22 - 3474 4361 3180 4606 2788 4459 2544 4214 2739 4067 3131 3871 - 3327 3725 3474 3871 3767 3969 4061 3871 4257 3871 4453 4018 - 4404 4312 4355 4508 4012 4753 3816 4704 3767 4508 3718 4312 - 3621 4312 3523 4312 3474 4361 3474 4361 - 3473.68 4361.04 3498.05 4428.36 3293.94 4586.50 3055.29 4626.97 - 2872.85 4513.37 2718.43 4413.93 2534.76 4338.61 2549.86 4126.19 - 2691.52 4096.91 2825.08 4014.35 3045.34 3924.43 3178.91 3841.88 - 3238.37 3718.32 3401.88 3729.94 3430.83 3845.00 3537.55 3910.96 - 3688.12 3969.39 3846.65 3969.39 3989.30 3883.13 4106.49 3864.11 - 4209.34 3855.62 4316.35 3891.30 4424.68 3948.40 4486.79 4103.44 - 4417.59 4245.54 4394.37 4357.19 4384.52 4464.25 4292.78 4599.01 - 4127.35 4730.82 3956.92 4763.18 3860.03 4747.44 3772.64 4660.04 - 3778.54 4552.52 3756.23 4463.30 3773.21 4354.86 3691.87 4291.34 - 3642.83 4312.09 3598.23 4312.09 3547.02 4301.98 3505.38 4319.23 - 3468.10 4347.58 3473.68 4361.04 3473.68 4361.04 3498.05 4428.36 -3 3 0 2 -1 7 0 0 -1 0.000 0 0 0 22 - 2701 901 5701 601 8401 1201 10801 1201 12901 901 13801 901 - 14101 1201 13876 1651 13501 1801 12601 1801 11101 2101 9601 1801 - 8101 1801 6601 2101 5101 2401 3601 2101 2401 1801 1801 1501 - 1801 1201 2101 901 2701 901 2701 901 - 2701.00 901.00 3389.04 866.68 4994.45 558.92 6349.17 639.60 - 7765.64 1131.26 8952.31 1261.51 10252.32 1239.99 11285.97 1166.53 - 12416.03 935.47 13106.76 886.38 13576.77 808.12 13906.71 944.78 - 14078.46 1062.12 14127.73 1365.69 13973.63 1561.16 13797.62 1723.12 - 13595.29 1782.84 13290.90 1841.46 12807.43 1780.56 12250.14 1835.74 - 11465.82 2101.00 10736.18 2101.00 9951.86 1835.74 9256.95 1766.93 - 8445.05 1766.93 7750.14 1835.74 6942.71 2032.65 6259.29 2169.35 - 5465.82 2401.00 4736.18 2401.00 3941.22 2177.51 3325.89 2039.14 - 2669.09 1900.17 2255.61 1747.22 1910.31 1677.87 1752.11 1421.90 - 1770.04 1275.74 1844.78 1095.30 1995.30 944.78 2250.49 839.08 - 2564.31 901.00 2701.00 901.00 2701.00 901.00 3389.04 866.68 -3 2 0 2 -1 7 0 0 -1 0.000 0 0 0 8 - 1352 10802 1352 11177 1577 11627 2177 11927 2777 11777 3302 11552 - 3827 11702 3902 12002 - -5998.00 1202.00 1336.33 11016.87 1336.33 11110.62 1380.03 11295.75 - 1485.91 11535.92 1698.45 11748.45 2002.31 11907.83 2338.05 11944.68 - 2642.45 11822.33 2901.26 11735.14 3154.03 11561.38 3443.45 11543.03 - 3712.53 11583.66 3875.62 11752.27 3894.37 11827.27 -5998.00 1202.00 -3 2 0 2 -1 7 0 0 -1 0.000 0 0 0 10 - 2252 10802 2252 11102 2402 11402 2702 11402 3002 11252 3377 11177 - 3752 11252 4127 11402 4352 11702 4352 12002 - -5998.00 1202.00 2239.46 10973.89 2239.46 11048.89 2270.69 11181.17 - 2313.57 11347.35 2481.10 11450.88 2631.19 11418.72 2781.17 11383.31 - 2928.18 11277.33 3086.17 11223.12 3285.79 11177.00 3468.21 11177.00 - 3667.65 11226.93 3841.09 11278.48 4047.42 11341.01 4200.89 11458.62 - 4321.64 11610.92 4370.22 11756.65 4370.22 11831.65 -5998.00 1202.00 -3 2 0 2 -1 7 0 0 -1 0.000 0 0 0 6 - 5252 10802 5252 11102 4952 11252 4877 11552 5102 11777 5102 12002 - -5998.00 1202.00 5288.66 10967.68 5288.66 11042.68 5197.35 11190.43 - 5010.37 11179.23 4898.18 11319.09 4852.30 11462.83 4902.42 11643.75 - 5069.16 11697.72 5119.42 11819.04 5119.42 11875.29 -5998.00 1202.00 -3 2 0 2 -1 7 0 0 -1 0.000 0 0 0 7 - 6152 10802 6152 10952 6002 11177 5627 11327 5477 11477 5402 11627 - 5402 12002 - -5998.00 1202.00 6160.20 10887.43 6160.20 10924.93 6132.30 11017.07 - 6055.03 11133.97 5922.79 11241.27 5707.60 11273.85 5584.67 11354.92 - 5506.14 11436.57 5453.96 11508.96 5411.34 11587.42 5386.33 11693.38 - 5386.33 11787.13 -5998.00 1202.00 -3 2 0 2 -1 7 0 0 -1 0.000 0 0 0 8 - 8252 10802 8252 11102 7802 11252 7352 11102 6827 11102 6527 11327 - 6302 11702 6302 12002 - -5998.00 1202.00 8295.63 10966.47 8295.63 11041.47 8160.02 11229.61 - 7923.45 11252.00 7680.55 11252.00 7461.99 11119.85 7230.26 11082.25 - 6954.52 11059.49 6735.91 11132.36 6586.79 11260.70 6457.27 11404.31 - 6330.92 11597.58 6287.12 11755.72 6287.12 11830.72 -5998.00 1202.00 -3 2 0 2 -1 7 0 0 -1 0.000 0 0 0 10 - 9152 10802 9152 11177 9077 11402 8852 11627 8402 11777 7877 11627 - 7352 11402 6902 11402 6602 11702 6602 12002 - -5998.00 1202.00 9162.58 11018.03 9162.58 11111.78 9143.08 11232.00 - 9107.24 11353.07 9036.43 11467.65 8917.64 11586.43 8754.14 11687.48 - 8521.69 11774.40 8264.23 11779.99 7994.77 11668.87 7753.80 11583.20 - 7485.75 11429.45 7246.63 11380.37 7014.12 11355.56 6796.29 11445.79 - 6645.78 11596.29 6578.78 11758.06 6578.78 11833.06 -5998.00 1202.00 -4 0 -1 0 0 2 32 0.0000000 0 435 2235 14401 1201 Ionosphere\001 -4 0 -1 0 0 2 32 0.0000000 0 435 2115 14401 6001 Telescopes\001 -4 0 -1 0 0 2 32 0.0000000 0 435 4590 14403 9903 telescope/IF electronics\001 -4 0 -1 0 0 2 32 0.0000000 0 435 1425 14403 9303 Cables,\001 -4 0 -1 0 0 2 32 0.0000000 0 330 2160 14403 12303 Correlator\001 -4 0 -1 0 0 3 32 0.0000000 0 450 4200 14703 12903 errors mostly negligible\001 -4 0 -1 0 0 3 32 0.0000000 0 210 210 602 10202 x\001 -4 0 -1 0 0 3 32 0.0000000 0 315 210 2702 10202 y\001 -4 0 -1 0 0 3 32 0.0000000 0 210 210 4502 10202 x\001 -4 0 -1 0 0 3 32 0.0000000 0 315 210 6602 10202 y\001 -4 0 -1 0 0 3 32 0.0000000 0 210 210 7502 10202 x\001 -4 0 -1 0 0 3 32 0.0000000 0 315 210 9602 10202 y\001 -4 0 -1 0 0 2 32 0.0000000 0 435 2970 14401 7501 Rotating Earth\001 -4 0 -1 0 0 3 32 0.0000000 0 330 1965 14701 8101 clock error\001 -4 0 -1 0 0 3 32 0.0000000 0 435 3180 14701 1801 Faraday rotation\001 -4 0 -1 0 0 3 32 0.0000000 0 420 2610 14701 6601 position errors\001 -4 0 -1 0 0 3 32 0.0000000 0 450 3975 14703 10503 gain and phase errors\001 -4 0 -1 0 0 2 32 0.0000000 0 435 2565 14401 2701 Troposphere\001 -4 0 -1 0 0 3 32 0.0000000 0 450 4140 14701 3301 Large-scale refraction\001 -4 0 -1 0 0 3 32 0.0000000 0 435 3780 14701 4501 Refraction in water-\001 -4 0 -1 0 0 3 32 0.0000000 0 435 3285 15001 5101 vapour turbulence\001 -4 0 -1 0 0 3 32 0.0000000 0 315 1785 15001 3901 extinction\001 -4 0 -1 0 0 0 10 0.0000000 0 150 1305 11102 13502 error_model.fig 35%\001 -4 0 -1 0 0 3 32 0.0000000 0 330 1245 19502 1802 Global\001 -4 0 -1 0 0 3 32 0.0000000 0 330 1245 19502 3602 Global\001 -4 0 -1 0 0 3 32 0.0000000 0 435 2325 19502 4802 Per telescope\001 -4 0 -1 0 0 3 32 0.0000000 0 435 2325 19502 6602 Per telescope\001 -4 0 -1 0 0 3 32 0.0000000 0 330 1245 19502 8102 Global\001 -4 0 -1 0 0 3 32 0.0000000 0 330 1995 19802 10802 IF channel\001 -4 0 -1 0 0 3 32 0.0000000 0 435 1950 19502 10202 Per dipole/\001 -4 0 -1 0 0 3 32 0.0000000 0 435 780 19502 12602 (Per\001 -4 0 -1 0 0 3 32 0.0000000 0 435 2685 19802 13202 interferometer)\001 --6 diff --git a/src/doc/fig/general_index.fig b/src/doc/fig/general_index.fig deleted file mode 100644 index 9af185cc19cab4a0add764a79bc26baaec2f84cf..0000000000000000000000000000000000000000 --- a/src/doc/fig/general_index.fig +++ /dev/null @@ -1,93 +0,0 @@ -#FIG 3.1 -Portrait -Center -Inches -1200 2 -2 1 1 2 -1 -1 0 0 -1 6.000 0 0 7 0 0 2 - 16500 13200 20100 13200 -2 1 0 2 -1 -1 0 0 -1 0.000 0 0 -1 1 0 2 - 0 0 2.00 135.00 255.00 - 14100 11700 14100 12300 -2 1 1 2 -1 -1 0 0 -1 6.000 0 0 7 0 0 2 - 8100 13200 11400 13200 -2 1 0 2 -1 -1 0 0 -1 0.000 0 0 -1 1 0 4 - 0 0 2.00 135.00 255.00 - 15000 9900 15000 10500 14100 10500 14100 10800 -2 1 1 2 -1 -1 0 0 -1 6.000 0 0 -1 1 0 3 - 0 0 2.00 135.00 255.00 - 14100 10500 9900 10500 9900 10800 -2 1 1 2 -1 -1 0 0 -1 6.000 0 0 -1 1 0 3 - 0 0 2.00 135.00 255.00 - 15000 10500 18300 10500 18300 10800 -2 1 1 2 -1 -1 0 0 -1 6.000 0 0 -1 0 0 1 - 6600 13200 -2 2 0 2 -1 -1 0 0 -1 0.000 0 0 0 0 0 5 - 15300 11700 15300 10800 12900 10800 12900 11700 15300 11700 -2 1 0 2 -1 -1 0 0 -1 0.000 0 0 -1 0 0 2 - 12300 13200 15900 13200 -2 2 0 2 -1 -1 0 0 -1 0.000 0 0 0 0 0 5 - 19500 7500 19500 6600 16800 6600 16800 7500 19500 7500 -2 2 0 2 -1 -1 0 0 -1 0.000 0 0 0 0 0 5 - 20700 5700 20700 4800 18000 4800 18000 5700 20700 5700 -2 1 0 2 -1 -1 0 0 -1 0.000 0 0 -1 1 0 4 - 0 0 2.00 135.00 255.00 - 18000 7500 18000 8100 16800 8100 16800 8400 -2 1 0 2 -1 -1 0 0 -1 0.000 0 0 -1 1 0 4 - 0 0 2.00 135.00 255.00 - 19200 5700 19200 6300 18000 6300 18000 6600 -2 1 1 2 -1 -1 0 0 -1 6.000 0 0 -1 1 0 3 - 0 0 2.00 135.00 255.00 - 18000 8100 20400 8100 20400 8400 -2 2 0 2 -1 -1 0 0 -1 0.000 0 0 0 0 0 5 - 21900 3900 21900 3000 19200 3000 19200 3900 21900 3900 -2 1 0 2 -1 -1 0 0 -1 0.000 0 0 -1 1 0 4 - 0 0 2.00 135.00 255.00 - 20400 3900 20400 4500 19200 4500 19200 4800 -2 1 2 2 -1 -1 0 0 -1 4.500 0 0 7 0 0 2 - 16500 8700 15300 9600 -2 2 0 2 -1 -1 0 0 -1 0.000 0 0 0 0 0 5 - 15900 15300 15900 12300 12300 12300 12300 15300 15900 15300 -2 2 1 2 -1 -1 0 0 -1 6.000 0 0 7 0 0 5 - 11100 11700 11100 10800 8700 10800 8700 11700 11100 11700 -2 2 1 2 -1 -1 0 0 -1 6.000 0 0 7 0 0 5 - 11700 15300 11700 12300 8100 12300 8100 15300 11700 15300 -2 1 1 2 -1 -1 0 0 -1 6.000 0 0 -1 1 0 2 - 0 0 2.00 135.00 255.00 - 9900 11700 9900 12300 -2 1 1 2 -1 -1 0 0 -1 6.000 0 0 -1 1 0 2 - 0 0 2.00 135.00 255.00 - 18300 11700 18300 12300 -2 2 1 2 -1 -1 0 0 -1 6.000 0 0 7 0 0 5 - 19500 11700 19500 10800 17100 10800 17100 11700 19500 11700 -2 2 1 2 -1 -1 0 0 -1 6.000 0 0 7 0 0 5 - 20100 15300 20100 12300 16500 12300 16500 15300 20100 15300 -2 2 1 2 -1 -1 0 0 -1 6.000 0 0 7 0 0 5 - 23100 7500 23100 6600 20700 6600 20700 7500 23100 7500 -2 1 1 2 -1 -1 0 0 -1 6.000 0 0 -1 1 0 3 - 0 0 2.00 135.00 255.00 - 18600 6300 21900 6300 21900 6600 -2 2 1 2 -1 -1 0 0 -1 6.000 0 0 7 0 0 5 - 15600 7500 15600 6600 13200 6600 13200 7500 15600 7500 -2 1 1 2 -1 -1 0 0 -1 6.000 0 0 -1 1 0 3 - 0 0 2.00 135.00 255.00 - 18600 6300 14400 6300 14400 6600 -2 2 1 2 -1 -1 0 0 -1 6.000 0 0 7 0 0 5 - 16500 5700 16500 4800 14100 4800 14100 5700 16500 5700 -2 1 1 2 -1 -1 0 0 -1 6.000 0 0 -1 1 0 3 - 0 0 2.00 135.00 255.00 - 20100 4500 15300 4500 15300 4800 -2 2 1 2 -1 -1 0 0 -1 6.000 0 0 7 0 0 5 - 24600 5700 24600 4800 22200 4800 22200 5700 24600 5700 -2 1 1 2 -1 -1 0 0 -1 6.000 0 0 -1 1 0 3 - 0 0 2.00 135.00 255.00 - 19800 4500 23400 4500 23400 4800 -2 1 1 2 -1 -1 0 0 -1 6.000 0 0 7 1 0 3 - 0 0 2.00 135.00 255.00 - 17100 8100 13500 8100 13500 8400 -4 0 -1 0 0 2 20 0.0000000 0 195 810 13500 12900 header\001 -4 0 -1 0 0 2 20 0.0000000 0 195 525 13500 14100 data\001 -4 0 -1 0 0 2 20 0.0000000 0 195 1155 13500 11400 last index\001 -4 0 -1 0 0 2 20 0.0000000 0 195 1260 20100 3600 file header\001 -4 0 -1 0 0 2 20 0.0000000 0 195 1215 17400 7200 first index\001 -4 0 -1 0 0 2 20 0.0000000 0 255 2340 18150 5400 zeroth index: group\001 -4 0 -1 0 0 0 10 0.0000000 0 150 1395 8400 3300 general_index.fig 40%\001 diff --git a/src/doc/fig/model_update.cap b/src/doc/fig/model_update.cap deleted file mode 100644 index e0763b2eff97b8834b5e82af731d8e4d339410f3..0000000000000000000000000000000000000000 --- a/src/doc/fig/model_update.cap +++ /dev/null @@ -1,24 +0,0 @@ -%model_update.cap -\begin{figure} - -\fig{model_update} - -\caption[]{\it -\label{.model.update} -Schematic diagram of the model-update operation. -\\ \\ -The observation consists of the true source visibilities plus observing errors. -The source model consists of the true source components minus some unknown -defects. -\\ \\ -It is these latter defects that the update procedure tries to determine. To do -this, it transforms the model into visibilities and compares it to the observed -visibilities. It then uses a least-square model fit to determine which part of -the difference is attributable to a model defect. -\\ \\ -The update model to be fitted is different for each model component; moreover -it depends on constraints defined by the user in the form of an update mode -(i.e. update position, update flux, update extents etc.) -} -\end{figure} - diff --git a/src/doc/fig/model_update.fig b/src/doc/fig/model_update.fig deleted file mode 100644 index f554acd6bcd18bfca4dca1837c7fff21086357d5..0000000000000000000000000000000000000000 --- a/src/doc/fig/model_update.fig +++ /dev/null @@ -1,133 +0,0 @@ -#FIG 3.1 -Portrait -Center -Inches -1200 2 -6 3600 300 7800 2700 -2 1 0 2 -1 -1 0 0 -1 0.000 0 0 -1 0 0 2 - 5700 1200 5700 2400 -2 2 0 2 -1 -1 0 0 -1 0.000 0 0 0 0 0 5 - 7500 2400 7500 1200 3900 1200 3900 2400 7500 2400 -4 0 -1 0 0 2 20 0.0000000 0 165 510 4500 1800 true\001 -4 0 -1 0 0 2 20 0.0000000 0 195 1170 4200 2100 visibilities\001 -4 0 -1 0 0 2 20 0.0000000 0 255 1125 6000 1800 observing\001 -4 0 -1 0 0 2 20 0.0000000 0 135 720 6300 2100 errors\001 -4 0 -1 0 0 2 24 0.0000000 0 255 2745 4500 900 OBSERVATION\001 --6 -2 1 0 2 -1 -1 0 0 -1 0.000 0 0 -1 0 0 2 - 10500 3600 10500 4800 -2 1 0 2 -1 -1 0 0 -1 0.000 0 0 -1 0 0 2 - 9600 4800 9600 5400 -2 1 0 2 -1 -1 0 0 -1 0.000 0 0 -1 0 0 2 - 11400 4800 11400 5400 -2 1 0 2 -1 -1 0 0 -1 0.000 0 0 -1 1 0 2 - 0 0 2.00 135.00 255.00 - 9600 6300 9600 6900 -2 1 0 2 -1 -1 0 0 -1 0.000 0 0 -1 1 0 2 - 0 0 2.00 135.00 255.00 - 11400 6300 11400 6900 -2 2 0 2 -1 -1 0 0 -1 0.000 0 0 0 0 0 5 - 12300 4800 12300 3600 8700 3600 8700 4800 12300 4800 -2 1 0 2 -1 -1 0 0 -1 0.000 0 0 -1 0 0 2 - 10500 6900 10500 8100 -2 2 0 2 -1 -1 0 0 -1 0.000 0 0 0 0 0 5 - 12300 8100 12300 6900 8700 6900 8700 8100 12300 8100 -2 1 0 2 -1 -1 0 0 -1 0.000 0 0 -1 0 0 2 - 8100 10800 8100 12000 -2 2 0 2 -1 -1 0 0 -1 0.000 0 0 0 0 0 5 - 9900 12000 9900 10800 6300 10800 6300 12000 9900 12000 -2 4 0 2 -1 -1 0 0 -1 0.000 0 0 16 0 0 5 - 12000 6300 12000 5400 9000 5400 9000 6300 12000 6300 -2 1 0 2 -1 -1 0 0 -1 0.000 0 0 -1 0 0 4 - 6600 2400 6600 8700 7200 8700 7200 9300 -2 1 0 2 -1 -1 0 0 -1 0.000 0 0 -1 1 0 2 - 0 0 2.00 135.00 255.00 - 7200 10200 7200 10800 -2 1 0 2 -1 -1 0 0 -1 0.000 0 0 -1 0 0 4 - 11400 8100 11400 8700 9000 8700 9000 9300 -2 1 1 2 -1 -1 0 0 -1 6.000 0 0 -1 0 0 2 - 9600 8100 9600 8700 -2 1 1 2 -1 -1 0 0 -1 6.000 0 0 -1 0 0 3 - 4800 2400 4800 8700 6600 8700 -2 1 0 2 -1 -1 0 0 -1 0.000 0 0 -1 1 0 2 - 0 0 2.00 135.00 255.00 - 9000 10200 9000 10800 -2 1 0 2 -1 -1 0 0 -1 0.000 0 0 -1 0 0 2 - 7200 12000 7200 12900 -2 1 0 2 -1 -1 0 0 -1 0.000 0 0 -1 0 0 2 - 9000 12000 9000 12900 -2 1 0 2 -1 -1 0 0 -1 0.000 0 0 -1 1 0 3 - 0 0 2.00 135.00 255.00 - 9300 14100 9300 16800 9900 16800 -2 1 1 2 -1 -1 0 0 -1 6.000 0 0 -1 1 0 3 - 0 0 2.00 135.00 255.00 - 7200 14100 7200 14700 5700 14700 -2 1 0 2 -1 -1 0 0 -1 0.000 0 0 -1 1 0 4 - 0 0 2.00 135.00 255.00 - 12300 16800 15000 16800 15000 1500 12300 1500 -2 1 0 2 -1 -1 0 0 -1 0.000 0 0 -1 0 0 4 - 10500 2400 10500 3000 9600 3000 9600 3600 -2 1 0 2 -1 -1 0 0 -1 0.000 0 0 -1 0 0 3 - 10500 3000 11400 3000 11400 3600 -2 1 0 2 -1 -1 0 0 -1 0.000 0 0 -1 0 0 3 - 12300 2100 13200 2100 13200 10200 -2 1 0 2 -1 -1 0 0 -1 0.000 0 0 -1 1 0 2 - 0 0 2.00 135.00 255.00 - 12000 13500 9600 13500 -2 1 0 2 -1 -1 0 0 -1 0.000 0 0 -1 1 0 2 - 0 0 2.00 135.00 255.00 - 15900 13500 14400 13500 -2 2 0 2 -1 -1 0 0 -1 0.000 0 0 0 0 0 5 - 14400 14400 14400 12600 12000 12600 12000 14400 14400 14400 -2 1 0 2 -1 -1 0 0 -1 0.000 0 0 -1 1 0 2 - 0 0 2.00 135.00 255.00 - 13200 11400 13200 12600 -2 2 0 2 -1 -1 0 0 -1 0.000 0 0 0 0 0 5 - 14400 11400 14400 10200 12000 10200 12000 11400 14400 11400 -2 2 0 2 -1 -1 0 0 -1 0.000 0 0 0 0 0 5 - 18000 14415 18000 12615 15900 12615 15900 14415 18000 14415 -2 2 0 2 -1 -1 0 0 -1 0.000 0 0 0 0 0 5 - 12300 2400 12300 1200 8700 1200 8700 2400 12300 2400 -2 4 0 2 -1 -1 0 0 -1 0.000 0 0 16 0 0 5 - 9600 10200 9600 9300 6600 9300 6600 10200 9600 10200 -2 4 0 2 -1 -1 0 0 -1 0.000 0 0 16 0 0 5 - 9600 14100 9600 12900 6600 12900 6600 14100 9600 14100 -2 1 1 2 -1 -1 0 0 -1 6.000 0 0 -1 1 0 3 - 0 0 2.00 135.00 255.00 - 8700 14100 8700 15300 5700 15300 -2 2 0 2 -1 -1 0 0 -1 0.000 0 0 0 0 0 5 - 12300 17700 12300 15900 9900 15900 9900 17700 12300 17700 -4 0 -1 0 0 2 20 0.0000000 0 225 1335 10800 4200 component\001 -4 0 -1 0 0 2 20 0.0000000 0 195 810 11100 4500 defects\001 -4 0 -1 0 0 2 20 0.0000000 0 165 510 9300 4200 true\001 -4 0 -1 0 0 2 20 0.0000000 0 225 1440 8850 4500 components\001 -4 0 -1 0 0 2 20 0.0000000 0 195 2205 9375 6000 Fourier transform\001 -4 0 -1 0 0 2 20 0.0000000 0 195 1170 9150 7800 visibilities\001 -4 0 -1 0 0 2 20 0.0000000 0 165 510 9375 7500 true\001 -4 0 -1 0 0 2 20 0.0000000 0 255 1005 10950 7500 visibility\001 -4 0 -1 0 0 2 20 0.0000000 0 195 810 11025 7800 defects\001 -4 0 -1 0 0 2 20 0.0000000 0 255 1125 6600 11400 observing\001 -4 0 -1 0 0 2 20 0.0000000 0 135 720 6750 11700 errors\001 -4 0 -1 0 0 2 20 0.0000000 0 195 1170 7500 9900 difference\001 -4 0 -1 0 0 2 20 0.0000000 0 195 1080 7500 13500 model fit\001 -4 0 -1 0 0 2 20 0.0000000 0 225 1335 12600 14100 component\001 -4 0 -1 0 0 2 20 0.0000000 0 255 1695 12300 13200 parameterised\001 -4 0 -1 0 0 2 20 0.0000000 0 195 1680 12375 13800 for one source\001 -4 0 -1 0 0 2 20 0.0000000 0 225 1830 12300 10800 one component\001 -4 0 -1 0 0 2 20 0.0000000 0 195 1065 12675 11100 at a time\001 -4 0 -1 0 0 2 20 0.0000000 0 255 1140 16515 13500 requested\001 -4 0 -1 0 0 2 20 0.0000000 0 255 1545 16230 13215 update mode\001 -4 0 -1 0 0 2 20 0.0000000 0 255 855 16515 13815 by user\001 -4 0 -1 0 0 2 24 0.0000000 0 255 1410 9900 900 MODEL\001 -4 0 -1 0 0 2 20 0.0000000 0 255 2715 9000 1800 source-component list\001 -4 0 -1 0 0 0 10 0.0000000 0 150 1395 16500 1200 model_update.fig 45%\001 -4 0 -1 0 0 1 20 0.0000000 0 255 3015 2400 14700 (observing errors rejected)\001 -4 0 -1 0 0 2 20 0.0000000 0 195 810 8550 11700 defects\001 -4 0 -1 0 0 2 20 0.0000000 0 255 1005 8475 11400 visibility\001 -4 0 -1 0 0 0 20 0.0000000 0 255 2730 2400 15300 (defects for other model\001 -4 0 -1 0 0 0 20 0.0000000 0 255 2430 2700 15600 components rejected)\001 -4 0 -1 0 0 2 20 0.0000000 0 195 1920 12225 13500 model of defects\001 -4 0 -1 0 0 2 20 0.0000000 0 255 825 10725 16500 update\001 -4 0 -1 0 0 2 20 0.0000000 0 225 1350 10425 16800 parameters\001 -4 0 -1 0 0 2 20 0.0000000 0 195 1680 10275 17100 for one source\001 -4 0 -1 0 0 2 20 0.0000000 0 225 1335 10500 17400 component\001 diff --git a/src/doc/fig/mosaic_sectors.cap b/src/doc/fig/mosaic_sectors.cap deleted file mode 100644 index 1088aee246e37622f5e109230b77dd53cead6394..0000000000000000000000000000000000000000 --- a/src/doc/fig/mosaic_sectors.cap +++ /dev/null @@ -1,18 +0,0 @@ -%mosaic_sectors.cap -% -\begin{figure} - -\fig{mosaic_sectors} - -\caption[]{\it -\label{.mosaic.sectors} -Sectors in the {\rm uv} plane. -\\ -Left: For a standard observation the scans for a single observation and channel -are contiguous and can be lumped together in a single sector. \\ -Right: In a mosaic observation the cuts for a given field are interleaved with -cuts for other fields, so each cut is stored in a sector of its own. -\\ -The sector numbers shown are just by way of example. -} -\end{figure} diff --git a/src/doc/fig/mosaic_sectors.fig b/src/doc/fig/mosaic_sectors.fig deleted file mode 100644 index 01db8f568a3a54590ca77b17514c8a081ed38801..0000000000000000000000000000000000000000 --- a/src/doc/fig/mosaic_sectors.fig +++ /dev/null @@ -1,52 +0,0 @@ -#FIG 3.1 -Portrait -Center -Inches -1200 2 -6 5100 1800 16830 10215 -5 1 1 1 -1 -1 0 0 -1 4.000 0 0 0 0 12622.500 6007.500 12630 5400 13230 6015 12630 6615 -5 1 1 1 -1 -1 0 0 -1 4.000 0 0 0 0 12622.500 6022.500 12630 4815 13830 6015 12630 7230 -5 1 1 1 -1 -1 0 0 -1 4.000 0 0 0 0 12630.000 6015.000 12630 4215 14430 6015 12630 7815 -5 1 1 1 -1 -1 0 0 -1 4.000 0 0 0 0 12637.500 6022.500 12630 3630 15030 6015 12630 8415 -5 1 1 1 -1 -1 0 0 -1 4.000 0 0 0 0 12637.500 6007.500 12630 3015 15630 6015 12630 9000 -5 1 1 1 -1 -1 0 0 -1 4.000 0 0 0 0 12622.500 6022.500 12630 2415 16230 6015 12630 9630 -5 1 1 1 -1 -1 0 0 -1 4.000 0 0 0 0 5692.500 6007.500 5700 5400 6300 6015 5700 6615 -5 1 1 1 -1 -1 0 0 -1 4.000 0 0 0 0 5692.695 5992.500 5700 4785 6900 6015 5700 7200 -5 1 1 1 -1 -1 0 0 -1 4.000 0 0 0 0 5700.060 6000.000 5700 4200 7500 6015 5700 7800 -5 1 1 1 -1 -1 0 0 -1 4.000 0 0 0 0 5707.590 5992.500 5700 3600 8100 6015 5700 8385 -5 1 1 1 -1 -1 0 0 -1 4.000 0 0 0 0 5707.500 6007.500 5700 3015 8700 6015 5700 9000 -5 1 1 1 -1 -1 0 0 -1 4.000 0 0 0 0 5692.560 5992.500 5700 2385 9300 6015 5700 9600 -5 1 0 1 -1 -1 1 0 1 0.000 0 0 0 0 5716.245 5985.720 8025 3225 9315 6015 9135 7110 -2 1 0 1 -1 -1 0 0 -1 0.000 0 0 -1 0 0 2 - 12030 6015 16830 6015 -2 1 0 1 -1 -1 0 0 -1 0.000 0 0 -1 0 0 2 - 12630 1830 12630 10215 -2 1 0 1 -1 -1 0 0 -1 0.000 0 0 -1 0 0 2 - 5100 6015 9900 6015 -2 1 1 1 -1 -1 0 0 -1 4.000 0 0 -1 0 0 2 - 5700 6015 9300 6015 -2 1 0 1 -1 -1 0 0 -1 0.000 0 0 -1 0 0 2 - 5700 1800 5700 10185 -2 1 0 1 -1 -1 1 0 1 0.000 0 0 -1 0 0 3 - 8010 3225 5715 6015 9120 7110 -2 1 0 1 -1 -1 1 0 1 0.000 0 0 -1 0 0 4 - 14550 2955 12600 6015 14895 3210 14565 3015 -2 1 0 1 -1 -1 1 0 1 0.000 0 0 -1 0 0 4 - 15825 4335 12600 6015 15990 4755 15810 4365 -2 1 0 1 -1 -1 1 0 1 0.000 0 0 -1 0 0 4 - 15300 3630 12630 6015 15570 3975 15315 3630 -2 1 0 1 -1 -1 1 0 1 0.000 0 0 -1 0 0 4 - 16170 5235 12600 6015 16215 5670 16155 5250 -2 1 0 1 -1 -1 1 0 1 0.000 0 0 -1 0 0 4 - 16245 6165 12600 6015 16185 6630 16230 6165 -2 1 0 1 -1 -1 1 0 1 0.000 0 0 -1 0 0 4 - 16065 7125 12600 6015 15900 7530 16050 7125 --6 -4 0 -1 1 0 0 10 0.0000000 0 150 1455 13500 10500 mosaic_sectors.fig 40%\001 -4 0 -1 0 0 2 20 0.0000000 0 195 975 8700 3600 3.2.7.5.0\001 -4 0 -1 0 0 2 20 0.0000000 0 195 975 15600 3600 3.2.7.5.4\001 -4 0 -1 0 0 2 20 0.0000000 0 195 975 16200 4500 3.2.7.5.5\001 -4 0 -1 0 0 2 20 0.0000000 0 195 975 16500 5400 3.2.7.5.6\001 -4 0 -1 0 0 2 20 0.0000000 0 195 975 16500 6600 3.2.7.5.7\001 -4 0 -1 0 0 2 20 0.0000000 0 195 975 16200 7500 3.2.7.5.8\001 -4 0 -1 0 0 2 20 0.0000000 0 195 975 15000 3000 3.2.7.5.3\001 diff --git a/src/doc/fig/natnf_interface.cap b/src/doc/fig/natnf_interface.cap deleted file mode 100644 index 5f4c92f621c4a369bdda746a6906636a55d23bb8..0000000000000000000000000000000000000000 --- a/src/doc/fig/natnf_interface.cap +++ /dev/null @@ -1,11 +0,0 @@ -%natnf_interface.tex -\begin{figure}[hbtp] - -%\fig{natnf_interface} -% -\caption{\it -\label{.natnf.interface} -Overview of the actions in NATNF. -} - -\end{figure} diff --git a/src/doc/fig/ncalib_3c48.cap b/src/doc/fig/ncalib_3c48.cap deleted file mode 100644 index 05dff25f1d0e624ee240158b4137258a0036a97c..0000000000000000000000000000000000000000 --- a/src/doc/fig/ncalib_3c48.cap +++ /dev/null @@ -1,58 +0,0 @@ -%ncalib_3c48.tex -% NOTE: -% This file suffers from the -% -% 'Paragraph ended before \sbox was complete.' -% -% problem. A strange thing is that it is flagged as late as at the start of the -% last paragraph. -% -% Attempts made to fix it: -% - Remove the label: This works -% - Prefix \label with \protect: No effect -% - Put the text in a [\protect]\parbox{\textwidth}{}: No effect -% - Put each paragraph in a \parbox{\textwidth}{}: No effect -% - Remove the \em's: No effect -% - Put \label above \caption: Works - - - -\begin{figure} - - -\fig{ncalib_3c48} -\label{.ncalib.3c48} - -\caption[.]{\it -Principal features of the Selfcal, Redundancy and Align methods. -\\ \\ -These four maps of 3C48 may serve to demonstrate the main features of the three -methods: -\\ \\ -The {\em radial stripes} in (a) are caused by large-scale effects at specific -Hour Angles. These limit the dynamic range of the 'Standard Reduction' to about -1:100 (20 dB). They are still present after a Redundancy solution, but can be -be removed with an Align. -\\ \\ -The {\em prominent rings} in (b) are caused by a slowly varying gain or phase -errors between telescopes A and B. They could be removed by Redundancy, but -only if there is a full solution for all 14 telescopes. Otherwise they can be -removed with Align or Selfcal. -\\ \\ -The {\em almost perfect map} in (c) is the result of Selfcal, without -Redundancy. The minor remaining problems are caused by the incompleteness of -the source model, particularly the small source near 3C48. -\\ \\ -The {\em finished product} in (d) is essentially perfect, and has a dynamic -range in excess of 1:10000 (40 dB), limited by the noise only. The remaining -rings are the grating rings of sources which have not been completely -subtracted. The result has been produced by a full Redundancy solution, -followed by an Align with a model that contained about 10 point sources. -%\\ \\ -%NOTE: Any remaining problems in a WSRT map can always be easily recognised -(and %often diagnosed in detail), thanks to the very regular beam shape. -Reduction %artifacts will not easily be confused with real structure, even at -very low %levels. -} - -\end{figure} diff --git a/src/doc/fig/ncalib_3c48.fig b/src/doc/fig/ncalib_3c48.fig deleted file mode 100644 index d72ea6b4d431994c2bad7bba763a5dc5147c309c..0000000000000000000000000000000000000000 --- a/src/doc/fig/ncalib_3c48.fig +++ /dev/null @@ -1,8 +0,0 @@ -#FIG 3.1 -Portrait -Center -Inches -1200 2 -4 0 -1 0 0 3 20 0.0000000 0 270 3885 4500 4800 postscript object to be inserted here\001 -4 0 -1 0 0 3 10 0.0000000 0 150 1260 10800 1500 ncalib_scan.fig 80%\001 -4 0 -1 0 0 3 32 0.0000000 0 465 8790 2400 900 Effects of Redun, Selfcal and Align in single scan\001 diff --git a/src/doc/fig/ncalib_interface.cap b/src/doc/fig/ncalib_interface.cap deleted file mode 100644 index f6659065b8379ecfa64845b69f640e2c3e2d7e56..0000000000000000000000000000000000000000 --- a/src/doc/fig/ncalib_interface.cap +++ /dev/null @@ -1,11 +0,0 @@ -%ncalib_interface.tex -\begin{figure}[hbtp] - -\fig{ncalib_interface} -% -\caption{\it -\label{.ncalib.interface} -Overview of the actions in NCALIB. -} - -\end{figure} diff --git a/src/doc/fig/ncalib_matrix.cap b/src/doc/fig/ncalib_matrix.cap deleted file mode 100644 index e6b72f4b1dda73f18ceb69acca63ad7653beeeb6..0000000000000000000000000000000000000000 --- a/src/doc/fig/ncalib_matrix.cap +++ /dev/null @@ -1,32 +0,0 @@ -%ncalib_matrix.tex -\begin{figure}[hbtp] - -\fig{ncalib_matrix} -\label{.ncalib.matrix} - -\caption{\it -Least-squares fit of telescope errors through matrix inversion. -\\ \\ -The {\bf problem} is formulated by the matrix equation - $[wd]=W\times[e]$ -in which $[wd]$ is a vector of known values, and $[e]$ is a vector of unkown -telescope errors. Each row (equation) in the matrix is multiplied by a weight -factor, which determines its relative influence on the solution. The same -matrix can contain a mixture of Selfcal equations and Redundancy equations, -both of which have the same general form. If there are only Redundancy -equations, extra -constraint equations are needed to supply the missing information about -the absolute gain (flux) and/or the absolute phase gradient over the -array (position in the sky). -\\ \\ -The matrix $W$ is rectangular because there are more equations than unknowns. -A least-squares {\bf solution} is obtained by the pseudo-inversion of $W$: -\\ \\ -$[e]=W^{-1}\times[wd]={(W^{T}W)}^{-1}W^{T}\times[wd]$ -\\ \\ -To save space and time, the \NEWSTAR implementation uses the much smaller matrix -${(W^{T}W)}^{-1}$ and the vector $W^{T}[wd]$, which is of course mathematically -equivalent. -} - -\end{figure} diff --git a/src/doc/fig/ncalib_scan.cap b/src/doc/fig/ncalib_scan.cap deleted file mode 100644 index ac28faaca61b65fedac30796b99ef17eeeb18856..0000000000000000000000000000000000000000 --- a/src/doc/fig/ncalib_scan.cap +++ /dev/null @@ -1,51 +0,0 @@ -%ncalib_scan.tex -\begin{figure}[hbtp] - -\fig{ncalib_scan} -\label{.ncalib.scan} - -\caption[.]{\it -The effects of Redundancy, Selfcal and Align on the visibilities -in a single HA-scan. -\\ \\ -In all four pictures, the broken line represents the `true' -visibility amplitudes and phases, as a function of baseline length (u). -The actual uv-data are given by crosses. Note the multiple uv-data for -redundant baselines. The source model in this example (full line) is an -off-axis point source. -\\ \\ -{\bf Redundancy}: In (a), he actually measured uv-samples are -scattered, because of instrumental errors. After Redundancy calibration -(b), the amplitudes and phases of redundant baselines are the same -(except for a little residual scatter caused by noise). The result is -an `internally perfect HA-scan', i.e. its shape is as it should be, but -two parameters are still missing: the absolute flux and the absolute -position in the sky. A map made in this stage would show radial stripes -around strong sources. -\\ \\ -{\bf Align}: In (c), the perfect HA-scans that are produced by -Redundancy are `Aligned' with the help of a model of the observed -source. The `rigid' Scans are moved as a whole to fit the model in a -{\em weighted least-squares} sense. Arrows indicate the two parameters -that are determined by Align: one to shift all amplitudes vertically, -and one to rotate all phases around the origin. Note that the outcome -can be influenced by giving more weight to certain baselines. -\\ \\ -{\bf Selfcal}: In `normal' Selfcal (d), the source model is used to -determine $2N$ telescope gain and phase errors. Since this number of -independent parameters is larger than the two that were needed for -Align, the Scan is less `rigid'. This means that the data have greater -freedom to adapt themselves to the {\em wrong} source model. -\\ \\ -To counter this effect, Redundancy constraints can be added to -the Selfcal solution In the \NEWSTAR implementation. If the Redundancy -constraints would be given infinite weight, the outcome would be -identical to that of Redundancy followed by Align. However, this has -the disadvantage that a Redundancy solution may have `frozen-in' errors -caused by noise in certain critical baselines. Such errors may be -`thawed out' by giving more weight to Selfcal (model) constraints. In -the present implementation, Selfcal and Redundancy constraints have -equal weights, which may be close to optimum. -} - -\end{figure} diff --git a/src/doc/fig/ncalib_scan.fig b/src/doc/fig/ncalib_scan.fig deleted file mode 100644 index d72ea6b4d431994c2bad7bba763a5dc5147c309c..0000000000000000000000000000000000000000 --- a/src/doc/fig/ncalib_scan.fig +++ /dev/null @@ -1,8 +0,0 @@ -#FIG 3.1 -Portrait -Center -Inches -1200 2 -4 0 -1 0 0 3 20 0.0000000 0 270 3885 4500 4800 postscript object to be inserted here\001 -4 0 -1 0 0 3 10 0.0000000 0 150 1260 10800 1500 ncalib_scan.fig 80%\001 -4 0 -1 0 0 3 32 0.0000000 0 465 8790 2400 900 Effects of Redun, Selfcal and Align in single scan\001 diff --git a/src/doc/fig/ncalib_vispace.cap b/src/doc/fig/ncalib_vispace.cap deleted file mode 100644 index 31e91ef3f64387f88689d81a8c0329871df5b754..0000000000000000000000000000000000000000 --- a/src/doc/fig/ncalib_vispace.cap +++ /dev/null @@ -1,28 +0,0 @@ -%ncalib_vispace.tex -\begin{figure}[hbtp] - -\fig{ncalib_vispace} -\label{.ncalib.vispace} - -\caption{ -A qualitative interpretation of Selfcal, with or without Redundancy constraints. -\\ \\ -A perfect instrument would give visibility values that are represented by a -point (the {\em true} visibilities) in a 2N-dimensional {\em visibility space}. -N is the number of measured uv-samples. The actual visibility values, which -will be corrupted by instrumental errors, are represented by some other point -in this space. -\\ \\ -In a calibration process, a priori knowledge is used to constrain the volume -of visibility space in which this other point can lie. In Selfcal, the data -are compared with a model of the source (model constraints), under the -assumption that the only instrumental errors are telescope-based gain and phase -errors (instrumental constraints). The points in visibility space that -represent Selfcal Solutions must lie in the shaded volume that is bounded by -the {\em model} and {\em Selfcal} constraints. The technique works because the -two constraint volumes are largely 'orthogonal' to each other, so that the -intersection volume is relatively small. Every extra constraint (more -telescopes, redundant spacings) will make this intersection volume smaller. -} - -\end{figure} diff --git a/src/doc/fig/ncalib_vispace.fig b/src/doc/fig/ncalib_vispace.fig deleted file mode 100644 index 5da1b3b293125c5aa3236b5f173cc6aa4ab05951..0000000000000000000000000000000000000000 --- a/src/doc/fig/ncalib_vispace.fig +++ /dev/null @@ -1,8 +0,0 @@ -#FIG 3.1 -Portrait -Center -Inches -1200 2 -4 0 -1 0 0 3 20 0.0000000 0 270 3885 4500 4800 postscript object to be inserted here\001 -4 0 -1 0 0 3 10 0.0000000 0 150 1455 11400 1500 ncalib_vispace.fig 80%\001 -4 0 -1 0 0 3 32 0.0000000 0 435 8550 2400 900 The effect of Redundancy constraints on Selfcal\001 diff --git a/src/doc/fig/nclean_interface.cap b/src/doc/fig/nclean_interface.cap deleted file mode 100644 index e601e86dfb207586cc2e8c11dc59b59386bd8ad3..0000000000000000000000000000000000000000 --- a/src/doc/fig/nclean_interface.cap +++ /dev/null @@ -1,11 +0,0 @@ -%nclean_interface.tex -\begin{figure}[hbtp] - -\fig{nclean_interface} -% -\caption{\it -\label{.nclean.interface} -Overview of the actions in NCLEAN. -} - -\end{figure} diff --git a/src/doc/fig/nclean_interface.fig b/src/doc/fig/nclean_interface.fig deleted file mode 100644 index 343e6d5ce3ff36ffe5573c4edadbd6f3dff8d152..0000000000000000000000000000000000000000 --- a/src/doc/fig/nclean_interface.fig +++ /dev/null @@ -1,170 +0,0 @@ -#FIG 3.1 -Portrait -Center -Inches -1200 2 -6 14025 16725 16275 17700 -2 1 0 2 -1 -1 0 0 -1 0.000 0 0 7 0 0 2 - 14100 16800 16200 16800 -4 0 -1 0 0 0 12 0.0000000 0 135 1140 14100 17100 RSTMDL=true\001 -4 0 -1 0 0 0 12 0.0000000 0 135 1200 14100 17400 RONMDL=true\001 -4 0 -1 0 0 0 12 0.0000000 0 135 1215 14100 17700 RESMDL=false\001 --6 -2 1 1 1 -1 -1 0 0 -1 4.000 0 0 -1 0 0 2 - 11700 2400 11700 19800 -2 1 1 2 -1 -1 0 0 -1 6.000 0 0 -1 0 0 1 - 14700 2100 -2 1 1 2 -1 -1 0 0 -1 6.000 0 0 -1 0 0 1 - 14700 2400 -2 1 0 2 -1 -1 0 0 -1 0.000 0 0 -1 0 0 2 - 3600 6600 11400 6600 -2 1 0 2 -1 -1 0 0 -1 0.000 0 0 -1 0 0 2 - 3600 7500 13500 7500 -2 1 0 2 -1 -1 0 0 -1 0.000 0 0 -1 0 0 2 - 3600 8400 13500 8400 -2 1 1 2 -1 -1 0 0 -1 6.000 0 0 -1 0 0 2 - 3900 2100 3900 2400 -2 1 1 2 -1 -1 0 0 -1 6.000 0 0 -1 0 0 2 - 6300 2100 6300 2400 -2 1 1 2 -1 -1 0 0 -1 6.000 0 0 -1 0 0 2 - 9300 2100 9300 2400 -2 1 1 2 -1 -1 0 0 -1 6.000 0 0 -1 0 0 2 - 12300 2100 12300 2400 -2 1 1 2 -1 -1 0 0 -1 6.000 0 0 -1 0 0 2 - 14400 2100 14400 2400 -2 1 0 2 -1 -1 0 0 -1 0.000 0 0 -1 0 0 2 - 16800 3900 19500 3900 -2 1 1 2 -1 -1 0 0 -1 6.000 0 0 -1 0 0 2 - 3900 2100 17100 2100 -2 1 1 2 -1 -1 0 0 -1 6.000 0 0 -1 0 0 2 - 17100 2100 17100 2400 -2 1 0 2 -1 -1 0 0 -1 0.000 0 0 -1 0 0 2 - 14100 6600 16200 6600 -2 1 0 2 -1 -1 0 0 -1 0.000 0 0 -1 0 0 2 - 3600 5400 5400 5400 -2 1 1 1 -1 -1 0 0 -1 4.000 0 0 -1 0 0 2 - 16500 2400 16500 19800 -2 1 0 2 -1 -1 0 0 -1 0.000 0 0 -1 0 0 2 - 3600 3600 16200 3600 -2 1 0 2 -1 -1 0 0 -1 0.000 0 0 -1 0 0 2 - 11700 9900 13500 9900 -2 1 0 2 -1 -1 0 0 -1 0.000 0 0 -1 0 0 2 - 3600 9900 8700 9900 -2 1 1 1 -1 -1 0 0 -1 4.000 0 0 -1 0 0 2 - 8700 9900 11700 9900 -2 1 0 2 -1 -1 0 0 -1 0.000 0 0 -1 0 0 2 - 6000 14100 13500 14100 -2 1 0 2 -1 -1 0 0 -1 0.000 0 0 -1 0 0 2 - 6000 12900 13500 12900 -2 1 0 2 -1 -1 0 0 -1 0.000 0 0 -1 0 0 2 - 3600 15600 8400 15600 -2 1 0 2 -1 -1 0 0 -1 0.000 0 0 -1 0 0 2 - 3600 18000 13500 18000 -2 1 0 2 -1 -1 0 0 -1 0.000 0 0 -1 0 0 2 - 6000 16800 11400 16800 -2 1 0 2 -1 -1 0 0 -1 0.000 0 0 -1 0 0 2 - 6000 18900 11400 18900 -2 1 1 1 -1 -1 0 0 -1 4.000 0 0 -1 0 0 2 - 5700 2700 5700 20100 -2 1 0 2 -1 -1 0 0 -1 0.000 0 0 -1 0 0 2 - 6000 11400 8400 11400 -2 1 0 1 -1 -1 0 0 -1 0.000 0 0 -1 0 0 2 - 3600 9300 16200 9300 -2 1 1 1 -1 -1 0 0 -1 4.000 0 0 7 0 0 2 - 13575 3525 13575 20925 -2 1 1 1 -1 -1 0 0 -1 4.000 0 0 -1 0 0 2 - 8700 2400 8700 19800 -4 0 -1 0 0 0 20 0.0000000 0 255 975 3600 3000 Hogbom\001 -4 0 -1 0 0 0 20 0.0000000 0 195 840 3600 2700 BEAM\001 -4 0 -1 0 0 0 20 0.0000000 0 195 1500 14100 3000 Restore from\001 -4 0 -1 0 0 0 20 0.0000000 0 195 930 14100 2700 UREST\001 -4 0 -1 0 0 0 20 0.0000000 0 195 1155 14100 3300 source list\001 -4 0 -1 0 0 0 20 0.0000000 0 195 600 3600 3300 clean\001 -4 0 -1 0 0 0 20 0.0000000 0 195 1410 6000 2700 UVCOVER\001 -4 0 -1 0 0 0 20 0.0000000 0 195 810 9000 2700 DATA\001 -4 0 -1 0 0 0 20 0.0000000 0 255 1230 9000 3000 Polar-grid\001 -4 0 -1 0 0 0 20 0.0000000 0 195 1320 9000 3300 Clark clean\001 -4 0 -1 0 0 0 20 0.0000000 0 195 2445 6000 3000 Standard Clark clean\001 -4 0 -1 0 0 0 20 0.0000000 0 195 1245 12000 2700 COMPON\001 -4 0 -1 0 0 2 20 0.0000000 0 255 2025 4200 6900 CLEAN_LIMIT\001 -4 0 -1 0 0 0 20 0.0000000 0 195 1980 6600 6900 Limit level rel. to\001 -4 0 -1 0 0 0 20 0.0000000 0 255 1740 8700 6900 map maximum\001 -4 0 -1 0 0 2 20 0.0000000 0 195 1140 7200 1800 OPTION\001 -4 0 -1 0 0 2 20 0.0000000 0 255 2325 5400 7800 COMPON_LIMIT\001 -4 0 -1 0 0 2 20 0.0000000 0 255 1710 5400 8700 LOOP_GAIN\001 -4 0 -1 0 0 0 20 0.0000000 0 255 3270 8100 7800 Maximum nr of components\001 -4 0 -1 0 0 0 20 0.0000000 0 255 5475 7500 8700 Multiplier for subtraction of source components\001 -4 0 -1 0 0 2 20 0.0000000 0 195 825 16800 4800 AREA\001 -4 0 -1 0 0 2 20 0.0000000 0 255 1590 16800 4500 WMP_SETS\001 -4 0 -1 0 0 0 20 0.0000000 0 255 1215 18000 4800 Map/beam\001 -4 0 -1 0 0 2 20 0.0000000 0 255 2745 16800 4200 INPUT_WMP_NODE\001 -4 0 -1 0 0 0 20 0.0000000 0 255 1155 16800 3300 histogram\001 -4 0 -1 0 0 0 20 0.0000000 0 255 1905 16800 3000 Make map/beam\001 -4 0 -1 0 0 0 20 0.0000000 0 195 855 16800 2700 HISTO\001 -4 0 -1 0 0 0 20 0.0000000 0 255 1680 14100 7500 residuals input\001 -4 0 -1 0 0 0 20 0.0000000 0 255 1560 14100 7200 Multiplier for\001 -4 0 -1 0 0 2 20 0.0000000 0 255 2025 14100 6900 MAP_FACTOR\001 -4 0 -1 0 0 3 20 0.0000000 0 270 2190 3600 5700 If too little memory:\001 -4 0 -1 0 0 2 20 0.0000000 0 255 2295 3600 6000 DMEMORY_USE\001 -4 0 -1 0 0 0 20 0.0000000 0 255 2385 16800 5100 areas to be processed\001 -4 0 -1 0 0 4 14 0.0000000 0 195 1875 17100 5400 call NMADAR, sets\001 -4 0 -1 0 0 4 14 0.0000000 0 195 2430 17100 5700 NAREA, TAREA, PAREA\001 -4 0 -1 0 0 2 20 0.0000000 0 255 1950 10500 4500 AP_WMP_SET\001 -4 0 -1 0 0 2 20 0.0000000 0 255 2745 8100 4200 INPUT_WMP_NODE\001 -4 0 -1 0 0 2 20 0.0000000 0 255 1590 8100 4500 WMP_SETS\001 -4 0 -1 0 0 2 20 0.0000000 0 195 825 8100 4800 AREA\001 -4 0 -1 0 0 0 20 0.0000000 0 255 2985 9600 4800 Map areas to be processed\001 -4 0 -1 0 0 3 40 0.0000000 0 555 11010 4200 600 Schematic diagram of NCLEAN user interface\001 -4 0 -1 0 0 0 20 0.0000000 0 195 1395 6000 10800 beam centre\001 -4 0 -1 0 0 0 20 0.0000000 0 255 705 7500 10800 (0-.5)\001 -4 0 -1 0 0 2 20 0.0000000 0 255 2220 6000 10200 PRUSSIAN_HAT\001 -4 0 -1 0 0 0 20 0.0000000 0 255 2340 6000 10500 enhanced peaking of\001 -4 0 -1 0 0 0 20 0.0000000 0 15 75 9900 14100 \001 -4 0 -1 0 0 0 20 0.0000000 0 255 2655 9300 13200 Limiting level in major\001 -4 0 -1 0 0 0 20 0.0000000 0 255 1875 6900 13500 cycle rel. to map\001 -4 0 -1 0 0 0 20 0.0000000 0 255 2220 9000 13500 maximum (.001-1)\001 -4 0 -1 0 0 2 20 0.0000000 0 255 2160 6900 13200 CYCLE_DEPTH\001 -4 0 -1 0 0 2 20 0.0000000 0 255 2745 6900 14400 GRATING_FACTOR\001 -4 0 -1 0 0 0 20 0.0000000 0 255 3000 9900 14400 Factor to be applied to the\001 -4 0 -1 0 0 0 20 0.0000000 0 255 6060 6900 14700 estimated cumulative error in provisional cleaning in\001 -4 0 -1 0 0 0 20 0.0000000 0 255 1440 6900 15000 minor cycles\001 -4 0 -1 0 0 0 20 0.0000000 0 195 2385 6000 12000 Must antenna-beam\001 -4 0 -1 0 0 0 20 0.0000000 0 255 2925 5700 12300 tapering be corrected for?\001 -4 0 -1 0 0 2 20 0.0000000 0 255 2145 4200 15900 RESIDUAL (y/n)\001 -4 0 -1 0 0 0 20 0.0000000 0 255 4125 4200 16200 Make residual map after clean cycle\001 -4 0 -1 0 0 0 20 0.0000000 0 195 1140 8400 18300 .MDL file\001 -4 0 -1 0 0 2 20 0.0000000 0 255 3075 4800 18300 OUTPUT_MDL_NODE:\001 -4 0 -1 0 0 2 20 0.0000000 0 255 2040 6300 17100 RESTORE (y/n)\001 -4 0 -1 0 0 0 20 0.0000000 0 255 4140 6300 17400 Make restored map after clean cycle\001 -4 0 -1 0 0 4 14 0.0000000 0 210 5580 4800 18600 set FCAAP=0 if none given, else use FCAAP for MDL file \001 -4 0 -1 0 0 2 20 0.0000000 0 255 3270 5700 11700 DECONVOLUTION (y/n)\001 -4 0 -1 0 0 0 20 0.0000000 0 255 3240 8400 19500 Restoring-beam parameters\001 -4 0 -1 0 0 0 12 0.0000000 0 135 1020 8100 17700 set RSTMDL\001 -4 0 -1 0 0 0 12 0.0000000 0 135 1035 5100 16500 set RESMDL\001 -4 0 -1 0 0 0 12 0.0000000 0 135 915 8100 15300 set GRFAC\001 -4 0 -1 0 0 0 12 0.0000000 0 135 915 8100 13800 set MPDEP\001 -4 0 -1 0 0 0 12 0.0000000 0 135 915 6600 12600 set APDCV\001 -4 0 -1 0 0 0 12 0.0000000 0 135 885 6600 11100 set PRHAT\001 -4 0 -1 0 0 0 12 0.0000000 0 135 2595 8400 9600 RONMDL=false RSTMDL=false\001 -4 0 -1 0 0 0 12 0.0000000 0 135 885 7500 9000 set CLFAC\001 -4 0 -1 0 0 0 12 0.0000000 0 135 885 14400 7800 set CLFAC\001 -4 0 -1 0 0 0 12 0.0000000 0 135 840 12000 7200 set CLLIM\001 -4 0 -1 0 0 0 12 0.0000000 0 135 840 6600 7200 set CLLIM\001 -4 0 -1 0 0 0 12 0.0000000 0 135 885 8100 19200 If RSTMDL\001 -4 0 -1 0 0 0 12 0.0000000 0 165 2445 7200 19800 set RESDL, RESDM, RESDAN\001 -4 0 -1 0 0 2 20 0.0000000 0 255 2400 5700 19500 RESTORE_BEAM\001 -4 0 -1 0 0 0 12 0.0000000 0 180 1770 14100 20400 NMODAX: get model-\001 -4 0 -1 0 0 0 12 0.0000000 0 180 1530 14100 20700 handling parameters\001 -4 0 -1 0 0 0 12 0.0000000 0 180 1440 9000 20700 making parameters\001 -4 0 -1 0 0 0 12 0.0000000 0 180 1860 9000 20400 NMADAC: set up map-\001 -4 0 -1 0 0 0 12 0.0000000 0 135 720 9000 21300 NCLCDT\001 -4 0 -1 0 0 0 12 0.0000000 0 135 750 12000 21300 NCLCMP\001 -4 0 -1 0 0 0 12 0.0000000 0 135 615 14100 21300 NCLUV\001 -4 0 -1 0 0 0 12 0.0000000 0 135 660 16800 21300 NCLHIS\001 -4 0 -1 0 0 0 12 0.0000000 0 135 615 6000 21300 NCLUV\001 -4 0 -1 0 0 0 12 0.0000000 0 135 735 3600 21300 NCLBEA\001 -4 0 -1 0 0 0 12 0.0000000 0 135 870 3900 21600 NMODAX \001 -4 0 -1 0 0 0 12 0.0000000 0 135 960 7500 8100 set SRCLIM\001 -4 0 -1 0 0 0 12 0.0000000 0 135 1020 3900 6300 set MEMSIZ\001 -4 0 -1 0 0 0 12 0.0000000 0 165 3645 8400 5100 call NMADAR, sets NAREA, TAREA, PAREA\001 -4 0 -1 0 0 0 12 0.0000000 0 180 1845 16500 600 nclean_interface.fig 50%\001 diff --git a/src/doc/fig/ncopy_interface.cap b/src/doc/fig/ncopy_interface.cap deleted file mode 100644 index a76661904403f7e8db5c286ef4a5fa41a9dabdaa..0000000000000000000000000000000000000000 --- a/src/doc/fig/ncopy_interface.cap +++ /dev/null @@ -1,11 +0,0 @@ -%ncopy_interface.tex -\begin{figure}[hbtp] - -%\fig{ncopy_interface} -% -\caption{\it -\label{.ncopy.interface} -Overview of the actions in NCOPY. -} - -\end{figure} diff --git a/src/doc/fig/newstar_overview.cap b/src/doc/fig/newstar_overview.cap deleted file mode 100644 index fcf516836438f81fcba9347cd42700447afbf036..0000000000000000000000000000000000000000 --- a/src/doc/fig/newstar_overview.cap +++ /dev/null @@ -1,19 +0,0 @@ -%newstar_overview.cap -\begin{figure} -\fig{newstar_overview} -\caption[]{\it -\label{.newstar.overview} -Overview of the Newstar programs and data files and their interrelations. -For information on entities in this diagram see \\ -\\ -programs - \textref{\bf NCALIB}{ncalib_descr}, - \textref{\bf NMAP}{nmap_descr}, - \textref{\bf NSCAN}{nscan_descr} \\ -files - \textref{\bf .SCN file}{scn_file}, - \textref{\bf .WMP file}{wmp_descr}, - \textref{\bf .MDL file}{mdl_descr} -} -\end{figure} - diff --git a/src/doc/fig/newstar_overview.fig b/src/doc/fig/newstar_overview.fig deleted file mode 100644 index ac6145d9324501b623c8dd5bb291f15afaa721b6..0000000000000000000000000000000000000000 --- a/src/doc/fig/newstar_overview.fig +++ /dev/null @@ -1,209 +0,0 @@ -#FIG 3.1 -Portrait -Center -Inches -1200 2 -6 6900 9900 11100 12300 -2 4 0 1 -1 -1 0 0 -1 0.000 0 0 7 0 0 5 - 8700 10500 8700 9900 6900 9900 6900 10500 8700 10500 -2 4 0 1 -1 -1 0 0 -1 0.000 0 0 7 0 0 5 - 11100 10500 11100 9900 9300 9900 9300 10500 11100 10500 -2 4 0 1 -1 -1 0 0 -1 0.000 0 0 7 0 0 5 - 8700 11400 8700 10800 6900 10800 6900 11400 8700 11400 -2 4 0 1 -1 -1 0 0 -1 0.000 0 0 7 0 0 5 - 11100 11400 11100 10800 9300 10800 9300 11400 11100 11400 -2 4 0 1 -1 -1 0 0 -1 0.000 0 0 7 0 0 5 - 8700 12300 8700 11700 6900 11700 6900 12300 8700 12300 -2 4 0 1 -1 -1 0 0 -1 0.000 0 0 7 0 0 5 - 11100 12300 11100 11700 9300 11700 9300 12300 11100 12300 -4 0 -1 0 0 18 12 0.0000000 4 180 1770 6975 10425 parameter interface\001 -4 0 -1 0 0 18 12 0.0000000 4 135 1260 9600 12225 user feedback\001 -4 0 -1 0 0 18 12 0.0000000 4 135 870 9750 11925 XMOSAIC\001 -4 0 -1 0 0 18 12 0.0000000 4 135 1305 7125 12225 documentation\001 -4 0 -1 0 0 18 12 0.0000000 4 135 870 7350 11925 XMOSAIC\001 -4 0 -1 0 0 18 12 0.0000000 4 135 540 9975 10125 NGEN\001 -4 0 -1 0 0 18 12 0.0000000 4 135 480 7575 11025 GIDS\001 -4 0 -1 0 0 18 12 0.0000000 4 180 1215 7200 11325 image display\001 -4 0 -1 0 0 18 12 0.0000000 4 135 765 9825 11025 PGPLOT\001 -4 0 -1 0 0 18 12 0.0000000 4 180 1545 9450 11325 graphics package\001 -4 0 -1 0 0 18 12 0.0000000 4 180 1725 9375 10395 general parameters\001 -4 0 -1 0 0 18 12 0.0000000 4 135 645 7500 10125 DWARF\001 --6 -1 1 0 1 -1 -1 0 0 -1 0.0000000 1 0.000 1500 8100 915 615 1500 8100 2400 8700 -1 1 0 1 -1 -1 0 0 -1 0.0000000 1 0.000 5100 8100 915 615 5100 8100 6000 8700 -1 1 0 1 -1 -1 0 0 -1 0.0000000 1 0.000 5100 5700 915 615 5100 5700 6000 6300 -1 2 0 1 -1 -1 0 0 -1 0.0000000 1 0.000 7650 3375 450 300 7200 3075 8100 3675 -1 2 0 1 -1 -1 0 0 -1 0.0000000 1 0.000 9750 4725 450 300 9300 4425 10200 5025 -1 2 0 1 -1 -1 0 0 -1 0.0000000 1 0.000 9750 5475 450 300 9300 5175 10200 5775 -1 2 0 1 -1 -1 0 0 -1 0.0000000 1 0.000 9750 6300 450 300 9300 6000 10200 6600 -1 2 0 1 -1 -1 0 0 -1 0.0000000 1 0.000 7650 2625 450 300 7200 2325 8100 2925 -2 2 0 1 -1 -1 0 0 -1 0.000 0 0 0 0 0 5 - 3900 8400 3900 7800 2700 7800 2700 8400 3900 8400 -2 2 0 1 -1 -1 0 0 -1 0.000 0 0 0 0 0 5 - 5700 7200 5700 6600 4500 6600 4500 7200 5700 7200 -2 2 0 1 -1 -1 0 0 -1 0.000 0 0 0 0 0 5 - 5700 9600 5700 9000 4500 9000 4500 9600 5700 9600 -2 2 0 1 -1 -1 0 0 -1 0.000 0 0 0 0 0 5 - 2100 6000 2100 5400 900 5400 900 6000 2100 6000 -2 2 0 1 -1 -1 0 0 -1 0.000 0 0 0 0 0 5 - 2100 3300 2100 2700 900 2700 900 3300 2100 3300 -2 2 0 1 -1 -1 0 0 -1 0.000 0 0 0 0 0 5 - 8700 6600 8700 6000 7500 6000 7500 6600 8700 6600 -2 2 0 1 -1 -1 0 0 -1 0.000 0 0 0 0 0 5 - 8700 9000 8700 8400 7500 8400 7500 9000 8700 9000 -2 2 0 1 -1 -1 0 0 -1 0.000 0 0 0 0 0 5 - 8700 7800 8700 7200 7500 7200 7500 7800 8700 7800 -2 2 0 1 -1 -1 0 0 -1 0.000 0 0 0 0 0 5 - 8700 5400 8700 4800 7500 4800 7500 5400 8700 5400 -2 2 0 1 -1 -1 0 0 -1 0.000 0 0 0 0 0 5 - 6600 3300 6600 2700 5400 2700 5400 3300 6600 3300 -2 2 0 1 -1 -1 0 0 -1 0.000 0 0 0 0 0 5 - 4800 3300 4800 2700 3600 2700 3600 3300 4800 3300 -2 2 0 1 -1 -1 0 0 -1 0.000 0 0 0 0 0 5 - 9900 3300 9900 2700 8700 2700 8700 3300 9900 3300 -2 1 0 1 -1 -1 0 0 -1 0.000 0 0 -1 1 1 2 - 0 0 1.00 75.00 135.00 - 0 0 1.00 75.00 135.00 - 4200 3300 4800 5100 -2 1 0 1 -1 -1 0 0 -1 0.000 0 0 -1 1 1 2 - 0 0 1.00 75.00 135.00 - 0 0 1.00 75.00 135.00 - 6000 3300 5400 5100 -2 1 0 1 -1 -1 0 0 -1 0.000 0 0 -1 1 1 2 - 0 0 1.00 75.00 135.00 - 0 0 1.00 75.00 135.00 - 6600 2850 7200 2700 -2 1 0 1 -1 -1 0 0 -1 0.000 0 0 -1 1 1 2 - 0 0 1.00 75.00 135.00 - 0 0 1.00 75.00 135.00 - 6600 3150 7200 3300 -2 1 0 1 -1 -1 0 0 -1 0.000 0 0 -1 1 1 2 - 0 0 1.00 75.00 135.00 - 0 0 1.00 75.00 135.00 - 3300 7800 4500 6150 -2 1 0 1 -1 -1 0 0 -1 0.000 0 0 -1 1 0 2 - 0 0 1.00 75.00 135.00 - 1500 3300 4500 5250 -2 1 0 1 -1 -1 0 0 -1 0.000 0 0 -1 1 1 2 - 0 0 1.00 75.00 135.00 - 0 0 1.00 75.00 135.00 - 2100 5700 4125 5700 -2 1 0 1 -1 -1 0 0 -1 0.000 0 0 -1 1 0 2 - 0 0 1.00 75.00 135.00 - 1500 7500 1500 6000 -2 1 0 1 -1 -1 0 0 -1 0.000 0 0 -1 1 0 2 - 0 0 1.00 75.00 135.00 - 2700 8100 2400 8100 -2 1 0 1 -1 -1 0 0 -1 0.000 0 0 -1 1 0 2 - 0 0 1.00 75.00 135.00 - 4125 8100 3900 8100 -2 1 0 1 -1 -1 0 0 -1 0.000 0 0 -1 1 0 2 - 0 0 1.00 75.00 135.00 - 5100 6300 5100 6600 -2 1 0 1 -1 -1 0 0 -1 0.000 0 0 -1 1 0 2 - 0 0 1.00 75.00 135.00 - 5100 7200 5100 7425 -2 1 0 1 -1 -1 0 0 -1 0.000 0 0 -1 1 1 2 - 0 0 1.00 75.00 135.00 - 0 0 1.00 75.00 135.00 - 5100 8700 5100 9000 -2 1 0 1 -1 -1 0 0 -1 0.000 0 0 -1 1 0 3 - 0 0 1.00 75.00 135.00 - 4500 9300 1500 9300 1500 8700 -2 1 0 1 -1 -1 0 0 -1 0.000 0 0 -1 1 0 2 - 0 0 1.00 75.00 135.00 - 5850 5400 7500 5100 -2 1 0 1 -1 -1 0 0 -1 0.000 0 0 -1 1 1 2 - 0 0 1.00 75.00 135.00 - 0 0 1.00 75.00 135.00 - 6000 5850 7425 6300 -2 1 0 1 -1 -1 0 0 -1 0.000 0 0 -1 1 0 2 - 0 0 1.00 75.00 135.00 - 5700 6150 7500 7350 -2 1 0 1 -1 -1 0 0 -1 0.000 0 0 -1 1 0 2 - 0 0 1.00 75.00 135.00 - 5925 7800 7500 7650 -2 1 0 1 -1 -1 0 0 -1 0.000 0 0 -1 1 0 2 - 0 0 1.00 75.00 135.00 - 5925 8400 7500 8700 -2 1 0 1 -1 -1 0 0 -1 0.000 0 0 -1 1 0 2 - 0 0 1.00 75.00 135.00 - 5700 5250 9300 3300 -2 1 0 1 -1 -1 0 0 -1 0.000 0 0 -1 1 0 2 - 0 0 1.00 75.00 135.00 - 8700 2850 8100 2700 -2 1 0 1 -1 -1 0 0 -1 0.000 0 0 -1 1 0 2 - 0 0 1.00 75.00 135.00 - 8700 3150 8100 3300 -2 1 0 1 -1 -1 0 0 -1 0.000 0 0 -1 1 0 2 - 0 0 1.00 75.00 135.00 - 8700 4950 9300 4800 -2 1 0 1 -1 -1 0 0 -1 0.000 0 0 -1 1 0 2 - 0 0 1.00 75.00 135.00 - 8700 5250 9300 5400 -2 1 0 1 -1 -1 0 0 -1 0.000 0 0 -1 1 0 2 - 0 0 1.00 75.00 135.00 - 8700 6300 9300 6300 -2 1 0 1 -1 -1 0 0 -1 0.000 0 0 -1 1 0 2 - 0 0 1.00 75.00 135.00 - 5700 6900 6075 7125 -2 1 0 1 -1 -1 0 0 -1 0.000 0 0 -1 1 0 2 - 0 0 1.00 75.00 135.00 - 8700 7500 9600 7500 -2 1 0 1 -1 -1 0 0 -1 0.000 0 0 -1 1 0 2 - 0 0 1.00 75.00 135.00 - 8700 8700 9600 8700 -2 1 0 1 -1 -1 0 0 -1 0.000 0 0 -1 1 0 2 - 0 0 1.00 75.00 135.00 - 1500 2400 1500 2700 -2 1 0 1 -1 -1 0 0 -1 0.000 0 0 -1 1 0 2 - 0 0 1.00 75.00 135.00 - 3900 2400 3900 2700 -2 1 0 1 -1 -1 0 0 -1 0.000 0 0 -1 1 0 2 - 0 0 1.00 75.00 135.00 - 4500 2700 4500 2400 -2 1 0 1 -1 -1 0 0 -1 0.000 0 0 -1 1 0 2 - 0 0 1.00 75.00 135.00 - 1500 5100 1500 5400 -4 0 -1 0 0 18 16 0.0000000 4 180 1005 7575 5175 NGCALC\001 -4 0 -1 0 0 18 16 0.0000000 4 180 765 7725 8775 NGIDS\001 -4 0 -1 0 0 18 16 0.0000000 4 180 765 8925 3075 NGIDS\001 -4 0 -1 0 0 18 16 0.0000000 4 180 780 1125 3075 NATNF\001 -4 0 -1 0 0 18 16 0.0000000 4 180 870 1050 5775 NCALIB\001 -4 0 -1 0 0 18 16 0.0000000 4 180 720 4725 6975 NMAP\001 -4 0 -1 0 0 18 16 0.0000000 4 180 390 7425 2700 FLF\001 -4 0 -1 0 0 18 16 0.0000000 4 180 420 9525 4800 NGI\001 -4 0 -1 0 0 18 16 0.0000000 4 180 870 3750 3075 NSCAN\001 -4 0 -1 0 0 18 16 0.0000000 4 180 780 5550 3075 NFLAG\001 -4 0 -1 0 0 18 16 0.0000000 4 180 630 7350 3450 ASCII\001 -4 0 -1 0 0 18 16 0.0000000 4 180 960 9300 5550 MONGO\001 -4 0 -1 0 0 18 16 0.0000000 4 180 525 9525 6375 SCN\001 -4 0 -1 0 0 18 16 0.0000000 4 180 885 7650 6225 NCOPY\001 -4 0 -1 0 0 18 16 0.0000000 4 180 915 7650 6510 NSIMUL\001 -4 0 -1 0 0 18 16 0.0000000 4 180 780 7650 7575 NPLOT\001 -4 0 -1 0 0 18 20 0.0000000 4 210 1275 4500 7950 WMP-file\001 -4 0 -1 0 0 18 20 0.0000000 4 210 1200 4500 5550 SCN-file\001 -4 0 -1 0 0 18 20 0.0000000 4 210 1200 900 7950 MDL-file\001 -4 0 -1 0 0 18 16 0.0000000 4 180 1020 2775 8175 NMODEL\001 -4 0 -1 0 0 18 16 0.0000000 4 180 960 4575 9375 NCLEAN\001 -4 0 -1 0 0 18 12 0.0000000 4 135 735 4725 5850 uv-data\001 -4 0 -1 0 0 18 12 0.0000000 4 135 870 4725 6120 uv-model\001 -4 0 -1 0 0 18 12 0.0000000 4 135 1185 825 8250 source model\001 -4 0 -1 0 0 18 12 0.0000000 4 180 1080 825 8520 components\001 -4 0 -1 0 0 18 12 0.0000000 4 180 630 4725 8250 images\001 -4 0 -1 0 0 18 12 0.0000000 4 180 435 4725 8520 a.p's\001 -4 0 -1 0 0 -1 12 0.0000000 4 135 645 4350 2250 UVFITS\001 -4 0 -1 0 0 -1 12 0.0000000 4 135 810 2400 6675 SELFCAL\001 -4 0 -1 0 0 -1 12 0.0000000 4 135 960 6225 4050 FLAGGING\001 -4 0 -1 0 0 -1 12 0.0000000 4 180 780 10425 6225 Secondary\001 -4 0 -1 0 0 -1 12 0.0000000 4 135 855 9825 8775 X-terminal\001 -4 0 -1 0 0 -1 12 0.0000000 4 135 1530 600 4875 Extarnal information\001 -4 0 -1 0 0 -1 12 0.0000000 4 135 495 1350 2250 ATCA\001 -4 0 -1 0 0 -1 12 0.0000000 4 135 510 3750 2250 WSRT\001 -4 0 -1 0 0 -1 12 0.0000000 4 135 390 6225 7275 FITS\001 -4 0 -1 0 0 -1 12 0.0000000 4 180 315 2550 6900 loop\001 -4 0 -1 0 0 -1 12 0.0000000 4 180 315 6375 4275 loop\001 -4 0 -1 0 0 -1 12 0.0000000 4 135 705 10425 6450 SCN-file\001 -4 0 -1 0 0 -1 12 0.0000000 4 135 510 9825 7425 Plotter\001 -4 0 -1 0 0 -1 12 0.0000000 4 135 855 9825 7650 X-terminal\001 -4 0 -1 0 0 4 12 0.0000000 0 180 2205 8400 13200 newstar_overview.fig 60%\001 diff --git a/src/doc/fig/nflag_flag.cap b/src/doc/fig/nflag_flag.cap deleted file mode 100644 index 632e0074e24e1997751542fb0e21e5de1243d9ec..0000000000000000000000000000000000000000 --- a/src/doc/fig/nflag_flag.cap +++ /dev/null @@ -1,22 +0,0 @@ -%nflag_flag.cap - -\begin{figure} -\fig{nflag_flag} -\caption{\it -\label{.nflag.flag} -% -Bird's eye view of the flagging branch of NFLAG, showing the four main branches -and their interconnections. Regular text represents manpulation of program -variables. Interactions with the user are shown in boldface; an arrow shows -parameter input into a program variable. -\\ -Full-drawn lines represent the main-branch connections, dashed lines the -detours from one main branch into another one; the user selects these routes -through the nparameter inputs shown. -\\ -Dotted lines represent the return paths that are selected through a QUIT input -in each of the branches. All returns are through label 101 in the top left; in -the case where the return is from a detour, control is returned to the branch -where the detour originated. -} -\end{figure} diff --git a/src/doc/fig/nflag_flag.fig b/src/doc/fig/nflag_flag.fig deleted file mode 100644 index e4f04516f53a854c5db89e295c262d58ae4531a3..0000000000000000000000000000000000000000 --- a/src/doc/fig/nflag_flag.fig +++ /dev/null @@ -1,180 +0,0 @@ -#FIG 3.1 -Portrait -Center -Inches -1200 2 -2 1 0 2 -1 7 0 0 -1 0.000 0 0 -1 0 0 2 - 19800 19500 21900 19500 -2 1 0 2 -1 7 0 0 -1 0.000 0 0 -1 0 0 2 - 19800 13200 21900 13200 -2 1 0 2 -1 7 0 0 -1 0.000 0 0 -1 1 0 4 - 0 0 2.00 120.00 240.00 - 9600 15600 12901 15601 14101 15601 14101 15901 -2 1 0 2 -1 7 0 0 -1 0.000 0 0 -1 1 0 5 - 0 0 2.00 120.00 240.00 - 9600 15900 10200 15900 10200 23100 14101 23101 14101 23401 -2 1 0 2 -1 7 0 0 -1 0.000 0 0 -1 1 0 5 - 0 0 2.00 120.00 240.00 - 9600 12000 10500 12000 10500 22800 14401 22801 14401 23401 -2 1 0 2 -1 7 0 0 -1 0.000 0 0 -1 1 0 5 - 0 0 2.00 120.00 240.00 - 9600 11400 12600 11400 12600 15300 14401 15301 14401 15901 -2 1 0 2 -1 7 0 0 -1 0.000 0 0 -1 1 0 5 - 0 0 2.00 120.00 240.00 - 9600 15300 12000 15300 12000 9300 14101 9301 14101 9601 -2 1 0 2 -1 7 0 0 -1 0.000 0 0 -1 1 0 5 - 0 0 2.00 120.00 240.00 - 9600 10800 11700 10800 11700 9000 14401 9001 14401 9601 -2 1 0 2 -1 7 0 0 -1 0.000 0 0 -1 1 0 4 - 0 0 2.00 120.00 240.00 - 14703 21603 13803 21603 13803 17103 14103 17103 -2 1 0 2 -1 7 0 0 -1 0.000 0 0 -1 1 0 4 - 0 0 2.00 120.00 240.00 - 14705 30005 13805 30005 13805 24605 14105 24605 -2 1 2 2 -1 7 0 0 -1 4.500 0 0 -1 1 0 5 - 0 0 2.00 120.00 240.00 - 9600 10200 10800 10200 10800 22500 14701 22501 14701 23401 -2 1 2 2 -1 7 0 0 -1 4.500 0 0 -1 0 0 2 - 19800 13500 22200 13500 -2 1 2 2 -1 7 0 0 -1 4.500 0 0 -1 0 0 2 - 19800 19800 22200 19800 -2 1 2 2 -1 7 0 0 -1 4.500 0 0 -1 1 0 5 - 0 0 2.00 120.00 240.00 - 9600 9600 11400 9600 11400 8700 14701 8701 14701 9601 -2 1 2 2 -1 7 0 0 -1 4.500 0 0 -1 1 0 5 - 0 0 2.00 120.00 240.00 - 9600 9900 12900 9900 12900 15000 14701 15001 14701 15901 -2 1 1 2 -1 7 0 0 -1 6.000 0 0 -1 0 0 3 - 19800 29400 21300 29400 21300 20400 -2 1 1 2 -1 7 0 0 -1 6.000 0 0 -1 1 0 5 - 0 0 2.00 120.00 240.00 - 19800 28800 21000 28800 21000 15000 15300 15000 15300 15900 -2 1 1 2 -1 7 0 0 -1 6.000 0 0 -1 1 0 5 - 0 0 2.00 120.00 240.00 - 19800 20400 21300 20400 21300 9000 15300 9000 15300 9600 -2 1 1 2 -1 7 0 0 -1 6.000 0 0 -1 1 0 5 - 0 0 2.00 120.00 240.00 - 19800 21000 20700 21000 20700 22500 15300 22500 15300 23400 -2 1 0 2 -1 7 0 0 -1 0.000 0 0 -1 1 0 6 - 0 0 2.00 120.00 240.00 - 19800 27600 21900 27600 21900 5400 3600 5400 3600 8400 3900 8400 -2 2 0 1 -1 7 0 0 -1 0.000 0 0 0 0 0 5 - 13503 15903 20103 15903 20103 21903 13503 21903 13503 15903 -2 2 0 1 -1 7 0 0 -1 0.000 0 0 0 0 0 5 - 13500 23400 20100 23400 20100 30300 13500 30300 13500 23400 -2 1 0 2 -1 7 0 0 -1 0.000 0 0 -1 1 0 2 - 0 0 2.00 120.00 240.00 - 7732 8328 8182 8328 -2 1 0 2 -1 7 0 0 -1 0.000 0 0 -1 1 0 2 - 0 0 2.00 120.00 240.00 - 8104 14629 8479 14629 -2 1 0 2 -1 7 0 0 -1 0.000 0 0 -1 1 0 2 - 0 0 2.00 120.00 240.00 - 17032 11329 17482 11329 -2 1 0 2 -1 7 0 0 -1 0.000 0 0 -1 1 0 2 - 0 0 2.00 120.00 240.00 - 17186 17630 17487 17630 -2 1 0 2 -1 7 0 0 -1 0.000 0 0 -1 1 0 2 - 0 0 2.00 120.00 240.00 - 17114 25132 17564 25132 -2 2 0 1 -1 7 0 0 -1 0.000 0 0 0 0 0 5 - 13500 9598 20098 9598 20098 14400 13500 14400 13500 9598 -2 1 0 2 -1 7 0 0 -1 0.000 0 0 -1 1 0 4 - 0 0 2.00 120.00 240.00 - 14700 14100 13800 14100 13800 10800 14100 10800 -2 1 2 2 -1 7 0 0 -1 4.500 0 0 -1 1 0 6 - 0 0 2.00 120.00 240.00 - 19800 28200 22200 28200 22200 5100 3300 5100 3300 9000 3900 9000 -2 2 0 1 -1 7 0 0 -1 0.000 0 0 0 0 0 5 - 3900 5700 9903 5700 9903 17403 3900 17403 3900 5700 -2 1 0 2 -1 7 0 0 -1 0.000 0 0 -1 1 0 4 - 0 0 2.00 120.00 240.00 - 5400 16800 4200 16800 4200 8400 4500 8400 -4 0 -1 0 0 1 20 0.0000000 0 135 480 15007 12007 OPER\001 -4 0 -1 0 0 1 20 0.0000000 0 135 1380 15306 12606 set UTILOPT = ' '\001 -4 0 -1 0 0 1 20 0.0000000 0 135 1425 15308 13208 OPTION =MODE\001 -4 0 -1 0 0 1 20 0.0000000 0 135 645 16508 13508 #MODE\001 -4 0 -1 0 0 1 20 0.0000000 0 135 1725 15007 10207 set UTILOPT= MODE\001 -4 0 -1 0 0 2 20 0.0000000 0 180 1155 15007 11407 FLAG_MODE\001 -4 0 -1 0 0 2 20 0.0000000 0 180 2685 15006 10806 display current status MODE_xxx\001 -4 0 -1 0 0 2 20 0.0000000 0 165 585 15907 12007 =QUIT\001 -4 0 -1 0 0 1 20 0.0000000 0 135 480 17704 11404 OPER\001 -4 0 -1 0 0 2 20 0.0000000 0 180 1155 15004 11404 FLAG_MODE\001 -4 0 -1 0 0 1 20 0.0000000 0 135 270 14409 17109 181\001 -4 0 -1 0 0 1 20 0.0000000 0 135 270 14409 18309 182\001 -4 0 -1 0 0 1 20 0.0000000 0 135 270 14407 16807 180\001 -4 0 -1 0 0 1 20 0.0000000 0 135 1380 15310 18910 set UTILOPT = ' '\001 -4 0 -1 0 0 1 20 0.0000000 0 135 1665 15011 17111 set UTILOPT = STAT\001 -4 0 -1 0 0 1 20 0.0000000 0 135 480 15011 18311 OPER\001 -4 0 -1 0 0 1 20 0.0000000 0 135 675 15310 19510 OPTION\001 -4 0 -1 0 0 1 20 0.0000000 0 135 555 16510 19510 =STAT\001 -4 0 -1 0 0 1 20 0.0000000 0 135 540 16510 19810 #STAT\001 -4 0 -1 0 0 1 20 0.0000000 0 135 480 15010 20410 OPER\001 -4 0 -1 0 0 1 20 0.0000000 0 135 480 15010 21010 OPER\001 -4 0 -1 0 0 2 20 0.0000000 0 180 1275 15011 17711 OPS_STATIST\001 -4 0 -1 0 0 2 20 0.0000000 0 165 585 15911 18311 =QUIT\001 -4 0 -1 0 0 1 20 0.0000000 0 135 480 17705 17705 OPER\001 -4 0 -1 0 0 2 20 0.0000000 0 135 960 15908 21008 = INSPECT\001 -4 0 -1 0 0 2 20 0.0000000 0 135 660 15908 20408 =MODE\001 -4 0 -1 0 0 1 20 0.0000000 0 135 675 16203 15903 OPTION\001 -4 0 -1 0 0 1 20 0.0000000 0 135 1110 17403 15903 =STATISTICS\001 -4 0 -1 0 0 3 20 0.0000000 0 180 1335 15003 21603 execution options\001 -4 0 -1 0 0 1 20 0.0000000 0 135 270 14408 24608 191\001 -4 0 -1 0 0 1 20 0.0000000 0 135 270 14408 24008 190\001 -4 0 -1 0 0 1 20 0.0000000 0 135 1380 15312 26412 set UTILOPT = ' '\001 -4 0 -1 0 0 1 20 0.0000000 0 135 1125 15312 27012 OPTION =INS\001 -4 0 -1 0 0 1 20 0.0000000 0 135 915 15612 27612 FLOPT = ""\001 -4 0 -1 0 0 1 20 0.0000000 0 135 480 15017 28817 OPER\001 -4 0 -1 0 0 2 20 0.0000000 0 180 1110 15013 24013 emit message\001 -4 0 -1 0 0 2 20 0.0000000 0 180 1260 15014 25214 OPS_INSPECT\001 -4 0 -1 0 0 2 20 0.0000000 0 135 1275 15917 28817 = STATISTICS\001 -4 0 -1 0 0 2 20 0.0000000 0 165 480 16209 25809 QUIT\001 -4 0 -1 0 0 1 20 0.0000000 0 135 630 15009 25809 OPER =\001 -4 0 -1 0 0 1 20 0.0000000 0 135 480 17707 25207 OPER\001 -4 0 -1 0 0 1 20 0.0000000 0 135 2085 15007 24607 set UTILOPT = 'INSPECT'\001 -4 0 -1 0 0 1 20 0.0000000 0 135 480 15006 29406 OPER\001 -4 0 -1 0 0 2 20 0.0000000 0 135 660 15906 29406 =MODE\001 -4 0 -1 0 0 1 20 0.0000000 0 135 1155 15312 28212 OPTION # INS\001 -4 0 -1 0 0 3 20 0.0000000 0 180 1335 15005 30005 execution options\001 -4 0 -1 0 0 1 20 0.0000000 0 135 1380 16200 9600 OPTION =MODE\001 -4 0 -1 0 0 1 20 0.0000000 0 135 735 5407 9607 UTILOPT\001 -4 0 -1 0 0 1 20 0.0000000 0 135 270 4807 8407 100\001 -4 0 -1 0 0 1 20 0.0000000 0 135 270 4807 9007 101\001 -4 0 -1 0 0 1 20 0.0000000 0 135 2250 5407 9007 set switches to default values\001 -4 0 -1 0 0 1 20 0.0000000 0 135 1050 6908 9908 =STA to 180\001 -4 0 -1 0 0 2 20 0.0000000 0 180 1335 5407 8407 FLAG_OPTION\001 -4 0 -1 0 0 1 20 0.0000000 0 135 675 8403 8403 OPTION\001 -4 0 -1 0 0 1 20 0.0000000 0 135 1050 6903 9603 =MOD to 120\001 -4 0 -1 0 0 1 20 0.0000000 0 135 1050 6903 10203 =INS to 190\001 -4 0 -1 0 0 1 20 0.0000000 0 135 675 5407 12607 OPTION\001 -4 0 -1 0 0 2 20 0.0000000 0 135 660 6605 12605 =FLIST\001 -4 0 -1 0 0 2 20 0.0000000 0 135 735 6605 12905 =FCOPY\001 -4 0 -1 0 0 2 20 0.0000000 0 135 930 6605 13205 =MANUAL\001 -4 0 -1 0 0 2 20 0.0000000 0 135 990 6605 13505 =HASCANS\001 -4 0 -1 0 0 2 20 0.0000000 0 135 915 6605 14105 =DETERM\001 -4 0 -1 0 0 1 20 0.0000000 0 135 675 5404 11404 OPTION\001 -4 0 -1 0 0 2 20 0.0000000 0 180 1455 5704 14704 OPS_<OPTION> \001 -4 0 -1 0 0 0 20 0.0000000 0 135 480 5704 15304 OPER\001 -4 0 -1 0 0 1 20 0.0000000 0 135 1110 6604 15604 =STATISTICS\001 -4 0 -1 0 0 1 20 0.0000000 0 135 480 8629 14704 OPER\001 -4 0 -1 0 0 2 20 0.0000000 0 135 1080 6605 13805 =CLIPDATA\001 -4 0 -1 0 0 1 20 0.0000000 0 135 855 6604 15904 =INSPECT\001 -4 0 -1 0 0 1 20 0.0000000 0 135 660 6604 15304 =MODE\001 -4 0 -1 0 0 2 20 0.0000000 0 135 420 6604 12004 =INS\001 -4 0 -1 0 0 2 20 0.0000000 0 135 480 6604 11404 =STA\001 -4 0 -1 0 0 1 20 0.0000000 0 135 675 5404 12004 OPTION\001 -4 0 -1 0 0 1 20 0.0000000 0 135 675 5403 10803 OPTION\001 -4 0 -1 0 0 2 20 0.0000000 0 135 660 6603 10803 =MODE\001 -4 0 -1 0 0 1 20 0.0000000 0 135 1620 16200 23400 OPTION = INSPECT\001 -4 0 -1 0 0 1 20 0.0000000 0 135 1335 5400 6300 set UTILOPT= ' '\001 -4 0 -1 0 0 2 20 0.0000000 0 180 1650 5104 6904 Define hypercube:\001 -4 0 -1 0 0 1 20 0.0000000 0 135 180 4804 6904 10\001 -4 0 -1 0 0 2 20 0.0000000 0 180 2055 5701 7201 SCN_NODE, SCN_SETS,\001 -4 0 -1 0 0 2 20 0.0000000 0 180 1815 5701 7501 SELECT_XYX. IFRS,\001 -4 0 -1 0 0 2 20 0.0000000 0 180 1035 5700 7800 HA_RANGE\001 -4 0 -1 0 0 3 20 0.0000000 0 180 1335 15000 14100 execution options\001 -4 0 -1 0 0 1 20 0.0000000 0 135 270 14407 10807 121\001 -4 0 -1 0 0 1 20 0.0000000 0 135 270 14407 11407 122\001 -4 0 -1 0 0 1 20 0.0000000 0 135 270 14408 10208 120\001 -4 0 -1 0 0 3 20 0.0000000 0 135 735 5700 16800 execution\001 -4 0 -1 0 0 1 10 0.0000000 0 150 1185 4200 29700 nflag_flag.fig 35%\001 diff --git a/src/doc/fig/nflag_gids.cap b/src/doc/fig/nflag_gids.cap deleted file mode 100644 index 8885ae0df954d6156aff7984045d32bde59f47bf..0000000000000000000000000000000000000000 --- a/src/doc/fig/nflag_gids.cap +++ /dev/null @@ -1,17 +0,0 @@ -%nflag_gids.cap - -\begin{figure} -\fig{nflag_gids} -\caption{\it -\label{.nflag.gids} -% -The use of a flag file to transfer flagging commands into NFLAG. -\\ -Flag files contain flagging commands that NFLAG can read and execute. Both a -compact binary form (the .FLF file) and a bulky text form are available. The -latter form can be edited manually. -\\ -Flag files may be generated by \whichref{NGIDS}{} and through commands in the -\whichref{FLIST}{} branch of NFLAG. -} -\end{figure} diff --git a/src/doc/fig/nflag_gids.fig b/src/doc/fig/nflag_gids.fig deleted file mode 100644 index a8755cd1990ebe4c34ad8f17c5d2bd51d8173be9..0000000000000000000000000000000000000000 --- a/src/doc/fig/nflag_gids.fig +++ /dev/null @@ -1,86 +0,0 @@ -#FIG 3.1 -Portrait -Center -Inches -1200 2 -6 3899 5399 4799 6599 -2 4 0 2 -1 7 0 0 -1 0.000 0 0 15 0 0 5 - 4500 6300 4500 5400 3900 5400 3900 6300 4500 6300 -2 2 0 2 -1 7 0 0 -1 0.000 0 0 0 0 0 5 - 3976 5551 4426 5551 4426 5851 3976 5851 3976 5551 -2 1 0 2 -1 7 0 0 -1 0.000 0 0 -1 0 0 2 - 4126 5551 4126 5851 -2 1 0 2 -1 7 0 0 -1 0.000 0 0 -1 0 0 2 - 4276 5551 4276 5851 --6 -6 4199 2099 6599 4199 -2 4 0 2 -1 7 0 0 -1 0.000 0 0 15 0 0 5 - 6300 3900 6300 2400 4500 2400 4500 3900 6300 3900 -2 1 0 2 -1 7 0 0 -1 0.000 0 0 -1 0 0 2 - 4950 3000 5250 3000 -2 1 0 2 -1 7 0 0 -1 0.000 0 0 -1 0 0 2 - 5100 2850 5100 3150 -2 2 0 2 -1 7 0 0 -1 0.000 0 0 0 0 0 5 - 4350 2250 6450 2250 6450 4050 4350 4050 4350 2250 --6 -6 9300 3300 11400 5100 -2 2 0 2 -1 7 0 0 -1 0.000 0 0 0 0 0 5 - 9301 3301 11101 3301 11101 4501 9301 4501 9301 3301 -4 0 -1 0 0 2 20 0.0000000 0 180 495 9601 3601 binary\001 -4 0 -1 0 0 2 20 0.0000000 0 180 615 9601 3901 flagging\001 -4 0 -1 0 0 2 20 0.0000000 0 135 840 9601 4201 commands\001 -4 0 -1 0 0 2 20 0.0000000 0 135 720 9526 4801 .FLF file\001 --6 -6 9000 5700 11700 9300 -2 2 0 2 -1 7 0 0 -1 0.000 0 0 0 0 0 5 - 9001 5701 11401 5701 11401 8701 9001 8701 9001 5701 -4 0 -1 0 0 2 20 0.0000000 0 135 510 9601 6301 ASCII\001 -4 0 -1 0 0 2 20 0.0000000 0 180 615 9601 6601 flagging\001 -4 0 -1 0 0 2 20 0.0000000 0 135 840 9601 6901 commands\001 -4 0 -1 0 0 2 20 0.0000000 0 135 1305 9226 9001 user-named file\001 --6 -6 5400 8100 7500 9300 -2 2 0 2 -1 7 0 0 -1 0.000 0 0 0 0 0 5 - 5551 8101 7351 8101 7351 9001 5551 9001 5551 8101 -4 0 -1 0 0 2 20 0.0000000 0 135 840 5851 8701 text editor\001 --6 -2 2 0 2 -1 7 0 0 -1 0.000 0 0 0 0 0 5 - 5700 5400 7200 5400 7200 6300 5700 6300 5700 5400 -2 1 0 2 -1 7 0 0 -1 0.000 0 0 -1 0 0 2 - 5700 4050 6450 5400 -2 1 0 2 -1 7 0 0 -1 0.000 0 0 -1 1 0 2 - 0 0 2.00 120.00 240.00 - 7200 5700 9300 4200 -2 2 0 2 -1 7 0 0 -1 0.000 0 0 0 0 0 5 - 16500 5400 18000 5400 18000 6600 16500 6600 16500 5400 -2 1 0 2 -1 7 0 0 -1 0.000 0 0 -1 1 1 2 - 0 0 2.00 120.00 240.00 - 0 0 2.00 120.00 240.00 - 11100 4200 13200 5700 -2 1 0 2 -1 7 0 0 -1 0.000 0 0 -1 1 1 2 - 0 0 2.00 120.00 240.00 - 0 0 2.00 120.00 240.00 - 11400 7200 13200 6000 -2 1 0 2 -1 7 0 0 -1 0.000 0 0 -1 1 0 2 - 0 0 2.00 120.00 240.00 - 15000 5850 16500 5850 -2 2 0 1 -1 7 1 0 19 0.000 0 0 0 0 0 5 - 4650 2550 6150 2550 6150 3750 4650 3750 4650 2550 -2 2 0 2 -1 7 0 0 -1 0.000 0 0 0 0 0 5 - 13200 5400 15000 5400 15000 7200 13200 7200 13200 5400 -2 1 0 2 -1 7 0 0 -1 0.000 0 0 -1 1 0 2 - 0 0 2.00 120.00 240.00 - 7200 6000 9000 7200 -2 1 0 2 -1 7 0 0 -1 0.000 0 0 -1 1 0 2 - 0 0 2.00 120.00 240.00 - 7350 8550 9000 8100 -3 0 0 2 -1 7 0 0 -1 0.000 0 0 0 7 - 4200 5400 4275 4950 4800 4950 5175 5250 5475 4875 5025 4500 - 5100 4050 -4 0 -1 0 0 2 20 0.0000000 0 135 585 6000 6000 NGIDS\001 -4 0 -1 0 0 2 20 0.0000000 0 135 645 13500 6000 NFLAG\001 -4 0 -1 0 0 2 20 0.0000000 0 135 720 16800 6000 .SCN file\001 -4 0 -1 0 0 2 20 0.0000000 0 120 645 13500 6300 execute\001 -4 0 -1 0 0 2 20 0.0000000 0 180 615 13500 6600 flagging\001 -4 0 -1 0 0 2 20 0.0000000 0 135 840 13500 6900 commands\001 -4 0 -1 0 0 1 10 0.0000000 0 150 1185 13800 9000 nflag_gids.fig 50%\001 diff --git a/src/doc/fig/nflag_inspect.cap b/src/doc/fig/nflag_inspect.cap deleted file mode 100644 index 484553fe24c9b8363b725de2678c1d3aa57c53c5..0000000000000000000000000000000000000000 --- a/src/doc/fig/nflag_inspect.cap +++ /dev/null @@ -1,15 +0,0 @@ -%nflag_inspect.cap - -\begin{figure} -\fig{nflag_inspect} -\caption{\it -\label{.nflag.inspect} -% -Schematic of the INSPECT branch of NFLAG. -\\ -By default NFLAG executes a COUNT operation at the end of each -\whichref{flagging operation}{}. The COUNT option is provided mainly for -convenience, but must be executed if you want to display flagging statistics -before doing anything else. -} -\end{figure} diff --git a/src/doc/fig/nflag_inspect.fig b/src/doc/fig/nflag_inspect.fig deleted file mode 100644 index 27f3238da73b3b468c58aaa49b9a5719358ec533..0000000000000000000000000000000000000000 --- a/src/doc/fig/nflag_inspect.fig +++ /dev/null @@ -1,70 +0,0 @@ -#FIG 3.1 -Portrait -Center -Inches -1200 2 -6 2400 3300 12600 7500 -2 1 1 2 -1 7 0 0 20 6.000 0 0 -1 0 0 2 - 2401 3901 10201 3901 -2 1 1 2 -1 7 0 0 20 6.000 0 0 -1 0 0 2 - 5701 3901 5701 4201 -2 1 1 2 -1 7 0 0 20 6.000 0 0 -1 0 0 2 - 3601 3901 3601 4201 -2 1 1 2 -1 7 0 0 20 6.000 0 0 -1 0 0 2 - 10201 3901 10201 4201 -2 1 1 2 -1 7 0 0 20 6.000 0 0 -1 0 0 2 - 8101 3901 8101 4201 -2 1 1 1 -1 7 0 0 -1 4.000 0 0 -1 0 0 1 - 5101 4201 -2 1 1 1 -1 7 0 0 -1 4.000 0 0 -1 0 0 2 - 5101 4201 5101 7201 -2 1 1 1 -1 7 0 0 -1 4.000 0 0 -1 0 0 2 - 7501 4201 7501 7201 -2 1 1 1 -1 7 0 0 -1 4.000 0 0 -1 0 0 2 - 9601 4201 9601 7201 -2 1 1 1 -1 7 0 0 -1 4.000 0 0 -1 0 0 2 - 3001 4201 3001 7201 -2 1 1 1 -1 7 0 0 -1 4.000 0 0 -1 0 0 2 - 12301 4201 12301 7201 -4 0 -1 0 0 1 20 0.0000000 0 255 1680 3301 4501 FTYP_<mod>\001 -4 0 -1 0 0 1 20 0.0000000 0 255 1380 5401 4501 HA_<mod>\001 -4 0 -1 0 0 1 20 0.0000000 0 255 1695 2701 3601 Display counts\001 -4 0 -1 0 0 1 20 0.0000000 0 255 1455 3301 4801 Per flag type\001 -4 0 -1 0 0 1 20 0.0000000 0 255 1695 5401 4801 Per hour angle\001 -4 0 -1 0 0 1 20 0.0000000 0 255 1485 7801 4801 Per telescope\001 -4 0 -1 0 0 1 20 0.0000000 0 195 2115 9901 4801 Per interferometer\001 -4 0 -1 0 0 1 20 0.0000000 0 255 1410 9901 4501 IFR_<mod>\001 -4 0 -1 0 0 1 20 0.0000000 0 255 1500 7801 4501 TEL_<mod>\001 -4 0 -1 0 0 1 20 0.0000000 0 195 7005 3901 5401 <mod> indicates a limitation to certain subsets of the counts:\001 -4 0 -1 0 0 1 20 0.0000000 0 255 1455 4201 5701 _<flag type>\001 -4 0 -1 0 0 1 20 0.0000000 0 255 1920 4201 6001 _<polarisations>\001 -4 0 -1 0 0 1 20 0.0000000 0 255 3720 6301 6001 = X (XX alone), Y (YY alone),\001 -4 0 -1 0 0 1 20 0.0000000 0 255 4440 6601 6301 XY (XX and YY), YX (XY and YX)\001 -4 0 -1 0 0 1 20 0.0000000 0 255 2220 4201 6601 _<interferometers>\001 -4 0 -1 0 0 1 20 0.0000000 0 255 1590 4201 6901 _<telescopes>\001 --6 -6 2400 7800 6300 11700 -6 3303 9903 6003 11403 -4 0 -1 0 0 2 20 0.0000000 0 255 1950 3607 10807 SELECT_IFRS\001 -4 0 -1 0 0 2 20 0.0000000 0 255 1620 3607 10507 HA_RANGE\001 -4 0 -1 0 0 2 20 0.0000000 0 255 1920 3607 11107 SELECT_XYX\001 -4 0 -1 0 0 2 20 0.0000000 0 255 2550 3307 10207 Secondary hypercube\001 --6 -2 1 1 2 -1 7 0 0 -1 6.000 0 0 -1 0 0 1 - 3601 8401 -2 1 1 2 -1 7 0 0 -1 6.000 0 0 -1 0 0 2 - 3602 8402 3602 8702 -2 1 1 1 -1 7 0 0 -1 4.000 0 0 -1 0 0 2 - 6002 8702 6002 11402 -2 1 1 1 -1 7 0 0 -1 4.000 0 0 -1 0 0 2 - 3002 8702 3002 11402 -2 1 1 2 -1 7 0 0 -1 6.000 0 0 -1 0 0 2 - 2402 8402 3601 8401 -4 0 -1 0 0 2 20 0.0000000 0 255 2100 3303 9603 SELECT_FLAG\001 -4 0 -1 0 0 1 20 0.0000000 0 195 1005 3302 9002 COUNT\001 -4 0 -1 0 0 1 20 0.0000000 0 255 2250 2702 8102 Count current flags\001 --6 -2 1 1 2 -1 7 0 0 -1 6.000 0 0 -1 0 0 2 - 2400 3000 2400 8400 -4 0 -1 0 0 2 20 0.0000000 0 255 1965 2100 2700 OPS_INSPECT\001 -4 0 -1 0 0 1 10 0.0000000 0 150 1365 9000 2700 nflag_inspect.fig 50%\001 diff --git a/src/doc/fig/nflag_interface.cap b/src/doc/fig/nflag_interface.cap deleted file mode 100644 index 5a4c1d8f8ece3fcfe39cbe78af00083b8c90d62f..0000000000000000000000000000000000000000 --- a/src/doc/fig/nflag_interface.cap +++ /dev/null @@ -1,11 +0,0 @@ -%nflag_interface.tex -\begin{figure}[b] - -%\fig{nflag_interface} -% -\caption{\it -Overview of the actions in NFLAG. -} - -\label{.nflag.interface} -\end{figure} diff --git a/src/doc/fig/nflag_mode.fig b/src/doc/fig/nflag_mode.fig deleted file mode 100644 index e4f04516f53a854c5db89e295c262d58ae4531a3..0000000000000000000000000000000000000000 --- a/src/doc/fig/nflag_mode.fig +++ /dev/null @@ -1,180 +0,0 @@ -#FIG 3.1 -Portrait -Center -Inches -1200 2 -2 1 0 2 -1 7 0 0 -1 0.000 0 0 -1 0 0 2 - 19800 19500 21900 19500 -2 1 0 2 -1 7 0 0 -1 0.000 0 0 -1 0 0 2 - 19800 13200 21900 13200 -2 1 0 2 -1 7 0 0 -1 0.000 0 0 -1 1 0 4 - 0 0 2.00 120.00 240.00 - 9600 15600 12901 15601 14101 15601 14101 15901 -2 1 0 2 -1 7 0 0 -1 0.000 0 0 -1 1 0 5 - 0 0 2.00 120.00 240.00 - 9600 15900 10200 15900 10200 23100 14101 23101 14101 23401 -2 1 0 2 -1 7 0 0 -1 0.000 0 0 -1 1 0 5 - 0 0 2.00 120.00 240.00 - 9600 12000 10500 12000 10500 22800 14401 22801 14401 23401 -2 1 0 2 -1 7 0 0 -1 0.000 0 0 -1 1 0 5 - 0 0 2.00 120.00 240.00 - 9600 11400 12600 11400 12600 15300 14401 15301 14401 15901 -2 1 0 2 -1 7 0 0 -1 0.000 0 0 -1 1 0 5 - 0 0 2.00 120.00 240.00 - 9600 15300 12000 15300 12000 9300 14101 9301 14101 9601 -2 1 0 2 -1 7 0 0 -1 0.000 0 0 -1 1 0 5 - 0 0 2.00 120.00 240.00 - 9600 10800 11700 10800 11700 9000 14401 9001 14401 9601 -2 1 0 2 -1 7 0 0 -1 0.000 0 0 -1 1 0 4 - 0 0 2.00 120.00 240.00 - 14703 21603 13803 21603 13803 17103 14103 17103 -2 1 0 2 -1 7 0 0 -1 0.000 0 0 -1 1 0 4 - 0 0 2.00 120.00 240.00 - 14705 30005 13805 30005 13805 24605 14105 24605 -2 1 2 2 -1 7 0 0 -1 4.500 0 0 -1 1 0 5 - 0 0 2.00 120.00 240.00 - 9600 10200 10800 10200 10800 22500 14701 22501 14701 23401 -2 1 2 2 -1 7 0 0 -1 4.500 0 0 -1 0 0 2 - 19800 13500 22200 13500 -2 1 2 2 -1 7 0 0 -1 4.500 0 0 -1 0 0 2 - 19800 19800 22200 19800 -2 1 2 2 -1 7 0 0 -1 4.500 0 0 -1 1 0 5 - 0 0 2.00 120.00 240.00 - 9600 9600 11400 9600 11400 8700 14701 8701 14701 9601 -2 1 2 2 -1 7 0 0 -1 4.500 0 0 -1 1 0 5 - 0 0 2.00 120.00 240.00 - 9600 9900 12900 9900 12900 15000 14701 15001 14701 15901 -2 1 1 2 -1 7 0 0 -1 6.000 0 0 -1 0 0 3 - 19800 29400 21300 29400 21300 20400 -2 1 1 2 -1 7 0 0 -1 6.000 0 0 -1 1 0 5 - 0 0 2.00 120.00 240.00 - 19800 28800 21000 28800 21000 15000 15300 15000 15300 15900 -2 1 1 2 -1 7 0 0 -1 6.000 0 0 -1 1 0 5 - 0 0 2.00 120.00 240.00 - 19800 20400 21300 20400 21300 9000 15300 9000 15300 9600 -2 1 1 2 -1 7 0 0 -1 6.000 0 0 -1 1 0 5 - 0 0 2.00 120.00 240.00 - 19800 21000 20700 21000 20700 22500 15300 22500 15300 23400 -2 1 0 2 -1 7 0 0 -1 0.000 0 0 -1 1 0 6 - 0 0 2.00 120.00 240.00 - 19800 27600 21900 27600 21900 5400 3600 5400 3600 8400 3900 8400 -2 2 0 1 -1 7 0 0 -1 0.000 0 0 0 0 0 5 - 13503 15903 20103 15903 20103 21903 13503 21903 13503 15903 -2 2 0 1 -1 7 0 0 -1 0.000 0 0 0 0 0 5 - 13500 23400 20100 23400 20100 30300 13500 30300 13500 23400 -2 1 0 2 -1 7 0 0 -1 0.000 0 0 -1 1 0 2 - 0 0 2.00 120.00 240.00 - 7732 8328 8182 8328 -2 1 0 2 -1 7 0 0 -1 0.000 0 0 -1 1 0 2 - 0 0 2.00 120.00 240.00 - 8104 14629 8479 14629 -2 1 0 2 -1 7 0 0 -1 0.000 0 0 -1 1 0 2 - 0 0 2.00 120.00 240.00 - 17032 11329 17482 11329 -2 1 0 2 -1 7 0 0 -1 0.000 0 0 -1 1 0 2 - 0 0 2.00 120.00 240.00 - 17186 17630 17487 17630 -2 1 0 2 -1 7 0 0 -1 0.000 0 0 -1 1 0 2 - 0 0 2.00 120.00 240.00 - 17114 25132 17564 25132 -2 2 0 1 -1 7 0 0 -1 0.000 0 0 0 0 0 5 - 13500 9598 20098 9598 20098 14400 13500 14400 13500 9598 -2 1 0 2 -1 7 0 0 -1 0.000 0 0 -1 1 0 4 - 0 0 2.00 120.00 240.00 - 14700 14100 13800 14100 13800 10800 14100 10800 -2 1 2 2 -1 7 0 0 -1 4.500 0 0 -1 1 0 6 - 0 0 2.00 120.00 240.00 - 19800 28200 22200 28200 22200 5100 3300 5100 3300 9000 3900 9000 -2 2 0 1 -1 7 0 0 -1 0.000 0 0 0 0 0 5 - 3900 5700 9903 5700 9903 17403 3900 17403 3900 5700 -2 1 0 2 -1 7 0 0 -1 0.000 0 0 -1 1 0 4 - 0 0 2.00 120.00 240.00 - 5400 16800 4200 16800 4200 8400 4500 8400 -4 0 -1 0 0 1 20 0.0000000 0 135 480 15007 12007 OPER\001 -4 0 -1 0 0 1 20 0.0000000 0 135 1380 15306 12606 set UTILOPT = ' '\001 -4 0 -1 0 0 1 20 0.0000000 0 135 1425 15308 13208 OPTION =MODE\001 -4 0 -1 0 0 1 20 0.0000000 0 135 645 16508 13508 #MODE\001 -4 0 -1 0 0 1 20 0.0000000 0 135 1725 15007 10207 set UTILOPT= MODE\001 -4 0 -1 0 0 2 20 0.0000000 0 180 1155 15007 11407 FLAG_MODE\001 -4 0 -1 0 0 2 20 0.0000000 0 180 2685 15006 10806 display current status MODE_xxx\001 -4 0 -1 0 0 2 20 0.0000000 0 165 585 15907 12007 =QUIT\001 -4 0 -1 0 0 1 20 0.0000000 0 135 480 17704 11404 OPER\001 -4 0 -1 0 0 2 20 0.0000000 0 180 1155 15004 11404 FLAG_MODE\001 -4 0 -1 0 0 1 20 0.0000000 0 135 270 14409 17109 181\001 -4 0 -1 0 0 1 20 0.0000000 0 135 270 14409 18309 182\001 -4 0 -1 0 0 1 20 0.0000000 0 135 270 14407 16807 180\001 -4 0 -1 0 0 1 20 0.0000000 0 135 1380 15310 18910 set UTILOPT = ' '\001 -4 0 -1 0 0 1 20 0.0000000 0 135 1665 15011 17111 set UTILOPT = STAT\001 -4 0 -1 0 0 1 20 0.0000000 0 135 480 15011 18311 OPER\001 -4 0 -1 0 0 1 20 0.0000000 0 135 675 15310 19510 OPTION\001 -4 0 -1 0 0 1 20 0.0000000 0 135 555 16510 19510 =STAT\001 -4 0 -1 0 0 1 20 0.0000000 0 135 540 16510 19810 #STAT\001 -4 0 -1 0 0 1 20 0.0000000 0 135 480 15010 20410 OPER\001 -4 0 -1 0 0 1 20 0.0000000 0 135 480 15010 21010 OPER\001 -4 0 -1 0 0 2 20 0.0000000 0 180 1275 15011 17711 OPS_STATIST\001 -4 0 -1 0 0 2 20 0.0000000 0 165 585 15911 18311 =QUIT\001 -4 0 -1 0 0 1 20 0.0000000 0 135 480 17705 17705 OPER\001 -4 0 -1 0 0 2 20 0.0000000 0 135 960 15908 21008 = INSPECT\001 -4 0 -1 0 0 2 20 0.0000000 0 135 660 15908 20408 =MODE\001 -4 0 -1 0 0 1 20 0.0000000 0 135 675 16203 15903 OPTION\001 -4 0 -1 0 0 1 20 0.0000000 0 135 1110 17403 15903 =STATISTICS\001 -4 0 -1 0 0 3 20 0.0000000 0 180 1335 15003 21603 execution options\001 -4 0 -1 0 0 1 20 0.0000000 0 135 270 14408 24608 191\001 -4 0 -1 0 0 1 20 0.0000000 0 135 270 14408 24008 190\001 -4 0 -1 0 0 1 20 0.0000000 0 135 1380 15312 26412 set UTILOPT = ' '\001 -4 0 -1 0 0 1 20 0.0000000 0 135 1125 15312 27012 OPTION =INS\001 -4 0 -1 0 0 1 20 0.0000000 0 135 915 15612 27612 FLOPT = ""\001 -4 0 -1 0 0 1 20 0.0000000 0 135 480 15017 28817 OPER\001 -4 0 -1 0 0 2 20 0.0000000 0 180 1110 15013 24013 emit message\001 -4 0 -1 0 0 2 20 0.0000000 0 180 1260 15014 25214 OPS_INSPECT\001 -4 0 -1 0 0 2 20 0.0000000 0 135 1275 15917 28817 = STATISTICS\001 -4 0 -1 0 0 2 20 0.0000000 0 165 480 16209 25809 QUIT\001 -4 0 -1 0 0 1 20 0.0000000 0 135 630 15009 25809 OPER =\001 -4 0 -1 0 0 1 20 0.0000000 0 135 480 17707 25207 OPER\001 -4 0 -1 0 0 1 20 0.0000000 0 135 2085 15007 24607 set UTILOPT = 'INSPECT'\001 -4 0 -1 0 0 1 20 0.0000000 0 135 480 15006 29406 OPER\001 -4 0 -1 0 0 2 20 0.0000000 0 135 660 15906 29406 =MODE\001 -4 0 -1 0 0 1 20 0.0000000 0 135 1155 15312 28212 OPTION # INS\001 -4 0 -1 0 0 3 20 0.0000000 0 180 1335 15005 30005 execution options\001 -4 0 -1 0 0 1 20 0.0000000 0 135 1380 16200 9600 OPTION =MODE\001 -4 0 -1 0 0 1 20 0.0000000 0 135 735 5407 9607 UTILOPT\001 -4 0 -1 0 0 1 20 0.0000000 0 135 270 4807 8407 100\001 -4 0 -1 0 0 1 20 0.0000000 0 135 270 4807 9007 101\001 -4 0 -1 0 0 1 20 0.0000000 0 135 2250 5407 9007 set switches to default values\001 -4 0 -1 0 0 1 20 0.0000000 0 135 1050 6908 9908 =STA to 180\001 -4 0 -1 0 0 2 20 0.0000000 0 180 1335 5407 8407 FLAG_OPTION\001 -4 0 -1 0 0 1 20 0.0000000 0 135 675 8403 8403 OPTION\001 -4 0 -1 0 0 1 20 0.0000000 0 135 1050 6903 9603 =MOD to 120\001 -4 0 -1 0 0 1 20 0.0000000 0 135 1050 6903 10203 =INS to 190\001 -4 0 -1 0 0 1 20 0.0000000 0 135 675 5407 12607 OPTION\001 -4 0 -1 0 0 2 20 0.0000000 0 135 660 6605 12605 =FLIST\001 -4 0 -1 0 0 2 20 0.0000000 0 135 735 6605 12905 =FCOPY\001 -4 0 -1 0 0 2 20 0.0000000 0 135 930 6605 13205 =MANUAL\001 -4 0 -1 0 0 2 20 0.0000000 0 135 990 6605 13505 =HASCANS\001 -4 0 -1 0 0 2 20 0.0000000 0 135 915 6605 14105 =DETERM\001 -4 0 -1 0 0 1 20 0.0000000 0 135 675 5404 11404 OPTION\001 -4 0 -1 0 0 2 20 0.0000000 0 180 1455 5704 14704 OPS_<OPTION> \001 -4 0 -1 0 0 0 20 0.0000000 0 135 480 5704 15304 OPER\001 -4 0 -1 0 0 1 20 0.0000000 0 135 1110 6604 15604 =STATISTICS\001 -4 0 -1 0 0 1 20 0.0000000 0 135 480 8629 14704 OPER\001 -4 0 -1 0 0 2 20 0.0000000 0 135 1080 6605 13805 =CLIPDATA\001 -4 0 -1 0 0 1 20 0.0000000 0 135 855 6604 15904 =INSPECT\001 -4 0 -1 0 0 1 20 0.0000000 0 135 660 6604 15304 =MODE\001 -4 0 -1 0 0 2 20 0.0000000 0 135 420 6604 12004 =INS\001 -4 0 -1 0 0 2 20 0.0000000 0 135 480 6604 11404 =STA\001 -4 0 -1 0 0 1 20 0.0000000 0 135 675 5404 12004 OPTION\001 -4 0 -1 0 0 1 20 0.0000000 0 135 675 5403 10803 OPTION\001 -4 0 -1 0 0 2 20 0.0000000 0 135 660 6603 10803 =MODE\001 -4 0 -1 0 0 1 20 0.0000000 0 135 1620 16200 23400 OPTION = INSPECT\001 -4 0 -1 0 0 1 20 0.0000000 0 135 1335 5400 6300 set UTILOPT= ' '\001 -4 0 -1 0 0 2 20 0.0000000 0 180 1650 5104 6904 Define hypercube:\001 -4 0 -1 0 0 1 20 0.0000000 0 135 180 4804 6904 10\001 -4 0 -1 0 0 2 20 0.0000000 0 180 2055 5701 7201 SCN_NODE, SCN_SETS,\001 -4 0 -1 0 0 2 20 0.0000000 0 180 1815 5701 7501 SELECT_XYX. IFRS,\001 -4 0 -1 0 0 2 20 0.0000000 0 180 1035 5700 7800 HA_RANGE\001 -4 0 -1 0 0 3 20 0.0000000 0 180 1335 15000 14100 execution options\001 -4 0 -1 0 0 1 20 0.0000000 0 135 270 14407 10807 121\001 -4 0 -1 0 0 1 20 0.0000000 0 135 270 14407 11407 122\001 -4 0 -1 0 0 1 20 0.0000000 0 135 270 14408 10208 120\001 -4 0 -1 0 0 3 20 0.0000000 0 135 735 5700 16800 execution\001 -4 0 -1 0 0 1 10 0.0000000 0 150 1185 4200 29700 nflag_flag.fig 35%\001 diff --git a/src/doc/fig/nflag_operate.cap b/src/doc/fig/nflag_operate.cap deleted file mode 100644 index 47d24226694c56774578b198f101f990afb60362..0000000000000000000000000000000000000000 --- a/src/doc/fig/nflag_operate.cap +++ /dev/null @@ -1,13 +0,0 @@ -%nflag_operate.cap - -\begin{figure} -\fig{nflag_operate} -\caption{\it -\label{.nflag.operate} -% -Schematic of the operations branch of NFLAG. -\\ -This branch contains options to set visibility or scan-header flags on the -basis of a variety of criteria. See text for a description. -} -\end{figure} diff --git a/src/doc/fig/nflag_operate.fig b/src/doc/fig/nflag_operate.fig deleted file mode 100644 index 03aa54a396c023e7d5480c99601d08f804b481b4..0000000000000000000000000000000000000000 --- a/src/doc/fig/nflag_operate.fig +++ /dev/null @@ -1,217 +0,0 @@ -#FIG 3.1 -Portrait -Center -Inches -1200 2 -6 2401 3301 15601 6601 -2 1 1 2 -1 7 0 0 -1 6.000 0 0 -1 0 0 3 - 3603 4503 3603 4803 14403 4803 -2 1 1 2 -1 7 0 0 -1 6.000 0 0 -1 0 0 2 - 14403 4803 14403 5103 -2 1 1 2 -1 7 0 0 -1 6.000 0 0 -1 0 0 2 - 12603 4803 12603 5103 -2 1 1 2 -1 7 0 0 -1 6.000 0 0 -1 0 0 2 - 9303 4803 9303 5103 -2 1 1 2 -1 7 0 0 -1 6.000 0 0 -1 0 0 2 - 6903 4803 6903 5103 -2 1 1 2 -1 7 0 0 -1 6.000 0 0 -1 0 0 2 - 4203 4803 4203 5103 -2 1 1 1 -1 7 0 0 -1 4.000 0 0 -1 0 0 2 - 6303 5103 6303 6303 -2 1 1 1 -1 7 0 0 -1 4.000 0 0 -1 0 0 2 - 8703 5103 8703 6303 -2 1 1 1 -1 7 0 0 -1 4.000 0 0 -1 0 0 2 - 12003 5103 12003 6303 -2 1 1 1 -1 7 0 0 -1 4.000 0 0 -1 0 0 2 - 13803 5103 13803 6303 -2 1 1 2 -1 7 0 0 -1 6.000 0 0 -1 0 0 2 - 3002 3602 2402 3602 -4 0 -1 0 0 2 20 0.0000000 0 255 1980 3303 4203 OPS_DETERM\001 -4 0 -1 0 0 1 20 0.0000000 0 195 795 3903 5403 SHAD\001 -4 0 -1 0 0 1 20 0.0000000 0 195 735 6603 5403 PBAS\001 -4 0 -1 0 0 1 20 0.0000000 0 195 1650 9003 5403 ELEVATION\001 -4 0 -1 0 0 1 20 0.0000000 0 195 1005 12303 5403 REDUN\001 -4 0 -1 0 0 1 20 0.0000000 0 195 1215 14103 5403 NONRED\001 -4 0 -1 0 0 2 20 0.0000000 0 255 2250 3903 6003 SHADOW_DIAM\001 -4 0 -1 0 0 2 20 0.0000000 0 255 1920 6603 6003 PBAS_LIMITS\001 -4 0 -1 0 0 2 20 0.0000000 0 255 2745 9003 6003 ELEVATION_LIMIT\001 -4 0 -1 0 0 1 20 0.0000000 0 195 1200 3302 3602 DETERM\001 --6 -6 3900 14100 6300 15900 -4 0 -1 0 0 2 20 0.0000000 0 255 1245 3902 14402 Secondary\001 -4 0 -1 0 0 2 20 0.0000000 0 255 1230 3902 14702 hypercube\001 -4 0 -1 0 0 2 20 0.0000000 0 255 1620 4202 15002 HA_RANGE\001 -4 0 -1 0 0 2 20 0.0000000 0 255 1950 4202 15302 SELECT_IFRS\001 -4 0 -1 0 0 2 20 0.0000000 0 255 1920 4202 15602 SELECT_XYX\001 --6 -6 3901 18301 13201 21601 -6 8703 18903 11103 20703 -4 0 -1 0 0 2 20 0.0000000 0 255 1245 8705 19205 Secondary\001 -4 0 -1 0 0 2 20 0.0000000 0 255 1230 8705 19505 hypercube\001 -4 0 -1 0 0 2 20 0.0000000 0 255 1620 9005 19805 HA_RANGE\001 -4 0 -1 0 0 2 20 0.0000000 0 255 1950 9005 20105 SELECT_IFRS\001 -4 0 -1 0 0 2 20 0.0000000 0 255 1920 9005 20405 SELECT_XYX\001 --6 -2 1 0 2 -1 7 0 0 -1 0.000 0 0 -1 0 0 2 - 8703 18903 12003 18903 -2 1 1 1 -1 7 0 0 -1 4.000 0 0 -1 0 0 2 - 11102 18302 11102 21302 -2 1 0 2 -1 7 0 0 -1 0.000 0 0 -1 0 0 2 - 3902 18902 8102 18902 -4 0 -1 0 0 1 20 0.0000000 0 195 960 3903 18603 CLEAR\001 -4 0 -1 0 0 1 20 0.0000000 0 195 975 5403 18603 CLDAT\001 -4 0 -1 0 0 1 20 0.0000000 0 195 1185 6903 18603 CLHEAD\001 -4 0 -1 0 0 1 20 0.0000000 0 195 1230 8703 18603 UVDATA\001 -4 0 -1 0 0 1 20 0.0000000 0 255 1560 11402 18602 HA_RANGE\001 -4 0 -1 0 0 2 20 0.0000000 0 255 1620 11402 21002 HA_RANGE\001 -4 0 -1 0 0 2 20 0.0000000 0 255 2100 4502 19202 SELECT_FLAG\001 --6 -2 1 1 2 -1 7 0 0 -1 6.000 0 0 -1 0 0 2 - 2402 6902 3002 6902 -2 1 1 2 -1 7 0 0 -1 6.000 0 0 -1 0 0 2 - 3602 7802 3602 8402 -2 1 1 2 -1 7 0 0 -1 6.000 0 0 -1 0 0 2 - 3602 8402 15903 8403 -2 1 1 2 -1 7 0 0 -1 6.000 0 0 -1 0 0 2 - 7803 8403 7803 8703 -2 1 1 2 -1 7 0 0 -1 6.000 0 0 -1 0 0 2 - 6003 8403 6003 8703 -2 1 1 2 -1 7 0 0 -1 6.000 0 0 -1 0 0 2 - 4203 8403 4203 8703 -2 1 1 2 -1 7 0 0 -1 6.000 0 0 -1 0 0 2 - 9603 8403 9603 8703 -2 1 1 2 -1 7 0 0 -1 6.000 0 0 -1 0 0 2 - 11403 8403 11403 8703 -2 1 1 2 -1 7 0 0 -1 6.000 0 0 -1 0 0 2 - 13803 8403 13803 8703 -2 1 1 2 -1 7 0 0 -1 6.000 0 0 -1 0 0 2 - 15903 8403 15903 8703 -2 1 1 1 -1 7 0 0 -1 4.000 0 0 -1 0 0 2 - 7203 8703 7203 11103 -2 1 1 1 -1 7 0 0 -1 4.000 0 0 -1 0 0 2 - 9003 8703 9003 11103 -2 1 1 1 -1 7 0 0 -1 4.000 0 0 -1 0 0 2 - 10803 8703 10803 11103 -2 1 1 1 -1 7 0 0 -1 4.000 0 0 -1 0 0 2 - 13203 8703 13203 11103 -2 1 1 1 -1 7 0 0 -1 4.000 0 0 -1 0 0 2 - 15303 8703 15303 10803 -2 1 0 2 -1 7 0 0 -1 0.000 0 0 -1 0 0 2 - 9303 10503 15003 10503 -2 1 1 1 -1 7 0 0 -1 4.000 0 0 -1 0 0 2 - 5403 8703 5403 11103 -2 1 0 2 -1 7 0 0 -1 0.000 0 0 -1 0 0 2 - 3903 10503 8703 10503 -2 1 1 2 -1 7 0 0 -1 6.000 0 0 -1 0 0 2 - 2401 16501 3001 16501 -2 1 1 2 -1 7 0 0 -1 6.000 0 0 -1 0 0 3 - 3601 12901 3602 13202 15901 13201 -2 1 1 2 -1 7 0 0 -1 6.000 0 0 -1 0 0 2 - 4201 13201 4201 13501 -2 1 1 2 -1 7 0 0 -1 6.000 0 0 -1 0 0 2 - 6901 13201 6901 13501 -2 1 0 2 -1 7 0 0 -1 0.000 0 0 -1 0 0 2 - 9002 14102 15901 14101 -2 1 1 2 -1 7 0 0 -1 6.000 0 0 -1 0 0 2 - 2401 12001 3001 12001 -2 1 1 2 -1 7 0 0 -1 6.000 0 0 -1 0 0 2 - 14701 13201 14701 13501 -2 1 1 2 -1 7 0 0 -1 6.000 0 0 -1 0 0 2 - 13201 13201 13201 13501 -2 1 1 2 -1 7 0 0 -1 6.000 0 0 -1 0 0 2 - 9301 13201 9301 13501 -2 1 1 1 -1 7 0 0 -1 4.000 0 0 -1 0 0 2 - 6301 13501 6301 15901 -2 1 1 1 -1 7 0 0 -1 4.000 0 0 -1 0 0 2 - 8701 13501 8701 15901 -2 1 1 1 -1 7 0 0 -1 4.000 0 0 -1 0 0 2 - 10201 13501 10201 15901 -2 1 1 2 -1 7 0 0 -1 6.000 0 0 -1 0 0 2 - 12001 13201 12001 13501 -2 1 1 2 -1 7 0 0 -1 6.000 0 0 -1 0 0 2 - 10801 13201 10801 13501 -2 1 1 1 -1 7 0 0 -1 4.000 0 0 -1 0 0 2 - 11401 13501 11401 15901 -2 1 1 1 -1 7 0 0 -1 4.000 0 0 -1 0 0 2 - 12601 13501 12601 15901 -2 1 1 1 -1 7 0 0 -1 4.000 0 0 -1 0 0 2 - 14101 13501 14101 15901 -2 1 1 1 -1 7 0 0 -1 4.000 0 0 -1 0 0 2 - 15301 13501 15301 15901 -2 1 1 2 -1 7 0 0 -1 6.000 0 0 -1 0 0 2 - 15901 13201 15901 13501 -2 1 1 2 -1 7 0 0 -1 6.000 0 0 -1 0 0 3 - 3601 17401 3601 18001 11701 18001 -2 1 1 2 -1 7 0 0 -1 6.000 0 0 -1 0 0 2 - 9001 18001 9001 18301 -2 1 1 2 -1 7 0 0 -1 6.000 0 0 -1 0 0 2 - 11701 18001 11701 18301 -2 1 1 2 -1 7 0 0 -1 6.000 0 0 -1 0 0 2 - 7201 18001 7201 18301 -2 1 1 2 -1 7 0 0 -1 6.000 0 0 -1 0 0 2 - 5701 18001 5701 18301 -2 1 1 2 -1 7 0 0 -1 6.000 0 0 -1 0 0 2 - 4201 18001 4201 18301 -2 1 1 1 -1 7 0 0 -1 4.000 0 0 -1 0 0 1 - 8401 18301 -2 1 1 1 -1 7 0 0 -1 4.000 0 0 -1 0 0 2 - 8401 18301 8401 21301 -2 1 1 2 -1 7 0 0 -1 6.000 0 0 -1 0 0 2 - 2401 18601 3601 18601 -2 1 1 2 -1 7 0 0 -1 6.000 0 0 -1 0 0 3 - 2401 18601 2401 9001 2401 3001 -4 0 -1 0 0 1 20 0.0000000 0 195 1440 3302 6902 CLIPDATA\001 -4 0 -1 0 0 2 20 0.0000000 0 255 2220 3302 7502 OPS_CLIPDATA\001 -4 0 -1 0 0 1 20 0.0000000 0 255 3285 3903 8103 Flag data outside an interval\001 -4 0 -1 0 0 1 20 0.0000000 0 255 3990 9303 8103 Flag data exceeding a derived limit\001 -4 0 -1 0 0 1 20 0.0000000 0 195 810 3904 9004 AMPL\001 -4 0 -1 0 0 1 20 0.0000000 0 255 1215 3904 9304 Amplitude\001 -4 0 -1 0 0 1 20 0.0000000 0 195 1065 3904 9604 threshold\001 -4 0 -1 0 0 1 20 0.0000000 0 195 1155 9304 9304 Residual-\001 -4 0 -1 0 0 1 20 0.0000000 0 255 1140 9304 9604 amplitude\001 -4 0 -1 0 0 1 20 0.0000000 0 195 1065 9304 9904 threshold\001 -4 0 -1 0 0 1 20 0.0000000 0 255 1440 11104 9604 amplitude in\001 -4 0 -1 0 0 1 20 0.0000000 0 195 1800 11104 9304 Outlier residual\001 -4 0 -1 0 0 1 20 0.0000000 0 195 1860 11104 9904 set of redundant\001 -4 0 -1 0 0 1 20 0.0000000 0 195 1020 11104 10204 baselines\001 -4 0 -1 0 0 1 20 0.0000000 0 195 1050 9304 9004 ARESID\001 -4 0 -1 0 0 1 20 0.0000000 0 195 1035 11104 9004 RRESID\001 -4 0 -1 0 0 1 20 0.0000000 0 255 1245 13504 9304 Magnitude\001 -4 0 -1 0 0 1 20 0.0000000 0 195 1425 13504 9604 of difference\001 -4 0 -1 0 0 1 20 0.0000000 0 195 1440 13504 9904 between XX\001 -4 0 -1 0 0 1 20 0.0000000 0 195 915 13504 10204 and YY\001 -4 0 -1 0 0 1 20 0.0000000 0 255 630 13504 9004 QXY\001 -4 0 -1 0 0 1 20 0.0000000 0 195 525 15604 9004 DT1\001 -4 0 -1 0 0 1 20 0.0000000 0 255 1215 15604 9304 Amplitude\001 -4 0 -1 0 0 1 20 0.0000000 0 255 1485 15604 9604 discontinuity\001 -4 0 -1 0 0 2 20 0.0000000 0 255 1695 9904 10804 CLIP_LIMIT\001 -4 0 -1 0 0 2 20 0.0000000 0 255 1860 5403 10803 CLIP_LIMITS\001 -4 0 -1 0 0 2 20 0.0000000 0 255 1545 15604 10804 DT1_LIMIT\001 -4 0 -1 0 0 1 20 0.0000000 0 195 570 5705 9005 COS\001 -4 0 -1 0 0 1 20 0.0000000 0 195 465 7505 9005 SIN\001 -4 0 -1 0 0 1 20 0.0000000 0 195 780 5705 9305 Cosine\001 -4 0 -1 0 0 1 20 0.0000000 0 195 1065 5705 9605 threshold\001 -4 0 -1 0 0 1 20 0.0000000 0 195 585 7505 9305 Sine \001 -4 0 -1 0 0 1 20 0.0000000 0 195 1065 7505 9605 threshold\001 -4 0 -1 0 0 1 20 0.0000000 0 195 1275 3301 16501 MANUAL\001 -4 0 -1 0 0 2 20 0.0000000 0 255 2010 3301 17101 OPS_MANUAL\001 -4 0 -1 0 0 1 20 0.0000000 0 195 945 3902 13802 SCANS\001 -4 0 -1 0 0 1 20 0.0000000 0 195 1440 6601 13801 MAXABCS\001 -4 0 -1 0 0 2 20 0.0000000 0 255 1950 6601 14401 ABCS_LIMITS\001 -4 0 -1 0 0 1 20 0.0000000 0 195 1065 9003 13803 ANOISE\001 -4 0 -1 0 0 2 20 0.0000000 0 255 1665 3301 12601 OPS_SCANS\001 -4 0 -1 0 0 1 20 0.0000000 0 195 1365 3301 12001 HASCANS\001 -4 0 -1 0 0 1 20 0.0000000 0 255 2040 5101 12001 Flag scan headers\001 -4 0 -1 0 0 1 20 0.0000000 0 195 615 14401 13801 XRN\001 -4 0 -1 0 0 1 20 0.0000000 0 195 1050 12901 13801 RNOISE\001 -4 0 -1 0 0 1 20 0.0000000 0 255 2970 12901 12901 Residuals amplitude noise\001 -4 0 -1 0 0 1 20 0.0000000 0 255 2925 9001 12901 Visibility amplitude noise\001 -4 0 -1 0 0 2 20 0.0000000 0 255 1860 11401 14401 CLIP_LIMITS\001 -4 0 -1 0 0 1 20 0.0000000 0 195 630 11701 13801 YAN\001 -4 0 -1 0 0 1 20 0.0000000 0 195 630 10501 13801 XAN\001 -4 0 -1 0 0 1 20 0.0000000 0 195 615 15601 13801 YRN\001 -4 0 -1 0 0 1 20 0.0000000 0 255 1245 3901 17701 Clear flags\001 -4 0 -1 0 0 1 20 0.0000000 0 255 990 8701 17701 Set flags\001 -4 0 -1 0 0 1 20 0.0000000 0 255 2745 5101 16501 Manually set/clear flags\001 -4 0 -1 0 0 2 20 0.0000000 0 255 2085 2101 2701 FLAG_OPTION\001 -4 0 -1 0 0 1 10 0.0000000 0 150 1380 14101 2701 nflag_operate.fig 50%\001 diff --git a/src/doc/fig/nflag_statist.cap b/src/doc/fig/nflag_statist.cap deleted file mode 100644 index c4ed58380cbfac24aef82c9386f45d76241696cb..0000000000000000000000000000000000000000 --- a/src/doc/fig/nflag_statist.cap +++ /dev/null @@ -1,14 +0,0 @@ -%nflag_statist.cap - -\begin{figure} -\fig{nflag_statist} -\caption{\it -\label{.nflag.statist} -% -Schematic of the STATIST branch of NFLAG. -\\ -This branch accumulates statistical characteristics from the visibilities -and/or the noise parameters in the scan headers and provides displays of the -results in various formats. -} -\end{figure} diff --git a/src/doc/fig/nflag_statist.fig b/src/doc/fig/nflag_statist.fig deleted file mode 100644 index 8f70792eb149520bb12d72245d778689af95cd66..0000000000000000000000000000000000000000 --- a/src/doc/fig/nflag_statist.fig +++ /dev/null @@ -1,52 +0,0 @@ -#FIG 3.1 -Portrait -Center -Inches -1200 2 -6 3301 5101 4801 6601 -4 0 -1 0 0 1 20 0.0000000 0 195 600 3302 5402 ACC\001 -4 0 -1 0 0 1 20 0.0000000 0 195 1395 3302 5702 Accumulate\001 -4 0 -1 0 0 1 20 0.0000000 0 195 990 3302 6002 statistics\001 -4 0 -1 0 0 1 20 0.0000000 0 195 1245 3302 6302 from scans\001 --6 -6 3300 7200 8100 9300 -2 1 1 2 -1 7 0 0 -1 6.000 0 0 -1 0 0 2 - 3602 7802 3602 8102 -2 1 1 2 -1 7 0 0 -1 6.000 0 0 -1 0 0 2 - 6302 7802 6302 8102 -4 0 -1 0 0 1 20 0.0000000 0 195 1155 3302 8402 GROUPS\001 -4 0 -1 0 0 1 20 0.0000000 0 255 1560 3302 7502 On-line Help\001 -4 0 -1 0 0 1 20 0.0000000 0 195 2085 3302 8702 List accumulation\001 -4 0 -1 0 0 1 20 0.0000000 0 195 765 3302 9002 groups\001 -4 0 -1 0 0 1 20 0.0000000 0 195 1245 6002 8402 EXPLAIN\001 -4 0 -1 0 0 1 20 0.0000000 0 255 1950 6002 8702 Explain statistics\001 -4 0 -1 0 0 1 20 0.0000000 0 195 1380 6002 9002 to be shown\001 --6 -6 8100 4200 14400 6000 -2 1 1 2 -1 7 0 0 -1 6.000 0 0 -1 0 0 2 - 12302 4802 12302 5102 -2 1 1 2 -1 7 0 0 -1 6.000 0 0 -1 0 0 2 - 10502 4802 10502 5102 -2 1 1 2 -1 7 0 0 -1 6.000 0 0 -1 0 0 2 - 8402 4802 8402 5102 -4 0 -1 0 0 1 20 0.0000000 0 195 1440 8103 5703 scan-header\001 -4 0 -1 0 0 1 20 0.0000000 0 195 1140 10203 5703 visibilities\001 -4 0 -1 0 0 1 20 0.0000000 0 255 2385 12003 5703 accumulation-group\001 -4 0 -1 0 0 1 20 0.0000000 0 195 945 8102 5402 SCANS\001 -4 0 -1 0 0 1 20 0.0000000 0 195 1020 10202 5402 UVDAT\001 -4 0 -1 0 0 1 20 0.0000000 0 255 3465 8102 4502 Display statistics accumulated\001 -4 0 -1 0 0 1 20 0.0000000 0 195 990 12002 5402 <group>\001 --6 -2 1 1 2 -1 7 0 0 -1 6.000 0 0 -1 0 0 2 - 2700 3000 2700 7800 -2 1 1 2 -1 7 0 0 -1 6.000 0 0 -1 0 0 2 - 2700 4800 12300 4800 -2 1 1 2 -1 7 0 0 -1 6.000 0 0 -1 0 0 2 - 2700 7800 6300 7800 -4 0 -1 0 0 3 20 0.0000000 0 195 555 5401 5401 ACD\001 -4 0 -1 0 0 3 20 0.0000000 0 270 1890 5401 5701 not implemented\001 -4 0 -1 0 0 3 20 0.0000000 0 195 540 6601 5401 ACH\001 -4 0 -1 0 0 2 20 0.0000000 0 255 1935 2400 2700 OPS_STATIST\001 -4 0 -1 0 0 1 10 0.0000000 0 150 1335 12300 8700 nflag_statist.fig 50%\001 -4 0 -1 0 0 1 20 0.0000000 0 195 2460 3300 4200 Accumulate statistics\001 -4 0 -1 0 0 1 20 0.0000000 0 255 2235 3301 4501 primary hypercube\001 diff --git a/src/doc/fig/ngcalc_display.fig b/src/doc/fig/ngcalc_display.fig deleted file mode 100644 index bab6950d4cd97c1717c50441f8e1764bd38c2c0e..0000000000000000000000000000000000000000 --- a/src/doc/fig/ngcalc_display.fig +++ /dev/null @@ -1,217 +0,0 @@ -#FIG 3.1 -Portrait -Center -Inches -1200 2 -2 1 1 2 -1 -1 0 0 -1 6.000 0 0 -1 0 0 1 - 4200 5400 -2 1 1 2 -1 -1 0 0 -1 6.000 0 0 -1 0 0 1 - 4200 5400 -2 1 1 2 -1 -1 0 0 -1 6.000 0 0 -1 0 0 2 - 10800 7800 10800 7500 -2 1 1 2 -1 -1 0 0 -1 6.000 0 0 -1 0 0 2 - 12300 7800 12300 7500 -2 1 1 2 -1 -1 0 0 -1 6.000 0 0 -1 0 0 2 - 4800 7800 4800 7500 -2 1 1 2 -1 -1 0 0 -1 6.000 0 0 -1 0 0 2 - 6600 7800 6600 7500 -2 1 1 2 -1 -1 0 0 -1 6.000 0 0 -1 0 0 2 - 9000 7800 9000 7500 -2 1 1 2 -1 -1 0 0 -1 6.000 0 0 -1 0 0 2 - 4800 7500 14700 7500 -2 1 1 2 -1 -1 0 0 -1 6.000 0 0 -1 0 0 2 - 7200 10200 7200 9900 -2 1 1 2 -1 -1 0 0 -1 6.000 0 0 -1 0 0 2 - 9000 10200 9000 9900 -2 1 1 2 -1 -1 0 0 -1 6.000 0 0 -1 0 0 2 - 10800 10200 10800 9900 -2 1 1 2 -1 -1 0 0 -1 6.000 0 0 -1 0 0 2 - 12300 10200 12300 9900 -2 1 1 1 -1 -1 0 0 -1 4.000 0 0 -1 0 0 2 - 4200 7800 4200 9000 -2 1 1 1 -1 -1 0 0 -1 4.000 0 0 -1 0 0 2 - 6000 7800 6000 9000 -2 1 1 1 -1 -1 0 0 -1 4.000 0 0 -1 0 0 2 - 8400 7800 8400 9000 -2 1 1 1 -1 -1 0 0 -1 4.000 0 0 -1 0 0 2 - 10200 7800 10200 9000 -2 1 1 1 -1 -1 0 0 -1 4.000 0 0 -1 0 0 2 - 11700 7800 11700 9600 -2 1 1 1 -1 -1 0 0 -1 4.000 0 0 -1 0 0 1 - 15300 9000 -2 1 1 1 -1 -1 0 0 -1 4.000 0 0 -1 0 0 2 - 6600 10200 6600 11400 -2 1 1 1 -1 -1 0 0 -1 4.000 0 0 -1 0 0 2 - 8400 10200 8400 11400 -2 1 1 1 -1 -1 0 0 -1 4.000 0 0 -1 0 0 2 - 10200 10200 10200 11400 -2 1 1 1 -1 -1 0 0 -1 4.000 0 0 -1 0 0 2 - 11700 10200 11700 12000 -2 1 1 2 -1 -1 0 0 -1 6.000 0 0 -1 0 0 2 - 14700 7800 14700 7500 -2 1 1 2 -1 -1 0 0 -1 6.000 0 0 -1 0 0 2 - 14700 9900 7200 9900 -2 1 1 2 -1 -1 0 0 -1 6.000 0 0 -1 0 0 2 - 14700 10200 14700 9900 -2 1 1 1 -1 -1 0 0 -1 4.000 0 0 -1 0 0 2 - 14400 10200 14400 12000 -2 1 1 1 -1 -1 0 0 -1 4.000 0 0 -1 0 0 2 - 16800 10200 16800 11400 -2 1 1 1 -1 -1 0 0 -1 4.000 0 0 -1 0 0 2 - 16800 7800 16800 9000 -2 1 1 1 -1 -1 0 0 -1 4.000 0 0 -1 0 0 2 - 14400 7800 14400 9600 -2 1 1 1 -1 -1 0 0 -1 4.000 0 0 -1 0 0 2 - 9000 12600 9000 13800 -2 1 1 1 -1 -1 0 0 -1 4.000 0 0 -1 0 0 2 - 11100 12600 11100 13800 -2 1 1 1 -1 -1 0 0 -1 4.000 0 0 -1 0 0 2 - 12900 12600 12900 13800 -2 1 1 1 -1 -1 0 0 -1 4.000 0 0 -1 0 0 2 - 14400 12600 14400 13800 -2 1 1 1 -1 -1 0 0 -1 4.000 0 0 -1 0 0 3 - 16800 12600 16800 13500 16800 13800 -2 1 1 2 -1 -1 0 0 -1 6.000 0 0 -1 0 0 2 - 9600 12300 9600 12600 -2 1 1 2 -1 -1 0 0 -1 6.000 0 0 -1 0 0 2 - 11700 12300 11700 12600 -2 1 1 2 -1 -1 0 0 -1 6.000 0 0 -1 0 0 2 - 13500 12300 13500 12600 -2 1 1 2 -1 -1 0 0 -1 6.000 0 0 -1 0 0 2 - 15000 12300 15000 12600 -2 1 1 2 -1 -1 0 0 -1 6.000 0 0 -1 0 0 1 - 15000 12300 -2 1 1 2 -1 -1 0 0 -1 6.000 0 0 -1 0 0 2 - 9600 12300 15000 12300 -2 1 1 1 -1 -1 0 0 -1 4.000 0 0 -1 0 0 2 - 6600 11400 11700 11400 -2 1 1 1 -1 -1 0 0 -1 4.000 0 0 -1 0 0 2 - 14400 11400 16800 11400 -2 1 1 1 -1 -1 0 0 -1 4.000 0 0 -1 0 0 2 - 14400 9000 16800 9000 -2 1 1 1 -1 -1 0 0 -1 4.000 0 0 -1 0 0 2 - 9000 13800 16800 13800 -2 1 1 1 -1 -1 0 0 -1 4.000 0 0 -1 0 0 2 - 4200 9000 11700 9000 -2 1 1 1 -1 -1 0 0 -1 4.000 0 0 -1 0 0 2 - 8400 5400 8400 7200 -2 1 1 1 -1 -1 0 0 -1 4.000 0 0 -1 0 0 2 - 10800 5400 10800 6600 -2 1 1 1 -1 -1 0 0 -1 4.000 0 0 -1 0 0 2 - 12900 5400 12900 6600 -2 1 1 1 -1 -1 0 0 -1 4.000 0 0 -1 0 0 2 - 5400 5400 5400 7200 -2 1 1 1 -1 -1 0 0 -1 4.000 0 0 -1 0 0 2 - 8400 6600 12900 6600 -2 1 1 2 -1 -1 0 0 -1 6.000 0 0 -1 0 0 2 - 3300 5100 11400 5100 -2 1 1 2 -1 -1 0 0 -1 6.000 0 0 -1 0 0 2 - 11400 5100 11400 5400 -2 1 1 2 -1 -1 0 0 -1 6.000 0 0 -1 0 0 2 - 9000 5100 9000 5400 -2 1 1 2 -1 -1 0 0 -1 6.000 0 0 -1 0 0 2 - 6000 5100 6000 5400 -2 1 1 2 -1 -1 0 0 -1 6.000 0 0 -1 0 0 3 - 3300 3600 3300 15000 7800 15000 -2 1 1 2 -1 -1 0 0 -1 6.000 0 0 -1 0 0 2 - 4800 15000 4800 15300 -2 1 1 2 -1 -1 0 0 -1 6.000 0 0 -1 0 0 2 - 7800 15000 7800 15300 -2 1 0 2 -1 -1 0 0 -1 0.000 0 0 -1 0 0 2 - 4500 18000 9900 18000 -2 1 0 2 -1 -1 0 0 -1 0.000 0 0 -1 0 0 2 - 4500 16500 9900 16500 -2 1 1 1 -1 -1 0 0 -1 4.000 0 0 -1 0 0 1 - 4200 15300 -2 1 1 1 -1 -1 0 0 -1 4.000 0 0 -1 0 0 2 - 6900 15300 6900 22200 -2 1 1 1 -1 -1 0 0 -1 4.000 0 0 -1 0 0 2 - 10200 15300 10200 22200 -2 1 1 1 -1 -1 0 0 -1 4.000 0 0 -1 0 0 3 - 4200 15300 4200 18900 6900 18900 -4 0 -1 0 0 0 20 0.0000000 0 195 1200 4500 8100 LAYOUT\001 -4 0 -1 0 0 0 20 0.0000000 0 195 1545 6300 8100 OVERVIEW\001 -4 0 -1 0 0 0 20 0.0000000 0 255 1140 4500 8400 Summary\001 -4 0 -1 0 0 0 20 0.0000000 0 195 1260 4500 8700 of contents\001 -4 0 -1 0 0 0 20 0.0000000 0 195 855 8700 8100 SHOW\001 -4 0 -1 0 0 0 20 0.0000000 0 195 1065 8700 8400 show full\001 -4 0 -1 0 0 0 20 0.0000000 0 195 1200 8700 8700 file header\001 -4 0 -1 0 0 0 20 0.0000000 0 195 855 10500 8400 edit file\001 -4 0 -1 0 0 0 20 0.0000000 0 195 765 10500 8700 header\001 -4 0 -1 0 0 0 20 0.0000000 0 255 1170 12000 8400 proceed to\001 -4 0 -1 0 0 0 20 0.0000000 0 195 1200 12000 8700 cut header\001 -4 0 -1 0 0 0 20 0.0000000 0 195 660 10500 8100 EDIT\001 -4 0 -1 0 0 0 20 0.0000000 0 195 795 12000 8100 CONT\001 -4 0 -1 0 0 2 20 0.0000000 0 255 1470 12000 9300 NGF_SETS\001 -4 0 -1 0 0 2 20 0.0000000 0 255 1845 12000 9600 SET_ACTION\001 -4 0 -1 0 0 0 20 0.0000000 0 195 930 12000 11100 cut data\001 -4 0 -1 0 0 0 20 0.0000000 0 255 1170 12000 10800 proceed to\001 -4 0 -1 0 0 0 20 0.0000000 0 195 795 12000 10500 CONT\001 -4 0 -1 0 0 0 20 0.0000000 0 195 765 10500 11100 header\001 -4 0 -1 0 0 0 20 0.0000000 0 195 855 10500 10800 edit cut\001 -4 0 -1 0 0 0 20 0.0000000 0 195 660 10500 10500 EDIT\001 -4 0 -1 0 0 0 20 0.0000000 0 195 1200 8700 11100 cut header\001 -4 0 -1 0 0 0 20 0.0000000 0 195 1065 8700 10800 show full\001 -4 0 -1 0 0 0 20 0.0000000 0 195 855 8700 10500 SHOW\001 -4 0 -1 0 0 0 20 0.0000000 0 195 780 6900 10500 NEXT\001 -4 0 -1 0 0 0 20 0.0000000 0 165 930 6900 10800 next cut\001 -4 0 -1 0 0 0 20 0.0000000 0 255 1845 14700 11100 FILE_ACTION\001 -4 0 -1 0 0 0 20 0.0000000 0 165 1020 14700 10800 return to\001 -4 0 -1 0 0 0 20 0.0000000 0 255 690 14700 10500 QUIT\001 -4 0 -1 0 0 0 20 0.0000000 0 195 1065 14700 8700 OPTION\001 -4 0 -1 0 0 0 20 0.0000000 0 165 1020 14700 8400 return to\001 -4 0 -1 0 0 0 20 0.0000000 0 255 690 14700 8100 QUIT\001 -4 0 -1 0 0 0 20 0.0000000 0 195 855 9300 12900 SHOW\001 -4 0 -1 0 0 0 20 0.0000000 0 255 1365 9300 13200 list complex\001 -4 0 -1 0 0 0 20 0.0000000 0 195 720 9300 13590 values\001 -4 0 -1 0 0 0 20 0.0000000 0 195 810 11400 12900 AMPL\001 -4 0 -1 0 0 0 20 0.0000000 0 195 345 11400 13200 list\001 -4 0 -1 0 0 0 20 0.0000000 0 255 1245 11400 13500 amplitudes\001 -4 0 -1 0 0 0 20 0.0000000 0 195 930 13200 12900 PHASE\001 -4 0 -1 0 0 0 20 0.0000000 0 195 345 13200 13200 list\001 -4 0 -1 0 0 0 20 0.0000000 0 255 750 13200 13500 phases\001 -4 0 -1 0 0 0 20 0.0000000 0 255 690 14700 12900 QUIT\001 -4 0 -1 0 0 0 20 0.0000000 0 165 1020 14700 13200 return to\001 -4 0 -1 0 0 0 20 0.0000000 0 255 1755 14700 13500 SET_ACTION\001 -4 0 -1 0 0 2 20 0.0000000 0 255 2115 12000 12000 DATA_ACTION\001 -4 0 -1 0 0 0 20 0.0000000 0 255 1845 6300 8400 List (aggregates\001 -4 0 -1 0 0 0 20 0.0000000 0 255 945 6600 8700 of) cuts\001 -4 0 -1 0 0 0 20 0.0000000 0 195 855 5700 5700 SHOW\001 -4 0 -1 0 0 0 20 0.0000000 0 255 2295 5700 6000 inspect/edit in detail\001 -4 0 -1 0 0 0 20 0.0000000 0 195 825 8700 5700 BRIEF\001 -4 0 -1 0 0 0 20 0.0000000 0 195 735 11100 5700 FULL\001 -4 0 -1 0 0 0 20 0.0000000 0 255 1605 8700 6000 list agrregates\001 -4 0 -1 0 0 0 20 0.0000000 0 195 765 8700 6300 of cuts\001 -4 0 -1 0 0 0 20 0.0000000 0 195 1245 11100 6000 list all cuts\001 -4 0 -1 0 0 2 20 0.0000000 0 255 1965 5700 7200 FILE_ACTION\001 -4 0 -1 0 0 0 10 0.0000000 0 105 615 9900 6300 NGCPBR\001 -4 0 -1 0 0 0 10 0.0000000 0 105 615 12000 6300 NGCPBR\001 -4 0 -1 0 0 0 10 0.0000000 0 105 615 7500 6300 NGCPRT\001 -4 0 -1 0 0 3 20 0.0000000 0 270 1770 3900 4800 Tabular display\001 -4 0 -1 0 0 3 20 0.0000000 0 270 525 2700 3600 from\001 -4 0 -1 0 0 2 20 0.0000000 0 195 1140 3300 3600 OPTION\001 -4 0 -1 0 0 0 20 0.0000000 0 195 1095 4500 15600 MONGO\001 -4 0 -1 0 0 0 20 0.0000000 0 195 735 7200 15600 PLOT\001 -4 0 -1 0 0 3 20 0.0000000 0 270 1815 3900 14700 Graphic display\001 -4 0 -1 0 0 0 10 0.0000000 0 105 705 5400 15900 NGCMON\001 -4 0 -1 0 0 0 10 0.0000000 0 105 600 8100 15900 NGCPLT\001 -4 0 -1 0 0 2 20 0.0000000 0 195 1395 7200 16200 PLOTTER\001 -4 0 -1 0 0 2 20 0.0000000 0 255 1965 4500 17700 MONGO_FILE\001 -4 0 -1 0 0 2 20 0.0000000 0 255 1710 5700 18300 PLOT_TYPE\001 -4 0 -1 0 0 2 20 0.0000000 0 255 1755 7200 19200 BAS_RANGE\001 -4 0 -1 0 0 0 20 0.0000000 0 195 570 5100 18600 COS\001 -4 0 -1 0 0 0 20 0.0000000 0 195 465 6000 18600 SIN\001 -4 0 -1 0 0 0 20 0.0000000 0 195 810 6900 18600 AMPL\001 -4 0 -1 0 0 0 20 0.0000000 0 195 930 8100 18600 PHASE\001 -4 0 -1 0 0 0 20 0.0000000 0 195 1725 7200 19500 select baselines\001 -4 0 -1 0 0 2 20 0.0000000 0 255 1470 5700 17100 NGF_SETS\001 -4 0 -1 0 0 2 20 0.0000000 0 255 1740 5700 16800 NGF_LOOPS\001 -4 0 -1 0 0 2 20 0.0000000 0 255 1680 8100 20100 BAS_SCALE\001 -4 0 -1 0 0 3 20 0.0000000 0 210 630 7200 20100 either\001 -4 0 -1 0 0 2 20 0.0000000 0 255 1545 8100 20400 HA_SCALE\001 -4 0 -1 0 0 3 20 0.0000000 0 135 225 7500 20400 or\001 -4 0 -1 0 0 2 20 0.0000000 0 195 975 7200 21300 SCALE\001 -4 0 -1 0 0 0 20 0.0000000 0 255 1800 7200 20700 parameter scale\001 -4 0 -1 0 0 2 20 0.0000000 0 195 1140 7200 21600 OFFSET\001 -4 0 -1 0 0 0 20 0.0000000 0 195 2325 7200 21900 data scale and offset\001 -4 0 -1 0 0 0 10 0.0000000 0 150 1440 14400 3600 ngcalc_display.fig 45%\001 diff --git a/src/doc/fig/ngcalc_extract.fig b/src/doc/fig/ngcalc_extract.fig deleted file mode 100644 index 57703ada89fc2a09b8496fa00ba5dc79a68dfdba..0000000000000000000000000000000000000000 --- a/src/doc/fig/ngcalc_extract.fig +++ /dev/null @@ -1,131 +0,0 @@ -#FIG 3.1 -Portrait -Center -Inches -1200 2 -2 1 1 1 -1 -1 0 0 -1 4.000 0 0 -1 0 0 2 - 2400 10500 16500 10500 -2 1 1 1 -1 -1 0 0 -1 4.000 0 0 -1 0 0 2 - 6600 6600 6600 10500 -2 1 1 1 -1 -1 0 0 -1 4.000 0 0 -1 0 0 2 - 8400 6600 8400 10500 -2 1 0 2 -1 -1 0 0 -1 0.000 0 0 -1 0 0 3 - 2700 9900 2700 9900 16200 9900 -2 1 1 2 -1 -1 0 0 -1 6.000 0 0 -1 0 0 2 - 9000 8700 9000 8400 -2 1 1 2 -1 -1 0 0 -1 6.000 0 0 -1 0 0 2 - 10800 8700 10800 8400 -2 1 1 2 -1 -1 0 0 -1 6.000 0 0 -1 0 0 2 - 12600 8700 12600 8400 -2 1 1 2 -1 -1 0 0 -1 6.000 0 0 -1 0 0 2 - 9000 8400 17100 8400 -2 1 1 1 -1 -1 0 0 -1 4.000 0 0 -1 0 0 2 - 10200 8700 10200 10500 -2 1 1 1 -1 -1 0 0 -1 4.000 0 0 -1 0 0 2 - 12000 8700 12000 10500 -2 1 1 1 -1 -1 0 0 -1 4.000 0 0 -1 0 0 2 - 13500 8700 13500 10500 -2 1 1 2 -1 -1 0 0 -1 6.000 0 0 -1 0 0 2 - 14100 8700 14100 8400 -2 1 1 2 -1 -1 0 0 -1 6.000 0 0 -1 0 0 2 - 15600 8700 15600 8400 -2 1 1 1 -1 -1 0 0 -1 4.000 0 0 -1 0 0 2 - 16500 8700 16500 10500 -2 1 1 2 -1 -1 0 0 -1 6.000 0 0 -1 0 0 3 - 17100 8400 17100 12300 10800 12300 -2 1 1 1 -1 -1 0 0 -1 4.000 0 0 -1 0 0 2 - 14700 8700 14700 10500 -2 1 1 2 -1 -1 0 0 -1 6.000 0 0 -1 0 0 2 - 5700 6600 5700 6300 -2 1 1 2 -1 -1 0 0 -1 6.000 0 0 -1 0 0 2 - 7200 6600 7200 6300 -2 1 1 1 -1 -1 0 0 -1 4.000 0 0 -1 0 0 2 - 5100 6600 5100 10500 -2 1 1 2 -1 -1 0 0 -1 6.000 0 0 -1 0 0 2 - 4200 6600 4200 6300 -2 1 1 1 -1 -1 0 0 -1 4.000 0 0 -1 0 0 2 - 3600 6600 3600 10500 -2 1 1 2 -1 -1 0 0 -1 6.000 0 0 -1 0 0 2 - 3000 6300 18300 6300 -2 1 1 2 -1 -1 0 0 -1 6.000 0 0 -1 0 0 2 - 3000 6600 3000 6300 -2 1 1 1 -1 -1 0 0 -1 4.000 0 0 -1 0 0 2 - 2400 6600 2400 10500 -2 1 1 1 -1 -1 0 0 -1 4.000 0 0 -1 0 0 2 - 17700 6600 17700 14100 -2 1 1 2 -1 -1 0 0 -1 6.000 0 0 -1 0 0 2 - 18300 6300 18300 6600 -2 1 1 1 -1 -1 0 0 -1 6.000 0 0 -1 0 0 2 - 19800 6600 19800 14100 -2 1 0 2 -1 -1 0 0 -1 0.000 0 0 -1 0 0 2 - 10500 13500 19500 13500 -2 1 1 1 -1 -1 0 0 -1 4.000 0 0 -1 0 0 2 - 15000 12600 15000 14100 -2 1 1 1 -1 -1 0 0 -1 4.000 0 0 -1 0 0 2 - 10200 12600 10200 14100 -2 1 1 1 -1 -1 0 0 -1 4.000 0 0 -1 0 0 2 - 11700 12600 11700 14100 -2 1 1 2 -1 -1 0 0 -1 6.000 0 0 -1 0 0 2 - 12300 12300 12300 12600 -2 1 1 2 -1 -1 0 0 -1 6.000 0 0 -1 0 0 2 - 15600 12300 15600 12600 -2 1 1 2 -1 -1 0 0 -1 6.000 0 0 -1 0 0 2 - 10800 12300 10800 12600 -2 1 1 2 -1 -1 0 0 -1 6.000 0 0 -1 1 0 2 - 0 0 2.00 135.00 255.00 - 3300 3300 3300 3900 -2 1 1 2 -1 -1 0 0 -1 6.000 0 0 -1 0 0 2 - 12600 6600 12600 6300 -2 1 1 1 -1 -1 0 0 -1 4.000 0 0 -1 0 0 2 - 10200 14100 19800 14100 -4 0 -1 0 0 0 20 0.0000000 0 195 690 18000 6900 ICOR\001 -4 0 -1 0 0 0 20 0.0000000 0 195 1665 18000 7200 Interferometer\001 -4 0 -1 0 0 0 20 0.0000000 0 195 780 6900 6900 TCOR\001 -4 0 -1 0 0 0 20 0.0000000 0 255 1155 6900 7200 Tel. gn/ph\001 -4 0 -1 0 0 0 20 0.0000000 0 195 1260 6900 7500 corrections\001 -4 0 -1 0 0 0 19 0.0000000 0 195 735 8700 9000 TPON\001 -4 0 -1 0 0 0 19 0.0000000 0 270 1185 8700 9300 Tot.pwr w.\001 -4 0 -1 0 0 0 19 0.0000000 0 135 1020 8700 9600 ns src. on\001 -4 0 -1 0 0 0 19 0.0000000 0 195 870 10500 9000 TPOFF\001 -4 0 -1 0 0 0 19 0.0000000 0 270 1185 10500 9300 Tot.pwr w.\001 -4 0 -1 0 0 0 19 0.0000000 0 195 1050 10500 9600 ns src. off\001 -4 0 -1 0 0 0 19 0.0000000 0 195 915 12300 9000 TNOISI\001 -4 0 -1 0 0 0 19 0.0000000 0 195 1050 12300 9300 Noise src.\001 -4 0 -1 0 0 0 19 0.0000000 0 240 630 12300 9600 temp.\001 -4 0 -1 0 0 2 20 0.0000000 0 195 1920 7500 10200 TELESCOPES\001 -4 0 -1 0 0 0 19 0.0000000 0 240 630 13800 9600 temp.\001 -4 0 -1 0 0 0 19 0.0000000 0 270 795 13800 9300 System\001 -4 0 -1 0 0 0 19 0.0000000 0 195 660 13800 9000 TSYS\001 -4 0 -1 0 0 0 19 0.0000000 0 240 1380 15000 9600 temperature\001 -4 0 -1 0 0 0 19 0.0000000 0 195 750 15000 9000 TSYSI\001 -4 0 -1 0 0 0 19 0.0000000 0 270 1215 15000 9300 Const. syst.\001 -4 0 -1 0 0 0 20 0.0000000 0 255 885 5400 7500 weights\001 -4 0 -1 0 0 0 20 0.0000000 0 195 660 5400 7200 Visib.\001 -4 0 -1 0 0 0 20 0.0000000 0 195 1140 5400 6900 WEIGHT\001 -4 0 -1 0 0 0 20 0.0000000 0 195 1035 3900 6900 MODEL\001 -4 0 -1 0 0 0 20 0.0000000 0 195 720 3900 7200 Model\001 -4 0 -1 0 0 0 20 0.0000000 0 195 585 3900 7500 visib.\001 -4 0 -1 0 0 0 20 0.0000000 0 195 810 2700 6900 DATA\001 -4 0 -1 0 0 0 20 0.0000000 0 195 660 2700 7200 Visib.\001 -4 0 -1 0 0 2 20 0.0000000 0 255 2340 2700 6000 EXTRACT_TYPE\001 -4 0 -1 0 0 0 20 0.0000000 0 255 1440 5400 6000 Type of data\001 -4 0 -1 0 0 2 20 0.0000000 0 255 1920 2700 5400 SELECT_XYX\001 -4 0 -1 0 0 2 20 0.0000000 0 255 1440 2700 5100 SCN_SETS\001 -4 0 -1 0 0 2 20 0.0000000 0 255 1560 2700 4800 SCN_NODE\001 -4 0 -1 0 0 0 20 0.0000000 0 195 1350 2700 4200 EXTRACT\001 -4 0 -1 0 0 0 20 0.0000000 0 195 3165 4500 4200 Extract cuts from .SCN file\001 -4 0 -1 0 0 0 20 0.0000000 0 255 1440 18000 7500 gn/ph corrns\001 -4 0 -1 0 0 0 20 0.0000000 0 255 2085 15300 13200 constant rcvr gain\001 -4 0 -1 0 0 0 20 0.0000000 0 195 1005 15300 12900 RGAINI\001 -4 0 -1 0 0 0 20 0.0000000 0 195 720 10500 12900 GAIN\001 -4 0 -1 0 0 0 20 0.0000000 0 255 930 10500 13200 IF gains\001 -4 0 -1 0 0 0 20 0.0000000 0 195 1005 12000 12900 GNCAL\001 -4 0 -1 0 0 0 20 0.0000000 0 255 2655 12000 13200 gain correction method\001 -4 0 -1 0 0 2 20 0.0000000 0 195 2955 13500 13800 INTERFEROMETERS\001 -4 0 -1 0 0 2 20 0.0000000 0 195 1140 3300 3300 OPTION\001 -4 0 -1 0 0 3 20 0.0000000 0 270 525 2700 3300 from\001 -4 0 -1 0 0 2 20 0.0000000 0 255 1320 12300 8100 IF_MODE\001 -4 0 -1 0 0 0 20 0.0000000 0 225 1275 12300 7500 parameters\001 -4 0 -1 0 0 0 20 0.0000000 0 195 1065 12300 6900 IFDATA\001 -4 0 -1 0 0 0 20 0.0000000 0 255 1845 12300 7200 Gain/syst. temp.\001 -4 0 -1 0 0 0 10 0.0000000 0 150 1440 16800 4200 ngcalc_extract.fig 45%\001 diff --git a/src/doc/fig/ngcalc_interface.cap b/src/doc/fig/ngcalc_interface.cap deleted file mode 100644 index fb5c7b4aa962651f366b409b26c4ade4b1dc777d..0000000000000000000000000000000000000000 --- a/src/doc/fig/ngcalc_interface.cap +++ /dev/null @@ -1,36 +0,0 @@ -%ngcalc_interface.cap - -\begin{figure}[htbp] -\fig{ngcalc_interface} - -\caption{\it -\label{.ngcalc.interface} -Overview of NGCALC's parameter interface. -\\ -\\ See also: -\\ \indent \figref{.ngcalc.extract} for details of the {\em EXTRACT} operation -\\ \indent \figref{.ngcalc.display} for details of the display operations -} -\end{figure} - -\begin{figure}[htbp] -\fig{ngcalc_extract} - -\caption{\it -\label{.ngcalc.extract} -NGCALC's cut-extract interface. -\\ -\\ See \figref{.ngcalc.interface} for the overall interface. -} -\end{figure} - -\begin{figure}[htbp] -\fig{ngcalc_display} - -\caption{\it -\label{.ngcalc.display} -NGCALC's header/data display interface. -\\ -\\ See \figref{.ngcalc.interface} for the overall interface. -} -\end{figure} diff --git a/src/doc/fig/ngcalc_interface.fig b/src/doc/fig/ngcalc_interface.fig deleted file mode 100644 index a717407525b09757d385584af0b0806353713559..0000000000000000000000000000000000000000 --- a/src/doc/fig/ngcalc_interface.fig +++ /dev/null @@ -1,220 +0,0 @@ -#FIG 3.1 -Portrait -Center -Inches -1200 2 -2 1 1 1 -1 -1 0 0 -1 4.000 0 0 -1 0 0 2 - 3300 7200 3300 10200 -2 1 1 2 -1 -1 0 0 -1 6.000 0 0 -1 0 0 2 - 3900 7200 3900 6900 -2 1 1 1 -1 -1 0 0 -1 4.000 0 0 -1 0 0 2 - 5400 7200 5400 10200 -2 1 1 2 -1 -1 0 0 -1 6.000 0 0 -1 0 0 2 - 6000 7200 6000 6900 -2 1 1 1 -1 -1 0 0 -1 4.000 0 0 -1 0 0 2 - 3300 11100 3300 12000 -2 1 1 1 -1 -1 0 0 -1 4.000 0 0 -1 0 0 2 - 7500 11100 7500 12000 -2 1 1 2 -1 -1 0 0 -1 6.000 0 0 -1 0 0 3 - 3900 11100 3900 10800 2700 10800 -2 1 1 1 -1 -1 0 0 -1 4.000 0 0 -1 0 0 2 - 3300 22800 3300 24600 -2 1 1 1 -1 -1 0 0 -1 4.000 0 0 -1 0 0 2 - 6900 22800 6900 24600 -2 1 1 2 -1 -1 0 0 -1 6.000 0 0 -1 0 0 2 - 3900 22500 3900 22800 -2 1 1 2 -1 -1 0 0 -1 6.000 0 0 -1 0 0 2 - 14700 22500 2700 22500 -2 1 1 2 -1 -1 0 0 -1 6.000 0 0 -1 0 0 2 - 7500 22500 7500 22800 -2 1 1 2 -1 -1 0 0 -1 6.000 0 0 -1 0 0 2 - 3600 12300 15300 12300 -2 1 1 1 -1 -1 0 0 -1 4.000 0 0 -1 0 0 2 - 6300 12600 6300 14100 -2 1 1 1 -1 -1 0 0 -1 4.000 0 0 -1 0 0 2 - 11100 12600 11100 14100 -2 1 1 1 -1 -1 0 0 -1 4.000 0 0 -1 0 0 2 - 14700 12600 14700 14100 -2 1 1 1 -1 -1 0 0 -1 4.000 0 0 -1 0 0 2 - 16800 12600 16800 14100 -2 1 1 2 -1 -1 0 0 -1 6.000 0 0 -1 0 0 2 - 4800 12300 4800 12600 -2 1 1 2 -1 -1 0 0 -1 6.000 0 0 -1 0 0 2 - 6900 12300 6900 12600 -2 1 1 2 -1 -1 0 0 -1 6.000 0 0 -1 0 0 2 - 11700 12300 11700 12600 -2 1 1 2 -1 -1 0 0 -1 6.000 0 0 -1 0 0 2 - 15300 12300 15300 12600 -2 1 1 2 -1 -1 0 0 -1 6.000 0 0 -1 0 0 1 - 3900 12000 -2 1 1 1 -1 -1 0 0 -1 4.000 0 0 -1 0 0 2 - 4200 12600 4200 13500 -2 1 1 2 -1 -1 0 0 -1 6.000 0 0 -1 0 0 2 - 3600 12300 3600 15600 -2 1 0 2 -1 -1 0 0 -1 0.000 0 0 -1 0 0 2 - 4500 17100 11400 17100 -2 1 1 1 -1 -1 0 0 -1 4.000 0 0 -1 0 0 2 - 7500 15900 7500 18000 -2 1 1 1 -1 -1 0 0 -1 4.000 0 0 -1 0 0 2 - 11700 15900 11700 18000 -2 1 1 1 -1 -1 0 0 -1 4.000 0 0 -1 0 0 1 - 4200 15900 -2 1 1 1 -1 -1 0 0 -1 4.000 0 0 -1 0 0 2 - 4200 15900 4200 18000 -2 1 1 1 -1 -1 0 0 -1 4.000 0 0 -1 0 0 2 - 15000 15900 15000 18000 -2 1 1 2 -1 -1 0 0 -1 6.000 0 0 -1 0 0 2 - 4800 15900 4800 15600 -2 1 1 2 -1 -1 0 0 -1 6.000 0 0 -1 0 0 2 - 8100 15900 8100 15600 -2 1 1 2 -1 -1 0 0 -1 6.000 0 0 -1 0 0 2 - 12300 15900 12300 15600 -2 1 1 2 -1 -1 0 0 -1 6.000 0 0 -1 0 0 2 - 3600 15600 12300 15600 -2 1 1 2 -1 -1 0 0 -1 6.000 0 0 -1 1 0 2 - 0 0 2.00 135.00 255.00 - 2700 4200 4200 4200 -2 1 1 2 -1 -1 0 0 -1 6.000 0 0 -1 0 0 2 - 2700 6900 6000 6900 -2 1 1 1 -1 -1 0 0 -1 4.000 0 0 -1 0 0 2 - 9300 22800 9300 24600 -2 1 1 2 -1 -1 0 0 -1 6.000 0 0 -1 0 0 2 - 9900 22500 9900 22800 -2 1 1 1 -1 -1 0 0 -1 4.000 0 0 -1 0 0 2 - 14100 22800 14100 24600 -2 1 1 2 -1 -1 0 0 -1 6.000 0 0 -1 0 0 2 - 14700 22500 14700 22800 -2 1 1 1 -1 -1 0 0 -1 4.000 0 0 -1 0 0 2 - 16500 22800 16500 24600 -2 1 1 1 -1 -1 0 0 -1 4.000 0 0 -1 0 0 2 - 11700 22800 11700 24600 -2 1 1 2 -1 -1 0 0 -1 6.000 0 0 -1 0 0 2 - 12300 22500 12300 22800 -2 1 1 2 -1 -1 0 0 -1 6.000 0 0 -1 1 0 2 - 0 0 2.00 135.00 255.00 - 2700 20100 5400 20100 -2 2 1 1 -1 -1 0 0 -1 4.000 0 0 0 0 0 5 - 6000 4500 6000 3600 4200 3600 4200 4500 6000 4500 -2 2 1 1 -1 -1 0 0 -1 4.000 0 0 0 0 0 5 - 7800 21000 7800 19200 5400 19200 5400 21000 7800 21000 -2 1 1 1 -1 -1 0 0 -1 4.000 0 0 -1 0 0 2 - 4200 18000 15000 18000 -2 1 1 1 -1 -1 0 0 -1 4.000 0 0 -1 0 0 2 - 4200 13500 6300 13500 -2 1 1 1 -1 -1 0 0 -1 4.000 0 0 -1 0 0 2 - 6300 14100 16800 14100 -2 1 1 1 -1 -1 0 0 -1 4.000 0 0 -1 0 0 2 - 3300 10200 10500 10200 -2 1 1 1 -1 -1 0 0 -1 4.000 0 0 -1 0 0 2 - 14100 24600 16500 24600 -2 1 1 2 -1 -1 0 0 -1 6.000 0 0 -1 0 0 2 - 2700 22500 2700 3900 -2 1 1 1 -1 -1 0 0 -1 4.000 0 0 -1 0 0 2 - 3300 24600 14100 24600 -2 1 1 2 -1 -1 0 0 -1 6.000 0 0 -1 0 0 2 - 11100 5700 11100 7200 -2 1 1 2 -1 -1 0 0 -1 6.000 0 0 -1 0 0 2 - 14400 5700 14400 7200 -2 1 0 2 -1 -1 0 0 -1 0.000 0 0 -1 0 0 2 - 10800 8400 16500 8400 -2 1 1 1 -1 -1 0 0 -1 4.000 0 0 -1 0 0 2 - 13500 7200 13500 10200 -2 1 1 1 -1 -1 0 0 -1 4.000 0 0 -1 0 0 2 - 16800 7200 16800 10200 -2 1 1 1 -1 -1 0 0 -1 4.000 0 0 -1 0 0 2 - 10500 10200 16800 10200 -2 1 1 1 -1 -1 0 0 -1 4.000 0 0 -1 0 0 2 - 10500 7200 10500 10200 -2 1 1 2 -1 -1 0 0 -1 6.000 0 0 -1 0 0 2 - 2700 5700 14400 5700 -4 0 -1 0 0 2 20 0.0000000 0 255 1740 3600 12000 CALC_TYPE\001 -4 0 -1 0 0 0 20 0.0000000 0 195 780 3600 11400 CALC\001 -4 0 -1 0 0 0 20 0.0000000 0 195 2385 4800 11400 Perform calculations\001 -4 0 -1 0 0 0 20 0.0000000 0 195 1020 3600 7500 MERGE\001 -4 0 -1 0 0 2 20 0.0000000 0 255 1470 3600 8100 NGF_SETS\001 -4 0 -1 0 0 0 20 0.0000000 0 255 1620 3600 8400 Cuts to merge\001 -4 0 -1 0 0 0 20 0.0000000 0 195 1335 5700 7500 COMBINE\001 -4 0 -1 0 0 2 20 0.0000000 0 195 1860 5700 8100 EXPRESSION\001 -4 0 -1 0 0 0 20 0.0000000 0 255 2535 7800 8100 Combining expression\001 -4 0 -1 0 0 2 20 0.0000000 0 255 2175 6000 9000 USE_NGF_SETS\001 -4 0 -1 0 0 2 20 0.0000000 0 255 1740 5700 9900 NGF_LOOPS\001 -4 0 -1 0 0 3 20 0.0000000 0 270 3345 5700 8700 For each #<n> in expression:\001 -4 0 -1 0 0 3 20 0.0000000 0 270 2685 6300 15300 Polynomial fit / subtract\001 -4 0 -1 0 0 2 20 0.0000000 0 255 2940 3600 24000 OUTPUT_NGF_NODE\001 -4 0 -1 0 0 0 20 0.0000000 0 195 780 3600 23100 COPY\001 -4 0 -1 0 0 0 10 0.0000000 0 150 1530 14700 4200 ngcalc_interface.fig 45%\001 -4 0 -1 0 0 0 20 0.0000000 0 255 3240 6000 9300 1 cut for #<n> in expression\001 -4 0 -1 0 0 0 20 0.0000000 0 195 1230 6600 12900 SMOOTH\001 -4 0 -1 0 0 0 20 0.0000000 0 255 3900 6600 13200 Convolve with triangular window\001 -4 0 -1 0 0 2 20 0.0000000 0 255 1590 6600 13800 HA_WIDTH\001 -4 0 -1 0 0 0 20 0.0000000 0 195 2325 8400 13800 Window half-width\001 -4 0 -1 0 0 0 20 0.0000000 0 195 810 11400 12900 SHIFT\001 -4 0 -1 0 0 2 20 0.0000000 0 195 870 11400 13800 SHIFT\001 -4 0 -1 0 0 0 20 0.0000000 0 255 2850 11400 13200 Shift to new sky position\001 -4 0 -1 0 0 0 20 0.0000000 0 195 780 15000 12900 NULL\001 -4 0 -1 0 0 0 20 0.0000000 0 240 1050 12600 13800 l,m shifts\001 -4 0 -1 0 0 0 20 0.0000000 0 255 1500 15000 13200 Delete points\001 -4 0 -1 0 0 0 20 0.0000000 0 195 1395 4500 12900 AVERAGE\001 -4 0 -1 0 0 2 20 0.0000000 0 255 1620 15000 13800 HA_RANGE\001 -4 0 -1 0 0 0 20 0.0000000 0 195 765 4500 16200 POLY\001 -4 0 -1 0 0 0 20 0.0000000 0 255 2565 4500 16800 Nth-order polynomial\001 -4 0 -1 0 0 0 20 0.0000000 0 195 1830 4500 16500 Fit and subtract\001 -4 0 -1 0 0 0 20 0.0000000 0 195 960 7800 16200 CPOLY\001 -4 0 -1 0 0 0 20 0.0000000 0 195 1830 7800 16500 Fit and subtract\001 -4 0 -1 0 0 0 20 0.0000000 0 255 3525 7800 16800 polynomial with N coefficients\001 -4 0 -1 0 0 2 20 0.0000000 0 255 1155 5400 17400 POLY_N\001 -4 0 -1 0 0 0 20 0.0000000 0 195 3240 7200 17400 Number of coefficients to fit\001 -4 0 -1 0 0 0 20 0.0000000 0 195 975 12000 16200 DPOLY\001 -4 0 -1 0 0 0 20 0.0000000 0 255 2340 12000 16500 Subtract polynomial\001 -4 0 -1 0 0 2 20 0.0000000 0 255 1935 12000 17400 POLY_COEFF\001 -4 0 -1 0 0 0 20 0.0000000 0 255 2850 12000 17700 Polynomial's coefficients\001 -4 0 -1 0 0 2 20 0.0000000 0 255 1515 5400 17700 POLY_USE\001 -4 0 -1 0 0 0 20 0.0000000 0 195 3075 7200 17700 Orders of coefficients to fit\001 -4 0 -1 0 0 0 20 0.0000000 0 195 1350 4500 4200 EXTRACT\001 -4 0 -1 0 0 3 20 0.0000000 0 270 2370 6300 4200 see companion figure\001 -4 0 -1 0 0 0 10 0.0000000 0 105 645 4200 10800 NGCCAL\001 -4 0 -1 0 0 0 10 0.0000000 0 105 630 6300 6900 NGCCOB\001 -4 0 -1 0 0 0 20 0.0000000 0 255 3090 3600 23400 Copy cuts to other file/cuts\001 -4 0 -1 0 0 0 20 0.0000000 0 255 1620 4500 13200 Show average\001 -4 0 -1 0 0 0 20 0.0000000 0 195 1110 7200 23100 DELETE\001 -4 0 -1 0 0 0 20 0.0000000 0 195 1275 7200 23400 Delete cuts\001 -4 0 -1 0 0 2 20 0.0000000 0 255 1470 7200 24000 NGF_SETS\001 -4 0 -1 0 0 2 20 0.0000000 0 255 1590 14400 24300 NGF_NODE\001 -4 0 -1 0 0 0 20 0.0000000 0 195 810 14400 23100 NODE\001 -4 0 -1 0 0 0 20 0.0000000 0 255 1995 14400 23400 Select new target\001 -4 0 -1 0 0 0 20 0.0000000 0 195 1080 14400 23700 .NGF file\001 -4 0 -1 0 0 0 20 0.0000000 0 195 615 12000 23100 CVX\001 -4 0 -1 0 0 0 20 0.0000000 0 195 1815 12000 23700 to host's format\001 -4 0 -1 0 0 0 20 0.0000000 0 195 1620 9600 23700 header format\001 -4 0 -1 0 0 0 20 0.0000000 0 255 825 9600 23400 Update\001 -4 0 -1 0 0 0 20 0.0000000 0 195 585 9600 23100 NVS\001 -4 0 -1 0 0 0 20 0.0000000 0 195 1500 12000 23400 Convert data\001 -4 0 -1 0 0 0 20 0.0000000 0 195 1095 5700 19800 MONGO\001 -4 0 -1 0 0 0 20 0.0000000 0 195 735 5700 20100 PLOT\001 -4 0 -1 0 0 0 20 0.0000000 0 240 1650 5700 20400 SHOW, EDIT\001 -4 0 -1 0 0 0 20 0.0000000 0 240 1695 5700 20700 BRIEF, FULL\001 -4 0 -1 0 0 3 20 0.0000000 0 270 2370 8100 20100 see companion figure\001 -4 0 -1 0 0 0 10 0.0000000 0 105 615 8400 23700 NGCDEL\001 -4 0 -1 0 0 0 10 0.0000000 0 105 630 6000 23700 NGCCOP\001 -4 0 -1 0 0 0 10 0.0000000 0 105 630 10800 24000 NGCCVS\001 -4 0 -1 0 0 0 10 0.0000000 0 105 675 13200 24000 NGCXCV\001 -4 0 -1 0 0 0 10 0.0000000 0 105 645 15600 24000 NGCDAT\001 -4 0 -1 0 0 2 20 0.0000000 0 195 1155 2100 3900 ACTION\001 -4 0 -1 0 0 0 10 0.0000000 0 105 645 2400 3000 NGCDAT\001 -4 0 -1 0 0 2 20 0.0000000 0 255 1590 2100 3300 NGF_NODE\001 -4 0 -1 0 0 3 20 0.0000000 0 210 900 3300 22200 Utilities\001 -4 0 -1 0 0 3 20 0.0000000 0 270 1425 3300 19800 Display, edit\001 -4 0 -1 0 0 3 20 0.0000000 0 210 2385 3300 6600 Parallel combination\001 -4 0 -1 0 0 0 10 0.0000000 0 135 2205 7800 7500 NNGCEXP, NGCEXC, NGCEXN\001 -4 0 -1 0 0 0 20 0.0000000 0 195 960 10800 7500 TRANS\001 -4 0 -1 0 0 0 20 0.0000000 0 255 2190 10800 8100 and frequency axes\001 -4 0 -1 0 0 0 20 0.0000000 0 255 2475 13800 7800 Transpose hour angle\001 -4 0 -1 0 0 0 20 0.0000000 0 195 2715 13800 8100 and interferometer axes\001 -4 0 -1 0 0 0 20 0.0000000 0 255 2475 10800 7800 Transpose hour angle\001 -4 0 -1 0 0 0 20 0.0000000 0 195 750 13800 7500 BASE\001 -4 0 -1 0 0 2 20 0.0000000 0 255 1620 12600 9300 HA_RANGE\001 -4 0 -1 0 0 2 20 0.0000000 0 255 1470 12600 9000 NGF_SETS\001 -4 0 -1 0 0 2 20 0.0000000 0 255 1740 12600 8700 NGF_LOOPS\001 -4 0 -1 0 0 0 10 0.0000000 0 105 615 12600 7500 NGCTRP\001 -4 0 -1 0 0 0 10 0.0000000 0 105 615 15900 7500 NGCBAS\001 -4 0 -1 0 0 3 20 0.0000000 0 255 1800 10800 5400 Transpose / Sort\001 diff --git a/src/doc/fig/ngf_scn_indices.cap b/src/doc/fig/ngf_scn_indices.cap deleted file mode 100644 index a32092371be18598e63e7d22d24e65c683ec88fe..0000000000000000000000000000000000000000 --- a/src/doc/fig/ngf_scn_indices.cap +++ /dev/null @@ -1,17 +0,0 @@ -%ngf_scn_indices.cap - -\begin{figure}[htbp] - -\fig{ngf_scn_indices} - -\caption{\it -\label{.ngf.scn.indices} -Derivation of .NGF-file cut indices from .SCN-file sector indices -\\ -This diagram schematically indicates how the cut indices in the .NGF file are -related to the sector indices in the .SCN file, - which in turn are derived -from the hierarchical structure of the WSRT observation file. -} -\end{figure} - - diff --git a/src/doc/fig/ngf_scn_indices.fig b/src/doc/fig/ngf_scn_indices.fig deleted file mode 100644 index a5cc8e89547d6d2495a373cfec0d5f9f376d4869..0000000000000000000000000000000000000000 --- a/src/doc/fig/ngf_scn_indices.fig +++ /dev/null @@ -1,59 +0,0 @@ -#FIG 3.1 -Portrait -Center -Inches -1200 2 -2 2 0 2 -1 -1 0 0 -1 0.000 0 0 0 0 0 5 - 12300 5400 12300 4500 5700 4500 5700 5400 12300 5400 -2 2 0 2 -1 -1 0 0 -1 0.000 0 0 0 0 0 5 - 12300 2700 12300 600 5700 600 5700 2700 12300 2700 -2 2 0 2 -1 -1 0 0 -1 0.000 0 0 0 0 0 5 - 12300 9300 12300 8400 5700 8400 5700 9300 12300 9300 -2 1 1 2 -1 -1 0 0 -1 6.000 0 0 7 1 0 3 - 0 0 2.00 135.00 255.00 - 12600 7500 7200 7500 7200 8700 -2 1 1 2 -1 -1 0 0 -1 6.000 0 0 7 1 0 2 - 0 0 2.00 135.00 255.00 - 7200 1200 7200 4800 -2 1 1 2 -1 -1 0 0 -1 6.000 0 0 7 1 0 2 - 0 0 2.00 135.00 255.00 - 8100 1800 8100 4800 -2 1 1 2 -1 -1 0 0 -1 6.000 0 0 7 1 0 2 - 0 0 2.00 135.00 255.00 - 9000 2400 9000 4800 -2 1 1 2 -1 -1 0 0 -1 6.000 0 0 7 1 0 3 - 0 0 2.00 135.00 255.00 - 12600 6300 9900 6300 9900 8700 -2 1 1 2 -1 -1 0 0 -1 6.000 0 0 7 1 0 2 - 0 0 2.00 135.00 255.00 - 9000 5100 9000 8700 -2 1 1 2 -1 -1 0 0 -1 6.000 0 0 7 1 0 2 - 0 0 2.00 135.00 255.00 - 8100 5100 8100 8700 -2 1 1 2 -1 -1 0 0 -1 6.000 0 0 7 1 0 3 - 0 0 2.00 135.00 255.00 - 12600 6600 10800 6600 10800 8700 -2 1 1 2 -1 -1 0 0 -1 6.000 0 0 7 1 0 3 - 0 0 2.00 135.00 255.00 - 12600 7800 11700 7800 11700 8700 -2 1 1 2 -1 -1 0 0 -1 6.000 0 0 7 1 0 3 - 0 0 2.00 135.00 255.00 - 12600 3900 9900 3900 9900 4800 -2 1 1 2 -1 -1 0 0 -1 6.000 0 0 7 1 0 5 - 0 0 2.00 135.00 255.00 - 12600 3600 6300 3600 6300 3600 6300 4500 6300 4800 -4 0 -1 0 0 0 20 0.0000000 0 255 4320 6000 5100 <grp>. <obs>. <fld>. <chn>. <seq>\001 -4 0 -1 0 0 0 20 0.0000000 0 195 2325 7800 1800 mosaic field number\001 -4 0 -1 0 0 0 20 0.0000000 0 255 2490 8700 2400 channel/band number\001 -4 0 -1 0 0 0 20 0.0000000 0 255 2985 6900 1200 observation (OH) number\001 -4 0 -1 0 0 0 20 0.0000000 0 255 2445 12900 6300 derived by NGCALC\001 -4 0 -1 0 0 0 20 0.0000000 0 195 2640 12900 6600 from data "coodinates"\001 -4 0 -1 0 0 0 20 0.0000000 0 255 5160 6900 9000 <grp>. <fld>. <chn>. <pol>. <iort>. <seq>\001 -4 0 -1 0 0 0 20 0.0000000 0 255 3585 12900 7500 automatic sequential allocation\001 -4 0 -1 0 0 0 20 0.0000000 0 255 1545 13500 7800 by NGCALC\001 -4 0 -1 0 0 0 20 0.0000000 0 195 1140 3600 4800 .SCN file:\001 -4 0 -1 0 0 0 20 0.0000000 0 195 2640 2700 1500 WSRT observation file\001 -4 0 -1 0 0 0 20 0.0000000 0 195 1155 3600 8700 .NGF file:\001 -4 0 -1 0 0 0 20 0.0000000 0 255 3585 12900 3600 automatic sequential allocation\001 -4 0 -1 0 0 0 20 0.0000000 0 255 1335 13500 3900 by NSCAN\001 -4 0 -1 0 0 0 10 0.0000000 0 150 1500 15000 900 ngf_scn_indices.fig 50%\001 diff --git a/src/doc/fig/ngids_interface.cap b/src/doc/fig/ngids_interface.cap deleted file mode 100644 index 54602e6d48ac2dc4d6e20ffac038e7ea28468e95..0000000000000000000000000000000000000000 --- a/src/doc/fig/ngids_interface.cap +++ /dev/null @@ -1,11 +0,0 @@ -%ngids_interface.tex -\begin{figure}[hbtp] - -%\fig{ngids_interface} -% -\caption{\it -\label{.ngids.interface} -Overview of the actions in NGIDS. -} - -\end{figure} diff --git a/src/doc/fig/nhyper_overview.fig b/src/doc/fig/nhyper_overview.fig deleted file mode 100644 index 4d4e545ff8da03e27199069c9c8dc29d873e513f..0000000000000000000000000000000000000000 --- a/src/doc/fig/nhyper_overview.fig +++ /dev/null @@ -1,93 +0,0 @@ -#FIG 3.1 -Portrait -Center -Inches -1200 2 -6 9000 11700 14400 13500 -2 1 1 2 -1 -1 0 0 -1 6.000 0 0 7 1 0 2 - 0 0 2.00 135.00 255.00 - 9300 13200 10200 13200 -2 1 0 2 -1 -1 0 0 -1 0.000 0 0 7 1 1 2 - 0 0 2.00 135.00 255.00 - 0 0 2.00 135.00 255.00 - 9300 12600 10200 12600 -4 0 -1 0 0 0 20 0.0000000 0 255 915 9000 12000 Legend:\001 -4 0 -1 0 0 0 20 0.0000000 0 255 3765 10500 12600 hypertext links in both directions\001 -4 0 -1 0 0 0 20 0.0000000 0 255 2130 10500 13200 one-way link only\001 --6 -1 3 2 2 -1 -1 0 0 -1 4.5000000 1 0.000 7200 9000 1800 1800 7200 9000 9000 9000 -2 1 1 2 -1 -1 0 0 -1 6.000 0 0 7 1 0 4 - 0 0 2.00 135.00 255.00 - 10500 8700 8700 8700 8700 8100 12600 8100 -2 1 1 2 -1 -1 0 0 -1 6.000 0 0 7 1 0 4 - 0 0 2.00 135.00 255.00 - 10500 9300 8700 9300 8700 9900 12600 9900 -2 1 1 2 -1 -1 0 0 -1 6.000 0 0 7 1 0 4 - 0 0 2.00 135.00 255.00 - 4800 8100 6000 8100 6000 8100 4800 6600 -2 1 1 2 -1 -1 0 0 -1 6.000 0 0 7 1 0 4 - 0 0 2.00 135.00 255.00 - 4800 9900 5400 9900 6000 9900 4500 11400 -2 1 1 2 -1 -1 0 0 -1 6.000 0 0 7 0 0 1 - 3000 9000 -2 2 0 2 -1 -1 0 0 -1 0.000 0 0 7 0 0 5 - 5700 6600 5700 5400 3000 5400 3000 6600 5700 6600 -2 2 0 2 -1 -1 0 0 -1 0.000 0 0 7 0 0 5 - 4800 8700 4800 7500 1500 7500 1500 8700 4800 8700 -2 2 0 2 -1 -1 0 0 -1 0.000 0 0 7 0 0 5 - 4800 10500 4800 9300 1500 9300 1500 10500 4800 10500 -2 2 0 2 -1 -1 0 0 -1 0.000 0 0 7 0 0 5 - 5700 12600 5700 11400 3000 11400 3000 12600 5700 12600 -2 2 0 2 -1 -1 0 0 -1 0.000 0 0 7 0 0 5 - 14400 8700 14400 7800 12600 7800 12600 8700 14400 8700 -2 2 0 2 -1 -1 0 0 -1 0.000 0 0 7 0 0 5 - 12000 9600 12000 8400 10500 8400 10500 9600 12000 9600 -2 2 0 2 -1 -1 0 0 -1 0.000 0 0 7 0 0 5 - 14400 10200 14400 9300 12600 9300 12600 10200 14400 10200 -2 1 0 2 -1 -1 0 0 -1 0.000 0 0 7 1 1 2 - 0 0 2.00 135.00 255.00 - 0 0 2.00 135.00 255.00 - 5400 6600 6300 8100 -2 1 0 2 -1 -1 0 0 -1 0.000 0 0 7 1 1 3 - 0 0 2.00 135.00 255.00 - 0 0 2.00 135.00 255.00 - 10500 5400 9900 5400 7500 8100 -2 1 0 2 -1 -1 0 0 -1 0.000 0 0 7 1 1 3 - 0 0 2.00 135.00 255.00 - 0 0 2.00 135.00 255.00 - 10500 6600 9900 6600 8100 8100 -2 1 0 2 -1 -1 0 0 -1 0.000 0 0 7 1 1 2 - 0 0 2.00 135.00 255.00 - 0 0 2.00 135.00 255.00 - 10500 9000 8400 9000 -2 1 0 2 -1 -1 0 0 -1 0.000 0 0 7 1 1 2 - 0 0 2.00 135.00 255.00 - 0 0 2.00 135.00 255.00 - 7200 9900 6300 13500 -2 1 0 2 -1 -1 0 0 -1 0.000 0 0 7 1 1 2 - 0 0 2.00 135.00 255.00 - 0 0 2.00 135.00 255.00 - 5100 11400 6300 9900 -2 2 0 2 -1 -1 0 0 -1 0.000 0 0 0 0 0 5 - 14100 5700 14100 4800 10500 4800 10500 5700 14100 5700 -2 2 0 2 -1 -1 0 0 -1 0.000 0 0 0 0 0 5 - 14100 6900 14100 6000 10500 6000 10500 6900 14100 6900 -2 2 0 2 -1 -1 0 0 -1 0.000 0 0 7 0 0 5 - 6900 14400 6900 13500 4500 13500 4500 14400 6900 14400 -4 0 -1 0 0 0 20 0.0000000 0 255 840 10800 9300 caption\001 -4 0 -1 0 0 0 20 0.0000000 0 255 1020 12900 8400 Diagram\001 -4 0 -1 0 0 0 20 0.0000000 0 195 825 12900 9900 Picture\001 -4 0 -1 0 0 0 20 0.0000000 0 255 750 10800 9000 Figure\001 -4 0 -1 0 0 0 20 0.0000000 0 255 1080 6600 9000 hypertext\001 -4 0 -1 0 0 0 20 0.0000000 0 195 540 6900 9300 links\001 -4 0 -1 0 0 0 20 0.0000000 0 255 2460 1800 8100 NEWSTAR program\001 -4 0 -1 0 0 0 20 0.0000000 0 255 1875 2100 8400 keyword prompt\001 -4 0 -1 0 0 0 20 0.0000000 0 255 2235 1800 9900 "nhyper" command\001 -4 0 -1 0 0 0 20 0.0000000 0 195 1740 2100 10200 from unix shell\001 -4 0 -1 0 0 0 20 0.0000000 0 195 1890 3300 12000 Lists of contents\001 -4 0 -1 0 0 0 20 0.0000000 0 255 2055 3300 6000 Program keyword\001 -4 0 -1 0 0 0 20 0.0000000 0 255 1245 3600 6300 description\001 -4 0 -1 0 0 0 20 0.0000000 0 255 3015 10800 5400 LaTeX documents (.html)\001 -4 0 -1 0 0 0 20 0.0000000 0 255 2790 10800 6600 ASCII Documents (.txt)\001 -4 0 -1 0 0 0 20 0.0000000 0 255 1350 5100 14100 Bug reports\001 -4 0 -1 0 0 4 10 0.0000000 0 150 1785 12600 14400 nhyper_overview.fig 60%\001 diff --git a/src/doc/fig/nmap_handle.cap b/src/doc/fig/nmap_handle.cap deleted file mode 100644 index d318b24ce9c3c7f4b850c3a5c23ce2f2db43efa5..0000000000000000000000000000000000000000 --- a/src/doc/fig/nmap_handle.cap +++ /dev/null @@ -1,10 +0,0 @@ -%nmap_handle.tex - -\begin{figure}[hbt] -\fig{nmap_handle} - -\caption{\it -\label{.nmap.handle} -Overview of NMAP's map-handling interface. -} -\end{figure} diff --git a/src/doc/fig/nmap_handle.fig b/src/doc/fig/nmap_handle.fig deleted file mode 100644 index b8c9b905330ea07dc97d6f8fdbc7b7d9a4722ade..0000000000000000000000000000000000000000 --- a/src/doc/fig/nmap_handle.fig +++ /dev/null @@ -1,40 +0,0 @@ -#FIG 3.1 -Portrait -Center -Inches -1200 2 -6 6000 1800 15900 3600 -6 6000 2400 8100 3300 -4 0 -1 0 0 0 20 0.0000000 0 195 1035 6000 2700 FIDDLE\001 -4 0 -1 0 0 0 20 0.0000000 0 255 1635 6000 3300 combine maps\001 -4 0 -1 0 0 0 20 0.0000000 0 255 1815 6000 3000 Manipulate and\001 --6 -2 1 1 2 -1 -1 0 0 -1 6.000 0 0 -1 0 0 1 - 14100 2100 -2 1 1 2 -1 -1 0 0 -1 6.000 0 0 -1 0 0 1 - 14100 2400 -2 1 1 2 -1 -1 0 0 -1 6.000 0 0 -1 0 0 2 - 14100 2100 14100 2400 -2 1 1 2 -1 -1 0 0 -1 6.000 0 0 -1 0 0 2 - 9000 2100 9000 2400 -2 1 1 2 -1 -1 0 0 -1 6.000 0 0 -1 0 0 2 - 12000 2100 12000 2400 -2 1 1 2 -1 -1 0 0 -1 6.000 0 0 -1 0 0 2 - 6600 2100 6600 2400 -4 0 -1 0 0 0 20 0.0000000 0 195 2190 13500 3300 format conversions\001 -4 0 -1 0 0 0 20 0.0000000 0 195 2205 13500 3000 Internal WMP-file\001 -4 0 -1 0 0 0 20 0.0000000 0 195 1005 8400 2700 xxxFITS\001 -4 0 -1 0 0 0 20 0.0000000 0 195 1005 11400 2700 xxxOLD\001 -4 0 -1 0 0 0 20 0.0000000 0 255 2820 8400 3000 Convert maps to various\001 -4 0 -1 0 0 0 20 0.0000000 0 195 2445 8400 3300 flavours of FITS files\001 -4 0 -1 0 0 0 20 0.0000000 0 195 1695 11400 3000 Convert WMP\001 -4 0 -1 0 0 0 20 0.0000000 0 255 1710 11400 3300 file to/from old\001 -4 0 -1 0 0 0 20 0.0000000 0 195 780 11400 3600 format\001 -4 0 -1 0 0 0 20 0.0000000 0 240 1335 13500 2700 CVX, NVS\001 --6 -2 1 1 1 -1 -1 0 0 -1 4.000 0 0 -1 0 0 2 - 13200 2400 13200 4500 -2 1 1 2 -1 -1 0 0 -1 6.000 0 0 -1 0 0 2 - 5100 2100 14100 2100 -4 0 -1 0 0 2 20 0.0000000 0 195 1140 6600 1800 OPTION\001 -4 0 -1 0 0 0 10 0.0000000 0 150 1335 12000 1200 nmap_handle.fig 50%\001 diff --git a/src/doc/fig/nmap_interface.cap b/src/doc/fig/nmap_interface.cap deleted file mode 100644 index 98683962e37353bcd1d54f8e7878833dd53aac04..0000000000000000000000000000000000000000 --- a/src/doc/fig/nmap_interface.cap +++ /dev/null @@ -1,60 +0,0 @@ -%nmap_interface.cap - -%\begin{figure}[htbp] - -%\fig{nmap_interface} - -%\caption{\it -%Overview of NMAP's parameter interface. -%\\ -%\\ See also companion figures: -%\\ \indent \figref{.nmap.make} and \figref{.nmap.make.q} for the map-making -%interface; -%\\ \indent \figref{.nmap.handle} for the {\em other} options. -%} -%\label{.nmap.interface} -%\end{figure} - - -\begin{figure}[htbp] - -\fig{nmap_make} - -\caption{\it -Overview of NMAP's map-making interface. -%This diagram expands the {\em other options} stub in \figref{.nmap.interface}. -\\ -\\ See \figref{.nmap.make.q} for the QMAPS and QDATS branches; by default, -these branches are bypassed. -\\ -\\ (The rightmost column in the diagram is irrelevant for map-making in NMAP.) -} -\label{.nmap.make} -\end{figure} - - -\begin{figure} -% The asterisks indicate parameters also prompted for in DATA CLEAN. These must -% be changed to confom with nmap_make.fig. - -\fig{nmap_make_q} - -\caption{\it -Overview of the optional detailed-question sequences of the map-making -interface. This diagram expands the {\em QMAPS} and {\em QDATAS} stubs in -\figref{.nmap.make}. -} -\label{.nmap.make.q} -\end{figure} - - -%\begin{figure} - -%\fig{nmap_handle} - -%\caption{\it -%Overview of NMAP's map-handling interface. This diagram expands the {\em other -%options} stub in \figref{.nmap.interface}. -%} -%\label{.nmap.handle} -%\end{figure} diff --git a/src/doc/fig/nmap_interface.fig b/src/doc/fig/nmap_interface.fig deleted file mode 100644 index adcedb77d04aa03c10bf512a16bd710ff22da47f..0000000000000000000000000000000000000000 --- a/src/doc/fig/nmap_interface.fig +++ /dev/null @@ -1,129 +0,0 @@ -#FIG 3.1 -Portrait -Center -Inches -1200 2 -2 1 1 2 -1 -1 0 0 -1 6.000 0 0 -1 0 0 2 - 3000 2700 3000 3000 -2 1 1 2 -1 -1 0 0 -1 6.000 0 0 -1 0 0 2 - 3000 2700 14400 2700 -2 1 0 2 -1 -1 0 0 -1 0.000 0 0 -1 0 0 2 - 2100 4500 13500 4500 -2 1 0 2 -1 -1 0 0 -1 0.000 0 0 -1 0 0 2 - 4800 6300 13500 6300 -2 1 1 1 -1 -1 0 0 -1 4.000 0 0 -1 0 0 2 - 4500 3000 4500 19200 -2 1 1 2 -1 -1 0 0 -1 6.000 0 0 -1 0 0 2 - 5700 7200 11400 7200 -2 1 1 2 -1 -1 0 0 -1 6.000 0 0 -1 0 0 2 - 5700 7200 5700 7500 -2 1 1 2 -1 -1 0 0 -1 6.000 0 0 -1 0 0 2 - 8400 7200 8400 7500 -2 1 1 2 -1 -1 0 0 -1 6.000 0 0 -1 0 0 2 - 11400 7200 11400 7500 -2 1 0 2 -1 -1 0 0 -1 0.000 0 0 -1 0 0 2 - 4800 8700 13500 8700 -2 1 0 2 -1 -1 0 0 -1 0.000 0 0 -1 0 0 2 - 7500 9300 13500 9300 -2 1 0 2 -1 -1 0 0 -1 0.000 0 0 -1 0 0 2 - 7500 9900 10200 9900 -2 1 0 2 -1 -1 0 0 -1 0.000 0 0 -1 0 0 2 - 10800 9900 13500 9900 -2 1 1 1 -1 -1 0 0 -1 4.000 0 0 -1 0 0 2 - 7200 7500 7200 19200 -2 1 1 1 -1 -1 0 0 -1 4.000 0 0 -1 0 0 2 - 10500 7500 10500 19200 -2 1 0 2 -1 -1 0 0 -1 0.000 0 0 -1 0 0 2 - 4800 10800 13500 10800 -2 2 2 2 -1 -1 0 0 0 4.500 0 0 0 0 0 5 - 2100 10800 2100 10800 2100 10800 2100 10800 2100 10800 -2 1 1 2 -1 -1 0 0 0 6.000 0 0 -1 0 0 2 - 8100 2700 8100 3000 -2 1 1 2 -1 -1 0 0 0 6.000 0 0 -1 0 0 2 - 14400 2700 14400 3000 -2 1 0 2 -1 -1 0 0 0 0.000 0 0 -1 0 0 2 - 2100 15900 13500 15900 -2 1 0 2 -1 -1 0 0 0 0.000 0 0 -1 0 0 2 - 4800 16500 13500 16500 -2 1 0 2 -1 -1 0 0 0 0.000 0 0 -1 0 0 2 - 2100 16500 4200 16500 -2 1 1 1 0 0 0 0 -1 4.000 0 0 -1 0 0 2 - 1800 3000 1800 19200 -2 1 1 1 0 0 0 0 -1 4.000 0 0 -1 0 0 2 - 13800 3000 13800 19200 -4 0 -1 0 0 0 20 0.0000000 0 195 1815 2400 3900 from NCLEAN\001 -4 0 -1 0 0 0 20 0.0000000 0 195 975 2400 3300 CLEAN\001 -4 0 -1 0 0 3 20 0.0000000 0 195 1095 2700 4200 LCL=true\001 -4 0 -1 0 0 0 20 0.0000000 0 195 870 10800 7800 IFRHA\001 -4 0 -1 0 0 0 20 0.0000000 0 195 1590 4800 7800 STANDARD\001 -4 0 -1 0 0 0 20 0.0000000 0 255 1965 5100 8400 U (hor), V (vert)\001 -4 0 -1 0 0 0 20 0.0000000 0 195 990 5100 8100 Gridded:\001 -4 0 -1 0 0 0 20 0.0000000 0 195 990 7800 7800 BASHA\001 -4 0 -1 0 0 2 20 0.0000000 0 255 2715 7500 6900 UV_COORDINATES\001 -4 0 -1 0 0 2 20 0.0000000 0 255 2490 7500 6600 USER_COMMENT\001 -4 0 -1 0 0 2 20 0.0000000 0 195 660 7500 6000 IFRS\001 -4 0 -1 0 0 2 20 0.0000000 0 255 1620 7500 5700 HA_RANGE\001 -4 0 -1 0 0 2 20 0.0000000 0 255 1440 7500 5400 SCN_SETS\001 -4 0 -1 0 0 2 20 0.0000000 0 255 1560 7500 5100 SCN_NODE\001 -4 0 -1 0 0 2 20 0.0000000 0 255 1710 7500 4800 SCN_LOOPS\001 -4 0 -1 0 0 2 20 0.0000000 0 255 2640 7500 10200 BAS_RESOLUTION\001 -4 0 -1 0 0 2 20 0.0000000 0 255 2565 10800 10200 IFR_RESOLUTION\001 -4 0 -1 0 0 2 20 0.0000000 0 255 2505 9300 9600 HA_RESOLUTION\001 -4 0 -1 0 0 2 20 0.0000000 0 255 1245 7500 11100 FT_SIZE \001 -4 0 -1 0 0 2 20 0.0000000 0 255 1425 7500 12000 OUT_SIZE\001 -4 0 -1 0 0 0 20 0.0000000 0 255 1155 8100 8400 HA (vert)\001 -4 0 -1 0 0 0 20 0.0000000 0 255 1650 8100 8100 Baseline (hor)\001 -4 0 -1 0 0 0 20 0.0000000 0 255 1155 11100 8400 HA (vert)\001 -4 0 -1 0 0 0 20 0.0000000 0 255 1920 11100 8100 Ifr number (hor)\001 -4 0 -1 0 0 2 20 0.0000000 0 255 1680 7500 12300 FIELD_SIZE\001 -4 0 -1 0 0 2 20 0.0000000 0 255 1545 7500 12600 GRID_SIZE\001 -4 0 -1 0 0 3 20 0.0000000 0 225 2265 7800 11400 Set FTSIZ, DODFT\001 -4 0 -1 0 0 3 20 0.0000000 0 195 1170 7800 12900 Set FIELD\001 -4 0 -1 0 0 2 20 0.0000000 0 255 1050 7500 13500 QMAPS\001 -4 0 -1 0 0 3 20 0.0000000 0 270 1470 2400 13500 Set taper and\001 -4 0 -1 0 0 3 20 0.0000000 0 210 1305 2700 13800 convolution\001 -4 0 -1 0 0 2 20 0.0000000 0 255 1215 7500 14400 QDATAS\001 -4 0 -1 0 0 2 20 0.0000000 0 195 1590 7500 15300 SUBTRACT\001 -4 0 -1 0 0 3 20 0.0000000 0 195 1140 2400 15600 SUB=true\001 -4 0 -1 0 0 2 20 0.0000000 0 255 1815 7500 16800 MAP_POLAR\001 -4 0 -1 0 0 0 20 0.0000000 0 255 1545 9600 16800 Maps wanted\001 -4 0 -1 0 0 2 20 0.0000000 0 255 1875 7500 17700 MAP_COORD\001 -4 0 -1 0 0 0 20 0.0000000 0 255 2355 9600 17700 Map coordinate type\001 -4 0 -1 0 0 0 20 0.0000000 0 255 1695 9600 18600 Type of output\001 -4 0 -1 0 0 0 20 0.0000000 0 255 2190 9600 15300 Subtract model y/n\001 -4 0 -1 0 0 0 20 0.0000000 0 255 4560 9600 14400 Detailed control of input-data handling\001 -4 0 -1 0 0 0 20 0.0000000 0 255 3735 9600 13500 Detailed control of map-making\001 -4 0 -1 0 0 0 20 0.0000000 0 255 3750 9600 12600 Grid-point separation in degrees\001 -4 0 -1 0 0 0 20 0.0000000 0 255 3390 9600 12300 Size of output map in degrees\001 -4 0 -1 0 0 0 20 0.0000000 0 255 3240 9600 12000 Size of output map in points\001 -4 0 -1 0 0 0 20 0.0000000 0 255 2865 9600 11100 Size of UV grid in points\001 -4 0 -1 0 0 2 20 0.0000000 0 195 1215 7500 18600 OUTPUT\001 -4 0 -1 0 0 2 20 0.0000000 0 195 1140 8100 2400 OPTION\001 -4 0 -1 0 0 3 20 0.0000000 0 210 2040 6600 16200 call NMODAX to \001 -4 0 -1 0 0 0 20 0.0000000 0 255 2040 2400 3600 entry NMADAC \001 -4 0 -1 0 0 0 10 0.0000000 0 150 1470 12300 2100 nmap_interface.fig 50%\001 -4 0 -1 0 0 0 10 0.0000000 0 135 1680 2400 18600 set OUTOPT, MAKMAP\001 -4 0 -1 0 0 0 10 0.0000000 0 135 1245 2400 18000 set CEP, MAPCTP\001 -4 0 -1 0 0 0 10 0.0000000 0 135 1050 2400 17100 set POLC, POLT\001 -4 0 -1 0 0 0 10 0.0000000 0 135 1080 7800 17100 set POLC, POLT\001 -4 0 -1 0 0 0 10 0.0000000 0 135 1245 7800 18000 set CEP, MAPCTP\001 -4 0 -1 0 0 0 10 0.0000000 0 135 1680 7800 18900 set OUTOPT, MAKMAP\001 -4 0 -1 0 0 0 10 0.0000000 0 105 540 7800 15600 Set SUB\001 -4 0 -1 0 0 3 20 0.0000000 0 225 1275 2700 14100 parameters\001 -4 0 -1 0 0 0 10 0.0000000 0 135 1755 2400 12000 Set FTSIZ, OUTSIZ, FIELD\001 -4 0 -1 2 0 0 10 0.0000000 0 105 735 2400 9000 UVCDT =0\001 -4 0 -1 0 0 0 10 0.0000000 0 105 540 4800 9000 UVCDT\001 -4 0 -1 0 0 0 10 0.0000000 0 105 165 6600 9000 =0\001 -4 0 -1 0 0 0 10 0.0000000 0 105 165 7800 9000 =1\001 -4 0 -1 0 0 0 10 0.0000000 0 105 165 11100 9000 =2\001 -4 0 -1 0 0 0 20 0.0000000 0 195 600 14100 3300 other\001 -4 0 -1 0 0 3 20 0.0000000 0 270 1260 7800 13800 see caption\001 -4 0 -1 0 0 3 20 0.0000000 0 270 1260 7800 14700 see caption\001 -4 0 -1 0 0 3 20 0.0000000 0 270 1260 14100 3600 see caption\001 -4 0 -1 0 0 0 20 0.0000000 0 195 855 7500 3300 MAKE\001 -4 0 -1 0 0 0 20 0.0000000 0 255 1320 7500 3600 Make maps\001 -4 0 -1 0 0 0 20 0.0000000 0 195 1740 7500 3900 from SCN files\001 -4 0 -1 0 0 3 20 0.0000000 0 270 1215 7800 4200 LCL=false\001 -4 0 0 0 0 3 32 0.0000000 0 330 2280 1800 1500 OBSOLETE\001 -4 0 0 0 0 3 20 0.0000000 0 285 4140 4800 1500 map-making now in nmap_make.fig\001 -4 0 0 0 0 3 20 0.0000000 0 210 3885 4800 1800 CLEAN column still to be extracted\001 diff --git a/src/doc/fig/nmap_make.cap b/src/doc/fig/nmap_make.cap deleted file mode 100644 index b21097c437821d2c5ac1cf9448122c566c359b5d..0000000000000000000000000000000000000000 --- a/src/doc/fig/nmap_make.cap +++ /dev/null @@ -1,17 +0,0 @@ -%nmap_make.cap - -\begin{figure}[htb] - -\fig{nmap_make} - -\caption{\it -\label{.nmap.make} -Overview of NMAP's map-making interface. -%%This diagram expands the {\em other options} stub in \figref{.nmap.interface}. -\\ -\\ See \figref{.nmap.make.q} for the QMAPS and QDATS branches; by default, -these branches are bypassed. -\\ -\\ (The rightmost column in the diagram is irrelevant for map-making in NMAP.) -} -\end{figure} diff --git a/src/doc/fig/nmap_make.fig b/src/doc/fig/nmap_make.fig deleted file mode 100644 index 5b4139bfb8da2087da2fb55be0db7963fde4d823..0000000000000000000000000000000000000000 --- a/src/doc/fig/nmap_make.fig +++ /dev/null @@ -1,133 +0,0 @@ -#FIG 3.1 -Portrait -Center -Inches -1200 2 -2 1 0 2 -1 -1 0 0 -1 0.000 0 0 -1 0 0 2 - 8700 6900 11400 6900 -2 1 0 2 -1 -1 0 0 -1 0.000 0 0 -1 0 0 2 - 12000 6900 14400 6900 -2 1 0 2 -1 -1 0 0 -1 0.000 0 0 -1 0 0 2 - 2400 9000 8100 9000 -2 1 0 2 -1 -1 0 0 -1 0.000 0 0 -1 0 0 2 - 2400 10200 14400 10200 -2 1 0 2 -1 -1 0 0 -1 0.000 0 0 -1 0 0 2 - 8700 6300 14400 6300 -2 1 1 2 -1 -1 0 0 -1 6.000 0 0 -1 0 0 4 - 2700 5400 2700 5100 9000 5100 9000 5400 -2 1 1 2 -1 -1 0 0 -1 6.000 0 0 -1 0 0 3 - 9000 5100 12300 5100 12300 5400 -2 1 1 1 -1 -1 0 0 -1 6.000 0 0 -1 0 0 2 - 11700 5400 11700 15900 -2 1 1 1 -1 -1 0 0 -1 6.000 0 0 -1 0 0 2 - 14700 600 14700 15900 -2 1 1 1 -1 -1 0 0 -1 6.000 0 0 -1 0 0 2 - 2100 5400 2100 15900 -2 1 1 1 -1 -1 0 0 -1 6.000 0 0 -1 0 0 2 - 8400 5400 8400 15900 -2 1 0 2 -1 -1 0 0 -1 0.000 0 0 -1 0 0 2 - 2400 8100 14400 8100 -2 1 1 1 0 0 0 0 -1 4.000 0 0 -1 0 0 2 - 12000 600 12000 4800 -2 1 0 1 -1 -1 0 0 -1 0.000 0 0 -1 0 0 4 - 4800 2100 4500 2100 4500 3300 4800 3300 -2 1 0 1 -1 -1 0 0 -1 0.000 0 0 -1 0 0 1 - 12000 3300 -2 1 0 1 -1 -1 0 0 -1 0.000 0 0 -1 0 0 1 - 12000 3300 -2 1 1 2 0 0 0 0 -1 6.000 0 0 -1 0 0 3 - 4500 900 5400 900 5400 1200 -2 1 1 1 0 0 0 0 -1 4.000 0 0 -1 0 0 2 - 4200 1200 4200 4800 -2 1 1 2 0 0 0 0 -1 6.000 0 0 -1 0 0 1 - 15900 1200 -2 1 1 2 0 0 0 0 -1 6.000 0 0 -1 0 0 2 - 15300 1200 15300 600 -2 1 1 1 -1 -1 0 0 -1 6.000 0 0 -1 0 0 2 - 17700 600 17700 15900 -4 0 -1 0 0 2 20 0.0000000 0 255 2640 8700 7200 BAS_RESOLUTION\001 -4 0 -1 0 0 2 20 0.0000000 0 255 2565 12000 7200 IFR_RESOLUTION\001 -4 0 -1 0 0 2 20 0.0000000 0 255 1680 2400 9300 FIELD_SIZE\001 -4 0 -1 0 0 0 20 0.0000000 0 135 240 4200 9300 or\001 -4 0 -1 0 0 2 20 0.0000000 0 255 1545 4500 9300 GRID_SIZE\001 -4 0 -1 0 0 0 20 0.0000000 0 255 1485 6300 9300 Scale of map\001 -4 0 -1 0 0 0 10 0.0000000 0 105 390 9600 7500 set R1\001 -4 0 -1 0 0 0 10 0.0000000 0 105 390 12900 7500 set R1\001 -4 0 -1 0 0 0 10 0.0000000 0 105 645 4200 9600 set FIELD\001 -4 0 -1 0 0 2 20 0.0000000 0 255 2505 9900 6600 HA_RESOLUTION\001 -4 0 -1 0 0 0 10 0.0000000 0 105 390 12900 6600 set R0\001 -4 0 -1 0 0 0 20 0.0000000 0 195 420 2400 5700 UV\001 -4 0 -1 0 0 3 20 0.0000000 0 270 4755 8700 6000 These two options are for UV-display only\001 -4 0 -1 0 0 0 20 0.0000000 0 195 990 8700 5700 BASHA\001 -4 0 -1 0 0 0 20 0.0000000 0 195 870 12000 5700 IFRHA\001 -4 0 -1 0 0 0 10 0.0000000 0 105 705 10200 5700 UVCDT=1\001 -4 0 -1 0 0 0 10 0.0000000 0 105 705 13425 5700 UVCDT=2\001 -4 0 -1 0 0 0 10 0.0000000 0 105 705 3300 5700 UVCDT=0\001 -4 0 -1 0 0 2 20 0.0000000 0 255 1050 3900 10500 QMAPS\001 -4 0 -1 0 0 2 20 0.0000000 0 255 1215 3900 11700 QDATAS\001 -4 0 -1 0 0 0 20 0.0000000 0 255 4710 6900 10500 UV-plane convolution and taper details?\001 -4 0 -1 0 0 0 20 0.0000000 0 255 2970 6900 11700 UV data-handling details\001 -4 0 -1 0 0 2 20 0.0000000 0 255 1425 3900 8700 OUT_SIZE\001 -4 0 -1 0 0 2 20 0.0000000 0 255 1170 3900 8400 FT_SIZE\001 -4 0 -1 0 0 0 20 0.0000000 0 255 3090 6900 8400 Size in points of UV frame\001 -4 0 -1 0 0 0 20 0.0000000 0 255 5520 6900 8700 Size in points of output frame (map or UV plot)\001 -4 0 -1 0 0 0 10 0.0000000 0 105 750 13200 8700 set OUTSIZ\001 -4 0 -1 0 0 0 10 0.0000000 0 105 615 13200 8400 set FTSIZ\001 -4 0 -1 0 0 2 18 0.0000000 0 195 1485 3900 12900 SUBTRACT\001 -4 0 -1 0 0 0 18 0.0000000 0 195 2025 7020 12900 Model subtraction\001 -4 0 -1 0 0 2 18 0.0000000 0 255 1710 3900 13500 MAP_POLAR\001 -4 0 -1 0 0 2 18 0.0000000 0 255 1800 3900 13800 MAP_COORD\001 -4 0 -1 0 0 2 18 0.0000000 0 195 1140 3900 14400 OUTPUT\001 -4 0 -1 0 0 0 18 0.0000000 0 255 5520 7020 14400 Type of output (map, antpat, coverage, uv-plane)\001 -4 0 -1 0 0 0 18 0.0000000 0 195 1995 7020 13800 Coordinate frame\001 -4 0 -1 0 0 0 18 0.0000000 0 195 1440 7020 13500 Polarisations\001 -4 0 -1 0 0 0 10 0.0000000 0 105 645 9570 13500 set POLTJ\001 -4 0 -1 0 0 0 10 0.0000000 0 105 855 9570 13800 set MAPCTP\001 -4 0 -1 0 0 0 18 0.0000000 0 195 615 4170 14685 MAP\001 -4 0 -1 0 0 0 18 0.0000000 0 195 375 5610 14685 AP\001 -4 0 -1 0 0 0 18 0.0000000 0 195 930 7020 14685 COVER\001 -4 0 -1 0 0 0 18 0.0000000 0 195 735 8430 14685 REAL\001 -4 0 -1 0 0 0 18 0.0000000 0 195 765 9840 14685 IMAG\001 -4 0 -1 0 0 0 18 0.0000000 0 195 780 11250 14685 AMPL\001 -4 0 -1 0 0 0 18 0.0000000 0 195 885 12660 14685 PHASE\001 -4 0 -1 0 0 2 18 0.0000000 0 255 2925 3900 15600 OUTPUT_WMP_NODE\001 -4 0 -1 0 0 0 18 0.0000000 0 255 1215 7020 15600 Output file\001 -4 0 -1 0 0 0 10 0.0000000 0 135 795 4470 15000 OUTOPT(1)\001 -4 0 -1 0 0 0 10 0.0000000 0 135 795 5880 15000 OUTOPT(2)\001 -4 0 -1 0 0 0 10 0.0000000 0 135 795 7290 15000 OUTOPT(3)\001 -4 0 -1 0 0 0 10 0.0000000 0 135 795 8700 15000 OUTOPT(4)\001 -4 0 -1 0 0 0 10 0.0000000 0 135 795 10110 15000 OUTOPT(5)\001 -4 0 -1 0 0 0 10 0.0000000 0 135 795 11550 15000 OUTOPT(6)\001 -4 0 -1 0 0 0 10 0.0000000 0 135 795 12960 15000 OUTOPT(7)\001 -4 0 -1 0 0 0 10 0.0000000 0 105 510 9570 12900 Set SUB\001 -4 0 -1 0 0 3 20 0.0000000 0 270 7275 4200 12000 If YES, prompt for detailed instructions (see companion diagram)\001 -4 0 -1 0 0 3 20 0.0000000 0 270 7275 4200 10800 If YES, prompt for detailed instructions (see companion diagram)\001 -4 0 -1 0 0 2 20 0.0000000 0 255 1635 4800 4800 UV_COORD\001 -4 0 -1 0 0 0 20 0.0000000 0 255 2115 7500 4800 Type ,of UV plane\001 -4 0 -1 0 0 2 20 0.0000000 0 255 1710 4800 1500 SCN_LOOPS\001 -4 0 -1 0 0 2 20 0.0000000 0 255 2040 5100 3000 HOUR_ANGLE\001 -4 0 -1 0 0 2 20 0.0000000 0 255 1440 5100 2700 SCN_SETS\001 -4 0 -1 0 0 2 20 0.0000000 0 255 1560 5100 2400 SCN_NODE\001 -4 0 -1 0 0 2 20 0.0000000 0 255 2490 4800 3900 USER_COMMENT\001 -4 0 -1 0 0 1 20 0.0000000 0 255 3735 7500 1500 Loops specification for all inputs\001 -4 0 -1 0 0 1 20 0.0000000 0 255 4245 7500 3900 Comment to be stored in map header\001 -4 0 -1 0 0 2 20 0.0000000 0 195 2955 5100 3300 INTERFEROMETERS\001 -4 0 -1 0 0 3 20 0.0000000 0 270 5265 4800 2100 Up to 8 input datasets; selection per dataset of:\001 -4 0 0 0 0 1 10 0.0000000 0 105 705 15300 5700 UVCDT=0\001 -4 0 -1 0 0 0 10 0.0000000 0 135 1395 15300 8400 FTSIZ from input map\001 -4 0 -1 0 0 0 10 0.0000000 0 135 1605 15300 8700 OUTSIZ from inpout map\001 -4 0 0 0 0 1 10 0.0000000 0 135 1425 15300 9600 FIELD from input map\001 -4 0 0 0 0 1 10 0.0000000 0 105 690 15300 12900 SUB = true\001 -4 0 0 0 0 1 10 0.0000000 0 135 1380 15300 13500 POLC from input map\001 -4 0 0 0 0 1 10 0.0000000 0 135 1650 15300 13800 MAPCTP gtom input map\001 -4 0 0 0 0 1 10 0.0000000 0 135 1200 15300 15000 OUTOPT(1) = true\001 -4 0 0 0 0 1 10 0.0000000 0 105 1140 15300 15900 MAKMAP = true\001 -4 0 0 0 0 3 10 0.0000000 0 120 75 15300 3900 p\001 -4 0 0 0 0 3 10 0.0000000 0 135 435 15000 2400 prompt\001 -4 0 0 0 0 3 10 0.0000000 0 135 435 15000 2700 prompt\001 -4 0 0 0 0 3 10 0.0000000 0 135 435 15000 3000 prompt\001 -4 0 0 0 0 2 20 0.0000000 0 195 1140 2100 600 OPTION\001 -4 0 0 0 0 1 20 0.0000000 0 195 1095 3300 600 = MAKE\001 -4 0 0 0 0 0 10 0.0000000 0 105 690 15900 1200 LCL = true\001 -4 0 0 0 0 3 10 0.0000000 0 150 2400 15000 600 entry NMADAC called from NCLEAN\001 -4 0 -1 0 0 0 10 0.0000000 0 150 1245 2100 1800 nmap_make.fig 50%\001 diff --git a/src/doc/fig/nmap_make_q.cap b/src/doc/fig/nmap_make_q.cap deleted file mode 100644 index d61cc432759bcb094ca8ee6f5816b8fa8248244b..0000000000000000000000000000000000000000 --- a/src/doc/fig/nmap_make_q.cap +++ /dev/null @@ -1,16 +0,0 @@ -%nmap_make_q.cap - -\begin{figure}[hbt] -% The asterisks indicate parameters also prompted for in DATA CLEAN. These must -% be changed to confom with nmap_make.fig. - -\fig{nmap_make_q} - -\caption{\it -\label{.nmap.make.q} -Overview of the optional detailed-question sequences of the map-making -interface. This diagram expands the {\em QMAPS} and {\em QDATAS} stubs in -\figref{.nmap.make}. -} -\end{figure} - diff --git a/src/doc/fig/nmap_make_q.fig b/src/doc/fig/nmap_make_q.fig deleted file mode 100644 index fa20fdd1ecc318ec48a39b97e99b2afe56201ca5..0000000000000000000000000000000000000000 --- a/src/doc/fig/nmap_make_q.fig +++ /dev/null @@ -1,161 +0,0 @@ -#FIG 3.1 -Portrait -Center -Inches -1200 2 -2 1 0 2 0 0 0 0 -1 0.000 0 0 -1 0 0 2 - 2400 8100 12900 8100 -2 1 0 2 -1 -1 0 0 -1 0.000 0 0 -1 0 0 2 - 2400 2100 12900 2100 -2 1 0 2 0 0 0 0 -1 0.000 0 0 -1 0 0 2 - 2400 3000 12900 3000 -2 1 0 2 0 0 0 0 -1 0.000 0 0 -1 0 0 2 - 2400 3900 12900 3900 -2 1 0 2 0 0 0 0 -1 0.000 0 0 -1 0 0 2 - 2400 5400 12900 5400 -2 1 0 2 0 0 0 0 -1 0.000 0 0 -1 0 0 2 - 2400 6300 12900 6300 -2 1 0 2 0 0 0 0 -1 0.000 0 0 -1 0 0 2 - 2400 7500 12900 7500 -2 1 0 2 0 0 0 0 -1 0.000 0 0 -1 0 0 2 - 2400 9600 12900 9600 -2 1 1 1 -1 -1 0 0 -1 4.000 0 0 -1 0 0 2 - 7200 1800 7200 17700 -2 1 1 1 -1 -1 0 0 -1 4.000 0 0 -1 0 0 2 - 10200 1200 10200 17700 -2 1 1 1 -1 -1 0 0 -1 4.000 0 0 -1 0 0 2 - 2100 1200 2100 17700 -2 1 1 1 -1 -1 0 0 -1 4.000 0 0 -1 0 0 2 - 13200 1200 13200 17700 -2 1 0 2 0 0 0 0 -1 0.000 0 0 -1 0 0 2 - 2400 12600 12900 12600 -2 1 0 2 0 0 0 0 -1 0.000 0 0 -1 0 0 2 - 2400 13800 12900 13800 -2 1 0 2 0 0 0 0 -1 0.000 0 0 -1 0 0 2 - 2400 14400 12900 14400 -2 1 0 2 0 0 0 0 -1 0.000 0 0 -1 0 0 2 - 2400 15600 12900 15600 -2 1 0 2 0 0 0 0 -1 0.000 0 0 -1 0 0 2 - 2400 16500 12900 16500 -2 1 0 2 -1 -1 0 0 -1 0.000 0 0 -1 0 0 2 - 2400 11700 12900 11700 -2 1 1 2 0 0 0 0 -1 6.000 0 0 -1 0 0 1 - 3000 1200 -2 1 1 2 0 0 0 0 -1 6.000 0 0 -1 0 0 2 - 3000 1200 3000 900 -2 1 1 2 0 0 0 0 -1 6.000 0 0 -1 0 0 2 - 8100 1200 8100 900 -2 1 1 2 0 0 0 0 -1 6.000 0 0 -1 0 0 2 - 11100 1200 11100 900 -2 1 1 2 0 0 0 0 -1 6.000 0 0 -1 0 0 2 - 3000 900 11100 900 -4 0 -1 0 0 0 20 0.0000000 0 255 2355 5100 7800 Circular taper width\001 -4 0 -1 0 0 2 20 0.0000000 0 255 2595 2400 7800 CWEIGHT_VALUE\001 -4 0 -1 0 0 0 10 0.0000000 0 105 900 8400 7800 set CWGVAL\001 -4 0 -1 0 0 2 20 0.0000000 0 195 1680 2400 8400 CONVOLVE\001 -4 0 -1 0 0 0 20 0.0000000 0 255 2205 5100 8400 Convolving fuction\001 -4 0 -1 0 0 0 20 0.0000000 0 195 960 2700 8700 GAUSS\001 -4 0 -1 0 0 0 20 0.0000000 0 195 615 4500 8700 BOX\001 -4 0 -1 0 0 0 20 0.0000000 0 195 1215 6600 8700 EXPSINC\001 -4 0 -1 0 0 0 20 0.0000000 0 195 300 8700 8700 P4\001 -4 0 -1 0 0 0 20 0.0000000 0 195 300 10500 8700 P6\001 -4 0 -1 0 0 3 20 0.0000000 0 210 750 4500 9000 boxcar\001 -4 0 -1 0 0 3 20 0.0000000 0 270 1365 6600 9000 tapered sinc\001 -4 0 -1 0 0 3 20 0.0000000 0 270 1455 8700 9000 prolate 4*4pt\001 -4 0 -1 0 0 3 20 0.0000000 0 270 1455 10500 9000 prolate 6*6pt\001 -4 0 -1 0 0 3 20 0.0000000 0 270 1020 2700 9000 gaussian\001 -4 0 -1 0 0 0 10 0.0000000 0 105 780 3000 9300 CVLTYP=1\001 -4 0 -1 0 0 0 10 0.0000000 0 105 780 4800 9300 CVLTYP=2\001 -4 0 -1 0 0 0 10 0.0000000 0 105 780 6900 9300 CVLTYP=4\001 -4 0 -1 0 0 0 10 0.0000000 0 105 780 9000 9300 CVLTYP=3\001 -4 0 -1 0 0 0 10 0.0000000 0 105 780 10800 9300 CVLTYP=5\001 -4 0 -1 0 0 2 20 0.0000000 0 135 135 1800 7800 *\001 -4 0 -1 0 0 2 20 0.0000000 0 195 1410 2400 3300 UNIFORM\001 -4 0 -1 0 0 0 20 0.0000000 0 255 3045 5100 3300 Definition of UV coverage\001 -4 0 -1 0 0 0 20 0.0000000 0 195 1590 2700 3600 STANDARD\001 -4 0 -1 0 0 0 10 0.0000000 0 105 630 4500 3600 UWGT=1\001 -4 0 -1 0 0 0 20 0.0000000 0 195 735 5700 3600 FULL\001 -4 0 -1 0 0 0 10 0.0000000 0 105 630 6600 3600 UWGT=2\001 -4 0 -1 0 0 0 20 0.0000000 0 195 1395 7800 3600 NATURAL\001 -4 0 -1 0 0 0 10 0.0000000 0 105 630 9300 3600 UWGT=0\001 -4 0 -1 0 0 2 20 0.0000000 0 195 990 2400 4200 TAPER\001 -4 0 -1 0 0 0 20 0.0000000 0 195 1395 6600 4500 NATURAL\001 -4 0 -1 0 0 3 20 0.0000000 0 135 555 6600 4800 none\001 -4 0 -1 0 0 3 20 0.0000000 0 270 1020 2700 4800 gaussian\001 -4 0 -1 0 0 0 20 0.0000000 0 195 960 2700 4500 GAUSS\001 -4 0 -1 0 0 0 10 0.0000000 0 105 765 3000 5100 TAPTYP=1\001 -4 0 -1 0 0 0 10 0.0000000 0 105 765 4800 5100 TAPTYP=2\001 -4 0 -1 0 0 3 20 0.0000000 0 270 1110 4500 4800 triangular\001 -4 0 -1 0 0 0 20 0.0000000 0 195 1065 4500 4500 LINEAR\001 -4 0 -1 0 0 0 10 0.0000000 0 105 765 6900 5100 TAPTYP=3\001 -4 0 -1 0 0 0 20 0.0000000 0 195 990 8700 4500 OVERR\001 -4 0 -1 0 0 3 20 0.0000000 0 210 1050 8700 4800 1 / radius\001 -4 0 -1 0 0 0 10 0.0000000 0 105 765 9000 5100 TAPTYP=4\001 -4 0 -1 0 0 0 20 0.0000000 0 255 5100 5100 4200 Taper function (circular in equatorial plane)\001 -4 0 -1 0 0 0 20 0.0000000 0 195 1155 10500 4500 RGAUSS\001 -4 0 -1 0 0 3 20 0.0000000 0 270 1935 10500 4800 gaussian / radius\001 -4 0 -1 0 0 0 10 0.0000000 0 105 765 10800 5100 TAPTYP=5\001 -4 0 -1 0 0 0 20 0.0000000 0 195 420 2700 1500 UV\001 -4 0 -1 0 0 0 20 0.0000000 0 195 990 7800 1500 BASHA\001 -4 0 -1 0 0 0 20 0.0000000 0 195 870 10800 1500 IFRHA\001 -4 0 -1 0 0 2 20 0.0000000 0 135 135 1800 3300 *\001 -4 0 -1 0 0 2 20 0.0000000 0 135 135 1800 5700 *\001 -4 0 -1 0 0 2 20 0.0000000 0 255 2145 2400 5700 TAPER_VALUE\001 -4 0 -1 0 0 0 20 0.0000000 0 255 1410 5100 5700 Taper width\001 -4 0 -1 0 0 0 10 0.0000000 0 105 870 3000 6000 set TAPVAL\001 -4 0 -1 0 0 2 20 0.0000000 0 255 2355 2400 6600 CWEIGHT_TYPE\001 -4 0 -1 0 0 0 20 0.0000000 0 255 6945 5100 6600 Circular taper function (i.e. circular in the plane of the field)\001 -4 0 -1 0 0 0 10 0.0000000 0 105 825 3000 7200 CWGTYP=1\001 -4 0 -1 0 0 0 20 0.0000000 0 195 810 2700 6900 NONE\001 -4 0 -1 0 0 0 20 0.0000000 0 195 960 4500 6900 GAUSS\001 -4 0 -1 0 0 0 20 0.0000000 0 195 1065 6600 6900 LINEAR\001 -4 0 -1 0 0 0 10 0.0000000 0 105 825 4800 7200 CWGTYP=2\001 -4 0 -1 0 0 0 10 0.0000000 0 105 825 6900 7200 CWGTYP=3\001 -4 0 -1 0 0 2 20 0.0000000 0 135 135 1800 6600 *\001 -4 0 -1 0 0 2 20 0.0000000 0 195 2085 2400 9900 DECONVOLVE\001 -4 0 -1 0 0 0 20 0.0000000 0 255 4185 5100 9900 Undo map taper due to convolution?\001 -4 0 -1 0 0 0 10 0.0000000 0 105 720 10200 9900 set DECVL\001 -4 0 -1 0 0 3 20 0.0000000 0 210 1155 9300 2400 is selected\001 -4 0 -1 0 0 0 20 0.0000000 0 255 1725 7200 2400 QMAPS=YES\001 -4 0 -1 0 0 3 20 0.0000000 0 270 4200 2700 2400 The following prompts appear only if \001 -4 0 -1 0 0 2 20 0.0000000 0 255 1740 2400 12900 USER_DATA\001 -4 0 -1 0 0 0 20 0.0000000 0 195 3360 5700 12900 Observed or model visibilities\001 -4 0 -1 0 0 0 20 0.0000000 0 195 1590 2700 13200 STANDARD\001 -4 0 -1 0 0 0 20 0.0000000 0 195 1035 5100 13200 MODEL\001 -4 0 -1 0 0 2 20 0.0000000 0 255 1380 2400 14100 UV_AREA\001 -4 0 -1 0 0 0 20 0.0000000 0 195 2475 5700 14100 UV annulus selection\001 -4 0 -1 0 0 0 20 0.0000000 0 255 2790 5700 15000 UV annulus for clipping\001 -4 0 -1 0 0 0 20 0.0000000 0 255 4725 5700 14700 Clip visibilities with extreme amplitudes?\001 -4 0 -1 0 0 0 20 0.0000000 0 255 1860 2700 15300 CLIP_LEVELS\001 -4 0 -1 0 0 2 20 0.0000000 0 255 1650 2700 15000 CLIP_AREA\001 -4 0 -1 0 0 0 20 0.0000000 0 255 6090 5700 15300 Lower and upper limits for valid visibility amplitudes\001 -4 0 -1 0 0 2 20 0.0000000 0 255 1890 2400 15900 FIELD_SHIFT\001 -4 0 -1 0 0 0 20 0.0000000 0 255 1305 5700 16200 Map centre\001 -4 0 -1 0 0 0 20 0.0000000 0 255 1110 5700 15900 Map shift\001 -4 0 -1 0 0 2 20 0.0000000 0 255 2235 2700 16200 FIELD_CENTRE\001 -4 0 -1 0 0 2 20 0.0000000 0 255 1740 2400 16800 DATA_TYPE\001 -4 0 -1 0 0 0 20 0.0000000 0 255 2850 5700 16800 Visibility transformation\001 -4 0 -1 0 0 0 20 0.0000000 0 195 1260 2700 17100 NORMAL\001 -4 0 -1 0 0 0 20 0.0000000 0 195 1050 4800 17100 COSINE\001 -4 0 -1 0 0 0 20 0.0000000 0 195 645 6900 17100 SINE\001 -4 0 -1 0 0 0 20 0.0000000 0 195 810 9000 17100 AMPL\001 -4 0 -1 0 0 0 20 0.0000000 0 195 930 11100 17100 PHASE\001 -4 0 -1 0 0 0 10 0.0000000 0 105 780 3000 17400 DATTYP=1\001 -4 0 -1 0 0 0 10 0.0000000 0 105 780 5100 17400 DATTYP=2\001 -4 0 -1 0 0 0 10 0.0000000 0 105 780 7200 17400 DATTYP=3\001 -4 0 -1 0 0 0 10 0.0000000 0 105 780 9300 17400 DATTYP=4\001 -4 0 -1 0 0 0 10 0.0000000 0 105 780 11400 17400 DATTYP=5\001 -4 0 -1 0 0 0 10 0.0000000 0 135 1680 7800 16200 LSHIFT=-1, set CENTRE\001 -4 0 -1 0 0 0 10 0.0000000 0 135 1410 7800 15900 LSHIFT=1, set SHIFT\001 -4 0 -1 0 0 0 10 0.0000000 0 105 795 12300 15300 set CLPLEV\001 -4 0 -1 0 0 0 10 0.0000000 0 105 825 9300 15000 set CLPRAD\001 -4 0 -1 0 0 0 10 0.0000000 0 105 810 9300 14100 set UVRAD\001 -4 0 -1 0 0 0 10 0.0000000 0 105 690 5400 13500 UVDTP=1\001 -4 0 -1 0 0 0 10 0.0000000 0 105 690 3000 13500 UVDTP=0\001 -4 0 -1 0 0 2 16 0.0000000 0 165 1080 2400 14700 CLIPPING\001 -4 0 -1 0 0 3 20 0.0000000 0 270 4200 2700 12000 The following prompts appear only if \001 -4 0 -1 0 0 0 20 0.0000000 0 255 1905 7200 12000 QDATAS=YES\001 -4 0 -1 0 0 3 20 0.0000000 0 210 1155 9300 12000 is selected\001 -4 0 -1 0 0 3 20 0.0000000 0 270 6105 2400 600 UV-plane or map-making mode (see previous figure)\001 -4 0 -1 0 0 0 10 0.0000000 0 150 1395 11700 600 nmap_make_q.fig 50%\001 -4 0 -1 0 0 2 20 0.0000000 0 135 135 1800 14175 *\001 diff --git a/src/doc/fig/nmodel_convert.cap b/src/doc/fig/nmodel_convert.cap deleted file mode 100644 index 4b1c88b21569fd4f40c00d223b965153a1a1bab7..0000000000000000000000000000000000000000 --- a/src/doc/fig/nmodel_convert.cap +++ /dev/null @@ -1,14 +0,0 @@ -%nmodel_convert.cap - -% JPH 951013 Change \figref - -\begin{figure} -\fig{nmodel_convert} -\caption{\it -\label{.nmodel.convert} -Overview of the parameter interface for the model-conversion branch of NMODEL. -\\ -This diagram expands the corresponding branch in the overview diagram -(\figref{.nmodel.interface}) of NMODEL's parameter interface. -} -\end{figure} diff --git a/src/doc/fig/nmodel_convert.fig b/src/doc/fig/nmodel_convert.fig deleted file mode 100644 index a9a0349383682a635c68276c8394ffc3e51829ee..0000000000000000000000000000000000000000 --- a/src/doc/fig/nmodel_convert.fig +++ /dev/null @@ -1,67 +0,0 @@ -#FIG 3.1 -Portrait -Center -Inches -1200 2 -2 1 1 2 -1 7 0 0 -1 6.000 0 0 -1 0 0 2 - 1200 2100 1200 3000 -2 1 1 1 -1 -1 0 0 0 4.000 0 0 -1 0 0 2 - 4206 3306 4201 5701 -2 1 1 1 -1 -1 0 0 0 4.000 0 0 -1 0 0 2 - 7201 3301 7200 11100 -2 1 1 2 -1 -1 0 0 0 6.000 0 0 -1 0 0 2 - 2101 3001 2101 3301 -2 1 1 2 -1 -1 0 0 0 6.000 0 0 -1 0 0 2 - 4801 3001 4801 3301 -2 1 1 2 -1 7 0 0 -1 6.000 0 0 -1 0 0 3 - 1201 3001 7801 3001 7801 3301 -2 1 1 2 -1 7 0 0 -1 6.000 0 0 -1 0 0 3 - 7801 4351 7801 6601 8101 6601 -2 1 1 2 -1 7 0 0 -1 6.000 0 0 -1 0 0 2 - 7801 5401 8101 5401 -2 1 1 2 -1 7 0 0 -1 6.000 0 0 -1 0 0 2 - 7801 5101 8101 5101 -2 1 1 2 -1 7 0 0 -1 6.000 0 0 -1 0 0 2 - 7801 4801 8101 4801 -2 1 0 2 -1 -1 0 0 0 0.000 0 0 -1 0 0 2 - 1801 6901 10801 6901 -2 1 1 2 -1 7 0 0 -1 6.000 0 0 -1 0 0 3 - 7801 6301 8101 6301 8101 6301 -2 1 0 2 -1 7 0 0 -1 0.000 0 0 -1 0 0 2 - 7500 7500 10800 7500 -2 1 1 2 -1 7 0 0 -1 6.000 0 0 -1 0 0 4 - 7800 8400 7800 8100 12300 8100 12300 8400 -2 1 1 2 -1 7 0 0 -1 6.000 0 0 -1 0 0 2 - 10200 8100 10200 8400 -4 0 -1 0 0 2 20 0.0000000 0 165 930 900 1800 ACTION\001 -4 0 -1 0 0 0 12 0.0000000 0 180 1770 12900 1800 nmodel_convert.fig 45%\001 -4 0 -1 0 0 1 20 0.0000000 0 165 2025 1501 2701 .MDL-file conversions\001 -4 0 -1 0 0 0 20 0.0000000 0 165 1470 4506 3906 Convert to host-\001 -4 0 -1 0 0 0 20 0.0000000 0 165 435 1806 3606 NVS\001 -4 0 -1 0 0 0 20 0.0000000 0 165 1665 1806 3906 Internal .MDL-file\001 -4 0 -1 0 0 0 20 0.0000000 0 225 1215 2106 4206 format update\001 -4 0 -1 0 0 0 20 0.0000000 0 165 465 4506 3606 CVX\001 -4 0 -1 0 0 0 20 0.0000000 0 165 1410 4806 4206 macine data fmt\001 -4 0 -1 0 0 1 20 0.0000000 0 165 1305 7501 3601 Conversions to\001 -4 0 -1 0 0 1 20 0.0000000 0 165 1500 7801 3901 other coordinates\001 -4 0 -1 0 0 1 20 0.0000000 0 225 1470 7801 4201 and/or frequency\001 -4 0 -1 0 0 1 20 0.0000000 0 165 1050 8401 4801 CONVERT\001 -4 0 -1 0 0 1 20 0.0000000 0 165 510 8401 5101 EDIT\001 -4 0 -1 0 0 1 20 0.0000000 0 165 645 8401 5401 REDIT\001 -4 0 -1 0 0 1 20 0.0000000 0 165 630 8401 5701 FEDIT\001 -4 0 -1 0 0 1 20 0.0000000 0 225 4965 10201 4801 epoch, reference coord. with adjustment of l,m, intensities\001 -4 0 -1 0 0 1 20 0.0000000 0 225 2445 10201 5101 epoch, reference coord. only\001 -4 0 -1 0 0 1 20 0.0000000 0 225 5415 10201 5401 reference coord. and freq., correct intensities for spectral index \001 -4 0 -1 0 0 1 20 0.0000000 0 225 5145 10201 5701 same with correction for freq. dependence of primary beam\001 -4 0 -1 0 0 2 20 0.0000000 0 240 1320 4801 7201 MDL_NODE\001 -4 0 -1 0 0 1 20 0.0000000 0 165 660 8401 6301 BEAM\001 -4 0 -1 0 0 1 20 0.0000000 0 165 960 8401 6601 DEBEAM\001 -4 0 -1 0 0 1 20 0.0000000 0 225 3450 10201 6301 correct for attenuation by primary beam\001 -4 0 -1 0 0 1 20 0.0000000 0 225 4260 10201 6601 remove correction for primary-beam attenuation\001 -4 0 -1 0 0 2 20 0.0000000 0 255 2010 7500 7800 CONVERT_TO\001 -4 0 -1 0 0 1 20 0.0000000 0 195 735 7500 8700 B1950\001 -4 0 -1 0 0 1 20 0.0000000 0 195 645 9900 8700 J2000\001 -4 0 -1 0 0 1 20 0.0000000 0 195 1515 12000 8700 APPARENT\001 -4 0 -1 0 0 2 20 0.0000000 0 255 2280 7500 9600 REF_SCN_NODE\001 -4 0 -1 0 0 2 20 0.0000000 0 255 2760 7500 10200 REFERENCE_DATA\001 -4 0 -1 0 0 2 20 0.0000000 0 255 1995 7500 10800 REF_SCN_SET\001 diff --git a/src/doc/fig/nmodel_handle.cap b/src/doc/fig/nmodel_handle.cap deleted file mode 100644 index 6f5122ddca67f1ff8fd8e1a6c40269a423727acc..0000000000000000000000000000000000000000 --- a/src/doc/fig/nmodel_handle.cap +++ /dev/null @@ -1,17 +0,0 @@ -%nmodel_handle.tex - -% JPH 951013 Change \figref - -\begin{figure} -\fig{nmodel_handle} -\caption{\it -\label{.nmodel.handle} -Overview of the parameter interface for the model-manipulation branch of -NMODEL. \\ -This diagram expands the HANDLE branch in the overview diagram -(\figref{.nmodel.interface}) of NMODEL's parameter interface. -\\ -The same model-handling facilities are also available from several other -programs. - } -\end{figure} diff --git a/src/doc/fig/nmodel_handle.fig b/src/doc/fig/nmodel_handle.fig deleted file mode 100644 index b5a6747b828a5a5af3d9a88911ad365ab02170c4..0000000000000000000000000000000000000000 --- a/src/doc/fig/nmodel_handle.fig +++ /dev/null @@ -1,321 +0,0 @@ -#FIG 3.1 -Portrait -Center -Inches -1200 2 -6 6600 17100 18300 21900 -6 6901 19501 7501 21301 -4 0 -1 0 0 0 20 0.0000000 0 195 90 6901 19801 I\001 -4 0 -1 0 0 0 20 0.0000000 0 195 555 6901 20101 POL\001 -4 0 -1 0 0 0 20 0.0000000 0 195 180 6901 20401 L\001 -4 0 -1 0 0 0 20 0.0000000 0 195 390 6901 20701 LA\001 -4 0 -1 0 0 0 20 0.0000000 0 195 255 6901 21001 SI\001 -4 0 -1 0 0 0 20 0.0000000 0 195 300 6901 21301 ID\001 --6 -2 1 1 1 -1 -1 0 0 -1 4.000 0 0 -1 0 0 2 - 6601 17101 6601 21601 -2 1 0 2 -1 -1 0 0 -1 0.000 0 0 -1 0 0 2 - 6901 18001 9901 18001 -2 1 1 2 -1 -1 0 0 -1 6.000 0 0 -1 0 0 2 - 8101 19201 8101 19501 -2 1 1 2 -1 -1 0 0 -1 6.000 0 0 -1 0 0 2 - 9001 19201 9001 19501 -2 1 1 2 -1 -1 0 0 -1 6.000 0 0 -1 0 0 2 - 9901 19201 9901 19501 -2 1 1 2 -1 -1 0 0 -1 6.000 0 0 -1 0 0 2 - 7501 18901 7501 19201 -2 1 0 2 -1 -1 0 0 -1 0.000 0 0 -1 0 0 2 - 6901 18601 18001 18601 -2 1 1 2 -1 -1 0 0 -1 6.000 0 0 -1 0 0 3 - 7201 19501 7201 19201 14701 19201 -2 1 1 2 -1 -1 0 0 -1 6.000 0 0 -1 0 0 2 - 14701 19201 14701 19501 -2 1 1 1 -1 -1 0 0 -1 4.000 0 0 -1 0 0 2 - 14101 19501 14101 21601 -2 1 0 2 -1 -1 0 0 -1 0.000 0 0 -1 0 0 2 - 14401 20101 18001 20101 -4 0 -1 0 0 0 20 0.0000000 0 195 915 6901 17401 FSORT\001 -4 0 -1 0 0 0 20 0.0000000 0 255 2910 6901 17701 Sort on source parameter\001 -4 0 -1 0 0 2 20 0.0000000 0 255 1710 6901 18301 SORT_TYPE\001 -4 0 -1 0 0 0 20 0.0000000 0 255 2775 9001 18301 Increasing or decreasing\001 -4 0 -1 0 0 2 20 0.0000000 0 255 1815 6901 18901 SORT_FIELD\001 -4 0 -1 0 0 0 20 0.0000000 0 195 3150 9001 18901 Parameter on which to sort\001 -4 0 -1 0 0 0 20 0.0000000 0 255 210 7801 19801 Q\001 -4 0 -1 0 0 0 20 0.0000000 0 195 210 8701 19801 U\001 -4 0 -1 0 0 0 20 0.0000000 0 195 210 9601 19801 V\001 -4 0 -1 0 0 0 20 0.0000000 0 255 2100 10501 19801 Stokes parameters\001 -4 0 -1 0 0 0 20 0.0000000 0 255 2115 10501 20101 Polarised intensity\001 -4 0 -1 0 0 0 20 0.0000000 0 195 255 7801 20401 M\001 -4 0 -1 0 0 0 20 0.0000000 0 195 435 8701 20401 LM\001 -4 0 -1 0 0 0 20 0.0000000 0 195 435 9601 20401 ML\001 -4 0 -1 0 0 0 20 0.0000000 0 240 1740 10501 20401 l,m coordinates\001 -4 0 -1 0 0 0 20 0.0000000 0 195 375 7801 20701 SA\001 -4 0 -1 0 0 0 20 0.0000000 0 195 375 8701 20701 PA\001 -4 0 -1 0 0 0 20 0.0000000 0 195 450 7801 21001 RM\001 -4 0 -1 0 0 0 20 0.0000000 0 195 2565 10501 21301 Source claasifications \001 -4 0 -1 0 0 0 20 0.0000000 0 195 840 9601 21301 CCBM\001 -4 0 -1 0 0 0 20 0.0000000 0 195 630 8701 21301 BITS\001 -4 0 -1 0 0 0 20 0.0000000 0 195 555 7801 21301 TYP\001 -4 0 -1 0 0 0 20 0.0000000 0 255 3300 10501 20701 Shape parameters: Axes, p.a.\001 -4 0 -1 0 0 0 20 0.0000000 0 255 3300 10501 21001 Spectral index; rotn measure\001 -4 0 -1 0 0 0 20 0.0000000 0 195 465 14401 19801 DIS\001 -4 0 -1 0 0 0 20 0.0000000 0 255 2625 15301 19801 Distance to some point\001 -4 0 -1 0 0 2 20 0.0000000 0 255 2145 14401 20401 SORT_CENTRE\001 -4 0 -1 0 0 0 20 0.0000000 0 195 1920 14401 20701 Reference centre\001 --6 -6 2100 6300 4800 9900 -2 1 0 2 -1 -1 0 0 -1 0.000 0 0 -1 0 0 2 - 2101 7801 4501 7801 -2 1 1 2 -1 -1 0 0 -1 6.000 0 0 -1 0 0 2 - 2401 6301 2401 6601 -4 0 -1 0 0 2 20 0.0000000 0 255 2640 2101 8101 SOURCE_NUMBER\001 -4 0 -1 0 0 1 20 0.0000000 0 195 2070 2101 8401 ID for new source\001 -4 0 -1 0 0 2 20 0.0000000 0 195 1215 2101 9001 SOURCE\001 -4 0 -1 0 0 0 20 0.0000000 0 195 1710 2101 9301 Parameters for\001 -4 0 -1 0 0 0 20 0.0000000 0 135 1290 2101 9601 new source\001 -4 0 -1 0 0 0 20 0.0000000 0 195 630 2101 6901 ADD\001 -4 0 -1 0 0 0 20 0.0000000 0 255 1110 2101 7201 Manually\001 -4 0 -1 0 0 1 20 0.0000000 0 195 1320 2101 7501 add sources\001 --6 -6 14100 6300 16500 7800 -2 1 1 2 -1 -1 0 0 -1 6.000 0 0 -1 0 0 2 - 14401 6301 14401 6601 -4 0 -1 0 0 1 20 0.0000000 0 255 2010 14101 6901 FLUX_KNOWN\001 -4 0 -1 0 0 1 20 0.0000000 0 255 780 14101 7201 Toggle\001 -4 0 -1 0 0 1 20 0.0000000 0 195 2370 14101 7501 'flux-known' switch\001 --6 -2 1 1 2 -1 -1 0 0 -1 6.000 0 0 -1 0 0 3 - 9000 22800 1500 22800 1500 2700 -2 1 1 1 -1 -1 0 0 -1 4.000 0 0 -1 0 0 2 - 8400 23100 8400 25500 -2 1 1 2 -1 -1 0 0 -1 6.000 0 0 -1 0 0 2 - 2400 22800 2400 23100 -2 1 1 2 -1 -1 0 0 -1 6.000 0 0 -1 0 0 2 - 3600 22800 3600 23100 -2 1 1 2 -1 -1 0 0 -1 6.000 0 0 -1 0 0 2 - 5400 22800 5400 23100 -2 1 1 1 -1 -1 0 0 -1 4.000 0 0 -1 0 0 2 - 3000 23100 3000 25500 -2 1 1 1 -1 -1 0 0 -1 4.000 0 0 -1 0 0 2 - 4800 23100 4800 25500 -2 1 0 2 -1 -1 0 0 -1 0.000 0 0 -1 0 0 2 - 2100 24300 8100 24300 -2 1 1 1 -1 -1 0 0 -1 4.000 0 0 -1 0 0 2 - 6600 23100 6600 25500 -2 1 1 2 -1 -1 0 0 -1 6.000 0 0 -1 0 0 2 - 7200 22800 7200 23100 -2 1 1 2 -1 -1 0 0 -1 6.000 0 0 -1 0 0 2 - 9000 22800 9000 23100 -2 1 1 2 -1 -1 0 0 -1 6.000 0 0 -1 0 0 2 - 1500 13200 16200 13200 -2 1 1 2 -1 -1 0 0 -1 6.000 0 0 -1 0 0 2 - 16200 13200 16200 13500 -2 1 1 2 -1 -1 0 0 -1 6.000 0 0 -1 0 0 1 - 2700 13200 -2 1 1 2 -1 -1 0 0 -1 6.000 0 0 -1 0 0 2 - 3000 13200 3000 13500 -2 1 0 2 -1 -1 0 0 -1 0.000 0 0 -1 0 0 2 - 10800 14700 12900 14700 -2 1 0 2 -1 -1 0 0 -1 0.000 0 0 -1 0 0 2 - 5400 14700 10200 14700 -2 1 1 2 -1 -1 0 0 -1 6.000 0 0 -1 0 0 2 - 14100 13200 14100 13500 -2 1 1 2 -1 -1 0 0 -1 6.000 0 0 -1 0 0 2 - 11400 13200 11400 13500 -2 1 1 2 -1 -1 0 0 -1 6.000 0 0 -1 0 0 2 - 8700 13200 8700 13500 -2 1 1 2 -1 -1 0 0 -1 6.000 0 0 -1 0 0 2 - 6000 13200 6000 13500 -2 1 1 1 -1 -1 0 0 -1 4.000 0 0 -1 0 0 2 - 5100 13500 5100 15900 -2 1 1 1 -1 -1 0 0 -1 4.000 0 0 -1 0 0 2 - 7800 13500 7800 15900 -2 1 1 1 -1 -1 0 0 -1 4.000 0 0 -1 0 0 2 - 10500 13500 10500 15900 -2 1 1 1 -1 -1 0 0 -1 4.000 0 0 -1 0 0 2 - 13200 13500 13200 15900 -2 1 0 2 -1 -1 0 0 -1 0.000 0 0 -1 0 0 1 - 4800 16200 -2 1 1 2 -1 -1 0 0 -1 6.000 0 0 -1 0 0 2 - 1500 16800 7200 16800 -2 1 1 2 -1 -1 0 0 -1 6.000 0 0 -1 0 0 2 - 7200 17100 7200 16800 -2 1 1 2 -1 -1 0 0 -1 6.000 0 0 -1 0 0 2 - 6300 3300 6300 3600 -2 1 1 2 -1 -1 0 0 -1 6.000 0 0 -1 0 0 2 - 2700 3300 2700 3600 -2 1 1 1 -1 -1 0 0 -1 4.000 0 0 -1 0 0 2 - 5700 3600 5700 5100 -2 1 0 2 -1 -1 0 0 -1 0.000 0 0 -1 0 0 2 - 2400 4500 5400 4500 -2 1 0 2 -1 -1 0 0 -1 0.000 0 0 -1 0 0 2 - 6000 4500 8700 4500 -2 1 0 2 -1 -1 0 0 -1 0.000 0 0 -1 0 0 2 - 2400 14400 4800 14400 -2 1 0 2 -1 7 0 0 -1 0.000 0 0 -1 0 0 2 - 13500 14700 15300 14700 -2 1 1 1 -1 -1 0 0 -1 4.000 0 0 -1 0 0 2 - 15600 13500 15600 15900 -2 1 1 2 -1 7 0 0 -1 6.000 0 0 -1 0 0 4 - 902 1202 902 1802 9002 1802 9002 1202 -2 1 1 2 -1 7 0 0 -1 6.000 0 0 -1 0 0 2 - 1502 1802 1502 2102 -2 1 1 2 -1 -1 0 0 -1 6.000 0 0 -1 0 0 3 - 1500 3300 11100 3300 11100 3600 -2 1 1 2 -1 -1 0 0 -1 6.000 0 0 -1 0 0 2 - 2402 16802 2402 17102 -2 1 1 1 -1 -1 0 0 -1 4.000 0 0 -1 0 0 2 - 4500 17100 4500 18900 -2 1 1 2 -1 -1 0 0 -1 6.000 0 0 -1 0 0 2 - 5400 16800 5400 17100 -2 1 1 1 -1 -1 0 0 -1 4.000 0 0 -1 0 0 2 - 10500 3600 10500 5100 -2 1 0 2 -1 -1 0 0 -1 0.000 0 0 -1 0 0 2 - 5402 7802 8102 7802 -2 1 0 2 -1 -1 0 0 -1 0.000 0 0 -1 0 0 2 - 8702 10802 13501 10801 -2 1 0 2 -1 -1 0 0 -1 0.000 0 0 -1 0 0 2 - 8702 7802 11101 7801 -2 1 1 2 -1 -1 0 0 -1 6.000 0 0 -1 0 0 2 - 8702 8402 8702 8702 -2 1 1 2 -1 -1 0 0 -1 6.000 0 0 -1 0 0 2 - 9602 8402 9602 8702 -2 1 1 2 -1 -1 0 0 -1 6.000 0 0 -1 0 0 2 - 10502 8402 10502 8702 -2 1 1 2 -1 -1 0 0 -1 6.000 0 0 -1 0 0 2 - 11402 8402 11402 8702 -2 1 1 2 -1 -1 0 0 -1 6.000 0 0 -1 0 0 2 - 8702 8402 11402 8402 -2 1 1 1 -1 -1 0 0 -1 4.000 0 0 -1 0 0 2 - 8402 6602 8402 12302 -2 1 1 2 -1 7 0 0 -1 6.000 0 0 -1 0 0 2 - 5702 6302 5702 6602 -2 1 1 1 -1 -1 0 0 -1 4.000 0 0 -1 0 0 2 - 5101 6601 5100 10200 -2 1 1 1 -1 7 0 0 -1 4.000 0 0 -1 0 0 2 - 11401 6601 11401 12301 -2 1 1 2 -1 -1 0 0 -1 6.000 0 0 -1 0 0 2 - 9302 8402 9302 8102 -2 1 1 2 -1 7 0 0 -1 6.000 0 0 -1 0 0 2 - 9001 6301 9001 6601 -2 1 1 2 -1 -1 0 0 -1 6.000 0 0 -1 0 0 2 - 1500 6300 14400 6300 -2 1 1 1 -1 7 0 0 -1 4.000 0 0 -1 0 0 3 - 13800 6600 13800 7800 15000 7800 -2 1 1 1 -1 7 0 0 -1 4.000 0 0 -1 0 0 2 - 13800 7800 13800 12300 -4 0 -1 0 0 0 20 0.0000000 0 195 1755 1800 6000 Edit list in core\001 -4 0 -1 0 0 0 20 0.0000000 0 195 960 8700 23400 TOTAL\001 -4 0 -1 0 0 0 20 0.0000000 0 195 1980 8700 23700 Show source-list\001 -4 0 -1 0 0 0 20 0.0000000 0 195 990 8700 24000 statistics\001 -4 0 -1 0 0 0 20 0.0000000 0 255 2100 2100 23700 Display source list\001 -4 0 -1 0 0 0 20 0.0000000 0 240 2340 2100 24000 with l,m coordinates\001 -4 0 -1 0 0 0 20 0.0000000 0 255 2100 5100 23700 Display source list\001 -4 0 -1 0 0 0 20 0.0000000 0 240 3030 5100 24000 with RA,DEC coordinates\001 -4 0 -1 0 0 0 20 0.0000000 0 195 615 2100 23400 LIST\001 -4 0 -1 0 0 0 20 0.0000000 0 195 855 3300 23400 SHOW\001 -4 0 -1 0 0 0 20 0.0000000 0 195 810 5100 23400 RLIST\001 -4 0 -1 0 0 2 20 0.0000000 0 255 2400 3600 24600 SOURCE_RANGE\001 -4 0 -1 0 0 0 20 0.0000000 0 195 2730 3600 24900 First and last line in list\001 -4 0 -1 0 0 0 20 0.0000000 0 255 1680 3600 25200 to be displayed\001 -4 0 -1 0 0 0 20 0.0000000 0 195 1050 6900 23400 RSHOW\001 -4 0 -1 0 0 0 20 0.0000000 0 195 1110 2400 13800 DELETE\001 -4 0 -1 0 0 0 20 0.0000000 0 195 1650 2400 14100 Delete sources\001 -4 0 -1 0 0 2 20 0.0000000 0 255 2145 10800 15000 DELETE_AREA\001 -4 0 -1 0 0 0 20 0.0000000 0 195 1065 5400 13800 DCLOW\001 -4 0 -1 0 0 0 20 0.0000000 0 195 1410 5400 14100 Delete weak\001 -4 0 -1 0 0 0 20 0.0000000 0 255 2040 5400 14400 clean components\001 -4 0 -1 0 0 0 20 0.0000000 0 195 2085 8100 14100 Delete weak non-\001 -4 0 -1 0 0 0 20 0.0000000 0 255 2040 8100 14400 clean components\001 -4 0 -1 0 0 0 20 0.0000000 0 195 1275 8100 13800 DNCLOW\001 -4 0 -1 0 0 0 20 0.0000000 0 195 1005 10800 13800 DAREA\001 -4 0 -1 0 0 0 20 0.0000000 0 195 1650 10800 14100 Delete sources\001 -4 0 -1 0 0 0 20 0.0000000 0 195 3750 6000 15300 Absolute I below which to delete\001 -4 0 -1 0 0 2 20 0.0000000 0 255 2310 6000 15000 DELETE_LEVEL\001 -4 0 -1 0 0 0 20 0.0000000 0 255 2955 1800 12900 Delete parts of list in core\001 -4 0 -1 0 0 0 20 0.0000000 0 195 960 13500 13800 CLEAR\001 -4 0 -1 0 0 0 20 0.0000000 0 195 1095 13500 14100 Delete all\001 -4 0 -1 0 0 0 20 0.0000000 0 135 840 13500 14400 sources\001 -4 0 -1 0 0 0 20 0.0000000 0 255 1575 10800 14400 in a map area\001 -4 0 -1 0 0 0 20 0.0000000 0 195 1380 2400 4200 Write list to\001 -4 0 -1 0 0 0 20 0.0000000 0 195 915 2400 3900 WRITE\001 -4 0 -1 0 0 0 20 0.0000000 0 195 1635 6000 4200 Read list from\001 -4 0 -1 0 0 0 20 0.0000000 0 195 795 6000 3900 READ\001 -4 0 -1 0 0 0 20 0.0000000 0 195 1080 3900 4200 MDL file\001 -4 0 -1 0 0 0 20 0.0000000 0 195 1080 7800 4200 MDL file\001 -4 0 -1 0 0 2 20 0.0000000 0 255 3000 2400 4800 OUTPUT_MDL_NODE\001 -4 0 -1 0 0 2 20 0.0000000 0 255 2730 6000 4800 INOUT_MDL_NODE\001 -4 0 -1 0 0 2 20 0.0000000 0 255 2010 2400 14700 SOURCE_LIST\001 -4 0 -1 0 0 2 20 0.0000000 0 255 2400 2400 15000 SOURCE_RANGE\001 -4 0 -1 0 0 0 20 0.0000000 0 195 2400 2400 15300 Sources to be deleted\001 -4 0 -1 0 0 2 20 0.0000000 0 255 1740 13500 15000 CLEAR_REF\001 -4 0 -1 0 0 1 20 0.0000000 0 195 1845 13500 15300 Clear ref. coord.\001 -4 0 -1 0 0 1 20 0.0000000 0 195 915 13500 15600 as well?\001 -4 0 -1 0 0 0 20 0.0000000 0 195 765 15900 13800 ZERO\001 -4 0 -1 0 0 0 20 0.0000000 0 240 2070 15900 14100 Delete all sources,\001 -4 0 -1 0 0 0 20 0.0000000 0 195 2430 15900 14400 reset reference coord.\001 -4 0 -1 0 0 2 20 0.0000000 0 255 2370 1202 2402 MODEL_OPTION\001 -4 0 -1 0 0 1 20 0.0000000 0 195 1245 302 902 NMODEL\001 -4 0 -1 0 0 2 20 0.0000000 0 195 1395 1802 902 ACTION =\001 -4 0 -1 0 0 1 20 0.0000000 0 255 3810 3302 902 HANDLE, see overview diagram\001 -4 0 -1 0 0 1 20 0.0000000 0 255 4050 1802 1202 of NMODEL's parameter interface\001 -4 0 -1 0 0 1 20 0.0000000 0 255 3840 8402 902 Model-handling sections in other\001 -4 0 -1 0 0 1 20 0.0000000 0 255 2565 9302 1202 NEWSTAR programs\001 -4 0 -1 0 0 0 20 0.0000000 0 195 5100 1802 3002 Transfers between list in core and .MDL file\001 -4 0 -1 0 0 1 20 0.0000000 0 195 1455 10800 3900 INTERNAL\001 -4 0 -1 0 0 1 20 0.0000000 0 240 3330 10800 4200 For each scan, use associated\001 -4 0 -1 0 0 1 20 0.0000000 0 195 2640 10800 4500 model visibilities in file\001 -4 0 -1 0 0 1 20 0.0000000 0 195 2700 9900 3000 .SCN-file model access\001 -4 0 -1 0 0 0 12 0.0000000 0 180 1710 14400 1200 nmodel_handle.fig 40%\001 -4 0 -1 0 0 0 20 0.0000000 0 255 2145 1800 22500 Display list in core\001 -4 0 -1 0 0 0 20 0.0000000 0 255 2550 1800 16500 Reorganise list in core\001 -4 0 -1 0 0 0 20 0.0000000 0 195 750 5100 17400 SORT\001 -4 0 -1 0 0 0 20 0.0000000 0 195 855 5100 17700 Sort on\001 -4 0 -1 0 0 0 20 0.0000000 0 195 915 5100 18000 Stokes I\001 -4 0 -1 0 0 0 20 0.0000000 0 195 1020 2102 17402 MERGE\001 -4 0 -1 0 0 1 20 0.0000000 0 255 2115 2100 17700 Consolidate list by\001 -4 0 -1 0 0 1 20 0.0000000 0 255 1890 2100 18000 pruning sources \001 -4 0 -1 0 0 1 20 0.0000000 0 240 2085 2100 18300 with identical l, m\001 -4 0 -1 0 0 1 20 0.0000000 0 195 945 2100 18600 and flux\001 -4 0 -1 0 0 0 20 0.0000000 0 255 3300 12300 9900 Shape parameters: Axes, p.a.\001 -4 0 -1 0 0 0 20 0.0000000 0 255 3300 12300 10200 Spectral index; rotn measure\001 -4 0 -1 0 0 2 20 0.0000000 0 255 2400 5402 8402 SOURCE_RANGE\001 -4 0 -1 0 0 2 20 0.0000000 0 255 2010 5402 8102 SOURCE_LIST\001 -4 0 -1 0 0 0 20 0.0000000 0 240 2070 5402 7502 and l,m of sources\001 -4 0 -1 0 0 0 20 0.0000000 0 255 1950 5402 7202 Change intensity\001 -4 0 -1 0 0 0 20 0.0000000 0 195 1635 5402 6902 CALIBRATE\001 -4 0 -1 0 0 2 20 0.0000000 0 255 2745 5402 9302 SOURCE_FACTORS\001 -4 0 -1 0 0 0 20 0.0000000 0 240 1455 5402 9602 Gain factor, \001 -4 0 -1 0 0 0 20 0.0000000 0 240 1695 5402 9902 l,m increments\001 -4 0 -1 0 0 0 20 0.0000000 0 195 2595 5402 8702 Sources to be modified\001 -4 0 -1 0 0 0 20 0.0000000 0 195 2580 10802 8102 Parameter to be edited\001 -4 0 -1 0 0 0 20 0.0000000 0 195 90 8702 9002 I\001 -4 0 -1 0 0 0 20 0.0000000 0 255 210 9602 9002 Q\001 -4 0 -1 0 0 0 20 0.0000000 0 195 210 10502 9002 U\001 -4 0 -1 0 0 0 20 0.0000000 0 195 210 11402 9002 V\001 -4 0 -1 0 0 0 20 0.0000000 0 255 2100 12302 9002 Stokes parameters\001 -4 0 -1 0 0 0 20 0.0000000 0 195 555 8702 9302 POL\001 -4 0 -1 0 0 0 20 0.0000000 0 255 2115 12302 9302 Polarised intensity\001 -4 0 -1 0 0 0 20 0.0000000 0 195 180 8702 9602 L\001 -4 0 -1 0 0 0 20 0.0000000 0 195 255 9602 9602 M\001 -4 0 -1 0 0 0 20 0.0000000 0 240 1740 12302 9602 l,m coordinates\001 -4 0 -1 0 0 0 20 0.0000000 0 195 390 8702 9902 LA\001 -4 0 -1 0 0 0 20 0.0000000 0 195 375 9602 9902 SA\001 -4 0 -1 0 0 0 20 0.0000000 0 195 375 10502 9902 PA\001 -4 0 -1 0 0 0 20 0.0000000 0 195 255 8702 10202 SI\001 -4 0 -1 0 0 0 20 0.0000000 0 195 450 9602 10202 RM\001 -4 0 -1 0 0 0 20 0.0000000 0 195 840 11402 10502 CCBM\001 -4 0 -1 0 0 0 20 0.0000000 0 195 630 10502 10502 BITS\001 -4 0 -1 0 0 0 20 0.0000000 0 195 555 9602 10502 TYP\001 -4 0 -1 0 0 0 20 0.0000000 0 195 300 8702 10502 ID\001 -4 0 -1 0 0 0 20 0.0000000 0 195 2535 12302 10502 Source classifications \001 -4 0 -1 0 0 0 20 0.0000000 0 195 1710 8702 7202 Edit source list\001 -4 0 -1 0 0 2 20 0.0000000 0 255 1725 8702 8102 EDIT_FIELD\001 -4 0 -1 0 0 0 20 0.0000000 0 195 825 8702 6902 FEDIT\001 -4 0 -1 0 0 1 20 0.0000000 0 195 660 11701 6901 EDIT\001 -4 0 -1 0 0 2 20 0.0000000 0 255 1860 9003 11403 EDIT_VALUE\001 -4 0 -1 0 0 2 20 0.0000000 0 255 2010 9003 11703 SOURCE_LIST\001 -4 0 -1 0 0 2 20 0.0000000 0 255 2400 9003 12003 SOURCE_RANGE\001 -4 0 -1 0 0 0 20 0.0000000 0 195 1380 11703 11403 Value to set\001 -4 0 -1 0 0 0 20 0.0000000 0 195 1395 11703 11703 Source lines\001 -4 0 -1 0 0 0 20 0.0000000 0 195 1305 12003 12003 to be edited\001 diff --git a/src/doc/fig/nmodel_interface.cap b/src/doc/fig/nmodel_interface.cap deleted file mode 100644 index 802572b34d2e1efc8a37512e4c95e861ab5a4da3..0000000000000000000000000000000000000000 --- a/src/doc/fig/nmodel_interface.cap +++ /dev/null @@ -1,12 +0,0 @@ -%nmodel_interface.tex - -\begin{figure} -\fig{nmodel_interface} -\caption{\it -\label{.nmodel.interface} -Overview of the actions in NMODEL. \\ -See the companion diagrams for details of the -model-handling (\figref{.nmodel.handle}) and -model-conversion (\figref{.nmodel.convert}) interfaces -} -\end{figure} diff --git a/src/doc/fig/nmodel_interface.fig b/src/doc/fig/nmodel_interface.fig deleted file mode 100644 index 402af55ae3f5b04f4f8cf67b58ab0cdca6c8b720..0000000000000000000000000000000000000000 --- a/src/doc/fig/nmodel_interface.fig +++ /dev/null @@ -1,234 +0,0 @@ -#FIG 3.1 -Portrait -Center -Inches -1200 2 -6 1800 12300 7200 14400 -2 1 1 2 -1 -1 0 0 -1 6.000 0 0 -1 0 0 2 - 5702 12302 5705 12605 -2 1 1 2 -1 -1 0 0 -1 6.000 0 0 -1 0 0 2 - 2405 12305 2405 12605 -2 1 1 1 -1 -1 0 0 -1 4.000 0 0 -1 0 0 2 - 4805 12605 4801 14101 -4 0 -1 0 0 0 20 0.0000000 0 195 795 1805 12905 READ\001 -4 0 -1 0 0 0 20 0.0000000 0 195 1815 1805 13205 Read source list\001 -4 0 -1 0 0 2 20 0.0000000 0 255 2685 1805 13805 INPUT_MDL_NODE\001 -4 0 -1 0 0 2 20 0.0000000 0 255 3000 5105 13805 OUTPUT_MDL_NODE\001 -4 0 -1 0 0 0 20 0.0000000 0 195 915 5105 12905 WRITE\001 -4 0 -1 0 0 0 20 0.0000000 0 195 1890 5105 13205 Write source list\001 --6 -6 1200 15600 16500 24000 -2 1 1 2 -1 -1 0 0 0 6.000 0 0 -1 0 0 2 - 1205 16205 3602 16202 -2 1 0 2 -1 -1 0 0 0 0.000 0 0 -1 0 0 2 - 1803 17103 5702 17102 -2 1 1 2 -1 -1 0 0 0 6.000 0 0 -1 0 0 2 - 2103 16203 2103 16503 -2 1 1 2 -1 -1 0 0 0 6.000 0 0 -1 0 0 2 - 3602 16202 3602 16502 -2 1 1 1 -1 -1 0 0 -1 4.000 0 0 -1 0 0 3 - 3002 16502 3002 18302 3001 18901 -2 1 0 2 -1 7 0 0 -1 0.000 0 0 -1 0 0 2 - 3302 18002 5702 18002 -2 1 1 1 -1 -1 0 0 0 4.000 0 0 -1 0 0 1 - 7206 21306 -2 1 1 1 -1 -1 0 0 0 4.000 0 0 -1 0 0 1 - 7206 21306 -2 1 1 2 -1 7 0 0 -1 6.000 0 0 -1 0 0 1 - 3604 19504 -2 1 1 2 -1 7 0 0 -1 6.000 0 0 -1 0 0 3 - 3601 19051 3604 20704 3904 20704 -2 1 1 2 -1 7 0 0 -1 6.000 0 0 -1 0 0 2 - 3604 20404 3904 20404 -2 1 1 2 -1 7 0 0 -1 6.000 0 0 -1 0 0 2 - 3604 20104 3904 20104 -2 1 1 2 -1 7 0 0 -1 6.000 0 0 -1 0 0 2 - 3604 19804 3904 19804 -2 1 1 2 -1 7 0 0 -1 6.000 0 0 -1 0 0 1 - 6004 19504 -2 1 1 2 -1 7 0 0 -1 6.000 0 0 -1 0 0 3 - 9901 19351 9903 21603 10203 21603 -2 1 1 2 -1 7 0 0 -1 6.000 0 0 -1 0 0 2 - 9903 19803 10203 19803 -2 1 1 2 -1 -1 0 0 -1 6.000 0 0 -1 0 0 2 - 1201 23701 5101 23701 -2 1 1 2 -1 7 0 0 -1 6.000 0 0 -1 0 0 3 - 10801 21751 10804 22504 11104 22504 -2 1 1 2 -1 7 0 0 -1 6.000 0 0 -1 0 0 2 - 10804 22204 11104 22204 -2 1 1 2 -1 7 0 0 -1 6.000 0 0 -1 0 0 3 - 10801 19951 10804 21004 11104 21004 -2 1 1 2 -1 7 0 0 -1 6.000 0 0 -1 0 0 2 - 10804 20704 11104 20704 -2 1 1 2 -1 7 0 0 -1 6.000 0 0 -1 0 0 2 - 10804 20404 11104 20404 -2 1 1 2 -1 7 0 0 -1 6.000 0 0 -1 0 0 2 - 3301 18601 14101 18601 -4 0 -1 0 0 1 20 0.0000000 0 195 3750 1503 15903 Access model stored in .SCN file\001 -4 0 -1 0 0 2 20 0.0000000 0 255 1560 2703 17403 SCN_NODE\001 -4 0 -1 0 0 2 20 0.0000000 0 255 1440 2703 17703 SCN_SETS\001 -4 0 -1 0 0 0 20 0.0000000 0 195 570 1802 16802 GET\001 -4 0 -1 0 0 0 20 0.0000000 0 195 765 3302 16802 SAVE\001 -4 0 -1 0 0 2 20 0.0000000 0 255 2385 3302 18302 MODEL_ACTION\001 -4 0 -1 0 0 1 20 0.0000000 0 195 1875 6002 18302 Combination of:\001 -4 0 -1 0 0 0 20 0.0000000 0 240 1440 4211 19811 [NO]BEAM\001 -4 0 -1 0 0 0 20 0.0000000 0 240 1425 4206 20106 [NO]BAND\001 -4 0 -1 0 0 0 20 0.0000000 0 240 1305 4206 20406 [NO]TIME\001 -4 0 -1 0 0 0 20 0.0000000 0 240 1455 4206 20706 [NO]INPOL\001 -4 0 -1 0 0 0 12 0.0000000 0 135 1080 2104 19504 set MODACT\001 -4 0 -1 0 0 0 12 0.0000000 0 135 240 2404 19804 bit \001 -4 0 -1 0 0 0 12 0.0000000 0 135 240 2404 20104 bit \001 -4 0 -1 0 0 0 12 0.0000000 0 135 240 2404 20404 bit \001 -4 0 -1 0 0 0 12 0.0000000 0 135 240 2404 20704 bit \001 -4 0 -1 0 0 0 20 0.0000000 0 195 1275 6012 20112 Bandwidth\001 -4 0 -1 0 0 0 20 0.0000000 0 255 1050 8112 20412 smearing\001 -4 0 -1 0 0 1 20 0.0000000 0 255 1725 6007 19807 Primary-beam\001 -4 0 -1 0 0 1 20 0.0000000 0 195 1155 7807 19807 correction\001 -4 0 -1 0 0 0 20 0.0000000 0 255 1050 7507 20107 smearing\001 -4 0 -1 0 0 0 20 0.0000000 0 255 2025 6007 20407 Time-integration\001 -4 0 -1 0 0 0 20 0.0000000 0 255 1725 6007 20707 Primary-beam\001 -4 0 -1 0 0 0 20 0.0000000 0 255 1350 7807 20707 polarisation\001 -4 0 -1 0 0 1 20 0.0000000 0 255 3420 3302 18902 source-component processing\001 -4 0 -1 0 0 1 20 0.0000000 0 195 4320 9603 18903 how to combine .SCN model list with\001 -4 0 -1 0 0 1 20 0.0000000 0 255 2550 9903 19203 the list already in core\001 -4 0 -1 0 0 1 20 0.0000000 0 255 4800 10503 19803 rewriting the resultant model to .SCN file\001 -4 0 -1 0 0 1 20 0.0000000 0 255 4005 10503 21603 without saving the resultant model\001 -4 0 -1 0 0 1 20 0.0000000 0 255 2940 1501 23401 Manipulate model in core\001 -4 0 -1 0 0 0 20 0.0000000 0 195 1200 5401 23701 HANDLE\001 -4 0 -1 0 0 3 20 0.0000000 0 270 3720 6901 23701 see NMODEL HANDLE diagram\001 -4 0 -1 0 0 1 20 0.0000000 0 195 1695 11404 22204 INCREMENT\001 -4 0 -1 0 0 1 20 0.0000000 0 195 780 11404 22504 TEMP\001 -4 0 -1 0 0 1 20 0.0000000 0 195 720 13204 22504 as add\001 -4 0 -1 0 0 1 20 0.0000000 0 195 1335 13204 22204 as MERGE\001 -4 0 -1 0 0 1 20 0.0000000 0 195 1170 13204 20404 Overwrite\001 -4 0 -1 0 0 1 20 0.0000000 0 195 1365 14404 20704 incremental\001 -4 0 -1 0 0 1 20 0.0000000 0 255 945 13204 20704 Straight\001 -4 0 -1 0 0 1 20 0.0000000 0 255 1500 14704 21004 with pruning\001 -4 0 -1 0 0 1 20 0.0000000 0 195 1380 13204 21004 Incremental\001 -4 0 -1 0 0 1 20 0.0000000 0 195 660 11404 20404 NEW\001 -4 0 -1 0 0 1 20 0.0000000 0 195 630 11404 20704 ADD\001 -4 0 -1 0 0 1 20 0.0000000 0 195 1020 11404 21004 MERGE\001 --6 -2 1 2 2 -1 7 0 0 -1 4.500 0 0 -1 0 0 1 - 1500 7200 -2 1 1 2 -1 7 0 0 -1 6.000 0 0 -1 0 0 1 - 1201 2701 -2 1 1 2 -1 7 0 0 -1 6.000 0 0 -1 0 0 2 - 1201 2701 9900 2700 -2 1 1 2 -1 7 0 0 -1 6.000 0 0 -1 0 0 2 - 9901 2701 9901 3001 -2 1 1 2 -1 -1 0 0 0 6.000 0 0 -1 0 0 2 - 2100 4200 6903 4203 -2 1 1 2 -1 -1 0 0 0 6.000 0 0 -1 0 0 2 - 2100 4200 2100 4500 -2 1 1 2 -1 -1 0 0 0 6.000 0 0 -1 0 0 2 - 4503 4203 4503 4503 -2 1 1 2 -1 -1 0 0 0 6.000 0 0 -1 0 0 2 - 6903 4203 6903 4503 -2 1 0 2 -1 -1 0 0 0 0.000 0 0 -1 0 0 2 - 1803 5703 8703 5703 -2 1 1 1 -1 7 0 0 -1 4.000 0 0 -1 0 0 1 - 3900 4500 -2 1 1 1 -1 7 0 0 -1 4.000 0 0 -1 0 0 2 - 3900 4500 3900 11100 -2 1 1 1 -1 7 0 0 -1 4.000 0 0 -1 0 0 2 - 6300 4500 6300 11100 -2 1 1 2 -1 7 0 0 -1 6.000 0 0 -1 0 0 3 - 9900 4200 9900 6900 10200 6900 -2 1 1 2 -1 7 0 0 -1 6.000 0 0 -1 0 0 2 - 9900 6600 10200 6600 -2 1 1 2 -1 7 0 0 -1 6.000 0 0 -1 0 0 2 - 9900 6000 10200 6000 -2 1 1 2 -1 7 0 0 -1 6.000 0 0 -1 0 0 2 - 9900 5400 10200 5400 -2 1 1 2 -1 7 0 0 -1 6.000 0 0 -1 0 0 2 - 9900 5100 10200 5100 -2 1 1 2 -1 7 0 0 -1 6.000 0 0 -1 0 0 2 - 9900 4800 10200 4800 -2 1 1 2 -1 7 0 0 -1 6.000 0 0 -1 0 0 2 - 9900 4500 10200 4500 -2 1 1 2 -1 7 0 0 -1 6.000 0 0 -1 0 0 4 - 9904 8104 9904 7804 15900 7800 15900 8100 -2 1 0 2 -1 7 0 0 -1 0.000 0 0 -1 0 0 2 - 9304 9004 17400 9000 -2 1 1 2 -1 7 0 0 -1 6.000 0 0 -1 0 0 2 - 13505 7805 13505 8105 -2 1 0 2 -1 7 0 0 -1 0.000 0 0 -1 0 0 1 - 9304 10804 -2 1 0 2 -1 7 0 0 -1 0.000 0 0 -1 0 0 2 - 9304 10804 12004 10804 -2 1 1 1 -1 7 0 0 -1 4.000 0 0 7 0 0 2 - 12304 8104 12302 11402 -2 1 1 1 -1 7 0 0 -1 4.000 0 0 7 0 0 2 - 9000 11400 9001 3001 -2 1 1 2 -1 7 0 0 -1 6.000 0 0 -1 0 0 2 - 1200 12300 5700 12300 -2 1 1 2 -1 -1 0 0 -1 6.000 0 0 -1 0 0 2 - 1200 23700 1200 2100 -2 1 1 2 -1 7 0 0 -1 6.000 0 0 -1 0 0 2 - 1200 15000 5100 15000 -2 1 1 1 -1 7 0 0 -1 4.000 0 0 7 0 0 2 - 15000 8100 14998 11398 -4 0 -1 0 0 2 20 0.0000000 0 195 1155 900 1800 ACTION\001 -4 0 -1 0 0 1 20 0.0000000 0 255 3810 1801 2401 Create/update model components\001 -4 0 -1 0 0 1 20 0.0000000 0 195 1155 9300 3300 UPDATE\001 -4 0 -1 0 0 1 20 0.0000000 0 255 4800 11100 3300 Refine parameters of existing components\001 -4 0 -1 0 0 0 20 0.0000000 0 195 675 1803 3303 FIND\001 -4 0 -1 0 0 0 20 0.0000000 0 255 2310 3003 3303 Find sources in map\001 -4 0 -1 0 0 2 20 0.0000000 0 255 1620 1803 3903 FIND_TYPE\001 -4 0 -1 0 0 0 20 0.0000000 0 195 2625 3903 3903 How to locate a source\001 -4 0 -1 0 0 0 20 0.0000000 0 195 540 1803 4803 POS\001 -4 0 -1 0 0 0 20 0.0000000 0 195 570 4203 4803 ABS\001 -4 0 -1 0 0 0 20 0.0000000 0 255 1830 1803 5103 Highest positive\001 -4 0 -1 0 0 0 20 0.0000000 0 255 1905 4203 5103 Highest absolute\001 -4 0 -1 0 0 0 20 0.0000000 0 195 675 6603 4803 MAN\001 -4 0 -1 0 0 0 20 0.0000000 0 195 1785 6603 5103 Manual control\001 -4 0 -1 0 0 0 20 0.0000000 0 195 1830 6603 5403 on GIDS screen\001 -4 0 -1 0 0 2 20 0.0000000 0 255 1710 4203 6003 WMP_NODE\001 -4 0 -1 0 0 2 20 0.0000000 0 255 1590 4203 6303 WMP_SETS\001 -4 0 -1 0 0 2 20 0.0000000 0 195 825 4203 6903 AREA\001 -4 0 -1 0 0 0 20 0.0000000 0 195 1470 4203 7203 Search areas\001 -4 0 -1 0 0 2 20 0.0000000 0 255 1665 4203 7803 MAP_LIMIT\001 -4 0 -1 0 0 2 20 0.0000000 0 255 2115 4203 9003 MAX_NUMBER\001 -4 0 -1 0 0 1 20 0.0000000 0 195 2085 4203 8103 Minimum relative\001 -4 0 -1 0 0 1 20 0.0000000 0 255 1785 4203 8403 component flux\001 -4 0 -1 0 0 1 20 0.0000000 0 195 2160 4203 9303 Maximum number\001 -4 0 -1 0 0 1 20 0.0000000 0 255 1665 4203 9603 of components\001 -4 0 -1 0 0 2 20 0.0000000 0 255 1425 4203 10203 ID_START\001 -4 0 -1 0 0 1 20 0.0000000 0 195 1740 4203 10503 ID number for \001 -4 0 -1 0 0 1 20 0.0000000 0 255 2355 4203 10803 first new component\001 -4 0 -1 0 0 2 20 0.0000000 0 255 2115 9300 3900 UPDATE_TYPE\001 -4 0 -1 0 0 1 20 0.0000000 0 195 90 10500 4500 I\001 -4 0 -1 0 0 1 20 0.0000000 0 195 435 10500 4800 LM\001 -4 0 -1 0 0 1 20 0.0000000 0 195 525 10500 5100 ILM\001 -4 0 -1 0 0 1 20 0.0000000 0 195 690 10500 5400 SILM\001 -4 0 -1 0 0 1 20 0.0000000 0 195 1170 10500 6000 EXTEND\001 -4 0 -1 0 0 1 20 0.0000000 0 255 630 10500 6600 QUV\001 -4 0 -1 0 0 1 20 0.0000000 0 195 1605 10500 6900 PESTIMATE\001 -4 0 -1 0 0 1 20 0.0000000 0 255 1095 12300 4500 Flux only\001 -4 0 -1 0 0 1 20 0.0000000 0 195 1950 12300 5100 Position and flux\001 -4 0 -1 0 0 1 20 0.0000000 0 255 1500 12300 4800 Position only\001 -4 0 -1 0 0 1 20 0.0000000 0 255 3660 12300 5400 Position, flux and spectral index\001 -4 0 -1 0 0 1 20 0.0000000 0 255 2490 12300 6000 Extension parameters\001 -4 0 -1 0 0 1 20 0.0000000 0 255 2220 12300 6600 Stokes Q/I, U/I, V/I\001 -4 0 -1 0 0 1 20 0.0000000 0 255 3720 12300 6900 Percentage of linear polarisation\001 -4 0 -1 0 0 1 20 0.0000000 0 195 1305 9304 8404 CLUSTER\001 -4 0 -1 0 0 1 20 0.0000000 0 195 1485 9304 8704 LCLUSTER\001 -4 0 -1 0 0 2 20 0.0000000 0 255 2715 9304 11104 UPDATE_CLUSTER\001 -4 0 -1 0 0 1 20 0.0000000 0 195 1545 12905 8405 COMBINED\001 -4 0 -1 0 0 1 20 0.0000000 0 195 1725 12905 8705 LCOMBINED\001 -4 0 -1 0 0 2 20 0.0000000 0 255 1560 12605 9305 SCN_NODE\001 -4 0 -1 0 0 2 20 0.0000000 0 255 1440 12605 9605 SCN_SETS\001 -4 0 -1 0 0 2 20 0.0000000 0 255 1620 12605 10205 HA_RANGE\001 -4 0 -1 0 0 2 20 0.0000000 0 255 1920 12601 9901 SELECT_XYX\001 -4 0 -1 0 0 2 20 0.0000000 0 195 660 12601 10501 IFRS\001 -4 0 -1 0 0 2 20 0.0000000 0 255 2235 9300 7500 UPDATE_MODE\001 -4 0 -1 0 0 1 20 0.0000000 0 255 3750 12000 3900 Source parameters to be updated\001 -4 0 -1 0 0 2 20 0.0000000 0 255 1560 12600 9300 SCN_NODE\001 -4 0 -1 0 0 1 20 0.0000000 0 195 3060 1500 12000 Access model in .MDL file\001 -4 0 -1 0 0 0 12 0.0000000 0 180 1860 12900 1800 nmodel_interface.fig 45%\001 -4 0 -1 0 0 1 20 0.0000000 0 195 2640 1500 14700 .MDL-file conversions\001 -4 0 -1 0 0 0 20 0.0000000 0 240 5670 5400 15000 CVX, NVS, CONVERT, EDIT, REDIT, FEDIT:\001 -4 0 -1 0 0 3 20 0.0000000 0 270 3945 11100 15000 see NMODEL CONVERT diagram \001 -4 0 -1 0 0 1 20 0.0000000 0 195 2055 15300 8400 CONSTRAINED\001 -4 0 -1 0 0 1 20 0.0000000 0 195 2235 15300 8700 LCONSTRAINED\001 diff --git a/src/doc/fig/nplot_interface.cap b/src/doc/fig/nplot_interface.cap deleted file mode 100644 index 0f03686e692bbbb70604b7a9a357f58220244d02..0000000000000000000000000000000000000000 --- a/src/doc/fig/nplot_interface.cap +++ /dev/null @@ -1,11 +0,0 @@ -%nplot_interface.tex -\begin{figure}[hbtp] - -%\fig{nplot_interface} -% -\caption{\it -\label{.nplot.interface} -Overview of the actions in NPLOT. -} - -\end{figure} diff --git a/src/doc/fig/nscan_interface.cap b/src/doc/fig/nscan_interface.cap deleted file mode 100644 index a47518baba67c5c914417c381b66e687578e8440..0000000000000000000000000000000000000000 --- a/src/doc/fig/nscan_interface.cap +++ /dev/null @@ -1,11 +0,0 @@ -%nscan_interface.tex -\begin{figure}[hbtp] - -%\fig{nscan_interface} -% -\caption{\it -\label{.nscan.interface} -Overview of the actions in NSCAN. -} - -\end{figure} diff --git a/src/doc/fig/scn_contents.cap b/src/doc/fig/scn_contents.cap deleted file mode 100644 index 07f026b7e25f62edf12f2459d8dd8e5e682f8e84..0000000000000000000000000000000000000000 --- a/src/doc/fig/scn_contents.cap +++ /dev/null @@ -1,23 +0,0 @@ -%scn_contents.tex -\begin{figure} -\fig{scn_contents} -\caption[.]{\it -\label{.scn.contents} -UV data and correction model in the .SCN file - - The SCN-file contains uv-data and its corrections. It can also -contain the uv-representation (i.e. mapped to the uv-coordinates of the -uv-data) of a SELFCAL source model. The reason for this approach is -that it is a very time-consuming process to transform a model of many -many ($>100$) source components to the uv-plane. - - If the uv-model is available, it may be used for various -``casual'' purposes (e.g. calculating SELFCAL residues, or subtraction -from the uv-data) without a large time-penalty. It is also much quicker -to recalculate the uv-model when only a few of the many source -components have changed. - - Obviously, the component-representation (a copy of a .MDL file) -of the stored uv-model must also be kept in the SCN-file. -} -\end{figure} diff --git a/src/doc/fig/scn_contents.fig b/src/doc/fig/scn_contents.fig deleted file mode 100644 index 64952679791e7f723fc125789b047cd738c05563..0000000000000000000000000000000000000000 --- a/src/doc/fig/scn_contents.fig +++ /dev/null @@ -1,28 +0,0 @@ -#FIG 3.1 -Portrait -Center -Inches -1200 2 -1 4 0 1 -1 -1 0 0 -1 0.0000000 1 0.000 13500 5700 900 900 12600 5700 14400 5700 -2 2 0 1 -1 -1 0 0 -1 0.000 0 0 0 0 0 5 - 11100 6600 11100 4800 9300 4800 9300 6600 11100 6600 -2 1 0 1 -1 -1 0 0 -1 0.000 0 0 -1 1 0 2 - 0 0 1.00 75.00 135.00 - 11100 5700 12600 5700 -2 1 0 1 -1 -1 0 0 -1 0.000 0 0 -1 1 0 2 - 0 0 1.00 75.00 135.00 - 9300 5700 8700 5700 -2 2 0 1 -1 -1 0 0 -1 0.000 0 0 0 0 0 5 - 5700 6900 5700 4500 3300 4500 3300 6900 5700 6900 -2 2 1 1 -1 -1 0 0 -1 4.000 0 0 0 0 0 5 - 8700 6900 8700 4500 6300 4500 6300 6900 8700 6900 -2 2 0 1 -1 -1 0 0 -1 0.000 0 0 0 0 0 5 - 11400 7200 11400 4200 3000 4200 3000 7200 11400 7200 -4 0 -1 0 0 3 20 0.0000000 0 210 1020 3900 5700 UV data\001 -4 0 -1 0 0 3 20 0.0000000 0 210 1200 6900 5700 UV model\001 -4 0 -1 0 0 3 20 0.0000000 0 135 720 9900 5400 source\001 -4 0 -1 0 0 3 20 0.0000000 0 210 705 9900 5700 model\001 -4 0 -1 0 0 3 20 0.0000000 0 225 1245 9600 6000 component\001 -4 0 -1 0 0 3 20 0.0000000 0 210 345 9900 6300 list\001 -4 0 -1 0 0 3 20 0.0000000 0 270 1125 12900 5700 .MDL file\001 -4 0 -1 0 0 0 10 0.0000000 0 150 1320 8700 8700 scn_contents.fig 50%\001 diff --git a/src/doc/fig/scn_hierarchy.cap b/src/doc/fig/scn_hierarchy.cap deleted file mode 100644 index 6bd9cd73ec2e459c5585f70824624a59ce6534ed..0000000000000000000000000000000000000000 --- a/src/doc/fig/scn_hierarchy.cap +++ /dev/null @@ -1,12 +0,0 @@ -%scn_hierarchy.cap -\begin{figure} -\fig{scn_hierarchy} -\caption[]{ \it -\label{.scn.hierarchy} -The scan and sector structures in a .SCN-file with the indexing hierarchy in -which they are embedded. -\\ -See text for further explanation. -} -\end{figure} - diff --git a/src/doc/fig/scn_hierarchy.fig b/src/doc/fig/scn_hierarchy.fig deleted file mode 100644 index 5f53abb294112562ab479722564f2ac58f4d0d24..0000000000000000000000000000000000000000 --- a/src/doc/fig/scn_hierarchy.fig +++ /dev/null @@ -1,149 +0,0 @@ -#FIG 3.1 -Portrait -Center -Inches -1200 2 -6 10500 15375 12075 16950 -4 0 -1 0 0 1 20 0.7854000 0 255 1305 10800 16725 hour angle \001 -4 0 -1 0 0 1 20 0.7854000 0 195 1470 11025 16950 scan number\001 -4 0 -1 0 0 3 20 0.7854000 0 135 225 11760 15780 or\001 --6 -2 1 1 2 -1 -1 0 0 -1 6.000 0 0 -1 1 0 3 - 0 0 2.00 135.00 255.00 - 16200 6900 13200 6900 13200 7500 -2 2 0 2 -1 -1 0 0 -1 0.000 0 0 0 0 0 5 - 17700 8100 17700 7200 15000 7200 15000 8100 17700 8100 -2 2 0 2 -1 -1 0 0 -1 0.000 0 0 0 0 0 5 - 18900 6300 18900 5400 16200 5400 16200 6300 18900 6300 -2 1 0 2 -1 -1 0 0 -1 0.000 0 0 -1 1 0 4 - 0 0 2.00 135.00 255.00 - 16200 8100 16200 8700 15000 8700 15000 9000 -2 1 0 2 -1 -1 0 0 -1 0.000 0 0 -1 1 0 4 - 0 0 2.00 135.00 255.00 - 17400 6300 17400 6900 16200 6900 16200 7200 -2 1 1 2 -1 -1 0 0 -1 6.000 0 0 -1 1 0 3 - 0 0 2.00 135.00 255.00 - 17400 6900 19500 6900 19500 7200 -2 2 0 2 -1 -1 0 0 -1 0.000 0 0 0 0 0 5 - 20100 4500 20100 3600 17400 3600 17400 4500 20100 4500 -2 1 1 2 -1 -1 0 0 -1 6.000 0 0 -1 1 0 3 - 0 0 2.00 135.00 255.00 - 17400 5100 14400 5100 14400 5400 -2 1 1 2 -1 -1 0 0 -1 6.000 0 0 -1 1 0 3 - 0 0 2.00 135.00 255.00 - 18600 5100 20700 5100 20700 5400 -2 1 0 2 -1 -1 0 0 -1 0.000 0 0 -1 1 0 4 - 0 0 2.00 135.00 255.00 - 18600 4500 18600 5100 17400 5100 17400 5400 -2 2 1 2 -1 -1 0 0 -1 6.000 0 0 7 0 0 5 - 15600 6300 15600 5400 13200 5400 13200 6300 15600 6300 -2 2 1 2 -1 -1 0 0 -1 6.000 0 0 7 0 0 5 - 14400 8100 14400 7200 12000 7200 12000 8100 14400 8100 -2 2 1 2 -1 -1 0 0 -1 6.000 0 0 7 0 0 5 - 20700 8100 20700 7200 18300 7200 18300 8100 20700 8100 -2 2 1 2 -1 -1 0 0 -1 6.000 0 0 7 0 0 5 - 21900 6300 21900 5400 19500 5400 19500 6300 21900 6300 -2 1 0 2 -1 -1 0 0 -1 0.000 0 0 -1 1 0 4 - 0 0 2.00 135.00 255.00 - 13800 11700 13800 12300 12900 12300 12900 12600 -2 2 0 2 -1 -1 0 0 -1 0.000 0 0 0 0 0 5 - 15000 11700 15000 10800 12600 10800 12600 11700 15000 11700 -2 1 1 2 -1 -1 0 0 -1 6.000 0 0 7 1 0 3 - 0 0 2.00 135.00 255.00 - 13800 10500 10800 10500 10800 10800 -2 1 1 2 -1 -1 0 0 -1 6.000 0 0 -1 1 0 3 - 0 0 2.00 135.00 255.00 - 15000 10500 16800 10500 16800 10800 -2 2 1 2 -1 -1 0 0 -1 6.000 0 0 7 0 0 5 - 12000 11700 12000 10800 9600 10800 9600 11700 12000 11700 -2 2 1 2 -1 -1 0 0 -1 6.000 0 0 7 0 0 5 - 18000 11700 18000 10800 15600 10800 15600 11700 18000 11700 -2 1 0 2 -1 -1 0 0 -1 0.000 0 0 -1 1 0 4 - 0 0 2.00 135.00 255.00 - 15000 9900 15000 10500 13800 10500 13800 10800 -2 2 0 2 -1 -1 0 0 -1 0.000 0 0 0 0 0 5 - 16200 9900 16200 9000 13800 9000 13800 9900 16200 9900 -2 1 1 2 -1 -1 0 0 -1 6.000 0 0 7 1 0 3 - 0 0 2.00 135.00 255.00 - 15000 8700 12000 8700 12000 9000 -2 1 1 2 -1 -1 0 0 -1 6.000 0 0 -1 1 0 3 - 0 0 2.00 135.00 255.00 - 16200 8700 18000 8700 18000 9000 -2 2 1 2 -1 -1 0 0 -1 6.000 0 0 7 0 0 5 - 13200 9900 13200 9000 10800 9000 10800 9900 13200 9900 -2 2 1 2 -1 -1 0 0 -1 6.000 0 0 7 0 0 5 - 19200 9900 19200 9000 16800 9000 16800 9900 19200 9900 -2 1 0 2 -1 -1 0 0 -1 0.000 0 0 -1 0 0 2 - 11400 18000 13800 18000 -2 1 0 2 -1 -1 0 0 -1 0.000 0 0 -1 1 0 2 - 0 0 2.00 135.00 255.00 - 12000 18600 13200 18600 -2 1 0 2 -1 -1 0 0 -1 0.000 0 0 -1 1 0 2 - 0 0 2.00 135.00 255.00 - 12000 18600 12000 20400 -2 1 0 2 -1 -1 0 0 -1 0.000 0 0 -1 0 0 5 - 12000 16800 12000 16500 14400 16500 14400 20100 14100 20100 -2 1 0 2 -1 -1 0 0 -1 0.000 0 0 -1 0 0 5 - 11700 17100 11700 16800 14100 16800 14100 20400 13800 20400 -2 2 0 2 -1 -1 0 0 -1 0.000 0 0 0 0 0 5 - 13800 20700 13800 17100 11400 17100 11400 20700 13800 20700 -2 1 0 2 -1 -1 0 0 -1 0.000 0 0 -1 1 0 2 - 0 0 2.00 135.00 255.00 - 11100 17100 12300 15900 -2 1 0 2 -1 -1 0 0 -1 0.000 0 0 -1 0 0 2 - 10500 15000 15600 15000 -2 1 1 2 -1 -1 0 0 -1 6.000 0 0 -1 0 0 2 - 13200 16500 14100 15600 -2 1 1 2 -1 -1 0 0 -1 6.000 0 0 -1 0 0 5 - 12900 16500 12900 15600 15300 15600 15300 19200 14400 19200 -2 1 0 2 -1 -1 0 0 -1 0.000 0 0 -1 0 0 2 - 14100 17700 13800 17700 -2 1 0 2 -1 -1 0 0 -1 0.000 0 0 -1 0 0 2 - 14400 17400 14100 17400 -2 2 0 2 -1 -1 0 0 -1 0.000 0 0 0 0 0 5 - 15600 21000 15600 14100 10500 14100 10500 21000 15600 21000 -2 2 1 2 -1 -1 0 0 -1 6.000 0 0 7 0 0 5 - 21300 21000 21300 14100 16200 14100 16200 21000 21300 21000 -2 1 1 2 -1 -1 0 0 -1 6.000 0 0 7 0 0 2 - 16200 15000 21300 15000 -2 2 1 2 -1 -1 0 0 -1 6.000 0 0 7 0 0 5 - 20100 13500 20100 12600 17400 12600 17400 13500 20100 13500 -2 1 0 2 -1 -1 0 0 -1 0.000 0 0 -1 1 0 2 - 0 0 2.00 135.00 255.00 - 12900 13500 12900 14100 -2 1 1 2 -1 -1 0 0 -1 6.000 0 0 -1 1 0 2 - 0 0 2.00 135.00 255.00 - 18600 13500 18600 14100 -2 2 1 2 -1 -1 0 0 -1 6.000 0 0 7 0 0 5 - 9900 21000 9900 14100 4800 14100 4800 21000 9900 21000 -2 1 1 2 -1 -1 0 0 -1 6.000 0 0 7 0 0 2 - 4800 15000 9900 15000 -2 1 1 2 -1 -1 0 0 -1 6.000 0 0 -1 1 0 2 - 0 0 2.00 135.00 255.00 - 7200 13500 7200 14100 -2 1 1 2 -1 -1 0 0 -1 6.000 0 0 -1 1 0 3 - 0 0 2.00 135.00 255.00 - 12900 12300 7200 12300 7200 12600 -2 1 1 2 -1 -1 0 0 -1 6.000 0 0 -1 1 0 3 - 0 0 2.00 135.00 255.00 - 13800 12300 18600 12300 18600 12600 -2 1 1 2 -1 -1 0 0 -1 6.000 0 0 -1 0 0 1 - 5400 15000 -2 2 0 2 -1 -1 0 0 -1 0.000 0 0 0 0 0 5 - 14100 13500 14100 12600 11700 12600 11700 13500 14100 13500 -2 2 1 2 -1 -1 0 0 -1 6.000 0 0 7 0 0 5 - 8400 13500 8400 12600 6000 12600 6000 13500 8400 13500 -4 0 -1 0 0 2 20 0.0000000 0 195 2085 15300 7800 observation index\001 -4 0 -1 0 0 2 20 0.0000000 0 195 1260 18300 4200 file header\001 -4 0 -1 0 0 0 10 0.0000000 0 150 1365 6000 4200 scn_hierarchy.fig 40%\001 -4 0 -1 0 0 2 20 0.0000000 0 195 1245 14400 9600 field index\001 -4 0 -1 0 0 2 20 0.0000000 0 195 1680 12900 11400 channel index\001 -4 0 -1 0 0 1 20 0.0000000 0 255 1350 12000 18300 polarisation\001 -4 0 -1 0 0 1 20 1.5707999 0 195 1650 11700 20100 interferometer\001 -4 0 -1 0 0 2 20 0.0000000 0 195 1410 11700 17700 scan header\001 -4 0 -1 0 0 2 20 0.0000000 0 195 1590 12000 14700 sector header\001 -4 0 -1 0 0 2 20 0.0000000 0 195 1335 12300 20100 =visibilities\001 -4 0 -1 0 0 2 20 0.0000000 0 195 1125 12300 19500 scan data\001 -4 0 -1 0 0 2 20 0.0000000 0 195 1215 12300 12900 sequence-\001 -4 0 -1 0 0 2 20 0.0000000 0 195 1665 12000 13200 number index\001 -4 0 -1 0 0 2 20 0.0000000 0 255 1425 16800 6000 group index\001 diff --git a/src/doc/fig/scn_indices.cap b/src/doc/fig/scn_indices.cap deleted file mode 100644 index c375e4f58c2dcf980ce9610697d434bd882a0947..0000000000000000000000000000000000000000 --- a/src/doc/fig/scn_indices.cap +++ /dev/null @@ -1,18 +0,0 @@ -%scn_indices.cap -% -\begin{figure} - -\fig{scn_indices} - -\caption[]{\it -\label{.scn.indices} -The allocation of the sector indices for a .SCN file. -\\ - Every run of the NSCAN {\em LOAD} function creates a new {\em group}. -\\ - Every (tape of optical-disk) label specified as input for such a run is -stored in a new {\em observation}. -\\ - The {\em field} and {\em channel} numbers are copied from the input. -\\ - For a standard observation, the sequence number is 0. For a mosaic -observation, the successive cuts for the same field and channel are given -successive {\em sequence} numbers. -} -\end{figure} diff --git a/src/doc/fig/scn_indices.fig b/src/doc/fig/scn_indices.fig deleted file mode 100644 index 66e4b0a465d4582b42911ad4b36aa03c933242e1..0000000000000000000000000000000000000000 --- a/src/doc/fig/scn_indices.fig +++ /dev/null @@ -1,36 +0,0 @@ -#FIG 3.1 -Portrait -Center -Inches -1200 2 -2 1 0 2 -1 -1 0 0 -1 0.000 0 0 -1 1 0 2 - 0 0 2.00 135.00 255.00 - 9000 2400 9000 4800 -2 1 0 2 -1 -1 0 0 -1 0.000 0 0 -1 1 0 2 - 0 0 2.00 135.00 255.00 - 8100 1800 8100 4800 -2 1 0 2 -1 -1 0 0 -1 0.000 0 0 -1 1 0 3 - 0 0 2.00 135.00 255.00 - 12000 3900 6300 3900 6300 4800 -2 1 0 2 -1 -1 0 0 -1 0.000 0 0 -1 1 0 3 - 0 0 2.00 135.00 255.00 - 6300 3900 9900 3900 9900 4800 -2 1 0 2 -1 -1 0 0 -1 0.000 0 0 -1 1 0 2 - 0 0 2.00 135.00 255.00 - 7200 3900 7200 4800 -2 1 1 2 -1 -1 0 0 -1 6.000 0 0 -1 1 0 2 - 0 0 2.00 135.00 255.00 - 7200 1200 7200 3600 -2 2 0 2 -1 -1 0 0 -1 0.000 0 0 0 0 0 5 - 11700 2700 11700 600 5700 600 5700 2700 11700 2700 -2 2 0 2 -1 -1 0 0 -1 0.000 0 0 0 0 0 5 - 11700 5400 11700 4500 5700 4500 5700 5400 11700 5400 -4 0 -1 0 0 0 20 0.0000000 0 255 4320 6000 5100 <grp>. <obs>. <fld>. <chn>. <seq>\001 -4 0 -1 0 0 0 20 0.0000000 0 195 2325 7800 1800 mosaic field number\001 -4 0 -1 0 0 0 20 0.0000000 0 255 2490 8700 2400 channel/band number\001 -4 0 -1 0 0 0 20 0.0000000 0 195 1140 3600 4800 .SCN file:\001 -4 0 -1 0 0 0 20 0.0000000 0 195 2640 2700 1500 WSRT observation file\001 -4 0 -1 0 0 0 20 0.0000000 0 255 3585 12300 3900 automatic sequential allocation\001 -4 0 -1 0 0 0 20 0.0000000 0 255 1335 12900 4200 by NSCAN\001 -4 0 -1 0 0 0 10 0.0000000 0 150 1215 13500 900 scn_indices.fig 50%\001 -4 0 -1 0 0 0 20 0.0000000 0 255 1095 6900 1200 tape label\001 diff --git a/src/doc/fig/scn_sector.cap b/src/doc/fig/scn_sector.cap deleted file mode 100644 index d63dc2d101b211f719b4812c3e477255bd01b6f0..0000000000000000000000000000000000000000 --- a/src/doc/fig/scn_sector.cap +++ /dev/null @@ -1,22 +0,0 @@ -%scn_sector.tex -% -\begin{figure} -\fig{scn_sector} -\caption[]{\it -\label{.scn.sector} - Sectors in the {\rm uv} plane. - - A Sector is a {\bf time-contiguous} collection of HA-scans, for -one frequency channel and one pointing centre. Usually, the Sector -index will be 0, since there is only one Sector. The single Sector in -the left figure contains 10 contiguous HA-scans, for one pointing centre -and one frequency channel. - - The most common case of multiple Sectors is a mosaicking -observation (right), where each pointing centre is observed for a few -consecutive HA-intervals (scans) at a time, but revisited several times -in the course of 12 hours. The figure on the right shows 7 Sectors of 3 -contiguous HA-scans each, for one pointing centre and one frequency -channel. -} -\end{figure} diff --git a/src/doc/fig/scn_sector.fig b/src/doc/fig/scn_sector.fig deleted file mode 100644 index 343fa07c10772ee40914e7824f26bba5ec975082..0000000000000000000000000000000000000000 --- a/src/doc/fig/scn_sector.fig +++ /dev/null @@ -1,45 +0,0 @@ -#FIG 3.1 -Portrait -Center -Inches -1200 2 -6 5100 1800 16830 10215 -5 1 1 1 -1 -1 0 0 -1 4.000 0 0 0 0 12622.500 6007.500 12630 5400 13230 6015 12630 6615 -5 1 1 1 -1 -1 0 0 -1 4.000 0 0 0 0 12622.500 6022.500 12630 4815 13830 6015 12630 7230 -5 1 1 1 -1 -1 0 0 -1 4.000 0 0 0 0 12630.000 6015.000 12630 4215 14430 6015 12630 7815 -5 1 1 1 -1 -1 0 0 -1 4.000 0 0 0 0 12637.500 6022.500 12630 3630 15030 6015 12630 8415 -5 1 1 1 -1 -1 0 0 -1 4.000 0 0 0 0 12637.500 6007.500 12630 3015 15630 6015 12630 9000 -5 1 1 1 -1 -1 0 0 -1 4.000 0 0 0 0 12622.500 6022.500 12630 2415 16230 6015 12630 9630 -5 1 1 1 -1 -1 0 0 -1 4.000 0 0 0 0 5692.500 6007.500 5700 5400 6300 6015 5700 6615 -5 1 1 1 -1 -1 0 0 -1 4.000 0 0 0 0 5692.695 5992.500 5700 4785 6900 6015 5700 7200 -5 1 1 1 -1 -1 0 0 -1 4.000 0 0 0 0 5700.060 6000.000 5700 4200 7500 6015 5700 7800 -5 1 1 1 -1 -1 0 0 -1 4.000 0 0 0 0 5707.590 5992.500 5700 3600 8100 6015 5700 8385 -5 1 1 1 -1 -1 0 0 -1 4.000 0 0 0 0 5707.500 6007.500 5700 3015 8700 6015 5700 9000 -5 1 1 1 -1 -1 0 0 -1 4.000 0 0 0 0 5692.560 5992.500 5700 2385 9300 6015 5700 9600 -5 1 0 1 -1 -1 1 0 1 0.000 0 0 0 0 5716.245 5985.720 8025 3225 9315 6015 9135 7110 -2 1 0 1 -1 -1 0 0 -1 0.000 0 0 -1 0 0 2 - 12030 6015 16830 6015 -2 1 0 1 -1 -1 0 0 -1 0.000 0 0 -1 0 0 2 - 12630 1830 12630 10215 -2 1 0 1 -1 -1 0 0 -1 0.000 0 0 -1 0 0 2 - 5100 6015 9900 6015 -2 1 1 1 -1 -1 0 0 -1 4.000 0 0 -1 0 0 2 - 5700 6015 9300 6015 -2 1 0 1 -1 -1 0 0 -1 0.000 0 0 -1 0 0 2 - 5700 1800 5700 10185 -2 1 0 1 -1 -1 1 0 1 0.000 0 0 -1 0 0 3 - 8010 3225 5715 6015 9120 7110 -2 1 0 1 -1 -1 1 0 1 0.000 0 0 -1 0 0 4 - 14550 2955 12600 6015 14895 3210 14565 3015 -2 1 0 1 -1 -1 1 0 1 0.000 0 0 -1 0 0 4 - 15825 4335 12600 6015 15990 4755 15810 4365 -2 1 0 1 -1 -1 1 0 1 0.000 0 0 -1 0 0 4 - 15300 3630 12630 6015 15570 3975 15315 3630 -2 1 0 1 -1 -1 1 0 1 0.000 0 0 -1 0 0 4 - 16170 5235 12600 6015 16215 5670 16155 5250 -2 1 0 1 -1 -1 1 0 1 0.000 0 0 -1 0 0 4 - 16245 6165 12600 6015 16185 6630 16230 6165 -2 1 0 1 -1 -1 1 0 1 0.000 0 0 -1 0 0 4 - 16065 7125 12600 6015 15900 7530 16050 7125 --6 -4 0 -1 1 0 0 10 0.0000000 0 150 1170 13500 10500 scn_sector.fig 40%\001 diff --git a/src/doc/fig/scn_sets.cap b/src/doc/fig/scn_sets.cap deleted file mode 100644 index b10f85d73d1dc45f8acbb7f2095c0fc1f26a1f9f..0000000000000000000000000000000000000000 --- a/src/doc/fig/scn_sets.cap +++ /dev/null @@ -1,31 +0,0 @@ -% scn_sets.cap -% -% JPH 941123 \ps --> \fig - -\begin{figure}{hbtp} - -\fig{scn_sets} -% -\caption[]{\it -\label{.scn.sets} -Schematic overview of the organisation of the uv-data in the SCN-file. - - The basic unit is the Sector, which can be selected by means of -five integer parameters, divided by dots (g.o.f.c.s). Each starts at -zero (!), and can be a wildcard ($\ast$, meaning all) or a specific -range with an increment (e.g. 3-15:3, or 4-). The uv-data within a -Sector can be selected by HA range, polarisation (XX,XY,YX,YY) and -interferometers (9A, 8$\ast$, -FF etc). - - There are headers with information at three levels: -\\ - The {\bf file header} describes controls access to the various parts, -but contains no astronomical information. -\\ - Each {\bf sector header} contains information about the source, -and observational parameters like pointing centre, frequency etc. It -also contains polarisation corrections. -\\ - Each {\bf scan header} -contains information about HA etc. It also contains various phase and -gain corrections per telescope. -} - -\end{figure} diff --git a/src/doc/fig/scn_wmp_indices.fig b/src/doc/fig/scn_wmp_indices.fig deleted file mode 100644 index 389b470d4e16cd8c9f0f2b6c306e9faaa54f20b0..0000000000000000000000000000000000000000 --- a/src/doc/fig/scn_wmp_indices.fig +++ /dev/null @@ -1,65 +0,0 @@ -#FIG 3.1 -Portrait -Center -Inches -1200 2 -2 1 0 2 -1 -1 0 0 -1 0.000 0 0 -1 1 0 2 - 0 0 2.00 135.00 255.00 - 9000 2400 9000 4800 -2 1 0 2 -1 -1 0 0 -1 0.000 0 0 -1 1 0 2 - 0 0 2.00 135.00 255.00 - 8100 1800 8100 4800 -2 1 0 2 -1 -1 0 0 -1 0.000 0 0 -1 1 0 2 - 0 0 2.00 135.00 255.00 - 7200 1200 7200 4800 -2 1 0 2 -1 -1 0 0 -1 0.000 0 0 -1 1 0 2 - 0 0 2.00 135.00 255.00 - 8100 5100 8100 8700 -2 1 0 2 -1 -1 0 0 -1 0.000 0 0 -1 1 0 2 - 0 0 2.00 135.00 255.00 - 9000 5100 9000 8700 -2 1 0 2 -1 -1 0 0 -1 0.000 0 0 -1 1 0 3 - 0 0 2.00 135.00 255.00 - 12900 3900 6300 3900 6300 4800 -2 1 0 2 -1 -1 0 0 -1 0.000 0 0 -1 1 0 3 - 0 0 2.00 135.00 255.00 - 6300 3900 9900 3900 9900 4800 -2 2 0 2 -1 -1 0 0 -1 0.000 0 0 0 0 0 5 - 12300 5400 12300 4500 5700 4500 5700 5400 12300 5400 -2 2 0 2 -1 -1 0 0 -1 0.000 0 0 0 0 0 5 - 12300 2700 12300 600 5700 600 5700 2700 12300 2700 -2 2 0 2 -1 -1 0 0 -1 0.000 0 0 0 0 0 5 - 12300 9300 12300 8400 5700 8400 5700 9300 12300 9300 -2 1 0 2 -1 -1 0 0 -1 0.000 0 0 -1 1 0 3 - 0 0 2.00 135.00 255.00 - 12900 9900 11700 9900 11700 9000 -2 1 0 2 -1 -1 0 0 -1 0.000 0 0 -1 1 0 3 - 0 0 2.00 135.00 255.00 - 12900 7800 7200 7800 7200 8700 -2 1 0 2 -1 -1 0 0 -1 0.000 0 0 -1 1 0 2 - 0 0 2.00 135.00 255.00 - 11700 7800 11700 8700 -2 1 0 2 -1 -1 0 0 -1 0.000 0 0 -1 1 0 2 - 0 0 2.00 135.00 255.00 - 10800 6600 10800 8700 -2 1 0 2 -1 -1 0 0 -1 0.000 0 0 -1 1 0 3 - 0 0 2.00 135.00 255.00 - 12900 6600 9900 6600 9900 8700 -4 0 -1 0 0 0 20 0.0000000 0 255 4320 6000 5100 <grp>. <obs>. <fld>. <chn>. <seq>\001 -4 0 -1 0 0 0 20 0.0000000 0 195 2325 7800 1800 mosaic field number\001 -4 0 -1 0 0 0 20 0.0000000 0 255 2490 8700 2400 channel/band number\001 -4 0 -1 0 0 0 20 0.0000000 0 255 2985 6900 1200 observation (OH) number\001 -4 0 -1 0 0 0 20 0.0000000 0 255 3585 12900 3900 automatic sequential allocation\001 -4 0 -1 0 0 0 20 0.0000000 0 255 1335 13500 4200 by NSCAN\001 -4 0 -1 0 0 0 20 0.0000000 0 195 1140 3600 4800 .SCN file:\001 -4 0 -1 0 0 0 20 0.0000000 0 195 2640 2700 1500 WSRT observation file\001 -4 0 -1 0 0 0 20 0.0000000 0 195 1260 3600 8700 .WMP file:\001 -4 0 -1 0 0 0 20 0.0000000 0 255 5115 6900 9000 <grp>. <fld>. <chn>. <pol>. <typ>. <seq>\001 -4 0 -1 0 0 0 20 0.0000000 0 195 1260 12900 9600 NCLEAN:\001 -4 0 -1 0 0 0 20 0.0000000 0 195 2160 12900 10200 DATAclean: reuse\001 -4 0 -1 0 0 0 20 0.0000000 0 255 3615 12900 9900 BEAM/UVCLEAN: increment\001 -4 0 -1 0 0 0 20 0.0000000 0 255 1545 13500 8100 by NGCALC\001 -4 0 -1 0 0 0 20 0.0000000 0 255 3585 12900 7800 automatic sequential allocation\001 -4 0 -1 0 0 0 20 0.0000000 0 195 2640 12900 6900 from data "coodinates"\001 -4 0 -1 0 0 0 20 0.0000000 0 255 2445 12900 6600 derived by NGCALC\001 -4 0 -1 0 0 0 10 0.0000000 0 150 1605 3600 10800 scn_wmp_indices.fig 50%\001 diff --git a/src/doc/fig/wsrt_layout.cap b/src/doc/fig/wsrt_layout.cap deleted file mode 100644 index 823f308c9dc8ad3d0ea8cbeb9e7ee30a4d981ebf..0000000000000000000000000000000000000000 --- a/src/doc/fig/wsrt_layout.cap +++ /dev/null @@ -1,47 +0,0 @@ -%wsrt_layout.tex - -\begin{figure}[hbtp] -% -\fig{wsrt_layout} - -\caption[.]{\it -\label{.wsrt.layout} -The layout of the WSRT on its East-West baseline. -\\ - The WSRT array consists of 10 fixed and 2 pairs of movable -telescopes, placed on a straight East-West line of about 3km length. -Each telescope has a diameter of 25m, and a mesh-width of 8 mm. The -interval between the 10 fixed telescopes (labeled 0 through 9) is 144m. -The movable pair AB is placed on a 300m railtrack immediately to the -East of the fixed array; the second movable pair, CD sits on 150m of -rail track 1.2 km away. -\\ - The positions of the {\em fixed telescopes} (0-9) are defined -from West to East as 0(144)1296m. The 4 {\bf movable telescopes} (A,B -and C,D) can be moved to increase the uv-coverage. In the {\em standard -configurations}, all four are moved together, so that their relative -positions remains constant: AB=CD=72m, AC=BD=09=1296m, 0A=9C, 0B=9D. -Thus, in the Standard Configuration, the only parameter needed to -specify the array is the distance 9A: -\\ \\ -- 9A=36m: telescopes ABCD are placed at 1332, 1404, 2628, 2700 m \\ -- 9A=54m: telescopes ABCD are placed at 1350, 1422, 2646, 2718 m \\ -- 9A=72m: telescopes ABCD are placed at 1368, 1440, 2664, 2736 m \\ -- 9A=90m: telescopes ABCD are placed at 1386, 1458, 2682, 2754 m -\\ \\ - Regular covering of the uv-plane gives the lowest grating -sidelobes. This is achieved by placing the movable telescopes in such a -way that the 12-hour concentric elliptic uv-tracks are regularly spaced, -in the following way: -\\ \\ -- 1$\times$12 hrs: 9A=72m, giving 72m intervals between uv-tracks. \\ -- 2$\times$12 hrs: add 9A=36m, giving 36m intervals. \\ -- 4$\times$12 hrs: add 9A=54 and =90m, giving 18m intervals (with the -shortest 18m spacing missing). -\\ \\ - Smaller intervals between uv-tracks are better, since this causes the -first grating ring to have a larger radius. For intervals of 18m -(smaller than the telescope diameter), the grating rings will be -essentially outside the primary beam. -} -\end{figure} diff --git a/src/doc/fig/wsrt_layout.fig b/src/doc/fig/wsrt_layout.fig deleted file mode 100644 index e198c52208e47e49e3ab125d6fa406dda2817dac..0000000000000000000000000000000000000000 --- a/src/doc/fig/wsrt_layout.fig +++ /dev/null @@ -1,1896 +0,0 @@ -#FIG 3.1 -Portrait -Center -Inches -1200 2 -6 900 4200 1200 4500 -5 1 0 1 0 0 0 0 -1 0.000 0 1 0 0 1050.000 4138.125 915 4260 1050 4320 1185 4260 -5 1 0 1 0 0 0 0 -1 0.000 0 1 0 0 1057.500 4327.500 990 4320 1050 4395 1125 4320 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 3 - 990 4305 1050 4215 1125 4305 -2 2 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 5 - 1065 4230 1035 4230 1035 4200 1065 4200 1065 4230 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 1 - 1125 4350 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 2 - 990 4320 1050 4395 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 2 - 1050 4395 1125 4320 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 4 - 990 4305 990 4320 1125 4320 1125 4305 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 2 - 1050 4320 930 4485 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 2 - 1050 4320 1185 4485 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 2 - 1050 4320 1050 4485 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 2 - 1050 4395 930 4485 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 2 - 1050 4395 1185 4485 -2 2 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 5 - 945 4485 945 4485 915 4485 915 4485 945 4485 -2 2 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 5 - 1065 4485 1065 4485 1035 4485 1035 4485 1065 4485 -2 2 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 5 - 1185 4485 1185 4485 1170 4485 1170 4485 1185 4485 --6 -6 1800 4200 2100 4500 -5 1 0 1 0 0 0 0 -1 0.000 0 1 0 0 1950.000 4138.125 1815 4260 1950 4320 2085 4260 -5 1 0 1 0 0 0 0 -1 0.000 0 1 0 0 1957.500 4327.500 1890 4320 1950 4395 2025 4320 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 3 - 1890 4305 1950 4215 2025 4305 -2 2 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 5 - 1965 4230 1935 4230 1935 4200 1965 4200 1965 4230 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 1 - 2025 4350 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 2 - 1890 4320 1950 4395 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 2 - 1950 4395 2025 4320 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 4 - 1890 4305 1890 4320 2025 4320 2025 4305 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 2 - 1950 4320 1830 4485 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 2 - 1950 4320 2085 4485 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 2 - 1950 4320 1950 4485 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 2 - 1950 4395 1830 4485 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 2 - 1950 4395 2085 4485 -2 2 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 5 - 1845 4485 1845 4485 1815 4485 1815 4485 1845 4485 -2 2 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 5 - 1965 4485 1965 4485 1935 4485 1935 4485 1965 4485 -2 2 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 5 - 2085 4485 2085 4485 2070 4485 2070 4485 2085 4485 --6 -6 2700 4200 3000 4500 -5 1 0 1 0 0 0 0 -1 0.000 0 1 0 0 2850.000 4138.125 2715 4260 2850 4320 2985 4260 -5 1 0 1 0 0 0 0 -1 0.000 0 1 0 0 2857.500 4327.500 2790 4320 2850 4395 2925 4320 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 3 - 2790 4305 2850 4215 2925 4305 -2 2 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 5 - 2865 4230 2835 4230 2835 4200 2865 4200 2865 4230 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 1 - 2925 4350 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 2 - 2790 4320 2850 4395 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 2 - 2850 4395 2925 4320 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 4 - 2790 4305 2790 4320 2925 4320 2925 4305 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 2 - 2850 4320 2730 4485 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 2 - 2850 4320 2985 4485 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 2 - 2850 4320 2850 4485 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 2 - 2850 4395 2730 4485 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 2 - 2850 4395 2985 4485 -2 2 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 5 - 2745 4485 2745 4485 2715 4485 2715 4485 2745 4485 -2 2 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 5 - 2865 4485 2865 4485 2835 4485 2835 4485 2865 4485 -2 2 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 5 - 2985 4485 2985 4485 2970 4485 2970 4485 2985 4485 --6 -6 3600 4200 3900 4500 -5 1 0 1 0 0 0 0 -1 0.000 0 1 0 0 3750.000 4138.125 3615 4260 3750 4320 3885 4260 -5 1 0 1 0 0 0 0 -1 0.000 0 1 0 0 3757.500 4327.500 3690 4320 3750 4395 3825 4320 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 3 - 3690 4305 3750 4215 3825 4305 -2 2 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 5 - 3765 4230 3735 4230 3735 4200 3765 4200 3765 4230 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 1 - 3825 4350 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 2 - 3690 4320 3750 4395 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 2 - 3750 4395 3825 4320 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 4 - 3690 4305 3690 4320 3825 4320 3825 4305 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 2 - 3750 4320 3630 4485 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 2 - 3750 4320 3885 4485 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 2 - 3750 4320 3750 4485 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 2 - 3750 4395 3630 4485 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 2 - 3750 4395 3885 4485 -2 2 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 5 - 3645 4485 3645 4485 3615 4485 3615 4485 3645 4485 -2 2 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 5 - 3765 4485 3765 4485 3735 4485 3735 4485 3765 4485 -2 2 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 5 - 3885 4485 3885 4485 3870 4485 3870 4485 3885 4485 --6 -6 4500 4200 4800 4500 -5 1 0 1 0 0 0 0 -1 0.000 0 1 0 0 4650.000 4138.125 4515 4260 4650 4320 4785 4260 -5 1 0 1 0 0 0 0 -1 0.000 0 1 0 0 4657.500 4327.500 4590 4320 4650 4395 4725 4320 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 3 - 4590 4305 4650 4215 4725 4305 -2 2 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 5 - 4665 4230 4635 4230 4635 4200 4665 4200 4665 4230 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 1 - 4725 4350 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 2 - 4590 4320 4650 4395 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 2 - 4650 4395 4725 4320 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 4 - 4590 4305 4590 4320 4725 4320 4725 4305 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 2 - 4650 4320 4530 4485 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 2 - 4650 4320 4785 4485 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 2 - 4650 4320 4650 4485 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 2 - 4650 4395 4530 4485 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 2 - 4650 4395 4785 4485 -2 2 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 5 - 4545 4485 4545 4485 4515 4485 4515 4485 4545 4485 -2 2 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 5 - 4665 4485 4665 4485 4635 4485 4635 4485 4665 4485 -2 2 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 5 - 4785 4485 4785 4485 4770 4485 4770 4485 4785 4485 --6 -6 5400 4200 5700 4500 -5 1 0 1 0 0 0 0 -1 0.000 0 1 0 0 5550.000 4138.125 5415 4260 5550 4320 5685 4260 -5 1 0 1 0 0 0 0 -1 0.000 0 1 0 0 5557.500 4327.500 5490 4320 5550 4395 5625 4320 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 3 - 5490 4305 5550 4215 5625 4305 -2 2 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 5 - 5565 4230 5535 4230 5535 4200 5565 4200 5565 4230 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 1 - 5625 4350 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 2 - 5490 4320 5550 4395 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 2 - 5550 4395 5625 4320 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 4 - 5490 4305 5490 4320 5625 4320 5625 4305 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 2 - 5550 4320 5430 4485 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 2 - 5550 4320 5685 4485 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 2 - 5550 4320 5550 4485 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 2 - 5550 4395 5430 4485 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 2 - 5550 4395 5685 4485 -2 2 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 5 - 5445 4485 5445 4485 5415 4485 5415 4485 5445 4485 -2 2 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 5 - 5565 4485 5565 4485 5535 4485 5535 4485 5565 4485 -2 2 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 5 - 5685 4485 5685 4485 5670 4485 5670 4485 5685 4485 --6 -6 6300 4200 6600 4500 -5 1 0 1 0 0 0 0 -1 0.000 0 1 0 0 6450.000 4138.125 6315 4260 6450 4320 6585 4260 -5 1 0 1 0 0 0 0 -1 0.000 0 1 0 0 6457.500 4327.500 6390 4320 6450 4395 6525 4320 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 3 - 6390 4305 6450 4215 6525 4305 -2 2 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 5 - 6465 4230 6435 4230 6435 4200 6465 4200 6465 4230 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 1 - 6525 4350 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 2 - 6390 4320 6450 4395 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 2 - 6450 4395 6525 4320 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 4 - 6390 4305 6390 4320 6525 4320 6525 4305 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 2 - 6450 4320 6330 4485 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 2 - 6450 4320 6585 4485 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 2 - 6450 4320 6450 4485 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 2 - 6450 4395 6330 4485 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 2 - 6450 4395 6585 4485 -2 2 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 5 - 6345 4485 6345 4485 6315 4485 6315 4485 6345 4485 -2 2 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 5 - 6465 4485 6465 4485 6435 4485 6435 4485 6465 4485 -2 2 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 5 - 6585 4485 6585 4485 6570 4485 6570 4485 6585 4485 --6 -6 7200 4200 7500 4500 -5 1 0 1 0 0 0 0 -1 0.000 0 1 0 0 7350.000 4138.125 7215 4260 7350 4320 7485 4260 -5 1 0 1 0 0 0 0 -1 0.000 0 1 0 0 7357.500 4327.500 7290 4320 7350 4395 7425 4320 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 3 - 7290 4305 7350 4215 7425 4305 -2 2 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 5 - 7365 4230 7335 4230 7335 4200 7365 4200 7365 4230 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 1 - 7425 4350 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 2 - 7290 4320 7350 4395 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 2 - 7350 4395 7425 4320 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 4 - 7290 4305 7290 4320 7425 4320 7425 4305 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 2 - 7350 4320 7230 4485 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 2 - 7350 4320 7485 4485 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 2 - 7350 4320 7350 4485 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 2 - 7350 4395 7230 4485 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 2 - 7350 4395 7485 4485 -2 2 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 5 - 7245 4485 7245 4485 7215 4485 7215 4485 7245 4485 -2 2 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 5 - 7365 4485 7365 4485 7335 4485 7335 4485 7365 4485 -2 2 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 5 - 7485 4485 7485 4485 7470 4485 7470 4485 7485 4485 --6 -6 8100 4200 8400 4500 -5 1 0 1 0 0 0 0 -1 0.000 0 1 0 0 8250.000 4138.125 8115 4260 8250 4320 8385 4260 -5 1 0 1 0 0 0 0 -1 0.000 0 1 0 0 8257.500 4327.500 8190 4320 8250 4395 8325 4320 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 3 - 8190 4305 8250 4215 8325 4305 -2 2 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 5 - 8265 4230 8235 4230 8235 4200 8265 4200 8265 4230 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 1 - 8325 4350 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 2 - 8190 4320 8250 4395 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 2 - 8250 4395 8325 4320 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 4 - 8190 4305 8190 4320 8325 4320 8325 4305 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 2 - 8250 4320 8130 4485 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 2 - 8250 4320 8385 4485 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 2 - 8250 4320 8250 4485 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 2 - 8250 4395 8130 4485 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 2 - 8250 4395 8385 4485 -2 2 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 5 - 8145 4485 8145 4485 8115 4485 8115 4485 8145 4485 -2 2 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 5 - 8265 4485 8265 4485 8235 4485 8235 4485 8265 4485 -2 2 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 5 - 8385 4485 8385 4485 8370 4485 8370 4485 8385 4485 --6 -6 9000 4200 9300 4500 -5 1 0 1 0 0 0 0 -1 0.000 0 1 0 0 9150.000 4138.125 9015 4260 9150 4320 9285 4260 -5 1 0 1 0 0 0 0 -1 0.000 0 1 0 0 9157.500 4327.500 9090 4320 9150 4395 9225 4320 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 3 - 9090 4305 9150 4215 9225 4305 -2 2 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 5 - 9165 4230 9135 4230 9135 4200 9165 4200 9165 4230 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 1 - 9225 4350 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 2 - 9090 4320 9150 4395 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 2 - 9150 4395 9225 4320 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 4 - 9090 4305 9090 4320 9225 4320 9225 4305 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 2 - 9150 4320 9030 4485 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 2 - 9150 4320 9285 4485 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 2 - 9150 4320 9150 4485 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 2 - 9150 4395 9030 4485 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 2 - 9150 4395 9285 4485 -2 2 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 5 - 9045 4485 9045 4485 9015 4485 9015 4485 9045 4485 -2 2 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 5 - 9165 4485 9165 4485 9135 4485 9135 4485 9165 4485 -2 2 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 5 - 9285 4485 9285 4485 9270 4485 9270 4485 9285 4485 --6 -6 900 5100 1200 5400 -5 1 0 1 0 0 0 0 -1 0.000 0 1 0 0 1050.000 5038.125 915 5160 1050 5220 1185 5160 -5 1 0 1 0 0 0 0 -1 0.000 0 1 0 0 1057.500 5227.500 990 5220 1050 5295 1125 5220 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 3 - 990 5205 1050 5115 1125 5205 -2 2 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 5 - 1065 5130 1035 5130 1035 5100 1065 5100 1065 5130 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 1 - 1125 5250 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 2 - 990 5220 1050 5295 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 2 - 1050 5295 1125 5220 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 4 - 990 5205 990 5220 1125 5220 1125 5205 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 2 - 1050 5220 930 5385 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 2 - 1050 5220 1185 5385 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 2 - 1050 5220 1050 5385 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 2 - 1050 5295 930 5385 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 2 - 1050 5295 1185 5385 -2 2 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 5 - 945 5385 945 5385 915 5385 915 5385 945 5385 -2 2 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 5 - 1065 5385 1065 5385 1035 5385 1035 5385 1065 5385 -2 2 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 5 - 1185 5385 1185 5385 1170 5385 1170 5385 1185 5385 --6 -6 1800 5100 2100 5400 -5 1 0 1 0 0 0 0 -1 0.000 0 1 0 0 1950.000 5038.125 1815 5160 1950 5220 2085 5160 -5 1 0 1 0 0 0 0 -1 0.000 0 1 0 0 1957.500 5227.500 1890 5220 1950 5295 2025 5220 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 3 - 1890 5205 1950 5115 2025 5205 -2 2 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 5 - 1965 5130 1935 5130 1935 5100 1965 5100 1965 5130 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 1 - 2025 5250 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 2 - 1890 5220 1950 5295 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 2 - 1950 5295 2025 5220 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 4 - 1890 5205 1890 5220 2025 5220 2025 5205 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 2 - 1950 5220 1830 5385 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 2 - 1950 5220 2085 5385 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 2 - 1950 5220 1950 5385 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 2 - 1950 5295 1830 5385 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 2 - 1950 5295 2085 5385 -2 2 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 5 - 1845 5385 1845 5385 1815 5385 1815 5385 1845 5385 -2 2 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 5 - 1965 5385 1965 5385 1935 5385 1935 5385 1965 5385 -2 2 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 5 - 2085 5385 2085 5385 2070 5385 2070 5385 2085 5385 --6 -6 2700 5100 3000 5400 -5 1 0 1 0 0 0 0 -1 0.000 0 1 0 0 2850.000 5038.125 2715 5160 2850 5220 2985 5160 -5 1 0 1 0 0 0 0 -1 0.000 0 1 0 0 2857.500 5227.500 2790 5220 2850 5295 2925 5220 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 3 - 2790 5205 2850 5115 2925 5205 -2 2 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 5 - 2865 5130 2835 5130 2835 5100 2865 5100 2865 5130 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 1 - 2925 5250 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 2 - 2790 5220 2850 5295 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 2 - 2850 5295 2925 5220 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 4 - 2790 5205 2790 5220 2925 5220 2925 5205 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 2 - 2850 5220 2730 5385 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 2 - 2850 5220 2985 5385 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 2 - 2850 5220 2850 5385 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 2 - 2850 5295 2730 5385 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 2 - 2850 5295 2985 5385 -2 2 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 5 - 2745 5385 2745 5385 2715 5385 2715 5385 2745 5385 -2 2 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 5 - 2865 5385 2865 5385 2835 5385 2835 5385 2865 5385 -2 2 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 5 - 2985 5385 2985 5385 2970 5385 2970 5385 2985 5385 --6 -6 3600 5100 3900 5400 -5 1 0 1 0 0 0 0 -1 0.000 0 1 0 0 3750.000 5038.125 3615 5160 3750 5220 3885 5160 -5 1 0 1 0 0 0 0 -1 0.000 0 1 0 0 3757.500 5227.500 3690 5220 3750 5295 3825 5220 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 3 - 3690 5205 3750 5115 3825 5205 -2 2 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 5 - 3765 5130 3735 5130 3735 5100 3765 5100 3765 5130 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 1 - 3825 5250 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 2 - 3690 5220 3750 5295 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 2 - 3750 5295 3825 5220 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 4 - 3690 5205 3690 5220 3825 5220 3825 5205 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 2 - 3750 5220 3630 5385 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 2 - 3750 5220 3885 5385 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 2 - 3750 5220 3750 5385 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 2 - 3750 5295 3630 5385 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 2 - 3750 5295 3885 5385 -2 2 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 5 - 3645 5385 3645 5385 3615 5385 3615 5385 3645 5385 -2 2 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 5 - 3765 5385 3765 5385 3735 5385 3735 5385 3765 5385 -2 2 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 5 - 3885 5385 3885 5385 3870 5385 3870 5385 3885 5385 --6 -6 4500 5100 4800 5400 -5 1 0 1 0 0 0 0 -1 0.000 0 1 0 0 4650.000 5038.125 4515 5160 4650 5220 4785 5160 -5 1 0 1 0 0 0 0 -1 0.000 0 1 0 0 4657.500 5227.500 4590 5220 4650 5295 4725 5220 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 3 - 4590 5205 4650 5115 4725 5205 -2 2 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 5 - 4665 5130 4635 5130 4635 5100 4665 5100 4665 5130 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 1 - 4725 5250 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 2 - 4590 5220 4650 5295 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 2 - 4650 5295 4725 5220 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 4 - 4590 5205 4590 5220 4725 5220 4725 5205 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 2 - 4650 5220 4530 5385 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 2 - 4650 5220 4785 5385 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 2 - 4650 5220 4650 5385 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 2 - 4650 5295 4530 5385 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 2 - 4650 5295 4785 5385 -2 2 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 5 - 4545 5385 4545 5385 4515 5385 4515 5385 4545 5385 -2 2 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 5 - 4665 5385 4665 5385 4635 5385 4635 5385 4665 5385 -2 2 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 5 - 4785 5385 4785 5385 4770 5385 4770 5385 4785 5385 --6 -6 5400 5100 5700 5400 -5 1 0 1 0 0 0 0 -1 0.000 0 1 0 0 5550.000 5038.125 5415 5160 5550 5220 5685 5160 -5 1 0 1 0 0 0 0 -1 0.000 0 1 0 0 5557.500 5227.500 5490 5220 5550 5295 5625 5220 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 3 - 5490 5205 5550 5115 5625 5205 -2 2 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 5 - 5565 5130 5535 5130 5535 5100 5565 5100 5565 5130 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 1 - 5625 5250 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 2 - 5490 5220 5550 5295 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 2 - 5550 5295 5625 5220 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 4 - 5490 5205 5490 5220 5625 5220 5625 5205 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 2 - 5550 5220 5430 5385 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 2 - 5550 5220 5685 5385 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 2 - 5550 5220 5550 5385 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 2 - 5550 5295 5430 5385 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 2 - 5550 5295 5685 5385 -2 2 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 5 - 5445 5385 5445 5385 5415 5385 5415 5385 5445 5385 -2 2 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 5 - 5565 5385 5565 5385 5535 5385 5535 5385 5565 5385 -2 2 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 5 - 5685 5385 5685 5385 5670 5385 5670 5385 5685 5385 --6 -6 6300 5100 6600 5400 -5 1 0 1 0 0 0 0 -1 0.000 0 1 0 0 6450.000 5038.125 6315 5160 6450 5220 6585 5160 -5 1 0 1 0 0 0 0 -1 0.000 0 1 0 0 6457.500 5227.500 6390 5220 6450 5295 6525 5220 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 3 - 6390 5205 6450 5115 6525 5205 -2 2 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 5 - 6465 5130 6435 5130 6435 5100 6465 5100 6465 5130 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 1 - 6525 5250 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 2 - 6390 5220 6450 5295 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 2 - 6450 5295 6525 5220 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 4 - 6390 5205 6390 5220 6525 5220 6525 5205 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 2 - 6450 5220 6330 5385 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 2 - 6450 5220 6585 5385 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 2 - 6450 5220 6450 5385 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 2 - 6450 5295 6330 5385 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 2 - 6450 5295 6585 5385 -2 2 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 5 - 6345 5385 6345 5385 6315 5385 6315 5385 6345 5385 -2 2 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 5 - 6465 5385 6465 5385 6435 5385 6435 5385 6465 5385 -2 2 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 5 - 6585 5385 6585 5385 6570 5385 6570 5385 6585 5385 --6 -6 7200 5100 7500 5400 -5 1 0 1 0 0 0 0 -1 0.000 0 1 0 0 7350.000 5038.125 7215 5160 7350 5220 7485 5160 -5 1 0 1 0 0 0 0 -1 0.000 0 1 0 0 7357.500 5227.500 7290 5220 7350 5295 7425 5220 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 3 - 7290 5205 7350 5115 7425 5205 -2 2 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 5 - 7365 5130 7335 5130 7335 5100 7365 5100 7365 5130 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 1 - 7425 5250 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 2 - 7290 5220 7350 5295 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 2 - 7350 5295 7425 5220 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 4 - 7290 5205 7290 5220 7425 5220 7425 5205 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 2 - 7350 5220 7230 5385 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 2 - 7350 5220 7485 5385 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 2 - 7350 5220 7350 5385 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 2 - 7350 5295 7230 5385 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 2 - 7350 5295 7485 5385 -2 2 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 5 - 7245 5385 7245 5385 7215 5385 7215 5385 7245 5385 -2 2 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 5 - 7365 5385 7365 5385 7335 5385 7335 5385 7365 5385 -2 2 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 5 - 7485 5385 7485 5385 7470 5385 7470 5385 7485 5385 --6 -6 8100 5100 8400 5400 -5 1 0 1 0 0 0 0 -1 0.000 0 1 0 0 8250.000 5038.125 8115 5160 8250 5220 8385 5160 -5 1 0 1 0 0 0 0 -1 0.000 0 1 0 0 8257.500 5227.500 8190 5220 8250 5295 8325 5220 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 3 - 8190 5205 8250 5115 8325 5205 -2 2 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 5 - 8265 5130 8235 5130 8235 5100 8265 5100 8265 5130 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 1 - 8325 5250 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 2 - 8190 5220 8250 5295 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 2 - 8250 5295 8325 5220 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 4 - 8190 5205 8190 5220 8325 5220 8325 5205 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 2 - 8250 5220 8130 5385 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 2 - 8250 5220 8385 5385 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 2 - 8250 5220 8250 5385 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 2 - 8250 5295 8130 5385 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 2 - 8250 5295 8385 5385 -2 2 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 5 - 8145 5385 8145 5385 8115 5385 8115 5385 8145 5385 -2 2 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 5 - 8265 5385 8265 5385 8235 5385 8235 5385 8265 5385 -2 2 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 5 - 8385 5385 8385 5385 8370 5385 8370 5385 8385 5385 --6 -6 9000 5100 9300 5400 -5 1 0 1 0 0 0 0 -1 0.000 0 1 0 0 9150.000 5038.125 9015 5160 9150 5220 9285 5160 -5 1 0 1 0 0 0 0 -1 0.000 0 1 0 0 9157.500 5227.500 9090 5220 9150 5295 9225 5220 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 3 - 9090 5205 9150 5115 9225 5205 -2 2 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 5 - 9165 5130 9135 5130 9135 5100 9165 5100 9165 5130 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 1 - 9225 5250 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 2 - 9090 5220 9150 5295 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 2 - 9150 5295 9225 5220 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 4 - 9090 5205 9090 5220 9225 5220 9225 5205 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 2 - 9150 5220 9030 5385 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 2 - 9150 5220 9285 5385 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 2 - 9150 5220 9150 5385 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 2 - 9150 5295 9030 5385 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 2 - 9150 5295 9285 5385 -2 2 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 5 - 9045 5385 9045 5385 9015 5385 9015 5385 9045 5385 -2 2 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 5 - 9165 5385 9165 5385 9135 5385 9135 5385 9165 5385 -2 2 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 5 - 9285 5385 9285 5385 9270 5385 9270 5385 9285 5385 --6 -6 900 6000 1200 6300 -5 1 0 1 0 0 0 0 -1 0.000 0 1 0 0 1050.000 5938.125 915 6060 1050 6120 1185 6060 -5 1 0 1 0 0 0 0 -1 0.000 0 1 0 0 1057.500 6127.500 990 6120 1050 6195 1125 6120 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 3 - 990 6105 1050 6015 1125 6105 -2 2 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 5 - 1065 6030 1035 6030 1035 6000 1065 6000 1065 6030 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 1 - 1125 6150 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 2 - 990 6120 1050 6195 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 2 - 1050 6195 1125 6120 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 4 - 990 6105 990 6120 1125 6120 1125 6105 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 2 - 1050 6120 930 6285 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 2 - 1050 6120 1185 6285 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 2 - 1050 6120 1050 6285 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 2 - 1050 6195 930 6285 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 2 - 1050 6195 1185 6285 -2 2 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 5 - 945 6285 945 6285 915 6285 915 6285 945 6285 -2 2 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 5 - 1065 6285 1065 6285 1035 6285 1035 6285 1065 6285 -2 2 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 5 - 1185 6285 1185 6285 1170 6285 1170 6285 1185 6285 --6 -6 1800 6000 2100 6300 -5 1 0 1 0 0 0 0 -1 0.000 0 1 0 0 1950.000 5938.125 1815 6060 1950 6120 2085 6060 -5 1 0 1 0 0 0 0 -1 0.000 0 1 0 0 1957.500 6127.500 1890 6120 1950 6195 2025 6120 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 3 - 1890 6105 1950 6015 2025 6105 -2 2 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 5 - 1965 6030 1935 6030 1935 6000 1965 6000 1965 6030 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 1 - 2025 6150 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 2 - 1890 6120 1950 6195 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 2 - 1950 6195 2025 6120 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 4 - 1890 6105 1890 6120 2025 6120 2025 6105 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 2 - 1950 6120 1830 6285 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 2 - 1950 6120 2085 6285 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 2 - 1950 6120 1950 6285 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 2 - 1950 6195 1830 6285 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 2 - 1950 6195 2085 6285 -2 2 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 5 - 1845 6285 1845 6285 1815 6285 1815 6285 1845 6285 -2 2 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 5 - 1965 6285 1965 6285 1935 6285 1935 6285 1965 6285 -2 2 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 5 - 2085 6285 2085 6285 2070 6285 2070 6285 2085 6285 --6 -6 2700 6000 3000 6300 -5 1 0 1 0 0 0 0 -1 0.000 0 1 0 0 2850.000 5938.125 2715 6060 2850 6120 2985 6060 -5 1 0 1 0 0 0 0 -1 0.000 0 1 0 0 2857.500 6127.500 2790 6120 2850 6195 2925 6120 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 3 - 2790 6105 2850 6015 2925 6105 -2 2 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 5 - 2865 6030 2835 6030 2835 6000 2865 6000 2865 6030 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 1 - 2925 6150 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 2 - 2790 6120 2850 6195 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 2 - 2850 6195 2925 6120 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 4 - 2790 6105 2790 6120 2925 6120 2925 6105 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 2 - 2850 6120 2730 6285 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 2 - 2850 6120 2985 6285 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 2 - 2850 6120 2850 6285 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 2 - 2850 6195 2730 6285 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 2 - 2850 6195 2985 6285 -2 2 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 5 - 2745 6285 2745 6285 2715 6285 2715 6285 2745 6285 -2 2 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 5 - 2865 6285 2865 6285 2835 6285 2835 6285 2865 6285 -2 2 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 5 - 2985 6285 2985 6285 2970 6285 2970 6285 2985 6285 --6 -6 3600 6000 3900 6300 -5 1 0 1 0 0 0 0 -1 0.000 0 1 0 0 3750.000 5938.125 3615 6060 3750 6120 3885 6060 -5 1 0 1 0 0 0 0 -1 0.000 0 1 0 0 3757.500 6127.500 3690 6120 3750 6195 3825 6120 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 3 - 3690 6105 3750 6015 3825 6105 -2 2 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 5 - 3765 6030 3735 6030 3735 6000 3765 6000 3765 6030 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 1 - 3825 6150 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 2 - 3690 6120 3750 6195 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 2 - 3750 6195 3825 6120 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 4 - 3690 6105 3690 6120 3825 6120 3825 6105 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 2 - 3750 6120 3630 6285 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 2 - 3750 6120 3885 6285 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 2 - 3750 6120 3750 6285 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 2 - 3750 6195 3630 6285 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 2 - 3750 6195 3885 6285 -2 2 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 5 - 3645 6285 3645 6285 3615 6285 3615 6285 3645 6285 -2 2 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 5 - 3765 6285 3765 6285 3735 6285 3735 6285 3765 6285 -2 2 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 5 - 3885 6285 3885 6285 3870 6285 3870 6285 3885 6285 --6 -6 4500 6000 4800 6300 -5 1 0 1 0 0 0 0 -1 0.000 0 1 0 0 4650.000 5938.125 4515 6060 4650 6120 4785 6060 -5 1 0 1 0 0 0 0 -1 0.000 0 1 0 0 4657.500 6127.500 4590 6120 4650 6195 4725 6120 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 3 - 4590 6105 4650 6015 4725 6105 -2 2 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 5 - 4665 6030 4635 6030 4635 6000 4665 6000 4665 6030 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 1 - 4725 6150 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 2 - 4590 6120 4650 6195 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 2 - 4650 6195 4725 6120 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 4 - 4590 6105 4590 6120 4725 6120 4725 6105 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 2 - 4650 6120 4530 6285 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 2 - 4650 6120 4785 6285 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 2 - 4650 6120 4650 6285 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 2 - 4650 6195 4530 6285 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 2 - 4650 6195 4785 6285 -2 2 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 5 - 4545 6285 4545 6285 4515 6285 4515 6285 4545 6285 -2 2 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 5 - 4665 6285 4665 6285 4635 6285 4635 6285 4665 6285 -2 2 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 5 - 4785 6285 4785 6285 4770 6285 4770 6285 4785 6285 --6 -6 5400 6000 5700 6300 -5 1 0 1 0 0 0 0 -1 0.000 0 1 0 0 5550.000 5938.125 5415 6060 5550 6120 5685 6060 -5 1 0 1 0 0 0 0 -1 0.000 0 1 0 0 5557.500 6127.500 5490 6120 5550 6195 5625 6120 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 3 - 5490 6105 5550 6015 5625 6105 -2 2 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 5 - 5565 6030 5535 6030 5535 6000 5565 6000 5565 6030 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 1 - 5625 6150 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 2 - 5490 6120 5550 6195 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 2 - 5550 6195 5625 6120 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 4 - 5490 6105 5490 6120 5625 6120 5625 6105 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 2 - 5550 6120 5430 6285 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 2 - 5550 6120 5685 6285 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 2 - 5550 6120 5550 6285 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 2 - 5550 6195 5430 6285 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 2 - 5550 6195 5685 6285 -2 2 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 5 - 5445 6285 5445 6285 5415 6285 5415 6285 5445 6285 -2 2 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 5 - 5565 6285 5565 6285 5535 6285 5535 6285 5565 6285 -2 2 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 5 - 5685 6285 5685 6285 5670 6285 5670 6285 5685 6285 --6 -6 6300 6000 6600 6300 -5 1 0 1 0 0 0 0 -1 0.000 0 1 0 0 6450.000 5938.125 6315 6060 6450 6120 6585 6060 -5 1 0 1 0 0 0 0 -1 0.000 0 1 0 0 6457.500 6127.500 6390 6120 6450 6195 6525 6120 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 3 - 6390 6105 6450 6015 6525 6105 -2 2 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 5 - 6465 6030 6435 6030 6435 6000 6465 6000 6465 6030 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 1 - 6525 6150 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 2 - 6390 6120 6450 6195 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 2 - 6450 6195 6525 6120 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 4 - 6390 6105 6390 6120 6525 6120 6525 6105 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 2 - 6450 6120 6330 6285 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 2 - 6450 6120 6585 6285 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 2 - 6450 6120 6450 6285 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 2 - 6450 6195 6330 6285 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 2 - 6450 6195 6585 6285 -2 2 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 5 - 6345 6285 6345 6285 6315 6285 6315 6285 6345 6285 -2 2 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 5 - 6465 6285 6465 6285 6435 6285 6435 6285 6465 6285 -2 2 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 5 - 6585 6285 6585 6285 6570 6285 6570 6285 6585 6285 --6 -6 7200 6000 7500 6300 -5 1 0 1 0 0 0 0 -1 0.000 0 1 0 0 7350.000 5938.125 7215 6060 7350 6120 7485 6060 -5 1 0 1 0 0 0 0 -1 0.000 0 1 0 0 7357.500 6127.500 7290 6120 7350 6195 7425 6120 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 3 - 7290 6105 7350 6015 7425 6105 -2 2 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 5 - 7365 6030 7335 6030 7335 6000 7365 6000 7365 6030 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 1 - 7425 6150 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 2 - 7290 6120 7350 6195 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 2 - 7350 6195 7425 6120 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 4 - 7290 6105 7290 6120 7425 6120 7425 6105 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 2 - 7350 6120 7230 6285 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 2 - 7350 6120 7485 6285 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 2 - 7350 6120 7350 6285 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 2 - 7350 6195 7230 6285 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 2 - 7350 6195 7485 6285 -2 2 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 5 - 7245 6285 7245 6285 7215 6285 7215 6285 7245 6285 -2 2 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 5 - 7365 6285 7365 6285 7335 6285 7335 6285 7365 6285 -2 2 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 5 - 7485 6285 7485 6285 7470 6285 7470 6285 7485 6285 --6 -6 8100 6000 8400 6300 -5 1 0 1 0 0 0 0 -1 0.000 0 1 0 0 8250.000 5938.125 8115 6060 8250 6120 8385 6060 -5 1 0 1 0 0 0 0 -1 0.000 0 1 0 0 8257.500 6127.500 8190 6120 8250 6195 8325 6120 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 3 - 8190 6105 8250 6015 8325 6105 -2 2 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 5 - 8265 6030 8235 6030 8235 6000 8265 6000 8265 6030 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 1 - 8325 6150 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 2 - 8190 6120 8250 6195 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 2 - 8250 6195 8325 6120 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 4 - 8190 6105 8190 6120 8325 6120 8325 6105 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 2 - 8250 6120 8130 6285 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 2 - 8250 6120 8385 6285 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 2 - 8250 6120 8250 6285 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 2 - 8250 6195 8130 6285 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 2 - 8250 6195 8385 6285 -2 2 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 5 - 8145 6285 8145 6285 8115 6285 8115 6285 8145 6285 -2 2 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 5 - 8265 6285 8265 6285 8235 6285 8235 6285 8265 6285 -2 2 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 5 - 8385 6285 8385 6285 8370 6285 8370 6285 8385 6285 --6 -6 9000 6000 9300 6300 -5 1 0 1 0 0 0 0 -1 0.000 0 1 0 0 9150.000 5938.125 9015 6060 9150 6120 9285 6060 -5 1 0 1 0 0 0 0 -1 0.000 0 1 0 0 9157.500 6127.500 9090 6120 9150 6195 9225 6120 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 3 - 9090 6105 9150 6015 9225 6105 -2 2 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 5 - 9165 6030 9135 6030 9135 6000 9165 6000 9165 6030 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 1 - 9225 6150 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 2 - 9090 6120 9150 6195 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 2 - 9150 6195 9225 6120 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 4 - 9090 6105 9090 6120 9225 6120 9225 6105 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 2 - 9150 6120 9030 6285 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 2 - 9150 6120 9285 6285 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 2 - 9150 6120 9150 6285 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 2 - 9150 6195 9030 6285 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 2 - 9150 6195 9285 6285 -2 2 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 5 - 9045 6285 9045 6285 9015 6285 9015 6285 9045 6285 -2 2 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 5 - 9165 6285 9165 6285 9135 6285 9135 6285 9165 6285 -2 2 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 5 - 9285 6285 9285 6285 9270 6285 9270 6285 9285 6285 --6 -6 900 6900 1200 7200 -5 1 0 1 0 0 0 0 -1 0.000 0 1 0 0 1050.000 6838.125 915 6960 1050 7020 1185 6960 -5 1 0 1 0 0 0 0 -1 0.000 0 1 0 0 1057.500 7027.500 990 7020 1050 7095 1125 7020 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 3 - 990 7005 1050 6915 1125 7005 -2 2 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 5 - 1065 6930 1035 6930 1035 6900 1065 6900 1065 6930 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 1 - 1125 7050 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 2 - 990 7020 1050 7095 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 2 - 1050 7095 1125 7020 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 4 - 990 7005 990 7020 1125 7020 1125 7005 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 2 - 1050 7020 930 7185 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 2 - 1050 7020 1185 7185 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 2 - 1050 7020 1050 7185 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 2 - 1050 7095 930 7185 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 2 - 1050 7095 1185 7185 -2 2 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 5 - 945 7185 945 7185 915 7185 915 7185 945 7185 -2 2 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 5 - 1065 7185 1065 7185 1035 7185 1035 7185 1065 7185 -2 2 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 5 - 1185 7185 1185 7185 1170 7185 1170 7185 1185 7185 --6 -6 1800 6900 2100 7200 -5 1 0 1 0 0 0 0 -1 0.000 0 1 0 0 1950.000 6838.125 1815 6960 1950 7020 2085 6960 -5 1 0 1 0 0 0 0 -1 0.000 0 1 0 0 1957.500 7027.500 1890 7020 1950 7095 2025 7020 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 3 - 1890 7005 1950 6915 2025 7005 -2 2 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 5 - 1965 6930 1935 6930 1935 6900 1965 6900 1965 6930 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 1 - 2025 7050 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 2 - 1890 7020 1950 7095 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 2 - 1950 7095 2025 7020 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 4 - 1890 7005 1890 7020 2025 7020 2025 7005 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 2 - 1950 7020 1830 7185 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 2 - 1950 7020 2085 7185 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 2 - 1950 7020 1950 7185 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 2 - 1950 7095 1830 7185 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 2 - 1950 7095 2085 7185 -2 2 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 5 - 1845 7185 1845 7185 1815 7185 1815 7185 1845 7185 -2 2 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 5 - 1965 7185 1965 7185 1935 7185 1935 7185 1965 7185 -2 2 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 5 - 2085 7185 2085 7185 2070 7185 2070 7185 2085 7185 --6 -6 2700 6900 3000 7200 -5 1 0 1 0 0 0 0 -1 0.000 0 1 0 0 2850.000 6838.125 2715 6960 2850 7020 2985 6960 -5 1 0 1 0 0 0 0 -1 0.000 0 1 0 0 2857.500 7027.500 2790 7020 2850 7095 2925 7020 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 3 - 2790 7005 2850 6915 2925 7005 -2 2 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 5 - 2865 6930 2835 6930 2835 6900 2865 6900 2865 6930 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 1 - 2925 7050 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 2 - 2790 7020 2850 7095 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 2 - 2850 7095 2925 7020 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 4 - 2790 7005 2790 7020 2925 7020 2925 7005 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 2 - 2850 7020 2730 7185 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 2 - 2850 7020 2985 7185 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 2 - 2850 7020 2850 7185 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 2 - 2850 7095 2730 7185 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 2 - 2850 7095 2985 7185 -2 2 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 5 - 2745 7185 2745 7185 2715 7185 2715 7185 2745 7185 -2 2 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 5 - 2865 7185 2865 7185 2835 7185 2835 7185 2865 7185 -2 2 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 5 - 2985 7185 2985 7185 2970 7185 2970 7185 2985 7185 --6 -6 3600 6900 3900 7200 -5 1 0 1 0 0 0 0 -1 0.000 0 1 0 0 3750.000 6838.125 3615 6960 3750 7020 3885 6960 -5 1 0 1 0 0 0 0 -1 0.000 0 1 0 0 3757.500 7027.500 3690 7020 3750 7095 3825 7020 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 3 - 3690 7005 3750 6915 3825 7005 -2 2 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 5 - 3765 6930 3735 6930 3735 6900 3765 6900 3765 6930 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 1 - 3825 7050 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 2 - 3690 7020 3750 7095 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 2 - 3750 7095 3825 7020 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 4 - 3690 7005 3690 7020 3825 7020 3825 7005 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 2 - 3750 7020 3630 7185 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 2 - 3750 7020 3885 7185 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 2 - 3750 7020 3750 7185 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 2 - 3750 7095 3630 7185 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 2 - 3750 7095 3885 7185 -2 2 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 5 - 3645 7185 3645 7185 3615 7185 3615 7185 3645 7185 -2 2 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 5 - 3765 7185 3765 7185 3735 7185 3735 7185 3765 7185 -2 2 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 5 - 3885 7185 3885 7185 3870 7185 3870 7185 3885 7185 --6 -6 4500 6900 4800 7200 -5 1 0 1 0 0 0 0 -1 0.000 0 1 0 0 4650.000 6838.125 4515 6960 4650 7020 4785 6960 -5 1 0 1 0 0 0 0 -1 0.000 0 1 0 0 4657.500 7027.500 4590 7020 4650 7095 4725 7020 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 3 - 4590 7005 4650 6915 4725 7005 -2 2 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 5 - 4665 6930 4635 6930 4635 6900 4665 6900 4665 6930 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 1 - 4725 7050 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 2 - 4590 7020 4650 7095 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 2 - 4650 7095 4725 7020 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 4 - 4590 7005 4590 7020 4725 7020 4725 7005 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 2 - 4650 7020 4530 7185 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 2 - 4650 7020 4785 7185 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 2 - 4650 7020 4650 7185 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 2 - 4650 7095 4530 7185 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 2 - 4650 7095 4785 7185 -2 2 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 5 - 4545 7185 4545 7185 4515 7185 4515 7185 4545 7185 -2 2 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 5 - 4665 7185 4665 7185 4635 7185 4635 7185 4665 7185 -2 2 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 5 - 4785 7185 4785 7185 4770 7185 4770 7185 4785 7185 --6 -6 5400 6900 5700 7200 -5 1 0 1 0 0 0 0 -1 0.000 0 1 0 0 5550.000 6838.125 5415 6960 5550 7020 5685 6960 -5 1 0 1 0 0 0 0 -1 0.000 0 1 0 0 5557.500 7027.500 5490 7020 5550 7095 5625 7020 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 3 - 5490 7005 5550 6915 5625 7005 -2 2 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 5 - 5565 6930 5535 6930 5535 6900 5565 6900 5565 6930 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 1 - 5625 7050 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 2 - 5490 7020 5550 7095 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 2 - 5550 7095 5625 7020 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 4 - 5490 7005 5490 7020 5625 7020 5625 7005 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 2 - 5550 7020 5430 7185 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 2 - 5550 7020 5685 7185 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 2 - 5550 7020 5550 7185 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 2 - 5550 7095 5430 7185 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 2 - 5550 7095 5685 7185 -2 2 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 5 - 5445 7185 5445 7185 5415 7185 5415 7185 5445 7185 -2 2 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 5 - 5565 7185 5565 7185 5535 7185 5535 7185 5565 7185 -2 2 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 5 - 5685 7185 5685 7185 5670 7185 5670 7185 5685 7185 --6 -6 6300 6900 6600 7200 -5 1 0 1 0 0 0 0 -1 0.000 0 1 0 0 6450.000 6838.125 6315 6960 6450 7020 6585 6960 -5 1 0 1 0 0 0 0 -1 0.000 0 1 0 0 6457.500 7027.500 6390 7020 6450 7095 6525 7020 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 3 - 6390 7005 6450 6915 6525 7005 -2 2 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 5 - 6465 6930 6435 6930 6435 6900 6465 6900 6465 6930 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 1 - 6525 7050 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 2 - 6390 7020 6450 7095 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 2 - 6450 7095 6525 7020 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 4 - 6390 7005 6390 7020 6525 7020 6525 7005 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 2 - 6450 7020 6330 7185 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 2 - 6450 7020 6585 7185 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 2 - 6450 7020 6450 7185 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 2 - 6450 7095 6330 7185 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 2 - 6450 7095 6585 7185 -2 2 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 5 - 6345 7185 6345 7185 6315 7185 6315 7185 6345 7185 -2 2 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 5 - 6465 7185 6465 7185 6435 7185 6435 7185 6465 7185 -2 2 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 5 - 6585 7185 6585 7185 6570 7185 6570 7185 6585 7185 --6 -6 7200 6900 7500 7200 -5 1 0 1 0 0 0 0 -1 0.000 0 1 0 0 7350.000 6838.125 7215 6960 7350 7020 7485 6960 -5 1 0 1 0 0 0 0 -1 0.000 0 1 0 0 7357.500 7027.500 7290 7020 7350 7095 7425 7020 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 3 - 7290 7005 7350 6915 7425 7005 -2 2 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 5 - 7365 6930 7335 6930 7335 6900 7365 6900 7365 6930 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 1 - 7425 7050 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 2 - 7290 7020 7350 7095 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 2 - 7350 7095 7425 7020 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 4 - 7290 7005 7290 7020 7425 7020 7425 7005 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 2 - 7350 7020 7230 7185 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 2 - 7350 7020 7485 7185 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 2 - 7350 7020 7350 7185 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 2 - 7350 7095 7230 7185 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 2 - 7350 7095 7485 7185 -2 2 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 5 - 7245 7185 7245 7185 7215 7185 7215 7185 7245 7185 -2 2 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 5 - 7365 7185 7365 7185 7335 7185 7335 7185 7365 7185 -2 2 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 5 - 7485 7185 7485 7185 7470 7185 7470 7185 7485 7185 --6 -6 8100 6900 8400 7200 -5 1 0 1 0 0 0 0 -1 0.000 0 1 0 0 8250.000 6838.125 8115 6960 8250 7020 8385 6960 -5 1 0 1 0 0 0 0 -1 0.000 0 1 0 0 8257.500 7027.500 8190 7020 8250 7095 8325 7020 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 3 - 8190 7005 8250 6915 8325 7005 -2 2 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 5 - 8265 6930 8235 6930 8235 6900 8265 6900 8265 6930 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 1 - 8325 7050 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 2 - 8190 7020 8250 7095 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 2 - 8250 7095 8325 7020 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 4 - 8190 7005 8190 7020 8325 7020 8325 7005 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 2 - 8250 7020 8130 7185 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 2 - 8250 7020 8385 7185 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 2 - 8250 7020 8250 7185 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 2 - 8250 7095 8130 7185 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 2 - 8250 7095 8385 7185 -2 2 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 5 - 8145 7185 8145 7185 8115 7185 8115 7185 8145 7185 -2 2 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 5 - 8265 7185 8265 7185 8235 7185 8235 7185 8265 7185 -2 2 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 5 - 8385 7185 8385 7185 8370 7185 8370 7185 8385 7185 --6 -6 9000 6900 9300 7200 -5 1 0 1 0 0 0 0 -1 0.000 0 1 0 0 9150.000 6838.125 9015 6960 9150 7020 9285 6960 -5 1 0 1 0 0 0 0 -1 0.000 0 1 0 0 9157.500 7027.500 9090 7020 9150 7095 9225 7020 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 3 - 9090 7005 9150 6915 9225 7005 -2 2 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 5 - 9165 6930 9135 6930 9135 6900 9165 6900 9165 6930 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 1 - 9225 7050 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 2 - 9090 7020 9150 7095 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 2 - 9150 7095 9225 7020 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 4 - 9090 7005 9090 7020 9225 7020 9225 7005 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 2 - 9150 7020 9030 7185 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 2 - 9150 7020 9285 7185 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 2 - 9150 7020 9150 7185 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 2 - 9150 7095 9030 7185 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 2 - 9150 7095 9285 7185 -2 2 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 5 - 9045 7185 9045 7185 9015 7185 9015 7185 9045 7185 -2 2 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 5 - 9165 7185 9165 7185 9135 7185 9135 7185 9165 7185 -2 2 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 5 - 9285 7185 9285 7185 9270 7185 9270 7185 9285 7185 --6 -6 9375 6900 10275 7200 -6 9375 6900 9675 7200 -5 1 0 1 0 0 0 0 -1 0.000 0 1 0 0 9525.000 6838.125 9390 6960 9525 7020 9660 6960 -5 1 0 1 0 0 0 0 -1 0.000 0 1 0 0 9532.500 7027.500 9465 7020 9525 7095 9600 7020 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 3 - 9465 7005 9525 6915 9600 7005 -2 2 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 5 - 9540 6930 9510 6930 9510 6900 9540 6900 9540 6930 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 1 - 9600 7050 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 2 - 9465 7020 9525 7095 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 2 - 9525 7095 9600 7020 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 4 - 9465 7005 9465 7020 9600 7020 9600 7005 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 2 - 9525 7020 9405 7185 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 2 - 9525 7020 9660 7185 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 2 - 9525 7020 9525 7185 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 2 - 9525 7095 9405 7185 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 2 - 9525 7095 9660 7185 -2 2 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 5 - 9420 7185 9420 7185 9390 7185 9390 7185 9420 7185 -2 2 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 5 - 9540 7185 9540 7185 9510 7185 9510 7185 9540 7185 -2 2 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 5 - 9660 7185 9660 7185 9645 7185 9645 7185 9660 7185 --6 -6 9975 6900 10275 7200 -5 1 0 1 0 0 0 0 -1 0.000 0 1 0 0 10125.000 6838.125 9990 6960 10125 7020 10260 6960 -5 1 0 1 0 0 0 0 -1 0.000 0 1 0 0 10132.500 7027.500 10065 7020 10125 7095 10200 7020 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 3 - 10065 7005 10125 6915 10200 7005 -2 2 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 5 - 10140 6930 10110 6930 10110 6900 10140 6900 10140 6930 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 1 - 10200 7050 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 2 - 10065 7020 10125 7095 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 2 - 10125 7095 10200 7020 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 4 - 10065 7005 10065 7020 10200 7020 10200 7005 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 2 - 10125 7020 10005 7185 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 2 - 10125 7020 10260 7185 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 2 - 10125 7020 10125 7185 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 2 - 10125 7095 10005 7185 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 2 - 10125 7095 10260 7185 -2 2 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 5 - 10020 7185 10020 7185 9990 7185 9990 7185 10020 7185 -2 2 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 5 - 10140 7185 10140 7185 10110 7185 10110 7185 10140 7185 -2 2 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 5 - 10260 7185 10260 7185 10245 7185 10245 7185 10260 7185 --6 --6 -6 9525 6000 10425 6300 -6 9525 6000 9825 6300 -5 1 0 1 0 0 0 0 -1 0.000 0 1 0 0 9675.000 5938.125 9540 6060 9675 6120 9810 6060 -5 1 0 1 0 0 0 0 -1 0.000 0 1 0 0 9682.500 6127.500 9615 6120 9675 6195 9750 6120 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 3 - 9615 6105 9675 6015 9750 6105 -2 2 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 5 - 9690 6030 9660 6030 9660 6000 9690 6000 9690 6030 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 1 - 9750 6150 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 2 - 9615 6120 9675 6195 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 2 - 9675 6195 9750 6120 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 4 - 9615 6105 9615 6120 9750 6120 9750 6105 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 2 - 9675 6120 9555 6285 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 2 - 9675 6120 9810 6285 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 2 - 9675 6120 9675 6285 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 2 - 9675 6195 9555 6285 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 2 - 9675 6195 9810 6285 -2 2 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 5 - 9570 6285 9570 6285 9540 6285 9540 6285 9570 6285 -2 2 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 5 - 9690 6285 9690 6285 9660 6285 9660 6285 9690 6285 -2 2 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 5 - 9810 6285 9810 6285 9795 6285 9795 6285 9810 6285 --6 -6 10125 6000 10425 6300 -5 1 0 1 0 0 0 0 -1 0.000 0 1 0 0 10275.000 5938.125 10140 6060 10275 6120 10410 6060 -5 1 0 1 0 0 0 0 -1 0.000 0 1 0 0 10282.500 6127.500 10215 6120 10275 6195 10350 6120 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 3 - 10215 6105 10275 6015 10350 6105 -2 2 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 5 - 10290 6030 10260 6030 10260 6000 10290 6000 10290 6030 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 1 - 10350 6150 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 2 - 10215 6120 10275 6195 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 2 - 10275 6195 10350 6120 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 4 - 10215 6105 10215 6120 10350 6120 10350 6105 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 2 - 10275 6120 10155 6285 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 2 - 10275 6120 10410 6285 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 2 - 10275 6120 10275 6285 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 2 - 10275 6195 10155 6285 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 2 - 10275 6195 10410 6285 -2 2 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 5 - 10170 6285 10170 6285 10140 6285 10140 6285 10170 6285 -2 2 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 5 - 10290 6285 10290 6285 10260 6285 10260 6285 10290 6285 -2 2 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 5 - 10410 6285 10410 6285 10395 6285 10395 6285 10410 6285 --6 --6 -6 9675 5100 10575 5400 -6 9675 5100 9975 5400 -5 1 0 1 0 0 0 0 -1 0.000 0 1 0 0 9825.000 5038.125 9690 5160 9825 5220 9960 5160 -5 1 0 1 0 0 0 0 -1 0.000 0 1 0 0 9832.500 5227.500 9765 5220 9825 5295 9900 5220 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 3 - 9765 5205 9825 5115 9900 5205 -2 2 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 5 - 9840 5130 9810 5130 9810 5100 9840 5100 9840 5130 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 1 - 9900 5250 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 2 - 9765 5220 9825 5295 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 2 - 9825 5295 9900 5220 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 4 - 9765 5205 9765 5220 9900 5220 9900 5205 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 2 - 9825 5220 9705 5385 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 2 - 9825 5220 9960 5385 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 2 - 9825 5220 9825 5385 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 2 - 9825 5295 9705 5385 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 2 - 9825 5295 9960 5385 -2 2 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 5 - 9720 5385 9720 5385 9690 5385 9690 5385 9720 5385 -2 2 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 5 - 9840 5385 9840 5385 9810 5385 9810 5385 9840 5385 -2 2 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 5 - 9960 5385 9960 5385 9945 5385 9945 5385 9960 5385 --6 -6 10275 5100 10575 5400 -5 1 0 1 0 0 0 0 -1 0.000 0 1 0 0 10425.000 5038.125 10290 5160 10425 5220 10560 5160 -5 1 0 1 0 0 0 0 -1 0.000 0 1 0 0 10432.500 5227.500 10365 5220 10425 5295 10500 5220 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 3 - 10365 5205 10425 5115 10500 5205 -2 2 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 5 - 10440 5130 10410 5130 10410 5100 10440 5100 10440 5130 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 1 - 10500 5250 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 2 - 10365 5220 10425 5295 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 2 - 10425 5295 10500 5220 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 4 - 10365 5205 10365 5220 10500 5220 10500 5205 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 2 - 10425 5220 10305 5385 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 2 - 10425 5220 10560 5385 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 2 - 10425 5220 10425 5385 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 2 - 10425 5295 10305 5385 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 2 - 10425 5295 10560 5385 -2 2 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 5 - 10320 5385 10320 5385 10290 5385 10290 5385 10320 5385 -2 2 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 5 - 10440 5385 10440 5385 10410 5385 10410 5385 10440 5385 -2 2 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 5 - 10560 5385 10560 5385 10545 5385 10545 5385 10560 5385 --6 --6 -6 9825 4200 10725 4500 -6 9825 4200 10125 4500 -5 1 0 1 0 0 0 0 -1 0.000 0 1 0 0 9975.000 4138.125 9840 4260 9975 4320 10110 4260 -5 1 0 1 0 0 0 0 -1 0.000 0 1 0 0 9982.500 4327.500 9915 4320 9975 4395 10050 4320 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 3 - 9915 4305 9975 4215 10050 4305 -2 2 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 5 - 9990 4230 9960 4230 9960 4200 9990 4200 9990 4230 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 1 - 10050 4350 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 2 - 9915 4320 9975 4395 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 2 - 9975 4395 10050 4320 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 4 - 9915 4305 9915 4320 10050 4320 10050 4305 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 2 - 9975 4320 9855 4485 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 2 - 9975 4320 10110 4485 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 2 - 9975 4320 9975 4485 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 2 - 9975 4395 9855 4485 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 2 - 9975 4395 10110 4485 -2 2 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 5 - 9870 4485 9870 4485 9840 4485 9840 4485 9870 4485 -2 2 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 5 - 9990 4485 9990 4485 9960 4485 9960 4485 9990 4485 -2 2 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 5 - 10110 4485 10110 4485 10095 4485 10095 4485 10110 4485 --6 -6 10425 4200 10725 4500 -5 1 0 1 0 0 0 0 -1 0.000 0 1 0 0 10575.000 4138.125 10440 4260 10575 4320 10710 4260 -5 1 0 1 0 0 0 0 -1 0.000 0 1 0 0 10582.500 4327.500 10515 4320 10575 4395 10650 4320 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 3 - 10515 4305 10575 4215 10650 4305 -2 2 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 5 - 10590 4230 10560 4230 10560 4200 10590 4200 10590 4230 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 1 - 10650 4350 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 2 - 10515 4320 10575 4395 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 2 - 10575 4395 10650 4320 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 4 - 10515 4305 10515 4320 10650 4320 10650 4305 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 2 - 10575 4320 10455 4485 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 2 - 10575 4320 10710 4485 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 2 - 10575 4320 10575 4485 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 2 - 10575 4395 10455 4485 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 2 - 10575 4395 10710 4485 -2 2 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 5 - 10470 4485 10470 4485 10440 4485 10440 4485 10470 4485 -2 2 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 5 - 10590 4485 10590 4485 10560 4485 10560 4485 10590 4485 -2 2 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 5 - 10710 4485 10710 4485 10695 4485 10695 4485 10710 4485 --6 --6 -6 13275 6900 14175 7200 -6 13275 6900 13575 7200 -5 1 0 1 0 0 0 0 -1 0.000 0 1 0 0 13425.000 6838.125 13290 6960 13425 7020 13560 6960 -5 1 0 1 0 0 0 0 -1 0.000 0 1 0 0 13432.500 7027.500 13365 7020 13425 7095 13500 7020 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 3 - 13365 7005 13425 6915 13500 7005 -2 2 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 5 - 13440 6930 13410 6930 13410 6900 13440 6900 13440 6930 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 1 - 13500 7050 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 2 - 13365 7020 13425 7095 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 2 - 13425 7095 13500 7020 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 4 - 13365 7005 13365 7020 13500 7020 13500 7005 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 2 - 13425 7020 13305 7185 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 2 - 13425 7020 13560 7185 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 2 - 13425 7020 13425 7185 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 2 - 13425 7095 13305 7185 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 2 - 13425 7095 13560 7185 -2 2 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 5 - 13320 7185 13320 7185 13290 7185 13290 7185 13320 7185 -2 2 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 5 - 13440 7185 13440 7185 13410 7185 13410 7185 13440 7185 -2 2 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 5 - 13560 7185 13560 7185 13545 7185 13545 7185 13560 7185 --6 -6 13875 6900 14175 7200 -5 1 0 1 0 0 0 0 -1 0.000 0 1 0 0 14025.000 6838.125 13890 6960 14025 7020 14160 6960 -5 1 0 1 0 0 0 0 -1 0.000 0 1 0 0 14032.500 7027.500 13965 7020 14025 7095 14100 7020 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 3 - 13965 7005 14025 6915 14100 7005 -2 2 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 5 - 14040 6930 14010 6930 14010 6900 14040 6900 14040 6930 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 1 - 14100 7050 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 2 - 13965 7020 14025 7095 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 2 - 14025 7095 14100 7020 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 4 - 13965 7005 13965 7020 14100 7020 14100 7005 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 2 - 14025 7020 13905 7185 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 2 - 14025 7020 14160 7185 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 2 - 14025 7020 14025 7185 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 2 - 14025 7095 13905 7185 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 2 - 14025 7095 14160 7185 -2 2 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 5 - 13920 7185 13920 7185 13890 7185 13890 7185 13920 7185 -2 2 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 5 - 14040 7185 14040 7185 14010 7185 14010 7185 14040 7185 -2 2 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 5 - 14160 7185 14160 7185 14145 7185 14145 7185 14160 7185 --6 --6 -6 13425 6000 14325 6300 -6 13425 6000 13725 6300 -5 1 0 1 0 0 0 0 -1 0.000 0 1 0 0 13575.000 5938.125 13440 6060 13575 6120 13710 6060 -5 1 0 1 0 0 0 0 -1 0.000 0 1 0 0 13582.500 6127.500 13515 6120 13575 6195 13650 6120 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 3 - 13515 6105 13575 6015 13650 6105 -2 2 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 5 - 13590 6030 13560 6030 13560 6000 13590 6000 13590 6030 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 1 - 13650 6150 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 2 - 13515 6120 13575 6195 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 2 - 13575 6195 13650 6120 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 4 - 13515 6105 13515 6120 13650 6120 13650 6105 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 2 - 13575 6120 13455 6285 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 2 - 13575 6120 13710 6285 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 2 - 13575 6120 13575 6285 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 2 - 13575 6195 13455 6285 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 2 - 13575 6195 13710 6285 -2 2 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 5 - 13470 6285 13470 6285 13440 6285 13440 6285 13470 6285 -2 2 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 5 - 13590 6285 13590 6285 13560 6285 13560 6285 13590 6285 -2 2 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 5 - 13710 6285 13710 6285 13695 6285 13695 6285 13710 6285 --6 -6 14025 6000 14325 6300 -5 1 0 1 0 0 0 0 -1 0.000 0 1 0 0 14175.000 5938.125 14040 6060 14175 6120 14310 6060 -5 1 0 1 0 0 0 0 -1 0.000 0 1 0 0 14182.500 6127.500 14115 6120 14175 6195 14250 6120 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 3 - 14115 6105 14175 6015 14250 6105 -2 2 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 5 - 14190 6030 14160 6030 14160 6000 14190 6000 14190 6030 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 1 - 14250 6150 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 2 - 14115 6120 14175 6195 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 2 - 14175 6195 14250 6120 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 4 - 14115 6105 14115 6120 14250 6120 14250 6105 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 2 - 14175 6120 14055 6285 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 2 - 14175 6120 14310 6285 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 2 - 14175 6120 14175 6285 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 2 - 14175 6195 14055 6285 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 2 - 14175 6195 14310 6285 -2 2 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 5 - 14070 6285 14070 6285 14040 6285 14040 6285 14070 6285 -2 2 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 5 - 14190 6285 14190 6285 14160 6285 14160 6285 14190 6285 -2 2 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 5 - 14310 6285 14310 6285 14295 6285 14295 6285 14310 6285 --6 --6 -6 13575 5100 14475 5400 -6 13575 5100 13875 5400 -5 1 0 1 0 0 0 0 -1 0.000 0 1 0 0 13725.000 5038.125 13590 5160 13725 5220 13860 5160 -5 1 0 1 0 0 0 0 -1 0.000 0 1 0 0 13732.500 5227.500 13665 5220 13725 5295 13800 5220 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 3 - 13665 5205 13725 5115 13800 5205 -2 2 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 5 - 13740 5130 13710 5130 13710 5100 13740 5100 13740 5130 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 1 - 13800 5250 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 2 - 13665 5220 13725 5295 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 2 - 13725 5295 13800 5220 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 4 - 13665 5205 13665 5220 13800 5220 13800 5205 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 2 - 13725 5220 13605 5385 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 2 - 13725 5220 13860 5385 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 2 - 13725 5220 13725 5385 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 2 - 13725 5295 13605 5385 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 2 - 13725 5295 13860 5385 -2 2 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 5 - 13620 5385 13620 5385 13590 5385 13590 5385 13620 5385 -2 2 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 5 - 13740 5385 13740 5385 13710 5385 13710 5385 13740 5385 -2 2 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 5 - 13860 5385 13860 5385 13845 5385 13845 5385 13860 5385 --6 -6 14175 5100 14475 5400 -5 1 0 1 0 0 0 0 -1 0.000 0 1 0 0 14325.000 5038.125 14190 5160 14325 5220 14460 5160 -5 1 0 1 0 0 0 0 -1 0.000 0 1 0 0 14332.500 5227.500 14265 5220 14325 5295 14400 5220 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 3 - 14265 5205 14325 5115 14400 5205 -2 2 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 5 - 14340 5130 14310 5130 14310 5100 14340 5100 14340 5130 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 1 - 14400 5250 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 2 - 14265 5220 14325 5295 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 2 - 14325 5295 14400 5220 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 4 - 14265 5205 14265 5220 14400 5220 14400 5205 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 2 - 14325 5220 14205 5385 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 2 - 14325 5220 14460 5385 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 2 - 14325 5220 14325 5385 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 2 - 14325 5295 14205 5385 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 2 - 14325 5295 14460 5385 -2 2 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 5 - 14220 5385 14220 5385 14190 5385 14190 5385 14220 5385 -2 2 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 5 - 14340 5385 14340 5385 14310 5385 14310 5385 14340 5385 -2 2 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 5 - 14460 5385 14460 5385 14445 5385 14445 5385 14460 5385 --6 --6 -6 13725 4200 14625 4500 -6 13725 4200 14025 4500 -5 1 0 1 0 0 0 0 -1 0.000 0 1 0 0 13875.000 4138.125 13740 4260 13875 4320 14010 4260 -5 1 0 1 0 0 0 0 -1 0.000 0 1 0 0 13882.500 4327.500 13815 4320 13875 4395 13950 4320 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 3 - 13815 4305 13875 4215 13950 4305 -2 2 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 5 - 13890 4230 13860 4230 13860 4200 13890 4200 13890 4230 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 1 - 13950 4350 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 2 - 13815 4320 13875 4395 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 2 - 13875 4395 13950 4320 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 4 - 13815 4305 13815 4320 13950 4320 13950 4305 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 2 - 13875 4320 13755 4485 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 2 - 13875 4320 14010 4485 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 2 - 13875 4320 13875 4485 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 2 - 13875 4395 13755 4485 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 2 - 13875 4395 14010 4485 -2 2 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 5 - 13770 4485 13770 4485 13740 4485 13740 4485 13770 4485 -2 2 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 5 - 13890 4485 13890 4485 13860 4485 13860 4485 13890 4485 -2 2 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 5 - 14010 4485 14010 4485 13995 4485 13995 4485 14010 4485 --6 -6 14325 4200 14625 4500 -5 1 0 1 0 0 0 0 -1 0.000 0 1 0 0 14475.000 4138.125 14340 4260 14475 4320 14610 4260 -5 1 0 1 0 0 0 0 -1 0.000 0 1 0 0 14482.500 4327.500 14415 4320 14475 4395 14550 4320 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 3 - 14415 4305 14475 4215 14550 4305 -2 2 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 5 - 14490 4230 14460 4230 14460 4200 14490 4200 14490 4230 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 1 - 14550 4350 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 2 - 14415 4320 14475 4395 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 2 - 14475 4395 14550 4320 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 4 - 14415 4305 14415 4320 14550 4320 14550 4305 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 2 - 14475 4320 14355 4485 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 2 - 14475 4320 14610 4485 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 2 - 14475 4320 14475 4485 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 2 - 14475 4395 14355 4485 -2 1 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 2 - 14475 4395 14610 4485 -2 2 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 5 - 14370 4485 14370 4485 14340 4485 14340 4485 14370 4485 -2 2 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 5 - 14490 4485 14490 4485 14460 4485 14460 4485 14490 4485 -2 2 0 1 0 0 0 0 -1 0.000 0 0 7 0 0 5 - 14610 4485 14610 4485 14595 4485 14595 4485 14610 4485 --6 --6 -2 1 0 2 0 0 0 0 -1 0.000 0 0 -1 0 0 2 - 900 4500 8700 4500 -2 1 0 2 0 0 0 0 -1 0.000 0 0 -1 0 0 2 - 1800 4500 9300 4500 -2 1 0 2 0 0 0 0 -1 0.000 0 0 -1 0 0 2 - 1800 4500 9300 4500 -2 1 0 2 0 0 0 0 -1 0.000 0 0 -1 0 0 2 - 2700 4500 9300 4500 -2 1 1 2 0 0 0 0 -1 6.000 0 0 -1 0 0 2 - 13200 4500 14700 4500 -2 1 1 2 0 0 0 0 -1 6.000 0 0 -1 0 0 2 - 9300 4500 10800 4500 -2 1 0 2 0 0 0 0 -1 0.000 0 0 -1 0 0 2 - 900 5400 8700 5400 -2 1 0 2 0 0 0 0 -1 0.000 0 0 -1 0 0 2 - 1800 5400 9300 5400 -2 1 0 2 0 0 0 0 -1 0.000 0 0 -1 0 0 2 - 1800 5400 9300 5400 -2 1 0 2 0 0 0 0 -1 0.000 0 0 -1 0 0 2 - 2700 5400 9300 5400 -2 1 1 2 0 0 0 0 -1 6.000 0 0 -1 0 0 2 - 13200 5400 14700 5400 -2 1 1 2 0 0 0 0 -1 6.000 0 0 -1 0 0 2 - 9300 5400 10800 5400 -2 1 0 2 0 0 0 0 -1 0.000 0 0 -1 0 0 2 - 900 6300 8700 6300 -2 1 0 2 0 0 0 0 -1 0.000 0 0 -1 0 0 2 - 1800 6300 9300 6300 -2 1 0 2 0 0 0 0 -1 0.000 0 0 -1 0 0 2 - 1800 6300 9300 6300 -2 1 0 2 0 0 0 0 -1 0.000 0 0 -1 0 0 2 - 2700 6300 9300 6300 -2 1 1 2 0 0 0 0 -1 6.000 0 0 -1 0 0 2 - 13200 6300 14700 6300 -2 1 1 2 0 0 0 0 -1 6.000 0 0 -1 0 0 2 - 9300 6300 10800 6300 -2 1 0 2 0 0 0 0 -1 0.000 0 0 -1 0 0 2 - 900 7200 8700 7200 -2 1 0 2 0 0 0 0 -1 0.000 0 0 -1 0 0 2 - 1800 7200 9300 7200 -2 1 0 2 0 0 0 0 -1 0.000 0 0 -1 0 0 2 - 1800 7200 9300 7200 -2 1 0 2 0 0 0 0 -1 0.000 0 0 -1 0 0 2 - 2700 7200 9300 7200 -2 1 1 2 0 0 0 0 -1 6.000 0 0 -1 0 0 2 - 13200 7200 14700 7200 -2 1 1 2 0 0 0 0 -1 6.000 0 0 -1 0 0 2 - 9300 7200 10800 7200 -2 1 2 1 0 0 0 0 -1 3.000 0 0 -1 0 0 2 - 10800 4500 13200 4500 -2 1 2 1 0 0 0 0 -1 3.000 0 0 -1 0 0 2 - 10800 5400 13125 5400 -2 1 2 1 0 0 0 0 -1 3.000 0 0 -1 0 0 2 - 10800 6300 13200 6300 -2 1 2 1 0 0 0 0 -1 3.000 0 0 -1 0 0 2 - 10800 7200 13200 7200 -2 1 0 1 -1 -1 0 0 -1 0.000 0 0 -1 1 0 2 - 0 0 2.00 135.00 255.00 - 2025 8700 1125 8700 -2 1 0 1 -1 -1 0 0 -1 0.000 0 0 -1 1 0 2 - 0 0 2.00 135.00 255.00 - 11625 8700 12600 8700 -4 0 0 0 0 0 20 0.0000000 0 195 1005 15300 4500 9A=90m\001 -4 0 0 0 0 0 20 0.0000000 0 195 1005 15300 5400 9A=72m\001 -4 0 0 0 0 0 20 0.0000000 0 195 1005 15300 6300 9A=54m\001 -4 0 0 0 0 0 20 0.0000000 0 195 1005 15300 7200 9A=36m\001 -4 0 0 0 0 0 20 0.0000000 0 195 195 13500 7800 C\001 -4 0 0 0 0 0 20 0.0000000 0 195 210 14100 7800 D\001 -4 0 0 0 0 0 20 0.0000000 0 195 135 900 7800 0\001 -4 0 0 0 0 0 20 0.0000000 0 195 135 1800 7800 1\001 -4 0 0 0 0 0 20 0.0000000 0 195 135 2700 7800 3\001 -4 0 0 0 0 0 20 0.0000000 0 195 135 3600 7800 3\001 -4 0 0 0 0 0 20 0.0000000 0 195 135 4500 7800 4\001 -4 0 0 0 0 0 20 0.0000000 0 195 135 5400 7800 5\001 -4 0 0 0 0 0 20 0.0000000 0 195 135 6300 7800 6\001 -4 0 0 0 0 0 20 0.0000000 0 195 135 7200 7800 7\001 -4 0 0 0 0 0 20 0.0000000 0 195 135 8100 7800 8\001 -4 0 0 0 0 0 20 0.0000000 0 195 135 9000 7800 9\001 -4 0 0 0 0 0 20 0.0000000 0 195 210 9600 7800 A\001 -4 0 0 0 0 0 20 0.0000000 0 195 195 10200 7800 B\001 -4 0 -1 0 0 0 20 0.0000000 0 195 585 2100 8700 West\001 -4 0 -1 0 0 0 20 0.0000000 0 195 510 11100 8700 East\001 -4 0 0 0 0 0 10 0.0000000 0 150 1335 14250 8700 wsrt_layout.fig 47%\001 diff --git a/src/doc/html/elsewhere_inst_maint.html b/src/doc/html/elsewhere_inst_maint.html deleted file mode 100644 index f6766aaf37e8481a0d2db99fb9f2171b2f5b3473..0000000000000000000000000000000000000000 --- a/src/doc/html/elsewhere_inst_maint.html +++ /dev/null @@ -1,423 +0,0 @@ -<TITLE>Installation and maintenance of Newstar outside NFRA</TITLE> - -<STRONG>Subject:</STRONG> Installation and maintenance of Newstar outside NFRA -<BR><STRONG>Author:</STRONG> Marco de Vos (CMV), Henk Vosmeijer (HjV) -<BR><STRONG>To:</STRONG> Friends of Newstar -<P><STRONG>Date:</STRONG> 24/11/94 -<P> -<EM>Revision history</EM> -<UL> -<LI>18/06/96 - add Solaris as available machine, correct Building Newstar part -<LI>24/11/94 - add questionnaire new Newstar sites, make html -<LI>16/02/94 - first release -<LI>04/03/94 - prerelease -</UL> - -<PRE></PRE> -<H1>Installation and maintenance of Newstar outside NFRA</H1> -<PRE></PRE> - -<H2>1. About Newstar and this document</H2> - -Newstar is the reduction package for WSRT data. -<BR>It makes optimal use of the specific properties of the WSRT. - -<P>You can use it to: -<UL> -<LI>read, display, calibrate and analyse WSRT data. -<LI>flag bad data interactively or in semi-automatic mode. -<LI>extract and improve parametrised models from the data. -<LI>make and manipulate calibrated maps. -<LI>save raw or calibrated data as UVFITS tapes or files. -<LI>save maps as FITS tapes or files. -</UL> - -General information on Newstar operations can be found in the Newstar -Documentation. This documentation is available on-line. If you are -familiar with World Wide Web browsers like XMosaic, you can get at the -documentation by opening <A HREF=http://www.astron.nl/newstar/hlp/homepage.html>http://www.astron.nl/newstar/hlp/homepage.html</A> -<BR>Otherwise, please send an eMail to <EM>newstar@astron.nl</EM> for assistance. -<P> -This document is concerned with installation and maintenance of Newstar -at institutes other than the NFRA. It descibes our export policy, the -procedure for first time installation and the procedures for local -maintenance. -<PRE></PRE> - -<H2>2. Export policy</H2> - -The master copy of the Newstar software is maintained at the NFRA in -Dwingeloo. Newstar is available for end-users on the following machines: -<UL> -<LI>hp = HP Workstations (9000 series, others at request) -<LI>sw = Sun Workstations (sun4) -<LI>dw = DEC Workstations (DEC3100) -<LI>da = DEC Alpha/OSF1 -<LI>so = Sun Solaris -</UL> - -(the two-letter codes will be used in the remainder of this document) -<P> -This list may be extended with other Unix systems in future. Newstar -can also be run on Convex (cv) systems, but this is not officially -supported by the NFRA. -<P> -If you want to install Newstar on your institute, the Newstar group -will assist with the first time installation of the package. We expect -you to assign a local "Friend of Newstar" who will take care of local -maintenance, using the procedures described in this document. In case -of problems, you can of course contact the Newstar group, who will do -it's best to solve things on a short notice. -<P> -The Newstar maintenance at the radio-observatory in Westerbork is -updated by the Newstar group at a weekly basis. -<PRE></PRE> - -<H2>3. First time installation</H2> - -It should be noted that the Newstar group is available for assistance -with the first time installation of Newstar. Also we can implement such -things as changes in printers and tapeunits. However, this section -describes the installation process in full detail. -<P> -<H3>3A. Before installation</H3> - -Before you can install Newstar, you have to sort out the following -things: -<UL> -<LI>Set up an account for Newstar, or at least a directory where -Newstar can be installed (this directory will be refered to as -the "Newstar root-directory" in the remainder of this document). -<P> -At present, disk-space requirements are: -<UL> -<LI>Sources: 15 ... 27 MByte -<LI>Libraries: 20 ... 25 MByte (for each architecture) -<LI>Executables: 60 ... 90 MByte (for each architecture) -</UL> -<BR>The amount of diskspace varies per architecture. -<BR>Sources, libraries and executables may reside at separate filesystems. -<P> -<LI>Find out the commands to send ASCII and postscript files to -your local printer(s). -<P> -<LI>Find out the names of the tapeunits connected to your hosts -</UL> -You should fill out the form in <STRONG>Appendix A</STRONG> and eMail -it to <EM>newstar@astron.nl</EM> (from this point on the Newstar group -can take care of installation). - - -<H3>3B. Installing the Newstar sources</H3> - -You should have tar-archives nstar_src.tar.Z and nstar_src_aa.tar -(where aa is the abbreviation of the architecture on which you want to -use Newstar, you may need several nstar_src_aa.tar files) from tape or -from anonymous ftp to ftp.astron.nl (directory newstar). -<BR>To unpack this archive, use the following commands: -<PRE> ->>> cd "Newstar root-directory" ->>> mkdir src ->>> cd src ->>> uncompress [directory_with_archive/]nstar_src.tar.Z ->>> tar xvf [directory_with_archive/]nstar_src.tar ->>> tar xvf [directory_with_archive/]nstar_src_aa.tar -</PRE> - -<H3>3C. Adapting to your local situation</H3> - -Assign an abbreviated name for your institute (up to 5 characters). This -name will be refered to as "xxxx" in the remainder of this document. -<P> -Your local situation will be reflected in the following files, all in -directory "Newstar root-directory"/src/sys -<PRE> -newstar_xxxx.csh Directory structure, tape-units, some details -wngfex_xxxx.csh Commands for printing -i_aaxxxx.csh Fine-tuning for compilation on architecture "aa" -</PRE> -In general, the Newstar group will create these files based on information -supplied by you. In case you want to create the files yourself, please use -the versions for the nfra (newstar_nfra.csh etc.) as a template, since -they are extensively documented. -<P> -In newstar_xxxx.csh you should define at least the following: -<OL> -<LI>The Newstar rootdirectory -<BR><TT>(setenv n_root "Newstar root-directory")</TT> -<P> -<LI>The Newstar site -<BR><TT>(setenv n_site xxxx)</TT> -<P> -<LI>The architectures you want to install Newstar for (we distribute -some precompiled binaries and libraries for which you need only the -versions specified here, these are in fact in nstar_src_aa.tar) -<BR><TT>(setenv n_install hp/sw)</TT> -<P> -<LI>The hosts on which Newstar has to be compiled (just one host per -architecture please...) -<BR><TT>(setenv n_hosts host1,host2)</TT> -<P> -The order in n_install and n_hosts is arbitrary, but you best keep it -the same in both variables for your own convenience. -<P> -<LI>Definition of tape-units -<BR><TT>(setenv MAG4 /dev/rmt/0mn)</TT> -<P> -<LI>The location of the executable files and libraries if they -should not reside on the same filesystem as the sources. -You should create those directories yourself. If you do not -specify directories here, they will be created automatically. -</OL> -If you create any files yourself, we would like to receive a copy of them. -The files will then be included in the Newstar master. - - -<H3>3D. Building Newstar</H3> - -If you want to make an executable installation for architecture aa, login -on a host of that architecture and initialise the Newstar environment: -<PRE> ->>> source "Newstar root-directory"/src/sys/newstar_xxxx.csh -</PRE> -You may have received archives nstar_exe_aa.tar or nstar_lib_aa.tar. -If aa matches the name of your architecture, you may just untar these files -in the appropriate directories to get a working system: -<PRE> ->>> nup quit ->>> cd $n_lib ->>> uncompress [directory_with_archive/]nstar_lib_aa.tar.Z ->>> tar xvf [directory with_archive]/nstar_lib_aa.tar ->>> uncompress [directory_with_archive/]nstar_lib_inc.tar.Z ->>> tar xvf [directory with_archive]/nstar_lib_inc.tar ->>> cd $n_exe ->>> uncompress [directory_with_archive/]nstar_exe_aa.tar.Z ->>> tar xvf [directory_with_archive/]nstar_exe_aa.tar -</PRE> -If you need to build Newstar from scratch, use the following commands: -<PRE> ->>> nup build -u wntinc (will give 9 errors for dsc-files which could not be - translated because wntinc does not yet exist.) ->>> nup build -u -t:exe wntinc ->>> nup build -u all -</PRE> -Logs of all transactions and errors are kept in $n_src/updyymmddaa[i].log -where i is an index (e.g. upd930623sw.log, upd930623sw1.log). -<P> -If something goes wrong during the installation, the log-files will be sent -to the Newstar group by eMail. This assumes you have the elm mailer -running at your institute. If you do not have it, you should supply an -alias to e.g. mail or mailx in newstar_xxxx.csh -(add a line like alias elm 'mail -s "\!1" \!2 ') -<PRE></PRE> - -<H2>4. Using Newstar, revisions and releases</H2> - -If someone wants to run Newstar programs, the Newstar environment should -be initialised first: -<PRE> ->>> source "Newstar root-directory"/src/sys/newstar_xxxx.csh -</PRE> -This can be safely done in a .cshrc or .login file. -<P> -You can now display the version of Newstar you are currently using: -<PRE> ->>> nnews -</PRE> -This will display the version number first, followed by a list of -recent changes. The version number consists of a release number followed -by a dot and a revision number. -<PRE> ->>> dwe nscan -</PRE> -Programs are started by typing dwe (or exe) followed by the name of the -program. This will display a line like "NSCAN$1 (v4.21) started ...". -The version number can be lower than the version displayed by nnews, since -a revision may concern only some programs. A full revision history with -the revisions for every program can be found in the on-line documentation -(select "Revision history" from the Newstar home page presented by nhyper). -<P> -A revision of Newstar is a series of minor changes that do not affect -the overall operation of Newstar. Revisions are typically bug repairs, -small additions to the functionality of a program etc. They do not affect -keyword syntax and fileformats. -<P> -A release of Newstar is issued when any of the following occured: -<OL> -<LI>A change of fileformats (so you will have to use the -NVS "New Version" option in some programs) -<LI>A change in keyword syntax (so you will have to type different -things or change batch files in some cases) -<LI>Addition of a new program, or a full rewrite of an existing one. -</OL> -<PRE></PRE> - -<H2>5. Keeping your installation up to date</H2> - -In the following we assume that the Newstar environment has been initialised. -<P> -If we modify the Newstar master at NFRA, all Friends of Newstar that we -know of will receive an eMail describing the changes. This message will -also contain instructions how to upgrade your installation. -<P> -In most cases, upgrading is done through a single command: -<PRE> ->>> nup update -</PRE> -This in fact causes the following commands to be executed, which you may -also execute by hand: -<PRE> - >>> cd $n_import -</PRE> -The default directory is set to $n_import, which is the proper place to -receive new files. This keeps your current sources intact. -<PRE> - >>> nup retrieve all -</PRE> -This will make a fresh version of the file $n_src/sys/database.idx, which -gives a full description of your current installation. -Than it will retrieve the version of database.idx from the NFRA for -comparison. Any files that need to be updated are retrieved in $n_import. -The list of files retrieved is in file retrieved.grp. -<PRE> - >>> nup build -Update -T:^exe retrieved.grp -</PRE> -This will build all files just retrieved, and any files dependent on them. -No executables will be built, this will be done after the library check. -<PRE> - >>> nup clear -NConfirm -</PRE> -This will throw away any source files in the master system that are no -longer needed. -<PRE> - >>> nup check l -</PRE> -This will check your libraries. Experience shows that escpecially on HP -workstations libraries tend to get cluttered. This will be found by the -library check. If necessary, an additional build command will be scheduled -to rebuilt modules. Objects for which no source is present are removed -from the libraries. Duplicate entries are both removed and replaced by -a fresh entry. Out-of-date entries are updated. -<PRE> - >>> nup check e -Update -</PRE> -This will check your executables. Executables that do not yet exist -or are out-of-date with respect to the NFRA are rebuilt. Note that usually -not all versions need to be rebuilt for a new revision. Thus some programs -may show a lower version than the version shown by nnews. -<PRE> - >>> rsh HOST '( source $n_src/sys/newstar_xxxx.csh; nup update rsh) -</PRE> -If $n_hosts (as defined in newstar_xxxx.csh) contains more hosts, the above -command will be issued for each of them. This will carry out the build -and check commands listed above, but not the retrieve. -<P> -The proceedings of the update command will dump a lot of output on your -screen, which is also stored in logfiles $n_src/updyymmdd[i].log (see -above). You may want to redirect the output to a file or /dev/null. -If any errors occur, the log-file will be sent to the Newstar group by eMail. -<P> -<P> -The nup command has many more uses than the ones described above. Most of -them should not be relevant to you, since they are related to partial -rebuilds, making backups etc. In case you are interested though, you can -get more information through the command -<PRE> ->>> nup help -help - -</PRE> -<HR> -<H2>Appendix 1: Questionnaire new Newstar sites</H2> - -Provide the following information, and send it to <EM>newstar@astron.nl</EM> -<OL> - -<H3><LI>Site:</H3> -<OL> -<LI>Institute: -<P> -<LI>Abbreviated institute name (up to 5 char): -<P> -<LI>Address: -<PRE> - -</PRE> -<P> -<LI>Friend of newstar: -<P> -<LI>eMail address: -<P> -<LI>ftp node(s): -<P> -<LI>Phone: -<PRE></PRE> -</OL> - -<H3><LI>Platform:</H3> -<OL> -<LI>Platform(s) and their hostname(s) on which Newstar should run: -<OL> -<LI>Convex (cv) -<LI>DEC Alpha/OSF1 (da) -<LI>DECstation (dw) -<LI>HP workstation (hp) -<LI>SUN (sw) -</OL> -If not in list contact to <EM>newstar@astron.nl</EM> for possible inclusion of -your platform. -<P> -<LI>Do platforms have a common NFS on which to place sources? -<OL> -<LI>Yes -<LI>No -</OL> -(only if more than one platform requested at 2.1) -<P> -<LI>Root directory for Newstar: -<BR>(e.g. /usr/src/newstar ) -<PRE></PRE> -<LI>If object-libraries should be placed on a different file system, -specify here: -<PRE></PRE> -<LI>Idem executables: -<PRE></PRE> -<LI>Could you provide an account on your platform(s) in which we can -login to do some remote checks can be made? -<OL> -<LI>Yes -<LI>No -</OL> -If <STRONG>YES</STRONG>, please specify it: -<PRE></PRE> -</OL> - -<H3><LI>Software:</H3> -<OL> -<LI>Are you using the standard f77, cc and ld provided with your system? -<OL> -<LI>Yes -<LI>No -</OL> -If not, provide details on how to call them, and the switches provided) -<PRE></PRE> -<LI>What is your standard command to print 132 wide ASCII files? -<PRE></PRE> -<LI>What is your standard command to plot A4-format PostScript files? -<PRE></PRE> -<LI>What is your standard command to plot A3-format PostScript files? -<PRE></PRE> -<LI>Which other plotters would you like to use? -<BR>(contact <EM>newstar@astron.nl</EM> to see if support is possible) -<PRE></PRE> -</OL> - -<H3><LI>Input/Output medium:</H3> -<OL> -<LI>Specify the device-names of the available mediums for reading/writing data? -<PRE></PRE> -<LI>Specify on which medium you want to receive Newstar if you cannot -support ftp: -<BR>(9track/density, Exabyte, DAT, ...) -<PRE></PRE> -</OL> -</OL> diff --git a/src/doc/html/homepage.html b/src/doc/html/homepage.html deleted file mode 100644 index 21e543ac249ebf18d33aefef494e198311e6de33..0000000000000000000000000000000000000000 --- a/src/doc/html/homepage.html +++ /dev/null @@ -1,40 +0,0 @@ -<! History: > -<! JPH 960326 Correct NFRA reference > -<! JPH 960426 Correct .gif references; replace gen_intro with > -<! introduction> -<! TJD 180221 Remove dead links> -<! > -<! > -<HEAD> -<TITLE>Newstar Home Page nfra (local version!)</TiTLE> -</HEAD> -<BODY> -<IMG SRC="src/doc/bin/newstar.gif"> - -<H1>Welcome to the upgraded Newstar Documentation Service</H1> - -<H2>Historical reference documentation for Newstar</H1> - -<H2>The Netherlands East West Synthesis Telescope Array Reduction</H2> -<P> - -<A HREF=introduction/introduction.html>Newstar</A> -is the software package to reduce data from the - <A HREF=src/doc/bin/wsrt.gif>WSRT</A>, -the <EM>Westerbork Synthese Radio Telescope</EM>. -<P> -The WSRT is operated by the Netherlands Foundation for Research in -Astronomy (the <A HREF=http://www.astron.nl>NFRA</A>). -<P> - -<P> -This documentation server gives access to: - -<UL> -<LI><A HREF=nnews.txt>The latest news on Newstar</A> (<EM>here at nfra</EM>) -<LI><A HREF=hb_contents/hb_contents.html>The Newstar Documentation Collection</A> -</UL> - -<HR> -<!-- <ADDRESS><A HREF=people/people.html>The Newstar projectgroup</A></ADDRESS> --> -</BODY> diff --git a/src/doc/html/nfra_config_management.html b/src/doc/html/nfra_config_management.html deleted file mode 100644 index 932207e7343ec4dd59b3b3e092931d6eb37e09a9..0000000000000000000000000000000000000000 --- a/src/doc/html/nfra_config_management.html +++ /dev/null @@ -1,652 +0,0 @@ -<TITLE>Newstar configuration management at NFRA</TITLE> - -<BR><STRONG>Subject:</STRONG> Newstar configuration management at NFRA -<BR><STRONG>Author:</STRONG> Marco de Vos (CMV) and Henk Vosmeyer (HjV) -<BR><STRONG>To:</STRONG> Newstar Support Team (HjV, CMV, JEN, JPH) -<P> <STRONG>Date:</STRONG> 08/11/94 -<P> -<EM>Revision history</EM> -<UL> -<LI>22/01/96 - Change appendix 3 -<LI>11/11/94 - Add appendix 3 -<LI>08/11/94 - Typo's and minor changes -<LI>02/11/94 - Separation of NFRA-Master and Export-Master -<LI>04/03/94 - First release -<LI>21/02/94 - Prerelease -</UL> - - -<H1>Newstar configuration management at NFRA</H1> -<PRE></PRE> - - -<H2>General concerns</H2> - -The Newstar package is not a static product. Major and minor changes are -often being made to the software. These changes should affect the use of -the package in a positive sense only. Therefore we need to guard the -integrity of the package at NFRA and define clear procedures for external -users on how to upgrade their implementation. This document describes -those procedures. -<P> -This document is limited to configuration management on the Unix systems. -The VAX system will be no longer supported at NFRA from 15/03/94, and -can be maintained through the perl-scripts provided by WNB. -<P> -Reference to Newstar directories are made through the usual variables -$n_src, $n_root etc. Refer to Appendix 2 for the details. -<P> -All commands assume one is logged in as the Newstar Master (newstar). -<PRE></PRE> - -<H2>What makes up the Newstar configuration at NFRA</H2> - -The Newstar configuration at NFRA consists of the following: -<P> -<UL> - <LI><STRONG>The NFRA-Master system</STRONG> on the /newstar disk (below $n_root): - <OL> - <LI>The Master source tree (below $n_src) - <LI>The NFRA library and executable areas ($n_inc, $n_lib, - $n_exe and $n_tst for the various architectures) - <LI>The NFRA documentation area ($n_hlp) - <LI>The NFRA import area (below $n_import) - </OL> - <P> - Below /newstar/master we also have an installation of: (1) mongo (in - /newstar/master/mongo), of (2) perl (in /newstar/master/perl) and - (3) a copy of the sources for the VAX-based Remote Tape Daemon (in - /newstar/master/rmtd). - <P> - This is a working system, used by NFRA users and programmers. - <P> - <LI><STRONG>The Export-Master system</STRONG> on the /users disk of ftp.astron.nl: - <OL> - <LI>The Export Master source tree (below $n_src) - <LI>The Server version of the documentation (below $n_www) - <UL> - <LI>server homepage $n_www/homepage.html - <LI>documentation relevant to the Export Master source tree - $n_www/hlp/ - <LI>user feedback system $n_www/bug/ - <LI>link to mail area $n_www/mail/ - </UL> - <LI>Some server programs for ftp.astron.nl (below /users/newstar) - <LI>The import area for sites outside NFRA (/users/ftp/newstar/import) - </OL> - <P> - This is a sources-only system which is never compiled. - The Export Master source tree and the documentation are kept - up-to-date from the NFRA Master system. - <P> - <LI><STRONG>The Newstar account</STRONG> on the NFRA Unix system (~newstar) - <OL> - <LI>Startup files for the newstar account (.cshrc and .login etc.). These - files should not contain commands that are essential for the - functioning of newstar apart from PATH settings and - the startup command: -<PRE> -# -# Initialise Newstar (either NFRA-Master or Export-Master) -# -if (-e /newstar/master/src/sys/newstar_nfra.csh) then - source /newstar/master/src/sys/newstar_nfra.csh -else if (-e /users/newstar/bin/newstar_init.csh) then - source /users/newstar/bin/newstar_init.csh -endif -</PRE> - - <LI>Mail environment (~/Mail and ~/.elm). The elm - alias friends_of_newstar is used to inform on updates. The Newstar - environment variable $n_master points to this eMail account. - <LI>Server interface (~/server). This directory is used to pass commands - to the server programs on ftp.astron.nl - </OL> - <P> - This account is the owner of the NFRA-Master and the Export-Master, and - is the only account that can modify them (apart from $n_import and the - locking database). -</UL> -<PRE></PRE> - -<H2>Relations between NFRA-Master and Export-Master</H2> - -The dynamic relations between Master systems (either the NFRA Master or -another one) and Export-Master are as follows: -<PRE> -+----------------------------------------------------------------------+ -| Master: | -| $n_src <--------+ | -| | | nup build -U (in $n_import) | -| | nup build -U | | -| v | | -| $n_exe, ... <--------+ | -| | | -| $n_import -->--------+ | -| | ^ ^^ | -| | | || | -| | | || (NFRA only) | -| | | |+--------------------+--<-- nsh in | -| | | | | | -+----------------------------------------------------------------------+ -| Export-Master: | | | | | -| | | | nup retrieve ... | (NFRA and others) | -| | | | (NFRA only) | | -| nup release | | | | | -| | | nup retrieve | | -| v | | | | -| $n_src | | | -| $n_import <------------------+ | -| | -+----------------------------------------------------------------------+ -</PRE> -Use of the "<TT>nup release</TT>" command is restricted to the NFRA-Master. -Master systems outside NFRA use the "<TT>nup retrieve</TT>" command to get -updated files from the Export-Master. The "<TT>nup update</TT>" command -combines "<TT>nup retrieve</TT>" and "<TT>nup build -U</TT>". -<BR>The NFRA-Master uses the "<TT>nup retrieve -import ...</TT>" to get -files from the Export-Master's $n_import (files checked in by -programmers outside the NFRA). -<PRE></PRE> - -<H2>Definition of revisions and releases</H2> - -Every modification of files in the Master source tree results in a new -<EM>revision</EM>, even if the modification does not involve changes in the -executables. The procedure for merging modifications in the Master source -tree is described in the next section. -<P> -A <EM>release</EM> is defined as a revision which involves one or more of the -following items: -<OL> - <LI>A change of fileformats, so you will have to use the - NVS (New Version) option in some programs - <LI>A change in keyword syntax (so you will have to type different - things or change batch files in some cases) other than an - additional keyword for which the default can be used. - <LI>Addition of a new program, or a major rewrite of an existing one. -</OL> -The issue of a new release has to be decided upon by at least two members -of the Newstar Project Team. -<P> -The updating of revision numbers is taken care of by the update script. -Releases need to be explicitly indicated. The procedure for this is -described in a later section. -<P> -The version number of the current Newstar configuration is given -by the file $n_src/sys/version.idx -<P> -A full description of the current Newstar configuration is given by -the file $n_src/sys/database.idx after the command "<TT>nup check d</TT>" -<P> -A user-oriented decription of the configuration is given in the -file $n_src/doc/nnews.hlp which is shown by the command "<TT>nnews</TT>" -<P> -The version number of the Newstar executables is given by the -command -<BR>"<TT>what $n_exe/*.exe | grep %NST%</TT>" -<P> -<PRE></PRE> - -<H2>Checking-in modified files</H2> - -When programmers (in or outside the NFRA) want to make a change in files -in their Master source tree they have to use the "<TT>nsh in</TT>" command. -This will ask (among other things) for a list of files to be checked in, for -a comment and for the executables to be rebuilt (seprated by blanks). -<P> -When programmers check in their modified files, these files are copied -into their local $n_import directory, together with a groupfile listing -the files and executables. The same files are copied into the $n_import -directory of the Export-Master. If the "<TT>nsh in</TT>" command is issued for -(modified) files in a Master tree (presumably outside the NFRA), these -files are not copied to the local $n_import. They are copied into the -Export-Master. In all cases, a mail message describing the check-in is -sent to $n_master (currently newstar@astron.nl). -<P> -Testing should be completed before check-in! At the NFRA, an executable -and/or ppd-file supplied by a programmer can at request be copied into -$n_tst for testing by a broader user-group. -<PRE></PRE> - - -<H2>Merging modifications into the NFRA-Master source tree</H2> - -When mail concerning a check-in is received, the following actions -should be taken: -<P> - -<EM> 1e. If files originate from outside the NFRA, they should be - received in $n_import of the NFRA-Master (more than one - groupfile can be handled with a single update command):</EM> -<PRE> - >>> nup retrieve -import updxxx.grp -</PRE> -<STRONG>Any file that has to be ftp'd with binary mode has to be retrieved -separately.</STRONG> -<P> -<EM> 2e. Perform some elementary checks: </EM> -<P> -If psc/pin/pef-files are changed, they should be checked against -changes in keywords. If the meaning of existing keywords have been -changed, the revision should be treated as a release (see the previous -section). -<P> -If keywords have been removed from a psc file, it should be checked wether -they have been removed from the programs as well. In such cases, special -care should be taken that executables are being rebuilt synchroneously -with the ppd-files. In general, removal of keywords is discouraged for -revisions. -<P> -NOTE: The synchronisation of exe/ppd files is not optimal in the present - structure for configuration management, but cannot be improved - without structural changes in the coupling of exe and ppd files. -<P> -<EM> 3e. Update libraries and executables for all architectures:</EM> -<PRE> - >>> nup build -Update updxxx.grp (on rzmws0) - >>> nup build -Update updxxx.grp (on rzmws5) -</PRE> - -Any errors reported by the build command should be reported to -and repaired by the programmer. -<P> -<EM> 4e. At successful compilation, merge the files in the source tree:</EM> -<PRE> - >>> nup build -Update -T:none -Merge updxxx.grp (on rzmws0) -</PRE> - -The revision number will be automatically updated in version.idx. -<P> -The subject from the groupfile(s) is copied in the nnews.hlp file, and a -message to be sent to local Friends of Newstar is composed (so enter -useful information). Both files will -be presented in the MicroEmacs editor (change buffers with ^X X command, -exit with Esc Z). -Comments concerning programmers only should be removed from nnews.hlp, or -be prefixed by "System: ". This checking of nnews.hlp is very important -since most users rely on this file for their information on changes. -The message is kept in $n_import/message.RR.rr where RR is the new Release, -rr the new revision of Newstar. -<P> -The message is not yet sent, this is done after the Export-Master has been -updated. -<BR>This is done with the "<TT>nup release</TT>" command, discussed later. -A mail is sent to $n_master to remind you of this revision after three days. -<PRE></PRE> - -<H2>Special procedure in case a groupfile needs to be deleted</H2> - -If a groupfile needs to be removed from the Master, it should be explicitly -deleted using a command like -<BR>"<TT>rm $n_src/xxx/yyy.grp</TT>" followed by a reconstruction of the -database with "<TT>nup check d</TT>". -<P> -At remote sides, the groupfile will be deleted automatically after the -next update. -<PRE></PRE> - - -<H2>Special procedure for new releases</H2> - -If a modification is to be interpreted as a release, the following -special actions need to be taken: -<OL> - <LI>Check out file $n_src/sys/version.idx - <LI>Increase the release number by hand, set the revision number to 1 - <LI>Check in file $n_src/sys/version.idx - <UL> - <LI>The comment should clearly indicate the new release - <LI>When asked for the executables to be rebuilt, answer: @all - </UL> - <LI>Update the resulting groupfile in the master: - <UL> - <LI>Nnews should clearly reflect the new release - <LI>The mail message has to be edited to mention the release explicitly - </UL> - <LI>The file $n_root/updates.html should be edited - to reflect the new release. An example how to do this should be - taken from header of the previous release. It should be decided - wether the old revision history should still be kept in this file. - If not, the revision information should be replaced by the remark -<PRE> - <EM>Revision history not recorded</EM><P> -</PRE> - The description of previous releases should not be removed. - Add a hypertext link to this release at the beginning of the file. -</OL> -<PRE></PRE> - -<H2>Merging changes into the Export-Master</H2> - -After the changes have been active in Dwingeloo, they have to be made -known to the outside world. This is typically done after three days (to -remind you, the above mentioned at-job is scheduled). -<P> -The procedure to update the Export-Master is as follows: -<P> -<PRE> - >>> telnet wsrt00 - >>> setenv n_remote rzmws0.astron.nl newstar /newstar/master/src - >>> nup update -</PRE> -This will try to update the Westerbork installation from the NFRA-master. -Any errors occurring here will almost certainly occur in other installtions -as well, so they need to be repaired before the next step. Should you choose -to make changes directly in the NFRA-Master, issue the following command -<STRONG>at rzmws0</STRONG> before trying to update wsrt00 again: -<PRE> - >>> nup check d -</PRE> -This will make a fresh version of the database. Once installation on wsrt00 -is successfull, give the following command <STRONG>at rzmws0</STRONG>: -<PRE> - >>> nup release -</PRE> -This will rebuild the documentation, create a fresh database, pack -all sources, libraries and executables and send them over to the -Export-Master. It also tells the server program that files are waiting -to be unpacked. Once this has been done, the message will be sent. In -case more than one release has been pending, a fresh message for the -most recent revision will be composed, containing all the subjects -from previous revisions. The message will be sent to the Friends of Newstar. -This relies on an elm alias friends_of_newstar. -<PRE></PRE> - -<H2>Maintenance of server programs for the Export-Master</H2> - -The server programs for the Export-Master are maintained outside the -normal Newstar routine. All sources (programs, scripts and text-files) -have to be in /users/newstar/src/. They have to be compiled or put in -their proper place by executing the "<TT>make</TT>" command in that directory. -A "<TT>make</TT>" should be done after any change in files in /users/newstar/src. -Refer to file /users/newstar/src/Makefile for details about requirements -for server programs. -<PRE></PRE> - -<H2>Maintenance of the locking database</H2> - -The locking database is there mainly for administrative purposes. -It warns users who check out a locked file, but still makes a copy for them. -However, it will prohibit checking in locked files. Since users sometimes -just delete files without unlocking them, the lock-file will get polluted. -Therefore the weekly routine includes cleaning up of this file. -<PRE></PRE> - - -<H2>Weekly routines for the Newstar Master copy at NFRA</H2> - -Backups are made each Thursday afternoon or Friday morning. The procedure -for backups is: -<PRE> - >>> nup check d -</PRE> -This will build a fresh version of file database.idx -The database will be updated for any direct changes in the Master (that is: -without proper checkin through $n_import). -<PRE> - >>> nup save -</PRE> -This will make a backup of the entire master tree (all files below $n_root). -Three DAT tapes are used for the backups (cyclic use of Newstar_A, Newstar_B -and Newstar_C). The save command will run in the background and notify -by mail when it is ready. -<P> -The two most recent backups are stored at the Bank of Dwingeloo. -Backups of the Export-Master are made as part of the Scissor backup -routine. -<P> - -After the backup, the following command should be entered: -<PRE> - >>> rm $n_exe/*.old $n_tst/*.old -</PRE> -This will throw away old versions, which can be restored from the backup -tape if necessary. -<PRE> - >>> nup clear -Confirm -</PRE> -This will remove any obsolete files from the Master copy. See above for -the deletion of obsolete groupfiles. Removing a file from a groupfile will -cause a prompt for deletion here. In such cases, check wether the file -has become really obsolete (e.g. by using a grep on the subroutine name). -If the file has been accidentally removed from a groupfile, check out -the groupfile, re-insert the file, check-in the groupfile and make a -maintenance revision. -<PRE> - >>> nup check l (on rzmws0) - >>> nup check l (on rzmws5) -</PRE> -This will check the current libraries. If faults are reported, the -libraries should be updated through the groupfile produced by the -check command (instructions are given by the command). The name of -the groupfile will be libyymmdd${n_arch}.grp. -<PRE></PRE> - - -<H2>Appendix 1: Terminology</H2> - -<DL> -<DT> Site:<DD> - on or more computers that share a (Network) File System - -<DT> Master-systeem:<DD> - the officially installed Newstar version on a site - -<DT> NFRA-Master:<DD> - the master system at the Unix network of the NFRA, - -<DT> Export-Master:<DD> - the (sources-only) master system at the Unix network - of the NFRA, distribution is done from this master. - -<DT> User-systeem:<DD> - a (partial) version of Newstar that is made by a user/ - programmer based on the Master-system. When starting - an executable, a version in the user-system has priority - over the Master. - -<DT> Binary-tree:<DD> - a directory tree in a Master or User system containing - the executable files needed to run Newstar (NB: you - also need the startup scripts in $n_src/sys). - -<DT> Source-tree:<DD> - a directory tree in a Master or User system containing - only all files needed to install a binary tree - (excluding the operating system and compilers...). - -<DT> Library-tree:<DD> - a directory tree in a Master or User system with libraries - and (for a User system) object files; one directory in the - library tree contains include files and system independent - pre-processed files, all derived from the source tree. - -<DT> Work-directory:<DD> - a directory for temporary files, for listingss and for - files needed for the debugger. -</DL> -<P> -The Master system has two binary trees: -<UL> - <LI>$n_root/exe No debugging information. - <LI>$n_root/tst Can be used for debugging, will usually be empty. -</UL> -<P> -Executable files are looked for in the current directory first, then -in $n_uexe (if it exists) and finally in $n_exe. -<P> -A user may decide to do "<TT>setenv n_uexe $n_tst</TT>" to get access to test versions, -and programmers will set $n_uexe to the binary tree of their user system. -<PRE></PRE> - -<H2>Appendix 2: Directory trees</H2> - -<PRE> -Master (NFRA or elsewhere): ---------------------------- - -$n_root -+-- src = $n_src Source tree - | - +-- lib -+-- inc = $n_inc Precompiled files - | +-- sun = $n_lib Object libraries - | +-- hp - | - +-- exe -+-- sun = $n_exe Executables and ppd-files - | +-- hp - | | - | +-- html = $n_hlp Hypertext help files (elsewhere) - | - +-- hlp = $n_hlp Hypertext help files (at NFRA) - | - +-- tst -+-- sun = $n_tst Test versions - | +-- hp - | - +-- work -+-- sun = $n_work Intermediate files, files - | +-- hp necessary for debugging - | - +-- import = $n_import Import area for uploading of - revisions and programmers files. - -Sites outside NFRA can have other architectures in $n_lib and $n_exe. -At most sites outside NFRA $n_hlp is a subdirectory of $n_root/exe. - -This structure can be split over various filesystems. The tree can than -be realised through symbolic links. Since all system commands use the -environment variables this is not strictly necessary. - -Additional directories at NFRA only: - - | - +-- mongo Installation of mongo - +-- perl Executables for perl - +-- rmtd Sources for rmtd (VAX) - -Possible files in $n_root: backups.txt Log of backups - updates.log Log of update-commands - updates.html Revision history (NFRA only) - -Source tree: - - $n_src -+-- sys Maintenance system - | - +-- doc -+- ... Documents - | - +-- wng Precompiler, files, I/O etc. - +-- dwarf Parameter interface - +-- n* The various programs - | - +-- data Calibrator models - | - +-- batch Standard batch procedures - -Possible files in $n_src: upd*.log Compilation logs - - -User system: ------------- - -~programmer +... $n_uroot -+-- lib -+-- inc = $n_uinc - : | +-- sun = $n_ulib - : | - +-- exe -+-- sun = $n_uexe - | - +-- work = $n_work - | - [ +-- src = $n_usrc ] - : - +... Arbitrary directories with files - modified by the programmer. - - -Logging in as the owner of $n_root (Newstar manager) causes $n_u... -to point to $n_..., $n_work will point to $n_root/work/$n_arch. -If the Newstar manager uses the -NUpdate switch for update, $n_uexe -will be set to $n_tst, else it will be at $n_exe. - -It is confusing that there is no $n_uwork, this departure from the -general practice may be removed in future. - - -Export Master (NFRA only, at ftp.astron.nl): ------------------------------------------- - -/users/ftp/newstar = $n_root Newstar ftp area -/users/www/newstar = $n_www Newstar www area -/users/newstar Newstar server programs - -$n_root -+-- src = $n_src Source tree - | - +-- import = $n_import Import area for uploading of - revisions and programmers files - (also from non-NFRA sites). - -Files in $n_root: - nstar_src.tar.Z Archive with sources - nstar_src_??.tar Archive with additional sources - for various architectures - nstar_hlp.tar.Z Archive with documentation - nstar_exe_??.tar.Z Archive with executables for - various architectures - nstar_lib_??.tar.Z Archive with libraries for - various architectures - nstar_lib_inc.tar.Z Archive with include files - - - -$n_www -+-- hlp Documentation (from nstar_hlp.tar) - | - +-- bug User Feedback System - | - +-- bin = $n_cgi httpd scripts for Newstar - | (sources in /users/newstar/src) - | - +-- mail Link to Newstar mail area for HjV - -Files in $n_www: - homepage.html Homepage for the server area, - different from hlp/homepage.html - index.html Link to homepage.html, you get this - for http://www.astron.nl/newstar/ - example.* Some sample images - updates.html Revision history (from NFRA master) - - -/users/newstar -+-- src Server programs (sources) - +-- bin = $n_bin Server programs (executables) - -</PRE> -<PRE></PRE> - -<H2>Appendix 3: Other programs and procedures related to Newstar</H2> - -<H3>Mails concerning Newstar</H3> - -A copy of all E-mail correspondention between the different members of the -Newstar group should always be send to HjV (hjvosmeijer@astron.nl). He will -extract those documents and put them in his Newstar mail directory -(~hjv/public_html/newstar/mail). A printed version of the documents will be put in -a special binder which will be kept in HjV's room. -<BR>Every working-day at 07.00 AM a script will create an updated HTML -file (<A HREF=http://www.astron.nl/~hjv/newstar/mail.html>mail.html</A>) -which gives everyone the possibility to read the mails and search for -keywords using Mosaic. - - - -<H3>Newstar use</H3> - -On every site where Newstar is installed, the programs will write an -entry (with username, programname, date a.s.o.) in the file -$n_import/newstar.use. During an update of a site, this file is ftp'ed -to NFRA (/users/ftp/pub/incoming) and a new (empty) version is -created on the updating site. -<BR>At NFRA every working-day at 07.00 AM a script will take care for -moving those new files to ~hjv/newstar/use, compressing the files and -merge them with the already existing files per site, create quarterly -and monthly reports. The script will also update an HTML file -(<A HREF=http://www.astron.nl/~hjv/newstar/use.html>use.html</A>) -which which gives everyone the possibility to view those reports -by using Mosaic. - - diff --git a/src/doc/icons/anchor.xbm b/src/doc/icons/anchor.xbm deleted file mode 100755 index e9e72aa1acab717f667e01739ad55bfcc731ad00..0000000000000000000000000000000000000000 --- a/src/doc/icons/anchor.xbm +++ /dev/null @@ -1,6 +0,0 @@ -#define anchor.xbm_width 16 -#define anchor.xbm_height 16 -static char anchor.xbm_bits[] = { - 0x00, 0x00, 0xe0, 0x07, 0xe0, 0x07, 0x80, 0x05, 0x80, 0x05, 0x80, 0x05, - 0x80, 0x03, 0x80, 0x01, 0x9e, 0x79, 0x8e, 0x71, 0x8e, 0x71, 0x8a, 0x51, - 0x90, 0x09, 0xe0, 0x07, 0x80, 0x01, 0x00, 0x00}; diff --git a/src/doc/icons/blank.pbm b/src/doc/icons/blank.pbm deleted file mode 100644 index 3c724639131396f04cf2160158a14bb3ee553068..0000000000000000000000000000000000000000 --- a/src/doc/icons/blank.pbm +++ /dev/null @@ -1,4 +0,0 @@ -P4 -# CREATOR: XV Version 3.00 Rev: 3/30/93 -1 1 - \ No newline at end of file diff --git a/src/doc/icons/blank.xbm b/src/doc/icons/blank.xbm deleted file mode 100755 index 3c724639131396f04cf2160158a14bb3ee553068..0000000000000000000000000000000000000000 --- a/src/doc/icons/blank.xbm +++ /dev/null @@ -1,4 +0,0 @@ -P4 -# CREATOR: XV Version 3.00 Rev: 3/30/93 -1 1 - \ No newline at end of file diff --git a/src/doc/icons/contents.xbm b/src/doc/icons/contents.xbm deleted file mode 100755 index a3aed9f8625c67129952f83a07497875fd2ab1f5..0000000000000000000000000000000000000000 --- a/src/doc/icons/contents.xbm +++ /dev/null @@ -1,12 +0,0 @@ -#define contents_width 63 -#define contents_height 16 -static char contents_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,0xc0,0x01,0x00,0x08,0x00,0x00,0x01,0x00,0x20,0x02,0x00,0x08,0x00, - 0x00,0x01,0x00,0x20,0xe2,0x74,0x7c,0x9c,0x8e,0x8f,0x03,0x20,0x10,0x99,0x08, - 0x22,0x13,0x41,0x04,0x20,0x10,0x89,0x08,0x3e,0x11,0x81,0x03,0x20,0x12,0x89, - 0x08,0x02,0x11,0x01,0x04,0x20,0x12,0x89,0x88,0x22,0x11,0x51,0x04,0xc0,0xe1, - 0x9c,0x71,0x9c,0x33,0x8e,0x03,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}; diff --git a/src/doc/icons/contents_motif.gif b/src/doc/icons/contents_motif.gif deleted file mode 100644 index ddb24ce671d219174f0e1e0d3c366ff23371d5b8..0000000000000000000000000000000000000000 Binary files a/src/doc/icons/contents_motif.gif and /dev/null differ diff --git a/src/doc/icons/cross-ref.xbm b/src/doc/icons/cross-ref.xbm deleted file mode 100755 index c2ff90eaa3ea1478676a68139f884040f5d0cdb9..0000000000000000000000000000000000000000 --- a/src/doc/icons/cross-ref.xbm +++ /dev/null @@ -1,6 +0,0 @@ -#define cross-ref.xbm_width 16 -#define cross-ref.xbm_height 16 -static char cross-ref.xbm_bits[] = { - 0x00, 0x01, 0x80, 0x01, 0xc0, 0x01, 0xe0, 0x01, 0xf0, 0x01, 0xf8, 0x61, - 0xfc, 0x71, 0xfe, 0x79, 0xff, 0x7f, 0x00, 0x7f, 0x00, 0x7f, 0x80, 0x7f, - 0xc0, 0x7f, 0xe0, 0x7f, 0xe0, 0x7f, 0x00, 0x00}; diff --git a/src/doc/icons/cross_ref_motif.gif b/src/doc/icons/cross_ref_motif.gif deleted file mode 100644 index 1cb5a9b47a64d878d53385636238e12ae0139e65..0000000000000000000000000000000000000000 Binary files a/src/doc/icons/cross_ref_motif.gif and /dev/null differ diff --git a/src/doc/icons/foot.xbm b/src/doc/icons/foot.xbm deleted file mode 100755 index 19952073e20bd30f0d142048523cddfc135f51ea..0000000000000000000000000000000000000000 --- a/src/doc/icons/foot.xbm +++ /dev/null @@ -1,6 +0,0 @@ -#define foot.xbm_width 16 -#define foot.xbm_height 16 -static char foot.xbm_bits[] = { - 0x00, 0x00, 0xc0, 0x01, 0xc0, 0x01, 0xc0, 0x01, 0x80, 0x00, 0x98, 0x0c, - 0xf8, 0x0f, 0x98, 0x0c, 0x80, 0x00, 0x80, 0x00, 0x80, 0x00, 0x80, 0x00, - 0x80, 0x00, 0x80, 0x00, 0x80, 0x00, 0x00, 0x00}; diff --git a/src/doc/icons/foot_motif.gif b/src/doc/icons/foot_motif.gif deleted file mode 100644 index b801393f38c66bcd32af988e8d44de0f605c3a99..0000000000000000000000000000000000000000 Binary files a/src/doc/icons/foot_motif.gif and /dev/null differ diff --git a/src/doc/icons/icons.fig b/src/doc/icons/icons.fig deleted file mode 100755 index 793299bdbdfca3b39979f9a1a061b0232a6dd39a..0000000000000000000000000000000000000000 --- a/src/doc/icons/icons.fig +++ /dev/null @@ -1,43 +0,0 @@ -#FIG 2.1 -80 2 -6 314 214 364 249 -2 1 0 3 1 0 0 0 0.000 -1 0 0 - 319 244 359 244 359 219 9999 9999 -2 1 0 3 4 0 0 0 0.000 -1 0 0 - 319 244 319 219 359 219 9999 9999 --6 -2 1 0 3 1 0 0 0 0.000 -1 0 0 - 54 149 119 149 119 124 9999 9999 -2 1 0 3 4 0 0 0 0.000 -1 0 0 - 54 149 54 124 119 124 9999 9999 -2 1 0 3 1 0 0 0 0.000 -1 0 0 - 54 209 84 209 84 184 9999 9999 -2 1 0 3 4 0 0 0 0.000 -1 0 0 - 54 209 54 184 84 184 9999 9999 -2 1 0 3 1 0 0 0 0.000 -1 0 0 - 54 269 124 269 124 244 9999 9999 -2 1 0 3 4 0 0 0 0.000 -1 0 0 - 54 269 54 244 124 244 9999 9999 -2 1 0 3 1 0 0 0 0.000 -1 0 0 - 54 329 99 329 99 304 9999 9999 -2 1 0 3 4 0 0 0 0.000 -1 0 0 - 54 329 54 304 99 304 9999 9999 -2 1 0 3 1 0 0 0 0.000 -1 0 0 - 54 389 139 389 139 364 9999 9999 -2 1 0 3 4 0 0 0 0.000 -1 0 0 - 54 389 54 364 139 364 9999 9999 -2 1 0 3 1 0 0 0 0.000 -1 0 0 - 54 449 164 449 164 424 9999 9999 -2 1 0 3 4 0 0 0 0.000 -1 0 0 - 54 449 54 424 164 424 9999 9999 -2 1 0 3 4 0 0 0 0.000 -1 0 0 - 54 89 54 64 94 64 9999 9999 -2 1 0 3 1 0 0 0 0.000 -1 0 0 - 54 89 94 89 94 64 9999 9999 -4 0 16 14 0 0 0 0.00000 4 11 57 59 139 Previous -4 0 16 14 0 0 0 0.00000 4 14 18 59 199 Up -4 0 16 14 0 0 0 0.00000 4 11 58 59 259 Contents -4 0 16 14 0 0 0 0.00000 4 11 36 59 319 Index -4 0 16 14 0 0 0 0.00000 4 14 73 59 379 Next Group -4 0 16 14 0 0 0 0.00000 4 14 101 59 439 Previous Group -4 0 16 14 0 0 0 0.00000 4 11 29 59 79 Next diff --git a/src/doc/icons/icons.html b/src/doc/icons/icons.html deleted file mode 100644 index 3a45761ac46ac474c723bb6e964c4b9fc441f22b..0000000000000000000000000000000000000000 --- a/src/doc/icons/icons.html +++ /dev/null @@ -1,20 +0,0 @@ - -<FORM METHOD="POST" > -<INPUT TYPE="submit" VALUE="Next"> - <P> -<INPUT TYPE="submit" VALUE="Previous"> - <P> -<INPUT TYPE="submit" VALUE="Up"> - <P> -<INPUT TYPE="submit" VALUE="Next Group"> - <P> -<INPUT TYPE="submit" VALUE="Previous Group"> - <P> -<INPUT TYPE="submit" VALUE="Contents"> - <P> -<INPUT TYPE="submit" VALUE="Index"> - <P> - - - -</FORM> diff --git a/src/doc/icons/index.xbm b/src/doc/icons/index.xbm deleted file mode 100755 index 4c8c10616fb3242e52863a04453eeeaa67d43353..0000000000000000000000000000000000000000 --- a/src/doc/icons/index.xbm +++ /dev/null @@ -1,10 +0,0 @@ -#define index_width 41 -#define index_height 16 -static char index_bits[] = { - 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, - 0x00,0x00,0x00,0x00,0x00,0x60,0x00,0x00,0x00,0xf0,0x01,0x40,0x00,0x00,0x00, - 0x40,0x00,0x40,0x00,0x00,0x00,0x40,0x74,0x78,0x9c,0x3b,0x00,0x40,0x98,0x44, - 0x22,0x0a,0x00,0x40,0x88,0x44,0x3e,0x04,0x00,0x40,0x88,0x44,0x02,0x0a,0x00, - 0x40,0x88,0x44,0x22,0x11,0x00,0xf0,0x9d,0xb9,0x9c,0x31,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}; diff --git a/src/doc/icons/index_motif.gif b/src/doc/icons/index_motif.gif deleted file mode 100644 index cab027c0212a65601c3ea6bfa6690c823b661698..0000000000000000000000000000000000000000 Binary files a/src/doc/icons/index_motif.gif and /dev/null differ diff --git a/src/doc/icons/invis_anchor.xbm b/src/doc/icons/invis_anchor.xbm deleted file mode 100755 index cc208a31ff7090c51c647e04d889f7d0eb4490b5..0000000000000000000000000000000000000000 --- a/src/doc/icons/invis_anchor.xbm +++ /dev/null @@ -1,4 +0,0 @@ -#define dot_anchor_width 1 -#define dot_anchor_height 1 -static char dot_anchor_bits[] = { - 0xfe}; diff --git a/src/doc/icons/latex2html.xbm b/src/doc/icons/latex2html.xbm deleted file mode 100755 index d9879963bcf75d353bfd0ef590891ced6ab7d885..0000000000000000000000000000000000000000 --- a/src/doc/icons/latex2html.xbm +++ /dev/null @@ -1,16 +0,0 @@ -#define noname_width 84 -#define noname_height 17 -static char noname_bits[] = { - 0x00,0x00,0x00,0x00,0x20,0xc0,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, - 0xe0,0xc0,0x01,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xe0,0xc0,0x01,0x00, - 0x00,0x00,0x00,0x1f,0xfc,0x07,0xfc,0xe7,0xc1,0x07,0x00,0x00,0x00,0x00,0x8c, - 0xcd,0x04,0x38,0xe3,0xc3,0x0f,0x00,0x00,0x00,0x00,0x8c,0xc5,0x0c,0x70,0xe1, - 0xc7,0x1f,0x00,0x00,0x00,0x00,0xcc,0xc5,0x08,0xe0,0xe1,0xff,0x3f,0x00,0x00, - 0x00,0x00,0x4c,0xc3,0xfc,0xe3,0xe0,0xff,0x3f,0x00,0x00,0x00,0x00,0xcc,0xc3, - 0x30,0xc3,0xe0,0xff,0xbf,0xbb,0xff,0xfd,0x01,0xac,0xc2,0x30,0xe6,0xe1,0xc7, - 0x9f,0xbf,0xff,0xfd,0x01,0xfc,0xcf,0xb0,0xa4,0xe3,0xc3,0x0f,0x9b,0xb5,0xcd, - 0x00,0xcc,0xc0,0xb0,0x10,0xe3,0xc1,0x07,0x1b,0x84,0xcf,0x00,0xff,0xf0,0xf3, - 0xbc,0xef,0xc0,0x01,0x1f,0x84,0xcf,0x00,0x00,0x00,0xb0,0x04,0xe0,0xc0,0x01, - 0x1b,0x84,0xcf,0x00,0x00,0x00,0x30,0x04,0x20,0xc0,0x00,0x1b,0x84,0xca,0x0c, - 0x00,0x00,0x30,0x06,0x00,0x00,0x00,0x1b,0x84,0xc8,0x0c,0x00,0x00,0xfc,0x03, - 0x00,0x00,0x80,0x3f,0xdf,0xfd,0x0f}; diff --git a/src/doc/icons/next.xbm b/src/doc/icons/next.xbm deleted file mode 100755 index 3e99395169322792e3565a62f4ca53e6810dc666..0000000000000000000000000000000000000000 --- a/src/doc/icons/next.xbm +++ /dev/null @@ -1,6 +0,0 @@ -#define next.xbm_width 16 -#define next.xbm_height 16 -static char next.xbm_bits[] = { - 0x00, 0x00, 0x00, 0x00, 0x02, 0x03, 0x06, 0x07, 0x0e, 0x0f, 0x1e, 0x1f, - 0x3e, 0x3f, 0xfe, 0x7f, 0xfe, 0x7f, 0x3e, 0x3f, 0x1e, 0x1f, 0x0e, 0x0f, - 0x06, 0x07, 0x02, 0x03, 0x00, 0x00, 0x00, 0x00}; diff --git a/src/doc/icons/next_group_motif.gif b/src/doc/icons/next_group_motif.gif deleted file mode 100644 index 96d4e5ddfdfbe5cba5c008485fd7daa0189a1ef2..0000000000000000000000000000000000000000 Binary files a/src/doc/icons/next_group_motif.gif and /dev/null differ diff --git a/src/doc/icons/next_group_motif_gr.gif b/src/doc/icons/next_group_motif_gr.gif deleted file mode 100644 index fabf730466e8be49e7b9a1cc33d93856016de06b..0000000000000000000000000000000000000000 Binary files a/src/doc/icons/next_group_motif_gr.gif and /dev/null differ diff --git a/src/doc/icons/next_motif.gif b/src/doc/icons/next_motif.gif deleted file mode 100644 index 9c81e8c92fed7fe851ce02e7854dc26a58eae9b2..0000000000000000000000000000000000000000 Binary files a/src/doc/icons/next_motif.gif and /dev/null differ diff --git a/src/doc/icons/next_motif_gr.gif b/src/doc/icons/next_motif_gr.gif deleted file mode 100644 index 985c857a3e0f66f3bfd06820ef908e76cbfe0ed0..0000000000000000000000000000000000000000 Binary files a/src/doc/icons/next_motif_gr.gif and /dev/null differ diff --git a/src/doc/icons/next_page.xbm b/src/doc/icons/next_page.xbm deleted file mode 100755 index a9b5f23afaf3540a3e7c700d585eade3d5bb95c5..0000000000000000000000000000000000000000 --- a/src/doc/icons/next_page.xbm +++ /dev/null @@ -1,13 +0,0 @@ -#define next_page_width 68 -#define next_page_height 16 -static char next_page_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,0x98,0x03,0x00, - 0x04,0xc0,0x07,0x00,0x00,0x00,0x30,0x01,0x00,0x04,0x80,0x0c,0x00,0x00,0x00, - 0x30,0x71,0xee,0x3e,0x80,0xc8,0xc3,0xe5,0x00,0x50,0x89,0x28,0x04,0x80,0x0c, - 0x24,0x12,0x01,0x50,0xf9,0x10,0x04,0x80,0x87,0x27,0xf2,0x01,0x90,0x09,0x28, - 0x04,0x80,0x40,0x24,0x12,0x00,0x90,0x89,0x44,0x44,0x80,0x40,0x24,0x12,0x01, - 0x38,0x71,0xc6,0x38,0xc0,0x83,0xcb,0xe3,0x00,0x00,0x00,0x00,0x00,0x00,0x00, - 0x00,0x02,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x02,0x00,0x00,0x00,0x00, - 0x00,0x00,0x00,0xc0,0x01,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, - 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00}; diff --git a/src/doc/icons/previous.xbm b/src/doc/icons/previous.xbm deleted file mode 100755 index 2c209a2beabc301ef32b1377f076148f6d76493d..0000000000000000000000000000000000000000 --- a/src/doc/icons/previous.xbm +++ /dev/null @@ -1,6 +0,0 @@ -#define previous.xbm_width 16 -#define previous.xbm_height 16 -static char previous.xbm_bits[] = { - 0x00, 0x00, 0x00, 0x00, 0xc0, 0x40, 0xe0, 0x60, 0xf0, 0x70, 0xf8, 0x78, - 0xfc, 0x7c, 0xfe, 0x7f, 0xfe, 0x7f, 0xfc, 0x7c, 0xf8, 0x78, 0xf0, 0x70, - 0xe0, 0x60, 0xc0, 0x40, 0x00, 0x00, 0x00, 0x00}; diff --git a/src/doc/icons/previous_group_motif.gif b/src/doc/icons/previous_group_motif.gif deleted file mode 100644 index ff93c5920e154e07872c5ca79af1efc137f4f3f3..0000000000000000000000000000000000000000 Binary files a/src/doc/icons/previous_group_motif.gif and /dev/null differ diff --git a/src/doc/icons/previous_group_motif_gr.gif b/src/doc/icons/previous_group_motif_gr.gif deleted file mode 100644 index 9ea0ce3ca756f390fad324d9b7b837c4dea6f56e..0000000000000000000000000000000000000000 Binary files a/src/doc/icons/previous_group_motif_gr.gif and /dev/null differ diff --git a/src/doc/icons/previous_motif.gif b/src/doc/icons/previous_motif.gif deleted file mode 100644 index d43c0320e665dccf4f429d8b9d3448cceee82333..0000000000000000000000000000000000000000 Binary files a/src/doc/icons/previous_motif.gif and /dev/null differ diff --git a/src/doc/icons/previous_motif_gr.gif b/src/doc/icons/previous_motif_gr.gif deleted file mode 100644 index 8d40fd5e0221c056806d5d8467e0e56262cf3bf6..0000000000000000000000000000000000000000 Binary files a/src/doc/icons/previous_motif_gr.gif and /dev/null differ diff --git a/src/doc/icons/previous_page.xbm b/src/doc/icons/previous_page.xbm deleted file mode 100755 index f3ac286bfaab0624357a8f32144a3a0ddee75738..0000000000000000000000000000000000000000 --- a/src/doc/icons/previous_page.xbm +++ /dev/null @@ -1,17 +0,0 @@ -#define previous_page_width 98 -#define previous_page_height 16 -static char previous_page_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, - 0x08,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xf0,0x01,0x00,0x00,0x00,0x00, - 0x00,0x00,0xf8,0x00,0x00,0x00,0x00,0x20,0x03,0x00,0x00,0x00,0x00,0x00,0x00, - 0x90,0x01,0x00,0x00,0x00,0x20,0xd2,0x71,0xee,0x0e,0xce,0x8c,0x03,0x10,0x79, - 0xb8,0x1c,0x00,0x20,0x23,0x88,0x44,0x08,0x91,0x48,0x04,0x90,0x81,0x44,0x22, - 0x00,0xe0,0x21,0xf8,0x44,0x08,0x91,0x88,0x03,0xf0,0xf0,0x44,0x3e,0x00,0x20, - 0x20,0x08,0x28,0x08,0x91,0x08,0x04,0x10,0x88,0x44,0x02,0x00,0x20,0x20,0x88, - 0x38,0x08,0x91,0x48,0x04,0x10,0x88,0x44,0x22,0x00,0xf0,0xf0,0x70,0x10,0x3e, - 0x0e,0x97,0x03,0x78,0x70,0x79,0x1c,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, - 0x00,0x00,0x00,0x40,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, - 0x00,0x40,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x38, - 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}; diff --git a/src/doc/icons/up.xbm b/src/doc/icons/up.xbm deleted file mode 100755 index 8cb4e256a97922a482d1158740d736359dd932e4..0000000000000000000000000000000000000000 --- a/src/doc/icons/up.xbm +++ /dev/null @@ -1,6 +0,0 @@ -#define up.xbm_width 16 -#define up.xbm_height 16 -static char up.xbm_bits[] = { - 0x00, 0x00, 0x80, 0x01, 0xc0, 0x03, 0xe0, 0x07, 0xf0, 0x0f, 0xf8, 0x1f, - 0xfc, 0x3f, 0xfc, 0x3f, 0x80, 0x01, 0x80, 0x01, 0xc0, 0x03, 0xe0, 0x07, - 0xf0, 0x0f, 0xf8, 0x1f, 0xfc, 0x3f, 0x00, 0x00}; diff --git a/src/doc/icons/up_motif.gif b/src/doc/icons/up_motif.gif deleted file mode 100644 index 316d0d2a14b571bea2eb874efd04bfe509f53b34..0000000000000000000000000000000000000000 Binary files a/src/doc/icons/up_motif.gif and /dev/null differ diff --git a/src/doc/icons/up_motif_gr.gif b/src/doc/icons/up_motif_gr.gif deleted file mode 100644 index ef0fb5923faaae8fb2238860664d3d9eb28be26f..0000000000000000000000000000000000000000 Binary files a/src/doc/icons/up_motif_gr.gif and /dev/null differ diff --git a/src/doc/intfc/dwarf_private_intfc.tex b/src/doc/intfc/dwarf_private_intfc.tex deleted file mode 100644 index 367ee8c67e93984d16026aab83d423372fc64a60..0000000000000000000000000000000000000000 --- a/src/doc/intfc/dwarf_private_intfc.tex +++ /dev/null @@ -1,14 +0,0 @@ -% dwarf_private_intfc.tex - - -\chapter{ The generic control parameters of the NEWSTAR user interface} - -\tableofcontents - - -\section{ Descriptions of the individual parameters} -\label{.descriptions} - -\subsection{ References to public interfaces} -\label{.public} - diff --git a/src/doc/intfc/dwarf_private_intfc_tmp.0 b/src/doc/intfc/dwarf_private_intfc_tmp.0 deleted file mode 100644 index e244a1918596518669303d2f39e378743279842f..0000000000000000000000000000000000000000 --- a/src/doc/intfc/dwarf_private_intfc_tmp.0 +++ /dev/null @@ -1,15 +0,0 @@ -% - - -\chapter{ The generic control parameters of the NEWSTAR user interface} - -\tableofcontents - - -\section{ Descriptions of the individual parameters} -\label{.descriptions} - -\subsection{ References to public interfaces} -\label{.public} - - diff --git a/src/doc/intfc/dwarf_private_intfc_tmp.text b/src/doc/intfc/dwarf_private_intfc_tmp.text deleted file mode 100644 index e244a1918596518669303d2f39e378743279842f..0000000000000000000000000000000000000000 --- a/src/doc/intfc/dwarf_private_intfc_tmp.text +++ /dev/null @@ -1,15 +0,0 @@ -% - - -\chapter{ The generic control parameters of the NEWSTAR user interface} - -\tableofcontents - - -\section{ Descriptions of the individual parameters} -\label{.descriptions} - -\subsection{ References to public interfaces} -\label{.public} - - diff --git a/src/doc/intfc/dwarf_private_keys.tef b/src/doc/intfc/dwarf_private_keys.tef deleted file mode 100644 index 47db8889774000cf58a1cf0f927eb17d46164058..0000000000000000000000000000000000000000 --- a/src/doc/intfc/dwarf_private_keys.tef +++ /dev/null @@ -1,278 +0,0 @@ - -%\section{ References to public interfaces} -%\label{.public} - -% \input dwarf.tmp.ref.1 -{\em See also:} -\begin{itemize} -\item \textref{DWARF}{introduction.user.interface} user interface -\end{itemize} - - - -\subsection{ Parameter ASK} -\label{.ask} - -\spbegin -{\em Expected input:} Character *4: 1 value -\spend -\spbegin -\svbegin\begin{verbatim} -\spend -\spbegin -\svbegin\begin{verbatim} -ASK=YES directs DWARF programs to always prompt for parameters, even if -an external default has been defined (through SPECIFY or otherwise). - This setting can be overridden by use of the /NOASK qualifier with the -EXECUTE command or with run-time parameter input. -\end{verbatim}\svend -\spend - - -\subsection{ Parameter BELL} -\label{.bell} - -\spbegin -{\em Prompt:} Terminal bell with prompts and error messages\\ -{\em Expected input:} Character *4: 1 value -\spend -\spbegin -\svbegin\begin{verbatim} -\spend -\spbegin -\svbegin\begin{verbatim} -Controls the sounding of the terminal bell with error messages and -with prompts for parameters -\end{verbatim}\svend -\spend - - -\subsection{ Parameter CURNODE} -\label{.curnode} - -\spbegin -{\em Prompt:} Current node name\\ -{\em Expected input:} Character *80: 1 value -\spend -\spbegin -\svbegin\begin{verbatim} -\spend -\spbegin -\svbegin\begin{verbatim} -This is the node name with respect to which relative node names, i.e. -node specifications starting with "." or "-", will be expanded -\end{verbatim}\svend -\spend - - -\subsection{ Parameter EXTENDSIZE} -\label{.extendsize} - -\spbegin -{\em Prompt:} Default extension size in blocks for DWARF data files\\ -{\em Expected input:} Integer: 1 value -\spend -\spbegin -\svbegin\begin{verbatim} -\spend -\spbegin -\svbegin\begin{verbatim} -Defines the minimum extension size to be applied by DWARF I/O routines. -An actual extension will be the maximum of this parameter and the extension -requested by the program. -\end{verbatim}\svend -\spend - - -\subsection{ Parameter IBMODE} -\label{.ibmode} - -\spbegin -{\em Expected input:} Character *11: 1 value -\spend -\spbegin -\svbegin\begin{verbatim} -\spend -\spbegin -\svbegin\begin{verbatim} -This is the batch/interactive flag maintained by DWARF, It can not be -changed by the user. -\end{verbatim}\svend -\spend - - -\subsection{ Parameter IDENT} -\label{.ident} - -\spbegin -{\em Expected input:} Character *3: 1 value -\spend -\spbegin -\svbegin\begin{verbatim} -\spend -\spbegin -\svbegin\begin{verbatim} -This is the process identification used by DWARF. It can not be -changed by the user. -\end{verbatim}\svend -\spend - - -\subsection{ Parameter IOBUFSIZE} -\label{.iobufsize} - -\spbegin -{\em Prompt:} Default I/O buffer size in bytes\\ -{\em Expected input:} Integer: 1 value -\spend -\spbegin -\svbegin\begin{verbatim} -\spend -\spbegin -\svbegin\begin{verbatim} -This is the default size of I/O buffers to be allocated by the DWARF -bulk I/O routines. This parameter is intended primarily for adapting DWARF to -host systems with limited physical memory. -\end{verbatim}\svend -\spend - - -\subsection{ Parameter LOGFATAL} -\label{.logfatal} - -\spbegin -{\em Prompt:} Do you want unsuccessful program runs logged\\ -{\em Expected input:} Character *4: 1 value -\spend -\spbegin -\svbegin\begin{verbatim} -\spend -\spbegin -\svbegin\begin{verbatim} -This parameter controls the logging of program runs that terminate -with a failure status. If LOGFATAL=NO, only successfull runs will be logged. -\end{verbatim}\svend -\spend - - -\subsection{ Parameter LOGLEVEL} -\label{.loglevel} - -\spbegin -{\em Prompt:} Severity threshold for logging messages\\ -{\em Expected input:} Integer: 1 value -\spend -\spbegin -\svbegin\begin{verbatim} -\spend -\spbegin -\svbegin\begin{verbatim} -This parameter defines the level below which messages will not be -logged. If LOGLEVEL=0, all messages are logged; if it is 8 you get no log at -all. - LOGLEVEL=4 will give you all informational messages from DWARF programs -plus fatal error messages. -\end{verbatim}\svend -\spend - - -\subsection{ Parameter MESSAGEDEVICE} -\label{.messagedevice} - -\spbegin -{\em Prompt:} Device(s) for messages\\ -{\em Expected input:} Character *8: 1 to 2 values -\spend -\spbegin -\svbegin\begin{verbatim} -\spend -\spbegin -\svbegin\begin{verbatim} -Defines where messages will be shown: On the terminal and/or in a file -to be spooled automatically to the line printer -\end{verbatim}\svend -\spend - - -\subsection{ Parameter SAVELAST} -\label{.savelast} - -\spbegin -{\em Expected input:} Character *4: 1 value -\spend -\spbegin -\svbegin\begin{verbatim} -\spend -\spbegin -\svbegin\begin{verbatim} -SAVELAST=YES directs DWARF programs to save the last value typed in -during program execution as an external default for later program runs. - The setting of this paramater can be overriden by use of the -/[NO]SAVELAST qualifier with the EXECUTE command or with parameter input. -\end{verbatim}\svend -\spend - - -\subsection{ Parameter STREAM} -\label{.stream} - -\spbegin -{\em Prompt:} Stream name\\ -{\em Expected input:} Character *11: 1 value -\spend -\spbegin -\svbegin\begin{verbatim} -\spend -\spbegin -\svbegin\begin{verbatim} -Defines the "current stream name" to be used as default for the -stream component in program and DWARF symbol names -\end{verbatim}\svend -\spend - - -\subsection{ Parameter TEST} -\label{.test} - -\spbegin -{\em Prompt:} Set DWARF test mode\\ -{\em Expected input:} Character *4: 1 value -\spend -\spbegin -\svbegin\begin{verbatim} -\spend -\spbegin -\svbegin\begin{verbatim} -In testing mode: - Parameters with the TEST attribute will be prompted for. - The debugger will be automatically invoked at the instant an -error is reported. (Note that this may already happen during the execution -of the remainder of the SPECIFY DWARF command. In that case, just type "GO" in -reply to debugger prompts, and "EXIT" when the debugger reports program -completion.) -\end{verbatim}\svend -\spend - - -\subsection{ Parameter USERLEVEL} -\label{.userlevel} - -\spbegin -{\em Prompt:} How do you rate yourself as a DWARF user\\ -{\em Expected input:} Character *8: 1 value -\spend -\spbegin -\svbegin\begin{verbatim} -\spend -\spbegin -\svbegin\begin{verbatim} -Defines the amount of information to be given with parameter prompts: - EXPERT: Keyword name and default only - AVERAGE: Same plus available options where applicable - BEGINNER: Some descriptive information in addition - While being prompted, you may temporarily descend to a "lower" level -by typing a question mark; by adding /KEEP to the "?" you may retain this lower -level until program exit. -\end{verbatim}\svend -\spend - diff --git a/src/doc/intfc/flfnode_public_intfc.tex b/src/doc/intfc/flfnode_public_intfc.tex deleted file mode 100644 index bd72aadbd65236e4f3aa248515860c2a0d2b59a7..0000000000000000000000000000000000000000 --- a/src/doc/intfc/flfnode_public_intfc.tex +++ /dev/null @@ -1,39 +0,0 @@ -% flfnode_public_intfc.tex - -\chapter{ Public parameter group FLFNODE} -\tableofcontents - - -\section{ Overview} - - This document contains an overview of the public parameter group -FLFNODE, (part of) which is included in several \NEWSTAR programs. - -% \Figref{.flfnode.interface} and its companion \figref{.flfnode.extract} -%show %schematically the various branches of program execution and the -%parameters that %the user must provide to control each of them. - -%\input {../fig/flfnode_interface.cap} - - The -%remainder of the -document describes the individual parameters in alphabetical order. This -description centers on the Help texts, which have been designed to guide the -user to the proper choice at each junction, even if his knowledge of the -overall workings of the program is only superficial. - - Please note that the generic prompt and help texts defined for these -parameters are frequently superseded in the actual applications by alternative -texts that are more appropriate to the situation at hand. Unfortunately, the -present architecture of \NEWSTAR precludes the inclusion of such texts in the -documentation system, so the only opportunity to read that information is -during program execution (in your terminal window!). - - -\section{ Descriptions of the individual parameters} -\label{.descriptions} - -\subsection{ References to public interfaces} -\label{.public} - -%\input {flfnode_public_keys.tef} diff --git a/src/doc/intfc/flfnode_public_keys.tef b/src/doc/intfc/flfnode_public_keys.tef deleted file mode 100644 index 8b137891791fe96927ad78e64b0aad7bded08bdc..0000000000000000000000000000000000000000 --- a/src/doc/intfc/flfnode_public_keys.tef +++ /dev/null @@ -1 +0,0 @@ - diff --git a/src/doc/intfc/global_private_intfc.tex b/src/doc/intfc/global_private_intfc.tex deleted file mode 100644 index ed3a5938facfcecd730aa8daaad483f9b1d75dc5..0000000000000000000000000000000000000000 --- a/src/doc/intfc/global_private_intfc.tex +++ /dev/null @@ -1,14 +0,0 @@ -% global_private_intfc.tex - - -\chapter{ The global control parameters of the NEWSTAR user interface} - -\tableofcontents - - -\section{ Descriptions of the individual parameters} -\label{.descriptions} - -\subsection{ References to public interfaces} -\label{.public} - diff --git a/src/doc/intfc/global_private_keys.tef b/src/doc/intfc/global_private_keys.tef deleted file mode 100644 index b246d42b0923136403dabaef092c6392111ff600..0000000000000000000000000000000000000000 --- a/src/doc/intfc/global_private_keys.tef +++ /dev/null @@ -1,103 +0,0 @@ - -%\section{ References to public interfaces} -%\label{.public} - -% \input global.tmp.ref.1 -{\em See also:} -\begin{itemize} -\item \textref{DWARF}{introduction.user.interface} user interface -\end{itemize} - - - -\subsection{ Parameter CHANNEL} -\label{.channel} - -\spbegin -{\em Prompt:} $<$DeAnza Imagechannel Nr$>$\\ -{\em Expected input:} Integer: 1 value -\spend -\spbegin -\svbegin\begin{verbatim} -\spend -\spbegin -\svbegin\begin{verbatim} -Defines the image-channel on the DeAnza image-processor - Channel 0 is used as overlay-channel and should (unless necessary) - not be used -\end{verbatim}\svend -\spend - - -\subsection{ Parameter DATABASE} -\label{.database} - -\spbegin -{\em Prompt:} DATA BASE NAME$>$\\ -{\em Expected input:} Character *80: 1 value -\spend -\spbegin -\svbegin\begin{verbatim} -\spend -\spbegin -\svbegin\begin{verbatim} -Defines the name of the delault database, which all programs will use unless - prompting is forced through the /ASK qualifier -\end{verbatim}\svend -\spend - - -\subsection{ Parameter IPUNIT} -\label{.ipunit} - -\spbegin -{\em Prompt:} $<$DeAnza-Unitnr$>$\\ -{\em Expected input:} Integer: 1 value -\spend -\spbegin -\svbegin\begin{verbatim} -\spend -\spbegin -\svbegin\begin{verbatim} -Defines the unitnr of the DeAnza image-processor - 0 is the DeAnza in the image-room -\end{verbatim}\svend -\spend - - -\subsection{ Parameter LUTNR} -\label{.lutnr} - -\spbegin -{\em Prompt:} $<$Colour Lookup-Table Nr$>$\\ -{\em Expected input:} Integer: 1 value -\spend -\spbegin -\svbegin\begin{verbatim} -\spend -\spbegin -\svbegin\begin{verbatim} -Defines the nr of the colour lookup-table, which drives the colours -on the screen. - 0 should normally be used -\end{verbatim}\svend -\spend - - -\subsection{ Parameter TAPEUNIT} -\label{.tapeunit} - -\spbegin -{\em Expected input:} Character *4: 1 value -\spend -\spbegin -\svbegin\begin{verbatim} -\spend -\spbegin -\svbegin\begin{verbatim} -Defines the tapeunit that have to be used - MTA0 is the fast selfloading tapeunit - MTB0 is the slower tapeunit (the left one) -\end{verbatim}\svend -\spend - diff --git a/src/doc/intfc/mdlnode_public_intfc.tex b/src/doc/intfc/mdlnode_public_intfc.tex deleted file mode 100644 index 1cba9333f6cfb422ac43ead1dfecd33578afc3be..0000000000000000000000000000000000000000 --- a/src/doc/intfc/mdlnode_public_intfc.tex +++ /dev/null @@ -1,39 +0,0 @@ -% mdlnode_public_intfc.tex - -\chapter{ Public parameter group MDLNODE} -\tableofcontents - - -\section{ Overview} - - This document contains an overview of the public parameter group -MDLNODE, (part of) which is included in several \NEWSTAR programs. - -% \Figref{.mdlnode.interface} and its companion \figref{.mdlnode.extract} -%show schematically the various branches of program execution and the -%parameters that the user must provide to control each of them. - -%\input {../fig/mdlnode_interface.cap} - - The -%remainder of the -document describes the individual parameters in alphabetical order. This -description centers on the Help texts, which have been designed to guide the -user to the proper choice at each junction, even if his knowledge of the -overall workings of the program is only superficial. - - Please note that the generic prompt and help texts defined for these -parameters are frequently superseded in the actual applications by alternative -texts that are more appropriate to the situation at hand. Unfortunately, the -present architecture of \NEWSTAR precludes the inclusion of such texts in the -documentation system, so the only opportunity to read that information is -during program execution (in your terminal window!). - - -\section{ Descriptions of the individual parameters} -\label{.descriptions} - -\subsection{ References to public interfaces} -\label{.public} - -\input {mdlnode_public_keys.tef} diff --git a/src/doc/intfc/mdlnode_public_keys.tef b/src/doc/intfc/mdlnode_public_keys.tef deleted file mode 100644 index aaa1995e7303dc6e5e547cec80e964f4bd449b31..0000000000000000000000000000000000000000 --- a/src/doc/intfc/mdlnode_public_keys.tef +++ /dev/null @@ -1,64 +0,0 @@ - - -\subsection{ Parameter INPUT\_MDL\_NODE} -\label{.input.mdl.node} - -\spbegin -{\em Prompt:} input .MDL file name ({\em may vary per application})\\ -{\em Expected input:} Character *80: 1 value -\spend -\spbegin -\svbegin\begin{verbatim} - Specify the input .MDL filee name. -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} -Enter ** (or e.g. /user0/mydata/**) to get a list of .MDL files in your current -(or the indicated) directory; then enter #<n> to select the <n>th file from -such a list. -\end{verbatim}\svend -\spend - - -\subsection{ Parameter MDL\_NODE} -\label{.mdl.node} - -\spbegin -{\em Prompt:} input/output .MDL file name ({\em may vary per application})\\ -{\em Expected input:} Character *80: 1 value -\spend -\spbegin -\svbegin\begin{verbatim} - Specify the .MDL file name. -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} -Enter ** (or e.g. /user0/mydata/**) to get a list of .MDL files in your current -(or the indicated) directory; then enter #<n> to select the <n>th file from -such a list. -\end{verbatim}\svend -\spend - - -\subsection{ Parameter OUTPUT\_MDL\_NODE} -\label{.output.mdl.node} - -\spbegin -{\em Prompt:} output .MDL file name ({\em may vary per application})\\ -{\em Expected input:} Character *80: 1 value -\spend -\spbegin -\svbegin\begin{verbatim} - Specify the output .MDL file name. -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} -Enter ** (or e.g. /user0/mydata/**) to get a list of .MDL files in your current -(or the indicated) directory; then enter #<n> to select the <n>th file from -such a list. -\end{verbatim}\svend -\spend - diff --git a/src/doc/intfc/natnf_private_intfc.tex b/src/doc/intfc/natnf_private_intfc.tex deleted file mode 100644 index d8b245c192c7c9bc237f71de889a8c7037e0a7d1..0000000000000000000000000000000000000000 --- a/src/doc/intfc/natnf_private_intfc.tex +++ /dev/null @@ -1,31 +0,0 @@ -% natnf_private_intfc.tex - -\chapter{ Private parameters for program NATNF} -\tableofcontents - - -\section{ Overview} - - This document contains an overview of the parameter interface of the -program NATNF. The program also uses a number of public interfaces; references -to these are also \textref{listed}{.public}. - -% \Figref{.natnf.interface} and its companion \figref{.natnf.extract} -%show schematically the various branches of program execution and the -%parameters that %the user must provide to control each of them. - -%\input {../fig/natnf_interface.cap} - - The remainder of the document describes the individual parameters in -alphabetical order. This description centers on the Help texts, which have been -designed to guide the user to the proper choice at each junction, even if his -knowledge of the overall workings of the program is only superficial. - - -\section{ Descriptions of the individual parameters} -\label{.descriptions} - -\subsection{ References to public interfaces} -\label{.public} - -\input {natnf_private_keys.tef} diff --git a/src/doc/intfc/natnf_private_keys.tef b/src/doc/intfc/natnf_private_keys.tef deleted file mode 100644 index 93325278e559a1209335c091f6cd8e2fe24a742a..0000000000000000000000000000000000000000 --- a/src/doc/intfc/natnf_private_keys.tef +++ /dev/null @@ -1,11 +0,0 @@ - -%\section{ References to public interfaces} -%\label{.public} - -% \input natnf.tmp.ref.1 -{\em See also:} -\begin{itemize} -\item \textref{DWARF}{introduction.user.interface} user interface -\end{itemize} - - diff --git a/src/doc/intfc/ncalib_private_intfc.tex b/src/doc/intfc/ncalib_private_intfc.tex deleted file mode 100644 index 80459b9c5ce1e3101314f2ca37c26b96e8584b8f..0000000000000000000000000000000000000000 --- a/src/doc/intfc/ncalib_private_intfc.tex +++ /dev/null @@ -1,31 +0,0 @@ -% ncalib_private_intfc.tex - -\chapter{ Private parameters for program NCALIB} -\tableofcontents - - -\section{ Overview} - - This document contains an overview of the parameter interface of the -program NCALIB. The program also uses a number of public interfaces; references -to these are also \textref{listed}{.public}. - -% \Figref{.ncalib.interface} and its companion \figref{.ncalib.extract} -show %schematically the various branches of program execution and the -parameters that %the user must provide to control each of them. - -%\input {../fig/ncalib_interface.cap} - - The remainder of the document describes the individual parameters in -alphabetical order. This description centers on the Help texts, which have been -designed to guide the user to the proper choice at each junction, even if his -knowledge of the overall workings of the program is only superficial. - - -\section{ Descriptions of the individual parameters} -\label{.descriptions} - -\subsection{ References to public interfaces} -\label{.public} - -\input {ncalib_private_keys.tef} diff --git a/src/doc/intfc/ncalib_private_keys.tef b/src/doc/intfc/ncalib_private_keys.tef deleted file mode 100644 index 3d702f65cc3aebf5d81b478c70a97bdccfee79fa..0000000000000000000000000000000000000000 --- a/src/doc/intfc/ncalib_private_keys.tef +++ /dev/null @@ -1,11 +0,0 @@ - -%\section{ References to public interfaces} -%\label{.public} - -% \input ncalib.tmp.ref.1 -{\em See also:} -\begin{itemize} -\item \textref{DWARF}{introduction.user.interface} user interface -\end{itemize} - - diff --git a/src/doc/intfc/nclean_private_intfc.tex b/src/doc/intfc/nclean_private_intfc.tex deleted file mode 100644 index c201e60a250f6002fdd1277ab7615c3623f01fff..0000000000000000000000000000000000000000 --- a/src/doc/intfc/nclean_private_intfc.tex +++ /dev/null @@ -1,31 +0,0 @@ -% nclean_private_intfc.tex - -\chapter{ Private parameters for program NCLEAN} -\tableofcontents - - -\section{ Overview} - - This document contains an overview of the parameter interface of the -program NCLEAN. The program also uses a number of public interfaces; references -to these are also \textref{listed}{.public}. - -% \Figref{.nclean.interface} and its companion \figref{.nclean.extract} -show %schematically the various branches of program execution and the parameters -that %the user must provide to control each of them. - -%\input {../fig/nclean_interface.cap} - - The remainder of the document describes the individual parameters in -alphabetical order. This description centers on the Help texts, which have been -designed to guide the user to the proper choice at each junction, even if his -knowledge of the overall workings of the program is only superficial. - - -\section{ Descriptions of the individual parameters} -\label{.descriptions} - -\subsection{ References to public interfaces} -\label{.public} - -\input {nclean_private_keys.tef} diff --git a/src/doc/intfc/nclean_private_keys.tef b/src/doc/intfc/nclean_private_keys.tef deleted file mode 100644 index ac406e5681e3bce139fc3454532cda540f27bc23..0000000000000000000000000000000000000000 --- a/src/doc/intfc/nclean_private_keys.tef +++ /dev/null @@ -1,545 +0,0 @@ - -%\section{ References to public interfaces} -%\label{.public} - -% \input nclean.tmp.ref.1 -{\em See also:} -\begin{itemize} -\item \textref{DWARF}{introduction.user.interface} user interface -\item \textref{MDLNODE}{mdlnode_public_intfc} public keywords -\item \textref{NGEN}{ngen_public_intfc} public keywords -\item \textref{NMAP}{nmap_public_intfc} public keywords -\item \textref{NMODEL}{nmodel_public_intfc} public keywords -\item \textref{SCNNODE}{scnnode_public_intfc} public keywords -\item \textref{SCNSETS}{scnsets_public_intfc} public keywords -\item \textref{SELECT}{select_public_intfc} public keywords -\item \textref{WMPNODE}{wmpnode_public_intfc} public keywords -\item \textref{WMPSETS}{wmpsets_public_intfc} public keywords -\end{itemize} - - - -\subsection{ Parameter AP\_WMP\_SET} -\label{.ap.wmp.set} - -\spbegin -{\em Prompt:} ONE antenna pattern (grp.fld.chn.pol.1.seq)\\ -{\em Expected input:} Character *32: 1 to 1 values -\spend -\spbegin -\svbegin\begin{verbatim} -Specify ONE antenna pattern - (group.field.channel.polarisation.type(=1).sequence_number) -\end{verbatim}\svend -\spend - - -\subsection{ Parameter AREA} -\label{.area} - -\spbegin -{\em Prompt:} Window area l,m,dl,dm\\ -{\em Expected input:} Integer: 1 to 4 values -\spend -\spbegin -\svbegin\begin{verbatim} -The CLEAN window is defined as the union of up to 32 rectangular areas (which -may arbitrarily overlap). For BEAM clean this is also the window within which -source responses will be subtracted. -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} -You are being prompted for these areas one by one until you give a null reply -(<CR> only). An area is specified by four numbers: l,m, dl,dm, where -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} - l,m l and m in grid points for the area centre; (l,m)=(0,0) at the map - centre, increasing toward the upper right (i.e. with decreasing RA - and increasing DEC) - dl,dm width and height of the area in grid points -\end{verbatim}\svend -\spend - - -\subsection{ Parameter CLEAN\_LIMIT} -\label{.clean.limit} - -\spbegin -{\em Prompt:} Limit in fraction of map maximum\\ -{\em Expected input:} Real: 1 value -\spend -\spbegin -\svbegin\begin{verbatim} -Specify the level to which to clean in fraction of the initial map maximum. -\end{verbatim}\svend -\spend - - -\subsection{ Parameter CLIP\_AREA} -\label{.clip.area} - -\spbegin -{\em Prompt:} UV-radius range for clipping (m)\\ -{\em Expected input:} Real: 1 to 2 values -\spend -\spbegin -\svbegin\begin{verbatim} -Specify the (circular) UV-plane radii (in metres) between which you want to -clip the data. The default is to clip everywhere. -\end{verbatim}\svend -\spend - - -\subsection{ Parameter CLIP\_LEVELS} -\label{.clip.levels} - -\spbegin -{\em Prompt:} Amplitude range to be discarded\\ -{\em Expected input:} Real: 1 to 2 values -\spend -\spbegin -\svbegin\begin{verbatim} -Specify amplitude range (in Westerbork Units) of visibility magnitudes that you -want to discard. -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} -In the annulus defined by CLIP_AREA, values between the limits you specify will -be discarded. -\end{verbatim}\svend - {\em parameter \textref{CLIP\_AREA}{.clip.area} } -\spend -\spbegin -\svbegin\begin{verbatim} -NOTE: It would be more natural to define a range within which visibilities are -considered valid. As it is, only the lower limit is actually useful, allowing -you to define a rejection threshold for interference. To do so, specify your -threshold for the lower and 'infinity' for the upper limit, e.g. -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} - <threshold>,100000 -\end{verbatim}\svend -\spend - - -\subsection{ Parameter CMEMORY\_USE} -\label{.cmemory.use} - -\spbegin -{\em Prompt:} UV-clean memory size\\ -{\em Expected input:} Integer: 1 value -\spend -\spbegin -\svbegin\begin{verbatim} -Specify the work memory size in bytes for the UV Clean option, to be allowed in -defining the beam patch and to be used in executing the Fourier transforms. -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} -The default shown is normally adequate; a larger value may speed up the -execution of major cycles in UV Clean. -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} -NCLEAN will not accept a value in excess of 4000000 (4 MB). -\end{verbatim}\svend -\spend - - -\subsection{ Parameter COMPON\_LIMIT} -\label{.compon.limit} - -\spbegin -{\em Prompt:} Maximum number of components to find\\ -{\em Expected input:} Integer: 1 value -\spend -\spbegin -\svbegin\begin{verbatim} -Specify the maximum number of components to be cleaned. -\end{verbatim}\svend -\spend - - -\subsection{ Parameter COMPON\_LOG} -\label{.compon.log} - -\spbegin -{\em Prompt:} Reporting interval for components found: | terminal, printer\\ -{\em Expected input:} Integer: 1 to 2 values -\spend -\spbegin -\svbegin\begin{verbatim} -You may give two numbers <n> here, indicating that every <n>-th component must -be reported. The first number applies to your terminal window, the second to -the log file. A value of 0 means 'no reporting at all. -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} -Example: - 2,0 specifies that every other component will be typed, and none logged. -\end{verbatim}\svend -\spend - - -\subsection{ Parameter CYCLE\_DEPTH} -\label{.cycle.depth} - -\spbegin -{\em Prompt:} Major cycle depth\\ -{\em Expected input:} Real: 1 value -\spend -\spbegin -\svbegin\begin{verbatim} -Specify the level relative to the initial map maximum in the CLEAN window to -which you want to clean in one major cycle. -\end{verbatim}\svend -\spend - - -\subsection{ Parameter DATA\_FACTOR} -\label{.data.factor} - -\spbegin -{\em Prompt:} Data multiplication factor\\ -{\em Expected input:} Real: 1 value -\spend -\spbegin -\svbegin\begin{verbatim} -Specify the factor by which to multiply the input map-data. -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} -This option is only relevant for DATA clean. The first input-map and all maps -created by DATA clean will be multiplied by this factor. -\end{verbatim}\svend -\spend - - -\subsection{ Parameter DECONVOLUTION} -\label{.deconvolution} - -\spbegin -{\em Prompt:} Correct antenna pattern for mapping taper: YES/NO\\ -{\em Expected input:} Yes/No: 1 value -\spend -\spbegin -\svbegin\begin{verbatim} -The gridding convolution in map-making is usually compensated for by -multiplying the output map and antenna pattern with a taper function that rises -toward the map edges. -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} -If this is the case, answering YES here will instruct the program to account -for this effect; this will reduce the aliasing errors in the residual map, -allowing you to clean a somewhat larger part of the map. YES will in general -produce a result with less aliasing, NO the reverse. -\end{verbatim}\svend -\spend - - -\subsection{ Parameter DMEMORY\_USE} -\label{.dmemory.use} - -\spbegin -{\em Prompt:} Work memory size\\ -{\em Expected input:} Integer: 1 value -\spend -\spbegin -\svbegin\begin{verbatim} -The memory workspace in bytes needed is 12 times the size of the rectangle -enclosing all selected areas in the map plane. NCLEAN normally allocates up to -300 KB for this purpose. To satisfy the present need, you must either accept -the value suggested here or specify a smaller set of areas, or both. -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} -NCLEAN will not accept a value in excess of 4000000 (4 MB). -\end{verbatim}\svend -\spend - - -\subsection{ Parameter GRATING\_FACTOR} -\label{.grating.factor} - -\spbegin -{\em Prompt:} Grating factor\\ -{\em Expected input:} Real: 1 value -\spend -\spbegin -\svbegin\begin{verbatim} -In the minor cycles of UVCOVER, DATA and COMPON clean, the maximum error made -in only subtracting part of the antenna pattern is estimated by <number of -sources> times <ypical sidelobe level in antenna pattern> times GRATING_FACTOR. -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} -You may lower this latter factor if you are not worried about the effects of -far-out sidelobes on the minor-cycle cleaning process. A lower value will allow -more source components to be collected in minor cycles before a major cycle -must be started. -\end{verbatim}\svend -\spend - - -\subsection{ Parameter LOOP\_GAIN} -\label{.loop.gain} - -\spbegin -{\em Prompt:} Clean loop-gain factor\\ -{\em Expected input:} Real: 1 value -\spend -\spbegin -\svbegin\begin{verbatim} -For each component found, the antenna pattern shifted to its position is -subtracted from the CLEAN window. To prevent overshoots, it is customary to -subtract not the complete component but only a fraction of it. The magnitude of -this fraction is defined here. -\end{verbatim}\svend -\spend - - -\subsection{ Parameter MAP\_FACTOR} -\label{.map.factor} - -\spbegin -{\em Prompt:} Multiplication factor\\ -{\em Expected input:} Real: 1 value -\spend -\spbegin -\svbegin\begin{verbatim} -Specify the factor by which to multiply the residual map before restoring. -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} -Normally one should use the default value of 1; a value of 0 serves to make a -map of the CLEAN components only. -\end{verbatim}\svend -\spend - - -\subsection{ Parameter OPTION} -\label{.option} - -\spbegin -{\em Prompt:} Operation wanted\\ -{\em Expected input:} Character *24: 1 value -\spend -\spbegin -\svbegin\begin{verbatim} -CLEANing: -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} - BEAM Hogbom clean: Use the map and the beam to clean. This - method is inaccurate away from the map centre due to the - aliasing associated with visibility gridding. -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} - UVCOVER Standard Clark Clean: Find and provisionally subtract sources - in some map areas first (minor cycles), then properly subtract - the sources found (major cycle). The number of minor cycles - between major cycles is determined by the program; the user can - steer this through a few control parameters. - The method suffers from the same limitations as BEAM, but is - faster for cleaning extended sources. -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} - DATA Cotton-Schwab Clean: Find sources as in UVCOVER, but perform - the major cycle on the original SCN-file visibilities, making a - new map from the residuals as input for the next major cycle. - This method rigorously avoids the aliasing limitations of BEAM - and UVCOVER, at the price of being very much slower. -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} - UREST Use a clean component list and a map to restore the clean - components in the map. -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} -For exploring the data before committing more serious work: -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} - HISTO Produce only a histogram of selected areas in the map and/or - antenna pattern -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} - COMPON Execute minor cycles as for UVCOVER, but omit the following - major cycle. The result is a source model and a map in which - these sources are provisionally subtracted in selected areas. - It is the fastest of the four CLEAN variants but produces an - inaccurate residual map. - This option may be used to quickly get a feel for the - minor-cycle control of UVCOVER and DATA Clean, or to make an - initial data model for NCALIB SELFCAL or NMODEL UPDATE. -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} -Other options: -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} - QUIT Terminate NCLEAN. -\end{verbatim}\svend -\spend - - -\subsection{ Parameter PRUSSIAN\_HAT} -\label{.prussian.hat} - -\spbegin -{\em Prompt:} Prussian hat value\\ -{\em Expected input:} Real: 1 value -\spend -\spbegin -\svbegin\begin{verbatim} -For extended sources a prussian hat (i.e. a nominal additional peak value on -the central value of the antenna pattern) may give better clean results. Values -of .1 to .4 could be tried. -\end{verbatim}\svend - \whichref{Cornwell} -\spend - - -\subsection{ Parameter RESIDUAL} -\label{.residual} - -\spbegin -{\em Prompt:} residual map?\\ -{\em Expected input:} Yes/No: 1 value -\spend -\spbegin -\svbegin\begin{verbatim} -Specify if the residual map must be written. -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} -For BEAM and UVCOVER cleaning, this map is an automatic by-product of the -process and the choice is whether or not to write it to the .WMP file. The map -will be given the same indices as the input map except for an incremented -sequence number. -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} -For UVDAT cleaning, the residual map must be constructed by making a new map -from the original visibilities, in which the CLEAN components just found are -subtracted. The new map will OVERWRITE the input map. -\end{verbatim}\svend - {\em See elsewhere for the\ - \textref{rationale}{nclean\_descr.residual.map} } -\spend - - -\subsection{ Parameter RESTORE} -\label{.restore} - -\spbegin -{\em Prompt:} restored map (YES/NO)?\\ -{\em Expected input:} Yes/No: 1 value -\spend -\spbegin -\svbegin\begin{verbatim} -Specify if a restored map must be written. -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} -A restored map consists of the CLEAN components convolved with a hypothetical -beam that has no sidelobes, superimposed on the residuals. It is an -approximation to what you would have observed with complete contiguous UV -coverage (hoth in hour angle and baseline) up to the longest baseline available. -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} -You will be given the option to suppress the residuals (parameter MAP_FACTOR), -in which case you get a map of the CLEAN components only. -\end{verbatim}\svend -\spend - - -\subsection{ Parameter RESTORE\_BEAM} -\label{.restore.beam} - -\spbegin -{\em Prompt:} dl, dm arcsec, pa deg\\ -{\em Expected input:} Real: 1 to 3 values -\spend -\spbegin -\svbegin\begin{verbatim} -Specify the restore beam width: -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} - dl width of beam in arcsec (full-halfwidth) -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} - dm width of beam in arcsec (full-halfwidth) -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} - pa position angle of skewed beam in degrees (anti-clockwise; - 0 deg is horizontally to the right (+l direction) -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} -The default beam is a two-dimensional Gaussian truncated at a level of .xx -relative to the maxiumum. If an antenna pattern for your map is available, the -l,m beam widths are derived from it; else a rule-of-thumb formula is used: -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} - half-width = 12 arcsec * 1400/frequency(MHz) -\end{verbatim}\svend -\spend - - -\subsection{ Parameter WMP\_SETS0} -\label{.wmp.sets0} - -\spbegin -{\em Prompt:} ONE input map: grp.fld.chn.pol.0.seq\\ -{\em Expected input:} Character *32: 1 to 1 values -\spend -\spbegin -\svbegin\begin{verbatim} -Specify ONE input map (group.field.channel.polar.type(=0).sequence_number) -\end{verbatim}\svend -\spend - diff --git a/src/doc/intfc/ncopy_private_intfc.tex b/src/doc/intfc/ncopy_private_intfc.tex deleted file mode 100644 index 667f7494c5277ab44af496963dc661c44d2eaa20..0000000000000000000000000000000000000000 --- a/src/doc/intfc/ncopy_private_intfc.tex +++ /dev/null @@ -1,31 +0,0 @@ -% ncopy_private_intfc.tex - -\chapter{ Private parameters for program NCOPY} -\tableofcontents - - -\section{ Overview} - - This document contains an overview of the parameter interface of the -program NCOPY. The program also uses a number of public interfaces; references -to these are also \textref{listed}{.public}. - -% \Figref{.ncopy.interface} and its companion \figref{.ncopy.extract} -show %schematically the various branches of program execution and the -parameters that %the user must provide to control each of them. - -%\input {../fig/ncopy_interface.cap} - - The remainder of the document describes the individual parameters in -alphabetical order. This description centers on the Help texts, which have been -designed to guide the user to the proper choice at each junction, even if his -knowledge of the overall workings of the program is only superficial. - - -\section{ Descriptions of the individual parameters} -\label{.descriptions} - -\subsection{ References to public interfaces} -\label{.public} - -\input {ncopy_private_keys.tef} diff --git a/src/doc/intfc/ncopy_private_keys.tef b/src/doc/intfc/ncopy_private_keys.tef deleted file mode 100644 index 537ef87354e6aec8508052ef767c6c9f03c2f2ad..0000000000000000000000000000000000000000 --- a/src/doc/intfc/ncopy_private_keys.tef +++ /dev/null @@ -1,125 +0,0 @@ - -%\section{ References to public interfaces} -%\label{.public} - -% \input ncopy.tmp.ref.1 -{\em See also:} -\begin{itemize} -\item \textref{DWARF}{introduction.user.interface} user interface -\item \textref{NGEN}{ngen_public_intfc} public keywords -\item \textref{SCNNODE}{scnnode_public_intfc} public keywords -\item \textref{SCNSETS}{scnsets_public_intfc} public keywords -\item \textref{SELECT}{select_public_intfc} public keywords -\end{itemize} - - - -\subsection{ Parameter COPY\_IFDATA} -\label{.copy.ifdata} - -\spbegin -{\em Prompt:} copy IF-data/Total Powers?\\ -{\em Expected input:} Yes/No: 1 value -\spend -\spbegin -\svbegin\begin{verbatim} - Specify YES if you want to copy IF-data (Total Powers) together -with the data -\end{verbatim}\svend -\spend - - -\subsection{ Parameter COPY\_MODEL} -\label{.copy.model} - -\spbegin -{\em Prompt:} copy model data?\\ -{\em Expected input:} Yes/No: 1 value -\spend -\spbegin -\svbegin\begin{verbatim} - Specify YES if you want to copy the model together with the data -\end{verbatim}\svend -\spend - - -\subsection{ Parameter OPTION} -\label{.option} - -\spbegin -{\em Expected input:} Character *12: 1 value -\spend -\spbegin -\svbegin\begin{verbatim} -Actions: -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} - COPY Copy sectors from one SCN file to another. - SHORTCOPY As copy, but only scans selected by scan number; this option - allows you to cut out the invalid trailing scan from a mosaic - sector -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} - OVERWIEW Display and log an overview of all sectors in a SCN file - QUIT Exit from NCOPY -\end{verbatim}\svend -\spend - - -\subsection{ Parameter POLARISATION} -\label{.polarisation} - -\spbegin -{\em Prompt:} Select polarisations\\ -{\em Expected input:} Character *4: 1 value -\spend -\spbegin -\svbegin\begin{verbatim} -Select polarisations to be copied: - XYX: XX, XY, YX, YY - XY: XX, YY only - X: XX only -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} - YX: for special applications only: - overwrite XX with XY, YY with YX, then output as if XY -\end{verbatim}\svend -\spend - - -\subsection{ Parameter SCANS} -\label{.scans} - -\spbegin -{\em Prompt:} First and last scan number from each sector\\ -{\em Expected input:} Integer: 1 to 2 values -\spend -\spbegin -\svbegin\begin{verbatim} -From all sectors selected, only the scan numbers within the selected scan -number and HA ranges wiull be copied. E.g., the specification -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} - SCANS= 0,4 -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} -will remove the last scan (number 5) from allo sectors of a mosaic observation -that produces 6-scan sectors. -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} -Remember that the first scan in a sector is numbered 0. -\end{verbatim}\svend -\spend - diff --git a/src/doc/intfc/nfilt_private_intfc.tex b/src/doc/intfc/nfilt_private_intfc.tex deleted file mode 100644 index 8f836fd5e09c5768703e24bcacad1424732d04c0..0000000000000000000000000000000000000000 --- a/src/doc/intfc/nfilt_private_intfc.tex +++ /dev/null @@ -1,31 +0,0 @@ -% nfilt_private_intfc.tex - -\chapter{ Private parameters for program NFILT} -\tableofcontents - - -\section{ Overview} - - This document contains an overview of the parameter interface of the -program NFLAG. The program also uses a number of public interfaces; references -to these are also \textref{listed}{.public}. - -% \Figref{.nfilt.interface} and its companion \figref{.nfilt.extract} -show %schematically the various branches of program execution and the -parameters that %the user must provide to control each of them. - -%\input {../fig/nfilt_interface.cap} - - The remainder of the document describes the individual parameters in -alphabetical order. This description centers on the Help texts, which have been -designed to guide the user to the proper choice at each junction, even if his -knowledge of the overall workings of the program is only superficial. - - -\section{ Descriptions of the individual parameters} -\label{.descriptions} - -\subsection{ References to public interfaces} -\label{.public} - -\input {nfilt_private_keys.tef} diff --git a/src/doc/intfc/nfilt_private_keys.tef b/src/doc/intfc/nfilt_private_keys.tef deleted file mode 100644 index 3a1af1ef014b79a4b2c3b4953e77a652b76aaf70..0000000000000000000000000000000000000000 --- a/src/doc/intfc/nfilt_private_keys.tef +++ /dev/null @@ -1,11 +0,0 @@ - -%\section{ References to public interfaces} -%\label{.public} - -% \input nfilt.tmp.ref.1 -{\em See also:} -\begin{itemize} -\item \textref{DWARF}{introduction.user.interface} user interface -\end{itemize} - - diff --git a/src/doc/intfc/nflag_private_intfc.tex b/src/doc/intfc/nflag_private_intfc.tex deleted file mode 100644 index 73a734343523922faebb3630236fd0d7fb184eb4..0000000000000000000000000000000000000000 --- a/src/doc/intfc/nflag_private_intfc.tex +++ /dev/null @@ -1,31 +0,0 @@ -% nflag_private_intfc.tex - -\chapter{ Private parameters for program NFLAG} -\tableofcontents - - -\section{ Overview} - - This document contains an overview of the parameter interface of the -program NFLAG. The program also uses a number of public interfaces; references -to these are also \textref{listed}{.public}. - -% \Figref{.nflag.interface} and its companion \figref{.nflag.extract} -% show schematically the various branches of program execution and the -% parameters that the user must provide to control each of them. - -%\input {../fig/nflag_interface.cap} - - The remainder of the document describes the individual parameters in -alphabetical order. This description centers on the Help texts, which have been -designed to guide the user to the proper choice at each junction, even if his -knowledge of the overall workings of the program is only superficial. - - -\section{ Descriptions of the individual parameters} -\label{.descriptions} - -\subsection{ References to public interfaces} -\label{.public} - -\input {nflag_private_keys.tef} diff --git a/src/doc/intfc/nflag_private_keys.tef b/src/doc/intfc/nflag_private_keys.tef deleted file mode 100644 index b1e25f74f51fb31a28c33aeea03a7faf297ef6c8..0000000000000000000000000000000000000000 --- a/src/doc/intfc/nflag_private_keys.tef +++ /dev/null @@ -1,11 +0,0 @@ - -%\section{ References to public interfaces} -%\label{.public} - -% \input nflag.tmp.ref.1 -{\em See also:} -\begin{itemize} -\item \textref{DWARF}{introduction.user.interface} user interface -\end{itemize} - - diff --git a/src/doc/intfc/ngcalc_private_intfc.tex b/src/doc/intfc/ngcalc_private_intfc.tex deleted file mode 100644 index b6a82c1de0938c6c5359705d7619554eb3662b54..0000000000000000000000000000000000000000 --- a/src/doc/intfc/ngcalc_private_intfc.tex +++ /dev/null @@ -1,31 +0,0 @@ -% ngcalc_private_intfc.tex - -\chapter{ Private parameters for program NGCALC} -\tableofcontents - - -\section{ Overview} - - This document contains an overview of the parameter interface of the -program NGCALC. The program also uses a number of public interfaces; references -to these are also \textref{listed}{.public}. - - \Figref{.ngcalc.interface} and its companion \figref{.ngcalc.extract} -show schematically the various branches of program execution and the parameters -that the user must provide to control each of them. - -\input {../fig/ngcalc_interface.cap} - - The remainder of the document describes the individual parameters in -alphabetical order. This description centers on the Help texts, which have been -designed to guide the user to the proper choice at each junction, even if his -knowledge of the overall workings of the program is only superficial. - -\subsection{ References to public interfaces} -\label{.public} - -\section{ Descriptions of the individual parameters} -\label{.descriptions} - - -\input {ngcalc_private_keys.tef} diff --git a/src/doc/intfc/ngcalc_private_keys.tef b/src/doc/intfc/ngcalc_private_keys.tef deleted file mode 100644 index ef68831afe339638bb2e2fb2c02e46e45688b719..0000000000000000000000000000000000000000 --- a/src/doc/intfc/ngcalc_private_keys.tef +++ /dev/null @@ -1,722 +0,0 @@ - -%\section{ References to public interfaces} -%\label{.public} - -% \input ngcalc.tmp.ref.1 -{\em See also:} -\begin{itemize} -\item \textref{DWARF}{introduction.user.interface} user interface -\item \textref{MDLNODE}{mdlnode_public_intfc} public keywords -\item \textref{NGEN}{ngen_public_intfc} public keywords -\item \textref{NGFSETS}{ngfsets_public_intfc} public keywords -\item \textref{NMODEL}{nmodel_public_intfc} public keywords -\item \textref{NSHOW}{nshow_public_intfc} public keywords -\item \textref{PLOTTER}{plotter_public_intfc} public keywords -\item \textref{SCNNODE}{scnnode_public_intfc} public keywords -\item \textref{SCNSETS}{scnsets_public_intfc} public keywords -\item \textref{SELECT}{select_public_intfc} public keywords -\end{itemize} - - - -\subsection{ Parameter ACTION} -\label{.action} - -\spbegin -{\em Prompt:} type of action |\\ -{\em Expected input:} Character *24: 1 value -\spend -\spbegin -\svbegin\begin{verbatim} -Specify the action to be performed: -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} - Creating cuts from external data: - EXTRACT extract information from SCN file into cuts - COPY copy cuts to other NGF file, retaining their indices - (this action is mainly useful for discarding cuts no longer - needed and thereby freeing disk space) -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} - Viewing the contents of the .NGF file: - SHOW show information in cut headers and data - BRIEF show summary per group/field showing numbers of polarisations, - interferometers, cuts and data points -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} - Calculations: - CALC Perform one of a set of predefined algorithms on individual cuts - MERGE Merge a number of cuts into a single new cut. - NOTE: Overlapping points will be averaged so you may use MERGE - to average e.g. a set of interferometers with data points - at coincident hour angles. - COMBINE Combine cut(s) in user-specified expression -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} - Sorting: - Starting from a cut in the HA direction, these actions produce a new cut -in the frequency or baseline direction for each hour angle present in any of -the input cuts. Use the HA_RANGE parameter to limit the number of output cuts. - The output cuts are in a primitive format in which the data are transposed -but NOT the coordinate axes. These wrong axes appear in plots of the transposed -cuts and must be interpreted as indicated below. In calculations, however, -coordinates will be interpreted correctly (provided you specify a sensible -calculation). -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} - Transposing a transposed group of cuts reproduces the original cuts. You -may also try to combine TRANS and BASE operations but sensible results are not -guaranteed. -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} - TRANS transpose frequency and HA axes. - In the transposed cuts, each channel is represented by an hour - angle of <channel number>*0.125 deg. - Each hour-angle bin of 0.125 deg is represented by a channel - number, which starts at 0 for the lowest hour angle present. -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} - BASE transpose interferometer and hour-angle axes. - In the transposed cuts, each baseline bin of 10 metres is - represented by an HA bin of .125 deg at HA = <baseline>/10*.125 - deg; baselines landing in the same bin are averaged. - Each hour-angle bin of .125 deg is represented by a baseline - sequence number of HA*.125. -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} - Plotting: - MONGO output cut data in a MONGO-readable file - PLOT plot data in NGF cut(s) -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} - Miscellaneous: - DELETE delete cuts. (Only the index linkage is removed but the cut data - remain in the file: Use COPY to free the file space.) - BEWARE: This action is IRREVERSIBLE. - NODE switch to other NGF file - QUIT terminate NGCALC -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} - Data-format conversions: - CVX convert NGF file from other machine's format to local format - NVS update to latest NGF-file format -\end{verbatim}\svend -\spend - - -\subsection{ Parameter BAS\_RANGE} -\label{.bas.range} - -\spbegin -{\em Prompt:} Baseline range (metres)\\ -{\em Expected input:} Real: 1 to 2 values -\spend -\spbegin -\svbegin\begin{verbatim} -Enter the the lower and upper ends of baseline range to plot. -\end{verbatim}\svend -\spend - - -\subsection{ Parameter BAS\_SCALE} -\label{.bas.scale} - -\spbegin -{\em Prompt:} Baseline plot scale (metres/cm)\\ -{\em Expected input:} Real: 1 value -\spend - - -\subsection{ Parameter CALC\_TYPE} -\label{.calc.type} - -\spbegin -{\em Prompt:} calculation type\\ -{\em Expected input:} Character *24: 1 value -\spend -\spbegin -\svbegin\begin{verbatim} -Specify the action to be performed on individual cut(s). -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} - AVER average cut and report results -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} - The following actions will create a new cut for each input cut with the same - index numbers except for a new SEQ number. -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} - SMOOTH create new cut(s) by smoothing cut data with a triangular - function (whose halfwidth you will specify) -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} - POLY fit N+1 coefficients of an Nth-order polynomial - P= c0 +c1*HA +c2*HA**2 +... +cN*HA**N - through cut data and create new cut(s) from the residuals -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} - CPOLY as POLY, but fitting only N selected coefficients of an - Mth-order polynomial. M>N; the missing coefficients are held - at 0. (This method can be used, e.g., to fit a polynomial for - which you know a priori that it must be even.) -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} - DPOLY subtract values of a polynomial (yet to be specified) from cut - data and create new cut(s) from the results -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} - SHIFT create new cuts with visibility values transformed to a - different sky position -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} - NULL create new cuts with data points in an HA range (yet to be - selected) deleted -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} - QUIT leave CALC -Note: All calculations are done with complex numbers. To use e.g. only - amplitude, convert it first with an expression= AMPL(#..) in - a COMBINE action. -\end{verbatim}\svend -\spend - - -\subsection{ Parameter DATA\_ACTION} -\label{.data.action} - -\spbegin -{\em Prompt:} data representation\\ -{\em Expected input:} Character *24: 1 value -\spend -\spbegin -\svbegin\begin{verbatim} -Specify action to perform: -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} - SHOW show detailed cut data -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} - AMPL show amplitude of cut data - PHASE show phase of cut data -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} - QUIT quit data part -\end{verbatim}\svend -\spend - - -\subsection{ Parameter EXPRESSION} -\label{.expression} - -\spbegin -{\em Prompt:} expression\\ -{\em Expected input:} Character *80: 1 value -\spend -\spbegin -\svbegin\begin{verbatim} -Specify the expression defining the new output cut. It is safest to enclose the -expression in double quotes. -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} -Each data point in the output cut will be set to the value of your expression, -using the values of the corresponding data point in each of the input cuts in -the expression. Elements of an expression can be: -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} - References to input cuts of the form #<number> or ##<number> (see NOTE - below). You will be prompted later to identify one cut to be associated - with each of the numbers you use in the expression. For each output - point, a reference refers to the input point at the same hour angle. -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} - Real constants, e.g. 5, -1.23E-12 -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} - Symbolic constants - PI [=3.14..], EE [=2.71..], CC [=light velocity in km/s], - DRAD [=180/PI] -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} - Standard functions of real or complex argument (angles always in - degrees): - SIN(x), COS(x), ASIN(x), ACOS(x), ATAN(x), ATAN(real,imag) - EXP(x), EXP10(x), EXP2(x), LOG(x), LOG10(x), LOG2(x) - ABS(X), SQRT(X( - REAL(x), IMAG(x), AMPL(x), PHASE(x), IMUL(x) (mmultiply x by i) -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} - Standard functions of a real argument that will be performed separately - on the real and imaginary components of a complex argument - FLOOR(x), CEIL(x), ROUND(x), INT(x), FRACT(x) -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} - Cut-data-point coordinates: - RA [right-ascension], DEC [declination], HA [hour-angle], - UT [univ.time], FQ [freq. in MHz], BL [baseline in m], - UU [U in lambda], VV [V in lambda] -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} - Operators, in order of decreasing priority (results of logical and - relation expressions are 0. (False) or 1. (True)): -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} - unary +,- - **,^ (power) - *, /, +, - - >=,<=,=,<,>,<> (comparisons: if either value to be compared is - complex, absolute values are used in the comparison) - <> (not) & (and) (or) -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} -Example: - #1*(REAL(#1)<0)+#2*(REAL(#2)>0): for each hour angle, take the data - value from cut #1 if it is <0 and the data value from cut #2 if - it is >0, and add them to get the data point at the same hour - angle in the output cut -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} -NOTE: - You may loop over sectors in the standard way. Each of the input -sectors in the expression will be incremented at the start of a new loop cycle. -You may, however, inhibit this incrementing by using a double '#', e.g. ##2. -\end{verbatim}\svend -\spend - - -\subsection{ Parameter EXTRACT\_TYPE} -\label{.extract.type} - -\spbegin -{\em Prompt:} data type\\ -{\em Expected input:} Character *24: 1 value -\spend -\spbegin -\svbegin\begin{verbatim} -Specify the type of data to extract: -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} - DATA Observed visibilities - WEIGHT Visibility weights - MODEL Model visibilities -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} - TCOR Telescope gain/phase corrections - ICOR Interferometer gain/phase corrections - IFDATA 'IF' data: gain/system-temperature parameters from the WSRT - on-line system; you will be asked for details later. -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} - QUIT quit EXTRACT action -\end{verbatim}\svend -\spend - - -\subsection{ Parameter HA\_SCALE} -\label{.ha.scale} - -\spbegin -{\em Prompt:} hour-angle plot scale degree/cm\\ -{\em Expected input:} Real: 1 value -\spend - - -\subsection{ Parameter HA\_WIDTH} -\label{.ha.width} - -\spbegin -{\em Prompt:} smoothing width\\ -{\em Expected input:} Real: 1 value -\spend -\spbegin -\svbegin\begin{verbatim} -Specify smoothing halfwidth of triangular smoothing function in degrees of HA. -\end{verbatim}\svend -\spend - - -\subsection{ Parameter IF\_MODE} -\label{.if.mode} - -\spbegin -{\em Prompt:} type of IF data\\ -{\em Expected input:} Character *8: 1 value -\spend -\spbegin -\svbegin\begin{verbatim} -Specify type of 'IF' data to extract: -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} - Quantities related to telescope noise sources: - TPON total-power data for noise source on - TPOFF total-power data for noise source off - TNOISI constant noise source temperature -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} - Quanitities related to telescope system temperatiures: - TSYS system temperatures - TSYSI constant system temperature -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} - Quantities related to interferometer gain correction: - GAIN IF gains - GNCAL gain correction method - RGAINI constant receiver gain -\end{verbatim}\svend -\spend - - -\subsection{ Parameter MAX\_BASE} -\label{.max.base} - -\spbegin -{\em Prompt:} max. baseline to include (metres)\\ -{\em Expected input:} Real: 1 value -\spend -\spbegin -\svbegin\begin{verbatim} -Specify maximum baseline to include in output cut. -\end{verbatim}\svend -\spend - - -\subsection{ Parameter MONGO\_FILE} -\label{.mongo.file} - -\spbegin -{\em Prompt:} Mongo file name\\ -{\em Expected input:} Character *80: 1 value -\spend -\spbegin -\svbegin\begin{verbatim} -Specify the name of the file to be used in Mongo plotting. -\end{verbatim}\svend -\spend - - -\subsection{ Parameter NGF\_NODE} -\label{.ngf.node} - -\spbegin -{\em Prompt:} Input[+output] 'node' name\\ -{\em Expected input:} Character *80: 1 value -\spend -\spbegin -\svbegin\begin{verbatim} -This is the file from which input cuts will be read. -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} -Except in COPY operations, it is also the file to which new cuts will be -written. -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} -Enter ** (or e.g. /user0/mydata/**) to get a list of files, then enter #<n> to -select the <n>-th file from such that list. -\end{verbatim}\svend -\spend - - -\subsection{ Parameter OFFSET} -\label{.offset} - -\spbegin -{\em Prompt:} plot offset (data units)\\ -{\em Expected input:} Real: 1 value -\spend -\spbegin -\svbegin\begin{verbatim} -Example: - If you enter 100, <data values>-100 will be plotted. -\end{verbatim}\svend -\spend - - -\subsection{ Parameter OUTPUT\_NGF\_NODE} -\label{.output.ngf.node} - -\spbegin -{\em Prompt:} Output 'node' name\\ -{\em Expected input:} Character *80: 1 value -\spend -\spbegin -\svbegin\begin{verbatim} -This is the file to which cuts will be copied. -The source and output files MUST be different. -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} -Enter ** (or e.g. /user0/mydata/**) to get a list of files, enter #nn to select -the nn-th file from such a list. -\end{verbatim}\svend -\spend - - -\subsection{ Parameter PLOT\_TYPE} -\label{.plot.type} - -\spbegin -{\em Prompt:} cut-data component\\ -{\em Expected input:} Character *24: 1 value -\spend -\spbegin -\svbegin\begin{verbatim} -Specify the data component for the output cut: -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} - COS real part - SIN imaginary part - AMPL ABS(data) - PHASE ARG(data) -\end{verbatim}\svend -\spend - - -\subsection{ Parameter POLY\_COEF} -\label{.poly.coef} - -\spbegin -{\em Prompt:} polynomial coefficients\\ -{\em Expected input:} Real: 1 to 11 values -\spend -\spbegin -\svbegin\begin{verbatim} -Specify the coefficients of the polynomial to be subtracted: -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} - P= c0 +c1*HA +c2*(HA**2) +... +cN*(HA**N) -\end{verbatim}\svend -\spend - - -\subsection{ Parameter POLY\_N} -\label{.poly.n} - -\spbegin -{\em Prompt:} number of coefficients to fit\\ -{\em Expected input:} Integer: 1 value -\spend -\spbegin -\svbegin\begin{verbatim} -Specify number of coefficients of the polynomial to be fitted to the data. -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} -For CALC=POLY, this is 1 + the polynomial's degree. -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} -For CALC=DPOLY it is the number of non-zero coefficients. You will be prompted -later for there orders. -\end{verbatim}\svend -\spend - - -\subsection{ Parameter POLY\_USE} -\label{.poly.use} - -\spbegin -{\em Prompt:} orders of coefficients to fit\\ -{\em Expected input:} Integer: 1 to 11 values -\spend -\spbegin -\svbegin\begin{verbatim} -Specify the orders of the polynomial coefficients to fit to. Default is -0,...,<N>, where <N> is the number you gave for POLY_N. -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} -Example: - To fit a 6th-degree even polynomial, specify POLY_N=3 and POLY_USE=0,2,4,6. -\end{verbatim}\svend -\spend - - -\subsection{ Parameter SCALE} -\label{.scale} - -\spbegin -{\em Prompt:} plot scale (data units/mm)\\ -{\em Expected input:} Real: 1 value -\spend -\spbegin -\svbegin\begin{verbatim} -Specify the scale in units/mm. -\end{verbatim}\svend -\spend - - -\subsection{ Parameter SECTOR\_ACTION} -\label{.sector.action} - -\spbegin -{\em Prompt:} Sector-header action |\\ -{\em Expected input:} Character *24: 1 value -\spend -\spbegin -\svbegin\begin{verbatim} - Specify interaction with this sector header: -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} - Show details of the sector header: - SHOW show entire sector header - EDIT edit fields (values) in the Sector header by name -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} - Navigation: - NEXT: proceed to the header for the next sector selected - CONT: descend into the scans of this sector - QUIT: return to the file-header level -\end{verbatim}\svend -\spend - - -\subsection{ Parameter SELECT\_XYX} -\label{.select.xyx} - -\spbegin -{\em Prompt:} polarisation(s)\\ -{\em Expected input:} Character *4: 1 value -\spend -\spbegin -\svbegin\begin{verbatim} -Select the polarisation(s) to be used. Your answer will be interpreted -according to the data type you will select hereafter -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} - Interferometer Telescope - ============== ========= - XYX XX, YX, YX and YY X and Y - XY XX and YY X and Y - X XX only X only - Y YY only Y only - YX XY and YX none - YYX YX none - XXY XY none -\end{verbatim}\svend -\spend - - -\subsection{ Parameter SHIFT} -\label{.shift} - -\spbegin -{\em Prompt:} l,m shifts to apply to data (arcsec)\\ -{\em Expected input:} Real: 1 to 2 values -\spend -\spbegin -\svbegin\begin{verbatim} -Specify the l,m shifts in arcsec to be applied to data -\end{verbatim}\svend -\spend - - -\subsection{ Parameter USE\_NGF\_SET} -\label{.use.ngf.set} - -\spbegin -{\em Prompt:} Cut to use\\ -{\em Expected input:} Character *32: 1 value -\spend -\spbegin -\svbegin\begin{verbatim} -Define the cut represented by each of the variables of the form -#<n> and ##<n> in your expression. You are being prompted for each such -variable that is present in the expression. Your reply must designate ONE cut. -\end{verbatim}\svend -\spend - diff --git a/src/doc/intfc/ngen_private_intfc.tex b/src/doc/intfc/ngen_private_intfc.tex deleted file mode 100644 index 7e92879b7ecf178f9dae58945d8dc60ecf76b2f1..0000000000000000000000000000000000000000 --- a/src/doc/intfc/ngen_private_intfc.tex +++ /dev/null @@ -1,31 +0,0 @@ -% ngen_private_intfc.tex - -\chapter{ Private parameters for program NGEN} -\tableofcontents - - -\section{ Overview} - - This document contains an overview of the parameter interface of the -program NGEN. The program also uses a number of public interfaces; references -to these are also \textref{listed}{.public}. - -% \Figref{.ngen.interface} and its companion \figref{.ngen.extract} show -%schematically the various branches of program execution and the parameters -that %the user must provide to control each of them. - -%\input {../fig/ngen_interface.cap} - - The remainder of the document describes the individual parameters in -alphabetical order. This description centers on the Help texts, which have been -designed to guide the user to the proper choice at each junction, even if his -knowledge of the overall workings of the program is only superficial. - - -\section{ Descriptions of the individual parameters} -\label{.descriptions} - -\subsection{ References to public interfaces} -\label{.public} - -\input {ngen_private_keys.tef} diff --git a/src/doc/intfc/ngen_public_intfc.tex b/src/doc/intfc/ngen_public_intfc.tex deleted file mode 100644 index 13a155b76430d90c907952c85b6d5f54392061e6..0000000000000000000000000000000000000000 --- a/src/doc/intfc/ngen_public_intfc.tex +++ /dev/null @@ -1,39 +0,0 @@ -% ngen_public_intfc.tex - -\chapter{ Public parameter group NGEN} -\tableofcontents - - -\section{ Overview} - - This document contains an overview of the public parameter group NGEN, -(part of) which is included in several \NEWSTAR programs. - -% \Figref{.ngen.interface} and its companion \figref{.ngen.extract} show -%schematically the various branches of program execution and the parameters -%that the user must provide to control each of them. - -%\input {../fig/ngen_interface.cap} - - The -%remainder of the -document describes the individual parameters in alphabetical order. This -description centers on the Help texts, which have been designed to guide the -user to the proper choice at each junction, even if his knowledge of the -overall workings of the program is only superficial. - - Please note that the generic prompt and help texts defined for these -parameters are frequently superseded in the actual applications by alternative -texts that are more appropriate to the situation at hand. Unfortunately, the -present architecture of \NEWSTAR precludes the inclusion of such texts in the -documentation system, so the only opportunity to read that information is -during program execution (in your terminal window!). - - -\section{ Descriptions of the individual parameters} -\label{.descriptions} - -\subsection{ References to public interfaces} -\label{.public} - -\input {ngen_public_keys.tef} diff --git a/src/doc/intfc/ngen_public_keys.tef b/src/doc/intfc/ngen_public_keys.tef deleted file mode 100644 index 8b137891791fe96927ad78e64b0aad7bded08bdc..0000000000000000000000000000000000000000 --- a/src/doc/intfc/ngen_public_keys.tef +++ /dev/null @@ -1 +0,0 @@ - diff --git a/src/doc/intfc/ngfsets_public_intfc.tex b/src/doc/intfc/ngfsets_public_intfc.tex deleted file mode 100644 index 4b10ee8fa291c4c80acbb9d16ab95fd3d05f603c..0000000000000000000000000000000000000000 --- a/src/doc/intfc/ngfsets_public_intfc.tex +++ /dev/null @@ -1,39 +0,0 @@ -% ngfsets_public_intfc.tex - -\chapter{ Public parameter group NGFSETS} -\tableofcontents - - -\section{ Overview} - - This document contains an overview of the public parameter group -NGFSETS, (part of) which is included in several \NEWSTAR programs. - -% \Figref{.ngfsets.interface} and its companion \figref{.ngfsets.extract} -%show schematically the various branches of program execution and the -%parameters that the user must provide to control each of them. - -%\input {../fig/ngfsets_interface.cap} - - The -%remainder of the -document describes the individual parameters in alphabetical order. This -description centers on the Help texts, which have been designed to guide the -user to the proper choice at each junction, even if his knowledge of the -overall workings of the program is only superficial. - - Please note that the generic prompt and help texts defined for these -parameters are frequently superseded in the actual applications by alternative -texts that are more appropriate to the situation at hand. Unfortunately, the -present architecture of \NEWSTAR precludes the inclusion of such texts in the -documentation system, so the only opportunity to read that information is -during program execution (in your terminal window!). - - -\section{ Descriptions of the individual parameters} -\label{.descriptions} - -\subsection{ References to public interfaces} -\label{.public} - -\input {ngfsets_public_keys.tef} diff --git a/src/doc/intfc/ngfsets_public_keys.tef b/src/doc/intfc/ngfsets_public_keys.tef deleted file mode 100644 index 4d8479973934d47f16550546f2e11e1e13223e76..0000000000000000000000000000000000000000 --- a/src/doc/intfc/ngfsets_public_keys.tef +++ /dev/null @@ -1,440 +0,0 @@ - - -\subsection{ Parameter NGF\_CHANNELS} -\label{.ngf.channels} - -\spbegin -{\em Prompt:} 3rd index: channel(s) ({\em may vary per application})\\ -{\em Expected input:} Character *32: 1 value -\spend -\spbegin -\svbegin\begin{verbatim} -Give the channel index (range) CHN of a cut-Set specification - (grp.fld.CHN.pol.iort.seq) -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} -Remember that channel 0 is the 'continuum' channel. -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} -Possible answers ([]=optional): -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} - 0 take the continuum channel - n1 take channel nr n1 (n1=0,1,2,3,....) - n1-n2[:n3] loop over channels n1 through n2 [step n3] - * loop over all channels for the field (wildcard) - n1-[*] loop over all channels for the field, - starting with n1 [step n3] -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} -Note: - The associated NGF_LOOPS keyword allows even more looping over index values. -\end{verbatim}\svend -\spend - - -\subsection{ Parameter NGF\_CUTS} -\label{.ngf.cuts} - -\spbegin -{\em Prompt:} 6th index: cut(s) ({\em may vary per application})\\ -{\em Expected input:} Character *32: 1 value -\spend -\spbegin -\svbegin\begin{verbatim} - Give the sequence-number index (range) SEQ of a cut-Set - specification (grp.fld.chn.pol.iort.SEQ). -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} -Possible answers ([]=optional): -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} - 0 take the first cut - n1 take cut nr n1 (n1=0,1,2,3,....) - n1-n2[:n3] loop over cuts n1 through n2 [step n3] - * loop over all - (wildcard) - n1-[*] loop over all cuts for the field and channel, - starting with n1 [step n3] -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} -Note: -The associated NGF_LOOPS keyword allows even more looping over index values. -\end{verbatim}\svend -\spend - - -\subsection{ Parameter NGF\_FIELDS} -\label{.ngf.fields} - -\spbegin -{\em Prompt:} 2nd index: field(s) ({\em may vary per application})\\ -{\em Expected input:} Character *32: 1 value -\spend -\spbegin -\svbegin\begin{verbatim} - Give the field index (range) FLD of a cut-Set specification - (grp.FLD.chn.pol.iort.seq) -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} -Possible answers ([]=optional): -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} - 0 take first (or only) field - n1 take field nr n1 (n1=0,1,2,3,....) - n1-n2[:n3] loop over fields n1 through n2 [step n3] - * loop over all fields in the observation (wildcard) - n1-[*][:n3] loop over all fields in the observation, - starting with n1 [step n3] -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} -Note: - The associated NGF_LOOPS keyword allows even more looping over index values. -\end{verbatim}\svend -\spend - - -\subsection{ Parameter NGF\_GROUPS} -\label{.ngf.groups} - -\spbegin -{\em Prompt:} 1st index: grp ({\em may vary per application})\\ -{\em Expected input:} Character *32: 1 value -\spend -\spbegin -\svbegin\begin{verbatim} -Give the group index (range) GRP of a cut-Set specification - (GRP.fld.chn.pol.iort.seq) -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} -Possible answers ([]=optional): -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} - 0 take first (or only) group - n1 take group nr n1 (n1=0,1,2,3,....) - n1-n2[:n3] loop over groups n1 through n2 [step n3] - * loop over all available groups (wildcard) - n1-[*][:n3] loop over all available groups, - starting with n1 [step n3] -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} -Note: - The associated NGF_LOOPS keyword allows even more looping over index values. -\end{verbatim}\svend -\spend - - -\subsection{ Parameter NGF\_IFRS} -\label{.ngf.ifrs} - -\spbegin -{\em Prompt:} 5th index: iort ({\em may vary per application})\\ -{\em Expected input:} Character *32: 1 value -\spend -\spbegin -\svbegin\begin{verbatim} -Give the interferometer or telescope index (range) IORT of a cut-Set -specification - (grp.fld.chn.pol.IORT.seq) -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} -This index is most useful in loop specifications (parameter NGF_LOOPS). -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} -For interferometer data, iort is an interferometer sequence number which can -not be easily interpreted. Therefore, this index is useful only in loop -specifications (parameter NGF_LOOPS). Specify a wildcard ('*') here and rely on -the SELECT_IFRS parameter for selecting interferometers. -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} -For telescope data, iort is the telescope number (A-D being represented by -10-13). The selection possibilities are limited here and you may prefer to rely -on the SELECT_TELS parameter. -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} -Possible answers ([]=optional): -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} - 0 take first (or only) ifr|tel - n1 take ifr|tel nr n1 (n1=0,1,2,3,....) - n1-n2[:n3] loop over ifr|tels n1 through n2 [step n3] - * loop over all available ifrs|tels (wildcard) - n1-[*][:n3] loop over all available ifrs|tels, - starting with n1 [step n3] -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} -Note: - The associated NGF_LOOPS keyword allows even more looping over index values. -\end{verbatim}\svend -\spend - - -\subsection{ Parameter NGF\_LOOPS} -\label{.ngf.loops} - -\spbegin -{\em Prompt:} Loop specifications: nr of cycles, index increment per cycle ({\em may vary per application})\\ -{\em Expected input:} Character *32: 1 to 16 values -\spend -\spbegin -\svbegin\begin{verbatim} -With the NGF_LOOPS keyword, you may specify repetitions of the operation you -are currently defining, systematically incrementing the Group, Channel, Field -etc. indices for each new cycle. -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} -This is done by specifying pairs of values: -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} - niter1,index_incr1, niter2,index_incr2, ... -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} -In each pair, the first value (n_iter) indicates the number of times the loop -has to execute; the second value (index_incr) indicates how the Cut index is to -be changed at the start of a new cycle. -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} -Example: - The specification NGF_SETS = grp.fld.1-2.* would select the combination -of all cuts of frequency channels 1 and 2 for the field grp.fld. If one wishes -to process 32 sets of successive such pairs of frequency channels, you would -have to type in the successive NGF_SETS specifications by hand: -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} - grp.fld.1-2, grp.fld.3-4, ....., grp.fld.63-64 -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} -Instead, you may specify NGF_LOOPS=32, 0.0.2 This will cause the program to -execute the present operation 32 times in a loop, starting with the NGF_SETS -specification and then incrementing its indices by 0.0.2 for every iteration; -this is equivalent to the above 32 separate runs of the program. -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} - n_iter must be > 0, and the increment can be any index string with -simple positive or negative integers. An increment of 0 may be omitted, i.e. -the increment specifications 0.0.3.0 and ..3 are all equivalent. -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} - Loops may be nested (to a limiting depth of 8 levels). A following loop -specification is executed inside the preceding ones. -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} -Example of nested loops: - To run your program on group 3 for 64 fields (fld index), for 10 odd -channels (chn index) per field, starting at channel 7 and combining all -polarisations (pol index) every time, specify: -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} - NGF_SETS=3.0.7.* (initial set of cuts) - NGF_LOOPS=64,.1, 10,..2 -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} -The second loop is executed as an inner loop inside the first one, that is, for -each mosaic subfield the channels are processed in a contiguous sequence. -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} -IF YOU WANT TO BE REMINDED OF WHAT CUTS ARE IN YOUR FILE: - Type O or L in response to this prompt to get an Overview or Layout - of the file for which you need to specify the sets. -\end{verbatim}\svend -\spend - - -\subsection{ Parameter NGF\_POLARS} -\label{.ngf.polars} - -\spbegin -{\em Prompt:} 4th index: polarisation(s) ({\em may vary per application})\\ -{\em Expected input:} Character *32: 1 value -\spend -\spbegin -\svbegin\begin{verbatim} -Give the polarisation index (range) POL of a cut-Set specification - (grp.fld.chn.POL.iort.seq) -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} - POL is a number indicating the polarisation. For interferometer data, -pol=0,1,2,3 represents XX,XY,YX,YY. For telescope data pol=0,1 represents X,Y. -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} -This index is useful for defining loops (NGF_LOOPS parameter). Otherwise you -may find the SELECT_XYX parameter more convenient. -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} -If you prefer to use NGF_POLAR here, examples of reasonable answers are: - For interferometer data - * (=XX,XY,YX,YY) 0-3:3 (=XX,YY) 0 (=XX) 3 (=YY) - For telescope data - * (=X,Y) 0 (=X) 1 (=Y) -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} -Note: - The associated NGF_LOOPS keyword allows even more looping over index values. -\end{verbatim}\svend -\spend - - -\subsection{ Parameter NGF\_SETS} -\label{.ngf.sets} - -\spbegin -{\em Prompt:} Sectors to do: grp.fld.chn.pol.iort.seq ({\em may vary per application})\\ -{\em Expected input:} Character *32: 1 to 64 values -\spend -\spbegin -\svbegin\begin{verbatim} - A NEWSTAR .NGF file contains visibilities and associated data for one -or more objects. The basic unit of data is the CUT, which is a one-dimensional -vector of some type of data extracted from a .SCN file. The data may be either -visibilities or associated data such as corrections; they may be associated -with an interferometer or with a telescope. Cuts are addressed through a CUT -INDEX which is a string of six integers separated by dots: -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} - grp.fld.chn.pol.iort.seq -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} - A GROUP is basically an administrative unit, allowing the user to -subdivide his data, e.g. per object. - The FIELD and CHANNEL are the field and channel numbers in the .SCN -file of the observation from which the cut was taken. - POL is a number indicating the polarisation. For interferometer data, -pol=0,1,2,3 represents XX,XY,YX,YY. For telescope data pol=0,1 represents X,Y. - Depending on the type of data, IORT is the interferometer or telescope -number. (The former is difficult to interpret; rather use the SELECT_IFRS -parameter if you want to select interferometers.) - The cut SEQuence number distinguishes cuts for which all five of the -preceding indices are identical. It is your responsibility to know what the -different seq values represent. - Index values start at zero. (Remember that for the CHN index 0 is the -continuum channel.) -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} - You may select SETS of cuts for processing through [ranges of] values -for the ive indices, e.g. -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} - 2.3-5:2.*.1-7.*.2 -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} -The WILDCARD value '*' means 'all'. Each index may also be specified as a -RANGE: <first>-<last>[<:increment>]. Indices omitted are assumed to be '*', -i.e. ...1.0 means *.*.*.1.0. For wildcards at the end the dots may also be -omitted, i.e. 1.0 means 1.0.*.*.* -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} - The notation 3-5:2 stands for 'from 3 through 5 in steps of 2'. The -step must be positive. If it is omitted, it is taken to be 1 (as in '1-7' -above). -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} - Multiple cut SETS may be specified, separated by comma's: -<Set1>,<Set2>,... The associated NGF_LOOPS keyword allows even more looping -over index values. -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} -IF YOU WANT TO BE REMINDED OF WHAT CUTS ARE IN YOUR FILE: - Type O or L in response to this prompt to get an Overview or Layout - of your .NGF file. -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} -IF YOU DO NOT YET FEEL COMFORTABLE WITH THESE CONCEPTS MORE HELP IS PROVIDED: - type '' or '>' to be prompted for each of the 6 indices separately, - with more specific explanation per index. -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} -IF YOU GET BORED WITH 6-NUMBER INDICES: - Absolute Cut nrs '#<n>' can be used as an alternative. -\end{verbatim}\svend -\spend - diff --git a/src/doc/intfc/ngids_private_intfc.tex b/src/doc/intfc/ngids_private_intfc.tex deleted file mode 100644 index d4aa1167dc2bb1ebd6d27a1493aea3b8b886da85..0000000000000000000000000000000000000000 --- a/src/doc/intfc/ngids_private_intfc.tex +++ /dev/null @@ -1,31 +0,0 @@ -% ngids_private_intfc.tex - -\chapter{ Private parameters for program NGIDS} -\tableofcontents - - -\section{ Overview} - - This document contains an overview of the parameter interface of the -program NGIDS. The program also uses a number of public interfaces; references -to these are also \textref{listed}{.public}. - -% \Figref{.ngids.interface} and its companion \figref{.ngids.extract} -%show schematically the various branches of program execution and the -%parameters that %the user must provide to control each of them. - -%\input {../fig/ngids_interface.cap} - - The remainder of the document describes the individual parameters in -alphabetical order. This description centers on the Help texts, which have been -designed to guide the user to the proper choice at each junction, even if his -knowledge of the overall workings of the program is only superficial. - - -\section{ Descriptions of the individual parameters} -\label{.descriptions} - -\subsection{ References to public interfaces} -\label{.public} - -\input {ngids_private_keys.tef} diff --git a/src/doc/intfc/ngids_private_keys.tef b/src/doc/intfc/ngids_private_keys.tef deleted file mode 100644 index 4f5652b30e296085d4e659cecbd22b00fb7e2b91..0000000000000000000000000000000000000000 --- a/src/doc/intfc/ngids_private_keys.tef +++ /dev/null @@ -1,370 +0,0 @@ - -%\section{ References to public interfaces} -%\label{.public} - -% \input ngids.tmp.ref.1 -{\em See also:} -\begin{itemize} -\item \textref{DWARF}{introduction.user.interface} user interface -\item \textref{NGEN}{ngen_public_intfc} public keywords -\item \textref{NMODEL}{nmodel_public_intfc} public keywords -\item \textref{SCNNODE}{scnnode_public_intfc} public keywords -\item \textref{SCNSETS}{scnsets_public_intfc} public keywords -\item \textref{SELECT}{select_public_intfc} public keywords -\item \textref{WMPNODE}{wmpnode_public_intfc} public keywords -\item \textref{WMPSETS}{wmpsets_public_intfc} public keywords -\end{itemize} - - - -\subsection{ Parameter ALL\_CHAN} -\label{.all.chan} - -\spbegin -{\em Prompt:} Propagate flag changes to all channels (Yes/No)?\\ -{\em Expected input:} Yes/No: 1 value -\spend -\spbegin -\svbegin\begin{verbatim} -If you answer Yes to this prompt, each flag will be set for all channels. That -is: If you set a flag in channel <i> it will be copied (in the flag list) to -the corresponding points in all other frequency channels. -\end{verbatim}\svend -\spend - - -\subsection{ Parameter ALL\_POLS} -\label{.all.pols} - -\spbegin -{\em Prompt:} Propagate flag changes to all polarisations (Yes/No)?\\ -{\em Expected input:} Yes/No: 1 value -\spend -\spbegin -\svbegin\begin{verbatim} -If you answer Yes to this prompt, each flag will be set for all polarisations. -That is: if you set a flag on an XX visibility it will be copied (in the flag -list) to the corresponding XY, YX and YY visibilities. -\end{verbatim}\svend -\spend - - -\subsection{ Parameter AREA} -\label{.area} - -\spbegin -{\em Prompt:} Display area (l,m, dl,dm)\\ -{\em Expected input:} Integer: 1 to 4 values -\spend -\spbegin -\svbegin\begin{verbatim} -Specify the map area to be displayed. The coordinates are in grid units. (0,0) -is the map centre increase is toward the upper right (decreasing RA, incrasing -DEC). The area is defined by four values: -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} - l,m area centre - dl,dm area size -\end{verbatim}\svend -\spend - - -\subsection{ Parameter BLANK\_FLAGS} -\label{.blank.flags} - -\spbegin -{\em Prompt:} Blank flagged data-points (Yes/No)?\\ -{\em Expected input:} Yes/No: 1 value -\spend -\spbegin -\svbegin\begin{verbatim} -If you answer YES to this prompt, data points that are flagged will be set to -blank in the GIDS window. -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} -A single red overlay plane is used to display flagged data points. This plane -will contain the flags for the last plane loaded. The BLANK_FLAGS option allows -you to discern flagged data in other pictures. -\end{verbatim}\svend -\spend - - -\subsection{ Parameter CLIP\_LEVEL} -\label{.clip.level} - -\spbegin -{\em Prompt:} Clip limit for flagging\\ -{\em Expected input:} Real: 1 value -\spend -\spbegin -\svbegin\begin{verbatim} -All visibilities that exceed the limit in the quantity displayed (cf. parameter -DATA_TYPE) will be flagged. Select a suitable level by consulting the display. -The colour bar to the left is annotated with values and you the pixel value -pointed at by the cursor is shown in the upper left corner. -\end{verbatim}\svend - {\em see parameter \textref{DATA\_TYPE}{.data.type} } -\spend - - -\subsection{ Parameter DATA\_TYPE} -\label{.data.type} - -\spbegin -{\em Prompt:} Select visibility component to display\\ -{\em Expected input:} Character *16: 1 value -\spend -\spbegin -\svbegin\begin{verbatim} -Specify how to display complex visibility values -\end{verbatim}\svend -\spend - - -\subsection{ Parameter MAP\_COMPRESS} -\label{.map.compress} - -\spbegin -{\em Prompt:} display-size compression factor\\ -{\em Expected input:} Integer: 1 value -\spend -\spbegin -\svbegin\begin{verbatim} -For a value N, the points in a N*N box are averaged into a single display -point. . Example: - A 1024*1024 map loaded with N=2 will result in a 512*512 image. -\end{verbatim}\svend -\spend - - -\subsection{ Parameter MAP\_RANGE} -\label{.map.range} - -\spbegin -{\em Prompt:} Data-value range for diaplay\\ -{\em Expected input:} Real: 1 to 2 values -\spend -\spbegin -\svbegin\begin{verbatim} -Data values outside the limuts will be truncated to the coresponding limit. -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} -By choosing suitable limits you can concentrate the display on a particular -range of intensities in the map. The defaults shown are the extremes in the -image to be displayed. -\end{verbatim}\svend -\spend - - -\subsection{ Parameter MAP\_SEQUENCES} -\label{.map.sequences} - -\spbegin -{\em Prompt:} Display-plane range to delete\\ -{\em Expected input:} Integer: 1 to 2 values -\spend -\spbegin -\svbegin\begin{verbatim} -The display planes are numbered sequentially in the order in which they were -loaded. You may specify here the first and last value for a range of planes -that will be removed from the GIDS display memory. -\end{verbatim}\svend -\spend - - -\subsection{ Parameter NEXT} -\label{.next} - -\spbegin -{\em Prompt:} Load next picture\\ -{\em Expected input:} Character *5: 1 value -\spend -\spbegin -\svbegin\begin{verbatim} -This prompt appears after the loading of a picture. NGIDS will wait for your -reply while you may manipulate the GIDS display. Your reply options are: -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} - YES Load next picture, then return with this prompt - NO Quit loading, return to OPTION prompt - ALL Load all remaining pictures without intervening consultations -\end{verbatim}\svend -\spend - - -\subsection{ Parameter OPTION} -\label{.option} - -\spbegin -{\em Prompt:} action\\ -{\em Expected input:} Character *24: 1 value -\spend -\spbegin -\svbegin\begin{verbatim} -Specify the action to perform. -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} - Loading/unloading visibility data or images for half-tone/colour display. The - visibility 'planes' or images that you select are stored in display memory - for rapid access. The number of pictures that you can store is limited by the - availablity of this memory. -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} - MAP Load images(s) from map (.WMP) files. - DATA Load (corrected) data from visibility (.SCN) files -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} - Select mode for flagging of visibility data on the display. The flags you set - will not yet be written back to the .SCN file, so you can freely experiment. -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} - DOFLAG Switch to Flagging mode for .SCN-file visibilities - CLIPFLAG Switch to Flagging mode using cliplevels - FLAG Flagging in .WMP maps using the PGPLOT cursor in GIDS -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} - Saving the flags you set on your display: -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} - UNLOAD Save flags list in a .FLF (binary file), from which you can - then transfer to the .SCN file through NFLAG LOAD. - WRITE Save flags list in an ASCII file, which you may manually - edit before transferringt it to the .SCN file through NFLAG - READ. - CLEAR Clear flags list. -\end{verbatim}\svend - {\em see - \textref{NFLAG OPS\_FLIST}{nflag\_private\_keys.ops.flist} - parameter }\ -\spend -\spbegin -\svbegin\begin{verbatim} - Terminate current action sequence: -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} - GCLEAR Remove a sequence of loaded pictures. - NOFLAG Switch back to normal display mode. - QUIT Leave NGIDS (the GIDS window will remain on the screen). -\end{verbatim}\svend -\spend - - -\subsection{ Parameter OUTPUT\_FILE} -\label{.output.file} - -\spbegin -{\em Prompt:} (output filename)\\ -{\em Expected input:} Character *80: 1 value -\spend -\spbegin -\svbegin\begin{verbatim} - Specify the full name for the output disk-file. -\end{verbatim}\svend -\spend - - -\subsection{ Parameter PLOT\_TYPE} -\label{.plot.type} - -\spbegin -{\em Expected input:} Character *16: 1 value -\spend -\spbegin -\svbegin\begin{verbatim} -In displaying visibilities, you can choose between three two-dimensional cross -sections: -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} - IFRS Hour angle (horizontal) versus interferometer (vertical), one picture - per frequency channel. Interferometers in the order - .... -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} - BASE As IFRS, but interferometers in order of increasing baseline, - and of - increasing East telecope number within sets of redundant baselines. -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} - CHAN Hour angle (horizontal) versus frequency channel (vertical), one - picture per interferometer. -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} -NOTE: - You select the channels to be displayed through the SCN_SETS parameter, -in the form <grp>.<obs>.<fld>.<CHN>. You have the liberty to select SCN_SETS -with channels for more than one <grp>.<obs>.<fld>. You may think of some good -use of this option (e.g. displaying the same channel for all fields in a -mosaic). -\end{verbatim}\svend -\spend - - -\subsection{ Parameter USER\_FLAG} -\label{.user.flag} - -\spbegin -{\em Prompt:} Flags to use\\ -{\em Expected input:} Character *16: 1 to 16 values -\spend -\spbegin -\svbegin\begin{verbatim} -Each of the flagging modes (parameter OPTION, options FLAG, DOFLAG, CLIPFLAG) -uses a specific flag type by default. You may define here one ore more flags to -use instead. The use foreseen for this option is to experiment using one of -'user' flags without getting the experimental settings tangled up with settings -already in existence. -\end{verbatim}\svend - {\em see parameter \textref{OPTION}{.option} } -\spend -\spbegin -\svbegin\begin{verbatim} - NONE revert to default types per flagging mode - ALL or * use all flag types (not a very sensible idea) -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} - MAN use the flag type for the MANUAL class of operations - CLIP use the flag type for the CLIP class of operations - NOISE use the flag type for the NOISE class of operations - SHAD use the flag type for the SHADOW class of operations - ADD use the flag type for the ADDITIVE class of operations -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} - U1 use a separate flag for some user-defined operations - U2 use a separate flag for some user-defined operations - U3 use a separate flag for some user-defined operations -\end{verbatim}\svend -\spend - diff --git a/src/doc/intfc/nmap_private_intfc.tex b/src/doc/intfc/nmap_private_intfc.tex deleted file mode 100644 index 1c909090a0e9cc51f5ad935c67a9217b4adf1d15..0000000000000000000000000000000000000000 --- a/src/doc/intfc/nmap_private_intfc.tex +++ /dev/null @@ -1,57 +0,0 @@ -% nmap_private_intfc.tex - -\chapter{ Private parameters for program NMAP} -\tableofcontents - - -\section{ Overview} -\label{.overview} - - This document contains an overview of the parameter interface of the -program NMAP. The program also uses a number of public interfaces; references -to these are also \textref{listed}{.public}. - - - Apart from a number of utility options, the main functions of NMAP are -the making of maps from .SCN files (option MAKE) and manipulating these maps in -various ways (option FIDDLE). - - "Roadmap"-style overviews for the entire parameter interface are shown -in \textref{below}{.diagrams}. - - The remainder of the document describes the individual parameters in -alphabetical order. This description centers on the Help texts, which have been -designed to guide the user to the proper choice at each junction, even if his -knowledge of the overall workings of the program is only superficial. - - - -\section{ Interface diagrams} -\label{.diagrams} - - The first diagram, an synopsis of NMAP's parameter interface, does not -yet exist. Following that diagram several sub-diagrams are planned, of which -those for the FIDDLE and utility options still have to be made. - - \Figref{.nmap.make} shows the parameter interface for MAKE. Two detours -in this interface, for parameters QMAPS and QDATAS, are normally bypassed; they -are shown in \figref{.nmap.make.q}. - - Included in these diagrams are NMAP's public parameters. These are -interleaved with the private ones so they can not be diagrammed as a separate -unit. In fact, the only reason that they are public is that the NCLEAN -\textref{'data clean'}{nclean_descr.data.clean} operation uses them. This use -is indicated on the right-hand side of \figref{.nmap.make} and -\figref{.nmap.make.q}. - -\input{nmap_make.cap} -\input{nmap_make_q.cap} -\input{nmap_handle.cap} - -\section{ Descriptions of the individual parameters} -\label{.descriptions} - -\subsection{ References to public interfaces} -\label{.public} - -\input {nmap_private_keys.tef} diff --git a/src/doc/intfc/nmap_private_keys.tef b/src/doc/intfc/nmap_private_keys.tef deleted file mode 100644 index a895fc9273d867c60ff41730b44ea559b5f74eeb..0000000000000000000000000000000000000000 --- a/src/doc/intfc/nmap_private_keys.tef +++ /dev/null @@ -1,1470 +0,0 @@ - -%\section{ References to public interfaces} -%\label{.public} - -% \input nmap.tmp.ref.1 -{\em See also:} -\begin{itemize} -\item \textref{DWARF}{introduction.user.interface} user interface -\item \textref{MDLNODE}{mdlnode_public_intfc} public keywords -\item \textref{NGEN}{ngen_public_intfc} public keywords -\item \textref{NMAP}{nmap_public_intfc} public keywords -\item \textref{NMODEL}{nmodel_public_intfc} public keywords -\item \textref{NSHOW}{nshow_public_intfc} public keywords -\item \textref{SCNNODE}{scnnode_public_intfc} public keywords -\item \textref{SCNSETS}{scnsets_public_intfc} public keywords -\item \textref{SELECT}{select_public_intfc} public keywords -\item \textref{UNIT}{unit_public_intfc} public keywords -\item \textref{WMPNODE}{wmpnode_public_intfc} public keywords -\item \textref{WMPSETS}{wmpsets_public_intfc} public keywords -\end{itemize} - - - -\subsection{ Parameter AREA} -\label{.area} - -\spbegin -{\em Prompt:} Area: l,m, dl,dm\\ -{\em Expected input:} Integer: 1 to 4 values -\spend -\spbegin -\svbegin\begin{verbatim} -Specify the area to be selected: -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} - l, m position in grid spacings of centre of area - 0,0 is the map centre, increaing toward the upper right (i.e. - with DEcreasing RA and INcreasing DEC) -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} - dl, dm horizontal and vertical area sizes -\end{verbatim}\svend -\spend - - -\subsection{ Parameter BAS\_RESOLUTION} -\label{.bas.resolution} - -\spbegin -{\em Prompt:} Baseline averaging interval (m)\\ -{\em Expected input:} Real: 1 value -\spend -\spbegin -\svbegin\begin{verbatim} -Specify the width in metres of baseline over which visibilities will be -averaged. -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} -The minimum value is 9, representing the smallest baseline increment ever -present in practice in a (set of) WSRT observation(s). The maximum is -(arbitrarily) fixed at 300. -\end{verbatim}\svend -\spend - - -\subsection{ Parameter CLIPPING} -\label{.clipping} - -\spbegin -{\em Prompt:} Clipping?\\ -{\em Expected input:} Yes/No: 1 value -\spend -\spbegin -\svbegin\begin{verbatim} -'Clipping' means discarding data in a certain annulus that fall within a -certain range of values (yet to be specified). -\end{verbatim}\svend - {\em parameters \textref{CLIP\_AREA}{.clip.area}, - \textref{CLIP\_LEVELS}{.clip.levels} } -\spend -\spbegin -\svbegin\begin{verbatim} -It is a simple (and primitive) method of eliminating data affected by strong -interference. (Note that NFLAG provides a much wider scala of operations to -find and suppress interference.) -\end{verbatim}\svend -\spend - - -\subsection{ Parameter CLIP\_AREA} -\label{.clip.area} - -\spbegin -{\em Prompt:} UV-radius range for clipping (m)\\ -{\em Expected input:} Real: 1 to 2 values -\spend -\spbegin -\svbegin\begin{verbatim} -Specify the (circular) UV-plane radii (in metres) between which you want to -clip the data. The default is to clip everywhere. -\end{verbatim}\svend -\spend - - -\subsection{ Parameter CLIP\_LEVELS} -\label{.clip.levels} - -\spbegin -{\em Prompt:} Amplitude range to be discarded\\ -{\em Expected input:} Real: 1 to 2 values -\spend -\spbegin -\svbegin\begin{verbatim} -Specify amplitude range (in Westerbork Units) of visibility magnitudes that you -want to discard. -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} -In the annulus defined by CLIP_AREA, values between the limits you specify will -be discarded. -\end{verbatim}\svend - {\em parameter \textref{CLIP\_AREA}{.clip.area} } -\spend -\spbegin -\svbegin\begin{verbatim} -NOTE: It would be more natural to define a range within which visibilities are -considered valid. As it is, only the lower limit is actually useful, allowing -you to define a rejection threshold for interference. To do so, specify your -threshold for the lower and 'infinity' for the upper limit, e.g. -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} - <threshold>,100000 -\end{verbatim}\svend -\spend - - -\subsection{ Parameter COMMENT} -\label{.comment} - -\spbegin -{\em Prompt:} FITS comment ($<$\\ -{\em Expected input:} Character *70: 1 value -\spend -\spbegin -\svbegin\begin{verbatim} -The given text will be included as COMMENT in FITS output. -\end{verbatim}\svend -\spend - - -\subsection{ Parameter CONVOLVE} -\label{.convolve} - -\spbegin -{\em Prompt:} Convolution type\\ -{\em Expected input:} Character: 1 value -\spend -\spbegin -\svbegin\begin{verbatim} -This is the interpolation function to be used in horizontally and vertically -interpolating the observed visibilities onto the rectangular grid to be used in -the Fast Fourier Transform. -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} -The choice of function determines the detailed aliasing properties of the -map(s). NMAP chooses appropriate horizontal and vertical width parameters for -each. You may specify one of the following functions: -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} - Gaussian-based: -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} - EXPSINC Sinc*exp on 6*6 grid points: An 'approximation' to the ideal - sinc (=sin(x)/x) function. This is the function selected as the - default for map-making after extensive experience with all of - the options available here. - GAUSS Gaussian type over 4*4 grid points: The function used in the - first years of WSRT operations; it was later replaced by the - prolate spheroids. The expense in computing time is the same as - for P4ROL. -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} - Prolate spheroids: These function minimise the 'power' (= the integral of the - intensity squared) 'aliased in' from sources outside the map -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} - P4ROL Prolate spheroidal function with 4*4 grid points. - P6ROL Prolate spheroidal function with 6*6 grid points: By using more - points in the interpolation, this function pushes the aliasing - down considerably, - at the expense of a factor two or more in - computing time for the interpolation -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} -All the above functions may also be used in constructing a UV-plane for display -(UV_COORDINATES=UV). -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} -For plotting visibilities versus baseline or interferometer -(UV_COORDINATES=BASHA or IFRHA), they are of little use, and the default one -would normally select is -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} - BOX Shift to nearest grid point. -\end{verbatim}\svend - {\em see parameter \textref{UV\_COORDINATES}{.uv.coordinates} } -\spend - - -\subsection{ Parameter CSUM\_FACTORS} -\label{.csum.factors} - -\spbegin -{\em Prompt:} Summing multipliers\\ -{\em Expected input:} Real: 1 to 16 values -\spend -\spbegin -\svbegin\begin{verbatim} -Specify up to 8 complex weight factors by which the input maps have to be -multiplied. For each factor the real part should be given first, the imaginary -next. So 1,0,0,-1 means add the real part of the first map-pair to the -imagingary part of the second map-pair: -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} - (1+0*i)*(map1r + i*map1i) + (0-1*i)*(map2r + i*map2i) -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} -If the number of weights you give is less than the number of maps to be -combined, the weights will re-used in a cyclic fashion. Example: - 1,1,-1,-1 will average the first, third, ... pairs in your WMP_SETS -specification with the negated second, fourth ... pairs. -\end{verbatim}\svend -\spend - - -\subsection{ Parameter CUBIC} -\label{.cubic} - -\spbegin -{\em Prompt:} Make line cube (Yes/No) ?\\ -{\em Expected input:} Yes/No: 1 value -\spend -\spbegin -\svbegin\begin{verbatim} -Specify if you want to output the FITS maps in one cube or in separate maps -\end{verbatim}\svend -\spend - - -\subsection{ Parameter DATA\_ACTION} -\label{.data.action} - -\spbegin -{\em Prompt:} Action to perform on the data\\ -{\em Expected input:} Character *8: 1 value -\spend -\spbegin -\svbegin\begin{verbatim} -Specify action to perform: -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} - SHOW show detailed map data -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} - NOISE calculate noise - OFFSET calculate noise and offset -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} - QUIT quit data part -\end{verbatim}\svend -\spend - - -\subsection{ Parameter DATA\_TYPE} -\label{.data.type} - -\spbegin -{\em Prompt:} Data transformation for display\\ -{\em Expected input:} Character: 1 value -\spend -\spbegin -\svbegin\begin{verbatim} -Specify how to transform the complex input visibilities. NORMAL is the default; -the others are for special experiments and diagnostics only. -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} - NORMAL Complex value -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} - COS Real part - SIN Imaginary part -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} - AMPL Amplitude - PHASE Phase -\end{verbatim}\svend -\spend - - -\subsection{ Parameter DECONVOLVE} -\label{.deconvolve} - -\spbegin -{\em Prompt:} Correct map for convolution taper (Yes/No) ?\\ -{\em Expected input:} Yes/No: 1 value -\spend -\spbegin -\svbegin\begin{verbatim} -The interpolation (convolution) in the visibility domain results in a -multiplication ('tapering') of the output map(s) and antenna pattern(s) by the -Fourier transform of the convolving function; i.e., toward the edge of the map -the sources, sidelobes and grating responses appear weaker than they actually -are. -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} -By default this effect will be corrected for by dividing the map through the -taper. A side effect of this correction is that the noise, which is uniform -over the whole uncorrected map, is amplified toward the map edges. -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} -Here you are given the option to bypass this correction. e.g. because uniform -noise is more important for your application than source fluxes. -\end{verbatim}\svend -\spend - - -\subsection{ Parameter FIDDLE\_OPTION} -\label{.fiddle.option} - -\spbegin -{\em Prompt:} Fiddle action|\\ -{\em Expected input:} Character *8: 1 value -\spend -\spbegin -\svbegin\begin{verbatim} -Specify action to perform. -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} - In-place modifications: Modify data of (an) input image(s): -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} - BEAM correct map for primary beam attenuation so it will represent - the 'true' sky - DEBEAM apply primary beam attenuation to map so it will reprsent the - product of the 'true' sky and the primary beam - FACTOR multiply image with a constant factor -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} - Unary operations: Create 1 new image from each input image: -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} - EXTRACT extract an area from (a) image(s) - COPY copy image(s) - LOAD read or write (an) image(s) in a foreign format (e.g. Holog) -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} - Binary combinations: make (a) new output image(s) from (a) pair(s) of input - images: -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} - ADD weighted sum of two images: F1*image1 + F2*image2 - AVER weighted average of two images: - (F1*image1 + F2*image2) / [abs(F1) + abs(F2)] - POL degree of linear polarisation from Q and U maps: - sqrt (Qmap**2 + Umap**2)] - ANGLE polarisation orientation (radians) from Q and U maps: - 0.5*atan (Umap / Qmap) -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} - Combinations of more than two images: -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} - SUM weighted summation of (a) set(s) of images in a single .WMP file - (you will be prompted to select the weighing method) - CSUM weighted summation of pairs of images. You will be prompted - for (a) set(s) of "real" images and (a) set(s) of - "imaginary" images and complex weighting factors. - RSUM idem, but the complex weighting factors will be calculated - based on a specified rotation measure. - MOSCOM 'mosaic combine': merge a set of maps (generally for different - field centres) into one output map -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} - Miscellaneous: -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} - QUIT Return to OPTIONS level -\end{verbatim}\svend -\spend - - -\subsection{ Parameter FIELD\_CENTRE} -\label{.field.centre} - -\spbegin -{\em Prompt:} Field centre: RA,DEC (decimal deg)\\ -{\em Expected input:} DoublePrecision: 1 to 2 values -\spend -\spbegin -\svbegin\begin{verbatim} -Specify the map centre wanted in the apparent-coordinate frame. -Default is the fringe-stopping centre. -\end{verbatim}\svend -\spend - - -\subsection{ Parameter FIELD\_SHIFT} -\label{.field.shift} - -\spbegin -{\em Prompt:} l,m field shift (arcsec)\\ -{\em Expected input:} Real: 1 to 2 values -\spend -\spbegin -\svbegin\begin{verbatim} -Specify the field-centre shift in l,m coordinates. -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} -(l,m) are 'horizontal' and 'vertical' Cartesian coordinates in a plane tangent -to the celestial sphere at the reference centre. The coordinate system is -B1950/J2000 or apparent as defined by your value for parameter MAP_COORD. -\end{verbatim}\svend - {\it See \textref{MAP\_COORD}{.map.coord}, - \textref{REF\_COORD}{.ref.coord} } -\spend -\spbegin -\svbegin\begin{verbatim} -If you enter a null value (\ or ""), you will be prompted for a FIELD_CENTRE -instead. This option is intended for instrumental test programs only and has -not been tested for general applications; use it at your own risk if you wish. -\end{verbatim}\svend -\spend - - -\subsection{ Parameter FIELD\_SIZE} -\label{.field.size} - -\spbegin -{\em Prompt:} Fieldsize l,m (deg)\\ -{\em Expected input:} Real: 1 to 2 values -\spend -\spbegin -\svbegin\begin{verbatim} -Specify the l and m field size of the map to be transformed. The default will -produce a map with a resolution of about 3.5 grid intervals per -synthesized-beam half-width. -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} -If you give a NULL answer (two double quotes), you will be prompted for the -grid steps. -\end{verbatim}\svend -\spend - - -\subsection{ Parameter FILENAME} -\label{.filename} - -\spbegin -{\em Prompt:} Name for output disk file\\ -{\em Expected input:} Character *80: 1 value -\spend -\spbegin -\svbegin\begin{verbatim} -Specify the file name (without an extension) to be used in creating a -pseudo-tape output file name (e.g. FITS write). -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} -Specify a full filename otherwise (e.g. LOAD/UNLOAD in FIDDLE). -\end{verbatim}\svend -\spend - - -\subsection{ Parameter FITS\_SCALE} -\label{.fits.scale} - -\spbegin -{\em Prompt:} Units of source flux\\ -{\em Expected input:} Character *4: 1 value -\spend -\spbegin -\svbegin\begin{verbatim} -Specify the output units of the FITS data: -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} - JY jansky per beam - WU Westerbork units (1 W.U. = 5 mJy) -\end{verbatim}\svend -\spend - - -\subsection{ Parameter FT\_SIZE} -\label{.ft.size} - -\spbegin -{\em Prompt:} FFT size\\ -{\em Expected input:} Integer: 1 to 2 values -\spend -\spbegin -\svbegin\begin{verbatim} -Specify the size of the Fourier transform in the horizontal and vertical -directions. -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} -If the size in both direction is <= 17, a Direct Fourier Transform (DFT) will -be made instead of the standard operation of interpolating onto a rectangular -grid followed by a Fast Fourier Transform (FFT). -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} -The standard operation suffers from 'aliasing' artefacts associated with the -periodic nature of the FFT. These artefacts are suppressed, to a level that is -generally acceptable, through a very careful choice of the convolution function -used in the interpolstion to a rectangular grid, but they cannot be avoided -completely. -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} -By avoiding the interpolation altogether, the DFT method is free from these -aliasing effects. -\end{verbatim}\svend -\spend - - -\subsection{ Parameter GRID\_SIZE} -\label{.grid.size} - -\spbegin -{\em Prompt:} Grid interval in l,m (arcsec)\\ -{\em Expected input:} Real: 1 to 2 values -\spend -\spbegin -\svbegin\begin{verbatim} -Specify the l and m grid steps in arcseconds for the map to be made. -In most applications you may define GRID_SIZE as you please. NOTE however, that -any number of maps that you want to combine into a single mosaic (FIDDLE MOSCOM -option) must all share the same GRID_SIZE (as well as the same reference -coordinates, parameters MAP_COORD and REF_COORD) -\end{verbatim}\svend - {\em See \textref{MAP\_COORD}{.map.coord}, - \textref{REF\_COORD}{.ref.coord} } -\spend - - -\subsection{ Parameter HA\_RESOLUTION} -\label{.ha.resolution} - -\spbegin -{\em Prompt:} Hour-angle averaging interval (UT seconds)\\ -{\em Expected input:} Real: 1 value -\spend -\spbegin -\svbegin\begin{verbatim} -Specify the width in UT degrees of hour angle over which visibilities will be -averaged (to reduce the noise per plotted point). -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} -Note: Observations are taken at multiples of 10 UT seconds and it is - therefore convenient to specify this parameter in UT seconds as well. - The number you specify will be converted to a sidereal hour-angle - interval. -\end{verbatim}\svend -\spend - - -\subsection{ Parameter IFR\_RESOLUTION} -\label{.ifr.resolution} - -\spbegin -{\em Prompt:} Interferometer separation\\ -{\em Expected input:} Real: 1 value -\spend -\spbegin -\svbegin\begin{verbatim} -Specify the vertical separation in grid points between interferometers -\end{verbatim}\svend -\spend - - -\subsection{ Parameter INPUT\_FILE} -\label{.input.file} - -\spbegin -{\em Prompt:} Input file name\\ -{\em Expected input:} Character *80: 1 value -\spend -\spbegin -\svbegin\begin{verbatim} -Specify the file name (including extension) of the file to be converted. -\end{verbatim}\svend -\spend - - -\subsection{ Parameter INPUT\_LABELS} -\label{.input.labels} - -\spbegin -{\em Prompt:} Input tape labels\\ -{\em Expected input:} Integer: 1 to 256 values -\spend -\spbegin -\svbegin\begin{verbatim} -Specify the tape labels to be read. * specifies all labels on the tape. -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} -Remember that WMP-file images are identified by indices grp.obs.fld.chn.seq). -Each of the selected tape labels will be stored in the WMP-file as a separate -field (FLD) in the group (GRP) being created. The CHN, POL and TYP indices will -reflect the nature of the input data, SEQ will be 0. -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} -Example: - INPUT_LABELS=3,6,8 will cause a new GRP to be created in which these -labels will be stored under the image indices -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} - <newgrp>. 0. <chn for label 3>. <pol for label 3>. <typ for label 3>. 0 - <newgrp>. 1. <chn for label 6>. <pol for label 6>. <typ for label 6>. 0 - <newgrp>. 2. <chn for label 8>. <pol for label 8>. <typ for label 8>. 0 -\end{verbatim}\svend -\spend - - -\subsection{ Parameter LM\_CENTRE} -\label{.lm.centre} - -\spbegin -{\em Prompt:} Output map centre\\ -{\em Expected input:} DoublePrecision: 1 to 2 values -\spend -\spbegin -\svbegin\begin{verbatim} -Specify the centre of the output map in the l and m direction; in arcsec with -respect to the mosaic reference position. -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} -If you specify an *, you will prompted for RA,DEC position -\end{verbatim}\svend -\spend - - -\subsection{ Parameter LOAD\_OPTION} -\label{.load.option} - -\spbegin -{\em Prompt:} Load action/image type |\\ -{\em Expected input:} Character *8: 1 value -\spend -\spbegin -\svbegin\begin{verbatim} -Specify the type of foreign map and what to do with it: -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} - WMP read WMP format maps from contiguous binary file - UNLOAD inverse of WMP: write WMP maps to contiguous binary file - this option can also be used to load in an SAOIMAGE file - (specify a data offset of 512) -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} - NEWHOLOG read HOLOG file from the WSRT (this option, synonymous with - WMP, was added to help the user) - OLDHOLOG read a Holog map in old IBM-coded format (this option used to - be called HOLOG) -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} - QUIT quit LOADing -\end{verbatim}\svend -\spend - - -\subsection{ Parameter MAP\_COORD} -\label{.map.coord} - -\spbegin -{\em Prompt:} Map coordinate system|\\ -{\em Expected input:} Character *12: 1 value -\spend -\spbegin -\svbegin\begin{verbatim} -Specify the coordinate system for the map. -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} -There are two choices to be made: The first is whether the map is to be made in -apparent coordinates for the epoch of the observation or in fixed-epoch -coordinates. The latter are fixed for each instrument: B1950 for the WSRT, -J2000 for the ATNF. The second choice is whether the 'reference position' for -the map must coincide with the fringe-stopping centre or is to be specified by -you. -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} -The reference position is the position at which the map plane is tangent to the -celestial sphere; it defines the geometry of the map's (l,m) grid in terms of -RA and DEC. -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} -The reference position is important for mosaic mapping: The FIDDLE/MOSCOM -operation that combines mosaic subfields into a single large map will only work -if all input maps have the same reference. -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} -For a single mosaic, the program by default uses the mosaic centre as the -reference for all subfield maps. However, if you intend to combine multiple -mosaics into a 'super-mosaic', only you can define the common reference centre -that will be needed. -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} -You have the following options for your reply: -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} - Reference position defined by the observation (i.e. coinciding with the - fringe stopping centre): -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} - B1950_J2000 in epoch coordinates for the epoch defined by the - instrument with which the observation was made: - B1950 for the WSRT - J2000 for the ATNF -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} - APPARENT in apparent coordinates at the time of observation -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} - Reference position to be defined by the user through an additional parameter - REF_COORD: -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} - REFER in B1950_J2000 coordinates -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} - AREFER in APPARENT coordinates. Note that this will not work for -\end{verbatim}\svend -\spend - - -\subsection{ Parameter MAP\_FACTORS} -\label{.map.factors} - -\spbegin -{\em Prompt:} Input-map multipliers\\ -{\em Expected input:} Real: 1 to 2 values -\spend -\spbegin -\svbegin\begin{verbatim} -Specify the factors by which the input maps have to be multiplied. -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} -You may specify up to 8 factors which will be used as multipliers in the -weighted summation the input maps you selected. If there are more maps to be -summed than factors specified, the factors will be cyclically re-used. -\end{verbatim}\svend -\spend - - -\subsection{ Parameter MAP\_LEVEL} -\label{.map.level} - -\spbegin -{\em Prompt:} Polarisation threshold (W.U)\\ -{\em Expected input:} Real: 1 value -\spend -\spbegin -\svbegin\begin{verbatim} -Specify the minimum level in Wetsrebork Units that is still to be considered -valid linear polarisation. Polarisation levels below this threshold will be set -to zero in the output map(s). -\end{verbatim}\svend -\spend - - -\subsection{ Parameter MAP\_POLAR} -\label{.map.polar} - -\spbegin -{\em Prompt:} Select 1 to 4 output-map polarisation(s)|\\ -{\em Expected input:} Character *4: 1 to 4 values -\spend -\spbegin -\svbegin\begin{verbatim} -Specify up to four polarisations for the maps to make: -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} - XX XX only - XY XY only - YX YX only - YY YY only -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} - I Stokes I - L 'line' Stokes I: Incomplete input data (e.g. no valid XX or YY) - will be filled in aassuming that the field is unpolarised - (Q=U=V=0) - Q Stokes Q - U Stokes U - V Stokes V -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} -Each of the above may be suffixed with 'I' to indicate that visibilities must -be pre-multiplied with sqrt(-1) -\end{verbatim}\svend -\spend - - -\subsection{ Parameter OLD\_DATTYP} -\label{.old.dattyp} - -\spbegin -{\em Prompt:} Old R-series data format\\ -{\em Expected input:} Integer: 1 value -\spend -\spbegin -\svbegin\begin{verbatim} -Specify the old R-series data type: -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} - 0 local - 1 VAX, D_FORMAT - 2 VAX, G_FORMAT - 3 ALLIANT - 4 CONVEX - 5 IEEE - 6 DEC station - 7 SUN station - 8 HP station -\end{verbatim}\svend -\spend - - -\subsection{ Parameter OPTION} -\label{.option} - -\spbegin -{\em Prompt:} Action|\\ -{\em Expected input:} Character *8: 1 value -\spend -\spbegin -\svbegin\begin{verbatim} -Specify action to perform: -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} - Primary operations: - MAKE make map(s) from visibility data in .SCN file - FIDDLE combine or change maps in .WMP file -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} - FITS conversions: - W16FITS write FITS tape/disk with 16 bits data - W32FITS write FITS tape/disk with 32 bits data - WRLFITS write FITS tape/disk with 32 bits float data - RFITS read FITS tape/disk data -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} - Miscellaneous: - SHOW show/edit map data - QUIT finish -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} - Format conversions: - CVX convert a map file from other machine's format to local - machine's - NVS convert a map file to newest version. Needs to be run only if - indicated by program - FROM_OLD convert from R-series format - TO_OLD convert to R-series format -\end{verbatim}\svend -\spend - - -\subsection{ Parameter OUTPUT} -\label{.output} - -\spbegin -{\em Expected input:} Character *8: 1 to 8 values -\spend -\spbegin -\svbegin\begin{verbatim} -Specify one or more output types: -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} - Standard image types for map-making: - MAP Output (a) map(s) - AP Output (an) antenna pattern(s) -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} - Visibility-domain outputs, for diagnostics only: - COVER Output the 'antenna-pattern' convolved visibilities -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} - REAL Output the real part of the convolved visibilities - IMAG Output the imaginary part of the convolved visibilities -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} - AMPL Output the amplitude of the convolved visibilities - PHASE Output the phase of the convolved visibilities -\end{verbatim}\svend -\spend - - -\subsection{ Parameter OUTPUT\_LABEL} -\label{.output.label} - -\spbegin -{\em Prompt:} Output label\\ -{\em Expected input:} Integer: 1 value -\spend -\spbegin -\svbegin\begin{verbatim} -Specify the first output tape label. If this label already exists, it and all -the subsequent labels will be overwritten. -Specify * or 0 to write the new label behind all existing ones. -\end{verbatim}\svend -\spend - - -\subsection{ Parameter OUT\_CENTRE} -\label{.out.centre} - -\spbegin -{\em Prompt:} Output map centre\\ -{\em Expected input:} Integer: 1 to 2 values -\spend -\spbegin -\svbegin\begin{verbatim} -Specify the centre of the output map in the l and m direction in pixels with -respect to the mosaic reference position. -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} -If you specify an *, you will be prompted for l,m and RA,DEC position -\end{verbatim}\svend -\spend - - -\subsection{ Parameter OUT\_SIZE} -\label{.out.size} - -\spbegin -{\em Prompt:} Output map size\\ -{\em Expected input:} Integer: 1 to 2 values -\spend -\spbegin -\svbegin\begin{verbatim} -Specify the size in grid points of the output map(s) in the horizontal and -vertical directions. -\end{verbatim}\svend -\spend - - -\subsection{ Parameter QDATAS} -\label{.qdatas} - -\spbegin -{\em Prompt:} Special data selection (Yes/No) ?\\ -{\em Expected input:} Yes/No: 1 value -\spend -\spbegin -\svbegin\begin{verbatim} -Maps are normally made directly from the .SCN-file visibilities. Answering YES -here gives you access to some specials including -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} - - making a map from model visibilities in the .SCN file; - - selecting visibilities from an annulus in the UV plane; - - clipping extreme amplitudes in an annulus in the UV plane; - - shifting the pointing centre to which the visibilities refer (and - consequently the centre of the map to be made from them). -\end{verbatim}\svend -\spend - - -\subsection{ Parameter RADEC\_CENTRE} -\label{.radec.centre} - -\spbegin -{\em Prompt:} Output map centre: RA,DEC (decimal deg)\\ -{\em Expected input:} DoublePrecision: 1 to 2 values -\spend -\spbegin -\svbegin\begin{verbatim} -Specify the centre of the output map: RA and DEC in decimal degrees. -\end{verbatim}\svend -\spend - - -\subsection{ Parameter REF\_COORD} -\label{.ref.coord} - -\spbegin -{\em Prompt:} Map reference coordinates: RA,DEC (decimal deg)\\ -{\em Expected input:} DoublePrecision: 1 to 2 values -\spend -\spbegin -\svbegin\begin{verbatim} -Specify (in decimal degrees) the RA and DEC of the reference coordinates to use -in producing the map. The coordinate system is B1950/J2000 or apparent as -defined by your value for parameter MAP_COORD. -\end{verbatim}\svend -\spend - - -\subsection{ Parameter ROTATION\_MEASURE} -\label{.rotation.measure} - -\spbegin -{\em Prompt:} Rotation measure\\ -{\em Expected input:} Real: 1 to 64 values -\spend -\spbegin -\svbegin\begin{verbatim} -Specify one (or more) rotation measure(s) (RM). Pairs of input maps will be -phase-rotated to the the frequency of the first input map and averaged: - THETAn = 2 * RM * ( (c/FRQn)**2 - (c/FRQ1)**2 ) - Qout = SUM( Wn * ( cos(THETAn)*Qn - sin(THETAn)*Un ) ) / SUM( Wn ) - Uout = SUM( Wn * ( sin(THETAn)*Qn + cos(THETAn)*Un ) ) / SUM( Wn ) -A pair of Qout/Uout will be produced for each RM given. E.g. to get average Q/U -maps for rotation measures from 0 to 5 with intervals of 0.5, specify -ROTATION_MEASURE=0 TO 5 BY 0.5. -\end{verbatim}\svend -\spend - - -\subsection{ Parameter SUBTRACT} -\label{.subtract} - -\spbegin -{\em Prompt:} Model subtraction (Yes/No) ?\\ -{\em Expected input:} Yes/No: 1 value -\spend -\spbegin -\svbegin\begin{verbatim} -Reply YES if you want to subtract a source model. You will then be prompted to -provide details on the model you want to subtract. -\end{verbatim}\svend - {\em see the \textref{NMODEL HANDLE}{nmodel\_public\_intfc} interface } -\spend - - -\subsection{ Parameter SUM\_FACTORS} -\label{.sum.factors} - -\spbegin -{\em Prompt:} Summing multipliers\\ -{\em Expected input:} Real: 1 to 8 values -\spend -\spbegin -\svbegin\begin{verbatim} -Specify up to 8 weight factors by which the input maps have to be multiplied. -If the number of weights you give is less than the number of maps to be -combined, the weights will re-used in a cyclic fashion. -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} -Example: - 1,-1 will average the first, third, ... maps in your WMP_SETS -specification with the negated second, fourth ... maps. -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} -Note: When used together with the RSUM option, the weights will be used both -for the Real and Imaginary map (they are real weights). -\end{verbatim}\svend -\spend - - -\subsection{ Parameter SUM\_OPTION} -\label{.sum.option} - -\spbegin -{\em Prompt:} Weighing method\\ -{\em Expected input:} Character *8: 1 value -\spend -\spbegin -\svbegin\begin{verbatim} -Specify the type of weight to use in the averaging. In all cases the summation -produces a weighted average map over all SETS_1, the weights depending on the -method you select: -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} - SUM weight(i)= 1 - NSUM weight(i)= normalisation factor of map(i) - NSSUM weight(i)= 1 / (<noise in map(i)>**2) -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} - BSUM weight(i)= bandwidth of map(i) - BNSUM weight(i)= bandwidth * normalisation factor of map(i) -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} - FSUM weight(i)= factors to be specified by you. -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} - QUIT quit AVERaging -\end{verbatim}\svend -\spend - - -\subsection{ Parameter TAPER} -\label{.taper} - -\spbegin -{\em Prompt:} Taper type\\ -{\em Expected input:} Character *8: 1 value -\spend -\spbegin -\svbegin\begin{verbatim} -The taper is a function of baseline length used to de-emphasize the long -baselines and consequently reduce the near-in sidelobes of the synthesized beam. -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} -You may specify the following functions, some of them to be supplemented later -with a baseline-scale parameter TAPER_VALUE: -\end{verbatim}\svend - {\em see public parameter - \textref{TAPER\_VALUE}{nmap\_public\_intfc.taper.value} } -\spend -\spbegin -\svbegin\begin{verbatim} - GAUSS exp -(<baseline>/TAPER_VALUE)**2 - standard WSRT beam: good compromise between near-in sidelobes, - beam width and noise -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} - LINEAR max (0, 1-baseline/TAPER_VALUE) -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} - OVERR 1 / baseline (no scale) -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} - RGAUSS exp -(<baseline>/TAPER_VALUE)**2 / <baseline> - broader beam, very low near-in sidelobes, poorer noise -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} - NATURAL no taper (no scale) - optimum signal/noise ratio, narrower beam with very strong - near-in sidelobes -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} -NOTES: - Unless you have specified UNIFORM=NATURAL for the UV coverage mode, the - 1/<baseline> density variation of measured visibility points is already - being accounted for, so OVERR and RGAUSS should not be chosen. LINEAR - does not combine very well with NATURAL either. -\end{verbatim}\svend - {\em cf. parameter \textref{UNIFORM}{nmap\_public\_intfc.uniform} } -\spend - - -\subsection{ Parameter USER\_COMMENT} -\label{.user.comment} - -\spbegin -{\em Prompt:} Comment to be included in map header(s) ($<$\\ -{\em Expected input:} Character *24: 1 value -\spend -\spbegin -\svbegin\begin{verbatim} -Give, optionally, a descriptive comment for the maps. -\end{verbatim}\svend -\spend - - -\subsection{ Parameter USER\_DATA} -\label{.user.data} - -\spbegin -{\em Prompt:} Visibilities to use\\ -{\em Expected input:} Character *8: 1 value -\spend -\spbegin -\svbegin\begin{verbatim} -Specify the type of visibilities to use: -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} - STANDARD observed visibilities -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} - MODEL model visibilities (to be specified later with type=0 -sources) -\end{verbatim}\svend -\spend - - -\subsection{ Parameter USE\_NOISE} -\label{.use.noise} - -\spbegin -{\em Prompt:} Weigh with noise (Yes/No) ?\\ -{\em Expected input:} Yes/No: 1 value -\spend -\spbegin -\svbegin\begin{verbatim} -Specify if you want the noise of the individual maps to be used as a weight in -the MOSCOM combination -\end{verbatim}\svend -\spend - - -\subsection{ Parameter UV\_COORDINATES} -\label{.uv.coordinates} - -\spbegin -{\em Prompt:} UV coordinate system\\ -{\em Expected input:} Character *8: 1 value -\spend -\spbegin -\svbegin\begin{verbatim} -Specify the type of UV coordinates wanted for UV-plane type output -\end{verbatim}\svend - {\em \textref{OUTPUT}{.output}: COVER, REAL, IMAG, AMPL, PHASE options } -\spend -\spbegin -\svbegin\begin{verbatim} - UV standard UV coordinates: interferometer tracks are ellipses -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} - BASHA hour-angle (horizontal) and interferometer baseline (vertical) - coordinates: interferometer tracks are horizontal lines; - redundant baselines overlap -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} - IFRHA as BASHA, but vertical axis is the interferometer ordinal number - in the sequence 01,02,...,0D,12,13,...,CD) -\end{verbatim}\svend -\spend - - -\subsection{ Parameter WGT\_LIMIT} -\label{.wgt.limit} - -\spbegin -{\em Prompt:} Relative weight limit\\ -{\em Expected input:} Real: 1 value -\spend -\spbegin -\svbegin\begin{verbatim} -Specifies the relative weight as compared to the expected maximum weight of -data points combined on one line, below which no output will be generated -\end{verbatim}\svend -\spend - - -\subsection{ Parameter WMP\_NODE\_1} -\label{.wmp.node.1} - -\spbegin -{\em Prompt:} First WMP node name\\ -{\em Expected input:} Character *80: 1 value -\spend -\spbegin -\svbegin\begin{verbatim} -Specify the node name for the first Fiddle input set of images. -\end{verbatim}\svend -\spend - - -\subsection{ Parameter WMP\_NODE\_2} -\label{.wmp.node.2} - -\spbegin -{\em Prompt:} Second WMP node name\\ -{\em Expected input:} Character *80: 1 value -\spend -\spbegin -\svbegin\begin{verbatim} -Specify the node name for the second Fiddle input set of images. -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} -Specify * if this is the same as the first node (NODE_1). -\end{verbatim}\svend -\spend - - -\subsection{ Parameter WMP\_SET\_1} -\label{.wmp.set.1} - -\spbegin -{\em Prompt:} First image set(s) to be used: grp.fld.chn.pol.typ.seq\\ -{\em Expected input:} Character *32: 1 to 64 values -\spend -\spbegin -\svbegin\begin{verbatim} -Specify the first image set(s) to be used. -\end{verbatim}\svend -\spend - - -\subsection{ Parameter WMP\_SET\_2} -\label{.wmp.set.2} - -\spbegin -{\em Prompt:} Second image set(s) to be used: grp.fld.chn.pol.typ.seq\\ -{\em Expected input:} Character *32: 1 to 64 values -\spend -\spbegin -\svbegin\begin{verbatim} -Specify the second image Set(s) to be used -\end{verbatim}\svend -\spend - diff --git a/src/doc/intfc/nmap_public_intfc.tex b/src/doc/intfc/nmap_public_intfc.tex deleted file mode 100644 index b617bb0973cb328671dc6c487cf84e8997354760..0000000000000000000000000000000000000000 --- a/src/doc/intfc/nmap_public_intfc.tex +++ /dev/null @@ -1,44 +0,0 @@ -% nmap_public_intfc.tex -% -% History: -% JPH Original -% JPH 960425 Change footnote to text in parentheses" l2h does not handle -% footnotes well - -\chapter{ Public parameter group NMAP} -\tableofcontents - - -\section{ Overview} -\label{.overview} - - This document contains an overview of the public parameter group -NMAP.This group is a subset of the map-making control parameters, viz. -thoseparameters that are also used by NCLEAN in its -\textref{"dataclean"}{nclean_descr.data.clean} operation. - - The accompanying diagrams are to be found in the document -describingNMAP's \textref{private parameters}{nmap_private_intfc}. This -document contiansonly the descriptions of the individual parameters in -alphabetical order. Thesecenter on the Help texts, which have been designed to -guide the user to theproper choice at each junction, even if his knowledge of -the overall workingsof the program is only superficial. - - The prompt and help texts defined for these parameters are those -for NMAP. In the data-clean application, these may be overridden by texts more -appropriate there. Unfortunately, the present architecture of -\NEWSTAR precludes the inclusion of such texts in the documentation system, -so the only opportunity to read that information is during program execution -(in your terminal window!). - -\input {nmap_make_q.cap} - - \Figref{.nmap.make.q} gives a schematic overview of this part of -NMAP'sparameter interface. (The companion diagram to which the figure refers is -irrelevant in the present context, but you may find it in the description of -NMAP's \textref{private interface}{nmap_private_intfc.nmap.make}.) - -\input {nmap_public_keys.tef} - - -\label{.nmap.make} % dummy diff --git a/src/doc/intfc/nmap_public_keys.tef b/src/doc/intfc/nmap_public_keys.tef deleted file mode 100644 index a5d7b1ffbd672d2b6cf35c36b2320b17cc4cde5c..0000000000000000000000000000000000000000 --- a/src/doc/intfc/nmap_public_keys.tef +++ /dev/null @@ -1,220 +0,0 @@ - - -\subsection{ Parameter CWEIGHT\_TYPE} -\label{.cweight.type} - -\spbegin -{\em Prompt:} Circular weight type ({\em may vary per application})\\ -{\em Expected input:} Character *8: 1 value -\spend -\spbegin -\svbegin\begin{verbatim} -ON TOP of the standard taper function which is circular in the equatorial UV -plane, you nay specify a taper that is circular in the projected UV plane (i.e. -the plane as seen from the field centre). You can select one out of the -following functions: -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} - GAUSS exp -(<projected baseline>/CWEIGHT_VALUE)**2 -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} - LINEAR max (0, 1-<projected baseline>/CWEIGHT_VALUE) -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} - NATURAL unity weight everywhere, i.e. no circular taper -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} -NOTE that the circular weighing does not replace the standard tapering, but is -applied as an EXTRA weight function. This is probably not what you want; you -may eliminate the normal tapering by specifying TAPER=NATURAL and -UNIFORM=STANDARD to take into account the radial density dependence of measured -visibilities. -\end{verbatim}\svend -\spend - - -\subsection{ Parameter CWEIGHT\_VALUE} -\label{.cweight.value} - -\spbegin -{\em Prompt:} Circular-weight width (metres) ({\em may vary per application})\\ -{\em Expected input:} Real: 1 value -\spend -\spbegin -\svbegin\begin{verbatim} -Specify the width for your circular weight function. -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} -If you have selected a gaussian for the circular_weight function -(CWEIGHT_TYPE=GAUSS), the value you specify here will be the projected baseline -radius for which the weight is 1/e times its value in the origin. The default -value makes the weight equal to 1/4 at a projected baseline of 3000 m. -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} -If you have selected a triangular weight function (CWEIGHT_TYPE=LINEAR), the -value you specify here is the projected baseline at which the weight reaches -zero. -\end{verbatim}\svend -\spend - - -\subsection{ Parameter MEMORY\_USE} -\label{.memory.use} - -\spbegin -{\em Prompt:} Work memory size ({\em may vary per application})\\ -{\em Expected input:} Integer: 1 value -\spend -\spbegin -\svbegin\begin{verbatim} -Specify an approximate value for the work memory size to be used in the -transform (bytes). -\end{verbatim}\svend -\spend - - -\subsection{ Parameter QMAPS} -\label{.qmaps} - -\spbegin -{\em Prompt:} UV taper/convolution details? ({\em may vary per application})\\ -{\em Expected input:} Yes/No: 1 value -\spend -\spbegin -\svbegin\begin{verbatim} -The standard defaults used for the taper and convolution functions in the -map-making process will produce maps of excellent quality for normal -applications at an acceptable expense of computing resources. -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} -There may be particular situations, however, where a non-standard taper and/or -convolution function is more suitable. Answer YES if you want to make your own -selection out of the possible options. -\end{verbatim}\svend -\spend - - -\subsection{ Parameter TAPER\_VALUE} -\label{.taper.value} - -\spbegin -{\em Prompt:} Taper half-width (metres) ({\em may vary per application})\\ -{\em Expected input:} Real: 1 value -\spend -\spbegin -\svbegin\begin{verbatim} -Specify the baseline in metres of the taper function at which the taper -function will fall to 1/e of its central value. -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} -The default is defined such that the taper function you selected has a value of -1/4 for a baseline length of 3000 m. -\end{verbatim}\svend -\spend - - -\subsection{ Parameter UNIFORM} -\label{.uniform} - -\spbegin -{\em Prompt:} Measure function for UV coverage ({\em may vary per application})\\ -{\em Expected input:} Character *8: 1 value -\spend -\spbegin -\svbegin\begin{verbatim} -Specify the way the UV coverage should be determined: -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} - STANDARD: Weigh each observed point with the track length it covers in - the UV plane, and average sets of redundant baselines. This - method accounts properly for the fact that the density of - measured points is inversely proportional to the baseline, - for the multiplicity of redundant baselines and for - variations in integration times. -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} - FULL: Weigh each point according to the actual UV point density. In - this case care is also taken of all local UV plane density - enhancements, e.g. because there is overlap between - observations. -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} - NATURAL: Take each individual measured point separately, without - weighing for the UV track covered by it. This option gives - the maximum possible signal/noise ratio in your map, but it - generally weighs the short baselines much too heavily which - results in a very fat synthesized beam. -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} -Of these options, FULL gives the cleanest synthesized beam, but it is slower -because it necessitates an extra read pass over the .SCN-file data. -\end{verbatim}\svend -\spend - - -\subsection{ Parameter UV\_AREA} -\label{.uv.area} - -\spbegin -{\em Prompt:} projected UV radius range (metres) ({\em may vary per application})\\ -{\em Expected input:} Real: 1 to 2 values -\spend -\spbegin -\svbegin\begin{verbatim} -Specify the range of PROJECTED baselines for which you want to include the data. -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} -You may use this option, - at the expense of throwing away data -, for such -purposes as -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} - - To make the projected synthesised aperture and hence the synthesised - beam somewhat more circularly symmetric. -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} - - To exclude noise from long projected baselines where you know there is - no signal of interest. -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} - - To eliminate data from the short baselines, e.g. to suppress - interference. -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} -The default is not to eliminate any baselines. -\end{verbatim}\svend -\spend - diff --git a/src/doc/intfc/nmodel_private_intfc.tex b/src/doc/intfc/nmodel_private_intfc.tex deleted file mode 100644 index 386558a263c6a98d34c9c1961df47e3fe14a6746..0000000000000000000000000000000000000000 --- a/src/doc/intfc/nmodel_private_intfc.tex +++ /dev/null @@ -1,31 +0,0 @@ -% nmodel_private_intfc.tex - -\chapter{ Private parameters for program NMODEL} -\tableofcontents - - -\section{ Overview} - - This document contains an overview of the parameter interface of the -program NMODEL. The program also uses a number of public interfaces; references -to these are also \textref{listed}{.public}. - -% \Figref{.nmodel.interface} and its companion \figref{.nmodel.extract} -show %schematically the various branches of program execution and the -parameters that %the user must provide to control each of them. - -%\input {../fig/nmodel_interface.cap} - - The remainder of the document describes the individual parameters in -alphabetical order. This description centers on the Help texts, which have been -designed to guide the user to the proper choice at each junction, even if his -knowledge of the overall workings of the program is only superficial. - - -\section{ Descriptions of the individual parameters} -\label{.descriptions} - -\subsection{ References to public interfaces} -\label{.public} - -\input {nmodel_private_keys.tef} diff --git a/src/doc/intfc/nmodel_private_keys.tef b/src/doc/intfc/nmodel_private_keys.tef deleted file mode 100644 index 0b2c9fa4a57534be3b7e2f84890715e48d7ffebd..0000000000000000000000000000000000000000 --- a/src/doc/intfc/nmodel_private_keys.tef +++ /dev/null @@ -1,11 +0,0 @@ - -%\section{ References to public interfaces} -%\label{.public} - -% \input nmodel.tmp.ref.1 -{\em See also:} -\begin{itemize} -\item \textref{DWARF}{introduction.user.interface} user interface -\end{itemize} - - diff --git a/src/doc/intfc/nmodel_public_intfc.tex b/src/doc/intfc/nmodel_public_intfc.tex deleted file mode 100644 index 6569682dbdc36272a805b1bdfc64f9453db76d27..0000000000000000000000000000000000000000 --- a/src/doc/intfc/nmodel_public_intfc.tex +++ /dev/null @@ -1,36 +0,0 @@ -% nmodel_public_intfc.tex - -\chapter{ Public parameter group NMODEL} -\tableofcontents - - -\section{ Overview} - - This document contains an overview of the public parameter group NMODEL, -(part of) which is included in all those \NEWSTAR programs that manipulate -models in .MDL and/or .SCN files. - -% \Figref{.nmodel.interface} and its companion \figref{.nmodel.handle} -%show schematically the various branches of program execution and the -%parameters -%that the user must provide to control each of them. - -%\input {../fig/nmodel_handle.cap} - - The -%remainder of the -document describes the individual parameters in alphabetical order. This -description centers on the Help texts, which have been designed to guide the -user to the proper choice at each junction, even if his knowledge of the -overall workings of the program is only superficial. - - Please note that the generic prompt and help texts defined for these -parameters are frequently superseded in the actual applications by alternative -texts that are more appropriate to the situation at hand. Unfortunately, the -present architecture of \NEWSTAR precludes the inclusion of such texts in the -documentation system, so the only opportunity to read that information is -during program execution (in your terminal window!). - - - -\input {nmodel_public_keys.tef} diff --git a/src/doc/intfc/nmodel_public_keys.tef b/src/doc/intfc/nmodel_public_keys.tef deleted file mode 100644 index 8b137891791fe96927ad78e64b0aad7bded08bdc..0000000000000000000000000000000000000000 --- a/src/doc/intfc/nmodel_public_keys.tef +++ /dev/null @@ -1 +0,0 @@ - diff --git a/src/doc/intfc/nplot_private_intfc.tex b/src/doc/intfc/nplot_private_intfc.tex deleted file mode 100644 index d527e7e9037fd3649529f08c957ea6118cc793f6..0000000000000000000000000000000000000000 --- a/src/doc/intfc/nplot_private_intfc.tex +++ /dev/null @@ -1,31 +0,0 @@ -% nplot_private_intfc.tex - -\chapter{ Private parameters for program NPLOT} -\tableofcontents - - -\section{ Overview} - - This document contains an overview of the parameter interface of the -program NPLOT. The program also uses a number of public interfaces; references -to these are also \textref{listed}{.public}. - -% \Figref{.nplot.interface} and its companion \figref{.nplot.extract} -show %schematically the various branches of program execution and the -parameters that %the user must provide to control each of them. - -%\input {../fig/nplot_interface.cap} - - The remainder of the document describes the individual parameters in -alphabetical order. This description centers on the Help texts, which have been -designed to guide the user to the proper choice at each junction, even if his -knowledge of the overall workings of the program is only superficial. - - -\section{ Descriptions of the individual parameters} -\label{.descriptions} - -\subsection{ References to public interfaces} -\label{.public} - -\input {nplot_private_keys.tef} diff --git a/src/doc/intfc/nplot_private_keys.tef b/src/doc/intfc/nplot_private_keys.tef deleted file mode 100644 index 61da5ca29db9e92015b45421994d8bc60c1cf907..0000000000000000000000000000000000000000 --- a/src/doc/intfc/nplot_private_keys.tef +++ /dev/null @@ -1,990 +0,0 @@ - -%\section{ References to public interfaces} -%\label{.public} - -% \input nplot.tmp.ref.1 -{\em See also:} -\begin{itemize} -\item \textref{DWARF}{introduction.user.interface} user interface -\item \textref{MDLNODE}{mdlnode_public_intfc} public keywords -\item \textref{NGEN}{ngen_public_intfc} public keywords -\item \textref{NMODEL}{nmodel_public_intfc} public keywords -\item \textref{SCNNODE}{scnnode_public_intfc} public keywords -\item \textref{SCNSETS}{scnsets_public_intfc} public keywords -\item \textref{SELECT}{select_public_intfc} public keywords -\item \textref{WMPNODE}{wmpnode_public_intfc} public keywords -\item \textref{WMPSETS}{wmpsets_public_intfc} public keywords -\end{itemize} - - - -\subsection{ Parameter ANGLE\_WMP\_SET} -\label{.angle.wmp.set} - -\spbegin -{\em Prompt:} ONE position-angle map: grp.fld.chn.pol.0.seq\\ -{\em Expected input:} Character *32: 1 value -\spend -\spbegin -\svbegin\begin{verbatim} -Select a .WMP-file image holding polarisation position angles. If the image you -specify contains anything else, your plot will be garbage. -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} -The .WMP-file indices are: -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} - group.field.channel.polarisation.type(=0).sequence_number -\end{verbatim}\svend -\spend - - -\subsection{ Parameter ANNOTATION} -\label{.annotation} - -\spbegin -{\em Prompt:} Annotation text, up to 80 characters in double quotes\\ -{\em Expected input:} Character *80: 1 value -\spend -\spbegin -\svbegin\begin{verbatim} -This text will be displayed on all plots for this NPLOT run until you change it -\end{verbatim}\svend -\spend - - -\subsection{ Parameter AREA} -\label{.area} - -\spbegin -{\em Prompt:} Area centre (l,m) and width (dl,dm) in grid units\\ -{\em Expected input:} Integer: 1 to 4 values -\spend -\spbegin -\svbegin\begin{verbatim} -Specify an area of a map: -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} - l,m grid coordinates of area centre: 0,0 is the map centre, - increasing to the upper right (i.e. with DEcreasing - right ascension and INcreasing declination) -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} - dl,dm area width and height -\end{verbatim}\svend -\spend - - -\subsection{ Parameter COORD} -\label{.coord} - -\spbegin -{\em Prompt:} Axis annotation style\\ -{\em Expected input:} Character *24: 1 value -\spend -\spbegin -\svbegin\begin{verbatim} -Select ONE style of axis annotations: -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} - NONE no annotation (only pixel coordinates) -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} - Relative quasi-Cartesian coordinates: -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} - LM l, m in arcsec with respect to map centre - (or annotation for UV-plane plots) - DLM l, m in arcsec with respect to centre of plot - (or annotation for UV-plane plots) -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} - Equatorial coordinates: -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} - DEGREE right ascension and declination in decimal degrees - RADEC right ascension (hhmmss) and declination (ddmmss) - DDEGREE relative right ascension and declination in decimal degrees - w.r.t. centre of plot - DRADEC relative right ascension (hhmmss) and declination (ddmmss) - w.r.t. centre of plot -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} -These annotations will be printed along the left and bottom sides of the plot. -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} -By default, (l,m) pixel-coordinates are shown along the top and right axes side -irrespective of what you select. You may suppress these, by prefixing any of -the above options with an O for 'Only'. -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} -Example: - ONONE will suppress all annotations. -\end{verbatim}\svend -\spend - - -\subsection{ Parameter COORD\_PREC} -\label{.coord.prec} - -\spbegin -{\em Prompt:} Number of steps for coordinate contouring near pole\\ -{\em Expected input:} Integer: 1 value -\spend -\spbegin -\svbegin\begin{verbatim} -Specify the number of steps across the map to use in defining the -coordinate grid for contouring of coordinates near the pole. -\end{verbatim}\svend -\spend - - -\subsection{ Parameter COORD\_TYPE} -\label{.coord.type} - -\spbegin -{\em Prompt:} Coordinate grid style\\ -{\em Expected input:} Character *24: 1 value -\spend -\spbegin -\svbegin\begin{verbatim} -Select the style for plotting coordinate grid lines: -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} - TICK give along plot edges only - DOTTED dotted grid - FULL full-drawn grid -\end{verbatim}\svend -\spend - - -\subsection{ Parameter DATA\_TYPE} -\label{.data.type} - -\spbegin -{\em Prompt:} data types to plot\\ -{\em Expected input:} Character *16: 1 value -\spend -\spbegin -\svbegin\begin{verbatim} -Specify the data type(s) to be plotted. -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} - DATA or * plot the data as given in the map - SLOPE plot the horizontal slope of the data (This option is still - experimental) -\end{verbatim}\svend -\spend - - -\subsection{ Parameter DATA\_TYPES} -\label{.data.types} - -\spbegin -{\em Prompt:} Visibility component to plot\\ -{\em Expected input:} Character *16: 1 to 6 values -\spend -\spbegin -\svbegin\begin{verbatim} -Specify the visibility component to be plotted. -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} - The quantity plotted depends on the data selected. For TEL or INTERF -and for redund. RES : gain-1(%), phase(deg) For DATA: - ampl (WU), phase(deg For Selfcal RES with external model: -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} - Standard representations of complex data: -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} - Model Resid Int.model - AMPLITUDE - PHASE - COSINE - SINE -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} - AGAIN Re log(data/model) * 100 = gain in % - PGAIN Im log(data/model) * 180/pi = phase in deg -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} - Old WSRT 'PLOTAP' formats: -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} - AP amplitude/phase plots, one pair per page - CS cosine/sine plots, one pair per page -\end{verbatim}\svend -\spend -\spbegin -{\em Expected input:} Real *16: 1 to 6 values -\spend - - -\subsection{ Parameter DOT\_CONT} -\label{.dot.cont} - -\spbegin -{\em Prompt:} Dotted-contour levels\\ -{\em Expected input:} Real: 1 to 32 values -\spend -\spbegin -\svbegin\begin{verbatim} -Specify up to 32 values of the contours to be drawn as dotted lines. -\end{verbatim}\svend -\spend - - -\subsection{ Parameter FULL\_CONT} -\label{.full.cont} - -\spbegin -{\em Prompt:} Full-contour levels\\ -{\em Expected input:} Real: 1 to 32 values -\spend -\spbegin -\svbegin\begin{verbatim} -Specify up to 32 values of the contours to be drawn as full lines. -\end{verbatim}\svend -\spend - - -\subsection{ Parameter HALFTONE} -\label{.halftone} - -\spbegin -{\em Prompt:} Halftone transfer function\\ -{\em Expected input:} Character *24: 1 value -\spend -\spbegin -\svbegin\begin{verbatim} -At this point, data values have been normalised to lie within the interval -[0,1]. Halftones are represented by the same interval: 0=white, 1=black. You -are now to define the transfer function F for mapping data values onto -halftones: -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} - halftone = F (normalised data value) -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} - Continuous functions: -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} - CONTINUE a quadratic function (you will be prompted for the - coefficients) - NONE direct mapping: halftone level = normalised data value -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} - Discontinuous functions: -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} - STEP F is a staircase function; halftone shades are generated by a - stochastic algorithm - PATTERN as STEP, but halftone shades are represented by a set of - fixed patterns -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} -In selecting a method, bear in mind that the human eye is quite sensitive to -density variations in light shades while very poorly perceiving the same -variations in the dark shades; in other words, its response to density -variations is quasi-logarithmic. -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} -To compensate for this, a quasi-exponential transfer function is suitable. The -best approximation to this available here is a steeply quadratic function (i.e. -specify CONTINUE here and consult the on-line help for the TRANSFORM parameter). -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} -You may judge the quality of your transfer function from the grey-scale wedge -that will appear side by side with your plot. -\end{verbatim}\svend -\spend - - -\subsection{ Parameter HA\_INTEGRATION} -\label{.ha.integration} - -\spbegin -{\em Prompt:} Integration time (sec)\\ -{\em Expected input:} Real: 1 value -\spend -\spbegin -\svbegin\begin{verbatim} -Specify the time interval over which you want to integrate (if possible) before -calibrating. The value you specify will be rounded down to a multiple of the -hour-angle interval between successive scans. -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} -'*' and '0' mean do not integrate, i.e. calibrate per scan. -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} -The largest value allowed is 3600 (= 1 hour). -\end{verbatim}\svend -\spend - - -\subsection{ Parameter HA\_MODE} -\label{.ha.mode} - -\spbegin -{\em Prompt:} Special HA plot coordinates\\ -{\em Expected input:} Character *10: 1 value -\spend -\spbegin -\svbegin\begin{verbatim} -This parameter selects a coordinate conversion for the vertical (HA) plot -coordinate in plots of .SCN-file entities. -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} - ST Sidereal time i.s.o. HA. This is useful for plotting a series of - observations (e.g. calibrators-object-calibrators) in a time - sequence, e.g. to survey interference. Vertical coordinate is - ST in degrees -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} - SEQUENCE Pseudo sidereal time: Sidereal time is forced into an ascending - sequence: When the start ST for a sector is less than that of - the one just plotted, it is changed to make the new sector - follow the previous one contiguously. Within each sector, - vertical scale size is that of HA or ST, but the sectors are - displaced in ST. Sectors are plotted in order of their index. - This mode is useful to stuff a lot of information into a single - plot, e.g. to check for interference, but the plot may become - too confusing. -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} - I<xxx> The prefix I indicates that you want to integrate scans; you - will be prompted for the HA interval over which to integrate. - As currently implemented, this mode is effective only for plots - that have HA or (pseudo)ST as vertical coordinate. The plot - scale for this coordinate will not be affected. -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} -NPLOT will set plotting mode according to your reply and return to the OPTION -prompt. The mode will remain in force until you change it or NPLOT exits. -\end{verbatim}\svend -\spend - - -\subsection{ Parameter HA\_SCALE} -\label{.ha.scale} - -\spbegin -{\em Prompt:} HA plot scale (degree/cm)\\ -{\em Expected input:} Real: 1 value -\spend -\spbegin -\svbegin\begin{verbatim} -Specify the hour-angle scale in degree/cm. -\end{verbatim}\svend -\spend - - -\subsection{ Parameter IFR\_MODE} -\label{.ifr.mode} - -\spbegin -{\em Prompt:} Select data cross-section\\ -{\em Expected input:} Character *16: 1 value -\spend -\spbegin -\svbegin\begin{verbatim} -Specify the cross section through the visibility data cube to be plotted: - Consider the interferometers arranged in an upper-triangular matrix: -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} - 00 01 02 ... 0B 0C 0D - 11 12 ... 1B 1C 1D - 22 ... 2B 2C 2D - : : : - BB BC BD - CC CD - DD -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} -Then the possible plotting modes are -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} - visibilities as function of hour angle per interferometer: -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} - NORMAL interferometer order in the matrix is row by row -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} - INVERT interferometer order in the matrix is column by column . - SORT interferometers in order of ascending baseline -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} - other cross sections of the hour-angle/interferometer/channel cube: -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} - SPECTRAL visibilities as function of spectral channel and hour angle, - per interferometer (the WSRT 'PLUVO' format) -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} - BAND visibilities as function of channel and interferometer, - interferometer order as for NORMAL -\end{verbatim}\svend -\spend - - -\subsection{ Parameter IF\_MODE} -\label{.if.mode} - -\spbegin -{\em Prompt:} Parameter to plot\\ -{\em Expected input:} Character *8: 1 value -\spend -\spbegin -\svbegin\begin{verbatim} -Specify action to perform: -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} - Telescope parameters: -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} - TPON total power data (noise source off) - TPOFF total power data (noise source on) - TSYS system temperatures - ISYS system temperatures (X+Y) - GAIN IF gains -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} - Interferometer parameters: -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} - GNCAL gain correction method - TSYSI constant system temperature - TNOISI constant noise source temperature - RGAINI constant receiver gain -\end{verbatim}\svend -\spend - - -\subsection{ Parameter OPTION} -\label{.option} - -\spbegin -{\em Prompt:} Type of data to plot|\\ -{\em Expected input:} Character *24: 1 value -\spend -\spbegin -\svbegin\begin{verbatim} -Specify type of data to plot: -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} - .WMP-file data: -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} - MAP image(s) from .WMP file -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} - .SCN-file visibilities: - DATA observed visibilities - MODEL model visibilities - RESIDUAL visibility residuals (after correction of all known - errors and division by the visibilities of a source - model (yet to be specified) - (sets I=1, QUV=0) -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} - .SCN-file correction parameters: -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} - TELESCOPE telescope phase/gain corrections - INTERFEROMETER interferometer phase/gain corrections (i.e. all - corrections combined per interferometer) -\end{verbatim}\svend -\svbegin\begin{verbatim} - IFDATA IF-data: total powers, system temperatures etc. -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} - Plotting versus sidereal time i.s.o. hour angle: -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} - SPECIAL will prompt for a special mode -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} - QUIT terminate NPLOT -\end{verbatim}\svend -\spend - - -\subsection{ Parameter PLOTS\_PER\_PAGE} -\label{.plots.per.page} - -\spbegin -{\em Prompt:} Number of plots per page in hor. and vert. directions\\ -{\em Expected input:} Integer: 1 to 2 values -\spend -\spbegin -\svbegin\begin{verbatim} -Specify number of plots to be plotted on one page. -\end{verbatim}\svend -\spend - - -\subsection{ Parameter PLOT\_HEADING} -\label{.plot.heading} - -\spbegin -{\em Prompt:} Plot heading (Yes/No) ?\\ -{\em Expected input:} Character *24: 1 value -\spend -\spbegin -\svbegin\begin{verbatim} -Specify if you want to have a MAP plot with or without the heading. -\end{verbatim}\svend -\spend - - -\subsection{ Parameter PLOT\_POSITIONS} -\label{.plot.positions} - -\spbegin -{\em Prompt:} Mark source positions\\ -{\em Expected input:} Character *24: 1 value -\spend -\spbegin -\svbegin\begin{verbatim} -Specify if you want model-source positions marked in your plot. The answers may -be: -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} - NO - YES position markers only - MAMES position markers annotated with their IDs from the model list -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} -The marker symbol used is determined per source by its Type (which is the -suffix number in its ID). -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} - EDIT invoke model-handling code to modify model-components' Types, - (FEDIT option), then return to this prompt. This path also - allows you to define additional annotations. -\end{verbatim}\svend -\whichref{NMODEL HANDLE/EDIT}{nmodel\_public\_keys.} -\whichref{parameter SOURCES}{} -\whichref{parameter TEXT}{} -\spend - - -\subsection{ Parameter PLOT\_TYPE} -\label{.plot.type} - -\spbegin -{\em Prompt:} Data representation(s)\\ -{\em Expected input:} Character *16: 1 to 4 values -\spend -\spbegin -\svbegin\begin{verbatim} -Specify the (combination of) data representations: -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} - CONTOUR Contour plot - HALFTONE Halftone plot - * Equivalent to CONTOUR,HALFTONE - RULED Ruled-surface -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} - POLARISATION Pseudo-vectors of linear polarisation. This requires two - input maps, one holding polarisation strengths - sqrt(Q*Q+U*U) and the other position angles atan(U/Q)/2. -\end{verbatim}\svend - {\em Such maps are prepared with - \whichref{NMAP FIDDLE xxx}{} } -\spend - - -\subsection{ Parameter POL\_RANGE} -\label{.pol.range} - -\spbegin -{\em Prompt:} Polarised-flux limits (W.U.)\\ -{\em Expected input:} Real: 1 to 2 values -\spend -\spbegin -\svbegin\begin{verbatim} -No polarisation pseudo-vector will be drown if the intensity of linear -polarisation is below the lower limit (and therefore mainly noise); above the -upper limit it will be truncated to that limit. -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} -Please specify the limits in Westerbork Units. -\end{verbatim}\svend -\spend - - -\subsection{ Parameter POL\_SCALE} -\label{.pol.scale} - -\spbegin -{\em Prompt:} Polarisation pseudo-vector length scale W.U./cm\\ -{\em Expected input:} Real: 1 value -\spend -\spbegin -\svbegin\begin{verbatim} -Specify the polarisation pseudo-vector length scale in Westerbork Units /cm. -\end{verbatim}\svend -\spend - - -\subsection{ Parameter POL\_TYPE} -\label{.pol.type} - -\spbegin -{\em Prompt:} Polarisation representation\\ -{\em Expected input:} Character *16: 1 value -\spend -\spbegin -\svbegin\begin{verbatim} -Specify if polarisation (POL) or magnetic field (MAG) should be plotted -\end{verbatim}\svend -\spend - - -\subsection{ Parameter RANGE} -\label{.range} - -\spbegin -{\em Prompt:} Halftone saturation limits\\ -{\em Expected input:} Real: 1 to 2 values -\spend -\spbegin -\svbegin\begin{verbatim} -Specify the range of values to be covered by the full range of halftone shades. -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} -The first value is the minimum to be represented by 'white', the second value -the to be represented by 'black'. -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} -NOTES: - Values outside this range will always be white. (If you think this is a -bad idea, please submit a Bug Report.) - It is not possible to invert the scale by specifying a maximum<minimum. -\end{verbatim}\svend -\spend - - -\subsection{ Parameter RULE\_RANGE} -\label{.rule.range} - -\spbegin -{\em Prompt:} Ruled-surface intensity range (W.U.)\\ -{\em Expected input:} Real: 1 to 2 values -\spend -\spbegin -\svbegin\begin{verbatim} -Specify the intensity limits in Westerbork Units for the ruled surface plot. -Values outside the limits will be truncated. -\end{verbatim}\svend -\spend - - -\subsection{ Parameter RULE\_SCALE} -\label{.rule.scale} - -\spbegin -{\em Prompt:} Ruled-surface height scale (W.U./cm)\\ -{\em Expected input:} Real: 1 value -\spend -\spbegin -\svbegin\begin{verbatim} -Specify the ruled-surface height scale in Westerbork Units /cm. -\end{verbatim}\svend -\spend - - -\subsection{ Parameter SCALE\_AMPL} -\label{.scale.ampl} - -\spbegin -{\em Prompt:} Magnitude scale (W.U./mm or %/mm)\\ -{\em Expected input:} Real: 1 value -\spend -\spbegin -\svbegin\begin{verbatim} -Specify the magnitude scale: -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} - in Westerbork Units /mm for source/model visibilities and visibility - residuals - in percent/mm for telescope corrections -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} -amplitude noises recorded in the sector headers selected. For other DATA_TYPEs -it is a value that is likely to give reasonable output. -\end{verbatim}\svend -\spend -\spbegin -{\em Expected input:} Real: 1 value -\spend - - -\subsection{ Parameter SCALE\_PHASE} -\label{.scale.phase} - -\spbegin -{\em Prompt:} Phase scale (W.U./mm or deg/mm)\\ -{\em Expected input:} Real: 1 value -\spend -\spbegin -\svbegin\begin{verbatim} -Specify the phase scale: -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} - in Westerbork Units /mm for residuals - in degrees/mm for source/model visibilities; for telescope - corrections. -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} -The default is a value that is likely to give reasonable output. -\end{verbatim}\svend -\spend - - -\subsection{ Parameter SIZE} -\label{.size} - -\spbegin -{\em Prompt:} Plot scaling factors (horizontal, vertical)\\ -{\em Expected input:} Real: 1 to 2 values -\spend -\spbegin -\svbegin\begin{verbatim} -At this point, the plot has been dimensioned to fit on a single plotter page or -terminal screen, but will not necessarily fill it. You may blow it up in either -or both dimensions with the factors you specify here. -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} -If necessary, the blown-up plot will be distributed over more tham one page. -\end{verbatim}\svend -\spend - - -\subsection{ Parameter SOURCES} -\label{.sources} - -\spbegin -{\em Prompt:} Source pair for annotation\\ -{\em Expected input:} Character *10: 1 to 2 values -\spend -\spbegin -\svbegin\begin{verbatim} -Give the names of two sources that you have selected for plotting. A connecting -line will be drawn between them. You will be prompted for an annotation, which -defaults to the separation in degrees. -\end{verbatim}\svend -\spend - - -\subsection{ Parameter TEXT} -\label{.text} - -\spbegin -{\em Prompt:} Annotation for source pair\\ -{\em Expected input:} Character *80: 1 value -\spend -\spbegin -\svbegin\begin{verbatim} -The annotation (max 80 characters) for the source pair just selected -\end{verbatim}\svend -\spend - - -\subsection{ Parameter TRANSFORM} -\label{.transform} - -\spbegin -{\em Prompt:} Grey-scale transfer coefficients:|-\\ -{\em Expected input:} Real: 1 to 3 values -\spend -\spbegin -\svbegin\begin{verbatim} -Specify the range coefficients for the CONTINUOUS quadratic transfer function -that you selected. -\end{verbatim}\svend - {\em parameter \textref{HALFTONE}{.halftone} } -\spend -\spbegin -\svbegin\begin{verbatim} -Remember that the data at this point have been normalised to the range [0,1]. -You may specify 5 values, of which the first three are REQUIRED: -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} - m,M Range of normalised data values to be represented by the full - halftone range. Values outside this range will be truncated. - a,b,c The 0-th through 2nd-order coefficients in the transfer - quadratic. -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} -The result will be ('ndv' = normalised data value): -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} - ndv < m: OUT = 0 (white) - m < ndv < M: OUT = a + b*IN + c*IN*IN (grey scale) - ndv > M: OUT = 1 (black) -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} -You may break the IN range up into partial ranges by specifying multiple sets -of m,M,a,b,c separated by semicolons, or specifying the sets one by one as the -prompt is repeated. Input will be considered complete when you give no new -reply. -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} -Examples: - standard linear, halftone=ndv: 0,1, 0,1 - ndv distance from .5: 0,.5, 1,-2; .5,1, -1,2 - four grey levels: 0,.25,0; .25,.5,.25; .5,.75,.5; .75,1,1 - an approximation to an exp - that seeks to match the - quasi-logarithic response - of the human eye: 0,1, 0,.1,.9 -\end{verbatim}\svend -\spend - diff --git a/src/doc/intfc/nscan_private_intfc.tex b/src/doc/intfc/nscan_private_intfc.tex deleted file mode 100644 index c7f98ce0ba397632befb0f8ee076452aca500673..0000000000000000000000000000000000000000 --- a/src/doc/intfc/nscan_private_intfc.tex +++ /dev/null @@ -1,31 +0,0 @@ -% nscan_private_intfc.tex - -\chapter{ Private parameters for program NSCAN} -\tableofcontents - - -\section{ Overview} - - This document contains an overview of the parameter interface of the -program NSCAN. The program also uses a number of public interfaces; references -to these are also \textref{listed}{.public}. - -% \Figref{.nscan.interface} and its companion \figref{.nscan.extract} -show %schematically the various branches of program execution and the -parameters that %the user must provide to control each of them. - -%\input {../fig/nscan_interface.cap} - - The remainder of the document describes the individual parameters in -alphabetical order. This description centers on the Help texts, which have been -designed to guide the user to the proper choice at each junction, even if his -knowledge of the overall workings of the program is only superficial. - - -\section{ Descriptions of the individual parameters} -\label{.descriptions} - -\subsection{ References to public interfaces} -\label{.public} - -\input {nscan_private_keys.tef} diff --git a/src/doc/intfc/nscan_private_keys.tef b/src/doc/intfc/nscan_private_keys.tef deleted file mode 100644 index 1461e67ce9f5bc00d08cd337c94f6a1f7e1843f7..0000000000000000000000000000000000000000 --- a/src/doc/intfc/nscan_private_keys.tef +++ /dev/null @@ -1,11 +0,0 @@ - -%\section{ References to public interfaces} -%\label{.public} - -% \input nscan.tmp.ref.1 -{\em See also:} -\begin{itemize} -\item \textref{DWARF}{introduction.user.interface} user interface -\end{itemize} - - diff --git a/src/doc/intfc/nshow_public_intfc.tex b/src/doc/intfc/nshow_public_intfc.tex deleted file mode 100644 index abd54f1959181cc5c97280495e6e2dbd63d0bc12..0000000000000000000000000000000000000000 --- a/src/doc/intfc/nshow_public_intfc.tex +++ /dev/null @@ -1,39 +0,0 @@ -% nshow_public_intfc.tex - -\chapter{ Public parameter group NSHOW} -\tableofcontents - - -\section{ Overview} - - This document contains an overview of the public parameter group NSHOW, -(part of) which is included in several \NEWSTAR programs. - -% \Figref{.nshow.interface} and its companion \figref{.nshow.extract} -%show schematically the various branches of program execution and the -%parameters that the user must provide to control each of them. - -%\input {../fig/nshow_interface.cap} - - The -%remainder of the -document describes the individual parameters in alphabetical order. This -description centers on the Help texts, which have been designed to guide the -user to the proper choice at each junction, even if his knowledge of the -overall workings of the program is only superficial. - - Please note that the generic prompt and help texts defined for these -parameters are frequently superseded in the actual applications by alternative -texts that are more appropriate to the situation at hand. Unfortunately, the -present architecture of \NEWSTAR precludes the inclusion of such texts in the -documentation system, so the only opportunity to read that information is -during program execution (in your terminal window!). - - -\section{ Descriptions of the individual parameters} -\label{.descriptions} - -\subsection{ References to public interfaces} -\label{.public} - -\input {nshow_public_keys.tef} diff --git a/src/doc/intfc/nshow_public_keys.tef b/src/doc/intfc/nshow_public_keys.tef deleted file mode 100644 index 8b137891791fe96927ad78e64b0aad7bded08bdc..0000000000000000000000000000000000000000 --- a/src/doc/intfc/nshow_public_keys.tef +++ /dev/null @@ -1 +0,0 @@ - diff --git a/src/doc/intfc/plotter_public_intfc.tex b/src/doc/intfc/plotter_public_intfc.tex deleted file mode 100644 index c1ccb471a7b588e5e0bee8217053aa0c05eb0839..0000000000000000000000000000000000000000 --- a/src/doc/intfc/plotter_public_intfc.tex +++ /dev/null @@ -1,40 +0,0 @@ -% plotter_public_intfc.tex - -\chapter{ Public parameter group PLOTTER} -\tableofcontents - - -\section{ Overview} - - This document contains an overview of the public parameter group -PLOTTER, (part of) which is included in several \NEWSTAR programs. - -% \Figref{.plotter.interface} and its companion \figref{.plotter.extract} -show -%schematically the various branches of program execution and the parameters -%that the user must provide to control each of them. - -%\input {../fig/plotter_interface.cap} - - The -%remainder of the -document describes the individual parameters in alphabetical order. This -description centers on the Help texts, which have been designed to guide the -user to the proper choice at each junction, even if his knowledge of the -overall workings of the program is only superficial. - - Please note that the generic prompt and help texts defined for these -parameters are frequently superseded in the actual applications by alternative -texts that are more appropriate to the situation at hand. Unfortunately, the -present architecture of \NEWSTAR precludes the inclusion of such texts in the -documentation system, so the only opportunity to read that information is -during program execution (in your terminal window!). - - -\section{ Descriptions of the individual parameters} -\label{.descriptions} - -\subsection{ References to public interfaces} -\label{.public} - -\input {plotter_public_keys.tef} diff --git a/src/doc/intfc/plotter_public_keys.tef b/src/doc/intfc/plotter_public_keys.tef deleted file mode 100644 index 70b48166f5d08dfdb96b8c0489755354a19b67a2..0000000000000000000000000000000000000000 --- a/src/doc/intfc/plotter_public_keys.tef +++ /dev/null @@ -1,73 +0,0 @@ - - -\subsection{ Parameter PLOTTER} -\label{.plotter} - -\spbegin -{\em Prompt:} plotter to use ({\em may vary per application})\\ -{\em Expected input:} Character *8: 1 value -\spend -\spbegin -\svbegin\begin{verbatim} - Select device/mode for plotting: -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} - Xwindows: - X11 X11 terminal - The display used is given by (NGEN-) keyword DISPLAY - and/or the environment variable DISPLAY -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} - PostScript printer: - QMS QMS laser printer in landscape orientation - QMSP QMS laser printer in portrait orientation -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} - PostScript files:: - PL Postscript file in landscape mode - PP PostScript file in portrait mode - EL Encapsulated Postscript file in landscape mode - EP Encapsulated Postscript file in portrait mode -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} - Miscellaneous graphics: - REGIS graphics VT terminal - FREGIS (*) REGIS to file -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} - Bitmap graphics: - BIT1 (*) bitmap for 100 dpi - BIT2 (*) bitmap for 200 dpi - BIT3 (*) bitmap for 300 bpi -\end{verbatim}\svend -\spend - - -\subsection{ Parameter PLOT\_FORMAT} -\label{.plot.format} - -\spbegin -{\em Prompt:} A$<$n$>$-format of plot ({\em may vary per application})\\ -{\em Expected input:} Character *1: 1 value -\spend -\spbegin -\svbegin\begin{verbatim} - Select format for (Encapsulated) PostScript plots: - 0 = A0 - 1 = A1 - 2 = A2 - 3 = A3 - 4 = A4 -\end{verbatim}\svend -\spend - diff --git a/src/doc/intfc/scnnode_public_intfc.tex b/src/doc/intfc/scnnode_public_intfc.tex deleted file mode 100644 index 431b5d5dbbce7c5328ec05e75bb404a51c44be57..0000000000000000000000000000000000000000 --- a/src/doc/intfc/scnnode_public_intfc.tex +++ /dev/null @@ -1,39 +0,0 @@ -% scnnode_public_intfc.tex - -\chapter{ Public parameter group SCNNODE} -\tableofcontents - - -\section{ Overview} - - This document contains an overview of the public parameter group -SCNNODE, (part of) which is included in several \NEWSTAR programs. - -% \Figref{.scnnode.interface} and its companion \figref{.scnnode.extract} -% show schematically the various branches of program execution and the -% parameters that the user must provide to control each of them. - -%\input {../fig/scnnode_interface.cap} - - The -%remainder of the -document describes the individual parameters in alphabetical order. This -description centers on the Help texts, which have been designed to guide the -user to the proper choice at each junction, even if his knowledge of the -overall workings of the program is only superficial. - - Please note that the generic prompt and help texts defined for these -parameters are frequently superseded in the actual applications by alternative -texts that are more appropriate to the situation at hand. Unfortunately, the -present architecture of \NEWSTAR precludes the inclusion of such texts in the -documentation system, so the only opportunity to read that information is -during program execution (in your terminal window!). - - -\section{ Descriptions of the individual parameters} -\label{.descriptions} - -\subsection{ References to public interfaces} -\label{.public} - -\input {scnnode_public_keys.tef} diff --git a/src/doc/intfc/scnnode_public_keys.tef b/src/doc/intfc/scnnode_public_keys.tef deleted file mode 100644 index 8b137891791fe96927ad78e64b0aad7bded08bdc..0000000000000000000000000000000000000000 --- a/src/doc/intfc/scnnode_public_keys.tef +++ /dev/null @@ -1 +0,0 @@ - diff --git a/src/doc/intfc/scnsets_public_intfc.tex b/src/doc/intfc/scnsets_public_intfc.tex deleted file mode 100644 index 8ea7fe0c1d560f6fbb55e7c396eb7758db49885e..0000000000000000000000000000000000000000 --- a/src/doc/intfc/scnsets_public_intfc.tex +++ /dev/null @@ -1,39 +0,0 @@ -% scnsets_public_intfc.tex - -\chapter{ Public parameter group SCNSETS} -\tableofcontents - - -\section{ Overview} - - This document contains an overview of the public parameter group -SCNSETS, (part of) which is included in several \NEWSTAR programs. - -% \Figref{.scnsets.interface} and its companion \figref{.scnsets.extract} -%show schematically the various branches of program execution and the -%parameters that the user must provide to control each of them. - -%\input {../fig/scnsets_interface.cap} - - The -%remainder of the -document describes the individual parameters in alphabetical order. This -description centers on the Help texts, which have been designed to guide the -user to the proper choice at each junction, even if his knowledge of the -overall workings of the program is only superficial. - - Please note that the generic prompt and help texts defined for these -parameters are frequently superseded in the actual applications by alternative -texts that are more appropriate to the situation at hand. Unfortunately, the -present architecture of \NEWSTAR precludes the inclusion of such texts in the -documentation system, so the only opportunity to read that information is -during program execution (in your terminal window!). - - -\section{ Descriptions of the individual parameters} -\label{.descriptions} - -\subsection{ References to public interfaces} -\label{.public} - -\input {scnsets_public_keys.tef} diff --git a/src/doc/intfc/scnsets_public_keys.tef b/src/doc/intfc/scnsets_public_keys.tef deleted file mode 100644 index 8b137891791fe96927ad78e64b0aad7bded08bdc..0000000000000000000000000000000000000000 --- a/src/doc/intfc/scnsets_public_keys.tef +++ /dev/null @@ -1 +0,0 @@ - diff --git a/src/doc/intfc/select_public_intfc.tex b/src/doc/intfc/select_public_intfc.tex deleted file mode 100644 index 8a292892416da9582fd47e0a3f5cb3cd1e4df18b..0000000000000000000000000000000000000000 --- a/src/doc/intfc/select_public_intfc.tex +++ /dev/null @@ -1,39 +0,0 @@ -% select_public_intfc.tex - -\chapter{ Public parameter group SELECT} -\tableofcontents - - -\section{ Overview} - - This document contains an overview of the public parameter group -SELECT, (part of) which is included in several \NEWSTAR programs. - -% \Figref{.select.interface} and its companion \figref{.select.extract} -%show schematically the various branches of program execution and the -%parameters that the user must provide to control each of them. - -%\input {../fig/select_interface.cap} - - The -%remainder of the -document describes the individual parameters in alphabetical order. This -description centers on the Help texts, which have been designed to guide the -user to the proper choice at each junction, even if his knowledge of the -overall workings of the program is only superficial. - - Please note that the generic prompt and help texts defined for these -parameters are frequently superseded in the actual applications by alternative -texts that are more appropriate to the situation at hand. Unfortunately, the -present architecture of \NEWSTAR precludes the inclusion of such texts in the -documentation system, so the only opportunity to read that information is -during program execution (in your terminal window!). - - -\section{ Descriptions of the individual parameters} -\label{.descriptions} - -\subsection{ References to public interfaces} -\label{.public} - -\input {select_public_keys.tef} diff --git a/src/doc/intfc/select_public_keys.tef b/src/doc/intfc/select_public_keys.tef deleted file mode 100644 index 8b137891791fe96927ad78e64b0aad7bded08bdc..0000000000000000000000000000000000000000 --- a/src/doc/intfc/select_public_keys.tef +++ /dev/null @@ -1 +0,0 @@ - diff --git a/src/doc/intfc/unit_public_intfc.tex b/src/doc/intfc/unit_public_intfc.tex deleted file mode 100644 index a783013f6809b157fd8656bd2a9b9ae962fe306e..0000000000000000000000000000000000000000 --- a/src/doc/intfc/unit_public_intfc.tex +++ /dev/null @@ -1,39 +0,0 @@ -% unit_public_intfc.tex - -\chapter{ Public parameter group UNIT} -\tableofcontents - - -\section{ Overview} - - This document contains an overview of the public parameter group UNIT, -(part of) which is included in several \NEWSTAR programs. - -% \Figref{.unit.interface} and its companion \figref{.unit.extract} show -%schematically the various branches of program execution and the parameters -%that the user must provide to control each of them. - -%\input {../fig/unit_interface.cap} - - The -%remainder of the -document describes the individual parameters in alphabetical order. This -description centers on the Help texts, which have been designed to guide the -user to the proper choice at each junction, even if his knowledge of the -overall workings of the program is only superficial. - - Please note that the generic prompt and help texts defined for these -parameters are frequently superseded in the actual applications by alternative -texts that are more appropriate to the situation at hand. Unfortunately, the -present architecture of \NEWSTAR precludes the inclusion of such texts in the -documentation system, so the only opportunity to read that information is -during program execution (in your terminal window!). - - -\section{ Descriptions of the individual parameters} -\label{.descriptions} - -\subsection{ References to public interfaces} -\label{.public} - -\input {unit_public_keys.tef} diff --git a/src/doc/intfc/unit_public_keys.tef b/src/doc/intfc/unit_public_keys.tef deleted file mode 100644 index a0b6b31c2b49e4ed1fdad5b302b4d78e3958bc88..0000000000000000000000000000000000000000 --- a/src/doc/intfc/unit_public_keys.tef +++ /dev/null @@ -1,241 +0,0 @@ - - -\subsection{ Parameter INPUT\_UNIT} -\label{.input.unit} - -\spbegin -{\em Prompt:} input 'tape' unit: number or 'D' for 'disk' | ({\em may vary per application})\\ -{\em Expected input:} Character *1: 1 value -\spend -\spbegin -\svbegin\begin{verbatim} - Specify the input unit for your data: -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} - 0,..9 Tape/optical disk/DAT unit - D Disk -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} -The correspondence between the unit numbers and the devices on your host -machine is defined by the environment variables MAG<n>. The list below shows -the values with which NEWSTAR is distributed, but your local installation may -be different, so you do wello to check with your local site manager -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} - classic 0.5-inch magtape: - 0 1600 bpi - 1 6250 bpi - 2 800 bpi -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} - optical disk, formatted as a magtape: - 4 - 5 -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} - DAT, ExaByte or similar tape: - 6 - 7 - 8 - 9 -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} -You may enter '*' to get a list of unit numbers available for you, but this -will not tell you to what physical devices these correspond. -\end{verbatim}\svend -\spend - - -\subsection{ Parameter OUTPUT\_UNIT} -\label{.output.unit} - -\spbegin -{\em Prompt:} output 'tape' unit: number or 'D' for 'disk' | ({\em may vary per application})\\ -{\em Expected input:} Character *1: 1 value -\spend -\spbegin -\svbegin\begin{verbatim} -Specify the input unit for your data: -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} - 0,..9 Tape/optical disk/DAT unit - D Disk -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} -The correspondence between the unit numbers and the devices on your host -machine is defined by the environment variables MAG<n>. The list below shows -the values with which NEWSTAR is distributed, but your local installation may -be different, so you do wello to check with your local site manager -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} - classic 0.5-inch magtape: - 0 1600 bpi - 1 6250 bpi - 2 800 bpi -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} - optical disk, formatted as a magtape: - 4 - 5 -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} - DAT, ExaByte or similar tape: - 6 - 7 - 8 - 9 -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} -You may enter '*' to get a list of unit numbers available for you, but this -will not tell you to what physical devices these correspond. -\end{verbatim}\svend -\spend - - -\subsection{ Parameter OUTPUT\_VOLUME} -\label{.output.volume} - -\spbegin -{\em Prompt:} Output volume name ({\em may vary per application})\\ -{\em Expected input:} Character *6: 1 value -\spend -\spbegin -\svbegin\begin{verbatim} -Specify the full name for the output volume. -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} -This name is used for the administration in MEDIAD -\end{verbatim}\svend -\spend - - -\subsection{ Parameter OVERWRITE} -\label{.overwrite} - -\spbegin -{\em Prompt:} Overwrite (YES/NO) ({\em may vary per application})\\ -{\em Expected input:} Yes/No: 1 value -\spend -\spbegin -\svbegin\begin{verbatim} -Specify if one wants to overwrite the current label (YES) or not (NO). -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} -BEWARE: All subsequent labels will also be overwritten. -\end{verbatim}\svend -\spend - - -\subsection{ Parameter UNIT} -\label{.unit} - -\spbegin -{\em Prompt:} 'tape' unit: number or 'D' for 'disk' | ({\em may vary per application})\\ -{\em Expected input:} Character *1: 1 value -\spend -\spbegin -\svbegin\begin{verbatim} - Specify the input unit for your data: -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} - 0,..9 Tape/optical disk/DAT unit - D Disk -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} -The correspondence between the unit numbers and the devices on your host -machine is defined by the environment variables MAG<n>. The list below shows -the values with which NEWSTAR is distributed, but your local installation may -be different, so you do well to check with your local site manager -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} - classic 0.5-inch magtape: - 0 1600 bpi - 1 6250 bpi - 2 800 bpi -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} - optical disk, formatted as a magtape: - 4 - 5 -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} - DAT, ExaByte or similar tape: - 6 - 7 - 8 - 9 -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} -You may enter '*' to get a list of unit numbers available for you, but this -will not tell you to what physical devices these correspond. -\end{verbatim}\svend -\spend - - -\subsection{ Parameter VOLUME\_TYPE} -\label{.volume.type} - -\spbegin -{\em Prompt:} Abbreviated medium type ({\em may vary per application})\\ -{\em Expected input:} Character *4: 1 value -\spend -\spbegin -\svbegin\begin{verbatim} -Specify the type for the output volume. -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} -This name is used for the administration in MEDIAD -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} - DOD - DEC Optical Disk - DAT - Digital Audio Tape - 800 - 9-track tape, 800 bpi - 1600 - 9-track tape, 1600 bpi - 6250 - 9-track tape, 6250 bpi -\end{verbatim}\svend -\spend - diff --git a/src/doc/intfc/wmpnode_public_intfc.tex b/src/doc/intfc/wmpnode_public_intfc.tex deleted file mode 100644 index 3cd01e75bfe1cfe0012544f90605bcf51c0a7adf..0000000000000000000000000000000000000000 --- a/src/doc/intfc/wmpnode_public_intfc.tex +++ /dev/null @@ -1,39 +0,0 @@ -% wmpnode_public_intfc.tex - -\chapter{ Public parameter group WMPNODE} -\tableofcontents - - -\section{ Overview} - - This document contains an overview of the public parameter group -WMPNODE, (part of) which is included in several \NEWSTAR programs. - -% \Figref{.wmpnode.interface} and its companion \figref{.wmpnode.extract} -%show schematically the various branches of program execution and the -%parameters that the user must provide to control each of them. - -%\input {../fig/wmpnode_interface.cap} - - The -%remainder of the -document describes the individual parameters in alphabetical order. This -description centers on the Help texts, which have been designed to guide the -user to the proper choice at each junction, even if his knowledge of the -overall workings of the program is only superficial. - - Please note that the generic prompt and help texts defined for these -parameters are frequently superseded in the actual applications by alternative -texts that are more appropriate to the situation at hand. Unfortunately, the -present architecture of \NEWSTAR precludes the inclusion of such texts in the -documentation system, so the only opportunity to read that information is -during program execution (in your terminal window!). - - -\section{ Descriptions of the individual parameters} -\label{.descriptions} - -\subsection{ References to public interfaces} -\label{.public} - -\input {wmpnode_public_keys.tef} diff --git a/src/doc/intfc/wmpnode_public_keys.tef b/src/doc/intfc/wmpnode_public_keys.tef deleted file mode 100644 index 9f2c9eaea16dc4265ddb43d61b46755d31ef0a7c..0000000000000000000000000000000000000000 --- a/src/doc/intfc/wmpnode_public_keys.tef +++ /dev/null @@ -1,61 +0,0 @@ - - -\subsection{ Parameter INPUT\_WMP\_NODE} -\label{.input.wmp.node} - -\spbegin -{\em Prompt:} Input .WMP file name ({\em may vary per application})\\ -{\em Expected input:} Character *80: 1 value -\spend -\spbegin -\svbegin\begin{verbatim} -Specify the file name (no extension). -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} -You may enter '[<directory>/]**' to get a list of .WMP files in your current or -another directory; then enter '#<n>' to select the <n>th file from that list. -\end{verbatim}\svend -\spend - - -\subsection{ Parameter OUTPUT\_WMP\_NODE} -\label{.output.wmp.node} - -\spbegin -{\em Prompt:} Output .WMP file name ({\em may vary per application})\\ -{\em Expected input:} Character *80: 1 value -\spend -\spbegin -\svbegin\begin{verbatim} -Specify the file name (no extension). -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} -You may enter '[<directory>/]**' to get a list of .WMP files in your current or -another directory; then enter '#<n>' to select the <n>th file from that list. -\end{verbatim}\svend -\spend - - -\subsection{ Parameter WMP\_NODE} -\label{.wmp.node} - -\spbegin -{\em Prompt:} .WMP file name ({\em may vary per application})\\ -{\em Expected input:} Character *80: 1 value -\spend -\spbegin -\svbegin\begin{verbatim} -Specify the file name (no extension). -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} -You may enter '[<directory>/]**' to get a list of .WMP files in your current or -another directory; then enter '#<n>' to select the <n>th file from that list. -\end{verbatim}\svend -\spend - diff --git a/src/doc/intfc/wmpsets_public_intfc.tex b/src/doc/intfc/wmpsets_public_intfc.tex deleted file mode 100644 index 247a701045fdd2492c009baf929dccf4fe0655bb..0000000000000000000000000000000000000000 --- a/src/doc/intfc/wmpsets_public_intfc.tex +++ /dev/null @@ -1,39 +0,0 @@ -% wmpsets_public_intfc.tex - -\chapter{ Public parameter group WMPSETS} -\tableofcontents - - -\section{ Overview} - - This document contains an overview of the public parameter group -WMPSETS, (part of) which is included in several \NEWSTAR programs. - -% \Figref{.wmpsets.interface} and its companion \figref{.wmpsets.extract} -%show schematically the various branches of program execution and the -%parameters that the user must provide to control each of them. - -%\input {../fig/wmpsets_interface.cap} - - The -%remainder of the -document describes the individual parameters in alphabetical order. This -description centers on the Help texts, which have been designed to guide the -user to the proper choice at each junction, even if his knowledge of the -overall workings of the program is only superficial. - - Please note that the generic prompt and help texts defined for these -parameters are frequently superseded in the actual applications by alternative -texts that are more appropriate to the situation at hand. Unfortunately, the -present architecture of \NEWSTAR precludes the inclusion of such texts in the -documentation system, so the only opportunity to read that information is -during program execution (in your terminal window!). - - -\section{ Descriptions of the individual parameters} -\label{.descriptions} - -\subsection{ References to public interfaces} -\label{.public} - -\input {wmpsets_public_keys.tef} diff --git a/src/doc/intfc/wmpsets_public_keys.tef b/src/doc/intfc/wmpsets_public_keys.tef deleted file mode 100644 index 322ccf0b47357f666cfe9f6f5b269cab4f594e5e..0000000000000000000000000000000000000000 --- a/src/doc/intfc/wmpsets_public_keys.tef +++ /dev/null @@ -1,448 +0,0 @@ - - -\subsection{ Parameter WMP\_CHANNELS} -\label{.wmp.channels} - -\spbegin -{\em Prompt:} 3rd index: channel(s) ({\em may vary per application})\\ -{\em Expected input:} Character *32: 1 value -\spend -\spbegin -\svbegin\begin{verbatim} -Give the channel index-range CHN of an image-Set specification - (grp.fld.CHN.pol.typ.seq) -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} -Remember that channel 0 is the 'continuum' channel. -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} -Possible answers ([]=optional): -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} - 0 take the continuum channel - n1 take channel nr n1 (n1=0,1,2,3,....) - n1-n2[:n3] loop over channels n1 through n2 [step n3] - * loop over all channels for the field (wildcard) - n1-[*] loop over all channels for the field, - starting with n1 [step n3] -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} -Note: - The associated WMP_LOOPS keyword allows even more looping over index values. -\end{verbatim}\svend -\spend - - -\subsection{ Parameter WMP\_FIELDS} -\label{.wmp.fields} - -\spbegin -{\em Prompt:} 2nd index: field(s) ({\em may vary per application})\\ -{\em Expected input:} Character *32: 1 value -\spend -\spbegin -\svbegin\begin{verbatim} -Give the field index (range) FLD of an image-Set specification - (grp.FLD.chn.pol.typ.seq) -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} -Possible answers ([]=optional): -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} - 0 take first (or only) field - n1 take field nr n1 (n1=0,1,2,3,....) - n1-n2[:n3] loop over fields n1 through n2 [step n3] - * loop over all fields in the observation (wildcard) - n1-[*][:n3] loop over all fields in the observation, - starting with n1 [step n3] -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} -Note: - The associated WMP_LOOPS keyword allows even more looping over index values. -\end{verbatim}\svend -\spend - - -\subsection{ Parameter WMP\_GROUPS} -\label{.wmp.groups} - -\spbegin -{\em Prompt:} 1st index: grp ({\em may vary per application})\\ -{\em Expected input:} Character *32: 1 value -\spend -\spbegin -\svbegin\begin{verbatim} -Give the group index (range) GRP of an image-Set specification - (GRP.fld.chn.pol.typ.seq) -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} -Possible answers ([]=optional): -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} - 0 take first (or only) group - n1 take group nr n1 (n1=0,1,2,3,....) - n1-n2[:n3] loop over groups n1 through n2 [step n3] - * loop over all available groups (wildcard) - n1-[*][:n3] loop over all available groups, - starting with n1 [step n3] -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} -Note: - The associated WMP_LOOPS keyword allows even more looping over index values. -\end{verbatim}\svend -\spend - - -\subsection{ Parameter WMP\_LOOPS} -\label{.wmp.loops} - -\spbegin -{\em Prompt:} Loop specifications: |- ({\em may vary per application})\\ -{\em Expected input:} Character *32: 1 to 16 values -\spend -\spbegin -\svbegin\begin{verbatim} -Using the WMP_LOOPS parameter in combination with your WMP_SETS soecification, -you may specify repetitions of the operation you are currently defining, -systematically incrementing the Group, Channel, etc. indices for each new cycle. -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} -This is done by specifying here pairs of values: -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} - n1,incr1, n2,incr2, ... -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} -In each pair, the first value (n) indicates the number of times the loop has to -execute; the second value (incr) indicates how the imaqge index is to be -changed at the start of the successive loops. -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} -Example: - The specification WMP_SETS = grp.fld.1-2.* would select the combination -of all images of frequency channels 1 and 2 for the field grp.fld. If you wish -to process 32 sets of successive such pairs of frequency channels, you would -have to type in all the successive WMP_SETS specifications: -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} - grp.fld.1-2, grp.fld.3-4, ....., grp.fld.63-64 -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} -Instead, you may specify WMP_LOOPS=32,0.0.2 and the first index only for -WMP_SETS. This will cause the program to execute the present operation 32 times -in a loop, starting with your WMP_SETS specification and then incrementing its -indices by 0.0.2 for every iteration; this is equivalent to the above 32 -separate runs of the program. -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} -n must be > 0, and the increment can be any index string with simple positive -or negative integers. An increment of 0 may be omitted, i.e. the increment -specifications 0.0.3.0 and ..3 are equivalent. -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} -Loops may be nested (to a limiting depth of 8 levels). A following loop -specification is executed inside the preceding one(s). -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} -Example of NESTED loops: - To run your program for 64 fields (fld index), for 10 odd channels (chn -index) per field, starting at channel 7 and combining all polarisations (pol -index) every time, specify: -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} - WMP_LOOPS=64,.1, 10,..2 - WMP_SETS=grp.0.7.* (initial set of images) -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} -The second loop is executed as an inner loop inside the first one, that is, for -each mosaic subfield the channels are processed in a contiguous sequence. -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} -IF YOU WANT TO BE REMINDED OF WHAT IMAGES ARE IN YOUR FILE: - Type O or L in response to this prompt to get an Overview or Layout - of the file for which you need to specify the sets. -\end{verbatim}\svend -\spend - - -\subsection{ Parameter WMP\_MAPS} -\label{.wmp.maps} - -\spbegin -{\em Prompt:} 6th index: image sequence number(s) ({\em may vary per application})\\ -{\em Expected input:} Character *32: 1 value -\spend -\spbegin -\svbegin\begin{verbatim} -Give the sequence-number index (range) SEQ of an image-Set specification - (grp.fld.chn.pol.typ.SEQ) -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} -Possible answers ([]=optional): -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} - 0 take the first image - n1 take image nr n1 (n1=0,1,2,3,....) - n1-n2[:n3] loop over images n1 through n2 [step n3] - * loop over all - (wildcard) - n1-[*][:n3] loop over all available ifrs|tels, - starting with n1 [step n3] -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} -Note: - The associated WMP_LOOPS keyword allows even more looping over index values. -\end{verbatim}\svend -\spend - - -\subsection{ Parameter WMP\_POLARS} -\label{.wmp.polars} - -\spbegin -{\em Prompt:} 4th index: polarisation(s) ({\em may vary per application})\\ -{\em Expected input:} Character *32: 1 value -\spend -\spbegin -\svbegin\begin{verbatim} -Give the polarisation index (range) POL of an image-Set specification - (grp.fld.chn.POL.typ.seq) -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} - POL is a number indicating the polarisation. For interferometer data, -pol=0,1,2,3 represents XX,XY,YX,YY. For telescope data, pol=0,1 represents X,Y. -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} - This index is useful for defining loops (WMP_LOOPS parameter). -Otherwise you may find the SELECT_XYX parameter more convenient. -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} - If you prefer to use WMP_POLARS here, examples of reasonable answers -are: - * XX, XY, YX, YY - 0-3:3 XX, YY - 0 XX - 3 YY -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} -Note: - The associated WMP_LOOPS keyword allows even more looping over index values. -\end{verbatim}\svend -\spend - - -\subsection{ Parameter WMP\_SETS} -\label{.wmp.sets} - -\spbegin -{\em Prompt:} Images to process: grp.fld.chn.pol.typ.seq | ({\em may vary per application})\\ -{\em Expected input:} Character *32: 1 to 64 values -\spend -\spbegin -\svbegin\begin{verbatim} - A NEWSTAR .WMP file contains maps and antenna patterns for one or more -objects. The basic unit of data is the two-dimensional IMAGE representing -either a MAP of a piece of sky or the synthesised ANTENNA PATTERN. Images are -addressed through an IMAGE INDEX which is a string of six integers separated by -dots: -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} - grp.fld.chn.pol.typ.seq -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} - A GROUP is basically an administrative unit, allowing the user to subdivide - his data, e.g. per object. -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} - The FIELD and CHANNEL are the field and channel numbers of the observation(s) - in the .SCN file from which the image was made. These numbers are defined by - the way the observation was made and should be indentical for - all observations involved (which could, e.g., be several 12-hour mosaic - observations with different baseline sets.). -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} - POL is a code indicating the polarisation. The code distinguishes the - four components of a full polarisation represntation: -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} - 0,1,2,3 = XX.XY.YX.YY or - 0,1,2,3 = I,Q,U,V -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} - but it is your responsibility to remember which of the two representations - applies. -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} - TYP codes the type of image: 0 for a map, 1 for an antenna pattern. -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} - The image SEQ uence number distinguishes images for which all five of - the preceding indices are identical. It is used in particular to distinguish - residual maps in a CLEAN sequence. It is your responsibility to know what - the different SEQ values represent. -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} -Index values start at zero. (Remember that for the CHN index 0 is the continuum -channel.) -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} -You may select SETS of images for processing through [ranges of] values for the -five indices, e.g. -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} - 2.3-5:2.*.1-7.* -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} -The WILDCARD value '*' means 'all'. Each index may also be specified as a -RANGE: <first>-<last>[<:increment>]. Indices omitted are assumed to be '*', -i.e. ....1.0 means *.*.*.*.1.0. For wildcards at the end the dots may also be -omitted, i.e. 1.0 means 1.0.*.*.*.* -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} -The notation 3-5:2 stands for 'from 3 through 5 in steps of 2'. The step must -be positive; if it is omitted, it is taken to be 1 (as in '1-7' above). -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} -Multiple image SETS may be specified, separated by comma's: <Set1>,<Set2>,... -The associated WMP_LOOPS keyword allows even more looping over index values. -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} -IF YOU WANT TO BE REMINDED OF WHAT IMAGES ARE IN YOUR FILE: - Type O or L in response to this prompt to get an Overview or Layout - of your .WMP file. -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} -IF YOU DO NOT YET FEEL COMFORTABLE WITH THESE CONCEPTS MORE HELP IS PROVIDED: - type '' or '>' to be prompted for each of the 6 indices separately, - with more specific explanation per index. -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} -IF YOU GET BORED WITH 6-NUMBER INDICES: - Absolute Cut nrs '#<n>' can be used as an alternative. -\end{verbatim}\svend -\spend - - -\subsection{ Parameter WMP\_TYPES} -\label{.wmp.types} - -\spbegin -{\em Prompt:} 5th index: typ ({\em may vary per application})\\ -{\em Expected input:} Character *32: 1 value -\spend -\spbegin -\svbegin\begin{verbatim} -Give the type index (range) TYP of an image-Set specification - (grp.fld.chn.pol.TYP.seq) -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} -This index is most useful in loop specifications (parameter WMP_LOOPS). -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} -Possible answers: -\end{verbatim}\svend -\spend -\spbegin -\svbegin\begin{verbatim} - 0 maps only - 1 antenna patterns only - 0-1 or * both maps and antenna patterns -\end{verbatim}\svend -\spend - diff --git a/src/doc/latex/bibliography.tex b/src/doc/latex/bibliography.tex deleted file mode 100644 index 2f1a3295386f28b06e3a2a5e2bc44d3a6f34b01a..0000000000000000000000000000000000000000 --- a/src/doc/latex/bibliography.tex +++ /dev/null @@ -1,84 +0,0 @@ -% bibliography.tex: Bibliography for NEWSTAR - -\chapter{ Bibliography} - -\begin{thebibliography}{123} % {123..} is widest entry label -\bf % use boldface (except \it) - - -\bibitem{Brouw71} Brouw W.N. -{\it Data processing for the WSRT} -PhD Thesis, Leiden (1971) - -\bibitem{Brouw72} Brouw W.N. -{\it Data processing for the WSRT} -Handbook of Computational Physics (1972?) - -\bibitem{Hogbom74} H\"ogbom J.A. -{\it ...} -Astron.Astrophys.Suppl. 15, p417 (1974) - -\bibitem{Schwarz78} Schwarz U.J. -{\it ...} -Astron.Astrophys. 65, p345 (1978) - -\bibitem{Clark80} Clark B.G. -{\it ...} -(1980) - -\bibitem{Noordam81} Noordam J.E. and De Bruyn A.G. -{\it High dynamic range observations of 3C84} -Nature .. p.. (1981) - -\bibitem{Cornwell83} Cornwell T.J. -{\it ...} -(1983) - -\bibitem{Ekers83} Ekers R.D. -{\it The almost serendipitous discovery of SELFCAL} -Proceedings of IAU Symposium nr ..., -({\rm "Serendipitous discoveries in radio astronomy"}), -K.Kellermann (ed), Green Bank U.S.A. (1983) - -\bibitem{Greve84} Van Someren Greve H.W. -{\it ...} -NFRA Internal Technical Report 171 (1984) - -\bibitem{Spoelstra85} Spoelstra T.A.Th. -{\it ...} -NFRA Note 477 (1985) - -\bibitem{Tan86} Tan G.B. -{\it Multi Frequency Frontend (MFFE) receivers for the WSRT} -(1986) - -\bibitem{Spoelstra88} Spoelstra T.A.Th. -{\it ...} -NFRA Note 429 (1988) - -\bibitem{DWARF} Olnon F.M. -{\it DWARF Users Guide} -(1991) - - -\bibitem{Wieringa91} Wieringa M. -{\it 327 MHz studies of the high redshift Universe and the galactic foreground} -PhD Thesis, Leiden (1991) - -\bibitem{Brouw91c} Brouw W.N. -{\it The WNG programming environment, part 3: I/O (WNC, WNF, WND} -NFRA ITR 197c (1991) - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - -% Example: -% \bibitem[label]{key} % [label] = entry label -% <Author>: % {key} = citation key -% {\it <title>} % use \cite[note]{key} -% <Date, journal etc> % [note] = note in text - -\bibitem[...]{...} ...: -{\it ...} - -\end{thebibliography} - diff --git a/src/doc/latex/common_descr.tex b/src/doc/latex/common_descr.tex deleted file mode 100644 index 18ea580880b53532729d06c707b282a42c0e046a..0000000000000000000000000000000000000000 --- a/src/doc/latex/common_descr.tex +++ /dev/null @@ -1,322 +0,0 @@ -% -% @(#) common_descr.tex v1.2 04/08/93 JEN -% -\chapter{Common features of \NEWSTAR programs} -\tableofcontents - -%============================================================================== -\section{Running \NEWSTAR programs under DWARF} -\label{common.descr.dwarf} - -All \NEWSTAR programs run under -the Dwingeloo Westerbork Astronomical Reduction Facility (DWARF). -This means that the programs communicate with the user -via the DWARF interface, especially the DWARF parameter interface. -DWARF also provides the user with various commands -to modify the environment in which programs will be executed. -This chapter tells you enough of DWARF to be able to run your first -\NEWSTAR programs. - -A full explanation of all the DWARF possibilities can be found in the -``DWARF User's Guide'', written by Friso Olnon. - - -%------------------------------------------------------------------------------ -\subsection{DWARF environment set-up} - -Before running the programs some symbols and logicals (aliases) should be known. -Ask the System manager about the proper login commands. - -The current values of the DWARF environment variables can be viewed: - -\scmd{dwv dwarf} \sinline{dwview (see below)} -\sline{ DWARF\$0\_STREAM (program) = 1} -\sline{ DWARF\$0\_CURNODE (program) = 0} -\sline{ DWARF\$0\_ASK (program) = NO} -\sline{ DWARF\$0\_SAVELAST (program) = NO} -\sline{ DWARF\$0\_USERLEVEL (program) = BEGINNER} -\sline{ DWARF\$0\_BELL (program) = ON} -\sline{ DWARF\$0\_MESSAGEDEVICE (program) = TERMINAL} -\sline{ DWARF\$0\_EXTENDSIZE (program) = 64} -\sline{ DWARF\$0\_IOBUFSIZE (program) = 32768} -\sline{ DWARF\$0\_TEST (program) = NO} -\sline{ DWARF\$0\_LOGLEVEL (program) = 4} -\sline{ DWARF\$0\_LOGFATAL (program) = NO} -\sline{ DWARF\$0\_IDENT (local) = 143} -\sline{ DWARF\$0\_IBMODE (local) = INTERACTIVE} - -The DWARF environment variables can also be changed by typing: -\scmd{dws dwarf}\sinline{dwspecify (see below)} - - -%------------------------------------------------------------------------------ -\subsection{Running programs} -\label{common.descr.dwarf-run} - -Programs are normally run by typing: - -\scmd{exe $<$programname$>$}\sinline{(e.g. exe[cute] NSCAN)} - -Note: {\tt exe} stands for execute, and can, and this is preferred, -also be given as {\tt dwe} or {\tt dwexe}. - -The program starts running, and asks questions (parameters, or `keywords') -that will specify the action of -the program. All questions have some prompt information, and more help on the -specific question can be obtained by typing a `?' as answer. - -The type of answer (value, name, option, yes/no, ...) depends on the question. -Some answer should be a single value, some should be a list separated by commas. -In the case of a numeric list, the answer can also be of the form: start-value -[by increment] [to end-value] -There are three special answers that can always be given: - -\begin{itemize} -\item \# or $\wedge$D ($\wedge$Z) means end-of-file. - The general action is to restart the - asking of questions at a {\em higher logical level} - in the - program. In the case of options it indicates in - general the QUIT option. -\item "" means empty answer. In general this is taken to mean that no - answer is given. Depending on the keyword this can - mean to by-pass a certain action, or to go back to - another level of questions. If the answer is - essential, it will be repeated. -\item * means `all'. If interpretable it is taken as meaning "all - possible values", otherwise the question is repeated, - or a special default value is taken. -\end{itemize} - -In general (but with the exception of obvious interactive programs) all -questions for the program are asked and checked for consistency, availability of -files etc, before the program starts actually executing. - -After the program is finished, a log of the program, including the questions and -their answers and all data produced by the program, may be spooled to the -lineprinter (controlled by the common \NEWSTAR keyword {\bf LOG}, see below). -On this log you will see the answers to some questions that were never asked. -The default answers to these hidden questions need normally sufficient, -and are, therefore, not asked. -Ways to change them are given in below. - - -%------------------------------------------------------------------------------ -\subsection{Streams} -\label{common.descr.DWARF-stream} - -It is sometimes useful to run the same program in parallel, or to run a program -regularly with a specified set of answers. To be able to differentiate between -the programs, programs can be run in different streams. For all practical -purposes the program (and its parameters) have different names. -Streamnames can be any alpha-numeric string, although for practical reasons -integers may be preferred by the user: - -\sline{`program-name'\$`stream'}\sinline{(e.g. dwe nscan\$5)} - -The zero stream has a special meaning in specifying values across streams. - - -%------------------------------------------------------------------------------ -\subsection{Specifying program parameters (keywords)} - -In addition to answering questions asked, keyword values can be also be -specified beforehand. -This is especially handy if you want to run programs in Batch mode, -or you want to make sure that for a set of programs the -keyword values will be the same. - -Keyword values can be specified before a program is run, by using the -{\tt dws(pecify)} command. To answer all questions, type: - -\scmd{dws `program-name'}\sinline{(e.g. dws NSCAN)} - -All keywords (and their current values) will now be displayed one after the -other, and may be modified by the user. -The process can be stopped at any time by giving $\wedge$D ($\wedge$Z) as -answer. If you only want to specify a few keyword values only -(and know the name of the keyword), type: - -\scmd{dws `program-name'/nomenu}\sinline{(e.g. dws nscan/nom)} -\sline{: keyword=`value'}\sinline{(e.g. ha-range=-10,10)} -\sline{:} - -The prog-name can be replaced by {\tt `prog-name'\$`stream'} to -specify keyword values for a separate stream (the default stream is in -general \$1). -NB: The program name and/or stream can contain the wildcard $\ast$. - -Some questions are asked more than once in the program, for instance in -an interactive loop. -To specify all answers beforehand, seperate them in {\tt dws} with a -semi-colon (;). -However, to make really sure that all answers are given, it is much safer to -use the `Dry-run' or the `Saved-run' method (see below). - -Keywords in DWARF have several levels of default values. The decision -process is as follows: - -- is there a value for this keyword in the currect stream? If yes: use it. -\\- is there a value for this keyword in stream 0? If yes: use it. -\\- is there a value for this keyword in NGEN in this stream? If yes: use it. -\\- is there a value for this keyword in NGEN for stream 0? If yes: use it. -\\- should the program ask the keyword? If no: use program default. -\\- prompt the user for a value and use it. - -Note: NGEN is a collection of special \NEWSTAR keywords, described below. - -%------------------------------------------------------------------------------ -\subsection{Asking all} -\label{common.descr.dwarf-ask} - -All questions (including the hidden ones) will be asked if you run the program -as: - -\scmd{dwe `name' /ask}\sinline{(e.g. dwe nscan/ask)} - -Asking can also be enabled for all runs of all programs by setting -the global DWARF parameter ASK: - -\scmd{dws dwarf/nomenu} -\sline{: ask=yes} -\sline{:} - - -%------------------------------------------------------------------------------ -\subsection{Maintenance of keyword values} - -From the above it is clear that the variety of possibilities to specify -keyword values also makes the possibility of errors quite large. It is therefore -recommended to make sure that programs are run as intended. To aid in -maintaining the specified answers, run the following regularly: - -\scmd{dwv(iew) 'prog-name'[\$`stream']/extern} - -shows all current values for the specified program and stream. - -\scmd{dwc(lear) `prog-name'[\$`stream']} - -clears all current values for the specified program and stream. - - - -%------------------------------------------------------------------------------ -\subsection{Dry run.} - -A program can have a dry-run, in which all questions are asked and all checks -are done by: - -\scmd{dwe `prog-name'[\$`stream']/norun} - -In that case (except for obviously interactive program options) the program will -not run, but the answers to all questions will be remembered -for subsequent runs {\em in that particular stream}. - -%------------------------------------------------------------------------------ -\subsection{Saved run} - -All answers in any program run can be saved for later use by: - -\scmd{dwe `prog-name'[\$`stream']/save} - -Note: more than one /name can be given at a {\tt dwe} call. - -%================================================= Special subsection ======== -\section{Some common \NEWSTAR keywords} -\label{common.descr.newstar} - - -%------------------------------------------------------------------------------ -\subsection{NGEN: General keywords} -\label{common.descr.newstar.ngen} - -The following keywords (parameters) are used for most \NEWSTAR programs, but -they are usually hidden from the user (default switch /NOASK). -Their current values can be inspected by: - - -\scmd{dwv ngen} -\sline{ NGEN\$1\_LOG (program) = SPOOL /NOASK} -\sline{ NGEN\$1\_RUN (program) = YES /NOASK} -\sline{ NGEN\$1\_DATAB (program) = "" /NOASK} -\sline{ NGEN\$1\_INFIX (program) = "" /NOASK} -\sline{ NGEN\$1\_APPLY (program) = * /NOASK} -\sline{ NGEN\$1\_DE\_APPLY (program) = NONE /NOASK} -\sline{ NGEN\$1\_LOOPS (program) = "" /ASK} -\sline{ NGEN\$1\_DELETE\_NODE (program) = NO /ASK} - -More information about these keywords can be found in the Summary of -Common keywords in the next section. - -Usually, their default values are taken for the NGEN keywords, -but they may also be specified by the user in a number of ways, -for instance with {\tt dwspecify}: - -\scmd{dws `prog-name'[\$`stream']/nomenu} -\sinline{will set the keyword for specified program and stream.} - -\scmd{dws `prog-name'\$0/nomenu} -\sinline{will set the keyword for specified program and all streams.} - -\scmd{dws ngen[\$`stream']/nomenu} -\sinline{will set the keyword for all programs in the stream.} - -\scmd{dws ngen\$0/nomenu} -\sinline{will set the keyword for all programs and streams.} - -It is also possible to give (any) keyword values as switches when running -the program: - -\scmd{dwe `prog-name'[\$`stream']/keyw[=`value']}\sinline{or} -\scmd{dwe `prog-name'[\$`stream']/nokeyw} - -will set the keyword for the specified program and stream - -Some examples in the case of NGEN keywords: - -\begin{itemize} -\item {\tt /LOG= spool/yes/no/append}\\ - specify if program log should be - spooled (the name will be the first - three letters of the program name - (capital), followed by date, time, - letter (capital), .LOG), made but not - spooled (name will be PROG-NAME.LOG), - not made, appended to PROG-NAME.LOG. -\item {\tt /LOG X /LOG=spool} -\item {\tt /NOLOG X /LOG=no} -\item {\tt /RUN}\\ - run the program -\item {\tt /NORUN}\\ - start the program, ask all questions, - save all the keyword values (as if specified). - This can be used to prepare a batch run for intance. -\item {\tt /INFIX= 'node shorthand'}\\ - specify a part of the node name that is always the same (see later) -\item {\tt /INFIX X /INFIX=""} -\item {\tt /NOINFIX X /INFIX=""} -\item {\tt /APPLY=list-of-options}\\ - specify the corrections to be applied to data (see later for full - explanation). The list can contain one or more of: - ALL, NONE, RED, ALG, OTH, EXT, POL, - FAR, MOD, IFR, MIFR , NORED, ... NOMIFR -\item {\tt /APPLY X /APPLY=*}\\ -\item {\tt /NOAPPLY X /APPLY=NONE}\\ -\item {\tt /DE\_APPLY='list-of-options'}\\ -\item {\tt /DE\_APPLY X /DE\_APPLY=NONE}\\ -\item {\tt /NODE\_APPLY X /DE\_APPLY=*}\\(i.e. NO DE\_APPLY) -\end{itemize} - -%---------------------------------------------------------------------- -\subsection{Some frequently used \NEWSTAR keywords} -\label{common.descr.NEWSTAR-other} - -Some other keywords are also used by many \NEWSTAR programs, -but not hidden to the user. -They are usually concerned with the -selection of data: {\bf SETS, POLARISATION, SELECT\_IFRS, HA\_RANGE, -AREA}. There are also some others. They have been collected into this -`common' section to emphasize their communality, and also to make it -possible to treat some of them in some more detail. -More information about these keywords can be found in the Summary of -Common keywords in the next section. diff --git a/src/doc/latex/doc_guide.tex b/src/doc/latex/doc_guide.tex deleted file mode 100644 index 3a1844921e79435996f97ae8b58c094eebb2eea0..0000000000000000000000000000000000000000 --- a/src/doc/latex/doc_guide.tex +++ /dev/null @@ -1,789 +0,0 @@ - -% NOTES: -% 1. This is a "meta"-document, i.e. a document that describes LaTeX -% commands using \verb and \verbatim. Latex2html understands verbatim -% environments incompletely and is prone to the mistake of trying to execute -% commands within them. To prevent this from happening, the escape sequence -",," -% is used instead of a "\" where necessary. -% \verb/ndoc Cook/ preserves these through LaTeX2html and then -substitutes -% them in the .html file. -% \verb/ndoc Print/ removes them before submitting the file to LaTeX. -% -% History -% JPH 940628 Original -% JPH 940719 Fix errors, expand/clarify at various places -% JPH 940915 Add caption bug; \ref bug -% Revise Figures section to reflect new methods -% Revise sectioning/subsectioning -% JPH 940916 Make compilable -% JPH 941027 Add escapes for sequences that were unintendedly -% translated -% JPH 941031 Remove keyref -% JPH 941110 Shift position of /label in figure declaration -% JPH 941121 Replace "\<escape>" by ",," to make robust against -% changes/variants of unix utilities. (Perhaps a more -% "improbable" escape sequence must be found.) -% Use rawhtml environment for script section. -% JPH 950213 Fix some '\verb/,,textref\' which cause 'Ouput line too -% long' and 'Undefined control sequence': Replace \ by -'' -% HjV 950615 Use $n_l2h iso. ~jph. Correct some typo's -% JPH 950824 Replace \s by ,,s. Update sections on referencing -% commands -% JPH 951016 LaTeX caption bug. - doc_sources_and_print.cap. -% JPH 960326 Line-too-long bug. -% JPH 960508 Formulas-in-l2h section at end -% -% -\newcommand{\bi}{ \begin{itemize} } -\newcommand{\ei}{ \end{itemize} } -\newcommand{\noi}{ \noindent} -\newcommand{\ndoc}{ \verb/ndoc/} -\newcommand{\ltoh}{ \verb/latex2html/ } -\newcommand{\tex}{ \verb/.tex/ } - - -\chapter{Guide for writing and maintaining \NEWSTAR documents} - -\tableofcontents - -\section{ Summary of \NEWSTAR LaTeX commands } - - For quick reference use the following list of special LaTeX commands -available in the \NEWSTAR documentation system: -\\ \\ -\textref{ascref}{.cross.ref.other} \\ -\textref{Ascref}{.cross.ref} \\ -\textref{caption}{.caption} \\ -\textref{chapter}{.layout} \\ -\textref{eqref}{.eqref} \\ -\textref{Eqref}{.eqref} \\ -\textref{fig}{.caption} \\ -\textref{figref}{.figref} \\ -\textref{Figref}{.figref} \\ -\textref{label}{.cross.ref.latex} \\ -\textref{ps}{.ps} \\ -\textref{psref}{.cross.ref.other} \\ -\textref{Psref}{.cross.ref} \\ -\textref{ref}{.cross.ref.latex}: {\em Not to be used} \\ -\textref{tableofcontents}{.layout} \\ -\textref{textref}{.cross.ref.latex} \\ -\textref{Textref}{.cross.ref} \\ -\textref{whichref}{.cross.ref} \\ - - -\section{ The \NEWSTAR documentation system} - - The \NEWSTAR documentation system provides documentation in two forms: -An on-line hypertext system based on the public-domain program "xmosaic" and -standard LATeX documents. Both forms are derived from a single set of LaTeX -source files; for the hypertext form, the public-domain translator \ltoh is -used. - - Broadly speaking, authors are free to use the standard LaTeX -constructs. In particular, \ltoh handles tabular material, mathematical -formulas and the inclusion of diagrams very well. Writers should be aware, -however, that every bit of math-mode text is translated into a little bitmap -that must be loaded separately for display. This considerably slows down both -the processing by \verb/ndoc Cook/ and the display by xmosaic. - - Simple macros defined through -\verb/,,newcommand/ can be used freely, but complicated nesting of macros -should be avoided. - - To satisfy the specific needs of the \NEWSTAR system and circumvent -some deficiencies of \ltoh, the guidelines given below should be followed. - - -\subsection{ LaTeX and ASCII documents} - - The official format for \NEWSTAR document sources is LaTeX. It is, -however, considered more important that documentation exist at all than that it -have a finished form. {\em Users are strongly invited to submit any bits of -text that they consider to be of potential use to others.} Such contributions -will quickly be integrated with the system and the \NEWSTAR group will assume -responsibility for their further maintenance, including their eventual -conversion to or integration with the LaTeX document collection. - - -\section{ Guidelines for writing LaTeX documents} - -\subsection{ General layout} -\label{.layout} - -\bi -\item Preamble - - The document compiler \ndoc automatically inserts a preamble including -the \verb/,,begin{document}/ and also appends the \verb/,,end{document}/. The -source of a document may add private preamble elements such as -\verb/,,newcommand/ definitions. Apart from that, the first document line is -the -\verb/,,chapter/ line: - -\item \verb/,,chapter{<text>}/ - - The chapter is the basic documentation unit. \ndoc formats the argument -\verb/<text>/ as a hypertext or printed document title. - - -\item \verb/,,tableofcontents/ - - This creates a standard table of the chapter's contents in the printed -document and an equivalent unnumbered table with links to the -(sub)(sub)sections in the hypertext display. - - -\item \verb/,,[sub]sub]]section{<text>}/ - - These commands produce standard section headings, numbered in the -printed document, unnumbered in the hypertext display. -\ei - - -\section{ Cross-references} -\label{.cross.ref} - - In writing documents, the placeholder \verb/,,whichref{text}{}/ can be -used for references whose target is not yet known. - - For most referencing commands, a companion with the leading character -capitalised is available; these work the same way except that the text argument -is printed in boldface. This feature is intended for use in the documentation -home-page document, \verb/hb_contents.tex/. - - -\subsection{ Cross-references to text in LaTeX documents } -\label{.cross.ref.latex} - - Cross-references must work in both the printed and hypertext versions -of a document. For this reason, {\it the standard LaTeX \verb/,,ref/ command is -unsuitable} and the rules given below must be followed instead. - -\bi -\item \verb/,,label{.<label>}/ - - A label name {\em must start in a dot} as shown. LaTeX {\em forbids the -use of underscores in labels}, even if they are escaped by a backslash; it is -recommended to use {\em dots} instead. - -\item \verb/,,textref{<text>}{.<label>}/ - - This is translated for the printed document as \verb/<text> (sec. -<section number>)/. In the hypertext display, \verb/<text>/ becomes a hypertext -link to \verb/<label>/. \verb/<text>/ may have a local format of its own, e.g. -\verb/{\em <text>}/ or \verb/{\bf <text>}/. - -\item \verb/,,textref{<text>}{<file name>.<label>}/ - - This is the form for a reference to a label in an external file. In the -printed document it becomes \verb/<text>/ with a numbered footnote showing the -directory and name of the target file's source and the target label. - - \verb/<file name>/ is the name of a .tex file (without the .tex -extension!) in directory \verb:\$n\_doc/latex:; the name may contain {\em -neither dots nor uppercase characters}, but underscores are allowed (and need -not to be quotes with a backslash). - -\item \verb/,,whichref{<text>}{}/ - - can be used as a placeholder for a \verb/,,textref/ whose target is as -yet unknown. - -\ei - -\subsection{ Cross-references to other types of documents} -\label{.cross.ref.other} - - The documentation system also contains ASCII documents and PostScript -documents imported from elswehere. Such documents may be referred to through -the following commands: - -\bi -\item \verb/,,ascref{<text>}{<file name>}/ -\item \verb/,,psref{<text>}{<file name>}/ -\ei - - \verb/<file name>/ is the name (without extension!) of a .txt file in -directory \verb:\$n\_doc/txt: or of a .ps file in directory \verb:\$n\_hlp:; -the name may contain {\em neither dots nor uppercase characters}, but -underscores are allowed (and need not to be quotes with a backslash). - -\bi -\item \verb/,,srcref{<text>}{<directory><file name><extension>}/ -\ei - - This command is used to refer to program code or WNTINC table -definitions (.dsc files). \verb/directory/ must be specified relative to -\verb/n_src/ and the file extension must be included. - - -\subsection{ Equations and equation references} -\label{.eqref} - - The commands \verb/,,Eqref{.<label>}/ and \verb/,,eqref{.<label>}/ are -entirely analogous to the \textref{figure references}{.figref} -\verb/,,Figref/ and \verb/,,figref/. - - -\section{ Figures and figure references} -\label{.fig} - - Figures with their captions reside in the directory -\verb:\$n\_doc/fig:. A figure consists of two components: -\bi - -\item a \verb:<name>.cap: {\em caption file} containing a caption and a the -directive to include the figure. - -\item the diagram proper in the form of either an \verb/xfig/ drawing -\verb:<name>.fig:, or a binary (e.g. \verb/<name>.ps/ or \verb/<name>.gif/) -file. -\ei - - A figure with its caption is included in a document source file through -the command - -\verb: ,,input{../fig/<name>.cap: \ - -In the printed document, figure and caption are included in the standard way. -In the hypertext display the word \verb/FIGURE/ is included, followed by the -caption text, with a hypertext link from FIGURE to a postscript file. \ndoc -generates that file automatically from the .fig file. - - -\subsection{ Caption files} -\label{.caption} - - The purpose of the caption file (as opposed to spelling out the caption -text in the document source) is to enable the figure with its caption to exist -as an independent unit that can be included in more than one document and also -exist outside the context of any document. - - The caption file must not only provide the caption, but also the title -under which the figure may be listed in the Handbook Overview. It is therefore -important to adhere strictly to the following format: - - -\begin{verbatim} - ,,begin{figure}[htbp] - ,,fig{<name>} - ,,caption[]{<optional LaTeX commands, e.g. \it> - <title> - <optional LaTeX commands, e.g. \> <optional remainder of caption> - } - ,,label{.<label>} - ,,end{figure} -\end{verbatim} - -\noi Examples can be found in the -\verb:/\$n\_doc/fig: directory. - - You are free to choose the label; the recommended choice, however, is -the file name with underscores replaced by dots. (Remember that underscores are -illegal in labels and that labels must start with a dot.) - - Comment lines (but no {\em empty} lines!) may be arbitrarily added, -except that the \verb/<title>/ line must {\em immediately follow} the -\verb/,,caption/ command. - - -\subsection{ Xfig figures} -\label{.xfig} - - \verb/.fig/ files may be created without any restrictions with the -public-domain program \verb/xfig/. It is not necessary to produce a postscript -file with this program. \ndoc/ will take the \verb/.fig/ file and convert it -automatically. - - Often, figures drawn on a convenient scale on a workstation screen will -not fit on a standard A4 page. \ndoc/ may be instructed to automatically reduce -its scale by including in the figure a text line - -\verb/ <file name>.fig <nn>/ % -It is best to put this text in an inconspicuous corner and a small font (e.g. -10pt as opposed to a standard 20pt). - - -\subsection{ Postscript figures} -\label{.ps} - - It is also possible to include Postscript figures produced in other -ways than through xfig: Use the command \verb/,,ps{<filename>}/ instead of -\verb/,,fig/ and place the postscript file \verb/<filename>.ps/ in the -directory \verb:/\$n\_doc/bin: with a soft link to it in \verb/\$n\_hlp/. If it -can not be easily recovered, it is advisable to protect it against accidental -deletion! - - -\subsection{ Figure references} -\label{.figref} - - For references to figures, use - -\verb/ ,,figref{.<label>}/ and \verb/ ,,Figref{.<label>}/ - -\noi These commands translate to hypertext links \verb/figure/ or \verb/Figure/ -in the hypertext document, and to a standard reference \verb/figure <n>/ or -\verb/Figure <n>/ in the printed document. - - -\section{ Session transcripts} - - Verbatim transcripts of pieces of terminal dialogue controlling program -execution are an important ingredient to documentation. Such transcripts are -easily produced through the command - - \verb/ndoc S[cript] <file name>/ - -This starts a cshell script session in which you execute the program of which -you want a transcript. After exit from the script session, the collected script -is automatically formatted into a LaTeX file \verb/<file name>.trs/; what -remains for you to do is to cut out the irrelevant parts and perhaps add some -comments. A sample section of such a file is shown below - -\spbegin -\svbegin \begin{verbatim} % -,,spbegin %.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+. -,,skeyword{USE\_SCN\_NODE} ,,sprompt{(input node name)} ,,sdefault{= *:} -,,suser{?} % -,,svbegin ,,begin{verbatim} - Specify the node name from which the corrections should be calculated. - * indicates the same as the output node name. -\end{verbatim}\svend -\verb/,,end{verbatim},,svend/ -\svbegin\begin{verbatim} ,,spend -%.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-. -% -,,spbegin %.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+. -,,skeyword{USE\_SCN\_NODE} ,,sprompt{(input node name)} ,,sdefault{= *:} -,,suser{*} ,,sinline{Use the same SCN file} ,,spend -%.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-. -% -,,spbegin %.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+. -,,skeyword{USE\_SCN\_SETS} ,,sprompt{(Set(s) of input uv-data Sectors: -g.o.f.c.s)} ,,sdefault{= "":} ,,suser{2.0.0.0.0} ,,sinline{Sets in job 2} -,,spend %.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-. -% -,,spbegin %.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+. -,,skeyword{HA\_RANGE} ,,sprompt{(DEG) (HA range)} ,,sdefault{= *:} -,,suser{,,scr} ,,sinline{Use all scans in these sets} % -,,svbegin ,,begin{verbatim} - 0123456789ABCD - 0 -+++++++++++++ - 1 -++++++++++++ - 2 -+++++++++++ - 3 -++++++++++ - 4 -+++++++++ - 5 -++++++++ - 6 -+++++++ - 7 -++++++ - 8 -+++++ - 9 -++++ - A -+++ - B -++ - C -+ - D - -\end{verbatim}\svend -\verb/,,end{verbatim}\svend/ -\svbegin\begin{verbatim} -,,spend%.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-./ -\end{verbatim}\svend -\spend - - The file consists of sections delimited by \verb/,,spbegin/ and -\verb/,,spend/, each consisting of a prompt with its reply and the ensuing -output from the computer. LaTeX will treat these sections as blocks in which a -page break can not occur. The following LaTeX commands are used: - -\bi - -\item \verb/,,skeyword/, \verb/,,sprompt/ and \verb/,,sdefault/ are the -components of a program prompt; - -\item \verb/,,suser/ is the user's reply (in which \verb/,,scr/ represents a -null reply (carriage return only) and \verb/,,seof/ an end-of-file -(control-D)).; - -\item \verb/,,sinline/ is an inline comment typed in during the session (an -exclamation mark plus text following the answer to a prompt); - -\item \verb/,,svbegin/ and \verb/,,svend/ delimit the verbatim section in -which computer output is rendered. - -\ei - - It is necessary to check these scripts with some care. The system does -occasionally get confused by the way the parameter interface splits long input -and output lines. The errors are usually easily corrected. - -\bi - -\item To replace parts of lengthy computer output, e.g. by ellipses; note -that, since this occurs inside \verb/verbatim/ sections, LaTeX commands such as -\verb/,,vdots/ can not be used. A line consisting of just three dots gives a -satisfactory effect. - -\item To add \verb/,,sinline/ comments. These must be placed either -immediately following \verb/,,suser/ commands or between an -\verb/,,end{verbatim}/ and the adjacent \verb/,,svend/. - -\item To reduce the size of verbatim sections that are more than 80 -characters wide (e.g. sections from a log file). - -\ei - - -\section {Documentation directories} - -\input{../fig/doc_sources_and_hyper.cap} -\input{../fig/doc_sources_and_print.cap} - - The documentation system encompasses three classes of files. The -document source files reside in subdirectories of \verb/$n_doc/; the code -source files which may also be referenced reside in subdirectories of -\verb/$n_src/. All hypertext files reside in a tree of subdirectories rooted in -\verb/\$n\_hlp/. The interrelations of all these files are shown in -\figref{.doc.sources.and.hyper}. - - The following types of source texts are used: -\bi -\item Narrative LaTeX source texts: \verb:$n_doc/latex/<name>.tex: - -\item Caption LaTeX source texts: \verb:$n_doc/fig/<name>.cap: - -\item Standardised LaTeX files describing the private and public program -parameter interfaces: \verb:$n_doc/intfc/<name>.tex:. These files incorporate -\verb/.tef/ files derived from the program-parameter definition files -(\verb/<name>.psc/). - -\item ASCII texts: \verb:$n_doc/txt/<name>.txt: - -\item Postscript files for which no source exists: \verb:$n_doc/ps/<name>.ps: - -\item Code sources: \verb:$n_src/<directory>/<name>.<extension>: -\ei - - In processing, temporary files are created in the current directory; -their names either contain the string \verb/\_tmp./ or end in \verb/.tmp/. -\ndoc normally deletes them when exiting. - - \verb/latex2html/, invoked by \verb/ndoc Cook/, translates each file -\verb/<name>.tex/ into a file -\verb:\$n\_hlp/<name>/<name>.html:. A large number of -\verb/.html/ files are therefore in subdirectories of -\verb/\$n\_hlp/. - - \verb/ndoc Print/ creates .ps PostScript text files in \verb/\$n\_hlp/. - \verb/ndoc Fig/ creates .fps PostScript diagram files in -\verb/\$n\_hlp/. - - - - -\section {Processing commands} - -\subsection{ Programmer's commands: Processing individual files } - - The commands are of the form - - \verb/ndoc <operation> [-<option>] <file>/ - - \verb/<file>/ is the full file name including the extension, and it -must be in the current directory. Wildcards may be used. - - The \verb/<operation>/ and \verb/-<option>/ arguments may be -abbreviated and are case-insensitive. The following operations and options are -available: - -\bi -\item \verb/P[rint]/ creates [a] PostScript file[s] from [a] .tex source -file[s], with the following options: - \bi - \item[] \verb/-S[yntax]/ do nothing else; - \item[] \verb/-V[iew]/ display the output using ghostview; - \item[] \verb/-P[rint]/ print the PostScript output. - \ei - -\verb/Print/ uses the LaTeX program. It attempts to suppress the verbose output -of this program by filtering out everything except essential error messages. If -you encounter a problem that you can not solve, submit your source file to the -\NEWSTAR group for diagnosis. - -\item \verb/C[ook]/ creates a Hypertext file from [a] .tex document[s]. This -operation makes use of \ltoh. This program may crash over LaTeX syntax errors -without properly analysing them. {\em It is therefore recommended to first do a -\verb/Print -Syntax/ check.} - -\item \verb/K[ey]/ creates Hypertext files from [a] .pin, .psc or .pef -file[s] - -\item \verb/L[ink]/ creates the softlinks from the \verb/n_hlp/ directory to -the \verb:$n_doc/txt: and \verb:$n_src: directories. -\ei - - \ndoc checks the dates of its input and output files. If the output is -newer than the date, \ndoc emits a message and proceeds with the next input -file. This check is incomplete in that it does not check the status of -\verb/,,input/ files such as figure captions. - - There are two ways of bypassing this check: -\bi -\item Setting the environment variable \verb/n_force/. -\item \verb/touch/ing the inpout file to set its modification time to the -present time. -\ei - - When working in a shadow system, \ndoc makes no difference between hard -copies and soft links to the master system: Both are unconditionally compiled. - - -\subsection{ \NEWSTAR manager's commands: Maintaining the documentation system -} - - To recompile the entire documentation collection from its sources, one -uses the command - -\verb/ ndoc All/ - -\noindent \ndoc will ask which parts of the system to recompile, the default -being 'yes' for all subsystems. In this mode of operation \ndoc bypasses the -check for an up-to-date output file. - - One of the actions available in \verb/ndoc All/ is a systematic check -of the correspondence between source and output files. This is a very useful -action because it clears up leftovers of obsolete documents and pinpoints areas -of trouble. - - - - -\section{ Debugging .tex files} - - \ndoc goes a long way in filtering from the verbiage that LaTeX spews -out the essential diagnostics. It shows the essential section of LaTeX output -where the error is reported (including a line number) plus five lines of text -in the middle of which the error was found. Very often this information -suffices to pinpoint the error. If it does not, you may have to take a better -look either at your source or at the \verb/<file name>_tmp.tex/ file that is -the file LaTeX was actually processing. Note that the line number reported -refers to this latter file! - - Specific errors that have been encountered and are not covered by this -diagnosis mechanism are described below. - - -\subsection{ Temporarily disabling parts of .tex files} - - \ndoc provides a simple facility for "commenting out" large parts of -\tex input files: \verb/.c+/ and \verb/.c-/ can be inserted (on lines -containing nothing else) to delimit a piece of text that must be ignored. This -has proved very useful to quickly pinpoint the location where an error occurs. - - -\subsection{ Specific errors} - -\subsection{ LaTeX bugs} - - Both \verb/ndoc Print/ and \verb/ndoc Cook/ make use of LaTeX and may -therefore be affected by LaTeX bugs. For cases not covered here, refer to "The -LaTex Book", which is probably the best informed source about that program. - -\bi -\item Symptom: - {\em The word \verb/dump/ appears in the place of a Figure or Table.} - - This is an obscure problem. One situation in which it has been observed -is when a \verb/,,figure/ environment is put at the very start of a document, -i.e. without any preceding text. (This condition will not occur for regular -documents but may occur in test situations.) It has also been seen in a case -where a \verb/tabular/ environment was nested inside a \verb/table/, in which -case the solution was to remove the \verb/table/ environment. - -\item Symptom: - {\em LaTeX complains about a 'runaway argument' in a \verb/,,caption/ -environment.} - - This may happen when the optional argument in square brackets is -omitted. As of 940914, this argument is automatically provided for by -\verb/doc_preprocess.csh/. - -\item Symptom: - {\em ndoc Print runs without reporting any error, but produces a -PostScript file in which figure references appear without numbers filled in.} - - This happens when the \verb/,,label/ directive in a \verb/figure/ -declaration is placed before the \verb/,,caption/ command.! - -\item Symptom: - {\em LaTeX reports: TeX capacity exceeded, sorry [parameter stack -size=60].} - - This has been seen to happen when a \verb/,,section/ title argument is -too complicated, e.g. because it contains italicised text. - -\item Symptom: - {\em LaTeX finds a \$ or \_ in a \verb/,,textref/ file argument that is -not escaped by a preceding backslash.} - - This may happen when the expansion of a command defined through -\verb/,,newcommand/ contains a \textref{referencing command}{.cross.ref}. Fix -the problem by including escape charaters in the \verb/,,newcommand/ -definition. - -\item Symptom: - {\em LaTeX complains about "Paragraph ended before \verb/,,sbox/ was -complete" in a figure caption.} - - The \verb/,,caption/ environment appears to be sensitive to formatting. -In particular new paragraphs (i.e. blank lines) and \verb/,,indent/ commands -have been noted to produce this nasty error. In some cases it was found -necessary to put the \verb/,,label/ before the \verb/,,caption/. -\ei - - -\subsection{ Processing errors in ndoc} - - When LaTeX reports an error to \ndoc, \ndoc displays a five-line text -section in the middle of which the error occurred. This is not from the -original input text, but from the preprocessed text as it was eventually -presented tp LaTeX. Most errors are easily recognised and traced back to the -input \tex file. - -\bi -\item Symptom: - An error occurs which is associated with lines from the .tex input that -were concatenated by ndoc. - - This may very well be an error in the algorithm used by ndoc to merge -paragraphs into single long lines. It is not necessarily clear why LaTeX does -not accept the long line. An any rate, the recommended action is to check with -the \NEWSTAR manager. - -\item Symptom: - ndoc cook stops with message -\verb/ nawk: record `[...]' has too many fields/ - - In preprocessing documents, ndoc formats paragraphs into single lines -to make it easier to identify LaTeX command sequences. Find the offending -paragraph in you documents and insert \verb/<newline><blank>/ at some -appropriate place. The leading paragraph will inhibit the merger of the two -parts of the paragraph, yet LaTeX will format the two parts into one paragraph. - -\ei - - -\subsection{Processing errors in \protect\verb/ndoc Cook/} - - The program \ltoh on which \verb/ndoc Cook/ is based is rather lax on -checking LaTeX syntax but may stumble over the consequences of an error missed. -{\it It is therefore strongly recommended to first check the syntactical -correctness of the .tex file through \verb/ndoc P/}. - -\bi -\item Symptom: - \verb/.DVI file can't be opened/ - - \ltoh runs LaTeX on a selection from the .tex file consisting of -formulas, tabular material and diagrams. This run failed to produce a -\verb/.dvi/ file, but \ltoh gobbled up all the error information. This error -may be due to improper configuration of your system, {\em e.g.} a misplaced -\verb/.sty/ file. It is virtually impossible to diagnose except by using a -\textref{modified version of \ltoh}{.latex2html}. - -\item Symptom -\begin{verbatim} The nplot_descr.aux file was not found, so sections will not -be numbered and cross-references will be shown as icons. -\end{verbatim} - - Your .tex file contains a \verb/,,ref/ directive. Convert al -\verb/,,ref/s to \verb/,,textref/s. - -\item Symptom: - Commands that are normally accepted are reported as unknown. - - This is likely to be the result of a syntax error. (For example, a -missing \verb/,,end{itemize}/ will cause \verb/,,item/ to be reported as -unknown.) Check your input file by running \verb/ndoc Print/ on it. - -\item Symptom: - \verb/xmosaic/ can not find a file pointed at by a hypertext link. - - Note the file name appearing at the bottom of the \verb/xmosaic/ window -when you point at the reference. This reference should be in either of the -forms: - - \verb:<file name>/<file name>.html -\indent \verb:../<file name>/<file name>.html - -If it starts in a \verb:/:, you have to replace your \ltoh by the -\textref{modified version}{.latex2html}. - -\item Symptom: - \verb/latex2html/ warns that the \verb/.aux/ file was not found but -otherwise \verb/ndoc Cook/ seems to complete normally. - - The precise nature of this error is not understood, but it seems to -indicate that something is wrong in a cross-reference. (e.g. a LaTeX -\verb/,,ref/ command). It has been seen to occur when a \verb/,,ref/ with a -label name containing dots is used (cf. the section on \textref{cross -references}{.cross.ref}). -\ei - - -\appendix - -\section{\protect\ltoh} -\label{.latex2html} - - \ltoh is a public-domain perl script created by Nikos Drakos at Leeds -University, England (Email: nikos@cbl.leeds.ac.uk) and available through -anonymous ftp. It has been found to be a reliable and highly capable program. -Apart from configuring it to the local environment, two changes were found -necessary: - -\bi -\item All lines containing the string \verb:s/\W//g: must be commented out by -prefixing them with a \verb/#/. This makes \ltoh capable of handling relative -file references and removes an inconsistency it the processing of labels and -references. - -\item After the line - -\indent \verb/system("$LATEX $$_images.tex");/ - -insert the lines - -\begin{verbatim} - if (!-e "20756_images.dvi") - {system("cat 20756_images.log"); die "Failure to process formulas"; } -\end{verbatim} -\ei - -\subsection{ Formulas and the like in \protect\ltoh} -\label{.formulas} - - LaTeX allows many constructs, such as formulas, tables etc., for which -there is no HTML counterpart (yet). \ltoh converts each single occurrence of -these into a little picture file that is linked in-line into the \verb/.html/ -document. The pictures are stored in \verb/.xbm/ files in the same directory as -the \verb/.html/ file. - - Since building these pictures is a very time-consuming process, \ltoh -seeks to reuse them as much as possible whenever it recompiles a \verb/.tex/ -file. To this end, it maintains an administration in the file \verb/images.pl/ -in the \verb/.html/ file's directory. Therefore, to insure the integrity of the -.html document, both the \verb/.xbm/ files and \verb/images.pl/ must be left in -place. As of May 1996, \verb/doc_cook.csh/ contains a section of code that -finds all in-line picture references in the renewed \verb/.html/ file, reports -any referred-to files that are missing and deletes unreferenced \verb/.xbm/ -files. - - In cases a \verb/.xbm/ file is reported missing, the way to get it -rebuilt is to delete \verb/images.pl/ in order to force \ltoh to rebuild all -the picture files from scratch. - - - diff --git a/src/doc/latex/doc_guide_tmp.0 b/src/doc/latex/doc_guide_tmp.0 deleted file mode 100644 index ed0b816e098b2ce09602d8ad4f9ae8f37edeb5c9..0000000000000000000000000000000000000000 --- a/src/doc/latex/doc_guide_tmp.0 +++ /dev/null @@ -1,767 +0,0 @@ - -% -% -% -% -% -",," -% -% -substitutes -% -% -% -% -% -% -% -% -% -% -% -% -% -% -% -% -% -% -% -% -'' -% -% -% -% -% -% -% -% -\newcommand{\bi}{ \begin{itemize} } -\newcommand{\ei}{ \end{itemize} } -\newcommand{\noi}{ \noindent} -\newcommand{\ndoc}{ \verb/ndoc/} -\newcommand{\ltoh}{ \verb/latex2html/ } -\newcommand{\tex}{ \verb/.tex/ } - - -\chapter{Guide for writing and maintaining \NEWSTAR documents} - -\tableofcontents - -\section{ Summary of \NEWSTAR LaTeX commands } - - For quick reference use the following list of special LaTeX commands available in the \NEWSTAR documentation system: -\\ \\ -@0@\textref@1@{ascref}@4@{@3@.cross.ref.other} \\ -@0@\textref@1@{Ascref}@4@{@3@.cross.ref} \\ -@0@\textref@1@{caption}@4@{@3@.caption} \\ -@0@\textref@1@{chapter}@4@{@3@.layout} \\ -@0@\textref@1@{eqref}@4@{@3@.eqref} \\ -@0@\textref@1@{Eqref}@4@{@3@.eqref} \\ -@0@\textref@1@{fig}@4@{@3@.caption} \\ -@0@\textref@1@{figref}@4@{@3@.figref} \\ -@0@\textref@1@{Figref}@4@{@3@.figref} \\ -@0@\textref@1@{label}@4@{@3@.cross.ref.latex} \\ -@0@\textref@1@{ps}@4@{@3@.ps} \\ -@0@\textref@1@{psref}@4@{@3@.cross.ref.other} \\ -@0@\textref@1@{Psref}@4@{@3@.cross.ref} \\ -@0@\textref@1@{ref}@4@{@3@.cross.ref.latex}: {\em Not to be used} \\ -@0@\textref@1@{tableofcontents}@4@{@3@.layout} \\ -@0@\textref@1@{textref}@4@{@3@.cross.ref.latex} \\ -@0@\textref@1@{Textref}@4@{@3@.cross.ref} \\ -@0@\textref@1@{whichref}@4@{@3@.cross.ref} \\ - - -\section{ The \NEWSTAR documentation system} - - The \NEWSTAR documentation system provides documentation in two forms: An on-line hypertext system based on the public-domain program "xmosaic" and standard LATeX documents. Both forms are derived from a single set of LaTeX source files; for the hypertext form, the public-domain translator \ltoh is used. - - Broadly speaking, authors are free to use the standard LaTeX constructs. In particular, \ltoh handles tabular material, mathematical formulas and the inclusion of diagrams very well. Writers should be aware, however, that every bit of math-mode text is translated into a little bitmap that must be loaded separately for display. This considerably slows down both the processing by \verb/ndoc Cook/ and the display by xmosaic. - - Simple macros defined through -\verb/,,newcommand/ can be used freely, but complicated nesting of macros should be avoided. - - To satisfy the specific needs of the \NEWSTAR system and circumvent some deficiencies of \ltoh, the guidelines given below should be followed. - - -\subsection{ LaTeX and ASCII documents} - - The official format for \NEWSTAR document sources is LaTeX. It is, however, considered more important that documentation exist at all than that it have a finished form. {\em Users are strongly invited to submit any bits of text that they consider to be of potential use to others.} Such contributions will quickly be integrated with the system and the \NEWSTAR group will assume responsibility for their further maintenance, including their eventual conversion to or integration with the LaTeX document collection. - - -\section{ Guidelines for writing LaTeX documents} - -\subsection{ General layout} -\label{.layout} - -\bi -\item Preamble - - The document compiler \ndoc automatically inserts a preamble including the \verb/,,begin{document}/ and also appends the \verb/,,end{document}/. The source of a document may add private preamble elements such as -\verb/,,newcommand/ definitions. Apart from that, the first document line is the -\verb/,,chapter/ line: - -\item \verb/,,chapter{<text>}/ - - The chapter is the basic documentation unit. \ndoc formats the argument -\verb/<text>/ as a hypertext or printed document title. - - -\item \verb/,,tableofcontents/ - - This creates a standard table of the chapter's contents in the printed document and an equivalent unnumbered table with links to the (sub)(sub)sections in the hypertext display. - - -\item \verb/,,[sub]sub]]section{<text>}/ - - These commands produce standard section headings, numbered in the printed document, unnumbered in the hypertext display. -\ei - - -\section{ Cross-references} -\label{.cross.ref} - - In writing documents, the placeholder \verb/,,whichref{text}{}/ can be used for references whose target is not yet known. - - For most referencing commands, a companion with the leading character capitalised is available; these work the same way except that the text argument is printed in boldface. This feature is intended for use in the documentation home-page document, \verb/hb_contents.tex/. - - -\subsection{ Cross-references to text in LaTeX documents } -\label{.cross.ref.latex} - - Cross-references must work in both the printed and hypertext versions of a document. For this reason, {\it the standard LaTeX \verb/,,ref/ command is unsuitable} and the rules given below must be followed instead. - -\bi -\item \verb/,,label{.<label>}/ - - A label name {\em must start in a dot} as shown. LaTeX {\em forbids the use of underscores in labels}, even if they are escaped by a backslash; it is recommended to use {\em dots} instead. - -\item \verb/,,textref{<text>}{.<label>}/ - - This is translated for the printed document as \verb/<text> (sec. <section number>)/. In the hypertext display, \verb/<text>/ becomes a hypertext link to \verb/<label>/. \verb/<text>/ may have a local format of its own, e.g. -\verb/{\em <text>}/ or \verb/{\bf <text>}/. - -\item \verb/,,textref{<text>}{<file name>.<label>}/ - - This is the form for a reference to a label in an external file. In the printed document it becomes \verb/<text>/ with a numbered footnote showing the directory and name of the target file's source and the target label. - - \verb/<file name>/ is the name of a .tex file (without the .tex extension!) in directory \verb:\$n\_doc/latex:; the name may contain {\em neither dots nor uppercase characters}, but underscores are allowed (and need not to be quotes with a backslash). - -\item \verb/,,whichref{<text>}{}/ - - can be used as a placeholder for a \verb/,,textref/ whose target is as yet unknown. - -\ei - -\subsection{ Cross-references to other types of documents} -\label{.cross.ref.other} - - The documentation system also contains ASCII documents and PostScript documents imported from elswehere. Such documents may be referred to through the following commands: - -\bi -\item \verb/,,ascref{<text>}{<file name>}/ -\item \verb/,,psref{<text>}{<file name>}/ -\ei - - \verb/<file name>/ is the name (without extension!) of a .txt file in directory \verb:\$n\_doc/txt: or of a .ps file in directory \verb:\$n\_hlp:; the name may contain {\em neither dots nor uppercase characters}, but underscores are allowed (and need not to be quotes with a backslash). - -\bi -\item \verb/,,srcref{<text>}{<directory><file name><extension>}/ -\ei - - This command is used to refer to program code or WNTINC table definitions (.dsc files). \verb/directory/ must be specified relative to -\verb/n_src/ and the file extension must be included. - - -\subsection{ Equations and equation references} -\label{.eqref} - - The commands \verb/,,Eqref{.<label>}/ and \verb/,,eqref{.<label>}/ are entirely analogous to the @0@\textref@1@{figure references}@4@{@3@.figref} -\verb/,,Figref/ and \verb/,,figref/. - - -\section{ Figures and figure references} -\label{.fig} - - Figures with their captions reside in the directory -\verb:\$n\_doc/fig:. A figure consists of two components: -\bi - -\item a \verb:<name>.cap: {\em caption file} containing a caption and a the directive to include the figure. - -\item the diagram proper in the form of either an \verb/xfig/ drawing -\verb:<name>.fig:, or a binary (e.g. \verb/<name>.ps/ or \verb/<name>.gif/) file. -\ei - - A figure with its caption is included in a document source file through the command - -\verb: ,,input{../fig/<name>.cap: \ - -In the printed document, figure and caption are included in the standard way. In the hypertext display the word \verb/FIGURE/ is included, followed by the caption text, with a hypertext link from FIGURE to a postscript file. \ndoc generates that file automatically from the .fig file. - - -\subsection{ Caption files} -\label{.caption} - - The purpose of the caption file (as opposed to spelling out the caption text in the document source) is to enable the figure with its caption to exist as an independent unit that can be included in more than one document and also exist outside the context of any document. - - The caption file must not only provide the caption, but also the title under which the figure may be listed in the Handbook Overview. It is therefore important to adhere strictly to the following format: - - -\begin{verbatim} - ,,begin{figure}[htbp] - ,,fig{<name>} - ,,caption[]{<optional LaTeX commands, e.g. \it> - <title> - <optional LaTeX commands, e.g. \> <optional remainder of caption> - } - ,,label{.<label>} - ,,end{figure} -\end{verbatim} - -\noi Examples can be found in the -\verb:/\$n\_doc/fig: directory. - - You are free to choose the label; the recommended choice, however, is -the file name with underscores replaced by dots. (Remember that underscores are -illegal in labels and that labels must start with a dot.) - - Comment lines (but no {\em empty} lines!) may be arbitrarily added, -except that the \verb/<title>/ line must {\em immediately follow} the -\verb/,,caption/ command. - - -\subsection{ Xfig figures} -\label{.xfig} - - \verb/.fig/ files may be created without any restrictions with the -public-domain program \verb/xfig/. It is not necessary to produce a postscript -file with this program. \ndoc/ will take the \verb/.fig/ file and convert it -automatically. - - Often, figures drawn on a convenient scale on a workstation screen will -not fit on a standard A4 page. \ndoc/ may be instructed to automatically reduce -its scale by including in the figure a text line - -\verb/ <file name>.fig <nn>/ % -It is best to put this text in an inconspicuous corner and a small font (e.g. -10pt as opposed to a standard 20pt). - - -\subsection{ Postscript figures} -\label{.ps} - - It is also possible to include Postscript figures produced in other -ways than through xfig: Use the command \verb/,,ps{<filename>}/ instead of -\verb/,,fig/ and place the postscript file \verb/<filename>.ps/ in the -directory \verb:/\$n\_doc/bin: with a soft link to it in \verb/\$n\_hlp/. If it -can not be easily recovered, it is advisable to protect it against accidental -deletion! - - -\subsection{ Figure references} -\label{.figref} - - For references to figures, use - -\verb/ ,,figref{.<label>}/ and \verb/ ,,Figref{.<label>}/ - -\noi These commands translate to hypertext links \verb/figure/ or \verb/Figure/ -in the hypertext document, and to a standard reference \verb/figure <n>/ or -\verb/Figure <n>/ in the printed document. - - -\section{ Session transcripts} - - Verbatim transcripts of pieces of terminal dialogue controlling program -execution are an important ingredient to documentation. Such transcripts are -easily produced through the command - - \verb/ndoc S[cript] <file name>/ - -This starts a cshell script session in which you execute the program of which -you want a transcript. After exit from the script session, the collected script -is automatically formatted into a LaTeX file \verb/<file name>.trs/; what -remains for you to do is to cut out the irrelevant parts and perhaps add some -comments. A sample section of such a file is shown below - -\spbegin -\svbegin \begin{verbatim} % -,,spbegin % -,,skeyword{USE\_SCN\_NODE} ,,sprompt{(input node name)} ,,sdefault{= *:} -,,suser{?} % -,,svbegin ,,begin{verbatim} - Specify the node name from which the corrections should be calculated. - * indicates the same as the output node name. -\end{verbatim}\svend -\verb/,,end{verbatim},,svend/ -\svbegin\begin{verbatim} ,,spend -% -% -,,spbegin % -,,skeyword{USE\_SCN\_NODE} ,,sprompt{(input node name)} ,,sdefault{= *:} -,,suser{*} ,,sinline{Use the same SCN file} ,,spend -% -% -,,spbegin % -,,skeyword{USE\_SCN\_SETS} ,,sprompt{(Set(s) of input uv-data Sectors: -g.o.f.c.s)} ,,sdefault{= "":} ,,suser{2.0.0.0.0} ,,sinline{Sets in job 2} -,,spend % -% -,,spbegin % -,,skeyword{HA\_RANGE} ,,sprompt{(DEG) (HA range)} ,,sdefault{= *:} -,,suser{,,scr} ,,sinline{Use all scans in these sets} % -,,svbegin ,,begin{verbatim} - 0123456789ABCD - 0 -+++++++++++++ - 1 -++++++++++++ - 2 -+++++++++++ - 3 -++++++++++ - 4 -+++++++++ - 5 -++++++++ - 6 -+++++++ - 7 -++++++ - 8 -+++++ - 9 -++++ - A -+++ - B -++ - C -+ - D - -\end{verbatim}\svend -\verb/,,end{verbatim}\svend/ -\svbegin\begin{verbatim} -,,spend% -\end{verbatim}\svend -\spend - - The file consists of sections delimited by \verb/,,spbegin/ and -\verb/,,spend/, each consisting of a prompt with its reply and the ensuing -output from the computer. LaTeX will treat these sections as blocks in which a -page break can not occur. The following LaTeX commands are used: - -\bi - -\item \verb/,,skeyword/, \verb/,,sprompt/ and \verb/,,sdefault/ are the -components of a program prompt; - -\item \verb/,,suser/ is the user's reply (in which \verb/,,scr/ represents a -null reply (carriage return only) and \verb/,,seof/ an end-of-file -(control-D)).; - -\item \verb/,,sinline/ is an inline comment typed in during the session (an -exclamation mark plus text following the answer to a prompt); - -\item \verb/,,svbegin/ and \verb/,,svend/ delimit the verbatim section in -which computer output is rendered. - -\ei - - It is necessary to check these scripts with some care. The system does -occasionally get confused by the way the parameter interface splits long input -and output lines. The errors are usually easily corrected. - -\bi - -\item To replace parts of lengthy computer output, e.g. by ellipses; note -that, since this occurs inside \verb/verbatim/ sections, LaTeX commands such as -\verb/,,vdots/ can not be used. A line consisting of just three dots gives a -satisfactory effect. - -\item To add \verb/,,sinline/ comments. These must be placed either -immediately following \verb/,,suser/ commands or between an -\verb/,,end{verbatim}/ and the adjacent \verb/,,svend/. - -\item To reduce the size of verbatim sections that are more than 80 -characters wide (e.g. sections from a log file). - -\ei - - -\section {Documentation directories} - -% -% - -\begin{figure}[hbtp] - -\fig{doc_sources_and_hyper} -\caption[.]{ \it -\label{.doc.sources.and.hyper} On-line Help files in the \NEWSTAR -documentation system and their origins. -\\ Files shown in boldface are the documentation and program sources, those -shown in regular print are the derived Help files. -\\ The full-drawn arrows indicate hypertext links for diagrams. The links to -the other files types are not shown. The dotted arrow indicate links to in-line -picture files that contain @0@\Textref@1@{formulas and tables}@4@{@3@.formulas}. -\\ The dashed arrows indicate the relations between the files: Straight arrows -represent a direct derivation, merging arrows a source-file inclusion. The -capital letters on the arrows show in which procedure the derivation is -implemented: -\\ C= ndoc Cook; F= ndoc Fig; T= ndoc Test; P= ndoc Print. } -\end{figure} - -% -% - -\begin{figure}[hbtp] - -\fig{doc_sources_and_print} -\caption[.]{ \it -\label{.doc.sources.and.print} Printable documents in the \NEWSTAR -documentation system and their origins. -\\ Files shown in boldface are the documentation and program sources, those -shown in regular print are the derived printable files in the Help system. -\\ The dashed arrows indicate the relations between the files: Straight arrows -represent a direct derivation, merging arrows a source-file inclusion. The -capital letters on the arrows show in which procedure the derivation is -implemented: F= ndoc Fig; T= ndoc Test; P= ndoc Print. } -\end{figure} - - - The documentation system encompasses three classes of files. The -document source files reside in subdirectories of \verb/$n_doc/; the code -source files which may also be referenced reside in subdirectories of -\verb/$n_src/. All hypertext files reside in a tree of subdirectories rooted in -\verb/\$n\_hlp/. The interrelations of all these files are shown in -\figref{.doc.sources.and.hyper}. - - The following types of source texts are used: -\bi -\item Narrative LaTeX source texts: \verb:$n_doc/latex/<name>.tex: - -\item Caption LaTeX source texts: \verb:$n_doc/fig/<name>.cap: - -\item Standardised LaTeX files describing the private and public program -parameter interfaces: \verb:$n_doc/intfc/<name>.tex:. These files incorporate -\verb/.tef/ files derived from the program-parameter definition files -(\verb/<name>.psc/). - -\item ASCII texts: \verb:$n_doc/txt/<name>.txt: - -\item Postscript files for which no source exists: \verb:$n_doc/ps/<name>.ps: - -\item Code sources: \verb:$n_src/<directory>/<name>.<extension>: -\ei - - In processing, temporary files are created in the current directory; -their names either contain the string \verb/\_tmp./ or end in \verb/.tmp/. -\ndoc normally deletes them when exiting. - - \verb/latex2html/, invoked by \verb/ndoc Cook/, translates each file -\verb/<name>.tex/ into a file -\verb:\$n\_hlp/<name>/<name>.html:. A large number of -\verb/.html/ files are therefore in subdirectories of -\verb/\$n\_hlp/. - - \verb/ndoc Print/ creates .ps PostScript text files in \verb/\$n\_hlp/. - \verb/ndoc Fig/ creates .fps PostScript diagram files in -\verb/\$n\_hlp/. - - - - -\section {Processing commands} - -\subsection{ Programmer's commands: Processing individual files } - - The commands are of the form - - \verb/ndoc <operation> [-<option>] <file>/ - - \verb/<file>/ is the full file name including the extension, and it -must be in the current directory. Wildcards may be used. - - The \verb/<operation>/ and \verb/-<option>/ arguments may be -abbreviated and are case-insensitive. The following operations and options are -available: - -\bi -\item \verb/P[rint]/ creates [a] PostScript file[s] from [a] .tex source -file[s], with the following options: - \bi - \item[] \verb/-S[yntax]/ do nothing else; - \item[] \verb/-V[iew]/ display the output using ghostview; - \item[] \verb/-P[rint]/ print the PostScript output. - \ei - -\verb/Print/ uses the LaTeX program. It attempts to suppress the verbose output -of this program by filtering out everything except essential error messages. If -you encounter a problem that you can not solve, submit your source file to the -\NEWSTAR group for diagnosis. - -\item \verb/C[ook]/ creates a Hypertext file from [a] .tex document[s]. This -operation makes use of \ltoh. This program may crash over LaTeX syntax errors -without properly analysing them. {\em It is therefore recommended to first do a -\verb/Print -Syntax/ check.} - -\item \verb/K[ey]/ creates Hypertext files from [a] .pin, .psc or .pef -file[s] - -\item \verb/L[ink]/ creates the softlinks from the \verb/n_hlp/ directory to -the \verb:$n_doc/txt: and \verb:$n_src: directories. -\ei - - \ndoc checks the dates of its input and output files. If the output is -newer than the date, \ndoc emits a message and proceeds with the next input -file. This check is incomplete in that it does not check the status of -\verb/,,input/ files such as figure captions. - - There are two ways of bypassing this check: -\bi -\item Setting the environment variable \verb/n_force/. -\item \verb/touch/ing the inpout file to set its modification time to the -present time. -\ei - - When working in a shadow system, \ndoc makes no difference between hard -copies and soft links to the master system: Both are unconditionally compiled. - - -\subsection{ \NEWSTAR manager's commands: Maintaining the documentation system -} - - To recompile the entire documentation collection from its sources, one -uses the command - -\verb/ ndoc All/ - -\noindent \ndoc will ask which parts of the system to recompile, the default -being 'yes' for all subsystems. In this mode of operation \ndoc bypasses the -check for an up-to-date output file. - - One of the actions available in \verb/ndoc All/ is a systematic check -of the correspondence between source and output files. This is a very useful -action because it clears up leftovers of obsolete documents and pinpoints areas -of trouble. - - - - -\section{ Debugging .tex files} - - \ndoc goes a long way in filtering from the verbiage that LaTeX spews -out the essential diagnostics. It shows the essential section of LaTeX output -where the error is reported (including a line number) plus five lines of text -in the middle of which the error was found. Very often this information -suffices to pinpoint the error. If it does not, you may have to take a better -look either at your source or at the \verb/<file name>_tmp.tex/ file that is -the file LaTeX was actually processing. Note that the line number reported -refers to this latter file! - - Specific errors that have been encountered and are not covered by this -diagnosis mechanism are described below. - - -\subsection{ Temporarily disabling parts of .tex files} - - \ndoc provides a simple facility for "commenting out" large parts of -\tex input files: \verb/.c+/ and \verb/.c-/ can be inserted (on lines -containing nothing else) to delimit a piece of text that must be ignored. This -has proved very useful to quickly pinpoint the location where an error occurs. - - -\subsection{ Specific errors} - -\subsection{ LaTeX bugs} - - Both \verb/ndoc Print/ and \verb/ndoc Cook/ make use of LaTeX and may -therefore be affected by LaTeX bugs. For cases not covered here, refer to "The -LaTex Book", which is probably the best informed source about that program. - -\bi -\item Symptom: - {\em The word \verb/dump/ appears in the place of a Figure or Table.} - - This is an obscure problem. One situation in which it has been observed -is when a \verb/,,figure/ environment is put at the very start of a document, -i.e. without any preceding text. (This condition will not occur for regular -documents but may occur in test situations.) It has also been seen in a case -where a \verb/tabular/ environment was nested inside a \verb/table/, in which -case the solution was to remove the \verb/table/ environment. - -\item Symptom: - {\em LaTeX complains about a 'runaway argument' in a \verb/,,caption/ -environment.} - - This may happen when the optional argument in square brackets is -omitted. As of 940914, this argument is automatically provided for by -\verb/doc_preprocess.csh/. - -\item Symptom: - {\em ndoc Print runs without reporting any error, but produces a -PostScript file in which figure references appear without numbers filled in.} - - This happens when the \verb/,,label/ directive in a \verb/figure/ -declaration is placed before the \verb/,,caption/ command.! - -\item Symptom: - {\em LaTeX reports: TeX capacity exceeded, sorry [parameter stack -size=60].} - - This has been seen to happen when a \verb/,,section/ title argument is -too complicated, e.g. because it contains italicised text. - -\item Symptom: - {\em LaTeX finds a \$ or \_ in a \verb/,,textref/ file argument that is -not escaped by a preceding backslash.} - - This may happen when the expansion of a command defined through -\verb/,,newcommand/ contains a @0@\textref@1@{referencing command}@4@{@3@.cross.ref}. Fix -the problem by including escape charaters in the \verb/,,newcommand/ -definition. - -\item Symptom: - {\em LaTeX complains about "Paragraph ended before \verb/,,sbox/ was -complete" in a figure caption.} - - The \verb/,,caption/ environment appears to be sensitive to formatting. -In particular new paragraphs (i.e. blank lines) and \verb/,,indent/ commands -have been noted to produce this nasty error. In some cases it was found -necessary to put the \verb/,,label/ before the \verb/,,caption/. -\ei - - -\subsection{ Processing errors in ndoc} - - When LaTeX reports an error to \ndoc, \ndoc displays a five-line text -section in the middle of which the error occurred. This is not from the -original input text, but from the preprocessed text as it was eventually -presented tp LaTeX. Most errors are easily recognised and traced back to the -input \tex file. - -\bi -\item Symptom: - An error occurs which is associated with lines from the .tex input that -were concatenated by ndoc. - - This may very well be an error in the algorithm used by ndoc to merge -paragraphs into single long lines. It is not necessarily clear why LaTeX does -not accept the long line. An any rate, the recommended action is to check with -the \NEWSTAR manager. - -\item Symptom: - ndoc cook stops with message -\verb/ nawk: record `[...]' has too many fields/ - - In preprocessing documents, ndoc formats paragraphs into single lines -to make it easier to identify LaTeX command sequences. Find the offending -paragraph in you documents and insert \verb/<newline><blank>/ at some -appropriate place. The leading paragraph will inhibit the merger of the two -parts of the paragraph, yet LaTeX will format the two parts into one paragraph. - -\ei - - -\subsection{Processing errors in \protect\verb/ndoc Cook/} - - The program \ltoh on which \verb/ndoc Cook/ is based is rather lax on -checking LaTeX syntax but may stumble over the consequences of an error missed. -{\it It is therefore strongly recommended to first check the syntactical -correctness of the .tex file through \verb/ndoc P/}. - -\bi -\item Symptom: - \verb/.DVI file can't be opened/ - - \ltoh runs LaTeX on a selection from the .tex file consisting of -formulas, tabular material and diagrams. This run failed to produce a -\verb/.dvi/ file, but \ltoh gobbled up all the error information. This error -may be due to improper configuration of your system, {\em e.g.} a misplaced -\verb/.sty/ file. It is virtually impossible to diagnose except by using a -@0@\textref@1@{modified version of \ltoh}@4@{@3@.latex2html}. - -\item Symptom -\begin{verbatim} The nplot_descr.aux file was not found, so sections will not -be numbered and cross-references will be shown as icons. -\end{verbatim} - - Your .tex file contains a \verb/,,ref/ directive. Convert al -\verb/,,ref/s to \verb/,,textref/s. - -\item Symptom: - Commands that are normally accepted are reported as unknown. - - This is likely to be the result of a syntax error. (For example, a -missing \verb/,,end{itemize}/ will cause \verb/,,item/ to be reported as -unknown.) Check your input file by running \verb/ndoc Print/ on it. - -\item Symptom: - \verb/xmosaic/ can not find a file pointed at by a hypertext link. - - Note the file name appearing at the bottom of the \verb/xmosaic/ window -when you point at the reference. This reference should be in either of the -forms: - - \verb:<file name>/<file name>.html -\indent \verb:../<file name>/<file name>.html - -If it starts in a \verb:/:, you have to replace your \ltoh by the -@0@\textref@1@{modified version}@4@{@3@.latex2html}. - -\item Symptom: - \verb/latex2html/ warns that the \verb/.aux/ file was not found but -otherwise \verb/ndoc Cook/ seems to complete normally. - - The precise nature of this error is not understood, but it seems to -indicate that something is wrong in a cross-reference. (e.g. a LaTeX -\verb/,,ref/ command). It has been seen to occur when a \verb/,,ref/ with a -label name containing dots is used (cf. the section on @0@\textref@1@{cross references}@4@{@3@.cross.ref}). -\ei - - -\appendix - -\section{\protect\ltoh} -\label{.latex2html} - - \ltoh is a public-domain perl script created by Nikos Drakos at Leeds -University, England (Email: nikos@cbl.leeds.ac.uk) and available through -anonymous ftp. It has been found to be a reliable and highly capable program. -Apart from configuring it to the local environment, two changes were found -necessary: - -\bi -\item All lines containing the string \verb:s/\W//g: must be commented out by -prefixing them with a \verb/#/. This makes \ltoh capable of handling relative -file references and removes an inconsistency it the processing of labels and -references. - -\item After the line - -\indent \verb/system("$LATEX $$_images.tex");/ - -insert the lines - -\begin{verbatim} - if (!-e "20756_images.dvi") - {system("cat 20756_images.log"); die "Failure to process formulas"; } -\end{verbatim} -\ei - -\subsection{ Formulas and the like in \protect\ltoh} -\label{.formulas} - - LaTeX allows many constructs, such as formulas, tables etc., for which -there is no HTML counterpart (yet). \ltoh converts each single occurrence of -these into a little picture file that is linked in-line into the \verb/.html/ -document. The pictures are stored in \verb/.xbm/ files in the same directory as -the \verb/.html/ file. - - Since building these pictures is a very time-consuming process, \ltoh -seeks to reuse them as much as possible whenever it recompiles a \verb/.tex/ -file. To this end, it maintains an administration in the file \verb/images.pl/ -in the \verb/.html/ file's directory. Therefore, to insure the integrity of the -.html document, both the \verb/.xbm/ files and \verb/images.pl/ must be left in -place. As of May 1996, \verb/doc_cook.csh/ contains a section of code that -finds all in-line picture references in the renewed \verb/.html/ file, reports -any referred-to files that are missing and deletes unreferenced \verb/.xbm/ -files. - - In cases a \verb/.xbm/ file is reported missing, the way to get it -rebuilt is to delete \verb/images.pl/ in order to force \ltoh to rebuild all -the picture files from scratch. - - - - diff --git a/src/doc/latex/doc_guide_tmp.all b/src/doc/latex/doc_guide_tmp.all deleted file mode 100644 index ac1746544b6b0aecd2ec4a207e3412ade9710f71..0000000000000000000000000000000000000000 --- a/src/doc/latex/doc_guide_tmp.all +++ /dev/null @@ -1,1114 +0,0 @@ -%% \documentstyle[subeqn]{article} - \documentstyle{article} - \newcommand{\iinput}[1]{ \input{#1} } -% \input /newstar/master/src/doc/latex/hb_print_preamble.sty -% -% @(#) hb_print_preamble.tex v2.0 13/07/93 CMV -% -% History: -% JPH 9405.. Revision -% JPH 940707 Transferred to master system as part of new doc system -% JPH 940712 Improve \sinline to optimise paper utilisation -% JPH 940915 Add obsolescent script commands -% JPH 950823 Add interdocument referencing commands, using l2h method -% JPH 951016 arguments on \whichref -% JPH 951114 Change \seof definition to avoid LaTeX quirk -% JPH 951124 \maketitle -% -% -% This preamble is used to tailor the standard document-style book -% to our specific needs. It should be included in every tex-file -% that could produce a separate printed version. -% -% NOTE: The \fig command is not defined here but in docPrint.csh, because it depends on the environment variable $n_hlp -% -% Define document layout -% - \setlength{\parskip}{\medskipamount} - \setlength{\parindent}{10mm} - \setlength{\itemsep}{-0.5\parsep} - \setlength{\textheight}{250mm} - \setlength{\topmargin}{-35mm} - \setlength{\textwidth}{160mm} - \setlength{\oddsidemargin}{0mm} - \setlength{\evensidemargin}{0mm} - \setlength{\unitlength}{1mm} -% - \pagestyle{plain} % only a page number at the foot -% \pagestyle{headings} % alternative: section name at the top - \newcommand{\chapter}[1]{ {\noindent \Large\bf #1} } - \renewcommand{\maketitle}{} -% -% Referencing -% - \newcommand{\ascref}[2]{\htmladdnormallink{{#1}}{#2}} - \newcommand{\Ascref}[2]{\htmladdnormallink{{#1}}{#2}} - \newcommand{\textref}[2]{\htmladdnormallink{{#1}}{#2}} - \newcommand{\Textref}[2]{\htmladdnormallink{{#1}}{#2}} - \newcommand{\Psref}[2]{\htmladdnormallink{{#1}}{#2}} - \newcommand{\srcref}[2]{\htmladdnormallink{{#1}}{#2}} - \newcommand{\Srcref}[2]{\htmladdnormallink{{#1}}{#2}} -% - \newcommand{\Figref}[1]{ Figure \ref{#1} } - \newcommand{\figref}[1]{ figure \ref{#1} } - \newcommand{\Eqref}[1]{ Equation \ref{#1} } - \newcommand{\eqref}[1]{ equation \ref{#1} } - \newcommand{\whichref}[2]{#1} -% -% Scripting commands -% -%% components of a Newstar prompt. Note that the absence of whitespace in the definitions is deliberate. -% - \newcommand{\skeyword}[1]{ - \par \noindent $\bigotimes\ ${\bf #1}} - \newcommand{\sprompt}[1]{{\footnotesize #1}} - \newcommand{\sdefault}[1]{{\small #1}} - \newcommand{\suser}[1]{\fbox{\sf #1}} -% -%% symbols for non-printing replies -% - \newcommand{\scr}{$^{}$} - \newcommand{\seof}{\fbox{\sf ~$<$EOF$>$}} -% -%% shell prompt -% - \newcommand{\scmd}[1]{ - ~\\\hspace{2mm} $>~${\sf #1} - \nopagebreak - } -% -%% -% - \newcommand{\sline}[1]{ - ~\\\hspace*{1pc}{\tt #1} } - \newcommand{\slong}[1]{ - ~\\\hspace*{-10mm}{\tt #1} } -% -%% comments are right-justified. We use an incantation adapted from The TeXbook, Exercise 14.30, to put the short ones in-line and the long ones in a separate line or paragraph. -% - \newcommand{\sinline}[1]{ - {\unskip\nobreak\hfil\penalty50\hskip.2em\hbox{}\nobreak\hfil - \normalsize \it #1 - \parfillskip=0pt \finalhyphendemerits=0 \par}} -% -%% the separate non-inline comment style should no longer be used -% -% -%% verbatim environment for machine output -% - \newcommand{\svbegin}{ - \vspace*{-\bigskipamount} \small } - \newcommand{\svend} { - \vspace*{-\medskipamount}\vspace*{-\smallskipamount} } -% -%% samepage "environment" to keep prompt and response together -% - \newcommand{\spbegin}{ - \begingroup \par \protect\samepage} - \newcommand{\spend}{ - \endgroup \medbreak \par \vspace*{-.5\parskip} } -% -%% obsolescent -% -\newcommand{\sskip}{} -\newcommand{\scomment}[1]{\it #1} -\newcommand{\setc}{~\\\hspace*{7mm}$\vdots$ } - -% \input /newstar/master/src/doc/latex/hb_symbols.sty -% -% @(#) cbSymbols.tex v1.1 13/07/93 JEN -% -% Symbol definitions for the redundancy cookbook -% This file is included in all NEWSTAR Cookbook sections to ensure a -% uniform naming convention. -% -% This file is also translated into a NEWSTAR "glossary" called -% FORMSYMBOLS.TEX by means of the program SYMBOLSLATEX.FOR. -% -% This file should be included right after cb_preamble.tex -% - -%\gloshead{General:} - -\def\cbdir{\$n_src/doc/cook} % cookbook directory -\def\NEWSTAR{{\sf NEWSTAR~}} % name of software package -\def\Nseries{\NEWSTAR} % name of package (was N-series) - -%\gloshead{Visibility components:} - -\def\cVis{{\cal V}} % (complex) visibility -\def\pvis{{\Phi}} % visibility phase -\def\avis{{|{\cVis}|}} % visibility amplitude -\def\lavis{{\varrho}} % visibility ln(ampl) - -\def\cGain{{G}} % (complex) Gain (multiplicative) -\def\cNoise{{N}} % (complex) random noise (additive) -\def\cCadd{{C}} % (complex) offset (additive) - -%\gloshead{The four types of dipole errors and related quantities:} - -\def\perr{{p}} % dipole phase error -\def\gerr{{g}} % dipole gain error -\def\lerr{{q}} % dipole ln(gain) error -\def\dang{{\phi}} % dipole position angle -\def\derr{{\Delta}} % dipole position angle error -\def\eerr{{\Theta}} % dipole ellipticity - -%\gloshead{Miscellaneous:} - -\def\Apol{{\epsilon}} % Polarisation A-factor -\def\Bpol{{\eta}} % Polarisation B-factor - -\def\wgt{{\cal W}} % Weight factor -\def\pwgt{{\wgt^p}} % Weight for phase equation -\def\lwgt{{\wgt^g}} % Weight for ln(gain) equation - -\def\pzd{{\psi}} % XY phase zero difference (PZD) - -\def\farang{{\chi}} % Faraday rotation angle - -%*********************************** end of CBSYMBOLS.TEX *************** - -% \input /newstar/master/latex2html/html.sty -% LaTeX2HTML Version 0.5.3: html.sty -% -% This file contains definitions of LaTeX commands which are -% processed in a special way by the translator. -% For example, there are commands for embedding external hypertext links, -% for cross-references between documents or for including -% raw HTML. -% This file includes the comments.sty file v2.0 by Victor Eijkhout -% In most cases these commands do nothing when processed by LaTeX. - -%%% LINKS TO EXTERNAL DOCUMENTS -% -% This can be used to provide links to arbitrary documents. -% The first argument should be the text that is going to be -% highlighted and the second argument a URL. -% The hyperlink will appear as a hyperlink in the HTML -% document and as a footnote in the dvi or ps files. -% -\newcommand{\htmladdnormallink}[2]{ #1\footnote{#2}} - -% This is an alternative definition of the command above which -% will ignore the URL in the dvi or ps files. -%\newcommand{\htmladdnormallink}[2]{ #1 } - -% This command takes as argument a URL pointing to an image. -% The image will be embedded in the HTML document but will -% be ignored in the dvi and ps files. -% -\newcommand{\htmladdimg}[1]{ } - -%%% CROSS-REFERENCES BETWEEN (LOCAL OR REMOTE) DOCUMENTS -% -% This can be used to refer to symbolic labels in other Latex -% documents that have already been processed by the translator. -% The arguments should be: -% #1 : the URL to the directory containing the external document -% #2 : the path to the labels.pl file of the external document. -% If the external document lives on a remote machine then labels.pl -% must be copied on the local machine. -% -%e.g. \externallabels{http://cbl.leeds.ac.uk/nikos/WWW/doc/tex2html/latex2html} -% {/usr/cblelca/nikos/tmp/labels.pl} -% The arguments are ignored in the dvi and ps files. -% -\newcommand{\externallabels}[2]{ } - -% This complements the \externallabels command above. The argument -% should be a label defined in another latex document and will be -% ignored in the dvi and ps files. -% -\newcommand{\externalref}[1]{ } - - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -% Comment.sty version 2.0, 19 June 1992 -% selectively in/exclude pieces of text: the user can define new -% comment versions, and each is controlled separately. -% This style can be used with plain TeX or LaTeX, and probably -% most other packages too. -% -% Examples of use in LaTeX and TeX follow \endinput -% -% Author -% Victor Eijkhout -% Department of Computer Science -% University Tennessee at Knoxville -% 104 Ayres Hall -% Knoxville, TN 37996 -% USA -% -% eijkhout@cs.utk.edu -% -% Usage: all text included in between -% \comment ... \endcomment -% or \begin{comment} ... \end{comment} -% is discarded. The closing command should appear on a line -% of its own. No starting spaces, nothing after it. -% This environment should work with arbitrary amounts -% of comment. -% -% Other 'comment' environments are defined by -% and are selected/deselected with -% \includecomment{versiona} -% \excludecoment{versionb} -% -% These environments are used as -% \versiona ... \endversiona -% or \begin{versiona} ... \end{versiona} -% with the closing command again on a line of its own. -% -% Basic approach: -% to comment something out, scoop up every line in verbatim mode -% as macro argument, then throw it away. -% For inclusions, both the opening and closing comands -% are defined as noop - -\def\makeinnocent#1{\catcode`#1=12 } -\def\csarg#1#2{\expandafter#1\csname#2\endcsname} - -\def\ThrowAwayComment#1{\begingroup - \def\CurrentComment{#1}% - \let\do\makeinnocent \dospecials - \makeinnocent\^^L% and whatever other special cases - \endlinechar`\^^M \catcode`\^^M=12 \xComment} -{\catcode`\^^M=12 \endlinechar=-1 % - \gdef\xComment#1^^M{\def\test{#1} - \csarg\ifx{PlainEnd\CurrentComment Test}\test - \let\next\endgroup - \else \csarg\ifx{LaLaEnd\CurrentComment Test}\test - \edef\next{\endgroup\noexpand\end{\CurrentComment}} - \else \let\next\xComment - \fi \fi \next} -} - -\def\includecomment - #1{\expandafter\def\csname#1\endcsname{}% - \expandafter\def\csname end#1\endcsname{}} -\def\excludecomment - #1{\expandafter\def\csname#1\endcsname{\ThrowAwayComment{#1}}% - {\escapechar=-1\relax - \csarg\xdef{PlainEnd#1Test}{\string\\end#1}% - \csarg\xdef{LaLaEnd#1Test}{\string\\end\string\{#1\string\}}% - }} - -\excludecomment{comment} -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - -%%% RAW HTML -% -% Enclose raw HTML between a \begin{rawhtml} and \end{rawhtml}. -% The html environment ignores its body -% -\excludecomment{rawhtml} - -%%% HTML ONLY -% -% Enclose LaTeX constructs which will only appear in the -% HTML output and will be ignored by LaTeX with -% \begin{htmlonly} and \end{htmlonly} -% -\excludecomment{htmlonly} - -%%% LaTeX ONLY -% Enclose LaTeX constructs which will only appear in the -% DVI output and will be ignored by latex2html with -%\begin{latexonly} and \end{latexonly} -% -\newenvironment{latexonly}{}{} - -%%% Hyperref -% Suggested by Eric M. Carol <eric@ca.utoronto.utcc.enfm> -% Similar to \ref but accepts conditional text. -% The first argument is HTML text which will become ``hyperized'' -% (underlined). -% The second and third arguments are text which will appear only in the paper -% version (DVI file), enclosing the fourth argument which is a reference to a label. -% -%e.g. \hyperref{using the tracer}{using the tracer (see Section}{)}{trace} -% where there is a corresponding \label{trace} -% -\newcommand{\hyperref}[4]{#2\ref{#4}#3} - - \iinput{epsf.sty} - \newcommand{\fig}[1]{ - \centering - \leavevmode - \epsfbox{/newstar/master/hlp/fig/#1.ps} - } - \begin{document} - {\it Printout of NEWSTAR document chapter - \today } - \\ \\ -% \input doc_guide_tmp.text - -% -% -% -% -% -",," -% -% -substitutes -% -% -% -% -% -% -% -% -% -% -% -% -% -% -% -% -% -% -% -% -'' -% -% -% -% -% -% -% -% -\newcommand{\bi}{ \begin{itemize} } -\newcommand{\ei}{ \end{itemize} } -\newcommand{\noi}{ \noindent} -\newcommand{\ndoc}{ \verb/ndoc/} -\newcommand{\ltoh}{ \verb/latex2html/ } -\newcommand{\tex}{ \verb/.tex/ } - - -\chapter{Guide for writing and maintaining \NEWSTAR documents} - -\tableofcontents - -\section{ Summary of \NEWSTAR LaTeX commands } - - For quick reference use the following list of special LaTeX commands available in the \NEWSTAR documentation system: -\\ \\ -ascref (sec. \ref{.cross.ref.other}) \\ -Ascref (sec. \ref{.cross.ref}) \\ -caption (sec. \ref{.caption}) \\ -chapter (sec. \ref{.layout}) \\ -eqref (sec. \ref{.eqref}) \\ -Eqref (sec. \ref{.eqref}) \\ -fig (sec. \ref{.caption}) \\ -figref (sec. \ref{.figref}) \\ -Figref (sec. \ref{.figref}) \\ -label (sec. \ref{.cross.ref.latex}) \\ -ps (sec. \ref{.ps}) \\ -psref (sec. \ref{.cross.ref.other}) \\ -Psref (sec. \ref{.cross.ref}) \\ -ref (sec. \ref{.cross.ref.latex}): {\em Not to be used} \\ -tableofcontents (sec. \ref{.layout}) \\ -textref (sec. \ref{.cross.ref.latex}) \\ -Textref (sec. \ref{.cross.ref}) \\ -whichref (sec. \ref{.cross.ref}) \\ - - -\section{ The \NEWSTAR documentation system} - - The \NEWSTAR documentation system provides documentation in two forms: An on-line hypertext system based on the public-domain program "xmosaic" and standard LATeX documents. Both forms are derived from a single set of LaTeX source files; for the hypertext form, the public-domain translator \ltoh is used. - - Broadly speaking, authors are free to use the standard LaTeX constructs. In particular, \ltoh handles tabular material, mathematical formulas and the inclusion of diagrams very well. Writers should be aware, however, that every bit of math-mode text is translated into a little bitmap that must be loaded separately for display. This considerably slows down both the processing by \verb/ndoc Cook/ and the display by xmosaic. - - Simple macros defined through -\verb/,,newcommand/ can be used freely, but complicated nesting of macros should be avoided. - - To satisfy the specific needs of the \NEWSTAR system and circumvent some deficiencies of \ltoh, the guidelines given below should be followed. - - -\subsection{ LaTeX and ASCII documents} - - The official format for \NEWSTAR document sources is LaTeX. It is, however, considered more important that documentation exist at all than that it have a finished form. {\em Users are strongly invited to submit any bits of text that they consider to be of potential use to others.} Such contributions will quickly be integrated with the system and the \NEWSTAR group will assume responsibility for their further maintenance, including their eventual conversion to or integration with the LaTeX document collection. - - -\section{ Guidelines for writing LaTeX documents} - -\subsection{ General layout} -\label{.layout} - -\bi -\item Preamble - - The document compiler \ndoc automatically inserts a preamble including the \verb/,,begin{document}/ and also appends the \verb/,,end{document}/. The source of a document may add private preamble elements such as -\verb/,,newcommand/ definitions. Apart from that, the first document line is the -\verb/,,chapter/ line: - -\item \verb/,,chapter{<text>}/ - - The chapter is the basic documentation unit. \ndoc formats the argument -\verb/<text>/ as a hypertext or printed document title. - - -\item \verb/,,tableofcontents/ - - This creates a standard table of the chapter's contents in the printed document and an equivalent unnumbered table with links to the (sub)(sub)sections in the hypertext display. - - -\item \verb/,,[sub]sub]]section{<text>}/ - - These commands produce standard section headings, numbered in the printed document, unnumbered in the hypertext display. -\ei - - -\section{ Cross-references} -\label{.cross.ref} - - In writing documents, the placeholder \verb/,,whichref{text}{}/ can be used for references whose target is not yet known. - - For most referencing commands, a companion with the leading character capitalised is available; these work the same way except that the text argument is printed in boldface. This feature is intended for use in the documentation home-page document, \verb/hb_contents.tex/. - - -\subsection{ Cross-references to text in LaTeX documents } -\label{.cross.ref.latex} - - Cross-references must work in both the printed and hypertext versions of a document. For this reason, {\it the standard LaTeX \verb/,,ref/ command is unsuitable} and the rules given below must be followed instead. - -\bi -\item \verb/,,label{.<label>}/ - - A label name {\em must start in a dot} as shown. LaTeX {\em forbids the use of underscores in labels}, even if they are escaped by a backslash; it is recommended to use {\em dots} instead. - -\item \verb/,,textref{<text>}{.<label>}/ - - This is translated for the printed document as \verb/<text> (sec. <section number>)/. In the hypertext display, \verb/<text>/ becomes a hypertext link to \verb/<label>/. \verb/<text>/ may have a local format of its own, e.g. -\verb/{\em <text>}/ or \verb/{\bf <text>}/. - -\item \verb/,,textref{<text>}{<file name>.<label>}/ - - This is the form for a reference to a label in an external file. In the printed document it becomes \verb/<text>/ with a numbered footnote showing the directory and name of the target file's source and the target label. - - \verb/<file name>/ is the name of a .tex file (without the .tex extension!) in directory \verb:\$n\_doc/latex:; the name may contain {\em neither dots nor uppercase characters}, but underscores are allowed (and need not to be quotes with a backslash). - -\item \verb/,,whichref{<text>}{}/ - - can be used as a placeholder for a \verb/,,textref/ whose target is as yet unknown. - -\ei - -\subsection{ Cross-references to other types of documents} -\label{.cross.ref.other} - - The documentation system also contains ASCII documents and PostScript documents imported from elswehere. Such documents may be referred to through the following commands: - -\bi -\item \verb/,,ascref{<text>}{<file name>}/ -\item \verb/,,psref{<text>}{<file name>}/ -\ei - - \verb/<file name>/ is the name (without extension!) of a .txt file in directory \verb:\$n\_doc/txt: or of a .ps file in directory \verb:\$n\_hlp:; the name may contain {\em neither dots nor uppercase characters}, but underscores are allowed (and need not to be quotes with a backslash). - -\bi -\item \verb/,,srcref{<text>}{<directory><file name><extension>}/ -\ei - - This command is used to refer to program code or WNTINC table definitions (.dsc files). \verb/directory/ must be specified relative to -\verb/n_src/ and the file extension must be included. - - -\subsection{ Equations and equation references} -\label{.eqref} - - The commands \verb/,,Eqref{.<label>}/ and \verb/,,eqref{.<label>}/ are entirely analogous to the figure references (sec. \ref{.figref}) -\verb/,,Figref/ and \verb/,,figref/. - - -\section{ Figures and figure references} -\label{.fig} - - Figures with their captions reside in the directory -\verb:\$n\_doc/fig:. A figure consists of two components: -\bi - -\item a \verb:<name>.cap: {\em caption file} containing a caption and a the directive to include the figure. - -\item the diagram proper in the form of either an \verb/xfig/ drawing -\verb:<name>.fig:, or a binary (e.g. \verb/<name>.ps/ or \verb/<name>.gif/) file. -\ei - - A figure with its caption is included in a document source file through the command - -\verb: ,,input{../fig/<name>.cap: \ - -In the printed document, figure and caption are included in the standard way. In the hypertext display the word \verb/FIGURE/ is included, followed by the caption text, with a hypertext link from FIGURE to a postscript file. \ndoc generates that file automatically from the .fig file. - - -\subsection{ Caption files} -\label{.caption} - - The purpose of the caption file (as opposed to spelling out the caption text in the document source) is to enable the figure with its caption to exist as an independent unit that can be included in more than one document and also exist outside the context of any document. - - The caption file must not only provide the caption, but also the title under which the figure may be listed in the Handbook Overview. It is therefore important to adhere strictly to the following format: - - -\begin{verbatim} - ,,begin{figure}[htbp] - ,,fig{<name>} - ,,caption[]{<optional LaTeX commands, e.g. \it> - <title> - <optional LaTeX commands, e.g. \> <optional remainder of caption> - } - ,,label{.<label>} - ,,end{figure} -\end{verbatim} - -\noi Examples can be found in the -\verb:/\$n\_doc/fig: directory. - - You are free to choose the label; the recommended choice, however, is -the file name with underscores replaced by dots. (Remember that underscores are -illegal in labels and that labels must start with a dot.) - - Comment lines (but no {\em empty} lines!) may be arbitrarily added, -except that the \verb/<title>/ line must {\em immediately follow} the -\verb/,,caption/ command. - - -\subsection{ Xfig figures} -\label{.xfig} - - \verb/.fig/ files may be created without any restrictions with the -public-domain program \verb/xfig/. It is not necessary to produce a postscript -file with this program. \ndoc/ will take the \verb/.fig/ file and convert it -automatically. - - Often, figures drawn on a convenient scale on a workstation screen will -not fit on a standard A4 page. \ndoc/ may be instructed to automatically reduce -its scale by including in the figure a text line - -\verb/ <file name>.fig <nn>/ % -It is best to put this text in an inconspicuous corner and a small font (e.g. -10pt as opposed to a standard 20pt). - - -\subsection{ Postscript figures} -\label{.ps} - - It is also possible to include Postscript figures produced in other -ways than through xfig: Use the command \verb/,,ps{<filename>}/ instead of -\verb/,,fig/ and place the postscript file \verb/<filename>.ps/ in the -directory \verb:/\$n\_doc/bin: with a soft link to it in \verb/\$n\_hlp/. If it -can not be easily recovered, it is advisable to protect it against accidental -deletion! - - -\subsection{ Figure references} -\label{.figref} - - For references to figures, use - -\verb/ ,,figref{.<label>}/ and \verb/ ,,Figref{.<label>}/ - -\noi These commands translate to hypertext links \verb/figure/ or \verb/Figure/ -in the hypertext document, and to a standard reference \verb/figure <n>/ or -\verb/Figure <n>/ in the printed document. - - -\section{ Session transcripts} - - Verbatim transcripts of pieces of terminal dialogue controlling program -execution are an important ingredient to documentation. Such transcripts are -easily produced through the command - - \verb/ndoc S[cript] <file name>/ - -This starts a cshell script session in which you execute the program of which -you want a transcript. After exit from the script session, the collected script -is automatically formatted into a LaTeX file \verb/<file name>.trs/; what -remains for you to do is to cut out the irrelevant parts and perhaps add some -comments. A sample section of such a file is shown below - -\spbegin -\svbegin \begin{verbatim} % -,,spbegin % -,,skeyword{USE\_SCN\_NODE} ,,sprompt{(input node name)} ,,sdefault{= *:} -,,suser{?} % -,,svbegin ,,begin{verbatim} - Specify the node name from which the corrections should be calculated. - * indicates the same as the output node name. -\end{verbatim}\svend -\verb/,,end{verbatim},,svend/ -\svbegin\begin{verbatim} ,,spend -% -% -,,spbegin % -,,skeyword{USE\_SCN\_NODE} ,,sprompt{(input node name)} ,,sdefault{= *:} -,,suser{*} ,,sinline{Use the same SCN file} ,,spend -% -% -,,spbegin % -,,skeyword{USE\_SCN\_SETS} ,,sprompt{(Set(s) of input uv-data Sectors: -g.o.f.c.s)} ,,sdefault{= "":} ,,suser{2.0.0.0.0} ,,sinline{Sets in job 2} -,,spend % -% -,,spbegin % -,,skeyword{HA\_RANGE} ,,sprompt{(DEG) (HA range)} ,,sdefault{= *:} -,,suser{,,scr} ,,sinline{Use all scans in these sets} % -,,svbegin ,,begin{verbatim} - 0123456789ABCD - 0 -+++++++++++++ - 1 -++++++++++++ - 2 -+++++++++++ - 3 -++++++++++ - 4 -+++++++++ - 5 -++++++++ - 6 -+++++++ - 7 -++++++ - 8 -+++++ - 9 -++++ - A -+++ - B -++ - C -+ - D - -\end{verbatim}\svend -\verb/,,end{verbatim}\svend/ -\svbegin\begin{verbatim} -,,spend% -\end{verbatim}\svend -\spend - - The file consists of sections delimited by \verb/,,spbegin/ and -\verb/,,spend/, each consisting of a prompt with its reply and the ensuing -output from the computer. LaTeX will treat these sections as blocks in which a -page break can not occur. The following LaTeX commands are used: - -\bi - -\item \verb/,,skeyword/, \verb/,,sprompt/ and \verb/,,sdefault/ are the -components of a program prompt; - -\item \verb/,,suser/ is the user's reply (in which \verb/,,scr/ represents a -null reply (carriage return only) and \verb/,,seof/ an end-of-file -(control-D)).; - -\item \verb/,,sinline/ is an inline comment typed in during the session (an -exclamation mark plus text following the answer to a prompt); - -\item \verb/,,svbegin/ and \verb/,,svend/ delimit the verbatim section in -which computer output is rendered. - -\ei - - It is necessary to check these scripts with some care. The system does -occasionally get confused by the way the parameter interface splits long input -and output lines. The errors are usually easily corrected. - -\bi - -\item To replace parts of lengthy computer output, e.g. by ellipses; note -that, since this occurs inside \verb/verbatim/ sections, LaTeX commands such as -\verb/,,vdots/ can not be used. A line consisting of just three dots gives a -satisfactory effect. - -\item To add \verb/,,sinline/ comments. These must be placed either -immediately following \verb/,,suser/ commands or between an -\verb/,,end{verbatim}/ and the adjacent \verb/,,svend/. - -\item To reduce the size of verbatim sections that are more than 80 -characters wide (e.g. sections from a log file). - -\ei - - -\section {Documentation directories} - -% -% - -\begin{figure}[hbtp] - -\fig{doc_sources_and_hyper} -\caption[.]{ \it -\label{.doc.sources.and.hyper} On-line Help files in the \NEWSTAR -documentation system and their origins. -\\ Files shown in boldface are the documentation and program sources, those -shown in regular print are the derived Help files. -\\ The full-drawn arrows indicate hypertext links for diagrams. The links to -the other files types are not shown. The dotted arrow indicate links to in-line -picture files that contain formulas and tables (sec. \ref{.formulas}). -\\ The dashed arrows indicate the relations between the files: Straight arrows -represent a direct derivation, merging arrows a source-file inclusion. The -capital letters on the arrows show in which procedure the derivation is -implemented: -\\ C= ndoc Cook; F= ndoc Fig; T= ndoc Test; P= ndoc Print. } -\end{figure} - -% -% - -\begin{figure}[hbtp] - -\fig{doc_sources_and_print} -\caption[.]{ \it -\label{.doc.sources.and.print} Printable documents in the \NEWSTAR -documentation system and their origins. -\\ Files shown in boldface are the documentation and program sources, those -shown in regular print are the derived printable files in the Help system. -\\ The dashed arrows indicate the relations between the files: Straight arrows -represent a direct derivation, merging arrows a source-file inclusion. The -capital letters on the arrows show in which procedure the derivation is -implemented: F= ndoc Fig; T= ndoc Test; P= ndoc Print. } -\end{figure} - - - The documentation system encompasses three classes of files. The -document source files reside in subdirectories of \verb/$n_doc/; the code -source files which may also be referenced reside in subdirectories of -\verb/$n_src/. All hypertext files reside in a tree of subdirectories rooted in -\verb/\$n\_hlp/. The interrelations of all these files are shown in -\figref{.doc.sources.and.hyper}. - - The following types of source texts are used: -\bi -\item Narrative LaTeX source texts: \verb:$n_doc/latex/<name>.tex: - -\item Caption LaTeX source texts: \verb:$n_doc/fig/<name>.cap: - -\item Standardised LaTeX files describing the private and public program -parameter interfaces: \verb:$n_doc/intfc/<name>.tex:. These files incorporate -\verb/.tef/ files derived from the program-parameter definition files -(\verb/<name>.psc/). - -\item ASCII texts: \verb:$n_doc/txt/<name>.txt: - -\item Postscript files for which no source exists: \verb:$n_doc/ps/<name>.ps: - -\item Code sources: \verb:$n_src/<directory>/<name>.<extension>: -\ei - - In processing, temporary files are created in the current directory; -their names either contain the string \verb/\_tmp./ or end in \verb/.tmp/. -\ndoc normally deletes them when exiting. - - \verb/latex2html/, invoked by \verb/ndoc Cook/, translates each file -\verb/<name>.tex/ into a file -\verb:\$n\_hlp/<name>/<name>.html:. A large number of -\verb/.html/ files are therefore in subdirectories of -\verb/\$n\_hlp/. - - \verb/ndoc Print/ creates .ps PostScript text files in \verb/\$n\_hlp/. - \verb/ndoc Fig/ creates .fps PostScript diagram files in -\verb/\$n\_hlp/. - - - - -\section {Processing commands} - -\subsection{ Programmer's commands: Processing individual files } - - The commands are of the form - - \verb/ndoc <operation> [-<option>] <file>/ - - \verb/<file>/ is the full file name including the extension, and it -must be in the current directory. Wildcards may be used. - - The \verb/<operation>/ and \verb/-<option>/ arguments may be -abbreviated and are case-insensitive. The following operations and options are -available: - -\bi -\item \verb/P[rint]/ creates [a] PostScript file[s] from [a] .tex source -file[s], with the following options: - \bi - \item[] \verb/-S[yntax]/ do nothing else; - \item[] \verb/-V[iew]/ display the output using ghostview; - \item[] \verb/-P[rint]/ print the PostScript output. - \ei - -\verb/Print/ uses the LaTeX program. It attempts to suppress the verbose output -of this program by filtering out everything except essential error messages. If -you encounter a problem that you can not solve, submit your source file to the -\NEWSTAR group for diagnosis. - -\item \verb/C[ook]/ creates a Hypertext file from [a] .tex document[s]. This -operation makes use of \ltoh. This program may crash over LaTeX syntax errors -without properly analysing them. {\em It is therefore recommended to first do a -\verb/Print -Syntax/ check.} - -\item \verb/K[ey]/ creates Hypertext files from [a] .pin, .psc or .pef -file[s] - -\item \verb/L[ink]/ creates the softlinks from the \verb/n_hlp/ directory to -the \verb:$n_doc/txt: and \verb:$n_src: directories. -\ei - - \ndoc checks the dates of its input and output files. If the output is -newer than the date, \ndoc emits a message and proceeds with the next input -file. This check is incomplete in that it does not check the status of -\verb/,,input/ files such as figure captions. - - There are two ways of bypassing this check: -\bi -\item Setting the environment variable \verb/n_force/. -\item \verb/touch/ing the inpout file to set its modification time to the -present time. -\ei - - When working in a shadow system, \ndoc makes no difference between hard -copies and soft links to the master system: Both are unconditionally compiled. - - -\subsection{ \NEWSTAR manager's commands: Maintaining the documentation system -} - - To recompile the entire documentation collection from its sources, one -uses the command - -\verb/ ndoc All/ - -\noindent \ndoc will ask which parts of the system to recompile, the default -being 'yes' for all subsystems. In this mode of operation \ndoc bypasses the -check for an up-to-date output file. - - One of the actions available in \verb/ndoc All/ is a systematic check -of the correspondence between source and output files. This is a very useful -action because it clears up leftovers of obsolete documents and pinpoints areas -of trouble. - - - - -\section{ Debugging .tex files} - - \ndoc goes a long way in filtering from the verbiage that LaTeX spews -out the essential diagnostics. It shows the essential section of LaTeX output -where the error is reported (including a line number) plus five lines of text -in the middle of which the error was found. Very often this information -suffices to pinpoint the error. If it does not, you may have to take a better -look either at your source or at the \verb/<file name>_tmp.tex/ file that is -the file LaTeX was actually processing. Note that the line number reported -refers to this latter file! - - Specific errors that have been encountered and are not covered by this -diagnosis mechanism are described below. - - -\subsection{ Temporarily disabling parts of .tex files} - - \ndoc provides a simple facility for "commenting out" large parts of -\tex input files: \verb/.c+/ and \verb/.c-/ can be inserted (on lines -containing nothing else) to delimit a piece of text that must be ignored. This -has proved very useful to quickly pinpoint the location where an error occurs. - - -\subsection{ Specific errors} - -\subsection{ LaTeX bugs} - - Both \verb/ndoc Print/ and \verb/ndoc Cook/ make use of LaTeX and may -therefore be affected by LaTeX bugs. For cases not covered here, refer to "The -LaTex Book", which is probably the best informed source about that program. - -\bi -\item Symptom: - {\em The word \verb/dump/ appears in the place of a Figure or Table.} - - This is an obscure problem. One situation in which it has been observed -is when a \verb/,,figure/ environment is put at the very start of a document, -i.e. without any preceding text. (This condition will not occur for regular -documents but may occur in test situations.) It has also been seen in a case -where a \verb/tabular/ environment was nested inside a \verb/table/, in which -case the solution was to remove the \verb/table/ environment. - -\item Symptom: - {\em LaTeX complains about a 'runaway argument' in a \verb/,,caption/ -environment.} - - This may happen when the optional argument in square brackets is -omitted. As of 940914, this argument is automatically provided for by -\verb/doc_preprocess.csh/. - -\item Symptom: - {\em ndoc Print runs without reporting any error, but produces a -PostScript file in which figure references appear without numbers filled in.} - - This happens when the \verb/,,label/ directive in a \verb/figure/ -declaration is placed before the \verb/,,caption/ command.! - -\item Symptom: - {\em LaTeX reports: TeX capacity exceeded, sorry [parameter stack -size=60].} - - This has been seen to happen when a \verb/,,section/ title argument is -too complicated, e.g. because it contains italicised text. - -\item Symptom: - {\em LaTeX finds a \$ or \_ in a \verb/,,textref/ file argument that is -not escaped by a preceding backslash.} - - This may happen when the expansion of a command defined through -\verb/,,newcommand/ contains a referencing command (sec. \ref{.cross.ref}). Fix -the problem by including escape charaters in the \verb/,,newcommand/ -definition. - -\item Symptom: - {\em LaTeX complains about "Paragraph ended before \verb/,,sbox/ was -complete" in a figure caption.} - - The \verb/,,caption/ environment appears to be sensitive to formatting. -In particular new paragraphs (i.e. blank lines) and \verb/,,indent/ commands -have been noted to produce this nasty error. In some cases it was found -necessary to put the \verb/,,label/ before the \verb/,,caption/. -\ei - - -\subsection{ Processing errors in ndoc} - - When LaTeX reports an error to \ndoc, \ndoc displays a five-line text -section in the middle of which the error occurred. This is not from the -original input text, but from the preprocessed text as it was eventually -presented tp LaTeX. Most errors are easily recognised and traced back to the -input \tex file. - -\bi -\item Symptom: - An error occurs which is associated with lines from the .tex input that -were concatenated by ndoc. - - This may very well be an error in the algorithm used by ndoc to merge -paragraphs into single long lines. It is not necessarily clear why LaTeX does -not accept the long line. An any rate, the recommended action is to check with -the \NEWSTAR manager. - -\item Symptom: - ndoc cook stops with message -\verb/ nawk: record `[...]' has too many fields/ - - In preprocessing documents, ndoc formats paragraphs into single lines -to make it easier to identify LaTeX command sequences. Find the offending -paragraph in you documents and insert \verb/<newline><blank>/ at some -appropriate place. The leading paragraph will inhibit the merger of the two -parts of the paragraph, yet LaTeX will format the two parts into one paragraph. - -\ei - - -\subsection{Processing errors in \protect\verb/ndoc Cook/} - - The program \ltoh on which \verb/ndoc Cook/ is based is rather lax on -checking LaTeX syntax but may stumble over the consequences of an error missed. -{\it It is therefore strongly recommended to first check the syntactical -correctness of the .tex file through \verb/ndoc P/}. - -\bi -\item Symptom: - \verb/.DVI file can't be opened/ - - \ltoh runs LaTeX on a selection from the .tex file consisting of -formulas, tabular material and diagrams. This run failed to produce a -\verb/.dvi/ file, but \ltoh gobbled up all the error information. This error -may be due to improper configuration of your system, {\em e.g.} a misplaced -\verb/.sty/ file. It is virtually impossible to diagnose except by using a -modified version of \ltoh (sec. \ref{.latex2html}). - -\item Symptom -\begin{verbatim} The nplot_descr.aux file was not found, so sections will not -be numbered and cross-references will be shown as icons. -\end{verbatim} - - Your .tex file contains a \verb/,,ref/ directive. Convert al -\verb/,,ref/s to \verb/,,textref/s. - -\item Symptom: - Commands that are normally accepted are reported as unknown. - - This is likely to be the result of a syntax error. (For example, a -missing \verb/,,end{itemize}/ will cause \verb/,,item/ to be reported as -unknown.) Check your input file by running \verb/ndoc Print/ on it. - -\item Symptom: - \verb/xmosaic/ can not find a file pointed at by a hypertext link. - - Note the file name appearing at the bottom of the \verb/xmosaic/ window -when you point at the reference. This reference should be in either of the -forms: - - \verb:<file name>/<file name>.html -\indent \verb:../<file name>/<file name>.html - -If it starts in a \verb:/:, you have to replace your \ltoh by the -modified version (sec. \ref{.latex2html}). - -\item Symptom: - \verb/latex2html/ warns that the \verb/.aux/ file was not found but -otherwise \verb/ndoc Cook/ seems to complete normally. - - The precise nature of this error is not understood, but it seems to -indicate that something is wrong in a cross-reference. (e.g. a LaTeX -\verb/,,ref/ command). It has been seen to occur when a \verb/,,ref/ with a -label name containing dots is used (cf. the section on cross references (sec. \ref{.cross.ref})). -\ei - - -\appendix - -\section{\protect\ltoh} -\label{.latex2html} - - \ltoh is a public-domain perl script created by Nikos Drakos at Leeds -University, England (Email: nikos@cbl.leeds.ac.uk) and available through -anonymous ftp. It has been found to be a reliable and highly capable program. -Apart from configuring it to the local environment, two changes were found -necessary: - -\bi -\item All lines containing the string \verb:s/\W//g: must be commented out by -prefixing them with a \verb/#/. This makes \ltoh capable of handling relative -file references and removes an inconsistency it the processing of labels and -references. - -\item After the line - -\indent \verb/system("$LATEX $$_images.tex");/ - -insert the lines - -\begin{verbatim} - if (!-e "20756_images.dvi") - {system("cat 20756_images.log"); die "Failure to process formulas"; } -\end{verbatim} -\ei - -\subsection{ Formulas and the like in \protect\ltoh} -\label{.formulas} - - LaTeX allows many constructs, such as formulas, tables etc., for which -there is no HTML counterpart (yet). \ltoh converts each single occurrence of -these into a little picture file that is linked in-line into the \verb/.html/ -document. The pictures are stored in \verb/.xbm/ files in the same directory as -the \verb/.html/ file. - - Since building these pictures is a very time-consuming process, \ltoh -seeks to reuse them as much as possible whenever it recompiles a \verb/.tex/ -file. To this end, it maintains an administration in the file \verb/images.pl/ -in the \verb/.html/ file's directory. Therefore, to insure the integrity of the -.html document, both the \verb/.xbm/ files and \verb/images.pl/ must be left in -place. As of May 1996, \verb/doc_cook.csh/ contains a section of code that -finds all in-line picture references in the renewed \verb/.html/ file, reports -any referred-to files that are missing and deletes unreferenced \verb/.xbm/ -files. - - In cases a \verb/.xbm/ file is reported missing, the way to get it -rebuilt is to delete \verb/images.pl/ in order to force \ltoh to rebuild all -the picture files from scratch. - - - - - -\end{document} - diff --git a/src/doc/latex/doc_guide_tmp.aux b/src/doc/latex/doc_guide_tmp.aux deleted file mode 100644 index e69de29bb2d1d6434b8b29ae775ad8c2e48c5391..0000000000000000000000000000000000000000 diff --git a/src/doc/latex/doc_guide_tmp.dvi b/src/doc/latex/doc_guide_tmp.dvi deleted file mode 100644 index 1c5e63b413638fb178869621e200bb2b1a662c18..0000000000000000000000000000000000000000 Binary files a/src/doc/latex/doc_guide_tmp.dvi and /dev/null differ diff --git a/src/doc/latex/doc_guide_tmp.err b/src/doc/latex/doc_guide_tmp.err deleted file mode 100644 index e69de29bb2d1d6434b8b29ae775ad8c2e48c5391..0000000000000000000000000000000000000000 diff --git a/src/doc/latex/doc_guide_tmp.rack b/src/doc/latex/doc_guide_tmp.rack deleted file mode 100644 index 464c4a66c2f4dbf2f5edb99c3f181009774d1d2c..0000000000000000000000000000000000000000 --- a/src/doc/latex/doc_guide_tmp.rack +++ /dev/null @@ -1,17 +0,0 @@ -%% \documentstyle[subeqn]{article} - \documentstyle{article} - \newcommand{\iinput}[1]{ \input{#1} } - \input /newstar/master/src/doc/latex/hb_print_preamble.sty - \input /newstar/master/src/doc/latex/hb_symbols.sty - \input /newstar/master/latex2html/html.sty - \iinput{epsf.sty} - \newcommand{\fig}[1]{ - \centering - \leavevmode - \epsfbox{/newstar/master/hlp/fig/#1.ps} - } - \begin{document} - {\it Printout of NEWSTAR document chapter - \today } - \\ \\ -\input doc_guide_tmp.text -\end{document} diff --git a/src/doc/latex/doc_guide_tmp.text b/src/doc/latex/doc_guide_tmp.text deleted file mode 100644 index 9665bea0e02111f7e77d50d59544a53d14775c8b..0000000000000000000000000000000000000000 --- a/src/doc/latex/doc_guide_tmp.text +++ /dev/null @@ -1,767 +0,0 @@ - -% -% -% -% -% -",," -% -% -substitutes -% -% -% -% -% -% -% -% -% -% -% -% -% -% -% -% -% -% -% -% -'' -% -% -% -% -% -% -% -% -\newcommand{\bi}{ \begin{itemize} } -\newcommand{\ei}{ \end{itemize} } -\newcommand{\noi}{ \noindent} -\newcommand{\ndoc}{ \verb/ndoc/} -\newcommand{\ltoh}{ \verb/latex2html/ } -\newcommand{\tex}{ \verb/.tex/ } - - -\chapter{Guide for writing and maintaining \NEWSTAR documents} - -\tableofcontents - -\section{ Summary of \NEWSTAR LaTeX commands } - - For quick reference use the following list of special LaTeX commands available in the \NEWSTAR documentation system: -\\ \\ -ascref (sec. \ref{.cross.ref.other}) \\ -Ascref (sec. \ref{.cross.ref}) \\ -caption (sec. \ref{.caption}) \\ -chapter (sec. \ref{.layout}) \\ -eqref (sec. \ref{.eqref}) \\ -Eqref (sec. \ref{.eqref}) \\ -fig (sec. \ref{.caption}) \\ -figref (sec. \ref{.figref}) \\ -Figref (sec. \ref{.figref}) \\ -label (sec. \ref{.cross.ref.latex}) \\ -ps (sec. \ref{.ps}) \\ -psref (sec. \ref{.cross.ref.other}) \\ -Psref (sec. \ref{.cross.ref}) \\ -ref (sec. \ref{.cross.ref.latex}): {\em Not to be used} \\ -tableofcontents (sec. \ref{.layout}) \\ -textref (sec. \ref{.cross.ref.latex}) \\ -Textref (sec. \ref{.cross.ref}) \\ -whichref (sec. \ref{.cross.ref}) \\ - - -\section{ The \NEWSTAR documentation system} - - The \NEWSTAR documentation system provides documentation in two forms: An on-line hypertext system based on the public-domain program "xmosaic" and standard LATeX documents. Both forms are derived from a single set of LaTeX source files; for the hypertext form, the public-domain translator \ltoh is used. - - Broadly speaking, authors are free to use the standard LaTeX constructs. In particular, \ltoh handles tabular material, mathematical formulas and the inclusion of diagrams very well. Writers should be aware, however, that every bit of math-mode text is translated into a little bitmap that must be loaded separately for display. This considerably slows down both the processing by \verb/ndoc Cook/ and the display by xmosaic. - - Simple macros defined through -\verb/,,newcommand/ can be used freely, but complicated nesting of macros should be avoided. - - To satisfy the specific needs of the \NEWSTAR system and circumvent some deficiencies of \ltoh, the guidelines given below should be followed. - - -\subsection{ LaTeX and ASCII documents} - - The official format for \NEWSTAR document sources is LaTeX. It is, however, considered more important that documentation exist at all than that it have a finished form. {\em Users are strongly invited to submit any bits of text that they consider to be of potential use to others.} Such contributions will quickly be integrated with the system and the \NEWSTAR group will assume responsibility for their further maintenance, including their eventual conversion to or integration with the LaTeX document collection. - - -\section{ Guidelines for writing LaTeX documents} - -\subsection{ General layout} -\label{.layout} - -\bi -\item Preamble - - The document compiler \ndoc automatically inserts a preamble including the \verb/,,begin{document}/ and also appends the \verb/,,end{document}/. The source of a document may add private preamble elements such as -\verb/,,newcommand/ definitions. Apart from that, the first document line is the -\verb/,,chapter/ line: - -\item \verb/,,chapter{<text>}/ - - The chapter is the basic documentation unit. \ndoc formats the argument -\verb/<text>/ as a hypertext or printed document title. - - -\item \verb/,,tableofcontents/ - - This creates a standard table of the chapter's contents in the printed document and an equivalent unnumbered table with links to the (sub)(sub)sections in the hypertext display. - - -\item \verb/,,[sub]sub]]section{<text>}/ - - These commands produce standard section headings, numbered in the printed document, unnumbered in the hypertext display. -\ei - - -\section{ Cross-references} -\label{.cross.ref} - - In writing documents, the placeholder \verb/,,whichref{text}{}/ can be used for references whose target is not yet known. - - For most referencing commands, a companion with the leading character capitalised is available; these work the same way except that the text argument is printed in boldface. This feature is intended for use in the documentation home-page document, \verb/hb_contents.tex/. - - -\subsection{ Cross-references to text in LaTeX documents } -\label{.cross.ref.latex} - - Cross-references must work in both the printed and hypertext versions of a document. For this reason, {\it the standard LaTeX \verb/,,ref/ command is unsuitable} and the rules given below must be followed instead. - -\bi -\item \verb/,,label{.<label>}/ - - A label name {\em must start in a dot} as shown. LaTeX {\em forbids the use of underscores in labels}, even if they are escaped by a backslash; it is recommended to use {\em dots} instead. - -\item \verb/,,textref{<text>}{.<label>}/ - - This is translated for the printed document as \verb/<text> (sec. <section number>)/. In the hypertext display, \verb/<text>/ becomes a hypertext link to \verb/<label>/. \verb/<text>/ may have a local format of its own, e.g. -\verb/{\em <text>}/ or \verb/{\bf <text>}/. - -\item \verb/,,textref{<text>}{<file name>.<label>}/ - - This is the form for a reference to a label in an external file. In the printed document it becomes \verb/<text>/ with a numbered footnote showing the directory and name of the target file's source and the target label. - - \verb/<file name>/ is the name of a .tex file (without the .tex extension!) in directory \verb:\$n\_doc/latex:; the name may contain {\em neither dots nor uppercase characters}, but underscores are allowed (and need not to be quotes with a backslash). - -\item \verb/,,whichref{<text>}{}/ - - can be used as a placeholder for a \verb/,,textref/ whose target is as yet unknown. - -\ei - -\subsection{ Cross-references to other types of documents} -\label{.cross.ref.other} - - The documentation system also contains ASCII documents and PostScript documents imported from elswehere. Such documents may be referred to through the following commands: - -\bi -\item \verb/,,ascref{<text>}{<file name>}/ -\item \verb/,,psref{<text>}{<file name>}/ -\ei - - \verb/<file name>/ is the name (without extension!) of a .txt file in directory \verb:\$n\_doc/txt: or of a .ps file in directory \verb:\$n\_hlp:; the name may contain {\em neither dots nor uppercase characters}, but underscores are allowed (and need not to be quotes with a backslash). - -\bi -\item \verb/,,srcref{<text>}{<directory><file name><extension>}/ -\ei - - This command is used to refer to program code or WNTINC table definitions (.dsc files). \verb/directory/ must be specified relative to -\verb/n_src/ and the file extension must be included. - - -\subsection{ Equations and equation references} -\label{.eqref} - - The commands \verb/,,Eqref{.<label>}/ and \verb/,,eqref{.<label>}/ are entirely analogous to the figure references (sec. \ref{.figref}) -\verb/,,Figref/ and \verb/,,figref/. - - -\section{ Figures and figure references} -\label{.fig} - - Figures with their captions reside in the directory -\verb:\$n\_doc/fig:. A figure consists of two components: -\bi - -\item a \verb:<name>.cap: {\em caption file} containing a caption and a the directive to include the figure. - -\item the diagram proper in the form of either an \verb/xfig/ drawing -\verb:<name>.fig:, or a binary (e.g. \verb/<name>.ps/ or \verb/<name>.gif/) file. -\ei - - A figure with its caption is included in a document source file through the command - -\verb: ,,input{../fig/<name>.cap: \ - -In the printed document, figure and caption are included in the standard way. In the hypertext display the word \verb/FIGURE/ is included, followed by the caption text, with a hypertext link from FIGURE to a postscript file. \ndoc generates that file automatically from the .fig file. - - -\subsection{ Caption files} -\label{.caption} - - The purpose of the caption file (as opposed to spelling out the caption text in the document source) is to enable the figure with its caption to exist as an independent unit that can be included in more than one document and also exist outside the context of any document. - - The caption file must not only provide the caption, but also the title under which the figure may be listed in the Handbook Overview. It is therefore important to adhere strictly to the following format: - - -\begin{verbatim} - ,,begin{figure}[htbp] - ,,fig{<name>} - ,,caption[]{<optional LaTeX commands, e.g. \it> - <title> - <optional LaTeX commands, e.g. \> <optional remainder of caption> - } - ,,label{.<label>} - ,,end{figure} -\end{verbatim} - -\noi Examples can be found in the -\verb:/\$n\_doc/fig: directory. - - You are free to choose the label; the recommended choice, however, is -the file name with underscores replaced by dots. (Remember that underscores are -illegal in labels and that labels must start with a dot.) - - Comment lines (but no {\em empty} lines!) may be arbitrarily added, -except that the \verb/<title>/ line must {\em immediately follow} the -\verb/,,caption/ command. - - -\subsection{ Xfig figures} -\label{.xfig} - - \verb/.fig/ files may be created without any restrictions with the -public-domain program \verb/xfig/. It is not necessary to produce a postscript -file with this program. \ndoc/ will take the \verb/.fig/ file and convert it -automatically. - - Often, figures drawn on a convenient scale on a workstation screen will -not fit on a standard A4 page. \ndoc/ may be instructed to automatically reduce -its scale by including in the figure a text line - -\verb/ <file name>.fig <nn>/ % -It is best to put this text in an inconspicuous corner and a small font (e.g. -10pt as opposed to a standard 20pt). - - -\subsection{ Postscript figures} -\label{.ps} - - It is also possible to include Postscript figures produced in other -ways than through xfig: Use the command \verb/,,ps{<filename>}/ instead of -\verb/,,fig/ and place the postscript file \verb/<filename>.ps/ in the -directory \verb:/\$n\_doc/bin: with a soft link to it in \verb/\$n\_hlp/. If it -can not be easily recovered, it is advisable to protect it against accidental -deletion! - - -\subsection{ Figure references} -\label{.figref} - - For references to figures, use - -\verb/ ,,figref{.<label>}/ and \verb/ ,,Figref{.<label>}/ - -\noi These commands translate to hypertext links \verb/figure/ or \verb/Figure/ -in the hypertext document, and to a standard reference \verb/figure <n>/ or -\verb/Figure <n>/ in the printed document. - - -\section{ Session transcripts} - - Verbatim transcripts of pieces of terminal dialogue controlling program -execution are an important ingredient to documentation. Such transcripts are -easily produced through the command - - \verb/ndoc S[cript] <file name>/ - -This starts a cshell script session in which you execute the program of which -you want a transcript. After exit from the script session, the collected script -is automatically formatted into a LaTeX file \verb/<file name>.trs/; what -remains for you to do is to cut out the irrelevant parts and perhaps add some -comments. A sample section of such a file is shown below - -\spbegin -\svbegin \begin{verbatim} % -,,spbegin % -,,skeyword{USE\_SCN\_NODE} ,,sprompt{(input node name)} ,,sdefault{= *:} -,,suser{?} % -,,svbegin ,,begin{verbatim} - Specify the node name from which the corrections should be calculated. - * indicates the same as the output node name. -\end{verbatim}\svend -\verb/,,end{verbatim},,svend/ -\svbegin\begin{verbatim} ,,spend -% -% -,,spbegin % -,,skeyword{USE\_SCN\_NODE} ,,sprompt{(input node name)} ,,sdefault{= *:} -,,suser{*} ,,sinline{Use the same SCN file} ,,spend -% -% -,,spbegin % -,,skeyword{USE\_SCN\_SETS} ,,sprompt{(Set(s) of input uv-data Sectors: -g.o.f.c.s)} ,,sdefault{= "":} ,,suser{2.0.0.0.0} ,,sinline{Sets in job 2} -,,spend % -% -,,spbegin % -,,skeyword{HA\_RANGE} ,,sprompt{(DEG) (HA range)} ,,sdefault{= *:} -,,suser{,,scr} ,,sinline{Use all scans in these sets} % -,,svbegin ,,begin{verbatim} - 0123456789ABCD - 0 -+++++++++++++ - 1 -++++++++++++ - 2 -+++++++++++ - 3 -++++++++++ - 4 -+++++++++ - 5 -++++++++ - 6 -+++++++ - 7 -++++++ - 8 -+++++ - 9 -++++ - A -+++ - B -++ - C -+ - D - -\end{verbatim}\svend -\verb/,,end{verbatim}\svend/ -\svbegin\begin{verbatim} -,,spend% -\end{verbatim}\svend -\spend - - The file consists of sections delimited by \verb/,,spbegin/ and -\verb/,,spend/, each consisting of a prompt with its reply and the ensuing -output from the computer. LaTeX will treat these sections as blocks in which a -page break can not occur. The following LaTeX commands are used: - -\bi - -\item \verb/,,skeyword/, \verb/,,sprompt/ and \verb/,,sdefault/ are the -components of a program prompt; - -\item \verb/,,suser/ is the user's reply (in which \verb/,,scr/ represents a -null reply (carriage return only) and \verb/,,seof/ an end-of-file -(control-D)).; - -\item \verb/,,sinline/ is an inline comment typed in during the session (an -exclamation mark plus text following the answer to a prompt); - -\item \verb/,,svbegin/ and \verb/,,svend/ delimit the verbatim section in -which computer output is rendered. - -\ei - - It is necessary to check these scripts with some care. The system does -occasionally get confused by the way the parameter interface splits long input -and output lines. The errors are usually easily corrected. - -\bi - -\item To replace parts of lengthy computer output, e.g. by ellipses; note -that, since this occurs inside \verb/verbatim/ sections, LaTeX commands such as -\verb/,,vdots/ can not be used. A line consisting of just three dots gives a -satisfactory effect. - -\item To add \verb/,,sinline/ comments. These must be placed either -immediately following \verb/,,suser/ commands or between an -\verb/,,end{verbatim}/ and the adjacent \verb/,,svend/. - -\item To reduce the size of verbatim sections that are more than 80 -characters wide (e.g. sections from a log file). - -\ei - - -\section {Documentation directories} - -% -% - -\begin{figure}[hbtp] - -\fig{doc_sources_and_hyper} -\caption[.]{ \it -\label{.doc.sources.and.hyper} On-line Help files in the \NEWSTAR -documentation system and their origins. -\\ Files shown in boldface are the documentation and program sources, those -shown in regular print are the derived Help files. -\\ The full-drawn arrows indicate hypertext links for diagrams. The links to -the other files types are not shown. The dotted arrow indicate links to in-line -picture files that contain formulas and tables (sec. \ref{.formulas}). -\\ The dashed arrows indicate the relations between the files: Straight arrows -represent a direct derivation, merging arrows a source-file inclusion. The -capital letters on the arrows show in which procedure the derivation is -implemented: -\\ C= ndoc Cook; F= ndoc Fig; T= ndoc Test; P= ndoc Print. } -\end{figure} - -% -% - -\begin{figure}[hbtp] - -\fig{doc_sources_and_print} -\caption[.]{ \it -\label{.doc.sources.and.print} Printable documents in the \NEWSTAR -documentation system and their origins. -\\ Files shown in boldface are the documentation and program sources, those -shown in regular print are the derived printable files in the Help system. -\\ The dashed arrows indicate the relations between the files: Straight arrows -represent a direct derivation, merging arrows a source-file inclusion. The -capital letters on the arrows show in which procedure the derivation is -implemented: F= ndoc Fig; T= ndoc Test; P= ndoc Print. } -\end{figure} - - - The documentation system encompasses three classes of files. The -document source files reside in subdirectories of \verb/$n_doc/; the code -source files which may also be referenced reside in subdirectories of -\verb/$n_src/. All hypertext files reside in a tree of subdirectories rooted in -\verb/\$n\_hlp/. The interrelations of all these files are shown in -\figref{.doc.sources.and.hyper}. - - The following types of source texts are used: -\bi -\item Narrative LaTeX source texts: \verb:$n_doc/latex/<name>.tex: - -\item Caption LaTeX source texts: \verb:$n_doc/fig/<name>.cap: - -\item Standardised LaTeX files describing the private and public program -parameter interfaces: \verb:$n_doc/intfc/<name>.tex:. These files incorporate -\verb/.tef/ files derived from the program-parameter definition files -(\verb/<name>.psc/). - -\item ASCII texts: \verb:$n_doc/txt/<name>.txt: - -\item Postscript files for which no source exists: \verb:$n_doc/ps/<name>.ps: - -\item Code sources: \verb:$n_src/<directory>/<name>.<extension>: -\ei - - In processing, temporary files are created in the current directory; -their names either contain the string \verb/\_tmp./ or end in \verb/.tmp/. -\ndoc normally deletes them when exiting. - - \verb/latex2html/, invoked by \verb/ndoc Cook/, translates each file -\verb/<name>.tex/ into a file -\verb:\$n\_hlp/<name>/<name>.html:. A large number of -\verb/.html/ files are therefore in subdirectories of -\verb/\$n\_hlp/. - - \verb/ndoc Print/ creates .ps PostScript text files in \verb/\$n\_hlp/. - \verb/ndoc Fig/ creates .fps PostScript diagram files in -\verb/\$n\_hlp/. - - - - -\section {Processing commands} - -\subsection{ Programmer's commands: Processing individual files } - - The commands are of the form - - \verb/ndoc <operation> [-<option>] <file>/ - - \verb/<file>/ is the full file name including the extension, and it -must be in the current directory. Wildcards may be used. - - The \verb/<operation>/ and \verb/-<option>/ arguments may be -abbreviated and are case-insensitive. The following operations and options are -available: - -\bi -\item \verb/P[rint]/ creates [a] PostScript file[s] from [a] .tex source -file[s], with the following options: - \bi - \item[] \verb/-S[yntax]/ do nothing else; - \item[] \verb/-V[iew]/ display the output using ghostview; - \item[] \verb/-P[rint]/ print the PostScript output. - \ei - -\verb/Print/ uses the LaTeX program. It attempts to suppress the verbose output -of this program by filtering out everything except essential error messages. If -you encounter a problem that you can not solve, submit your source file to the -\NEWSTAR group for diagnosis. - -\item \verb/C[ook]/ creates a Hypertext file from [a] .tex document[s]. This -operation makes use of \ltoh. This program may crash over LaTeX syntax errors -without properly analysing them. {\em It is therefore recommended to first do a -\verb/Print -Syntax/ check.} - -\item \verb/K[ey]/ creates Hypertext files from [a] .pin, .psc or .pef -file[s] - -\item \verb/L[ink]/ creates the softlinks from the \verb/n_hlp/ directory to -the \verb:$n_doc/txt: and \verb:$n_src: directories. -\ei - - \ndoc checks the dates of its input and output files. If the output is -newer than the date, \ndoc emits a message and proceeds with the next input -file. This check is incomplete in that it does not check the status of -\verb/,,input/ files such as figure captions. - - There are two ways of bypassing this check: -\bi -\item Setting the environment variable \verb/n_force/. -\item \verb/touch/ing the inpout file to set its modification time to the -present time. -\ei - - When working in a shadow system, \ndoc makes no difference between hard -copies and soft links to the master system: Both are unconditionally compiled. - - -\subsection{ \NEWSTAR manager's commands: Maintaining the documentation system -} - - To recompile the entire documentation collection from its sources, one -uses the command - -\verb/ ndoc All/ - -\noindent \ndoc will ask which parts of the system to recompile, the default -being 'yes' for all subsystems. In this mode of operation \ndoc bypasses the -check for an up-to-date output file. - - One of the actions available in \verb/ndoc All/ is a systematic check -of the correspondence between source and output files. This is a very useful -action because it clears up leftovers of obsolete documents and pinpoints areas -of trouble. - - - - -\section{ Debugging .tex files} - - \ndoc goes a long way in filtering from the verbiage that LaTeX spews -out the essential diagnostics. It shows the essential section of LaTeX output -where the error is reported (including a line number) plus five lines of text -in the middle of which the error was found. Very often this information -suffices to pinpoint the error. If it does not, you may have to take a better -look either at your source or at the \verb/<file name>_tmp.tex/ file that is -the file LaTeX was actually processing. Note that the line number reported -refers to this latter file! - - Specific errors that have been encountered and are not covered by this -diagnosis mechanism are described below. - - -\subsection{ Temporarily disabling parts of .tex files} - - \ndoc provides a simple facility for "commenting out" large parts of -\tex input files: \verb/.c+/ and \verb/.c-/ can be inserted (on lines -containing nothing else) to delimit a piece of text that must be ignored. This -has proved very useful to quickly pinpoint the location where an error occurs. - - -\subsection{ Specific errors} - -\subsection{ LaTeX bugs} - - Both \verb/ndoc Print/ and \verb/ndoc Cook/ make use of LaTeX and may -therefore be affected by LaTeX bugs. For cases not covered here, refer to "The -LaTex Book", which is probably the best informed source about that program. - -\bi -\item Symptom: - {\em The word \verb/dump/ appears in the place of a Figure or Table.} - - This is an obscure problem. One situation in which it has been observed -is when a \verb/,,figure/ environment is put at the very start of a document, -i.e. without any preceding text. (This condition will not occur for regular -documents but may occur in test situations.) It has also been seen in a case -where a \verb/tabular/ environment was nested inside a \verb/table/, in which -case the solution was to remove the \verb/table/ environment. - -\item Symptom: - {\em LaTeX complains about a 'runaway argument' in a \verb/,,caption/ -environment.} - - This may happen when the optional argument in square brackets is -omitted. As of 940914, this argument is automatically provided for by -\verb/doc_preprocess.csh/. - -\item Symptom: - {\em ndoc Print runs without reporting any error, but produces a -PostScript file in which figure references appear without numbers filled in.} - - This happens when the \verb/,,label/ directive in a \verb/figure/ -declaration is placed before the \verb/,,caption/ command.! - -\item Symptom: - {\em LaTeX reports: TeX capacity exceeded, sorry [parameter stack -size=60].} - - This has been seen to happen when a \verb/,,section/ title argument is -too complicated, e.g. because it contains italicised text. - -\item Symptom: - {\em LaTeX finds a \$ or \_ in a \verb/,,textref/ file argument that is -not escaped by a preceding backslash.} - - This may happen when the expansion of a command defined through -\verb/,,newcommand/ contains a referencing command (sec. \ref{.cross.ref}). Fix -the problem by including escape charaters in the \verb/,,newcommand/ -definition. - -\item Symptom: - {\em LaTeX complains about "Paragraph ended before \verb/,,sbox/ was -complete" in a figure caption.} - - The \verb/,,caption/ environment appears to be sensitive to formatting. -In particular new paragraphs (i.e. blank lines) and \verb/,,indent/ commands -have been noted to produce this nasty error. In some cases it was found -necessary to put the \verb/,,label/ before the \verb/,,caption/. -\ei - - -\subsection{ Processing errors in ndoc} - - When LaTeX reports an error to \ndoc, \ndoc displays a five-line text -section in the middle of which the error occurred. This is not from the -original input text, but from the preprocessed text as it was eventually -presented tp LaTeX. Most errors are easily recognised and traced back to the -input \tex file. - -\bi -\item Symptom: - An error occurs which is associated with lines from the .tex input that -were concatenated by ndoc. - - This may very well be an error in the algorithm used by ndoc to merge -paragraphs into single long lines. It is not necessarily clear why LaTeX does -not accept the long line. An any rate, the recommended action is to check with -the \NEWSTAR manager. - -\item Symptom: - ndoc cook stops with message -\verb/ nawk: record `[...]' has too many fields/ - - In preprocessing documents, ndoc formats paragraphs into single lines -to make it easier to identify LaTeX command sequences. Find the offending -paragraph in you documents and insert \verb/<newline><blank>/ at some -appropriate place. The leading paragraph will inhibit the merger of the two -parts of the paragraph, yet LaTeX will format the two parts into one paragraph. - -\ei - - -\subsection{Processing errors in \protect\verb/ndoc Cook/} - - The program \ltoh on which \verb/ndoc Cook/ is based is rather lax on -checking LaTeX syntax but may stumble over the consequences of an error missed. -{\it It is therefore strongly recommended to first check the syntactical -correctness of the .tex file through \verb/ndoc P/}. - -\bi -\item Symptom: - \verb/.DVI file can't be opened/ - - \ltoh runs LaTeX on a selection from the .tex file consisting of -formulas, tabular material and diagrams. This run failed to produce a -\verb/.dvi/ file, but \ltoh gobbled up all the error information. This error -may be due to improper configuration of your system, {\em e.g.} a misplaced -\verb/.sty/ file. It is virtually impossible to diagnose except by using a -modified version of \ltoh (sec. \ref{.latex2html}). - -\item Symptom -\begin{verbatim} The nplot_descr.aux file was not found, so sections will not -be numbered and cross-references will be shown as icons. -\end{verbatim} - - Your .tex file contains a \verb/,,ref/ directive. Convert al -\verb/,,ref/s to \verb/,,textref/s. - -\item Symptom: - Commands that are normally accepted are reported as unknown. - - This is likely to be the result of a syntax error. (For example, a -missing \verb/,,end{itemize}/ will cause \verb/,,item/ to be reported as -unknown.) Check your input file by running \verb/ndoc Print/ on it. - -\item Symptom: - \verb/xmosaic/ can not find a file pointed at by a hypertext link. - - Note the file name appearing at the bottom of the \verb/xmosaic/ window -when you point at the reference. This reference should be in either of the -forms: - - \verb:<file name>/<file name>.html -\indent \verb:../<file name>/<file name>.html - -If it starts in a \verb:/:, you have to replace your \ltoh by the -modified version (sec. \ref{.latex2html}). - -\item Symptom: - \verb/latex2html/ warns that the \verb/.aux/ file was not found but -otherwise \verb/ndoc Cook/ seems to complete normally. - - The precise nature of this error is not understood, but it seems to -indicate that something is wrong in a cross-reference. (e.g. a LaTeX -\verb/,,ref/ command). It has been seen to occur when a \verb/,,ref/ with a -label name containing dots is used (cf. the section on cross references (sec. \ref{.cross.ref})). -\ei - - -\appendix - -\section{\protect\ltoh} -\label{.latex2html} - - \ltoh is a public-domain perl script created by Nikos Drakos at Leeds -University, England (Email: nikos@cbl.leeds.ac.uk) and available through -anonymous ftp. It has been found to be a reliable and highly capable program. -Apart from configuring it to the local environment, two changes were found -necessary: - -\bi -\item All lines containing the string \verb:s/\W//g: must be commented out by -prefixing them with a \verb/#/. This makes \ltoh capable of handling relative -file references and removes an inconsistency it the processing of labels and -references. - -\item After the line - -\indent \verb/system("$LATEX $$_images.tex");/ - -insert the lines - -\begin{verbatim} - if (!-e "20756_images.dvi") - {system("cat 20756_images.log"); die "Failure to process formulas"; } -\end{verbatim} -\ei - -\subsection{ Formulas and the like in \protect\ltoh} -\label{.formulas} - - LaTeX allows many constructs, such as formulas, tables etc., for which -there is no HTML counterpart (yet). \ltoh converts each single occurrence of -these into a little picture file that is linked in-line into the \verb/.html/ -document. The pictures are stored in \verb/.xbm/ files in the same directory as -the \verb/.html/ file. - - Since building these pictures is a very time-consuming process, \ltoh -seeks to reuse them as much as possible whenever it recompiles a \verb/.tex/ -file. To this end, it maintains an administration in the file \verb/images.pl/ -in the \verb/.html/ file's directory. Therefore, to insure the integrity of the -.html document, both the \verb/.xbm/ files and \verb/images.pl/ must be left in -place. As of May 1996, \verb/doc_cook.csh/ contains a section of code that -finds all in-line picture references in the renewed \verb/.html/ file, reports -any referred-to files that are missing and deletes unreferenced \verb/.xbm/ -files. - - In cases a \verb/.xbm/ file is reported missing, the way to get it -rebuilt is to delete \verb/images.pl/ in order to force \ltoh to rebuild all -the picture files from scratch. - - - - diff --git a/src/doc/latex/doc_guide_tmp.toc b/src/doc/latex/doc_guide_tmp.toc deleted file mode 100644 index b1b28d3cd6f3ccac32f8530b63143549312d58b5..0000000000000000000000000000000000000000 --- a/src/doc/latex/doc_guide_tmp.toc +++ /dev/null @@ -1,28 +0,0 @@ - \parskip 2pt\relax -\contentsline {section}{\numberline {1} Summary of {\sf NEWSTAR\nobreakspace {}}LaTeX commands }{1} -\contentsline {section}{\numberline {2} The {\sf NEWSTAR\nobreakspace {}}documentation system}{1} -\contentsline {subsection}{\numberline {2.1} LaTeX and ASCII documents}{2} -\contentsline {section}{\numberline {3} Guidelines for writing LaTeX documents}{2} -\contentsline {subsection}{\numberline {3.1} General layout}{2} -\contentsline {section}{\numberline {4} Cross-references}{2} -\contentsline {subsection}{\numberline {4.1} Cross-references to text in LaTeX documents }{2} -\contentsline {subsection}{\numberline {4.2} Cross-references to other types of documents}{3} -\contentsline {subsection}{\numberline {4.3} Equations and equation references}{3} -\contentsline {section}{\numberline {5} Figures and figure references}{3} -\contentsline {subsection}{\numberline {5.1} Caption files}{4} -\contentsline {subsection}{\numberline {5.2} Xfig figures}{4} -\contentsline {subsection}{\numberline {5.3} Postscript figures}{4} -\contentsline {subsection}{\numberline {5.4} Figure references}{4} -\contentsline {section}{\numberline {6} Session transcripts}{4} -\contentsline {section}{\numberline {7}Documentation directories}{6} -\contentsline {section}{\numberline {8}Processing commands}{6} -\contentsline {subsection}{\numberline {8.1} Programmer's commands: Processing individual files }{6} -\contentsline {subsection}{\numberline {8.2} {\sf NEWSTAR\nobreakspace {}}manager's commands: Maintaining the documentation system }{7} -\contentsline {section}{\numberline {9} Debugging .tex files}{7} -\contentsline {subsection}{\numberline {9.1} Temporarily disabling parts of .tex files}{7} -\contentsline {subsection}{\numberline {9.2} Specific errors}{8} -\contentsline {subsection}{\numberline {9.3} LaTeX bugs}{8} -\contentsline {subsection}{\numberline {9.4} Processing errors in ndoc}{8} -\contentsline {subsection}{\numberline {9.5}Processing errors in \verb /ndoc Cook/}{9} -\contentsline {section}{\numberline {A}\ltoh }{9} -\contentsline {subsection}{\numberline {A.1} Formulas and the like in \ltoh }{10} diff --git a/src/doc/latex/doc_release9511.tex b/src/doc/latex/doc_release9511.tex deleted file mode 100644 index 761d588fab3497e5754e66ecbacf3027b2dac02c..0000000000000000000000000000000000000000 --- a/src/doc/latex/doc_release9511.tex +++ /dev/null @@ -1,86 +0,0 @@ -% doc_release_9511.tex -% -% -\chapter{ Changes to the \NEWSTAR documentation system, November 1995} -{\center\it by Johan Hamaker, 951012} - -\tableofcontents - -\section{ New contents page} - - A new contents page, hb\_contents.tex, replaces the old one that was -generated by ndoc overview. This latter command is no longer valid and the -files \$n\_doc/hb\_contents.tbl and \$n\_doc/hb\_contents.tex must be deleted. - - The new contents page is hand-coded, which leads to a much more compact -format with a very much higher information density. - - -\subsection{ Up-to-date versus obsolescent documents} - - In the contents page, an attempt has been made to visually distinguish -references to obsolescent documents from those to up-to-date ones, the latter -being shown in boldface. - - - -\section{ Maintaining PostScript copies of all documents} - - It was found that ndoc print does not work in Westerbork because it -relies on a system environment. This was to be expected because the official -\NEWSTAR policy is that ndoc needs to work only in Dwingeloo. - - To give remote users access to printed copies, the .ps versions of all -documents are now stored in \$n\_hlp and should be exported from there. - - -\subsection{ New extension .fps for PostScript diagrams} - - ndoc fig produces PostScript versions of diagram graphics (.fig files); -these are then integrated into LaTeX documents through ,,fig commands in .cap -files that are themselves ,,input'ed by .tex files. To distinguish these -PostScript files from printable documents, the former carry the extension .fps -rather than .ps. - - - -\section{ Elimination of diagrams as independent documents} - - Until now copies of many diagrams have existed as independent .html -documents that could be referenced directly. This is a reasonable idea but -leads to problems when a caption refers to another diagram: If that diagram is -in the same document, the reference must be to a label, but if the diagram is -in a stand-alone diagram file, the reference must be to that file. - - The solution is to eliminate the standalone hypertext diagrams. Instead -of referring to the standalone document, one refers to the diagram in a text -file in which it is embedded. - - - -\section{ Referencing of Fortran and other source documents} - - It was found desirable to refer to files in the \$n\_src tree: Examples -are the \$n\_src/doc/txt/*.txt ASCII documents and the .dsc files that define -data structures. The obvious way to do this is through soft links, but these do -not work between the WWW server and the \$n\_src disk. - - The only solution is to make copies of the referenced documents on the -WWW server. For this purpose, a directory \$n\_hlp/src must be created with a -shadow directory tree containing copies of only those files that are referenced -(see ndoc options below).. - - A new procedure, doc\_copy.csh, has been created for this purpose. It -is driven by an internal table showing which files must be copied. - - -\section{ ndoc options } - - ndoc overview has been phased out. - - ndoc test will carry out a series of consistency checks between the -document source tree and the \$n\_hlp tree, eliminating files in the latter for -which no corresponding source exists and reporting anomalies. It also - - ndoc all compiles all program-interface descriptions, all LaTeX -documents and performs an ndoc test. diff --git a/src/doc/latex/file_indexing.tex b/src/doc/latex/file_indexing.tex deleted file mode 100644 index 7ebd30e5d204095dae347bb576e8b176ef73d290..0000000000000000000000000000000000000000 --- a/src/doc/latex/file_indexing.tex +++ /dev/null @@ -1,230 +0,0 @@ -%file_indexing.tex -% -% JPH 941128 -% HjV 950614 Change links to .WMP file and .NGF file -% JPH 960104 Add secs. on looping vs aggregates, repeated execution -% -% -\newcommand{\bi}{ \begin{itemize} } -\newcommand{\ei}{ \end{itemize} } -\newcommand{\bn}{ \begin{enumerate} } -\newcommand{\en}{ \end{enumerate} } -\newcommand{\eg}{ {\em e.g. } } - -\chapter{ The indexing and navigation of \NEWSTAR's compound data files } - -{\par \em Contributed by Johan Hamaker, November 1994 \\ - 960104: Add \textref{loops vs. aggregates}{.loops.vs.aggregates} - and \textref{repetitive processing}{.repetitive} -\centering \par} - -\tableofcontents - -\section{ Indexed data-file types } -\label{.file.types} - - The indexing structure described in this document is common to three types of \NEWSTAR files. Each of these is a collection of 'elementary' {\em data blocks} under a {\em hierarchical index}: - -\bi -\item The \textref{.SCN file}{scn_file}, collecting visibility {\em sectors}; - -\item The \textref{.WMP file}{wmp_descr}, collecting {\em images}: maps and antenna patterns; - -\item The \textref{.NGF file}{ngcalc_descr.ngf.file}, collecting one-dimensional {\em cuts} through the visibility and correction -\textref{hypercubes}{scn_file.hypercube}. -\ei - - This document describes the generic properties of the index mechanism and the versatile mechanisms in the \NEWSTAR program-parameter interface through which sets of data blocks can be defined for processing. - - -\section{ The index structure } -\label{.index.structure} - - The data blocks are organised in a {\em hierarchical index}. This structure is isomorphous to the familiar directory structure for files, the data blocks taking the place of the individual files. Unlike directories, however, the indices are not names but {\em numbers}. As we shall see below, in some cases these numbers are related to some physical parameter, in other cases they are simply administrative sequence numbers. - - Just like a full file path is composed of concatenated directory names, a data block is adressed through its {\em compound index}, {\em i.e.} its concatenated indices: -\\ \\ -\verb/ <index0>.<index1>.<index2>..../ -\\ \\ -At all levels, the first index value is 0. You may find this uncomfortable at first, but you will soon get used to it - - The successive indices convey specific information which is different between file types. The following information levels are used: -\spbegin -\bi -\item[] \verb/ <grp> /group -\item[] \verb/ <obs> /observation -\item[] \verb/ <fld> /mosaic subfield -\item[] \verb/ <chn> /frequency channel -\item[] \verb/ <pol> /polarisation -\item[] \verb/ <typ> /type -\item[] \verb/ <ifr> /interferometer -\item[] \verb/ <seq> /sequence number -\ei -\spend % -The compound indices are: -\spbegin -\bi -\item[] \verb/ <grp>.<obs>.<fld>.<chn>.<seq> / for the -\textref{.SCN file}{scn_file}; -\item[] \verb/ <grp>.<fld>.<chn>.<pol>.<typ>.<seq> / for the \textref{.WMP file}{wmp_descr}; -\item[] \verb/ <grp>.<fld>.<chn>.<pol>.<ifr>.<seq> / for the -\textref{.NGF file}{ngcalc_descr.ngf.file}. -\ei -\spend More details about the meaning and use of these levels is given in the documents on the individual file types. - - -\section{ Addressing groups of data blocks } -\label{.addressing.groups} - - The true power of the indexing mechanism lies in its ability to address data blocks in aggregates of widely varying composition, through shorthand notations that one may type in response to a prompt asking for the data blocks to be processed. - - -\subsection{ Data-block aggregates } -\label{.sets} - - Firstly, a compound index may refer to a {\em set} or {\em aggregate} of data blocks in several ways: - -\bi -\item Instead of a single index value, one may define an aggregate through a {\em range} with an {\em increment}: -\\ \\ -\verb/ <start value>-<end value>:<step>/ -\\ \\ -or abbreviations thereof (with obvious meaning): -\spbegin -\verb/ <start value>-<end value>/ -\verb/ <start value>-:<step>/ -\verb/ <start value>-/ -\spend - \bi - \item[] {\em WARNING: The range ('-') and step (':') notation is valid {\em only} for the index parameter \verb/<xxx>_SETS/. In all other contexts they will be interpreted as expression operators.} - \ei -\item One may also use the {\em wildcard} character '*', meaning 'all values'. An index level may be omitted (by putting nothing between the dots that delimit it), and even the dots themselves for the trailing values; in all these cases \NEWSTAR will substitute wildcards. Thus -\\ \\ -\verb/ 3.*.1.*.* 3..1.*.* 3.*.1 3..1/ -\\ \\ -all mean the same thing. - -\item Secondly, a number of sets in any of these forms may be concatenated with commas in between, \eg -\\ \\ -\verb/ 3.1-5:2, 4, 5.1..3-:3/ -\ei - - For all practical purposes, the number of data blocks that can be addressed in these ways through a single specification is unlimited. - - -\subsection{ Looping} -\label{.looping} - - Suppose one wants to make 8 maps from 16 visibility sectors and specifies -\bi -\item[] \verb/ 3.5.0-15.1.0/ -\ei -for the input. NMAP will take this specification to mean that all 16 sectors must be used in the first map and will then stop because the input sectors are exhausted. - - What one needs is a mechanism to tell NMAP that it should use the sectors in pairs. One way to do this is to 'manually' execute it 8 times with sector specifications -\spbegin -\bi -\item[] \verb/ SCN_SETS = 3.5.0-1.1.0/ -\item[] \verb/ SCN_SETS = 3.5.2-3.1.0/ -\item[] \indent {\em etc.} -\ei -\spend - {\em LOOPS} provide an efficient shorthand to do just that. With a LOOP specification, one directs the program to execute a program a number of times, incrementing the data-block specification after every cycle. The LOOP specification takes the form -\bi -\item[] \verb/ <number of cycles>,<compound-index increment per cycle>/ -\ei - -In combination with this, the initial set of data blocks is specified. - - Thus for the above example one would specify -\spbegin -\bi -\item[] \verb/ SCN_LOOPS = 8,0.0.2 / -\item[] \verb/ SCN_SETS = 3.1.0-1.1.0 / -\ei -\spend -Zeros may be omitted in the increment; thus in the above, the shorter notation -\verb/SCN_LOOPS = 8,..2/ is just as good. - - -\subsubsection{ Repetitive execution } -\label{.repetitive} - - The LOOPS construct may also be used for executing the same operation more than once in a single run. viz. by specifying an increment of 0. E.g. -\bi -\item[] \verb/ SCN_LOOPS = 8,...1, 3,0 / -\ei -will select 8 sector aggregates, processing each 3 times in a row. - - -\subsection{ Nested loops, aggregate start sets } -\label{.nested.loops} - - It is possible to specify more than one loop simultaneously, \eg -\spbegin -\bi -\item[] \verb/ SCN_LOOPS = 64,..1, 8,...1/ -\item[] \verb/ SCN_SETS = 2.0.0.1.* / -\ei -\spend for a mosaic of 64 subfields and 8 frequency channels. This will result in 8 maps being made in succession for each of the 64 subfiels; {\em i.e.} a following loop is nested {\em inside} the ones specified before it. - - It more than one set is specified for the start cycle, incrementation is applied to each set. Thus, \eg, for a specification -\spbegin -\bi -\item[] \verb/ SCN_LOOPS = 8,.1/ -\item[] \verb/ SCN_SETS = 1.0.3.1, 1.1-3:2.0.7/ -\ei - -the data blocks used would be -\bi -\item[] \verb/ 1.0.3.1, 1.1.0.7, 1.3.0.7/ for the first cycle; -\item[] \verb/ 1.1.3.1, 1.2.0.7, 1.4.0.7/ for the second cycle; -\item[] \verb/ 1.1.3.1, 1.3.0.7, 1.5.0.7/ for the third cycle; -\ei -\spend -{\em etc.}. (This example merely serves to show how the loop mechanism works; one is not likely in reality to want successive cycles with partly overlapping input data blocks.) - - -\subsection{ Loops versus data-block aggregates } -\label{.loops.vs.aggregates} - - In those operations where each data block is processaed individually, the blocks to be selected may be specified either as an aggregate or through a loop construct. For instance, Self-calibration operates on each data block ('sector') in a .SCN file in isolation; in this case, e.g. the specifications -\bi -\item[] \verb/ SCN_SETS = 0.3-6.0.0-8/ -\ei -and -\bi -\item[] \verb/ SCN_LOOPS = 4,.1, 9,...1 / -\item[] \verb/ SCN_SETS = 0.3.0.0 / -\ei -are equivalent. The only reason why one might want to use a LOOPS specification in this case is to control the order in shich the dat blocks are selected. - - There are also applications in which data blocks are combined, for instance when a sky map is made using an aggregate of .SCN-file sectors as input. Here the LOOPS construct results in a separate map for each loop cycle, rather than a single map from all input sectors as an aggregate specification would. See \textref{above}{.nested.loops} for an example where a number of maps are made each using a sector aggregate as input. - - -\section{ When one is not sure of the existing index ranges } -\label{.query} - - Data files may become so large and complex that one does not remember precisely the ranges of the indices in all the various branches of the index hierarchy. If one doesn't particularly care, one may use wildcards or deliberately specify an index range that is too large: In most cases a \NEWSTAR program, finding that a requested data block does not exist, will simply proceed to the next one. Thus, for example, if one specifies 8 loop cycles but there are only data for the first three, the 4th through 8th cycles will be traversed but nothing will be done in them. - - Another possibility one has is to reply with 'L' (for {\em Layout}) or 'O' (for {\em Overview}) to a \verb/_SETS/ or \verb/_LOOPS/ prompt. This will give you information about the composition of your data file. - - -\section{ Absolute indexing } - - In addition to the compound indices discussed so far, one may also use the {\em absolute} index to address a data block. The absolute index is a sequence number that is allocated sequentially to each new data block created; thus the newest data block invariably has the highest absolute index. Like the other indices, the absolute index starts at 0. - - To address a data block through its absolute index, prefix the number with a hash sign, \eg -\bi -\item[] \verb/ WMP_SETS = #23-27/ -\ei - -Absolute indices can be used throughout in place of compound indices. For example, the loop specification -\bi -\item[] \verb/ NGF_LOOPS = 3,#1, 4,#3/ -\item[] \verb/ MGF_SETS = 3.7.5.1.*/ -\ei - -is valid (but is may not be very easy to be sure that it does the right thing). - - diff --git a/src/doc/latex/files_descr.tex b/src/doc/latex/files_descr.tex deleted file mode 100644 index 346edc9964a026881d63877c078d283136811344..0000000000000000000000000000000000000000 --- a/src/doc/latex/files_descr.tex +++ /dev/null @@ -1,542 +0,0 @@ -% JPH 940916 Make compilable -% -% @(#) files_descr.tex v1.2 04/08/93 JEN -% -% History: -% JPH 940602 minor changes -% JPH 940914 Bug fix -% - -\chapter{ \NEWSTAR data-file organisation and the programs' associated user -interfaces} - -{\it Contributed by J.E. Noordam, August 1993} - - -\tableofcontents - - -\section{\NEWSTAR data and ancillary file types} - -The \NEWSTAR programs recognize three major types of data files, which are -identified by their extension: -\\ -\\ .SCN files: uv-data and uv-model -\\ .MDL files: SELFCAL source model -\\ .WMP files: maps of various kinds - -\NEWSTAR programs also produce a number of ancillary files, with the following -extensions (the list may no longer be complete): -\\ -\\ .PLT-files: to be plotted -\\ .LOG-files: to be printed -\\ .NGF-files: produced by NGALC -\\ .MNG-files: used to make plots with the MONGO package - - The relations between these files and the \NEWSTAR programs are shown -in \figref{.newstar.overview}. - -\input{../fig/newstar_overview.cap} - - -%======================================================================== -\section{Directories and nodes (files)} -\label{.nodes} - - For historical reasons, the \NEWSTAR programs refer to data files as -{\bf nodes} in a {\bf database}. In fact, they are just files in a directory. -Users are recommended to use a separate sub-directory for each data reduction -project. - - However, although they refer to the same thing, there is a slight -difference between {\bf node names} used by the user and the actual {\bf file -names}: Node names are a series of alpha-numeric character strings separated by -dots, e.g.: - -\begin{verbatim} - mynode - mynode.21cm.yesterday.s.x.c.d.file.dd -\end{verbatim} - -The maximum length of a node name is 80 characters (which means maximally 39 -dots). This is converted to a {\em file name} by: -\\ -- appending the extension (.SCN, .MDL or .WMP), \\ -- converting all dots (.) to underscores (\_), \\ -- converting all lowercase to uppercase, -- replacing the underscore nearest but less than 47 to a dot. (?) \\ -\\ -This file name is then prefixed with the current database (default nothing). - - Parts of a node name can be set aside for short-hand use. This can be -done by the INFIX keyword (see COMMON keywords), or in a node specification by -enclosing a part in parenthesis (). This enclosed part will from then on be -available to all programs that are run in {\bf the current stream}. Reference -to `the infix' is made by typing a \#, e.g.: - -\begin{verbatim} - mynode.21(cm.yesterday.s.x.c.d.file.d)d -\end{verbatim} - -Typing {\tt mynode.92\#e} will then produce {\tt -mynode.92cm.yesterday.s.x.c.d.file.de} - -The database (directory) name can also be included in the node definition: - -\begin{verbatim} - wnb/data/mynode - ../other/mynode.21cm.yesterday.s.x.c.d.file.dd -\end{verbatim} - - If a database is specified in this way, it will be saved in such a way -that all subsequent program runs {\bf in the same stream} that have no explicit -database specified, will use it, including the currently running program at all -its further node questions. - - - -%=============================================================================== -\section{The \NEWSTAR data files (SCN, MDL, WMP)} - - These three \NEWSTAR data files are each described in detail in their -own `File Description' chapter in this Handbook. In this Overview section, it -is explained how the basic units (called Sets) in such a file can be selected -individually or in groups. For each of the three data files, an overview is -given of the various ways in which the user may interact with these `objects', -with references to the relevant program options. - - -%------------------------------------------------------------------------------- -\subsection{Data file logical organisation: Sets} -\label{data.sets} - - The three main \NEWSTAR data file (node) types are logically organised -in the same way: they consist of a number of basic units called `Sets', which -can be selected by the user in two ways: - -\begin{itemize} -\item - By {\bf direct reference} to an absolute set index: {\tt \#ir} selects -set nr {\tt ir}, in which {\tt ir} can be a range of contiguous sets (see -below). Direct reference is only useful if the user knows exactly how the -various Sets are ordered in the file. - -\item - By {\bf indexed reference} to a series of indices that represent -parameters like map or channel nr. A `selector' consists of a series on -integer indices, separated by points. The indices may also be specified as -ranges of indices or wildcards ($\ast$). For instance: {\tt ir1.ir2.*.ir4} -selects all Sets with index values in the indicated ranges. - -\end{itemize} - - {\bf Index ranges} ({\tt ir}) can take the following forms {\bf (NB: -Indices start at 0!)}: - -\begin{tabular}{ll} {\bf int} &single index value at this level -\\ {\bf $\ast$} &wildcard: all possible index values at this level -\\ {\bf int-} &all index values at this level, starting at `int' -\\ {\bf int1-int2[:int3]} & - index values `int1' through `int2' by step `int3' (dflt=1) \\ -{\bf int1:int3} &interpreted as int1-$\ast$:int3 \\ {\bf omitted} - &in the middle: interpreted as $.\ast$ - ($.. \equiv .\ast.$) \\ {\bf omitted} -&at the end: interpreted as $.\ast$ - ($..2 \equiv \ast.\ast.2.\ast.\ast.\ast$) \\ -\end{tabular} - - -%------------------------------------------------------------------------ -\subsection{Using loops} -\label{loops} - - Sometimes a program must be run more than once for the same -SCN-file, but for different Sets. In that case, the {\bf LOOPS} keyword can -used to specify subsequent ranges of Sets. A loop is specified by means of a -pair of values: The first value indicates how often the loop should execute, -the second specifies an increment to be given to the Set specification at each -run. - - For example: {\tt loops=3,..2} indicates that the program has to run -three times, each time incrementing the 3rd Set index by 2. So, if the first -Set (selected with the keyword SETS) was {\tt 0.0-3.2.5.*}, the program will be -run three times, for the Sets - -\begin{verbatim} - 0.0-3.2.5.*. - 0.0-3.4.5.*. - 0.0-3.6.5.*. -\end{verbatim} - -{\bf Nested loops} can be specified by stringing loop definitions (pairs of -values) together. For instance: {\tt loops=3,..2,5,...3} adds an inner loop of -5 program runs in which the 4th Set index is incremented by 3 each time: - -\begin{verbatim} - 0.0-3.2.5.*. 0.0-3.2.8.*. 0.0-3.2.11.*. - 0.0-3.2.14.*. 0.0-3.2.17.*. - 0.0-3.4.5.*. 0.0-3.4.8.*. 0.0-3.4.11.*. - 0.0-3.4.14.*. 0.0-3.4.17.*. - 0.0-3.6.5.*. 0.0-3.6.8.*. 0.0-3.6.11.*. - 0.0-3.6.14.*. 0.0-3.6.17.*. -\end{verbatim} - - -%=============================================================================== -\section{Overview of interactions with the SCN file} -\label{scn} - - The SCN-file contains uv-data, and possibly the uv-representation of a -source model. A single SCN-file may contain uv-data of different (but related) -observations. - - For more information, see the dedicated SCN-file section in this -chapter of the Handbook, and also the section on the program NSCAN. It -contains a description of the structure and the contents of the -SCN-file. - - -%------------------------------------------------------------------------------ -\subsection{Creating SCN files} -\label{scn.create} - -- From WSRT circle files: NSCAN option LOAD. \\ -- From ATCA (Australia Telescope Compact Array) files: NATNF.\\ -- From old (R-series) SCN-files: NSCAN option FROM\_OLD.\\ -- Simulated uv-data: NSIMUL? (not implemented yet).\\ - -%------------------------------------------------------------------------------ -\subsection{Inspecting the contents of a SCN file} -\label{scn.inspect} - -- File Layout: NSCAN option SHOW\\ -- File header: NSCAN option SHOW\\ -- Set headers: NSCAN option SHOW\\ -\hspace*{5mm} - Telescope (dipole) angle/ellipt corr: NCALIB option POLAR -SHOW\\ -- Scan headers: NSCAN option SHOW\\ -\hspace*{5mm} - Telescope gain/phase corr: NCALIB option SHOW\\ -- uv-data (corrected, converted): NSCAN option SHOW\\ -- Display of (gridded) uv-data or uv-model: See WMP file below.\\ -- Plot telescope gain/phase corr (REDC+ALGC+OTHC): NPLOT option TELESCOPE\\ -- Plot Redundancy/Selfcal residuals: NPLOT option RESIDUAL\\ -- Plot uv-data or uv-model: NPLOT option DATA or MODEL\\ -- Print average telescope gain/phase corr (R+A+O): NCALIB option SHOW\\ -- Extract various astrophysical info: NGCALC\\ - -%------------------------------------------------------------------------------ -\subsection{Editing the header information of a SCN file} -\label{scn.int} - - Almost every value (observation parameters, corrections, etc) in the -SCN-file headers may be edited manually by means of NSCAN option -SHOW EDIT. This means that, even if there is no specific \NEWSTAR routine to -change something, it can always be done by hand. This may be laborious in some -cases, {\em but at least it is possible!}. This feature is particularly useful -in those (rare) cases where erroneous information has somehow been put in the -header during the observations in Westerbork. - -%------------------------------------------------------------------------------ -\subsection{Applying corrections to uv-data} -\label{scn.apply} - - In general, uv-data in a SCN-file is {\em never physically modified}. -Corrections may be applied (or de-applied) to the uv-data whenever the data is -read into memory to be processed. The user may specify which corrections are -applied (or de-applied) by specifying the value of the general \NEWSTAR -keywords APPLY and DE\_APPLY, which are used by all \NEWSTAR programs that -handle uv-data. Use {\tt dws NGEN} -(see Common features of \NEWSTAR programs). - -%------------------------------------------------------------------------------ -\subsection{Modyfing the stored corrections} -\label{scn.modify} - -{\bf Zeroeing} selected corrections: NCALIB option SET ZERO - -{\bf Set Header} (corrections that are `constant' in time):\\ -- Any value: NSCAN option SHOW EDIT\\ -- POLC (dipole angle error and ellipticity corr):\\ -\hspace*{5mm} - Estimation: NCALIB option POLAR CALC\\ -\hspace*{5mm} - Manual: NCALIB option POLAR SET, EDIT, ZERO\\ -\hspace*{5mm} - Copying from calibrator: NCALIB option POLAR COPY\\ - -{\bf Scan Header} (corrections that vary per HA):\\ -- Any value: NSCAN option SHOW EDIT\\ -- Telescope (dipole) gain/phase corr:\\ -\hspace*{5mm} - Estimation: NCALIB option REDUN \\ -\hspace*{10mm} - Redundancy (no model): REDC\\ -\hspace*{10mm} - Align: ALGC\\ -\hspace*{10mm} - Selfcal ALGC\\ -\hspace*{5mm} - Manual: NCALIB option SET MANUAL, ZERO, RENORM \\ -\hspace*{5mm} - Copying from calibrator: NCALIB option SET COPY, CCOPY, LINE\\ -- Phase Zero Difference: OTHC\\ -\hspace*{5mm} - Estimation: NCALIB option POLAR VZERO CALC, APPLY, ASK, SCAN \\ -\hspace*{5mm} - Manual: NCALIB option POLAR VZERO MANUAL, ASK\\ -\hspace*{5mm} - Copying from calibrator: NCALIB option POLAR VZERO COPY\\ -- Extinction corr (manual): NCALIB option SET EXTINCT\\ -- Refraction corr (manual): NCALIB option SET REFRACT\\ -- Faraday corr (input of ionosonde data): NCALIB option SET FARADAY\\ - -%------------------------------------------------------------------------------ -\subsection{Modifying a uv-model in the SCN-file} -\label{scn.uvmodel} - - See Overview of interactions with MDL file below. - -%------------------------------------------------------------------------------ -\subsection{Reorganisation of SCN files} -\label{scn.reorg} - -- Create new `Job' from Sets in the same SCN-file: NSCAN option REGROUP\\ -- Create a `secondary' SCN-file (data selection, correction): NCOPY\\ - (not implemented yet)\\ -- Delete SCN-file: Use UNIX command {\tt rm <xxx>.SCN} (be careful!)\\ - -%------------------------------------------------------------------------------ -\subsection{Export of uv-data from SCN files} -\label{scn.export} - -- To UVFITS format (AIPS): NSCAN option UVFITS, PFITS\\ -- To old (R-series) SCN-file format: NSCAN option TO\_OLD\\ -- To WMP file (as gridded uv-data or maps): NMAP option MAKE\\ - - - -%============================================================================== -\section{Overview of interactions with an MDL file} -\label{mdl.inter} - - A MDL file contains a collection of source model components. -This may consist of a mixture of {\bf multi-parameter components} and ordinary -{\bf CLEAN components}. The MDL file may also contain {\bf reference -coordinates} (obtained from a SCN-file) for the position of the field centre -and the observing frequency. - - For more information, see the dedicated MDL-file section in this -chapter of the Cookbook, and also the section on the program NSCAN. It -contains a description of the structure and the contents of the -MDL-file. - - NOTE: Note that the model in the MDL file may be manipulated by means -of NMODEL {\bf options} (i.e. options of the program NMODEL), or by MDL {\bf -handles}. The latter operations (e.g. READ, WRITE, EDIT, -SHOW) are available in all the programs that deal with source models: -NCALIB, NMAP, NCLEAN, NSCAN, NMODEL. - -%---------------------------------------------------------------------------- -\subsection{Adding source components to an MDL file} -\label{mdl.generate} - -- Manual, by specifying source parameters: MDL handle ADD.\\ -- Automatic search of a map (in a WMP file): NMODEL action FIND\\ -- CLEANing a map (in a WMP file): NCLEAN option BEAM, UVCOVER, COMPON\\ -- Save model from SCN file in an MDL file: NMODEL option SAVE\\ -- Convert old (R-series) model to \NEWSTAR MDL file format.\\ - -%---------------------------------------------------------------------------- -\subsection{Modifying a model in an MDL file} -\label{mdl.modify} - -Modifying {\bf source components}:\\ -- Improve source parameters by fitting to the uv-data: - NMODEL option UPDATE, XUPDATE\\ -- Manual editing: MDL handle EDIT, FEDIT\\ -- Delete:\\ -\hspace*{5mm} - All components: MDL handle CLEAR, ZERO\\ -\hspace*{5mm} - Selected components: - MDL handle DELETE, DNCLOW, DCLOW, DAREA\\ -\hspace*{5mm} - Selected components: MDL handle EDIT, FEDIT\\ -- Calibrate (position, flux): MDL handle CALIB\\ -- Combine components at the same position: MDL handle MERGE\\ -- Correct for primary beam attenuation: NMODEL option BEAM, DEBEAM\\ - -Modifying {\bf reference coordinates}:\\ -- Change epoch or coordinate system: NMODEL option CONVERT\\ -NB: Reference position and frequency are obtained from SCN-file.\\ - -%---------------------------------------------------------------------------- -\subsection{Inspecting, displaying and sorting an MDL model} -\label{mdl.inspect} - -Inspecting:\\ -- Show list of components: MDL handle SHOW (screen) or PRINT (log-file)\\ -- Idem, in RA/DEC coordinates: MDL handle RSHOW, RLIST\\ -- Show source list statistics: MDL handle TOT \\ - -Displaying:\\ -- As gridded uv-model from SCN file: See WMP file below\\ -- As a map of the uv-model in the SCN-file: See WMP file below\\ -- As position markers in a map: NPLOT option MAP\\ -- As `restored' components in a CLEAN residual map: NCLEAN option UREST \\ - -Sorting:\\ -- According to decreasing flux: MDL handle SORT, WRITE(!)\\ -- According to the value of another source parameter: MDL handle FSORT\\ - - -%---------------------------------------------------------------------------- -\subsection{Relation with the uv-model in the .SCN file} -\label{mdl.uvmodel} - - The source components in an MDL file may be Fourier transformed to the -uv-plane, to the uv-coordinates of the uv-data in a SCN-file. -This {\bf uv-model} is then `saved' in the SCN-file, together with a copy of -the MDL source components that produced it. - - Whenever a uv-model is needed (e.g. for Selfcal in NCALIB, or source -subtraction in NMAP) the user is always asked to specify a {\bf input model} -explicitly, even if there is already a {\bf saved uv-model} in the SCN-file. -This input model may be specified either by reading -(and editing) components from an MDL-file, or by editing source components -manually. In the following, the Fourier transform of the input model will be -called the {\bf input uv-model}. The user may choose (keyword MODEL\_ACTION) -one of the following possibilities: - -- {\bf Merge:} Replace the saved uv-model with the input uv-model, - and use it. \\ -- {\bf Add:} Add the input uv-model to the saved uv-model in the SCN-file, - and use it.\\ -- {\bf New:} Replace the saved uv-model in the SCN file by the input uv-model, - and use it.\\ -- {\bf Temporary:} Use the input uv-model, - but do not change the saved uv-model in the SCN-file.\\ -- {\bf Increment:} Use the sum of the saved uv-model and the input uv-model, - but do not change the saved uv-model in the SCN-file. \\ - - NOTE: \NEWSTAR regards the saved uv-model as {\em applied corrections}, -i.e. corrections that were applied (added) to the cosmic noise before the -uv-data were put into the SCN file. Hence, to subtract the saved uv-model from -the data, one could specify `MOD' to the (NGEN) keyword DE\_APPLY! Specifying -`MOD' to the (NGEN) keyword APPLY will restore a model that was subtracted from -the data before it was put in the SCN file (?). - -%---------------------------------------------------------------------------- -\subsection{The various uses of an MDL model} -\label{mdl.uses} - -{\bf Present uses} of an MDL model:\\ -- To solve for telescope gain/phase errors (Selfcal, Align): - NCALIB option REDUN\\ -- To subtract sources from the uv-data: NMAP option MAKE\\ -- To combine multiple observations:\\ -\hspace*{5mm} - With different frequencies (broad-band mapping)\\ -\hspace*{5mm} - With different pointing centres (mosaicking)\\ -\hspace*{5mm} - With different observing times\\ -- To deal with instrumental polarisation\\ -- To undo large Faraday `rotation measures'\\ -- To detect variability \\ -- To simulate uv-data: clumsy at the moment\\ - - -{\bf Potential uses} of an MDL model:\\ -- To deal with non-isoplanaticity\\ -- To simulate uv-data: NSIMUL (not yet implemented)\\ - - - -%=============================================================================== -\section{Overview of interactions with a WMP file} -\label{wmp.inter} - - A WMP file contains a collection of 2-dimensional arrays, that are -related in some way (but that can have different dimensions). These may be -maps for various frequencies (line data) or pointing centres -(mosaicking), antenna patterns and CLEAN residual maps. Even rectangular -arrays of (gridded) uv-data may be put in a WMP file, for display purposes. - - For more information, see the dedicated WMP-file section in this -chapter of the Cookbook, and also the section on the program NSCAN. It -contains a description of the structure and the contents of the -WMP-file. - - -%------------------------------------------------------------------------------ -\subsection{Creating maps in WMP files} -\label{wmp.create} - -- Making maps/ap's from uv-data (or uv-model) in SCN-file: NMAP option MAKE\\ -\hspace*{5mm} - Many types of maps: -XX,YY,XY,YX,I,Q,U,V,cos,sin,ampl,phase,...\\ -- Residual maps: NCLEAN option BEAM, UVCOVER\\ -- Restored maps: NCLEAN option UREST\\ -- Gridded uv-data from SCN-file: NMAP option MAKE REAL, IMAG, AMPL, PHASE\\ -\hspace*{5mm} - In various forms: real or imaginary parts,ampl,phase,...\\ -- Gridded uv-coverage from SCN-file: NMAP option MAKE COVER\\ -- Copy maps: NMAP option FIDDLE COPY\\ -- Extract areas from maps: NMAP option FIDDLE EXTRACT\\ -- Convert from old (R-series) map files: NMAP option FROM\_OLD\\ - -{\bf Delete} WMP files: -Use operating system UNIX: {\tt rm <....>.WMP} (be careful!) - - -%------------------------------------------------------------------------------ -\subsection{Inspecting the contents of a WMP file} -\label{wmp.inspect} - -- Show header information: NMAP option SHOW.\\ -- Display images on color screen (X): NGIDS\\ -- Make plots on X-screen or plotter: NPLOT option MAP -\hspace*{5mm} - Various types: contour, greyscale, polar, ruled surface\\ - -%------------------------------------------------------------------------------ -\subsection{Editing the WMP header information} -\label{wmp.edit} - -- Edit header information: NMAP option SHOW.\\ - -%------------------------------------------------------------------------------ -\subsection{Operations on WMP images} -\label{wmp.oper} - - Although \NEWSTAR has primarily been designed for WSRT {\em uv-data} -processing it offers some powerful image-plane features: - -- Various map operations (very powerful): NMAP option FIDDLE\\ -\hspace*{5mm} - Add, subtract, average, extract, copy, mosaic, etc\\ -- Cleaning and restoring: NCLEAN option BEAM, UREST\\ -- Finding strong sources: NMODEL option FIND\\ - - For many astrophysical projects, this will be sufficient. -However, for moreadvanced operations astrophysical image analysis, the user -should transfer the images from the WMP file to other packages -(e.g. GIPSY, AIPS) by means of the FITS format: NMAP option W16FITS, -W32FITS. - - -%=============================================================================== -\section{Auxiliary \NEWSTAR files} - -%------------------------------------------------------------------------------ -\subsection{.LOG files} -\label{log} - - Each \NEWSTAR program run produces a log-file, with the name {\tt -<progname>.LOG}. It contains the `vital information' about the program run: -keyword values (including the hidden ones) and essential results. In some -cases (e.g. NCALIB REDUN), the user may specify how much information is -printed in the log-file (keyword SHOW\_LEVEL). - - The user may specify (NGEN keyword LOG) what happens with the log-file -upon completion: it may be spooled automatically to the line printer, or thrown -away, or kept for later inspection. In the latter case, the log-file is -automatically renamed with a unique name (e.g. {\tt NCA<alphanumeric>.LOG}) -when the program is run again. - -%------------------------------------------------------------------------------ -\subsection{.PLT files} -\label{plt} - - All plot files produced by the programs NPLOT and NGCALC have the -extension .PLT. The file names usually begin with the 3-4 letter code of the -selected PLOTTER option (PSP, PAL, EMS etc), followed by a unique combination -of alphanumeric characters derived from the date and time of creation. - -%------------------------------------------------------------------------------ -\subsection{.NGI files} -\label{ngi} - - NGI files are used to store the various information that the program -NGCALC extracts from the SCN-file. - diff --git a/src/doc/latex/files_handle.tex b/src/doc/latex/files_handle.tex deleted file mode 100644 index 5854880d93a4969f756626e65e63cfbb866d899b..0000000000000000000000000000000000000000 --- a/src/doc/latex/files_handle.tex +++ /dev/null @@ -1,568 +0,0 @@ -% JPH 940916 Make compilable -% -% @(#) files_descr.tex v1.2 04/08/93 JEN -% -% History -% JPH 940602 minor changes -% JPH 940914 Bug fix -% -\chapter{ \NEWSTAR data-file organisation and the programs' associated user -interfaces} - -{\centering \it Contributed by J.E. Noordam, August 1993} - -\tableofcontents - - -\section{\NEWSTAR data and ancillary file types} - -The \NEWSTAR programs recognize three major types of data files, which are -identified by their extension: -\\ -\\ .SCN files: uv-data and uv-model -\\ .MDL files: SELFCAL source model -\\ .WMP files: maps of various kinds - -\NEWSTAR programs also produce a number of ancillary files, with the following -extensions (the list may no longer be complete): -\\ -\\ .PLT-files: to be plotted -\\ .LOG-files: to be printed -\\ .NGF-files: produced by NGALC -\\ .MNG-files: used to make plots with the MONGO package - - The relations between these files and the \NEWSTAR programs are shown -in \figref{.newstar.overview}. - -\input{../fig/newstar_overview.cap} - - -%======================================================================== - -\section{Directories and nodes (files)} -\label{.nodes} - - For historical reasons, the \NEWSTAR programs refer to data files as -{\bf nodes} in a {\bf database}. In fact, they are just files in a directory. -Users are recommended to use a separate sub-directory for each data reduction -project. - - However, although they refer to the same thing, there is a slight -difference between {\bf node names} used by the user and the actual {\bf file -names}: Node names are a series of alpha-numeric character strings separated by -dots, e.g.: - -\begin{verbatim} - mynode - mynode.21cm.yesterday.s.x.c.d.file.dd -\end{verbatim} - -The maximum length of a node name is 80 characters (which means maximally 39 -dots). This is converted to a {\em file name} by: -\\ -- appending the extension (.SCN, .MDL or .WMP), \\ -- converting all dots (.) to underscores (\_), \\ -- converting all lowercase to uppercase, -- replacing the underscore nearest but less than 47 to a dot. (?) \\ -\\ -This file name is then prefixed with the current database (default nothing). - - Parts of a node name can be set aside for short-hand use. This can be -done by the INFIX keyword (see COMMON keywords), or in a node specification by -enclosing a part in parenthesis (). This enclosed part will from then on be -available to all programs that are run in {\bf the current stream}. Reference -to `the infix' is made by typing a \#, e.g.: - -\begin{verbatim} - mynode.21(cm.yesterday.s.x.c.d.file.d)d -\end{verbatim} - -Typing {\tt mynode.92\#e} will then produce {\tt -mynode.92cm.yesterday.s.x.c.d.file.de} - -The database (directory) name can also be included in the node definition: - -\begin{verbatim} - wnb/data/mynode - ../other/mynode.21cm.yesterday.s.x.c.d.file.dd -\end{verbatim} - - If a database is specified in this way, it will be saved in such a way -that all subsequent program runs {\bf in the same stream} that have no explicit -database specified, will use it, including the currently running program at all -its further node questions. - - - -%=============================================================================== - -\section{The \NEWSTAR data files (SCN, MDL, WMP)} - - These three \NEWSTAR data files are each described in detail in their -own `File Description' chapter in this Handbook. In this Overview section, it -is explained how the basic units (called Sets) in such a file can be selected -individually or in groups. For each of the three data files, an overview is -given of the various ways in which the user may interact with these `objects', -with references to the relevant program options. - - -%------------------------------------------------------------------------------- - -\subsection{Data file logical organisation: Sets} -\label{data.sets} - - The three main \NEWSTAR data file (node) types are logically organised -in the same way: they consist of a number of basic units called `Sets', which -can be selected by the user in two ways: - -\begin{itemize} -\item - By {\bf direct reference} to an absolute set index: {\tt \#ir} selects -set nr {\tt ir}, in which {\tt ir} can be a range of contiguous sets (see -below). Direct reference is only useful if the user knows exactly how the -various Sets are ordered in the file. - -\item - By {\bf indexed reference} to a series of indices that represent -parameters like map or channel nr. A `selector' consists of a series on -integer indices, separated by points. The indices may also be specified as -ranges of indices or wildcards ($\ast$). For instance: {\tt ir1.ir2.*.ir4} -selects all Sets with index values in the indicated ranges. -\end{itemize} - - {\bf Index ranges} ({\tt ir}) can take the following forms {\bf (NB: -Indices start at 0!)}: - -\begin{tabular}{ll} {\bf int} &single index value at this level -\\ {\bf $\ast$} &wildcard: all possible index values at this level -\\ {\bf int-} &all index values at this level, starting at `int' -\\ {\bf int1-int2[:int3]} & - index values `int1' through `int2' by step `int3' (dflt=1) \\ -{\bf int1:int3} &interpreted as int1-$\ast$:int3 \\ {\bf omitted} - &in the middle: interpreted as $.\ast$ - ($.. \equiv .\ast.$) \\ {\bf omitted} -&at the end: interpreted as $.\ast$ - ($..2 \equiv \ast.\ast.2.\ast.\ast.\ast$) \\ -\end{tabular} - - -%------------------------------------------------------------------------ - -\subsection{Using loops} -\label{loops} - - Sometimes a program must be run more than once for the same -SCN-file, but for different Sets. In that case, the {\bf LOOPS} keyword can -used to specify subsequent ranges of Sets. A loop is specified by means of a -pair of values: The first value indicates how often the loop should execute, -the second specifies an increment to be given to the Set specification at each -run. - - For example: {\tt loops=3,..2} indicates that the program has to run -three times, each time incrementing the 3rd Set index by 2. So, if the first -Set (selected with the keyword SETS) was {\tt 0.0-3.2.5.*}, the program will be -run three times, for the Sets - -\begin{verbatim} - 0.0-3.2.5.*. - 0.0-3.4.5.*. - 0.0-3.6.5.*. -\end{verbatim} - -{\bf Nested loops} can be specified by stringing loop definitions (pairs of -values) together. For instance: {\tt loops=3,..2,5,...3} adds an inner loop of -5 program runs in which the 4th Set index is incremented by 3 each time: - -\begin{verbatim} - 0.0-3.2.5.*. 0.0-3.2.8.*. 0.0-3.2.11.*. - 0.0-3.2.14.*. 0.0-3.2.17.*. - 0.0-3.4.5.*. 0.0-3.4.8.*. 0.0-3.4.11.*. - 0.0-3.4.14.*. 0.0-3.4.17.*. - 0.0-3.6.5.*. 0.0-3.6.8.*. 0.0-3.6.11.*. - 0.0-3.6.14.*. 0.0-3.6.17.*. -\end{verbatim} - - -%=============================================================================== -\section{Overview of interactions with the SCN file} -\label{scn} - - The SCN-file contains uv-data, and possibly the uv-representation of a -source model. A single SCN-file may contain uv-data of different (but related) -observations. - - For more information, see the dedicated SCN-file section in this -chapter of the Handbook, and also the section on the program NSCAN. It -contains a description of the structure and the contents of the -SCN-file. - - -%------------------------------------------------------------------------------ - -\subsection{Creating SCN files} -\label{scn.create} - -- From WSRT circle files: NSCAN option LOAD. \\ -- From ATCA (Australia Telescope Compact Array) files: NATNF.\\ -- From old (R-series) SCN-files: NSCAN option FROM\_OLD.\\ -- Simulated uv-data: NSIMUL? (not implemented yet).\\ - -%------------------------------------------------------------------------------ - -\subsection{Inspecting the contents of a SCN file} -\label{scn.inspect} - -- File Layout: NSCAN option SHOW\\ -- File header: NSCAN option SHOW\\ -- Set headers: NSCAN option SHOW\\ -\hspace*{5mm} - Telescope (dipole) angle/ellipt corr: NCALIB option POLAR -SHOW\\ -- Scan headers: NSCAN option SHOW\\ -\hspace*{5mm} - Telescope gain/phase corr: NCALIB option SHOW\\ -- uv-data (corrected, converted): NSCAN option SHOW\\ -- Display of (gridded) uv-data or uv-model: See WMP file below.\\ -- Plot telescope gain/phase corr (REDC+ALGC+OTHC): NPLOT option TELESCOPE\\ -- Plot Redundancy/Selfcal residuals: NPLOT option RESIDUAL\\ -- Plot uv-data or uv-model: NPLOT option DATA or MODEL\\ -- Print average telescope gain/phase corr (R+A+O): NCALIB option SHOW\\ -- Extract various astrophysical info: NGCALC\\ - - -%------------------------------------------------------------------------------ - -\subsection{Editing the header information of a SCN file} -\label{scn.int} - - Almost every value (observation parameters, corrections, etc) in the -SCN-file headers may be edited manually by means of NSCAN option -SHOW EDIT. This means that, even if there is no specific \NEWSTAR routine to -change something, it can always be done by hand. This may be laborious in some -cases, {\em but at least it is possible!}. This feature is particularly useful -in those (rare) cases where erroneous information has somehow been put in the -header during the observations in Westerbork. - -%------------------------------------------------------------------------------ - -\subsection{Applying corrections to uv-data} -\label{scn.apply} - - In general, uv-data in a SCN-file is {\em never physically modified}. -Corrections may be applied (or de-applied) to the uv-data whenever the data is -read into memory to be processed. The user may specify which corrections are -applied (or de-applied) by specifying the value of the general \NEWSTAR -keywords APPLY and DE\_APPLY, which are used by all \NEWSTAR programs that -handle uv-data. Use {\tt dws NGEN} -(see Common features of \NEWSTAR programs). - -%------------------------------------------------------------------------------ - -\subsection{Modyfing the stored corrections} -\label{scn.modify} - -{\bf Zeroeing} selected corrections: NCALIB option SET ZERO - -{\bf Set Header} (corrections that are `constant' in time):\\ -- Any value: NSCAN option SHOW EDIT\\ -- POLC (dipole angle error and ellipticity corr):\\ -\hspace*{5mm} - Estimation: NCALIB option POLAR CALC\\ -\hspace*{5mm} - Manual: NCALIB option POLAR SET, EDIT, ZERO\\ -\hspace*{5mm} - Copying from calibrator: NCALIB option POLAR COPY\\ - -{\bf Scan Header} (corrections that vary per HA):\\ -- Any value: NSCAN option SHOW EDIT\\ -- Telescope (dipole) gain/phase corr:\\ -\hspace*{5mm} - Estimation: NCALIB option REDUN \\ -\hspace*{10mm} - Redundancy (no model): REDC\\ -\hspace*{10mm} - Align: ALGC\\ -\hspace*{10mm} - Selfcal ALGC\\ -\hspace*{5mm} - Manual: NCALIB option SET MANUAL, ZERO, RENORM \\ -\hspace*{5mm} - Copying from calibrator: NCALIB option SET COPY, CCOPY, LINE\\ -- Phase Zero Difference: OTHC\\ -\hspace*{5mm} - Estimation: NCALIB option POLAR VZERO CALC, APPLY, ASK, SCAN \\ -\hspace*{5mm} - Manual: NCALIB option POLAR VZERO MANUAL, ASK\\ -\hspace*{5mm} - Copying from calibrator: NCALIB option POLAR VZERO COPY\\ -- Extinction corr (manual): NCALIB option SET EXTINCT\\ -- Refraction corr (manual): NCALIB option SET REFRACT\\ -- Faraday corr (input of ionosonde data): NCALIB option SET FARADAY\\ - -%------------------------------------------------------------------------------ - -\subsection{Modifying a uv-model in the SCN-file} -\label{scn.uvmodel} - - See Overview of interactions with MDL file below. - - -%------------------------------------------------------------------------------ -\subsection{Reorganisation of SCN files} -\label{scn.reorg} - -- Create new `Job' from Sets in the same SCN-file: NSCAN option REGROUP\\ -- Create a `secondary' SCN-file (data selection, correction): NCOPY\\ - (not implemented yet)\\ -- Delete SCN-file: Use UNIX command {\tt rm <xxx>.SCN} (be careful!)\\ - -%------------------------------------------------------------------------------ - -\subsection{Export of uv-data from SCN files} -\label{scn.export} - -- To UVFITS format (AIPS): NSCAN option UVFITS, PFITS\\ -- To old (R-series) SCN-file format: NSCAN option TO\_OLD\\ -- To WMP file (as gridded uv-data or maps): NMAP option MAKE\\ - - - -%============================================================================== - -\section{Overview of interactions with an MDL file} -\label{mdl.inter} - - A MDL file contains a collection of source model components. -This may consist of a mixture of {\bf multi-parameter components} and ordinary -{\bf CLEAN components}. The MDL file may also contain {\bf reference -coordinates} (obtained from a SCN-file) for the position of the field centre -and the observing frequency. - - For more information, see the dedicated MDL-file section in this -chapter of the Cookbook, and also the section on the program NSCAN. It -contains a description of the structure and the contents of the -MDL-file. - - NOTE: Note that the model in the MDL file may be manipulated by means -of NMODEL {\bf options} (i.e. options of the program NMODEL), or by MDL {\bf -handles}. The latter operations (e.g. READ, WRITE, EDIT, -SHOW) are available in all the programs that deal with source models: -NCALIB, NMAP, NCLEAN, NSCAN, NMODEL. - -%---------------------------------------------------------------------------- - -\subsection{Adding source components to an MDL file} -\label{mdl.generate} - -- Manual, by specifying source parameters: MDL handle ADD.\\ -- Automatic search of a map (in a WMP file): NMODEL action FIND\\ -- CLEANing a map (in a WMP file): NCLEAN option BEAM, UVCOVER, COMPON\\ -- Save model from SCN file in an MDL file: NMODEL option SAVE\\ -- Convert old (R-series) model to \NEWSTAR MDL file format.\\ - -%---------------------------------------------------------------------------- - -\subsection{Modifying a model in an MDL file} -\label{mdl.modify} - -Modifying {\bf source components}:\\ -- Improve source parameters by fitting to the uv-data: - NMODEL option UPDATE, XUPDATE\\ -- Manual editing: MDL handle EDIT, FEDIT\\ -- Delete:\\ -\hspace*{5mm} - All components: MDL handle CLEAR, ZERO\\ -\hspace*{5mm} - Selected components: - MDL handle DELETE, DNCLOW, DCLOW, DAREA\\ -\hspace*{5mm} - Selected components: MDL handle EDIT, FEDIT\\ -- Calibrate (position, flux): MDL handle CALIB\\ -- Combine components at the same position: MDL handle MERGE\\ -- Correct for primary beam attenuation: NMODEL option BEAM, DEBEAM\\ - -Modifying {\bf reference coordinates}:\\ -- Change epoch or coordinate system: NMODEL option CONVERT\\ -NB: Reference position and frequency are obtained from SCN-file.\\ - -%---------------------------------------------------------------------------- - -\subsection{Inspecting, displaying and sorting an MDL model} -\label{mdl.inspect} - -Inspecting:\\ -- Show list of components: MDL handle SHOW (screen) or PRINT (log-file)\\ -- Idem, in RA/DEC coordinates: MDL handle RSHOW, RLIST\\ -- Show source list statistics: MDL handle TOT \\ - -Displaying:\\ -- As gridded uv-model from SCN file: See WMP file below\\ -- As a map of the uv-model in the SCN-file: See WMP file below\\ -- As position markers in a map: NPLOT option MAP\\ -- As `restored' components in a CLEAN residual map: NCLEAN option UREST \\ - -Sorting:\\ -- According to decreasing flux: MDL handle SORT, WRITE(!)\\ -- According to the value of another source parameter: MDL handle FSORT\\ - - -%---------------------------------------------------------------------------- - -subsection{Relation with the uv-model in the .SCN file} -\label{mdl.uvmodel} - - The source components in an MDL file may be Fourier transformed to the -uv-plane, to the uv-coordinates of the uv-data in a SCN-file. -This {\bf uv-model} is then `saved' in the SCN-file, together with a copy of -the MDL source components that produced it. - - Whenever a uv-model is needed (e.g. for Selfcal in NCALIB, or source -subtraction in NMAP) the user is always asked to specify a {\bf input model} -explicitly, even if there is already a {\bf saved uv-model} in the SCN-file. -This input model may be specified either by reading -(and editing) components from an MDL-file, or by editing source components -manually. In the following, the Fourier transform of the input model will be -called the {\bf input uv-model}. The user may choose (keyword MODEL\_ACTION) -one of the following possibilities: - -- {\bf Merge:} Replace the saved uv-model with the input uv-model, - and use it. \\ -- {\bf Add:} Add the input uv-model to the saved uv-model in the SCN-file, - and use it.\\ -- {\bf New:} Replace the saved uv-model in the SCN file by the input uv-model, - and use it.\\ -- {\bf Temporary:} Use the input uv-model, - but do not change the saved uv-model in the SCN-file.\\ -- {\bf Increment:} Use the sum of the saved uv-model and the input uv-model, - but do not change the saved uv-model in the SCN-file. \\ - - NOTE: \NEWSTAR regards the saved uv-model as {\em applied corrections}, -i.e. corrections that were applied (added) to the cosmic noise before the -uv-data were put into the SCN file. Hence, to subtract the saved uv-model from -the data, one could specify `MOD' to the (NGEN) keyword DE\_APPLY! Specifying -`MOD' to the (NGEN) keyword APPLY will restore a model that was subtracted from -the data before it was put in the SCN file (?). - -%---------------------------------------------------------------------------- - -\subsection{The various uses of an MDL model} -\label{mdl.uses} - -{\bf Present uses} of an MDL model:\\ -- To solve for telescope gain/phase errors (Selfcal, Align): - NCALIB option REDUN\\ -- To subtract sources from the uv-data: NMAP option MAKE\\ -- To combine multiple observations:\\ -\hspace*{5mm} - With different frequencies (broad-band mapping)\\ -\hspace*{5mm} - With different pointing centres (mosaicking)\\ -\hspace*{5mm} - With different observing times\\ -- To deal with instrumental polarisation\\ -- To undo large Faraday `rotation measures'\\ -- To detect variability \\ -- To simulate uv-data: clumsy at the moment\\ - - -{\bf Potential uses} of an MDL model:\\ -- To deal with non-isoplanaticity\\ -- To simulate uv-data: NSIMUL (not yet implemented)\\ - - - -%=============================================================================== - -\section{Overview -of interactions with a WMP file} -\label{wmp.inter} - - A WMP file contains a collection of 2-dimensional arrays, that are -related in some way (but that can have different dimensions). These may be -maps for various frequencies (line data) or pointing centres -(mosaicking), antenna patterns and CLEAN residual maps. Even rectangular -arrays of (gridded) uv-data may be put in a WMP file, for display purposes. - - For more information, see the dedicated WMP-file section in this -chapter of the Cookbook, and also the section on the program NSCAN. It -contains a description of the structure and the contents of the -WMP-file. - - -%------------------------------------------------------------------------------ - -\subsection{Creating maps in WMP files} -\label{wmp.create} - -- Making maps/ap's from uv-data (or uv-model) in SCN-file: NMAP option MAKE\\ -\hspace*{5mm} - Many types of maps: -XX,YY,XY,YX,I,Q,U,V,cos,sin,ampl,phase,...\\ -- Residual maps: NCLEAN option BEAM, UVCOVER\\ -- Restored maps: NCLEAN option UREST\\ -- Gridded uv-data from SCN-file: NMAP option MAKE REAL, IMAG, AMPL, PHASE\\ -\hspace*{5mm} - In various forms: real or imaginary parts,ampl,phase,...\\ -- Gridded uv-coverage from SCN-file: NMAP option MAKE COVER\\ -- Copy maps: NMAP option FIDDLE COPY\\ -- Extract areas from maps: NMAP option FIDDLE EXTRACT\\ -- Convert from old (R-series) map files: NMAP option FROM\_OLD\\ - -{\bf Delete} WMP files: -Use operating system UNIX: {\tt rm <....>.WMP} (be careful!) - - -%------------------------------------------------------------------------------ - -\subsection{Inspecting the contents of a WMP file} -\label{wmp.inspect} - -- Show header information: NMAP option SHOW.\\ -- Display images on color screen (X): NGIDS\\ -- Make plots on X-screen or plotter: NPLOT option MAP -\hspace*{5mm} - Various types: contour, greyscale, polar, ruled surface\\ - -%------------------------------------------------------------------------------ - -subsection{Editing the WMP header information} -\label{wmp.edit} - -- Edit header information: NMAP option SHOW.\\ - -%------------------------------------------------------------------------------ - -\subsection{Operations on WMP images} -\label{wmp.oper} - - Although \NEWSTAR has primarily been designed for WSRT {\em uv-data} -processing it offers some powerful image-plane features: - -- Various map operations (very powerful): NMAP option FIDDLE\\ -\hspace*{5mm} - Add, subtract, average, extract, copy, mosaic, etc\\ -- Cleaning and restoring: NCLEAN option BEAM, UREST\\ -- Finding strong sources: NMODEL option FIND\\ - - For many astrophysical projects, this will be sufficient. -However, for moreadvanced operations astrophysical image analysis, the user -should transfer the images from the WMP file to other packages -(e.g. GIPSY, AIPS) by means of the FITS format: NMAP option W16FITS, -W32FITS. - - -%=============================================================================== - -\section{Auxiliary \NEWSTAR files} - -%------------------------------------------------------------------------------ - -\subsection{.LOG files} -\label{log} - - Each \NEWSTAR program run produces a log-file, with the name {\tt -<progname>.LOG}. It contains the `vital information' about the program run: -keyword values (including the hidden ones) and essential results. In some -cases (e.g. NCALIB REDUN), the user may specify how much information is -printed in the log-file (keyword SHOW\_LEVEL). - - The user may specify (NGEN keyword LOG) what happens with the log-file -upon completion: it may be spooled automatically to the line printer, or thrown -away, or kept for later inspection. In the latter case, the log-file is -automatically renamed with a unique name (e.g. {\tt NCA<alphanumeric>.LOG}) -when the program is run again. - -%------------------------------------------------------------------------------ - -\subsection{.PLT files} -\label{plt} - - All plot files produced by the programs NPLOT and NGCALC have the -extension .PLT. The file names usually begin with the 3-4 letter code of the -selected PLOTTER option (PSP, PAL, EMS etc), followed by a unique combination -of alphanumeric characters derived from the date and time of creation. - -%------------------------------------------------------------------------------ - -\subsection{.NGI files} -\label{ngi} - - NGI files are used to store the various information that the program -NGCALC extracts from the SCN-file. - diff --git a/src/doc/latex/hb_contents.tex b/src/doc/latex/hb_contents.tex deleted file mode 100644 index f4007956138735d191b3eb533232613507468ab0..0000000000000000000000000000000000000000 --- a/src/doc/latex/hb_contents.tex +++ /dev/null @@ -1,253 +0,0 @@ -% hb_contents.tex - Documentation contents page -% -% -% NOTES: -% 1. Reference to a diagram should always be made through a text document -% in which it is included. This insures that references in the caption to other -% figures are properly resolved. See the entry for NMODEL below for a example. -% -% 2. For most of the reference commands, a lower-case and a capitalised -% form exists. The latter is to be used for references to up-to-dat documenats, -% the former to obsolete ones. -% -% -% History: -% JPH 9509.. -% JPH 951013 Change references to diagrams -% JPH 960205 Remove duplicate 'bug reporting'; fix link to overview -% diagram -% JPH 960325 Fix reference to record_replay -% JPH 960415 Repair incorrect line mergers/breaks -% JPH 960426 model_descr --> models_descr; ihw.dsc; catewgory codes -% in WSRT tape description; corect ref. to documentation -% diagrams - - - -\newcommand{\bi}{\begin{itemize}} -\newcommand{\ei}{\end{itemize}} -\newcommand{\I}{\item} - - -{\bf NEWSTAR documentation overview} - - {\bf NOTE CAREFULLY: \em - - Most of the documentation is not up-to-date in its details. -Referencesthat {\bf are} are shown in boldface. The others are left in place -because theydo provide useful general information.} - -\tableofcontents - -\section{Introduction} -\bi -\I \Textref{Introduction}{introduction} to Newstar for new and - prospective users -\I \Textref{Source models}{make_model} and their construction. -\I \textref{Models in Newstar}{models_descr} -%\I Recent \textref{modifications}{gen_nnews} modifications -\I \Textref{Overview diagram}{introduction.basic.functions} of programs - and data files -\ei - -\section{Data files} -\bi -\I \Textref{Indexing}{file_indexing} and navigation -\I Visibilities: The \Textref{.SCN file}{scn_file} - \bi - \I Data-structure definitions: - \Srcref{sector}{nscan/sth.dsc} header; - \Srcref{scan}{nscan/sch.dsc} header; - \ei -\I Images: The \textref{.WMP file}{wmp_descr} - \bi - \I Data-structure definitions: - \Srcref{map}{nmap/mph.dsc} header - \ei -\I Source model: The \textref{.MDL file}{mdl_descr} - \bi - \I Data-structure definitions: - \ei -\I Low-level \Textref{inspection/editing}{show_edit} of .SCN and .WMP - files -\I See also: The \Textref{WSRT tape}{.wsrt.tape} format. -\ei - -\section{Source models} -\bi -\I The \textref{.MDL file}{mdl_descr} -\I \textref{Model-making}{make_model} -\I \textref{Models in Newstar}{models_descr} -\I \Ascref{Calibrator models}{calibr_models} {\it in Dutch} -\ei - - -\section{NEWSTAR Programs} -\bi -\I \Textref{Overview}{introduction.programs} of functionality -\I The parameter interface: - \bi - \I \Textref{General}{introduction.user.interface} features common to all - programs - \I \textref{Advanced}{common_descr} common features - \ei -\I NATNF: Descriptions of -% \textref{program}{natnf_descr} and - \Textref{parameters}{natnf_private_intfc}; -% \textref{interface}{natnf_interface} diagram -\I NCALIB: Descriptions of \textref{program}{ncalib_descr} and - \Textref{parameters}{ncalib_private_intfc}; -% \textref{interface}{ncalib_interface} diagram - \bi - \I \textref{Redundancy, Align and Selfcal}{ncalib_redun}; - \textref{Polarisation}{ncalib_polar}; - \textref{Utilities}{ncalib_descr} - \ei -\I NCLEAN: Descriptions of \Textref{program}{nclean_descr} and - \Textref{parameters}{nclean_private_intfc}; - \Textref{interface}{nclean_descr.nclean.interface} diagram -\I NCOPY: Descriptions of \textref{program}{ncopy_descr} and - \Textref{parameters}{ncopy_private_intfc}; -% \textref{interface}{ncopy_descr.ncopy.interface} diagram -%\I NFILT: Descriptions of \textref{program}{nfilt_descr} and -% \Textref{parameters}{nfilt_descr.nfilt.private.intfc}; -% \textref{interface}{nfilt_interface} diagram -\I NFLAG: Descriptions of \textref{program}{nflag_descr} and - \Textref{parameters}{nflag_private_intfc}; -% \textref{interface}{nflag_descr.nflag.interface} diagram -\I NGCALC: Descriptions of \textref{program}{ngcalc_descr} and - \Textref{parameters}{ngcalc_private_intfc}; - \Textref{interface}{ngcalc_descr.ngcalc.interface} diagram - \bi - \I \ascref{Application example}{ngcalc_lightcurve} - \ei -\I NGIDS: Descriptions of \textref{program}{ngids_descr} and - \Textref{parameters}{ngids_private_intfc}; -% \textref{interface}{ngids_descr.ngids.interface} diagram -\I NMAP: Descriptions of \textref{program}{nmap_descr} and - \Textref{parameters}{nmap_private_intfc}; - interface diagrams: - \Textref{map-making}{nmap_descr.nmap.make}, with - \Textref{hidden details}{nmap_descr.nmap.make.q} - \bi - \I Use of \ascref{models in map-making}{models_and_maps}; -% \textref{advanced examples}{ } - \ei -\I NMODEL: Descriptions of -%%\ textref{program}{nmodels_descr} and - \Textref{parameters}{nmodel_private_intfc}; - interface diagrams: - \Textref{general}{nmodel_descr.nmodel.interface}, - \Textref{modelhandling}{nmodel_descr.nmodel.interface}, - \Textref{modelconversions}{nmodel_descr.nmodel.convert} -\I NPLOT: Descriptions of \textref{program}{nplot_descr} and - \Textref{parameters}{nplot_private_intfc}; -% \textref{interface}{nplot_descr.nplot.interface} diagram -\I NSCAN: Descriptions of \textref{program}{nscan_descr} and - \Textref{parameters}{nscan_private_intfc}; -% \textref{interface}{nscan_descr.nscan.interface} diagram -\I Descriptions of{\em public} parameters, shared by more than oneprogram: - \bi - \I .SCN-file access: - \Textref{file}{scnnode_public_intfc}, - \Textref{sector}{scnsets_public_intfc} and - \Textref{hour-angle, interferometer, - polarisation}{select_public_intfc} selection - \bi - \I \Textref{Magtape/disk}{unit_public_intfc} selection - \ei - \I .WMP-file access: \Textref{file}{wmpnode_public_intfc} and - \Textref{image}{wmpsets_public_intfc} selection - \I .MDL-file access: \Textref{file}{mdlnode_public_intfc} selection - \I Model \textref{manipulation}{nmodel_public_intfc}; - \Textref{diagram}{nmodel_descr.nmodel.handle} - \I Mapping parameters: \Textref{NMAP}{nmap_public_intfc} group - \I \Textref{Plot-device}{plotter_public_intfc} selection - \I \Textref{.FLF file}{flfnode_public_intfc} and - \Textref{.NGF sector}{ngfsets_public_intfc} selection - \I Low-level \Textref{inspection/editing}{nshow_public_intfc} of - .SCN and .WMP files - \I Advanced control of \Textref{hidden parameters}{ngen_public_intfc} - \ei -\ei - -\section{Bulk data: Batch processing} -\bi -\I \Textref{Recording/replaying}{record_replay} program runs -\I \ascref{Batch processing}{batch} in NEWSTAR - \bi - \I \ascref{Hints}{more_on_batch} - \ei -\ei - -\section{Processing recipes} -\bi -\I \textref{21cm-continuum}{rcp_continuum_21cm} observation -\I \textref{21cm-mosaic}{rcp_mosaic_21cm} observation -\I \textref{21cm-line}{rcp_line_21cm} observation -\I \textref{Linear-polarisation}{rcp_linear_polarisation} obdervation -\I \Ascref{Lightcurves}{ngcalc_lightcurve} using NGCALC -\ei - -\section{Obsolescent NFRA programs} -\bi -\I \ascref{Desk calculator}{dwcalc}: DWCALC -\I Dwingeloo \textref{plate-measuring}{plate_measure} machine: MEASURE -\ei - -\section{Miscellaneous information} -\bi -\I \Textref{WSRT}{wsrt_fact_sheet} fact sheet -\I \Ascref{Category codes}{spefu_type_categ} in the WSRT - Observation Header (OH) -\ei - -\section{Programmers' documentation} -\bi -\I Style guides: - \bi - \I \Textref{Document-writing}{doc_guide}; - \Ascref{parameter definition}{psc_guide} - \ei -\I Programming techniques: - \bi - \I Dynamic setting of parameter prompts: \Ascref{WNDPOH}{wndpoh} - \I \Ascref{control-C handling}{control_c} - \I \Ascref{dbx debugging on SUN workstations}{debug_efficiently} - \I \Ascref{Obscure bugs}{obscure_bugs} in Newstar programs - \I \Textref{Inspection/editing of /.SCN/.WMP files}{show_edit} - \ei -\I Program/subsystem documentation: - \bi - \I \Textref{NCOPY}{ncopy_progrmr} - \I \Ascref{NCALIB VZERO}{ncalib_vzero} algorithm - \I \Ascref{Table-definition compiler}{wntinc} - \I \Ascref{Hypertext browser}{xmosaic_restart} restart protocol - \I Accessing \Ascref{.SCN data in various sort orders}{qube} - \I \Psref{Least-squares package}{lsq} - \ei -\I System maintenance: - \bi - \I \ascref{Bug reporting}{bug_reports} ({\em in Dutch}) - \I \Textref{Documentation}{doc_guide} organisation; - diagrams: - \Textref{hypertext system}{doc_guide.doc.sources.and.hyper}, - \Textref{printable system}{doc_guide.doc.sources.and.print}, - \I \Psref{DEC Alpha portability}{alpha_portability}; - \Psref{32/64 bit issues}{alpha_32_64} - \I \Ascref{PPD buffer size}{ppd_buffer} adjustment {\em (in Dutch)} - \I NFRA \textref{Configuration management}{nfra_config_management} - \I Newstar \textref{maintenance outside NFRA}{elsewhere_inst_maint} - \ei -\label{.wsrt.tape} -\I The WSRT tape format: - \bi - \I File descriptor (\Srcref{FD}{nscan/fdw.dsc}); - observation header (\Srcref{OH}{nscan/ohw.dsc}); - system calibration block (\Srcref{SC}{nscan/scw.dsc}); - set header (\Srcref{SH}{nscan/shw.dsc}); - interferometer header (\Srcref{IH}{nscan/ihw.dsc}). - \I \Ascref{Category codes}{spefu_type_categ} in the - Observation Header (OH) - \ei -\ei diff --git a/src/doc/latex/hb_cook_preamble.sty b/src/doc/latex/hb_cook_preamble.sty deleted file mode 100644 index a0c5fb1e5eb6bdaf53614668f23abe34c0aa202c..0000000000000000000000000000000000000000 --- a/src/doc/latex/hb_cook_preamble.sty +++ /dev/null @@ -1,71 +0,0 @@ -% -% @(#) hb_cook_preamble.tex -% Macros for the hypertext version of Newstar documents. Simplified -% versions of the print macros are used because latex2html does neither -% know nor need most of the more advanced commands. - -% Note that expansions starting in ~ must start immediately after the opening { - -% History: -% JPH 940615 Separate cook and print versions of hb_preamble -% JPH 941104 Fix \svbegin/end malfunction (see note below) -% JPH 950213 Define \centering -% JPH 950825 All cross-ref macros here i.s.o. through code in -% doc_cook -% JPH 951016 Argt on \whichrefs -% -% Standard LaTeX macros -% - \newcommand{\centering}{} -% -% scripting macros -% - \newcommand{\scmd}[1]{~\\\hspace{2mm} $>$\ {\sf #1}} - \newcommand{\skeyword}[1]{\\$\bigotimes$\ {\bf #1}} - \newcommand{\sprompt}[1]{~{\footnotesize #1}} - \newcommand{\sdefault}[1]{~{\small #1}} - \newcommand{\suser}[1]{~\hspace{1mm}\fbox{\large \sf #1}} - \newcommand{\sline}[1]{ - \\\hspace*{3mm}{\tt #1}} - \newcommand{\slong}[1]{ - \\\hspace*{-10mm}{\tt #1}} - \newcommand{\sskip}{} - \newcommand{\sinline}[1]{ - \normalsize \hspace*{\fill}\-\hspace*{\fill}\mbox{\it #1} } - \newcommand{\scomment}[1]{\\{\it #1} } - \newcommand{\setc}{ - ~\\\hspace*{7mm}$\vdots$ } - \newcommand{\scr}{~{\small \sf $<$CR$>$}} - \newcommand{\seof}{~{\small \sf $<$EOF$>$} } - \newcommand{\spbegin}{ } - \newcommand{\spend}{ } - \newcommand{\svbegin}{ } - \newcommand{\svend}{ } -% -% referencing macros -% - \newcommand{\eqref}[1]{\htmladdnormallink{equation}{ \##1}} - \newcommand{\Eqref}[1]{\htmladdnormallink{Equation}{ \##1}} - \newcommand{\figref}[1]{\htmladdnormallink{figure}{ \##1}} - \newcommand{\Figref}[1]{\htmladdnormallink{Figure}{ \##1}} - \newcommand{\ascref}[2]{\htmladdnormallink{#1}{#2}} - \newcommand{\Ascref}[2]{\htmladdnormallink{{\bf #1}}{#2}} - \newcommand{\textref}[2]{\htmladdnormallink{#1}{#2}} - \newcommand{\Textref}[2]{\htmladdnormallink{{\bf #1}}{#2}} - \newcommand{\psref}[2]{\htmladdnormallink{#1}{#2}} - \newcommand{\Psref}[2]{\htmladdnormallink{{\bf #1}}{#2}} - \newcommand{\srcref}[2]{\htmladdnormallink{#1}{#2}} - \newcommand{\Srcref}[2]{\htmladdnormallink{{\bf #1}}{#2}} - \newcommand{\whichref}[2]{#1} -% -% macros that did not work with latex2html and were therefore implemented in -% docScript.csh -% -% \newcommand{\textref}[3]{ -% \htmladdnormallink{#1}{../#2/#2.html\##3} } -% \newcommand{\eqref}... -% -% \svbegin \svend are intended to define a smaller type font so that verbatim -% text will fit the standard window width, but latex2html ignores such commands -% as \small. Therefore, doc_cook translates the verbatim environment into a -% rawhtml environment with <PRE>. diff --git a/src/doc/latex/hb_print_preamble.sty b/src/doc/latex/hb_print_preamble.sty deleted file mode 100644 index b39dae55924e70be5b47bdf88ff6270366a09fc6..0000000000000000000000000000000000000000 --- a/src/doc/latex/hb_print_preamble.sty +++ /dev/null @@ -1,111 +0,0 @@ -% -% @(#) hb_print_preamble.tex v2.0 13/07/93 CMV -% -% History: -% JPH 9405.. Revision -% JPH 940707 Transferred to master system as part of new doc system -% JPH 940712 Improve \sinline to optimise paper utilisation -% JPH 940915 Add obsolescent script commands -% JPH 950823 Add interdocument referencing commands, using l2h method -% JPH 951016 arguments on \whichref -% JPH 951114 Change \seof definition to avoid LaTeX quirk -% JPH 951124 \maketitle -% -% -% This preamble is used to tailor the standard document-style book -% to our specific needs. It should be included in every tex-file -% that could produce a separate printed version. -% -% NOTE: The \fig command is not defined here but in docPrint.csh, because it depends on the environment variable $n_hlp -% -% Define document layout -% - \setlength{\parskip}{\medskipamount} - \setlength{\parindent}{10mm} - \setlength{\itemsep}{-0.5\parsep} - \setlength{\textheight}{250mm} - \setlength{\topmargin}{-35mm} - \setlength{\textwidth}{160mm} - \setlength{\oddsidemargin}{0mm} - \setlength{\evensidemargin}{0mm} - \setlength{\unitlength}{1mm} -% - \pagestyle{plain} % only a page number at the foot -% \pagestyle{headings} % alternative: section name at the top - \newcommand{\chapter}[1]{ {\noindent \Large\bf #1} } - \renewcommand{\maketitle}{} -% -% Referencing -% - \newcommand{\ascref}[2]{\htmladdnormallink{{#1}}{#2}} - \newcommand{\Ascref}[2]{\htmladdnormallink{{#1}}{#2}} - \newcommand{\textref}[2]{\htmladdnormallink{{#1}}{#2}} - \newcommand{\Textref}[2]{\htmladdnormallink{{#1}}{#2}} - \newcommand{\Psref}[2]{\htmladdnormallink{{#1}}{#2}} - \newcommand{\srcref}[2]{\htmladdnormallink{{#1}}{#2}} - \newcommand{\Srcref}[2]{\htmladdnormallink{{#1}}{#2}} -% - \newcommand{\Figref}[1]{ Figure \ref{#1} } - \newcommand{\figref}[1]{ figure \ref{#1} } - \newcommand{\Eqref}[1]{ Equation \ref{#1} } - \newcommand{\eqref}[1]{ equation \ref{#1} } - \newcommand{\whichref}[2]{#1} -% -% Scripting commands -% -%% components of a Newstar prompt. Note that the absence of whitespace in the definitions is deliberate. -% - \newcommand{\skeyword}[1]{ - \par \noindent $\bigotimes\ ${\bf #1}} - \newcommand{\sprompt}[1]{{\footnotesize #1}} - \newcommand{\sdefault}[1]{{\small #1}} - \newcommand{\suser}[1]{\fbox{\sf #1}} -% -%% symbols for non-printing replies -% - \newcommand{\scr}{$^{}$} - \newcommand{\seof}{\fbox{\sf ~$<$EOF$>$}} -% -%% shell prompt -% - \newcommand{\scmd}[1]{ - ~\\\hspace{2mm} $>~${\sf #1} - \nopagebreak - } -% -%% -% - \newcommand{\sline}[1]{ - ~\\\hspace*{1pc}{\tt #1} } - \newcommand{\slong}[1]{ - ~\\\hspace*{-10mm}{\tt #1} } -% -%% comments are right-justified. We use an incantation adapted from The TeXbook, Exercise 14.30, to put the short ones in-line and the long ones in a separate line or paragraph. -% - \newcommand{\sinline}[1]{ - {\unskip\nobreak\hfil\penalty50\hskip.2em\hbox{}\nobreak\hfil - \normalsize \it #1 - \parfillskip=0pt \finalhyphendemerits=0 \par}} -% -%% the separate non-inline comment style should no longer be used -% -% -%% verbatim environment for machine output -% - \newcommand{\svbegin}{ - \vspace*{-\bigskipamount} \small } - \newcommand{\svend} { - \vspace*{-\medskipamount}\vspace*{-\smallskipamount} } -% -%% samepage "environment" to keep prompt and response together -% - \newcommand{\spbegin}{ - \begingroup \par \protect\samepage} - \newcommand{\spend}{ - \endgroup \medbreak \par \vspace*{-.5\parskip} } -% -%% obsolescent -% -\newcommand{\sskip}{} -\newcommand{\scomment}[1]{\it #1} -\newcommand{\setc}{~\\\hspace*{7mm}$\vdots$ } diff --git a/src/doc/latex/hb_symbols.sty b/src/doc/latex/hb_symbols.sty deleted file mode 100644 index c7e00596f5f9582e422edabef1b8547df7233653..0000000000000000000000000000000000000000 --- a/src/doc/latex/hb_symbols.sty +++ /dev/null @@ -1,53 +0,0 @@ -% -% @(#) cbSymbols.tex v1.1 13/07/93 JEN -% -% Symbol definitions for the redundancy cookbook -% This file is included in all NEWSTAR Cookbook sections to ensure a -% uniform naming convention. -% -% This file is also translated into a NEWSTAR "glossary" called -% FORMSYMBOLS.TEX by means of the program SYMBOLSLATEX.FOR. -% -% This file should be included right after cb_preamble.tex -% - -%\gloshead{General:} - -\def\cbdir{\$n_src/doc/cook} % cookbook directory -\def\NEWSTAR{{\sf NEWSTAR~}} % name of software package -\def\Nseries{\NEWSTAR} % name of package (was N-series) - -%\gloshead{Visibility components:} - -\def\cVis{{\cal V}} % (complex) visibility -\def\pvis{{\Phi}} % visibility phase -\def\avis{{|{\cVis}|}} % visibility amplitude -\def\lavis{{\varrho}} % visibility ln(ampl) - -\def\cGain{{G}} % (complex) Gain (multiplicative) -\def\cNoise{{N}} % (complex) random noise (additive) -\def\cCadd{{C}} % (complex) offset (additive) - -%\gloshead{The four types of dipole errors and related quantities:} - -\def\perr{{p}} % dipole phase error -\def\gerr{{g}} % dipole gain error -\def\lerr{{q}} % dipole ln(gain) error -\def\dang{{\phi}} % dipole position angle -\def\derr{{\Delta}} % dipole position angle error -\def\eerr{{\Theta}} % dipole ellipticity - -%\gloshead{Miscellaneous:} - -\def\Apol{{\epsilon}} % Polarisation A-factor -\def\Bpol{{\eta}} % Polarisation B-factor - -\def\wgt{{\cal W}} % Weight factor -\def\pwgt{{\wgt^p}} % Weight for phase equation -\def\lwgt{{\wgt^g}} % Weight for ln(gain) equation - -\def\pzd{{\psi}} % XY phase zero difference (PZD) - -\def\farang{{\chi}} % Faraday rotation angle - -%*********************************** end of CBSYMBOLS.TEX *************** diff --git a/src/doc/latex/html.sty b/src/doc/latex/html.sty deleted file mode 100644 index 32ca7e44466f67f861ec510ea685475caecf868c..0000000000000000000000000000000000000000 --- a/src/doc/latex/html.sty +++ /dev/null @@ -1,161 +0,0 @@ -% LaTeX2HTML Version 0.5.3: html.sty -% -% This file contains definitions of LaTeX commands which are -% processed in a special way by the translator. -% For example, there are commands for embedding external hypertext links, -% for cross-references between documents or for including -% raw HTML. -% This file includes the comments.sty file v2.0 by Victor Eijkhout -% In most cases these commands do nothing when processed by LaTeX. - -%%% LINKS TO EXTERNAL DOCUMENTS -% -% This can be used to provide links to arbitrary documents. -% The first argument should be the text that is going to be -% highlighted and the second argument a URL. -% The hyperlink will appear as a hyperlink in the HTML -% document and as a footnote in the dvi or ps files. -% -\newcommand{\htmladdnormallink}[2]{ #1\footnote{#2}} - -% This is an alternative definition of the command above which -% will ignore the URL in the dvi or ps files. -%\newcommand{\htmladdnormallink}[2]{ #1 } - -% This command takes as argument a URL pointing to an image. -% The image will be embedded in the HTML document but will -% be ignored in the dvi and ps files. -% -\newcommand{\htmladdimg}[1]{ } - -%%% CROSS-REFERENCES BETWEEN (LOCAL OR REMOTE) DOCUMENTS -% -% This can be used to refer to symbolic labels in other Latex -% documents that have already been processed by the translator. -% The arguments should be: -% #1 : the URL to the directory containing the external document -% #2 : the path to the labels.pl file of the external document. -% If the external document lives on a remote machine then labels.pl -% must be copied on the local machine. -% -%e.g. \externallabels{http://cbl.leeds.ac.uk/nikos/WWW/doc/tex2html/latex2html} -% {/usr/cblelca/nikos/tmp/labels.pl} -% The arguments are ignored in the dvi and ps files. -% -\newcommand{\externallabels}[2]{ } - -% This complements the \externallabels command above. The argument -% should be a label defined in another latex document and will be -% ignored in the dvi and ps files. -% -\newcommand{\externalref}[1]{ } - - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -% Comment.sty version 2.0, 19 June 1992 -% selectively in/exclude pieces of text: the user can define new -% comment versions, and each is controlled separately. -% This style can be used with plain TeX or LaTeX, and probably -% most other packages too. -% -% Examples of use in LaTeX and TeX follow \endinput -% -% Author -% Victor Eijkhout -% Department of Computer Science -% University Tennessee at Knoxville -% 104 Ayres Hall -% Knoxville, TN 37996 -% USA -% -% eijkhout@cs.utk.edu -% -% Usage: all text included in between -% \comment ... \endcomment -% or \begin{comment} ... \end{comment} -% is discarded. The closing command should appear on a line -% of its own. No starting spaces, nothing after it. -% This environment should work with arbitrary amounts -% of comment. -% -% Other 'comment' environments are defined by -% and are selected/deselected with -% \includecomment{versiona} -% \excludecoment{versionb} -% -% These environments are used as -% \versiona ... \endversiona -% or \begin{versiona} ... \end{versiona} -% with the closing command again on a line of its own. -% -% Basic approach: -% to comment something out, scoop up every line in verbatim mode -% as macro argument, then throw it away. -% For inclusions, both the opening and closing comands -% are defined as noop - -\def\makeinnocent#1{\catcode`#1=12 } -\def\csarg#1#2{\expandafter#1\csname#2\endcsname} - -\def\ThrowAwayComment#1{\begingroup - \def\CurrentComment{#1}% - \let\do\makeinnocent \dospecials - \makeinnocent\^^L% and whatever other special cases - \endlinechar`\^^M \catcode`\^^M=12 \xComment} -{\catcode`\^^M=12 \endlinechar=-1 % - \gdef\xComment#1^^M{\def\test{#1} - \csarg\ifx{PlainEnd\CurrentComment Test}\test - \let\next\endgroup - \else \csarg\ifx{LaLaEnd\CurrentComment Test}\test - \edef\next{\endgroup\noexpand\end{\CurrentComment}} - \else \let\next\xComment - \fi \fi \next} -} - -\def\includecomment - #1{\expandafter\def\csname#1\endcsname{}% - \expandafter\def\csname end#1\endcsname{}} -\def\excludecomment - #1{\expandafter\def\csname#1\endcsname{\ThrowAwayComment{#1}}% - {\escapechar=-1\relax - \csarg\xdef{PlainEnd#1Test}{\string\\end#1}% - \csarg\xdef{LaLaEnd#1Test}{\string\\end\string\{#1\string\}}% - }} - -\excludecomment{comment} -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - -%%% RAW HTML -% -% Enclose raw HTML between a \begin{rawhtml} and \end{rawhtml}. -% The html environment ignores its body -% -\excludecomment{rawhtml} - -%%% HTML ONLY -% -% Enclose LaTeX constructs which will only appear in the -% HTML output and will be ignored by LaTeX with -% \begin{htmlonly} and \end{htmlonly} -% -\excludecomment{htmlonly} - -%%% LaTeX ONLY -% Enclose LaTeX constructs which will only appear in the -% DVI output and will be ignored by latex2html with -%\begin{latexonly} and \end{latexonly} -% -\newenvironment{latexonly}{}{} - -%%% Hyperref -% Suggested by Eric M. Carol <eric@ca.utoronto.utcc.enfm> -% Similar to \ref but accepts conditional text. -% The first argument is HTML text which will become ``hyperized'' -% (underlined). -% The second and third arguments are text which will appear only in the paper -% version (DVI file), enclosing the fourth argument which is a reference to a label. -% -%e.g. \hyperref{using the tracer}{using the tracer (see Section}{)}{trace} -% where there is a corresponding \label{trace} -% -\newcommand{\hyperref}[4]{#2\ref{#4}#3} diff --git a/src/doc/latex/introduction.tex b/src/doc/latex/introduction.tex deleted file mode 100644 index 1a61762bee782842de8747c2329f9c0e89383523..0000000000000000000000000000000000000000 --- a/src/doc/latex/introduction.tex +++ /dev/null @@ -1,634 +0,0 @@ -% introduction.tex -% -% JPH 941124 -% JPH 941221 Expand processing paradigm: First order calibration from -% calibrator, later refinement through Selfcal. Add UPDATE. -% -\newcommand{\bi}{ \begin{itemize} } -\newcommand{\ei}{ \end{itemize} } -\newcommand{\bn}{ \begin{enumerate} } -\newcommand{\en}{ \end{enumerate} } -\newcommand{\eg}{e.g.} - -\chapter{ Introduction to \NEWSTAR for new and prospective users } {\em -Contributed by Johan Hamaker, november 1994 \centering \par} - -\tableofcontents - - -\section{ Preface } -\label{.preface} - - \NEWSTAR is an acronym for the '{\bf N}etherlands {\bf E}ast-{\bf W}est -{\bf S}ynthesis {\bf T}elescope {\bf A}nalysis and {\bf R}eduction'. It stands -for a small collection of programs whose purpose is to process 'raw' visibility -data from the WSRT into sky maps, source lists and the like that are ready for -astronomical interpretation. - - Its functionality allows one to fully exploit the strong points of -East-West systhesis arrays in general and the WSRT in particular: Wide-field -mapping, and high dynamic range both in 'total-power' and polarisation -observations. To achieve this, \NEWSTAR contains a number of powerful and -refined algorithms not known to exist in other systems. Their presence makes -\NEWSTAR quite overwhelming for the uninitiated. This document is intended to -provide a simple introduction of a tutorial type. - - The documentation generally refers to the WSRT as the source of -observations. \NEWSTAR also includes provisions for the processing of data from -the Australian Telecope (ATNF) compact array (ATCA), but these are few and -simple and we skip them here. - - -\subsection{ Portability } -\label{.portability} - - \NEWSTAR's primary maintenance is carried out by NFRA on Sun and HP -systems. It is actively supported elsewhere for a DECstation and a DEC Alpha; -it has been supported in the past for a Convex and is therefore likely to be -readily portable to there. VAX support has been discontinued. - - For general operations, such as moving or deleting files, manipulating -text files, {\em etc.} you must rely on your host system. Inasmuch as \NEWSTAR -now only runs in Unix environments, a generic knowledge of that environment -should be sufficient, but also necessary. - - -\subsection{ Terminology} -\label{.terminology} - - A perceptive user may well notice that \NEWSTAR programs are rather -careless in their use of terminology. This is a heritage that we are to some -extent stuck with: Automatic 'batch' procedures in several on-going large WSRT -projects ({\em WENSS} and {\em WHISP}) rely on the present structure and -parameter names of the user interface. We try to clarify ambiguities in the -documentation and on-line Help, but the user must be wary that names do not -always mean what they seem to suggest. - - -\section{ NEWSTAR's basic processing paradigm } -\label{.basic} - -\input {basic_functions.cap} - -\subsection{ Source and instrumental-error modeling } -\label{.source.error.modeling} - - The most common aim of processing visibility data is to obtain a -representation of the sources observed, with artefacts from the observing -process adequately removed. Such artefacts arise both from the finite sampling -of the data (primary and synthesised antenna beams) and from instrumental -errors. - - If errors were absent, the problem would be 'simply' to deconvolve the -known antenna pattern (synthesised beam) from the observed data. This is an -ambiguous process: There is an infinite number of possible solutions. -Acceptable ones are favoured by the {\em a priori} knowledge incorporated in -radio-astronomy algorithms; in addition, human judgment is needed to control -the reduction process. - - Instrumental errors complicate the problem. To first order they may be -determined from {\em calibrator} sources observed before and/or after the -source. This typically yields a {\em dynamic range} in the order of one in a -few hundred. - - Much higher dynamic ranges can only be obtained through {\em -self-calibration}. This is a generic name for processes in which a source model -and a model of the instrumental errors are constructed simultaneously. -Self-calibration relies on the fact that the signature of true sources in an -observation is quite different from that imposed by instrumental errors. -Algorithms have been invented that discriminate between the two quite well. The -separation is not perfect, however, and even more than for source modeling -alone, human judgment must keep the process on course. - - -\subsection{ Outline of the reduction process in \NEWSTAR } -\label{.outline} - - \Figref{.basic.functions} shows the fundamental functions and the -primary data files with their most important contents. The connecting arrows -show the data flow in the basic reduction process. We enumerate the steps here -in order for a typical reduction process. In practice, the complexity of the -observed field and/or the quality of the observation may give rise to a wide -variety of situations; the same steps or only part of them may have to be -combined in a different sequence. If you need really high dynamic range, take -your time to become an expert... - - The basic reduction steps shown combined in \figref{.basic.functions} -are: -\bn -%1 -\item Visibilities are read in from a data archive by NSCAN; calibrator -observation(s) are included. -%2 -\item The calibrator data are processed in NCALIB to find the instrumental -errors. A source model is used as a reference; such models are available in -\NEWSTAR for all calibrators routinely used by the WSRT. The errors found are -stored as {\em corrections} in the calibrator observation. -%3 -\item NCALIB is invoked to copy the corrections from the calibrator to the -astronomical observation. This provides the 'first-order' error correction -referred to \textref{above}{.source.error.modeling}. -%4 -\item A map is made from the astronomical observation, using the corrections. -At this point, reduction may be complete. If the quality of the map is -inadequate, one must continue. -%5 -\item NMODEL FIND and NCLEAN are used to construct a {\em source model} for -the astronomical field; such a model is a list of components, each of which can -be arbitrarily positioned and have a finite extent. ({\em I.e.}, they are much -more general than conventional CLEAN components.) -%6 -\item The positions and other parameters defining the source components may -be improved through an NMODEL UPDATE. This procedure is unique to \NEWSTAR. It -refines the parameters estimated by NMODEL FIND for each source component by -comparing its computed visibilities against the observed ones. -%7 -\item A 'self-calibration' {\em selfcal} can now be done with NCALIB in the -same way as was done for the calibrator in step 2 above. This will refine the -correction parameters stored in the .SCN file. -%8 -\item NFLAG may be used to flag as 'bad' those scans for which the Selfcal -operation produced a poor result (either an error message or an excessive mean -error in the solution). -%9 -\item Form this point on, steps 3-8 can be repeated {\em ad libitum}. -\en - - With a general picture of the reduction process in mind, we can take a -look first at the data files and then at the programs involved. - - -\section{ The \NEWSTAR data files } - - We first discuss the three types of data files shown in -\figref{.basic.functions}. After that, we consider the common {\em indexing} -system that is common to most of these files. - -\subsection{ The scan (.SCN) file } -\label{.scn.file} - -\input{ scn_summary.tef} - - -\subsubsection{ Error categories and the Selfcal paradigm } -\label{.selfcal} - -\input {error_model.cap} - - Errors, - and consequently corrections for them -, can be broken down -in four categories, as shown schematically in \figref{.error.model}: - -\bi -\item {\em Global:} Errors represented by a single parameter for the -instrument as a whole: \eg a clock error or refraction. - -\item {\em Telescope(-based):} Errors that occur {\em per telescope} and -therefore affect all interferometers including that telescope in the same way: -\eg tropospheric cloud effects and telescope position errors. - -\item {\em IF-based:} Errors that occur {\em per dipole/polarisation channel} - and therefore affect all interferometers including that IF channel in the same -way: \eg elctronic gain and phase errors. - -\item {\em Interferometer(-based):} Errors that occur in the correlator and -can therefore not be attributed to a telescope/polarisation channel: \eg -correlator zero offsets. In a well-designed correlator these errors can be very -small and for the WSRT one can almost always ignore them. -\ei - - In the somewhat inaccurate terminology of \NEWSTAR no dictinction is -made between telescope- and IF-based errors; the two are jointly known as {\em -telescope errors} as opposed to {\em interferometer errors}. The distinction -between the two types of error is fundamental to the {\em Selfcal} methods -which are used to separate instrumental errors from the true source -visibilities. A basic understanding of the Selfcal paradigm is assumed -throughout \NEWSTAR. - - In addition to the Selfcal constraint, WSRT data are subject to the -{\em Redundancy} constraint: Baselines of the same length (and the same -orientation as they always have for the WSRT) must produce the same -visibilities. - - -\subsection{ The map (.WMP) file } -\label{.wmp.file} - - .WMP files are the containers for two-dimensional {\em images}: sky -maps and antenna patterns. Each immage is an array of data points with -horizontal and vertical positions {\em l, m} as coordinates. It represents a -projection of the celestial sphere on a plane tangent in the field centre; the -direction of the projection is {\em parallel to the polar axis}. - - The organisation of the images in a .WMP file will be discussed -\textref{shortly}{.indices}. - - -\subsection{ The source-model (.MDL) file } -\label{.mdl.file} - - Unlike the .SCN and .WMP files that may contain a collection of sectors -or images, the .MDL file harbours only a single {\em source model}. The concept -of such a model is familiar from {\em CLEAN} as a list of point sources with a -position and flux for each. - - The \NEWSTAR source mode is more refined: It may also contain for each -source an (elliptical-Gaussian) extent, its 4 Stokes parameters, its spectral -index and its intrinsic rotation measure. Traditional CLEAN components are a -degenerate case of this more general concept. - - -\subsection{ Organisation of collections of data structures: Indices} -\label{.indices} -\label{.SCNSUM.indices} - - We have seen that \NEWSTAR data files are collections of data units: -Let us first consider the .SCN file, where these units are the -\textref{sectors}{.scn.file}. Each such unit is self-describing, but we need -additional information to understand its relation to other units, viz. what are -its channel number and field number (for a mosaic observation). Moreover it is -possible to store more than one observation in a scan file and we need a way of -knowing which is which. - - The organisation in \NEWSTAR data files is by means {\em hierarchical -indexing}: Each unit is addressed through a {\em composite index}, consisting -of a string of integers {\em 'indices'} separated by dots, e.g. - -\verb/ 3.1.0.5/ - - For the .SCN file the indices are: - -\verb/ <group>.<observation>.<field>.<channel>.<sequence\ nr/ -where - -\bi -\item \verb/<group/ is a purely administrative index that allows one, \eg to -collect observations that are intrinsically unrelated in a single file, -\eg a scientific observation with the calibrator observations to be used with -it. - -\item \verb/<observation>/ is related to {\em labels} and {\em observations} -in which WSRT data tapes are structured. - -\item \verb/<field>/ is a subfield number in a mosaic observation. - -\item \verb/<channel>/ is a frequency-channel number (also known as band -number). - -\item \verb/<sequence number>/ is an extra index that allows for the -existence of multiple data structures having all preceding indices the same, -\ei - - For the .WMP file the indices are: - -\verb/ <group>.<field>.<channel>.<polarisation>.<image type>.<sequence nr>/ -% -where \verb/<group>/, \verb/<field>/ and \verb/<channel>/ are the same as for -the .SCN file; in addition we have - -\bi -\item \verb/<polarisation>/ represents either a WSRT dipole combination or a -Stokes parameter. - -\item \verb/<image type>/ indicates either a map or an antenna pattern. -\ei - A number of mechanisms exist in the user interface that allow you to -select set(s) of data units, \eg 'all sectors', 'all channels for fields 3 -through 7', etc. - - In closing, we note that the indexing structure is purely -administrative. The data units are entirely self-contained in terms of their -data contents and associated headers. A sector, for example, can be copied from -one .SCN file to another without any loss of the information necessary for its -interpretation. - - -\section{ The \NEWSTAR programs} -\label{.programs} - - \Figref{.basic.functions} includes only the most basic functions of the -most important programs. Each of the programs includes a considerable number of -other {\em functions}: \NEWSTAR is a small collection of large multifunctional -programs rather than a large collection of small programs (like AIPS or GIPSY). - - We will briefly mention the most interesting functions in each of the -programs, but ignore the {\em utility functions} which are part of most -programs. These will, \eg: - -\bi -\item list the contents of files; - -\item show headers and data blocks in detail and optionally edit them; - -\item convert files between number formats for different host systems; - -\item track version changes; - -\item write and/or read FITS tapes/files. - -\ei - - -\subsection{ NSCAN} -\label{.nscan} - - NSCAN is the program that handles .SCN files. Apart from utilities, its -only operation is: - -\bi -\item LOADing data from an external medium (classical magtape, DAT or Exabyte -tape, optical disk) into a .SCN file. -\ei - -It is capable to read WSRT data in all existing formats including the old -'Leiden format'. - - -\subsection{ NCALIB} -\label{.ncalib} - - NCALIB is the program that determines corrections from the visibilities -in a .SCN file, optionally using a \textref{source model}{.mdl.file} as a -reference. Its primary functions include: - -\bi -\label{.redun} -\item REDUN: This is the Selfcal function of NEWSTAR. It includes several -methods of estimating telescope errors from observed visibilities and -(optionally) a source model, using the \textref{Selfcal and -Redundancy}{.selfcal} constraints. - -\item POLAR: Determining deviations from the nominal dipole responses to -polarised radiation from calibrator observations. - -\item SET: Function for reading corection parameters from external sources, -such as - - \bi - \item estimates of Faraday rotations calculated from ionosonde or -chirp-sounder data; - - \item clock corrections from the International Earth Rotation Service (IERS, -formerly the Bureau Internationale de l'Heure). - \ei -\ei - - -\subsection{ NMAP} -\label{.nmap} - - NMAP is the program that handles .WMP files. Its primary functions -include: - -\bi -\item MAKE: Its first and foremost function, {\em viz.} to Fourier-transform -visibilities into sky maps with their assosiated antenna patterns. - -\item FIDDLE: A family of functions to modify maps or combine them into new -ones in several useful ways, \eg: - - \bi - \item BEAM, DEBEAM: Apply/de-apply the primary-beam correction. - - \item POL, ANGLE: Convert a pair of Stokes Q and U maps into a pair -representing the polarisation direction and magnitude. - - \item MOSCOM: Merge adjacent overlapping maps (\eg mosaic subfields or -adjacent full mosaics) into a single large map. - -\ei\ei - - -\subsection{ NFLAG} -\label{.nflag} - - NFLAG is the {\em only} program that changes flag settings. Its FLAG -function is composed of a large number of subfunctions that set different flags -on the basis of criteria that may be - -\bi -\item {\em deterministic,} i.e. comparing data's coordinate parameters -against fixed limits (\eg elevation, shadowing, short baselines); - -\item {\em data-derived,} i.e. comparing data values against a fixed limit -(\eg an upper limit for data considered to be free of interference); - -\item derived from {\em data statistics}, such as comparing the noise in a -\textref{selfcal}{.redun} solution against a fixed limit. -\ei - - NFLAG is still evolving. It is hoped that both NFRA and the \NEWSTAR -users will contribute new ideas and algorithms, to further the art of -eliminating faulty data with a minimum of efforts as well as minimal accidental -loss of healthy data. - - -\subsection{ NMODEL} -\label{.nmodel} - - NMODEL is the program that handles source-model (.MDL) files. Its most -vital function is FIND, {\em i.e.} finding source components of small extent -and fitting elliptical Gaussians to them. This operation differs from CLEAN in -two ways: - -\bi -\item Components are merely located; to subtract them, one must make a new -map as in the major cycles of Cotton-Schwab CLEAN. - -\item Sources may be at fractional grid positions and extended, which allows -for a much more accurate representation of sources of small size. -\ei - - NMODEL also harbours the \textref{UPDATE function}{.outline}, which -fine-tunes the components of a model by comparing the model visibilities with -the observed ones. - - -\subsection{ NCLEAN} -\label{.nclean} - - NCLEAN is \NEWSTAR's CLEAN program. It's purpose is to create source -models for thos source components that cannot be adequately represented by -elliptical Gaussian's. It implements only the H\"ogbom, Clark and Cotton-Schwab -CLEAN algorithms. - - -\subsection{ Other programs} -\label{.other.programs} - - \Figref{.basic.functions} shows only the most vital programs. There are -several others: - -\bi -\item NATNF loads data from the Australian Telescope (ATNF) into a .SCN file. - -\item NCOPY copies selected parts of a .SCN file into another .SCN file. (In -this process one may change visibility values irreversibly through the -application of selected corrections.) - -\item NPLOT can display or print a variety of plots as well as images in -various representations. - -\item NGIDS is an adaptation of {\em GIPSY}'s display program GIDS. It -primary function is to display images in various modes, but it can also be used -to select faulty data in a display of visibilities (the {\em TVFLAG} function -of AIPS). - -\item NGCALC is a program to analyse one-dimensional {\em cuts}, either -through the visibility \whichref{hypercube}{} or through the associated -hypercube of correction values. It can be used, \eg, to analyse the 'light -curve' of a variable source or to fit a polynomial to a cut of visibilities -against baseline. -\ei - - -\section{ Salient features of the user interface } -\label{.user.interface} - - -\subsection{ Controlling program runs } - - \NEWSTAR programs communicate with the user through a uniform parameter -interface. (Historically this subsystem is referred to as {\em DWARF}, but this -name now serves only to cause confusion.) We briefly mention the features one -normally uses in an interactive session. - -\bi -\item A program is started from the shell through the commands - \bi - \item[] dwe \verb/<program name>/ or dwexe \verb/<program name>/ - \ei - -\item Except for those parameters that are intrinsically of an interactive -nature, a program collects all necessary parameter values before any real -processing and/or writing to data files is done. - -\item Programs can be aborted at any time through control-C. This is safe -{\em except when modification of data files is in progress.} Where the latter -is the case, one would risk corrupting those files. - -\item Parameters to be specified by the user are known by their name (also -known as the {\em keyword}. - -\item When a program needs a parameter value, it will prompt on the terminal -showing the keyword, a short text explaining what is being asked for, a list of -options where applicable, and the default value if one is available. - -\item The user's reply is immediately checked to the extent possible: For -numeric values a range of validity may have been defined, options must match -the list of valid names (unique abbreviations being allowed in most cases. - -\item When you reply with an EOF character (control-D in Unix) or a hash sign -(\#), the program will backtrack over one or several prompts, allowing you to -recover from mistakes without having to abort and restart the program. -\ei - - -\subsection{ On-line Help } -\label{.help} - - On-line help in a running program is available in two modes: -\bi -\item The {\em dumb-terminal mode}: When you type a '?' in reply to a prompt, -the help text for the parameter will be shown on your terminal (window). - -\item You switch to {\em hypertext mode} by typing '??' in reply to a prompt; -this mode then remains in effect until the program terminates. Help texts are -displayed in the xmosaic window; the advantage is that you now have access to -associated documentation through hypertext links. -\ei - - - -\subsection{ Log files } -\label{.log.files} - - Each program run produces a .LOG file in your current directory. These -files are named - - \verb/<prog><timestamp>A.LOG/, - -where \verb/<prog>/ is the first three characters of the program name and -\verb/<timestamp>/ is a string of 12 digits (yymmddhhmmss). The newest log for -a program is also known under the name - - \verb/<program>.LOG/ -\\ -The log file contains a record of all the parameter values that were used in -the program run, a copy of all messages and other output that appeared on the -terminal and in some cases a lot more information. - - In many cases the best way to digest a log file is not to print it. -Instead, take a quick look at it on your terminal to decide what information is -most relevant; then use the Unix utility {\em grep} to extract it. - - -\section{ Disk-space management } - - \NEWSTAR is rather lavish in its use of disk space, - partly because -its functionality demands it, partly also because disk space is so cheap that -programming for space economy is not cost-effective. - - As an example, a .SCN file for a 12-hour observation with 87 -interferometers, 8 frequency channels, 4 polarisations and a sampling interval -of 1 minute occupies 24 Mbytes; including a source model in all sectors almost -doubles this space. Yet this type of observation is relatively modest in its -demands; a mosaic observation easily runs into the hundreds of Mb. - - It is therefore important to avail yourself of sufficient disk space, -and you may also have to familiarise yourself with the methods for saving files -on DAT tape on your host machine. - - \NEWSTAR programs have been designed to crash gracefully when running -out of disk space. That is, a data file they were writing to will be left in an -incomplete but probably readable state. Yet it bis better not to rely on this, -as recovering from a crash may still be a time-consuming affair. - - - -\section{ Interfacing with other astronomical reduction packages } -\label{.interfacing} - - The possibilities to exchange data between \NEWSTAR and 'the rest of -the world' are limited to the following: - -\bi -\item The sectors from a .SCN file can be exported in the UVFITS format that -AIPS can read. The inverse operation is {\em not} provided for. - -\item Images can be written and read in 16- and 32-bit integer as well as -32-bit floating-point FITS formats. Other packages are likely to interface to -at least one of these. - -\item Visibility data from ATNF/Miriad can be read. - -\item Interfaces between \NEWSTAR and AIPS++ will probably be developed as a -by-product of NFRA's active involvement in the latter project. The eventual -conversion policy will be determined on the basis of the user's needs. -\ei - - -\section{ Acknowledgements } - - \NEWSTAR's history dates back to the pioneering work on Redundancy by -J.E. Noordam in the early 1980s. W.N. Brouw systematised and expanded his work -in subsequent years, in a suite of programs known as the 'R-series'. In -1990-1991, this series served as the prototype for an entirely new collection -of programs that eventually became \NEWSTAR. During this entire development, -A.G.de Bruyn played an indispensable role as an active and stimulating user. - - Several users contributed to the documentation; they are acknowledged -in the individual Document chapters. - - Incorporated in \NEWSTAR are: - -\bi -\item The Dwingeloo-Westerbork Astronomical Reduction Facility ({\em DWARF}) -user-parameter interface from NFRA. - -\item The Groningen Image Display Syetem ({\em GIDS}) display package from -Groningen's GIPSY system. - -\item The {\em PGPLOT} public-domain screen-graphics package. -\ei - - diff --git a/src/doc/latex/lsq.tex b/src/doc/latex/lsq.tex deleted file mode 100644 index 6b323cad5ec010dbe46457c0a4f51d69d0e79b65..0000000000000000000000000000000000000000 --- a/src/doc/latex/lsq.tex +++ /dev/null @@ -1,1293 +0,0 @@ -% file lsq.tex : Least Squares in Newstar - -% History: -% WNB 95.... -% JPH 951127 Changes to make compatible with n_doc - -%%\documentclass[10pt,a4paper]{article} -% []:titlepage,leqno,fleqn,11pt,12pt,twoside,twocolumn,landscape -% {}:report,letter - -% LATEX_PREAMBLE_A4.TEX: Latex template -%%\setlength{\topmargin}{-15mm} -%\setlength{\textheight}{250mm} -%\setlength{\textwidth}{140mm} -%\setlength{\oddsidemargin}{0mm} -%\setlength{\evensidemargin}{0mm} -\setlength{\unitlength}{1mm} -\setlength{\parindent}{0mm} -\setlength{\parskip}{\medskipamount} -%\setlength{\parsep}{\smallskipamount} - -\pagestyle{plain} % only a page number at the foot -%{}:plain,empty,headings,myheadings -%\markboth{lefthead}{righthead} -%\markright{righthead} - -%\makeglossary -%\makeindex - -% End of preamble. - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%\begin{document} %%%%% start of actual document %%%%%%%% -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - -\newcommand{\LSQ}{{\em LSQ}} -\newcommand{\SVD}{{\em SVD}} -\newcommand{\Cond}{{\em condition}} -\newcommand{\Weight}{{\em weight}} -\newcommand{\Known}{{\em measured}} -\newcommand{\Sol}{{\em solution}} -\newcommand{\Type}{{\em type}} -\newcommand{\Error}{{\em error}} -\newcommand{\Covar}{{\em covariance}} -\newcommand{\Xsd}{{\em uncertainties}} -\newcommand{\Mean}{{\em sd}} -\newcommand{\Fit}{{\em goodness}} -\newcommand{\Rank}{{\em rank}} -\newcommand{\Prec}{{\em collinearity}} -\newcommand{\Nconst}{{\em n-constraint}} -\newcommand{\Constraint}{{\em constraints}} -\newcommand{\Real}{{\sc real}} -\newcommand{\Int}{{\sc integer}} -\newcommand{\Complex}{{\sc complex}} -\newcommand{\Logic}{{\sc logical}} -\newcommand{\Mn}{{\vspace{-0.5em}}} - \renewcommand{\mathbf}[1]{\mbox{$\boldmath #1$}} - -\chapter{Least Squares in Newstar} -\\ -{\it Contributed by W.N. Brouw, 15 April, 1995 --- Version 3} -\tableofcontents - - -\section{Introduction} -\label{s-Intro} - -Tryimg to find a more stable non-linear least squares method (\LSQ) than the -one currently used in Newstar, I found another few areas that could be added -or improved in the existing routines. In the end I made the following -changes: -\begin{itemize} -\item improved error estimates for solved variables \Mn -\item included support for user defined constraints \Mn -\item support for more stable non-linear solutions \Mn -\item changed the user interface to routines (they are now called WNML\ldots\ -rather than WNMI\ldots\ , WNMY\ldots\ , WNMX\ldots\ or WNMZ\ldots) \Mn -\end{itemize} -In addition the present document describes the usage and background of the -different routines. - -Least squares solutions in Newstar have the following general -background: -\begin{enumerate} -\item all are based on creating normal equations from an, initially unknown, -number of condition equations \Mn -\item the actual \LSQ-object is a symmetric (or Hermitian) matrix \Mn -\item matrix inversions are done using in-place Cholesky methods where -possible: it is for -standard use the fastest, least memory consuming and a stable method. In cases -where the inverse matrix is needed, the method uses resources of the same -order as full LU-decomposition. \Mn -\item input/output to the \LSQ-object is done in single precision, internally -all calculations are done in double precision \Mn -\item all routines using the \LSQ\ package should include the -{{\sc lsq}\_{\sc o}\_{\sc def}} file \Mn -\item complex numbers are assumed to be contiguous pairs of real numbers with -the real part being the first \Mn -\end{enumerate} - -The following terminology is used throughout: -\begin{list}{1}{\setlength{\labelwidth}{6em}} -\item[$n$] number of unknowns to be solved \Mn -\item[$m$] number of simultaneous knowns \Mn -\item[$N$] number of condition equations \Mn -\item[$\chi^2$] merit function \Mn -\item[$z^*$] complex conjugate of $z$ \Mn -\item[$z_{\Re}$] real part of $z$ \Mn -\item[$z_{\Im}$] imaginary part of $z$ \Mn -\item[$\mathbf{x}$] column vector of unknowns $x_{0},\ldots,x_{n-1}$ \Mn -\item[$\mathbf{a}_{i}$] vector of factors $a_{0,i},\ldots,a_{n-1,i}$ in -condition equation $i$ \\( $i=0,\ldots,N-1$ ) \Mn -\item[$\mathbf{C}$] the $N\times n$ array of condition equations \Mn -\item[$\mathbf{A}$] $n\times n$ array: normal equations matrix \Mn -\item[$\mathbf{L}$] $n$ column vector: right-hand side normal equations \Mn -\item[$y_{i}$] model value for condition equation $i$ ( -$i=0,\ldots,N-1$ ) \Mn -\item[$l_{i}$] measured value for condition equation $i$ ( -$i=0,\ldots,N-1$ ) \Mn -\item[$\sigma_{i}$] standard deviation for condition equation $i$ ( -$i=0,\ldots,N-1$ ) \Mn -\item[$w_{i}$] weight for condition equation $i$ ($w_{i}=1/\sigma_{i}^2$) \Mn -\item[${[}ab{]}$] shorthand for $\sum_{i=0}^{N-1} w_{i} a_{i} b_{i}$ \Mn -\end{list} - -The condition equations can, with the above definitions, be written in one of -the following ways: - -\begin{equation} - \mathbf{a}_{i}\cdot\mathbf{x} = l_{i} \hspace{2cm} i=0,\ldots,N-1 -\end{equation} - -or as: - -\begin{eqnarray} - \sum_{k=0}^{n-1} a_{ik}x_{k} = l_{i} \hspace{2cm} i=0,\ldots,N-1 -\end{eqnarray} - -or as: - -\begin{equation} - \mathbf{C\cdot x} = \mathbf{l} -\end{equation} - -The normal matrix is defined as: - -\begin{equation} - \mathbf{A} = \mathbf{C}^{T}\cdot\mathbf{Q}^{-1}\cdot\mathbf{C} -\end{equation} -resulting in the normal equations: -\begin{equation} - \mathbf{A}\cdot\mathbf{x} = \mathbf{L} -\end{equation} -where $\mathbf{L}=\mathbf{C^{T}}\cdot\mathbf{l}$ and -$\mathbf{Q}$ is the covariance matrix of the observations. In Newstar only -covariance matrices with the same value in each column $i$ (the `weight' -$w_{i}$) are considered. - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -\section{Linear equations} -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -\subsection{Real} -The merit function we want to minimise is: - -\begin{eqnarray} - \chi^{2} = \sum_{i=0}^{N-1} - {\left[ \frac{l_{i}-y_{i}}{\sigma_{i}} \right]}^{2} -\label{.e.chir} -\end{eqnarray} - -For the minimum of $\chi^{2}$ holds: - -\begin{equation} - \frac{\partial \chi^{2}}{\partial a_{k}} = 0 - \hspace{2cm} k=0,\ldots,n-1 -\end{equation} - -which leads to the following set of normal equations: - -\begin{equation} - \sum_{i=0}^{N-1} \frac{\left[ l_{i} - y_{i}\right]}{\sigma_{i}^{2}} - \frac{\partial y_{i}}{\partial a_{k}} = 0 - \hspace{2cm} k=0,\ldots,n-1 -\end{equation} - -or in matrix form: - -\begin{equation} - \left( \begin{array}{cccc} - \left[ a_{0}a_{0}\right] & \left[ a_{0}a_{1}\right] & - \cdots & \left[ a_{0}a_{n-1}\right] \\ - \left[ a_{1}a_{0}\right] & \left[ a_{1}a_{1}\right] & - \cdots & \left[ a_{1}a_{n-1}\right] \\ - \vdots & \vdots & \ddots & \vdots \\ - \left[ a_{n-1}a_{0}\right] & \left[ a_{n-1}a_{1}\right] & - \cdots & \left[ a_{n-1}a_{n-1}\right] - \end{array} \right) - \cdot \mathbf{x} = - \left( \begin{array} {c} - \left[ a_{0}l\right] \\ - \left[ a_{1}l\right] \\ - \vdots \\ - \left[ a_{n-1}l\right] - \end{array} \right) - \label{.e.solr} -\end{equation} - -or: - -\begin{equation} - \mathbf{A}\cdot\mathbf{x} = \mathbf{L} -\end{equation} -This symmetric set of equations can be solved, if the matrix is positive -definite, i.e. if there are no dependencies between the columns. The solution -is given by: - -\begin{equation} - \mathbf{x} = \mathbf{A}^{-1}\cdot\mathbf{L} -\end{equation} - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -\subsubsection{Errors} -\label{.ss.errors} - -After solution for the unknowns $\mathbf{x}$, $\chi^{2}$ as defined in -\eqref{.e.chir} can be directly calculated if we rewrite it as: -\begin{equation} - \chi^{2} = [ll] - 2\sum_{k=0}^{n-1}[a_{k}l]x_{k} + - \sum_{i=0}^{N-1} w_{i}y_{i}^{2} -\label{.e.chis2} -\end{equation} -Noting that $y_{i}=\sum_{k=0}^{n-1}a_{k}x_{k}$ and using equation -\eqref{.e.solr} to note -that $[a_{i}l]=\sum_{k=0}^{n-1} [a_{i}a_{k}]x_{k}$, we can rewrite -\eqref{.e.chis2} as: -\begin{equation} - \chi^{2} = [ll] - \sum_{k=0}^{n-1} x_{k}[a_{k}l] -\label{.e.chis3} -\end{equation} -The $\chi^{2}$ could be used to assess the goodness of fit if the actual -$\sigma_{i}$'s were known, and the errors are normal distributed. In general the -actual values of $\sigma_{i}$ are not known, and often the distribution is not -normal (.e.g. if we solve for logarithmic values). An estimate of the standard -deviation can be made by: -\begin{equation} - \sigma^{2}= - \frac{\left[ \left( l_{i}-y_{i}\right)^{2}\right]}{N-n} -\end{equation} -which can be estimated by: -\begin{equation} - \sigma_{o}^{2}=\frac{\chi^{2}}{N-n} -\end{equation} -to give `an error per observation'. The `error per unit weight', or the -standard deviation, can be expressed as: -\begin{equation} - \sigma_{w}^{2}=\frac{\chi^{2}}{[1]}\frac{N}{N-n} -\end{equation} - -The uncertainty in the solution $x_{i}$ can be expressed as: -\begin{equation} - \sigma^{2}\left(x_{i}\right) = - \sum_{k=1}^{N-1}\sigma_{k}^{2} - {\left(\frac{\partial{x_{i}}}{\partial{y_{k}}}\right)}^{2} -\end{equation} -Since -\begin{equation} - x_{i}=\sum_{k=0}^{n-1}{\left(\mathbf{A}^{-1}\right)}_{ik} - \left[a_{k}l\right] -\end{equation} -we have: -\begin{equation} - {\frac{\partial{x_{i}}}{\partial{y_{k}}}}= - \sum_{j=0}^{n-1}{\left(\mathbf{A}^{-1}\right)}_{ij} - \frac{a_{kj}}{\sigma_{k}^{2}} -\end{equation} -leading to: -\begin{equation} - \sigma^{2}\left(x_{i}\right) = - \sum_{k=0}^{n-1}\sum_{l=0}^{n-1} - {\left(\mathbf{A}^{-1}\right)}_{ik} - {\left(\mathbf{A}^{-1}\right)}_{il} - \left[\sum_{j=0}^{N-1} - \frac{a_{kj}a_{lj}}{\sigma_{j}^{2}}\right] -\end{equation} -Doing the sums, this equation reduces to: -\begin{equation} - \sigma^{2}\left(x_{i}\right) = - {\left(\mathbf{A}^{-1}\right)}_{ii} -\end{equation} -If the $\sigma_{i}$ was not known originally, the estimate of the standard -uncertainties in the unknowns $\mathbf{x}$ are: -\begin{equation} - \sigma\left(x_{i}\right) = \sigma_{o} - \sqrt{{\left(\mathbf{A}^{-1}\right)}_{ii}} -\label{.e.sigx} -\end{equation} - -If the uncertainties in the unknowns are wanted, Newstar calculates the -inverse matrix $\mathbf{A}^{-1}$ by backsubstitution of the identity matrix, -and the uncertainties by \eqref{.e.sigx}. - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -\subsubsection{Newstar calls} -\label{.ss.ncalls} - -Real \LSQ\ in Newstar is implemented by the following calls: -\begin{enumerate} -\item generate an \LSQ-object with:\\ - \Logic\ WNMLGA(\LSQ, \Type, $n$\ [, $m$]) with: -\begin{list}{1}{\setlength{\labelwidth}{16em}} - \item[\LSQ] \Int, return pointer to created \LSQ-object -(if {\em .true.}) \Mn - \item[\Type] coded \Int; coded as: 0 or -{{\sc lsq}\_{\sc t}\_{\sc real}}\ [+\ {{\sc lsq}\_{\sc t}\_{\sc multiple}}]. -The second part indicates that multiple ($m > 1$) simultaneous equations are -requested. \Mn - \item[$n$] \Int, number of unknowns \Mn - \item[$m$] \Int, number of simultaneous equations if -{{\sc lsq}\_{\sc t}\_{\sc multiple}} specified (default one) \Mn -\end{list} -\item generate normal equations from the condition equations with successive -calls to:\\ - CALL WNMLMN(\LSQ, \Type, \Cond, \Weight, \Known) with: -\begin{list}{1}{\setlength{\labelwidth}{16em}} - \item[\LSQ] \LSQ-object pointer \Mn - \item[\Type] $0$ or {{\sc lsq}\_{\sc c}\_{\sc real}} to indicate -that the condition equations are real \Mn - \item[\Cond] factors in condition equation as \Real($0:n-1$) \Mn - \item[\Weight] \Real, weight of condition equation ($w=1/\sigma^2$). -Note that for the best arithmetic performance, the $w_{i}$ are best -normalised to a maximum value of one. \Mn - \item[\Known] measured value(s) as \Real($0:m-1$) \Mn -\end{list} -\item triangularise the normal equations matrix $\mathbf{A}$ with:\\ - \Logic\ WNMLTN(\LSQ) with: -\begin{list}{1}{\setlength{\labelwidth}{16em}} - \item[\LSQ] \LSQ-object pointer \Mn -\end{list} -The value of WNMLTN is {\em .false.} if the matrix $\mathbf{A}$ is not -invertable. Note that if an unknown does not appear in any condition equation -with a non-zero coefficient (i.e. if the corresponding $A_{ii} -\equiv 0$) WNMLTN assumes a zero solution for the corresponding unknown. The -check on dependency between equations is done with a default precision of -$10^{-6}$. This precision can be \textref{changed}{.ss.specc}). -\item obtain the solution by back substitution with:\\ - CALL WNMLSN(\LSQ,\Sol,\Error,\Mean) with: -\begin{list}{1}{\setlength{\labelwidth}{16em}} - \item[\LSQ] \LSQ-object pointer \Mn - \item[\Sol] solution $\mathbf{x}$ as \Real($0:n-1,0:m-1$) \Mn - \item[\Error] adjustment error per unit weight ($\sigma_{w}$)as -\Real($0:m-1$) \Mn - \item[\Mean] standard deviation ($\sigma_{o}$) as \Real($0:m-1$) \Mn -\end{list} -\item obtain the covariance matrix or something similar with:\\ - CALL WNMLME(\LSQ,\Xsd) or:\\ - CALL WNMLCV(\LSQ,\Covar) or:\\ - CALL WNMLIN(\LSQ) with: -\begin{list}{1}{\setlength{\labelwidth}{16em}} - \item[\LSQ] \LSQ-object pointer \Mn - \item[\Xsd] the uncertainties in the unknowns $\mathbf{x}$ as -\Real($0:n-1,0:m-1$) \Mn - \item[\Covar] the covariance (inverse) matrix of the solution, as -\Real($0:n-1,0:n-1$) \Mn -\end{list} - WNMLIN will calculate the covariance matrix internally only. In all -three cases the covariance matrix will overwrite the normal array, and it -will be used, rather than back substitution, in WNMLSN if that routine is -called after one of the inversion ones. -\item free \LSQ-object with: \\ - CALL WNMLFA(\LSQ) -\end{enumerate} - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -\subsubsection{Additional Newstar calls} -\label{.ss.specc} - -A number of other calls are available to aid, especially, re-use of the -\LSQ-object: - -\begin{description} - \item[--] re-initialise the \LSQ-object for re-use with: \\ -CALL WNMLIA(\LSQ, \Type\ [, \Prec]) with: -\begin{list}{1}{\setlength{\labelwidth}{16em}} - \item[\LSQ] \LSQ-object pointer \Mn - \item[\Type] coded \Int, coded as a combination of: -\begin{description} - \item[--] 0: default, equal to {{\sc lsq}\_{\sc i}\_{\sc all}} \Mn - \item[--] {{\sc lsq}\_{\sc i}\_{\sc norm}}: re-initialise the -`unknown' part of the object (i.e. the normal array $\mathbf{A}$) \Mn - \item[--] {{\sc lsq}\_{\sc i}\_{\sc known}}: re-initialise the -`known' part of the object (i.e. the vector ${\mathbf L}$) \Mn - \item[--] {{\sc lsq}\_{\sc i}\_{\sc sol}}: equal to -{\sc norm}\ +\ {\sc known} \Mn - \item[--] {{\sc lsq}\_{\sc i}\_{\sc nonlin}}: re-initialise the -non-linear part of the object \Mn - \item[--] {{\sc lsq}\_{\sc i}\_{\sc all}}: equal to -{\sc sol}\ +\ {\sc nonlin} \Mn - \item[--] {{\sc lsq}\_{\sc i}\_{\sc prec}}: set the internal check -precision to \Prec \Mn -\end{description} - \item[\Prec] precision factor to be used (\Real). Only used if -{{\sc lsq}\_{\sc i}\_{\sc prec}} set. Note that the default internal value is -$10^{-6}$. \Mn -\end{list} - \item[--] re-create (parts of) the normal equations with successive -calls to:\\ - CALL WNMLMN(\LSQ, \Type, \Cond, \Weight, \Known) with: -\begin{list}{1}{\setlength{\labelwidth}{16em}} - \item[\LSQ] \LSQ-object pointer \Mn - \item[\Type] the standard {{\sc lsq}\_{\sc c}\_{\sc real}} etc can be -used, with in addition one of the following: -\begin{description} - \item[--] {{\sc lsq}\_{\sc c}\_{\sc nonorm}}: do not update the -normal array ($\mathbf{A}$) \Mn - \item[--] {{\sc lsq}\_{\sc c}\_{\sc noknown}}: do not update the -`known' part of the normal equations ($\mathbf{L}$) \Mn -\end{description} - \item[\Cond] factors in condition equation as \Real($0:n-1$) \Mn - \item[\Weight] \Real, weight of condition equation ($w=1/\sigma^2$) -Note that for the best arithmetic performance, the $w_{i}$ are best -normalised to a maximum value of one. \Mn - \item[\Known] measured value(s) as \Real($0:m-1$) \Mn -\end{list} -\end{description} - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -\subsection{Complex} - -The merit function we want to minimise in this case is: - -\begin{equation} - \chi^{2} = \sum_{i=0}^{N-1} - {\left[ \frac{l_{i}-y_{i}}{\sigma_{i}} \right]} - {\left[ \frac{l_{i}-y_{i}}{\sigma_{i}} \right]}^{*} - \label{.e.chic} -\end{equation} - -Differentiating $\chi^{2}$ leads to the following set of normal equations: - -\begin{equation} - \left( \begin{array}{cccc} - \left[ a_{0}^{*}a_{0}\right] & \left[ a_{0}^{*}a_{1}\right] & - \cdots & \left[ a_{0}^{*}a_{n-1}\right] \\ - \left[ a_{1}^{*}a_{0}\right] & \left[ a_{1}^{*}a_{1}\right] & - \cdots & \left[ a_{1}^{*}a_{n-1}\right] \\ - \vdots & \vdots & \ddots & \vdots \\ - \left[ a_{n-1}^{*}a_{0}\right] & \left[ a_{n-1}^{*}a_{1}\right] & - \cdots & \left[ a_{n-1}^{*}a_{n-1}\right] - \end{array} \right) - \cdot \mathbf{x} = - \left( \begin{array} {c} - \left[ a_{0}^{*}l\right] \\ - \left[ a_{1}^{*}l\right] \\ - \vdots \\ - \left[ a_{n-1}^{*}l\right] - \end{array} \right) - \label{.e.solc} -\end{equation} - -The normal matrix is Hermitian. It can be solved by Choleski methods. -However, internally the matrix is converted to a real form. Although this has -an, in general, small memory penalty, it has no influence on CPU time, and -makes it possible to use the same routines for complex and real solutions. -The conversion to real is done by splitting each element $A_{ij}$ of the -normal matrix into ${A_{\Re}}_{ij}+\imath{A_{\Im}}_{ij}$ and replacing it by: - -\begin{equation} - A_{ij}=\left( \begin{array}{rr} - {A_{ij}}_{\Re} & -{A_{ij}}_{\Im} \\ - {A_{ij}}_{\Im} & {A_{ij}}_{\Re} - \end{array} \right) -\label{.e.comnor} -\end{equation} - -and simular replacements for the vector elements $x_{i}$ and $L_{i}$ as: - -\begin{equation} - x_{i}=\left( \begin{array} {r} - {x_{i}}_{\Re} \\ - {x_{i}}_{\Im} - \end{array} \right) -\end{equation} -and: -\begin{equation} - L_{i}=\left( \begin{array} {r} - {L_{i}}_{\Re} \\ - {L_{i}}_{\Im} - \end{array} \right) -\end{equation} - - -Another reason for solving real rather than complex equations is given in the -next section. - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -\subsubsection{Separable complex} -\label{.ss.sepc} - -In cases where both the unknowns $\mathbf{x}$ and their complex conjugates -$\mathbf{x}^{*}$ appear in the condition equations, differentiating the merit -function \eqref{.e.chic} will not produce a symmetric or Hermitian -normal matrix, since there exists no linear relation between $x_{i}$ and -$x^{*}_{i}$. We could, of course, solve for $2n$ complex equations with added -constraints that the sum of even and odd unknowns must be real, and their -difference imaginary, but this will lead to $4n$ complex equations. - -If, however, we consider each complex unknown as two real unknowns (i.e. -${x_{i}}_{\Re}$ and ${x_{i}}_{\Im}$) then differentiating \eqref{.e.chic} -produces the -following symmetric set of $2n$ real equations: - -\begin{displaymath} - \left( \begin{array}{ccccc} - {\left[ {a_{0}}^{*}a_{0}\right]}_{\Re} & - {\left[ {a_{1}}^{*}a_{0}\right]}_{\Im} & - {\left[ {a_{2}}^{*}a_{0}\right]}_{\Re} & - \cdots & - {\left[ {a_{2n-1}}^{*}a_{0}\right]}_{\Im} \\ - -{\left[ {a_{0}}^{*}a_{1}\right]}_{\Im} & - {\left[ {a_{1}}^{*}a_{1}\right]}_{\Re} & - -{\left[ {a_{2}}^{*}a_{1}\right]}_{\Im} & - \cdots & - {\left[ {a_{2n-1}}^{*}a_{1}\right]}_{\Re} \\ - \vdots & \vdots & \vdots & \ddots & \vdots \\ - -{\left[ {a_{0}}^{*}a_{2n-1}\right]}_{\Im} & - {\left[ {a_{1}}^{*}a_{2n-1}\right]}_{\Re} & - -{\left[ {a_{2}}^{*}a_{2n-1}\right]}_{\Im} & - \cdots & - {\left[ {a_{2n-1}}^{*}a_{2n-1}\right]}_{\Re} - \end{array} \right) \cdot -\end{displaymath} -\begin{equation} - \hspace{4cm} \cdot \left( \begin{array} {c} - {x_{0}}_{\Re} \\ - {x_{0}}_{\Im} \\ - {x_{1}}_{\Re} \\ - \vdots \\ - {x_{n-1}}_{\Im} \\ - \end{array} \right) = - \left( \begin{array} {c} - {\left[ {a_{0}}^{*}l\right]}_{\Re} \\ - {\left[ {a_{1}}^{*}l\right]}_{\Im} \\ - {\left[ {a_{2}}^{*}l\right]}_{\Re} \\ - \vdots \\ - {\left[ {a_{2n-1}}^{*}l\right]}_{\Im} - \end{array} \right) - \label{.e.solsc} -\end{equation} - -A number of special cases can be distinguished. - -In the `normal' complex case (previous section), $a_{2i}\equiv a_{2i+1}$, and -\eqref{.e.solsc} reduces to \eqref{.e.comnor}. - -If all $a_{2i}$ and $a_{2i+1}$ are real, but specified, e.g., as a complex -number, \eqref{.e.solsc} deteriorates into: - -\begin{displaymath} - \left( \begin{array}{ccccc} - \left[ {a_{0}}_{\Re}{a_{0}}_{\Re}\right] & 0 & - \left[ {a_{0}}_{\Re}{a_{1}}_{\Re}\right] & \cdots & 0 \\ - 0 & \left[ {a_{0}}_{\Im}{a_{0}}_{\Im} \right] & 0 & - \cdots & \left[ {a_{0}}_{\Im}{a_{n-1}}_{\Im}\right] \\ - \left[ {a_{1}}_{\Re}{a_{0}}_{\Re}\right] & 0 & - \left[ {a_{1}}_{\Re}{a_{1}}_{\Re}\right] & \cdots & 0 \\ - \vdots & \vdots & \vdots & \ddots & \vdots \\ - 0 & \left[ {a_{n-1}}_{\Im}{a_{0}}_{\Im}\right] & 0 & - \cdots & \left[ {a_{n-1}}_{\Im}{a_{n-1}}_{\Im} \right] - \end{array} \right) \cdot -\end{displaymath} -\begin{equation} - \hspace{4cm} \cdot \left( \begin{array} {c} - {x_{0}}_{\Re} \\ - {x_{0}}_{\Im} \\ - {x_{1}}_{\Re} \\ - \vdots \\ - {x_{n-1}}_{\Im} \\ - \end{array} \right) = - \left( \begin{array} {c} - \left[ {a_{0}}_{\Re}l_{\Re}\right] \\ - \left[ {a_{0}}_{\Im}l_{\Im}\right] \\ - \left[ {a_{1}}_{\Re}l_{\Re}\right] \\ - \vdots \\ - \left[ {a_{n-1}}_{\Im}l_{\Im}\right] - \end{array} \right) - \label{.e.solscr} -\end{equation} - -Note that in this case there is a true separation of the real and imaginary -parts of the different unknowns, and two separate real solutions with each -$n$ unknowns will produce exactly the same result. - -The full and special cases are all catered for in the Newstar routines. - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -\subsubsection{Errors} - -Using arguments comparable to \textref{those in}{.ss.errors}, we can get -\eqref{.e.chis3} for the complex case as: -\begin{equation} - \chi^{2} = [ll^{*}] - -\sum_{k=0}^{n-1} \left( {x_{k}}_{\Re}{\left[ a_{2k}^{*}l \right]}_{\Re} + -{x_{k}}_{\Im}{\left[ a_{2k+1}^{*}l \right]}_{\Im} \right) -\label{.e.chis4} -\end{equation} -with the $a$'s and $x$'s as defined in \eqref{.e.solscr}. - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -\subsubsection{Newstar calls} -\label{.ss.ccalls} - -Complex \LSQ\ in Newstar is implemented as a real \LSQ\ with $2n$ -unknowns. All calls are identical to those with -\textref{those in}{.ss.ncalls}, but with different \Type\ and some \Complex\ -rather than -\Real\ arguments: -\begin{enumerate} -\item generate an \LSQ-object with:\\ - \Logic\ WNMLGA(\LSQ, \Type, $n$\ [, $m$]) with: -\begin{list}{1}{\setlength{\labelwidth}{16em}} - \item[\LSQ] \Int, return pointer to created \LSQ-object -(if {\em .true.}) \Mn - \item[\Type] coded \Int; coded as: -{{\sc lsq}\_{\sc t}\_{\sc complex}}\ [+\ {{\sc lsq}\_{\sc t}\_{\sc multiple}}]. -The second part indicates that multiple ($m > 1$) simultaneous equations are -requested. \Mn - \item[$n$] \Int, number of (complex) unknowns \Mn - \item[$m$] \Int, number of simultaneous equations if -{{\sc lsq}\_{\sc t}\_{\sc multiple}} specified (default one) \Mn -\end{list} -\item generate normal equations from the condition equations with successive -calls to:\\ - CALL WNMLMN(\LSQ, \Type, \Cond, \Weight, \Known) with: -\begin{list}{1}{\setlength{\labelwidth}{16em}} - \item[\LSQ] \LSQ-object pointer \Mn - \item[\Type] coded \Int, coded as: -\begin{description} - \item[--] 0: default, equal to {{\sc lsq}\_{\sc c}\_{\sc complex}} \Mn - \item[--] {{\sc lsq}\_{\sc c}\_{\sc complex}}: coefficients in \Cond\ -are $n$ complex numbers for $n$ complex unknowns \Mn - \item[--] {{\sc lsq}\_{\sc c}\_{\sc real}}: coefficients in \Cond\ -are $2n$ real numbers for $n$ complex unknowns. Each pair are the -coefficients for the real and imaginary parts of each unknown \Mn - \item[--] {{\sc lsq}\_{\sc c}\_{\sc dcomplex}}: coefficients in \Cond\ -are $2n$ complex numbers for $n$ complex unknowns. Each pair are the -coefficients for the real and imaginary parts of each unknown \Mn - \item[--] {{\sc lsq}\_{\sc c}\_{\sc ccomplex}}: coefficients in \Cond\ -are $2n$ complex numbers for $n$ complex unknowns. Each pair are the -coefficients for each unknown and its conjugate \Mn -\end{description} - \item[\Cond] factors in condition equation as \\ -\Real($0:2n-1$) or as -\Complex($0:n-1$) or as \Complex($0:2n-1$), depending on \Type \Mn - \item[\Weight] \Real, weight of condition equation ($w=1/\sigma^2$). -Note that for the best arithmetic performance, the $w_{i}$ are best -normalised to a maximum value of one. \Mn - \item[\Known] measured value(s) as \Complex($0:m-1$) \Mn -\end{list} -\item triangularise the normal equations matrix $\mathbf{A}$ with:\\ - \Logic\ WNMLTN(\LSQ) with: -\item obtain the solution by back substitution with:\\ - CALL WNMLSN(\LSQ,\Sol,\Error,\Mean) with: -\begin{list}{1}{\setlength{\labelwidth}{16em}} - \item[\LSQ] \LSQ-object pointer \Mn - \item[\Sol] solution $\mathbf{x}$ as \Complex($0:n-1,0:m-1$) \Mn - \item[\Error] adjustment error per unit weight ($\sigma_{w}$)as -\Real($0:m-1$) \Mn - \item[\Mean] standard deviation ($\sigma_{o}$) as \Real($0:m-1$) \Mn -\end{list} -\item obtain the covariance matrix or something similar with:\\ - CALL WNMLME(\LSQ,\Xsd) or:\\ - CALL WNMLCV(\LSQ,\Covar) or:\\ - CALL WNMLIN(\LSQ) with: -\begin{list}{1}{\setlength{\labelwidth}{16em}} - \item[\LSQ] \LSQ-object pointer \Mn - \item[\Xsd] the uncertainties in the unknowns $\mathbf{x}$ as -\Complex($0:n-1,0:m-1$). Note that in actual fact the errors are for the real -and imaginary parts only. True errors for the complex unknowns will be -$\sqrt{\frac{x_{\Im}^{2}\sigma_{\Im}^{2}+x_{\Re}^{2}\sigma_{\Re}^{2}} -{xx^{*}}}$ \Mn - \item[\Covar] the covariance (inverse) matrix of the solution, as -\Real($0:2n-1,0:2n-1$) \Mn -\end{list} - WNMLIN will calculate the covariance matrix internally only. In all -three cases the covariance matrix will overwrite the normal array, and it -will be used, rather than back substitution, in WNMLSN if that routine is -called after one of the inversion ones. -\item free \LSQ-object with: \\ - CALL WNMLFA(\LSQ) -\end{enumerate} - -The same additional calls to re-use an (\textref{\LSQ-object}{.ss.specc}), -with the same arguments, -are available as for the real case. The type and number of \Cond\ are, of -course, dependent on the \Type\ of solution (real or complex) and \Type\ of -condition equations. - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -\section{Dependant linear equations} - -If there are not enough independent condition equations, the normal matrix -$\mathbf{A}$ cannot be inverted, and a call to WNMLTN will fail with a {\em -.false.} return value. - -The equations could still be solved if some additional `constraint' equations -would be introduced. In the more complex cases the precise, let alone the -best, form for these additional equations is difficult to determine (e.g. the -redundancy situation in Westerbork). - -A method known as `Single value decomposition' (\SVD) can be used to obtain -the minimal set of orthogonal equations that have to be added to solve the -\LSQ\ problem. Several implementations exist in the literature. - -In general we can distinguish three types of constrained equations: -\begin{itemize} - \item the minimum number of sufficient constraint equations are known -to be able to solve a system of equations \Mn - \item constraints are used to add additional information (e.g. the -sum of angles of a triangle) \Mn - \item no actual constraint equations are known \Mn -\end{itemize} -All three cases are handled in Newstar, the first two in the same way. - -The general constraint situation arises from the use of Lagrange -multiplicators. Assume that in addition to the condition equations, with -measured values, we have a set of $p$ rigorous equations: -\begin{equation} - \phi_i(\mathbf{x})=0 \hspace{1cm} i=0,\ldots,p-1 -\label{.e.lag} -\end{equation} -We must therefore make $\chi^{2}$ minimal, subject to the set of -\eqref{.e.lag}, or: -\begin{equation} - \sum_{i=0}^{n-1}\frac{\partial \chi^{2}}{\partial x_{i}}dx_{i}=0 -\end{equation} -subject to the conditions: -\begin{equation} - \sum_{i=0}^{n-1}\frac{\partial \phi_{k}}{\partial x_{i}}dx_{i} - =0 \hspace {1cm} k=0,\dots,p-1 -\end{equation} -which leads to a set of $n+p$ equations: -\begin{equation} - \frac{\partial \chi^{2}}{\partial x_{i}} + - \sum_{k=0}^{p-1}\lambda_{k}\frac{\partial \phi_{k}}{\partial x_{i}}=0 - \hspace{1cm} i=0,\ldots,n-1 -\label{.e.lag2} -\end{equation} -together with the \eqref{.e.lag}. - -Note that in Newstar I have chosen for having constraint equations linear in -the unknowns, with a zero value. In cases where this is not adequate (e.g. -$x+y+z=360$) a simple linear transformation will suffice to make it e.g. -$x'+y'+z'=0$. - -Defining the second term in \eqref{.e.lag2} as $B_{ik}$, we can write our -expanded set of normal equations as: -\begin{equation} - \left(\begin{array} {cc} - \mathbf{A} & \mathbf{B} \\ - \mathbf{B}^{T} & 0 - \end{array} \right) - \left(\begin{array} {c} - \mathbf{x} \\ - \mathbf{\lambda} - \end{array} \right) = - \left( \begin{array} {c} - \mathbf{L} \\ - 0 - \end{array}\right) -\label{.e.xnorm} -\end{equation} - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -\subsection{Unknown constraints} - -The Newstar routines to handle this situation use a method based on -``Pseudo-inverse berekening en Cholesky factorisatie'', Hans van der Marel, -27 maart 1990. I will briefly describe Hans' paper, together with the -additions I have made. - -In the case we are considering, the normal equation $\mathbf{A}$ has not full -column rank. Therefore, there exists, if the rank defect is $p$, an $n\times -p$ matrix $\mathbf{G}$, a basis for the null-space of $\mathbf{A}$, with -$\mathbf{AG}=0$. If we assume that $\mathbf{B}$ has just sufficient -constraint equations to solve the rank defect, the inverse of the matrix in -\eqref{.e.xnorm} is: -\begin{equation} - {\left(\begin{array} {cc} - \mathbf{A} & \mathbf{B} \\ - \mathbf{B}^{T} & 0 - \end{array} \right)}^{-1} = - \left(\begin{array} {cc} - \mathbf{A}^{\#} & - \mathbf{G} {\left(\mathbf{B}^{T}\mathbf{G}\right)}^{-1} \\ - {\left(\mathbf{G}^{T}\mathbf{B}\right)}^{-1}\mathbf{G}^{T} & 0 - \end{array}\right) -\end{equation} -with $\mathbf{A}^{\#}$ the pseudo-inverse of $\mathbf{A}$. A number of -relations hold for $\mathbf{A}^{\#}$, the most important for us that -$\mathbf{B}^{T}\mathbf{A}^{\#}=0$ and $\mathbf{A}^{\#}\mathbf{B}=0$, or -$\mathbf{B}$ is a base for the null-space of $\mathbf{A}^{\#}$. For a mininorm -solution we can choose $\mathbf{B}=\mathbf{G}$. In that case $\mathbf{A}^{\#}$ -is the Moore-Penrose inverse, and $\mathbf{B}^{T}\mathbf{G}$ is regular and -symmetric. - -We can now proceed in the following way: - -\begin{enumerate} - \item Do a Cholesky factorisation of the normal -equations $\mathbf{A}$ until the remaining columns of $\mathbf{A}$ are -dependent. Pivoting along the diagonal of $\mathbf{A}$ occurs to make sure -that $\mathbf{A}$ can be partitioned in an independent and a dependent part -with rank -defect $n_{2}$. Dependency is determined by looking at the angle between a -column and the space formed by the already determined independent space (the -so-called `collinearity number'). - -If $n_{1}=n-n_{2}$, we can say that after $n_{1}$ Choleski steps, we have: -\begin{equation} - \mathbf{A} = \left( \begin{array} {cc} - A_{11} & A_{12} \\ - A_{21} & A_{22} - \end{array} \right) = - \left( \begin{array} {cc} - U_{11}^{T} & 0 \\ - U_{12}^{T} & I - \end{array} \right) \cdot - \left( \begin{array} {cc} - U_{11} & U_{12} \\ - 0 & \overline{A}_{22} - \end{array} \right) -\end{equation} -with $U_{11}$ the Cholesky factor of $A_{11}$, $U_{12}={U_{11}^{T}}^{-1} -A_{12}$ and $\overline{A}_{22}=A_{22}-U_{12}^{T}U_{12}$. - -The collinearity angle $\delta$ can be determined for the current column $i$ -by: $\sin^{2}\delta = u_{ii}^{2}/a_{ii}$. \Mn - \item Determine a $G_{1}$ replacing the (rectangular) $U_{12}$ from -$U_{11} G_{1} = -U_{12}$. \Mn - \item Determine a (symmetric) $G_{2}$ replacing $A_{22}$ from the -rank basis $I+G_{1}^{T}G_{1} = (G_{2}^{T}-1)(G_{2}-1)$ \Mn - \item determine constraint equations -$G={\left( G_{1}G_{2},G_{2}\right)}^{T}$. \Mn - \item Solve for the $n_{1}$ independent unknowns $\mathbf{x}_{1}$ -using $A_{11}$ and $L_{1}$ by back substitution \Mn - \item Solve constraint equations for the remaining $n_{2}$ unknowns, -using $G_{2}$ by back substitution: -$\mathbf{x}_{2}=-G_{2}^{-1}G_{1}^{T}\mathbf{x}_{1}$ \Mn - \item Make Baarda's S-transform of independent $n_{1}$ unknowns: -$\mathbf{x}_{1}=\mathbf{x}_{1}+G_{1}\mathbf{x}_{2}$. \Mn -\end{enumerate} -Setting $\mathbf{F}=A_{1}^{-1}L_{1}$, $\mathbf{D}=-G_{2}^{-1}G_{1}^{T}$ -and $\mathbf{E} = \left(\begin{array}{c}\mathbf{I}_{n_{1}}+G_{1}\mathbf{D} \\ -\mathbf{D} \end{array}\right)$, we can write the above steps as: -\begin{equation} - \left(\begin{array}{c} - \mathbf{x}_{1} \\ \mathbf{x}_{2} - \end{array}\right) = - \left(\begin{array}{c} - \mathbf{I}_{n_{1}}+G_{1}\mathbf{D} \\ \mathbf{D} - \end{array}\right) - \left(\begin{array}{c} - A_{1}^{-1}L_{1} - \end{array}\right) = \mathbf{E}\cdot\mathbf{F} -\end{equation} - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -\subsubsection{Errors} - -Errors are determined in the same way as \textref{described in}{.ss.errors}, -where it should be noted that \eqref{.e.chis3} can -either be used summing over $n_{1}$ variables and using the first guess of -$\mathbf{x}_{1}$, or over $n$ and using the final $\mathbf{x}$. Internally -the first option is used. -The uncertainties in $\mathbf{x}$ are determined by calculating the -covariance matrix. Using similar arithmetic \textref{as in}{.ss.errors}, it -can be shown that: -\begin{equation} - \mathbf{A}^{-1}=\mathbf{E}\cdot\mathbf{a}_{1}^{-1}\cdot\mathbf{E}^{T} -\end{equation} -$\mathbf{A}^{-1}$ is calculated by first solving -$\mathbf{H}=\mathbf{E}\left(\mathbf{A}_{1}^{-1} -\cdot\mathbf{I}_{n_{1}}\right)$ -and then $\mathbf{A}^{-1} = \mathbf{E}\cdot\mathbf{H}^{T}$. - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -\subsubsection{Newstar calls} - -The implementation in Newstar of dependent equations adds only one routine -WNMLTR, which replaces in this case the -\textref{call to WNMLTN in}{.ss.ncalls} and \textref{in}{.ss.ccalls}. The -call is: -\begin{itemize} -\item Do Cholesky factorisation of underdetermined system:\\ - \Logic\ WNMLTR(\LSQ,\Rank) with: -\begin{list}{1}{\setlength{\labelwidth}{16em}} - \item[\LSQ] \LSQ-object pointer \Mn - \item[\Rank] return \Int, the rank of $\mathbf{A}$. Note that in the -complex cases the maximum rank is $2n$. \Mn -\end{list} -\end{itemize} - -All other calls remain identical, i.e. WNMLSN knows if a rank defect was -detected by WNMLTR. The actual constraint equations used in the solution can -be obtained by: -\begin{itemize} -\item Get constraint equations: \\ - CALL WNMLGC(\LSQ,\Nconst,\Constraint) with: -\begin{list}{1}{\setlength{\labelwidth}{16em}} - \item[\LSQ] \LSQ-object pointer \Mn - \item[\Nconst] the \Int\ number of constraint equations returned, -i.e. the rank deficiency \Mn - \item[\Constraint] the \Real\ (or \Complex) constraint equations, -returned as an \\array($0:n-1,0:\,$\Nconst$\,-\,1,0:m-1$) \Mn -\end{list} -Note that in the complex case \Nconst\ can have a maximum value of $2n$, and -the returned equations are in {{\sc lsq}\_{\sc c}\_{\sc real}} type. -\end{itemize} - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -\subsection{Known constraints} - -In the case of known constraints, hence when $\mathbf{B}$ is known in -\eqref{.e.xnorm}, this equation can be solved. Cholesky decomposition -does not work in this case, and a, transparent, Crout LU decomposition is -done to determine the (symmetric) covariance (i.e. inverse) matrix of the -left hand side of \eqref{.e.xnorm}. -. - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -\subsubsection{Errors} - -Errors are determined as \textref{explained in}{.ss.errors}. Since all -constraint equations are $\equiv 0$, the sum in \eqref{.e.chis3} is -taken over $n$, not over $n+p$ if $p$ are the number of constraint equations. - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -\subsubsection{Newstar calls} - -The basic differences with the normal procedures are: -\begin{enumerate} -\item the \LSQ-object should know the number of constraint equations \Mn -\item the constraint equations ($\mathbf{B}^{T}$) should be specified. \Mn -\end{enumerate} - -The calls that are necessary: -\begin{enumerate} -\item generate an \LSQ-object with:\\ - \Logic\ WNMLGA(\LSQ, \Type, $n$\ , $m$, $p$) with: -\begin{list}{1}{\setlength{\labelwidth}{16em}} - \item[\LSQ] \Int, return pointer to created \LSQ-object -(if {\em .true.}) \Mn - \item[\Type] coded \Int; coded as:\\ -\{ {{\sc lsq}\_{\sc t}\_{\sc real}}\ $|$\ {{\sc lsq}\_{\sc t}\_{\sc -complex}}\} -\ +\ {{\sc lsq}\_{\sc t}\_{\sc constraints}} \\ -{[}+\ {{\sc lsq}\_{\sc t}\_{\sc multiple}}].\\ -The second part indicates that multiple \mbox{($m > 1$)} simultaneous equations -are -requested. \Mn - \item[$n$] \Int, number of unknowns \Mn - \item[$m$] \Int, number of simultaneous equations if -{{\sc lsq}\_{\sc t}\_{\sc multiple}} specified or 0 (default one) \Mn - \item[$p$] \Int, number of constraint equations \Mn -\end{list} -\item specify the constraint equations with a call to:\\ - CALL WNMLMC(\LSQ, \Type, \Constraint) with: -\begin{list}{1}{\setlength{\labelwidth}{16em}} - \item[\LSQ] \LSQ-object pointer \Mn - \item[\Type] coded \Int\ with same values as WNMLMN. In the complex -case and \Complex\ type, the number of equations given should be $p/2$. -that the constraint equations are real \Mn - \item[\Constraint] constraint equations as \Real($0:n-1,0:p-1$)\\ - or as {\Complex($0:n-1,0:p/2-1$)} or as \Real($0:2n-1,0:p-1$)\\ - or as {\Complex($0:2n-1,0:p/2-1$)}, depending on \Type\Mn -\end{list} -\end{enumerate} - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -\section{Non-linear equations} - -In the case of non-linear condition equations, no simple solution to minimise -the merit function (e.g. \eqref{.e.chir}) exists. A simple solution -is to take the condition equation, make a first order Taylor expansion around -an estimated $\hat{\mathbf{x}}$; solve for $d\mathbf{x}$, and iterate till -solution found. This approach was used in Newstar originally. - -However, better and more stable methods exist (e.g. steepest-descend) for -some circumstances. A method that seems to be quite stable and using both -steepest-descent and Taylor expansion, is the method by Levenberg-Marquardt -(see e.g. ``Numerical recipes'', W.H. Press {\em et al.}, Cambridge -University Press). - -If we have an estimate for $\mathbf{x}$, we can find a better one by: -\begin{equation} - \hat{\mathbf{x}}_{next}=\hat{\mathbf{x}}+\mathbf{H}^{-1}\cdot - \left[ -\nabla\chi^{2}(\hat{\mathbf{x}})\right] -\label{.e.nonl1} -\end{equation} -where $\mathbf{H}$ is the Hessian matrix of $\chi^{2}$. If our approximation -is not good enough, we could use the steepest-descent by calculating: -\begin{equation} - \hat{\mathbf{x}}_{next}=\hat{\mathbf{x}}-\mathit{constant}\cdot - \left[ -\nabla\chi^{2}(\hat{\mathbf{x}})\right] -\label{.e.nonl2} -\end{equation} - -The Hessian matrix $\mathbf{H}$ has as elements: -\begin{equation} - H_{ij} = - \frac{\partial^{2}\chi^{2}}{\partial x_{i}\partial x_{j}} = - 2\sum_{k=0}^{N-1}\frac{1}{\sigma_{i}^{2}} \left[ - \frac{\partial y_{k}}{\partial x_{i}} - \frac{\partial y_{k}}{\partial x_{j}}- - \left( l_{i}-y_{i}\right) - \frac{\partial^{2}y_{i}}{\partial x_{i} \partial x_{j}}\right] -\label{.e.hes} -\end{equation} -By dropping the second term in \eqref{.e.hes}, and multiplying each -$H_{ii}$ term with $(1+\lambda)$, and defining the first derivative of -$\chi^{2}$ as $\mathbf{b}$, we can combine the equations \eqref{.e.nonl1}, -\eqref{.e.nonl2} into: -\begin{equation} - \mathbf{H}\cdot d\mathbf{x} = \mathbf{b} -\end{equation} -which can be solved as standard normal equations. - -Choosing $\lambda$ is the crux of the matter, and where to stop iterating. A -start value of $\lambda=0.001$ is used in the following routines. The method -looks at the $\chi^{2}$ for $\hat{\mathbf{x}}+d\mathbf{x}$. If it has increased -over the value of $\chi^{2}$ for $\hat{\mathbf{x}}$, $\hat{\mathbf{x}}$ is -unchanged, and $\lambda=10\lambda$. If there is a decrease; a new value for -$\hat{\mathbf{x}}$ is used, and $\lambda=\lambda / 10$. Iteration can be -stopped if the fractional decrease in $\chi^{2}$ is small (say $<0.001$); -never if there is an increase in $\chi^{2}$. - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -\subsection{Errors} - -Errors are calculated as \textref{described in}{.ss.errors}. The errors -returned by WNMLSN are, of course, only approximations, since the original -equations are non-linear, but give a good impression of the residuals. The -covariance matrix should be calculated by doing a final linear run on the -residuals, and solve the equations. - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -\subsection{Newstar calls} - -The basic difference in calls is the use of WNMLNN(or in special cases maybe -WNMLNR) rather than WNMLTN to -triangularise the normal matrix. The -condition equations should contain the derivative to the $x_{k}$ at the -position of $\hat{\mathbf{x}}$; and the measured values the value -$\left(l_{i}-y_{i}(\hat{\mathbf{x}})\right)$. - -The actual steps in the process are than: -\begin{enumerate} -\item create \LSQ-object with WNMLGA (note that {{\sc lsq}\_{\sc t}\_{\sc -multiple}} is not allowed) \Mn -\item fill it with condition equations, as -\textref{described in}{.ss.ncalls} or \textref{in}{.ss.ccalls}, with WNMLMN, -using the residuals with an -estimated solution as the $l$-terms, and the derivative with respect to the -unknowns of the condition equations as the condition equations \Mn -\label{.ll.2} -\item triangularise and solve with:\\ - \Logic\ WNMLNN(\LSQ,0,\Sol,\Error,\Fit) or:\\ - \Logic\ WNMLNR(\LSQ,\Rank,\Sol,\Error,\Fit) with: -\begin{list}{1}{\setlength{\labelwidth}{16em}} - \item[\LSQ] \LSQ-object pointer \Mn - \item[\Rank] return \Int, the rank of $\mathbf{A}$. Note that in the -complex case the maximum rank is $2n$. \Mn - \item[\Sol] the estimated solution should be given, and will be -updated to a new solution of $\mathbf{x}$ as \Real($0:n-1$) or -\Complex($0:n-1$) \Mn - \item[\Error] adjustment error per unit weight ($\sigma_{w}$)as -\Real \Mn - \item[\Fit] goodness of current estimate as \Real. If \Fit\ $>0$ no -stable solution reached yet; if \Fit\ $\leq 0$ and $|$\Fit$|<0.001$ the -process can be stopped. \Fit\ is the fractional improvement in $\chi^{2}$. \Mn -\end{list} -\item check the \Fit\ returned parameter. If it is non-positive and has an -absolute value less than what you think is a good change (e.g. 0.001) stop -the process \Mn -\item else re-start at \ref{.ll.2} \Mn -\item if satisfied, and the covariance matrix is wanted, re-initialise the -\LSQ-object with {{\sc lsq}\_{\sc i}\_{\sc all}}, reload condition equations, -use \mbox{WNMLTR} (or WNMLTN if you are sure of an independent set of -equations), and ask for the covariance matrix or vector (WNMLCV or -\mbox{WNMLME}). \Mn -\item free \LSQ-object with WNMLFA \Mn -\end{enumerate} - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -\section{Summary} - -An \LSQ-object takes a total space of: -\begin{eqnarray} -9 & + & (\mathrm{administration}) \nonumber \\ -(n+p)(n+p+1)/2 & + & (\mathrm{normal\ array}) \nonumber \\ -4m & + & (\mathrm{error\ calculations}) \nonumber \\ -m(m+p) & + & (\mathrm{known\ sides}) \nonumber \\ -(n+p+1)/2 & + & (\mathrm{pivot\ area}) \nonumber \\ -(n+p) & & (\mathrm{solution})\ \mathrm{8\ byte\ words} -\end{eqnarray} -where $n$ is the number of unknowns ($2n$ if complex); $m$ the number of -simultaneously to be -solved equations; $p$ the number of external constraint equations. -In the non-linear case two \LSQ-objects are used. In cases where the inverted -normal array is calculated (known constraints, or explicit calls to WNMLME, -WNMLCV or WNMLIN) a temporary storage of $n^{2}$ 8-byte words is used. - -The following calls are available: -\begin{enumerate} -\item generate an \LSQ-object with:\\ - \Logic\ WNMLGA(\LSQ, \Type, $n$\ [, $m$[, $p$[, \Prec]]]) with: -\begin{list}{1}{\setlength{\labelwidth}{16em}} - \item[\LSQ] \Int, return pointer to created \LSQ-object -(if {\em .true.}) - \item[\Type] coded \Int; coded as: 0 or -\{ {{\sc lsq}\_{\sc t}\_{\sc real}}\ $|$\ -{{\sc lsq}\_{\sc t}\_{\sc complex}}\} (\Real\ is default if not specified)\\ -+ one or more of the following optional ones:\\ - {{\sc lsq}\_{\sc t}\_{\sc multiple}} if $m$ present (else 1 -assumed)\\ -{\sc lsq}\_{\sc t}\_{\sc constraint} if $p$ present (else 0 assumed)\\ -{\sc lsq}\_{\sc t}\_{\sc prec} if \Prec\ present (else default $10^{-6}$ -assumed)\\ -Optional trailing arguments may be omitted; embedded ones should have a -value, preferably ``0''. - \item[$n$] \Int, number of unknowns - \item[$m$] \Int, number of simultaneous equations if -{{\sc lsq}\_{\sc t}\_{\sc multiple}} specified (default 1) - \item[$p$] \Int, number of user specified constraints if -{{\sc lsq}\_{\sc t}\_{\sc constraint}} (default 0) - \item[\Prec] \Real, the value to be used in dependency checks -(default $10^{-6}$) -\end{list} - -\item delete an \LSQ-object with:\\ - CALL WNMLFA(\LSQ) with: -\begin{list}{1}{\setlength{\labelwidth}{16em}} - \item[\LSQ] \Int, pointer to \LSQ-object -\end{list} - -\item re-initialise an existing \LSQ-object for re-use with: \\ - CALL WNMLIA(\LSQ, \Type\ [, \Prec]) with: -\begin{list}{1}{\setlength{\labelwidth}{16em}} - \item[\LSQ] \LSQ-object pointer \Mn - \item[\Type] coded \Int, coded as a combination of: -\begin{description} - \item[--] 0: default, equal to {{\sc lsq}\_{\sc i}\_{\sc all}} \Mn - \item[--] {{\sc lsq}\_{\sc i}\_{\sc norm}}: re-initialise the -`unknown' part of the object (i.e. the normal array $\mathbf{A}$) \Mn - \item[--] {{\sc lsq}\_{\sc i}\_{\sc known}}: re-initialise the -`known' part of the object (i.e. the vector ${\mathbf L}$) \Mn - \item[--] {{\sc lsq}\_{\sc i}\_{\sc sol}}: equal to -{\sc norm}\ +\ {\sc known} \Mn - \item[--] {{\sc lsq}\_{\sc i}\_{\sc nonlin}}: re-initialise the -non-linear part of the object \Mn - \item[--] {{\sc lsq}\_{\sc i}\_{\sc all}}: equal to -{\sc sol}\ +\ {\sc nonlin} \Mn - \item[--] {{\sc lsq}\_{\sc i}\_{\sc prec}}: set the internal check -precision to \Prec \Mn -\end{description} - \item[\Prec] precision factor to be used (\Real). Only used if -{{\sc lsq}\_{\sc i}\_{\sc prec}} set. Note that the default internal value is -$10^{-6}$. \Mn -\end{list} - -\item generate normal equations from the condition equations with successive -calls to:\\ - CALL WNMLMN(\LSQ, \Type, \Cond, \Weight, \Known) with: -\begin{list}{1}{\setlength{\labelwidth}{16em}} - \item[\LSQ] \LSQ-object pointer \Mn - \item[\Type] coded \Int, coded in the real case as one of : -\begin{description} - \item[--] 0: default, equal to {{\sc lsq}\_{\sc c}\_{\sc real}} \Mn - \item[--] {{\sc lsq}\_{\sc c}\_{\sc real}} condition equations have -\Real$(0:n-1)$ values -\end{description} -or in the complex case as one of: -\begin{description} - \item[--] 0: default, equal to {{\sc lsq}\_{\sc c}\_{\sc complex}} \Mn - \item[--] {{\sc lsq}\_{\sc c}\_{\sc real}} condition equations have -\Real$(0:2n-1)$ values - \item[--] {{\sc lsq}\_{\sc c}\_{\sc complex}} condition equations have -\Complex$(0:n-1)$ values - \item[--] {{\sc lsq}\_{\sc c}\_{\sc ccomplex}} condition equations have -\Complex$(0:2n-1)$ values for conjugate variables - \item[--] {{\sc lsq}\_{\sc c}\_{\sc dcomplex}} condition equations have -\Complex$(0:2n-1)$ values for separate real and imaginary variables -\end{description} -in both cases it can be combined with one or more of: -\begin{description} - \item[--] {{\sc lsq}\_{\sc c}\_{\sc nonorm}} to bypass updating the -normal array ($\mathbf{A}$) - \item[--] {{\sc lsq}\_{\sc c}\_{\sc noknown}} to bypass updating the -known vector(s) ($\mathbf{L}$) -\end{description} - \item[\Cond] factors in condition equation as \Real($0:n-1$), -\Real($0:2n-1$), \Complex($0:n-1$) or \Complex($0:2n-1$), depending on the -\Type \Mn - \item[\Weight] \Real, weight of condition equation ($w=1/\sigma^2$). -Note that for the best arithmetic performance, the $w_{i}$ are best -normalised to a maximum value of one. \Mn - \item[\Known] measured value(s) as \Real($0:m-1$) or -\Complex($0:m-1$) \Mn -\end{list} - -\item specify known constraint equations with a call to:\\ - CALL WNMLMC(\LSQ, \Type, \Constraint) with: -\begin{list}{1}{\setlength{\labelwidth}{16em}} - \item[\LSQ] \LSQ-object pointer \Mn - \item[\Type] the same \Type\ as used in WNMLMN to indicate the type -of equations \Mn - \item[\Constraint] constraint equations as \Real($0:n-1,0:p-1$) or as\\ -{\Complex($0:n-1,0:p/2-1$)}, {\Complex($0:2n-1,0:p/2-1$)} or as\\ -{\Real($0:2n-1,0:p-1$)}, depending on \Type \Mn -\end{list} - - \item prepare normal equations for solution with one of:\\ - \Logic\ WNMLTN(\LSQ) \\ - \Logic\ WNMLTR(\LSQ,\Rank) \\ - \Logic\ WNMLNN(\LSQ,0,\Sol,\Error,\Fit) \\ - \Logic\ WNMLNR(\LSQ,\Rank,\Sol,\Error,\Fit) with: -\begin{list}{1}{\setlength{\labelwidth}{16em}} - \item[\LSQ] \LSQ-object pointer \Mn - \item[\Rank] return \Int, the rank of $\mathbf{A}$. Note that in the -complex case the maximum rank is $2n$. \Mn - \item[\Sol] the estimated solution should be given, and will be -updated to a new solution of $\mathbf{x}$ as \Real($0:n-1$) or -\Complex($0:n-1$) \Mn - \item[\Error] adjustment error per unit weight ($\sigma_{w}$)as -\Real \Mn - \item[\Fit] goodness of current estimate as \Real. If \Fit\ $>0$ no -stable solution reached yet; if \Fit\ $\leq 0$ and $|$\Fit$|<0.001$ the -process can be stopped. \Fit\ is the fractional improvement in $\chi^{2}$. \Mn -\end{list} - -WNMLTN assumes that the normal equations are fully determined; WNMLTR will -determine the minimum orthogonal set of constraint equations necessary to -solve the normal equations; WNMLNN will solve an update to a solution \Sol -for non-linear condition equations; WNMLNR will solve as WNMLNN, but will -also calculate the set of constraints if necessary. - -\item obtain the solution by back substitution for the non-linear case with:\\ - CALL WNMLSN(\LSQ,\Sol,\Error,\Mean) with: -\begin{list}{1}{\setlength{\labelwidth}{16em}} - \item[\LSQ] \LSQ-object pointer \Mn - \item[\Sol] solution $\mathbf{x}$ as \Real($0:n-1,0:m-1$) or -\Complex($0:n-1,0:m-1$) \Mn - \item[\Error] adjustment error per unit weight ($\sigma_{w}$)as -\Real($0:m-1$) \Mn - \item[\Mean] standard deviation ($\sigma_{o}$) as \Real($0:m-1$) \Mn -\end{list} - -\item get calculated constraint equations: \\ - CALL WNMLGC(\LSQ,\Nconst,\Constraint) with: -\begin{list}{1}{\setlength{\labelwidth}{16em}} - \item[\LSQ] \LSQ-object pointer \Mn - \item[\Nconst] the \Int\ number of constraint equations returned, -i.e. the (real) rank deficiency \Mn - \item[\Constraint] the \Real\ (or \Complex) constraint equations, -returned as an \\array($0:n-1,0:\,$\Nconst$\,-\,1,0:m-1$) \Mn -\end{list} -Note that in the complex case \Nconst\ can have a maximum value of $2n$. - -\item obtain the covariance matrix or something similar with:\\ - CALL WNMLME(\LSQ,\Xsd) or:\\ - CALL WNMLCV(\LSQ,\Covar) or:\\ - CALL WNMLIN(\LSQ) with: -\begin{list}{1}{\setlength{\labelwidth}{16em}} - \item[\LSQ] \LSQ-object pointer \Mn - \item[\Xsd] the uncertainties in the unknowns $\mathbf{x}$ as -\Real($0:n-1,0:m-1$) or as \Complex($0:n-1,0:m-1$) \Mn - \item[\Covar] the covariance (inverse) matrix of the solution, as \\ -\Real($0:n-1,0:n-1$) or as \Real($0:2n-1,0:2n-1$) for the complex case \Mn -\end{list} - WNMLIN will calculate the covariance matrix internally only. In all -three cases the covariance matrix will overwrite the normal array, and it -will be used, rather than back substitution, in WNMLSN if that routine is -called after one of the inversion ones. After an inversion call the -constraint -equations can no longer be obtained - -\end{enumerate} - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -\vspace{2cm} -{\em wnb, \today} -\end{document} %%%%% End of document %%%%%%%%%%%%%%%%% -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% diff --git a/src/doc/latex/make_model.tex b/src/doc/latex/make_model.tex deleted file mode 100644 index 51b0989345bd5cb460539b081ae989606f8940a2..0000000000000000000000000000000000000000 --- a/src/doc/latex/make_model.tex +++ /dev/null @@ -1,221 +0,0 @@ -\newcommand{\noi}{\noindent} -\newcommand{\bi}{\begin{itemize}} -\newcommand{\ei}{\end{itemize}} - -\chapter{\centering Source models and their construction } -{\par \em Contributed by Johan Hamaker, December 1994 \centering \par} - -\tableofcontents - -\section{ The use of source models } -\label{.source.use} - - The maps that a synthesis instrument produces do not represent the {\em -true sky}, but the true sky convolved with the instrumental response, the -so-called {\em synthesised beam}. - - Whether or not this form is an adequate representation for the purposes -of the observer depends both on the information he is trying to extract and on -the 'completeness' of the observation. In many cases it will be desirable to -obtain a purer representation of the true source distribution. What one needs, -then, is a {\em model} of the source; the process of constructing such a model -is known under various names, such as {\em model-making} and {\em -deconvolution}. - - Even if the user could dispense with a model, a model is needed in {\em -self-calibration}, the process which seeks to determine instrumental errors -from the observation itself. In self-calibration, a source model and a model of -the instrumental errors are built up side by side, using algorithms that take -into account {\em a priori} knowledge about their signatures in an observation. - - Deconvolution amounts to extrapolating from the data actually observed -into in the rest of the data domain: In aperture synthesis, one tries to -estimate the visibilities between and outside the interferometer baselines and -hour angles covered by the observation. The extrapolation is essentially no -more than an 'intelligent guess' and one must always remain wary of the -possibility that it may be wrong, - in particular when the observed field has -complex structure, and/or when the observation has incomplete hour-angle or -baseline coverage or parts are unusable due to interference. You are advised to -start with relatively simple cases and only tackle more complicated jobs when -you have developed a feeling for the possibilities and pitfalls of the methods. - - -\section{ The \NEWSTAR source model } - - A {\em source model} is a list of {\em source components} that together -approximate the true brightness distribution of a region on the celestial -sphere. - - A simple and widely known type of model is the list of CLEAN -components. A CLEAN model is restricted by the fact that its components lie on -grid points of the map in which they were found and that they are point sources. -In \NEWSTAR a much more general model is used: - -\bi -\item Components can be arbitrarily placed. - -\item Components can have an elliptic-Gaussian shape, characterised by its -half-widths along the long and short axes and the position angle of its long -axis. - -\item Components can have a spectral index. - -\item Components can be polarised, their polarisation state being described -by the ratios of stokes parameters {\em Q/I, U/I, V/I} as well as an intrinsic -rotation measure. -\ei - - Obviously, to take full advantage of these modeling options one needs a -lot of functionality. Not all of it is presently available in \NEWSTAR, and you -are encouraged to share with us ideas that you might have on extending what -exists. - - -\input{clean_vs_find.cap} - -\section{ Model-making in the map domain } -\label{.methods} - - -\subsection{ CLEAN } -\label{.clean} - - The most well-known method of constructing a source model is through -the \textref{CLEAN algorithm}{nclean_descr}. In its simplest form, this -iterative algorithm consists of a repetition of the following steps: - -\bi -\item Find the highest point in the map. - -\item Subtract from the map the theoretical response corresponding to a point -source at that position with some fraction of the peak intensity found. -\ei - -\noi The user defines the map areas in which sources are looked for, and -also has control over several other process parameters. Since CLEAN removes -each model component found from the map, it is capable in principle of modeling -an entire observed field in a single operation. - - The model obtained is a collection of point sources at map-grid -positions. Consequently, a CLEAN model is not particularly suitable for -representing point sources at arbitrary locations nor for sources of an extent -in the order of a few syntesised-beam widths. It is, on the other hand, the -only representation we have for extended sources of arbitrary shape. - - CLEAN depends on the subtraction of an antenna pattern shifted to the -position of each new source component. Since an antenna pattern normally has -the same size as the map to which it applies, shifting it leaves part of the -map 'uncovered'. Moreover, both the map and the antenna pattern are -contaminated near their edges by \whichref{aliasing effects}{}. The net result -is that satisfactory CLEANING is limited to (somewhat less than) the central -quarter of the map. - - For incomplete observations (e.g. Southern sources with limited -hour-angle coverage) CLEAN is known to produce artefacts (i.e. incorrect -visibility interpolations) which are difficult to control. - - Several variations on the basic theme of CLEAN have been proposed, both -to speed it up and to suppress undesirable artefacts. \NEWSTAR's -\textref{NCLEAN}{nclean_descr} includes only a few of these; of them, -Cotton-Schwab CLEAN is the most inportant one because it addresses the -fundamental limitations outlined above. - - - -\subsection{ NMODEL FIND } -\label{.nmodel.find} - - The FIND algorithm in NMODEL determines source positions and shapes by -fitting a two-dimensional quadratic function to selected source peaks. The -selection is made by finding peaks in the map as for CLEAN; the user defines -the map areas in which such peaks are looked for. - - Subtracting the source components found is not part of the FIND -process. Therefore, FINDing can only proceed to the extent that sources being -fitted are not too much disturbed by sidelobes from other sources. Before -prpoceeding any further, one must first make a new map in which the source -model constructed so far is subtracted. - - \Figref{.clean.vs.find} shows the similarities and differences between -FIND and CLEAN. - - -\section{ Model refinement in the visibility domain } -\label{.model.refine} - - The complicated details of making a map on a Cartesian grid out of the -visibilities observed on a polar grid need not concern us here. It is important -to realise, however, that it involves several parameters whose definition is in -principle quite arbitrary: - -\bi -\item The {\em convolution function} used in interpolating the visibilities -from a polar grid to a Cartesian grid. - -\item The {\em taper function} used for weighing down the long baselines in -order to suppress near-in sidelobes in the antenna pattern. - -\item The selection of baselines and hour angle ranges, which may be dictated -by scheduling constraints, malfunctions and interference. -\ei - - The choice of such parameters affects the source-modeling procedures in -various ways, {\em e.g.}: - -\bi -\item In general, the model cannot be expected to accurately represent -structure on a scale significantly smaller than the syntesised beamwidth. Thus, -the model to be constructed from a map is affected by the taper used in making -the map. - -\item The peak-fitting process in FIND is affected by sidelobes from other -sources: A sloping sidelobe will shift the peak. a non-zero local 'base level' -in the map will result in an incotrrect flux estimate. -\ei - - CLEAN, being an iterative procedure, automatically corrects -inaccuraccies in its flux determinations, but it works only for the central -part of the map as discussed above. FIND does not do this {\em per se}. In all -methods, the ultimate method of source removal rely on a comparison or -subtraction not in the map, but in the visibility domain. - - -\subsection{ Cotton-Schwab CLEAN } -\label{.cotton} - - Cotton-Schwab CLEAN is a variant of CLEAN is which only a rough model -is constructed in the map domain and then properly subtracted in the visibility -domain. This variant of CLEAN is thus very similar to the FIND loop of -\figref{.clean.vs.find}{\em b}, the difference being that instead of FIND a -quick-and-dirty H\"ogbom CLEAN is used. - - -\subsection{ NMODEL UPDATE } -\label{.nmodel.update} - -\input{model_update.cap} - - As discussed above, both iterated FINDing and Cotton-Schwab CLEAN rely -on successive refinement of the model by locating additional components in the -map domain. NMODEL's UPDATE function refines the model through a compariuson in -the {\em visibility} domain; in doing so it relies exclusively on observed data -and avoids all the ambiguities introduced by the \textref{map-making -process}{.model.refine}. - - The UPDATE procedure is shown schematically in \figref{.model.update}. -Starting from an initial model (typically generated by FIND), it calculates its -contribution to the observed visibilities. It then tries to explain the -difference between observed and model visibilities in terms of errors in the -parameters of each of the model components and adjusts the components -accordingly. The result is an improved model. i.e. one that more accurately -represents the true observed source distribution. - - Note that UPDATE does not generate any new components. Thus, a complete -source model can usually only be obtained by iterating through FIND and UPDATE, -mixing in some form of CLEAN for modeling the more extended sources. - - A very neat property of UPDATE is that it suppresses 'mistaken' -sources: for example, peaks in the map where grating rings of two sources cross -and sources 'aliased in' from ouside the observed field. For such sources, no -corresponding pattern exists in the visibility data and UPDATE consequently -cancels them. diff --git a/src/doc/latex/mdl_descr.tex b/src/doc/latex/mdl_descr.tex deleted file mode 100644 index d9fcaa2b4176704c4256cbaea6216bfd2d727866..0000000000000000000000000000000000000000 --- a/src/doc/latex/mdl_descr.tex +++ /dev/null @@ -1,265 +0,0 @@ -% -% @(#) mdl_descr.tex v1.2 04/08/93 JEN -% HjV 950619 Correct some typo's -% -\chapter{The MDL-file (model components)} -\tableofcontents - -A \NEWSTAR MDL file contains a collection of source model components. -This may be a mixture of multi-parameter components and ordinary CLEAN -components. The former are much more versatile, and represent one of the -main differences between \NEWSTAR and other uv-data reduction packages. - -%============================================================================== -%\include{fig_file1_MDL_structure} % figure -%============================================================================== - -%============================================================================== -\section{Inspecting the list of model components} -\label{mdl.descr.example} - - -******* Insert new script here ****** - - -The above model is in `local mode', which means that no reference position or -reference frequency is known. This information may be taken from a SCN-file -(use NMODEL option CONVERT), and stored with the model in the MDL file. The -model then looks like this: - - -******* Insert new script here ****** - -\newpage -The coordinates may als be viewed in RA and DEC: - - -******* Insert new script here ****** - - -Note that not all source parameters (see below) are visible here. They may -be inspected in the log-file whenever the model has been used. - -%============================================================================== -\section{Source component parameters} -\label{mdl.descr.param} - -The source components in a \NEWSTAR model have the following parameters: - -\begin{itemize} -\item {\bf I:} -total flux in W.U. (even when extended or polarised) -\item {\bf l, m:} -offset from the reference point (map centre) in arcsec -\item {\bf ID:} -identification number (1,2,3,...) in the list. -\item {\bf Q, U, V:} -Stokes Q, U, V in percent (of I) -\item {\bf long, short, PA:} -long and short axes (full halfwidth in arcsec) of an elliptic gaussian extended -source, and the position angle of the long axis (degrees North thru East). -\item {\bf si:} -spectral index ($flux \div frequ^{si}$). -Only used if reference frequency is known. -\item {\bf rm:} -Faraday rotation measure ($rot~=~ rm \times (c/frequ^{2}) ~in~rad/m^{2}$). -Only used if reference frequency is known. -\item {\bf flags:} -(e.g. a `proper' source (0) or a CLEAN component (1)) -\end{itemize} - - -NB: CLEAN components: -~\\ - Are not corrected for beam smearing in SELFCAL. -~\\ - Are confined to map grid postions, which may result in poor subtraction. -~\\ - Their positions cannot be "updated" automatically after SELFCAL. -~\\ Therefore, use ``proper sources'' for strong point sources, -and CLEAN components for weak extended sources (but only if necessary). - - - - -%============================================================================== -\newpage -\section{Overview of model `handling' options.} -\label{mdl.descr.handle} - -In various \NEWSTAR programs (NMODEL, NCALIB, NMAP etc) the user is able to -{\bf handle} the list of model components in various ways. -The keyword often used is {\bf MODEL\_OPTION}: - -\begin{itemize} -\item {\bf READ/WRITE:} Read/write from/to an external MDL file -\item {\bf CLEAR:} Clear the source component list, - while resetting reference coordinates -\item {\bf ZERO:} Empty the source component list, - but keep the coordinates of the field centre - and frequency. -\item {\bf SHOW/LIST:} Show source list on terminal screen, - or both terminal and LOG-file. - See example above. -\item {\bf RSHOW/RLIST:} Show source list in RA/DEC coordinates - See example above. -\item {\bf TOT:} Show source list statistics (for a specified - range of sources). The result looks like: -\sline{Sources at epoch 1950 at 05:38:43.51, 49.49.42.8, 1417.248 MHz} -\sline{10 sources (0 deleted) with 4453.700 W.U. (Max= 1900.000, Min= 2.200)}\\ -\item {\bf ADD:} Add sources to the list by hand. -\item {\bf CALIB:} Convert the source list by scaling intensities - and/or moving l,m positions. -\item {\bf EDIT:} Edit the sources in the list - (an amplitude of zero will delete the source) -\item {\bf FEDIT:} Edit a `field' (parameter) for a range of sources -\item {\bf MERGE:} Combine sources components that have - the same position -\item {\bf SORT:} Sort the source list in decreasing amplitude - (sorting will always precede a write) -\item {\bf FSORT:} Sort on a specified `field' (parameter) - in the source list -\item {\bf DEL:} Delete sources -\item {\bf DNCLOW:} Delete non-CLEAN components with low amplitudes -\item {\bf DCLOW:} Delete CLEAN components with low amplitudes -\item {\bf DAREA:} Delete sources in specified area -\end{itemize} - -In many cases, the user may specify sources in the list upon which some -`handling' options is to act. The specification may be in the form of -a {\bf SOURCE\_LIST} of id-numbers, separated by comma's (e.g. 3,6,7,2,34). -If the user answers with \scr, a {\bf SOURCE\_RANGE} is asked, -i.e. the first and last id-number of a contiguous sublist: - -\skeyword{SOURCE\_LIST} -\sprompt{(Source number list)} -\sdefault{ = $\ast$:} -\suser{?} -\skeyword{SOURCE\_RANGE} -\sprompt{(Source number range)} -\sdefault{ = "":} -\suser{*} -\sinline{$\ast$ means all sources} - -%---------------------------------------------------------------------------- -\newpage -\subsection{Calibration} -\label{mdl.descr.handle-calib} - -If the flux or position of one of the sources in the list is known, it may -be used as a calibrator. In the example, all 10 fluxes of the example model -used above are multiplied by a factor (2000/1900), to make the flux of the -first one equal to 2000 W.U. At the same time, all positions are shifted. - - -******* Insert new script here ****** - - -%---------------------------------------------------------------------------- -\newpage -\subsection{Sorting} -\label{mdl.descr.handle-sort} - -The source components may be sorted in many different ways. The option -SORT orders all components in order of decreasing flux. -{\it This operation is performed before each WRITE, so that the components -in an MDL file are always sorted this way!}. - -\skeyword{MODEL\_OPTION} -\sprompt{(READ,WRITE,CLEAR,ZERO,SHOW, $\ldots$)} -\sdefault{= QUIT:}~ -\suser{sort} - -FSORT allows the sorting on a range of criteria. In this example, the soorces -are sorted in the order of decreasing m-coordinate: - - -****** Insert new script here ***** - - -Other possibilities are: -~\\- I: amplitude -~\\- L,M: l or m -~\\- LM,ML: l and m, or m and l -~\\- ID: identification -~\\- Q,U,V: Q or U or V -~\\- SI,RM: spectral index or rotation measure -~\\- LA,SA,PA: long or short axis, position angle -~\\- BITS: bits (i.e. if source is extended or has polarisation) -~\\- TYP: source type (0 is the standard) -~\\- CC: clean component -~\\- TP2: reserved -~\\- DIST: distance to a specified centre -~\\- POL: polarised intensity - - -%---------------------------------------------------------------------------- -\newpage -\subsection{Editing} -\label{mdl.descr.handle-edit} - -Model components may be edited in various ways, using `handling' options -CLEAR, ZERO, ADD, MERGE, DEL, DNCLOW, DCLOW (see the overview above). -The handling options EDIT and FEDIT allow specific parameters (`fields') -to be edited separately. EDIT acts on a specified source, and FEDIT acts -on a range of sources. The possibilities are: - -~\\- I: amplitude -~\\- L,M: l or m -~\\- ID: identification -~\\- Q,U,V: Q or U or V -~\\- SI,RM: spectral index or rotation measure -~\\- LA,SA,PA: long or short axis, position angle -~\\- BITS: bits (i.e. if source is extended or has polarisation) -~\\- TYP: source type (0 is the standard) -~\\- CC: clean component -~\\- TP2: reserved - - - -%============================================================================== -\newpage -\section{Conversion to a uv-model for the .SCN file} -\label{mdl.descr.uvmodel} - -The calculation of uv-model data (for comparison with uv-data in NCALIB)i -s time consuming. Therefore, a calculated uv-model -is saved in the .SCN file for which it is calculated, together with the source -list used. In all programs that use the model data it can be specified how the -model calculation should be done, and if the calculation should be saved. The -relevant question is MODEL\_ACTION, which expects a list of three answers. The -first one can be one of: - -\begin{itemize} -\item {\bf merge:} - replace the model saved in the SCN node with the one - specified by the user. However, first compare these two - lists, and only add the difference to the saved model data. - I.e. make the calculation as short as possible if the new - list differs only slightly from the saved one. -\item {\bf add:} - replace the saved model with the sum of the saved one and - the one specified by the user. The model calculated on the - basis of the user specified list is added to the saved - data. -\item {\bf new:} - replace the saved model by the model specified by the user, - and calculate a completely new set of model data -\item {\bf temporary:} - do not use any data in the SCN node, or write anything, but - use the data based on the list specified by the user -\item {\bf increment:} - use the saved model data, and add to it the model data - based on the user specified list, but do not save anything -\end{itemize} - -The second answer can be BAND or NOBAND, and specifies if in the model -calculation source data should be corrected for bandsmearing to match -the actual data better. The third answer can be TIME or NOTIME to -indicate the use of integration time smearing. - - - - - - - - - diff --git a/src/doc/latex/models_descr.tex b/src/doc/latex/models_descr.tex deleted file mode 100644 index 30ff5a0bb839d6180730dae46a454ef9a724271d..0000000000000000000000000000000000000000 --- a/src/doc/latex/models_descr.tex +++ /dev/null @@ -1,266 +0,0 @@ -%models_descr.tex - -\newcommand{\NMODEL}{\textref{NMODEL}{nmodel\_descr} } -\newcommand{\local}{ {\em local} } -\newcommand{\apparent}{ {\em apparent} } -\newcommand{\epoch}{ {\em epoch} } -\newcommand{\header}{\textref{header}{.model.header} } -\newcommand{\source}{\textref{source}{.source.components} } - -\chapter{ Models in Newstar} - -{\it (contributed by W.N. Brouw 931011, edited by J.P. Hamaker 940411) } - -\tableofcontents - - -\section{General} -\label{.general} - - Source models in Newstar are in principle meant to belong to a certain -observation, although models can be converted from/to belonging to other -observations. - -\section{Model header} -\label{.model.header} - - Each model has a header. In this header the following -information is stored: - -\begin{itemize} - -\item {\em TYPE} - of coordinates used. This can be: -% - \begin{itemize} - \item - {\em local:} - no information is available about the observation to which the -model pertains. Whenever the model is used in connection with an -observation, it will be assumed that the model header data are identical -to the corresponding data in the observation. -% - \item - \apparent: - it is assumed that all coordinates are apparent. -% - \item - \epoch: - it is assumed that all coordinates belong to B1950 or J2000 - \end{itemize} - -\item {\em EPOCH:} 1950 or 2000 (if {\em TYPE} = \epoch) - -\item {\em RA, DEC:} \label{.ref.coord} - the reference right-ascension and declination (\apparent or -\epoch) to which the \textref{\em l,m}{.lm} coordinates of the \source -components refer. It is assumed that this is also the centre of the -primary beam of the individual telescopes. - -\item {\em FREQ:} - the frequency ... - -\item {\em INST:} - the instrument used in the observation. -\end{itemize} -% - -\subsection{ Conversions between coordinate types} -\label{.coord.conversions} - - If the model list was made through the {\bf ADD} and {\bf EDIT} -options of \NMODEL, the type will be \local. If it is generated through -\textref{NCLEAN}{nclean_descr} or the {\bf FIND} option of \NMODEL, the -type and other data are taken from the corresponding map. - - A \local list can be converted to an \apparent or \epoch type -though the {\bf CONVERT} or {\bf EDIT} options of \NMODEL. In this case -the reference data provided (either from a scan header or manually) will -be copied into the model header. - - An \apparent or \epoch list can be converted to \local in the -same way. - - An \apparent or \epoch list can be converted to another -\apparent or \epoch list with the \NMODEL {\bf EDIT} or {\bf CONVERT} -options. For {\bf EDIT}, the new reference data from the user will -replace the existing \header data, without changing the actual \source -components. {\bf CONVERT} will also convert the existing \source and -\header data to the new coordinates, i.e. the new source list will be -for the new RA, DEC, FREQ, INST, using the model components' spectral -index, rotation measure, primary beam and sky position. - - An \apparent or \epoch list can be converted to an \epoch or -\apparent list by \NMODEL {\bf EDIT} or {\bf CONVERT}. For {\bf EDIT}, -the new values will replace the old \header data, and only the change in -direction to the North Pole ('phi') will be applied to the individual -sources. If {\bf CONVERT}, only a reference scan can be used, and the -\source components will be shifted, rotated, beamed, spectrally indexed -etc. to the new coordinates. - - -\section{ Source components} -\label{.source.components} - - Each source in the source model has the following information: -\begin{itemize} - -\item {\em INTENSITY:} - intensity (STOKES $I$, in general in Westerbork Units) of the -source. This value is always posaitive. - -\item {\em L, M:} \label{.lm} - - the {\em l} and {\em m} coordinate on the sky for an E-W -interferometer pointed at the -\textref{reference coordinates}{.ref.coord} -in the model header; {\em l} and {\em m} are -thus given as offsets to the header position. - -\item {\em Q,U,V:} - Stokes polarisation parameters as percentages of Stokes {\em I} - -\item {\em SI:} - spectral index of the source - -\item {\em RM:} - the rotation measure of the source - -\item {\em extension:} - extension parameters of the source modeled as a two-dimensional -Gaussian: length major axis, minor axis, position angle major axis. For -a point source, both axes have length 0. - - -\item {\em source type:} \label{.type} - a number to be used to select particular sources only for -certain operations. In general only type 0 will be used in the programs -(e.g. self-calibration, updates, subtractions), but sometimes type = 1 -are used (in a different way, e.g. in -\textref{UPDATE}{nmodel_descr.update} they will not be updated, but -subtracted from the observations before updating starts). Other types -are not used at present. The user can manually set them (NMODEL -\textref{EDIT}{nmodel_descr.edit}) to e.g. temporarily 'delete' them -from his model. - -\item {\em ID:} - a simple sequence number for easily keeping track of sources -across sorting and updates etc. - -\item {\em MODE:} - this is a bit mask with bits to indicate that the source is: -% - \begin{itemize} - \item {\em clean component:} - the source has been found by \textref{NCLEAN}{nclean_descr} and -is constrained to lie on a map grid point and to be a point source. - - \item {\em beamed:} \label{.beamed} - the source intensity has been corrected for the primary beam of -the instrument. - \end{itemize} -\end{itemize} - - Whenever \textref{NMODEL}{nmodel_descr} {\bf CONVERT} is used, -the above data will be adjusted to reflect the new \header data. Note -that a {\em beamed} source will remain unchanged if the frequency and/or -instrument is changed but no spectral index is available. - - All of the above information can be changed by the \NMODEL -HANDLE {\bf EDIT} and {\bf FEDIT} options. - - The {\em beam} mode can be changed (and the intensity changed) -by the \NMODEL {\bf [DE]BEAM} options. This operation will only be -applied to sources for which it is appropriate. - - -\section{ Merging model lists} -\label{.merge.lists} - - Models can be combined with the \NMODEL {\bf xxx} option, -provided either - -\begin{itemize} - -\item one of the types is \local (in which case the other type will be -assumed to be the correct one); or - -\item both type are either \apparent or \epoch. \end{itemize} - - The two models will be automatically converted and merged into a -single model with one of the {\header}s being used. - - -\section{ Conversion of a model to visibilities} -\label{.model.to.vis} - - Conversion of a model to visibilities always occurs in the -context of a particular scan in a \textref{SCN file}{scn_descr}. In -this process, the model is automatically converted from the -model-\header coordinates to those in the \textref{scan header}{scn_descr}. - - In this process, \textref{\em beamed}{.beamed} \source -components will be de-beamed before being used; {\em de-beamed} -components will first be {\em beamed} for the header coordinates, then -{\em de-beamed} for the scan coordinates). In addition non-clean -components will be {\em smeared} for the appropriate bandwidth and -integration time. - - The user can suppress the smearing and the beaming operations -(\NMODEL {\bf MODEL\_ACTION} keyword). He has no control over the other -conversions (spectral index, different position etc.). - - -\subsection{ Instrumental polarisation} -\label{.instr.pol} - - In addition to the corrections discussed so far, {\em -position-dependent} instrumental polarisation (somewhat unfortunately -often referred to as {\em cross polarisation}) should be corrected for -in the calculation of model visibilities. It is understood in principle -how this must be done, but the implementation has been suspended until -proper measured parameyters become available. - - -\section{ Primary beam model} -\label{.primary.beam} - - The primary beam for the {\em WSRT} is currently modeled as a -circularly symmetric $\cos^{6}$ function. Pointing measurements show -that this is a good approximation out to the first null. If positions -further out were to be included, it would probably be better to model -the beam as a J0 (Bessel) function or as an $\exp(\cos^{6})$. - - For the ATCA the beam is given as an inverse polynomial, which -is correct to the first side-lobe (except for non-symmetry around the -legs). - -\section{ Updating a model} -\label{.update} - - The \NMODEL {\bf UPDATE}, {\bf XUPDATE} and {\bf SUPDATE} -options try to match a givel source model the data as well as possible -to an observation in a .SCN file.The update process extracts its -information from residuals of the observed visibilities after all model -components of \textref{types}{.type} 0 and 1 have been subtracted. -Updating is a process of fine-tuning the parameters of the model -components and is therefore not applicable to clean components. - - To make the process not too slow, each \source component is -fitted separately, special care being taken that components close -together do not unduly influence each other's updates. For the process -to work it is necessary that observation(s) span as large an HA range as -possible; otherwise the exact distance between to closely-spaced -components is difficult to determine. - - The fitting process is linear, and uses both the real and -imaginary parts of the visibilities. Since the equations used are -linearized, more than one iteration is in general needed for the process -to converge. In the equations no account is taken of secondary effects -(e.g. a shift in {\em l,m} will lead to different amplitudes due to -primary beam and frequency dependencies). It is assumed that these -effects will also iterate out. In those cases where this does not -happen, it probably would not have happened if they were taken into -account; due to dependencies between equations. - - diff --git a/src/doc/latex/mongo_graphics.tex b/src/doc/latex/mongo_graphics.tex deleted file mode 100644 index 7c24a9c6af189b14b521089bfc56c2a4acaef1d2..0000000000000000000000000000000000000000 --- a/src/doc/latex/mongo_graphics.tex +++ /dev/null @@ -1,54 +0,0 @@ -% mongo_graphics.txt -% -% History: -% JPH 940919 Make compilable in new doc. system -% -% -\chapter{ MONGO graphics} - -In many cases, the user will need the results of \NEWSTAR processing in -graphical form. In order to make this easier, the output of programs -like NGCALC can be specified to be in `MONGO' format. These are -ASCII files, organised in columns, which can be processed by the -MONGO graphics program. Because it is ASCII, the knowledgeable user -can easily edit the file with a standard editor, to fine-tune the -resulting representation. - -MONGO \copyright is an interactive graphics program, written by John L. Tonry. -For a detailed description, see the MONGO manual. %% (\cite{MONGO}). -In this section, a few simple examples are given to give the user the -general idea, and to get him/her over the initial barrier. - -In Dwingeloo, MONGO is only available on the VAX. -Create the MONGO command by typing -\\ \verb&MONGO :== @user5:[mongo]mongo.com& - -MONGO can be used interactively, or by means of a command ``macro'' (.MAC). -The data usually reside in an ASCII data file, which may be edited by -the user. - -%============================================================================== -\subsection{A simple MONGO plot} -\label{.simple.plot} - -Create a MONGO data file (extension .DAT). -This is an ASCII, in which the data is lined up in columns. -In this case, replace the string "....." in the first column with 0,1,2,3 etc -to indicate channel nr. - -Then make a MONGO command macro (ext .MAC): -\begin{tabbing} -+++\=+++++++++++++\= \kill % set tabs -\\ \> \verb&data gain64a.dat& \>MONGO data file -\\ \> \verb&limits -5 70 -10 10&\> -\\ \> \verb&xcol 1& \>x-values in 1st column of data file -\\ \> \verb&ycol 2& \>y-values in 2nd column of data file -\\ \> \verb&box& \>draw a box around the plot -\\ \> \verb&ptype 4 3& \> -\\ \> \verb&connect& \> -\\ \> \verb&xlabel channel #& \>horizontal axis label string -\\ \> \verb&ylabel ....& \>vertical axis label string -\\ \> \verb&id& \> -\end{tabbing} - -Alternative: use MONGO interactively. diff --git a/src/doc/latex/ncalib_descr.tex b/src/doc/latex/ncalib_descr.tex deleted file mode 100644 index 993b0d74219f88d0ef90c63ee59e37341ae17ba4..0000000000000000000000000000000000000000 --- a/src/doc/latex/ncalib_descr.tex +++ /dev/null @@ -1,257 +0,0 @@ -% -% ncalib_descr.tex v1.2 04/08/93 JEN -% JPH 940407 Technical changes -% -\chapter{The Program NCALIB} - -\tableofcontents {\bf Related chapters:} -\begin{itemize} -\item \textref{NCALIB REDUN: Redundancy, Align and Selfcal}{ncalib_redun} -\item \textref{NCALIB POLAR: Polarisation corrections}{ncalib_polar} -\end{itemize} - -%============================================================================ - -\section{Overview of NCALIB options} -\label{.overview} - - The program NCALIB is the heart of the NEWSTAR package. It offers a -wide range of options for the determination of all kinds of instrumental -corrections (calibration) and their application to the data (correction). -Corrections are stored in the Set headers and Scan headers of the \textref{SCN -file}{scn_descr}. They may be applied to the uv-data whenever they are read -into memory, subject to the specifications given by means the -\textref{APPLY}{common_descr} keyword. Corrections in the SCN-file may also be -manipulated, or `imported' from other sources. - - -\begin{itemize} -\item \textref{\bf REDUNDANCY}{ncalib_redun}: Calculate Redundancy, Align or -Selfcal corrections. % -\item -\textref{\bf POLAR}{ncalib_polar}: - Determine/manipulate polarisation corrections: % - \begin{itemize} - \item \textref{\bf CALC}{ncalib_polar.calc}: Calculate polarisation -corrections - \item \textref{\bf SHOW}{ncalib_polar.show}: Show polarisation corrections - \item \textref{\bf SET}{ncalib_polar.set}: Set corrections manually - \item \textref{\bf COPY}{ncalib_polar.copy}: copy polarisation corrections -from one set to others - \item \textref{\bf EDIT}{ncalib_polar.ccopy}: Edit polarisation corrections - \item \textref{\bf ZERO}{ncalib_polar.zero}: Zero polarisation corrections - \item \textref{\bf VZERO}{ncalib_polar.vzero}: Calculate X-Y phase -zero difference, assuming V=0 - \end{itemize} % -\item \textref{\bf SET}{.option.set}: Set some correction data % - \begin{itemize} - \item \textref{\bf ZERO}{.set.zero}: Zero selected corrections - \item \textref{\bf MANUAL}{.set.manual}: Copy corrections from manual -input - \item \textref{\bf COPY}{.set.copy}: Copy corrections from somewhere -else - \item \textref{\bf LINE}{.set.line}: Copy all corrections from -corresponding continuum channel - \item \textref{\bf EXTINCT}{.set.extinct}: Set extinction - \item \textref{\bf REFRACT}{.set.refract}: Set refraction - \item \textref{\bf FARADAY}{.set.faraday}: Set Faraday rotation - \item \textref{\bf RENORM}{.set.renorm}: Renormalise telescope -corrections - \end{itemize} % -\item \textref{\bf SHOW}{.option.show}: Show (on printer) the average -telescope corrections (over all HA-Scans) in specified set(s). % -\item {\bf QUIT}: Quit program NCALIB -\end{itemize} - - -%============================================================================ -%============================================================================ - -\section{Option SET: Set various corrections in the SCN-file} -\label{.option.set} - - The NCALIB option SET is accessed in the following manner: - -\scmd{dwe ncalib} -\sline{\ \ \ \ \ NCALIB\$1 is started at 17-DEC-92 15:58:01} - -\skeyword{OPTION} -\sprompt{(REDUNDANCY,POLAR,SET,SHOW,QUIT)} -\sdefault{ = QUIT}: -\suser{set} - -\skeyword{SET\_OPTION} -\sprompt{(ZERO,MANUAL,COPY,LINE,EXTINCT,...)} -\sdefault{ = QUIT}: -\suser{...} - -In the following, the various sub-options of the NCALIB option SET will be -treated in some detail. - - -%---------------------------------------------------------------------------- - -\subsection{SET ZERO: Set selected corrections to zero} -\label{.set.zero} - -The uv-data stored in a SCN file are never physically modified. Corrections are -stored separately in the Scan and Set header(s), and applied to the data -whenever they are read into memory for processing. Thus, by setting some (or -all) corrections to zero, a reduction process that has gone wrong can always be -returned to a known initial state. The keyword ZERO allows the user to specify -which of the various kinds of corrections are to be set to zero. - -\skeyword{SET\_OPTION} -\sprompt{(ZERO,MANUAL,COPY,LINE,EXTINCT,...)} -\sdefault{ = QUIT}: -\suser{zero} - -\skeyword{ZERO} -\sprompt{(ALL,NONE,RED,ALG,OTH,...)} -\sdefault{ = NONE}: -\suser{all} - -***** Insert new script here ***** - -NB: Going trough a large SCN file (e.g. one with many line channels) will take -some time. - -%---------------------------------------------------------------------------- - -\subsection{SET MANUAL: Manual input of telescope corrections} -\label{.set.manual} - -The telescope gain and phase corrections may be specified manually by the user. -The given values will be stored as `other corrections' (OTHC) in the Scan -headers of the specified range (Sets and HA-range). - -{\it Note of the editor: It is not yet clear to me what happens to the other -telescope corrections (REDC and ALGC) in the Scan header. It seems reasonable -that they are set to zero.} - -***** Insert new script here ***** - -%---------------------------------------------------------------------------- -%---------------------------------------------------------------------------- - -\subsection{SET RENORM: Renormalise telescope corrections} -\label{.set.renorm} - -In the Redundancy calibration process, the {\em average} telescope gain and -phase corrections over all telescopes are arbitrarily set to zero. This is a -`reasonable' assumption, unless the correction for one or more telescopes -happens to be anomalously large. In that case, the gain and/or phase -corrections of all the other telescopes will be shifted by an `unreasonable' -amount (since the average must be zero). Therefore, it is sometimes desirable -to RENORMalise by shifting the telescope corrections by a common amount, until -the average is zero for a selection of `good' telescopes. - - -***** Insert new script here ***** - -Note that the program terminates upon completion, i.e. it does not return to -the level of the SET option. - - -%---------------------------------------------------------------------------- - -\subsection{SET LINE: Copy telescope corrections from continuum channel} -\label{.set.line} - -Since Selfcal/Redundancy calibration requires a S/N of more than 2-5, it is -often possible for the continuum channel (0), but not for the individual line -channels. In those cases, the telescope gain and phase corrections that have -been found for channel 0 may be transferred to the line channels. This is a -`reasonable' thing to do, since the total telescope errors will vary much more -than the reletive errors between channels (i.e. the bandpass shape). - -***** Insert new script here ***** - -%---------------------------------------------------------------------------- -%---------------------------------------------------------------------------- - -\subsection{SET COPY: Copy telescope corrections from somewhere else} -\label{.set.copy} - -In the Standard Calibration process, the telescope gain and phase errors -$\gerr_{i}$ and $\perr_{i}$ are calculated with the help of a strong calibrator -source, which has been observed directly before (or after) the actual -observation. In order to use these calibrator corrections to correct the -latter, they must be transferred (copied) from the Scan header(s) of the -calibrator to the Scan header(s) of the observed object. - -There are two possibilities: The calibrator observation (and thus the desired -corrections) may be stored in a separate SCN-file (node), or they may be stored -as another `job' of the same SCN-file as the observed object. In the following -example, the observed object is stored as job nr 0, while the calibrator -observation is stored in the same SCN-file, as job nr 1: - - -***** Insert new script here ***** - -NB: Note that the program exits upon completion, and does not return to -SET\_OPTION. - -%---------------------------------------------------------------------------- -\subsection{SET CCOPY: Like COPY, but more intelligent} -\label{.set.ccopy} - - - -%---------------------------------------------------------------------------- -%---------------------------------------------------------------------------- - -\subsection{SET EXTINCT: Set extinction correction} -\label{.set.extinct} - -The actual atmospheric extinction factor (as a function of telescope elevetion) -may differ from the default value, which is based on a standard model of the -atmosphere. - - -***** Insert new script here ***** - -%---------------------------------------------------------------------------- -\subsection{SET REFRACT: Set refraction correction} -\label{.set.refract} - -***** Insert new script here ***** - -%---------------------------------------------------------------------------- -\subsection{SET FARADAY: Set Faraday rotation} -\label{.set.faraday} - -Information about the ionospheric Faraday rotation during the observation may -be obtained externally, e.g. from ionosonde measurements. NFRA receives these -values routinely from meteorological stations not too far from the WSRT. The -information may be entered into the SCN-file as a function of HA. They are -stored as corrections (FARAD) in the Scan header, and will be applied routinely -to the data if specified by the keyword APPLY. - -***** Insert new script here ***** - -%============================================================================ -\newpage -\section{Option SHOW: Print average corrections (on line printer)} -\label{.option.show} - -The average telescope gain and phase corrections that are stored in the SCN -file can be printed, for a specified range of sets. The numbers printed are a -{\em combination} of the several kinds of telescope corrections stored in the -SCN file (see the SCN-file description section). The desired combination may be -specified with the keywords APPLY and D\_APPLY. - -The output takes the form of 14 columns of 8 numbers: -\\- X gain: as gain factor and as percentage (\%) -\\- X phase: in radians and in degrees -\\- Y gain: as gain factor and as percentage (\%) -\\- Y phase: in radians and in degrees - -***** Insert new script here ***** - -The output will now be printed on the line printer. Note that the program -terminates upon completion, i.e. it does not return to the level of the SHOW -option. - - - diff --git a/src/doc/latex/ncalib_descr_tmp.0 b/src/doc/latex/ncalib_descr_tmp.0 deleted file mode 100644 index 4df40dab464f11a09b7bedb0b6f539d114edcd35..0000000000000000000000000000000000000000 --- a/src/doc/latex/ncalib_descr_tmp.0 +++ /dev/null @@ -1,198 +0,0 @@ -% -% -% -% -\chapter{The Program NCALIB} - -\tableofcontents {\bf Related chapters:} -\begin{itemize} -\item @0@\textref@1@{NCALIB REDUN: Redundancy, Align and Selfcal}@4@{ncalib\_redun@3@} -\item @0@\textref@1@{NCALIB POLAR: Polarisation corrections}@4@{ncalib\_polar@3@} -\end{itemize} - -% - -\section{Overview of NCALIB options} -\label{.overview} - - The program NCALIB is the heart of the NEWSTAR package. It offers a wide range of options for the determination of all kinds of instrumental corrections (calibration) and their application to the data (correction). Corrections are stored in the Set headers and Scan headers of the @0@\textref@1@{SCN file}@4@{scn\_descr@3@}. They may be applied to the uv-data whenever they are read into memory, subject to the specifications given by means the -@0@\textref@1@{APPLY}@4@{common\_descr@3@} keyword. Corrections in the SCN-file may also be manipulated, or `imported' from other sources. - - -\begin{itemize} -\item @0@\textref@1@{\bf REDUNDANCY}@4@{ncalib\_redun@3@}: Calculate Redundancy, Align or -Selfcal corrections. % -\item -@0@\textref@1@{\bf POLAR}@4@{ncalib\_polar@3@}: - Determine/manipulate polarisation corrections: % - \begin{itemize} - \item @0@\textref@1@{\bf CALC}@4@{ncalib\_polar@3@.calc}: Calculate polarisation corrections - \item @0@\textref@1@{\bf SHOW}@4@{ncalib\_polar@3@.show}: Show polarisation corrections - \item @0@\textref@1@{\bf SET}@4@{ncalib\_polar@3@.set}: Set corrections manually - \item @0@\textref@1@{\bf COPY}@4@{ncalib\_polar@3@.copy}: copy polarisation corrections from one set to others - \item @0@\textref@1@{\bf EDIT}@4@{ncalib\_polar@3@.ccopy}: Edit polarisation corrections - \item @0@\textref@1@{\bf ZERO}@4@{ncalib\_polar@3@.zero}: Zero polarisation corrections - \item @0@\textref@1@{\bf VZERO}@4@{ncalib\_polar@3@.vzero}: Calculate X-Y phase zero difference, assuming V=0 - \end{itemize} % -\item @0@\textref@1@{\bf SET}@4@{@3@.option.set}: Set some correction data % - \begin{itemize} - \item @0@\textref@1@{\bf ZERO}@4@{@3@.set.zero}: Zero selected corrections - \item @0@\textref@1@{\bf MANUAL}@4@{@3@.set.manual}: Copy corrections from manual input - \item @0@\textref@1@{\bf COPY}@4@{@3@.set.copy}: Copy corrections from somewhere else - \item @0@\textref@1@{\bf LINE}@4@{@3@.set.line}: Copy all corrections from corresponding continuum channel - \item @0@\textref@1@{\bf EXTINCT}@4@{@3@.set.extinct}: Set extinction - \item @0@\textref@1@{\bf REFRACT}@4@{@3@.set.refract}: Set refraction - \item @0@\textref@1@{\bf FARADAY}@4@{@3@.set.faraday}: Set Faraday rotation - \item @0@\textref@1@{\bf RENORM}@4@{@3@.set.renorm}: Renormalise telescope corrections - \end{itemize} % -\item @0@\textref@1@{\bf SHOW}@4@{@3@.option.show}: Show (on printer) the average -telescope corrections (over all HA-Scans) in specified set(s). % -\item {\bf QUIT}: Quit program NCALIB -\end{itemize} - - -% -% - -\section{Option SET: Set various corrections in the SCN-file} -\label{.option.set} - - The NCALIB option SET is accessed in the following manner: - -\scmd{dwe ncalib} -\sline{\ \ \ \ \ NCALIB\$1 is started at 17-DEC-92 15:58:01} - -\skeyword{OPTION} -\sprompt{(REDUNDANCY,POLAR,SET,SHOW,QUIT)} -\sdefault{ = QUIT}: -\suser{set} - -\skeyword{SET\_OPTION} -\sprompt{(ZERO,MANUAL,COPY,LINE,EXTINCT,...)} -\sdefault{ = QUIT}: -\suser{...} - -In the following, the various sub-options of the NCALIB option SET will be treated in some detail. - - -% - -\subsection{SET ZERO: Set selected corrections to zero} -\label{.set.zero} - -The uv-data stored in a SCN file are never physically modified. Corrections are stored separately in the Scan and Set header(s), and applied to the data whenever they are read into memory for processing. Thus, by setting some (or all) corrections to zero, a reduction process that has gone wrong can always be returned to a known initial state. The keyword ZERO allows the user to specify which of the various kinds of corrections are to be set to zero. - -\skeyword{SET\_OPTION} -\sprompt{(ZERO,MANUAL,COPY,LINE,EXTINCT,...)} -\sdefault{ = QUIT}: -\suser{zero} - -\skeyword{ZERO} -\sprompt{(ALL,NONE,RED,ALG,OTH,...)} -\sdefault{ = NONE}: -\suser{all} - -***** Insert new script here ***** - -NB: Going trough a large SCN file (e.g. one with many line channels) will take some time. - -% - -\subsection{SET MANUAL: Manual input of telescope corrections} -\label{.set.manual} - -The telescope gain and phase corrections may be specified manually by the user. The given values will be stored as `other corrections' (OTHC) in the Scan headers of the specified range (Sets and HA-range). - -{\it Note of the editor: It is not yet clear to me what happens to the other telescope corrections (REDC and ALGC) in the Scan header. It seems reasonable that they are set to zero.} - -***** Insert new script here ***** - -% -% - -\subsection{SET RENORM: Renormalise telescope corrections} -\label{.set.renorm} - -In the Redundancy calibration process, the {\em average} telescope gain and phase corrections over all telescopes are arbitrarily set to zero. This is a `reasonable' assumption, unless the correction for one or more telescopes happens to be anomalously large. In that case, the gain and/or phase corrections of all the other telescopes will be shifted by an `unreasonable' amount (since the average must be zero). Therefore, it is sometimes desirable to RENORMalise by shifting the telescope corrections by a common amount, until the average is zero for a selection of `good' telescopes. - - -***** Insert new script here ***** - -Note that the program terminates upon completion, i.e. it does not return to the level of the SET option. - - -% - -\subsection{SET LINE: Copy telescope corrections from continuum channel} -\label{.set.line} - -Since Selfcal/Redundancy calibration requires a S/N of more than 2-5, it is often possible for the continuum channel (0), but not for the individual line channels. In those cases, the telescope gain and phase corrections that have been found for channel 0 may be transferred to the line channels. This is a `reasonable' thing to do, since the total telescope errors will vary much more than the reletive errors between channels (i.e. the bandpass shape). - -***** Insert new script here ***** - -% -% - -\subsection{SET COPY: Copy telescope corrections from somewhere else} -\label{.set.copy} - -In the Standard Calibration process, the telescope gain and phase errors $\gerr_{i}$ and $\perr_{i}$ are calculated with the help of a strong calibrator source, which has been observed directly before (or after) the actual observation. In order to use these calibrator corrections to correct the latter, they must be transferred (copied) from the Scan header(s) of the calibrator to the Scan header(s) of the observed object. - -There are two possibilities: The calibrator observation (and thus the desired corrections) may be stored in a separate SCN-file (node), or they may be stored as another `job' of the same SCN-file as the observed object. In the following example, the observed object is stored as job nr 0, while the calibrator observation is stored in the same SCN-file, as job nr 1: - - -***** Insert new script here ***** - -NB: Note that the program exits upon completion, and does not return to SET\_OPTION. - -% -\subsection{SET CCOPY: Like COPY, but more intelligent} -\label{.set.ccopy} - - - -% -% - -\subsection{SET EXTINCT: Set extinction correction} -\label{.set.extinct} - -The actual atmospheric extinction factor (as a function of telescope elevetion) may differ from the default value, which is based on a standard model of the atmosphere. - - -***** Insert new script here ***** - -% -\subsection{SET REFRACT: Set refraction correction} -\label{.set.refract} - -***** Insert new script here ***** - -% -\subsection{SET FARADAY: Set Faraday rotation} -\label{.set.faraday} - -Information about the ionospheric Faraday rotation during the observation may be obtained externally, e.g. from ionosonde measurements. NFRA receives these values routinely from meteorological stations not too far from the WSRT. The information may be entered into the SCN-file as a function of HA. They are stored as corrections (FARAD) in the Scan header, and will be applied routinely to the data if specified by the keyword APPLY. - -***** Insert new script here ***** - -% -\newpage -\section{Option SHOW: Print average corrections (on line printer)} -\label{.option.show} - -The average telescope gain and phase corrections that are stored in the SCN file can be printed, for a specified range of sets. The numbers printed are a {\em combination} of the several kinds of telescope corrections stored in the SCN file (see the SCN-file description section). The desired combination may be specified with the keywords APPLY and D\_APPLY. - -The output takes the form of 14 columns of 8 numbers: -\\- X gain: as gain factor and as percentage (\%) -\\- X phase: in radians and in degrees -\\- Y gain: as gain factor and as percentage (\%) -\\- Y phase: in radians and in degrees - -***** Insert new script here ***** - -The output will now be printed on the line printer. Note that the program terminates upon completion, i.e. it does not return to the level of the SHOW option. - - - - diff --git a/src/doc/latex/ncalib_descr_tmp.text b/src/doc/latex/ncalib_descr_tmp.text deleted file mode 100644 index cd339e43483d5f681be306685f654d134f0ccd6a..0000000000000000000000000000000000000000 --- a/src/doc/latex/ncalib_descr_tmp.text +++ /dev/null @@ -1,198 +0,0 @@ -% -% -% -% -\chapter{The Program NCALIB} - -\tableofcontents {\bf Related chapters:} -\begin{itemize} -\item \htmladdnormallink{{NCALIB REDUN: Redundancy, Align and Selfcal}}{\$n\_hlp/ncalib\_redun.ps} -\item \htmladdnormallink{{NCALIB POLAR: Polarisation corrections}}{\$n\_hlp/ncalib\_polar.ps} -\end{itemize} - -% - -\section{Overview of NCALIB options} -\label{.overview} - - The program NCALIB is the heart of the NEWSTAR package. It offers a wide range of options for the determination of all kinds of instrumental corrections (calibration) and their application to the data (correction). Corrections are stored in the Set headers and Scan headers of the \htmladdnormallink{{SCN file}}{\$n\_hlp/scn\_descr.ps}. They may be applied to the uv-data whenever they are read into memory, subject to the specifications given by means the -\htmladdnormallink{{APPLY}}{\$n\_hlp/common\_descr.ps} keyword. Corrections in the SCN-file may also be manipulated, or `imported' from other sources. - - -\begin{itemize} -\item \htmladdnormallink{{\bf REDUNDANCY}}{\$n\_hlp/ncalib\_redun.ps}: Calculate Redundancy, Align or -Selfcal corrections. % -\item -\htmladdnormallink{{\bf POLAR}}{\$n\_hlp/ncalib\_polar.ps}: - Determine/manipulate polarisation corrections: % - \begin{itemize} - \item \htmladdnormallink{{\bf CALC}}{\$n\_hlp/ncalib\_polar.ps:.calc}: Calculate polarisation corrections - \item \htmladdnormallink{{\bf SHOW}}{\$n\_hlp/ncalib\_polar.ps:.show}: Show polarisation corrections - \item \htmladdnormallink{{\bf SET}}{\$n\_hlp/ncalib\_polar.ps:.set}: Set corrections manually - \item \htmladdnormallink{{\bf COPY}}{\$n\_hlp/ncalib\_polar.ps:.copy}: copy polarisation corrections from one set to others - \item \htmladdnormallink{{\bf EDIT}}{\$n\_hlp/ncalib\_polar.ps:.ccopy}: Edit polarisation corrections - \item \htmladdnormallink{{\bf ZERO}}{\$n\_hlp/ncalib\_polar.ps:.zero}: Zero polarisation corrections - \item \htmladdnormallink{{\bf VZERO}}{\$n\_hlp/ncalib\_polar.ps:.vzero}: Calculate X-Y phase zero difference, assuming V=0 - \end{itemize} % -\item \bf SET (sec. \ref{.option.set}): Set some correction data % - \begin{itemize} - \item \bf ZERO (sec. \ref{.set.zero}): Zero selected corrections - \item \bf MANUAL (sec. \ref{.set.manual}): Copy corrections from manual input - \item \bf COPY (sec. \ref{.set.copy}): Copy corrections from somewhere else - \item \bf LINE (sec. \ref{.set.line}): Copy all corrections from corresponding continuum channel - \item \bf EXTINCT (sec. \ref{.set.extinct}): Set extinction - \item \bf REFRACT (sec. \ref{.set.refract}): Set refraction - \item \bf FARADAY (sec. \ref{.set.faraday}): Set Faraday rotation - \item \bf RENORM (sec. \ref{.set.renorm}): Renormalise telescope corrections - \end{itemize} % -\item \bf SHOW (sec. \ref{.option.show}): Show (on printer) the average -telescope corrections (over all HA-Scans) in specified set(s). % -\item {\bf QUIT}: Quit program NCALIB -\end{itemize} - - -% -% - -\section{Option SET: Set various corrections in the SCN-file} -\label{.option.set} - - The NCALIB option SET is accessed in the following manner: - -\scmd{dwe ncalib} -\sline{\ \ \ \ \ NCALIB\$1 is started at 17-DEC-92 15:58:01} - -\skeyword{OPTION} -\sprompt{(REDUNDANCY,POLAR,SET,SHOW,QUIT)} -\sdefault{ = QUIT}: -\suser{set} - -\skeyword{SET\_OPTION} -\sprompt{(ZERO,MANUAL,COPY,LINE,EXTINCT,...)} -\sdefault{ = QUIT}: -\suser{...} - -In the following, the various sub-options of the NCALIB option SET will be treated in some detail. - - -% - -\subsection{SET ZERO: Set selected corrections to zero} -\label{.set.zero} - -The uv-data stored in a SCN file are never physically modified. Corrections are stored separately in the Scan and Set header(s), and applied to the data whenever they are read into memory for processing. Thus, by setting some (or all) corrections to zero, a reduction process that has gone wrong can always be returned to a known initial state. The keyword ZERO allows the user to specify which of the various kinds of corrections are to be set to zero. - -\skeyword{SET\_OPTION} -\sprompt{(ZERO,MANUAL,COPY,LINE,EXTINCT,...)} -\sdefault{ = QUIT}: -\suser{zero} - -\skeyword{ZERO} -\sprompt{(ALL,NONE,RED,ALG,OTH,...)} -\sdefault{ = NONE}: -\suser{all} - -***** Insert new script here ***** - -NB: Going trough a large SCN file (e.g. one with many line channels) will take some time. - -% - -\subsection{SET MANUAL: Manual input of telescope corrections} -\label{.set.manual} - -The telescope gain and phase corrections may be specified manually by the user. The given values will be stored as `other corrections' (OTHC) in the Scan headers of the specified range (Sets and HA-range). - -{\it Note of the editor: It is not yet clear to me what happens to the other telescope corrections (REDC and ALGC) in the Scan header. It seems reasonable that they are set to zero.} - -***** Insert new script here ***** - -% -% - -\subsection{SET RENORM: Renormalise telescope corrections} -\label{.set.renorm} - -In the Redundancy calibration process, the {\em average} telescope gain and phase corrections over all telescopes are arbitrarily set to zero. This is a `reasonable' assumption, unless the correction for one or more telescopes happens to be anomalously large. In that case, the gain and/or phase corrections of all the other telescopes will be shifted by an `unreasonable' amount (since the average must be zero). Therefore, it is sometimes desirable to RENORMalise by shifting the telescope corrections by a common amount, until the average is zero for a selection of `good' telescopes. - - -***** Insert new script here ***** - -Note that the program terminates upon completion, i.e. it does not return to the level of the SET option. - - -% - -\subsection{SET LINE: Copy telescope corrections from continuum channel} -\label{.set.line} - -Since Selfcal/Redundancy calibration requires a S/N of more than 2-5, it is often possible for the continuum channel (0), but not for the individual line channels. In those cases, the telescope gain and phase corrections that have been found for channel 0 may be transferred to the line channels. This is a `reasonable' thing to do, since the total telescope errors will vary much more than the reletive errors between channels (i.e. the bandpass shape). - -***** Insert new script here ***** - -% -% - -\subsection{SET COPY: Copy telescope corrections from somewhere else} -\label{.set.copy} - -In the Standard Calibration process, the telescope gain and phase errors $\gerr_{i}$ and $\perr_{i}$ are calculated with the help of a strong calibrator source, which has been observed directly before (or after) the actual observation. In order to use these calibrator corrections to correct the latter, they must be transferred (copied) from the Scan header(s) of the calibrator to the Scan header(s) of the observed object. - -There are two possibilities: The calibrator observation (and thus the desired corrections) may be stored in a separate SCN-file (node), or they may be stored as another `job' of the same SCN-file as the observed object. In the following example, the observed object is stored as job nr 0, while the calibrator observation is stored in the same SCN-file, as job nr 1: - - -***** Insert new script here ***** - -NB: Note that the program exits upon completion, and does not return to SET\_OPTION. - -% -\subsection{SET CCOPY: Like COPY, but more intelligent} -\label{.set.ccopy} - - - -% -% - -\subsection{SET EXTINCT: Set extinction correction} -\label{.set.extinct} - -The actual atmospheric extinction factor (as a function of telescope elevetion) may differ from the default value, which is based on a standard model of the atmosphere. - - -***** Insert new script here ***** - -% -\subsection{SET REFRACT: Set refraction correction} -\label{.set.refract} - -***** Insert new script here ***** - -% -\subsection{SET FARADAY: Set Faraday rotation} -\label{.set.faraday} - -Information about the ionospheric Faraday rotation during the observation may be obtained externally, e.g. from ionosonde measurements. NFRA receives these values routinely from meteorological stations not too far from the WSRT. The information may be entered into the SCN-file as a function of HA. They are stored as corrections (FARAD) in the Scan header, and will be applied routinely to the data if specified by the keyword APPLY. - -***** Insert new script here ***** - -% -\newpage -\section{Option SHOW: Print average corrections (on line printer)} -\label{.option.show} - -The average telescope gain and phase corrections that are stored in the SCN file can be printed, for a specified range of sets. The numbers printed are a {\em combination} of the several kinds of telescope corrections stored in the SCN file (see the SCN-file description section). The desired combination may be specified with the keywords APPLY and D\_APPLY. - -The output takes the form of 14 columns of 8 numbers: -\\- X gain: as gain factor and as percentage (\%) -\\- X phase: in radians and in degrees -\\- Y gain: as gain factor and as percentage (\%) -\\- Y phase: in radians and in degrees - -***** Insert new script here ***** - -The output will now be printed on the line printer. Note that the program terminates upon completion, i.e. it does not return to the level of the SHOW option. - - - - diff --git a/src/doc/latex/ncalib_polar.tex b/src/doc/latex/ncalib_polar.tex deleted file mode 100644 index ff96d101a9ac5e10bc72bc2d4b9bda79fb027e67..0000000000000000000000000000000000000000 --- a/src/doc/latex/ncalib_polar.tex +++ /dev/null @@ -1,1272 +0,0 @@ -% -% ncalib_polar.tex v1.2 04/08/93 JEN -% JPH 940407 Technical changes -% R. Sault 940606 Thorough revision -% JPH 940927 Some text improvements. Blank lines following labels. -% JPH 951107 Break a paragraph that was too long for ndoc - - -\chapter{NCALIB POLAR: Polarisation corrections} -\tableofcontents - - - -\section{ Preface } - - This document describes the handling of polarisation calibration and -correction by the NCALIB POLAR option. This option is activated as follows: - -\spbegin %.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+. -\scmd{exe\ ncalib} -\svbegin \begin{verbatim} - NCALIB$1 (v4.62) is started at 30-May-94 13:52:04 -\end{verbatim}\svend -\spend %.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-. -% -\spbegin %.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+. -\skeyword{OPTION} -\sprompt{(REDUNDANCY, POLAR, SET, SHOW, QUIT)} -\sdefault{= QUIT:} -\suser{polar} -\spend %.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-. -% -\spbegin %.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+. -\skeyword{POLAR\_OPTION} -\sprompt{(CALC, SHOW, SET, COPY, EDIT...)} -\sdefault{= QUIT:} -\suser{show} -\sinline{Select option} -\spend %.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-. - - - -\section{WSRT polarisation calibration strategy} -\label{.strategy} - - In the following, it will be assumed that the dipoles of the WSRT -telescopes are {\em parallel} (++). The usual calibration strategy consists of -the following steps: - -\begin{itemize} - -\item - In addition to observing calibrators along with normal observations, -the WSRT at regular intervals observes calibrators to determine various -instrumental parameters which are reasonably constant. These corrections are -automatically applied to your data at the telescope. - -\item - The complex gain factors $\cGain_{ij}$ (i.e. dipole gain errors, -$\lerr_i=\log(\gerr_i)$, and phase errors, $\perr_i$ are determined by -observing a strong calibrator, for which an accurate model exists. The -determination is done separately for the X-dipoles and the Y-dipoles, using -\eqref{.equ.pol.008}. {\em Note that any inaccuracy in the assumed value for Q -will be interpreted as a gain error. Also note that $\cGain_{xy}$ and -$\cGain_{yx}$ will be inaccurate by the value of the ``phase-zero difference -(PZD)'' between the X and Y dipoles.} - -\item - The dipole angle errors $\derr_i$ and ellipticities $\eerr_i$ are -determined by observing a strong {\em unpolarised} calibrator. This is done by -means of NCALIB option POLAR CALC in this section, using \eqref{.equ.pol.010}. -The measured corrections are stored (as POLC) in the {\em sector header} of the -SCN-file. (I.e. they are assumed to be constant for the duration of an entire -sector rather than to change from scan to scan.). - -\item - The missing 'phase-zero difference (PZD)' between the X- and Y-dipoles -is determined with the help of a calibrator with strong U. Again, -\eqref{.equ.pol.010} is used. It is assumed that $\Apol_{xy}$ and -$\Apol_{yx}$, which determine the `leakage' of the large I-term into the -result, are negligible in this stage, and that $V=0$. If this assumption is -incorrect, this will translate into a spurious V in later observations. - -\item - Ionospheric Faraday rotation may vary on much shorter timescales than -the length of the observation. This can be calibrated to a large extent by -introducing external information, obtained by -\textref{ionosonde measurements}{ncalib_descr.set.faraday}. - -\item - The WSRT instrumental polarisation is small, due to the placement of -the feed on the axis of the antenna paraboloid. The effect can be eliminated -with the help of the multi-parameter \NEWSTAR source model (see NMODEL). - -\end{itemize} - - For the best results, it may be necessary to iterate two or three -times, because one pair of dipole errors (position angle/ellipticity) may -affect the determination of the other pair (gain/phase). However, the process -will iterate to the correct result, because, {\em in the case of parallel -dipoles}, all four types of dipole errors have distinct signatures. This means -that one type of dipole error cannot be interpreted as another type, and still -give a consistent result. Therefore, all four types can be determined -independently. - -%============================================================================= -\section{Polarisation equations} - - Each of the 14 WSRT telescopes have two perpendicular linear dipoles, X -and Y. In the existing front-ends, the XY-dipole unit can be rotated over an -arbitrary angle. The dipole position angle ($\dang$) is defined from North -($\dang=0^\circ$) through East ($\dang=90^\circ$). The complex visibility -$\cVis_{12}$ that is measured with an interferometer (consisting of two dipoles -with position angles $\dang_1$ and $\dang_2$ can be written as (see Weiler, -1973): - -\begin{eqnarray} -\cVis_{12} =& \cGain_{12} &( I[\cos(\dang_1-\dang_2) - - \Apol_{12}\sin(\dang_1-\dang_2)] \nonumber \\ - & + & Q[\cos(\dang_1+\dang_2) - - \Bpol_{12}\sin(\dang_1+\dang_2)] \nonumber \\ - & + & U[\sin(\dang_1+\dang_2) + - \Bpol_{12}\cos(\dang_1+\dang_2)] \nonumber \\ - & - & iV[\sin(\dang_1-\dang_2) + - \Apol_{12}\cos(\dang_1-\dang_2)]) -\label{.equ.pol.002} -\end{eqnarray} - -in which I, Q, U and V are the Fourier transforms of the corresponding Stokes -parameters of the observed source, and the $\cGain$, $\Apol$ and $\Bpol$ -factors contain the four types of dipole errors: phase ($\perr$), gain -($\lerr=\log(\gerr)$), dipole angle error ($\derr$) and ellipticity ($\eerr$). -In the ideal case, they are all zero. For small values of $\derr$ and $\eerr$, -second-order terms can be ignored, and we can write: -% -\begin{eqnarray} -\Apol_{12} &=& (\derr_1 - \derr_2) - i(\eerr_1 + \eerr_2) \nonumber\\ -\Bpol_{12} &=& (\derr_1 + \derr_2) - i(\eerr_1 - \eerr_2) -\label{.equ.pol.004} -\end{eqnarray} -% -\begin{eqnarray} -\cGain_{12} = \gerr_1\gerr_2\exp(-i(\perr_1-\perr_2)) - = \exp(\lerr_1+\lerr_2-i(\perr_1-\perr_2)) -\label{.equ.pol.006} -\end{eqnarray} - - -\subsection{Parallel dipoles (++)} - -In the `normal' position (+) of the dipole unit, $\dang_x=90^\circ$ (east), and -$\dang_y=180^\circ$ (south). Usually the dipole units in all WSRT telescopes -are set `parallel' (++) to each other. In this case, the equations reduce to a -particularly simple form. Again ignoring second-order terms, we get % -\begin{eqnarray} -\cVis_{xx} &=& \cGain_{xx}(I-Q) \nonumber\\ -\cVis_{yy} &=& \cGain_{yy}(I+Q) -\label{.equ.pol.008} -\end{eqnarray} -% -\begin{eqnarray} -\cVis_{xy} &=& \cGain_{xy}(-U - iV - \Apol_{xy} I) \nonumber\\ -\cVis_{yx} &=& \cGain_{yx}(-U + iV + \Apol_{yx} I) -\label{.equ.pol.010} -\end{eqnarray} -% -in which $\cVis_{xx}$ is the visibility measured between the X-dipoles of -telescopes {\em i} and {\em j}, etc. After calibration, $\cGain=1$ and -$\Apol=0$, and the complex Stokes values can be calculated from the observed -visibilities: -% -\begin{eqnarray} I&=& +(\cVis_{xx} + \cVis_{yy})/2 \nonumber \\ Q&=& --(\cVis_{xx} - \cVis_{yy})/2 \nonumber \\ U&=& -(\cVis_{xy} + \cVis_{yx})/2 -\nonumber \\ iV&=& -(\cVis_{xy} - -\cVis_{yx})/2 -\label{.equ.pol.014} -\end{eqnarray} - -In the parallel mode (++), the two sets of dipole errors (phase/gain and -angle/ellipticity) are separable, and so can be determined. Nowadays (after -December 1983), the dipoles are almost always parallel, and in the new -frontends (after 1997), the dipoles will not be rotatable. - - -\subsection{X-Y Phase Zero Difference (PZD)} - -In the case of parallel dipoles (++), the complex gain errors of the X-dipoles -and those of the Y-dipoles are calibrated separately; $\cVis_{xy}$ and -$\cVis_{yx}$ will usually not have enough signal for calibration, because these -dipoles are nominally perpendicular and the fraction of linear polarisation is -usually small in calibrators. Since we only calibrate phase {\em differences}, -an arbitrary phase zero ($\perr_{x0}$ and $\perr_{y0}$) is assigned to the X- -and Y-dipoles. These phase zeros will cancel out for $\cGain_{xx}$ and -$\cGain_{yy}$, but not for $\cGain_{xy}$ and $\cGain_{yx}$. Thus, the latter -will be multiplied by an unknown phase factor $\pzd$, the so-called {\em XY -Phase Zero Difference (PZD)}. - -\begin{eqnarray} -\cGain_{xx} &=& \gerr_x\gerr_x\exp(-i(\perr_x-\perr_x)) \nonumber \\ -\cGain_{yy} &=& \gerr_y\gerr_y\exp(-i(\perr_y-\perr_y))\\ - \label{.equ.pol.016} % -\cGain_{xy} &=& \gerr_x\gerr_y\exp(-i(\perr_x-\perr_y+\pzd)) \nonumber \\ -\cGain_{yx} &=& \gerr_y\gerr_z\exp(-i(\perr_y-\perr_x-\pzd)) -\label{.equ.pol.018} -\end{eqnarray} - -\noindent in which $\pzd=\perr_{x0}-\perr_{y0} = {\rm PZD}$. Of course, -$\cGain_{xy}$ is the complex gain of the interferometer made up of the X-dipole -of telescope $i$ and Y-dipole of telescope $j$, etc. - - -\subsection{Crossed dipoles ($+\times$)} - - Before 1983, polarisation measurements with the WSRT were usually -carried out with dipoles in the fixed telescopes (0-9) in the `normal' -position, and the dipoles in the movable telescopes (A-D) rotated by $45^\circ$ -($\times$), with $\dang_x=45^\circ$ and $\dang_y=135^\circ$. The 40 standard -(fixed-movable) interferometers were said to have `crossed' ($+\times$) -dipoles. In this case, the visibility equations take the following form: -% -\begin{eqnarray} -\cVis_{xx} &=& \ \ \cGain_{xx}(I(1-\Apol_{xx}) - - Q(1+\Bpol_{xx}) + U(1-\Bpol_{xx}) + iV(1-\Apol_{xx})) \nonumber \\ -\cVis_{yy} &=& \ \ \cGain_{yy}(I(1+\Apol_{yy}) + - Q(1+\Bpol_{yy}) - U(1-\Bpol_{yy}) + iV(1-\Apol_{yy})) \nonumber \\ -\cVis_{xy} &=& -\cGain_{xy}(I(1-\Apol_{xy}) + - Q(1-\Bpol_{xy}) + U(1+\Bpol_{xy} - iV(1+\Apol_{xy})) \nonumber \\ -\cVis_{yx} &=& \ \ \cGain_{yx}(I(1-\Apol_{yx}) - - Q(1-\Bpol_{yx}) - U(1+\Bpol_{yx}) - iV(1+\Apol_{yx})) -\label{.equ.pol.022} -\end{eqnarray} -% - With crossed dipoles, the signal-to-noise ratio of the xy/yx terms are -similar to that of the xx/yy terms. This makes it possible to make a -redundancy calibration solution for all 28 dipoles simultaneously, {\em but -only if we may assume that $V=0$}. In principle, this would open the way to -continuous polarisation calibration on the object itself, provided it has -enough flux. - - However, crossed dipoles introduce a number of new problems that make -them less attractive: -% -\begin{itemize} - -\item The two sets of dipole errors (phase/gain and angle/ellipticity) are no -longer completely separable. This means that the phase solution will influence -the angle error solution, and the gain solution will influence the ellipticity -solution. - -\item For part of the telescopes, the four-petal clover-leaf pattern of -instrumental polarisation will be rotated by $45^\circ$ with respect to the sky -and with respect to the four legs that support the focus box. This complicates -any calibration schemes for instrumental polarisation. - -\end{itemize} - - These problems, combined with the fact that the phase-zero problem is -not really avoided (since redundancy solution is only possible if it has to be -assumed that $V=0$) have led to the practice to use only parallel dipoles. - - {\it (Annotation by JPH 940624: The reader is cautioned that the -arguments advanced here against the use of crossed dipoles are a matter of -continuing controversy. It can easily be shown from first principles that the -separability of phase/gain and dipole errors is irrelevant. Furthermore, the -parallel-dipole configuration is inherently asymmetric with respect to Stokes -{\em Q} and {\em U} and crossed dipoles are clearly superior in this respect; -how important this is is not clear.)} - - -\subsection{Faraday rotation} - -When radiation passes through a charged medium (like the ionosphere), the place -of linear polarisation will be rotated by the angle $\farang$: -% -\begin{eqnarray} Q &=& Q_{obs}\cos(2\farang) + U_{obs}\sin(2\farang) \nonumber -\\ U &=& U_{obs}\cos(2\farang) + Q_{obs}\sin(2\farang) -\label{.equ.pol.024} -\end{eqnarray} -% -Note that $I$, $V$ and $P=\sqrt{Q^2+U^2}$ are independent of $\farang$. The -Faraday effect is strongly frequency-dependent: $\farang \propto \nu^{-2}$. - - -\section{POLAR SHOW: Show corrections} -\label{.show} - -The 56 correction factors (2 for each of the 28 dipoles) for angle errors and -ellipticities that are stored in the {\em set header} (as POLC, see SCN-file -description) can be viewed in a digestible form: - -\spbegin %.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+. -\skeyword{POLAR\_OPTION} -\sprompt{(CALC, SHOW, SET, COPY, EDIT...)} -\sdefault{= QUIT:} -\suser{show} -\spend %.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-. -% -\spbegin %.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+. -\skeyword{SCN\_NODE} -\sprompt{(input/output 'node' name)} -\sdefault{= "":} -\suser{psr1937.jan93} -\spend %.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-. -% -\spbegin %.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+. -\skeyword{SCN\_SETS} -\sprompt{(Set(s) to do: g.o.f.c.s )} -\sdefault{= "":} -\suser{2.0.0.0.0} -\sinline{For example} % -\svbegin \begin{verbatim} - Sector: 2.0.0.0.0 - - Position Ellipticity Rotation Orthog. - X(%) Y(%) X(%) Y(%) (deg) (deg) - - 0 -1.13 -0.06 -0.37 0.54 -0.34 0.61 - 1 -0.16 0.13 0.07 0.04 -0.01 0.17 - 2 1.25 0.82 1.77 -2.56 0.59 -0.24 - 3 0.49 -0.02 0.11 1.19 0.13 -0.29 - 4 -0.72 -0.14 -0.03 -0.46 -0.25 0.33 - 5 -0.09 -0.41 0.47 0.15 -0.14 -0.19 - 6 -0.04 -0.21 -0.93 0.52 -0.07 -0.10 - 7 -1.30 -1.42 0.45 -0.21 -0.78 -0.07 - 8 2.51 1.77 0.86 0.99 1.23 -0.42 - 9 0.80 -0.23 -0.69 -0.39 0.16 -0.59 - A -0.03 -0.73 1.61 -0.08 -0.22 -0.40 - B -0.13 -0.57 -0.57 0.30 -0.20 -0.26 - C 0.00 0.00 0.00 0.00 0.00 0.00 - D -0.05 -0.31 -1.23 1.50 -0.10 -0.15 -\end{verbatim}\svend -\spend %.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-. - -The first two columns (position) give the dipole angle error, expressed as the -percentage of I that will corrupt Q, U and V. This is equivalent to expressing -the dipole misalignment errors as percentages of one radian. In the last two -columns, these same numbers are re-interpreted as a position error (rotation) -of the entire XY-dipole assembly in degrees, and a deviation from the nominal -orthogonality between the X and Y dipole. This is useful, since the entire -XY-dipole assembly can be rotated as a whole for each WSRT telescope. - -The ellipticities are also given as percentages of the corrupting I, or as -percentages of one radian. - -%============================================================================= - -\section{POLAR CALC: Calculate corrections} -\label{.calc} - -The dipole angle {\em errors} $\derr_i$ and ellipticities $\eerr_i$ are -calculated using \eqref{.equ.pol.010}. A strong calibrator is observed, which -is known to be unpolarised ($U=0$ and $V=0$). It is assumed that gain and -phase have already been calibrated by other means (e.g. Selfcal): $\cGain_{xy} -= \cGain_{yx} = 1$. Thus, -\eqref{.equ.pol.010} reduces to: -% -\begin{equation} - \cVis_{12}/I = \Apol_{12} = (\derr_{1}-\derr_{2})-i(\eerr_{1}+\eerr_{2}) -\end{equation} -% -with $I=(\cVis_{11}+\cVis_{22})/2$. - -The system of linear equations (one for each $\cVis_{xy}$ and $\cVis_{yx}$) can -be solved in a manner that is entirely analogous to the -\textref{redundancy solution}{ncalib.redun} for gain and phase errors. The -separate solutions for the real and imaginary parts now give the $\derr_i$ and -$\eerr_i$ respectively. - -Since the S/N of the $\cVis_{xy}$ and $\cVis_{yx}$ will be small, the -least-squares solution will be more accurate if more data (Sets and HA-range) -are used. However, it must of course be assumed that the $\derr_i$ and -$\eerr_i$ values are the same for all these data. This is a fairly safe -assumption, since the causes for these dipole errors are `mechanical', and vary -only slowly in time. If the estimated values are to be useful for correction -subsequent observations, they must at least be constant for the duration of the -calibrator observation. - -\spbegin %.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+. -\skeyword{POLAR\_OPTION} -\sprompt{(CALC, SHOW, SET, COPY, EDIT...)} -\sdefault{= QUIT:} -\suser{calc} -\spend %.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-. -% -\spbegin %.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+. -\skeyword{SCN\_NODE} -\sprompt{(input/output 'node' name)} -\sdefault{= "":} -\suser{psr1937.jan93} -\spend %.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-. -% -\spbegin %.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+. -\skeyword{SCN\_LOOPS} -\sprompt{(niter, Setincr(g.o.f.c.s) ....)} -\sdefault{= "":} -\suser{\scr} -\spend %.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-. -% -\spbegin %.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+. -\skeyword{SCN\_SETS} -\sprompt{(Set(s) to do: g.o.f.c.s )} -\sdefault{= "":} -\suser{2.0.0.0.0} -\spend %.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-. -% -\spbegin %.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+. -\skeyword{HA\_RANGE} -\sprompt{(DEG) (HA range)} -\sdefault{= *:} -\suser{\scr} % -\svbegin \begin{verbatim} - All cross interferometers pre-selected -\end{verbatim}\svend -\spend %.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-. -% -\spbegin %.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+. -\skeyword{SELECT\_IFRS} -\sprompt{(Select/de-select ifrs)} -\sdefault{= "":} -\suser{p} % -\svbegin \begin{verbatim} - 0123456789ABCD - 0 -+++++++++++++ - 1 -++++++++++++ - 2 -+++++++++++ - 3 -++++++++++ - 4 -+++++++++ - 5 -++++++++ - 6 -+++++++ - 7 -++++++ - 8 -+++++ - 9 -++++ - A -+++ - B -++ - C -+ - D - -\end{verbatim}\svend -\spend %.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-. -% -\spbegin %.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+. -\skeyword{SELECT\_IFRS} -\sprompt{(Select/de-select ifrs)} -\sdefault{= "":} -\suser{\scr} -\spend %.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-. -% -\spbegin %.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+. -\skeyword{BASEL\_CHECK} -\sprompt{(M) (Baseline deviation allowed)} -\sdefault{= 0.5 M:} -\suser{\scr} -\spend %.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-. - -The only difference with a `normal' (gain/phase) Redundancy solution is that -these solutions are for all 28 dipoles simultaneously. Therefore, the necessary -constraint equations have 28 coefficients. The words `gain' and `phase' refer -to the separate Real and Imaginary solutions. The succession of dipoles is -0X,0Y,1X,1Y,...etc. - -The constraint equations arbitrarily set the {\em average ellipticity} and the -{\em average dipole angle errors} over the array to zero. Without further -information, this may be the most reasonable value. But if it is wrong it could -affect the observations that are calibrated with the results. - -The result of CALC looks very much like the output of SHOW (see above), except -that the estimated accuracy (mean error) of the numbers is give in brackets. - -%\input ncalib_polar_calc2.scr -\spbegin %.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+. -\svbegin \begin{verbatim} - Sector: 2.0.0.0 - - Position Ellipticity Rotation Orthog. - X(%) Y(%) X(%) Y(%) (deg) (deg) - - 0 -1.13(0.06) -0.06(0.06) -0.37(0.06) 0.54(0.06) -0.34 0.61 - 1 -0.16(0.06) 0.13(0.06) 0.07(0.06) 0.04(0.06) -0.01 0.17 - 2 1.25(0.06) 0.82(0.06) 1.77(0.06) -2.56(0.06) 0.59 -0.24 - 3 0.49(0.06) -0.02(0.06) 0.11(0.06) 1.19(0.06) 0.13 -0.29 - 4 -0.72(0.06) -0.14(0.06) -0.03(0.06) -0.46(0.06) -0.25 0.33 - 5 -0.09(0.06) -0.41(0.06) 0.47(0.06) 0.15(0.06) -0.14 -0.19 - 6 -0.04(0.06) -0.21(0.06) -0.93(0.06) 0.52(0.06) -0.07 -0.10 - 7 -1.30(0.06) -1.42(0.06) 0.45(0.06) -0.21(0.06) -0.78 -0.07 - 8 2.51(0.06) 1.77(0.06) 0.86(0.06) 0.99(0.06) 1.23 -0.42 - 9 0.80(0.07) -0.23(0.07) -0.69(0.07) -0.39(0.07) 0.16 -0.59 - A -0.03(0.04) -0.73(0.04) 1.61(0.04) -0.08(0.04) -0.22 -0.40 - B -0.13(0.05) -0.57(0.05) -0.57(0.05) 0.30(0.05) -0.20 -0.26 - C 0.00(0.72) 0.00(0.72) 0.00(0.72) 0.00(0.72) 0.00 0.00 - D -0.05( 0.2) -0.31( 0.2) -1.23( 0.2) 1.50( 0.2) -0.10 -0.15 -\end{verbatim}\svend -\spend %.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-. - -The dipole corrections estimated by CALC will be {\em added} to the corrections -that were applied to the data when they were read in. - -%============================================================================= -\section{POLAR SET: Set corrections manually} -\label{.set} - -The user may specify values for the dipole angle errors $\derr_i$ and -ellipticity $\eerr_i$ manually. The numbers given by the user are converted to -internal format, and stored (as POLC) in the headers of the given range of -Sets. The default values are zero. - -\spbegin %.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+. -\skeyword{POLAR\_OPTION} -\sprompt{(CALC, SHOW, SET, COPY, EDIT...)} -\sdefault{= QUIT:} -\suser{set} -\spend %.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-. -% -\spbegin %.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+. -\skeyword{SCN\_NODE} -\sprompt{(input/output 'node' name)} -\sdefault{= "":} -\suser{psr1937.jan93} -\spend %.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-. -% -\spbegin %.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+. -\skeyword{SCN\_SETS} -\sprompt{(Set(s) to do: g.o.f.c.s )} -\sdefault{= "":} -\suser{2.0.0.0.0} -\sinline{For example} -\spend %.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-. -% -\spbegin %.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+. -\skeyword{POL\_ROTAN} -\sprompt{(dipole position)} -\sdefault{= 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0:} -\suser{\scr} -\spend %.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-. -% -\spbegin %.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+. -\skeyword{POL\_ORTHOG} -\sprompt{(dipole orthogonality)} -\sdefault{= 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0:} -\suser{\scr} -\spend %.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-. -% -\spbegin %.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+. -\skeyword{POL\_X\_ELLIPS} -\sprompt{(X ellipticity)} -\sdefault{= 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0:} -\suser{\scr} -\spend %.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-. -% -\spbegin %.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+. -\skeyword{POL\_Y\_ELLIPS} -\sprompt{(Y ellipticity)} -\sdefault{= 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0:} -\suser{\scr} % -\svbegin \begin{verbatim} - Sector: 2.0.0.0.0 -\end{verbatim}\svend -\spend %.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-. - -%============================================================================= -\section{POLAR EDIT: Edit corrections} -\label{.edit} - -This is similar to POLAR SET above, except that the default values are the -corrections (POLC) that are already stored in the Set headers. Thus, the -existing POLC corrections in each Set header of the given range can be edited -separately: - - -\spbegin %.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+. -\skeyword{POLAR\_OPTION} -\sprompt{(CALC, SHOW, SET, COPY, EDIT...)} -\sdefault{= QUIT:} -\suser{edit} -\spend %.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-. -% -\spbegin %.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+. -\skeyword{SCN\_NODE} -\sprompt{(input/output 'node' name)} -\sdefault{= "":} -\suser{psr1937.jan93} -\spend %.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-. -% -\spbegin %.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+. -\skeyword{SCN\_SETS} -\sprompt{(Set(s) to do: g.o.f.c.s )} -\sdefault{= "":} -\suser{2.0.0.0.0} -\sinline{For example} % -\svbegin \begin{verbatim} - Sector: 2.0.0.0.0 -\end{verbatim}\svend -\spend %.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-. -% -\spbegin %.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+. -\skeyword{POL\_ROTAN} -\sprompt{(dipole position)} -\sdefault{= 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0:} -\suser{\scr} -\spend %.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-. -% -\spbegin %.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+. -\skeyword{POL\_ORTHOG} -\sprompt{(dipole orthogonality)} -\sdefault{= 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0:} -\suser{\scr} -\spend %.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-. -% -\spbegin %.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+. -\skeyword{POL\_X\_ELLIPS} -\sprompt{(X ellipticity)} -\sdefault{= 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0:} -\suser{\scr} -\spend %.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-. -% -\spbegin %.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+. -\skeyword{POL\_Y\_ELLIPS} -\sprompt{(Y ellipticity)} -\sdefault{= 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0:} -\suser{\scr} -\spend %.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-. - - -%============================================================================= -\section{POLAR ZERO: Zero corrections} -\label{.zero} - -For the specified range of sets, the POLC corrections in the set header are set -to zero: - -\spbegin %.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+. -\skeyword{POLAR\_OPTION} -\sprompt{(CALC, SHOW, SET, COPY, EDIT...)} -\sdefault{= QUIT:} -\suser{zero} -\spend %.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-. -% -\spbegin %.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+. -\skeyword{SCN\_NODE} -\sprompt{(input/output 'node' name)} -\sdefault{= "":} -\suser{psr1937.jan93} -\spend %.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-. -% -\spbegin %.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+. -\skeyword{SCN\_SETS} -\sprompt{(Set(s) to do: g.o.f.c.s )} -\sdefault{= "":} -\suser{2.0.0.0.0} % -\svbegin \begin{verbatim} - Sector: 2.0.0.0.0 -\end{verbatim}\svend -\spend %.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-. -% -\spbegin %.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+. -\skeyword{POLAR\_OPTION} -\sprompt{(CALC, SHOW, SET, COPY, EDIT...)} -\sdefault{= QUIT:} -\suser{\scr} -\spend %.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-. - - -%============================================================================= -\section{POLAR COPY: Copy corrections from somewhere else} -\label{.copy} - -The polarisation corrections $\derr_i$ and $\eerr_i$ are calculated with the -help of a strong, unpolarised calibrator source, using the option POLAR CALC -(see above). In order to use these corrections to correct a real observation, -they must be transferred (copied) from the Set header of the calibrator to the -Set header(s) of the observed object. - -There are two possibilities: The calibrator observation (and thus the desired -corrections) may be stored in a separate SCN-file (node), or they may be stored -in another `group' in the same SCN-file as the observed object. Below, an -example is given for both situations: - -If the calibrator observation is stored in a separate SCN-file: - -\spbegin %.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+. -\skeyword{POLAR\_OPTION} -\sprompt{(CALC, SHOW, SET, COPY, EDIT...)} -\sdefault{= QUIT:} -\suser{copy} -\spend %.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-. -% -\spbegin %.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+. -\skeyword{SCN\_NODE} -\sprompt{(input/output 'node' name)} -\sdefault{= "":} -\suser{psr1937.jan93} -\spend %.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-. -% -\spbegin %.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+. -\skeyword{SCN\_LOOPS} -\sprompt{(niter, Setincr(g.o.f.c.s) ....)} -\sdefault{= "":} -\suser{\scr} -\spend %.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-. -% -\spbegin %.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+. -\skeyword{SCN\_SETS} -\sprompt{(Set(s) to do: g.o.f.c.s )} -\sdefault{= "":} -\suser{0} -\spend %.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-. -% -\spbegin %.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+. -\skeyword{USE\_SCN\_NODE} -\sprompt{(input node name)} -\sdefault{= *:} -\suser{?} % -\svbegin \begin{verbatim} - Specify the node name from which the corrections should be calculated. - * indicates the same as the output node name. -\end{verbatim}\svend -\spend %.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-. -% -\spbegin %.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+. -\skeyword{USE\_SCN\_NODE} -\sprompt{(input node name)} -\sdefault{= *:} -\suser{3c48} -\spend %.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-. -% -\spbegin %.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+. -\skeyword{USE\_SCN\_SETS} -\sprompt{(Set(s) of input uv-data Sectors: g.o.f.c.s)} -\sdefault{= "":} -\suser{2.0.0.0.0} % -\svbegin \begin{verbatim} - Sector: 0.0.0.0.0 - Sector: 0.0.0.4.0 -\end{verbatim}\svend -\spend %.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-. - -If the calibrator observation is stored in the same SCN-file (e.g. as group 1, -while the observed object is stored as group 0), the process runs as follows: - -\spbegin %.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+. -\skeyword{POLAR\_OPTION} -\sprompt{(CALC, SHOW, SET, COPY, EDIT...)} -\sdefault{= QUIT:} -\suser{copy} -\spend %.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-. -% -\spbegin %.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+. -\skeyword{SCN\_NODE} -\sprompt{(input/output 'node' name)} -\sdefault{= "":} -\suser{psr1937.jan93} -\spend %.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-. -% -\spbegin %.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+. -\skeyword{SCN\_LOOPS} -\sprompt{(niter, Setincr(g.o.f.c.s) ....)} -\sdefault{= "":} -\suser{\scr} -\spend %.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-. -% -\spbegin %.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+. -\skeyword{SCN\_SETS} -\sprompt{(Set(s) to do: g.o.f.c.s )} -\sdefault{= "":} -\suser{0} -\spend %.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-. -% -\spbegin %.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+. -\skeyword{USE\_SCN\_NODE} -\sprompt{(input node name)} -\sdefault{= *:} -\suser{\scr} -\spend %.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-. -% -\spbegin %.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+. -\skeyword{USE\_SCN\_SETS} -\sprompt{(Set(s) of input uv-data Sectors: g.o.f.c.s)} -\sdefault{= "":} -\suser{1.0.0.0.0} % -\svbegin \begin{verbatim} - Sector: 0.0.0.0.0 - Sector: 0.0.0.4.0 -\end{verbatim}\svend -\spend %.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-. - - -%============================================================================= -\section{POLAR VZERO: X-Y Phase Zero Difference, assuming V=0} -\label{.vzero} - -The VZERO option deals with the determination and manipulation of the {\em -Phase Zero Difference (PZD)} between the X and Y dipoles. It is invoked in the -following way: - -\spbegin %.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+. -\skeyword{POLAR\_OPTION} -\sprompt{(CALC, SHOW, SET, COPY, EDIT...)} -\sdefault{= QUIT:} -\suser{vzero} % -\spend %.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-. - - -%------------------------------------------------------------------------------ -\subsection{POLAR VZERO CALC: Calculate and show} -\label{.vzero.calc} - -An Phase Zero Difference (PZD) between the X-dipoles an the Y-dipoles affects -the phase of the complex gain factors $\cGain_{xy}$ and $\cGain_{yx}$ (but not -$\cGain_{xx}$ and $\cGain_{yy}$). The PZD is determined with the help of a -strong calibrator source, which must have a relatively large U-component of -linear polarisation, and an accurately known amount of circular polarisation -(Stokes V). The latter is important, since a wrong value for V will be -incorrectly interpreted as a PZD. Since the V is difficult to measure -accurately, it is safer to use a calibrator that `should not' have any circular -polarisation: $V=0$. - -The algorithm uses \eqref{.equ.pol.010} and \eqref{.equ.pol.018}. It is assumed -that the `leakage' of the strong I-term is eliminated by means -\textref{POLAR CALC}{.calc}: $\Apol_{xy} = \Apol_{yx} = 0$. It is also assumed -that the gain and phase errors have also been well-calibrated: $\lerr_i = -\perr_i = 0$. Thus, \eqref{.equ.pol.010} reduce to: -\begin{eqnarray} - \cVis_{xy} & = & -U\exp (-i\pzd) \nonumber \\ - \cVis_{yx} & = & -U\exp (+i\pzd) -\end{eqnarray} - -The calculation of the PZD angle ($\pzd$) is now quite straightforward. Because -of the low S/N of the `cross-terms' $\cVis_{xy}$, as many data (Sets, HA-range) -should be used in the estimation as possible. However, the PZD may change with -time. - -\spbegin %.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+. -\skeyword{VZERO\_OPTION} -\sprompt{(CALC, APPLY, ASK, MANUAL, SCAN...)} -\sdefault{= QUIT:} -\suser{calc} -\spend %.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-. -% -\spbegin %.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+. -\skeyword{SCN\_NODE} -\sprompt{(input/output 'node' name)} -\sdefault{= "PSR1937.JAN93":} -\suser{\scr} -\spend %.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-. -% -\spbegin %.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+. -\skeyword{SCN\_LOOPS} -\sprompt{(niter, Setincr(g.o.f.c.s) ....)} -\sdefault{= "":} -\suser{\scr} -\spend %.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-. -% -\spbegin %.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+. -\skeyword{SCN\_SETS} -\sprompt{(Set(s) to do: g.o.f.c.s )} -\sdefault{= "":} -\suser{0} -\spend %.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-. -% -\spbegin %.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+. -\skeyword{HA\_RANGE} -\sprompt{(DEG) (HA range)} -\sdefault{= *:} -\suser{\scr} % -\svbegin \begin{verbatim} - All cross interferometers pre-selected -\end{verbatim}\svend -\spend %.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-. -% -\spbegin %.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+. -\skeyword{SELECT\_IFRS} -\sprompt{(Select/de-select ifrs)} -\sdefault{= "":} -\suser{\scr} % -\svbegin \begin{verbatim} - Sector: 0.0.0.0 - Sector: 0.0.0.4 -\end{verbatim}\svend -\spend %.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-. - -The resulting PZD angle is given as follows: - -%\input ncalib_polar_vzero3.scr -\spbegin %.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+. -\svbegin \begin{verbatim} - A complex angle of 0.54+0.12I(0.01+0.01I) or 12.44 degrees -\end{verbatim}\svend -\spend %.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-. - -This message is somewhat confusing as the interesting information in the -``complex angle'' has been truncated in the printing (the relative sizes of the -real and imaginary parts). The angle given in degrees is somewhat more -informative. - - - -%------------------------------------------------------------------------------ -\subsection{POLAR VZERO APPLY: Calculate, show and apply} -\label{.vzero.apply} - -The PZD angle is `applied' by adjusting the phase in the `other corrections' -(OTHC) in the Scan headers. This is done for the entire specified range (Sets -and HA-range). - -\spbegin %.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+. -\skeyword{VZERO\_OPTION} -\sprompt{(CALC, APPLY, ASK, MANUAL, SCAN...)} -\sdefault{= QUIT:} -\suser{apply} -\spend %.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-. -% -\spbegin %.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+. -\skeyword{SCN\_NODE} -\sprompt{(input/output 'node' name)} -\sdefault{= "":} -\suser{psr1937.jan93} -\spend %.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-. -% -\spbegin %.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+. -\skeyword{SCN\_LOOPS} -\sprompt{(niter, Setincr(g.o.f.c.s) ....)} -\sdefault{= "":} -\suser{\scr} -\spend %.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-. -% -\spbegin %.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+. -\skeyword{SCN\_SETS} -\sprompt{(Set(s) to do: g.o.f.c.s )} -\sdefault{= "":} -\suser{0} -\spend %.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-. -% -\spbegin %.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+. -\skeyword{HA\_RANGE} -\sprompt{(DEG) (HA range)} -\sdefault{= *:} -\suser{\scr} % -\svbegin \begin{verbatim} - All cross interferometers pre-selected -\end{verbatim}\svend -\spend %.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-. -% -\spbegin %.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+. -\skeyword{SELECT\_IFRS} -\sprompt{(Select/de-select ifrs)} -\sdefault{= "":} -\suser{\scr} % -\svbegin \begin{verbatim} - Sector: 0.0.0.0 - Sector: 0.0.0.4 - A complex angle of 0.55+0.01I(0.01+0.01I) or 1.00 degrees -\end{verbatim}\svend -\spend %.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-. - -%------------------------------------------------------------------------------ -\subsection{POLAR VZERO ASK: Calculate, check with user, and apply} -\label{.vzero.ask} - -The user may influence the result by giving another PZD, which will be -`applied' for the entire specified range (Sets and HA-range). The default is -the calculated value. - -\spbegin %.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+. -\skeyword{VZERO\_OPTION} -\sprompt{(CALC, APPLY, ASK, MANUAL, SCAN...)} -\sdefault{= QUIT:} -\suser{ask} -\spend %.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-. -% -\spbegin %.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+. -\skeyword{SCN\_NODE} -\sprompt{(input/output 'node' name)} -\sdefault{= "PSR1937.JAN93":} -\suser{\scr} -\spend %.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-. -% -\spbegin %.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+. -\skeyword{SCN\_LOOPS} -\sprompt{(niter, Setincr(g.o.f.c.s) ....)} -\sdefault{= "":} -\suser{\scr} -\spend %.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-. -% -\spbegin %.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+. -\skeyword{SCN\_SETS} -\sprompt{(Set(s) to do: g.o.f.c.s )} -\sdefault{= 0:} -\suser{\scr} -\spend %.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-. -% -\spbegin %.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+. -\skeyword{HA\_RANGE} -\sprompt{(DEG) (HA range)} -\sdefault{= *:} -\suser{\scr} % -\svbegin \begin{verbatim} - 0123456789ABCD - 0 -+++++++++++++ - 1 -++++++++++++ - 2 -+++++++++++ - 3 -++++++++++ - 4 -+++++++++ - 5 -++++++++ - 6 -+++++++ - 7 -++++++ - 8 -+++++ - 9 -++++ - A -+++ - B -++ - C -+ - D - -\end{verbatim}\svend -\spend %.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-. -% -\spbegin %.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+. -\skeyword{SELECT\_IFRS} -\sprompt{(Select/de-select ifrs)} -\sdefault{= "":} -\suser{\scr} % -\svbegin \begin{verbatim} - Sector: 0.0.0.0 - Sector: 0.0.0.4 - A complex angle of 0.55-0.00I(0.01+0.01I) or -0.19 degrees -\end{verbatim}\svend -\spend %.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-. -% -\spbegin %.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+. -\skeyword{VZERO\_PHASE} -\sprompt{(X-Y difference)} -\sdefault{= -0.1857903:} -\suser{\scr} -\sinline{Use the calculated value} -\spend %.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-. - -%------------------------------------------------------------------------------ -\subsection{POLAR VZERO MANUAL: Ask for and apply} -\label{.vzero.manual} - -The PZD angle given by the user is `applied' to the entire specified range -(Sets and HA-range). The default value is $PZD =0^\circ$. - -\spbegin %.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+. -\skeyword{VZERO\_OPTION} -\sprompt{(CALC, APPLY, ASK, MANUAL, SCAN...)} -\sdefault{= QUIT:} -\suser{manual} -\spend %.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-. -% -\spbegin %.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+. -\skeyword{SCN\_NODE} -\sprompt{(input/output 'node' name)} -\sdefault{= "PSR1937.JAN93":} -\suser{\scr} -\spend %.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-. -% -\spbegin %.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+. -\skeyword{SCN\_LOOPS} -\sprompt{(niter, Setincr(g.o.f.c.s) ....)} -\sdefault{= "":} -\suser{\scr} -\spend %.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-. -% -\spbegin %.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+. -\skeyword{SCN\_SETS} -\sprompt{(Set(s) to do: g.o.f.c.s )} -\sdefault{= 0:} -\suser{\scr} -\spend %.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-. -% -\spbegin %.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+. -\skeyword{HA\_RANGE} -\sprompt{(DEG) (HA range)} -\sdefault{= *:} -\suser{\scr} -\spend %.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-. -% -\spbegin %.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+. -\skeyword{VZERO\_PHASE} -\sprompt{(X-Y difference)} -\sdefault{= 0:} -\suser{-1} -\sinline{User specifies a PZD = -1 degrees} -\spend %.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-. - -%------------------------------------------------------------------------------ -\subsection{POLAR VZERO SCAN: Calculate and apply on a per-scan basis} -\label{.vzero.scan} - -The change of the PZD angle as a function of time can be studied by estimating -it for each Scan (HA) separately. The S/N of the estimation will necessarily be -low. - -\spbegin %.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+. -\skeyword{VZERO\_OPTION} -\sprompt{(CALC, APPLY, ASK, MANUAL, SCAN...)} -\sdefault{= QUIT:} -\suser{scan} -\spend %.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-. -% -\spbegin %.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+. -\skeyword{SCN\_NODE} -\sprompt{(input/output 'node' name)} -\sdefault{= "PSR1937.JAN93":} -\suser{\scr} -\spend %.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-. -% -\spbegin %.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+. -\skeyword{SCN\_LOOPS} -\sprompt{(niter, Setincr(g.o.f.c.s) ....)} -\sdefault{= "":} -\suser{\scr} -\spend %.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-. -% -\spbegin %.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+. -\skeyword{SCN\_SETS} -\sprompt{(Set(s) to do: g.o.f.c.s )} -\sdefault{= 0:} -\suser{\scr} -\spend %.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-. -% -\spbegin %.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+. -\skeyword{HA\_RANGE} -\sprompt{(DEG) (HA range)} -\sdefault{= *:} -\suser{\scr} % -\svbegin \begin{verbatim} - 0123456789ABCD - 0 -+++++++++++++ - 1 -++++++++++++ - 2 -+++++++++++ - 3 -++++++++++ - 4 -+++++++++ - 5 -++++++++ - 6 -+++++++ - 7 -++++++ - 8 -+++++ - 9 -++++ - A -+++ - B -++ - C -+ - D - -\end{verbatim}\svend -\spend %.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-. -% -\spbegin %.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+. -\skeyword{SELECT\_IFRS} -\sprompt{(Select/de-select ifrs)} -\sdefault{= "":} -\suser{\scr} -\spend %.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-. - -%------------------------------------------------------------------------------ -\subsection{POLAR VZERO COPY: Calculate from input and apply to output} -\label{.vzero.copy} - -The PZD angle is calculated with the help of a strong, unpolarised calibrator -source. In order to use it to correct a real observation, it must be -transferred (copied) from the Scan header(s) of the calibrator to the Scan -header(s) of the observed object. - -There are two possibilities: The calibrator observation (and thus the desired -corrections) may be stored in a separate SCN-file (node), or it may be stored -in another group in the same SCN-file as the observed object. NB: In the latter -case, it could even be the same observation! In both cases, the PZD is -calculated from a range of data (Sets and HA-range) in the INPUT\_NODE, and -`applied' (i.e. stored as `other corrections' (OTHC)) to the Scan Headers in -the SCAN\_NODE. In the following example, the calibrator is stored in the same -SCN-file as group 1, while the observed object is stored as group 0): - -\spbegin %.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+. -\skeyword{VZERO\_OPTION} -\sprompt{(CALC, APPLY, ASK, MANUAL, SCAN...)} -\sdefault{= QUIT:} -\suser{copy} -\spend %.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-. -% -\spbegin %.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+. -\skeyword{SCN\_NODE} -\sprompt{(input/output 'node' name)} -\sdefault{= ""} -\suser{psr1937.jan93} -\sinline{SCN-file} -\spend %.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-. -% -\spbegin %.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+. -\skeyword{SCN\_LOOPS} -\sprompt{(niter, Setincr(g.o.f.c.s) ....)} -\sdefault{= "":} -\suser{\scr} -\spend %.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-. -% -\spbegin %.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+. -\skeyword{SCN\_SETS} -\sprompt{(Set(s) to do: g.o.f.c.s )} -\sdefault{= 0:} -\suser{0.*.*.*.*} -\sinline{Apply the PZD to all sets of job 0} -\spend %.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-. -% -\spbegin %.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+. -\skeyword{USE\_SCN\_NODE} -\sprompt{(input node name)} -\sdefault{= *:} -\suser{?} % -\svbegin \begin{verbatim} - Specify the node name from which the corrections should be calculated. - * indicates the same as the output node name. -\end{verbatim}\svend -\spend %.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-. -% -\spbegin %.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+. -\skeyword{USE\_SCN\_NODE} -\sprompt{(input node name)} -\sdefault{= *:} -\suser{*} -\sinline{Use the same SCN file} -\spend %.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-. -% -\spbegin %.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+. -\skeyword{USE\_SCN\_SETS} -\sprompt{(Set(s) of input uv-data Sectors: g.o.f.c.s)} -\sdefault{= "":} -\suser{2.0.0.0.0} -\sinline{Sets in job 2} -\spend %.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-. -% -\spbegin %.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+. -\skeyword{HA\_RANGE} -\sprompt{(DEG) (HA range)} -\sdefault{= *:} -\suser{\scr} -\sinline{Use all scans in these sets} % -\svbegin \begin{verbatim} - 0123456789ABCD - 0 -+++++++++++++ - 1 -++++++++++++ - 2 -+++++++++++ - 3 -++++++++++ - 4 -+++++++++ - 5 -++++++++ - 6 -+++++++ - 7 -++++++ - 8 -+++++ - 9 -++++ - A -+++ - B -++ - C -+ - D - -\end{verbatim}\svend -\spend %.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-. -% -\spbegin %.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+. -\skeyword{SELECT\_IFRS} -\sprompt{(Select/de-select ifrs)} -\sdefault{= "":} -\suser{\scr} -\sinline{Use all interferometers} % -\svbegin \begin{verbatim} - Sector: 0.0.0.0 - Sector: 0.0.0.4 - A complex angle of 0.55-0.00I(0.01+0.01I) or -0.89 degrees -\end{verbatim}\svend -\spend %.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-. - -Warning: Remember that the PZD may partly be an {\em artifact} of the separate -phase/gain calibration of the X-dipoles and the Y-dipoles. This may lead to a -different PZD angle for the calibrator and the subsequent observation. The -difference may be several degrees, which is much greater than the accuracy that -is required for the measurement of very small percentages of circular -polarisation. However, the measured V may be more accurate if the observed -object is extended, which will often be the case. But the truth of the matter -is that, even though the WSRT may offer the best conditions for very accurate -polarisation measurements, the PZD problem is essentially unsolved. - diff --git a/src/doc/latex/ncalib_redun.tex b/src/doc/latex/ncalib_redun.tex deleted file mode 100644 index 34eacc5c0bf5733682c39e412fa13a8f25f6ca32..0000000000000000000000000000000000000000 --- a/src/doc/latex/ncalib_redun.tex +++ /dev/null @@ -1,309 +0,0 @@ -% ncalib_redun.tex v1.2 04/08/93 JEN -% JPH 940406 Technical changes -% JPH 951107 Break a paragraph that was too long for ndoc -% JPH 960326 Further fix for this problem - -\newcommand{\be}{\begin{enumerate}} -\newcommand{\ee}{\end{enumerate}} -\newcommand{\I}{\item} - - -\chapter{NCALIB REDUN: Redundancy, Align and Selfcal} % -\tableofcontents % -\section{Overview} - - The NCALIB option {\bf REDUN} actually covers three related methods of -estimating telescope gain and phase errors from the uv-data itself: Redundancy, -Selfcal and Align. All three methods require the socalled `Selfcal assumption', -which states that all phase and gain errors are {\em telescope-based}. -% (line break for sake of ndoc - donot remove leading blank) - This means that the errors can be fully decomposed into contributions from -individual telescopes, and that interferometer-based errors can be ignored. -This assumption implies a drastic reduction in the number of {\em independent} -errors in the data taken with an N-telescope array: from $N(N-1)/2$ to $N-1$ -per integration interval. This relatively small number of independent errors -can be determined with a {\em least-squares fitting} technique. - - Any {\em interferometer-based} errors (e.g. thermal noise or -correlator errors) violate the basic Selfcal assumption, and cause propagating -errors in the solution. Fortunately, the WSRT correlators only contribute very -small interferometer errors (typically $<$0.01\%), -but the S/N per uv-sample should be at least 2-5 for a good solution. - - Independent solutions can be obtained for telescope gain and phase -errors, because they are mathematically `orthogonal'. - -\begin{itemize} -\item {\bf Selfcal:} - The telescope gain and phase errors are estimated by comparing the -uv-data with a model of the observed source. In WSRT Selfcal, the information -from redundant spacings can be added as {\em extra constraints} on the Selfcal -solution. Since this extra information is model-independent, the Selfcal -process is less likely to converge to the wrong result. - -\item {\bf Redundancy:} - Telescope gain and phase errors are estimated by comparing the uv-data -of `redundant' interferometers, i.e. interferometers that have the same -baseline length and orientation. Since this is a comparative method, the -absolute gain (flux) and the absolute phase gradient (position) cannot be -determined. The result is a set of `internally perfect' HA-scans, that still -have to be `aligned' (see below) to each other in flux and position. - -\item {\bf Align:} - The absolute gain and the absolute phase gradient for misaligned -HA-scans can be determined with the help of a source model. This is similar to -Selfcal, except that one only solves for one parameter per HA-scan, rather than -for N telescope errors. This has the advantage that the source model may be -less perfect, and the SNR of the uv-data may be lower. Therefore, this method -may also be used to remove ionosferic phase gradients from data that have too -little SNR to warrant Redundancy or Selfcal. - -\end{itemize} - - The figures of this section may help to illustrate the effects of these -three methods. There is also a description of the relevant mathematical -formalism. Finally, this section contains processing examples and an -explanation of the output that is produced on the screen and in the log file. - -\input{../fig/ncalib_3c48.cap} -\input{../fig/ncalib_scan.cap} - - -%============================================================================= -%\include{form_redun} % REDUN mathematical formalism -%============================================================================= - -\input{../fig/ncalib_matrix.cap} -\input{../fig/ncalib_vispace.cap} - - -%============================================================================= -\section{Redundancy} -\label{.redundancy} - - Redundancy-only is selected by {\bf not} specifying a source model. The -resulting telescope gain and phase errors are stored in the Scan file headers, -as REDC. - -**** Put new script here **** - - -%============================================================================= -\section{Align} -\label{.align} - - Align is selected by specifying a source model, and explicitly -specifying the {\bf ALIGN\_OPTION}. It is then assumed by default that the -Scan is `perfect', i.e. that all 14 telescopes are grouped together. In that -case, only two parameters have to be determined: the absolute gain, and the -absolute phase gradient over the array. Experienced users can specify -multi-parameter solutions for more than one independent groups of telescopes by -manipulating the {\bf FORCE\_FREEDOM} keyword. The {\bf MWEIGHT} keywords are -used to give greater weight to those baselines (by length), for which the model -is `known' to be most accurate. - - The resulting telescope gain and phase corrections are stored in the -Scan headers, as ALGC. - -*** Put new script here **** - -%============================================================================= -\section{Selfcal} -\label{.selfcal} - - Selfcal is selected by specifying a source model, and explicitly -specifying `Selfcal' to the {\bf ALIGN\_OPTION}. Redundancy constraints -(equations) are included automatically if redundant spacings have been selected -with {\bf SELECT\_IFRS}. The {\bf MWEIGHT} keywords are used to give greater -weight to those baselines (by length), for which the model is `known' to be -most accurate. - - The resulting telescope gain and phase corrections are stored in the -Scan headers, as ALGC. - -*** Put new script here **** - - -%============================================================================= -\newpage -\section{Discussion of the screen/log output} -\label{.log.output} - -The following information per HA-scan may be printed in the LOG-file and/or -displayed on the terminal screen (keyword {\bf SHOW\_LEVEL}). - -\slong{ HA Rk A(\%) P(deg) A(WU) P(WU) Amax Aavg Arms dAmax -dPmax I} -\sskip -\slong{Set: 0.0.0.0} -\slong{ 11.53X New phase constraints:} -\slong{ 1 1 1 1 1 1 1 1 1 1 1 1 1 1} -\slong{ 11.53X 01 0.6 0.2 12.9 7.1 2012 2000.0 5.2 1.9 67 0.5 -58 3} -\setc - -\vspace*{-10mm} -\begin{tabbing} +++++\=+++++\=+++++\=+++++\=+++++\=+++++\=+++++\=+++++\=+++++\= -\kill %tabs -\\ \> HA \> (e.g. -83.86X) \>\> Hour-angle (degr) and polarisation -\\ \> Rk \> (e.g. 12) \>\> Rank of the gain and phase solution -matrices -\\ \> A(\%) \> (e.g. 3.3) \>\> RMS gain residual (\%) -\\ \> P(deg) \> (e.g. 2.2) \>\> RMS phase residual (degr) -\\ \> A(WU) \> (e.g. 1.6) \>\> RMS gain residual (WU=Westerbork Unit) -\\ \> P(WU) \> (e.g. 1.8) \>\> RMS phase residual (WU) -\\ \> Amax \> (e.g. 63) \>\> Maximum ampl (WU) -\\ \> Aavg \> (e.g. 50.1) \>\> Average ampl (WU) -\\ \> Arms \> (e.g. 5.1) \>\> RMS ampl (WU) -\\ \> dAmax \> (e.g. -12.4 23) \>\> largest gain -\\ \> dPmax \> (e.g. 6.3 CD) \>\> largest phase residual (WU), ifr=CD -\end{tabbing} - - -\slong{X average amplitude= 2000.005 (0.892)} -\sskip -\slong{X overall noise (gain, phase in W.U.): 14.2 11.1} -\sskip - -\begin{itemize} -\item {\bf Average amplitude:} - -\item {\bf Average gain and phase errors per telescope:} - Over the whole observation (or rather, the part that has just been -processed). These numbers can also be calculated separately by means of NCALIB -option SHOW. - -\item {\bf Overall noise:} - Useful for automatic deletion of `bad' scans (see NSCAN). -Redundancy-only is model-independent, so the overall noise should be equal to -the thermal noise. If not, it is an indication of problems. A difference -between SELFCAL noise and Redundancy-only noise is an indication of the -completeness of the SELFCAL model (caution: there are different interferometers -involved). - -\item {\bf Graphs:} - There are three kinds of line-printer graphs produced in the log-file. -They give various overall gain and phase quantities per interferometer. The -baseline length increases to the right. The gain axis (A) is on the left, and -the phase axis (P) on the right. - \begin{itemize} - \item {\bf Graph: Average residual error X (W.U.):} - \item {\bf Graph: Average residual error X (\%, deg):} - \item {\bf Graph: RMS X (W.U.):} - \end{itemize} % -\end{itemize} - - - The SELFCAL and Redundancy residuals contain a wealth of information -about the quality of the data and the completeness of the SELFCAL model. The -user is urged to make residual plots by means of the program NPLOT. - - -%============================================================================= - -\section{QDETAILS: Hidden parameters} -\label{.qdetails} - - For all REDUN options, the user is prompted for `more details?' by the -NCALIB keyword QDETAILS. Hidden behind this are a number of keywords that may -be manipulated by experienced users in special cases. Their default values are -optimised for normal use, and wil be printed in the NCALIB LOG-file. - -\skeyword{BASEL\_CHECK} -\sprompt{(M)} -\sdefault{ = 0.5 M:} -\suser{\scr} -\scomment{ Criterion for two baselines to be considered redundant, i.e. of -identical length.} - -\skeyword{WEIGHT\_MIN} -\sprompt{(Minimum weight accepted)} -\sdefault{= 0.01:} -\suser{\scr} -\scomment{The weight of Selfcal and Redundancy equations is proportional to the -amplitude of their uv-data. If the amplitude is very small, the information -will be very noisy, and may do more harm than good to the solution. Therefore, -it may be excluded by raising the value of WEIGHT\_MIN, as a fraction of the -maximum weight.} - -\skeyword{SOLVE} -\sprompt{(Solve for gain, phase (Y/N)} -\sdefault{= YES,YES:} -\suser{\scr} -\scomment{Normally, both a gain and a phase solution will be required. But it -is possible to ask for only one at a time.} - -\skeyword{COMPLEX} -\sprompt{(Complex solution (Y/N)} -\sdefault{ = NO:} -\suser{\scr} -\scomment{The non-linear conversion to gain and phase skews the gaussian -distribution of the noise on the measured cos/sine values. Therefore, gain and -phase solutions will produce a `noise bias', which is more serious for low S/N -data. This can be avoided by specifying a `complex solution' (see also section -...)} - -\skeyword{FORCE\_PHASE} -\sprompt{()} -\sdefault{ = 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0 } -\suser{\scr} -\scomment{If the visibility phases are close to $\pm 180~degr$, the conversion -from cos/sine to phase may cause phase ambiguities (jumps) of 360 degr. This -will cause problems in the phase solution, where the phases are assumed to be -on a linear scale between $\pm \infty$. In order to avoid this, the user may -specify initial phase corrections for all telescopes, which will be used to -move the data away from $\pm 180~degr$ before processing. This is of course -taken into account for the total correction afterwards.} - -\skeyword{CONTINUITY} -\sprompt{(Continuity in solution (Y/N)} -\sdefault{= YES:} -\suser{\scr} -\scomment{Normally, the HA-scans are processed in HA-order. The gain and phase -errors determined for the last Scan may be used to correct the data of the next -Scan {\em before} processing. (This is of course taken into account for the -total correction afterwards). This approach is useful to keep phases away from -$\pm 180~degr$, where they may cause unwanted phase-ambiguity problems.} - -\skeyword{CHECKS} -\sprompt{(Maximum deviations)} -\sdefault{ = 5,5,3:} -\suser{\scr} -\scomment{The user may set some threshold values for an automatic check on the -quality of the solution of each HA-scan. A warning will be issued in the log -whenever the tresholds are exceeded. However, no further action is taken by the -program!} - -\newcommand{\void}[1]{} -\void{ -\section{Pathological situations} - - It may happen that NCALIB fails to produce a decent solution from the -latter observations: The errors reported for the amplitude and phase noises are -mucj larger than one could reasonably expect. This is a sure sign of trouble: -Apart from obvious causes such as interference, it may be a consequence of -improper phase corrections applied in the on-line observing system. - - The trouble comes from the fact that under such conditions NCALIB may -not be able to correctly resolve the 360-degree phase ambiguity inherent in -determining a visibility's phase. This kind of problem can be fixed with a -little bit of work. - -\be -\I Determine whether the problem occurs in the XX or YY interferometers or -both. The remaining steps must be applied to each separately. - -\I Use the \textref{NSCAN}{nscan_descr} SHOW option to display the table -of amplitudes and phases in a representative scan. - -\I Take a good look at the lower triangle where the phases are displayed. -What you must expect is to find (probably one) telescope(s) for which the -phases in different interferometers flip wildly between two values, one in the -vicinity of +180 degrees and the other of -180 degrees. - -\I Re-execute your Selfcal run, but this time use the FORCE_PHASE -parameter to force the phases for the suspected telecope to either + or - 180 -degrees, e.g. if Telescope 3 give problems, specify FORCE_PHASE = ,,,180. -\ee } - - diff --git a/src/doc/latex/nclean_descr.tex b/src/doc/latex/nclean_descr.tex deleted file mode 100644 index f8649efcc2a0553a2d2fce991b58a93f07012620..0000000000000000000000000000000000000000 --- a/src/doc/latex/nclean_descr.tex +++ /dev/null @@ -1,260 +0,0 @@ -% JPH 940916 Make compilable -% nclean_descr.tex -% -% JPH 9404.. Original -% JPH 940729 Note on corrugations and SDI Clean -% Note on residual map for UV Clean (bug 67) -% JPH 940816 \textref to keyword help files --> \keyref -% JPH 941028 \keyref --> \textref -% -% -% -\chapter{The program NCLEAN} - -\tableofcontents - -\section{ Overview} -\label{.overview} - - NCLEAN is a relatively simple implementation of a number of Clean -algorithms. According to its writer (WNB), more elaborate and versatile -implementations exist in AIPS and GIPSY. - - NCLEAN makes extensive use of the -\textref{\em source model}{nmodel_descr} facilities. A source model is a list -of source components. The user has considerable latitude in manipulating such -models; for example, NCLEAN allows one to restore source components that were -inserted in the model by mechanisms other than Clean and are not on grid -points. Since it is left to the user to decide what is "correct" and what not, -such facilities should be used only by experts and with caution. - -\input{../fig/nclean_interface.cap} - - \Figref{.nclean.interface} shows an overview of the options available -in NCLEAN. The program's basic Clean function is implemented in several forms -to be discussed below. In addition, there is a separate option to restore a -map from a source model in a -\textref{\em MDL file}{nmodel_descr}, and an option to produce a histogram of -the intensities of a collection of map areas. - - The components found are stored in a source model in core. NCLEAN will -ask the user for an MDL file to store the list; if he specifies none, the -\textref{\em NMODEL HANDLE}{nmodel_descr} process will be activated to process -the list. - - -\section{ NCLEAN versus NMODEL FIND} -\label{.nclean.versus} - - The Clean algorithm is fundamentally limited by its basic paradigm, -{\em viz.} attempting to represent a continuous brightness contribution as a -superposition of point sources on map-grid points. This approach is inadequate -for small sources if dynamic ranges in excess of, say, 1000 are aimed for. - - On the other hand, Clean is the only mechanism available to construct -models for extended sources that cannot be adequately represented by a model -with at most a few parameters. Note, however, that Clean has difficulty -guessing the missing information for extended sources which results in the -notorious problem of \whichref{\em corrugations}{}. Modifications to Clean's -search algorithm have proved succesful in suppressing these corrugations -(whichref{"SDI Clean"}{}), but they are not available in NCLEAN. - - As an alternative, Newstar has the option of FINDing sources with the -program \textref{NMODEL}{nmodel_descr}. This method is superior for sources of -small extent, since it does not confine their positions to be on grid points -and desribes their shapes in terms of an ellipse with three parameters (axes -and orientation). In doing this, FIND can also take the effects of bandwidth -smearing and finite integration time into account. - - FIND is therefore the recommended way of building models of small -sources. Cleaning must be used for sources that do not fit the shape -restrictions on FIND sources. Obviously, Clean and FIND may have to be used in -combination, in such a way that all source components in the model take the -form that best fits their real appearance. - - -\section{ Cleaning methods} % -\subsection{ Beam Clean = H\"ogbom Clean} -\label{.beam.clean} - - H\"ogbom's original \whichref{\bf Clean}{} method is known in Newstar -as {\bf Beam Clean}. It consists of repeatedly finding the highest point in -(part of) a map (the {\em search area}) and subtracting a source component at -that position from the entire map or some part of it (the {\em clean area}). -The subtracted component consists of the antenna pattern shifted and multiplied -by the peak intensity of the source and a {\em gain factor}. This factor is -usually chosen somewhat smaller then 1 to account for the fact that part of the -intensity found may be due to sidelobes from other sources. - - The subtraction may be problematic in cases where the shifted antenna -pattern does not cover the entire clean area. Moreover, the edges of both the -map and the antenna pattern are contaminated by aliasing effects. For this -reason cleaning is best restricted to an area somewhat less than the central -half of the map in both dimensions. - - In the NEWSTAR version, the search area coincides with the clean area. -It is defined as the union of at most 32 rectangles specified by the user. -Since subtraction occurs only in the search area, sidelobes in the remainder of -the map are not removed. It is therefore not advisable to successively clean -different areas; nor is it necessary, since NCLEAN allows you to specify all -relevant areas simultaneously. - - H\"ogbom Clean is controlled by the parameters - -\begin{itemize} -\item \textref{\bf LOOP\_GAIN}{nclean_private_keys.loop.gain}: the gain -factor; - -\item \textref{\bf COMPON\_LIMIT}{nclean_private_keys.compon.limit}: the -number of source components at which the process will stop; - -\item \textref{\bf CLEAN\_LIMIT}{nclean_private_keys.clean.limit}: the -absolute maximum intensity in the residual map at which the process will stop; - -\item \textref{\bf AREA}{nclean_private_keys.area} (prompt repeats until a -null answer is given): the map areas in which source components are looked for -and subtracted. % -\end{itemize} - -\label{.prussian.hat} - An additional parameter, -\textref{\bf PRUSSIAN\_HAT}{nclean_private_keys.prussian.hat}, allows one to -stick a delta-function peak on the centre of the antenna pattern, which in -certain cases gives better results (Cornwell ...). - - -\subsection{ UV Clean = Clark Clean } -\label{.uv.clean} - - {\bf UV Clean}, more hgenerally known as \whichref{\bf Clark Clean}{} -speeds up the cleaning of extended sources which must be represented by a large -number of closely spaced point-source components. Sources are found in the same -way as for H\"ogbom Clean. But rather than subtracting them one by one in the -entire search area, Clark Clean does only a provisional subtraction in a small -{\em patch} around the source position. Proper subtraction is done later by -jointly convolving the sources collected with the antenna pattern and -subtracting the result. - - The convolution is implemented through Fourier transformations and a -multiplication in the visibility plane, which is considerably faster than a -direct convolution in the map domain. However, this method suffers from -aliasing errors similar to those for Beam Clean and is therefore subject to the -same limitations. - - In UV Clean {\em minor cycles}, in each of which a single source -component is located and provisionally subtracted, alternate with {\em major -cycles} in which the newly found sources are properly removed. The number of -minor cycles between successive major cycles is controlled by an algorithm that -estimates the buildup of deviations in the residual map due to the provisional -nature of component subtractions. The user has a few parameters to control -this algorithm. - - UV Clean is controlled by the same parameters as H\"ogbom Clean. In -addition, the number of minor cycles to a major one is controlled by the -parameters: - -% -\begin{itemize} - -\label{.cycle.depth} -\item \textref{\bf CYCLE\_DEPTH}{nclean_private_keys.cycle.depth}: The lower -limit to components to be found in minor cycles relative to the present -absolute residual-map maximum. - -\label{.grating.factor} -\item \textref{\bf GRATING\_FACTOR}{nclean_private_keys.grating.factor}: A -multiplier to be applied to the estimate of the maximum error buildup in the -minor cycles. The default of 1 is supposed to guarantee that grating responses -will not erroneously be mistaken for source components. A lower value allows a -larger number of minor cycles per major cycle, but should be used only to the -extent that there is no danger of mistakes. The \textref{\bf COMPON}{.compon} -clean option can be used to explore this effect prior to starting serious work. - -\end{itemize} - - In map-making, a taper rising toward the map edges may have been -applied to the final map to componsate for the effect of the gridding -convolution in the UV plane. The parameter -\textref{\bf DECONVOLUTION}{nclean_private_keys.deconvolution} controls if the -effect of this must be taken into account in cleaning. - - -\subsection{ Data clean = Cotton-Schwab Clean} -\label{.data.clean} - - "Data" Clean is the somewhat unfortunate name given to the -"Cotton-Schwab" modification of \textref{Clark Clean}{.uv.clean}) in which the -model subtraction is done in the \textref{SCN file(s)}{scn_descr} from which -the map was originally made. In this way aliasing effects are completely -avoided, albeit at the expense of again much more processing. - - Since a Newstar map does not include a detailed bookkeeping of the SCN -files and control parameters with which it was made, the user has to respecify -them as part of the process. This is not as bad as it may sound, because no -harm will be done if the new map is made with different specifications provided -only that a corresponding antenna pattern is generated along with it. The user -may actually take advantage of this, e.g. by specifying a smaller map area if -he has found that that is all he needs. - - Since the antenna beam plays no role in source subtraction, the -\textref{\bf PRUSSIAN\_HAT}{.prussian.hat} parameter is not used in Data Clean. - - An important practical point to note is that {\em the residual map -overwrites the input map}. This is discussed further -\textref{below}{.residual.maps}. - - -\subsection{"Component" clean: A quick-and dirty Clean} -\label{.compon} - - Another Clean option is available in NCLEAN, in which only the -minor-cycle part of a Clark or "Data" Clean is performed. Since the -minor-cycle source subtraction is of a sloppy nature, the residual map should -{\em not} be used as a starting point for further investigations. However, the -source model can be used, e.g. as a starting point for -\textref{Selfcal}{ncalib.redun} or \textref{NMODEL UPDATE}{nmodel_descr}. - - Another possible use is to quickly explore the effect of the {\bf -CYCLE\_DEPTH} and {\bf GRATING\_FACTOR} -\textref{parameters}{.cycle.depth} before embarking on a lengthy Clark or Data -Clean. - - -\section{ Residual maps} -\label{.residual.maps} - - Residual maps have the same size as their parent map. For H\"ogbom and -Clark Clean, they are stored in the .WMP file from which the input map was -taken, under the index - - \verb/<group>.<field>.<channel>.<polarisation>.1.<sequence_number>/ - -where \verb/<group>.../ are the same as those of the input file, the type 1 -indicates a map and \verb/<sequence_number>/ is the first new number available. -Thus, derivatives of a map will form a contiguous sequence in the order in -which they were created. - - For Data Clean the residual map is written in place of the original. -The idea behind this is that, unlike for the other Clean modes, one may -backtrack from a Data Clean operation without recourse to the input map: What -one does instead is to discard the newly found model components and then -regenerate the input map with the previous model. - - In whichever way one cleans, backtracking implies that one must keep -track of which residual maps are rejected. There is (as yet?) no mechanism -available to remove them from a .WMP file except for selectively -\textref{copying}{nmap_descr.copy} maps to a new .WMP file. - - - -\section{Missing items to be added} -\label{.missing} - -\begin{itemize} -\item Litterature references -\item Beam-patch calculation and other details of minor-cycle clean -\item RESTORE details -\end{itemize} - - - diff --git a/src/doc/latex/ncopy_descr.tex b/src/doc/latex/ncopy_descr.tex deleted file mode 100644 index 88878c60f5e280dea3ec024e75617dc129c536e9..0000000000000000000000000000000000000000 --- a/src/doc/latex/ncopy_descr.tex +++ /dev/null @@ -1,105 +0,0 @@ -% -% @(#) ncopy_descr.tex v1.1 08/02/94 JPH -% -% JPH 940927 Remove non-standard constructs - -% -\chapter{The Program NCOPY} -\tableofcontents - -\section{General} - - NCOPY is a program to selectively copy data from an input to an -output SCN file. Its basic use is to condense SCN files by -\begin{itemize} - -\item selecting only those sectors, scans and polarisations that one wants -to retain; - -\item eliminating "holes" in a file that are no longer used. -\end{itemize} -As an ancillary function, NCOPY can produce overviews of all sectors in a SCN -file. - - - -\section{NCOPY options and keywords} -\begin{itemize} -\item OVERVIEW: Produce on terminal and in the log file a listing of all -sectors in a file. In addition to the layout (as for NFLAG SHOW) and file -size, the following is shown for each sector: - - {\sf g.o.f.c.s} and absolute sector numbers; - field name and WSRT observation number; - frequency and bandwidth; - hour-range and number of scans; - numbers of interferometers and polarisations; - technical information for testing/debugging purposes (subject -to change). - -The information relevant to the user is crammed into the width of a terminal -window. - -\item COPY: Copy sectors. The following additional information is requested -once for every time the COPY option is selected: - -\indent INPUT\_SCAN \\ -\indent OUTPUT\_SCAN \\ -\indent INPUT\_SECTORS \\ -\indent HA\_RANGE \\ -\indent POLARISATION \\ - - Data will be appended to the output file. If the latter does not -exist, a new file is created and its creation reported. - - A new output group is created for every input group, the -remaining indices, o.f.c.s, being taken from the input. -\end{itemize} - - -\section{Multiple references to the same physical sector} - - This section is relevant only for cases where the input SCN file -contains sectors that are referred to through more than one g.o.f.c.s -reference. The only ways such multiple references may have been created is -through the NSCAN REGROUP option or through an earlier NCOPY COPY operation as -described below. - - To understand the implications of multiple references for NCOPY, -one must understand the distinction between {\em physical sectors} and {\em -sector references}. The former hold the physical data and are therefore -unique. The references are small data structures embodying the g.o.f.c.s -hierarchical indexing structure through which the physical sectors are -accessed. - - An input physical sector specified repeatedly in a {\em single} COPY -operation will be copied only once. If the INPUT\_SECTORS specification either -explicitly or implicitly refers to the sector more than once, a single -physical copy is made, along with a copy of each of the references to it. - - If an input sector already copied is selected again in a {\em new} -COPY operation, the correct response would be to make a new reference to the -output sector already in existence. However, NCOPY has no way of knowing which -sectors were already copied in the past, so a new independent copy of the -entire sector will be made. - - -\section{Possible later extensions} - - As future options, to be realised only upon user demand, we -consider: -\begin{itemize} - -\item integration of data over hour-angle intervals; - -\item selection of interferometers; - -\item definition of output sector numbers by the user and (partial) -correction of the deficiencies noted above; - -\item permanent application of corrections to the stored data as foreseen in -the original Newstar design. - -\end{itemize} - - diff --git a/src/doc/latex/ncopy_progrmr.tex b/src/doc/latex/ncopy_progrmr.tex deleted file mode 100644 index 941f5f7b15599d4bf38e35066444f9feabaefd2a..0000000000000000000000000000000000000000 --- a/src/doc/latex/ncopy_progrmr.tex +++ /dev/null @@ -1,238 +0,0 @@ -\chapter{NCOPY programmmer's documentation} - -{\em Contributed by JPH, 940208. \\ -Updates: - JPH 941031 Clarify handling of APPLY/DEAPPLY masks before and -after changes of October 1994. -\\ JPH 941121 prefix underscores with slashes -} -\newcommand{\bi}{ \begin{itemize} } -\newcommand{\ei}{ \end{itemize} } - -\tableofcontents - - -\section{ Overview} - - NCOPY Phase 2 is still a relatively straigthforward program. The -structure follows standard Newstar practice, with a main dispatching routine -NCOPY, initialisation and user-parameter input routines NCOINI and NCODAT, and -routines NCO$<$xxx$>$ that do the actual work. Some parameter input may be done -by the latter. - - There are currently two main options: -\bi -\item COPY: To selectively copy (parts of) sectors. - -\item OVERVIEW: To display an overview of all sectors, one sector per line. -\ei - -\section{ NCODAT } - - NCODAT is basically a clone of NSCDAT and follows the same kind of -logic. It is just as dull as all the other $<$xxx$>$DAT routines. - - Note however, that it calls WNDDA0 rather than WNDDAB as do the other -routines. As a consequence, the APPLY and DE\_APPLY masks (COMMON variables CAP -and CDAP) were left at their initial values of 0. - - This was changed in the release of October 1994. NCOCPY now prompts for -these masks with defaults NONE/ASK. These defaults reproduce the old behaviour, -but the user now has the option to "freeze" certain corrections "in" in the -visibilities. Since WNDDA0 does not allow dynamic setting of defaults, WNDPAP -is called for this purpose. (This option was requested by A.G. de Bruijn as a -tool to handle non-isoplanatic errors, such as may occur with a strong source -on the flank of the primary beam being affected by pointing errors to which the -field centre is essentially insensitive.) - - -\section{ NCOOVV: Sectors overview } - - NCOOVV accesses all sectors specified by the user in the standard way -through repeated calls to NSCSTG. For each sector it formats a line of salient -data. - - Special care had to be taken to make these lines fit on a standard -80-character screen: Since WNCTXT prefixes a blank, and terminals intend to -insert a line feed when a line is exactly 80 characters long, the actually -available line length is only 78 characters. Terminal width is set to this -value. - - Additional information may be displayed in the log, for which the width -is set to 131. Currently, pointers are displayed for diagnostic use. - - To make the display of hierarchical sector indices legible, a -3-character fixed-format length is used for each index, and leading indices -that are the same as in the nprevious line are suppressed. - - -\section{ NCOCPY: Copy sectors } - -. For a number of variables and data structures, NCOCPY has an input and -an output copy, which are distinguished by the prefixes I and O: IPLN $vs.$ -OPLN, etc. This is in anticipation of their I and O values being different, as -some already may be, line ISCN and OSCN. Pairs that are currently identical are -linked by EQUIVALENCEs, $e.g.$ INIFR and ONIFR. "O" variables that are not -equivalenced must be explicitly assigned. - -. The basic logic of NCOPCPY is straightforward. NSCSTG is repeatedly -called to read sectors. Each sector's HA range is checked against the user's -range and first and last scan numbers to be copied, SCNFST and SCNLST, are -established. The condition that the output need no more polarisations than -present in the input is also checked. - -. ISTH is then copied to OSTH and written tentatively, with as many -changes as possible already made; its address is saved for a later rewrite. -Next, the IFR table is copied and the file address of the scans block -established. - -. The WSRT headers are copied in an internal subroutine at label 2020. -This routine consists of calls to: -\bi -\item NSCSCR: read SCH; read raw uncorrected scan visibilities into -4-polarisation c/s and weight arrays, using STH and SCH dimension parameters -such as PLN and NIFR. - -\item NSCSDW: write scan from these arrays, again using dimension parameters. -\ei -. Modifications to the scan are made in between. - -. The model lists and visibilities are copied in an internal subroutine -at label 2010. - -. Finally, the newly made sector is linked into the index structure. The -code is patterned after that of NSCREG. - - -\subsection{ Output sector numbering } - - Output sector indices are copied from the input except for the first -one, the group index. This index is automatically assigned the first available -number for each new group being processed, that is: For every new COPY request -and for every new input group within a COPY request. This method of assignment -is the simplest way to avoid collisions in output indices; alternatives should -only be considered if users ask for them. - - -\subsection{ STH modifications } - - - NCOCPY is responsible for the following OSTH fields that differ from -their ISTH peers: -\bi -\item HAB, SCN: reflect the user's HA selection. - -\item PLN: the number of polarisations in the output. - -\item NIFR: number of output interferometers (currently identical to input). - -\item SCNL: scan length (depends on NIFR, PLN). - -\item REDNS, ALGNS, OTHNS: zero the Y components if only XX data present. - -\item pointers to other data structures. -\ei - - -\subsection{ SCH modifications } - - NCOCPY is responsible for the following OSCH fields that differ from -their ISCH peers: -\bi -\item MAX: maximum of C/S values REDNS, ALGNS, OTHNS. - -\item OTHNS: zero the Y components if only XX data present. -\ei - -\subsection{ NCOCPB: Make unique copy of a data structure } - - Several input data structures may be linked by more than one pointer, -and each link might give rise to a separate copy. For copying such structures, -NCOCPB must be used. It maintains a checklist of input file addresses of blocks -it has already copied, with the corresponding output file addresses. The -calling program is responsible for allocating a buffer for this list and -initialising it through a special call to NCOCPB. Details of this and other -variant calls are to be found in NCOCPB's header. - - Since there can(?) be no duplications of data structures between -groups, the checklist is reinitialised for every new input group. - - The blocks that may have multiple references are: -\bi -\item FDW for all sectors in a mosaic: 1 -\item OHW for all sectors in the same field: 128 fields -\item SHW for all sectors at the same frequency: 8 frequencies. -\item MDH for all sectors in the same field: 128 fields -\ei - - -\section{ Tests } - -. The following tests were made to check NCOPY: -\bi -\item Copy sectors from the same input SCN file with various selection -parameters. Check outputs with OVERVIEW and compare samples of headers and data -with NCOPY SHOW. - -\item Copy one 4-polarisation input sector to three output sectors, selecting -XYX, XY and X polarisations. Make 4 XX and 3 YY maps from the input amd output -sectors and compare the map statistics through -. - {\sf sdiff -s -w 80 $<$log1$>$ $<$log2$>\ |$ grep '-$<>$'} -\ei - -\section{ Modification history } - -\subsection{Copying flags (9401..-940207) } - - Upon request of Ger de Bruijn, all input flags are also copied to the -output. To this end, the calls to NSCSCR and NSCSCW have been changed to calls -to NSCSCF and NSCSFW, respectively. These have an extra parameter in which the -flag settings from the input are transferred to the output. - - The new entry points exist in the new version of NSCSCR and NSCSCW -which are still being tested in JPH's shadow system. - - If desired, it is very simple to add code to suppress the copying of -flags. - - Test: - Use a 720-scan single-polarisation file. NFLAG, flag\_option DETERM, -ops\_determ PBAS, pbas\_limits=0,200. This results in 18% SHAD flags being set -in a 270-scan single-polarisation file. flag\_option INSPECT, ops\_inspect IFR -gives an overview per interferometer. - Copy the file with NCOPY and test the copy with NFLAG, flag\_option -INSPECT, ops\_inspect COUNT, select\_flag ALL, sub\_cube NO. This gives the -same result. - - -\section{ Bug history } - -\subsection{ Checklist overflow (de Bruijn, 940207) } - -Corrections: - -\bi -\item Do not use NCOCPB for STH addresses. Multiple references to STH can -only occur due to a NSCAN REGROUP operation which is very rarely used. Multiple -copies of an STH can not be prevented between COPY operations. The user is -already responsible for avoiding those and now has the added responsibility of -avoiding REGROUP duplications. - -\item Reinitialise checklist for each new input group. - -\item Souble checklist size to handle the largest predicted mosaic observation -\ei - -Test: - Copy a simple observation A to B, then B to C, and verify that -overviews of B and C are identical. - - - - - - - - - diff --git a/src/doc/latex/nflag_descr.tex b/src/doc/latex/nflag_descr.tex deleted file mode 100644 index 17935fa65b2a2831d8cd34fe2ee8e6ebbcadbcde..0000000000000000000000000000000000000000 --- a/src/doc/latex/nflag_descr.tex +++ /dev/null @@ -1,746 +0,0 @@ -% -% @(#) nflag_descr.tex v1.2 04/08/93 JEN -% HjV 950615 Separate parts by indenting text or by using two blank lines -% JPH 951016 Revision -% -\newcommand{\Em}[1]{{\em #1\/}} -\newcommand{\bi}{ \begin{itemize} } -\newcommand{\ei}{ \end{itemize} } - - -\chapter{The Program NFLAG} - -\Em{\center -Contributed by Johan Hamaker, October 1995.\\ -Revision of original docyment by Jan Noordam, August 1993. -} - -\Em{ -This is a preliminary version of a new document replacing the old version of -August 1993 by J.E. Noordam. The information in it is thought to be accurate -but known to be incomplete. It should, however, in its present from help the -user to get to grips with NFLAG's overwhelming user interface and functionality. -} - -\tableofcontents - -%================================================= Standard subsection ======= -\section{Overview} -\label{.overview} - - The basic function of NFLAG is to mark visibility points in a .SCN file -as faulty by 'flagging' them, i.e. by setting bits in the 'flag mask' -associated with each point. In general, visibilities thus flagged will be -considered no longer to exist; in this sense flagging is equivalent to -deletion, but unlike deletion it is reversible, i.e. flag bits can be cleared -at a later time. It is also possible to instruct processing programs to ignore -flag bits and treat flagged visibilities as valid. - - A secondary function in NFLAG, not further described here, is the SHOW -option through which one may explore the contents of a .SCN file. For a -description, see the descriptions of \textref{NSCAN}{nscan_descr} and its -\textref{parameter interface}{nscan_private_intfc}. - - -\section{ The \NEWSTAR flags concept} -\label{.flag.concept} - - The simplest way to get rid of bad visibilities is by \Em{deleting} -them. Typically this is done by replacing each bad value by a special value -that processing programs recognise as an instruction to ignore the data point. -Since its original value is overwritten, a deleted data point is irreversibly -lost. - - The first step toward refinement is to \Em{flag} visibilities as bad -without overwriting them; processing programs ignore those data for which the -flag is set. Since the original value is retained, is can be 'undeleted' by -clearing the flag; flagging is therefore also known as 'reversible deletion'. -This method is a well-known one, because it is implemented AIPS. - - In \NEWSTAR, it is carried a step further by differentiating between a -number of different reasons for which a visibility may be considered bad. -Rather than a single flag, \NEWSTAR associates a complete \Em{flag byte} with -each visibility point: Thus one has not a single bit to play with, but eight -different ones. The advantage of this approach is that different flagging -operations can be treated independently of one another. This makes it possible -in many cases to backtrack form a flagging operation that produced undesirable -results and thus introduces an important margin of safety: For instance, a -selection made in a laborious manual flagging session cannot be accidentally -undone by a subsequent automatic clipping operation going wrong. - - Five of the eight bits in the flag byte are used by NFLAG, the user may -use the remaining three in whichever way he wishes. By default, programs bypass -all visibilities for which any one of the eight flags is set; it is also -possible, however, to instruct a program to ignore certain flags. The three -user-definable flag-types can be used for experiments with different selections -of uv-data. (This is analogous to the use of different flag tables in AIPS.) - - Below is a list of the flags defined by \NEWSTAR. The numbers shown in -parentheses are the bit number (LSB=0) and hexadecimal values for these flags: -\bi - -\item MANUAL (bit 7, 80): NFLAG sets this flag when the user explicitly -selects data points for flagging by specifying their coordinates (sector index, -hour-angle range etc.) - -\item CLIP (bit 6, 40): This flag is set in operations that select bad data -by comparing them against some limit, e.g. a maximum for their cos or sin -components or their selfcal residual amplitiude. - -\item NOISE (bit 5, 20): This flag is set in operations that select groups -of bad data by checking their noise levels, e.g. those that NCALIB has -calculated and stored in the .SCN file in a \whichref{REDUN}{} or -\whichref{SELFCAL} operation. - -\item ADDitive (bit 4, 10): This flag is set in operations that select -groups of bad data by comparing their average value against some limits - -\item SHADowing (bit 3, 08): This flag is set in operations that select bad -data on the basis of some function of their coordinates, e.g. the length of the -projected baseline or a geometry in which shadowing occurs. - -\ei -The remaining three bits are known as U1 (bit 2, 04), U2 (bit 1, 02) and U3 -(bit 0, 01). - - The \NEWSTAR visibility flagging scheme gives the user unprecedented -flexibility for reversible data-editing, although its very power makes it a -little more difficult to understand and use than a simple scheme such as AIPS's. - - -\section{ Flagging logistics} -\label{.logistics} - - The only program that actiually sets and clears flags is NFLAG. It -contains a number of options to select bad data on a varied range of criteria -and set flags accordingly. To verify the effect, it also offers the option to -\whichref{count flags}{.} over various cross-sections or projections of the -\textref{data hypercube}{scn_file.hypercube} and \whichref{tabulate}{.} the -results. - - Another option is to select flags on a display of some two-dimensinal -cross section through the hypercube, using the program \whichref{NGIDS}{}. -NGIDS then produces a file with flagging commands which may subsequently be -\whichref{read and executed} by NFLAG. - - On a micro-level, it is possible to inspect the individual flag bytes -in individual scans through the \textref{SHOW}{.overview} option. - - -\subsection{ Visibility and scan-header flags} -\label{.header.flags} - - In addition to the flag bytes associated with the individual -visibilities, the \textref{scan header}{scn_file.scan} also contains a flag -byte. Through the flags in this byte one may invalidate the scan as a whole. -This is obviously a more expedient way to handle flagging, since a single -computer instruction will flag or test the entire scan. - - In the present implementation of NFLAG, visibility flagging and -scan-header flagging operate independently. That is, when the header is flagged -the corresponding flags on the individual visibilities are left unchanged, and -if the header is later unflagged those flags come back into force. On one hand -this introduces some additional independence between different flagging -operations as discussed \textref{above}{.flag.concept}. On the other hand it -forces upon the user a technical distinction between two types of flagging that -are functionally equivalent: The user must contend with such flagging -operations as -% -\textref{HASCANS}{nflag_private_intfc.ops.scans}, -\textref{CLHEAD}{nflag_private_intfc.ops.manual}, -\textref{TOHEAD, TODATA}{nflag_private_intfc.ops.fcopy}, -statistics specifiers such as -\textref{SCANS}{nflag_private_intfc.ops.statist}. -(Unfortunately, the keywords used are not an example of clarity and -consistency...) - - - -\section{ Primary and secondary visibility (hyper)cubes} -\label{.hypercubes} - - We assume here that the concept of the visibility -\textref{hypercube}{scn_file.hypercube} is understood. We recall that the -group/observation, mosaic-subfield, frequency-channel and (for a mosaic -observation) the successive hour-angle 'cuts' are selected through the compound -\textref{sector index}{scn_file.SCNSUM.indices}; the scan's hour-angle, and -within a scan the interferometer and polarisation are selected by direct -specification. - - At the very start, NFLAG asks you to select a \Em{primary data -hypercube} to operate on, through the parameters -\bi{} -\item\Textref{SCN\_NODE}{scnnode_public_intfc.scn.node}: - .SCN file; -\item \Textref{SCN\_SETS}{scnsets_public_intfc.scn.sets}: - sets of sectors, i.e. one ore more combinations of group, observation, - mosaic subfield, frequency channels and hour angle cuts; -\item \Textref{HA\_RANGE}{select_public_intfc.ha.range}: - hour-angle range; -\item \Textref{SELECT\_IFRS}{select_public_intfc.select.ifrs}: - interferometers; -\item \Textref{SELECT\_XYX}{select_public_intfc.select.xyx} - polarisations. -\ei - -\noindent This primary cube may later be redefined partly or completely through -the MODE branch of NFLAG which is accessible from \whichref{several places}{.} -in the program. - - For certain operations, one may narrow down the range of visibilities -to be operated on by defining a \Em{secondary hypercube}; the data volume -operated upon will then be the cross section of the primary and secondary -cubes. Secondary-cube definition is limited to the latter three of the -parameters listed above; note, in particular, that it is not presently possible -to define a secondary frequency-channel range because that definition is part -of the SCN\_SETS parameter. - - A word of caution is in order about the effect of data-cube definitions -in operations that affect the \textref{\Em{scan-header}}{.header.flags} flags. -Since such actions operate on the entire scan, \Em {the ranges of -interferometers and polarisations (parameters \Em{SELECT\_IFRS} and -\Em{SELECT\_XYX}) that you defined for your hypercubes have no effect}. - - -\section{ The flagging branch of NFLAG} -\label{.flagging.branch} - -\input{../fig/nflag_flag.cap} - -\input{../fig/nflag_operate.cap} - - The flagging branch is where the actual work of NFLAG is done. All -commands that change flag setting on visibility points or scan headers are to -be found here. The flagging options are shown in the upper left box in -\figref{.nflag.flag} A detailed overview of the branch is given in -\figref{.nflag.operate}. - - -\section{ The INSPECTion branch of NFLAG} -\label{.inspection.branch} - -\input{../fig/nflag_inspect.cap} - - The purpose of the inspection branch is to provide overviews of the -flags present. Generally speaking, the bulk of the visibilities is much too -large for making useful graphic or tabular representations of the individual -flag settings. For most purposes, however, the information one needs can be -represented in the form of tables of flag counts along various cross-sections -of the visibility hypercube. Such tables is what the inspection commands -produce. - - A schematic overview of the branch is given in \figref{.nflag.inspect}. - - From the INSPECT branch, it is possible also to make a detour into the -\textref{MODE}{.mode.branch} or \textref{STATISTICS}{.statist.branch} branch. - - -\section{ The STATISTics branch of NFLAG} -\label{.statist.branch} - -\input{../fig/nflag_statist.cap} - - The purpose of the statistics branch is to provide statistical -overviews of the visibility data. Generally speaking, the bulk of the -visibilities is much too large for making useful graphic or tabular -representations of the individual values (except with \whichref{NGIDS}). For -flagging purposes, however, much of the information one needs can be -represented in the form of tables of data statistics along various -cross-sections of the visibility hypercube. Such tables is what the statistics -commands produce. - - A schematic overview of the branch is given in \figref{.nflag.statist}. - - From the STATISTICS branch, it is possible also to make a detour into -the INSPECT branch. - - -\section{ NFLAGS environment paremeters: The MODE branch} -\label{.mode.branch} - -%\input{../fig/nflag_mode.cap} - - - -\section{ Selection of bad visibilities on an X11 display } -\label{.x11} - -\input{../fig/nflag_gids.cap} - - For detailed point-by-point flagging of visibilities the flagging modes -of NFLAG are much too cumbersome. For this purpose one may instead use a -combination of -\bi -\item NGIDS, to select data points with a cursor on a two-dimensional display -of a cross section through the visibility hypercube in which data values are -represented by colours; - -\item NFLAG, to do the actual flagging of the selected points. -\ei -The procedure is schematically represented in \figref{.nflag.gids}. - - -.c+ - -{\bf The user is urged to work through the examples in this section before -starting to use NFLAG. Quite a lot of valuable (and sometimes essential) -information is available in the on-line HELP text.} - - - -%------------------------------------------- Option NFLAG subsubsection ------ -\newpage -\subsection{Example: two flagging operations} -\label{.example1} - - This example has been annotated, so that it may serve as a first -introduction to the use of NFLAG option FLAG. Starting with an unflagged -SCN-file, two successive flagging operations are shown, using two different -flag types (MANUAL and SHADOW). The results of this particular example -are shown in the description of NFLAG option SHOW, later in this section. - - -**** Put new script here *** - - -{\it The other FLAG\_OPTIONs deal with the NFLAG internal flag list: -Clearing it and copying flags to/from the two types of flag files. -This will be dealt with in a later example of GET/PUT. -Now the uv-data hypercube will be defined, to which the subsequent -(un)flagging operations will be limited:} - - -**** Put new script here *** - - -{\it In an FILLED data hypercube, all interferometers and all polarisations are -selected. Some operations will then set flags in the Scan header, rather than -in the individual uv-data. The user should be aware of this when inspecting -flags, and in subsequent unflagging operations.} - - -**** Put new script here *** - - -{\it At least one FLAG\_MODE must be specified here, e.g. FLAG. -The specified FLAG\_MODEs will be active from here onwards. -NOCORRECT indicates that no corrections will be applied to the uv-data when -they are read in. -In the following (un)flagging operations, their default flag types will be -used, since we have not used the option UFLAG to override them.} - - -{\it First, some individual interferometers will be flagged, using the manual -operation IFR. Its default flag has type MANUAL. This operation has its own -interferometer selection, which can only {\em narrow} the hypercude specified -above.} - - -**** Put new script here *** - - -{\it The message per (affected) Scan is the result of the flag-mode SHOW, -which will now be turned off. The second operation that will be -shown here is the flagging of uv-data that are affected by `shadowing', -i.e. the partial blocking of the field of view of one telescope by another. -This is called a `deterministic algorithm', since it only uses known -instrumental parameters like HA, elevation and telescope position. -The operation has the default flag type SHADOW.} - - -**** Put new script here *** - - -{\it For real flagging of shadowed data, the actual diameter of 25m for WSRT -telescopes should of course be given here. This example is to demonstrate -a serendipitous alternative use of this operation, i.e. the flagging of -all baselines with a {\em projected} size of less than 200m.} - - -{\it The result of these two flagging operations may now be verified -with NFLAG option SHOW. This is done, for this particular example, in -the description of option SHOW at the end of this section.} - - -**** Put new script here *** - - -%------------------------------------------- Option NFLAG subsubsection ------ -\newpage -\subsection{Example: resetting all flags} -\label{.reset} - -The following example is very important for users who have lost their way -in the many options and operations of NEWSTAR flagging, and want to start -with a clean slate. It also emphasizes the two questions that users should -constantly ask themselves: Which flag types are being affected, and are they -affected in the Scan header or in the individual uv-data? - - -**** Put new script here *** - - -{\it Note the use of UFLAG to select all (8) flag types, This overrides the -default flag types of any subsequent flagging operations.} - - -**** Put new script here *** - - -{\it This takes care of the flags in the individual uv-data. To make sure -that also the flags in the Scan headers are reset, another operation must -be performed:} - - -**** Put new script here *** - - -{\it Now all flags in this SCN-file have been reset. -This may be verified with NFLAG option SHOW.} - - - -%------------------------------------------- Option NFLAG subsubsection ------ -\newpage -\subsection{The internal flag list: GET and PUT} -\label{.list} - -The program NFLAG uses an internal flag list to store flags temporarily -in the process of copying them from one place to another. This is -illustrated in the block diagram NFLAG\_001.fig. - - -The flag list can be filled in either of two ways: - -\begin{enumerate} -\item -From the uv-data in the SCN-file, in one or more GET operations. The user -should keep in mind that each GET operation will add entries to the list. -the list should be explicitly CLEARed when necessary. -\item -From one of the two kinds of flag file, i.e. an FLF-file (LOAD) or an -ASCII flag file (READ). The reverse operations (UNLOAD and WRITE) are -also possible. -Thus, to store flags that are set in a SCN-file in a flag-file, they must -first be GOT into the internal list, and then UNLOADED or WRITTEN to -a flag-file. -\end{enumerate} - -The PUT operation, with which flags are copied from the internal flag list -to the uv-data is very powerful, because it is possible to specify a -socalled PUT\_RANGE. This is a range in the four `dimensions' channel, HA, -ifr and polarisation. For each entry in the flag list, not only the -corresponding uv-data point will be flagged, but a 4-dimensional hypercube -around it. For example: if some automatic algorithm has detected interference -in one frequency channel, it is possible to flag all frequenct channels at -that particular HA and ifr in this way. - -%------------------------------------------- Option NFLAG subsubsection ------ -\newpage -\subsection{The two kinds of flag files} -\label{.file} - -Flags may be stored into two different files: the FLF-file is (much) smaller -because the information is stored in a compact format. The same information -can also be stored in an ASCII file (default name FLAG.LOG), which can be -inspected and edited with a normal text editor. It is up to the user to -choose between these two kinds of file. - -When printed, the ASCII file looks as follows: - -\begin{verbatim} -> more FLAG.LOG - !+ Flagging file FLAG.LOG - ! Created by NOORDAM on 930715 at 17:06:18 at rzmws0 - ! Flags: - ! MAN : 80 CLIP: 40 NOIS: 20 ADD : 10 - ! SHAD: 08 U3 : 04 U2 : 02 U1 : 01 - ! Types: - ! 00: Interprete Ifr field as interferometer - ! 01: Interprete Ifr field as baselines in m - ! Data following an ! are seen as comments - ! Remaining fields have format: - ! *: all values - ! value: single value - ! val1=val2: value range (inclusive) - ! - !- - !Flag Type Channel Hour-angle Ifr Pol - 40 00 0 -88.74 * * - 40 00 0 -88.49 * * - 40 00 0 -88.24 * * - 40 00 0 -87.99 * * - 80 00 0 -10.02 * * - 80 00 0 -9.77 * * - 80 00 0 -9.52 * * - 80 00 0 -9.27 * * - 80 00 0 -9.02 * * - 80 00 0 -8.77 * * -\end{verbatim} - -Note the two flag types, MANUAL (80) and NOISE (40), which have obviously been -set in two different flagging operations. -{\it (NB: the use of the word `type' for the second column is a bit cunfusing -here: it has no relation to the flag type!)} - - -%============================================================================ -\newpage -\section{Interactive flagging using NGIDS} -\label{.interactive} - -In the following, a complete sequence of steps will be shown: -~\\ - Making a `map' of uv-data in a WMP file, using NMAP -~\\ - Displaying the uv-data on the screen, using NGIDS -~\\ - Specifying areas of uv-data to be flagged, using mouse and NGIDS -~\\ - Writing the flags from NGIDS to an ASCII flag-file -~\\ - Printing the ASCII flag-file to inspect it -~\\ - Reading the flags into the NFLAG internal flag list -~\\ - Copying the flags to the uv-data in the SCN-file, using PUT -~\\ See the block diagram NFLAG\_001.fig. - -%------------------------------------------------------------------------ -\subsection{Putting the uv-data into a WMP file} -\label{.interactive.wmp} - -**** Put new script here **** - - -%------------------------------------------------------------------------ -\subsection{Displaying the WMP file with NGIDS} -\label{.interactive.display} - -**** Put new script here **** - -%------------------------------------------------------------------------ -\subsection{Interactively specifying flags in NGIDS} -\label{.interactive.flag} - -**** Put new script here **** - -%------------------------------------------------------------------------ -\subsection{Transferring flags with an ASCII flag file} -\label{.interactive.flag.file} - -**** Put new script here **** - - -\begin{verbatim} -> more DEMOFLAG.LOG - - !+ Flagging file DEMOFLAG.LOG - ! Created by NOORDAM on 930724 at 17:18:00 at rzmws0 - ! Flags: - ! MAN : 80 CLIP: 40 NOIS: 20 ADD : 10 - ! SHAD: 08 U3 : 04 U2 : 02 U1 : 01 - ! Types: - ! 00: Interprete Ifr field as interferometer - ! 01: Interprete Ifr field as baselines in m - ! Data following an ! are seen as comments - ! Remaining fields have format: - ! *: all values - ! value: single value - ! val1=val2: value range (inclusive) - ! - !- - !Flag Type Channel Hour-angle Ifr Pol - 80 00 * -62.67 6D * - 80 00 * 7.52= 38.10 9D * - 80 00 * -28.08= 32.59 1B=8B * -\end{verbatim} - -**** Put new script here **** - - -{\it This is not quite the result we expected. A GET operation produces a -separate entry for every HA-Scan. What we see here is the compact notation -produced by NGIDS. This is partly explainable: we have forgotten to -CLEAR the internal flag list of NFLAG before doing the GET operation -(remember that each GET {\em adds} entries to the list). -But we must conclude that GET has not added any entries to it in this -case, so there must be something wrong.....} - - -%================================================= Standard subsection ======= -\newpage -\section{NFLAG option SHOW} -\label{.show} - -{\bf The option SHOW} allows the user to inspect the contents of a SCN-file: -the general layout, the contents of headers at the various levels -(i.e. file header, Sector header and Scan header), and the uv-data itself. -Until july 1993, this functionality used to be part of the program NSCAN. -Its use is demonstrated in some detail in another section of this Cookbook: -`Description of the NEWSTAR SCN-file'. In this section, we will only -draw attention to the use of the SHOW option to inspect flags that are set -in the uv-data or in the Scan header. - - -%------------------------------------------- Option SHOW subsubsection ------ -\subsection{A short tour of SHOW} -\label{.show-tour} - -The NFLAG option SHOW allows the user to inspect the SCN-file at successively -deeper levels: File layout and header, Sector header, Scan header (including -header flags) and finally Scan data (including weights and flags): - -**** Put new script here **** - -%------------------------------------------- Option SHOW subsubsection ------ -\subsection{Inspecting flags per Sector} -\label{.show-sector} - -It is possible to inspect the total number of flags for each interferometer -in a Sector (i.e. many consecutive Scans). Each flagged uv-data point is -counted for `one', even if more than one of the 8 flag types have been set. - -**** Put new script here **** - - -%------------------------------------------- Option SHOW subsubsection ------ -\subsection{Inspecting flags per Scan} -\label{.show-scan} - -The flag-bytes of individual uv-data can be inspected too: - -**** Put new script here **** - -The flag code is the sum of the codes of all the flag types that are set -for a particular uv-data sample. Thus, for some only the flag of type -MANUAL (80) is set, for others only type SHADOW(08), and a few have -them both (88). - -Note that the weights of all uv-data that are flagged (any flag type) have -been made negative. This is used internally, to speed up NEWSTAR programs. - -%------------------------------------------- Option SHOW subsubsection ------ -\subsection{Inspecting flags in the Scan header} -\label{.show-header} - - -If flags are set in the Scan header, they may be inspected as follows: - -**** Put new script here **** - -The flag (type MANUAL, code 80) is visible in BITS. - - -%================================================= Special subsection ======== -\newpage -\section{Ideas for improvements} -\label{.improve} - -Efficient data editing is now the highest priority for NEWSTAR. The program -NFLAG, and the interactive flagging option in the program NGIDS, have been -created in a very short time, to meet the needs of important new NEWSTAR users -(notably the WHISP project and the operational groups in Westerbork and -Dwingeloo). Although some of the most important options have been implemented -(and partly tested), there is ample room for improvement. - -The user is invited to add ideas and suggestions to the list below. This list -is not necessarily in order of importance, and certain things will not get done -very soon. Some ideas can be implemented rapidly: the program NFLAG has been -designed as a frame-work, in which a wide range of flagging operations can be -relatively easily provided and/or modified. Other improvements are clearly -desirable, but the required effort may not be justifiable for an interim -package (waiting for AIPS++). However, the list below will play an important -role in determining the list of priorities for the fall of 1993. - -\begin{itemize} - -\item -Flagging operation ARESID (comparable to RRESID at level OPERATION\_0). -The Align/Selfcal residue for each -indivudual uv-data point is used as a criterion to flag that data point. -The advantage over RRESID is that all interferometers are involved. -The disadvantage is that a good source model is required. -The most urgent application is the treatment of calibrator observations -(for which good models exist) by the operational NFRA groups. - -\item -Flagging operation DCOFFSET, to detect DC offsets caused by the ageing -correlator. - -\item -Automatic batch procedures (ABP) for certain flagging operations, -for use by the operational groups in Westerbork and Dwingeloo. -Ideally, they should lead to a succinct Quality Report for a particular -observation, possibly with suggestions for action if necessary (Expert -System). - -\item -Easy availability of the necessary information to set limit values for -flagging criteria. For instance, the overall Redundancy noise for the -entire Sector when using the operation RRESID. - -\item -The possibility of using `general' limit values for flagging criteria, -instead of explicit numeric values. -For instance: upper limit is 2*REDNS, or 3.5*SIGMA etc. - -\item -More detailed inspection tools for the flags that are set in the uv-data. At -this moment there is only the possibility to show all flags (of any type) per -interferometer for a particular Sector. This is only useful to see whether or -not a certain interferometer has been flagged. Moreover, it is cumbersome to -have to leave NFLAG option FLAG, and to enter NFLAG option SHOW. - -\item -A SHOW option to view the internal flag list. Perhaps this could be -gradually extended to a full set of tools to edit the flag list, comparable -to the tools for a list of source model components. - -\item -More user-friendly interactive flagging with the NGIDS display. -This includes better use of available GIDS functionality to -indicate data to be flagged, and improvement of the display of vital -reference data (ifr, baseline, HA, channel, value etc) at all times. - -\item -At this moment, the NFLAG flagging operations work directly on the uv-data -in the SCN-file. It might be preferable to collect the flags in the internal -flag list first, to be copied to the uv-data (PUT) or an external file after -inspection. - -\item -Reading the uv-data into NGIDS directly from the SCN-file. -The present implementation requires the intermediairy steps via the program -NMAP and the WMP file. This was easier to implement, but is more cumbersome -for the user. Ideally, the user would of course like to interact directly -with the uv-data in the SCN-file, in both directions (like in AIPS TVFLAG). - -\item -In some ways, it may be easier to determine which uv-data are `bad' from the -the line graphics plots produced by NPLOT. - -\item -Filtering operations on frequency-spectra, comparable to the AIPS option UVLIN. -The latter simply calculates and subtracts the average from the spectrum of -each individual uv-sample, to `remove' the continuum, and thus to enhance the -line. This technique could be -refined to subtracting low-order polynomials from the spectra. -Moreover, the effects of strong sources that are far outside the primary beam -could be filtered out by removing high-frequency ripples from the spectra. - -\item -\item -\item -\item -\item -\item -\end{itemize} - - - NB: The concept of a flag-file, which may also be edited, is -potentially quite powerful. The information in such a flag-file -specifies flag type, and ranges for frequency channel, HA, ifr and -polarisation. Since these ranges may be wild-cards (*), the flag-files -may be used to copy flags from a calibrator observation to a real observation. - - The use of data flags by NEWSTAR programs is entirely analogous -to the use of uv-data corrections: they are applied `on-the-fly' -whenever uv-data are read in for processing. The default is that all -8 flag types are tested for. But the user may specify that one or more -flag types are to be ignored, by means of the general (NGEN) keyword -UFLAG. This is of course analogous to the use of the NGEN keywords -APPLY and DE\_APPLY for on-the-fly corrections. diff --git a/src/doc/latex/ngcalc_descr.tex b/src/doc/latex/ngcalc_descr.tex deleted file mode 100644 index bbc42ad3277a876d14b4d6f0cac99af803ebdf3e..0000000000000000000000000000000000000000 --- a/src/doc/latex/ngcalc_descr.tex +++ /dev/null @@ -1,236 +0,0 @@ -% JPH 940916 Make compilable -% JPH 950213 Fix figure reference -% JPH 960502 In extracting, each new input observation produces a new -% output group. -% JPH 960503 New sections .loops, delete, .merge, .combine -% -% ngcalc_descr.tex -% -\newcommand{\noi}{\noindent} -\newcommand{\bi}{\begin{itemize}} -\newcommand{\ei}{\end{itemize}} - -\chapter{The Program NGCALC} -\tableofcontents - - -\section{ General} -\label{.general} - - NGCALC is a program for extracting information from .SCN-file data and -then manipulating it in a great variety of ways. The data may be either -interferometer-based (visibilities) or telescope-based (e.g. corrections). - - This document is still far from complete, but it is hoped that it gives -you somethging of a handle to start exploring on your own the many -possibilities that NGCALC offers. - - -\section{ The .NGF file} -\label{.ngf.file} - - The extracted data are organised and manipulated in a special type of -file, the {\em .NGF file}. - - The .NGF file contains a collection of {\em cuts} i.e. vectors -representing the values of some quantity as a function of either hour angle or -frequency. (You may still come across the term {\em plots} for these cuts, - -and corresponding the the .NGF file may be referred to as a {\em plot file} -, -but this unfortunate terminology is being phased out.) Each cut has a header -containing relevant parameters such as interferometer designation, bandwidth, -center frequency, hour-angle range etc. - - The cuts are organised in an index structure similar to that for -sectors in a .SCN file and maps in the .WMP file. The order of the indices is - -\verb/ <grp>.<fld>.<chn>.<pol>.<iort>.<seq>/ - -For each cut, the index is derived automatically from the index of the sector -from which the data are taken. This is shown schematically in -\figref{.ngf.scn.indices} and explained below: - -\input{ngf_scn_indices.cap} - -\bi -\item The \verb/<grp>/ ({\em group}\/) numbers are automatically assigned in -sequential order. A \verb/group/ generally contains all cuts produced in a -single run of NGCALC. In extracting data from a .SCN file, different input -groups and/or observations are mapped to different output groups. -% -\item \verb/<fld>/ ({\em field}\/) and -% -\item \verb/<chn>/ ({\em channel}\/) are those for the data in the .SCN file -from which the cut was made. -% -\item \verb/<pol>/ ({\em polarisation}\/) is a fixed code: - -\begin{tabular}{lllll} - &for interferometer-based data: &0=XX, &1=XY, 2=YX, &3=YY; \\ - &for telescope-based data: &0=X, & &1=Y. -\end{tabular} - -\item \verb/<iort>/ ({\em interferometer}\/ for interferometer-based data) is -a sequence number whose only function is to distinguish cuts for different -interferometers. In general, you will use this index only in specifying -\Textref{loops}{.loops} to process interferometers one by one; for {\em -selecting}\/ interferometers, the \whichref{SELECT\_IFRS parameter}{} is more -convenient -% -\item \verb/<iort>/ ({\em telecsope}\/ for telecope-based data) is analogous -to that for interferometers and the remarks made above on its use apply here as -well; in particular, the index value does {\em not}\/ necessarily correpond to -the telescope number. -% -\item \verb/<seq>/ ({\em sequence number}\/) is a number making it possible -to have several different kinds of cut with all preceding indices identical. -% -\ei - - -\section{ Overview of the parameter interface } - - -\input{ngcalc_interface.cap} - - -\section{ General features of the parameter interface} -\label{.general.features} - -\subsection{ Special use of NGF\_LOOPS} -\label{.loops} - - In certain operations, sets of input cuts are combined to produce some -output, e.g. some statistic as in the \verb/CALC/ option, or a new cut as in -the \verb/MERGE/ option. To process such sets per interferometer, the -\verb/NGF_LOOPS/ parameter may be used to loop over the interferometers one by -one by specifying an increment for the \Textref{\verb/iort/ index}{.ngf.file}, -e.g. - -\verb/ NGF_LOOPS = 65, ....1/ - -If you do not know the number of interferometers, you may have all of them -processed by their number as 91 (the largest possible number) or higher. - - -\subsection{ The DELETE and COPY options} -\label{.delete} - - It is rather easy to make mistakes in defining operations that combine -cuts. To get rid of the resultant clutter in an .NGF file, NGCALC offers the -option to \verb/DELETE/ (sets of) cuts. The data are not actually deleted but -simply disconnected from the index structure which makes them invisible; be -careful: this process is {\em irrevrsible}! - - Deleted data may still occupy more disk space than you want. The -\verb/COPY/ operation may be used to create a new .NGF file from which the -deleted data along with the corresponding index structures are actually -removed. The indices of valid data are copied unchanged, so e.g. the group -numbers in the output file may form a non-contiguous series. - - -\subsection{New cuts created by combining input cuts} -\label{.combine} - - Several options, such as \verb/MERGE/ and \verb/COMBINE/, combine data -from multiple input cuts to create new cuts. In such cases, NGCALC tries to -assign sensible values to the output cut's header parameters, but one cannot -rely blindly on them. - - The \verb/TRANS/ and \verb/BASE/ operations transpose data in the -three-dimensional hour-angle/baseline/frequency-channel data cube. The cuts for -the transposed data mostly use the same header parameters as the original cuts -and some educated guessing may be necessary to figure out what these parameters -mean. - - -\subsection{ Inspecting the contents of an .NGF file} -\label{.inspect} - - The \verb/BRIEF/ and \verb/FULL/ options can be used to inspect the -composition of your file. \verb/BRIEF/ provides a quick survey, \verb/FULL/ -gives details per individual cuts. Since the number of cuts in a file may be -quite large, the recommended way to explore a .NGF file is to start with -\verb/BRIEF/ and use \verb/FULL/ only to get details about one or a few cuts. - -%script - -\section{ Extracting data from a .SCN file} -\label{.extract} - - The first step in using NGCALC is to extract the necessary data from -one or more .SCN files and store it in an .NGF file. The number of output cuts -equals the number of input sectors times the numer of selected interferometers; -so in cases where the former is already considerable you should think carefully -about what you need. - -The mapping of the .SCN-file sector indices to .NGF-file cut indices is shown -schematically in a diagram \figref{.ngf.scn.indices}. - -% A typical extraction run is shown below: - -%script - - -\section{ Merging cuts} -\label{.merge} - - The \verb/MERGE/ option enables you to merge a set of cuts into a new -one; the \verb/NGF_LOOPS/ parameter may be used to execute a whole series of -mergers in a single operation. - - In the merge algorithm, the input cut data are sorted in hour-angle -bins .25 deg wide and averaged per bin. The resulting output is stored in a -contiguous sequence of points equidistant at .25 deg, long enough to hold the -data; see \figref{.ngcalc.merge}. - -\input{ngcalc_merge.cap} - - The output cuts will be indexed using the indices of the input cuts, -changing GRP to a new number and SEQ to 0. It is recommended that you check the -output using the \Textref{\verb/BRIEF/ or \verb/FULL/}{.inspect} options to -ascertain what indices NGCALC has assigned. - - - -.c+ -%============================================= Standard subsection ======= -\section{Overview of NGCALC options} -\label{.overview} - -The NGCALC keyword {\bf ACTION} can have the following responses: - -\begin{itemize} - -\item {\bf NODE:} switch data node - -\item {\bf EXTRACT:} extract information from SCN file into NGF file - -\item {\bf SHOW:} show information in NGF file - -\item {\bf BRIEF:} show one line information of plots in NGF file - -\item {\bf MERGE:} merge a number of plot sets into a single NGF file - -\item {\bf COMBINE:} combine info in NGF file(s) into new NGF file - -\item {\bf TRANS:} interchange frequency and HA axes (rough version, in which -bands are - translated into HA's and vv - -\item {\bf CALC:} do some calculation on an NGF file - -\item {\bf COPY:} copy info from other NGF file - -\item {\bf MONGO:} produce NGF file info into a MONGO readable file - -\item {\bf PLOT:} plot NGF file(s) - -\item {\bf DELETE:} delete NGF file(s) - -\item {\bf CVX:} convert NGF file from other machine's format to local format - -\item {\bf NVS:} update to latest NGF file format - -\item {\bf QUIT:} leave the program -\end{itemize} - diff --git a/src/doc/latex/ngids_descr.tex b/src/doc/latex/ngids_descr.tex deleted file mode 100644 index 869649f28b3b6b4617b844390d6014be02789e4f..0000000000000000000000000000000000000000 --- a/src/doc/latex/ngids_descr.tex +++ /dev/null @@ -1,76 +0,0 @@ -% -% @(#) ngids_descr.tex v1.2 04/08/93 JEN -% -% JPH 940727 Add sectioning commands. Add "Killing" section -% -% -\chapter{A few remarks on the program NGIDS {\it (Very incomplete)}} -\tableofcontents - -\section{ How to run NGIDS} -\subsection{ Starting up} - - Maps created by NMAP can be loaded into GIDS using the program NGIDS. -It creates a window for GIDS if it does not exist yet. {\bf NOTE that GIDS only -works on a COLOUR display!!!} - - If NGIDS fails to start, you should check for the existence of the file -{\em .gids\_sockets} in your login directory. This file should NOT exist; so -delete it and retry if it does exist. - - -\subsection{ Exiting} - - NGIDS can be stopped in the usual way by the answer \#. This does not -remove the GIDS window, so you can still play with the images. Stopping GIDS -should be done via its menu option ETCETERA, QUIT, YES. Note that NGIDS should -be stopped before GIDS, otherwise you'll get a broken pipe error and maybe a -coredump. - - -\subsection{ Killing GIDS or NGIDS when it runs out of control} - - An incorrect termination of either GIDS or NGIDS may result in one of -the programs devouring CPU time in vainly polling for the other one. When you -suspect this, use {\bf ps} to find the process id of the culprit and then kill -it with {\bf kill $<$process-id$>$}. - - -\section{ Image planes} - - NGIDS records images which can be played back using the ETCETERA, -RECORDING, LOOP menu option in GIDS. NGIDS starts recording in "image plane" 1. -The maximum number of planes, the number of used planes and the currently -active plane are shown in a little pane at the top left corner of the GIDS -window. You should restart NGIDS if you want to start recording at 1 again. The -memory of the X-terminal is used for the "image planes". The NFRA HP -X-terminals have enough memory to record up to 28 512x512 maps. - - The last image loaded is also stored in image plane 0. This is a -special plane since it contains the entire image, even if it is not completely -visible. You can zoom and scroll it using the GIDS menu and/or the mouse. For -this the buttons on the mouse have the functions: \\ - left : zoom in \\ - - middle : scroll \\ - right : zoom out \\ When clicking one of these -buttons the pixel the cursor is pointing to will be put into the middle of the -display. - - -\subsection{ Image sizes} - - By default GIDS is started with a window of 512x512. You can resize it -in the standard way using the mouse. When shrinking you should keep the menu -visible. Resizing affects the maximum number of images that can be recorded. It -also clears all image planes. - - NB: If the screen window is too small for the image, the program will -automatically "zoom out", i.e. to make the image smaller by taking one out of -every 2,3,4,etc pixels (in two dimensions). Note that this is not the same as -averaging these pixels. When "zooming out" however, all pixels are displayed. - - -\section{ Acknowledgement} - - We thank the GIPSY group in Groningen and in particular Dr Kor Begeman -for the GIDS software and the advice and help they gave us. In the future they -will write a GIDS user manual, but until then you have to find your own way in -GIDS. diff --git a/src/doc/latex/nmap_descr.tex b/src/doc/latex/nmap_descr.tex deleted file mode 100644 index 437248679a1dd2779c688798dce689721c1683e4..0000000000000000000000000000000000000000 --- a/src/doc/latex/nmap_descr.tex +++ /dev/null @@ -1,289 +0,0 @@ -% -% @(#) nmap_descr.tex v1.2 04/08/93 JEN -% -\chapter{The Program NMAP} -\tableofcontents - -\section{ Introduction} -\label{.intro} - - The \NEWSTAR program NMAP makes maps (images) from the uv-data in a -SCN-file, and stores them in a WMP-file. The input data may be combined in many -different ways, to produce maps that range from simple to quite exotic. As a -by-product, antenna patterns may be calculated (and stored in the same .WMP -file), for use in \textref{NCLEAN}{nclean_descr}. - - The program NMAP also allows the user to manipulate maps in a .WMP file, -and to convert them to other formats. - - A .WMP file may contain various kinds of maps that are {\em related in -some way}, i.e. different frequency channels, polarisations, pointing centres -(mosaicking), antenna patterns, CLEAN residuals, and even gridded uv-data. Each -{\em image} in a .WMP file consists of a 2-dimensional array of pixel values, -withj a header containing descriptive information. A 'hypercube' of images -in a .WMP file can have maps of different sizes. For more information about the -structure of the .WMP file, see the \textref{.WMP file}{wmp_descr} description. - -%============================================================================== -\section{Overview of NMAP options} -\label{.options} - -The program NMAP offers the following main options: - -\begin{itemize} -\item {\bf MAKE:} Make map(s) and/or antenna patterns -\item {\bf SHOW:} Show/edit map (header) data. - See section on WMP File Description. -\item {\bf FIDDLE:} Perform all kinds of operations on maps. -\item {\bf W16FITS:} Write FITS tape/disk with 16 bits data. -\item {\bf W32FITS:} Write FITS tape/disk with 32 bits data. -\item {\bf FROM\_OLD:} Convert from old (R-series) format to WMP format. -\item {\bf TO\_OLD:} Convert from WMP format to old (R-series) format. -\item {\bf CVX:} Convert a WMP-file from other machine's format - to local machine's. -\item {\bf NVS:} Convert a WMP file to newest version. - This option should be run if indicated by the program). -\item {\bf QUIT:} Quit the program NMAP. -\end{itemize} - - - -%============================================================================== -\section{Option MAKE: Making maps} -\label{.make} - - An overview of the user interface for the MAKE option is shown in -\figref{.nmap.make} and its companion \figref{.nmap.make.q}. - -\input{../fig/nmap_make.cap} - - -%----------------------------------------------------------------------------- -\subsection{Types of output images} -\label{.make.output} - - The program NMAP produces (multiple) images of the following types: - -\begin{itemize} - -\item {\bf MAP:} Normal map of the uv-data or the uv-model (the -uv-representation of the Selfcal model) from the SCN-file. -Various linear combinations of the four measured polarisations can be specified -with the keyword {\bf MAP\_POLAR}, to produce: - - \begin{itemize} - \item {\bf XX, YY, XY or YX-maps:} Use XX, YY, XY or YX data only - \item {\bf I-map:} (XX+YY)/2 - \item {\bf Q-map:} (-XX+YY)/2 - \item {\bf U-map:} (-XY+YX)/2 - \item {\bf V-map:} (XY+YX)*i/2 - \item {\bf L-map:} XX or YY or (XX+YY)/2 if both present - \item {\bf *I-map:} any of the above, but multiplied with $\sqrt{-1}$ - \end{itemize} - -NB: Note that parallel dipoles (++) are assumed here. -Observations with `crossed' dipoles (+x) require linear combinations of -all four polarisations. This can be done in the map plane (see NMAP -option {\bf FIDDLE\_OPTION}). - -\item {\bf AP:} Antenna pattern (Replace uv-data by 1's) -\item {\bf COS:} Assume input sines to be zero -\item {\bf SIN:} Assume input cosines to be zero -\item {\bf AMPL:} Assume input phases to be zero -\item {\bf PHASE:} Assume input amplitudes to be one -\end{itemize} - -It is also possible to store {\bf uv-data} in a WMP file, for display purposes. -The uv-data is `gridded' (convolved onto a rectangular grid). - -\begin{itemize} -\item {\bf COVER:} Gridded uv-coverage (data replaced by 1's) -\item {\bf REAL:} Real part of the gridded uv-data -\item {\bf IMAG:} Imaginary part of the gridded uv-data -\item {\bf AMPL:} Amplitude of the gridded uv-data -\item {\bf PHASE:} Phases of the gridded uv-data -\end{itemize} - - -%---------------------------------------------------------------------------- -\subsection{Operations on the input data} -\label{.make.input} - -\input{../fig/nmap_make_q.cap} - -\begin{itemize} -\item {\bf Data selection}: The uv-data that go into a map may be -selected in various ways: - \begin{itemize} - \item One or more SCN-files. - \item Sets within a SCN-file (e.g. frequ channels, pointing centres). - \item HA-Scans within each Set (HA-range). - \item Polarisations (XX,YY,XY,YX). - \item Individual iterferometers - \item An area in the uv-plane - \item Clip-level - \end{itemize} - -\item {\bf Data correction}: -Various correction factors are stored in the Set and Scan headers of the -SCN-file. They may be applied to the uv-data at the moment that they are -read from disk for processing. Application of correction is controlled -by the NGEN keywords {\bf APPLY} and {\bf DE\_APPLY} -(see the section `Common Features of \NEWSTAR Programs' in this Cookbook). - -\item {\bf Data conversion}: -The uv-data may be converted in various ways: - \begin{itemize} - \item Subtraction of a source model. - \item Combination of different polarisations (XX,YY,XY,YX). - \item Conversion to amplitudes or phases. - \end{itemize} - -\item {\bf Data weighting:} - \begin{itemize} - \item { NATURAL:} Take each individual measured point separately, - without weighting for the UV track covered by it. - \item { STANDARD:} Weight each observed point with the track length covered - on the UV plane, - and average redundant baselines on a per set basis. - {\it (default)} - \item { FULL:} Weight each point according to the actual UV point - density. In this case care is taken of all local UV - plane density enhancements, - but it necessitates an extra pass through the data. - \end{itemize} - -\item {\bf Data tapering:} - \begin{itemize} - \item { GAUSS:} $\exp(-baseline^{2})$ - {\it (default)} - \item { LINEAR:} max(0,1-baseline/taper\_value) - \item { NATURAL:} no taper - \item { OVERR:} $1/baseline$ - \item { RGAUSS:} $\exp(-baseline^{2})/baseline$ - \end{itemize} - -\item {\bf Data convolution:} (onto a rectangular grid in the uv-plane) - \begin{itemize} - \item { GAUSS:} Gaussian type with $4\times 4$ grid points - \item { P4ROL:} Prolate spheroidal function with $4\times 4$ grid points - \item { P6ROL:} Prolate spheroidal function with $6\times 6$ grid points - \item { EXPSINC:} $sinc\times\exp$ on $6\times 6$ grid points - {\it (default)} - \item { BOX:} A square box - \end{itemize} -\end{itemize} - -At this point, the data are either stored in the WMP file as gridded uv-data -(usually for display purposes), or Fouries transformed into an image. - -%============================================================================== - -\section{Option MAKE: example} -\label{.make.example} - -The following is an example of making a `normal' map (and its antenna pattern), -using the program defaults. This is usually sufficient to get a satisfactory -result. Experienced users may experiment with some of the more advanced -options. - -**** Put new script here **** - - -%------------------------------------------------------------------------------ - -\subsection{QMAPS: Hidden map options} -\label{.make.qmaps} - -The more advanced map-making options are hidden behind the NMAP keyword {\bf -QMAPS}. If skipped, the (context-sensitive) default values will give a -satisfactory result in most cases. -Their values will be printed in the NMAP log-file. -For more information on each of these -keywords, see the on-line Help text (type `?'), which is also printed in the -`Summary of NMAP keywords' in this Cookbook. - -**** Put new script here **** - - -%------------------------------------------------------------------------------ -\subsection{QDATAS: Hidden map options} -\label{.make.qdatas} - -The more advanced data-selection options are hidden behind the NMAP keyword -{\bf QDATA}. If skipped, the (context-sensitive) default values will give a -satisfactory result in most cases. -Their values will be printed in the NMAP log-file. -For more information on each of these -keywords, see the on-line Help text (type `?'), which is also printed in the -`Summary of NMAP keywords' in this Cookbook. - -\sprompt{QDATAS} -\sprompt{(More data handling details?)} -\sdefault{ = NO:} -\suser{y} - -(To be added later). - -%============================================================================== - -\section{Option FIDDLE: Operations on maps} -\label{.fiddle} - -\input{../fig/nmap_handle.cap} - -The NMAP keyword {\bf FIDDLE\_OPTION} -offers the user a wide range of possibilities to -perform oparations on maps in WMP files: - -All relevant data are copied from the first (or only) input map. -If 2 maps are required (ADD,AVER,POL,ANGLE) all pairs of SETS\_1 and -SETS\_2 will produce an output map. -SUM will average all SETS\_1 maps. -MOSCOM will produce a single output map from all specified input maps. -The others will produce an output for each SETS\_1. -BEAM, DEBEAM and FACTOR will overwrite the input maps. -F is a specified multiplication factor. - -\begin{itemize} -\item {\bf ADD:} $F1\times map1 + F2\times map2$ -\item {\bf AVER:} $(F1\times map1 + F2\times map2)/(abs(F1)+abs(F2))$ -\item {\bf SUM:} Various averages of maps. -In all cases the summation produces -a weighted average map over all SETS\_1, the weight depending on the type: - \begin{itemize} - \item {\bf SUM:} weight(i)= 1 - \item {\bf NSUM:} weight(i)= normalisation factor of map - \item {\bf BSUM:} weight(i)= bandwidth - \item {\bf BNSUM:} weight(i)= bandwidth $\times$ normalisation factor - \item {\bf FSUM:} weight(i)= factor given by the user. - Up to 8 factors can be given, - which will be used in a cyclic fashion if more needed - \item {\bf NSSUM:} weight(i)= $1/(map noise^{2})$ - \item {\bf QUIT:} finished - \end{itemize} -\item {\bf POL:} $\sqrt{map1^{2} + map2^{2}}$, - unless $< F1$, then 0 -\item {\bf ANGLE:} $0.5\times \arctan{(map1/map2)}$ (radians), - unless $POL < F1$, then 0 -\item {\bf EXTRACT:} extract an area of maps -\label{.copy} -\item {\bf COPY:} copy maps -\item {\bf BEAM:} correct maps for primary beam -\item {\bf DEBEAM:} de-correct maps for primary beam -\item {\bf FACTOR:} $F1\times map$ -\item {\bf MOSCOM:} combine all specified maps - (referenced to same mosaic position) into one output map. - The noise of the individual maps may be used as weight. -\item {\bf QUIT:} quit the fiddle option. -\end{itemize} - - - -%============================================================================== - -\section{Option FITS: Conversion to FITS format} -\label{.fits} - -There are two separate NMAP options ({\bf W16FITS} and {\bf W32FITS}. - diff --git a/src/doc/latex/nmap_example.tex b/src/doc/latex/nmap_example.tex deleted file mode 100644 index 4acd7cce7c06e81f2590b31068b6a09fabeddde2..0000000000000000000000000000000000000000 --- a/src/doc/latex/nmap_example.tex +++ /dev/null @@ -1,11 +0,0 @@ -% -% @(#) nmap_example.tex v1.2 04/08/93 JEN -% -\chapter{Advanced NMAP examples} -\tableofcontents - -%================================================= Standard subsection ======= -\section{Making multiple maps} -\label{nmap.example.makemult} - -**** Put new script here **** diff --git a/src/doc/latex/nmodel_descr.tex b/src/doc/latex/nmodel_descr.tex deleted file mode 100644 index 82b0cf358b4def51f2b7ffa692e7dad0d8dbbe15..0000000000000000000000000000000000000000 --- a/src/doc/latex/nmodel_descr.tex +++ /dev/null @@ -1,20 +0,0 @@ -% nmodel_descr.tex -% -% JPH - - -\it - This is a dummy replacing the original Cookbook version that got lost. -Since that version contained very little true information, no attempt has been -made to restore it. - - A new version is planned. - - Shown below are the interface diagrams that do exist - -\input{nmodel_interface.cap} - -\input{nmodel_handle.cap} - -\input{nmodel_convert.cap} - diff --git a/src/doc/latex/nplot_descr.tex b/src/doc/latex/nplot_descr.tex deleted file mode 100644 index d0fd2c9be73988ef4e6e1a91d84194382c201657..0000000000000000000000000000000000000000 --- a/src/doc/latex/nplot_descr.tex +++ /dev/null @@ -1,220 +0,0 @@ -% -% @(#) nplot_descr.tex v1.2 04/08/93 JEN -% -% History: -% JPH 940916 \ref --> \textref -% HjV 950615 Separate parts by indenting text or by using two blank -% lines -% JPH 960429 Add NOTE. Missing \ on \textref. -% -% NOTE: -% Text terminated after PLUVO by a '.c+' marker because currently there -% is nothing relevant beond that point -% -\chapter{The Program NPLOT} - -\tableofcontents - - -%============================================================================== -\section{Overview of NPLOT options} -\label{.options} - -The program NPLOT has the following main options: - -\begin{itemize} -\item {\bf MAP:} Plot map(s) of various types (from WMP-file) -\item {\bf DATA:} Plot uv-data from SCN-file -\item {\bf MODEL:} Plot uv-model from SCN-file - (i.e. the uv-representation of a Selfcal model, - calculated for the uv-coordinates of the uv-data in the SCN-file) -\item {\bf TELESCOPE:} Plot telescope errors -\item {\bf RESIDUAL:} Plot interferometer residuals - (i.e. the residual scatter of redundant spacing data after a - Redundancy solution, or the residual differences with the - source model after a Selfcal solution. -\item {\bf QUIT:} Quit the program NPLOT -\end{itemize} - -%============================================================================== -\section{NPLOT output} -\label{.output} - -After selecting an NPLOT option, the {\bf PLOTTER} question is asked: - -\skeyword{PLOTTER} -\sprompt{(QMS,QMSP,REGIS,FREGIS,EPS,EPP,PSL,PSP,...)} -\sdefault{= PSP:} -\suser{?} - -Produces QMS formatted files, for which currenlty no printers are available\\ -{\tt QMS QMS laser printer in landscape orientation}\\ -{\tt QMSP QMS laser printer in portrait orientation}\\ -Produces output on VT terminal:\\ -{\tt REGIS graphics VT terminal (e.g. VT330)}\\ -{\tt FREGIS (*) REGIS to file}\\ -Produces PostScript files on disk (which may fill up quickly!):\\ -{\tt EPS encapsulated PostScript for use in textprocessors etc}\\ -{\tt EPP EPS in portrait mode}\\ -{\tt EAL encapsulated PostScript A3 plotter landscape}\\ -{\tt EAP EPS A3 in portrait mode}\\ -Produces PostScript files, and prints them automatically (if you are lucky)\\ -on the New PostScript laser printer in the Dwingeloo computer room:\\ -{\tt PSL Postscript (do not use halftone: slow!)}\\ -{\tt PSP PostScript in portrait mode}\\ -{\tt PAL Postscript A3 (do not use halftone: slow!)}\\ -{\tt PAP PostScript A3 in portrait mode}\\ -Bit maps:\\ -{\tt BIT1 (*) bitmap for 100 dpi}\\ -{\tt BIT2 (*) bitmap for 200 dpi}\\ -{\tt BIT3 (*) bitmap for 300 bpi}\\ -Produces a X11-plot on the Workstation (or X-terminal) screen.\\ -{\tt X11 X11 terminal}\\ - -{\tt (*) = not implemented yet.} - -All plot file names start with the 3-4 letters of the selected option (e.g. -EPS), followed by a unique combination of characters based on the time and the -date. All plot files have the extension .PLT. - -%============================================================================== -\section{Plotting a map from a WMP file} -\label{.map} - -NPLOT option MAP can be used to make {\bf contour plots} or {\bf greyscale -plots} of 2-dimensional pixel-arrays stored in a WMP-file. These may be maps, -antenna-patterns, residuals etc, but also gridded uv-data (see the description -of the program NMAP, and the WMP file). They can also be displayed (and -analysed) as a color image on the X11 screen with the program NGIDS. - - -*** Put new script here **** - - -The plot is now made, and sent to the laser plotter automatically if that has -been specified. The program will then prompt the user for the next plot to be -specified. - - -**** Put new script here **** - - -It is also possible to make `ruled-surface' plots, halftone plots and plots in -polar coordinates (gridded uv-data). - - -%============================================================================== -\section{Plotting uv-data from a SCN-file} -\label{.data} - - -%----------------------------------------------------------------------------- -\subsection{NORMAL: interferometers vs time (HA)} -\label{.data.normal} - -**** Put new script here **** - - -The plot is now made, and sent to the laser plotter automatically if that has -been specified. The program will then prompt the user for the next plot to be -specified. - - -**** Put new script here **** - - -%----------------------------------------------------------------------------- -\subsection{PLUVO: frequency channels vs time (HA)} -\label{.pluvo} - - -**** Put new script here **** - - -Etc... - -.c+ -%============================================================================== -\section{Plotting a uv-model from a SCN-file} -\label{.model} - -The same as plotting \textref{uv data}{.data}. - -**** Put new script here **** - -The plot is now made, and sent to the laser plotter automatically if that has -been specified. The program will then prompt the user for the next plot to be -specified. - -**** Put new script here **** - - -%============================================================================== -\section{Plotting telescope corrections} -\label{.tel} - -The telescope corrections are stored in the HA-Scan headers of the SCN-file. -Plotted are the {\bf total} telescope corrections: Redundancy (REDC) plus Align -(ALGC) plus `other' (OTHC). - - -%----------------------------------------------------------------------------- -\subsection{NORMAL: telescopes vs time (HA)} -\label{.tel.normal} - -**** Put new script here **** - -The plot is now made, and sent to the laser plotter automatically if that has -been specified. The program will then prompt the user for the next plot to be -specified. - -**** Put new script here **** - - -%----------------------------------------------------------------------------- -\subsection{PLUVO: frequ channels vs time (HA)} -\label{.tel.pluvo} - - -**** Put new script here **** - -Etc... - -%============================================================================== - -\section{Plotting NCALIB residuals from SCN-file} -\label{.residuals} - - -The residuals are calculated by going though the SCN-file and subtracting a -uv-model from the uv-data (Selfcal rediduals), or the average of redundant -spacings (Redundancy residuals). - -%----------------------------------------------------------------------------- -\subsection{Redundancy residuals} -\label{.redun.residuals} - -**** Put new script here **** - -The plot is now made, and sent to the laser plotter automatically if that has -been specified. The program will then prompt the user for the next plot to be -specified. - -**** Put new script here **** - - -%----------------------------------------------------------------------------- -\subsection{Selfcal residuals} -\label{.selfcal.residuals} - -**** Put new script here **** - -The plot is now made, and sent to the laser plotter automatically if that has -been specified. The program will then prompt the user for the next plot to be -specified. - -**** Put new script here **** - - - - diff --git a/src/doc/latex/nscan_descr.tex b/src/doc/latex/nscan_descr.tex deleted file mode 100644 index 057a3628191e8c9250ef8b32d21560d2c4f7763d..0000000000000000000000000000000000000000 --- a/src/doc/latex/nscan_descr.tex +++ /dev/null @@ -1,137 +0,0 @@ -% -% @(#) nscan_descr.tex v1.2 04/08/93 JEN -% -% History -% JPH 9401003 Remove \newpage, shorten %===== markers t0 80 chars -% -% -\chapter{The Program NSCAN} -\tableofcontents - -%=============================================================================== - -\section{Overview of NCSAN options} -\label{nscan.descr.options} - -The program NSCAN allows the user to interact with the uv-data file (SCN-file). -The structure of this file is explained in detail in a separate section of this -cookbook. The program NSCAN offers the following main options: - -\begin{itemize} -\item {\bf LOAD:} -Load WSRT uv-data (in WSRT circle format) from tape, disk, DAT or optical disk -into a SCN-file. -The input may be from multiple tapes and/or labels. -The user may select data, and change the integration time. - -\item {\bf DUMP:} -Dump WSRT data (in WSRT circle format) from tape or DAT or optical disk to a -disk file (in WSRT circle format). - -\item {\bf FROM\_OLD:} -Convert an old (R-series format) SCN-file into a \NEWSTAR SCN-file. - -\item {\bf TO\_OLD:} -Convert a \NEWSTAR SCN-file into an old (R-series format) SCN-file. - -\item {\bf SHOW:} -Show/edit the contents of a SCN-file: layout, header information -(incl corrections), uv-data and uv-model. -This is demonstrated in the section `Description of the SCN-file' in this -Cookbook. - -\item {\bf DELETE:} -Delete (or un-delete) uv-data in a SCN-file, according to certain selection -criteria. Actually, the data is only disabled (flagged) reversibly by making -the attached weight-factor negative. - -\item {\bf COPY:} (not yet available) -Copy selected Sets from a SCN file to a new (secondary) SCN-file. The uv-data -may be physically modified (e.g. corrections, model subtraction, change of -integration time) in this process. -This option will probably be implemented in a separate program NCOPY. - -\item {\bf REGROUP:} -Select and reorganise the data in a SCN-file. -Make a new group directory entry (job tree) with specified Sets in it. - -\item {\bf UVFITS:} -Convert a SCN-file into a UVFITS file (tape/disk) for further image analysis in -AIPS. -It is recommended to do all WSRT uv-data processing first in \NEWSTAR, since -AIPS uv-data processing is rather VLA-oriented, and does not do justice to WSRT -data. - -\item {\bf PFITS:} -Print a summary of a UVFITS (AIPS) tape/disk file, showing all keywords and a -limited set of data. - -\item {\bf CVX:} -Convert a SCN file from other machine's format to local machine's. - -\item {\bf NVS:} -Convert a SCN file to newest version. -This should be run if SCN file made before the dates: - \\ 910417: add MJD to set header. - \\ 900907: add precession rotation angle. - \\ 900220: add polarisation corrections. - \\ 920828: recalculate MJD for observations aborted at Wbork. - -\item {\bf WERR:} -Correct mosaic tape errors. This only concerns mosaic data taken in 1991. - -\item {\bf QUIT:} -Exit the program NSCAN -\end{itemize} - - -%=============================================================================== - -\section{Option LOAD} -\label{nscan.descr.load} - -{\bf An example:} -Let us assume we have a mosaicking observations at 4 settings of ABCD of 60 -fields, 64 line channels. There will thus be 12 spokes per 12 hour per field. -These data are on 4 tapes: - -\vspace{-0.8cm} % reduce vertical gap -\begin{tabbing} -+++++\=++++++++\=++++++++\=+++++\=+++++\=+++++\=+++++\=+++++\=+++++\= \kill -%tabs - \\ \> Tape 1: \> label 1: \> 6 hours, spacing 9A is 36 m - \\ \> \> label 2: \> 6 hours, 36 m - \\ \> Tape 2: \> label 1: \> 12 hours for fields 30-59, 72 m - \\ \> \> label 2: \> 12 hours for fields 0-29, 72 m - \\ \> Tape 3: \> label 1: \> 12 hours all fields for 48 m - \\ \> Tape 4: \> label 1: \> 12 hours all fields for 90 m -\end{tabbing} -\vspace{-0.4cm} % reduce vertical gap - -The Set numbers will be unknown, but the indices generated are (if they are -read in in order of tape and label): - -\vspace{-0.8cm} % reduce vertical gap -\begin{tabbing} -+++++\=++++++++\=++++++++\=+++++\=+++++\=+++++\=+++++\=+++++\=+++++\= \kill -%tabs - \\ \> Tape 1: \> {\tt 0.0.0-59.0-64.0-5, 0.1.0-59.0-64.0-5 } - \>\>\>\>\>Note continuum channel 0 - \\ \> Tape 2: \> {\tt 1.0.30-59.0-64.0-11, 1.1.0-29.0-64.0-11 } - \\ \> Tape 3: \> {\tt 2.0.0-59.0-64.0-11 } - \\ \> Tape 4: \> {\tt 3.0.0-59.0-64.0-11 } -\end{tabbing} -\vspace{-0.4cm} % reduce vertical gap - -If a map is wanted of field 31 using spacings 36 m and 72 m averaging all odd -channels between 17 and 25, the data could be specified as: - -\begin{verbatim} - 0..31.17-25:2,1..31.17-25:2 -or 0-1.*.31.17-25:2 -\end{verbatim} - - -%=============================================================================== -\section{Option DELETE} -\label{nscan.descr.delete} diff --git a/src/doc/latex/people.tex b/src/doc/latex/people.tex deleted file mode 100644 index a826f35b7dc854f34a6964b4490113b4625a674b..0000000000000000000000000000000000000000 --- a/src/doc/latex/people.tex +++ /dev/null @@ -1,186 +0,0 @@ -% @(#) people.tex -% -% CMV 930721 original -% JPH 94???? edit for latex2html -% JPH 941123 fix compilation error -% HjV 9603.. Correct alignment of photographs -% JPH 960410 Correct directory for .gif files -% -% -% This file contains information on the Newstar team -% -\title{Newstar Project Team} - -{\bf NFRA/ASTRON} - -Stichting Astronomisch Onderzoek in Nederland \\ -Netherlands Foundation for Reasearch in Astronomy \\ -P.O. Box 2 \\ -NL-7990 AA Dwingeloo \\ -Phone: +31 521 595100 - -\begin{itemize} - -\item General eMail account: {\bf - \begin{rawhtml} - <a href="mailto:newstar@astron.nl">newstar@astron.nl</a> - \end{rawhtml} - } - -\item Jan Noordam Project Manager \label{jen} {\it JEN} - (eMail: - \begin{rawhtml} - <a href="mailto:noordam@astron.nl">noordam@astron.nl</a> - \end{rawhtml} - ) - \begin{rawhtml} - <IMG ALIGN=RIGHT SRC=../src/doc/bin/jen.gif> - <br> - <br> - <br> - <br> - <br> - <br> - <br> - <br> - <br> - <br> - <br> - <br> - <br> - <br> - <br> - <br> - \end{rawhtml} - -\item Ger de Bruyn Project Scientist \label{agb} {\it AGB} - (eMail: - \begin{rawhtml} - <a href="mailto:ger@astron.nl"> ger@astron.nl</a> - \end{rawhtml} - ) - \begin{rawhtml} - <IMG ALIGN=RIGHT SRC=../src/doc/bin/agb.gif> - <br> - <br> - <br> - <br> - <br> - <br> - <br> - <br> - <br> - <br> - <br> - <br> - <br> - <br> - <br> - <br> - \end{rawhtml} - -\item Johan Hamaker \label{jph} {\it JPH} - (eMail: - \begin{rawhtml} - <a href="mailto:hamaker@astron.nl"> hamaker@astron.nl</a> - \end{rawhtml} - ) - \begin{rawhtml} - <IMG ALIGN=RIGHT SRC=../src/doc/bin/jph.gif> - <br> - <br> - <br> - <br> - <br> - <br> - <br> - <br> - <br> - <br> - <br> - <br> - <br> - <br> - <br> - <br> - \end{rawhtml} - -\item Henk Vosmeijer \label{hjv} {\it HjV} - (eMail: - \begin{rawhtml} - <a href="mailto:vosmeijer@astron.nl"> vosmeijer@astron.nl</a> - \end{rawhtml} - ) - \begin{rawhtml} - <IMG ALIGN=RIGHT SRC=../src/doc/bin/hjv.gif> - <br> - <br> - <br> - <br> - <br> - <br> - <br> - <br> - <br> - <br> - <br> - <br> - <br> - <br> - <br> - <br> - \end{rawhtml} - -\item Marco de Vos \label{cmv} {\it CMV} - (eMail: - \begin{rawhtml} - <a href="mailto:devoscm@astron.nl"> devoscm@astron.nl</a> - \end{rawhtml} - ) - \begin{rawhtml} - <IMG ALIGN=RIGHT SRC=../src/doc/bin/cmv.gif> - <br> - <br> - <br> - <br> - <br> - <br> - <br> - <br> - <br> - <br> - <br> - <br> - <br> - <br> - <br> - <br> - \end{rawhtml} - -\item Wim Brouw \label{wnb} {\it WNB} - (eMail: - \begin{rawhtml} - <a href="mailto:wbrouw@atnf.csiro.au"> wbrouw@atnf.csiro.au</a> - \end{rawhtml} - ) - \begin{rawhtml} - <IMG ALIGN=RIGHT SRC=../src/doc/bin/wnb.gif> - <br> - <br> - <br> - <br> - <br> - <br> - <br> - <br> - <br> - <br> - <br> - <br> - <br> - <br> - <br> - <br> - \end{rawhtml} - -\end{itemize} diff --git a/src/doc/latex/plate_measure.tex b/src/doc/latex/plate_measure.tex deleted file mode 100644 index 8faa9461f2702572aabd825a44e5ab0ef6365365..0000000000000000000000000000000000000000 --- a/src/doc/latex/plate_measure.tex +++ /dev/null @@ -1,254 +0,0 @@ -% History: -% JPH 940914 Replace & by / in \verb (latex2html mishandles &) - - - - -\chapter{ Dwingeloo Plate Measuring Machine} - - -A \NEWSTAR Guide to Determining Positions Using the Dwingeloo Plate Measuring -Machine. - -\indent{\it Original by James Albinson, July 1983 \\ -\indent Version 3, updated by Richard Strom, October 1992} - - -{\it For Problems, questions, complaints, suggestions on use and operation: See -Richard Strom, alternatively Ger der Bruyn. \\ In case of mechanical/electrical -failures: See Jean Casse}. - - - -\section{Introduction} -\label{.intro} - -This document is based on previous versions by Seth Shostak and Bob Hanisch, -and gives a simple procedure for measuring the positions of objects from the -PSS prints or KPNO plates. The general procedure is as follows: -\\(1) identify standard stars from an overlay of the region of interest, -\\(2) measure the positions of a number of standard stars and the desired -objects, -\\(3) solve for the plate constants and the positions of the desired objects. A -guide to these procedures is given below. - - -\section{Logging in} -\label{.login} - -Turn on the terminal next to the measuring machine and the yellow Interloop -interface to which it should be connected. (If the interface is off, there will -be no response from the terminal. If the terminal is disconnected from the -interface, you will have to ask for help to connect it up.) If you get the -server prompt (`Server $>$'), connect to the RZMVX4 computer (`c' should be -enough) and log in under `measure', password: \verb/meas$$92/ - -You now need to type the following command: \verb/assign user1: qd2:/ - -You're now ready to run the OVERLAY program. - - -\section{Running the OVERLAY program} -\label{.run} - -Type: \verb/exe overlay/ - -The program will ask for a right ascension and declination; these refer to the -field center you're interested in. For example, if you want to find star -positions around a galaxy, type the position of the galaxy. - -An example: -\\ RA\_MAPCENTRE (RA of map\_centre in h,m,s): 4,2,35.000 -\\ DEC\_MAPCENTRE (DEC of map\_centre in d,m,s): 69,40,42.00 -\\ For negative declinations simply prefix the declination degrees with a minus -sign. - -OVERLAY will produce some output on the lineprinter and an overlay plot on the -QMS printer/plotter. It may be desirable to make the plot on a transparent -sheet; in that case special Xerox transparent overhead sheets can be loaded in -the QMS printer (check with other users first, and only load as many sheets as -you need). Take the plot and identify your standard stars. If the plot was made -on paper, you can circle the stellar positions on a plastic sheet using a -marking pen that can be obtained from the secretaries. It is also helpful to -label the stars with the same numbers that appear on the OVERLAY plot, as you -will have to enter these numbers when measuring the positions. On the other -hand, you may not want to write too much stuff on the plastic sheet as this may -obliterate objects that you want to measure. Since it is not possible to -measure any more than 30 standard stars, be sure that you select standard stars -with numbers between 1 and 30. (OVERLAY numbers the stars in order of -increasing distance from the field center.) - -Special note for very northerly fields (dec $> 70^\circ$): For very northerly -fields it is more convenient to make the overlays with a Schmidt projection -rather than a linear projection (which is the default). To do this type in the -command \verb/@schmidt/. This will produce plots with the Schmidt projection -for all subsequent runs of OVERLAY. To go back to a linear projection, simply -type the command \verb/@linear/. - -Special note for measuring several fields: You should complete your -measurements for each field before proceeding to the next field. The reason for -this is that the program which solves for the plate constants and object -positions uses the standard star positions from the most recent run of OVERLAY. - - - -\section{Measuring positions} -\label{.pos} - -Preliminaries. Turn on the plate illumination light. The switch is on top of -the green box behind the measuring machine. Turn on the Television camera and -monitor screen. The switch for this is the leftmost of the three rotary -switches on the front of the monitor. Make sure that the lowest of the 7 -channel knobs on the right-hand edge of the monitor is selected. After a few -seconds the monitor should show an image. The brightness and contrast knobs are -the other two rotary knobs on the front of the monitor. Adjust to suit. The -focus knob is below and to the right of the eyepiece, facing the front of the -machine. Adjust as necessary. - -Place the ``sandwich" of PSS print and plastic overlay between the glass plates -of the measuring machine. The orientation is not important. Adjust the -measuring machine so that the axes are set at the center of their travel -(x-axis at 10.0, y-axis at 9.0). Then release the gray clamps, center the -microscope over your field, and retighten the clamps. - -Turn on the interface (white rocker switch on right) and make sure the mode -switch is set to `TERMINAL'. Turn on the two Sony Magnescale digital readouts -and the illuminating lamp, if you haven't already (switch is on the little -green box). Adjust the lamp for good illumination, and use the knurled knob to -focus the image through the microscope (if no TV). Push the `START/READ' -switch on the interface. - -Start up the measuring machine program by typing: \verb/exe measure/ - -The program asks you if you want a new file. To start measuring a new field, -answer this question with `y'. To continue measuring on a field still in -position on the measuring machine, answer with `n'. - -Set the mode switch on the interface chassis to `TRANSMIT'. Measure your -standard stars (in any order) as follows: -\begin{enumerate} -\item Center the standard star in the crosshairs. -\item Set the thumbswitches on the interface to the number of the standard star -from the OVERLAY plot (i.e., a number between 01 and 30). -\item Push the `START/READ' switch. This sends the x-y coordinates of the star -to the computer, and you should also see them dispayed on the terminal. -\end{enumerate} - -Repeat steps 1-3 for each standard star you want to measure (10 to 15 stars are -usually sufficient). Since there is no backlash in the digital readout, it is -not necessary to repeat your measurements or to approach each star from the -same direction. - -If you have a large number of radio sources to identify and would like to have -approximate x-y positions around which to look for optical identifications, -skip from here to \textref{section}{.diff}. - -Measure the ``unknown'' objects (stars, galaxies, or whatever) in the same -manner, but set the thumbswitches to numbers between 31 and 98, incrementing -the count by one for each object you measure. You may, of course, measure the -objects in any order you find convenient. The x-y positions will continue to be -displayed on the terminal, but the object number will be the thumbswitch -setting minus 30. - -When you have finished all the positions you want, set the thumbswitches to 99 -and push the `START/READ' switch. This terminates the program. {\bf Be sure to -set the mode switch back to `TERMINAL'.} - - -\section{Solving for plate constants and positions} -\label{.solve} - -Start up the program by typing: \verb/exe solve/ - -The program asks you for some information about the plate: -\\ - PLATE\_TYPE: Type a carriage return if you used a PSS print, or the -appropriate code for a KPNO plate. -\\ - FIELDNAME: Type a name (up to 8 characters) of this field. -\\ - TRANSFORM\_CODE: Type `1' (x-y $\rightarrow$ alpha,delta) -\\ - PLATE\_CENTER (hms,dms): Type the right ascension and declination of the -field center in the format shown. These coordinates can be found in the little -box in the upper left corner of each PSS print; put a comma between hms \/ dms. - -The program now goes on to solve for the plate constants. You have the -opportunity to delete certain stars from the solution of plate constants if you -have reason to believe that their measured positions are in error. Assuming -that they are all okay, however, just type `return' in response to this -question. - -- CORRECT\_STAND? Type either 'Y' or `return'. - -The program now solves for the coordinates of the unknown objects. When the -program finishes, you have the option to send the results to be printed on the -lineprinter: - -- OUTPUT? The default is Y (yes), so type a `return'. Finally, you may have -the positions you've measured added to the standard star positions as secondary -standards: - -- SECONDARY\_STAND? Typically the response is `no' (the default is yes). You -may now pick up your output downstairs from the lineprinter. - -If your plate solution looks dubious, i.e., one or more stars have large -errors, you can rerun SOLVE and delete these stars from the solution. Run -SOLVE again, and answer the questions concerning the type of plate and field -name again. Hereafter you want to use the same data as before. SOLVE -remembers all of the information from the previous run, and uses this -information if you simply answer all of the questions with `return'. So, -answer the questions with `return's until you are asked: - -- EXCLUDE\_STAND: Type in the numbers in the specified format, and then -continue as before to produce a new plate solution. - - -\section{A different approach to making source identifications} -\label{.diff} - - -If you have a large number of radio sources you want to try to identify, you -could spend an eternity measuring candidate objects unless you know where on -the plate to look. It is possible to use SOLVE to get x-y positions for given -radio source positions (in right ascension and declination epoch 1950), and -these x-y positions can then be used as guides in measuring candidate objects. - -To make use of this option, you must measure some standard star positions in -the field of interest as \textref{previously described}{.pos}. Rather than -measuring any unknown objects at this time, however, terminate MEASURE (set -thumbswitches to 99 and push the `START/READ' switch) and run SOLVE (see -\textref{section}{.solve}). You will need to run SOLVE twice, first to check -that your standard stars have been measured accurately (check the rms fit and -the individual errors; if one or two stars are bad delete them from the fit the -next time around), and second to convert given alphas and deltas (i.e. your -radio source positions) to x-y coordinates. - -Now run SOLVE a second time. When the program asks you for the type of -transformation (TRANSFORM\_CODE), type a `2', i.e., transform (alpha,delta) -$\rightarrow$ (x,y). The program will then ask you to enter the coordinates of -your source positions. You should type all of the alphas and deltas in the -given format, (put a blank between alpha \/ delta as opposed to a comma), and -terminate your input with a blank line (i.e. an extra `return'). The rest of -the program is then run in the same way as described previously in section -\whichref{}{}. - -The output from SOLVE will now contain a list of x-y coordinates for your -source positions. You can use these to set the measuring machine to the -appropriate position, and then measure candidate objects in the vicinity. To -do this, run MEASURE as described in steps III.a-d. However, when you are -asked: - -- NEWFILE? type a `no' (i.e., use the Old file). The program then asks you how -many objects were measured in the previous run of the program (it should be -able to keep count itself, but this is a very stupid program): - -- OLD\_OBJECTS? Type in the number of objects previously measured. This is -{\it not} the highest numbered standard star, but rather simply the total -number of objects measured. At this point you can measure the positions of -candidate objects just as in step III.f. It is not necessary to measure any -standard star positions again (i.e., skip step ...), as your unknown object x-y -positions are simply being appended to your previous measurements. - -When you have finished, please do not forget to logout; just type `lo' on the -terminal. Turn off all the bits of the measuring machine and put the green -cover over the camera and table. Put any PSS prints carefully back in their -folders, and replace them at the right place in the cabinet. - - diff --git a/src/doc/latex/rcp_batch_processing.tex b/src/doc/latex/rcp_batch_processing.tex deleted file mode 100644 index b90158a3712f3972a54fbc1bcdd19c8383bce2da..0000000000000000000000000000000000000000 --- a/src/doc/latex/rcp_batch_processing.tex +++ /dev/null @@ -1,66 +0,0 @@ -% JPH 940916 Make compilable -% JPH 950214 Again: change target labels -% -% @(#) rcp_batch_processing.tex v1.2 04/08/93 JEN -% -\chapter{Processing recipe: Simple Batch Processing} -\tableofcontents - -%=============================================== Standard subsection ====== -\section{Scope of the recipe} -\label{.scope} - -........... - -%--------------------------------------------------------------------------- -% If possible, supply an idea for an "appetizer" picture, which gives an -% idea of what can be achieved with this recipe. - -%\begin{figure}[htbp] -%\vspace{10cm} -%\caption[017 processing appetizer:...] % appears in listoffigures -%{\label{.appetizer}} -%\begin{center}\parbox{0.9\textwidth}{\it % actual caption if long -%017 processing appetizer:... -%\\This result was obtained in the following way: -%\\Note the following features: -%}\end{center} -%\end{figure} - - -%=============================================== Standard subsection ====== -\section{Introduction and background} -\label{.intro} - - -%=============================================== Standard subsection ====== -\section{Summary of the recipe} -\label{.summary} - -The following is a step-by-step summary of the processing recipe. -For some of these steps, more detail is provided below. - -\begin{enumerate} -\item {\bf Load your data:} -from tape or optical disk (NSCAN, option ....). -See also Recipe ``Reading data in Dwingeloo''. -\item {\bf Inspect the data file layout:} (NSCAN, option ...). -\item {\bf ... :} -\item {\bf ... :} -\item {\bf ... :} -\item {\bf ... :} -\end{enumerate} - - -%=============================================== Standard subsection ====== -\section{More details for some of the steps} -\label{.detail} - -%------------------------------------------------------------------------- -\subsection{Load your data} -\label{.detail.load} - -%------------------------------------------------------------------------- -\subsection{Inspect the data file layout} -\label{.detail.layout} - diff --git a/src/doc/latex/rcp_batch_processing_tmp.0 b/src/doc/latex/rcp_batch_processing_tmp.0 deleted file mode 100644 index 8d33d5919d42ed8cedc19698ac73354cd4150a1f..0000000000000000000000000000000000000000 --- a/src/doc/latex/rcp_batch_processing_tmp.0 +++ /dev/null @@ -1,64 +0,0 @@ -% -% -% -% -% -\chapter{Processing recipe: Simple Batch Processing} -\tableofcontents - -% -\section{Scope of the recipe} -\label{.scope} - -........... - -% -% -% - -% -% -% -% -% -% -% -% -% -% - - -% -\section{Introduction and background} -\label{.intro} - - -% -\section{Summary of the recipe} -\label{.summary} - -The following is a step-by-step summary of the processing recipe. For some of these steps, more detail is provided below. - -\begin{enumerate} -\item {\bf Load your data:} from tape or optical disk (NSCAN, option ....). See also Recipe ``Reading data in Dwingeloo''. -\item {\bf Inspect the data file layout:} (NSCAN, option ...). -\item {\bf ... :} -\item {\bf ... :} -\item {\bf ... :} -\item {\bf ... :} -\end{enumerate} - - -% -\section{More details for some of the steps} -\label{.detail} - -% -\subsection{Load your data} -\label{.detail.load} - -% -\subsection{Inspect the data file layout} -\label{.detail.layout} - - diff --git a/src/doc/latex/rcp_batch_processing_tmp.text b/src/doc/latex/rcp_batch_processing_tmp.text deleted file mode 100644 index 8d33d5919d42ed8cedc19698ac73354cd4150a1f..0000000000000000000000000000000000000000 --- a/src/doc/latex/rcp_batch_processing_tmp.text +++ /dev/null @@ -1,64 +0,0 @@ -% -% -% -% -% -\chapter{Processing recipe: Simple Batch Processing} -\tableofcontents - -% -\section{Scope of the recipe} -\label{.scope} - -........... - -% -% -% - -% -% -% -% -% -% -% -% -% -% - - -% -\section{Introduction and background} -\label{.intro} - - -% -\section{Summary of the recipe} -\label{.summary} - -The following is a step-by-step summary of the processing recipe. For some of these steps, more detail is provided below. - -\begin{enumerate} -\item {\bf Load your data:} from tape or optical disk (NSCAN, option ....). See also Recipe ``Reading data in Dwingeloo''. -\item {\bf Inspect the data file layout:} (NSCAN, option ...). -\item {\bf ... :} -\item {\bf ... :} -\item {\bf ... :} -\item {\bf ... :} -\end{enumerate} - - -% -\section{More details for some of the steps} -\label{.detail} - -% -\subsection{Load your data} -\label{.detail.load} - -% -\subsection{Inspect the data file layout} -\label{.detail.layout} - - diff --git a/src/doc/latex/rcp_circ_polarisation.tex b/src/doc/latex/rcp_circ_polarisation.tex deleted file mode 100644 index 6c00045785ef54922bc549ff4540ad134dcdfa0b..0000000000000000000000000000000000000000 --- a/src/doc/latex/rcp_circ_polarisation.tex +++ /dev/null @@ -1,59 +0,0 @@ -% JPH 940916 Make compilable -% -% @(#) rcp_circ_polarisation.tex v1.2 04/08/93 RGS -% -\chapter{Processing recipe: Circular Polarisation} -\tableofcontents - -Author: R.G. Strom - -%=============================================== Standard subsection ====== -\section{Scope of the recipe} -\label{.scope} - -........... - -%--------------------------------------------------------------------------- -% If possible, supply an idea for an "appetizer" picture, which gives an -% idea of what can be achieved with this recipe. - -%\begin{figure}[htbp] -%\vspace{10cm} -%\caption[010 processing appetizer:...] % appears in listoffigures -%{\label{.appetizer}} -%\begin{center}\parbox{0.9\textwidth}{\it % actual caption if long -%010 processing appetizer:... -%\\This result was obtained in the following way: -%\\Note the following features: -%}\end{center} -%\end{figure} - - -%=============================================== Standard subsection ====== -\section{Introduction and background} -\label{.intro} - - -%=============================================== Standard subsection ====== -\section{Summary of the recipe} -\label{.summary} - -The following is a step-by-step summary of the processing recipe. -For some of these steps, more detail is provided below. - -\begin{enumerate} -\item {\bf Load your data:} -from tape or optical disk (NSCAN, option ....). -See also Recipe ``Reading data in Dwingeloo''. -\item {\bf Inspect the data file layout:} (NSCAN, option ...). -\item {\bf ... :} -\item {\bf ... :} -\item {\bf ... :} -\item {\bf ... :} -\end{enumerate} - - -%=============================================== Standard subsection ====== -\section{More details for some of the steps} -\label{.detail} - diff --git a/src/doc/latex/rcp_continuum_21cm.tex b/src/doc/latex/rcp_continuum_21cm.tex deleted file mode 100644 index 0a22f7af6ad1437b2baf5ff12c15195ac66fac44..0000000000000000000000000000000000000000 --- a/src/doc/latex/rcp_continuum_21cm.tex +++ /dev/null @@ -1,84 +0,0 @@ -% -% @(#) rcp_continuum_21cm.tex v1.2 04/08/93 AGB -% -% History: -% JPH 940914 Comment out 'processing appetizer' -% -% -\chapter{Processing recipe: Continuum measurements at 21 cm} -\tableofcontents - -Author: A.G. de Bruyn - -%=============================================== Standard subsection ====== -\section{Scope of the recipe} -\label{.scope} - -21 cm - -6 cm - -49/92 cm ........... - -%--------------------------------------------------------------------------- -% If possible, supply an idea for an "appetizer" picture, which gives an -% idea of what can be achieved with this recipe. - -%\begin{figure}[htbp] -%\vspace{10cm} -%\caption[004 processing appetizer:...] % appears in listoffigures -%{\label{.appetizer}} -%\begin{center}\parbox{0.9\textwidth}{\it % actual caption if long -%004 processing appetizer:... -%\\This result was obtained in the following way: -%\\Note the following features: -%}\end{center} -%\end{figure} - - -%=============================================== Standard subsection ====== -\section{Introduction and background} -\label{.intro} - - -%=============================================== Standard subsection ====== -\section{Summary of the recipe for 21cm} -\label{.summary} - -The following is a step-by-step summary of the processing recipe. For some of -these steps, more detail is provided below. - -\begin{enumerate} -\item {\bf Load your data:} from tape or optical disk (NSCAN, option ....). See -also Recipe ``Reading data in Dwingeloo''. -\item {\bf Inspect the data file layout:} (NSCAN, option ...). -\item {\bf ... :} -\item {\bf ... :} -\item {\bf ... :} -\item {\bf ... :} -\end{enumerate} - - -%=============================================== Standard subsection ====== -\section{More details for some of the steps} -\label{.detail} - -%------------------------------------------------------------------------- -\subsection{Load your data} -\label{.detail.load} - -%------------------------------------------------------------------------- -\subsection{Inspect the data file layout} -\label{.detail.layout} - -%======================================================================= -%======================================================================= - -%=============================================== Extra subsection ====== -\section{Processing 6cm continuum data} -\label{.6cm} - - -%=============================================== Extra subsection ====== -\section{Processing 49/92cm continuum data} -\label{.49/92cm} diff --git a/src/doc/latex/rcp_dynamic_range.tex b/src/doc/latex/rcp_dynamic_range.tex deleted file mode 100644 index a6cda0c6a1d01b49d52b760a9c5fe0c8a8c574bd..0000000000000000000000000000000000000000 --- a/src/doc/latex/rcp_dynamic_range.tex +++ /dev/null @@ -1,6 +0,0 @@ -% -% @(#) rcp_dynamic_range.tex v1.2 04/08/93 JEN -% -\chapter{Processing recipe: High Dynamic Range} -\tableofcontents - diff --git a/src/doc/latex/rcp_external_calibrators.tex b/src/doc/latex/rcp_external_calibrators.tex deleted file mode 100644 index 0a7c5815b0caa05db97c7a730d27181c37fd26fb..0000000000000000000000000000000000000000 --- a/src/doc/latex/rcp_external_calibrators.tex +++ /dev/null @@ -1,6 +0,0 @@ -% -% @(#) rcp_external_calibrators.tex v1.2 04/08/93 JEN -% -\chapter{Processing recipe: External Calibrators} -\tableofcontents - diff --git a/src/doc/latex/rcp_line_21cm.tex b/src/doc/latex/rcp_line_21cm.tex deleted file mode 100644 index f13928a518b4ef804971534081dc4123bb7b6bb2..0000000000000000000000000000000000000000 --- a/src/doc/latex/rcp_line_21cm.tex +++ /dev/null @@ -1,366 +0,0 @@ -% -% @(#) rcp_line_21cm.tex v1.2 04/08/93 AGB -% -% History: -% JPH 940914 Comment out 'processing appetizer' -% -% -\chapter{Processing recipe: 21cm line observations} -\tableofcontents - -Author: A.G. de Bruyn - - -%=============================================== Standard subsection ====== -\section{Scope of the recipe} -\label{.scope} - -This recipe deals with the reduction of a 21cm line dataset. It describes the -calibration of the (complex) passbands using one or more calibrators, the -flagging of bad data and the production of an image cube. It shows you how to -display this image cube in a movie-like fashion using GIDS. The recipe also -includes a description of how to visually identify groups of bad datapoints -(e.g. bad interferometers or bad channels) and flag/clip those data. If the -field is littered with bright continuum sources at the edge of the field, or -when you are working with a relatively wide band, the subtraction of the -continuum in the image plane will produce undesirable chromatic effects (the -continuum emission itself will go away but not their frequency- scaled sidelobe -and grating-lobe responses). A simple procedure to remove the continuum in such -cases will be given. - -%--------------------------------------------------------------------------- -% If possible, supply an idea for an "appetizer" picture, which gives an -% idea of what can be achieved with this recipe. - -%\begin{figure}[htbp] -%\vspace{10cm} -%\caption[001 processing appetizer:...] % appears in listoffigures -%{\label{.appetizer}} -%\begin{center}\parbox{0.9\textwidth}{\it % actual caption if long -%001 processing appetizer:... -%\\This result was obtained in the following way: -%\\Note the following features: -%}\end{center} -%\end{figure} - - -%=============================================== Standard subsection ====== -\newpage -\section{Introduction and background} -\label{.intro} - -This recipe describes the series of steps to go through when you want to -calibrate a WSRT 21cm line observation. It assumes that the S/N in the data is -rather low and that selfcalibration is not required. It also assumes that you -do not have to clean the final images. - - -%=============================================== Standard subsection ====== -\section{Summary of the recipe} -\label{.summary} - -The following is a step-by-step summary of the processing recipe. For some of -these steps, more detail is provided below. - -\begin{enumerate} -\item {\bf Load your data:} from tape or optical disk (NSCAN). See also Recipe -005. -\item {\bf Inspect the data file layout:} (NSCAN) -\item {\bf Determine complex passbands:} from a calibrator (NCALIB) -\item {\bf Inspect the calibration quality:} (NPLOT) -\item {\bf Transfer the calibration corrections:} (NCALIB) -\item {\bf Make a preliminary cube of images:} (NMAP) -\item {\bf Inspect the image cube:} (NGIDS) -\item {\bf Subtract the continuum:} (NMAP) -\item {\bf Make a cube of (calibrated) visibilities:} (NMAP) -\item {\bf Inspect the UV-data cube:} (NGIDS) -\item {\bf Plot your images:} (NPLOT) -\item {\bf Transfer your images to GIPSY or AIPS:} for further analysis. -\item {\bf Dealing with remaining imperfections:} If there are bad groups of -datapoints or if the continuum has not been removed satisfactorily the -following additional steps may be required: - \begin{itemize} - \item {\bf Flag bad groups of data:} (NSCAN) - \item {\bf Make a new image cube:} (NMAP) - \item {\bf Find and Update source parameters:} - of discrete continuum sources(NMODEL) - \item {\bf Make a new image cube:} - with discrete sources subtracted (NMAP) - \end{itemize} Then proceed with step 7 and iterate if necessary. -\end{enumerate} - - - - -%=============================================== Standard subsection ====== -\section{More details for some of the steps} -\label{.detail} - - -%------------------------------------------------------------------------- -\subsection{Load your data} -\label{.detail.load} - -Log in on the computer on which you want to read in the data. At present this -is either the microVAX (RZMVX4) or the Alliant. You load data with the program -NSCAN, option LOAD. Before you load your data you must know with what time -resolution you want to read in the data, and which channels you wish to -process. If your object is confined to a small region (say less than 10 arcmin) -it may be sufficient to use 120 seconds averaging. If you wish to synthesize -bigger fields I recommend using 60 seconds averaging, in order to avoid too -much tangential smearing. If the data were Hanning tapered in Westerbork -reading in every other channel may speed up the processing by a factor of two. -Hence for a 32 channel observation you could answer at the channel question: "2 -to 28 by 2". Reading in the continuum channel (channel 0) is generally not -necessary; it contains continuum data with contaminating line emission. It is -also advised to read in the calibrator data into the same scanfile. If you do -this in the second jobstep the data will be assigned the next highest 'group -index'. - -%------------------------------------------------------------------------- -\subsection{Inspect the file layout and flag/clip bad points} -\label{.detail.inspdata} - -To find out how the data in the file is organized, and how you can access -certain subsets of it, it is suggested to move 'up and down' within the program -NSCAN. There are five levels of actions to choose, all of which work on -different parts of the dataset. The layout of the file, or the function of the -five-digit 'index' that points to the various observations, channels etc. is -particularly important to memorize. To avoid that obviously bad points (e.g. -correlator spikes) ruin the calibration solution you may wish to flag -('delete') any points with a value higher than a certain limit. Usually the -occurrence of correlator spikes is noted on the information you receive from -Westerbork/Dwingeloo. Flagging is done on a point-by-point basis using the -amplitude of the visibility. Be careful when you use this option if you have no -information on the amplitude range which is normal. Preliminary clipping of -calibrator data is generally not necessary. During program execution it will -inform you at which hourangles interferometers have been clipped. The cutoff -value for the object data can of course be much lower. When visibility samples -have been clipped they will be ignored in all programs. You can also undo any -clipping; you do this by first typing "undelete" at the question where the type -of flagging criterion is selected (HA, AN, RN, IFR, CLIP ...). - -%------------------------------------------------------------------------- -\subsection{Determine the instrumental gains/phases across the passband} -\label{.detail.passband} - -Run the (self-)calibration program NCALIB (option redundancy) for the -calibrator source(s). In order to do this you need a 'model' for the calibrator -field containing the fluxes and positions of the calibrator source and any -(strong) surrounding sources (see Recipe 013: Using external calibrators). -Depending on observing frequency and source there could be anywhere between one -and many hundreds of sources in the model file. Upon execution the complex -gains are determined, and stored, per telescope/polarisation for each time -interval and channel. - -%------------------------------------------------------------------------- -\subsection{Plot the calibration results} -\label{.detail.plotcal} - -In order to decide which calibrator(s) to use, or which part of the calibration -observation, you must inspect the quality of the output from the calibartor -NCALIB run. Both the printed LOG from the previous step and/or a plot of the -telescope complex gains and the residuals from the (self-) calibration solution -are helpful to make up your mind. The program NPLOT (options 'telescope' and -'residuals') does the plotting. In general it suffices to plot one channel, -somehwere in the middle of the band, to judge the quality of the gains (called -amplitude) and phases for the various telescopes. Phase and gain slopes across -the passband are usually the same, to first order, for all telescopes. Phase -drifts at 21cm are typically a few degrees of phase over a 12 hour period; gain -drifts -should generally be less than a few %. Gain/phase offsets however may -occasionally be larger. Consult the printout which contains summary information -for each channel. If there are no instrumental problems the gain and phase -errors should be equal to the thermal noise values (see Appendix ....). - - -%------------------------------------------------------------------------- -\subsection{Transfer the gains/phases from the calibrator(s)} -\label{.detail.transcal} - -The corrections from the calibrator(s) are averaged over all available (non- -flagged) hourangle scans and stored in each scan of the object scanfile. If -your calibrator observations have equal length, and no scans have been flagged, -the resulting value is just the mean of the individual calibrator averages. -There is no provision to weight for the S/N ratio or the amplitude of the -calibrator. This means that the transferred gains/phases are representative for -a point in time halfway the time of the calibrator observations. This would be -a good assumption for gain/phase drifts that go linear with time. For galactic -21cm line observations you will have calibrators observed at frequencies lower -and higher (usually by about 1 MHz) than the frequency of your object. Usually -these are scheduled before and after the time of observation of your object but -this is not essential. If the calibrator observations have equal length then -the averaged gain/phase would be appropriate for a frequency halfway the -calibrator frequencies as if there is a linear gain/phase drift with frequency. -If your object frequency is not halfway in frequency between the frequencies of -the calibrators and you want to store gains/phases in your object file that -refer to the frequency of your object, on the assumption that the gains/phase -vary linearly with frequency, than you may play around with the length of the -respective calibrator observations. This can be done using the NSCAN program -(option DELETE, suboption HA (delete). - -%------------------------------------------------------------------------- -\subsection{Make a cube of images} -\label{.detail.makecube} - -Assuming that you do not want to selfcalibrate the object data (which for line -observations is usually the case) you can now proceed to make an image cube. -When making images you want to delete any obviously bad baselines. Because you -do not yet know whether such bad baselines exist you might as well proceed with -making your first series of images. It is possible to exclude visibilities that -have an amplitude higher than a certain value. This clipping is not permanent, -but only for the execution of NMAP. If the images look good, then all -participating baselines are probably good. In an observations with 32 frequency -channels, channel 1,29,30 and 31 are usually of poor quality so one would make -maps of channels 2 through 28 only. Note that the 3d digit in the index of the -.WMP cube will always start counting at 0 and continues through 26. That is, -channel 2 is really designated 0.0.0 and channel 28 is 0.0.26. - - -%------------------------------------------------------------------------- -\subsection{Visual inspection of images} -\label{.detail.visinsp} - -Making final, good quality, images is generally an iterative procedure where -you work in both the image plane and the UV-plane. This procedure is fastest if -you can load the cubes directly into the memory of your display (e.g. X- -terminal or workstation). GIDS, the Gipsy Image Display System, is a very -useful program to do this. Currently it only runs on the Sun If you want to -analyse the images in detail, using programs in GIPSY or AIPS) you will have to -make FITS-images first. This can also be done using NMAP (option w16fits or -w32fits) but is not shown here. Before you can run GIDS (via dwe NGIDS) you -have to switch to an X-terminal (in Dwingeloo we have four HP X-terminals) or -one of the two colour displays on the SUN (IPX's). - -%------------------------------------------------------------------------- -\subsection{Subtract the continuum form the line channels} -\label{.detail.subcont} - -After inspecting the cube of line images you can decide which channels to use -for the continuum. Use the option FIDDLE (suboption SUM) to create an averaged -continuum image. Then use the option ADD to add the continuum channels with -weight -1 to each line image to create continuum-free line channels. - -%------------------------------------------------------------------------- -\subsection{Make a cube of the corrected visibilities} -\label{.detail.cubecorr} - -If the continuum-free line images look fine you are finished. However, there -may be problems at some low level caused by interference, correlator errors or -telescope/interferometer errors. Problems at certain position angles in the -images correspond to certain hourangles and could be due to short-lived -interference. An error pattern in the images, which is centered on the field -centre (fringe-stopping centre) and not on strong continuum sources, shows that -we are dealing with an additive, rather than multiplicative, error suggests -that we are dealing with (DC-) offsets in the backend. To find out which -baselines are causing the damage you can make a cube of the (calibrated) -visibilities before they are gridded and transformed. You should use the option -BASHA instead of UV in NMAP to generate such a cube. Answers to the questions -on FFT and map size should be the defaults that are suggested. The best way to -pick up low-level problems in the data (e.g. small offsets) is to create -outputs for the real (COS) and imaginary (SIN) data. Working with the -amplitudes and phases is generally only useful if you want to identify problems -of a multiplicative nature and when the signal is well above the noise per -visibility point. - - -%------------------------------------------------------------------------- -\subsection{Visual inspection of (calibrated) visibilities} -\label{.detail.inspcalvis} - -The cube of UV-data has a different size than that of the images. With samples -of 240 sec there are about 180 points in the horizontal direction and 152 -points in the vertical direction (4 x 38). By choosing an 18m baseline -increment when making the cube you will get the various baselines well -separated and makes it easier to count on the screen which baselines are bad. -The shortest baseline (9A=72m) is at the bottom of the 'image'. You can now -proceed to make a new series of images where baseline 5B should be thrown out. -Then you can define the 'continuum' channels and run NMAP to calculate an -average continuum channel. This is not shown here because you may want to do -this all in GIPSY or AIPS using FITS images. For the purpose of the -demonstration this was done in Dwingeloo and the final 'continuum corrected' -cube shows images of channels 7 though 23. These images were 512 x 512 in size -and covered an area of 0.6 degrees. - - -%------------------------------------------------------------------------- -\subsection{Make contour plots of images} -\label{.detail.contour} - -Use the program NPLOT, option MAP to make contour plots of images. There is a -variety of output devices. In Dwingeloo you could first send a plot to a -(graphics-) terminal (option REGIS) to check the contourvalues that you would -like to plot. When you are satisfied you can, by using the 'loop' option, send -a series of plots to the QMS plotter in either portrait (QMSP) or landscape -(QMS) mode. The former gives you, for square plotareas, somewhat more space to -plot in, if at least you want to restrict yourself to a single A4 sheet. -Dealing with the size question will take some experience. The default size of -1,1 will give you a plot of at most 5 inch. This is the case if the number of -grid points is a power of two (32, 64, 128 etc). When using a size greater than -1,1 on a power-of-two image area in landscape mode the plot will not fit on one -sheet and you have to use scissors and tape. On the portrait mode you can -actually increase the size to 1.4,1.4 before it needs more than a single A4 -sheet. - - -%------------------------------------------------------------------------- -\subsection{Transfer images to AIPS or GIPSY} -\label{.detail.transcube} - -You can use the FITS write option in NMAP to generate 2 byte or 4 byte integer -images in FITS format for further analysis in AIPS or GIPSY. - - - - - -%========================================================================== -\section{Dealing with remaining imperfections} -\label{.remain} - -If the inspection of the continuum subtracted image cube shows imperfections -due to bad data or poor continuum subtraction you have to continue the -reduction a bit further. - - -%------------------------------------------------------------------------- -\subsection{Further flagging of bad data.} -\label{.remain.flag} - -If the inspection of the visibility cube using NGIDS has indicated that there -are errors in certain hour-angles or baselines you can flag these using the -delete option in NSCAN. If there are only bad baselines you can also decide to -exclude these baselines when preparing the specifications for a new NMAP. That -is, you do not have to actively delete them. - -%------------------------------------------------------------------------- -\subsection{Make a new image cube.} -\label{.remain.newcube} - -If the new image cube shows, after subtracting some averaged continuum image, -residual (chromatic) grating rings due to strong sources at the edge of the -field you need to subtract these sources in the original UV-data. - -%------------------------------------------------------------------------- -\subsection{Finding and updating discrete source parameters.} -\label{.remain.sourcepar} - -In order to determine the flux densities and positions of these sources you -search the continuum image using the FIND option in NMODEL. To improve the -estimates of flux and coordinates you can use the UPDATE option in NMODEL. A -single update, using only the UV-data with coninuum emission, usually suffices. - The update algorithm will only work for discrete (point) sources. If there are -extended sources with residual grating lobes you need to use NCLEAN (option -Beam) to decompose that source into a number of delta- functions. The final -list of components (updated discrete sources and clean- components) can be -merged into one model file. - -%------------------------------------------------------------------------- -\subsection{Make a new image cube with sources subtracted.} -\label{.remain.subtr} - -Now you proceed with step 6, but subtract the list of sources found in the -previous step. - -%======================================================================= -%======================================================================= diff --git a/src/doc/latex/rcp_linear_polarisation.tex b/src/doc/latex/rcp_linear_polarisation.tex deleted file mode 100644 index 9869e0927cea27c76f8a2b1b5e0c5dde3d5b10bb..0000000000000000000000000000000000000000 --- a/src/doc/latex/rcp_linear_polarisation.tex +++ /dev/null @@ -1,231 +0,0 @@ -% -% @(#) rcp_linear_polarisation.tex v1.2 04/08/93 RGS -% -\chapter{Processing recipe: Linear Polarisation} - -Author: R.G. Strom -% JPH 951107 Break a paragraph that was too long for ndoc -% JPH 960326 Furtehr fix for this - - -\tableofcontents - -%=============================================== Standard subsection ====== -\section{Scope of the recipe} -\label{.scope} - - -For obtaining polarization maps from standard continuum observations (all four -dipole combinations must be present). See also the description of the program -NCALIB, part 3. - -%--------------------------------------------------------------------------- - -% If possible, supply an idea for an "appetizer" picture, which gives an -% idea of what can be achieved with this recipe. - - -%=============================================== Standard subsection ====== -\section{Introduction and background} -\label{.intro} - -In a normal WSRT continuum observation, four dipole combinations (XX, XY, etc.) -are measured for each fixed-movable (numbered-lettered telescope) baseline. -Since mid-1983, the standard configuration is for the X-dipoles in all -telescopes to be set parallel (hence the Y-dipoles are also). A polarization -code is recorded for each observation, which gives the X-dipole position angle -in the fixed and movable telescopes, in steps of $45^\circ$. The usual setting -for the X-dipoles is $90^\circ$ (i.e., directed toward increasing RA), which -gives a polarization code of 22. This results in the following definition of -the Stokes parameters: $$I={1\over2}(XX+YY)$$ $$Q={1\over2}(YY-XX)$$ -$$U={1\over2}(YX-XY)$$ $$V=-{i\over2}(XY+YX)$$ (where $i=\sqrt{-1}$). In the -remainder of this description it will be assumed that the observation being -corrected has code 22, and of course that all four dipole combinations have -good data. - -{\em Most continuum observations made before mid-1983 were done with the -dipoles in the movable telescopes rotated by $45^\circ$ to the fixed ones, -usually with polarization code 21 [or in any event with the digits differing by -an odd number]. For analyzing such observations, the user should consult with -the WSRT User Service in Dwingeloo. From time to time, calibration sources are -still observed in code 21 [generally indicated by `$+\times$' appended to the -source name]. In almost all line observations, only one or two of the dipole -combinations (XX, YY) are measured; they are of course unsuitable for -determining source polarization.} - -The determination of the (observed) Stokes $Q$ depends, as shown by the first -two equations above, upon how well the gains of the XX and YY channels can be -ascertained (since usually, $I>>Q$). For the $U$ and $V$ determinations, the -critical parameters are the dipole setting or orthogonality, and the -ellipticity. Moreover, since $V$ is usually small (i.e., $V<<U$) its -determination will also depend upon the quality of the XY and YX gains. The -other parameter required to correct the XY and YX combinations is the $X-Y$ -phase difference. The correction is usually small (since it should have been -determined and applied online in Westerbork) and has to be determined from an -observation of a polarized source, or a special `crossed' (code 21) calibration -source measurement. Finally, it may be necessary to correct for Faraday -rotation in the ionosphere (this is usually only necessary at 49 and 92 cm), -and for variations in the instrumental polarization if there is significant -emission beyond the central part of the primary beam. - -%=============================================== Standard subsection ====== -\section{Summary of the recipe} -\label{.summary} - -The following is a step-by-step summary of the processing recipe. For some of -these steps, more detail is provided below. - -\begin{enumerate} -\item {\bf Load your data:} from tape or optical disk (NSCAN, option LOAD) See -also Recipe ``Reading data in Dwingeloo''. -\item {\bf Inspect the data file layout:} (NSCAN, option SHOW) -\item {\bf Determine the instrumental gain and phase corrections for a strong -calibrator with known polarisation:} (NCALIB, option REDUN.) -\item {\bf Determine or set the instrumental polarization corrections for an -unpolarised calibrator:} (NCALIB, option POLAR.) -\item {\bf Map and inspect Stokes $Q, U, V$ for the calibrator (optional):} -(NMAP, followed by NPLOT or NGIDS.) -\item {\bf Copy (or set by hand) the instrumental polarization corrections for -the observed field:} (NCALIB, option POLAR COPY.) -\item {\bf Determine, and apply if necessary, the correction for ionospheric -Faraday rotation (optional, usually only necessary at 49/92 cm):} (NCALIB, -option SET FARADAY.) -\item {\bf Map and inspect $I, Q, U, V$ images of field:} (NMAP, followed by -NPLOT or NGIDS) -\item {\bf Primary beam correction for each Stokes parameter (may only be -necessary if source extends over large fraction of primary beam):} (NCALIB, -options BEAM\_FACTORS (for Stokes $I$) and INPOL* (where * = $Q, U, or iV$ for -the other three Stokes parameters).) -\item {\bf Map the final corrected image in all Stokes parameters:} (NMAP) -\end{enumerate} - - -%=============================================== Standard subsection ====== -\section{More details for some of the steps} -\label{.detail} - -%------------------------------------------------------------------------- -\subsection{Load your data} - - Remember that in addition to your own observation, you will probably -want to load one or more calibration source measurements. Choose an unpolarized -calibrator (3C 147 is probably the best) observed within a day of your -observation {\it and with the same instrumental settings} (load several -calibrators if you want to check on the repeatability of the solution), and a -polarized source (like 3C 286, except at 92 cm) to determine the $X-Y$ phase -difference. To locate calibration measurements, use ARCQUERY (see Appendix B). -General information on the use of external calibrators can be found in Recipe -13 (which refers to NCALIB option SET COPY), while loading data is described in -Recipe 5 (which refers to NSCAN option LOAD). - -%------------------------------------------------------------------------- -\subsection{Inspect the data file layout} - - Make certain, in particular, that all four polarization combinations -(XX, XY, etc.) are present in all observations to be used, and that the -calibrators are consistent with the observation to be corrected (frequencies -and bandwidths should be the same, although a change in spacing shouldn't make -any difference). If the time between calibrator and observation is more than a -day or two, it is also advisable to check that no frontends have been changed -(consult the logbook or reduction group). Inspect data for interference (which -may be polarized -- check the XY and YX combinations in particular) and other -defects. For more information on inspecting data files, see NSCAN option SHOW. - -%------------------------------------------------------------------------- -\subsection{Determine the instrumental polarization} - -Before determining the instrumental polarization using a calibrator, redundancy -and selfcal solutions must be applied (use SELFCAL and ALIGN in the NCALIB -option REDUN). This will also provide a useful check of the data quality. Note -that at 92 cm (and in some cases 49 cm) there are background sources which may -have to be included in the model used for ALIGN. Having run the ALIGN solution, -NCALIB can be used to calculate the instrumental polarization (POLAR\_OPTION: -CALC) and examine the result (POLAR\_OPTION: SHOW). Under normal conditions, -the orthogonalities and positions of most dipoles should be under $1^\circ$, -and the ellipticities generally under 1\%. Large values (more than a few -degrees or percent) probably indicate an instrumental problem (bad data) and -require further investigation. Run a solution on a different calibrator as a -check. Deviant points can be changed by hand (POLAR\_OPTION: EDIT). Tables of -instrumental polarization are also generated from time to time in Westerbork, -and the values can be entered by hand (POLAR\_OPTION: SET), or used to -cross-check the solution from NCALIB. - -As a check on the instrumental polarization thus generated, it may be useful to -make a map of an unpolarized calibrator if one has been observed for a few -hours or more during the same period (a shorter observation could also be used, -but the map might prove difficult to interpret). Make sure that SELFCAL and -ALIGN corrections have been successfully applied, and then look at the Q, U and -V maps (made with NMAP). Ideally, they should be zero; the residual as a -fraction of the flux density is an indication of the error which will be -present in the polarization map of your observation. (If your source is very -extended, however, the polarization error pattern generated by a point source -may be misleading). - -Finally, we have to determine (or at least check) the $X-Y$ phase difference. -This is best done using a linearly polarized calibrator (strictly speaking, a -source with strong U signal). The method assumes that V is much smaller than U -(since $YX=U+iV$, a nonnegligible V affects the $X-Y$ phase), which is usually -the case. The correction can be calculated (VZERO\_OPTION: CALC, ASK, etc.) and -applied to the data in several ways. Usually, the XY and YX phase zeroes have -been determined and applied on-line to sufficient accuracy for most -polarization maps, so the correction should be a few degrees or so. However, -there have been instances where the difference was as much as $30^\circ$, so it -is advisable to check. If various frequency channels are used, the phase -difference should be calculated for each one separately, as the correction is -usually frequency dependent. - -%------------------------------------------------------------------------- -\subsection{Correct the observation for instrumental polarization} - -If you are happy with the instrumental parameters as applied to the -calibrator(s), the values can be copied to your observation using NCALIB (under -POLAR\_OPTION select COPY). The corrections will then be applied to the data -when making a map with NMAP. If you have run selfcal (ALIGN) on your XX and YY -polarizations using a source model based on Stokes I ($XX+YY$), remember that -solving for gain (keyword SOLVE) could remove most of the Q signal. - -%------------------------------------------------------------------------- -\subsection{Correct for ionospheric Faraday rotation} - -At 49 and 92 cm, Faraday rotation in the ionosphere can be considerable. The -effect is to change the position angle (p.a.) of the plane of linear -polarization (for the WSRT the p.a. will always {\it increase}, so the shift is -systematic). Since the ionosphere changes throughout the day, the amount of -rotation may vary during an observation. This has two consequences: the average -position angle will be increased, and more seriously, if the differential -rotation exceeds about one radian, there will be decorrelation of the polarized -signal and distortion of the Q and U maps. - -To correct for ionospheric Faraday, the reduction group must be consulted to -generate the predicted rotation using ionosonde data and information about the -observation in question (the date, time and source position are needed, and the -correction should be done for a frequency of 1 GHz). This will produce a table -with hourly values of various parameters, including the source HA and the -amount of rotation. The HA and rotation at 1 GHz (both in degrees) have to be -entered in an ASCII file (see the description in NCALIB, option FARADAY under -SET\_OPTION), and the correction is applied using FARADAY. Note that the HAs do -not have to be hourly, or even regularly spaced: at night there may be little -change in the Faraday rotation, and a single correction might suffice. - -%=============================================== Extra subsubsection ====== -\subsection{Correct for primary beam instrumental polarization} -\label{.beam} - -The instrumental polarization determined from a calibrator is, strictly -speaking, only correct for a source at the beam center, though at most -frequencies the variation within the half-power primary beam is small. For -polarization mapping over large fields, there is a separate correction for -off-axis instrumental polarization (NCALIB: NMODEL - BEAM). - -%------------------------------------------------------------------------- -\subsection{How do I know that my data are correct? -- additional hints.} -\label{.hints} - -Errors; some error patterns; effect of source extent. - -Ionospheric effects and the I map. - -What can be done if a polarization combination is missing? - -Etc. - diff --git a/src/doc/latex/rcp_mosaic_21cm.tex b/src/doc/latex/rcp_mosaic_21cm.tex deleted file mode 100644 index 31461e0222b1ecdc4467b123c444b6f92fb91050..0000000000000000000000000000000000000000 --- a/src/doc/latex/rcp_mosaic_21cm.tex +++ /dev/null @@ -1,203 +0,0 @@ -% -% @(#) rcp_mosaic_21cm.tex v1.2 04/08/93 TG -% -% History: -% JPH 940914 Comment out 'processing appetizer' -% -% -\chapter{Processing recipe: Mosaicing at 21 cm} -\tableofcontents - -Author: T. Ghosh - -%=============================================== Standard subsection ====== -\section{Scope of the recipe} -\label{.scope} - -This recipe suggests a way for making a 21-cm continuum mosaic map. In this -example, a particular field was chosen where there were many previously-known -radio sources within the region to be mapped. Hence, we knew that there was -sufficient flux-density for almost all of the pointing centres to allow us to -run {\it selfcal}. If the user is not sure of having enough SNR for this, a -modified version can be used. Hence, consider this recipe as just a starting -point, and {\it add salt to your taste}. - -%--------------------------------------------------------------------------- -% If possible, supply an idea for an "appetizer" picture, which gives an -% idea of what can be achieved with this recipe. - -%\begin{figure}[htbp] -%\vspace{10cm} -%\caption[003 processing appetizer:...] % appears in listoffigures -%{\label{.appetizer}} -%\begin{center}\parbox{0.9\textwidth}{\it % actual caption if long -%003 processing appetizer:... -%\\This result was obtained in the following way: -%\\Note the following features: -%}\end{center} -%\end{figure} - - -%=============================================== Standard subsection ====== -\section{Introduction and background} -\label{.intro} - -In the mosaic mode of observation, during one 12-hour period the telescopes, -along with the fringe-stopping and the delay-tracking centres, cycle through a -grid of pointings a number of times. In Fig 003.1, we used a 13 x 5 grid of -these so called, {\it pointing centres}. There were about 21 cuts (or spokes), -each containing two scans of 10-s duration for each pointing centre. The total -40-MHz bandwidth at 21 cm is usually divided into eight 5-MHz channels -(although these are not contiguous). Hence, the data file had the following set -indices (see also Ch 3.): $$0.0.1-65.1-8.0-20$$ - -For a particular pointing centre, the reduction methodology is very much the -same as that in Recipe 004. {\bf However, all the maps are to be made using a -common reference point (NMAP-option REFERENCE)}. Usually, for a large number of -pointing centres, book-keeping etc. could be quite difficult. Here, all the -advantages of the Automatic Batch Processing facility (ABP, Appendix D) can be -very easily exploited. In the following section we detail all the steps, -indicating the pre-ABP, the ABP, and the post ABP stages, Stage I, II and III -respectively, that were used to generate the map in Fig 003.1. These three -stages also coincide with the {\em calibration using a different source}, the -{\em Selfcal-Model formation loop for all the pointing centres}, and the {\em -mosaicing} stages. - - -%=============================================== Standard subsection ====== -\section{Summary of the recipe} -\label{.summary} - -{\bf STAGE I:} - -\begin{enumerate} -\item {\bf Load your data:} Source data from tape or optical disk (NSCAN). See -also Recipe ``Reading data in Dwingeloo''. Also read the data from observations -of a calibration source, (e.g. 3C147 in the case of Fig 003.1) made just before -or after the {\em source field}. -\item {\bf Inspect the data file and flag bad points mentioned on the WSRT -green sheet :} (NSCAN, option SHOW etc). -\item {\bf Calculate antenna-based phase and gain correction factors for the -Calibrator data:} (NCALIB, option REDUNDANCY, suboption SELFCAL, using a model -file obtained from AGB ) -\item {\bf Copy the corrections to the source data:} (NCALIB, option SET, -suboption COPY) -\end{enumerate} - -{\bf STAGE II:} - -This stage could be batch processed (APPENDIX D). In the following, we first -write a name for each task, which briefly describes the function of the step -too. Within the bracket, we mention the programme to be used, and comment on a -few important input parameters. Depending upon the flux density of the -strongest source in the map of a particular pointing centre, the Stage is -stopped at various {\bf Exit points}. - -For each pointing centre: - -\begin{enumerate} -\item {\bf Raw:} (NMAP, make a $1024 x 1024$ pixel raw map of real size -$1^\circ .2 x 1^\circ .2$ ) -\item {\bf Find1:} (NMODEL, find model components down to a suitable limit e.g. -6 w.u. here) -\end{enumerate} - -{\bf Exit point 1:} If the flux density of the strongest component, $S_{h}$ is -less than limit~1 (12~w.u., here) - STOP - Proceed to next pointing centre. - -\begin{enumerate} -\item {\bf Upd1:} (NMODEL, Update the model list, delete sources weaker than a -certain limit after updating, e.g. 6 w.u) -\item {\bf Upd2:} (NMODEL, Second iteration of the above) -\item {\bf Self1:} (NCALIB, self-calibrate ONLY the PHASE of the data using -model, Upd2) -\item {\bf Sub1:} (NMAP, make $1^\circ .2 x 1^\circ .2$ map after subtracting -model, Upd2) -\end{enumerate} - -{\bf Exit point 2:} If $S_{h} < $ limit~2 (20 w.u. here) - STOP - Proceed to -next pointing centre. - -\begin{enumerate} -\item {\bf Find2:} (NMODEL, find model components from map, Sub1 down to a -suitable limit e.g. 5 w.u. here and add to the model, Upd2) -\item {\bf Upd3:} (NMODEL, update the model list, Find2 and delete sources -weaker than a certain limit e.g. 5 w.u here) -\item {\bf Upd4:} (NMODEL, second iteration of the above) -\item {\bf Self2:} (NCALIB, self-calibrate the data using model, Upd4) -\item {\bf Del1:} (NSCAN, delete scans with selfcal-amplitude and/or phase -noise $ > 2 \sigma$) -\item {\bf Sub2:} (NMAP, make $1^\circ .2 x 1^\circ .2$ map after subtracting -model, Upd4) -\end{enumerate} - -{\bf Exit point 3:} If $S_{h} < $ limit~3 (40 w.u. here) - STOP - Proceed to -next pointing centre. - -\begin{enumerate} -\item {\bf Find3:} (NMODEL, find model components from map, Sub2 down to a -suitable limit e.g. 2.5 w.u. here and add to the model, Upd4) -\item {\bf Upd5:} (NMODEL, update the model list, Find3 and delete soucres -weaker than a certain limit e.g. 2.5 w.u here) -\item {\bf Upd6:} (NMODEL, second iteration of the above) -\item {\bf Self3:} (NCALIB, self-calibrate the data using model, Upd6) -\item {\bf Del2:} (NSCAN, delete scans with selfcal-amplitude and/or phase -noise $ > 2 \sigma$) -\item {\bf Sub3:} (NMAP, make $ 1^\circ .2 x 1^\circ .2 $ map after subtracting -model, Upd6) -\end{enumerate} - -{\bf End of stage II} - -At this point, for all the pointing centres, one should have a good model list, -and a residual map. The common model components in the overlapping region can -be checked for positional agreement. These can be cross-checked against any -source within the region whose accurate position is known from the literature. -Usually, agreements within 1 arcsec was achieved at this stage, which was -already 1/10 th of the synthesised beam. - -Depending upon the quality of the maps, they can be grouped into four classes. - -{\bf A.} Good maps, where noise is already at the theoretical limit, though -there may still be residual sources, and their grating rings and sidelobes. - -{\bf B.} Maps containing grating rings from sources beyond the mapped region. - -{\bf C.} Maps with bad scans. - -{\bf D.} Maps with amplitude or/and Phase calibration problems. - -For Class B maps, make larger low-resolution maps and try to include the strong -(offending) source in the model list, and then start again at the beginning of -Stage I (retaining the 'outside sources', though). - -For Class C maps, search out the bad data (no easy-solution, sorry), delete it, -and start again. - -For Class D maps, there may be spurious sources in the model-list. Plot them, -(NPLOT) and try to locate suspects, delete these, and continue (refer to -sec..... if this doesn't help). - -{\bf STAGE III:} - -Once all the maps are of Class A-quality, do the following: - -\begin{enumerate} -\item {\bf Mkbeam :} (NMAP. Make beams for all the pointing centres) -\item {\bf Clean :} (NCLEAN, option UVC. Clean the entire map with the number -of components = 100, Gain = 0.1 and a Cycle-Depth value of 0.35) -\item {\bf Restore :} (NCLEAN, option UREST. Restore both the model and the -clean components) -\item {\bf Extract :} (NMAP, option FIDDLE, suboption EXTRACT. Write out a -smaller section of this map into one set index of a common map file that will -be the input for the MOSAIC combination, here, inner 700 x 700 pixels of each -pointing centre were used) -\item {\bf Mosaic :} (NMAP, option FIDDLE, suboption MOSC. This part of the -programme corrects the input maps for primary beam attenuation and then -averages them with proper weightage) -\item {\bf Ready to serve:} (NPLOT, NGIDS, write out FITS image and take it to -AIPS ..... use the garnish of your choice) -\end{enumerate} - - - diff --git a/src/doc/latex/rcp_mosaic_92cm.tex b/src/doc/latex/rcp_mosaic_92cm.tex deleted file mode 100644 index aa3ca417dd8fa39b0895b00a4deb952284a5642c..0000000000000000000000000000000000000000 --- a/src/doc/latex/rcp_mosaic_92cm.tex +++ /dev/null @@ -1,6 +0,0 @@ -% -% @(#) rcp_mosaic_92cm.tex v1.2 04/08/93 JEN -% -\chapter{Processing recipe: Mosaicing at 92 cm} -\tableofcontents - diff --git a/src/doc/latex/rcp_old_data.tex b/src/doc/latex/rcp_old_data.tex deleted file mode 100644 index d8fc393f21061c3ae152745ebda0849e6d345c06..0000000000000000000000000000000000000000 --- a/src/doc/latex/rcp_old_data.tex +++ /dev/null @@ -1,6 +0,0 @@ -% -% @(#) rcp_old_data.tex v1.2 04/08/93 JEN -% -\chapter{Processing recipe: Old WSRT data (1979-1984)} -\tableofcontents - diff --git a/src/doc/latex/rcp_pulsar_imaging.tex b/src/doc/latex/rcp_pulsar_imaging.tex deleted file mode 100644 index b5316e639bef76eb13e0db07a88e21286331469f..0000000000000000000000000000000000000000 --- a/src/doc/latex/rcp_pulsar_imaging.tex +++ /dev/null @@ -1,6 +0,0 @@ -% -% @(#) rcp_pulsar_imaging.tex v1.2 04/08/93 JEN -% -\chapter{Processing recipe: Pulsar Imaging} -\tableofcontents - diff --git a/src/doc/latex/rcp_read_data.tex b/src/doc/latex/rcp_read_data.tex deleted file mode 100644 index 9abaef624a9d43f131b0902131c73e209c717a1f..0000000000000000000000000000000000000000 --- a/src/doc/latex/rcp_read_data.tex +++ /dev/null @@ -1,44 +0,0 @@ -% -% @(#) rcp_read_data.tex v1.2 04/08/93 ARF -% -\chapter{Processing recipe: Reading WSRT Data (in Dwingeloo)} -\tableofcontents - -Author: A.R. Foley - -%=============================================== Standard subsection ====== -\section{Scope of the recipe} -\label{.scope} - -........... - -%\include{fig_rec1_005_block} % figure to be included? - -%=============================================== Standard subsection ====== -\section{Introduction and background} -\label{.intro} - - -%=============================================== Standard subsection ====== -\section{Summary of the recipe} -\label{.summary} - -The following is a step-by-step summary of the processing recipe. -For some of these steps, more detail is provided below. - -\begin{enumerate} -\item {\bf ... :} -\item {\bf ... :} -\item {\bf ... :} -\item {\bf ... :} -\end{enumerate} - - -%=============================================== Standard subsection ====== -\section{More details for some of the steps} -\label{.detail} - -%------------------------------------------------------------------------- -\subsection{..} -\label{.detail.x} - diff --git a/src/doc/latex/rcp_simulated_data.tex b/src/doc/latex/rcp_simulated_data.tex deleted file mode 100644 index d6796b828df07b0c1432d527c5236a2477381e39..0000000000000000000000000000000000000000 --- a/src/doc/latex/rcp_simulated_data.tex +++ /dev/null @@ -1,6 +0,0 @@ -% -% @(#) rcp_simulated_data.tex v1.2 04/08/93 JEN -% -\chapter{Processing recipe: Simulated UV Data} -\tableofcontents - diff --git a/src/doc/latex/rcp_spectral_dr.tex b/src/doc/latex/rcp_spectral_dr.tex deleted file mode 100644 index fff16a56b94681a25f670cc15c247b008b08cf33..0000000000000000000000000000000000000000 --- a/src/doc/latex/rcp_spectral_dr.tex +++ /dev/null @@ -1,6 +0,0 @@ -% -% @(#) rcp_spectral_dr.tex v1.2 04/08/93 JEN -% -\chapter{Processing recipe: High Spectral Dynamic Range} -\tableofcontents - diff --git a/src/doc/latex/rcp_uvfits_output.tex b/src/doc/latex/rcp_uvfits_output.tex deleted file mode 100644 index 787ed1e3913f2b91baf831db9a319b08eb06d598..0000000000000000000000000000000000000000 --- a/src/doc/latex/rcp_uvfits_output.tex +++ /dev/null @@ -1,6 +0,0 @@ -% -% @(#) rcp_uvfits_output.tex v1.2 04/08/93 JEN -% -\chapter{Processing recipe: Generating UVFITS tapes for AIPS} -\tableofcontents - diff --git a/src/doc/latex/rcp_variability.tex b/src/doc/latex/rcp_variability.tex deleted file mode 100644 index eb0f4ba2031890ad33b2679935688076b773878c..0000000000000000000000000000000000000000 --- a/src/doc/latex/rcp_variability.tex +++ /dev/null @@ -1,6 +0,0 @@ -% -% @(#) rcp_variability.tex v1.2 04/08/93 JEN -% -\chapter{Processing recipe: Variability} -\tableofcontents - diff --git a/src/doc/latex/rcp_very_old_data.tex b/src/doc/latex/rcp_very_old_data.tex deleted file mode 100644 index 447be848a85999be4fc5066b86d809b48854673d..0000000000000000000000000000000000000000 --- a/src/doc/latex/rcp_very_old_data.tex +++ /dev/null @@ -1,5 +0,0 @@ -% -% @(#) rcp_very_old_data.tex v1.2 04/08/93 JEN -% -\chapter{Processing recipe: Old WSRT data (1971-1979)} -\tableofcontents diff --git a/src/doc/latex/record_replay.tex b/src/doc/latex/record_replay.tex deleted file mode 100644 index d24e5975b337a96d0df867f7dbbc6491778b6f1d..0000000000000000000000000000000000000000 --- a/src/doc/latex/record_replay.tex +++ /dev/null @@ -1,136 +0,0 @@ -% ***.tex -% -% JPH 951113 -% -% -\newcommand{\bi}{ \begin{itemize} } -\newcommand{\ei}{ \end{itemize} } -\newcommand{\bn}{ \begin{enumerate} } -\newcommand{\en}{ \end{enumerate} } -\newcommand{\Em}[1]{ {\em #1}\/ } -\newcommand{\noi}{ \noindent } - -\chapter{ Capturing \NEWSTAR program runs for repeated execution } - -{\par \em Contributed by Johan Hamaker, November 1995 \centering \par} - -\tableofcontents - -\section{ Introduction } -\label{.intro} - - The \NEWSTAR mechanism for repetitive execution programs with a minimum of user interaction is through the definition of default parameter values in a process symbol table. - - While attractive in concept, this approach is rather difficult to handle in practice for several reasons: -\bi -\item There is a variety of mechanims involved and invoking the right one in each particular situation requires a thorough understanding of the entire parameter system. - -\item The symbol-table utilities \verb/dws[pecify]/ and \verb/dwv[iew]/ present the parameters in an arbitrary order, including (often a great number of) them that are irrelevant for the program run to be controlled. - -\item If a parameter is to be prompted for more than once during the program run, the successive values must be stored in the symbol table as successive value sets (separated by colons) for that parameter. -\ei -% -\noi These two effects combined make it difficult to keep track of the parameter set for a program run, in particular when a saved parameter set must be modified in detail to cover a slightly different situation. In practice, batch scripting has so far remained something of a black art mastered only by a few specialists. - - -\section{ The batch recording method } -\label{.batch} - - The idea of the batch recording method is very simple: The parameter values from a manually executed program run are saved an ASCII file rather than the symbol table. They are recorded precisely in the order in which they are actually obtained and with the literal values as typed in by the user, as in the following simple example for NSCAN: - -\spbegin \svbegin \begin{verbatim} - OPTION = sh - INPUT_SCN_NODE = ** - INPUT_SCN_NODE = f - FILE_ACTION = # - INPUT_SCN_NODE = t - FILE_ACTION = layout - FILE_ACTION = ov - OVERVIEW = obs - FILE_ACTION = q - INPUT_SCN_NODE = - OPTION = -\end{verbatim} \svend \spend - - For an identical re-execution of the program run, one may use this file as input. One may also edit it, however, to correct errors or instruct the program to prompt for those parameters that the user wants to control. For example, the above file could be edited to become: - -\spbegin \svbegin \begin{verbatim} - OPTION = SHOW ! 1 - INPUT_SCN_NODE = ** ! 2 - INPUT_SCN_NODE = /ASK ! 3 - FILE_ACTION = LAYOUT ! 4 - FILE_ACTION = OVERVIEW ! 5 - OVERVIEW = OBS ! 6 - FILE_ACTION = QUIT ! 7 - INPUT_SCN_NODE = "" ! 8 - OPTION = QUIT ! 9 -\end{verbatim} \svend \spend - - There are several important advantages over the use of the symbol table: -\bi -\item The parameters appear in the batch file precisely in the order in which they will be used. - -\item Indentation may be used as shown above to represent the 'parameter hierarchy' and the way the program branches back after completion of a request, making it easy to follow the program's execution while reading the batch file. - -\item Comments may be appended to parameter values to facilitate the tracing of errors. -\ei - - The method is implemented in three new commands: -\bi -\item \verb/ dwrec <program>.<ext>/ to record a run of \verb/<prorgam>/ in a - file \verb/<program>.<ext>/; - -\item \verb/ dwrep <program>.<ext>/ to replay the file. - -\item \verb/ dwren <program>.<ext>/ to [re]number the lines by appending a - comment to each line in the file, as shown above, for debugging - purposes -\ei - - -\section{ Creating a batch file } -\label{.create} - - To create a batch file, use the command - -\verb/ dwrec <program>.<extension>/ - -The program will be excuted in the normal way, the only difference being that a batch file is created containing lines of the form - -\verb/ <paremeter> = <value> ! <line number>/ - - The user's replies are stored litterally; this is unlike in the \NEWSTAR log files, where the value shown is the one actually used after interpretation of the user's reply by the parameter system. - - Parameters to be prompted for in later replays of the batch file must be given the value \verb:/ASK:. This may be done by editing the file, but it is also possible to instruct the system to set thids special value at recording time, by appending the string \verb/!?/ to the reply. As an example, we show the complete run that would create the second example of the \textref{preceding section}{.batch}. - -\indent \Em{ put script here} - - -\section{ Replaying a batch file } -\label{.replay} - - The command to replay a batch file is - -\verb/ dwrep <program>.<extension>/ - -The program will run in nthe normal way, taking inputs from the batch file and prompting the user only where the value \verb:/ASK: is specified. - - -\section{ Renumbering a batch file } -\label{.renumber} - - To renumber the lines, e.g. after manual addition of lines, use the command - -\verb/ dwren <program>.<extension>/ - - -\section{ Limitations } - - A fundamental limitation of the batch-recording method is that it fixes the order in which parameters must be read. Its typical use is for repeating the same operation with small variations, e.g. on different files, with different sector-set or map-set specifications etc. - - It is not suited for applications requiring more flexibility, such as running NMAP to make maps with a variable set of input 'jobs'. For such situations, a shell script could be used to dynamically generate a batch file from a prototype. Whether this will make a friendlier method than the present one (as used in WENSS adn WHISP) remains to be seen. - - - - - diff --git a/src/doc/latex/scn_file.tex b/src/doc/latex/scn_file.tex deleted file mode 100644 index 9c76e9c9e47513054fdef173002a94280cf55f44..0000000000000000000000000000000000000000 --- a/src/doc/latex/scn_file.tex +++ /dev/null @@ -1,410 +0,0 @@ -%scn_file.tex -% -% JPH 941125 -% HjV 950619 Correct some typo's -% JPH 960513 References to sch.dsc, sth.dsc -% -% -\newcommand{\bi}{ \begin{itemize} } -\newcommand{\ei}{ \end{itemize} } -\newcommand{\bn}{ \begin{enumerate} } -\newcommand{\en}{ \end{enumerate} } -\newcommand{\eg}{ {\em e.g. } } - -\title{ The .SCN file } -\maketitle - -\chapter{ Visibilities and associated data: The .SCN-file } - -{\par \em Contributed by Johan Hamaker, November 1994 \centering \par} - -\tableofcontents - -\section{ Overview of .SCN file contents} -\label{.scn.file} - -\input{ scn_summary.tef } - -\section{ The visibility hypercube and its dimensions } -\label{.hypercube} - -\input{scn_hierarchy.cap} - - Visibilities in a synthesis observation are functions of a series of -coordinate parameters. One may conceptually arrange them in a {\em hypercube} -whose coordinate axes correspond to these parameters; alternatively, this -hypercube may be visualised as a hierarchy in which each level corresponds to -one of the parameters. - - The organisational model used in the .SCN file is a hyprid, in which -the lowest levels form a compact array, which is embedded in a hierarchical -{\em index structure} for the remaining levels. The order of the parameters in -this arrangement is in principle quite arbitratry. \NEWSTAR's choice was -motivated by considerations of efficiency in both storage space and sorting for -the most important processes. The order is, from the bottom upwards: - -\bi -\item {\em Polarisation:} Each telescope contains 2 orthogonal dipoles named -{\em X} and {\em Y}. Depending on the observing mode, there may be 4 ({\em XX, -XY, YX, YY}), 2 ({\em XX, YY}) or 1 ({\em XX}) polarisation. - -\item {\em Interferometer:} The WSRT consisting of 14 telescopes, the number -of interferometers formed between the elements can be 91 at most. Depending -upon the availability of telescopes and the observing modes, the actual number -(NIFR) is usually somewhat smaller. In the .SCN file, the interferometers are -sorted in order of ascending baseline and assigned a sequence number from 0 to -NIFR-1. - -\item {\em Hour Angle:} The hour angle for the middle of the integration -interval to which the data pertain. Hour angles are referred to as such. The -integration interval is a multiple of 10 UT seconds and is defined by the user -when he reads in the data. - -\item {\em Frequency Channel:} For observations in several (NCHN) -simultaneous frequency bands, these bands are numbered from 1 through NCHN. In -a single observation, the bands are not necessarily equally wide and -equidistant. By convention, the sum of all bands is called the {\em continuum -channel} and assigned channel number 0. - -\item {\em Mosaic Subfield} or {\em Pointing Centre:} In a mosaic -observation, subfields are repeatedly observed in a fixed sequence. The fields -are assigned a sequence number starting at 0. By convention, field 0 is at the -mosaic centre. - -\item {\em Observation:} An observation is a 'container' holding all the data -that were read from a single WSRT observation {\em label} in a single run of -NSCAN.load. - -\item {\em Group:} A group is likewise a container holding all observations -loaded in a single NSCAN.load run. -\ei - - It is customary to loosely refer to the levels of this hierarchy as the -{\em dimensions} of a six-dimensional {\em data (hyper)cube}. One should bear -in mind, however, that the same 'dimension' may be of different magnitude in -different 'sub-cubes' of this hypercube or, in other words, that the 'cube' is -not regularly filled. - - -\subsection{ .SCN-file hierarchy and indexing } -\label{.hierarchy} - - An overview of the .SCN-file hierarchy is shown in -\figref{.scn.hierarchy}. The levels correspond to those discussed -\textref{above}{.hypercube}. We shall discuss them from the bottom up. - - It is worth noting that the scan and sector headers combined contain -all the information necessary to process the data. A sector may be divorced -from the .SCN file without impairing its ability to be processed. The index -blocks in the levels on top contain no 'scientific' information. Their only -purpose is to organise the sectors. - - -\subsubsection{ The scan} -\label{.scan} - - The {\em scan} is the fundamental agggregate of data in a .SCN file. It -is a two-dimensional array of visibilities for a single integration interval, -with polarisation and interferometer as its dimensions. - - Associated with this block of data is a {\em scan header}. It contains -descriptive data such as frequency and position parameters. In addition, it -holds tables of those gain and phase corrections that may change from scan to -scan, as well as data and correction statistics that are a measure of the -data's quality. The contents are listed in the \Srcref{definion -file}{nscan/sch.dsc}. - - -\subsubsection{ The sector} -\label{.sector} - - A sequence of scans that is contiguous in hour angle is grouped -together in a {\em sector}. The sector's contents are described in a {\em -sector header}. Like the scan header, it contains descriptive data, corrections -parameters that may be assumed to be constant for the time period covered by -the sector and data/correction statistics for all the sector's scans combined. -The contents are listed in the \Srcref{definion file}{nscan/sth.dsc}. - - -\subsubsection{ The indexing levels } -\label{.levels} -\label{.SCNSUM.indices} - - - The \textref{index structure}{file_indexing} in which the sectors are -organised follows the levels listed \textref{above}{.hypercube}. The -\verb/<sequence number>/ is an extra index that allows one to have more than -one sector for which the first four indices are identical. A complete -.SCN-sector designation reads: -\bi -\item[] \verb/<group>.<observation>.<field>.<channel>.<sequence number>/ -\ei - -\input{mosaic_sectors.cap} - - One particularly important application of this possibility is in the -organisation of the non-contiguous scans in a \whichref{mosaic observation}{ }. -In such an observation, the scans are not contiguous and therefore each -'hour-angle cut' forms a sector of its own (\figref{.mosaic.sectors}). - - - -\subsection{ How index values are allocated} -\label{.index.define} - -\input{scn_indices.cap} - - The method by which NSCAN allocates sector numbers is schematically -shown in \figref{.scn.indices}. The only control the user has is over the -allocation of groups: Every NSCAN.load operation creates a new group, and the -user defines which WSRT labels will be stored in that group. - - - -\section{ Visibility data, weights and flags } - - Each visibility point is stored in 3 contiguous 16-bit words. Two of -these represent the real and imaginary parts of the complex visibility in {\em -Westerbork Units} ({\em W.U}), 1 W.U = 5 mJy). Of the remaining two bytes, one -holds the 8 \whichref{{\em flags}}{}, the other a \whichref{{\em weight}} value -related to the 'probable error' in the data. - - -\section{ The headers } - - We give an outline here of the header contents. To inspect them in -detail, use the NSCAN SHOW or NFLAG SHOW functions. More complete though very -terse descriptions can be found in the definition files (see below). - - -\subsection{ The file header } - - At the beginning of the .SCN file is the {\em file header}. It contains -some administrative information such as the last time the file was opened for -writing, and pointers into the index structure. For more details see the -\srcref{definition}{wng/gfh.dsc} file. - - -\subsection{ The sector header } - - The sector header contains parametric data tha are constant throughout -the sector. The most important groups are the following: - -\bi -\item Coordinates: - \bi - \item right ascension (RA) and declination (DEC), both apparent and epoch; - \item start hour-angle (HAB) and increment between scans (HAI); - \item LSR frequency, frequency-channel number (CHN); - \item mosaic-subfield number (PTS); - \item telescope positions (RTP). - \ei - -\item Sector composition: Number of scans (SCN), number of - \whichref{polarisations}{} (PLN), bandwidth (BAND), interferometer list - (IFRP). - -\item Corrections: \whichref{dipole errors}{}. - -\item Noise statistics reported by the most recent - \textref{selfcal}{introduction.selfcal} extraction of corrections from - the visibilities. - -\item Administrative information: length of a scan header plus data (SCNL). -\ei For more details see the \srcref{definition}{nscan/sth.dsc} file. - - -\subsection{ The scan header } - - The scan header contains the parametric data that apply specifically to -one scan: - -\bi -\item Coordinate: Hour angle -\item Corrections: - \bi - \item Gain and phase corrections per - \textref{telescope}{introduction.SCNSUM}; - \item \textref{global}{introduction.selfcal} corrections that may vary with - hour angle: tropospheric and ionospheric refraction, extinction, - Faraday rotation, clock; - \ei -\item Noise statistics reported in the most recent - \textref{selfcal}{introduction.selfcal} extraction of corrections from - the visibilities. -\ei For more details see the \srcref{definition}{nscan/sch.dsc} file. - - -\section{ Operations on .SCN files in general} -\label{.operations} - -\subsection{ Creation } -\label{.creation} - -\bi -\item From WSRT observations files: \textref{NSCAN LOAD}{nscan_descr}. -\item From ATCA (Australia Telescope Compact Array) files: \whichref{NATNF - LOAD}{(undocumented)}. -\item From old (R-series) SCN-files: \textref{NSCAN FROM\_OLD}{nscan_descr}. -\item Simulated uv-data: \whichref{NSIMUL}{(undocumented)}. -\ei - - -\subsection{ Inspection } -\label{.inspect} - -Displays in tabular form: -\bi -\item Summary of contents: \textref{NSCAN SHOW}{nscan_descr}. -\item Summary of one sector or scan header at a time: \textref{NSCAN SHOW -CONT - [CONT]}{nscan_descr}. -\item Complete sector or scan header, one at a time: \textref{NSCAN SHOW CONT - [CONT] SHOW}{nscan_descr}. -\item Visibilities, weights, flags for one scan at a time: \textref{NSCAN -SHOW - CONT CONT DATA/WEIGHTS}{nscan_descr}. -\item Telescope gain/phase corrections averaged over a range of scans: - \textref{NCALIB SHOW}{ncalib_descr} -\item Telescope dipole corrections averaged over a range of scans: - \textref{NCALIB POLAR SHOW}{ncalib_polar} -\ei - -\noindent Graphic displays: -\bi -\item Object or model visibilities vs. hour angle: \whichref{NPLOT - DATA/MODEL}{ (undocumented)} -\item Object or model visibilities in the Cartesian UV plane: - \textref{NMAP..}{nmap_descr} -\item Gain/phase corrections vs. hour angle: \whichref{NPLOT - TELESCOPE}{ (undocumented)}. -\item Redundancy/Selfcal residuals: \whichref{NPLOT RESIDUAL}{ -(undocumented)} -\ei - - Additional possibilities for extracting. manipulating and displaying a -variety of items from the .SCN file are available in -\textref{NGCALC}{ngcalc_descr}. - - -\subsubsection{ Editing } -\label{.edit} - - Almost every value (observation parameters, corrections, etc) in the -SCN-file headers may be edited manually through \textref{NSCAN SHOW -EDIT}{nscan_descr}. The effect of changing a value may range from trivial to -catastrophic. If you run into a situation that you think can only be remedied -by manual editing, you do better to contact the \textref{\NEWSTAR -group}{people} first. - - -\subsection{ Export } -\label{.export} - -\bi -\item In UVFITS format (AIPS): \textref{NSCAN UVFITS}{nscan_descr} -\item Inspect a UVFITS file: \textref{NSCAN PFITS}{nscan_descr} -\ei - - -\subsection{ Reorganising sectors } -\label{.reorganise} - - You may want to reorganise the indexing of your sectors. This can be -done to some extent through the \textref{NSCAN REGROUP}{nscan_descr} function. - - -\subsection{ Deleting sectors } -\label{.delete} - - The most important reason why one would want to delete sectors is to -reclaim disk space. It would be fairly simple to provide a DELETE command that -would make sectors invisible, but this would not free any space. - - An equivalent result can be achieved, however: Use -\textref{NCOPY}{ncopy_descr} to copy those sectors that you want to keep to a -new .SCN file, then delete the old file. - -. -\section{ Operation on corrections in a .SCN file} -\label{.corrections} - - Operations on corrections generally fall into either of two categories: -\bi -\item Those that affect the gain/phase of individual dipole/interferometer - hannels. This encompasses all corrections, except - -\item Those dealing with polarisation. These are 'special' in that they - produce an effect of 'mixing' or 'crosstalk' between channels that -would - ideally be independent. -\ei - - -\subsection{ Gain/phase corrections} -\label{.gain.phase} - -\bi -\item Zero, manual set: \textref{NCALIB SET ZERO/MANUAL}{ncalib_descr} -\item Selfcal model fit: \textref{NCALIB REDUN}{ncalib_redun} -\item Shift the reference value of telescope phases: \textref{NCALIB - RENORM}{ncalib_redun} -\item Copy average corrections from one selection of scans to another one: - \textref{NCALIB SET COPY/CCOPY/LINE}{ncalib_descr} -\ei - - -\subsection{ Polarisation corrections } -\label{.polarisation} - -Dipole errors: -\bi -\item Zero, manual set: \textref{NCALIB POLAR ZERO/MANUAL}{ncalib_polar} -\item Estimation: \textref{NCALIB POLAR CALC}{ncalib_polar} -\item Copy average corrections from one selection of scans to another one: - \textref{NCALIB POLAR COPY}{ncalib_polar} -\ei -\noindent Phase-zero difference: -\bi -\item Manual set: \textref{NCALIB POLAR VZERO MANUAL}{ncalib_polar} -\item Estimation: \textref{NCALIB POLAR VZERO CALC}{ncalib_polar} -\item Copy average corrections from one selection of scans to another one: - \textref{NCALIB POLAR VZERO COPY}{ncalib_polar} -\ei - - -\subsection{ Controlling the application of corrections } -\label{.apply} - - Corrections are selectively applied to the visibilities whenever the -data is read into memory to be processed. By default, all available corrections -are selected. The user has the option to make his own selection. To this end, -start your program with the \whichref{/ASK switch}{}: -\bi -\item[] \verb: dwe <program> /ASK: -\ei This will result in a long series of prompts. Simply type a \verb/<CR>/ to -all, except those for the \verb/APPLY/, \verb/DE_APPLY/ and \verb/FLAG/ -parameters. More information can be found in the \textref{on-line -help}{introduction.help} texts. - - (We acknowledge that the appearance of many irrelevant prompts in this -situation is unsatisfactory. We hope to correct this situation in the future.) - - -\section{ Operations on flags } - -{\em Yet to be written } - - -\section{ Operations on model visibilities } -\label{.model} - -\bi -\item Inserting/modifying the internal model: Use the \textref{model - HANDLE}{nmodel_handle} interface in NMODEL, NCALIB or NMAP. -\item Deleting the indernal model: There is no operation to do this. See the - \textref{model HANDLE}{nmodel_handle} document for a workaround. -\ei - - - diff --git a/src/doc/latex/scn_summary.tef b/src/doc/latex/scn_summary.tef deleted file mode 100644 index e2a31e3be2b6f6c71cd6a165bedfaca717216543..0000000000000000000000000000000000000000 --- a/src/doc/latex/scn_summary.tef +++ /dev/null @@ -1,11 +0,0 @@ -% scn_summary.tef -\label{.SCNSUM} - - .SCN files hold all visibility data in \NEWSTAR. The basic unit of data is the {\em scan}, an array of visibilities for one mosiac subfield, hour angle and frequency channel, with polarisation (XX, XY, ,YX, YY) and interferometer sequence number as its two dimensions. Series of scans that are contiguous in hour angle together form a {\em sector}. The organisation of the sectors in a .SCN file will be discussed \textref{below}{.SCNSUM.indices}. - - It is a fundamental tenet of \NEWSTAR that visibility data are always stored as received from Westerbork. {\em Corrections} are stored separately as such, and only applied to the visibilities when the data are read in by a program. Thus, what changes during the history of a .SCN file is the correction tables, {\em not} the visibility data. - - An important mechanism for eliminating faulty data points is the use of {\em flags}. Since there are several different reasons for rejecting data, 8 different flag types are recognised. A {\em flag byte} is associated with each data point. Programs normally reject a data point if any one of these flags is set, but the user has the option ignore certain flag types. - - The {\em self-calibration} methods in \NEWSTAR rely on comparing the observed visibility data with the visibilities of a {\em source model} to find the instrumental errors. To economise on the lengthy calculations necessary to generate the {\em model visibilities}, the latter may be saved in the .SCN file for reuse. - diff --git a/src/doc/latex/selected_papers.tex b/src/doc/latex/selected_papers.tex deleted file mode 100644 index a9d5ef22a76a711d66c9ce128ede8e93d4c70655..0000000000000000000000000000000000000000 --- a/src/doc/latex/selected_papers.tex +++ /dev/null @@ -1,34 +0,0 @@ -% JPH 940916 Make compilable -% APX1_F.TEX: Belongs to NEWSTAR cookbook - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -\chapter{ Selected papers} - -There are some papers that are closely related to the material covered in this -cookbook, and may therefore be interesting to the user. Copies of these papers -are attached here. Others are mentioned in the bibliography of this Cookbook. - -%=============================================================================== -\section{NFRA ITR 198a by W.N.Brouw} - -{\it The N-series redundancy programs. Part 1 of 1: General introduction.} -\\by W.N.Brouw -\\NFRA Internal Techinical Report nr 198a, 2 sept 1992 - -%=============================================================================== -\section{Nature 1982 by J.E.Noordam and A.G.de Bruyn} - -{\it High dynamic range mapping of strong radio sources, -with application to 3C84.} -\\by J.E.Noordam and A.G.de Bruyn -\\Nature, Vol 299, No 5884, pp 597-600, 14 october 1982 - - -%=============================================================================== -\section{Experimental Astronomy 1992 by M.H.Wieringa} - -{\it An investigation of the telescope based calibration methods -`Redundancy' and `Self-cal'} -\\by M.H.Wieringa -\\Experimental Astronomy, Vol 2, pp 203-225, 1992 - diff --git a/src/doc/latex/show_edit.tex b/src/doc/latex/show_edit.tex deleted file mode 100644 index cf51aeb87b9139ee700349e275055eb49ed541cf..0000000000000000000000000000000000000000 --- a/src/doc/latex/show_edit.tex +++ /dev/null @@ -1,802 +0,0 @@ - -\chapter{SHOWing and EDITing data-file contents in \NEWSTAR} -\\ \\ -{\it -\indent Contributed by Wim Brouw, December 1993 \\ -\indent Revised/adapted by Johan Hamaker, June 1994 } - -\tableofcontents - - -\section{ Introduction} - - - The programs NSCAN, NFLAG, NMAP and NGCALC have a SHOW option, with an -EDIT sub-option. This EDIT sub-option can be used to examine and change any -field in the SCN, WMP and NGF files. - - The EDIT option can show and/or edit the contents of \NEWSTAR files. -All values ('fields'), with the exception of values determining the structure -of the file, may be edited individually (or in groups) by hand. This is -laborious, {\em but at least it is possible!} - - The different files contain a variety of blocks (e.g. STH - sector -header; MPH - map header). In addition to manipulating these fields, \NEWSTAR -programs know how to present their names and values in an intelligible form to -the user, and conversely how to interpret the user's editing instructions. - - After starting EDIT, the message: - - \verb/**** Editing STH **** (or MPH or ....)/ - -\noindent will appear, indicating the actual block available for editing at -this instant. - -\section{SHOW and EDIT} - - {\bf SHOW} gives a formatted display of the contents of the entire -"current" block (i.e. the block currently accessed through a navigating -command such as {\bf CONTINUE} or {\bf NEXT}. To display individual fields in -the block one uses the {\bf EDIT} option. Once in edit mode, one may both -display and modify fileds. - - The {\it display} commands for an individual field consist of the field -name, optionally followed by a colon and qualifying information. The various -types of qualifier will be discussed below. A display command becomes an {\bf -EDIT} command when followed by a comma plus one or more new values. - -\spbegin %.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+ -\svbegin \begin{verbatim} - *** Editing STH *** -\end{verbatim}\svend -% -\skeyword{EDIT} -\sprompt{(Edit: name [(offset)][/length][:format] , val [, ...])} -\sdefault{= "":} -\suser{ra:d} -% -\svbegin \begin{verbatim} - RA 0.06725881318561733 -\end{verbatim} -\svend -\spend %.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.- - -\noindent Note that \textref{pointer values}{.pointers} can not be shown this -way. - -\section{ Displaying data values and properties} - -\subsection{ Displaying data values in different formats } -\label{.show.in.format} - - Appending a format specifier to the colon overrides the default format -in which a value is displayed. Some of the possible formats are: - -\begin{tabular}{lll} - - &\verb/UB UI UJ/ &unsigned byte, I, J \\ - &\verb/SB SI SJ/ &signed same \\ - &\verb/XB XI XJ/ &hexadecimal same \\ - &\verb/OB OI OJ/ &octal same \\ - &\verb/AL<n>/ &<n> characters \\ - &\verb/E[<n>[.<m>]]/ &real \\ - &\verb/D[<n>[.<m>]]/ &double precision \\ - &\verb/EC or DC[<n>[.<m>]]/ &complex \\ - &\verb/{ED}{AHD}{FRD}[<n>[.<m>]]/ &Angle, hh:mm:ss, dd.mm.ss -for\\ - & &\ Fractions, radians, -degrees\\ -\end{tabular} - -\spbegin %.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+ -\svbegin \begin{verbatim} - *** Editing STH *** -\end{verbatim}\svend -% -\skeyword{EDIT} -\sprompt{(Edit: name [(offset)][/length][:format] , val [, ...])} -\sdefault{= "":} -\suser{ra:dhf} -% -\svbegin \begin{verbatim} - RA 01:36:51 -\end{verbatim} -\svend -\spend %.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.- -% -\spbegin %.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+ -\skeyword{EDIT} -\sprompt{(Edit: name [(offset)][/length][:format] , val [, ...])} -\sdefault{= "":} -\suser{ra:dhf10} -% -\svbegin \begin{verbatim} - RA 01:36:51.1615 -\end{verbatim} -\svend -\spend %.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.- -% -\spbegin %.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+ -\skeyword{EDIT} -\sprompt{(Edit: name [(offset)][/length][:format] , val [, ...])} -\sdefault{= "":} -\suser{ra:xj} -% -\svbegin \begin{verbatim} - RA 3fb137d4 -\end{verbatim} -\svend -\spend %.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.- -% - - The full list of available formats, including fieldsize indicators, -exists only in the form of a table in the program source file -\verb/wnctxt_x.for/. - - -\subsection{ Displaying parts of arrays} - - Elements of array fields can be selected by appending the start index -and the number of elements to the field name, as follows: - - \verb:- <name>[(<offset>)][,/<number>]: - -\noindent will show the value of \verb/<name>/. If an offset is given for a -multi-valued \verb/<name>/, the display will start at this value; if -\verb:/<number>: is given, only that many values will be shown. -Examples are given \textref{below}{.edit}. Remember that {\bf indices start at -0!}. - - -\subsection{ Displaying information about data fields} -\label{.show.meta} - -\begin{tabular}{lll} -&\verb/*/ &will show the entire block formatted in the same way as \\ -& &\ for a {\bf SHOW} command \\ -&\verb/:/ &will show the names and formats of all data fields in the -block \\ -&\verb/<name>:/ &will show format information for \verb/<name>/ \\ -\end{tabular} - -\noindent Examples: - -\spbegin %.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+ -\svbegin \begin{verbatim} - *** Editing STH *** -\end{verbatim}\svend -% -\skeyword{EDIT} -\sprompt{(Edit: name [(offset)][/length][:format] , val [, ...])} -\sdefault{= "":} -\suser{:} -% -\svbegin \begin{verbatim} - Known names: - LINK, XJ, , ; 0, 2, 1, 4 - LEN, SI, , ; 8, 1, 1, 2 - VER, SI, , ; 10, 1, 1, 2 - FIELD, AL, , ; 28, 1, 0, 12 - . - . - - RA, DAF12.7, , ; 40, 1, 0, 8 - DEC, DAF12.7, , ; 48, 1, 0, 8 - RTP, E12.4, , ; 124, 14, 0, 4 - NIFR, SJ, , ; 180, 1, 1, 4 - IFRP, XJ, , P:IFRT; 184, 1, 1, 4 - NFD, SJ, , ; 188, 1, 1, 4 - FDP, XJ, , P:FDW; 192, 1, 1, 4 - NOH, SJ, , ; 196, 1, 1, 4 - . - . - -\end{verbatim} -\svend -\spend %.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.- - -\noindent The entries in this table are: - -\begin{tabular}{lll} -&column 2: &the default \textref{display/value format}{.show.in.format} \\ -&column 3: &the byte offset of the field in the block \\ -&column 4: &the number of elements in the field \\ -&column 5: & *** ?? *** \\ -&column 6: &the byte size of a single element (which is the string -length\\ -& &\ for a character value) -\end{tabular} - - -\section{ Modifying data values } -\label{.edit} - - Most values in a data file can be edited. The field descriptors -outlined above for {\bf SHOW} are also valid for {\bf EDIT}. Edit commands are -charaterised by the presence of a {\bf comma} following the field descriptor: - -\indent \verb:<name>[<(offset)>][</number>], <value> [,<value>...]: - -\noindent will change the value(s) at the given field. Examples: - -% -\spbegin %.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+ -\svbegin \begin{verbatim} - *** Editing STH *** -\end{verbatim} -% -\skeyword{EDIT} -\sprompt{(Edit: name [(offset)][/length][:format] , val [, ...])} -\sdefault{= "":} -\suser{RTP,12 } -% -\svbegin \begin{verbatim} - RTP 12.0000 143.9919 287.9837 431.9756 575.9674 - 719.9592 863.9511 1007.9429 1151.9348 1295.9266 - 1367.9257 1439.9176 2663.8491 2735.8452 -\end{verbatim} -\svend -\spend %.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.- -% -\spbegin %.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+ -\skeyword{EDIT} -\sprompt{(Edit: name [(offset)][/length][:format] , val [, ...])} -\sdefault{= "":} -\suser{rtp(2)/2, 1, 2, 3, 4} -\sinline{ Note that names are not case-sensitive!} -% -\svbegin \begin{verbatim} - RTP 1.0000 2.0000 -\end{verbatim} -\svend -\spend %.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.- -% -\spbegin %.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+ -\skeyword{EDIT} -\sprompt{(Edit: name [(offset)][/length][:format] , val [, ...])} -\sdefault{= "":} -\suser{rtp, 0} -% -\svbegin \begin{verbatim} - RTP 0.0000 143.9919 1.0000 2.0000 575.9674 - 719.9592 863.9511 1007.9429 1151.9348 1295.9266 - 1367.9257 1439.9176 2663.8491 2735.8452 -\end{verbatim} -\svend -\spend %.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.- -% -\spbegin %.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+ -\skeyword{EDIT} -\sprompt{(Edit: name [(offset)][/length][:format] , val [, ...])} -\sdefault{= "":} -\suser{rtp(2), 287.9837, 431.9756} -% -\svbegin \begin{verbatim} - RTP 287.9837 431.9756 575.9674 719.9592 863.9511 - 1007.9429 1151.9348 1295.9266 1367.9257 1439.9176 - 2663.8491 2735.8452 -\end{verbatim} -\svend -\spend %.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.- -% -\spbegin %.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+ -\skeyword{EDIT} -\sprompt{(Edit: name [(offset)][/length][:format] , val [, ...])} -\sdefault{= "":} -\suser{link, 12} -% -\svbegin \begin{verbatim} Edit of field LINK not allowed - LINK 0007ec60 00000098 -\end{verbatim} -\svend -\spend %.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.- -% - - The last example demonstrates that certain fields cannot be changed -because the integrity of the file depends on them. This restriction may be -overridden by appending '{\bf ==}' to the field descriptor: - -\spbegin %.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+ -\svbegin \begin{verbatim} - *** Editing STH *** -\end{verbatim}\svend -% -\skeyword{EDIT} -\sprompt{(Edit: name [(offset)][/length][:format] , val [, ...])} -\sdefault{= "":} -\suser{link(1)==, 1} -% -\svbegin \begin{verbatim} - LINK 00000001 -\end{verbatim} -\svend -\spend %.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.- - - The value given is interpreted with the default format descriptor -displayed by the \textref{name command}{.show.meta}). A different format can -be used by giving a -\textref{format specifier}{.show.in.format}. - - For integers, the radix specifiers {\tt \%X} (hexadecimal), {\tt -\%D}(decimal) and {\tt \%O} (octal) can also be used. Values given as - - \verb/hh:[[mm][:[ss][.ttt]]/ or \\ -\indent \verb/dd.[mm].[ss][.ttt]]/ - -\noindent will be translated to degrees and saved in the appropriate F, -R or D format; - - - -\section{ Secondary blocks and substructures} -\label{.pointers} - - The header blocks directly accessible through {\bf SHOW/EDIT} contain -pointers to other blocks. When their value is listed, \verb/:P/ is appended, -meaning that the value is the address of a block on disk in the corresponding -format format. - - Certain fields in a block are arrays not of single values but of -sub-blocks of some type; an example are the interferometer entries in the OHW -block. When such a field is listed, \verb/:S/ is appended, meaning that this -is an array of subblocks. - - All secondary-block and substructure types known to the system -(i.e. not only those associated with the current block) are displayed by the -{\bf ::} command: - -\spbegin %.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+ -\skeyword{EDIT} -\sprompt{(Edit: name [(offset)][/length][:format] , val [, ...])} -\sdefault{= "":} -\suser{::} -% -\svbegin \begin{verbatim} - Known P: types: STH, FDW, OHW, SCW, SHW, FDX, GFH, IFRT, MDH, MDD, SGH, MDL, -SCH - IFRC, B, I, J, E, D, X, Y, S:SET, S:SRC, S:BCOR, S:MOZP, S:IFR, IFH -\end{verbatim} -\sinline{ {\rm :} indicates a sub-structure. The use of the data types {\em B, -I} etc. is explained \textref{elsewhere}{.data.arrays}. } -\svend -\spend %.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.- - - -\subsection{ Navigating secondary blocks} - - Specifying the name of a pointer will steer the editing process to the -block pointed at: - -\svbegin \begin{verbatim} - *** Editing STH *** -\end{verbatim} -% -\spbegin %.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+ -\skeyword{EDIT} -\sprompt{(Edit: name [(offset)][/length][:format] , val [, ...])} -\sdefault{= "":} -\suser{mdd} -% -\svbegin \begin{verbatim} - *** Editing STH *** -\end{verbatim} -\sinline{ So nothing happened: There is no MDD block attached to this STH -block.} -\svend -\spend %.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.- -% -\spbegin %.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+ -\skeyword{EDIT} -\sprompt{(Edit: name [(offset)][/length][:format] , val [, ...])} -\sdefault{= "":} -\suser{ifrp:} -% -\svbegin \begin{verbatim} - Edit data: IFRP, XJ, , P:IFRT; 184, 1, 1, 4 -\end{verbatim} -\svend -\spend %.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.- -% -\spbegin %.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+ -\skeyword{EDIT} -\sprompt{(Edit: name [(offset)][/length][:format] , val [, ...])} -\sdefault{= "":} -\suser{ifrp} -% -\svbegin \begin{verbatim} - *** Editing IFRT *** -\end{verbatim} -\sinline{ This time we succeeded!} -\svend -\spend %.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.- -% -\spbegin %.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+ -\skeyword{EDIT} -\sprompt{(Edit: name [(offset)][/length][:format] , val [, ...])} -\sdefault{= "":} -\suser{:} -% -\svbegin \begin{verbatim} - Known names: - IFR, XI, , ; 0, 88, 0, 2 -\end{verbatim} -\sinline{The IFR block is just an array of hex integers} -\svend -\spend %.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.- -% -\spbegin %.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+ -\skeyword{EDIT} -\sprompt{(Edit: name [(offset)][/length][:format] , val [, ...])} -\sdefault{= "":} -\suser{*} -% -\svbegin \begin{verbatim} - IFR 0a09 0b0a 0d0c 0b09 0100 - 0201 0302 0403 0504 0605 - . - . - -\end{verbatim} -\svend -\spend %.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.- -% -\spbegin %.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+ -\skeyword{EDIT} -\sprompt{(Edit: name [(offset)][/length][:format] , val [, ...])} -\sdefault{= "":} -\suser{\scr} -% -\svbegin \begin{verbatim} - *** Editing STH *** -\end{verbatim} -\sinline{ A null reply returns us to the parent block} -\svend -\spend %.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.- -% - - -\subsection{ Displaying/editing a substructure} - - An array of substructures can be shown in its entirety by: - - \verb/<name>/* - -\noindent Example: - -% -\spbegin %.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+ -\svbegin \begin{verbatim} - *** Editing SHW *** -\end{verbatim} -% - \skeyword{EDIT} -\sprompt{(Edit: name [(offset)][/length][:format] , val [, ...])} -\sdefault{= "":} -\suser{ifr/*} -% -\svbegin \begin{verbatim} - INFNR 16667 WTEL 0 OTEL 13 - RBAS 2736 NIH 2040 - - INFNR 16665 WTEL 0 OTEL 12 - RBAS 2664 NIH 2047 - . - . - - *** Editing SHW *** -\end{verbatim}\svend -\sinline{ Note that the current block is still \verb/SHW/.} -\spend %.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.- - - -\noindent A single sub-structure can be shown and edited by: - - \verb/<name>[(<index>)]/ - -\noindent Example: - -\spbegin %.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+ -\svbegin \begin{verbatim} - *** Editing SHW *** -\end{verbatim} -% -\skeyword{EDIT} -\sprompt{(Edit: name [(offset)][/length][:format] , val [, ...])} -\sdefault{= "":} -\suser{ifr} -% -\svbegin \begin{verbatim} - *** Editing S:IFR *** -\end{verbatim}\svend -\spend %.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.- -% -\spbegin %.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+ -\skeyword{EDIT} -\sprompt{(Edit: name [(offset)][/length][:format] , val [, ...])} -\sdefault{= "":} -\suser{*} -% -\svbegin \begin{verbatim} - INFNR 16667 WTEL 0 OTEL 13 - RBAS 2736 NIH 9120 -\end{verbatim} -\svend -\spend %.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.- -% -\spbegin %.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+ -\skeyword{EDIT} -\sprompt{(Edit: name [(offset)][/length][:format] , val [, ...])} -\sdefault{= "":} -\suser{\scr} -% -\svbegin \begin{verbatim} - *** Editing SHW *** -\end{verbatim} -\svend -\spend %.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.- -% -\spbegin %.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+ -\skeyword{EDIT} -\sprompt{(Edit: name [(offset)][/length][:format] , val [, ...])} -\sdefault{= "":} -\suser{ifr(5)} -% -\svbegin \begin{verbatim} - *** Editing S:IFR *** -\end{verbatim} -\svend -\spend %.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.- -% -\spbegin %.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+ -\skeyword{EDIT} -\sprompt{(Edit: name [(offset)][/length][:format] , val [, ...])} -\sdefault{= "":} -\suser{*} -% -\svbegin \begin{verbatim} - INFNR 17689 WTEL 2 OTEL 12 - RBAS 2376 NIH 9465 -\end{verbatim} -\svend -\spend %.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.- -% -\spbegin %.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+ -\skeyword{EDIT} -\sprompt{(Edit: name [(offset)][/length][:format] , val [, ...])} -\sdefault{= "":} -\suser{\scr} -% -\svbegin \begin{verbatim} - *** Editing SHW *** -\end{verbatim} -\svend -\spend %.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.- - - -\section{ Advanced options} - - The options described here are available for system programmers. -They assume a proper understanding of the architecture of Newstar data files -and of the mechanisms (.dsc and .def files) through which it is defined. No -attempt will be made here to help the reader on these points... - - The syntax of the advanced options is less intuitively clear than what -has been described above and its expressive power is limited. -In using it, the user will have to feel his way around, but he can safely do so -as long as he doesnot rashly attempt to change any values. - - -\subsection{ Linked lists} - - Link pointers in linked lists are similar to other pointers, except -that the type of the target block is not known a priori. It must therefore be -specified: - - \verb+<name>[(<index>)]::<target block type>+ - -\noindent For example: - -\spbegin %.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+ -\svbegin \begin{verbatim} - *** Editing STH *** -\end{verbatim}\svend -% -\skeyword{EDIT} -\sprompt{(Edit: name [(offset)][/length][:format] , val [, ...])} -\sdefault{= "":} -\suser{link::gfh} -% -\svbegin \begin{verbatim} - *** Editing GFH *** -\end{verbatim} -\svend -\spend %.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.- -% -\spbegin %.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+ -\skeyword{EDIT} -\sprompt{(Edit: name [(offset)][/length][:format] , val [, ...])} -\sdefault{= "":} -\suser{*} -% -\svbegin \begin{verbatim} - ID .SCN LEN 512 VER 1 - CDAT 21-Sep-1993 CTIM 17:23 RDAT 13-Jun-1994 - RTIM 16:16 RCNT 50 NAME A271A - DATTP 7 - LINK 00006550 00500e08 - ALHD 00006550 00500e08 - NLINK 4 ALLEN 4 - LINKG 00000200 008069c8 :P - LHD 00000200 008069c8 :P - NLINKG 2 LLEN 2 IDMDL 0 - ID1 0 ID2 0 USER 0 - -\end{verbatim} -\svend -\spend %.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.- -% -\spbegin %.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+ -\skeyword{EDIT} -\sprompt{(Edit: name [(offset)][/length][:format] , val [, ...])} -\sdefault{= "":} -\suser{\scr} -\sinline{ Return to STH} -% -\svbegin \begin{verbatim} - *** Editing STH *** -\end{verbatim} -\svend -\spend %.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.- - - -\subsection{ Data arrays} -\label{.data.arrays} - - Some pointers point to "naked" arrays of data structures. An example -is MDD in the STH which points to the array of complex model visibilities: - -\spbegin %.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+ -\svbegin \begin{verbatim} - *** Editing STH *** -\end{verbatim}\svend -% -\skeyword{EDIT} -\sprompt{(Edit: name [(offset)][/length][:format] , val [, ...])} -\sdefault{= "":} -\suser{mdd::z} -\sinline{ We try to display the array in complex format ...} -% -\svbegin \begin{verbatim} - MDD 006179c8 00000000 :P -\end{verbatim} -\sinline{ but the system does not understand us!} -\svend -\spend %.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.- -% -\spbegin %.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+ -\skeyword{EDIT} -\sprompt{(Edit: name [(offset)][/length][:format] , val [, ...])} -\sdefault{= "":} -\suser{mdd} -% -\svbegin \begin{verbatim} - *** Editing MDD *** -\end{verbatim} -\svend -\spend %.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.- -% -\spbegin %.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+ -\skeyword{EDIT} -\sprompt{(Edit: name [(offset)][/length][:format] , val [, ...])} -\sdefault{= "":} -\suser{*} -% -\svbegin \begin{verbatim} - MDD -540.55+72.69I 0.00+0.00I - 0.00+0.00I 0.00+0.00I - -540.50+72.76I 0.00+0.00I - 0.00+0.00I 0.00+0.00I - . - . - -\end{verbatim} -\sinline{ This works, but it is not clear how we could select specific elements -for display.} -\svend -\spend %.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.- - - - There are also data arrays whose address is defined implicitly by the -fact that they contiguously follow a header block. An example is the -scan-visibilities block headed by the SCN header. To access such data in the -absence of a pointer, one must use a -\textref{byte offset}{.abs.rel.address}. -For this we need the length of the header, which we can easily find. The -technique is demonstrated below is a somewhat different context, {\it viz.} -that of finding an SCH which is not directly pointed at. - -\spbegin %.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+ -\svbegin \begin{verbatim} - *** Editing STH *** -\end{verbatim}\svend -% -\skeyword{EDIT} -\sprompt{(Edit: name [(offset)][/length][:format] , val [, ...])} -\sdefault{= "":} -\suser{scnl} -% -\svbegin \begin{verbatim} - SCNL 1552 -\end{verbatim} -\sinline{\\ This is the length of an SCH plus the data.} -\svend -\spend %.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.- -% -\spbegin %.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+ -\skeyword{EDIT} -\sprompt{(Edit: name [(offset)][/length][:format] , val [, ...])} -\sdefault{= "":} -\suser{scnp} -% -\svbegin \begin{verbatim} - *** Editing SCH *** -\end{verbatim} -\svend -\spend %.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.- -% -\spbegin %.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+ -\skeyword{EDIT} -\sprompt{(Edit: name [(offset)][/length][:format] , val [, ...])} -\sdefault{= "":} -\suser{*} -% -\svbegin \begin{verbatim} - HA -90.1250124 deg MAX 1294.000 W.U. SCAL 0.000000 - REDNS 0.000 0.000 0.000 0.000 W.U. - . - . - -\end{verbatim} -\svend -\spend %.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.- -% -\spbegin %.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+ -\skeyword{EDIT} -\sprompt{(Edit: name [(offset)][/length][:format] , val [, ...])} -\sdefault{= "":} -\suser{.1552::sch} -\sinline{ Move to the next SCH. We can use multiples of SCNL to get to any of -the SCHs.} -% -\svbegin \begin{verbatim} - *** Editing SCH *** -\end{verbatim}\svend -% -\skeyword{EDIT} -\sprompt{(Edit: name [(offset)][/length][:format] , val [, ...])} -\sdefault{= "":} -\suser{*} -% -\svbegin \begin{verbatim} - HA -89.8743278 deg MAX 1349.000 W.U. SCAL 0.000000 - REDNS 0.000 0.000 0.000 0.000 W.U. - ALGNS 0.000 0.000 0.000 0.000 W.U. - . - . - -\end{verbatim} -\svend -\spend %.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.- - - - -\subsection{ Absolute and relative file addresses} -\label{.abs.rel.address} - - Absolute {\em file addresses} (i.e. byte offsets in the file) can be -used instead of field names. - - Relative addresses are byte offset relative to the start of the current -block. They are specified in the form - - \verb/.<offset>/ diff --git a/src/doc/latex/wmp_descr.tex b/src/doc/latex/wmp_descr.tex deleted file mode 100644 index 59269c7f33fb0964b430749b1a6a7c148e13b2f9..0000000000000000000000000000000000000000 --- a/src/doc/latex/wmp_descr.tex +++ /dev/null @@ -1,194 +0,0 @@ -% -% @(#) wmp_descr.tex v1.2 04/08/93 JEN -% JPH 940520 modernised -% HjV 950619 Correct some typo's -% -% -\chapter{The WMP-file (image data)} -\tableofcontents - -\section{Organisation of the WMP file: Maps} -\label{.organ} - - The \NEWSTAR WMP file contains `image data', i.e. a collection of -2-dimensional arrays of data. The various `images' in a WMP file {\it are -related in some way}, but do not have to have the same dimensions. Examples -are radio maps at various frequencies (line observations), polarisations, or -pointing directions (mosaicking). -There may also be antenna patterns and various kinds of residual maps, or even -rectangular arrays ov uv-data. - -%\include{fig_wmp_structure} % figure - -The basic unit in the WMP file is the Map (a 2-dimensional array of pixel -values). It can be selected by the user by means of 6 integer indices: -\\ \\ -\begin{tabular}{lll} -1) &group &spare index \\ -2) &field &pointing centre (mosaicing) \\ -3) &channel &frequency channel, or DCB band \\ -4) &polarisation &0=I or XX, 1=Q or XY, 2=U or YX, 3=V or YY \\ -5) &type &0=map, 1=ap, 2=cov, 3=real, 4=imag, 5=ampl, 6=phase \\ -6) &nseq &sequence number within each type \\ -\end{tabular} -\\ \\ -Indices may also be ranges of indices, or wildcards ($\ast$), as explained in -more detail in the section `Overview of \NEWSTAR files' in this Cookbook. -Note that the Map in the WMP-file plays the same role as the Set in the -SCN-file. - - All indices are just running numbers ({\bf starting at 0!}), except -`type' and `polarisation', which have fixed codes (see above). - - Neither the `field' nor the `channel' index nrs correspond with the -`field' or `channel' nrs in the SCN-file. The reason for this is that a map -may be made from a {\em combination} of fields or channels. - - Usually, all Maps belong to the same `group' (0). Therefore, the first -index is called a `spare index' here. However, any selection of Maps may be -put into a new group in the same WMP file, using the NMAP option REGROUP. - - The 6th index allows for a sequence of Maps of a certain type, usually -derived from each other. Examples are residual Maps after -\textref{CLEANing}{nclean_descr}, or the Maps that result from -\textref{combining other Maps}{nmap_descr.fiddle}. - - -\section{File layout and file header} -\label{.file.layout} - - A summary of the WMP-file contents and layout may be obtained by using -the program NMAP, option SHOW: - - -****** Put new script here ****** - - -This particular WMP-file actually contains the following (rather strange) -collection of Maps: -\sline{g.f.c.p.t.n (\#abs)} - \sinline{group.field.chan.pol.type.nseq} -\sline{0.0.0.0.2.0(\#0) type COVE } - \sinline{uv-coverage for XY-map} -\sline{0.0.0.0.6.0(\#1) type PHAS } - \sinline{map of XY phases} -\sline{0.0.0.0.0.0(\#2) type MAP } - \sinline{XY-map} -\sline{0.0.0.0.1.0(\#3) type AP } - \sinline{antenna pattern for XY-map} -\sline{0.0.0.1.6.0(\#4) type PHAS } - \sinline{map of Q phases} -\sline{0.0.0.1.0.0(\#5) type MAP } - \sinline{Q-map} -\sline{0.0.0.2.6.0(\#6) type PHAS } - \sinline{map of V phases} -\sline{0.0.0.2.0.0(\#7) type MAP } - \sinline{V-map} -\sline{0.0.0.3.6.0(\#8) type PHAS } - \sinline{map of iV phases} -\sline{0.0.0.3.0.0(\#9) type MAP } - \sinline{iV-map} - - -The 10 `datasets' (Maps) in this WMP-file belong to 1 `group' (1st index, =0). -The number in parentheses indicates the {\em absolute Map nr} within the file. - -Note that the number of polarisations is not really 4, and that the number of -types is not really 7. Indicated are the highest index values present, plus -one. - -The WMP file header only contains book-keeping information that allows the -program to find its way around: - - -****** Put new script here ***** - - -\section{The Map header} -\label{.map.header} - -Each Map in a WMP file contains a header with information, which can be -inspected with the program \textref{NMAP, option SHOW}{nmap_descr.show}: - - -****** Put new script here ***** - - -%------------------------------------------------------------------------------ - -\subsection{Explanation of items in the Map header} -\label{.header.items} - -\begin{itemize} -\item LINK: Link (pointer) to other Maps -\item LEN: Length of header block (bytes?) -\item VER: Version nr of the header -\item SETN: Abs Map (Set) nr, i.e. the one needed for direct reference - (e.g. \#setn) -\item FNM: Field (pointing centre) name -\item EPO: Epoch (e.g. 1950.0) -\item RA: RA of field centre (degr) -\item DEC: DEC of field centre (degr) -\item FRQ: Central frequency (MHz) -\item BDW: Bandwidth (MHz) -\item RAO, DECO, FRQO: Observed RA (degr), DEC (degr), freq (MHz) -\item ODY, OYR: Observed day (since January 0th) and year (since 1900) -\item DCD: Data code (2=I, 4=J, 5=E, 8=D) -\item PCD: Program code (0=NMAP) -\item SRA, SDEC, SFRQ: Separation in RA (degr), DEC (degr) and freq (MHz) -\item NRA, NDEC, NFRQ: Nr of points in RA, DEC and frequ -\item ZRA, ZDEC, ZFRQ: Centre RA (1st point=0), DEC (1st line=0), frequ (1st -map=0) -\item MXR, MXD, MXF: Position max in RA, DEC, frequ -\item MNR, MND, MNF: Position min in RA, DEC, frequ -\item MAX, MIN: Max, min map value -\item SHR, SHD, SHF: Shift in RA, DEC (add, degr?) or frequ (add, MHz) -\item SUM: Normalising sum -\item UNI: Multiplier to get Jy -\item UCM: User comment -\item NPT: Nr of input uv-data points -\item TYP: Map type (MAP, AP, COV, PHAS etc) -\item POL: Polarisation type (I,Q,U,V or XX,XY,YX,YY) -\item CD: Codes (array of 8 integer switches, 0-7): - taper type (0), convolution type (1), - correct for convolution (2), clipping done (3), - source subtraction (4), data type (5), - uv coordinate type (6), de-beam count (7) -\item EPT: Map epoch used (0=apparent, 1=as specified in EPO above) -\item OEP: Observation epoch (e.g. 1985.78) -\item NOS: Map rms noise (W.U.) -\item FRA, FDEC, FFRQ: Field size in RA (degr), DEC (degr), frequ (MHz) -\item TEL: Telescope name (e.g. WSRT) -\item FSR, FSD: FFT size RA, DEC -\item MDP: Map data pointer -\item NBL: Nr of baselines that have contributed to the Map -\item NST: Nr of uv-data sets that have contributed to the Map -\item VEL: Velocity (m/s) -\item VELC: Velocity code (0=continuum, 1=heliocentric radio, 2=LSR radio, - 3=heliocentric optical, 4=LSR optical) -\item VELR: Velocity at reference frequ (FRQC) -\item INST: Instrument code (0=WSRT, 1=ATCA) -\item FRQ0, FRQV, FRQC: Rest, Real and Centre frequency for line (MHz) -% -\end{itemize} - - - -\section{The Map data} -\label{.data} - - The actual data in a Map can be displayed on the X-screen as a color -map by using the program NGIDS, or as a contour or gray-scale plot with the -program NPLOT. However, its is also possible to inspect small areas of a WMP -Map, or its statistics, with the program NMAP, option -SHOW: - - -****** Put new script here ***** - - -Note that the `noise' option gives the rms of the pixel values in the selected -area(s), while the `offset' option gives the rms with respect to their average -value (offset). A histogram of pixel values is printed in the log-file -(NMAP.LOG). - diff --git a/src/doc/latex/wsrt_fact_sheet.tex b/src/doc/latex/wsrt_fact_sheet.tex deleted file mode 100644 index 2e48b114057baa0353c492164a06b0db77e33642..0000000000000000000000000000000000000000 --- a/src/doc/latex/wsrt_fact_sheet.tex +++ /dev/null @@ -1,90 +0,0 @@ -% JPH 940916 Make compilable - -\chapter{ WSRT fact sheet} - - -\section{Array} - - The WSRT array is shown in the figure \figref{.wsrt.layout}. The -regular spacings of the 1-dimensional array are designed to minimise the -side-lobe level in the un-CLEANed map (the WSRT array was designed in the early -sixties, before the invention of the CLEAN method for deconvolution in 1972). -The `waste' of uv-coverage is compensated somewhat by using the redundant -spacings for model-independent calibration. The very regular WSRT `beam' -enhances the map-reliability: its residual structure can be readily traced back -to the source of the problem, and it cannot easily be mistaken for real -structure in the map. - - The 1-dimensional East-West orientation of the WSRT array is -advantageous for wide-field mapping and deconvolution, because the instrumental -`point-spread function' (or `beam') with which the image is convolved, is -constant over the entire observed field. Disadvantages are the poor -North-South resolution for low-declination sources, and the impossibility of -making 2D `snap-shot' images. - -\input{../fig/wsrt_layout.cap} - - - The redundant spacings in the regular WSRT array can be used for -model-independent internal calibration. The visibilities measured by two -redundant interferometers (i.e. with the same baseline length and orientation) -must obviously be identical. Thus, any differences between them must be caused -by instrumental errors, including the effects of the Earth troposhere and -ionosphere. - - Maximum redundancy occurs if 9A=72m in the standard configuration -\figref{.wsrt.layout}: baselines 9A=AB=CD=72m, and 09=1B=AC=BD=1296m. In this -case, there is a `full redundancy solution' for both phase and gain, linking -the errors of all 14 telescopes. For other values of the distance 9A, there -will still be a full solution for the telescope gain errors, but the phase -solution will usually be split up into three independent groups: the fixed -array (0-9), A/C and B/D. - - - -\section{Telescopes} - - -\section{Sensitivity} -\label{.sensitivity} - -The following tables gives WSRT interferometer system temperatures and -sensitivities. The theoretical rms continuum sensitivity for 12 hrs observation -is based on the given $T_{sys}$ and maximum bandwidth. - -\begin{center} -\begin{tabular}{|c|r@{--}l|c|c|c|} -\hline -\multicolumn{1}{|c|}{$\lambda$} & -\multicolumn{2}{|c|}{Frequ} & -\multicolumn{1}{|c|}{$T_{sys}$} & -\multicolumn{1}{|c|}{Max BW} & -\multicolumn{1}{|c|}{Sensitivity} \\ % end of first header line -\multicolumn{1}{|c|}{cm} & -\multicolumn{2}{|c|}{MHz} & -\multicolumn{1}{|c|}{K} & -\multicolumn{1}{|c|}{MHz} & -\multicolumn{1}{|c|}{mJy} \\ % end of second header line -\hline 92 & 320 & 330 & 130 & 5 & 0.5 \\ 49 & 607 & 610 & 110 & 2.5 & -0.6 \\ 21 & 1365 & 1425 & 60 & 60 & 0.06 \\ 18 & 1590 & 1730 & 60 & 80 & -0.15 \\ - 6 & 4770 & 5020 & 110 & 80 & 0.07 \\ \hline -\end{tabular} -\end{center} - - - - -\section{Backend} - - The WSRT digital backends contribute only very small `closure -errors' (interferometer-dependent errors), of the order of $0.01\%$. -For comparison, the VLA has closure errors of up to a few percent in continuum -mode, mainly due to the wideband quadrature networks). The problem is much -less in the VLA line mode. - - Closure errors violate the basic assumption of techniques like SELFCAL -and Redundant Spacing Calibration, i.e. that all errors are telescope-based. -Closure errors can be calibrated if they are more or less constant over the -length of the observation, but it is obviously better if they are small. - diff --git a/src/doc/latex2html.pls b/src/doc/latex2html.pls deleted file mode 100755 index 8ec839ddd628ad19dccb32921432bc156b70390c..0000000000000000000000000000000000000000 --- a/src/doc/latex2html.pls +++ /dev/null @@ -1,13 +0,0 @@ -# LaTeX2HTML Version 0.5.3: latex2html.config -# -# Revision: -# CMV 940712 Modified for Newstar maintenance system at NFRA -# - -# Change this if you do not want the navigation icons -# to be served from Leeds. -# To use your local icons change the value of the $ICONSERVER variable -# to point to the place where the icons are installed -$ICONSERVER = '../icons'; #******* CMV 940712 -$NO_NAVIGATION = 1; - diff --git a/src/doc/newstar.hun b/src/doc/newstar.hun deleted file mode 100644 index 6ca5338b9d67cff97cc136eb55945fe4e36f888e..0000000000000000000000000000000000000000 Binary files a/src/doc/newstar.hun and /dev/null differ diff --git a/src/doc/nnews.hlp b/src/doc/nnews.hlp deleted file mode 100644 index 5cc4c64e68184fb046cfc4c969eb1d8c218f7bda..0000000000000000000000000000000000000000 --- a/src/doc/nnews.hlp +++ /dev/null @@ -1,730 +0,0 @@ -1 NNews - 1000929 Allow reading leiden data from CD-ROM - 1000929 Repair problem locating MDL files - 1000929 Correct bug in COR data display; add stepping over sets in SCAN display - 1000922 Correct double 29 in DCB data from MS - 1000922 Solved rounding problem when flagging mosaic data using CHAN - 1000922 Added the display of polarisation channels if no ap solution - 1000921 Repair milennium bug in update procedure - 000309 NSCAN: Allow for CD-ROM directories - 000309 Add 99A, 99B for project numbers - 000309 NPLOT: phase continuity added - 000309 Changed the MXNCH to 8192 to plot long 10s files - 000309 ALL: Default for MODEL_ACTION now uses BEAM instead of NOBEAM - 000309 NCALIB: fix FCA used for reading data for vzero calculation - 000309 solves a problem with DZB data reported by AGB - 000309 Added loops to SET -- INIT - 000309 NGCALC: Corrected a missing argument that made ngcalc plot crash - 000309 NMODEL: Add extra model update modes (but not implement them yet) - 000309 Add messages that X* updates not yet implemented. - 000309 Corrected update convergence for 'I' only case - 000309 NMAP: [C]MEMORY_USE max. 4 --> 32 MB (request by AGB) - 980707 System: Various changes for logbook and CD-ROM stuff - NFRA: remove ws4, ws5, ws7 stuff, use daw18 for compile/linking - add script to read WSRT-logbook - 980707 NPLOT: change dot pattern for connecting lines - 980707 phase continuity; better connecting lines - 980707 NCALIB: For better calculating MIFR - 970728 NPLOT: modification related to remove control-C plot control - 970605 NPLOT: Make default coordinate contouring grid size 256 - Some changes for plotting exactly on pole - 970530 NPLOT: Correct plotting of coordinates and ticks near pole. - A selectable precision (COORD_PREC) possible. - 970529 NSCAN UVFITS: Allow multiple BITPIXes, - better grouping of sets in labels - Extra prompt for BITPIX - 970529 System: Included check for non-existent conversion from DEC,L to RA,M - 970529 NPLOT: Coordinate plotting near pole - 970509 NSCAN/NFLAG: improve formatting of X/Y arrays - 970509 NCOPY: add new option SHORTCOPY - 970509 NPLOT: plot control through control-C - SPECIAL options: - alternatives for HA scale - hour-angle integration - annotation text - new SORT=INVERT option: transposed interferometer order - new data types AGAIN, PGAIN: ampl. and phase of data/model - plot order XXgain, XXphase ... i.s.o. XXgain, YYgain ... - raster lines on tel/interfmr plots - increase font size for 'PLUVO' plots - nonlinear gain scale to accomodate very large and very small gains - modification related to control-C plot control in NPLOT - correct scales for BAND mode - 970509 NCALIB: New algorithm for VZERO calculation - Add USIGN to resolve sign ambiguity in Stokes U - Calculate and report GZD - Revise gain normalisation algorithm (had never been tested!) - Revise ME calculation in ncalib.for - extend GAIN_NORM help text to include -1 option - 970509 System NFRA: do 'setenv LPDEST jet5' to use new printer - Fixes/changes in record/replay - Small changes for LICK and WSRT - Changes for RUG (add Solaris) - Add IONOST for HP - 970509 NSCAN: Give error-message in case WNFRD return an error - bug 229 - 970509 All: Filename-problem on Solaris solved - bug 224 - Logging of selected IFRs also in logfile - bug 228 - 970509 NMAP: problem in FITS maps created by NMAP solved - bug 221 - 970509 NCLEAN: fixed crash problem when reading visibility data - bug 226 - 961108 NSCAN: Corrections for archive - 961017 NCOPY: add special option for holographic beam measurements - 961017 NCALIB: fix loose ends from earlier change of dispatching codes - CCOPY should now work as advertised - Renormalisation: Leave undefined corrections (TCOR=0) undefined - 961017 NSCAN: Correct use of band8 bandwidth for versions<46 - 961017 NSCAN UVFITS: Use RR,LL etc instead of XX,YY because of problems with UVLOD in AIPS - 961017 All: use . i.s.o. - in interfm display for better visual appearance - 960813 NCALIB: correct VZERO calculation - suppress 'XY constrains' output in log file - correct code for SETCLK (was treated as SETMIFR) - correct SHOW output format - 960813 NPLOT: correct misleading comment - 960813 NSCAN: Add bytecount for CHECK - 960813 System: add files for site LICK, add Dec-Alpha/OSF1 in Bonn - 960626 NPLOT: change plot annotaion format - change interface to ST plot options: ST_ prefix in IFR_MODE - replaced by S_ prefix in OPTION - new keyword HA_MODE for special effects in vertical scale - 960626 NCALIB: For REDUN option: Take all interferometers. (Also 00, 11 etc.) - 960626 NMODEL: show RA and DEC in show header also in decimal format - 960626 NSCAN/NFLAG: fine-tune overview formatting - bug fix in MAXD calculation for NSCSCF - 960626 NSCAN: Read correct OH-length for mosaik observations - 960626 NCOPY: Fix serious bugs - must have been there for several months! - zero IFRMC, IFRAC, emit user message - bug 141 - 960626 System: add files for Solaris system - Situation at RUU changed - 960520 NCALIB: extend help texts for BASEL_xxx parameters - 960513 NCOPY/NPLOT/NGIDS/NCLEAN: warning if /NORUN - 960502 Documentation: Several small bugs fixed - 960422 NMAP: RA,DEC in header within proper ranges - emergency bandage for the HOLOG mess: new keywords OLDHOLOG and NEWHOLOG - report filename on open failures - find free label if * specified (previously * was equivalent to 1) - return to nmadat after most actions - (in batch mode, input EOF will cause nmap to QUIT as before) - 960422 NMODEL: option RMERGE: merges model components that are within radius - removed bug from UPDATE option QUV - 960422 NPLOT: Do not ask IFR_MODE when OPTION=TELESCOPE - bug 161 - Correct MB3 or X exit loop - bug 200 - add plot modes STNORM, STSORT: using ST i.s.o. HA - 960422 NSCAN/NFLAG: Type text for COR/UNCOR and if something NOT present - bug 169 - 960422 NSCAN: corrected a bug in precession angle calculation - bug 0217 - Add pol.code for DXB/DCB IF-sets, Increase max number of sets - 960422 NFLAG: new options: UXY and VXY - 960422 NCOPY: interferometer selection, SELECT_IFRS parameter - 960422 NCALIB: Correct Copy MIFR corrections (SET_OPTION=ICOPY) - bug 181 - 960422 IONOS: Changed averaging (first days, then hours) - 960422 All: truncate '.<number>' in mosaic field name to get correct default MDL name - 960422 System: add I_HPWSRT.CSH - new routine for calculating sidereal time - add dwrec|p|n aliases - 960130 NMAP RFITS: Do not abort when error in FITS header found - 960130 System: correct problem with unlocking of files - bug 142 - System: some small updates, mainly for NFRA purpose - 960130 Documentation: remove FULL command in ndoc: replaced by ALL - 960130 NCLEAN: Move comments to new line - 960130 NSCAN: Change name for Scissor: CONTLINE now OBSMODE - 960130 NMODEL: Reminder if INTERN is on - bug 156 - 960130 NFLAG: Explanation for STATISTICS GROUPS option, correct flow, - IFR output - bug 149 151 153 189 190 - 960130 NCALIB: Add message concerning model selection for REDUN - bug 178 - Reset Scan counter for SET ZERO - bug 185 - 960130 NSCAN: Some explanation for layout - bug 172 - 960130 NMAP: REF_COORD RA always positive - bug 193 - RFITS: Message if Disk files not found - 960130 NPLOT: merge HjV 941031, 950711, 950718 with my own changes. - Fix help text for IFR_MODE - bug 201 - 960130 NFLAG: Comments; add detour into MODE from STATIST branch; - bug 190 - add labels 183, 193 (CMV's fix for bug 190) - 960130 All programs: add OVERVIEW=ALTOBS option - 960130 System: implements the dwre? commands; - 960130 System: Add LD_LIBRARY_PATH for site UCSB - 951215 System: Add new site: AIRUB (Bonn) - 951213 Correct REF_COORD backtrack error - bug 194 - 951213 System: Add environment n_www - Used to specify your favorite WWW browser. - If you don't define it, xmosaic (part of Newstar - distibution) will be used. - You may change n_www in your newstar_<site>.csh - When changing this file, please check it in with: nsh in - 951205 SYSTEM: Add site IRABO, add some missing files - 951205 MODELS:Adding a new model file for 1127-145 at 21cm - 951205 New improved model for 3C295 at 21cm from reduction group - 951205 New improved models for 325 MHz (92cm) - 951205 NMAP: correction of logic for FIELD_SHIFT/FIELD_CENTRE - bug 139 - 951205 NSCAN: Made Scissor interface more robust - 951205 NCALIB: correct REDUN output: last column I (= nr of iterns) decimal - 951205 Correct scaling of errors (/10 instead of *10) - 921205 PPD: Donot remember ?? request, so user retains access to terminal - help trough ? - bug 154 - 951205 System: add DAT-device for DAW13 (NFRA-only) - 951205 NFLAG: correct EXPLAIN bug showing RMS 3 times - 951205 Documentation: - 1. Revision of documentation system - various bug fixes - - more robust - better cross-referencing - 2. groundwork for batch recording system - 951205 NMAP: Implement complex summing/rotation measures - 951205 NSCAN: Add ARC option for LEIDEN tapes - Therefore WARC changed to ARC and added two new sub-options for ARC - 950822 New Newstar release: 6.1 - 950821 NCALIB SET IREF Help text corrected - 950821 Scissor: Improve options for ionos, add filpo option - 950821 NMAP: Rough trial to produce P^2 maps (pol type LI) - Prepare improved polarised intensity map - 950714 NCALIB: Include MIFR setting - New least squares: better mean errors in polarisation calculations - Improved 'complex' solutions for calibration - Change in writing interferometer errors for missing telescopes - Add option ICOPY for SET_OPTION (Copy MIFR-corrections) - 950714 NCLEAN DATA Clean: correct restored map when using DataFactor (new keyword) - 950714 NSCAN: Add MDLNODE_PEF (model keyword was missing) - Add NSCSCY to NSCSCR for UVLIN type operations - 950714 NPLOT: Re-open SCN-file for update when models found - bug 127 - Plot all PHASE residuals in W.U. - Add (hidden) keyword PLOT_HEADING (Def. YES / NOASK) - 950714 NGCALC: Change SET_ACTION in SECTOR_ACTION, add EDIT - 950714 NPLOT/NGCALC: Add A0-plotter, therefore changed options for - keyword PLOTTER and added keyword PLOT_FORMAT - 950714 NMODEL: Update option extended with, a.o., clustering, position only - Add constrained update - Model update correction for constrained clusters of more - than 2 sources - Added looped updates: not always perfect; slow, and most - useful for small number of well separated sources/clusters - 950714 System: some changes for use in Leiden - 950714 Documentation: Use latex2html stuff from Newstar account - Correct some typo's in tex-files - Add plotter_public_intfc.tex and change some other - 950714 NFILT: Create the program to calculate continuum from the UV data - 950714 NGEN: Change (DE_)APPLY so it has the same options as X_(DE_)APPLY - 950530 NSCAN/WARC: Correct handling of Mosaic positions - 950530 Update the LSQ test program twnm.for - 950516 NSCAN: fixed problem with wrong 0X total power. - bug 122 - 950516 Scan-file remembers whether REDUN was done with /DE_APPLY=OTH - 950516 NCLEAN: Add keyword DATA_FACTOR for DATA-clean option - 950503 TWNM: A new set of least squares routines, incorporating proper error - handling and non-linear solutions are provided. - Documentation is available in lsq.tex/lsq.ps - 950502 NCLEAN: DATA clean: HA_RANGE works once more - 950502 NCLEAN: Better error message in case outputfile readonly - 950502 NCLEAN: Data clean: clip_area back again - 950502 NSCAN: Correct AOTH correction if telescopes deleted - 950502 NMAP MAKE: correct binning if position of C,D is zero - 950502 NSCAN: Add option to read LEIDEN-tapes - 950502 Scissor: More client commands, add ionosphere stuff - 950502 Scissor: no messages about succesfull connection - 950502 NSCAN: Check if IF is present - 950303 NSCAN: DE_APPLY corrections set properly if telescope missing - 950224 Add test program TWNM for non-linear and complex LSQ testing - 950224 When elm NOT available, do elm alias '/usr/ucb/mail' - 950224 Make sure that if still logged in after 7 days with - intermediate logins, you can re-init symbol file - 950221 NCALIB: Different limits for manual gain - NCALIB: Account for /DE_APPLY=OTH in different way when writing back corrections - 950220 NPLOT: correction for plotting mosaic IFDATA - 950220 NCALIB: larger range for gain corrections (SET MANUAL etc) - NCALIB: Do not create non-existing SCN files - 950220 NSCAN etc: Giving HA_RANGE=* is equivalent to default range - 950220 NSCAN PFITS: Option for shortlist of multiple labels - 950220 bug fix: allow for comment following '\' null reply - 950220 alert user if he tries to process .psc files - 950220 744 --> 644: data files are not executable - 950220 update of doc system - 950202 NCALIB: restore printing logic to situation before 940912(request by AGB) - 950202 NGEN: Add shift and model again - 950202 System: Use $HOME in directories i.s.o. tilde - 950202 NCALIB: default modelfile back again - 950202 Scissor: improved archiving procedures - 950202 NSCAN WARC: also pass calculated size of label to MEDIAD - 950202 NMAP: RFITS several small bugs fixed - bug 134 - 950126 NSCAN (NFRA): Archiving options - 950126 changes in user interface accumulated over several months - the algorithms have not been touched - minor corrections to prompt/help formatting - format and help-text changes - 950123 ATNF: do not keep old executables (-NKeep switch) - 950123 Correct renaming of log-files etc - 950123 NMAP on Alpha: correct alignment - NMAP on Alpha: Correct RFITS - 950123 complete backtracking on ctrl-D, fix omissions in closing files - 950123 NPLOT: Correct HA_SCALE - 950123 Correct plotting of Y telescope errors - bug 135 - 950123 Correct alignment errors in NMAP common - 950123 NSCAN DUMP: correct size of copied labels - 950112 correct scan number for model visibilities in HA-integration - this fixes a bug reported to JPH personally by AGB - 950112 system: test if we have to rebuild sys_bldppd.exe before - processing psc/pin files - 950111 NSCAN: Option WARC updates Scissor - NSCAN: Put WSRT Gain corrections in DE_APPY OTHERS - 950111 NSCAN: Correction for WARC - 950111 NSCAN: Correct WARC for Mosaic observations - 950111 donot give an error message for wildcard disk input - 950111 NPLOT: Correct scale for pol.vectors - 950111 NPLOT: Fix bug with RA =~ 0.0 (No coordinates plotted) - NATNF: Select all interf. (Not asked anywhere) - System: Add scripts for ESTEC - Documentation: Newstar maintenance inside/outside NFRA as html-file - 950111 NSCAN DUMP: Pass correct size to Scissor - 950111 NMODEL: Option _CONVERT is CONVERT again - 950111 show prompt only on terminal or if environment var N_PSCTEST=1 - 941121 NPLOT: Correct handling of # at WMP_LOOPS - 941121 NFLAG: Correct bug in psc-file, occurring at GET option - 941115 Documentation: include link to Scissor in homepage - 941115 new organisation of program-parameter documentation - 941115 adapt hypertext program-parameter help to new organisation - add sync mechanism to xmosaic restarting - 941115 NFRA: More Scissor commands - 941115 NFRA: Allow override of Owner for medium adminitstration - 941115 prompt-format control in .psc files, see psc_guide.txt - 941115 correct units for correction tables: deg --> rad - 941110 NMAP WFITS: Correct bug in CDELT3 - 941110 NGIDS: Include FLFNODE - 941110 All: allow tape-directories on disk - 941110 NSCAN: update mediumadm. in Scissor for option DUMP - 941110 System: Interface to Scissor - 941031 NCALIB: Repair yet another bug in psc-file - 941031 PPD: Add missing pef-files in psc-files, typo's in for-files - 941027 New Newstar release: 5.1 - 941027 NMAP FIDDLE: Open/close file when asking WMP_SET_2 - 941019 NMAP FIDDLE EXTRACT: Correct fieldsize of extracted map - 941019 NPLOT: Correct default option after IFDATA choosen - 941019 NCOPY: add option to apply corrections to data being copied - (request of AGB; primitive implementation only) - 941019 NMAP: add FIELD_CENTRE for map-making - 940930 NGIDS: Correct plotting of maps with odd-axis length - 940930 NMAP: Corrections in RFITS (for FITS files not produced by NMAP) - 940930 NCALIB: Bug in COPY repaired - 940928 NFLAG: Can use CLIPDATA=2*RMS etc. again. - solved problem with write-protected files - 940928 NMAP: No longer overwrite tapes when aborted - bug 125 - 940928 All: correct default model-file for broadband 92 cm observations - 940928 NCALIB: SET DX etc is now SET OTHERS DX - NCALIB: Option SET OTHERS MULTIPLY added - 940928 NPLOT: Prompts for scales accept * (=default) - 940908 NFLAG: bug in `dryrun' statistics fixed - New NFLAG option RT1 (CLIPDATA group) - 940901 NMODEL: Changed NMODEL UPDATE to include Polarisation - and Linear pol estimator (not written yet) - 940901 NGIDS: New flagging mode CLIPFLAG - bug 115 - 940901 All: specifying SELECT_IFRS= -* also switches off autocorrelations - 940901 Files opened for writing/updating are now write-locked - to prevent multiple writes to the same file - 940901 System: changes in X11 interface - bug 120 - 940901 NPLOT: Keep old user-input as default for next plot, - option to abort a series of plots on X11. - 940901 No more confusing messages about DWARF symbols - 940901 User interface: - LOOPS before SETS like everywhere - Replace reporting of individual cuts by summaries per 100 - 940901 ALL: Improve user interface and list output for LAYOUT/OVERVIEW - 940901 NMODEL: Correction for pol update - 940901 NPLOT: Ask tick-type also if no pixel coordinates asked - 940901 NPLOT: Correct bug in overlay of contour map and pol. vectors - 940901 NSCAN: Load datasets with 512 channels (or more) - 940901 NSCAN/NMAP: UNIT-* now really lists units - 940901 NFILT: Tested writing of IFR errors with Qubes - Still missing: secondary corrections - 940901 NMAP Write FITS: Correct bu causing core dump, correct scale for AP - 940901 NPLOT: More space between annotation and axis - 940821 NFILT: Add interferometer error writing to Qube options - 940821 NMAP: No error if #.. set-specification in FIDDLE - 940821 NSCAN LOAD: Use proper channel numbers for observations <1983 - 940821 NPLOT MAP: Options to suppress annotation with pixel coordinates - 940821 NGCALC: Add BASE option to make plots as function of baseline - NGCALC CALC: Add CPOLY to make plot with data from fit - 940821 NCALIB REDUN: MODEL_OPTION no longer accepts INTERNAL - bug 121 - 940821 NFLAG FLAG: DETERM option ELEVATION added - bug 111 - 940812 NMAP FIDDLE COPY: Keep original comment in map header - 940812 All: NODE specification from list (** first, then #nn) - Giving * as tapeunit generates list of known ones - 940812 NCLEAN: No max. limit on memory size - 940803 NCLEAN: prompt for DMEMORY_SIZE with a default value - (not tested because this code is not normally executed) - 940803 NCLEAN: Bug 67 (Data Clean overwrites input map). - bug 67 - This behaviour is intentional. An explanation - is given in the NCLEAN program description. - 940721 DEC/Alpha: get rid of <unaligned access> from qsort routine - 940721 NFRA: add tape-unit MAG0 (1600 bpi) and MAG1 (6250 bpi) for rzmws0 - 940721 NGCALC: add DEL function - bug 117 - 940721 NPLOT: Add option ISYS to IFDATA to plot Tsys X+Y - 940721 NGCALC: Correct extract of IF-data - NGCALC: Correct bug in subtraction of poly-fit, show also - for HA in hours - 940721 NFLAG: Add MANUAL option HARANGE with repeated prompt - bug 118 - 940721 NMAP: Correct centre of extracted map (FIDDLE EXTRACT) - bug 114 - 940721 NCALIB: bug in SET INIT corrected - bug 116 - 940721 NFLAG: Improved statistics options - 940721 NMAP: Add option to read FITS-files - bug 104 - Only tested on FITS-files written with Newstar - 940721 ndoc Hyper: respect user's Xmosaic window-size settings - 940721 NPLOT: Increase buffers for large DATA plots - 940623 NMAP: Correction in Job Summary - 940623 NMAP: Correct grouping in output map - 940623 WSRT batches: smaller plots - 940623 NGCALC: Correct data copy buffer pointer - bug 113 - 940623 NMAP: Correct for crash during MOSCOM - 940623 NGIDS: Really set data to BLANK if BLANK_FLAGS=YES - 940623 NPLOT: Handle INTERNAL model correctly for RESIDUAL and MODEL - bug 99 - NPLOT: Correct default HA scale for X11 - bug 112 - NPLOT MAP: Option EDIT for PLOT_POSITIONS - NPLOT: Option INTERFEROMETER (corrections per ifr.) - 940613 nhyper: Mosaic 2.4 for DEC workstaton - 940613 NPLOT: different data-types on one page possible - 940613 NMAP: Add job summary log - 940613 NSCAN: Make available for old VAX R-series files - 940524 NMAP: Also symbol SD=Sin(Dec) defined - 940524 NFLAG: Define DWARF symbol RMS after dryrun, this allows - specifications like CLIP_LIMIT=5*rms - 940524 NCALIB SET INIT: Option to select interferometers - bug 110 - 940524 NCOPY: Copy IF-data, option to strip Model, does not complain - bug 109 - if data has less polarisations than expected - 940524 NPLOT: More sensible default for HA-range - 940524 NSCAN LOAD: Adapt for some weird tape-errors - 940524 NPLOT on X11: no more accidental "incorrect datatype" messages - 940524 NMAP: Make available for old VAX R-series files - 940524 NMAP: Extra spaces in output summary (for ABF scripts) - 940524 NSCAN: Small error with LOADIF on HP/WSRT solved - 940516 Prompts for NODE: ** option also matches lowercase files - 940516 NCALIB COPY/SHOW/CCOPY: Hidden keyword CAL_EQUAL to make all - input sectors of equal length (=weight) - 940516 nhyer: Mosaic 2.4 for Sun and Hp - 940516 NMAP FIDDLE MOSCOM: Max. number of input maps increased - 940516 NSCAN LIST: Print duration of measurement - 940516 NSCAN: Correct CATEG output for RUG/sw - 940509 NSCAN: LOADIF option to load Total Power data with uv-data - NSCAN SHOW: TP/GN option for SCAN_ACTION to show T.P./Tsys - 940509 NSCAN/NFLAG SHOW OVERVIEW: Correct bug in listing - 940509 Extensions are now accepted with nodenames (e.g. M31.SCN i.s.o. M31) - Warning if node needs to be converted with CVX - System: allow global DWARF symbols to be defined by Newstar programs - NMAP: handle flaw of Sun tapeunits when winding up to end-of-file - NSCAN: properly handle End-of-File on some Sun tapeunits - 940509 NMAP: Declination stored in DWARF symbol PCDEC - This allows you to specify e.g. GRID_SIZE=4,4/SIN(PCDEC) - 940509 NPLOT: Add option IFDATA (keyword: OPTION) and - keyword IF_MODE to plot Total Power data - 940509 NSCAN LOADIF: Various bugs corrected - 940509 NGCALC: Add option IFDATA (keyword: OPTION) and - keyword IF_MODE to extract Total Power data - 940509 NPLOT: Option to label sources with proper names in map-plot - 940509 All: You can get a list of matching nodes by giving ** - or name_of_directory/* - 940509 NMAP: Increase size of output map for MOSCOM - 940509 NGIDS: Increase buffer size for large MOSCOM maps - 940509 NCALIB SET: Options IFR and MIFR for interf. corrections - bug 98 - NSCAN/NFLAG SHOW: SCAN_OPTION Ifr to list these corrections - 940509 NPLOT: Freq.bands back in plots with IFR_MODE=BAND - 940425 NSCAN UVFITS: Correct labeling of polarisations - bug 88 - 940425 NCLEAN UVCOVER: No crash if Mapsize<FFTsize - 940425 NPLOT: Option to plot identification with sources in maps - 940425 All: proper correction for Faraday rotation once more - bug 102 - 940425 NMAP: Bug removed from NVS and CVX - 940418 NSCAN LOAD: Warning if Leiden tape, comments for old tape versions - 940418 NPLOT MODEL: default model file, INTERN handled correctly - 940418 NMODEL etc: Change in SHOW submenu, SHOW option in MODIFY - 940418 NMAP: Warning if input data with different pointing centra selected - NMAP: Do not create non-existing SCN files - NMAP: INTERN option works with MODEL_OPTION - 940418 System: DWARF startup more reliable, default dir. for models - 940418 NSCAN/NFLAG: Corrected bug in NSCSCM (in NSCSCR) - 940418 NSCAN/NFLAG SHOW: bug in T option corrected, phase shown unscaled - 940418 NGIDS DATA: Phases in range -180,180 (used to be 0,360) - bug 77 - 940418 NGIDS: better text if INTERN option used - bug 94 - 940411 DWARF: Unix environment variables (setenv) now recognised as symbols - 940411 NCALIB: Selection of telescopes possible for ZERO and COPY/CCOPY - 940411 NMAP: Show flux in areas with option SHOW CONT CONT D/N/O - 940411 NPLOT: Solved some little problems - 940411 NSCAN: Reading data period july 1978 - january 1984 possible - bug 73 - 940329 NMODEL/NCALIB: Solved HP bug at WSRT - NSCAN: Proper sequence number in LIST option - 940329 DWARF: ?? also works if you were reading something on a server - 940317 NFLAG: removed bug which caused an extra Scan - NFLAG: added option QXY (to CLIPDATA group) - NFLAG: added switch (use MODE) to disable 'dry-run' - 940317 NSCAN: Do not ask OVERVIEW question for Layout... - 940316 NGIDS: Correct handling of INTERN option for models - bug 79 - 940316 NSCAN: Levels in Overview - 940315 DWARF: proper handling of paths in restore and save - 940304 NMAP etc: Proper sign of V in model subtraction - bug 74 - 940303 NSCAN LIST: Proper date/time - 940303 NSCAN/NFLAG SHOW: Correct negative phases - 940301 NCALIB: Add space between HA and Pol. in output list - 940301 Models: Correct test for equality U,Q,V - 940301 NCALIB: "Flux-unknown" bit in model header determines default - for SOLVE gain - 940301 NSCAN/NFLAG SHOW: Option to display corrected data - bug 53 - 940228 All: Propoer Faraday rotation, model for x+ etc dipoles - 940228 NCOPY: Bug causing segmentation violation removed - 940228 NMODEL: Changed MODEL_OPTION user interface, - default file for READ model is calibrator model - 940228 NCALIB: added (linear) differential shifts - 940228 NGEN: New keyword MODELB: search directory for models - 940224 NPLOT: Problems with mosaick observations solved - 940224 DWARF: Correct handling of quotes and slashes in qualifiers - passed to dwe - 940224 NSCAN: New command LIST to list contents of WSRT tapes - 940223 NSCAN: Proper conversions for reading WSRT data on DECStations - 940223 DWARF: Streams work again - 940223 DWARF: DATAB feature switched off if DATAB set to "*" (including the - quotes, use dws ngen to set this) - 940221 NCOPY now copies all flags i.s.o. removing them - 940218 DWARF: Show version when program is started - 940218 NGIDS: Option to blank flagged datapoints - 940218 NCALIB: Changed format of log-line (tag for Reduce scripts) - 940218 NSCAN Remote tapes: tell server who is calling - 940216 NGEN: Add keyword MEMORY - 940215 NMAP: Default HA-range -90,90 for WSRT - bug 4 - NMAP: Allow specification of Grid size (give "" at FIELD_SIZE) - bug 5 - NCALIB: SOLVE and COMPLEX always asked - bug 60 - NSCAN/NFLAG Show: Give category/type in printout - 940214 NCOPY: remove relics of simulation - 940208 NSCAN: Remote tape-units - 940203 NGIDS: New keyword ALL_POLS, no empty flag files, - Name of input Node and Sets in (ASCII) flag files. - 940203 NMAP: Suppress unnecessary creation of new groups when looping - 940203 Fitting NPLOT to the needs of the reduction group - bug 59 - which means: Plot AP or CS on one page (= 'old' PLOTAP) - More plots on one page - NPLOT: add BANDPASS option to make (ifr, ch) plots - bug 26 - 940202 DWARF/System: Changes for DEC Alpha/OSF1 and general cleanup - bug 57 - 940126 NGIDS: Increase effective size of buffer - 940120 NFLAG: Extended IHAMIN,IHAMAX to 180 degr - 940120 DWARF: open ppd-file readonly - 940117 NGIDS: Correct bug in data-range/model subtraction, better min/max - 940117 NSCAN/NFLAG: Better printing of FREQ in Sector header (no 0.xxxE04) - 931223 NPLOT: Keyword SCN_LOOPS included - 931221 NGIDS: Correct some SUN specific Fortran and typos - 931221 NGIDS: Correct zoom and HA step, some more on-line help - 931220 NSCAN, NMAP, NGCALC: New EDIT format, new OVERVIEW option for SHOW. - Answer L or O to any ???_SETS/LOOPS prompt to get the Layout or an - overview of the corresponding file. - 931217 NSCAN: report which interferometer in case of Format error - 931217 NGIDS: Read SCN files directly and flag them with gids regions - bug 65 - 931216 General: old logfiles (>5 days) no longer purged - 931216 NFLAG: Fully reworked new version - 931216 All: Make LOOPS more specific (SCN_LOOPS etc) - bug 3 - 931215 All: Read special (ACORM=0) tapes - 931215 NCALIB: cater for possible phase ambiguities in complex gain averaging - 931215 NCALIB: Make Complex solution (only a possibility) and some small - text changes - 931215 New (931117) version of giplib and gids for cv - 931215 NMODEL: Add REDIT, FEDIT model action - 931206 NGEN: New dummy program NGEN for use in batch scripts - 931206 NMAP: Changed text - bug 42 - 931202 System: Problem solved with character entry (for HP-UX 09.01) - 931202 NPLOT/X11: Plot crosses in maps (again) - bug 40 - 931130 NGIDS allows SLICE - 931130 NSCAN: correct default label for output disk files - 931130 NSCAN: report old and new indices for each new index being made - 931124 NSCAN/NFLAG: W option shows all weights including values of 0 - 931123 Error with structures in WNTINC. Recompile some DSC - bug 63 - 931123 WNTINC: Proper _T for multiple sub-structures - 931123 NMAP Show: Layout extended (and some minor changes) - 931123 NPLOT: starts with white display - 931117 NCLEAN: Better userinteraction for AREA=, INST corrected in Beam Clean - 931117 System: xmosaic 2.0 and various minor improvements - 931116 DWARF: can now use . as well as $ for stream, dwv: new option /SHORT - 931116 NSCAN/NFLAG SHOW: Sector action does not stop in batch - bug 61 - 931112 All: bug fix to clock correction - 931111 Fire off X11 window right at the beginning and keep it. - bug 27 - 931110 NCALIB: baseline-pole correction fixed - 931105 NSCAN/NFLAG: Changed default for SECTOR_ACTION to NEXT - 931102 Models: Default option for MODEL_ACTION is now NOBEAM!!!! - 931008 Models: Automatic correction for beam shape at different frequencies, - positions, instruments has been included in all model - handling and calculations. - NMODEL EDIT option has been added to be able to change the - model header without conversion (part of the old CONVERT), - NMODEL CONVERT will convert everything - In model data calculations the automatic beaming can be - suppressed by the MODEL_ACTION NOBEAM. Note that if you - specify BEAM with an existing (old) calculated model, the - complete model will be recalculated. - 930924 NGCALC: Bug with 1D plots fixed - 930922 NSCAN: Option SHOW is back in NSCAN (but it also remains in NFLAG) - 930913 NSCAN: Correction of UVFITS output for incomplete data - 930826 NFLAG: New options TOPOL, STAT, ... New sequence in OPERATION_... - (now goes back to FLAG_MODE, OPERATION_0). - Bug in interferometer coding for ASCII files corrected. - 930825 NPLOT: Bug in PS output corrected. Also, printing to A3 should - now switch back to A4 properly - 930806 NFLAG: Option ARESID for flaggin on Selfcal/Align residuals - NFLAG: Option PUT repaired - 930802 NSCAN: NVS handles IQUV to XYX conversion properly for more than - one channel, proper weight check. - 930722 NPLOT: Changed keyword PLUVO in IFR_MODE(normal,spectral,sort) - normal: plot ifr vs ha, ifr order (00,01,...,dd) - spectral: spectral channel vs ha, per ifr (old PLUVO) - sort: ifr vs ha, baseline sort - 930706 NPLOT: RULE plots will now be plotted horizontal (C10) - 930701 New version of NGCALC with more expression functions and SHIFT - Calculate option. The new features can only be used for freshly - extracted data; there is no possibility to add the necessary - data to the existing NGF files by, e.g. NVS option. Old data - can still be used for all other options. - 930628 New NPLOT (NGCALC) X11 driver. You can now select the plotsize as - fraction of screen (default 0.75; value > 0.0, <= 1.0) by: - setenv PGPLOT_XW_WIDTH value - and get all plots without waiting (and without seeing end result) by: - setenv PGPLOT_XW_CLICKLEFT 0 - 930622 New NFLAG SHOW SCAN T option to guess calibrator phases selfcal start - 930622 Add some flagging possibilities to NGIDS for UV data - 930619 A new program: NFLAG contains now the SHOW and FLAG(DELETE) options - originally in NSCAN - 930616 New option added to set a field shift in SCN (in NCALIB), and to - "de-"apply it if wanted (all programs) - 930610 Flagging in NSCAN has been redefined, and options added. Read ? text - for details - 930608 The data format has been changed to cater for multiple flagging layers - and absolute (rather than relative) weights per data point. - SCN files made before this date will give a message: - "run NSCAN/NMAP NVS first". Run NSCAN NVS to convert the data to the - new format. - "DELETE" is now called "FLAGGING", and a new NGEN keyword UFLAG has - been introduced to be able to selectively include flagged data in - your processing. Like other NGEN keywords (e.g. APPLY) it can be - set as a switch on dwe; a dws NGEN or dws "program" or by - dwe "program"/ASK. - NSCAN SHOW has been extended to show the flags set for the DATA W - option, and a SET_ACTION FLAGS has been added to give an overview - of flags per cube slice. - 930606 Added ionospheric refraction, baseline pole, d(x,y,x), clock and - frequency correction. - Limited edges of mosaic output to suppress noisy data - 930524 Many keywords now have a more meaningfull name. - 930519 Read/Write to DAT-devices on HP now possible - 930513 NCALIB/NGCALC: New method for complex Least Squares - NPLOT: Solved problem when plotting with one (positive or negative) - contour causes crashes. (A42) - Problem with keyword DELETE_NODE solved (came in a loop). (A47) - NGIDS: Reorganised the program for future (interactive deleting) - NMODEL: New option: FIND to find sources in map - 930503 NMODEL: Problem with core-dump when type-error solved (A40) - Model update was wrong for fields with negative declination. - NSCAN: Problem with flagging of two polarisations corrected (A41) - NSCAN/NCALIB: Message will be printed when the program creates a new - SCN-file. Happens when name of non existing-file typed in (A43) - NCLEAN: Problems solved with noise values in the latest restore-step of - data-clean (came from original iso. residual map). (A44) - NGIDS: now totally independent from GIPSY (A49) - NATNF: Phase problem solved (A50) - 930304 NMAP: Writing cubes contiguous - 930210 NPLOT: Default contours now available. - Default PLOTTER will now be PSP, default SIZE will be 1.3, 1.3 - 920205 The problems on the HP with default value 0 have been solved. - Also some printout on the screen will fit on one line. - 921222 NPLOT: Display option X11 now partly available for UNIX machines - (Do NOT use halftone; some options will NOT work correct yet) - 921218 Changed KEYWORD=LOG. All programs have now default YES iso. SPOOL - 921106 Programs changed for J2000 and allow HA outside -90 - +90 degrees. - 921022 NATNF, NSCAN and NMAP are now able to use mag-tapes on UNIX system. - Do a setenv to see which mag-tapes are available. - NPLOT and NGCALC can now plot on A3-plotter (B17). - 920903 Many problems solved by WNB during his stay in Dwingeloo - NGCALC: New program for data calculation and plotting (C2) - NATNF: New program to handle RPFITS files - NSCAN: Split mosaic data (B1) - Error in old WSRT-tapes (1987) .. pointing set (A33) - Wrong MJD when not correct ended WSRT observation (A34) - Faster mosaic splitsing (2 times faster) (A35) - Conversion LINOBS (I,Q,U,V) to XX,XY,YX,YY (B14) - NMAP: UV circular weighting function (B5) - A option/loop (in FIDDLE/ADD) for line-data (B6) - MOSCOM option to use noise as weight (B11) - Extended NMAP fits header (B12) - Change coordinates if shift (A23) - Noise for extract/copy in NMAP (A28) - Precission angle calculation (A30) - Calculate offsets in map (A32) - Logics MAP statistics (A36) - NMODEL: Delete of non-clean components (B3) - Delete of sources inside dl,dm box (B13) - Merge source models: sometimes recalculate everything (A31) - RSHOW problem solved (A22) - NPLOT: Option to plot hourangle against frequency for a baseline - polarisation (C7) - Halftone plotting problem solved (A19) - Plot message by selfcal/align residuals with model (A24) - On SUN: Problem plots bigger than A4 solved (A26) - NCLEAN: Changed sign restore beam angle (A20) - 920728 NGIDS: New program to load maps into GIDS - (GIDS = Groningen Image Display System) - 920714 NSCAN updated for Online System nr. 63 (Change in extended FD) - 920626 New delete option DCLOW, same as DNCLOW, but for cleaning components - NMAP: Problem with Beam-option correctred (B4) - Problem with fsum corrected (A18) - Problem with model subtraction for polarisation sources - with RM corrected (A16) - 920623 Name of software-pakket changed from N-series into NEWSTAR - (Netherlands East West Synthesis Telescope Array Reduction-package) - 920609 NSCAN: Problem with flagging of two polarisations corrected (A12) - Layout for MJD(start) corrected (A14) - NMAP: Problem with source subtraction corrected (A15) - Problem with "LAYOUT" option for WMP-file corrected (A13) - 920504 NMAP: Problem with data in HA-baseline format corrected. - NSCAN: Problem with delete options (Rnoise Anoise) corrected (A11) - 920407 Problem with option CVX to DEC-workstation corrected. - NPLOT: Use of double loops for plotting a MAP corrected (A5) - Plotting more than one 'data', 'residuals' or - 'telescope corrections' problem corrected. - NMODEL: Symmetirc extended sources problem corrected (A6) - NCLEAN: Epoche problem corrected (A9) - NMAP: Writing REAL or AMP data from .WMP file to grey-scale - problem corrected. - 920131 NCLEAN with an unsaved residual map corrected - 920131 NCLEAN major cycle statistics printout corrected - 920130 NPLOT re-write to use full page in portrait mode - 920129 NPLOT output to EPS and EPP can be viewed on the DECstation (if files - produced there or ftp'ed) with the command: dxpsview & - or with the PostScript preview application - These files can also be incorporated in WordMarc (and other) documents - 920128 Spool error PS plots - 920128 Change prompt error in NMAP FIDDLE - 920119 NMODEL UPDATE corrected for use of B1950 models - 920119 NCALIB SELFCAL corrected for use of B1950 models - 920117 NCLEN COMPON option - 920117 NCLEAN restoring for extended sources - 920117 NCLEAN restoring for non-clean point sources - 920116 NCLEAN URESTore option for clean components - 920116 NPLOT large plots now ok - 920115 NCLEAN UVCOVER with restore option - 920109 NSCAN UVFITS memory related crashes for large jobs solved - 920109 NMODEL option to delete low-level non-clean changed in definition - 920108 NCLEAN Clark type clean (UVCOVER) please test and comments - 911230 NMODEL UPDATE corrected for logical error for clean components - 911230 NMODEL new option DNCLOW to delete low-level non-clean components - 911230 NPLOT better RA, DEC coordinates - 911227 NPLOT renewed with ruled surface and polarisation vector possibilities - 911227 Correct conversion to/from other coordinates in NMODEL - 911219 A new set of Plot routines incorporated in NPLOT (maybe problems) - 911209 Correct interferometer selection POL NCALIB - 911115 All (de-)beams have a maximum limit of a factor 100 - 911105 MAPs made before today at 10:00 will not properly combine in MOSCOM - 911105 NMAP FIDDLE MOSCOM will combine mosaic fields properly weighted - 911104 Correct de-selection of clean components (X)UPDATE in NMODEL - 911031 WERR option NSCAN will correct mosaic HA tape error - 911025 All HA's on WSRT tape for mosaic wrong - 911024 NMAP reference coordinate (mosaic) option checked - 911023 NPLOT RES definition changed for Ampl and Phase - 911014 NSCAN DELETE new CLIP option - 911009 NCALIB: SET RENORM option added - 911009 NMAP: correct multiple polarisations output - 911008 Default: No complex for NCALIB pure redundancy - 911007 Instrumental polarisation in first version - 911004 NCALIB POLAR VZERO options CALC APPLY MANUAL ASK in first version - 911003 The ncopy command will transfer and convert files from VAX - 910930 NPLOT: repair logics - 910930 NCALIB POLAR COPY has loops - 910930 NCALIB REDUN check on extreme values - 910927 Multiple input sets ok in NMAP; NPLOT option order reversed - 910923 Add SET,COPY,EDIT option to POLAR option in NCALIB - 910923 Correct sign of shift in NMAP - 910918 Add option to NPLOT to only plot XY,YX - 910918 quota directory|filename ... gives size (may have wildcards) (Alliant) - 910917 Correct bug in all programs that mistreated APPLY and DE_APPLY - 910917 Status of options as described in ITR198a - Can be printed (on VAX) by: $ wm/print user5:[wnb.itr]itr2a.wnb - 910917 The following programs exist: - NSCAN, NMODEL, NCALIB, NMAP, NCLEAN, NPLOT (+NGEN for parameters only) diff --git a/src/doc/txt/batch.txt b/src/doc/txt/batch.txt deleted file mode 100644 index bcedc4e6a8807a468500ae17878be27419201791..0000000000000000000000000000000000000000 --- a/src/doc/txt/batch.txt +++ /dev/null @@ -1,321 +0,0 @@ -Betreft: -Batch processing in Newstar ---------------------------- - -Waarde heren, - -Ik heb wat details van DWARF opgespoord ten behoeve van automatische -processing. Hieronder volgt een voorlopig overzicht. Een aantal zaken -staat al in het Cookbook: Program Descriptions, Common. - - -1e. DWARF Keywords, streams ---------------------------- - -Een gebruiker heeft invloed op de werking van een Newstar programma via -de DWARF user-interface. Alle grootheden/parameters die een gebruiker -in principe kan specificeren corresponderen met keywords, die een -waarde hebben. Die waarde kan op een aantal niveaus bepaald worden: - - 1e. Interne of program defaults: - De programmeur heeft een default waarde meegegeven bij de - definitie van het keyword (in de zgn. PIN-file). In een - (beperkt) aantal gevallen staat er geen default in de PIN-file - maar geeft het programma zelf een default mee. - - 2e. Externe defaults: - De gebruiker heeft, buiten het programma om, een waarde - gegeven aan het keyword door een DWARF symbool te definieren - (met dwspecify, met dwrestore, of door het programma eerder - te gebruiken met de /SAVE switch) - -Voor een aantal algemene keywords wordt de externe default op twee -plaatsten gezocht: eerst in een tabel met defaults voor het programma -(de "local" external default), als daar geen waarde staat in de algemene -tabel (de external default van "NGEN"). - - 3e. Het programma prompt de gebruiker voor het keyword en krijgt - een waarde via toetsenbord of input-file. - -Normaliter gaan de antwoorden die de user geeft op keyword prompts verloren -wanneer het programma wordt verlaten. Er zijn twee manieren om een keyword -te bewaren (alsof het met dwspecify was gegeven): - - - Voor alle keywords de waarde bewaren: start programma met - dwe <programma> /SAVE - - - Voor individuele keywords de waarde bewaren: geef na de prompt - waarde /SAVE [/[NO]ASK] (zie ook onder 3e) - - -Op elk niveau kan een qualifier (switch) /ASK of /NOASK worden meegegeven. -Deze bepaalt of de gebruiker voor het keyword geprompt wordt of niet -(het opgeven van /[NO]ASK bij een prompt heeft alleen zin als ook de -/SAVE switch gegeven wordt). - - -Met de /SAVE optie en dwspecify (= dws) kunnen vaste defaults voor een -programma worden gezet. Omdat het meestal wenselijk is verschillende -sets van defaults te gebruiken voor verschillende procedures kan een -programma in verschillende "streams" (wat was dat andere woord ook al -weer?) gestart worden. Elke "stream" heeft een eigen set defaults. - -Het commando om een programma te starten in een bepaalde "stream" is - - dwe <programma>$<streamname> - -bv - dwe nscan$1 - dwe nmap$standard - dwe nplot default: stream 1 - -Wanneer een keyword geen default heeft in de opgegeven stream wordt -een default in stream 0 gezocht, is daar ook niets dan blijft alleen -de default van de PIN file over. Voor NGEN keywords wordt steeds zowel -in de stream voor het programma als in de stream voor NGEN gezocht. - - - -2e. DWARF Symbols ------------------ - -DWARF slaat externe defaults op als symbolen. Alle symbolen staan -fysiek in de file $DWARF_SYMBOLS (meestal ~/SYMBOL_DIR/SYMBOL.$$). - -Een DWARF keyword correspondeert met een symbool - - <Programma>$<Stream>_<Keyword> - -De waarde van het symbool is de character string die als default -gebruikt zal worden bij user-input, eventueel met de qualifier /ASK -of /NOASK er achter. - -Wanneer achter de waarde <space>/ASK staat, vervangt de waarde de default -van het programma, maar wordt de user toch geprompt voor het keyword. - -Wanneer achter de waarde <space>/NOASK staat, of wanneer er helemaal geen -qualifier staat, dan wordt de user niet meer voor het keyword geprompt. - - -Naast deze keyword symbolen kunnen ook algemene symbolen gezet worden, -die in antwoorden op prompts gebruikt kunnen worden, bv PI = 3.1415, -NATUURLIJK = YES en zo voorts. - - -De volgende utilities zijn beschikbaar om symbolen te manipuleren: - - - dwlet [symbol=value] [/LOG[=long|short] [/NOLOG] (= dwl) - - Geef een waarde aan algemene symbolen. Kan niet gebruikt worden - om DWARF keywords te wijzigen. - - Als er geen symbol=value wordt meegegeven wordt de standard input - gelezen voor regels met "symbol=value", om te stoppen: lege regel - of # of ^D. - - dwspecify program[$stream] [/MENU] [/NOMENU] (= dws) - - Default stream is 1, default mode is /NOMENU. - - Hiermee worden externe defautls voor DWARF keywords opgegeven. - Met /menu wordt voor elk keyword geprompt met de huidige - (externe of interne) default, alleen wijzigingen worden in - een symbool gezet. Met /nomenu worden van de standard input - regels keyword=value gelezen. - - dwclear [program[$stream]keyword,... [/CONFIRM] ... (= dwc) - - Verwijdert de definitie van de keywords, wildcards zijn toegestaan, - erg handig is bijvoorbeeld: dwclear nscan$*_*, om helemaal schoon - te beginnen. - - dwsave [program[$stream]keyword,... [/OUTPUT=file] [/CONFIRM] ... - - Default file is dwarfsave.sav, default extensie is sav - - Schrijft de keywords en hun waarde in de genoemde (ASCII) file, - wildcards zijn toegestaan. Default is *$*_* - - dwrestore file [/CONFIRM] [/OVERWRITE] - - Leest regels keyword=value van de genoemde file en definieert de - corresponderende symbolen. - - dwview symbol,... [/EXTERN] [/GENERAL] [/INPUT=file] (=dwv) - - Laat de waarde van symbolen zien: - - Zonder /GENERAL en /INPUT: - Symbols moeten de vorm [[program]$stream_]keyword hebben, - wildcards toegestaan. Laat zowel interne als externe defaults - zien, als /EXTERN alleen de externe (zowel "local" als "NGEN"). - - Met /INPUT: - Leest als dwrestore van de genoemde file, laat keywords zien - die matchen met de genoemde symbols. - - Met /GENERAL: (optie gemaakt 28/07/93) - Symbols mag zowel DWARF keywords als algemene symbols bevatten, - wildcards toegestaan (bv: dwv /g *). - Voor keywords: alleen externde defaults worden getoond. - Als er precies een symbool is opgegeven is de uitvoer de - waarde van dat symbool, anders regels symbol=value. - - -Een typische manier om standard streams te gebruiken is dus: - - dwe nscan$abc /save [/norun] of dws nscan$abc /menu - dwe nplot$abc /save [/norun] - - dwsave *$abc /output=abc - -Tenslotte commentaar invoegen in abc.sav, eventueel nog wat keywords -van de /ask switch voorzien. - -Dan bij gebruik: - - dwrestore abc /override - - dwe nscan$abc - dwe nplot$abc - - - - - - -3e. Antwoorden op prompts -------------------------- - -Het programma bepaalt (via de PIN file) wat voor antwoorden geldig zijn -(character strings, numeric values). Binnen de grenzen van die geldigheid -kunnen de volgende constructies worden opgegeven: - - ? Geef online help - - # of ^D Exit (meestal: vraag vorige keyword) - - "" Empty answer (meestal: by-pass option) - - * Wildcard (meestal: take all) - - ... ! Comment Alles na een uitroepteken is commentaar - - ...'Symbol'... Het symbol wordt vertaald voor alle verdere - processing - - (1=2)*4 Rekenkundige expressies worden uitgewerkt - (alleen voor numerieke waarden, dus wel voor - INPUT_LABELS, niet voor LOOPS) - - 99 TO 120 BY 2 Reeksen worden gegeven als begin TO eind BY stap - (alleen voor numerieke waarden, dus wel voor - INPUT_LABELS, niet voor LOOPS) - - ... /SAVE [/[NO]ASK] Bewaar deze waarde na afloop van het programma in - een DWARF symbol. De qualifier /ASK of /NOASK - wordt in het symbool bewaard (geen qualifier - betekent in praktijk: /NOASK) - - value1; value2; ... Geef een reeks waardes op, de volgende keer dat - het keyword wordt gevraagd neemt het programma - de eerstvolgende waarde - - value1,value2 Geef een vector op, alle waardes worden meteen - naar het programma doorgegeven - - /ASK=keyword Wanneer het programma het opgegeven keyword - nodig heeft krijgt de gebruiker een prompt; - als deze qualifier gegeven is wordt het - huidige keyword nog een keer gevraagd. - - - -Nota Bene: er is geen snelle manier om hidden keywords te zetten als - het programma al draait. Met dws is dat wel mogelijk. - - - -4e. Scripts en batch processing ------------------------------------------------ - -Er zijn twee manieren om Newstar (of eigenlijk: DWARF) in batch mode -te gebruiken. De simpelste manier lijkt me via shell scripts, waarin -keywords worden gelezen met dwrestore en vervolgens de nodige programma's -worden gedraaid. - -Er is (voor WENSS) een "Batch package" ontworpen om de interactie met -de keyword files te vereenvoudigen. Voor zover ik kan zien is de enige -functie het overnemen van de dwrestore en het zetten van /ASK achter -een aantal keywords. Dit weegt denk ik niet op tegen de extra moeite om -voor elk programma een "batch versie" te maken. Ik zal hier nog wat -beter naar kijken. Je hoort er nog van. - - -5e. Voorstel voor wijzigingen en uitbreidingen ----------------------------------------------- - -De volgende wijzigingen in het huidige systeem lijken me wenselijk: - - - Alternatieve specificatie voor streams omdat $ een Unix special - character is. Ik stel voor om voor stream specificaties zowel - een $ als een . toe te staan (bv dwe nscan.test of dwe nscan$test). - - - Van keywords die als symbol gedefinieerd zijn met /NOASK moet tijdens - de uitvoering van het programma het keyword en de waarde worden - afgedrukt. - - -Een "conditionele" batch processing kan vrij makkelijk worden gerealiseerd -door de Newstar programma's bepaalde interne waarden in een (algemeen) -symbol te laten zetten. Die waarden kunnen dan in het shell script worden -opgevraagd en getest. Bv: bij NSCAN kan het aantal Channels in symbol -NCHAN worden gezet, in het shell script kan dan een test worden gedaan - - if (`dwv /General nchan` == 128) then ... - -of de waarde kan in een shell variabele worden gezet - - set channels=`dwv /g nchan` - -of de waarde kan worden toegekend aan een keyword voor een ander programma - - dws nmap\$1 /NOMENU <_EOD_ -LOOPS='NCHAN',...1 -# -_EOD_ - - -Wanneer jullie doorgeven op welke parameters je wilt testen is het een -kleine moeite die waarden in een symbol te zetten. Wanneer je een -programma met /SAVE draait zijn alle antwoorden van de user in elk -geval beschikbaar in symbolen, dus daar kun je ook op testen. - - ----------- - -Tot zover maar weer even. Ik maak hier nog een fatsoenlijk (Engels) document -van, maar hiermee kunnen jullie denk ik wel even vooruit. - -Hartelijk groeten, - -Marco. - - - --- - - - +--------------------------------------------------------------------------+ - | NFRA/St. ASTRON | eMail: devoscm@astro.rug.nl / cccccccc | - | P.O. Box 2 | or: devoscm@astron.nl / c m m c | - | NL-7900 AA Dwingeloo | / c m m m c | - | | ---------------------------------+ c m m c | - | Phone: +31 5219 7244 \ "If you reinvent the wheel, | v v | - | Fax: +31 5219 7332 \ make sure yours will look | v v | - | Telex: 42043 rzm nl | different..." | v | - +--------------------------------------------------------------------------+ - - - diff --git a/src/doc/txt/bug_reports.txt b/src/doc/txt/bug_reports.txt deleted file mode 100644 index 0c65ed83723cb931125d341f93cfdd905f4af602..0000000000000000000000000000000000000000 --- a/src/doc/txt/bug_reports.txt +++ /dev/null @@ -1,434 +0,0 @@ -Newstar Bug reporting procedure -------------------------------- - - bug_reports.txt 14/06/93 v1.0 CMV - bug_reports.txt 06/09/93 v1.2 CMV - JPH 940621 Add list of contents. Include bug_report.2 (=sec. 6.1) - - -INHOUD -====== -1. Inleiding -2. Procedure -3. Revisions en Releases -4. Functionality Requests -5. Implementatie: nbug -6. Prioriteitsstelling -6.1 Update on priorities -7. Slotopmerkingen - - -1. Inleiding ------------- - -Zolang een programmapakket door een beperkte groep gebruikt wordt, is -er weinig noodzaak voor al te veel formele procedures. Naarmate het -pakket door een grotere groep, met een grotere geografische verspreiding -wordt gebruikt werkt een aantal informele overlegcircuits niet meer en -moet er een aantal afspraken over tijdschema's en rapportage gemaakt worden. - -Die afspraken moeten het volgende garanderen: - - 1e. Gebruikers weten welke versie van het pakket voor hen draait, - en wat de (voornaamste) eigenschappen van die versie zijn. - - 2e. Gebruikers die een "bug" rapporteren worden regelmatig op de - hoogte gehouden van de afhandeling van die bug. - - 3e. Programmeurs weten aan welke programma's gewerkt wordt. - - 4e. Er is een duidelijke prioriteitstelling voor de verschillende - onderhouds- en ontwikkelingstaken, waardoor niet onevenredig - veel tijd wordt besteed aan minder belangrijke klussen. - - 5e. Er zijn duidelijke overleg momenten, waardoor er doorlopend - een optimale werkverdeling is. - - 6e. Er is een rapportage procedure, waardoor ervaring bij debugging - voor het nageslacht bewaard blijft. - -Voor wat betreft Newstar zijn de meeste van die punten nu (informeel) -geregeld. Dit rapport probeert het geheel te structureren, uitgaande -van de afhandeling van bugs. Aangezien in mijn optiek missende -functionaliteit ook een bug is (het jeukt net zo erg...) geldt het -verhaal in hoofdlijnen ook voor functionality requests. - - - -2. Procedure ------------- - -Afhandeling van een bug doorloopt de volgende fasen (tussen haakjes de -status die na deze fase aan de fout wordt toegekend, zie sectie 5): - - 1e. Ontvangst (Received) - 2e. Prioriteitsstelling, toewijzing (Assigned) - 3e. Bevestiging naar gebruiker (Confirmed) - -Tussen 1e. en 3e. mag hooguit twee dagen verstijken. De bevestiging kan -ook inhouden: dit heeft lage prioriteit, we houden u op de hoogte. Een -bevestiging kan ook plaatsvinden voor prioriteitsstelling. - - 4e. Reproductie van de fout - -Als 4e. problemen geeft, wordt teruggekoppeld naar de gebruiker: -architectuur/site specifieke problemen, kan gebruiker reproduceren? -Wanneer dit onderdeel meer dan een dag in beslag neemt, moet de -prioriteitstelling opnieuw worden bekeken. - - 5e. Analyse van de fout (Analysed) - -Hier wordt de set van modules/bestanden waar de fout in kan zitten -afgebakend: tracen van de fout, controleren van asynchrone effecten etc. -Wanneer dit onderdeel meer dan een dag in beslag neemt, moet de -prioriteitstelling opnieuw worden bekeken. Afhankelijk van de locatie -van de fout kan de bug worden doorgeschoven naar een andere programmeur -(bv omdat die de modules geschreven of recent gewijzigd heeft). - - 6e. Formuleren van een oplossing of omleiding - -Wanneer dit onderdeel meer dan een week in beslag neemt, moet de -prioriteitstelling opnieuw bekeken worden. Ook moet de gebruiker -een bericht krijgen dat de zaak wel eens wat langer kon duren. - - 7e. Implementeren van de oplossing of omleiding (Solved) - -Als het implementeren van de geformuleerde oplossing langer dan een week -duurt, moeten we terug naar 6e. - - 8e. Validatie van de oplossing of omleiding (Tested) - -Eventueel worden de wijzigingen gecontroleerd door de oorspronkelijke -auteur van de modules. -De gebruiker wordt verzocht op zijn site een test te draaien met de -gewijzigde modules (evt ftp van executable naar user systeem op die site). - - 9e. Afwikkeling van de fout (Released) - -De wijzigingen worden in de NFRA Master geupdate, inclusief wijzigingen -van de documentatie. -De gebruiker die de bug gemeld had, wordt op de hoogte gesteld, -de master op zijn site wordt bijgewerkt. -Andere sites ontvangen een melding van de wijzigingen, en worden -eventueel bijgewerkt. - - -3. Revisions en releases ------------------------- - -Bij wijzigingen in Newstar kunnen we twee gevallen onderscheiden: - - de wijziging heeft een minimale invloed op het gebruik van de - programma's (afgezien van het ontbreken van crashes etc.); - kleine toevoegingen in functionaliteit vallen hier ook onder - - de wijziging heeft invloed op het gebruik van de programma's - (veranderde keywords, noodzaak om SCN files te converteren etc) - -In het eerste geval spreken we van een revision van Newstar. Bij een -revision is het niet nodig dat elke gebruiker een melding van -dit heuglijke feit ontvangt. Ook is het niet nodig dat alle sites -een revision onmiddelijke ontvangen. Het exporteren van een revision -gebeurt door een beperkt aantal bestanden over te zenden (via een -revision groupfile: update retrieve .....grp) - -In het tweede geval spreken we van een release van Newstar. -Een release wordt expliciet aangekondigd aan alle gebruikers (evt via -locale Newstar managers). Een release wordt ge\"exporteerd naar alle -sites. Voor een release wordt het volledige Master systeem van de site -gecontroleerd: update retrieve all) - - -4. Functionality requests -------------------------- - -Voor functionality requests geldt in principe hetzelfde als voor bug, -met dien verstande dat het reproduceren van de fout vervalt, en dat de -overige stappen een langere tijdschaal hebben. - - -5. Implementatie: nbug ----------------------- - -In de NFRA Master staat een subdirectory $n_src/doc/bug waarin voor -elke bug een bestand wordt bijgehouden. Deze bestanden (project files) -kunnen met de Hypertext browser worden bekeken via een aantal indexen. -Onderlinge verbindingen zijn mogelijk. - -Onafhankelijk van de manier waaop de bug binnenkomt (eMail, formulier AGB, -telefonisch, wandelgangen) wordt een project file gemaakt. Als de bug -elektronisch gerapporteerd werd, kan het betreffende bestand aan de -project file gekoppeld worden, anders moet de essentiele informatie -worden ingevoerd. - -Wanneer nieuwe informatie beschikbaar komt (na toewijzing, bevestiging, -oplossing etc) wordt die toegevoegd aan de project file, eventueel met -een gekoppeld tekstbestand. - -De bug-reports worden bijgehouden middels de utility "nbug", die een -hele reeks opties heeft. De meeste opties corresponderen met de diverse -stadia die een bug in zijn carriere kan doorlopen. - - add Invoeren nieuwe bug (kent nummer toe, vraagt details) - confirm Ontvangstbevestiging - priority Prioriteitstelling (vraagt priority en assignment) - suspend Wordt tijdelijk niet aan gewerkt (behoudt prioriteit) - - analysed Fout is gevonden - solved Fout is opgelost - tested Oplossing is getest - - released Nieuwe software is vrijgegeven (priority wordt -1) - - feedback Bevestiging van contact met melder - status Vraagt status op van bepaalde bug (kan beter via hypertext) - - -Bovenstaande opties vragen allemaal om een associated file en een -comment, en geven de optie om de project file te editen (emacs of $EDITOR). -Ze voeren ook automatisch een index commando uit. Indices kunnen op -ieder moment gemaakt worden met de index optie: - - index Maakt de standard indexen voor de hypertext - - Alle bugs op volgorde van nummer - - Alle bugs op volgorde van prioriteit - - Alle actieve bugs op volgorde van prioriteit - -Naast indices voor on-line toegang zijn (geprinte) lijsten vooralsnog -van groot belang. De volgende lijsten kunnen met de ndoc optie "list" -worden gemaakt: - - list Maakt lijsten voor printout - full Alle bugs op volgorde van nummer - priority Alle bugs op volgorde van prioriteit - active Alle actieve bugs op volgorde van prioriteit - late Alle "vertraagde" bugs, dat is: - - ontvangen en niet binnen twee dagen bevestigd - - niet suspended en geen feedback binnen twee weken - - suspended of released en geen feedback binnen twee dagen - - user Alle bugs van een bepaalde user (Pietje Puk etc) - programmer Alle bugs van een bepaalde programmeur (HjV, WNB, ...) - - -In de lijsten (en indices) verschijnt de bug als volgt: - -ID Pr.ty Origin Worker Status Action/Feedback Description ------------------------------------------------------------------------------- - -0024 10 verheijen None Confirmed 930806/930823 Gridding in .. -0023 200 verheijen CMV Confirmed 930806/930823 NGIDS locks .. -: -0020 0 verheijen None Confirmed 930806/930823 NGIDS much t.. -0019 300 verheijen, WHISP CMV Confirmed 930806/930823 NGIDS flaggi.. -: - -De volgende bestanden zijn van belang voor nbug: - - $n_src/doc/bug/n????.prj Project file - $n_src/doc/bug/detail/n????.* Alle overige documenten - - $n_src/doc/bug/nbug.txt "Home Page" met links naar indices - $n_src/doc/bug/nbug.idx Index op nummer - $n_src/doc/bug/npriority.idx Index op priority - $n_src/doc/bug/nactive.idx Index op priority voor actieve bugs - -Al deze bestanden zijn normale ASCII file die naar believe kunnen worden -bijgewerkt voor veranderingen die niet door nbug worden ondersteund. - - -6. Prioriteitsstelling ----------------------- - -De voorlopige strategie voor de prioriteiten is als volgt: - - - Prioriteiten lopen van 0 tot 900 - - De honderdtallen doen dienst als grove prioriteitsklassen - Bugs uit 900-999 worden in principe het eerst aangepakt - - De tientallen doen dienst als een globaal werkschema binnen de - prioriteitsklassen. Bugs uit 990-999 worden in principe eerder - aangepakt dan bugs uit 980-989 - - De eenheden zijn een kunstmatig middel om een bug omhoog te kunnen - schuiven zonder alle overige project files te moeten wijzigen. - Als een bug met prioriteit 700 zeer urgent wordt, urgenter dan - bestaande bugs met prioriteit 980, dan wordt de prioriteit gewijzigd - naar 981. - - - Een tijdslimiet of schatting kan als commentaar bij de prioriteit- - stelling worden gegeven. - -Een definitief systeem zal worden vastgesteld op basis van ervaringen met -het huidige voorstel. - - -6.1 Update on the priority system: ---------------------------------- - -There are now five priority classes: - - 100 - Critical bugs, that make it impossible to use vital programs - 200 - Urgent requests or bugs - 300 - Desirable things - 400/500 - Pro memori - -The priority scheme does not show any timeslicing, but is complemented -in this respect by the Project Plan. - -The header tag Class has been added to distinguish between Bugs -and Requests, the tag Category shows the program (e.g. NSCAN, NPLOT) -with which the Bug/Request is mainly concerned. - - -7. Slotopmerkingen ------------------- - -Het moge duidelijk zijn dat een dergelijk systeem niet beperkt is tot -gebruik binnen Newstar. Met een aantal triviale wijzigingen in nbug -is het mogelijk voor een willekeurig software project een dergelijke -rapportage op te zetten. - -Ook is deze strategie in principe bruikbaar voor alle processen waarbij -een "checklist" van status veranderingen moet worden bijgehouden. -Desgewenst kan de volgorde van veranderingen worden vastgelegd. - -We kunnen nbug vergelijken met andere bug-reporting systemen (zoals bv het -GNATS systeem van GNU). Deze systemen hebben een grotere nadruk op -automatische interactie/responsies via electronische mail. De on-line -toegankelijkheid is kleiner dan bij nbug, evenals de centrale rapportage -mogelijkheden. Desgewenst kan meer eMail interactie worden ingebouwd in -nbug. Dit lijkt me in de huidige situatie (waar verreweg de meeste -klachten verbaal worden ingediend) nauwelijks de moeite. - - - - - -Appendix A: Casus ------------------ - -> _nbug add_ -Creating bug-report project file with id-number 0036 -Enter name of file with associated eMail: _~devoscm/tmp_ -Enter origin [Pietje Puk]: __ -Enter email address [Unknown]: _puk@rux.timboektoe.edu_ -Enter subject [Unknown]: _Cannot make poststam images anymore_ -Any comments: _Seems the same old problem again_ - -Please confirm the bug within two days and set a priority as soon -as possible. Indices for the bug-database will be updated. - -Edit the project file (y,n)? [n] _n_ -0036 0 Pietje Puk None Received 930909/000000 - Cannot make poststamp images anymore -Updating indices... - -After I called him back, I type... - -> _nbug confirm 36_ -0036 0 Pietje Puk None Received 930909/000000 - Cannot make poststamp images anymore -Any comments: _Called back, Mr. Puk seems quite upset about this_ -Associated file (may be -bugid or detail/...): __ -Edit the project file (y,n)? [n] __ -0036 0 Pietje Puk None Confirmed 930909/930909 - Cannot make poststamp images anymore -Updating indices... - -Then JEN decides this is quite important... - -> _nbug priority_ -Enter bug-id: _36_ -0036 0 Pietje Puk None Confirmed 930909/930909 - Cannot make poststamp images anymore -Enter (new) priority: _900_ -Assign job to: _HjV_ -Any comments: _Must be solved with a week_ -Associated file (may be -bugid or detail/...): __ -Edit the project file (y,n)? [n] __ -0036 1000 Pietje Puk HjV Assigned 930909/930909 - Cannot make poststamp images anymore -Updating indices... - -So it is analysed immediately... - -> _nbug analy 36_ -0036 1000 Pietje Puk HjV Assigned 930909/930909 - Cannot make poststamp images anymore -Any comments: _Missing check on array bounds in NPLSTM_ -Associated file (may be -bugid or detail/...): _test.log_ - -Edit the project file (y,n)? [n] __ -0036 1000 Pietje Puk HjV Analysed 930909/930909 - Cannot make poststamp images anymore -Updating indices... - -And when Dr. Puk calls me occasionally... - -> _nbug feedback 36_ -0036 1000 Pietje Puk HjV Analysed 930909/930909 - Cannot make poststamp images anymore -Any comments: _Pietje called again, told him Henk found it_ -Associated file (may be -bugid or detail/...): __ -Edit the project file (y,n)? [n] __ -0036 1000 Pietje Puk HjV Analysed 930909/930909 - Cannot make poststamp images anymore -Updating indices... - -Etc. - -Appendix B: Format of project file and indices ----------------------------------------------- - -n0036.prj: ------------------------------------------------------------- - <TITLE>Newstar Bug Report # 0036</TITLE> - - <H1>Newstar Bug Report # 0036 </H1> - - <DT><STRONG>Origin:</STRONG> Pietje Puk - <DT><STRONG>Address:</STRONG> puk@rux.timboektoe.edu - <DT><STRONG>Subject:</STRONG> Cannot make poststamp images anymore - <DT><STRONG>Status:</STRONG> Analysed - <DT><STRONG>Priority:</STRONG> 1000 - <DT><STRONG>Worker:</STRONG> <A HREF=../html/people.html#HjV>HjV</A> - <DT><STRONG>Last action:</STRONG> 930909 - <DT><STRONG>Last feedback:</STRONG> 930909 - - <P> - <H2>Detailed description</H2> - - <P> - <H2>History</H2> - - <DT>930909 18:05 - <STRONG>Received</STRONG> by Marco de Vos - <DD>Seems the same old problem again - (<A HREF=detail/n0036.1>detail</A>) - <DT>930909 18:07 - <STRONG>Confirmed</STRONG> by Marco de Vos - <DD>Called back, Mr. Puk seems quite upset about this - <DT>930909 18:07 - <STRONG>Assigned (HjV, priority 1000)</STRONG> by Jan Noordam - <DD>Must be solved with a week - <DT>930909 18:08 - <STRONG>Analysed</STRONG> by Henk Vosmeijer - <DD>Missing check on array bounds in NPLSTM - (<A HREF=detail/n0036.2>detail</A>) - <DT>930909 18:09 - <STRONG>Feedback</STRONG> by Marco de Vos - <DD>Pietje called again, told him Henk found it ------------------------------------------------------------- - - -nbug.idx: ------------------------------------------------------------- - <TITLE>Newstar Bug Index: all keys</TITLE> - <H1>Index of all bugs sorted on ID number</H1> - - <P> - <LI> For an index sorted on priority, click <A HREF=npriority.idx>here</A> - <LI> For an index of active items only, click <A HREF=nactive.idx>here</A> - <P> - - <TT><DT>BugID Pr.ty - Subject - <DD><STRONG>Status...</STRONG> - Action/Feedback - (<EM>Origin</EM> - Worked on)</TT><P> - - <TT><DT><A HREF=n0001.prj>0001</A>: +0000 </TT> - Lines in NPLOT to ... - <TT><DT><A HREF=n0002.prj>0002</A>: +0000 </TT> - Programs stay sile... - ------------------------------------------------------------- - diff --git a/src/doc/txt/calibr_models.txt b/src/doc/txt/calibr_models.txt deleted file mode 100644 index 8084547dd901c38e875e126f9aa5d213e50be0db..0000000000000000000000000000000000000000 --- a/src/doc/txt/calibr_models.txt +++ /dev/null @@ -1,62 +0,0 @@ -Beste mensen, - -Op /user4/92calib staan 5 modellen voor 325 MHz -van 5 in Westerbork gebruikte calibrators (3C48, 147, -286, 295 en 345) - -Ze bevatten ruim honderd componenten, voldoende voor een -nauwkeurige zelfcalibratie. - -Bedenk echter het volgende: - -1) Ze gelden voor 325 MHz en als je ze in NCALIB -wilt gebruiken op andere banden van het -breedband 92cm systeem moet de BEAM optie aangezet -worden. Dat corrigeert dan in eerste orde (met behulp -van een (cos**6(cfr) functie) voor de veranderende primaire -bundel (met c=0.0629 dat nu geldt voor alle -frequenties beneden 500 MHz). Echter op de laagste frequenties -is de bundel waarschijnlijk breder dan een simpele -frequentie schaling. Daar moet dan dus een nieuwe -coefficient voor worden bepaald alsmede een nieuw frequentie -interval waarvoor die constante geldt voor worden gecreeerd. - -2) De calibratie bronnen zijn in werkelijkheid natuurlijk minder sterk -op de hogere frequenties. Maar om redenen uitgelegd in een -README help file in dezelfde directory wordt daar NIET voor -gecorrigeerd !! Daar moeten de astronomen zelf voor corrigeren -met behulp van de spectrale indices van die bronnen. - - -3) De bron 3C345 mag niet als flux calibrator gebruikt worden omdat -hij in fluxdichtheid varieert. Deze bron wordt slechts zo af en toe -gemeten om dat hij gepolariseerd is waardoor met behulp van het Stokes -U signaal het phase verschil van de XX en YY kanalen gecontroleerd -kan worden onder de aanname dat V=0 (VZERO optie in NCALIB-polar) -Deze bron heeft ook een RM van ongeveer 15-20 rad/m**2 waardoor de -Stokes Q en U percentages afhangen van frequentie. -Deze percentages staan dus ook niet in het model. -Ze zijn trouwens afhankelijk van de ionosferische Faraday draaiiing -die niet nauwkeurig bekend is. - -4) Voor de bron 3C303 (die ook i.v.m. met zijn hoge lineaire -polarisatie wordt waargeneomen, net als 3C345) -wacht ik nog steeds op een aantal metingen -waaruit ik een goede kaart kan maken waaruit een model te halen is. -Verder geldt voor deze bron hetzelfde als voor 3C345 behalve dat hij -niet verandert in flux dichtheid. - -Henk: Kun jij deze modellen neerzetten op de plaats waar NEWSTAR -zijn default modellen weghaalt. - -Als er vragen zijn dan hoor ik het wel. - -Ger --- - -A.G. de Bruyn (Ger) | Internet: ger@astron.nl -NFRA | -Postbus 2 | Phone: (31)-521-595257 -7990 AA Dwingeloo | Fax: (31)-521-597332 -The Netherlands - diff --git a/src/doc/txt/control_c.txt b/src/doc/txt/control_c.txt deleted file mode 100644 index 8f09648f448cff2d8b7f88fdf36c6a44826e8168..0000000000000000000000000000000000000000 --- a/src/doc/txt/control_c.txt +++ /dev/null @@ -1,38 +0,0 @@ -Trapping control-C in Newstar programs -------------------------------------- - - (contributed by JPH 941005, gleaned from wndpar_x.fun, wngex.for) - - - - - INCLUDE WXH_DEF ... - XHCC(0)=1 ! inhibit ... - XHCC(0)=0 ! clear - IF (XHCC(1) .NE.0) THEN ! was a control-C caught? - XHCC(1)=0 - <action, typically CALL WNGEX> - ENDIF - - This code has been used to create module WNGCC with entry points - - WNGCCD disable control-C - WNGCCE enable control-C - LOGICAL WNGCCC check and reset 'control-c seen' status - -and several other entry points to check, count and reset the number of -interrupts seen. - - - The implementation is in entry point WNGEX0 in wngex.for. This routine -is declared the handler for signal SIGINT by wngsxh.fsc. Its action is very -simple: - - if xhcc(0) !=0 - xhcc(1)+=1 - else - fall through to WNGEX - - endif - - - diff --git a/src/doc/txt/copyright.txt b/src/doc/txt/copyright.txt deleted file mode 100644 index 6d061df0b1319b0765c5ae880d738eaffea10792..0000000000000000000000000000000000000000 --- a/src/doc/txt/copyright.txt +++ /dev/null @@ -1,157 +0,0 @@ -NEWSTAR - Copyright Notice --------------------------- - - COPYRIGHT (c) 1991, 1994 - by the Netherlands Foundation for Research in Astronomy - - NFRA/St. ASTRON - P.O. Box 2 - 7990 AA Dwingeloo - The Netherlands - - - The information in this document is subject to change without - notice and should not be construed as a commitment by the NFRA. - - The NFRA assumes no responsibility for the use or reliability - of the Newstar package and software exported together with it. - - Permission to use, copy, and distribute Newstar software and its - documentation for any purpose is hereby granted, provided that - this copyright notice appears in all copies. - - Permission to modify the software is granted, but not the right - to distribute the modified code. Modifications are to be distributed - exclusively through the Newstar Master Installation at the NFRA. - Please send any modifications to the Newstar manager who may - include them in the Master Installation for further distribution. - - Requests for copies of the Master Installation, for assistance with - the installation and for support of an unmodified version of the - Master Installation can be directed to the Newstar manager, who - can be reached by electronic mail as newstar@astron.nl or through - the Newstar User Feedback System (refer to the documentation for - details). - - - The Gipsy program gids and the giplib-library are distributed - with Newstar. Gipsy is copyrighted by the Kapteyn Astronomical - Institute, University of Groningen. The original copyright notice - for the Gipsy software is included at the end of this document. - - A binary version of the Mosaic hypertext browser, developed at - the NCSA (Illinois) is distributed with Newstar. The original - copyright notice for Mosaic is included at the end of this document. - - Newstar includes a modified version of the X11-driver originally - developed for the PGPLOT package by Tim Pearson (Caltech). - - - -COPYRIGHT Release 3.5 - - Groningen Image Processing SYstem (GIPSY) - - COPYRIGHT (c) 1978, 1984, 1992, 1993, 1994 - - Kapteyn Astronomical Institute, - University of Groningen - P.O. Box 800 - 9700 AV Groningen - The Netherlands - - - The information in this document is subject to change without - notice and should not be construed as a commitment by the Kapteyn - Astronomical Institute. - - The Kapteyn Astronomical Institute assumes no responsibility for - the use or reliability of its software. - - Permission to use, copy, and distribute GIPSY software and its - documentation for any purpose is hereby granted, provided that - this copyright notice appears in all copies. - - Permission to modify the software is granted, but not the right - to distribute the modified code. Modifications are to be distributed - via the GIPSY source server, which is currently kapteyn.astro.rug.nl. - You can send your modifications to the GIPSY manager, who will take - care of the distribution. - - Permission to install modified or new code directly can be obtained - from the GIPSY Manager. The E-Mail address of the GIPSY Manager - is listed in $gip_sys/manager.mgr. - - Reports of software failures will only be considered when you have - an automatic update of GIPSY sources installed at your site. See - $gip_sys/README. - - -Everything not already copyrighted by CERN is copyrighted by NCSA -(including the contents of the libhtmlw, libnet, libXmx, and src -directories, but not including the contents of libdtm, which is -entirely public domain). - -The official NCSA Mosaic copyright statement follows. - -/**************************************************************************** - * NCSA Mosaic for the X Window System * - * Software Development Group * - * National Center for Supercomputing Applications * - * University of Illinois at Urbana-Champaign * - * 605 E. Springfield, Champaign IL 61820 * - * mosaic@ncsa.uiuc.edu * - * * - * Copyright (C) 1993, Board of Trustees of the University of Illinois * - * * - * NCSA Mosaic software, both binary and source (hereafter, Software) is * - * copyrighted by The Board of Trustees of the University of Illinois * - * (UI), and ownership remains with the UI. * - * * - * The UI grants you (hereafter, Licensee) a license to use the Software * - * for academic, research and internal business purposes only, without a * - * fee. Licensee may distribute the binary and source code (if released) * - * to third parties provided that the copyright notice and this statement * - * appears on all copies and that no charge is associated with such * - * copies. * - * * - * Licensee may make derivative works. However, if Licensee distributes * - * any derivative work based on or derived from the Software, then * - * Licensee will (1) notify NCSA regarding its distribution of the * - * derivative work, and (2) clearly notify users that such derivative * - * work is a modified version and not the original NCSA Mosaic * - * distributed by the UI. * - * * - * Any Licensee wishing to make commercial use of the Software should * - * contact the UI, c/o NCSA, to negotiate an appropriate license for such * - * commercial use. Commercial use includes (1) integration of all or * - * part of the source code into a product for sale or license by or on * - * behalf of Licensee to third parties, or (2) distribution of the binary * - * code or source code to third parties that need it to utilize a * - * commercial product sold or licensed by or on behalf of Licensee. * - * * - * UI MAKES NO REPRESENTATIONS ABOUT THE SUITABILITY OF THIS SOFTWARE FOR * - * ANY PURPOSE. IT IS PROVIDED "AS IS" WITHOUT EXPRESS OR IMPLIED * - * WARRANTY. THE UI SHALL NOT BE LIABLE FOR ANY DAMAGES SUFFERED BY THE * - * USERS OF THIS SOFTWARE. * - * * - * By using or copying this Software, Licensee agrees to abide by the * - * copyright law and all other applicable laws of the U.S. including, but * - * not limited to, export control laws, and the terms of this license. * - * UI shall have the right to terminate this license immediately by * - * written notice upon Licensee's breach of, or non-compliance with, any * - * of its terms. Licensee may be held legally responsible for any * - * copyright infringement that is caused or encouraged by Licensee's * - * failure to abide by the terms of this license. * - * * - * Comments and questions are welcome and can be sent to * - * mosaic-x@ncsa.uiuc.edu. * - ****************************************************************************/ - -For more information on copyright and licensing issues, contact: - -Marc Andreessen -Software Development Group -National Center for Supercomputing Applications -605 E. Springfield, Champaign IL 61820 -marca@ncsa.uiuc.edu diff --git a/src/doc/txt/debug_efficiently.txt b/src/doc/txt/debug_efficiently.txt deleted file mode 100644 index 9d6ad328325e8dbb362ede302dcae95ebf598ba2..0000000000000000000000000000000000000000 --- a/src/doc/txt/debug_efficiently.txt +++ /dev/null @@ -1,36 +0,0 @@ -Efficient use of the dbx debugger on the SUNs ---------------------------------------------- - -(contributed by JPH 940919; based on research by CMV) - - - For the convenience of programmers who want to use dbx with Newstar -programs, the objects in the Newstar libraries are routinely compiled with the --g option (Newstar nsh option 'build -d') which creates objects including the -necessary symbolic information. When an executable is built with this same -option, all this information is carried over, resulting in a .exe file in which -all modules are accessible to dbx. - - This is very convenient for a programmer who needs access not only to -modules that he is modifying in his own shadow system but also to other -unmodified modules in the master libraries; indeed, there is no need for him to -copy master files to his shadow system for the mere purpose of recompiling them. - The disadvantage is that the .exe file carries a huge ballast of -symbolic information (typically several hundred thousands of items) which take -a long time (many minutes) to load at the expense of a more than unmodest -consumption of machine resources. - - CMV found the following simple procedure to load only those symbols -that one actually needs: - - > dbx - dbx> modules select <object_1>.o, <object_2>.o, ... - dbx> debug <$n_exe/<program>.exe - dbx> <set breakpoints or whatever> - dbx> run - -Should one discover in the subsequent debugging session that more modules are -needed, then one may restart the above sequence without leaving dbx. -Breakpoints and the like remain valid, but the modules selected before must -again be spelled out, - this is not nice but usually one needs only a few ... - diff --git a/src/doc/txt/doc_organisation.txt b/src/doc/txt/doc_organisation.txt deleted file mode 100644 index 4f37612030a1c841c912ceebdf8e8aa56c342538..0000000000000000000000000000000000000000 --- a/src/doc/txt/doc_organisation.txt +++ /dev/null @@ -1,776 +0,0 @@ -The Organisation of Newstar documentation ------------------------------------------ - - -@(#) newdoc.txt v1.6 08/09/93 CMV - newdoc.txt v1.5 03/09/93 CMV - newdoc.txt v1.4 05/08/93 CMV - - -1. Introduction ---------------- - - -This document defines the format and organisation of the Newstar -documentation. The next sections describe the way documentation can be -accessed, the way in which the documentation as a whole is organised and -the way in which documentation should be formatted. This corresponds to the -the point of view of a user, a Newstar site manager and a documentation -editor respectively. Appendices give detailed instructions for naming -conventions and editing. - -End-users who are just interested in using the documentation only -need to read section 2, site managers and contributors should read -the remaining sections as well. - - -2. Accessebility ----------------- - -The Newstar user documentation is accessible in three forms: - - 1e. As on-line help from program prompts, either as "dumb-terminal" - text or through NCSA's xmosaic browser decribed below. - - 2e. By browsing the documentation using xmosaic or any other - hypertext reader (e.g. the "dumb-terminal" reader for the - World Wide Web, developed at CERN) - - 3e. By reading the printed form of the documentation (the Newstar - Cookbook) either on paper or using an appropriate Postscript or - dvi viewer. - - -The documentation is organised as a hypertext network, which means that -various smaller pieces of information are connected by "links". This -not only gives flexible index and glossary functions, but also allows for -a menu-like presentation of the on-line documentation (options 1e and -2e). The pieces of information can also be put together in a single -large document, the Newstar Cookbook, where "links" show up as the -usual references like "see also section 1.3". - -To access the on-line documentation, the user enters one or more -questionmarks (?) in response to a prompt. If a single ? is entered, -the help text will be shown on the terminal screen. If more than -one ? is entered, a separate window will be opened in which xmosaic -presents the requested information. If no window could be started, -the help text will be given on the terminal. When an xmosaic window -is open, all help text will be presented there, regardless of the -number of questionmarks typed. The window remains active when the -program quits, so the same window can be used by several programs -(so far only if run on the same host). Xmosaic has been developed at -the NCSA and has many interesting options which fall outside the -scope of this document. - -If the information is shown through xmosaic, the user can access the -remainder of the documentation though that browser. Certain words in -the text will appear underlined. The user can move the mouse on one -of these words and click the left mouse button. Xmosaic will now display -the information that is associated with the underlined word. This can -be a brief explanation of that word (glossary function) or a related -piece of documentation. - -Any help text explaining a prompt will have at least the following links -appended to it (words within underscores will appear underlined): - - More information: - _List of keywords_ for NSCAN - _The Newstar Cookbook_ - Description of _program NSCAN_ - Description of _common keywords_ - The _DWARF User Interface_ - -The list of keywords for any program will have the following list appended -to it: - - More information: - _The Newstar Cookbook_ - Description of _program NSCAN_ - Description of _common keywords_ - -Prompts related to specific file types will also contain links to -documents revealing the secrets of such files. - -The hypertext network can also be accessed from outside a Newstar program -by typing "nhyper" at the command line. This will present you a page -with general information containing links to the table of contents of -the Newstar Cookbook and to some general help files (in particular the -Newstar News file). - - -3. Organisation ---------------- - -There are four different sources of information for the Newstar -documentation: - - - Cookbook sections, which are LaTeX documents (with some restrictions - on the commands to be used, see below). They may contain ordinary - text, terminal scripts (created with help of "nscript", see below) - and may include postscript figures. These LaTeX files are translated - into the HTML format for inclusion in the hypertext network. - - The LaTeX source files are all found in directory $n_src/doc/cook - The HTML versions are found in directory $n_src/doc/html - - - - Descriptive text (help-text) for program keywords, stored in - so called PIN files (extensions .pin, .psc or .pef). The PIN files - are translated into LaTeX (for inclusion in the printed version - of the cookbook) and into HTML for inclusion in the hypertext - network. - - The PIN files are located in $n_src/nscan etc. - The LaTeX versions are found in directory $n_src/doc/cook - The HTML versions are found in directory $n_src/doc/html - - - - Miscellaneous documents called Memo's, which are generally plain - ASCII files. For details on Newstar Memo's, refer to document - newmemo.txt - - The NEWSTAR Memo's are found in directory $n_src/doc/memo - - - Program source files can contain specially marked documentation - which can be extracted. The extracted documentation can be included - in the hypertext network. - - Documentation from file abc.def is stored in $n_src/doc/extractabc.def - - - - Bugreports, with their present status and history, are a separate - issue and are described in document bug_reports.txt. - - Bugreports are found in directory $n_src/doc/bug - - -Apart from these files there are: - - - Files with LaTeX commands used to generated printed versions of the - cookbook or parts thereof. These files are found in $n_src/doc/cook - and have names cb_*.tex - - - Index files for the hypertext network, generated automatically in - directory $n_src/doc/html - - -Files are maintained though utility $n_src/sys/document.csh which uses -the program docaid.c ($n_exe/docaid.exe). - -There is a groupfile $n_src/doc/doc.grp listing files in or below $n_src/doc -that have been created "by hand". A groupfile $n_src/doc/auto.grp will be -updated together with the hypertext indices. - -Note: the files in directories keys and html are derived from files in -the source tree ($n_src). These files are updated automatically when -other files (e.g. ppd-files) are being compiled. -This validates the principle that the source tree contains only all -files needed for installation. The alternative would be to create a -directory in either the library or the executable tree for -documentation. However, I think it is important that a full set of -documentation is available before installation. In my opinion this -outweights the violation of the source tree policy. It also makes -it possible that, at least for the time being, files in the keys -and html directory are explicitly updated at NFRA. - - -An update of the documentation proceeds as follows: - - "ndoc keys all" Convert all pin, psc and pef files to LaTeX and html files - "ndoc extr all" Extract documentation from files in $n_src/sys - "ndoc html all" Convert all cookbook sections to html files - "ndoc index" Make indices for the files in the html directory - -A shorthand for these commands is: "ndoc full" - -Updating the documentation takes a few minutes and needs to be done at -a single host only for all machines that share a filesystem. - -Other options of ndoc are: - - "ndoc script" Start the script utility (see Appendix C) - "ndoc print" Print part of the Newstar Cookbook - "ndoc hyper" Start the hypertext browser at the Newstar Home Page - "ndoc memo" Insert an external file into the Newstar Memo system - -The print command will ask you for a cookbook file to print. - - -4. Formatting -------------- - -Since a large amount of documentation is available already in -LaTeX, we choose to use LaTeX as our principle documentation -format. Although it is probably easier to convert an html document -to a LaTeX source than vice versa, this approach allows us to make -a fast start. To facilate translation we put some constrains on the -infinite flexibility of LaTeX. These are given in the "style guide" -found as Appendix A. - -Appendix A lists the "allowed" LaTeX commands, these are the commands -that will be recognised by the LaTeX to HTML converter. Any other -command will, for the time being, show up as ordinary text in the -xmosaic browser. - -The most important rules for writing documentation are the following: - - 1e. The basic element of Cookbook documentation is the section. - Each section should appear in a separate file. - It is well possible (and in fact preferable) to break - up sections in smaller units. - - 2e. Figures, tables and other blocks containing large amounts - of LaTeX commands not listed in Appendix A should be put in the - Cookbook by means of an \input or \include command. The embedding - commands (like \begin{figure} and \end{figure}) should also be - in that separate file. - - Such figures and tables will be converted to dvi or postscript - files in the html directory. - - 3e. Terminal sessions can be included within cookbook sections. - However, for extended examples it is better to put them in a - separate file which is included by an \input or \include command. - This makes the hypertext more readable and facilates regeneration - if the programs change. - - For a list of the LaTeX commands that will appear in terminal - sessions, refer to Appendix A. - - Refer to Appendix C for instructions on how to make - terminal sessions using the nscript command - - 4e. Within a section, the target of a hypertext link is marked - through the \label command. See the naming conventions in - Appendix B (eg. \label{nscan.descr.general}) - - 5e. Within a section, a hypertext link is made though the \ref, \refn, - \input and \include commands. The \input and \include commands - will translate to a lines: "See also: _Name of the include file_" - in the browser. The \ref command will translate as follows: - - ... This is explained in \ref{nscan.descr} where we see ... -> - ... This is explained in _here_ where we see ... - - ... This is explained in \ref{nscan.descr}{Chapter 4} ... -> - ... This is explained in _Chapter 4_ ... - - The last for will give a somewhat confusing output in the - printed version. - - 6e. Within PIN files, links can also be made through the \ref command. - In the "dumb-terminal" on-line help, these \ref commands show up - as text and may at best serve as an entry in the printed version - of the Cookbook. - - 7e. Filenames and labels should obey a strict naming scheme to - allow for the proper files to be constructed. This naming - scheme is given in Appendix B. - - -5. Contributing to the Newstar documentation --------------------------------------------- - -Contributions to the Newstar documentation are very welcome, in particular -new recipes are appreciated. To contribute a recipe, put your text in a -file either as plain ASCII (with some indication as to sections etc) or -using the LaTeX commands from Appendix A. Preferably you should use the -naming conventions from Appendix B. Send the files to me and we will put -them in their proper place. - - - -Appendix A: Style Guide for the Newstar Cookbook ----------- - -The following conventions should be obeyed when writing LaTeX documents -that should be converted to html using the docaid program: - - - Only commands in the recognised subset (see below) may be used. - - - The \begin{...} and \end{...} commands should be on a line of - their own. - - - To change font temporarily, use something like {\bf ...}, without - any space between the brace and \bf. Curently recognised fonts - are: \rm \bf \it \tt \tiny - - - For verbatim text use either - - \begin{verbatim} - ... - \end{verbatim} - - or {\tt ...} (with special characters escaped). - The commands used by nscript (\sline etc) use the latter strategy. - - - The tabbing environment can be used inside documents with the - following restrictions. There should be a single definition line - (with \= commands), which should follow the \begin{tabbing} line - without intervening empty/comment lines. The definition line will - not be copied to the hypertext, so use the \kill command. - - Since tabbing in HTML is extremely poor, do not expect to much of - presentation in xmosaic. - - -The following subset of LaTeX commands is currently recognised by docaid. - -/* - - Translation table for LaTeX to html - - Format: - - Column 1: name of the command (minimal match) without leading \ - Column 2: length of command (all zero's, set by program) - Column 3: action routine - NULL No special action (just print replacement string) - _PUSH Print closing tag for the replacement string when - closing } is found - _SKIP Skip any arghuments to the command - other Special action, refer to code for details - Column 4: replacement string (or NULL if none) - - - Any LaTeX commands that do not start with a \ are handled separately, - however they are included in this table inside comments. - -*/ - -/* - The following lines correspond to definitions in cb_symbols.tex - Please update this list when cb_symbols.tex is changed -*/ - "cbdir", 0, NULL, "$n_src/doc/cook", - "NEWSTAR", 0, NULL, "<EM>NEWSTAR</EM>", - "Nseries", 0, NULL, "<EM>NEWSTAR</EM>", - - "cVis", 0, NULL, "<EM>V</EM>", - "pvis", 0, NULL, "<EM>Phi</EM>", - "avis", 0, NULL, "<EM>|V|</EM>", - "lavis", 0, NULL, "<EM>rho</EM>", - - "cGain", 0, NULL, "<EM>G</EM>", - "cNoise", 0, NULL, "<EM>N</EM>", - "cCadd", 0, NULL, "<EM>C</EM>", - - "perr", 0, NULL, "<EM>p</EM>", - "gerr", 0, NULL, "<EM>g</EM>", - "lerr", 0, NULL, "<EM>q</EM>", - "dang", 0, NULL, "<EM>phi</EM>", - "derr", 0, NULL, "<EM>Delta</EM>", - "eerr", 0, NULL, "<EM>Theta</EM>", - - "Apol", 0, NULL, "<EM>epsilon</EM>", - "Bpol", 0, NULL, "<EM>eta</EM>", - - "wgt", 0, NULL, "<EM>W</EM>", - "pwgt", 0, NULL, "<EM>W**p</EM>", - "lwgt", 0, NULL, "<EM>W**g</EM>", - - "pzd", 0, NULL, "<EM>psi</EM>", - - "farang", 0, NULL, "<EM>chi</EM>", - -/* - Here are the commands defined in cb_preamble.tex - Please update this list when cb_preamble.tex is changed -*/ - - "cbfile{", 0, _PUSH, "<TT>", - - "skeyword{", 0, _PUSH, "<DD><STRONG>", - "sprompt{", 0, _PUSH, "<EM>", - "sdefault{", 0, _PUSH, NULL, - "suser{", 0, _PUSH, " <KBD>", - "sline{", 0, _PUSH, "<DD><SAMP>", - "slong{", 0, _PUSH, "<DD><SAMP>", - "sskip", 0, NULL, "<P>", - "scmd{", 0, _PUSH, "<DD>> <KBD>", - - "sinline{", 0, _PUSH, " . . . <EM>", - "scomment{", 0, _PUSH, "<EM><P>", - - "setc", 0, NULL, "<P>:<P>:<P>", - "scr", 0, NULL, "<CR>", - "gloshead{", 0, _PUSH, "<H2>", - - -/* - Now follow the supported built-in LaTeX special characters - - A tilde (~, smallspace) is replaced by an normal space character - - Please mind that all commands below are prefixed by a backslash! -*/ - - " ", 0, NULL, " ", - "$", 0, NULL, "$", - "#", 0, NULL, "#", - "&", 0, NULL, "&", - "{", 0, NULL, "{", - "}", 0, NULL, "}", - "%", 0, NULL, "%", - "_", 0, NULL, "_", - "-", 0, NULL, NULL, - "\"o", 0, NULL, "ö", - "wedge", 0, NULL, "^", - - "arctan", 0, NULL, "<STRONG>arctan</STRONG>", - "ast", 0, NULL, "*", - "bigotimes", 0, NULL, "<STRONG>*</STRONG>", - "cdots", 0, NULL, "...", - "circ", 0, NULL, "o", - "copyright", 0, NULL, "(c)", - "delta", 0, NULL, "<EM>delta</EM>", - "div", 0, NULL, "-/-", - "equiv", 0, NULL, "==", - "exp", 0, NULL, "<STRONG>exp</STRONG>", - "gg", 0, NULL, ">>", - "infty", 0, NULL, "<STRONG>inf</STRONG>", - "lambda", 0, NULL, "<EM>lambda</EM>", - "ldots", 0, NULL, "...", - "log", 0, NULL, "<STRONG>log</STRONG>", - "over", 0, NULL, "/", - "phi", 0, NULL, "<EM>phi</EM>", - "pm", 0, NULL, "+/-", - "rightarrow", 0, NULL, "-->", - "sigma", 0, NULL, "<EM>sigma</EM>", - "sqrt", 0, NULL, "<STRONG>sqrt</STRONG>", - "sum", 0, NULL, "<STRONG>SUM</STRONG>", - "theta", 0, NULL, "<EM>theta</EM>", - "times", 0, NULL, ".", - "vdots", 0, NULL, ":", - -/* - Line separating commands - - An empty line will also translate to a <P> tag -*/ - - "\\", 0, NULL, "<DD>", /* Trick to get newline */ - "par", 0, NULL, "<P>", - "newpage", 0, NULL, "<P>", - "vspace", 0, _SKIP, "<P>", - -/* - Math modes - - $>$ and $<$ translate to the > and < entities, - any other $ .... $ construct is identical to \( ... \) - - $$ ... $$ constructs are identical to \[ ... \] -*/ - /* Inline math mode */ - "(", 0, NULL, " <EM> ", - ")", 0, NULL, " </EM> ", - "begin{math}", 0, NULL, " <EM> ", - "end{math}", 0, NULL, " </EM> ", - /* Display math mode */ - "[", 0, NULL, "<P><EM>", - "]", 0, NULL, "</EM><P>", - "begin{displaymath}", 0, NULL, "<P><EM>", - "end{displaymath}", 0, NULL, "</EM><P>", - "begin{equation}", 0, NULL, "<P><EM>", - "end{equation}", 0, NULL, "</EM><P>", - "begin{eqnarray}", 0, NULL, "<P><EM>", - "end{eqnarray}", 0, NULL, "</EM><P>", - -/* - Headings and references -*/ - "title{", 0, _PUSH, "<H1>", - "chapter{", 0, _PUSH, "<H1>", - "section{", 0, _PUSH, "<H1>", - "subsection{", 0, _PUSH, "<H2>", - "subsubsection{", 0, _PUSH, "<H3>", - - "label{", 0, _LABEL, NULL, - "ref{", 0, _ANCHOR, NULL, - "pageref{", 0, _ANCHOR, NULL, - "input{", 0, _ANCINP, NULL, - "include{", 0, _ANCINP, NULL, - - "eqno{", 0, _PUSH, "<EM>", - -/* - Many things are just ignored -*/ - "tableofcontents", 0, NULL, NULL, - "listoffigures", 0, NULL, NULL, - "listoftable", 0, NULL, NULL, - "makeindex", 0, NULL, NULL, - "documentstyle", 0, _SKIP, NULL, - "hskip", 0, _SKIP, NULL, - "hspace", 0, _SKIP, NULL, - "hline", 0, NULL, NULL, - "maketitle", 0, NULL, NULL, - "nonumber", 0, NULL, NULL, - "pagestyle", 0, _SKIP, NULL, - "pagenumbering", 0, _SKIP, NULL, - "parbox", 0, _SKIP, NULL, - -/* - Special handling for some environments -*/ - "begin{thebibliography}",0, NULL, "<H1>Bibliography</H1>\n", - "end{thebibliography}", 0, NULL, "<P>", - "bibitem", 0, _LABBIB, NULL, - "cite", 0, _ANCBIB, NULL, - - "begin{tabbing}", 0, _TABBING, NULL, - "end{tabbing}", 0, _TABBING, "<P>", - ">", 0, NULL, " ", - - "begin{figure", 0, _FIGURE, NULL, - "end{figure", 0, _FIGURE, "<P>", - "begin{tab", 0, _TABLE, NULL, - "end{tab", 0, _TABLE, "<P>", - "caption{", 0, _PUSH, "<EM>", - - "begin{enumerate}", 0, NULL, "<OL>", - "end{enumerate}", 0, NULL, "</OL>", - - "begin{itemize}", 0, NULL, "<UL>", - "end{itemize}", 0, NULL, "</UL>", - "item{", 0, _PUSH, "<LI> <STRONG>", - "itemitem{", 0, _PUSH, "<LI> <STRONG>", - "item", 0, NULL, "<LI>", - "itemitem", 0, NULL, "<LI>", - - "begin{verbatim}", 0, _VERBON, "<PRE>", - "begin{verbatim*}", 0, _VERBON, "<PRE>", - "end{verbatim}", 0, _VERBOF, "</PRE>", - -/* - All other environments are just skipped. - Note: the order in the table is important here! -*/ - "begin{", 0, _SKIP, "<P>", - "end{", 0, _SKIP, "<P>", - "author{", 0, _SKIP, NULL, - - "end", 0, NULL, NULL, - -/* - Font selections. These are special case things, since the required - syntax for a temporary font change is: - - {\bf ... } - - etc, so we test on the {\ rather than on the \ - - "rm", 0, _PUSH, "<STRONG>", - "bf", 0, _PUSH, "<STRONG>", - "em", 0, _PUSH, "<EM>", - "it", 0, _PUSH, "<EM>", - "tt", 0, _PUSH, "<TT>", - - Any isolated occurence of a font change is just ignored. - So you should use \chapter{{\it Something fresh}} - and not \chapter{\it Something fresh} - -*/ - "tiny", 0, NULL, NULL, - "bf", 0, NULL, NULL, - "it", 0, NULL, NULL, - "rm", 0, NULL, NULL, - "tt", 0, NULL, NULL, - -/* - The end of the table should be marked by a NULL command! -*/ - NULL, 0, NULL, NULL - - - -Appendix B: Naming convention for Newstar Documentation ------------ - -***** ALL LABELS AND FILENAMES SHOULD BE IN LOWER CASE ***** - - -1e. Labels - -The following conventions should be used for the naming of labels -and references (commands \ref{...}, \pageref{...} \label{...}): - - - The name of the label should consist of two or more elements - separated by dots. The first two elements uniquely identify the - file to which the reference is made. As a consequence all labels - in a file start with the same two elements. The remaining - elements serve as a reference within the file. - - - The label corresponding to a file a_b is a.b - A label within this file might be a.b.c or a.b.c.d - - The label corresponding to a file a_b_x is a.b_x - A label within this file might be a.b_x.c or a.b_x.c.d_y-z - - - References to keywords should be made as follows: - - \ref{<name of pin/psc/pef file>.<name of keyword>} - - * In general the name of the pin/psc/pef file will be the name of - * the program. For common keywords (including things like SCN_SETS) - * the name of the PEF file should be used! - - - - Figures, tables, formulea and other pieces of "difficult" LaTeX - will be included as GIF images, and should therefore be in separate - files. These files should have names fig_*.tex, tab_*.tex and - eqn_*.tex. Normal labeling conventions apply to such files. - -For bibliographic references (commands \bibitem and \cite) the normal -LaTeX conventions apply. - - -2e. Filenames - -The cookbook is built based on the following tree (all filenames have -extension .tex): - Label - cookbook (tittle page, table of contents) cookbook - | - | - +-- ch_biblio ch.biblio - | - +-- ch_general ch.general - | | - | +-- gen_intro gen.intro - | : - | - +-- ch_recipes ch.recipes - | | - | +-- rcp_line_21cm rcp.line_21cm - | +-- rcp_linear_polarisation rcp.linear_polarisation - | : - | - +-- ch_files ch.files - | | - | +-- files_descr files.descr - | +-- scn_descr scn.descr - | +-- mdl_descr mdl.descr - | : - | - +-- ch_programs ch.programs - | | - | +-- common_descr common.descr - | +-- common_keys common.keys - | | | - | | + ngen_comm ngen.comm - | | : - | | - | +-- nscan_descr nscan.descr - | +-- nscan_keys nscan.keys - | | | - | | + ngen_short ngen.short - | | : - | | - | +-- ncalib_descr ncalib.descr - | +-- ncalib_redun ncalib.redun - | +-- ncalib_polar ncalib.polar - | +-- ncalib_keys ncalib.keys - | | - | : - | - +-- ch_appendices ch.appendices - | - + apx_wsrtfactsheet apx.wsrtfactsheet - + apx_arquery apx.arquery - : - - -Files with keyword descriptions are generated automatically from the -pin/psc/pef files: - - - Each pin, psc and pef file is translated into a single LaTeX file - <name>_keys.tex (for pin/psc) or <name>_comm.tex (for pef). These - files contain the full description of each keyword define in the - pin/psc/pef file. For pef files, a keyword summary is generated - in file <name>_short.tex. An INCLUDE=NAME_PEF keyword in a psc file - will be translated in a \include{name_short} and a \ref{name.comm} - - - Each pin, psc and pef file is translated into a html file with - links to files with information on the individual keywords. - The index file has name <name>_keys.html (for pin/psc) or - <name>_comm.html (for pef). The files with keyword information are - named <name>_<keyword>.html - -Files with names fig_*.tex, tab_*.tex and eqn_*.tex will be included -as GIF figures. - - -Appendix C: Creating scripts of terminal sessions ------------ - -To create a script of a terminal session, the command - - $n_src/sys/document.csh script [file] - -should be used, this is conveniently aliased to "nscript". -If no filename is given, you will be prompted for one. - -This command will start the script command. The user has to initialise -Newstar by typing "$go" (this is not necessary if initialisation is done -in the user's .cshrc file). The initialisation procedure (in -$n_src/sys/newstar_init.csh) notices that the script utility is used -and will switch the DWARF bell "on". The prmpt will be set to "script> ". -You can execute all commands you like and then enter either "exit" or ^D. -The terminal session will now be transformed to a LaTeX file, which you -can edit at wish. - -The nscript command will ask you wether the terminal script should be -"Latex'ed" and printed or displayed (using xdvi, which should be in -your path). Often, you will want to edit the file first and then -view it. This is possible by typing: - - nscript -p [file] - -When answering to system prompts, you can add comments by prefixing -them with a semicolon followed by a hash mark, e.g.: - - script> dwe nscan ;# First we start reading data from tape - script> ls -l ; # This gives a directory listing - -If the hash is the first non-blank character on the line, the comment -will be on a line of it's own. - - script> # To start newstar, just type the following commands: - - -When answering to DWARF prompts, you can add comments by prefixing -them with an exclamation mark, e.g.: - - LEVELS = -20 -10 : 20 ! For this test, we use a single level - OPTION (blabla) = QUIT : ! No further processing needed! - -In the latter example, the second exclamation mark will just show up -as an exclamation mark (of course), the "empty" user respons will -translate to "<CR>" in the output. - - - NB: In order to facilate the script command, the DWARF "bell" is - now rung at the start of the prompt (used to be at the end). - The exclamation-mark comments turned out to be an existing DWARF - feature that had somewhat faded in the mist of times. - -The following LaTeX commands are used in translated terminal sessions; -they are defined for LaTeX in $n_src/doc/cook/cb_preamble.tex: - - \skeyword{ name of keyword } - \sprompt{ text of prompt } - \sdefault{ default value } - \suser{ user response } - - \sline{ line with terminal output } - \slong{ long line with terminal output } - - \scmd{ respons of user to operating system prompt } - - \sinline{ inline comment } - \scomment{ comment that is on a line of it's own } - \setc % Vertical dots replacing terminal output - \scr % Carriage Return in fixed width font - diff --git a/src/doc/txt/dwcalc.txt b/src/doc/txt/dwcalc.txt deleted file mode 100644 index 9dccc78319cb0089a052f3a7a0ea7d481154b43c..0000000000000000000000000000000000000000 --- a/src/doc/txt/dwcalc.txt +++ /dev/null @@ -1,276 +0,0 @@ -The desk-calcutor program DWCALC --------------------------------- - -HISTORY: - This file was originally written as a VAX/VMS HELP file. The program -dwcalc was part of the DWARF infrastructure which has been merged into Newstar. -This file has been taken over essentially as it was found. - - 8-oct-86 Ger van Diepen - JPH 940718 Update for Newstar - JPH 940918 Formatting for line-breaking algorithm - - -DWCALC -====== - -The program DWCALC is a handy desk-calculator, allowing the use of expressions -(with units), symbols and formulae. It is derived from the Dutch image -processing system DWARF. (Dwingeloo Westerbork Astronomical Reduction -Facility). - - The program is started by the command 'dwcalc'. Qualifiers can be used to -control the program. If they are given at the 'dwcalc' command-line, they -serve as a global qualifier. Global qualifiers can be overridden for each -individual expression-line by ending the line with the qualifiers, preceeded -by at least one space (to distinguish it from the division operator). - - The input expressions are read from stdin. The results are listed on stdout. -Optionally (part of) input and output can be logged. All input is converted to -uppercase, therefore input is NOT case-sensitive. - - -EXPRESSIONS -=========== - After having started the program, the program asks you for an expression. By -giving a null-answer the program will be stopped. Typing a question mark -starts a help session. Typing UNIT=? will show you the available units on -printer or terminal. - -Expressions have the normal arithmetical format, using +,-,*,/,** and -parentheses. Blanks and unary signs are allowed. However, note that / cannot -be preceeded by a blank to distinguish it from the qualifier-indicator. The -relational operators .NOT.,.EQ.,.NE.,.GT.,.GE.,.LE. and .LT. are also allowed. - Also available are: - some built-in functions (goniometric, etc.) - unit -specification and conversion - special format for time or positions (using -colons) - symbol definition and substitution - -Integer numbers can be specified in octal or hexadecimal format (use %O, %X, -resp.). - - -FUNCTIONS -========= - -The following functions (similar to Fortran) can be used in expressions: - - MIN MAX (1-10 arguments) - SIN COS TAN - ASIN ACOS ATAN ATAN2 - ABS EXP LOG LOG10 SQRT - TRUNC ROUND MOD SIGN - -Default unit for goniometric function is degrees, which can be overridden via -the /UNIT-qualifier or by giving the unit in the expression. - -The result of SIGN is: - -1 for negative values - 0 for zero - 1 for positive values - -Note that conversion to integer format implies rounding. - - -UNITS -===== - -CALCULATE is able of converting from one unit to another. It converts the -units given in the expression to the unit given by the /UNIT-qualifier. The -units must belong to the same group (so conversion from SEC to KM is -impossible). - -A unit can be given at several places: - - - after a number e.g. 10DEG - - after a subexpression e.g. (10+3)deg - - after a symbol e.g. PI RAD - - Note that in the last case the blank is significant, else it is optional. - - -TIME_POSITION -------------- - -Times and positions can be given in HH:MM:SS (or DD:MM:SS) format using colons -as separators. A unit may follow the value. Each part can be a floating number, -which may exceed 60. - -The output can also be listed in that format by giving /UNIT=HMS or /UNIT=DMS. - -This sexagesimal format allows for easy addition, subtraction and conversion -of times and positions. - - -SYMBOLS -======= - -Symbols are very useful for storing results and for handling formulae. Both -symbol substitution and definition is possible in DWCALC. DWCALC will always -define global symbols. It is also possible to use predefined local or global -symbols, either numeric or alphanumeric. - -By defining a formula as a symbol, it is very easy to calculate the result of -the formula for several values of its parameters. E.g. - - $ VOLUME = "4/3*pi*r**3" - $ CALC - Expression: r=3 - Expression: volume - Expression: r=10 - Expression: volume - - -DEFINITION ----------- - -A symbol can be defined by using the constructS: - - symbol_name = expression - symbol_name = "expression" - -In the first case the expression is evaluated and the result will be assigned -to the symbol. In the second case the expression-text is assigned to the -symbol, which is useful for defining formulae. - -Note that DCL uses the same procedure. - -SUBSTITUTION ------------- - -Symbols can be substituted in an expression by giving its name enclosed in -apostrophes or giving its name without apostrophes. - -In the former case its value is substituted literally. In the latter case its -value is treated as a subexpression. E.g. if I=3+4 then - - 3*'i' results in 3*3+4 = 13 and - 3*i results in 3*(3+4) = 21 - -Note that nested substitution is possible. Circular substitution is detected by -allowing a maximum of 25 substitutions. - - -Examples -======== - -Convert miles to kilometers - - $ dwcalc 10mile /unit=km - -If a whole series must be done it would be better to do: - - $ dwcalc/unit=km - 10mile - 8 mile - (1.25+3.48)mile - -Convert right ascension from HH:MM:SS to degrees. - - $ dwcalc/unit=deg 9:23:48.329 hms - -Convert a time to seconds - - $ dwcalc/unit=sec 9:23:48.329 hr - -Do some time calculation - - $ dwcalc/unit=hms 10:34:48 + 2::45 - :34:56.89 - -Calculate an expression and define the symbol ABC The result must be an integer - - $ dwcalc ABC = (2.34 * pi)+8*-cos(135+pi*28) /unit=deg - -Define a formula and calculate it for several parameters - - $ dwcalc - VOLUME = "4/3*PI*R**3" - R=2 - VOLUME - R=10 - VOLUME - -Convert from hexadecimal to decimal - - %x1a2f - -Convert from decimal to hexadecimal - - 2546 /rad=x - -/UNIT -===== - -This qualifier defines the default unit for the given values and the unit in -which the result will be expressed. In this way it can be used for converting -rom one unit to another. Note however that conversion between different groups -of units is not allowed (e.g. seconds to meters is illegal). - -From DCL the available units can be shown via the command PRTUNIT. From -CALCULATE they can be shown via UNIT=?. - -Default is no units. - - -/RADIX -====== - -This qualifier defines in which radix the output will be listed. Possible -values are: - - D decimal - O octal - X hexadecimal - -The default is D. O and X force TYPE=J if type is non-integer. - - -/TYPE -===== - -This qualifier defines in which format the output will be listed. Note that all -calculations are done in double precision and that the program tests on -integer overflow before conversion to an integer format. Possible values are: - - B signed byte - I signed word (integer*2) - J signed longword (integer*4) - L logical - R single precision (real*4) - D double precision (real*8) - -The default is D. - - -/STREAM -======= - -This qualifier is special to DWARF. It controls the stream of the application -symbols. The stream-name will be inserted in a symbol-name, if that symbol-name - has the format "image_keyword". - -Default is no stream. - - -/LIST -===== - -This qualifier controls if the results will be listed. Normally you will always -list the result, but in command-files it can be useful to negate this -qualifier (i.e. /NOLIST). - -Default is list. - - -/LOG -==== - -This qualifier controls if the expressions and results will be written in the -log-file CALCULATE.LOG (in the default directory). This log-file is written in -such a way that it can be executed as a DCL command-file or can be used as -input for the ARCHIVE-programs. This means that most lines will be flagged with -an exclamation mark (indicating comments), but symbol definitions are valid -commands, which can be executed. In this way users can calculate complex -expressions and define the results as symbols in a subprocess and execute the -log-file in the main process in order to obtain the results. - -Default is no logging. diff --git a/src/doc/txt/memos.txt b/src/doc/txt/memos.txt deleted file mode 100644 index 6fc76ebf4f0749ad7556c3bba1ad7c1bdc8c0983..0000000000000000000000000000000000000000 --- a/src/doc/txt/memos.txt +++ /dev/null @@ -1,145 +0,0 @@ -The NEWSTAR memo system ------------------------ - -This memo proposes a format for software memo series. -The vital element in this format is the Memo Header which gives -all vital information. The various header elements are described -with their possible values, - -The only implementation currently available is for Newstar memo's. Some -sample headers from this series are added. - - -1. Function of memo's ---------------------- - -The function of a memo series is to document a design process and to -offer a convenient place where notes of various kinds can be dumped. - -In order to achieve this, it is essential that the header of each note -clearly states what the purpose, subject and intended audience is. - -That way, it is sufficient to browse the headers of memo's in order -to find information relevant to a certain person or problem - - -2. Layout of memo headers -------------------------- - -A memo header consists of the following fields, some of which are -required, others are optional: - - * Name of memo series + index number [Required] - - In fact the name of the memo series is a first order - selection of the intended audience. - The serial number should be assigned on a central basis (preferably - some automated procedure) and runs incrementally from 1. - - * Subject [Required] - - The subject or description should be one line of highly descriptive - information. Since this line will show up in overview indices, - it has to contain sufficient information to identify the scope - of the memo. - - * Author [Required] - - This is just a textual identification. Preferably some database - with additional information on Memo authors should exist (including - up to date information on (eMail) addresses). - - * Date [Required] - - This should be the date of issue of the original memo, for - updates see the next section - - * Status [Optional] - - Possible values: Info Proposal Design - - More than one value may be given, the list of possible values - may be extended - - IF MISSING a status of Info should be assumed - - * Action [Optional] - - Possible values: Decision Read Feedback - Optional extension: "before <date>" - - The action should be taken before the specified date, if no date - is given this is NOT equivalent to "as soon as possible" (in that - case a specific date should be given) but to "not necessary" - - IF MISSING a status of Read should be assumed - - - * To [Required] - - The intended audience. This may be a specific name (e.g. Dr. P. Puk), - a generic name (WHISP Project Team) or The ... Memo Series - - * Summary [Required] - - The full header including the summary should not exeed a single - page. Since Memo's are intended to be brief, no more than the - summary will be required in many cases. - - * Replaces [Optional] - - Gives the numbers of the memo's that become obsolete by this one. - - * Update on [Optional] - - Gives the numbers of the memo's are updated by this one. - - -3. An example: the Newstar Memo Series --------------------------------------- - -The Newstar memo series is part of the hypertext network of Newstar -documentation. The header layout in current practice does not follow -the proposal in all details. - -The body of the memo can be in any form (WP, ASCII text, Hypertext, LaTeX). -In order enter the memo into the memo series, one enters the command - - ndoc memo new [file] - -This will assign a unique number to the memo and create an empty memo -header. You will be prompted for all header entries, and in addition -be asked for memo's, bug-reports and source files with which the memo -is concerned. These references appear as hypertext links in the on-line -version of the memo, and in normal text in the memo header. - -The specified file (which may be "none") will be moved into the directory -with memo headers. The final header page will be presented for editing, -together with the associated file. This is the time to fill in the summary -(which may be copied from the associated file). - -After completion, an index of all memo's will be automatically updated. - - -4. Updates on existing memo's ------------------------------ - -If a memo is updated, it is advised to enter the updates as a separate memo, -indicating the differences only. If a modified text is stored, users are -forced to read through the entire memo and the preceding version to find -the differences. - -Only if a memo has been changed substantially, so it is in fact better -to go through the whole text once more, a new memo can be created to -replace the original one. - -The header fields "Replaces" and "Update on" should be used to -indicate such cases. - -In the on-line implementation of the Newstar Memo Series, the headers -of the updated/replaced memo's are modified to reflect this information -as well. People keeping a paper copy can replace their header pages -with the updates. - - - diff --git a/src/doc/txt/models_and_maps.txt b/src/doc/txt/models_and_maps.txt deleted file mode 100644 index c4b4bd644dd816f2aa9185cd233dba4b269a8d14..0000000000000000000000000000000000000000 --- a/src/doc/txt/models_and_maps.txt +++ /dev/null @@ -1,89 +0,0 @@ -How to apply models when making maps ------------------------------------- - -1e. Models and scanfiles ------------------------- - -Models can exist in two places: - - 1e. As a list of model parameters in a Model (MDL) file - 2e. As a list of model parameters and complex uv-data points - in a Scan (SCN) file - -The model-list and the uv-model in a SCN file are always in accordance -with each other. - -Models are update in the SCN files after a respons to the MODEL_ACTION -prompt. MODEL_ACTION is in fact: "What model is actually going to be used -for processing and what model will finally end up in the SCN file?" - -The MODEL_ACTION question is asked in many cases: - 1e. After the NMODEL option SAVE has been choosen - 2e. After the NMAP option SUBTRACT has been choosen - 3e. After the NCALIB option REDUNDANCY has been choosen - 4e. After the NFLAG flagging operation ARESID has been choosen - -In all cases, the MODEL_ACTION is preceded by the MODEL_OPTION prompt. -This allows you to create a temporary model list in memory by reading -MDL files or by creating model components "by hand". The temporary model -list can be editied as well. - -The MODEL_ACTION determines what model is actually used in the -following processing AND what model is stored in the SCN file - - Used Stored -MERGE SCN ^ List SCN ^ List -ADD SCN + List SCN + List -NEW List List -TEMP List SCN -INCR SCN + List SCN - -SCN: Model currently present in the SCN file -List: Model currently in memory (constructed at MODEL_OPTION) - ^ Combination of two models, with common components occuring only - once in the final model - + Addition of the two models, components occuring in both models - are added as well, so they get the double amplitude - -Obviously, options MERGE and NEW will be most commonly used. - -Apart from this choice, MODEL_ACTION lets you decide how the model should -be calculated: should band smearing and time smearing be taken into account, -should instrumental polarisation be taken into account. - - -2. Subtracting models with NMAP -------------------------------- - -There are two ways to subtract a model from uv-data before a map is made: - - 1e. In NMAP, answer SUBTRACT=YES - - You will be asked for MODEL_OPTION to construct a temporary list, - and for MODEL_ACTION to determine what model is to be used. - - This way you cannot use just the model that is present in the SCN file. - - Also, you cannot use different models for different sets or different - SCN files (NMAP allows you to combine various SCN files, and to make - several maps based on several groups etc) - - - 2e. With NMAP, use DEAPPLY=MOD and SUBTRACT=NO - - The uv-model in the SCN file(s) will be subtracted from the uv-data - it corresponds to. The uv-model is considered a modification of the - visibilities corresponding to an empty sky. Deapplying this - modification thus corresponds to subtraction of the uv-model. - - This way, you can only use the model that is present in the SCN file. - This way, you can use different models for different groups in a SCN - file, and different models for different SCN files. - - However, you cannot add sources from another model, and you cannot - control the BAND/TIME/INPOL parameters (you should have done this when - you put the model in the SCN file). - -The same reasoning applies to NCALIB and NFLAG. - - diff --git a/src/doc/txt/more_on_batch.txt b/src/doc/txt/more_on_batch.txt deleted file mode 100644 index 306b40f416cb11255f2113d065c7b1bf84fe5801..0000000000000000000000000000000000000000 --- a/src/doc/txt/more_on_batch.txt +++ /dev/null @@ -1,230 +0,0 @@ -Fm: Marco de Vos (Newstar Project Team) -To: Ulrich Schwarz & Paul Stoppelenburg - -Subject: -Hints for batchprocessing with Newstar --------------------------------------- - - -A. Layout for a batch-script ----------------------------- - -Batch-scripts always have the follwing layout: - ->>>>>>>>>>>>>>>>>>> Example follows below this line >>>>>>>>>>> -#!/bin/csh -f -# -# Startup Newstar -# -source ~newstar/src/sys/newstar_rug.csh - -# -# Maybe some identification -# -echo "Name of the script: $0" # Prints the name of the file -echo "Purpose: ....." # Print the purpose of the file - -# -# Clear all symbols -# -dwc '*$ch0' - -# -# Define the symbols for this job -# -dws nmap\$ch0 /nomenu <<_EOD_ -OPTION=MAKE;QUIT ! The QUIT is for final exit -LOOPS="";# ! The # is in case we want to stop at the SCN_NODE prompt -SCN_NODE=obs2; ""/ask ! Just set the two defaults (/ASK) -SCN_SETS=0.0.0.0.0 -HA_RANGE= -90,90 -SELECT_IFRS= -mm,-ff;"" ! The second answer should be "" -... etc ... -# -_EOD_ - -# -# Start the program -# -dwe nmap\$ch0 - -# -# End -# -<<<<<<<<<<<<<<<< End of example <<<<<<<<<<<<<<<<<<<<<<<<<<<<<< - - -There may be many different dws and dwe commands in a single file. - -In stead of typing nmap\$0 you can also use 'nmap$0' . - - - - -B. Starting a batch-script --------------------------- - -To start such a batch script, just type it's name, eg: - - > nmap0.scr - -This may give a message like: nmap0.scr: Permission denied. - -In that case you sould first type: - - > chmod a+x nmap0.scr - -to change the mode ("protection") of the file such that All users -can eXecute it. You probably created the script from scratch with -an editor, so Unix treated it as an ordinary text file. - - - -C. Starting batch jobs in the background ----------------------------------------- - -To start a batch job in the background, leaving your terminal free -for other work, just type the following: - - > nmap0.scr >& output_file & - -All output that normally was shown on your screen will now end up in -the file named output_file (you can use any name you like). - -To check wether the job is finished you can try: - - > more output_file shows all of the "screen output" - > tail output_file shows the last 20 lines or so - > ps lws | grep nmap0.scr shows the status of the process (with - elapsed time etc.), no output means - the batch is finished - -There is a Newstar command which will execute a job in the background -and send the output to you by mail when it finishes. Just type: - - > nspawn nmap0.scr - -The "screen output" will end up in nmap0.scr.output. -The mail will be sent using elm with the command as subject. - -NOTA BENE: If you start a job in the background, all parameters should - be known in advance. So you should not use /ASK when specifying - parameters. - - - -D. How to set the keywords for a program ----------------------------------------- - -In a batch-script, you can set keywords in two different ways: - -1e. Use the dwspecify (dws) command: - -dws nmap\$ch0 /nomenu <<_EOD_ -OPTION=first_answer;second_answer;third_answer -SCN_NODE=TEST;"" -# -_EOD_ - -The sequence of the keywords is not relevant. -Each keyword should be set like: KEYWORD= value (not: nmap$ch0_keyword=value). -You can only specify the keywords for one program (and one stream). - -You can enter the KEYWORD=value lines by hand, or edit the output -from dwsave (remove the PROGRAM$Stream_ prefixes!) - -Alternatively you can extract keywords from a logfile: - - > grep '^>' NMAP.LOG | sed -e 's/^>//' > output_file - -If this seems an interesting option, I will create a Newstar command -for it (to save innocent Unix users all the '^>' things). - - -2e. Use the dwrestore command: - - -Typically, you will now do the following: - - > dwe ncalib\$ch0 /norun/save - > dwe nmap\$ch0 /norun/save - > dwsave nmap\$ch0 /output=nmap0.keys - -Now you may want to edit nmap0.keys, which contains lines like: - - NMAP$1_LOOPS=""";#" - NMAP$1_OPTION="MAKE;#" - NMAP$1_RUN="YES" - NMAP$1_SCN_NODE="""" - -In the batch script, you say: - -dwrestore nmap0.keys - - -3e. Combine the use of dws and dwrestore - - -Suppose we want to do a job repeatedly with the parameters saved above, -but with only SCN_SETS differing from command to command. We may then -combine dws and dwrestore as follows: - - -#!bin/csh -#!/bin/csh -f -# -# Startup Newstar -# -source ~newstar/src/sys/newstar_rug.csh - -# -# Maybe some identification -# -echo "Name of the script: $0" # Prints the name of the file -echo "Purpose: ....." # Print the purpose of the file - -# -# Clear all symbols -# -dwc '*' - -# -# Set up all "global" symbols for this job -# -dwrestore nmap0.keys - -# -# Start a loop over the sets -# -foreach set ( 0 1 3 4 ) - -# -# Define SCN_SETS for ncalib -# -dws ncalib\$ch0 /nomenu <<_EOD_ -SCN_SETS=0.0.$set -# -_EOD_ - -# -# Run ncalib for this set -# -dwe ncalib\$ch0 - -# -# Define SCN_SETS for nmap -# -dws nmap\$ch0 /nomenu <<_EOD_ -SCN_SETS=0.0.$set -# -_EOD_ - -# -# Run ncalib for this set -# -dwe nmap\$ch0 - -# -# Next set -# -end diff --git a/src/doc/txt/ncalib_vzero.txt b/src/doc/txt/ncalib_vzero.txt deleted file mode 100644 index d2b9347543be8855aea80f016bedc91690398e36..0000000000000000000000000000000000000000 --- a/src/doc/txt/ncalib_vzero.txt +++ /dev/null @@ -1,82 +0,0 @@ -The VZERO algorithm - JPH 960212 - -Summary -------- - Following a query by Jayaram Chengalur, this note provides an exegesis of W.N. Brouw's algorithm for determining the phase-zero-difference ('PZD') between the XX and YY interferometer subsets as implemeneted in the Newstar program NCALIB. The 180-degree ambiguity suggested by Chengalur appears indeed to exist; I suggest that a check could be implemented to insure selection of the proper value for the PZD. - ------------- - - -Brouw's algorithm ------------------ - I reproduce here the relevant lines of code from the program module NCAPVZ where the PZD is calculated: - - - 1 DO I1=0,STHJ(STH_NIFR_J)-1 !ALL IFRS - 2 IF (WGT(I1,1).GT.0 .AND. WGT(I1,2).GT.0 .AND. !XY/YX PRESENT - 3 1 ABS(DATC(I1,2)).NE.0) THEN !SOME POWER - 4 CF=1 !COEFFICIENT - 5 CW=-DATC(I1,2)*DATC(I1,1) !-YX.XY - 6 R0=ABS(CW) !WEIGHT - 7 IF (R0.NE.0) - 8 1 CALL WNMLMN(MAR,LSQ_C_COMPLEX,CF,R0, - 9 1 (DATC(I1,2)-CONJG(DATC(I1,1)))/SQRT(CW)) - . - solve - . - IF (ABS(CSOL).NE.0) THEN -10 XYDIF=ATAN2(AIMAG(CSOL),REAL(CSOL)) !GET ANGLE - ELSE - XYDIF=0 - END IF -11 CALL WNCTXT(F_TP,'A complex angle of !EC9.2\(!EC9.2) '// - 1 'or !EAR9.2 degrees', - 1 CSOL,CME,XYDIF) -C - - 1: Process all interferometers, I1 = interferometer index - 2: DATC = cpomplex visibility, WGT = weight; the first index is the - interferometer number, second index is 1 for XY, 2 for YX. Check - validity of data: if weight WGT equals 0, point has been deleted. - 3: This check seems to be redundant: If either XY or YX is 0, so will - be R0 in line 6 and consequently lines 8 and 9 will be skipped. - 5: CW = -XY.YX - 6: R0 = weight of this interferometer in the solution. - 7: If the weight is 0, bypass lines 8 and 9 including the division by - sqrt(CW). - 8: Accumulate sum of (XY-YX*)/sqrt(-XY.YX) with weights |XY.YX|. - 10: The result is a complex number, the weighted average of the - quantities of line 9 over all interferometers; its argument is the - phase difference we were after. - 11: The test displaying this result is a bit sloppy! - -So the quantity that is averaged (line 8) is - - P = sqrt(XY/YX) - sqrt(YX*/YX).sqrt(YX/XY) - - -Interpretation --------------- - - I suggest the following interpretation: - -We seek to minimise |V| by multiplying X with a factor a.e^(i.phi), so - - YX' = YX.a^2.e^(2i.phi) - -making - - P' = sqrt(XY/YX) - a.e^(i.phi).sqrt(YX/XY) - -Setting P' = 0 gives us - - a.e^(i.phi) = sum[sqrt(XY/YX)] / sum[sqrt(YX/XY)] - -The amplitude factor a should be 1 after XX and YY Selfcal, and could be used for a consistency check. NCALIB implicity displays its value by printing out a.e^(i.phi) as a 'complex angle', but otherwise ignores it. - - -The PZD ambiguity ------------------ - - The 180-degree ambiguity in the VZERO determination noted by Chengalur is represented in the algorithm above by the sign ambiguity of the sqrt() function. - - It seems to me that whatever algorithm one uses, there is probably no way to avoid the appearance in one form or another of a factor 2 on the unknown phase phi. This means that one must check afterwards in some way that the algorithm selected the right value; for a calibrator there should be enough flux in a single scan to do this straightaway. diff --git a/src/doc/txt/ngcalc_lightcurve.txt b/src/doc/txt/ngcalc_lightcurve.txt deleted file mode 100644 index a9e08acfe33de90ab86cf5f1616b96082ba049f6..0000000000000000000000000000000000000000 --- a/src/doc/txt/ngcalc_lightcurve.txt +++ /dev/null @@ -1,112 +0,0 @@ -I,Q,U,V,p,angle lightcurves using NEWSTAR program NGCALC - - -Ger de Bruyn 15-juni-1994 - -The program NGCALC can extract 1-dimensional (Visibility data versus -time/HA) data from a SCN-file. These can then be processed to yield -lightcurves of all Stokes parameters for a range of baselines. - -A 'typical' run would go as follows: - -1) exe ngcalc/ask - -The /ask qualifier is only required if you wish to subtract the STORED -selfcal MDL from the selfcal'ed visibility data. - -Input: - - the name of the NGF file you wish to create - - select option EXTRACT - - specify the name of the SCN-file - - select the SETS - - select the type of information you want to process (e.g. DATA) - - select the polarizations (specify XYX if you wish to form all - Stokes parameters) - - select the INTERFEROMETERS (e.g. FM) - -This is a slow program! It takes about 20 minutes CPU (on an HP710) -for the extraction of 12 hours of data (720 scans of 1 minute) on 40 -baselines on one frequncy channel for each of the four XX,XY,YX,YY -correlations. This then creates 40x4 files or 'plots' as they are called in -the program. - -These plots will have a six-digit number containing information on the -baselines, polarizations and frequency channel. - -2) Use the option MERGE to merge different HA-sections - -If the 12 hour observations was cut into more than one part, each -HA-sector will get a separate file. You can then merge these two or -more HA-slots into one file, where the appropriate HA information is -preserved. - -You can use a double-loop here. One loop might run over polarization -and one loop over baselines; e.g. 4,...1, 69,....1 if you had -XX,XY,YX,YY and baselines from 9A (a 0 in the fifth digit) through 0D -(a 68 in the fifth digit) - - -3) Use option CALC, SHIFT to shift the visibilities to the source you -wish to study - -Use the position (l,m in arcseconds) as given in your MODEL. You may -(have to) use a loop again. - - -4) Use the option MERGE to average all baselines you wish to use - -After the shift operation the source should be in the phase centre. This -means that the source signal is contained in the COS part of the visibility. -You can check, using the plotting facilities, whether indeed the SIN signal -is consistent with noise around zero. - -You may wish to loop here over the fourth, polarization, index (e.g. -4,...1) - - -5) Use the COMBINE option to form Stokes I,Q,U and V - -Examples: -Q = (#0-#1)/2, where #0 is the YY file and #1 is the XX file. -V = -0.5*imul(#0+#1) where #0 is the XY file and #1 is the YX file - - -6) If required, smooth the data using option CALC, SMOOTH - - -7) You can use the PLOT option at the various stages to see whether the -results look as 'expected' - -8) Use option MON to dump the interesting files in an ASCII file for -further processing with SUPERMONGO. The mongo file will contain as its first -column the HA. - - - ------------------------------------------------------------ -N.B. There are a number of things to watch out for when using NGCALC - -1) Files can be addressed with the full six-digit index or with a # whichever -you find more convenient. Note, however, that when using the #'s you can -NOT use loops. - -2) There is some logic to the index numbering system but it takes a while to -get use to it. - -3) When trying to form the polarization angle 0.5*atan(U/Q) you run into -the problem that this angle as calculated will be within the range -45 to -+45 degrees, while of course the true polarization angle is defined -within boundaries -90 and +90 degrees - -4) Unfortunately, the delete option does not yet work. If you have made a -new file with erroneous specifications you would ideally like to -throw it away because you might forget that it is unusable. - -5) When using the loop system all the plotfiles that will be -tried in the looping must be present. - -E.g. if you have 40 FM baselines in the NGF file they are numbered 0,2,8,9,....68 -with some numbers not occurring (This number is the order in which the -baselines exist in the SCN file). Hence, if you wish to loop over baselines -then you could say 69,....1 but then the program will stop after it has -done the first baseline, because baseline ....1 does not exist. diff --git a/src/doc/txt/obscure_bugs.txt b/src/doc/txt/obscure_bugs.txt deleted file mode 100644 index fb821540ca2edceb402d15d0710bc909b43d15f9..0000000000000000000000000000000000000000 --- a/src/doc/txt/obscure_bugs.txt +++ /dev/null @@ -1,26 +0,0 @@ -obscure_bugs.txt - -A collection of obscure Newstar bugs and their antidotes --------------------------------------------------------- - - Like any system its size, Newstar is sensitive to programming errors -that are eaily made. Some of these may result in very obscure behaviour that -may be difficult to diagnose. This document is meant to formalise our -collective knowledge in this area. Anyone who solves a problem of this type is -invited to record his experience here so others after him may benefit from it. - - -Symptom: When exiting, the program emits a series of messages -------- - mv: <file name> is identical to <filename> - -Cause: The first argument in a WNCTXT call should be a bitmask (normally F_T or -F_TP). Omitting it or putting something else in its place may cause this type -of behaviour. -(JPH 940909) - - -Symptom: Program crashes with IOT 6 (?) -------- -Cause: Division by 0 (and probably other arithmetic exceptions) -(JPH 940909) diff --git a/src/doc/txt/ppd_buffer.txt b/src/doc/txt/ppd_buffer.txt deleted file mode 100644 index 0911b64813ab5d032c5abddabed43bc105256ca7..0000000000000000000000000000000000000000 --- a/src/doc/txt/ppd_buffer.txt +++ /dev/null @@ -1,41 +0,0 @@ -Aanpassen van de grootte van de ppd help-text buffer ----------------------------------------------------- - -(bijdrage van H.J. Vosmeijer/J.P. Hamaker, 940829) - - -Als het compileren van een .pin/.psc/.pef file stuk loopt op een te kleine -werk-buffer in sys_bldppd, moeten zowel deze buffer als een daarmee -corresponderende buffer in de Newstar executables worden vergroot. Dit veresit -de volgende wijzigingen in files in $n_src/dwarf, gevolgd door een gepaste -reeks 'nsh build's - - -Om de werk-buffer in cpl_2.def te vergroten moet het volgende -gebeuren (b.v. van 5000 naar 10000 bytes): - -In cpl_2.def: - 1. verander 5000 in 10000 in parameter (cpl__wrklmax = 5000) - - 2. verander 5000 in 10000 in parameter (cpl_wrkbuf = 421) !&5000 !#C - - 3. hoog alle adressen op met 5000 (=(nieuw-oud)=(10000-5000)) voor de - variabelen die NA CPL_WRKBUF en VOOR CPL__LENGTH komen. - Dit zijn dus de waarden na het = teken) - - 4. pas CPL__LENGTH aan (=(CPL_ERRNTOT+3)/4) - - 5. verander 5000 in 10000 in CHARACTER*5000 CPL$WRKBUF - - 6. hoog alle waarden op met 5000 (=(nieuw-oud)=(10000-5000)) voor de - variabelen die NA CPL$WRKBUF komen. - -In onderstaande files in genoemde regels 5000 in 10000 veranderen: - cplblock.for: CHARACTER*5000 CPL$WRKBUF - cplread.for: CHARACTER KEYWORD*80, VALUE*5000 - bpdbuild.for: CHARACTER VALUE*5000 - bpdstore.for: CHARACTER STRING*5000, NAME*16 - ppdhelp.fsc: CHARACTER WORK*5000, WORK2*80, LINE*80 - ppdprompt.for: CHARACTER WORK*5000, PROGSTRM*80, KEYWORD*16 - - diff --git a/src/doc/txt/psc_guide.txt b/src/doc/txt/psc_guide.txt deleted file mode 100644 index 9d668a575afe8627f4f00a0aa5d635dc29f62484..0000000000000000000000000000000000000000 --- a/src/doc/txt/psc_guide.txt +++ /dev/null @@ -1,360 +0,0 @@ -Style guide for parameter definition files ------------------------------------------- - -History: - 941110 contributed by JPH - 941117 Style recommendation 7. - 941212 Revise the latter following changes in cplvallist.for, ppdopstr.for. - - -Summary -======= - - This document contains guidelines for writing .psc/.pef parameter -definition files. A few implementation notes are added as an Appendix. The -following subjects are addressed: - - a. Definition of parameter properties - - b. Definition of default values - - c. Prompt formatting - - d. Insertion of hypertext references - - -Related documents -================= - - The reader is assumed to have some knowledge of LaTeX and the way it is -used for Newstar documentation. The latter is described in the Newstar document -"Guide for writing and maintaining Newstar documents". - - -Definition of parameter properties -================================== - - A large number of properties can be defined for each parameter. I -discuss only a few. - - - ATTRIBUTES=<attr>[,<attr>]... - - . LOOP: WNDPAR returns the special status DWC_ENDOFLOOP when no more -parameter values are available. The calling program may detect this status as a -signal for some special action. When LOOP is not specified, the value(s) -specified is/are simply re-used. - - . NULL_VALUES: It is allowed to enter 0 values, either by default or -by the user. A null value is represented by an empty string: "". For a null -reply, WNDPAR returns <number of values>=0. - - . WILD_CARDS: A wildcard, *, is allowed as default or reply. For a -wildcard, WNDPAR returns <number of values>=-1. - -In a proper implementation, the latter two attributes should be defined only -where appropriate. In Newstar, they are declared almost everywhere and -consequently programs must make special checks in many places for illegitimate -null and wildcard values. - - This situation is clearly unsatisfactory, but systematic rectification -is not worth the effort and risk of mistakes. Some efforts in this direction -have been made but are being discontinued. - - -Definition of parameter defaults -================================ - - Defaults in a prompt can be defined in a number of ways. The DWARF -design postulated that the interface presented to the user should be defined as -much as possible in the .psc file; the - - - DEFAULTS=<values> - -clause in a keyword description serves this purpose. As an alternative, dynamic -defaulting can be used. - - Newstar largely ignores this philosophy, by defining most defaults -through the dynamic mechanism, even when the value is a constant. In some cases -both .psc and dynamic defaults are provided, - in which case the latter will -take precedence. - - This situation is clearly unsatisfactory, but systematic rectification -is not worth the effort and risk of mistakes. Some efforts in this direction -have been made but are being discontinued. - - -Prompt and options string formatting -==================================== - - A Newstar prompt is composed of - - <keyword> - - <prompt text> - (<options list>) - =<default>: - -The complete prompt is concatenated from these components and then formatted -into one or more lines on the terminal. - - As of november 1994, the formatting routine has been modified to allow -the programmer more control over the form in which the prompt is displayed, -through the use of some special punctuation: - - - The prompt string may be terminated in a '|' to put the options -string on a new line. - - - The options string may contain the characters ' ,;|/[]' to format it: - - . The '|' can be used to split the string over multiple lines; when -appended at the and of the list, it signals that the <default> must be put on a -new line of its own. - - . ';' and ' ' can be used to group options in functionally related -subsets; - - . '/' can be used to group options that are alternatives, e.g. -BAND/NOBAND. - - . '[]' can be used to indicate options that one would only use in -exceptional situations; - - . '(:)' can be used to insert comments (this may not work, it has not -been tested). - - -Long and short lines --------------------- - - Within Newstar a need exists for text files to be formatted as one line -per full paragraph in some application, and in other uses for the same files to -be formatted in lines that fit a terminal screen. The conversions can be made -automatically, provided a few guidelines are heeded: See item 7 of the Style -Recommendations below. - - -Style recommendations ---------------------- - - 1. The '|' character will signal a line break and therefore cannot be -used otherwise (e.g. as an 'OR' symbol). - - 2. If the prompt, options, and default strings combined leave enough -room for a reply on the same line, donot insert any newlines. - - 3. If the options string must be divided over more than one line, then -put the entire options string on lines of its own (i.e. terminate both the -prompt and options strings in a '|'); - - 4. Use blanks and semicolons to visually group the options, and use the -same grouping in the help text. Insert newlines only between groups, and put a -semicolon before such a newline. - - 5. Remember that the options string will be shown enclosed in -parentheses. Therefore donot terminate it in a semicolon. (If it ends in a '|', -that character will be shifted behind the closing parenthesis.) - - 6. Format the OPTION string in the way you want it to appear in the -prompt, remembering that the prompting routine will indent each new line by 4 -blanks: (So donot insert additional blanks in your .psc file!) - - OPTIONS=- -QUIT; COPY,CCOPY,LINE; ZERO,MANUAL,INIT,RENORM;| - -EXT,REF, IREF,FAR, IFR,MIFR, SHIFT,CLK; DX,DY,DZ, POLE,FREQ - - 7. Make sure the product of the number of options and the LENGTH for -character parameters is less than 512. (All options are extended by CPL_VALLIST -to LENGTH characters and concatenated in a local buffer defined by -PPD_OPSTR_PUT.) - - 8. Newstar's automatic line-formatting mechanism may concatenate -consecutive short lines into a longer one. It does, however, avoid improper -joining of lines by assuming that the following input line types either start a -new output line or terminate the current output line or both: - - - a line starting in whitespace, '-' or a '!' comment character: new - output line; - - - a blank line or a line consisting of a '.' only: copy literally; - - - a line containing an in-line comment or a double quote: terminate - output line. - -Similarly, a line ending in a hyphen (the DWARF 'to be continued' mark) -terminates the current output. - - - -TaTeX/Hypertext conversion of the Help texts -============================================ - - The command 'ndoc Key' translates the files - - <xxx>.psc resp. <xxx>.pef - -into LaTeX files - - $n_doc/intfc/<xxx>_private_intfc.tef - resp. $n_doc/intfc/<xxx>_public_intfc.tef - -It subsequently calls ndoc Cook to process a corresponding .tex file to produce -the hypertext document. - - (NOTE: This is a change w.r.t. the previous situation, in which only -the hypertext translation was available, consisting of one separate small .html -file per keyword. The logistics for the _intfc.tex/tef files is now entirely -identical to that for the other .tex documents, which is advantageous in many -ways.) - - -Cross references ----------------- - - To fully exploit the symmetry between LaTeX sources and the .tef files -provision is made for cross-references in the latter. These take the form of -LaTeX \textref commands on comment lines in the .psc/.pef file, e.g. - - ! {\em see also the}\textref{DWARF}{<file name>} interface description} - -Conversely, references to Help texts can be made both from other Help texts and -LaTeX documents. For this purpose, ndoc Key generates a label for each help -text: - - keyword <XXX>_<YYY>_<ZZZ> --> label .<xxx>.<yyy>.<zzz> - - -Appendix: Prompt formatting -=========================== - - The DWARF susbsytem of NEWSTAR is responsible for displaying prompt -information on the terminal and checking the user's reply. As inherited, the -formatting of the prompts was very clumsy, making them difficult to read, -particularly in those frequent cases where a large number of options must be -chosen from. - - It has proved possible by some very simple changes to give the maker of -the .psc file, - that defines the prompt and options strings -, a great deal of -control over the way a prompt is formatted. This is made possible by the fact -that - - a. Prompt and options strings are copied litterally from the .psc file -to the binary .ppd file that an executable program reads. - - b. Parsing of the options string relies on a string parameter that -defines which characters delimit inidividual options in the options string. By -extending the former string we may allow other characters than ',' to be used -as delimiters. - - c. The prompt is composed by essentially a simple concatenation of the -prompt, options and default strings and then breaking it into lines for output -on the terminal. It is easy to change the line-breaking algorithm to break -lines at a predefined delimiter character; the vertical bar '|' was chosen for -this purpose. - - It has later been found that there are other DWARF routines that assume -that a comma is the only delimiter, such as CPL_VALLIST. These seem to work -correctly, provided only that the parameter's LENGTH is defined large enough -(cf. Style recommendation number 7 above.). This can be safely done since this -attribute is only used to allocate buffer space. - - -Implementation in the prompt and reply paths --------------------------------------------- - - A schematic of the prompt and reply paths is shown in the following -diagram: - -|GP_INP -| calls GP_INP_GET -| -| GP_INP_GET -| | calls PPD_PROMPT -| | -| | PPD_PROMPT -| | calls PPD_PRSTR_GET to get <prompt string> -| | calls PPD_OPSTR_GET to get <options string> -| | returns with -| | PROMPT = <prompt string> (<options string> )' -| | appends '=<default string>' to PROMPT -| | calls DWC_INPUT with PROMPT -| | -| | |DWC_INPUT -| | | calls GEN_INPUT -| | | -| | | |GEN_INPUT -| | | | formats prompt and outputs line by line - prompt -****************************************************************************** - reply - - prompt -****************************************************************************** - reply -| | | | reads answer -| | | | detects DWC_EOFCTRLZ -| | | | returns -| | | -| | | returns -| | -| | does some checks on ANSWER -| | reprompts for some errors -| -| calls GP_INP_PARSE -| ... -| calls GP_INP_DECODE -| -| GP_INP_DECODE -| | calls PV_BLK_DECODE -| | calls PPD_CHECK -| | -| | PPD_CDHECK -| | | if options defined: -| | | calls PPD_OPSTR_MATCH -| | | -| | | PPD_OPSTR_MATCH -| | | | calls STR_MATCH_L -| | | | -| | | | STR_MATCH_L -| | | | | returns <match number> -| | | | -| | | | loop <match number> times -| | | | calls STR_SKIP_U (DELIM=',;|[]',...) -| | | | -| | | | STR_SKIP_U -| | | | | skips up to character in argt DELIM -| | | | -| | | | end loop -| | | | calls STR_SKIP_W -| | | | -| | | | STR_SKIP_W -| | | | | skips whitespace -| | | | -| | | | calls STR_COPY_U (DELIM='.;|[]',...) -| | | | -| | | | STR_COPY_U -| | | | | copies up to character in argt DELIM -| | | | -| | | |returns full OPTION -| | | -| | |end if -| | |... -| | -| |... -| |... - - - In the prompt path GP_INP_GET and PPD_PROMPT concatenate the keyword, -prompt, options and default strings in string PROMPT. These strings are taken -litterally from the .PPD file or WNDPOH without any processing except for the -insertion of a few punctuation marks to delineate the four components. All -punctuation marks in the strings are preserved. - - GEN_INPUT formats PROMPT into lines for the terminal. It interprets one -or more vertical bars '|' as a newline and does not autonomously generate any -additional newlines. Any lines after the first are indented by 4 spaces; apart -from this, the formatting is entirely controlled by the bar characters in the -strings as defined in the .psc file. No checks are made on the lengths of the -lines being output. - - The reply path uses the options string to check the reply and must -therefore recognise all punctuation characters. This is realised extremely -simply by including them in the DELIM argument so STR_SKIP_U and STR_COPY_U diff --git a/src/doc/txt/psctest.txt b/src/doc/txt/psctest.txt deleted file mode 100644 index 3f5ad6b78d3f9c12bbc1a7c587ef3d6ecad921f6..0000000000000000000000000000000000000000 --- a/src/doc/txt/psctest.txt +++ /dev/null @@ -1,82 +0,0 @@ - - -psctest.csh -=========== - - Options to: - - - Create a .pst file by running program under manual control. - - - Create reference numbers on the parameter lines. - - - Run program under control of a .pst file: - = Including backtrack paths - = Including on-line help requests at first appearance of each - parameter. - = Using only a certain range of parameter lines - = In /ASK mode including hidden parameters - - - -.pst file -========= - - Consists of: - - - Preamble: a csh script, ending in the line 'exit'. This script is -executed by psctest.csh to set up initial conditions (i.e. verify accessibility -of input files, remove left-over output files etc.). - - - Parameter input: Lines of the form - - <blanks>[*]<blanks><KEYWORD> = <value> ! <number> - -The lines are indented corresponding to the 'level' of the parameter in its -local context. The asterix is positioned at the level of a preceding parameter -that is the target for a backtrack request. - - - Comment lines starting in a '!'. - - - The simplest way to generate an initial .pst file is through - - psctest -m <program> - -The file may then be manually edited to e.g. - - - insert the initialising script; - - - remove spurious parts (e.g. backtracks accidentally made in the manual - run); - - - change improper backtrack targets to what they should be (Of course, - corresponding changes must be made in the program code!). - -After a change in the parameter lines, they may be renumbered through - - psctest -n. - - -Special cases -============= - -Unconditional backtracking --------------------------- - - To be realised by listing the parameters through which the backtrack is -made with '#' input, at the proper indentation (i.e. indents for a backtrack -chain decrease downward). Do not include '*' backtrack marks! - - -Repetition loop ---------------- - - Occurs e.g. in NSCAN LOAD, NMAP MAKE. Append indices in [] to the -parameter name to show the cycle number. Continue increasing indentation -throughout the loop. - - -Hidden parameters ------------------ - - To be indented at the same level as the subsequent visible parameter. diff --git a/src/doc/txt/qube.txt b/src/doc/txt/qube.txt deleted file mode 100644 index e6a427d215fc65e17dc4fbc9c28d5cde7e878d25..0000000000000000000000000000000000000000 --- a/src/doc/txt/qube.txt +++ /dev/null @@ -1,226 +0,0 @@ -QUBES: Software to make SCN-file UV-data available in various sort orders -------------------------------------------------------------------------- -History: - Contributed by WNB, 940810 - WNB 940812: add interferometer errors - - -Summary (JPH 940810) - - This note documents software created by WNB during his 1994 visit at NFRA as infrastructure for the program NFILTER.) - - -1. Introduction - -To be able to read a one-directional data vector from the Scan data in -any of the possible coordinate direction, a number of NSCQ.. routines -are available, replacing in essence NSCSCR and NMOMU4 and their -initialisers. -The possible directions are: frequency(f), ha(t), interferometer(i). No -possibilty to go in the direction of Mosaic fields has been built in, -mainly because different mosaic fields have no identical ha's: the -4-dimensional structure (mosaic,f,t,i) is not a regular hypercube. -The structure chosen assumes that the dataset to be considered -consists of a series of 3-d cubes (f,t,i) at different mosaic points. -In principle extension to a series of (mosaic,f,i) cubes at different -ha's would be feasable. -A field in the above is a set of observations at the same position on -the sky, with identical (number of) frequencies, interferometers and -hour angles. Note: the actual check on the number of hour angles is -not extensive, to limit the sorting problems, but with actual WSRT -observations this should not be a problem. -An example of the actual use is given in NFIUVL.for, which at the -moment is a simple test program, not an actual UVLIN. - -2. Routines - -To write a program using the NSCQ routines, the basic structure of the -program is identical to programs using NSCSCR, i.e. scans in the -i-direction. The user parameters used by the NSCQ routines are the -same: Node, Sets and, possibly, Loops. Other selection parameters can -be used in the same way as in other programs, and model data has to be -initialised in the same way as well (i.e. NMODAX, NMOMUI and NMOMSC/L -have to be used before the actual data loops can start). - - -To set the field a (short) description of the standard program -structure as it is now (*=optional): - -while WNDXLN do all specified loops(*) - NMOMSL calculate scan model(*) - while NSCSTL do all sectors - NSCSIF get interferometer table(*) - NSCMBL get baseline table(*) - NCARRT get redundant baseline(*) - NMORDH get model parameters(*) - NMOMST calculate some model parameters(*) - for i=ha-range go through (selected) ha scans - NSCSCR get corrected scan data - NMOMUV calculate UV coordinates for scan (*) - NMOMU4 calculate model for scan(*) - action including e.g. NSCSWI - end - end -end - -The structure to go through data in different order is comparable: - -while WNDXLN do all specified loops(*) - NMOMSL calculate scan model(*) - NSCQOP prepare SETs for reading - while NSCQFN get next field in 4-d structure (and - coordinate tables) and select - coordinate order - NSCMBL get baseline table(*) - NCARRT get redundant baselines (*) - - for i=first selected coordinate - for j=second selected coordinate - NSCQSR read selected (pseudo-)scan along 3rd coord - and model, if selected in QFN - action including e.g. NSCQWA/M - end - end - end - NSCQCL close Qube control area -end - -routines to calculate e.g. UV-coordinates etc for the pseudo scans are -easily added if necessary. - - -3. Description interface - - -- NSCQOP_L( QUA_J:O, Qube control area ptr - FCA_J:I, (Scan) file control area - SETS_J(0:SOF__N-1,0:*):I, SETs selected by user - LPOFF_J(0:SOF__N-1) Current Loop offsets - INFO_J(QINFO__L:QINFO__H):O Info about 4-d qube - ) - -QOP analyses the SETs (using also the loop info (LPOFF) and Scan file -(FCA), and makes a sorted list of all Sector pointers. It also -reserves buffers for later use. -The QUA is a pointer to the control area to be used in all subsequent -Q calls. -The INFO array returns the following information (parameters in -CBITS_DEF): - INFO(QINFO_FLD) number of different fields - INFO(QINFO_F) max. number of frequencies found in all fields - INFO(QINFO_T) max. # ha - INFO(QINFO_I) max. # ifrs - -Note: the system works fastest if field selection is done by the Loop -structure. - - -- NSCQCL_L( QUA_J:IO, Qube control area ptr - FCA_J:I, Scan file control area - SETS_J(0:SOF__N-1,0:*):I SETs selected by user - ) - -QCL frees all the buffers and temporary files used - - -- NSCQFN_L( QUA_J:I, Qube control area ptr - FCA_J:I, Scan file control area - ORDER_J:I, Order of data reading - STH_B(0:STH__L-1):O, A Sector header - INFO_J(QINFO__L:QINFO__H):O, Info about 4-d qube - PINFO_J(QINFO__L:QINFO__H):O Pointer to Info about 4-d qube - ) - -QFN selects the next field for processing (or is .false. if no more). -It uses the QUA and FCA, and the ORDER specified. The ORDER can be: - QUB_FTI [+QUB_M] [+QUB_OUT] - TFI - TIF - ITF - FIT - IFT -The ..I uses no sorting file, the I.. may use a large sorting file. -The coding is: I=interferometer, F=frequency, T=ha. The last code -specifies the direction of the 'scan' produced (i.e. FTI is the -'normal' order, TIF produces a scan along the frequency axis); the 1st -code specifies the highest loop direction the user wants to use. Note: -you can loop in a different order than specified, but this will be -rather inefficient in general. -The _M modifier (e.g. QUB_TIF+QUB_M) will in addition to the data also -generate the model data in the same 'scan' direction. -The _OUT modifier will prepare and enable the writing of -interferometer errors. - -The STH returned is one of the STHs of the field. I.e., the -coordinates, number of interferometers etc will be correct, but time, -frequency, ha and data depended on these will be random. It can, -however, be used in routines like NSCMBL. - -The INFO returned is identical to that for QOP, but now the actual -field number(1..), and axis lengths for this field are returned. - -The PINFO (at QINFO_T, QINFO_I, QINFO_F) returns pointers to tables -with the actual coordinates along the axes. These values can be -addressed as: - A_I(PINFO(QINFO_I)+n_i) interferometer codes - A_E(PINFO(QINFO_T)+n_t) ha values - A_D(PINFO(QINFO_F)+n_f) frequencies -with n=0,INFO(QINFO_x)-1 - - -- NSCQFR_L( QUA_J:I, Qube control area ptr - FCA_J:I Scan file control area - ) - -QFR resets the field search to the start of the field list - - -- NSCQSR_L( QUA_J:I, Qube control area ptr - FCA_J:I, Scan file area - AX1_J:I, 1st axis to read - AX2_J:I, 2nd axis to read - CAP_J:I, apply bits - CDAP_J:I, de-apply bits - PWGT_J:O, pointer to scan weights - PDAT_J:O, pointer to scan data - PMOD_J:O, pointer to scan model - POUT_J:O, pointer to area to put - ifr errors - ) - -QSR reads a (pseudo-)scan along the 3rd axis selected in QFN at the -position specified by AX1 and AX2 (axis types determined in QFN). I.e. -with QUB_TIF and AX1,AX2=300,2 a frequency scan will be produced for -the second interferometer in the interferometer table at the 300th ha -point (values for the axes can be 0..INFO(corresponding)-1). - -The data is returned by a pointer to an array. These arrays have -dimensions (0:3,0:length scan-1). Note: the index order is different -from that returned by NSCSCR and NMOCIX, for obvious reasons. -If n_p is the polarisation (0..3) wanted and n_d the data point -(0..INFO()-1),the data can be accessed by: - A_E(PWGT+4*n_d+n_p) - A_X(PDAT+4*n_d+n_p) - A_X(PMOD+4*n_d+n_p) -Interferometer error data (if QUB_OUT included in QFN) can be put into -the array pointed to by POUT, and accessed by: - A_X(POUT+4*n_d+n_p) - -Note: the PMOD has only a valid value if QUB_M was used in QFN -Note: the model data are already converted to XYX format - - -- NSCQWA_L( QUA_J:I, Qube control area ptr - NSCQWM_L FCA_J:I, Scan file area - AX1_J:I, 1st axis to write - AX2_J:I, 2nd axis to write - CAP_J:I, apply bits - CDAP_J:I de-apply bits - ) - -QWA will write the additive interferometer errors set (in pseudo-scan -order in the array POUT obtained from QSR) to the scan data file. -QWM the multiplicative interferometer errors. - - -wnb/940812 diff --git a/src/doc/txt/remote_tape.txt b/src/doc/txt/remote_tape.txt deleted file mode 100644 index 3956a7be5403d63f87c9d40047b662518ed70a31..0000000000000000000000000000000000000000 --- a/src/doc/txt/remote_tape.txt +++ /dev/null @@ -1,66 +0,0 @@ - -Transparent reading of the Optical Disks with Newstar ------------------------------------------------------ - -It is now possible to access the optical disk units that are -connected to the VAX while working on a Unix machine. - -In Dwingeloo, the following tape-devices have been defined: - - MAG4 //rzmvx4.astron.nl:1100/RZMVX4$MUA0 - MAG5 //rzmvx4.astron.nl:1101/RZMVX4$MUA1 - -These devives allow you to read data from the units MUA0 and MUA1 -as if they were connected to your Unix machine. - -If you work on e.g. rzmws10 and you want to get data from MUA0, -just run NSCAN and specify unit 4. - - -Note 1: Implementation - - Transparent reading is implemented by a server on the VAX and - an extension of the tape-handling routines in Newstar. - The server on the VAX is USER5:[DEVOSCM.RMTD]RMTD.EXE - The server has to be started on two ports, this can be done - by including in the system-startup: - - @user5:[devoscm.rmtd]rmtd_start.com - - which will submit two jobs on RZMVX4_BATCH. - - The names of the remote units have been defined in the startup file - $n_src/sys/newstar_nfra.csh - - The routines changed for the implementation are $n_src/wng/wnftrw.cun - and $n_src/wng/wnf???_x.cun. The code for the client side of the - network is in wnftrw.cun. The changes in the other files are: (1) all - calls to open, close, read and write now go through a routine in - wnftrw.cun and (2) all calls to routines wnftrw pass the MCA (not FCA) - -Note 2: Suggested testing - - To test the reliability of the transparent tape-reading I suggest - the following. During the next week, all files read from Optical Disk - by the Reduction Group are read two times and then compared - - 1e. Unix: NSCAN LOAD UNIT=4 or 5 - - 2e. VAX: NSCAN LOAD UNIT=4 or 5 - Unix: ftp SCN-file - NSCAN CVX - - 3e. Unix: ~devoscm/tst.csh File1.SCN File2.SCN - - If the files have been loaded identically, no differences should appear. - The tst.csh procedure ignores differences of 1 unit in the data, since - they can be produced by rounding errors during the time-averaging. - - Any differences should be reported to Marco de Vos. - - After testing some 10 SCN files, we are sure that no systematic errors - take place. The remaining test is on reliability of the connection over - a longer period. This can be tested by using only the Unix version of - Newstar to read data from the archive. After a month, we will have a - good impression of the reliability. - diff --git a/src/doc/txt/spefu_type_categ.txt b/src/doc/txt/spefu_type_categ.txt deleted file mode 100644 index 6c32b3447afb2353a2a4b13530a14f0863b1a434..0000000000000000000000000000000000000000 --- a/src/doc/txt/spefu_type_categ.txt +++ /dev/null @@ -1,65 +0,0 @@ -List of codes in the OHW-fields SPEFU, TYPE, CATEG --------------------------------------------------- - (original Dutch source unknown, - translated litterally into English by JPH, 940621) - -History: - JPH 940914 Format corrections - - - The OH (Observation Header) of an observation file on a WSRT tape is -copied literally into a OHW block asspociated with one or more Sectors in a -.SCN file. It contains several fields describing the natiure of the -observation. The meaning of the ASCII that may occur in these fields is -tabulated below. - - SPEFU= Meaning - ------ ------- - PT Pointing observation - HO Holog observation - OF Offset observation - VL VLBI observation - MO Mosaiking observation - PD Pulsar observation (DCB) - DF Delay offset observation (DCB) - LO LO sweep observation - FS FS frequency switching observation - SD Switched dipole observation - NO No special observation - - - - - TYPE - 1st char Meaning 2nd char Meaning - -------- ------- -------- ------- - C Other A Supplememt to N,M,P or F - F Frequency switch. B Baseline (for C) - M Mosaicking C Gain/phase (for C) - N Norm. astr. D Dipole switch (for C) - P Pulsar E Extinction (for C) - V VLBI F Phase only (for C) - G Gain only (for C) - H Holog (for C) - L LO-delay (for C) - M Monitoring (for N) - N New (for N,M,P of F) - O Redo (for N,M,P of F) - P Parallax (for N of C) - Q Offset (for C) - R Pointing (for C) - S System temp. (for C) - T General Test (for C) - U Universal (for C) - V Videoband (for C) - W Delay (for C) - - - - CATEG= Meaning - ------ ------- - I Instrumental, including all calibrations - N Astronomy: Nearby galaxies - S Astronomy: Solar System - G Astronomy: Galactic Object - E Galactic astronomy not covered by N diff --git a/src/doc/txt/wndpoh.txt b/src/doc/txt/wndpoh.txt deleted file mode 100644 index 86995310d08edde2b6d58312f30e6e85dbd36add..0000000000000000000000000000000000000000 --- a/src/doc/txt/wndpoh.txt +++ /dev/null @@ -1,173 +0,0 @@ -Dynamic tailoring of the Newstar program-parameter interface ------------------------------------------------------------- - -Contributed by Johan Hamaker, 940916 - - -Statement of the problem -======================== - - The DWARF parameter interface and the way it is harnessed in the -Newstar programs is plagued by several problems that confuse the user: - - - many keywords are used in multiple places serving multiple, often -quite different, functions ("keyword overloading"); - - - since DWARF allows only static definitions of keyword prompt, options -and help text, the information provided to the user in a prompt is either too -generic (in order to cover all functions for which the keyword is used) or -confusing (when a keyword is re-used in a context that differs from the one it -was designed for); - - - the logic underlying the order in which prompts are presented is in -many places different from a user's natural expectations. - - Following the DWARF design philosophy a proper solution would be to -split overloaded keywords into multiple ones; in addition the order of the -prompts could be made more natural to the uninitiated user. Both of these -options are unacceptable because of their pervasive impact on existing batch -procedures. - - In trying out various ways to patch the situation I noticed that the -only information that a user can hardly avoid noticing is that provided in the -prompts (and in the help texts if he consults these). Everything else is very -easily overlooked. - - The problem, then, is to provide prompts, options and help texts -specific to each of the quite different contexts in which a keyword may be -used, without resorting to changing the keywords themselves. In other words, we -want a method enabling programs to set these prompt components dynamically. As -a practical matter, the method should have a minimal impact on the existing -programs. - - -The new subroutine WNDPOH -========================= - - A new routine WNDPOH has been created that accepts dynamic Prompt, -Options and Help strings. These will be used in the subsequent parameter prompt -(directly through WNDPAR or indirectly through WNDNOD, NSCHAS etc.). The prompt -and options strings replace those in the .ppd file; the help text may either be -inserted in front of the .pps text or replace it. Thus, the call sequence is -simply - - CALL WNDPOH (<prompt>, <options>, <help>) - CALL WNDPAR (... - -or - - CALL WNDPOH (<prompt>, <options>, <help>) - CALL NSCHAS (... - -etc. -There is no need to clear the strings later, this is done automatically once an -answer from the user has been accepted. - - -Details on the call arguments ------------------------------ - - The help text may contain newline directives in the WNCTXT format: !/. -It is recommended to format help text in lines that will fit in single -80-character Fortran lines and extend the quoted string over as many -continuation lines as are necessary, e.g. - - CALL WNDPOH( - 1'Target node to which to write corrections',' ', - 3'SET COPY copies the average telescope corrections from 1 complete!/ - 3input sector to selected parts of any number of output sectors.') - -A help text ending in a line '#-' signals that the text OVERRIDES the .ppd help -text rather than being prepended to it (so the .ppd text will not be shown). - - The <prompt> and <options> strings are limited to 128 characters, the -<help> text to 512 (or a few less). Blank arguments to WNDPOH are ignored, i.e. -they leave the corresponding dynamic text unaltered. - - -Where to program dynamic prompting ----------------------------------- - - The following is a list (possibly still incomplete) of keywords and -subroutine calls that may need dynamic prompting. A complete example of how I -envisage the use of WNDPOH is in ncadat.for. - - all <xxx>_NODE keywords (WNDNOD) - - all <xxx>_SETS keywords (WNDST<x>) - - all <xxx>_LOOPS keywords (WNDXLP) in those cases where the loop controls - more than one ,xxx>_SETS stream - - SELECT_XYX (NSCPL<x>) when used to select telescope rather than - interferometer polarisations. In this case the dynamic options are - 'X,Y,XY', and the subsequent NSCPLS call must read - CALL NSCPLS(XY_P,<pol.mask>) - where XY_P is defined in CBITS_DEF - - SELECT_IFRS (NSCIF<x>), SELECT_TELS (NSCTL<x>) in those cases where it - is not obvious to which stream (input or output) the selection - pertains. - - -Limitations -=========== - - 1. The dynamic information is not included in the hypertext display for -the keyword, because the hypertext source file is a static derivate of the .psc -or .pef file. For this reason the dynamic information is always shown on the -terminal for all forms of on-line help requests. - - 2. As stated before, the method can not change the order in which -prompts appear. - - 3. Since the dynamic texts are provided by the program, they are not -available to dwspecify. I consider this a minor disadvantage since dwspecify is -a primitive program in other ways as well. For interactively setting up -parameter values dwexe/norun is a much better alternative that does have access -to the dynamic texts. - - - -APPENDIX: Implementation -======================== - - WNDPAR through GET_PARM calls on routines PPD_PRSTR_GET, PPD_OPSTR_GET -and PPD_HSTR_GET to fetch the prompt, options and help strings from the .ppd -file. To allow a program to modify e.g. the prompt dynamically, a new entry -point PPD_PRSTR_LSET was created. It takes a prompt string as argument and -stores it in an internal buffer. When PPD_PRSTR_GET is called later, it checks -this buffer and if it finds anything there, uses it instead of the .ppd prompt. -The same method is used to allow dynamic options and help texts; a dynamic help -text may either override the static text or be inserted in front of it. A -terminating line '#-' is inter[reted as an 'override' flag. - - For the programmer's convenience, a single routine is available to set -dynamic information pertaining to the subsequent direct or indirect (through -another routine such as WNDSTA) WNDPAR call. - - The dynamic information will be used in the prompt and any automatic -repeat of it; it will then automatically be cleared. - - -Automatic clearing -================== - - Subroutines like WNDNOD, WNDSTA, NSCIFS are called in various contexts, -so the use of WNDPOH with them is desirable. Internally, these routines call -WNDPAR and may do so repeatedly in case of an incorrect reply. For this reason -WNDPAR can not automatically clear the dynamic strings. - - The solution is for the calling subroutines to set an 'inhibit -clearing' flag. WNDPAR will only clear the dynamic strings if this flag is -clear. Any routine that sets the flag is responsible for clearing both the falg -and the strings, through a call to WNDPOHC. - - The flag must be accessible to several routines and must therefore -reside in a COMMON block. At present the location A_J(0) defined by WNG_DEF is -used because it was available. This solution is sound except that it is -invisible outside the routines that use the flag; an unexpected conflict could -arise later when someone decides that he may use this location for another -purpose. - - diff --git a/src/doc/txt/wntinc.txt b/src/doc/txt/wntinc.txt deleted file mode 100644 index 296f4526bdb649db5f0684978d28aa9fea1dff19..0000000000000000000000000000000000000000 --- a/src/doc/txt/wntinc.txt +++ /dev/null @@ -1,473 +0,0 @@ -wntinc.txt draft-5 930902/WNB - - -The Newstar table compiler WNTINC ---------------------------------- - - - -1. Introduction - -WNTINC is a replacement for WNTAB. The major changes are based on -comments/remarks made by JPH and MdV, and on deficiencies found by myself. -It has been rewritten to make it more modular and to get rid of any -non-described numerical codes. -Main features: -- calculation on local variables -- multiple structure definitions -- structure definitions inside DEFINE -- structures in data statements -- implicit array lengths -- implicit string lengths -- alignment possibilities -- map/union options (not implemented in this version yet) -- deletion of some unused options -- complete C coverage -- continuation lines - -An example of the use can be found in wnt.dsc - - -2. Input structure - -The input file to WNTINC is a NAME.dsc file. The parameter to WNTINC is -NAME, possibly modified by a directory indication. Whatever the case of -NAME, it will be assumed to reference a lc NAME.dsc. -All input lines will be converted to UC, unless enclosed in "". The output -names will all be UC for Fortran and Unix parameters; lc for Unix variable -names. -Blanks in the following indicate 'white space' (i.e. in general spaces -and/or tabs) - -NAME.dsc will consist of a number of lines. Each line consists of a (possibly -empty) command part, followed by an optional comment part which should be -preceded with an !. A line can be continued by having the last non-blank -character in the command part to be a '\'. -An empty line will be considered to be a comment line; a comment not -starting at the beginning of the line will be considered to be a -continuation of the previous line (whether '\' present or not. (This -is to distinguish comments that should precede fields from comments that -should follow fields)). - -Each command can be: -- empty (i.e. comment line only) - can occur everywhere -- the first non-blank character a '%': commands that steer the behaviour - of the compiling process - can occur everywhere -- the first non-blank character a '.': commands that steer the data - interpretation process - can occur only in 'data-blocks'; except .DEFINE: can occur only - once outside a data-block; .STRUCTURE (.BEGIN) that can occur - inside and outside data-blocks and which define the start of - data-blocks; .PARAMETER that can occur everywhere -- data command (starts always with a '-' (dummy name)) or alphabetic character - - -3. Output files - -WNTINC produces the following output files (NAME is the input file name -name, or set by the %NAME) (all filenames in lc): - -a. If .STRUCTURE type data blocks present: - -- NAME_o.def Fortran include file containing parameters and/or comments - and/or 'structure-type' definitions -- NAME_o.inc C include file containing parameters and/or comments and/or - structure definitions -- NAME_t.def Fortran include file containing information for translating - data structures from one representation to another (using - WNTT* routines) -- NAME_t.inc C include file -- NAME_e.def Fortran include file containing information for formatted - printout and/or input of data structures -- NAME_e.inc C include file - -b. If a .DEFINE data block present, or if no .STRUCTURE and no .DEFINE type - present: - -- NAME.def Fortran include file containing comments, parameters (if no - _o present) and/or common blocks and/or data definitions -- NAME.inc C include file containing the same -- NAME_bd.for Common block data-initialisation (if necessary) - -d. Always: - -NAME.LIS describing: -- the input lines -- the offset in and structure of common blocks and data structures. - - -4. Comment lines - - -Commment outside data blocks will be considered to be comments for the .dsc -file only. -Comments inside data blocks will form part of the program output. Lines -starting with a ! will be output proceeding the data items following. Other -comments will always follow the data items they follow. - - -5. % commands - -%name commands steer the compiling process. Some action may be dependent on -wether it is inside or outside data blocks. The following commands are -recognized: - -%NAME=string name of output files to be used. - Default: input file name -%DATE=yymmdd date of producing output - Default: today -%USER=name name of user - Default: login name -%VERSION=num Current version - Default: 1 -%SYSTEM=num Current system - Default;1 - -%%NAME will show currently defined name -%%DATE .. date -%%USER .. user -%%VERSION .. version -%%SYSTEM .. system - -If more than one of the above commands are encountered, the last will be -used - - -%[NO]LIST list lines in log (e.g. to suppress include file -listing) - Default: LIST -%[NO]PRINT list comments in output (not fully implemented) - Default: print -%[NO]ALIGN align data items on their lengths (complex data on - their constituant length; structure on the largest - element length included in the structure) - -The above act as switches - -%INSERT=string include specified file -%INCLUDE=string include specified file - As a rule the string will be of the form NAME_DSF, - referencing an include file name.dsf - -The above are identical - -%COMMENT=string include specified comment at begin of output file -%REVISION=nam=yymmdd=string include specified comment as a revision -%FORTRAN=string include the Fortran statement (e.g. IMPLICIT NONE). - If outside data block: at begin of output; if inside: - at end of output -%CC=string include the C statement - -The above act additive - -%LOCAL=name=expr specify a local variable name with a value expr. - The value of the name can be an integer value, or - a character string. If the expr can be evaluated to - an integer constant it will have an integer value, - else a character string value. - In most places were information has to be supplied it - can be supplied as: - - integer expression: containing known variable names, - integer constants (), +-*/, +- unary - - character expression: single known name with a - character value - - string (anything that cannot be interpreted as - one of the above) - Note: an expression starting with a ( will be - deemed to have been ended at the belonging ). This - is for some formatting reason. - Note: / is only recognised if not preceded and or - followed by blanks. This is to recognize the /../ - initialisation - Examples: - 2. is string "2." - 01 is value 1 (and string "1" if -appropiate) - (1)*2 is string "(1)*2" - +(1)*2 is value 2 ("2" string) - -%GLOBAL=name=expr identical to the combination: - %LOCAL=name=expr - .PARAMETER - name tp /expr/ - where tp is either J or C(length expr) - - -6. . commands - -. commands define some aspects of the data commands present. Recognized: - - -.END ends blocks starting with .STRUCTURE, .DEFINE, or - .MAP -.DEFINE starts a 'define-block' - Can only occur once outside a data block (define- - or struct-block). The sub-type will initially be - data -.STRUCTURE[=sname] starts a structure block with name sname or NAME - can occur inside or outside a define-block. Many - structure blocks are allowed, but they may not be - nested (there references (see S:) may, of course, - be nested. - Each structure block should have a unique name - (i.e. only one unnamed allowed). The sub-type - will initially be data -.BEGIN[=sname] identical to .STRUCTURE (for historical reasons) - -The above define the type of current data block. It will define the output -files produced, and which sub-types are allowed. - - -.[OFFSET]=nexpr will define a current offset - Only for structure-blocks; assumed to be in data-sub - For define-blocks allowed in common-sub -.ALIGN=nexpr Align offset on specified lengths (note the program - knows the defined local variables LB_B etc) - Allowed in common-sub en structure data-sub -.MAP[=nexpr] will start equivalence structures -.UNION[=nexpr] will start the next structure to be equivalent - The nexpr will serve as an id that can be used in - the WNT translation tables to get the proper - translation of the data; and is used to generate - a name for C. Definition ends at .END - Can only be used in structure-blocks at data-sub - Note: Not implemented yet, but its action can be - made by the equivalence = (except for the translation - choice option) -.PARAMETER Interprets following data lines as parameters -.DATA Interprets following lines as data -.COMMON[=cname] Interprets following lines as to belong to common - cname_COM (or NAME_COM) - Only in define-block - -7. Data commands - -A data command describes a data-item. It consists of two mandatory fields -separated by blanks, and an optional (obligatory for parameters and implied -lengths) initialisation and an optional editing field (only allowed for -structure data-sub). -A full command is: - - name[=rnam] type [/init, ..../] [<edit>] - -Name can be "-" to indicate a dummy name (to be used for filling) or a name -starting with an alphabetic (including _$) character and having only -alphanumeric characters (including _$). -The name can be followed with an '=' followed by a reference name (not valid -for parameter data). The data will be put at the same offset as the data at -the reference name. Limitations: -- rnam should immediately precede name in the same sub-block, i.e. all names - referencing the same rnam should be continuous after rnam -- name should describe an entity not larger than the entity of rnam -- if in ALIGN mode, the alignment of name should be of the same or lesser - value than that of rnam - -Type describes the data entity. It consists of a type indicator, optionally -followed by an array definition. - -The indicator can be: - - B I1 byte - I I2 integer*2 - J I4 integer*4 - K long integer (for now identical to J) - E R4 real*4 - D R8 real*8 - X complex*8 - Y complex*16 - A double length ASCII - Cnexpr character*(nexpr) - C* character*(*) (length from initialisation - string; hence only allowed for parameters - and data in common-sub or define data-sub - S:name structure as defined by name - A:[([start][,inc])] enumeration(add). If in a data-type mode in - define-block, it will generate a character - string array with an implied length from - the initialisation data, containing the - strings provided and a final ' ' string. - This variable can then be used in e.g. - WNCAFU to do a minimax search for its - occurrence. In addition (and in all other - cases only) it will produce a series of - parameters consisting of pre_txt with - values starting at start and incrementing - with inc, where the txt is the first three - (or less if not existing) characters of the - strings, and pre__N will be defined to give - the number of values+1; pre__I the increment - and pre__L and pre__H the lowest and highest - values. The pre__* - will also be available as local variables. - Default start, inc: 1 - E.g.: - cb E: /structure,define,end/ - will produce: - CHARACTER*(10) CB__TXT(4) - DATA CB__TXT/'STRUCTURE','DEFINE','END',' '/ - INTEGER CB_STR,CB_DEF,CB_END,CB__N, - CB__I,CB__H,CB__L - PARAMETER(CB_STR=1,CB_DEF=2,CB_END=3, - CB__N=4,CB__I=1,CB__L=1,CB__H=3) - AR:[([start][,inc])] as A:, but the parameter names will be *_pre - M:[([start][,fac])] enumeration(mul). As A:, but multiplicative - rather than additive. - Default start, fac: 1, 2 - MR:[([start][,fac])] as M:, but *_pre parameters - N:[(val,...)] enumeration(named). As A:, but values are - specified (up to number of array indices - allowed, currently 16). - Default val: 1,2,3,... - Note: No __H,__L and __I produced - NR:[(val,...)] as N:, but *_pre parameters - - [A|M|N][R][F][*]:[...] as A: M: or N:, but Reversed name_ if R present, - full name (rather than 3 first characters) - if F present, no __ names and text if * present. - - - - -Array specification: - - (nexpr[:nexpr],....) The last index (i.e. the high-bound) can be -specified as '*' to indicate an implied length to be deduced from the -initialisation string (if this was allowed). All format types except -A:, M: and N: can have an array index. - - -Initialisation data: - - /init, .../ each init can be an expression, or (nexpr)init. In the -latter case the (nexpr) gives a repeat factor. -If the format was character and the string contains blanks, ',' '/' or -anything that can be but should not be interpreted as an expression (e.g. -'02' which may not be converted to '2'), or is case sensitive, it should be -enclosed in "". - - -Edit data: - - <format,code,units,special> - -Each field may be omitted, trailing ',' may be omitted. - format: WNCTXT (WNCTXI) type format (e.g. AEF12.6) - Default: deduced from item - code: 0: editing of field allowed, >0: not allowed - Default: 0 - units: string specifying units (e.g. "deg") - Default: " " - special: string to indicate something special defined by user - of edit data (e.g. if formatting types are not - sufficient, e.g. to type interferometer names) - Default: " " - The special field is used for S: fields, the default - will be "S:NAME". By definition the user can put - anything in it. The only definition I have now is: - "D:NAME" for a field containing a disk pointer to - to a structure NAME. The editing routine will be - extended to recognise these special codes. - -8. Program changes, omissions - -The following features are not fully implemented yet: - -- initialisation of structures (relatively easy, will do soon) -- MAP/UNION: the = feature caters for everything except the run-time choice - of translation table. This last feature is probably dangerous anyway. - If the need arises, easily to implement. -- C: I have only tested that the .inc files look ok, and are all accepted - by the C compilers. - -The following existing programs need changes: - -- ncomp/ndel.ssc: to change to WNTINC: done -- no _m.mvx output: use existing ones by preserving them. If the f??.dsc files - change, the .mvx has to change. However, the DECalpha has a different - assembler from the VAX, and changes are necessary anyway in the - existing Macro programs (i.e. the I/O routines). - I have done the preservation, and will look at changing the Macro - programs to Fortran. -- no .RECORD: it has been enhanced by the S: data item: scw.dsc and ohw.dsc - uses this: change done -- output now _o.inc rather than -c.inc to get uniform naming: wnf I/O - routines have to change: done - - -9. Detailed program output - - -The output of the program consist of: -- parameters -- structure definitions -- data definitions -- common defintions -- translation tables -- edit tables - -- Parameters - -Parameters are output in Fortran as PARAMETER, with name and type as given. -In C as #define NAME init-text -Note: Maybe they should be given as: - #define NAME (cast) init-text ?? comments please -For A:, M:, N: type the following INTEGER PARAMETERs are produced: - NAME__N # of items in list +1 (==first available - element). Also available as local variable - NAME__L First value (not for N:) - NAME__H Last value (not for N:) - NAME__I Increment(A:) or factor(M:) - NAME_txt For each non-empty init-txt (i.e. not ,, or ,/) - the first 3 char of the text (or less if - shorter text) are taken as txt. - -- Structure definitions - -Structure definitions are given in C as: - struct struct-name { type name [indices]; ,,,}; -All names in lc; indices in reversed order from Fortran. -In Fortran each given name is combined with the struct-name sname to -produce the following INTEGER PARAMETERs: - SNAME__L Byte length of structure - SNAME__V Version - SNAME__S System -In the edit output: - SNAME__EL Length of edit arrays -The above are also available as %LOCAL constants -For historic reasons also available: - snameHDL - snameHDV - snameHDS - snameEDL -For all structure elements: - SNAME_NAME_1 Byte offset from start of structure -In addition for CHARACTER data: - SNAME_NAME_N Length in characters -for STRUCTURE data: - SNAME_NAME_N Length in bytes -for all if the offset from the beginning is an integer multiple of the unit -size of the data type (e.g. LB_J=4 for INTEGER; structure length for structure): - SNAME_NAME_type Offset in unit-length units from start - of structure. Types are the types as given - in the definition (C,J,E,Y,S etc) - - - -Automatic formatting of data structures ---------------------------------------- - (contributed 941010 by JPH, - based on research and correspondence with WNB) - - - WNTINC copies the edit directives in <xxx>.DSC literally to <XXX>_E_DEF. -The directives are not interpreted, so they may have any form; double quotes -can be used to include blanks etc.". - - They must fit, however, in elements of the CHARACTER array declared in -the latter file. The declaration is written by WNTIOS through WNCTXT calls. On -941010 the length has been increased fro 10 to 12 characters. - - The directives are read and interpreted by NSCXXS. This routine imposes -some formatting constraints and defaults of its own. See the comments in that -file. diff --git a/src/doc/txt/xmosaic_restart.txt b/src/doc/txt/xmosaic_restart.txt deleted file mode 100644 index 6adc97a418cc72e412e0cdb63bcf2448e0e1831a..0000000000000000000000000000000000000000 --- a/src/doc/txt/xmosaic_restart.txt +++ /dev/null @@ -1,51 +0,0 @@ - -Xmosaic restart protocol -======================== - - xmosaic is started by genaid.exe. genaid stores the pid of xmosaic in a -file /tmp/xm-<display name>, where <display name> is derived from the -environment variable DISPLAY by substituting a dot for each colon. - - To access xmosaic from a parameter prompt in a Newstar program, PPDHELP -call genmosaic.cun. The latter routine reads the file created by genaid to -retrieve xmosaic's pid, <pid>. It then follows the protocol defined by xmosaic -to access the appropriate help information in mosaic form: - - - 1. Create a file /tmp/Mosaic.<pid>, containing the lines - - goto - file://localhost/<directory>/file.html - - 2. Sending a SIGUSR1 signal to process <pid>. - -The latter signal causes xmosaic to opend the file /tmp/Mosaic.pid and act on -its contents. - - -Changes, early november 1994 -============================ - - Parameter .html files are now clustered in one .html file per .psc or -.pef file. Finding the right target for display by mosaic requires some -searching, which is done most easily in a .csh script: - - set target = \ - `grep -l <Keyword> $n_hlp/intfc/<program>_private_intfc.psc` - if ($#target != 0) then - set typ = 'private' - else - set target = `grep -l <Keyword> $n_src/*/*.pef` - if ($#target != 0) then - set typ = 'public' - else - <emit error message> - endif - set label = `echo <keyword> sed -e 'y:A...Z_:a...z.:' ` - echo 'goto' >! /tmp/Mosaic.<pid> - echo \ -"file://localhost$n_hlp/<pgm>_${typ}_intfc/<pgm>_${typ}_intfc.html#$target" \ - >> /tmp/Mosaic.<pid> - ln -s /tmp/Mosaic.<pid> /tmp/xmosaic.<pid> - kill -SIGUSR1 <pid> - diff --git a/src/dwarf/abp.grp b/src/dwarf/abp.grp deleted file mode 100644 index 1b3208430911b9adc78c4bb57e3f8d24444ee5ac..0000000000000000000000000000000000000000 --- a/src/dwarf/abp.grp +++ /dev/null @@ -1,49 +0,0 @@ -!+ ABP.GRP -! WNB 920915 -! -! Revisions: -! HjV 921104 Remove NGIDS -! HjV 930226 Add ABPX_NPLOT -! HjV 930924 Add ABPX_NFLAG -! -! General routines for DWARF programs -! -! Group definition: -! -ABP.GRP -! -! Masks for program development -! -! PIN files -! -! Structure files -! -! General command files -! -! -! Initialisation command files -! -! -! Fortran definition files: -! -! -! Programs: -! -ABPX_NCALIB.FOR !ABPX_NCALIB -ABPX_NCLEAN.FOR !ABPX_NCLEAN -ABPX_NFLAG.FOR !ABPX_NFLAG -ABPX_NMAP.FOR !ABPX_NMAP -ABPX_NMODEL.FOR !ABPX_NMODEL -ABPX_NPLOT.FOR !ABPX_NPLOT -ABPX_NSCAN.FOR !ABPX_NSCAN -! -! Executables -! -ABPX_NCALIB.EXE ! -ABPX_NCLEAN.EXE ! -ABPX_NFLAG.EXE ! -ABPX_NMAP.EXE ! -ABPX_NMODEL.EXE ! -ABPX_NPLOT.EXE ! -ABPX_NSCAN.EXE ! -!- diff --git a/src/dwarf/abprun.for b/src/dwarf/abprun.for deleted file mode 100644 index 16479d08a2e1eef0ae273a870f26df0cdb8bd033..0000000000000000000000000000000000000000 --- a/src/dwarf/abprun.for +++ /dev/null @@ -1,504 +0,0 @@ -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ -C.Ident: ABP_RUN -C.Keywords: Automatic Batch Programming -C.Author: Friso Olnon (NFRA, Dwingeloo) -C.Language: FX-Fortran -C.Environment: Alliant -C.Comments: -C.Version: 910626 FMO - creation -C.Version: 910704 FMO - search .EXE in EXEUSER after EXEDWARF (<-Foley) -C.Version: 910708 FMO - allow different ABP and DWARF program names, -C - act upon RUNMODE=DEFINE -C.Version: 910815 FMO - renew ABP_CLEAR (PPD file no longer needed) -C - renew ABP_RESTORE -C.Version: 910909 FMO - adapted for Alliant -C.Version: 911206 GvD - use EXECL iso. SYSTEM to start program -C PPD_EXIT is called in ABP_RUN_DO -C Added routine ABP_RUN_SPEC -C ABP_SPECIFY is removed (SP_LIST can be used) -C Up to 20 arguments are allowed in the CLI (was 10) -C.Version: 920228 GvD - search .sav-file on SYS$LOGIN, then on ABPDIR -C.Version: 930923 CMV - logical names for new maintenance system -C.Version: 940119 CMV - use WNGLUN i.s.o. GEN_GET_LUN -C.Version: 940121 CMV - changed messenger -C.Version: 940211 WNB - change file inquire -C.Version: 940628 CMV - built in some safety checks -C.Version: 010709 AXC - Linux port:tmpchar in calls -C------------------------------------------------------------------------- -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - LOGICAL FUNCTION ABP_RUN_INIT (PROGNAM,DWFNAM,NRARG,NAME,DEFVAL, - 1 EXEFIL,STREAM,RUNMODE) -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' -C - CHARACTER*(*) PROGNAM !(i) ABP program name - CHARACTER*(*) DWFNAM !(i) DWARF program name - INTEGER NRARG !(i) nr of possible arguments - CHARACTER*(*) NAME(*) !(i) argument names - CHARACTER*(*) DEFVAL(*) !(i) default argument values - CHARACTER*(*) STREAM !(o) stream name (prefixed with $) - CHARACTER*(*) EXEFIL !(o) expanded spec of executable - CHARACTER*(*) RUNMODE !(o) run mode -C -C.Purpose: Initialise ABP program -C.Returns: .TRUE. for success, .FALSE. otherwise -C.Notes: -C - Initialise DWARF control, start messenger and start command-line -C interpreter. -C - Check presence of program executable in EXEDWARF (or in EXEUSER). -C - Get stream name and run mode from command line. -C - Open PPD file. -C - Refresh appropriate external defaults. -C------------------------------------------------------------------------- -C - INTEGER PARM, QUAL !argument-attribute codes - PARAMETER (PARM = CLI__PARAMETER) - PARAMETER (QUAL = CLI__QUALIFIER+CLI__DEFAULT+CLI__VALUE) -C - INTEGER ATTR(20) !argument attributes - CHARACTER*1 PROMPT(20) !prompt strings - DATA ATTR /PARM,19*QUAL/ !1 parameter, up to 19 qual's - DATA PROMPT /20*' '/ !dummy prompt strings -C - LOGICAL ABP_CLEAR, ABP_RESTORE - INTEGER DWC_CTL_OPEN, DWC_STREAM_CHECK - INTEGER MSG_INIT, MSG_SET - INTEGER CLI_INIT, CLI_GET - INTEGER PPD_INIT - INTEGER STR_SIGLEN, FILNAM_FULL - LOGICAL WNFOP -C - CHARACTER SAVFIL*80, XSTREAM*16, TMP*80 - INTEGER IS, LP, LD, LE, LR, LS, LSV, LX - LOGICAL OK, EXIST - INTEGER FCAT -C -C -C Initialize -C - get DWARF control variables -C - start messenger -C - start command-line interpreter -C - LP = STR_SIGLEN (PROGNAM) - LD = STR_SIGLEN (DWFNAM) - IS = DWC_CTL_OPEN () - TMP='ABPX_'//PROGNAM(:LP) - IF (IAND(IS,1).NE.0) IS = MSG_INIT(TMP,F_T) - IF (IAND(IS,1).NE.0) IS = CLI_INIT (NRARG,NAME,ATTR,PROMPT,DEFVAL) - IF (IAND(IS,1).EQ.0) GOTO 999 -C -C Build the full executable spec -C and check its existence -C - TMP=DWFNAM(:LD)//'.EXE' - IS = FILNAM_FULL (TMP,EXEFIL,LE,'n_exe') - IF (IAND(IS,1).EQ.0) GOTO 999 - EXIST=WNFOP(FCAT,EXEFIL(:LE),'R') - IF (.NOT.EXIST) THEN - TMP=DWFNAM(:LD)//'.EXE' - IS = FILNAM_FULL (TMP,EXEFIL,LE,'n_uexe') - IF (IAND(IS,1).EQ.0) GOTO 999 - EXIST=WNFOP(FCAT,EXEFIL(:LE),'R') - END IF - IF (.NOT.EXIST) GOTO 991 - CALL WNFCL(FCAT) -C -C Get standard command-line arguments -C - IS = CLI_GET ('STREAM',XSTREAM,LX) - IF (IAND(IS,1).NE.0) IS = CLI_GET ('RUNMODE',RUNMODE,LR) - IF (IAND(IS,1).EQ.0) GOTO 999 -C -C Stream name must be present -C - IF (XSTREAM(:LX).EQ.'""') GOTO 992 -C -C Check stream name -C - must be valid stream name, not $0 -C - <prognam><stream>.sav must exist -C in ABPDIR or user's login directory -C - IS = DWC_STREAM_CHECK (XSTREAM(:LX),STREAM,LS,.FALSE.) - IF (IAND(IS,1).EQ.0) GOTO 993 - IF (STREAM(:LS).EQ.'$' .OR. STREAM(:LS).EQ.'$0') GOTO 993 - TMP=PROGNAM(:LP)//STREAM(:LS)//'.SAV' - IS = FILNAM_FULL (TMP, - 1 SAVFIL,LSV,'HOME') - IF (IAND(IS,1).EQ.0) GOTO 993 - EXIST=WNFOP(FCAT,SAVFIL(:LSV),'R') - IF (.NOT.EXIST) THEN - TMP=PROGNAM(:LP)//STREAM(:LS)//'.SAV' - IS = FILNAM_FULL (TMP - 1 ,SAVFIL,LSV,'ABPDIR') - IF (IAND(IS,1).EQ.0) GOTO 993 - EXIST=WNFOP(FCAT,SAVFIL(:LSV),'R') - IF (.NOT.EXIST) THEN - CALL WNCTXT(DWLOG,'File !AS not found',SAVFIL(:LSV)) - GOTO 993 - END IF - ELSE - CALL WNCTXT(DWLOG,'Using !AS from HOME directory',SAVFIL) - END IF - CALL WNFCL(FCAT) -C -C Refresh external defaults -C - TMP=DWFNAM(:LD)//'$0' - OK = ABP_CLEAR (TMP) - TMP=DWFNAM(:LD)//STREAM(:LS) - IF (OK) OK = ABP_CLEAR (TMP) - IF (OK) OK = ABP_RESTORE (TMP,SAVFIL(:LSV)) - IF (.NOT.OK) GOTO 990 -C -C Open PPD file -C - IS = PPD_INIT (DWFNAM(:LD)) - IF (IAND(IS,1).EQ.0) THEN - CALL WNCTXT(DWLOG,'!_!AS.PPD',DWFNAM(:LD)) - GOTO 999 - END IF -C -C - ABP_RUN_INIT = .TRUE. - RETURN -C - 990 CALL WNCTXT(DWLOG,'No symbols read from stream...') - GOTO 999 - 991 CALL WNCTXT(DWLOG,'File !AS not found',EXEFIL(:LE)) - GOTO 999 - 992 CALL WNCTXT(DWLOG,'Stream name is missing') - GOTO 999 - 993 CALL WNCTXT(DWLOG,'Invalid stream: !AS',XSTREAM(:LX)) - GOTO 999 - 999 IS = MSG_SET(IS,0) - ABP_RUN_INIT = .FALSE. - RETURN - END -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - LOGICAL FUNCTION ABP_RUN_DO (DWFNAM,STREAM,EXEFIL,RUNMODE) -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' -C - CHARACTER*(*) DWFNAM !(i) DWARF program name - CHARACTER*(*) STREAM !(i) stream name (with $ prefix) - CHARACTER*(*) EXEFIL !(i) expanded spec of executable - CHARACTER*(*) RUNMODE !(i) run mode -C -C.Purpose: Run the program in the given stream -C.Returns: .TRUE. for success, .FALSE. otherwise -C.Notes: -C - If RUNMODE is DRYRUN: only close the symbol facility. -C------------------------------------------------------------------------- -C - INTEGER STR_SIGLEN - INTEGER PPD_EXIT - INTEGER SYMBOL_DEFINE, SYMBOL_EXIT -C - CHARACTER*255 SYMVAL,TMP*80,TMP2*80 - INTEGER IS, LD, LS, LV, LE -C -C - IS = PPD_EXIT () - IF (IAND(IS,1).EQ.0) GOTO 999 - IF (RUNMODE.EQ.'DRYRUN') THEN - IS = SYMBOL_EXIT () !keep symbol def - IF (IAND(IS,1).EQ.0) GOTO 999 - ABP_RUN_DO = .TRUE. - RETURN - END IF -C Create symbol DWARF_<dwfnam>_CONTROL -C - containing ASK, SAVE, TEST switches -C - stream length and name -C - zero length (no input file) -C - LD = STR_SIGLEN (DWFNAM) - LS = STR_SIGLEN (STREAM) - LE = STR_SIGLEN (EXEFIL) - IF (RUNMODE.EQ.'DEFINE') THEN - SYMVAL = '221 '//STREAM(:LS)//'00' !do ASK and SAVE - ELSE - SYMVAL = '111 '//STREAM(:LS)//'00' !don't - END IF - WRITE (SYMVAL(4:5),'(I2.2)') LS - LV = 3+2+LS+2 - TMP='DWARF_'//DWFNAM(:LD)//'_CONTROL' - IS = SYMBOL_DEFINE (TMP,SYMVAL(:LV), - 1 DWC__LOCALSYM) - IF (IAND(IS,1).EQ.0) GOTO 999 -C -C Run the DWARF program -C Append a zero for the C-routine EXECL -C - E_C = IS !Set exit status - IS = SYMBOL_EXIT () !keep symbol def - IF (IAND(IS,1).EQ.0) GOTO 999 - TMP=EXEFIL(:LE)//CHAR(0) - TMP2=DWFNAM(:LD)//CHAR(0) - CALL GEN_EXECL (TMP, TMP2) !run - ABP_RUN_DO = .TRUE. - RETURN -C -C Error section -C - 999 ABP_RUN_DO = .FALSE. - RETURN - END -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - LOGICAL FUNCTION ABP_CLEAR (PROGSTRM) -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' -C - CHARACTER*(*) PROGSTRM !(i) DWARF program name and stream -C -C.Purpose: Clear the external defaults -C.Returns: .TRUE. for success, .FALSE. otherwise -C.Notes: -C------------------------------------------------------------------------- -C - CHARACTER*(*) BLANK - PARAMETER (BLANK = ' ') -C - INTEGER SYMBOL_SEARCH, SYMBOL_DELETE -C - CHARACTER NAM*64,TMP*80 - INTEGER IS, LN, NR -C -C - NR = 0 - LN = 1 - TMP= PROGSTRM//'_*' - DO WHILE (LN.GT.0) - IS = SYMBOL_SEARCH (TMP,BLANK,NR,NAM,LN) - IF (IAND(IS,1).EQ.0) GOTO 999 - IF (LN.GT.0) IS = SYMBOL_DELETE (NAM(:LN),DWC__GLOBALSYM) - IF (IAND(IS,1).EQ.0) GOTO 999 - END DO -C - ABP_CLEAR = .TRUE. - RETURN -C - 999 ABP_CLEAR = .FALSE. - RETURN - END -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - LOGICAL FUNCTION ABP_RESTORE (PROGSTRM,SAVFILE) -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' -C - CHARACTER*(*) PROGSTRM !(i) DWARF program name and stream - CHARACTER*(*) SAVFILE !(i) save file -C -C.Purpose: Restore parameter defaults from file -C.Returns: .TRUE. for success, .FALSE. otherwise -C.Notes: -C - The external defaults for the program in the given stream are -C restored from the save file. -C - The save file must have been created via DWARF's SAVE command. It -C then contains definition lines of the form -C #<progstrm>_<keyword>="<value>" -C where # indicates a blank space, -C - Only defaults with the proper <progstrm> are restored. -C - All other lines are ignored. -C - Temporarily the old-style save files are still readable. -C------------------------------------------------------------------------- -C - CHARACTER*(*) BLANK, UNDERSC, ASTER, EQUAL, QUOTE - PARAMETER (BLANK = ' ') - PARAMETER (UNDERSC = '_') - PARAMETER (ASTER = '*') - PARAMETER (EQUAL = '=') - PARAMETER (QUOTE = '"') - CHARACTER*(*) ANUMX - PARAMETER (ANUMX = 'ABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789_') -C - INTEGER GEN_FORIOS - INTEGER SYMBOL_DEFINE - INTEGER STR_COPY, STR_COPY_W - INTEGER WNCALN -C - CHARACTER LINE*512, DEFSTART*25, NAM*64, VALUE*255 - INTEGER LP, LL, LD, LN, LV - INTEGER IS, LUN, PTR - LOGICAL NEW_STYLE - INTEGER NDEF -C -C - LP = WNCALN(PROGSTRM) - NDEF=0 -C -C Open the save file and check the first -C line to see whether it is an old- or -C new-style save file -C - old files start with a .GLOBAL line -C - CALL WNGLUN(LUN) - IF (LUN.EQ.0) GOTO 999 - OPEN (LUN,NAME=SAVFILE,STATUS='OLD',ERR=998) - READ (LUN,'(Q,A)',END=900,ERR=997) LL, LINE - NEW_STYLE = LINE.NE.'.GLOBAL' - IF (NEW_STYLE) THEN - DEFSTART = BLANK//PROGSTRM(:LP)//UNDERSC - LD = LP+2 - GOTO 101 - ELSE - CALL WNCTXT(DWLOG, - 1 'OLD-STYLE save file, how did you ever get it?') - DEFSTART = BLANK//BLANK//PROGSTRM(:LP)//UNDERSC - LD = LP+3 - ENDIF -C -C Read and check the next line -C - skip non-definition lines -C - 100 READ (LUN,'(Q,A)',END=900,ERR=997) LL, LINE - 101 IF (LL.GT.0) LL = WNCALN(LINE(:LL)) - IF (NEW_STYLE) THEN - IF (LL.LT.LD+5) GOTO 100 !too short a line - IF (LINE(:LD).NE.DEFSTART(:LD)) GOTO 100!wrong start - PTR = 2 !skip to start name - ELSE - IF (LL.LT.LD+8) GOTO 100 - IF (LINE(:LD).NE.DEFSTART(:LD)) GOTO 100 - PTR = 3 - END IF - IF (LINE(LL:LL).NE.QUOTE) GOTO 100 !wrong end -C -C - extract the name -C - remove a possible abbreviation -C character (asterisk) -C - NAM = DEFSTART(PTR:LD) !fill first part name - LN = LD-PTR+1 - PTR = LD+1 !point to start of key - IS = STR_COPY_W (ANUMX,LINE(:LL),PTR,NAM,LN) !extract rest - IF (PTR.LT.LL .AND. LINE(PTR:PTR).EQ.ASTER) THEN!asterisk encountered: - PTR = PTR+1 ! skip it - IS = STR_COPY_W (ANUMX,LINE(:LL),PTR,NAM,LN)!extract rest name - END IF -C -C - extract the value (must be quoted) -C - IF (NEW_STYLE) THEN - IF (PTR+2.GE.LL) GOTO 100 !too short aline - IF (LINE(PTR:PTR+1).NE.EQUAL//QUOTE) - 1 GOTO 100 !value not quoted - PTR = PTR+2 - ELSE - IF (PTR+5.GE.LL) GOTO 100 - IF (LINE(PTR:PTR+4).NE.BLANK//EQUAL//EQUAL//BLANK//QUOTE) - 1 GOTO 100 - PTR = PTR+5 - END IF - LV = 0 !clear value - IS = STR_COPY (LINE(PTR:LL-1),VALUE,LV) !extract value - IF (IS.LT.0) GOTO 100 !too long: skip -C -C Define the symbol -C - IS = SYMBOL_DEFINE (NAM(:LN),VALUE(:LV),DWC__GLOBALSYM) - IF (IAND(IS,1).EQ.0) GOTO 996 - NDEF=NDEF+1 - GOTO 100 -C -C Wrap up -C - 900 CLOSE (UNIT=LUN,ERR=998) - CALL WNGLUF(LUN) - IF (NDEF.EQ.0) THEN - CALL WNCTXT(DWLOG,'No symbols defined at all....') - ABP_RESTORE = .FALSE. - ELSE - CALL WNCTXT(DWLOG,'!UJ symbols defined....',NDEF) - ABP_RESTORE = .TRUE. - END IF - RETURN -C - 997 IS = GEN_FORIOS (SAVFILE) !read error - 996 CLOSE (UNIT=LUN,ERR=998) !processing error - CALL WNGLUF(LUN) - GOTO 999 - 998 IS = GEN_FORIOS (SAVFILE) !open or close error - CALL WNGLUF(LUN) - 999 ABP_RESTORE = .FALSE. !setup error - RETURN - END -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - LOGICAL FUNCTION ABP_RUN_SPEC (DWFNAM,STREAM,SW,ANAME,PNAME,NRARG) -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' -C - CHARACTER*(*) DWFNAM !(i) DWARF program name - CHARACTER*(*) STREAM !(i) stream name (with $ prefix) - INTEGER SW(*) !(i) 0=ignore, 1=required, 2=optional - CHARACTER*(*) ANAME(*) !(i) names as known to ABP - CHARACTER*(*) PNAME(*) !(i) names as known to PPD - INTEGER NRARG !(i) #arguments in above arrays -C The first 2 can be ignored -C (they are STREAM and RUNMODE) -C -C -C.Purpose: Get and test qualifier values and 'specify' them -C.Returns: .TRUE. for success, otherwise .FALSE. -C.Notes: -C - The qualifier values are read from CLI and it is tested if they -C should have a value. -C - Each qualifier is handled by SP_LIST_KEY to define its symbol -C - SP_LIST_KEY cannot be called before all values are read from the CLI. -C This is because SP_DEF_CHECK in it resets the CLI. -C------------------------------------------------------------------------- -C - INTEGER CLI_GET - INTEGER SP_LIST_KEY -C - CHARACTER WORK*512 - INTEGER IS, LW, LWT - INTEGER STW(20), SEW(20) -C -C -C Loop through all qualifiers. -C Ignore if the switch is 0. -C First assemble all values in a string. -C This is necessary because SP_DEF_CHECK resets -C the CLI, so CLI_GET would lost its context. -C - LWT = 1 - DO I = 3,NRARG - STW(I) = LWT !start of value in string - SEW(I) = 0 !end of value - IF (SW(I) .NE. 0) THEN - IS = CLI_GET (ANAME(I), WORK(LWT:), LW) !no ignore - IF (IAND(IS,1).EQ.0) GOTO 999 - IF (LW .EQ. 0 .OR. WORK(LWT:LWT+LW-1) .EQ. '""') THEN - IF (SW(I) .EQ. 1) THEN - CALL WNCTXT(F_TP, - 1 'Qualifier !AS missing',ANAME(I)) - GOTO 999 - ENDIF - ELSE - LWT = LWT + LW !update string length - SEW(I) = LWT - 1 !save value end - ENDIF - ENDIF - ENDDO -C -C Now define all the values. -C - DO I = 3,NRARG - IF (SEW(I) .NE. 0) THEN - IS = SP_LIST_KEY (DWFNAM,STREAM,PNAME(I),WORK(STW(I):SEW(I))) - IF (IAND(IS,1).EQ.0) GOTO 999 - ENDIF - ENDDO -C -C - 900 ABP_RUN_SPEC = .TRUE. - RETURN -C - 999 ABP_RUN_SPEC = .FALSE. - RETURN - END diff --git a/src/dwarf/abpx_ncalib.for b/src/dwarf/abpx_ncalib.for deleted file mode 100644 index 7ebf9c6f4807ca7b7d4ce4537a34c2efd39fcdd3..0000000000000000000000000000000000000000 --- a/src/dwarf/abpx_ncalib.for +++ /dev/null @@ -1,135 +0,0 @@ -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ -C.Ident: ABPX_NCALIB -C.Keywords: Automatic Batch Programming -C.Author: Friso Olnon (NFRA, Dwingeloo) -C.Language: DWARF-Fortran -C.Environment: HP -C.Comments: -C.Version: 930827 Yuan Tang - creation -C.Version: 940120 CMV - Changed messenger -C------------------------------------------------------------------------- -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - SUBROUTINE ABPX_NCALIB -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' -C -C -C.Purpose: Dry-run or run DWARF program NCALIB -C.Returns: Status code to command interpreter -C success DWC_SUCCESS for successfull dry_run -C error DWC_EXEERRORS for dry-run or program-start error -C exit status of program if it has run -C.Notes: -C - The program is invoked via a foreign command with the stream name as -C required parameter. The foreign command automatically includes the -C qualifier /RUNMODE=NORMAL (batch mode), =DEFINE (definition mode) -C or =DRYRUN (check mode). -C# - The available NCALIB invocations are: -C#l ABP_NCALIB <standard_stream> <required_quals> [<optional_quals>] -C#l one-line description -C#l ABP_NCALIB <stream> -C#l use defaults saved in SYS$LOGIN:NCALIB$<stream>.sav -C#l ABP_NCALIB always accepts the optional qualifiers -C#l /<name>=<value> default value: -C -C - First, the external defaults for the program in the given stream will -C be cleared en restored from the file NCALIB$<stream>.sav in ABPDIR -C (for the standard streams) or in the user's login directory (for -C other streams). -C - Then, additional (possibly overriding) defaults will be specified -C according to the chosen stream and the given qualifiers. -C - Finally, DWARF program NCALIB will be run in the chosen stream -C unless the runmode is DRYRUN. -C------------------------------------------------------------------------- -C -C - LOGICAL ABP_RUN_INIT, ABP_RUN_SPEC, ABP_RUN_DO - INTEGER STR_SIGLEN, MSG_SET -C - CHARACTER*(*) PROGNAM ! this program - PARAMETER (PROGNAM = 'NCALIB') - CHARACTER*(*) DWFNAM ! DWARF program to be run - PARAMETER (DWFNAM = 'NCALIB') -C -C Command-line syntax definition -C - the first two arguments are always: -C parameter STREAM, default value "" -C qualifier RUNMODE, default value NORMAL -C - up to 8 other qualifiers can be defined -C - INTEGER NRARG ! total nr of arguments [2,20] - PARAMETER (NRARG = 9) - CHARACTER*16 NAME(NRARG) ! argument names - CHARACTER*6 DEFVAL(NRARG) ! default argument values - DATA NAME(1),DEFVAL(1) /'STREAM','""'/ - DATA NAME(2),DEFVAL(2) /'RUNMODE','NORMAL'/ - DATA NAME(3),DEFVAL(3) /'SCN_NODE' ,'""'/ - DATA NAME(4),DEFVAL(4) /'INPUT_MDL_NODE' ,'""'/ - DATA NAME(5),DEFVAL(5) /'SCN_SETS' ,'""'/ - DATA NAME(6),DEFVAL(6) /'SELECT_IFRS','""'/ - DATA NAME(7),DEFVAL(7) /'USE_SCN_NODE','""'/ - DATA NAME(8),DEFVAL(8) /'USE_SCN_SETS','""'/ - DATA NAME(9),DEFVAL(9) /'DELETE_LEVEL','""'/ -C -C Define which qualifiers (ie. keywords) -C have to be defined or are optional. -C 0 = ignore -C 1 = required -C 2 = optional -C You can define multiple arrays to let -C it depend on the stream. -C - INTEGER SW(NRARG) /0,0,1,1,1,2,0,0,1/ - INTEGER SWGAIN(NRARG) /0,0,0,0,0,0,1,1,0/ - INTEGER SWTRANS(NRARG) /0,0,1,0,1,0,1,1,0/ - INTEGER SWSET(NRARG) /0,0,1,0,1,0,0,0,0/ - INTEGER SWSELF7CH(NRARG) /0,0,1,1,1,0,0,0,1/ -C - CHARACTER STREAM*12, RUNMODE*20 - CHARACTER EXEFIL*80 - INTEGER IS - LOGICAL OK -C -C -C Initialise -C - start DWARF control, messenger, -C command-line interpreter, PPD access -C - get full executable spec -C - get stream name and run mode -C - refresh appropriate external defaults -C - OK = ABP_RUN_INIT (PROGNAM,DWFNAM,NRARG,NAME,DEFVAL, - 1 EXEFIL,STREAM,RUNMODE) - IF (.NOT.OK) GOTO 999 -C -C Read all program-specific qualifiers -C and specify them as a symbol. -C - IF (STREAM(1:5).EQ.'$GAIN') THEN - OK = ABP_RUN_SPEC (DWFNAM,STREAM,SWGAIN,NAME,NAME,NRARG) - ELSE IF (STREAM(1:6).EQ.'$TRANS') THEN - OK = ABP_RUN_SPEC (DWFNAM,STREAM,SWTRANS,NAME,NAME,NRARG) - ELSE IF (STREAM(1:5).EQ.'$SET0') THEN - OK = ABP_RUN_SPEC (DWFNAM,STREAM,SWSET,NAME,NAME,NRARG) - ELSE IF (STREAM(1:8).EQ.'$SELF7CH') THEN - OK = ABP_RUN_SPEC (DWFNAM,STREAM,SWSELF7CH,NAME,NAME,NRARG) - ELSE - OK = ABP_RUN_SPEC (DWFNAM,STREAM,SW,NAME,NAME,NRARG) - END IF - IF (.NOT.OK) GOTO 999 -C -C Run DWARF program -C - OK = ABP_RUN_DO (DWFNAM,STREAM,EXEFIL,RUNMODE) - IF (.NOT.OK) GOTO 999 -C -C Only get here if the program was not -C started (dry-run or failed startup) -C - IS = DWC_SUCCESS - GOTO 900 -C - 999 IS = DWC_EXEERRORS - 900 E_C = MSG_SET (IS,0) - END diff --git a/src/dwarf/abpx_nclean.for b/src/dwarf/abpx_nclean.for deleted file mode 100644 index 963adc30b6950cdf4f26df88da6ef4621419062d..0000000000000000000000000000000000000000 --- a/src/dwarf/abpx_nclean.for +++ /dev/null @@ -1,137 +0,0 @@ -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ -C.Ident: ABPX_NCLEAN -C.Keywords: Automatic Batch Programming -C.Author: Friso Olnon (NFRA, Dwingeloo) -C.Language: DWARF-Fortran -C.Environment: HP -C.Comments: -C.Version: 930323 Yuan Tang - creation -C.Version: 940120 CMV - Changed messenger -C------------------------------------------------------------------------- -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - SUBROUTINE ABPX_NCLEAN -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' -C -C -C.Purpose: Dry-run or run DWARF program NCLEAN -C.Returns: Status code to command interpreter -C success DWC_SUCCESS for successfull dry_run -C error DWC_EXEERRORS for dry-run or program-start error -C exit status of program if it has run -C.Notes: -C - The program is invoked via a foreign command with the stream name as -C required parameter. The foreign command automatically includes the -C qualifier /RUNMODE=NORMAL (batch mode), =DEFINE (definition mode) -C or =DRYRUN (check mode). -C# - The available NCLEAN invocations are: -C#l ABP_NCLEAN <standard_stream> <required_quals> [<optional_quals>] -C#l one-line description -C#l ABP_NCLEAN <stream> -C#l use defaults saved in SYS$LOGIN:NCLEAN$<stream>.sav -C#l ABP_NCLEAN always accepts the optional qualifiers -C#l /<name>=<value> default value: -C -C - First, the external defaults for the program in the given stream will -C be cleared en restored from the file NCLEAN$<stream>.sav in ABPDIR -C (for the standard streams) or in the user's login directory (for -C other streams). -C - Then, additional (possibly overriding) defaults will be specified -C according to the chosen stream and the given qualifiers. -C - Finally, DWARF program NCLEAN will be run in the chosen stream -C unless the runmode is DRYRUN. -C------------------------------------------------------------------------- -C - LOGICAL ABP_RUN_INIT, ABP_RUN_SPEC, ABP_RUN_DO - INTEGER STR_SIGLEN, MSG_SET -C - CHARACTER*(*) PROGNAM ! this program - PARAMETER (PROGNAM = 'NCLEAN') - CHARACTER*(*) DWFNAM ! DWARF program to be run - PARAMETER (DWFNAM = 'NCLEAN') -C -C Command-line syntax definition -C - the first two arguments are always: -C parameter STREAM, default value "" -C qualifier RUNMODE, default value NORMAL -C - up to 8 other qualifiers can be defined -C - INTEGER NRARG ! total nr of arguments [2,20] - PARAMETER (NRARG = 15) - CHARACTER*16 NAME(NRARG) ! argument names - CHARACTER*6 DEFVAL(NRARG) ! default argument values - DATA NAME(1),DEFVAL(1) /'STREAM','""'/ - DATA NAME(2),DEFVAL(2) /'RUNMODE','NORMAL'/ - DATA NAME(3),DEFVAL(3) /'INPUT_WMP_NODE' ,'""'/ - DATA NAME(4),DEFVAL(4) /'INPUT_MDL_NODE' ,'""'/ - DATA NAME(5),DEFVAL(5) /'CLEAN_LIMIT','""'/ - DATA NAME(6),DEFVAL(6) /'AREA','""'/ - DATA NAME(7),DEFVAL(7) /'OUTPUT_MDL_NODE','""'/ - DATA NAME(8),DEFVAL(8) /'WMP_SETS','""'/ - DATA NAME(9),DEFVAL(9) /'SCN_NODE','""'/ - DATA NAME(10),DEFVAL(10) /'SCN_SETS','""'/ - DATA NAME(11),DEFVAL(11) /'SELECT_IFRS','""'/ - DATA NAME(12),DEFVAL(12) /'COMPON_LIMIT','""'/ - DATA NAME(13),DEFVAL(13) /'CLIP_AREA','""'/ - DATA NAME(14),DEFVAL(14) /'CLIP_LEVELS','""'/ - DATA NAME(15),DEFVAL(15) /'RESTORE_BEAM','""'/ - -C -C You can define multiple arrays to let -C it depend on the stream. -C - INTEGER SWUREST(NRARG) /0,0,1,1,0,0,0,1,0,0,0,0,0,0,1/ - INTEGER SWUVCOVER(NRARG) /0,0,1,0,1,0,1,1,0,0,0,0,0,0,1/ - INTEGER SWBEAM(NRARG) /0,0,1,0,1,1,1,0,0,0,0,0,0,0,0/ - INTEGER SWDATA(NRARG) /0,0,1,1,1,0,1,1,1,1,1,1,1,1,1/ -C - CHARACTER STREAM*12, RUNMODE*20 - CHARACTER EXEFIL*80 - INTEGER IS - LOGICAL OK -C -C -C Initialise -C - start DWARF control, messenger, -C command-line interpreter, PPD access -C - get full executable spec -C - get stream name and run mode -C - refresh appropriate external defaults -C - OK = ABP_RUN_INIT (PROGNAM,DWFNAM,NRARG,NAME,DEFVAL, - 1 EXEFIL,STREAM,RUNMODE) - - IF (.NOT.OK) GOTO 999 -C -C Read all program-specific qualifiers -C and specify them as a symbol. -C - IF (STREAM(1:8) .EQ. '$UVCOVER') THEN - OK = ABP_RUN_SPEC (DWFNAM,STREAM,SWUVCOVER,NAME,NAME,NRARG) - ELSE IF (STREAM(1:6) .EQ. '$UREST') THEN - OK = ABP_RUN_SPEC (DWFNAM,STREAM,SWUREST,NAME,NAME,NRARG) - ELSE IF (STREAM(1:5) .EQ. '$DATA') THEN - OK = ABP_RUN_SPEC (DWFNAM,STREAM,SWDATA,NAME,NAME,NRARG) - ELSE - OK = ABP_RUN_SPEC (DWFNAM,STREAM,SWBEAM,NAME,NAME,NRARG) - ENDIF - - IF (.NOT.OK) GOTO 999 -C -C Run DWARF program -C - - OK = ABP_RUN_DO (DWFNAM,STREAM,EXEFIL,RUNMODE) - - IF (.NOT.OK) GOTO 999 -C -C Only get here if the program was not -C started (dry-run or failed startup) -C - IS = DWC_SUCCESS - GOTO 900 -C - 999 IS = DWC_EXEERRORS - 900 E_C = MSG_SET (IS,0) - END diff --git a/src/dwarf/abpx_nflag.for b/src/dwarf/abpx_nflag.for deleted file mode 100644 index 20ae667e253a5b79c815ee2806f25dc09ce53a67..0000000000000000000000000000000000000000 --- a/src/dwarf/abpx_nflag.for +++ /dev/null @@ -1,124 +0,0 @@ -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ -C.Ident: ABPX_NFLAG -C.Keywords: Automatic Batch Programming -C.Author: Friso Olnon (NFRA, Dwingeloo) -C.Language: DWARF-Fortran -C.Environment: Alliant -C.Comments: -C.Version: 930713 Yuan Tang - creation -C.Version: 940120 CMV - Changed messenger -C------------------------------------------------------------------------- -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - SUBROUTINE ABPX_NFLAG -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' -C -C -C.Purpose: Dry-run or run DWARF program NSCAN -C.Returns: Status code to command interpreter -C success DWC_SUCCESS for successfull dry_run -C error DWC_EXEERRORS for dry-run or program-start error -C exit status of program if it has run -C.Notes: -C - The program is invoked via a foreign command with the stream name as -C required parameter. The foreign command automatically includes the -C qualifier /RUNMODE=NORMAL (batch mode), =DEFINE (definition mode) -C or =DRYRUN (check mode). -C# - The available NSCAN invocations are: -C#l ABP_NSCAN <standard_stream> <required_quals> [<optional_quals>] -C#l one-line description -C#l ABP_NSCAN <stream> -C#l use defaults saved in SYS$LOGIN:NSCAN$<stream>.sav -C#l ABP_NSCAN always accepts the optional qualifiers -C#l /<name>=<value> default value: -C -C - First, the external defaults for the program in the given stream will -C be cleared en restored from the file NSCAN$<stream>.sav in ABPDIR -C (for the standard streams) or in the user's login directory (for -C other streams). -C - Then, additional (possibly overriding) defaults will be specified -C according to the chosen stream and the given qualifiers. -C - Finally, DWARF program NSCAN will be run in the chosen stream -C unless the runmode is DRYRUN. -C------------------------------------------------------------------------- -C - LOGICAL ABP_RUN_INIT, ABP_RUN_SPEC, ABP_RUN_DO - INTEGER STR_SIGLEN, MSG_SET -C - CHARACTER*(*) PROGNAM ! this program - PARAMETER (PROGNAM = 'NFLAG') - CHARACTER*(*) DWFNAM ! DWARF program to be run - PARAMETER (DWFNAM = 'NFLAG') -C -C Command-line syntax definition -C - the first two arguments are always: -C parameter STREAM, default value "" -C qualifier RUNMODE, default value NORMAL -C - up to 8 other qualifiers can be defined -C - INTEGER NRARG ! total nr of arguments [2,10] - PARAMETER (NRARG = 5) - CHARACTER*16 NAME(NRARG) ! argument names - CHARACTER*6 DEFVAL(NRARG) ! default argument values - DATA NAME(1),DEFVAL(1) /'STREAM','""'/ - DATA NAME(2),DEFVAL(2) /'RUNMODE','NORMAL'/ - DATA NAME(3),DEFVAL(3) /'INPUT_SCN_NODE' ,'""'/ - DATA NAME(4),DEFVAL(4) /'SCN_SETS' ,'""'/ - DATA NAME(5),DEFVAL(5) /'LIMIT' ,'""'/ -C -C Define which qualifiers (ie. keywords) -C have to be defined or are optional. -C 0 = ignore -C 1 = required -C 2 = optional -C You can define multiple arrays to let -C it depend on the stream. -C -C - INTEGER SW(NRARG) /0,0,1,1,1/ - INTEGER SWSH(NRARG) /0,0,1,0,0/ - - CHARACTER STREAM*12, RUNMODE*20 - CHARACTER EXEFIL*80 - INTEGER IS - LOGICAL OK -C -C -C Initialise -C - start DWARF control, messenger, -C command-line interpreter, PPD access -C - get full executable spec -C - get stream name and run mode -C - refresh appropriate external defaults -C - OK = ABP_RUN_INIT (PROGNAM,DWFNAM,NRARG,NAME,DEFVAL, - 1 EXEFIL,STREAM,RUNMODE) - IF (.NOT.OK) GOTO 999 -C -C Read all program-specific qualifiers -C and specify them as a symbol. -C Stream RAW does not need the MODEL_NODE. -C - - IF (STREAM(1:5).EQ.'$SHOW') THEN - OK = ABP_RUN_SPEC (DWFNAM,STREAM,SWSH,NAME,NAME,NRARG) - ELSE - OK = ABP_RUN_SPEC (DWFNAM,STREAM,SW,NAME,NAME,NRARG) - ENDIF - IF (.NOT.OK) GOTO 999 -C -C Run DWARF program -C - OK = ABP_RUN_DO (DWFNAM,STREAM,EXEFIL,RUNMODE) - IF (.NOT.OK) GOTO 999 -C -C Only get here if the program was not -C started (dry-run or failed startup) -C - IS = DWC_SUCCESS - GOTO 900 -C - 999 IS = DWC_EXEERRORS - 900 E_C = MSG_SET (IS,0) - END diff --git a/src/dwarf/abpx_nmap.for b/src/dwarf/abpx_nmap.for deleted file mode 100644 index c801cfd5cbf9f0807b774395b380da8e761dff7c..0000000000000000000000000000000000000000 --- a/src/dwarf/abpx_nmap.for +++ /dev/null @@ -1,150 +0,0 @@ -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ -C.Ident: ABPX_NMAP -C.Keywords: Automatic Batch Programming -C.Author: Friso Olnon (NFRA, Dwingeloo) -C.Language: DWARF-Fortran -C.Environment: Alliant -C.Comments: -C.Version: 930729 Yuan Tang - creation -C.Version: 940120 CMV - Changed messenger -C------------------------------------------------------------------------- -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - SUBROUTINE ABPX_NMAP -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' -C -C -C.Purpose: Dry-run or run DWARF program NMAP -C.Returns: Status code to command interpreter -C success DWC_SUCCESS for successfull dry_run -C error DWC_EXEERRORS for dry-run or program-start error -C exit status of program if it has run -C.Notes: -C - The program is invoked via a foreign command with the stream name as -C required parameter. The foreign command automatically includes the -C qualifier /RUNMODE=NORMAL (batch mode), =DEFINE (definition mode) -C or =DRYRUN (check mode). -C# - The available NMAP invocations are: -C#l ABP_NMAP <standard_stream> <required_quals> [<optional_quals>] -C#l one-line description -C#l ABP_NMAP <stream> -C#l use defaults saved in SYS$LOGIN:NMAP$<stream>.sav -C#l ABP_NMAP always accepts the optional qualifiers -C#l /<name>=<value> default value: -C -C - First, the external defaults for the program in the given stream will -C be cleared en restored from the file NMAP$<stream>.sav in ABPDIR -C (for the standard streams) or in the user's login directory (for -C other streams). -C - Then, additional (possibly overriding) defaults will be specified -C according to the chosen stream and the given qualifiers. -C - Finally, DWARF program NMAP will be run in the chosen stream -C unless the runmode is DRYRUN. -C------------------------------------------------------------------------- -C - LOGICAL ABP_RUN_INIT, ABP_RUN_SPEC, ABP_RUN_DO - INTEGER STR_SIGLEN, MSG_SET -C - CHARACTER*(*) PROGNAM ! this program - PARAMETER (PROGNAM = 'NMAP') - CHARACTER*(*) DWFNAM ! DWARF program to be run - PARAMETER (DWFNAM = 'NMAP') -C -C Command-line syntax definition -C - the first two arguments are always: -C parameter STREAM, default value "" -C qualifier RUNMODE, default value NORMAL -C - up to 8 other qualifiers can be defined -C - INTEGER NRARG ! total nr of arguments [2,20] - PARAMETER (NRARG = 19) - CHARACTER*19 NAME(NRARG) ! argument names - CHARACTER*6 DEFVAL(NRARG) ! default argument values - DATA NAME(1),DEFVAL(1) /'STREAM','""'/ - DATA NAME(2),DEFVAL(2) /'RUNMODE','NORMAL'/ - DATA NAME(3),DEFVAL(3) /'SCN_NODE' ,'""'/ - DATA NAME(4),DEFVAL(4) /'OUTPUT_WMP_NODE' ,'""'/ - DATA NAME(5),DEFVAL(5) /'INPUT_MDL_NODE' ,'""'/ - DATA NAME(6),DEFVAL(6) /'SCN_SETS' ,'""'/ - DATA NAME(7),DEFVAL(7) /'SELECT_IFRS','""'/ - DATA NAME(8),DEFVAL(8) /'MAP_POLAR' ,'""'/ - DATA NAME(9),DEFVAL(9) /'REF_COORD' ,'""'/ - DATA NAME(10),DEFVAL(10) /'WMP_NODE_1' ,'""'/ - DATA NAME(11),DEFVAL(11) /'WMP_NODE_2' ,'""'/ - DATA NAME(12),DEFVAL(12) /'FIELD_SIZE' ,'""'/ - DATA NAME(13),DEFVAL(13) /'WMP_SET_1' ,'""'/ - DATA NAME(14),DEFVAL(14) /'OUT_SIZE' ,'""'/ - DATA NAME(15),DEFVAL(15) /'RADEC_CENTRE' ,'""'/ - DATA NAME(16),DEFVAL(16) /'CLIP_LEVELS' ,'""'/ - DATA NAME(17),DEFVAL(17) /'CLIP_AREA' ,'""'/ - DATA NAME(18),DEFVAL(18) /'DELETE_LEVEL' ,'""'/ - DATA NAME(19),DEFVAL(19) /'MAP_FACTORS' ,'""'/ -C -C Define which qualifiers (ie. keywords) -C have to be defined or are optional. -C 0 = ignore -C 1 = required -C 2 = optional -C You can define multiple arrays to let -C it depend on the stream. -C Note that the switches for STREAM and RUNMODE -C are of no interest. -C - INTEGER SWRAW(NRARG) /0,0,1,1,0,1,2,1,1,0,0,1,0,0,0,0,0,0,0/ - INTEGER SWSUB(NRARG) /0,0,1,1,1,1,2,1,1,0,0,1,0,0,0,0,0,1,0/ - INTEGER SWEXT(NRARG) /0,0,0,0,0,0,0,0,0,1,1,0,1,0,0,0,0,0,0/ - INTEGER SWMOS(NRARG) /0,0,0,0,0,0,0,0,0,1,1,0,1,1,1,0,0,0,0/ - INTEGER SWCLIP(NRARG) /0,0,1,1,1,1,2,1,1,0,0,1,0,0,0,1,1,0,0/ - INTEGER SWFACT(NRARG) /0,0,0,0,0,0,0,0,0,1,0,0,1,0,0,0,0,0,1/ -C - CHARACTER STREAM*12, RUNMODE*20 - CHARACTER EXEFIL*80 - INTEGER IS - LOGICAL OK -C -C -C Initialise -C - start DWARF control, messenger, -C command-line interpreter, PPD access -C - get full executable spec -C - get stream name and run mode -C - refresh appropriate external defaults -C - OK = ABP_RUN_INIT (PROGNAM,DWFNAM,NRARG,NAME,DEFVAL, - 1 EXEFIL,STREAM,RUNMODE) - IF (.NOT.OK) GOTO 999 -C -C Read all program-specific qualifiers -C and specify them as a symbol. -C Stream $RAW does not need the MODEL_NODE. -C - IF (STREAM(1:4).EQ.'$RAW' .OR. STREAM.EQ.'$EXTRAW') THEN - OK = ABP_RUN_SPEC (DWFNAM,STREAM,SWRAW,NAME,NAME,NRARG) - ELSE IF (STREAM(1:8).EQ.'$EXTRACT') THEN - OK = ABP_RUN_SPEC (DWFNAM,STREAM,SWEXT,NAME,NAME,NRARG) - ELSE IF (STREAM(1:7).EQ.'$MOSCOM') THEN - OK = ABP_RUN_SPEC (DWFNAM,STREAM,SWMOS,NAME,NAME,NRARG) - ELSE IF (STREAM(1:5).EQ.'$CLIP') THEN - OK = ABP_RUN_SPEC (DWFNAM,STREAM,SWCLIP,NAME,NAME,NRARG) - ELSE IF (STREAM(1:7).EQ.'$FACTOR') THEN - OK = ABP_RUN_SPEC (DWFNAM,STREAM,SWFACT,NAME,NAME,NRARG) - ELSE - OK = ABP_RUN_SPEC (DWFNAM,STREAM,SWSUB,NAME,NAME,NRARG) - ENDIF - IF (.NOT.OK) GOTO 999 -C -C Run DWARF program -C - OK = ABP_RUN_DO (DWFNAM,STREAM,EXEFIL,RUNMODE) - IF (.NOT.OK) GOTO 999 -C Only get here if the program was not -C started (dry-run or failed startup) -C - IS = DWC_SUCCESS - GOTO 900 -C - 999 IS = DWC_EXEERRORS - 900 E_C = MSG_SET (IS,0) - END - diff --git a/src/dwarf/abpx_nmodel.for b/src/dwarf/abpx_nmodel.for deleted file mode 100644 index 4fd1e5ff6a6442c07183827ed8dead554f3305fc..0000000000000000000000000000000000000000 --- a/src/dwarf/abpx_nmodel.for +++ /dev/null @@ -1,165 +0,0 @@ -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ -C.Ident: ABPX_NMODEL -C.Keywords: Automatic Batch Programming -C.Author: Friso Olnon (NFRA, Dwingeloo) -C.Language: DWARF-Fortran -C.Environment: Alliant -C.Comments: -C.Version: 930719 Yuan Tang - creation -C.Version: 940120 CMV - Changed messenger -C------------------------------------------------------------------------- -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - SUBROUTINE ABPX_NMODEL -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' -C -C -C.Purpose: Dry-run or run DWARF program NMODEL -C.Returns: Status code to command interpreter -C success DWC_SUCCESS for successfull dry_run -C error DWC_EXEERRORS for dry-run or program-start error -C exit status of program if it has run -C.Notes: -C - The program is invoked via a foreign command with the stream name as -C required parameter. The foreign command automatically includes the -C qualifier /RUNMODE=NORMAL (batch mode), =DEFINE (definition mode) -C or =DRYRUN (check mode). -C# - The available NMODEL invocations are: -C#l ABP_NMODEL <standard_stream> <required_quals> [<optional_quals>] -C#l one-line description -C#l ABP_NMODEL <stream> -C#l use defaults saved in SYS$LOGIN:NMODEL$<stream>.sav -C#l ABP_NMODEL always accepts the optional qualifiers -C#l /<name>=<value> default value: -C -C - First, the external defaults for the program in the given stream will -C be cleared en restored from the file NMODEL$<stream>.sav in ABPDIR -C (for the standard streams) or in the user's login directory (for -C other streams). -C - Then, additional (possibly overriding) defaults will be specified -C according to the chosen stream and the given qualifiers. -C - Finally, DWARF program NMODEL will be run in the chosen stream -C unless the runmode is DRYRUN. -C------------------------------------------------------------------------- -C - LOGICAL ABP_RUN_INIT, ABP_RUN_SPEC, ABP_RUN_DO - INTEGER STR_SIGLEN, MSG_SET -C - CHARACTER*(*) PROGNAM ! this program - PARAMETER (PROGNAM = 'NMODEL') - CHARACTER*(*) DWFNAM ! DWARF program to be run - PARAMETER (DWFNAM = 'NMODEL') -C -C Command-line syntax definition -C - the first two arguments are always: -C parameter STREAM, default value "" -C qualifier RUNMODE, default value NORMAL -C - up to 8 other qualifiers can be defined -C - INTEGER NRARG ! total nr of arguments [2,20] - PARAMETER (NRARG = 16) - CHARACTER*15 NAME(NRARG) ! argument names - CHARACTER*6 DEFVAL(NRARG) ! default argument values - DATA NAME(1),DEFVAL(1) /'STREAM','""'/ - DATA NAME(2),DEFVAL(2) /'RUNMODE','NORMAL'/ - DATA NAME(3),DEFVAL(3) /'WMP_NODE' ,'""'/ - DATA NAME(4),DEFVAL(4) /'SCN_NODE' ,'""'/ - DATA NAME(5),DEFVAL(5) /'MDL_NODE' ,'""'/ - DATA NAME(6),DEFVAL(6) /'OUTPUT_MDL_NODE','""'/ - DATA NAME(7),DEFVAL(7) /'SCN_SETS' ,'""'/ - DATA NAME(8),DEFVAL(8) /'SELECT_IFRS','""'/ - DATA NAME(9), DEFVAL(9) /'REF_SCN_NODE','""'/ - DATA NAME(10),DEFVAL(10) /'REF_SCN_SET', '""'/ - DATA NAME(11),DEFVAL(11) /'REFERENCE_DATA','""'/ - DATA NAME(12),DEFVAL(12) /'MAX_NUMBER' ,'""'/ - DATA NAME(13),DEFVAL(13) /'SOURCE_FACTORS','""'/ - DATA NAME(14),DEFVAL(14) /'DELETE_AREA','""'/ - DATA NAME(15),DEFVAL(15) /'DELETE_LEVEL','""'/ - DATA NAME(16),DEFVAL(16) /'INPUT_MDL_NODE','""'/ -C -C Define which qualifiers (ie. keywords) -C have to be defined or are optional. -C 0 = ignore -C 1 = required -C 2 = optional -C You can define multiple arrays to let -C it depend on the stream. -C - INTEGER SWFIND(NRARG) /0,0,1,0,0,1,0,0,0,0,0,1,0,0,1,1/ - INTEGER SWFFIND(NRARG) /0,0,1,0,0,1,0,0,0,0,0,1,0,0,1,0/ - INTEGER SWUPD(NRARG) /0,0,0,1,0,1,1,2,0,0,0,0,0,0,1,1/ - INTEGER SWLIST1(NRARG) /0,0,0,0,0,1,0,0,0,0,0,0,0,0,1,1/ - INTEGER SWLIST2(NRARG) /0,0,0,0,1,0,0,0,1,1,1,0,0,0,0,0/ - INTEGER SWSHIFT(NRARG) /0,0,0,0,0,1,0,0,0,0,0,0,1,0,0,1/ - INTEGER SWFLUX(NRARG) /0,0,0,0,0,1,0,0,0,0,0,0,1,0,1,1/ - INTEGER SWCONVT(NRARG) /0,0,0,0,1,0,0,0,0,0,1,0,0,0,0,0/ - INTEGER SWCOMB(NRARG) /0,0,0,0,0,1,0,0,0,0,0,0,0,0,0,1/ - INTEGER SWDAREA(NRARG) /0,0,0,0,0,1,0,0,0,0,0,0,0,1,0,1/ - INTEGER SWMODLOG(NRARG)/0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1/ - INTEGER SWUPD7CH(NRARG)/0,0,0,1,0,1,1,0,0,0,0,0,0,0,1,1/ -C - CHARACTER STREAM*12, RUNMODE*20 - CHARACTER EXEFIL*80 - INTEGER IS - LOGICAL OK -C -C -C Initialise -C - start DWARF control, messenger, -C command-line interpreter, PPD access -C - get full executable spec -C - get stream name and run mode -C - refresh appropriate external defaults -C - OK = ABP_RUN_INIT (PROGNAM,DWFNAM,NRARG,NAME,DEFVAL, - 1 EXEFIL,STREAM,RUNMODE) - IF (.NOT.OK) GOTO 999 -C -C Read all program-specific qualifiers -C and specify them as a symbol. -C - IF (STREAM(1:5).EQ.'$FIND') THEN - OK = ABP_RUN_SPEC (DWFNAM,STREAM,SWFIND,NAME,NAME,NRARG) - ELSE IF (STREAM(1:6).EQ.'$FFIND') THEN - OK = ABP_RUN_SPEC (DWFNAM,STREAM,SWFFIND,NAME,NAME,NRARG) - ELSE IF (STREAM(1:6).EQ.'$LIST1') THEN - OK=ABP_RUN_SPEC(DWFNAM,STREAM,SWLIST1,NAME,NAME,NRARG) - ELSE IF (STREAM(1:6).EQ.'$LIST2') THEN - OK=ABP_RUN_SPEC(DWFNAM,STREAM,SWLIST2,NAME,NAME,NRARG) - ELSE IF (STREAM(1:6).EQ.'$SHIFT') THEN - OK=ABP_RUN_SPEC(DWFNAM,STREAM,SWSHIFT,NAME,NAME,NRARG) - ELSE IF (STREAM(1:9).EQ.'$CALIFLUX') THEN - OK=ABP_RUN_SPEC(DWFNAM,STREAM,SWFLUX,NAME,NAME,NRARG) - ELSE IF (STREAM(1:8).EQ.'$CONVERT') THEN - OK=ABP_RUN_SPEC(DWFNAM,STREAM,SWCONVT,NAME,NAME,NRARG) - ELSE IF (STREAM(1:5).EQ.'$COMB' .OR. STREAM.EQ.'$SEPARA') - 1 THEN - OK=ABP_RUN_SPEC(DWFNAM,STREAM,SWCOMB,NAME,NAME,NRARG) - ELSE IF (STREAM(1:6).EQ.'$DAREA') THEN - OK=ABP_RUN_SPEC(DWFNAM,STREAM,SWDAREA,NAME,NAME,NRARG) - ELSE IF (STREAM(1:7).EQ.'$MODLOG') THEN - OK=ABP_RUN_SPEC(DWFNAM,STREAM,SWMODLOG,NAME,NAME,NRARG) - ELSE IF (STREAM(1:7).EQ.'$UPD7CH') THEN - OK=ABP_RUN_SPEC(DWFNAM,STREAM,SWUPD7CH,NAME,NAME,NRARG) - ELSE - OK=ABP_RUN_SPEC (DWFNAM,STREAM,SWUPD ,NAME,NAME,NRARG) - ENDIF - IF (.NOT.OK) GOTO 999 - -C -C Run DWARF program -C - OK = ABP_RUN_DO (DWFNAM,STREAM,EXEFIL,RUNMODE) - IF (.NOT.OK) GOTO 999 -C -C Only get here if the program was not -C started (dry-run or failed startup) -C - IS = DWC_SUCCESS - GOTO 900 -C -C - 999 IS = DWC_EXEERRORS - 900 E_C = MSG_SET (IS,0) - END diff --git a/src/dwarf/abpx_nplot.for b/src/dwarf/abpx_nplot.for deleted file mode 100644 index 5f134670d274a9d9fa721b52e5fa4aa4f68d81b1..0000000000000000000000000000000000000000 --- a/src/dwarf/abpx_nplot.for +++ /dev/null @@ -1,123 +0,0 @@ -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ -C.Ident: ABPX_NPLOT -C.Keywords: Automatic Batch Programming -C.Author: Friso Olnon (NFRA, Dwingeloo) -C.Language: DWARF-Fortran -C.Environment: Alliant -C.Comments: -C.Version: 911206 GvD - creation -C.Version: 940120 CMV - Changed messenger -C------------------------------------------------------------------------- -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - SUBROUTINE ABPX_NPLOT -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' -C -C -C.Purpose: Dry-run or run DWARF program NMAP -C.Returns: Status code to command interpreter -C success DWC_SUCCESS for successfull dry_run -C error DWC_EXEERRORS for dry-run or program-start error -C exit status of program if it has run -C.Notes: -C - The program is invoked via a foreign command with the stream name as -C required parameter. The foreign command automatically includes the -C qualifier /RUNMODE=NORMAL (batch mode), =DEFINE (definition mode) -C or =DRYRUN (check mode). -C# - The available NMAP invocations are: -C#l ABP_NMAP <standard_stream> <required_quals> [<optional_quals>] -C#l one-line description -C#l ABP_NMAP <stream> -C#l use defaults saved in SYS$LOGIN:NMAP$<stream>.sav -C#l ABP_NMAP always accepts the optional qualifiers -C#l /<name>=<value> default value: -C -C - First, the external defaults for the program in the given stream will -C be cleared en restored from the file NMAP$<stream>.sav in ABPDIR -C (for the standard streams) or in the user's login directory (for -C other streams). -C - Then, additional (possibly overriding) defaults will be specified -C according to the chosen stream and the given qualifiers. -C - Finally, DWARF program NMAP will be run in the chosen stream -C unless the runmode is DRYRUN. -C------------------------------------------------------------------------- -C - LOGICAL ABP_RUN_INIT, ABP_RUN_SPEC, ABP_RUN_DO - INTEGER STR_SIGLEN, MSG_SET -C - CHARACTER*(*) PROGNAM ! this program - PARAMETER (PROGNAM = 'NPLOT') - CHARACTER*(*) DWFNAM ! DWARF program to be run - PARAMETER (DWFNAM = 'NPLOT') -C -C Command-line syntax definition -C - the first two arguments are always: -C parameter STREAM, default value "" -C qualifier RUNMODE, default value NORMAL -C - up to 8 other qualifiers can be defined -C - INTEGER NRARG ! total nr of arguments [2,20] - PARAMETER (NRARG = 8) - CHARACTER*16 NAME(NRARG) ! argument names - CHARACTER*6 DEFVAL(NRARG) ! default argument values - DATA NAME(1),DEFVAL(1) /'STREAM','""'/ - DATA NAME(2),DEFVAL(2) /'RUNMODE','NORMAL'/ - DATA NAME(3),DEFVAL(3) /'MAP_NODE' ,'""'/ - DATA NAME(4),DEFVAL(4) /'SETS' ,'""'/ - DATA NAME(5),DEFVAL(5) /'MODEL_NODE' ,'""'/ - DATA NAME(6),DEFVAL(6) /'FULL_CONT' ,'""'/ - DATA NAME(7),DEFVAL(7) /'DOT_CONT' ,'""'/ - DATA NAME(8),DEFVAL(8) /'COORD' ,'""'/ -C -C Define which qualifiers (ie. keywords) -C have to be defined or are optional. -C 0 = ignore -C 1 = required -C 2 = optional -C You can define multiple arrays to let -C it depend on the stream. -C Note that the switches for STREAM and RUNMODE -C are of no interest. -C - INTEGER SWPLOT(NRARG) /0,0,1,1,1,1,1,1/ -C - CHARACTER STREAM*12, RUNMODE*20 - CHARACTER EXEFIL*80 - INTEGER IS - LOGICAL OK -C -C -C Initialise -C - start DWARF control, messenger, -C command-line interpreter, PPD access -C - get full executable spec -C - get stream name and run mode -C - refresh appropriate external defaults -C - OK = ABP_RUN_INIT (PROGNAM,DWFNAM,NRARG,NAME,DEFVAL, - 1 EXEFIL,STREAM,RUNMODE) - IF (.NOT.OK) GOTO 999 -C -C Read all program-specific qualifiers -C and specify them as a symbol. -C Stream $RAW does not need the MODEL_NODE. -C - IF (STREAM.EQ.'$PLOT') THEN - OK = ABP_RUN_SPEC (DWFNAM,STREAM,SWPLOT,NAME,NAME,NRARG) - ENDIF - IF (.NOT.OK) GOTO 999 -C -C Run DWARF program -C - OK = ABP_RUN_DO (DWFNAM,STREAM,EXEFIL,RUNMODE) - IF (.NOT.OK) GOTO 999 -C Only get here if the program was not -C started (dry-run or failed startup) -C - IS = DWC_SUCCESS - GOTO 900 -C - 999 IS = DWC_EXEERRORS - 900 E_C = MSG_SET (IS,0) - END diff --git a/src/dwarf/abpx_nscan.for b/src/dwarf/abpx_nscan.for deleted file mode 100644 index 6e442a9a902cc0c25a07257c320cbcf517d2c10b..0000000000000000000000000000000000000000 --- a/src/dwarf/abpx_nscan.for +++ /dev/null @@ -1,124 +0,0 @@ -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ -C.Ident: ABPX_NSCAN -C.Keywords: Automatic Batch Programming -C.Author: Friso Olnon (NFRA, Dwingeloo) -C.Language: DWARF-Fortran -C.Environment: Alliant -C.Comments: -C.Version: 921216 Yuan Tang - creation -C.Version: 940120 CMV - Changed messenger -C------------------------------------------------------------------------- -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - SUBROUTINE ABPX_NSCAN -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' -C -C -C.Purpose: Dry-run or run DWARF program NSCAN -C.Returns: Status code to command interpreter -C success DWC_SUCCESS for successfull dry_run -C error DWC_EXEERRORS for dry-run or program-start error -C exit status of program if it has run -C.Notes: -C - The program is invoked via a foreign command with the stream name as -C required parameter. The foreign command automatically includes the -C qualifier /RUNMODE=NORMAL (batch mode), =DEFINE (definition mode) -C or =DRYRUN (check mode). -C# - The available NSCAN invocations are: -C#l ABP_NSCAN <standard_stream> <required_quals> [<optional_quals>] -C#l one-line description -C#l ABP_NSCAN <stream> -C#l use defaults saved in SYS$LOGIN:NSCAN$<stream>.sav -C#l ABP_NSCAN always accepts the optional qualifiers -C#l /<name>=<value> default value: -C -C - First, the external defaults for the program in the given stream will -C be cleared en restored from the file NSCAN$<stream>.sav in ABPDIR -C (for the standard streams) or in the user's login directory (for -C other streams). -C - Then, additional (possibly overriding) defaults will be specified -C according to the chosen stream and the given qualifiers. -C - Finally, DWARF program NSCAN will be run in the chosen stream -C unless the runmode is DRYRUN. -C------------------------------------------------------------------------- -C - LOGICAL ABP_RUN_INIT, ABP_RUN_SPEC, ABP_RUN_DO - INTEGER STR_SIGLEN, MSG_SET -C - CHARACTER*(*) PROGNAM ! this program - PARAMETER (PROGNAM = 'NSCAN') - CHARACTER*(*) DWFNAM ! DWARF program to be run - PARAMETER (DWFNAM = 'NSCAN') -C -C Command-line syntax definition -C - the first two arguments are always: -C parameter STREAM, default value "" -C qualifier RUNMODE, default value NORMAL -C - up to 8 other qualifiers can be defined -C - INTEGER NRARG ! total nr of arguments [2,10] - PARAMETER (NRARG = 5) - CHARACTER*16 NAME(NRARG) ! argument names - CHARACTER*6 DEFVAL(NRARG) ! default argument values - DATA NAME(1),DEFVAL(1) /'STREAM','""'/ - DATA NAME(2),DEFVAL(2) /'RUNMODE','NORMAL'/ - DATA NAME(3),DEFVAL(3) /'INPUT_SCAN' ,'""'/ - DATA NAME(4),DEFVAL(4) /'SETS' ,'""'/ - DATA NAME(5),DEFVAL(5) /'LIMIT' ,'""'/ -C -C Define which qualifiers (ie. keywords) -C have to be defined or are optional. -C 0 = ignore -C 1 = required -C 2 = optional -C You can define multiple arrays to let -C it depend on the stream. -C -C - INTEGER SW(NRARG) /0,0,1,1,1/ - INTEGER SWSH(NRARG) /0,0,1,0,0/ - - CHARACTER STREAM*12, RUNMODE*20 - CHARACTER EXEFIL*80 - INTEGER IS - LOGICAL OK -C -C -C Initialise -C - start DWARF control, messenger, -C command-line interpreter, PPD access -C - get full executable spec -C - get stream name and run mode -C - refresh appropriate external defaults -C - OK = ABP_RUN_INIT (PROGNAM,DWFNAM,NRARG,NAME,DEFVAL, - 1 EXEFIL,STREAM,RUNMODE) - IF (.NOT.OK) GOTO 999 -C -C Read all program-specific qualifiers -C and specify them as a symbol. -C Stream RAW does not need the MODEL_NODE. -C - - IF (STREAM(1:5).EQ.'$SHOW') THEN - OK = ABP_RUN_SPEC (DWFNAM,STREAM,SWSH,NAME,NAME,NRARG) - ELSE - OK = ABP_RUN_SPEC (DWFNAM,STREAM,SW,NAME,NAME,NRARG) - ENDIF - IF (.NOT.OK) GOTO 999 -C -C Run DWARF program -C - OK = ABP_RUN_DO (DWFNAM,STREAM,EXEFIL,RUNMODE) - IF (.NOT.OK) GOTO 999 -C -C Only get here if the program was not -C started (dry-run or failed startup) -C - IS = DWC_SUCCESS - GOTO 900 -C - 999 IS = DWC_EXEERRORS - 900 IS = MSG_SET (IS,0) - END diff --git a/src/dwarf/blbcompare.for b/src/dwarf/blbcompare.for deleted file mode 100644 index 5cd1e91bc7dea18086a53db22406820c8f606ce4..0000000000000000000000000000000000000000 --- a/src/dwarf/blbcompare.for +++ /dev/null @@ -1,137 +0,0 @@ -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ -C.Ident: BLB_COMPARE -C.Keywords: Block of Bytes, Compare -C.Author: Friso Olnon (NFRA, Dwingeloo) -C.Language: DWARF-Fortran -C.Environment: VAX or Alliant -C.Comments: -C.Version: 890111 FMO - creation -C.Version: 980112 FMO - added BLB_COMPAR1 -C.Version: 920214 GvD - no optional arguments in MSG anymore -C------------------------------------------------------------------------- -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - INTEGER*4 FUNCTION BLB_COMPARE (VAL1,VAL2,DTYPE,LENG) -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' -C - BYTE VAL1(*) ! (i) first value - BYTE VAL2(*) ! (i) second value - CHARACTER*1 DTYPE ! (i) datatype code (B,I,J,R,D,C,L) - INTEGER*4 LENG ! (i) length of C_type value -C -C.Purpose: Compare two values of the given type -C.Returns: 1 (VAL1=VAL2), 0 (VAL1<VAL2) , or 2 (VAL1>VAL2) -C.Notes: -C Logical values (type 'L') are assumed to be 1 byte long; only the least -C significant bit is tested. If these are not equal, 0 will be returned. -C------------------------------------------------------------------------- -C - INTEGER*4 MOVE_BLB, MOVE_BLI, MOVE_BLJ, MOVE_BLR, MOVE_BLD -C - INTEGER*4 IS - INTEGER*2 II1, II2 - REAL*4 R2 - DOUBLE PRECISION D2 - CHARACTER*256 C1, C2 -C -C - IF (DTYPE.EQ.'B') THEN - IF (VAL1(1).LT.VAL2(1)) GOTO 900 - IF (VAL1(1).GT.VAL2(1)) GOTO 902 - ELSE IF (DTYPE.EQ.'I') THEN - IS = MOVE_BLI (VAL1,II1,1) - IS = MOVE_BLI (VAL2,II2,1) - IF (II1.LT.II2) GOTO 900 - IF (II1.GT.II2) GOTO 902 - ELSE IF (DTYPE.EQ.'J') THEN - IS = MOVE_BLJ (VAL1,J1,1) - IS = MOVE_BLJ (VAL2,J2,1) - IF (J1.LT.J2) GOTO 900 - IF (J1.GT.J2) GOTO 902 - ELSE IF (DTYPE.EQ.'R') THEN - IS = MOVE_BLR (VAL1,R1,1) - IS = MOVE_BLR (VAL2,R2,1) - IF (R1.LT.R2) GOTO 900 - IF (R1.GT.R2) GOTO 902 - ELSE IF (DTYPE.EQ.'D') THEN - IS = MOVE_BLD (VAL1,D1,1) - IS = MOVE_BLD (VAL2,D2,1) - IF (D1.LT.D2) GOTO 900 - IF (D1.GT.D2) GOTO 902 - ELSE IF (DTYPE.EQ.'C') THEN - IS = MOVE_BLB (VAL1,%REF(C1),LENG) - IS = MOVE_BLB (VAL2,%REF(C2),LENG) - IF (C1.LT.C2) GOTO 900 - IF (C1.GT.C2) GOTO 902 - ELSE IF (DTYPE.EQ.'L') THEN - IF (VAL1(1)-VAL2(1)) GOTO 900 - ELSE - CALL WNCTXT(DWLOG,'Invalid datatype code in BLB_COMPARE') - CALL WNGEX - ENDIF -C - BLB_COMPARE = 1 - RETURN -C - 900 BLB_COMPARE = 0 - RETURN -C - 902 BLB_COMPARE = 2 - RETURN - END -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - INTEGER*4 FUNCTION BLB_COMPAR1 (VAL,DTYPE) -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' -C - BYTE VAL(*) ! (i) value - CHARACTER*1 DTYPE ! (i) datatype code (B,I,J,R,D) -C -C.Purpose: Compare numerical value with 1 -C.Returns: 1 (VAL = 1), 0 (VAL < 1) , or 2 (VAL > 1) -C.Notes: -C------------------------------------------------------------------------- -C - INTEGER*4 MOVE_BLI, MOVE_BLJ, MOVE_BLR, MOVE_BLD -C - INTEGER*4 IS - INTEGER*2 II - REAL*4 R - REAL*8 D -C -C - IF (DTYPE.EQ.'B') THEN - IF (VAL(1).LT.1) GOTO 900 - IF (VAL(1).GT.1) GOTO 902 - ELSE IF (DTYPE.EQ.'I') THEN - IS = MOVE_BLI (VAL,II,1) - IF (II.LT.1) GOTO 900 - IF (II.GT.1) GOTO 902 - ELSE IF (DTYPE.EQ.'J') THEN - IS = MOVE_BLJ (VAL,J,1) - IF (J.LT.1) GOTO 900 - IF (J.GT.1) GOTO 902 - ELSE IF (DTYPE.EQ.'R') THEN - IS = MOVE_BLR (VAL,R,1) - IF (R.LT.1.0) GOTO 900 - IF (R.GT.1.0) GOTO 902 - ELSE IF (DTYPE.EQ.'D') THEN - IS = MOVE_BLD (VAL,D,1) - IF (D.LT.1.D0) GOTO 900 - IF (D.GT.1.D0) GOTO 902 - ELSE - CALL WNCTXT(DWLOG,'Invalid datatype code in BLB_COMPAR1') - CALL WNGEX - ENDIF -C - BLB_COMPAR1 = 1 - RETURN -C - 900 BLB_COMPAR1 = 0 - RETURN -C - 902 BLB_COMPAR1 = 2 - RETURN - END diff --git a/src/dwarf/bldppd_2.def b/src/dwarf/bldppd_2.def deleted file mode 100644 index 85cd696286de15ac7b0046a781d585bfa91fc9c0..0000000000000000000000000000000000000000 --- a/src/dwarf/bldppd_2.def +++ /dev/null @@ -1,133 +0,0 @@ -C Include module BLDPPD_2 -C Created by BLDDEF from: _$1$DIA3:[TESTDWARF.SRC.DEF]BLDPPD.DEF; on 17-OCT-90 -C -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ -C.Ident: DEF_BLDPPD -C.Keywords: PPD File, Build -C.Author: Kasper Kombrink (NFRA, Dwingeloo) -C.Language: DWARF-DEF -C.Environment: VAX -C.Comments: -C.Version: 850320 KK - version 1 -C.Version: 881222 FMO - version 2, complete revision -C - removed declarations of PIN-file keywords, checks, -C attributes, search codes, io codes and data types -C - definition of CPL field nrs taken from PPD.DEF -C-------------------------------------------------------------------- -C -C Symbolic names for field numbers in CPL's work buffer -C Each field contains the corresponding part of the definition -C of a program parameter -C -C - INTEGER*4 W_UNAM - PARAMETER (W_UNAM =1) !user's name (keyword) - INTEGER*4 W_COPY - PARAMETER (W_COPY =2) !internal or external reference - INTEGER*4 W_PNAM - PARAMETER (W_PNAM =3) !program's name - INTEGER*4 W_DTYPE - PARAMETER (W_DTYPE =4) !data type - INTEGER*4 W_IOCD - PARAMETER (W_IOCD =5) !I/O type - INTEGER*4 W_PLEN - PARAMETER (W_PLEN =6) !length of a single value in bytes - INTEGER*4 W_NVAL - PARAMETER (W_NVAL =7) !nr of values per set - INTEGER*4 W_NSETS - PARAMETER (W_NSETS =8) !nr of sets - INTEGER*4 W_MNVAL - PARAMETER (W_MNVAL =9) !minimum nr of values per set - INTEGER*4 W_MXVAL - PARAMETER (W_MXVAL =10) !maximum nr of values per set - INTEGER*4 W_CMAS - PARAMETER (W_CMAS =11) !checks on values - INTEGER*4 W_AMAS - PARAMETER (W_AMAS =12) !attributes - INTEGER*4 W_MIN - PARAMETER (W_MIN =13) !minimum values - INTEGER*4 W_MAX - PARAMETER (W_MAX =14) !maximum values - INTEGER*4 W_USTR - PARAMETER (W_USTR =15) !units - INTEGER*4 W_SSTR - PARAMETER (W_SSTR =16) !search strategy for defaults - INTEGER*4 W_DVSTR - PARAMETER (W_DVSTR =17) !default value(s) - INTEGER*4 W_OPSTR - PARAMETER (W_OPSTR =18) !options - INTEGER*4 W_PRSTR - PARAMETER (W_PRSTR =19) !prompt string - INTEGER*4 W_GSTR - PARAMETER (W_GSTR =20) !group name (for global search) - INTEGER*4 W_HSTR - PARAMETER (W_HSTR =21) !help string -C -C -C Definition of control common /BLDPPD/ -C -C - INTEGER*4 BPD__REFMAX - PARAMETER (BPD__REFMAX =64) !max number of external references -C - INTEGER*4 BPD_LENGTH - PARAMETER (BPD_LENGTH =1) !&1 !#J !generated: field to contain the block length - INTEGER*4 BPD_TYPE - PARAMETER (BPD_TYPE =2) !&1 !#J !generated: field to contain the block type - INTEGER*4 BPD_REFNR - PARAMETER (BPD_REFNR =1) !&1 !#J !number of external references - INTEGER*4 BPD_REFNAM - PARAMETER (BPD_REFNAM =2) !&1024 !#C !names of referenced PPD files -C -C Status-arrays for the dynamic buffers used by BLDPPD -C -C (1) = extend size (bytes) -C (2) = size of dynamic buffer (0 if not yet allocated) -C (3) = virtual address of dynamic buffer -C (4) = number of bytes written -C (5) = number of entries written -C (6) = offset of last written entry -C - INTEGER*4 BPD_INDEX - PARAMETER (BPD_INDEX =258) !&6 !#J !status array for the index buffer - INTEGER*4 BPD_PARM - PARAMETER (BPD_PARM =264) !&6 !#J !same for the parameter descr buffer - INTEGER*4 BPD_PROT - PARAMETER (BPD_PROT =270) !&6 !#J !same for the prototype descr buffer - INTEGER*4 BPD_HELP - PARAMETER (BPD_HELP =276) !&6 !#J !same for the help buffer - INTEGER*4 BPD__LENGTH - PARAMETER (BPD__LENGTH =281) !generated: block length (in longwords) - INTEGER*4 BPD__TYPE - PARAMETER (BPD__TYPE =32) !generated: block type - INTEGER*4 BLDPPD__DEFTYP - PARAMETER (BLDPPD__DEFTYP=23) - INTEGER*4 BLDPPD__DEFVSN - PARAMETER (BLDPPD__DEFVSN=2) -C - EXTERNAL BLDPPD_BLOCK -C -C Common block specification -C - INTEGER*4 BPD$LENGTH - EQUIVALENCE (BPD$LENGTH,BPD__(0)) - INTEGER*4 BPD$TYPE - EQUIVALENCE (BPD$TYPE,BPD__(4)) - INTEGER*4 BPD$REFNR - EQUIVALENCE (BPD$REFNR,BPD__(0)) - CHARACTER*16 BPD$REFNAM(64) - EQUIVALENCE (BPD$REFNAM,BPD__(4)) - INTEGER*4 BPD$INDEX(6) - EQUIVALENCE (BPD$INDEX,BPD__(1028)) - INTEGER*4 BPD$PARM(6) - EQUIVALENCE (BPD$PARM,BPD__(1052)) - INTEGER*4 BPD$PROT(6) - EQUIVALENCE (BPD$PROT,BPD__(1076)) - INTEGER*4 BPD$HELP(6) - EQUIVALENCE (BPD$HELP,BPD__(1100)) - BYTE BPD__(0:1123) - INTEGER*4 BPD_(281) - EQUIVALENCE (BPD_,BPD__) -C - COMMON /BLDPPD/ BPD_ -C diff --git a/src/dwarf/bldppdblock.for b/src/dwarf/bldppdblock.for deleted file mode 100644 index a1e010084ee14ae2f9b33e9fc200477ce29da7d6..0000000000000000000000000000000000000000 --- a/src/dwarf/bldppdblock.for +++ /dev/null @@ -1,25 +0,0 @@ - BLOCK DATA BLDPPD_BLOCK -C Created by BLDDEF from: _$1$DIA3:[TESTDWARF.SRC.DEF]BLDPPD.DEF; on 17-OCT-90 -C HjV 921208 Removed all equivalence and add names to common block -C AXC 010907 LinuxPort - data initialisation -C - INTEGER*4 BPD$LENGTH - INTEGER*4 BPD$TYPE - INTEGER*4 BPD$REFNR - CHARACTER*16 BPD$REFNAM(64) - INTEGER*4 BPD$INDEX(6) - INTEGER*4 BPD$PARM(6) - INTEGER*4 BPD$PROT(6) - INTEGER*4 BPD$HELP(6) -C - COMMON /BLDPPD/ BPD$REFNR, BPD$REFNAM, BPD$INDEX, BPD$PARM, - * BPD$PROT, BPD$HELP -C -C - DATA BPD$REFNR /0/ - DATA BPD$INDEX /2048,5*0/ - DATA BPD$PARM /4096,5*0/ - DATA BPD$PROT /4096,5*0/ - DATA BPD$HELP /2048,5*0/ - - END diff --git a/src/dwarf/bpdbuild.for b/src/dwarf/bpdbuild.for deleted file mode 100644 index 3cde53d8a3f085dbe00d30d3dc38f3fff72899bf..0000000000000000000000000000000000000000 --- a/src/dwarf/bpdbuild.for +++ /dev/null @@ -1,551 +0,0 @@ -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ -C.Ident: BPD_BUILD -C.Keywords: PPD File, Build, Parameter Description -C.Author: Friso Olnon (NFRA, Dwingeloo) -C.Language: DWARF-Fortran -C.Environment: VAX or Alliant -C.Comments: -C.Version: 900415 FMO - recreation -C.Version: 920115 GvD - call PPD_MAX_XGET with %REF(VALUE) iso. VALUE -C.Version: 930427 HjV - Change size VALUE from 2000 to 2500 -C.Version: 930613 HjV - Change size VALUE from 2500 to 5000 -C.Version: 930923 CMV - logical names for new maintenance system -C.Version: 940829 HjV - Change size VALUE from 5000 to 10000 -C------------------------------------------------------------------------- -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - INTEGER*4 FUNCTION BPD_BUILD (PROGNAM,PASSNR,DO_UPDATE) -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' -C - CHARACTER*(*) PROGNAM ! (i) program name - INTEGER*4 PASSNR ! (i) compilation pass number - LOGICAL*4 DO_UPDATE ! (i) update mode ? -C -C.Purpose: Build the program-parameter description -C.Returns: Status code (.TRUE. for success, .FALSE. otherwise) -C success PPD_SUCCESS -C info PPD_INTREF internal reference found in first pass -C false status codes returned by referenced routines -C.Notes: -C For each description field: -C - Get the specification from the CPL work buffer (function CPL_WRK_GET). -C - If nothing is specified and COPY is active, the template will be used -C and only the consistency checks will be performed. -C - Check whether the specification is valid and consistent with the other -C fields, and store it in the description array PPDPD_. These actions -C are performed by the functions PPD_<field_name>_PUT. -C - In case of syntax errors, the error code and the appropriate source- -C line nr are stored in the error buffer (CPL_ERR_PUT). The rest of the -C fields will still be analysed. -C - For all other errors (like buffer overflows) the function returns -C immediately with an error status. -C -C NOTE: The order in which the fields are analysed is important for the -C consistency checking. -C------------------------------------------------------------------------- -C - INCLUDE 'BLDPPD_2_DEF' -C - CHARACTER*(*) COLON - PARAMETER (COLON = ':') -C - INTEGER*4 CPL_WRK_GET, CPL_ERR_PUT - INTEGER*4 BPD_REF_UPDATE - INTEGER*4 PPD_INIT, PPD_EXIT, PPD_READ_U - INTEGER*4 PPD_LENG_INIT - INTEGER*4 PPD_UNAM_PUT, PPD_PNAM_PUT, PPD_CMAS_PUT - INTEGER*4 PPD_AMAS_PUT, PPD_IOCD_PUT, PPD_DTYPE_PUT - INTEGER*4 PPD_PLEN_PUT, PPD_NSETS_PUT, PPD_NVAL_PUT - INTEGER*4 PPD_MNVAL_PUT, PPD_MXVAL_PUT - INTEGER*4 PPD_MIN_XGET, PPD_MIN_PUT - INTEGER*4 PPD_MAX_XGET, PPD_MAX_PUT - INTEGER*4 PPD_USTR_XGET, PPD_USTR_PUT - INTEGER*4 PPD_SSTR_XGET, PPD_SSTR_PUT - INTEGER*4 PPD_DVSTR_XGET, PPD_DVSTR_PUT - INTEGER*4 PPD_OPSTR_XGET, PPD_OPSTR_PUT - INTEGER*4 PPD_PRSTR_XGET, PPD_PRSTR_PUT - INTEGER*4 PPD_HSTR_XGET, PPD_HSTR_PUT - INTEGER*4 STR_SIGLEN -C - CHARACTER VALUE*10000 - CHARACTER*16 PPDREF, UNAMREF, GROUP - INTEGER*4 LVAL, LPREF, LUREF, LGRP - INTEGER*4 LNR, LNRCOPY, NSEP - INTEGER*4 IS, REFIS, TMP - LOGICAL*4 DO_CHECK, DO_COPY, IS_EXTREF -C -C -C -C COPY -C ==== -C - DO_COPY = .FALSE. - IS = CPL_WRK_GET (W_COPY,LNRCOPY,VALUE,LVAL) - IF (IAND(IS,1).EQ.0) GOTO 999 -C - IF (LVAL.GT.0) THEN - NSEP = INDEX (VALUE(:LVAL),COLON) - IS_EXTREF = NSEP.GT.1 -C -C Internal reference -C - if 1st pass: postpone the processing -C of this parameter till the 2nd pass -C - if 2nd pass: handle as "external" -C reference to the 1st-pass PPD file -C - IF (.NOT.IS_EXTREF) THEN - IF (PASSNR.EQ.1) THEN - BPD_BUILD = PPD_INTREF - RETURN - ELSE - PPDREF = PROGNAM - LPREF = STR_SIGLEN (PROGNAM) - UNAMREF = VALUE(NSEP+1:LVAL) - LUREF = STR_SIGLEN (UNAMREF) - ENDIF -C -C External reference: -C - get the names of the referenced -C PPD file and program parameter -C - ELSE - PPDREF = VALUE(:NSEP-1) - LPREF = STR_SIGLEN (PPDREF) - IF (NSEP.LT.LVAL) THEN - UNAMREF = VALUE(NSEP+1:LVAL) - ELSE - IS = CPL_WRK_GET (W_UNAM,LNR,VALUE,LVAL) - UNAMREF = VALUE(:LVAL) - ENDIF - LUREF = STR_SIGLEN (UNAMREF) - ENDIF -C -C Get referenced parameter description -C - open the referenced PPD file (it must -C exist in n_exe for an update) -C - copy the relevant parameter -C description into PPDPD_ -C - set the DO_COPY flag -C - update the list of references -C - REFIS = PPD_INIT (PPDREF(:LPREF)) - IF (IAND(REFIS,1).NE.0) THEN - IS = PPD_READ_U (UNAMREF(:LUREF)) - IF (IAND(IS,1).NE.0) THEN - DO_COPY = .TRUE. - IF (IS_EXTREF) THEN - IF (DO_UPDATE .AND. REFIS.NE.1) - 1 IS = CPL_ERR_PUT (PPD_PPDNOTFND,LNRCOPY) - IF (IAND(IS,1).NE.0) - 1 IS = BPD_REF_UPDATE (PPDREF(:LPREF)//COLON) - ENDIF - ELSE - TMP = PPD_EXIT () - IS = CPL_ERR_PUT (IS,LNRCOPY) - ENDIF - ELSE - IS = CPL_ERR_PUT (REFIS,LNRCOPY) - ENDIF - IF (IAND(IS,1).EQ.0) GOTO 999 - ENDIF -C -C - IS = PPD_LENG_INIT () -C -C USER'S NAME (KEYWORD) -C ===================== -C - IS = CPL_WRK_GET (W_UNAM,LNR,VALUE,LVAL) - IF (IAND(IS,1).EQ.0) GOTO 999 -C - DO_CHECK = .TRUE. - IS = PPD_UNAM_PUT (VALUE(:LVAL),DO_CHECK) - IF (IAND(IS,1).EQ.0) THEN - IS = CPL_ERR_PUT (IS,LNR) - IF (IAND(IS,1).EQ.0) GOTO 999 - ENDIF -C -C PROGRAM'S NAME -C ============== -C (after UNAM) -C - IS = CPL_WRK_GET (W_PNAM,LNR,VALUE,LVAL) - IF (IAND(IS,1).EQ.0) GOTO 999 -C - DO_CHECK = .TRUE. - IS = PPD_PNAM_PUT (VALUE(:LVAL),DO_CHECK) - IF (IAND(IS,1).EQ.0) THEN - IS = CPL_ERR_PUT (IS,LNR) - IF (IAND(IS,1).EQ.0) GOTO 999 - ENDIF -C -C -C CHECKS -C ====== -C (after COPY) -C - IS = CPL_WRK_GET (W_CMAS,LNR,VALUE,LVAL) - IF (IAND(IS,1).EQ.0) GOTO 999 -C - DO_CHECK = .TRUE. - IF (LVAL.EQ.0 .AND. DO_COPY) THEN - LNR = LNRCOPY - DO_CHECK = .FALSE. - ENDIF -C - IS = PPD_CMAS_PUT (VALUE(:LVAL),DO_CHECK) - IF (IAND(IS,1).EQ.0) THEN - IS = CPL_ERR_PUT (IS,LNR) - IF (IAND(IS,1).EQ.0) GOTO 999 - ENDIF -C -C -C ATTRIBUTES -C ========== -C (after COPY and CMAS) -C - IS = CPL_WRK_GET (W_AMAS,LNR,VALUE,LVAL) - IF (IAND(IS,1).EQ.0) GOTO 999 -C - DO_CHECK = .TRUE. - IF (LVAL.EQ.0 .AND. DO_COPY) THEN - LNR = LNRCOPY - DO_CHECK = .FALSE. - ENDIF -C - IS = PPD_AMAS_PUT (VALUE(:LVAL),DO_CHECK) - IF (IAND(IS,1).EQ.0) THEN - IS = CPL_ERR_PUT (IS,LNR) - IF (IAND(IS,1).EQ.0) GOTO 999 - ENDIF -C -C -C INPUT/OUTPUT CODE -C ================= -C (after COPY) -C - IS = CPL_WRK_GET (W_IOCD,LNR,VALUE,LVAL) - IF (IAND(IS,1).EQ.0) GOTO 999 -C - DO_CHECK = .TRUE. - IF (LVAL.EQ.0 .AND. DO_COPY) THEN - LNR = LNRCOPY - DO_CHECK = .FALSE. - ENDIF -C - IS = PPD_IOCD_PUT (VALUE(:LVAL),DO_CHECK) - IF (IAND(IS,1).EQ.0) THEN - IS = CPL_ERR_PUT (IS,LNR) - IF (IAND(IS,1).EQ.0) GOTO 999 - ENDIF -C -C -C DATA TYPE -C ========= -C (after COPY and CMAS) -C - IS = CPL_WRK_GET (W_DTYPE,LNR,VALUE,LVAL) - IF (IAND(IS,1).EQ.0) GOTO 999 -C - DO_CHECK = .TRUE. - IF (LVAL.EQ.0 .AND. DO_COPY) THEN - LNR = LNRCOPY - DO_CHECK = .FALSE. - ENDIF -C - IS = PPD_DTYPE_PUT (VALUE(:LVAL),DO_CHECK) - IF (IAND(IS,1).EQ.0) THEN - IS = CPL_ERR_PUT (IS,LNR) - IF (IAND(IS,1).EQ.0) GOTO 999 - ENDIF -C -C -C PARAMETER LENGTH -C ================ -C (after COPY and DTYPE) -C - IS = CPL_WRK_GET (W_PLEN,LNR,VALUE,LVAL) - IF (IAND(IS,1).EQ.0) GOTO 999 -C - DO_CHECK = .TRUE. - IF (LVAL.EQ.0 .AND. DO_COPY) THEN - LNR = LNRCOPY - DO_CHECK = .FALSE. - ENDIF -C - IS = PPD_PLEN_PUT (VALUE(:LVAL),DO_CHECK) - IF (IAND(IS,1).EQ.0) THEN - IS = CPL_ERR_PUT (IS,LNR) - IF (IAND(IS,1).EQ.0) GOTO 999 - ENDIF -C -C -C MAXIMUM NR OF SETS -C ================== -C (after COPY) -C - IS = CPL_WRK_GET (W_NSETS,LNR,VALUE,LVAL) - IF (IAND(IS,1).EQ.0) GOTO 999 -C - DO_CHECK = .TRUE. - IF (LVAL.EQ.0 .AND. DO_COPY) THEN - LNR = LNRCOPY - DO_CHECK = .FALSE. - ENDIF -C - IS = PPD_NSETS_PUT (VALUE(:LVAL),DO_CHECK) - IF (IAND(IS,1).EQ.0) THEN - IS = CPL_ERR_PUT (IS,LNR) - IF (IAND(IS,1).EQ.0) GOTO 999 - ENDIF -C -C -C NR OF VALUES PER SET -C ==================== -C (after COPY, AMAS and CMAS) -C - IS = CPL_WRK_GET (W_NVAL,LNR,VALUE,LVAL) - IF (IAND(IS,1).EQ.0) GOTO 999 -C - DO_CHECK = .TRUE. - IF (LVAL.EQ.0 .AND. DO_COPY) THEN - LNR = LNRCOPY - DO_CHECK = .FALSE. - ENDIF -C - IS = PPD_NVAL_PUT (VALUE(:LVAL),DO_CHECK) - IF (IAND(IS,1).EQ.0) THEN - IS = CPL_ERR_PUT (IS,LNR) - IF (IAND(IS,1).EQ.0) GOTO 999 - ENDIF -C -C -C MINIMUM NR OF VALUES PER SET -C ============================ -C (after COPY and NVAL) -C - IS = CPL_WRK_GET (W_MNVAL,LNR,VALUE,LVAL) - IF (IAND(IS,1).EQ.0) GOTO 999 -C - DO_CHECK = .TRUE. - IF (LVAL.EQ.0 .AND. DO_COPY) THEN - LNR = LNRCOPY - DO_CHECK = .FALSE. - ENDIF -C - IS = PPD_MNVAL_PUT (VALUE(:LVAL),DO_CHECK) - IF (IAND(IS,1).EQ.0) THEN - IS = CPL_ERR_PUT (IS,LNR) - IF (IAND(IS,1).EQ.0) GOTO 999 - ENDIF -C -C -C MAXIMUM NR OF VALUES PER SET -C ============================ -C (after COPY, NVAL and MNVAL) -C - IS = CPL_WRK_GET (W_MXVAL,LNR,VALUE,LVAL) - IF (IAND(IS,1).EQ.0) GOTO 999 -C - DO_CHECK = .TRUE. - IF (LVAL.EQ.0 .AND. DO_COPY) THEN - LNR = LNRCOPY - DO_CHECK = .FALSE. - ENDIF -C - IS = PPD_MXVAL_PUT (VALUE(:LVAL),DO_CHECK) - IF (IAND(IS,1).EQ.0) THEN - IS = CPL_ERR_PUT (IS,LNR) - IF (IAND(IS,1).EQ.0) GOTO 999 - ENDIF -C -C -C MINIMUM VALUES -C ============== -C (after COPY, DTYPE, PLEN, NVAL, AMAS -C AND CMAS) -C - IS = CPL_WRK_GET (W_MIN,LNR,VALUE,LVAL) - IF (IAND(IS,1).EQ.0) GOTO 999 -C - DO_CHECK = .TRUE. - IF (LVAL.EQ.0 .AND. DO_COPY) THEN - LNR = LNRCOPY - IS = PPD_MIN_XGET (%REF(VALUE),LEN(VALUE),LVAL) - IF (IAND(IS,1).EQ.0) GOTO 999 - DO_CHECK = .FALSE. - ENDIF -C - IS = PPD_MIN_PUT (VALUE(:LVAL),DO_CHECK) - IF (IAND(IS,1).EQ.0) THEN - IS = CPL_ERR_PUT (IS,LNR) - IF (IAND(IS,1).EQ.0) GOTO 999 - ENDIF -C -C -C MAXIMUM VALUES -C ============== -C (after COPY, DTYPE, PLEN, NVAL, AMAS -C AND CMAS) -C - IS = CPL_WRK_GET (W_MAX,LNR,VALUE,LVAL) - IF (IAND(IS,1).EQ.0) GOTO 999 -C - DO_CHECK = .TRUE. - IF (LVAL.EQ.0 .AND. DO_COPY) THEN - LNR = LNRCOPY - IS = PPD_MAX_XGET (%REF(VALUE),LEN(VALUE),LVAL) - IF (IAND(IS,1).EQ.0) GOTO 999 - DO_CHECK = .FALSE. - ENDIF -C - IS = PPD_MAX_PUT (VALUE(:LVAL),DO_CHECK) - IF (IAND(IS,1).EQ.0) THEN - IS = CPL_ERR_PUT (IS,LNR) - IF (IAND(IS,1).EQ.0) GOTO 999 - ENDIF -C -C -C UNITS -C ===== -C (after COPY) -C - IS = CPL_WRK_GET (W_USTR,LNR,VALUE,LVAL) - IF (IAND(IS,1).EQ.0) GOTO 999 -C - DO_CHECK = .TRUE. - IF (LVAL.EQ.0 .AND. DO_COPY) THEN - LNR = LNRCOPY - IS = PPD_USTR_XGET (VALUE,LVAL) - IF (IAND(IS,1).EQ.0) GOTO 999 - DO_CHECK = .FALSE. - ENDIF -C - IS = PPD_USTR_PUT (VALUE(:LVAL),DO_CHECK) - IF (IAND(IS,1).EQ.0) THEN - IS = CPL_ERR_PUT (IS,LNR) - IF (IAND(IS,1).EQ.0) GOTO 999 - ENDIF -C -C -C SEARCH STRATEGY -C =============== -C (after COPY) -C - IS = CPL_WRK_GET (W_SSTR,LNR,VALUE,LVAL) - IF (IAND(IS,1).EQ.0) GOTO 999 -C - DO_CHECK = .TRUE. - GROUP = ' ' - LGRP = 0 - IF (LVAL.EQ.0 .AND. DO_COPY) THEN - LNR = LNRCOPY - IS = PPD_SSTR_XGET (VALUE,LVAL,GROUP,LGRP) - IF (IAND(IS,1).EQ.0) GOTO 999 - DO_CHECK = .FALSE. - ENDIF -C - IS = PPD_SSTR_PUT (VALUE(:LVAL),GROUP(:LGRP),DO_CHECK) - IF (IAND(IS,1).EQ.0) THEN - IS = CPL_ERR_PUT (IS,LNR) - IF (IAND(IS,1).EQ.0) GOTO 999 - ENDIF -C -C -C DEFAULT VALUES -C ============== -C (after COPY and SSTR) -C - IS = CPL_WRK_GET (W_DVSTR,LNR,VALUE,LVAL) - IF (IAND(IS,1).EQ.0) GOTO 999 -C - DO_CHECK = .TRUE. - IF (LVAL.EQ.0 .AND. DO_COPY) THEN - LNR = LNRCOPY - IS = PPD_DVSTR_XGET (VALUE,LVAL) - IF (IAND(IS,1).EQ.0) GOTO 999 - DO_CHECK = .FALSE. - ENDIF -C - IS = PPD_DVSTR_PUT (VALUE(:LVAL),DO_CHECK) - IF (IAND(IS,1).EQ.0) THEN - IS = CPL_ERR_PUT (IS,LNR) - IF (IAND(IS,1).EQ.0) GOTO 999 - ENDIF -C -C -C OPTIONS -C ======= -C (after COPY, CMAS, DTYPE and PLEN) -C - IS = CPL_WRK_GET (W_OPSTR,LNR,VALUE,LVAL) - IF (IAND(IS,1).EQ.0) GOTO 999 -C - DO_CHECK = .TRUE. - IF (LVAL.EQ.0 .AND. DO_COPY) THEN - LNR = LNRCOPY - IS = PPD_OPSTR_XGET (VALUE,LVAL) - IF (IAND(IS,1).EQ.0) GOTO 999 - DO_CHECK = .FALSE. - ENDIF -C - IS = PPD_OPSTR_PUT (VALUE(:LVAL),DO_CHECK) - IF (IAND(IS,1).EQ.0) THEN - IS = CPL_ERR_PUT (IS,LNR) - IF (IAND(IS,1).EQ.0) GOTO 999 - ENDIF -C -C -C PROMPT -C ====== -C (after COPY) -C - IS = CPL_WRK_GET (W_PRSTR,LNR,VALUE,LVAL) - IF (IAND(IS,1).EQ.0) GOTO 999 -C - DO_CHECK = .TRUE. - IF (LVAL.EQ.0 .AND. DO_COPY) THEN - LNR = LNRCOPY - IS = PPD_PRSTR_XGET (VALUE,LVAL) - IF (IAND(IS,1).EQ.0) GOTO 999 - DO_CHECK = .FALSE. - ENDIF -C - IS = PPD_PRSTR_PUT (VALUE(:LVAL),DO_CHECK) - IF (IAND(IS,1).EQ.0) THEN - IS = CPL_ERR_PUT (IS,LNR) - IF (IAND(IS,1).EQ.0) GOTO 999 - ENDIF -C -C -C HELP -C ==== -C (after COPY) -C - IS = CPL_WRK_GET (W_HSTR,LNR,VALUE,LVAL) - IF (IAND(IS,1).EQ.0) GOTO 999 -C - DO_CHECK = .TRUE. - IF (LVAL.EQ.0 .AND. DO_COPY) THEN - LNR = LNRCOPY - IS = PPD_HSTR_XGET (VALUE,LVAL) - IF (IAND(IS,1).EQ.0) GOTO 999 - DO_CHECK = .FALSE. - ENDIF -C - IS = PPD_HSTR_PUT (VALUE(:LVAL),DO_CHECK) - IF (IAND(IS,1).EQ.0) THEN - IS = CPL_ERR_PUT (IS,LNR) - IF (IAND(IS,1).EQ.0) GOTO 999 - ENDIF -C -C - BPD_BUILD = PPD_SUCCESS - IF (DO_COPY) IS = PPD_EXIT () - RETURN -C - 999 BPD_BUILD = IS - IF (DO_COPY) IS = PPD_EXIT () - RETURN - END diff --git a/src/dwarf/bpdcompile.for b/src/dwarf/bpdcompile.for deleted file mode 100644 index d09071520a01e4addd1e7c55a239d37ddc10c6e2..0000000000000000000000000000000000000000 --- a/src/dwarf/bpdcompile.for +++ /dev/null @@ -1,146 +0,0 @@ -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ -C.Ident: BPD_COMPILE -C.Keywords: PPD File, Build, Compilation -C.Author: Friso Olnon (NFRA, Dwingeloo) -C.Language: DWARF-Fortran -C.Environment: VAX or Alliant -C.Comments: -C.Version: 900415 FMO - recreation -C.Version: 930923 CMV - logical names for new maintenance system -C.Version: 010709 AXC - Linux port - tmpchar in calls -C------------------------------------------------------------------------- -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - INTEGER*4 FUNCTION BPD_COMPILE (PROGNAM,DO_LIST,PRTFLAGS, - 1 DO_UPDATE) -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' -C - CHARACTER*(*) PROGNAM ! (i) program name - LOGICAL*4 DO_LIST ! (i) full compilation listing ? - INTEGER*4 PRTFLAGS ! (i) disposition of listing - LOGICAL*4 DO_UPDATE ! (i) update mode ? -C -C.Purpose: Compile the PIN file into a PPD file -C.Returns: Status code (.TRUE. for success, .FALSE. otherwise) -C success PPD_SUCCESS -C false status codes returned by referenced modules -C.Notes: -C------------------------------------------------------------------------- -C - INCLUDE 'BLDPPD_2_DEF' -C - CHARACTER*(*) LISTYPE - PARAMETER (LISTYPE = '.LIS') -C -C Parameter-definition keywords -C and corresponding work indices -C - INTEGER*4 NPAR - PARAMETER (NPAR = 22) - CHARACTER*16 PAR(NPAR) - INTEGER*4 WPAR(NPAR) - DATA PAR / - 1 'USER_PARAMETER','KEYWORD' ,'COPY' , - 2 'PROG_PARAMETER','DATA_TYPE' ,'IO' , - 3 'LENGTH' ,'NVALUES' ,'MAX_NSETS' , - 4 'MIN_NVALUES' ,'MAX_NVALUES' ,'CHECKS' , - 5 'ATTRIBUTES' ,'SWITCHES' ,'MINIMUM' , - 6 'MAXIMUM' ,'UNITS' ,'SEARCH' , - 7 'DEFAULTS' ,'OPTIONS' ,'PROMPT' , - 8 'HELP' / - DATA WPAR / - 1 W_UNAM ,W_UNAM ,W_COPY , - 2 W_PNAM ,W_DTYPE ,W_IOCD , - 3 W_PLEN ,W_NVAL ,W_NSETS , - 4 W_MNVAL ,W_MXVAL ,W_CMAS , - 5 W_AMAS ,W_AMAS ,W_MIN , - 6 W_MAX ,W_USTR ,W_SSTR , - 7 W_DVSTR ,W_OPSTR ,W_PRSTR , - 8 W_HSTR / -C - INTEGER*4 BPD_INIT, CPL_READ, BPD_BUILD, BPD_STORE - INTEGER*4 BPD_WRITE, CPL_LIST, BPD_EXIT - INTEGER*4 FILNAM_FULL, STR_SIGLEN -C - CHARACTER*16 STARTKEY(2), NEXTKEY, FILESPEC*80, TMPC*80 - INTEGER*4 IS, TMP, PASSNR, NSTART, LP, LL1, LF - LOGICAL*4 EOF, INTREF, FILL_WORK -C -C -C Initialize -C - set compilation pass nr -C - set change-of-group keywords -C - PASSNR = 1 - NSTART = 2 - STARTKEY(1) = PAR(1) - STARTKEY(2) = PAR(2) - LP = STR_SIGLEN (PROGNAM) -C -C - open the source file -C - initialize the compilation buffers -C - 100 IS = BPD_INIT (PROGNAM(:LP),PASSNR) - IF (IAND(IS,1).EQ.0) GOTO 999 -C -C Process the parameter definitions -C one by one -C - read the group of source lines -C - build the parameter description -C - store the description -C - EOF = .FALSE. - INTREF = .FALSE. - FILL_WORK = .TRUE. - DO WHILE (.NOT.EOF) - IS = CPL_READ (NPAR,PAR,WPAR,FILL_WORK,NSTART,STARTKEY,NEXTKEY) - EOF = IS.EQ.CPL_SRCEOF - IF (IAND(IS,1).NE.0) - 1 IS = BPD_BUILD (PROGNAM(:LP),PASSNR,DO_UPDATE) - IF (IAND(IS,1).NE.0) THEN - IF (IS.EQ.PPD_INTREF) THEN - INTREF = .TRUE. - ELSE - IS = BPD_STORE () - ENDIF - ENDIF - IF (IAND(IS,1).EQ.0) GOTO 999 - ENDDO -C -C Write the PPD file -C - IS = BPD_WRITE (PROGNAM(:LP),PASSNR) - -C -C If the compilation was successful -C and internal references were found: -C - do a second compilation pass -C - IF (IAND(IS,1).NE.0 .AND. INTREF) THEN - PASSNR = 2 - GOTO 100 - ENDIF -C -C Make the compilation listing -C - put in current directory -C - also if compilation errors were found -C - IF (IAND(IS,1).NE.0 .OR. IS.EQ.PPD_NOSUCCESS) THEN - LL1=LP - DO WHILE (LL1.GT.1.AND.PROGNAM(LL1:LL1).NE.'/' - 1 .AND.PROGNAM(LL1:LL1).NE.']' - 1 .AND.PROGNAM(LL1:LL1).NE.':') - LL1=LL1-1 - END DO - TMPC = PROGNAM(LL1:LP)//LISTYPE - TMP = FILNAM_FULL (TMPC,FILESPEC,LF,' ') - TMP = CPL_LIST (FILESPEC(:LF),DO_LIST,PRTFLAGS) - ENDIF -C -C Close the source file -C - 999 BPD_COMPILE = IS - IS = BPD_EXIT () - RETURN - END diff --git a/src/dwarf/bpdefcheck.for b/src/dwarf/bpdefcheck.for deleted file mode 100644 index d86802b161e2a6e038f349d05373f06fa5c7a39e..0000000000000000000000000000000000000000 --- a/src/dwarf/bpdefcheck.for +++ /dev/null @@ -1,97 +0,0 @@ -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ -C.Ident: BP_DEF_CHECK -C.Keywords: Program Parameters, PPD Default, Check -C.Author: Friso Olnon (NFRA, Dwingeloo) -C.Language: DWARF-Fortran -C.Environment: VAX or Alliant -C.Comments: -C.Version: 900416 FMO - recreation -C.Version: 940120 CMV - changed messenger -C------------------------------------------------------------------------- -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - INTEGER*4 FUNCTION BP_DEF_CHECK (VALUE) -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' -C - CHARACTER*(*) VALUE ! (i) input value string -C -C.Purpose: Check the syntax of a PPD default -C.Returns: Status code (.TRUE. for success, .FALSE. otherwise) -C success DWC_SUCCESS -C false status codes returned by referenced modules -C.Notes: -C - The string may contain unknown symbols; they will temporarily be -C replaced by '1' to allow the syntax checking. -C - The only allowed qualifier is /(NO)ASK. -C - The string cannot be a help request (question mark). -C - The message buffer is cleared (BLDPPD reports itself). -C------------------------------------------------------------------------- -C -C - CHARACTER*(*) STREAM - PARAMETER (STREAM = '$1') -C - INTEGER*4 CLI_RESET, CLI_PARSE, CLI_GET - INTEGER*4 DWC_STR_SUBST, DWC_HELP - INTEGER*4 PV_BLK_ALLOC, PV_BLK_DECODE, PV_BLK_RELEASE -C - INTEGER*4 NRARG - PARAMETER (NRARG = 2) - CHARACTER*6 NAME(NRARG) - INTEGER*4 ATTR(NRARG) - CHARACTER*1 PROMPT(NRARG) - CHARACTER*1 DEFVAL(NRARG) - DATA NAME /'VALSTR' ,'ASK' / - DATA ATTR /CLI__EXPRESSION ,CLI__QUALIFIER/ - DATA PROMPT /' ' ,' ' / - DATA DEFVAL /' ' ,' ' / -C - CHARACTER*255 WORK, VALSTR - INTEGER*4 IS, LW, LVAL, TMP, ERRPTR, DLEVEL, VALBLK(8) - LOGICAL*4 SWSYM - BYTE DEFARR(1) ! dummy -C -C -C Substitute symbols -C - SWSYM = .FALSE. - IS = DWC_STR_SUBST (VALUE,WORK,LW,STREAM,ERRPTR,.TRUE.,SWSYM) - IF (IAND(IS,1).EQ.0) GOTO 999 -C -C If help request: return warning -C - IS = DWC_HELP (WORK(:LW),-1,DLEVEL) - IF (IAND(IS,1).EQ.0) GOTO 999 -C -C Analyse the default string -C - reset the Command-Line Interpreter -C - parse the string -C - extract the pure value string -C - IS = CLI_RESET (NRARG,NAME,ATTR,PROMPT,DEFVAL) - IF (IAND(IS,1).NE.0) IS = CLI_PARSE (WORK(:LW)) - IF (IAND(IS,1).NE.0) IS = CLI_GET ('VALSTR',VALSTR,LVAL) - IF (IAND(IS,1).EQ.0) GOTO 999 -C -C Check the values -C - allocate memory for the value block -C - convert the string to a block -C - release memory -C - IF (LVAL.GT.0) THEN - IS = PV_BLK_ALLOC (VALSTR(:LVAL),VALBLK) - IF (IAND(IS,1).EQ.0) GOTO 999 - IS = PV_BLK_DECODE (VALSTR(:LVAL),VALBLK,STREAM, - 1 .TRUE.,SWSYM,.TRUE.,DEFARR,0) - TMP = PV_BLK_RELEASE (VALBLK) - IF (IAND(IS,1).EQ.0) GOTO 999 - ENDIF -C -C - BP_DEF_CHECK = DWC_SUCCESS - RETURN -C - 999 BP_DEF_CHECK = IS - RETURN - END diff --git a/src/dwarf/bpdhelp.for b/src/dwarf/bpdhelp.for deleted file mode 100644 index 5958c12e2ad63039f27c152d6e8661b6395ba468..0000000000000000000000000000000000000000 --- a/src/dwarf/bpdhelp.for +++ /dev/null @@ -1,135 +0,0 @@ -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ -C.Ident: BPD_HELP -C.Keywords: PPD File, Build, Help Buffer -C.Author: Friso Olnon (NFRA, Dwingeloo) -C.Language: DWARF-Fortran -C.Environment: VAX or Alliant -C.Comments: -C Common variables used: -C INTEGER*4 BPD$HELP(1) ! (r) extend size in bytes -C INTEGER*4 BPD$HELP(2) ! (m) current size in bytes -C INTEGER*4 BPD$HELP(3) ! (m) current address -C INTEGER*4 BPD$HELP(4) ! (m) nr of bytes written -C INTEGER*4 BPD$HELP(5) ! (m) nr of entries written -C INTEGER*4 BPD$HELP(6) ! (m) offset of last-written entry -C -C.Version: 900415 FMO - recreation -C------------------------------------------------------------------------- -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - INTEGER*4 FUNCTION BPD_HELP_INIT () -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' -C -C -C.Purpose: Initialize the help buffer -C.Returns: Status code (.TRUE. for success, .FALSE. otherwise) -C success PPD_SUCCESS -C.Notes: -C------------------------------------------------------------------------- -C - INCLUDE 'BLDPPD_2_DEF' -C - INTEGER*4 CLEAR_BLJ -C - INTEGER*4 IS -C -C - IS = CLEAR_BLJ (BPD$HELP(2),5) -C - BPD_HELP_INIT = PPD_SUCCESS - RETURN - END -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - INTEGER*4 FUNCTION BPD_HELP_PUT (STRING,HOFF) -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' -C - CHARACTER*(*) STRING ! (i) help text - INTEGER*4 HOFF ! (o) offset of new entry -C -C.Purpose: Add an entry to the help buffer -C.Returns: Status code (.TRUE. for success, .FALSE. otherwise) -C success PPD_SUCCESS -C false status returned by referenced routines -C.Notes: -C------------------------------------------------------------------------- -C - INCLUDE 'BLDPPD_2_DEF' -C - INTEGER*4 STR_SIGLEN, CPL_DYN_PUT -C - INTEGER*4 IS, LENGTH -C -C - HOFF = BPD$HELP(4) - LENGTH = STR_SIGLEN (STRING) - IF (LENGTH.GT.0) THEN - IS = CPL_DYN_PUT (LENGTH,%REF(STRING),BPD$HELP) - IF (IAND(IS,1).EQ.0) GOTO 999 - ENDIF -C -C - BPD_HELP_PUT = PPD_SUCCESS - RETURN -C - 999 BPD_HELP_PUT = IS - RETURN - END -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - INTEGER*4 FUNCTION BPD_HELP_WRITE () -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' -C -C -C.Purpose: Write the help buffer to the PPD file -C.Returns: Status code (.TRUE. for success, .FALSE. otherwise) -C success PPD_SUCCESS -C false status codes returned by referenced modules -C.Notes: -C------------------------------------------------------------------------- -C - INCLUDE 'BLDPPD_2_DEF' -C - INTEGER*4 CPL_DYN_WRITE -C - INTEGER*4 IS - LOGICAL*4 DO_RELEASE -C -C - DO_RELEASE = .TRUE. - IS = CPL_DYN_WRITE (BPD$HELP,DO_RELEASE) - IF (IAND(IS,1).EQ.0) GOTO 999 -C -C - BPD_HELP_WRITE = PPD_SUCCESS - RETURN -C - 999 BPD_HELP_WRITE = IS - RETURN - END -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - INTEGER*4 FUNCTION BPD_HELP_INQ (NHELP,LHELP) -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' -C - INTEGER*4 NHELP ! (o) nr of entries - INTEGER*4 LHELP ! (o) significant length in bytes -C -C.Purpose: Get information about the help buffer -C.Returns: Status code (.TRUE. for success, .FALSE. otherwise) -C success PPD_SUCCESS -C.Notes: -C------------------------------------------------------------------------- -C - INCLUDE 'BLDPPD_2_DEF' -C - NHELP = BPD$HELP(5) - LHELP = BPD$HELP(4) -C - BPD_HELP_INQ = PPD_SUCCESS - RETURN - END diff --git a/src/dwarf/bpdindex.for b/src/dwarf/bpdindex.for deleted file mode 100644 index d8578eb47366ce9d12ea6a66afe35079ebddcf45..0000000000000000000000000000000000000000 --- a/src/dwarf/bpdindex.for +++ /dev/null @@ -1,458 +0,0 @@ -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ -C.Ident: BPD_INDEX -C.Keywords: PPD File, Build, Index Buffer -C.Author: Friso Olnon (NFRA, Dwingeloo) -C.Language: DWARF-Fortran -C.Environment: VAX or Alliant -C.Comments: -C Common variables used: -C INTEGER*4 BPD$INDEX(1) ! (r) extend size in bytes -C INTEGER*4 BPD$INDEX(2) ! (m) current size in bytes -C INTEGER*4 BPD$INDEX(3) ! (m) current address -C INTEGER*4 BPD$INDEX(4) ! (m) nr of bytes written -C INTEGER*4 BPD$INDEX(5) ! (m) nr of index entries written -C INTEGER*4 BPD$INDEX(6) ! (-) offset of last-written entry -C -C.Version: 900415 FMO - recreation -C.Version: 920224 GvD - no optional arguments in MSG anymore -C.Version: 940120 CMV - use indirect addressing (A_B) -C------------------------------------------------------------------------- -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - INTEGER*4 FUNCTION BPD_INDEX_INIT () -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' -C -C -C.Purpose: Initialize the index buffer -C.Returns: Status code (.TRUE. for success, .FALSE. otherwise) -C success PPD_SUCCESS -C.Notes: -C------------------------------------------------------------------------- -C - INCLUDE 'BLDPPD_2_DEF' -C - INTEGER*4 CLEAR_BLJ -C - INTEGER*4 IS -C -C - IS = CLEAR_BLJ (BPD$INDEX(2),5) -C - BPD_INDEX_INIT = PPD_SUCCESS - RETURN - END -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - INTEGER*4 FUNCTION BPD_INDEX_PUT (PDOFF) -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' -C - INTEGER*4 PDOFF ! (i) offset of proto/parm description -C -C.Purpose: Add an entry to the index buffer -C.Returns: Status code (.TRUE. for success, .FALSE. otherwise) -C success PPD_SUCCESS -C false status returned by referenced routines -C.Notes: -C PDOFF is the offset of the corresponding prototype or parameter in -C the description buffer. -C------------------------------------------------------------------------- -C - INCLUDE 'BLDPPD_2_DEF' - INCLUDE 'PPDREC_4_DEF' -C - INTEGER*4 PPD_UNAM_GET, PPD_PNAM_GET - INTEGER*4 CPL_DYN_PUT -C - INTEGER*4 IS, LN, LMIN - LOGICAL*4 PROTOTYPE -C -C -C Build the index entry -C - IS = PPD_PNAM_GET (PPDID$PNAM,LN) - IF (IAND(IS,1).NE.0) - 1 IS = PPD_UNAM_GET (PPDID$UNAM,LN,LMIN,PROTOTYPE) - IF (IAND(IS,1).EQ.0) GOTO 999 - PPDID$LUNAM = 0 - PPDID$PARMOFF = PDOFF -C -C Add the entry to the index buffer -C - IS = CPL_DYN_PUT (PPDID__LENGTH*4,PPDID_,BPD$INDEX) - IF (IAND(IS,1).EQ.0) GOTO 999 -C -C - BPD_INDEX_PUT = PPD_SUCCESS - RETURN -C - 999 BPD_INDEX_PUT = IS - RETURN - END -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - INTEGER*4 FUNCTION BPD_INDEX_SORT () -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' -C -C -C.Purpose: Sort the index on ascending program's parameter name -C.Returns: Status code (.TRUE. for success, .FALSE. otherwise) -C success PPD_SUCESS -C.Notes: -C The sort algorithm is "quickersort" as described in -C "Communications of the ACM" nr 271. -C------------------------------------------------------------------------- -C - INCLUDE 'BLDPPD_2_DEF' - INCLUDE 'PPDREC_4_DEF' -C - INTEGER*4 MOVE_BLJ -C - CHARACTER*16 XPNAM, YPNAM - INTEGER*4 XENT(PPDID__LENGTH), YENT(PPDID__LENGTH) - EQUIVALENCE (XPNAM,XENT(PPDID_PNAM)) - EQUIVALENCE (YPNAM,YENT(PPDID_PNAM)) - INTEGER*4 IS, SS, SE, SM, X, Y, YH - INTEGER*4 SNR, SAVSS(32), SAVSE(32) -C - INTEGER*4 ADDR, N - ADDR(N) = BPD$INDEX(3)+(N-1)*PPDID__LENGTH*4 -C -C - SS = 1 ! segment start - SE = BPD$INDEX(5) ! segment end - SNR = 1 ! segment number -C - DO WHILE (SNR.GT.0) -C -C Segment with more than 2 entries: -C - split into smaller segments -C - IF (SE-SS.GT.1) THEN -C -C Choose the middle entry as reference -C - move it into the local array PPDID_ -C - put the first entry in its place -C - SM = (SS+SE)/2 - IS = MOVE_BLJ (A_B(ADDR(SM)-A_OB), - 1 PPDID_,PPDID__LENGTH) - IS = MOVE_BLJ (A_B(ADDR(SS)-A_OB), - 1 A_B(ADDR(SM)-A_OB),PPDID__LENGTH) - Y = SE -C -C Shuffle, so that all entries preceding -C the reference <= the reference -C and all others >= the reference -C - find the first entry > PPDID_ -C - if found: find the last entry < PPDID_ -C - if found: swap the entries -C and look for the next "swap" pair -C - DO X = SS+1,Y - IF (SS+1.LE.Y) THEN - IS = MOVE_BLJ (A_B(ADDR(X)-A_OB),XENT,PPDID__LENGTH) - IF (XPNAM.GT.PPDID$PNAM) THEN - DO Y = Y,X,-1 - IF (Y.GE.X) THEN - IS = MOVE_BLJ (A_B(ADDR(Y)-A_OB), - 1 YENT,PPDID__LENGTH) - IF (YPNAM.LT.PPDID$PNAM) THEN - IS = MOVE_BLJ (YENT, - 1 A_B(ADDR(X)-A_OB), - 1 PPDID__LENGTH) - IS = MOVE_BLJ (XENT, - 1 A_B(ADDR(Y)-A_OB), - 1 PPDID__LENGTH) - YH = Y-1 - GOTO 45 - ENDIF - ENDIF - ENDDO - Y = X-1 - GOTO 60 - 45 Y = YH - ENDIF - ENDIF - ENDDO -C -C - move the last "lower" (Y) entry -C into the first position -C - put the reference entry in its place -C - 60 IS = MOVE_BLJ (A_B(ADDR(Y)-A_OB), - 1 A_B(ADDR(SS)-A_OB),PPDID__LENGTH) - IS = MOVE_BLJ (PPDID_, - 1 A_B(ADDR(Y)-A_OB),PPDID__LENGTH) -C -C The segment now consists of 3 sections -C (the middle one just is entry Y): -C - the first Y-SS entries <= entry Y -C - the last SE-Y entries >= entry Y -C - save the start- and end-positions of -C the larger section in SAVSS and SAVSE -C - make the smaller section the next -C segment to be sorted -C - IF (Y-SS.GT.SE-Y) THEN - SAVSS(SNR) = SS - SAVSE(SNR) = Y-1 - SS = Y+1 - ELSE - SAVSS(SNR) = Y+1 - SAVSE(SNR) = SE - SE = Y-1 - ENDIF - SNR = SNR+1 -C -C Segment with 1 or 2 entries: -C - ELSE -C -C Swap if 2 entries in the wrong order -C - - IF (SE.GT.SS) THEN - IS = MOVE_BLJ (A_B(ADDR(SS)-A_OB), - 1 XENT,PPDID__LENGTH) - IS = MOVE_BLJ (A_B(ADDR(SE)-A_OB), - 1 YENT,PPDID__LENGTH) - IF (XPNAM.GT.YPNAM) THEN - IS = MOVE_BLJ (YENT, - 1 A_B(ADDR(SS)-A_OB),PPDID__LENGTH) - IS = MOVE_BLJ (XENT, - 1 A_B(ADDR(SE)-A_OB),PPDID__LENGTH) - ENDIF - ENDIF -C -C Take the next segment to be sorted -C - SNR = SNR-1 - IF (SNR.GT.0) THEN - SS = SAVSS(SNR) - SE = SAVSE(SNR) - ENDIF - ENDIF - ENDDO -C -C - BPD_INDEX_SORT = PPD_SUCCESS - RETURN - END -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - INTEGER*4 FUNCTION BPD_INDEX_UNIQ () -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' -C -C -C.Purpose: Determine the unique-abbreviation lengths of the user's names -C.Returns: Status code (.TRUE. for success, .FALSE. otherwise) -C success PPD_SUCESS -C.Notes: -C------------------------------------------------------------------------- -C - INCLUDE 'BLDPPD_2_DEF' - INCLUDE 'PPDREC_4_DEF' -C - INTEGER*4 BPD_PARM_PUTL, BPD_PROTO_PUTL - INTEGER*4 STR_SIGLEN, MOVE_BLJ -C - CHARACTER*16 UNAM, XUNAM - INTEGER*4 LUNAM, XLUNAM - INTEGER*4 XENT(PPDID__LENGTH) - EQUIVALENCE (XUNAM,XENT(PPDID_UNAM)) - EQUIVALENCE (XLUNAM,XENT(PPDID_LUNAM)) - INTEGER*4 IS, X - LOGICAL*4 READY -C - INTEGER*4 ADDR, N - ADDR(N) = BPD$INDEX(3)+(N-1)*PPDID__LENGTH*4 -C -C -C Do for all index entries -C (NOTE: initially, all LUNAM's are zero) -C - DO I = 1,BPD$INDEX(5) - IS = MOVE_BLJ (A_B(ADDR(I)-A_OB), - 1 PPDID_,PPDID__LENGTH) - UNAM = PPDID$UNAM - LUNAM = PPDID$LUNAM -C -C Check the user's name in the current -C entry against that in all other entries -C - start with current LUNAM + 1 -C - if a name is equal to the current -C name: update LUNAM in the comparison -C entry -C - if at least one equality was found: -C increment the current LUNAM, and -C compare again -C - otherwise: ready with current entry -C - READY = .FALSE. - DO WHILE (.NOT.READY .AND. LUNAM.LT.16) - LUNAM = LUNAM+1 - READY = .TRUE. - DO X = 1,BPD$INDEX(5) - IF (X.NE.I) THEN - IS = MOVE_BLJ (A_B(ADDR(X)-A_OB), - 1 XENT,PPDID__LENGTH) - IF (XUNAM(:LUNAM).EQ.UNAM(:LUNAM)) THEN - XLUNAM = MIN (LUNAM,STR_SIGLEN(XUNAM)) - IS = MOVE_BLJ (XENT, - 1 A_B(ADDR(X)-A_OB), - 1 PPDID__LENGTH) - READY = .FALSE. - ENDIF - ENDIF - ENDDO - ENDDO -C -C Update LUNAM in the current index entry -C and in the corresponding param descr -C - PPDID$LUNAM = MIN (LUNAM,STR_SIGLEN(UNAM)) - IS = MOVE_BLJ (PPDID_, - 1 A_B(ADDR(I)-A_OB),PPDID__LENGTH) - IF (UNAM(1:1).NE.'$') THEN - IS = BPD_PARM_PUTL (PPDID$PARMOFF,PPDID$LUNAM) - ELSE - IS = BPD_PROTO_PUTL (PPDID$PARMOFF,PPDID$LUNAM) - ENDIF - ENDDO -C -C - BPD_INDEX_UNIQ = PPD_SUCCESS - RETURN - END -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - INTEGER*4 FUNCTION BPD_INDEX_WRITE () -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' -C -C -C.Purpose: Write the index buffer to the PPD file -C.Returns: Status code (.TRUE. for success, .FALSE. otherwise) -C success PPD_SUCCESS -C false status codes returned by referenced modules -C.Notes: -C------------------------------------------------------------------------- -C - INCLUDE 'BLDPPD_2_DEF' -C - INTEGER*4 CPL_DYN_WRITE -C - INTEGER*4 IS - LOGICAL*4 DO_RELEASE -C -C - DO_RELEASE = .TRUE. - IS = CPL_DYN_WRITE (BPD$INDEX,DO_RELEASE) - IF (IAND(IS,1).EQ.0) GOTO 999 -C -C - BPD_INDEX_WRITE = PPD_SUCCESS - RETURN -C - 999 BPD_INDEX_WRITE = IS - RETURN - END -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - INTEGER*4 FUNCTION BPD_INDEX_INQ (NINDEX,LINDEX) -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' -C - INTEGER*4 NINDEX ! (o) nr of index entries - INTEGER*4 LINDEX ! (o) significant length in bytes -C -C.Purpose: Get information about the index buffer -C.Returns: Status code (.TRUE. for success, .FALSE. otherwise) -C success PPD_SUCCESS -C.Notes: -C------------------------------------------------------------------------- -C - INCLUDE 'BLDPPD_2_DEF' -C - NINDEX = BPD$INDEX(5) - LINDEX = BPD$INDEX(4) -C - BPD_INDEX_INQ = PPD_SUCCESS - RETURN - END -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - INTEGER*4 FUNCTION BPD_INDEX_GETU (UNAM) -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' -C - CHARACTER*(*) UNAM ! (i) user's parameter name -C -C.Purpose: Check whether the name occurs in the index -C.Returns: Status code (.TRUE. for success, .FALSE. otherwise) -C success PPD_SUCCESS -C error PPD_KEYNOTFND name not found -C.Notes: -C------------------------------------------------------------------------- -C - INCLUDE 'BLDPPD_2_DEF' - INCLUDE 'PPDREC_4_DEF' -C - INTEGER MOVE_BLJ, MSG_SET -C - INTEGER*4 IS, NR, ADDR -C -C - ADDR = BPD$INDEX(3) - DO NR = 1,BPD$INDEX(5) - IS = MOVE_BLJ (A_B(ADDR-A_OB),PPDID_,PPDID__LENGTH) - IF (UNAM.EQ.PPDID$UNAM) GOTO 999 - ADDR = ADDR+PPDID__LENGTH*4 - ENDDO -C - BPD_INDEX_GETU = MSG_SET (PPD_KEYNOTFND,1) - RETURN -C - 999 BPD_INDEX_GETU = PPD_SUCCESS - RETURN - END -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - INTEGER*4 FUNCTION BPD_INDEX_GETP (PNAM) -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' -C - CHARACTER*(*) PNAM ! (i) program's parameter name -C -C.Purpose: Check whether the name occurs in the index -C.Returns: Status code (.TRUE. for success, .FALSE. otherwise) -C success PPD_SUCCESS -C error PPD_PKYNOTFND name not found -C.Notes: -C------------------------------------------------------------------------- -C - INCLUDE 'BLDPPD_2_DEF' - INCLUDE 'PPDREC_4_DEF' -C - INTEGER MOVE_BLJ, MSG_SET -C - INTEGER*4 IS, NR, ADDR -C -C - ADDR = BPD$INDEX(3) - DO NR = 1,BPD$INDEX(5) - IS = MOVE_BLJ (A_B(ADDR-A_OB),PPDID_,PPDID__LENGTH) - IF (PNAM.EQ.PPDID$PNAM) GOTO 999 - ADDR = ADDR+PPDID__LENGTH*4 - ENDDO -C - BPD_INDEX_GETP = MSG_SET(PPD_PKYNOTFND,1) - RETURN -C - 999 BPD_INDEX_GETP = PPD_SUCCESS - RETURN - END diff --git a/src/dwarf/bpdinit.for b/src/dwarf/bpdinit.for deleted file mode 100644 index d30988a9da2f5aa412bfcd1c131318f4d0e5b924..0000000000000000000000000000000000000000 --- a/src/dwarf/bpdinit.for +++ /dev/null @@ -1,111 +0,0 @@ -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ -C.Ident: BPD_INIT -C.Keywords: PPD File, Build, Initialize -C.Author: Friso Olnon Kombrink (NFRA, Dwingeloo) -C.Language: DWARF-Fortran -C.Environment: VAX or Alliant -C.Comments: -C.Version: 900415 FMO - recreation -C.Version: 930923 CMV - logical names for new maintenance system -C.Version: 010907 AXC - Linux port - tmpcahr in calls -C------------------------------------------------------------------------- -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - INTEGER*4 FUNCTION BPD_INIT (PROGNAM,PASSNR) -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' -C - CHARACTER*(*) PROGNAM ! (i) program name - INTEGER*4 PASSNR ! (i) compilation pass number -C -C.Purpose: Open the source file and initialize the compilation buffers -C.Returns: Status code (.TRUE. for success, .FALSE. otherwise) -C success PPD_SUCCESS -C false status codes returned by referenced modules -C.Notes: -C - The source file PROGNAM//'.PIN' will be looked for in the current -C directory. -C------------------------------------------------------------------------- -C -C - CHARACTER*(*) SRCTYP - PARAMETER (SRCTYP = '.PIN') -C - INTEGER*4 CPL_SRC_OPEN, CPL_SRC_REWIND - INTEGER*4 CPL_ERR_INIT - INTEGER*4 BPD_INDEX_INIT, BPD_PARM_INIT - INTEGER*4 BPD_PROTO_INIT, BPD_HELP_INIT - INTEGER*4 STR_SIGLEN, FILNAM_FULL -C - CHARACTER*80 FILESPEC, TMP - INTEGER*4 IS, LP, LF -C -C - IF (PASSNR.EQ.1) THEN - LP = STR_SIGLEN (PROGNAM) - TMP=PROGNAM(:LP)//SRCTYP - IS = FILNAM_FULL (TMP,FILESPEC,LF,' ') - IF (IAND(IS,1).NE.0) IS = CPL_SRC_OPEN (FILESPEC(:LF)) - ELSE - IS = CPL_SRC_REWIND () - ENDIF - IF (IAND(IS,1).NE.0) IS = CPL_ERR_INIT () - IF (IAND(IS,1).NE.0) IS = BPD_INDEX_INIT () - IF (IAND(IS,1).NE.0) IS = BPD_PARM_INIT () - IF (IAND(IS,1).NE.0) IS = BPD_PROTO_INIT () - IF (IAND(IS,1).NE.0) IS = BPD_HELP_INIT () - IF (IAND(IS,1).EQ.0) GOTO 999 -C - BPD_INIT = PPD_SUCCESS - RETURN -C - 999 BPD_INIT = IS - RETURN - END -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - INTEGER*4 FUNCTION BPD_EXIT () -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' -C -C -C.Purpose: Close the source file -C.Returns: Status code (.TRUE. for success, .FALSE. otherwise) -C success PPD_SUCCESS -C false status codes returned by referenced modules -C.Notes: -C------------------------------------------------------------------------- -C -C - INTEGER*4 CPL_SRC_CLOSE -C - INTEGER*4 IS -C -C - IS = CPL_SRC_CLOSE () - IF (IAND(IS,1).EQ.0) GOTO 999 -C - BPD_EXIT = PPD_SUCCESS - RETURN -C - 999 BPD_EXIT = IS - RETURN - END - - - - - - - - - - - - - - - - - - diff --git a/src/dwarf/bpdparm.for b/src/dwarf/bpdparm.for deleted file mode 100644 index 6308ffa12079c16eaed61d16d76e8dcf94925981..0000000000000000000000000000000000000000 --- a/src/dwarf/bpdparm.for +++ /dev/null @@ -1,349 +0,0 @@ -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ -C.Ident: BPD_PARM -C.Keywords: PPD File, Build, Parameter-Description Buffer -C.Author: Friso Olnon (NFRA, Dwingeloo) -C.Language: DWARF-Fortran -C.Environment: VAX or Alliant -C.Comments: -C Common variables used: -C INTEGER*4 BPD$PARM(1) ! (r) extend size in bytes -C INTEGER*4 BPD$PARM(2) ! (m) current size in bytes -C INTEGER*4 BPD$PARM(3) ! (m) current address -C INTEGER*4 BPD$PARM(4) ! (m) nr of bytes written -C INTEGER*4 BPD$PARM(5) ! (m) nr of description entries written -C INTEGER*4 BPD$PARM(6) ! (m) offset of last-written entry -C INTEGER*4 BPD$PROT(1) -C INTEGER*4 BPD$PROT(2) -C INTEGER*4 BPD$PROT(3) -C INTEGER*4 BPD$PROT(4) -C INTEGER*4 BPD$PROT(5) -C INTEGER*4 BPD$PROT(6) -C -C INTEGER*4 PPDPD$EXTEN ! (m) offset of extension area -C INTEGER*4 PPDPD$FORW ! (m) offset of next description -C BYTE PPDPD_(*) ! (r) description -C -C.Version: 900415 FMO - recreation -C.Version: 930510 HjV - Change some INTEGER*2 into INTEGER*4 -C.Version: 940120 CMV - use indirect addressing (A_B) -C------------------------------------------------------------------------- -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - INTEGER*4 FUNCTION BPD_PARM_INIT () -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' -C -C -C.Purpose: Initialize the parameter description buffer -C.Returns: Status code (.TRUE. for success, .FALSE. otherwise) -C success PPD_SUCCESS -C.Notes: -C------------------------------------------------------------------------- -C - INCLUDE 'BLDPPD_2_DEF' -C - INTEGER*4 CLEAR_BLJ -C - INTEGER*4 IS -C -C - IS = CLEAR_BLJ (BPD$PARM(2),5) -C - BPD_PARM_INIT = PPD_SUCCESS - RETURN - END -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - INTEGER*4 FUNCTION BPD_PARM_PUT (PDOFF) -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' -C - INTEGER*4 PDOFF ! (o) offset of new entry -C -C.Purpose: Add an entry to the parameter description buffer -C.Returns: Status code (.TRUE. for success, .FALSE. otherwise) -C success PPD_SUCCESS -C false status returned by referenced routines -C.Notes: -C First the offsets of the extension area and the next entry are set. -C------------------------------------------------------------------------- -C - INCLUDE 'BLDPPD_2_DEF' - INCLUDE 'PPDREC_4_DEF' -C - INTEGER*4 CPL_DYN_PUT -C - INTEGER*4 IS, LENGTH -C -C -C Complete the description entry -C - extension and forward offsets -C - PPDPD$EXTEN = UNDEF_J - PPDPD$FORW = BPD$PARM(4)+PPDPD$LENG -C -C Add the entry to the description buffer -C - PDOFF = BPD$PARM(4) - LENGTH = PPDPD$LENG - IS = CPL_DYN_PUT (LENGTH,PPDPD_,BPD$PARM) - IF (IAND(IS,1).EQ.0) GOTO 999 -C -C - BPD_PARM_PUT = PPD_SUCCESS - RETURN -C - 999 BPD_PARM_PUT = IS - RETURN - END -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - INTEGER*4 FUNCTION BPD_PARM_PUTL (PDOFF,LUNAM) -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' -C - INTEGER*4 PDOFF ! (i) offset of description entry - INTEGER*4 LUNAM ! (i) user's name minimum-match length -C -C.Purpose: Put the minimum-match length in the description entry -C.Returns: Status code (.TRUE. for success, .FALSE. otherwise) -C success PPD_SUCCESS -C.Notes: -C------------------------------------------------------------------------- -C - INCLUDE 'BLDPPD_2_DEF' - INCLUDE 'PPDREC_4_DEF' -C - INTEGER*4 MOVE_BLJ -C - INTEGER*4 IS -C -C - IS = MOVE_BLJ (LUNAM, - 1 A_B(BPD$PARM(3)+PDOFF+PPDPD_LUNAM-1-A_OB),1) -C -C - BPD_PARM_PUTL = PPD_SUCCESS - RETURN - END -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - INTEGER*4 FUNCTION BPD_PARM_WRITE () -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' -C -C -C.Purpose: Write the parameter description buffer to the PPD file -C.Returns: Status code (.TRUE. for success, .FALSE. otherwise) -C success PPD_SUCCESS -C false status codes returned by referenced modules -C.Notes: -C First, the forward pointer of the last description is set to UNDEF_J. -C------------------------------------------------------------------------- -C - INCLUDE 'BLDPPD_2_DEF' -C - INTEGER*4 MOVE_BLJ, CPL_DYN_WRITE -C - INTEGER*4 IS - LOGICAL*4 DO_RELEASE -C -C - IF (BPD$PARM(2).NE.0) - 1 IS = MOVE_BLJ (UNDEF_J, - 1 A_B(BPD$PARM(3)+BPD$PARM(6)-A_OB),1) -C - DO_RELEASE = .TRUE. - IS = CPL_DYN_WRITE (BPD$PARM,DO_RELEASE) - IF (IAND(IS,1).EQ.0) GOTO 999 -C -C - BPD_PARM_WRITE = PPD_SUCCESS - RETURN -C - 999 BPD_PARM_WRITE = IS - RETURN - END -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - INTEGER*4 FUNCTION BPD_PARM_INQ (NPARM,LPARM) -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' -C - INTEGER*4 NPARM ! (o) nr of entries - INTEGER*4 LPARM ! (o) significant length in bytes -C -C.Purpose: Get information about the parameter description buffer -C.Returns: Status code (.TRUE. for success, .FALSE. otherwise) -C success PPD_SUCCESS -C.Notes: -C------------------------------------------------------------------------- -C - INCLUDE 'BLDPPD_2_DEF' -C - NPARM = BPD$PARM(5) - LPARM = BPD$PARM(4) -C - BPD_PARM_INQ = PPD_SUCCESS - RETURN - END -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - INTEGER*4 FUNCTION BPD_PROTO_INIT () -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' -C -C -C.Purpose: Initialize the prototype description buffer -C.Returns: Status code (.TRUE. for success, .FALSE. otherwise) -C success PPD_SUCCESS -C.Notes: -C------------------------------------------------------------------------- -C - INCLUDE 'BLDPPD_2_DEF' -C - INTEGER*4 CLEAR_BLJ -C - INTEGER*4 IS -C -C - IS = CLEAR_BLJ (BPD$PROT(2),5) -C - BPD_PROTO_INIT = PPD_SUCCESS - RETURN - END -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - INTEGER*4 FUNCTION BPD_PROTO_PUT (PDOFF) -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' -C - INTEGER*4 PDOFF ! (o) offset of new entry -C -C.Purpose: Add an entry to the prototype description buffer -C.Returns: Status code (.TRUE. for success, .FALSE. otherwise) -C success PPD_SUCCESS -C false status returned by referenced routines -C.Notes: -C First the offsets of the extension area and the next entry are set. -C------------------------------------------------------------------------- -C - INCLUDE 'BLDPPD_2_DEF' - INCLUDE 'PPDREC_4_DEF' -C - INTEGER*4 CPL_DYN_PUT -C - INTEGER*4 IS, LENGTH -C -C -C Complete the description entry -C - extension and forward offsets -C - PPDPD$EXTEN = UNDEF_J - PPDPD$FORW = BPD$PROT(4)+PPDPD$LENG -C -C Add the entry to the description buffer -C - PDOFF = BPD$PROT(4) - LENGTH = PPDPD$LENG - IS = CPL_DYN_PUT (LENGTH,PPDPD_,BPD$PROT) - IF (IAND(IS,1).EQ.0) GOTO 999 -C -C - BPD_PROTO_PUT = PPD_SUCCESS - RETURN -C - 999 BPD_PROTO_PUT = IS - RETURN - END -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - INTEGER*4 FUNCTION BPD_PROTO_PUTL (PDOFF,LUNAM) -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' -C - INTEGER*4 PDOFF ! (i) offset of description entry - INTEGER*4 LUNAM ! (i) user's name minimum-match length -C -C.Purpose: Put the minimum-match length in the description entry -C.Returns: Status code (.TRUE. for success, .FALSE. otherwise) -C success PPD_SUCCESS -C.Notes: -C------------------------------------------------------------------------- -C - INCLUDE 'BLDPPD_2_DEF' - INCLUDE 'PPDREC_4_DEF' -C - INTEGER*4 MOVE_BLJ -C - INTEGER*4 IS -C -C - IS = MOVE_BLJ (LUNAM, - 1 A_B(BPD$PROT(3)+PDOFF+PPDPD_LUNAM-1-A_OB),1) -C -C - BPD_PROTO_PUTL = PPD_SUCCESS - RETURN - END -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - INTEGER*4 FUNCTION BPD_PROTO_WRITE () -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' -C -C -C.Purpose: Write the prototype description buffer to the PPD file -C.Returns: Status code (.TRUE. for success, .FALSE. otherwise) -C success PPD_SUCCESS -C false status codes returned by referenced modules -C.Notes: -C First, the forward pointer of the last description is set to UNDEF_J. -C------------------------------------------------------------------------- -C - INCLUDE 'BLDPPD_2_DEF' -C - INTEGER*4 MOVE_BLJ, CPL_DYN_WRITE -C - INTEGER*4 IS - LOGICAL*4 DO_RELEASE -C -C - IF (BPD$PROT(2).NE.0) - 1 IS = MOVE_BLJ (UNDEF_J, - 1 A_B(BPD$PROT(3)+BPD$PROT(6)-A_OB),1) -C - DO_RELEASE = .TRUE. - IS = CPL_DYN_WRITE (BPD$PROT,DO_RELEASE) - IF (IAND(IS,1).EQ.0) GOTO 999 -C -C - BPD_PROTO_WRITE = PPD_SUCCESS - RETURN -C - 999 BPD_PROTO_WRITE = IS - RETURN - END -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - INTEGER*4 FUNCTION BPD_PROTO_INQ (NPROT,LPROT) -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' -C - INTEGER*4 NPROT ! (o) nr of entries - INTEGER*4 LPROT ! (o) significant length in bytes -C -C.Purpose: Get information about the prototype description buffer -C.Returns: Status code (.TRUE. for success, .FALSE. otherwise) -C success PPD_SUCCESS -C.Notes: -C------------------------------------------------------------------------- -C - INCLUDE 'BLDPPD_2_DEF' -C - NPROT = BPD$PROT(5) - LPROT = BPD$PROT(4) -C - BPD_PROTO_INQ = PPD_SUCCESS - RETURN - END diff --git a/src/dwarf/bpdref.fsc b/src/dwarf/bpdref.fsc deleted file mode 100644 index f7a284ea0ecb3bde35965bafef9a0460929aff21..0000000000000000000000000000000000000000 --- a/src/dwarf/bpdref.fsc +++ /dev/null @@ -1,242 +0,0 @@ -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ -C.Ident: BPD_REF -C.Keywords: PPD file, Build, Cross References -C.Author: Friso Olnon (NFRA, Dwingeloo) -C.Language: DWARF-Fortran -C.Environment: VAX or Alliant -C.Comments: -C Common variables used: -C INTEGER*4 BPD$REFNR ! (m) nr of references -C CHARACTER*16 BPD$REFNAM(*) ! (m) names of referenced PPD files -C -C.Version: 900415 FMO - recreation -C.Version: 900502 FMO - new GEN_LUN module -C.Version: 920213 GvD - no optional arguments anymore -C.Version: 920424 GvD - only call LIST_CLOSE if OLDLUN>=0 -C.Version: 930923 CMV - logical names for new maintenance system -C.Version: 940118 CMV - used WNCFOP, WNCALN i.s.o. DWARF stuff -C.Version: 940211 WNB - change file inquire -C.Version: 010629 AXC - Linux port -C------------------------------------------------------------------------- -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - INTEGER*4 FUNCTION BPD_REF_UPDATE (PPDREF) -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' -C - CHARACTER*(*) PPDREF ! (i) name of referenced PPD file -C -C.Purpose: Add the name to the reference list -C.Returns: Status code (.TRUE. for success, .FALSE. otherwise) -C success PPD_SUCCESS -C fatal PPD_REFEXCMAX too many references -C.Notes: -C------------------------------------------------------------------------- -C - INCLUDE 'BLDPPD_2_DEF' -C - INTEGER*4 STR_MATCH_A, MSG_SET -C - INTEGER*4 IS, NR -C -C -C If the complete name doesn't -C occur in the list, add it -C - IS = 0 - IF (BPD$REFNR.GT.0) - 1 IS = STR_MATCH_A (PPDREF,BPD$REFNR,BPD$REFNAM,NR) - IF (IS.NE.1) THEN - IF (BPD$REFNR.EQ.BPD__REFMAX) GOTO 999 - BPD$REFNR = BPD$REFNR+1 - BPD$REFNAM(BPD$REFNR) = PPDREF - ENDIF -C - BPD_REF_UPDATE = PPD_SUCCESS - RETURN -C - 999 BPD_REF_UPDATE = MSG_SET (PPD_REFEXCMAX,0) - RETURN - END -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - INTEGER*4 FUNCTION BPD_REF_WRITE (PROGNAM) -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' -C - CHARACTER*(*) PROGNAM ! (i) name of the new PPD file -C -C.Purpose: Write a new version of the PPD cross-reference file -C.Returns: Status code (.TRUE. for success, .FALSE. otherwise) -C success PPD_SUCCESS -C false status returned by referenced modules -C.Notes: -C Existing references from <prognam>.PPD are removed, and the new -C ones are added. -C------------------------------------------------------------------------- -C - INCLUDE 'BLDPPD_2_DEF' -C - CHARACTER*(*) REFFILE - PARAMETER (REFFILE = 'PPD.REF') -C - INTEGER*4 GEN_FORIOS - INTEGER*4 FILNAM_FULL - INTEGER WNCAL0 - LOGICAL WNFOP -C - CHARACTER OLDSPEC*80, NEWSPEC*80, LINE*32, NAMPPD*16 - INTEGER*4 IS, LO, LN, LL, OLDLUN, NEWLUN - LOGICAL EXIST - INTEGER FCAT -C -C -C Open DWARF's PPD reference file -C - OLDLUN = -1 - IS = FILNAM_FULL (REFFILE,OLDSPEC,LO,'n_exe') - IF (IAND(IS,1).EQ.0) GOTO 999 - EXIST=WNFOP(FCAT,OLDSPEC(:LO),'R') - IF (EXIST) THEN - CALL WNFCL(FCAT) - IS=0 - CALL WNGLUN(OLDLUN) - IF (OLDLUN.EQ.0) GOTO 999 - OPEN (UNIT=OLDLUN,FILE=OLDSPEC(:LO), -#ifdef wn_li__ - 1 STATUS='OLD',ERR=998) -#else - 1 READONLY,STATUS='OLD',ERR=998) -#endif - - ENDIF -C -C Open new user's PPD reference file -C in the current directory -C - IS = FILNAM_FULL (REFFILE,NEWSPEC,LN,' ') - IF (IAND(IS,1).EQ.0) GOTO 997 - NEWLUN=-1 - CALL WNCFOP(NEWLUN,NEWSPEC(:LN)) - IF (NEWLUN.EQ.-1) GOTO 997 -C -C Copy the records with references -C from other PPD files -C - IF (EXIST) THEN - LL = 0 - DO WHILE (LL.GE.0) - READ(OLDLUN,'(A)',IOSTAT=IS) LINE - IF (IAND(IS,1).EQ.0) GOTO 995 - LL=WNCAL0(LINE) - IF (LL.GT.0 .AND. LINE(:16).NE.PROGNAM) - 1 CALL WNCTXT(NEWLUN,'!AS',LINE) - ENDDO - ENDIF -C -C Add records with the references -C from the new PPD file -C - NAMPPD = PROGNAM - DO I = 1,BPD$REFNR - CALL WNCTXT(NEWLUN,'!AS!AS',NAMPPD,BPD$REFNAM(I)) - ENDDO -C - IS = PPD_SUCCESS - 995 CALL WNCFCL(NEWLUN) - 997 IF (OLDLUN.GE.0) THEN - CLOSE(OLDLUN) - CALL WNGLUF(OLDLUN) - ENDIF - 999 BPD_REF_WRITE = IS - RETURN -C - 998 BPD_REF_WRITE = GEN_FORIOS (OLDSPEC(:LO)) - IF (OLDLUN.GE.0) CALL WNGLUF(OLDLUN) - RETURN - END -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - INTEGER*4 FUNCTION BPD_REF_LIST (PROGNAM,PRTFLAGS) -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' -C - CHARACTER*(*) PROGNAM ! (i) name of the new PPD file - INTEGER*4 PRTFLAGS ! (i) disposition flags -C -C.Purpose: Create a list of PPD files referencing the new PPD file -C.Returns: Status code (.TRUE. for success, .FALSE. otherwise) -C success PPD_SUCCESS -C false status returned by referenced modules -C.Notes: -C Existing references from <prognam>.PPD are removed, and the new -C ones are added. -C------------------------------------------------------------------------- -C -C - LOGICAL L__FALSE - PARAMETER (L__FALSE = .FALSE.) -C - CHARACTER*(*) REFFILE, LISTYPE - PARAMETER (REFFILE = 'PPD.REF') - PARAMETER (LISTYPE = '.RLIS') -C - INTEGER WNCALN - INTEGER*4 FILNAM_FULL -C - CHARACTER REFSPEC*80, LINE*32, LISTSPEC*80, TMP*80 - INTEGER*4 IS, LR, LL, LP, LS, REFLUN, LISTID - LOGICAL*4 REF_FOUND -C -C -C Open the user's PPD reference file -C in the current directory -C - IS = FILNAM_FULL (REFFILE,REFSPEC,LR,' ') - IF (IAND(IS,1).EQ.0) GOTO 999 - IS=0 - CALL WNGLUN(REFLUN) - IF (REFLUN.EQ.0) GOTO 998 - OPEN(UNIT=REFLUN,FILE=REFSPEC(:LR),STATUS='OLD',IOSTAT=IS) - IF (IAND(IS,1).EQ.0) GOTO 998 -C -C Open the PPD reference list file -C in the current directory -C - LISTID = -1 - LP = WNCALN(PROGNAM) - TMP=PROGNAM(:LP)//LISTYPE - IS = FILNAM_FULL (TMP,LISTSPEC,LS,' ') - IF (IAND(IS,1).NE.0) CALL WNCFOP(LISTID,LISTSPEC(:LS)) - IF (LISTID.EQ.-1) GOTO 997 -C -C Fill the print header -C - CALL WNCFHD(LISTID,2,'The following PPD files use !AS.PPD'// - 1 ' as external reference :',PROGNAM(:LP)) - IF (IAND(IS,1).EQ.0) GOTO 996 -C -C Read the references to the new PPD file -C and write them to the print file -C - REF_FOUND = .FALSE. - LL = 0 - DO WHILE (LL.GE.0) - READ(REFLUN,'(A)',IOSTAT=IS) LINE - IF (IAND(IS,1).EQ.0) GOTO 996 - LL=WNCALN(LINE) - TMP=PROGNAM(:LP)//':' - IF (LL.GT.16 .AND. LINE(17:).EQ.TMP) THEN - REF_FOUND = .TRUE. - CALL WNCTXT(LISTID,'!2_!AS',LINE(:16)) - ENDIF - ENDDO - IF (.NOT.REF_FOUND) CALL WNCTXT(LISTID,'!2_no references') -C - IS = PPD_SUCCESS - 996 CALL WNFCL(LISTID) - 997 CLOSE(REFLUN) - 998 CALL WNGLUF(REFLUN) - 999 BPD_REF_LIST = IS - RETURN - END diff --git a/src/dwarf/bpdstore.for b/src/dwarf/bpdstore.for deleted file mode 100644 index 750f1d53bbc93d38d6602dec3a62980b0c981b9a..0000000000000000000000000000000000000000 --- a/src/dwarf/bpdstore.for +++ /dev/null @@ -1,68 +0,0 @@ -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ -C.Ident: BPD_STORE -C.Keywords: PPD File, Store Parameter Description -C.Author: Friso Olnon (NFRA, Dwingeloo) -C.Language: DWARF-Fortran -C.Environment: VAX or Alliant -C.Comments: -C.Version: 900415 FMO - recreation -C.Version: HjV 930427 - Change size STRING from 2000 to 2500 -C.Version: HjV 930613 - Change size STRING from 2500 to 5000 -C.Version: HjV 940829 - Change size STRING from 5000 to 10000 -C------------------------------------------------------------------------- -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - INTEGER*4 FUNCTION BPD_STORE () -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' -C -C -C.Purpose: Add a parameter description to the dynamic buffer -C.Returns: Status code (.TRUE. for success, .FALSE. otherwise) -C success PPD_SUCCESS -C false status returned by referenced routines -C.Notes: -C------------------------------------------------------------------------- -C -C - INTEGER*4 PPD_UNAM_GET, PPD_DVSTR_GET - INTEGER*4 BPD_PARM_PUT, BPD_PROTO_PUT, BPD_INDEX_PUT - INTEGER*4 BP_DEF_CHECK, CPL_ERR_PUT -C - CHARACTER STRING*10000, NAME*16 - INTEGER*4 IS, LN, LMIN, PDOFF - LOGICAL*4 PROTOTYPE - INTEGER*4 LSTR, LNR -C -C -C Add the description and an index -C entry to the appropriate buffers -C - IS = PPD_UNAM_GET (NAME,LN,LMIN,PROTOTYPE) - IF (IAND(IS,1).EQ.0) GOTO 999 - IF (PROTOTYPE) THEN - IS = BPD_PROTO_PUT (PDOFF) - ELSE - IS = BPD_PARM_PUT (PDOFF) - ENDIF - IF (IAND(IS,1).NE.0) IS = BPD_INDEX_PUT (PDOFF) - IF (IAND(IS,1).EQ.0) GOTO 999 -C -C Check default value string -C - IS = PPD_DVSTR_GET (STRING,LSTR) - IF (LSTR.GT.0) THEN - IS = BP_DEF_CHECK (STRING(:LSTR)) - IF (IAND(IS,1).EQ.0) THEN - IS = CPL_ERR_PUT (PPD_DEFVALINV,LNR) - IF (IAND(IS,1).EQ.0) GOTO 999 - ENDIF - ENDIF -C -C - BPD_STORE = PPD_SUCCESS - RETURN -C - 999 BPD_STORE = IS - RETURN - END diff --git a/src/dwarf/bpdwrite.for b/src/dwarf/bpdwrite.for deleted file mode 100644 index ea3e57fae496ef5f2eb0fde231cb6c3b48238b39..0000000000000000000000000000000000000000 --- a/src/dwarf/bpdwrite.for +++ /dev/null @@ -1,158 +0,0 @@ -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ -C.Ident: BPD_WRITE -C.Keywords: PPD File, Build, Write the PPD File -C.Author: Friso Olnon (NFRA, Dwingeloo) -C.Language: DWARF-Fortran -C.Environment: VAX or Alliant -C.Comments: -C.Version: 900415 FMO - recreation -C.Version: 920224 GvD - no optional arguments in MSG anymore -C.Version: 930923 CMV - logical names for new maintenance system -C.Version: 010907 AXC - linuxport - tmpchar in calls -C------------------------------------------------------------------------- -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - INTEGER*4 FUNCTION BPD_WRITE (PROGNAM,PASSNR) -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' -C - CHARACTER*(*) PROGNAM ! (i) program name - INTEGER*4 PASSNR ! (i) compilation pass nr -C -C.Purpose: Write the PPD file to disk -C.Returns: Status code (.TRUE. for success, .FALSE. otherwise) -C success PPD_SUCCESS -C error PPD_NOSUCCESS compilation errors found -C false status codes returned by referenced modules -C.Notes: -C------------------------------------------------------------------------- -C - INCLUDE 'PPDREC_4_DEF' -C - CHARACTER*(*) OBJTYPE - INTEGER*4 RECLEN - PARAMETER (OBJTYPE = '.PPD') - PARAMETER (RECLEN = 512) -C - INTEGER*4 BPD_INDEX_SORT ,BPD_INDEX_UNIQ - INTEGER*4 BPD_INDEX_INQ ,BPD_INDEX_WRITE - INTEGER*4 BPD_PARM_INQ ,BPD_PARM_WRITE - INTEGER*4 BPD_HELP_INQ ,BPD_HELP_WRITE - INTEGER*4 BPD_PROTO_INQ ,BPD_PROTO_WRITE - INTEGER*4 CPL_OBJ_OPEN ,CPL_OBJ_WRITE ,CPL_OBJ_CLOSE - INTEGER*4 CPL_OBJ_DELETE ,CPL_ERR_GETSUM - INTEGER STR_SIGLEN, MSG_SET, FILNAM_FULL -C - CHARACTER*80 FILESPEC,TMP - INTEGER*4 IS, NENTRIES, NBYTES, NERR, NWARN, LP, LF -C -C -C Delete the 1-st pass PPD file -C - IF (PASSNR.GT.1) THEN - IS = CPL_OBJ_DELETE () - IF (IAND(IS,1).EQ.0) GOTO 999 - ENDIF -C -C If compilation errors: return -C - IS = CPL_ERR_GETSUM (NERR,NWARN) - IF (IAND(IS,1).NE.0 .AND. NERR.GT.0) - 1 IS = MSG_SET (PPD_NOSUCCESS,0) - IF (IAND(IS,1).EQ.0) GOTO 999 -C -C Finalize the index buffer -C - sort on ascending program's name -C - determine and store for each parameter -C the minimum nr of characters that -C uniquely identify the user's name -C - IS = BPD_INDEX_SORT () - IF (IAND(IS,1).NE.0) IS = BPD_INDEX_UNIQ () - IF (IAND(IS,1).EQ.0) GOTO 999 -C -C Build the file description block -C - NBYTES = PPDFD__LENGTH*4 - PPDFD$STOT = ((NBYTES-1)/RECLEN+1)*RECLEN -C - IS = BPD_INDEX_INQ (NENTRIES,NBYTES) - IF (IAND(IS,1).EQ.0) GOTO 999 - PPDFD$NINDEX = NENTRIES - IF (NENTRIES.GT.0) THEN - PPDFD$INDEX = PPDFD$STOT - PPDFD$SINDEX = ((NBYTES-1)/RECLEN+1)*RECLEN - PPDFD$STOT = PPDFD$STOT+PPDFD$SINDEX - ELSE - PPDFD$INDEX = UNDEF_J - PPDFD$SINDEX = 0 - ENDIF -C - IS = BPD_PARM_INQ (NENTRIES,NBYTES) - IF (IAND(IS,1).EQ.0) GOTO 999 - PPDFD$NPARM = NENTRIES - IF (NENTRIES.GT.0) THEN - PPDFD$PARM = PPDFD$STOT - PPDFD$SPARM = ((NBYTES-1)/RECLEN+1)*RECLEN - PPDFD$STOT = PPDFD$STOT+PPDFD$SPARM - ELSE - PPDFD$PARM = UNDEF_J - PPDFD$SPARM = 0 - ENDIF -C - IS = BPD_HELP_INQ (NENTRIES,NBYTES) - IF (IAND(IS,1).EQ.0) GOTO 999 - IF (NENTRIES.GT.0) THEN - PPDFD$HELP = PPDFD$STOT - PPDFD$SHELP = ((NBYTES-1)/RECLEN+1)*RECLEN - PPDFD$STOT = PPDFD$STOT+PPDFD$SHELP - ELSE - PPDFD$HELP = UNDEF_J - PPDFD$SHELP = 0 - ENDIF -C - IS = BPD_PROTO_INQ (NENTRIES,NBYTES) - IF (IAND(IS,1).EQ.0) GOTO 999 - PPDFD$NPARMPT = NENTRIES - IF (NENTRIES.GT.0) THEN - PPDFD$PARMPT = PPDFD$STOT - PPDFD$SPARMPT = ((NBYTES-1)/RECLEN+1)*RECLEN - PPDFD$STOT = PPDFD$STOT+PPDFD$SPARMPT - ELSE - PPDFD$PARMPT = UNDEF_J - PPDFD$SPARMPT = 0 - ENDIF -C - LP = STR_SIGLEN (PROGNAM) - PPDFD$IMAGE = PROGNAM(:LP) -C -C Open the object file in -C the current directory -C - TMP=PROGNAM(:LP)//OBJTYPE - IS = FILNAM_FULL (TMP,FILESPEC,LF,' ') - IF (IAND(IS,1).NE.0) IS = CPL_OBJ_OPEN (FILESPEC(:LF),RECLEN) - IF (IAND(IS,1).EQ.0) GOTO 999 -C -C Write the file description block -C and the buffers to the file -C - IS = CPL_OBJ_WRITE (PPDFD_,PPDFD__LENGTH*4) - IF (IAND(IS,1).NE.0) IS = BPD_INDEX_WRITE () - IF (IAND(IS,1).NE.0) IS = BPD_PARM_WRITE () - IF (IAND(IS,1).NE.0) IS = BPD_HELP_WRITE () - IF (IAND(IS,1).NE.0) IS = BPD_PROTO_WRITE () - IF (IAND(IS,1).EQ.0) GOTO 998 -C -C - BPD_WRITE = PPD_SUCCESS - IS = CPL_OBJ_CLOSE () - RETURN -C - 998 BPD_WRITE = IS - IS = CPL_OBJ_DELETE () - RETURN -C - 999 BPD_WRITE = IS - RETURN - END diff --git a/src/dwarf/calculate.for b/src/dwarf/calculate.for deleted file mode 100644 index 05184552b7f10d353bbec37ae9b615052a23c538..0000000000000000000000000000000000000000 --- a/src/dwarf/calculate.for +++ /dev/null @@ -1,597 +0,0 @@ -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ -C.Ident: SYS_CALCULATE -C.Keywords: Calculator -C.Author: Friso Olnon (NFRA, Dwingeloo) -C.Language: DWARF-Fortran -C.Environment: Any -C.Comments: -C.Version: 900416 FMO - recreation -C.Version: 911022 GvD - print sign when negative 0:MM:SS -C suppress bell when showing answers -C.Version: 920206 GvD - add former optional arguments to CLI_GET/DWC_INPUT -C.Version: 920512 GvD - adapted completely to UNIX -C.Version: 930923 CMV - logical names for new maintenance system -C.Version: 940118 CMV - used WNCFOP, WNCALN i.s.o. DWARF stuff -C.Version: 940119 CMV - removed messenger -C------------------------------------------------------------------------- -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - SUBROUTINE CALCULATE -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' -C -C -C.Purpose: Calculate expressions typed in by the user -C.Returns: Not applicable -C.Notes: -C - It is possible to define a symbol with the calculated value. -C------------------------------------------------------------------------- -C -C - CHARACTER*(*) PROGNAME, BLANK, EXPERR - PARAMETER (PROGNAME = 'CALCULATE') - PARAMETER (BLANK = ' ') - PARAMETER (EXPERR = 'Error at or near position !SJ '// - 1 'in value-string:!/ !AS') -C - INTEGER*4 NRARG, Q, QVAL - PARAMETER (NRARG = 7) - PARAMETER (Q = CLI__QUALIFIER) - PARAMETER (QVAL = CLI__QUALIFIER+CLI__VALUE) - CHARACTER*10 NAME(NRARG) - INTEGER*4 ATTR(NRARG) - CHARACTER*1 PROMPT(NRARG) - CHARACTER*12 DEFVAL(NRARG) - DATA NAME /'EXPRESSION' - 1 ,'TYPE','RADIX','STREAM','LIST','UNIT','LOG'/ - DATA ATTR /CLI__EXPRESSION - 1 ,QVAL ,QVAL ,QVAL ,Q ,QVAL ,Q/ - DATA PROMPT /NRARG*' '/ - DATA DEFVAL /NRARG*' '/ -C - INTEGER*4 CALCUL_DEF, CALCUL_QUAL - INTEGER*4 DWC_CTL_OPEN, DWC_INPUT - INTEGER*4 DWC_TSTSYM, DWC_STR_SUBST, DWC_EXPCAL - INTEGER*4 CLI_INIT, CLI_GET, CLI_PARSE - INTEGER*4 GEN_CVT_D_NR, GEN_CVT_NR_D, GEN_CVT_NR_L - INTEGER*4 SYMBOL_DEFINE - INTEGER*4 STR_COPY_U, STR_SKIP_U, STR_SKIP_W - INTEGER WNCAL0 -C - CHARACTER*255 LINE, COMMAND, INPUT, EXPRESSION, UNITSTR, RESULT - CHARACTER STREAM*12, SYMBOL*16, DATTYP*1, INTTYP*1, FORM*5 - INTEGER*4 LL, LC, LI, LX, LU, LR, LSYM - INTEGER*4 IS, TMP, PTR, DD, MM, RADIX, LOGID - LOGICAL*4 DO_LIST, DO_LOG, IS_DCL - REAL*8 VALUE, R8, SS - BYTE BHULP(16) - LOGICAL*4 SWSYM, SWSIGN - DATA LOGID /0/ - DATA IS_DCL /.FALSE./ -C -C -C Initialize -C - get DWARF control variables -C - initialize command-line interpreter -C - IS = DWC_CTL_OPEN () ! ignore false return - IF (IAND(IS,1).NE.0) IS = CLI_INIT (NRARG,NAME,ATTR,PROMPT,DEFVAL) - IF (IAND(IS,1).EQ.0) GOTO 990 -C -C Get and interpret initial command line -C - no expression is allowed -C - set new argument attributes and -C default values, using the qualifiers -C supplemented with program defaults -C - IS = CLI_GET (BLANK,COMMAND,LC) - IF (IAND(IS,1).NE.0) IS = CLI_GET ('EXPRESSION',EXPRESSION,LX) - IF (IAND(IS,1).NE.0 .AND. LX.GT.0) - 1 CALL WNCTXT(F_T,'Sorry, you cannot give '// - 1 'an expression on the commandline') - IF (IAND(IS,1).NE.0) IS = CALCUL_DEF (ATTR,DEFVAL) - IF (IAND(IS,1).EQ.0) GOTO 990 -C -C Ask input line and save it -C - stop if end-of-input is given -C (CTRL/Z,'#' or ' ') -C - 100 TMP = DWC_INPUT (INPUT,'Expression',LI,0,0) - IF (IAND(TMP,1).EQ.0 .OR. LI.EQ.0) GOTO 900 -C -C Substitute apostrophed symbols -C - TMP = DWC_STR_SUBST (INPUT(:LI),LINE,LL,BLANK,PTR,.FALSE.,SWSYM) - IF (IAND(TMP,1).EQ.0) THEN - CALL WNCTXT(F_T,EXPERR,PTR,INPUT(:LI)) - GOTO 100 - ENDIF -C -C Process help request -C - IF (LINE(:LL).EQ.'?') THEN - CALL WNCTXT(F_T,'No on-line help available') - GOTO 100 - ENDIF -C -C Interpret the input line -C - reset the command-line interpreter -C - parse the line -C - process the qualifiers -C - get the expression -C - TMP = CLI_INIT (NRARG,NAME,ATTR,PROMPT,DEFVAL) - IF (IAND(TMP,1).NE.0) TMP = CLI_PARSE (LINE(:LL)) - IF (IAND(TMP,1).NE.0) - 1 TMP = CALCUL_QUAL (DATTYP,RADIX,STREAM,DO_LIST,DO_LOG,UNITSTR) - IF (IAND(TMP,1).NE.0) TMP = CLI_GET ('EXPRESSION',LINE,LL) - IF (IAND(TMP,1).EQ.0) THEN - IS = TMP - GOTO 100 - ENDIF -C -C If format is: <name> = <expression> -C - a symbol must be defined -C - isolate and check the symbol name -C - determine start of expression -C - PTR = 1 - LSYM = 0 - TMP = STR_COPY_U ('=',LINE(:LL),PTR,SYMBOL,LSYM) - IF (PTR.GT.LL) THEN - LSYM = 0 - PTR = 1 - ELSE - IF (LSYM.GT.0) LSYM = WNCAL0(SYMBOL(:LSYM)) - IF (LSYM.GT.0) THEN - TMP = DWC_TSTSYM (SYMBOL(:LSYM)) - IF (IAND(TMP,1).EQ.0) THEN - IS = TMP - GOTO 100 - ENDIF - ENDIF - PTR = PTR+1 - TMP = STR_SKIP_W (BLANK,LINE(:LL),PTR) - ENDIF - EXPRESSION = LINE(PTR:LL) - LX = LL-PTR+1 -C -C If 'UNIT=?' is given: -C - spawn PRTUNITS.COM and ask again -C - IF (LSYM.GT.0 .AND. EXPRESSION(:LX).EQ.'?') THEN - IF (INDEX('UNITS',SYMBOL(:LSYM)).NE.1) THEN - CALL WNCTXT(F_T,'HELP is only possible for UNITS') - ELSE - CALL PRTUNITS() - ENDIF - GOTO 100 - ENDIF -C -C If the expression is quoted: -C - remove the quotes -C - don't evaluate the expression -C - IF (EXPRESSION(1:1).EQ.'"' .AND. EXPRESSION(LX:LX).EQ.'"') THEN - RESULT = EXPRESSION(2:LX-1) - LR = LX-2 -C -C Check and evaluate the expression -C - internal datatype: 'I' i.s.o. 'L' -C - evaluate to REAL*8 value -C - convert to proper datatype -C - ELSE - SWSYM = .FALSE. - INTTYP = DATTYP - IF (INTTYP.EQ.'L') INTTYP = 'I' - TMP = DWC_EXPCAL (EXPRESSION,UNITSTR,STREAM,.FALSE.,SWSYM, - 1 VALUE,PTR) - IF (IAND(TMP,1).EQ.0) THEN - CALL WNCTXT(F_T,'Syntax error in the expression') - GOTO 100 - ENDIF - TMP = GEN_CVT_D_NR (INTTYP,VALUE,BHULP) - IF (TMP.NE.GEN_SUCCESS) THEN - IF (IAND(TMP,1).NE.0) - 1 CALL WNCTXT(F_T,'Integer overflow during '// - 1 'conversion to !AS data type',INTTYP) - CALL WNCTXT(F_T,EXPERR,PTR,EXPRESSION) - GOTO 100 - ENDIF -C -C Process the answer -C - isolate the default unitcode -C - PTR = 1 - TMP = STR_SKIP_U (',',UNITSTR,PTR) - LU = WNCAL0(UNITSTR(:PTR-1)) -C -C - normal conversion to ASCII string -C - convert logicals first from integer -C to logical value -C - IF (UNITSTR(:LU).NE.'DMS' .AND. UNITSTR(:LU).NE.'HMS') THEN - IF (DATTYP.EQ.'R') THEN - FORM = '!E' - ELSE IF (DATTYP.EQ.'D' .OR. DATTYP.EQ.'L') THEN - FORM = '!'//DATTYP - ELSE - IF (RADIX.EQ.1) THEN - FORM = '!S'//DATTYP - ELSE IF (RADIX.EQ.2) THEN - FORM = '%O!O'//DATTYP - ELSE IF (RADIX.EQ.3) THEN - FORM = '%X!X'//DATTYP - ENDIF - ENDIF - IF (DATTYP.EQ.'L') TMP = GEN_CVT_NR_L (INTTYP,BHULP) - CALL WNCTXS(RESULT,FORM,BHULP) - LR=WNCAL0(RESULT) -C -C - convert to DD:MM:SS.SSSSSS string -C - ELSE - TMP = GEN_CVT_NR_D (INTTYP,BHULP,R8) ! -> REAL*8 - SWSIGN = R8.LT.0 - IF (SWSIGN) R8 = -R8 - DD = INT(R8) ! unsigned DD - R8 = (R8-DD)*60 - MM = INT(R8) ! unsigned MM - SS = (R8-MM)*60 ! SS.SSSSSS - IF (SWSIGN) THEN - CALL WNCTXS(RESULT,'-!SJ:!SJ:!D.6', - 1 DD,MM,SS) - ELSE - CALL WNCTXS(RESULT,'!SJ:!SJ:!D.6', - 1 DD,MM,SS) - ENDIF - LR=WNCAL0(RESULT) - ENDIF - ENDIF -C -C Output the result -C - type if /LIST -C - define the symbol -C - log if /LOG -C Symbol assignments are prefixed with -C '$'; all other lines are prefixed with -C '!'. The log file can later be executed -C as a command file. -C - IF (DO_LIST) THEN - IF (LSYM.GT.0) THEN - CALL WNCTXT(F_T,'!5C!AS = !AS', - 1 SYMBOL(:LSYM),RESULT(:LR)) - ELSE - CALL WNCTXT(F_T,'!5C = !AS',RESULT(:LR)) - END IF - END IF -C - IF (LSYM.GT.0) TMP = SYMBOL_DEFINE (SYMBOL(:LSYM), - 1 RESULT(:LR),DWC__GLOBALSYM) -C - IF (DO_LOG) THEN - LOGID=1 !Flag logging occurred - CALL WNCTXT(F_P,'$!! Expression: !AS',INPUT(:LI)) - IF (LSYM.GT.0) THEN - CALL WNCTXT(F_P,'$!_!AS :== !AS', - 1 SYMBOL(:LSYM),RESULT(:LR)) - ELSE - CALL WNCTXT(F_P,'$!! = !AS',RESULT(:LR)) - ENDIF - ENDIF -C - GOTO 100 -C -900 CONTINUE -990 IF (LOGID.EQ.0) LOGCD=F_NO !Throw away if empty - END -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - SUBROUTINE PRTUNITS() -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' -C - INTEGER*4 READ_UNITG_ALL, READ_UNITG, READ_UNIT - INTEGER*4 STR_COPY_U - INTEGER WNCALN -C - CHARACTER GLIST*80, ULIST*255, GROUP*10, UNIT*8, DUM*1 - INTEGER*4 IS, LGL, LUL, PTR, PTR2, LG, LU, LDUM - INTEGER*4 PRTID /0/, PRTFLAGS, MSGFLAGS - REAL*8 FACTOR -C - CALL WNCTXT(F_TP,'Currently recognized DWARF units:') - CALL WNCTXT(F_TP,'!2/!5CGroup !15CUnit !25CFactor') -C -C Write to print file -C - IS = READ_UNITG_ALL (GLIST) ! get all groups - IF (IAND(IS,1).EQ.0) GOTO 999 - LGL = WNCALN(GLIST) - PTR = 1 - DO WHILE (PTR.LE.LGL) - LG = 0 - IS = STR_COPY_U (',',GLIST(:LGL),PTR,GROUP,LG) ! next group - IS = READ_UNITG (GROUP(:LG),ULIST) ! get all units - IF (IAND(IS,1).EQ.0) GOTO 999 - LUL = WNCALN(ULIST) - PTR2 = 1 - LU = 0 - IS = STR_COPY_U (',',ULIST(:LUL),PTR2,UNIT,LU) ! first unit - IS = READ_UNIT (UNIT(:LU),GROUP,FACTOR) ! get factor - IF (IAND(IS,1).EQ.0) GOTO 999 - CALL WNCTXT(F_TP,'!/!5C!AS !15C!AS !25C!D', - 1 GROUP(:LG),UNIT(:LU),FACTOR) - PTR2 = PTR2+1 - DO WHILE (PTR2.LE.LUL) ! do all units - LU = 0 - IS = STR_COPY_U (',',ULIST(:LUL),PTR2,UNIT,LU) - IS = READ_UNIT (UNIT(:LU),GROUP,FACTOR) - IF (IAND(IS,1).EQ.0) GOTO 999 - CALL WNCTXT(F_TP,'!15C!AS !25C!D',UNIT(:LU),FACTOR) - PTR2 = PTR2+1 - ENDDO - PTR = PTR+1 - ENDDO - RETURN -C - 999 CALL WNCTXT(F_TP,'Error reading units...') - RETURN - END -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - INTEGER*4 FUNCTION CALCUL_QUAL (DATTYP,RADIX,STREAM, - 1 DO_LIST,DO_LOG,UNITSTR) -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' -C - CHARACTER*(*) DATTYP ! (o) data type - INTEGER*4 RADIX ! (o) data-radix - CHARACTER*(*) STREAM ! (o) stream name - LOGICAL*4 DO_LIST ! (o) list ? - LOGICAL*4 DO_LOG ! (o) log ? - CHARACTER*(*) UNITSTR ! (o) string with possible unitcodes -C -C.Purpose: Check/convert the qualifiers of the program CALCULATE -C.Returns: Status code (.TRUE. for success, .FALSE. otherwise) -C success DWC_SUCCESS -C error DWC_CALINVTYP invalid datatype -C error DWC_CALINVRAD invalid radix -C error DWC_STRINVNR invalid stream name -C .false. status codes from CLI or READ_UNIT routines -C.Notes: -C - If a qualifier is negated, the program default will be used. -C - If a unitcode is given, all possible unitcodes of the same group will -C be appended (comma-separated list). The given unitcode will be used -C as the default by the EXP-routines. -C - If an error is detected, a message will be written. -C------------------------------------------------------------------------- -C - CHARACTER*(*) BLANK - PARAMETER (BLANK = ' ') -C - INTEGER*4 DWC_STREAM_CHECK, DWC_STREAM_GET, CLI_GET - INTEGER*4 READ_UNIT, READ_UNITG -C - REAL*8 FACTOR - CHARACTER VAL*80, GROUP*16, DUM*1 - INTEGER*4 IS, LS, LVAL, LDUM, TYPNR - CHARACTER RADLIST*3, TYPLIST*6 - DATA RADLIST /'DOX'/ ! decimal, octal, hexadecimal - DATA TYPLIST /'BIJLRD'/ ! I1, I2, I4, L2, R4, R8 -C -C -C -C Output radix -C - ignore '%' in qualifier value -C - set to decimal if /NORADIX -C - IS = CLI_GET ('RADIX',VAL,LVAL) - IF (IS.EQ.DWC_PRESENT) THEN - IF (VAL(1:1).EQ.'%') THEN - RADIX = INDEX (RADLIST,VAL(2:2)) - ELSE - RADIX = INDEX (RADLIST,VAL(1:1)) - ENDIF - IF (RADIX.EQ.0) CALL WNCTXT(F_T, - 1 '!AS is an invalid radix-option (D, O or X is valid)', - 2 VAL(:LVAL)) - ELSE IF (IS.EQ.DWC_NEGATED) THEN - RADIX = 1 - ENDIF - IF (IAND(IS,1).EQ.0) GOTO 990 -C -C Data type -C - real*8 if /NOTYPE -C - integer for non-decimal radix -C (type J i.s.o. non-integer types) -C - IS = CLI_GET ('TYPE',VAL,LVAL) - IF (IS.EQ.DWC_PRESENT) THEN - TYPNR = INDEX (TYPLIST,VAL(1:1)) - IF (TYPNR.EQ.0) THEN - CALL WNCTXT(F_T, - 1 '!AS is an invalid datatype (B,I,J,L,R,D are valid)', - 2 VAL(:LVAL)) - GOTO 990 - ENDIF - ELSE IF (IS.EQ.DWC_NEGATED) THEN - TYPNR = 6 - ENDIF - IF (IAND(IS,1).EQ.0) GOTO 990 - IF (RADIX.GT.1) TYPNR = MIN(3,TYPNR) - DATTYP = TYPLIST(TYPNR:TYPNR) -C -C Stream name -C - check syntax and prefix '$' if needed -C - use DWARF$STREAM if /NOSTREAM -C - IS = CLI_GET ('STREAM',VAL,LVAL) - IF (IS.EQ.DWC_PRESENT) THEN - IS = DWC_STREAM_CHECK (VAL(:LVAL),STREAM,LS,.FALSE.) - ELSE IF (IS.EQ.DWC_NEGATED) THEN - IS = DWC_STREAM_GET (STREAM,LS,.FALSE.) - ENDIF - IF (IAND(IS,1).EQ.0) GOTO 990 -C -C List flag -C - IS = CLI_GET ('LIST',DUM,LDUM) - DO_LIST = IS.EQ.DWC_PRESENT - IF (IAND(IS,1).EQ.0) GOTO 990 -C -C Log flag -C - IS = CLI_GET ('LOG',DUM,LDUM) - DO_LOG = IS.EQ.DWC_PRESENT - IF (IAND(IS,1).EQ.0) GOTO 990 -C -C Unit code -C - no unit if /NOUNIT -C - append all unit codes in the group -C - IS = CLI_GET ('UNIT',VAL,LVAL) - IF (IAND(IS,1).EQ.0) GOTO 990 - IF (IS.EQ.DWC_NEGATED) THEN - VAL = '1' - LVAL = 1 - ENDIF - IS = READ_UNIT (VAL(:LVAL),GROUP,FACTOR) - IF (IAND(IS,1).NE.0) THEN - UNITSTR = VAL(:LVAL)//',' - IS = READ_UNITG (GROUP,UNITSTR(LVAL+2:)) - ENDIF - IF (IAND(IS,1).EQ.0) GOTO 990 -C - CALCUL_QUAL = DWC_SUCCESS - RETURN -C - 990 CALCUL_QUAL = IS - RETURN - END -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - INTEGER*4 FUNCTION CALCUL_DEF (ATTR,DEFVAL) -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' -C - INTEGER*4 ATTR(*) ! (m) argument attributes - CHARACTER*(*) DEFVAL(*) ! (m) default values -C -C.Purpose: Modify the default syntax for input to the program CALCULATE -C.Returns: Status code (.TRUE. for success, .FALSE. otherwise) -C success DWC_SUCCESS -C error DWC_CALINVTYP invalid datatype -C error DWC_CALINVRAD invalid radix -C error DWC_STRINVNR invalid stream name -C .false. status codes from CLI or READ_UNIT routines -C.Notes: -C - All qualifiers with a value (TYPE, RADIX, STREAM and UNIT) will be -C set to present-by-default. If the qualifier is present on the initial -C command line, the associated value will be the default. Otherwise, -C the program default will be used ('D', 'D', DWARF$STREAM and '1'). -C - If an error is detected, a message will be written. -C------------------------------------------------------------------------- -C - INTEGER*4 DWC_STREAM_CHECK, DWC_STREAM_GET, CLI_GET - INTEGER*4 READ_UNIT -C - REAL*8 FACTOR - CHARACTER VAL*80, STREAM*12, UNIT*8, GROUP*16, DUM*1 - INTEGER*4 IS, LVAL, LDUM, LS, RADIX, TYPE -C - CHARACTER RADLIST*3, TYPLIST*6 - DATA RADLIST /'DOX'/ ! decimal, octal, hexadecimal - DATA TYPLIST /'BIJLRD'/ ! I1, I2, I4, L2, R4, R8 -C -C -C -C Output radix -C - default: decimal -C - ignore '%' in qualifier value -C - RADIX = 1 - IS = CLI_GET ('RADIX',VAL,LVAL) - IF (IS.EQ.DWC_PRESENT) THEN - IF (VAL(1:1).EQ.'%') THEN - RADIX = INDEX (RADLIST,VAL(2:2)) - ELSE - RADIX = INDEX (RADLIST,VAL(1:1)) - ENDIF - IF (RADIX.EQ.0) CALL WNCTXT(F_T, - 1 '!AS is an invalid radix-option (D, O or X is valid)', - 2 VAL(:LVAL)) - ENDIF - IF (IAND(IS,1).EQ.0) GOTO 990 - ATTR(3) = CLI__QUALIFIER+CLI__DEFAULT+CLI__VALUE - DEFVAL(3) = RADLIST(RADIX:RADIX) -C -C Data type -C - default: REAL*8 -C - integer for non-decimal radix -C (type J i.s.o. non-integer types) -C - TYPE = 6 - IS = CLI_GET ('TYPE',VAL,LVAL) - IF (IS.EQ.DWC_PRESENT) THEN - TYPE = INDEX (TYPLIST,VAL(1:1)) - IF (TYPE.EQ.0) CALL WNCTXT(F_T, - 1 '!AS is an invalid datatype (B,I,J,L,R,D are valid)', - 2 VAL(:LVAL)) - ENDIF - IF (IAND(IS,1).EQ.0) GOTO 990 - IF (RADIX.GT.1) TYPE = MIN(3,TYPE) - ATTR(2) = CLI__QUALIFIER+CLI__DEFAULT+CLI__VALUE - DEFVAL(2) = TYPLIST(TYPE:TYPE) -C -C Stream name -C - default: DWARF$STREAM -C - check syntax and prefix '$' -C - IS = CLI_GET ('STREAM',VAL,LVAL) - IF (IS.EQ.DWC_PRESENT) THEN - IS = DWC_STREAM_CHECK (VAL(:LVAL),STREAM,LS,.FALSE.) - ELSE - IS = DWC_STREAM_GET (STREAM,LS,.FALSE.) - ENDIF - IF (IAND(IS,1).EQ.0) GOTO 990 - ATTR(4) = CLI__QUALIFIER+CLI__DEFAULT+CLI__VALUE - DEFVAL(4) = STREAM(:LS) -C -C List flag -C - default: list the results -C - ATTR(5) = CLI__QUALIFIER+CLI__DEFAULT - IS = CLI_GET ('LIST',DUM,LDUM) - IF (IAND(IS,1).EQ.0) GOTO 990 - IF (IS.EQ.DWC_NEGATED) ATTR(5) = CLI__QUALIFIER -C -C Log flag -C - default: don't log the results -C - ATTR(7) = CLI__QUALIFIER - IS = CLI_GET ('LOG',DUM,LDUM) - IF (IAND(IS,1).EQ.0) GOTO 990 - IF (IS.EQ.DWC_PRESENT) ATTR(7) = CLI__QUALIFIER+CLI__DEFAULT -C -C Unit code -C - default: no unit -C - UNIT = '1' - IS = CLI_GET ('UNIT',VAL,LVAL) - IF (IS.EQ.DWC_PRESENT) THEN - IS = READ_UNIT (VAL(:LVAL),GROUP,FACTOR) - IF (IAND(IS,1).NE.0) UNIT = VAL(:LVAL) - ENDIF - IF (IAND(IS,1).EQ.0) GOTO 990 - ATTR(6) = CLI__QUALIFIER+CLI__DEFAULT+CLI__VALUE - DEFVAL(6) = UNIT -C - CALCUL_DEF = DWC_SUCCESS - RETURN -C - 990 CALCUL_DEF = IS - RETURN - END diff --git a/src/dwarf/calculate.hlp b/src/dwarf/calculate.hlp deleted file mode 100644 index 7c81e21d5d092d92591a10bd58d5acf5cc4017ab..0000000000000000000000000000000000000000 --- a/src/dwarf/calculate.hlp +++ /dev/null @@ -1,263 +0,0 @@ -!CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC -! -! -! *********************************************************** -! * * -! * NETHERLANDS FOUNDATION FOR RADIO ASTRONOMY * -! * P.O. BOX 2 * -! * 7990 AA DWINGELOO * -! * THE NETHERLANDS * -! * * -! *********************************************************** -! -! -! MODULE-NAME: CALCULATE -! ------------ -! -! FILE-NAME: CALCULATE.HLP -! ---------- -! -! BRIEF DESCRIPTION: -! ------------------ -! This file defines the help-text for the program CALCULATE. -! CALCULATE is derived from DWARF (Dwingeloo Westerbork -! Astronomical Reduction Facility). -! -! -! HISTORY: -! -------- -! 8-oct-86 Ger van Diepen -! -! -!CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC -! -! -! -! -! -1 CALCULATE - The program CALCULATE is a handy desk-calculator, allowing the use of - expressions (with units), symbols and formulae. - It is derived from the Dutch image processing system DWARF. - (Dwingeloo Westerbork Astronomical Reduction Facility). - Note that DWARF is designed in such a way, that applications can - run outside the DWARF-environment. - - The program is started by the command CALC(ULATE). - Qualifiers can be used to control the program. If they are given - at the CALC command-line, they serve as a global qualifier. - Global qualifiers can be overridden for each individual expression-line - by ending the line with the qualifiers, preceeded by at least one space - (to distinguish it from the division operator). - - The input expressions are read from SYS$INPUT. - The results are listed on SYS$OUTPUT. - Optionally (part of) input and output can be logged. -2 EXPRESSIONS - After having started the program, the program asks you for an expression. - By giving a null-answer the program will be stopped. - Typing a question mark starts a help session. - Typing UNIT=? will show you the available units on printer or terminal. - - Expressions have the normal arithmetical format, using +,-,*,/,** - and parentheses. Blanks and unary signs are allowed. - However, note that / cannot be preceeded by a blank to distinguish - it from the qualifier-indicator. - The relational operators .NOT.,.EQ.,.NE.,.GT.,.GE.,.LE. and .LT. - are also allowed. - Also available are: - - some built-in functions (goniometric, etc.) - - unit specification and conversion - - special format for time or positions (using colons) - - symbol definition and substitution - - As in DCL, integer numbers can be specified in octal or hexadecimal - format (use %O, %X, resp.). -3 FUNCTIONS - The following functions (similar to Fortran) can be used in expressions: - MIN MAX 1-10 arguments - SIN COS TAN - ASIN ACOS ATAN ATAN2 - ABS - EXP LOG LOG10 - SQRT - TRUNC ROUND - MOD - SIGN - - Default unit for goniometric function is degrees, which can be - overridden via the /UNIT-qualifier or by giving the unit in the - expression. - - The result of SIGN is: - -1 for negative values - 0 for zero - 1 for positive values - - Note that conversion to integer format implies rounding. -3 UNITS - CALCULATE is able of converting from one unit to another. - It converts the units given in the expression to the unit given by - the /UNIT-qualifier. The units must belong to the same group (so - conversion from SEC to KM is impossible). - - A unit can be given at several places: - - after a number e.g. 10DEG - - after a subexpression e.g. (10+3)deg - - after a symbol e.g. PI RAD - - Note that in the last case the blank is significant, else it is - optional. -3 TIME_POSITION - Times and positions can be given in HH:MM:SS (or DD:MM:SS) format - using colons as separators. A unit may follow the value. - Each part can be a floating number, which may exceed 60. - - The output can also be listed in that format by giving - /UNIT=HMS or /UNIT=DMS. - - This sexagesimal format allows for easy addition, subtraction and - conversion of times and positions. -3 SYMBOLS - Symbols are very useful for storing results and for handling formulae. - Both symbol substitution and definition is possible in CALCULATE. - CALCULATE will always define global symbols. - It is also possible to use predefined local or global symbols, - either numeric or alphanumeric. - - By defining a formula as a symbol, it is very easy to calculate - the result of the formula for several values of its parameters. - E.g. $ VOLUME = "4/3*pi*r**3" - $ CALC - Expression: r=3 - Expression: volume - Expression: r=10 - Expression: volume -4 DEFINITION - A symbol can be defined by using the construct: - symbol_name = expression - or - symbol_name = "expression" - - In the first case the expression is evaluated and the result - will be assigned to the symbol. - In the second case the expression-text is assigned to the symbol, - which is useful for defining formulae. - - Note that DCL uses the same procedure. -4 SUBSTITUTION - Symbols can be substituted in an expression by - giving its name enclosed in apostrophes - or - giving its name without apostrophes. - - In the first case its value is substituted literally. - In the second case its value is treated as a subexpression. - - E.g. if I=3+4 then 3*'i' results in 3*3+4 = 13 - and 3*i results in 3*(3+4) = 21 - - Note that nested substitution is possible. - Mutual substitution is detected by allowing a maximum of 25 - substitutions. -2 Examples - Convert miles to kilometers - $ calc - 10mile /unit=km - - If a whole serie must be done it would be better to do: - $ calc/unit=km - 10mile - 8 mile - (1.25+3.48)mile - - Convert rigth ascension from HH:MM:SS to degrees. - $ calc/unit=deg - 9:23:48.329 hms - - Convert a time to seconds - $ calc/unit=sec - 9:23:48.329 hr - - Do some time calculation - $ calc/unit=hms - 10:34:48 + 2::45 - :34:56.89 - - Calculate an expression and define the symbol ABC - The result must be an integer - $calc - ABC = (2.34 * pi)+8*-cos(135+pi*28) /unit=deg - - Define a formula and calculate it for several parameters - $calc - VOLUME = "4/3*PI*R**3" - R=2 - VOLUME - R=10 - VOLUME - - Convert from hexadecimal to decimal - %x1a2f - - Convert from decimal to hexadecimal - 2546 /rad=x -2 /UNIT - This qualifier defines the default unit for the given values - and the unit in which the result will be expressed. - In this way it can be used for converting from one unit to another. - Note however that conversion between different groups of units - is not allowed (e.g. seconds to meters is illegal). - - From DCL the available units can be shown via the command PRTUNIT. - From CALCULATE they can be shown via UNIT=?. - - Default is no units. -2 /RADIX - This qualifier defines in which radix the output will be listed. - Possible values are: - D decimal - O octal - X hexadecimal - - The default is D. - O and X force TYPE=J if type is non-integer. -2 /TYPE - This qualifier defines in which format the output will be listed. - Note that all calculations are done in double precision and that - the program tests on integer overflow before conversion to an - integer format. - Possible values are: - B signed byte - I signed word (integer*2) - J signed longword (integer*4) - L logical - R single precision (real*4) - D double precision (real*8) - - The default is D. -2 /STREAM - This qualifier is special to DWARF. - It controls the stream of the application symbols. - The stream-name will be inserted in a symbol-name, if that symbol-name - has the format "image_keyword". - - Default is no stream. -2 /LIST - This qualifier controls if the results will be listed. - Normally you will always list the result, but in command-files - it can be useful to negate this qualifier (i.e. /NOLIST). - - Default is list. -2 /LOG - This qualifier controls if the expressions and results will be written - in the log-file CALCULATE.LOG (in the default directory). - This log-file is written in such a way that it can be executed as a - DCL command-file or can be used as input for the ARCHIVE-programs. - This means that most lines will be flagged with an exclamation mark - (indicating comments), but symbol definitions are valid commands, - which can be executed. - In this way users can calculate complex expressions and define the - results as symbols in a subprocess and execute the log-file in the - main process in order to obtain the results. - - Default is no logging. diff --git a/src/dwarf/clear.for b/src/dwarf/clear.for deleted file mode 100644 index 8af96ce00bacde93b4867e5685fb65a85f1c2d96..0000000000000000000000000000000000000000 --- a/src/dwarf/clear.for +++ /dev/null @@ -1,181 +0,0 @@ -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ -C.Ident: SYS_CLEAR -C.Keywords: Program Parameters, External Defaults, Clear -C.Author: Friso Olnon (NFRA, Dwingeloo) -C.Language: DWARF-Fortran -C.Environment: VAX or Alliant -C.Comments: -C.Version: 900416 FMO - recreation -C.Version: 910813 FMO - recreation, work from list of existing symbols -C.Version: 920206 GvD - add former optional arguments to CLI_GET/DWC_INPUT -C.Version: 940121 CMV - changed messenger -C------------------------------------------------------------------------- -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - SUBROUTINE CLEAR -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' -C -C -C.Purpose: Clear the specified external defaults -C.Returns: Not applicable -C.Notes: -C - Parameter: -C Symbol_list required -C - Qualifiers (the names can be abbreviated to a single letter): -C /EXCLUDE=list default: /NOEXCLUDE -C /CONFIRM default: /NOCONFIRM -C /LOG=LONG or /NOLOG default: /LOG=SHORT -C -C - The symbol lists (parameter and /EXCLUDE value) are comma-separated -C lists of DWARF symbol names: -C <program_name>$<stream_name>_<parameter_name> -C where each name can be absent or wildcarded (*). The dollar and -C underscore prefixes are part of the stream and parameter name -C components. -C - The lists will be expanded as follows: each absent component will be -C replaced by the component from the previous symbol name, except that -C the stream for global programs will be set to $0. The default for the -C first name is -C *$<current_stream>_*. -C - /CONFIRM will ask for you to confirm each individual clear action; -C the qualifier will be ignored in batch mode. -C - /LOG=L reports each individual clear action and the total nr of -C symbols cleared, /LOG=S only reports the total number, and /NOLOG -C reports nothing. -C------------------------------------------------------------------------- -C - CHARACTER*(*) PROGNAME, BLANK - PARAMETER (PROGNAME = 'CLEAR') - PARAMETER (BLANK = ' ' ) -C - INTEGER NRARG, PR, Q, QV, QVD - PARAMETER (NRARG = 4) - PARAMETER (PR = CLI__PARAMETER+CLI__REQUIRED) - PARAMETER (Q = CLI__QUALIFIER) - PARAMETER (QV = CLI__QUALIFIER+CLI__VALUE) - PARAMETER (QVD = CLI__QUALIFIER+CLI__VALUE+CLI__DEFAULT) - CHARACTER*7 NAME(NRARG) - INTEGER ATTR(NRARG) - CHARACTER*12 PROMPT(NRARG) - CHARACTER*5 DEFVAL(NRARG) - DATA NAME /'INCLIST' ,'EXCLUDE' ,'CONFIRM' ,'LOG' / - DATA ATTR / PR , QV , Q , QVD / - DATA PROMPT /'Symbol_list',' ' ,' ' ,' ' / - DATA DEFVAL /' ' ,' ' ,' ' ,'SHORT'/ -C - INTEGER CLI_INIT, CLI_GET - INTEGER MSG_INIT, MSG_SET - INTEGER DWC_CTL_OPEN, DWC_IBMODE_INQ, DWC_INPUT - INTEGER DWC_SYM_SPLIT, DWC_SYMLIST_EXPAND - INTEGER SYMBOL_SEARCH, SYMBOL_GET, SYMBOL_DELETE, SYMBOL_EXIT -C - CHARACTER*255 VALUE, INCLIST, EXCLIST - CHARACTER NAM*64, PROGNAM*9, STREAM*12, KEY*16, YN*1, DUM*1 - INTEGER LV, LI, LE, LN, LP, LS, LK, LDUM - INTEGER IS, TMP, NRCLEAR, NR - LOGICAL DO_DELETE, DO_CONFIRM, LONG_LOG, SHORT_LOG, DWARFMSG - DATA NRCLEAR /0/ - DATA DO_DELETE /.TRUE./ - DATA DO_CONFIRM /.FALSE./ - DATA LONG_LOG /.FALSE./ - DATA SHORT_LOG /.TRUE./ - DATA DWARFMSG /.FALSE./ -C -C -C Initialize -C - get DWARF control variables -C - start messenger -C - initialize command-line interpreter -C - IS = DWC_CTL_OPEN () - IF (IAND(IS,1).NE.0) IS = MSG_INIT (PROGNAME,F_T) - IF (IAND(IS,1).NE.0) IS = CLI_INIT (NRARG,NAME,ATTR,PROMPT,DEFVAL) - IF (IAND(IS,1).EQ.0) GOTO 999 -C -C Interpret the command line -C - get and expand symbol list -C - get and expand exclude list -C - get confirm qualifier -C - get log qualifier -C - IS = CLI_GET ('INCLIST',VALUE,LV) - IF (IAND(IS,1).NE.0) - 1 IS = DWC_SYMLIST_EXPAND (VALUE(:LV),INCLIST,LI) - IF (IAND(IS,1).EQ.0) GOTO 999 -C - IS = CLI_GET ('EXCLUDE',VALUE,LV) - IF (IAND(IS,1).EQ.0) GOTO 999 - IF (LV.EQ.0) THEN - EXCLIST = BLANK - LE = 1 - ELSE - IS = DWC_SYMLIST_EXPAND (VALUE(:LV),EXCLIST,LE) - IF (IAND(IS,1).EQ.0) GOTO 999 - IF (LE.EQ.0) LE = 1 - END IF -C - IF (IAND(DWC_IBMODE_INQ('BATCH'),1).EQ.0) THEN - IS = CLI_GET ('CONFIRM',DUM,LDUM) - IF (IAND(IS,1).EQ.0) GOTO 999 - DO_CONFIRM = IS.EQ.DWC_PRESENT - END IF -C - IS = CLI_GET ('LOG',VALUE,LV) - IF (IAND(IS,1).EQ.0) GOTO 999 - IF (LV.EQ.0) THEN - SHORT_LOG = .FALSE. - ELSE IF (VALUE(1:1).EQ.'L') THEN - LONG_LOG = .TRUE. - END IF -C -C Find the next symbol name -C matching INCLIST but not EXCLIST -C - NR = 0 - IS = SYMBOL_SEARCH (INCLIST(:LI),EXCLIST(:LE),NR,NAM,LN) - IF (IAND(IS,1).EQ.0) GOTO 999 - DO WHILE (LN.GT.0) -C -C - DWARF symbols cannot be cleared -C - IS = DWC_SYM_SPLIT (NAM(:LN),PROGNAM,LP,STREAM,LS,KEY,LK) - IF (PROGNAM(:LP).EQ.'DWARF') THEN - IF (.NOT.DWARFMSG) CALL WNCTXT(DWLOG, - 1 'DWARF$0_* symbols cannot be cleared; use SPECIFY') - DWARFMSG = .TRUE. -C -C - ask confirmation (if active) -C - delete the symbol -C - increment counter and log (if active) -C - ELSE - IF (DO_CONFIRM) THEN - IS = SYMBOL_GET (NAM(:LN),VALUE,LV) - IS = DWC_INPUT (YN,NAM(:LN)//' = '//VALUE(:LV)// - 1 ', clear this symbol? (Y,[N])',LDUM,1,0) - IF (IAND(IS,1).EQ.0) YN = 'N' - DO_DELETE = YN.EQ.'Y' - END IF - IF (DO_DELETE) THEN - IS = SYMBOL_DELETE (NAM(:LN),DWC__GLOBALSYM) - IF (IAND(IS,1).NE.0) THEN - NRCLEAR = NRCLEAR+1 - IF (LONG_LOG) CALL WNCTXT(DWLOG, - 1 'Symbol !AS is cleared',NAM(:LN)) - END IF - END IF - END IF - IS = SYMBOL_SEARCH (INCLIST(:LI),EXCLIST(:LE),NR,NAM,LN) - IF (IAND(IS,1).EQ.0) GOTO 999 - END DO -C -C Wrap up -C - write any remaining messages -C - write the nr of symbols deleted -C - close the symbol facility -C - 999 IF (SHORT_LOG) CALL WNCTXT(DWLOG,'!SJ symbols cleared',NRCLEAR) - IF (NRCLEAR.GT.0) TMP = SYMBOL_EXIT () - E_C = MSG_SET(IS,0) ! Exit code for WNGEX - END diff --git a/src/dwarf/cli.for b/src/dwarf/cli.for deleted file mode 100644 index 81742357265e4ade4e18d6c1ba5effe13252fca5..0000000000000000000000000000000000000000 --- a/src/dwarf/cli.for +++ /dev/null @@ -1,570 +0,0 @@ -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ -C.Ident: CLI -C.Keywords: DWARF, Command Line Interpreter -C.Author: Friso Olnon (NFRA, Dwingeloo) -C.Language: DWARF-Fortran -C.Environment: VAX or Alliant -C.Comments: -C DWARF COMMAND LINE INTERPRETER (CLI) -C ------------------------------------ -C -C The CLI facility is used by all DWARF-system programs to analyse the -C arguments in the primary command line, and by DWARF's program-parameter -C interface to preprocess all its input strings. -C -C Syntax definition -C ----------------- -C A program or routine must start a sequence of CLI operations with a -C call to CLI_INIT or CLI_RESET to clear the internal buffers and to -C inform the facility about the number, names and attributes of the -C arguments to be expected. When CLI_INIT is called for the first time, -C it fetches any arguments given in the primary command line and stores -C them. The syntax can be redefined at any time, but all previous -C information will then be lost. -C -C CLI input -C --------- -C The CLI usually acquires input when it needs it (see CLI_INIT and -C CLI_GET) and analyses it via internal calls to CLI_PARSE. In addition, -C any routine can send its own input lines to the CLI by explicitly -C calling CLI_PARSE. -C -C CLI output -C ---------- -C The CLI is questioned about arguments via calls to CLI_GET. When -C CLI_GET finds that a required argument is missing, it will prompt for -C additional input (provided that the standard input device is a -C terminal), append the answer to the current command line, analyse the -C new line, and return the requested information. -C -C.Version: 900426 FMO - recreation -C.Version: 910913 FMO - allow up to 20 arguments (was 10) -C.Version: 910930 GvD - allow values starting with a slash -C.Version: 911022 GvD - fixed little bug when unknown qualifier is given -C.Version: 920206 GvD - no optional arguments anymore in CLI_GET -C.Version: 930312 FMO - LINE buffer 255 --> 1024 -C.Version: 930923 HjV - LINE buffer in CLI_GET 80 --> 255 -C.Version: 940209 CMV - Print message for unknown qualifier here -C------------------------------------------------------------------------- -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - INTEGER*4 FUNCTION CLI_INIT (NR,NAME,ATTR,PROMPT,DEFVAL) -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' -C - INTEGER*4 NR ! (i) nr of arguments - CHARACTER*(*) NAME(*) ! (i) names (case insensitive) - INTEGER*4 ATTR(*) ! (i) attributes - CHARACTER*(*) PROMPT(*) ! (i) prompt strings - CHARACTER*(*) DEFVAL(*) ! (i) default values -C -C.Purpose: Initialise the Command Line Interpreter -C.Returns: Status code (.TRUE. for success, .FALSE. otherwise) -C success DWC_SUCCESS -C false status codes from referenced routines -C.Notes: -C - The command-line syntax is defined by means of the input arrays. -C - When the program calls CLI_INIT for the first time, the routine reads -C any arguments given with the command that started up the program. -C -C - NR gives the number of arguments to be defined (up to 20). -C -C - NAME defines the names of the arguments. A name cannot be empty -C or longer than 16 characters (trailing blanks and tabs are ignored) -C and will be converted to upper case for internal use. -C -C - ATTR describes the arguments as the sum of the 3 basic attributes, -C "type", "presence" and "value", for which symbolic names are defined -C in the Fortran include module 'CONSTANTS_1_DEF': -C -C "Type" can be either -C CLI__PARAMETER (default), CLI__EXPRESSION, or CLI__QUALIFIER. -C Only the first element in the definition arrays can be an expression- -C type parameter, and no other parameters are allowed in that case. -C All parameter arguments must preceed the qualifier arguments in the -C definition arrays. -C -C "Presence" can be either -C CLI__OPTIONAL (default), CLI__REQUIRED, or CLI__DEFAULT. -C A default qualifier is assumed to be present until it is negated via -C /NOname. A parameter is assumed to be present by default when a -C default value has been defined. Any parameter value disappears as -C soon as it has been fetched via a CLI_GET call; from then on, the -C parameter is either optional or required. -C -C "Value" (only used for qualifiers) can be either -C CLI__NOVALUE (default), or CLI__VALUE. -C For a qualifier with the VALUE attribute a value must always be -C available when the qualifier is present (as opposed to negated). -C -C - PROMPT defines prompt strings for the arguments (trailing blanks and -C tabs are ignored). If no prompt string is defined for a required -C argument, its name will be used as such. -C -C - DEFVAL defines default values for the arguments (trailing blanks and -C tabs are ignored). A default value is: -C required for qualifiers with both CLI__VALUE and CLI__DEFAULT, -C not allowed for qualifiers with CLI__NOVALUE, and -C allowed in all other cases. -C------------------------------------------------------------------------- -C - CHARACTER*(*) BLANK - PARAMETER (BLANK = ' ') -C - INTEGER*4 CLI_PARSE, CLI_BUF_INIT - INTEGER*4 GEN_GETFOR -C - CHARACTER*1024 LINE - INTEGER*4 IS, LL -C - LOGICAL*4 FIRST - SAVE FIRST - DATA FIRST /.TRUE./ -C -C -C Initialize the CLI buffer -C - IS = CLI_BUF_INIT (NR,NAME,ATTR,PROMPT,DEFVAL) - IF (IAND(IS,1).EQ.0) GOTO 999 -C -C Get foreign command and parse it -C - don't ask if none found -C - IF (FIRST) THEN - FIRST = .FALSE. - IS = GEN_GETFOR (BLANK,LINE,LL) - IF (IAND(IS,1).NE.0 .AND. LL.GT.0) IS = CLI_PARSE (LINE(:LL)) - IF (IAND(IS,1).EQ.0) GOTO 999 - ENDIF -C - CLI_INIT = DWC_SUCCESS - RETURN -C - 999 CLI_INIT = IS - RETURN - END -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - INTEGER*4 FUNCTION CLI_RESET (NR,NAME,ATTR,PROMPT,DEFVAL) -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' -C - INTEGER*4 NR ! (i) nr of arguments - CHARACTER*(*) NAME(*) ! (i) names (case insensitive) - INTEGER*4 ATTR(*) ! (i) attributes - CHARACTER*(*) PROMPT(*) ! (i) prompt strings - CHARACTER*(*) DEFVAL(*) ! (i) default values -C -C.Purpose: Initialise the Command Line Interpreter -C.Returns: Status code (.TRUE. for success, .FALSE. otherwise) -C success DWC_SUCCESS -C false status codes from referenced routines -C.Notes: -C - The command-line syntax is defined as in CLI_INIT. -C - Unlike CLI_INIT, this routine does not read the command line that -C started up the program. -C------------------------------------------------------------------------- -C - INTEGER*4 CLI_BUF_INIT -C - CLI_RESET = CLI_BUF_INIT (NR,NAME,ATTR,PROMPT,DEFVAL) - RETURN - END -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - INTEGER*4 FUNCTION CLI_GET (NAME,VALUE,LVAL) -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' -C - CHARACTER*(*) NAME ! (i) argument name - CHARACTER*(*) VALUE ! (o) argument value - INTEGER*4 LVAL ! (o) significant length of VALUE -C -C.Purpose: Get the status and value of an argument -C.Returns: Status code (.TRUE. for success, .FALSE. otherwise) -C success DWC_SUCCESS also for truncated command line -C success DWC_PRESENT argument is present -C success DWC_ABSENT optional argument is absent -C success DWC_NEGATED qualifier is negated -C error DWC_NOPARCOM required argument is absent -C false status codes from referenced routines -C.Notes: -C - All arguments are optional. -C -C If NAME is an argument name: -C - NAME is case insensitive and may be a unique abbreviation of a name. -C - The current status and value of that argument will be returned. -C - LVAL = 0 indicates that no value is available (optional argument is -C absent, qualifier is negated or does not have the value attribute). -C - If the argument is required but absent and the standard-input device -C is a terminal, the user will be prompted for input, the answer will -C be appended to the current command line, the new line will be parsed, -C and the routine will loop back until the argument is specified. If -C the input device is not a terminal, the routine returns with the -C error status DWC_NOPARVAL. -C - If CLI_GET is called for a parameter, that parameter becomes absent. -C CLI_GET only changes the presence of a qualifier, if the additional -C input line contained that qualifier. -C -C If NAME is blank (or empty): -C - The current command line will be returned in VALUE. -C - All present parameter values are listed, separated by blanks and -C followed by all present or negated qualifiers in the format /name, -C /NOname or /name=value', where name is the full name. -C - If the output string is too short, the command line will be truncated. -C - Since parameter values are used only once, the complete command line -C will only be returned if no CLI_GET (parameter) has been done yet. -C------------------------------------------------------------------------- -C - CHARACTER*(*) BLANK - PARAMETER (BLANK = ' ') -C - INTEGER*4 CLI_BUF_GET, CLI_PARSE, CLI_BUF_GETCOM - INTEGER DWC_INPUT, GEN_TERMSW, MSG_SET -C - CHARACTER*255 LINE - INTEGER*4 IS,LL -C -C -C Get complete command line -C - IF (NAME.EQ.BLANK) THEN - CLI_GET = CLI_BUF_GETCOM (VALUE,LVAL) - RETURN - ENDIF -C -C Get status and value of argument -C - 100 IS = CLI_BUF_GET (NAME,VALUE,LVAL) -C -C If a required argument is absent: -C - ask user on terminal -C - parse the answer -C - try again -C - IF (IS.EQ.DWC_REQUIRED) THEN - IF (IAND(GEN_TERMSW('SYS$INPUT'),1) .NE. 0) THEN - IS = DWC_INPUT (LINE,VALUE(:LVAL),LL,0,0) - IF (IAND(IS,1).NE.0) IS = CLI_PARSE (LINE) - IF (IAND(IS,1).NE.0) GOTO 100 - ELSE - IS = MSG_SET (DWC_NOPARCOM,0) - ENDIF - ENDIF -C - CLI_GET = IS - RETURN - END -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - INTEGER*4 FUNCTION CLI_PARSE (LINE) -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' -C - CHARACTER*(*) LINE ! (i) command line -C -C.Purpose: Analyse the command line and store the arguments -C.Returns: Status code (.TRUE. for success, .FALSE. otherwise) -C success DWC_SUCCESS -C error DWC_CLIBUFERR one or more syntax errors were found -C.Notes: -C - The command line consists of a series of parameter and qualifier -C fields. These argument fields can be separated by any number of white -C characters (i.e. blanks and tabs). The only requirement is, that each -C parameter field must be preceded by at least one white, unless it is -C the first field in the line. -C - When CLI_PARSE finds a syntax error, it leaves a message in the -C message buffer, but completes the analysis of the line. -C -C Parameter fields: -C - Any field that does not start with a slash (/) is a parameter field. -C Parameters are identified by their sequence number in the line. -C - For normal parameters (type attribute CLI__PARAMETER) the field ends -C before the first white or slash and may contain all other ASCII -C characters. -C - For parameters with the CLI__EXPRESSION attribute, the field can even -C contain these delimiters. The end of an expression is marked by a -C slash preceded by a blank, unless that combination is part of a -C parenthesized ((...)) or quoted ("...") substring. -C -C Qualifier fields: -C - A qualifier field has the format /KEY, /NOKEY, or /KEY=VALUE, where -C KEY identifies the qualifier. The last form is only allowed for -C qualifiers with the CLI__VALUE attribute. Both the slash and the -C equal sign may be surrounded by any number of whites. -C - The keyword field ends before the first white, slash or equal sign. -C KEY must be a known qualifier name (case blind) or the unique -C abbreviation of such a name. -C - The value field in principle ends before the first white or slash, -C but CLI__PARSE accepts parenthesized ((...)) and quoted ("...") -C values, in which case it removes the delimiters and all whites from -C the value. -C------------------------------------------------------------------------- -C - CHARACTER*(*) BLANK, TAB, WHITE, SLASH - PARAMETER (BLANK = ' ') - PARAMETER (TAB = ' ') - PARAMETER (WHITE = BLANK//TAB) - PARAMETER (SLASH = '/') -C - INTEGER*4 CLI_PARSE_P, CLI_PARSE_Q, CLI_PARSE_X - INTEGER*4 CLI_BUF_GETNRS, CLI_BUF_PUTPAR, CLI_BUF_PUTQUAL - INTEGER*4 STR_SIGLEN, STR_SKIP_W -C - CHARACTER*255 KEY, VAL - INTEGER*4 LL, LK, LV, PTR, PTRSAV - INTEGER*4 IS, PCNT, NRPAR, NREXP, NRQUA - LOGICAL*4 ERROR -C -C - IS = CLI_BUF_GETNRS (NRPAR,NREXP,NRQUA) - ERROR = .FALSE. - LL = STR_SIGLEN (LINE) - PTR = 1 - PCNT = 0 - IS = STR_SKIP_W (WHITE,LINE(:LL),PTR) -C -C Loop through the command string -C - DO WHILE ((.NOT.ERROR) .AND. (PTR.LE.LL)) - IF (LINE(PTR:PTR).NE.SLASH) THEN -C -C Extract and store the parameter -C - IF (NREXP.GT.0) THEN - IS = CLI_PARSE_X (LINE(:LL),PTR,VAL,LV) - ELSE - IS = CLI_PARSE_P (LINE(:LL),PTR,VAL,LV) - ENDIF - PCNT = PCNT+1 - IS = CLI_BUF_PUTPAR (PCNT,VAL,LV) - ELSE -C -C Extract and store the qualifier -C If it is not a qualifier, treat it -C as a value if expressions are allowed. -C First remove messages from _PARSE_Q. -C - PTRSAV = PTR - IS = CLI_PARSE_Q (LINE(:LL),PTR,KEY,LK,VAL,LV) - IS = CLI_BUF_PUTQUAL (KEY(:LK),VAL,LV) - IF ((IAND(IS,1).EQ.0) .AND. (NREXP.GT.0)) THEN - PTR = PTRSAV - IS = CLI_PARSE_X (LINE(:LL),PTR,VAL,LV) - PCNT = PCNT+1 - IS = CLI_BUF_PUTPAR (PCNT,VAL,LV) - ELSE IF (IAND(IS,1).EQ.0) THEN - CALL WNCTXT(DWLOG,DWMSG,KEY(:LK)) - ENDIF - ENDIF -C - IF (IAND(IS,1).EQ.0) ERROR = .TRUE. - IS = STR_SKIP_W (WHITE,LINE(:LL),PTR) - ENDDO -C - IF (ERROR) THEN - CLI_PARSE = DWC_CLIBUFERR - ELSE - CLI_PARSE = DWC_SUCCESS - ENDIF - RETURN - END -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - INTEGER*4 FUNCTION CLI_PARSE_P (LINE,PTR,VAL,LV) -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' -C - CHARACTER*(*) LINE ! (i) command line - INTEGER*4 PTR ! (m) start of parameter -> end+1 - CHARACTER*(*) VAL ! (o) parameter value - INTEGER*4 LV ! (o) length of VAL -C -C.Purpose: Extract a parameter field from the command line -C.Returns: Status code (.TRUE. for success, .FALSE. otherwise) -C success DWC_SUCCESS -C.Notes: -C see CLI_PARSE -C------------------------------------------------------------------------- -C - CHARACTER*(*) BLANK, TAB, WHITE, SLASH, P_END - PARAMETER (BLANK = ' ') - PARAMETER (TAB = ' ') - PARAMETER (WHITE = BLANK//TAB) - PARAMETER (SLASH = '/') - PARAMETER (P_END = WHITE//SLASH) -C - INTEGER*4 STR_COPY_U -C - INTEGER*4 IS -C -C - LV = 0 - IS = STR_COPY_U (P_END,LINE,PTR,VAL,LV) -C - CLI_PARSE_P = DWC_SUCCESS - RETURN - END -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - INTEGER*4 FUNCTION CLI_PARSE_X (LINE,PTR,VAL,LV) -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' -C - CHARACTER*(*) LINE ! (i) command line - INTEGER*4 PTR ! (m) start of expression -> end+1 - CHARACTER*(*) VAL ! (o) expression - INTEGER*4 LV ! (o) length of VAL -C -C.Purpose: Extract an expression from the command line -C.Returns: Status code (.TRUE. for success, .FALSE. otherwise) -C success DWC_SUCCESS -C.Notes: -C see CLI_PARSE -C------------------------------------------------------------------------- -C - CHARACTER*(*) BLANK, SLASH, QUOTE, OPNPAR, CLOPAR - PARAMETER (BLANK = ' ') - PARAMETER (SLASH = '/') - PARAMETER (QUOTE = '"') - PARAMETER (OPNPAR = '(') - PARAMETER (CLOPAR = ')') -C - INTEGER*4 STR_COPY_U, STR_COPY -C - INTEGER*4 IS, LL, DEPTH - LOGICAL*4 EXP_END -C -C - VAL = BLANK - LV = 0 - LL = LEN(LINE) - DEPTH = 0 -C -C Copy until qualifier or end-of-line -C - copy quoted substrings -C - keep track of the subexpression -C depth, i.e. nr of '(' - nr of ')' -C - copy subexpressions -C - stop at BLANK//SLASH at depth 0 -C - IS = STR_COPY_U (SLASH//QUOTE//OPNPAR//CLOPAR,LINE,PTR,VAL,LV) - EXP_END = PTR.GT.LL - IF (.NOT.EXP_END .AND. PTR.GT.1) THEN - EXP_END = LINE(PTR-1:PTR).EQ.BLANK//SLASH - ENDIF - DO WHILE (.NOT.EXP_END) - IF (LINE(PTR:PTR).EQ.QUOTE) THEN - IS = STR_COPY (QUOTE,VAL,LV) - PTR = PTR+1 - IS = STR_COPY_U (QUOTE,LINE,PTR,VAL,LV) - ELSE IF (LINE(PTR:PTR).EQ.OPNPAR) THEN - DEPTH = DEPTH+1 - ELSE IF (LINE(PTR:PTR).EQ.CLOPAR) THEN - DEPTH = DEPTH-1 - ENDIF - IS = STR_COPY (LINE(PTR:PTR),VAL,LV) - PTR = PTR+1 - IF (DEPTH.EQ.0) THEN - IS = STR_COPY_U (QUOTE//OPNPAR//CLOPAR//SLASH,LINE,PTR, - 1 VAL,LV) - EXP_END = PTR.GT.LL - IF (.NOT.EXP_END .AND. PTR.GT.1) THEN - EXP_END = LINE(PTR-1:PTR).EQ.BLANK//SLASH - ENDIF - ELSE - IS = STR_COPY_U (QUOTE//OPNPAR//CLOPAR,LINE,PTR,VAL,LV) - EXP_END = PTR.GT.LL - ENDIF - ENDDO - IF (LV.GT.0 .AND. VAL(LV:LV).EQ.BLANK) LV = LV-1 -C -C Return -C - CLI_PARSE_X = DWC_SUCCESS - RETURN - END -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - INTEGER*4 FUNCTION CLI_PARSE_Q (LINE,PTR,KEY,LK,VAL,LV) -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' -C - CHARACTER*(*) LINE ! (i) command line - INTEGER*4 PTR ! (m) start of qualifier -> end+1 - CHARACTER*(*) KEY ! (o) qualifier key - INTEGER*4 LK ! (o) length of KEY - CHARACTER*(*) VAL ! (o) qualifier value - INTEGER*4 LV ! (o) length of VAL -C -C.Purpose: Extract a qualifier field from the command line -C.Returns: Status code (.TRUE. for success, .FALSE. otherwise) -C success DWC_SUCCESS -C.Notes: -C see CLI_PARSE -C------------------------------------------------------------------------- -C - CHARACTER*(*) BLANK, TAB, WHITE, SLASH, EQUAL, QUOTE, OPPAR, CLPAR - PARAMETER (BLANK = ' ') - PARAMETER (TAB = ' ') - PARAMETER (WHITE = BLANK//TAB) - PARAMETER (SLASH = '/') - PARAMETER (EQUAL = '=') - PARAMETER (QUOTE = '"') - PARAMETER (OPPAR = '(') - PARAMETER (CLPAR = ')') -C - CHARACTER*(*) Q_END, K_END, V_START - CHARACTER*1 V_END(2) - PARAMETER (Q_END = WHITE//SLASH) ! end qualifier - PARAMETER (K_END = Q_END//EQUAL) ! end qual key - PARAMETER (V_START = QUOTE//OPPAR) ! start delimited value - DATA V_END /QUOTE, CLPAR/ ! end delimited value -C - INTEGER*4 STR_SKIP_W, STR_COPY_U -C - INTEGER*4 LL, IS, VTYP -C -C - LL = LEN(LINE) - LK = 0 - LV = 0 -C -C Extract qualifier key -C - first, skip slash and whites -C - PTR = PTR+1 - IS = STR_SKIP_W (WHITE,LINE,PTR) - IS = STR_COPY_U (K_END,LINE,PTR,KEY,LK) -C -C Skip to next token -C - IS = STR_SKIP_W (WHITE,LINE,PTR) - IF (PTR.LE.LL .AND. LINE(PTR:PTR).EQ.EQUAL) THEN -C -C Extract qualifier value -C - first, skip equal sign and whites -C - determine type of value -C - delimited values are extracted -C without delimiters and whites -C - PTR = PTR+1 - IS = STR_SKIP_W (WHITE,LINE,PTR) - VTYP = 0 - IF (PTR.LE.LL) VTYP = INDEX(V_START,LINE(PTR:PTR)) - IF (VTYP.EQ.0) THEN - IS = STR_COPY_U (Q_END,LINE,PTR,VAL,LV) - ELSE - PTR = PTR+1 - DO WHILE (PTR.LE.LL .AND. LINE(PTR:PTR).NE.V_END(VTYP)) - IS = STR_SKIP_W (WHITE,LINE,PTR) - IS = STR_COPY_U (WHITE//V_END(VTYP), - 1 LINE,PTR,VAL,LV) - ENDDO - PTR = PTR+1 - ENDIF - ENDIF -C - CLI_PARSE_Q = DWC_SUCCESS - RETURN - END diff --git a/src/dwarf/cli_1.def b/src/dwarf/cli_1.def deleted file mode 100644 index df7f1dc037a0d4c748bc96f18d4eb00a6e57b64b..0000000000000000000000000000000000000000 --- a/src/dwarf/cli_1.def +++ /dev/null @@ -1,91 +0,0 @@ -C Include module CLI_1 -C Created by BLDDEF from: USER5:[OLNON.SYS]CLI.DEF; on 13-SEP-91 -C -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ -C.Ident: DEF_CLI -C.Keywords: Command-line interpreter control block, Definition -C.Author: Friso Olnon (NFRA, Dwingeloo) -C.Language: DWARF-DEF -C.Environment: VAX or Alliant -C.Comments: -C.Version: 881128 FMO - creation -C.Version: 910913 FMO - allow up to 20 arguments (was 10) -C------------------------------------------------------------------------- -C -C -C Sizes -C - INTEGER*4 CLI__MXNR - PARAMETER (CLI__MXNR =20) !maximum nr of arguments allowed - INTEGER*4 CLI__LNAM - PARAMETER (CLI__LNAM =16) !maximum length of argument names -C -C Control block -C - INTEGER*4 CLI_LENGTH - PARAMETER (CLI_LENGTH =1) !&1 !#J !generated: field to contain the block length - INTEGER*4 CLI_TYPE - PARAMETER (CLI_TYPE =2) !&1 !#J !generated: field to contain the block type - INTEGER*4 CLI_NRARG - PARAMETER (CLI_NRARG =3) !&1 !#J !nr of arguments in use - INTEGER*4 CLI_NRPAR - PARAMETER (CLI_NRPAR =4) !&1 !#J !nr of parameters - INTEGER*4 CLI_NREXP - PARAMETER (CLI_NREXP =5) !&1 !#J !nr of expression-type parameters - INTEGER*4 CLI_NRQUA - PARAMETER (CLI_NRQUA =6) !&1 !#J !nr of qualifiers - INTEGER*4 CLI_NAME - PARAMETER (CLI_NAME =7) !&320 !#C !argument names - INTEGER*4 CLI_ATTR - PARAMETER (CLI_ATTR =87) !&20 !#J !attributes - INTEGER*4 CLI_STAT - PARAMETER (CLI_STAT =107) !&20 !#J !status codes - INTEGER*4 CLI_IDPRO - PARAMETER (CLI_IDPRO =127) !&20 !#J !prompt string ID's - INTEGER*4 CLI_IDDEF - PARAMETER (CLI_IDDEF =147) !&20 !#J !default value ID's - INTEGER*4 CLI_IDVAL - PARAMETER (CLI_IDVAL =167) !&20 !#J !value string ID's - INTEGER*4 CLI__LENGTH - PARAMETER (CLI__LENGTH =186) !generated: block length (in longwords) - INTEGER*4 CLI__TYPE - PARAMETER (CLI__TYPE =31) !generated: block type - INTEGER*4 CLI__DEFTYP - PARAMETER (CLI__DEFTYP=31) - INTEGER*4 CLI__DEFVSN - PARAMETER (CLI__DEFVSN=1) -C - EXTERNAL CLI_BLOCK -C -C Common block specification -C - INTEGER*4 CLI$LENGTH - EQUIVALENCE (CLI$LENGTH,CLI__(0)) - INTEGER*4 CLI$TYPE - EQUIVALENCE (CLI$TYPE,CLI__(4)) - INTEGER*4 CLI$NRARG - EQUIVALENCE (CLI$NRARG,CLI__(8)) - INTEGER*4 CLI$NRPAR - EQUIVALENCE (CLI$NRPAR,CLI__(12)) - INTEGER*4 CLI$NREXP - EQUIVALENCE (CLI$NREXP,CLI__(16)) - INTEGER*4 CLI$NRQUA - EQUIVALENCE (CLI$NRQUA,CLI__(20)) - CHARACTER*16 CLI$NAME(20) - EQUIVALENCE (CLI$NAME,CLI__(24)) - INTEGER*4 CLI$ATTR(20) - EQUIVALENCE (CLI$ATTR,CLI__(344)) - INTEGER*4 CLI$STAT(20) - EQUIVALENCE (CLI$STAT,CLI__(424)) - INTEGER*4 CLI$IDPRO(20) - EQUIVALENCE (CLI$IDPRO,CLI__(504)) - INTEGER*4 CLI$IDDEF(20) - EQUIVALENCE (CLI$IDDEF,CLI__(584)) - INTEGER*4 CLI$IDVAL(20) - EQUIVALENCE (CLI$IDVAL,CLI__(664)) - BYTE CLI__(0:743) - INTEGER*4 CLI_(186) - EQUIVALENCE (CLI_,CLI__) -C - COMMON /CLI_COMMON/ CLI_ -C diff --git a/src/dwarf/cliblock.for b/src/dwarf/cliblock.for deleted file mode 100644 index 6bc0e08d970598d8582cbe2d1015fec0084bd337..0000000000000000000000000000000000000000 --- a/src/dwarf/cliblock.for +++ /dev/null @@ -1,35 +0,0 @@ - BLOCK DATA CLI_BLOCK -C Created by BLDDEF from: USER5:[OLNON.SYS]CLI.DEF; on 13-SEP-91 -C HjV 921208 Removed all equivalence and add names to common block -C -C -C - INTEGER*4 CLI$LENGTH - INTEGER*4 CLI$TYPE - INTEGER*4 CLI$NRARG - DATA CLI$NRARG /0/ - INTEGER*4 CLI$NRPAR - DATA CLI$NRPAR /0/ - INTEGER*4 CLI$NREXP - DATA CLI$NREXP /0/ - INTEGER*4 CLI$NRQUA - DATA CLI$NRQUA /0/ - CHARACTER*16 CLI$NAME(20) - DATA CLI$NAME /20*' '/ - INTEGER*4 CLI$ATTR(20) - DATA CLI$ATTR /20*0/ - INTEGER*4 CLI$STAT(20) - DATA CLI$STAT /20*0/ - INTEGER*4 CLI$IDPRO(20) - DATA CLI$IDPRO /20*0/ - INTEGER*4 CLI$IDDEF(20) - DATA CLI$IDDEF /20*0/ - INTEGER*4 CLI$IDVAL(20) - DATA CLI$IDVAL /20*0/ -C - COMMON /CLI_COMMON/ CLI$LENGTH, CLI$TYPE, CLI$NRARG, CLI$NRPAR, - * CLI$NREXP, CLI$NRQUA, CLI$NAME, CLI$ATTR, - * CLI$STAT, CLI$IDPRO, CLI$IDDEF, CLI$IDVAL -C -C - END diff --git a/src/dwarf/clibuf.for b/src/dwarf/clibuf.for deleted file mode 100644 index 32fbbf53c1e83a02670112f3ac8829e35e26bce1..0000000000000000000000000000000000000000 --- a/src/dwarf/clibuf.for +++ /dev/null @@ -1,528 +0,0 @@ -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ -C.Ident: CLI_BUF -C.Keywords: Command Line Interpreter, Buffer -C.Author: Friso Olnon (NFRA, Dwingeloo) -C.Language: DWARF-Fortran -C.Environment: VAX or Alliant -C.Comments: -C Symbolic names for argument attributes: -C CLI__PARAMETER CLI__QUALIFIER CLI__EXPRESSION -C CLI__OPTIONAL CLI__DEFAULT CLI__REQUIRED -C CLI__NOVALUE CLI__VALUE -C Common variables used: -C INTEGER*4 CLI$NRARG ! nr of arguments -C INTEGER*4 CLI$NRPAR ! nr of parameters -C INTEGER*4 CLI$NREXP ! nr of expressions -C INTEGER*4 CLI$NRQUA ! nr of qualifiers -C CHARACTER CLI$NAME(CLI__MXNR)*(CLI__LNAM) ! names (upper case) -C INTEGER*4 CLI$ATTR(CLI__MXNR) ! attributes -C INTEGER*4 CLI$STAT(CLI__MXNR) ! status codes -C INTEGER*4 CLI$IDPRO(CLI__MXNR) ! prompt string ID's -C INTEGER*4 CLI$IDDEF(CLI__MXNR) ! default value ID's -C INTEGER*4 CLI$IDVAL(CLI__MXNR) ! value string ID's -C where CLI__MXNR = 20 and CLI__LNAM = 16 -C -C.Version: 900420 FMO - recreation -C.Version: 910913 FMO - allow up to 20 arguments (was 10) -C.Version: 920214 GvD - no optional arguments in MSG anymore -C.Version: 940209 CMV - Print message for unknown qualifier in CLI.FOR -C------------------------------------------------------------------------- -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - INTEGER*4 FUNCTION CLI_BUF_INIT (NRARG,NAME,ATTR,PROMPT,DEFVAL) -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' - INCLUDE 'CLI_1_DEF' -C - INTEGER*4 NRARG ! (i) nr of arguments - CHARACTER*(*) NAME(*) ! (i) names (case insenstive) - INTEGER*4 ATTR(*) ! (i) attributes - CHARACTER*(*) PROMPT(*) ! (i) prompt strings - CHARACTER*(*) DEFVAL(*) ! (i) default values -C -C.Purpose: Initialize the CLI buffer -C.Returns: Status code (.TRUE. for success, .FALSE. otherwise) -C success DWC_SUCCESS -C fatal DWC_CLISYNTAX any error -> ABORT -C.Notes: -C - The command-line syntax, as described in the notes of CLI_INIT, is -C checked and stored in the CLI buffer. -C - Any error must be a programming error and leads to program abort. -C - The argument status is initialized at DWC_PRESENT for all qualifiers -C with the CLI__DEFAULT attribute and for all parameters with a default -C value, and at DWC_ABSENT for all other arguments. -C------------------------------------------------------------------------- -C - CHARACTER*(*) BLANK - PARAMETER (BLANK = ' ') -C - INTEGER*4 CLI_STR_INIT, CLI_STR_PUT - INTEGER*4 STR_SIGLEN, STR_UPCASE - INTEGER MSG_SET -C - INTEGER*4 IS, LN, LP, LD - LOGICAL*4 VALUE, DEFAULT, REQUIRED -C -C - IF (NRARG.LT.0 .OR. NRARG.GT.CLI__MXNR) THEN - IS = 4 - CALL WNCTXT(DWLOG,'Invalid number of arguments: !SJ',NRARG) - GOTO 999 - ENDIF -C -C Initialize the buffers -C - CLI$NRARG = NRARG - CLI$NRPAR = 0 - CLI$NREXP = 0 - CLI$NRQUA = 0 - DO I = 1,CLI__MXNR - CLI$NAME(I) = BLANK - CLI$ATTR(I) = 0 - CLI$STAT(I) = DWC_ABSENT - CLI$IDPRO(I) = 0 - CLI$IDDEF(I) = 0 - CLI$IDVAL(I) = 0 - ENDDO - IS = CLI_STR_INIT () - IF (IAND(IS,1).EQ.0) GOTO 999 -C -C Check the command-line syntax -C and fill the buffers -C - DO I = 1,NRARG -C - LN = STR_SIGLEN (NAME(I)) - IF (LN.EQ.0) THEN - IS = 4 - CALL WNCTXT(DWLOG,'Argument !SJ has no name',I) - GOTO 999 - ENDIF - CLI$NAME(I) = NAME(I) - IS = STR_UPCASE (CLI$NAME(I)) - LP = STR_SIGLEN (PROMPT(I)) - LD = STR_SIGLEN (DEFVAL(I)) -C - VALUE = IAND(ATTR(I),CLI__VALUE).NE.0 - REQUIRED = IAND(ATTR(I),CLI__REQUIRED).NE.0 - DEFAULT = .NOT.REQUIRED .AND. IAND(ATTR(I),CLI__DEFAULT).NE.0 -C -C Qualifier definition -C - IF (IAND(ATTR(I),CLI__QUALIFIER).NE.0) THEN - CLI$ATTR(I) = CLI__QUALIFIER - CLI$NRQUA = CLI$NRQUA+1 - IF (VALUE) THEN - CLI$ATTR(I) = CLI$ATTR(I)+CLI__VALUE - IF (LD.GT.0) THEN - IS = CLI_STR_PUT (CLI$IDDEF(I),DEFVAL(I),LD) - ELSE IF (DEFAULT) THEN - IS = 4 - CALL WNCTXT(DWLOG,'Qualifier !AS: '// - 1 'default value required',4,0,NAME(I)) - ENDIF - ELSE - IF (LD.GT.0) THEN - IS = 4 - CALL WNCTXT(DWLOG,'Qualifier !AS: '// - 1 'no default value allowed',NAME(I)) - ENDIF - ENDIF - IF (DEFAULT) THEN - CLI$ATTR(I) = CLI$ATTR(I)+CLI__DEFAULT - CLI$STAT(I) = DWC_PRESENT - ENDIF - IF (IAND(IS,1).EQ.0) GOTO 999 -C -C Parameter or expression -C - ELSE - IF (IAND(ATTR(I),CLI__EXPRESSION).NE.0) THEN - IF (I.NE.1) THEN - IS = 4 - CALL WNCTXT(DWLOG,'Expression !AS: '// - 1 'must be the first argument',NAME(I)) - ENDIF - CLI$ATTR(I) = CLI__EXPRESSION - CLI$NREXP = 1 - CLI$NRPAR = 1 - ELSE - IF (CLI$NREXP.GT.0) THEN - IS = 4 - CALL WNCTXT(DWLOG,'Parameter !AS: '// - 1 'not allowed after expression',NAME(I)) - ELSE IF (CLI$NRQUA.GT.0) THEN - IS = 4 - CALL WNCTXT(DWLOG,'Parameter !AS: '// - 1 'must precede qualifiers',NAME(I)) - ENDIF - CLI$ATTR(I) = CLI__PARAMETER - CLI$NRPAR = CLI$NRPAR+1 - ENDIF - IF (IAND(IS,1).EQ.0) GOTO 999 -C -C - if a default value is given: -C put it into the value buffer -C and set status to PRESENT -C - IF (LD.GT.0) THEN - CLI$STAT(I) = DWC_PRESENT - IS = CLI_STR_PUT (CLI$IDVAL(I),DEFVAL(I),LD) - IF (IAND(IS,1).EQ.0) GOTO 999 - ENDIF - ENDIF -C -C For required arguments: -C - the name will be used as prompt -C if no prompt string was provided -C - IF (REQUIRED) THEN - CLI$ATTR(I) = CLI$ATTR(I)+CLI__REQUIRED - IF (LP.GT.0) THEN - IS = CLI_STR_PUT (CLI$IDPRO(I),PROMPT(I),LP) - ELSE - IS = CLI_STR_PUT (CLI$IDPRO(I),NAME(I),LN) - ENDIF - IF (IAND(IS,1).EQ.0) GOTO 999 - ENDIF -C - ENDDO -C - CLI_BUF_INIT = DWC_SUCCESS - RETURN -C -C Fatal error found: abort program -C - 999 CLI_BUF_INIT = MSG_SET (DWC_CLISYNTAX,0) - CALL WNGEX - RETURN - END -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - INTEGER*4 FUNCTION CLI_BUF_PUTPAR (NR,VAL,LVAL) -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' - INCLUDE 'CLI_1_DEF' -C - INTEGER*4 NR ! (i) parameter nr - CHARACTER*(*) VAL ! (i) value - INTEGER*4 LVAL ! (i) significant length of the value -C -C.Purpose: Store or clear the parameter value and set its status -C.Returns: Status code (.TRUE. for success, .FALSE. otherwise) -C success DWC_SUCCESS -C error DWC_CLIBUFERR error report left in message buffer -C.Notes: -C - If LVAL > 0, the value will be stored and the status will be set to -C DWC_PRESENT. -C - Otherwise, any old value will be cleared and the status will be -C set to DWC_ABSENT. -C------------------------------------------------------------------------- -C - INTEGER*4 CLI_STR_PUT - INTEGER MSG_SET -C - INTEGER*4 IS -C -C - IF (NR.GT.CLI$NRPAR) THEN - IS = MSG_SET (DWC_CLIPARUNK,1) - CALL WNCTXT(DWLOG,DWMSG,NR) - GOTO 999 - ENDIF -C - IS = CLI_STR_PUT (CLI$IDVAL(NR),VAL,LVAL) - IF (IAND(IS,1).EQ.0) GOTO 999 - IF (LVAL.GT.0) THEN - CLI$STAT(NR) = DWC_PRESENT - ELSE - CLI$STAT(NR) = DWC_ABSENT - ENDIF -C -C - CLI_BUF_PUTPAR = DWC_SUCCESS - RETURN -C - 999 CLI_BUF_PUTPAR = DWC_CLIBUFERR - RETURN - END -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - INTEGER*4 FUNCTION CLI_BUF_PUTQUAL (KEY,VAL,LVAL) -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' - INCLUDE 'CLI_1_DEF' -C - CHARACTER*(*) KEY ! (i) qualifier key (case insensitive) - CHARACTER*(*) VAL ! (i) value - INTEGER*4 LVAL ! (i) significant length of the value -C -C.Purpose: Store or clear the value of a qualifier and set its status -C.Returns: Status code (.TRUE. for success, .FALSE. otherwise) -C success DWC_SUCCESS -C error DWC_CLIBUFERR error report left in message buffer -C.Notes: -C - If KEY is a unique abbreviation of a qualifier name, the status will -C be set to DWC_PRESENT. If LVAL > 0, VAL(:LVAL) will be stored. -C - If KEY is 'NO' followed by an (abbreviated) qualifier name, the -C status will be set to DWC_NEGATED. -C - In both cases any old value will be cleared. -C------------------------------------------------------------------------- -C - INTEGER*4 CLI_STR_PUT, STR_MATCH_A, STR_UPCASE - INTEGER MSG_SET -C - CHARACTER UPKEY*(CLI__LNAM+2) - INTEGER*4 IS, NR -C -C - UPKEY = KEY - IS = STR_UPCASE (UPKEY) -C -C KEY = name : -C - qualifier present -C - check whether a value is allowed -C - store or clear the value -C - IS = STR_MATCH_A (UPKEY,CLI$NRQUA,CLI$NAME(CLI$NRPAR+1),NR) - IF (IAND(IS,1).NE.0) THEN - NR = CLI$NRPAR+NR - IF (IAND(CLI$ATTR(NR),CLI__VALUE).NE.0) THEN - IF (LVAL.LE.0 .AND. CLI$IDDEF(NR).EQ.0) THEN - IS = MSG_SET(DWC_QUALNOVAL,1) - ELSE - IS = CLI_STR_PUT (CLI$IDVAL(NR),VAL,LVAL) - ENDIF - ELSE IF (LVAL.GT.0) THEN - IS = MSG_SET (DWC_QUALVALNA,1) - ENDIF - IF (IAND(IS,1).EQ.0) GOTO 999 - CLI$STAT(NR) = DWC_PRESENT -C -C KEY = NOname: -C - qualifier negated -C - no value allowed -C - clear the value -C - ELSE - IF (UPKEY(:2).EQ.'NO') IS = STR_MATCH_A (UPKEY(3:), - 1 CLI$NRQUA,CLI$NAME(CLI$NRPAR+1),NR) - IF (IAND(IS,1).NE.0) THEN - NR = CLI$NRPAR+NR - IF (LVAL.LE.0) THEN - IS = CLI_STR_PUT (CLI$IDVAL(NR),VAL,LVAL) - ELSE - IS = MSG_SET (DWC_QUALVALNA,1) - ENDIF - IF (IAND(IS,1).EQ.0) GOTO 999 - CLI$STAT(NR) = DWC_NEGATED -C -C Otherwise: -C - invalid key -C - ELSE - IF (NR.GT.0) IS = MSG_SET (DWC_AMBQUAL,1) - IF (NR.LE.0) IS = MSG_SET (DWC_UNKQUAL,1) - GOTO 999 - ENDIF - ENDIF -C -C - CLI_BUF_PUTQUAL = DWC_SUCCESS - RETURN -C - 999 CLI_BUF_PUTQUAL = DWC_CLIBUFERR - RETURN - END -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - INTEGER*4 FUNCTION CLI_BUF_GET (NAME,VAL,LVAL) -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' - INCLUDE 'CLI_1_DEF' -C -C - CHARACTER*(*) NAME ! (i) argument name (case insensitive) - CHARACTER*(*) VAL ! (o) value - INTEGER*4 LVAL ! (o) significant length of the value -C -C.Purpose: Get status and value of an argument from the buffer -C.Returns: Status code (.TRUE. for success, .FALSE. otherwise) -C success DWC_PRESENT argument is present -C success DWC_NEGATED qualifier is negated -C success DWC_ABSENT optional argument is absent -C success DWC_REQUIRED required argument is absent -C error DWC_CLIBUFERR error report left in message buffer -C.Notes: -C - NAME can be a uniquely abbreviated parameter or qualifier name. -C - If the argument is present, any value (maybe the default value) will -C be returned in VAL. LVAL = 0 means that no value is available. -C - If the argument is absent but required, the status DWC_REQUIRED will -C be returned and the prompt string and its length will be returned in -C VAL and LVAL. -C - In all other cases VAL will be blank and LVAL = 0. -C - Parameter (default) values are used only once: after each GET for a -C parameter, its value will be removed from the buffer and the status -C in the buffer will be set to DWC_ABSENT. Qualifier values and -C status's are not modified by GET. -C------------------------------------------------------------------------- -C - CHARACTER*(*) BLANK - PARAMETER (BLANK = ' ') -C - INTEGER*4 CLI_STR_GET, CLI_STR_PUT - INTEGER STR_UPCASE, STR_MATCH_A, MSG_SET -C - CHARACTER UPNAME*(CLI__LNAM) - INTEGER*4 STAT, IS, NR -C -C -C Initialize output arguments -C - VAL = BLANK - LVAL = 0 -C -C Check the argument name -C - UPNAME = NAME - IS = STR_UPCASE (UPNAME) - IS = STR_MATCH_A (UPNAME,CLI$NRARG,CLI$NAME,NR) - IF (IAND(IS,1).EQ.0) THEN - IF (NR.GT.0) IS = MSG_SET (DWC_CLINAMAMB,1) - IF (NR.EQ.0) IS = MSG_SET (DWC_CLINAMUNK,1) - IF (NR.GE.0) CALL WNCTXT(DWLOG,DWMSG,NAME) - GOTO 999 - ENDIF -C -C Fill status and value arguments -C - STAT = CLI$STAT(NR) - IF (STAT.EQ.DWC_PRESENT) THEN - IF (CLI$IDVAL(NR).GT.0) THEN - IS = CLI_STR_GET (CLI$IDVAL(NR),VAL,LVAL) - ELSE IF (CLI$IDDEF(NR).GT.0) THEN - IS = CLI_STR_GET (CLI$IDDEF(NR),VAL,LVAL) - ENDIF - ELSE IF (STAT.EQ.DWC_ABSENT) THEN - IF (IAND(CLI$ATTR(NR),CLI__REQUIRED).NE.0) THEN - STAT = DWC_REQUIRED - IS = CLI_STR_GET (CLI$IDPRO(NR),VAL,LVAL) - ENDIF - ENDIF - IF (IAND(IS,1).EQ.0) GOTO 999 -C -C Parameter and expression values -C are only used once: -C - set buffer status to absent -C - clear the value in the buffer -C - IF (NR.LE.CLI$NRPAR .AND. STAT.EQ.DWC_PRESENT) THEN - CLI$STAT(NR) = DWC_ABSENT - IS = CLI_STR_PUT (CLI$IDVAL(NR),BLANK,0) - IF (IAND(IS,1).EQ.0) GOTO 999 - ENDIF -C -C - CLI_BUF_GET = STAT - RETURN -C - 999 CLI_BUF_GET = DWC_CLIBUFERR - RETURN - END -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - INTEGER*4 FUNCTION CLI_BUF_GETCOM (COMMAND,LCOM) -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' - INCLUDE 'CLI_1_DEF' -C - CHARACTER*(*) COMMAND ! (o) full command string - INTEGER*4 LCOM ! (o) significant length of the string -C -C.Purpose: Get the complete argument string from the buffer -C.Returns: Status code (.TRUE. for success, .FALSE. otherwise) -C success DWC_SUCCESS -C.Notes: -C - All present arguments and negated qualifiers will be assembled. -C - Qualifiers are given with their full names preceded by '/' or '/NO'). -C - Qualifier values are added with a '=' sign. -C - If the output string is too short the command will be truncated. -C - Since parameter value disappear from the buffer with a CLI_BUF_GET, -C CLI_BUF_GETCOM only gives the complete argument string when it is -C called before any parameter GET. -C------------------------------------------------------------------------- -C - CHARACTER*(*) BLANK, SLASH, EQUAL - PARAMETER (BLANK = ' ') - PARAMETER (SLASH = '/') - PARAMETER (EQUAL = '=') -C - INTEGER*4 CLI_STR_GET, STR_COPY, STR_SIGLEN -C - CHARACTER QKEY*(CLI__LNAM+3), VAL*255 - INTEGER*4 IS, LK, LV, NR -C -C - COMMAND = BLANK - LCOM = 0 -C -C Assemble present parameters -C - DO NR = 1,CLI$NRPAR - IF (CLI$STAT(NR).EQ.DWC_PRESENT) THEN - IS = CLI_STR_GET (CLI$IDVAL(NR),VAL,LV) - IS = STR_COPY (VAL(:LV)//BLANK,COMMAND,LCOM) - ENDIF - ENDDO -C -C Assemble present/negated qualifiers -C - DO NR = CLI$NRPAR+1,CLI$NRARG - IF (CLI$STAT(NR).EQ.DWC_PRESENT) THEN - QKEY = SLASH//CLI$NAME(NR) - LK = STR_SIGLEN (QKEY) - IF (CLI$IDVAL(NR).GT.0) THEN - IS = CLI_STR_GET (CLI$IDVAL(NR),VAL,LV) - IS = STR_COPY (QKEY(:LK)//EQUAL//VAL(:LV), - 1 COMMAND,LCOM) - ELSE IF (CLI$IDDEF(NR).GT.0) THEN - IS = CLI_STR_GET (CLI$IDDEF(NR),VAL,LV) - IS = STR_COPY (QKEY(:LK)//EQUAL//VAL(:LV), - 1 COMMAND,LCOM) - ELSE - IS = STR_COPY (QKEY(:LK),COMMAND,LCOM) - ENDIF - ELSE IF (CLI$STAT(NR).EQ.DWC_NEGATED) THEN - QKEY = SLASH//'NO'//CLI$NAME(NR) - LK = STR_SIGLEN (QKEY) - IS = STR_COPY (QKEY(:LK),COMMAND,LCOM) - ENDIF - ENDDO -C - CLI_BUF_GETCOM = DWC_SUCCESS - RETURN - END -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - INTEGER*4 FUNCTION CLI_BUF_GETNRS (NRPAR,NREXP,NRQUA) -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' - INCLUDE 'CLI_1_DEF' -C - INTEGER*4 NRPAR ! (o) nr of parameters - INTEGER*4 NREXP ! (o) nr of expressions - INTEGER*4 NRQUA ! (o) nr of qualifiers -C -C.Purpose: Get the numbers of defined arguments -C.Returns: Status code (.TRUE. for success, .FALSE. otherwise) -C success DWC_SUCCESS -C.Notes: -C------------------------------------------------------------------------- -C - NRPAR = CLI$NRPAR - NREXP = CLI$NREXP - NRQUA = CLI$NRQUA -C - CLI_BUF_GETNRS = DWC_SUCCESS - RETURN - END diff --git a/src/dwarf/clistr.for b/src/dwarf/clistr.for deleted file mode 100644 index ff2adda7eb47fbef17951d1c7f931f3752d2b07d..0000000000000000000000000000000000000000 --- a/src/dwarf/clistr.for +++ /dev/null @@ -1,198 +0,0 @@ -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ -C.Ident: CLI_STR -C.Keywords: Command Line Interpreter, String Buffer -C.Author: Friso Olnon (NFRA, Dwingeloo) -C.Language: DWARF-Fortran -C.Environment: VAX or Alliant -C.Comments: -C All argument names, values and prompt strings are kept in a local -C buffer in this module. They can only be accessed via the entry points -C provided: INIT, PUT, GET -C.Version: 881205 FMO - creation -C.Version: 900420 FMO - expand comments -C.Version: 910913 FMO - double the buffer size -C.Version: 920214 GvD - no optional arguments in MSG anymore -C------------------------------------------------------------------------- -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - INTEGER*4 FUNCTION CLI_STR () -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' -C - INTEGER*4 CLI_STR_INIT ! () - INTEGER*4 CLI_STR_PUT ! (ID,STRING,LSTR) - INTEGER*4 CLI_STR_GET ! (ID,STRING,LSTR) -C - INTEGER*4 ID ! (m) string identifier - CHARACTER*(*) STRING ! (i/o) string - INTEGER*4 LSTR ! (i/o) significant length of STRING -C -C.Purpose: Manipulate the CLI-string buffer -C.Returns: Status code (.TRUE. for success, .FALSE. otherwise) -C success DWC_SUCCESS -C warning DWC_STRTOOSHO output string truncated (GET) -C error DWC_CLISTRMAX too many CLI strings (PUT) -C error DWC_CLISTROVR CLI-string buffer overflow (PUT) -C fatal DWC_CLISTRINV invalid ID (PUT and GET) -> ABORT -C.Notes: -C - Each string in the buffer has an identifier. The caller must declare -C these identifiers as INTEGER*4 variables with initial value 0, and -C carry them around (never re-assign). -C - The module can manage up to 40 CLI strings with a total length of up -C to 1024 characters. -C - If the module gets an invalid ID, the program will be aborted. -C - CLI strings are stored/retrieved literally, e.g. trailing blanks and -C tabs are considered to be significant. -C -C INIT -C - Clears the buffer and returns with DWC_SUCCESS. -C -C PUT -C - If ID = 0, STRING(:LSTR) and LSTR will be stored in the buffer and -C ID will receive a value, provided that LSTR > 0. -C - If ID > 0, the associated string will be removed from the buffer. -C If LSTR > 0, STRING(:LSTR) and LSTR will be stored in its place. -C Otherwise, ID will be reset to 0. -C -C GET -C - If ID > 0, the associated string and its length will be copied from -C the buffer into STRING and LSTR. If STRING is too short, the string -C will be truncated. -C - If ID = 0, STRING will be made blank and LSTR will be set to 0. -C------------------------------------------------------------------------- -C -C -C Definition of the string buffer -C - INTEGER*4 MAXID, BUFSIZ - CHARACTER*(*) BLANK - PARAMETER (MAXID = 40 ) ! max nr of ID's - PARAMETER (BUFSIZ = 1024) ! buffer size (bytes) - PARAMETER (BLANK = ' ') - CHARACTER BUF*(BUFSIZ) - INTEGER*4 LBUF, OFFS(MAXID), LENG(MAXID) - SAVE BUF, LBUF, OFFS, LENG - DATA BUF /BLANK / ! string buffer - DATA LBUF /0 / ! used length of buffer - DATA OFFS /MAXID*0/ ! offsets of strings - DATA LENG /MAXID*0/ ! lengths of strings -C - INTEGER*4 CLEAR_BLJ, STR_COPY - INTEGER MSG_SET -C - CHARACTER WORK*(BUFSIZ) - INTEGER*4 IS, TMP -C -C -C ENTRY CLI_STR () ! Dummy entry point -C ============= -C - CLI_STR = DWC_SUCCESS - RETURN -C -C - ENTRY CLI_STR_INIT () ! Initialize buffer -C ================== -C - IS = CLEAR_BLJ (OFFS,MAXID) - IS = CLEAR_BLJ (LENG,MAXID) - BUF = BLANK - LBUF = 0 -C - CLI_STR_INIT = DWC_SUCCESS - RETURN -C -C - ENTRY CLI_STR_PUT (ID,STRING,LSTR) ! Put string in buffer -C ================= -C -C - IF (ID.LT.0 .OR. ID.GT.MAXID) GOTO 9999 -C -C If no old string present: -C - if new string given: -C put it in first free slot -C and return the slot nr in ID -C - otherwise: -C just return with success status -C - IF (ID.EQ.0) THEN - IF (LSTR.GT.0) THEN - ID = 1 - DO WHILE (ID.LE.MAXID .AND. LENG(ID).GT.0) - ID = ID+1 - ENDDO - IF (ID.GT.MAXID) GOTO 9991 - OFFS(ID) = LBUF - LENG(ID) = LSTR - IS = STR_COPY (STRING(:LSTR),BUF,LBUF) - IF (IS.LT.0) GOTO 9992 - ENDIF -C -C Otherwise: -C - remove the old string -C and update the offset array -C - put the new string in the old slot -C or clear the slot and return ID=0 -C - ELSE - IF (OFFS(ID)+LENG(ID).EQ.LBUF) THEN - LBUF = OFFS(ID) - ELSE - WORK = BUF(OFFS(ID)+LENG(ID)+1:LBUF) - BUF(OFFS(ID)+1:) = WORK - LBUF = LBUF-LENG(ID) - DO TMP = 1,MAXID - IF (OFFS(TMP).GT.OFFS(ID)) - 1 OFFS(TMP) = OFFS(TMP)-LENG(ID) - ENDDO - ENDIF -C - IF (LSTR.GT.0) THEN - OFFS(ID) = LBUF - LENG(ID) = LSTR - IS = STR_COPY (STRING(:LSTR),BUF,LBUF) - IF (IS.LT.0) GOTO 9992 - ELSE - OFFS(ID) = 0 - LENG(ID) = 0 - ID = 0 - ENDIF - ENDIF -C - CLI_STR_PUT = DWC_SUCCESS - RETURN -C - 9991 CLI_STR_PUT = MSG_SET (DWC_CLISTRMAX,1) - CALL WNCTXT(DWLOG,DWMSG,MAXID) - ID = 0 - RETURN -C - 9992 CLI_STR_PUT = MSG_SET (DWC_CLISTROVR,1) - CALL WNCTXT(DWLOG,DWMSG,BUFSIZ) - RETURN -C -C - ENTRY CLI_STR_GET (ID,STRING,LSTR) ! Get string from buffer -C ================== -C - IF (ID.LT.0 .OR. ID.GT.MAXID) GOTO 9999 -C - STRING = BLANK - LSTR = 0 - IF (ID.GT.0 .AND. LENG(ID).GT.0) THEN - IS = STR_COPY (BUF(OFFS(ID)+1:OFFS(ID)+LENG(ID)),STRING,LSTR) - IF (IS.LT.0) GOTO 9993 - ENDIF - CLI_STR_GET = DWC_SUCCESS - RETURN -C - 9993 CLI_STR_GET = MSG_SET (DWC_STRTOOSHO,1) - CALL WNCTXT(DWLOG,DWMSG,LEN(STRING)) - RETURN -C - 9999 CLI_STR = MSG_SET (DWC_CLISTRINV,1) - CALL WNCTXT(DWLOG,DWMSG,ID) - CALL WNGEX - RETURN - END diff --git a/src/dwarf/cpl.grp b/src/dwarf/cpl.grp deleted file mode 100644 index 774981b9ddaf2a118bda6de73908f157693e672b..0000000000000000000000000000000000000000 --- a/src/dwarf/cpl.grp +++ /dev/null @@ -1,101 +0,0 @@ -!+ CPL.GRP -! WNB 920915 -! -! Revisions: -! HjV 921104 Add function and entry names -! CMV 940120 Moved CPLVALLIST to PPD.GRP -! CMV 940131 Moved BPD to this groupfile -! AXC 012806 Changed files for linux port -! -! Routines used only by the PPD-Compiler -! -! Group definition: -! -CPL.GRP -! -! Masks for program development -! -! PIN files -! -! Structure files -! -CPL_2.DEF !Used in CPLERR, CPLOBJ, CPLSRC, CPLWRK - CPLBLOCK.FOR !CPL_BLOCK -BLDPPD_2.DEF ! Used by bpdbuild/compile/help/index/parm/ref - BLDPPDBLOCK.FOR !BLDPPD_BLOCK -! -! General command files -! -! -! Initialisation command files -! -! -! Fortran definition files: -! -! -! Programs: -! -BPDBUILD.FOR !BPD_BUILD -BPDCOMPILE.FOR !BPD_COMPILE -BPDHELP.FOR !BPD_HELP_INIT - !BPD_HELP_PUT - !BPD_HELP_WRITE - !BPD_HELP_INQ -BPDINDEX.FOR !BPD_INDEX_INIT - !BPD_INDEX_PUT - !BPD_INDEX_SORT - !BPD_INDEX_UNIQ - !BPD_INDEX_WRITE - !BPD_INDEX_INQ - !BPD_INDEX_GETU - !BPD_INDEX_GETP -BPDINIT.FOR !BPD_INIT - !BPD_EXIT -BPDPARM.FOR !BPD_PARM_INIT - !BPD_PARM_PUT - !BPD_PARM_PUTL - !BPD_PARM_WRITE - !BPD_PARM_INQ - !BPD_PROTO_INIT - !BPD_PROTO_PUT - !BPD_PROTO_PUTL - !BPD_PROTO_WRITE - !BPD_PROTO_INQ -BPDREF.FSC !BPD_REF_UPDATE - !BPD_REF_WRITE - !BPD_REF_LIST -BPDSTORE.FOR !BPD_STORE - BPDEFCHECK.FOR !BP_DEF_CHECK -BPDWRITE.FOR !BPD_WRITE -! -CPLDYN.FOR !CPL_DYN_PUT - !CPL_DYN_WRITE -CPLERR.FOR !CPL_ERR_INIT - !CPL_ERR_PUT - !CPL_ERR_SORT - !CPL_ERR_GETMSG - !CPL_ERR_GETSUM -CPLLIST.FOR !CPL_LIST -CPLOBJ.FSC !CPL_OBJ_OPEN - !CPL_OBJ_CLOSE - !CPL_OBJ_DELETE - !CPL_OBJ_INQUIRE - !CPL_OBJ_WRITE -CPLREAD.FOR !CPL_READ -CPLSRC.FSC !CPL_SRC_OPEN - !CPL_SRC_CLOSE - !CPL_SRC_REWIND - !CPL_SRC_BACKSP - !CPL_SRC_INQUIRE - !CPL_SRC_READ - !CPL_SRC_GETLINE - !CPL_SRC_GETKEY - !CPL_SRC_GETVAL -CPLWRK.FOR !CPL_WRK_INIT - !CPL_WRK_PUTLNR - !CPL_WRK_PUTVAL - !CPL_WRK_GET -! -! Executables -! -!- diff --git a/src/dwarf/cpl_2.def b/src/dwarf/cpl_2.def deleted file mode 100644 index 1d14886785ac7ff79737c9aa5e8fc6eea155dbb5..0000000000000000000000000000000000000000 --- a/src/dwarf/cpl_2.def +++ /dev/null @@ -1,159 +0,0 @@ -C Include module CPL_2 -C Created by BLDDEF from: USER5:[VANDIEPEN.WORK.NEW]CPL.DEF; on 17-MAR-92 -C -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ -C.Ident: DEF_CPL -C.Keywords: Compiler Utility, Buffers and Constants, Definition -C.Author: Friso Olnon, Kasper Kombrink (NFRA, Dwingeloo) -C.Language: DWARF-DEF -C.Environment: VAX or Alliant -C.Comments: -C.Version: 850320 KK - version 1 -C.Version: 890109 FMO - version 2; completely renewed -C.Version: 920317 GvD - take care of alignment (use filler) -C.Version: 930427 HjV - Change size of work buffer from 2000 to 2500 -C. and update some pointers -C.Version: 930613 HjV - Change size of work buffer from 2500 to 5000 -C.Version: 940829 HjV - Change size of work buffer from 5000 to 10000 -C------------------------------------------------------------------------- -C -C -C Sizes of buffers -C - INTEGER*4 CPL__SRCLMAX - PARAMETER (CPL__SRCLMAX =255) !max length of source lines (char's) - INTEGER*4 CPL__OBJLMAX - PARAMETER (CPL__OBJLMAX =512) !max length of object records (bytes) - INTEGER*4 CPL__NAMLMAX - PARAMETER (CPL__NAMLMAX =64) !max length of full file names (char's) - INTEGER*4 CPL__WRKLMAX - PARAMETER (CPL__WRKLMAX =10000) !size of the work buffer for values (bytes) - INTEGER*4 CPL__WRKNMAX - PARAMETER (CPL__WRKNMAX =32) !max nr of fields in the work buffer - INTEGER*4 CPL__ERRNMAX - PARAMETER (CPL__ERRNMAX =100) !max nr of in the error buffer -C -C - INTEGER*4 CPL_LENGTH - PARAMETER (CPL_LENGTH =1) !&1 !#J !generated: field to contain the block length - INTEGER*4 CPL_TYPE - PARAMETER (CPL_TYPE =5) !&1 !#J !generated: field to contain the block type -C -C Source status block and buffer -C - INTEGER*4 CPL_SRCLUN - PARAMETER (CPL_SRCLUN =9) !&1 !#J !LUN for the source file currently open - INTEGER*4 CPL_SRCNAME - PARAMETER (CPL_SRCNAME =13) !&64 !#C !full name of the source file last opened - INTEGER*4 CPL_SRCBUF - PARAMETER (CPL_SRCBUF =77) !&255 !#C !last source line read - INTEGER*4 CPL_FILLER1 - PARAMETER (CPL_FILLER1 =332) !&1 !#L !filler for alignment - INTEGER*4 CPL_SRCLBUF - PARAMETER (CPL_SRCLBUF =333) !&1 !#J !signif. length of the last line read - INTEGER*4 CPL_SRCLNR - PARAMETER (CPL_SRCLNR =337) !&1 !#J !nr of the last line read - INTEGER*4 CPL_SRCPTR - PARAMETER (CPL_SRCPTR =341) !&1 !#J !pointer in the last line read -C -C Object status block -C - INTEGER*4 CPL_OBJLUN - PARAMETER (CPL_OBJLUN =345) !&1 !#J !LUN for the object file currently open - INTEGER*4 CPL_OBJNAME - PARAMETER (CPL_OBJNAME =349) !&64 !#C !full name of the object file last opened - INTEGER*4 CPL_OBJLREC - PARAMETER (CPL_OBJLREC =413) !&1 !#J !record length (bytes) - INTEGER*4 CPL_OBJNREC - PARAMETER (CPL_OBJNREC =417) !&1 !#J !nr of records written -C -C -C Work buffer -C - INTEGER*4 CPL_WRKBUF - PARAMETER (CPL_WRKBUF =421) !&10000 !#C !buffer with field values (as char string) - INTEGER*4 CPL_WRKLBUF - PARAMETER (CPL_WRKLBUF =10421) !&1 !#J !signif. length of the value buffer - INTEGER*4 CPL_WRKSTART - PARAMETER (CPL_WRKSTART =10425) !&32 !#J !start positions of the values in the buffer - INTEGER*4 CPL_WRKEND - PARAMETER (CPL_WRKEND =10553) !&32 !#J !end positions of the values in the buffer - INTEGER*4 CPL_WRKLNR - PARAMETER (CPL_WRKLNR =10681) !&33 !#J !source-line nrs for the corresponding fields - !WRKLNR(0) is the nr of the last line read -C -C Error buffer -C - INTEGER*4 CPL_ERRBUF - PARAMETER (CPL_ERRBUF =10813) !&200 !#J !ERRBUF(n,1) = nr of the source line - !ERRBUF(n,2) = status code for message - INTEGER*4 CPL_ERRNERR - PARAMETER (CPL_ERRNERR =11613) !&1 !#J !nr of error entries - INTEGER*4 CPL_ERRNWARN - PARAMETER (CPL_ERRNWARN =11617) !&1 !#J !nr of warning entries - INTEGER*4 CPL_ERRNTOT - PARAMETER (CPL_ERRNTOT =11621) !&1 !#J !total nr of entries -C - INTEGER*4 CPL__LENGTH - PARAMETER (CPL__LENGTH =2906) !generated: block length (in longwords) - INTEGER*4 CPL__TYPE - PARAMETER (CPL__TYPE =30) !generated: block type - INTEGER*4 CPL__DEFTYP - PARAMETER (CPL__DEFTYP=22) - INTEGER*4 CPL__DEFVSN - PARAMETER (CPL__DEFVSN=2) -C - EXTERNAL CPL_BLOCK -C -C Common block specification -C - INTEGER*4 CPL$LENGTH - EQUIVALENCE (CPL$LENGTH,CPL__(0)) - INTEGER*4 CPL$TYPE - EQUIVALENCE (CPL$TYPE,CPL__(4)) - INTEGER*4 CPL$SRCLUN - EQUIVALENCE (CPL$SRCLUN,CPL__(8)) - CHARACTER*64 CPL$SRCNAME - EQUIVALENCE (CPL$SRCNAME,CPL__(12)) - CHARACTER*255 CPL$SRCBUF - EQUIVALENCE (CPL$SRCBUF,CPL__(76)) - LOGICAL*1 CPL$FILLER1 - EQUIVALENCE (CPL$FILLER1,CPL__(331)) - INTEGER*4 CPL$SRCLBUF - EQUIVALENCE (CPL$SRCLBUF,CPL__(332)) - INTEGER*4 CPL$SRCLNR - EQUIVALENCE (CPL$SRCLNR,CPL__(336)) - INTEGER*4 CPL$SRCPTR - EQUIVALENCE (CPL$SRCPTR,CPL__(340)) - INTEGER*4 CPL$OBJLUN - EQUIVALENCE (CPL$OBJLUN,CPL__(344)) - CHARACTER*64 CPL$OBJNAME - EQUIVALENCE (CPL$OBJNAME,CPL__(348)) - INTEGER*4 CPL$OBJLREC - EQUIVALENCE (CPL$OBJLREC,CPL__(412)) - INTEGER*4 CPL$OBJNREC - EQUIVALENCE (CPL$OBJNREC,CPL__(416)) - CHARACTER*10000 CPL$WRKBUF - EQUIVALENCE (CPL$WRKBUF,CPL__(420)) - INTEGER*4 CPL$WRKLBUF - EQUIVALENCE (CPL$WRKLBUF,CPL__(10420)) - INTEGER*4 CPL$WRKSTART(32) - EQUIVALENCE (CPL$WRKSTART,CPL__(10424)) - INTEGER*4 CPL$WRKEND(32) - EQUIVALENCE (CPL$WRKEND,CPL__(10552)) - INTEGER*4 CPL$WRKLNR(0:32) - EQUIVALENCE (CPL$WRKLNR,CPL__(10680)) - INTEGER*4 CPL$ERRBUF(100,2) - EQUIVALENCE (CPL$ERRBUF,CPL__(10812)) - INTEGER*4 CPL$ERRNERR - EQUIVALENCE (CPL$ERRNERR,CPL__(11612)) - INTEGER*4 CPL$ERRNWARN - EQUIVALENCE (CPL$ERRNWARN,CPL__(11616)) - INTEGER*4 CPL$ERRNTOT - EQUIVALENCE (CPL$ERRNTOT,CPL__(11620)) - BYTE CPL__(0:11623) - BYTE CPL_(11624) - EQUIVALENCE (CPL_,CPL__) -C - COMMON /CPL/ CPL_ -C diff --git a/src/dwarf/cplblock.for b/src/dwarf/cplblock.for deleted file mode 100644 index 9b5352499c679b40c93304f983789d2e6a47e874..0000000000000000000000000000000000000000 --- a/src/dwarf/cplblock.for +++ /dev/null @@ -1,72 +0,0 @@ - BLOCK DATA CPL_BLOCK -C Created by BLDDEF from: USER5:[VANDIEPEN.WORK.NEW]CPL.DEF; on 17-MAR-92 -C HjV 921208 Removed all equivalence and add names to common block -C HjV 930427 Change size CPL$WRKBUF from 2000 to 2500 -C HjV 930613 Change size CPL$WRKBUF from 2500 to 5000 -C HjV 940829 Change size CPL$WRKBUF from 5000 to 10000 -C AXC 010709 Linux port - data initiialisation -C -C -C - INTEGER*4 CPL$LENGTH - INTEGER*4 CPL$TYPE - INTEGER*4 CPL$SRCLUN - CHARACTER*64 CPL$SRCNAME - CHARACTER*255 CPL$SRCBUF - LOGICAL*1 CPL$FILLER1 - INTEGER*4 CPL$SRCLBUF - INTEGER*4 CPL$SRCLNR - INTEGER*4 CPL$SRCPTR - INTEGER*4 CPL$OBJLUN - CHARACTER*64 CPL$OBJNAME - INTEGER*4 CPL$OBJLREC - INTEGER*4 CPL$OBJNREC - CHARACTER*10000 CPL$WRKBUF - INTEGER*4 CPL$WRKLBUF - INTEGER*4 CPL$WRKSTART(32) - INTEGER*4 CPL$WRKEND(32) - INTEGER*4 CPL$WRKLNR(0:32) - INTEGER*4 CPL$ERRBUF(100,2) - INTEGER*4 CPL$ERRNERR - INTEGER*4 CPL$ERRNWARN - INTEGER*4 CPL$ERRNTOT -C - COMMON /CPL/ CPL$LENGTH, CPL$TYPE, CPL$SRCLUN, CPL$SRCNAME, - * CPL$SRCBUF, CPL$FILLER1, CPL$SRCLBUF, CPL$SRCLNR, - * CPL$SRCPTR, CPL$OBJLUN, CPL$OBJNAME, CPL$OBJLREC, - * CPL$OBJNREC, CPL$WRKBUF, CPL$WRKLBUF, CPL$WRKSTART, - * CPL$WRKEND, CPL$WRKLNR, CPL$ERRBUF, CPL$ERRNERR, - * CPL$ERRNWARN, CPL$ERRNTOT -C - DATA CPL$SRCLUN /-1/ - DATA CPL$SRCNAME /' '/ - DATA CPL$SRCBUF /' '/ - DATA CPL$SRCLBUF /0/ - DATA CPL$SRCLNR /0/ - DATA CPL$SRCPTR /0/ - DATA CPL$OBJLUN /-1/ - DATA CPL$OBJNAME /' '/ - DATA CPL$OBJLREC /0/ - DATA CPL$OBJNREC /0/ - DATA CPL$ERRNTOT /0/ - DATA CPL$WRKBUF /' '/ - DATA CPL$WRKLBUF /0/ - DATA CPL$WRKSTART /32*0/ - DATA CPL$WRKEND /32*0/ - DATA CPL$WRKLNR /33*0/ - DATA CPL$ERRBUF /200*0/ - DATA CPL$ERRNERR /0/ - DATA CPL$ERRNWARN /0/ -C - END - - - - - - - - - - - diff --git a/src/dwarf/cpldyn.for b/src/dwarf/cpldyn.for deleted file mode 100644 index fa568fe433eaabc3d08f140bcb21a4a2cbabd4de..0000000000000000000000000000000000000000 --- a/src/dwarf/cpldyn.for +++ /dev/null @@ -1,118 +0,0 @@ -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ -C.Ident: CPL_DYN -C.Keywords: Compiler Utility, Dynamic Buffer -C.Author: Friso Olnon (NFRA, Dwingeloo) -C.Language: DWARF-Fortran -C.Environment: VAX or Alliant -C.Comments: -C The buffer is described in the status array (INTEGER*4 elements): -C (1) = extend size (bytes) -C (2) = size of dynamic buffer (0 = not yet allocated) -C (3) = virtual address of dynamic buffer -C (4) = nr of bytes written -C (5) = nr of entries written -C (6) = offset of last-written entry -C -C.Version: 900415 FMO - recreation -C.Version: 920214 GvD - no optional arguments in MSG anymore -C.Version: 940120 CMV - use WNGGVM i.s.o. GEN_GET_VM, use A_B etc. -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - INTEGER*4 FUNCTION CPL_DYN_PUT (NBARR,BARR,DYNSTAT) -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' -C - INTEGER*4 NBARR ! (i) size of BARR in bytes - BYTE BARR(*) ! (i) array to be moved into the buffer - INTEGER*4 DYNSTAT(6) ! (m) status array dynamic buffer -C -C.Purpose: Write a byte array into the dynamic buffer -C.Returns: Status code (.TRUE. for success, .FALSE. otherwise) -C success CPL_SUCCESS -C fatal CPL_DYNFILERR error report left in message buffer -C.Notes: -C------------------------------------------------------------------------- -C -C - INTEGER MOVE_BLB, MSG_SET - LOGICAL WNGGVM, WNGFVM -C - INTEGER*4 IS, OLDSIZ, OLDADR -C -C -C If no buffer is allocated yet -C or the current buffer is too small: -C allocate/extend the buffer -C - IF (NBARR.GT.0) THEN - DYNSTAT(6) = DYNSTAT(4) - DYNSTAT(4) = DYNSTAT(4) + NBARR - IF (DYNSTAT(4).GT.DYNSTAT(2)) THEN - OLDSIZ = DYNSTAT(2) - OLDADR = DYNSTAT(3) - DYNSTAT(2) = ((DYNSTAT(4)-1)/DYNSTAT(1)+1)*DYNSTAT(1) - IF (.NOT.WNGGVM(DYNSTAT(2),DYNSTAT(3))) GOTO 999 -C - IF (OLDSIZ.NE.0) THEN - IS = MOVE_BLB (A_B(OLDADR-A_OB), - 1 A_B(DYNSTAT(3)-A_OB), - 1 DYNSTAT(6)) - IF (.NOT.WNGFVM(OLDSIZ,OLDADR)) GOTO 999 - ENDIF - ENDIF -C -C Put BARR into the buffer -C - IS = MOVE_BLB (BARR,A_B(DYNSTAT(3)+DYNSTAT(6)-A_OB),NBARR) - IF (IAND(IS,1).EQ.0) GOTO 999 - DYNSTAT(5) = DYNSTAT(5)+1 - ENDIF -C -C Return -C - CPL_DYN_PUT = CPL_SUCCESS - RETURN -C - 999 CPL_DYN_PUT = MSG_SET (CPL_DYNFILERR,0) - RETURN - END -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - INTEGER*4 FUNCTION CPL_DYN_WRITE (DYNSTAT,SWFREE) -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' -C - INTEGER*4 DYNSTAT(6) ! (i) status array dynamic buffer - LOGICAL*4 SWFREE ! (i) release virtual memory ? -C -C.Purpose: Write the dynamic buffer into the object file -C.Returns: Status code (.TRUE. for success, .FALSE. otherwise) -C success CPL_SUCCESS -C fatal CPL_DYNWRTERR error report left in message buffer -C.Notes: -C------------------------------------------------------------------------- -C - LOGICAL WNGFVM - INTEGER*4 CPL_OBJ_WRITE - INTEGER*4 CLEAR_BLJ - INTEGER MSG_SET -C - INTEGER*4 IS -C -C - IF (DYNSTAT(2).GT.0) THEN - IS = CPL_OBJ_WRITE (A_B(DYNSTAT(3)-A_OB),DYNSTAT(4)) - IF (IAND(IS,1).EQ.0) GOTO 999 - IF (SWFREE) THEN - IF (.NOT.WNGFVM(DYNSTAT(2),DYNSTAT(3))) GOTO 999 - IS = CLEAR_BLJ (DYNSTAT(2),3) - IF (IAND(IS,1).EQ.0) GOTO 999 - ENDIF - ENDIF -C - CPL_DYN_WRITE = CPL_SUCCESS - RETURN -C - 999 CPL_DYN_WRITE = MSG_SET (CPL_DYNWRTERR,0) - RETURN - END diff --git a/src/dwarf/cplerr.for b/src/dwarf/cplerr.for deleted file mode 100644 index 996f1a9d44946c7e8f94a70aab337364944d67c6..0000000000000000000000000000000000000000 --- a/src/dwarf/cplerr.for +++ /dev/null @@ -1,303 +0,0 @@ -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ -C.Ident: CPL_ERR -C.Keywords: Compiler Utility, Error Buffer -C.Author: Friso Olnon (NFRA, Dwingeloo) -C.Language: DWARF-Fortran -C.Environment: VAX or Alliant -C.Comments: -C Common variables used: -C INTEGER*4 CPL$ERRBUF(*,2) ! (m) error array -C (i,1) = source-line number -C (i,2) = error code -C INTEGER*4 CPL$ERRNTOT ! (m) nr of entries in error buffer -C INTEGER*4 CPL$ERRNERR ! (m) total nr of error entries -C INTEGER*4 CPL$ERRNWARN ! (m) total nr of warning entries -C -C.Version: 900407 FMO - recreation -C.Version: 920214 GvD - no optional arguments in MSG anymore -C------------------------------------------------------------------------- -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - INTEGER*4 FUNCTION CPL_ERR_INIT () -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' - INCLUDE 'CPL_2_DEF' -C -C -C.Purpose: Initialize the error buffer -C.Returns: Status code (.TRUE. for success, .FALSE. otherwise) -C success CPL_SUCCESS -C.Notes: -C------------------------------------------------------------------------- -C - CPL$ERRNWARN = 0 - CPL$ERRNERR = 0 - CPL$ERRNTOT = 0 -C - CPL_ERR_INIT = CPL_SUCCESS - RETURN - END -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - INTEGER*4 FUNCTION CPL_ERR_PUT (STAT,LINENR) -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' - INCLUDE 'CPL_2_DEF' -C - INTEGER*4 STAT ! (i) status code - INTEGER*4 LINENR ! (i) source-line number -C -C.Purpose: Put error/warning code and source-line nr in error buffer -C.Returns: Status code (.TRUE. for success, .FALSE. otherwise) -C success CPL_SUCCESS -C fatal CPL_ERRCNTEXC maximum error count exceeded -C.Notes: -C - If the status code is true, the function just returns with the -C success status. -C - Otherwise, DWARF's normal message buffer will be cleared, -C the status code will be stored in the CPL error buffer, -C the counts will be incremented, and -C the function returns with the success status. -C------------------------------------------------------------------------- -C - INTEGER MSG_SET -C - INTEGER*4 IS -C -C - IF (IAND(STAT,1).EQ.0) THEN - CPL$ERRNTOT = CPL$ERRNTOT+1 - IF (CPL$ERRNTOT.GE.CPL__ERRNMAX) GOTO 999 - CPL$ERRBUF(CPL$ERRNTOT,1) = LINENR - CPL$ERRBUF(CPL$ERRNTOT,2) = STAT - IF (IAND(STAT,7).EQ.0) THEN - CPL$ERRNWARN = CPL$ERRNWARN+1 - ELSE - CPL$ERRNERR = CPL$ERRNERR+1 - ENDIF - ENDIF -C - CPL_ERR_PUT = CPL_SUCCESS - RETURN -C - 999 CPL_ERR_PUT = MSG_SET(CPL_ERRCNTEXC,0) - CPL$ERRBUF(CPL$ERRNTOT,1) = LINENR - CPL$ERRBUF(CPL$ERRNTOT,2) = CPL_ERRCNTEXC - CPL$ERRNERR = CPL$ERRNERR+1 - RETURN - END -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - INTEGER*4 FUNCTION CPL_ERR_SORT () -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' - INCLUDE 'CPL_2_DEF' -C -C -C.Purpose: Sort the error array on ascending source-line number -C.Returns: Status code (.TRUE. for success, .FALSE. otherwise) -C success CPL_SUCCESS -C.Notes: -C The sort-algorithm is "quickersort" as described in -C "Communications of the ACM" nr 271 -C------------------------------------------------------------------------- -C - INTEGER*4 k,q,m,p,lt(32),ut(32),qh,t(2),x(2) -C -C - j = CPL$ERRNTOT - i = 1 - m = 1 -C - 10 IF (j-i.le.1) goto 100 -C -C Segment has more then 2 elements -C - split it -C - p = (i+j)/2 - t(1) = CPL$ERRBUF(p,1) - t(2) = CPL$ERRBUF(p,2) -C -C t are the values of -C the mid-array elements : -C t(1) = source line number -C t(2) = error-code -C - CPL$ERRBUF(p,1) = CPL$ERRBUF(i,1) - CPL$ERRBUF(p,2) = CPL$ERRBUF(i,2) - q = j -C -C - Look for an element CPL$ERRBUF(k,1) -C > t(1) from segment begin -C - Look for an element CPL$ERRBUF(q,1) -C < t(1) from segment end -C - If found: -C - interchange the entries -C - look for next pair -C - DO k = i+1,q - IF (i+1.le.q .AND. CPL$ERRBUF(k,1).gt.t(1)) then - DO q = q,k,-1 - IF (q.ge.k .AND. CPL$ERRBUF(q,1).lt.t(1)) then - x(1) = CPL$ERRBUF(k,1) - x(2) = CPL$ERRBUF(k,2) - CPL$ERRBUF(k,1) = CPL$ERRBUF(q,1) - CPL$ERRBUF(k,2) = CPL$ERRBUF(q,2) - CPL$ERRBUF(q,1) = x(1) - CPL$ERRBUF(q,2) = x(2) - qh = q-1 - goto 45 - ENDIF - ENDDO - q = k-1 - goto 60 - 45 q = qh - ENDIF - ENDDO -C -C The pointer from segment start and -C the one from segment end met each other -C - 60 CPL$ERRBUF(i,1) = CPL$ERRBUF(q,1) - CPL$ERRBUF(i,2) = CPL$ERRBUF(q,2) - CPL$ERRBUF(q,1) = t(1) - CPL$ERRBUF(q,2) = t(2) -C -C The segment has been split in 3 parts -C (the middle of only 1 element) -C - save begin- and end-positions of the -C largest segment in arrays lt and ut -C - reset i and j (the begin- and end- -C positions of the next segment) -C - IF (q*2.gt.i+j) then - lt(m) = i - ut(m) = q-1 - i = q+1 - else - lt(m) = q+1 - ut(m) = j - j = q-1 - ENDIF -C -C Update and split this new segment -C - m = m+1 - goto 10 -C -C -C - 100 IF (i.lt.j) then -C -C Segment is less then 2 elements long -C - IF (CPL$ERRBUF(i,1).gt.CPL$ERRBUF(j,1)) then -C -C Segment is 2 elements long -C - x(1) = CPL$ERRBUF(i,1) - x(2) = CPL$ERRBUF(i,2) - CPL$ERRBUF(i,1) = CPL$ERRBUF(j,1) - CPL$ERRBUF(i,2) = CPL$ERRBUF(j,2) - CPL$ERRBUF(j,1) = x(1) - CPL$ERRBUF(j,2) = x(2) - ENDIF - ENDIF -C -C If lt and ut describe more segments -C to be sorted: repeat the process, -C if not: ready -C - m = m-1 - IF (m.gt.0) then - i = lt(m) - j = ut(m) - goto 10 - ENDIF -C - CPL_ERR_SORT = CPL_SUCCESS - RETURN - END -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - INTEGER*4 FUNCTION CPL_ERR_GETMSG (LINENR,TEXT,LTEXT) -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' - INCLUDE 'CPL_2_DEF' -C - INTEGER*4 LINENR ! (i) source-line number - CHARACTER*(*) TEXT ! (o) message text - INTEGER*4 LTEXT ! (o) signif. length of text -C -C.Purpose: Get the (next) message text associated with the source-line nr -C.Returns: Status code (.TRUE. for success, .FALSE. otherwise) -C success CPL_SUCCESS -C false status from GEN_GETMSG -C.Notes: -C If there is no (more) entry for the line nr in the error buffer, -C LTEXT = 0 will be returned. -C When LINENR = 0 is given, the internal error pointer is reset. -C------------------------------------------------------------------------- -C - INTEGER GEN_GETMSG, MSG_SET -C - INTEGER*4 PTR, IS, OUTADR - DATA PTR /1/ - SAVE PTR -C -C - TEXT = ' ' - LTEXT = 0 -C -C Reset pointer -C - IF (LINENR.EQ.0) THEN - PTR = 1 - CPL_ERR_GETMSG = CPL_SUCCESS - RETURN - ENDIF -C -C Move pointer to the right linenr -C - DO WHILE (PTR.LE.CPL$ERRNTOT .AND. CPL$ERRBUF(PTR,1).LT.LINENR) - PTR = PTR+1 - ENDDO -C -C Get the message text -C - IF (PTR.LE.CPL$ERRNTOT .AND. CPL$ERRBUF(PTR,1).EQ.LINENR) THEN - IS = GEN_GETMSG (CPL$ERRBUF(PTR,2),LTEXT,TEXT,15,OUTADR) - IF (IAND(IS,1).EQ.0) GOTO 999 - PTR = PTR+1 - ENDIF -C - CPL_ERR_GETMSG = CPL_SUCCESS - RETURN -C - 999 CPL_ERR_GETMSG = MSG_SET (IS,0) - RETURN - END -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - INTEGER*4 FUNCTION CPL_ERR_GETSUM (NERR,NWARN) -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' - INCLUDE 'CPL_2_DEF' -C - INTEGER*4 NERR ! (o) nr of error entries in errbuf - INTEGER*4 NWARN ! (o) nr of warning entries in errbuf -C -C.Purpose: Get the nr of error/warning entries in the error buffer -C.Returns: Status code (.TRUE. for success, .FALSE. otherwise) -C success CPL_SUCCESS -C.Notes: -C------------------------------------------------------------------------- -C -C -C - NERR = CPL$ERRNERR - NWARN = CPL$ERRNWARN -C - CPL_ERR_GETSUM = CPL_SUCCESS - RETURN - END diff --git a/src/dwarf/cpllist.for b/src/dwarf/cpllist.for deleted file mode 100644 index a9913efaead4e17470b161cc34ae9d4020eb8744..0000000000000000000000000000000000000000 --- a/src/dwarf/cpllist.for +++ /dev/null @@ -1,145 +0,0 @@ -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ -C.Ident: CPL_LIST -C.Keywords: Compiler Utility, List -C.Author: Friso Olnon (NFRA, Dwingeloo) -C.Language: DWARF-Fortran -C.Environment: VAX or Alliant -C.Comments: -C.Version: 900415 FMO - recreation -C.Version: 900920 FMO - only open print file for DO_LIST=.TRUE. -C.Version: 920213 GvD - no optional arguments anymore -C.Version: 940118 CMV - used WNCFOP, WNCALN i.s.o. DWARF stuff -C.Version: 940217 HjV - Change WNCFGC in WNCFGV -C------------------------------------------------------------------------- -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - INTEGER*4 FUNCTION CPL_LIST (LISTNAME,DO_LIST,PRTFLAGS) -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' -C - CHARACTER*(*) LISTNAME ! (i) list file specification - LOGICAL*4 DO_LIST ! (i) create compilation listing ? - INTEGER*4 PRTFLAGS ! (i) disposition flags -C -C.Purpose: Create output listing for the various compilers -C.Returns: Status code (.TRUE. for success, .FALSE. otherwise) -C success CPL_SUCCESS -C error CPL_CLISTERR error report left in message buffer -C.Notes: -C The source lines are merged with any error messages generated. -C The error messages and the compilation summary will also be displayed -C on the user terminal. -C------------------------------------------------------------------------- -C - LOGICAL L__FALSE - PARAMETER (L__FALSE = .FALSE.) -C - CHARACTER*(*) SUMTXT, SRCTXT, WARTXT, ERRTXT, CRETXT, DELTXT - PARAMETER (SUMTXT = '!/compilation summary :') - PARAMETER (SRCTXT = '!/ source file : !AS') - PARAMETER (WARTXT = ' total number of warnings : !SL') - PARAMETER (ERRTXT = ' total number of severe errors : !SL') - PARAMETER (CRETXT = '!/!AS created') - PARAMETER (DELTXT = '!/no object file created') -C - INTEGER*4 CPL_SRC_REWIND, CPL_SRC_GETLINE, CPL_SRC_INQUIRE - INTEGER*4 CPL_ERR_SORT, CPL_ERR_GETMSG, CPL_ERR_GETSUM - INTEGER*4 CPL_OBJ_INQUIRE - INTEGER MSG_SET -C - CHARACTER SRCNAME*64, OBJNAME*64, SRCLINE*255, PRTLINE*132 - INTEGER*4 FLAGS, LSN, LON, LSL, LPL, NLL, NPL, NHC - INTEGER*4 IS, LINENR, NERR, NWARN - INTEGER*4 LISTID /0/, LISTLCNT, LISTPLEN -C -C -C Set up -C - IS = CPL_ERR_SORT () - IF (IAND(IS,1).NE.0) IS = CPL_SRC_REWIND () - IF (IAND(IS,1).EQ.0) GOTO 999 - IF (DO_LIST) THEN - LISTID=-1 - CALL WNCFOP(LISTID,LISTNAME) - IF (LISTID.EQ.-1) GOTO 999 - CALL WNCFHD(LISTID,1,'!50C Compilation listing') - CALL WNCFSV(LISTID,F_DIS,PRTFLAGS) - ENDIF -C -C Read next source line -C - 100 IS = CPL_SRC_GETLINE (SRCLINE,LSL,LINENR) - IF (IS.EQ.CPL_SRCEOF) GOTO 900 - IF (IAND(IS,1).EQ.0) GOTO 999 -C -C Write to print file -C - IF (DO_LIST) CALL WNCTXT(LISTID,'!4$ZJ !AS', - 1 LINENR,SRCLINE(:LSL)) -C -C If error(s) detected in source line: -C - write source line to terminal -C - write messages to file and terminal -C - IS = CPL_ERR_GETMSG (LINENR,PRTLINE,LPL) - IF (IAND(IS,1).NE.0 .AND. LPL.GT.0) THEN - CALL WNCTXT(F_T,'!/!4$ZJ !AS',LINENR,SRCLINE(:LSL)) - DO WHILE (IAND(IS,1).NE.0 .AND. LPL.GT.0) - IF (DO_LIST) THEN - CALL WNCTXT(F_T+LISTID,'!AS',PRTLINE(:LPL)) - ELSE - CALL WNCTXT(F_T,'!AS',PRTLINE(:LPL)) - END IF - IF (IAND(IS,1).NE.0) - 1 IS = CPL_ERR_GETMSG (LINENR,PRTLINE,LPL) - ENDDO - ENDIF - IF (IAND(IS,1).EQ.0) GOTO 999 - GOTO 100 -C -C Get summary information -C - 900 IS = CPL_ERR_GETSUM (NERR,NWARN) - IF (IAND(IS,1).NE.0) IS = CPL_SRC_INQUIRE (SRCNAME,LSN) - IF (IAND(IS,1).NE.0) IS = CPL_OBJ_INQUIRE (OBJNAME,LON) - IF (IAND(IS,1).EQ.0) GOTO 999 -C -C Write summary to file and terminal -C - IF (DO_LIST) THEN - CALL WNCFGV(LISTID,F_LC,LISTLCNT) - CALL WNCFGV(LISTID,F_PL,LISTPLEN) - IF (LISTLCNT+8.GT.LISTPLEN) CALL WNCTXT(LISTID,'!^') - CALL WNCTXT(F_T+LISTID,SUMTXT) - CALL WNCTXT(F_T+LISTID,SRCTXT,SRCNAME(:LSN)) - CALL WNCTXT(F_T+LISTID,WARTXT,NWARN) - CALL WNCTXT(F_T+LISTID,ERRTXT,NERR) - IF (NERR.EQ.0) THEN - CALL WNCTXT(F_T+LISTID,CRETXT,OBJNAME(:LON)) - ELSE - CALL WNCTXT(F_T+LISTID,DELTXT) - ENDIF - CALL WNCFCL(LISTID) -C -C Write summary to terminal -C - ELSE - CALL WNCTXT(F_T,SUMTXT) - CALL WNCTXT(F_T,SRCTXT,SRCNAME(:LSN)) - CALL WNCTXT(F_T,WARTXT,NWARN) - CALL WNCTXT(F_T,ERRTXT,NERR) - IF (NERR.EQ.0) THEN - CALL WNCTXT(F_T,CRETXT,OBJNAME(:LON)) - ELSE - CALL WNCTXT(F_T,DELTXT) - ENDIF - ENDIF -C -C Return -C - CPL_LIST = CPL_SUCCESS - RETURN -C - 999 CPL_LIST = MSG_SET (CPL_CLISTERR,0) - RETURN - END diff --git a/src/dwarf/cplobj.fsc b/src/dwarf/cplobj.fsc deleted file mode 100644 index f86b51039554f66c437a650874eca7a390f37145..0000000000000000000000000000000000000000 --- a/src/dwarf/cplobj.fsc +++ /dev/null @@ -1,247 +0,0 @@ -C++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ -C.Ident: CPL_OBJ -C.Keywords: Compiler Utility, Object File -C.Author: Friso Olnon (NFRA, Dwingeloo) -C.Language: DWARF-Fortran -C.Environment: VAX or Alliant -C.Comments: -C Common variables used: -C -C INTEGER*4 CPL$OBJLUN ! (m) lun for file (-1 if not open) -C CHARACTER*64 CPL$OBJNAME ! (m) full name of last opened file -C INTEGER*4 CPL$OBJLREC ! (m) record length in bytes -C INTEGER*4 CPL$OBJNREC ! (m) nr of records written -C -C NAME, LREC and NREC are initially: ' ', 0, 0. -C NAME and LREC are filled by OPEN and only reset by DELETE. -C NREC is (re)set to 0 by OPEN and DELETE, and incremented by WRITE. -C So, the info is still available if the file is only closed. -C -C NOTE: for open keyed-access object files (CPL$OBJNREC = -1) -C calls to CPL_OBJ_WRITE are passed to CPL_KOBJ_WRITE. -C -C.Version: 890205 FMO - Creation -C.Version: 900403 FMO - removed keyed-access branch -C - expand file name using FILNAM_FULL -C.Version: 900502 FMO - new GEN_LUN module -C.Version: 920214 GvD - no optional arguments in MSG anymore -C - use GEN_FILCRE to open the output file -C.Version: 920423 GvD - use GEN_FILOPN to open the input file -C.Version: 940119 CMV - included OPEN statement in this file -C-------------------------------------------------------------------------- -C++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - INTEGER*4 FUNCTION CPL_OBJ_OPEN (FILESPEC,RECLEN) -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' - INCLUDE 'CPL_2_DEF' -C - CHARACTER*(*) FILESPEC ! (i) file specification - INTEGER*4 RECLEN ! (i) record length in bytes -C -C.Purpose: Open a new object file (direct access) -C.Returns: Status code (.TRUE. for success, .FALSE. otherwise) -C success CPL_SUCCESS -C fatal CPL_OBJOPNERR error report left in message buffer -C.Notes: -C-------------------------------------------------------------------------- -C -C - INTEGER FILNAM_FULL, MSG_SET, GEN_FORIOS -C - INTEGER*4 IS, LN, RCL -C -C - IF (CPL$OBJLUN.GE.0) GOTO 999 -C - IS = FILNAM_FULL (FILESPEC,CPL$OBJNAME,LN,' ') - CALL WNGLUN(CPL$OBJLUN) - IF (CPL$OBJLUN.EQ.0) GOTO 999 -C -#ifdef wn_hp__ - RCL = RECLEN -#else - #ifdef wn_li__ - RCL = RECLEN - #else - RCL = RECLEN/4 - #endif -#endif - OPEN (UNIT=CPL$OBJLUN,FILE=CPL$OBJNAME(:LN), -#ifdef wn_li__ - 1 FORM='UNFORMATTED', -#endif - 1 STATUS='UNKNOWN',ERR=992,ACCESS='DIRECT',RECL=RCL) - CPL$OBJLREC = RECLEN - CPL$OBJNREC = 0 -C - CPL_OBJ_OPEN = CPL_SUCCESS - RETURN -C - 992 IS = GEN_FORIOS(CPL$OBJNAME(:LN)) - CALL WNGLUF(CPL$OBJLUN) - CPL$OBJLUN = -1 -C - 999 CPL_OBJ_OPEN = MSG_SET (CPL_OBJOPNERR,0) - RETURN - END -C++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - INTEGER*4 FUNCTION CPL_OBJ_CLOSE () -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' - INCLUDE 'CPL_2_DEF' -C -C -C.Purpose: Close the object file -C.Returns: Status code (.TRUE. for success, .FALSE. otherwise) -C success CPL_SUCCESS also if the file is not open -C error CPL_OBJCLOERR error report left in message buffer -C.Notes: -C-------------------------------------------------------------------------- -C - INTEGER GEN_FORIOS, MSG_SET -C - INTEGER*4 IS -C -C - IF (CPL$OBJLUN.GE.0) THEN - CLOSE (UNIT=CPL$OBJLUN,ERR=999) - CALL WNGLUF(CPL$OBJLUN) - CPL$OBJLUN = -1 - ENDIF -C - CPL_OBJ_CLOSE = CPL_SUCCESS - RETURN -C - 999 IS = GEN_FORIOS (CPL$OBJNAME) - CPL_OBJ_CLOSE = MSG_SET (CPL_OBJCLOERR,0) - RETURN - END -C++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - INTEGER*4 FUNCTION CPL_OBJ_DELETE () -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' - INCLUDE 'CPL_2_DEF' -C -C -C.Purpose: Delete the object file last opened -C.Returns: Status code (.TRUE. for success, .FALSE. otherwise) -C success CPL_SUCCESS -C error CPL_OBJDELERR error report left in message buffer -C.Notes: -C If the file is not open, it will be opened first. -C-------------------------------------------------------------------------- -C - INTEGER*4 GEN_FORIOS, MSG_SET -C - INTEGER*4 IS,RCL -C -C - IF (CPL$OBJLUN.LT.0) THEN - CALL WNGLUN(CPL$OBJLUN) - IF (CPL$OBJLUN.EQ.0) GOTO 999 -#ifdef wn_hp__ - RCL = CPL$OBJLREC -#else - #ifdef wn_li__ - RCL = CPL$OBJLREC - #else - RCL = CPL$OBJLREC/4 - #endif -#endif - OPEN (UNIT=CPL$OBJLUN,FILE=CPL$OBJNAME, -#ifdef wn_li__ - 1 FORM='UNFORMATTED', -#endif - 1 STATUS='UNKNOWN',ERR=992,ACCESS='DIRECT',RECL=RCL) - IF (IAND(IS,1).EQ.0) GOTO 992 - ENDIF -C - CLOSE (UNIT=CPL$OBJLUN,DISPOSE='DELETE',ERR=999) - 992 CALL WNGLUF(CPL$OBJLUN) -C - CPL$OBJLUN = -1 - CPL$OBJNAME = ' ' - CPL$OBJLREC = 0 - CPL$OBJNREC = 0 -C - CPL_OBJ_DELETE = CPL_SUCCESS - RETURN -C - 999 IS = GEN_FORIOS (CPL$OBJNAME) - CPL_OBJ_DELETE = MSG_SET(CPL_OBJDELERR,0) - RETURN - END -C++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - INTEGER*4 FUNCTION CPL_OBJ_INQUIRE (FULLSPEC,LSPEC) -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' - INCLUDE 'CPL_2_DEF' -C - CHARACTER*(*) FULLSPEC ! (o) full file specification - INTEGER*4 LSPEC ! (o) its significant length -C -C.Purpose: Get the full spec of the object file last opened -C.Returns: Status code (.TRUE. for success, .FALSE. otherwise) -C success CPL_SUCCESS -C.Notes: -C-------------------------------------------------------------------------- -C - INTEGER WNCALN -C -C - FULLSPEC = CPL$OBJNAME - LSPEC = WNCALN(FULLSPEC) -C - CPL_OBJ_INQUIRE = CPL_SUCCESS - RETURN - END -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - INTEGER*4 FUNCTION CPL_OBJ_WRITE (BARR,LARR) -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' - INCLUDE 'CPL_2_DEF' -C - BYTE BARR(*) ! (i) byte array to be written - INTEGER*4 LARR ! (i) significant length of byte array -C -C.Purpose: Write next object record(s) -C.Returns: Status code (.TRUE. for success, .FALSE. otherwise) -C success CPL_SUCCESS -C fatal CPL_OBJWRTERR error report left in message buffer -C.Notes: -C------------------------------------------------------------------------- -C - INTEGER MSG_SET, GEN_FORIOS -C - INTEGER*4 IS, NDONE, NWRITE -C -C - IF (CPL$OBJLUN.LT.0) THEN - CALL WNCTXT(F_TP,'Object file is not open') - GOTO 999 - ENDIF -C - NDONE = 0 - DO WHILE (NDONE.LT.LARR) - NWRITE = MIN (CPL$OBJLREC,LARR-NDONE) - CPL$OBJNREC = CPL$OBJNREC+1 - WRITE (CPL$OBJLUN,REC=CPL$OBJNREC,ERR=998) - 1 (BARR(I),I=NDONE+1,NDONE+NWRITE) - NDONE = NDONE+NWRITE - ENDDO -C -C Return -C - CPL_OBJ_WRITE = CPL_SUCCESS - RETURN -C - 998 IS = GEN_FORIOS (CPL$OBJNAME) - 999 CPL_OBJ_WRITE = MSG_SET (CPL_OBJWRTERR,1) - CALL WNCTXT(DWLOG,DWMSG,CPL$OBJNREC) - RETURN - END diff --git a/src/dwarf/cplread.for b/src/dwarf/cplread.for deleted file mode 100644 index 6e2e10cadb6c33fd5ebe4dbe9255a4582f9fa61f..0000000000000000000000000000000000000000 --- a/src/dwarf/cplread.for +++ /dev/null @@ -1,127 +0,0 @@ -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ -C.Ident: CPL_READ -C.Keywords: Compiler Utility, Read Source -C.Author: Friso Olnon (NFRA, Dwingeloo) -C.Language: DWARF-Fortran -C.Environment: VAX or Alliant -C.Comments: -C.Version: 900415 FMO - recreation -C.Version: 920214 GvD - no optional arguments in MSG anymore -C.Version: 930613 HjV - Change size of work-buffer from 2000 to 5000 -C.Version: 940829 HjV - Change size of work-buffer from 5000 to 10000 -C------------------------------------------------------------------------- -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - INTEGER*4 FUNCTION CPL_READ (NKEY,KEY,WKEY,SWWORK,NCOGKEY,COGKEY, - 1 NXTKEY) -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' -C - INTEGER*4 NKEY ! (i) nr of valid source keywords - CHARACTER*(*) KEY(NKEY) ! (i) valid source keywords - INTEGER*4 WKEY(NKEY) ! (i) corresponding work indices - LOGICAL*4 SWWORK ! (i) write into work buffer ? - INTEGER*4 NCOGKEY ! (i) nr of change-of-group keywords - CHARACTER*(*) COGKEY(NCOGKEY) ! (i) change-of-group keywords - CHARACTER*(*) NXTKEY ! (o) change-of-group keyword found -C -C.Purpose: Read a group of source lines into the work buffer -C.Returns: Status code -C success CPL_SUCCESS regular end of group -C info CPL_SRCEOF regular end of file -C error CPL_FLDUNEXP unexpected field -C error CPL_EOFUNEXP unexpected end of file -C false status codes returned by referenced routines -C.Notes: -C------------------------------------------------------------------------- -C - INTEGER*4 CPL_WRK_INIT, CPL_WRK_PUTLNR, CPL_WRK_PUTVAL - INTEGER*4 CPL_SRC_GETKEY, CPL_SRC_GETVAL, CPL_SRC_BACKSP - INTEGER*4 CPL_ERR_PUT - INTEGER STR_MATCH_A, MSG_SET -C - CHARACTER KEYWORD*80, VALUE*10000 - INTEGER*4 LENKEY, LENVAL - INTEGER*4 IS, LINENR, LASTNR, MATCH, FIELDNR - LOGICAL*4 IN_GROUP - SAVE IN_GROUP -C -C -C Initialize the work buffers -C - IN_GROUP = .FALSE. - IF (SWWORK) THEN - IS = CPL_WRK_INIT () - IF (IAND(IS,1).EQ.0) GOTO 999 - ENDIF -C -C Extract the next keyword -C - 100 IS = CPL_SRC_GETKEY (KEYWORD,LENKEY,LINENR) - IF (IS.EQ.CPL_SRCEOF) GOTO 999 ! end file - IF (IAND(IS,1).EQ.0) GOTO 999 ! read error -C -C Check the keyword -C - IF (IN_GROUP) THEN - IS = STR_MATCH_A (KEYWORD(:LENKEY),NCOGKEY,COGKEY,MATCH) - IF (MATCH.GT.0) THEN ! end of group - IS = CPL_SRC_BACKSP () - NXTKEY = COGKEY(MATCH) - GOTO 999 - ENDIF - IS = STR_MATCH_A (KEYWORD(:LENKEY),NKEY,KEY,MATCH) - ELSE - IS = STR_MATCH_A (KEYWORD(:LENKEY),NKEY,KEY,MATCH) - IN_GROUP = MATCH.GT.0 .AND. WKEY(MATCH).EQ.1 - IF (.NOT.IN_GROUP) THEN ! wrong start - IS = MSG_SET (CPL_FLDUNEXP,1) - CALL WNCTXT(DWLOG,DWMSG,LINENR) - GOTO 999 - ENDIF - ENDIF -C - IF (SWWORK) THEN - IF (MATCH.GT.0) THEN - IF (IS.NE.0) THEN - FIELDNR = WKEY(MATCH) - ELSE - IS = CPL_ERR_PUT (CPL_FLDNOTUNI,LINENR) - IF (IAND(IS,1).EQ.0) GOTO 999 - ENDIF - ELSE - IS = CPL_ERR_PUT (CPL_FLDINVAL,LINENR) - IF (IAND(IS,1).EQ.0) GOTO 999 - FIELDNR = 0 - ENDIF - ENDIF -C -C Extract the value -C - IS = CPL_SRC_GETVAL (VALUE,LENVAL,LASTNR) - IF (IS.EQ.CPL_SRCEOF) IS = MSG_SET (CPL_EOFUNEXP,0) ! wrong EOF - IF (IAND(IS,1).EQ.0) GOTO 999 ! or read error -C -C Store the nr of last source line read -C and the linenr and value of the field -C - IF (SWWORK) THEN - IS = CPL_WRK_PUTLNR (0,LASTNR) - IF (IAND(IS,1).NE.0 .AND. FIELDNR.GT.0) THEN - IS = CPL_WRK_PUTLNR (FIELDNR,LINENR) - IF (IAND(IS,1).NE.0 .AND. LENVAL.GT.0) THEN - IS = CPL_WRK_PUTVAL (FIELDNR,VALUE(:LENVAL)) - ENDIF - ENDIF - IF (IAND(IS,1).EQ.0) GOTO 999 - ENDIF -C -C End of entry: goto next entry -C - GOTO 100 -C -C Return -C - 999 CPL_READ = IS - RETURN - END diff --git a/src/dwarf/cplsrc.fsc b/src/dwarf/cplsrc.fsc deleted file mode 100644 index f1cc7d9a8ee0e545a51cae918050da6afbd49cb2..0000000000000000000000000000000000000000 --- a/src/dwarf/cplsrc.fsc +++ /dev/null @@ -1,610 +0,0 @@ -C++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ -C.Ident: CPL_SRC -C.Keywords: Compiler Utility, Source File -C.Author: Friso Olnon (NFRA, Dwingeloo) -C.Language: DWARF-Fortran -C.Environment: VAX or Alliant -C.Comments: -C Common variables used: -C INTEGER*4 CPL$SRCLUN ! (m) lun for open source file -C (= -1 if not open) -C CHARACTER*64 CPL$SRCNAME ! (m) full spec of last opened file -C (= blank initially) -C INTEGER*4 CPL$SRCLNR ! (m) nr of the last source line read -C (= 0 if not open or just opened/rewinded -C CHARACTER*255 CPL$SRCBUF ! (m) last source line read -C (= blank if not open or just opened/rewinded -C INTEGER*4 CPL$SRCLBUF ! (m) signif length of last line read -C (= 0 if not open or just opened/rewinded -C INTEGER*4 CPL$SRCPTR ! (m) next SRCBUF character to read -C (= 0 if not open, -C = 1 if just opened/rewinded/backspaced/read, -C = SRCLBUF+1 for end-of-line) -C -C.Version: 900415 FMO - recreation -C.Version: 900502 FMO - new GEN_LUN module -C.Version: 920214 GvD - no optional arguments in MSG anymore -C.Version: 940119 CMV - use WNGLUN i.s.o GEN_LUN -C-------------------------------------------------------------------------- -C++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - INTEGER*4 FUNCTION CPL_SRC_OPEN (FILESPEC) -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' - INCLUDE 'CPL_2_DEF' -C - CHARACTER*(*) FILESPEC ! (i) file specification -C -C.Purpose: Open the source file -C.Returns: Status code (.TRUE. for success, .FALSE. otherwise) -C success CPL_SUCCESS -C fatal CPL_SRCOPNERR error report left in message buffer -C.Notes: -C-------------------------------------------------------------------------- -C - INTEGER*4 FILNAM_FULL, GEN_FORIOS - INTEGER MSG_SET -C - INTEGER*4 IS, LN -C -C - IF (CPL$SRCLUN.GE.0) GOTO 999 -C - IS = FILNAM_FULL (FILESPEC,CPL$SRCNAME,LN,' ') - IF (IAND(IS,1).NE.0) CALL WNGLUN(CPL$SRCLUN) - IF (CPL$SRCLUN.EQ.0) GOTO 999 -C - OPEN (UNIT=CPL$SRCLUN,FILE=CPL$SRCNAME(:LN),STATUS='OLD', -#ifdef wn_li__ - 1 ERR=992) -#else - 1 READONLY,ERR=992) -#endif - CPL$SRCBUF = ' ' - CPL$SRCLBUF = 0 - CPL$SRCLNR = 0 - CPL$SRCPTR = 1 -C - CPL_SRC_OPEN = CPL_SUCCESS - RETURN -C - 992 IS = GEN_FORIOS (FILESPEC) - CALL WNGLUF(CPL$SRCLUN) - CPL$SRCLUN = -1 -C - 999 CPL_SRC_OPEN = MSG_SET (CPL_SRCOPNERR,0) - RETURN - END -C++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - INTEGER*4 FUNCTION CPL_SRC_CLOSE () -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' - INCLUDE 'CPL_2_DEF' -C -C.Purpose: Close the source file -C.Returns: Status code (.TRUE. for success, .FALSE. otherwise) -C success CPL_SUCCESS also if the file is not open -C error CPL_SRCCLOERR error report left in message buffer -C.Notes: -C-------------------------------------------------------------------------- -C - INTEGER GEN_FORIOS, MSG_SET -C - INTEGER*4 IS -C -C - IF (CPL$SRCLUN.GE.0) THEN - CLOSE (UNIT=CPL$SRCLUN,ERR=992) - CALL WNGLUF(CPL$SRCLUN) - CPL$SRCLUN = -1 - CPL$SRCBUF = ' ' - CPL$SRCLBUF = 0 - CPL$SRCLNR = 0 - CPL$SRCPTR = 0 - ENDIF -C - CPL_SRC_CLOSE = CPL_SUCCESS - RETURN -C - 992 IS = GEN_FORIOS (CPL$SRCNAME) - 999 CPL_SRC_CLOSE = MSG_SET (CPL_SRCCLOERR,0) - RETURN - END -C++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - INTEGER*4 FUNCTION CPL_SRC_REWIND () -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' - INCLUDE 'CPL_2_DEF' -C -C.Purpose: Rewind the source file -C.Returns: Status code (.TRUE. for success, .FALSE. otherwise) -C success CPL_SUCCESS -C fatal CPL_SRCREWERR error report left in message buffer -C.Notes: -C-------------------------------------------------------------------------- -C -C - INTEGER GEN_FORIOS, MSG_SET -C - INTEGER*4 IS -C -C - REWIND (UNIT=CPL$SRCLUN,ERR=999) - CPL$SRCBUF = ' ' - CPL$SRCLBUF = 0 - CPL$SRCLNR = 0 - CPL$SRCPTR = 1 -C - CPL_SRC_REWIND = CPL_SUCCESS - RETURN -C - 999 IS = GEN_FORIOS (CPL$SRCNAME) - CPL_SRC_REWIND = MSG_SET (CPL_SRCREWERR,0) - RETURN - END -C++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - INTEGER*4 FUNCTION CPL_SRC_BACKSP () -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' - INCLUDE 'CPL_2_DEF' -C -C.Purpose: Backspace the source file -C.Returns: Status code (.TRUE. for success, .FALSE. otherwise) -C success CPL_SUCCESS -C.Notes: -C-------------------------------------------------------------------------- -C -C - CPL$SRCPTR = 1 -C - CPL_SRC_BACKSP = CPL_SUCCESS - RETURN - END -C++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - INTEGER*4 FUNCTION CPL_SRC_INQUIRE (FULLSPEC,LSPEC) -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' - INCLUDE 'CPL_2_DEF' -C - CHARACTER*(*) FULLSPEC ! (o) full file specification - INTEGER*4 LSPEC ! (o) its significant length -C -C.Purpose: Get the full specification of the source file last opened -C.Returns: Status code (.TRUE. for success, .FALSE. otherwise) -C success CPL_SUCCESS -C.Notes: -C-------------------------------------------------------------------------- -C - INTEGER WNCALN -C -C - FULLSPEC = CPL$SRCNAME - LSPEC = WNCALN (FULLSPEC) -C - CPL_SRC_INQUIRE = CPL_SUCCESS - RETURN - END -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - INTEGER*4 FUNCTION CPL_SRC_READ () -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' - INCLUDE 'CPL_2_DEF' -C -C.Purpose: Read the next source line -C.Returns: Status code (.TRUE. for success, .FALSE. otherwise) -C success CPL_SUCCESS -C info CPL_SRCEOF end of file reached -C fatal CPL_SRCRDERR error report left in message buffer -C.Notes: -C The source buffer is refilled and the status block is updated -C accordingly. -C------------------------------------------------------------------------- -C - INTEGER*4 MSG_SET, GEN_FORIOS, WNCAL0 -C - INTEGER*4 IS -C -C -C READ (CPL$SRCLUN,'(Q,A)',ERR=999,END=900) CPL$SRCLBUF,CPL$SRCBUF - CPL$SRCBUF=' ' - READ (CPL$SRCLUN,'(A)',ERR=999,END=900) CPL$SRCBUF - CPL$SRCLNR = CPL$SRCLNR+1 - CPL$SRCLBUF = WNCAL0 (CPL$SRCBUF) - CPL$SRCPTR = 1 -C - CPL_SRC_READ = CPL_SUCCESS - RETURN -C - 900 CPL_SRC_READ = CPL_SRCEOF - RETURN -C - 999 IS = GEN_FORIOS (CPL$SRCNAME) - CPL_SRC_READ = MSG_SET (CPL_SRCRDERR,0) - RETURN - END -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - INTEGER*4 FUNCTION CPL_SRC_GETLINE (SRCLINE,LLINE,LINENR) -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' - INCLUDE 'CPL_2_DEF' -C - CHARACTER*(*) SRCLINE ! (o) source line - INTEGER*4 LLINE ! (o) its significant length - INTEGER*4 LINENR ! (o) nr of the line -C -C.Purpose: Get a source line -C.Returns: Status code (.TRUE. for success, .FALSE. otherwise) -C success CPL_SUCCESS -C info CPL_SRCEOF end of file (issued by CPL_SRC_READ) -C false status code returned by CPL_SRC_READ -C.Notes: -C If the buffer is exhausted, the next source line will be read. -C The next part of the buffer then is copied to SRCLINE. -C Trailing blanks and tabs are ignored. SRCLINE will be blank-padded. -C SRCLINE = ' ' and LLINE = 0 for Fortran I/O error or end-of-file. -C------------------------------------------------------------------------- -C - INTEGER*4 CPL_SRC_READ - INTEGER*4 STR_COPY, STR_SIGLEN -C - INTEGER*4 IS -C -C -C Initialize the output arguments -C - SRCLINE = ' ' - LLINE = 0 - LINENR = CPL$SRCLNR -C -C If the buffer is empty or exhausted, -C fill it with the next source line -C - IF (LINENR.EQ.0 .OR. CPL$SRCPTR.GT.CPL$SRCLBUF) THEN - IS = CPL_SRC_READ () - IF (IS.NE.CPL_SUCCESS) GOTO 999 - LINENR = CPL$SRCLNR - ENDIF -C -C Copy the next part of the buffer -C to SRCLINE and update the pointer -C - IF (CPL$SRCPTR.LE.CPL$SRCLBUF) THEN - IS = STR_COPY (CPL$SRCBUF(CPL$SRCPTR:CPL$SRCLBUF),SRCLINE,LLINE) - CPL$SRCPTR = CPL$SRCPTR+LLINE - LLINE = STR_SIGLEN (SRCLINE) - ENDIF -C - CPL_SRC_GETLINE = CPL_SUCCESS - RETURN -C - 999 CPL_SRC_GETLINE = IS - RETURN - END -C++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - INTEGER*4 FUNCTION CPL_SRC_GETKEY (KEYWORD,LKEY,LINENR) -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' - INCLUDE 'CPL_2_DEF' -C - CHARACTER*(*) KEYWORD ! (o) keyword (uppercase) - INTEGER*4 LKEY ! (o) sign. length of keyword - INTEGER*4 LINENR ! (o) nr of current source line -C -C.Purpose: Get the next keyword from the source file -C.Returns: Status code (.TRUE. for success, .FALSE. otherwise) -C success CPL_SUCCESS -C info CPL_SRCEOF end of file (issued by CPL_SRC_READ) -C false status code returned by CPL_SRC_READ -C.Notes: -C The keyword must be the first token in the current or next line. -C Whites (blanks and tabs) and comments are skipped. The search continues -C across line boundaries and ends at the first significant character. -C -C The keyword ends before the first white, '!' or '=', or at the line -C end. Lowercase characters are converted to uppercase. -C -C A blank keyword (LKEY = 0) is assumed to be found when the first -C significant character found is an '='. -C------------------------------------------------------------------------- -C - CHARACTER BLANK*1, TAB*1, WHITE*2, EQUAL*1, EXCLAM*1 - PARAMETER (BLANK = ' ') - PARAMETER (EQUAL = '=') - PARAMETER (EXCLAM = '!') -C - INTEGER*4 CPL_SRC_READ - INTEGER*4 STR_COPY_U, STR_SKIP_W, STR_UPCASE -C - INTEGER*4 IS - LOGICAL*4 FOUND -C -C -C Initialize the output arguments -C - TAB = CHAR(9) - WHITE = BLANK//TAB -C - KEYWORD = BLANK - LKEY = 0 - LINENR = CPL$SRCLNR -C -C Start with a fresh source line -C - IF (CPL$SRCPTR.NE.1 .OR. LINENR.EQ.0) THEN - IS = CPL_SRC_READ () - IF (IS.NE.CPL_SUCCESS) GOTO 999 - LINENR = CPL$SRCLNR - ENDIF -C -C Skip to the start of the keyword -C - skip white and comment lines -C - skip leading whites -C - FOUND = .FALSE. - DO WHILE (.NOT.FOUND) - IF (CPL$SRCLBUF.GT.0) THEN - IS = STR_SKIP_W (WHITE, - 1 CPL$SRCBUF(:CPL$SRCLBUF),CPL$SRCPTR) - FOUND = CPL$SRCBUF(CPL$SRCPTR:CPL$SRCPTR).NE.EXCLAM - ENDIF - IF (.NOT.FOUND) THEN - IS = CPL_SRC_READ () - IF (IS.NE.CPL_SUCCESS) GOTO 999 - LINENR = CPL$SRCLNR - ENDIF - ENDDO -C -C Extract the keyword -C - IS = STR_COPY_U (WHITE//EQUAL//EXCLAM, - 1 CPL$SRCBUF(:CPL$SRCLBUF),CPL$SRCPTR,KEYWORD,LKEY) - IF (LKEY.GT.0) IS = STR_UPCASE (KEYWORD(:LKEY)) -C - CPL_SRC_GETKEY = CPL_SUCCESS - RETURN -C - 999 CPL_SRC_GETKEY = IS - RETURN - END -C++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - INTEGER*4 FUNCTION CPL_SRC_GETVAL (VALUE,LVAL,LINENR) -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' - INCLUDE 'CPL_2_DEF' -C - CHARACTER*(*) VALUE ! (o) value - INTEGER*4 LVAL ! (o) sign. length of value - INTEGER*4 LINENR ! (o) nr of current source line -C -C.Purpose: Get the next value from the source file -C.Returns: Status code (.TRUE. for success, .FALSE. otherwise) -C success CPL_SUCCESS -C info CPL_SRCEOF end of file (issued by CPL_SRC_READ) -C false status code returned by CPL_SRC_READ -C.Notes: -C The search starts at the current position in the current source -C line (i.e. after the keyword). Whites, continuation marks and -C comments are skipped. The search continues across line boundaries, -C independent of the use of continuation marks, and ends at the first -C significant character. -C -C QUOTED VALUE: -C -C The value ends before the first quote that is the last significant -C character on a line (i.e. only followed by whites or comment). -C -C The value continues across line boundaries. If a line does not -C end with a continuation mark a carriage-return/line-feed will -C be inserted, otherwise the value just continues on the next line. -C -C The opening and closing quotes are not part of the value: they -C only indicate to the compiler that the value should be taken -C literally. Inside the value, quotes can be used freely except that -C a quote followed by (whites and) an exclamation mark will be -C interpreted as an end-of-value. -C -C UNQUOTED VALUE: -C -C The value ends with the last significant character on the line, -C unless that character is a continuation mark in which case the -C value continues on the next line. -C -C Tabs are converted to blanks, multiple blanks to a single blank, -C and lowercase to uppercase characters. -C------------------------------------------------------------------------- -C - CHARACTER*(*) BLANK, EQUAL, EXCLAM, HYPHEN, QUOTE - CHARACTER TAB,WHITE,CRLF*2 - PARAMETER (BLANK = ' ') - PARAMETER (EQUAL = '=') - PARAMETER (EXCLAM = '!') - PARAMETER (HYPHEN = '-') - PARAMETER (QUOTE = '"') -C - INTEGER*4 CPL_SRC_READ - INTEGER*4 STR_SKIP_W, STR_COPY, STR_COPY_U, STR_UPCASE -C - INTEGER*4 IS, TMP - LOGICAL*4 END_VAL, END_LINE -C - TAB = CHAR(9) - WHITE = BLANK//TAB - CRLF = CHAR(13)//CHAR(10) -C -C Initialize the output arguments -C - VALUE = ' ' - LVAL = 0 - LINENR = CPL$SRCLNR -C -C Skip to the start of the value -C - skip whites and comment -C - if end-of-line: return null value -C - IS = STR_SKIP_W (WHITE,CPL$SRCBUF(:CPL$SRCLBUF),CPL$SRCPTR) - END_LINE = CPL$SRCPTR.GT.CPL$SRCLBUF - 1 .OR. CPL$SRCBUF(CPL$SRCPTR:CPL$SRCPTR).EQ.EXCLAM - IF (END_LINE) GOTO 900 -C -C - skip '=', whites and comment -C - IF (CPL$SRCBUF(CPL$SRCPTR:CPL$SRCPTR).EQ.EQUAL) THEN - CPL$SRCPTR = CPL$SRCPTR+1 - IS = STR_SKIP_W (WHITE,CPL$SRCBUF(:CPL$SRCLBUF),CPL$SRCPTR) - END_LINE = CPL$SRCPTR.GT.CPL$SRCLBUF - 1 .OR. CPL$SRCBUF(CPL$SRCPTR:CPL$SRCPTR).EQ.EXCLAM - ENDIF -C -C - skip continuation mark and comment -C - IF (.NOT.END_LINE - 1 .AND. CPL$SRCBUF(CPL$SRCPTR:CPL$SRCPTR).EQ.HYPHEN) THEN - TMP = CPL$SRCPTR+1 - IS = STR_SKIP_W (WHITE,CPL$SRCBUF(:CPL$SRCLBUF),TMP) - END_LINE = TMP.GT.CPL$SRCLBUF .OR. CPL$SRCBUF(TMP:TMP).EQ.EXCLAM - ENDIF -C -C - if end-of-line: continue with next -C line, skip whites, continuation -C marks, comments and end-of-lines -C - DO WHILE (END_LINE) - IS = CPL_SRC_READ () - IF (IS.NE.CPL_SUCCESS) GOTO 999 - LINENR = CPL$SRCLNR - IF (CPL$SRCLBUF.GT.0) THEN - IS = STR_SKIP_W (WHITE, - 1 CPL$SRCBUF(:CPL$SRCLBUF),CPL$SRCPTR) - END_LINE = CPL$SRCBUF(CPL$SRCPTR:CPL$SRCPTR).EQ.EXCLAM - ENDIF - IF (.NOT.END_LINE - 1 .AND. CPL$SRCBUF(CPL$SRCPTR:CPL$SRCPTR).EQ.HYPHEN) THEN - TMP = CPL$SRCPTR+1 - IS = STR_SKIP_W (WHITE,CPL$SRCBUF(:CPL$SRCLBUF),TMP) - END_LINE = TMP.GT.CPL$SRCLBUF - 1 .OR. CPL$SRCBUF(TMP:TMP).EQ.EXCLAM - ENDIF - ENDDO -C -C Extract a quoted value -C - skip starting quote -C - copy across line boundaries -C until closing quote -C - skip continuation marks -C - insert a CRLF for every end-of-line -C not preceded by a continuation mark -C - END_VAL = .FALSE. - IF (CPL$SRCBUF(CPL$SRCPTR:CPL$SRCPTR).EQ.QUOTE) THEN - CPL$SRCPTR = CPL$SRCPTR+1 - DO WHILE (.NOT.END_VAL) - IS = STR_COPY_U (QUOTE//HYPHEN, - 1 CPL$SRCBUF(:CPL$SRCLBUF),CPL$SRCPTR,VALUE,LVAL) - END_LINE = CPL$SRCPTR.GT.CPL$SRCLBUF - IF (END_LINE) THEN - IS = STR_COPY (CRLF,VALUE,LVAL) - ELSE IF (CPL$SRCBUF(CPL$SRCPTR:CPL$SRCPTR).EQ.QUOTE) THEN - TMP = CPL$SRCPTR+1 - IS = STR_SKIP_W (WHITE,CPL$SRCBUF(:CPL$SRCLBUF),TMP) - END_VAL = TMP.GT.CPL$SRCLBUF - 1 .OR. CPL$SRCBUF(TMP:TMP).EQ.EXCLAM - IF (.NOT.END_VAL) IS = STR_COPY (QUOTE,VALUE,LVAL) - CPL$SRCPTR = CPL$SRCPTR+1 - ELSE ! hyphen - TMP = CPL$SRCPTR+1 - IS = STR_SKIP_W (WHITE,CPL$SRCBUF(:CPL$SRCLBUF),TMP) - END_LINE = TMP.GT.CPL$SRCLBUF - 1 .OR. CPL$SRCBUF(TMP:TMP).EQ.EXCLAM - IF (.NOT.END_LINE) IS = STR_COPY (HYPHEN,VALUE,LVAL) - CPL$SRCPTR = CPL$SRCPTR+1 - ENDIF - DO WHILE (END_LINE) - IS = CPL_SRC_READ () - IF (IS.NE.CPL_SUCCESS) GOTO 999 - LINENR = CPL$SRCLNR - END_LINE = CPL$SRCLBUF.EQ.0 - IF (END_LINE) IS = STR_COPY (CRLF,VALUE,LVAL) - ENDDO - ENDDO -C -C Extract an unquoted value -C - copy until the first end-of-line or -C comment not preceded by a -C continuation mark -C - skip continuation marks -C - ignore white lines -C - convert tabs to blanks, multiple -C blanks to single blanks, and -C lowercase to uppercase characters -C - ELSE - DO WHILE (.NOT.END_VAL) - IS = STR_COPY_U (WHITE//EXCLAM//HYPHEN, - 1 CPL$SRCBUF(:CPL$SRCLBUF),CPL$SRCPTR,VALUE,LVAL) - END_LINE = CPL$SRCPTR.GT.CPL$SRCLBUF - 1 .OR. CPL$SRCBUF(CPL$SRCPTR:CPL$SRCPTR).EQ.EXCLAM - IF (END_LINE) THEN - END_VAL = .TRUE. - ELSE IF (CPL$SRCBUF(CPL$SRCPTR:CPL$SRCPTR).EQ.HYPHEN) THEN - TMP = CPL$SRCPTR+1 - IS = STR_SKIP_W (WHITE,CPL$SRCBUF(:CPL$SRCLBUF),TMP) - END_LINE = TMP.GT.CPL$SRCLBUF - 1 .OR. CPL$SRCBUF(TMP:TMP).EQ.EXCLAM - IF (.NOT.END_LINE) IS = STR_COPY (HYPHEN,VALUE,LVAL) - CPL$SRCPTR = CPL$SRCPTR+1 - ELSE ! white - IF (VALUE(LVAL:LVAL).NE.BLANK) THEN - IS = STR_COPY (BLANK,VALUE,LVAL) - ENDIF - IS = STR_SKIP_W (WHITE, - 1 CPL$SRCBUF(:CPL$SRCLBUF),CPL$SRCPTR) - ENDIF - DO WHILE (.NOT.END_VAL .AND. END_LINE) - IS = CPL_SRC_READ () - IF (IS.NE.CPL_SUCCESS) GOTO 999 - LINENR = CPL$SRCLNR - END_LINE = CPL$SRCLBUF.EQ.0 - ENDDO - ENDDO - IF (VALUE(LVAL:LVAL).EQ.BLANK) LVAL = LVAL-1 - IF (LVAL.GT.0) IS = STR_UPCASE (VALUE(:LVAL)) - ENDIF -C - 900 CPL_SRC_GETVAL = CPL_SUCCESS - RETURN -C - 999 CPL_SRC_GETVAL = IS - RETURN - END - - - - - - - - - - - - - - - - - - - - - - - - diff --git a/src/dwarf/cplvallist.for b/src/dwarf/cplvallist.for deleted file mode 100644 index e0663531e8b95f2fd7290a235d5e01c92b9f00a4..0000000000000000000000000000000000000000 --- a/src/dwarf/cplvallist.for +++ /dev/null @@ -1,149 +0,0 @@ -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ -C.Ident: CPL_VALLIST -C.Keywords: Compiler Utility, Value List -C.Author: Friso Olnon (NFRA, Dwingeloo) -C.Language: DWARF-Fortran -C.Environment: VAX or Alliant -C.Comments: -C.Version: 900415 FMO - recreation -C.Version: 920214 GvD - no optional arguments in MSG anymore -C 941212 JPH - COMMA --> DELIM -C------------------------------------------------------------------------- -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - INTEGER*4 FUNCTION CPL_VALLIST (LIST,TYPE,LVAL,ARRAY,LARR,NRVAL) -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' -C - CHARACTER*(*) LIST ! (i) value list to be decoded - CHARACTER*(*) TYPE ! (i) data-type code - INTEGER*4 LVAL ! (i) length of a decoded single value - BYTE ARRAY(*) ! (o) array with decoded values - INTEGER*4 LARR ! (i) max length of array (bytes) - INTEGER*4 NRVAL ! (o) nr of values in the list -C -C.Purpose: Convert a comma-separated list of values to a value array -C.Returns: Status code (.TRUE. for success, .FALSE. otherwise) -C success CPL_SUCCESS -C error CPL_VALLISINV Error report left in message buffer -C.Notes: -C - Leading and trailing blanks and tabs in list elements are ignored. -C - Valid data-type codes are B (byte), I (integer*2), J (integer*4), -C R (real*4), D (real*8), L (logical) and C (character). -C - LVAL gives the maximum length for C values, the length for L values, -C and is ignored for the other types (B,I,J,R,D). -C - Valid L values are 'FALSE', 'TRUE', 'NO' ,'YES' or abbreviations. -C - Empty elements (e.g. ',,') are converted to undef_ values, but empty -C L values are converted to .FALSE. -C - In case of errors a zero-filled array will be returned (NRVAL=0). -C------------------------------------------------------------------------- -C - CHARACTER*(*) BLANK, TAB, COMMA, LOGLIST, TYPLIST, DELIM - PARAMETER (BLANK = ' ') - PARAMETER (TAB = ' ') - PARAMETER (COMMA = ',') - PARAMETER (LOGLIST = 'TRUE,FALSE,YES,NO') - PARAMETER (TYPLIST = 'BIJRDLC') - PARAMETER (DELIM = ', ;|[]:' ) -C - INTEGER*4 STR_SIGLEN, STR_MATCH_L, STR_COPY_U, STR_SKIP_W - INTEGER*4 STR_READ_B, STR_READ_I, STR_READ_J - INTEGER*4 STR_READ_R, STR_READ_D - INTEGER*4 CLEAR_BLB, MOVE_BLB - INTEGER*4 MSG_SET -C - CHARACTER*80 VALUE - INTEGER*4 LL, LV - CHARACTER*80 C - BYTE B(80) - INTEGER*2 II - REAL*4 R - REAL*8 D - LOGICAL*4 L - EQUIVALENCE (C,B,II,J,R,D,L) - INTEGER*4 IS, PTR, MATCH, ARRPTR -C -C -C Initialize -C - IF (INDEX(TYPLIST,TYPE).EQ.0) GOTO 991 - NRVAL = 0 - IS = CLEAR_BLB (ARRAY,LARR) - ARRPTR = 0 - LL = STR_SIGLEN (LIST) -C -C Isolate next value -C - LL+1 to take care of trailing comma -C - PTR = 1 - DO WHILE (PTR.LE.LL+1) - LV = 0 - IS = STR_SKIP_W (BLANK//TAB,LIST(:LL),PTR) - IS = STR_COPY_U (DELIM,LIST,PTR,VALUE,LV) -!! IS = STR_COPY_U (COMMA,LIST,PTR,VALUE,LV) - IF (LV.GT.0) LV = STR_SIGLEN (VALUE(:LV)) -C -C Decode/check the value -C - IF (LV.GT.0) THEN - IF (TYPE.EQ.'B') THEN - IS = STR_READ_B (VALUE(:LV),B(1)) - ELSE IF (TYPE.EQ.'I') THEN - IS = STR_READ_I (VALUE(:LV),II) - ELSE IF (TYPE.EQ.'J') THEN - IS = STR_READ_J (VALUE(:LV),J) - ELSE IF (TYPE.EQ.'R') THEN - IS = STR_READ_R (VALUE(:LV),R) - ELSE IF (TYPE.EQ.'D') THEN - IS = STR_READ_D (VALUE(:LV),D) - ELSE IF (TYPE.EQ.'L') THEN - IS = STR_MATCH_L (VALUE(:LV),LOGLIST,MATCH) - IF (IAND(IS,1).NE.0) - 1 L = MATCH.EQ.1 .OR. MATCH.EQ.3 - ELSE - IS = LV.LE.LVAL - IF (IAND(IS,1).NE.0) C = VALUE(:LV) - ENDIF - IF (IAND(IS,1).EQ.0) GOTO 999 -C -C Undefined value -C - ELSE - IF (TYPE.EQ.'B') THEN - B(1) = UNDEF_B - ELSE IF (TYPE.EQ.'I') THEN - II = UNDEF_I - ELSE IF (TYPE.EQ.'J') THEN - J = UNDEF_J - ELSE IF (TYPE.EQ.'R') THEN - R = UNDEF_R - ELSE IF (TYPE.EQ.'D') THEN - D = UNDEF_D - ELSE IF (TYPE.EQ.'L') THEN - L = .FALSE. - ELSE - C = UNDEF_C - ENDIF - ENDIF - IF (ARRPTR+LVAL.GT.LARR) GOTO 992 - IS = MOVE_BLB (B,ARRAY(ARRPTR+1),LVAL) - ARRPTR = ARRPTR+LVAL - NRVAL = NRVAL+1 - PTR = PTR+1 - ENDDO -C -C Return -C - CPL_VALLIST = CPL_SUCCESS - RETURN -C - 991 IS = MSG_SET (CPL_DATTYPINV,1) - CALL WNCTXT(DWLOG,DWMSG,TYPE) - GOTO 999 - 992 IS = MSG_SET (CPL_ARROVRFLO,0) - 999 NRVAL = 0 - IS = CLEAR_BLB (ARRAY,LARR) - CPL_VALLIST = MSG_SET (CPL_VALLISINV,1) - CALL WNCTXT(DWLOG,DWMSG,LIST) - RETURN - END diff --git a/src/dwarf/cplwrk.for b/src/dwarf/cplwrk.for deleted file mode 100644 index 827048fabab94c753b192442f43b994556c0f578..0000000000000000000000000000000000000000 --- a/src/dwarf/cplwrk.for +++ /dev/null @@ -1,179 +0,0 @@ -C++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ -C.Ident: CPL_WRK -C.Keywords: Compiler Utility, Work Buffer -C.Author: Friso Olnon (NFRA, Dwingeloo) -C.Language: DWARF-Fortran -C.Environment: VAX or Alliant -C.Comments: -C Parameters: -C INTEGER*4 CPL__WRKLMAX ! size of value buffer (bytes) -C INTEGER*4 CPL__WRKNMAX ! max nr of fields -C Common variables used: -C CHARACTER*(*) CPL$WRKBUF ! (m) buffer with field values -C INTEGER*4 CPL$WRKLBUF ! (m) signif length of buffer -C INTEGER*4 CPL$WRKSTART(i) ! (m) start of value i in buffer -C INTEGER*4 CPL$WRKEND(i) ! (m) end of value i in buffer -C INTEGER*4 CPL$WRKLNR(i) ! (m) source-line nr of field i -C INTEGER*4 CPL$WRKLNR(0) ! (m) nr of last source-line read -C -C.Version: 900415 FMO - recreation -C.Version: 920214 GvD - no optional arguments in MSG anymore -C-------------------------------------------------------------------------- -C++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - INTEGER*4 FUNCTION CPL_WRK_INIT () -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' - INCLUDE 'CPL_2_DEF' -C -C.Purpose: Initialize the work buffer -C.Returns: Status code (.TRUE. for success, .FALSE. otherwise) -C success CPL_SUCCESS -C.Notes: -C-------------------------------------------------------------------------- -C -C -C -C - CPL$WRKLBUF = 0 - DO I = 1,CPL__WRKNMAX - CPL$WRKSTART(I) = UNDEF_J - CPL$WRKEND(I) = UNDEF_J - CPL$WRKLNR(I) = UNDEF_J - ENDDO -C - CPL_WRK_INIT = CPL_SUCCESS - RETURN - END -C++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - INTEGER*4 FUNCTION CPL_WRK_PUTLNR (FIELDNR,LINENR) -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' - INCLUDE 'CPL_2_DEF' -C - INTEGER*4 FIELDNR ! (i) field nr - INTEGER*4 LINENR ! (i) source-line nr -C -C.Purpose: Store the source-line number for a field in the work buffer -C.Returns: Status code (.TRUE. for success, .FALSE. otherwise) -C success CPL_SUCCESS -C fatal CPL_FLDNRINV Field nr out of range -C.Notes: -C CPL$WRKLNR(0) is used for the nr of the last source-line of a group -C-------------------------------------------------------------------------- -C - INTEGER MSG_SET -C -C - IF (FIELDNR.LT.0 .OR. FIELDNR.GT.CPL__WRKNMAX) GOTO 999 - CPL$WRKLNR(FIELDNR) = LINENR -C - CPL_WRK_PUTLNR = CPL_SUCCESS - RETURN -C - 999 CPL_WRK_PUTLNR = MSG_SET (CPL_FLDNRINV,1) - CALL WNCTXT(DWLOG,DWMSG,FIELDNR) - RETURN - END -C++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - INTEGER*4 FUNCTION CPL_WRK_PUTVAL (FIELDNR,VALUE) -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' - INCLUDE 'CPL_2_DEF' -C - INTEGER*4 FIELDNR ! (i) field nr - CHARACTER*(*) VALUE ! (i) value -C -C.Purpose: Put the field value (character format) in the work buffer -C.Returns: Status code (.TRUE. for success, .FALSE. otherwise) -C success CPL_SUCCESS -C fatal CPL_FLDNRINV Field nr out of range -C fatal CPL_WRKFUL Buffer overflow -C.Notes: -C Trailing blanks and tabs in the value are ignored. If the value is -C empty, nothing will be stored and the success status is returned. -C-------------------------------------------------------------------------- -C - INTEGER*4 STR_SIGLEN, STR_COPY, MSG_SET -C - INTEGER*4 IS, LVAL -C -C - IF (FIELDNR.LE.0 .OR. FIELDNR.GT.CPL__WRKNMAX) GOTO 999 -C - LVAL = STR_SIGLEN (VALUE) - IF (LVAL.GT.0) THEN - CPL$WRKSTART(FIELDNR) = CPL$WRKLBUF+1 - IS = STR_COPY (VALUE(:LVAL),CPL$WRKBUF,CPL$WRKLBUF) - CPL$WRKEND(FIELDNR) = CPL$WRKLBUF - IF (IS.LT.0) GOTO 998 - ENDIF -C - CPL_WRK_PUTVAL = CPL_SUCCESS - RETURN -C - 998 CPL_WRK_PUTVAL = MSG_SET (CPL_WRKFUL,0) - RETURN -C - 999 CPL_WRK_PUTVAL = MSG_SET (CPL_FLDNRINV,1) - CALL WNCTXT(DWLOG,DWMSG,FIELDNR) - RETURN - END -C++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - INTEGER*4 FUNCTION CPL_WRK_GET (FIELDNR,LINENR,VALUE,LVAL) -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' - INCLUDE 'CPL_2_DEF' -C - INTEGER*4 FIELDNR ! (i) field nr - INTEGER*4 LINENR ! (o) source-line nr of the field - CHARACTER*(*) VALUE ! (o) value of the field - INTEGER*4 LVAL ! (o) its significant length -C -C.Purpose: Get line nr and field value (char format) from the work buffer -C.Returns: Status code (.TRUE. for success, .FALSE. otherwise) -C success CPL_SUCCESS -C fatal CPL_FLDNRINV Field nr out of range -C error CPL_STROVRFLO Output string too short -C.Notes: -C - If no line nr was stored for the field, the nr of the last source- -C line read will be returned. -C - If no field value was stored, LVAL = 0 will be returned. -C - If VALUE is longer than the value stored, it will be padded with -C blanks; if it is shorter, the value will be truncated. -C-------------------------------------------------------------------------- -C - INTEGER*4 STR_COPY, MSG_SET -C - INTEGER*4 IS, WST, WED -C -C - LINENR = 0 - VALUE = ' ' - LVAL = 0 - IF (FIELDNR.LT.0 .OR. FIELDNR.GT.CPL__WRKNMAX) GOTO 999 -C - LINENR = CPL$WRKLNR(FIELDNR) - IF (FIELDNR.GT.0) THEN - IF (LINENR.EQ.UNDEF_J) LINENR = CPL$WRKLNR(0) - WST = CPL$WRKSTART(FIELDNR) - IF (WST.NE.UNDEF_J) THEN - WED = CPL$WRKEND(FIELDNR) - IS = STR_COPY (CPL$WRKBUF(WST:WED),VALUE,LVAL) - IF (IS.LT.0) GOTO 998 - ENDIF - ENDIF -C - CPL_WRK_GET = CPL_SUCCESS - RETURN -C - 998 CPL_WRK_GET = MSG_SET (CPL_STROVRFLO,0) - RETURN -C - 999 CPL_WRK_GET = MSG_SET (CPL_FLDNRINV,1) - CALL WNCTXT(DWLOG,DWMSG,FIELDNR) - RETURN - END diff --git a/src/dwarf/dwarf.pin b/src/dwarf/dwarf.pin deleted file mode 100644 index f81ed407f854c998627b96e76398ce2b5a7fcbe9..0000000000000000000000000000000000000000 --- a/src/dwarf/dwarf.pin +++ /dev/null @@ -1,239 +0,0 @@ -!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ -!.Ident: PIN_DWARF -!.Keywords: DWARF control parameters, Definition -!.Author: Ger van Diepen (NFRA, Dwingeloo) -!.Language: DWARF-PIN -!.Environment: VAX -!.Comments: -!.Version: 840917 JPH - Retyped from GVD's listing - Reformulated HELP -! text to conform to Manual terminology -!.Version: 850319 KK - New PPD concept -!.Version: 880717 FMO - Replaced "" by " (Note: don't end a line which -! is part of a quoted value, with a quote; it will be -! interpreted as the end of the value !!!) -! - Removed some typo's -!.Version: 891023 FMO - Added NETWORK to IBMODE options -!.Version: 911128 GvD - Added program default for IDENT and IBMODE -!. 921222 WNB - Set BELL OFF default -!------------------------------------------------------------------------- -! -KEYWORD=STREAM - DATA_TYPE=C - LENGTH=11 - MAX_NSETS=1 - IO=I - CHECKS=ANUMERIC - ATTRIBUTES=IMMEDIATE - SEARCH=LOCAL,PROGRAM - DEFAULTS=1 - PROMPT="Stream name" - HELP= -" Defines the "current stream name" to be used as default for the -stream component in program and DWARF symbol names" -! -KEYWORD=CURNODE - DATA_TYPE=C - LENGTH=80 - MAX_NSETS=1 - IO=I - CHECKS=NODE - ATTRIBUTES=IMMEDIATE,NULL_NODE - SEARCH=LOCAL,PROGRAM - DEFAULTS=0 - PROMPT="Current node name" - HELP= -" This is the node name with respect to which relative node names, i.e. -node specifications starting with "." or "-", will be expanded" -! -KEYWORD=ASK - DATA_TYPE=C - LENGTH=4 - MAX_NSETS=1 - IO=I - CHECKS=ABBREV_OPTIONS - ATTRIBUTES=IMMEDIATE - SEARCH=LOCAL,PROGRAM - OPTIONS=YES,NO - DEFAULTS=NO - HELP= -" ASK=YES directs DWARF programs to always prompt for parameters, even if -an external default has been defined (through SPECIFY or otherwise). - This setting can be overridden by use of the /NOASK qualifier with the -EXECUTE command or with run-time parameter input." -! -KEYWORD=SAVELAST - DATA_TYPE=C - LENGTH=4 - MAX_NSETS=1 - IO=I - CHECKS=ABBREV_OPTIONS - ATTRIBUTES=IMMEDIATE - SEARCH=LOCAL,PROGRAM - OPTIONS=YES,NO - DEFAULTS=NO - HELP= -" SAVELAST=YES directs DWARF programs to save the last value typed in -during program execution as an external default for later program runs. - The setting of this paramater can be overriden by use of the -/[NO]SAVELAST qualifier with the EXECUTE command or with parameter input." -! -KEYWORD=USERLEVEL - DATA_TYPE=C - LENGTH=8 - MAX_NSETS=1 - IO=I - CHECKS=ABBREV_OPTIONS - ATTRIBUTES=IMMEDIATE - SEARCH=LOCAL,PROGRAM - OPTIONS=BEGINNER,AVERAGE,EXPERT - DEFAULTS=BEGINNER - PROMPT="How do you rate yourself as a DWARF user" - HELP= -" Defines the amount of information to be given with parameter prompts: - EXPERT: Keyword name and default only - AVERAGE: Same plus available options where applicable - BEGINNER: Some descriptive information in addition - While being prompted, you may temporarily descend to a "lower" level -by typing a question mark; by adding /KEEP to the "?" you may retain this lower -level until program exit." -! -KEYWORD=BELL - DATA_TYPE=C - LENGTH=4 - MAX_NSETS=1 - IO=I - CHECKS=ABBREV_OPTIONS - ATTRIBUTES=IMMEDIATE - SEARCH=LOCAL,PROGRAM - OPTIONS=ON,OFF - DEFAULTS=OFF - PROMPT="Terminal bell with prompts and error messages" - HELP= -" Controls the sounding of the terminal bell with error messages and -with prompts for parameters" -! -KEYWORD=MESSAGEDEVICE - DATA_TYPE=C - LENGTH=8 - NVALUES=2 - MAX_NSETS=1 - IO=I - CHECKS=ABBREV_OPTIONS - ATTRIBUTES=IMMEDIATE - SEARCH=LOCAL,PROGRAM - OPTIONS=TERMINAL,PRINTER - DEFAULTS=TERMINAL - PROMPT="Device(s) for messages" - HELP= -" Defines where messages will be shown: On the terminal and/or in a file -to be spooled automatically to the line printer" -! -KEYWORD=EXTENDSIZE - DATA_TYPE=J - MAX_NSETS=1 - IO=I - CHECKS=MINIMUM,MAXIMUM - ATTRIBUTES=IMMEDIATE - SEARCH=LOCAL,PROGRAM - MINIMUM=1 - MAXIMUM=512 - DEFAULTS=64 - PROMPT="Default extension size in blocks for DWARF data files" - HELP= -" Defines the minimum extension size to be applied by DWARF I/O routines. -An actual extension will be the maximum of this parameter and the extension -requested by the program." -! -KEYWORD=IOBUFSIZE - DATA_TYPE=J - MAX_NSETS=1 - IO=I - CHECKS=MINIMUM,MAXIMUM - ATTRIBUTES=IMMEDIATE - SEARCH=LOCAL,PROGRAM - MINIMUM=2048 - MAXIMUM=32768 - DEFAULTS=32768 - PROMPT="Default I/O buffer size in bytes" - HELP= -" This is the default size of I/O buffers to be allocated by the DWARF -bulk I/O routines. This parameter is intended primarily for adapting DWARF to -host systems with limited physical memory." -! -KEYWORD=TEST - DATA_TYPE=C - LENGTH=4 - MAX_NSETS=1 - IO=I - CHECKS=ABBREV_OPTIONS - ATTRIBUTES=IMMEDIATE - SEARCH=LOCAL,PROGRAM - OPTIONS=YES,NO - DEFAULTS=NO - PROMPT="Set DWARF test mode" - HELP= -" In testing mode: - Parameters with the TEST attribute will be prompted for. - The debugger will be automatically invoked at the instant an -error is reported. (Note that this may already happen during the execution -of the remainder of the SPECIFY DWARF command. In that case, just type "GO" in -reply to debugger prompts, and "EXIT" when the debugger reports program -completion.)" -! -KEYWORD=LOGLEVEL - DATA_TYPE=J - MAX_NSETS=1 - IO=I - CHECKS=MINIMUM,MAXIMUM - ATTRIBUTES=IMMEDIATE - SEARCH=LOCAL,PROGRAM - MINIMUM=0 - MAXIMUM=8 - DEFAULTS=4 - PROMPT="Severity threshold for logging messages" - HELP= -" This parameter defines the level below which messages will not be -logged. If LOGLEVEL=0, all messages are logged; if it is 8 you get no log at -all. - LOGLEVEL=4 will give you all informational messages from DWARF programs -plus fatal error messages." -! -KEYWORD=LOGFATAL - DATA_TYPE=C - LENGTH=4 - MAX_NSETS=1 - IO=I - CHECKS=ABBREV_OPTIONS - ATTRIBUTES=IMMEDIATE - SEARCH=LOCAL,PROGRAM - OPTIONS=YES,NO - DEFAULTS=NO - PROMPT="Do you want unsuccessful program runs logged" - HELP= -" This parameter controls the logging of program runs that terminate -with a failure status. If LOGFATAL=NO, only successfull runs will be logged." -! -KEYWORD=IDENT - DATA_TYPE=C - LENGTH=3 - MAX_NSETS=1 - IO=O - ATTRIBUTES=IMMEDIATE - SEARCH=LOCAL,PROGRAM - DEFAULTS=XYZ - HELP= -" This is the process identification used by DWARF. It can not be -changed by the user." -! -KEYWORD=IBMODE - DATA_TYPE=C - LENGTH=11 - IO=O - ATTRIBUTES=IMMEDIATE - SEARCH=LOCAL,PROGRAM - CHECKS=OPTIONS - OPTIONS=INTERACTIVE,BATCH,NETWORK - DEFAULT=INTERACTIVE - HELP= -" This is the batch/interactive flag maintained by DWARF, It can not be -changed by the user." diff --git a/src/dwarf/dwarf.ppd b/src/dwarf/dwarf.ppd deleted file mode 100644 index 897f1ab01f205ee7947f45e54804be5e88547cfc..0000000000000000000000000000000000000000 Binary files a/src/dwarf/dwarf.ppd and /dev/null differ diff --git a/src/dwarf/dwarf_4.def b/src/dwarf/dwarf_4.def deleted file mode 100644 index ab6c521a951d9a7509d7d53b69ee3849bee279af..0000000000000000000000000000000000000000 --- a/src/dwarf/dwarf_4.def +++ /dev/null @@ -1,104 +0,0 @@ -C Include module DWARF_4 -C Created by BLDDEF from: _$1$DIA3:[TESTDWARF.SRC.DEF]DWARF.DEF; on 17-OCT-90 -C -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ -C.Ident: DEF_DWARF -C.Keywords: DWARF control block, Definition -C.Author: Ger van Diepen (NFRA, Dwingeloo) -C.Language: DWARF-DEF -C.Environment: VAX or Alliant -C.File: [.SRC]DWARF.DEF -C.Comments: -C.Version: 830711 GVD - version 2 -C.Version: 831117 GVD - version 3 -C.Version: 811122 JPH -C.Version: 831207 GVD - removed flags -C.Version: 831208 JPH - add dynamic reference arrays -C.Version: 840105 JPH - add macro .PSECT declarartion -C.Version: 840119 GVD - defined UNDEF_C as a constant -C - removed UNDEF_C and .PSECT for Macro -C.Version: 840503 KK - add loglevel -C.Version: 840705 KK - add LOGFATAL -C.Version: 840727 GVD - new stream-name format -C.Version: 840808 GVD - added IDENT and IBMODE -C.Version: 840814 JPH - add macro definition of DWARF_. Make it and -C the definition of B$ conditional so they will only -C be seen by TRANSFERS.MAR -C.Version: 840816 JPH - DWARF_, B$ unconditional and local -C.Version: 840827 JPH - Add LOG__ symbols -C.Version: 840915 JPH - Correct error that caused MAXNDIM to be defined -C with a LOG prefix -C.Version: 880508 FMO - adapted for new DEF translator (BLDDEF) -C - added block type DYNREF -C.Version: 880509 FMO - undone DYNREF (old way restored; there were -C problems with double definition of LENGTH and TYPE) -C.Version: 890216 FMO - add string equivalents for STREAM, CURNODE and -C IDENT -C.Version: 920407 GvD - use '80000000'X to define UNDEF_J -C - define UNDEF_B and LARGEST_B as I2 iso. BYTE -C 920918 WNB -Convex made UNDEF_R into 0.0. Changed t0 3.85E-37 -C.Version: 940124 CMV - Removed LOG__, PRT__ and MSG__ flags -C------------------------------------------------------------------------- -C -C Declare external function STATUS as I*4 -C - INTEGER*4 STATUS -C -C Common block specification -C - INTEGER*4 DWARF__LENGTH ! block length (in longwords) - PARAMETER (DWARF__LENGTH =41) - INTEGER*4 DWARF$LENGTH - EQUIVALENCE (DWARF$LENGTH,DWARF__(0)) - INTEGER*4 DWARF$TYPE - EQUIVALENCE (DWARF$TYPE,DWARF__(4)) - INTEGER*4 DWARF$BELL - EQUIVALENCE (DWARF$BELL,DWARF__(8)) - INTEGER*4 DWARF$MSGDEV - EQUIVALENCE (DWARF$MSGDEV,DWARF__(12)) - INTEGER*4 DWARF$LEVEL - EQUIVALENCE (DWARF$LEVEL,DWARF__(16)) - INTEGER*4 DWARF$IOBFSZ - EQUIVALENCE (DWARF$IOBFSZ,DWARF__(20)) - INTEGER*4 DWARF$TAPEBLSZ - EQUIVALENCE (DWARF$TAPEBLSZ,DWARF__(24)) - INTEGER*4 DWARF$EXTENDSZ - EQUIVALENCE (DWARF$EXTENDSZ,DWARF__(28)) - INTEGER*4 DWARF$LENSTR - EQUIVALENCE (DWARF$LENSTR,DWARF__(32)) - INTEGER*4 DWARF$ASK - EQUIVALENCE (DWARF$ASK,DWARF__(36)) - INTEGER*4 DWARF$SAVELAST - EQUIVALENCE (DWARF$SAVELAST,DWARF__(40)) - INTEGER*4 DWARF$TEST - EQUIVALENCE (DWARF$TEST,DWARF__(44)) - INTEGER*4 DWARF$LENNODE - EQUIVALENCE (DWARF$LENNODE,DWARF__(48)) - INTEGER*4 DWARF$CURNODE(1) - EQUIVALENCE (DWARF$CURNODE,DWARF__(52)) - CHARACTER*80 DWARF$CURNODE_C - EQUIVALENCE (DWARF$CURNODE_C,DWARF__(52)) - INTEGER*4 DWARF$LOGLEVEL - EQUIVALENCE (DWARF$LOGLEVEL,DWARF__(132)) - INTEGER*4 DWARF$LOGFATAL - EQUIVALENCE (DWARF$LOGFATAL,DWARF__(136)) - INTEGER*4 DWARF$STREAM(1) - EQUIVALENCE (DWARF$STREAM,DWARF__(140)) - CHARACTER*12 DWARF$STREAM_C - EQUIVALENCE (DWARF$STREAM_C,DWARF__(140)) - INTEGER*4 DWARF$LENID - EQUIVALENCE (DWARF$LENID,DWARF__(152)) - INTEGER*4 DWARF$IDENT(1) - EQUIVALENCE (DWARF$IDENT,DWARF__(156)) - CHARACTER*4 DWARF$IDENT_C - EQUIVALENCE (DWARF$IDENT_C,DWARF__(156)) - INTEGER*4 DWARF$IBMODE - EQUIVALENCE (DWARF$IBMODE,DWARF__(160)) - BYTE DWARF__(0:163) - INTEGER*4 DWARF_(41) - EQUIVALENCE (DWARF_,DWARF__) -C - COMMON /DWARF_COMMON/ DWARF_ -C - EXTERNAL DWARF_BLOCK - diff --git a/src/dwarf/dwarf_alias.com b/src/dwarf/dwarf_alias.com deleted file mode 100755 index e0462b94e2da65d25640cb0c49a73d5655863aba..0000000000000000000000000000000000000000 --- a/src/dwarf/dwarf_alias.com +++ /dev/null @@ -1,38 +0,0 @@ -$!# dwarfalias.ssc -$!# FMO 910913 -$!# -$!# Revisions: -$!# GvD 911205 added abpi and use env.var. $SYSDWARF -$!# GvD 920302 added wenssinit -$!# GvD 920512 added calculate -$!# HjV 921130 use dwarfnews.hlp iso. dwarfnews.txt -$!# WNB 930302 made ssc to include vax -$!# HjV 930419 Add lo*gout -$!# -$!# Aliases for DWARF environment -$!# Call by sourcing in dwarfcshrc_xxxx -$!# -#$ ABPI*NIT == "@ABPDWARF:ABP_INIT" -#$ WENSSI*NIT == "@ABPDWARF:WENSS_INIT" -$ DWCAL*CULATE == "$SYSDWARF:CALCULATE.EXE" -$ CALC*ULATE == "$SYSDWARF:CALCULATE.EXE" -$ DWC*LEAR == "$SYSDWARF:CLEAR.EXE" -$ DWE*XECUTE == "$SYSDWARF:EXECUTE.EXE" -$ EXE*CUTE == "$SYSDWARF:EXECUTE.EXE" -$ DWL*ET == "$SYSDWARF:LET.EXE" -$ LET == "$SYSDWARF:LET.EXE" -$ DWN*EWS == "TYPE/PAGE ROOTDWARF:[DWARF]DWARFNEWS.HLP" -$ DWR*ESTORE == "$SYSDWARF:RESTORE.EXE" -$ RES*TORE == "$SYSDWARF:RESTORE.EXE" -$ DWSA*VE == "$SYSDWARF:SAVE.EXE" -$ DWS*PECIFY == "$SYSDWARF:SPECIFY.EXE" -$ SPEC*IFY == "$SYSDWARF:SPECIFY.EXE" -$ DWV*IEW == "$SYSDWARF:VIEW.EXE" -$ VI*EW == "$SYSDWARF:VIEW.EXE" -$ BLDP*PD == "$SYSDWARF:SYS_BLDPPD.EXE" -$ PRTP*PD == "$SYSDWARF:SYS_PRTPPD.EXE" -$ PRTU*NITS == "$SYSDWARF:PRTUNITS.EXE" -$ IND*WARF == "@ROOTDWARF:[DWARF]DWARFLOGIN" -$ OUTD*WARF == "@ROOTDWARF:[DWARF]DWARFLOGOUT" -$ LO*GOUT == "@ROOTDWARF:[DWARF]DWARFLOGOUT" -$ EXIT 1 diff --git a/src/dwarf/dwarf_alias.ssc b/src/dwarf/dwarf_alias.ssc deleted file mode 100644 index c22bb27cb804c6d515fc74d049e949ddc9658a82..0000000000000000000000000000000000000000 --- a/src/dwarf/dwarf_alias.ssc +++ /dev/null @@ -1,73 +0,0 @@ -# dwarfalias.ssc -# FMO 910913 -# -# Revisions: -# GvD 911205 added abpi and use env.var. $SYSDWARF -# GvD 920302 added wenssinit -# GvD 920512 added calculate -# HjV 921130 use dwarfnews.hlp iso. dwarfnews.txt -# WNB 930302 made ssc to include vax -# HjV 930419 Add lo*gout -# -# Aliases for DWARF environment -# Call by sourcing in dwarfcshrc_xxxx -# -#ifdef wn_vax__ -#$ ABPI*NIT == "@ABPDWARF:ABP_INIT" -#$ WENSSI*NIT == "@ABPDWARF:WENSS_INIT" -$ DWCAL*CULATE == "$SYSDWARF:CALCULATE.EXE" -$ CALC*ULATE == "$SYSDWARF:CALCULATE.EXE" -$ DWC*LEAR == "$SYSDWARF:CLEAR.EXE" -$ DWE*XECUTE == "$SYSDWARF:EXECUTE.EXE" -$ EXE*CUTE == "$SYSDWARF:EXECUTE.EXE" -$ DWL*ET == "$SYSDWARF:LET.EXE" -$ LET == "$SYSDWARF:LET.EXE" -$ DWN*EWS == "TYPE/PAGE ROOTDWARF:[DWARF]DWARFNEWS.HLP" -$ DWR*ESTORE == "$SYSDWARF:RESTORE.EXE" -$ RES*TORE == "$SYSDWARF:RESTORE.EXE" -$ DWSA*VE == "$SYSDWARF:SAVE.EXE" -$ DWS*PECIFY == "$SYSDWARF:SPECIFY.EXE" -$ SPEC*IFY == "$SYSDWARF:SPECIFY.EXE" -$ DWV*IEW == "$SYSDWARF:VIEW.EXE" -$ VI*EW == "$SYSDWARF:VIEW.EXE" -$ BLDP*PD == "$SYSDWARF:SYS_BLDPPD.EXE" -$ PRTP*PD == "$SYSDWARF:SYS_PRTPPD.EXE" -$ PRTU*NITS == "$SYSDWARF:PRTUNITS.EXE" -$ IND*WARF == "@ROOTDWARF:[DWARF]DWARFLOGIN" -$ OUTD*WARF == "@ROOTDWARF:[DWARF]DWARFLOGOUT" -$ LO*GOUT == "@ROOTDWARF:[DWARF]DWARFLOGOUT" -$ EXIT 1 -#else -# alias abpi "source $ABPDWARF/abp_init.sal" -# alias wenssi "source $ABPDWARF/wenss_init.sal" - alias dwcalc "$SYSDWARF/calculate.exe \!*" - alias dwcalculate "$SYSDWARF/calculate.exe \!*" - alias calc "$SYSDWARF/calculate.exe \!*" - alias calculate "$SYSDWARF/calculate.exe \!*" - alias dwc "$SYSDWARF/clear.exe \!*" - alias dwclear "$SYSDWARF/clear.exe \!*" - alias dwe "$SYSDWARF/execute.exe \!*" - alias dwexe "$SYSDWARF/execute.exe \!*" - alias exe "$SYSDWARF/execute.exe \!*" - alias dwl "$SYSDWARF/let.exe \!*" - alias dwlet "$SYSDWARF/let.exe \!*" - alias dwn "more $ROOTDWARF/dwarfnews.hlp" - alias dwnews "more $ROOTDWARF/dwarfnews.hlp" - alias dwr "$SYSDWARF/restore.exe \!*" - alias dwrestore "$SYSDWARF/restore.exe \!*" - alias restore "$SYSDWARF/restore.exe \!*" - alias dwsa "$SYSDWARF/save.exe \!*" - alias dwsave "$SYSDWARF/save.exe \!*" - alias dws "$SYSDWARF/specify.exe \!*" - alias dwspecify "$SYSDWARF/specify.exe \!*" - alias specify "$SYSDWARF/specify.exe \!*" - alias dwv "$SYSDWARF/view.exe \!*" - alias dwview "$SYSDWARF/view.exe \!*" - alias bldppd "$SYSDWARF/sys_bldppd.exe \!*" - alias prtppd "$SYSDWARF/sys_prtppd.exe \!*" - alias prtunits "$SYSDWARF/prtunits.exe" - alias indwarf "source $ROOTDWARF/dwarflogin.sun" - alias ind "source $ROOTDWARF/dwarflogin.sun" - alias outdwarf "source $ROOTDWARF/dwarflogout.sun" - alias outd "source $ROOTDWARF/dwarflogout.sun" -#endif diff --git a/src/dwarf/dwarf_alias.sun b/src/dwarf/dwarf_alias.sun deleted file mode 100755 index 8c60472270f48416830e5f6968912d663e27e1f4..0000000000000000000000000000000000000000 --- a/src/dwarf/dwarf_alias.sun +++ /dev/null @@ -1,46 +0,0 @@ -# dwarfalias.ssc -# FMO 910913 -# -# Revisions: -# GvD 911205 added abpi and use env.var. $SYSDWARF -# GvD 920302 added wenssinit -# GvD 920512 added calculate -# HjV 921130 use dwarfnews.hlp iso. dwarfnews.txt -# WNB 930302 made ssc to include vax -# HjV 930419 Add lo*gout -# -# Aliases for DWARF environment -# Call by sourcing in dwarfcshrc_xxxx -# -# alias abpi "source $ABPDWARF/abp_init.sal" -# alias wenssi "source $ABPDWARF/wenss_init.sal" - alias dwcalc "$SYSDWARF/calculate.exe \!*" - alias dwcalculate "$SYSDWARF/calculate.exe \!*" - alias calc "$SYSDWARF/calculate.exe \!*" - alias calculate "$SYSDWARF/calculate.exe \!*" - alias dwc "$SYSDWARF/clear.exe \!*" - alias dwclear "$SYSDWARF/clear.exe \!*" - alias dwe "$SYSDWARF/execute.exe \!*" - alias dwexe "$SYSDWARF/execute.exe \!*" - alias exe "$SYSDWARF/execute.exe \!*" - alias dwl "$SYSDWARF/let.exe \!*" - alias dwlet "$SYSDWARF/let.exe \!*" - alias dwn "more $ROOTDWARF/dwarfnews.hlp" - alias dwnews "more $ROOTDWARF/dwarfnews.hlp" - alias dwr "$SYSDWARF/restore.exe \!*" - alias dwrestore "$SYSDWARF/restore.exe \!*" - alias restore "$SYSDWARF/restore.exe \!*" - alias dwsa "$SYSDWARF/save.exe \!*" - alias dwsave "$SYSDWARF/save.exe \!*" - alias dws "$SYSDWARF/specify.exe \!*" - alias dwspecify "$SYSDWARF/specify.exe \!*" - alias specify "$SYSDWARF/specify.exe \!*" - alias dwv "$SYSDWARF/view.exe \!*" - alias dwview "$SYSDWARF/view.exe \!*" - alias bldppd "$SYSDWARF/sys_bldppd.exe \!*" - alias prtppd "$SYSDWARF/sys_prtppd.exe \!*" - alias prtunits "$SYSDWARF/prtunits.exe" - alias indwarf "source $ROOTDWARF/dwarflogin.sun" - alias ind "source $ROOTDWARF/dwarflogin.sun" - alias outdwarf "source $ROOTDWARF/dwarflogout.sun" - alias outd "source $ROOTDWARF/dwarflogout.sun" diff --git a/src/dwarf/dwarfblock.for b/src/dwarf/dwarfblock.for deleted file mode 100644 index bce8e7e40a107282389105c0e2d4e04ec16b302d..0000000000000000000000000000000000000000 --- a/src/dwarf/dwarfblock.for +++ /dev/null @@ -1,69 +0,0 @@ - BLOCK DATA DWARF_BLOCK -C Created by BLDDEF from: _$1$DIA3:[TESTDWARF.SRC.DEF]DWARF.DEF; on 17-OCT-90 -C HjV 921208 Removed all equivalence and add names to common block -C AXC 010709 linux port - data initialisation -C -C -C - INTEGER*4 DWARF$LENGTH - INTEGER*4 DWARF$TYPE - INTEGER*4 DWARF$BELL - INTEGER*4 DWARF$MSGDEV - INTEGER*4 DWARF$LEVEL - INTEGER*4 DWARF$IOBFSZ - INTEGER*4 DWARF$TAPEBLSZ - INTEGER*4 DWARF$EXTENDSZ - INTEGER*4 DWARF$LENSTR - INTEGER*4 DWARF$ASK - INTEGER*4 DWARF$SAVELAST - INTEGER*4 DWARF$TEST - INTEGER*4 DWARF$LENNODE - INTEGER*4 DWARF$CURNODE(1) - CHARACTER*80 DWARF$CURNODE_C - INTEGER*4 DWARF$LOGLEVEL - INTEGER*4 DWARF$LOGFATAL - INTEGER*4 DWARF$STREAM(1) - CHARACTER*12 DWARF$STREAM_C - INTEGER*4 DWARF$LENID - INTEGER*4 DWARF$IDENT(1) - CHARACTER*4 DWARF$IDENT_C - INTEGER*4 DWARF$IBMODE -C - COMMON /DWARF_COMMON/ DWARF$LENGTH, DWARF$TYPE, DWARF$BELL, - * DWARF$MSGDEV, DWARF$LEVEL, DWARF$IOBFSZ, DWARF$TAPEBLSZ, - * DWARF$EXTENDSZ, DWARF$LENSTR, DWARF$ASK, DWARF$SAVELAST, - * DWARF$TEST, DWARF$LENNODE, DWARF$CURNODE_C, - * DWARF$LOGLEVEL, DWARF$LOGFATAL, DWARF$STREAM_C, - * DWARF$LENID, DWARF$IDENT_C, DWARF$IBMODE -C -C - DATA DWARF$BELL /0/ - DATA DWARF$MSGDEV /0/ - DATA DWARF$LEVEL /2/ - DATA DWARF$IOBFSZ /32768/ - DATA DWARF$TAPEBLSZ /16384/ - DATA DWARF$EXTENDSZ /64/ - DATA DWARF$LENSTR /2/ - DATA DWARF$ASK /0/ - DATA DWARF$SAVELAST /0/ - DATA DWARF$TEST /0/ - DATA DWARF$LENNODE /1/ - DATA DWARF$CURNODE_C /'0'/ - DATA DWARF$LOGLEVEL /8/ - DATA DWARF$LOGFATAL /0/ - DATA DWARF$STREAM_C /'$1'/ - DATA DWARF$LENID /0/ - DATA DWARF$IDENT_C /'XYZ'/ - DATA DWARF$IBMODE /0/ - END - - - - - - - - - - - diff --git a/src/dwarf/dwarfcshrc.com b/src/dwarf/dwarfcshrc.com deleted file mode 100755 index 448198193afa2fd61c00bfc6ff995a8bde855b4b..0000000000000000000000000000000000000000 --- a/src/dwarf/dwarfcshrc.com +++ /dev/null @@ -1,31 +0,0 @@ -$!# dwarfcshrc.ssc -$!# WNB 920915 -$!# -$!# Revisions: -$!# WNB 921015 Add tests -$!# HjV 921103 Use $ROOTDWARF iso. $SYSDWARF for LIBDWARF -$!# WNB 930302 Make ssc -$!# HjV 931126 Add N_EXE and N_UEXE -$!# WNB 931126 Add N_HLP -$!# WNB 940310 Add N_IMPORT -$!# -$!# Environment for DWARF programs -$!# Call by sourcing in dwarfcshrc_xxx -$!# -$ IF F$TRNLNM("LIDWARF") .EQS. "" THEN - - ASSIGN/NOLOG ROOTDWARF:[DWARF] LIBDWARF -$ ASSIGN/NOLOG ROOTDWARF:[EXE] RUNDWARF -$ ASSIGN/NOLOG ROOTDWARF:[EXE] ABPDWARF -$ ASSIGN/NOLOG ROOTDWARF:[DWARF] INCDWARF -$ ASSIGN/NOLOG ROOTDWARF:[DWARF] SRCDWARF -$ ASSIGN/NOLOG ROOTDWARF:[DWARF] ABPDWARFVX -$ IF F$TRNLNM("SYS$LOGIN").EQS."" THEN - - DEFINE SYS$LOGIN 'F$ENVIRONMENT("DEFAULT")' -$ ASSIGN/NOLOG SYS$LOGIN:USERLOG.LOG USERLOG -$ ASSIGN/NOLOG [] SRCDIR -$ ASSIGN/NOLOG [] EXEUSER -$ ASSIGN/NOLOG EXEDWARF: N_EXE -$ ASSIGN/NOLOG [] N_UEXE -$ ASSIGN/NOLOG EXEDWARF: N_IMPORT -$ ! -$ EXIT diff --git a/src/dwarf/dwarfcshrc.ssc b/src/dwarf/dwarfcshrc.ssc deleted file mode 100644 index 31194aca87994ee33352c0e9e0f934913982cdde..0000000000000000000000000000000000000000 --- a/src/dwarf/dwarfcshrc.ssc +++ /dev/null @@ -1,48 +0,0 @@ -# dwarfcshrc.ssc -# WNB 920915 -# -# Revisions: -# WNB 921015 Add tests -# HjV 921103 Use $ROOTDWARF iso. $SYSDWARF for LIBDWARF -# WNB 930302 Make ssc -# HjV 931126 Add N_EXE and N_UEXE -# WNB 931126 Add N_HLP -# WNB 940310 Add N_IMPORT -# -# Environment for DWARF programs -# Call by sourcing in dwarfcshrc_xxx -# -#ifdef wn_vax__ -$ IF F$TRNLNM("LIDWARF") .EQS. "" THEN - - ASSIGN/NOLOG ROOTDWARF:[DWARF] LIBDWARF -$ ASSIGN/NOLOG ROOTDWARF:[EXE] RUNDWARF -$ ASSIGN/NOLOG ROOTDWARF:[EXE] ABPDWARF -$ ASSIGN/NOLOG ROOTDWARF:[DWARF] INCDWARF -$ ASSIGN/NOLOG ROOTDWARF:[DWARF] SRCDWARF -$ ASSIGN/NOLOG ROOTDWARF:[DWARF] ABPDWARFVX -$ IF F$TRNLNM("SYS$LOGIN").EQS."" THEN - - DEFINE SYS$LOGIN 'F$ENVIRONMENT("DEFAULT")' -$ ASSIGN/NOLOG SYS$LOGIN:USERLOG.LOG USERLOG -$ ASSIGN/NOLOG [] SRCDIR -$ ASSIGN/NOLOG [] EXEUSER -$ ASSIGN/NOLOG EXEDWARF: N_EXE -$ ASSIGN/NOLOG [] N_UEXE -$ ASSIGN/NOLOG EXEDWARF: N_IMPORT -$ ! -$ EXIT -#else -setenv USERLOG 'SYS$LOGIN:USERLOG.LOG' -if (! $?RUNDWARF) setenv RUNDWARF $ROOTDWARF -if (! $?LIBDWARF) setenv LIBDWARF $ROOTDWARF -if (! $?SRCDWARF) setenv SRCDWARF $ROOTDWARF -if (! $?INCDWARF) setenv INCDWARF $ROOTDWARF -if (! $?ABPDWARF) setenv ABPDWARF $SYSDWARF -setenv ABPDWARFVX "$EXEDWARF" -if (! $?EXEDWARF_UNIX) setenv EXEDWARF_UNIX $SYSDWARF -setenv n_exe $SYSDWARF -setenv n_hlp $SYSDWARF/html -setenv n_import $SRCDWARF/../import -setenv n_uexe './' -setenv SRCDIR '[]' -setenv EXEUSER '[]' -#endif diff --git a/src/dwarf/dwarfcshrc.sun b/src/dwarf/dwarfcshrc.sun deleted file mode 100755 index aa92b2749e9f59f84cc48d52ae4205e7d9fc25c8..0000000000000000000000000000000000000000 --- a/src/dwarf/dwarfcshrc.sun +++ /dev/null @@ -1,28 +0,0 @@ -# dwarfcshrc.ssc -# WNB 920915 -# -# Revisions: -# WNB 921015 Add tests -# HjV 921103 Use $ROOTDWARF iso. $SYSDWARF for LIBDWARF -# WNB 930302 Make ssc -# HjV 931126 Add N_EXE and N_UEXE -# WNB 931126 Add N_HLP -# WNB 940310 Add N_IMPORT -# -# Environment for DWARF programs -# Call by sourcing in dwarfcshrc_xxx -# -setenv USERLOG 'SYS$LOGIN:USERLOG.LOG' -if (! $?RUNDWARF) setenv RUNDWARF $ROOTDWARF -if (! $?LIBDWARF) setenv LIBDWARF $ROOTDWARF -if (! $?SRCDWARF) setenv SRCDWARF $ROOTDWARF -if (! $?INCDWARF) setenv INCDWARF $ROOTDWARF -if (! $?ABPDWARF) setenv ABPDWARF $SYSDWARF -setenv ABPDWARFVX "$EXEDWARF" -if (! $?EXEDWARF_UNIX) setenv EXEDWARF_UNIX $SYSDWARF -setenv n_exe $SYSDWARF -setenv n_hlp $SYSDWARF/html -setenv n_import $SRCDWARF/../import -setenv n_uexe './' -setenv SRCDIR '[]' -setenv EXEUSER '[]' diff --git a/src/dwarf/dwarfcshrc_arecb.com b/src/dwarf/dwarfcshrc_arecb.com deleted file mode 100755 index cbbe232dcce1e109637b84564a58bb5d67c553db..0000000000000000000000000000000000000000 --- a/src/dwarf/dwarfcshrc_arecb.com +++ /dev/null @@ -1,16 +0,0 @@ -$!# dwarfcshrc_arecb.ssc -$!# HjV 930914 -$!# -$!# Revisions: -$!# -$!# Environment for DWARF programs -$!# Call by inserting in .cshrc as source dwarfcshrc_arecb.sun -$!# -$ ASSIGN/NOLOG/TRANS=CONCEAL USER5:[WNB.] ROOTDWARF: -$ ASSIGN/NOLOG ROOTDWARF:[EXE] SYSDWARF -$ ASSIGN/NOLOG ROOTDWARF:[EXE] EXEDWARF -$ ASSIGN/NOLOG ROOTDWARF:[DWARF] LIBDWARF -$ @ROOTDWARF:[DWARF]DWARFCSHRC -$ @ROOTDWARF:[DWARF]DWARF_ALIAS -$ ! -$ EXIT diff --git a/src/dwarf/dwarfcshrc_arecb.ssc b/src/dwarf/dwarfcshrc_arecb.ssc deleted file mode 100644 index 2af976d7bc6a6f5280df09b473554f5d65940d9d..0000000000000000000000000000000000000000 --- a/src/dwarf/dwarfcshrc_arecb.ssc +++ /dev/null @@ -1,30 +0,0 @@ -# dwarfcshrc_arecb.ssc -# HjV 930914 -# -# Revisions: -# -# Environment for DWARF programs -# Call by inserting in .cshrc as source dwarfcshrc_arecb.sun -# -#ifdef wn_vax__ -$ ASSIGN/NOLOG/TRANS=CONCEAL USER5:[WNB.] ROOTDWARF: -$ ASSIGN/NOLOG ROOTDWARF:[EXE] SYSDWARF -$ ASSIGN/NOLOG ROOTDWARF:[EXE] EXEDWARF -$ ASSIGN/NOLOG ROOTDWARF:[DWARF] LIBDWARF -$ @ROOTDWARF:[DWARF]DWARFCSHRC -$ @ROOTDWARF:[DWARF]DWARF_ALIAS -$ ! -$ EXIT -#else - setenv ROOTDWARF /usr/local/newstar/dwarf - if (! $?HOSTTYPE) then - setenv HOSTTYPE `arch` - endif - if ($HOSTTYPE =~ sun*) then - setenv LIBDWARF /usr/local/newstar/lib/dwarf - setenv SYSDWARF /usr/local/newstar/exe - setenv EXEDWARF 'USR[LOCAL.NEWSTAR.EXE]' - endif - source $ROOTDWARF/dwarfcshrc.sun - source $ROOTDWARF/dwarf_alias.sun -#endif diff --git a/src/dwarf/dwarfcshrc_arecb.sun b/src/dwarf/dwarfcshrc_arecb.sun deleted file mode 100755 index b055cb1c60d0769eb6a9864aeb3a9c3fb0d9db79..0000000000000000000000000000000000000000 --- a/src/dwarf/dwarfcshrc_arecb.sun +++ /dev/null @@ -1,19 +0,0 @@ -# dwarfcshrc_arecb.ssc -# HjV 930914 -# -# Revisions: -# -# Environment for DWARF programs -# Call by inserting in .cshrc as source dwarfcshrc_arecb.sun -# - setenv ROOTDWARF /usr/local/newstar/dwarf - if (! $?HOSTTYPE) then - setenv HOSTTYPE `arch` - endif - if ($HOSTTYPE =~ sun*) then - setenv LIBDWARF /usr/local/newstar/lib/dwarf - setenv SYSDWARF /usr/local/newstar/exe - setenv EXEDWARF 'USR[LOCAL.NEWSTAR.EXE]' - endif - source $ROOTDWARF/dwarfcshrc.sun - source $ROOTDWARF/dwarf_alias.sun diff --git a/src/dwarf/dwarfcshrc_atnf.com b/src/dwarf/dwarfcshrc_atnf.com deleted file mode 100755 index acbfec5ecc080845868f07fe72ca06929eb40c16..0000000000000000000000000000000000000000 --- a/src/dwarf/dwarfcshrc_atnf.com +++ /dev/null @@ -1,19 +0,0 @@ -$!# dwarfcshrc_atnf.ssc -$!# WNB 920915 -$!# -$!# Revisions: -$!# WNB 930302 Make ssc -$!# WNB 940124 Change directories -$!# WNB 940216 Change LIBDWARF directory -$!# -$!# Environment for DWARF programs -$!# Call by sourcing in .cshrc (login.com) dwarfcshrc_atnf.sun -$!# -$ ASSIGN/NOLOG/TRANS=CONCEAL UTIL0:[BOOK.WBROUW.WNB.] ROOTDWARF: -$ ASSIGN/NOLOG ROOTDWARF:[EXE] SYSDWARF -$ ASSIGN/NOLOG ROOTDWARF:[EXE] EXEDWARF -$ ASSIGN/NOLOG ROOTDWARF:[DWARF] LIBDWARF -$ @ROOTDWARF:[DWARF]DWARFCSHRC -$ @ROOTDWARF:[DWARF]DWARF_ALIAS -$ ! -$ EXIT diff --git a/src/dwarf/dwarfcshrc_atnf.ssc b/src/dwarf/dwarfcshrc_atnf.ssc deleted file mode 100644 index 1953f079eb0713489904640ad11424604d843b37..0000000000000000000000000000000000000000 --- a/src/dwarf/dwarfcshrc_atnf.ssc +++ /dev/null @@ -1,49 +0,0 @@ -# dwarfcshrc_atnf.ssc -# WNB 920915 -# -# Revisions: -# WNB 930302 Make ssc -# WNB 940124 Change directories -# WNB 940216 Change LIBDWARF directory -# -# Environment for DWARF programs -# Call by sourcing in .cshrc (login.com) dwarfcshrc_atnf.sun -# -#ifdef wn_vax__ -$ ASSIGN/NOLOG/TRANS=CONCEAL UTIL0:[BOOK.WBROUW.WNB.] ROOTDWARF: -$ ASSIGN/NOLOG ROOTDWARF:[EXE] SYSDWARF -$ ASSIGN/NOLOG ROOTDWARF:[EXE] EXEDWARF -$ ASSIGN/NOLOG ROOTDWARF:[DWARF] LIBDWARF -$ @ROOTDWARF:[DWARF]DWARFCSHRC -$ @ROOTDWARF:[DWARF]DWARF_ALIAS -$ ! -$ EXIT -#else -if (! $?host) set host=`hostname` -setenv ROOTDWARF /code_norma/nstar/dwarf -if ($host == ateles) then - setenv SYSDWARF /newstar/scv/dwarf - setenv EXEDWARF 'NEWSTAR:[SCV.DWARF]' - setenv LIBDWARF /code_norma/nstar/olb/scv/dwarf -else if ($host == norma) then - setenv SYSDWARF /newstar/sdw/dwarf - setenv EXEDWARF 'NEWSTAR:[SDW.DWARF]' - setenv LIBDWARF /code_norma/nstar/olb/sdw/dwarf -else if ($?MACHINE_ARC) then - if ($MACHINE_ARC == dec) then - setenv SYSDWARF /newstar/sdw/dwarf - setenv EXEDWARF 'NEWSTAR:[SDW.DWARF]' - setenv LIBDWARF /code_norma/nstar/olb/sdw/dwarf - else - setenv SYSDWARF /newstar/ssw/dwarf - setenv EXEDWARF 'NEWSTAR:[SSW.DWARF]' - setenv LIBDWARF /code_norma/nstar/olb/ssw/dwarf - endif -else - setenv SYSDWARF /newstar/ssw/dwarf - setenv EXEDWARF 'NEWSTAR:[SSW.DWARF]' - setenv LIBDWARF /code_norma/nstar/olb/ssw/dwarf -endif -source $ROOTDWARF/dwarfcshrc.sun -source $ROOTDWARF/dwarf_alias.sun -#endif diff --git a/src/dwarf/dwarfcshrc_atnf.sun b/src/dwarf/dwarfcshrc_atnf.sun deleted file mode 100755 index 20d08fee397f57999dc420b6de55de8288d63e5d..0000000000000000000000000000000000000000 --- a/src/dwarf/dwarfcshrc_atnf.sun +++ /dev/null @@ -1,38 +0,0 @@ -# dwarfcshrc_atnf.ssc -# WNB 920915 -# -# Revisions: -# WNB 930302 Make ssc -# WNB 940124 Change directories -# WNB 940216 Change LIBDWARF directory -# -# Environment for DWARF programs -# Call by sourcing in .cshrc (login.com) dwarfcshrc_atnf.sun -# -if (! $?host) set host=`hostname` -setenv ROOTDWARF /code_norma/nstar/dwarf -if ($host == ateles) then - setenv SYSDWARF /newstar/scv/dwarf - setenv EXEDWARF 'NEWSTAR:[SCV.DWARF]' - setenv LIBDWARF /code_norma/nstar/olb/scv/dwarf -else if ($host == norma) then - setenv SYSDWARF /newstar/sdw/dwarf - setenv EXEDWARF 'NEWSTAR:[SDW.DWARF]' - setenv LIBDWARF /code_norma/nstar/olb/sdw/dwarf -else if ($?MACHINE_ARC) then - if ($MACHINE_ARC == dec) then - setenv SYSDWARF /newstar/sdw/dwarf - setenv EXEDWARF 'NEWSTAR:[SDW.DWARF]' - setenv LIBDWARF /code_norma/nstar/olb/sdw/dwarf - else - setenv SYSDWARF /newstar/ssw/dwarf - setenv EXEDWARF 'NEWSTAR:[SSW.DWARF]' - setenv LIBDWARF /code_norma/nstar/olb/ssw/dwarf - endif -else - setenv SYSDWARF /newstar/ssw/dwarf - setenv EXEDWARF 'NEWSTAR:[SSW.DWARF]' - setenv LIBDWARF /code_norma/nstar/olb/ssw/dwarf -endif -source $ROOTDWARF/dwarfcshrc.sun -source $ROOTDWARF/dwarf_alias.sun diff --git a/src/dwarf/dwarfcshrc_kosma.com b/src/dwarf/dwarfcshrc_kosma.com deleted file mode 100755 index 9e5d61a3c1450178d553379d6d956201dada58e4..0000000000000000000000000000000000000000 --- a/src/dwarf/dwarfcshrc_kosma.com +++ /dev/null @@ -1,17 +0,0 @@ -$!# dwarfcshrc_kosma.ssc -$!# HjV 930630 -$!# -$!# Revisions: -$!# HjV 930720 Typo's -$!# -$!# Environment for DWARF programs -$!# Call by inserting in .cshrc as source dwarfcshrc_kosma.sun -$!# -$ ASSIGN/NOLOG/TRANS=CONCEAL APOLLO_UTILDSK:[NEWSTAR.] ROOTDWARF: -$ ASSIGN/NOLOG ROOTDWARF:[SVX.EXE] SYSDWARF -$ ASSIGN/NOLOG ROOTDWARF:[SVX.EXE] EXEDWARF -$ ASSIGN/NOLOG ROOTDWARF:[DWARF] LIBDWARF -$ @ROOTDWARF:[DWARF]DWARFCSHRC -$ @ROOTDWARF:[DWARF]DWARF_ALIAS -$ ! -$ EXIT diff --git a/src/dwarf/dwarfcshrc_kosma.ssc b/src/dwarf/dwarfcshrc_kosma.ssc deleted file mode 100644 index f042b1019cb31785524599bf05b0267262d75fbb..0000000000000000000000000000000000000000 --- a/src/dwarf/dwarfcshrc_kosma.ssc +++ /dev/null @@ -1,28 +0,0 @@ -# dwarfcshrc_kosma.ssc -# HjV 930630 -# -# Revisions: -# HjV 930720 Typo's -# -# Environment for DWARF programs -# Call by inserting in .cshrc as source dwarfcshrc_kosma.sun -# -#ifdef wn_vax__ -$ ASSIGN/NOLOG/TRANS=CONCEAL APOLLO_UTILDSK:[NEWSTAR.] ROOTDWARF: -$ ASSIGN/NOLOG ROOTDWARF:[SVX.EXE] SYSDWARF -$ ASSIGN/NOLOG ROOTDWARF:[SVX.EXE] EXEDWARF -$ ASSIGN/NOLOG ROOTDWARF:[DWARF] LIBDWARF -$ @ROOTDWARF:[DWARF]DWARFCSHRC -$ @ROOTDWARF:[DWARF]DWARF_ALIAS -$ ! -$ EXIT -#else - if (! $?host) set host=`hostname` - setenv ROOTDWARF /utildsk/newstar/dwarf - if ($host =~ apollo*) then - setenv SYSDWARF /utildsk/newstar/exe - setenv EXEDWARF 'UTILDSK[NEWSTAR.EXE]' - endif - source $ROOTDWARF/dwarfcshrc.sun - source $ROOTDWARF/dwarf_alias.sun -#endif diff --git a/src/dwarf/dwarfcshrc_kosma.sun b/src/dwarf/dwarfcshrc_kosma.sun deleted file mode 100755 index 5c6065b7442dc4840ff1d5152a317e0cdb704ba1..0000000000000000000000000000000000000000 --- a/src/dwarf/dwarfcshrc_kosma.sun +++ /dev/null @@ -1,17 +0,0 @@ -# dwarfcshrc_kosma.ssc -# HjV 930630 -# -# Revisions: -# HjV 930720 Typo's -# -# Environment for DWARF programs -# Call by inserting in .cshrc as source dwarfcshrc_kosma.sun -# - if (! $?host) set host=`hostname` - setenv ROOTDWARF /utildsk/newstar/dwarf - if ($host =~ apollo*) then - setenv SYSDWARF /utildsk/newstar/exe - setenv EXEDWARF 'UTILDSK[NEWSTAR.EXE]' - endif - source $ROOTDWARF/dwarfcshrc.sun - source $ROOTDWARF/dwarf_alias.sun diff --git a/src/dwarf/dwarfcshrc_nfra.com b/src/dwarf/dwarfcshrc_nfra.com deleted file mode 100755 index c7b15f0c440f6210e31311336f0146addb40236d..0000000000000000000000000000000000000000 --- a/src/dwarf/dwarfcshrc_nfra.com +++ /dev/null @@ -1,19 +0,0 @@ -$!# dwarfcshrc_nfra.ssc -$!# HjV 930226 -$!# -$!# Revisions: -$!# WNB 930302 Delete some -$!# HjV 930621 Change test HOSTTYPE for HP and SUN -$!# CMV 930721 Add test on existence of HOSTTYPE -$!# -$!# Environment for DWARF programs -$!# Call by inserting in .cshrc as source dwarfcshrc_nfra.sun -$!# -$ ASSIGN/NOLOG/TRANS=CONCEAL USER5:[WNB.] ROOTDWARF: -$ ASSIGN/NOLOG ROOTDWARF:[EXE] SYSDWARF -$ ASSIGN/NOLOG ROOTDWARF:[EXE] EXEDWARF -$ ASSIGN/NOLOG ROOTDWARF:[DWARF] LIBDWARF -$ @ROOTDWARF:[DWARF]DWARFCSHRC -$ @ROOTDWARF:[DWARF]DWARF_ALIAS -$ ! -$ EXIT diff --git a/src/dwarf/dwarfcshrc_nfra.ssc b/src/dwarf/dwarfcshrc_nfra.ssc deleted file mode 100644 index 96d330a4539b1b7bd58732bb13be804d3ed07430..0000000000000000000000000000000000000000 --- a/src/dwarf/dwarfcshrc_nfra.ssc +++ /dev/null @@ -1,49 +0,0 @@ -# dwarfcshrc_nfra.ssc -# HjV 930226 -# -# Revisions: -# WNB 930302 Delete some -# HjV 930621 Change test HOSTTYPE for HP and SUN -# CMV 930721 Add test on existence of HOSTTYPE -# -# Environment for DWARF programs -# Call by inserting in .cshrc as source dwarfcshrc_nfra.sun -# -#ifdef wn_vax__ -$ ASSIGN/NOLOG/TRANS=CONCEAL USER5:[WNB.] ROOTDWARF: -$ ASSIGN/NOLOG ROOTDWARF:[EXE] SYSDWARF -$ ASSIGN/NOLOG ROOTDWARF:[EXE] EXEDWARF -$ ASSIGN/NOLOG ROOTDWARF:[DWARF] LIBDWARF -$ @ROOTDWARF:[DWARF]DWARFCSHRC -$ @ROOTDWARF:[DWARF]DWARF_ALIAS -$ ! -$ EXIT -#else - if (! $?host) set host=`hostname` - if ($host =~ rzma*) then - setenv ROOTDWARF ~wnb/dwarf - setenv SYSDWARF ~wim/dwarf - setenv EXEDWARF 'USR:[WIM.DWARF]' - else if ($host =~ rzmd*) then - setenv ROOTDWARF /home/rzmws0/wnb/dwarf - setenv LIBDWARF /newstar/sdw/lib/dwarf - setenv SYSDWARF /newstar/sdw/exe - setenv EXEDWARF 'NEWSTAR[SDW.EXE]' - else - setenv ROOTDWARF /home/rzmws0/wnb/dwarf - if (! $?HOSTTYPE) then - setenv HOSTTYPE `arch` - endif - if ($HOSTTYPE =~ sun*) then - setenv LIBDWARF /newstar/ssw/lib/dwarf - setenv SYSDWARF /newstar/ssw/exe - setenv EXEDWARF 'NEWSTAR[SSW.EXE]' - else if ($HOSTTYPE =~ hp*) then - setenv LIBDWARF /newstar/shp/lib/dwarf - setenv SYSDWARF /newstar/shp/exe - setenv EXEDWARF 'NEWSTAR[SHP.EXE]' - endif - endif - source $ROOTDWARF/dwarfcshrc.sun - source $ROOTDWARF/dwarf_alias.sun -#endif diff --git a/src/dwarf/dwarfcshrc_nfra.sun b/src/dwarf/dwarfcshrc_nfra.sun deleted file mode 100755 index c0a635775a2797fb9d9a047342ed21440d96ad61..0000000000000000000000000000000000000000 --- a/src/dwarf/dwarfcshrc_nfra.sun +++ /dev/null @@ -1,38 +0,0 @@ -# dwarfcshrc_nfra.ssc -# HjV 930226 -# -# Revisions: -# WNB 930302 Delete some -# HjV 930621 Change test HOSTTYPE for HP and SUN -# CMV 930721 Add test on existence of HOSTTYPE -# -# Environment for DWARF programs -# Call by inserting in .cshrc as source dwarfcshrc_nfra.sun -# - if (! $?host) set host=`hostname` - if ($host =~ rzma*) then - setenv ROOTDWARF ~wnb/dwarf - setenv SYSDWARF ~wim/dwarf - setenv EXEDWARF 'USR:[WIM.DWARF]' - else if ($host =~ rzmd*) then - setenv ROOTDWARF /home/rzmws0/wnb/dwarf - setenv LIBDWARF /newstar/sdw/lib/dwarf - setenv SYSDWARF /newstar/sdw/exe - setenv EXEDWARF 'NEWSTAR[SDW.EXE]' - else - setenv ROOTDWARF /home/rzmws0/wnb/dwarf - if (! $?HOSTTYPE) then - setenv HOSTTYPE `arch` - endif - if ($HOSTTYPE =~ sun*) then - setenv LIBDWARF /newstar/ssw/lib/dwarf - setenv SYSDWARF /newstar/ssw/exe - setenv EXEDWARF 'NEWSTAR[SSW.EXE]' - else if ($HOSTTYPE =~ hp*) then - setenv LIBDWARF /newstar/shp/lib/dwarf - setenv SYSDWARF /newstar/shp/exe - setenv EXEDWARF 'NEWSTAR[SHP.EXE]' - endif - endif - source $ROOTDWARF/dwarfcshrc.sun - source $ROOTDWARF/dwarf_alias.sun diff --git a/src/dwarf/dwarfcshrc_raiub.com b/src/dwarf/dwarfcshrc_raiub.com deleted file mode 100755 index 0454a07b331a0406a56b124fdff635023f371d73..0000000000000000000000000000000000000000 --- a/src/dwarf/dwarfcshrc_raiub.com +++ /dev/null @@ -1,9 +0,0 @@ -$!# dwarfcshrc_raiub.ssc -$!# HjV 930226 -$!# -$!# Revisions: -$!# WNB 930302 Make ssc -$!# -$!# Environment for DWARF programs -$!# Call by sourcing in .cshrc (login.com) -$!# diff --git a/src/dwarf/dwarfcshrc_raiub.ssc b/src/dwarf/dwarfcshrc_raiub.ssc deleted file mode 100644 index 4f2cfb760badc490905c49c3e47be289e19b5790..0000000000000000000000000000000000000000 --- a/src/dwarf/dwarfcshrc_raiub.ssc +++ /dev/null @@ -1,18 +0,0 @@ -# dwarfcshrc_raiub.ssc -# HjV 930226 -# -# Revisions: -# WNB 930302 Make ssc -# -# Environment for DWARF programs -# Call by sourcing in .cshrc (login.com) -# -#ifdef wn_vax__ -#else -setenv ROOTDWARF /aux29/dwingeloo/newstar/dwarf -setenv SYSDWARF $ROOTDWARF/../exe -setenv LIBDWARF $ROOTDWARF -setenv EXEDWARF 'AUX29:[DWINGELOO.NEWSTAR.EXE]' -source $ROOTDWARF/dwarfcshrc.sun -source $ROOTDWARF/dwarf_alias.sun -#endif diff --git a/src/dwarf/dwarfcshrc_raiub.sun b/src/dwarf/dwarfcshrc_raiub.sun deleted file mode 100755 index 3809709482dfb41d19cbc74c8689e086e8f50402..0000000000000000000000000000000000000000 --- a/src/dwarf/dwarfcshrc_raiub.sun +++ /dev/null @@ -1,15 +0,0 @@ -# dwarfcshrc_raiub.ssc -# HjV 930226 -# -# Revisions: -# WNB 930302 Make ssc -# -# Environment for DWARF programs -# Call by sourcing in .cshrc (login.com) -# -setenv ROOTDWARF /aux29/dwingeloo/newstar/dwarf -setenv SYSDWARF $ROOTDWARF/../exe -setenv LIBDWARF $ROOTDWARF -setenv EXEDWARF 'AUX29:[DWINGELOO.NEWSTAR.EXE]' -source $ROOTDWARF/dwarfcshrc.sun -source $ROOTDWARF/dwarf_alias.sun diff --git a/src/dwarf/dwarfcshrc_rug.com b/src/dwarf/dwarfcshrc_rug.com deleted file mode 100755 index e525594caf70006acfdf8745fd9aef79cc41435a..0000000000000000000000000000000000000000 --- a/src/dwarf/dwarfcshrc_rug.com +++ /dev/null @@ -1,16 +0,0 @@ -$!# dwarfcshrc_rug.ssc -$!# HjV 930226 -$!# -$!# Revisions: -$!# WNB 930302 Make ssc -$!# HjV 930706 Change name of disk (dj3 iso. dj2) -$!# -$!# Environment for DWARF programs -$!# Call by sourcing in .cshrc (login.com) -$!# -$ ASSIGN/NOLOG/TRANS=CONCEAL DU$GWS:[GWSX.WNB.] ROOTDWARF: -$ ASSIGN/NOLOG ROOTDWARF:[EXE] SYSDWARF -$ ASSIGN/NOLOG ROOTDWARF:[EXE] EXEDWARF -$ ASSIGN/NOLOG ROOTDWARF:[DWARF] LIBDWARF -$ @ROOTDWARF:[DWARF]DWARFCSHRC -$ @ROOTDWARF:[DWARF]DWARF_ALIAS diff --git a/src/dwarf/dwarfcshrc_rug.ssc b/src/dwarf/dwarfcshrc_rug.ssc deleted file mode 100644 index 5c18933d0d50bc4e0b2f529c052d949c0be07949..0000000000000000000000000000000000000000 --- a/src/dwarf/dwarfcshrc_rug.ssc +++ /dev/null @@ -1,35 +0,0 @@ -# dwarfcshrc_rug.ssc -# HjV 930226 -# -# Revisions: -# WNB 930302 Make ssc -# HjV 930706 Change name of disk (dj3 iso. dj2) -# -# Environment for DWARF programs -# Call by sourcing in .cshrc (login.com) -# -#ifdef wn_vax__ -$ ASSIGN/NOLOG/TRANS=CONCEAL DU$GWS:[GWSX.WNB.] ROOTDWARF: -$ ASSIGN/NOLOG ROOTDWARF:[EXE] SYSDWARF -$ ASSIGN/NOLOG ROOTDWARF:[EXE] EXEDWARF -$ ASSIGN/NOLOG ROOTDWARF:[DWARF] LIBDWARF -$ @ROOTDWARF:[DWARF]DWARFCSHRC -$ @ROOTDWARF:[DWARF]DWARF_ALIAS -#else -setenv ROOTDWARF ~newstar/dwarf -if ($HOSTTYPE =~ al*) then - setenv SYSDWARF /dj3/users/newstar/exe/sal - setenv LIBDWARF /dj3/users/newstar/lib/sal/dwarf - setenv EXEDWARF 'DJ3[USERS.NEWSTAR.EXE.SAL]' -else if ($HOSTTYPE =~ hp*) then - setenv SYSDWARF /dj3/users/newstar/exe/shp - setenv LIBDWARF /dj3/users/newstar/lib/shp/dwarf - setenv EXEDWARF 'DJ3[USERS.NEWSTAR.EXE.SHP]' -else - setenv SYSDWARF /dj3/users/newstar/exe/ssw - setenv LIBDWARF /dj3/users/newstar/lib/ssw/dwarf - setenv EXEDWARF 'DJ3[USERS.NEWSTAR.EXE.SSW]' -endif -source $ROOTDWARF/dwarfcshrc.sun -source $ROOTDWARF/dwarf_alias.sun -#endif diff --git a/src/dwarf/dwarfcshrc_rug.sun b/src/dwarf/dwarfcshrc_rug.sun deleted file mode 100755 index 22ce7d9111a886c8718e25491c51f5abbd159808..0000000000000000000000000000000000000000 --- a/src/dwarf/dwarfcshrc_rug.sun +++ /dev/null @@ -1,26 +0,0 @@ -# dwarfcshrc_rug.ssc -# HjV 930226 -# -# Revisions: -# WNB 930302 Make ssc -# HjV 930706 Change name of disk (dj3 iso. dj2) -# -# Environment for DWARF programs -# Call by sourcing in .cshrc (login.com) -# -setenv ROOTDWARF ~newstar/dwarf -if ($HOSTTYPE =~ al*) then - setenv SYSDWARF /dj3/users/newstar/exe/sal - setenv LIBDWARF /dj3/users/newstar/lib/sal/dwarf - setenv EXEDWARF 'DJ3[USERS.NEWSTAR.EXE.SAL]' -else if ($HOSTTYPE =~ hp*) then - setenv SYSDWARF /dj3/users/newstar/exe/shp - setenv LIBDWARF /dj3/users/newstar/lib/shp/dwarf - setenv EXEDWARF 'DJ3[USERS.NEWSTAR.EXE.SHP]' -else - setenv SYSDWARF /dj3/users/newstar/exe/ssw - setenv LIBDWARF /dj3/users/newstar/lib/ssw/dwarf - setenv EXEDWARF 'DJ3[USERS.NEWSTAR.EXE.SSW]' -endif -source $ROOTDWARF/dwarfcshrc.sun -source $ROOTDWARF/dwarf_alias.sun diff --git a/src/dwarf/dwarfcshrc_wsrt.com b/src/dwarf/dwarfcshrc_wsrt.com deleted file mode 100755 index f39af5b4f255ef024ffa31ddbaf547bd5688de14..0000000000000000000000000000000000000000 --- a/src/dwarf/dwarfcshrc_wsrt.com +++ /dev/null @@ -1,9 +0,0 @@ -$!# dwarfcshrc_wsrt.ssc -$!# HjV 930226 -$!# -$!# Revisions: -$!# WNB 930302 Make ssc -$!# -$!# Environment for DWARF programs -$!# Call by sourcing in .cshrc (login.com) -$!# diff --git a/src/dwarf/dwarfcshrc_wsrt.ssc b/src/dwarf/dwarfcshrc_wsrt.ssc deleted file mode 100644 index 82067c4b43acbf980075d466fee73a2884b97005..0000000000000000000000000000000000000000 --- a/src/dwarf/dwarfcshrc_wsrt.ssc +++ /dev/null @@ -1,20 +0,0 @@ -# dwarfcshrc_wsrt.ssc -# HjV 930226 -# -# Revisions: -# WNB 930302 Make ssc -# -# Environment for DWARF programs -# Call by sourcing in .cshrc (login.com) -# -#ifdef wn_vax__ -#else -if (! $?host) set host=`hostname` -setenv ROOTDWARF /users/srt/nst/dwarf -if ($host =~ wsrt*) then - setenv SYSDWARF /users/srt/nst/exe - setenv EXEDWARF 'USERS[SRT.NST.EXE]' -endif -source $ROOTDWARF/dwarfcshrc.sun -source $ROOTDWARF/dwarf_alias.sun -#endif diff --git a/src/dwarf/dwarfcshrc_wsrt.sun b/src/dwarf/dwarfcshrc_wsrt.sun deleted file mode 100755 index b7b310c597b617db63b2a95690c0484c4c948b50..0000000000000000000000000000000000000000 --- a/src/dwarf/dwarfcshrc_wsrt.sun +++ /dev/null @@ -1,17 +0,0 @@ -# dwarfcshrc_wsrt.ssc -# HjV 930226 -# -# Revisions: -# WNB 930302 Make ssc -# -# Environment for DWARF programs -# Call by sourcing in .cshrc (login.com) -# -if (! $?host) set host=`hostname` -setenv ROOTDWARF /users/srt/nst/dwarf -if ($host =~ wsrt*) then - setenv SYSDWARF /users/srt/nst/exe - setenv EXEDWARF 'USERS[SRT.NST.EXE]' -endif -source $ROOTDWARF/dwarfcshrc.sun -source $ROOTDWARF/dwarf_alias.sun diff --git a/src/dwarf/dwarfini.hlp b/src/dwarf/dwarfini.hlp deleted file mode 100644 index e4e1529cf57459f7cbac99b9f4458befc05653dd..0000000000000000000000000000000000000000 --- a/src/dwarf/dwarfini.hlp +++ /dev/null @@ -1,4 +0,0 @@ - -1 Type dwnews to get information about the recent changes in the DWARF system. - -************************************************** 16-Dec-92 WNB *********** diff --git a/src/dwarf/dwarflogin.com b/src/dwarf/dwarflogin.com deleted file mode 100755 index c1c9270d1060db286ac98ed2688d5055192c47cd..0000000000000000000000000000000000000000 --- a/src/dwarf/dwarflogin.com +++ /dev/null @@ -1,54 +0,0 @@ -$!# dwarflogin.ssc -$!# WNB 930302 -$!# -$!# Revisions: -$!# WNB 930302 Make ssc -$!# -$!# DWARF initialisation. Call as ind(warf) -$!# -$ IF F$TRNLNM("SYS$LOGIN").EQS."" THEN - - DEFINE SYS$LOGIN 'F$ENVIRONMENT("DEFAULT")' -$ TMP="$SYSDWARF:initdw" -$ MODE=F$MODE() -$ IF MODE .EQS. "OTHER" THEN MODE="BATCH" -$ TMP 'F$STRING(F$GETJPI("","PROC_INDEX"))'+'MODE' -$ BATCHFILE="" -$ IF MODE .EQS. "BATCH" -$ THEN -$ EXEBATCH_PRC==F$GETJPI("","PRCNAM")-"BATCH_" -$ BATCHFILE=F$SEARCH("SYS$LOGIN:EXEBATCH''EXEBATCH_PRC'.TMP") -$ IF BATCHFILE.NES."" THEN SET NOVERIFY -$ ENDIF -$ IF BATCHFILE.NES."" -$ THEN -$ RESTORE="$SYSDWARF:ENVRESTORE.EXE" -$ RESTORE 'BATCHFILE' -$ ELSE -$ IF F$SEARCH("SYS$LOGIN:LOGIN.SAV").NES."" -$ THEN -$ RESTORE="$SYSDWARF:RESTORE.EXE" -$ RESTORE SYS$LOGIN:LOGIN.SAV -$ ENDIF -$ ENDIF -$ IF BATCHFILE.NES."" -$ THEN -$ WRITE SYS$OUTPUT "" -$ SET VERIFY -$ @'BATCHFILE' -$ X='F$VERIFY(0) -$ WRITE SYS$OUTPUT " - - -" -$ DELETE 'BATCHFILE' -$ LOGOUT="LOGOUT" -$ LOGOUT -$ ENDIF -$ ! -$ PI=="3.141592653589793" -$ PIRAD=="3.141592653589793 RAD" -$ Y*ES==".TRUE." -$ N*O==".FALSE." -$ INIMSG=F$SEARCH("SYSDWARF:DWARFINI.HLP") -$ IF INIMSG .NES. "" THEN TYPE 'INIMSG' -$ EXIT 1 diff --git a/src/dwarf/dwarflogin.ssc b/src/dwarf/dwarflogin.ssc deleted file mode 100644 index c9af9d0f7f92a754cca1af4ab5a1b7021cbd7949..0000000000000000000000000000000000000000 --- a/src/dwarf/dwarflogin.ssc +++ /dev/null @@ -1,85 +0,0 @@ -# dwarflogin.ssc -# WNB 930302 -# -# Revisions: -# WNB 930302 Make ssc -# -# DWARF initialisation. Call as ind(warf) -# -#ifdef wn_vax__ -$ IF F$TRNLNM("SYS$LOGIN").EQS."" THEN - - DEFINE SYS$LOGIN 'F$ENVIRONMENT("DEFAULT")' -$ TMP="$SYSDWARF:initdw" -$ MODE=F$MODE() -$ IF MODE .EQS. "OTHER" THEN MODE="BATCH" -$ TMP 'F$STRING(F$GETJPI("","PROC_INDEX"))'+'MODE' -$ BATCHFILE="" -$ IF MODE .EQS. "BATCH" -$ THEN -$ EXEBATCH_PRC==F$GETJPI("","PRCNAM")-"BATCH_" -$ BATCHFILE=F$SEARCH("SYS$LOGIN:EXEBATCH''EXEBATCH_PRC'.TMP") -$ IF BATCHFILE.NES."" THEN SET NOVERIFY -$ ENDIF -$ IF BATCHFILE.NES."" -$ THEN -$ RESTORE="$SYSDWARF:ENVRESTORE.EXE" -$ RESTORE 'BATCHFILE' -$ ELSE -$ IF F$SEARCH("SYS$LOGIN:LOGIN.SAV").NES."" -$ THEN -$ RESTORE="$SYSDWARF:RESTORE.EXE" -$ RESTORE SYS$LOGIN:LOGIN.SAV -$ ENDIF -$ ENDIF -$ IF BATCHFILE.NES."" -$ THEN -$ WRITE SYS$OUTPUT "" -$ SET VERIFY -$ @'BATCHFILE' -$ X='F$VERIFY(0) -$ WRITE SYS$OUTPUT " - - -" -$ DELETE 'BATCHFILE' -$ LOGOUT="LOGOUT" -$ LOGOUT -$ ENDIF -$ ! -$ PI=="3.141592653589793" -$ PIRAD=="3.141592653589793 RAD" -$ Y*ES==".TRUE." -$ N*O==".FALSE." -$ INIMSG=F$SEARCH("SYSDWARF:DWARFINI.HLP") -$ IF INIMSG .NES. "" THEN TYPE 'INIMSG' -$ EXIT 1 -#else -setenv DWARF_SYMBOLS ~/SYMBOL_DIR/SYMBOL.$$ -if (! -e ~/SYMBOL_DIR) then - "mkdir" ~/SYMBOL_DIR - echo "Created subdirectory ~/SYMBOL_DIR" -endif -if (-e ~/SYMBOL_DIR/SAVSYMBOLS) then - "cp" ~/SYMBOL_DIR/SAVSYMBOLS $DWARF_SYMBOLS - echo "Symbols restored from ~/SYMBOL_DIR/SAVSYMBOLS" -else - "touch" $DWARF_SYMBOLS -endif -chmod 644 $DWARF_SYMBOLS -"find" ~/SYMBOL_DIR/SYMBOL.* -atime +7 -exec "rm" "{}" ";" >& /dev/null -# -$SYSDWARF/initdw.exe $$+INTERACTIVE -# -$SYSDWARF/let.exe >/dev/null <<endlet -YES = .TRUE. -YE = .TRUE. -Y = .TRUE. -NO = .FALSE. -N = .FALSE. -PI = 3.141592653589793 -PIRAD = 3.141592653589793 RAD -endlet -# -if (-e $ROOTDWARF/dwarfini.hlp) more $ROOTDWARF/dwarfini.hlp -# -#endif diff --git a/src/dwarf/dwarflogin.sun b/src/dwarf/dwarflogin.sun deleted file mode 100755 index cdcafb2b596e70d97c968b02c82717a3547a8180..0000000000000000000000000000000000000000 --- a/src/dwarf/dwarflogin.sun +++ /dev/null @@ -1,36 +0,0 @@ -# dwarflogin.ssc -# WNB 930302 -# -# Revisions: -# WNB 930302 Make ssc -# -# DWARF initialisation. Call as ind(warf) -# -setenv DWARF_SYMBOLS ~/SYMBOL_DIR/SYMBOL.$$ -if (! -e ~/SYMBOL_DIR) then - "mkdir" ~/SYMBOL_DIR - echo "Created subdirectory ~/SYMBOL_DIR" -endif -if (-e ~/SYMBOL_DIR/SAVSYMBOLS) then - "cp" ~/SYMBOL_DIR/SAVSYMBOLS $DWARF_SYMBOLS - echo "Symbols restored from ~/SYMBOL_DIR/SAVSYMBOLS" -else - "touch" $DWARF_SYMBOLS -endif -chmod 644 $DWARF_SYMBOLS -"find" ~/SYMBOL_DIR/SYMBOL.* -atime +7 -exec "rm" "{}" ";" >& /dev/null -# -$SYSDWARF/initdw.exe $$+INTERACTIVE -# -$SYSDWARF/let.exe >/dev/null <<endlet -YES = .TRUE. -YE = .TRUE. -Y = .TRUE. -NO = .FALSE. -N = .FALSE. -PI = 3.141592653589793 -PIRAD = 3.141592653589793 RAD -endlet -# -if (-e $ROOTDWARF/dwarfini.hlp) more $ROOTDWARF/dwarfini.hlp -# diff --git a/src/dwarf/dwarflogout.com b/src/dwarf/dwarflogout.com deleted file mode 100755 index 8b296d9d7b19b5280eae199dc8740eec6b05a3e7..0000000000000000000000000000000000000000 --- a/src/dwarf/dwarflogout.com +++ /dev/null @@ -1,12 +0,0 @@ -$!# dwarflogout.ssc -$!# GvD 911203 -$!# -$!# Revisions: -$!# WNB 930302 Make ssc -$!# -$!# Save DWARF symbols -$!# -$ DELETE/SYMBOL/GLOBAL LOGOUT -$ NAME=F$SEARCH("SYS$LOGIN:LOGOUT.COM") -$ IF NAME.NES."" THEN @'NAME' -$ LOGOUT diff --git a/src/dwarf/dwarflogout.ssc b/src/dwarf/dwarflogout.ssc deleted file mode 100644 index 580b61cc92c93236b157769f042085b9550a1dec..0000000000000000000000000000000000000000 --- a/src/dwarf/dwarflogout.ssc +++ /dev/null @@ -1,19 +0,0 @@ -# dwarflogout.ssc -# GvD 911203 -# -# Revisions: -# WNB 930302 Make ssc -# -# Save DWARF symbols -# -#ifdef wn_vax__ -$ DELETE/SYMBOL/GLOBAL LOGOUT -$ NAME=F$SEARCH("SYS$LOGIN:LOGOUT.COM") -$ IF NAME.NES."" THEN @'NAME' -$ LOGOUT -#else -if ($?DWARF_SYMBOLS) then - echo "Symbols will be saved in ~/SYMBOL_DIR/SAVSYMBOLS" - "cp" $DWARF_SYMBOLS ~/SYMBOL_DIR/SAVSYMBOLS -endif -#endif diff --git a/src/dwarf/dwarflogout.sun b/src/dwarf/dwarflogout.sun deleted file mode 100755 index e53fb4d687e7b70c7a38157703909e18695c9626..0000000000000000000000000000000000000000 --- a/src/dwarf/dwarflogout.sun +++ /dev/null @@ -1,12 +0,0 @@ -# dwarflogout.ssc -# GvD 911203 -# -# Revisions: -# WNB 930302 Make ssc -# -# Save DWARF symbols -# -if ($?DWARF_SYMBOLS) then - echo "Symbols will be saved in ~/SYMBOL_DIR/SAVSYMBOLS" - "cp" $DWARF_SYMBOLS ~/SYMBOL_DIR/SAVSYMBOLS -endif diff --git a/src/dwarf/dwarfnews.hlp b/src/dwarf/dwarfnews.hlp deleted file mode 100644 index ec34bde921b0c94db24c5e81d2420760cd5b9c68..0000000000000000000000000000000000000000 --- a/src/dwarf/dwarfnews.hlp +++ /dev/null @@ -1,94 +0,0 @@ -1 DWARFnews - - - 911210 Some improvements have been made to DWARF. - The main improvement is that a program is starting faster because - the symbol handling software is much faster. The number of symbols - allowed is unlimited, but of course you should not let it grow too - much. The symbol files are now located in a separate subdirectory, - which is automatically created by .dwarflogin when it does not exist. - .dwarflogout saves your symbol files and deletes symbol files older - than 1 week. You should therefore use - source $SYSDWARF/.dwarflogout in your logout file. - Secondly the EXEC call is used as much as possible to start the - programs. This has the benefit that no shell is created to run the - program and that EXECUTE disappears after having started the program. - Thirdly some environment variables resembling the VAX logical names - have been defined. These are $SYSDWARF, $RUNDWARF and $LIBDWARF. - These variables should be used as much as possible instead of the - ~dwarf construction, because they are more system independent. - At last a few minor bugs have been removed. - - 910913 The following DWARF command aliases have been defined: - dwc for dwclear (see 910814) - dwe for dwexe (see below) - dwl for dwlet (see 910814) - dwn for dwnews (display this file) - dwr for restore (see 910814) - dws for specify - dwsa for dwsave (see 910814) - dwv for dwview (see 910817) - - The DWARF command dwexe has been installed. It behaves roughly like - the EXE*CUTE command on the VAX, e.g.: - dwexe 'program$stream <qualifiers>' - runs the program in the given stream taking the qualifiers - into account. - The following qualifiers are recognized: - /[no]ask /[no]save /[no]test (as on the VAX); - /input=<file> lets the program read input from the file; - /nowait runs the program in the background (it will - stop when it needs input from the terminal); - /batch runs the program in the background, but lets - the program take its input from the null device - and writes the output to <prognam><stream>.log; - /debug executes the program under dbx; - /norun for N-type programs: runs the program in - specify mode: only asks for parameter input - and saves the answers in external defaults); - for other programs: only saves any ask, save - or test switch given (as on the VAX); - /nolog or /log=<value> - /nodatab - /noinfix - /noapply or /apply=<list> - /node_apply or /de_apply=<list> - are only recognized for N-type programs; first, - defaults for the corresponding program - parameters are specified according to the - qualifiers given. - - 910817 Command dwview installed (similar to DWARF/VAX's VIEW): - Examples: - dwview - lists all external defaults (specified or restored) - dwview 'program$stream' - lists all program parameters and their current defaults - (external or PPD) in the given or current stream - dwview 'program /external' - only lists the program parameters with external defaults - dwview 'name_list /input=save_file' - lists all saved parameter defaults matching the namelist - - 910814 Some more VAX/DWARF commands have been activated on the Alliant. - The command lines given below are meant to show all the possible - qualifiers; all their names can be abbreviated to a single letter. - The quotes suppress the interpretation of meta-characters by the shell. - - dwclear 'list /exclude=list /confirm /log=long' - clears the listed parameter defaults (list required) - dwsave 'list /output=file /exclude=list /confirm /log=short' - saves the listed defaults in the file - (default: save all defaults in .dwarfsave.sav) - restore 'file /include=list /exclude=list /confirm /overwrite /nolog' - restores (all) defaults from the file - dwlet 'name=value /log=short' - defines a global symbol - prtunits - displays DWARF units and conversion factors - - 910806 External defaults are no longer automatically carried over from your - previous session. However, you can activate this option by copying - ~dwarf/protologout to ~/.logout. From then on, when you log out, all - the defaults are saved in the file ~/symbol.sav and, when you log in - again, DWARF's login procedure will restore them. diff --git a/src/dwarf/dwc.def b/src/dwarf/dwc.def deleted file mode 100644 index 50158f51f5739d3ac7a163ee11422b957da6b32a..0000000000000000000000000000000000000000 --- a/src/dwarf/dwc.def +++ /dev/null @@ -1,638 +0,0 @@ -C+DWC.DEF -C CMV 940131 -C -C General include file for DWARF -C -C This file contains all status codes and general dwarf parameters. -C It should be included in all Fortran DWARF sources and replaces -C various ???msg.def and other DWARF include files now obsolerte. -C -C- AXC 010907 linux port, parameter initialisation -C -C 'Universal' constants for DWARF -C -C -C 'undefined' values for standard data types -C - BYTE UNDEF_B - PARAMETER (UNDEF_B =-128) - INTEGER*2 UNDEF_I - PARAMETER (UNDEF_I =-32768) - INTEGER*4 UNDEF_J - PARAMETER (UNDEF_J ='80000000'X) - REAL*4 UNDEF_R - PARAMETER (UNDEF_R =3.85E-37) !!2.9387358770557188E-39) - REAL*8 UNDEF_D - PARAMETER (UNDEF_D =3.85E-37) !!2.9387358770557188D-39) - COMPLEX*8 UNDEF_X - PARAMETER (UNDEF_X =(3.85E-37,3.85E-37)) -C PARAMETER (UNDEF_X =(UNDEF_R,UNDEF_R)) ! not allowed - COMPLEX*16 UNDEF_Y - PARAMETER (UNDEF_Y = (3.85E-37,3.85E-37)) -C PARAMETER (UNDEF_Y =(UNDEF_D,UNDEF_D)) ! Not allowed - CHARACTER*1 UNDEF_C - PARAMETER (UNDEF_C = '') !not allowed - -C -C largest possible values -C - BYTE LARGEST_B - PARAMETER (LARGEST_B =127) - INTEGER*2 LARGEST_I - PARAMETER (LARGEST_I =32767) - INTEGER*4 LARGEST_J - PARAMETER (LARGEST_J =2147483647) - REAL*4 LARGEST_R - PARAMETER (LARGEST_R =1.7014117331926443E38) - REAL*8 LARGEST_D - PARAMETER (LARGEST_D =1.7014117331926443D38) -C -C Flags for parameter interface -C - INTEGER*4 PARM__OVERRIDE - PARAMETER (PARM__OVERRIDE =1) !override SPECIFY default with caller default - INTEGER*4 PARM__TOBY - PARAMETER (PARM__TOBY =2) !data array is in TO/BY format -C - INTEGER*4 PARM__NULL - PARAMETER (PARM__NULL =0) !null value - INTEGER*4 PARM__WILD - PARAMETER (PARM__WILD =-1) !wildcard - INTEGER*4 PARM__EOF - PARAMETER (PARM__EOF =-2) !end of file/control-Z -C -C Symbol types -C - INTEGER*4 DWC__LOCALSYM - PARAMETER (DWC__LOCALSYM =1) - INTEGER*4 DWC__GLOBALSYM - PARAMETER (DWC__GLOBALSYM =2) -C -C Commandline interface -C -C - an .OR.-ed combination of these flags determines -C the type and attributes of each argument -C - the flags in each group are mutually exclusive -C -C type -C - INTEGER*4 CLI__PARAMETER - PARAMETER (CLI__PARAMETER =0) !standard parameter (default) - INTEGER*4 CLI__QUALIFIER - PARAMETER (CLI__QUALIFIER =1) !qualifier - INTEGER*4 CLI__EXPRESSION - PARAMETER (CLI__EXPRESSION =2) !expression-type parameter -C -C presence attribute -C - INTEGER*4 CLI__OPTIONAL - PARAMETER (CLI__OPTIONAL =0) !absent by default (default) - INTEGER*4 CLI__DEFAULT - PARAMETER (CLI__DEFAULT =4) !present by default (for qualifiers only) - INTEGER*4 CLI__REQUIRED - PARAMETER (CLI__REQUIRED =8) !must be specified -C -C value attribute (for qualifiers only) -C - INTEGER*4 CLI__NOVALUE - PARAMETER (CLI__NOVALUE =0) !no value associated (default) - INTEGER*4 CLI__VALUE - PARAMETER (CLI__VALUE =16) !value associated - -C -C DWC messages (not yet checked wether they are used at all) -C - integer*4 dwc_success - parameter (dwc_success='08038009'x) - integer*4 dwc_getinperr - parameter (dwc_getinperr='08038014'x) - integer*4 dwc_eofctrlz - parameter (dwc_eofctrlz='08038018'x) - integer*4 dwc_experrmsg - parameter (dwc_experrmsg='08038022'x) - integer*4 dwc_invoper - parameter (dwc_invoper='0803802a'x) - integer*4 dwc_invnonr - parameter (dwc_invnonr='08038032'x) - integer*4 dwc_toomanarg - parameter (dwc_toomanarg='0803803a'x) - integer*4 dwc_toolitarg - parameter (dwc_toolitarg='08038042'x) - integer*4 dwc_toodeenes - parameter (dwc_toodeenes='0803804a'x) - integer*4 dwc_toomanynr - parameter (dwc_toomanynr='08038052'x) - integer*4 dwc_unbparen - parameter (dwc_unbparen='0803805a'x) - integer*4 dwc_divbyzero - parameter (dwc_divbyzero='08038062'x) - integer*4 dwc_unkfunc - parameter (dwc_unkfunc='0803806a'x) - integer*4 dwc_notaftop - parameter (dwc_notaftop='08038072'x) - integer*4 dwc_invfunarg - parameter (dwc_invfunarg='0803807a'x) - integer*4 dwc_undefexp - parameter (dwc_undefexp='08038082'x) - integer*4 dwc_setcurnod - parameter (dwc_setcurnod='08038088'x) - integer*4 dwc_intoverfl - parameter (dwc_intoverfl='08038092'x) - integer*4 dwc_tonotall - parameter (dwc_tonotall='0803809a'x) - integer*4 dwc_stepnotal - parameter (dwc_stepnotal='080380a2'x) - integer*4 dwc_tsnotall - parameter (dwc_tsnotall='080380aa'x) - integer*4 dwc_saveovflo - parameter (dwc_saveovflo='080380b4'x) - integer*4 dwc_stepiszer - parameter (dwc_stepiszer='080380ba'x) - integer*4 dwc_stepsign - parameter (dwc_stepsign='080380c2'x) - integer*4 dwc_toomanyel - parameter (dwc_toomanyel='080380ca'x) - integer*4 dwc_noendapos - parameter (dwc_noendapos='080380d2'x) - integer*4 dwc_symnotdef - parameter (dwc_symnotdef='080380da'x) - integer*4 dwc_mutualsub - parameter (dwc_mutualsub='080380e2'x) - integer*4 dwc_noendquo - parameter (dwc_noendquo='080380ea'x) - integer*4 dwc_toomanchr - parameter (dwc_toomanchr='080380f2'x) - integer*4 dwc_invunit - parameter (dwc_invunit='080380fa'x) - integer*4 dwc_strtoosho - parameter (dwc_strtoosho='08038100'x) - integer*4 dwc_novaldef - parameter (dwc_novaldef='0803810a'x) - integer*4 dwc_keyvahelp - parameter (dwc_keyvahelp='08038110'x) - integer*4 dwc_unkkeyw - parameter (dwc_unkkeyw='0803811a'x) - integer*4 dwc_unkprkeyw - parameter (dwc_unkprkeyw='08038124'x) - integer*4 dwc_partoosml - parameter (dwc_partoosml='0803812c'x) - integer*4 dwc_parnonr - parameter (dwc_parnonr='08038134'x) - integer*4 dwc_paramerr - parameter (dwc_paramerr='0803813a'x) - integer*4 dwc_parnotfnd - parameter (dwc_parnotfnd='08038144'x) - integer*4 dwc_parnoval - parameter (dwc_parnoval='0803814c'x) - integer*4 dwc_parwrdef - parameter (dwc_parwrdef='08038154'x) - integer*4 dwc_parwrans - parameter (dwc_parwrans='0803815a'x) - integer*4 dwc_pargivval - parameter (dwc_pargivval='08038162'x) - integer*4 dwc_ppdnovirt - parameter (dwc_ppdnovirt='08038174'x) - integer*4 dwc_ppdfrvirt - parameter (dwc_ppdfrvirt='0803817c'x) - integer*4 dwc_acttooman - parameter (dwc_acttooman='0803818c'x) - integer*4 dwc_calsepexp - parameter (dwc_calsepexp='08038190'x) - integer*4 dwc_calinvrad - parameter (dwc_calinvrad='0803819a'x) - integer*4 dwc_calinvtyp - parameter (dwc_calinvtyp='080381a2'x) - integer*4 dwc_invsymnam - parameter (dwc_invsymnam='080381aa'x) - integer*4 dwc_reservsym - parameter (dwc_reservsym='080381b2'x) - integer*4 dwc_getinptr - parameter (dwc_getinptr='080381bb'x) - integer*4 dwc_lokillimg - parameter (dwc_lokillimg='080381c2'x) - integer*4 dwc_multiqual - parameter (dwc_multiqual='080381ca'x) - integer*4 dwc_blankslas - parameter (dwc_blankslas='080381d0'x) - integer*4 dwc_strinvnr - parameter (dwc_strinvnr='080381da'x) - integer*4 dwc_strnotall - parameter (dwc_strnotall='080381e2'x) - integer*4 dwc_apptwodot - parameter (dwc_apptwodot='080381ea'x) - integer*4 dwc_apptoolon - parameter (dwc_apptoolon='080381f2'x) - integer*4 dwc_appminus - parameter (dwc_appminus='080381fa'x) - integer*4 dwc_subprcerr - parameter (dwc_subprcerr='08038204'x) - integer*4 dwc_filnotfnd - parameter (dwc_filnotfnd='0803820c'x) - integer*4 dwc_noparcom - parameter (dwc_noparcom='08038212'x) - integer*4 dwc_unkqual - parameter (dwc_unkqual='0803821a'x) - integer*4 dwc_ambqual - parameter (dwc_ambqual='08038222'x) - integer*4 dwc_qualnoval - parameter (dwc_qualnoval='0803822a'x) - integer*4 dwc_qualvalna - parameter (dwc_qualvalna='08038232'x) - integer*4 dwc_invimgstr - parameter (dwc_invimgstr='0803823a'x) - integer*4 dwc_synerrsym - parameter (dwc_synerrsym='08038242'x) - integer*4 dwc_lokunkimg - parameter (dwc_lokunkimg='0803824a'x) - integer*4 dwc_qualbatch - parameter (dwc_qualbatch='08038252'x) - integer*4 dwc_specwrsyn - parameter (dwc_specwrsyn='0803825a'x) - integer*4 dwc_errsavsym - parameter (dwc_errsavsym='08038262'x) - integer*4 dwc_letnosval - parameter (dwc_letnosval='08038268'x) - integer*4 dwc_novalall - parameter (dwc_novalall='08038272'x) - integer*4 dwc_symbolclr - parameter (dwc_symbolclr='08038278'x) - integer*4 dwc_twiceval - parameter (dwc_twiceval='08038284'x) - integer*4 dwc_tbnotall - parameter (dwc_tbnotall='0803828c'x) - integer*4 dwc_tbnomult - parameter (dwc_tbnomult='08038294'x) - integer*4 dwc_usesavfil - parameter (dwc_usesavfil='0803829b'x) - integer*4 dwc_symbclear - parameter (dwc_symbclear='080382a3'x) - integer*4 dwc_nrsymclr - parameter (dwc_nrsymclr='080382ab'x) - integer*4 dwc_invlevel - parameter (dwc_invlevel='08038362'x) - integer*4 dwc_unkdwcom - parameter (dwc_unkdwcom='0803836c'x) - integer*4 dwc_exeerrors - parameter (dwc_exeerrors='08038372'x) - integer*4 dwc_waitsubpr - parameter (dwc_waitsubpr='0803837b'x) - integer*4 dwc_waitready - parameter (dwc_waitready='08038383'x) - integer*4 dwc_wtnojob - parameter (dwc_wtnojob='0803838c'x) - integer*4 dwc_wtmorejob - parameter (dwc_wtmorejob='08038392'x) - integer*4 dwc_wtnokeyw - parameter (dwc_wtnokeyw='0803839a'x) - integer*4 dwc_wtnothact - parameter (dwc_wtnothact='080383a3'x) - integer*4 dwc_savinvglb - parameter (dwc_savinvglb='080383aa'x) - integer*4 dwc_savnrsave - parameter (dwc_savnrsave='080383b3'x) - integer*4 dwc_resnrrest - parameter (dwc_resnrrest='080383bb'x) - integer*4 dwc_chkerrmsg - parameter (dwc_chkerrmsg='080383c2'x) - integer*4 dwc_wildnotal - parameter (dwc_wildnotal='080383ca'x) - integer*4 dwc_parnoout - parameter (dwc_parnoout='080383d4'x) - integer*4 dwc_parretbat - parameter (dwc_parretbat='080383dc'x) - integer*4 dwc_noglbstr - parameter (dwc_noglbstr='080383e4'x) - integer*4 dwc_progsterr - parameter (dwc_progsterr='080383ec'x) - integer*4 dwc_pareltsml - parameter (dwc_pareltsml='080383f4'x) - integer*4 dwc_nodcomerr - parameter (dwc_nodcomerr='080383fa'x) - integer*4 dwc_clrdwarf - parameter (dwc_clrdwarf='08038400'x) - integer*4 dwc_toomanset - parameter (dwc_toomanset='0803840c'x) - integer*4 dwc_nullnotal - parameter (dwc_nullnotal='0803841a'x) - integer*4 dwc_imgsubprc - parameter (dwc_imgsubprc='08038431'x) - integer*4 dwc_nolocval - parameter (dwc_nolocval='0803843b'x) - integer*4 dwc_nodwvalue - parameter (dwc_nodwvalue='08038444'x) - integer*4 dwc_dwserror - parameter (dwc_dwserror='0803844c'x) - integer*4 dwc_unkdwkey - parameter (dwc_unkdwkey='08038454'x) - integer*4 dwc_immnosubs - parameter (dwc_immnosubs='0803845b'x) - integer*4 dwc_mandatval - parameter (dwc_mandatval='08038462'x) - integer*4 dwc_nocupdsym - parameter (dwc_nocupdsym='0803846c'x) - integer*4 dwc_keywmism - parameter (dwc_keywmism='08038474'x) - integer*4 dwc_subprcpmt - parameter (dwc_subprcpmt='0803847b'x) - integer*4 dwc_exeuser - parameter (dwc_exeuser='08038483'x) - integer*4 dwc_present - parameter (dwc_present='08038489'x) - integer*4 dwc_absent - parameter (dwc_absent='08038491'x) - integer*4 dwc_negated - parameter (dwc_negated='08038499'x) - integer*4 dwc_required - parameter (dwc_required='080384a1'x) - integer*4 dwc_clibuferr - parameter (dwc_clibuferr='080384aa'x) - integer*4 dwc_clisyntax - parameter (dwc_clisyntax='080384b4'x) - integer*4 dwc_cliparunk - parameter (dwc_cliparunk='080384ba'x) - integer*4 dwc_clinamamb - parameter (dwc_clinamamb='080384c2'x) - integer*4 dwc_clinamunk - parameter (dwc_clinamunk='080384ca'x) - integer*4 dwc_clistrinv - parameter (dwc_clistrinv='080384d4'x) - integer*4 dwc_clistrmax - parameter (dwc_clistrmax='080384da'x) - integer*4 dwc_clistrovr - parameter (dwc_clistrovr='080384e2'x) -C -C GEN messages -C - integer*4 gen_success - parameter (gen_success='08018061'x) - integer*4 gen_lunnofree - parameter (gen_lunnofree='080181b2'x) - integer*4 gen_stmessag - parameter (gen_stmessag='0801800b'x) - integer*4 gen_endmessag - parameter (gen_endmessag='08018013'x) - integer*4 gen_symdeferr - parameter (gen_symdeferr='0801818a'x) - integer*4 gen_symgeterr - parameter (gen_symgeterr='08018192'x) - integer*4 gen_symdelerr - parameter (gen_symdelerr='0801819a'x) - integer*4 gen_isnotanm - parameter (gen_isnotanm='08018032'x) - integer*4 gen_invdattyp - parameter (gen_invdattyp='08018092'x) - integer*4 gen_forioerr - parameter (gen_forioerr='0801805a'x) - integer*4 gen_strovflo - parameter (gen_strovflo='080180e4'x) -C -C UDF parameters -C - integer*4 udf_uninotfnd - parameter (udf_uninotfnd='08068032'x) - integer*4 udf_grpnotfnd - parameter (udf_grpnotfnd='0806803a'x) - integer*4 udf_strtoosml - parameter (udf_strtoosml='0806813c'x) -C -C CPL parameters -C - integer*4 cpl_strovrflo - parameter (cpl_strovrflo='080880ca'x) - integer*4 cpl_fldnrinv - parameter (cpl_fldnrinv='080880c4'x) - integer*4 cpl_success - parameter (cpl_success='08088079'x) - integer*4 cpl_wrkful - parameter (cpl_wrkful='0808801c'x) - integer*4 cpl_dattypinv - parameter (cpl_dattypinv='0808810a'x) - integer*4 cpl_arrovrflo - parameter (cpl_arrovrflo='080880d2'x) - integer*4 cpl_vallisinv - parameter (cpl_vallisinv='080880ea'x) - integer*4 cpl_srceof - parameter (cpl_srceof='0808805b'x) - integer*4 cpl_dynfilerr - parameter (cpl_dynfilerr='080880f4'x) - integer*4 cpl_dynwrterr - parameter (cpl_dynwrterr='080880fc'x) - integer*4 cpl_errcntexc - parameter (cpl_errcntexc='0808802c'x) - integer*4 cpl_clisterr - parameter (cpl_clisterr='08088102'x) - integer*4 cpl_objopnerr - parameter (cpl_objopnerr='080880a4'x) - integer*4 cpl_objcloerr - parameter (cpl_objcloerr='080880b2'x) - integer*4 cpl_objdelerr - parameter (cpl_objdelerr='080880ba'x) - integer*4 cpl_fldunexp - parameter (cpl_fldunexp='080880da'x) - integer*4 cpl_eofunexp - parameter (cpl_eofunexp='080880e2'x) - integer*4 cpl_fldinval - parameter (cpl_fldinval='08088052'x) - integer*4 cpl_srcopnerr - parameter (cpl_srcopnerr='08088084'x) - integer*4 cpl_srcrewerr - parameter (cpl_srcrewerr='0808808c'x) - integer*4 cpl_srcrderr - parameter (cpl_srcrderr='08088094'x) - integer*4 cpl_srccloerr - parameter (cpl_srccloerr='0808809a'x) - integer*4 cpl_fldnotuni - parameter (cpl_fldnotuni='0808804a'x) - integer*4 cpl_objwrterr - parameter (cpl_objwrterr='080880ac'x) -C -C DBD messages (set in ppdcheck) -C - integer*4 dbd_namtolng - parameter (dbd_namtolng='08078022'x) - integer*4 dbd_namtomny - parameter (dbd_namtomny='0807802a'x) - integer*4 dbd_badnode - parameter (dbd_badnode='0807801a'x) -C -C PPD messages -C - integer*4 ppd_success - parameter (ppd_success='08028009'x) - integer*4 ppd_nosuccess - parameter (ppd_nosuccess='08028012'x) - integer*4 ppd_strnotan - parameter (ppd_strnotan='08028032'x) - integer*4 ppd_arrnotasc - parameter (ppd_arrnotasc='0802803a'x) - integer*4 ppd_arrnotdes - parameter (ppd_arrnotdes='08028042'x) - integer*4 ppd_optinval - parameter (ppd_optinval='08028052'x) - integer*4 ppd_optnotuni - parameter (ppd_optnotuni='0802805a'x) - integer*4 ppd_strtoosml - parameter (ppd_strtoosml='0802808a'x) - integer*4 ppd_seqerror - parameter (ppd_seqerror='080280ca'x) - integer*4 ppd_endoffile - parameter (ppd_endoffile='080280d3'x) - integer*4 ppd_keynotfnd - parameter (ppd_keynotfnd='080280da'x) - integer*4 ppd_errminchk - parameter (ppd_errminchk='0802811a'x) - integer*4 ppd_errmaxchk - parameter (ppd_errmaxchk='08028122'x) - integer*4 ppd_strnotalp - parameter (ppd_strnotalp='0802812a'x) - integer*4 ppd_strnotnum - parameter (ppd_strnotnum='08028132'x) - integer*4 ppd_imtoolong - parameter (ppd_imtoolong='080281aa'x) - integer*4 ppd_ppdnotfnd - parameter (ppd_ppdnotfnd='080281b2'x) - integer*4 ppd_pkynotfnd - parameter (ppd_pkynotfnd='080281ba'x) - integer*4 ppd_nocurentr - parameter (ppd_nocurentr='080281d2'x) - integer*4 ppd_numvalmin - parameter (ppd_numvalmin='0802823a'x) - integer*4 ppd_numvalmax - parameter (ppd_numvalmax='08028242'x) - integer*4 ppd_numsetmax - parameter (ppd_numsetmax='0802824a'x) - integer*4 ppd_vallssmin - parameter (ppd_vallssmin='08028252'x) - integer*4 ppd_valexcmax - parameter (ppd_valexcmax='0802825a'x) - integer*4 ppd_arrnotnas - parameter (ppd_arrnotnas='08028262'x) - integer*4 ppd_arrnotnde - parameter (ppd_arrnotnde='0802826a'x) - integer*4 ppd_unamnot - parameter (ppd_unamnot='0802827a'x) - integer*4 ppd_max16 - parameter (ppd_max16='08028282'x) - integer*4 ppd_chatnuni - parameter (ppd_chatnuni='0802828a'x) - integer*4 ppd_chatinv - parameter (ppd_chatinv='08028292'x) - integer*4 ppd_mutexclch - parameter (ppd_mutexclch='0802829a'x) - integer*4 ppd_nndnotnod - parameter (ppd_nndnotnod='080282a2'x) - integer*4 ppd_undonlvec - parameter (ppd_undonlvec='080282aa'x) - integer*4 ppd_typenot - parameter (ppd_typenot='080282b2'x) - integer*4 ppd_typchkinv - parameter (ppd_typchkinv='080282ba'x) - integer*4 ppd_typeinv - parameter (ppd_typeinv='080282ca'x) - integer*4 ppd_ioinv - parameter (ppd_ioinv='080282d2'x) - integer*4 ppd_lengthnot - parameter (ppd_lengthnot='080282da'x) - integer*4 ppd_notposint - parameter (ppd_notposint='080282e2'x) - integer*4 ppd_lengthinv - parameter (ppd_lengthinv='080282ea'x) - integer*4 ppd_nvlinvvec - parameter (ppd_nvlinvvec='080282f2'x) - integer*4 ppd_nvlinvchk - parameter (ppd_nvlinvchk='080282fa'x) - integer*4 ppd_mnvalinv - parameter (ppd_mnvalinv='08028302'x) - integer*4 ppd_mxvalinv - parameter (ppd_mxvalinv='0802830a'x) - integer*4 ppd_mmnoval - parameter (ppd_mmnoval='08028312'x) - integer*4 ppd_mmnochk - parameter (ppd_mmnochk='0802831a'x) - integer*4 ppd_mminv - parameter (ppd_mminv='08028322'x) - integer*4 ppd_vcinvnvl - parameter (ppd_vcinvnvl='0802832a'x) - integer*4 ppd_nvcinvnvl - parameter (ppd_nvcinvnvl='08028332'x) - integer*4 ppd_unitinv - parameter (ppd_unitinv='0802833a'x) - integer*4 ppd_searchinv - parameter (ppd_searchinv='08028342'x) - integer*4 ppd_psearch - parameter (ppd_psearch='0802834a'x) - integer*4 ppd_optnoval - parameter (ppd_optnoval='08028352'x) - integer*4 ppd_optnochk - parameter (ppd_optnochk='0802835a'x) - integer*4 ppd_noimage - parameter (ppd_noimage='0802836a'x) - integer*4 ppd_exeuser - parameter (ppd_exeuser='08028371'x) - integer*4 ppd_refexcmax - parameter (ppd_refexcmax='0802837c'x) - integer*4 ppd_glofilnf - parameter (ppd_glofilnf='08028380'x) - integer*4 ppd_parinv - parameter (ppd_parinv='08028392'x) - integer*4 ppd_parnotuni - parameter (ppd_parnotuni='0802839a'x) - integer*4 ppd_invquaval - parameter (ppd_invquaval='080283a2'x) - integer*4 ppd_defvalinv - parameter (ppd_defvalinv='080283aa'x) - integer*4 ppd_intref - parameter (ppd_intref='080283bb'x) - integer*4 ppd_keyambig - parameter (ppd_keyambig='080283c2'x) - integer*4 ppd_lengthlon - parameter (ppd_lengthlon='080283ca'x) -C -C General common block for DWARF (not to be confused with DWARF_4.DEF) -C - INTEGER DWLOG !Printfiles for messages - CHARACTER*130 DWMSG !Message string -C - COMMON /DWC_COM/DWLOG,DWMSG -C - EXTERNAL DWC_BLOCK - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - diff --git a/src/dwarf/dwc.grp b/src/dwarf/dwc.grp deleted file mode 100644 index e899016eff0f138a1957e501d350e88b339235dc..0000000000000000000000000000000000000000 --- a/src/dwarf/dwc.grp +++ /dev/null @@ -1,243 +0,0 @@ -!+ DWC.GRP -! WNB 920915 -! -! Revisions: -! HjV 921104 Add function and entry names -! HjV 930226 Add DWCNEXACT.MVX -! CMV 940119 Removed DWCEXH and PPARG.FOR, -! DWCSYSIN.FOR now .FSC, DWCWAITPR.FOR now .FVX -! CMV 940131 Added DWC.DEF and CLI_1.DEF -! HjV 940217 Add/change missing entry-points/functions -! -! General routines for DWARF programs -! -! Group definition: -! -DWC.GRP -! -! Masks for program development -! -! PIN files -! -! Structure files -! -DWC.DEF ! Include this in all DWARF sources - DWCBLOCK.FOR !DWC_BLOCK -! -DWARF_4.DEF ! Used in dwcask/bell/ctl/.... - DWARFBLOCK.FOR !DWARF_BLOCK -CLI_1.DEf ! Used in CLIBUF only - CLIBLOCK.FOR !CLI_BLOCK -PARM_6.DEF ! Used in gpask/ctl/def/ini/loop/sav/val - PARMBLOCK.FOR !PARM_BLOCK -! -! General command files -! -! -! Initialisation command files -! -! -! Fortran definition files: -! -! -! Programs: -! -ABPRUN.FOR !ABP_RUN_INIT - !ABP_RUN_DO - !ABP_CLEAR - !ABP_RESTORE - !ABP_RUN_SPEC -! -CLI.FOR !CLI_INIT - !CLI_RESET - !CLI_GET - !CLI_PARSE - !CLI_PARSE_P - !CLI_PARSE_X - !CLI_PARSE_Q -CLIBUF.FOR !CLI_BUF_INIT - !CLI_BUF_PUTPAR - !CLI_BUF_PUTQUAL - !CLI_BUF_GET - !CLI_BUF_GETCOM - !CLI_BUF_GETNRS -CLISTR.FOR !CLI_STR - !CLI_STR_INIT Initialize buffer - !CLI_STR_PUT Put string in buffer - !CLI_STR_GET Get string from buffer -! -DWCASK.FOR !DWC_ASK - !DWC_ASK_PUT - !DWC_ASK_INQ -DWCBELL.FOR !DWC_BELL - !DWC_BELL_PUT - !DWC_BELL_INQ -DWCCTL.FOR !DWC_CTL - !DWC_CTL_OPEN - !DWC_CTL_SAVE - !DWC_CTL_UPDATE - !DWC_CTL_FILL - !DWC_CTL_FILL_S -DWCEXPCAL.FOR !DWC_EXPCAL -DWCEXPR.FOR !DWC_EXPR - !DWC_EXPR_SOLVE - !DWC_EXPR_FUNC - !DWC_EXPR_SUBST - !DWC_EXPR_NR - !DWC_EXPR_OPER - !DWC_EXPR_OPER_M - !DWC_EXPR_UNIT - !DWC_EXPR_SUBX - !DWC_EXPR_LOGI -DWCEXTENDSZ.FOR !DWC_EXTENDSZ - !DWC_EXTENDSZ_PUT - !DWC_EXTENDSZ_GET -DWCHELP.FOR !DWC_HELP -DWCIBMODE.FOR !DWC_IBMODE - !DWC_IBMODE_PUT - !DWC_IBMODE_INQ -DWCIDENT.FOR !DWC_IDENT - !DWC_IDENT_GET - !DWC_IDENT_PUT -DWCINPUT.FOR !DWC_INPUT -DWCIOBFSZ.FOR !DWC_IOBFSZ - !DWC_IOBFSZ_PUT - !DWC_IOBFSZ_GET -DWCLEVEL.FOR !DWC_LEVEL - !DWC_LEVEL_PUT - !DWC_LEVEL_GET -DWCLOGFATAL.FOR !DWC_LOGFATAL - !DWC_LOGFATAL_PUT - !DWC_LOGFATAL_INQ -DWCLOGLEVEL.FOR !DWC_LOGLEVEL - !DWC_LOGLEVEL_PUT - !DWC_LOGLEVEL_GET -DWCMSGDEV.FOR !DWC_MSGDEV - !DWC_MSGDEV_PUT - !DWC_MSGDEV_INQ -DWCNEXACT.MVX !DWC_NEXACT -DWCNODE.FOR !DWC_NODE - !DWC_NODE_EXPAND_A - !DWC_NODE_EXPAND - !DWC_NODE_PUT - !DWC_NODE_GET - !DWC_NODE_CHECK - !DWC_NODE_SET -DWCPRCMODE.FOR !DWC_PRCMODE_SET - !DWC_PRCMODE_INQ -DWCPROG.FOR !DWC_PROG_PUT - !DWC_PROG_CHECK - !DWC_PROG_GET -DWCSAVE.FOR !DWC_SAVE - !DWC_SAVE_PUT - !DWC_SAVE_INQ -DWCSTR.FOR !DWC_STR - !DWC_STR_STANDARD - !DWC_STR_SUBST -DWCSTREAM.FOR !DWC_STREAM_PUT - !DWC_STREAM_GET - !DWC_STREAM_CHECK -DWCSYM.FOR !DWC_SYM_SPLIT - !DWC_SYM_BUILD - !DWC_SYM_EXPAND - !DWC_SYM_TRANSL -DWCSYMLIST.FOR !DWC_SYMLIST_EXPAND -DWCSYSIN.FSC !DWC_SYSIN_SET - !DWC_SYSIN_GET -DWCSYSOUT.FOR !DWC_SYSOUT_SET - !DWC_SYSOUT_INQ -DWCTEST.FOR !DWC_TEST - !DWC_TEST_PUT - !DWC_TEST_INQ -DWCTSTSYM.FOR !DWC_TSTSYM -DWCWAITPR.FVX !DWC_WAITPR -! -PROGEND.FOR !PROG_END - !PROG_END_STAT - !PROG_END_EXH -PROGSTART.FOR !PROG_START - !PROG_START_X -! -PUTPARM.FOR !PUT_PARM_N - !PUT_PARM_C -PPCTL.FOR !PP_CTL_OPEN - !PP_CTL_CLOSE -! -GETPARM.FOR !GET_PARM_N - !GET_PARM_C -GPARG.FOR !GP_ARG - !GP_ARG_CHECK -GPASK.FOR !GP_ASK - !GP_ASK_INIT - !GP_ASK_SET - !GP_ASK_INQ -GPCTL.FOR !GP_CTL - !GP_CTL_RESET - !GP_CTL_OPEN - !GP_CTL_CLOSE - !GP_CTL_END -GPDEF.FOR !GP_DEF - !GP_DEF_READ - !GP_DEF_FILL - !GP_DEF_CLEAR - !GP_DEF_RELEASE - !GP_DEF_PUT - !GP_DEF_GET - !GP_DEF1 - !GP_DEF1_ALLOC - !GP_DEF1_GET -GPINI.FOR !GP_INI - !GP_INI_FILL - !GP_INI_DECODE - !GP_INI_CLEAR - !GP_INI_PUT - !GP_INI_GET -GPINP.FOR !GP_INP - !GP_INP_GET - !GP_INP_PARSE - !GP_INP_DECODE -GPLOOP.FOR !GP_LOOP_INIT - !GP_LOOP_SWITCH - !GP_LOOP_SET - !GP_LOOP_RESET -GPSAV.FOR !GP_SAV_INIT - !GP_SAV_SWITCH - !GP_SAV_WRITE - !GP_SAV_DEFINE -GPVAL.FOR !GP_VAL - !GP_VAL_READ_N - !GP_VAL_READ_C - !GP_VAL_FILL - !GP_VAL_CLEAR - !GP_VAL_RELEASE - !GP_VAL_PUT - !GP_VAL_GET -! -PVBLK.FOR !PV_BLK - !PV_BLK_ALLOC - !PV_BLK_RELEASE - !PV_BLK_READ - !PV_BLK_ENCODE - !PV_BLK_DECODE -PVDEF.FOR !PV_DEF - !PV_DEF_GET - !PV_DEF_DECODE - !PV_DEF_ENCODE -PVSET.FOR !PV_SET - !PV_SET_ENCODE - !PV_SET_DECODE - !PV_SET_DECODE_C - !PV_SET_DECODE_N - !PV_SET_READ - !PV_SET_TOBY_C - !PV_SET_TOBY_X -PVVAL.FOR !PV_VAL - !PV_VAL_ENCODE - !PV_VAL_ENCODE_C - !PV_VAL_ENCODE_N - !PV_VAL_DECODE_N -! -UDFUNIT.FOR !READ_UNIT - !READ_UNITG - !READ_UNITG_ALL -!- diff --git a/src/dwarf/dwcask.for b/src/dwarf/dwcask.for deleted file mode 100644 index 2a0badf18960e786cf57a01c568f28ced8995cf3..0000000000000000000000000000000000000000 --- a/src/dwarf/dwcask.for +++ /dev/null @@ -1,74 +0,0 @@ -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ -C.Ident: DWC_ASK -C.Keywords: DWARF, Ask Switch -C.Author: Friso Olnon (NFRA, Dwingeloo) -C.Language: DWARF-Fortran -C.Environment: VAX or Alliant -C.Comments: -C Common fields used: -C INTEGER*4 DWARF$ASK ! (m) ask enabled ? -C -C.Version: 900318 FMO - creation -C------------------------------------------------------------------------- -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - INTEGER*4 FUNCTION DWC_ASK () -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' -C -C -C.Purpose: Make source module name known -C.Returns: Status code (.TRUE. for success, .FALSE. otherwise) -C success DWC_SUCCESS -C.Notes: Dummy routine -C------------------------------------------------------------------------- -C -C - DWC_ASK = DWC_SUCCESS - RETURN - END -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - INTEGER*4 FUNCTION DWC_ASK_PUT (SWITCH) -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' -C - LOGICAL*4 SWITCH ! (i) switch ON ? -C -C.Purpose: Enable or disable DWARF's ask -C.Returns: Status code (.TRUE. for success, .FALSE. otherwise) -C success DWC_SUCCESS -C.Notes: -C------------------------------------------------------------------------- -C - INCLUDE 'DWARF_4_DEF' -C -C - IF (SWITCH) THEN - DWARF$ASK = 1 - ELSE - DWARF$ASK = 0 - ENDIF -C - DWC_ASK_PUT = DWC_SUCCESS - RETURN - END -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - INTEGER*4 FUNCTION DWC_ASK_INQ () -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' -C -C -C.Purpose: Is DWARF's ask enabled ? -C.Returns: Status code (.TRUE. for success, .FALSE. otherwise) -C success 1 yes -C warning 0 no -C.Notes: -C------------------------------------------------------------------------- -C - INCLUDE 'DWARF_4_DEF' -C - DWC_ASK_INQ = DWARF$ASK - RETURN - END diff --git a/src/dwarf/dwcbell.for b/src/dwarf/dwcbell.for deleted file mode 100644 index 0656057c37b030dacfdfc055c9da05ae3d2982e6..0000000000000000000000000000000000000000 --- a/src/dwarf/dwcbell.for +++ /dev/null @@ -1,74 +0,0 @@ -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ -C.Ident: DWC_BELL -C.Keywords: DWARF, Bell Switch -C.Author: Friso Olnon (NFRA, Dwingeloo) -C.Language: DWARF-Fortran -C.Environment: VAX or Alliant -C.Comments: -C Common fields used: -C INTEGER*4 DWARF$BELL ! (m) bell enabled ? -C -C.Version: 900318 FMO - creation -C------------------------------------------------------------------------- -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - INTEGER*4 FUNCTION DWC_BELL () -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' -C -C -C.Purpose: Make source module name known -C.Returns: Status code (.TRUE. for success, .FALSE. otherwise) -C success DWC_SUCCESS -C.Notes: Dummy routine -C------------------------------------------------------------------------- -C -C - DWC_BELL = DWC_SUCCESS - RETURN - END -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - INTEGER*4 FUNCTION DWC_BELL_PUT (SWITCH) -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' -C - LOGICAL*4 SWITCH ! (i) switch ON ? -C -C.Purpose: Enable or disable DWARF's bell signal -C.Returns: Status code (.TRUE. for success, .FALSE. otherwise) -C success DWC_SUCCESS -C.Notes: -C------------------------------------------------------------------------- -C - INCLUDE 'DWARF_4_DEF' -C -C - IF (SWITCH) THEN - DWARF$BELL = 1 - ELSE - DWARF$BELL = 0 - ENDIF -C - DWC_BELL_PUT = DWC_SUCCESS - RETURN - END -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - INTEGER*4 FUNCTION DWC_BELL_INQ () -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' -C -C -C.Purpose: Is DWARF's bell enabled ? -C.Returns: Status code (.TRUE. for success, .FALSE. otherwise) -C success 1 yes -C warning 0 no -C.Notes: -C------------------------------------------------------------------------- -C - INCLUDE 'DWARF_4_DEF' -C - DWC_BELL_INQ = DWARF$BELL - RETURN - END diff --git a/src/dwarf/dwcblock.for b/src/dwarf/dwcblock.for deleted file mode 100644 index a4474fb6e7e5387a8e4e2d77878b1387d03c2ee2..0000000000000000000000000000000000000000 --- a/src/dwarf/dwcblock.for +++ /dev/null @@ -1,21 +0,0 @@ -C+DWCBLOCK.FOR -C CMV 940131 -C -C 010709 AXC linux port, data init -C -C Block data for DWC.DEF -C - BLOCK DATA DWC_BLOCK -C -C -C General common block for DWARF (not to be confused with DWARF_4.DEF) -C - INTEGER DWLOG !Printfiles for messages - CHARACTER*130 DWMSG !Message string -C - COMMON /DWC_COM/DWLOG,DWMSG -C - DATA DWLOG/1/ !Terminal (==F_T) - DATA DWMSG/' '/ -C - END diff --git a/src/dwarf/dwcctl.for b/src/dwarf/dwcctl.for deleted file mode 100644 index 0b372e1b35c2ab40fb3e03897c221e5d72bf8ae1..0000000000000000000000000000000000000000 --- a/src/dwarf/dwcctl.for +++ /dev/null @@ -1,445 +0,0 @@ -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ -C.Ident: DWC_CTL -C.Keywords: DWARF, Program, Control -C.Author: Friso Olnon (NFRA, Dwingeloo) -C.Language: DWARF-Fortran -C.Environment: VAX or Alliant -C.Comments: -C Common fields used: -C INTEGER*4 DWARF_(*) ! (m) all fields -C -C.Version: 900416 FMO - recreation -C.Version: 920214 GvD - no optional arguments in MSG anymore -C.Version: 940120 CMV - use indirect addressing (A_B) -C 940209 WNB - compiler problems -C.Version: 010709 AXC - ichar -C------------------------------------------------------------------------- -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - INTEGER*4 FUNCTION DWC_CTL () -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' -C -C -C.Purpose: Make source module name known -C.Returns: Status code (.TRUE. for success, .FALSE. otherwise) -C success DWC_SUCCESS always -C.Notes: Dummy routine -C------------------------------------------------------------------------- -C - DWC_CTL = DWC_SUCCESS - RETURN - END -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - INTEGER*4 FUNCTION DWC_CTL_OPEN () -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' - INCLUDE 'DWARF_4_DEF' -C -C -C.Purpose: Get DWARF control parameters in common -C.Returns: Status code (.TRUE. for success, .FALSE. otherwise) -C success DWC_SUCCESS -C error DWC_UNKDWCOM symbol not defined (no message stored) -C false status code returned by referenced routines -C.Notes: -C - The parameters are kept in the symbol DWARF_CONTROL_COMMON. The value -C of that symbol will overlay DWARF's control common. -C - If the symbol doesn't exist, the common contains its initial values. -C - Only SPECIFY can create the control symbol. -C------------------------------------------------------------------------- -C - INTEGER*4 SYMBOL_GET, MOVE_BLB -C - CHARACTER WORK*255,DCOM*40 - INTEGER*4 IS, LW -C -C - DCOM='DWARF_CONTROL_COMMON' - IS = SYMBOL_GET (DCOM,WORK,LW) - IF (IAND(IS,1).EQ.0) GOTO 999 - IF (LW.EQ.0) GOTO 998 -C - IS = MOVE_BLB (%REF(WORK),DWARF_,LW) - IF (IAND(IS,1).EQ.0) GOTO 999 -C - DWC_CTL_OPEN = DWC_SUCCESS - RETURN - 998 DWC_CTL_OPEN = DWC_UNKDWCOM - RETURN - 999 DWC_CTL_OPEN = IS - RETURN - END -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - INTEGER*4 FUNCTION DWC_CTL_SAVE () -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' - INCLUDE 'DWARF_4_DEF' -C -C -C.Purpose: Save DWARF control parameters -C.Returns: Status code (.TRUE. for success, .FALSE. otherwise) -C success DWC_SUCCESS -C false status code returned by referenced routines -C.Notes: -C - The parameters are saved in the symbol DWARF_CONTROL_COMMON. -C The value of that symbol will overlay DWARF's control common. -C - Only SPECIFY can create the control symbol. -C------------------------------------------------------------------------- -C - INTEGER*4 SYMBOL_DEFINE, MOVE_BLB -C - CHARACTER WORK*255 - INTEGER*4 IS -C -C - IS = MOVE_BLB (DWARF_,%REF(WORK),DWARF__LENGTH*4) - IF (IAND(IS,1).NE.0) IS = SYMBOL_DEFINE ('DWARF_CONTROL_COMMON', - 1 WORK(:DWARF__LENGTH*4),DWC__GLOBALSYM) - IF (IAND(IS,1).EQ.0) GOTO 999 -C - DWC_CTL_SAVE = DWC_SUCCESS - RETURN - 999 DWC_CTL_SAVE = IS - RETURN - END -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - INTEGER*4 FUNCTION DWC_CTL_UPDATE (PROG) -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' -C - CHARACTER*(*) PROG ! (i) program name -C -C.Purpose: Update the program control parameters -C.Returns: Status code (.TRUE. for success, .FALSE. otherwise) -C success DWC_SUCCESS -C false status code returned by referenced routines -C.Notes: -C - The updates (if any) are kept in the symbol DWARF_<prog>_CONTROL -C that was defined by EXECUTE.EXE. -C - Most program control parameters are in DWARF's control common, -C but some are still in PARM's control common. The relevant fields will -C be changed via the relevant routines. -C------------------------------------------------------------------------- -C - INTEGER*4 DWC_PROG_PUT, DWC_PROG_GET, DWC_STREAM_PUT - INTEGER*4 DWC_ASK_PUT, DWC_SAVE_PUT, DWC_TEST_PUT - INTEGER*4 DWC_PRCMODE_SET, DWC_SYSIN_SET, DWC_SYSOUT_SET - INTEGER*4 SYMBOL_GET, GEN_FORIOS -C - CHARACTER PROGNAM*16, WORK*255, INFILE*80, DCOM*40 - INTEGER*4 IS, LP, LW, LI, LS, PTR - INTEGER*4 ASKSW, SAVESW, TESTSW -C -C -C Check and store the program name -C - IS = DWC_PROG_PUT (PROG) - IF (IAND(IS,1).NE.0) IS = DWC_PROG_GET (PROGNAM,LP) - IF (IAND(IS,1).EQ.0) GOTO 999 -C -C Get and store the updates -C - DCOM='DWARF_'//PROGNAM(:LP)//'_CONTROL' - IS = SYMBOL_GET (DCOM,WORK,LW) - IF (IAND(IS,1).EQ.0) GOTO 999 - IF (LW.EQ.0) THEN - LI = 0 - ELSE - READ (WORK(:5),'(3I1,I2)',ERR=998) ASKSW,SAVESW,TESTSW,LS - PTR = 6 - IF (ASKSW.NE.0) IS = DWC_ASK_PUT (ASKSW.EQ.2) - IF (IAND(IS,1).NE.0 .AND. SAVESW.NE.0) - 1 IS = DWC_SAVE_PUT (SAVESW.EQ.2) - IF (IAND(IS,1).NE.0 .AND. TESTSW.NE.0) - 1 IS = DWC_TEST_PUT (TESTSW.EQ.2) - IF (IAND(IS,1).NE.0 .AND. LS.GT.0) - 1 IS = DWC_STREAM_PUT (WORK(6:PTR+LS-1)) - IF (IAND(IS,1).EQ.0) GOTO 999 - PTR = PTR+LS - READ (WORK(PTR:PTR+1),'(I2)',ERR=998) LI - PTR = PTR+2 - IF (LI.GT.0) INFILE = WORK(PTR:PTR+LI-1) - ENDIF -C -C Set process mode and standard -C input and output devices -C (in this order !!!) -C - IF (IAND(IS,1).NE.0) IS = DWC_PRCMODE_SET () ! process mode - IF (IAND(IS,1).NE.0) IS = DWC_SYSIN_SET (INFILE,LI) ! standard input - IF (IAND(IS,1).NE.0) IS = DWC_SYSOUT_SET () ! standard output - IF (IAND(IS,1).EQ.0) GOTO 999 -C -C - DWC_CTL_UPDATE = DWC_SUCCESS - RETURN - 998 DWC_CTL_UPDATE = GEN_FORIOS ('work_string') - RETURN - 999 DWC_CTL_UPDATE = IS - RETURN - END -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - INTEGER*4 FUNCTION DWC_CTL_FILL () -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' -C -C -C.Purpose: Fill the DWARF common and define the symbol DWARF_CONTROL_COMMON -C.Returns: Status code (.TRUE. for success, .FALSE. otherwise) -C success DWC_SUCCESS -C fatal DWC_DWSERROR error while interpreting DWARF symbols -C.Notes: -C The value of the symbol will be the string equivalent of the common -C array DWARF_. -C------------------------------------------------------------------------- -C - CHARACTER*(*) PROGNAM, STREAM, BLANK - PARAMETER (PROGNAM = 'DWARF') - PARAMETER (STREAM = '$0' ) - PARAMETER (BLANK = ' ' ) -C - INTEGER*4 PPD_INIT, PPD_EXIT, PPD_READ_U, PPD_READ_UNXT - INTEGER*4 PPD_PNAM_GET - INTEGER*4 CLI_RESET, CLI_PARSE, CLI_GET - INTEGER*4 DWC_CTL_FILL_S, DWC_CTL_SAVE - INTEGER*4 DWC_SYM_BUILD, DWC_STR_SUBST, DWC_HELP - INTEGER*4 PV_DEF_GET - INTEGER*4 PV_BLK_ALLOC, PV_BLK_DECODE, PV_BLK_RELEASE - INTEGER MSG_SET -C - INTEGER*4 NRARG - PARAMETER (NRARG = 1) - CHARACTER*10 NAME(NRARG) - INTEGER*4 ATTR(NRARG) - CHARACTER*1 PROMPT(NRARG) - CHARACTER*1 DEFVAL(NRARG) - DATA NAME /'VALSTR' / - DATA ATTR /CLI__EXPRESSION/ - DATA PROMPT /' ' / - DATA DEFVAL /' ' / -C - CHARACTER VALSTR*255, WORK*255, KEY*16, SYMBOL*38, TYPE*1 - INTEGER*4 LVAL, LW, LK, LS, LT - INTEGER*4 IS, ERRPTR, DLEVEL, TMP, VALBLK(8) - LOGICAL*4 SWSYM - BYTE DEFARR(1) ! dummy -C -C -C Open the PPD file and loop -C through all DWARF parameters -C - IS = PPD_INIT (PROGNAM) - IF (IAND(IS,1).NE.0) IS = PPD_READ_U (BLANK) - IF (IAND(IS,1).EQ.0) GOTO 999 - DO WHILE (IAND(IS,7).EQ.1) -C -C Get program's parameter name -C and its default value -C - IS = PPD_PNAM_GET (KEY,LK) - IF (IAND(IS,1).NE.0) - 1 IS = DWC_SYM_BUILD (PROGNAM,STREAM,KEY(:LK),SYMBOL,LS) - IF (IAND(IS,1).NE.0) - 1 IS = PV_DEF_GET (SYMBOL(:LS),VALSTR,LVAL,TYPE,LT) - IF (IAND(IS,1).EQ.0) GOTO 999 - IF (LVAL.EQ.0) GOTO 991 -C -C Substitute symbols -C - SWSYM = .FALSE. - IS = DWC_STR_SUBST (VALSTR(:LVAL),WORK,LW,STREAM,ERRPTR, - 1 .FALSE.,SWSYM) - IF (IAND(IS,1).EQ.0) GOTO 992 -C -C If help request (not allowed): return -C - IS = DWC_HELP (WORK(:LW),-1,DLEVEL) - IF (IAND(IS,1).EQ.0) GOTO 999 -C -C Analyse the string -C - reset the Command-Line Interpreter -C - parse the string -C - extract the pure value string -C - IS = CLI_RESET (NRARG,NAME,ATTR,PROMPT,DEFVAL) - IF (IAND(IS,1).NE.0) IS = CLI_PARSE (WORK(:LW)) - IF (IAND(IS,1).NE.0) IS = CLI_GET ('VALSTR',VALSTR,LVAL) - IF (IAND(IS,1).EQ.0) GOTO 999 - IF (LVAL.EQ.0) GOTO 991 -C -C Check the value string -C - allocate memory for the value block -C - convert value string to value block -C - IS = PV_BLK_ALLOC (VALSTR(:LVAL),VALBLK) - IF (IAND(IS,1).EQ.0) GOTO 999 -C - IS = PV_BLK_DECODE (VALSTR(:LVAL),VALBLK,STREAM, - 1 .FALSE.,SWSYM,.TRUE.,DEFARR,0) -C -C Put the values in the DWARF common -C and release virtual memory -C - IF (IAND(IS,1).NE.0) IS = DWC_CTL_FILL_S (KEY(:LK),VALBLK(7), - 1 A_B(VALBLK(2)-A_OB), - 1 A_B(VALBLK(3)-A_OB)) - TMP = PV_BLK_RELEASE (VALBLK) - IF (IAND(IS,1).NE.0) IS = PPD_READ_UNXT () - IF (IAND(IS,1).EQ.0) GOTO 999 - ENDDO -C -C Define the control symbol -C - IS = DWC_CTL_SAVE () - IF (IAND(IS,1).EQ.0) GOTO 999 -C -C - IS = PPD_EXIT () - DWC_CTL_FILL = DWC_SUCCESS - RETURN - 991 IS = MSG_SET (DWC_NODWVALUE,1) - CALL WNCTXT(DWLOG,DWMSG,SYMBOL(:LS)) - GOTO 999 - 992 IS = MSG_SET (DWC_EXPERRMSG,1) - CALL WNCTXT(DWLOG,DWMSG,'keyword '//KEY(:LK),ERRPTR,WORK(:LW)) - 999 DWC_CTL_FILL = MSG_SET(DWC_DWSERROR,0) - RETURN - END -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - INTEGER*4 FUNCTION DWC_CTL_FILL_S (KEYWORD,LVAL,NRVAL,ARR) -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' -C - CHARACTER*(*) KEYWORD ! (i) program keyword - INTEGER*4 LVAL ! (i) length of value (in bytes) - INTEGER*4 NRVAL ! (i) number of values in value array - BYTE ARR(*) ! (i) value array -C -C.Purpose: Put the value of a DWARF parameter into the DWARF common -C.Returns: Status code (.TRUE. for success, .FALSE. otherwise) -C success DWC_SUCCESS -C fatal DWC_UNKDWKEY unknown DWARF keyword -C.Notes: -C------------------------------------------------------------------------- -C - INTEGER*4 DWC_ASK_PUT, DWC_BELL_PUT, DWC_EXTENDSZ_PUT - INTEGER*4 DWC_IBMODE_PUT, DWC_IDENT_PUT, DWC_IOBFSZ_PUT - INTEGER*4 DWC_LEVEL_PUT, DWC_LOGFATAL_PUT, DWC_LOGLEVEL_PUT - INTEGER*4 DWC_MSGDEV_PUT, DWC_NODE_PUT, DWC_SAVE_PUT - INTEGER*4 DWC_STREAM_PUT, DWC_TEST_PUT - INTEGER MSG_SET, MOVE_BLB -C - CHARACTER*255 WORK - INTEGER*4 IS -C -C -C Stream name -C - IF (KEYWORD.EQ.'STREAM') THEN - IS = MOVE_BLB (ARR,%REF(WORK),LVAL) - IF (IAND(IS,1).NE.0) IS = DWC_STREAM_PUT (WORK(:LVAL)) -C -C Userlevel -C - ELSE IF (KEYWORD.EQ.'USERLEVEL') THEN - IF (ARR(1).EQ.ICHAR('E')) THEN ! expert - IS = DWC_LEVEL_PUT (0) - ELSE IF (ARR(1).EQ.ICHAR('A')) THEN ! average - IS = DWC_LEVEL_PUT (1) - ELSE - IS = DWC_LEVEL_PUT (2) ! beginner (default) - ENDIF -C -C Message device(s) -C - ELSE IF (KEYWORD.EQ.'MESSAGEDEVICE') THEN - IF (ARR(1).EQ.ICHAR('P')) THEN ! printer - IS = DWC_MSGDEV_PUT (1) - ELSE IF (NRVAL.LE.1) THEN ! terminal (default) - IS = DWC_MSGDEV_PUT (0) - ELSE - IS = DWC_MSGDEV_PUT (2) ! both - ENDIF -C -C Terminal bell -C - ELSE IF (KEYWORD.EQ.'BELL') THEN - IS = DWC_BELL_PUT (ARR(2).EQ.ICHAR('N')) ! on or off (default) - -C -C Buffer size for bulk-IO -C - ELSE IF (KEYWORD.EQ.'IOBUFSIZE') THEN - IS = DWC_IOBFSZ_PUT (ARR) -C -C Minimum extendsize for disk files -C - ELSE IF (KEYWORD.EQ.'EXTENDSIZE') THEN - IS = DWC_EXTENDSZ_PUT (ARR) -C -C Current node name -C - ELSE IF (KEYWORD.EQ.'CURNODE') THEN - IS = MOVE_BLB (ARR,%REF(WORK),LVAL) - IF (IAND(IS,1).NE.0) IS = DWC_NODE_PUT (WORK(:LVAL)) -C -C Ask switch -C - ELSE IF (KEYWORD.EQ.'ASK') THEN - IS = DWC_ASK_PUT (ARR(1).EQ.ICHAR('Y')) ! on or off (default) -C -C Savelast switch -C - ELSE IF (KEYWORD.EQ.'SAVELAST') THEN - IS = DWC_SAVE_PUT (ARR(1).EQ.ICHAR('Y')) ! on or off (default) -C -C Test switch -C - ELSE IF (KEYWORD.EQ.'TEST') THEN - IS = DWC_TEST_PUT (ARR(1).EQ.ICHAR('Y')) ! on or off (default) -C -C Loglevel -C - ELSE IF (KEYWORD.EQ.'LOGLEVEL') THEN - IS = DWC_LOGLEVEL_PUT (ARR) -C -C Log switch for fatal runs -C - ELSE IF (KEYWORD.EQ.'LOGFATAL') THEN - IS = DWC_LOGFATAL_PUT (ARR(1).EQ.ICHAR('Y')) ! on or off (default) -C -C Login identification string -C - ELSE IF (KEYWORD.EQ.'IDENT') THEN - IS = MOVE_BLB (ARR,%REF(WORK),LVAL) - IF (IAND(IS,1).NE.0) IS = DWC_IDENT_PUT (WORK(:LVAL)) -C -C Mode -C - ELSE IF (KEYWORD.EQ.'IBMODE') THEN - IF (ARR(1).EQ.ICHAR('B')) THEN - IS = DWC_IBMODE_PUT (1) ! batch - ELSE - IS = DWC_IBMODE_PUT (0) ! interactive (default) - ENDIF -C -C Unknown DWARF parameter -C - ELSE - IS = MSG_SET (DWC_UNKDWKEY,1) - CALL WNCTXT(DWLOG,DWMSG,KEYWORD) - ENDIF - IF (IAND(IS,1).EQ.0) GOTO 999 -C -C - DWC_CTL_FILL_S = DWC_SUCCESS - RETURN - 999 DWC_CTL_FILL_S = IS - RETURN - END diff --git a/src/dwarf/dwcexpcal.for b/src/dwarf/dwcexpcal.for deleted file mode 100644 index e6b3daf1eb5dc2009dec6a42d3d0d2467dd39986..0000000000000000000000000000000000000000 --- a/src/dwarf/dwcexpcal.for +++ /dev/null @@ -1,81 +0,0 @@ -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ -C.Ident: DWC_EXPCAL -C.Keywords: DWARF Expression, Evaluate -C.Author: Ger van Diepen (NFRA, Dwingeloo) -C.Language: DWARF-Fortran -C.Environment: VAX or Alliant -C.Comments: -C.Version: 820715 GVD - creation DWCEXPCAL -C.Version: 840622 GVD - replaced UDF_RDUNI by READ_UNIT -C.Version: 900110 FMO - Remove obsolete arg's UNIADR and UNISIZE -C.Version: 900111 FMO - Catch unit '1' (i.e. no unit) -C.Version: 900321 FMO - use DWC_EXPR_SOLVE -C.Version: 900416 FMO - logical*4 arguments -C------------------------------------------------------------------------- -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - INTEGER*4 FUNCTION DWC_EXPCAL (STRING,UNITSTR,STREAM,CHKSW, - 1 SWSYM,RESULT,ERRPTR) -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' -C - CHARACTER*(*) STRING ! (m) expression - CHARACTER*(*) UNITSTR ! (i) possible unit codes - CHARACTER*(*) STREAM ! (i) stream name for DWARF symbol names - LOGICAL*4 CHKSW ! (i) unknown symbols allowed ? - LOGICAL*4 SWSYM ! (m) unknown symbols found ? - REAL*8 RESULT ! (o) value - INTEGER*4 ERRPTR ! (o) position of error in STRING -C -C.Purpose: Evaluate an expression to a REAL*8 value -C.Returns: Status code (.TRUE. for success, .FALSE. otherwise) -C success DWC_SUCCESS -C false status code from READ_UNIT or DWC_EXPR_SOLVE -C.Notes: -C - The first code in the unit string is the default unit code. The -C result of the calculation will be expressed in that unit. The default -C unit for trigonometric functions will be degrees. -C------------------------------------------------------------------------- -C -C - CHARACTER*(*) BLANK, COMMA, DEFUNIT - PARAMETER (BLANK = ' ') - PARAMETER (COMMA = ',') - PARAMETER (DEFUNIT = 'DEG') -C - INTEGER*4 DWC_EXPR_SOLVE, STR_COPY_U, READ_UNIT -C - CHARACTER*10 UNIT, GROUP - INTEGER*4 IS, LU, PTR - REAL*8 FACTOR -C -C -C -C Get the default unit -C - IF (UNITSTR.EQ.BLANK) THEN - UNIT = DEFUNIT - ELSE - UNIT = ' ' - LU = 0 - PTR = 1 - IS = STR_COPY_U (COMMA,UNITSTR,PTR,UNIT,LU) - IF (UNIT(:LU).EQ.'1') UNIT = DEFUNIT - ENDIF -C -C Get the conversion factor -C and evaluate the expression -C - ERRPTR = 0 - IS = READ_UNIT (UNIT,GROUP,FACTOR) - IF (IAND(IS,1).NE.0) IS = DWC_EXPR_SOLVE - 1 (STRING,STREAM,FACTOR,UNITSTR,RESULT,ERRPTR,CHKSW,SWSYM) - IF (IAND(IS,1).EQ.0) GOTO 999 -C -C - DWC_EXPCAL = DWC_SUCCESS - RETURN -C - 999 DWC_EXPCAL = IS - RETURN - END diff --git a/src/dwarf/dwcexpr.for b/src/dwarf/dwcexpr.for deleted file mode 100644 index 585d36adf28cff12cd4f68e4c27f916e6351ee67..0000000000000000000000000000000000000000 --- a/src/dwarf/dwcexpr.for +++ /dev/null @@ -1,1167 +0,0 @@ -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ -C.Ident: DWC_EXPR -C.Keywords: DWARF Expression -C.Author: Friso Olnon (NFRA, Dwingeloo) -C.Language: DWARF-Fortran -C.Environment: VAX or Alliant -C.Comments: -C.Version: 900416 FMO - recreation -C.Version: 920214 GvD - no optional arguments in MSG anymore -C - use argument PAR iso. I in error message in _SUBX -C.Version: 010709 AXC - linux port - exatr real*8R2 -C------------------------------------------------------------------------- -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - INTEGER*4 FUNCTION DWC_EXPR () -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' -C -C -C.Purpose: Make source module name known -C.Returns: Status code (.TRUE. for success, .FALSE. otherwise) -C success DWC_SUCCESS -C.Notes: Dummy routine -C------------------------------------------------------------------------- -C - DWC_EXPR = DWC_SUCCESS - RETURN - END -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - INTEGER*4 FUNCTION DWC_EXPR_SOLVE (STRING,STREAM,FACUNIT,UNITSTR, - 1 ANSWER,PTR,CHKSW,SWSYM) -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' -C - CHARACTER*(*) STRING ! (m) expression - CHARACTER*(*) STREAM ! (i) stream name for symbol names - REAL*8 FACUNIT ! (i) conversion factor (-> def unit) - CHARACTER*(*) UNITSTR ! (i) possible unit codes - REAL*8 ANSWER ! (o) result - INTEGER*4 PTR ! (o) position of possible error - LOGICAL*4 CHKSW ! (i) unknown symbols allowed ? - LOGICAL*4 SWSYM ! (m) unknown symbols found ? -C -C.Purpose: Check the syntax of an expression and solve it -C.Returns: Status code (.TRUE. for success, .FALSE. otherwise) -C success DWC_SUCCESS -C error DWC_TOODEENES subexpressions too deeply nested -C error DWC_TOOMANYNR too many numbers in subexpression -C error DWC_NOTAFTOP nothing found after last operator -C error DWC_UNBPAREN unbalanced parentheses -C false status codes returned by referenced routines -C.Notes: -C - Parentheses can be used to create subexpressions for changing the -C normal arithmetical priorities. Up to 10 levels are allowed, with in -C each level up to 10 numbers. -C - Unary operators ('+', '-' and .NOT.) create a new subexpression which -C ends before the next binary operator with the same or lower priority -C than the unary operator. -C - The numbers and operators in each subexpression are kept in arrays. -C When the end of the subexpression is encountered (end of unary reach, -C closing parenthesis ')', or end-of-expression), it will be evaluated -C and the result will be stored in the level above. -C - The calculation is done in real*8. -C - It's possible to use symbols in the expression. They will be -C substituted in the string with parentheses around them to ensure -C the correct arithmetical order. -C As a consequence, STRING might change. -C------------------------------------------------------------------------- -C - CHARACTER*(*) BLANK, OPPAR - INTEGER*4 MAXLEV, MAXNNR - PARAMETER (BLANK = ' ') - PARAMETER (OPPAR = '(') - PARAMETER (MAXLEV = 20) ! max depth of subexpressions - PARAMETER (MAXNNR = 100) ! max nr of numbers in expr -C - INTEGER*4 DWC_EXPR_FUNC, DWC_EXPR_NR, DWC_EXPR_OPER - INTEGER*4 DWC_EXPR_SUBX, DWC_EXPR_SUBST, DWC_EXPR_UNIT - INTEGER*4 STR_SIGLEN, STR_CHECK_ALPH, STR_SKIP_W - INTEGER MSG_SET -C - INTEGER*4 LEV, UNARY, TOTNNR - INTEGER*4 UNOP(MAXLEV), NNR(MAXLEV) - INTEGER*4 FUNC(MAXLEV), NPAR(MAXLEV), STN(MAXLEV) - INTEGER*4 OPER(MAXNNR) - REAL*8 NR(MAXNNR) - REAL*8 NUM - INTEGER*4 IS, LSTR, FUN, PAR, NSUBST - LOGICAL*4 FOUND_OP, START_SUB, END_SUB, END_STRING -C -C - ANSWER = 0 - LSTR = STR_SIGLEN (STRING) - PTR = 1 -C - TOTNNR = 0 ! total nr of numbers - LEV = 1 ! current subexpression level - NNR(LEV) = 0 ! nr of numbers (and op codes) - STN(LEV) = 1 ! start of first number in NR - FUNC(LEV) = 0 ! function code - UNOP(LEV) = 0 ! unary operator code - NSUBST = 0 ! nr of symbol substitutions -C -C - FOUND_OP = .TRUE. - DO WHILE (PTR.LE.LSTR) - FUN = 0 - UNARY = 0 -C -C Start of subexpression ? -C - IS = STR_SKIP_W (BLANK,STRING(:LSTR),PTR) ! skip blanks - START_SUB = STRING(PTR:PTR).EQ.OPPAR -C -C Unary operator ? -C - IF (.NOT.START_SUB) THEN - IF (STRING(PTR:PTR).EQ.'+') THEN - UNARY = 4 - ELSE IF (STRING(PTR:PTR).EQ.'-') THEN - UNARY = 5 - ELSE IF (STRING(PTR:PTR+4).EQ.'.NOT.') THEN - UNARY = 16 - PTR = PTR+4 - ENDIF - START_SUB = UNARY.NE.0 - ENDIF -C -C Function or symbol name? -C - if function: determine code -C and nr of possible parameters -C - if symbol name: substitute -C (put value between parentheses) -C - IF (.NOT.START_SUB) THEN - FOUND_OP = .FALSE. - IF (IAND(STR_CHECK_ALPH(STRING(PTR:PTR)),1) .NE. 0) THEN - IS = DWC_EXPR_FUNC (STRING,LSTR,PTR,FUN,PAR) - IF (IAND(IS,1).EQ.0) GOTO 999 ! unknown function - IF (FUN.LT.0) THEN ! symbol name - IS = DWC_EXPR_SUBST (STRING,LSTR,PTR,-FUN,STREAM, - 1 CHKSW,SWSYM,NSUBST) - IF (IAND(IS,1).EQ.0) GOTO 999 ! substitution error - ENDIF - START_SUB = .TRUE. - ENDIF - ENDIF -C -C If start subexpression: -C - go 1 level deeper -C - IF (START_SUB) THEN - LEV = LEV+1 - IF (LEV.GT.MAXLEV) GOTO 991 ! too deep a level - NNR(LEV) = 0 ! nr of REAL*8 numbers - STN(LEV) = TOTNNR+1 ! start of 1st nr in NR - FUNC(LEV) = FUN ! function code - NPAR(LEV) = PAR ! nr of parameters - UNOP(LEV) = UNARY ! unary operator - PTR = PTR+1 ! 1-st pos in subexpr -C -C Otherwise: -C - extract number -C - ELSE - IS = STR_SKIP_W (BLANK,STRING(:LSTR),PTR) ! skip blanks - IS = DWC_EXPR_NR (STRING,LSTR,PTR,NUM) - IF (IAND(IS,1).EQ.0) GOTO 999 ! extraction error - 200 NNR(LEV) = NNR(LEV)+1 ! make room for number - TOTNNR = TOTNNR +1 - IF (TOTNNR.GT.MAXNNR) GOTO 992 ! too many numbers -C -C - extract unit and scale number -C - store number in array -C - IS = STR_SKIP_W (BLANK,STRING(:LSTR),PTR) ! skip blanks - IS = DWC_EXPR_UNIT (STRING,LSTR,PTR,NUM,FACUNIT,UNITSTR) - IF (IAND(IS,1).EQ.0) GOTO 999 ! scaling error - NR(TOTNNR) = NUM -C -C - extract and store operator -C - IS = DWC_EXPR_OPER (STRING,LSTR,PTR,OPER(TOTNNR), - 1 UNOP(LEV),LEV) - IF (IAND(IS,1).EQ.0) GOTO 999 ! syntax error - END_STRING = OPER(TOTNNR).EQ.0 - END_SUB = OPER(TOTNNR).EQ.-1 -C -C If end of subexpression: -C - evaluate it -C - go 1 level up -C - IF (END_SUB) THEN - IS = DWC_EXPR_SUBX (NR(STN(LEV)),OPER(STN(LEV)),UNOP(LEV), - 1 NNR(LEV),FUNC(LEV),NPAR(LEV),FACUNIT,NUM,SWSYM) - IF (IAND(IS,1).EQ.0) GOTO 999 ! evaluation error - TOTNNR = TOTNNR-NNR(LEV) - LEV = LEV-1 - GOTO 200 ! fill in the nr - ENDIF - IF (.NOT.END_STRING) FOUND_OP = .TRUE. ! operator found - ENDIF - ENDDO -C -C Evaluate whole expression -C - IF (FOUND_OP) GOTO 993 ! ends with operator - IF (LEV.NE.1) GOTO 994 ! unbalanced parenth's - IS = DWC_EXPR_SUBX (NR,OPER,UNOP,NNR,FUNC,NPAR,FACUNIT, - 1 ANSWER,SWSYM) - IF (IAND(IS,1).EQ.0) GOTO 999 -C -C - DWC_EXPR_SOLVE = DWC_SUCCESS - PTR = 0 - RETURN -C - 991 DWC_EXPR_SOLVE = MSG_SET (DWC_TOODEENES,1) - CALL WNCTXT(DWLOG,DWMSG,MAXLEV) - RETURN -C - 992 DWC_EXPR_SOLVE = MSG_SET (DWC_TOOMANYNR,1) - CALL WNCTXT(DWLOG,DWMSG,MAXNNR) - RETURN -C - 993 DWC_EXPR_SOLVE = MSG_SET (DWC_NOTAFTOP,0) - RETURN -C - 994 DWC_EXPR_SOLVE = MSG_SET (DWC_UNBPAREN,0) - RETURN -C - 999 DWC_EXPR_SOLVE = IS ! error reported by referenced routine - RETURN - END -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - INTEGER*4 FUNCTION DWC_EXPR_FUNC (STRING,LSTR,PTR,FUNC,NRPAR) -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' -C - CHARACTER*(*) STRING ! (i) expression - INTEGER*4 LSTR ! (i) significant length of STRING - INTEGER*4 PTR ! (m) pointer (see notes) - INTEGER*4 FUNC ! (o) function code or -length name - INTEGER*4 NRPAR ! (o) nr of required parameters -C -C.Purpose: Determine the function used in the expression -C.Returns: Status code (.TRUE. for success, .FALSE. otherwise) -C success DWC_SUCCESS -C error DWC_UNKFUNC unknown function -C.Notes: -C - If on input PTR points to a valid function name, it will on output -C point to the opening parenthesis. -C - If PTR points to a symbol name (an extended-alphanumeric substring -C not followed by an opening parenthesis), PTR is not changed and -C -FUNC will be the length of the symbol name. -C -C - Valid functions: -C code name nrpar code name nrpar code name nrpar -C -C 1 MIN -32 2 MAX -32 3 SIN 1 -C 4 COS 1 5 TAN 1 6 ASIN 1 -C 7 ACOS 1 8 ATAN 1 9 ATAN2 2 -C 10 ABS 1 11 EXP 1 12 LOG 1 -C 13 LOG10 1 14 SQRT 1 15 TRUNC 1 -C 16 ROUND 1 17 MOD 2 18 SIGN 1 -C -C NRPAR > 0 gives the exact nr of parameters the user must give, -C -NRPAR > 0 gives the maximum nr of parameters the user can give. -C------------------------------------------------------------------------- -C - CHARACTER*(*) BLANK, OPPAR, ANUMX - INTEGER*4 NRFUNC - PARAMETER (BLANK = ' ') - PARAMETER (OPPAR = '(') - PARAMETER (ANUMX = 'ABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789$_') - PARAMETER (NRFUNC = 18) ! nr of functions -C - CHARACTER*5 FNAM(NRFUNC) - INTEGER*4 PAR(NRFUNC) - DATA FNAM / - 1 'MIN' ,'MAX' ,'SIN' ,'COS' ,'TAN' ,'ASIN' , - 2 'ACOS' ,'ATAN' ,'ATAN2','ABS' ,'EXP' ,'LOG' , - 3 'LOG10','SQRT' ,'TRUNC','ROUND','MOD' ,'SIGN' / - DATA PAR / - 1 -32 ,-32 ,1 ,1 ,1 ,1 , - 2 1 ,1 ,2 ,1 ,1 ,1 , - 3 1 ,1 ,1 ,1 ,2 ,1 / -C - INTEGER MSG_SET, STR_SKIP_W, STR_MATCH_A -C - INTEGER*4 IS, START, LNAME -C -C -C Skip to the end of the name -C and skip possible blanks -C - START = PTR - LNAME = STR_SKIP_W (ANUMX,STRING(:LSTR),PTR) - IS = STR_SKIP_W (BLANK,STRING(:LSTR),PTR) -C -C If function name: -C - return code and nr of parameters -C Otherwise (symbol name): -C - restore pointer and return length -C - IF (PTR.LE.LSTR .AND. STRING(PTR:PTR).EQ.OPPAR) THEN - IS = STR_MATCH_A (STRING(START:PTR-1),NRFUNC,FNAM,FUNC) - IF (IS.NE.1) GOTO 999 ! unknown function - NRPAR = PAR(FUNC) - ELSE - PTR = START - FUNC = -LNAME - ENDIF -C -C - DWC_EXPR_FUNC = DWC_SUCCESS - RETURN -C - 999 DWC_EXPR_FUNC = MSG_SET (DWC_UNKFUNC,0) - RETURN - END -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - INTEGER*4 FUNCTION DWC_EXPR_SUBST (STRING,LSTR,PTR,LNAM, - 1 STREAM,CHKSW,SWSYM,NRSUBS) -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' -C - CHARACTER*(*) STRING ! (m) expression - INTEGER*4 LSTR ! (m) significant length of expression - INTEGER*4 PTR ! (i) start of symbol name - INTEGER*4 LNAM ! (i) length of symbol name - CHARACTER*(*) STREAM ! (i) stream name - LOGICAL*4 CHKSW ! (i) unknown symbols allowed ? - LOGICAL*4 SWSYM ! (m) were there unknown symbols ? - INTEGER*4 NRSUBS ! (m) nr of substitutions performed -C -C.Purpose: Replace a symbol in a expression by its value -C.Returns: Status code (.TRUE. for success, .FALSE. otherwise) -C success DWC_SUCCESS -C error DWC_MUTUALSUB more than 25 substitutions (probably looping) -C error DWC_SYMNOTDEF unknown symbol (only for CHKSW = .TRUE.) -C error DWC_STRTOOSHO STRING is too short to contain the symbol value -C.Notes: -C - The significant length of the expression will be updated. -C - The value will be placed between parentheses to keep the correct -C arithmetical order. -C - To avoid substitution looping, there is a maximum of 25 substitutions. -C - An unknown symbol will be substituted by '(1)'. -C------------------------------------------------------------------------- -C - CHARACTER*(*) OPPAR, CLPAR - INTEGER*4 MAXSUBS - PARAMETER (OPPAR = '(') - PARAMETER (CLPAR = ')') - PARAMETER (MAXSUBS = 25) -C - INTEGER*4 DWC_SYM_EXPAND, DWC_SYM_TRANSL - INTEGER STR_COPY, MSG_SET -C - CHARACTER*255 VALUE, WORK - INTEGER*4 IS, LVAL, LW -C -C -C Check nr of substitutions -C - IF (NRSUBS.GE.MAXSUBS) GOTO 991 - NRSUBS = NRSUBS+1 -C -C Translate the symbol -C - expand symbol name (if needed) -C - IS = DWC_SYM_EXPAND (STRING(PTR:PTR+LNAM-1),STREAM,WORK,LW) - IF (IAND(IS,1).NE.0) - 1 IS = DWC_SYM_TRANSL (WORK(:LW),VALUE,LVAL,CHKSW,SWSYM) - IF (IAND(IS,1).EQ.0) GOTO 999 -C -C Replace the symbol name by the value -C - put the value between parentheses -C - LW = 0 - IS = STR_COPY (STRING(PTR+LNAM:LSTR),WORK,LW) ! save rest of string - LSTR = PTR-1 ! keep first part - IS = STR_COPY (OPPAR//VALUE(:LVAL)//CLPAR// ! append value - 1 WORK(:LW),STRING,LSTR) ! and rest string - IF (IS.LT.0) GOTO 990 ! string overflow -C -C - DWC_EXPR_SUBST = DWC_SUCCESS - RETURN -C - 990 DWC_EXPR_SUBST = MSG_SET (DWC_STRTOOSHO,1) - CALL WNCTXT(DWLOG,DWMSG,LEN(STRING)) - RETURN -C - 991 DWC_EXPR_SUBST = MSG_SET (DWC_MUTUALSUB,0) - RETURN -C - 999 DWC_EXPR_SUBST = IS - RETURN - END -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - INTEGER*4 FUNCTION DWC_EXPR_NR (STRING,LSTR,PTR,NR) -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' -C - CHARACTER*(*) STRING ! (i) expression - INTEGER*4 LSTR ! (i) significant length of STRING - INTEGER*4 PTR ! (m) pointer (start -> end of nr) - REAL*8 NR ! (o) number -C -C.Purpose: Read a number from the expression and decode it -C.Returns: Status code (.TRUE. for success, .FALSE. otherwise) -C success DWC_SUCCESS -C error DWC_INVNONR invalid number or no number -C.Notes: -C - The number can be in decimal (default), octal or hexadecimal radix -C indicated by the prefixes by %D, %O and %X respectively. An octal or -C hexadecimal number must be followed by a blank or an operator (incl. -C comma and open-parenthesis). -C - Real numbers can only be given in decimal radix. Exponential D- or -C E-notation can be used, but the exponent can contain only 1 unary -C sign. A decimal point is not required. -C - Decimal numbers can be given as DD:MM:SS, where DD, MM and SS are -C real numbers. The total value is DD+MM/60+SS/3600. By default all -C three numbers are zero, but at least one of them must be given. -C Significant colons must be given too of course. -C Eg.: ::5.3 means 0:0:5.3 -C - When a valid number has been found, the PTR will point to the next -C character in the expression. -C------------------------------------------------------------------------- -C - LOGICAL*4 DECIMAL, OCTAL, HEXA - CHARACTER*(*) RADLIST, BLANK, EXPON, SIGNS, COLON - PARAMETER (DECIMAL = 1) - PARAMETER (OCTAL = 2) - PARAMETER (HEXA = 3) - PARAMETER (RADLIST = 'DOX') - PARAMETER (BLANK = ' ') - PARAMETER (EXPON = 'DE') - PARAMETER (SIGNS = '+-') - PARAMETER (COLON = ':') -C - INTEGER*4 DWC_EXPR_OPER_M - INTEGER*4 STR_CHECK_ALPH, STR_SKIP_U, STR_READ_D - INTEGER MSG_SET -C - INTEGER*4 LENG, ST, END, COLPOS, NRCOL, INTNR - INTEGER*4 IS, RADIX - REAL*8 NRDMS - LOGICAL*4 END_OF_NR, IS_EXPON -C -C -C Logical value ? -C - IF (STRING(PTR:PTR+5).EQ.'.TRUE.') THEN - NR = -1 - PTR = PTR+6 - GOTO 900 - ELSE IF (STRING(PTR:PTR+6).EQ.'.FALSE.') THEN - NR = 0 - PTR = PTR+7 - GOTO 900 - ENDIF -C -C Determine the radix -C - default decimal -C - ST = PTR - RADIX = DECIMAL - IF (STRING(ST:ST).EQ.'%') THEN - RADIX = INDEX (RADLIST,STRING(ST+1:ST+1)) - IF (RADIX.EQ.0) GOTO 999 ! invalid radix - ST = PTR+2 ! skip radix prefix - ENDIF -C -C Get the end of the number -C - END_OF_NR = .FALSE. - IS_EXPON = .FALSE. - I = ST ! start of number - DO WHILE (.NOT.END_OF_NR) -C -C - end of string or blank ? -C - IF (I.GT.LSTR .OR. STRING(I:I).EQ.BLANK) THEN - END_OF_NR = .TRUE. -C -C - start of unit code ? -C - ELSE IF (RADIX.EQ.DECIMAL .AND. .NOT.IS_EXPON - 1 .AND. INDEX(EXPON,STRING(I:I)).NE.0) THEN - IF (IAND(STR_CHECK_ALPH(STRING(I+1:I+1)),1) .NE. 0) THEN - END_OF_NR = .TRUE. ! unit found - ELSE - IS_EXPON = .TRUE. ! exponent found - I = I+1 ! skip E or D - IF (INDEX(SIGNS,STRING(I:I)).NE.0) - 1 I = I+1 ! skip sign - ENDIF -C -C - alphabetic character ? -C - ELSE IF (RADIX.EQ.DECIMAL - 1 .AND. IAND(STR_CHECK_ALPH(STRING(I:I)),1) .NE. 0) THEN - END_OF_NR = .TRUE. -C -C - operator symbol ? -C - ELSE IF (IAND(DWC_EXPR_OPER_M(STRING,LSTR,I),1) .NE. 0) THEN - END_OF_NR = .TRUE. -C -C COLON indicates a new part of the nr, -C so an exponent is possible again -C - ELSE IF (STRING(I:I).EQ.COLON) THEN - IS_EXPON = .FALSE. - I = I+1 ! skip colon -C -C Otherwise: stil part of nr -C - ELSE - I = I+1 ! skip char - ENDIF - ENDDO -C -C Check the nr -C - END = I-1 - LENG = END-ST+1 - IF (LENG.EQ.0) GOTO 999 ! no nr - IF (RADIX.EQ.OCTAL) THEN - IF (LENG.GT.12) GOTO 999 ! too long - READ (STRING(ST:END),'(O12)',ERR=999) INTNR - NR = INTNR - ELSE IF (RADIX.EQ.HEXA) THEN - IF (LENG.GT.8) GOTO 999 ! too long - READ (STRING(ST:END),'(Z8)',ERR=999) INTNR - NR = INTNR - ELSE ! DECIMAL -C - NRDMS = 0 - NRCOL = 0 - DO WHILE (ST.LE.END+1) - IF (NRCOL.GT.2) GOTO 999 ! more than 2 colons - COLPOS = ST - IS = STR_SKIP_U (COLON,STRING(:END),COLPOS) ! find colon - IF (IS.GT.0) THEN - IS = STR_READ_D (STRING(ST:COLPOS-1),NR) ! decode nr - IF (IAND(IS,1).EQ.0) GOTO 999 - NRDMS = NRDMS+NR*60D0**-NRCOL ! convert to DDMMSS - ENDIF - ST = COLPOS+1 ! skip past colon - NRCOL = NRCOL+1 ! increment colon count - ENDDO - IF (LENG.LT.NRCOL) GOTO 999 ! only colons, no nr's - NR = NRDMS - ENDIF - PTR = END+1 -C - 900 DWC_EXPR_NR = DWC_SUCCESS - RETURN -C - 999 DWC_EXPR_NR = MSG_SET (DWC_INVNONR,0) - RETURN - END -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - INTEGER*4 FUNCTION DWC_EXPR_OPER (STRING,LSTR,PTR,OPER, - 1 UNOPER,DEPTH) -C ENTRY DWC_EXPR_OPER_M (STRING,LSTR,PTR) -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' -C - INTEGER*4 DWC_EXPR_OPER_M ! just match -C - CHARACTER*(*) STRING ! (i) expression - INTEGER*4 LSTR ! (i) significant length of STRING - INTEGER*4 PTR ! (m) pointer (start -> end of oper) - INTEGER*4 OPER ! (o) operator code -C 1=** 2=* 3=/ 4=+ 5=- -C 6=.EQ. 7=.NE. 8=.LT. 9=.LE. 10=.GT. -C 11=.GE. 12=.AND. 13=.OR. 14=.XOR. 15=.EQV. -C 0=end-of-string -C -1=) -C -2=, - INTEGER*4 UNOPER ! (i) unary operator code -C 4=+ 5=- 16=.NOT. - INTEGER*4 DEPTH ! (i) Subexpression level -C on level 1 ) and , are not allowed -C -C.Purpose: Extract the binary operator from the expression -C.Returns: Status code (.TRUE. for success, .FALSE. otherwise) -C success DWC_SUCCESS -C warning 0 no operator match (DWC_EXPR_OPER_M only) -C error DWC_UNBPAREN unbalanced parentheses -C error DWC_INVOPER invalid operator -C.Notes: -C - Closing parenthesis (')'), comma and end-of-string are detected -C and are treated as pseudo operators. The first two are not allowed -C on DEPTH = 1. -C - The function also checks for the end of the reach of a unary -C operator (i.e., the arithmetical priority of the binary operator -C is equal to or less than the priority of the unary operator). If -C that is found, the code for the pseudo operator ')' will be returned. -C - If an operator has been found, PTR will point to the first position -C behind the operator. -C -C The priority order of the operators is: -C high ** -C | * / -C | + - -C | EQ NE LT LE GT GE -C | NOT -C | AND -C v OR -C low XOR EQV -C------------------------------------------------------------------------- -C - INTEGER*4 MSG_SET -C -C Possible binary operators -C (unaries are catched in _SOLVE; -C .NOT. has the code 16) -C - CHARACTER*5 OPARR(-2:15) - INTEGER*4 LENOP(-2:15), PRIO(-2:16) - DATA OPARR / - 1 ',' ,')' ,' ' , - 2 '**' ,'*' ,'/' ,'+' ,'-' , - 3 '.EQ.' ,'.NE.' ,'.LT.' ,'.LE.' ,'.GT.' , - 4 '.GE.' ,'.AND.','.OR.' ,'.XOR.','.EQV.'/ - DATA LENOP / - 1 1 ,1 ,5 , - 2 2 ,1 ,1 ,1 ,1 , - 3 4 ,4 ,4 ,4 ,4 , - 4 4 ,5 ,4 ,5 ,5 / - DATA PRIO / - 1 100 ,100 ,100 , - 2 1 ,2 ,2 ,3 ,3 , - 3 4 ,4 ,4 ,4 ,4 , - 4 4 ,6 ,7 ,8 ,8 ,5/ -C -C -C -C Find the operator -C - IF (PTR.GT.LSTR) THEN - OPER = 0 ! end of string - ELSE - DO OPER = -2,15 - IF (STRING(PTR:PTR+LENOP(OPER)-1).EQ.OPARR(OPER)) GOTO 100 - ENDDO - GOTO 999 ! invalid operator - 100 CONTINUE - ENDIF -C -C Check -C - IF (UNOPER.GT.0 .AND. PRIO(OPER).GE.PRIO(UNOPER)) THEN - OPER = -1 ! end of unary range - ELSE IF (OPER.EQ.0) THEN ! end of string - ELSE IF (DEPTH.EQ.1 .AND. OPER.LT.0) THEN - IF (OPER.EQ.-1) GOTO 998 ! unbalanced parenth's - IF (OPER.EQ.-2) GOTO 999 ! invalid operator - ELSE - PTR = PTR+LENOP(OPER) ! shift pointer - ENDIF -C -C - DWC_EXPR_OPER = DWC_SUCCESS - RETURN -C - 998 DWC_EXPR_OPER = MSG_SET (DWC_UNBPAREN,0) - RETURN -C - 999 DWC_EXPR_OPER = MSG_SET (DWC_INVOPER,1) - CALL WNCTXT(DWLOG,DWMSG,STRING(1:2)) - RETURN -C -C ===================== - ENTRY DWC_EXPR_OPER_M (STRING,LSTR,PTR) -C ===================== -C - DO J = -2,15 - IF (STRING(PTR:PTR+LENOP(J)-1).EQ.OPARR(J)) GOTO 800 - ENDDO - DWC_EXPR_OPER_M = 0 ! no operator - RETURN -C - 800 DWC_EXPR_OPER_M = DWC_SUCCESS ! operator found - RETURN - END -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - INTEGER*4 FUNCTION DWC_EXPR_UNIT (STRING,LSTR,PTR,NR, - 1 FACUNIT,UNITSTR) -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' -C -C - CHARACTER*(*) STRING ! (i) expression - INTEGER*4 LSTR ! (i) significant length of STRING - INTEGER*4 PTR ! (m) pointer (start -> end of unit) - REAL*8 NR ! (m) nr to be scaled - REAL*8 FACUNIT ! (i) conversion factor - CHARACTER*(*) UNITSTR ! (i) string with possible unit codes -C -C.Purpose: Scale the nr if the expression contains a valid unit -C.Returns: Status code (.TRUE. for success, .FALSE. otherwise) -C error DWC_INVUNIT unit not allowed -C false status code returned by READ_UNIT -C.Notes: -C------------------------------------------------------------------------- -C - CHARACTER*(*) BLANK, ALPHA - PARAMETER (BLANK = ' ') - PARAMETER (ALPHA = 'ABCDEFGHIJKLMNOPQRSTUVWXYZ') -C - INTEGER*4 STR_SKIP_W, STR_MATCH_L, READ_UNIT - INTEGER MSG_SET -C - INTEGER*4 IS, ST, MATCHNR - REAL*8 FACTOR - CHARACTER*16 WORK -C -C -C Is a unit code given ? -C - if so: determine its length -C and get the scale factor -C - ST = PTR - IS = STR_SKIP_W (ALPHA,STRING(:LSTR),PTR) - IF (IS.EQ.0) GOTO 900 ! no unit -C - IS = STR_MATCH_L (STRING(ST:PTR-1),UNITSTR,MATCHNR) - IF (IAND(IS,1).EQ.0) GOTO 999 ! invalid code - IS = READ_UNIT (STRING(ST:PTR-1),WORK,FACTOR) - IF (IAND(IS,1).EQ.0) GOTO 998 ! error -C -C Scale the nr and -C update the pointer -C - FACTOR = FACUNIT/FACTOR - NR = NR*FACTOR - IS = STR_SKIP_W (BLANK,STRING(:LSTR),PTR) -C -C - 900 DWC_EXPR_UNIT = DWC_SUCCESS - RETURN -C - 998 DWC_EXPR_UNIT = IS - PTR = ST - RETURN -C - 999 DWC_EXPR_UNIT = MSG_SET (DWC_INVUNIT,1) - CALL WNCTXT(DWLOG,DWMSG,STRING(ST:PTR-1)) - PTR = ST - RETURN - END -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - INTEGER*4 FUNCTION DWC_EXPR_SUBX (NR,OPER,UNOPER,NNR,FUNC,NRPAR, - 1 FACUNIT,NUM,SWSYM) -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' -C -C - REAL*8 NR(*) ! (m) table with numbers - INTEGER*4 OPER(*) ! (m) table with operator codes - INTEGER*4 UNOPER ! (i) unary operator code - INTEGER*4 NNR ! (i) nr of numbers in NR - INTEGER*4 FUNC ! (i) function code (0 = no function) - INTEGER*4 NRPAR ! (i) nr of parms required for function - REAL*8 FACUNIT ! (i) factor (default unit to radians) - REAL*8 NUM ! (o) result - LOGICAL*4 SWSYM ! (i) were unknown symbols present ? -C -C.Purpose: Evaluate a subexpression -C.Returns: Status code (.TRUE. for success, .FALSE. otherwise) -C DWC_SUCCESS -C DWC_UNDEFEXP undefined exponentiation -C DWC_DIVBYZERO divide by zero -C DWC_TOOMANARG too many function-arguments -C DWC_TOOLITARG not enough function-arguments -C DWC_INVFUNARG invalid function-argument -C.Notes: -C - OPER(I) is an operator for NR(I) and NR(I+1). -C - If unknown symbols were found, these have been substituted by (1). -C In that case only syntax errors are significant and data errors -C are ignored. -C - First the arithmetic is done according to the normal arithmetical -C priority-rules. -C - Then the function is evaluated if one is given. The argument or -C result of a trigonometric function is converted from, respectively -C to, the default unit. -C - Finally the unary operator is taken if one is given. -C------------------------------------------------------------------------- -C - INTEGER*4 DWC_EXPR_LOGI, MSG_SET, READ_UNIT - INTEGER*4 MOVE_BLD, MOVE_BLJ -C - INTEGER*4 SUB, PAR - INTEGER*4 EXPON, IS - REAL*8 FACTOR, DIFF, R2 - COMPLEX*16 COMPL - CHARACTER*16 WORK -C -C -C Get nr of numbers/operators -C Get conversion factor for radians -C - SUB = NNR - IS = READ_UNIT ('RAD',WORK,FACTOR) - IF (IAND(IS,1).EQ.0) GOTO 999 - FACTOR = FACTOR/FACUNIT ! factor for gonio fu's -C -C Perform all exponentiations (backwards) -C - negative exp can only be integer -C - I = SUB-1 - DO WHILE (I.GT.0) - IF (OPER(I).EQ.1) THEN - IF (NR(I).EQ.0) THEN ! zero exp - NR(I+1) = 0 - ELSE IF (NR(I).LT.0) THEN ! negative exp - EXPON = NINT (NR(I+1)) - IF (ABS(EXPON-NR(I+1)).GT.1.E-4) THEN - IF (.NOT.SWSYM) GOTO 991 ! not integer - EXPON = 1 - ENDIF - NR(I+1) = NR(I)**EXPON - ELSE ! positive exp - NR(I+1) = NR(I)**NR(I+1) - ENDIF - IS = MOVE_BLD (NR(I+1),NR(I),SUB-I) ! shift tables - IS = MOVE_BLJ (OPER(I+1),OPER(I),SUB-I) - SUB = SUB-1 - ELSE - I = I-1 - ENDIF - ENDDO -C -C Perform all multiplications/divisions -C - I = 1 - DO WHILE (I.LT.SUB) - IF (OPER(I).EQ.2 .OR. OPER(I).EQ.3) THEN - IF (OPER(I).EQ.2) THEN - NR(I+1) = NR(I)*NR(I+1) ! multiply - ELSE - IF (NR(I+1).EQ.0) THEN ! avoid zero-divide - IF (.NOT.SWSYM) GOTO 992 - NR(I+1) = 1 - ENDIF - NR(I+1) = NR(I)/NR(I+1) ! divide - ENDIF - IS = MOVE_BLD (NR(I+1),NR(I),SUB-I) ! shift tables - IS = MOVE_BLJ (OPER(I+1),OPER(I),SUB-I) - SUB = SUB-1 - ELSE - I = I+1 - ENDIF - ENDDO -C -C Perform all additions/subtractions -C - I = 1 - DO WHILE (I.LT.SUB) - IF (OPER(I).EQ.4 .OR. OPER(I).EQ.5) THEN - IF (OPER(I).EQ.4) THEN - NR(I+1) = NR(I)+NR(I+1) ! add - ELSE - NR(I+1) = NR(I)-NR(I+1) ! subtract - ENDIF - IS = MOVE_BLD (NR(I+1),NR(I),SUB-I) ! shift tables - IS = MOVE_BLJ (OPER(I+1),OPER(I),SUB-I) - SUB = SUB-1 - ELSE - I = I+1 - ENDIF - ENDDO -C -C Perform all compares with -C accuracy of 8 decimals -C - I = 1 - DO WHILE (I.LT.SUB) - IF (OPER(I).GE.6. AND. OPER(I).LE.11) THEN - DIFF = NR(I)-NR(I+1) - IF (ABS(DIFF).LT.1.E-8) DIFF = 0 - IF (DIFF.EQ.0) THEN - R1=1 - ELSE - R1=0 - END IF - IF (DIFF.LT.0) THEN - R2=1 - ELSE - R2=0 - END IF - IF (OPER(I).EQ.6) THEN - NR(I+1) = R1 !DIFF.EQ.0 - ELSE IF (OPER(I).EQ.7) THEN - NR(I+1) = 1-R1 !DIFF.NE.0 - ELSE IF (OPER(I).EQ.8) THEN - NR(I+1) = R2 !DIFF.LT.0 - ELSE IF (OPER(I).EQ.9) THEN - NR(I+1) = MAX(1,R1+R2) !DIFF.LE.0 - ELSE IF (OPER(I).EQ.10) THEN - NR(I+1) = 1-R1*R2 !DIFF.GT.0 - ELSE - NR(I+1) = 1-R2 !DIFF.GE.0 - ENDIF - IS = MOVE_BLD (NR(I+1),NR(I),SUB-I) ! shift tables - IS = MOVE_BLJ (OPER(I+1),OPER(I),SUB-I) - SUB = SUB-1 - ELSE - I = I+1 - ENDIF - ENDDO -C -C Perform all logical operations -C - IS = DWC_EXPR_LOGI (NR,OPER,SUB,12,12,SWSYM) ! .AND.'s - IF (IAND(IS,1).NE.0) IS = DWC_EXPR_LOGI (NR,OPER,SUB,13,13,SWSYM) ! .OR.'s - IF (IAND(IS,1).NE.0) IS = DWC_EXPR_LOGI (NR,OPER,SUB,14,15,SWSYM) ! .XOR. and .EQV.'s - IF (IAND(IS,1).EQ.0) GOTO 999 -C -C Calculate the function value -C - first check nr of parameters -C - if there is no function, there may be -C 1 (REAL) or 2 (COMPLEX) numbers -C - PAR = -1 - IF (FUNC.GT.0) PAR = NRPAR - IF (SUB.GT.ABS(PAR)) GOTO 993 ! too many parms - IF (PAR.GT.0 .AND .SUB.LT.PAR) GOTO 994 ! too few parms -C - IF (FUNC.EQ.1) THEN ! MIN - NUM = NR(1) - DO I = 2,SUB - NUM = MIN (NUM,NR(I)) - ENDDO -C - ELSE IF (FUNC.EQ.2) THEN ! MAX - NUM = NR(1) - DO I = 2,SUB - NUM = MAX (NUM,NR(I)) - ENDDO -C - ELSE IF (FUNC.EQ.3) THEN ! SIN - NUM = SIN (NR(1)*FACTOR) -C - ELSE IF (FUNC.EQ.4) THEN ! COS - NUM = COS (NR(1)*FACTOR) -C - ELSE IF (FUNC.EQ.5) THEN ! TAN - NUM = TAN (NR(1)*FACTOR) -C - ELSE IF (FUNC.EQ.6) THEN ! ASIN - IF (ABS(NR(1)).GT.1) GOTO 995 - NUM = ASIN (NR(1))/FACTOR -C - ELSE IF (FUNC.EQ.7) THEN ! ACOS - IF (ABS(NR(1)).GT.1) GOTO 995 - NUM = ACOS (NR(1))/FACTOR -C - ELSE IF (FUNC.EQ.8) THEN ! ATAN - NUM = ATAN (NR(1))/FACTOR -C - ELSE IF (FUNC.EQ.9) THEN ! ATAN2 - IF (NR(1).EQ.0.AND.NR(2).EQ.0) GOTO 995 - NUM = ATAN2 (NR(1),NR(2))/FACTOR -C - ELSE IF (FUNC.EQ.10) THEN ! ABS - NUM = ABS (NR(1)) -C - ELSE IF (FUNC.EQ.11) THEN - NUM = EXP (NR(1)) ! EXP -C - ELSE IF (FUNC.EQ.12) THEN ! LOG - IF (NR(1).LE.0) GOTO 995 - NUM = LOG (NR(1)) -C - ELSE IF (FUNC.EQ.13) THEN ! LOG10 - IF (NR(1).LE.0) GOTO 995 - NUM = LOG10 (NR(1)) -C - ELSE IF (FUNC.EQ.14) THEN ! SQRT - IF (NR(1).LT.0) GOTO 995 - NUM = SQRT (NR(1)) -C - ELSE IF (FUNC.EQ.15) THEN ! TRUNC - IF (NR(1).GE.2147483647.5 - 1 .OR.NR(1).LE.-2147483648.5) GOTO 995 - NUM = INT (NR(1)) -C - ELSE IF (FUNC.EQ.16) THEN ! ROUND - IF (NR(1).GE.2147483647.5 - 1 .OR.NR(1).LE.-2147483648.5) GOTO 995 - NUM = NINT (NR(1)) -C - ELSE IF (FUNC.EQ.17) THEN ! MOD - NUM = MOD (NR(1),NR(2)) -C - ELSE IF (FUNC.EQ.18) THEN ! SIGN - IF (NR(1).LT.-1.E-8) THEN - NUM = -1 - ELSE IF (NR(1).GT.1.E-8) THEN - NUM = 1 - ELSE - NUM = 0 - ENDIF -C - ELSE IF (SUB.EQ.1) THEN ! normal REAL nr - NUM = NR(1) -C - ELSE ! complex nr - COMPL = CMPLX (NR(1),NR(2)) - NUM = ABS (COMPL) - ENDIF -C -C Unary operator (ignore +) -C - IF (UNOPER.EQ.5) THEN ! - - NUM = -NUM - ELSE IF (UNOPER.EQ.16) THEN ! .NOT. - NR(2) = NUM - OPER(1) = UNOPER - SUB = 2 - IS = DWC_EXPR_LOGI (NR,OPER,SUB,16,16,SWSYM) - IF (IAND(IS,1).EQ.0) GOTO 999 - NUM = NR(1) - ENDIF -C -C - DWC_EXPR_SUBX = DWC_SUCCESS - RETURN -C - 991 DWC_EXPR_SUBX = MSG_SET (DWC_UNDEFEXP,0) - RETURN -C - 992 DWC_EXPR_SUBX = MSG_SET (DWC_DIVBYZERO,0) - RETURN -C - 993 DWC_EXPR_SUBX = MSG_SET (DWC_TOOMANARG,1) - CALL WNCTXT(DWLOG,DWMSG,ABS(PAR)) - RETURN -C - 994 DWC_EXPR_SUBX = MSG_SET (DWC_TOOLITARG,1) - CALL WNCTXT(DWLOG,DWMSG,PAR) - RETURN -C - 995 IF (SWSYM) THEN - NUM = 1 - DWC_EXPR_SUBX = DWC_SUCCESS - ELSE - DWC_EXPR_SUBX = MSG_SET (DWC_INVFUNARG,0) - ENDIF - RETURN -C - 999 DWC_EXPR_SUBX = IS - RETURN - END -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - INTEGER*4 FUNCTION DWC_EXPR_LOGI (NR,OPER,SUB,TYPE1,TYPE2,SWSYM) -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' -C - REAL*8 NR(*) ! (m) table with numbers - INTEGER*4 OPER(*) ! (m) table with operator codes -C 12=.AND. 13=.OR. -C 14=.XOR. 15=.EQV. -C 16=.NOT. -C OPER(I) is an operator for NR(I) and NR(I+1) -C for .NOT. only NR(I+1) - INTEGER*4 SUB ! (m) nr of numbers in NR - INTEGER*4 TYPE1 ! (i) demanded operator 1 - INTEGER*4 TYPE2 ! (i) demanded operator 2 - LOGICAL*4 SWSYM ! (i) were unknown symbols found ? -C If so, they have been substituted by (1); then -C only syntax errors are significant -C -C.Purpose: -C.Returns: Status code (.TRUE. for success, .FALSE. otherwise) -C success DWC_SUCCESS -C error DWC_INTOVERFL integer overflow during conversion -C false status codes returned by referenced routines -C.Notes: -C This function solves the demanded logical operations in an -C expression. -C Max. 2 operation-types can be solved. -C By different calls to this function, the user can use its own -C arithmetical priorities. -C The values and operator-codes must reside in a table. -C The function will adjust the tables to the left, if an -C operation is done. -C The needed values will be rounded to integer*4 to make logical -C operations possible. -C------------------------------------------------------------------------- -C - INTEGER*4 GEN_CVT_D_NR, MOVE_BLD, MOVE_BLJ - INTEGER MSG_SET -C - INTEGER*4 IS -C -C - I = 1 - DO WHILE (I.LT.SUB) -C -C Convert to INTEGER*4 -C - IF (OPER(I).EQ.TYPE1 .OR. OPER(I).EQ.TYPE2) THEN - IS = GEN_CVT_D_NR ('J',NR(I+1),J2) - IF (IAND(IS,7).NE.1) THEN - IF (.NOT.SWSYM) GOTO 999 - ENDIF - IF (OPER(I).NE.16) THEN - IS = GEN_CVT_D_NR ('J',NR(I),J1) - IF (IAND(IS,7).NE.1) THEN - IF (.NOT.SWSYM) GOTO 999 - ENDIF - ENDIF -C -C Do logical operation -C - IF (OPER(I).EQ.12) THEN - J2 = IAND (J1,J2) - ELSE IF (OPER(I).EQ.13) THEN - J2 = IOR (J1,J2) - ELSE IF (OPER(I).EQ.14) THEN - J2 = IEOR (J1,J2) - ELSE IF (OPER(I).EQ.15) THEN - J2 = NOT (IEOR (J1,J2)) - ELSE IF (OPER(I).EQ.16) THEN - J2 = NOT (J2) - ENDIF -C -C Convert back to REAL*8 and -C adjust the table to the left -C - NR(I+1) = J2 - IS = MOVE_BLD (NR(I+1),NR(I),SUB-I) - IS = MOVE_BLJ (OPER(I+1),OPER(I),SUB-I) - SUB = SUB-1 - ELSE - I = I+1 - ENDIF - ENDDO -C -C - DWC_EXPR_LOGI = DWC_SUCCESS - RETURN -C - 999 IF (IAND(IS,1).EQ.0) THEN - DWC_EXPR_LOGI = IS - ELSE - DWC_EXPR_LOGI = MSG_SET (DWC_INTOVERFL,1) - CALL WNCTXT(DWLOG,DWMSG,'J') - ENDIF - RETURN - END diff --git a/src/dwarf/dwcextendsz.for b/src/dwarf/dwcextendsz.for deleted file mode 100644 index c9fbe07498b3e9e71772a2fa1b99f3a15eb720e7..0000000000000000000000000000000000000000 --- a/src/dwarf/dwcextendsz.for +++ /dev/null @@ -1,71 +0,0 @@ -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ -C.Ident: DWC_EXTENDSZ -C.Keywords: DWARF, Extend Size -C.Author: Friso Olnon (NFRA, Dwingeloo) -C.Language: DWARF-Fortran -C.Environment: VAX or Alliant -C.Comments: -C Common variables used: -C INTEGER*4 DWARF$EXTENDSZ ! (m) extend size for disk files -C -C.Version: 900318 FMO - creation -C------------------------------------------------------------------------- -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - INTEGER*4 FUNCTION DWC_EXTENDSZ () -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' -C -C -C.Purpose: Make source module name known -C.Returns: Status code (.TRUE. for success, .FALSE. otherwise) -C success DWC_SUCCESS -C.Notes: Dummy routine -C------------------------------------------------------------------------- -C -C - DWC_EXTENDSZ = DWC_SUCCESS - RETURN - END -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - INTEGER*4 FUNCTION DWC_EXTENDSZ_PUT (EXTENDSZ) -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' -C - INTEGER*4 EXTENDSZ ! (i) extend size (in bytes) -C -C.Purpose: Store extend size -C.Returns: Status code (.TRUE. for success, .FALSE. otherwise) -C success DWC_SUCCESS -C.Notes: -C------------------------------------------------------------------------- -C - INCLUDE 'DWARF_4_DEF' -C - DWARF$EXTENDSZ = EXTENDSZ -C - DWC_EXTENDSZ_PUT = DWC_SUCCESS - RETURN - END -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - INTEGER*4 FUNCTION DWC_EXTENDSZ_GET (EXTENDSZ) -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' -C - INTEGER*4 EXTENDSZ ! (i) extend size (in bytes) -C -C.Purpose: Get DWARF's extend size for disk files -C.Returns: Status code (.TRUE. for success, .FALSE. otherwise) -C success DWC_SUCCESS -C.Notes: -C------------------------------------------------------------------------- -C - INCLUDE 'DWARF_4_DEF' -C - EXTENDSZ = DWARF$EXTENDSZ -C - DWC_EXTENDSZ_GET = DWC_SUCCESS - RETURN - END diff --git a/src/dwarf/dwchelp.for b/src/dwarf/dwchelp.for deleted file mode 100644 index 97003de353e58b034bb2a0a13c8298da8027978a..0000000000000000000000000000000000000000 --- a/src/dwarf/dwchelp.for +++ /dev/null @@ -1,111 +0,0 @@ -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ -C.Ident: DWC_HELP -C.Keywords: Program Parameters, Help -C.Author: Friso Olnon (NFRA, Dwingeloo) -C.Language: DWARF-Fortran -C.Environment: VAX or Alliant -C.Comments: -C.Version: 900309 FMO - new code -C.Version: 930902 CMV - option for hypertext browser, remove /HOLD etc -C------------------------------------------------------------------------- -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - INTEGER*4 FUNCTION DWC_HELP (STRING,PRTSW,DLEVEL) -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' -C - CHARACTER*(*) STRING ! (i) value string - INTEGER*4 PRTSW ! (i) print control for help info - INTEGER*4 DLEVEL ! (m) helplevel minus userlevel -C -C.Purpose: Check for and process a help request -C.Returns: Status code (.TRUE. for success, .FALSE. otherwise) -C success DWC_SUCCESS no help request -C warning DWC_KEYVAHELP help request (no message stored) -C.Notes: -C - The string is a help request when it consists of a series of question -C marks and blanks. -C - If two question marks are typed, or if the current helplevel -C is larger than one, the hypertext browser is used. -C - If a hypertext request fails, we return to terminal help -C - If a hypertext request is succesfull, we stick to it -C - The helplevel is determined by the number of question marks typed -C (plus the current userlevel). It will be incremented at every call, -C so the user must initialize it when necessary. -C The following arguments are obsolete now: -C - DLEVEL is the difference between the helplevel and the userlevel. Its -C output value depends on PRTSW. -C - PRTSW < 0 set DLEVEL = number of question marks in the string -C > 0 print the help information and set DLEVEL = 0 -C = 0 print the help information if the new helplevel exceeds -C the maximum user level (now 2), and add the number of -C question marks in the string to DLEVEL -C------------------------------------------------------------------------- -C -C - CHARACTER*(*) BLANK, REQUEST - INTEGER*4 LUN - PARAMETER (BLANK = ' ') - PARAMETER (REQUEST = '?') - PARAMETER (LUN = 6) ! LUN for help output -C - INTEGER*4 DWC_LEVEL_GET, DWC_LEVEL_PUT - INTEGER*4 PPD_HELP - INTEGER*4 STR_SIGLEN, STR_SKIP_W, STR_MATCH_L -C - INTEGER*4 IS, LSTR, PTR, NR, NRQ, LEVEL, MAXLEVEL - LOGICAL*4 DO_HOLD -C -C -C The string must start with a -C question mark. Otherwise: return -C - LSTR = STR_SIGLEN (STRING) - IF (LSTR.EQ.0 .OR. STRING(1:1).NE.REQUEST) GOTO 999 - NRQ = 1 - PTR = 2 - DO_HOLD = .FALSE. -C -C Count the nr of question marks -C and check for the /HOLD qualifier -C - the string is no help request if any -C other non-blank character occurs -C - IS = STR_SKIP_W (BLANK,STRING(:LSTR),PTR) - DO WHILE (PTR.LE.LSTR) - IF (STRING(PTR:PTR).EQ.REQUEST) THEN ! question mark - NRQ = NRQ+1 - PTR = PTR+1 - IS = STR_SKIP_W (BLANK,STRING(:LSTR),PTR) - ELSE ! other char - GOTO 999 - ENDIF - ENDDO -C -C Determine the help level -C -C DLEVEL = DLEVEL+NRQ ! level difference -C IS = DWC_LEVEL_GET (LEVEL,MAXLEVEL) ! user and max level -C LEVEL = LEVEL+DLEVEL ! help level -C IF (DO_HOLD) THEN -C IS = DWC_LEVEL_PUT (LEVEL) ! set user = help level -C DLEVEL = 0 ! clear difference -C ENDIF -C -C Write help info if requested -C - in user's parameter name order -C - only non-prototype input parameters -C -C IF (PRTSW.LT.0) THEN -C DLEVEL = NRQ -C ELSE IF (PRTSW.GT.0 .OR. LEVEL.GT.MAXLEVEL) THEN - IS = PPD_HELP (BLANK,.FALSE.,.TRUE.,.FALSE.,NRQ,LUN) -C IF (PRTSW.GT.0) DLEVEL = 0 -C ENDIF -C - DWC_HELP = DWC_KEYVAHELP - RETURN -C - 999 DWC_HELP = DWC_SUCCESS - RETURN - END diff --git a/src/dwarf/dwcibmode.for b/src/dwarf/dwcibmode.for deleted file mode 100644 index e000fa8bf414fb727231f1920f1959e3888d03b1..0000000000000000000000000000000000000000 --- a/src/dwarf/dwcibmode.for +++ /dev/null @@ -1,91 +0,0 @@ -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ -C.Ident: DWC_IBMODE -C.Keywords: DWARF, Execution Mode -C.Author: Friso Olnon (NFRA, Dwingeloo) -C.Language: DWARF-Fortran -C.Environment: VAX or Alliant -C.Comments: -C Common variables used: -C INTEGER*4 DWARF$IBMODE ! (m) execution mode -C (0 = interactive, 1 =batch) -C -C.Version: 900302 FMO - creation -C------------------------------------------------------------------------- -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - INTEGER*4 FUNCTION DWC_IBMODE () -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' -C -C -C.Purpose: Make source module name known -C.Returns: Status code (.TRUE. for success, .FALSE. otherwise) -C success DWC_SUCCESS -C.Notes: Dummy routine -C------------------------------------------------------------------------- -C -C - DWC_IBMODE = DWC_SUCCESS - RETURN - END -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - INTEGER*4 FUNCTION DWC_IBMODE_PUT (IBMODE) -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' -C - INTEGER*4 IBMODE ! (i) execution mode -C -C.Purpose: Store execution mode -C.Returns: Status code (.TRUE. for success, .FALSE. otherwise) -C success DWC_SUCCESS -C.Notes: -C - IBMODE = 0 (interactive) or = 1 (batch). -C------------------------------------------------------------------------- -C - INCLUDE 'DWARF_4_DEF' -C - DWARF$IBMODE = IBMODE -C - DWC_IBMODE_PUT = DWC_SUCCESS - RETURN - END -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - INTEGER*4 FUNCTION DWC_IBMODE_INQ (IBMODE) -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' -C - CHARACTER*(*) IBMODE ! (i) execution mode -C -C.Purpose: Is IBMODE the current execution mode ? -C.Returns: Status code (.TRUE. for success, .FALSE. otherwise) -C success 1 yes -C warning 0 no -C error 2 invalid mode (no message stored) -C.Notes: -C - IBMODE can be 'INTERACTIVE', 'BATCH' or abbreviations. -C------------------------------------------------------------------------- -C - INCLUDE 'DWARF_4_DEF' -C - CHARACTER*(*) MODE_LIST - PARAMETER (MODE_LIST = 'INTERACTIVE,BATCH') -C - INTEGER*4 STR_MATCH_L -C - INTEGER*4 IS, NR -C -C - IS = STR_MATCH_L (IBMODE,MODE_LIST,NR) - IF (NR.EQ.0) THEN - DWC_IBMODE_INQ = 2 - ELSE IF ((NR.EQ.1 .AND. DWARF$IBMODE.EQ.0) .OR. - 1 (NR.EQ.2 .AND. DWARF$IBMODE.EQ.1)) THEN - DWC_IBMODE_INQ = 1 - ELSE - DWC_IBMODE_INQ = 0 - ENDIF -C - RETURN - END diff --git a/src/dwarf/dwcident.for b/src/dwarf/dwcident.for deleted file mode 100644 index d5d755d9e7afc3d857583d24ff658057d917a94a..0000000000000000000000000000000000000000 --- a/src/dwarf/dwcident.for +++ /dev/null @@ -1,101 +0,0 @@ -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ -C.Ident: DWC_IDENT -C.Keywords: DWARF, Login Identification -C.Author: Friso Olnon (NFRA, Dwingeloo) -C.Language: DWARF-Fortran -C.Environment: VAX or Alliant -C.Comments: -C Common variables used: -C INTEGER*4 LENID ! (m) significant length of IDENT -C CHARACTER*4 IDENT_C ! (m) login identification -C -C.Version: 900319 FMO - creation -C.Version: 911127 GvD - fixed little bug in DWC_IDENT_PUT -C LI was tested on .EQ.0 iso. .NE.0 -C.Version: 920214 GvD - no optional arguments in MSG anymore -C------------------------------------------------------------------------- -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - INTEGER*4 FUNCTION DWC_IDENT () -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' -C -C -C.Purpose: Make source module name known -C.Returns: Status code (.TRUE. for success, .FALSE. otherwise) -C success DWC_SUCCESS -C.Notes: Dummy routine -C------------------------------------------------------------------------- -C -C - DWC_IDENT = DWC_SUCCESS - RETURN - END -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - INTEGER*4 FUNCTION DWC_IDENT_GET (IDENT,LI) -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' - INCLUDE 'DWARF_4_DEF' -C - CHARACTER*(*) IDENT ! (o) login identification - INTEGER*4 LI ! (o) significant length of IDENT -C -C.Purpose: Get the login identification -C.Returns: Status code (.TRUE. for success, .FALSE. otherwise) -C success DWC_SUCCESS -C warning DWC_STRTOOSHO identification string is truncated -C.Notes: -C------------------------------------------------------------------------- -C -C - INTEGER MSG_SET -C -C - IDENT = DWARF$IDENT_C - IF (DWARF$LENID.GT.LEN(IDENT)) GOTO 999 - LI = DWARF$LENID -C - DWC_IDENT_GET = DWC_SUCCESS - RETURN -C - 999 LI = LEN (IDENT) - DWC_IDENT_GET = MSG_SET (DWC_STRTOOSHO,1) - CALL WNCTXT(DWLOG,DWMSG,LEN(IDENT)) - RETURN - END -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - INTEGER*4 FUNCTION DWC_IDENT_PUT (IDENT) -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' - INCLUDE 'DWARF_4_DEF' -C - CHARACTER*(*) IDENT ! (i) login identification -C -C.Purpose: Store the login identification -C.Returns: Status code (.TRUE. for success, .FALSE. otherwise) -C success DWC_SUCCESS -C warning DWC_STRTOOSHO identification string is truncated -C.Notes: -C------------------------------------------------------------------------- -C - INTEGER WNCALN,MSG_SET -C - INTEGER*4 LI -C -C - LI = WNCALN (IDENT) - IF (LI.GT.LEN(DWARF$IDENT_C)) GOTO 999 - IF (LI.NE.0) THEN - DWARF$IDENT_C = IDENT(:LI) - DWARF$LENID = LI - ENDIF -C - DWC_IDENT_PUT = DWC_SUCCESS - RETURN -C - 999 DWC_IDENT_PUT = MSG_SET (DWC_STRTOOSHO,1) - CALL WNCTXT(DWLOG,DWMSG,LEN(DWARF$IDENT_C)) - RETURN - END diff --git a/src/dwarf/dwcinput.for b/src/dwarf/dwcinput.for deleted file mode 100644 index 1527e6280246ed1b04ddd5cac4a9007de96323f0..0000000000000000000000000000000000000000 --- a/src/dwarf/dwcinput.for +++ /dev/null @@ -1,149 +0,0 @@ -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ -C.Ident: DWC_INPUT -C.Keywords: Dwarf Control, Get Input -C.Author: Ger van Diepen (NFRA, Dwingeloo) -C.Language: DWARF-Fortran -C.Environment: VAX or Alliant -C.Comments: -C.Version: 900407 FMO - recreation -C.Version: 920206 GvD - no optional arguments anymore -C.Version: 930716 CMV - bell in advance for script mode -C.Version: 010709 AXC -`nchar*1 and tmpchar in calls -C------------------------------------------------------------------------- -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - INTEGER*4 FUNCTION DWC_INPUT (LINE,PROMPT,LL,DEVCOD,BELLSW) -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' -C - CHARACTER*(*) LINE ! (o) answer - CHARACTER*(*) PROMPT ! (i) prompt - INTEGER*4 LL ! (o) length of answer (optional) - INTEGER*4 DEVCOD ! (i) input-device code -C 0 (default) SYS$INPUT -C 1 SYS$COMMAND -C 2 SYS$COMMAND (from subprocess) - INTEGER*4 BELLSW ! (i) bell switch -C 0 (default) no bell signal -C 1 bell signal if DWARF's bell is enabled -C 2 always bell -C -C.Purpose: Ask the user for input -C.Returns: Status code (.TRUE. for success, .FALSE. otherwise) -C success DWC_SUCCESS -C info DWC_GETINPTR answer truncated -C warning DWC_EOFCTRLZ end of file (CTRL/Z or '#' given) -C fatal DWC_GETINPERR I/O error -C.Notes: -C - The prompt string will be completed with ': '. In batch mode no -C prompts will be printed. -C - The answer may be composed of several lines: if an input line ends -C with a hyphen, the user will be prompted for a continuation line, and -C that line will be appended to the answer (without hyphen). -C - The answer will be translated as follows: lowercase characters are -C converted into uppercase, tabs into blanks, multiple blanks into a -C single blank, a leading blank and trailing comments (starting -C with '!') are removed. -C - If the answer is too long, it will be truncated and an informational -C message will be left in the message buffer. -C - Usually, SYS$INPUT and SYS$COMMAND will be the same device (both -C terminal or batch-job). Only in the case of indirect command files, -C SYS$INPUT will be the command file and SYS$COMMAND the terminal. -C------------------------------------------------------------------------- -C -C - INTEGER*4 MAXDEV - CHARACTER*1 BLANK, COLON, PRCONT, BELL - PARAMETER (MAXDEV = 2) - PARAMETER (BLANK = ' ') - PARAMETER (COLON = ':') - PARAMETER (PRCONT = '_') -C - INTEGER*4 DWC_BELL_INQ, DWC_STR_STANDARD - INTEGER*4 GEN_INPUT,STR_SIGLEN - INTEGER*4 MSG_SET -C - CHARACTER PRADD*2, WORK*255, TMP*256 - INTEGER*4 LP, LLSAV, LLADD, XDEVCOD - INTEGER*4 IS -C - BELL = CHAR(7) -C -C Check device code and bell switch -C - XDEVCOD = DEVCOD - IF (DEVCOD.LT.0 .OR. DEVCOD.GT.MAXDEV) XDEVCOD = 0 - PRADD = COLON//BLANK -C -C Get first input line -C - I=STR_SIGLEN(PROMPT) - IF (BELLSW.EQ.2 .OR. - 1 (BELLSW.EQ.1 .AND. IAND(DWC_BELL_INQ(),1).NE.0)) THEN - IF (PROMPT.NE.BLANK) THEN - TMP=BELL//PROMPT(:I)//PRADD - I=STR_SIGLEN(TMP)+1 - IS = GEN_INPUT (LINE,TMP(:I),XDEVCOD) - ELSE - TMP=BELL//PRADD - I=STR_SIGLEN(TMP)+1 - IS = GEN_INPUT (LINE,TMP(:I),XDEVCOD) - ENDIF - ELSE - IF (PROMPT.NE.BLANK) THEN - TMP=PROMPT(:I)//PRADD - I=STR_SIGLEN(TMP)+1 - IS = GEN_INPUT (LINE,TMP(:I),XDEVCOD) - ELSE - IS = GEN_INPUT (LINE,PRADD,XDEVCOD) - ENDIF - ENDIF -C - IF (IS.NE.DWC_SUCCESS) GOTO 999 - IS = DWC_STR_STANDARD (LINE,WORK,LL) - IF (IAND(IS,1).EQ.0) THEN - CALL WNCTXT(DWLOG, - 1 'WORK string in DWC_INPUT too short; tell DWARF manager') - CALL WNGEX - END IF - LINE = WORK(:LL) -C -C Get possible continuation lines -C - LLSAV is used to make sure that -C only 1 continuation line will be -C asked when an answer ends with ------ -C - LLSAV = LL - DO WHILE (LINE(LL:LL).EQ.'-' .AND. LL.GE.LLSAV) - LLSAV = LL - LINE(LL:LL) = BLANK - IS = GEN_INPUT (LINE(LL:),PRCONT//PRADD(:LP),XDEVCOD) - IF (IS.NE.DWC_SUCCESS) GOTO 999 - IS = DWC_STR_STANDARD (LINE(LL:),WORK,LLADD) - IF (IAND(IS,1).EQ.0) THEN - CALL WNCTXT(DWLOG, - 1 'WORK string in DWC_INPUT too short; tell DWARF manager') - CALL WNGEX - END IF - LINE(LL:) = WORK(:LLADD) - LL = LLSAV-1+LLADD - ENDDO -C -C Remove possible leading blank -C - IF (LL.GT.0 .AND. LINE(1:1).EQ.BLANK) THEN - LINE = LINE(2:) - LL = LL-1 - ENDIF -C -C Return -C - 999 IF (IS.EQ.DWC_GETINPTR) THEN - LL = LEN(LINE) - DWC_INPUT = MSG_SET (DWC_GETINPTR,1) - CALL WNCTXT(DWLOG,DWMSG,LL) - ELSE - DWC_INPUT = IS - ENDIF - RETURN - END diff --git a/src/dwarf/dwciobfsz.for b/src/dwarf/dwciobfsz.for deleted file mode 100644 index e003483c8d4674f5428974f3ffcef66b564a5efd..0000000000000000000000000000000000000000 --- a/src/dwarf/dwciobfsz.for +++ /dev/null @@ -1,71 +0,0 @@ -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ -C.Ident: DWC_IOBFSZ -C.Keywords: DWARF, IO Buffer Size -C.Author: Friso Olnon (NFRA, Dwingeloo) -C.Language: DWARF-Fortran -C.Environment: VAX or Alliant -C.Comments: -C Common variables used: -C INTEGER*4 DWARF$IOBFSZ ! (m) IO buffer size -C -C.Version: 900318 FMO - creation -C------------------------------------------------------------------------- -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - INTEGER*4 FUNCTION DWC_IOBFSZ () -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' -C -C -C.Purpose: Make source module name known -C.Returns: Status code (.TRUE. for success, .FALSE. otherwise) -C success DWC_SUCCESS -C.Notes: Dummy routine -C------------------------------------------------------------------------- -C -C - DWC_IOBFSZ = DWC_SUCCESS - RETURN - END -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - INTEGER*4 FUNCTION DWC_IOBFSZ_PUT (IOBFSZ) -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' -C - INTEGER*4 IOBFSZ ! (i) IO buffer size (in bytes) -C -C.Purpose: Store IO buffer size -C.Returns: Status code (.TRUE. for success, .FALSE. otherwise) -C success DWC_SUCCESS -C.Notes: -C------------------------------------------------------------------------- -C - INCLUDE 'DWARF_4_DEF' -C - DWARF$IOBFSZ = IOBFSZ -C - DWC_IOBFSZ_PUT = DWC_SUCCESS - RETURN - END -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - INTEGER*4 FUNCTION DWC_IOBFSZ_GET (IOBFSZ) -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' -C - INTEGER*4 IOBFSZ ! (i) IO buffer size (in bytes) -C -C.Purpose: Get DWARF's IO buffer size -C.Returns: Status code (.TRUE. for success, .FALSE. otherwise) -C success DWC_SUCCESS -C.Notes: -C------------------------------------------------------------------------- -C - INCLUDE 'DWARF_4_DEF' -C - IOBFSZ = DWARF$IOBFSZ -C - DWC_IOBFSZ_GET = DWC_SUCCESS - RETURN - END diff --git a/src/dwarf/dwclevel.for b/src/dwarf/dwclevel.for deleted file mode 100644 index 9dd9f86126c450261c871bcf4342968f31eb8eb4..0000000000000000000000000000000000000000 --- a/src/dwarf/dwclevel.for +++ /dev/null @@ -1,74 +0,0 @@ -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ -C.Ident: DWC_LEVEL -C.Keywords: DWARF, User Level -C.Author: Friso Olnon (NFRA, Dwingeloo) -C.Language: DWARF-Fortran -C.Environment: VAX or Alliant -C.Comments: -C Common variables used: -C INTEGER*4 DWARF$LEVEL ! (m) user level -C 2 (beginner), 1 (average), 0 (expert) -C -C.Version: 900309 FMO - creation -C------------------------------------------------------------------------- -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - INTEGER*4 FUNCTION DWC_LEVEL () -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' -C -C -C.Purpose: Make source module name known -C.Returns: Status code (.TRUE. for success, .FALSE. otherwise) -C success DWC_SUCCESS -C.Notes: Dummy routine -C------------------------------------------------------------------------- -C -C - DWC_LEVEL = DWC_SUCCESS - RETURN - END -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - INTEGER*4 FUNCTION DWC_LEVEL_PUT (LEVEL) -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' -C - INTEGER*4 LEVEL ! (i) user level -C -C.Purpose: Set new user level -C.Returns: Status code (.TRUE. for success, .FALSE. otherwise) -C success DWC_SUCCESS -C.Notes: -C------------------------------------------------------------------------- -C - INCLUDE 'DWARF_4_DEF' -C - DWARF$LEVEL = MIN (LEVEL,2) -C - DWC_LEVEL_PUT = DWC_SUCCESS - RETURN - END -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - INTEGER*4 FUNCTION DWC_LEVEL_GET (LEVEL,MAXLEVEL) -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' -C - INTEGER*4 LEVEL ! (o) user level - INTEGER*4 MAXLEVEL ! (o) maximum user level -C -C.Purpose: Get current user level -C.Returns: Status code (.TRUE. for success, .FALSE. otherwise) -C success DWC_SUCCESS -C.Notes: -C------------------------------------------------------------------------- -C - INCLUDE 'DWARF_4_DEF' -C - LEVEL = DWARF$LEVEL - MAXLEVEL = 2 -C - DWC_LEVEL_GET = DWC_SUCCESS - RETURN - END diff --git a/src/dwarf/dwclogfatal.for b/src/dwarf/dwclogfatal.for deleted file mode 100644 index 95e21d930c5f2a02b1ed856323f4bb917a5c2dab..0000000000000000000000000000000000000000 --- a/src/dwarf/dwclogfatal.for +++ /dev/null @@ -1,74 +0,0 @@ -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ -C.Ident: DWC_LOGFATAL -C.Keywords: DWARF, Log Fatal Switch -C.Author: Friso Olnon (NFRA, Dwingeloo) -C.Language: DWARF-Fortran -C.Environment: VAX or Alliant -C.Comments: -C Common fields used: -C INTEGER*4 DWARF$LOGFATAL ! (m) log on fatal exit ? -C -C.Version: 900319 FMO - creation -C------------------------------------------------------------------------- -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - INTEGER*4 FUNCTION DWC_LOGFATAL () -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' -C -C -C.Purpose: Make source module name known -C.Returns: Status code (.TRUE. for success, .FALSE. otherwise) -C success DWC_SUCCESS -C.Notes: Dummy routine -C------------------------------------------------------------------------- -C -C - DWC_LOGFATAL = DWC_SUCCESS - RETURN - END -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - INTEGER*4 FUNCTION DWC_LOGFATAL_PUT (SWITCH) -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' -C - LOGICAL*4 SWITCH ! (i) switch log fatal on ? -C -C.Purpose: Enable or disable log fatal -C.Returns: Status code (.TRUE. for success, .FALSE. otherwise) -C success DWC_SUCCESS -C.Notes: -C------------------------------------------------------------------------- -C - INCLUDE 'DWARF_4_DEF' -C -C - IF (SWITCH) THEN - DWARF$LOGFATAL = 1 - ELSE - DWARF$LOGFATAL = 0 - ENDIF -C - DWC_LOGFATAL_PUT = DWC_SUCCESS - RETURN - END -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - INTEGER*4 FUNCTION DWC_LOGFATAL_INQ () -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' -C -C -C.Purpose: Inquire whether to log on fatal exit -C.Returns: Status code (.TRUE. for success, .FALSE. otherwise) -C success 1 yes -C warning 0 no -C.Notes: -C------------------------------------------------------------------------- -C - INCLUDE 'DWARF_4_DEF' -C - DWC_LOGFATAL_INQ = DWARF$LOGFATAL - RETURN - END diff --git a/src/dwarf/dwcloglevel.for b/src/dwarf/dwcloglevel.for deleted file mode 100644 index d1067de22c5415dad17feab4a035baaf71d01da0..0000000000000000000000000000000000000000 --- a/src/dwarf/dwcloglevel.for +++ /dev/null @@ -1,73 +0,0 @@ -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ -C.Ident: DWC_LOGLEVEL -C.Keywords: DWARF, Log Level -C.Author: Friso Olnon (NFRA, Dwingeloo) -C.Language: DWARF-Fortran -C.Environment: VAX or Alliant -C.Comments: -C Common variables used: -C INTEGER*4 DWARF$LOGLEVEL ! (m) log level (between 0 and 8) -C -C.Version: 900319 FMO - creation -C------------------------------------------------------------------------- -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - INTEGER*4 FUNCTION DWC_LOGLEVEL () -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' -C -C -C.Purpose: Make source module name known -C.Returns: Status code (.TRUE. for success, .FALSE. otherwise) -C success DWC_SUCCESS -C.Notes: Dummy routine -C------------------------------------------------------------------------- -C -C - DWC_LOGLEVEL = DWC_SUCCESS - RETURN - END -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - INTEGER*4 FUNCTION DWC_LOGLEVEL_PUT (LEVEL) -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' -C - INTEGER*4 LEVEL ! (i) log level -C -C.Purpose: Set new log level -C.Returns: Status code (.TRUE. for success, .FALSE. otherwise) -C success DWC_SUCCESS -C.Notes: -C------------------------------------------------------------------------- -C - INCLUDE 'DWARF_4_DEF' -C - DWARF$LOGLEVEL = MAX (0,MIN(LEVEL,8)) -C - DWC_LOGLEVEL_PUT = DWC_SUCCESS - RETURN - END -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - INTEGER*4 FUNCTION DWC_LOGLEVEL_GET (LEVEL,MAXLEVEL) -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' -C - INTEGER*4 LEVEL ! (o) log level - INTEGER*4 MAXLEVEL ! (o) maximum log level -C -C.Purpose: Get current log level -C.Returns: Status code (.TRUE. for success, .FALSE. otherwise) -C success DWC_SUCCESS -C.Notes: -C------------------------------------------------------------------------- -C - INCLUDE 'DWARF_4_DEF' -C - LEVEL = DWARF$LOGLEVEL - MAXLEVEL = 8 -C - DWC_LOGLEVEL_GET = DWC_SUCCESS - RETURN - END diff --git a/src/dwarf/dwcmsgdev.for b/src/dwarf/dwcmsgdev.for deleted file mode 100644 index a3a327552d0fa71d90d3fc471cb057b2660c743d..0000000000000000000000000000000000000000 --- a/src/dwarf/dwcmsgdev.for +++ /dev/null @@ -1,90 +0,0 @@ -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ -C.Ident: DWC_MSGDEV -C.Keywords: DWARF, Message Device -C.Author: Friso Olnon (NFRA, Dwingeloo) -C.Language: DWARF-Fortran -C.Environment: VAX or Alliant -C.Comments: -C Common variables used: -C INTEGER*4 DWARF$MSGDEV ! (m) message device -C = 0 (terminal), = 1 (printer) or = 2 (both). -C -C.Version: 900319 FMO - creation -C------------------------------------------------------------------------- -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - INTEGER*4 FUNCTION DWC_MSGDEV () -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' -C -C -C.Purpose: Make source module name known -C.Returns: Status code (.TRUE. for success, .FALSE. otherwise) -C success DWC_SUCCESS -C.Notes: Dummy routine -C------------------------------------------------------------------------- -C -C - DWC_MSGDEV = DWC_SUCCESS - RETURN - END -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - INTEGER*4 FUNCTION DWC_MSGDEV_PUT (MSGDEV) -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' -C - INTEGER*4 MSGDEV ! (i) message device -C -C.Purpose: Store message device -C.Returns: Status code (.TRUE. for success, .FALSE. otherwise) -C success DWC_SUCCESS -C.Notes: -C------------------------------------------------------------------------- -C - INCLUDE 'DWARF_4_DEF' -C - DWARF$MSGDEV = MSGDEV -C - DWC_MSGDEV_PUT = DWC_SUCCESS - RETURN - END -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - INTEGER*4 FUNCTION DWC_MSGDEV_INQ (MSGDEV) -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' -C - CHARACTER*(*) MSGDEV ! (i) message device -C -C.Purpose: Is MSGDEV the current message device ? -C.Returns: Status code (.TRUE. for success, .FALSE. otherwise) -C success 1 yes -C warning 0 no -C error 2 invalid mode (no message stored) -C.Notes: -C - MSGDEV can be 'TERMINAL', 'PRINTER' or abbreviations. -C------------------------------------------------------------------------- -C - INCLUDE 'DWARF_4_DEF' -C - CHARACTER*(*) DEV_LIST - PARAMETER (DEV_LIST = 'TERMINAL,PRINTER') -C - INTEGER*4 STR_MATCH_L -C - INTEGER*4 IS, NR -C -C - IS = STR_MATCH_L (MSGDEV,DEV_LIST,NR) - IF (NR.EQ.0) THEN - DWC_MSGDEV_INQ = 2 - ELSE IF ((NR.EQ.1 .AND. DWARF$MSGDEV.NE.1) .OR. - 1 (NR.EQ.2 .AND. DWARF$MSGDEV.NE.0)) THEN - DWC_MSGDEV_INQ = 1 - ELSE - DWC_MSGDEV_INQ = 0 - ENDIF -C - RETURN - END diff --git a/src/dwarf/dwcnexact.mvx b/src/dwarf/dwcnexact.mvx deleted file mode 100644 index 139e019be8091fdb4b3a4d1fd6820538ad456cca..0000000000000000000000000000000000000000 --- a/src/dwarf/dwcnexact.mvx +++ /dev/null @@ -1,205 +0,0 @@ -;+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ -;.Ident: DWC_NEXACT -;.Keywords: Process Information -;.Author: Ger van Diepen (NFRA, Dwingeloo) -;.Language: VAX/Macro -;.Environment: VAX/VMS -;.Comments: -;.Version: 830103 GVD - creation DWCNEXACT.MAR -;.Version: 840808 GVD - image name extracted -;.Version: 910820 FMO - new header -;.Version: 920224 GvD - no optional arguments in MSG anymore -;.Version: 930202 HjV - $CODE, $PDATA and $LOCAL expanded -;.Version: 940203 CMV - Changed call to MSG_SWRITE to MSG_SET -;----------------------------------------------------------------------- -;+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ -; INTEGER*4 FUNCTION DWC_NEXACT (NEXT,PID,PROCNAME,IMGNAME,UIC,TIME,OWNER) -; -; INTEGER*4 NEXT !(m) code (see notes) -; INTEGER*4 PID !(o) pidnr of process -; CHARACTER*(*) PROCNAME !(o) name of process -; CHARACTER*(*) IMGNAME !(o) program name -; INTEGER*4 UIC !(m) UIC-nr of the process -; 0=UIC-nr will be written in UIC -; else=UIC of the process must be equal -; to this UIC -; REAL*8 TIME !(o) starting-time of the process -; INTEGER*4 OWNER !(o) pidnr of the process-owner -; (=0 if it's a detached process) -; -;.Purpose: Get information about active processes -;.Returns: -; success 1 -; error 2 end of processes -; error code from SYS$GETJPI -;.Notes: -; The information consists of pidnr, process-name, uic, starting-time -; and owner-pid. -; -; NEXT determines for which process the information will be gotten -; (own process, arbitrary process or all processes): -; - 0 = get information about own process -; - <0 = get information about all processes -; NEXT = -1 initially, DWC_NEXACT will update NEXT. -; The user must call DWC_NEXACT, until the return-code = 0. -; Every call gives information about the next process. -; - >0 = get information about process with this pidnr -; -; If UIC = 0, the UIC of the process will be written into UIC. -; Otherwise, the UIC of the process must equal the given UIC. -;----------------------------------------------------------------------- -; - .TITLE DWC_NEXACT GET (NEXT) ACTIVE PROCESS-INFORMATION - .IDENT /GVD7AUG84/ -; -; - $JPIDEF -; - ONEXT=4 - OPID=8 - OPROC=12 - OIMG=16 - OUIC=20 - OTIME=24 - OOWNER=28 -; -; -; - .MACRO $PDATA - .PSECT $PDATA, PIC,CON,REL,LCL,SHR,NOEXE,RD,NOWRT,LONG - .IF NDF $PDATA -$PDATA: - .ENDC -$RELOC=$PDATA - .ENDM -ZERO: .LONG 0 -; -; - .MACRO $LOCAL - .PSECT $LOCAL, PIC,CON,REL,LCL,NOSHR,NOEXE,RD,WRT,LONG - .IF NDF $LOCAL -$LOCAL: - .ENDC -$RELOC=$LOCAL - .ENDM -IOSB: .BLKQ -UIC: .BLKL -LEN: .BLKL -LENPRC: .BLKL -LENIMG: .BLKL -IMGNAM: .BLKL 32 -; -LIST: - .WORD 4 - .WORD JPI$_PID -LISPID: .BLKL - .ADDRESS LEN -LISLPR: .BLKW - .WORD JPI$_PRCNAM -LISTPR: .BLKL - .ADDRESS LENPRC - .WORD 128 - .WORD JPI$_IMAGNAME - .ADDRESS IMGNAM - .ADDRESS LENIMG - .WORD 4 - .WORD JPI$_UIC - .ADDRESS UIC - .ADDRESS LEN - .WORD 8 - .WORD JPI$_LOGINTIM -LISTIM: .BLKL - .ADDRESS LEN - .WORD 4 - .WORD JPI$_OWNER -LISOWN: .BLKL - .ADDRESS LEN - .LONG 0 -; -; -; - .MACRO $CODE - .PSECT $CODE, PIC,CON,REL,LCL,SHR,EXE,RD,NOWRT,LONG - .IF NDF $CODE -$CODE: - .ENDC - .ENDM - .ENTRY DWC_NEXACT,^M<R2,R3,R4,R5,R6,R7> -; - MOVL OPID(AP),LISPID ;ADDRESS PIDNR - MOVL OPROC(AP),R7 ;ADDRESS STRING-DESCRIPTOR PROCESS-NAME - MOVW (R7),LISLPR ;STRING-LENGTH - MOVL 4(R7),LISTPR ;STRING-ADDRESS - MOVL OUIC(AP),R6 ;UIC-ADDRESS - MOVL OTIME(AP),LISTIM ;TIME-ADDRESS - MOVL OOWNER(AP),LISOWN ;OWNER-ADDRESS -; -; GET NEXT PROCESS -NEXT: $GETJPI_S EFN=#0,PIDADR=@ONEXT(AP),ITMLST=LIST,IOSB=IOSB - CMPL R0,#SS$_NOMOREPROC - BNEQ 10$ - MOVL #2,R0 ;END-OF-PROCESSES - BRW END -; -10$: CMPL R0,#SS$_NOPRIV - BEQL LOOP ;NO PRIVILEGE, TRY NEXT PROCESS - CMPL R0,#SS$_SUSPENDED - BEQL LOOP ;SUSPENDED, TRY NEXT PROCESS - BLBC R0,ENDERR ;OTHER ERROR -; -; -; WAIT FOR GETJPI - $WAITFR_S EFN=#0 - BLBC R0,ENDERR ;ERROR - MOVL IOSB,R0 ;RETURN-CODE - BLBC R0,ENDERR ;ERROR -; -; TEST FOR UIC? - TSTL (R6) - BEQL 20$ ;NO - CMPL (R6),UIC - BNEQ LOOP ;WRONG UIC, TRY NEXT PROCESS - BRW FOUND ;OK -20$: MOVL UIC,(R6) ;FILL UIC - BRW FOUND -; -; NEXT PROCESS? -LOOP: TSTL @ONEXT(AP) - BLSS NEXT ;YES - BRW END ;NO -; -; ERROR, CREATE MESSAGE -ENDERR: MOVL R0,IOSB - PUSHAL ZERO - PUSHAL IOSB - CALLS #2,G^MSG_SET - BRW END -; -; -; BLANK REMAINDER OF PROCESS-NAME -FOUND: MOVW LISLPR,LEN ;LENGTH OF PROCESS-NAME-FIELD - MOVL LISTPR,R7 ;ADDRESS - ADDL2 LENPRC,R7 ;START FOR BLANKING - SUBW2 LENPRC,LEN ;LENGTH FOR BLANKING - MOVC5 #0,(SP),#^A' ',LEN,(R7) ;BLANK -; -; EXTRACT IMAGE-NAME FROM COMPLETE IMAGE-FILENAME - LOCC #^A']',LENIMG,IMGNAM ;LOCATE END-OF-DIRECTORY - BEQL 10$ ;NOT FOUND - ADDL3 #1,R1,R7 ;START OF FILENAME - LOCC #^A'.',LENIMG,(R7) ;LOCATE END OF IMAGENAME - BEQL 10$ ;NOT FOUND - SUBL3 R7,R1,R0 ;NOW LENGTH OF IMAGE-NAME IN R0 -; NOW MOVE IMAGE-NAME TO DESTINATION -10$: MOVL OIMG(AP),R2 ;DESTINATION STRING - MOVL 4(R2),R3 - MOVC5 R0,(R7),#^A' ',(R2),(R3) ;PUT IMAGENAME IN DESTINATION -; -; SET FOR SUCCESS - MOVL #1,R0 -; -; -END: RET -; -; - .END diff --git a/src/dwarf/dwcnode.for b/src/dwarf/dwcnode.for deleted file mode 100644 index c16cca8748ac7100fc1327649d0f0e8cca89b93c..0000000000000000000000000000000000000000 --- a/src/dwarf/dwcnode.for +++ /dev/null @@ -1,403 +0,0 @@ -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ -C.Ident: DWC_NODE -C.Keywords: DWARF, Node Name -C.Author: Friso Olnon (NFRA, Dwingeloo) -C.Language: DWARF-Fortran -C.Environment: VAX or Alliant -C.Comments: -C Common variables used: -C CHARACTER*80 DWARF$CURNODE_C ! (m) current node name -C INTEGER*4 DWARF$LENNODE ! (m) significant length of node name -C -C.Version: 900219 FMO - creation -C.Version: 920214 GvD - no optional arguments in MSG anymore -C.Version: 010709 AXC - linux port - tmpchar in calls -C------------------------------------------------------------------------- -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - INTEGER*4 FUNCTION DWC_NODE () -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' -C -C -C.Purpose: Make source-module name known -C.Returns: Status code (.TRUE. for success, .FALSE. otherwise) -C success DWC_SUCCESS -C.Notes: Dummy function -C------------------------------------------------------------------------- -C -C - DWC_NODE = DWC_SUCCESS - RETURN - END -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - INTEGER*4 FUNCTION DWC_NODE_EXPAND_A (NRSET,NRVAL,LARR,ARRAY,NR) -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' -C - INTEGER*4 NRSET ! (i) nr of sets - INTEGER*4 NRVAL ! (i) nr of reserved values per set - INTEGER*4 LARR ! (i) length of single value - BYTE ARRAY(LARR,NRVAL,*) ! (m) node name array - INTEGER*4 NR(*) ! (i) nr of used elements per set -C -C.Purpose: Expand a block of node names -C.Returns: Status code (.TRUE. for success, .FALSE. otherwise) -C success DWC_SUCCESS -C error DWC_NODCOMERR error in node name expansion -C.Notes: -C------------------------------------------------------------------------- -C -C - CHARACTER*(*) BLANK - PARAMETER (BLANK = ' ') -C - INTEGER*4 DWC_NODE_GET, DWC_NODE_EXPAND - INTEGER*4 MOVE_BLB, STR_SIGLEN, MSG_SET -C - CHARACTER XNODE*80, NODE*80, CURNODE*80 - INTEGER*4 IS, LX, LN, LC -C -C -C Start with DWARF's current node -C - CURNODE = BLANK - LC = 1 - IS = DWC_NODE_GET (CURNODE,LC) - IF (IAND(IS,1).EQ.0) GOTO 999 -C -C Replace all relative node names in -C the block with expanded names -C - skip undefined block elements -C - DO I = 1,NRSET - DO J = 1,NR(I) - IF (ARRAY(1,J,I).NE.UNDEF_B) THEN - NODE = BLANK - IS = MOVE_BLB (ARRAY(1,J,I),%REF(NODE),LARR) - LN = STR_SIGLEN (NODE(:LARR)) - IS = DWC_NODE_EXPAND (NODE(:LN),CURNODE(:LC),XNODE(:LARR),LX) - IF (IS.EQ.DWC_SETCURNOD) THEN ! set new current node - CURNODE = XNODE - LC = LX-1 - ELSE - IF (IAND(IS,1).EQ.0) GOTO 999 - ENDIF - IS = MOVE_BLB (%REF(XNODE),ARRAY(1,J,I),LARR) - ENDIF - ENDDO - ENDDO -C - DWC_NODE_EXPAND_A = DWC_SUCCESS - RETURN -C - 999 DWC_NODE_EXPAND_A = MSG_SET (DWC_NODCOMERR,1) - CALL WNCTXT(DWLOG,DWMSG,NODE(:LN),CURNODE(:LC)) - RETURN - END -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - INTEGER*4 FUNCTION DWC_NODE_EXPAND (NODE,CURNODE,XNODE,LX) -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' -C - CHARACTER*(*) NODE ! (i) node name - CHARACTER*(*) CURNODE ! (i) current node name - CHARACTER*(*) XNODE ! (o) expanded node name - INTEGER*4 LX ! (o) significant length of XNODE -C -C.Purpose: Expand a node name -C.Returns: Status code (.TRUE. for success, .FALSE. otherwise) -C success .TRUE. -C warning DWC_SETCURNOD set new current node is requested -C error DWC_APPMINUS minus sign found in NODE, but no more fields -C left in intermediate result -C error DWC_APPTOOLON result is too long for XNODE -C.Notes: -C - The node name can consist of one or more fields separated by dots -C (e.g. ABC.DEF.GHIJ) -C - If the name starts with an empty field (empty name or name starting -C with dot or minus sign), the current node name will be prefixed. -C If the name ends with an empty field (trailing dot), that field will -C be ignored. -C Other empty fields (2 subsequent dots) are not allowed. -C - If a field consists of one or more minus signs, each minus sign -C causes the deletion of the last field in the intermediate result. -C - Examples: -C CURNODE NODE XNODE -C ------- ------- ------- -C A.B C C -C A.B .C A.B.C -C A.B - A -C A.B.C.D .--.E.F A.B.E.F -C A.B.C.D --.E.-.F A.B.F -C------------------------------------------------------------------------- -C -C - CHARACTER*(*) MINUS, DELIM, SETCUR - PARAMETER (DELIM = '.') - PARAMETER (MINUS = '-') - PARAMETER (SETCUR = ':') -C - INTEGER*4 DWC_NODE_CHECK - INTEGER*4 STR_SIGLEN, STR_COPY_U, STR_COPY - INTEGER*4 MSG_SET -C - INTEGER*4 IS, LN, PTR - LOGICAL*4 DO_SETCUR -C -C - XNODE = CURNODE - LX = STR_SIGLEN (XNODE) - LN = STR_SIGLEN (NODE) - IF (LN.EQ.0) GOTO 900 ! empty node name -C -C If trailing colon: -C - remove it -C - set flag for restoration at exit -C If trailing delimiter: -C - remove it -C - IF (NODE(LN:LN).EQ.SETCUR) THEN - DO_SETCUR = .TRUE. - LN = LN-1 - IF (LN.EQ.0) GOTO 900 - ENDIF - IF (NODE(LN:LN).EQ.DELIM) THEN - LN = LN-1 - IF (LN.EQ.0) GOTO 900 - ENDIF -C -C Check the syntax of the node name -C - IS = DWC_NODE_CHECK (NODE(:LN)) - IF (IAND(IS,1).EQ.0) GOTO 999 -C -C Expand -C - IF (NODE(1:1).NE.DELIM .AND. NODE(1:1).NE.MINUS) LX = 0 - PTR = 1 - DO WHILE (PTR.LE.LN) - IF (NODE(PTR:PTR).EQ.DELIM) PTR = PTR+1 ! skip delimiter -C -C Remove last field of XNODE -C - including its starting delimiter -C - IF (NODE(PTR:PTR).EQ.MINUS) THEN - IF (LX.EQ.0) GOTO 993 ! not possible - DO WHILE (LX.GT.1 .AND. XNODE(LX:LX).NE.DELIM) - LX = LX-1 - ENDDO - LX = LX-1 ! new length of XNODE - PTR = PTR+1 ! next position in NODE -C -C Append NODE field to XNODE -C - if not first field: with delimiter -C - ELSE - IF (LX.GT.0) IS = STR_COPY (DELIM,XNODE,LX) - IS = STR_COPY_U (DELIM,NODE(:LN),PTR,XNODE,LX) - IF (IS.LT.0) GOTO 994 ! not enough room - ENDIF - ENDDO -C -C Restore "set current node" indicator -C - IF (DO_SETCUR) THEN - IS = STR_COPY (SETCUR,XNODE,LX) - IF (IS.LT.0) GOTO 994 ! not enough room - DWC_NODE_EXPAND = DWC_SETCURNOD - RETURN - ENDIF -C - 900 DWC_NODE_EXPAND = DWC_SUCCESS - RETURN -C - 993 DWC_NODE_EXPAND = MSG_SET (DWC_APPMINUS,0) - RETURN - 994 DWC_NODE_EXPAND = MSG_SET (DWC_APPTOOLON,1) - CALL WNCTXT(DWLOG,DWMSG,LEN(XNODE)) - RETURN - 999 DWC_NODE_EXPAND = IS - RETURN - END -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - INTEGER*4 FUNCTION DWC_NODE_PUT (NODE) -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' -C - CHARACTER*(*) NODE ! (i) node name -C -C.Purpose: Set new current node -C.Returns: Status code (.TRUE. for success, .FALSE. otherwise) -C success DWC_SUCCESS -C warning DWC_STRTOOSHO node name has been truncated -C.Notes: -C------------------------------------------------------------------------- -C - INCLUDE 'DWARF_4_DEF' -C - INTEGER*4 STR_SIGLEN, MSG_SET -C - INTEGER*4 LN -C -C - LN = STR_SIGLEN (NODE) - IF (LN.GT.LEN(DWARF$CURNODE_C)) GOTO 999 - IF (LN.GT.0) THEN - DWARF$CURNODE_C = NODE(:LN) - DWARF$LENNODE = LN - ENDIF -C - DWC_NODE_PUT = DWC_SUCCESS - RETURN -C - 999 DWC_NODE_PUT = MSG_SET (DWC_STRTOOSHO,1) - CALL WNCTXT(DWLOG,DWMSG,LEN(DWARF$CURNODE_C)) - RETURN - END -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - INTEGER*4 FUNCTION DWC_NODE_GET (NODE,LN) -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' -C - CHARACTER*(*) NODE ! (o) node name - INTEGER*4 LN ! (o) significant length of NODE -C -C.Purpose: Get the current node -C.Returns: Status code (.TRUE. for success, .FALSE. otherwise) -C success DWC_SUCCESS -C warning DWC_STRTOOSHO node name has been truncated -C.Notes: -C------------------------------------------------------------------------- -C - INCLUDE 'DWARF_4_DEF' -C - CHARACTER*(*) BLANK - PARAMETER (BLANK = ' ') -C - INTEGER*4 STR_COPY, MSG_SET -C - INTEGER*4 IS -C -C - LN = 0 - NODE = BLANK - IS = STR_COPY (DWARF$CURNODE_C(:DWARF$LENNODE),NODE,LN) - IF (IS.LT.0) GOTO 999 -C - DWC_NODE_GET = DWC_SUCCESS - RETURN -C - 999 DWC_NODE_GET = MSG_SET (DWC_STRTOOSHO,1) - CALL WNCTXT(DWLOG,DWMSG,LEN(NODE)) - RETURN - END -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - INTEGER*4 FUNCTION DWC_NODE_CHECK (NODE) -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' -C - CHARACTER*(*) NODE ! (i) node name -C -C.Purpose: Check the syntax of the node name -C.Returns: Status code (.TRUE. for success, .FALSE. otherwise) -C success .TRUE. -C error DWC_APPTWODOT 2 subsequent dots in NODE -C error GEN_ISNOTANM subname is not alphanumeric or all minus signs -C.Notes: -C - The node name can consist of one or more fields separated by dots -C (e.g. ABC.DEF.GHIJ) -C - The name can start with an empty field (empty name or name starting -C with dot or minus sign) and end with an empty field (trailing dot). -C Other empty fields (2 subsequent dots) are not allowed. -C - All other fields must be either alphanumeric or all minus signs. -C------------------------------------------------------------------------- -C -C - CHARACTER*(*) ANUM, MINUS, DELIM - PARAMETER (ANUM = 'ABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789') - PARAMETER (DELIM = '.') - PARAMETER (MINUS = '-') -C - INTEGER*4 STR_SIGLEN, STR_SKIP_W - INTEGER*4 MSG_SET -C - INTEGER*4 IS, LN, PTR, SAVPTR -C -C - LN = STR_SIGLEN (NODE) - PTR = 1 ! start of first field - IF (NODE(1:1).EQ.DELIM) THEN ! field is empty - IF (LN.EQ.1) GOTO 991 ! next field is empty - PTR = PTR+1 ! start of next field - ENDIF - DO WHILE (PTR.LE.LN) - SAVPTR = PTR - IS = STR_SKIP_W (ANUM,NODE(:LN),PTR) - IF (IS.EQ.0) IS = STR_SKIP_W (MINUS,NODE(:LN),PTR) - IF (PTR.LE.LN) THEN - IF (NODE(PTR:PTR).NE.DELIM) GOTO 992 ! invalid field - IF (IS.EQ.0 .OR. PTR.EQ.LN) GOTO 991 ! empty field - PTR = PTR+1 ! start of next field - ENDIF - ENDDO -C - DWC_NODE_CHECK = DWC_SUCCESS - RETURN -C - 991 DWC_NODE_CHECK = MSG_SET (DWC_APPTWODOT,0) - RETURN - 992 DWC_NODE_CHECK = MSG_SET (GEN_ISNOTANM,1) - CALL WNCTXT(DWLOG,DWMSG,NODE(SAVPTR:PTR)) - RETURN - END -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - INTEGER*4 FUNCTION DWC_NODE_SET (NODE) -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' -C - CHARACTER*(*) NODE ! (i) node name -C -C.Purpose: Set new current node if requested -C.Returns: Status code (.TRUE. for success, .FALSE. otherwise) -C success DWC_SUCCESS no "set current node" request -C warning DWC_SETCURNOD new current node is set -C.Notes: -C - If NODE ends with a colon, the current node will be set to NODE -C without the colon, and a message will be written. -C------------------------------------------------------------------------- -C -C - CHARACTER*(*) SETCUR, QUOTE - PARAMETER (SETCUR = ':') - PARAMETER (QUOTE = '"') -C - INTEGER*4 DWC_NODE_PUT - INTEGER*4 STR_SIGLEN, MSG_SET -C - INTEGER*4 IS, LN - CHARACTER TMP*80 -C -C -C Remember that the colon caused -C GET_PARM to return the node name -C as a quoted string -C - LN = STR_SIGLEN (NODE) - IF (LN.GE.3 .AND. NODE(LN-1:LN-1).EQ.SETCUR) GOTO 900 -C - DWC_NODE_SET = DWC_SUCCESS - RETURN -C - 900 IS = DWC_NODE_PUT (NODE(2:LN-2)) ! ignore false return - DWC_NODE_SET = MSG_SET(DWC_SETCURNOD,1) - TMP=QUOTE//NODE(2:LN-2)//QUOTE - CALL WNCTXT(DWLOG,DWMSG,TMP) - RETURN - END diff --git a/src/dwarf/dwcprcmode.for b/src/dwarf/dwcprcmode.for deleted file mode 100644 index 1fa146288f1c492904642d907cd41e05040557ae..0000000000000000000000000000000000000000 --- a/src/dwarf/dwcprcmode.for +++ /dev/null @@ -1,67 +0,0 @@ -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ -C.Ident: DWC_PRCMODE -C.Keywords: DWARF, Process Mode -C.Author: Friso Olnon (NFRA, Dwingeloo) -C.Language: DWARF-Fortran -C.Environment: VAX or Alliant -C.Comments: -C The process mode is kept in a local saved variable with value -C PARM__SUBPROC (=1) for a subprocess, or -C PARM__MAINPROC (=0) for a main process -C.Version: 900302 FMO - creation -C.Version: 910826 FMO - PARM_n no longer needed -C.Version: 940119 CMV - Remove check on owner and PARM__ -C------------------------------------------------------------------------- -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - INTEGER FUNCTION DWC_PRCMODE_SET () -C ENTRY DWC_PRCMODE_INQ (PRCMODE) -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' - INTEGER DWC_PRCMODE_INQ -C - CHARACTER*(*) PRCMODE ! (i) process mode -C -C.Purpose: Set process mode or inquire after the current mode -C.Returns: Status code (.TRUE. for success, .FALSE. otherwise) -C success DWC_SUCCESS for SET -C success 1 for INQ if PRCMODE is the current mode -C warning 0 for INQ if PRCMODE is not the current mode -C error 2 for INQ if PRCMODE is an invalid mode (no msg) -C false status returned by referenced routine (for SET) -C.Notes: -C - PRCMODE can be 'SUBPROCESS', 'MAINPROCESS' or abbreviations. -C------------------------------------------------------------------------- -C -C - CHARACTER*(*) MODE_LIST - PARAMETER (MODE_LIST = 'SUBPROCESS,MAINPROCESS') -C - INTEGER DWC_IBMODE_INQ, STR_MATCH_L -C - INTEGER IS, NR - INTEGER PROCESS_MODE - DATA PROCESS_MODE /0/ - SAVE PROCESS_MODE -C -C - PROCESS_MODE = 0 - DWC_PRCMODE_SET = DWC_SUCCESS - RETURN -C -C ===================== - ENTRY DWC_PRCMODE_INQ (PRCMODE) -C ===================== -C - IS = STR_MATCH_L (PRCMODE,MODE_LIST,NR) - IF (NR.EQ.0) THEN - DWC_PRCMODE_INQ = 2 - ELSE IF ((NR.EQ.1 .AND. PROCESS_MODE.EQ.1) .OR. - 1 (NR.EQ.2 .AND. PROCESS_MODE.EQ.0)) THEN - DWC_PRCMODE_INQ = 1 - ELSE - DWC_PRCMODE_INQ = 0 - ENDIF -C - RETURN - END diff --git a/src/dwarf/dwcprog.for b/src/dwarf/dwcprog.for deleted file mode 100644 index 3d830b78251958b0eb5fdeaca9c07ef600fddc73..0000000000000000000000000000000000000000 --- a/src/dwarf/dwcprog.for +++ /dev/null @@ -1,135 +0,0 @@ -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ -C.Ident: DWC_PROG -C.Keywords: DWARF, Program Name -C.Author: Friso Olnon (NFRA, Dwingeloo) -C.Language: DWARF-Fortran -C.Environment: VAX or Alliant -C.Comments: -C The program name and its significant length are kept in local saved -C variables. Their initial values are 'NN' and 2, respectively. -C.Version: 900227 FMO - creation -C.Version: 910826 FMO - PARM_n no longer needed -C.Version: 920214 GvD - no optional arguments in MSG anymore -C------------------------------------------------------------------------- -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - INTEGER FUNCTION DWC_PROG_PUT (PROG) -C ENTRY DWC_PROG_GET (PROG,LP) -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' - INTEGER DWC_PROG_GET -C - CHARACTER*(*) PROG !(i/o) program name - INTEGER LP !(o) significant length of PROG -C -C.Purpose: Check and store, or get the program name -C.Returns: Status code (.TRUE. for success, .FALSE. otherwise) -C success DWC_SUCCESS also for blank program name (PUT) -C error DWC_LOKILLIMG illegal program name (PUT) -C warning DWC_STRTOOSHO PROG is too short, message stored (GET) -C.Notes: -C PUT: -C - First, PROG is converted to uppercase. -C - A valid program name consists of an alphabetic character followed by -C at most 8 alpha-numeric characters. -C - If the program name is blank, the current name is kept. -C GET: -C - In case of string overflow the truncated name (and its length) -C will be returned. -C------------------------------------------------------------------------- -C -C - INTEGER DWC_PROG_CHECK, STR_UPCASE, MSG_SET -C - CHARACTER*16 UPCPROG - INTEGER IS, LUP - LOGICAL IS_GLOBAL -C - CHARACTER*12 PROGNAM - INTEGER LPROGNAM - DATA PROGNAM /'NN'/ - DATA LPROGNAM /2/ - SAVE PROGNAM, LPROGNAM -C -C - UPCPROG = PROG - IS = STR_UPCASE (UPCPROG) - IS = DWC_PROG_CHECK (UPCPROG,LUP,IS_GLOBAL) - IF (IAND(IS,1).EQ.0) GOTO 991 -C - IF (LUP.GT.0) THEN - PROGNAM = UPCPROG(:LUP) - LPROGNAM = LUP - ENDIF -C - DWC_PROG_PUT = DWC_SUCCESS - RETURN -C - 991 DWC_PROG_PUT = IS - RETURN -C -C ================== - ENTRY DWC_PROG_GET (PROG,LP) -C ================== -C - PROG = PROGNAM(:LPROGNAM) - IF (LEN(PROG).LT.LPROGNAM) GOTO 992 - LP = LPROGNAM -C - DWC_PROG_GET = DWC_SUCCESS - RETURN -C - 992 LP = LEN (PROG) - DWC_PROG_GET = MSG_SET (DWC_STRTOOSHO,1) - CALL WNCTXT(DWLOG,DWMSG,LP) - RETURN - END -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - INTEGER FUNCTION DWC_PROG_CHECK (PROG,LP,IS_GLOBAL) -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' -C - CHARACTER*(*) PROG !(i) program name - INTEGER LP !(o) significant length of PROG - LOGICAL IS_GLOBAL !(o) global DWARF program name ? -C -C.Purpose: Check program name -C.Returns: Status code (.TRUE. for success, .FALSE. otherwise) -C success DWC_SUCCESS also for blank program name -C error DWC_LOKILLIMG illegal program name (messages stored) -C.Notes: -C - A valid program name consists of an alphabetic character followed by -C at most 8 alpha-numeric characters. -C - GLOBAL and DWARF are global program names. -C------------------------------------------------------------------------- -C -C - CHARACTER*(*) GLOBAL_LIST - INTEGER MAXLP - PARAMETER (GLOBAL_LIST = 'GLOBAL,DWARF') - PARAMETER (MAXLP = 9) -C - INTEGER STR_SIGLEN, STR_CHECK_ANUMA, STR_MATCH_L - INTEGER MSG_SET -C - INTEGER IS, NR -C -C - IS_GLOBAL = .FALSE. - LP = STR_SIGLEN (PROG) - IF (LP.GT.0) THEN - IF (LP.GT.MAXLP) GOTO 999 - IS = STR_CHECK_ANUMA (PROG(:LP)) - IF (IAND(IS,1).EQ.0) GOTO 999 - IS = STR_MATCH_L (PROG(:LP),GLOBAL_LIST,NR) - IS_GLOBAL = IS.EQ.1 - ENDIF -C - DWC_PROG_CHECK = DWC_SUCCESS - RETURN -C - 999 DWC_PROG_CHECK = MSG_SET (DWC_LOKILLIMG,1) - CALL WNCTXT(DWLOG,DWMSG,PROG(:LP)) - RETURN - END diff --git a/src/dwarf/dwcsave.for b/src/dwarf/dwcsave.for deleted file mode 100644 index 4011fb05aa3772edef2bf98dea0463cfb53cd8f0..0000000000000000000000000000000000000000 --- a/src/dwarf/dwcsave.for +++ /dev/null @@ -1,74 +0,0 @@ -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ -C.Ident: DWC_SAVE -C.Keywords: DWARF, Save Switch -C.Author: Friso Olnon (NFRA, Dwingeloo) -C.Language: DWARF-Fortran -C.Environment: VAX or Alliant -C.Comments: -C Common fields used: -C INTEGER*4 DWARF$SAVELAST ! (m) in save mode ? -C -C.Version: 900319 FMO - creation -C------------------------------------------------------------------------- -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - INTEGER*4 FUNCTION DWC_SAVE () -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' -C -C -C.Purpose: Make source module name known -C.Returns: Status code (.TRUE. for success, .FALSE. otherwise) -C success DWC_SUCCESS -C.Notes: Dummy routine -C------------------------------------------------------------------------- -C -C - DWC_SAVE = DWC_SUCCESS - RETURN - END -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - INTEGER*4 FUNCTION DWC_SAVE_PUT (SWITCH) -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' -C - LOGICAL*4 SWITCH ! (i) switch save mode on ? -C -C.Purpose: Enable or disable save mode -C.Returns: Status code (.TRUE. for success, .FALSE. otherwise) -C success DWC_SUCCESS -C.Notes: -C------------------------------------------------------------------------- -C - INCLUDE 'DWARF_4_DEF' -C -C - IF (SWITCH) THEN - DWARF$SAVELAST = 1 - ELSE - DWARF$SAVELAST = 0 - ENDIF -C - DWC_SAVE_PUT = DWC_SUCCESS - RETURN - END -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - INTEGER*4 FUNCTION DWC_SAVE_INQ () -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' -C -C -C.Purpose: Inquire whether DWARF is in save mode -C.Returns: Status code (.TRUE. for success, .FALSE. otherwise) -C success 1 yes -C warning 0 no -C.Notes: -C------------------------------------------------------------------------- -C - INCLUDE 'DWARF_4_DEF' -C - DWC_SAVE_INQ = DWARF$SAVELAST - RETURN - END diff --git a/src/dwarf/dwcstr.for b/src/dwarf/dwcstr.for deleted file mode 100644 index 250f709f998f922af3c5191f4860427b107e6b44..0000000000000000000000000000000000000000 --- a/src/dwarf/dwcstr.for +++ /dev/null @@ -1,261 +0,0 @@ -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ -C.Ident: DWC_STR -C.Keywords: DWARF, String -C.Author: Friso Olnon (NFRA, Dwingeloo) -C.Language: DWARF-Fortran -C.Environment: VAX or Alliant -C.Comments: -C.Version: 900416 FMO - recreation -C.Version: 920214 GvD - no optional arguments in MSG anymore -C------------------------------------------------------------------------- -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - INTEGER*4 FUNCTION DWC_STR () -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' -C -C -C.Purpose: Make module name known -C.Returns: Status code (.TRUE. for success, .FALSE. otherwise) -C success DWC_SUCCESS -C.Notes: -C------------------------------------------------------------------------- -C -C - DWC_STR = DWC_SUCCESS - RETURN - END -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - INTEGER*4 FUNCTION DWC_STR_STANDARD (STRIN,STROUT,LOUT) -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' -C - CHARACTER*(*) STRIN ! (i) input string - CHARACTER*(*) STROUT ! (o) output string - INTEGER*4 LOUT ! (o) significant length of STROUT -C -C.Purpose: Translate a string to a standard DWARF string -C.Returns: Status code (.TRUE. for success, .FALSE. otherwise) -C success DWC_SUCCESS -C warning DWC_STRTOOSHO output string too short -C.Notes: -C The translation steps are: -C - leave quoted substrings unchanged, but append a closing quote if that -C is not present; -C - convert lowercase to uppercase; -C - convert tabs to blanks; -C - compress multiple blanks to a single blank; -C - remove comment (starting with exclamation mark); -C -C If the output string is too short, a message will be stored in the -C message buffer and the truncated string will be returned. -C------------------------------------------------------------------------- -C -C - CHARACTER*(*) BLANK, TAB, WHITE, QUOTE, EXCLA, SPECIAL - PARAMETER (BLANK = ' ') - PARAMETER (TAB = ' ') - PARAMETER (WHITE = BLANK//TAB) - PARAMETER (QUOTE = '"') - PARAMETER (EXCLA = '!') - PARAMETER (SPECIAL = WHITE//QUOTE//EXCLA) -C - INTEGER*4 STR_SIGLEN, STR_UPCASE - INTEGER*4 STR_SKIP_W, STR_COPY, STR_COPY_U - INTEGER*4 MSG_SET -C - INTEGER*4 IS, LIN, PTR, NCOPY, SAVLOUT, MAXOUT -C -C -C Copy until the next special -C character and make uppercase -C - STROUT = BLANK - LOUT = 0 - NCOPY=0 - LIN = STR_SIGLEN (STRIN) - PTR = 1 - DO WHILE (PTR.LE.LIN) - SAVLOUT = LOUT - NCOPY = STR_COPY_U (SPECIAL,STRIN(:LIN),PTR,STROUT,LOUT) - IF (LOUT.GT.SAVLOUT) IS = STR_UPCASE (STROUT(SAVLOUT+1:LOUT)) -C -C End of string or start of comment: stop -C - IF (PTR.GT.LIN) THEN - ELSE IF (STRIN(PTR:PTR).EQ.EXCLA) THEN - PTR = LIN+1 -C -C Quoted substring: -C - copy it unchanged -C - add closing quote if necessary -C - ELSE IF (STRIN(PTR:PTR).EQ.QUOTE) THEN - NCOPY = STR_COPY (QUOTE,STROUT,LOUT) - PTR = PTR+1 - NCOPY = STR_COPY_U (QUOTE,STRIN(:LIN),PTR,STROUT,LOUT) - NCOPY = STR_COPY (QUOTE,STROUT,LOUT) - PTR = PTR+1 -C -C White substring: -C - replace by single blank -C - ELSE - NCOPY = STR_COPY (BLANK,STROUT,LOUT) - PTR = PTR+1 - IS = STR_SKIP_W (WHITE,STRIN(:LIN),PTR) - ENDIF - ENDDO -C -C - IF (NCOPY.LT.0) THEN - MAXOUT = LEN (STROUT) - DWC_STR_STANDARD = MSG_SET (DWC_STRTOOSHO,1) - CALL WNCTXT(DWLOG,DWMSG,MAXOUT) - ELSE - DWC_STR_STANDARD = DWC_SUCCESS - ENDIF - RETURN - END -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - INTEGER*4 FUNCTION DWC_STR_SUBST (STRING,STROUT,LOUT,STREAM, - 1 ERRPTR,CHKSW,SWSYM) -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' -C - CHARACTER*(*) STRING ! (i) input string - CHARACTER*(*) STROUT ! (o) output string - INTEGER*4 LOUT ! (o) significant length of STROUT - CHARACTER*(*) STREAM ! (i) stream name - INTEGER*4 ERRPTR ! (o) position of error in STROUT - LOGICAL*4 CHKSW ! (i) unknown symbols allowed - LOGICAL*4 SWSYM ! (m) unknown symbols found ? -C -C.Purpose: Substitute all symbols between apostrophes -C.Returns: Status code (.TRUE. for success, .FALSE. otherwise) -C success DWC_SUCCESS -C warning DWC_STRTOOSHO output string too short -C error DWC_NOENDQUO missing end quote -C error DWC_NOENDAPOS missing end apostroph -C error DWC_MUTUALSUB too many substitutions -C error DWC_SYMNOTDEF symbol not found -C.Notes: -C - Apostrophes in literals (quoted substrings) are not treated as -C as substitution-symbol indicators. -C - If necessary, the streamnr will be added to a symbol name. -C - If the value of the symbol itself contains substitution symbols, -C they will be substituted, etc. -C - The max. nr of substitutions is 25 to avoid substitution looping. -C------------------------------------------------------------------------- -C -C - INTEGER*4 MAXSUB - CHARACTER*(*) QUOTE, APOSTR - PARAMETER (MAXSUB = 25) - PARAMETER (QUOTE = '"') - PARAMETER (APOSTR = '''') -C - INTEGER*4 DWC_SYM_EXPAND, DWC_SYM_TRANSL - INTEGER*4 STR_SIGLEN, STR_SKIP_U, STR_COPY, MSG_SET -C - CHARACTER*255 VALUE, WORK - INTEGER*4 LMAX, LVAL, LW - INTEGER*4 IS, PTR, START, NRSUBS -C -C - ERRPTR = 0 - NRSUBS = 0 - STROUT = STRING - LOUT = STR_SIGLEN (STRING) - LMAX = LEN(STROUT) - IF (LOUT.GT.LMAX) GOTO 991 ! STROUT too short -C -C Skip until the start of a literal -C or substitution substring -C - PTR = 1 - IS = STR_SKIP_U (QUOTE//APOSTR,STROUT(:LOUT),PTR) - DO WHILE (PTR.LE.LOUT) - START = PTR -C -C If literal substring: -C - skip through it -C - IF (STROUT(PTR:PTR).EQ.QUOTE) THEN - PTR = PTR+1 - IS = STR_SKIP_U (QUOTE,STROUT(:LOUT),PTR) - IF (PTR.GT.LOUT) GOTO 992 ! missing end quote - PTR = PTR+1 -C -C If substitution substring: -C - extract the symbol name -C (error if no end apostroph present) -C - check the nr of substitutions -C - ELSE - PTR = PTR+1 - IS = STR_SKIP_U (APOSTR//QUOTE,STROUT(:LOUT),PTR) - IF (PTR.GT.LOUT .OR. STROUT(PTR:PTR).EQ.QUOTE) GOTO 993 -C - IF (NRSUBS.GE.MAXSUB) GOTO 994 ! too many substitutions - NRSUBS = NRSUBS+1 -C -C Translate the symbol -C - expand symbol name if needed -C - IS = DWC_SYM_EXPAND (STROUT(START+1:PTR-1),STREAM, - 1 WORK,LW) - IF (IAND(IS,1).NE.0) IS = DWC_SYM_TRANSL (WORK(:LW),VALUE,LVAL, - 1 CHKSW,SWSYM) - IF (IAND(IS,1).EQ.0) GOTO 995 -C -C Replace the symbol name by the value -C - LW = 0 - IS = STR_COPY (STROUT(PTR+1:LOUT),WORK,LW) ! save rest - LOUT = START-1 ! keep first part - IS = STR_COPY (VALUE(:LVAL)// ! append value - 1 WORK(:LW),STROUT,LOUT) ! append rest - IF (IS.LT.0) GOTO 996 ! STROUT too short - PTR = START - ENDIF -C -C Look for the next special substring -C starting after the literal or at the -C start of the substituted substring -C - IS = STR_SKIP_U (QUOTE//APOSTR,STROUT(:LOUT),PTR) - ENDDO -C -C - LOUT = STR_SIGLEN (STROUT(:LOUT)) - DWC_STR_SUBST = DWC_SUCCESS - RETURN -C - 991 DWC_STR_SUBST = MSG_SET (DWC_STRTOOSHO,1) - CALL WNCTXT(DWLOG,DWMSG,LMAX) - RETURN -C - 992 DWC_STR_SUBST = MSG_SET (DWC_NOENDQUO,0) - ERRPTR = START - RETURN -C - 993 DWC_STR_SUBST = MSG_SET (DWC_NOENDAPOS,0) - ERRPTR = START - RETURN -C - 994 DWC_STR_SUBST = MSG_SET (DWC_MUTUALSUB,0) - ERRPTR = START+1 - RETURN -C - 995 DWC_STR_SUBST = IS - ERRPTR = START+1 - RETURN -C - 996 DWC_STR_SUBST = MSG_SET (DWC_STRTOOSHO,1) - CALL WNCTXT(DWLOG,DWMSG,LMAX) - ERRPTR = START+1 - RETURN - END diff --git a/src/dwarf/dwcstream.for b/src/dwarf/dwcstream.for deleted file mode 100644 index 9509441d3ee79650a5792c706473aa96b0ba1369..0000000000000000000000000000000000000000 --- a/src/dwarf/dwcstream.for +++ /dev/null @@ -1,175 +0,0 @@ -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ -C.Ident: DWC_STREAM -C.Keywords: DWARF, Stream Name -C.Author: Friso Olnon (NFRA, Dwingeloo) -C.Language: DWARF-Fortran -C.Environment: VAX or Alliant -C.Comments: -C Common variables used: -C CHARACTER*12 DWARF$STREAM_C ! (m) current stream name -C INTEGER*4 DWARF$LENSTR ! (m) significant length -C -C.Version: 900228 FMO - creation -C.Version: 910923 FMO - XYZ are alphabetics too !! (CHECK) -C.Version: 920214 GvD - no optional arguments in MSG anymore -C------------------------------------------------------------------------- -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - INTEGER*4 FUNCTION DWC_STREAM_PUT (STREAM) -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' -C - CHARACTER*(*) STREAM ! (i) stream name -C -C.Purpose: Check and store the stream name -C.Returns: Status code (.TRUE. for success, .FALSE. otherwise) -C success DWC_SUCCESS -C error DWC_STRINVNR illegal stream name -C.Notes: -C - First, STREAM will be converted to uppercase. -C - A valid stream name consists of at most 11 alpha-numeric characters -C possibly prefixed with a '$'. -C - If the prefix is absent, it will be inserted. -C - If STREAM is blank or empty, the current name is kept. -C------------------------------------------------------------------------- -C - INCLUDE 'DWARF_4_DEF' -C - INTEGER*4 DWC_STREAM_CHECK, STR_UPCASE -C - CHARACTER*16 UPCSTREAM, XSTREAM - INTEGER*4 IS, LS -C -C - UPCSTREAM = STREAM - IS = STR_UPCASE (UPCSTREAM) - IS = DWC_STREAM_CHECK (UPCSTREAM,XSTREAM,LS,.FALSE.) - IF (IAND(IS,1).EQ.0) GOTO 999 -C - IF (LS.GT.0) THEN - DWARF$STREAM_C = XSTREAM(:LS) - DWARF$LENSTR = LS - ENDIF -C - DWC_STREAM_PUT = DWC_SUCCESS - RETURN -C - 999 DWC_STREAM_PUT = IS - RETURN - END -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - INTEGER*4 FUNCTION DWC_STREAM_GET (STREAM,LS,IS_GLOBAL) -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' -C - CHARACTER*(*) STREAM ! (o) stream name (with $ prefix) - INTEGER*4 LS ! (o) significant length of STREAM - LOGICAL*4 IS_GLOBAL ! (i) for global DWARF program name ? -C -C.Purpose: Get stream name -C.Returns: Status code (.TRUE. for success, .FALSE. otherwise) -C success DWC_SUCCESS -C warning DWC_STRTOOSHO STREAM too short -C.Notes: -C - For global program names STREAM = '$0' will be returned. -C - Otherwise, the current stream name will be copied from the DWARF -C control common, including the prefix). -C - In case of string overflow the truncated name (and its length) -C will be returned. -C------------------------------------------------------------------------- -C - INCLUDE 'DWARF_4_DEF' -C - CHARACTER*(*) BLANK, GLOBAL - PARAMETER (BLANK = ' ') - PARAMETER (GLOBAL = '$0') -C - INTEGER*4 STR_COPY, MSG_SET -C - INTEGER*4 IS -C -C - STREAM = BLANK - LS = 0 - IF (IS_GLOBAL) THEN - IS = STR_COPY (GLOBAL,STREAM,LS) - ELSE - IS = STR_COPY (DWARF$STREAM_C(:DWARF$LENSTR),STREAM,LS) - ENDIF - IF (IS.LT.0) GOTO 999 -C - DWC_STREAM_GET = DWC_SUCCESS - RETURN -C - 999 DWC_STREAM_GET = MSG_SET (DWC_STRTOOSHO,1) - CALL WNCTXT(DWLOG,DWMSG,LEN(STREAM)) - RETURN - END -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - INTEGER*4 FUNCTION DWC_STREAM_CHECK (STREAM,XSTREAM,LX,IS_GLOBAL) -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' -C - CHARACTER*(*) STREAM ! (i) stream name - CHARACTER*(*) XSTREAM ! (o) stream name (with $ prefix) - INTEGER*4 LX ! (o) significant length of XSTREAM - LOGICAL*4 IS_GLOBAL ! (i) for global DWARF program name ? -C -C.Purpose: Check stream name -C.Returns: Status code (.TRUE. for success, .FALSE. otherwise) -C success DWC_SUCCESS also for blank STREAM (then: LX = 0) -C warning DWC_STRTOOSHO XSTREAM too short -C error DWC_STRINVNR illegal stream name -C.Notes: -C - A valid stream name consists of at most 11 alpha-numeric characters -C possibly prefixed with a '$'. -C - If the prefix is absent, it will be inserted. -C - For global program names XSTREAM must be '$0'. -C - If STREAM is blank or empty, no checks will be done. -C------------------------------------------------------------------------- -C -C - CHARACTER*(*) BLANK, ANUM, PREFIX, GLOBAL - INTEGER*4 MAXLX - PARAMETER (BLANK = ' ') - PARAMETER (ANUM = 'ABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789') - PARAMETER (PREFIX = '$') - PARAMETER (GLOBAL = '$0') - PARAMETER (MAXLX = 12) -C - INTEGER*4 STR_SIGLEN, STR_COPY_W - INTEGER*4 MSG_SET -C - INTEGER*4 IS, LS, PTR -C -C - LS = STR_SIGLEN (STREAM) - IF (LS.EQ.0) THEN - XSTREAM = BLANK - LX = 0 - ELSE - XSTREAM = PREFIX - LX = 1 - PTR = 1 - IF (STREAM(1:1).EQ.PREFIX) PTR = 2 - IF (PTR.GT.LS) GOTO 999 ! just a prefix - IS = STR_COPY_W (ANUM,STREAM(:LS),PTR,XSTREAM,LX) - IF (LX.GT.MAXLX) GOTO 999 ! too long - IF (IS.LT.0) GOTO 998 ! string overflow - IF (PTR.LE.LS) GOTO 999 ! not alpha-numeric - IF (IS_GLOBAL .AND. XSTREAM(:LX).NE.GLOBAL) GOTO 999 - ENDIF -C - DWC_STREAM_CHECK = DWC_SUCCESS - RETURN -C - 998 DWC_STREAM_CHECK = MSG_SET (DWC_STRTOOSHO,1) - CALL WNCTXT(DWLOG,DWMSG,LEN(XSTREAM)) - RETURN -C - 999 DWC_STREAM_CHECK = MSG_SET (DWC_STRINVNR,1) - CALL WNCTXT(DWLOG,DWMSG,STREAM) - RETURN - END diff --git a/src/dwarf/dwcsym.for b/src/dwarf/dwcsym.for deleted file mode 100644 index 9600cc73f1c104eda16effc3680b69964a1ba98c..0000000000000000000000000000000000000000 --- a/src/dwarf/dwcsym.for +++ /dev/null @@ -1,282 +0,0 @@ -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ -C.Ident: DWC_SYM -C.Keywords: DWARF, Symbols -C.Author: Friso Olnon (NFRA, Dwingeloo) -C.Language: DWARF-Fortran -C.Environment: VAX or Alliant -C.Comments: -C.Version: 900416 FMO - recreation -C.Version: 910807 FMO - recognize abbreviations of symbol names YES and NO -C in _TRANSL (for Alliant) -C.Version: 920214 GvD - no optional arguments in MSG anymore -C.Version: 931116 CMV - Allow . in stead of $ for stream at input -C.Version: 010709 AXC - linux port - tmpchar in calls -C------------------------------------------------------------------------- -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - INTEGER*4 FUNCTION DWC_SYM_SPLIT (SYMBOL,PROGNAM,LP,STREAM, - 1 LS,KEY,LK) -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' -C - CHARACTER*(*) SYMBOL ! (i) symbol name - CHARACTER*(*) PROGNAM ! (o) program name - INTEGER*4 LP ! (o) significant length of PROGNAM - CHARACTER*(*) STREAM ! (o) stream name (with '$' prefix) - INTEGER*4 LS ! (o) significant length of STREAM - CHARACTER*(*) KEY ! (o) keyword (without '_' prefix) - INTEGER*4 LK ! (o) significant length of KEY -C -C.Purpose: Split a DWARF symbol name in its components -C.Returns: Status code (.TRUE. for success, .FALSE. otherwise) -C success DWC_SUCCESS -C warning DWC_STRTOOSHO one of the output strings is too short -C.Notes: -C - No syntax checks are done. -C - Trailing blanks in components are removed. -C - All components will be extracted, even if one of them has to be -C truncated. -C------------------------------------------------------------------------- -C -C - CHARACTER*(*) BLANK, DOLLAR, DOT, UNDERSC - PARAMETER (BLANK = ' ') - PARAMETER (DOLLAR = '$') - PARAMETER (DOT = '.') - PARAMETER (UNDERSC = '_') -C - INTEGER*4 STR_SIGLEN, STR_COPY_U, STR_COPY - INTEGER*4 MSG_SET -C - INTEGER*4 IS, LSYM, PTR, TMP -C -C - PROGNAM = BLANK - STREAM = BLANK - KEY = BLANK - LP = 0 - LS = 0 - LK = 0 - LSYM = STR_SIGLEN (SYMBOL) - PTR = 1 - IS = DWC_SUCCESS -C -C Extract program name -C - TMP = STR_COPY_U (DOLLAR//DOT//UNDERSC, - & SYMBOL(:LSYM),PTR,PROGNAM,LP) - IF (TMP.LT.0) IS = MSG_SET (DWC_STRTOOSHO,1) - IF (TMP.LT.0) CALL WNCTXT(DWLOG,DWMSG,LEN(PROGNAM)) - LP = STR_SIGLEN (PROGNAM(:LP)) -C -C Extract stream name (with '$' prefix) -C - IF (PTR.LE.LSYM .AND. (SYMBOL(PTR:PTR).EQ.DOLLAR.OR. - & SYMBOL(PTR:PTR).EQ.DOT) ) THEN - TMP = STR_COPY_U (UNDERSC,SYMBOL(:LSYM),PTR,STREAM,LS) - IF (TMP.LT.0) IS = MSG_SET (DWC_STRTOOSHO,1) - IF (TMP.LT.0) CALL WNCTXT(DWLOG,DWMSG,LEN(STREAM)) - STREAM(1:1)=DOLLAR !In case it happened to be DOT - LS = STR_SIGLEN (STREAM(:LS)) - ENDIF -C -C Extract keyword (without '_' prefix) -C - IF (PTR.LT.LSYM) THEN - TMP = STR_COPY (SYMBOL(PTR+1:LSYM),KEY,LK) - IF (TMP.LT.0) IS = MSG_SET (DWC_STRTOOSHO,1) - IF (TMP.LT.0) CALL WNCTXT(DWLOG,DWMSG,LEN(KEY)) - LK = STR_SIGLEN (KEY(:LK)) - ENDIF -C - DWC_SYM_SPLIT = IS - RETURN - END -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - INTEGER*4 FUNCTION DWC_SYM_BUILD (PROGNAM,STREAM,KEY,SYMBOL,LSYM) -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' -C - CHARACTER*(*) PROGNAM ! (i) program name - CHARACTER*(*) STREAM ! (i) stream name (with '$' prefix) - CHARACTER*(*) KEY ! (i) keyword (without '_' prefix) - CHARACTER*(*) SYMBOL ! (o) symbol name - INTEGER*4 LSYM ! (o) significant length of SYMBOL -C -C.Purpose: Build a DWARF symbol name from its components -C.Returns: Status code (.TRUE. for success, .FALSE. otherwise) -C success DWC_SUCCESS -C warning DWC_STRTOOSHO the output string is too short -C.Notes: -C - Only non-blank components will be used (ignore trailing blanks). -C - No syntax checks are done. -C------------------------------------------------------------------------- -C -C - CHARACTER*(*) BLANK, UNDERSC - PARAMETER (BLANK = ' ') - PARAMETER (UNDERSC = '_') -C - INTEGER*4 STR_SIGLEN, STR_COPY - INTEGER*4 MSG_SET -C - INTEGER*4 IS, LP, LS, LK - CHARACTER TMP*64 -C -C - SYMBOL = BLANK - LSYM = 0 - LP = STR_SIGLEN (PROGNAM) - LS = STR_SIGLEN (STREAM) - LK = STR_SIGLEN (KEY) -C - IF (LP.GT.0) IS = STR_COPY (PROGNAM(:LP),SYMBOL,LSYM) - IF (LS.GT.0) IS = STR_COPY (STREAM(:LS),SYMBOL,LSYM) - TMP=UNDERSC//KEY(:LK) - IF (LK.GT.0) IS = STR_COPY (TMP(:LK+1),SYMBOL,LSYM) - LSYM = STR_SIGLEN (SYMBOL(:LSYM)) -C - IF (IS.GT.0) THEN - DWC_SYM_BUILD = DWC_SUCCESS - ELSE - DWC_SYM_BUILD = MSG_SET (DWC_STRTOOSHO,1) - CALL WNCTXT(DWLOG,DWMSG,LEN(SYMBOL)) - ENDIF - RETURN - END -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - INTEGER*4 FUNCTION DWC_SYM_EXPAND (SYMBOL,STREAM,XSYMBOL,LX) -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' -C - CHARACTER*(*) SYMBOL ! (i) symbol name - CHARACTER*(*) STREAM ! (i) fill-up stream name - CHARACTER*(*) XSYMBOL ! (o) expanded symbol name - INTEGER*4 LX ! (o) significant length of XSYMBOL -C -C.Purpose: Expand a DWARF symbol name by inserting a stream name -C.Returns: Status code (.TRUE. for success, .FALSE. otherwise) -C success DWC_SUCCESS -C.Notes: -C - If STREAM is a valid stream name (with or without '$' prefix) and -C if SYMBOL is a valid name for a DWARF symbol without a stream -C component (e.g., <prognam>_<keyword>), the stream component will be -C inserted. -C - If the program name is a global one ('DWARF' or 'GLOBAL'), the global -C stream name ('$0') will be used, otherwise the given stream name. -C - If SYMBOL or STREAM violate the DWARF syntax in any way, the -C original name is copied to XSYMBOL. All messages will be suppressed. -C------------------------------------------------------------------------- -C -C - INTEGER*4 DWC_SYM_SPLIT, DWC_SYM_BUILD - INTEGER*4 DWC_PROG_CHECK, DWC_STREAM_CHECK, DWC_STREAM_GET - INTEGER*4 STR_SIGLEN -C - CHARACTER*16 PROG, XSTREAM, TMP, KEY - INTEGER*4 IS, LP, LS, LT, LK - LOGICAL*4 IS_GLOBAL -C -C -C Check whether STREAM is a valid -C stream name (add prefix if necessary) -C - IS = DWC_STREAM_CHECK (STREAM,XSTREAM,LS,.FALSE.) - IF (IAND(IS,1).EQ.0 .OR. LS.EQ.0) GOTO 999 -C -C Split the symbol name in its components -C and check their presence/absence -C - IS = DWC_SYM_SPLIT (SYMBOL,PROG,LP,TMP,LT,KEY,LK) - IF (IAND(IS,1).EQ.0 .OR. - 1 LP.EQ.0 .OR. LT.GT.0 .OR. LK.EQ.0) GOTO 999 -C -C Check the syntax of PROG and get -C the global stream if appropriate -C - IS = DWC_PROG_CHECK (PROG(:LP),LP,IS_GLOBAL) - IF (IAND(IS,1).EQ.0) GOTO 999 - IF (IS_GLOBAL) THEN - IS = DWC_STREAM_GET (XSTREAM,LS,IS_GLOBAL) - IF (IAND(IS,1).EQ.0) GOTO 999 - ENDIF -C -C Build the expanded symbol name -C - IS = DWC_SYM_BUILD (PROG(:LP),XSTREAM(:LS),KEY(:LK),XSYMBOL,LX) - IF (IAND(IS,1).EQ.0) GOTO 999 -C - DWC_SYM_EXPAND = DWC_SUCCESS - RETURN -C - 999 XSYMBOL = SYMBOL - LX = STR_SIGLEN (XSYMBOL) - DWC_SYM_EXPAND = DWC_SUCCESS - RETURN - END -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - INTEGER*4 FUNCTION DWC_SYM_TRANSL (SYMBOL,VALUE,LVAL,CHKSW,SWSYM) -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' -C - CHARACTER*(*) SYMBOL ! (i) symbol name - CHARACTER*(*) VALUE ! (o) symbol value - INTEGER*4 LVAL ! (o) significant length of VALUE - LOGICAL*4 CHKSW ! (i) unknown symbols allowed ? - LOGICAL*4 SWSYM ! (m) were there unknown symbols ? -C -C.Purpose: Translate a DWARF symbol -C.Returns: Status code (.TRUE. for success, .FALSE. otherwise) -C success DWC_SUCCESS -C warning DWC_STRTOOSHO value string has been truncated -C error DWC_SYMNOTDEF unknown symbol (only for CHKSW = .TRUE.) -C.Notes: -C - The value string will be converted to a standard DWARF string. -C - If the symbol is unknown, the dummy value '1' will be returned. -C------------------------------------------------------------------------- -C -C - CHARACTER*(*) DUMMY - INTEGER*4 LDUM - PARAMETER (DUMMY = '1') ! dummy symbol value - PARAMETER (LDUM = 1 ) -C - INTEGER*4 DWC_STR_STANDARD - INTEGER*4 MSG_SET , SYMBOL_GET -C - CHARACTER*255 WORK - INTEGER*4 IS, LW -C -C -C Translate the symbol -C - explicitly translate YES and NO -C - use dummy value for unknown symbol -C - IF (SYMBOL.EQ.'YES' .OR. SYMBOL.EQ.'YE' .OR. SYMBOL.EQ.'Y') THEN - WORK = '.TRUE.' - LW = 6 - ELSE IF (SYMBOL.EQ.'NO' .OR. SYMBOL.EQ.'N') THEN - WORK = '.FALSE.' - LW = 7 - ELSE - IS = SYMBOL_GET (SYMBOL,WORK,LW) - IF (LW.EQ.0) THEN - SWSYM = .TRUE. - IF (.NOT.CHKSW) GOTO 999 ! unknown not allowed - WORK = DUMMY - LW = LDUM - ENDIF - ENDIF -C -C Convert to standard DWARF string -C - DWC_SYM_TRANSL = DWC_STR_STANDARD (WORK(:LW),VALUE,LVAL) - RETURN -C - 999 DWC_SYM_TRANSL = MSG_SET (DWC_SYMNOTDEF,1) - CALL WNCTXT(DWLOG,DWMSG,SYMBOL) - RETURN - END diff --git a/src/dwarf/dwcsymlist.for b/src/dwarf/dwcsymlist.for deleted file mode 100644 index 7d95ff355f12e1ac92886d62aba5361381a1d1c4..0000000000000000000000000000000000000000 --- a/src/dwarf/dwcsymlist.for +++ /dev/null @@ -1,165 +0,0 @@ -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ -C.Ident: DWC_SYMLIST -C.Keywords: DWARF Symbol List -C.Author: Friso Olnon (NFRA, Dwingeloo) -C.Language: DWARF-Fortran -C.Environment: VAX or Alliant -C.Comments: -C - A DWARF symbol list consists of one or more comma-separated fields. -C - Each field in principle has 3 components: -C <program_name>$<stream_name>_<parameter_name> -C where each name can be absent or wildcarded (*). The dollar and -C underscore prefixes are part of the stream and parameter name -C components. -C.Version: 910805 FMO - creation -C.Version: 920214 GvD - no optional arguments in MSG anymore -C------------------------------------------------------------------------- -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - INTEGER*4 FUNCTION DWC_SYMLIST_EXPAND (INLIST,OUTLIST,LOUT) -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' -C - CHARACTER*(*) INLIST !(i) input list - CHARACTER*(*) OUTLIST !(o) output list - INTEGER*4 LOUT !(o) significant length of outlist -C -C.Purpose: Expand the symbol list -C.Returns: Status code (.TRUE. for success, .FALSE. otherwise) -C success 1 -C warning DWC_STRTOOSHO outlist buffer to short -C error DWC_SYNERRSYM syntax error in symbol name -C.Notes: -C - If a component is absent in an input list field, the component from -C the previous field will be inserted, except that the default stream -C for global programs (DWARF and GLOBAL) is $0. The first defaults are: -C *$<current_stream>_*. -C - The syntax of each output field will be checked. -C------------------------------------------------------------------------- -C -C - CHARACTER*(*) BLANK, COMMA, WILD, DOLLAR - PARAMETER (BLANK = ' ') - PARAMETER (COMMA = ',') - PARAMETER (WILD = '*') - PARAMETER (DOLLAR = '$') -C - INTEGER*4 DWC_SYM_SPLIT, DWC_SYM_BUILD - INTEGER*4 DWC_PROG_CHECK, DWC_STREAM_GET, DWC_STREAM_CHECK - INTEGER*4 STR_SIGLEN, STR_COPY, STR_COPY_U, STR_CHECK_ANUMX - INTEGER*4 MSG_SET -C - CHARACTER DEFPROG*9, DEFSTRM*12, DEFKEY*16 - CHARACTER PROGNAM*9, STREAM*12, KEY*16 - CHARACTER INFIELD*64, OUTFIELD*64, STRM*16 - INTEGER*4 LIF, LOF, LDP, LDS, LDK, LP, LS, LK - INTEGER*4 IS, LIN, PTR - LOGICAL*4 IS_GLOBAL -C -C - OUTLIST = BLANK - LOUT = 0 -C -C Set initial defaults -C - DEFPROG = WILD - LDP = 1 - IS = DWC_STREAM_GET (DEFSTRM,LDS,.FALSE.) - DEFKEY = WILD - LDK = 1 -C -C Extract next list field - PTR = 1 - LIN = STR_SIGLEN (INLIST) - DO WHILE (PTR.LE.LIN) - LIF = 0 - IS = STR_COPY_U (COMMA,INLIST(:LIN),PTR,INFIELD,LIF) -C -C Split the symbol name -C - IS = DWC_SYM_SPLIT (INFIELD(:LIF),PROGNAM,LP,STRM,LS,KEY,LK) - IF (IAND(IS,1).EQ.0) GOTO 999 -C -C Check the program name -C and refresh the default -C - IF (LP.EQ.0) THEN - PROGNAM = DEFPROG - LP = LDP - IF (PROGNAM(:LP).EQ.WILD) THEN - IS_GLOBAL = .FALSE. - ELSE - IS = DWC_PROG_CHECK (PROGNAM,LP,IS_GLOBAL) - IF (IAND(IS,1).EQ.0) GOTO 999 - ENDIF - ELSE IF (PROGNAM(:LP).EQ.WILD) THEN - IS_GLOBAL = .FALSE. - DEFPROG = WILD - LDP = 1 - ELSE - IS = DWC_PROG_CHECK (PROGNAM,LP,IS_GLOBAL) - IF (IAND(IS,1).EQ.0) GOTO 999 - DEFPROG = PROGNAM - LDP = LP - ENDIF -C -C Check the stream name -C and refresh the default -C - IF (LS.EQ.0) THEN - IF (IS_GLOBAL) THEN - IS = DWC_STREAM_GET (STRM,LS,.TRUE.) - ELSE - STRM = DEFSTRM - LS = LDS - ENDIF - ENDIF - IF (STRM(:LS).NE.DOLLAR//WILD) THEN - IS = DWC_STREAM_CHECK (STRM(:LS),STREAM,LS,IS_GLOBAL) - IF (IAND(IS,1).EQ.0) GOTO 999 - ELSE - STREAM = STRM(:LS) - ENDIF - IF (.NOT.IS_GLOBAL) THEN - DEFSTRM = STREAM - LDS = LS - ENDIF -C -C Check the parameter name -C and refresh the default -C - IF (LK.EQ.0) THEN - KEY = DEFKEY - LK = LDK - ELSE IF (KEY(:LK).NE.WILD) THEN - IF (LK.GT.16) GOTO 999 - IS = STR_CHECK_ANUMX (KEY(:LK)) - IF (IAND(IS,1).EQ.0) GOTO 999 - DEFKEY = KEY(:LK) - LDK = LK - ELSE - DEFKEY = WILD - LDK = 1 - ENDIF -C -C Append field to output list -C - IF (LOUT.GT.0) IS = STR_COPY (COMMA,OUTLIST,LOUT) - IS = DWC_SYM_BUILD (PROGNAM(:LP),STREAM(:LS),KEY(:LK), - 1 OUTFIELD,LOF) - IS = STR_COPY (OUTFIELD(:LOF),OUTLIST,LOUT) - IF (IS.LT.0) GOTO 998 - PTR = PTR+1 !skip separator - ENDDO -C -C - DWC_SYMLIST_EXPAND = 1 - RETURN -C - 998 DWC_SYMLIST_EXPAND = MSG_SET (DWC_STRTOOSHO,1) - CALL WNCTXT(DWLOG,DWMSG,LEN(OUTLIST)) - RETURN - 999 DWC_SYMLIST_EXPAND = MSG_SET (DWC_SYNERRSYM,1) - CALL WNCTXT(DWLOG,DWMSG,INFIELD(:LIF)) - RETURN - END diff --git a/src/dwarf/dwcsysin.fsc b/src/dwarf/dwcsysin.fsc deleted file mode 100644 index e6d4f9c22d56041dad1e11013898a89bb230209a..0000000000000000000000000000000000000000 --- a/src/dwarf/dwcsysin.fsc +++ /dev/null @@ -1,106 +0,0 @@ -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ -C.Ident: DWC_SYSIN -C.Keywords: DWARF, Standard Input Device -C.Author: Friso Olnon (NFRA, Dwingeloo) -C.Language: DWARF-Fortran -C.Environment: VAX or Alliant -C.Comments: -C The standard input device code is kept in a local saved variable with -C the values: -C 0: input from SYS$INPUT which is a terminal -C (for interactive EXECUTE) -C 3: input from SYS$INPUT which is not a terminal -C (for batch EXECUTE, for EXECUTE/INPUT=file, and for EXECUTE -C from a command procedure) -C 2: input from SYS$COMMAND -C (for EXECUTE/NOWAIT) -C.Version: 900301 FMO - creation -C.Version: 910826 FMO - add code 3 -C.Version: 920214 GvD - no optional arguments in MSG anymore -C.Version: 940117 CMV - made fsc, removed PARM__SYSIN -C------------------------------------------------------------------------- -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - INTEGER FUNCTION DWC_SYSIN_SET (INFILE,LI) -C ENTRY DWC_SYSIN_GET (DEVCOD) -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' - INTEGER DWC_SYSIN_GET -C - CHARACTER*(*) INFILE ! (i) input file - INTEGER LI ! (i) significant length of INFILE - INTEGER DEVCOD ! (o) input device -C -C.Purpose: Set or get the type of standard input -C.Returns: Status code (.TRUE. for success, .FALSE. otherwise) -C success DWC_SUCCESS -C false status returned by referenced routines -C.Notes: -C - For EXECUTE/INPUT=file, we must read all parameter input from this -C file. We will do this by defining SYS$INPUT as that file and reading -C the input from SYS$INPUT. SYS$INPUT will be defined in user-mode in -C the process logical table, so that the definition automatically -C disappears after program completion. -C------------------------------------------------------------------------- -C -#ifdef wn_vx__ - INCLUDE '($LNMDEF)' - INCLUDE '($SSDEF)' -C - INTEGER*4 SYS$CRELNM, SYS$TRNLNM - INTEGER*4 ITEMLST4(4), LN - INTEGER*2 ITEMLST2(2) - EQUIVALENCE (ITEMLST4,ITEMLST2) -#endif -C - INTEGER DWC_PRCMODE_INQ, GEN_TERMSW - INTEGER MSG_SET -C - INTEGER IS - INTEGER STDIN - DATA STDIN /0/ - SAVE STDIN -C -C - IF (LI.GT.0) THEN !input file specified: -#ifdef wn_vx__ - IF (INFILE(:LI).NE.'SYS$INPUT') THEN !make it SYS$INPUT - ITEMLST2(1) = LI - ITEMLST2(2) = LNM$_STRING - ITEMLST4(2) = %LOC (INFILE) - ITEMLST4(3) = LI - ITEMLST4(4) = 0 - IS = SYS$CRELNM (,'LNM$PROCESS', - 1 'SYS$INPUT',,ITEMLST4) - IF (IAND(IS,1).EQ.0) GOTO 999 - END IF -#endif - STDIN = 0 !input from SYS$INPUT -C - ELSE IF (IAND(DWC_PRCMODE_INQ('SUBPROCESS'),1) .NE. 0) THEN !subprocess: - STDIN = 1 !input from SYS$COMMAND -C - ELSE - STDIN = 0 !input from SYS$INPUT - END IF -C - IF (STDIN.EQ.0.AND. GEN_TERMSW('SYS$INPUT').NE.1) THEN - STDIN = 3 !SYS$INPUT no terminal - END IF -C -C - DWC_SYSIN_SET = DWC_SUCCESS - RETURN -C - 999 DWC_SYSIN_SET = MSG_SET (IS,0) - RETURN -C -C =================== - ENTRY DWC_SYSIN_GET (DEVCOD) -C =================== -C - DEVCOD = STDIN -C - DWC_SYSIN_GET = DWC_SUCCESS - RETURN - END diff --git a/src/dwarf/dwcsysout.for b/src/dwarf/dwcsysout.for deleted file mode 100644 index 3cad0aa7770e691e90e5346890f42dc2941cbf03..0000000000000000000000000000000000000000 --- a/src/dwarf/dwcsysout.for +++ /dev/null @@ -1,71 +0,0 @@ -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ -C.Ident: DWC_SYSOUT -C.Keywords: DWARF, Standard Output Device -C.Author: Friso Olnon (NFRA, Dwingeloo) -C.Language: DWARF-Fortran -C.Environment: VAX or Alliant -C.Comments: -C The output device type is kept in a local saved variable with value -C 0 (terminal) or 1 (otherwise) -C.Version: 900301 FMO - creation -C.Version: 910826 FMO - PARM_n no longer needed -C------------------------------------------------------------------------- -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - INTEGER FUNCTION DWC_SYSOUT_SET () -C ENTRY DWC_SYSOUT_INQ (SYSOUT) -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' - INTEGER DWC_SYSOUT_INQ -C - CHARACTER*(*) SYSOUT !(i) device type -C -C.Purpose: Set or inquire after the standard output device -C.Returns: Status code (.TRUE. for success, .FALSE. otherwise) -C success DWC_SUCCESS for SET -C success 1 for INQ if SYSOUT is the correct type -C warning 0 for INQ if SYSOUT is not the correct type -C error 2 for INQ if SYSOUT is invalid type (no msg) -C.Notes: -C SET: -C - For a terminal store 0, otherwise store 1. -C INQ: -C - SYSOUT can be 'TERMINAL' or an abbreviation. -C------------------------------------------------------------------------- -C -C - CHARACTER*(*) TYPE_LIST - PARAMETER (TYPE_LIST = 'TERMINAL') -C - INTEGER GEN_TERMSW, STR_MATCH_L -C - INTEGER IS, NR - INTEGER OUTPUT_DEVICE - DATA OUTPUT_DEVICE /0/ - SAVE OUTPUT_DEVICE -C -C - IF (IAND(GEN_TERMSW('SYS$OUTPUT'),1) .NE. 0) THEN - OUTPUT_DEVICE = 0 - ELSE - OUTPUT_DEVICE = 1 - ENDIF -C - DWC_SYSOUT_SET = DWC_SUCCESS - RETURN -C -C ==================== - ENTRY DWC_SYSOUT_INQ (SYSOUT) -C ==================== -C - IS = STR_MATCH_L (SYSOUT,TYPE_LIST,NR) - IF (NR.EQ.0) THEN - DWC_SYSOUT_INQ = 2 - ELSE IF (OUTPUT_DEVICE.EQ.0) THEN - DWC_SYSOUT_INQ = 1 - ELSE - DWC_SYSOUT_INQ = 0 - ENDIF -C - RETURN - END diff --git a/src/dwarf/dwctest.for b/src/dwarf/dwctest.for deleted file mode 100644 index 7e11dd6db41178258be1ffff38518a1b460d51c6..0000000000000000000000000000000000000000 --- a/src/dwarf/dwctest.for +++ /dev/null @@ -1,74 +0,0 @@ -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ -C.Ident: DWC_TEST -C.Keywords: DWARF, Test Switch -C.Author: Friso Olnon (NFRA, Dwingeloo) -C.Language: DWARF-Fortran -C.Environment: VAX or Alliant -C.Comments: -C Common fields used: -C INTEGER*4 DWARF$TEST ! (m) test mode ? -C -C.Version: 900308 FMO - creation -C------------------------------------------------------------------------- -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - INTEGER*4 FUNCTION DWC_TEST () -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' -C -C -C.Purpose: Make source module name known -C.Returns: Status code (.TRUE. for success, .FALSE. otherwise) -C success DWC_SUCCESS -C.Notes: Dummy routine -C------------------------------------------------------------------------- -C -C - DWC_TEST = DWC_SUCCESS - RETURN - END -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - INTEGER*4 FUNCTION DWC_TEST_PUT (SWITCH) -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' -C - LOGICAL*4 SWITCH ! (i) switch test mode on ? -C -C.Purpose: Enable or disable test mode -C.Returns: Status code (.TRUE. for success, .FALSE. otherwise) -C success DWC_SUCCESS -C.Notes: -C------------------------------------------------------------------------- -C - INCLUDE 'DWARF_4_DEF' -C -C - IF (SWITCH) THEN - DWARF$TEST = 1 - ELSE - DWARF$TEST = 0 - ENDIF -C - DWC_TEST_PUT = DWC_SUCCESS - RETURN - END -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - INTEGER*4 FUNCTION DWC_TEST_INQ () -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' -C -C -C.Purpose: Inquire whether DWARF is in test mode -C.Returns: Status code (.TRUE. for success, .FALSE. otherwise) -C success 1 yes -C warning 0 no -C.Notes: -C------------------------------------------------------------------------- -C - INCLUDE 'DWARF_4_DEF' -C - DWC_TEST_INQ = DWARF$TEST - RETURN - END diff --git a/src/dwarf/dwctstsym.for b/src/dwarf/dwctstsym.for deleted file mode 100644 index 046f8d377a73b4967ceaec8e2d5124b50bd519f9..0000000000000000000000000000000000000000 --- a/src/dwarf/dwctstsym.for +++ /dev/null @@ -1,62 +0,0 @@ -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ -C.Ident: DWC_TSTSYM -C.Keywords: -C.Author: Ger van Diepen (NFRA, Dwingeloo) -C.Language: DWARF-Fortran -C.Environment: VAX or Alliant -C.Comments: -C.Version: 830110 GVD - creation -C.Version: 901219 FMO - new code -C.Version: 910910 FMO - allow DWARF_<prognam>_CONTROL symbol names -C.Version: 920214 GvD - no optional arguments in MSG anymore -C------------------------------------------------------------------------- -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - INTEGER*4 FUNCTION DWC_TSTSYM (SYMBOL) -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' -C - CHARACTER*(*) SYMBOL ! (i) symbol name -C -C.Purpose: Test whether a user's symbol name is legal to DWCL -C.Returns: Status code (.TRUE. for success, .FALSE. otherwise) -C success DWC_SUCCESS -C error DWC_INVSYMNAM invalid name (too long or not alphanumeric) -C error DWC_RESERVSYM reserved name -C.Notes: -C A legal name is: -C - not longer than 16 characters, -C - alphanumeric with the first character alphabetic, or of the form -C DWARF_<prognam>_CONTROL, or equal to DWARF$X, -C - not a reserved name (e.g. SHOW, LET, KEEP, etc...). -C------------------------------------------------------------------------- -C -C - INTEGER*4 STR_SIGLEN, STR_CHECK_ANUMA, STR_MATCH_L, MSG_SET -C - INTEGER*4 LS, MATCHNR, IS - CHARACTER*(*) NAMELIST ! reserved names - PARAMETER (NAMELIST = - 1 'LET,SPECIFY,VIEW,CLEAR,SAVE,RESTORE,'// - 2 'EXECUTE,ACTIVE,WAIT,CALCULATE,COMPILE,'// - 3 'TO,BY,WHILE,DO,IF,ENDDO,ENDIF') -C -C - LS = STR_SIGLEN (SYMBOL) - IF (LS.GT.32) GOTO 991 - IF (SYMBOL(:LS).EQ.'DWARF$X') GOTO 900 - IF (LS.GT.14 .AND. SYMBOL(:6).EQ.'DWARF_' .AND. - 1 SYMBOL(LS-7:LS).EQ.'_CONTROL') GOTO 900 - IF (IAND(STR_CHECK_ANUMA(SYMBOL(:LS)),1) .EQ. 0) GOTO 991 - IS = STR_MATCH_L (SYMBOL,NAMELIST,MATCHNR) - IF (IS.EQ.1) GOTO 992 -C - 900 DWC_TSTSYM = DWC_SUCCESS - RETURN -C - 991 DWC_TSTSYM = MSG_SET (DWC_INVSYMNAM,0) - RETURN - 992 DWC_TSTSYM = MSG_SET (DWC_RESERVSYM,1) - CALL WNCTXT(DWLOG,DWMSG,SYMBOL) - RETURN - END diff --git a/src/dwarf/dwcwaitpr.fvx b/src/dwarf/dwcwaitpr.fvx deleted file mode 100644 index b56064313c6c9d63e992a805c5f27a59b1644064..0000000000000000000000000000000000000000 --- a/src/dwarf/dwcwaitpr.fvx +++ /dev/null @@ -1,106 +0,0 @@ -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ -C.Ident: DWC_WAITPR -C.Keywords: Process Control, Wait -C.Author: Ger van Diepen (NFRA, Dwingeloo) -C.Language: VAX-Fortran -C.Environment: VAX -C.Comments: -C.Version: 830110 GVD - creation DWCWAITPR.FOR -C.Version: 840727 GVD - removed old flags from GEN_PRTMSG -C.Version: 840808 GVD - new names for subprocesses -C.Version: 910821 FMO - new GEN_WAITTM call -C.Version: 920214 GvD - no optional arguments in MSG anymore -C.Version: 940119 CMV - made .fvx -C------------------------------------------------------------------------- -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - INTEGER FUNCTION DWC_WAITPR (PROGRAM,STREAM) -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' -C - CHARACTER*(*) PROGRAM !(i) program name (* = all) - CHARACTER*(*) STREAM !(i) stream name ($* = all) -C -C.Purpose: Wait for the completion of prognam$stream's -C.Returns: Status code (.TRUE. for success, .FALSE. otherwise) -C success 1 waited for at least 1 process -C info 3 no such processes active -C errors from SYS$GETJPI -C.Notes: -C - This function waits for processes with the given programs and/or -C streams by "polling" via the system-service SYS$GETJPI. Between each -C "poll" the function will wait for 2 seconds. -C - When the function is waiting for a process it will print a message -C on the terminal to tell the user that he is waiting. It will also -C print a message when that process is ready. -C------------------------------------------------------------------------- -C -C - INTEGER DWC_NEXACT, STR_SIGLEN - INTEGER SYS$ASCTIM, SYS$GETJPI, SYS$WAITFR -C - REAL WAITTIME - DOUBLE PRECISION TIME - CHARACTER PROCESS*15, PROGNAM*9, TIMESTR*11 - INTEGER IS, LP, PTR, NEXT, UIC, PIDCUR, PIDOWN, PID - LOGICAL WAIT_DONE - DATA WAIT_DONE /.FALSE./ -C -C -C Get UIC of own process -C - UIC = 0 - NEXT = 0 - IS = DWC_NEXACT (NEXT,PIDCUR,PROCESS,PROGNAM,UIC,TIME,PIDOWN) - IF (IAND(IS,1).EQ.0) GOTO 999 -C -C Get next active subprocess with same UIC -C - NEXT = -1 - IS = DWC_NEXACT (NEXT,PID,PROCESS,PROGNAM,UIC,TIME,PIDOWN) - DO WHILE (IAND(IS,1).NE.0) -C -C Skip unless subprocesses of own process -C with matching program and stream names -C - IF (PIDOWN.EQ.PIDCUR) THEN !own subprocess - LP = STR_SIGLEN (PROCESS) - PTR = INDEX (PROCESS,'$') - IF ((PROGRAM.EQ.'*' .OR. PROGRAM.EQ.PROGNAM) .AND. - 1 (STREAM.EQ.'$*' .OR. STREAM.EQ.PROCESS(PTR:LP))) THEN -C -C Wait for subprocess -C - tell user -C - IS = SYS$ASCTIM (,TIMESTR,TIME,%VAL(1)) - CALL WNCTXT(DWLOG, - 1 'Waiting for !AS!AS (started at !AS)', - 1 PROGNAM,PROCESS(PTR:LP),TIMESTR(:8)) - DO WHILE (SYS$GETJPI(%VAL(0),,PROCESS(:PTR-1),0,,,).EQ.1) - IS = SYS$WAITFR (%VAL(0)) - CALL LIB$WAIT (WAITTIME) - ENDDO - CALL WNCTXT(DWLOG, - 1 'Stream !AS ready; processing continues', - 1 PROCESS(PTR:LP)) - WAIT_DONE = .TRUE. - NEXT = -1 - END IF - END IF - IS = DWC_NEXACT (NEXT,PID,PROCESS,PROGNAM,UIC,TIME,PIDOWN) - END DO -C - IF (IS.NE.2) GOTO 999 !error -C -C Regular end -C - IF (WAIT_DONE) THEN - DWC_WAITPR = 1 - ELSE - DWC_WAITPR = 3 - END IF - RETURN -C - 999 DWC_WAITPR = IS - RETURN - END diff --git a/src/dwarf/dwe.dsc b/src/dwarf/dwe.dsc deleted file mode 100644 index d28420067b4e94ce75c1cc264795feef7121fe10..0000000000000000000000000000000000000000 --- a/src/dwarf/dwe.dsc +++ /dev/null @@ -1,54 +0,0 @@ -!+ DWE.DSC -! WNB 940304 -! -! Revisions: -! -%REVISION=WNB=940304="Original version" -! -! DWexecute common for switches -! -%COMMENT="DWE.DEF is a common area for the use of dwe switches" -%COMMENT=" " -! -%VERSION=1 -%SYSTEM=1 -%USER=WNB -%%DATE -%%NAME -! -%ALIGN -! -%LOCAL=CLI__PARAMETER=0 !CLI bits -%LOCAL=CLI__REQUIRED=8 -%LOCAL=CLI__QUALIFIER=1 -%LOCAL=CLI__DEFAULT=4 -%LOCAL=CLI__VALUE=16 -%LOCAL=PREQ=CLI__PARAMETER+CLI__REQUIRED -%LOCAL=Q=CLI__QUALIFIER -%LOCAL=QDEF=Q+CLI__DEFAULT -%LOCAL=QVAL=Q+CLI__VALUE -!- -.DEFINE - .DATA - SW A:(1) /PROGSTRM,WAIT,DEBUG,TEST,ASK, \ !SWITCH NAMES - SAVE,INPUT,BATCH,LOG, \ !Note: All NGEN variables - RUN,DATAB,INFIX,APPLY, \ !after LOG - DE_APPLY,UFLAG,MEMORY,MODELB/ -%GLOBAL=NRARG=SW__N-1 !# OF SWITCHES - !Note: Dwarf CLI interface - ! limits it to 20 now - ATTR J(NRARG) /PREQ, QDEF,Q,Q,Q, \ !SWITCH TYPES - Q,QVAL,Q,QVAL, \ - Q,QVAL,QVAL,QVAL, \ - QVAL,QVAL,QVAL,QVAL/ - PROMPT C14(NRARG) /"Program$stream",(NRARG-1)" "/ !SWITCH PROMPS - DEFVAL C8(NRARG) /(8)" ",SPOOL, \ !SWITCH DEFAULT VALUE - " "," "," ","*", \ - NONE,NONE,"100000"," "/ - NEGDEF C8(NRARG) /(8)" ",NO, \ !NEGATED DEFAULTS - NO,"""""""""","""""""""",NONE, \ - ALL,ALL,100000,""""""""""/ - VSW C80(NRARG) !SWITCH VALUES - LSW J(NRARG) !SWITCH VALUE LENGTHS - QSW J(NRARG) !SWITCH SEEN VALUES -.END diff --git a/src/dwarf/execute.fsc b/src/dwarf/execute.fsc deleted file mode 100644 index d12b3418330e3deea45fa75dca02a4e6ee240677..0000000000000000000000000000000000000000 --- a/src/dwarf/execute.fsc +++ /dev/null @@ -1,393 +0,0 @@ -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ -C.Ident: SYS_EXECUTE (EXECUTE.FSC) -C.Keywords: DWARF, Program, Execution Start -C.Author: Friso Olnon (NFRA, Dwingeloo) -C.Language: Fortran -C.Environment: Unix, VAX -C.Comments: -C.Version: 900417 FMO - recreation -C.Version: 910913 FMO - for N-programs: add LOG, DATAB, INFIX, APPLY and -C DE_APPLY qualifiers and change the meaning of RUN -C.Version: 911203 GvD - start program via EXECL if interactive -C.Version: 920313 GvD - include optional arguments -C.Version: 930607 WNB - add UFLAG -C.Version: 930923 CMV - logical names for new maintenance system -C.Version: 940121 CMV - changed messenger -C.Version: 940211 WNB - change file inquire -C.Version: 940215 WNB - add MEMORY -C.Version: 940216 WNB - Make FSC -C.Version: 940223 CMV - Call to SYMBOL_DEFINE had disappeared -C.Version: 940224 CMV - Quote DATAB and INFIX before passing to sp_list -C.Version: 940224 CMV - add MODELB -C.Version: 940304 WNB - add proper handling of N switches -C quote MODELB before passing to sp_list -C------------------------------------------------------------------------- -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - SUBROUTINE EXECUTE -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' - INCLUDE 'DWE_DEF' -C -C -C.Purpose: Start a DWARF application program -C.Returns: Not applicable -C.Notes: -C - The program is started via a EXECL or SYSTEM call. -C - With /BATCH or /NOWAIT, the program will run in the background; -C otherwise it will run in the foreground. -C - Program input: -C if /INPUT=<file> is given: from that file; -C else if /BATCH: from the null device; -C else: from the terminal (note that /NOWAIT causes the program -C to stop when it needs input). -C - Program output: -C if /BATCH: in the file <prognam><stream>.log; -C otherwise: to the terminal. -C - When /DEBUG is given, the program will be executed under dbx. The -C debug switch is ignored for /BATCH, /NOWAIT and /INPUT. -C------------------------------------------------------------------------- -C - CHARACTER*(*) PROGRAM, TYPE - PARAMETER (PROGRAM = 'EXECUTE') - PARAMETER (TYPE = '.EXE' ) -C - INTEGER SP_LIST - INTEGER CLI_INIT, CLI_GET - INTEGER DWC_CTL_OPEN -#ifdef wn_vx__ - INTEGER DWC_WAITPR - INTEGER DWC_IBMODE_INQ, DWC_IDENT_GET - INTEGER SYS$GETJPI, SYS$WAITFR -#endif - INTEGER DWC_SYM_SPLIT - INTEGER DWC_PROG_CHECK, DWC_STREAM_CHECK, DWC_STREAM_GET - INTEGER DWC_SYM_BUILD - INTEGER PPD_INIT, PPD_EXIT - INTEGER MSG_INIT, MSG_SET - INTEGER SYMBOL_DEFINE, SYMBOL_EXIT, FILNAM_FULL - INTEGER SYMBOL_GET - INTEGER STR_SIGLEN, STR_COPY - INTEGER GEN_SYSTEM - LOGICAL WNFOP - INTEGER WNCALN -C - CHARACTER PROG*9, STRM*12, STREAM*12, KEY*16 - CHARACTER SYMNAM*25, SYMVAL*255, QUALS*512 - CHARACTER EXEFILE*80, INFILE*80, OUTFILE*80, COMMAND*256 - CHARACTER*40 SYMBOL - CHARACTER*32 TXT - INTEGER IS, TMP, LEXE, LIN, LOUT, LC - INTEGER LP,LS,LK,LN,LV,LQ,LSYM - LOGICAL IS_GLOBAL, EXIST - INTEGER FCAT -#ifdef wn_vx__ - CHARACTER PRCNAM*15 - INTEGER LPRC -#endif -C -C Initialize -C - get DWARF control variables -C - start messenger -C - initialize command-line interpreter -C - IS = DWC_CTL_OPEN () - IF (IAND(IS,1).NE.0) IS = MSG_INIT (PROGRAM,F_T) - IF (IAND(IS,1).NE.0) IS = CLI_INIT (NRARG,SW__TXT,ATTR,PROMPT,DEFVAL) - IF (IAND(IS,1).EQ.0) GOTO 999 -C -C Get program and stream names -C - IS = CLI_GET (SW__TXT(SW_PRO),VSW(SW_PRO),LSW(SW_PRO)) - IF (IAND(IS,1).NE.0) - 1 IS = DWC_SYM_SPLIT (VSW(SW_PRO)(:LSW(SW_PRO)),PROG,LP, - 1 STRM,LS,KEY,LK) - IF (IAND(IS,1).NE.0) IS = DWC_PROG_CHECK (PROG(:LP),LP,IS_GLOBAL) - IF (IAND(IS,1).EQ.0) GOTO 999 - IF (LS.GT.0) THEN - IS = DWC_STREAM_CHECK (STRM(:LS),STREAM,LS,IS_GLOBAL) - ELSE - IS = DWC_STREAM_GET (STREAM,LS,IS_GLOBAL) - END IF - IF (IAND(IS,1).EQ.0) GOTO 999 -C -C Find the executable image file -C - - IS = FILNAM_FULL (PROG(:LP)//TYPE,EXEFILE,LEXE,' ') - IF (IAND(IS,1).EQ.0) GOTO 999 - EXIST=WNFOP(FCAT,EXEFILE(:LEXE),'R') - IF (EXIST) THEN - CALL WNFCL(FCAT) - IS = MSG_SET (DWC_EXEUSER,1) - CALL WNCTXT(DWLOG,DWMSG,PROG(:LP)//TYPE) - ELSE - IS = FILNAM_FULL (PROG(:LP)//TYPE,EXEFILE,LEXE,'n_uexe') - IF (IAND(IS,1).EQ.0) GOTO 999 - EXIST=WNFOP(FCAT,EXEFILE(:LEXE),'R') - IF (EXIST) THEN - CALL WNFCL(FCAT) - IS = MSG_SET (DWC_EXEUSER,1) - CALL WNCTXT(DWLOG,DWMSG,PROG(:LP)//TYPE) - ELSE - IS = FILNAM_FULL (PROG(:LP)//TYPE,EXEFILE,LEXE,'n_exe') - IF (IAND(IS,1).EQ.0) GOTO 999 - EXIST=WNFOP(FCAT,EXEFILE(:LEXE),'R') - IF (EXIST) THEN - CALL WNFCL(FCAT) - ELSE - GOTO 991 - END IF - END IF - END IF -#ifdef wn_vx__ -C -C Wait for image in this stream -C - First SYS$GETJPI is used to do the -C wait job quicker in case the stream -C is inactive (DWC_WAITPR would give -C more overhead). -C - Besides, it takes a while before -C SPAWN starts the image in the -C subprocess, so DWC_WAITPR might not -C recognize the image name (and won't -C wait). This happens if a next EXECUTE -C is done immediately after the first -C EXECUTE/NOWAIT. -C - IS = DWC_IDENT_GET (PRCNAM,LPRC) - IF (IAND(IS,1).EQ.0) GOTO 999 - PRCNAM(LPRC+1:) = STREAM - LPRC = LPRC+LS - DO WHILE (SYS$GETJPI(%VAL(0),,PRCNAM(:LPRC),0,,,)) - CALL SYS$WAITFR (%VAL(0)) - TMP = DWC_WAITPR (PROG,STREAM) - END DO -#endif -C -C Analyse the qualifiers -C - DO I=2,NRARG - IS = CLI_GET (SW__TXT(I),VSW(I),LSW(I)) - IF (IAND(IS,1).EQ.0) GOTO 999 - QSW(I) = IS - END DO -C -C SET SAVE FOR RUN -C - IF (PROG(:1).NE.'N' .AND. QSW(SW_RUN).EQ.DWC_ABSENT) - 1 QSW(SW_RUN) = DWC_PRESENT - IF (PROG(:1).EQ.'N' .AND. QSW(SW_RUN).EQ.DWC_NEGATED) - 1 QSW(SW_SAV) = DWC_PRESENT -C -C Create symbol DWARF_<prognam>_CONTROL -C - to pass the stream name and the ASK, -C SAVE and TEST qualifiers to PROG_START -C (used for update of DWARF common) -C - The symbol name need not contain the -C stream name since it is unique until -C the next run of EXECUTE (in fact, -C even the program name is superfluous). -C - SYMNAM = 'DWARF_'//PROG(:LP)//'_CONTROL' - LN = STR_SIGLEN (SYMNAM) -C -C - SYMVAL = '000' - LV = 0 - IF (QSW(SW_ASK).EQ.DWC_PRESENT) THEN - SYMVAL(1:1) = '2' - ELSE IF (QSW(SW_ASK).EQ.DWC_NEGATED) THEN - SYMVAL(1:1) = '1' - END IF - IF (QSW(SW_SAV).EQ.DWC_PRESENT) THEN - SYMVAL(2:2) = '2' - ELSE IF (QSW(SW_SAV).EQ.DWC_NEGATED) THEN - SYMVAL(2:2) = '1' - END IF - IF (QSW(SW_TES).EQ.DWC_PRESENT) THEN - SYMVAL(3:3) = '2' - ELSE IF (QSW(SW_TES).EQ.DWC_NEGATED) THEN - SYMVAL(3:3) = '1' - END IF -#ifdef wn_vx__ - WRITE (SYMVAL(4:),1000) LS,STREAM(:LS), - 1 LSW(SW_INP),VSW(SW_INP)(:LSW(SW_INP)) - 1000 FORMAT (I2.2,A,I2.2,A) - LV = 3+2+LS+2+LSW(SW_INP) -#else - WRITE (SYMVAL(4:),1000) LS,STREAM(:LS),'00' - 1000 FORMAT (I2.2,A,A) - LV = 3+2+LS+2 -#endif - TMP = SYMBOL_DEFINE(SYMNAM(:LN),SYMVAL(:LV),DWC__LOCALSYM) -C -C Specify defaults for N programs -C according to the qualifiers given -C - IF (PROG(:1).EQ.'N') THEN - QUALS = ' ' - LQ = 0 - VSW(SW_RUN)='YES' !/RUN VALUE - DO I=SW_LOG,NRARG !CHECK ALL POSSIBLES - IF (QSW(I).EQ.DWC_NEGATED) THEN - TXT='/X_'//SW__TXT(I)(:WNCALN(SW__TXT(I)))// - 1 '='//NEGDEF(I) - IS = STR_COPY (TXT(:WNCALN(TXT)),QUALS,LQ) - ELSE IF (QSW(I).EQ.DWC_PRESENT) THEN - IF (I.EQ.SW_DAT .OR. I.EQ.SW_INF .OR. - 1 I.EQ.SW_MOD) THEN !ADD "" - TXT='/X_'//SW__TXT(I)(:WNCALN(SW__TXT(I)))// - 1 '="'//VSW(I)(:LSW(I))//'"' - ELSE - TXT='/X_'//SW__TXT(I)(:WNCALN(SW__TXT(I)))// - 1 '='//VSW(I)(:LSW(I)) - END IF - IS = STR_COPY (TXT(:WNCALN(TXT)),QUALS,LQ) - END IF - END DO - IF (LQ.GT.0) THEN - IS = PPD_INIT (PROG(:LP)) - IF (IAND(IS,1).EQ.0) THEN - IS = MSG_SET (IS,0) - GOTO 999 - END IF - IS = SP_LIST (PROG(:LP),STREAM(:LS),QUALS(:LQ)) - TMP = PPD_EXIT () - IF (IAND(IS,1).EQ.0) GOTO 999 - END IF - END IF - IS = SYMBOL_EXIT () -C -C Start the program, unless /NORUN -C is given for a non-N program -C - IF (PROG(:1).EQ.'N' .OR. QSW(SW_RUN).NE.DWC_NEGATED) THEN -#ifdef wn_vx__ -C -C If /BATCH: -C - start EXEBATCH.COM to save session -C context and queue batch job -C - IF (QSW(SW_BAT).EQ.DWC_PRESENT) THEN - CALL LIB$DO_COMMAND ('@n_exe:EXEBATCH "' - 1 //VSW(SW_PRO)(:LSW(SW_PRO))//'"' ) - GOTO 999 - ENDIF -C -C If in batch mode: -C - start program execution via RUN -C - IF (IAND(DWC_IBMODE_INQ('BATCH'),1) .NE. 0) THEN - CALL LIB$DO_COMMAND ('$ RUN/NODEBUG '//EXEFILE(:LEXE)) - GOTO 999 - ENDIF -C -C If /NOWAIT: -C - spawn subprocess running the image -C - the CONTROL symbol will transmit the -C qualifier information -C - EXENOWAIT.COM must be used as an -C intermediate layer to execute a -C SET MESSAGE -C - IF (QSW(SW_WAI).EQ.DWC_NEGATED) THEN - CALL LIB$DO_COMMAND ('SPAWN/NOWAIT/PROCESS=' - 1 //PRCNAM(:LPRC) - 1 //' @n_exe:EXENOWAIT "' - 1 //EXEFILE(:LEXE)//'"') - GOTO 999 - ENDIF -C -C Otherwise: -C - start program via RUN command -C - IF (QSW(SW_DEB).EQ.DWC_NEGATED) THEN - CALL LIB$DO_COMMAND ('$ RUN/NODEBUG '//EXEFILE(:LEXE)) - ELSE IF (QSW(SW_DEB).EQ.DWC_PRESENT) THEN - CALL LIB$DO_COMMAND ('$ RUN/DEBUG '//EXEFILE(:LEXE)) - ELSE - CALL LIB$DO_COMMAND ('$ RUN '//EXEFILE(:LEXE)) - ENDIF - ENDIF -#else -C -C If /DEBUG is given: -C - ignore for /BATCH, /NOWAIT or /INPUT -C - run program under dbx -C - IF (QSW(SW_DEB).EQ.DWC_PRESENT .AND. - 1 QSW(SW_BAT).NE.DWC_PRESENT .AND. - 1 QSW(SW_WAI).NE.DWC_NEGATED .AND. - 1 LSW(SW_INP).EQ.0) THEN - COMMAND = 'dbx '//EXEFILE(:LEXE) - ELSE - COMMAND = EXEFILE(:LEXE) - END IF - LC = STR_SIGLEN (COMMAND) -C -C Determine standard input stream -C - /INPUT=<file>: that file -C - /BATCH: the null device -C - otherwise: terminal -C - IF (LSW(SW_INP).GT.0) THEN - IS = FILNAM_FULL (VSW(SW_INP)(:LV),INFILE,LIN,' ') - IF (IAND(IS,1).EQ.0) GOTO 999 - COMMAND(LC+1:) = ' <'//INFILE(:LIN) - ELSE IF (QSW(SW_BAT).EQ.DWC_PRESENT) THEN - COMMAND(LC+1:) = ' </dev/null' - END IF - LC = STR_SIGLEN (COMMAND) -C -C Determine standard output stream -C - /BATCH: <prognam><stream>.log -C - otherwise: terminal -C - IF (QSW(SW_BAT).EQ.DWC_PRESENT) THEN - IS = FILNAM_FULL (PROG(:LP)//STREAM(:LS)//'.LOG', - 1 OUTFILE,LOUT,' ') - IF (IAND(IS,1).EQ.0) GOTO 999 - COMMAND = COMMAND(:LC)//' >'//OUTFILE(:LOUT) - LC = STR_SIGLEN (COMMAND) - END IF -C -C If /NOWAIT or /BATCH: -C - run program in the background -C - IF (QSW(SW_WAI).EQ.DWC_NEGATED .OR. - 1 QSW(SW_BAT).EQ.DWC_PRESENT) THEN - COMMAND = COMMAND(:LC)//' &' - LC = LC+2 - END IF -C -C Start program -C If the command contains no blanks, it -C can be executed via EXECL (which does -C not start a new process). -C Since GEN_EXECL is a C routine, add -C a zero to the strings. -C Otherwise (or if EXECL returns, thus -C fails), we use SYSTEM. -C - IF (INDEX (COMMAND(:LC),' ') .EQ. 0) THEN - CALL GEN_EXECL (COMMAND(:LC)//CHAR(0), PROG(:LP)//CHAR(0)) - ENDIF - TMP = GEN_SYSTEM (COMMAND(:LC)//CHAR(0)) - GOTO 900 - END IF -#endif -C -C -C -C - 999 IF (IAND(IS,1).EQ.0) TMP = MSG_SET (DWC_EXEERRORS,0) -C - 991 IS = MSG_SET (DWC_FILNOTFND,1) - CALL WNCTXT(DWLOG,DWMSG,PROG(:LP)//TYPE) - TMP = MSG_SET (DWC_EXEERRORS,0) - E_C = IS ! Exit code for WNGEX - 900 CONTINUE -C -C - END diff --git a/src/dwarf/filnam.fun b/src/dwarf/filnam.fun deleted file mode 100644 index 39e8fc46f37b0cc173f1ebaae0451dea24d75583..0000000000000000000000000000000000000000 --- a/src/dwarf/filnam.fun +++ /dev/null @@ -1,123 +0,0 @@ -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ -C.Ident: GENUN_FILNAM -C.Keywords: File Names -C.Author: Friso Olnon (NFRA, Dwingeloo) -C.Language: DWARF-Fortran -C.Environment: UNIX -C.Comments: -C.Version: 900415 FMO - creation -C.Version: 920225 GvD - no optional arguments anymore -C.Version: 920501 GvD - allow absence of colon (as in HOME[GVD.B]X.Y) -C.Version: 930923 CMV - revised for Unix -C.Version: 940315 CMV - treatment ./ and ../ as absolute paths -C------------------------------------------------------------------------- -C++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - INTEGER*4 FUNCTION FILNAM_FULL (SPEC,XSPEC,LX,DEFSPEC) -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' -C - CHARACTER*(*) SPEC ! (i) file specification - CHARACTER*(*) XSPEC ! (o) resulting spec - INTEGER*4 LX ! (o) its length - CHARACTER*(*) DEFSPEC ! (i) default spec (optional) -C -C.Purpose: Make full file specification -C.Returns: Status code (.TRUE. for success, .FALSE. otherwise) -C success GEN_SUCCESS -C error 2 CURD buffer overflow or invalid syntax -C fatal GEN_STROVFLO XSPEC is too short -C false status code returned by referenced routines -C.Notes: -C -C DWARF file specifications on Unix systems are normal Unix paths -C (absolute or relative) consisting of one or more components -C separated by flags. The trailing component (the filename) should -C have an extension following a dot. -C -C SPEC is always converted to lowercase, so pathspecifcations -C that include Capitals should be supplied through DEFSPEC. -C This is a consequence of the conventions in the CPL routines. -C -C If SPEC is a relative path and if DEFSPEC is not empty and does -C not start with a dot, DEFSPEC is used as a directory prefix. -C If DEFSPEC starts with a slash it is just prefixed, otherwise it -C is treated as an environment variable and translated. -C -C If the path in SPEC does not have an extension, and if DEFSPEC -C starts with a dot, than the extension in DEFSPEC (converted to -C lowercase) is appended to SPEC to give the full filename. -C -C------------------------------------------------------------------------ -C -C - CHARACTER*(*) BLANK, SLASH, DOT, DOLLAR - PARAMETER (BLANK = ' ') - PARAMETER (SLASH = '/') - PARAMETER (DOT = '.') - PARAMETER (DOLLAR = '$') -C - INTEGER WNCALN -C - CHARACTER CURD*128, LSPEC*128 - INTEGER*4 LS, LD, IS -C -C Clear XSPEC to start with, get length of strings -C - XSPEC = BLANK - LX = 0 - LS = WNCALN(SPEC) - LD = WNCALN(DEFSPEC) - LSPEC=SPEC(1:LS) - CALL WNCALC(LSPEC(1:LS)) -C -C SPEC starts with slash, ./ or ../: copy absolute path -C - IF (SPEC(1:1).EQ.SLASH .OR. - 1 SPEC(1:2).EQ.DOT//SLASH .OR. - 1 SPEC(1:3).EQ.DOT//DOT//SLASH) THEN - XSPEC=LSPEC(1:LS) -C -C SPEC is relative path, DEFSPEC is absolute -C - ELSE IF (DEFSPEC.NE.BLANK.AND.DEFSPEC(1:1).EQ.SLASH) THEN - XSPEC=DEFSPEC(1:LD)//LSPEC(1:LS) -C -C SPEC is relative path, DEFSPEC is not an extension -C - ELSE IF (DEFSPEC.NE.BLANK.AND.DEFSPEC(1:1).NE.DOT) THEN - CALL WNGSEG(DEFSPEC,CURD) - IF (CURD.NE.' ') THEN - LD=WNCALN(CURD) - XSPEC=CURD(1:LD)//SLASH//LSPEC(1:LS) - ELSE - XSPEC=LSPEC(1:LS) - ENDIF -C -C Otherwise just use the relative path -C - ELSE - XSPEC=LSPEC(1:LS) - ENDIF -C -C Now check the extension -C - LX=WNCALN(XSPEC) - IF (DEFSPEC(1:1).EQ.DOT) THEN - I=LX - DO WHILE (I.GT.1.AND.XSPEC(I:I).NE.DOT - & .AND.XSPEC(I:I).NE.SLASH) - I=I-1 - ENDDO - IF (XSPEC(I:I).NE.DOT) THEN - CALL WNCALC( DEFSPEC(1:LD) ) - XSPEC(LX+1:)=DEFSPEC(1:LD) - LX=LX+LD - ENDIF - ENDIF -C -C That's all, success always -C - FILNAM_FULL = GEN_SUCCESS - RETURN - END diff --git a/src/dwarf/filnam.fvx b/src/dwarf/filnam.fvx deleted file mode 100644 index b00094add293788604b4a7cf22628d3ecd5318e2..0000000000000000000000000000000000000000 --- a/src/dwarf/filnam.fvx +++ /dev/null @@ -1,66 +0,0 @@ -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ -C.Ident: VGEN_FILNAM -C.Keywords: File Names -C.Author: Friso Olnon (NFRA, Dwingeloo) -C.Language: VAX-Fortran -C.Environment: VAX -C.Comments: -C.Version: 900403 FMO - creation -C.Version: 920225 GvD - no optional arguments anymore -C.Version: 930923 CMV - Revised definition of DEFSPEC -C------------------------------------------------------------------------- -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - INTEGER*4 FUNCTION FILNAM_FULL (SPEC,XSPEC,LX,DEFSPEC) -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' -C - CHARACTER*(*) SPEC ! (i) file specification - CHARACTER*(*) XSPEC ! (o) resulting spec - INTEGER*4 LX ! (o) its length - CHARACTER*(*) DEFSPEC ! (i) default spec (optional) -C -C.Purpose: Make full file specification -C.Returns: Status code (.TRUE. for success, .FALSE. otherwise) -C status code from GEN_MIXFNM -C.Notes: -C DWARF file specifications follow VMS syntax; they are case-insensitive -C and consist of five fields: -C - device field (ends with ':') -C - directory field (starts with '[' and ends with ']') -C - name field (starts after ']' and ends before '.') -C - type field (starts with '.' and ends before ';') -C - version field (starts with ';') -C -C - The fields may contain wildcards ('*' or '%'); such fields are -C handled as normal fields (no expansion). -C - If the first (or only) field is a logical name, the name will be -C replaced by the equivalent string (repeatedly if necessary) before -C expansion takes place. -C - DEFSPEC can be either a default device/directory specification -C (may be a logical name) or a default type (extension). -C - Relative directory specifications (e.g., '[]', '[.X.Y]', '[-.X]') -C will be expanded. -C -C E.g.: current default = 'USER5:[OLNON.WORK]' -C ('NEW',XSPEC,LX,'OLD.FOR') -> XSPEC = 'USER5:[OLNON.WORK]NEW.FOR;' -C ('[DWARF]NEW',XSPEC,LX,'.FOR') -> XSPEC = 'USER5:[DWARF]NEW.FOR;' -C ('[-.TEST]*.*',XSPEC,LX) -> XSPEC = 'USER5:[OLNON.TEST]*.*;' -C------------------------------------------------------------------------- -C - INTEGER*4 GEN_MIXFNM, STR_SIGLEN - INTEGER*4 LD -C - IF (DEFSPEC.EQ.'HOME') THEN - FILNAM_FULL = GEN_MIXFNM (DEFSPEC,SPEC,XSPEC,LX) - ELSE - LD=STR_SIGLEN(DEFSPEC) - IF (LD.GT.0.AND.DEFSPEC(1:1).NE.'.') THEN - FILNAM_FULL = - 1 GEN_MIXFNM (DEFSPEC(1:LD)//':',SPEC,XSPEC,LX) - ELSE - FILNAM_FULL = GEN_MIXFNM (DEFSPEC,SPEC,XSPEC,LX) - ENDIF - ENDIF - RETURN - END diff --git a/src/dwarf/gen.grp b/src/dwarf/gen.grp deleted file mode 100644 index ef701c87718acf89bdb5877e1b3ab7a6dc1251b8..0000000000000000000000000000000000000000 --- a/src/dwarf/gen.grp +++ /dev/null @@ -1,149 +0,0 @@ -!+ GEN.GRP -! WNB 920915 -! -! Revisions: -! HjV 921031 Genaral update -! HjV 921207 Add routine and entry names -! WNB 921209 Delete dwfldef -! HjV 930226 Change some .FOR to .FUN; add VAX-files (.FVX and .MVX) -! CMV 930712 Added GEN_SIZE (for more function in help) -! CMV 930922 Changed all INC to DEF -! CMV 940120 Removed a whole bunch of routines (replaced by -! equivalent calls to WNG stuff) -! CMV 940131 Moved .DEF files to relevant grp's, -! removed DEFVSNLST.FOR -! HjV 940301 Add PRTUSE -! JPH 941111 Remove GENMOSAIC (now XMOSAIC_RESTART in sys.grp) -! CMV 94114 Keep GENMOSAIC. No used, but don't want it to -! disappear yet. -! JPH 951108 Add GENFLUSH.CUN -! HjV 960618 Remove GENFLUSH.CUN -! AXC 010628 Changes for linux port -! -! General routines for DWARF programs -! -! Group definition: -! -GEN.GRP -! -! Masks for program development -! -! PIN files -! -! Structure files -! -! Help files -! -! -! General command files -! -! -! Initialisation command files -! -! -! Fortran definition files: -! -! -! Programs: -! -BLBCOMPARE.FOR !BLB_COMPARE - !BLB_COMPAR1 -FILNAM.FUN !FILNAM_FULL - FILNAM.FVX !FILNAM_SPLIT -GENBRDCAST.FOR !GEN_BRDCAST -GENCALL.MVX !GEN_CALL -GENCLRBLX.FOR !CLEAR_BLB Replace by WN later - !GEN_CLRBLB - !CLEAR_BLI - !GEN_CLRBLI - !CLEAR_BLJ - !GEN_CLRBLJ - !CLEAR_BLR - !GEN_CLRBLR - !CLEAR_BLD - !GEN_CLRBLD -GENCVT.FOR !GEN_CVT - !GEN_CVT_NR_D - !GEN_CVT_D_NR - !GEN_CVT_NR_L -GENERRNO.CHP !IERRNO - !GERROR -GENEXECL.CUN !GEN_EXECL Start a program on behalf of - GENEXECL.FVX ! another (FORTRAN) program -GENFORIOS.FUN !GEN_FORIOS_VMSERR - GENFORIOS.FVX !GEN_FORIOS -GENGETFOR.FSC !GEN_GETFOR -GENGETMSG.FOR !GEN_GETMSG -GENGETPAR.CUN !GET_PARM Get a value set for a program parameter - GENGETPAR.FVX ! -GENINPUT.FUN !GEN_INPUT - GENINPUT.FVX !GEN_INPUT_AST -GENISATERM.FSC !GEN_ISATERM -GENISATTY.CUN !GEN_ISATTY Test if file desriptor is associated - ! with a terminal -GENMIXFNM.MVX !GEN_MIXFNM -GENMOSAIC.CUN !GEN_MOSAIC Start xmosaic on-line help browser -GENMOVBLX.FOR !MOVE_BLB - !GEN_MOVBLK - !MOVE_BLI - !GEN_MOVBLI - !MOVE_BLJ - !GEN_MOVBLJ - !MOVE_BLR - !GEN_MOVBLR - !MOV_BLD - !GEN_MOVBLD -GENOUTPUT.FOR !GEN_OUTPUT - !GEN_OUTPUT_NOCR -GENSIZE.CUN !GEN_SIZE Get size of terminal screen - GENSIZE.FVX ! -GENSYMBOL.FUN !SYMBOL_SEAR - GENSYMBOL.FVX !SYMBOL_INIT - !SYMBOL_DEFINE - !SYMBOL_SEARCH - !SYMBOL_GET - !SYMBOL_DELETE - !SYMBOL_EXIT -GENSYMBOLC.CUN ! -GENSYSTEM.CUN !GEN_SYSTEM Execute command in a subprocess - GENSYSTEM.FVX ! -GENTERMSW.FUN !GEN_TERMSW - GENTERMSW.FVX ! -! -MSG.FOR !MSG_INIT Set program name and output files - !MSG_SET Convert Message code -! -PPDFILE.FSC !PPD_FILE_FIND - !PPD_FILE_OPEN - !PPD_FILE_CLOSE -PRTUSE.FSC !PRTUSE Print line in $n_import/newstar.use -! -STRCHECK.FOR !STR_CHECK_ALPH - !STR_CHECK_NUM - !STR_CHECK_ANUM - !STR_CHECK_ANUM_ - !STR_CHECK_ANUMX - !STR_CHECK_ANUMA -STRCOLLAPS.FOR !STR_COLLAPS -STRCOPY.FOR !STR_COPY - !STR_COPY_W - !STR_COPY_R - !STR_COPY_U -STRLENGTH.FOR !STR_SIGLEN -STRMATCH.FOR !STR_MATCH - !STR_MATCH_A - !STR_MATCH_L -STRREAD.FOR !STR_READ_B - !STR_READ_I - !STR_READ_J - !STR_READ_R - !STR_READ_D -STRSKIP.FOR !STR_SKIP_U - !STR_SKIP_PAST - !STR_SKIP_W -STRUPCASE.FOR !STR_UPCASE - !STR_UPCCPY -! -! Executables -! -!- diff --git a/src/dwarf/genbrdcast.for b/src/dwarf/genbrdcast.for deleted file mode 100644 index 5a0950d19246f3897bd0ef7d083addf9f0adad43..0000000000000000000000000000000000000000 --- a/src/dwarf/genbrdcast.for +++ /dev/null @@ -1,30 +0,0 @@ -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ -C.Ident: GENUN_BRDCAST -C.Keywords: Terminal output -C.Author: Friso Olnon (NFRA, Dwingeloo) -C.Language: DWARF-Fortran -C.Environment: UNIX -C.Comments: -C.Version: 880508 FMO - Created -C.Version: 910825 FMO - use PRINT i.s.o. TYPE -C.Version: 920316 GvD - use GEN_OUTPUT iso. PRINT -C------------------------------------------------------------------------- -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - INTEGER*4 FUNCTION GEN_BRDCAST (TEXT) -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' -C - CHARACTER*(*) TEXT ! (i) text to be written -C -C.Purpose: Force immediate write of a text to the terminal -C.Returns: Status code (.TRUE. for success, .FALSE. otherwise) -C success 1 always -C.Notes: For the moment just a Fortran PRINT -C------------------------------------------------------------------------- -C - CALL GEN_OUTPUT (TEXT) -C - GEN_BRDCAST = 1 - RETURN - END diff --git a/src/dwarf/gencall.mvx b/src/dwarf/gencall.mvx deleted file mode 100644 index 35cc45419f5493ac22090a1379712f79cd83d211..0000000000000000000000000000000000000000 --- a/src/dwarf/gencall.mvx +++ /dev/null @@ -1,75 +0,0 @@ -;+++ -;.Ident: VGEN_CALL -;.Keywords: Call interface, optional arguments -;.Author: Ger van Diepen (NFRA, Dwingeloo) -;.Language: VAX/Macro -;.Environment: VAX/VMS -;.File: [.SRC.VGEN]GENCALL.MAR -;.Version: 870824 GVD - creation -;.Version: 930129 HjV - $CODE expanded -;.Version: 940120 CMV - GEN_CALL_FAO removed -;---------------------------------------------------------------------- - .TITLE GEN_CALL Complete argument-list -; - .MACRO $CODE - .PSECT $CODE, PIC,CON,REL,LCL,SHR,EXE,RD,NOWRT,LONG - .IF NDF $CODE -$CODE: - .ENDC - .ENDM -;+ - .ENTRY GEN_CALL,^M<R2,R3> -; -;.Invocation: -; -; STATUS = GEN_CALL (ROUTINE,DEFARG_1,...,DEFARG_N) -; -; INTEGER*4 ROUTINE ! (i) routine to be called -; <datatype> DEFARG_i ! (i/m/o) i-th default argument -; -;.Purpose: pass completed argument list to action routine -;.Returns: function value of action routine -;.Notes: Default arguments are inserted for missing arguments. -; The nr of passed arguments will always be equal to the nr of -; default arguments, which means that extra original arguments -; will be ignored. -;------------------------------------------------------------------------ -; -; Get original argument-list via the frame-pointer. -; Get #arguments. -; Determine maximum #arguments. -; - MOVL 8(FP),R2 ; address original argument-list - MOVZBL (R2),R3 ; #original arguments in R3 - MOVZBL (AP),R1 - DECL R1 ; #default arguments in R1 - ADDL2 #4,AP ; set AP to routine-address -; -; -; -; -; Loop through both argument-lists in reverse order. -; Push the arguments on the stack. -; R0 is used as loop counter. -; -STORE: MOVL R1,R0 ; #arguments -; -ST: CMPL R0,R3 - BGTR PDEF ; no original argument - TSTL (R2)[R0] - BEQL PDEF ; original argument is nil -; - PUSHL (R2)[R0] ; push original argument - BRB NEXT -PDEF: PUSHL (AP)[R0] ; push default argument -NEXT: SOBGTR R0,ST -; -; -; Okay, the argument-list is completed. -; Now call the routine with the maximum #arguments. -; - CALLS R1,@(AP) - RET -; -; - .END diff --git a/src/dwarf/gencerror.cun b/src/dwarf/gencerror.cun deleted file mode 100644 index d7bbf4539da209363509022629fd83b4910a5d6e..0000000000000000000000000000000000000000 --- a/src/dwarf/gencerror.cun +++ /dev/null @@ -1,51 +0,0 @@ -/*++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++*/ -/*.Ident: GENSW_CERROR -/*.Keywords: C Error Message -/*.Author: Ger van Diepen (NFRA, Dwingeloo) -/*.Language: C -/*.Environment: SUN -/*.Comments: -/*.Version: 911231 GvD - creation -/*--------------------------------------------------------------------------*/ - -#include <errno.h> - -/*++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++*/ - gen_cerror_ (msg,leng) - char msg[]; /* (o) error message */ - int leng; /* (i) max. length of msg */ - { - -/*.Purpose: Get message for errno -/*.Notes: -/*--------------------------------------------------------------------------*/ - - extern int errno; - extern int sys_nerr; - extern char *sys_errlist[]; - - int l; - char *mp; - char m[16]; - - char *sprintf(); - -/* -Put errornr in string and copy to user-string -Get pointer to error message (if string long enough) -Copy the message (up to leng characters) -*/ - mp = sprintf (m, "Errno %d: ", errno); - l = strlen (m); - strncpy (msg,m,leng-1); - if (leng > l+1) { - if (errno>0 && errno<sys_nerr) { - mp = sys_errlist[errno]; - strncpy (msg+l,mp,leng-1-l); - } - } -/* -Ended successfully -*/ - return 1; - } diff --git a/src/dwarf/genclrblx.for b/src/dwarf/genclrblx.for deleted file mode 100644 index 0fcf1236140806cf017f20d95efd335bd2f591f8..0000000000000000000000000000000000000000 --- a/src/dwarf/genclrblx.for +++ /dev/null @@ -1,250 +0,0 @@ -C++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ -C.Ident: GENUN_CLRBLX -C.Keywords: Block, Clear -C.Author: Friso Olnon (NFRA, Dwingeloo) -C.Language: DWARF-Fortran -C.Environment: UNIX -C.Comments: -C.Version: 880626 FMO - creation -C.Version: 900906 FMO - at most 2 entry points per function -C---------------------------------------------------------------------- -C++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - INTEGER*4 FUNCTION CLEAR_BLB (ARRAY_B,NELEM) -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' -C - BYTE ARRAY_B(*) ! (m) array to be cleared - INTEGER*4 NELEM ! (i) nr of elements to be cleared -C -C.Purpose: Clear a BYTE array -C.Returns: Status code (.TRUE. for success, .FALSE. otherwise) -C success 1 -C.Notes: -C--------------------------------------------------------------------------- -C -C - DO I = 1,NELEM - ARRAY_B(I) = 0 - ENDDO -C - CLEAR_BLB = 1 - RETURN - END -C++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - INTEGER*4 FUNCTION GEN_CLRBLB (ARRAY_B,NELEM) ! archaic form - ENTRY GEN_CLRBLK (ARRAY_B,NELEM) ! archaic form -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' - INTEGER*4 GEN_CLRBLK -C - BYTE ARRAY_B(*) ! (m) array to be cleared - INTEGER*4 NELEM ! (i) nr of elements to be cleared -C -C.Purpose: Clear a BYTE array -C.Returns: Status code (.TRUE. for success, .FALSE. otherwise) -C success 1 -C.Notes: -C--------------------------------------------------------------------------- -C -C - DO I = 1,NELEM - ARRAY_B(I) = 0 - ENDDO -C - GEN_CLRBLB = 1 - RETURN - END -C++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - INTEGER*4 FUNCTION CLEAR_BLI (ARRAY_I,NELEM) -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' -C - INTEGER*2 ARRAY_I(*) ! (m) array to be cleared - INTEGER*4 NELEM ! (i) nr of elements to be cleared -C -C.Purpose: Clear an INTEGER*2 array -C.Returns: Status code (.TRUE. for success, .FALSE. otherwise) -C success 1 -C.Notes: -C--------------------------------------------------------------------------- -C -C - DO I = 1,NELEM - ARRAY_I(I) = 0 - ENDDO -C - CLEAR_BLI = 1 - RETURN - END -C++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - INTEGER*4 FUNCTION GEN_CLRBLI (ARRAY_I,NELEM) ! archaic form - ENTRY GEN_CLRBLW (ARRAY_I,NELEM) ! archaic form -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' - INTEGER*4 GEN_CLRBLW -C - INTEGER*2 ARRAY_I(*) ! (m) array to be cleared - INTEGER*4 NELEM ! (i) nr of elements to be cleared -C -C.Purpose: Clear an INTEGER*2 array -C.Returns: Status code (.TRUE. for success, .FALSE. otherwise) -C success 1 -C.Notes: -C--------------------------------------------------------------------------- -C -C - DO I = 1,NELEM - ARRAY_I(I) = 0 - ENDDO -C - GEN_CLRBLI = 1 - RETURN - END -C++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - INTEGER*4 FUNCTION CLEAR_BLJ (ARRAY_J,NELEM) -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' -C - INTEGER*4 ARRAY_J(*) ! (m) array to be cleared - INTEGER*4 NELEM ! (i) nr of elements to be cleared -C -C.Purpose: Clear an INTEGER*4 array -C.Returns: Status code (.TRUE. for success, .FALSE. otherwise) -C success 1 -C.Notes: -C--------------------------------------------------------------------------- -C -C - DO I = 1,NELEM - ARRAY_J(I) = 0 - ENDDO -C - CLEAR_BLJ = 1 - RETURN - END -C++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - INTEGER*4 FUNCTION GEN_CLRBLJ (ARRAY_J,NELEM) ! archaic form - ENTRY GEN_CLRBLL (ARRAY_J,NELEM) ! archaic form -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' - INTEGER*4 GEN_CLRBLL -C - INTEGER*4 ARRAY_J(*) ! (m) array to be cleared - INTEGER*4 NELEM ! (i) nr of elements to be cleared -C -C.Purpose: Clear an INTEGER*4 array -C.Returns: Status code (.TRUE. for success, .FALSE. otherwise) -C success 1 -C.Notes: -C--------------------------------------------------------------------------- -C -C - DO I = 1,NELEM - ARRAY_J(I) = 0 - ENDDO -C - GEN_CLRBLJ = 1 - RETURN - END -C++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - INTEGER*4 FUNCTION CLEAR_BLR (ARRAY_R,NELEM) -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' -C - REAL*4 ARRAY_R(*) ! (m) array to be cleared - INTEGER*4 NELEM ! (i) nr of elements to be cleared -C -C.Purpose: Clear a REAL*4 array -C.Returns: Status code (.TRUE. for success, .FALSE. otherwise) -C success 1 -C.Notes: -C--------------------------------------------------------------------------- -C -C - DO I = 1,NELEM - ARRAY_R(I) = 0 - ENDDO -C - CLEAR_BLR = 1 - RETURN - END -C++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - INTEGER*4 FUNCTION GEN_CLRBLR (ARRAY_R,NELEM) ! archaic form - ENTRY GEN_CLRBLF (ARRAY_R,NELEM) ! archaic form -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' - INTEGER*4 GEN_CLRBLF -C - REAL*4 ARRAY_R(*) ! (m) array to be cleared - INTEGER*4 NELEM ! (i) nr of elements to be cleared -C -C.Purpose: Clear a REAL*4 array -C.Returns: Status code (.TRUE. for success, .FALSE. otherwise) -C success 1 -C.Notes: -C--------------------------------------------------------------------------- -C -C - DO I = 1,NELEM - ARRAY_R(I) = 0 - ENDDO -C - GEN_CLRBLR = 1 - RETURN - END -C++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - INTEGER*4 FUNCTION CLEAR_BLD (ARRAY_D,NELEM) -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' -C - REAL*8 ARRAY_D(*) ! (m) array to be cleared - INTEGER*4 NELEM ! (i) nr of elements to be cleared -C -C.Purpose: Clear a REAL*8 array -C.Returns: Status code (.TRUE. for success, .FALSE. otherwise) -C success 1 -C.Notes: -C--------------------------------------------------------------------------- -C -C - DO I = 1,NELEM - ARRAY_D(I) = 0 - ENDDO -C - CLEAR_BLD = 1 - RETURN - END -C++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - INTEGER*4 FUNCTION GEN_CLRBLD (ARRAY_D,NELEM) ! archaic form - ENTRY GEN_CLRBLQ (ARRAY_D,NELEM) ! archaic form -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' - INTEGER*4 GEN_CLRBLQ -C - REAL*8 ARRAY_D(*) ! (m) array to be cleared - INTEGER*4 NELEM ! (i) nr of elements to be cleared -C -C.Purpose: Clear a REAL*8 array -C.Returns: Status code (.TRUE. for success, .FALSE. otherwise) -C success 1 -C.Notes: -C--------------------------------------------------------------------------- -C -C - DO I = 1,NELEM - ARRAY_D(I) = 0 - ENDDO -C - GEN_CLRBLD = 1 - RETURN - END diff --git a/src/dwarf/gencvt.for b/src/dwarf/gencvt.for deleted file mode 100644 index 14b5d3435423d065d827cdd03044bc835f5f4323..0000000000000000000000000000000000000000 --- a/src/dwarf/gencvt.for +++ /dev/null @@ -1,216 +0,0 @@ -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ -C.Ident: GEN_CVT -C.Keywords: Numbers, Convert -C.Author: Friso Olnon (NFRA, Dwingeloo) -C.Language: DWARF-Fortran -C.Environment: VAX or Alliant -C.Comments: -C.Version: 900305 FMO - creation -C.Version: 920214 GvD - no optional arguments in MSG anymore -C.Version: 920508 GvD - added entry GEN_CVT_NR_L to convert logicals -C.Version: - use FLOAT(LARGEST_B) for SUN -C------------------------------------------------------------------------- -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - INTEGER*4 FUNCTION GEN_CVT () -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' -C -C -C.Purpose: Make source-module name known -C.Returns: Status code (.TRUE. for success, .FALSE. otherwise) -C success GEN_SUCCESS -C.Notes: Dummy routine -C------------------------------------------------------------------------- -C - GEN_CVT = GEN_SUCCESS - RETURN - END -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - INTEGER*4 FUNCTION GEN_CVT_NR_D (DATYP,NR,DVAL) -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' -C - CHARACTER*1 DATYP ! (i) data type (B,I,J,R,D) - BYTE NR(*) ! (i) input nr of type DATYP - REAL*8 DVAL ! (o) output nr -C -C.Purpose: Convert a number of given type to REAL*8 -C.Returns: Status code (.TRUE. for success, .FALSE. otherwise) -C success GEN_SUCCESS -C error GEN_INVDATTYP invalid data type -C.Notes: -C------------------------------------------------------------------------- -C -C - INTEGER*4 MOVE_BLB, MSG_SET -C - INTEGER*2 II - INTEGER*4 IS - REAL*4 R -C - IF (DATYP.EQ.'B') THEN - DVAL = NR(1) - ELSE IF (DATYP.EQ.'I') THEN - IS = MOVE_BLB (NR,II,2) - DVAL = II - ELSE IF (DATYP.EQ.'J') THEN - IS = MOVE_BLB (NR,J,4) - DVAL = J - ELSE IF (DATYP.EQ.'R') THEN - IS = MOVE_BLB (NR,R,4) - DVAL = R - ELSE IF (DATYP.EQ.'D') THEN - IS = MOVE_BLB (NR,DVAL,8) - ELSE - GOTO 999 - ENDIF -C - GEN_CVT_NR_D = GEN_SUCCESS - RETURN -C - 999 GEN_CVT_NR_D = MSG_SET (GEN_INVDATTYP,1) - CALL WNCTXT(DWLOG,DWMSG,DATYP) - RETURN - END -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - INTEGER*4 FUNCTION GEN_CVT_D_NR (DATYP,DVAL,NR) -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' -C - CHARACTER*1 DATYP ! (i) data type (B,I,J,R,D) - REAL*8 DVAL ! (i) input nr - BYTE NR(*) ! (o) output nr of type DATYP -C -C.Purpose: Convert a REAL*8 number to given type -C.Returns: Status code (.TRUE. for success, .FALSE. otherwise) -C success GEN_SUCCESS -C info 3 truncated nr -C error GEN_INVDATTYP invalid data type -C.Notes: -C----------------------------------------------------------------------- -C -C - INTEGER*4 MOVE_BLB, MSG_SET -C - INTEGER*2 II - INTEGER*4 IS, TMP - REAL*4 R -C -C - IS = GEN_SUCCESS - TMP=LARGEST_B - IF (DATYP.EQ.'B') THEN - IF (DVAL.EQ.UNDEF_D) THEN - NR(1) = UNDEF_B - ELSE IF (DVAL.GE.FLOAT(TMP)+0.5) THEN - NR(1) = LARGEST_B - IS = 3 - ELSE IF (DVAL.LE.-FLOAT(TMP)-0.5) THEN - I = LARGEST_B - NR(1) = -I - IS = 3 - ELSE - NR(1) = NINT(DVAL) - ENDIF -C - ELSE IF (DATYP.EQ.'I') THEN - IF (DVAL.EQ.UNDEF_D) THEN - II = UNDEF_I - ELSE IF (DVAL.GE.FLOAT(LARGEST_I)+0.5) THEN - II = LARGEST_I - IS = 3 - ELSE IF (DVAL.LE.-FLOAT(LARGEST_I)-0.5) THEN - II = -LARGEST_I - IS = 3 - ELSE - II = NINT(DVAL) - ENDIF - TMP = MOVE_BLB (II,NR,2) -C - ELSE IF (DATYP.EQ.'J') THEN - IF (DVAL.EQ.UNDEF_D) THEN - J = UNDEF_J - ELSE IF (DVAL.GE.FLOAT(LARGEST_J)+0.5) THEN - J = LARGEST_J - IS = 3 - ELSE IF (DVAL.LE.-FLOAT(LARGEST_J)-0.5) THEN - J = -LARGEST_J - IS = 3 - ELSE - J = NINT(DVAL) - ENDIF - TMP = MOVE_BLB (J,NR,4) -C - ELSE IF (DATYP.EQ.'R') THEN - IF (DVAL.EQ.UNDEF_D) THEN - R = UNDEF_R - ELSE - R = DVAL - ENDIF - TMP = MOVE_BLB (R,NR,4) -C - ELSE IF (DATYP.EQ.'D') THEN - TMP = MOVE_BLB (DVAL,NR,8) - ELSE - GOTO 999 - ENDIF -C -C - GEN_CVT_D_NR = IS - RETURN -C - 999 GEN_CVT_D_NR = MSG_SET (GEN_INVDATTYP,1) - CALL WNCTXT(DWLOG,DWMSG,DATYP) - RETURN - END -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - INTEGER*4 FUNCTION GEN_CVT_NR_L (DATYP,VAL) -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' -C - CHARACTER*1 DATYP ! (i) data type (B,I,J) - BYTE VAL(*) ! (m) value -C -C.Purpose: Convert a number of given type to LOGICAL*1, *2 or *4 -C.Returns: Status code (.TRUE. for success, .FALSE. otherwise) -C success GEN_SUCCESS -C error GEN_INVDATTYP invalid data type -C.Notes: -C------------------------------------------------------------------------- -C -C - INTEGER*4 MOVE_BLB, MSG_SET -C - INTEGER*2 II2 - INTEGER*4 II4, IS - LOGICAL*1 LL1 - LOGICAL*2 L2 - LOGICAL*4 L4 -C - IF (DATYP.EQ.'B') THEN - II2 = VAL(1) - LL1 = IAND(II2,1).EQ.1 - IS = MOVE_BLB (LL1,VAL,1) - ELSE IF (DATYP.EQ.'I') THEN - IS = MOVE_BLB (VAL,II2,2) - L2 = IAND(II2,1).EQ.1 - IS = MOVE_BLB (L2,VAL,2) - ELSE IF (DATYP.EQ.'J') THEN - IS = MOVE_BLB (VAL,II4,4) - L4 = IAND(II4,1).EQ.1 - IS = MOVE_BLB (L4,VAL,4) - ELSE - GOTO 999 - ENDIF -C - GEN_CVT_NR_L = GEN_SUCCESS - RETURN -C - 999 GEN_CVT_NR_L = MSG_SET (GEN_INVDATTYP,1) - CALL WNCTXT(DWLOG,DWMSG,DATYP) - RETURN - END diff --git a/src/dwarf/generrno.chp b/src/dwarf/generrno.chp deleted file mode 100644 index a424837a4628a1125d80fd90987288f189a10cb4..0000000000000000000000000000000000000000 --- a/src/dwarf/generrno.chp +++ /dev/null @@ -1,43 +0,0 @@ -/*++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ -/*.Ident: GENHP_ERRNO -/*.Keywords: Fortran errors -/*.Author: Ger van Diepen (NFRA, Dwingeloo) -/*.Language: C -/*.Environment: HP9000/700 -/*.Comments: Substitute for standard SUN- and Alliant routines -/*.Version: 920525 GvD - creation -------------------------------------------------------------------------*/ -/*++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++*/ -#include <errno.h> - -long ierrno_ () - -/* -.Purpose: Get errno -.Returns: errno -.Notes: Call from Fortran as: - ERRNO = IERRNO () -------------------------------------------------------------------------*/ -{ - return errno; -} -/*++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++*/ -gerror_ (str,leng) - - char str[]; /* (o) string */ - long leng; /* (i) length of string */ -/* -.Purpose: Get message of latest error -.Returns: None -.Notes: Call from Fortran as: - CALL GERROR (STR) -------------------------------------------------------------------------*/ -{ - int l; - char *mes; - - mes = strerror (errno); - strncpy (str,mes,leng); - l = strlen (str); - if (l<leng) memset (&str[l], ' ', leng-l); /* fill with blanks */ -} diff --git a/src/dwarf/genexecl.cun b/src/dwarf/genexecl.cun deleted file mode 100644 index 769d505d7a7cdb50b1945939e176b953abfba627..0000000000000000000000000000000000000000 --- a/src/dwarf/genexecl.cun +++ /dev/null @@ -1,19 +0,0 @@ -/*+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++*/ -/*.Ident: GENUN_EXECL -/*.Keywords: Process -/*.Author: Ger van Diepen (NFRA, Dwingeloo) -/*.Language: C -/*.Environment: UNIX -/*.Comments: -/* - Uses EXECL to start a program on behalf of another (Fortran) program. -/* - The routine returns if EXECL fails, otherwise the program is stopped -/* and replaced by the new program. -/*.Version: 911204 GvD - Creation -/*-------------------------------------------------------------------------*/ -/*+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++*/ -gen_execl_ (comm,prog) -char comm[]; /* command to start program */ -char prog[]; /* name of program */ -{ - execl (comm, prog, (char *)0); -} diff --git a/src/dwarf/genexecl.fvx b/src/dwarf/genexecl.fvx deleted file mode 100644 index ed0e186d935f7270ab40175c05f8b0b719475077..0000000000000000000000000000000000000000 --- a/src/dwarf/genexecl.fvx +++ /dev/null @@ -1,42 +0,0 @@ -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ -C.Ident: VGEN_EXECL -C.Keywords: Execute Command -C.Author: Ger van Diepen (NFRA, Dwingeloo) -C.Language: Fortran -C.Environment: VAX -C.Comments: -C.Version: 920701 GvD - creation -C------------------------------------------------------------------------- -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - INTEGER*4 FUNCTION GEN_EXECL (COMM,PROG) -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' -C - CHARACTER*(*) COMM ! (i) command to be executed - CHARACTER*(*) PROG ! (i) program name (not used) -C -C.Purpose: Execute command in this process -C.Returns: Status from LIB$DO_COMMAND -C.Notes: -C------------------------------------------------------------------------- -C - INTEGER LENG -C - INTEGER LIB$DO_COMMAND -C -C -C Remove possible 0 indicating the end of the string. -C Execute the command. -C If successfull, the program is stopped. -C - LENG = INDEX(COMM,CHAR(0)) - IF (LENG.EQ.0) THEN - LENG = LEN(COMM) - ELSE - LENG = LENG-1 - ENDIF -C - GEN_EXECL = LIB$DO_COMMAND (COMM(:LENG)) - RETURN - END diff --git a/src/dwarf/genforios.fun b/src/dwarf/genforios.fun deleted file mode 100644 index 950a5034c5c0b9a61ec50c82c9b6a167feeaff6a..0000000000000000000000000000000000000000 --- a/src/dwarf/genforios.fun +++ /dev/null @@ -1,43 +0,0 @@ -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ -C.Ident: GENSW_FORIOS -C.Keywords: Fortran I/O errors -C.Author: Friso Olnon (NFRA, Dwingeloo) -C.Language: DWARF-Fortran -C.Environment: SUN -C.Comments: Calls library routines IERRNO and GERROR -C.Version: 880421 FMO - created -C.Version: 920214 GvD - no optional arguments in MSG anymore -C------------------------------------------------------------------------- -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - INTEGER*4 FUNCTION GEN_FORIOS (FILE) -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' -C - CHARACTER*(*) FILE ! (i) file name -C -C.Purpose: Get Fortran I/O status and store message in case of error -C.Returns: Status code (.TRUE. for success, .FALSE. otherwise) -C success GEN_SUCCESS -C error GEN_FORIOERR -C.Notes: An appropriate error message is left in the message buffer -C------------------------------------------------------------------------- -C -C - INTEGER*4 STR_SIGLEN - INTEGER*4 IERRNO ! FX/Fortran, return error number - EXTERNAL GERROR ! FX/Fortran, return error message - - CHARACTER*80 STR -C -C - IF (IERRNO().GT.0) GOTO 999 -C - GEN_FORIOS = GEN_SUCCESS - RETURN -C - 999 CALL GERROR(STR) - GEN_FORIOS = GEN_FORIOERR - CALL WNCTXT(DWLOG,STR(:STR_SIGLEN(STR))//'!/on file !AS',FILE) - RETURN - END diff --git a/src/dwarf/genforios.fvx b/src/dwarf/genforios.fvx deleted file mode 100644 index 111b4bb3cbafd51c605a037c5d00f610fb23c770..0000000000000000000000000000000000000000 --- a/src/dwarf/genforios.fvx +++ /dev/null @@ -1,79 +0,0 @@ -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ -C.Ident: VGEN_FORIOS -C.Keywords: Fortran I/O errors -C.Author: Ger van Diepen (NFRA, Dwingeloo) -C.Language: VAX-Fortran -C.Environment: VAX -C.Comments: Calls routine ERRSNS -C.Version: 821111 GVD - Creation -C.Version: 840308 GVD - Also generate message for RMSSTV -C.Version: 860719 HHJ - Improved error report: RMS_status not always > 1 -C when FORTRAN_status indicates an error. -C.Version: 870428 HHJ - Don't return VMS error code (can be odd), but -C generate message and return GEN_FORIOERR -C.Version: 880421 FMO - Slight editing -C.Version: 920224 GvD - no optional arguments in MSG anymore -C.Version: 920804 GvD - added routine GEN_FORIOS_VMSERR -C------------------------------------------------------------------------- -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - INTEGER*4 FUNCTION GEN_FORIOS (FILE) -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' -C - CHARACTER*(*) FILE ! (i) file name -C -C.Purpose: Get Fortran I/O status and store message in case of error -C.Returns: Status code (.TRUE. for success, .FALSE. otherwise) -C success GEN_SUCCESS -C error GEN_FORIOERR -C.Notes: An appropriate error message is left in the message buffer -C------------------------------------------------------------------------- -C -C - INTEGER*4 GEN_FORIOS_VMSERR -C - INTEGER*4 IS -C -C - GEN_FORIOS = GEN_FORIOS_VMSERR (FILE,IS) - RETURN - END -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - INTEGER*4 FUNCTION GEN_FORIOS_VMSERR (FILE,VMSERR) -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' -C - CHARACTER*(*) FILE ! (i) file name - INTEGER*4 VMSERR ! (o) VMS error code -C -C.Purpose: Get Fortran I/O status and store message in case of error -C.Returns: Status code (.TRUE. for success, .FALSE. otherwise) -C success GEN_SUCCESS -C error GEN_FORIOERR -C.Notes: An appropriate error message is left in the message buffer -C------------------------------------------------------------------------- -C -C - INTEGER*4 MSG_SET -C - INTEGER*4 STATUS, RMSSTV, UNIT, FNUM -C -C - VMSERR = 1 ! No error yet - CALL ERRSNS (FNUM,STATUS,RMSSTV,UNIT) ! get Fortran I/O status -C - IF (FNUM.GT.0) THEN - IF (RMSSTV.GT.1) VMSERR = MSG_SET (RMSSTV,0) ! STV error - IF (STATUS.GT.1) VMSERR = MSG_SET (STATUS,0) ! RMS error - GOTO 999 - ENDIF -C - GEN_FORIOS_VMSERR = GEN_SUCCESS - RETURN -C - 999 GEN_FORIOS_VMSERR = MSG_SET (GEN_FORIOERR,1) - CALL WNCTXT(DWLOG,DWMSG,FNUM,UNIT,FILE) - RETURN - END diff --git a/src/dwarf/gengetfor.fsc b/src/dwarf/gengetfor.fsc deleted file mode 100644 index 6c5a52a79afd3340f192a1a7c85b1d5708dd3bd9..0000000000000000000000000000000000000000 --- a/src/dwarf/gengetfor.fsc +++ /dev/null @@ -1,102 +0,0 @@ -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ -C.Ident: GEN_GETFOR -C.Keywords: Foreign Command Line -C.Author: Friso Olnon (NFRA, Dwingeloo) -C.Language: Fortran -C.Environment: VAX/VMS & UNIX -C.Comments: -C VAX-specific: LIB$GET_FOREIGN -C Alliant-specific: Fortran Library Routines IARGC, GETARG and LNBLNK -C.Version: 881025 FMO - creation -C.Version: 900407 FMO - convert to upper case -C.Version: 910825 FMO - use PRINT i.s.o. TYPE -C.Version: 920316 GvD - use GEN_OUTPUT iso. PRINT -C.Version: 920525 GvD - use STR_SIGLEN iso. LNBLNK -C.Version: 930201 HjV - Make FSC -C------------------------------------------------------------------------- -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - INTEGER*4 FUNCTION GEN_GETFOR (PROMPT,COMMAND,LENCOM) -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' -C - CHARACTER*(*) PROMPT ! (i) user prompt - CHARACTER*(*) COMMAND ! (o) command line - INTEGER*4 LENCOM ! (o) signif length of command line -C -C.Purpose: Get the foreign command line -C.Returns: Status code (.TRUE. for success, .FALSE. otherwise) -C success GEN_SUCCESS -C error 2 -C.Notes: -C - If no command line is available and a non-blank prompt is given, -C the user will be asked for the command line. -C - Trailing blanks and tabs in prompt and command are significant. -C - The line will be converted to upper case. -C - In case of an error, a blank command will be returned (LENCOM = 0). -C------------------------------------------------------------------------ -C -C - CHARACTER*(*) BLANK - PARAMETER (BLANK = ' ') -C -#ifdef wn_vx__ - INTEGER*4 LIB$GET_FOREIGN -C - INTEGER*4 IS - INTEGER*2 LENG -#else - INTEGER*4 IS, IARGC, STR_SIGLEN, STR_UPCASE -C - CHARACTER*80 ARG - INTEGER*4 NRARG, LARG, MAXLEN -#endif -C -C - COMMAND = BLANK - LENCOM = 0 -#ifdef wn_vx__ - IF (PROMPT.NE.BLANK) THEN - IS = LIB$GET_FOREIGN (COMMAND,PROMPT,LENG) - ELSE - IS = LIB$GET_FOREIGN (COMMAND,,LENG) - ENDIF - IF (.NOT.IS) GOTO 999 - LENCOM = LENG -#else - MAXLEN = LEN(COMMAND) -C - NRARG = IARGC () - IF (NRARG.GT.0) THEN - DO I = 1,NRARG -# ifdef wn_hp__ - CALL IGETARG (I,ARG,LEN(ARG)) -# else - CALL GETARG (I,ARG) -# endif - LARG = STR_SIGLEN (ARG) - IF (LENCOM+LARG+1.GT.MAXLEN) GOTO 999 - COMMAND (LENCOM+1:) = ARG(:LARG) - LENCOM = LENCOM+LARG+1 ! leave a blank - ENDDO - LENCOM = LENCOM-1 ! cut off blank - ELSE IF (PROMPT.NE.BLANK) THEN - CALL GEN_OUTPUT (PROMPT) - READ (*,'(Q,A)') LENCOM,COMMAND - IF (LENCOM.GT.MAXLEN) GOTO 999 - ENDIF -C - IS = STR_UPCASE (COMMAND) -#endif - GEN_GETFOR = GEN_SUCCESS - RETURN -C - 999 COMMAND = BLANK - LENCOM = 0 -#ifdef wn_vx__ - GEN_GETFOR = IS -#else - GEN_GETFOR = 2 -#endif - RETURN - END diff --git a/src/dwarf/gengetmsg.for b/src/dwarf/gengetmsg.for deleted file mode 100644 index 3ef1c4c7338a1fd0107271d28a9eb7dbab8df24c..0000000000000000000000000000000000000000 --- a/src/dwarf/gengetmsg.for +++ /dev/null @@ -1,551 +0,0 @@ -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ -C.Ident: GENUN_GETMSG -C.Keywords: Message Facility, Get Text -C.Author: Friso Olnon (NFRA, Dwingeloo) -C.Language: DWARF-Fortran -C.Environment: UNIX -C.Comments: -C.Version: 900410 FMO - creation -C.Version: 900502 FMO - added GEN_LUN -C.Version: 920310 GvD - added PPD_LENGTHLON, UDF_UNIT and DBD_ messages -C.Version: 920508 GvD - updated DWC_TBNOTALL for logical data -C.Version: 930923 CMV - logical names for new maintenance system -C.Version: 940131 CMV - all messages in dwc.def -C------------------------------------------------------------------------- -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - INTEGER*4 FUNCTION GEN_GETMSG (STATID,LMSG,MSG,FLAGS,BARR) -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' -C - INTEGER*4 STATID ! (i) status identification - INTEGER*4 LMSG ! (o) sign. length of message text - CHARACTER*(*) MSG ! (o) message text - INTEGER*4 FLAGS ! (i) message components to be returned - BYTE BARR(4) ! (o) message-specific info -C -C.Purpose: Get message text associated with error code -C.Returns: Status code (.TRUE. for success, .FALSE. otherwise) -C success 1 always -C.Notes: -C - If STATID is associated with a message string, that string will be -C returned in MSG. Otherwise, STATID will be written into MSG in -C hexadecimal format. -C - FLAGS and BARR are not used. -C------------------------------------------------------------------------- -C - INTEGER MAXPAR - PARAMETER (MAXPAR=238) - INTEGER WNCALN -C - INTEGER*4 C(MAXPAR) - CHARACTER*80 T(MAXPAR) -C - DATA C( 1),T( 1) /GEN_STMESSAG, - 1' !AS is started at !%D !%T'/ - DATA C( 2),T( 2) /GEN_ENDMESSAG, - 1' !AS is ended at !%T STATUS=!AS'/ - DATA C( 3),T( 3) /GEN_ISNOTANM, - 1'string !AS is not alphanumeric'/ - DATA C( 4),T( 4) /GEN_FORIOERR, - 1'Fortran-errornr !SJ on LUN !SJ in file !AS'/ - DATA C( 5),T( 5) /GEN_SUCCESS, - 1'success'/ - DATA C( 6),T( 6) /GEN_INVDATTYP, - 1'Invalid data type specifier: !AS'/ - DATA C( 7),T( 7) /GEN_STROVFLO, - 1'Output string too short to hold value, !SJ characters - 2 truncated'/ - DATA C( 8),T( 8) /GEN_SYMDEFERR, - 1'Error defining symbol !AS'/ - DATA C( 9),T( 9) /GEN_SYMGETERR, - 1'Error getting the value of symbol !AS'/ - DATA C( 10),T( 10) /GEN_SYMDELERR, - 1'Error deleting symbol !AS'/ -C - DATA C( 11),T( 11) /DWC_SUCCESS, - 1'success'/ - DATA C( 12),T( 12) /DWC_GETINPERR, - 1'IO-error on !AS'/ - DATA C( 13),T( 13) /DWC_EOFCTRLZ, - 1'end-of-file found or CTRL/Z given on !AS'/ - DATA C( 14),T( 14) /DWC_EXPERRMSG, - 1'!ASerror at or near position !SJ in value-string:!/ !AS'/ - DATA C( 15),T( 15) /DWC_INVOPER, - 1'operator-symbol !AS is invalid'/ - DATA C( 16),T( 16) /DWC_INVNONR, - 1'invalid or no number'/ - DATA C( 17),T( 17) /DWC_TOOMANARG, - 1'too many function-arguments, max=!SJ'/ - DATA C( 18),T( 18) /DWC_TOOLITARG, - 1'not enough function-arguments, !SJ are required'/ - DATA C( 19),T( 19) /DWC_TOODEENES, - 1'subexpressions too deeply nested, max. depth=!SJ'/ - DATA C( 20),T( 20) /DWC_TOOMANYNR, - 1'too many numbers in (sub)expression, max=!SJ'/ - DATA C( 21),T( 21) /DWC_UNBPAREN, - 1'unbalanced parentheses'/ - DATA C( 22),T( 22) /DWC_DIVBYZERO, - 1'divide by zero'/ - DATA C( 23),T( 23) /DWC_UNKFUNC, - 1'unknown function-name'/ - DATA C( 24),T( 24) /DWC_NOTAFTOP, - 1'nothing found after operator'/ - DATA C( 25),T( 25) /DWC_INVFUNARG, - 1'invalid function-argument'/ - DATA C( 26),T( 26) /DWC_UNDEFEXP, - 1'undefined exponentiation'/ - DATA C( 27),T( 27) /DWC_SETCURNOD, - 1'Current node set to !AS for current program run'/ - DATA C( 28),T( 28) /DWC_INTOVERFL, - 1'Integer overflow during conversion to !AS data type'/ - DATA C( 29),T( 29) /DWC_TONOTALL, - 1'TO only allowed after start-value'/ - DATA C( 30),T( 30) /DWC_STEPNOTAL, - 1'BY only allowed after TO'/ - DATA C( 31),T( 31) /DWC_TSNOTALL, - 1'TO or BY not allowed'/ - DATA C( 32),T( 32) /DWC_SAVEOVFLO, - 1'Aborting due to parameter save area overflow'/ - DATA C( 33),T( 33) /DWC_STEPISZER, - 1'BY-value is zero'/ - DATA C( 34),T( 34) /DWC_STEPSIGN, - 1'BY-value has wrong sign'/ - DATA C( 35),T( 35) /DWC_TOOMANYEL, - 1'too many elements in array, max=!SJ'/ - DATA C( 36),T( 36) /DWC_NOENDAPOS, - 1'no ending apostrophe found'/ - DATA C( 37),T( 37) /DWC_SYMNOTDEF, - 1'symbol !AS not defined'/ - DATA C( 38),T( 38) /DWC_MUTUALSUB, - 1'probably mutual substitution'/ - DATA C( 39),T( 39) /DWC_NOENDQUO, - 1'no ending quotation-mark found'/ - DATA C( 40),T( 40) /DWC_TOOMANCHR, - 1'too many characters in this element, max=!SJ'/ - DATA C( 41),T( 41) /DWC_INVUNIT, - 1'unitcode !AS is invalid or not permitted'/ - DATA C( 42),T( 42) /DWC_STRTOOSHO, - 1'output-string too short, max. length=!SJ'/ - DATA C( 43),T( 43) /DWC_NOVALDEF, - 1'no value given or no default found for valuenr !SJ - 2 in this valueset'/ - DATA C( 44),T( 44) /DWC_KEYVAHELP, - 1'value of symbol !AS is HELP'/ - DATA C( 45),T( 45) /DWC_UNKKEYW, - 1'!AS is an unknown!ASkeyword for image !AS'/ - DATA C( 46),T( 46) /DWC_UNKPRKEYW, - 1'!AS is an unknown!ASprogramkeyword for image !AS'/ - DATA C( 47),T( 47) /DWC_PARTOOSML, - 1'!SJ elements are available in call-argument ARRAY; - 2 !SJ are needed'/ - DATA C( 48),T( 48) /DWC_PARNONR, - 1'The call-argument NELEM is not present'/ - DATA C( 49),T( 49) /DWC_PARAMERR, - 1'error occurred for programkeyword !AS'/ - DATA C( 50),T( 50) /DWC_PARNOTFND, - 1'keyword !AS not found or not accessible for the requested - 2 operation'/ - DATA C( 51),T( 51) /DWC_PARNOVAL, - 1'no value found for keyword !AS'/ - DATA C( 52),T( 52) /DWC_PARWRDEF, - 1'wrong default-value for programkeyword !AS'/ - DATA C( 53),T( 53) /DWC_PARWRANS, - 1'wrong answer given for keyword !AS, please repeat'/ - DATA C( 54),T( 54) /DWC_PARGIVVAL, - 1'!AS has no program-default; please give a value or CTRL/Z'/ - DATA C( 55),T( 55) /DWC_PPDNOVIRT, - 1'no virtual memory found for !SJ bytes'/ - DATA C( 56),T( 56) /DWC_PPDFRVIRT, - 1'error in free virtual memory'/ - DATA C( 57),T( 57) /DWC_ACTTOOMAN, - 1'too many processes active'/ - DATA C( 58),T( 58) /DWC_CALSEPEXP, - 1'sorry, you can''t give an expression in the command-line'/ - DATA C( 59),T( 59) /DWC_CALINVRAD, - 1'!AS is an invalid radix-option (D, O or X is valid)'/ - DATA C( 60),T( 60) /DWC_CALINVTYP, - 1'!AS is an invalid datatype (B,I,J,L,R,D are valid)'/ - DATA C( 61),T( 61) /DWC_INVSYMNAM, - 1'invalid symbol-name'/ - DATA C( 62),T( 62) /DWC_RESERVSYM, - 1'invalid symbol-name, !AS is a reserved name'/ - DATA C( 63),T( 63) /DWC_GETINPTR, - 1'Answer is too long; truncated to !SJ characters'/ - DATA C( 64),T( 64) /DWC_LOKILLIMG, - 1'!AS is an illegal image-name'/ - DATA C( 65),T( 65) /DWC_MULTIQUAL, - 1'no other qualifiers are allowed when !AS is given'/ - DATA C( 66),T( 66) /DWC_BLANKSLAS, - 1'perhaps you put a blank before a slash that indicates a - 2 division'/ - DATA C( 67),T( 67) /DWC_STRINVNR, - 1'stream-name !AS is invalid'/ - DATA C( 68),T( 68) /DWC_STRNOTALL, - 1'stream-name !AS is not allowed with image-name !AS'/ - DATA C( 69),T( 69) /DWC_APPTWODOT, - 1'2 succeeding dots in given name'/ - DATA C( 70),T( 70) /DWC_APPTOOLON, - 1'resulting name longer than !SJ characters'/ - DATA C( 71),T( 71) /DWC_APPMINUS, - 1'too many minus-signs in given name'/ - DATA C( 72),T( 72) /DWC_SUBPRCERR, - 1'error in starting subprocess !AS'/ - DATA C( 73),T( 73) /DWC_FILNOTFND, - 1'file !AS not found in Master or User directory'/ - DATA C( 74),T( 74) /DWC_NOPARCOM, - 1'no parameters given in command-line'/ - DATA C( 75),T( 75) /DWC_UNKQUAL, - 1'!AS is an unknown qualifier'/ - DATA C( 76),T( 76) /DWC_AMBQUAL, - 1'!AS is an ambiguous qualifier-abbreviation'/ - DATA C( 77),T( 77) /DWC_QUALNOVAL, - 1'no value given on qualifier !AS'/ - DATA C( 78),T( 78) /DWC_QUALVALNA, - 1'no value allowed on qualifier !AS'/ - DATA C( 79),T( 79) /DWC_INVIMGSTR, - 1'syntax-error in image$stream !AS'/ - DATA C( 80),T( 80) /DWC_SYNERRSYM, - 1'syntax-error in symbol-name !AS'/ - DATA C( 81),T( 81) /DWC_LOKUNKIMG, - 1'No PPD file found for image !AS in Master or User - 2 directories'/ - DATA C( 82),T( 82) /DWC_QUALBATCH, - 1'qualifier !AS is not possible in batch-mode'/ - DATA C( 83),T( 83) /DWC_SPECWRSYN, - 1'sorry, correct syntax is KEYWORD=VALUE'/ - DATA C( 84),T( 84) /DWC_ERRSAVSYM, - 1'syntax-error in symbol-name in SAV-file on linenr !SJ'/ - DATA C( 85),T( 85) /DWC_LETNOSVAL, - 1'no symbol-name, =-sign or value given'/ - DATA C( 86),T( 86) /DWC_NOVALALL, - 1'No data-value is allowed when qualifier !AS is given'/ - DATA C( 87),T( 87) /DWC_SYMBOLCLR, - 1'symbol is cleared'/ - DATA C( 88),T( 88) /DWC_TWICEVAL, - 1'(Default-3)value is given both as a string and as an - 2 array argument'/ - DATA C( 89),T( 89) /DWC_TBNOTALL, - 1'You cannot use the TOBY-flag for vectors and - 2 character/logical-data'/ - DATA C( 90),T( 90) /DWC_TBNOMULT, - 1'Nr of elements must be a multiple of 3, when TOBY is used'/ - DATA C( 91),T( 91) /DWC_USESAVFIL, - 1'!AS is used as SAV-file!/'/ - DATA C( 92),T( 92) /DWC_SYMBCLEAR, - 1'symbol !AS is cleared'/ - DATA C( 93),T( 93) /DWC_NRSYMCLR, - 1'!SJ symbols cleared'/ - DATA C( 94),T( 94) /DWC_INVLEVEL, - 1'invalid value for qualifier /LEVEL'/ - DATA C( 95),T( 95) /DWC_UNKDWCOM, - 1'DWARF_COMMON-symbol is undefined!/ Use SPECIFY DWARF - 2 to create it'/ - DATA C( 96),T( 96) /DWC_EXEERRORS, - 1'errors found, image is not started'/ - DATA C( 97),T( 97) /DWC_WAITSUBPR, - 1'waiting for image !AS in stream !AS (started at !AS)'/ - DATA C( 98),T( 98) /DWC_WAITREADY, - 1'stream !AS is ready; processing will continue'/ - DATA C( 99),T( 99) /DWC_WTNOJOB, - 1'no jobname or jobnumber given in the command'/ - DATA C(100),T(100) /DWC_WTMOREJOB, - 1'more than 1 jobname or jobnumber given in the command'/ - DATA C(101),T(101) /DWC_WTNOKEYW, - 1'no underscores/keywords are possible in the command'/ - DATA C(102),T(102) /DWC_WTNOTHACT, - 1'no such image$streams active'/ - DATA C(103),T(103) /DWC_SAVINVGLB, - 1'invalid option used for GLOBALS-qualifier (GLOBAL or IMAGE)'/ - DATA C(104),T(104) /DWC_SAVNRSAVE, - 1'!SJ symbols saved'/ - DATA C(105),T(105) /DWC_RESNRREST, - 1'!SJ symbols restored'/ - DATA C(106),T(106) /DWC_CHKERRMSG, - 1'keyword !AS, data-error in value-string:!/ !AS'/ - DATA C(107),T(107) /DWC_WILDNOTAL, - 1'no wildcard (*) allowed for keyword !AS'/ - DATA C(108),T(108) /DWC_PARNOOUT, - 1'no output-value given for keyword !AS'/ - DATA C(109),T(109) /DWC_PARRETBAT, - 1'RETRY_PARM call illegal in batch-mode; keyword=!AS'/ - DATA C(110),T(110) /DWC_NOGLBSTR, - 1'$0 is a global stream-name and cannot be used'/ - DATA C(111),T(111) /DWC_PROGSTERR, - 1'error in PROG_START, program is aborted'/ - DATA C(112),T(112) /DWC_PARELTSML, - 1'array-elements are !SJ bytes long; !SJ bytes are needed'/ - DATA C(113),T(113) /DWC_NODCOMERR, - 1'error in combining node-name !AS with the current - 2 node-name !AS'/ - DATA C(114),T(114) /DWC_CLRDWARF, - 1'DWARF-symbols cannot be cleared; use SPECIFY'/ - DATA C(115),T(115) /DWC_TOOMANSET, - 1'!SJ value-sets given in program-array, max=!SJ'/ - DATA C(116),T(116) /DWC_ENDOFLOOP, - 1'end-of-loop for a keyword'/ - DATA C(117),T(117) /DWC_NULLNOTAL, - 1'no null-value (2 quotation-marks) allowed for keyword !AS'/ - DATA C(118),T(118) /DWC_NULLVALUE, - 1'null-value returned'/ - DATA C(119),T(119) /DWC_WILDCARD, - 1'wildcard-value returned'/ - DATA C(120),T(120) /DWC_IMGSUBPRC, - 1' '/ - DATA C(121),T(121) /DWC_NOLOCVAL, - 1'You cannot specify a local value for keyword !AS'/ - DATA C(122),T(122) /DWC_NODWVALUE, - 1'No value found for DWARF-programkeyword !AS'/ - DATA C(123),T(123) /DWC_DWSERROR, - 1'Warn DWARF-manager: error during interpretation of - 2 DWARF-symbols'/ - DATA C(124),T(124) /DWC_UNKDWKEY, - 1'DWARF-programkeyword !AS not defined in the routine'/ - DATA C(125),T(125) /DWC_IMMNOSUBS, - 1'PPD''s IMMEDIATE switch overruled /NOSUBSTITUTE for - 2 this keyword'/ - DATA C(126),T(126) /DWC_MANDATVAL, - 1'You have to give a value when qualifier !AS is given'/ - DATA C(127),T(127) /DWC_NOCUPDSYM, - 1'No update-symbol for the control-area DWARF_COMMON found'/ - DATA C(128),T(128) /DWC_KEYWMISM, - 1'Wrong keyword-name given!AS!/ Found keyword !AS, expected !AS'/ - DATA C(129),T(129) /DWC_SUBPRCPMT, - 1'wants to prompt for input; please finish your current typing'/ - DATA C(130),T(130) /DWC_EXEUSER, - 1'File !AS being taken from USER directory'/ - DATA C(131),T(131) /DWC_PRESENT, - 1'Argument is present'/ - DATA C(132),T(132) /DWC_ABSENT, - 1'Argument is absent'/ - DATA C(133),T(133) /DWC_NEGATED, - 1'Qualifier is negated'/ - DATA C(134),T(134) /DWC_REQUIRED, - 1'Required argument is absent'/ - DATA C(135),T(135) /DWC_CLIBUFERR, - 1'Error in module CLI_BUF'/ - DATA C(136),T(136) /DWC_CLISYNTAX, - 1'Syntax error in command-line definition'/ - DATA C(137),T(137) /DWC_CLIPARUNK, - 1'Unknown parameter nr !SJ'/ - DATA C(138),T(138) /DWC_CLINAMAMB, - 1'Ambiguously abbreviated argument name: !AS'/ - DATA C(139),T(139) /DWC_CLINAMUNK, - 1'Unknown argument name: !AS'/ - DATA C(140),T(140) /DWC_CLISTRINV, - 1'Programming error: invalid CLI-string ID !SJ'/ - DATA C(141),T(141) /DWC_CLISTRMAX, - 1'More than !SJ CLI strings are requested'/ - DATA C(142),T(142) /DWC_CLISTROVR, - 1'Total length of CLI strings exceeds !SJ characters'/ -C - DATA C(143),T(143) /PPD_SUCCESS, - 1'success'/ - DATA C(144),T(144) /PPD_NOSUCCESS, - 1'no success'/ - DATA C(145),T(145) /PPD_STRNOTAN, - 1'string contains non-alphanumeric characters'/ - DATA C(146),T(146) /PPD_ARRNOTASC, - 1'values in array are not in ascending order'/ - DATA C(147),T(147) /PPD_ARRNOTDES, - 1'values in array are not in descending order'/ - DATA C(148),T(148) /PPD_OPTINVAL, - 1'invalid option'/ - DATA C(149),T(149) /PPD_OPTNOTUNI, - 1'specified part of option is not unique'/ - DATA C(150),T(150) /PPD_STRTOOSML, - 1'string is not long enough'/ - DATA C(151),T(151) /PPD_SEQERROR, - 1'sequence-error'/ - DATA C(152),T(152) /PPD_ENDOFFILE, - 1'all entries processed'/ - DATA C(153),T(153) /PPD_KEYNOTFND, - 1'specified keyword not found'/ - DATA C(154),T(154) /PPD_ERRMINCHK, - 1'error detected in check against minimum value'/ - DATA C(155),T(155) /PPD_ERRMAXCHK, - 1'error detected in check against maximum value'/ - DATA C(156),T(156) /PPD_STRNOTALP, - 1'string is not alphabetic'/ - DATA C(157),T(157) /PPD_STRNOTNUM, - 1'string is not numeric'/ - DATA C(158),T(158) /PPD_IMTOOLONG, - 1'image-name more than 8 characters'/ - DATA C(159),T(159) /PPD_PPDNOTFND, - 1'specified PPD-file not found'/ - DATA C(160),T(160) /PPD_PKYNOTFND, - 1'specified P-keyword not found'/ - DATA C(161),T(161) /PPD_NOCURENTR, - 1'no current ppd-entry'/ - DATA C(162),T(162) /PPD_NUMVALMIN, - 1'Number of values less then minimum; specified !SJ, minimum !SJ'/ - DATA C(163),T(163) /PPD_NUMVALMAX, - 1'Number of values exceeds maximum; specified !SJ, maximum !SJ'/ - DATA C(164),T(164) /PPD_NUMSETMAX, - 1'Number of value-sets exceeds maximum; specified !SJ, - 2 maximum !SJ'/ - DATA C(165),T(165) /PPD_VALLSSMIN, - 1'Specified value less than minimum !AS'/ - DATA C(166),T(166) /PPD_VALEXCMAX, - 1'Specified value exceeds maximum !AS'/ - DATA C(167),T(167) /PPD_ARRNOTNAS, - 1'Values in array are not in non-ascending order'/ - DATA C(168),T(168) /PPD_ARRNOTNDE, - 1'Values in array are not in non-descending order'/ - DATA C(169),T(169) /PPD_UNAMNOT, - 1'USER_PARAMETER not specified'/ - DATA C(170),T(170) /PPD_MAX16, - 1'value too long; max 16 characters'/ - DATA C(171),T(171) /PPD_CHATNUNI, - 1'one of the checks or attributes not uniquely abbreviated'/ - DATA C(172),T(172) /PPD_CHATINV, - 1'one of the checks or attributes invalid'/ - DATA C(173),T(173) /PPD_MUTEXCLCH, - 1'mutually exclusive checks specified'/ - DATA C(174),T(174) /PPD_NNDNOTNOD, - 1'attribute NULL_NODE and check NODE must both be specified'/ - DATA C(175),T(175) /PPD_UNDONLVEC, - 1'undefined values only permitted for a vector'/ - DATA C(176),T(176) /PPD_TYPENOT, - 1'DATA_TYPE not specified'/ - DATA C(177),T(177) /PPD_TYPCHKINV, - 1'one or more specified checks invalid for the specified - 2 DATA_TYPE'/ - DATA C(178),T(178) /PPD_TYPEINV, - 1'DATA_TYPE invalid'/ - DATA C(179),T(179) /PPD_IOINV, - 1'IO invalid'/ - DATA C(180),T(180) /PPD_LENGTHNOT, - 1'LENGTH required for this DATA_TYPE'/ - DATA C(181),T(181) /PPD_NOTPOSINT, - 1'value should be a positive integer value'/ - DATA C(182),T(182) /PPD_LENGTHINV, - 1'LENGTH invalid'/ - DATA C(183),T(183) /PPD_NVLINVVEC, - 1'NVALUES should be > 0 for a vector'/ - DATA C(184),T(184) /PPD_NVLINVCHK, - 1'one of the specified checks invalid for NVALUES = 1'/ - DATA C(185),T(185) /PPD_MNVALINV, - 1'MIN_NVALUES should be <= NVALUES'/ - DATA C(186),T(186) /PPD_MXVALINV, - 1'MAX_NVALUES should be <= NVALUES and >= MIN_NVALUES'/ - DATA C(187),T(187) /PPD_MMNOVAL, - 1'check MINIMUM or MAXIMUM, but no corresponding value'/ - DATA C(188),T(188) /PPD_MMNOCHK, - 1'MINIMUM or MAXIMUM value, but no corresponding check'/ - DATA C(189),T(189) /PPD_MMINV, - 1'MINIMUM or MAXIMUM invalid'/ - DATA C(190),T(190) /PPD_VCINVNVL, - 1'for a vector the nr of MINIMUM/MAXIMUM values should be - 2 NVALUES'/ - DATA C(191),T(191) /PPD_NVCINVNVL, - 1'if not a vector the nr of MINIMUM/MAXIMUM values should be 1'/ - DATA C(192),T(192) /PPD_UNITINV, - 1'UNIT invalid'/ - DATA C(193),T(193) /PPD_SEARCHINV, - 1'SEARCH invalid'/ - DATA C(194),T(194) /PPD_PSEARCH, - 1'when DEFAULT specified, SEARCH = PROGRAM required'/ - DATA C(195),T(195) /PPD_OPTNOVAL, - 1'check OPTIONS or ABBREV_OPTIONS, but no corresponding value'/ - DATA C(196),T(196) /PPD_OPTNOCHK, - 1'OPTIONS specified but no corresponding check'/ - DATA C(197),T(197) /PPD_NOIMAGE, - 1'no image name specified'/ - DATA C(198),T(198) /PPD_EXEUSER, - 1'PPD-file found on n_uexe'/ - DATA C(199),T(199) /PPD_REFEXCMAX, - 1'number of external references exceeds maximum; - 2 tell programmer'/ - DATA C(200),T(200) /PPD_GLOFILNF, - 1'the file for global searches is not (yet) present'/ - DATA C(201),T(201) /PPD_PARINV, - 1'parameter name invalid'/ - DATA C(202),T(202) /PPD_PARNOTUNI, - 1'parameter name not unique'/ - DATA C(203),T(203) /PPD_INVQUAVAL, - 1'invalid qualifier value(s)'/ - DATA C(204),T(204) /PPD_DEFVALINV, - 1'DEFAULTS invalid'/ - DATA C(205),T(205) /PPD_INTREF, - 1'one or more internal references; 2nd compilation pass - 2 necessary'/ - DATA C(206),T(206) /PPD_KEYAMBIG, - 1'ambiguous keyword !AS; you could mean one of the keywords:'/ -C - DATA C(207),T(207) /CPL_WRKFUL, - 1'not enough space in work-area; please contact programmer'/ - DATA C(208),T(208) /CPL_ERRCNTEXC, - 1'error-count exceeded'/ - DATA C(209),T(209) /CPL_FLDNOTUNI, - 1'field name not uniquely abbreviated'/ - DATA C(210),T(210) /CPL_FLDINVAL, - 1'invalid field name'/ - DATA C(211),T(211) /CPL_SRCEOF, - 1'End of source file detected'/ - DATA C(212),T(212) /CPL_SUCCESS, - 1'Success'/ - DATA C(213),T(213) /CPL_SRCOPNERR, - 1'Error opening source file'/ - DATA C(214),T(214) /CPL_SRCREWERR, - 1'Error rewinding source file'/ - DATA C(215),T(215) /CPL_SRCRDERR, - 1'Error reading source line !SJ'/ - DATA C(216),T(216) /CPL_SRCCLOERR, - 1'Error closing source file'/ - DATA C(217),T(217) /CPL_OBJOPNERR, - 1'Error opening object file'/ - DATA C(218),T(218) /CPL_OBJWRTERR, - 1'Error writing object record !SJ'/ - DATA C(219),T(219) /CPL_OBJCLOERR, - 1'Error closing object file'/ - DATA C(220),T(220) /CPL_OBJDELERR, - 1'Error deleting object file'/ - DATA C(221),T(221) /CPL_FLDNRINV, - 1'Invalid work-field number !SJ'/ - DATA C(222),T(222) /CPL_STROVRFLO, - 1'Output string too short'/ - DATA C(223),T(223) /CPL_ARROVRFLO, - 1'Output array too small'/ - DATA C(224),T(224) /CPL_FLDUNEXP, - 1'Unexpected field in source line !SJ'/ - DATA C(225),T(225) /CPL_EOFUNEXP, - 1'Unexpected end of source file'/ - DATA C(226),T(226) /CPL_VALLISINV, - 1'Invalid value list: !AS'/ - DATA C(227),T(227) /CPL_DYNFILERR, - 1'Error filling dynamic object buffer'/ - DATA C(228),T(228) /CPL_DYNWRTERR, - 1'Error writing dynamic object buffer to object file'/ - DATA C(229),T(229) /CPL_CLISTERR, - 1'Error writing compilation listing'/ - DATA C(230),T(230) /CPL_DATTYPINV, - 1'Invalid data-type code: !AS'/ - DATA C(231),T(231) /GEN_LUNNOFREE, - 1'No free LUN available'/ - DATA C(232),T(232) /PPD_LENGTHLON, - 1'LENGTH must be <=255'/ - DATA C(233),T(233) /UDF_UNINOTFND, - 1'unit-code !AS not found'/ - DATA C(234),T(234) /UDF_GRPNOTFND, - 1'unit-group !AS not found'/ - DATA C(235),T(235) /UDF_STRTOOSML, - 1'string is not long enough'/ - DATA C(236),T(236) /DBD_BADNODE, - 1'Node name syntax error'/ - DATA C(237),T(237) /DBD_NAMTOLNG, - 1'Junction name !AS consists of more than 8 characters'/ - DATA C(238),T(238) /DBD_NAMTOMNY, - 1'Node name consists of more than !SL junction names'/ -C - DO I = 1,MAXPAR - IF (STATID.EQ.C(I)) GOTO 100 - ENDDO - WRITE (MSG,'(A15,Z8.8)') 'Status code nr ',STATID - GOTO 900 - 100 MSG = T(I) -C - 900 LMSG = WNCALN(MSG) - GEN_GETMSG = 1 - RETURN - END diff --git a/src/dwarf/gengetpar.cun b/src/dwarf/gengetpar.cun deleted file mode 100644 index 655c6546f3f99d1b9ba6306088ce9e0768371afa..0000000000000000000000000000000000000000 --- a/src/dwarf/gengetpar.cun +++ /dev/null @@ -1,214 +0,0 @@ -/*++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++*/ -/*.Ident: GENSW_GET_PARM -/*.Keywords: Program Parameters, Get Value -/*.Author: Ger van Diepen (NFRA, Dwingeloo) -/*.Language: C -/*.Environment: SUN -/*.Comments: -/*.Version: 920202 GvD - creation -/*.Version: 940121 CMV - keey only get_parm_ for Alliant -/*.Version: CMV 031205 - Changed for stdarg -/*--------------------------------------------------------------------------*/ -/*++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++*/ -/* INTEGER*4 FUNCTION GET_PARM (KEYWORD,ARRAY,NBYT,NR,DEFSTR, -/* 1 DEFARR,NRDEF,FLAGS,STROUT) -/* -/* Required arguments: -/* -/* CHARACTER*(*) KEYWORD ! (i) program's parameter name -/* <datatype> ARRAY(*) ! (o) data array -/* INTEGER*4 NBYT ! (i) total length of array in bytes -/* -/* Optional arguments: -/* -/* INTEGER*4 NR ! (o) nr of filled elements in array -/* CHARACTER*(*) DEFSTR ! (i) default value (given as a string) -/* <datatype> DEFARR(*) ! (i) default value (given as an array) -/* INTEGER*4 NRDEF ! (i) nr of elements in DEFARR -/* INTEGER*4 FLAGS ! (i) control flags -/* CHARACTER*(*) STROUT ! (o) last value set -/* -/*.Purpose: Get a value set for a program parameter -/*.Returns: See GETPARM.FOR -/*.Notes: -/* GET_PARM is only an interface to GET_PARM_N/GET_PARM_C to -/* fill in optional arguments. -/* GET_PARS is a similar routine for WNDPAR (in the N-series), which -/* creates an argument list itself. -/*-------------------------------------------------------------------------*/ - - -#include <stdarg.h> - - int get_parm_ (char* key, char* array,int *nbyt,...) -/* char *key; - char *array; - int *nbyt; - va_dcl*/ - { -#ifdef wn_al__ - va_list args; - int i,is,nrarg,adr; - int lista[7]; - int listl[8]; - - char d_strout; -/* -functions -*/ - int write_msg_(); - int get_parm_call(); - - -/* -Get all arguments by looping through them until a values is found < 65536. -This is based on the fact that addresses are >= 65536, string lengths are -passed by value and are < 65536 and that the first argument is a string. -Null-arguments will be passed as 0. -So we have arguments until >0 and < 65536. -*/ - va_start (args,nbyt); - nrarg = 0; - while (nrarg<7) { - adr = va_arg (args, int); - if (adr>0 && adr<65536) - break; - lista[nrarg++] = adr; - } -/* -If we have more than 6 variable arguments, the call was invalid. -Print a message for that and return status 2. -Note that 30 is the length of the string. -*/ - if (nrarg>6) { - is = 2; /* status */ - i = 0; /* flags */ - fprintf(stderr,"Invalid GET_PARM argument list"); - return(30); - } -/* -Now get the possible corresponding string lengths. -Also get string length of keyword and possibly array. -*/ - i = 0; - while (i<nrarg+2) { - listl[i++] = adr; - adr = va_arg (args, int); - } - va_end (args); -/* -Now call the real GET_PARM. -*/ - return get_parm_call (key,array,nbyt,nrarg,lista,listl,1,&d_strout); -#endif - } - -#ifdef wn_al__ - - get_parm_call (key,array,nbyt,nrarg,lista,listl,lenout,strout) - char *key; - char *array; - int *nbyt; - int nrarg; - int *lista[]; - int listl[]; - int lenout; - char *strout; - { - int i,is; - int defs,defa,stro; - int lens,lena,leno; - - int d_nr,d_nrdef,d_flags; - char d_defstr,d_defarr; -/* -functions -*/ - int get_parm_n(); - int get_parm_c(); -/* -Now fill in defaults for non-given arguments. -Set a switch indicating if a possible character argument is given. -Shift the lengths if a string is inserted. -*/ - d_nr = -2147483648; /* undef_j */ - d_defstr = ' '; - d_defarr = -128; /* undef_b */ - d_nrdef = -2147483648; - d_flags = 0; - - defa = 1; /* initially DEFARR given */ - defs = 1; /* initially DEFSTR given */ - stro = 1; /* initially STROUT given */ - if (nrarg<=0 || lista[0]==0) /* no NR */ - lista[0] = &d_nr; - if (nrarg<=1 || lista[1]==0) { /* no DEFSTR */ - defs = 0; - lista[1] = (int *) &d_defstr; - } - if (nrarg<=2 || lista[2]==0) { /* no DEFARR */ - defa = 0; - lista[2] = (int *) &d_defarr; - } - if (nrarg<=3 || lista[3]==0) /* no NRDEF */ - lista[3] = &d_nrdef; - if (nrarg<=4 || lista[4]==0) /* no FLAGS */ - lista[4] = &d_flags; - if (nrarg<=5 || lista[5]==0) { /* no STROUT */ - stro = 0; - lista[5] = (int *) strout; - } -/* -Now call GET_PARM_N first. -If that fails because the datatype is C, we call GET_PARM_C. -Pass the lengths correctly. -*/ - lens = 1; /* set default string lengths */ - lena = 1; - leno = lenout; - i = 1; /* Only key is a string */ - if (defs) - lens = listl[i++]; - if (stro) - leno = listl[i]; - is = get_parm_n_ (key, - array, - nbyt, - lista[0], - lista[1], - lista[2], - lista[3], - lista[4], - lista[5], - listl[0], /* len(key) */ - lens, /* len(defstr) */ - leno); /* len(strout) */ - - if (is == 0) { - i = 2; /* key and array are strings */ - if (defs) - lens = listl[i++]; - if (defa) - lena = listl[i++]; - if (stro) - leno = listl[i]; - is = get_parm_c_ (key, - array, - nbyt, - lista[0], - lista[1], - lista[2], - lista[3], - lista[4], - lista[5], - listl[0], /* len(key) */ - listl[1], /* len(array) */ - lens, /* len(defstr) */ - lena, /* len(defarr) */ - leno); /* len(strout) */ - } - - return is; - } -#endif - diff --git a/src/dwarf/gengetpar.fvx b/src/dwarf/gengetpar.fvx deleted file mode 100644 index 0f5d8c0fa2e2fff7db7deae5a619bc63388c3f14..0000000000000000000000000000000000000000 --- a/src/dwarf/gengetpar.fvx +++ /dev/null @@ -1,72 +0,0 @@ -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ -C.Ident: VGEN_GET_PARM -C.Keywords: Program Parameters, Get Value -C.Author: Friso Olnon (NFRA, Dwingeloo) -C.Language: DWARF-Fortran -C.Environment: VAX or Alliant -C.Comments: -C.Version: 900322 FMO - creation -C.Version: 911213 GvD - do not return UNDEF_J in NR, otherwise -C GP_ARG_CHECK treats NELEM next time as not given. -C.Version: 920305 GvD - split in GETPARM.FOR and GENGETPAR.FOR -C system dependencies in GENGETPAR -C------------------------------------------------------------------------- -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - INTEGER*4 FUNCTION GET_PARM () -C GET_PARM (KEYWORD,ARRAY,NBYT,NR,DEFSTR, -C 1 DEFARR,NRDEF,FLAGS,STROUT) -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' -C -C Required arguments: -C -C CHARACTER*(*) KEYWORD ! (i) program's parameter name -C <datatype> ARRAY(*) ! (o) data array -C INTEGER*4 NBYT ! (i) total length of array in bytes -C -C Optional arguments: -C -C INTEGER*4 NR ! (o) nr of filled elements in array -C CHARACTER*(*) DEFSTR ! (i) default value (given as a string) -C <datatype> DEFARR(*) ! (i) default value (given as an array) -C INTEGER*4 NRDEF ! (i) nr of elements in DEFARR -C INTEGER*4 FLAGS ! (i) control flags -C CHARACTER*(*) STROUT ! (o) last value set -C -C.Purpose: Get a value set for a program parameter -C.Returns: See GETPARM.FOR -C.Notes: -C This function is only an interface to GET_PARM_N/GET_PARM_C to -C fill in optional arguments. -C------------------------------------------------------------------------- -C -C - INTEGER*4 GEN_CALL - EXTERNAL GET_PARM_N, GET_PARM_C -C -C -C Defaults for missing arguments -C - INTEGER*4 D_NR /UNDEF_J/ - CHARACTER*1 D_DEFSTR /' '/ - BYTE D_DEFARR(1) /UNDEF_B/ - CHARACTER*1 D_DEFARR_C(1) /UNDEF_C/ - INTEGER*4 D_NRDEF /UNDEF_J/ - INTEGER*4 D_FLAGS /0/ - CHARACTER*1 D_STROUT /' '/ -C -C Assume numerical-type data array -C - pass argument list to GET_PARM_N -C - GET_PARM = GEN_CALL (GET_PARM_N,,,, - 1 D_NR,D_DEFSTR,D_DEFARR,D_NRDEF,D_FLAGS,D_STROUT) -C -C Return status 0 means: character data -C - pass argument list to GET_PARM_C -C - IF (GET_PARM.EQ.0) GET_PARM = GEN_CALL (GET_PARM_C,,,, - 1 D_NR,D_DEFSTR,D_DEFARR_C,D_NRDEF,D_FLAGS,D_STROUT) -C - RETURN - END diff --git a/src/dwarf/geninput.fun b/src/dwarf/geninput.fun deleted file mode 100644 index eac88e8ea1bd2dcba17df6eccb7e7b98a74c3432..0000000000000000000000000000000000000000 --- a/src/dwarf/geninput.fun +++ /dev/null @@ -1,149 +0,0 @@ -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ -C.Ident: GEN_INPUT -C.Keywords: Get Input Line -C.Author: Friso Olnon (NFRA, Dwingeloo) -C.Language: DWARF-Fortran -C.Environment: UNIX -C.Comments: -C Only input from standard input is supported now. -C.Version: 900412 FMO - creation -C.Version: 900901 FMO - reformat long prompts, remove CR -C.Version: 910825 FMO - don't prompt if the implied input unit (5) is not -C a terminal -C.Version: 920214 GvD - no optional arguments in MSG anymore -C.Version: 920316 GvD - use GEN_OUTPUT to write to standard output -C.Version: 920513 GvD - report IO-error more exactly (via GEN_FORIOS) -C.Version: 930615 CMV - Use wncaln to get length of input -C.Version: 930802 CMV - Correct carriage return handling -C 941021 JPH - Prompt formatting -C 941206 JPH - Always output prompt. Repeat reply if input not -C from terminal -C 950110 JPH - Make prompt output and reply echo conditional on -C environment variable N_PSCTEST -C Remove DEV(2) ('FERRY', totally obsolete) -C 950117 JPH - Make '\' an alternative for "" (null input) -C 950208 JPH - Allow for comments following '\' null reply -C 951026 JPH - For batch applications; Output prompt terminator -C '~' if N_PSCTEST set -C -C - use GEN_ISATERM iso. ISATTY to isolate system-dep. -C 961025 HjV - Add test for wn_da__ because -C first time GEN_ISATERM(5) returns false -C------------------------------------------------------------------------- -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - INTEGER*4 FUNCTION GEN_INPUT (LINE,PROMPT,DEVCOD) -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' -C - CHARACTER*(*) LINE ! (o) answer - CHARACTER*(*) PROMPT ! (i) prompt - INTEGER*4 DEVCOD ! (i) input-device code -C -C.Purpose: Ask a single line from the user -C.Returns: Status code (.TRUE. for success, .FALSE. otherwise) -C success DWC_SUCCESS normal completion -C warning DWC_EOFCTRLZ end of file (CTRL/Z or '#' given) -C info DWC_GETINPTR answer truncated -C fatal DWC_GETINPERR I/O error -C.Notes: -C - The input is read from the implied unit, which is assumed to have -C logical unit nr 5. If the implied unit is not a terminal, no prompt -C will be issued. -C - JPH 941021: The new prompt formatting is presently parallelled with -C the old formatting code, in order to enable a smooth transition. Once -C all the .psc/pef files have been reformatted, the old branch with the -C selection code (variable BAR) can de taken out. -C------------------------------------------------------------------------- -C -C - CHARACTER*(*) BLANK, DELIM - PARAMETER (BLANK = ' ') - PARAMETER (DELIM = ',=:'//BLANK) -C - INTEGER*4 GEN_FORIOS, MSG_SET , WNCALN - INTEGER*4 STR_COPY, STR_COPY_U - LOGICAL GEN_ISATERM -C - CHARACTER ANSWER*255, STR*80 - LOGICAL FMTD - INTEGER*4 IS, LP, LA, LS, LI, PTR, SAVPTR, SAVLS, PMX - CHARACTER*11 DEV(0:1) - DATA DEV /'SYS$INPUT','SYS$COMMAND'/ - CHARACTER N_PSCTEST - DATA N_PSCTEST/'#'/ -C -C - IF (N_PSCTEST.EQ.'#') CALL WNGSEG('N_PSCTEST',N_PSCTEST) - IF (GEN_ISATERM(5) .OR. N_PSCTEST.NE.' ') THEN ! terminal input or - ! test mode - LP = LEN (PROMPT) ! set length of prompt - ELSE ! ordinary batch mode - LP = 0 ! ignore the prompt - IF (.NOT.GEN_ISATERM(5)) THEN ! Not terminal input on Alpha -#ifdef wn_da__ - LP = LEN (PROMPT) ! set length of prompt -#endif - END IF - END IF - PTR = 1 !next prompt char to be copied - LI = 0 !indentation length - FMTD = .FALSE. !option format unknown -C -C Loop until prompt is complete -C - DO WHILE (PTR.LE.LP) - STR = BLANK !clear output string - LS = LI - PMX = MIN (LP, PTR+75) -!! IS = STR_COPY_U ('|',PROMPT(:LP), !copy up to line delimiter - IS = STR_COPY_U ('|',PROMPT(:PMX), !copy up to line delimiter - 1 PTR,STR,LS) - DO WHILE (PROMPT(PTR:PTR).EQ.'|') - PTR = PTR+1 !skip line delimiters - ENDDO - - IF (PTR.GT.LP) THEN ! prompt completely copied: - IF (N_PSCTEST.NE.' ') THEN ! batch mode - LS=LS+1 - STR(LS:LS)='~' ! append ~ and output with CR - CALL GEN_OUTPUT (STR(:LS)) ! (batch_sync.exe will strip) - ELSE - CALL GEN_OUTPUT_NOCR (STR(:LS)) !write string (no CR) - ENDIF - ELSE !copy incomplete: - CALL GEN_OUTPUT (STR(:LS)) !write output string - LI = 4 !indent 4 chars - ENDIF - ENDDO -C -C Read input (this used to be through '(Q,A)', but this caused -C crashes on the SUN when reading from redirected stdin. -C - READ (*,'(A)',END=900,ERR=999) ANSWER - IF (ANSWER(1:1).EQ.'\') ANSWER='""' - LA=WNCALN(ANSWER) - LINE = ANSWER(:LA) -C - IF (N_PSCTEST.NE.' ') CALL GEN_OUTPUT (ANSWER(:LA)) -C -C Check status and return -C - IF (LA.GT.LEN(LINE)) THEN - GEN_INPUT = DWC_GETINPTR !answer truncated - ELSE IF (LINE.EQ.'#') THEN - GEN_INPUT = DWC_EOFCTRLZ !end of input - ELSE - GEN_INPUT = DWC_SUCCESS !normal completion - ENDIF - RETURN -C - 900 WRITE(*,*) '# ' !Supply new line - GEN_INPUT = DWC_EOFCTRLZ !end of input - RETURN -C - 999 GEN_INPUT = GEN_FORIOS ('Lunit 5') - GEN_INPUT = MSG_SET (DWC_GETINPERR,1) - CALL WNCTXT(DWLOG,DWMSG,DEV(DEVCOD)) - RETURN - END diff --git a/src/dwarf/geninput.fvx b/src/dwarf/geninput.fvx deleted file mode 100644 index 723e9d5034e9b013b592096f934051f79645f724..0000000000000000000000000000000000000000 --- a/src/dwarf/geninput.fvx +++ /dev/null @@ -1,114 +0,0 @@ -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ -C.Ident: VGEN_INPUT -C.Keywords: Get Input Line -C.Author: Ger van Diepen (NFRA, Dwingeloo) -C.Language: VAX-Fortran -C.Environment: VAX -C.Comments: -C Questions from subprocesses are directly asked on SYS$COMMAND. -C In the future we have to create a special function that can break -C through read-with-prompts (e.g. the $ of DCL), just like SYS$BRDCST -C is doing that. -C.Version: 821209 GVD - creation DWC_GETINP -C.Version: 831230 GVD - split into DWC_GETINP and DWC_GETINX -C - added '#' as an alternative CTRL/Z -C.Version: 840920 JPH - removed all Ferry references, subprocesses now -C ask via LIB$GET_COMMAND -C - for subprocesses: prefix CRLF to prompt and broadcast -C a message 15 sec after calling LIB$GET_COMMAND. -C.Version: 881204 FMO - split into DWC_INPUT and GEN_INPUT -C.Version: 920224 GvD - no optional arguments in MSG anymore -C------------------------------------------------------------------------- -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - INTEGER*4 FUNCTION GEN_INPUT (LINE,PROMPT,DEVCOD) -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' -C - CHARACTER*(*) LINE ! (o) answer - CHARACTER*(*) PROMPT ! (i) prompt - INTEGER*4 DEVCOD ! (i) input-device code -C -C.Purpose: Ask a single line from the user -C.Returns: Status code (.TRUE. for success, .FALSE. otherwise) -C success DWC_SUCCESS -C warning DWC_EOFCTRLZ end of file (CTRL/Z or '#' given) -C info DWC_GETINPTR answer truncated -C fatal DWC_GETINPERR I/O error -C.Notes: -C - If the input device is not a terminal, the prompt argument will be -C ignored. -C - If subprocess: prefix carriage-return and linefeed to the prompt. -C - An answer of '#' is treated as CTRL/Z. -C------------------------------------------------------------------------- -C - INCLUDE '($SSDEF)' - INCLUDE '($LIBDEF)' - INCLUDE '($RMSDEF)' -C - CHARACTER*(*) CRLF - PARAMETER (CRLF = CHAR(13)//CHAR(10)) -C - INTEGER*4 MSG_SET - INTEGER*4 LIB$GET_INPUT, LIB$GET_COMMAND - INTEGER*4 SYS$SETIMR, SYS$CANTIM - EXTERNAL GEN_INPUT_AST -C - INTEGER*4 DELTAT(2) - DATA DELTAT /-150000000,-1/ - CHARACTER*11 DEV(0:2) - DATA DEV /'SYS$INPUT','SYS$COMMAND','FERRY'/ -C - INTEGER*4 IS -C -C -C Get a line from the user -C - IF (DEVCOD.EQ.0) THEN - IS = LIB$GET_INPUT (LINE,PROMPT) - ELSE IF (DEVCOD.EQ.1) THEN - IS = LIB$GET_COMMAND (LINE,PROMPT) - ELSE - CALL SYS$SETIMR (,DELTAT,GEN_INPUT_AST,%VAL(DWC_SUBPRCPMT),) - IS = LIB$GET_COMMAND (LINE,CRLF//PROMPT) - CALL SYS$CANTIM (%VAL(DWC_SUBPRCPMT),) - ENDIF -C -C Check status and return -C - IF (IS.EQ.RMS$_EOF .OR. IS.EQ.SS$_ENDOFFILE) THEN - GEN_INPUT = DWC_EOFCTRLZ ! end of input - ELSE IF (IS.EQ.LIB$_INPSTRTRU) THEN - GEN_INPUT = DWC_GETINPTR ! answer truncated - ELSE IF (.NOT.IS) THEN - IS = MSG_SET (IS,0) ! I/O error - IS = MSG_SET (DWC_GETINPERR,1) - CALL WNCTXT(DWLOG,DWMSG,DEV(DEVCOD)) - GEN_INPUT = 4 - ELSE IF (LINE.EQ.'#') THEN - GEN_INPUT = DWC_EOFCTRLZ ! end of input - ELSE - GEN_INPUT = DWC_SUCCESS ! normal completion - ENDIF - RETURN - END -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - SUBROUTINE GEN_INPUT_AST -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' -C -C -C.Purpose: Display the message that the subprocess wants to prompt -C.Returns: Not applicable -C.Notes: -C------------------------------------------------------------------------- -C -C - INTEGER*4 MSG_SET - INTEGER*4 IS -C - IS = MSG_SET (DWC_SUBPRCPMT,0) -C - RETURN - END diff --git a/src/dwarf/genisaterm.fsc b/src/dwarf/genisaterm.fsc deleted file mode 100644 index 0d5f5b4ebe1bb56d215c7e34dd19bf1dd6e802af..0000000000000000000000000000000000000000 --- a/src/dwarf/genisaterm.fsc +++ /dev/null @@ -1,38 +0,0 @@ -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ -C.Ident: GEN_ISATERM -C.Keywords: Terminal -C.Author: Ger van Diepen (NFRA, Dwingeloo) -C.Language: DWARF-Fortran -C.Environment: VAX/VMS & UNIX -C.Comments: -C.Version: 920528 GvD - Created -C.Version: 930201 HjV - make FSC -C------------------------------------------------------------------------- -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - LOGICAL FUNCTION GEN_ISATERM (LUN) -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' -C - INTEGER LUN ! (i) LUN to be tested -C -C.Purpose: Test if a LUN is associated with a terminal; -C.Returns: TRUE = yes FALSE = not -C.Notes: -C------------------------------------------------------------------------- -C -#ifdef wn_hp__ - INTEGER FNUM, GEN_ISATTY - - INTEGER IS, FD - - FD = FNUM (LUN) !get File Descriptor - IS = GEN_ISATTY (FD) - GEN_ISATERM = IS.NE.0 !0 = false -#else - LOGICAL ISATTY - - GEN_ISATERM = ISATTY (LUN) -#endif - RETURN - END diff --git a/src/dwarf/genisatty.cun b/src/dwarf/genisatty.cun deleted file mode 100644 index 3354c63d3717d9b8ed10f51a02da8e653bd1815a..0000000000000000000000000000000000000000 --- a/src/dwarf/genisatty.cun +++ /dev/null @@ -1,22 +0,0 @@ -/*+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++*/ -/*.Ident: GENUN_ISATTY -/*.Keywords: Terminal -/*.Author: Ger van Diepen (NFRA, Dwingeloo) -/*.Language: C -/*.Environment: UNIX -/*.Comments: -/*.Version: 920528 GvD - Created -/*-----------------------------------------------------------------------*/ -/*+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++*/ - -gen_isatty_ (fd) - int *fd; /* (i) pointer to file descriptor */ -{ - -/*.Purpose: Test if a file descriptor is associated with a terminal; -/*.Returns: else = yes 0 = not -/*.Notes: -/*-----------------------------------------------------------------------*/ - - return isatty(*fd); -} diff --git a/src/dwarf/genmixfnm.mvx b/src/dwarf/genmixfnm.mvx deleted file mode 100644 index aea9e177e8a63b232d710d8b7c1a3359ae44a8b6..0000000000000000000000000000000000000000 --- a/src/dwarf/genmixfnm.mvx +++ /dev/null @@ -1,144 +0,0 @@ -;+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ -;.Ident: VGEN_MIXFNM -;.Keywords: File Specifications, Mix -;.Author: Ger van Diepen (NFRA, Dwingeloo) -;.Language: VAX/Macro -;.Environment: VAX/VMS -;.Comments: -;.Version: 830518 GVD - creation GENMIXFNM.MAR -;.Version: 830626 GVD - new version -;.Version: 841025 JPH - FAB and NAM blocks on stack; condense code -;.Version: 841107 JPH - add optional NAM argument -;.Version: 900328 FMO - edit comments -;.Version: 920225 GvD - no optional arguments in MSG anymore -;.Version: 930129 HjV - $CODE and $LOCAL expanded -;----------------------------------------------------------------------- - .TITLE GEN_MIXFNM MIX 2 FILENAMES -;+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ -; INTEGER*4 FUNCTION GEN_MIXFNM (OLD,NEW,RESULT,[LENG],[NAM]) -; -; CHARACTER*(*) OLD ! (i) old filename (default spec) -; CHARACTER*(*) NEW ! (i) new filename (primary spec) -; CHARACTER*(*) RESULT ! (o) resulting filename -; optional: -; INTEGER*4 LENG ! (o) significant length of result -; INTEGER*4 NAM(*) ! (o) RMS NAM block -; -;.Purpose: Mix two file specifications -;.Returns: Status code (.TRUE. for success, .FALSE. otherwise) -; success 1 -; false status code returned by RMS routines -;.Notes: -; - The filenames may contain wildcards or parts of the names may be -; omitted. -; - The resulting filename consists of the new name. Missing parts -; of the new name are filled with parts of the old name and the user -; defaults (from the SET DEFAULT command). Logical names (if used) are -; translated. -; -; E.g.: user default = DRA1:[VANDIEPEN.GEN] -; -; old = SOUTAP.FOR -; new = COPCAR -; result = DRA1:[VANDIEPEN.GEN]COPCAR.FOR; -; -; old = SYSDWARF: -; new = COPCAR -; result = DRA1:[DWARF]COPCAR.; -; -; - The function uses the RMS function SYS$PARSE. -; - The NAM argument is needed only if the caller wants access to -; additional information (such as file ID) which is produced as an -; automatic side effect of the RMS $PARSE operation. -; - The caller must insure that the block is large enough to hold a -; complete RMS NAM block (NAM$C_BLN bytes). -; - If the NAM argument is not given, the parse operation will use a -; temporary NAM block (built on the stack). -;----------------------------------------------------------------------- -; - .MACRO $LOCAL - .PSECT $LOCAL, PIC,CON,REL,LCL,NOSHR,NOEXE,RD,WRT,LONG - .IF NDF $LOCAL -$LOCAL: - .ENDC -$RELOC=$LOCAL - .ENDM -; -MSGLST: .LONG 2 ; MSG_SHOLD arg list - .ADDRESS ERRNR - .ADDRESS ZERO ; default flags -ERRNR: .BLKL 1 -ZERO: .LONG 0 -; - OFFOLD=4 ; arg list offsets - OFFNEW=8 - OFFRES=12 - OFFLENG=16 - OFFNAM=20 -; -; - .MACRO $CODE - .PSECT $CODE, PIC,CON,REL,LCL,SHR,EXE,RD,NOWRT,LONG - .IF NDF $CODE -$CODE: - .ENDC - .ENDM -; -.ENTRY GEN_MIXFNM,^M<R2,R3,R4,R5,R6,R7> -; -; Build FAB block on the stack -; - SUBL2 #FAB$C_BLN,SP ; make room on stack - MOVL SP,R6 ; save address of block - MOVC5 #0,(SP),#0,#FAB$C_BLN,(SP) ; clear block -; -; Get NAM block or build one on the stack -; - CMPB (AP),#OFFNAM/4 ; argument NAM given ? - BLSS 10$ ; if not: goto 10 - MOVL OFFNAM(AP),R7 ; save address of block - BRB 20$ ; goto 20 -10$: - SUBL2 #NAM$C_BLN,SP ; build temporary block on stack - MOVL SP,R7 ; save address of block -20$: MOVC5 #0,(SP),#0,#NAM$C_BLN,(R7) ; clear block -; -; Fill the blocks -; - MOVL OFFOLD(AP),R2 ; address of OLD filespec - MOVL OFFNEW(AP),R3 ; address of NEW filespec - $FAB_STORE FAB=(R6),BID=#FAB$C_BID,BLN=#FAB$C_BLN, - - DNS=(R2),DNA=@4(R2), - ; OLD is the default spec - FNS=(R3),FNA=@4(R3), - ; NEW is the primary spec - NAM=(R7) ; NAM block - MOVL OFFRES(AP),R3 ; address of RESULT - $NAM_STORE NAM=(R7),BID=#NAM$C_BID,BLN=#NAM$C_BLN, - - ESS=(R3),ESA=@4(R3) ; RESULT spec -; -; Mix the file specs -; - $PARSE FAB=(R6) ; parse -> RESULT - BLBS R0,APP ; if success: goto APP - MOVL R0,ERRNR ; otherwise: - CALLG MSGLST,G^MSG_SET ; hold the error message - BRB END ; goto END -; -; Fill up RESULT with blanks -; -APP: MOVZBL NAM$B_ESL(R7),R2 ; length of resulting filespec - SUBW3 R2,(R3),R4 ; length of substring to blank - BLEQ FILL ; if zero: goto FILL - ADDL3 R2,4(R3),R5 ; start of substring to blank - MOVC5 #0,(R5),#^A' ',R4,(R5) ; blank-fill - MOVL #1,R0 ; set success status -; -; Fill LENGTH argument (if given) -; -FILL: CMPL (AP),#OFFLENG/4 ; argument LENG given ? - BLSS END ; no: goto END - MOVL OFFLENG(AP),R2 ; address of LENG - BEQL END ; if zero: goto END - MOVZBL NAM$B_ESL(R7),(R2) ; fill argument -; -END: RET - .END diff --git a/src/dwarf/genmosaic.cun b/src/dwarf/genmosaic.cun deleted file mode 100644 index 1281a722f408adbf7f9664b5dbd69b2d3f034b4e..0000000000000000000000000000000000000000 --- a/src/dwarf/genmosaic.cun +++ /dev/null @@ -1,213 +0,0 @@ -/*+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++*/ -/*.Ident: GEN_MOSAIC -/*.Keywords: On-line Help -/*.Author: Marco de Vos (NFRA, Dwingeloo) -/*.Language: C -/*.Environment: UNIX (needs xmosaic.exe) -/*.Comments: -/*.Version: 930712 CMV - Created -/*.Version: 930927 CMV - Changed name of interface file (pidfile) -/*.Version: 931116 CMV - Trap undefined DISPLAY -/*.Version: 931223 CMV - Added nshow.pef -/*.Version: 940117 CMV - Write also to Mosaic.pid for Mosaic 2.1 -/*.Version: 940328 CMV - Add file://localhost to get there from http:.. -/*.Version: 940728 HjV - Use correct directory for requested keyword -/*.Version: 940812 CMV - Use double underscore in name - 940901 JPH - Undo 840812 -/*-----------------------------------------------------------------------*/ -/*+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++*/ - -#include <signal.h> -#include <stdlib.h> -#include <stdio.h> - -#ifdef _STANDALONE_ - -main() - -{ - char cc[128],*prog="nscan"; - int ii,i1=5,i2=0; - - ii=strlen("display"); - gen_mosaic_(prog,&i1,"display",&ii,NULL,&i2); - - printf("Keyword: "); - while (fgets(cc,128,stdin)) { - ii=strlen(cc); - gen_mosaic_(prog,&i1,cc,&ii,NULL,&i2); - printf("Keyword: "); - } -} -#endif - -gen_mosaic_ (prog,lprog,key,lkey,xdisp,ldisp) - -char *prog,*key,*xdisp; -int *lprog,*lkey,*ldisp; - -{ - -/*.Purpose: Start xmosaic at specified keyword -/*.Returns: PID of xmosaic or -1 any error occurred -/*.Notes: -/*-----------------------------------------------------------------------*/ - -/* - Name of the file in which the pid is saved. - The chance that on the same host a process with the same pid - will occur for this user is small. Any other procedure than this - save file will force us to edit xmosaic, which I don't want to - do now. -*/ - static char pidfile[128]; - -/* - Name of the html file to be loaded, name of display, - argument list of xmosaic to be started -*/ - static char name[128],disp[128]; - static char *args[]={"xmosaic",name,"-display",disp,NULL}; - -/* - This list should contain all pef files. - We could do this in a more flexible way, but that's for future -*/ - static char *pefs[]={"ngen","ncomm","nmap","nmodel","nsets","nshow", - "dwarf",NULL}; - - int pid=0,ii,start_new,l1,l2; - char file[128],*hlp; - FILE *fp; - - -/* - We need to find the last significant character of prog, key and disp - because they will be passed from Fortran. -*/ - for (l1=0; l1<(*lprog) && prog[l1]!=' ' && - prog[l1]!='\n' && prog[l1]!='\0'; l1++); - for (l2=0; l2<(*lkey) && key[l2]!=' ' && - key[l2]!='\n' && key[l2]!='\0'; l2++); - - if (*ldisp>0) { - for (ii=0; ii<(*ldisp) && xdisp[ii]!=' ' && xdisp[ii]!='\0'; ii++) - disp[ii]=xdisp[ii]; - disp[ii]='\0'; - } else if (getenv("DISPLAY")!=NULL) { /* DISPLAY defined, use it */ - strcpy(disp,getenv("DISPLAY")); - } else { /* Else try hostname:0.0 */ -/* - *ldisp=100; - gethost_(disp,ldisp); - strcat(disp,":0.0"); -*/ /* or rather: disable */ - printf("\nDISPLAY is undefined, you need it for hypertext help!\n"); - printf("Definition of DISPLAY through NGEN is not sufficient, you\n"); - printf("should really use something like setenv DISPLAY name:0.0\n\n"); - return(0); - } - -/* - Construct the name of the xmosaic interface file -*/ - strcpy(pidfile,"/tmp/xm-"); - for (ii=0; ii<100 && disp[ii]!='\0'; ii++) - if (disp[ii]==':') pidfile[8+ii]='.'; else pidfile[8+ii]=disp[ii]; - pidfile[8+ii]='\0'; - -/* - Construct URL of requested keyword. - - Since it may be a general keyword, we check the html directory for - the program name first, then for a list of .pef files. - This is clumsy, but I cannot see a way around it now. -*/ - hlp=getenv("n_hlp"); - sprintf(name,"%s/%.*s/%.*s_%.*s.html",hlp,l1,prog,l1,prog,l2,key); - fp=fopen(name,"r"); - for (ii=0; fp==NULL && pefs[ii]!=NULL; ii++) { - sprintf(name,"%s/%s/%s_%.*s.html",hlp,pefs[ii],pefs[ii],l2,key); - fp=fopen(name,"r"); - } - - if (fp==NULL) { - printf("\nNo such file for %.*s %.*s\n\n",l1,prog,l2,key); - return(0); - } - fclose(fp); - -/* - If this routine starts xmosaic, it creates a file /tmp/xmosaic-pid - containing it's pid. - - Any follwing calls check wether this file exists, - If so, we try to send an interrupt and wait for the response. - If the interrupt failed, we remove the /tmp file - If no response occured or if no /tmp/xmosaic etc file existed, - we try to start a new xmosaic. - - In future, we might want to change xmosaic to make it's communication - a bit more flexible (inter-host communication etc). -*/ - - start_new=1; - - fp=fopen(pidfile,"r"); - if (fp!=NULL) { - pid=-1; - fscanf(fp,"%d",&pid); - fclose(fp); - - if (pid>0) { - sprintf(file,"/tmp/Mosaic.%d",pid); - fp=fopen(file,"w"); - if (fp==NULL) return(-1); - fprintf(fp,"goto\nfile://localhost%s\n",name); - fclose(fp); -/* - Keep compatible with Mosaic <2.1 as well -*/ - sprintf(file,"/tmp/xmosaic.%d",pid); - fp=fopen(file,"w"); - if (fp==NULL) return(-1); - fprintf(fp,"goto\nfile://localhost%s\n",name); - fclose(fp); - - if (kill(pid,SIGUSR1)) { - unlink(pidfile); - } else { - start_new=0; - } - } - } - -/* - No xmosaic available, start child process, start xmosaic -*/ - - if (start_new) { - printf("Trying to start xmosaic on %s, please wait..\n",disp); - pid=fork(); - if (pid==0) { /* We are the child process now */ - freopen("/dev/null","w",stderr); - sprintf(file,"%s/xmosaic.exe",getenv("n_exe")); - if (execv(file,args)==-1) { - printf("Error starting xmosaic on %s...\n",disp); - unlink(pidfile); - exit(-1); - } - } else { -/* - Save pid in file for future calls -*/ - fp=fopen(pidfile,"w"); - if (fp!=NULL) { - fprintf(fp,"%d\n",pid); - fclose(fp); - } - } - } - - return(pid); -} diff --git a/src/dwarf/genmovblx.for b/src/dwarf/genmovblx.for deleted file mode 100644 index e4c4d6e38e6edb3cc9be6ef7c711eb3267f65195..0000000000000000000000000000000000000000 --- a/src/dwarf/genmovblx.for +++ /dev/null @@ -1,266 +0,0 @@ -C++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ -C.Ident: GENUN_MOVBLX -C.Keywords: Block, Move -C.Author: Friso Olnon (NFRA, Dwingeloo) -C.Language: DWARF-Fortran -C.Environment: UNIX -C.Comments: -C.Version: 880626 FMO - creation -C.Version: 890111 FMO - corrected declaration errors (types J,R,D) -C.Version: 900906 FMO - use byte block moves everywhere -C - use only 2 entry points per function (compiler error) -C---------------------------------------------------------------------- -C++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - INTEGER*4 FUNCTION MOVE_BLB (SRCARR,DSTARR,NELEM) - ENTRY GEN_MOVBLB (SRCARR,DSTARR,NELEM) ! archaic form -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' - INTEGER*4 GEN_MOVBLB -C - LOGICAL*1 SRCARR(*) ! (i) source array - LOGICAL*1 DSTARR(*) ! (m) destination array - INTEGER*4 NELEM ! (i) nr of elements to be moved -C -C.Purpose: Move a BYTE array -C.Returns: Status code (.TRUE. for success, .FALSE. otherwise) -C success 1 -C.Notes: -C--------------------------------------------------------------------------- -C -C - DO I = 1,NELEM - DSTARR(I) = SRCARR(I) - ENDDO -C - MOVE_BLB = 1 - RETURN - END -C++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - INTEGER*4 FUNCTION GEN_MOVBLK (SRCARR,DSTARR,NELEM) ! archaic form -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' -C - LOGICAL*1 SRCARR(*) ! (i) source array - LOGICAL*1 DSTARR(*) ! (m) destination array - INTEGER*2 NELEM ! (i) nr of elements to be moved -C -C.Purpose: Move a BYTE array -C.Returns: Status code (.TRUE. for success, .FALSE. otherwise) -C success 1 -C.Notes: -C--------------------------------------------------------------------------- -C -C - DO I = 1,NELEM - DSTARR(I) = SRCARR(I) - ENDDO -C - GEN_MOVBLK = 1 - RETURN - END -C++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - INTEGER*4 FUNCTION MOVE_BLI (SRCARR,DSTARR,NELEM) - ENTRY MOVE_BLW (SRCARR,DSTARR,NELEM) -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' - INTEGER*4 MOVE_BLW -C - LOGICAL*1 SRCARR(*) ! (i) source array - LOGICAL*1 DSTARR(*) ! (m) destination array - INTEGER*4 NELEM ! (i) nr of elements to be cleared -C -C.Purpose: Move an INTEGER*2 array -C.Returns: Status code (.TRUE. for success, .FALSE. otherwise) -C success 1 -C.Notes: -C--------------------------------------------------------------------------- -C -C - DO I = 1,NELEM*2 - DSTARR(I) = SRCARR(I) - ENDDO -C - MOVE_BLI = 1 - RETURN - END -C++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - INTEGER*4 FUNCTION GEN_MOVBLI (SRCARR,DSTARR,NELEM) ! archaic form - ENTRY GEN_MOVBLW (SRCARR,DSTARR,NELEM) ! archaic form -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' - INTEGER*4 GEN_MOVBLW -C - LOGICAL*1 SRCARR(*) ! (i) source array - LOGICAL*1 DSTARR(*) ! (m) destination array - INTEGER*4 NELEM ! (i) nr of elements to be cleared -C -C.Purpose: Move an INTEGER*2 array -C.Returns: Status code (.TRUE. for success, .FALSE. otherwise) -C success 1 -C.Notes: -C--------------------------------------------------------------------------- -C -C - DO I = 1,NELEM*2 - DSTARR(I) = SRCARR(I) - ENDDO -C - GEN_MOVBLI = 1 - RETURN - END -C++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - INTEGER*4 FUNCTION MOVE_BLJ (SRCARR,DSTARR,NELEM) - ENTRY MOVE_BLL (SRCARR,DSTARR,NELEM) -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' - INTEGER*4 MOVE_BLL -C - LOGICAL*1 SRCARR(*) ! (i) source array - LOGICAL*1 DSTARR(*) ! (m) destination array - INTEGER*4 NELEM ! (i) nr of elements to be cleared -C -C.Purpose: Move an INTEGER*4 array -C.Returns: Status code (.TRUE. for success, .FALSE. otherwise) -C success 1 -C.Notes: -C--------------------------------------------------------------------------- -C -C - DO I = 1,NELEM*4 - DSTARR(I) = SRCARR(I) - ENDDO -C - MOVE_BLJ = 1 - RETURN - END -C++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - INTEGER*4 FUNCTION GEN_MOVBLJ (SRCARR,DSTARR,NELEM) ! archaic form - ENTRY GEN_MOVBLL (SRCARR,DSTARR,NELEM) ! archaic form -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' - INTEGER*4 GEN_MOVBLL -C - LOGICAL*1 SRCARR(*) ! (i) source array - LOGICAL*1 DSTARR(*) ! (m) destination array - INTEGER*4 NELEM ! (i) nr of elements to be cleared -C -C.Purpose: Move an INTEGER*4 array -C.Returns: Status code (.TRUE. for success, .FALSE. otherwise) -C success 1 -C.Notes: -C--------------------------------------------------------------------------- -C -C - DO I = 1,NELEM*4 - DSTARR(I) = SRCARR(I) - ENDDO -C - GEN_MOVBLJ = 1 - RETURN - END -C++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - INTEGER*4 FUNCTION MOVE_BLR (SRCARR,DSTARR,NELEM) -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' -C - LOGICAL*1 SRCARR(*) ! (i) source array - LOGICAL*1 DSTARR(*) ! (m) destination array - INTEGER*4 NELEM ! (i) nr of elements to be cleared -C -C.Purpose: Move a REAL*4 array -C.Returns: Status code (.TRUE. for success, .FALSE. otherwise) -C success 1 -C.Notes: -C--------------------------------------------------------------------------- -C -C - DO I = 1,NELEM*4 - DSTARR(I) = SRCARR(I) - ENDDO -C - MOVE_BLR = 1 - RETURN - END -C++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - INTEGER*4 FUNCTION GEN_MOVBLR (SRCARR,DSTARR,NELEM) ! archaic form - ENTRY GEN_MOVBLF (SRCARR,DSTARR,NELEM) ! archaic form -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' - INTEGER*4 GEN_MOVBLF -C - LOGICAL*1 SRCARR(*) ! (i) source array - LOGICAL*1 DSTARR(*) ! (m) destination array - INTEGER*4 NELEM ! (i) nr of elements to be cleared -C -C.Purpose: Move a REAL*4 array -C.Returns: Status code (.TRUE. for success, .FALSE. otherwise) -C success 1 -C.Notes: -C--------------------------------------------------------------------------- -C -C - DO I = 1,NELEM*4 - DSTARR(I) = SRCARR(I) - ENDDO -C - GEN_MOVBLR = 1 - RETURN - END -C++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - INTEGER*4 FUNCTION MOVE_BLD (SRCARR,DSTARR,NELEM) -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' -C - LOGICAL*1 SRCARR(*) ! (i) source array - LOGICAL*1 DSTARR(*) ! (m) destination array - INTEGER*4 NELEM ! (i) nr of elements to be cleared -C -C.Purpose: Move a REAL*8 array -C.Returns: Status code (.TRUE. for success, .FALSE. otherwise) -C success 1 -C.Notes: -C--------------------------------------------------------------------------- -C -C - DO I = 1,NELEM*8 - DSTARR(I) = SRCARR(I) - ENDDO -C - MOVE_BLD = 1 - RETURN - END -C++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - INTEGER*4 FUNCTION GEN_MOVBLD (SRCARR,DSTARR,NELEM) ! archaic form - ENTRY GEN_MOVBLQ (SRCARR,DSTARR,NELEM) ! archaic form -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' - INTEGER*4 GEN_MOVBLQ -C - LOGICAL*1 SRCARR(*) ! (i) source array - LOGICAL*1 DSTARR(*) ! (m) destination array - INTEGER*4 NELEM ! (i) nr of elements to be cleared -C -C.Purpose: Move a REAL*8 array -C.Returns: Status code (.TRUE. for success, .FALSE. otherwise) -C success 1 -C.Notes: -C--------------------------------------------------------------------------- -C -C - DO I = 1,NELEM*8 - DSTARR(I) = SRCARR(I) - ENDDO -C - GEN_MOVBLD = 1 - RETURN - END diff --git a/src/dwarf/genoutput.for b/src/dwarf/genoutput.for deleted file mode 100644 index 0a88312291f7e45a1441f99c03bb62dfc044e170..0000000000000000000000000000000000000000 --- a/src/dwarf/genoutput.for +++ /dev/null @@ -1,38 +0,0 @@ -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ -C.Ident: GENSW_OUTPUT -C.Keywords: Terminal output -C.Author: Ger van Diepen (NFRA, Dwingeloo) -C.Language: DWARF-Fortran -C.Environment: SUN -C.Comments: -C.Version: 920316 GvD - Created -C JPH 951101 - GEN_FLUSH calls for batch applications -C HjV 960618 - Use TFLUSH iso. GEN_FLUSH -C------------------------------------------------------------------------- -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - SUBROUTINE GEN_OUTPUT (TEXT) -C ENTRY GEN_OUTPUT_NOCR (TEXT) -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' -C - CHARACTER*(*) TEXT ! (i) text to be written -C -C.Purpose: Force immediate write of a text to the terminal -C GEN_OUTPUT_NOCR does the same without carriage-return. -C.Returns: not applicable -C.Notes: -C------------------------------------------------------------------------- -C - PRINT 1010,TEXT - CALL TFLUSH() -1010 FORMAT (A) - RETURN -C - ENTRY GEN_OUTPUT_NOCR (TEXT) - PRINT 1000,TEXT - CALL TFLUSH() -1000 FORMAT (A,$) - RETURN -C - END diff --git a/src/dwarf/gensize.cun b/src/dwarf/gensize.cun deleted file mode 100644 index 2bb5e03afe1430abb85e579ff5444da08c293300..0000000000000000000000000000000000000000 --- a/src/dwarf/gensize.cun +++ /dev/null @@ -1,33 +0,0 @@ -/*+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++*/ -/*.Ident: GEN_SIZE -/*.Keywords: Terminal -/*.Author: Marco de Vos (NFRA, Dwingeloo) -/*.Language: C -/*.Environment: UNIX (needs termcap) -/*.Comments: -/*.Version: 930712 CMV - Created -/*-----------------------------------------------------------------------*/ -/*+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++*/ - -gen_size_ (lines, cols) - -int *lines,*cols; - -{ - -/*.Purpose: Find number of lines and columns on terminal screen -/*.Returns: Number of lines or -1 if cannot find -/*.Notes: Uses termcap, link with -ltermcap -/*-----------------------------------------------------------------------*/ - - char bp[1024]; - - if (tgetent(bp,"")) { - *lines=tgetnum("li"); - *cols =tgetnum("co"); - return(*lines); - } else { - return(-1); - } - -} diff --git a/src/dwarf/gensize.fvx b/src/dwarf/gensize.fvx deleted file mode 100644 index df10b4f1f5ee0da4bb8cb40d619b0d01eb202bcd..0000000000000000000000000000000000000000 --- a/src/dwarf/gensize.fvx +++ /dev/null @@ -1,22 +0,0 @@ -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ -C.Ident: GEN_SIZE -C.Keywords: Terminal -C.Author: Marco de Vos (NFRA, Dwingeloo) -C.Language: VAX-Fortran -C.Environment: VAX -C.Comments: Use fixed 80*24 character screen (VT100) -C.Version: 930712 CMV - creation -C------------------------------------------------------------------------- -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - INTEGER*4 FUNCTION GEN_SIZE(LINES,COLS) -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' -C - INTEGER LINES,COLS -C - LINES=24 - COLS=80 - GEN_SIZE=LINES - RETURN - END diff --git a/src/dwarf/gensymbol.fun b/src/dwarf/gensymbol.fun deleted file mode 100644 index caa659a5d765330dd7e208139e3e6f499d740875..0000000000000000000000000000000000000000 --- a/src/dwarf/gensymbol.fun +++ /dev/null @@ -1,373 +0,0 @@ -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ -C.Ident: GENUN_SYMBOL -C.Keywords: Symbols -C.Author: Friso Olnon (NFRA, Dwingeloo) -C.Language: DWARF-Fortran -C.Environment: UNIX -C.Comments: -C - Symbols tie a value to a name. -C - Symbol names are extended-alphanumeric strings (uppercase letters, -C digits, dollar sign and underscore) of up to 64 characters. The first -C character cannot be a digit. When a symbol name is entered with -C lowercase letters, these will be converted to uppercase; trailing -C blanks will be ignored. -C - Symbol values may contain up to 255 ASCII characters. All blanks are -C significant including leading and trailing ones. Symbols can have -C null values, which are given as '""'. -C - On the Alliant, all symbols are global and their definitions are kept -C in the file defined under the environment variable DWARF_SYMBOLS -C The file has to exist. -C - Each program works with its own copy of the symbol file. Only at -C program termination, the master file will be updated. -C -C.Version: 900418 FMO - creation -C.Version: 900502 FMO - new GEN_LUN module -C.Version: 910808 FMO - rewritten, added SYMBOL_SEARCH and SYMBOL_EXIT -C.Version: 910830 FMO - allow for symbol file defined under environment -C variable DWARF_SYMBOLS -C.Version: 911121 GvD - main part is written in C; this Fortran file -C is only an interface layer -C.Version: 920214 GvD - no optional arguments in MSG anymore -C 940209 WNB - cleanup entry argument names; split off -C 940216 CMV - pass back NAME to L2NAM for search -C------------------------------------------------------------------------- -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - INTEGER FUNCTION SYMBOL_DEFINE (L1NAME,VALUE,L1TYPE) -C ENTRY SYMBOL_DELETE (L1NAME,L2TYPE) -C ENTRY SYMBOL_GET (L1NAME,VALUE,LVAL) -C ENTRY SYMBOL_SEARCH (INCLIST,EXCLIST,NR,L2NAME,LNAM) -C ENTRY SYMBOL_EXIT () -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' -C - CHARACTER*(*) L1NAME,L2NAME !(i,o) name - CHARACTER*(*) VALUE !(i,o) value - INTEGER L1TYPE,L2TYPE !(i) type (not used) - INTEGER LVAL !(o) length of the value - CHARACTER*(*) INCLIST !(i) list with symbol names to include - CHARACTER*(*) EXCLIST !(i) list with symbol names to exclude - INTEGER NR !(m) symbol nr - INTEGER LNAM !(o) length of the name -C -C.Purpose: Maintain and access symbol table -C.Returns: Status code (.TRUE. for success, .FALSE. otherwise) -C success GEN_SUCCESS also if blank name (no definition) -C error GEN_SYMDEFERR any define/exit error, message left in buffer -C error GEN_SYMDELERR any delete error, message left in buffer -C error GEN_SYMGETERR any get/search error, message left in buffer -C.Notes: -C - The symbol table is implemented in a C subroutine, which uses a file -C defined by the environment variable DWARF_SYMBOLS. -C This file is opened, read and closed if a symbol routine is used -C for the first time. It is updated (if needed) by SYMBOL_EXIT. -C These Fortran routines are merely an interface to the C routines. -C - Symbol names are converted to uppercase and trailing blanks are -C ignored. -C - Symbol values are stored as given. -C Values with zero length will be converted to null values ('""'). -C -C DEFINE -C - Define a new or redefine an old symbol. -C -C DELETE -C - Delete a symbol. -C -C GET -C - Get the value of the given symbol. -C - If the symbol does not exist or an error occurred, a blank value -C with length = 0 will be returned. -C - Otherwise, the length will be positive; null values are returned -C as '""' with length = 2. -C - If the value buffer is too short, the truncated value and an error -C code will be returned. -C -C SEARCH -C - Find the first or next symbol with a matching name. -C - INCLIST and EXCLIST are comma-separated lists of symbol names; the -C names may contain wildcards (*), each matching a substring of zero or -C more characters. -C - A matching symbol name is a name that matches at least one INCLIST -C element and does not match any EXCLIST element. Abbreviated matches -C are not recognised. -C - If NR.le.0 on input, the first matching name in the list of defined -C symbols and its number (output NR) will be returned. -C - If NR.gt.0 on input, the next matching name and its number will be -C returned; the search starts at symbol number NR+1. -C - If there is no matching symbol, NR=0, NAME=blank and LNAM=0 will be -C returned. -C - If the NAME buffer is too short, the truncated name, its length and -C an error code will be returned. -C -C EXIT -C - Close the symbol facility. -C - The symbol file is updated if any symbol has been defined or deleted. -C------------------------------------------------------------------------- -C -C - CHARACTER*(*) WILD - PARAMETER (WILD = '*') - INTEGER NAMSIZ, VALSIZ - PARAMETER (NAMSIZ = 64 ) !max length of names - PARAMETER (VALSIZ = 255) !max length of values -C -C C-functions -C - INTEGER SYMBOL_INIT_C, SYMBOL_GET_C, SYMBOL_ADD_C - INTEGER SYMBOL_EXIT_C -C -C Other functions - INTEGER SYMBOL_SEAR - INTEGER STR_SIGLEN, STR_UPCASE - INTEGER MSG_SET -C -C Entry-points - INTEGER SYMBOL_DELETE, SYMBOL_GET, SYMBOL_SEARCH, SYMBOL_EXIT -C - INTEGER TYPE - CHARACTER NAM*(NAMSIZ+1), VAL*(VALSIZ) - CHARACTER NAME*(NAMSIZ+1) - INTEGER LN, LV, OK, IS - INTEGER TP !0=GET 1=DEFINE 2=DELETE -1=SEARCH -C -C Define error codes for various entries - INTEGER ERRNR(-1:2) - DATA ERRNR /GEN_SYMGETERR, GEN_SYMGETERR, GEN_SYMDEFERR, - 1 GEN_SYMDELERR/ -C -C Define permanent "first time" switch - LOGICAL FIRST - DATA FIRST /.TRUE./ - SAVE FIRST -C -C -C -C This is the SYMBOL_DEFINE entry - NAME=L1NAME - TP = 1 - TYPE=L1TYPE - GOTO 100 -C -C This is the SYMBOL_DELETE entry - ENTRY SYMBOL_DELETE (L1NAME,L2TYPE) - NAME=L1NAME - TYPE=L2TYPE - TP = 2 - GOTO 100 -C -C This is the SYMBOL_GET entry - ENTRY SYMBOL_GET (L1NAME,VALUE,LVAL) - NAME=L1NAME//' ' - TP = 0 - GOTO 100 -C -C This is the SYMBOL_SEARCH entry - ENTRY SYMBOL_SEARCH (INCLIST,EXCLIST,NR,L2NAME,LNAM) - NAME=L2NAME - TP = -1 - GOTO 100 -C -C -C Initialize to success -C On first invocation: -C - initialize the symbol facility -C - 100 OK = GEN_SUCCESS - IF (FIRST) THEN - OK = SYMBOL_INIT_C () - IF (IAND(OK,1) .NE. 1) THEN - CALL WNCTXT(DWLOG, - 1 'Error during initialization of symbol facility') - CALL WNCTXT(DWLOG, - 1 'Probably file DWARF_SYMBOLS could not be opened') - GOTO 929 - ENDIF - FIRST = .FALSE. - ENDIF -C -C Handle the symbol name -C Test its length and convert to uppercase -C Add a 0 to the name for the C subroutine -C - IF (TP.GE.0) THEN - LN = STR_SIGLEN (NAME) - IF (LN.EQ.0) THEN - CALL WNCTXT (DWLOG,'Blank name not allowed') - GOTO 929 - ENDIF - IF (LN.GT.NAMSIZ) THEN - CALL WNCTXT(DWLOG,'Name too long (!SJ, max length !SJ)', - 1 LN,NAMSIZ) - GOTO 929 - ENDIF - IF (INDEX(NAME(:LN),WILD).NE.0) THEN - CALL WNCTXT (DWLOG,'No wildcards allowed in name') - GOTO 929 - ENDIF - NAM = NAME - IS = STR_UPCASE (NAM) - NAM(LN+1:LN+1) = CHAR(0) -C -C -C Get the symbol value -C (ignore return status) -C Generate message if buffer too short -C - IF (TP.EQ.0) THEN - IS = SYMBOL_GET_C (NAM,LVAL,VAL) - VALUE = VAL(:LVAL) - IF (LEN(VALUE).LT.LVAL) THEN - LVAL = LEN(VALUE) - CALL WNCTXT(DWLOG, - 1 'Value truncated to !SJ characters',LVAL) - GOTO 929 - ENDIF -C -C Define the symbol -C Error if value too long -C Define as "" if null value -C - ELSEIF (TP.EQ.1) THEN - LV = LEN(VALUE) - IF (LV.GT.VALSIZ) THEN - CALL WNCTXT(DWLOG, - 1 'Value too long (!SJ, max length !SJ)', - 1 LV,VALSIZ) - GOTO 929 - ENDIF - IF (LV.EQ.0) THEN - VAL = '""' - LV = 2 - ELSE - VAL = VALUE - ENDIF - OK = SYMBOL_ADD_C (LN,NAM,LV,VAL,1) - ELSE -C -C Delete the symbol -C - OK = SYMBOL_ADD_C (LN,NAM,0,' ',2) - ENDIF -C -C Get the next symbol -C - ELSE - OK = SYMBOL_SEAR (INCLIST,EXCLIST,NR,L2NAME,LNAM) - ENDIF - GOTO 990 -C -C -C Generate error message - 929 OK = MSG_SET (ERRNR(TP),1) - CALL WNCTXT(DWLOG,DWMSG,NAME) -C - 990 SYMBOL_DEFINE = OK - RETURN -C -C This is the SYMBOL_EXIT entry-point. -C Exit if nothing done. -C Otherwise EXIT the symbol facility properly. -C Generate a message in case of errors. - ENTRY SYMBOL_EXIT () - OK = GEN_SUCCESS !Initialize to success - IF (.NOT.FIRST) THEN - OK = SYMBOL_EXIT_C () - ENDIF - IF (IAND(OK,1) .NE. 1) THEN - OK = MSG_SET (GEN_SYMDEFERR,1) - CALL WNCTXT(DWLOG,DWMSG,'update') - END IF - SYMBOL_DEFINE = OK - RETURN - END -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - INTEGER FUNCTION SYMBOL_SEAR (INCLIST,EXCLIST,NR,NAME,LNAM) -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' -C - CHARACTER*(*) INCLIST !(i) list with symbol names to include - CHARACTER*(*) EXCLIST !(i) list with symbol names to exclude - INTEGER NR !(m) symbol nr - CHARACTER*(*) NAME !(o) symbol name - INTEGER LNAM !(o) length of the name -C -C.Purpose: Find the first or next symbol with a matching name -C.Returns: Status code (.TRUE. for success, .FALSE. otherwise) -C success GEN_SUCCESS also if no matching symbol name does exist -C error GEN_SYMGETERR any error, message left in buffer -C.Notes: -C - INCLIST and EXCLIST are comma-separated lists of symbol names; the -C names may contain wildcards (*), each matching a substring of zero or -C more characters. -C - A matching symbol name is a name that matches at least one INCLIST -C element and does not match any EXCLIST element. Abbreviated matches -C are not recognised. -C - If NR.le.0 on input, the first matching name in the list of defined -C symbols and its number (output NR) will be returned. -C - If NR.gt.0 on input, the next matching name and its number will be -C returned; the search starts at symbol number NR+1. -C - If there is no matching symbol, NR=0, NAME=blank and LNAM=0 will be -C returned. -C - If the NAME buffer is too short, the truncated name, its length and -C an error code will be returned. -C------------------------------------------------------------------------- -C -C - CHARACTER*(*) BLANK, COMMA, WILD - PARAMETER (BLANK = ' ') - PARAMETER (COMMA = ',') - PARAMETER (WILD = '*') - INTEGER NAMSIZ - PARAMETER (NAMSIZ = 64) !max length of names -C - INTEGER SYMBOL_NEXT_C - INTEGER STR_SIGLEN, STR_MATCH_L - INTEGER MSG_SET -C - CHARACTER NAM*(NAMSIZ) - INTEGER IS, LN, LINC, LEXC, MATCHNR -C -C -C Set up -C - NAME = BLANK !set blank name - LNAM = 0 !set zero length - NAM = BLANK - LN = 0 - LINC = STR_SIGLEN (INCLIST) !length of INCLIST - IF (LINC.EQ.0) GOTO 930 !no INCLIST: ready - LEXC = STR_SIGLEN (EXCLIST) !length of EXCLIST -C -C Get the name of the next defined symbol -C that matches INCLIST but not EXCLIST -C - DO WHILE (SYMBOL_NEXT_C (NR,NAM,LN) .GT. 0) !get next symbol name - IS = STR_MATCH_L (NAM(:LN),INCLIST(:LINC),MATCHNR) - IF (IS.EQ.1) THEN ! matches INCLIST - IF (LEXC.EQ.0) GOTO 930 ! no EXCLIST: break - IS = STR_MATCH_L (NAM(:LN),EXCLIST(:LEXC),MATCHNR) - IF (IS.NE.1) GOTO 930 ! no match: break - ENDIF - ENDDO -C -C Wrap up -C - 930 IF (LN.GT.0) THEN !proper name found: - NAME = NAM(:LN) ! copy it to NAME - IF (LEN(NAME).LT.LN) GOTO 938 ! buffer too short - LNAM = LN ! copy name length - ELSE !otherwise: - NAME = BLANK ! return blank NAME - LNAM = 0 ! return zero length - NR = 0 ! return zero NR - ENDIF - SYMBOL_SEAR = GEN_SUCCESS - RETURN -C - 938 LNAM = LEN(NAME) - CALL WNCTXT(DWLOG,'Name truncated to !SJ characters',LNAM) - SYMBOL_SEAR = MSG_SET (GEN_SYMGETERR,1) - CALL WNCTXT(DWLOG,DWMSG,NAM(:LN)) - RETURN - END diff --git a/src/dwarf/gensymbol.fvx b/src/dwarf/gensymbol.fvx deleted file mode 100644 index 0f5f81e08395a0d21c8cfc56b785465274a3d18c..0000000000000000000000000000000000000000 --- a/src/dwarf/gensymbol.fvx +++ /dev/null @@ -1,357 +0,0 @@ -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ -C.Ident: VGEN_SYMBOL -C.Keywords: Symbols -C.Author: Ger van Diepen (NFRA, Dwingeloo) -C.Language: VAX-Fortran -C.Environment: VAX -C.Comments: -C - There are two types of symbols: global and local ones. They are -C stored in separate tables. -C - Symbol names should start with an alphabetic character, a dollar -C sign or an underscore. Their maximum length is 255 characters. -C Before being used the names are converted to uppercase and trailing -C blanks will be ignored. -C - Symbol values have a maximum length of 255 characters. Blanks -C are significant (including leading and trailing ones). -C -C.Version: 830628 GVD - creation of DWCSETSYM, DWCGETSYM, DWCDELSYM -C.Version: 840426 GVD - value with zero length is replaced by "" (GET) -C.Version: 850830 JPH - symbolic name LIB$_NOSUCHSYM now in $LIBDEF (V4) -C.Version: 860114 JPH - add TYPE argument for SET -C.Version: 890423 FMO - combined into a VGEN source module -C - add TYPE argument for DELETE -C - return status code and add LVAL argument for GET -C - return GEN_SUCCESS for successfull completion -C - put error messages in the buffer, don't write them -C - return standard GEN_ status codes -C.Version: 910808 FMO - added SEARCH and dummy routines INIT and EXIT -C.Version: 910917 GvD - changed table size from 200 to 512 entries -C.Version: 920224 GvD - no optional arguments in MSG anymore -C.Version: 940119 CMV - use WNGLUN i.s.o GEN_LUN -C------------------------------------------------------------------------- -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - LOGICAL FUNCTION SYMBOL_INIT () -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' -C -C.Purpose: Initialize the symbol facility if not yet done -C.Returns: Status code (.TRUE. for success, .FALSE. otherwise) -C.Notes: -C - Dummy routine on the VAX. -C------------------------------------------------------------------------- - SYMBOL_INIT = .TRUE. - RETURN - END -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - INTEGER*4 FUNCTION SYMBOL_DEFINE (NAME,VALUE,TYPE) -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' -C - CHARACTER*(*) NAME ! (i) name - CHARACTER*(*) VALUE ! (i) value - INTEGER*4 TYPE ! (i) type (odd: local, even: global) -C -C.Purpose: Define a new or redefine an old symbol -C.Returns: Status code (.TRUE. for success, .FALSE. otherwise) -C success GEN_SUCCESS -C error GEN_SYMDEFERR any error, message left in buffer -C.Notes: -C------------------------------------------------------------------------- -C - INCLUDE '($LIBCLIDEF)' -C - INTEGER*4 MSG_SET - INTEGER*4 LIB$SET_SYMBOL -C - INTEGER*4 IS, TYPE0 -C -C - IF (TYPE) THEN - TYPE0 = LIB$K_CLI_LOCAL_SYM - ELSE - TYPE0 = LIB$K_CLI_GLOBAL_SYM - ENDIF -C - IS = LIB$SET_SYMBOL (NAME,VALUE,TYPE0) -C - IF (IS) THEN - SYMBOL_DEFINE = GEN_SUCCESS - ELSE - IS = MSG_SET (IS,0) - SYMBOL_DEFINE = MSG_SET (GEN_SYMDEFERR,1) - CALL WNCTXT(DWLOG,DWMSG,NAME) - ENDIF - RETURN - END -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - INTEGER FUNCTION SYMBOL_SEARCH (INCLIST,EXCLIST,NR,NAME,LNAM) -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' -C - CHARACTER*(*) INCLIST !(i) list with symbol names to include - CHARACTER*(*) EXCLIST !(i) list with symbol names to exclude - INTEGER NR !(m) symbol nr - CHARACTER*(*) NAME !(o) symbol name - INTEGER LNAM !(o) length of the name -C -C.Purpose: Find the first or next symbol with a matching name -C.Returns: Status code (.TRUE. for success, .FALSE. otherwise) -C success GEN_SUCCESS also if no matching symbol name does exist -C error GEN_SYMGETERR any error, message left in buffer -C.Notes: -C - INCLIST and EXCLIST are comma-separated lists of symbol names; the -C names may contain wildcards (*), each matching a substring of zero or -C more characters. -C - A matching symbol name is a name that matches at least one INCLIST -C element and does not match any EXCLIST element. Abbreviated matches -C are not recognised. -C - If NR.le.0 on input, the first matching name in the list of defined -C symbols and its number (output NR) will be returned. -C - If NR.gt.0 on input, the next matching name and its number will be -C returned; the search starts at symbol number NR+1. -C - If there is no matching symbol, NR=0, NAME=blank and LNAM=0 will be -C returned. -C - If the NAME buffer is too short, the truncated name, its length and -C an error code will be returned. -C------------------------------------------------------------------------- -C -C - CHARACTER*(*) BLANK, COMMA, WILD - PARAMETER (BLANK = ' ') - PARAMETER (COMMA = ',') - PARAMETER (WILD = '*') - INTEGER TABSIZ, NAMSIZ - PARAMETER (TABSIZ = 512) !max nr of symbols - PARAMETER (NAMSIZ = 64 ) !max length of names -C - INTEGER STR_SIGLEN, STR_SKIP_W, STR_COPY_U, STR_MATCH_L - INTEGER MSG_SET - INTEGER LIB$SPAWN -C - CHARACTER NAM*(NAMSIZ), LINE*300 - INTEGER IS, LUN, LL, PTR, LN, LINC, LEXC, MATCHNR - LOGICAL OK -C - CHARACTER TABLE_N(TABSIZ)*(NAMSIZ) - INTEGER TABLE_LN(TABSIZ), COUNT - LOGICAL FIRST - DATA TABLE_N /TABSIZ*BLANK/ !names - DATA TABLE_LN /TABSIZ*0/ !name-lengths - DATA FIRST /.TRUE./ - SAVE TABLE_N, TABLE_LN, COUNT, FIRST -C -C -C Set up -C - NAME = BLANK !set blank name - LNAM = 0 !set zero length - NAM = BLANK - LN = 0 - LINC = STR_SIGLEN (INCLIST) !length of INCLIST - IF (LINC.EQ.0) GOTO 900 !no INCLIST: ready - LEXC = STR_SIGLEN (EXCLIST) !length of EXCLIST -C -C List names of all global symbols -C - spawn SHOW SYMBOL of all DWARF symbols -C - output to scratch file -C - don't pass logical names (flag=4) -C - extract symbol names and put them -C in a table (with their lengths) -C - IF (FIRST) THEN - CALL WNGLUN(LUN) - IF (LUN.EQ.0) GOTO 999 - IS = LIB$SPAWN ('SHOW SYMBOL/GLOBAL %*$%*_%*',,'SYMBOL.TMP',4) - IF (.NOT.IS) GOTO 991 - OPEN (UNIT=LUN,FILE='SYMBOL.TMP',STATUS='OLD') - COUNT = 0 - DO WHILE (.TRUE.) - READ (LUN,'(Q,A)',END=100) LL,LINE - COUNT = COUNT+1 - IF (COUNT.GT.TABSIZ) THEN - CALL WNCTXT(DWLOG, - 1 'Too many symbols (max !SJ)',TABSIZ) - GOTO 100 - END IF - PTR = 1 - IS = STR_SKIP_W (BLANK,LINE(:LL),PTR) - DO WHILE (LINE(PTR:PTR).NE.BLANK) - IS = STR_COPY_U (BLANK//WILD,LINE(:LL),PTR, - 1 TABLE_N(COUNT),TABLE_LN(COUNT)) - IF (LINE(PTR:PTR).EQ.WILD) PTR = PTR+1 - END DO - END DO - 100 CLOSE (UNIT=LUN,DISPOSE='DELETE') - CALL WNGLUF(LUN) - IF (COUNT.EQ.0) GOTO 900 - FIRST = .FALSE. - END IF -C -C Loop through the symbol table -C until a symbol is found that matches -C INCLIST but not EXCLIST -C - NR = MAX (1,NR+1) - DO NR = NR,COUNT - NAM = TABLE_N(NR) !get symbol name - LN = TABLE_LN(NR) !and its length - IS = STR_MATCH_L (NAM(:LN),INCLIST(:LINC),MATCHNR) - IF (IS.EQ.1) THEN !match with INCLIST - IF (LEXC.EQ.0) GOTO 900 !no EXCLIST: break - IS = STR_MATCH_L (NAM(:LN),EXCLIST(:LEXC),MATCHNR) - IF (IS.NE.1) GOTO 900 !no match: break - END IF - LN = 0 !clear name and go on - END DO -C -C Wrap up -C - 900 IF (LN.GT.0) THEN !proper name found: - NAME = NAM(:LN) ! copy it to NAME - IF (LEN(NAME).LT.LN) GOTO 998 ! buffer too short - LNAM = LN ! copy name length - ELSE !otherwise: - NAME = BLANK ! return blank NAME - LNAM = 0 ! return zero length - NR = 0 ! return zero NR - END IF - SYMBOL_SEARCH = GEN_SUCCESS - RETURN -C - 991 IS = MSG_SET (IS,0) ! SYS$ error - GOTO 999 - 998 LNAM = LEN(NAME) - CALL WNCTXT(DWLOG,'Name truncated to !SJ characters',LNAM) - 999 SYMBOL_SEARCH = MSG_SET (GEN_SYMGETERR,1) - CALL WNCTXT(DWLOG,DWMSG,NAM(:LN)) - RETURN - END -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - INTEGER*4 FUNCTION SYMBOL_GET (NAME,VALUE,LVAL) -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' -C - CHARACTER*(*) NAME ! (i) name - CHARACTER*(*) VALUE ! (o) value - INTEGER*4 LVAL ! (o) length of the value -C -C.Purpose: Get the value of a symbol -C.Returns: Status code (.TRUE. for success, .FALSE. otherwise) -C success GEN_SUCCESS also if the symbol doesn't exist -C error GEN_SYMGETERR any error, message left in buffer -C.Notes: -C - First the local symbol table is searched, then the global table. -C - If the symbol doesn't exist or an error occured, a blank value -C (length = 0) will be returned. -C - If the value has a zero length: return '""' as value, length = 2. -C - If VALUE is too short to contain the symbol value, the truncated -C value and an error code will be returned. -C------------------------------------------------------------------------- -C - INCLUDE '($LIBDEF)' -C - CHARACTER*(*) BLANK, NULL - PARAMETER (BLANK = ' ') - PARAMETER (NULL = '""') -C - INTEGER*4 MSG_SET - INTEGER*4 LIB$GET_SYMBOL -C - CHARACTER*255 VALUE0 - INTEGER*2 VALLEN, NTRUNC - INTEGER*4 IS -C -C - VALUE = BLANK - LVAL = 0 -C - IS = LIB$GET_SYMBOL (NAME,VALUE0,VALLEN) -C - IF (IS.EQ.LIB$_NOSUCHSYM) THEN ! symbol not found - IS = 1 - ELSE IF (.NOT.IS) THEN ! other LIB$ error - IS = MSG_SET (IS,0) - ELSE IF (VALLEN.GT.LEN(VALUE)) THEN ! string overflow - LVAL = LEN(VALUE) - VALUE = VALUE0(:LVAL) - NTRUNC = VALLEN-LVAL - IS = MSG_SET (GEN_STROVFLO,1) - CALL WNCTXT(DWLOG,DWMSG,NTRUNC) - ELSE IF (VALLEN.EQ.0) THEN ! null value - LVAL = 2 - VALUE = NULL - ELSE ! normal value - LVAL = VALLEN - VALUE = VALUE0(:LVAL) - ENDIF -C - IF (IS) THEN - SYMBOL_GET = GEN_SUCCESS - ELSE - SYMBOL_GET = MSG_SET (GEN_SYMGETERR,1) - CALL WNCTXT(DWLOG,DWMSG,NAME) - ENDIF - RETURN - END -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - INTEGER*4 FUNCTION SYMBOL_DELETE (NAME,TYPE) -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' -C - CHARACTER*(*) NAME ! (i) symbol name - INTEGER*4 TYPE ! (i) type (odd: local, even: global) -C -C.Purpose: Delete a local or global symbol -C.Returns: Status code (.TRUE. for success, .FALSE. otherwise) -C success GEN_SUCCESS also if the symbol doesn't exist -C error GEN_SYMDELERR any error, message left in buffer -C.Notes: -C------------------------------------------------------------------------- -C - INCLUDE '($LIBCLIDEF)' - INCLUDE '($LIBDEF)' -C - INTEGER*4 MSG_SET - INTEGER*4 LIB$DELETE_SYMBOL -C - INTEGER*4 IS, TYPE0 -C -C - IF (TYPE) THEN - TYPE0 = LIB$K_CLI_LOCAL_SYM - ELSE - TYPE0 = LIB$K_CLI_GLOBAL_SYM - ENDIF -C - IS = LIB$DELETE_SYMBOL (NAME,TYPE0) -C - IF (IS .OR. IS.EQ.LIB$_NOSUCHSYM) THEN - SYMBOL_DELETE = GEN_SUCCESS - ELSE - IS = MSG_SET (IS,0) - SYMBOL_DELETE = MSG_SET (GEN_SYMDELERR,1) - CALL WNCTXT(DWLOG,DWMSG,NAME) - ENDIF - RETURN - END -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - INTEGER*4 FUNCTION SYMBOL_EXIT () -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' -C -C.Purpose: Close the symbol facility -C.Returns: Status code (.TRUE. for success, .FALSE. otherwise) -C success GEN_SUCCESS always -C.Notes: -C - Dummy routine on the VAX. -C------------------------------------------------------------------------- -C - SYMBOL_EXIT = GEN_SUCCESS - RETURN - END diff --git a/src/dwarf/gensymbolc.cun b/src/dwarf/gensymbolc.cun deleted file mode 100644 index 87f41d91dc084053a887cf4e137f2a67957e6ce4..0000000000000000000000000000000000000000 --- a/src/dwarf/gensymbolc.cun +++ /dev/null @@ -1,415 +0,0 @@ -/*+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ -/*.Ident: GENUN_SYMBOLC -/*.Keywords: Symbols -/*.Author: Friso Olnon (NFRA, Dwingeloo) -/*.Language: C -/*.Environment: UNIX -/*.Comments: -/* - Symbols tie a value to a name. -/* - Symbol names are extended-alphanumeric strings (uppercase letters, -/* digits, dollar sign and underscore) of up to 64 characters. The first -/* character cannot be a digit. When a symbol name is entered with -/* lowercase letters, these will be converted to uppercase; trailing -/* blanks will be ignored. -/* - Symbol values may contain up to 255 ASCII characters. All blanks are -/* significant including leading and trailing ones. Symbols can have -/* null values, which are given as '""'. -/* - On the Alliant, all symbols are global and their definitions are kept -/* in the file defined under the environment variable DWARF_SYMBOLS. -/* The file will automatically be created when necessary. -/* - Each program works with its own copy of the symbol file. Only at -/* program termination, the master file will be updated. -/* -/*.Version: 900418 FMO - creation -/*.Version: 900502 FMO - new GEN_LUN module -/*.Version: 910808 FMO - rewritten, added SYMBOL_SEARCH and SYMBOL_EXIT -/*.Version: 910830 FMO - allow for symbol file defined under environment -/* variable DWARF_SYMBOLS -/*.Version: 911106 GvD - rewritten in mainly C to make it faster -/*.Version: 940329 CMV - if symbol not found, try getenv() -/*---------------------------------------------------------------------------*/ -#include <stdio.h> - -char *getenv(); /* define standard function */ - -#define NAMSIZ 65 /* maximum length of symbol name (incl. \0) */ -#define VALSIZ 256 /* maximum length of symbol value (incl. \0) */ -#define INCSIZ 128 /* increment when extending symbol table SYMN */ - -/* -Define the structures describing the symbol names and values -*/ -typedef struct symv { - char *valp; /* pointer to value */ - int lenv; /* length of value */ - int typ; /* 0=old, 1=new, 2=del */ -} symv; -typedef struct symn { - char *namp; /* pointer to name */ - symv *symvp; /* pointer to value block */ -} symn; -/* -Define global variables -*/ -int allsz = 0; /* nr of entries allocated in memory */ -int usedsz = 0; /* nr of entries used */ -symn *addr = 0; /* pointer to SYMN array in dynamic memory */ -int updsw = 0; /* 0 = nothing written 1 = symbols written */ -/*+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++*/ -int symbol_init_c_ () /* 1=success, else=error */ -{ - int status,lnam,lval; - FILE *fptr; - char *np; - char nam[NAMSIZ],val[VALSIZ]; - - if ((np = getenv ("DWARF_SYMBOLS")) == 0) - return 2; - if ((fptr = fopen (np, "r")) == 0) - return 0; - - while (symbol_file_read (fptr,&lnam,nam,&lval,val) == 1) { - symbol_ins (lnam,nam,lval,val,0,0,usedsz); - } - fclose (fptr); - return 1; -} -/*+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++*/ -int symbol_exit_c_ () /* 1=success, else=error */ -{ - FILE *fpi,*fpo; /* input and output file pointer */ - int i,swrd,len,is; - char *npi,*npo; /* input and output file name */ - char nam[NAMSIZ],val[VALSIZ]; /* file symbol names and values */ - int lnam,lval; /* length of file symbols */ - symn symnbl; /* table symbol name area */ - symv symvbl; /* table symbol value area */ - static char heof[] = {127,0}; /* very high EOF value */ - -/* -Update the file containing the symbols. -We can exit immediately if no updates have been done. -Otherwise open the input file and an output file. -Give the output file a temporary name derived from the input name DWARF_SYMBOLS -by appending .tmp to it. -*/ - if (!updsw) { - usedsz = 0; - return 1; - } - if ((npi = getenv ("DWARF_SYMBOLS")) == 0) - return 2; - len = strlen(npi); - npo = (char*) malloc (len+5); - memcpy (npo,npi,len); - strcpy (npo+len,".tmp"); - if ((fpi = fopen (npi, "r")) == 0) - return 0; - if ((fpo = fopen (npo, "w")) == 0) - return 0; -/* -Loop through all symbols in the table and the file. -Update the file symbols if changed in the table (new value or deleted). -Insert the high EOF value at the end (is handy to test). -*/ - i = 0; - swrd = 1; - while (1) { - if (swrd) { /* read if needed */ - if (symbol_file_read (fpi,&lnam,nam,&lval,val) != 1) - strcpy (nam,heof); /* end-of-file */ - } - swrd = 1; /* reset to read file */ - if (i < usedsz) { - memcpy (&symnbl,addr+i ,sizeof(symn)); - memcpy (&symvbl,symnbl.symvp,sizeof(symv)); - } else { - symnbl.namp = heof; /* end-of-table */ - symvbl.typ = 0; - } - is = strcmp (nam,symnbl.namp); - if (is<0) { -/* -File symbol not in table, thus write the file symbol -*/ - symbol_file_write (fpo,lnam,nam,lval,val); - } else { -/* -Write the table symbol if its value is new -*/ - if (symvbl.typ == 1) - symbol_file_write (fpo, strlen(symnbl.namp), symnbl.namp, - symvbl.lenv, symvbl.valp); -/* -If the table symbol is not in file, do not read file -Otherwise exit if EOF or write the symbol if table symbol is old -Increment the table index -*/ - if (is>0) { - swrd = 0; - } else { - if (strcmp (nam,heof) == 0) - break; /* end-of-all */ - if (symvbl.typ == 0) - symbol_file_write (fpo,lnam,nam,lval,val); - } - i++; - } - } -/* -All symbols have been handled -Close the files and rename the output file to the correct name -Clear the table size and update switch -*/ - fclose (fpi); - fclose (fpo); - rename (npo,npi); - updsw = 0; - usedsz = 0; - return 1; -} -/*+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++*/ -int symbol_add_c_ (lnam,nam,lval,val,type) /* 1=success, else=error */ -int *lnam; /* (i) length of symbol name */ -char nam[]; /* (i) symbol name */ -int *lval; /* (i) length of symbol value */ -char val[]; /* (i) symbol value */ -int *type; /* (i) 0=old, 1=new, 2=delete */ -{ - int is,sw,inx; -/* -Try to find the new name in the table by doing a binary search for it. -Then insert the symbol in the table. -Set update switch to something has been done. -*/ - sw = symbol_find (nam,&inx); - is = symbol_ins (*lnam,nam,*lval,val,*type,sw,inx); - updsw = 1; - return is; -} -/*+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++*/ -int symbol_next_c_ (nr,nam,lnam) /* 1=success, else=error */ -int *nr; /* (m) index of next symbol */ -char nam[]; /* (o) symbol name */ -int *lnam; /* (o) length of symbol value */ -{ - int is, inx; -/* -Set index to 0 if <0 -Return the next symbol name (skip deleted symbols) -Return status 0 if no more symbols -*/ - inx = *nr; - if (inx<0) - inx = 0; - nam[0] = '\0'; - is = 0; /* no symbol returned yet */ - while (!is) { - if (inx >= usedsz) { - inx = 0; /* no more symbols */ - break; - } else { - if ((addr+inx)->symvp->typ != 2) { - strcpy (nam, (addr+inx)->namp); /* non-deleted symbol */ - is = 1; - } - } - inx++; - } - - *lnam = strlen(nam); - *nr = inx; - return is; -} - - -/*+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++*/ -int symbol_file_read (fp,lnam,nam,lval,val) /* 1=success, else=error */ -FILE *fp; /* (i) pointer to symbol file */ -int *lnam; /* (o) length of symbol name */ -char nam[]; /* (o) symbol name */ -int *lval; /* (o) length of symbol value */ -char val[]; /* (o) symbol value */ -{ - int nr; -/* -Read namelength, name, value length and value -Stop if any read failed or if length are too big -*/ - nr = 0; - if (fread (lnam,sizeof(int),1,fp) != 0) { /* name length */ - if (*lnam > 0 && *lnam <= NAMSIZ) { - if (fread (nam,*lnam,1,fp) != 0) { /* symbol name */ - if (fread (lval,sizeof(int),1,fp) != 0) { /* value length */ - if (*lval > 0 && *lval <= VALSIZ) { - nr = fread (val,*lval,1,fp); /* symbol value */ - } - } - } - } - } - if (nr == 0) { - *lnam = 0; - *lval = 0; - } - nam[*lnam] = '\0'; - val[*lval] = '\0'; - - if (nr!=0) - nr = 1; - return nr; -} -/*+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++*/ -int symbol_file_write (fp,lnam,nam,lval,val) /* 1=success, else=error */ -FILE *fp; /* (i) pointer to symbol file */ -int lnam; /* (i) length of symbol name */ -char nam[]; /* (i) symbol name */ -int lval; /* (i) length of symbol value */ -char val[]; /* (i) symbol value */ -{ -/* -Write namelength, name, value length and value -*/ - fwrite (&lnam,sizeof(int),1,fp); - fwrite (nam,lnam,1,fp); - fwrite (&lval,sizeof(int),1,fp); - fwrite (val,lval,1,fp); - return 1; -} -/*+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++*/ -int symbol_ins (lnam,nam,lval,val,type,sw,inx) /* 1=success, else=error */ -int lnam; /* (i) length of symbol name */ -char nam[]; /* (i) symbol name */ -int lval; /* (i) length of symbol value */ -char val[]; /* (i) symbol value */ -int type; /* (i) 0=insert, 1=delete */ -int sw; /* (i) 0=new symbol, 1=existing */ -int inx; /* (i) index where to insert */ -{ - int newsz; - char *vp; - symn *newa, *enda; - symn symnbl; - symv symvbl; -/* -If the symbol is new get the symbol blocks, otherwise initialize them. -Extend the pointer table if not found. -(Re)allocate the pointer table if too small -Exit if allocation failed -Else update address and allocated size -*/ - if (sw) { - newa = addr+inx; - memcpy (&symnbl, newa, sizeof(symn)); - memcpy (&symvbl, symnbl.symvp, sizeof(symv)); - } else { - symnbl.symvp = 0; - symnbl.namp = 0; - symvbl.valp = 0; - if (usedsz >= allsz) { - newsz = (allsz+INCSIZ) * sizeof(symn); - if (allsz == 0) - newa = (symn *)malloc (newsz); - else - newa = (symn *)realloc(addr, newsz); - if (newa == 0) - return 1; - allsz = allsz+INCSIZ; - addr = newa; - } -/* -Shift the table to make room for the new pointer. -Increase the nr of used entries. -*/ - newa = addr+inx; - for (enda=addr+usedsz; enda>newa; enda--) { - *enda = *(enda-1); - } - usedsz++; - } -/* -Store the symbol value in memory. -Fill in length and type and store the value structure in memory. -Store name in memory if not done yet. -Finally fill and store the name structure in memory. -*/ - if (symvbl.valp == 0) - vp = (char *)malloc (lval); - else - vp = (char *)realloc (symvbl.valp, lval); - if (lval > 0) - memcpy (vp,val,lval); /* Put value in memory */ - symvbl.valp = vp; - symvbl.lenv = lval; - symvbl.typ = type; - if (symnbl.symvp == 0) - symnbl.symvp = (symv *)malloc (sizeof(symv)); - memcpy (symnbl.symvp, &symvbl, sizeof(symv)); - if (symnbl.namp == 0) { - symnbl.namp = (char *)malloc (lnam+1); - memcpy (symnbl.namp, nam, lnam+1); /* Put name (and 0) in memory */ - } - memcpy (newa, &symnbl, sizeof(symn)); - return 1; -} -/*+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++*/ -int symbol_find (nam,inx) /* 1=found, else=not found */ -char nam[]; /* (i) symbol name */ -int *inx; /* (o) index where found or to insert */ -{ - int i,is,st,end; -/* -Do a binary search in the table. -If not found, return the element where to insert as index -*/ - st = 0; - end = usedsz+1; - while (1) { - i = (st+end) / 2; - if (i == st) { - is = 1; /* not found */ - break; - } else { - is = strcmp (nam, (addr+i-1)->namp); - if (is==0) { - i--; /* found */ - break; - } - if (is < 0) - end = i; /* take lower part */ - else - st = i; /* take upper part */ - } - } - *inx = i; - return 1-is; -} -/*+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++*/ -int symbol_get_c_ (nam,lval,val) /* 1=success, else=error */ -char nam[]; /* (i) symbol name */ -int *lval; /* (o) length of symbol value */ -char val[]; /* (o) symbol value */ -{ - int inx; -/* -Try to find the symbol -If found and not deleted return its value and length -Otherwise try to get an environment variable with the same name. -If found, return it, else return zero length and false status -*/ - if (symbol_find (nam,&inx) && (addr+inx)->symvp->typ != 2) { - *lval = (addr+inx)->symvp->lenv; - memcpy (val, (addr+inx)->symvp->valp, *lval); - return 1; - } else if (getenv(nam)!=NULL) { - *lval = strlen(getenv(nam)); - memcpy (val, getenv(nam), *lval); - return 1; - } else { - *lval = 0; - return 0; - } -} - - - diff --git a/src/dwarf/gensystem.cun b/src/dwarf/gensystem.cun deleted file mode 100644 index 82416fec4cda408b7c421ef9ac5a80c5c600db92..0000000000000000000000000000000000000000 --- a/src/dwarf/gensystem.cun +++ /dev/null @@ -1,22 +0,0 @@ -/*+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++*/ -/*.Ident: GENUN_SYSTEM -/*.Keywords: Spawn subprocess -/*.Author: Ger van Diepen (NFRA, Dwingeloo) -/*.Language: C -/*.Environment: UNIX -/*.Comments: -/*.Version: 920528 GvD - creation -/*-----------------------------------------------------------------------*/ -/*+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++*/ - -gen_system_ (comm) - char *comm; /* (i) command to be executed */ -{ - -/*.Purpose: Execute command in a subprocess -/*.Returns: Exit status of command -/*.Notes: -/*-----------------------------------------------------------------------*/ - - return system(comm); -} diff --git a/src/dwarf/gensystem.fvx b/src/dwarf/gensystem.fvx deleted file mode 100644 index c8d344514f4f8702a408196d020db77bafd00110..0000000000000000000000000000000000000000 --- a/src/dwarf/gensystem.fvx +++ /dev/null @@ -1,59 +0,0 @@ -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ -C.Ident: VGEN_SYSTEM -C.Keywords: Spawn subprocess -C.Author: Ger van Diepen (NFRA, Dwingeloo) -C.Language: Fortran -C.Environment: VAX -C.Comments: -C.Version: 920701 GvD - creation -C------------------------------------------------------------------------- -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - INTEGER*4 FUNCTION GEN_SYSTEM (COMM) -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' -C - CHARACTER*(*) COMM ! (i) command to be executed -C -C.Purpose: Execute command in a subprocess -C.Returns: Status from LIB$SPAWN -C.Notes: -C------------------------------------------------------------------------- -C - INTEGER IS,ST,LENG - CHARACTER*128 STR -C - INTEGER STR_UPCASE - INTEGER LIB$SPAWN -C -C -C Execute the command which may be in UNIX format. -C Remove possible 0 indicating the end of the string. -C If it starts with a $ it is in UNIX-format. -C Then we skip until the first / and remove the .exe -C part. -C First convert to uppercase to make it easy. -C Execute command in original case. -C - LENG = INDEX(COMM,CHAR(0)) - IF (LENG.EQ.0) THEN - LENG = LEN(COMM) - ELSE - LENG = LENG-1 - ENDIF - STR = COMM(:LENG) - IS = STR_UPCASE(STR) - ST = 0 - I = 0 - IF (STR(1:1) .EQ. '$') THEN - ST = INDEX(STR,'/') - IF (ST.NE.0) THEN - I = INDEX(STR,'.EXE') - ENDIF - ENDIF - STR = COMM(:LENG) - IF (I.NE.0) STR(I:I+3) = ' ' -C - GEN_SYSTEM = LIB$SPAWN (STR(ST+1:LENG)) - RETURN - END diff --git a/src/dwarf/gentermsw.fun b/src/dwarf/gentermsw.fun deleted file mode 100644 index e447840cc2be1199b885475fd043f15f647f1577..0000000000000000000000000000000000000000 --- a/src/dwarf/gentermsw.fun +++ /dev/null @@ -1,56 +0,0 @@ -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ -C.Ident: GENUN_TERMSW -C.Keywords: Device, Inquire -C.Author: Friso Olnon (NFRA, Dwingeloo) -C.Language: DWARF-Fortran -C.Environment: UNIX -C.Comments: -C.Version: 900227 FMO - creation -C.Version: 920528 GvD - use GEN_ISATERM iso. ISATTY to isolate system-dep. -C------------------------------------------------------------------------- -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - INTEGER*4 FUNCTION GEN_TERMSW (DEVICE) -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' -C - CHARACTER*(*) DEVICE ! (i) device name -C -C.Purpose: Determine whether the device is the terminal -C.Returns: Status code (.TRUE. for success, .FALSE. otherwise) -C success 1 is terminal -C warning 0 is not a terminal -C.Notes: -C - If SYS$INPUT or SYS$COMMAND, check whether logical unit 5 (the -C standard input device) is a terminal. -C - If SYS$OUTPUT, check whether logical unit 6 (the standard output -C device) is a terminal. -C - In all other cases, return 0. -C------------------------------------------------------------------------- -C - INTEGER STR_UPCASE - LOGICAL GEN_ISATERM -C - CHARACTER*11 UPCDEV - INTEGER IS -C -C - UPCDEV = DEVICE - IS = STR_UPCASE (UPCDEV) - IF (UPCDEV.EQ.'SYS$INPUT' .OR. UPCDEV.EQ.'SYS$COMMAND') THEN - IF (GEN_ISATERM(5)) THEN - GEN_TERMSW = 1 - ELSE - GEN_TERMSW = 0 - END IF - ELSE IF (DEVICE.EQ.'SYS$OUTPUT') THEN - IF (GEN_ISATERM(6)) THEN - GEN_TERMSW = 1 - ELSE - GEN_TERMSW = 0 - END IF - ELSE - GEN_TERMSW = 0 - END IF - RETURN - END diff --git a/src/dwarf/gentermsw.fvx b/src/dwarf/gentermsw.fvx deleted file mode 100644 index db414bb77698365eaa9f3ac3b3bc54f7cf8a74d4..0000000000000000000000000000000000000000 --- a/src/dwarf/gentermsw.fvx +++ /dev/null @@ -1,53 +0,0 @@ -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ -C.Ident: VGEN_TERMSW -C.Keywords: Device, Inquire -C.Author: Friso Olnon (NFRA, Dwingeloo) -C.Language: VAX-Fortran -C.Environment: VAX -C.Comments: -C.Version: 900226 FMO - creation -C.Version: 920224 GvD - no optional arguments in MSG anymore -C------------------------------------------------------------------------- -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - INTEGER*4 FUNCTION GEN_TERMSW (DEVICE) -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' -C - CHARACTER*(*) DEVICE ! (i) device name -C -C.Purpose: Determine whether the device is the terminal -C.Returns: Status code (.TRUE. for success, .FALSE. otherwise) -C success 1 is terminal -C warning 0 is not a terminal -C false status code returned by referenced routine -C.Notes: -C------------------------------------------------------------------------- -C - INCLUDE '($DVIDEF)' - INCLUDE '($DCDEF)' -C - INTEGER*4 STR_SIGLEN, MSG_SET , SYS$GETDVI -C - INTEGER*4 ITEMLST4(4), IS, CLASS, LD - INTEGER*2 ITEMLST2(2) - EQUIVALENCE (ITEMLST4,ITEMLST2) -C -C - ITEMLST2(1) = 4 ! buffer length - ITEMLST2(2) = DVI$_DEVCLASS ! item code - ITEMLST4(2) = %LOC(CLASS) ! buffer address - ITEMLST4(3) = 0 - ITEMLST4(4) = 0 -C - LD = STR_SIGLEN (DEVICE) - IS = SYS$GETDVI (,,DEVICE(:LD),ITEMLST4,,,,) - IF (.NOT.IS) THEN - GEN_TERMSW = MSG_SET (IS,0) - ELSE IF (CLASS.EQ.DC$_TERM) THEN - GEN_TERMSW = 1 - ELSE - GEN_TERMSW = 0 - ENDIF - RETURN - END diff --git a/src/dwarf/getparm.for b/src/dwarf/getparm.for deleted file mode 100644 index 071a4ee74e98cb03d025eddbcbc31b77b09c5baa..0000000000000000000000000000000000000000 --- a/src/dwarf/getparm.for +++ /dev/null @@ -1,391 +0,0 @@ -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ -C.Ident: GET_PARM -C.Keywords: Program Parameters, Get Value -C.Author: Friso Olnon (NFRA, Dwingeloo) -C.Language: DWARF-Fortran -C.Environment: VAX or Alliant -C.Comments: -C.Version: 900322 FMO - creation -C.Version: 911213 GvD - do not return UNDEF_J in NR, otherwise -C GP_ARG_CHECK treats NELEM next time as not given. -C.Version: 920305 GvD - split into GETPARM.FOR and GENGETPAR.FOR -C (system dependencies in GENGETPAR.FOR) -C.Version: 920429 GvD - changed order of GP_ARG_CHECK arguments because -C %REF is still passed as a string on the SUN. -C.Version: 920513 GvD - test NR=UNDEF_J at the end -C------------------------------------------------------------------------- -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ -C GET_PARM (KEYWORD,ARRAY,NBYT,NR,DEFSTR,DEFARR,NRDEF,FLAGS,STROUT) -C -C Required arguments: -C -C CHARACTER*(*) KEYWORD ! (i) program's parameter name -C <datatype> ARRAY(*) ! (o) data array -C It must be passed in the standard Fortran way. -C The array must be declared according to the -C data type defined in the PIN file. The elements -C in a character-type array must at least have -C the length given in the PIN file. -C INTEGER*4 NBYT ! (i) total length of array in bytes -C The function will calculate the nr of elements -C in the array by dividing the element length -C (determined by the data type or the length of -C character-type elements) into this total -C array length. If the array is too small to -C receive all data, an error condition will be -C returned. -C -C Optional arguments: -C -C INTEGER*4 NR ! (o) nr of filled elements in array -C The argument must be present if there can be -C more than one element (NVAL>1 in PPD file) or -C if wildcards or null values are possible -C (SWITCHES=WILD or SWITCHES=NULL). -C The following special values can be returned: -C -2 if end-of-loop or CNTRL/Z given -C -1 if a wildcard value was given (value=*), -C 0 if a null value was given (value=""). -C Undefined values between defined values are -C also counted. E.g. (for TYPE=I) 1,,2 -C results in ARRAY=1,UNDEF_I,2 and NR=3. -C CHARACTER*(*) DEFSTR ! (i) default value (given as a string) -C The string will be evaluated as if it was -C entered in answer to a DWARF prompt. -C <datatype> DEFARR(*) ! (i) default value (given as an array) -C Must be declared in the same way as ARRAY. -C The array will be converted to a prompt string. -C INTEGER*4 NRDEF ! (i) nr of elements in DEFARR -C Ignored when no DEFARR argument is present. -C 1 (default) -C 0: default value is "" (null value) -C -1: default value is * (wildcard) -C INTEGER*4 FLAGS ! (i) control flags -C The flags are defined in the module FLAGS_1 -C (use statement INCLUDE '(FLAGS_1)' in FORTRAN). -C PARM__OVERRIDE = the default you give via -C DEFSTR or DEFARR must override the -C current value of the keyword. -C GET_PARM will prompt the user to show -C that the default is taken. -C PARM__TOBY = the default in DEFARR is given -C in TO/BY-format. That is: the data is -C ordered in the way FROM-TO-STEPSIZE -C (NRDEF then must be a multiple of 3) -C CHARACTER*(*) STROUT ! (o) last value set -C (as interpreted by GET_PARM). -C -C.Purpose: Get a value set for a program parameter -C.Returns: Status code (.TRUE. for success, .FALSE. otherwise) -C success DWC_SUCCESS -C success DWC_WILDCARD wildcard value (NR = -1 on return) -C success DWC_NULLVALUE null value (NR = 0 on return) -C warning DWC_ENDOFLOOP end of loop or CNTRL/Z -C warning DWC_STRTOOSHO string overflow during value conversion -C error DWC_PARWRANS wrong answer (in batch mode) -C fatal DWC_PARNOTFND invalid keyword -C fatal DWC_PARTOOSML ARRAY doen't contain enough elements -C fatal DWC_PARELTSML string elements in ARRAY are too short -C fatal DWC_PARNONR NR argument is required but not present -C fatal DWC_PARNOVAL no value found -C fatal DWC_PARWRDEF wrong default value given -C fatal DWC_GETINPERR error getting input -C fatal DWC_SAVEOVFLO save-string overflow -C.Notes: -C - This function passes a complete argument list to the action routines -C GET_PARM_N (numerical data) or GET_PARM_C (character data). -C -C If no more parameter values are available, 3 things can happen: -C - If GET_PARM must ask on the terminal, it will do so and it will take -C the first value set from the new data. If the user answers with -C CTRL/Z, the status DWC_ENDOFLOOP will be returned. -C - If GET_PARM must not ask and the parameter is of the LOOP-type -C (ATTRIBUTE=LOOP in the PIN file), the routine will return the status -C DWC_ENDOFLOOP. At the next call GET_PARM will start re-using the -C current value sets. -C - If GET_PARM must not ask and the parameter is of the non-LOOP type, -C the routine will start re-using the current value sets without -C warning. -C -C GET_PARM will ask if: -C - the ASK switch is on (either set by the PIN file or by the user, -C where the PIN file overrides the user) -C - a PIN default or a caller default is taken as the value, unless -C /NOASK is given for this keyword. A PIN or caller default will be -C taken if no value has been given via SPECIFY. A caller default will -C always be taken if the caller gives the flag PARM__OVERRIDE. -C -C - The format of the prompt strings issued by GET_PARM will depend on -C the current userlevel. -C - If there is a default (given via SPECIFY, in the PIN file or in the -C argument list of GET_PARM), it will always be part of the prompt -C string. GET_PARM will not show the complete default, but only the -C next value set from the default. -C - When the value sets in the default are exhausted, GET_PARM will -C either look for a new default from the caller or re-use the same -C default. -C -C The user can give several types of answers: -C - A value string, which then will be the new value. -C - A wildcard (*) provided that the WILD option is set in the PIN file. -C GET_PARM then will return with the success status DWC_WILDCARD and -C with NR = -1. -C - A "null" value ("") provided that the NULL option is set in the PIN -C file. GET_PARM then will return with the success status DWC_NULLVALUE -C and with NR = 0. -C - An empty answer (just a <RETURN>), in which case the default will be -C the new value. -C - One of the previous answers appended with qualifiers: -C /NOASK tells GET_PARM to stop asking values for this keyword. -C GET_PARM will start asking again once the user has answered -C /ASK=keyword to a prompt for any other program parameter. -C /(NO)SAVELAST will override the SAVE switch set via SPECIFY DWARF -C or EXECUTE/SAVE. When SAVE is set, the values (typed-in or -C default) will be saved in a DWARF symbol (as in SPECIFY). -C - A question mark (?) tells GET_PARM to show help information and to -C repeat the prompt. -C - /ASK=keyword tells GET_PARM to prompt when a value is needed for -C the specified program parameter. This qualifier cannot be appended -C to a any other type of answer. -C - CTRL/Z or # will return the status DWC_ENDOFLOOP to the caller. -C Note that this status can also be returned for LOOP-type parameters. -C -C - If the value for a node name parameter ends with a colon, the current -C node will be set to the value (without colon). This setting only -C holds for the current program run; the current node set via SPECIFY -C DWARF is not changed. -C------------------------------------------------------------------------- -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - INTEGER*4 FUNCTION GET_PARM_N (KEYWORD,ARRAY,NBYT, - 1 NR,DEFSTR,DEFARR,NRDEF,FLAGS,STROUT) -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' -C - CHARACTER*(*) KEYWORD ! (i) program's parameter name - BYTE ARRAY(*) ! (o) data array - INTEGER*4 NBYT ! (i) total length of array in bytes - INTEGER*4 NR ! (o) nr of filled elements in array - CHARACTER*(*) DEFSTR ! (i) default value (given as a string) - BYTE DEFARR(*) ! (i) default value (given as an array) - INTEGER*4 NRDEF ! (i) nr of elements in DEFARR - INTEGER*4 FLAGS ! (i) flags to control GET_PARM - CHARACTER*(*) STROUT ! (o) last value set -C -C.Purpose: Get the next value set for a numerical program parameter -C.Returns: Status code (.TRUE. for success, .FALSE. otherwise) -C see GET_PARM, but extra: -C warning 0 data type is CHARACTER -C.Notes: -C - This function is called by GET_PARM for any program parameter. -C - It sets up the GET_PARM environment for the parameter. -C - For numerical-type parameters, it does all the necessary things. -C - For character-type parameters, the routine returns to GET_PARM -C with status 0. GET_PARM then calls GET_PARM_C to do the work. -C------------------------------------------------------------------------- -C -C - CHARACTER*(*) BLANK, EOLVAL, EOLMSG - PARAMETER (BLANK = ' ') - PARAMETER (EOLVAL = '#') - PARAMETER (EOLMSG = '# ! = end-of-loop') -C - INTEGER*4 GP_CTL_OPEN, GP_CTL_CLOSE - INTEGER*4 GP_ARG_CHECK - INTEGER*4 GP_VAL_READ_N, GP_VAL_FILL - INTEGER*4 GP_SAV_WRITE - INTEGER*4 PPD_DTYPE_GET - INTEGER*4 MSG_SET -C - CHARACTER VALUE*255, DEFAULT*255, LOGMSG*255, DTYPE*1 - INTEGER*4 IS, LV, LDEF, PLEN, FOUND -C -C -C Start GET_PARM operations -C - check the parameter name -C - load its PPD description in common -C - load value administration in common -C - STROUT = BLANK - IS = GP_CTL_OPEN (KEYWORD) - IF (IAND(IS,1).EQ.0) GOTO 999 -C -C Get data type and length -C - get out for character type -C - IS = PPD_DTYPE_GET (DTYPE,PLEN) - IF (IAND(IS,1).EQ.0) GOTO 999 - IF (DTYPE.EQ.'C') THEN - GET_PARM_N = 0 - RETURN - ENDIF -C -C Analyse the arguments -C - IS = GP_ARG_CHECK (PLEN,NBYT,NR,DEFAULT,LDEF, - 1 DEFSTR,DEFARR,NRDEF,PLEN,FLAGS) - IF (IAND(IS,1).EQ.0) GOTO 999 -C -C Get the next value set or end-of-loop -C - if the value block is exhausted, -C get new value sets (or end-of-loop) -C and loop back -C - FOUND = GP_VAL_READ_N (ARRAY,NR,VALUE,LV) - DO WHILE (IAND(FOUND,1).EQ.0 .AND. FOUND.NE.DWC_ENDOFLOOP) - IS = GP_VAL_FILL (DEFAULT,LDEF,FLAGS) - IF (IAND(IS,1).NE.0) THEN - FOUND = GP_VAL_READ_N (ARRAY,NR,VALUE,LV) - ELSE - IF (IS.NE.DWC_ENDOFLOOP) GOTO 999 - FOUND = DWC_ENDOFLOOP - ENDIF - ENDDO - GET_PARM_N = FOUND -C -C Build save string and log message -C - IF (IAND(FOUND,1).NE.0) THEN - LOGMSG = VALUE(:LV) - ELSE - VALUE = EOLVAL - LV = 1 - LOGMSG = EOLMSG - ENDIF - STROUT = VALUE(:LV) -C -C Close GET_PARM operations -C - write log message at level 3, -C - possibly save the value string -C - save the value administration -C - return -C Do not return UNDEF_J in NR, otherwise -C GP_ARG_CHECK treats NELEM next time -C as not given. -C -C CALL WNCTXT (DWLOG,DWMSG,'!AS = !AS',KEYWORD,LOGMSG) - IS = GP_SAV_WRITE (VALUE,LV) - IF (IAND(IS,1).EQ.0) GET_PARM_N = IS -C -C - IS = GP_CTL_CLOSE () - IF (IAND(IS,1).EQ.0) GOTO 999 - IF (NR.EQ.UNDEF_J) NR = UNDEF_J+1 - RETURN -C - 999 GET_PARM_N = IS - IS = MSG_SET (DWC_PARAMERR,1) - CALL WNCTXT(DWLOG,DWMSG,KEYWORD) - IF (NR.EQ.UNDEF_J) NR = UNDEF_J+1 - RETURN - END -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - INTEGER*4 FUNCTION GET_PARM_C (KEYWORD,ARRAY,NBYT, - 1 NR,DEFSTR,DEFARR,NRDEF,FLAGS,STROUT) -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' -C - CHARACTER*(*) KEYWORD ! (i) program's parameter name - CHARACTER*(*) ARRAY(*) ! (o) data array - INTEGER*4 NBYT ! (i) total length of array in bytes - INTEGER*4 NR ! (o) nr of filled elements in array - CHARACTER*(*) DEFSTR ! (i) default value (given as a string) - CHARACTER*(*) DEFARR(1) ! (i) default value (given as an array) - INTEGER*4 NRDEF ! (i) nr of elements in DEFARR - INTEGER*4 FLAGS ! (i) flags to control GET_PARM - CHARACTER*(*) STROUT ! (o) last value set -C -C.Purpose: Get the next value set for a character-type program parameter -C.Returns: Status code (.TRUE. for success, .FALSE. otherwise) -C see GET_PARM -C.Notes: -C------------------------------------------------------------------------- -C -C - CHARACTER*(*) BLANK, EOLVAL, EOLMSG - PARAMETER (BLANK = ' ') - PARAMETER (EOLVAL = '#') - PARAMETER (EOLMSG = '# ! = end-of-loop') -C - INTEGER*4 GP_CTL_CLOSE - INTEGER*4 GP_ARG_CHECK - INTEGER*4 GP_VAL_READ_C, GP_VAL_FILL - INTEGER*4 GP_SAV_WRITE - INTEGER*4 PPD_CMAS_GET, DWC_NODE_SET - INTEGER*4 MSG_SET -C - CHARACTER*255 VALUE, DEFAULT, LOGMSG - INTEGER*4 IS, LV, LDEF, FOUND -C -C - STROUT = BLANK -C -C Analyse the arguments -C - IS = GP_ARG_CHECK (LEN(ARRAY(1)),NBYT,NR,DEFAULT,LDEF, - 1 DEFSTR,%REF(DEFARR(1)),NRDEF,LEN(DEFARR(1)),FLAGS) - IF (IAND(IS,1).EQ.0) GOTO 999 -C -C Get the next value set or end-of-loop -C - if the value block is exhausted, -C get new value sets (or end-of-loop) -C and loop back -C - 100 FOUND = GP_VAL_READ_C (ARRAY,NR,VALUE,LV) - DO WHILE (IAND(FOUND,1).EQ.0 .AND. FOUND.NE.DWC_ENDOFLOOP) - IS = GP_VAL_FILL (DEFAULT,LDEF,FLAGS) - IF (IAND(IS,1).NE.0) THEN - FOUND = GP_VAL_READ_C (ARRAY,NR,VALUE,LV) - ELSE - IF (IS.NE.DWC_ENDOFLOOP) GOTO 999 - FOUND = DWC_ENDOFLOOP - ENDIF - ENDDO - GET_PARM_C = FOUND -C -C Build save string and log message -C - IF (IAND(FOUND,1).NE.0) THEN - LOGMSG = VALUE(:LV) - ELSE - VALUE = EOLVAL - LV = 1 - LOGMSG = EOLMSG - ENDIF - STROUT = VALUE(:LV) -C -C Close GET_PARM operations -C - write log message at level 3, -C - possibly save the value string -C - act on "set current node" flag -C (loop back to get the next node name) -C - save the value administration -C - return -C Do not return UNDEF_J in NR, otherwise -C GP_ARG_CHECK treats NELEM next time -C as not given. -C -C CALL WNCTXT (DWLOG,'!AS = !AS',KEYWORD,LOGMSG) - IS = GP_SAV_WRITE (VALUE,LV) - IF (IAND(IS,1).EQ.0) GET_PARM_C = IS -C - IF (IAND(PPD_CMAS_GET('NODE'),1) .NE. 0) THEN - IS = DWC_NODE_SET (VALUE(:LV)) - IF (IS.EQ.DWC_SETCURNOD) THEN - STROUT = BLANK - GOTO 100 - ENDIF - ENDIF -C - IS = GP_CTL_CLOSE () - IF (IAND(IS,1).EQ.0) GOTO 999 - IF (NR.EQ.UNDEF_J) NR = UNDEF_J+1 - RETURN -C - 999 GET_PARM_C = IS - IS = MSG_SET (DWC_PARAMERR,1) - CALL WNCTXT(DWLOG,DWMSG,KEYWORD) - IF (NR.EQ.UNDEF_J) NR = UNDEF_J+1 - RETURN - END diff --git a/src/dwarf/global.pin b/src/dwarf/global.pin deleted file mode 100644 index 0cbb1dd9230da877fad60672b52b835adf7818ee..0000000000000000000000000000000000000000 --- a/src/dwarf/global.pin +++ /dev/null @@ -1,88 +0,0 @@ -!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ -!.Ident: PIN_GLOBAL -!.Keywords: DWARF control parameters, Definition -!.Author: Ger van Diepen (NFRA, Dwingeloo) -!.Language: DWARF-PIN -!.Environment: VAX -!.Comments: -!.Version: 830204 GVD - creation -!.Version: 840224 RH - adapted to new DWCL system -!.Version: 840615 GVD - removed DeAnza keywords ITTNR,SEGMENTNR and -! SEGMENTSIZE; set DEFAULT=0 /NOASK for IPUNIT and LUTNR -!.Version: 840807 GVD - maximum DeAnza channel nr = 2 -!.Version: 851108 KK - remove MAX_NSETS in keyword DATABASE -!.Version: 900919 FMO - new comment format -!------------------------------------------------------------------------- -! -! DATABASE-KEYWORDS -! ----------------- -! -KEYWORD=DATABASE - DATA_TYPE=C - IO=I - LENGTH=80 -!----- MAX_NSETS=1 - PROMPT=<DATA BASE NAME> -!----- CHECKS=ANUMERIC - SEARCH=LOCAL,GLOBAL,PROGRAM - HELP= -"Defines the name of the delault database, which all programs will use unless - prompting is forced through the /ASK qualifier" -! -! TAPE-KEYWORDS -! ------------- -! -KEYWORD=TAPEUNIT - DATA_TYPE=C - IO=I - LENGTH=4 - CHECKS=OPTIONS - OPTIONS=MTA0,MTB0 - SEARCH=LOCAL,GLOBAL,PROGRAM - HELP= -"Defines the tapeunit that have to be used - MTA0 is the fast selfloading tapeunit - MTB0 is the slower tapeunit (the left one)" -! -! DEANZA-KEYWORDS -! --------------- -! -KEYWORD=IPUNIT - DATA_TYPE=I - IO=I - MAX_NSETS=1 - CHECKS=MINIMUM,MAXIMUM - MINIMUM=0 - MAXIMUM=0 - SEARCH=LOCAL,GLOBAL,PROGRAM - DEFAULT=0 /NOASK - PROMPT="<DeAnza-Unitnr>" - HELP= -"Defines the unitnr of the DeAnza image-processor - 0 is the DeAnza in the image-room" -! -KEYWORD=CHANNEL - DATA_TYPE=I - IO=I - CHECKS=MINIMUM,MAXIMUM - MINIMUM=0 - MAXIMUM=2 - PROMPT="<DeAnza Imagechannel Nr>" - HELP= -"Defines the image-channel on the DeAnza image-processor - Channel 0 is used as overlay-channel and should (unless necessary) - not be used" -! -KEYWORD=LUTNR - DATA_TYPE=I - IO=I - CHECKS=MINIMUM,MAXIMUM - MINIMUM=0 - MAXIMUM=3 - SEARCH=LOCAL,GLOBAL,PROGRAM - DEFAULT=0 /NOASK - PROMPT="<Colour Lookup-Table Nr>" - HELP= -"Defines the nr of the colour lookup-table, which drives the colours -on the screen. - 0 should normally be used" diff --git a/src/dwarf/gparg.for b/src/dwarf/gparg.for deleted file mode 100644 index 9b64d243a5f4753e8952338f3ed5bb970efff6f7..0000000000000000000000000000000000000000 --- a/src/dwarf/gparg.for +++ /dev/null @@ -1,185 +0,0 @@ -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ -C.Ident: GP_ARG -C.Keywords: Program Parameters, Get Value, Arguments -C.Author: Friso Olnon (NFRA, Dwingeloo) -C.Language: DWARF-Fortran -C.Environment: VAX or Alliant -C.Comments: -C.Version: 900416 FMO - recreation -C.Version: 920214 GvD - no optional arguments in MSG anymore -C.Version: 920429 GvD - put argument DEFAULT in front of DEFARR, because -C if DEFARR is passed with %REF on the SUN, it is still -C treated as a string, so its length is also passed and -C used as length of DEFAULT. -C------------------------------------------------------------------------- -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - INTEGER*4 FUNCTION GP_ARG () -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' -C -C -C.Purpose: Make source module name known -C.Returns: Status code (.TRUE. for success, .FALSE. otherwise) -C success DWC_SUCCESS -C.Notes: Dummy function -C------------------------------------------------------------------------- -C -C - GP_ARG = DWC_SUCCESS - RETURN - END -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - INTEGER*4 FUNCTION GP_ARG_CHECK (LARR,NBYT,NR,DEFAULT,LDEF, - 1 DEFSTR,DEFARR,NRDEF,LDARR,FLAGS) -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' -C - INTEGER*4 LARR ! (i) length of array elements in bytes - INTEGER*4 NBYT ! (i) total length of array in bytes - INTEGER*4 NR ! (i) nr of filled elements in array - CHARACTER*(*) DEFAULT ! (o) default as standard value string - INTEGER*4 LDEF ! (o) significant length of DEFAULT - CHARACTER*(*) DEFSTR ! (i) default value (given as a string) - BYTE DEFARR(*) ! (i) default value (given as an array) - INTEGER*4 NRDEF ! (i) nr of elements in DEFARR - INTEGER*4 LDARR ! (i) length of DEFARR elements - INTEGER*4 FLAGS ! (i) flags to control GET_PARM -C -C.Purpose: Check the GET_PARM arguments -C.Returns: Status code (.TRUE. for success, .FALSE. otherwise) -C success DWC_SUCCESS -C fatal DWC_PARTOOSML ARRAY doen't contain enough elements -C fatal DWC_PARELTSML elements in character-type ARRAY are too short -C fatal DWC_PARNONR NR argument is required but not present -C fatal DWC_TWICEVAL default value is given as string and as array -C fatal DWC_TBNOTALL TOBY format is not allowed -C fatal DWC_TBNOMULT TOBY format, but NRDEF is not a multiple of 3 -C fatal DWC_TOOMANSET DEFARR contains too many sets -C false status codes returned by referenced modules -C.Notes: -C - The default value can be given either as a string (non-blank DEFSTR) -C or as an array (NRDEF defined). In both cases it will be converted to -C a standard DWARF value string, in which all symbols have been -C substituted (they must be known now). -C - The data type of the array is determined by the PPD file. -C - If the flag PARM__TOBY is given, the array is assumed to be in TOBY -C format (triplets: start, end, increment) in which case NRDEF must -C be a multiple of 3. -C------------------------------------------------------------------------- -C -C - CHARACTER*(*) BLANK - INTEGER*4 NRARG - PARAMETER (BLANK = ' ') - PARAMETER (NRARG = 1) -C - CHARACTER*10 NAME(NRARG) - INTEGER*4 ATTR(NRARG) - CHARACTER*1 PROMPT(NRARG) - CHARACTER*1 DEFVAL(NRARG) - DATA NAME /'VALSTR' / - DATA ATTR /CLI__EXPRESSION/ - DATA PROMPT /BLANK / - DATA DEFVAL /BLANK / -C - INTEGER*4 PV_DEF_ENCODE - INTEGER*4 CLI_RESET, CLI_PARSE, CLI_GET - INTEGER*4 DWC_STR_STANDARD, DWC_STR_SUBST - INTEGER*4 DWC_STREAM_GET, DWC_HELP - INTEGER*4 PPD_DTYPE_GET, PPD_NVAL_GET, PPD_AMAS_GET - INTEGER*4 MSG_SET -C - CHARACTER VALSTR*255, WORK*255, STREAM*16, DTYPE*1 - INTEGER*4 LVAL, LW, LS - INTEGER*4 IS, PLEN, NRVPS, MNVPS, MXVPS - INTEGER*4 DLEVEL, ERRPTR - LOGICAL*4 SWSYM -C -C - DEFAULT = BLANK - LDEF = 0 -C -C Get the size of the value and the -C required number of values per set -C - IS = PPD_DTYPE_GET (DTYPE,PLEN) - IF (IAND(IS,1).NE.0) IS = PPD_NVAL_GET (NRVPS,MNVPS,MXVPS) - IF (IAND(IS,1).EQ.0) GOTO 999 -C -C Check the array size -C - required: LARR >= PLEN -C and NBYT/LARR >= NRVPS -C - IF (LARR.LT.PLEN) GOTO 991 - I = NBYT/LARR - IF (I.LT.NRVPS) GOTO 992 -C -C The NR argument must be present: -C - if the nr of values can be > 1 -C - or if wildcards or null values -C are possible -C - IF (NR.EQ.UNDEF_J) THEN - IF (NRVPS.GT.1 - 1 .OR. IAND(PPD_AMAS_GET('WILD_CARDS'),1) .NE. 0 - 2 .OR. IAND(PPD_AMAS_GET('NULL_VALUES'),1) .NE. 0) GOTO 993 - ENDIF -C -C If the caller provided a default: -C - convert to standard value string - - LVAL = 0 ! assume: no default - IF (DEFSTR.NE.BLANK) THEN - IF (NRDEF.NE.UNDEF_J .OR. DEFARR(1).NE.UNDEF_B) GOTO 994 - IS = DWC_STR_STANDARD (DEFSTR,VALSTR,LVAL) - IF (IAND(IS,1).EQ.0) GOTO 999 - ELSE IF (NRDEF.NE.UNDEF_J .OR. DEFARR(1).NE.UNDEF_B) THEN - IS = PV_DEF_ENCODE (DEFARR,NRDEF,LDARR,FLAGS,VALSTR,LVAL) - IF (IAND(IS,1).EQ.0) GOTO 999 - ENDIF -C -C - substitute symbols (all known now) -C - IF (LVAL.GT.0) THEN - SWSYM = .FALSE. - IS = DWC_STREAM_GET (STREAM,LS,.FALSE.) - IF (IAND(IS,1).EQ.0) GOTO 999 - IS = DWC_STR_SUBST (VALSTR(:LVAL),WORK,LW,STREAM(:LS), - 1 ERRPTR,.FALSE.,SWSYM) - IF (IAND(IS,1).EQ.0) GOTO 995 -C -C - help request not allowed -C - IS = DWC_HELP (WORK(:LW),-1,DLEVEL) - IF (IAND(IS,1).EQ.0) GOTO 999 -C -C - check the final string -C - IS = CLI_RESET (NRARG,NAME,ATTR,PROMPT,DEFVAL) - IF (IAND(IS,1).NE.0) IS = CLI_PARSE (WORK(:LW)) - IF (IAND(IS,1).NE.0) IS = CLI_GET ('VALSTR',DEFAULT,LDEF) - IF (IAND(IS,1).EQ.0) GOTO 999 - ENDIF -C -C - GP_ARG_CHECK = DWC_SUCCESS - RETURN -C - 991 GP_ARG_CHECK = MSG_SET (DWC_PARELTSML,1) - CALL WNCTXT(DWLOG,DWMSG,LARR,PLEN) - RETURN - 992 GP_ARG_CHECK = MSG_SET (DWC_PARTOOSML,1) - CALL WNCTXT(DWLOG,DWMSG,I,NRVPS) - RETURN - 993 GP_ARG_CHECK = MSG_SET (DWC_PARNONR,0) - RETURN - 994 GP_ARG_CHECK = MSG_SET (DWC_TWICEVAL,0) - RETURN - 995 GP_ARG_CHECK = MSG_SET (DWC_EXPERRMSG,0) - CALL WNCTXT(DWLOG,DWMSG,BLANK,ERRPTR,WORK(:LW)) - RETURN - 999 GP_ARG_CHECK = IS - RETURN - END diff --git a/src/dwarf/gpask.for b/src/dwarf/gpask.for deleted file mode 100644 index e35a3ec865f15952936cff101c3518c2a48e854d..0000000000000000000000000000000000000000 --- a/src/dwarf/gpask.for +++ /dev/null @@ -1,158 +0,0 @@ -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ -C.Ident: GP_ASK -C.Keywords: Program Parameters, Get Value, Ask Control -C.Author: Friso Olnon (NFRA, Dwingeloo) -C.Language: DWARF-Fortran -C.Environment: VAX or Alliant -C.Comments: -C Common fields used: -C INTEGER*4 PARM$ASK ! (m) parameter's ask switch -C INTEGER*4 PARM$ASKSW ! (m) prompt user ? -C -C.Version: 900302 FMO - creation -C.Version: 920214 GvD - no optional arguments in MSG anymore -C------------------------------------------------------------------------- -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - INTEGER*4 FUNCTION GP_ASK () -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' -C -C -C.Purpose: Make source module name known -C.Returns: Status code (.TRUE. for success, .FALSE. otherwise) -C success DWC_SUCCESS -C.Notes: Dummy routine -C------------------------------------------------------------------------- -C -C - GP_ASK = DWC_SUCCESS - RETURN - END -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - INTEGER*4 FUNCTION GP_ASK_INIT (SWITCH) -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' -C - INTEGER*4 SWITCH(2) ! (i) ask switches -C -C.Purpose: Initialize the ASK control -C.Returns: Status code (.TRUE. for success, .FALSE. otherwise) -C success DWC_SUCCESS -C.Notes: -C - SWITCH are the ask switches derived from the ASK qualifiers on the -C initial parameter defaults (1 for SPECIFY, 2 for PPD). -C = -1 (/NOASK), = 0 (not given) or = 1 (/ASK). -C------------------------------------------------------------------------- -C - INCLUDE 'PARM_6_DEF' -C - INTEGER*4 DWC_ASK_INQ -C -C - PARM$ASKSW = 0 - IF (SWITCH(1).NE.0) THEN ! SPECIFY default with /[NO]ASK - PARM$ASK = SWITCH(1) - ELSE IF (IAND(DWC_ASK_INQ(),1) .NE. 0) THEN ! user gave EXECUTE/ASK - PARM$ASK = 1 ! or set DWARF ASK control on - ELSE - PARM$ASK = SWITCH(2) - ENDIF -C - GP_ASK_INIT = DWC_SUCCESS - RETURN - END -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - INTEGER*4 FUNCTION GP_ASK_SET (SWITCH,TYPE) -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' -C - INTEGER*4 SWITCH ! (i) ask switch - INTEGER*4 TYPE ! (i) type of switch -C -C.Purpose: Switch ASK action ON or OFF -C.Returns: Status code (.TRUE. for success, .FALSE. otherwise) -C success DWC_SUCCESS -C error DWC_PARNOVAL no value available in batch mode -C.Notes: -C - SWITCH = 1 (ON), -1 (OFF). -C - TYPE = 1 (from default), 2 (from user input), 3 (from RETRY_PARM), -C 4 (from absence of def value), 5 (from type of default used). -C - Any other SWITCH or TYPE will leave things unchanged. -C------------------------------------------------------------------------- -C - INCLUDE 'PARM_6_DEF' -C - INTEGER*4 DWC_IBMODE_INQ, PPD_AMAS_GET, MSG_SET - LOGICAL*4 NO_DEFAULT -C -C -C ASK qualifier from user -C - IF (TYPE.EQ.1 .OR. TYPE.EQ.2) THEN - IF (SWITCH.EQ.1) THEN - PARM$ASK = 1 - ELSE IF (SWITCH.EQ.-1) THEN - PARM$ASK = -1 - ENDIF -C -C RETRY_PARM from program -C - ELSE IF (TYPE.EQ.3) THEN - IF (SWITCH.EQ.1) THEN - PARM$ASK = PARM$ASK+100 - ENDIF -C -C Absence/presence of default value -C - ELSE IF (TYPE.EQ.4) THEN - NO_DEFAULT = SWITCH.EQ.1 -C -C Do we prompt or don't we ? -C - ELSE IF (TYPE.EQ.5) THEN - IF (PARM$ASK.GT.50) THEN ! RETRY_PARM active: - PARM$ASK = PARM$ASK-100 ! de-activate - PARM$ASKSW = .TRUE. ! yes - ELSE IF (IAND(DWC_IBMODE_INQ('BATCH'),1) .NE. 0) THEN ! batch - IF (NO_DEFAULT) GOTO 999 ! value required - PARM$ASKSW = .FALSE. ! no - ELSE IF (NO_DEFAULT) THEN ! value absent: - PARM$ASKSW = .TRUE. ! yes - ELSE IF (IAND(PPD_AMAS_GET('ASK'),1) .NE. 0) THEN ! PPD ASK attr - PARM$ASKSW = .TRUE. ! yes - ELSE IF (PARM$ASK.NE.0) THEN ! user gave /(NO)ASK: - PARM$ASKSW = PARM$ASK.EQ.1 ! follow it - ELSE ! default action: - PARM$ASKSW = SWITCH.EQ.1 ! yes, unless the - ENDIF ! SPEC def is used - ENDIF -C - GP_ASK_SET = DWC_SUCCESS - RETURN -C - 999 GP_ASK_SET = MSG_SET (DWC_PARNOVAL,0) - RETURN - END -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - INTEGER*4 FUNCTION GP_ASK_INQ (SWITCH) -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' -C - LOGICAL*4 SWITCH ! (o) prompt for input ? -C -C.Purpose: Inquire whether the program must prompt for values -C.Returns: Status code (.TRUE. for success, .FALSE. otherwise) -C success DWC_SUCCESS -C.Notes: -C------------------------------------------------------------------------- -C - INCLUDE 'PARM_6_DEF' -C - SWITCH = PARM$ASKSW - GP_ASK_INQ = DWC_SUCCESS - RETURN - END diff --git a/src/dwarf/gpctl.for b/src/dwarf/gpctl.for deleted file mode 100644 index ee675a3b9949dbfb935c66e2c21a5ef6bbdd837a..0000000000000000000000000000000000000000 --- a/src/dwarf/gpctl.for +++ /dev/null @@ -1,244 +0,0 @@ -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ -C.Ident: GP_CTL -C.Keywords: Program Parameters, Get Value, Control -C.Author: Friso Olnon (NFRA, Dwingeloo) -C.Language: DWARF-Fortran -C.Environment: VAX or Alliant -C.Comments: -C Common fields used: -C INTEGER*4 PARM$KEYPART(*) ! (m) parameter-specific fields -C CHARACTER*16 PARM$KEY ! (m) user's parameter name -C INTEGER*4 PARM$LK ! (m) significant length of the keyword -C -C.Version: 900416 FMO - recreation -C.Version: 920214 GvD - no optional arguments in MSG anymore -C.Version: 940120 CMV - use WNGGVM i.s.o. GEN_GET_VM, indirect addressing -C------------------------------------------------------------------------- -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - INTEGER*4 FUNCTION GP_CTL () -C ENTRY GP_CTL_OPEN (KEYWORD) -C ENTRY GP_CTL_CLOSE () -C ENTRY GP_CTL_END () -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' - INCLUDE 'PARM_6_DEF' -C - INTEGER*4 GP_CTL_OPEN, GP_CTL_CLOSE, GP_CTL_END -C - CHARACTER*(*) KEYWORD ! (i) program's name of the parameter -C -C.Purpose: Open, close or end the GET_PARM control -C.Returns: Status code (.TRUE. for success, .FALSE. otherwise) -C success DWC_SUCCESS -C error 2 too many active program parameters (OPEN) -C fatal DWC_UNKPRKEYW invalid keyword (OPEN) -C false status codes returned by references routines -C.Notes: -C - OPEN loads the parameter descriptions in common blocks -C - CLOSE saves the parameter-value administration in virtual memory -C - END defines external defaults for all parameters for which values -C were saved via /SAVE requests. -C------------------------------------------------------------------------- -C - CHARACTER*(*) BLANK - INTEGER*4 MAXNR ! max nr of used parameters - PARAMETER (BLANK = ' ') - PARAMETER (MAXNR = 100) - CHARACTER*16 PNAM_LIST(MAXNR) ! list of used param names - INTEGER*4 PADR_LIST(MAXNR) ! list of VM-block addresses - INTEGER*4 PCOUNT ! nr of used parameters - INTEGER*4 ACTIVE_NR ! nr of currently active param - DATA PNAM_LIST /MAXNR*' '/ - DATA PADR_LIST /MAXNR*0/ - DATA PCOUNT /0/ - DATA ACTIVE_NR /0/ - SAVE PNAM_LIST, PADR_LIST, PCOUNT, ACTIVE_NR -C - INTEGER*4 GP_INI_FILL, GP_DEF_CLEAR, GP_VAL_CLEAR, GP_SAV_INIT - INTEGER*4 GP_LOOP_INIT, GP_ASK_INIT, GP_SAV_DEFINE - INTEGER*4 DWC_PROG_GET, DWC_STREAM_GET, DWC_SYM_BUILD - INTEGER*4 PPD_READ_P, PPD_IOCD_GET, PPD_UNAM_GET - INTEGER*4 STR_UPCASE, STR_MATCH_A - INTEGER*4 MOVE_BLB - LOGICAL WNGGVM - INTEGER MSG_SET -C - CHARACTER SYMBOL*40, PROGNAM*16, STREAM*16, UPCKEY*16, IOCD*6 - INTEGER*4 IS, LSYM, LP, LS, LIO, NR, LKMIN, ADDRESS, ASKSW(2) - LOGICAL*4 PROTO -C - GP_CTL = DWC_SUCCESS - RETURN -C -C ================= - ENTRY GP_CTL_OPEN (KEYWORD) -C ================= -C -C Read the parameter description -C from the PPD file into common -C - convert the name to uppercase -C - accept input-type parameters only -C - UPCKEY = KEYWORD - IS = STR_UPCASE (UPCKEY) - IF (IAND(IS,1).NE.0) IS = PPD_READ_P (UPCKEY) - IF (IAND(IS,1).NE.0) IS = PPD_IOCD_GET (IOCD,LIO) - IF (IAND(IS,1).EQ.0) GOTO 999 ! PPD access error - IF (INDEX('IM',IOCD(1:1)).EQ.0) GOTO 991 ! no input-type -C -C If the parameter has already been used: -C - copy its control block into common -C - set the new active-number -C - IS = STR_MATCH_A (UPCKEY,PCOUNT,PNAM_LIST,NR) - IF (IS.EQ.1) THEN ! full match - IS = MOVE_BLB (A_B(PADR_LIST(NR)-A_OB), - 1 PARM$KEYPART,PARM__LENKP) - IF (IAND(IS,1).EQ.0) GOTO 999 - ACTIVE_NR = NR -C -C Otherwise: -C - initialize its control common -C - save it in a virtual memory block -C - add the parameter to the used-list -C - set the new active-number -C - ELSE - IF (PCOUNT.GE.MAXNR) GOTO 992 - IS = DWC_PROG_GET (PROGNAM,LP) - IF (IAND(IS,1).NE.0) IS = DWC_STREAM_GET (STREAM,LS,.FALSE.) - IF (IAND(IS,1).NE.0) - 1 IS = PPD_UNAM_GET (PARM$KEY,PARM$LK,LKMIN,PROTO) - IF (IAND(IS,1).NE.0) IS = DWC_SYM_BUILD - 1 (PROGNAM(:LP),STREAM(:LS),PARM$KEY(:PARM$LK),SYMBOL,LSYM) - IF (IAND(IS,1).NE.0) IS = GP_LOOP_INIT () - IF (IAND(IS,1).NE.0) IS = GP_INI_FILL (SYMBOL(:LSYM),ASKSW) - IF (IAND(IS,1).NE.0) IS = GP_ASK_INIT (ASKSW) - IF (IAND(IS,1).NE.0) IS = GP_DEF_CLEAR () - IF (IAND(IS,1).NE.0) IS = GP_VAL_CLEAR () - IF (IAND(IS,1).NE.0) IS = GP_SAV_INIT () - IF (IAND(IS,1).EQ.0) GOTO 999 -C - IF (.NOT.WNGGVM(PARM__LENKP,ADDRESS)) THEN - IS = MSG_SET (DWC_PPDNOVIRT,1) - CALL WNCTXT(DWLOG,DWMSG,PARM__LENKP) - GOTO 999 - ENDIF - IS = MOVE_BLB (PARM$KEYPART,A_B(ADDRESS-A_OB),PARM__LENKP) - IF (IAND(IS,1).EQ.0) GOTO 999 -C - PCOUNT = PCOUNT+1 - PNAM_LIST(PCOUNT) = UPCKEY - PADR_LIST(PCOUNT) = ADDRESS - ACTIVE_NR = PCOUNT - ENDIF -C - GP_CTL_OPEN = DWC_SUCCESS - RETURN -C - 991 GP_CTL_OPEN = MSG_SET (DWC_UNKPRKEYW,1) - CALL WNCTXT(DWLOG,DWMSG,UPCKEY,' input-',BLANK) - RETURN - 992 GP_CTL_OPEN = 2 - CALL WNCTXT(DWLOG,'Too many active program parameters') - RETURN - 999 GP_CTL_OPEN = IS - RETURN -C -C ================== - ENTRY GP_CTL_CLOSE () -C ================== -C -C Write the common back to VM block -C - IF (ACTIVE_NR.GT.0) - 1 IS = MOVE_BLB (PARM$KEYPART, - 1 A_B(PADR_LIST(ACTIVE_NR)-A_OB),PARM__LENKP) -C - ACTIVE_NR = 0 - GP_CTL_CLOSE = DWC_SUCCESS - RETURN -C -C ================ - ENTRY GP_CTL_END () -C ================ -C -C Define all SAVE symbols -C - IS = DWC_PROG_GET (PROGNAM,LP) ! ignore false returns - IS = DWC_STREAM_GET (STREAM,LS,.FALSE.) -C - DO NR = 1,PCOUNT - IS = MOVE_BLB (A_B(PADR_LIST(NR)-A_OB), - 1 PARM$KEYPART,PARM__LENKP) - IF (IAND(IS,1).NE.0) IS = DWC_SYM_BUILD - 1 (PROGNAM(:LP),STREAM(:LS),PARM$KEY(:PARM$LK),SYMBOL,LSYM) - IF (IAND(IS,1).NE.0) - 1 IS = GP_SAV_DEFINE (SYMBOL(:LSYM),PNAM_LIST(NR)) - ENDDO -C - GP_CTL_END = DWC_SUCCESS - RETURN - END -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - INTEGER*4 FUNCTION GP_CTL_RESET (KEYWORD) -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' -C - CHARACTER*(*) KEYWORD ! (i) parameter name -C -C.Purpose: Reset the GET_PARM control for a program parameter -C.Returns: Status code (.TRUE. for success, .FALSE. otherwise) -C success DWC_SUCCESS -C false status codes returned by referenced routines -C.Notes: -C - The control will be reset when the user answered /ASK=<keyword> -C on a DWARF prompt. -C - The next call of GET_PARM for that parameter will then result in -C a question on the terminal. -C------------------------------------------------------------------------- -C - INTEGER*4 GP_CTL_OPEN, GP_CTL_CLOSE - INTEGER*4 GP_ASK_SET, GP_VAL_RELEASE, GP_LOOP_RESET - INTEGER*4 PPD_PNAM_GET, PPD_READ_U -C - CHARACTER*16 SAVPKEY, PKEY - INTEGER*4 IS, LSAV, LPK -C -C -C Close the current parameter control -C - IS = PPD_PNAM_GET (SAVPKEY,LSAV) - IF (IAND(IS,1).NE.0) IS = GP_CTL_CLOSE () - IF (IAND(IS,1).EQ.0) GOTO 999 -C -C Find the wanted parameter and -C open its control -C - IS = PPD_READ_U (KEYWORD) - IF (IAND(IS,1).NE.0) IS = PPD_PNAM_GET (PKEY,LPK) - IF (IAND(IS,1).NE.0) IS = GP_CTL_OPEN (PKEY) - IF (IAND(IS,1).EQ.0) GOTO 998 -C -C Reset the relevant control fields -C - IS = GP_VAL_RELEASE () ! clear value array - IF (IAND(IS,1).NE.0) IS = GP_ASK_SET (1,2) ! user said ASK - IF (IAND(IS,1).NE.0) IS = GP_LOOP_RESET () ! reset loop control - IF (IAND(IS,1).EQ.0) GOTO 998 -C -C Close the parameter control -C and restore the original one -C - IS = GP_CTL_CLOSE () - 998 IS = GP_CTL_OPEN (SAVPKEY) - IF (IAND(IS,1).EQ.0) GOTO 999 -C - GP_CTL_RESET = DWC_SUCCESS - RETURN -C - 999 GP_CTL_RESET = IS - RETURN - END diff --git a/src/dwarf/gpdef.for b/src/dwarf/gpdef.for deleted file mode 100644 index b5e26f497280e294c9d73e6218d8db4c63294ae8..0000000000000000000000000000000000000000 --- a/src/dwarf/gpdef.for +++ /dev/null @@ -1,328 +0,0 @@ -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ -C.Ident: GP_DEF -C.Keywords: Program Parameters, Get Value, Current Defaults -C.Author: Friso Olnon (NFRA, Dwingeloo) -C. WNB 920918 Changed test on DEFADYN to NE iso GT -C.Language: DWARF-Fortran -C.Environment: VAX or Alliant -C.Comments: -C Common fields used: -C INTEGER*4 PARM$DEFLDYN ! (m) length of VM block (all sets) -C INTEGER*4 PARM$DEFADYN ! (m) address of VM block -C INTEGER*4 PARM$DEFAVAL ! (m) address of value part -C INTEGER*4 PARM$DEFASW ! (m) address of switches part -C INTEGER*4 PARM$DEFNRS ! (m) nr of sets -C INTEGER*4 PARM$DEFVPS ! (m) reserved nr of values per set -C INTEGER*4 PARM$DEFSNR ! (m) current set nr -C INTEGER*4 PARM$DEFPTR ! (m) pointer to current value -C INTEGER*4 PARM$DEFCNT ! (m) counter for TOBY format -C INTEGER*4 PARM$DEFLDEF ! (m) length of VM buffer (single set) -C INTEGER*4 PARM$DEFADEF ! (m) address of VM buffer -C -C.Version: 900325 FMO - creation -C.Version: 920214 GvD - no optional arguments in MSG anymore -C.Version: 920513 GvD - TOBY not allowed for logicals -C.Version: 940120 CMV - use WNGGVM i.s.o. GEN_GET_VM, indirect addressing -C------------------------------------------------------------------------- -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - INTEGER*4 FUNCTION GP_DEF () -C ENTRY GP_DEF_CLEAR () -C ENTRY GP_DEF_RELEASE () -C ENTRY GP_DEF_PUT (VALBLK,IS_OWNER) -C ENTRY GP_DEF_GET (VALBLK,IS_OWNER,IS_FILLED) -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' - INTEGER*4 GP_DEF_CLEAR, GP_DEF_RELEASE, GP_DEF_PUT, GP_DEF_GET -C - INTEGER*4 VALBLK(8) ! (i/o) value block descriptor - LOGICAL*4 IS_OWNER ! (i/o) block owned by this module ? - LOGICAL*4 IS_FILLED ! (o) any value in block ? -C -C.Purpose: Manipulate the description of current-defaults value block -C.Returns: Status code (.TRUE. for success, .FALSE. otherwise) -C success DWC_SUCCESS -C false status codes returned by referenced routines -C.Notes: -C - CLEAR clears the value block descriptor. -C - RELEASE releases the memory occupied by the value block (provided -C that this module "owns" the block) and clears the descriptor. -C - PUT copies a value-block descriptor into the current-defaults block -C descriptor, does or doesn't make this modules the block "owner" and -C resets the pointers to zero. -C - GET returns the block descriptor and tells whether the block is owned -C by this module and whether it contains any value. -C------------------------------------------------------------------------- -C - INCLUDE 'PARM_6_DEF' -C - INTEGER*4 SCALAR_BIT, TOBY_BIT - PARAMETER (SCALAR_BIT = 0) - PARAMETER (TOBY_BIT = 1) -C - INTEGER*4 PPD_DTYPE_GET, PPD_NVAL_GET, PPD_AMAS_GET - INTEGER*4 CLEAR_BLJ, MOVE_BLJ - LOGICAL WNGFVM -C - CHARACTER*1 DTYPE - INTEGER*4 IS, NVAL, MNVAL, MXVAL - LOGICAL TMP -C -C - GP_DEF = DWC_SUCCESS ! dummy main entry point - RETURN -C -C ================== - ENTRY GP_DEF_CLEAR () -C ================== -C - IS = CLEAR_BLJ (PARM$DEFLDYN,11) -C - GP_DEF_CLEAR = DWC_SUCCESS - RETURN -C -C ==================== - ENTRY GP_DEF_RELEASE () -C ==================== -C - IF (PARM$DEFLDYN.NE.0) - 1 TMP = WNGFVM(PARM$DEFLDYN,PARM$DEFADYN) - IF (PARM$DEFADEF.NE.0) - 1 TMP = WNGFVM(PARM$DEFLDEF,PARM$DEFADEF) - IS = CLEAR_BLJ (PARM$DEFLDYN,11) -C - GP_DEF_RELEASE = DWC_SUCCESS - RETURN -C -C ================ - ENTRY GP_DEF_PUT (VALBLK,IS_OWNER) -C ================ -C - IS = MOVE_BLJ (VALBLK,PARM$DEFLDYN,6) - IF (.NOT.IS_OWNER) PARM$DEFLDYN = 0 - PARM$DEFSNR = 0 ! current set nr - PARM$DEFPTR = 0 ! current value nr - PARM$DEFCNT = 0 ! TOBY counter -C - GP_DEF_PUT = DWC_SUCCESS - RETURN -C -C ================ - ENTRY GP_DEF_GET (VALBLK,IS_OWNER,IS_FILLED) -C ================ -C - IS = MOVE_BLJ (PARM$DEFLDYN,VALBLK,6) - IF (IAND(IS,1).NE.0) IS = PPD_DTYPE_GET (DTYPE,VALBLK(7)) - IF (IAND(IS,1).NE.0) IS = PPD_NVAL_GET (NVAL,MNVAL,MXVAL) - IF (IAND(IS,1).EQ.0) GOTO 999 - VALBLK(8) = 0 ! flags - IF (NVAL.EQ.1) VALBLK(8) = IBSET (VALBLK(8),SCALAR_BIT) - IF (DTYPE.NE.'C' .AND. DTYPE.NE.'L' - 1 .AND. IAND(PPD_AMAS_GET('VECTOR'),1) .EQ. 0) - 2 VALBLK(8) = IBSET (VALBLK(8),TOBY_BIT) - IS_OWNER = PARM$DEFLDYN.NE.0 - IS_FILLED = PARM$DEFADYN.NE.0 !!920918 -C - GP_DEF_GET = DWC_SUCCESS - RETURN -C - 999 GP_DEF_GET = IS - RETURN - END -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - INTEGER*4 FUNCTION GP_DEF_READ (ARRAY,NR,VALUE,LV) -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' -C - BYTE ARRAY(*) ! (o) value array - INTEGER*4 NR ! (o) nr of filled elements in array - CHARACTER*(*) VALUE ! (o) value string - INTEGER*4 LV ! (o) significant length of string -C -C.Purpose: Read the next value set from the defaults block -C.Returns: Status code (.TRUE. for success, .FALSE. otherwise) -C success DWC_SUCCESS -C warning 0 end of value block reached -C false status codes returned by referenced routines -C.Notes: -C - The pointers will be updated. -C------------------------------------------------------------------------- -C - INCLUDE 'PARM_6_DEF' -C - INTEGER*4 GP_DEF_GET, PV_BLK_READ -C - INTEGER*4 IS, VALBLK(8) - LOGICAL*4 IS_OWNER, IS_FILLED -C -C - IS = GP_DEF_GET (VALBLK,IS_OWNER,IS_FILLED) - IF (IAND(IS,1).EQ.0) GOTO 999 - IS = 0 - IF (IS_FILLED) IS = PV_BLK_READ (VALBLK,PARM$DEFSNR,PARM$DEFPTR, - 1 PARM$DEFCNT,ARRAY,NR,.TRUE.,VALUE,LV) - IF (IAND(IS,1).EQ.0) GOTO 999 -C - GP_DEF_READ = DWC_SUCCESS - RETURN -C - 999 GP_DEF_READ = IS - RETURN - END -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - INTEGER*4 FUNCTION GP_DEF1 () -C ENTRY GP_DEF1_ALLOC (VALBLK) -C ENTRY GP_DEF1_GET (ADDRESS) -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' - INTEGER*4 GP_DEF1_ALLOC, GP_DEF1_GET -C - INTEGER*4 VALBLK(8) ! (i) value block descriptor - INTEGER*4 ADDRESS ! (o) buffer address -C -C.Purpose: Manipulate the description of the single default set buffer -C.Returns: Status code (.TRUE. for success, .FALSE. otherwise) -C success DWC_SUCCESS -C false status code returned by reference routines -C.Notes: -C - ALLOC allocates memory for a single value set from the value block. -C - GET returns the buffer address. -C------------------------------------------------------------------------- -C - INCLUDE 'PARM_6_DEF' -C - INTEGER*4 MSG_SET - LOGICAL WNGGVM -C - INTEGER*4 IS, NBYTES, ADDR -C -C - GP_DEF1 = DWC_SUCCESS ! dummy main entry point - RETURN -C -C =================== - ENTRY GP_DEF1_ALLOC (VALBLK) -C =================== -C - NBYTES = VALBLK(6)*VALBLK(7) - IF (.NOT.WNGGVM(NBYTES,ADDR)) GOTO 999 - PARM$DEFLDEF = NBYTES - PARM$DEFADEF = ADDR -C - GP_DEF1_ALLOC = DWC_SUCCESS - RETURN -C - 999 GP_DEF1_ALLOC = MSG_SET (DWC_PPDNOVIRT,1) - CALL WNCTXT(DWLOG,DWMSG,NBYTES) - RETURN -C -C ================= - ENTRY GP_DEF1_GET (ADDRESS) -C ================= -C - ADDRESS = PARM$DEFADEF -C - GP_DEF1_GET = DWC_SUCCESS - RETURN - END -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - INTEGER*4 FUNCTION GP_DEF_FILL (DEFSTR,LDEF,FLAGS) -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' -C - CHARACTER*(*) DEFSTR ! (i) default value (standard string) - INTEGER*4 LDEF ! (i) significant length of DEFSTR - INTEGER*4 FLAGS ! (i) flags -C -C.Purpose: Fill the parameter's DEF value block -C.Returns: Status code (.TRUE. for success, .FALSE. otherwise) -C success DWC_SUCCESS -C false status codes returned by referenced modules -C.Notes: -C - Possible flags: -C PARM__OVERRIDE program default overrides the SPECIFY value -C -C The default value can be obtained in 2 ways: -C - from the known value in the parameter area (this can be the -C SPECIFY value or the PPD default). This way will be taken if the -C value comes from SPECIFY and the user did not give PARM__OVERRIDE, -C or if the user did not provide a program default. -C - from the program default the caller gave in the GET_PARM call. -C -C The function will allocate virtual memory to store a single set from the -C default value (this will be used by GP_VAL_FILL). It will free virtual -C memory that is no longer needed. -C------------------------------------------------------------------------- -C -C - INTEGER*4 GP_ASK_SET - INTEGER*4 PV_DEF_DECODE, GP_DEF_GET, GP_DEF_PUT, GP_DEF_RELEASE - INTEGER*4 GP_DEF1_ALLOC - INTEGER*4 GP_INI_GET -C - INTEGER*4 IS, INITYPE, INIBLK(8) - INTEGER*4 SWTYPE, SWABSENT, VALBLK(8) - LOGICAL*4 IS_OWNER, IS_FILLED -C -C -C Free the current default dynamic storage -C - IS = GP_DEF_RELEASE () - IF (IAND(IS,1).EQ.0) GOTO 999 -C -C If there is there a caller default -C and there is no SPECIFY value -C (or it must be overruled): -C - convert it to a value block and -C store its description in DEF fields -C - SWTYPE = 1 ! assume no SPEC val - IS = GP_INI_GET (INIBLK,INITYPE) - IF (IAND(IS,1).EQ.0) GOTO 999 - IF (LDEF.NE.0 .AND. - 1 (INITYPE.NE.1 .OR. IAND(FLAGS,PARM__OVERRIDE).NE.0)) THEN - IS = PV_DEF_DECODE (DEFSTR,LDEF,VALBLK) - IF (IAND(IS,1).EQ.0) GOTO 999 - IS_OWNER = .TRUE. - IS = GP_DEF_PUT (VALBLK,IS_OWNER) - IF (IAND(IS,1).EQ.0) GOTO 999 -C -C Otherwise: -C - use the SPECIFY value -C - ELSE - IS_OWNER = .FALSE. ! INI is owner - IS = GP_DEF_PUT (INIBLK,IS_OWNER) - IF (IAND(IS,1).EQ.0) GOTO 999 - IF (INITYPE.EQ.1) SWTYPE = -1 ! SPEC val used - ENDIF -C -C If there is a default: -C - allocate VM for a single set -C - SWABSENT = 1 ! assume no default - IS = GP_DEF_GET (VALBLK,IS_OWNER,IS_FILLED) - IF (IAND(IS,1).EQ.0) GOTO 999 - IF (IS_FILLED) THEN - IS = GP_DEF1_ALLOC (VALBLK) - IF (IAND(IS,1).EQ.0) GOTO 999 - SWABSENT = 0 - ENDIF -C -C Tell the ASK manager the type of -C default (or its absence), and -C let him set the final ask switch -C - IS = GP_ASK_SET (SWABSENT,4) - IF (IAND(IS,1).NE.0) IS = GP_ASK_SET (SWTYPE,5) - IF (IAND(IS,1).EQ.0) GOTO 999 -C - GP_DEF_FILL = DWC_SUCCESS - RETURN -C - 999 GP_DEF_FILL = IS - RETURN - END diff --git a/src/dwarf/gpini.for b/src/dwarf/gpini.for deleted file mode 100644 index 95358bd79cd9d7093cef04564e24a8c336758ea4..0000000000000000000000000000000000000000 --- a/src/dwarf/gpini.for +++ /dev/null @@ -1,306 +0,0 @@ -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ -C.Ident: GP_INI -C.Keywords: Program Parameters, Initial Defaults -C.Author: Friso Olnon (NFRA, Dwingeloo) -C.Language: DWARF-Fortran -C.Environment: VAX or Alliant -C.Comments: -C Common fields used: -C INTEGER*4 PARM$EXELDYN ! (m) length of VM block -C INTEGER*4 PARM$EXEADYN ! (m) address of VM block -C INTEGER*4 PARM$EXEAVAL ! (m) address of value part -C INTEGER*4 PARM$EXEASW ! (m) address of switches part -C INTEGER*4 PARM$EXENRS ! (m) nr of sets -C INTEGER*4 PARM$EXEVPS ! (m) reserved nr of values per set -C INTEGER*4 PARM$EXETYPE ! (m) type of initial default -C -C.Version: 900416 FMO - recreation -C.Version: 920206 GvD - add former optional arguments to CLI_GET -C.Version: 920513 GvD - TOBY not allowed for logicals -C.Version: 940329 CMV - Ignore errors in defaults -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - INTEGER*4 FUNCTION GP_INI () -C ENTRY GP_INI_CLEAR () -C ENTRY GP_INI_PUT (VALBLK,TYPE) -C ENTRY GP_INI_GET (VALBLK,TYPE) -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' - INTEGER*4 GP_INI_CLEAR, GP_INI_PUT, GP_INI_GET -C - INTEGER*4 VALBLK(8) ! (i/o) value block descriptor - INTEGER*4 TYPE ! (i/o) type of initial default -C -C.Purpose: Manipulate the description of the initial-defaults value block -C.Returns: Status code (.TRUE. for success, .FALSE. otherwise) -C success DWC_SUCCESS -C false status code returned by referenced routines -C.Notes: -C - PUT copies a value-block descriptor into the initial-defaults block -C descriptor and sets the default type code. -C - GET returns the block descriptor and the default type code: -C TYPE = 0 (none), 1 (SPECIFY), or 2 (PPD or caller default possible. -C------------------------------------------------------------------------- -C - INCLUDE 'PARM_6_DEF' -C - INTEGER*4 SCALAR_BIT, TOBY_BIT - PARAMETER (SCALAR_BIT = 0) - PARAMETER (TOBY_BIT = 1) -C - INTEGER*4 PPD_DTYPE_GET, PPD_NVAL_GET, PPD_AMAS_GET - INTEGER*4 CLEAR_BLJ, MOVE_BLJ -C - CHARACTER*1 DTYPE - INTEGER*4 IS, NVAL, MNVAL, MXVAL -C -C - GP_INI = DWC_SUCCESS - RETURN -C -C ================== - ENTRY GP_INI_CLEAR () -C ================== -C - IS = CLEAR_BLJ (PARM$EXELDYN,7) -C - GP_INI_CLEAR = DWC_SUCCESS - RETURN -C -C ================ - ENTRY GP_INI_PUT (VALBLK,TYPE) -C ================ -C - IS = MOVE_BLJ (VALBLK,PARM$EXELDYN,6) - PARM$EXETYPE = TYPE -C - GP_INI_PUT = DWC_SUCCESS - RETURN -C -C ================ - ENTRY GP_INI_GET (VALBLK,TYPE) -C ================ -C - IS = MOVE_BLJ (PARM$EXELDYN,VALBLK,6) - IF (IAND(IS,1).NE.0) TYPE = PARM$EXETYPE - IF (IAND(IS,1).NE.0) IS = PPD_DTYPE_GET (DTYPE,VALBLK(7)) - IF (IAND(IS,1).NE.0) IS = PPD_NVAL_GET (NVAL,MNVAL,MXVAL) - IF (IAND(IS,1).EQ.0) GOTO 999 - VALBLK(8) = 0 - IF (NVAL.EQ.1) VALBLK(8) = IBSET (VALBLK(8),SCALAR_BIT) - IF (DTYPE.NE.'C' .AND. DTYPE.NE.'L' - 1 .AND. IAND(PPD_AMAS_GET('VECTOR'),1) .EQ. 0) - 2 VALBLK(8) = IBSET (VALBLK(8),TOBY_BIT) -C - GP_INI_GET = DWC_SUCCESS - RETURN -C - 999 GP_INI_GET = IS - RETURN - END -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - INTEGER*4 FUNCTION GP_INI_FILL (SYMBOL,ASK) -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' -C - CHARACTER*(*) SYMBOL ! (i) full symbol name - INTEGER*4 ASK(2) ! (o) ask switches -C -C.Purpose: Fill the initial-defaults block for a program parameter -C.Returns: Status code (.TRUE. for success, .FALSE. otherwise) -C success DWC_SUCCESS -C fatal DWC_PARWRDEF error in default value -C.Notes: -C - ASK(1) gives the ASK qualifier on the SPECIFY default. -C The coding is: -1 for /NOASK, 0 if not given, +1 for /ASK. -C - ASK(2) does the same for the PPD default. -C------------------------------------------------------------------------- -C -C - INTEGER*4 GP_INI_CLEAR, GP_INI_PUT, GP_INI_DECODE - INTEGER*4 PV_DEF_GET, DWC_SYM_SPLIT, PPD_DVSTR_GET - INTEGER*4 MSG_SET -C - CHARACTER VALUE*255, TYPE*16, PROG*16, STREAM*16, KEY*16 - INTEGER*4 IS, LV, LT, TYPCOD, LP, LS, LK, VALBLK(8) -C -C - ASK(1) = 0 - ASK(2) = 0 - IS = DWC_SYM_SPLIT (SYMBOL,PROG,LP,STREAM,LS,KEY,LK) - IF (IAND(IS,1).NE.0) IS = GP_INI_CLEAR () - IF (IAND(IS,1).EQ.0) GOTO 999 -C -C Get the initial default (if any) -C - its type (1: SPECIFY, 2: program) -C - the ASK switch (from qualifier) -C - IS = PV_DEF_GET (SYMBOL,VALUE,LV,TYPE,LT) - IF (IAND(IS,1).EQ.0) GOTO 999 - IF (LT.GT.0) THEN -C -C -C SPECIFY default present (local/group): -C - if values, convert to value block -C - if qualifier only, use PPD default -C - IF (TYPE(1:1).NE.'p') THEN - TYPCOD = 1 - IS = GP_INI_DECODE (VALUE,STREAM(:LS),.FALSE.,VALBLK,ASK(1)) -C -C If an error occured, just ignore -C -C IF (IAND(IS,1).EQ.0) GOTO 999 - IF (IAND(IS,1).EQ.0) THEN - GP_INI_FILL = MSG_SET (DWC_PARWRDEF,1) - CALL WNCTXT(DWLOG,DWMSG,SYMBOL) - ASK(1)=0 - ASK(2)=0 - VALBLK(1)=0 - ELSE IF (VALBLK(1).EQ.0) THEN - IS = PPD_DVSTR_GET (VALUE,LV) - IF (IAND(IS,1).EQ.0) GOTO 999 - IF (LV.GT.0) THEN - TYPCOD = 2 - IS = GP_INI_DECODE (VALUE,STREAM(:LS), - 1 .TRUE.,VALBLK,ASK(2)) - IF (IAND(IS,1).EQ.0) GOTO 999 - ENDIF - ENDIF -C -C Program default allowed: -C - if there is no PPD default value -C (no default or qualifier only), -C VALBLK will be zero -C - ELSE - TYPCOD = 2 - IS = GP_INI_DECODE (VALUE,STREAM(:LS),.TRUE.,VALBLK,ASK(2)) - IF (IAND(IS,1).EQ.0) GOTO 999 - ENDIF -C -C If a value has been found: store it -C - IF (VALBLK(1).NE.0) IS = GP_INI_PUT (VALBLK,TYPCOD) - ENDIF -C -C - GP_INI_FILL = DWC_SUCCESS - RETURN -C - 999 GP_INI_FILL = MSG_SET (DWC_PARWRDEF,1) - CALL WNCTXT(DWLOG,DWMSG,SYMBOL) - RETURN - END -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - INTEGER*4 FUNCTION GP_INI_DECODE (VALUE,STREAM,SWDV,VALBLK,ASK) -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' -C - CHARACTER*(*) VALUE ! (i) input value string - CHARACTER*(*) STREAM ! (i) stream name (for substitution) - LOGICAL*4 SWDV ! (i) .TRUE. (PPD) or .FALSE. (SPECIFY) - INTEGER*4 VALBLK(8) ! (o) value-block descriptor - INTEGER*4 ASK ! (o) ASK qualifier switch -C -1: /NOASK, 0: not given, 1: /ASK -C -C.Purpose: Process the initial default for a program parameter -C.Returns: Status code (.TRUE. for success, .FALSE. otherwise) -C success DWC_SUCCESS also if no values -C false status codes returned by referenced modules -C.Notes: -C - Evaluate the input string and convert it to a value block. -C - The allowed qualifiers are /(NO)ASK and /(NO)SUBSTITUTE (although -C the latter one will be ignored: substitution is always done). -C - All symbols must be known now. -C - If VALUE does not contain a value, VALBLK will be cleared. -C------------------------------------------------------------------------- -C -C - INTEGER*4 CLI_RESET, CLI_PARSE, CLI_GET - INTEGER*4 DWC_STR_SUBST, DWC_HELP - INTEGER*4 PV_BLK_ALLOC, PV_BLK_DECODE, PV_BLK_RELEASE - INTEGER*4 MSG_SET , CLEAR_BLJ -C - INTEGER*4 NRARG - PARAMETER (NRARG = 3) - CHARACTER*10 NAME(NRARG) - INTEGER*4 ATTR(NRARG) - CHARACTER*1 PROMPT(NRARG) - CHARACTER*1 DEFVAL(NRARG) - DATA NAME /'VALSTR' ,'ASK' ,'SUBSTITUTE' / - DATA ATTR /CLI__EXPRESSION,CLI__QUALIFIER,CLI__QUALIFIER/ - DATA PROMPT /' ' ,' ' ,' ' / - DATA DEFVAL /' ' ,' ' ,' ' / -C - CHARACTER WORK*255, VALSTR*255, DUM*1 - INTEGER*4 IS, LW, LVAL, LD, ERRPTR, DLEVEL - LOGICAL*4 SWSYM - BYTE DEFARR(1) ! dummy -C -C -C Substitute symbols -C - SWSYM = .FALSE. - IS = DWC_STR_SUBST (VALUE,WORK,LW,STREAM,ERRPTR,.FALSE.,SWSYM) - IF (IAND(IS,1).EQ.0) GOTO 991 -C -C If help request (not allowed): return -C - IS = DWC_HELP (WORK(:LW),-1,DLEVEL) - IF (IAND(IS,1).EQ.0) GOTO 999 -C -C Analyse the string -C - reset the Command-Line Interpreter -C - parse the string -C - extract the pure value string -C - IS = CLI_RESET (NRARG,NAME,ATTR,PROMPT,DEFVAL) - IF (IAND(IS,1).NE.0) IS = CLI_PARSE (WORK(:LW)) - IF (IAND(IS,1).NE.0) IS = CLI_GET ('VALSTR',VALSTR,LVAL) - IF (IAND(IS,1).EQ.0) GOTO 999 -C -C Analyse the qualifiers -C - return the ASK qualifier switch -C - ignore any SUBSTITUTE qualifier -C - IS = CLI_GET ('ASK',DUM,LD) - IF (IAND(IS,1).EQ.0) GOTO 999 - IF (IS.EQ.DWC_PRESENT) THEN - ASK = 1 - ELSE IF (IS.EQ.DWC_NEGATED) THEN - ASK = -1 - ELSE - ASK = 0 - ENDIF -C -C Convert value string to value block -C - first allocate memory for the block -C - in case of error: release memory -C - IF (LVAL.GT.0) THEN - IS = PV_BLK_ALLOC (VALSTR(:LVAL),VALBLK) - IF (IAND(IS,1).EQ.0) GOTO 999 -C - IS = PV_BLK_DECODE (VALSTR(:LVAL),VALBLK,STREAM, - 1 .FALSE.,SWSYM,SWDV,DEFARR,0) - IF (IAND(IS,1).EQ.0) THEN - IS = PV_BLK_RELEASE (VALBLK) - GOTO 999 - ENDIF - ELSE - IS = CLEAR_BLJ (VALBLK,8) - ENDIF -C -C - GP_INI_DECODE = DWC_SUCCESS - RETURN -C - 991 GP_INI_DECODE = MSG_SET (DWC_EXPERRMSG,1) - CALL WNCTXT(DWLOG,DWMSG,' ',ERRPTR,WORK(:LW)) - RETURN - 999 GP_INI_DECODE = IS - RETURN - END diff --git a/src/dwarf/gpinp.for b/src/dwarf/gpinp.for deleted file mode 100644 index 09a2fd230bca66bc267b61ba0904e5ac8581893a..0000000000000000000000000000000000000000 --- a/src/dwarf/gpinp.for +++ /dev/null @@ -1,407 +0,0 @@ -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ -C.Ident: GP_INP -C.Keywords: Program Parameters, Get Value, Input -C.Author: Friso Olnon (NFRA, Dwingeloo) -C.Language: DWARF-Fortran -C.Environment: VAX or Alliant -C.Comments: -C.Version: 900416 FMO - recreation -C.Version: 910826 FMO - in case of non-terminal input (DEVCOD=3), abort -C the program if a wrong answer is received -C.Version: 920206 GvD - add former optional arguments to CLI_GET, etc. -C.Version: 940120 CMV - Changed messenger -C 941019 JPH - prefix default with '|'line delimiter -C.Version: 010709 AXC - linux port,tmpchar in string calls -C------------------------------------------------------------------------- -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - INTEGER*4 FUNCTION GP_INP (DEFAULT,LDEF,DLEVEL,DEFARR,NRDEF, - 1 VALBLK,DO_NOASK,DO_SAVE) -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' -C - CHARACTER*(*) DEFAULT ! (i) default string - INTEGER*4 LDEF ! (i) its length - INTEGER*4 DLEVEL ! (m) help-level difference - BYTE DEFARR(*) ! (i) default array - INTEGER*4 NRDEF ! (i) nr of values in DEFARR - INTEGER*4 VALBLK(8) ! (o) value block descriptor - LOGICAL*4 DO_NOASK ! (o) /NOASK given ? - LOGICAL*4 DO_SAVE ! (o) /SAVE given ? -C -C.Purpose: Get user input and convert it to a value block -C.Returns: Status code (.TRUE. for success, .FALSE. otherwise) -C success DWC_SUCCESS also if no value is given -C warning DWC_EOFCTRLZ CTRL/Z or # answer -C fatal DWC_GETINPERR error from DWC_INPUT -C error DWC_PARWRANS parameter input file error (program aborted) -C false status codes returned by referenced routines -C.Notes: -C - VALBLK(1) = 0 means that the user just gave a <return>. -C------------------------------------------------------------------------- -C - INTEGER*4 GP_INP_GET, GP_INP_PARSE, GP_INP_DECODE - INTEGER*4 GP_CTL_RESET - INTEGER DWC_SYSIN_GET, MSG_SET - INTEGER*4 DWC_PROG_GET, DWC_STREAM_GET, DWC_SYM_BUILD - INTEGER*4 PPD_UNAM_GET -C - CHARACTER*255 ANSWER, VALSTR - CHARACTER*16 PROGNAM, STREAM, KEY, ASKKEY, SYMBOL*50 - INTEGER*4 IS, LANS, LVAL, LP, LS, LK, LKMIN, LASK, LSYM - INTEGER DEVCOD - LOGICAL*4 PROTO -C -C - IS = DWC_SYSIN_GET (DEVCOD) - IF (IAND(IS,1).NE.0) IS = DWC_PROG_GET (PROGNAM,LP) - IF (IAND(IS,1).NE.0) IS = DWC_STREAM_GET (STREAM,LS,.FALSE.) - IF (IAND(IS,1).NE.0) IS = PPD_UNAM_GET (KEY,LK,LKMIN,PROTO) - IF (IAND(IS,1).NE.0) IS = DWC_SYM_BUILD - 1 (PROGNAM(:LP),STREAM(:LS),KEY(:LK),SYMBOL,LSYM) - IF (IAND(IS,1).EQ.0) GOTO 999 -C -C Get input from the user -C - 100 DO_NOASK = .FALSE. - DO_SAVE = .FALSE. - IS = GP_INP_GET (SYMBOL(:LSYM),DEFAULT,LDEF,DLEVEL,DEVCOD, - 1 ANSWER,LANS) - IF (IAND(IS,1).EQ.0) GOTO 999 -C -C Parse the answer string -C - substitute symbols -C - if help request: increment help level, -C possibly display full PPD help info, -C and ask again (if possible) -C - analyse any qualifiers -C - IS = GP_INP_PARSE (ANSWER(:LANS),DLEVEL,VALSTR,LVAL,ASKKEY,LASK, - 1 DO_NOASK,DO_SAVE) - IF (IAND(IS,1).EQ.0) THEN - IF (IS.EQ.DWC_KEYVAHELP) GOTO 100 - IS = MSG_SET (DWC_PARWRANS,1) - CALL WNCTXT(DWLOG,DWMSG,KEY(:LK)) - IF (DEVCOD.EQ.3) GOTO 991 - GOTO 100 - ENDIF -C -C Act upon /ASK=keyword and ask again -C - IF (LASK.GT.0) THEN - IS = GP_CTL_RESET (ASKKEY(:LASK)) - IF (IAND(IS,1).EQ.0) THEN - IS = MSG_SET (DWC_PARWRANS,1) - CALL WNCTXT(DWLOG,DWMSG,KEY(:LK)) - IF (DEVCOD.EQ.3) GOTO 991 - GOTO 100 - ENDIF - ENDIF -C -C Convert value string to value block -C - IF (LVAL.GT.0) THEN - IS = GP_INP_DECODE (VALSTR(:LVAL),STREAM(:LS),VALBLK, - 1 DEFARR,NRDEF) - IF (IAND(IS,1).EQ.0) THEN - IS = MSG_SET (DWC_PARWRANS,1) - CALL WNCTXT(DWLOG,DWMSG,KEY(:LK)) - IF (DEVCOD.EQ.3) GOTO 991 - GOTO 100 - ENDIF - ENDIF -C - GP_INP = DWC_SUCCESS - RETURN -C - 991 E_C = DWC_PARWRANS - CALL WNCTXT(DWLOG,'Error in parameter input file') - CALL WNGEX - 999 GP_INP = IS - RETURN - END -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - INTEGER*4 FUNCTION GP_INP_GET (SYMBOL,DEFAULT,LDEF,DLEVEL,DEVCOD, - 1 ANSWER,LANS) -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' -C - CHARACTER*(*) SYMBOL ! (i) full parameter name - CHARACTER*(*) DEFAULT ! (i) default set - INTEGER*4 LDEF ! (i) significant length of DEFAULT - INTEGER*4 DLEVEL ! (i) userlevel difference - INTEGER DEVCOD !(i) input device code - CHARACTER*(*) ANSWER ! (o) value set(s) (and qualifiers) - INTEGER*4 LANS ! (o) significant length of ANSWER -C -C.Purpose: Get new value set(s) for a program parameter from the user -C.Returns: Status code (.TRUE. for success, .FALSE. otherwise) -C success DWC_SUCCESS -C warning DWC_EOFCTRLZ end-of-input (= end-of-loop) -C fatal DWC_GETINPERR I/O error (message holded) -C fatal DWC_KEYWMISM parameter input file error (program aborted) -C false status codes returned by referenced routines -C.Notes: -C - The format of the prompt string depends on the current userlevel, -C but if there is a default set, it will be included. -C -C The user can give several answers: -C - ? to get help (the prompt will be repeated); -C - a value string with or without qualifiers /NOASK and /(NO)SAVELAST; -C - CTRL/Z or # to signal the end of input; -C - /ASK=keyword to force prompting for that program parameter. -C------------------------------------------------------------------------- -C - CHARACTER*(*) BLANK, TAB, EQUAL, UNDERSC, WHITE, EQUALS - PARAMETER (BLANK = ' ' ) - PARAMETER (TAB = ' ') - PARAMETER (EQUAL = '=' ) - PARAMETER (UNDERSC = '_' ) - PARAMETER (WHITE = BLANK//TAB) - PARAMETER (EQUALS = BLANK//EQUAL//BLANK) - INTEGER*4 BELL - LOGICAL*4 SWITCH - PARAMETER (BELL = 1 ) ! sound bell if it is active - PARAMETER (SWITCH = .FALSE.) ! dummy switch -C - INTEGER*4 DWC_SYM_SPLIT - INTEGER*4 DWC_PRCMODE_INQ, DWC_LEVEL_GET - INTEGER*4 PPD_PROMPT, DWC_INPUT - INTEGER*4 STR_COPY, STR_SIGLEN, STR_SKIP_W, STR_CHECK_ANUMX - INTEGER MSG_SET -C - CHARACTER PROMPT*255, WORK*20, PROGNAM*16, STREAM*16, KEY*16 - CHARACTER TMP*80 - INTEGER*4 IS, LPR, LW, LP, LS, LK, PTR - INTEGER*4 CURLEVEL, MAXLEVEL -C -C -C Split the symbol name, get the type -C of input device and the userlevel -C - IS = DWC_SYM_SPLIT (SYMBOL,PROGNAM,LP,STREAM,LS,KEY,LK) - IF (IAND(IS,1).NE.0) IS = DWC_LEVEL_GET (CURLEVEL,MAXLEVEL) - IF (IAND(IS,1).EQ.0) GOTO 999 -C -C Compose the prompt string -C - full symbol name for subprocess -C - keyword only for main process -C - append possible default set -C - IF (IAND(DWC_PRCMODE_INQ('SUBPROCESS'),1) .NE. 0) THEN - IS = PPD_PROMPT (PROGNAM(:LP)//STREAM(:LS)//UNDERSC, - 1 CURLEVEL+DLEVEL,SWITCH,PROMPT,LPR) - ELSE - IS = PPD_PROMPT (BLANK,CURLEVEL+DLEVEL,SWITCH,PROMPT,LPR) - ENDIF - IF (IAND(IS,1).EQ.0) GOTO 999 - TMP=EQUALS//DEFAULT(:LDEF) - IF (LDEF.GT.0) IS = STR_COPY (TMP,PROMPT,LPR) -C -C Ask the user -C - 100 IS = DWC_INPUT (ANSWER,PROMPT(:LPR),LANS,DEVCOD,BELL) - IF (IAND(IS,1).EQ.0) GOTO 999 -C -C Handle a <keyword>=<value> answer -C - check keyword and extract value -C Keyword mismatch: -C - if input from a parameter file, -C abort the program (no correction -C is possible) -C - if input from a terminal (e.g. -C type-ahead), ask again -C - PTR = INDEX (ANSWER(:LANS),EQUAL) - IF (PTR.GT.0) THEN - WORK = ANSWER(:PTR-1) - LW = STR_SIGLEN (WORK) - IF (LW.LE.LK .AND. IAND(STR_CHECK_ANUMX(WORK(:LW)),1).NE.0) THEN - IF (WORK(:LW).NE.KEY(:LK)) THEN - IF (DEVCOD.EQ.3) GOTO 991 - IS = MSG_SET (DWC_KEYWMISM,1) - CALL - 1 WNCTXT(DWLOG,DWMSG,BLANK,WORK(:LW),KEY(:LK)) - GOTO 100 - ENDIF - IS = STR_SKIP_W (WHITE//EQUAL,ANSWER(:LANS),PTR) - ANSWER = ANSWER(PTR:LANS) - LANS = LANS-PTR+1 - ENDIF - ENDIF -C -C - IF (ANSWER.EQ.'#') THEN - GP_INP_GET = DWC_EOFCTRLZ - ELSE - GP_INP_GET = DWC_SUCCESS - ENDIF - RETURN -C -C - 991 E_C = MSG_SET(DWC_KEYWMISM,1) - CALL WNCTXT(DWLOG,DWMSG,' in parameter input file',WORK(:LW),KEY(:LK)) - CALL WNGEX - 999 GP_INP_GET = IS - RETURN - END -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - INTEGER*4 FUNCTION GP_INP_PARSE (ANSWER,DLEVEL,VALSTR,LVAL, - 1 ASKKEY,LASK,DO_NOASK,DO_SAVE) -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' -C - CHARACTER*(*) ANSWER ! (i) value set(s) (and qualifiers) - INTEGER*4 DLEVEL ! (m) userlevel difference - CHARACTER*(*) VALSTR ! (o) value set(s) (without qualifiers) - INTEGER*4 LVAL ! (o) significant length of VALSTR - CHARACTER*(*) ASKKEY ! (o) parameter to be ASK-ed - INTEGER*4 LASK ! (o) significant length of ASKKEY - LOGICAL*4 DO_NOASK ! (o) /NOASK requested ? - LOGICAL*4 DO_SAVE ! (o) SAVE requested ? -C -C.Purpose: Parse the user's input string -C.Returns: Status code (.TRUE. for success, .FALSE. otherwise) -C success DWC_SUCCESS -C warning DWC_KEYVAHELP help request is given -C error status from referenced routines (messages holded) -C.Notes: -C - substitute the symbols between apostrophes; -C - give help if requested (question marks); -C - interprete and remove the qualifiers from the string; -C------------------------------------------------------------------------- -C - INTEGER*4 NRARG, EXPR, QVAL, Q - PARAMETER (NRARG = 3) - PARAMETER (EXPR = CLI__EXPRESSION) - PARAMETER (QVAL = CLI__QUALIFIER+CLI__VALUE) - PARAMETER (Q = CLI__QUALIFIER) -C - INTEGER*4 CLI_RESET, CLI_PARSE, CLI_GET - INTEGER*4 DWC_STREAM_GET, DWC_SAVE_INQ, DWC_STR_SUBST, DWC_HELP - INTEGER MSG_SET -C - CHARACTER*8 NAME(NRARG) - INTEGER*4 ATTR(NRARG) - CHARACTER*1 PROMPT(NRARG) - CHARACTER*1 DEFVAL(NRARG) - DATA NAME /'VALSTR','ASK','SAVELAST'/ - DATA ATTR / EXPR , QVAL, Q / - DATA PROMPT /' ' ,' ' ,' ' / - DATA DEFVAL /' ' ,' ' ,' ' / -C - CHARACTER STREAM*16, DUM*1 - INTEGER*4 IS, LS, LD, ERRPTR - LOGICAL*4 SWSYM -C -C -C Substitute symbols -C (no unknown symbols allowed) -C - SWSYM = .FALSE. - IS = DWC_STREAM_GET (STREAM,LS,.FALSE.) - IF (IAND(IS,1).EQ.0) GOTO 999 - IS = DWC_STR_SUBST (ANSWER,VALSTR,LVAL,STREAM(:LS),ERRPTR, - 1 .FALSE.,SWSYM) - IF (IAND(IS,1).EQ.0) GOTO 991 -C -C If help request: -C - increment help level with nr of -C question marks given (only for this -C GET_PARM unless /HOLD was added) -C - print PPD help if helplevel > beginner -C - return with warning status -C - IS = DWC_HELP (VALSTR(:LVAL),0,DLEVEL) - IF (IAND(IS,1).EQ.0) GOTO 999 -C -C Analyse the string -C - reset the Command-Line Interpreter -C - parse the string -C - extract the pure value string -C - IS = CLI_RESET (NRARG,NAME,ATTR,PROMPT,DEFVAL) - IF (IAND(IS,1).NE.0) IS = CLI_PARSE (VALSTR(:LVAL)) - IF (IAND(IS,1).NE.0) IS = CLI_GET ('VALSTR',VALSTR,LVAL) - IF (IAND(IS,1).EQ.0) GOTO 999 -C -C Analyse the qualifiers -C - if /ASK=<keyword> is given: return -C (no value specification is allowed) -C - otherwise: set NOASK and SAVE flags -C - IS = CLI_GET ('ASK',ASKKEY,LASK) - IF (IAND(IS,1).EQ.0) GOTO 999 - IF (IS.EQ.DWC_PRESENT) THEN - IF (LVAL.GT.0) GOTO 992 ! no value allowed - ELSE - DO_NOASK = IS.EQ.DWC_NEGATED - IS = CLI_GET ('SAVELAST',DUM,LD) - IF (IAND(IS,1).EQ.0) GOTO 999 - DO_SAVE = IS.EQ.DWC_PRESENT .OR. - 1 (IS.EQ.DWC_ABSENT .AND. IAND(DWC_SAVE_INQ(),1).NE.0) - ENDIF -C -C - GP_INP_PARSE = DWC_SUCCESS - RETURN -C - 991 GP_INP_PARSE = MSG_SET (DWC_EXPERRMSG,1) - CALL WNCTXT(DWLOG,DWMSG,' ',ERRPTR,VALSTR(:LVAL)) - RETURN - 992 GP_INP_PARSE = MSG_SET (DWC_NOVALALL,1) - CALL WNCTXT(DWLOG,DWMSG,'ASK') - RETURN - 999 GP_INP_PARSE = IS - RETURN - END -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - INTEGER*4 FUNCTION GP_INP_DECODE (VALSTR,STREAM,VALBLK, - 1 DEFARR,NRDEF) -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' -C - CHARACTER*(*) VALSTR ! (i) value string - CHARACTER*(*) STREAM ! (i) stream name (for substitution) - INTEGER*4 VALBLK(8) ! (i) value block descriptor - BYTE DEFARR(*) ! (i) default array - INTEGER*4 NRDEF ! (i) nr of values in DEFARR -C -C.Purpose: Analyse the value string and convert to a value block -C.Returns: Status code (.TRUE. for success, .FALSE. otherwise) -C success DWC_SUCCESS -C false status codes returned by referenced routines -C.Notes: -C------------------------------------------------------------------------- -C - INTEGER*4 PV_BLK_ALLOC, PV_BLK_DECODE, PV_BLK_RELEASE -C - INTEGER*4 IS - LOGICAL*4 SWSYM -C -C -C Check and convert the value to an array -C - no unknown symbols allowed -C - IS = PV_BLK_ALLOC (VALSTR,VALBLK) - IF (IAND(IS,1).EQ.0) GOTO 999 - IF (VALBLK(1).NE.0) THEN - SWSYM = .FALSE. - IS = PV_BLK_DECODE (VALSTR,VALBLK,STREAM,.FALSE.,SWSYM, - 1 .FALSE.,DEFARR,NRDEF) - IF (IAND(IS,1).EQ.0) GOTO 991 - ENDIF -C - GP_INP_DECODE = DWC_SUCCESS - RETURN -C - 991 GP_INP_DECODE = IS - IS = PV_BLK_RELEASE (VALBLK) - RETURN -C - 999 GP_INP_DECODE = IS - RETURN - END diff --git a/src/dwarf/gploop.for b/src/dwarf/gploop.for deleted file mode 100644 index c20429033c295e311b1f0001e57398dbfa7b4955..0000000000000000000000000000000000000000 --- a/src/dwarf/gploop.for +++ /dev/null @@ -1,109 +0,0 @@ -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ -C.Ident: GP_LOOP -C.Keywords: Program Parameters, Get Value, Loop Control -C.Author: Friso Olnon (NFRA, Dwingeloo) -C.Language: DWARF-Fortran -C.Environment: VAX or Alliant -C.Comments: -C Common fields used: -C INTEGER*4 PARM$LOOP ! (m) loop switch -C -C - PARM$LOOP = 0 for parameters without the LOOP attribute (always). -C - PARM$LOOP = 2 initially for a LOOP parameter. The next GET_PARM -C will return the first of the available value sets. -C - PARM$LOOP = 1 once the program has started using the values sets. -C When the sets are exhausted, the switch is reset to 2 and -C GET_PARM will return with the warning status DWC_ENDOFLOOP. -C -C.Version: 900322 FMO - combined pieces of old routines -C------------------------------------------------------------------------- -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - INTEGER*4 FUNCTION GP_LOOP_INIT () -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' -C -C -C.Purpose: Initialize the LOOP switch -C.Returns: Status code (.TRUE. for success, .FALSE. otherwise) -C success DWC_SUCCESS -C.Notes: -C------------------------------------------------------------------------- -C - INCLUDE 'PARM_6_DEF' -C - INTEGER*4 PPD_AMAS_GET -C - PARM$LOOP = 0 - IF (IAND(PPD_AMAS_GET('LOOP'),1) .NE. 0) PARM$LOOP = 2 -C - GP_LOOP_INIT = DWC_SUCCESS - RETURN - END -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - INTEGER*4 FUNCTION GP_LOOP_SWITCH () -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' -C -C -C.Purpose: Flip the LOOP switch for a parameter with the LOOP attribute -C.Returns: Status code (.TRUE. for success, .FALSE. otherwise) -C success DWC_SUCCESS also if no LOOP attribute -C warning DWC_EOFCTRLZ end-of-loop signal -C.Notes: -C------------------------------------------------------------------------- -C - INCLUDE 'PARM_6_DEF' -C -C - IF (PARM$LOOP.EQ.0) THEN - GP_LOOP_SWITCH = DWC_SUCCESS - ELSE IF (PARM$LOOP.EQ.1) THEN - GP_LOOP_SWITCH = DWC_EOFCTRLZ - PARM$LOOP = 2 - ELSE - GP_LOOP_SWITCH = DWC_SUCCESS - PARM$LOOP = 1 - ENDIF -C - RETURN - END -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - INTEGER*4 FUNCTION GP_LOOP_SET () -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' -C -C -C.Purpose: Set the LOOP switch for parameter with LOOP attribute -C.Returns: Status code (.TRUE. for success, .FALSE. otherwise) -C success DWC_SUCCESS -C.Notes: -C------------------------------------------------------------------------- -C - INCLUDE 'PARM_6_DEF' -C - IF (PARM$LOOP.GT.0) PARM$LOOP = 1 - GP_LOOP_SET = DWC_SUCCESS - RETURN - END -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - INTEGER*4 FUNCTION GP_LOOP_RESET () -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' -C -C -C.Purpose: Reset the LOOP switch to its initial condition -C.Returns: Status code (.TRUE. for success, .FALSE. otherwise) -C success DWC_SUCCESS -C.Notes: -C------------------------------------------------------------------------- -C - INCLUDE 'PARM_6_DEF' -C - IF (PARM$LOOP.GT.0) PARM$LOOP = 2 - GP_LOOP_RESET = DWC_SUCCESS - RETURN - END diff --git a/src/dwarf/gpsav.for b/src/dwarf/gpsav.for deleted file mode 100644 index b6af446840b160382b7fc181c7954d76f97106bc..0000000000000000000000000000000000000000 --- a/src/dwarf/gpsav.for +++ /dev/null @@ -1,164 +0,0 @@ -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ -C.Ident: GP_SAV -C.Keywords: Program Parameters, Get Value, Save -C.Author: Friso Olnon (NFRA, Dwingeloo) -C.Language: DWARF-Fortran -C.Environment: VAX or Alliant -C.Comments: -C Common fields used: -C INTEGER*4 PARM$SAVADR ! (m) address of save buffer in VM -C INTEGER*4 PARM$SAVLEN ! (m) significant length of save buffer -C -C.Version: 900412 FMO - combined parts of old routines -C.Version: 920214 GvD - no optional arguments in MSG anymore -C.Version: 940120 CMV - use WNGGVM i.s.o. GEN_GET_VM, indirect addressing -C.Version: 010709 AXC - linux port - parameter changes -C------------------------------------------------------------------------- -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - INTEGER*4 FUNCTION GP_SAV_INIT () -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' - INCLUDE 'PARM_6_DEF' -C -C -C.Purpose: Initialize the SAVE control fields -C.Returns: Status code (.TRUE. for success, .FALSE. otherwise) -C success DWC_SUCCESS -C.Notes: -C------------------------------------------------------------------------- -C -C - PARM$SAVLEN = 0 - PARM$SAVADR = 0 -C - GP_SAV_INIT = DWC_SUCCESS - RETURN - END -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - INTEGER*4 FUNCTION GP_SAV_SWITCH (SWITCH) -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' - INCLUDE 'PARM_6_DEF' -C - LOGICAL*4 SWITCH ! (i) switch ON or OFF -C -C.Purpose: Switch SAVE actions ON or OFF -C.Returns: Status code (.TRUE. for success, .FALSE. otherwise) -C success DWC_SUCCESS -C false status from GEN_GET_VM -C.Notes: -C - If necessary, virtual memory will be allocated. -C------------------------------------------------------------------------- -C - INTEGER MSG_SET - LOGICAL WNGGVM -C - INTEGER*4 IS -C -C -C PARM$SAVADR = 0: no SAVE buffer yet -C PARM$SAVLEN < 0: SAVE currently OFF -C PARM$SAVLEN > 0: SAVE currently ON -C - PARM$SAVLEN = ABS (PARM$SAVLEN) - IF (SWITCH) THEN - IF (PARM$SAVADR.EQ.0) THEN - IF (.NOT.WNGGVM(PARM__LENVS,PARM$SAVADR)) GOTO 999 - PARM$SAVLEN = 0 - ENDIF - ELSE - PARM$SAVLEN = -PARM$SAVLEN - ENDIF -C - GP_SAV_SWITCH = DWC_SUCCESS - RETURN -C - 999 GP_SAV_SWITCH = MSG_SET (DWC_PPDNOVIRT,1) - CALL WNCTXT(DWLOG,DWMSG,PARM__LENVS) - RETURN - END -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - INTEGER*4 FUNCTION GP_SAV_WRITE (VALUE,LV) -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' - INCLUDE 'PARM_6_DEF' -C - CHARACTER*(*) VALUE ! (i) value string - INTEGER*4 LV ! (i) significant length of string -C -C.Purpose: Save value string if SAVE is active -C.Returns: Status code (.TRUE. for success, .FALSE. otherwise) -C success DWC_SUCCESS -C fatal DWC_SAVEOVFLO save-string overflow -C.Notes: -C------------------------------------------------------------------------- -C -C - BYTE SEPAR -C - INTEGER MSG_SET, MOVE_BLB -C - INTEGER*4 IS -C - SEPAR = ICHAR(';') -C -C If SAVELAST active: save string value -C - IF (PARM$SAVADR.NE.0 .AND. PARM$SAVLEN.GE.0) THEN - IF (PARM$SAVLEN+LV+1.GT.PARM__LENVS) GOTO 999 - IF (PARM$SAVLEN.NE.0) THEN - IS = MOVE_BLB (SEPAR, - 1 A_B(PARM$SAVADR+PARM$SAVLEN-A_OB),1) - PARM$SAVLEN = PARM$SAVLEN+1 - ENDIF - IS = MOVE_BLB (%REF(VALUE), - 1 A_B(PARM$SAVADR+PARM$SAVLEN-A_OB),LV) - PARM$SAVLEN = PARM$SAVLEN+LV - ENDIF -C -C - GP_SAV_WRITE = DWC_SUCCESS - RETURN -C - 999 GP_SAV_WRITE = MSG_SET (DWC_SAVEOVFLO,0) - RETURN - END -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - INTEGER*4 FUNCTION GP_SAV_DEFINE (SYMBOL,PKEY) -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' - INCLUDE 'PARM_6_DEF' -C - CHARACTER*(*) SYMBOL ! (i) name of the symbol - CHARACTER*(*) PKEY ! (i) program's parameter name -C -C.Purpose: Define the SAVE symbol for a program parameter -C.Returns: Status code (.TRUE. for success, .FALSE. otherwise) -C success DWC_SUCCESS -C.Notes: -C------------------------------------------------------------------------- -C -C - INTEGER SYMBOL_DEFINE, MOVE_BLB, MSG_SET -C - CHARACTER*255 VALUE - INTEGER*4 IS, LV -C -C - IF (PARM$SAVLEN.NE.0) THEN - LV = ABS (PARM$SAVLEN) - IS = MOVE_BLB (A_B(PARM$SAVADR-A_OB),%REF(VALUE),LV) - IS = SYMBOL_DEFINE (SYMBOL,VALUE(:LV),DWC__GLOBALSYM) - IF (IAND(IS,1).EQ.0) THEN - IS = MSG_SET (DWC_PARAMERR,1) - CALL WNCTXT(DWLOG,PKEY) - END IF - ENDIF -C - GP_SAV_DEFINE = DWC_SUCCESS - RETURN - END diff --git a/src/dwarf/gpval.for b/src/dwarf/gpval.for deleted file mode 100644 index b7f406badc41dda420dad092e51ea0a9165b82e1..0000000000000000000000000000000000000000 --- a/src/dwarf/gpval.for +++ /dev/null @@ -1,458 +0,0 @@ -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ -C.Ident: GP_VAL -C.Keywords: Program Parameters, Get Value, VAL Block -C.Author: Friso Olnon (NFRA, Dwingeloo) -C. WNB 920918 Changed test on ADYN to NE iso GT -C.Language: DWARF-Fortran -C.Environment: VAX or Alliant -C.Comments: -C Common fields used: -C INTEGER*4 PARM$VALLDYN ! (m) length of VM block (all sets) -C INTEGER*4 PARM$VALADYN ! (m) address of VM block -C INTEGER*4 PARM$VALAVAL ! (m) address of value part -C INTEGER*4 PARM$VALASW ! (m) address of switches part -C INTEGER*4 PARM$VALNRS ! (m) nr of sets -C INTEGER*4 PARM$VALVPS ! (m) reserved nr of values per set -C INTEGER*4 PARM$VALSNR ! (m) current set nr -C INTEGER*4 PARM$VALPTR ! (m) pointer to current value -C INTEGER*4 PARM$VALCNT ! (m) counter for TOBY format -C -C.Version: 900416 FMO - recreation -C.Version: 911213 GvD - clear VALBLK(1) at beginning of GP_VAL_FILL -C was wrong when multiple defaults and /ASK -C.Version: 920122 GvD - also clear VALBLK(1) before asking; otherwise -C same block is owned by VAL and DEF -C - pass .FALSE. to GP_VAL_PUT if default is used -C.Version: 920214 GvD - no optional arguments in MSG anymore -C.Version: 920513 GvD - TOBY not allowed for logicals -C.Version: 940120 CMV - use WNGGVM i.s.o. GEN_GET_VM, indirect addressing -C------------------------------------------------------------------------- -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - INTEGER*4 FUNCTION GP_VAL () -C ENTRY GP_VAL_CLEAR () -C ENTRY GP_VAL_RELEASE () -C ENTRY GP_VAL_PUT (VALBLK,IS_OWNER) -C ENTRY GP_VAL_GET (VALBLK,IS_OWNER,IS_FILLED) -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' - INCLUDE 'PARM_6_DEF' -C - INTEGER*4 GP_VAL_CLEAR, GP_VAL_RELEASE, GP_VAL_PUT, GP_VAL_GET -C - INTEGER*4 VALBLK(8) ! (i/o) description of value block - LOGICAL*4 IS_OWNER ! (i/o) block owned by this module ? - LOGICAL*4 IS_FILLED ! (o) any value in block ? -C -C.Purpose: Manipulate the description of the value block -C.Returns: Status code (.TRUE. for success, .FALSE. otherwise) -C success DWC_SUCCESS -C false status codes returned by referenced routines -C.Notes: -C - CLEAR clears the value block descriptor. -C - RELEASE releases the memoryoccupied by the value block (provided -C that this module "owns" the block) and clears the descriptor. -C - PUT copies a value-block descriptor into the value block descriptor, -C does or doesn't make this module the block "owner", and resets the -C pointers to zero. -C - GET returns the block descriptor and tells whether the block is owned -C by this module and whether it contains any value. -C------------------------------------------------------------------------- -C - INTEGER*4 SCALAR_BIT, TOBY_BIT - PARAMETER (SCALAR_BIT = 0) - PARAMETER (TOBY_BIT = 1) -C - INTEGER*4 PPD_DTYPE_GET, PPD_NVAL_GET, PPD_AMAS_GET - INTEGER*4 CLEAR_BLJ, MOVE_BLJ - LOGICAL WNGFVM -C - CHARACTER*1 DTYPE - INTEGER*4 IS, NVAL, MNVAL, MXVAL - LOGICAL TMP -C -C - GP_VAL = DWC_SUCCESS - RETURN -C -C ================== - ENTRY GP_VAL_CLEAR () -C ================== -C - IS = CLEAR_BLJ (PARM$VALLDYN,9) -C - GP_VAL_CLEAR = DWC_SUCCESS - RETURN -C -C ==================== - ENTRY GP_VAL_RELEASE () -C ==================== -C - IF (PARM$VALLDYN.NE.0) - 1 TMP = WNGFVM(PARM$VALLDYN,PARM$VALADYN) - IS = CLEAR_BLJ (PARM$VALLDYN,9) -C - GP_VAL_RELEASE = DWC_SUCCESS - RETURN -C -C ================ - ENTRY GP_VAL_PUT (VALBLK,IS_OWNER) -C ================ -C - IS = MOVE_BLJ (VALBLK,PARM$VALLDYN,6) - IF (.NOT.IS_OWNER) PARM$VALLDYN = 0 - PARM$VALSNR = 0 ! current set nr - PARM$VALPTR = 0 ! current value nr - PARM$VALCNT = 0 ! TOBY counter -C - GP_VAL_PUT = DWC_SUCCESS - RETURN -C -C ================ - ENTRY GP_VAL_GET (VALBLK,IS_OWNER,IS_FILLED) -C ================ -C - IS = MOVE_BLJ (PARM$VALLDYN,VALBLK,6) - IF (IAND(IS,1).NE.0) IS = PPD_DTYPE_GET (DTYPE,VALBLK(7)) - IF (IAND(IS,1).NE.0) IS = PPD_NVAL_GET (NVAL,MNVAL,MXVAL) - IF (IAND(IS,1).EQ.0) GOTO 999 - VALBLK(8) = 0 - IF (NVAL.EQ.1) - 1 VALBLK(8) = IBSET (VALBLK(8),SCALAR_BIT) - IF (DTYPE.NE.'C' .AND. DTYPE.NE.'L' - 1 .AND. IAND(PPD_AMAS_GET('VECTOR'),1) .EQ. 0) - 2 VALBLK(8) = IBSET (VALBLK(8),TOBY_BIT) - IS_OWNER = PARM$VALLDYN.NE.0 - IS_FILLED = PARM$VALADYN.NE.0 !!920918 -C - GP_VAL_GET = DWC_SUCCESS - RETURN -C - 999 GP_VAL_GET = IS - RETURN - END -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - INTEGER*4 FUNCTION GP_VAL_READ_N (ARRAY,NR,VALUE,LV) -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' - INCLUDE 'PARM_6_DEF' -C - BYTE ARRAY(*) ! (o) numerical value array - INTEGER*4 NR ! (o) nr of filled elements in array - CHARACTER*(*) VALUE ! (o) value string - INTEGER*4 LV ! (o) significant length of string -C -C.Purpose: Read the next value set from the numerical value block -C.Returns: Status code (.TRUE. for success, .FALSE. otherwise) -C success DWC_SUCCESS -C success DWC_WILDCARD wildcard value (also NR = -1 on return) -C success DWC_NULLVALUE null value (also NR = 0 on return) -C warning 0 end of value block reached -C warning DWC_ENDOFLOOP value is end-of-loop signal -C false status codes returned by referenced routines -C.Notes: -C - The pointers will be updated. -C------------------------------------------------------------------------- -C - INTEGER*4 GP_VAL_GET, PV_BLK_READ -C - INTEGER*4 IS, VALBLK(8) - LOGICAL*4 IS_OWNER, IS_FILLED -C -C - IS = GP_VAL_GET (VALBLK,IS_OWNER,IS_FILLED) - IF (IAND(IS,1).EQ.0) GOTO 999 - IS = 0 - IF (IS_FILLED) IS = PV_BLK_READ (VALBLK,PARM$VALSNR,PARM$VALPTR, - 1 PARM$VALCNT,ARRAY,NR,.FALSE.,VALUE,LV) -C -C Value set found: -C - set status codes for special sets -C - IF (IAND(IS,1).NE.0) THEN - IF (NR.EQ.PARM__NULL) THEN !0 - IS = DWC_NULLVALUE - ELSE IF (NR.EQ.PARM__WILD) THEN !-1 - IS = DWC_WILDCARD - ELSE IF (NR.EQ.PARM__EOF) THEN !-2 - IS = DWC_ENDOFLOOP - ELSE - IS = DWC_SUCCESS - ENDIF - ENDIF -C - 999 GP_VAL_READ_N = IS - RETURN - END -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - INTEGER*4 FUNCTION GP_VAL_READ_C (ARRAY,NR,VALUE,LV) -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' - INCLUDE 'PARM_6_DEF' -C - CHARACTER*(*) ARRAY(*) ! (o) character-type value array - INTEGER*4 NR ! (o) nr of filled elements in array - CHARACTER*(*) VALUE ! (o) value string - INTEGER*4 LV ! (o) significant length of string -C -C.Purpose: Read the next value set from the character-type value block -C.Returns: Status code (.TRUE. for success, .FALSE. otherwise) -C success DWC_SUCCESS -C success DWC_WILDCARD wildcard value (also NR = -1 on return) -C success DWC_NULLVALUE null value (also NR = 0 on return) -C warning 0 end of value block reached -C warning DWC_ENDOFLOOP value is end-of-loop signal -C false status codes returned by referenced routines -C.Notes: -C - The pointers will be updated. -C------------------------------------------------------------------------- -C - CHARACTER*(*) BLANK - PARAMETER (BLANK = ' ') -C - INTEGER*4 GP_VAL_GET, PV_BLK_READ - INTEGER MOVE_BLB, MSG_SET - LOGICAL WNGGVM, WNGFVM -C - INTEGER*4 IS, OFF, VALBLK(8), ADDRESS - LOGICAL*4 IS_OWNER, IS_FILLED - LOGICAL TMP -C -C - ADDRESS = 0 - IS = GP_VAL_GET (VALBLK,IS_OWNER,IS_FILLED) - IF (IAND(IS,1).EQ.0) GOTO 999 - IS = 0 - IF (IS_FILLED) THEN - IF (.NOT.WNGGVM(VALBLK(6)*VALBLK(7),ADDRESS)) - 1 GOTO 991 ! set buffer - IS = PV_BLK_READ (VALBLK,PARM$VALSNR,PARM$VALPTR,PARM$VALCNT, - 1 A_B(ADDRESS-A_OB),NR,.FALSE.,VALUE,LV) - ENDIF -C -C Value set found: -C - set status codes for special sets -C - copy blank-filled to output array -C - IF (IAND(IS,1).NE.0) THEN - IF (NR.EQ.PARM__NULL) THEN !0 - IS = DWC_NULLVALUE - ELSE IF (NR.EQ.PARM__WILD) THEN !-1 - IS = DWC_WILDCARD - ELSE IF (NR.EQ.PARM__EOF) THEN !-2 - IS = DWC_ENDOFLOOP - ELSE - OFF = 0 - DO I = 1,NR - ARRAY(I) = BLANK - IS = MOVE_BLB (A_B(ADDRESS+OFF-A_OB), - 1 %REF(ARRAY(I)),VALBLK(7)) - IF (IAND(IS,1).EQ.0) GOTO 999 - OFF = OFF+VALBLK(7) - ENDDO - IS = DWC_SUCCESS - ENDIF - ENDIF -C - 999 GP_VAL_READ_C = IS - IF (ADDRESS.NE.0) TMP=WNGFVM(VALBLK(6)*VALBLK(7),ADDRESS) - RETURN - 991 GP_VAL_READ_C = MSG_SET (DWC_PPDNOVIRT,1) - CALL WNCTXT(DWLOG,DWMSG,VALBLK(6)*VALBLK(7)) - RETURN - END -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - INTEGER*4 FUNCTION GP_VAL_FILL (DEFSTR,LDEF,FLAGS) -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' -C - CHARACTER*(*) DEFSTR ! (i) default value (standard string) - INTEGER*4 LDEF ! (i) significant length of DEFSTR - INTEGER*4 FLAGS ! (i) flags to control GET_PARM -C -C.Purpose: Fill the parameter's value block -C.Returns: Status code (.TRUE. for success, .FALSE. otherwise) -C success DWC_SUCCESS -C warning DWC_ENDOFLOOP end-of-loop -C false status codes returned by referenced routines -C.Notes: -C Possible flags: -C PARM__OVERRIDE program default overrides the SPECIFY value -C -C The new value sets can come from the initial-default sets (EXE block), -C the terminal or the program default. They will be stored in the -C VAL block. -C -C If the value sets must come from the terminal, GP_VAL_FILL will prompt -C the user with the current default set (if available). Per prompt the -C next default set will be used. -C -C The user can give several answers: -C - CTRL/Z or # means end-of-loop -C - a value string, which will be checked and converted -C - qualifiers /NOASK or /(NO)SAVELAST -C - /ASK=keyword to reset the ASK switch for another keyword -C - ? to ask for help information -C -C If GP_VAL_FILL does not prompt, it will return the status end-of-loop -C for parameters with the LOOP attribute in the PPD file when the value -C sets are exhausted. The next time the value sets will be returned. -C -C GP_VAL_FILL also (de-)activates SAVE according to the user's SAVE -C qualifier (or DWARF's control parameter SAVE). -C------------------------------------------------------------------------- -C - CHARACTER*(*) BLANK - INTEGER*4 OFF, USER - PARAMETER (OFF = -1) - PARAMETER (USER = 2) - PARAMETER (BLANK = ' ') -C - INTEGER*4 GP_ASK_SET, GP_ASK_INQ - INTEGER*4 GP_DEF_FILL, GP_DEF_GET, GP_DEF1_GET, GP_DEF_READ - INTEGER*4 GP_DEF_CLEAR, GP_DEF_RELEASE - INTEGER*4 GP_INI_PUT - INTEGER*4 GP_INP - INTEGER*4 GP_LOOP_SWITCH, GP_LOOP_SET - INTEGER*4 GP_SAV_SWITCH - INTEGER*4 GP_VAL_PUT, GP_VAL_RELEASE - INTEGER*4 PV_DEF_DECODE - INTEGER*4 PPD_UNAM_GET - INTEGER MSG_SET -C - CHARACTER DEFAULT*255, KEY*16 - INTEGER*4 IS, LDEF1, LK, LKMIN, DLEVEL, DEFADR, NRDEF, VALBLK(8) - LOGICAL*4 DO_ASK, DO_NOASK, DO_SAVE - LOGICAL*4 IS_OWNER, IS_FILLED, PROTO -C -C -C Set up -C - free VAL block if still in use -C - must the user be asked ? -C - get the single-default-set buffer -C - VALBLK(1) = 0 - IS = GP_VAL_RELEASE () - IF (IAND(IS,1).NE.0) IS = GP_ASK_INQ (DO_ASK) - IF (IAND(IS,1).NE.0) IS = GP_DEF1_GET (DEFADR) - IF (IAND(IS,1).EQ.0) GOTO 999 -C -C Get next value set from the default -C (both as an array and as a string) -C - DEFARR may still be in TOBY format, -C so it cannot be used directly when -C the default should be returned ! -C - 100 IS = GP_DEF_READ (A_B(DEFADR-A_OB),NRDEF,DEFAULT,LDEF1) - IF (IAND(IS,1).EQ.0) THEN - IF (IS.NE.0) GOTO 999 -C -C No more defaults: -C - try get new ones (if none, it is OK) -C - refresh ask switch and buffer address -C - IS = GP_DEF_FILL (DEFSTR,LDEF,FLAGS) - IF (IAND(IS,1).NE.0) IS = GP_ASK_INQ (DO_ASK) - IF (IAND(IS,1).NE.0) IS = GP_DEF1_GET (DEFADR) - IF (IAND(IS,1).EQ.0) GOTO 999 -C -C If we have to ask the user: -C - if there is a default: get a set -C - otherwise: set blank default string -C - IF (DO_ASK) THEN - IS = GP_DEF_GET (VALBLK,IS_OWNER,IS_FILLED) - IF (IAND(IS,1).EQ.0) GOTO 999 - IF (IS_FILLED) GOTO 100 - DEFAULT = BLANK - LDEF1 = 0 -C -C If we don't have to ask: -C - if end-of-loop condition: -C release default block and set status -C - otherwise: -C move default to value block -C - anyway: return -C - ELSE - IS = GP_LOOP_SWITCH () - IF (IS.EQ.DWC_EOFCTRLZ) THEN - IS = GP_DEF_RELEASE () - IF (IAND(IS,1).NE.0) GOTO 990 - ELSE IF (IAND(IS,1).NE.0) THEN - IS = GP_DEF_GET (VALBLK,IS_OWNER,IS_FILLED) - IF (IAND(IS,1).NE.0) - 1 IS = GP_VAL_PUT (VALBLK,.FALSE.) - IF (IAND(IS,1).NE.0) IS = GP_DEF_CLEAR () - IF (IAND(IS,1).NE.0) GOTO 900 - ENDIF - GOTO 999 - ENDIF - ENDIF -C -C Get input from the user -C - check and convert the input string -C - store the data in a value block -C - possibly return end-of-loop status -C - DO_NOASK = .FALSE. - DO_SAVE = .FALSE. - DLEVEL = 0 - VALBLK(1) = 0 - 200 IF (DO_ASK) THEN - IS = GP_INP (DEFAULT,LDEF1,DLEVEL, - 1 A_B(DEFADR-A_OB),NRDEF, - 1 VALBLK,DO_NOASK,DO_SAVE) - IF (IS.EQ.DWC_EOFCTRLZ) GOTO 990 - IF (IAND(IS,1).EQ.0) GOTO 999 - ENDIF -C -C If no value given: take default -C - if there is none, repeat ask -C - otherwise, decode the default -C - IF (VALBLK(1).EQ.0) THEN - IF (LDEF1.EQ.0) THEN - IS = PPD_UNAM_GET (KEY,LK,LKMIN,PROTO) - IS = MSG_SET (DWC_PARGIVVAL,1) - CALL WNCTXT(DWLOG,DWMSG,KEY(:LK)) - DO_ASK = .TRUE. - GOTO 200 - ENDIF - IS = PV_DEF_DECODE (DEFAULT,LDEF1,VALBLK) - IF (IAND(IS,1).EQ.0) GOTO 999 - ENDIF -C -C If /NOASK given: -C - store data in EXE and VAL blocks -C - suppress further asking -C - set loop switch to "value given" -C Otherwise: -C - store data in the VAL block -C - IF (DO_NOASK) THEN - IS = GP_INI_PUT (VALBLK,1) ! mimic SPECIFY type - IF (IAND(IS,1).NE.0) IS = GP_VAL_PUT (VALBLK,.FALSE.)! EXE is owner - IF (IAND(IS,1).NE.0) IS = GP_ASK_SET (OFF,USER) ! user said NOASK - IF (IAND(IS,1).NE.0) IS = GP_LOOP_SET () - ELSE - IS = GP_VAL_PUT (VALBLK,.TRUE.) ! VAL is owner - ENDIF - IF (IAND(IS,1).EQ.0) GOTO 999 -C -C Activate or de-activate SAVE actions -C - IS = GP_SAV_SWITCH (DO_SAVE) - IF (IAND(IS,1).EQ.0) GOTO 999 -C -C - 900 GP_VAL_FILL = DWC_SUCCESS - RETURN - 990 GP_VAL_FILL = DWC_ENDOFLOOP - RETURN - 999 GP_VAL_FILL = IS - RETURN - END diff --git a/src/dwarf/initdw.for b/src/dwarf/initdw.for deleted file mode 100644 index f8ae32a60a48dc3d6133c8264751f3a8583cd6bf..0000000000000000000000000000000000000000 --- a/src/dwarf/initdw.for +++ /dev/null @@ -1,88 +0,0 @@ -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ -C.Ident: SYS_INITDW -C.Keywords: Initializing, Program Parameters, Specify -C.Author: Ger van Diepen (NFRA, Dwingeloo) -C.Language: Fortran -C.Environment: Any -C.Comments: -C.Version: 911126 GvD - creation -C.Version: 920212 GvD - change calls to MSG-routines -C.Version: 940121 CMV - changed messenger -C------------------------------------------------------------------------- -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - SUBROUTINE INITDW -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' -C -C -C.Purpose: Define initial DWARF parameters as <ident>+<ibmode> -C.Returns: Not applicable -C.Notes: -C - Parameter: -C [ident]+[ibmode] -C - Qualifiers: -C------------------------------------------------------------------------- -C - CHARACTER*(*) PROGRAM - PARAMETER (PROGRAM = 'INITDW') -C - INTEGER NRARG, PREQ - PARAMETER (NRARG = 1) - PARAMETER (PREQ = CLI__PARAMETER+CLI__REQUIRED+CLI__DEFAULT) - CHARACTER*10 NAME(NRARG) - INTEGER ATTR(NRARG) - CHARACTER*14 PROMPT(NRARG) - CHARACTER*15 DEFVAL(NRARG) - DATA NAME /'IDIB'/ - DATA ATTR /PREQ/ - DATA PROMPT /'Ident/Ibmode'/ - DATA DEFVAL /'XYZ+INTERACTIVE'/ -C - INTEGER SYMBOL_DEFINE - INTEGER CLI_INIT, CLI_GET - INTEGER DWC_CTL_OPEN, DWC_CTL_FILL - INTEGER MSG_INIT, MSG_SET - INTEGER SYMBOL_EXIT -C - INTEGER IS, LPS - CHARACTER IDIB*32 -C -C -C -C Initialize -C - get DWARF control variables -C - start messenger -C - initialize command-line interpreter -C - IS = DWC_CTL_OPEN () - IF (IAND(IS,1).EQ.0) IS = DWC_CTL_FILL () - IF (IAND(IS,1).NE.0) IS = MSG_INIT (PROGRAM,F_T) - IF (IAND(IS,1).NE.0) IS = CLI_INIT (NRARG,NAME,ATTR,PROMPT,DEFVAL) - IF (IAND(IS,1).EQ.0) GOTO 999 -C -C Get ident and ibmode -C - IS = CLI_GET ('IDIB',IDIB,LPS) - IF (IAND(IS,1).EQ.0) GOTO 999 -C -C Define ident if given -C (can be max 3 characters) - I = INDEX (IDIB,'+') - IF (I.EQ.0) I = 1+LPS - IF (I.GT.1) THEN - IS = SYMBOL_DEFINE ('DWARF$0_IDENT', IDIB(:MIN(3,I-1)), 0) - ENDIF -C -C Define ibmode if given - IF (I.LT.LPS) THEN - IS = SYMBOL_DEFINE ('DWARF$0_IBMODE', IDIB(I+1:LPS), 0) - ENDIF -C -C Assemble DWARF symbols -C Terminate the program -C - IS = DWC_CTL_FILL () - IS = SYMBOL_EXIT () - 999 E_C = MSG_SET(IS,0) ! Exit code for WNGEX - END diff --git a/src/dwarf/let.for b/src/dwarf/let.for deleted file mode 100644 index b58bedf7463a9caad403652be613bd6f751b1e63..0000000000000000000000000000000000000000 --- a/src/dwarf/let.for +++ /dev/null @@ -1,138 +0,0 @@ -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ -C.Ident: SYS_LET -C.Keywords: Utility Program, Define DCL Symbols -C.Author: Ger van Diepen (NFRA, Dwingeloo) -C.Language: DWARF-Fortran -C.Environment: VAX or Alliant -C.Comments: -C.Version: 820620 GVD - creation -C.Version: 881204 FMO - improved layout, use new MSG and CLI routines -C.Version: 890423 FMO - use SYMBOL-DEFINE i.s.o. DWC_SETSYM -C.Version: 900228 FMO - use DWC_CTL_OPEN to get DWARF control -C.Version: 900416 FMO - use logical*4 only -C.Version: 910813 FMO - remove LIB$DO_COMMAND, add SYMBOL_EXIT call, -C add /LOG qualifier -C.Version: 920206 GvD - add former optional arguments to DWC_INPUT -C.Version: 940121 CMV - changed messenger -C------------------------------------------------------------------------- -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - SUBROUTINE LET -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' -C -C.Purpose: Define arbitrary global DCL symbols -C.Returns: Not applicable -C.Notes: -C - Parameter: -C name=value optional -C - Qualifier (the names can be abbreviated to a single letter): -C /LOG=LONG or /NOLOG default: /LOG=SHORT -C -C - If you do not give a parameter, you will be prompted for definitions -C until you answer with #. -C - The parameter (or input line) will be compressed as follows: -C blanks and tabs that are not part of a quoted substring, are removed. -C - The symbol names shouldn't contain special characters and they -C shouldn't be reserved names. -C - LET SYMBOL=VALUE is equivalent to DCL's SYMBOL:==VALUE. -C - /LOG=L reports each individual symbol definition and the total nr of -C symbols defined, /LOG=S only reports the total number, and /NOLOG -C reports nothing. -C------------------------------------------------------------------------- -C - CHARACTER*(*) PROGNAME - PARAMETER (PROGNAME = 'LET') -C - INTEGER NRARG, X, QVD - PARAMETER (NRARG = 2) - PARAMETER (X = CLI__EXPRESSION) - PARAMETER (QVD = CLI__QUALIFIER+CLI__VALUE+CLI__DEFAULT) - CHARACTER*7 NAME(NRARG) - INTEGER ATTR(NRARG) - CHARACTER*1 PROMPT(NRARG) - CHARACTER*5 DEFVAL(NRARG) - DATA NAME /'SYMDEF','LOG' / - DATA ATTR / X , QVD / - DATA PROMPT /' ' ,' ' / - DATA DEFVAL /' ' ,'SHORT'/ -C - INTEGER CLI_INIT, CLI_GET - INTEGER MSG_INIT, MSG_SET - INTEGER DWC_CTL_OPEN, DWC_INPUT, DWC_TSTSYM - INTEGER STR_COLLAPS - INTEGER SYMBOL_DEFINE, SYMBOL_EXIT -C - CHARACTER*255 LINE, VALUE - INTEGER IS, LL, LV, TMP, NRDEF - LOGICAL DO_ASK, LONG_LOG, SHORT_LOG - DATA NRDEF /0/ - DATA LONG_LOG /.FALSE./ - DATA SHORT_LOG /.TRUE./ -C -C -C Initialize -C - get DWARF control variables -C - start messenger -C - initialize command-line interpreter -C - IS = DWC_CTL_OPEN () - IF (IAND(IS,1).NE.0) IS = MSG_INIT (PROGNAME,F_T) - IF (IAND(IS,1).NE.0) IS = CLI_INIT (NRARG,NAME,ATTR,PROMPT,DEFVAL) - IF (IAND(IS,1).EQ.0) GOTO 900 -C -C Interpret the command line -C - IS = CLI_GET ('SYMDEF',LINE,LL) - IF (IAND(IS,1).EQ.0) GOTO 900 - DO_ASK = LL.EQ.0 -C - IS = CLI_GET ('LOG',VALUE,LV) - IF (IAND(IS,1).EQ.0) GOTO 900 - IF (LV.EQ.0) THEN - SHORT_LOG = .FALSE. - ELSE IF (VALUE(1:1).EQ.'L') THEN - LONG_LOG = .TRUE. - END IF -C -C If no definition is given, the user -C will be asked for it (repeatedly); -C input is taken from SYS$INPUT -C - 100 IF (DO_ASK) THEN - IS = DWC_INPUT (LINE,'Symbol Definition',LL,0,0) - IF (IAND(IS,1).EQ.0) GOTO 900 !CTRL/Z, '#' or error - IF (LL.EQ.0) GOTO 900 !blank answer - IF (LINE(:LL).EQ.'EOD') GOTO 900 !'EOD' answer - IF (LINE(:1).EQ.'$') GOTO 900 !DCL line - END IF -C -C Check and act upon the definition -C - remove blanks and tabs that are -C not part of a quoted substring -C - check the syntax -C - define the symbol -C - LL = STR_COLLAPS (LINE) - I = INDEX(LINE,'=') - IF (I.GT.1 .AND. I.LT.LL) THEN - IS = DWC_TSTSYM (LINE(:I-1)) - IF (IAND(IS,1).EQ.0) THEN - ELSE - IS = SYMBOL_DEFINE (LINE(:I-1),LINE(I+1:LL),DWC__GLOBALSYM) - IF (IAND(IS,1).NE.0) THEN - NRDEF = NRDEF+1 - IF (LONG_LOG) CALL WNCTXT(DWLOG, - 1 'Global symbol !AS is defined with value !AS', - 2 LINE(:I-1),LINE(I+1:LL)) - END IF - END IF - ELSE - CALL WNCTXT(DWLOG,'No symbol name, = or value given') - END IF - IF (DO_ASK) GOTO 100 -C - 900 IF (SHORT_LOG) CALL WNCTXT(DWLOG,'!SJ symbols defined',NRDEF) - IF (NRDEF.GT.0) TMP = SYMBOL_EXIT () - E_C = MSG_SET(IS,0) ! Exit code for WNGEX - END diff --git a/src/dwarf/link.for b/src/dwarf/link.for deleted file mode 100644 index 15bb2da8cb9898a67470785b9b1b271c7321225f..0000000000000000000000000000000000000000 --- a/src/dwarf/link.for +++ /dev/null @@ -1,528 +0,0 @@ -C++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ -C.Ident: GEN_LINK -C.Keywords: Network Task-to-task Communication -C.Author: Friso Olnon (NFRA, Dwingeloo) -C.Language: DWARF-Fortran -C.Environment: Any -C.Comments: -C.Pdoc: -C Task-to-task communication is the exchange of data over a logical link -C between two programs running on the same or different network nodes. -C -C.Pdoc: Setup -C The communication is opened by one of the programs (the client) when -C it requests a logical link to the other program (the server) via a call -C to LINK_CL_START. The server on its turn completes the link by calling -C LINK_ACCEPT. From then on, there is no distinction between the server -C and the client. -C The server must have been started before the client, otherwise the -C client cannot make the connection. -C -C.Pdoc: Exchange data -C Either program can send data to or receive data from the other program -C via LINK_WRITE and LINK_READ calls. The programs must cooperate, i.e., -C each WRITE in one program must match a READ in the other program. -C -C.Pdoc: Wrapup -C At any time, the server can stop a connection via LINK_SV_CLOSE. -C Thereafter he can use LINK_ACCEPT to accept another connection. -C The server can entirely be stopped via LINK_SV_END. -C The client can be stopped via LINK_CL_END. -C -C.Version: 891202 FMO - creation -C.Version: 900519 FMO - new GEN_LUN calls and documentation -C.Version: 911231 GvD - rewritten to use Internet iso. DECnet -C.Version: 921207 HjV - Some lines to long for HP -C.Version: 01087 AXC - write .read changed -C-------------------------------------------------------------------------- -C+PDOC+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - INTEGER*4 FUNCTION LINK_SV_START (SD,TASK,SNODE) -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' -C - INTEGER*4 SD ! (o) socket descriptor - CHARACTER*(*) TASK ! (i) name of server task - CHARACTER*(*) SNODE ! (i) node name of server host -C blank = use default -C -C.Purpose: Initiate a logical link -C.Returns: Status code (.TRUE. for success, .FALSE. otherwise) -C success 1 -C error 2 error report left in message buffer -C.Notes: -C - This function is called by the server program when it wants to start. -C - TASK is the name of the server task to be executed and will be -C mapped to a port number. -C-------------------------------------------------------------------------- -C - INTEGER*4 STR_SIGLEN, STR_UPCASE - INTEGER*4 LINK_GETTASK, LINKF_SINIT, LINK_SV_END, LINK_ERROR -C - INTEGER*4 IS, IS1, NRCL, LENG - INTEGER*2 PORT - CHARACTER NODEX*32 -C -C -C Get the port number for the given task. -C Also get max #clients and default node. -C - SD = 0 - IS = LINK_GETTASK (TASK,PORT,NRCL,NODEX) - IF (IS.NE.1) GOTO 990 -C -C Get length of node name and convert to upper. -C Append a 0 to the strings for C-routines. -C Use node from caller if given. -C Start the server. -C Clear everything if error. -C - IF (SNODE.NE.' ') NODEX = SNODE - LENG = STR_SIGLEN(NODEX) - IF (LENG.GE.LEN(NODEX)) LENG = LEN(NODEX) - 1 - IS = STR_UPCASE (NODEX(:LENG)) - NODEX(LENG+1:LENG+1) = CHAR(0) - IS = LINKF_SINIT (SD, PORT, NRCL, NODEX(:LENG)) - IF (IS.GT.1) THEN - IS1 = LINK_SV_END (SD) - ENDIF - IF (IS.NE.1) THEN - IS = LINK_ERROR (IS,TASK,NODEX(:LENG),PORT) - ENDIF -C -C - 990 LINK_SV_START = IS - RETURN - END -C+PDOC+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - INTEGER*4 FUNCTION LINK_SV_ACCEPT (SD,TASK) -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' -C - INTEGER*4 SD ! (o) socket descriptor - CHARACTER*(*) TASK ! (i) name of server task -C -C.Purpose: Accept a connection -C.Returns: Status code (.TRUE. for success, .FALSE. otherwise) -C success 1 -C error 2 error report left in message buffer -C.Notes: -C - This function is called by the server program when it wants to start -C a connection. -C-------------------------------------------------------------------------- -C - INTEGER*4 IS -C - INTEGER LINKF_SACC, LINK_ERROR -C -C -C Accept a connection. -C - IS = LINKF_SACC (SD) - IF (IS.NE.1) THEN - IS = LINK_ERROR (IS,TASK,' ',0) - ENDIF -C - LINK_SV_ACCEPT = IS - RETURN - END -C+PDOC+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - INTEGER*4 FUNCTION LINK_CL_START (SD,TASK,SNODE) -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' -C - INTEGER*4 SD ! (o) socket descriptor - CHARACTER*(*) TASK ! (i) name of server task - CHARACTER*(*) SNODE ! (i) node name of server host -C blank = use default -C -C.Purpose: Initiate a logical link -C.Returns: Status code (.TRUE. for success, .FALSE. otherwise) -C success 1 -C error 2 error report left in message buffer -C.Notes: -C - This function is called by the client program when it wants to start. -C - TASK is the name of the server task to be connected to and will be -C mapped to a port number. -C-------------------------------------------------------------------------- -C - INTEGER*4 STR_SIGLEN, STR_UPCASE - INTEGER*4 LINK_GETTASK, LINKF_CINIT, LINK_CL_END, LINK_ERROR -C - INTEGER*4 IS, IS1, NRCL, LENG - INTEGER*2 PORT - CHARACTER NODEX*32 -C -C -C Get the port number for the given task. -C Also get max #clients and default server node. -C - SD = 0 - IS = LINK_GETTASK (TASK,PORT,NRCL,NODEX) - IF (IS.NE.1) GOTO 990 -C -C Get length of node name and convert to upper. -C Use server node from caller if given. -C Also convert client node name to uppercase. -C Append a 0 to the strings for C-routines. -C Start the client. -C Clear everything if error. -C - IF (SNODE.NE.' ') NODEX = SNODE - LENG = STR_SIGLEN(NODEX) - IF (LENG.GE.LEN(NODEX)) LENG = LEN(NODEX) - 1 - IS = STR_UPCASE (NODEX(:LENG)) - NODEX(LENG+1:LENG+1) = CHAR(0) - IS = LINKF_CINIT (SD, PORT, NODEX(:LENG)) - IF (IS.GT.1) THEN - IS1 = LINK_CL_END (SD) - ENDIF - IF (IS.NE.1) THEN - IS = LINK_ERROR (IS,TASK,NODEX(:LENG),PORT) - ENDIF -C -C - 990 LINK_CL_START = IS - RETURN - END -C+PDOC+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - INTEGER*4 FUNCTION LINK_READ (SD,BUF,LBUF,LOUT) -C ENTRY LINK_WRITE (SD,BUF,LBUF) -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' -C - INTEGER LINK_WRITE -C - INTEGER*4 SD ! (i) socket descriptor - BYTE BUF(0:*) ! (o,i) bytes read / to write - INTEGER*4 LBUF ! (i) length of BUF - INTEGER*4 LOUT ! (o) #bytes actually read -C -C.Purpose: Read or write a block on the logical link -C.Returns: Status code (.TRUE. for success, .FALSE. otherwise) -C success 1 -C error 2 error report left in message buffer -C.Notes: -C The first part (4 bytes) is the length of the block sent. -C Large blocks are split into fragments of 4096 bytes. -C-------------------------------------------------------------------------- -C - INTEGER MAX__LEN - PARAMETER (MAX__LEN = 4096) - BYTE TMP(0:MAX__LEN-1) -C - INTEGER IS, IS1, LBLK, LENG, REST, LMAX -C - INTEGER LINKF_BREAD, LINKF_BWRITE, LINK_ERROR - INTEGER MOVE_BLB -C -C -C Read a block. -C At least 4 bytes are needed to get the length. -C - LBLK = 0 -100 IS = LINKF_BREAD (SD, TMP(LBLK), MAX__LEN-LBLK, LENG) - IF (IS.NE.1) GOTO 900 - LBLK = LBLK + LENG - IF (LBLK.LT.4) GOTO 100 -C -C Get and test the length. -C Move the rest to the user buffer -C (up to LBUF bytes). -C - CALL LINK_NTOHJ (TMP, LOUT, 1) - LBLK = LBLK - 4 !minus length field -CCC write (20,1000) lout,lblk,lmax !!! -CCC1000 format (' to read:',3i10) !!! - LMAX = LBLK - IF (LMAX.GT.LBUF) LMAX = LBUF - IS1 = MOVE_BLB (TMP(4), BUF, LMAX) -C -C Read the rest if necessary. -C Read it directly into the user buffer -C in parts of max. MAX__LEN bytes. -C Read up to LBUF bytes. -C - LMAX = LOUT - IF (LMAX.GT.LBUF) LMAX = LBUF -200 REST = LMAX - LBLK - IF (REST.GT.0) THEN !more to read into BUF - IF (REST.GT.MAX__LEN) REST = MAX__LEN - IS = LINKF_BREAD (SD, BUF(LBLK), REST, LENG) - IF (IS.NE.1) GOTO 900 - LBLK = LBLK + LENG -CCC write (20,1100) leng !!! -CCC1100 format (' read:',i10) !!! - GOTO 200 - ENDIF -C -C If the user buffer is too small: -C - read the rest -C - generate an error message -C - IF (LOUT.GT.LBUF) THEN -250 IF (LOUT.GT.LBLK) THEN !still more to read - IS = LINKF_BREAD (SD, TMP, MAX__LEN, LENG) - IF (IS.NE.1) GOTO 900 - LBLK = LBLK + LENG - GOTO 250 - ENDIF - CALL WNCTXT(DWLOG, - * 'Buffer too small; !SL given, !SL bytes needed', - * LBUF,LOUT) - LOUT = LBUF - GOTO 900 - ENDIF - GOTO 990 - -C -C - ENTRY LINK_WRITE (SD,BUF,LBUF) -C -C Write the length of the block before the buffer. -C Write the first part of the buffer. -C At least 4 bytes should be written to write -C the length. -C - CALL LINK_HTONJ (LBUF, TMP, 1) - REST = LBUF + 4 !part of buffer that - IF (REST.GT.MAX__LEN) REST = MAX__LEN !can be written - IS1 = MOVE_BLB (BUF, TMP(4), REST-4) - LBLK = 0 !nothing written yet -300 IS = LINKF_BWRITE (SD, TMP(LBLK), REST-LBLK, LENG) - IF (IS.NE.1) GOTO 900 - LBLK = LBLK + LENG - IF (LBLK.LT.4) GOTO 300 - LBLK = LBLK - 4 -CCC write (20,1010) lbuf,leng !!! -CCC1010 format (' to write:',2i10) !!! -C -C Now write the remaining in parts of max. -C MAX__LEN bytes. -C REST is max. #bytes written per time -C LENG is actual #bytes written per time -C -400 REST = LBUF - LBLK - IF (REST.EQ.0) GOTO 990 !everything is written - IF (REST.GT.MAX__LEN) REST = MAX__LEN - IS = LINKF_BWRITE (SD, BUF(LBLK), REST, LENG) - IF (IS.NE.1) GOTO 900 - LBLK = LBLK + LENG -CCC write (20,1110) leng !!! -CCC1110 format (' written:',i10) !!! - GOTO 400 -C -C -900 IS = LINK_ERROR (IS,' ',' ',0) -C -990 LINK_READ = IS - RETURN - END -C+PDOC+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - INTEGER*4 FUNCTION LINK_SV_CLOSE (SD) -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' -C - INTEGER*4 SD ! (m) socket descriptor -C -C.Purpose: Close the server communication socket -C.Returns: Status code (.TRUE. for success, .FALSE. otherwise) -C success 1 -C error 2 error report left in message buffer -C.Notes: -C-------------------------------------------------------------------------- -C - INTEGER IS -C - INTEGER LINKF_SCCLOSE, LINK_ERROR -C -C Close the communication socket. -C - IS = LINKF_SCCLOSE (SD,2) - IF (IS.NE.1) THEN - IS = LINK_ERROR (IS,' ',' ',0) - ENDIF -C - LINK_SV_CLOSE = IS - RETURN - END -C+PDOC+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - INTEGER*4 FUNCTION LINK_SV_END (SD) -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' -C - INTEGER*4 SD ! (m) socket descriptor -C -C.Purpose: Close and release the server socket -C.Returns: Status code (.TRUE. for success, .FALSE. otherwise) -C success 1 -C error 2 error report left in message buffer -C.Notes: -C-------------------------------------------------------------------------- -C -C - INTEGER LINKF_SCCLOSE, LINKF_SCEND -C -C Close the socket. -C Release everything. -C - LINK_SV_END = LINKF_SCCLOSE (SD,1) - LINK_SV_END = LINKF_SCEND (SD,2) - RETURN - END -C+PDOC+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - INTEGER*4 FUNCTION LINK_CL_END (SD) -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' -C - INTEGER*4 SD ! (i) socket descriptor -C -C.Purpose: Close and release the client socket -C.Returns: Status code (.TRUE. for success, .FALSE. otherwise) -C success 1 -C error 2 error report left in message buffer -C.Notes: -C-------------------------------------------------------------------------- -C -C - INTEGER LINKF_SCCLOSE, LINKF_SCEND -C -C Close the socket. -C Release everything. -C - LINK_CL_END = LINKF_SCCLOSE (SD,1) - LINK_CL_END = LINKF_SCEND (SD,1) - RETURN - END -C+PDOC+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - INTEGER*4 FUNCTION LINK_GETTASK (TASK,PORT,NRCL,NODE) -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' -C - CHARACTER*(*) TASK ! (i) name of server task - INTEGER*2 PORT ! (o) port number of server task - INTEGER*4 NRCL ! (o) max nr of possible clients - CHARACTER*(*) NODE ! (o) node name of server host -C -C.Purpose: Get the number of the port where the server is listening -C.Returns: Status code (.TRUE. for success, .FALSE. otherwise) -C success 1 -C error 2 error report left in message buffer -C-------------------------------------------------------------------------- -C -C Define all tasks, ports and max. nr -C of clients. -C - INTEGER*4 NR_TASK - PARAMETER (NR_TASK = 3) -C - CHARACTER*6 NAME(NR_TASK) - DATA NAME /'TAPE', - * 'ANZA', - * 'DID'/ -C - INTEGER*4 MAXC(NR_TASK) - DATA MAXC /10,1,1/ -C - INTEGER*2 PRTN(NR_TASK) - DATA PRTN /1100,1101,1104/ -C - CHARACTER*6 NONM(NR_TASK) - DATA NONM /3*'RZMVX4'/ -C -C - INTEGER*4 IS - CHARACTER*32 TASKX -C - INTEGER*4 STR_UPCASE -C -C -C Convert task name to uppercase. -C Then try to find it. -C - TASKX = TASK - IS = STR_UPCASE (TASKX) - DO I = 1,NR_TASK - IF (TASKX .EQ. NAME(I)) THEN - PORT = PRTN(I) - NRCL = MAXC(I) - NODE = NONM(I) - WRITE(*,*) 'port:' - READ(*,*) port - LINK_GETTASK = 1 !Success - RETURN - ENDIF - ENDDO -C -C Task not found. -C - CALL WNCTXT(DWLOG,'Update LINK.FOR to add a new server task') - CALL WNCTXT(DWLOG,'Server task !AS is unknown',TASKX) - LINK_GETTASK = 2 - RETURN - END -C+PDOC+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - INTEGER*4 FUNCTION LINK_ERROR (ERR,TASK,SNODE,PORT) -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' -C - INTEGER ERR ! (i) error code from LINKF module - CHARACTER*(*) TASK ! (i) name of server task - CHARACTER*(*) SNODE ! (i) node name of server host - INTEGER*2 PORT ! (i) port number for server task -C -C.Purpose: Generate message for error from LINKF -C.Returns: Status code (.TRUE. for success, .FALSE. otherwise) -C success 1 -C error 2 error report left in message buffer -C-------------------------------------------------------------------------- -C - INTEGER IS -C -C -C Generate a message for the various errors -C - IF (ERR.EQ.0) THEN - CALL WNCTXT(DWLOG,'No heap storage available') - ELSEIF (ERR.EQ.2) THEN - CALL WNCTXT(DWLOG,'No event flag available') - ELSEIF (ERR.EQ.4) THEN - CALL WNCTXT(DWLOG,'$ASSIGN for communication channel failed') - ELSEIF (ERR.EQ.6) THEN - CALL WNCTXT(DWLOG,'Internet address of client host not found') - ELSEIF (ERR.EQ.8) THEN - CALL WNCTXT(DWLOG, - * 'Listen failed for task !AS on port !SW server !AS', - * TASK,PORT,SNODE) - ELSEIF (ERR.EQ.10) THEN - CALL WNCTXT(DWLOG,'Accept failed for server task !AS',) - ELSEIF (ERR.EQ.12) THEN - CALL WNCTXT(DWLOG,'Bind failed for task !AS on port !SW', - * TASK,PORT) - ELSEIF (ERR.EQ.14) THEN - CALL WNCTXT(DWLOG, - * 'Internet address of server !AS could not be found', - * SNODE) - ELSEIF (ERR.EQ.16) THEN - CALL WNCTXT(DWLOG, - * 'Connect failed to task !AS on port !SW server !AS', - * TASK,PORT,SNODE) - ELSEIF (ERR.EQ.18) THEN - CALL WNCTXT(DWLOG,'Close failed') - ELSEIF (ERR.EQ.20) THEN - CALL WNCTXT(DWLOG,'Read failed') - ELSEIF (ERR.EQ.22) THEN - CALL WNCTXT(DWLOG,'Write failed') - ENDIF -C - LINK_ERROR = IS - RETURN - END diff --git a/src/dwarf/linkc.cun b/src/dwarf/linkc.cun deleted file mode 100644 index 9ab746117b6b744333ff04f923e082f18e4f750b..0000000000000000000000000000000000000000 --- a/src/dwarf/linkc.cun +++ /dev/null @@ -1,372 +0,0 @@ -/*++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++*/ -/*.Ident: GENUN_LINKC -/*.Keywords: Network Task-to-task Communication -/*.Author: Ger van Diepen (NFRA, Dwingeloo) -/*.Language: C -/*.Environment: UNIX -/*.Comments: -/*.Version: 911231 GvD - creation -/*--------------------------------------------------------------------------*/ - -#include <sys/types.h> -#include <stdio.h> -#include <sys/socket.h> -#include <netdb.h> -#include <arpa/inet.h> -#include <netinet/in.h> -#include <sys/uio.h> - -/*+PDOC+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++*/ - linkc_sinit_ (msg,sd,port,maxc,snode) - char msg[]; /* (o) error message */ - int **sd; /* (o) socket descriptor */ - short *port; /* (i) port where server is listening*/ - int *maxc; /* (i) max nr of clients */ - char snode[]; /* (i) node name of server system */ - { - -/*.Purpose: Handle a logical link -/*.Returns: Status code (.TRUE. for success, .FALSE. otherwise) -/* success 1 -/* error 0 no heap storage available -/* 2 no event flag -/* 4 no assign -/* 6 get address client -/* 8 listen -/* 10 accept -/* 12 bind -/* 14 get address server -/* 16 connect -/* 18 close -/* 20 read -/* 22 write -/*.Notes: -/* - LINKC_SINIT is called by LINK_SV_START to start the server. -/*--------------------------------------------------------------------------*/ - - struct sockaddr_in sock_name; - struct hostent *hostentptr; - int sock; - int *socd; - -/* -Set initially to no message -*/ - msg[0] = '\0'; -/* -Allocate storage on the heap for 2 socket-ids -Initialize it -*/ - if ((socd = (int *) malloc (2*sizeof(int))) == NULL) - return 0; - *sd = socd; - *socd = -1; - *(socd+1) = -1; -/* -Create a socket for the server to listen -Store the socket-id -*/ - if ((sock = socket (AF_INET, SOCK_STREAM, 0)) == -1) { - linkc_error (msg); - return 4; - } - *socd = sock; -/* -Get the internet address of the server node -*/ - if ((hostentptr = gethostbyname (snode)) == NULL) { - linkc_error (msg); - return 14; - } -/* -Bind address and port to the server socket -*/ - sock_name.sin_family = hostentptr->h_addrtype; - sock_name.sin_port = htons(*port); - sock_name.sin_addr = *((struct in_addr *) hostentptr->h_addr); - if (bind (sock, &sock_name, sizeof(sock_name))) { - linkc_error (msg); - return 12; - } -/* -Listen on the socket for a connection (max. maxc connections) -*/ - if (listen (sock, *maxc)) { - linkc_error (msg); - return 8; - } -/* -Successfully ended -*/ - return 1; - } -/*+PDOC+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++*/ - linkc_sacc_ (msg,sd) - char msg[]; /* (o) error message */ - int *sd[2]; /* (o) socket descriptor */ - { - -/*.Purpose: Complete a logical link -/*.Returns: Status code (.TRUE. for success, .FALSE. otherwise) -/* success 1 -/* error 2 error report left in message buffer -/*.Notes: -/* - This function is called by the server program in answer to the link -/* request from the requestor program. -/*--------------------------------------------------------------------------*/ - - struct sockaddr_in sock_name; - int leng, sock; - -/* -Set initially to no message -*/ - msg[0] = '\0'; -/* -Accept a connection -Store the socket-id -*/ - leng = sizeof(sock_name); - if ((sock = accept ((*sd)[0], &sock_name, &leng)) == -1) { - linkc_error (msg); - return 10; - } - (*sd)[1] = sock; -/* -Successfully ended -*/ - return 1; - } -/*+PDOC+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++*/ - linkc_cinit_ (msg,sd,port,snode) - char msg[]; /* (o) error message */ - int **sd; /* (o) socket descriptor */ - short *port; /* (i) port where server is listening*/ - char snode[]; /* (i) node name of server system */ - { - -/*.Purpose: Handle a logical link -/*.Returns: Status code (.TRUE. for success, .FALSE. otherwise) -/* success 1 -/* error 2 error report left in message buffer -/* 4 no heap storage available -/*.Notes: -/* - LINK_CINIT is called by LINK_CL_START to start the client. -/*--------------------------------------------------------------------------*/ - - struct sockaddr_in sock_name; - struct hostent *hostentptr; - int sock; - int *socd; - int i; -/* -Set initially to no message -*/ - msg[0] = '\0'; -/* -Allocate storage on the heap for 2 socket-ids -Initialize it -*/ - if ((socd = (int *) malloc (2*sizeof(int))) == NULL) - return 0; - *sd = socd; - *socd = -1; - *(socd+1) = -1; -/* -Create a socket for the client -Store the socket-id (twice) -*/ - if ((sock = socket (AF_INET, SOCK_STREAM, 0)) == -1) { - linkc_error (msg); - return 4; - } - *socd = sock; - *(socd+1) = sock; -/* -Get the internet address of the server node -*/ - if ((hostentptr = gethostbyname (snode)) == NULL) { - linkc_error (msg); - return 14; - } -/* -Store the address and server port -Make a connection to the server -*/ - sock_name.sin_family = hostentptr->h_addrtype; - sock_name.sin_port = htons(*port); - sock_name.sin_addr = *((struct in_addr *) hostentptr->h_addr); - if (connect (sock, &sock_name, sizeof(sock_name))) { - linkc_error (msg); - return 16; - } -/* -Successfully ended -*/ - return 1; - } -/*+PDOC+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++*/ - linkc_bread_ (msg,sd,buf,lbuf,lout) - char msg[]; /* (o) error message */ - int *sd[2]; /* (o) socket descriptor */ - char buf[]; /* (o) bytes read */ - int *lbuf; /* (i) length of buf */ - int *lout; /* (o) nr of bytes read */ - { - -/*.Purpose: Read a stream of bytes over the logical link -/*.Returns: Status code (.TRUE. for success, .FALSE. otherwise) -/* success 1 also for end-of-data -/* error 2 error report left in message buffer -/*.Notes: -/* - LOUT = 0 signals the end-of-data. -/*--------------------------------------------------------------------------*/ - - int nr; - -/* -Set initially to no message -*/ - *lout = 0; - msg[0] = '\0'; -/* -Read from the socket -Store nr of bytes read -*/ - if ((nr = read ((*sd)[1], buf, *lbuf)) == -1) { - linkc_error (msg); - return 20; - } - *lout = nr; -/* -Successfully ended -*/ - return 1; - } -/*+PDOC+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++*/ - linkc_bwrite_ (msg,sd,buf,lbuf,lout) - char msg[]; /* (o) error message */ - int *sd[2]; /* (i) socket descriptor */ - char buf[]; /* (i) bytes to write */ - int *lbuf; /* (i) length of buf */ - int *lout; /* (o) nr of bytes written */ - { - -/*.Purpose: Send a stream of bytes over the logical link -/*.Returns: Status code (.TRUE. for success, .FALSE. otherwise) -/* success 1 -/* error 2 error report left in message buffer -/*.Notes: -/*--------------------------------------------------------------------------*/ - - int nr; - -/* -Set initially to no message -*/ - *lout = 0; - msg[0] = '\0'; -/* -Write to the socket -*/ - if ((nr = write ((*sd)[1], buf, *lbuf)) == -1) { - linkc_error (msg); - return 22; - } - *lout = nr; -/* -Successfully ended -*/ - return 1; - } -/*+PDOC+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++*/ - linkc_scclose_ (msg,sd,chnr) - char msg[]; /* (o) error message */ - int *sd[2]; /* (m) socket descriptor */ - int *chnr; /* (i) sockets to close (1 or 2) */ - { - -/*.Purpose: Close a socket -/*.Returns: Status code (.TRUE. for success, .FALSE. otherwise) -/* success 1 -/* error 2 error report left in message buffer -/*.Notes: -/*--------------------------------------------------------------------------*/ - - int sock, is; - -/* -Set initially to no message -*/ - is = 1; - msg[0] = '\0'; -/* -Get the socket to close -*/ - if (*chnr == 1) - sock = (*sd)[0]; - else - sock = (*sd)[1]; -/* -Shutdown and close it if defined -*/ - if (sock != -1) { - if (shutdown (sock,2) == -1) { - is = 18; - linkc_error (msg); - } - if (close (sock)) { - is = 18; - linkc_error (msg); - } - } -/* -Ended -*/ - return is; - } -/*+PDOC+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++*/ - linkc_scend_ (msg,sd,chnr) - char msg[]; /* (o) error message */ - int **sd; /* (m) socket descriptor */ - int *chnr; /* (i) nr of sockets to free (1 or 2) - (not used) */ - { - -/*.Purpose: Release the heap -/*.Returns: Status code (.TRUE. for success, .FALSE. otherwise) -/* success 1 -/* error 2 error report left in message buffer -/*.Notes: -/*--------------------------------------------------------------------------*/ - -/* -Set initially to no message -*/ - msg[0] = '\0'; -/* -Free the heap -Clear pointer -*/ - free (*sd); - sd = 0; -/* -Ended successfully -*/ - return 1; - } -/*+PDOC+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++*/ - linkc_error (msg) - char msg[]; /* (o) error message */ - { - -/*.Purpose: Get message for errno -/*.Notes: -/*--------------------------------------------------------------------------*/ - - gen_cerror_ (msg,80); -/* -Ended successfully -*/ - return 1; - } diff --git a/src/dwarf/linkf.for b/src/dwarf/linkf.for deleted file mode 100644 index bf123fc5ca86fc546a204eeb4745f3be71a8c092..0000000000000000000000000000000000000000 --- a/src/dwarf/linkf.for +++ /dev/null @@ -1,96 +0,0 @@ -C++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ -C.Ident: GENUN_LINKF -C.Keywords: Network Task-to-task Communication -C.Author: Ger van Diepen (NFRA, Dwingeloo) -C.Language: DWARF-Fortran -C.Environment: UNIX -C.Comments: -C.Version: 911231 GvD - creation -C.Returns: Status code (.TRUE. for success, .FALSE. otherwise) -C success 1 -C error 0 no heap storage available -C 2 no event flag -C 4 no assign -C 6 get address client -C 8 listen -C 10 accept -C 12 bind -C 14 get address server -C 16 connect -C 18 close -C-------------------------------------------------------------------------- -C+PDOC+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - INTEGER*4 FUNCTION LINKF_SINIT (SD,PORT,MAXC,SNODE) -C ENTRY LINKF_SACC (SD) -C ENTRY LINKF_CINIT (SD,PORT,SNODE) -C ENTRY LINKF_BREAD (SD,BUF,LBUF,LOUT) -C ENTRY LINKF_BWRITE (SD,BUF,LBUF,LOUT) -C ENTRY LINKF_SCCLOSE (SD,CHNR) -C ENTRY LINKF_SCEND (SD,CHNR) -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' -C - INTEGER*4 LINKF_SACC, LINKF_CINIT, LINKF_BREAD, LINKF_BWRITE - INTEGER*4 LINKF_SCCLOSE, LINKF_SCEND -C - INTEGER*4 SD ! (o,i) socket descriptor - INTEGER*2 PORT ! (i) port where server is listening -C and default port for client - INTEGER*4 MAXC ! (i) max nr of clients - CHARACTER*(*) SNODE ! (i) node name of server system - BYTE BUF(*) ! (o,i) bytes read/to be written - INTEGER*4 LBUF ! (i) length of BUF - INTEGER*4 LOUT ! (o) nr of bytes read / written - INTEGER*4 CHNR ! (i) channel nr to close (1 or 2) -C or channels to free (1 or 2) -C -C.Purpose: Interface between Fortran LINK routine and C LINKC routine -C to store an error message in the message buffer. -C.Returns: Status code (.TRUE. for success, .FALSE. otherwise) -C-------------------------------------------------------------------------- -C - INTEGER*4 IS, IS1 - BYTE MSG(80) - - INTEGER LINKC_SINIT, LINKC_SACC, LINKC_CINIT - INTEGER LINKC_BREAD, LINKC_BWRITE, LINKC_SCCLOSE, LINKC_SCEND -C -C - IS = LINKC_SINIT (MSG,SD,PORT,MAXC,SNODE) - GOTO 900 -C - ENTRY LINKF_SACC (SD) - IS = LINKC_SACC (MSG,SD) - GOTO 900 -C - ENTRY LINKF_CINIT (SD,PORT,SNODE) - IS = LINKC_CINIT (MSG,SD,PORT,SNODE) - GOTO 900 -C - ENTRY LINKF_BREAD (SD,BUF,LBUF,LOUT) - IS = LINKC_BREAD (MSG,SD,BUF,LBUF,LOUT) - GOTO 900 -C - ENTRY LINKF_BWRITE (SD,BUF,LBUF,LOUT) - IS = LINKC_BWRITE (MSG,SD,BUF,LBUF,LOUT) - GOTO 900 -C - ENTRY LINKF_SCCLOSE (SD,CHNR) - IS = LINKC_SCCLOSE (MSG,SD,CHNR) - GOTO 900 -C - ENTRY LINKF_SCEND (SD,CHNR) - IS = LINKC_SCEND (MSG,SD,CHNR) - GOTO 900 -C -C -C If error store message in buffer -C (message is an ASCIZ string). -C - 900 IF (IS.NE.1) THEN - CALL WNCTXT(DWLOG,'!AZ',MSG) - ENDIF - LINKF_SINIT = IS - RETURN - END diff --git a/src/dwarf/linkhton.for b/src/dwarf/linkhton.for deleted file mode 100644 index 491a234afd15a028ae741151beb74e7751cea80a..0000000000000000000000000000000000000000 --- a/src/dwarf/linkhton.for +++ /dev/null @@ -1,228 +0,0 @@ -C++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ -C.Ident: GEN_LINKHTON -C.Keywords: Network Data-conversion -C.Author: Ger van Diepen (NFRA, Dwingeloo) -C.Language: DWARF-Fortran -C.Environment: Any -C.Comments: -C.Version: 920113 GvD - creation -C.Returns: None -C-------------------------------------------------------------------------- -C+PDOC+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - SUBROUTINE LINK_HTON (DTYPE,IN,OUT,NR) -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' -C - CHARACTER*1 DTYPE ! (i) data type - BYTE IN(*) ! (i) input data array - BYTE OUT(*) ! (o) output data array - INTEGER*4 NR ! (i) #elements in data arrays -C -C.Purpose: Convert data from host to network byte order for -C any DWARF data type -C.Returns: None -C-------------------------------------------------------------------------- -C - IF (DTYPE.EQ.'J') THEN - CALL LINK_HTONJ (IN,OUT,NR) - ELSE IF (DTYPE.EQ.'I') THEN - CALL LINK_HTONI (IN,OUT,NR) - ELSE IF (DTYPE.EQ.'R') THEN - CALL LINK_HTONR (IN,OUT,NR) - ELSE IF (DTYPE.EQ.'D') THEN - CALL LINK_HTOND (IN,OUT,NR) - ELSE - CALL MOVE_BLB (IN,OUT,NR) - ENDIF -C - RETURN - END -C+PDOC+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - SUBROUTINE LINK_HTONR (IN,OUT,NR) -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' -C - REAL*4 IN(*) ! (i) input data array - INTEGER*4 OUT(2,*) ! (o) output data array - INTEGER*4 NR ! (i) #elements in data arrays -C -C.Purpose: Convert real*4 data from host to network byte order -C.Returns: None -C.Remarks: Each data point is converted to 2 long integers -C (one for the sign+exponent and one for the mantissa) -C-------------------------------------------------------------------------- -C - REAL*8 RLOG2 - PARAMETER (RLOG2 = 1d0 / 0.6931471805599453) -C - INTEGER*4 EXPO,NUM(2) - REAL*8 NUMD -C - DO I = 1,NR - NUM(2) = 0 - NUMD = IN(I) - IF (NUMD.EQ.0) THEN - NUM(1) = 0 - ELSE - IF (NUMD.LT.0) THEN - NUM(2) = 1000000 - NUMD = -NUMD - ENDIF - EXPO = LOG(NUMD) * RLOG2 ! exponent - NUM(1) = NINT((NUMD / 2d0**EXPO) * 2**29) ! mantissa - NUM(2) = NUM(2) + EXPO ! sign+exponent - ENDIF - CALL LINK_HTONJ (NUM, OUT(1,I), 2) - ENDDO -C - RETURN - END -C+PDOC+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - SUBROUTINE LINK_HTOND (IN,OUT,NR) -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' -C - REAL*8 IN(*) ! (i) input data array - INTEGER*4 OUT(2,*) ! (o) output data array - INTEGER*4 NR ! (i) #elements in data arrays -C -C.Purpose: Convert real*8 data from host to network byte order -C.Returns: None -C.Remarks: Each data point is converted to 2 long integers -C (one for the sign+exponent and one for the mantissa) -C-------------------------------------------------------------------------- -C - REAL*8 RLOG2 - PARAMETER (RLOG2 = 1d0 / 0.6931471805599453) -C - INTEGER*4 EXPO,NUM(2) - REAL*8 NUMD -C - DO I = 1,NR - NUM(2) = 0 - NUMD = IN(I) - IF (NUMD.EQ.0) THEN - NUM(1) = 0 - ELSE - IF (NUMD.LT.0) THEN - NUM(2) = 1000000 - NUMD = -NUMD - ENDIF - EXPO = LOG(NUMD) * RLOG2 ! exponent - NUM(1) = NINT((NUMD / 2d0**EXPO) * 2**29) ! mantissa - NUM(2) = NUM(2) + EXPO ! sign+exponent - ENDIF - CALL LINK_HTONJ (NUM, OUT(1,I), 2) - ENDDO -C - RETURN - END -C+PDOC+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - SUBROUTINE LINK_NTOH (DTYPE,IN,OUT,NR) -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' -C - CHARACTER*1 DTYPE ! (i) data type - BYTE IN(*) ! (i) input data array - BYTE OUT(*) ! (o) output data array - INTEGER*4 NR ! (i) #elements in data arrays -C -C.Purpose: Convert data from network to host byte order for -C any DWARF data type -C.Returns: None -C-------------------------------------------------------------------------- -C - IF (DTYPE.EQ.'J') THEN - CALL LINK_NTOHJ (IN,OUT,NR) - ELSE IF (DTYPE.EQ.'I') THEN - CALL LINK_NTOHI (IN,OUT,NR) - ELSE IF (DTYPE.EQ.'R') THEN - CALL LINK_NTOHR (IN,OUT,NR) - ELSE IF (DTYPE.EQ.'D') THEN - CALL LINK_NTOHD (IN,OUT,NR) - ELSE - CALL MOVE_BLB (IN,OUT,NR) - ENDIF -C - RETURN - END -C+PDOC+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - SUBROUTINE LINK_NTOHR (IN,OUT,NR) -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' -C - INTEGER*4 IN(2,*) ! (o) input data array - REAL*4 OUT(*) ! (i) output data array - INTEGER*4 NR ! (i) #elements in data arrays -C -C.Purpose: Convert real*4 data from network to host byte order -C.Returns: None -C.Remarks: Each data point is converted from 2 long integers -C (one for the sign+exponent and one for the mantissa) -C-------------------------------------------------------------------------- -C - INTEGER*4 SIGN,NUM(2) - REAL*8 NUMD -C - DO I = 1,NR - CALL LINK_NTOHJ (IN(1,I), NUM, 2) - IF (NUM(1) .EQ. 0) THEN - OUT(I) = 0 - ELSE - SIGN = 0 - IF (NUM(2).GE.500000) THEN - SIGN = -1 - NUM(2) = NUM(2) - 1000000 - ENDIF - NUMD = NUM(1) - NUMD = (NUMD / 2**29) * 2d0**NUM(2) - IF (SIGN.NE.0) NUMD = -NUMD - OUT(I) = NUMD - ENDIF - ENDDO -C - RETURN - END -C+PDOC+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - SUBROUTINE LINK_NTOHD (IN,OUT,NR) -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' -C - INTEGER*4 IN(2,*) ! (o) input data array - REAL*8 OUT(*) ! (i) output data array - INTEGER*4 NR ! (i) #elements in data arrays -C -C.Purpose: Convert real*8 data from network to host byte order -C.Returns: None -C.Remarks: Each data point is converted from 2 long integers -C (one for the sign+exponent and one for the mantissa) -C-------------------------------------------------------------------------- -C - INTEGER*4 SIGN,NUM(2) - REAL*8 NUMD -C - DO I = 1,NR - CALL LINK_NTOHJ (IN(1,I), NUM, 2) - IF (NUM(1) .EQ. 0) THEN - OUT(I) = 0 - ELSE - SIGN = 0 - IF (NUM(2).GE.500000) THEN - SIGN = -1 - NUM(2) = NUM(2) - 1000000 - ENDIF - NUMD = NUM(1) - NUMD = (NUMD / 2**29) * 2d0**NUM(2) - IF (SIGN.NE.0) NUMD = -NUMD - OUT(I) = NUMD - ENDIF - ENDDO -C - RETURN - END diff --git a/src/dwarf/linkhtonj.cun b/src/dwarf/linkhtonj.cun deleted file mode 100644 index 2e2dc501c0a72f55038d5da64c5386ec36d7d69f..0000000000000000000000000000000000000000 --- a/src/dwarf/linkhtonj.cun +++ /dev/null @@ -1,82 +0,0 @@ -/*++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++*/ -/*.Ident: GENUN_LINKHTONJ -/*.Keywords: Network Task-to-task Communication -/*.Author: Ger van Diepen (NFRA, Dwingeloo) -/*.Language: C -/*.Environment: UNIX -/*.Comments: -/*.Version: 920113 GvD - creation -/*--------------------------------------------------------------------------*/ - -/*+PDOC+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++*/ - link_htonj_ (in,out,nr) - long in[]; /* (i) input numbers */ - long out[]; /* (o) output numbers */ - int *nr; /* (i) nr of numbers */ - { - -/*.Purpose: Convert a long integer from host to network byte order -/*.Returns: None -/*.Notes: -/*--------------------------------------------------------------------------*/ - - int i; - - for (i=0; i<*nr; i++) - out[i] = htonl (in[i]); - return; - } -/*+PDOC+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++*/ - link_htoni_ (in,out,nr) - short in[]; /* (i) input numbers */ - short out[]; /* (o) output numbers */ - int *nr; /* (i) nr of numbers */ - { - -/*.Purpose: Convert a short integer from host to network byte order -/*.Returns: None -/*.Notes: -/*--------------------------------------------------------------------------*/ - - int i; - - for (i=0; i<*nr; i++) - out[i] = htons (in[i]); - return; - } -/*+PDOC+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++*/ - link_ntohj_ (in,out,nr) - long in[]; /* (i) input numbers */ - long out[]; /* (o) output numbers */ - int *nr; /* (i) nr of numbers */ - { - -/*.Purpose: Convert a long integer from network to host byte order -/*.Returns: None -/*.Notes: -/*--------------------------------------------------------------------------*/ - - int i; - - for (i=0; i<*nr; i++) - out[i] = ntohl (in[i]); - return; - } -/*+PDOC+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++*/ - link_ntohi_ (in,out,nr) - short in[]; /* (i) input numbers */ - short out[]; /* (o) output numbers */ - int *nr; /* (i) nr of numbers */ - { - -/*.Purpose: Convert a short integer from network to host byte order -/*.Returns: None -/*.Notes: -/*--------------------------------------------------------------------------*/ - - int i; - - for (i=0; i<*nr; i++) - out[i] = htons (in[i]); - return; - } diff --git a/src/dwarf/linkhtonj.fvx b/src/dwarf/linkhtonj.fvx deleted file mode 100644 index f5feb5d964d0b383dc0c7c55009dcbd06a102c54..0000000000000000000000000000000000000000 --- a/src/dwarf/linkhtonj.fvx +++ /dev/null @@ -1,69 +0,0 @@ -C++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ -C.Ident: VGEN_LINKHTONJ -C.Keywords: Network Data-conversion -C.Author: Ger van Diepen (NFRA, Dwingeloo) -C.Language: Fortran -C.Environment: VAX -C.Comments: This version is typically VAX, because it always swaps bytes. -C The UNIX-version is written in C and uses HTONx and NTOHx. -C.Version: 920113 GvD - creation -C.Returns: None -C-------------------------------------------------------------------------- -C+PDOC+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - SUBROUTINE LINK_HTONJ (IN,OUT,NR) -C ENTRY LINK_NTOHJ (IN,OUT,NR) -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' -C - BYTE IN(4,*) ! (i) input data array - BYTE OUT(4,*) ! (o) output data array - INTEGER*4 NR ! (i) #elements in data arrays -C -C.Purpose: Convert integer*4 data from host to network byte order and back. -C.Returns: None -C-------------------------------------------------------------------------- -C -C -C LINK_HTONJ and _NTOHJ are the same - GOTO 100 -C - ENTRY LINK_NTOHJ (IN,OUT,NR) -C -100 DO I = 1,NR - OUT(1,I) = IN(4,I) - OUT(2,I) = IN(3,I) - OUT(3,I) = IN(2,I) - OUT(4,I) = IN(1,I) - ENDDO -C - RETURN - END -C+PDOC+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - SUBROUTINE LINK_HTONI (IN,OUT,NR) -C ENTRY LINK_NTOHI (IN,OUT,NR) -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' -C - BYTE IN(2,*) ! (i) input data array - BYTE OUT(2,*) ! (o) output data array - INTEGER*4 NR ! (i) #elements in data arrays -C -C.Purpose: Convert integer*2 data from host to network byte order and back. -C.Returns: None -C-------------------------------------------------------------------------- -C -C -C LINK_HTONI and _NTOHI are the same - GOTO 100 -C - ENTRY LINK_NTOHI (IN,OUT,NR) -C -100 DO I = 1,NR - OUT(1,I) = IN(2,I) - OUT(2,I) = IN(1,I) - ENDDO -C - RETURN - END diff --git a/src/dwarf/linkrcvmsg.for b/src/dwarf/linkrcvmsg.for deleted file mode 100644 index 5e413e2c506f6aaabf7e55c80cea0f0c1fe726ca..0000000000000000000000000000000000000000 --- a/src/dwarf/linkrcvmsg.for +++ /dev/null @@ -1,43 +0,0 @@ -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ -C.Ident: GEN_LINK_RCVMSG -C.Keywords: Messenger, Link -C.Author: Ger van Diepen (NFRA, Dwingeloo) -C.Language: DWARF-Fortran -C.Environment: Any -C.Comments: -C.Version: 920110 GvD - creation -C------------------------------------------------------------------------- -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - INTEGER*4 FUNCTION LINK_RCV_MSG (SD,BUF,BUFC) -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' -C - INTEGER*4 SD ! (i) socket descriptor for the link - BYTE BUF(*) ! (i) message buffer - CHARACTER*(*) BUFC ! (i) message buffer as a string -C -C.Purpose: Write a message received via the link -C.Returns: Status code (.TRUE. for success, .FALSE. otherwise) -C set to status of message received -C.Notes: Integers are received in network byte order -C (ie. opposite to VAX) -C------------------------------------------------------------------------- -C - INTEGER*4 IS ,STS, LENG -C -C Set the status and message length -C (convert to host byte order) -C - CALL LINK_NTOHJ (BUF(5), STS, 1) - CALL LINK_NTOHJ (BUF(9), LENG, 1) -C -C Write the message (if any) -C Return the status -C - IF (LENG.GT.0) THEN - CALL WNCTXT(DWLOG,BUFC(13:12+LENG)) - ENDIF - LINK_RCV_MSG = STS - RETURN - END diff --git a/src/dwarf/linkrcvparm.for b/src/dwarf/linkrcvparm.for deleted file mode 100644 index 00e371f1d95b5a2ffb92e8479dc19cb76c9da9de..0000000000000000000000000000000000000000 --- a/src/dwarf/linkrcvparm.for +++ /dev/null @@ -1,140 +0,0 @@ -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ -C.Ident: GEN_LINK_RCVPARM -C.Keywords: Program Parameters, Get Value, Link -C.Author: Ger van Diepen (NFRA, Dwingeloo) -C.Language: DWARF-Fortran -C.Environment: Any -C.Comments: This is a special version of GET_PARM, which can be used -C to ask parameters on another system using the link. -C.Version: 920101 GvD - creation -C.Version: 920507 GvD - put data on 8-byte boundary -C.Version: 921207 HjV - Some lines to long for HP -C------------------------------------------------------------------------- -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - INTEGER*4 FUNCTION LINK_RCV_PARM (SD,BUF,BUFC,MAXL) -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' - INTEGER*4 SD ! (i) socket descriptor - BYTE BUF(*) ! (m) buffer with PARM name and values - CHARACTER*(*) BUFC ! (m) idem as string - INTEGER*4 MAXL ! (i) max. length of BUF -C -C.Purpose: Get a value set for a program parameter and send it via the link -C.Returns: Status code (.TRUE. for success, .FALSE. otherwise) -C success DWC_SUCCESS -C success DWC_WILDCARD wildcard value (NR = -1 on return) -C success DWC_NULLVALUE null value (NR = 0 on return) -C warning DWC_ENDOFLOOP end of loop or CNTRL/Z -C warning DWC_STRTOOSHO string overflow during value conversion -C error DWC_PARWRANS wrong answer (in batch mode) -C fatal DWC_PARNOTFND invalid keyword -C fatal DWC_PARTOOSML ARRAY doen't contain enough elements -C fatal DWC_PARELTSML string elements in ARRAY are too short -C fatal DWC_PARNONR NR argument is required but not present -C fatal DWC_PARNOVAL no value found -C fatal DWC_PARWRDEF wrong default value given -C fatal DWC_GETINPERR error getting input -C fatal DWC_SAVEOVFLO save-string overflow -C.Notes: -C------------------------------------------------------------------------- -C -C - INTEGER*4 IS, ST, STD, NRD - INTEGER*4 NR, NBYT, NRDEF, LEND, LENS, LENDEF, PLEN, FLAGS - CHARACTER*16 KEYWORD - CHARACTER*1 DTYPE - CHARACTER*1023 STROUT - BYTE VAL(4096) - CHARACTER*4096 VALC - EQUIVALENCE (VAL,VALC) -C - INTEGER*4 GET_PARM - INTEGER*4 MSG_SET , STR_SIGLEN - INTEGER*4 LINK_WRITE -C -C -C Get the various values from the buffer. -C (convert to host byte order) -C - CALL LINK_NTOHJ (BUF(5) ,NBYT ,1) ! size of value area - CALL LINK_NTOHJ (BUF(9) ,PLEN ,1) ! length of data value - CALL LINK_NTOHJ (BUF(13) ,LEND ,1) ! length of def. string - CALL LINK_NTOHJ (BUF(17) ,NRDEF ,1) ! #defaults - CALL LINK_NTOHJ (BUF(21) ,FLAGS ,1) ! flags - CALL LINK_NTOHJ (BUF(25) ,LENS ,1) ! length of STROUT - ST = 29 - DTYPE = BUFC(ST:ST) - KEYWORD = BUFC(ST+LEND+1:ST+LEND+16) -C -C Get the defaults if they are there. -C We leave a string in the buffer. -C Numeric data is converted in the buffer itself, -C while shifting it 16 bytes to the left because -C in place conversion is not possible. -C Note that if NRDEF is undefined, the first -C byte of the data indicates if a default exists. -C - STD = ST + LEND + 16 ! skip dtype,defstr,keyword - STD = (1 + (STD-1)/8) * 8 ! 8-byte boundary - STD = STD + 1 - IF (DTYPE.EQ.'C') THEN - CALL LINK_NTOHJ (BUF(STD), LENDEF, 1) ! length def. char.value - STD = STD + 4 - ELSE - NRD = NRDEF - IF (NRDEF.EQ.UNDEF_J) THEN - IF (BUF(STD) .NE. UNDEF_B) THEN - NRD = 1 ! there is a default - STD = STD + 1 - ENDIF - ENDIF - IF (NRD.GT.0) THEN - CALL LINK_NTOH (DTYPE, BUF(STD), BUF(STD-16), NRD) - STD = STD - 16 - ENDIF - ENDIF -C -C Get the parameter value(s). -C - IF (DTYPE.EQ.'C') THEN - IS = GET_PARM (KEYWORD, VALC(:PLEN), NBYT, NR, - * BUFC(ST+1:ST+LEND), BUFC(STD:STD+LENDEF-1), - * NRDEF, FLAGS, STROUT) - ELSE - IS = GET_PARM (KEYWORD, VAL, NBYT, NR, BUFC(ST+1:ST+LEND), - * BUF(STD), NRDEF, FLAGS, STROUT(:LENS)) - ENDIF -C -C Return them to the user. -C Test if the buffer is big enough. -C - CALL LINK_HTONJ (IS , BUF(5) , 1) - CALL LINK_HTONJ (NR , BUF(9) , 1) - CALL LINK_HTONJ (LENS, BUF(13), 1) - ST = 16 - IF (NR.LT.0) NR = 0 - LENS = STR_SIGLEN (STROUT(:LENS)) - IF (DTYPE.EQ.'R') PLEN = 2*PLEN - IF (NR*PLEN + LENS .GT. MAXL) THEN - CALL WNCTXT(DWLOG,'Buffer in LINK_RCV_PARM too small') - IS = MSG_SET (DWC_GETINPERR,0) - NR = 0 - LENS = 0 - ENDIF - IF (DTYPE.EQ.'C') THEN - BUFC(ST+1:ST+NR*PLEN) = VALC(:NR*PLEN) - ELSE - CALL LINK_HTON (DTYPE, VAL, BUF(ST+1), NR) - ENDIF - ST = ST + NR*PLEN - IF (LENS.GT.0) THEN - BUFC(ST+1:ST+LENS) = STROUT(:LENS) - ST = ST + LENS - ENDIF - IS = LINK_WRITE (SD, BUF, ST) -C -C - 999 LINK_RCV_PARM = IS - RETURN - END diff --git a/src/dwarf/lnk.grp b/src/dwarf/lnk.grp deleted file mode 100644 index 31a2353227f87a7eb0fa9db9c16468afb551120b..0000000000000000000000000000000000000000 --- a/src/dwarf/lnk.grp +++ /dev/null @@ -1,55 +0,0 @@ -!+ LNK.GRP -! CMV 940120 -! -! Revisions: -! CMV 940120 Split off from gen.grp -! -! DWARF routines for sockets/links -! -! Group definition: -! -LNK.GRP -! -! Programs: -! -LINK.FOR !LINK_SV_START - !LINK_SV_ACCEPT - !LINK_CL_START - !LINK_READ - !LINK_SV_CLOSE - !LINK_SV_END - !LINK_CL_END - !LINK_GETTASK - !LINK_ERROR - !LINK_WRITE -LINKC.CUN !LINKC_SINIT Handle a logical link (LL) - !LINKC_SACC Complete a LL - !LINKC_CINIT Handle a LL - !LINKC_BREAD Read a stream of bytes over the LL - !LINKC_BWRITE Send a stream of bytes over the LL - !LINKC_SCCLOSE Close a socket - !LINKC_SCEND Release the heap - !LINKC_ERROR Get message for errno -LINKF.FOR !LINKF_SINIT - !LINKF_SACC - !LINKF_CINIT - !LINKF_BREAD - !LINKF_BWRITE - !LINKF_SCCLOSE - !LINKF_SCEND -LINKHTON.FOR !LINK_HTON - !LINK_HTOND - !LINK_HTONR - !LINK_NTOH - !LINK_NTOHD - !LINK_NTOHR -LINKHTONJ.CUN !LINK_HTONJ Convert a long integer from host to - LINKHTONJ.FVX ! network byte order - !LINK_HTONI Convert a short integer ... - !LINK_NTOHJ Convert a long integer from network - ! to host byte order - !LINK_NTOHI Convert a short integer ... -LINKRCVMSG.FOR !LINK_RCV_MSG -LINKRCVPARM.FOR !LINK_RCV_PARM -GENCERROR.CUN !GEN_CERROR Get message for errno - diff --git a/src/dwarf/msg.for b/src/dwarf/msg.for deleted file mode 100644 index 47a5e89ce6a549a6894a4b79e37d9411c72577fc..0000000000000000000000000000000000000000 --- a/src/dwarf/msg.for +++ /dev/null @@ -1,92 +0,0 @@ -C+MSG.FOR -C CMV 940121 -C -C Revisions: -C CMV 940121 Created -C -C This module is a replacement for the original DWARF Message Facility -C designed by Henny Lem, adapted by Friso Olnon and Ger van Diepen. -C -C The facility has been stripped down completely because hardly anything -C of the functionality was being used in Newstar. The facility has been -C redefined to be used together with the WNG/Newstar routines. -C -C The routine WNGIN has to be called before any of the messenger -C routines is being used. The file 'WNG_DEF' has to be included. -C This makes two global variables available: DWLOG and DWMSG. -C DWLOG is the "output device" to be used in calls to WNCTXT. -C DWMSG is used by MSG_CODE (see below) to set the message text. -C -C The routines typically used for passing messages are: -C -C IS = MSG_INIT(PROGRAM_C(*):I,FILES_J:I) -C Define the output files for the messenger, depending on the -C value of FLAG which should be a code that can be used in -C calls to WNCTXT (typically either F_T or F_TP). Program will -C be used to prefix messages and can be any string in fact. -C -C IS = MSG_SET(MSGCODE_J:I,FLAG_J:I) -C Return the MSGCODE to IS and set the message string in DWMSG -C Typically followed by CALL WNCTXT(DWLOG,DWMSG,...) -C If FLAG.EQ.0, the message is written immediately, assuming -C there are no additional arguments necessary; if the MSGCODE -C is the same as in the previous call, it is not printed. -C If FLAG.LT.0 the program name is not prefixed to the message -C -C At the moment, only error-messages are printed when FLAG.EQ.0 -C -C -C CALL WNCTXT(DWLOG,Format,...) -C -C There is no need to close the messenger. If printfiles other than -C F_T and F_P are used in MSG_INIT, they can best be given a name -C through a call to WNCFSN -C -C- -C - INTEGER FUNCTION MSG_INIT (PROGNAM,CODE) -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' -C - CHARACTER*(*) PROGNAM ! (i) program name - INTEGER CODE ! (i) output code - INTEGER MESS ! (i) message number - INTEGER FLAG ! (i) prefix program name -C -C Entry points -C - INTEGER MSG_SET -C -C Function references -C - INTEGER WNCALN -C -C Static variables -C - INTEGER LAST_STAT - CHARACTER*25 PROG - DATA PROG/' '/,LAST_STAT/0/ - SAVE PROG,LAST_STAT -C - PROG=PROGNAM - DWLOG=CODE - IF (IAND(DWLOG,F_ALL).EQ.0) DWLOG=F_T !No code: to terminal - CALL WNCFOP(DWLOG,' ') !Open files - MSG_INIT=DWC_SUCCESS !Success of course - RETURN -C - ENTRY MSG_SET(MESS,FLAG) -C - CALL GEN_GETMSG(MESS,J,DWMSG,J1,B0) !Get message text - IF (FLAG.GE.0.AND.PROG.NE.' ') - 1 DWMSG=PROG(1:WNCALN(PROG))//': '//DWMSG !Prefix - IF (FLAG.EQ.0.AND.MESS.NE.DWC_SUCCESS.AND. - 1 IAND(MESS,1).EQ.0.AND. - 1 MESS.NE.LAST_STAT) - 1 CALL WNCTXT(DWLOG,DWMSG) !Output directly - LAST_STAT=MESS !Save code - MSG_SET=MESS !Return code - RETURN -C - END diff --git a/src/dwarf/parm_6.def b/src/dwarf/parm_6.def deleted file mode 100644 index f891fd60dfab82be9d81c473701de819c26ad2f4..0000000000000000000000000000000000000000 --- a/src/dwarf/parm_6.def +++ /dev/null @@ -1,365 +0,0 @@ -C Include module PARM_6 -C Created by BLDDEF from: _$1$DIA3:[TESTDWARF.SRC.DEF]PARM.DEF; on 17-OCT-90 -C -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ -C.Ident: DEF_PARM -C.Keywords: PARM control block, Definition -C.Author: Ger van Diepen (NFRA, Dwingeloo) -C.Language: DWARF-DEF -C.Environment: VAX or Alliant -C.Comments: -C.Version: 830708 GVD - version 1 -C.Version: 831207 GVD - version 2 -C.Version: 840411 GVD - added SYSOUT and exit-handler block -C.Version: 840705 GVD - remove PARM$DWARFPART -C - extend PARM$STR to 12 bytes -C - add PARM$ISLEN -C - remove PARM__SIZE and PARM -C.Version: 840727 GVD - extended string lengths -C.Version: 850521 JPH - Add names for special nr-of-elements-per set values -C.Version: 850801 KK - Add min length keyword name (MINLKEY) -C.Version: 880622 FMO - new DWARFDEF -C - added initialization values -C - added character-string equivalents PROGNAM, STREAM -C.Version: 890317 FMO - new version: PARM_6 -C - removed inclusion of DWARF_n -C - removed fields IMG, STR and ID -C - added fields PROGSTRM and LS -C - renamed fields IMGLEN, ISLEN, KEYLEN and MINLKEY -C to LP, LPS, LK and LKMIN -C - made fields KEY and PKEY character strings -C - removed field SYMLEN and PARM_ string definitions -C - move field PARM$LK from fixed to variable part -C------------------------------------------------------------------------- -C -C Description of the common area in which the program's keywords and -C their values are kept. -C -C - INTEGER*4 PARM__LENVS - PARAMETER (PARM__LENVS =255) !lengths of value strings -C -C -C Definition of parameter area -C - INTEGER*4 PARM_LENGTH - PARAMETER (PARM_LENGTH =1) !&1 !#J !generated: field to contain the block length - INTEGER*4 PARM_TYPE - PARAMETER (PARM_TYPE =2) !&1 !#J !generated: field to contain the block type -C -C Fixed part (parameter independent) -C - INTEGER*4 PARM_PROGNAM - PARAMETER (PARM_PROGNAM =3) !&12 !#C !program name - INTEGER*4 PARM_LP - PARAMETER (PARM_LP =6) !&1 !#J !significant length of PROGNAM - INTEGER*4 PARM_STREAM - PARAMETER (PARM_STREAM =7) !&12 !#C !stream name (prefixed with '$') - INTEGER*4 PARM_LS - PARAMETER (PARM_LS =10) !&1 !#J !significant length of STREAM - INTEGER*4 PARM_PROGSTRM - PARAMETER (PARM_PROGSTRM =11) !&25 !#C !fixed part of symbol name - INTEGER*4 PARM_LPS - PARAMETER (PARM_LPS =18) !&1 !#J !significant length of <prognam>$<stream> -C - INTEGER*4 PARM_MODE - PARAMETER (PARM_MODE =19) !&1 !#J !program mode 0 = interactive, 1 = batch - INTEGER*4 PARM_PRC - PARAMETER (PARM_PRC =20) !&1 !#J !process mode 0 = main, 1 = subprocess - INTEGER*4 PARM_DEV - PARAMETER (PARM_DEV =21) !&1 !#J !input device 0 = SYS$INPUT (batch) - ! 1 = SYS$COMMAND (interactive) - ! 2 = SYS$COMMAND (subprocess) - INTEGER*4 PARM_SYSOUT - PARAMETER (PARM_SYSOUT =22) !&1 !#J !output device 0 = terminal, 1 = other -C - INTEGER*4 PARM_EXH - PARAMETER (PARM_EXH =23) !&0 !#J !exit-handler block - INTEGER*4 PARM_EHLINK - PARAMETER (PARM_EHLINK =23) !&1 !#J !forward link - INTEGER*4 PARM_EHADDR - PARAMETER (PARM_EHADDR =24) !&1 !#J !address of exit routine - INTEGER*4 PARM_EHNRARG - PARAMETER (PARM_EHNRARG =25) !&1 !#J !nr of arguments for exit routine - INTEGER*4 PARM_EHSTADDR - PARAMETER (PARM_EHSTADDR =26) !&1 !#J !address of exit status - INTEGER*4 PARM_EHSTATUS - PARAMETER (PARM_EHSTATUS =27) !&1 !#J !exit status -C - INTEGER*4 PARM_NRKEY - PARAMETER (PARM_NRKEY =28) !&1 !#J !nr of input/modify keywords - INTEGER*4 PARM_KEYLDYN - PARAMETER (PARM_KEYLDYN =29) !&1 !#J !length of all keyword entries - INTEGER*4 PARM_KEYADYN - PARAMETER (PARM_KEYADYN =30) !&1 !#J !address of dynamic storage for keyword entries -C -C Fixed field with parameter-dependent content -C - INTEGER*4 PARM_KEYACUR - PARAMETER (PARM_KEYACUR =31) !&1 !#J !address of current keyword entry -C -C -C KEYPART is a description of a keyword entry. -C - It contains all data needed for a keyword in GET_PARM. -C - It is used as a local copy of the entry for the current -C keyword; its original address is saved in KEYACUR. -C -C Definition of fixed part of keyword entry -C - INTEGER*4 PARM_KEYPART - PARAMETER (PARM_KEYPART =32) !&0 !#J - INTEGER*4 PARM_KEY - PARAMETER (PARM_KEY =32) !&16 !#C !keyword (user's parameter name) - INTEGER*4 PARM_PKEY - PARAMETER (PARM_PKEY =36) !&16 !#C !program's parameter name - INTEGER*4 PARM_LK - PARAMETER (PARM_LK =40) !&1 !#J !significant length of the keyword - INTEGER*4 PARM_LKMIN - PARAMETER (PARM_LKMIN =41) !&1 !#J !minimum-match length of the keyword - INTEGER*4 PARM_APPD - PARAMETER (PARM_APPD =42) !&1 !#J !address of keyword entry in mapped PPD file - INTEGER*4 PARM_LOOP - PARAMETER (PARM_LOOP =43) !&1 !#J !loop switch 0 = no loop attribute -C 1 = a value has been given -C 2 = end-of-loop has been given - INTEGER*4 PARM_ASK - PARAMETER (PARM_ASK =44) !&1 !#J !ask switch -1= /NOASK given for keyword -C 0 = /NOASK given for program -C 1 = /ASK given - INTEGER*4 PARM_IO - PARAMETER (PARM_IO =45) !&1 !#J !I/O type of keyword -C 1 = input -C 2 = output -C 3 = modify (=input/output) - INTEGER*4 PARM_ASKSW - PARAMETER (PARM_ASKSW =46) !&1 !#J !ask switch set by DWC_GPDEF -C TRUE = do not ask -C FALSE= ask -C -C Description of initial default value sets -C - INTEGER*4 PARM_EXELDYN - PARAMETER (PARM_EXELDYN =47) !&1 !#J !length of dynamic storage - INTEGER*4 PARM_EXEADYN - PARAMETER (PARM_EXEADYN =48) !&1 !#J !address of NVALUES/SET (and dynamic block) - INTEGER*4 PARM_EXEAVAL - PARAMETER (PARM_EXEAVAL =49) !&1 !#J !address of the value block - INTEGER*4 PARM_EXEASW - PARAMETER (PARM_EXEASW =50) !&1 !#J !address of the "defined" switch array - INTEGER*4 PARM_EXENRS - PARAMETER (PARM_EXENRS =51) !&1 !#J !nr of value sets - INTEGER*4 PARM_EXEVPS - PARAMETER (PARM_EXEVPS =52) !&1 !#J !reserved nr of value per set -C - INTEGER*4 PARM_EXETYPE - PARAMETER (PARM_EXETYPE =53) !&1 !#J !type of values -C 0 = no value -C 1 = SPECIFY default -C 2 = PIN default -C -C Description of current default value sets (analogous) -C - INTEGER*4 PARM_DEFLDYN - PARAMETER (PARM_DEFLDYN =54) !&1 !#J !length - INTEGER*4 PARM_DEFADYN - PARAMETER (PARM_DEFADYN =55) !&1 !#J !address - INTEGER*4 PARM_DEFAVAL - PARAMETER (PARM_DEFAVAL =56) !&1 !#J - INTEGER*4 PARM_DEFASW - PARAMETER (PARM_DEFASW =57) !&1 !#J - INTEGER*4 PARM_DEFNRS - PARAMETER (PARM_DEFNRS =58) !&1 !#J - INTEGER*4 PARM_DEFVPS - PARAMETER (PARM_DEFVPS =59) !&1 !#J -C - INTEGER*4 PARM_DEFSNR - PARAMETER (PARM_DEFSNR =60) !&1 !#J !nr of current set - INTEGER*4 PARM_DEFPTR - PARAMETER (PARM_DEFPTR =61) !&1 !#J !pointer to current value in current set - INTEGER*4 PARM_DEFCNT - PARAMETER (PARM_DEFCNT =62) !&1 !#J !counter for TO/BY arrays -C - INTEGER*4 PARM_DEFLDEF - PARAMETER (PARM_DEFLDEF =63) !&1 !#J !length of current default set - INTEGER*4 PARM_DEFADEF - PARAMETER (PARM_DEFADEF =64) !&1 !#J !address of current default set -C -C Description of value sets to use (analogous) -C - INTEGER*4 PARM_VALLDYN - PARAMETER (PARM_VALLDYN =65) !&1 !#J !length - INTEGER*4 PARM_VALADYN - PARAMETER (PARM_VALADYN =66) !&1 !#J !address - INTEGER*4 PARM_VALAVAL - PARAMETER (PARM_VALAVAL =67) !&1 !#J - INTEGER*4 PARM_VALASW - PARAMETER (PARM_VALASW =68) !&1 !#J - INTEGER*4 PARM_VALNRS - PARAMETER (PARM_VALNRS =69) !&1 !#J - INTEGER*4 PARM_VALVPS - PARAMETER (PARM_VALVPS =70) !&1 !#J -C - INTEGER*4 PARM_VALSNR - PARAMETER (PARM_VALSNR =71) !&1 !#J - INTEGER*4 PARM_VALPTR - PARAMETER (PARM_VALPTR =72) !&1 !#J - INTEGER*4 PARM_VALCNT - PARAMETER (PARM_VALCNT =73) !&1 !#J -C -C Description of saved value string -C - INTEGER*4 PARM_SAVLEN - PARAMETER (PARM_SAVLEN =74) !&1 !#J !length - INTEGER*4 PARM_SAVADR - PARAMETER (PARM_SAVADR =75) !&1 !#J !address -C - INTEGER*4 PARM_KEYEND - PARAMETER (PARM_KEYEND =76) !&1 !#J !marks the end of KEYPART - INTEGER*4 PARM__LENGTH - PARAMETER (PARM__LENGTH =76) !generated: block length (in longwords) - INTEGER*4 PARM__TYPE - PARAMETER (PARM__TYPE =11) !generated: block type -C -C Parameter for the length of KEYPART -C - INTEGER*4 PARM__LENKP - PARAMETER (PARM__LENKP=4*(PARM_KEYEND-PARM_KEYPART)) - INTEGER*4 PARM__DEFTYP - PARAMETER (PARM__DEFTYP=7) - INTEGER*4 PARM__DEFVSN - PARAMETER (PARM__DEFVSN=6) -C - EXTERNAL PARM_BLOCK -C -C Common block specification -C - INTEGER*4 PARM$LENGTH - EQUIVALENCE (PARM$LENGTH,PARM__(0)) - INTEGER*4 PARM$TYPE - EQUIVALENCE (PARM$TYPE,PARM__(4)) - CHARACTER*12 PARM$PROGNAM - EQUIVALENCE (PARM$PROGNAM,PARM__(8)) - INTEGER*4 PARM$LP - EQUIVALENCE (PARM$LP,PARM__(20)) - CHARACTER*12 PARM$STREAM - EQUIVALENCE (PARM$STREAM,PARM__(24)) - INTEGER*4 PARM$LS - EQUIVALENCE (PARM$LS,PARM__(36)) - CHARACTER*25 PARM$PROGSTRM - EQUIVALENCE (PARM$PROGSTRM,PARM__(40)) - INTEGER*4 PARM$LPS - EQUIVALENCE (PARM$LPS,PARM__(68)) - INTEGER*4 PARM$MODE - EQUIVALENCE (PARM$MODE,PARM__(72)) - INTEGER*4 PARM$PRC - EQUIVALENCE (PARM$PRC,PARM__(76)) - INTEGER*4 PARM$DEV - EQUIVALENCE (PARM$DEV,PARM__(80)) - INTEGER*4 PARM$SYSOUT - EQUIVALENCE (PARM$SYSOUT,PARM__(84)) - INTEGER*4 PARM$EXH(1) - EQUIVALENCE (PARM$EXH,PARM__(88)) - INTEGER*4 PARM$EHLINK - EQUIVALENCE (PARM$EHLINK,PARM__(88)) - INTEGER*4 PARM$EHADDR - EQUIVALENCE (PARM$EHADDR,PARM__(92)) - INTEGER*4 PARM$EHNRARG - EQUIVALENCE (PARM$EHNRARG,PARM__(96)) - INTEGER*4 PARM$EHSTADDR - EQUIVALENCE (PARM$EHSTADDR,PARM__(100)) - INTEGER*4 PARM$EHSTATUS - EQUIVALENCE (PARM$EHSTATUS,PARM__(104)) - INTEGER*4 PARM$NRKEY - EQUIVALENCE (PARM$NRKEY,PARM__(108)) - INTEGER*4 PARM$KEYLDYN - EQUIVALENCE (PARM$KEYLDYN,PARM__(112)) - INTEGER*4 PARM$KEYADYN - EQUIVALENCE (PARM$KEYADYN,PARM__(116)) - INTEGER*4 PARM$KEYACUR - EQUIVALENCE (PARM$KEYACUR,PARM__(120)) - INTEGER*4 PARM$KEYPART(1) - EQUIVALENCE (PARM$KEYPART,PARM__(124)) - CHARACTER*16 PARM$KEY - EQUIVALENCE (PARM$KEY,PARM__(124)) - CHARACTER*16 PARM$PKEY - EQUIVALENCE (PARM$PKEY,PARM__(140)) - INTEGER*4 PARM$LK - EQUIVALENCE (PARM$LK,PARM__(156)) - INTEGER*4 PARM$LKMIN - EQUIVALENCE (PARM$LKMIN,PARM__(160)) - INTEGER*4 PARM$APPD - EQUIVALENCE (PARM$APPD,PARM__(164)) - INTEGER*4 PARM$LOOP - EQUIVALENCE (PARM$LOOP,PARM__(168)) - INTEGER*4 PARM$ASK - EQUIVALENCE (PARM$ASK,PARM__(172)) - INTEGER*4 PARM$IO - EQUIVALENCE (PARM$IO,PARM__(176)) - INTEGER*4 PARM$ASKSW - EQUIVALENCE (PARM$ASKSW,PARM__(180)) - INTEGER*4 PARM$EXELDYN - EQUIVALENCE (PARM$EXELDYN,PARM__(184)) - INTEGER*4 PARM$EXEADYN - EQUIVALENCE (PARM$EXEADYN,PARM__(188)) - INTEGER*4 PARM$EXEAVAL - EQUIVALENCE (PARM$EXEAVAL,PARM__(192)) - INTEGER*4 PARM$EXEASW - EQUIVALENCE (PARM$EXEASW,PARM__(196)) - INTEGER*4 PARM$EXENRS - EQUIVALENCE (PARM$EXENRS,PARM__(200)) - INTEGER*4 PARM$EXEVPS - EQUIVALENCE (PARM$EXEVPS,PARM__(204)) - INTEGER*4 PARM$EXETYPE - EQUIVALENCE (PARM$EXETYPE,PARM__(208)) - INTEGER*4 PARM$DEFLDYN - EQUIVALENCE (PARM$DEFLDYN,PARM__(212)) - INTEGER*4 PARM$DEFADYN - EQUIVALENCE (PARM$DEFADYN,PARM__(216)) - INTEGER*4 PARM$DEFAVAL - EQUIVALENCE (PARM$DEFAVAL,PARM__(220)) - INTEGER*4 PARM$DEFASW - EQUIVALENCE (PARM$DEFASW,PARM__(224)) - INTEGER*4 PARM$DEFNRS - EQUIVALENCE (PARM$DEFNRS,PARM__(228)) - INTEGER*4 PARM$DEFVPS - EQUIVALENCE (PARM$DEFVPS,PARM__(232)) - INTEGER*4 PARM$DEFSNR - EQUIVALENCE (PARM$DEFSNR,PARM__(236)) - INTEGER*4 PARM$DEFPTR - EQUIVALENCE (PARM$DEFPTR,PARM__(240)) - INTEGER*4 PARM$DEFCNT - EQUIVALENCE (PARM$DEFCNT,PARM__(244)) - INTEGER*4 PARM$DEFLDEF - EQUIVALENCE (PARM$DEFLDEF,PARM__(248)) - INTEGER*4 PARM$DEFADEF - EQUIVALENCE (PARM$DEFADEF,PARM__(252)) - INTEGER*4 PARM$VALLDYN - EQUIVALENCE (PARM$VALLDYN,PARM__(256)) - INTEGER*4 PARM$VALADYN - EQUIVALENCE (PARM$VALADYN,PARM__(260)) - INTEGER*4 PARM$VALAVAL - EQUIVALENCE (PARM$VALAVAL,PARM__(264)) - INTEGER*4 PARM$VALASW - EQUIVALENCE (PARM$VALASW,PARM__(268)) - INTEGER*4 PARM$VALNRS - EQUIVALENCE (PARM$VALNRS,PARM__(272)) - INTEGER*4 PARM$VALVPS - EQUIVALENCE (PARM$VALVPS,PARM__(276)) - INTEGER*4 PARM$VALSNR - EQUIVALENCE (PARM$VALSNR,PARM__(280)) - INTEGER*4 PARM$VALPTR - EQUIVALENCE (PARM$VALPTR,PARM__(284)) - INTEGER*4 PARM$VALCNT - EQUIVALENCE (PARM$VALCNT,PARM__(288)) - INTEGER*4 PARM$SAVLEN - EQUIVALENCE (PARM$SAVLEN,PARM__(292)) - INTEGER*4 PARM$SAVADR - EQUIVALENCE (PARM$SAVADR,PARM__(296)) - INTEGER*4 PARM$KEYEND - EQUIVALENCE (PARM$KEYEND,PARM__(300)) - BYTE PARM__(0:303) - INTEGER*4 PARM_(76) - EQUIVALENCE (PARM_,PARM__) -C - COMMON /PARM_COMMON/ PARM_ -C diff --git a/src/dwarf/parmblock.for b/src/dwarf/parmblock.for deleted file mode 100644 index ec3a71455827864156c2cbb0ce410d2c3823487e..0000000000000000000000000000000000000000 --- a/src/dwarf/parmblock.for +++ /dev/null @@ -1,112 +0,0 @@ - BLOCK DATA PARM_BLOCK -C Created by BLDDEF from: _$1$DIA3:[TESTDWARF.SRC.DEF]PARM.DEF; on 17-OCT-90 -C HjV 921208 Removed all equivalence and add names to common block -C AXC 010709 linux-port -data init -C -C -C - INTEGER*4 PARM$LENGTH - INTEGER*4 PARM$TYPE - CHARACTER*12 PARM$PROGNAM - INTEGER*4 PARM$LP - CHARACTER*12 PARM$STREAM - INTEGER*4 PARM$LS - CHARACTER*25 PARM$PROGSTRM - INTEGER*4 PARM$LPS - INTEGER*4 PARM$MODE - INTEGER*4 PARM$PRC - INTEGER*4 PARM$DEV - INTEGER*4 PARM$SYSOUT - INTEGER*4 PARM$EXH(1) - INTEGER*4 PARM$EHLINK - INTEGER*4 PARM$EHADDR - INTEGER*4 PARM$EHNRARG - INTEGER*4 PARM$EHSTADDR - INTEGER*4 PARM$EHSTATUS - INTEGER*4 PARM$NRKEY - INTEGER*4 PARM$KEYLDYN - INTEGER*4 PARM$KEYADYN - INTEGER*4 PARM$KEYACUR - INTEGER*4 PARM$KEYPART(1) - CHARACTER*16 PARM$KEY - CHARACTER*16 PARM$PKEY - INTEGER*4 PARM$LK - INTEGER*4 PARM$LKMIN - INTEGER*4 PARM$APPD - INTEGER*4 PARM$LOOP - INTEGER*4 PARM$ASK - INTEGER*4 PARM$IO - INTEGER*4 PARM$ASKSW - INTEGER*4 PARM$EXELDYN - INTEGER*4 PARM$EXEADYN - INTEGER*4 PARM$EXEAVAL - INTEGER*4 PARM$EXEASW - INTEGER*4 PARM$EXENRS - INTEGER*4 PARM$EXEVPS - INTEGER*4 PARM$EXETYPE - INTEGER*4 PARM$DEFLDYN - INTEGER*4 PARM$DEFADYN - INTEGER*4 PARM$DEFAVAL - INTEGER*4 PARM$DEFASW - INTEGER*4 PARM$DEFNRS - INTEGER*4 PARM$DEFVPS - INTEGER*4 PARM$DEFSNR - INTEGER*4 PARM$DEFPTR - INTEGER*4 PARM$DEFCNT - INTEGER*4 PARM$DEFLDEF - INTEGER*4 PARM$DEFADEF - INTEGER*4 PARM$VALLDYN - INTEGER*4 PARM$VALADYN - INTEGER*4 PARM$VALAVAL - INTEGER*4 PARM$VALASW - INTEGER*4 PARM$VALNRS - INTEGER*4 PARM$VALVPS - INTEGER*4 PARM$VALSNR - INTEGER*4 PARM$VALPTR - INTEGER*4 PARM$VALCNT - INTEGER*4 PARM$SAVLEN - INTEGER*4 PARM$SAVADR - INTEGER*4 PARM$KEYEND -C - COMMON /PARM_COMMON/ PARM$LENGTH, PARM$TYPE, PARM$PROGNAM, - * PARM$LP, PARM$STREAM, PARM$LS, PARM$PROGSTRM, PARM$LPS, - * PARM$MODE, PARM$PRC, PARM$DEV, PARM$SYSOUT, PARM$EHLINK, - * PARM$EHADDR, PARM$EHNRARG, PARM$EHSTADDR, PARM$EHSTATUS, - * PARM$NRKEY, PARM$KEYLDYN, PARM$KEYADYN, PARM$KEYACUR, - * PARM$KEY, PARM$PKEY, PARM$LK, PARM$LKMIN, - * PARM$APPD, PARM$LOOP, PARM$ASK, PARM$IO, PARM$ASKSW, - * PARM$EXELDYN, PARM$EXEADYN, PARM$EXEAVAL, PARM$EXEASW, - * PARM$EXENRS, PARM$EXEVPS, PARM$EXETYPE, PARM$DEFLDYN, - * PARM$DEFADYN, PARM$DEFAVAL, PARM$DEFASW, PARM$DEFNRS, - * PARM$DEFVPS, PARM$DEFSNR, - * PARM$DEFPTR, PARM$DEFCNT, PARM$DEFLDEF, PARM$DEFADEF, - * PARM$VALLDYN, PARM$VALADYN, PARM$VALAVAL, PARM$VALASW, - * PARM$VALNRS, PARM$VALVPS, PARM$VALSNR, PARM$VALPTR, - * PARM$VALCNT, PARM$SAVLEN, PARM$SAVADR, PARM$KEYEND -C -C - DATA PARM$LP /2/ - DATA PARM$STREAM /'$1'/ - DATA PARM$LS /2/ - DATA PARM$PROGSTRM /'NN$1_'/ - DATA PARM$LPS /4/ - DATA PARM$MODE /0/ - DATA PARM$PRC /0/ - DATA PARM$DEV /0/ - DATA PARM$SYSOUT /0/ - DATA PARM$NRKEY /0/ - DATA PARM$KEYLDYN /0/ - DATA PARM$KEYADYN /0/ - DATA PARM$KEYACUR /0/ - DATA PARM$LK /0/ - DATA PARM$PROGNAM /'NN'/ - END - - - - - - - - - diff --git a/src/dwarf/ppctl.for b/src/dwarf/ppctl.for deleted file mode 100644 index 8210270f6ec6dc36fd595b22cbe65d1ff82648ed..0000000000000000000000000000000000000000 --- a/src/dwarf/ppctl.for +++ /dev/null @@ -1,160 +0,0 @@ -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ -C.Ident: PP_CTL -C.Keywords: Program Parameters, Store Value, Control -C.Author: Friso Olnon (NFRA, Dwingeloo) -C.Language: DWARF-Fortran -C.Environment: VAX or Alliant -C.Comments: -C.Version: 900416 FMO - recreation -C.Version: 910910 FMO - add missing argument in STR_COPY_U call -C.Version: 920214 GvD - no optional arguments in MSG anymore -C------------------------------------------------------------------------- -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - INTEGER*4 FUNCTION PP_CTL_OPEN (PKEY,PROGSTRM,SYMBOL, - 1 LSYM,FOREIGN) -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' -C - CHARACTER*(*) PKEY ! (i) program's parameter name - CHARACTER*(*) PROGSTRM ! (i) target program and stream names - CHARACTER*(*) SYMBOL ! (o) name of symbol to be defined - INTEGER*4 LSYM ! (o) its significant length - LOGICAL*4 FOREIGN ! (o) put for foreign program ? -C -C.Purpose: Set up for PUT_PARM -C.Returns: Status code (.TRUE. for success, .FALSE. otherwise) -C success DWC_SUCCES -C fatal DWC_UNKPRKEYW unknown output-type program parameter -C false status codes returned by referenced routines -C.Notes: -C------------------------------------------------------------------------- -C -C - INTEGER*4 DWC_SYM_SPLIT, DWC_SYM_BUILD - INTEGER*4 DWC_PROG_GET, DWC_PROG_CHECK - INTEGER*4 DWC_STREAM_GET, DWC_STREAM_CHECK - INTEGER*4 PPD_SAVE, PPD_INIT, PPD_READ_P - INTEGER*4 PPD_IOCD_GET, PPD_UNAM_GET - INTEGER*4 MSG_SET , STR_SIGLEN -C - CHARACTER CURPROG*16, PROGNAM*16, STREAM*16, XSTREAM*16 - CHARACTER KEY*16, IOCD*6 - INTEGER*4 IS, LCP, LP, LS, LK, LKMIN, LIOCD - LOGICAL*4 PROTO, IS_GLOBAL -C -C - FOREIGN = .FALSE. - IS = DWC_PROG_GET (CURPROG,LCP) - IF (IAND(IS,1).EQ.0) GOTO 999 -C -C Isolate and check the names of -C the target program and stream -C - use the current names as defaults -C - IS = DWC_SYM_SPLIT (PROGSTRM,PROGNAM,LP,STREAM,LS,KEY,LK) - IF (IAND(IS,1).EQ.0) GOTO 999 - IF (LP.EQ.0) PROGNAM = CURPROG - IS = DWC_PROG_CHECK (PROGNAM,LP,IS_GLOBAL) - IF (IAND(IS,1).EQ.0) GOTO 999 - IF (LS.EQ.0) THEN - IS = DWC_STREAM_GET (STREAM,LS,IS_GLOBAL) - ELSE - IS = DWC_STREAM_CHECK (STREAM,XSTREAM,LS,IS_GLOBAL) - ENDIF - IF (IAND(IS,1).EQ.0) GOTO 999 -C -C If target is not the current program: -C - save the current PPD-status block -C - set the flag for later PPD restore -C - open the PPD file of the target -C - IF (PROGNAM(:LP).NE.CURPROG(:LCP)) THEN - IS = PPD_SAVE () - IF (IAND(IS,1).EQ.0) GOTO 999 - FOREIGN = .TRUE. - IS = PPD_INIT (PROGNAM(:LP)) - IF (IAND(IS,1).EQ.0) GOTO 999 - ENDIF -C -C Read the parameter definition (PPD) -C - check the IO code (output or modify) -C - get the user's parameter name -C - build the full symbol name -C - LK = STR_SIGLEN (PKEY) - IS = PPD_READ_P (PKEY(:LK)) - IF (IAND(IS,1).NE.0) IS = PPD_IOCD_GET (IOCD,LIOCD) - IF (INDEX('OM',IOCD(1:1)).EQ.0) GOTO 992 -C - IS = PPD_UNAM_GET (KEY,LK,LKMIN,PROTO) - IF (IAND(IS,1).NE.0) IS = DWC_SYM_BUILD - 1 (PROGNAM(:LP),STREAM(:LS),KEY(:LK),SYMBOL,LSYM) - IF (IAND(IS,1).EQ.0) GOTO 999 -C -C - PP_CTL_OPEN = DWC_SUCCESS - RETURN -C - 992 PP_CTL_OPEN = MSG_SET (DWC_UNKPRKEYW,1) - CALL WNCTXT(DWLOG,DWMSG,PKEY(:LK), - 1 ' output-',PROGNAM) - RETURN - 999 PP_CTL_OPEN = IS - RETURN - END -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - INTEGER*4 FUNCTION PP_CTL_CLOSE (PROGSTRM,FOREIGN) -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' -C - CHARACTER*(*) PROGSTRM ! (i) target program and stream names - LOGICAL*4 FOREIGN ! (i) put for foreign program ? -C -C.Purpose: Close the PUT_PARM operations -C.Returns: Status code (.TRUE. for success, .FALSE. otherwise) -C success DWC_SUCCES -C false status codes returned by referenced routines -C.Notes: -C------------------------------------------------------------------------- -C -C - INTEGER*4 DWC_CTL_FILL - INTEGER*4 PPD_EXIT, PPD_RESTORE - INTEGER*4 STR_COPY_U -C - CHARACTER PROGNAM*9 - INTEGER*4 LP, IS, PTR -C -C -C If a "foreign" program was used: -C - close its PPD file -C - if the program is DWARF: redefine -C the symbol DWARF_CONTROL_COMMON -C - restore the PPD status block of the -C current program -C - IF (FOREIGN) THEN - IS = PPD_EXIT () - IF (IAND(IS,1).EQ.0) GOTO 991 - LP = 0 - PTR = 1 - IS = STR_COPY_U ('$',PROGSTRM,PTR,PROGNAM,LP) - IF (PROGNAM(:LP).EQ.'DWARF') THEN - IS = DWC_CTL_FILL () - IF (IAND(IS,1).EQ.0) GOTO 991 - ENDIF - IS = PPD_RESTORE () - IF (IAND(IS,1).EQ.0) GOTO 992 - ENDIF -C -C - PP_CTL_CLOSE = DWC_SUCCESS - RETURN -C - 991 PP_CTL_CLOSE = IS - IS = PPD_RESTORE () - 992 IF (IAND(IS,1).EQ.0) PP_CTL_CLOSE = IS - RETURN - END diff --git a/src/dwarf/ppd.grp b/src/dwarf/ppd.grp deleted file mode 100644 index 9904b6ecd22bbc7d6828a507e8255b733e365f8e..0000000000000000000000000000000000000000 --- a/src/dwarf/ppd.grp +++ /dev/null @@ -1,127 +0,0 @@ -!+ PPD.GRP -! WNB 920915 -! -! Revisions: -! HjV 921104 Add function and entry names -! WNB 931129 Change PPDHELP from for to fsc -! CMV 940120 Moved CPLVALLIST in (only used by PPDMIN/PPDOPSTR) -! CMV 940131 Move .DEF files here, moved BPD to CPL.GRP -! HjV 940217 Add/change missing entry-points/functions -! -! Routines used to read PPD files -! -! Group definition: -! -PPD.GRP -! -! Masks for program development -! -! PIN files -! -! Structure files -! -PPDREC_4.DEF ! Used by bpdindex/parm/write and most ppd* - PPDRECBLOCK.FOR !PPDREC_BLOCK -PPDSTAT_2.DEF ! Used by ppdfile/index/parm/stat - PPDSTATBLOCK.FOR !PPDSTAT_BLOCK -! -! General command files -! -! -! Initialisation command files -! -! -! Fortran definition files: -! -! -! Programs: -! -PPDAMAS.FOR !PPD_AMAS_PUT - !PPD_AMAS_GET -PPDCHECK.FOR !PPD_CHECK - !PPD_CHECK_ASC - !PPD_CHECK_NDE - !PPD_CHECK_DES - !PPD_CHECK_NAS - !PPD_CHECK_NODE -PPDCMAS.FOR !PPD_CMAS_PUT - !PPD_CMAS_GET -PPDDTYPE.FOR !PPD_DTYPE_PUT - !PPD_PLEN_PUT - !PPD_DTYPE_GET - !PPD_DTYPE_XGET -PPDDVSTR.FOR !PPD_DVSTR_PUT - !PPD_DVSTR_GET - !PPD_DVSTR_XGET -PPDFAO.FOR !PPD_FAO -PPDHELP.FSC !PPD_HELP - !PPD_HELP_PRINT - !PPD_HELP_OUT - !PPD_HELP_MORE - !PPD_HELP_MORE1 -PPDHSTR.FOR !PPD_HSTR_PUT - !PPD_HSTR_XGET -PPDINDEX.FOR !PPD_INDEX_GETP - !PPD_INDEX_GETU - !PPD_INDEX_GETNXT -PPDINIT.FOR !PPD_INIT - !PPD_EXIT - !PPD_SAVE - !PPD_RESTORE -PPDIOCD.FOR !PPD_IOCD_PUT - !PPD_IOCD_GET -PPDLENG.FOR !PPD_LENG_INIT -PPDLIST.FOR !PPD_LIST -PPDMIN.FOR !PPD_MIN_PUT - !PPD_MIN_GET - !PPD_MIN_XGET - !PPD_MAX_PUT - !PPD_MAX_GET - !PPD_MAX_XGET -PPDNSETS.FOR !PPD_NSETS_PUT - !PPD_NSETS_GET -PPDNVAL.FOR !PPD_NVAL_PUT - !PPD_MNVAL_PUT - !PPD_MXVAL_PUT - !PPD_NVAL_GET - !PPD_NVAL_XGET -PPDOPSTR.FOR !PPD_OPSTR_PUT - !PPD_OPSTR_GET - !PPD_OPSTR_XGET - !PPD_OPSTR_MATCH -PPDPARM.FOR !PPD_PARM_GET - !PPD_PARM_NEXT - !PPD_PROTO_GET - !PPD_PROTO_NEXT -PPDPROMPT.FOR !PPD_PROMPT -PPDPRSTR.FOR !PPD_PRSTR_PUT - !PPD_PRSTR_GET - !PPD_PRSTR_XGET -PPDREAD.FOR !PPD_READ_P - !PPD_READ_U - !PPD_READ_PNXT - !PPD_READ_UNXT -PPDSSTR.FOR !PPD_SSTR_PUT - !PPD_SSTR_GET - !PPD_SSTR_XGET - !PPD_SSTR_SPLIT -PPDSTAT.FOR !PPD_STAT_CLEAR - !PPD_STAT_FILL - !PPD_STAT_INQ - !PPD_STAT_INQT - !PPD_STAT_SETT - !PPD_STAT_SAVE - !PPD_STAT_RESTORE -PPDUNAM.FOR !PPD_UNAM_PUT - !PPD_PNAM_PUT - !PPD_UNAM_GET - !PPD_PNAM_GET -PPDUSTR.FOR !PPD_USTR_PUT - !PPD_USTR_GET - !PPD_USTR_XGET -! -CPLVALLIST.FOR !CPL_VALLIST -! -! Executables -! -!- diff --git a/src/dwarf/ppd.ref b/src/dwarf/ppd.ref deleted file mode 100644 index e69de29bb2d1d6434b8b29ae775ad8c2e48c5391..0000000000000000000000000000000000000000 diff --git a/src/dwarf/ppdamas.for b/src/dwarf/ppdamas.for deleted file mode 100644 index 8306d882a5bd58ee3c696847fa7c6528dfebf3a8..0000000000000000000000000000000000000000 --- a/src/dwarf/ppdamas.for +++ /dev/null @@ -1,160 +0,0 @@ -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ -C.Ident: PPD_AMAS -C.Keywords: PPD File, Parameter Attributes -C.Author: Friso Olnon (NFRA, Dwingeloo) -C.Language: DWARF-Fortran -C.Environment: VAX or Alliant -C.Comments: -C Common variables used: -C INTEGER*4 PPDPD$AMAS ! (m) attribute mask -C -C.Version: 900415 FMO - recreation -C------------------------------------------------------------------------- -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - INTEGER*4 FUNCTION PPD_AMAS_PUT (LIST,DO_CHECK) -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' -C - CHARACTER*(*) LIST ! (i) list of proposed attributes - LOGICAL*4 DO_CHECK ! (i) check internal consistency ? -C -C.Purpose: Check and store the attributes for a program parameter -C.Returns: Status code (.TRUE. for success, .FALSE. otherwise) -C success PPD_SUCCESS -C error PPD_CHATINV invalid attribute name -C error PPD_CHATNUNI ambiguously abbreviated attribute name -C error PPD_UNDONLVEC undefined values only allowed for vectors -C error PPD_NNDNOTNOD null-node check invalid (no node attribute) -C.Notes: -C - The list should be a comma-separated list of valid attribute names. -C It will be converted to a bitmask and stored in the current -C parameter description (field PPDPD$AMAS). -C - If an invalid attribute name or conflicting attributes are given, -C the default mask (no attributes at all) will be stored. -C - If DO_CHECK is off, only the compatibility with the requested checks -C will be checked. -C - In case of errors, no messages are stored in the regular message -C buffer. The calling routine (BPD_BUILD) takes care of that. -C------------------------------------------------------------------------- -C - INCLUDE 'PPDREC_4_DEF' -C - CHARACTER*(*) COMMA, EMPTVAL - PARAMETER (COMMA = ',' ) - PARAMETER (EMPTVAL = '[]') -C - INTEGER*4 MAXNR, DEFMASK - PARAMETER (MAXNR = 11) - PARAMETER (DEFMASK = 0 ) - CHARACTER*16 NAMES(MAXNR) - DATA NAMES / - 1 'LOOP', 'VECTOR', - 2 'WILD_CARDS', 'IMMEDIATE', - 3 'ASK', 'UNDEFINED_VALUES', - 4 'TEST', 'PUT_GLOBAL', - 5 'DYNAMIC', 'NULL_VALUES', - 6 'NULL_NODE' / -C - INTEGER*4 PPD_CMAS_GET - INTEGER*4 STR_SIGLEN, STR_MATCH_A, STR_COPY_U -C - CHARACTER*16 NAME - INTEGER*4 IS, LL, LN, PTR, NR -C -C -C Check and convert name by name -C - extract the next name -C - check it -C - set the corresponding bit in the mask -C - IF (DO_CHECK) THEN - PPDPD$AMAS = DEFMASK - LL = STR_SIGLEN (LIST) - IF (LL.GT.0 .AND. LIST(:LL).NE.EMPTVAL) THEN - PTR = 1 - DO WHILE (PTR.LE.LL) - LN = 0 - IS = STR_COPY_U (COMMA,LIST(:LL),PTR,NAME,LN) - IS = STR_MATCH_A (NAME(:LN),MAXNR,NAMES,NR) - IF (IAND(IS,1).EQ.0) THEN - IF (IS.EQ.0) THEN - IS = PPD_CHATNUNI - ELSE - IS = PPD_CHATINV - ENDIF - PPDPD$AMAS = DEFMASK - GOTO 999 - ENDIF - PPDPD$AMAS = IBSET (PPDPD$AMAS,NR-1) - PTR = PTR+1 - ENDDO - ENDIF -C -C Check internal consistency -C - 'UNDEFINED_VALUES' only if 'VECTOR' -C - IF (BTEST(PPDPD$AMAS,5) .AND. .NOT.BTEST(PPDPD$AMAS,1)) THEN - IS = PPD_UNDONLVEC - PPDPD$AMAS = DEFMASK - GOTO 999 - ENDIF - ENDIF -C -C Check consistency with checks -C - 'NULL_NODE' only if 'NODE' check -C - IF (BTEST(PPDPD$AMAS,10) - 1 .AND. IAND(PPD_CMAS_GET('NODE'),1).EQ.0) THEN - IS = PPD_NNDNOTNOD - GOTO 999 - ENDIF -C -C - PPD_AMAS_PUT = PPD_SUCCESS - RETURN -C - 999 PPD_AMAS_PUT = IS - RETURN - END -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - INTEGER*4 FUNCTION PPD_AMAS_GET (NAME) -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' -C - CHARACTER*(*) NAME ! (i) (abbrev) name of attribute -C -C.Purpose: Check whether the named attribute is present -C.Returns: Status code (.TRUE. for success, .FALSE. otherwise) -C.Notes: -C A false status code is also returned if the attribute name is not -C correct. -C------------------------------------------------------------------------- -C - INCLUDE 'PPDREC_4_DEF' -C - INTEGER*4 MAXNR - PARAMETER (MAXNR = 11) - CHARACTER*16 NAMES(MAXNR) - DATA NAMES / - 1 'LOOP', 'VECTOR', - 2 'WILD_CARDS', 'IMMEDIATE', - 3 'ASK', 'UNDEFINED_VALUES', - 4 'TEST', 'PUT_GLOBAL', - 5 'DYNAMIC', 'NULL_VALUES', - 6 'NULL_NODE' / -C - INTEGER*4 STR_MATCH_A -C - INTEGER*4 IS, NR -C -C - IS = STR_MATCH_A (NAME,MAXNR,NAMES,NR) - IF (IAND(IS,1).EQ.0) GOTO 999 -C - IF (.NOT.BTEST (PPDPD$AMAS,NR-1)) IS = 0 -C - 999 PPD_AMAS_GET = IS - RETURN - END diff --git a/src/dwarf/ppdcheck.for b/src/dwarf/ppdcheck.for deleted file mode 100644 index 78598aca1d7fe2fa54c8656355c5849efabf38ba..0000000000000000000000000000000000000000 --- a/src/dwarf/ppdcheck.for +++ /dev/null @@ -1,633 +0,0 @@ -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ -C.Ident: PPD_CHECK -C.Keywords: PPD File, Check Parameter Values -C.Author: Friso Olnon (NFRA, Dwingeloo) -C.Language: DWARF-Fortran -C.Environment: VAX or Alliant -C.Comments: -C.Version: 900415 FMO - recreation -C.Version: 920224 GvD - no optional arguments in MSG anymore -C.Version: 920413 GvD - define SWARR as log*4 iso. log*1 -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - INTEGER*4 FUNCTION PPD_CHECK (ARR,NVSPEC,NVRES,SWARR,NSETS) -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' -C - BYTE ARR(*) ! (m) value array to be checked - INTEGER*4 NVSPEC(*) ! (i) nr of specified values per set - INTEGER*4 NVRES ! (i) nr of reserved values in each set - LOGICAL*4 SWARR(*) ! (i) "value defined" switch array - INTEGER*4 NSETS ! (i) nr of value-sets in ARR -C -C.Purpose: Check the array of values for a program parameter -C.Returns: Status code (.TRUE. for success, .FALSE. otherwise) -C success PPD_SUCCESS -C error PPD_ERRMINCHK error in check against minimum value -C error PPD_ERRMAXCHK error in check against maximum value -C error PPD_NUMSETMAX number of value-sets exceeds maximum -C error PPD_NUMVALMIN number of values less than minimum -C error PPD_NUMVALMAX number of values exceeds maximum -C error PPD_VALLSSMIN value less than minimum -C error PPD_VALEXCMAX value exceeds maximum -C error PPD_STRNOTALP string not alphabetic -C error PPD_STRNOTNUM string not numeric -C error PPD_STRNOTAN string not alpha-numeric -C error DBD_BADNODE bad node name -C false status returned by referenced routines -C.Notes: -C - ARR(PLEN,NVRES,NSETS) overlays the value array VALARR(NVRES,NSETS), -C of datatype DTYPE and a value length of PLEN bytes. -C - NVSPEC(NSETS) -C - SWARR(NVRES,NSETS) tells for each element in VALARR whether or not -C the value was specified. This array has significance for vectors only. -C - For scalars and numeric arrays, VALARR is always in TO/BY format: -C triplets of values (start, end, step). -C - For vectors and character arrays, VALARR just contains normal values. -C -C The following checks are performed: -C -C Number of value sets -C - For arrays and vectors, NSETS should not exceed the maximum nr of sets -C allowed for the parameter (field PPDPD$NSETS in the PPD file). -C - For scalars, the total nr of values in VALARR should not exceed the -C maximum nr of sets. The nr of values is counted via the routine -C PV_SET_TOBY_C. -C -C Number of values per set -C - For vectors, NVSPEC must be within limits (fields PPDPD$MNVAL and -C PPDPD$MXVAL). -C - For arrays, the nr of values per set should not exceed PPDPD$MXVAL. -C The nr of values is counted via the routine PV_SET_TOBY_C. -C -C Checks on individual values -C - The PPD field PPDPD$CMAS tells which checks have to be performed. -C - If the abbreviated_option check is requested and the value is a valid -C abbreviation, it will be replaced by the full option. -C------------------------------------------------------------------------- -C -C - INTEGER*4 SIZE - PARAMETER (SIZE = 256) -C - INTEGER*4 PPD_AMAS_GET ,PPD_CMAS_GET ,PPD_DTYPE_GET - INTEGER*4 PPD_NVAL_GET ,PPD_NSETS_GET ,PPD_OPSTR_MATCH - INTEGER*4 PPD_MIN_GET ,PPD_MAX_GET - INTEGER*4 PPD_CHECK_ASC ,PPD_CHECK_DES ,PPD_CHECK_NAS - INTEGER*4 PPD_CHECK_NDE ,PPD_CHECK_NODE ,PPD_FAO - INTEGER*4 PV_SET_TOBY_C - INTEGER*4 STR_SIGLEN - INTEGER*4 STR_CHECK_ALPH ,STR_CHECK_NUM ,STR_CHECK_ANUM - INTEGER*4 MSG_SET ,MOVE_BLB ,BLB_COMPARE -C - CHARACTER DTYPE*1, STRING*(SIZE) - BYTE MIN(SIZE), MAX(SIZE) - INTEGER*4 LSTR, LMIN, LMAX - INTEGER*4 PLEN, NVALS, MINNVALS, MAXNVALS, MAXNSETS - INTEGER*4 IS, SNR, VNR, SPTR, VPTR, MPTR, PTR - INTEGER*4 CNT, NSCALARS - LOGICAL*4 TOBY, VECTOR, SCALAR - LOGICAL*4 CHMIN, CHMAX, CHASC, CHDES, CHNAS, CHNDE - LOGICAL*4 CHALP, CHNUM, CHANM, CHOPT, CHOPS, CHNOD -C -C -C Get data from the parameter description -C - datatype and parameter length -C - skip checking of logical parms -C - IS = PPD_DTYPE_GET (DTYPE,PLEN) - IF (IAND(IS,1).EQ.0) GOTO 999 - IF (DTYPE.EQ.'L') GOTO 900 -C -C - max nr of sets -C - (min/max) nr of values per set -C - IS = PPD_NSETS_GET (MAXNSETS) - IF (IAND(IS,1).NE.0) IS = PPD_NVAL_GET (NVALS,MINNVALS,MAXNVALS) - IF (IAND(IS,1).EQ.0) GOTO 999 -C -C - parameter attributes -C - VECTOR = IAND(PPD_AMAS_GET ('VECTOR'),1) .NE. 0 - TOBY = .NOT.VECTOR .AND. DTYPE.NE.'C' - SCALAR = NVALS.EQ.1 -C -C - checks to be performed -C - CHMIN = IAND(PPD_CMAS_GET ('MINIMUM') ,1) .NE. 0 - CHMAX = IAND(PPD_CMAS_GET ('MAXIMUM') ,1) .NE. 0 - CHASC = IAND(PPD_CMAS_GET ('ASCENDING') ,1) .NE. 0 - CHDES = IAND(PPD_CMAS_GET ('DESCENDING') ,1) .NE. 0 - CHNAS = IAND(PPD_CMAS_GET ('NON_ASCENDING') ,1) .NE. 0 - CHNDE = IAND(PPD_CMAS_GET ('NON_DESCENDING'),1) .NE. 0 - CHALP = IAND(PPD_CMAS_GET ('ALPHABETIC') ,1) .NE. 0 - CHNUM = IAND(PPD_CMAS_GET ('NUMERIC') ,1) .NE. 0 - CHANM = IAND(PPD_CMAS_GET ('ANUMERIC') ,1) .NE. 0 - CHOPT = IAND(PPD_CMAS_GET ('OPTIONS') ,1) .NE. 0 - CHOPS = IAND(PPD_CMAS_GET ('ABBREV_OPTIONS'),1) .NE. 0 - CHNOD = IAND(PPD_CMAS_GET ('NODE') ,1) .NE. 0 -C -C - (arrays of) min and max values -C - IF (CHMIN) THEN - IS = PPD_MIN_GET (MIN,SIZE,LMIN) - IF (IAND(IS,1).EQ.0) THEN - IS = MSG_SET (PPD_ERRMINCHK,0) - GOTO 999 - ENDIF - ENDIF - IF (CHMAX) THEN - IS = PPD_MAX_GET (MAX,SIZE,LMAX) - IF (IAND(IS,1).EQ.0) THEN - IS = MSG_SET (PPD_ERRMAXCHK,0) - GOTO 999 - ENDIF - ENDIF -C -C Check number of sets -C - IF (.NOT.SCALAR .AND. NSETS.GT.MAXNSETS) THEN - IS = MSG_SET (PPD_NUMSETMAX,1) - CALL WNCTXT(DWLOG,DWMSG,NSETS,MAXNSETS) - GOTO 999 - ENDIF -C -C +----------------------+ -C | Checks per value set | -C +----------------------+ -C -C - skip sets without specified values -C - SPTR: start index of set in ARR -C - NSCALARS = 0 - DO SNR = 1,NSETS - IF (NVSPEC(SNR).GT.0) THEN - SPTR = (SNR-1)*PLEN*NVRES+1 -C -C Count the nr of values in the set -C - vector: only default values is OK -C - array -C - scalar: just count all values in -C all sets (-> NSCALARS) -C - NVALS = 0 - IF (VECTOR) THEN - PTR = (SNR-1)*NVRES+1 - DO VNR = 1,NVSPEC(SNR) - IF (SWARR(PTR)) NVALS = NVALS+1 - PTR = PTR+1 - ENDDO - IF (NVALS.EQ.0) NVALS = MAXNVALS - ELSE IF (DTYPE.EQ.'C') THEN ! no TO/BY - DO PTR = SPTR,SPTR+(NVSPEC(SNR)-1)*PLEN,PLEN - IF (ARR(PTR).NE.UNDEF_B) NVALS = NVALS+1 - ENDDO - IF (SCALAR) NSCALARS = NSCALARS+NVALS - ELSE ! TO/BY form - DO PTR = SPTR,SPTR+(NVSPEC(SNR)-1)*PLEN,3*PLEN - IS = PV_SET_TOBY_C (DTYPE,PLEN,ARR(PTR),CNT) - IF (IAND(IS,1).EQ.0) GOTO 999 - NVALS = NVALS+CNT+1 - ENDDO - IF (SCALAR) NSCALARS = NSCALARS+NVALS - ENDIF -C -C Check the nr of values -C - IF (.NOT.SCALAR) THEN - IF (NVALS.LT.MINNVALS) THEN - IS = MSG_SET (PPD_NUMVALMIN,1) - CALL WNCTXT(DWLOG,DWMSG,NVALS,MINNVALS) - GOTO 999 - ELSE IF (NVALS.GT.MAXNVALS) THEN - IS = MSG_SET (PPD_NUMVALMAX,1) - CALL WNCTXT(DWLOG,DWMSG,NVALS,MAXNVALS) - GOTO 999 - ENDIF - ENDIF -C -C Check the order of the values -C - IF (CHASC) THEN - IS = PPD_CHECK_ASC (ARR(SPTR),NVSPEC(SNR),DTYPE,PLEN,TOBY) - IF (IAND(IS,1).EQ.0) GOTO 999 - ELSE IF (CHNDE) THEN - IS = PPD_CHECK_NDE (ARR(SPTR),NVSPEC(SNR),DTYPE,PLEN,TOBY) - IF (IAND(IS,1).EQ.0) GOTO 999 - ELSE IF (CHNAS) THEN - IS = PPD_CHECK_NAS (ARR(SPTR),NVSPEC(SNR),DTYPE,PLEN,TOBY) - IF (IAND(IS,1).EQ.0) GOTO 999 - ELSE IF (CHDES) THEN - IS = PPD_CHECK_DES (ARR(SPTR),NVSPEC(SNR),DTYPE,PLEN,TOBY) - IF (IAND(IS,1).EQ.0) GOTO 999 - ENDIF -C -C +------------------+ -C | Checks per value | -C +------------------+ -C -C - don't check TO/BY step values -C - VPTR: start index of value in ARR -C - MPTR: start index of value in MIN/MAX -C - MPTR = 1 - DO VNR = 1,NVSPEC(SNR) - IF (.NOT.TOBY .OR. MOD(VNR,3).NE.0) THEN - VPTR = SPTR+(VNR-1)*PLEN - IF (VECTOR) MPTR = 1+(VNR-1)*PLEN -C -C Check against minimum/maximum -C - IF (CHMIN) THEN - IS = BLB_COMPARE (ARR(VPTR),MIN(MPTR),DTYPE, - 1 PLEN) - IF (IS.LT.1) THEN - IS = PPD_FAO (MIN(MPTR),PLEN,DTYPE, - 1 PLEN,STRING,LSTR) - IS = MSG_SET (PPD_VALLSSMIN,0) - CALL WNCTXT(DWLOG,DWMSG,STRING(:LSTR)) - GOTO 999 - ENDIF - ENDIF - IF (CHMAX) THEN - IS = BLB_COMPARE (ARR(VPTR),MAX(MPTR),DTYPE, - 1 PLEN) - IF (IS.GT.1) THEN - IS = PPD_FAO (MAX(MPTR),PLEN, - 1 DTYPE,PLEN,STRING,LSTR) - IS = MSG_SET (PPD_VALEXCMAX,0) - CALL WNCTXT(DWLOG,DWMSG,STRING(:LSTR)) - GOTO 999 - ENDIF - ENDIF -C -C Check character-string type -C - alphabetic, numeric or alphanumeric ? -C - IF (CHALP) THEN - IS = MOVE_BLB (ARR(VPTR),%REF(STRING),PLEN) - LSTR = STR_SIGLEN (STRING(:PLEN)) - IS = STR_CHECK_ALPH (STRING(:LSTR)) - IF (IAND(IS,1).EQ.0) THEN - IS = MSG_SET (PPD_STRNOTALP,0) - GOTO 999 - ENDIF - ELSE IF (CHNUM) THEN - IS = MOVE_BLB (ARR(VPTR),%REF(STRING),PLEN) - LSTR = STR_SIGLEN (STRING(:PLEN)) - IS = STR_CHECK_NUM (STRING(:LSTR)) - IF (IAND(IS,1).EQ.0) THEN - IS = MSG_SET (PPD_STRNOTNUM,0) - GOTO 999 - ENDIF - ELSE IF (CHANM) THEN - IS = MOVE_BLB (ARR(VPTR),%REF(STRING),PLEN) - LSTR = STR_SIGLEN (STRING(:PLEN)) - IS = STR_CHECK_ANUM (STRING(:LSTR)) - IF (IAND(IS,1).EQ.0) THEN - IS = MSG_SET (PPD_STRNOTAN,0) - GOTO 999 - ENDIF - ENDIF -C -C Check whether valid option -C - return full option in ARR -C - IF (CHOPT.OR.CHOPS) THEN - IS = PPD_OPSTR_MATCH (ARR(VPTR),PLEN,CHOPS) - IF (IAND(IS,1).EQ.0) GOTO 999 - ENDIF -C -C Check whether valid node name -C - IF (CHNOD) THEN - IS = MOVE_BLB (ARR(VPTR),%REF(STRING),PLEN) - LSTR = STR_SIGLEN (STRING(:PLEN)) - IS = PPD_CHECK_NODE (STRING(:LSTR)) - IF (IAND(IS,1).EQ.0) GOTO 999 - ENDIF - ENDIF - ENDDO - ENDIF - ENDDO -C -C For scalars: -C check the total nr of values in the -C array against the max nr of sets -C - IF (SCALAR .AND. NSCALARS.GT.MAXNSETS) THEN - IS = MSG_SET (PPD_NUMVALMAX,1) - CALL WNCTXT(DWLOG,DWMSG,NSCALARS,MAXNSETS) - ENDIF -C - 900 PPD_CHECK = PPD_SUCCESS - RETURN -C - 999 PPD_CHECK = IS - RETURN - END -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - INTEGER*4 FUNCTION PPD_CHECK_ASC - 1 (ARRAY,NELEM,DTYPE,PLEN,TOBY_FORM) -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' -C - INTEGER*4 PLEN ! (i) nr of bytes per element - BYTE ARRAY(PLEN,*) ! (i) array - INTEGER*4 NELEM ! (i) number of elements in array - CHARACTER*1 DTYPE ! (i) datatype code (B,I,J,R,D,C) - LOGICAL*4 TOBY_FORM ! (i) TO/BY format ? -C -C.Purpose: Check whether the array elements are in ascending order -C.Returns: Status code (.TRUE. for success, .FALSE. otherwise) -C success PPD_SUCCESS -C error PPD_ARRNOTASC array not in ascending order -C.Notes: -C------------------------------------------------------------------------- -C -C - INTEGER*4 BLB_COMPARE, BLB_COMPAR1, MSG_SET -C - INTEGER*4 IS -C -C - IF (.NOT.TOBY_FORM) THEN - DO I = 2,NELEM - IS = BLB_COMPARE (ARRAY(1,I),ARRAY(1,I-1),DTYPE,PLEN) - IF (IS.LE.1) GOTO 999 - ENDDO -C -C TO/BY format (start,end,step values): -C - start > preceding end -C - end >= start (= only for special step) -C - special: step = end, or step = 1 -C - ELSE - DO I = 1,NELEM,3 - IF (I.GT.1) THEN - IS = BLB_COMPARE (ARRAY(1,I),ARRAY(1,I-2),DTYPE,PLEN) - IF (IS.LE.1) GOTO 999 - ENDIF -C - IS = BLB_COMPARE (ARRAY(1,I+1),ARRAY(1,I),DTYPE,PLEN) - IF (IS.LT.1) GOTO 999 -C - IF (IS.EQ.1) THEN - IS = BLB_COMPARE (ARRAY(1,I+2),ARRAY(1,I+1),DTYPE,PLEN) - IF (IS.NE.1) IS = BLB_COMPAR1 (ARRAY(1,I+2),DTYPE,PLEN) - IF (IS.NE.1) GOTO 999 - ENDIF - ENDDO - ENDIF -C - PPD_CHECK_ASC = PPD_SUCCESS - RETURN -C - 999 PPD_CHECK_ASC = MSG_SET (PPD_ARRNOTASC,0) - RETURN - END -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - INTEGER*4 FUNCTION PPD_CHECK_NDE - 1 (ARRAY,NELEM,DTYPE,PLEN,TOBY_FORM) -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' -C - INTEGER*4 PLEN ! (i) nr of bytes per element - BYTE ARRAY(PLEN,*) ! (i) array - INTEGER*4 NELEM ! (i) number of elements in array - CHARACTER*1 DTYPE ! (i) datatype code (B,I,J,R,D,C) - LOGICAL*4 TOBY_FORM ! (i) TO/BY format ? -C -C.Purpose: Check whether the array elements are in non-descending order -C.Returns: Status code (.TRUE. for success, .FALSE. otherwise) -C success PPD_SUCCESS -C error PPD_ARRNOTNDE array not in non-descending order -C.Notes: -C------------------------------------------------------------------------- -C -C - INTEGER*4 BLB_COMPARE, BLB_COMPAR1, MSG_SET -C - INTEGER*4 IS -C -C - IF (.NOT.TOBY_FORM) THEN - DO I = 2,NELEM - IS = BLB_COMPARE (ARRAY(1,I),ARRAY(1,I-1),DTYPE,PLEN) - IF (IS.LT.1) GOTO 999 - ENDDO -C -C TO/BY format (start,end,step values): -C - start >= preceding end -C - end >= start (= only for special step) -C - special: step = end, or step = 1 -C - ELSE - DO I = 1,NELEM,3 - IF (I.GT.1) THEN - IS = BLB_COMPARE (ARRAY(1,I),ARRAY(1,I-2),DTYPE,PLEN) - IF (IS.LT.1) GOTO 999 - ENDIF -C - IS = BLB_COMPARE (ARRAY(1,I+1),ARRAY(1,I),DTYPE,PLEN) - IF (IS.LT.1) GOTO 999 -C - IF (IS.EQ.1) THEN - IS = BLB_COMPARE (ARRAY(1,I+2),ARRAY(1,I+1),DTYPE,PLEN) - IF (IS.NE.1) IS = BLB_COMPAR1 (ARRAY(1,I+2),DTYPE,PLEN) - IF (IS.NE.1) GOTO 999 - ENDIF - ENDDO - ENDIF -C - PPD_CHECK_NDE = PPD_SUCCESS - RETURN -C - 999 PPD_CHECK_NDE = MSG_SET (PPD_ARRNOTNDE,0) - RETURN - END -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - INTEGER*4 FUNCTION PPD_CHECK_DES - 1 (ARRAY,NELEM,DTYPE,PLEN,TOBY_FORM) -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' -C - INTEGER*4 PLEN ! (i) nr of bytes per element - BYTE ARRAY(PLEN,*) ! (i) array - INTEGER*4 NELEM ! (i) number of elements in array - CHARACTER*1 DTYPE ! (i) datatype code (B,I,J,R,D,C) - LOGICAL*4 TOBY_FORM ! (i) TO/BY format ? -C -C.Purpose: Check whether the array elements are in descending order -C.Returns: Status code (.TRUE. for success, .FALSE. otherwise) -C success PPD_SUCCESS -C error PPD_ARRNOTDES array not in descending order -C.Notes: -C------------------------------------------------------------------------- -C -C - INTEGER*4 BLB_COMPARE, BLB_COMPAR1, MSG_SET -C - INTEGER*4 IS -C -C - IF (.NOT.TOBY_FORM) THEN - DO I = 2,NELEM - IS = BLB_COMPARE (ARRAY(1,I),ARRAY(1,I-1),DTYPE,PLEN) - IF (IS.GE.1) GOTO 999 - ENDDO -C -C TO/BY format (start,end,step values): -C - start < preceding end -C - end <= start (= only for special step) -C - special: step = end, or step = 1 -C - ELSE - DO I = 1,NELEM,3 - IF (I.GT.1) THEN - IS = BLB_COMPARE (ARRAY(1,I),ARRAY(1,I-2),DTYPE,PLEN) - IF (IS.GE.1) GOTO 999 - ENDIF -C - IS = BLB_COMPARE (ARRAY(1,I+1),ARRAY(1,I),DTYPE,PLEN) - IF (IS.GT.1) GOTO 999 -C - IF (IS.EQ.1) THEN - IS = BLB_COMPARE (ARRAY(1,I+2),ARRAY(1,I+1),DTYPE,PLEN) - IF (IS.NE.1) IS = BLB_COMPAR1 (ARRAY(1,I+2),DTYPE,PLEN) - IF (IS.NE.1) GOTO 999 - ENDIF - ENDDO - ENDIF -C - PPD_CHECK_DES = PPD_SUCCESS - RETURN -C - 999 PPD_CHECK_DES = MSG_SET (PPD_ARRNOTDES,0) - RETURN - END -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - INTEGER*4 FUNCTION PPD_CHECK_NAS - 1 (ARRAY,NELEM,DTYPE,PLEN,TOBY_FORM) -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' -C - INTEGER*4 PLEN ! (i) nr of bytes per element - BYTE ARRAY(PLEN,*) ! (i) array - INTEGER*4 NELEM ! (i) number of elements in array - CHARACTER*1 DTYPE ! (i) datatype code (B,I,J,R,D,C) - LOGICAL*4 TOBY_FORM ! (i) TO/BY format ? -C -C.Purpose: Check whether the array elements are in non-ascending order -C.Returns: Status code (.TRUE. for success, .FALSE. otherwise) -C success PPD_SUCCESS -C error PPD_ARRNOTNAS array not in non-ascending order -C.Notes: -C------------------------------------------------------------------------- -C -C - INTEGER*4 BLB_COMPARE, BLB_COMPAR1, MSG_SET -C - INTEGER*4 IS -C -C - IF (.NOT.TOBY_FORM) THEN - DO I = 2,NELEM - IS = BLB_COMPARE (ARRAY(1,I),ARRAY(1,I-1),DTYPE,PLEN) - IF (IS.GT.1) GOTO 999 - ENDDO -C -C TO/BY format (start,end,step values): -C - start <= preceding end -C - end <= start (= only for special step) -C - special: step = end, or step = 1 -C - ELSE - DO I = 1,NELEM,3 - IF (I.GT.1) THEN - IS = BLB_COMPARE (ARRAY(1,I),ARRAY(1,I-2),DTYPE,PLEN) - IF (IS.GT.1) GOTO 999 - ENDIF -C - IS = BLB_COMPARE (ARRAY(1,I+1),ARRAY(1,I),DTYPE,PLEN) - IF (IS.GT.1) GOTO 999 -C - IF (IS.EQ.1) THEN - IS = BLB_COMPARE (ARRAY(1,I+2),ARRAY(1,I+1),DTYPE,PLEN) - IF (IS.NE.1) IS = BLB_COMPAR1 (ARRAY(1,I+2),DTYPE,PLEN) - IF (IS.NE.1) GOTO 999 - ENDIF - ENDDO - ENDIF -C - PPD_CHECK_NAS = PPD_SUCCESS - RETURN -C - 999 PPD_CHECK_NAS = MSG_SET (PPD_ARRNOTNAS,0) - RETURN - END -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - INTEGER*4 FUNCTION PPD_CHECK_NODE (NODE) -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' -C - CHARACTER*(*) NODE ! (i) full node name -C -C.Purpose: Check node name syntax -C.Returns: Status code (.TRUE. for success, .FALSE. otherwise) -C success PPD_SUCCESS -C error DBD_NAMTOLNG junction name longer than 8 characters -C error DBD_NAMTOMNY more than 16 junction names -C error DBD_BADNODE syntax error -C.Notes: -C------------------------------------------------------------------------- -C -C - INTEGER*4 MAXNR, MAXLEN - PARAMETER (MAXNR = 16) - PARAMETER (MAXLEN = 8) - CHARACTER*(*) DELIM, NULLNODE - PARAMETER (DELIM = '.') - PARAMETER (NULLNODE = '0') -C - INTEGER*4 PPD_AMAS_GET - INTEGER*4 STR_SIGLEN, STR_SKIP_U, MSG_SET -C - INTEGER*4 IS, LN, NR, NSKIP, PTR -C -C - NR = 0 - LN = STR_SIGLEN (NODE) - IF (LN.GT.0) THEN - PTR = 1 - NSKIP = STR_SKIP_U (DELIM,NODE(:LN),PTR) - IF (NSKIP.GT.MAXLEN) GOTO 991 - IF (NSKIP.NE.1 .OR. NODE(1:1).NE.NULLNODE) NR = 1 - PTR = PTR+1 - DO WHILE (PTR.LE.LN) - NR = NR+1 - IF (NR.GT.MAXNR) GOTO 992 - NSKIP = STR_SKIP_U (DELIM,NODE(:LN),PTR) - IF (NSKIP.GT.MAXLEN) GOTO 991 - PTR = PTR+1 - ENDDO - ENDIF - IF (NR.EQ.0 - 1 .AND. IAND(PPD_AMAS_GET('NULL_NODE'),1) .EQ. 0) GOTO 999 -C - PPD_CHECK_NODE = PPD_SUCCESS - RETURN -C - 991 IS = MSG_SET (DBD_NAMTOLNG,1) - CALL WNCTXT(DWLOG,DWMSG,NODE(PTR-NSKIP:PTR-1)) - GOTO 999 - 992 IS = MSG_SET (DBD_NAMTOMNY,1) - CALL WNCTXT(DWLOG,DWMSG,MAXNR) - 999 PPD_CHECK_NODE = MSG_SET (DBD_BADNODE,0) - RETURN - END diff --git a/src/dwarf/ppdcmas.for b/src/dwarf/ppdcmas.for deleted file mode 100644 index e3f43550d4dca8547958b9ad71c2c70f3177104a..0000000000000000000000000000000000000000 --- a/src/dwarf/ppdcmas.for +++ /dev/null @@ -1,154 +0,0 @@ -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ -C.Ident: PPD_CMAS -C.Keywords: PPD File, Parameter Checks -C.Author: Friso Olnon (NFRA, Dwingeloo) -C.Language: DWARF-Fortran -C.Environment: VAX or Alliant -C.Comments: -C Common variables used: -C INTEGER*4 PPDPD$CMAS ! (m) check mask -C -C.Version: 900415 FMO - recreation -C------------------------------------------------------------------------- -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - INTEGER*4 FUNCTION PPD_CMAS_PUT (LIST,DO_CHECK) -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' -C - CHARACTER*(*) LIST ! (i) list of proposed checks - LOGICAL*4 DO_CHECK ! (i) check internal consistency ? -C -C.Purpose: Check and store the checks for a program parameter -C.Returns: Status code (.TRUE. for success, .FALSE. otherwise) -C success PPD_SUCCESS -C error PPD_CHATINV invalid check name -C error PPD_CHATNUNI ambiguously abbreviated check name -C error PPD_MUTEXCLCH invalid combination of checks -C.Notes: -C - The list should be a comma-separated list of valid check names. -C It will be converted to a bitmask and stored in the current -C parameter description (field PPDPD$CMAS). -C - If an invalid check name or conflicting checks are given, -C the default mask (no checks at all) will be stored. -C - If DO_CHECK is off, the function just returns with PPD_SUCCESS. -C - In case of errors, no messages are stored in the regular message -C buffer. The calling routine (BPD_BUILD) takes care of that. -C------------------------------------------------------------------------- -C - INCLUDE 'PPDREC_4_DEF' -C - CHARACTER*(*) COMMA, EMPTVAL - PARAMETER (COMMA = ',' ) - PARAMETER (EMPTVAL = '[]') -C - INTEGER*4 MAXNR, DEFMASK - PARAMETER (MAXNR = 12) - PARAMETER (DEFMASK = 0 ) - CHARACTER*16 NAMES(MAXNR) - DATA NAMES / - 1 'MINIMUM', 'MAXIMUM', - 2 'ASCENDING', 'DESCENDING', - 3 'ALPHABETIC', 'NUMERIC', - 4 'ANUMERIC', 'OPTIONS', - 5 'ABBREV_OPTIONS','NODE', - 6 'NON_ASCENDING' ,'NON_DESCENDING' / -C - INTEGER*4 STR_SIGLEN, STR_MATCH_A, STR_COPY_U -C - CHARACTER*16 NAME - INTEGER*4 IS, LL, LN, PTR, NR, MASK -C -C -C Check and convert name by name -C - extract the next name -C - check it -C - set the corresponding bit in the mask -C - IF (DO_CHECK) THEN - MASK = DEFMASK - LL = STR_SIGLEN (LIST) - IF (LL.GT.0 .AND. LIST(:LL).NE.EMPTVAL) THEN - PTR = 1 - DO WHILE (PTR.LE.LL) - LN = 0 - IS = STR_COPY_U (COMMA,LIST(:LL),PTR,NAME,LN) - IS = STR_MATCH_A (NAME(:LN),MAXNR,NAMES,NR) - IF (IAND(IS,1).EQ.0) THEN - IF (IS.EQ.0) THEN - IS = PPD_CHATNUNI - ELSE - IS = PPD_CHATINV - ENDIF - GOTO 999 - ENDIF - MASK = IBSET (MASK,NR-1) - PTR = PTR+1 - ENDDO - ENDIF -C -C Check internal consistency -C - IF ((BTEST(MASK,7) .AND. BTEST(MASK,8)) .OR. - 1 (BTEST(MASK,4) .AND. BTEST(MASK,5)) .OR. - 2 (BTEST(MASK,4) .AND. BTEST(MASK,6)) .OR. - 3 (BTEST(MASK,5) .AND. BTEST(MASK,6)) .OR. - 4 (BTEST(MASK,2) .AND. BTEST(MASK,3)) .OR. - 5 (BTEST(MASK,2) .AND. BTEST(MASK,10)) .OR. - 6 (BTEST(MASK,2) .AND. BTEST(MASK,11)) .OR. - 7 (BTEST(MASK,3) .AND. BTEST(MASK,10)) .OR. - 8 (BTEST(MASK,3) .AND. BTEST(MASK,11)) .OR. - 9 (BTEST(MASK,10) .AND. BTEST(MASK,11))) THEN - IS = PPD_MUTEXCLCH - GOTO 999 - ENDIF - PPDPD$CMAS = MASK - ENDIF -C - PPD_CMAS_PUT = PPD_SUCCESS - RETURN -C - 999 PPDPD$CMAS = DEFMASK - PPD_CMAS_PUT = IS - RETURN - END -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - INTEGER*4 FUNCTION PPD_CMAS_GET (NAME) -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' -C - CHARACTER*(*) NAME ! (i) (abbrev) name of check -C -C.Purpose: Check whether the named check must be performed -C.Returns: Status code (.TRUE. for success, .FALSE. otherwise) -C.Notes: -C A false status code is also returned if the check name is not correct. -C------------------------------------------------------------------------- -C - INCLUDE 'PPDREC_4_DEF' -C - INTEGER*4 MAXNR - PARAMETER (MAXNR = 12) - CHARACTER*16 NAMES(MAXNR) - DATA NAMES / - 1 'MINIMUM', 'MAXIMUM', - 2 'ASCENDING', 'DESCENDING', - 3 'ALPHABETIC', 'NUMERIC', - 4 'ANUMERIC', 'OPTIONS', - 5 'ABBREV_OPTIONS','NODE', - 6 'NON_ASCENDING' ,'NON_DESCENDING' / -C - INTEGER*4 STR_MATCH_A -C - INTEGER*4 IS, NR -C -C - IS = STR_MATCH_A (NAME,MAXNR,NAMES,NR) - IF (IAND(IS,1).EQ.0) GOTO 999 -C - IF (.NOT.BTEST (PPDPD$CMAS,NR-1)) IS = 0 -C - 999 PPD_CMAS_GET = IS - RETURN - END diff --git a/src/dwarf/ppddtype.for b/src/dwarf/ppddtype.for deleted file mode 100644 index 057a4de67093f87340eeb68225504c6a72c0e483..0000000000000000000000000000000000000000 --- a/src/dwarf/ppddtype.for +++ /dev/null @@ -1,256 +0,0 @@ -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ -C.Ident: PPD_DTYPE -C.Keywords: PPD File, Parameter Datatype and Length -C.Author: Friso Olnon (NFRA, Dwingeloo) -C.Language: DWARF-Fortran -C.Environment: VAX or Alliant -C.Comments: -C Common variables used: -C CHARACTER*1 PPDPD$DTYPE ! (m) datatype -C INTEGER*4 PPDPD$PLEN ! (m) length in bytes -C -C.Version: 900415 FMO - recreation -C.Version: 911024 GvD - test if length <=255 -C.Version: 920224 GvD - no optional arguments in MSG anymore -C.Version: 930510 HjV - Change some INTEGER*2 into INTEGER*4 -C.Version: 940120 CMV - Use indirect addressing (A_B) -C------------------------------------------------------------------------- -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - INTEGER*4 FUNCTION PPD_DTYPE_PUT (STRING,DO_CHECK) -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' -C -C - CHARACTER*(*) STRING ! (i) proposed code - LOGICAL*4 DO_CHECK ! (i) check validity ? -C -C.Purpose: Check and store the datatype code for a program parameter -C.Returns: Status code (.TRUE. for success, .FALSE. otherwise) -C success PPD_SUCCESS -C error PPD_TYPENOT datatype not given -C error PPD_TYPEINV invalid code -C error PPD_TYPCHKINV datatype inconsistent with checks -C.Notes: -C - The datatype is required and will be stored in the current parameter -C description (field PPDPD$DTYPE). -C - If an invalid code is given, the default ('J') will be used. -C - If DO_CHECK is off, only the consistency with the checks is looked at. -C - In case of errors, no messages are stored in the regular message -C buffer. The calling routine (BPD_BUILD) takes care of that. -C------------------------------------------------------------------------- -C - INCLUDE 'PPDREC_4_DEF' -C - CHARACTER*(*) EMPTVAL, DEFDTYPE, TYPES - PARAMETER (EMPTVAL = '[]') - PARAMETER (DEFDTYPE = 'J' ) - PARAMETER (TYPES = 'BIJRDLC') -C - INTEGER*4 PPD_CMAS_GET, STR_SIGLEN -C - INTEGER*4 IS, LS -C -C -C Check the code -C - IF (DO_CHECK) THEN - PPDPD$DTYPE = DEFDTYPE - LS = STR_SIGLEN (STRING) - IF (LS.EQ.0 .OR. STRING(:LS).EQ.EMPTVAL) THEN - IS = PPD_TYPENOT - GOTO 999 - ELSE IF (LS.GT.1 .OR. INDEX(TYPES,STRING(:1)).EQ.0) THEN - IS = PPD_TYPEINV - GOTO 999 - ENDIF - PPDPD$DTYPE = STRING(:1) - ENDIF -C -C Check against the requested checks -C - IF (PPDPD$DTYPE.EQ.'L' .AND. - 1 (IAND(PPD_CMAS_GET ('MINIMUM' ),1) .NE. 0 .OR. - 2 IAND(PPD_CMAS_GET ('MAXIMUM' ),1) .NE. 0 .OR. - 3 IAND(PPD_CMAS_GET ('ASCENDING' ),1) .NE. 0 .OR. - 4 IAND(PPD_CMAS_GET ('DESCENDING' ),1) .NE. 0 .OR. - 5 IAND(PPD_CMAS_GET ('NON_ASCENDING' ),1) .NE. 0 .OR. - 6 IAND(PPD_CMAS_GET ('NON_DESCENDING'),1) .NE. 0)) THEN - IS = PPD_TYPCHKINV - GOTO 999 - ELSE IF (PPDPD$DTYPE.NE.'C' .AND. - 1 (IAND(PPD_CMAS_GET ('ALPHABETIC' ),1) .NE. 0 .OR. - 2 IAND(PPD_CMAS_GET ('NUMERIC' ),1) .NE. 0 .OR. - 3 IAND(PPD_CMAS_GET ('ANUMERIC' ),1) .NE. 0 .OR. - 4 IAND(PPD_CMAS_GET ('OPTIONS' ),1) .NE. 0 .OR. - 5 IAND(PPD_CMAS_GET ('ABBREV_OPTIONS'),1) .NE. 0 .OR. - 6 IAND(PPD_CMAS_GET ('NODE' ),1) .NE. 0)) THEN - IS = PPD_TYPCHKINV - GOTO 999 - ENDIF -C - PPD_DTYPE_PUT = PPD_SUCCESS - RETURN -C - 999 PPD_DTYPE_PUT = IS - RETURN - END -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - INTEGER*4 FUNCTION PPD_PLEN_PUT (STRING,DO_CHECK) -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' -C - CHARACTER*(*) STRING ! (i) proposed length - LOGICAL*4 DO_CHECK ! (i) check string syntax ? -C -C.Purpose: Decode, check and store the length for a program parameter -C.Returns: Status code (.TRUE. for success, .FALSE. otherwise) -C success PPD_SUCCESS -C error PPD_LENGTHNOT length not given for character type -C error PPD_NOTPOSINT must be a positive integer -C error PPD_LENGTHLON length too long -C error PPD_LENGTHINV invalid length for given datatype -C.Notes: -C - The datatype will be stored in the current parameter description -C (field PPDPD$PLEN). -C - If an invalid length is given, the default for the datatype will -C be used. -C - If DO_CHECK is off, only the match with datatype with be checked. -C - In case of errors, no messages are stored in the regular message -C buffer. The calling routine (BPD_BUILD) takes care of that. -C------------------------------------------------------------------------- -C - INCLUDE 'PPDREC_4_DEF' -C - INTEGER*4 MAXNR - CHARACTER*(*) EMPTVAL, TYPES - PARAMETER (MAXNR = 7) - PARAMETER (EMPTVAL = '[]') - PARAMETER (TYPES = 'BIJRDLC') - INTEGER*4 DEFPLEN(MAXNR) - DATA DEFPLEN /1,2,4,4,8,1,1/ -C - INTEGER*4 STR_SIGLEN, STR_READ_J -C - INTEGER*4 IS, LS, NR - INTEGER*4 PLEN -C - NR = INDEX(TYPES,PPDPD$DTYPE) -C -C Decode and check -C - IF (DO_CHECK) THEN - LS = STR_SIGLEN (STRING) - IF (LS.EQ.0 .OR. STRING(:LS).EQ.EMPTVAL) THEN - IF (PPDPD$DTYPE.EQ.'C') THEN - IS = PPD_LENGTHNOT - GOTO 999 - ENDIF - PPDPD$PLEN = DEFPLEN(NR) - ELSE - IS = STR_READ_J (STRING(:LS),PLEN) - IF (IAND(IS,1).EQ.0 .OR. PLEN.LE.0) THEN - IS = PPD_NOTPOSINT - GOTO 999 - ELSE IF (PLEN.GT.255) THEN - IS = PPD_LENGTHLON - GOTO 999 - ENDIF - PPDPD$PLEN = PLEN - ENDIF - ENDIF -C -C Check match with datatype -C - IF (PPDPD$DTYPE.NE.'C' .AND. PPDPD$DTYPE.NE.'L' - 1 .AND. PPDPD$PLEN.NE.DEFPLEN(NR)) THEN - IS = PPD_LENGTHINV - GOTO 999 - ENDIF -C - PPD_PLEN_PUT = PPD_SUCCESS - RETURN -C - 999 PPDPD$PLEN = DEFPLEN(NR) - PPD_PLEN_PUT = IS - RETURN - END -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - INTEGER*4 FUNCTION PPD_DTYPE_GET (CODE,PLEN) -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' -C - CHARACTER*(*) CODE ! (o) datatype code - INTEGER*4 PLEN ! (o) parameter length in bytes -C -C.Purpose: Get the datatype and length from the current param description -C.Returns: Status code (.TRUE. for success, .FALSE. otherwise) -C success PPD_SUCCESS -C.Notes: -C------------------------------------------------------------------------- -C - INCLUDE 'PPDREC_4_DEF' -C -C - CODE = PPDPD$DTYPE - PLEN = PPDPD$PLEN -C - PPD_DTYPE_GET = PPD_SUCCESS - RETURN - END -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - INTEGER*4 FUNCTION PPD_DTYPE_XGET (CODE,PLEN) -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' -C - CHARACTER*(*) CODE ! (o) datatype code - INTEGER*4 PLEN ! (o) parameter length in bytes -C -C.Purpose: Get the datatype and length for the current parameter -C.Returns: Status code (.TRUE. for success, .FALSE. otherwise) -C success PPD_SUCCESS -C error PPD_SEQERROR no PPD file mapped -C error PPD_NOCURENTR no current parameter selected -C.Notes: -C - The fields are taken directly from the mapped PPD file using the -C start address of the description of the current parameter. -C - Use XGET i.s.o. GET when the description array PPDPD_ contains -C data for another parameter. -C------------------------------------------------------------------------- -C - INCLUDE 'PPDREC_4_DEF' -C - INTEGER*4 PPD_STAT_INQ, MOVE_BLB, MOVE_BLJ, MSG_SET -C - INTEGER*4 IS, MAPB, ADDR, HLPB -C -C - CODE = ' ' - PLEN = 0 -C -C Make sure that the PPD file is mapped -C and that a parameter has been selected -C - IS = PPD_STAT_INQ (MAPB,ADDR,HLPB) - IF (MAPB.EQ.0) THEN - IS = PPD_SEQERROR - GOTO 999 - ELSE IF (ADDR.EQ.0) THEN - IS = PPD_NOCURENTR - GOTO 999 - ENDIF -C -C Get the fields -C - IS = MOVE_BLB (A_B(ADDR+PPDPD_DTYPE-A_OB),%REF(CODE),1) - IS = MOVE_BLJ (A_B(ADDR+PPDPD_PLEN-A_OB),PLEN,1) -C - PPD_DTYPE_XGET = PPD_SUCCESS - RETURN -C - 999 PPD_DTYPE_XGET = MSG_SET (IS,0) - RETURN - END diff --git a/src/dwarf/ppddvstr.for b/src/dwarf/ppddvstr.for deleted file mode 100644 index fc8c4e7adcfa3fece903fcce5a7ef1c661aec18e..0000000000000000000000000000000000000000 --- a/src/dwarf/ppddvstr.for +++ /dev/null @@ -1,187 +0,0 @@ -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ -C.Ident: PPD_DVSTR -C.Keywords: PPD File, Parameter Default Values -C.Author: Friso Olnon (NFRA, Dwingeloo) -C.Language: DWARF-Fortran -C.Environment: VAX or Alliant -C.Comments: -C Common variables used: -C CHARACTER*(*) PPDPD$DESCR ! (m) description in string format -C INTEGER*4 PPDPD$LENG ! (m) current sign length of descr -C INTEGER*4 PPDPD$DVOFF ! (m) offset of default vals in descr -C INTEGER*4 PPDPD$DVLEN ! (m) length of default vals -C -C.Version: 900415 FMO - recreation -C.Version: 920224 GvD - no optional arguments in MSG anymore -C.Version: 930510 HjV - Change some INTEGER*2 into INTEGER*4 -C.Version: 940120 CMV - Use indirect addressing (A_B) -C------------------------------------------------------------------------- -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - INTEGER*4 FUNCTION PPD_DVSTR_PUT (STRING,DO_CHECK) -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' -C - CHARACTER*(*) STRING ! (i) proposed default values - LOGICAL*4 DO_CHECK ! (i) check the string ? -C -C.Purpose: Check and store the default values for a program parameter -C.Returns: Status code (.TRUE. for success, .FALSE. otherwise) -C success PPD_SUCCESS -C error PPD_PSEARCH no PPD default allowed -C.Notes: -C - The default values are stored in the variable-length part of the -C current parameter description. Its offset w.r.t. the start of the -C description and its significant length are stored in the fixed part -C (fields PPDPD$DVOFF and PPDPD$DVLEN). -C - If no default values are given, the offset is set to UNDEF_J. -C - In case of errors, no messages are stored in the regular message -C buffer. The calling routine (BPD_BUILD) takes care of that. -C------------------------------------------------------------------------- -C - INCLUDE 'PPDREC_4_DEF' -C - INTEGER*4 PPD_SSTR_GET, STR_SIGLEN -C - CHARACTER SSTR*5, GROUP*32 - INTEGER*4 IS, LSTR, LS, LG -C -C - PPDPD$DVOFF = UNDEF_J - PPDPD$DVLEN = 0 -C - LSTR = STR_SIGLEN (STRING) - IF (LSTR.GT.0) THEN - PPDPD$DVOFF = PPDPD$LENG - PPDPD$DVLEN = LSTR - PPDPD$LENG = PPDPD$LENG+LSTR - IF (PPDPD$LENG.GT.PPDPD__LENGTH*4) GOTO 9999 - PPDPD$DESCR(PPDPD$DVOFF+1:PPDPD$LENG) = STRING(:LSTR) -C -C Is a PPD default allowed ? -C - IS = PPD_SSTR_GET (SSTR,LS,GROUP,LG) - IF (INDEX(SSTR(:LS),'P').EQ.0) THEN - IS = PPD_PSEARCH - GOTO 999 - ENDIF - ENDIF -C - PPD_DVSTR_PUT = PPD_SUCCESS - RETURN -C - 999 PPD_DVSTR_PUT = IS - RETURN -C - 9999 PPD_DVSTR_PUT = 4 - CALL WNCTXT(DWLOG,'PPDPD_ overflow: tell DWARF manager') - RETURN - END -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - INTEGER*4 FUNCTION PPD_DVSTR_GET (STRING,LS) -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' -C - CHARACTER*(*) STRING ! (o) default values - INTEGER*4 LS ! (o) its significant length -C -C.Purpose: Get the default values from the current parameter description -C.Returns: Status code (.TRUE. for success, .FALSE. otherwise) -C success PPD_SUCCESS -C error PPD_STRTOOSML output string too short -C.Notes: -C - If no default values are given, a blank string will be returned. -C------------------------------------------------------------------------- -C - INCLUDE 'PPDREC_4_DEF' -C - INTEGER*4 STR_COPY, MSG_SET -C - INTEGER*4 IS -C -C -C Get the string -C - STRING = ' ' - LS = 0 - IF (PPDPD$DVOFF.NE.UNDEF_J) THEN - IS = STR_COPY - 1 (PPDPD$DESCR(PPDPD$DVOFF+1:PPDPD$DVOFF+PPDPD$DVLEN), - 2 STRING,LS) - IF (IS.LT.0) GOTO 999 - ENDIF -C - PPD_DVSTR_GET = PPD_SUCCESS - RETURN -C - 999 PPD_DVSTR_GET = MSG_SET (PPD_STRTOOSML,0) - RETURN - END -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - INTEGER*4 FUNCTION PPD_DVSTR_XGET (STRING,LS) -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' -C - CHARACTER*(*) STRING ! (o) default values - INTEGER*4 LS ! (o) its significant length -C -C.Purpose: Get the default values for the current parameter -C.Returns: Status code (.TRUE. for success, .FALSE. otherwise) -C success PPD_SUCCESS -C error PPD_SEQERROR no PPD file mapped -C error PPD_NOCURENTR no current parameter selected -C error PPD_STRTOOSML output string too short -C.Notes: -C - The string is fetched directly from the mapped PPD file using -C the offset and length given in the current parameter description. -C - Use XGET i.s.o. GET when the variable-length part of the current -C description contains data for another parameter (e.g. the COPY -C parameter in BLDPPD). -C - If no default values are given, a blank string will be returned. -C------------------------------------------------------------------------- -C - INCLUDE 'PPDREC_4_DEF' -C - INTEGER*4 PPD_STAT_INQ, MOVE_BLB, MSG_SET -C - INTEGER*4 IS, MAPB, ADDR, HLPB -C -C - STRING = ' ' - LS = 0 -C -C Make sure that the PPD file is mapped -C and that a parameter has been selected -C - IS = PPD_STAT_INQ (MAPB,ADDR,HLPB) - IF (MAPB.EQ.0) THEN - IS = PPD_SEQERROR - GOTO 999 - ELSE IF (ADDR.EQ.0) THEN - IS = PPD_NOCURENTR - GOTO 999 - ENDIF -C -C Get the string -C - IF (PPDPD$DVOFF.NE.UNDEF_J) THEN - LS = PPDPD$DVLEN - ADDR = ADDR+PPDPD$DVOFF+1 - IF (LS.LE.LEN(STRING)) THEN - IS = MOVE_BLB (A_B(ADDR-A_OB),%REF(STRING),LS) - ELSE - LS = LEN(STRING) - IS = MOVE_BLB (A_B(ADDR-A_OB),%REF(STRING),LS) - IS = PPD_STRTOOSML - GOTO 999 - ENDIF - ENDIF -C - PPD_DVSTR_XGET = PPD_SUCCESS - RETURN -C - 999 PPD_DVSTR_XGET = MSG_SET (IS,0) - RETURN - END diff --git a/src/dwarf/ppdfao.for b/src/dwarf/ppdfao.for deleted file mode 100644 index 6d15b8fc075272d163cea540497707c25aaa2ef5..0000000000000000000000000000000000000000 --- a/src/dwarf/ppdfao.for +++ /dev/null @@ -1,83 +0,0 @@ -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ -C.Ident: PPD_FAO -C.Keywords: PPD File, Formatted ASCII Output -C.Author: Friso Olnon (NFRA, Dwingeloo) -C.Language: DWARF-Fortran -C.Environment: VAX or Alliant -C.Comments: -C.Version: 900415 FMO - recreation -C.Version: 920224 GvD - no optional arguments in MSG anymore -C.Version: 940119 CMV - use wnctxs i.s.o. STR_FAO -C------------------------------------------------------------------------- -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - INTEGER*4 FUNCTION PPD_FAO (ARRAY,LARR,DTYPE,PLEN,STRING,LSTR) -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' -C - BYTE ARRAY(*) ! (i) value array - INTEGER*4 LARR ! (i) nr of bytes in the array - CHARACTER*1 DTYPE ! (i) datatype (B,I,J,R,D,C) - INTEGER*4 PLEN ! (i) nr of bytes per value - CHARACTER*(*) STRING ! (o) output string - INTEGER*4 LSTR ! (o) its significant length -C -C.Purpose: Encode an array of values into a string -C.Returns: Status code (.TRUE. for success, .FALSE. otherwise) -C success PPD_SUCCESS -C error PPD_TYPEINV invalid data type -C error PPD_STRTOOSML output string too short -C.Notes: -C In the output string the values are separated by a comma and a blank. -C------------------------------------------------------------------------- -C -C - INTEGER*4 NTYPES - CHARACTER*(*) BLANK, COMMA, TYPES - PARAMETER (BLANK = ' ') - PARAMETER (COMMA = ',') - PARAMETER (NTYPES = 6 ) - PARAMETER (TYPES = 'BIJRDC') - CHARACTER*5 FMT(NTYPES) - DATA FMT /'!#SB','!#SI','!#SJ','!#E7','!#D16',' '/ -C - INTEGER*4 MOVE_BLB, MSG_SET - INTEGER WNCALN -C - INTEGER*4 IS, PTR, NVALS -C -C - STRING = BLANK - LSTR = 0 -C - PTR = INDEX (TYPES,DTYPE) - IF (PTR.EQ.0) THEN - IS = PPD_TYPEINV - GOTO 999 - ENDIF -C - IF (DTYPE.NE.'C') THEN - NVALS = LARR/PLEN - CALL WNCTXS(STRING,FMT(PTR),NVALS,ARRAY) - LSTR=WNCALN(STRING) - ELSE - PTR = 1 - DO WHILE (PTR.LE.LARR) - IF (LSTR+PLEN+2.GT.LEN(STRING)) THEN - IS = PPD_STRTOOSML - GOTO 999 - ENDIF - IS = MOVE_BLB (ARRAY(PTR),%REF(STRING(LSTR+1:)),PLEN) - LSTR = WNCALN(STRING(:LSTR+PLEN))+2 - STRING (LSTR-1:LSTR) = COMMA//BLANK - PTR = PTR+PLEN - ENDDO - LSTR = LSTR-2 - ENDIF -C - PPD_FAO = PPD_SUCCESS - RETURN -C - 999 PPD_FAO = MSG_SET (IS,0) - RETURN - END diff --git a/src/dwarf/ppdfile.fsc b/src/dwarf/ppdfile.fsc deleted file mode 100644 index 2035438b280a555fe4b9f56152e19308d93e756f..0000000000000000000000000000000000000000 --- a/src/dwarf/ppdfile.fsc +++ /dev/null @@ -1,237 +0,0 @@ -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ -C.Ident: GENUN_PPDFILE -C.Keywords: PPD File -C.Author: Friso Olnon (NFRA, Dwingeloo) -C.Language: DWARF-Fortran -C.Environment: UNIX -C.Comments: -C Common variables used: -C INTEGER*4 PPS$MAPB ! (m) start address of mapped file -C INTEGER*4 PPS$MAPE ! (m) end address of mapped file -C INTEGER*4 PPS$FABADR ! (m) address of FAB (not used) -C INTEGER*4 PPS$FABSIZ ! (m) size of FAB (used for map size) -C -C.Version: 900415 FMO - creation -C.Version: 900502 FMO - new GEN_LUN module -C.Version: 920214 GvD - no optional arguments in MSG anymore -C.Version: 920423 GvD - use GEN_FILOPN to open PPD-file -C.Version: 930923 CMV - logical names for new maintenance system -C.Version: 940111 CMV - open ppd-file as read only -C.Version: 940117 CMV - use WNGGVM i.s.o. GEN_GET_VM -C.Version: 940211 WNB - change file inquire -C.Version: 010709 AXC - linux port - tmpchar in calls, RECLEN && READONLY -C------------------------------------------------------------------------- -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - INTEGER*4 FUNCTION PPD_FILE_FIND (PROGNAM,XSPEC,LX) -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' -C - CHARACTER*(*) PROGNAM ! (i) program name - CHARACTER*(*) XSPEC ! (o) full file specification - INTEGER*4 LX ! (o) its significant length -C -C.Purpose: Search for the PPD file -C.Returns: Status code (.TRUE. for success, .FALSE. otherwise) -C success 1 PPD file found in EXEDWARF -C info DWC_EXEUSER PPD file found in EXEUSER -C error PPD_PPDNOTFND PPD file not found -C false status code returned by referenced routines -C.Notes: -C - The file <prognam>.PPD is looked for in EXEUSER and, if not found -C there, in EXEDWARF. -C - If the logical names EXEUSER and/or EXEDWARF are not defined, they -C default to the current device and directory. -C------------------------------------------------------------------------- -C - CHARACTER*(*) DEFTYP - PARAMETER (DEFTYP = '.PPD' ) -C - INTEGER*4 STR_SIGLEN, FILNAM_FULL, GEN_FORIOS - INTEGER MSG_SET - LOGICAL WNFOP -C - INTEGER*4 IS, LP - LOGICAL EXIST - INTEGER FCAT - CHARACTER TMP*80 -C -C - XSPEC = ' ' - LX = 0 - LP = STR_SIGLEN (PROGNAM) -C -C Search for the PPD file -C - first in Current dir, then in -C n_uexe and finally in n_exe -C - TMP=PROGNAM(:LP)//DEFTYP - IS = FILNAM_FULL (TMP,XSPEC,LX,' ') - IF (IAND(IS,1).EQ.0) GOTO 999 - EXIST=WNFOP(FCAT,XSPEC(:LX),'R') - IF (EXIST) GOTO 901 -C - IS = FILNAM_FULL (TMP,XSPEC,LX,'n_uexe') - IF (IAND(IS,1).EQ.0) GOTO 999 - EXIST=WNFOP(FCAT,XSPEC(:LX),'R') - IF (EXIST) GOTO 901 -C - IS = FILNAM_FULL (TMP,XSPEC,LX,'n_exe') - IF (IAND(IS,1).EQ.0) GOTO 999 - EXIST=WNFOP(FCAT,XSPEC(:LX),'R') - IF (.NOT.EXIST) GOTO 997 -C -C - 900 PPD_FILE_FIND = 1 - CALL WNFCL(FCAT) - RETURN - 901 PPD_FILE_FIND = DWC_EXEUSER - CALL WNFCL(FCAT) - RETURN -C - 997 PPD_FILE_FIND = MSG_SET (PPD_PPDNOTFND,0) - RETURN - 998 PPD_FILE_FIND = GEN_FORIOS (XSPEC(:LX)) - RETURN - 999 PPD_FILE_FIND = IS - RETURN - END -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - INTEGER*4 FUNCTION PPD_FILE_OPEN (XSPEC) -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' - INCLUDE 'PPDSTAT_2_DEF' - INCLUDE 'PPDREC_4_DEF' -C - CHARACTER*(*) XSPEC ! (i) full file specification -C -C.Purpose: Open and map an existing PPD file -C.Returns: Status code (.TRUE. for success, .FALSE. otherwise) -C success PPD_SUCCESS -C error PPD_SEQERROR there still was a PPD file open -C false status codes returned by referenced routines -C.Notes: -C - The PPD file will be opened and its contents will be copied into -C a virtual memory block starting at address PPS$MAPB. -C - The file will always be closed. -C------------------------------------------------------------------------- -C -C - INTEGER*4 RECLEN - PARAMETER (RECLEN = 512) -C - INTEGER MSG_SET - INTEGER*4 GEN_FORIOS - INTEGER*4 MOVE_BLJ, MOVE_BLB - LOGICAL WNGGVM, WNGFVM -C - BYTE RECORD(RECLEN) - INTEGER*4 IS, LUN, NRREC, RCL, ADDRESS -C -C -C Make sure that no PPD file is open -C - IF (PPS$MAPB.NE.0) THEN - IS = MSG_SET (PPD_SEQERROR,0) - GOTO 900 - ENDIF -C -C Open the file for mapping -C -#ifdef wn_hp__ - RCL = RECLEN -#else - #ifdef wn_li__ - RCL = RECLEN - #else - RCL = RECLEN/4 - #endif -#endif - IS = 0 - CALL WNGLUN(LUN) - IF (LUN.EQ.0) GOTO 900 - OPEN (UNIT=LUN,FILE=XSPEC,STATUS='OLD',ERR=992, -#ifdef wn_li__ - 1 ACCESS='DIRECT',FORM='UNFORMATTED',RECL=RCL) -#else - 1 READONLY,ACCESS='DIRECT',RECL=RCL) -#endif -C READ (UNIT=LUN,REC=1,ERR=992) RECORD - READ (UNIT=LUN,REC=1) RECORD - IS = MOVE_BLJ (RECORD,PPDFD_,PPDFD__LENGTH) ! fill file description - PPS$FABSIZ = PPDFD$STOT ! file size in bytes - NRREC = PPS$FABSIZ/RECLEN ! nr of records -C -C "Map" the file -C - IF (.NOT.WNGGVM(PPS$FABSIZ,ADDRESS)) THEN - IS=MSG_SET(DWC_PPDNOVIRT,1) - CALL WNCTXT(DWLOG,DWMSG,PPS$FABSIZ) - GOTO 902 - END IF - PPS$MAPB = ADDRESS ! start address of map - ADDRESS=ADDRESS-A_OB - IS = MOVE_BLB (RECORD,A_B(ADDRESS),RECLEN) - DO I = 2,NRREC - READ (UNIT=LUN,REC=I,ERR=993) RECORD - ADDRESS = ADDRESS+RECLEN - IS = MOVE_BLB (RECORD,A_B(ADDRESS),RECLEN) - ENDDO - PPS$MAPE = PPS$MAPB+PPS$FABSIZ-1 ! end address of map -C -C - IS = PPD_SUCCESS ! everything OK - GOTO 902 - 992 IS = GEN_FORIOS (XSPEC) ! first READ error - GOTO 902 - 993 IS = GEN_FORIOS (XSPEC) ! other READ error -C -C Clean up -C - JS = WNGFVM(PPS$FABSIZ,PPS$MAPB) - PPS$MAPB = 0 - 902 CLOSE (UNIT=LUN) - 901 CALL WNGLUF(LUN) - 900 PPD_FILE_OPEN = IS - RETURN - END -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - INTEGER*4 FUNCTION PPD_FILE_CLOSE () -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' - INCLUDE 'PPDSTAT_2_DEF' -C -C -C.Purpose: Unmap and close the current PPD file -C.Returns: Status code (.TRUE. for success, .FALSE. otherwise) -C success PPD_SUCCESS -C error PPD_SEQERROR there was no PPD file open -C.Notes: -C - Just release the virtual memory block. -C------------------------------------------------------------------------- -C - INTEGER MSG_SET - LOGICAL WNGFVM -C - INTEGER*4 IS -C -C -C Make sure that a PPD file is open -C - IF (PPS$MAPB.EQ.0) GOTO 999 -C -C "Unmap" the file -C - JS = WNGFVM(PPS$FABSIZ,PPS$MAPB) - PPS$MAPB = 0 - PPS$MAPE = 0 -C -C - PPD_FILE_CLOSE = PPD_SUCCESS - RETURN -C - 999 PPD_FILE_CLOSE = MSG_SET (PPD_SEQERROR,0) - RETURN - END diff --git a/src/dwarf/ppdhelp.fsc b/src/dwarf/ppdhelp.fsc deleted file mode 100644 index 8b4e9e6b68d7db3bdf956b89bcf5c1fedd8858c0..0000000000000000000000000000000000000000 --- a/src/dwarf/ppdhelp.fsc +++ /dev/null @@ -1,636 +0,0 @@ -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ -C.Ident: PPD_HELP -C.Keywords: PPD File, Help Info -C.Author: Kasper Kombrink (NFRA, Dwingeloo) -C.Language: DWARF-Fortran -C.Environment: VAX or Alliant -C.Comments: -C.Version: 900415 FMO - recreation -C.Version: 920224 GvD - no optional arguments in MSG anymore -C.Version: 930513 HjV - Change size WORK to 2500 i.s.o. 1600 -C.Version: 930613 HjV - Change size WORK to 5000 i.s.o. 2500 -C.Version: 930712 CMV - Made "more" function for help output -C.Version: 930902 CMV - Add hypertext functionality -C.Version: 940119 CMV - Use WNCALC i.s.o. STR_LOWCASE -C.Version: 940818 JPH - Remove leading blank from help output. -C Suppress printing of info that is already on the -C screen or irrelevant -C.Version: 940829 HjV - Change size WORK from 5000 to 10000 -C 940912 JPH - Comment -C In HYPER mode still show dynamic help on terminal -C Suppress more info (cf 940818) -C 941110 JPH - Replace GENMOSAIC by WNGSSP('xmosaic_restart.csh') -C 941206 JPH - Paginate help[ text only if output is to a -C terminal -C 950118 JPH - Make PPD_HELP_MORE a function that returns .FALSE. -C to signal 'stop printing help' -C 950124 JPH - Recognise '|' as line-feed character -C Suppress trailing lines of parameter attributes -C 951007 JPH - Fix deletion of leading tabs (PPD_HELP_PRINT) -C Clear HYPER at exit, so a single-'?' help request -C will always produce terminal help. -C Fix spurious terminal output in ?? situation -C 010709 AXC - linux port - tmpchar in calls, char*1, -C int/logical change, READONLY change... -C------------------------------------------------------------------------- -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - INTEGER*4 FUNCTION PPD_HELP - 1 (PARMSPEC,SWPNAM,SWINP,SWPROT,LEVEL,LUN) -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' -C - CHARACTER*(*) PARMSPEC ! (i) parameter specification - LOGICAL*4 SWPNAM ! (i) program's parameter name ? - LOGICAL*4 SWINP ! (i) only input parameters ? - LOGICAL*4 SWPROT ! (i) also prototype parameters ? - INTEGER*4 LEVEL ! (i) level of help info (1, 2 or 3) - INTEGER*4 LUN ! (i) LUN of the print file -C -C.Purpose: Write help info to a print file -C.Returns: Status code (.TRUE. for success, .FALSE. otherwise) -C success PPD_SUCCESS -C error PPD_NOCURENTR no current parameter selected -C false status returned by referenced routines -C.Notes: -C The parameter spec has the format: [program[$stream]_][keyword]. -C Keyword and switch arguments determine which help info will be printed: -C - no keyword current parameter; -C SWPNAM and SWPROT are not used; -C - a name named parameter; -C SWPNAM tells which name, SWPROT is not used; -C - '*' all parameters; -C SWPNAM tells in which order; -C SWPROT is only used for SWPNAM = .FALSE. -C -C 930712 CMV: All output is handled through ppd_help_out, the number -C of lines is counted and if it exceeds the number of terminal lines-3, -C a prompt ("press <Return> to continue") is given. -C The number of lines is determined in gen_size() (GENSIZE.CEE) -C -C 930902 CMV: If called to give info on the current keyword, we -C either call the normal terminal help (LEVEL==1) or try the -C hypertext browser (LEVEL>1 || HYPER=.TRUE.). -C------------------------------------------------------------------------- -C -C - CHARACTER*(*) TXTSEP - PARAMETER (TXTSEP = '****************************************') -C - INTEGER*4 PPD_STAT_INQ ,PPD_IOCD_GET ,PPD_HELP_PRINT - INTEGER*4 PPD_READ_P ,PPD_READ_U ,PPD_READ_PNXT - INTEGER*4 PPD_READ_UNXT ,MSG_SET - INTEGER DWC_PROG_GET, PPD_UNAM_GET - INTEGER GEN_MOSAIC, WNCAL0 - LOGICAL WNDDIS -C - CHARACTER PROGSTRM*80, KEYWORD*16, IOCD*6, DISP*50 - CHARACTER TMP*80 - INTEGER*4 LSPEC, LPS, LDS, LK, LI - INTEGER*4 IS, MAPB, ADDR, HLPB - LOGICAL LTMP -C -C HYPER flags wether the Hypertext browser should be called -C - LOGICAL HYPER - DATA HYPER/.FALSE./ - SAVE HYPER -C -C -C Set up -C - split parameter specification -C into program$stream and keyword -C - LSPEC = WNCAL0(PARMSPEC) - LPS = INDEX (PARMSPEC(:LSPEC),'_') - IF (LPS.GT.0) PROGSTRM = PARMSPEC(:LPS) - LK = LSPEC-LPS - IF (LK.GT.0) KEYWORD = PARMSPEC(LPS+1:LSPEC) -C -C Current parameter -C - IF (LK.EQ.0) THEN - IS = PPD_STAT_INQ (MAPB,ADDR,HLPB) - IF (ADDR.EQ.0) THEN - IS = MSG_SET (PPD_NOCURENTR,0) - GOTO 999 - ENDIF - IS = PPD_IOCD_GET (IOCD,LI) - IF (.NOT.SWINP .OR. INDEX('IM',IOCD(1:1)).NE.0) THEN -C -C Let's try the hyper -C - IF (LEVEL.GT.1.OR.HYPER) THEN -#ifdef _wn_un__ - IS=DWC_PROG_GET(PROGSTRM,LPS) - IS=PPD_UNAM_GET(KEYWORD,LK,LSPEC,LTMP) -C -C First get the value of the display variable, as known by Newstar -C -C CMV930902 This is recursive, removed for the while -C LTMP = WNDDIS(.FALSE.,DISP) -C LDS = WNCAL0(DISP) -C -C Start browser or move to new page -C NOTE: WNGSSP does not return status from xmosaic_restart.csh so we -C do not know if xmosaic activation succeeded -C -!! CALL WNCALC(PROGSTRM(:LPS)) -!! CALL WNCALC(KEYWORD(:LK)) - CALL WNGSSP('$n_src/sys/xmosaic_restart.csh', - 1 PROGSTRM(:LPS), KEYWORD(:LK), ' ' ) -!! IS = GEN_MOSAIC(PROGSTRM(:LPS),LPS, -!! 1 KEYWORD(:LK),LK,DISP,0) -!! HYPER=(IS.GT.0) - HYPER=.TRUE. - PROGSTRM=' ' -#else - HYPER=.FALSE. !NOT UNIX: NO HYPER -#endif - ENDIF -C -C If we didn't want the hypertext, or couldn't start: ordinary help -C - IS = PPD_HELP_PRINT (PROGSTRM(:LPS),3,LUN,HYPER) - IF (IAND(IS,1).EQ.0) GOTO 999 ! branch on error - ENDIF -C -C Specified parameter -C - ELSE IF (KEYWORD(:LK).NE.'*') THEN - IF (SWPNAM) THEN - IS = PPD_READ_P (KEYWORD(:LK)) - ELSE - IS = PPD_READ_U (KEYWORD(:LK)) - ENDIF - IF (IAND(IS,1).EQ.0) GOTO 999 - IS = PPD_IOCD_GET (IOCD,LI) - IF (.NOT.SWINP .OR. INDEX('IM',IOCD(1:1)).NE.0) THEN - IS = PPD_HELP_PRINT (PROGSTRM(:LPS),LEVEL,LUN) - IF (IAND(IS,1).EQ.0) GOTO 999 - ENDIF -C -C All parameters in program's name order -C - run through the index -C - ELSE IF (SWPNAM) THEN - IS = PPD_READ_P (' ') - DO WHILE (IAND(IS,1).NE.0 .AND. IS.NE.PPD_ENDOFFILE) - IS = PPD_IOCD_GET (IOCD,LI) - IF (.NOT.SWINP .OR. INDEX('IM',IOCD(1:1)).NE.0) THEN - IS = PPD_HELP_PRINT (PROGSTRM(:LPS),LEVEL,LUN) - IF (IAND(IS,1).NE.0) WRITE (LUN,'(1X,2A)') - 1 TXTSEP,TXTSEP - ENDIF - IF (IAND(IS,1).NE.0) IS = PPD_READ_PNXT () - ENDDO - IF (IAND(IS,1).EQ.0) GOTO 999 -C -C All parameters in PIN order -C - run through parameter descriptions -C - ELSE - TMP=' ' - IS = PPD_READ_U (TMP) - DO WHILE (IAND(IS,1).NE.0 .AND. IS.NE.PPD_ENDOFFILE) - IS = PPD_IOCD_GET (IOCD,LI) - IF (.NOT.SWINP .OR. INDEX('IM',IOCD(1:1)).NE.0) THEN - IS = PPD_HELP_PRINT (PROGSTRM(:LPS),LEVEL,LUN) - IF (IAND(IS,1).NE.0) WRITE (LUN,'(1X,2A)') - 1 TXTSEP,TXTSEP - ENDIF - IF (IAND(IS,1).NE.0) IS = PPD_READ_UNXT () - ENDDO - IF (IAND(IS,1).EQ.0) GOTO 999 -C -C - run through prototype descriptions -C - IF (SWPROT) THEN - IS = PPD_READ_U ('$') - DO WHILE (IAND(IS,1).NE.0 .AND. IS.NE.PPD_ENDOFFILE) - IS = PPD_IOCD_GET (IOCD,LI) - IF (.NOT.SWINP .OR. INDEX('IM',IOCD(1:1)).NE.0) THEN - IS = PPD_HELP_PRINT (PROGSTRM(:LPS),LEVEL,LUN) - IF (IAND(IS,1).NE.0) WRITE (LUN,'(1X,2A)') - 1 TXTSEP,TXTSEP - ENDIF - IF (IAND(IS,1).NE.0) IS = PPD_READ_UNXT () - ENDDO - IF (IAND(IS,1).EQ.0) GOTO 999 - ENDIF - ENDIF -C -C - PPD_HELP = PPD_SUCCESS - HYPER=.FALSE. - RETURN -C - 999 PPD_HELP = IS - HYPER=.FALSE. - RETURN - END -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - INTEGER*4 FUNCTION PPD_HELP_PRINT (PROGSTRM,LEVEL,LUN,HYPER) -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' -C - CHARACTER*(*) PROGSTRM ! (i) [program[$stream]_] - INTEGER*4 LEVEL ! (i) level of the info - INTEGER*4 LUN ! (i) LUN for print file - LOGICAL HYPER ! flag for hypertext mode -C -C.Purpose: Write the help info to the print file -C.Returns: Status code (.TRUE. for success, .FALSE. otherwise) -C success PPD_SUCCESS -C false status returned by referenced routines -C.Notes: -C------------------------------------------------------------------------- -C -C - INTEGER*4 SIZE - CHARACTER BLANK*1, COMMA*1, LF*2 - PARAMETER (SIZE = 256 ) - PARAMETER (BLANK = ' ') - PARAMETER (COMMA = ',') -C - INTEGER*4 PPD_HELP_OUT - INTEGER*4 PPD_UNAM_GET ,PPD_PNAM_GET ,PPD_AMAS_GET - INTEGER*4 PPD_CMAS_GET ,PPD_DTYPE_GET ,PPD_IOCD_GET - INTEGER*4 PPD_NVAL_GET ,PPD_NSETS_GET ,PPD_USTR_GET - INTEGER*4 PPD_OPSTR_GET ,PPD_PRSTR_GET ,PPD_SSTR_GET - INTEGER*4 PPD_DVSTR_GET ,PPD_HSTR_XGET ,PPD_MIN_GET - INTEGER*4 PPD_MAX_GET ,PPD_FAO - LOGICAL PPD_HELP_MORE,PPD_HELP_MORE1 - INTEGER*4 STR_COPY_U - INTEGER WNCALN -C - BYTE MINMAX(SIZE) - INTEGER*4 LMM - CHARACTER WORK*10000, WORK2*80, LINE*80 - INTEGER*4 LW, LW2, LL - CHARACTER UNAM*16, PNAM*16, DTYPE*1, IOCD*6 - INTEGER*4 LMIN, PLEN, NVAL, MNVAL, MXVAL, NSETS - INTEGER*4 IS, PTR - LOGICAL*4 PROTOTYPE, DYNONLY, END -C - LF = CHAR(10)//'|' -C -C Get size of terminal -C - L1=PPD_HELP_MORE1(LUN) -C -C level 0: write user's parameter name -C - IS = PPD_UNAM_GET (UNAM,LW,LMIN,PROTOTYPE) - IF (IAND(IS,1).EQ.0) GOTO 999 - CALL WNCTXS(LINE,' !AS!AS',PROGSTRM,UNAM(:LW)) - LL=WNCALN(LINE) -C -C level 1: add units and options -C -!! IF (LEVEL.GT.0) THEN -!! IS = PPD_USTR_GET (WORK,LW) -!! IF (IAND(IS,1).EQ.0) GOTO 999 -!! IF (LW.GT.0) THEN -!! WORK = ' ('//WORK(:LW)//')' -!! LW = LW+3 -!!jph 940817 IS = PPD_HELP_OUT (LUN,WORK,LW,LINE,LL) -!! ENDIF -C -!! IS = PPD_OPSTR_GET (WORK,LW) -!! IF (IAND(IS,1).EQ.0) GOTO 999 -!! IF (LW.GT.0) THEN -!! WORK = ' ('//WORK(:LW)//')' -!! LW = LW+3 -!!jph 940817 IS = PPD_HELP_OUT (LUN,WORK,LW,LINE,LL) -!! ENDIF -C -C level 2: add prompt string -C -!! IF (LEVEL.GT.1) THEN -!! IS = PPD_PRSTR_GET (WORK,LW) -!! IF (IAND(IS,1).EQ.0) GOTO 999 -!! IF (LW.GT.0) THEN -!! WORK = ' '//WORK(:LW) -!! LW = LW+1 -!!jph 940817 IS = PPD_HELP_OUT (LUN,WORK,LW,LINE,LL) -!! ENDIF -!! ENDIF -!! ENDIF -C -C Write the line to the print file -C -!! IF (LL.GT.1) THEN -!! IF (.NOT.PPD_HELP_MORE(LUN,LINE,LL) GOTO 900 -!! ENDIF -C -C level 3: write help string and the rest -C '*-' signals end of dynamic text -C - IF (LEVEL.LT.3) GOTO 900 - IS = PPD_HSTR_XGET (WORK,LW) - IF (IAND(IS,1).EQ.0) GOTO 999 - IF (LW.GT.0) THEN - END=.FALSE. - DYNONLY=.FALSE. - IF (.NOT.PPD_HELP_MORE(LUN,' ',1)) GOTO 900 - PTR = 1 - DO WHILE (PTR.LE.LW .AND. .NOT.END) - LL = 0 - IS = STR_COPY_U (LF,WORK(:LW),PTR,LINE,LL) ! copy 1 line - IF (PTR.LE.LW) LL = LL-1 -!! DYNONLY= LINE(1:2).EQ.'#-' - DYNONLY= WORK(1:2).EQ.'#-' - END= LINE(1:2).EQ.'*-' ! end of dynamic - IF (DYNONLY .OR. END) LINE(1:2)=' ' - END= (END .AND. HYPER) .OR. DYNONLY - IF (LL.GT.0 .AND. .NOT.END) THEN - IF (.NOT.PPD_HELP_MORE(LUN,LINE,LL)) GOTO 900 - ENDIF - PTR = PTR+1 ! skip line -!! IF (WORK(PTR:PTR).LT.' ') PTR=PTR+1 ! terminator(s) - ENDDO - IF (.NOT.PPD_HELP_MORE(LUN,' ',1)) GOTO 900 - ENDIF - IF (.NOT.END) THEN -C -! IS = PPD_DTYPE_GET (DTYPE,PLEN) -! IF (IAND(IS,1).EQ.0) GOTO 999 -! IF (DTYPE.EQ.'C' .OR. DTYPE.EQ.'L') THEN -! CALL WNCTXS(LINE,' data-type : !AS!SJ', -! 1 DTYPE,PLEN) -! ELSE -! CALL WNCTXS(LINE,' data-type : !AS', -! 1 DTYPE) -! ENDIF -! IF (.NOT.PPD_HELP_MORE(LUN,LINE,0)) GOTO 900 -C -! IS = PPD_NVAL_GET (NVAL,MNVAL,MXVAL) -! IF (IAND(IS,1).EQ.0) GOTO 999 -! CALL WNCTXS(LINE,' number of values : !SJ',NVAL) -! IF (.NOT.PPD_HELP_MORE(LUN,LINE,0)) GOTO 900 -! IF (NVAL.NE.1) THEN -! CALL WNCTXS(LINE,' minimum number of values : !SJ', -! 1 MNVAL) -! IF (.NOT.PPD_HELP_MORE(LUN,LINE,0)) GOTO 900 -! CALL WNCTXS(LINE,' maximum number of values : !SJ', -! 1 MXVAL) -! IF (.NOT.PPD_HELP_MORE(LUN,LINE,0)) GOTO 900 -! ENDIF -C -! IS = PPD_NSETS_GET (NSETS) -! IF (IAND(IS,1).EQ.0) GOTO 999 -! IF (NSETS.LT.LARGEST_I) THEN -! CALL WNCTXS(LINE,' maximum number of value-sets : !SJ', -! 1 NSETS) -! IF (.NOT.PPD_HELP_MORE(LUN,LINE,0)) GOTO 900 -! ENDIF -C -!! IS = PPD_IOCD_GET (IOCD,LW) -!! IF (IAND(IS,1).EQ.0) GOTO 999 -!! CALL WNCTXS(LINE,' code io : !AS',IOCD(:LW)) -!!jph 940817 IF (.NOT.PPD_HELP_MORE(LUN,LINE,0)) GOTO 900 -C -!! IS = PPD_PNAM_GET (PNAM,LW) -!! IF (IAND(IS,1).EQ.0) GOTO 999 -!!jph 940817 CALL WNCTXS(LINE,' program parameter name : !AS',PNAM(:LW)) -!! IF (.NOT.PPD_HELP_MORE(LUN,LINE,0)) GOTO 900 -C -!! IS = PPD_SSTR_GET (WORK,LW,WORK2,LW2) -!! IF (IAND(IS,1).EQ.0) GOTO 999 -!! IF (LW2.GT.0) THEN -!! CALL WNCTXS(LINE,' ppd name for global search : !AS', -!! 1 WORK2(:LW2)) -!! IF (.NOT.PPD_HELP_MORE(LUN,LINE,0)) GOTO 900 -!! ENDIF -!! IF (LW.GT.0) THEN -!!jph 940912 CALL WNCTXS(LINE,' search sequence defaults : !AS', -!! 1 WORK(:LW)) -!! IF (.NOT.PPD_HELP_MORE(LUN,LINE,0)) GOTO 900 -!! ENDIF -C -!! IS = PPD_DVSTR_GET (WORK,LW) -!! IF (IAND(IS,1).EQ.0) GOTO 999 -!! IF (LW.GT.0) THEN -!! CALL WNCTXS(LINE,' default value(s) : !AS', -!! 1 WORK(:LW)) -!! IF (.NOT.PPD_HELP_MORE(LUN,LINE,0)) GOTO 900 -!! ENDIF -C -! IF (IAND(PPD_AMAS_GET('VECTOR'),1) .NE. 0) THEN -! IF (.NOT.PPD_HELP_MORE(LUN, -! 2 ' this parameter represents a vector',0)) GOTO 900 -! ENDIF -! IF (IAND(PPD_AMAS_GET('WILD_CARDS'),1) .NE. 0) THEN -! IF (.NOT.PPD_HELP_MORE(LUN, -! 2 ' wild card values (*) are permitted',0)) GOTO 900 -! ENDIF -! IF (IAND(PPD_AMAS_GET('UNDEFINED_VALUES'),1) .NE. 0) THEN -! IF (.NOT.PPD_HELP_MORE(LUN, -! 2 ' undefined values are permitted',0)) GOTO 900 -! ENDIF -! IF (IAND(PPD_AMAS_GET('NULL_VALUES'),1) .NE. 0) THEN -! IF (.NOT.PPD_HELP_MORE(LUN, -! 2 ' null values are permitted',0)) GOTO 900 -! ENDIF -C -! IF (.NOT.PPD_HELP_MORE(LUN, -! 1 ' the specified values will be checked as follows :',0)) -! 2 GOTO 900 -C -! IF (IAND(PPD_CMAS_GET('MINIMUM'),1) .NE. 0) THEN -! IS = PPD_MIN_GET (MINMAX,SIZE,LMM) -! IF (IAND(IS,1).EQ.0) GOTO 999 -! IS = PPD_FAO (MINMAX,LMM,DTYPE,PLEN,WORK,LW) -! IF (.NOT.PPD_HELP_MORE(LUN,' minimum : '//WORK(:LW),0)) -! 1 GOTO 900 -! ENDIF -!C -! IF (IAND(PPD_CMAS_GET('MAXIMUM'),1) .NE. 0) THEN -! IS = PPD_MAX_GET (MINMAX,SIZE,LMM) -! IF (IAND(IS,1).EQ.0) GOTO 999 -! IS = PPD_FAO (MINMAX,LMM,DTYPE,PLEN,WORK,LW) -! IF (.NOT.PPD_HELP_MORE(LUN,' maximum : '//WORK(:LW),0)) -! 1 GOTO 900 -! ENDIF -!C -! IF (IAND(PPD_CMAS_GET('ASCENDING'),1) .NE. 0) THEN -! IF (.NOT.PPD_HELP_MORE(LUN,' ascending order',0)) GOTO 900 -! ELSE IF (IAND(PPD_CMAS_GET('NON_ASCENDING'),1) .NE. 0) THEN -! IF (.NOT.PPD_HELP_MORE(LUN,' non-ascending order',0)) -! 1 GOTO 900 -! ELSE IF (IAND(PPD_CMAS_GET('DESCENDING'),1) .NE. 0) THEN -! IF (.NOT.PPD_HELP_MORE(LUN,' descending order',0)) GOTO 900 -! ELSE IF (IAND(PPD_CMAS_GET('NON_DESCENDING'),1) .NE. 0) THEN -! IF (.NOT.PPD_HELP_MORE(LUN,' non-descending order',0)) -! 1 GOTO 900 -! ENDIF -!C -! IF (IAND(PPD_CMAS_GET('ALPHABETIC'),1) .NE. 0) THEN -! IF (.NOT.PPD_HELP_MORE(LUN,' alphabetic',0)) GOTO 900 -! ELSE IF (IAND(PPD_CMAS_GET('NUMERIC'),1) .NE. 0) THEN -! IF (.NOT.PPD_HELP_MORE(LUN,' numeric',0)) GOTO 900 -! ELSE IF (IAND(PPD_CMAS_GET('ANUMERIC'),1) .NE. 0) THEN -! IF (.NOT.PPD_HELP_MORE(LUN,' alpha-numeric',0)) GOTO 900 -! ENDIF -!C -! IF (IAND(PPD_CMAS_GET('OPTIONS'),1) .NE. 0) THEN -! IF (.NOT.PPD_HELP_MORE(LUN,' valid options',0)) GOTO 900 -! ELSE IF (IAND(PPD_CMAS_GET('ABBREV_OPTIONS'),1) .NE. 0) THEN -! IF (.NOT.PPD_HELP_MORE(LUN,' valid abbreviated options',0)) -! 1 GOTO 900 -! ENDIF -!C -! IF (IAND(PPD_CMAS_GET('NODE'),1) .NE. 0) THEN -! IF (.NOT.PPD_HELP_MORE(LUN,' valid node name',0)) GOTO 900 -! ENDIF -C - IF (.NOT.PPD_HELP_MORE(LUN,' ',1)) GOTO 900 - ENDIF -C -C - 900 PPD_HELP_PRINT = PPD_SUCCESS - RETURN -C - 999 PPD_HELP_PRINT = IS - RETURN - END -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - INTEGER*4 FUNCTION PPD_HELP_OUT (LUN,WORK,LW,LINE,LL) -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' -C - INTEGER*4 LUN ! (i) LUN for print file - CHARACTER*(*) WORK ! (i) string to be added - INTEGER*4 LW ! (i) its length - CHARACTER*(*) LINE ! (m) output line - INTEGER*4 LL ! (m) its length - LOGICAL PPD_HELP_MORE -C -C.Purpose: Append a string to the line, and write to the print file -C.Returns: Status code (.TRUE. for success, .FALSE. otherwise) -C success PPD_SUCCESS -C.Notes: -C Whenever the string does not fit into the output line, the line is -C written to the file and a new line is started. -C------------------------------------------------------------------------- -C -C - IF (LL+LW.LE.LEN(LINE)) THEN - LINE(LL+1:) = WORK(:LW) - LL = LL+LW - ELSE - IF (.NOT.PPD_HELP_MORE(LUN,LINE,LL)) GOTO 900 - IF (.NOT.PPD_HELP_MORE(LUN,WORK,LW)) GOTO 900 - LL = 1 - ENDIF -C -900 PPD_HELP_OUT = PPD_SUCCESS - RETURN - END - -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - LOGICAL FUNCTION PPD_HELP_MORE (LUN,LINE,LL) -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' -C - INTEGER*4 LUN ! (i) LUN for print file - CHARACTER*(*) LINE ! (m) output line - INTEGER*4 LL ! (m) its length -C -C.Purpose: Write a line to the terminal, stop at end of screen -C.Notes: -C The string is wrapped according to the number of columns on the -C screen. When the number of lines on the screen is reached, a -C prompt is issued. This is a very crude "more" function. -C If the user enters Ctrz_Z (Ctrl_D on Unix), all subsequent -C output is suppressed (this saves me from adding some fifteen -C checks in PPD_HELP_PRINT). -C------------------------------------------------------------------------- -C -C - LOGICAL GEN_ISATERM ! - INTEGER LINES,COLS,CUR_LINE,IS - DATA LINES/0/,COLS/0/,CUR_LINE/0/,IS/DWC_SUCCESS/ - CHARACTER LAST*80 - DATA LAST/' '/ - SAVE LINES,COLS,CUR_LINE,IS - LOGICAL PPD_HELP_MORE1 -C - INTEGER*4 NLINE, NDONE, NPR, GEN_INPUT, WNCALN - CHARACTER TMP*10 -C -C If LL == 0, set it to the defined length of the string -C - IF (LL.EQ.0) THEN - NLINE=WNCALN(LINE) - ELSE - NLINE=LL - ENDIF -C -C Make "empty lines" really empty -C - IF (NLINE.EQ.1.AND.LINE(1:1).EQ.'.') LINE(1:1)=' ' -C -C Print the string in pieces of COLS-1 -C - NDONE=0 - DO WHILE (NDONE.LT.NLINE) -C -C If screen (almost) full, wait for keypress -C - IF (GEN_ISATERM(6).AND.LINES.GT.3.AND.CUR_LINE.GE.LINES-3) THEN - IS=GEN_INPUT(TMP, - 1 '*** <Return> for next screen or <control-D> to quit help ***',0) - IF (IAND(IS,1) .EQ.0) GOTO 900 - WRITE(LUN,'(1X)') - CUR_LINE=0 - IF (LAST.NE.' ') THEN - WRITE(LUN,'(A)') LAST(1:WNCALN(LAST)) - CUR_LINE=1 - ENDIF - ENDIF -C -C Now print a line on the screen -C - NPR=MIN(NLINE-NDONE,COLS-1) - WRITE(LUN,'(A)') LINE(NDONE+1:NDONE+NPR) - LAST=LINE(NDONE+1:NDONE+NPR) - NDONE=NDONE+NPR - CUR_LINE=CUR_LINE+1 -C - END DO -C - PPD_HELP_MORE=.TRUE. - RETURN -C -C Quit request -C -900 PPD_HELP_MORE=.FALSE. - RETURN - - ENTRY PPD_HELP_MORE1(LUN) -C -C Initialise: get number of lines and columns -C -C Only initialise for output to screen (of course). -C - IF (LINES.EQ.0) THEN - IF (LUN.EQ.6) CALL GEN_SIZE(LINES,COLS) - IF (COLS.LE.0) COLS=80 - IF (COLS.GT.80) COLS=80 - ENDIF -C -C Start line counter and allow for output -C - CUR_LINE=0 - IS=DWC_SUCCESS - LAST=' ' - PPD_HELP_MORE1=.TRUE. -C - RETURN - END - diff --git a/src/dwarf/ppdhstr.for b/src/dwarf/ppdhstr.for deleted file mode 100644 index 33d2c0c8033ec067ed81d126c41508702dbcc1cf..0000000000000000000000000000000000000000 --- a/src/dwarf/ppdhstr.for +++ /dev/null @@ -1,172 +0,0 @@ -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ -C.Ident: PPD_HSTR -C.Keywords: PPD File, Parameter Help String -C.Author: Kasper Kombrink (NFRA, Dwingeloo) -C.Language: DWARF-Fortran -C.Environment: VAX or Alliant -C.Comments: -C Common variables used: -C INTEGER*4 PPDPD$HOFF ! (m) offset of help string in buffer -C INTEGER*4 PPDPD$HLEN ! (m) length of help string -C -C.Version: 900415 FMO - recreation -C.Version: 920224 GvD - no optional arguments in MSG anymore -C.Version: 930510 HjV - Change some INTEGER*2 into INTEGER*4 -C.Version: 940120 CMV - use indirect addressing (A_B) -C 940909 JPH - PPD_HSTR_LSET: dynamic help texts -C. 941031 HjV - Typo -C------------------------------------------------------------------------- -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - INTEGER*4 FUNCTION PPD_HSTR_PUT (STRING,DO_CHECK) -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' -C - CHARACTER*(*) STRING ! (i) proposed help string - LOGICAL*4 DO_CHECK ! (i) check the string ? -C -C.Purpose: Check and store the help string for a program parameter -C.Returns: Status code (.TRUE. for success, .FALSE. otherwise) -C success PPD_SUCCESS -C false status codes returned by referenced routines -C.Notes: -C - The help string is stored in the dynamic help buffer described by the -C status array BPD$HELP. Its offset w.r.t. the start of the buffer and -C its significant length are stored in the fixed part of the current -C parameter description (fields PPDPD$HOFF and PPDPD$HLEN). -C - If no help string is given, the offset is set to UNDEF_J. -C - In case of errors, no messages are stored in the regular message -C buffer. The calling routine (BPD_BUILD) takes care of that. -C------------------------------------------------------------------------- -C - INCLUDE 'PPDREC_4_DEF' -C - INTEGER*4 BPD_HELP_PUT, STR_SIGLEN -C - INTEGER*4 IS, LSTR, HOFF -C -C - PPDPD$HOFF = UNDEF_J - PPDPD$HLEN = 0 -C - LSTR = STR_SIGLEN (STRING) - IF (LSTR.GT.0) THEN - IS = BPD_HELP_PUT (STRING(:LSTR),HOFF) - IF (IAND(IS,1).EQ.0) GOTO 999 - PPDPD$HOFF = HOFF - PPDPD$HLEN = LSTR - ENDIF -C - PPD_HSTR_PUT = PPD_SUCCESS - RETURN -C - 999 PPD_HSTR_PUT = IS - RETURN - END -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - INTEGER*4 FUNCTION PPD_HSTR_XGET (STRING,LS) -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' -C - CHARACTER*(*) STRING ! (o) help string - INTEGER*4 LS ! (o) its significant length -C -C.Purpose: Get the help string for the current parameter -C.Returns: Status code (.TRUE. for success, .FALSE. otherwise) -C success PPD_SUCCESS -C error PPD_SEQERROR no PPD file mapped -C error PPD_NOCURENTR no current parameter selected -C error PPD_STRTOOSML output string too short -C.Notes: -C - If a dynamic help string has been set, it is copied first -C - The string is fetched from the mapped PPD file (help area) using -C the offset and length given in the current parameter description, -C and appended. -C - If no help string is given, a blank string will be returned. -C------------------------------------------------------------------------- -C - INCLUDE 'PPDREC_4_DEF' -C - INTEGER*4 PPD_STAT_INQ, MOVE_BLB, MSG_SET -C - INTEGER*4 IS, MAPB, ADDR, HLPB - INTEGER LHELP_MX - PARAMETER (LHELP_MX=512) - CHARACTER*(LHELP_MX) LHELP - INTEGER LHELP_L, LL - LOGICAL DYNONLY - INTEGER PPD_HSTR_LSET, STR_SIGLEN -C -C - STRING = ' ' - LS = 0 -C -C Make sure that the PPD file is mapped -C and that a parameter has been selected -C - IS = PPD_STAT_INQ (MAPB,ADDR,HLPB) - IF (MAPB.EQ.0) THEN - IS = PPD_SEQERROR - GOTO 999 - ELSE IF (ADDR.EQ.0) THEN - IS = PPD_NOCURENTR - GOTO 999 - ENDIF -C -C Get the dynamic help text. If it ends in -C a line '#-' this signals that the static -C help text must be ignored. -C - LL=MIN(LHELP_L,LEN(STRING)) - IF (LL.GT.0) STRING(1:LL)=LHELP - IF (PPDPD$HOFF.NE.UNDEF_J) THEN - LS = PPDPD$HLEN - ADDR = HLPB+PPDPD$HOFF+1 - IF (LS+LL .LE.LEN(STRING)) THEN - IS = MOVE_BLB (A_B(ADDR-A_OB),%REF(STRING(LL+1:)),LS) - LS = LS +LL - ELSE - LS = LEN(STRING) -LL - IS = MOVE_BLB (A_B(ADDR-A_OB),%REF(STRING(LL+1:)),LS) - LS = LS +LL - IS = PPD_STRTOOSML - GOTO 999 - ENDIF - ENDIF -C - PPD_HSTR_XGET = PPD_SUCCESS - RETURN -C - 999 PPD_HSTR_XGET = MSG_SET (IS,0) - RETURN -C -C -C This entry point is used to set dynamic help text that will be shown in -C subsequent prompts BEFORE the .PPD help text. The text is stored in the local -C buffer LHELP with a blank line appended to separate it from the .ppd text. -C - ENTRY PPD_HSTR_LSET (STRING) -C - IF (STRING.GT.' ') THEN - LHELP_L=MIN(STR_SIGLEN(STRING),LHELP_MX) - DYNONLY=LHELP(LHELP_L-1:LHELP_L).EQ.'#-' - IF (.NOT.DYNONLY) LHELP_L=MIN(STR_SIGLEN(STRING),LHELP_MX-4) - ! reserve for CRLF*- - LHELP(1:LHELP_L)=STRING - DO I=1,LHELP_L-1 - IF (LHELP(I:I+1).EQ.'!/') ! replace !/ with CRLF - 1 LHELP(I:I+1)=CHAR(13)//CHAR(10) - ENDDO - IF (.NOT.DYNONLY) THEN - LHELP(LHELP_L+1:LHELP_L+4)=CHAR(13)//CHAR(10)//'*-' - LHELP_L=LHELP_L+4 - ENDIF - ELSE - LHELP_L=4 - LHELP(1:4)=CHAR(13)//CHAR(10)//'*-' - ENDIF -C - RETURN - - END diff --git a/src/dwarf/ppdindex.for b/src/dwarf/ppdindex.for deleted file mode 100644 index f13e8bc1adaa43f694b39f3b2b38618b45ece478..0000000000000000000000000000000000000000 --- a/src/dwarf/ppdindex.for +++ /dev/null @@ -1,247 +0,0 @@ -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ -C.Ident: PPD_INDEX -C.Keywords: PPD File, Index -C.Author: Friso Olnon (NFRA, Dwingeloo) -C.Language: DWARF-Fortran -C.Environment: VAX or Alliant -C.Comments: -C Common variables used: -C INTEGER*4 PPS$INXB ! (r) address of index in PPD file -C INTEGER*4 PPS$NRINX ! (r) nr of index entries -C INTEGER*4 PPS$NRINXPR ! (m) nr of last selected index entry -C -C.Version: 900415 FMO - recreation -C.Version: 920224 GvD - no optional arguments in MSG anymore -C.Version: 940120 CMV - use indirect addressing (A_B) -C------------------------------------------------------------------------- -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - INTEGER*4 FUNCTION PPD_INDEX_GETP (PNAM,PDOFF) -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' -C - CHARACTER*(*) PNAM ! (i) program's parameter name - INTEGER*4 PDOFF ! (o) offset of parameter description -C -C.Purpose: Get the location of the parameter description -C.Returns: Status code (.TRUE. for success, .FALSE. otherwise) -C success PPD_SUCCESS -C info PPD_ENDOFFILE no parameters (only for blank PNAM) -C error PPD_SEQERROR no PPD file open -C error PPD_KEYNOTFND unknown parameter name -C.Notes: -C - A blank PNAM indicates the first normal parameter in the index. -C - The index number of the parameter will be saved in PPS$NRINXPR. -C------------------------------------------------------------------------- -C - INCLUDE 'PPDSTAT_2_DEF' - INCLUDE 'PPDREC_4_DEF' -C - INTEGER*4 MOVE_BLJ, STR_SIGLEN, MSG_SET -C - INTEGER*4 IS, LNAM, ADDR, NR - LOGICAL*4 FOUND -C -C -C Make sure that a PPD file is open -C - IF (PPS$INXB.EQ.0) THEN - IS = PPD_SEQERROR - GOTO 999 - ENDIF -C -C Loop through the index -C - skip prototype entries -C - stop when the proper entry is found -C - LNAM = STR_SIGLEN (PNAM) - ADDR = PPS$INXB+1 - NR = 0 - FOUND = .FALSE. - DO WHILE (.NOT.FOUND .AND. NR.LT.PPS$NRINX) - IS = MOVE_BLJ (A_B(ADDR-A_OB),PPDID_,PPDID__LENGTH) - NR = NR+1 - ADDR = ADDR + PPDID__LENGTH*4 - IF (PPDID$UNAM(1:1).NE.'$') THEN - FOUND = LNAM.EQ.0 .OR. PNAM.EQ.PPDID$PNAM - ENDIF - ENDDO -C - IF (.NOT.FOUND) THEN - IF (LNAM.GT.0) THEN - IS = PPD_KEYNOTFND - ELSE - IS = PPD_ENDOFFILE - ENDIF - GOTO 999 - ENDIF -C -C Fill the output argument -C and save the index pointer -C - PDOFF = PPDID$PARMOFF - PPS$NRINXPR = NR - PPD_INDEX_GETP = PPD_SUCCESS - RETURN -C - 999 PPD_INDEX_GETP = MSG_SET (IS,0) - RETURN - END -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - INTEGER*4 FUNCTION PPD_INDEX_GETU (UNAM,PDOFF) -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' -C - CHARACTER*(*) UNAM ! (m) user's parameter name - INTEGER*4 PDOFF ! (o) offset of parameter description -C -C.Purpose: Get the location of the prototype/parameter description -C.Returns: Status code (.TRUE. for success, .FALSE. otherwise) -C success PPD_SUCCESS -C error PPD_SEQERROR no PPD file open -C error PPD_KEYNOTFND unknown parameter name -C error PPD_KEYAMBIG ambiguously abbreviated name -C error PPD_STRTOOSML UNAM not long enough for the full name -C.Notes: -C - The complete user's name will be returned in UNAM. -C - The index pointer PPS$NRINXPR will be set to 0. -C------------------------------------------------------------------------- -C - INCLUDE 'PPDSTAT_2_DEF' - INCLUDE 'PPDREC_4_DEF' -C - INTEGER*4 MAXNSYN - PARAMETER (MAXNSYN = 16) -C - INTEGER*4 MOVE_BLJ, STR_SIGLEN, MSG_SET -C - CHARACTER*16 UNAMSYN(MAXNSYN) - INTEGER*4 IS, ADDR, LU, NSYN, NR - LOGICAL*4 FOUND -C -C -C Make sure that a PPD file is open -C - IF (PPS$INXB.EQ.0) THEN - IS = PPD_SEQERROR - GOTO 999 - ENDIF -C -C Loop through the index -C - stop when a unique match is found -C - NR = 0 - ADDR = PPS$INXB+1 - LU = STR_SIGLEN (UNAM) - NSYN = 0 - FOUND = .FALSE. - DO WHILE (.NOT.FOUND .AND. NR.LT.PPS$NRINX) - IS = MOVE_BLJ (A_B(ADDR-A_OB),PPDID_,PPDID__LENGTH) - NR = NR+1 - ADDR = ADDR + PPDID__LENGTH*4 - IF (UNAM(:LU).EQ.PPDID$UNAM(:LU)) THEN - IF (LU.GE.PPDID$LUNAM) THEN - FOUND = .TRUE. - ELSE IF (NSYN.LT.MAXNSYN) THEN - NSYN = NSYN+1 - UNAMSYN(NSYN) = PPDID$UNAM - ENDIF - ENDIF - ENDDO -C - IF (.NOT.FOUND) THEN - IF (NSYN.EQ.0) THEN - IS = PPD_KEYNOTFND - ELSE - DO I = 1,NSYN - CALL WNCTXT(DWLOG,'!AS',UNAMSYN(I)) - ENDDO - IS = PPD_KEYAMBIG - ENDIF - GOTO 999 - ENDIF -C - LU = STR_SIGLEN (PPDID$UNAM) - IF (LU.GT.LEN(UNAM)) THEN - IS = PPD_STRTOOSML - GOTO 999 - ENDIF -C -C Fill the output arguments -C and clear the index pointer -C - UNAM = PPDID$UNAM(:LU) - PDOFF = PPDID$PARMOFF - PPS$NRINXPR = 0 - PPD_INDEX_GETU = PPD_SUCCESS - RETURN -C - 999 PPD_INDEX_GETU = MSG_SET (IS,1) - CALL WNCTXT(DWLOG,DWMSG,UNAM) - RETURN - END -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - INTEGER*4 FUNCTION PPD_INDEX_GETNXT (PDOFF) -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' -C - INTEGER*4 PDOFF ! (o) offset of parameter description -C -C.Purpose: Get the location of the description of the next parameter -C.Returns: Status code (.TRUE. for success, .FALSE. otherwise) -C success PPD_SUCCESS -C info PPD_ENDOFFILE no more normal parameters -C error PPD_SEQERROR no PPD file open -C.Notes: -C - If called after GETP, the next normal parameter in the index will be -C taken. Otherwise, the first one will be taken. -C - The index number of the parameter will be saved in PPS$NRINXPR. -C------------------------------------------------------------------------- -C - INCLUDE 'PPDSTAT_2_DEF' - INCLUDE 'PPDREC_4_DEF' -C - INTEGER*4 MOVE_BLJ, MSG_SET -C - INTEGER*4 IS, ADDR, NR - LOGICAL*4 FOUND -C -C -C Make sure that a PPD file is open -C - IF (PPS$INXB.EQ.0) THEN - IS = PPD_SEQERROR - GOTO 999 - ENDIF -C -C Get the next normal index entry -C - skip prototype entries -C - NR = PPS$NRINXPR - ADDR = PPS$INXB + NR*PPDID__LENGTH*4 + 1 - FOUND = .FALSE. - DO WHILE (.NOT.FOUND .AND. NR.LT.PPS$NRINX) - IS = MOVE_BLJ (A_B(ADDR-A_OB),PPDID_,PPDID__LENGTH) - NR = NR+1 - ADDR = ADDR + PPDID__LENGTH*4 - FOUND = PPDID$UNAM(1:1).NE.'$' - ENDDO -C - IF (.NOT.FOUND) THEN - IS = PPD_ENDOFFILE - GOTO 999 - ENDIF -C -C Fill the output argument -C and update the index pointer -C - PDOFF = PPDID$PARMOFF - PPS$NRINXPR = NR - PPD_INDEX_GETNXT = PPD_SUCCESS - RETURN -C - 999 PPD_INDEX_GETNXT = MSG_SET (IS,0) - RETURN - END diff --git a/src/dwarf/ppdinit.for b/src/dwarf/ppdinit.for deleted file mode 100644 index c406c15006b4255c17e93f966a25163ed5e956d5..0000000000000000000000000000000000000000 --- a/src/dwarf/ppdinit.for +++ /dev/null @@ -1,168 +0,0 @@ -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ -C.Ident: PPD_INIT -C.Keywords: PPD File, Initialize and Exit PPD Operations -C.Author: Friso Olnon (NFRA, Dwingeloo) -C.Language: DWARF-Fortran -C.Environment: VAX or Alliant -C.Comments: -C.Version: 900415 FMO - recreation -C.Version: 920224 GvD - no optional arguments in MSG anymore -C.Version: 930923 CMV - logical names for new maintenance system -C.Version: 010709 AXC - Linux port - tmpchar in calls -C------------------------------------------------------------------------- -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - INTEGER*4 FUNCTION PPD_INIT (PROGNAM) -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' -C - CHARACTER*(*) PROGNAM ! (i) program name -C -C.Purpose: Open and map the PPD file -C.Returns: Status code (.TRUE. for success, .FALSE. otherwise) -C success 1 PPD file found in EXEDWARF -C info DWC_EXEUSER PPD file found in EXEUSER -C false status codes returned by referenced modules -C.Notes: -C - The file <prognam>.PPD is taken from EXEUSER: (a message will be -C written) or from EXEDWARF:. -C - The status array of the mapped PPF file will be filled. -C------------------------------------------------------------------------- -C -C - INTEGER*4 PPD_STAT_FILL, PPD_FILE_FIND, PPD_FILE_OPEN - INTEGER*4 STR_SIGLEN, MSG_SET -C - CHARACTER*64 FULLSPEC,TMP - INTEGER*4 IS, ISFOUND, LP, LF -C -C -C Search for the PPD file -C - LP = STR_SIGLEN (PROGNAM) - IS = PPD_FILE_FIND (PROGNAM(:LP),FULLSPEC,LF) - IF (IAND(IS,1).EQ.0) GOTO 999 - IF (IS.EQ.DWC_EXEUSER) THEN - ISFOUND = MSG_SET(DWC_EXEUSER,1) - TMP=PROGNAM(:LP)//'.PPD' - CALL WNCTXT(DWLOG,DWMSG,TMP) - ELSE - ISFOUND = 1 - ENDIF -C -C Open and map the file -C - IS = PPD_FILE_OPEN (FULLSPEC(:LF)) - IF (IAND(IS,1).EQ.0) GOTO 999 -C -C Fill the status array -C - IS = PPD_STAT_FILL () - IF (IAND(IS,1).EQ.0) GOTO 999 -C -C - PPD_INIT = ISFOUND - RETURN -C - 999 PPD_INIT = IS - RETURN - END -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - INTEGER*4 FUNCTION PPD_EXIT () -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' -C -C -C.Purpose: Unmap and close the currently open PPD file -C.Returns: Status code (.TRUE. for success, .FALSE. otherwise) -C success 1 -C false status codes returned by referenced modules -C.Notes: -C - The status array of the mapped PPD file will be cleared. -C------------------------------------------------------------------------- -C - INTEGER*4 PPD_STAT_CLEAR, PPD_FILE_CLOSE -C - INTEGER*4 IS -C -C -C Unmap and close the file -C - IS = PPD_FILE_CLOSE () - IF (IAND(IS,1).EQ.0) GOTO 999 -C -C Clear the status array -C - IS = PPD_STAT_CLEAR () - IF (IAND(IS,1).EQ.0) GOTO 999 -C - PPD_EXIT = 1 - RETURN -C - 999 PPD_EXIT = IS - RETURN - END -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - INTEGER*4 FUNCTION PPD_SAVE () -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' -C -C -C.Purpose: De-activate the currently open PPD file -C.Returns: Status code (.TRUE. for success, .FALSE. otherwise) -C success PPD_SUCCESS -C false status codes returned by referenced modules -C.Notes: -C This routine de-activates the current PPD file, so that another one -C can be activated temporarily by a call to PPD_INIT. The original PPD -C file is re-activated by calling PPD_EXIT and then PPD_RESTORE. -C------------------------------------------------------------------------- -C -C - INTEGER*4 PPD_STAT_SAVE -C - INTEGER*4 IS -C -C - IS = PPD_STAT_SAVE () - IF (IAND(IS,1).EQ.0) GOTO 999 -C - PPD_SAVE = PPD_SUCCESS - RETURN -C - 999 PPD_SAVE = IS - RETURN - END -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - INTEGER*4 FUNCTION PPD_RESTORE () -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' -C -C -C.Purpose: Re-activate the original PPD file -C.Returns: Status code (.TRUE. for success, .FALSE. otherwise) -C success PPD_SUCCESS -C false status codes returned by referenced modules -C.Notes: -C This routine re-activates the PPD file that has been de-activated by -C a call to PPD_SAVE. -C------------------------------------------------------------------------- -C -C - INTEGER*4 PPD_STAT_RESTORE -C - INTEGER*4 IS -C -C - IS = PPD_STAT_RESTORE () - IF (IAND(IS,1).EQ.0) GOTO 999 -C - PPD_RESTORE = PPD_SUCCESS - RETURN -C - 999 PPD_RESTORE = IS - RETURN - END diff --git a/src/dwarf/ppdiocd.for b/src/dwarf/ppdiocd.for deleted file mode 100644 index 08fb65dfbcc0eeb3440e8fb70723441dec7652c6..0000000000000000000000000000000000000000 --- a/src/dwarf/ppdiocd.for +++ /dev/null @@ -1,119 +0,0 @@ -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ -C.Ident: PPD_IOCD -C.Keywords: PPD File, Parameter I/O Code -C.Author: Friso Olnon (NFRA, Dwingeloo) -C.Language: DWARF-Fortran -C.Environment: VAX or Alliant -C.Comments: -C Common variables used: -C CHARACTER*1 PPDPD$IOCD ! (m) I/O code -C -C.Version: 900415 FMO - recreation -C.Version: 920224 GvD - no optional arguments in MSG anymore -C------------------------------------------------------------------------- -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - INTEGER*4 FUNCTION PPD_IOCD_PUT (STRING,DO_CHECK) -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' -C - CHARACTER*(*) STRING ! (i) proposed code - LOGICAL*4 DO_CHECK ! (i) check validity ? -C -C.Purpose: Check and store the I/O code for a program parameter -C.Returns: Status code (.TRUE. for success, .FALSE. otherwise) -C success PPD_SUCCESS -C error PPD_IOINV invalid code -C.Notes: -C - The code will be abbreviated to 1 character and stored in the -C current parameter description (field PPDPD$IOCD). -C - If an invalid code is given, the default ('INPUT') will be used. -C - If DO_CHECK is off, the function just returns with PPD_SUCCESS. -C - In case of errors, no messages are stored in the regular message -C buffer. The calling routine (BPD_BUILD) takes care of that. -C------------------------------------------------------------------------- -C - INCLUDE 'PPDREC_4_DEF' -C - INTEGER*4 MAXNR - CHARACTER*(*) EMPTVAL, DEFIOCD - PARAMETER (MAXNR = 4 ) - PARAMETER (EMPTVAL = '[]') - PARAMETER (DEFIOCD = 'I' ) - CHARACTER*6 NAMES(MAXNR) - DATA NAMES /'INPUT','OUTPUT','MODIFY','NONE'/ -C - INTEGER*4 STR_SIGLEN, STR_MATCH_A -C - INTEGER*4 IS, LS, NR -C -C -C Check and abbreviate the code -C - IF (DO_CHECK) THEN - PPDPD$IOCD = DEFIOCD - LS = STR_SIGLEN (STRING) - IF (LS.GT.0 .AND. STRING(:LS).NE.EMPTVAL) THEN - IS = STR_MATCH_A (STRING(:LS),MAXNR,NAMES,NR) - IF (IAND(IS,1).EQ.0) GOTO 999 - PPDPD$IOCD = STRING(:1) - ENDIF - ENDIF -C - PPD_IOCD_PUT = PPD_SUCCESS - RETURN -C - 999 PPD_IOCD_PUT = PPD_IOINV - RETURN - END -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - INTEGER*4 FUNCTION PPD_IOCD_GET (CODE,LC) -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' -C - CHARACTER*(*) CODE ! (o) full I/O code - INTEGER*4 LC ! (o) its significant length -C -C.Purpose: Get the I/O code from the current parameter description -C.Returns: Status code (.TRUE. for success, .FALSE. otherwise) -C success PPD_SUCCESS -C error PPD_IOINV invalid I/O code -C error PPD_STRTOOSML output string too short -C.Notes: -C------------------------------------------------------------------------- -C - INCLUDE 'PPDREC_4_DEF' -C - INTEGER*4 MAXNR - PARAMETER (MAXNR = 4) - CHARACTER*6 NAMES(MAXNR) - DATA NAMES /'INPUT','OUTPUT','MODIFY','NONE'/ -C - INTEGER*4 STR_SIGLEN, STR_MATCH_A, MSG_SET -C - INTEGER*4 IS, NR -C -C - CODE = ' ' - LC = 0 -C - IS = STR_MATCH_A (PPDPD$IOCD,MAXNR,NAMES,NR) - IF (IAND(IS,1).EQ.0) THEN - IS = PPD_IOINV - GOTO 999 - ENDIF -C - CODE = NAMES(NR) - LC = STR_SIGLEN (CODE) - IF (LC.LT.STR_SIGLEN(NAMES(NR))) THEN - IS = PPD_STRTOOSML - GOTO 999 - ENDIF -C - PPD_IOCD_GET = PPD_SUCCESS - RETURN -C - 999 PPD_IOCD_GET = MSG_SET (IS,0) - RETURN - END diff --git a/src/dwarf/ppdleng.for b/src/dwarf/ppdleng.for deleted file mode 100644 index 29c9a6e382391ad3d5d81cd8fb8d318f64d385d1..0000000000000000000000000000000000000000 --- a/src/dwarf/ppdleng.for +++ /dev/null @@ -1,38 +0,0 @@ -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ -C.Ident: PPD_LENG -C.Keywords: PPD File, Parameter Description, Length -C.Author: Friso Olnon (NFRA, Dwingeloo) -C.Language: DWARF-Fortran -C.Environment: VAX or Alliant -C.Comments: -C Common variable used: -C INTEGER*4 PPDPD$LENG ! (m) significant length of description -C -C.Version: 900415 FMO - creation -C.Version: 930510 HjV - Change some INTEGER*2 into -C and change PPDPD_HLEN (+3 i.s.o. +1 !!!) -C------------------------------------------------------------------------- -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - INTEGER*4 FUNCTION PPD_LENG_INIT () -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' -C -C -C.Purpose: Initialize the description length -C.Returns: Status code (.TRUE. for success, .FALSE. otherwise) -C success PPD_SUCCESS -C.Notes: -C - The parameter description consists of a number of fixed fields -C (PPDPD_HLEN+3 bytes) and possibly a number of variable-length fields -C described by the fixed fields PPDPD$xxLEN and PPDPD$xxOFF. -C PPDPD$LENG gives the current total length in bytes. -C------------------------------------------------------------------------- -C - INCLUDE 'PPDREC_4_DEF' -C - PPDPD$LENG = PPDPD_HLEN+3 -C - PPD_LENG_INIT = PPD_SUCCESS - RETURN - END diff --git a/src/dwarf/ppdlist.for b/src/dwarf/ppdlist.for deleted file mode 100644 index 6ddf9052e963fa49fcab899e8dcffbe7ba6825c0..0000000000000000000000000000000000000000 --- a/src/dwarf/ppdlist.for +++ /dev/null @@ -1,129 +0,0 @@ -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ -C.Ident: PPD_LIST -C.Keywords: PPD File, List -C.Author: Friso Olnon (NFRA, Dwingeloo) -C.Language: DWARF-Fortran -C.Environment: VAX or Alliant -C.Comments: -C.Version: 900415 FMO - recreation -C.Version: 900502 FMO - new GEN_LUN module -C.Version: 920213 GvD - no optional arguments anymore -C.Version: 930923 CMV - logical names for new maintenance system -C.Version: 940118 CMV - used WNCFOP, WNCALN i.s.o. DWARF stuff -C.Version: 010709 AXC - linux port - tmpchar in calls -C------------------------------------------------------------------------- -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - INTEGER*4 FUNCTION PPD_LIST (PROGNAM,PRTFLAGS) -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' -C - CHARACTER*(*) PROGNAM ! (i) program name - INTEGER*4 PRTFLAGS ! (i) disposition flags -C -C.Purpose: Create a listing of the PPD file -C.Returns: Status code (.TRUE. for success, .FALSE. otherwise) -C success PPD_SUCCESS -C false status codes returned by referenced modules -C.Notes: -C------------------------------------------------------------------------- -C -C - LOGICAL L__FALSE - PARAMETER (L__FALSE = .FALSE.) -C - CHARACTER*(*) HELPFIL, WILDKEY, LISTYP, PPDTYP - PARAMETER (HELPFIL = 'HELP.DAT') - PARAMETER (WILDKEY = '*') - PARAMETER (LISTYP = '.MLIS') - PARAMETER (PPDTYP = '.PPD') -C - INTEGER*4 PPD_INIT, PPD_EXIT, PPD_HELP - INTEGER*4 FILNAM_FULL, GEN_FORIOS - INTEGER WNCALN -C - CHARACTER LINE*132, HELPSPEC*80, PPDSPEC*80, TMP*80 - INTEGER*4 IS, ISTMP, HELPLUN, LP, LEVEL, LHS, LPS - LOGICAL*4 SWP, SWINP, SWPROT - INTEGER*4 LISTID - DATA LISTID /-1/ -C -C -C Open and map the PPD file -C - LP = WNCALN(PROGNAM) - IS = PPD_INIT (PROGNAM(:LP)) - IF (IAND(IS,1).EQ.0) GOTO 999 - TMP=PROGNAM(:LP)//PPDTYP - IF (IAND(IS,7).EQ.3) THEN - IS = FILNAM_FULL (TMP,PPDSPEC,LPS,'n_uexe') - ELSE - IS = FILNAM_FULL (TMP,PPDSPEC,LPS,'n_exe') - ENDIF - IF (IAND(IS,1).EQ.0) GOTO 998 -C -C Create, fill and rewind the help file -C - IS = FILNAM_FULL (HELPFIL,HELPSPEC,LHS,' ') - IF (IAND(IS,1).NE.0) CALL WNGLUN(HELPLUN) - IF (HELPLUN.EQ.0) GOTO 998 - OPEN (HELPLUN,FILE=HELPSPEC(:LHS),TYPE='NEW',ACCESS='SEQUENTIAL', - 1 FORM='FORMATTED',IOSTAT=ISTMP) - IF (ISTMP.NE.0.AND.ISTMP.NE.128) THEN - IS = GEN_FORIOS (HELPSPEC(:LHS)) - GOTO 997 - ENDIF -C - SWP = .FALSE. ! in PIN order - SWINP = .FALSE. ! all IO codes allowed - SWPROT = .TRUE. ! prototypes too - LEVEL = 3 ! maximum info level - IS = PPD_HELP (WILDKEY,SWP,SWINP,SWPROT,LEVEL,HELPLUN) - IF (IAND(IS,1).EQ.0) GOTO 996 -C - REWIND HELPLUN - -C -C Open the print file -C and fill the header lines -C - TMP=PROGNAM(:LP)//LISTYP - CALL WNCFOP(LISTID,TMP) - CALL WNCFHD(LISTID,1,'!50CListing of !AS',PPDSPEC(:LPS)) - CALL WNCFSV(LISTID,F_DIS,PRTFLAGS) -C -C Copy help file to print file -C - DO WHILE (IAND(IS,1).NE.0) - READ (HELPLUN,'(A)',IOSTAT=ISTMP,END=200) LINE - IF (ISTMP.EQ.0) THEN - CALL WNCTXT(LISTID,'!AS',LINE) - ELSE - IS = GEN_FORIOS (HELPSPEC(:LHS)) - ENDIF - ENDDO - GOTO 995 -C -C Close the files -C - 200 CALL WNCFCL(LISTID) - IF (IAND(IS,1).EQ.0) GOTO 995 -C - CLOSE (HELPLUN,DISPOSE='DELETE') - CALL WNGLUF(HELPLUN) -C - IS = PPD_EXIT () - IF (IAND(IS,1).EQ.0) GOTO 999 -C -C Return -C - PPD_LIST = PPD_SUCCESS - RETURN -C - 995 CALL WNCFCL(LISTID) - 996 CLOSE (HELPLUN,DISPOSE='DELETE') - 997 CALL WNGLUF(HELPLUN) - 998 ISTMP = PPD_EXIT () - 999 PPD_LIST = IS - RETURN - END diff --git a/src/dwarf/ppdmin.for b/src/dwarf/ppdmin.for deleted file mode 100644 index a9945ca64b12d75cebbd9dd378bf16e5ae6e6f20..0000000000000000000000000000000000000000 --- a/src/dwarf/ppdmin.for +++ /dev/null @@ -1,496 +0,0 @@ -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ -C.Ident: PPD_MIN -C.Keywords: PPD File, Parameter Minimum/Maximum Values -C.Author: Friso Olnon (NFRA, Dwingeloo) -C.Language: DWARF-Fortran -C.Environment: VAX or Alliant -C.Comments: -C Common variables used: -C CHARACTER*(*) PPDPD$DESCR ! (m) description in string format -C INTEGER*4 PPDPD$LENG ! (m) current sign length of descr -C INTEGER*4 PPDPD$MNOFF ! (m) offset of minimum values in descr -C INTEGER*4 PPDPD$MNLEN ! (m) length of minimum values -C INTEGER*4 PPDPD$MXOFF ! (m) offset of maximum values in descr -C INTEGER*4 PPDPD$MXLEN ! (m) length of maximum values -C -C.Version: 900415 FMO - recreation -C.Version: 920224 GvD - no optional arguments in MSG anymore -C.Version: 930510 HjV - Change some INTEGER*2 into INTEGER*4 -C.Version: 940120 CMV - Use indirect addressing (A_B) -C------------------------------------------------------------------------- -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - INTEGER*4 FUNCTION PPD_MIN_PUT (STRING,DO_CHECK) -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' -C - CHARACTER*(*) STRING ! (i) proposed minimum values - LOGICAL*4 DO_CHECK ! (i) check the string ? -C -C.Purpose: Check and store the minimum values for a program parameter -C.Returns: Status code (.TRUE. for success, .FALSE. otherwise) -C success PPD_SUCCESS -C error PPD_MMNOVAL min-check requested, but no values -C error PPD_MMNOCHK values given, but no min-check requested -C error PPD_MMINV invalid value found -C error PPD_VCINVNVL vector: invalid nr of values -C error PPD_NVCINVNVL scalar or array: only 1 value allowed -C.Notes: -C - The minimum values are stored in the variable-length part of the -C current parameter description. Its offset w.r.t. the start of the -C description and its significant length are stored in the fixed part -C (fields PPDPD$MNOFF and PPDPD$MNLEN). -C - If no minimum check is requested, the offset is set to UNDEF_J. -C - In case of errors, no messages are stored in the regular message -C buffer. The calling routine (BPD_BUILD) takes care of that. -C------------------------------------------------------------------------- -C - INCLUDE 'PPDREC_4_DEF' -C - INTEGER*4 LBUF - CHARACTER*(*) EMPTVAL - PARAMETER (LBUF = 256 ) - PARAMETER (EMPTVAL = '[]') -C - INTEGER*4 PPD_DTYPE_GET, PPD_DTYPE_XGET - INTEGER*4 PPD_NVAL_GET, PPD_NVAL_XGET - INTEGER*4 PPD_CMAS_GET, PPD_AMAS_GET, CPL_VALLIST - INTEGER*4 STR_SIGLEN, MOVE_BLB -C - BYTE BUF(LBUF) - CHARACTER*1 DTYPE, XDTYPE - INTEGER*4 PLEN, XPLEN, NVAL, XNVAL, MNVAL, MXVAL - INTEGER*4 IS, LSTR, LARR, COUNT -C -C - PPDPD$MNOFF = UNDEF_J - PPDPD$MNLEN = 0 - LSTR = STR_SIGLEN (STRING) -C - IF (IAND(PPD_CMAS_GET('MINIMUM'),1) .NE. 0) THEN -C -C If input as a character-string list: -C - minimum values must be given -C - decode the list into an array -C - check the nr of values -C - store the array in the description -C - IF (DO_CHECK) THEN - IF (LSTR.EQ.0 .OR. STRING(:LSTR).EQ.EMPTVAL) THEN - IS = PPD_MMNOVAL - GOTO 999 - ENDIF -C - IS = PPD_DTYPE_GET (DTYPE,PLEN) - IS = PPD_NVAL_GET (NVAL,MNVAL,MXVAL) - IS = CPL_VALLIST (STRING(:LSTR),DTYPE,PLEN, - 1 BUF,LBUF,COUNT) - IF (IAND(IS,1).EQ.0) THEN - IS = PPD_MMINV - GOTO 999 - ENDIF -C - IF (IAND(PPD_AMAS_GET('VECTOR'),1) .NE. 0) THEN - IF (COUNT.NE.NVAL) IS = PPD_VCINVNVL - ELSE - IF (COUNT.NE.1) IS = PPD_NVCINVNVL - ENDIF - IF (IAND(IS,1).EQ.0) GOTO 999 -C - PPDPD$MNOFF = PPDPD$LENG - PPDPD$MNLEN = PLEN*COUNT - PPDPD$LENG = PPDPD$LENG+PPDPD$MNLEN - IF (PPDPD$LENG.GT.PPDPD__LENGTH*4) GOTO 9999 - IS = MOVE_BLB (BUF,PPDPD_(PPDPD$MNOFF+1),PLEN*COUNT) -C -C If input as an array: -C - array cannot be empty -C - check datatype, value length -C and nr of values -C - store the array in the description -C - ELSE - LARR = LEN (STRING) - IF (LARR.EQ.0) THEN - IS = PPD_MMNOVAL - GOTO 999 - ENDIF -C - IS = PPD_DTYPE_GET (DTYPE,PLEN) - IS = PPD_DTYPE_XGET (XDTYPE,XPLEN) - IS = PPD_NVAL_GET (NVAL,MNVAL,MXVAL) - IS = PPD_NVAL_XGET (XNVAL,MNVAL,MXVAL) - IF (DTYPE.NE.XDTYPE .OR. - 1 PLEN .NE.XPLEN .OR. - 2 NVAL .NE.XNVAL) THEN - IS = PPD_MMNOVAL - GOTO 999 - ENDIF -C - PPDPD$MNOFF = PPDPD$LENG - PPDPD$MNLEN = LARR - PPDPD$LENG = PPDPD$LENG+LARR - IF (PPDPD$LENG.GT.PPDPD__LENGTH*4) GOTO 9999 - IS = MOVE_BLB (%REF(STRING),PPDPD_(PPDPD$MNOFF+1),LARR) - ENDIF -C - ELSE IF (DO_CHECK) THEN - IF (LSTR.GT.0. AND. STRING(:LSTR).NE.EMPTVAL) THEN - IS = PPD_MMNOCHK - GOTO 999 - ENDIF - ENDIF -C - PPD_MIN_PUT = PPD_SUCCESS - RETURN -C - 999 PPD_MIN_PUT = IS - RETURN -C - 9999 PPD_MIN_PUT = 4 - CALL WNCTXT(DWLOG,'PPDPD_ overflow: tell DWARF manager') - CALL WNGEX - RETURN - END -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - INTEGER*4 FUNCTION PPD_MIN_GET (ARRAY,MAXL,LARR) -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' -C - BYTE ARRAY(*) ! (o) minimum values - INTEGER*4 MAXL ! (i) size of array - INTEGER*4 LARR ! (o) significant size of array -C -C.Purpose: Get the minimum values from the current parameter description -C.Returns: Status code (.TRUE. for success, .FALSE. otherwise) -C success PPD_SUCCESS -C error PPD_STRTOOSML output array too small -C.Notes: -C - If no minimum values are given, LARR = 0 will be returned. -C------------------------------------------------------------------------- -C - INCLUDE 'PPDREC_4_DEF' -C - INTEGER*4 MOVE_BLB, MSG_SET -C - INTEGER*4 IS -C -C -C Get the array -C - LARR = 0 - IF (PPDPD$MNOFF.NE.UNDEF_J) THEN - IF (PPDPD$MNLEN.GT.MAXL) GOTO 999 - LARR = PPDPD$MNLEN - IS = MOVE_BLB (PPDPD_(PPDPD$MNOFF+1),ARRAY,LARR) - ENDIF -C - PPD_MIN_GET = PPD_SUCCESS - RETURN -C - 999 PPD_MIN_GET = MSG_SET (PPD_STRTOOSML,0) - RETURN - END -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - INTEGER*4 FUNCTION PPD_MIN_XGET (ARRAY,MAXL,LARR) -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' -C - BYTE ARRAY(*) ! (o) minimum values - INTEGER*4 MAXL ! (i) size of array - INTEGER*4 LARR ! (o) nr of bytes in array -C -C.Purpose: Get the minimum values for the current parameter -C.Returns: Status code (.TRUE. for success, .FALSE. otherwise) -C success PPD_SUCCESS -C error PPD_SEQERROR no PPD file mapped -C error PPD_NOCURENTR no current parameter selected -C.Notes: -C - The values are fetched directly from the mapped PPD file using -C the offset and length given in the current parameter description. -C - Use XGET i.s.o. GET when the variable-length part of the current -C description contains data for another parameter (e.g. the COPY -C parameter in BLDPPD). -C - If no minimum values are given, LARR = 0 will be returned. -C------------------------------------------------------------------------- -C - INCLUDE 'PPDREC_4_DEF' -C - INTEGER*4 PPD_STAT_INQ, MOVE_BLB, MSG_SET -C - INTEGER*4 IS, MAPB, ADDR, HLPB -C -C - LARR = 0 -C -C Make sure that the PPD file is mapped -C and that a parameter has been selected -C - IS = PPD_STAT_INQ (MAPB,ADDR,HLPB) - IF (MAPB.EQ.0) THEN - IS = PPD_SEQERROR - GOTO 999 - ELSE IF (ADDR.EQ.0) THEN - IS = PPD_NOCURENTR - GOTO 999 - ENDIF -C -C Get the array -C - IF (PPDPD$MNOFF.NE.UNDEF_J) THEN - IF (PPDPD$MNLEN.LE.MAXL) THEN - LARR = PPDPD$MNLEN - ADDR = ADDR+PPDPD$MNOFF+1 - IS = MOVE_BLB (A_B(ADDR-A_OB),ARRAY,LARR) - ELSE - IS = PPD_STRTOOSML - GOTO 999 - ENDIF - ENDIF -C - PPD_MIN_XGET = PPD_SUCCESS - RETURN -C - 999 PPD_MIN_XGET = MSG_SET (IS,0) - RETURN - END -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - INTEGER*4 FUNCTION PPD_MAX_PUT (STRING,DO_CHECK) -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' -C - CHARACTER*(*) STRING ! (i) proposed maximum values - LOGICAL*4 DO_CHECK ! (i) check the string ? -C -C.Purpose: Check and store the maximum values for a program parameter -C.Returns: Status code (.TRUE. for success, .FALSE. otherwise) -C success PPD_SUCCESS -C error PPD_MMNOVAL max-check requested, but no values -C error PPD_MMNOCHK values given, but no max-check requested -C error PPD_MMINV invalid value found -C error PPD_VCINVNVL vector: invalid nr of values -C error PPD_NVCINVNVL scalar or array: only 1 value allowed -C.Notes: -C - The maximum values are stored in the variable-length part of the -C current parameter description. Its offset w.r.t. the start of the -C description and its significant length are stored in the fixed part -C (fields PPDPD$MXOFF and PPDPD$MXLEN). -C - If no maximum check is requested, the offset is set to UNDEF_J. -C - In case of errors, no messages are stored in the regular message -C buffer. The calling routine (BPD_BUILD) takes care of that. -C------------------------------------------------------------------------- -C - INCLUDE 'PPDREC_4_DEF' -C - INTEGER*4 LBUF - CHARACTER*(*) EMPTVAL - PARAMETER (LBUF = 256 ) - PARAMETER (EMPTVAL = '[]') -C - INTEGER*4 PPD_DTYPE_GET, PPD_DTYPE_XGET - INTEGER*4 PPD_NVAL_GET, PPD_NVAL_XGET - INTEGER*4 PPD_CMAS_GET, PPD_AMAS_GET, CPL_VALLIST - INTEGER*4 STR_SIGLEN, MOVE_BLB -C - BYTE BUF(LBUF) - CHARACTER*1 DTYPE, XDTYPE - INTEGER*4 PLEN, XPLEN, NVAL, XNVAL, MNVAL, MXVAL - INTEGER*4 IS, LSTR, LARR, COUNT -C -C - PPDPD$MXOFF = UNDEF_J - PPDPD$MXLEN = 0 - LSTR = STR_SIGLEN (STRING) -C - IF (IAND(PPD_CMAS_GET('MAXIMUM'),1) .NE. 0) THEN -C -C If input as a character-string list: -C - maximum values must be given -C - decode the list into an array -C - check the nr of values -C - store the array in the description -C - IF (DO_CHECK) THEN - IF (LSTR.EQ.0 .OR. STRING(:LSTR).EQ.EMPTVAL) THEN - IS = PPD_MMNOVAL - GOTO 999 - ENDIF -C - IS = PPD_DTYPE_GET (DTYPE,PLEN) - IS = PPD_NVAL_GET (NVAL,MNVAL,MXVAL) - IS = CPL_VALLIST (STRING(:LSTR),DTYPE,PLEN, - 1 BUF,LBUF,COUNT) - IF (IAND(IS,1).EQ.0) THEN - IS = PPD_MMINV - GOTO 999 - ENDIF -C - IF (IAND(PPD_AMAS_GET('VECTOR'),1) .NE. 0) THEN - IF (COUNT.NE.NVAL) IS = PPD_VCINVNVL - ELSE - IF (COUNT.NE.1) IS = PPD_NVCINVNVL - ENDIF - IF (IAND(IS,1).EQ.0) GOTO 999 -C - PPDPD$MXOFF = PPDPD$LENG - PPDPD$MXLEN = PLEN*COUNT - PPDPD$LENG = PPDPD$LENG+PPDPD$MXLEN - IF (PPDPD$LENG.GT.PPDPD__LENGTH*4) GOTO 9999 - IS = MOVE_BLB (BUF,PPDPD_(PPDPD$MXOFF+1),PLEN*COUNT) -C -C If input as an array: -C - array cannot be empty -C - check datatype, value length -C and nr of values -C - store the array in the description -C - ELSE - LARR = LEN (STRING) - IF (LARR.EQ.0) THEN - IS = PPD_MMNOVAL - GOTO 999 - ENDIF -C - IS = PPD_DTYPE_GET (DTYPE,PLEN) - IS = PPD_DTYPE_XGET (XDTYPE,XPLEN) - IS = PPD_NVAL_GET (NVAL,MNVAL,MXVAL) - IS = PPD_NVAL_XGET (XNVAL,MNVAL,MXVAL) - IF (DTYPE.NE.XDTYPE .OR. - 1 PLEN .NE.XPLEN .OR. - 2 NVAL .NE.XNVAL) THEN - IS = PPD_MMNOVAL - GOTO 999 - ENDIF -C - PPDPD$MXOFF = PPDPD$LENG - PPDPD$MXLEN = LARR - PPDPD$LENG = PPDPD$LENG+LARR - IF (PPDPD$LENG.GT.PPDPD__LENGTH*4) GOTO 9999 - IS = MOVE_BLB (%REF(STRING),PPDPD_(PPDPD$MXOFF+1),LARR) - ENDIF -C - ELSE IF (DO_CHECK) THEN - IF (LSTR.GT.0. AND. STRING(:LSTR).NE.EMPTVAL) THEN - IS = PPD_MMNOCHK - GOTO 999 - ENDIF - ENDIF -C - PPD_MAX_PUT = PPD_SUCCESS - RETURN -C - 999 PPD_MAX_PUT = IS - RETURN -C - 9999 PPD_MAX_PUT = 4 - CALL WNCTXT(DWLOG,'PPDPD_ overflow: tell DWARF manager') - CALL WNGEX - RETURN - END -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - INTEGER*4 FUNCTION PPD_MAX_GET (ARRAY,MAXL,LARR) -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' -C - BYTE ARRAY(*) ! (o) maximum values - INTEGER*4 MAXL ! (i) size of array - INTEGER*4 LARR ! (o) significant size of array -C -C.Purpose: Get the maximum values from the current parameter description -C.Returns: Status code (.TRUE. for success, .FALSE. otherwise) -C success PPD_SUCCESS -C error PPD_STRTOOSML otuput array too small -C.Notes: -C - If no maximum values are given, LARR = 0 will be returned. -C------------------------------------------------------------------------- -C - INCLUDE 'PPDREC_4_DEF' -C - INTEGER*4 MOVE_BLB, MSG_SET -C - INTEGER*4 IS -C -C -C Get the array -C - LARR = 0 - IF (PPDPD$MXOFF.NE.UNDEF_J) THEN - IF (PPDPD$MXLEN.GT.MAXL) GOTO 999 - LARR = PPDPD$MXLEN - IS = MOVE_BLB (PPDPD_(PPDPD$MXOFF+1),ARRAY,LARR) - ENDIF -C - PPD_MAX_GET = PPD_SUCCESS - RETURN -C - 999 PPD_MAX_GET = MSG_SET (PPD_STRTOOSML,0) - RETURN - END -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - INTEGER*4 FUNCTION PPD_MAX_XGET (ARRAY,MAXL,LARR) -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' -C - BYTE ARRAY(*) ! (o) maximum values - INTEGER*4 MAXL ! (i) size of array - INTEGER*4 LARR ! (o) nr of bytes in array -C -C.Purpose: Get the maximum values for the current parameter -C.Returns: Status code (.TRUE. for success, .FALSE. otherwise) -C success PPD_SUCCESS -C error PPD_SEQERROR no PPD file mapped -C error PPD_NOCURENTR no current parameter selected -C.Notes: -C - The values are fetched directly from the mapped PPD file using -C the offset and length given in the current parameter description. -C - Use XGET i.s.o. GET when the variable-length part of the current -C description contains data for another parameter (e.g. the COPY -C parameter in BLDPPD). -C - If no maximum values are given, LARR = 0 will be returned. -C------------------------------------------------------------------------- -C - INCLUDE 'PPDREC_4_DEF' -C - INTEGER*4 PPD_STAT_INQ, MOVE_BLB, MSG_SET -C - INTEGER*4 IS, MAPB, ADDR, HLPB -C -C - LARR = 0 -C -C Make sure that the PPD file is mapped -C and that a parameter has been selected -C - IS = PPD_STAT_INQ (MAPB,ADDR,HLPB) - IF (MAPB.EQ.0) THEN - IS = PPD_SEQERROR - GOTO 999 - ELSE IF (ADDR.EQ.0) THEN - IS = PPD_NOCURENTR - GOTO 999 - ENDIF -C -C Get the array -C - IF (PPDPD$MXOFF.NE.UNDEF_J) THEN - IF (PPDPD$MXLEN.LE.MAXL) THEN - LARR = PPDPD$MXLEN - ADDR = ADDR+PPDPD$MXOFF+1 - IS = MOVE_BLB (A_B(ADDR-A_OB),ARRAY,LARR) - ELSE - IS = PPD_STRTOOSML - GOTO 999 - ENDIF - ENDIF -C - PPD_MAX_XGET = PPD_SUCCESS - RETURN -C - 999 PPD_MAX_XGET = MSG_SET (IS,0) - RETURN - END diff --git a/src/dwarf/ppdnsets.for b/src/dwarf/ppdnsets.for deleted file mode 100644 index c4950f99fa498864829bafc99bc2e2dfb1a77e05..0000000000000000000000000000000000000000 --- a/src/dwarf/ppdnsets.for +++ /dev/null @@ -1,86 +0,0 @@ -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ -C.Ident: PPD_NSETS -C.Keywords: PPD File, Maximum Number of Sets -C.Author: Friso Olnon (NFRA, Dwingeloo) -C.Language: DWARF-Fortran -C.Environment: VAX or Alliant -C.Comments: -C Common variables used: -C INTEGER*4 PPDPD$NSETS ! (m) max nr of sets -C -C.Version: 900415 FMO - recreation -C.Version: 930510 HjV - Change some INTEGER*2 into INTEGER*4 -C------------------------------------------------------------------------- -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - INTEGER*4 FUNCTION PPD_NSETS_PUT (STRING,DO_CHECK) -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' -C - CHARACTER*(*) STRING ! (i) proposed nr - LOGICAL*4 DO_CHECK ! (i) check validity ? -C -C.Purpose: Decode, check and store the maximum nr of value sets -C.Returns: Status code (.TRUE. for success, .FALSE. otherwise) -C success PPD_SUCCESS -C error PPD_NOTPOSINT must be a positive integer -C.Notes: -C - The nr will be stored in the current parameter description -C (field PPDPD$NSETS). -C - If an invalid nr is given, the default (LARGEST_I) will be used. -C - If DO_CHECK is off, the function just returns with PPD_SUCCESS. -C - In case of errors, no messages are stored in the regular message -C buffer. The calling routine (BPD_BUILD) takes care of that. -C------------------------------------------------------------------------- -C - INCLUDE 'PPDREC_4_DEF' -C - CHARACTER*(*) EMPTVAL - INTEGER*4 DEFNSETS - PARAMETER (EMPTVAL = '[]') - PARAMETER (DEFNSETS = LARGEST_J) -C - INTEGER*4 STR_SIGLEN, STR_READ_J -C - INTEGER*4 IS, LS - INTEGER*4 NSETS -C -C -C Decode and check -C - IF (DO_CHECK) THEN - PPDPD$NSETS = DEFNSETS - LS = STR_SIGLEN (STRING) - IF (LS.GT.0 .AND. STRING(:LS).NE.EMPTVAL) THEN - IS = STR_READ_J (STRING(:LS),NSETS) - IF (IAND(IS,1).EQ.0 .OR. NSETS.LE.0) GOTO 999 - PPDPD$NSETS = NSETS - ENDIF - ENDIF -C - PPD_NSETS_PUT = PPD_SUCCESS - RETURN -C - 999 PPD_NSETS_PUT = PPD_NOTPOSINT - RETURN - END -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - INTEGER*4 FUNCTION PPD_NSETS_GET (NSETS) -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' -C - INTEGER*4 NSETS ! (o) max nr of value sets -C -C.Purpose: Get the max nr of sets from the current parameter description -C.Returns: Status code (.TRUE. for success, .FALSE. otherwise) -C success PPD_SUCCESS -C.Notes: -C------------------------------------------------------------------------- -C - INCLUDE 'PPDREC_4_DEF' -C - NSETS = PPDPD$NSETS - PPD_NSETS_GET = PPD_SUCCESS - RETURN - END diff --git a/src/dwarf/ppdnval.for b/src/dwarf/ppdnval.for deleted file mode 100644 index d68f9d149ec345eb5a2d6aa5ad3298d37160db4e..0000000000000000000000000000000000000000 --- a/src/dwarf/ppdnval.for +++ /dev/null @@ -1,305 +0,0 @@ -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ -C.Ident: PPD_NVAL -C.Keywords: PPD File, Number of Values per Set -C.Author: Friso Olnon (NFRA, Dwingeloo) -C.Language: DWARF-Fortran -C.Environment: VAX or Alliant -C.Comments: -C Common variables used: -C INTEGER*4 PPDPD$NVAL ! (m) nr of values per set -C INTEGER*4 PPDPD$MNVAL ! (m) minimum nr of values per set -C INTEGER*4 PPDPD$MXVAL ! (m) maximum nr of values per set -C -C.Version: 900415 FMO - recreation -C.Version: 920224 GvD - no optional arguments in MSG anymore -C.Version: 930510 HjV - Change some INTEGER*2 into INTEGER*4 -C.Version: 940120 CMV - Use indirect addressing (A_B) -C------------------------------------------------------------------------- -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - INTEGER*4 FUNCTION PPD_NVAL_PUT (STRING,DO_CHECK) -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' -C - CHARACTER*(*) STRING ! (i) proposed nr - LOGICAL*4 DO_CHECK ! (i) check validity ? -C -C.Purpose: Decode, check and store the nr of values per set -C.Returns: Status code (.TRUE. for success, .FALSE. otherwise) -C success PPD_SUCCESS -C error PPD_NOTPOSINT must be a positive integer -C error PPD_NVLINVVEC vector attribute only allowed if nr > 1 -C error PPD_NVLINVCHK order checks only allowed if nr > 1 -C.Notes: -C - The nr will be stored in the current parameter description -C (field PPDPD$NVAL). -C - If an invalid nr is given, the default (1) will be used. -C - If DO_CHECK is off, only the consistency with attributes and checks -C is tested. -C - In case of errors, no messages are stored in the regular message -C buffer. The calling routine (BPD_BUILD) takes care of that. -C------------------------------------------------------------------------- -C - INCLUDE 'PPDREC_4_DEF' -C - CHARACTER*(*) EMPTVAL - INTEGER*4 DEFNVAL - PARAMETER (EMPTVAL = '[]') - PARAMETER (DEFNVAL = 1 ) -C - INTEGER*4 PPD_AMAS_GET, PPD_CMAS_GET - INTEGER*4 STR_SIGLEN, STR_READ_J -C - INTEGER*4 IS, LS - INTEGER*4 NVAL -C -C -C Decode and check -C - IF (DO_CHECK) THEN - PPDPD$NVAL = DEFNVAL - LS = STR_SIGLEN (STRING) - IF (LS.GT.0 .AND. STRING(:LS).NE.EMPTVAL) THEN - IS = STR_READ_J (STRING(:LS),NVAL) - IF (IAND(IS,1).EQ.0 .OR. NVAL.LE.0) THEN - IS = PPD_NOTPOSINT - GOTO 999 - ENDIF - PPDPD$NVAL = NVAL - ENDIF - ENDIF -C -C Check against attributes and checks -C - IF (PPDPD$NVAL.EQ.1) THEN - IF (IAND(PPD_AMAS_GET ('VECTOR'),1) .NE. 0) THEN - IS = PPD_NVLINVVEC - GOTO 999 - ENDIF - IF (IAND(PPD_CMAS_GET ('ASCENDING' ),1) .NE. 0 .OR. - 1 IAND(PPD_CMAS_GET ('DESCENDING' ),1) .NE. 0 .OR. - 2 IAND(PPD_CMAS_GET ('NON_ASCENDING' ),1) .NE. 0 .OR. - 3 IAND(PPD_CMAS_GET ('NON_DESCENDING'),1) .NE. 0) THEN - IS = PPD_NVLINVCHK - GOTO 999 - ENDIF - ENDIF -C - PPD_NVAL_PUT = PPD_SUCCESS - RETURN -C - 999 PPD_NVAL_PUT = IS - RETURN - END -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - INTEGER*4 FUNCTION PPD_MNVAL_PUT (STRING,DO_CHECK) -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' -C - CHARACTER*(*) STRING ! (i) proposed nr - LOGICAL*4 DO_CHECK ! (i) check validity ? -C -C.Purpose: Decode, check and store the minimum nr of values per set -C.Returns: Status code (.TRUE. for success, .FALSE. otherwise) -C success PPD_SUCCESS -C error PPD_NOTPOSINT must be a positive integer -C error PPD_MNVALINV minimum nr > nr -C.Notes: -C - The nr will be stored in the current parameter description -C (field PPDPD$MNVAL). -C - If an invalid nr is given, the default (1) will be used. -C - If DO_CHECK is off, only the consistency with the nr of values will -C be tested. -C - In case of errors, no messages are stored in the regular message -C buffer. The calling routine (BPD_BUILD) takes care of that. -C------------------------------------------------------------------------- -C - INCLUDE 'PPDREC_4_DEF' -C - CHARACTER*(*) EMPTVAL - INTEGER*4 DEFMNVAL - PARAMETER (EMPTVAL = '[]') - PARAMETER (DEFMNVAL = 1 ) -C - INTEGER*4 STR_SIGLEN, STR_READ_J -C - INTEGER*4 IS, LS - INTEGER*4 MNVAL -C -C -C Decode and check -C - IF (DO_CHECK) THEN - PPDPD$MNVAL = DEFMNVAL - LS = STR_SIGLEN (STRING) - IF (LS.GT.0 .AND. STRING(:LS).NE.EMPTVAL) THEN - IS = STR_READ_J (STRING(:LS),MNVAL) - IF (IAND(IS,1).EQ.0 .OR. MNVAL.LE.0) THEN - IS = PPD_NOTPOSINT - GOTO 999 - ENDIF - PPDPD$MNVAL = MNVAL - ENDIF - ENDIF -C -C Check against nr of values -C - IF (PPDPD$MNVAL.GT.PPDPD$NVAL) THEN - PPDPD$MNVAL = DEFMNVAL - IS = PPD_MNVALINV - GOTO 999 - ENDIF -C - PPD_MNVAL_PUT = PPD_SUCCESS - RETURN -C - 999 PPD_MNVAL_PUT = IS - RETURN - END -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - INTEGER*4 FUNCTION PPD_MXVAL_PUT (STRING,DO_CHECK) -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' -C - CHARACTER*(*) STRING ! (i) proposed nr - LOGICAL*4 DO_CHECK ! (i) check validity ? -C -C.Purpose: Decode, check and store the maximum nr of values per set -C.Returns: Status code (.TRUE. for success, .FALSE. otherwise) -C success PPD_SUCCESS -C error PPD_NOTPOSINT must be a positive integer -C error PPD_MXVALINV maximum nr > nr or < minimum nr -C.Notes: -C - The nr will be stored in the current parameter description -C (field PPDPD$MXVAL). -C - If an invalid nr is given, the default (PPDPD$NVAL) will be used. -C - If DO_CHECK is off, only the consistency with the (minimum) nr of -C values will be tested. -C - In case of errors, no messages are stored in the regular message -C buffer. The calling routine (BPD_BUILD) takes care of that. -C------------------------------------------------------------------------- -C - INCLUDE 'PPDREC_4_DEF' -C - CHARACTER*(*) EMPTVAL - PARAMETER (EMPTVAL = '[]') -C - INTEGER*4 STR_SIGLEN, STR_READ_J -C - INTEGER*4 IS, LS - INTEGER*4 MXVAL -C -C -C Decode and check -C - IF (DO_CHECK) THEN - PPDPD$MXVAL = PPDPD$NVAL - LS = STR_SIGLEN (STRING) - IF (LS.GT.0 .AND. STRING(:LS).NE.EMPTVAL) THEN - IS = STR_READ_J (STRING(:LS),MXVAL) - IF (IAND(IS,1).EQ.0 .OR. MXVAL.LE.0) THEN - IS = PPD_NOTPOSINT - GOTO 999 - ENDIF - PPDPD$MXVAL = MXVAL - ENDIF - ENDIF -C -C Check against (minimum) nr of values -C - IF (PPDPD$MXVAL.GT.PPDPD$NVAL - 1 .OR. PPDPD$MXVAL.LT.PPDPD$MNVAL) THEN - PPDPD$MXVAL = PPDPD$NVAL - IS = PPD_MXVALINV - GOTO 999 - ENDIF -C - PPD_MXVAL_PUT = PPD_SUCCESS - RETURN -C - 999 PPD_MXVAL_PUT = IS - RETURN - END -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - INTEGER*4 FUNCTION PPD_NVAL_GET (NVAL,MNVAL,MXVAL) -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' -C - INTEGER*4 NVAL ! (o) nr of values per set - INTEGER*4 MNVAL ! (o) minimum nr of values per set - INTEGER*4 MXVAL ! (o) maximum nr of values per set -C -C.Purpose: Get the nr of values per set from the current param description -C.Returns: Status code (.TRUE. for success, .FALSE. otherwise) -C success PPD_SUCCESS -C.Notes: -C------------------------------------------------------------------------- -C - INCLUDE 'PPDREC_4_DEF' -C - NVAL = PPDPD$NVAL - MNVAL = PPDPD$MNVAL - MXVAL = PPDPD$MXVAL - PPD_NVAL_GET = PPD_SUCCESS - RETURN - END -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - INTEGER*4 FUNCTION PPD_NVAL_XGET (NVAL,MNVAL,MXVAL) -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' -C - INTEGER*4 NVAL ! (o) nr of values per set - INTEGER*4 MNVAL ! (o) minimum nr of values per set - INTEGER*4 MXVAL ! (o) maximum nr of values per set -C -C.Purpose: Get the nr of values per set for the current parameter -C.Returns: Status code (.TRUE. for success, .FALSE. otherwise) -C success PPD_SUCCESS -C error PPD_SEQERROR no PPD file mapped -C error PPD_NOCURENTR no current parameter selected -C.Notes: -C - The fields are taken directly from the mapped PPD file using the -C start address of the description of the current parameter. -C - Use XGET i.s.o. GET when the description array PPDPD_ contains -C data for another parameter. -C------------------------------------------------------------------------- -C - INCLUDE 'PPDREC_4_DEF' -C - INTEGER*4 PPD_STAT_INQ, MOVE_BLJ, MSG_SET -C - INTEGER*4 IS, MAPB, ADDR, HLPB -C -C - NVAL = 0 - MNVAL = 0 - MXVAL = 0 -C -C Make sure that the PPD file is mapped -C and that a parameter has been selected -C - IS = PPD_STAT_INQ (MAPB,ADDR,HLPB) - IF (MAPB.EQ.0) THEN - IS = PPD_SEQERROR - GOTO 999 - ELSE IF (ADDR.EQ.0) THEN - IS = PPD_NOCURENTR - GOTO 999 - ENDIF -C -C Get the fields -C - IS = MOVE_BLJ (A_B(ADDR+PPDPD_NVAL-A_OB),NVAL,1) - IS = MOVE_BLJ (A_B(ADDR+PPDPD_MNVAL-A_OB),MNVAL,1) - IS = MOVE_BLJ (A_B(ADDR+PPDPD_MXVAL-A_OB),MXVAL,1) -C - PPD_NVAL_XGET = PPD_SUCCESS - RETURN -C - 999 PPD_NVAL_XGET = MSG_SET (IS,0) - RETURN - END diff --git a/src/dwarf/ppdopstr.for b/src/dwarf/ppdopstr.for deleted file mode 100644 index a3a7c06fb30404ea2a57bc51e956b5eadf661e37..0000000000000000000000000000000000000000 --- a/src/dwarf/ppdopstr.for +++ /dev/null @@ -1,339 +0,0 @@ -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ -C.Ident: PPD_OPSTR -C.Keywords: PPD File, Parameter Options -C.Author: Friso Olnon (NFRA, Dwingeloo) -C.Language: DWARF-Fortran -C.Environment: VAX or Alliant -C.Comments: -C Common variables used: -C CHARACTER*(*) PPDPD$DESCR ! (m) description in string format -C INTEGER*4 PPDPD$LENG ! (m) current sign length of descr -C INTEGER*4 PPDPD$OPOFF ! (m) offset of options string in descr -C INTEGER*4 PPDPD$OPLEN ! (m) length of options string -C -C.Version: 900415 FMO - recreation -C.Version: 920224 GvD - no optional arguments in MSG anymore -C.Version: 930510 HjV - Change some INTEGER*2 into INTEGER*4 -C.Version: 940120 CMV - Use indirect addressing (A_B) -C 940909 JPH - PPD_OPSTR_LSET: dynamic help texts -C 941221 JPH - formatting chatracters ';|[]/' in options string -C 941213 JPH - More formatting. COMMA --> DELIM -C 010709 AXC - Linux port - Parameter -C------------------------------------------------------------------------- -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - INTEGER*4 FUNCTION PPD_OPSTR_PUT (STRING,DO_CHECK) -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' -C - CHARACTER*(*) STRING ! (i) proposed options string - LOGICAL*4 DO_CHECK ! (i) check the string ? -C -C.Purpose: Check and store the options string for a program parameter -C.Returns: Status code (.TRUE. for success, .FALSE. otherwise) -C success PPD_SUCCESS -C error PPD_OPTNOVAL option check requested, but no options given -C error PPD_OPTNOCHK options given, but no option check requested -C error PPD_OPTINVAL invalid option syntax -C.Notes: -C - The options string is stored in the variable-length part of the -C current parameter description. Its offset w.r.t. the start of the -C description and its significant length are stored in the fixed part -C (fields PPDPD$OPOFF and PPDPD$OPLEN). -C - If no options are given, the offset is set to UNDEF_J. -C - In case of errors, no messages are stored in the regular message -C buffer. The calling routine (BPD_BUILD) takes care of that. -C------------------------------------------------------------------------- -C - INCLUDE 'PPDREC_4_DEF' -C - INTEGER*4 LBUF - CHARACTER*(*) EMPTVAL - PARAMETER (LBUF = 512 ) - PARAMETER (EMPTVAL = '[]') - INTEGER*4 PPD_CMAS_GET, PPD_DTYPE_GET - INTEGER*4 CPL_VALLIST - INTEGER*4 STR_SIGLEN -C - CHARACTER*1 DTYPE - BYTE BUF(LBUF) - INTEGER*4 IS, LSTR, PLEN, COUNT -C -C - PPDPD$OPOFF = UNDEF_J - PPDPD$OPLEN = 0 -C - LSTR = STR_SIGLEN (STRING) - IF (LSTR.GT.0 .AND. STRING(:LSTR).NE.EMPTVAL) THEN - PPDPD$OPOFF = PPDPD$LENG - PPDPD$OPLEN = LSTR - PPDPD$LENG = PPDPD$LENG+LSTR - IF (PPDPD$LENG.GT.PPDPD__LENGTH*4) GOTO 9999 - PPDPD$DESCR(PPDPD$OPOFF+1:PPDPD$LENG) = STRING(:LSTR) -C -C Is options string allowed and valid ? -C - IF (IAND(PPD_CMAS_GET('OPTIONS'),1).EQ.0 .AND. - 1 IAND(PPD_CMAS_GET('ABBREV_OPTIONS'),1).EQ.0) THEN - IS = PPD_OPTNOCHK - GOTO 999 - ENDIF - IS = PPD_DTYPE_GET (DTYPE,PLEN) - IS = CPL_VALLIST (STRING(:LSTR),DTYPE,PLEN,BUF,LBUF,COUNT) - IF (IAND(IS,1).EQ.0) THEN - IS = PPD_OPTINVAL - GOTO 999 - ENDIF -C -C Is options string required ? -C - ELSE - IF (IAND(PPD_CMAS_GET('OPTIONS'),1).NE.0 .OR. - 1 IAND(PPD_CMAS_GET('ABBREV_OPTIONS'),1).NE.0) THEN - IS = PPD_OPTNOVAL - GOTO 999 - ENDIF - ENDIF -C - PPD_OPSTR_PUT = PPD_SUCCESS - RETURN -C - 999 PPD_OPSTR_PUT = IS - RETURN -C - 9999 PPD_OPSTR_PUT = 4 - CALL WNCTXT(DWLOG,'PPDPD_ overflow: tell DWARF manager') - CALL WNGEX - RETURN - END -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - INTEGER*4 FUNCTION PPD_OPSTR_GET (STRING,LS) -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' -C - CHARACTER*(*) STRING ! (o) options string - INTEGER*4 LS ! (o) its significant length -C -C.Purpose: Get the options string from the current parameter description -C.Returns: Status code (.TRUE. for success, .FALSE. otherwise) -C success PPD_SUCCESS -C error PPD_STRTOOSML output string too short -C.Notes: -C - If a dynamic options string has been set, it is used -C - If no options are given, a blank string will be returned. -C------------------------------------------------------------------------- -C - INCLUDE 'PPDREC_4_DEF' -C - INTEGER*4 STR_COPY, MSG_SET -C - INTEGER*4 IS - - CHARACTER*128 LOPT - INTEGER LOPT_L - COMMON /LOPT/ LOPT_L,LOPT - - INTEGER PPD_OPSTR_LSET, STR_SIGLEN -C -C -C Get the string -C - STRING = ' ' - LS = 0 - IF (LOPT_L.NE.0) THEN - LS=MIN(LOPT_L,LEN(STRING)) - STRING=LOPT - ELSEIF (PPDPD$OPOFF.NE.UNDEF_J) THEN - IS = STR_COPY - 1 (PPDPD$DESCR(PPDPD$OPOFF+1:PPDPD$OPOFF+PPDPD$OPLEN), - 2 STRING,LS) - IF (IS.LT.0) GOTO 999 - ENDIF -C - PPD_OPSTR_GET = PPD_SUCCESS - RETURN -C - 999 PPD_OPSTR_GET = MSG_SET (PPD_STRTOOSML,0) - RETURN -C -C -C This entry point is used to set dynamic prompt text that will be shown in -C subsequent prompts in lieu of the .PPD prompt text. The text is stored in the -C local buffer LOPT -C - ENTRY PPD_OPSTR_LSET (STRING) -C - IF (STRING.GT.' ') THEN - LOPT=STRING - LOPT_L=STR_SIGLEN(STRING) - ELSE - LOPT_L=0 - ENDIF -C - RETURN -C - END -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - INTEGER*4 FUNCTION PPD_OPSTR_XGET (STRING,LS) -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' -C - CHARACTER*(*) STRING ! (o) options string - INTEGER*4 LS ! (o) its significant length -C -C.Purpose: Get the options string for the current parameter -C.Returns: Status code (.TRUE. for success, .FALSE. otherwise) -C success PPD_SUCCESS -C error PPD_SEQERROR no PPD file mapped -C error PPD_NOCURENTR no current parameter selected -C error PPD_STRTOOSML output string too short -C.Notes: -C - The string is fetched directly from the mapped PPD file using -C the offset and length given in the current parameter description. -C - Use XGET i.s.o. GET when the variable-length part of the current -C description contains data for another parameter (e.g. the COPY -C parameter in BLDPPD). -C - If no options are given, a blank string will be returned. -C------------------------------------------------------------------------- -C - INCLUDE 'PPDREC_4_DEF' -C - INTEGER*4 PPD_STAT_INQ, MOVE_BLB, MSG_SET -C - INTEGER*4 IS, MAPB, ADDR, HLPB -C -C - STRING = ' ' - LS = 0 -C -C Make sure that the PPD file is mapped -C and that a parameter has been selected -C - IS = PPD_STAT_INQ (MAPB,ADDR,HLPB) - IF (MAPB.EQ.0) THEN - IS = PPD_SEQERROR - GOTO 999 - ELSE IF (ADDR.EQ.0) THEN - IS = PPD_NOCURENTR - GOTO 999 - ENDIF -C -C Get the string -C - IF (PPDPD$OPOFF.NE.UNDEF_J) THEN - LS = PPDPD$OPLEN - ADDR = ADDR+PPDPD$OPOFF+1 - IF (LS.LE.LEN(STRING)) THEN - IS = MOVE_BLB (A_B(ADDR-A_OB),%REF(STRING),LS) - ELSE - LS = LEN(STRING) - IS = MOVE_BLB (A_B(ADDR-A_OB),%REF(STRING),LS) - IS = PPD_STRTOOSML - GOTO 999 - ENDIF - ENDIF -C - PPD_OPSTR_XGET = PPD_SUCCESS - RETURN -C - 999 PPD_OPSTR_XGET = MSG_SET (IS,0) - RETURN - END -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - INTEGER*4 FUNCTION PPD_OPSTR_MATCH (BSTR,LENG,SHORT) -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' -C - BYTE BSTR(*) ! (m) byte string with option - INTEGER*4 LENG ! (i) its length - LOGICAL*4 SHORT ! (i) unique abbreviation allowed - - CHARACTER*512 LOPT - INTEGER LOPT_L - COMMON /LOPT/ LOPT_L,LOPT -C -C.Purpose: Check whether the option is a valid one -C.Returns: Status code (.TRUE. for success, .FALSE. otherwise) -C success PPD_SUCCESS -C error PPD_OPTINVAL invalid option -C error PPD_OPTNOTUNI ambiguous abbreviation -C.Notes: -C - If a dynamic options string has been set, it is used -C - The complete option will be returned in BSTR. -C------------------------------------------------------------------------- -C - INCLUDE 'PPDREC_4_DEF' -C - CHARACTER*(*) BLANK, COMMA, DELIM - CHARACTER TAB*1, LF*1, CR*1, WHITE*4 - PARAMETER (BLANK = ' ') - PARAMETER (COMMA = ',') - PARAMETER (DELIM = ',;|[]:' ) -C - INTEGER*4 STR_COPY, STR_MATCH_L - INTEGER*4 STR_SKIP_U, STR_SKIP_W, STR_COPY_U - INTEGER*4 MOVE_BLB, MSG_SET -C - CHARACTER LIST*256, OPTION*80 - INTEGER*4 IS, LL, LO, MATCHNR, PTR -C - TAB = CHAR(9) - LF = CHAR(10) - CR = CHAR(13) - WHITE = BLANK//TAB//LF//CR -C -C Get the options list and -C the option in string format -C - LL = 0 - IF (LOPT_L.NE.0) THEN - LL=LOPT_L - LIST=LOPT - ELSEIF (PPDPD$OPOFF.NE.UNDEF_J) THEN - IS = STR_COPY - 1 (PPDPD$DESCR(PPDPD$OPOFF+1:PPDPD$OPOFF+PPDPD$OPLEN),LIST,LL) - ENDIF - IF (LL.EQ.0) GOTO 999 - IS = MOVE_BLB (BSTR,%REF(OPTION),LENG) -C -C Match option with list -C - IS = STR_MATCH_L (OPTION(:LENG),LIST(:LL),MATCHNR) - IF (MATCHNR.EQ.0) GOTO 999 -C -C Abbreviated match -C - only allowed for SHORT=.TRUE. -C - must be unique -C - return the complete option -C - IF (IS.NE.1) THEN - IF (.NOT.SHORT) GOTO 999 - IF (IS.EQ.0) GOTO 998 - OPTION(:LENG) = BLANK - LO = 0 - PTR = 1 - DO I = 1,MATCHNR-1 - IS = STR_SKIP_U (DELIM,LIST(:LL),PTR) -!! IS = STR_SKIP_U (COMMA//';|/[]',LIST(:LL),PTR) - PTR = PTR+1 - ENDDO - IS = STR_SKIP_W (WHITE,LIST(:LL),PTR) - IS = STR_COPY_U (DELIM//WHITE,LIST(:LL),PTR,OPTION,LO) -!! IS = STR_COPY_U (COMMA//WHITE//';|/[]',LIST(:LL),PTR,OPTION,LO) - IS = MOVE_BLB (%REF(OPTION),BSTR,LENG) - ENDIF -C -C - PPD_OPSTR_MATCH = PPD_SUCCESS - RETURN -C - 998 PPD_OPSTR_MATCH = MSG_SET (PPD_OPTNOTUNI,0) - RETURN -C - 999 PPD_OPSTR_MATCH = MSG_SET (PPD_OPTINVAL,0) - RETURN -C - END diff --git a/src/dwarf/ppdparm.for b/src/dwarf/ppdparm.for deleted file mode 100644 index 145ee57c1094d89466222e6c406d1f42e4a69b24..0000000000000000000000000000000000000000 --- a/src/dwarf/ppdparm.for +++ /dev/null @@ -1,219 +0,0 @@ -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ -C.Ident: PPD_PARM -C.Keywords: PPD File, Parameter Descriptions -C.Author: Friso Olnon (NFRA, Dwingeloo) -C.Language: DWARF-Fortran -C.Environment: VAX or Alliant -C.Comments: -C Common variables used: -C INTEGER*4 PPS$PARB ! (r) address of parameter descr area -C INTEGER*4 PPS$PROTB ! (r) address of prototype descr area -C INTEGER*4 PPS$NXTPAR ! (m) address of parameter description -C INTEGER*4 PPS$NXTPROT ! (m) address of prototype description -C BYTE PPDPD_(*) ! (m) prototype/parameter description -C -C.Version: 900415 FMO - recreation -C.Version: 920224 GvD - no optional arguments in MSG anymore -C.Version: 930510 HjV - Change some MOVE_BLI into MOVE_BLJ -C.Version: 940120 CMV - use indirect addressing (A_B) -C------------------------------------------------------------------------- -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - INTEGER*4 FUNCTION PPD_PARM_GET (PDOFF) -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' -C - INTEGER*4 PDOFF ! (i) offset of description -C -C.Purpose: Read the parameter description -C.Returns: Status code (.TRUE. for success, .FALSE. otherwise) -C success PPD_SUCCESS -C info PPD_ENDOFFILE no parameters at all (only for zero PDOFF) -C error PPD_SEQERROR no PPD file open -C.Notes: -C - The address of the description will be saved in PPS$NXTPAR. -C - The description will be read into the common array PPDPD_. -C------------------------------------------------------------------------- -C - INCLUDE 'PPDSTAT_2_DEF' - INCLUDE 'PPDREC_4_DEF' -C - INTEGER*4 MOVE_BLB, MOVE_BLJ, MSG_SET -C - INTEGER*4 IS, NBYTES -C -C - IF (PPS$PARB.EQ.0) GOTO 999 - IF (PPS$PARB.EQ.UNDEF_J) GOTO 998 - PPS$NXTPAR = PPS$PARB+PDOFF - IS = MOVE_BLJ (A_B(PPS$NXTPAR+PPDPD_LENG-A_OB),PPDPD$LENG,1) - NBYTES = PPDPD$LENG - IS = MOVE_BLB (A_B(PPS$NXTPAR+1-A_OB),PPDPD_,NBYTES) -C - PPD_PARM_GET = PPD_SUCCESS - RETURN -C - 998 PPD_PARM_GET = PPD_ENDOFFILE - RETURN -C - 999 PPD_PARM_GET = MSG_SET (PPD_SEQERROR,0) - RETURN - END -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - INTEGER*4 FUNCTION PPD_PARM_NEXT () -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' -C -C -C.Purpose: Read the first or next parameter description -C.Returns: Status code (.TRUE. for success, .FALSE. otherwise) -C success PPD_SUCCESS -C info PPD_ENDOFFILE no more parameters -C error PPD_SEQERROR no PPD file open -C.Notes: -C - The offset of the next description is given in the current -C description (field PPDPD$FORW). -C - The address of the description will be saved in PPS$NXTPAR. -C - The description will be read into the common array PPDPD_. -C------------------------------------------------------------------------- -C - INCLUDE 'PPDSTAT_2_DEF' - INCLUDE 'PPDREC_4_DEF' -C - INTEGER*4 MOVE_BLB, MOVE_BLJ, MSG_SET -C - INTEGER*4 IS, PDOFF, NBYTES -C -C -C Get the offset of the first or next -C description in the mapped PPD file -C - make sure that a PPD file is open -C - make sure that there are parameters -C - IF (PPS$PARB.EQ.0) GOTO 999 - IF (PPS$PARB.EQ.UNDEF_J) GOTO 998 - IF (PPS$NXTPAR.EQ.0) THEN - PDOFF = 0 - ELSE - IS = MOVE_BLJ (A_B(PPS$NXTPAR+PPDPD_FORW-A_OB),PDOFF,1) - IF (PDOFF.EQ.UNDEF_J) GOTO 998 - ENDIF -C -C Read the description -C - PPS$NXTPAR = PPS$PARB+PDOFF - IS = MOVE_BLJ (A_B(PPS$NXTPAR+PPDPD_LENG-A_OB),PPDPD$LENG,1) - NBYTES =PPDPD$LENG - IS = MOVE_BLB (A_B(PPS$NXTPAR+1-A_OB),PPDPD_,NBYTES) -C -C - PPD_PARM_NEXT = PPD_SUCCESS - RETURN -C - 998 PPD_PARM_NEXT = PPD_ENDOFFILE - RETURN -C - 999 PPD_PARM_NEXT = MSG_SET (PPD_SEQERROR,0) - RETURN - END -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - INTEGER*4 FUNCTION PPD_PROTO_GET (PDOFF) -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' -C - INTEGER*4 PDOFF ! (i) offset of description -C -C.Purpose: Read the prototype parameter description -C.Returns: Status code (.TRUE. for success, .FALSE. otherwise) -C success PPD_SUCCESS -C info PPD_ENDOFFILE no prototypes at all (only for zero PDOFF) -C error PPD_SEQERROR no PPD file open -C.Notes: -C - The address of the description will be saved in PPS$NXTPROT. -C - The description will be read into the common array PPDPD_. -C------------------------------------------------------------------------- -C - INCLUDE 'PPDSTAT_2_DEF' - INCLUDE 'PPDREC_4_DEF' -C - INTEGER*4 MOVE_BLB, MOVE_BLJ, MSG_SET -C - INTEGER*4 IS, NBYTES -C -C - IF (PPS$PROTB.EQ.0) GOTO 999 - IF (PPS$PROTB.EQ.UNDEF_J) GOTO 998 - PPS$NXTPROT = PPS$PROTB+PDOFF - IS = MOVE_BLJ (A_B(PPS$NXTPROT+PPDPD_LENG-A_OB),PPDPD$LENG,1) - NBYTES = PPDPD$LENG - IS = MOVE_BLB (A_B(PPS$NXTPROT+1-A_OB),PPDPD_,NBYTES) -C - PPD_PROTO_GET = PPD_SUCCESS - RETURN -C - 998 PPD_PROTO_GET = PPD_ENDOFFILE - RETURN -C - 999 PPD_PROTO_GET = MSG_SET (PPD_SEQERROR,0) - RETURN - END -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - INTEGER*4 FUNCTION PPD_PROTO_NEXT () -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' -C -C -C.Purpose: Read the first or next prototype parameter description -C.Returns: Status code (.TRUE. for success, .FALSE. otherwise) -C success PPD_SUCCESS -C info PPD_ENDOFFILE no more prototype parameters -C error PPD_SEQERROR no PPD file open -C.Notes: -C - The offset of the next description is given in the current -C description (field PPDPD$FORW). -C - The address of the description will be saved in PPS$NXTPROT. -C - The description will be read into the common array PPDPD_. -C------------------------------------------------------------------------- -C - INCLUDE 'PPDSTAT_2_DEF' - INCLUDE 'PPDREC_4_DEF' -C - INTEGER*4 MOVE_BLB, MOVE_BLJ, MSG_SET -C - INTEGER*4 IS, PDOFF, NBYTES -C -C -C Get the offset of the first or next -C description in the mapped PPD file -C - make sure that a PPD file is open -C - make sure that there are prototypes -C - IF (PPS$PROTB.EQ.0) GOTO 999 - IF (PPS$PROTB.EQ.UNDEF_J) GOTO 998 - IF (PPS$NXTPROT.EQ.0) THEN - PDOFF = 0 - ELSE - IS = MOVE_BLJ (A_B(PPS$NXTPROT+PPDPD_FORW-A_OB),PDOFF,1) - IF (PDOFF.EQ.UNDEF_J) GOTO 998 - ENDIF -C -C Read the description -C - PPS$NXTPROT = PPS$PROTB+PDOFF - IS = MOVE_BLJ (A_B(PPS$NXTPROT+PPDPD_LENG-A_OB),PPDPD$LENG,1) - NBYTES = PPDPD$LENG - IS = MOVE_BLB (A_B(PPS$NXTPROT+1-A_OB),PPDPD_,NBYTES) -C -C - PPD_PROTO_NEXT = PPD_SUCCESS - RETURN -C - 998 PPD_PROTO_NEXT = PPD_ENDOFFILE - RETURN -C - 999 PPD_PROTO_NEXT = MSG_SET (PPD_SEQERROR,0) - RETURN - END diff --git a/src/dwarf/ppdprompt.for b/src/dwarf/ppdprompt.for deleted file mode 100644 index f3a46771cf1b8aa16985ddb8ee1952766d3a43e0..0000000000000000000000000000000000000000 --- a/src/dwarf/ppdprompt.for +++ /dev/null @@ -1,130 +0,0 @@ -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ -C.Ident: PPD_PROMPT -C.Keywords: PPD File, Prompt Info -C.Author: Friso Olnon (NFRA, Dwingeloo) -C.Language: DWARF-Fortran -C.Environment: VAX or Alliant -C.Comments: -C.Version: 900415 FMO - recreation -C.Version: 920224 GvD - no optional arguments in MSG anymore -C.Version: 930513 HjV - Change size WORK to 2500 i.s.o. 1600 -C.Version: 930613 HjV - Change size WORK to 5000 i.s.o. 2500 -C.Version: 940829 HjV - Change size WORK from 5000 to 10000 -C 941019 JPH - Change order of prompt components; '|' line control -C Remove useless code -C 950124 JPH - Correct keyword/prompt/options formatting -C -C------------------------------------------------------------------------- -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - INTEGER*4 FUNCTION PPD_PROMPT (PARMSPEC,LEVEL,SWPNAM,PROMPT,LP) -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' -C - CHARACTER*(*) PARMSPEC ! (i) parameter specification - INTEGER*4 LEVEL ! (i) level of prompt info (0, 1 or 2) - LOGICAL*4 SWPNAM ! (i) program's parameter name ? - CHARACTER*(*) PROMPT ! (o) prompt string - INTEGER*4 LP ! (o) its significant length -C -C.Purpose: Compose the prompt string for a program parameter -C.Returns: Status code (.TRUE. for success, .FALSE. otherwise) -C success PPD_SUCCESS -C error PPD_NOCURENTR no current parameter selected -C error PPD_STRTOOSML output string too short -C false status returned by referenced routines -C.Notes: -C The parameter spec has the format: [program[$stream]_][keyword]. -C If the keyword is given, the prompt string for the that parameter -C will be composed. Otherwise, the current parameter will be used. -C------------------------------------------------------------------------- -C -C - INTEGER*4 PPD_STAT_INQ ,PPD_READ_P ,PPD_READ_U - INTEGER*4 PPD_UNAM_GET ,PPD_USTR_GET ,PPD_OPSTR_GET - INTEGER*4 PPD_PRSTR_GET - INTEGER*4 STR_COPY ,STR_SIGLEN ,MSG_SET -C - CHARACTER WORK*256, PROGSTRM*80, KEYWORD*16 - INTEGER*4 LW, LMIN, LSPEC, LPS, LK - INTEGER*4 IS, MAPB, ADDR, HLPB - LOGICAL*4 PROTOTYPE, LF -C -C -C Set up -C - split the parameter spec into -C program$stream and keyword -C - PROMPT = ' ' - LP = 0 - LSPEC = STR_SIGLEN (PARMSPEC) - LPS = INDEX (PARMSPEC(:LSPEC),'_') - IF (LPS.GT.0) PROGSTRM = PARMSPEC(:LPS) - LK = LSPEC-LPS - IF (LK.GT.0) KEYWORD = PARMSPEC(LPS+1:LSPEC) -C -C Get the wanted parameter description -C - IF (LK.GT.0) THEN - IF (SWPNAM) THEN - IS = PPD_READ_P (KEYWORD) - ELSE - IS = PPD_READ_U (KEYWORD) - ENDIF - ELSE - IS = PPD_STAT_INQ (MAPB,ADDR,HLPB) - IF (ADDR.EQ.0) IS = MSG_SET (PPD_NOCURENTR,0) - ENDIF - IF (IAND(IS,1).EQ.0) GOTO 999 -C -C Get the prompt string -C - level 0: user's parameter name -C - level 1: add units and options -C - level 2: add prompt string -C - IS = PPD_UNAM_GET (WORK,LW,LMIN,PROTOTYPE) - IF (IAND(IS,1).EQ.0) GOTO 999 - IF (LPS.GT.0) IS = STR_COPY (PROGSTRM(:LPS),PROMPT,LP) - IF (LW.GT.0) IS = STR_COPY (WORK(:LW),PROMPT,LP) - IF (IS.LT.0) GOTO 998 -C -! IF (LEVEL.GT.0) THEN -! IS = PPD_USTR_GET (WORK,LW) -! IF (IAND(IS,1).EQ.0) GOTO 999 -! IF (LW.GT.0) IS = STR_COPY (' ('//WORK(:LW)// ')',PROMPT,LP) -! IF (IS.LT.0) GOTO 998 -C -! IF (LEVEL.GT.1) THEN - IS = PPD_PRSTR_GET (WORK,LW) - IF (IAND(IS,1).EQ.0) GOTO 999 - LF = (WORK(LW:LW) .EQ.'|') - IF (.NOT.LF) THEN - LW=LW+1 - WORK(LW:LW)=' ' - ENDIF - IF (LW.GT.0) IS = STR_COPY - 1 (' '//WORK(:LW),PROMPT,LP) - IF (IS.LT.0) GOTO 998 -! ENDIF - IS = PPD_OPSTR_GET (WORK,LW) - LF = (WORK(LW:LW) .EQ.'|') - IF (LF) LW= LW-1 - IF (IAND(IS,1).EQ.0) GOTO 999 - IF (LW.GT.0) IS = STR_COPY ('('//WORK(:LW)//')',PROMPT,LP) - IF (LF) THEN - LP = LP +1 - PROMPT(LP:LP) = '|' - ENDIF - IF (IS.LT.0) GOTO 998 -! ENDIF -C -C - 900 PPD_PROMPT = PPD_SUCCESS - RETURN -C - 998 PPD_PROMPT = MSG_SET (PPD_STRTOOSML,0) - RETURN -C - 999 PPD_PROMPT = IS - RETURN - END diff --git a/src/dwarf/ppdprstr.for b/src/dwarf/ppdprstr.for deleted file mode 100644 index 6acf1123b24f798f1d485655f93ba4260c5cb18a..0000000000000000000000000000000000000000 --- a/src/dwarf/ppdprstr.for +++ /dev/null @@ -1,207 +0,0 @@ -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ -C.Ident: PPD_PRSTR -C.Keywords: PPD File, Parameter Prompt String -C.Author: Friso Olnon (NFRA, Dwingeloo) -C.Language: DWARF-Fortran -C.Environment: VAX or Alliant -C.Comments: -C Common variables used: -C CHARACTER*(*) PPDPD$DESCR ! (m) description in string format -C INTEGER*4 PPDPD$LENG ! (m) current sign length of descr -C INTEGER*4 PPDPD$PROFF ! (m) offset of default vals in descr -C INTEGER*4 PPDPD$PRLEN ! (m) length of default vals -C -C.Version: 900415 FMO - recreation -C.Version: 920224 GvD - no optional arguments in MSG anymore -C.Version: 930510 HjV - Change some INTEGER*2 into INTEGER*4 -C.Version: 940120 CMV - Use indirect addressing (A_B) -C 940909 JPH - PPD_PRSTR_LSET: dynamic help texts -C Insert hyphen in front of prompt text -C 940923 JPH - Correct prompt length\ -C 940930 JPH - Correct test for clear (.GT.' ' --> .NE.) -C 941020 JPH - Suppress '- ' if no prompt string -C------------------------------------------------------------------------- -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - INTEGER*4 FUNCTION PPD_PRSTR_PUT (STRING,DO_CHECK) -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' -C - CHARACTER*(*) STRING ! (i) proposed prompt string - LOGICAL*4 DO_CHECK ! (i) check the string ? -C -C.Purpose: Check and store the prompt string for a program parameter -C.Returns: Status code (.TRUE. for success, .FALSE. otherwise) -C success PPD_SUCCESS -C error PPD_PSEARCH no PPD default allowed -C.Notes: -C - The prompt string is stored in the variable-length part of the -C current parameter description. Its offset w.r.t. the start of the -C description and its significant length are stored in the fixed part -C (fields PPDPD$PROFF and PPDPD$PRLEN). -C - If no prompt string is given, the offset is set to UNDEF_J. -C - In case of errors, no messages are stored in the regular message -C buffer. The calling routine (BPD_BUILD) takes care of that. -C------------------------------------------------------------------------- -C - INCLUDE 'PPDREC_4_DEF' -C - INTEGER*4 STR_SIGLEN -C - INTEGER*4 LSTR -C -C - PPDPD$PROFF = UNDEF_J - PPDPD$PRLEN = 0 -C - LSTR = STR_SIGLEN (STRING) - IF (LSTR.GT.0) THEN - PPDPD$PROFF = PPDPD$LENG - PPDPD$PRLEN = LSTR - PPDPD$LENG = PPDPD$LENG+LSTR - IF (PPDPD$LENG.GT.PPDPD__LENGTH*4) GOTO 9999 - PPDPD$DESCR(PPDPD$PROFF+1:PPDPD$LENG) = STRING(:LSTR) - ENDIF -C - PPD_PRSTR_PUT = PPD_SUCCESS - RETURN -C - 9999 PPD_PRSTR_PUT = 4 - CALL WNCTXT(DWLOG,'PPDPD_ overflow: tell DWARF manager') - CALL WNGEX - RETURN - END -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - INTEGER*4 FUNCTION PPD_PRSTR_GET (STRING,LS) -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' -C - CHARACTER*(*) STRING ! (o) prompt string - INTEGER*4 LS ! (o) its significant length -C -C.Purpose: Get the prompt string from the current parameter description -C.Returns: Status code (.TRUE. for success, .FALSE. otherwise) -C success PPD_SUCCESS -C error PPD_STRTOOSML output string too short -C.Notes: -C - If a dynamic prompt string has been set, it is used -CC - If no prompt string is given, a blank string will be returned. -C------------------------------------------------------------------------- -C - INCLUDE 'PPDREC_4_DEF' -C - INTEGER*4 STR_COPY, MSG_SET -C - INTEGER*4 IS - CHARACTER*128 LPR - INTEGER LPR_L - INTEGER PPD_PRSTR_LSET, STR_SIGLEN - DATA LPR_L/0/ -C -C -C Get the string -C - LS = 2 - STRING(1:2) = '- ' - IF (LPR_L.NE.0) THEN - LS=MIN(LPR_L+2,LEN(STRING)-2) - STRING(3:)=LPR - ELSEIF (PPDPD$PROFF.NE.UNDEF_J) THEN - IS = STR_COPY - 1 (PPDPD$DESCR(PPDPD$PROFF+1:PPDPD$PROFF+PPDPD$PRLEN), - 2 STRING(1:),LS) - IF (IS.LT.0) GOTO 999 - ENDIF - IF (LS .EQ.2) LS= 0 -C - PPD_PRSTR_GET = PPD_SUCCESS - RETURN -C - 999 PPD_PRSTR_GET = MSG_SET (PPD_STRTOOSML,0) - RETURN -C -C -C This entry point is used to set dynamic prompt text that will be shown in -C subsequent prompts in lieu of the .PPD prompt text. The text is stored in the -C local buffer LPR -C - ENTRY PPD_PRSTR_LSET (STRING) -C - IF (STRING.NE.' ') THEN - LPR=STRING - LPR_L=STR_SIGLEN(STRING) - ELSE - LPR_L=0 - ENDIF -C - RETURN - END -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - INTEGER*4 FUNCTION PPD_PRSTR_XGET (STRING,LS) -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' -C - CHARACTER*(*) STRING ! (o) prompt string - INTEGER*4 LS ! (o) its significant length -C -C.Purpose: Get the prompt string for the current parameter -C.Returns: Status code (.TRUE. for success, .FALSE. otherwise) -C success PPD_SUCCESS -C error PPD_SEQERROR no PPD file mapped -C error PPD_NOCURENTR no current parameter selected -C error PPD_STRTOOSML output string too short -C.Notes: -C - The string is fetched directly from the mapped PPD file using -C the offset and length given in the current parameter description. -C - Use XGET i.s.o. GET when the variable-length part of the current -C description contains data for another parameter (e.g. the COPY -C parameter in BLDPPD). -C - If no prompt string is given, a blank string will be returned. -C------------------------------------------------------------------------- -C - INCLUDE 'PPDREC_4_DEF' -C - INTEGER*4 PPD_STAT_INQ, MOVE_BLB, MSG_SET -C - INTEGER*4 IS, MAPB, ADDR, HLPB -C -C - STRING = ' ' - LS = 0 -C -C Make sure that the PPD file is mapped -C and that a parameter has been selected -C - IS = PPD_STAT_INQ (MAPB,ADDR,HLPB) - IF (MAPB.EQ.0) THEN - IS = PPD_SEQERROR - GOTO 999 - ELSE IF (ADDR.EQ.0) THEN - IS = PPD_NOCURENTR - GOTO 999 - ENDIF -C -C Get the string -C - IF (PPDPD$PROFF.NE.UNDEF_J) THEN - LS = PPDPD$PRLEN - ADDR = ADDR+PPDPD$PROFF+1 - IF (LS.LE.LEN(STRING)) THEN - IS = MOVE_BLB (A_B(ADDR-A_OB),%REF(STRING),LS) - ELSE - LS = LEN(STRING) - IS = MOVE_BLB (A_B(ADDR-A_OB),%REF(STRING),LS) - IS = PPD_STRTOOSML - GOTO 999 - ENDIF - ENDIF -C - PPD_PRSTR_XGET = PPD_SUCCESS - RETURN -C - 999 PPD_PRSTR_XGET = MSG_SET (IS,0) - RETURN -C - END diff --git a/src/dwarf/ppdread.for b/src/dwarf/ppdread.for deleted file mode 100644 index 37841c6f77fb4d8a2680174bb9345a115f17ff4d..0000000000000000000000000000000000000000 --- a/src/dwarf/ppdread.for +++ /dev/null @@ -1,215 +0,0 @@ -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ -C.Ident: PPD_READ -C.Keywords: PPD File, Read Parameter Decsription -C.Author: Friso Olnon (NFRA, Dwingeloo) -C.Language: DWARF-Fortran -C.Environment: VAX or Alliant -C.Comments: -C.Version: 900415 FMO - recreation -C------------------------------------------------------------------------- -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - INTEGER*4 FUNCTION PPD_READ_P (PNAM) -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' -C - CHARACTER*(*) PNAM ! (i) program's parameter name -C -C.Purpose: Read the description of the specified parameter -C.Returns: Status code (.TRUE. for success, .FALSE. otherwise) -C success PPD_SUCCESS -C info PPD_ENDOFFILE no parameters at all (only for blank PNAM) -C false status codes returned by referenced routines -C.Notes: -C - A blank name indicates the first normal parameter in the index. -C - The address of the description will be saved in PPS$NXTPAR. -C - The description will be read into common array PPDPD_. -C - The index nr of the parameter will be saved in PPS$NRINXPR. -C------------------------------------------------------------------------- -C -C - INTEGER*4 PPD_INDEX_GETP, PPD_PARM_GET -C - INTEGER*4 IS, PDOFF -C -C -C Get the offset of the parameter -C description in the mapped PPD file -C - IS = PPD_INDEX_GETP (PNAM,PDOFF) - IF (IAND(IS,1).EQ.0 .OR. IS.EQ.PPD_ENDOFFILE) GOTO 999 -C -C Read the description into common -C - IS = PPD_PARM_GET (PDOFF) - IF (IAND(IS,1).EQ.0) GOTO 999 -C -C - PPD_READ_P = PPD_SUCCESS - RETURN -C - 999 PPD_READ_P = IS - RETURN - END -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - INTEGER*4 FUNCTION PPD_READ_U (UNAM) -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' -C - CHARACTER*(*) UNAM ! (m) user's parameter name -C -C.Purpose: Read the description of the specified parameter -C.Returns: Status code (.TRUE. for success, .FALSE. otherwise) -C success PPD_SUCCESS -C info PPD_ENDOFFILE no parameters at all (only for blank UNAM) -C false status codes returned by referenced routines -C.Notes: -C - A blank name or a single '$' indicates the first normal or prototype -C parameter in the description list (PIN order). -C - If the name indicates a prototype parameter (starts with '$'), -C PPS$ENTYP = 1 will be set and the address of the description will -C be saved in PPS$NXTPROT. Otherwise, PPS$ENTYP = 0 and the address -C is saved in PPS$NXTPAR. -C - The description will be read into common array PPDPD_. -C - The index pointer PPS$NRINXPR will be set to zero. -C - If an abbreviated name is given, the complete user's name will be -C returned in UNAM. -C------------------------------------------------------------------------- -C -C - INTEGER*4 PPD_STAT_SETT - INTEGER*4 PPD_INDEX_GETU, PPD_PARM_GET, PPD_PROTO_GET - INTEGER*4 STR_SIGLEN -C - INTEGER*4 IS, PDOFF, LNAM - LOGICAL*4 PROTOTYPE -C -C -C Determine the parameter type -C - LNAM = STR_SIGLEN (UNAM) - PROTOTYPE = LNAM.GT.0 .AND. UNAM(1:1).EQ.'$' - IF (PROTOTYPE) LNAM = LNAM-1 -C -C Get the offset of the parameter -C description in the mapped PPD file -C - IF (LNAM.GT.0) THEN - IS = PPD_INDEX_GETU (UNAM,PDOFF) - IF (IAND(IS,1).EQ.0) GOTO 999 - ELSE - PDOFF = 0 - ENDIF -C -C Read the description into common -C and save the parameter type -C - IF (PROTOTYPE) THEN - IS = PPD_PROTO_GET (PDOFF) - ELSE - IS = PPD_PARM_GET (PDOFF) - ENDIF - IF (IAND(IS,1).EQ.0 .OR. IS.EQ.PPD_ENDOFFILE) GOTO 999 - IS = PPD_STAT_SETT (PROTOTYPE) -C -C - PPD_READ_U = PPD_SUCCESS - RETURN -C - 999 PPD_READ_U = IS - RETURN - END -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - INTEGER*4 FUNCTION PPD_READ_PNXT () -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' -C -C -C.Purpose: Read the description of the next parameter in PNAM order -C.Returns: Status code (.TRUE. for success, .FALSE. otherwise) -C success PPD_SUCCESS -C info PPD_ENDOFFILE no more parameters -C false status codes returned by referenced routines -C.Notes: -C - The address of the description will be saved in PPS$NXTPAR. -C - The description will be read into common array PPDPD_. -C - The index pointer PPS$NRINXPR will be updated. -C - PPD_READ_PNXT can be called after a PPD_INIT (the first parameter -C will be selected) or after a PPD_READ_P (the parameter following -C the one in READ_P will be selected). -C------------------------------------------------------------------------- -C -C - INTEGER*4 PPD_INDEX_GETNXT, PPD_PARM_GET -C - INTEGER*4 IS, PDOFF -C -C -C Get the offset of the parameter -C description in the mapped PPD file -C - IS = PPD_INDEX_GETNXT (PDOFF) - IF (IAND(IS,1).EQ.0 .OR. IS.EQ.PPD_ENDOFFILE) GOTO 999 -C -C Read the description into common -C - IS = PPD_PARM_GET (PDOFF) - IF (IAND(IS,1).EQ.0) GOTO 999 -C -C - PPD_READ_PNXT = PPD_SUCCESS - RETURN -C - 999 PPD_READ_PNXT = IS - RETURN - END -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - INTEGER*4 FUNCTION PPD_READ_UNXT () -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' -C -C -C.Purpose: Read the description of the next parameter (in PIN order) -C.Returns: Status code (.TRUE. for success, .FALSE. otherwise) -C success PPD_SUCCESS -C info PPD_ENDOFFILE no more prototype/parameters -C false status codes returned by referenced routines -C.Notes: -C - The address of the description will be saved in PPS$NXTPAR -C for PPS$ENTYP = 0 or in PPS$NXTPROT if PPS$ENTYP = 1. -C - The description will be read into common array PPDPD_ -C - PPD_READ_UNXT can be called after a PPD_INIT (the first parameter -C will be selected) or after a PPD_READ_U (the prototype/parameter -C following the one in READ_U will be selected). -C------------------------------------------------------------------------- -C -C - INTEGER*4 PPD_STAT_INQT, PPD_PARM_NEXT, PPD_PROTO_NEXT -C - INTEGER*4 IS - LOGICAL*4 PROTOTYPE -C -C -C Get parameter type -C - IS = PPD_STAT_INQT (PROTOTYPE) - IF (IAND(IS,1).EQ.0) GOTO 999 -C -C Read the description into common -C - IF (PROTOTYPE) THEN - IS = PPD_PROTO_NEXT () - ELSE - IS = PPD_PARM_NEXT () - ENDIF - IF (IAND(IS,1).EQ.0 .OR. IS.EQ.PPD_ENDOFFILE) GOTO 999 -C - PPD_READ_UNXT = PPD_SUCCESS - RETURN -C - 999 PPD_READ_UNXT = IS - RETURN - END diff --git a/src/dwarf/ppdrec_4.def b/src/dwarf/ppdrec_4.def deleted file mode 100644 index cd6aca5e3e0d0815f55571ccd480eb360340bb6b..0000000000000000000000000000000000000000 --- a/src/dwarf/ppdrec_4.def +++ /dev/null @@ -1,374 +0,0 @@ -C Include module PPDREC_4 -C Created by BLDDEF from: _$1$DIA3:[TESTDWARF.SRC.DEF]PPDREC.DEF; on 17-OCT-90 -C -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ -C.Ident: DEF_PPDREC -C.Keywords: PPD File, Records, Layout -C.Author: Kasper Kombrink (NFRA, Dwingeloo) -C.Language: DWARF-DEF -C.Environment: VAX -C.Comments: -C.Version: 841130 KK - version 3 of PPD.DEF -C.Version: 841213 KK - version 1 of PPDREC.DEF -C.Version: 850627 KK - version 2 -C - Add comments -C - Include layout of index-entries -C - Include minimum number of characters which uniquely -C identifies user parameter name -C.Version: 850901 KK - version 3 -C - add EXTEN into PPDPD -C.Version: 890124 FMO - version 4 -C - new DEF syntax -C - PPDFD_ local array i.s.o. common array -C - extend PPDPD_ to include the variable-length fields -C - removed IN__ and added local PPDID_ for index entry -C - added AMAS_ and CMAS_ from PPD.DEF (now bit nrs) -C.Version: 930510 HjV - Change all INTEGER*2 into INTEGER*4 -C.Version: 010709 AXC - Linux port -byte equivalence removed -C-------------------------------------------------------------------- -C -C -C *** File description block *** -C - INTEGER*4 PPDFD_LENGTH - PARAMETER (PPDFD_LENGTH =1) !&1 !#J !generated: field to contain the block length - INTEGER*4 PPDFD_TYPE - PARAMETER (PPDFD_TYPE =5) !&1 !#J !generated: field to contain the block type - INTEGER*4 PPDFD_INDEX - PARAMETER (PPDFD_INDEX =1) !&1 !#J !pointer to index area - INTEGER*4 PPDFD_PARM - PARAMETER (PPDFD_PARM =5) !&1 !#J !pointer to parameter area - INTEGER*4 PPDFD_HELP - PARAMETER (PPDFD_HELP =9) !&1 !#J !pointer to help area - INTEGER*4 PPDFD_PARMPT - PARAMETER (PPDFD_PARMPT =13) !&1 !#J !pointer to prototype area - INTEGER*4 PPDFD_SINDEX - PARAMETER (PPDFD_SINDEX =17) !&1 !#J !size index area - INTEGER*4 PPDFD_SPARM - PARAMETER (PPDFD_SPARM =21) !&1 !#J !size parameter area - INTEGER*4 PPDFD_SHELP - PARAMETER (PPDFD_SHELP =25) !&1 !#J !size help area - INTEGER*4 PPDFD_SPARMPT - PARAMETER (PPDFD_SPARMPT =29) !&1 !#J !size prototype area - INTEGER*4 PPDFD_STOT - PARAMETER (PPDFD_STOT =33) !&1 !#J !total size ppd file - INTEGER*4 PPDFD_NINDEX - PARAMETER (PPDFD_NINDEX =37) !&1 !#J !number of index entries - INTEGER*4 PPDFD_NPARM - PARAMETER (PPDFD_NPARM =41) !&1 !#J !number of parameter entries - INTEGER*4 PPDFD_NPARMPT - PARAMETER (PPDFD_NPARMPT =45) !&1 !#J !number of prototype entries - INTEGER*4 PPDFD_RESERVED - PARAMETER (PPDFD_RESERVED =49) !&1 !#J !reserved - INTEGER*4 PPDFD_IMAGE - PARAMETER (PPDFD_IMAGE =53) !&16 !#C !program name - INTEGER*4 PPDFD__LENGTH - PARAMETER (PPDFD__LENGTH =17) !generated: block length (in longwords) - INTEGER*4 PPDFD__TYPE - PARAMETER (PPDFD__TYPE =16) !generated: block type -C -C -C *** (Prototype) parameter description entry *** -C - INTEGER*4 PPDPD_LENGTH - PARAMETER (PPDPD_LENGTH =1) !&1 !#J !generated: field to contain the block length - INTEGER*4 PPDPD_TYPE - PARAMETER (PPDPD_TYPE =5) !&1 !#J !generated: field to contain the block type - INTEGER*4 PPDPD_DESCR - PARAMETER (PPDPD_DESCR =1) !&512 !#C !complete description (string overlay) - INTEGER*4 PPDPD_FORW - PARAMETER (PPDPD_FORW =1) !&1 !#J !offset of next entry (w.r.t. start of area) - INTEGER*4 PPDPD_EXTEN - PARAMETER (PPDPD_EXTEN =5) !&1 !#J !offset of extension area (filled at run time) - INTEGER*4 PPDPD_LENG - PARAMETER (PPDPD_LENG =9) !&1 !#J !significant length of the description (bytes) - INTEGER*4 PPDPD_UNAM - PARAMETER (PPDPD_UNAM =13) !&16 !#C !parameter name (user) - INTEGER*4 PPDPD_PNAM - PARAMETER (PPDPD_PNAM =29) !&16 !#C !parameter name (program) - INTEGER*4 PPDPD_LUNAM - PARAMETER (PPDPD_LUNAM =45) !&1 !#J !minimum number of characters for unam - INTEGER*4 PPDPD_DTYPE - PARAMETER (PPDPD_DTYPE =49) !&1 !#C !parameter type - INTEGER*4 PPDPD_IOCD - PARAMETER (PPDPD_IOCD =50) !&1 !#C !code input/output - INTEGER*4 PPDPD_DUMMY - PARAMETER (PPDPD_DUMMY =51) !&1 !#C !DUMMY - INTEGER*4 PPDPD_PLEN - PARAMETER (PPDPD_PLEN =53) !&1 !#J !length of parameter value - INTEGER*4 PPDPD_NVAL - PARAMETER (PPDPD_NVAL =57) !&1 !#J !number of values - INTEGER*4 PPDPD_NSETS - PARAMETER (PPDPD_NSETS =61) !&1 !#J !maximum number of value sets - INTEGER*4 PPDPD_MNVAL - PARAMETER (PPDPD_MNVAL =65) !&1 !#J !minimum number of values - INTEGER*4 PPDPD_MXVAL - PARAMETER (PPDPD_MXVAL =69) !&1 !#J !maximum number of values - INTEGER*4 PPDPD_CMAS - PARAMETER (PPDPD_CMAS =73) !&1 !#J !check mask - INTEGER*4 PPDPD_AMAS - PARAMETER (PPDPD_AMAS =77) !&1 !#J !attribute mask - INTEGER*4 PPDPD_MNOFF - PARAMETER (PPDPD_MNOFF =81) !&1 !#J !offset minimum value(s) (w.r.t. start entry) - INTEGER*4 PPDPD_MNLEN - PARAMETER (PPDPD_MNLEN =85) !&1 !#J !length minimum value(s) - INTEGER*4 PPDPD_MXOFF - PARAMETER (PPDPD_MXOFF =89) !&1 !#J !offset maximum value(s) - INTEGER*4 PPDPD_MXLEN - PARAMETER (PPDPD_MXLEN =93) !&1 !#J !length maximum value(s) - INTEGER*4 PPDPD_UOFF - PARAMETER (PPDPD_UOFF =97) !&1 !#J !offset units string - INTEGER*4 PPDPD_ULEN - PARAMETER (PPDPD_ULEN =101) !&1 !#J !length units string - INTEGER*4 PPDPD_SOFF - PARAMETER (PPDPD_SOFF =105) !&1 !#J !offset search string - INTEGER*4 PPDPD_SLEN - PARAMETER (PPDPD_SLEN =109) !&1 !#J !length search string - INTEGER*4 PPDPD_DVOFF - PARAMETER (PPDPD_DVOFF =113) !&1 !#J !offset default value string - INTEGER*4 PPDPD_DVLEN - PARAMETER (PPDPD_DVLEN =117) !&1 !#J !length default value string - INTEGER*4 PPDPD_OPOFF - PARAMETER (PPDPD_OPOFF =121) !&1 !#J !offset options string - INTEGER*4 PPDPD_OPLEN - PARAMETER (PPDPD_OPLEN =125) !&1 !#J !length options string - INTEGER*4 PPDPD_PROFF - PARAMETER (PPDPD_PROFF =129) !&1 !#J !offset prompt string - INTEGER*4 PPDPD_PRLEN - PARAMETER (PPDPD_PRLEN =133) !&1 !#J !length prompt string - INTEGER*4 PPDPD_GOFF - PARAMETER (PPDPD_GOFF =137) !&1 !#J !offset ppd name for global search - INTEGER*4 PPDPD_GLEN - PARAMETER (PPDPD_GLEN =141) !&1 !#J !length ppd name for global search - INTEGER*4 PPDPD_HOFF - PARAMETER (PPDPD_HOFF =145) !&1 !#J !offset help string (w.r.t. start help area) - INTEGER*4 PPDPD_HLEN - PARAMETER (PPDPD_HLEN =149) !&1 !#J !length of help string - INTEGER*4 PPDPD__LENGTH - PARAMETER (PPDPD__LENGTH =128) !generated: block length (in longwords) - INTEGER*4 PPDPD__TYPE - PARAMETER (PPDPD__TYPE =17) !generated: block type -C -C -C *** Index entry *** -C - INTEGER*4 PPDID_LENGTH - PARAMETER (PPDID_LENGTH =1) !&1 !#J !generated: field to contain the block length - INTEGER*4 PPDID_TYPE - PARAMETER (PPDID_TYPE =2) !&1 !#J !generated: field to contain the block type - INTEGER*4 PPDID_PNAM - PARAMETER (PPDID_PNAM =1) !&16 !#C !parameter name (program) - INTEGER*4 PPDID_UNAM - PARAMETER (PPDID_UNAM =5) !&16 !#C !parameter name (user) - INTEGER*4 PPDID_LUNAM - PARAMETER (PPDID_LUNAM =9) !&1 !#J !minimum number of characters for unam - INTEGER*4 PPDID_PARMOFF - PARAMETER (PPDID_PARMOFF =10) !&1 !#J !offset of parm descr (w.r.t. start of area) - INTEGER*4 PPDID__LENGTH - PARAMETER (PPDID__LENGTH =10) !generated: block length (in longwords) - INTEGER*4 PPDID__TYPE - PARAMETER (PPDID__TYPE =33) !generated: block type -C -C -C *** Check-mask bits (CMAS) *** -C -C - INTEGER*4 CMAS_MIN - PARAMETER (CMAS_MIN =0) !minimum - INTEGER*4 CMAS_MAX - PARAMETER (CMAS_MAX =1) !maximum - INTEGER*4 CMAS_ASC - PARAMETER (CMAS_ASC =2) !ascending order - INTEGER*4 CMAS_DES - PARAMETER (CMAS_DES =3) !descending order - INTEGER*4 CMAS_ALP - PARAMETER (CMAS_ALP =4) !alphabetic - INTEGER*4 CMAS_NUM - PARAMETER (CMAS_NUM =5) !numeric - INTEGER*4 CMAS_ANM - PARAMETER (CMAS_ANM =6) !alphanumeric - INTEGER*4 CMAS_OPT - PARAMETER (CMAS_OPT =7) !options - INTEGER*4 CMAS_OPS - PARAMETER (CMAS_OPS =8) !abbreviated optons - INTEGER*4 CMAS_NOD - PARAMETER (CMAS_NOD =9) !node name - INTEGER*4 CMAS_NAS - PARAMETER (CMAS_NAS =10) !non-ascending - INTEGER*4 CMAS_NDE - PARAMETER (CMAS_NDE =11) !non-descending -C -C -C *** Attribute-mask bits (AMAS) *** -C - INTEGER*4 AMAS_LOP - PARAMETER (AMAS_LOP =0) !used for controlling program loops - INTEGER*4 AMAS_VEC - PARAMETER (AMAS_VEC =1) !vector-type value set - INTEGER*4 AMAS_WLD - PARAMETER (AMAS_WLD =2) !wild-card values allowed - INTEGER*4 AMAS_IMM - PARAMETER (AMAS_IMM =3) !immediate symbol substitutions - INTEGER*4 AMAS_ASK - PARAMETER (AMAS_ASK =4) !always ask user for values - INTEGER*4 AMAS_UND - PARAMETER (AMAS_UND =5) !undefined values allowed - INTEGER*4 AMAS_TST - PARAMETER (AMAS_TST =6) !test - INTEGER*4 AMAS_PUT - PARAMETER (AMAS_PUT =7) !PUT_PARM may create a GLOBAL$0 symbol - INTEGER*4 AMAS_DYN - PARAMETER (AMAS_DYN =8) !GET_PARM must get default from DCL symbol - INTEGER*4 AMAS_NUL - PARAMETER (AMAS_NUL =9) !null value allowed - INTEGER*4 AMAS_NND - PARAMETER (AMAS_NND =10) !node "0" allowed - INTEGER*4 PPDREC__DEFTYP - PARAMETER (PPDREC__DEFTYP=19) - INTEGER*4 PPDREC__DEFVSN - PARAMETER (PPDREC__DEFVSN=4) -C - EXTERNAL PPDREC_BLOCK -C -C Local block specification -C - INTEGER*4 PPDFD$LENGTH - EQUIVALENCE (PPDFD$LENGTH,PPDFD__(0)) - INTEGER*4 PPDFD$TYPE - EQUIVALENCE (PPDFD$TYPE,PPDFD__(4)) - INTEGER*4 PPDFD$INDEX - EQUIVALENCE (PPDFD$INDEX,PPDFD__(0)) - INTEGER*4 PPDFD$PARM - EQUIVALENCE (PPDFD$PARM,PPDFD__(4)) - INTEGER*4 PPDFD$HELP - EQUIVALENCE (PPDFD$HELP,PPDFD__(8)) - INTEGER*4 PPDFD$PARMPT - EQUIVALENCE (PPDFD$PARMPT,PPDFD__(12)) - INTEGER*4 PPDFD$SINDEX - EQUIVALENCE (PPDFD$SINDEX,PPDFD__(16)) - INTEGER*4 PPDFD$SPARM - EQUIVALENCE (PPDFD$SPARM,PPDFD__(20)) - INTEGER*4 PPDFD$SHELP - EQUIVALENCE (PPDFD$SHELP,PPDFD__(24)) - INTEGER*4 PPDFD$SPARMPT - EQUIVALENCE (PPDFD$SPARMPT,PPDFD__(28)) - INTEGER*4 PPDFD$STOT - EQUIVALENCE (PPDFD$STOT,PPDFD__(32)) - INTEGER*4 PPDFD$NINDEX - EQUIVALENCE (PPDFD$NINDEX,PPDFD__(36)) - INTEGER*4 PPDFD$NPARM - EQUIVALENCE (PPDFD$NPARM,PPDFD__(40)) - INTEGER*4 PPDFD$NPARMPT - EQUIVALENCE (PPDFD$NPARMPT,PPDFD__(44)) - INTEGER*4 PPDFD$RESERVED - EQUIVALENCE (PPDFD$RESERVED,PPDFD__(48)) - CHARACTER*16 PPDFD$IMAGE - EQUIVALENCE (PPDFD$IMAGE,PPDFD__(52)) - BYTE PPDFD__(0:67) - BYTE PPDFD_(68) - EQUIVALENCE (PPDFD_,PPDFD__) -C -C Common block specification -C - INTEGER*4 PPDPD$LENGTH - EQUIVALENCE (PPDPD$LENGTH,PPDPD__(0)) - INTEGER*4 PPDPD$TYPE - EQUIVALENCE (PPDPD$TYPE,PPDPD__(4)) - CHARACTER*512 PPDPD$DESCR - EQUIVALENCE (PPDPD$DESCR,PPDPD__(0)) - INTEGER*4 PPDPD$FORW - EQUIVALENCE (PPDPD$FORW,PPDPD__(0)) - INTEGER*4 PPDPD$EXTEN - EQUIVALENCE (PPDPD$EXTEN,PPDPD__(4)) - INTEGER*4 PPDPD$LENG - EQUIVALENCE (PPDPD$LENG,PPDPD__(8)) - CHARACTER*16 PPDPD$UNAM - EQUIVALENCE (PPDPD$UNAM,PPDPD__(12)) - CHARACTER*16 PPDPD$PNAM - EQUIVALENCE (PPDPD$PNAM,PPDPD__(28)) - INTEGER*4 PPDPD$LUNAM - EQUIVALENCE (PPDPD$LUNAM,PPDPD__(44)) - CHARACTER*1 PPDPD$DTYPE - EQUIVALENCE (PPDPD$DTYPE,PPDPD__(48)) - CHARACTER*1 PPDPD$IOCD - EQUIVALENCE (PPDPD$IOCD,PPDPD__(49)) - CHARACTER*2 PPDPD$DUMMY - EQUIVALENCE (PPDPD$DUMMY,PPDPD__(50)) - INTEGER*4 PPDPD$PLEN - EQUIVALENCE (PPDPD$PLEN,PPDPD__(52)) - INTEGER*4 PPDPD$NVAL - EQUIVALENCE (PPDPD$NVAL,PPDPD__(56)) - INTEGER*4 PPDPD$NSETS - EQUIVALENCE (PPDPD$NSETS,PPDPD__(60)) - INTEGER*4 PPDPD$MNVAL - EQUIVALENCE (PPDPD$MNVAL,PPDPD__(64)) - INTEGER*4 PPDPD$MXVAL - EQUIVALENCE (PPDPD$MXVAL,PPDPD__(68)) - INTEGER*4 PPDPD$CMAS - EQUIVALENCE (PPDPD$CMAS,PPDPD__(72)) - INTEGER*4 PPDPD$AMAS - EQUIVALENCE (PPDPD$AMAS,PPDPD__(76)) - INTEGER*4 PPDPD$MNOFF - EQUIVALENCE (PPDPD$MNOFF,PPDPD__(80)) - INTEGER*4 PPDPD$MNLEN - EQUIVALENCE (PPDPD$MNLEN,PPDPD__(84)) - INTEGER*4 PPDPD$MXOFF - EQUIVALENCE (PPDPD$MXOFF,PPDPD__(88)) - INTEGER*4 PPDPD$MXLEN - EQUIVALENCE (PPDPD$MXLEN,PPDPD__(92)) - INTEGER*4 PPDPD$UOFF - EQUIVALENCE (PPDPD$UOFF,PPDPD__(96)) - INTEGER*4 PPDPD$ULEN - EQUIVALENCE (PPDPD$ULEN,PPDPD__(100)) - INTEGER*4 PPDPD$SOFF - EQUIVALENCE (PPDPD$SOFF,PPDPD__(104)) - INTEGER*4 PPDPD$SLEN - EQUIVALENCE (PPDPD$SLEN,PPDPD__(108)) - INTEGER*4 PPDPD$DVOFF - EQUIVALENCE (PPDPD$DVOFF,PPDPD__(112)) - INTEGER*4 PPDPD$DVLEN - EQUIVALENCE (PPDPD$DVLEN,PPDPD__(116)) - INTEGER*4 PPDPD$OPOFF - EQUIVALENCE (PPDPD$OPOFF,PPDPD__(120)) - INTEGER*4 PPDPD$OPLEN - EQUIVALENCE (PPDPD$OPLEN,PPDPD__(124)) - INTEGER*4 PPDPD$PROFF - EQUIVALENCE (PPDPD$PROFF,PPDPD__(128)) - INTEGER*4 PPDPD$PRLEN - EQUIVALENCE (PPDPD$PRLEN,PPDPD__(132)) - INTEGER*4 PPDPD$GOFF - EQUIVALENCE (PPDPD$GOFF,PPDPD__(136)) - INTEGER*4 PPDPD$GLEN - EQUIVALENCE (PPDPD$GLEN,PPDPD__(140)) - INTEGER*4 PPDPD$HOFF - EQUIVALENCE (PPDPD$HOFF,PPDPD__(144)) - INTEGER*4 PPDPD$HLEN - EQUIVALENCE (PPDPD$HLEN,PPDPD__(148)) - BYTE PPDPD$TRAILER(360) - EQUIVALENCE (PPDPD$TRAILER,PPDPD__(152)) - BYTE PPDPD__(0:511) - BYTE PPDPD_(512) - EQUIVALENCE (PPDPD_,PPDPD__) -C - COMMON /PPDPD/ PPDPD_ -C -C -C Local block specification -C - INTEGER*4 PPDID$LENGTH - EQUIVALENCE (PPDID$LENGTH,PPDID__(0)) - INTEGER*4 PPDID$TYPE - EQUIVALENCE (PPDID$TYPE,PPDID__(4)) - CHARACTER*16 PPDID$PNAM - EQUIVALENCE (PPDID$PNAM,PPDID__(0)) - CHARACTER*16 PPDID$UNAM - EQUIVALENCE (PPDID$UNAM,PPDID__(16)) - INTEGER*4 PPDID$LUNAM - EQUIVALENCE (PPDID$LUNAM,PPDID__(32)) - INTEGER*4 PPDID$PARMOFF - EQUIVALENCE (PPDID$PARMOFF,PPDID__(36)) - BYTE PPDID__(0:39) - INTEGER*4 PPDID_(10) - EQUIVALENCE (PPDID_,PPDID__) - - diff --git a/src/dwarf/ppdrecblock.for b/src/dwarf/ppdrecblock.for deleted file mode 100644 index d2b2e40f21f32c55c82b6f20ce7f5ee9d4815e93..0000000000000000000000000000000000000000 --- a/src/dwarf/ppdrecblock.for +++ /dev/null @@ -1,61 +0,0 @@ - BLOCK DATA PPDREC_BLOCK -C Created by BLDDEF from: _$1$DIA3:[TESTDWARF.SRC.DEF]PPDREC.DEF; on 17-OCT-90 -C HjV 921208 Removed all equivalence and add names to common block -C HjV 930510 Change all INTEGER*2 into INTEGER*4 -C AXC 010709 Linux port - PPDPD$TRAILOR -C -C - INTEGER*4 PPDPD$LENGTH - INTEGER*4 PPDPD$TYPE - CHARACTER*512 PPDPD$DESCR - INTEGER*4 PPDPD$FORW - INTEGER*4 PPDPD$EXTEN - INTEGER*4 PPDPD$LENG - CHARACTER*16 PPDPD$UNAM - CHARACTER*16 PPDPD$PNAM - INTEGER*4 PPDPD$LUNAM - CHARACTER*1 PPDPD$DTYPE - CHARACTER*1 PPDPD$IOCD - CHARACTER*2 PPDPD$DUMMY - INTEGER*4 PPDPD$PLEN - INTEGER*4 PPDPD$NVAL - INTEGER*4 PPDPD$NSETS - INTEGER*4 PPDPD$MNVAL - INTEGER*4 PPDPD$MXVAL - INTEGER*4 PPDPD$CMAS - INTEGER*4 PPDPD$AMAS - INTEGER*4 PPDPD$MNOFF - INTEGER*4 PPDPD$MNLEN - INTEGER*4 PPDPD$MXOFF - INTEGER*4 PPDPD$MXLEN - INTEGER*4 PPDPD$UOFF - INTEGER*4 PPDPD$ULEN - INTEGER*4 PPDPD$SOFF - INTEGER*4 PPDPD$SLEN - INTEGER*4 PPDPD$DVOFF - INTEGER*4 PPDPD$DVLEN - INTEGER*4 PPDPD$OPOFF - INTEGER*4 PPDPD$OPLEN - INTEGER*4 PPDPD$PROFF - INTEGER*4 PPDPD$PRLEN - INTEGER*4 PPDPD$GOFF - INTEGER*4 PPDPD$GLEN - INTEGER*4 PPDPD$HOFF - INTEGER*4 PPDPD$HLEN - BYTE PPDPD$TRAILER(360) -C - COMMON /PPDPD/ PPDPD$FORW, PPDPD$EXTEN, PPDPD$LENG, PPDPD$UNAM, - * PPDPD$PNAM, PPDPD$LUNAM, PPDPD$DTYPE, PPDPD$IOCD, - * PPDPD$DUMMY, PPDPD$PLEN, PPDPD$NVAL, PPDPD$NSETS, - * PPDPD$MNVAL, PPDPD$MXVAL, PPDPD$CMAS, PPDPD$AMAS, - * PPDPD$MNOFF, PPDPD$MNLEN, PPDPD$MXOFF, PPDPD$MXLEN, - * PPDPD$UOFF, PPDPD$ULEN, PPDPD$SOFF, PPDPD$SLEN, - * PPDPD$DVOFF, PPDPD$DVLEN, PPDPD$OPOFF, PPDPD$OPLEN, - * PPDPD$PROFF, PPDPD$PRLEN, PPDPD$GOFF, PPDPD$GLEN, - * PPDPD$HOFF, PPDPD$HLEN, PPDPD$TRAILER -C - DATA PPDPD$FORW/0/ !Required by g77 - DATA PPDPD$HLEN/0/ -C - END -C diff --git a/src/dwarf/ppdsstr.for b/src/dwarf/ppdsstr.for deleted file mode 100644 index b67cf54e6a5a41def3b69888c4804dfcfc4ca34c..0000000000000000000000000000000000000000 --- a/src/dwarf/ppdsstr.for +++ /dev/null @@ -1,363 +0,0 @@ -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ -C.Ident: PPD_SSTR -C.Keywords: PPD File, Parameter Search Strategy -C.Author: Friso Olnon (NFRA, Dwingeloo) -C.Language: DWARF-Fortran -C.Environment: VAX or Alliant -C.Comments: -C Common variables used: -C CHARACTER*(*) PPDPD$DESCR ! (m) description in string format -C INTEGER*4 PPDPD$LENG ! (m) current sign length of descr -C INTEGER*4 PPDPD$SOFF ! (m) offset of search-strategy string -C INTEGER*4 PPDPD$SLEN ! (m) its signif length -C INTEGER*4 PPDPD$GOFF ! (m) offset of group name -C INTEGER*4 PPDPD$GLEN ! (m) its signif length -C -C.Version: 900415 FMO - recreation -C.Version: 920224 GvD - no optional arguments in MSG anymore -C.Version: 930510 HjV - Change some INTEGER*2 into INTEGER*4 -C.Version: 940120 CMV - Use indirect addressing (A_B) -C------------------------------------------------------------------------- -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - INTEGER*4 FUNCTION PPD_SSTR_PUT (STRING,GROUP,DO_CHECK) -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' -C - CHARACTER*(*) STRING ! (i) proposed search strategy - CHARACTER*(*) GROUP ! (i) group name - LOGICAL*4 DO_CHECK ! (i) check the string ? -C -C.Purpose: Check and store the search strategy for a program parameter -C.Returns: Status code (.TRUE. for success, .FALSE. otherwise) -C success PPD_SUCCESS -C error PPD_SEARCHINV invalid search list -C error PPD_GLOFILNF group PPD file not found -C.Notes: -C - The search strategy and group name are stored in the variable-length -C part of the current parameter description. The offsets of the strings -C w.r.t. the start of the description and their significant lengths are -C stored in the fixed part (fields PPDPD$UOFF, PPDPD$ULEN, PPDPD$GOFF -C and PPDPD$GLEN). -C - If a string is not given, the offset is set to UNDEF_J. -C - In case of errors, no messages are stored in the regular message -C buffer. The calling routine (BPD_BUILD) takes care of that. -C------------------------------------------------------------------------- -C - INCLUDE 'PPDREC_4_DEF' -C - CHARACTER*(*) EMPTVAL, DEFSSTR, DEFGSTR - PARAMETER (EMPTVAL = '[]' ) - PARAMETER (DEFSSTR = 'L,P' ) - PARAMETER (DEFGSTR = ' ' ) -C - INTEGER*4 PPD_SSTR_SPLIT, PPD_FILE_FIND - INTEGER*4 STR_SIGLEN -C - CHARACTER SSTR*5, GSTR*32, FULLSPEC*64 - INTEGER*4 IS, LS, LG, LF -C -C - PPDPD$SOFF = UNDEF_J - PPDPD$SLEN = 0 - PPDPD$GOFF = UNDEF_J - PPDPD$GLEN = 0 -C -C Split and check input string -C - IF (DO_CHECK) THEN - LS = STR_SIGLEN (STRING) - IF (LS.EQ.0 .OR. STRING(:LS).EQ.EMPTVAL) THEN - SSTR = DEFSSTR - GSTR = DEFGSTR - LS = STR_SIGLEN (SSTR) - LG = STR_SIGLEN (GSTR) - ELSE - IS = PPD_SSTR_SPLIT (STRING(:LS),SSTR,LS,GSTR,LG) - IF (IAND(IS,1).EQ.0) GOTO 999 - ENDIF - ELSE - SSTR = STRING - GSTR = GROUP - LS = STR_SIGLEN (SSTR) - LG = STR_SIGLEN (GSTR) - ENDIF -C -C Check and store group name -C - file <group>.PPD must exist -C - IF (LG.GT.0) THEN - IS = PPD_FILE_FIND (GSTR(:LG),FULLSPEC,LF) - IF (IAND(IS,1).EQ.0) THEN - IS = PPD_GLOFILNF - GOTO 999 - ENDIF - PPDPD$GOFF = PPDPD$LENG - PPDPD$GLEN = LG - PPDPD$LENG = PPDPD$LENG+LG - IF (PPDPD$LENG.GT.PPDPD__LENGTH*4) GOTO 9999 - PPDPD$DESCR(PPDPD$GOFF+1:PPDPD$LENG) = GSTR(:LG) - ENDIF -C -C Store the search strategy -C - IF (LS.GT.0) THEN - PPDPD$SOFF = PPDPD$LENG - PPDPD$SLEN = LS - PPDPD$LENG = PPDPD$LENG+LS - IF (PPDPD$LENG.GT.PPDPD__LENGTH*4) GOTO 9999 - PPDPD$DESCR(PPDPD$SOFF+1:PPDPD$LENG) = SSTR(:LS) - ENDIF -C - PPD_SSTR_PUT = PPD_SUCCESS - RETURN -C - 999 PPD_SSTR_PUT = IS - RETURN -C - 9999 PPD_SSTR_PUT = 4 - CALL WNCTXT(DWLOG,'PPDPD_ overflow: tell DWARF manager') - CALL WNGEX - RETURN - END -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - INTEGER*4 FUNCTION PPD_SSTR_GET (SSTR,LS,GROUP,LG) -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' -C - CHARACTER*(*) SSTR ! (o) search strategy - INTEGER*4 LS ! (o) its significant length - CHARACTER*(*) GROUP ! (o) group name for global search - INTEGER*4 LG ! (o) its significant length -C -C.Purpose: Get the search strategy from the current parameter description -C.Returns: Status code (.TRUE. for success, .FALSE. otherwise) -C success PPD_SUCCESS -C error PPD_STRTOOSML output string too short -C.Notes: -C - If no search strategy is given, a blank string will be returned. -C------------------------------------------------------------------------- -C - INCLUDE 'PPDREC_4_DEF' -C - INTEGER*4 STR_COPY, MSG_SET -C - INTEGER*4 IS -C -C - SSTR = ' ' - LS = 0 - GROUP = ' ' - LG = 0 -C -C Get the search strategy -C - IF (PPDPD$SOFF.NE.UNDEF_J) THEN - IS = STR_COPY - 1 (PPDPD$DESCR(PPDPD$SOFF+1:PPDPD$SOFF+PPDPD$SLEN), - 2 SSTR,LS) - IF (IS.LT.0) GOTO 999 - ENDIF -C -C Get the group name -C - IF (PPDPD$GOFF.NE.UNDEF_J) THEN - IS = STR_COPY - 1 (PPDPD$DESCR(PPDPD$GOFF+1:PPDPD$GOFF+PPDPD$GLEN), - 2 GROUP,LG) - IF (IS.LT.0) GOTO 999 - ENDIF -C - PPD_SSTR_GET = PPD_SUCCESS - RETURN -C - 999 PPD_SSTR_GET = MSG_SET (PPD_STRTOOSML,0) - RETURN - END -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - INTEGER*4 FUNCTION PPD_SSTR_XGET (SSTR,LS,GROUP,LG) -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' -C - CHARACTER*(*) SSTR ! (o) search strategy - INTEGER*4 LS ! (o) its significant length - CHARACTER*(*) GROUP ! (o) group name for global search - INTEGER*4 LG ! (o) its significant length -C -C.Purpose: Get the search strategy for the current parameter -C.Returns: Status code (.TRUE. for success, .FALSE. otherwise) -C success PPD_SUCCESS -C error PPD_SEQERROR no PPD file mapped -C error PPD_NOCURENTR no current parameter selected -C error PPD_STRTOOSML output string too short -C.Notes: -C - The strings are fetched directly from the mapped PPD file using -C the offsets and lengths given in the current parameter description. -C - Use XGET i.s.o. GET when the variable-length part of the current -C description contains data for another parameter (e.g. the COPY -C parameter in BLDPPD). -C - If no search strategy is given, a blank string will be returned. -C------------------------------------------------------------------------- -C - INCLUDE 'PPDREC_4_DEF' -C - INTEGER*4 PPD_STAT_INQ, MOVE_BLB, MSG_SET -C - INTEGER*4 IS, MAPB, ADDR, HLPB -C -C - SSTR = ' ' - LS = 0 - GROUP = ' ' - LG = 0 -C -C Make sure that the PPD file is mapped -C and that a parameter has been selected -C - IS = PPD_STAT_INQ (MAPB,ADDR,HLPB) - IF (MAPB.EQ.0) THEN - IS = PPD_SEQERROR - GOTO 999 - ELSE IF (ADDR.EQ.0) THEN - IS = PPD_NOCURENTR - GOTO 999 - ENDIF -C -C Get the search strategy -C - IF (PPDPD$SOFF.NE.UNDEF_J) THEN - LS = PPDPD$SLEN - IF (LS.LE.LEN(SSTR)) THEN - IS = MOVE_BLB (A_B(ADDR+PPDPD$SOFF+1-A_OB), - 1 %REF(SSTR),LS) - ELSE - LS = LEN(SSTR) - IS = MOVE_BLB (A_B(ADDR+PPDPD$SOFF+1-A_OB), - 1 %REF(SSTR),LS) - IS = PPD_STRTOOSML - GOTO 999 - ENDIF - ENDIF -C -C Get the group name -C - IF (PPDPD$GOFF.NE.UNDEF_J) THEN - LG = PPDPD$GLEN - IF (LG.LE.LEN(GROUP)) THEN - IS = MOVE_BLB (A_B(ADDR+PPDPD$GOFF+1-A_OB), - 1 %REF(GROUP),LG) - ELSE - LG = LEN(GROUP) - IS = MOVE_BLB (A_B(ADDR+PPDPD$GOFF+1-A_OB), - 1 %REF(GROUP),LG) - IS = PPD_STRTOOSML - GOTO 999 - ENDIF - ENDIF -C - PPD_SSTR_XGET = PPD_SUCCESS - RETURN -C - 999 PPD_SSTR_XGET = MSG_SET (IS,0) - RETURN - END -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - INTEGER*4 FUNCTION PPD_SSTR_SPLIT (LIST,SSTR,LS,GSTR,LG) -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' -C - CHARACTER*(*) LIST ! (i) proposed search list - CHARACTER*(*) SSTR ! (o) search strategy - INTEGER*4 LS ! (o) signif length of search strategy - CHARACTER*(*) GSTR ! (o) group name - INTEGER*4 LG ! (o) signif length of group name -C -C.Purpose: Split the search list -C.Returns: Status code (.TRUE. for success, .FALSE. otherwise) -C success PPD_SUCCESS -C error PPD_SEARCHINV invalid search list -C.Notes: -C - In case of errors, no messages are stored in the regular message -C buffer. The calling routine (PPD_SSTR_PUT) takes care of that. -C------------------------------------------------------------------------- -C -C - CHARACTER*(*) COLON, COMMA - INTEGER*4 NCODE - PARAMETER (COLON = ':') - PARAMETER (COMMA = ',') - PARAMETER (NCODE = 3 ) - CHARACTER*7 CODE(NCODE) - DATA CODE /'LOCAL','GLOBAL','PROGRAM' / -C - INTEGER*4 STR_SIGLEN, STR_MATCH_A, STR_COPY_U, STR_COPY -C - CHARACTER*16 FIELD - INTEGER*4 LL, LF - INTEGER*4 IS, PTR, NR, LASTNR - LOGICAL*4 GROUP_FLAG -C -C - GSTR = ' ' - SSTR = ' ' - LG = 0 - LS = 0 - LL = STR_SIGLEN (LIST) - PTR = 1 - LASTNR = 0 -C -C Extract the next search-list field -C - DO WHILE (PTR.LE.LL) - LF = 0 - IS = STR_COPY_U (COMMA//COLON,LIST(:LL),PTR,FIELD,LF) - GROUP_FLAG = PTR.LE.LL .AND. LIST(PTR:PTR).EQ.COLON -C -C Check and abbreviate -C - IS = STR_MATCH_A (FIELD(:LF),NCODE,CODE,NR) - IF (NR.LE.LASTNR) GOTO 999 - LASTNR = NR - FIELD = CODE(NR)(1:1) -C -C If GLOBAL search: -C - extract the group name if given -C or use default name 'GLOBAL' -C - IF (FIELD(1:1).EQ.'G') THEN - IF (GROUP_FLAG) THEN - LG = 0 - PTR = PTR+1 - IS = STR_COPY_U (COMMA,LIST(:LL),PTR,GSTR,LG) - ELSE - GSTR = 'GLOBAL' - LG = 6 - ENDIF -C -C Otherwise: no group name allowed -C - ELSE - IF (GROUP_FLAG) GOTO 999 - ENDIF -C -C Add search code (first character) -C to the search strategy -C - IF (LS.GT.0) THEN - IS = STR_COPY (COMMA//FIELD(1:1),SSTR,LS) - ELSE - IS = STR_COPY (FIELD(1:1),SSTR,LS) - ENDIF - PTR = PTR+1 - ENDDO -C -C - PPD_SSTR_SPLIT = PPD_SUCCESS - RETURN -C - 999 PPD_SSTR_SPLIT = PPD_SEARCHINV - RETURN - END diff --git a/src/dwarf/ppdstat.for b/src/dwarf/ppdstat.for deleted file mode 100644 index 6d88e4ff1eedf784248ecae08b12a95abe954f61..0000000000000000000000000000000000000000 --- a/src/dwarf/ppdstat.for +++ /dev/null @@ -1,220 +0,0 @@ -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ -C.Ident: PPD_STAT -C.Keywords: PPD File, Status Array -C.Author: Friso Olnon (NFRA, Dwingeloo) -C.Language: DWARF-Fortran -C.Environment: VAX or Alliant -C.Comments: -C Common variables used: -C INTEGER*4 PPS_(*) ! (m) status array of mapped PPD file -C -C.Version: 900415 FMO - recreation -C.Version: 920224 GvD - no optional arguments in MSG anymore -C.Version: 940120 CMV - use indirect addressing -C------------------------------------------------------------------------- -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - INTEGER*4 FUNCTION PPD_STAT_CLEAR () -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' -C -C -C.Purpose: Clear the status array of the mapped PPD file -C.Returns: Status code (.TRUE. for success, .FALSE. otherwise) -C success PPD_SUCCESS -C.Notes: -C------------------------------------------------------------------------- -C - INCLUDE 'PPDSTAT_2_DEF' -C - INTEGER*4 CLEAR_BLJ -C - INTEGER*4 IS -C -C - IS = CLEAR_BLJ (PPS_,PPS__LENGTH) -C - PPD_STAT_CLEAR = PPD_SUCCESS - RETURN - END -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - INTEGER*4 FUNCTION PPD_STAT_FILL () -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' -C -C -C.Purpose: Fill the status array of the mapped PPD file -C.Returns: Status code (.TRUE. for success, .FALSE. otherwise) -C success PPD_SUCCESS -C.Notes: -C - The fixed part of the status array is filled with information -C from the file-description block (first record of the PPD file). -C - The variable part is initialized. -C------------------------------------------------------------------------- -C - INCLUDE 'PPDSTAT_2_DEF' - INCLUDE 'PPDREC_4_DEF' -C - INTEGER*4 MOVE_BLJ -C - INTEGER*4 IS -C -C -C Copy the file description block -C into the local array PPDFD_ -C - IS = MOVE_BLJ (A_B(PPS$MAPB-A_OB),PPDFD_,PPDFD__LENGTH) -C -C Complete the fixed part of PPS_ -C - PPS$INXB = UNDEF_J - IF (PPDFD$INDEX.NE.UNDEF_J) PPS$INXB = PPS$MAPB+PPDFD$INDEX-1 - PPS$PARB = UNDEF_J - IF (PPDFD$PARM.NE.UNDEF_J) PPS$PARB = PPS$MAPB+PPDFD$PARM-1 - PPS$HLPB = UNDEF_J - IF (PPDFD$HELP.NE.UNDEF_J) PPS$HLPB = PPS$MAPB+PPDFD$HELP-1 - PPS$PROTB = UNDEF_J - IF (PPDFD$PARMPT.NE.UNDEF_J) PPS$PROTB = PPS$MAPB+PPDFD$PARMPT-1 - PPS$NRINX = PPDFD$NINDEX -C -C Initialize the variable part of PPS_ -C - PPS$NXTPAR = 0 - PPS$NXTPROT = 0 - PPS$ENTYP = 0 - PPS$NRINXPR = 0 -C - PPD_STAT_FILL = PPD_SUCCESS - RETURN - END -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - INTEGER*4 FUNCTION PPD_STAT_INQ (MAPB,ADDR,HLPB) -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' -C - INTEGER*4 MAPB ! (o) address mapped PPD file - INTEGER*4 ADDR ! (o) address current parm description - INTEGER*4 HLPB ! (o) address help area -C -C.Purpose: Get information from the status array of the mapped PPD file -C.Returns: Status code (.TRUE. for success, .FALSE. otherwise) -C success PPD_SUCCESS -C.Notes: -C - MAPB = 0 if no PPD file is currently mapped -C - ADDR = 0 if no current parameter was selected yet -C - HLPB = UNDEF_J if the help area is empty -C------------------------------------------------------------------------- -C - INCLUDE 'PPDSTAT_2_DEF' -C -C - MAPB = PPS$MAPB - HLPB = PPS$HLPB - ADDR = PPS$NXTPAR - IF (PPS$ENTYP.NE.0) ADDR = PPS$NXTPROT -C - PPD_STAT_INQ = PPD_SUCCESS - RETURN - END -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - INTEGER*4 FUNCTION PPD_STAT_INQT (PROTOTYPE) -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' -C - LOGICAL*4 PROTOTYPE ! (o) prototype parameter ? -C -C.Purpose: Get the type of the last parameter read -C.Returns: Status code (.TRUE. for success, .FALSE. otherwise) -C success PPD_SUCCESS -C.Notes: -C------------------------------------------------------------------------- -C - INCLUDE 'PPDSTAT_2_DEF' -C -C - PROTOTYPE = PPS$ENTYP.EQ.1 -C - PPD_STAT_INQT = PPD_SUCCESS - RETURN - END -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - INTEGER*4 FUNCTION PPD_STAT_SETT (PROTOTYPE) -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' -C - LOGICAL*4 PROTOTYPE ! (i) prototype parameter ? -C -C.Purpose: Save the type of the parameter last read -C.Returns: Status code (.TRUE. for success, .FALSE. otherwise) -C success PPD_SUCCESS -C.Notes: -C------------------------------------------------------------------------- -C - INCLUDE 'PPDSTAT_2_DEF' -C -C - PPS$ENTYP = 0 - IF (PROTOTYPE) PPS$ENTYP = 1 -C - PPD_STAT_SETT = PPD_SUCCESS - RETURN - END -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - INTEGER*4 FUNCTION PPD_STAT_SAVE () -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' - INTEGER*4 PPD_STAT_RESTORE -C -C -C.Purpose: Save/restore the status array of the mapped PPD file -C.Returns: Status code (.TRUE. for success, .FALSE. otherwise) -C success PPD_SUCCESS -C error PPD_SEQERROR sequence error -C.Notes: -C - SAVE copies the current status block into the save array, and clears -C the status block. A PPD file must be open, and the save array must -C be empty. -C - RESTORE copies the save array back into the status block, and clears -C the save array. No PPD file should be open, and the save array should -C not be empty. -C------------------------------------------------------------------------- -C - INCLUDE 'PPDSTAT_2_DEF' -C - INTEGER*4 MSG_SET , MOVE_BLJ, CLEAR_BLJ -C - INTEGER*4 IS, SAVESTAT(PPS__LENGTH) - SAVE SAVESTAT - DATA SAVESTAT /PPS__LENGTH*0/ -C -C - IF (PPS$MAPB.EQ.0 .OR. SAVESTAT(1).NE.0) GOTO 991 - IS = MOVE_BLJ (PPS_,SAVESTAT,PPS__LENGTH) - IS = CLEAR_BLJ (PPS_,PPS_LENGTH) -C - PPD_STAT_SAVE = PPD_SUCCESS - RETURN -C - 991 PPD_STAT_SAVE = MSG_SET (PPD_SEQERROR,0) - RETURN -C -C -C ------------------------- - ENTRY PPD_STAT_RESTORE () -C ------------------------- -C - IF (PPS$MAPB.NE.0 .OR. SAVESTAT(1).EQ.0) GOTO 992 - IS = MOVE_BLJ (SAVESTAT,PPS_,PPS__LENGTH) - IS = CLEAR_BLJ (SAVESTAT,PPS__LENGTH) -C - PPD_STAT_RESTORE = PPD_SUCCESS - RETURN -C - 992 PPD_STAT_RESTORE = MSG_SET (PPD_SEQERROR,0) - RETURN - END diff --git a/src/dwarf/ppdstat_2.def b/src/dwarf/ppdstat_2.def deleted file mode 100644 index 8b078053a7fb072fd00fe856674dff82928254f2..0000000000000000000000000000000000000000 --- a/src/dwarf/ppdstat_2.def +++ /dev/null @@ -1,116 +0,0 @@ -C Include module PPDSTAT_2 -C Created by BLDDEF from: _$1$DIA3:[TESTDWARF.SRC.DEF]PPDSTAT.DEF; on 17-OCT-90 -C -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ -C.Ident: DEF_PPDSTAT -C.Keywords: PPD File, Mapped, Status Array -C.Author: Kasper Kombrink (NFRA, Dwingeloo) -C.Language: DWARF-DEF -C.Environment: VAX -C.Comments: -C.Version: 850813 KK - version 1 -C.Version: 890125 FMO - version 2, new DEF syntax -C-------------------------------------------------------------------- -C -C Status array of the currently mapped PPD file -C (all fields are 0 when no PPD file is mapped) -C - INTEGER*4 PPS_LENGTH - PARAMETER (PPS_LENGTH =1) !&1 !#J !generated: field to contain the block length - INTEGER*4 PPS_TYPE - PARAMETER (PPS_TYPE =2) !&1 !#J !generated: field to contain the block type -C Location of the map -C - filled by PPD_INIT -C - cleared by PPD_EXIT -C - INTEGER*4 PPS_MAPB - PARAMETER (PPS_MAPB =1) !&1 !#J !address 1-st byte of mapped PPD file - INTEGER*4 PPS_MAPE - PARAMETER (PPS_MAPE =2) !&1 !#J !address last byte of mapped PPD file -C -C Location of the various areas -C - filled by PPD_INIT -C - UNDEF_J if the area is empty -C - cleared by PPD_EXIT -C - INTEGER*4 PPS_INXB - PARAMETER (PPS_INXB =3) !&1 !#J !address 0-th byte of index area - INTEGER*4 PPS_PARB - PARAMETER (PPS_PARB =4) !&1 !#J !address 0-th byte of parameter description area - INTEGER*4 PPS_HLPB - PARAMETER (PPS_HLPB =5) !&1 !#J !address 0-th byte of help area - INTEGER*4 PPS_PROTB - PARAMETER (PPS_PROTB =6) !&1 !#J !address 0-th byte of prototype description area - INTEGER*4 PPS_NRINX - PARAMETER (PPS_NRINX =7) !&1 !#J !number of index entries -C -C Location of the current description -C - 0 if none is selected -C - modified by several routines -C - INTEGER*4 PPS_NXTPAR - PARAMETER (PPS_NXTPAR =8) !&1 !#J !address 0-th byte of parameter description - INTEGER*4 PPS_NXTPROT - PARAMETER (PPS_NXTPROT =9) !&1 !#J !address 0-th byte of prototype description - INTEGER*4 PPS_ENTYP - PARAMETER (PPS_ENTYP =10) !&1 !#J !type of last selected description (0=param, 1=proto) - INTEGER*4 PPS_NRINXPR - PARAMETER (PPS_NRINXPR =11) !&1 !#J !index number of last selected description -C -C Description of the FAB -C - filled by PPD_INIT -C - cleared by PPD_EXIT -C - INTEGER*4 PPS_FABADR - PARAMETER (PPS_FABADR =12) !&1 !#J !FAB address - INTEGER*4 PPS_FABSIZ - PARAMETER (PPS_FABSIZ =13) !&1 !#J !FAB size - INTEGER*4 PPS__LENGTH - PARAMETER (PPS__LENGTH =13) !generated: block length (in longwords) - INTEGER*4 PPS__TYPE - PARAMETER (PPS__TYPE =21) !generated: block type - INTEGER*4 PPDSTAT__DEFTYP - PARAMETER (PPDSTAT__DEFTYP=24) - INTEGER*4 PPDSTAT__DEFVSN - PARAMETER (PPDSTAT__DEFVSN=2) -C - EXTERNAL PPDSTAT_BLOCK -C -C Common block specification -C - INTEGER*4 PPS$LENGTH - EQUIVALENCE (PPS$LENGTH,PPS__(0)) - INTEGER*4 PPS$TYPE - EQUIVALENCE (PPS$TYPE,PPS__(4)) - INTEGER*4 PPS$MAPB - EQUIVALENCE (PPS$MAPB,PPS__(0)) - INTEGER*4 PPS$MAPE - EQUIVALENCE (PPS$MAPE,PPS__(4)) - INTEGER*4 PPS$INXB - EQUIVALENCE (PPS$INXB,PPS__(8)) - INTEGER*4 PPS$PARB - EQUIVALENCE (PPS$PARB,PPS__(12)) - INTEGER*4 PPS$HLPB - EQUIVALENCE (PPS$HLPB,PPS__(16)) - INTEGER*4 PPS$PROTB - EQUIVALENCE (PPS$PROTB,PPS__(20)) - INTEGER*4 PPS$NRINX - EQUIVALENCE (PPS$NRINX,PPS__(24)) - INTEGER*4 PPS$NXTPAR - EQUIVALENCE (PPS$NXTPAR,PPS__(28)) - INTEGER*4 PPS$NXTPROT - EQUIVALENCE (PPS$NXTPROT,PPS__(32)) - INTEGER*4 PPS$ENTYP - EQUIVALENCE (PPS$ENTYP,PPS__(36)) - INTEGER*4 PPS$NRINXPR - EQUIVALENCE (PPS$NRINXPR,PPS__(40)) - INTEGER*4 PPS$FABADR - EQUIVALENCE (PPS$FABADR,PPS__(44)) - INTEGER*4 PPS$FABSIZ - EQUIVALENCE (PPS$FABSIZ,PPS__(48)) - BYTE PPS__(0:51) - INTEGER*4 PPS_(13) - EQUIVALENCE (PPS_,PPS__) -C - COMMON /PPDSTAT/ PPS_ -C diff --git a/src/dwarf/ppdstatblock.for b/src/dwarf/ppdstatblock.for deleted file mode 100644 index a5190e3a87e0b4e19b9a122d0173cb4841f89bba..0000000000000000000000000000000000000000 --- a/src/dwarf/ppdstatblock.for +++ /dev/null @@ -1,42 +0,0 @@ - BLOCK DATA PPDSTAT_BLOCK -C Created by BLDDEF from: _$1$DIA3:[TESTDWARF.SRC.DEF]PPDSTAT.DEF; on 17-OCT-90 -C HjV 921208 Removed all equivalence and add names to common block -C AXC 010709 Linux port - data initialisation -C -C -C - INTEGER*4 PPS$LENGTH - INTEGER*4 PPS$TYPE - INTEGER*4 PPS$MAPB - INTEGER*4 PPS$MAPE - INTEGER*4 PPS$INXB - INTEGER*4 PPS$PARB - INTEGER*4 PPS$HLPB - INTEGER*4 PPS$PROTB - INTEGER*4 PPS$NRINX - INTEGER*4 PPS$NXTPAR - INTEGER*4 PPS$NXTPROT - INTEGER*4 PPS$ENTYP - INTEGER*4 PPS$NRINXPR - INTEGER*4 PPS$FABADR - INTEGER*4 PPS$FABSIZ -C - COMMON /PPDSTAT/ PPS$MAPB, PPS$MAPE, PPS$INXB, PPS$PARB, PPS$HLPB, - * PPS$PROTB, PPS$NRINX, PPS$NXTPAR, PPS$NXTPROT, PPS$ENTYP, - * PPS$NRINXPR, PPS$FABADR, PPS$FABSIZ -C -C - DATA PPS$MAPB /0/ - DATA PPS$MAPE /0/ - DATA PPS$INXB /0/ - DATA PPS$PARB /0/ - DATA PPS$HLPB /0/ - DATA PPS$PROTB /0/ - DATA PPS$NRINX /0/ - DATA PPS$NXTPAR /0/ - DATA PPS$NXTPROT /0/ - DATA PPS$ENTYP /0/ - DATA PPS$NRINXPR /0/ - DATA PPS$FABADR /0/ - DATA PPS$FABSIZ /0/ - END diff --git a/src/dwarf/ppdunam.for b/src/dwarf/ppdunam.for deleted file mode 100644 index ca9ddeb27794d7c018d024a9a0b0f83b4311e712..0000000000000000000000000000000000000000 --- a/src/dwarf/ppdunam.for +++ /dev/null @@ -1,250 +0,0 @@ -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ -C.Ident: PPD_UNAM -C.Keywords: PPD File, Parameter Name -C.Author: Friso Olnon (NFRA, Dwingeloo) -C.Language: DWARF-Fortran -C.Environment: VAX or Alliant -C.Comments: -C Common variables used: -C CHARACTER*16 PPDPD$UNAM ! (m) user's parameter name -C INTEGER*4 PPDPD$LUNAM ! (m) length of unique abbreviation -C CHARACTER*16 PPDPD$PNAM ! (m) program's parameter name -C -C.Version: 900415 FMO - recreation -C.Version: 920224 GvD - no optional arguments in MSG anymore -C------------------------------------------------------------------------- -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - INTEGER*4 FUNCTION PPD_UNAM_PUT (NAME,DO_CHECK) -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' -C - CHARACTER*(*) NAME ! (i) proposed name - LOGICAL*4 DO_CHECK ! (i) check the name ? -C -C.Purpose: Check and store the user's name for a program parameter -C.Returns: Status code (.TRUE. for success, .FALSE. otherwise) -C success PPD_SUCCESS -C error PPD_UNAMNOT no name given -C error PPD_MAX16 name too long -C error PPD_PARINV invalid name -C error PPD_PARNOTUNI name not unique -C.Notes: -C The name and its significant length are stored in the current -C parameter description (fields PPDPD$UNAM and PPDPD$LUNAM). Later on, -C the length of the unique abbreviation will be determined and stored -C in PPDPD$LUNAM. -C -C A valid name: -C - is not blank and not longer than 16 characters -C - starts with an alphabetic, possibly prefixed with a '$' (prototype) -C - contains only alphanumeric or underscore characters -C - must be unique -C -C In case of errors, no messages are stored in the regular message -C buffer. The calling routine (BPD_BUILD) takes care of that. -C------------------------------------------------------------------------- -C - INCLUDE 'PPDREC_4_DEF' -C - CHARACTER*(*) PROTO - PARAMETER (PROTO = '$') -C - INTEGER*4 BPD_INDEX_GETU - INTEGER*4 STR_SIGLEN, STR_CHECK_ANUM_ - -C - INTEGER*4 IS, LN, PTR -C -C -C Store the name -C - LN = STR_SIGLEN (NAME) - PPDPD$UNAM = NAME(:LN) - PPDPD$LUNAM = STR_SIGLEN (PPDPD$UNAM) -C -C Check the syntax -C - IF (DO_CHECK) THEN - IF (LN.EQ.0) THEN - IS = PPD_UNAMNOT - GOTO 999 - ELSE IF (LN.GT.LEN(PPDPD$UNAM)) THEN - IS = PPD_MAX16 - GOTO 999 - ENDIF - PTR = 1 - IF (NAME(1:1).EQ.PROTO) PTR = 2 - IF (IAND(STR_CHECK_ANUM_(NAME(PTR:LN)),1) .EQ. 0) THEN - IS = PPD_PARINV - GOTO 999 - ENDIF -C -C Check whether the name is unique -C - loop through the index entries -C - IS = BPD_INDEX_GETU (NAME(:LN)) - IF (IAND(IS,1).NE.0) THEN - IS = PPD_PARNOTUNI - GOTO 999 - ENDIF - ENDIF -C -C - PPD_UNAM_PUT = PPD_SUCCESS - RETURN -C - 999 PPD_UNAM_PUT = IS - RETURN - END -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - INTEGER*4 FUNCTION PPD_PNAM_PUT (NAME,DO_CHECK) -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' -C - CHARACTER*(*) NAME ! (i) proposed name - LOGICAL*4 DO_CHECK ! (i) check the name ? -C -C.Purpose: Check and store the program's name for a program parameter -C.Returns: Status code (.TRUE. for success, .FALSE. otherwise) -C success PPD_SUCCESS -C error PPD_MAX16 name too long -C error PPD_PARINV invalid name -C error PPD_PARNOTUNI name not unique -C.Notes: -C The name is stored in the current parameter description (field -C PPDPD$PNAM). If no name is given, the user's name will be used -C (without prototype prefix). -C -C A valid name: -C - is not longer than 16 characters -C - starts with an alphabetic character -C - contains only alphanumeric or underscore characters -C - must be unique -C -C In case of errors, no messages are stored in the regular message -C buffer. The calling routine (BPD_BUILD) takes care of that. -C------------------------------------------------------------------------- -C - INCLUDE 'PPDREC_4_DEF' -C - CHARACTER*(*) PROTO, EMPTVAL - PARAMETER (PROTO = '$' ) - PARAMETER (EMPTVAL = '[]') -C - INTEGER*4 BPD_INDEX_GETP - INTEGER*4 STR_SIGLEN, STR_CHECK_ANUM_ -C - INTEGER*4 IS, LN -C -C -C Store the name -C - LN = STR_SIGLEN (NAME) - IF (LN.EQ.0 .OR. NAME(:LN).EQ.EMPTVAL) THEN - IF (PPDPD$UNAM(1:1).NE.PROTO) THEN - PPDPD$PNAM = PPDPD$UNAM - ELSE - PPDPD$PNAM = PPDPD$UNAM(2:) - ENDIF - ELSE - PPDPD$PNAM = NAME(:LN) - ENDIF -C -C Check the syntax -C - IF (LN.GT.0) THEN - IF (LN.GT.LEN(PPDPD$PNAM)) THEN - IS = PPD_MAX16 - GOTO 999 - ELSE IF (IAND(STR_CHECK_ANUM_(NAME(:LN)),1) .EQ. 0) THEN - IS = PPD_PARINV - GOTO 999 - ENDIF - ENDIF -C -C Check whether the name is unique -C - loop through the index entries -C - IS = BPD_INDEX_GETP (NAME(:LN)) - IF (IAND(IS,1).NE.0) THEN - IS = PPD_PARNOTUNI - GOTO 999 - ENDIF -C - PPD_PNAM_PUT = PPD_SUCCESS - RETURN -C - 999 PPD_PNAM_PUT = IS - RETURN - END -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - INTEGER*4 FUNCTION PPD_UNAM_GET (NAME,LN,LMIN,PROTOTYPE) -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' -C - CHARACTER*(*) NAME ! (o) user's name - INTEGER*4 LN ! (o) its significant length - INTEGER*4 LMIN ! (o) length of unique abbreviation - LOGICAL*4 PROTOTYPE ! (o) prototype name ? -C -C.Purpose: Get the user's parameter name from the current description -C.Returns: Status code (.TRUE. for success, .FALSE. otherwise) -C success PPD_SUCCESS -C error PPD_STRTOOSML output string too short -C.Notes: -C------------------------------------------------------------------------- -C - INCLUDE 'PPDREC_4_DEF' -C - CHARACTER*(*) PROTO - PARAMETER (PROTO = '$') -C - INTEGER*4 STR_SIGLEN, MSG_SET -C -C - NAME = PPDPD$UNAM - LN = STR_SIGLEN (NAME) - LMIN = PPDPD$LUNAM - PROTOTYPE = PPDPD$UNAM(1:1).EQ.PROTO -C - IF (LN.EQ.STR_SIGLEN(PPDPD$UNAM)) THEN - PPD_UNAM_GET = PPD_SUCCESS - ELSE - PPD_UNAM_GET = MSG_SET (PPD_STRTOOSML,0) - ENDIF - RETURN - END -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - INTEGER*4 FUNCTION PPD_PNAM_GET (NAME,LN) -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' -C - CHARACTER*(*) NAME ! (o) program's name - INTEGER*4 LN ! (o) its significant length -C -C.Purpose: Get the program's parameter name from the current description -C.Returns: Status code (.TRUE. for success, .FALSE. otherwise) -C success PPD_SUCCESS -C error PPD_STRTOOSML output string too short -C.Notes: -C------------------------------------------------------------------------- -C - INCLUDE 'PPDREC_4_DEF' -C - INTEGER*4 STR_SIGLEN, MSG_SET -C -C - NAME = PPDPD$PNAM - LN = STR_SIGLEN (NAME) -C - IF (LN.EQ.STR_SIGLEN(PPDPD$PNAM)) THEN - PPD_PNAM_GET = PPD_SUCCESS - ELSE - PPD_PNAM_GET = MSG_SET (PPD_STRTOOSML,0) - ENDIF - RETURN - END diff --git a/src/dwarf/ppdustr.for b/src/dwarf/ppdustr.for deleted file mode 100644 index 8a2557d101c4a703916f575df51b073488fcb029..0000000000000000000000000000000000000000 --- a/src/dwarf/ppdustr.for +++ /dev/null @@ -1,193 +0,0 @@ -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ -C.Ident: PPD_USTR -C.Keywords: PPD File, Parameter Units -C.Author: Friso Olnon (NFRA, Dwingeloo) -C.Language: DWARF-Fortran -C.Environment: VAX or Alliant -C.Comments: -C Common variables used: -C CHARACTER*(*) PPDPD$DESCR ! (m) description in string format -C INTEGER*4 PPDPD$LENG ! (m) current sign length of descr -C INTEGER*4 PPDPD$UOFF ! (m) offset of units string in descr -C INTEGER*4 PPDPD$ULEN ! (m) length of units string -C -C.Version: 900415 FMO - recreation -C.Version: 920224 GvD - no optional arguments in MSG anymore -C.Version: 930510 HjV - Change some INTEGER*2 into INTEGER*4 -C.Version: 940120 CMV - Use indirect addressing (A_B) -C------------------------------------------------------------------------- -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - INTEGER*4 FUNCTION PPD_USTR_PUT (STRING,DO_CHECK) -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' -C - CHARACTER*(*) STRING ! (i) proposed units string - LOGICAL*4 DO_CHECK ! (i) check the string ? -C -C.Purpose: Check and store the units string for a program parameter -C.Returns: Status code (.TRUE. for success, .FALSE. otherwise) -C success PPD_SUCCESS -C error PPD_UNITINV invalid unit -C.Notes: -C - The units string is stored in the variable-length part of the current -C parameter description. Its offset w.r.t. the start of the description -C and its significant length are stored in the fixed part (fields -C PPDPD$UOFF and PPDPD$ULEN). -C - If a unit list is given, only the first list element will be kept. -C - If no unit is given, the offset is set to UNDEF_J -C - In case of errors, no messages are stored in the regular message -C buffer. The calling routine (BPD_BUILD) takes care of that. -C------------------------------------------------------------------------- -C - INCLUDE 'PPDREC_4_DEF' -C - CHARACTER*(*) COMMA - PARAMETER (COMMA = ',') -C - INTEGER*4 READ_UNIT, STR_SIGLEN -C - CHARACTER*16 UGRP - REAL*8 UFACT - INTEGER*4 IS, LS -C -C - PPDPD$UOFF = UNDEF_J - PPDPD$ULEN = 0 -C - LS = STR_SIGLEN (STRING) - IF (LS.GT.0) THEN - I = INDEX (STRING(:LS),COMMA) - IF (I.GT.0) LS = STR_SIGLEN (STRING(:I-1)) - ENDIF - IF (LS.GT.0) THEN - IF (DO_CHECK) THEN - IS = READ_UNIT (STRING(:LS),UGRP,UFACT) - IF (IAND(IS,1).EQ.0) GOTO 999 - ENDIF - PPDPD$UOFF = PPDPD$LENG - PPDPD$ULEN = LS - PPDPD$LENG = PPDPD$LENG+LS - IF (PPDPD$LENG.GT.PPDPD__LENGTH*4) GOTO 9999 - PPDPD$DESCR(PPDPD$UOFF+1:PPDPD$LENG) = STRING(:LS) - ENDIF -C - PPD_USTR_PUT = PPD_SUCCESS - RETURN -C - 999 PPD_USTR_PUT = PPD_UNITINV - RETURN -C - 9999 PPD_USTR_PUT = 4 - CALL WNCTXT(DWLOG,'PPDPD_ overflow: tell DWARF manager') - CALL WNGEX - RETURN - END -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - INTEGER*4 FUNCTION PPD_USTR_GET (STRING,LS) -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' -C - CHARACTER*(*) STRING ! (o) units string - INTEGER*4 LS ! (o) its significant length -C -C.Purpose: Get the units string from the current parameter description -C.Returns: Status code (.TRUE. for success, .FALSE. otherwise) -C success PPD_SUCCESS -C error PPD_STRTOOSML output string too short -C.Notes: -C - If no units string is given, a blank string will be returned. -C------------------------------------------------------------------------- -C - INCLUDE 'PPDREC_4_DEF' -C - INTEGER*4 STR_COPY, MSG_SET -C - INTEGER*4 IS -C -C -C Get the string -C - STRING = ' ' - LS = 0 - IF (PPDPD$UOFF.NE.UNDEF_J) THEN - IS = STR_COPY - 1 (PPDPD$DESCR(PPDPD$UOFF+1:PPDPD$UOFF+PPDPD$ULEN), - 2 STRING,LS) - IF (IS.LT.0) GOTO 999 - ENDIF -C - PPD_USTR_GET = PPD_SUCCESS - RETURN -C - 999 PPD_USTR_GET = MSG_SET (PPD_STRTOOSML,0) - RETURN - END -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - INTEGER*4 FUNCTION PPD_USTR_XGET (STRING,LS) -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' -C - CHARACTER*(*) STRING ! (o) units string - INTEGER*4 LS ! (o) its significant length -C -C.Purpose: Get the units string for the current parameter -C.Returns: Status code (.TRUE. for success, .FALSE. otherwise) -C success PPD_SUCCESS -C error PPD_SEQERROR no PPD file mapped -C error PPD_NOCURENTR no current parameter selected -C error PPD_STRTOOSML output string too short -C.Notes: -C - The string is fetched directly from the mapped PPD file using -C the offset and length given in the current parameter description. -C - Use XGET i.s.o. GET when the variable-length part of the current -C description contains data for another parameter (e.g. the COPY -C parameter in BLDPPD). -C - If no units string is given, a blank string will be returned. -C------------------------------------------------------------------------- -C - INCLUDE 'PPDREC_4_DEF' -C - INTEGER*4 PPD_STAT_INQ, MOVE_BLB, MSG_SET -C - INTEGER*4 IS, MAPB, ADDR, HLPB -C -C - STRING = ' ' - LS = 0 -C -C Make sure that the PPD file is mapped -C and that a parameter has been selected -C - IS = PPD_STAT_INQ (MAPB,ADDR,HLPB) - IF (MAPB.EQ.0) THEN - IS = PPD_SEQERROR - GOTO 999 - ELSE IF (ADDR.EQ.0) THEN - IS = PPD_NOCURENTR - GOTO 999 - ENDIF -C -C Get the string -C - IF (PPDPD$UOFF.NE.UNDEF_J) THEN - LS = PPDPD$ULEN - ADDR = ADDR+PPDPD$UOFF+1 - IF (LS.LE.LEN(STRING)) THEN - IS = MOVE_BLB (A_B(ADDR-A_OB),%REF(STRING),LS) - ELSE - LS = LEN(STRING) - IS = MOVE_BLB (A_B(ADDR-A_OB),%REF(STRING),LS) - IS = PPD_STRTOOSML - GOTO 999 - ENDIF - ENDIF -C - PPD_USTR_XGET = PPD_SUCCESS - RETURN -C - 999 PPD_USTR_XGET = MSG_SET (IS,0) - RETURN - END diff --git a/src/dwarf/progend.for b/src/dwarf/progend.for deleted file mode 100644 index 9423a9d71249b5defc485bc997bf8fd9b4dd08d4..0000000000000000000000000000000000000000 --- a/src/dwarf/progend.for +++ /dev/null @@ -1,82 +0,0 @@ -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ -C.Ident: PROG_END -C.Keywords: DWARF Program Exit -C.Author: Friso Olnon (NFRA, Dwingeloo) -C.Language: DWARF-Fortran -C.Environment: VAX or Alliant -C.Comments: -C.Version: 910820 FMO - recreation -C.Version: 920206 GvD - no optional arguments anymore -C added entry PROG_END_STAT instead -C.Version: 940117 CMV - just call the exit handler and exit, -C should pass an exit status. -C.Version: 940120 CMV - Changed messenger -C------------------------------------------------------------------------- -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - INTEGER*4 FUNCTION PROG_END (STAT) -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' -C - INTEGER*4 STAT ! (i) program exit status -C -C.Purpose: Terminate the program (call interface) -C.Returns: Status code (.TRUE. for success, .FALSE. otherwise) -C success DWC_SUCCESS -C.Notes: -C - Execute the declared exit handlers. Among them the one declared by -C PROG_START, which prints all messages that are still in the message -C buffer and sets the exit status, defines symbols for the parameter -C values that the user wanted to save (indicated via the SAVELAST -C option), closes the the PPD file, closes the messenger and symbol -C facility. -C - Terminate the program with the given status. -C------------------------------------------------------------------------- -C -C -C Execute the exit handlers and terminate the program -C - CALL WNGSXX() - CALL EXIT(STAT) -C - PROG_END = DWC_SUCCESS !does not get here - RETURN - END - -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - SUBROUTINE PROG_END_EXH () -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' -C -C.Purpose: Exit handler declared by PROG_START -C.Returns: Not applicable -C.Notes: -C - Print all messages that are still in the message buffer. -C - Define symbols for the parameter values that the user wanted to save -C (indicated via the SAVELAST option). -C - Close the PPD file -C - Close the messenger (write an end message). -C------------------------------------------------------------------------- -C - INTEGER GP_CTL_END, PPD_EXIT, SYMBOL_EXIT, MSG_SET - INTEGER DWC_PROG_GET, DWC_STREAM_GET -C - INTEGER IS, LP, LS - CHARACTER*30 PRG - CHARACTER*8 ERRSTR(0:1) - DATA ERRSTR/'Error','Success'/ -C -C - IS = GP_CTL_END () !define all save symbols - IS = PPD_EXIT () !close the PPD file - IS = SYMBOL_EXIT () !close the symbol facility - IS = DWC_PROG_GET (PRG,LP) !get program name - IF (IAND(IS,1).NE.0) - 1 IS = DWC_STREAM_GET (PRG(LP+1:),LS,.FALSE.) ! and stream - IS = MSG_SET(GEN_ENDMESSAG,-1) !get end message - CALL WNCTXT(DWLOG,DWMSG,PRG, - 1 ERRSTR(IAND(E_C,1))) !print it -C - RETURN - END diff --git a/src/dwarf/progstart.for b/src/dwarf/progstart.for deleted file mode 100644 index 6ac03f432637b830a5dd037129b6da5e846c5137..0000000000000000000000000000000000000000 --- a/src/dwarf/progstart.for +++ /dev/null @@ -1,98 +0,0 @@ -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ -C.Ident: PROG_START -C.Keywords: DWARF, Program, Start -C.Author: Friso Olnon (NFRA, Dwingeloo) -C.Language: DWARF-Fortran -C.Environment: VAX or Alliant -C.Comments: -C.Version: 900407 FMO - new code -C.Version: 920206 GvD - no optional arguments anymore -C - add argument to MSG_INIT and MSG_SWRITE -C.Version: 940117 CMV - Call WNGSXH directly for PROG_END, remove -C version checks, flags argument -C.Version: 940218 CMV - Add version number to start message -C.Version: 940301 HjV - Write line in $n_import/newstar.use -C------------------------------------------------------------------------- -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - INTEGER*4 FUNCTION PROG_START (PROG,flags) -C -C Include files -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' -C -C Arguments -C - CHARACTER*(*) PROG ! (i) program name - INTEGER flags -C -C.Purpose: Start a DWARF program (call interface) -C.Returns: Status code (.TRUE. for success, .FALSE. otherwise) -C success DWC_SUCCESS -C .FALSE. status codes will not occur (the program will stop) -C.Notes: -C - Initialize the program control parameters. -C - Start the messenger (and write a starting message). -C - Open the PPD file. -C - Close the messenger if the caller himself wants to start it. -C - Declare the exit handler. -C - If PROG_START detects an error, it will print a message and stop -C the program. -C------------------------------------------------------------------------- -C - EXTERNAL PROG_END_EXH -C - INTEGER*4 DWC_CTL_OPEN, DWC_CTL_UPDATE, DWC_EXH_DECLR - INTEGER*4 DWC_PROG_GET, DWC_STREAM_GET, DWC_PRCMODE_INQ - INTEGER MSG_INIT, MSG_SET - INTEGER WNCALN - INTEGER*4 PPD_INIT -C - CHARACTER*30 PROGSTRM - INTEGER*4 IS, LP, LS -C -C Exit handler block for WNGSXH (put this in dsc file later) -C - INTEGER*4 DWCEXH(6) - SAVE DWCEXH -C -C Initialize the program control -C - IS = DWC_CTL_OPEN () ! ignore false return - IS = DWC_CTL_UPDATE (PROG) - IF (IAND(IS,1).EQ.0) GOTO 999 -C -C Start the messenger -C - if subprocess: write message -C - IS = DWC_PROG_GET (PROGSTRM,LP) - IF (IAND(IS,1).NE.0) - 1 IS = DWC_STREAM_GET (PROGSTRM(LP+1:),LS,.FALSE.) - IF (IAND(IS,1).NE.0) IS = MSG_INIT (PROGSTRM(:LP+LS), F_T) - IF (IAND(IS,1).EQ.0) GOTO 999 - IF (IAND(DWC_PRCMODE_INQ('SUBPROCESS'),1) .NE. 0) - 1 IS = MSG_SET (DWC_IMGSUBPRC,0) -C -C Open the PPD file -C - IS = PPD_INIT (PROGSTRM(:LP)) - IF (IAND(IS,1).EQ.0) GOTO 999 -C -C Declare the exit handler -C - ignore false status (for Alliant) -C - IF (DWCEXH(1).EQ.0) CALL WNGSXH(DWCEXH,PROG_END_EXH) -C - IS = MSG_SET(GEN_STMESSAG,-1) - J1 = WNCALN(PRGVER) - CALL WNCTXT(DWLOG,DWMSG, - 1 PROGSTRM(:LP+LS)//' (v'//PRGVER(:J1)//')') - CALL PRTUSE(PROGSTRM(:LP),PRGVER(:J1)) - PROG_START = DWC_SUCCESS - RETURN -C - 999 PROG_START = MSG_SET(DWC_PROGSTERR,0) -C - RETURN - END - diff --git a/src/dwarf/prtppd.for b/src/dwarf/prtppd.for deleted file mode 100644 index 3e061543ffcb28f63231cba8721aeb7e5259a055..0000000000000000000000000000000000000000 --- a/src/dwarf/prtppd.for +++ /dev/null @@ -1,80 +0,0 @@ -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ -C.Ident: SYS_PRTPPD -C.Keywords: PPD File, Print -C.Author: Friso Olnon (NFRA, Dwingeloo) -C.Language: DWARF-Fortran -C.Environment: VAX or Alliant -C.Comments: -C.Version: 900407 FMO - recreation -C.Version: 920206 GvD - add former optional arguments to CLI_GET -C------------------------------------------------------------------------- -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - SUBROUTINE SYS_PRTPPD -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' -C -C -C.Purpose: Print a map of a PPD file -C.Returns: Not applicable -C.Notes: -C - The program will prompt for the name of the PPD file. -C - If <name>/PRINT is answered, the listing will be printed and deleted. -C - If <name> is answered, the listing will kept as file <name>.MLIS. -C------------------------------------------------------------------------- -C -C - CHARACTER*(*) PROGNAME - INTEGER*4 NRARG - PARAMETER (PROGNAME = 'PRTPPD') - PARAMETER (NRARG = 2) - CHARACTER*6 NAME(NRARG) - INTEGER*4 ATTR(NRARG) - CHARACTER*13 PROMPT(NRARG) - CHARACTER*1 DEFVAL(NRARG) - DATA NAME /'PPDNAM' ,'PRINT' / - DATA ATTR /CLI__REQUIRED ,CLI__QUALIFIER/ - DATA PROMPT /'PPD-file name',' ' / - DATA DEFVAL /' ' ,' ' / -C - INTEGER*4 CLI_INIT, CLI_GET - INTEGER MSG_INIT, MSG_SET - INTEGER*4 PPD_LIST -C - CHARACTER PPDNAM*80, DUM*1 - INTEGER*4 IS, LNAM, LDUM -C -C -C Initialize -C - start messenger -C - initialize command-line interpreter -C - IS = MSG_INIT (PROGNAME,F_T) - IF (IAND(IS,1).NE.0) IS = CLI_INIT (NRARG,NAME,ATTR,PROMPT,DEFVAL) - IF (IAND(IS,1).EQ.0) GOTO 999 -C -C Get and check the PPD name -C - IS = CLI_GET ('PPDNAM',PPDNAM,LNAM) - IF (LNAM.EQ.0) THEN - IS = MSG_SET (PPD_NOIMAGE,0) - ELSE IF (LNAM.GT.9) THEN - IS = MSG_SET (PPD_IMTOOLONG,0) - ENDIF - IF (IAND(IS,1).EQ.0) GOTO 999 -C -C Get and interpret the PRINT qualifier -C - IS = CLI_GET ('PRINT',DUM,LDUM) - IF (IAND(IS,1).EQ.0) GOTO 999 - IF (IS.EQ.DWC_PRESENT) THEN - IS = PPD_LIST (PPDNAM(:LNAM),F_SP) - ELSE - IS = PPD_LIST (PPDNAM(:LNAM),F_YES) - ENDIF - IF (IAND(IS,1).EQ.0) IS = MSG_SET(IS,0) -C -C Terminate the program -C - 999 E_C=MSG_SET(IS,0) !Set exit code for WNGEX - END diff --git a/src/dwarf/prtuse.fsc b/src/dwarf/prtuse.fsc deleted file mode 100644 index cf1aa20c9687dd89be4deca41341802cb2e35375..0000000000000000000000000000000000000000 --- a/src/dwarf/prtuse.fsc +++ /dev/null @@ -1,106 +0,0 @@ -C+PRTUSE.FOR -C HjV 940303 -C -C Revisions: -C - SUBROUTINE PRTUSE (DPROG,DPVERS) -C -C Print line at end file $n_import/newstar.use with: -C machine - user - program - version - date - time -C If the log file does not yet exist, it will be created. -C The file will be used by the Newstar master to see who are -C really working with Newstar -C -C Result: -C -C CALL PRTUSE (DPROG,DPVERS) -C -C Include files: -C - INCLUDE 'WNG_DEF' -C -C Parameters: -C - CHARACTER*(*) DPROG !PROGRAM NAME - CHARACTER*(*) DPVERS !PROGRAM VERSION -C -C Arguments: -C -C -C Function references: -C - INTEGER WNCALN !LENGTH STRING -C -C Data declarations: -C - CHARACTER*32 DHOST !HOST NAME - CHARACTER*32 DUSER !USER NAME - CHARACTER*(*) USERLOG, DEFSPEC - PARAMETER (USERLOG = 'NEWSTAR.USE') - PARAMETER (DEFSPEC = 'n_import') -C - INTEGER*4 FILNAM_FULL -C - CHARACTER*80 FILESPEC - CHARACTER*132 LINE - INTEGER*4 IS, LUN, LF - LOGICAL*4 OPENED, EXIST -C -C- -C -C Open the permanent log file -C - if it is open right now, -C wait till it is closed -C - CALL WNGLUN (LUN) !GET LUN - IS = FILNAM_FULL (USERLOG,FILESPEC,LF,DEFSPEC) - IF (IAND(IS,1).NE.0) THEN - INQUIRE (FILE=FILESPEC(:LF),EXIST=EXIST,IOSTAT=IS) - IF (EXIST .AND. IS.EQ.0) THEN - OPENED = .TRUE. - DO WHILE (OPENED .AND. IS.EQ.0) - INQUIRE (FILE=FILESPEC(:LF),OPENED=OPENED,IOSTAT=IS) - ENDDO - OPEN (UNIT=LUN,FILE=FILESPEC(:LF),ERR=910, -#ifdef wn_li__ - 1 FORM='FORMATTED', !CARRIAGECONTROL='LIST',DISPOSE='KEEP', -#else - 1 FORM='FORMATTED', CARRIAGECONTROL='LIST',DISPOSE='KEEP', -#endif - 1 STATUS='OLD',ACCESS='APPEND') - ELSE - OPEN (UNIT=LUN,FILE=FILESPEC(:LF),ERR=910, -#ifdef wn_li__ - 1 FORM='FORMATTED',!CARRIAGECONTROL='LIST',,DISPOSE='KEEP', -#else - 1 - FORM='FORMATTED',CARRIAGECONTROL='LIST',,DISPOSE='KEEP', -#endif - 1 STATUS='NEW') - CALL WNCTXS(LINE, - 1 'Machine !20CUser !40CProgram !60CVersion !80CDate') - WRITE (LUN,'(A)',IOSTAT=IS) LINE - ENDIF - ENDIF - IF (IAND(IS,1).NE.0) GOTO 900 -C -C Append new line to log file -C - CALL WNGSGH (DHOST) - CALL WNGSGU (DUSER) - J1=WNCALN(DHOST) - J2=WNCALN(DUSER) - J3=WNCALN(DPROG) - J4=WNCALN(DPVERS) - CALL WNCTXS(LINE,'!AS !20C!AS !40C!AS !60C!AS !80C!%DN !%T ', - 1 DHOST(:J1),DUSER(:J2),DPROG(:J3),DPVERS(:J4)) - WRITE (LUN,'(A)',IOSTAT=IS) LINE -C -C Close and keep the log file -C - 900 CLOSE (UNIT=LUN,DISPOSE='SAVE',ERR=999) - 910 CALL WNGLUF (LUN) !FREE LUN -C -C - 999 RETURN - END diff --git a/src/dwarf/putparm.for b/src/dwarf/putparm.for deleted file mode 100644 index 9c72ac78f586fec9107688995941f7194a7b014b..0000000000000000000000000000000000000000 --- a/src/dwarf/putparm.for +++ /dev/null @@ -1,301 +0,0 @@ -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ -C.Ident: PUT_PARM -C.Keywords: Program Parameters, Store Value -C.Author: Friso Olnon (NFRA, Dwingeloo) -C.Language: DWARF-Fortran -C.Environment: VAX or Alliant -C.Comments: -C.Version: 900222 FMO - creation -C.Version: 920305 GvD - split into PUTPARM.FOR and GENPUTPAR.FOR -C (system dependencies in GENPUTPAR.FOR) -C.Version: 920429 GvD - changed order of PP_ARG_CHECK arguments to overcome -C SUN problems because length is still passed with %REF -C.Version: 940117 CMV - removed put_parm, now only put_parm_n and -C put_parm_c calls available. -C.Version: 940308 WNB - no define message for NGEN X_ parameters -C.Version: 940427 CMV - add PUT_PARM_G to define global symbols -C.Version: 940823 CMV - no define messages anymore (confuses users) -C------------------------------------------------------------------------- -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ -C -C The Put_parameter interface consists of three routines: -C -C -C PUT_PARM_G(KEYWORD,VALSTR) -C -C Put a character value from VALSTR in the global KEYWORD -C -C PUT_PARM_C(KEYWORD,VALSTR,PROGSTRM) -C -C Put a character value from VALSTR in the KEYWORD -C -C PUT_PARM_N(KEYWORD,VALARR,NRVAL,FLAGS,PROGSTRM) -C -C Put numeric values of the proper type (derived from -C the ppd-file) in the KEYWORD. The flags are defined in -C the module FLAGS_1 (use statement INCLUDE '(FLAGS_1)' in -C FORTRAN). The only value that is possible so far is: -C -C PARM__TOBY = the array is given in TO/BY-format. -C That is: the data is ordered in the way FROM, TO, -C STEPSIZE (NRVAL then must be a multiple of 3). -C -C CHARACTER*(*) KEYWORD ! (i) program's parameter name -C -C CHARACTER*(*) VALSTR ! (i) value (given as a string) -C The string will not be converted in any way. -C You must give characters in uppercase and -C should not use TAB-characters. -C -C <datatype> VALARR(*) ! (i) value (given as an array) -C It must be passed in the standard Fortran way. -C The array must be declared according to the -C data type defined in the PIN file. It will be -C converted to a string. -C INTEGER*4 NRVAL ! (i) nr of elements in VALARR -C Ignored when no VALARR argument is present. -C = 1 (default) -C INTEGER*4 FLAGS ! (i) control flags -C -C CHARACTER*(*) PROGSTRM ! (i) target program and stream names -C format: [<program>][$<stream>] -C defaults: current names -C -C.Purpose: Define an external default for a program parameter -C.Returns: Status code (.TRUE. for success, .FALSE. otherwise) -C success DWC_SUCCESS -C error DWC_PARAMERR messages written -C.Notes: -C This function gives an application program the possibility to define -C an external default in the same way as SPECIFY does. -C - The DWARF symbol <program>$<stream>_<keyword> will be defined. -C The program and stream names are taken from the argument PROGSTRM or -C default to the current names. <program> can be a group name, and -C <stream> can be 0. -C - The value can be given either as a string or as an array. If it's -C given as an array, it will be converted to a string. -C -C --- Obsolete, please do not use this feature because it is phased out. -C A program parameter is known under two, in principle different, names: -C - The program-keyword (PROG_PARAMETER in the PPD file) is used in the -C program code, e.g. in PUT_PARM's argument list. -C - The user-keyword (KEYWORD in the PPD file) is used outside the -C program, e.g. in DWARF's prompts and in DWARF symbol names. -C------------------------------------------------------------------------- -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - INTEGER*4 FUNCTION PUT_PARM_N (PKEY,VALARR,NRVAL, - 1 FLAGS,PROGSTRM) -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' -C - CHARACTER*(*) PKEY ! (i) program's parameter name - BYTE VALARR(*) ! (i) value given as an array - INTEGER*4 NRVAL ! (i) number of values in the array - INTEGER*4 FLAGS ! (i) additional flags - CHARACTER*(*) PROGSTRM ! (i) target program and stream names -C -C.Purpose: Define an external default for a program parameter -C.Returns: Status code (.TRUE. for success, .FALSE. otherwise) -C success DWC_SUCCES -C error DWC_PARAMERR messages written -C.Notes: -C------------------------------------------------------------------------- -C -C - CHARACTER*(*) BLANK - PARAMETER (BLANK = ' ') -C - INTEGER*4 PP_ARG_CHECK - INTEGER*4 PP_CTL_OPEN, PP_CTL_CLOSE - INTEGER*4 PPD_DTYPE_GET - INTEGER*4 PV_DEF_ENCODE - INTEGER*4 SYMBOL_DEFINE - INTEGER*4 MSG_SET -C - CHARACTER VALUE*255, SYMBOL*38, DTYPE*1 - INTEGER*4 IS, PLEN, LVAL, LSYM - LOGICAL*4 FOREIGN -C -C -C Set up for PUT_PARM -C - IS = PP_CTL_OPEN (PKEY,PROGSTRM,SYMBOL,LSYM,FOREIGN) - IF (IAND(IS,1).EQ.0) GOTO 998 -C -C Get the parameter's data type and -C get out if it is character type -C - IS = PPD_DTYPE_GET (DTYPE,PLEN) - IF (IAND(IS,1).EQ.0) GOTO 998 - IF (DTYPE.EQ.'C') THEN - IS = PP_CTL_CLOSE (BLANK,FOREIGN) - IF (IAND(IS,1).EQ.0) GOTO 999 - PUT_PARM_N = 0 - RETURN - ENDIF -C -C Convert the value to a proper string -C - IS = PV_DEF_ENCODE (VALARR,NRVAL,PLEN,FLAGS,VALUE,LVAL) - IF (LVAL.EQ.0) THEN - IS = MSG_SET (DWC_PARNOVAL,1) - CALL WNCTXT(DWLOG,DWMSG,PKEY) - END IF - IF (IAND(IS,1).EQ.0) GOTO 998 -C -C Define the DWARF symbol -C - IS = SYMBOL_DEFINE (SYMBOL(:LSYM),VALUE(:LVAL),DWC__GLOBALSYM) - IF (IAND(IS,1).EQ.0) GOTO 998 -C -C Write a log message at level 3 -C -C IF (INDEX(SYMBOL(:LSYM),'_X_').EQ.0) !MESSAGE IF NOT X_ VALUE -C 1 CALL WNCTXT(DWLOG,'DWARF symbol !AS = !AS defined', -C 1 SYMBOL(:LSYM),VALUE(:LVAL)) -C -C Close PUT_PARM operations -C - IS = PP_CTL_CLOSE (PROGSTRM,FOREIGN) - IF (IAND(IS,1).EQ.0) GOTO 999 -C - PUT_PARM_N = DWC_SUCCESS - RETURN -C - 998 IS = PP_CTL_CLOSE (BLANK,FOREIGN) - 999 PUT_PARM_N = MSG_SET (DWC_PARAMERR,1) - CALL WNCTXT(DWLOG,DWMSG,PKEY) - RETURN - END -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - INTEGER*4 FUNCTION PUT_PARM_C (PKEY,VALSTR,PROGSTRM) -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' -C - CHARACTER*(*) PKEY ! (i) program's parameter name - CHARACTER*(*) VALSTR ! (i) value given as a string - CHARACTER*(*) PROGSTRM ! (i) target program and stream names -C -C.Purpose: Define an external default for a program parameter -C.Returns: Status code (.TRUE. for success, .FALSE. otherwise) -C success DWC_SUCCES -C error DWC_PARAMERR messages written -C.Notes: -C------------------------------------------------------------------------- -C -C - CHARACTER*(*) BLANK - PARAMETER (BLANK = ' ') -C - INTEGER*4 PP_ARG_CHECK - INTEGER*4 PP_CTL_OPEN, PP_CTL_CLOSE - INTEGER*4 DWC_STR_STANDARD - INTEGER*4 SYMBOL_DEFINE - INTEGER*4 MSG_SET -C - CHARACTER VALUE*255, SYMBOL*38 - INTEGER*4 IS, LVAL, LSYM - LOGICAL*4 FOREIGN -C -C - FOREIGN = .FALSE. -C -C Set up for PUT_PARM -C - IS = PP_CTL_OPEN (PKEY,PROGSTRM,SYMBOL,LSYM,FOREIGN) - IF (IAND(IS,1).EQ.0) GOTO 998 -C -C Convert the value to a proper string -C -C IS = DWC_STR_STANDARD (VALUE,LVAL,VALSTR) - IS = DWC_STR_STANDARD (VALSTR,VALUE,LVAL) - IF (LVAL.EQ.0) THEN - IS = MSG_SET (DWC_PARNOVAL,1) - CALL WNCTXT(DWLOG,DWMSG,PKEY) - END IF - IF (IAND(IS,1).EQ.0) GOTO 998 -C -C Define the DWARF symbol -C - IS = SYMBOL_DEFINE (SYMBOL(:LSYM),VALUE(:LVAL),DWC__GLOBALSYM) - IF (IAND(IS,1).EQ.0) GOTO 998 -C -C Write a log message at level 3 -C -C IF (INDEX(SYMBOL(:LSYM),'_X_').EQ.0) !MESSAGE IF NOT X_ VALUE -C 1 CALL WNCTXT(DWLOG,'DWARF symbol !AS = !AS defined', -C 1 SYMBOL(:LSYM),VALUE(:LVAL)) -C -C Close PUT_PARM operations -C -C - IS = PP_CTL_CLOSE (PROGSTRM,FOREIGN) - IF (IAND(IS,1).EQ.0) GOTO 999 -C - PUT_PARM_C = DWC_SUCCESS - RETURN -C - 998 IS = PP_CTL_CLOSE (BLANK,FOREIGN) - 999 PUT_PARM_C = MSG_SET (DWC_PARAMERR,1) - CALL WNCTXT(DWLOG,DWMSG,PKEY) - RETURN - END -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - INTEGER*4 FUNCTION PUT_PARM_G (SYMBOL,VALSTR) -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' -C - CHARACTER*(*) SYMBOL ! (i) name of global symbol - CHARACTER*(*) VALSTR ! (i) value given as a string -C -C.Purpose: Define an value for a global symbol -C.Returns: Status code (.TRUE. for success, .FALSE. otherwise) -C success DWC_SUCCES -C error DWC_PARAMERR messages written -C.Notes: -C------------------------------------------------------------------------- -C -C - CHARACTER*(*) BLANK - PARAMETER (BLANK = ' ') -C - INTEGER*4 DWC_STR_STANDARD - INTEGER*4 SYMBOL_DEFINE - INTEGER*4 MSG_SET - INTEGER*4 WNCAL0 -C - CHARACTER VALUE*255 - INTEGER*4 IS, LVAL, LSYM -C -C Convert the value to a proper string -C - IS = DWC_STR_STANDARD (VALSTR,VALUE,LVAL) - IF (LVAL.EQ.0) THEN - IS = MSG_SET (DWC_PARNOVAL,1) - CALL WNCTXT(DWLOG,DWMSG,SYMBOL) - END IF - IF (IAND(IS,1).EQ.0) GOTO 998 -C -C Define the DWARF symbol -C - LSYM=WNCAL0(SYMBOL) - IF (LSYM.EQ.0) GOTO 998 - IS = SYMBOL_DEFINE (SYMBOL(:LSYM),VALUE(:LVAL),DWC__GLOBALSYM) - IF (IAND(IS,1).EQ.0) GOTO 998 -C -C Write a log message at level 3 -C -C CALL WNCTXT(DWLOG,'DWARF symbol !AS = !AS defined', -C 1 SYMBOL(:LSYM),VALUE(:LVAL)) -C - PUT_PARM_G = DWC_SUCCESS - RETURN -C - 998 PUT_PARM_G = MSG_SET (DWC_PARAMERR,1) - CALL WNCTXT(DWLOG,DWMSG,SYMBOL) - RETURN - END - diff --git a/src/dwarf/pvblk.for b/src/dwarf/pvblk.for deleted file mode 100644 index 1b5dc94960fd75b51ddc8a152610308d0f5ad60f..0000000000000000000000000000000000000000 --- a/src/dwarf/pvblk.for +++ /dev/null @@ -1,580 +0,0 @@ -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ -C.Ident: PV_BLK -C.Keywords: Parameter Values, Block -C.Author: Friso Olnon (NFRA, Dwingeloo) -C.Language: DWARF-Fortran -C.Environment: VAX or Alliant -C.Comments: -C The fields in the value block descriptor are: -C VALBLK(1) = length of the block in bytes -C VALBLK(2) = address of the memory block -C = address of the array with the nr of used values per set -C VALBLK(3) = address of the value array -C VALBLK(4) = address of the array with the value-defined switches -C VALBLK(5) = nr of sets in the block -C VALBLK(6) = nr of reserved values per set -C VALBLK(7) = nr of bytes per value -C VALBLK(8) = OR-ed flags (1 = scalar parm, 2 = TOBY format) -C -C.Version: 900416 FMO - recreation -C.Version: 900830 FMO - corrected wrong TOBY switch in READ -C.Version: 910730 FMO - corrected scalar special set handling in READ -C.Version: 920214 GvD - no optional arguments in MSG anymore -C.Version: 920413 GvD - use log*4 iso, log*1 for switches-array (VALBLK(4)) -C put switches in front of values for alignment purposes -C.Version: 920508 GvD - do not allow TOBY for logical data -C.Version: 940117 CMV - indirect adressing, use WNGGVM i.s.o. GEN_GETVM -C------------------------------------------------------------------------- -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - INTEGER*4 FUNCTION PV_BLK () -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' -C -C -C.Purpose: Make source-module name known -C.Returns: Status code (.TRUE. for success, .FALSE. otherwise) -C success DWC_SUCCESS -C.Notes: Dummy function -C------------------------------------------------------------------------- -C - PV_BLK = DWC_SUCCESS - RETURN - END -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - INTEGER*4 FUNCTION PV_BLK_ALLOC (VALSTR,VALBLK) -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' -C - CHARACTER*(*) VALSTR ! (m) value string - INTEGER*4 VALBLK(8) ! (o) value block descriptor -C -C.Purpose: Allocate a value block to accommodate the value sets -C.Returns: Status code (.TRUE. for success, .FALSE. otherwise) -C success DWC_SUCCESS also if the string is blank -C false status codes returned by referenced routines -C.Notes: -C - Sets are delimited by semicolons (outside quoted substrings). -C - For scalars, commas outside quoted substrings and subexpressions -C (parenthesized substrings) are converted to semicolons. -C - If VALSTR is blank or an error occurs, VALBLK will be cleared. -C------------------------------------------------------------------------- -C - CHARACTER*(*) QUOTE, SCOLON, COMMA, OPNPAR, CLOPAR, DELIM - PARAMETER (QUOTE = '"') - PARAMETER (SCOLON = ';') - PARAMETER (COMMA = ',') - PARAMETER (OPNPAR = '(') - PARAMETER (CLOPAR = ')') - PARAMETER (DELIM = QUOTE//SCOLON//COMMA//OPNPAR//CLOPAR) - INTEGER*4 SCALAR_BIT, TOBY_BIT - PARAMETER (SCALAR_BIT = 0) - PARAMETER (TOBY_BIT = 1) -C - INTEGER*4 PPD_DTYPE_GET, PPD_NVAL_GET, PPD_AMAS_GET - INTEGER*4 STR_SIGLEN, STR_SKIP_U - INTEGER MSG_SET, CLEAR_BLJ - LOGICAL WNGGVM -C - CHARACTER*1 DTYPE - INTEGER*4 LVAL, NRVPS, MNVPS, MXVPS, FLAGS - INTEGER*4 IS, LSTR, PTR, DEPTH, NRSETS -C -C -C Clear the block descriptor -C - if blank value string: return -C - IS = CLEAR_BLJ (VALBLK,8) - IF (IAND(IS,1).EQ.0) GOTO 999 - LSTR = STR_SIGLEN (VALSTR) - IF (LSTR.EQ.0) GOTO 900 -C -C Get info from PPD file -C - IS = PPD_DTYPE_GET (DTYPE,LVAL) ! length of a value - IF (IAND(IS,1).NE.0) IS = PPD_NVAL_GET (NRVPS,MNVPS,MXVPS) ! nr of values per set - IF (IAND(IS,1).EQ.0) GOTO 999 - FLAGS = 0 - IF (NRVPS.EQ.1) ! scalar type - 1 FLAGS = IBSET (FLAGS,SCALAR_BIT) - IF (DTYPE.NE.'C' .AND. DTYPE.NE.'L' - 1 .AND. IAND(PPD_AMAS_GET('VECTOR'),1).EQ.0) ! TOBY format - 1 FLAGS = IBSET (FLAGS,TOBY_BIT) -C -C For scalar value string: -C - skip through quoted substrings -C - count nr of semicolons -C - keep track of the subexpression -C depth, i.e. nr of '(' - nr of ')' -C - skip through subexpressions -C - convert commas to semicolons -C - NRSETS = 1 - PTR = 1 - IF (BTEST(FLAGS,SCALAR_BIT)) THEN - DEPTH = 0 - IS = STR_SKIP_U (DELIM,VALSTR(:LSTR),PTR) - DO WHILE (PTR.LE.LSTR) - IF (VALSTR(PTR:PTR).EQ.QUOTE) THEN - PTR = PTR+1 - IS = STR_SKIP_U (QUOTE,VALSTR(:LSTR),PTR) - ELSE IF (VALSTR(PTR:PTR).EQ.SCOLON) THEN - NRSETS = NRSETS+1 - ELSE IF (VALSTR(PTR:PTR).EQ.OPNPAR) THEN - DEPTH = DEPTH+1 - ELSE IF (VALSTR(PTR:PTR).EQ.CLOPAR) THEN - DEPTH = DEPTH-1 - ELSE IF (DEPTH.EQ.0) THEN - VALSTR(PTR:PTR) = SCOLON - NRSETS = NRSETS+1 - ENDIF - PTR = PTR+1 - IS = STR_SKIP_U (DELIM,VALSTR(:LSTR),PTR) - ENDDO -C -C For non-scalar value string: -C - skip through quoted substrings -C - count nr of semicolons -C - ELSE - IS = STR_SKIP_U (QUOTE//SCOLON,VALSTR(:LSTR),PTR) - DO WHILE (PTR.LE.LSTR) - IF (VALSTR(PTR:PTR).EQ.QUOTE) THEN - PTR = PTR+1 - IS = STR_SKIP_U (QUOTE,VALSTR(:LSTR),PTR) - ELSE - NRSETS = NRSETS+1 - ENDIF - PTR = PTR+1 - IS = STR_SKIP_U (QUOTE//SCOLON,VALSTR(:LSTR),PTR) - ENDDO - ENDIF -C -C Allocate memory for the value block -C and fill the descriptor array -C - IS=DWC_SUCCESS - IF (BTEST(FLAGS,TOBY_BIT)) NRVPS = 3*NRVPS ! res nr vals/set - VALBLK(1) = NRSETS*(4+NRVPS*(LVAL+4)) ! length value block - IF (.NOT.WNGGVM(VALBLK(1),VALBLK(2))) THEN ! get VM address - IS=MSG_SET(DWC_PPDNOVIRT,1) - CALL WNCTXT(DWLOG,DWMSG,VALBLK(1)) - GOTO 997 - END IF - IF (IAND(IS,1).EQ.0) GOTO 998 - VALBLK(4) = VALBLK(2)+NRSETS*4 ! address switch array - VALBLK(3) = VALBLK(4)+NRSETS*NRVPS*4 ! address value array - VALBLK(5) = NRSETS ! nr sets - VALBLK(6) = NRVPS - VALBLK(7) = LVAL - VALBLK(8) = FLAGS -C -C - 900 PV_BLK_ALLOC = DWC_SUCCESS - RETURN - 998 PV_BLK_ALLOC = MSG_SET (IS,0) - 997 IS = CLEAR_BLJ (VALBLK,8) - RETURN - 999 PV_BLK_ALLOC = IS - RETURN - END -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - INTEGER*4 FUNCTION PV_BLK_RELEASE (VALBLK) -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' -C - INTEGER*4 VALBLK(8) ! (m) value block descriptor -C -C.Purpose: Release the value block -C.Returns: Status code (.TRUE. for success, .FALSE. otherwise) -C success DWC_SUCCESS -C false status code from referenced routine -C.Notes: -C - The value block descriptor will always be cleared. -C------------------------------------------------------------------------- -C - INTEGER CLEAR_BLJ, MSG_SET - LOGICAL WNGFVM -C - INTEGER*4 IS -C -C - IF (VALBLK(1).NE.0.AND.VALBLK(2).NE.0) THEN - IF (.NOT.WNGFVM(VALBLK(1),VALBLK(2))) THEN - IS = DWC_PPDFRVIRT -C type*,'Yeergh' - IS = MSG_SET (IS,0) - END IF - ENDIF - IS = CLEAR_BLJ (VALBLK,8) - IF (IAND(IS,1).EQ.0) GOTO 999 -C - PV_BLK_RELEASE = DWC_SUCCESS - RETURN - 999 PV_BLK_RELEASE = IS - RETURN - END -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - INTEGER*4 FUNCTION PV_BLK_READ (VALBLK,SETNR,VALNR,COUNT,ARROUT, - 1 NROUT,SWDEF,STRING,LSTR) -C - INCLUDE 'WNG_DEF' ! For indirect addressing - INCLUDE 'DWC_DEF' -C - INTEGER*4 VALBLK(8) ! (i) value block descriptor - INTEGER*4 SETNR ! (m) nr of current set - INTEGER*4 VALNR ! (m) nr of value in current set - INTEGER*4 COUNT ! (m) counter in set for TO/BY arrays - BYTE ARROUT(*) ! (o) next value set - INTEGER*4 NROUT ! (o) nr of values in ARROUT - LOGICAL*4 SWDEF ! (i) is ARRAY a default value ? - CHARACTER*(*) STRING ! (o) next value set as a string - INTEGER*4 LSTR ! (o) length of value string -C -C.Purpose: Get the next value set from a value block -C.Returns: Status code (.TRUE. for success, .FALSE. otherwise) -C success DWC_SUCCESS -C warning 0 end of block is reached (always for zero block) -C false status codes returned by referenced routines -C.Notes: -C - The value set will be returned both as a string and as an array. -C - The output string can be in TOBY format. -C - The output array is in normal format (converted from TOBY when -C necessary) unless it concerns a default value set. -C - NROUT can be 0 ("null" set) or -1 ("wild" set); in those cases -C the contents of ARROUT are undetermined. -C - The routine will maintain the pointers SETNR, VALNR and COUNT. -C------------------------------------------------------------------------- -C - CHARACTER*(*) BLANK - INTEGER*4 SCALAR_BIT, TOBY_BIT - PARAMETER (BLANK = ' ') - PARAMETER (SCALAR_BIT = 0) - PARAMETER (TOBY_BIT = 1) -C - INTEGER*4 PV_SET_READ, PV_SET_ENCODE, PV_VAL_ENCODE - INTEGER*4 PPD_DTYPE_GET - INTEGER*4 MOVE_BLB, MOVE_BLJ -C - CHARACTER*1 DTYPE - INTEGER*4 IS, ANVPS, AVAL, PLEN, NR - LOGICAL*4 TOBY -C -C -C - STRING = BLANK - LSTR = 0 - IF (VALBLK(2).EQ.0) GOTO 990 - IS = PPD_DTYPE_GET (DTYPE,PLEN) - IF (IAND(IS,1).EQ.0) GOTO 999 -C -C SCALAR -C ====== -C - IF (BTEST(VALBLK(8),SCALAR_BIT)) THEN - NROUT = UNDEF_J - DO WHILE (NROUT.EQ.UNDEF_J) -C -C If there is a current set: -C - special set: set exhausted -C - else: extract the next value -C - if found: ready -C - else: set exhausted -C - IF (SETNR.GT.0) THEN - ANVPS = VALBLK(2)+(SETNR-1)*4-A_OB - AVAL = VALBLK(3)+(SETNR-1)*VALBLK(6)*VALBLK(7)-A_OB - IS = MOVE_BLJ (A_B(ANVPS),NR,1) - IF (NR.GT.0) THEN - IS = PV_SET_READ (DTYPE,VALBLK(7),A_B(ANVPS), - 1 A_B(AVAL),VALNR,COUNT,ARROUT) - IF (IAND(IS,1).NE.0) THEN - NROUT = 1 - ELSE IF (IS.NE.0) THEN - GOTO 999 - ENDIF - ENDIF - ENDIF -C -C If first time or exhausted set: -C - move to the next set -C - if this is a special set: ready -C - IF (NROUT.EQ.UNDEF_J) THEN - SETNR = SETNR+1 - IF (SETNR.GT.VALBLK(5)) GOTO 990 - VALNR = 0 - ANVPS = VALBLK(2)+(SETNR-1)*4-A_OB - IS = MOVE_BLJ (A_B(ANVPS),NROUT,1) - IF (IAND(IS,1).EQ.0) GOTO 999 - IF (NROUT.GT.0) NROUT = UNDEF_J - ENDIF - ENDDO -C -C Convert the value set to a string -C - for normal sets: use VAL_ENCODE -C to suppress TOBY output format -C - IF (NROUT.EQ.1) THEN - IS = PV_VAL_ENCODE (DTYPE,VALBLK(7),ARROUT,STRING,LSTR) - ELSE - TOBY = BTEST (VALBLK(8),TOBY_BIT) - IS = PV_SET_ENCODE (DTYPE,VALBLK(7),NROUT,ARROUT,TOBY, - 1 STRING,LSTR) - ENDIF - IF (IAND(IS,1).EQ.0) GOTO 999 -C -C ARRAY OR VECTOR -C =============== -C - ELSE -C -C Get the first or next value set -C and convert it to a string -C - SETNR = SETNR+1 - IF (SETNR.GT.VALBLK(5)) GOTO 990 - VALNR = 0 - ANVPS = VALBLK(2)+(SETNR-1)*4-A_OB - AVAL = VALBLK(3)+(SETNR-1)*VALBLK(6)*VALBLK(7)-A_OB - IS = MOVE_BLJ (A_B(ANVPS),NROUT,1) - TOBY = BTEST (VALBLK(8),TOBY_BIT) - IS = PV_SET_ENCODE (DTYPE,VALBLK(7),NROUT,A_B(AVAL),TOBY, - 1 STRING,LSTR) - IF (IAND(IS,1).EQ.0) GOTO 999 -C -C If it is not a special value set: -C - copy it to the output array (possibly -C after conversion from TOBY format) -C - IF (NROUT.GT.0) THEN - IF (.NOT.BTEST(VALBLK(8),TOBY_BIT) .OR. SWDEF) THEN - IS = MOVE_BLB (A_B(AVAL),ARROUT,VALBLK(7)*NROUT) - IF (IAND(IS,1).EQ.0) GOTO 999 - ELSE - NROUT = 0 - IS = 1 - DO WHILE (IAND(IS,1).NE.0) - IS = PV_SET_READ (DTYPE,VALBLK(7),A_B(ANVPS), - 1 A_B(AVAL),VALNR,COUNT, - 2 ARROUT(NROUT*VALBLK(7)+1)) - IF (IAND(IS,1).NE.0) NROUT = NROUT+1 - ENDDO - IF (IS.NE.0) GOTO 999 - ENDIF - ENDIF - ENDIF -C - PV_BLK_READ = DWC_SUCCESS - RETURN - 990 PV_BLK_READ = 0 - RETURN - 999 PV_BLK_READ = IS - RETURN - END -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - INTEGER*4 FUNCTION PV_BLK_ENCODE (VALBLK,STRING,LSTR) -C - INCLUDE 'WNG_DEF' ! For indirect addressing - INCLUDE 'DWC_DEF' -C - INTEGER*4 VALBLK(8) ! (i) value block descriptor - CHARACTER*(*) STRING ! (o) value string - INTEGER*4 LSTR ! (o) significant length of STRING -C -C.Purpose: Convert a value block to a standard value string -C.Returns: Status code (.TRUE. for success, .FALSE. otherwise) -C success DWC_SUCCESS also for empty block -C warning DWC_STRTOOSHO output string has been truncated -C false status codes returned by referenced routines -C.Notes: -C - The value string is created according to DWCL syntax rules. -C - The values in a set will be separated by comma's, and sets will be -C separated by semicolons. -C - LSTR = 0 for an empty block. -C------------------------------------------------------------------------- -C - CHARACTER*(*) BLANK, SETDELIM - INTEGER*4 TOBY_BIT - PARAMETER (BLANK = ' ') - PARAMETER (SETDELIM = ';') - PARAMETER (TOBY_BIT = 1) -C - INTEGER*4 PV_SET_ENCODE - INTEGER*4 PPD_DTYPE_GET - INTEGER MSG_SET, STR_COPY -C - CHARACTER*1 DTYPE - INTEGER*4 IS, LADD, SETNR, ANVPS, AVAL, PLEN - LOGICAL*4 TOBY -C -C -C Convert set for set -C - STRING = BLANK - LSTR = 0 - IS = PPD_DTYPE_GET (DTYPE,PLEN) - IF (IAND(IS,1).EQ.0) GOTO 999 - ANVPS = VALBLK(2)-A_OB - AVAL = VALBLK(3)-A_OB - TOBY = BTEST (VALBLK(8),TOBY_BIT) - DO SETNR = 1,VALBLK(5) - IS = PV_SET_ENCODE (DTYPE,VALBLK(7),A_B(ANVPS), - 1 A_B(AVAL),TOBY,STRING(LSTR+1:),LADD) - IF (IAND(IS,1).EQ.0) GOTO 999 - LSTR = LSTR+LADD - IF (SETNR.NE.VALBLK(5)) THEN - IS = STR_COPY (SETDELIM,STRING,LSTR) - IF (IS.LT.0) GOTO 990 - ENDIF - ANVPS = ANVPS+LB_J - AVAL = AVAL+VALBLK(6)*VALBLK(7) - ENDDO -C - PV_BLK_ENCODE = DWC_SUCCESS - RETURN - 990 PV_BLK_ENCODE = MSG_SET (DWC_STRTOOSHO,1) - CALL WNCTXT(DWLOG,DWMSG,LEN(STRING)) - RETURN - 999 PV_BLK_ENCODE = IS - RETURN - END -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - INTEGER*4 FUNCTION PV_BLK_DECODE (STRING,VALBLK,STREAM,CHKSW, - 1 SWSYM,SWDV,DEFARR,NRDEF) -C - INCLUDE 'WNG_DEF' ! For indirect addressing - INCLUDE 'DWC_DEF' -C - CHARACTER*(*) STRING ! (i) value string - INTEGER*4 VALBLK(8) ! (i) value block descriptor - CHARACTER*(*) STREAM ! (i) stream name (for substitution) - LOGICAL*4 CHKSW ! (i) unknown symbols allowed ? - LOGICAL*4 SWSYM ! (o) unknown symbols found ? - LOGICAL*4 SWDV ! (i) default value string ? - BYTE DEFARR(*) ! (i) default set - INTEGER*4 NRDEF ! (i) nr of values in DEFARR -C -C.Purpose: Convert a value string to a value block -C.Returns: Status code (.TRUE. for success, .FALSE. otherwise) -C success DWC_SUCCESS also for empty string -C error DWC_CHKERRMSG error in value checking -C false status codes returned by referenced modules -C.Notes: -C - VALBLK must have been created via PV_BLK_ALLOC (STRING,VALBLK). -C - Value sets are delimited by semicolons (outside quoted substrings). -C - Values within a set are delimited by commas. -C - Numerical values can be given as expressions; these will be evaluated -C after substitution of any symbol names in the expression. -C - Values that are not given by the user will be replaced by the -C corresponding default values (if present), unless the parameter -C has the UNDEFINED attribute. For scalars and arrays only explicitly -C undefined values will be defaulted; for vectors all undefined values -C will be defaulted. E.g. for a 5-valued parameter: -C 1,,2, -> 1,def,2,def (array) -C 1,,2, -> 1,def,2,def,def (vector) -C - If the parameter is a node name, relative names (with dots and minus -C signs) will be expanded using the current node name. A trailing colon -C in the node specification is interpreted as a directive to set the -C current node. If it is given, all subsequent relative node names in -C the value block will be expanded using the new current node. DWARF's -C current node will not yet be changed. -C - If no unknown symbols were found (SWSYM = .FALSE.), the values in -C the block will be checked against the PPD requirements. -C------------------------------------------------------------------------- -C - CHARACTER*(*) BLANK, QUOTE, SETDELIM - INTEGER*4 TOBY_BIT - PARAMETER (BLANK = ' ') - PARAMETER (QUOTE = '"') - PARAMETER (SETDELIM = ';') - PARAMETER (TOBY_BIT = 1) -C - INTEGER*4 PV_SET_DECODE - INTEGER*4 DWC_NODE_EXPAND_A - INTEGER*4 PPD_DTYPE_GET, PPD_CMAS_GET, PPD_CHECK - INTEGER*4 STR_SKIP_U - INTEGER MSG_SET -C - CHARACTER DTYPE*1 - INTEGER*4 IS, LSTR, PTR, START, ANVPS, AVAL, ASW, PLEN - LOGICAL*4 TOBY -C -C - LSTR = LEN (STRING) - IF (LSTR.EQ.0) GOTO 900 ! no value - IS = PPD_DTYPE_GET (DTYPE,PLEN) - IF (IAND(IS,1).EQ.0) GOTO 999 - ANVPS = VALBLK(2)-A_OB - AVAL = VALBLK(3) -A_OB - ASW = VALBLK(4) -A_OB - TOBY = BTEST (VALBLK(8),TOBY_BIT) -C -C Decode set by set -C - isolate the next set -C - allow for a trailing set delimiter -C - START = 1 - PTR = 1 - DO WHILE (PTR.LE.LSTR+1) - IS = STR_SKIP_U (QUOTE//SETDELIM,STRING(:LSTR),PTR) -C -C - start of quoted substring: skip -C through the whole substring -C - IF (PTR.LE.LSTR .AND. STRING(PTR:PTR).EQ.QUOTE) THEN - PTR = PTR+1 - IS = STR_SKIP_U (QUOTE,STRING(:LSTR),PTR) - PTR = PTR+1 - IF (PTR.GT.LSTR+1) PTR = LSTR+1 ! no end quote -C -C - set complete: decode it, clear the -C buffer, and go for the next set -C - ELSE - IS = PV_SET_DECODE (STRING(START:PTR-1), - 1 DTYPE,VALBLK(7),VALBLK(6),A_B(AVAL), - 2 A_B(ANVPS),A_B(ASW),STREAM,CHKSW,SWSYM, - 3 SWDV,TOBY,DEFARR,NRDEF) - IF (IAND(IS,1).EQ.0) GOTO 999 - PTR = PTR+1 - START = PTR - ANVPS = ANVPS+LB_J - AVAL = AVAL+VALBLK(6)*VALBLK(7) - ASW = ASW+VALBLK(6)*LB_J - ENDIF - ENDDO -C -C If node name: expand all names in block -C - IF (IAND(PPD_CMAS_GET('NODE'),1) .NE. 0) THEN - ANVPS = VALBLK(2)-A_OB - AVAL = VALBLK(3) -A_OB - ASW = VALBLK(4) -A_OB - IS = DWC_NODE_EXPAND_A (VALBLK(5),VALBLK(6),VALBLK(7), - 1 A_B(AVAL),A_B(ANVPS)) - IF (IAND(IS,1).EQ.0) GOTO 999 - ENDIF -C -C Check the values -C - IF (.NOT.SWSYM) THEN - ANVPS = VALBLK(2)-A_OB - AVAL = VALBLK(3) -A_OB - ASW = VALBLK(4) -A_OB - IS = PPD_CHECK (A_B(AVAL),A_B(ANVPS),VALBLK(6), - 1 A_B(ASW),VALBLK(5)) - IF (IAND(IS,1).EQ.0) GOTO 991 - ENDIF -C - 900 PV_BLK_DECODE = DWC_SUCCESS - RETURN - 991 PV_BLK_DECODE = MSG_SET (DWC_CHKERRMSG,1) - CALL WNCTXT(DWLOG,DWMSG,BLANK,STRING) - RETURN - 999 PV_BLK_DECODE = IS - RETURN - END - diff --git a/src/dwarf/pvdef.for b/src/dwarf/pvdef.for deleted file mode 100644 index b3450b1dfbdcd944c9996dd5a22e53412af4c773..0000000000000000000000000000000000000000 --- a/src/dwarf/pvdef.for +++ /dev/null @@ -1,331 +0,0 @@ -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ -C.Ident: PV_DEF -C.Keywords: Program Parameters, Default Values -C.Author: Friso Olnon (NFRA, Dwingeloo) -C.Language: DWARF-Fortran -C.Environment: VAX or Alliant -C.Comments: -C.Version: 900416 FMO - recreation -C.Version: 920214 GvD - no optional arguments in MSG anymore -C.Version: 920508 GvD - do not allow TOBY for logical values -C.Version: 940117 CMV - use WNGARA i.s.o. GEN_ADDRESS -C------------------------------------------------------------------------- -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - INTEGER*4 FUNCTION PV_DEF () -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' -C -C -C.Purpose: Make source module name known -C.Returns: Status code (.TRUE. for success, .FALSE. otherwise) -C success DWC_SUCCESS -C.Notes: -C------------------------------------------------------------------------- -C -C - PV_DEF = DWC_SUCCESS - RETURN - END -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - INTEGER*4 FUNCTION PV_DEF_GET (SYMBOL,DEFSTR,LDEF,DEFTYP,LTYP) -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' -C - CHARACTER*(*) SYMBOL ! (i) symbol name - CHARACTER*(*) DEFSTR ! (o) default value - INTEGER*4 LDEF ! (o) significant length of DEFSTR - CHARACTER*(*) DEFTYP ! (o) type of default value - INTEGER*4 LTYP ! (o) significant length of DEFTYP -C -C.Purpose: Get the default value sets for a program parameter -C.Returns: Status code (.TRUE. for success, .FALSE. otherwise) -C success DWC_SUCCESS -C false status codes returned by referenced routines -C.Notes: -C - SYMBOL is the full parameter name (prognam$stream_keyword). -C - The PPD search-sequence string determines what kind of defaults are -C allowed (local, group, program) and these are looked for in the order: -C stream-specific local in DWARF symbol <prog>$<stream>_<key> -C all-stream local " <prog>$0_<key> -C stream-specific group " <group>$<stream>_<key> -C all-stream group " <group>$0_<key> -C program in PPD file -C - DEFTYP tells where the default came from: -C 'local', 'local$0', <group>, <group>//'$0', 'program' or <blank>, -C where <group> denotes the group name (uppercase). -C - LTYP gives the corresponding length (=0 for <blank>). If DEFTYP is -C too short the type string will be truncated (considered successfull). -C - If a program default is allowed, type 'program' will be returned -C even if there is no PPD default, because the caller can provide a -C default in the argument list of GET_PARM. -C - If no default is found, LDEF = 0 will be returned. -C------------------------------------------------------------------------- -C -C - CHARACTER*(*) BLANK - PARAMETER (BLANK = ' ') -C - INTEGER*4 DWC_SYM_SPLIT, DWC_SYM_BUILD, DWC_STREAM_GET - INTEGER*4 PPD_SSTR_GET, PPD_DVSTR_GET - INTEGER*4 STR_SIGLEN, SYMBOL_GET -C - CHARACTER*16 PROG, STREAM, KEY, ALLSTREAM, SSTR, GROUP, WORK*50 - INTEGER*4 IS, LP, LS, LK, LA, LSSTR, LG, LW -C -C - DEFSTR = BLANK - LDEF = 0 -C -C Set up: -C - split symbol name in its components -C - get the all-stream name -C - get the default-search procedure -C and the possible group name -C - IS = DWC_SYM_SPLIT (SYMBOL,PROG,LP,STREAM,LS,KEY,LK) - IF (IAND(IS,1).NE.0) IS = DWC_STREAM_GET (ALLSTREAM,LA,.TRUE.) - IF (IAND(IS,1).NE.0) IS = PPD_SSTR_GET (SSTR,LSSTR,GROUP,LG) - IF (IAND(IS,1).EQ.0) GOTO 999 -C -C Stream-specific local default ? -C - IF (INDEX(SSTR(:LSSTR),'L').NE.0) THEN - IS = SYMBOL_GET (SYMBOL,DEFSTR,LDEF) - IF (IAND(IS,1).EQ.0) GOTO 999 - IF (LDEF.GT.0) THEN - DEFTYP = 'local' - GOTO 900 ! ready -C -C All-stream local default ? -C - ELSE IF (STREAM(:LS).NE.ALLSTREAM(:LA)) THEN - IS = DWC_SYM_BUILD (PROG(:LP),ALLSTREAM(:LA),KEY(:LK),WORK,LW) - IF (IAND(IS,1).NE.0) IS = SYMBOL_GET (WORK(:LW),DEFSTR,LDEF) - IF (IAND(IS,1).EQ.0) GOTO 999 - IF (LDEF.GT.0) THEN - DEFTYP = 'local'//ALLSTREAM(:LA) - GOTO 900 ! ready - ENDIF - ENDIF - ENDIF -C -C Stream-specific group default ? -C - IF (INDEX(SSTR(:LSSTR),'G').NE.0) THEN - IS = DWC_SYM_BUILD (GROUP(:LG),STREAM(:LS),KEY(:LK),WORK,LW) - IF (IAND(IS,1).NE.0) IS = SYMBOL_GET (WORK(:LW),DEFSTR,LDEF) - IF (IAND(IS,1).EQ.0) GOTO 999 - IF (LDEF.GT.0) THEN - DEFTYP = GROUP(:LG) - GOTO 900 ! ready -C -C All-stream local default ? -C - ELSE IF (STREAM(:LS).NE.ALLSTREAM(:LA)) THEN - IS = DWC_SYM_BUILD (GROUP(:LG),ALLSTREAM(:LA),KEY(:LK),WORK,LW) - IF (IAND(IS,1).NE.0) IS = SYMBOL_GET (WORK(:LW),DEFSTR,LDEF) - IF (IAND(IS,1).EQ.0) GOTO 999 - IF (LDEF.GT.0) THEN - DEFTYP = GROUP(:LG)//ALLSTREAM(:LA) - GOTO 900 ! ready - ENDIF - ENDIF - ENDIF -C -C Program default allowed ? -C - look for a PPD default -C - IF (INDEX(SSTR(:LSSTR),'P').NE.0) THEN - DEFTYP = 'program' - IS = PPD_DVSTR_GET (DEFSTR,LDEF) - IF (IAND(IS,1).EQ.0) GOTO 999 - GOTO 900 ! ready - ENDIF -C -C So, no local or group default found -C and no program default allowed -C - DEFTYP = BLANK - LTYP = 0 - PV_DEF_GET = DWC_SUCCESS - RETURN -C - 900 LTYP = STR_SIGLEN (DEFTYP) - PV_DEF_GET = DWC_SUCCESS - RETURN -C - 999 PV_DEF_GET = IS - RETURN - END -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - INTEGER*4 FUNCTION PV_DEF_DECODE (DEFAULT,LDEF,VALBLK) -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' -C - CHARACTER*(*) DEFAULT ! (i) value string - INTEGER*4 LDEF ! (i) significant length of DEFAULT - INTEGER*4 VALBLK(8) ! (o) value block descriptor -C -C.Purpose: Convert the default string to a value block -C.Returns: Status code (.TRUE. for success, .FALSE. otherwise) -C success DWC_SUCCESS -C error DWC_PARWRDEF error in default -C.Notes: -C - There can be no unknown symbols, help request or qualifiers. -C - Allocate virtual memory for the value block (filled by PV_BLK_DECODE). -C------------------------------------------------------------------------- -C -C - INTEGER*4 DWC_STREAM_GET - INTEGER*4 PV_BLK_ALLOC, PV_BLK_DECODE, PV_BLK_RELEASE - INTEGER*4 MSG_SET -C - CHARACTER STREAM*16 - INTEGER*4 IS, LS - LOGICAL*4 SWSYM - BYTE DEFARR(1) ! dummy -C -C -C Allocate memory for the value block -C - IS = PV_BLK_ALLOC (DEFAULT(:LDEF),VALBLK) - IF (IAND(IS,1).EQ.0) GOTO 999 - IF (VALBLK(2).EQ.0) GOTO 999 -C -C Convert value string to value block -C - no unknown symbols allowed -C - release value block in case of error -C - SWSYM = .FALSE. - IS = DWC_STREAM_GET (STREAM,LS,.FALSE.) - IF (IAND(IS,1).EQ.0) GOTO 999 - IS = PV_BLK_DECODE (DEFAULT(:LDEF),VALBLK,STREAM(:LS), - 1 .FALSE.,SWSYM,.TRUE.,DEFARR,0) - IF (IAND(IS,1).EQ.0) THEN - IS = PV_BLK_RELEASE (VALBLK) - GOTO 999 - ENDIF -C -C - PV_DEF_DECODE = DWC_SUCCESS - RETURN -C - 999 PV_DEF_DECODE = MSG_SET (DWC_PARWRDEF,1) - CALL WNCTXT(DWLOG,DWMSG,' ') - RETURN - END -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - INTEGER*4 FUNCTION PV_DEF_ENCODE (DEFARR,NRDEF,LDARR,FLAGS, - 1 VALSTR,LVAL) -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' -C - BYTE DEFARR(*) ! (i) default value (given as an array) - INTEGER*4 NRDEF ! (i) nr of elements in DEFARR - INTEGER*4 LDARR ! (i) length of DEFARR elements - INTEGER*4 FLAGS ! (i) flags to control GET_PARM - CHARACTER*(*) VALSTR ! (o) default as standard value string - INTEGER*4 LVAL ! (o) significant length of VALSTR -C -C.Purpose: Convert a default array to a standard default string -C.Returns: Status code (.TRUE. for success, .FALSE. otherwise) -C success DWC_SUCCESS -C fatal DWC_TBNOTALL TOBY format is not allowed -C fatal DWC_TBNOMULT TOBY format, but NRDEF is not a multiple of 3 -C fatal DWC_TOOMANSET DEFARR contains too many sets -C false status codes returned by referenced modules -C.Notes: -C - The data type of the array is determined by the PPD file. -C - If the flag PARM__TOBY is given, the array is assumed to be in TOBY -C format (triplets: start, end, increment) in which case NRDEF must -C be a multiple of 3. -C------------------------------------------------------------------------- -C -C - INTEGER*4 MAXSET - PARAMETER (MAXSET = 25) -C - INTEGER*4 PV_BLK_ENCODE - INTEGER*4 PPD_DTYPE_GET, PPD_NVAL_GET, PPD_AMAS_GET - INTEGER*4 MSG_SET , WNGARA -C - CHARACTER DTYPE*1 - INTEGER*4 IS, PLEN, NRVPS, MNVPS, MXVPS - INTEGER*4 NRSETS, NRVAL(MAXSET), VALBLK(8) - LOGICAL*4 SWTOBY -C -C -C Get the size of the value and the -C required number of values per set -C - IS = PPD_DTYPE_GET (DTYPE,PLEN) - IF (IAND(IS,1).NE.0) IS = PPD_NVAL_GET (NRVPS,MNVPS,MXVPS) - IF (IAND(IS,1).EQ.0) GOTO 999 ! shouldn't occur -C -C TOBY format given and allowed ? -C if so: is NRDEF a multiple of 3 ? -C - SWTOBY = IAND(FLAGS,PARM__TOBY).NE.0 - IF (SWTOBY) THEN - IF (DTYPE.EQ.'C' .OR. DTYPE.EQ.'L' - 1 .OR. IAND(PPD_AMAS_GET('VECTOR'),1).NE.0) GOTO 991 - IF (MOD(NRDEF,3).NE.0) GOTO 992 - ENDIF -C -C Determine the nr of sets -C and the nr of values per set -C - IF (NRDEF.EQ.UNDEF_J) THEN ! 1-element array - NRVPS = 1 - NRSETS = 1 - NRVAL(1) = 1 - ELSE IF (NRDEF.LE.0) THEN ! "null" or "wild": - NRSETS = 1 ! can only be 1 set - NRVAL(1) = NRDEF - ELSE IF (NRVPS.EQ.1) THEN ! normal scalar: - NRVPS = NRDEF ! put all values - NRSETS = 1 ! in one set - NRVAL(1) = NRDEF - ELSE ! normal vector - IF (SWTOBY) NRVPS = NRVPS*3 ! or array - NRSETS = 1+(NRDEF-1)/NRVPS - IF (NRSETS.GT.MAXSET) GOTO 993 - DO I = 1,NRSETS-1 ! assume full sets - NRVAL(I) = NRVPS ! except for last one - ENDDO ! (rest of values) - NRVAL(NRSETS) = NRDEF-(NRSETS-1)*NRVPS - ENDIF -C -C Convert the array to a string -C - VALBLK(1) = 0 ! dummy length - VALBLK(2) = WNGARA(NRVAL) ! addr nrval/set array - VALBLK(3) = WNGARA(DEFARR) ! addr value array - VALBLK(4) = 0 ! dummy addr - VALBLK(5) = NRSETS ! nr sets - VALBLK(6) = NRVPS ! nr reserved vals/set - VALBLK(7) = LDARR ! nr bytes/value - VALBLK(8) = 0 ! flags (TOBY form ?) - IF (SWTOBY) VALBLK(8) = 2 - IS = PV_BLK_ENCODE (VALBLK,VALSTR,LVAL) - IF (IAND(IS,1).EQ.0) GOTO 999 -C -C - PV_DEF_ENCODE = DWC_SUCCESS - RETURN -C - 991 PV_DEF_ENCODE = MSG_SET (DWC_TBNOTALL,0) - RETURN - 992 PV_DEF_ENCODE = MSG_SET (DWC_TBNOMULT,0) - RETURN - 993 PV_DEF_ENCODE = MSG_SET (DWC_TOOMANSET,1) - CALL WNCTXT(DWLOG,DWMSG,NRSETS,MAXSET) - RETURN -C - 999 PV_DEF_ENCODE = IS - RETURN - END diff --git a/src/dwarf/pvset.for b/src/dwarf/pvset.for deleted file mode 100644 index caa5612bd83a08a7a53ca7dc968751feaa8e7853..0000000000000000000000000000000000000000 --- a/src/dwarf/pvset.for +++ /dev/null @@ -1,986 +0,0 @@ -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ -C.Ident: PV_SET -C.Keywords: Parameter Values, Sets -C.Author: Friso Olnon (NFRA, Dwingeloo) -C.Language: DWARF-Fortran -C.Environment: VAX or Alliant -C.Comments: -C.Version: 900421 FMO - recreation -C.Version: 900831 FMO - split PV_SET_TOBY -C.Version: 911227 GvD - use symbolic names PARM__ in PV_SET_ENCODE -C handle PARM__EOF -C.Version: 920214 GvD - no optional arguments in MSG anymore -C.Version: 920508 GvD - convert logical values to correct format -C.Version: 930413 WNB - cater for < .5 increment if integer -C------------------------------------------------------------------------ -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - INTEGER*4 FUNCTION PV_SET () -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' -C -C -C.Purpose: Make source module name known -C.Returns: Status code (.TRUE. for success, .FALSE. otherwise) -C success DWC_SUCCESS -C.Notes: Dummy function -C------------------------------------------------------------------------- -C - PV_SET = DWC_SUCCESS - RETURN - END -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - INTEGER*4 FUNCTION PV_SET_ENCODE (DTYPE,LARR,NRARR,ARRAY,TOBY, - 1 STRING,LSTR) -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' -C - CHARACTER*1 DTYPE ! (i) data type (B,I,J,R,D,L,C) - INTEGER*4 LARR ! (i) length of each value (bytes) - INTEGER*4 NRARR ! (i) nr of values in the set - BYTE ARRAY(LARR,*) ! (i) value set - LOGICAL*4 TOBY ! (i) in TOBY format ? - CHARACTER*(*) STRING ! (o) value string - INTEGER*4 LSTR ! (o) significant length of STRING -C -C.Purpose: Convert a value set to a value string -C.Returns: Status code (.TRUE. for success, .FALSE. otherwise) -C success DWC_SUCCESS -C warning DWC_STRTOOSHO string is truncated -C false status codes returned by referenced modules -C.Notes: -C - NRARR = 0 indicates a "null" set; it will be converted to a double -C quote (""). -C - NRARR = -1 indicates a "wild" set; it will be converted to an -C asterisk (*). -C - NRARR = -2 indicates an "eof" set; it will be converted to a -C num-sign (#). -C - The values in the string will be separated by comma's. -C - If the output string is too short, the offending value (and its -C delimiter) is not put out. -C Character (data type 'C'): -C - Undefined values (starting with UNDEF_C) will be converted to empty -C string fields e.g. ,,). -C - If a value is not extended alphanumeric (uppercase characters, -C dollar and underscore), it will be enclosed in quotes. -C - Embedded quotes will be converted to double quotes. -C - White values (only blanks and tabs) will be converted to single -C quoted blanks. -C Numerical (data types L,B,I,J,R,D): -C - Undefined values (UNDEF_<type>) will be converted to empty string -C fields e.g. ,,). -C - For sets in TOBY format TO and BY will be inserted where necessary: -C TO is needed if the start and end values are not equal; -C BY is needed if the increment is not equal to 1. -C------------------------------------------------------------------------- -C -C - CHARACTER*(*) BLANK, NULLVAL, WILDVAL, EOFVAL, VALDELIM, TO, BY - PARAMETER (BLANK = ' ' ) - PARAMETER (NULLVAL = '""') - PARAMETER (WILDVAL = '*' ) - PARAMETER (EOFVAL = '#') - PARAMETER (VALDELIM = ',' ) - PARAMETER (TO = ' TO ') - PARAMETER (BY = ' BY ') -C - INTEGER*4 PV_VAL_ENCODE - INTEGER*4 STR_COPY, GEN_CVT_NR_D, MSG_SET -C - INTEGER*4 IS, LADD, VALNR - REAL*8 TBS, TBE, TBI -C -C - STRING = BLANK - LSTR = 0 -C -C "null" set -C - IF (NRARR.EQ.PARM__NULL) THEN - IS = STR_COPY (NULLVAL,STRING,LSTR) - IF (IS.LT.0) GOTO 991 -C -C "wild" set -C - ELSE IF (NRARR.EQ.PARM__WILD) THEN - IS = STR_COPY (WILDVAL,STRING,LSTR) - IF (IS.LT.0) GOTO 991 -C -C "eof" set -C - ELSE IF (NRARR.EQ.PARM__EOF) THEN - IS = STR_COPY (EOFVAL,STRING,LSTR) - IF (IS.LT.0) GOTO 991 -C -C Normal character or numerical set -C -C - ELSE IF (.NOT.TOBY) THEN - DO VALNR = 1,NRARR - IS = PV_VAL_ENCODE (DTYPE,LARR,ARRAY(1,VALNR), - 1 STRING(LSTR+1:),LADD) - IF (IAND(IS,1).EQ.0) GOTO 999 - LSTR = LSTR+LADD - IF (VALNR.NE.NRARR) THEN - IS = STR_COPY (VALDELIM,STRING,LSTR) - IF (IS.LT.0) GOTO 991 - ENDIF - ENDDO -C -C Numerical set in TOBY format -C - NRARR is a multiple of 3 -C -C - ELSE -C -C - write TOBY set only if -C the start value is defined -C - DO VALNR = 1,NRARR,3 - IS = GEN_CVT_NR_D (DTYPE,ARRAY(1,VALNR),TBS) - IF (IAND(IS,1).EQ.0) GOTO 999 - IF (TBS.NE.UNDEF_D) THEN ! write start - IS = PV_VAL_ENCODE (DTYPE,LARR,ARRAY(1,VALNR), - 1 STRING(LSTR+1:),LADD) - IF (IAND(IS,1).EQ.0) GOTO 999 - LSTR = LSTR+LADD -C -C - write end value only if -C |end-start| >= |increment| - - IS = GEN_CVT_NR_D (DTYPE,ARRAY(1,VALNR+1),TBE) - IF (IAND(IS,1).NE.0) - 1 IS = GEN_CVT_NR_D (DTYPE,ARRAY(1,VALNR+2),TBI) - IF (IAND(IS,1).EQ.0) GOTO 999 - IF (ABS(TBE-TBS).GE.ABS(TBI)) THEN - IS = STR_COPY (TO,STRING,LSTR) ! write ' TO ' - IF (IS.LT.0) GOTO 991 ! and end val - IS = PV_VAL_ENCODE (DTYPE,LARR,ARRAY(1,VALNR+1), - 1 STRING(LSTR+1:),LADD) - IF (IAND(IS,1).EQ.0) GOTO 999 - LSTR = LSTR+LADD -C -C - write increment only if -C the increment is not 1 -C - IF (TBI.NE.1) THEN - IS = STR_COPY (BY,STRING,LSTR) ! write ' BY ' - IF (IS.LT.0) GOTO 991 ! and incremnt - IS = PV_VAL_ENCODE (DTYPE,LARR,ARRAY(1,VALNR+2), - 1 STRING(LSTR+1:),LADD) - IF (IAND(IS,1).EQ.0) GOTO 999 - LSTR = LSTR+LADD - ENDIF - ENDIF - ENDIF - IF (VALNR+3.LE.NRARR) THEN - IS = STR_COPY (VALDELIM,STRING,LSTR) - IF (IS.LT.0) GOTO 991 - ENDIF - ENDDO - ENDIF -C - PV_SET_ENCODE = DWC_SUCCESS - RETURN - 991 PV_SET_ENCODE = MSG_SET (DWC_STRTOOSHO,1) - CALL WNCTXT(DWLOG,DWMSG,LEN(STRING)) - RETURN - 999 PV_SET_ENCODE = IS - RETURN - END -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - INTEGER*4 FUNCTION PV_SET_DECODE (STRING,DTYPE,LARR,NRARR,ARRAY, - 1 NR,SWDEF,STREAM,CHKSW,SWSYM,SWDV,TOBY,DEFARR,NRDEF) -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' -C - CHARACTER*(*) STRING ! (i) value string (single set) - CHARACTER*1 DTYPE ! (i) data type (B,I,J,R,D,L,C) - INTEGER*4 LARR ! (i) length of each value (bytes) - INTEGER*4 NRARR ! (i) nr of values in ARRAY - BYTE ARRAY(LARR,*) ! (o) output array - INTEGER*4 NR ! (o) nr of used elements in set - LOGICAL*4 SWDEF(*) ! (o) corresp. value given by user ? - CHARACTER*(*) STREAM ! (i) stream name (for substitution) - LOGICAL*4 CHKSW ! (i) unknown symbols allowed ? - LOGICAL*4 SWSYM ! (m) unknown symbols found ? - LOGICAL*4 SWDV ! (i) default value string ? - LOGICAL*4 TOBY ! (i) ARRAY in TOBY format ? - BYTE DEFARR(LARR,*) ! (i) default array - INTEGER*4 NRDEF ! (i) nr of values in DEFARR -C -C.Purpose: Convert a value set to a value (and switch) array -C.Returns: Status code (.TRUE. for success, .FALSE. otherwise) -C success DWC_SUCCESS -C error DWC_WILDNOTAL wildcard values (*) not allowed -C error DWC_NULLNOTAL null values ("") not allowed -C error DWC_NOVALDEF no value given and no default available -C error DWC_EXPERRMSG expression error -C.Notes: -C - Values that are not given by the user will be replaced by the -C corresponding default values (if present), unless the parameter -C has the UNDEFINED attribute. For scalars and arrays only explicitly -C undefined values will be defaulted; for vectors all undefined values -C will be defaulted. E.g. for a 5-valued parameter: -C 1,,2, -> 1,def,2,def (array) -C 1,,2, -> 1,def,2,def,def (vector) -C - Numerical values can be given as numerical expressions containing -C with most Fortran intrinsic functions and with symbol-names. Such -C expressions will be evaluated after symbol substitution. -C - Logical values are treated as integers (B,I,J depending on LARR). -C------------------------------------------------------------------------- -C -C - CHARACTER*(*) BLANK, EOFVAL, WILDVAL, NULLVAL - PARAMETER (BLANK = ' ') - PARAMETER (EOFVAL = '#') - PARAMETER (WILDVAL = '*') - PARAMETER (NULLVAL = '""') -C - INTEGER*4 PV_SET_DECODE_C, PV_SET_DECODE_N - INTEGER*4 PPD_AMAS_GET - INTEGER*4 MSG_SET , MOVE_BLB -C - INTEGER*4 IS, ERRPTR -C -C -C Decode special value set -C - IF (STRING.EQ.WILDVAL) THEN - IF (IAND(PPD_AMAS_GET('WILD_CARDS'),1) .EQ. 0) GOTO 991 - NR = PARM__WILD - ELSE IF (STRING.EQ.NULLVAL) THEN - IF (IAND(PPD_AMAS_GET('NULL_VALUES'),1) .EQ. 0) GOTO 992 - NR = PARM__NULL - ELSE IF (STRING.EQ.EOFVAL) THEN - NR = PARM__EOF -C -C Decode normal set -C - ELSE - IF (DTYPE.EQ.'C') THEN - IS = PV_SET_DECODE_C (STRING, - 1 LARR,NRARR,ARRAY,NR,SWDEF,ERRPTR) - ELSE - IS = PV_SET_DECODE_N (STRING,STREAM,CHKSW,SWSYM,DTYPE, - 1 LARR,NRARR,TOBY,ARRAY,NR,SWDEF,ERRPTR) - ENDIF - IF (IAND(IS,1).EQ.0) GOTO 993 -C -C For a vector all values will be returned -C - IF (IAND(PPD_AMAS_GET('VECTOR'),1).NE.0 .AND. NR.LT.NRARR) - 1 NR = NRARR -C -C Replace undefined values by defaults -C - unless the undefined attribute is set -C - for vectors: also replace trailing -C undefined values -C - IF (IAND(PPD_AMAS_GET('UNDEFINED_VALUES'),1) .EQ. 0) THEN - DO J = 1,NR - IF (.NOT.SWDEF(J)) THEN - IF (J.GT.NRDEF) GOTO 994 - IS = MOVE_BLB (DEFARR(1,J),ARRAY(1,J),LARR) - ENDIF - ENDDO - ENDIF -C -C If the string is a default value: -C - set all define switches to undefined -C - IF (SWDV) THEN - DO J = 1,NRARR - SWDEF(J) = .FALSE. - ENDDO - ENDIF - ENDIF -C -C - PV_SET_DECODE = DWC_SUCCESS - RETURN - 991 PV_SET_DECODE = MSG_SET (DWC_WILDNOTAL,1) - CALL WNCTXT(DWLOG,DWMSG,BLANK) - RETURN - 992 PV_SET_DECODE = MSG_SET (DWC_NULLNOTAL,1) - CALL WNCTXT(DWLOG,DWMSG,BLANK) - RETURN - 993 PV_SET_DECODE = MSG_SET (DWC_EXPERRMSG,1) - CALL WNCTXT(DWLOG,DWMSG,BLANK,ERRPTR,STRING) - RETURN - 994 IF (TOBY) J = 1+J/3 - IS = MSG_SET (DWC_NOVALDEF,1) - CALL WNCTXT(DWLOG,DWMSG,J) - PV_SET_DECODE = MSG_SET (DWC_EXPERRMSG,1) - CALL WNCTXT(DWLOG,DWMSG,BLANK,1,STRING) - RETURN - END -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - INTEGER*4 FUNCTION PV_SET_DECODE_C (STRING,LARR,NRARR,ARRAY, - 1 NRVAL,SWDEF,ERRPTR) -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' -C - CHARACTER*(*) STRING ! (i) input character string - INTEGER*4 LARR ! (i) maximum length of a value - INTEGER*4 NRARR ! (i) maximum nr of values - BYTE ARRAY(LARR,*) ! (o) output array - INTEGER*4 NRVAL ! (o) nr of used values - LOGICAL*4 SWDEF(*) ! (o) value defined ? - INTEGER*4 ERRPTR ! (o) position of error in input string -C -C.Purpose: Decode a character-type value set -C.Returns: Status code (.TRUE. for success, .FALSE. otherwise) -C success DWC_SUCCESS -C warning DWC_STRTOOSHO work string is too short -C error DWC_TOOMANYEL too many elements given -C error DWC_TOOMANCHR too many characters for an element -C false status code returned by referenced routine -C.Notes: -C - Comma's outside quoted substrings are treated as value separators. -C - Quotes that delimit quoted substrings are not outputted, but double -C quotes inside a quoted substring are replaced by a single quote. -C E.g. AB"cd"EF ==> ABcdEF -C "AB""CD" ==> AB"CD -C """" ==> " -C - Undefined values are empty values in the string (e.g. ,,); they are -C counted as used values. -C------------------------------------------------------------------------- -C -C - CHARACTER*(*) QUOTE, COMMA, BLANK - PARAMETER (QUOTE = '"') - PARAMETER (COMMA = ',') - PARAMETER (BLANK = ' ') -C - INTEGER*4 STR_COPY_U, STR_COPY - INTEGER*4 MSG_SET , MOVE_BLB -C - CHARACTER*255 WORK - INTEGER*4 IS, LW, LSTR, PTR - LOGICAL*4 END_VAL, IS_QUOTED -C -C -C Parse the string -C - go to LSTR+1 to catch trailing comma -C - LSTR = LEN (STRING) - NRVAL = 0 - PTR = 1 - ERRPTR = PTR - WORK = BLANK - LW = 0 - DO WHILE (PTR.LE.LSTR+1) -C -C Copy until end-of-value or -C start of quoted substring -C - IS = STR_COPY_U (QUOTE//COMMA,STRING,PTR,WORK,LW) - IF (IS.LT.0) GOTO 993 - END_VAL = PTR.GT.LSTR .OR. STRING(PTR:PTR).EQ.COMMA -C -C If quoted substring: -C - loop until end of quoted substring -C - skip start quote -C - copy until quote or end-of-string -C - if double quote: copy only one -C - otherwise: end of quoted substring -C - IF (.NOT.END_VAL) THEN - IS_QUOTED = .TRUE. - DO WHILE (IS_QUOTED .AND. .NOT.END_VAL) - PTR = PTR+1 - IS = STR_COPY_U (QUOTE,STRING,PTR,WORK,LW) - IF (IS.LT.0) GOTO 993 - PTR = PTR+1 - IF (PTR.GT.LSTR .OR. STRING(PTR:PTR).EQ.COMMA) THEN - END_VAL = .TRUE. - ELSE IF (STRING(PTR:PTR).EQ.QUOTE) THEN - IS = STR_COPY (QUOTE,WORK,LW) - IF (IS.LT.0) GOTO 993 - ELSE - IS_QUOTED = .FALSE. - ENDIF - ENDDO - ENDIF -C -C If end-of-value: -C - check length and nr of value -C - move the value into the array -C - set or clear the value-defined switch -C - prepare for next value -C - IF (END_VAL) THEN - IF (LW.GT.LARR) GOTO 991 ! too long a value - IF (NRVAL.GE.NRARR) GOTO 992 ! too many values - NRVAL = NRVAL+1 - IS = MOVE_BLB (%REF(WORK),ARRAY(1,NRVAL),LARR) - IF (IAND(IS,1).EQ.0) GOTO 999 - IF (LW.GT.0) THEN - SWDEF(NRVAL) = .TRUE. - ELSE - ARRAY(1,NRVAL) = UNDEF_B - SWDEF(NRVAL) = .FALSE. - ENDIF - PTR = PTR+1 - ERRPTR = PTR - WORK = BLANK - LW = 0 - ENDIF - ENDDO -C -C Fill out the value and switch arrays -C - DO J = NRVAL+1,NRARR - IS = MOVE_BLB (%REF(WORK),ARRAY(1,J),LARR) - IF (IAND(IS,1).EQ.0) GOTO 999 - ARRAY(1,J) = UNDEF_B - SWDEF(J) = .FALSE. - ENDDO -C -C - ERRPTR = 0 - PV_SET_DECODE_C = DWC_SUCCESS - RETURN - 991 PV_SET_DECODE_C = MSG_SET (DWC_TOOMANCHR,1) - CALL WNCTXT(DWLOG,DWMSG,LARR) - RETURN - 992 PV_SET_DECODE_C = MSG_SET (DWC_TOOMANYEL,1) - CALL WNCTXT(DWLOG,DWMSG,NRARR) - RETURN - 993 PV_SET_DECODE_C = MSG_SET (DWC_STRTOOSHO,1) - CALL WNCTXT(DWLOG,DWMSG,LEN(WORK)) - RETURN - 999 PV_SET_DECODE_C = IS - RETURN - END -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - INTEGER*4 FUNCTION PV_SET_DECODE_N (STRING,STREAM,CHKSW,SWSYM, - 1 DTYPE,LARR,NRARR,TOBY,ARRAY,NRVAL,SWDEF,ERRPTR) -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' -C - CHARACTER*(*) STRING ! (i) string with values - CHARACTER*(*) STREAM ! (i) stream name (symbol substitution) - LOGICAL*4 CHKSW ! (i) unknown symbols allowed ? - LOGICAL*4 SWSYM ! (m) unknown symbols found ? - CHARACTER*1 DTYPE ! (i) data type (B,I,J,R,D,L) - INTEGER*4 LARR ! (i) length of a value - INTEGER*4 NRARR ! (i) maximum nr of values - LOGICAL*4 TOBY ! (i) set in TOBY format ? - BYTE ARRAY(LARR,*) ! (o) output array - INTEGER*4 NRVAL ! (o) nr of used values - LOGICAL*4 SWDEF(*) ! (o) value defined ? - INTEGER*4 ERRPTR ! (o) position of error in string -C -C.Purpose: Decode a numerical value set -C.Returns: Status code (.TRUE. for success, .FALSE. otherwise) -C success DWC_SUCCESS -C warning DWC_STRTOOSHO work string is too short -C error DWC_UNBPAREN unbalanced parentheses -C error DWC_TSNOTALL TO/BY not allowed -C error DWC_STEPNOTAL BY not allowed in this position -C error DWC_TONOTALL TO not allowed in this position -C error DWC_STEPSIGN BY-value has wrong sign -C error DWC_STEPISZER BY-value is zero -C error DWC_TOOMANYEL too many numbers given -C error DWC_INTOVERFL integer overflow during conversion -C false status code returned by referenced routines -C.Notes: -C - The expression string is split into single expressions, these are -C evaluated, and put into the array in the wanted format. -C - Logical values are treated as integers (B,I,J depending on LARR). -C - The values/expressions must be separated by comma's. By means of TO/BY -C the user can give start,end,increment if that is allowed by the PPD -C file. E.g.: 1 TO 10 BY 2,20 TO 100 BY 5 -C - The words TO and BY must be preceded and followed by a blank. -C The increment cannot be 0 and must have the right sign. -C - In some situations (SPECIFY and BLDPPD) symbol values may not be known -C yet. In that case, CHKSW = .TRUE. and any unknown symbol name is -C substituted by 1 (then, only the syntax will be checked). -C------------------------------------------------------------------------- -C -C - CHARACTER*(*) COMMA, BLANK, OPPAR, CLPAR, TODELIM, BYDELIM - PARAMETER (COMMA = ',') - PARAMETER (BLANK = ' ') - PARAMETER (OPPAR = '(') - PARAMETER (CLPAR = ')') - PARAMETER (TODELIM = ' TO ') - PARAMETER (BYDELIM = ' BY ') -C - INTEGER*4 PV_VAL_DECODE_N, GEN_CVT_D_NR, GEN_CVT_NR_L - INTEGER*4 GEN_CVT_NR_D ! 930413 - INTEGER*4 STR_COPY_U, STR_COPY - INTEGER*4 MSG_SET -C - CHARACTER WORK*255, DTYP2*1 - INTEGER*4 IS, PTR, LSTR, LW - INTEGER*4 DEPTH, NRIE, SW, SAVPTR(3) - LOGICAL*4 IS_PARENT, IS_ENDVAL - REAL*8 SIE(3) -C -C - LSTR = LEN (STRING) - NRVAL = 0 -C -C Treat logical as integer values -C - DTYP2 = DTYPE - IF (DTYPE.EQ.'L') THEN - IF (LARR.EQ.1) THEN - DTYP2 = 'B' - ELSE IF (LARR.EQ.2) THEN - DTYP2 = 'I' - ELSE - DTYP2 = 'J' - ENDIF - ENDIF -C -C Initialize the array -C - with undefined values -C - set all switches to undefined -C - DO I = 1,NRARR - IS = GEN_CVT_D_NR (DTYP2,UNDEF_D,ARRAY(1,I)) - IF (IAND(IS,1).EQ.0) GOTO 999 - SWDEF(I) = .FALSE. - ENDDO -C -C Initialize pointers and switches -C - SW = 1 ! start value expected - SAVPTR(1) = 1 ! its position - PTR = 1 ! pointer in the string - NRIE = 1 ! only start - IF (TOBY) NRIE = 3 ! start,increment,end - WORK = BLANK - LW = 0 -C -C Parse the string -C - copy to a work string, because -C VAL_DECODE_N might modify the string -C - DO WHILE (PTR.LE.LSTR+1) - IS = STR_COPY_U (COMMA//OPPAR//CLPAR//BLANK,STRING,PTR, - 1 WORK,LW) - IF (IS.LT.0) GOTO 990 ! work string too short - IS_ENDVAL = PTR.GT.LSTR .OR. STRING(PTR:PTR).EQ.COMMA -C -C If subexpression (parenthesized): -C - copy until end of subexpression -C - IF (.NOT.IS_ENDVAL) THEN - IF (STRING(PTR:PTR).EQ.CLPAR) GOTO 991 ! unbalanced parentheses - IF (STRING(PTR:PTR).EQ.OPPAR) THEN - DEPTH = 1 - IS_PARENT = .TRUE. - DO WHILE (IS_PARENT) - IS = STR_COPY (STRING(PTR:PTR),WORK,LW) - PTR = PTR+1 - IS = STR_COPY_U (OPPAR//CLPAR,STRING,PTR,WORK,LW) - IF (IS.LT.0) GOTO 990 ! work string too short - IF (PTR.GT.LSTR) GOTO 991 ! unbalanced parentheses - IF (STRING(PTR:PTR).EQ.CLPAR) THEN - DEPTH = DEPTH-1 - IF (DEPTH.LT.0) GOTO 991 ! unbalanced parentheses - IF (DEPTH.EQ.0) THEN - IS_PARENT = .FALSE. - IS = STR_COPY (STRING(PTR:PTR),WORK,LW) - IF (IS.LT.0) GOTO 990 ! work string too short - PTR = PTR+1 - ENDIF - ELSE - DEPTH = DEPTH+1 - ENDIF - ENDDO -C -C TO ? -C - ELSE IF (STRING(PTR:PTR+3).EQ.TODELIM) THEN - IF (.NOT.TOBY) GOTO 992 ! TOBY not allowed - IF (SW.NE.1) GOTO 993 ! no start val expected - IS = PV_VAL_DECODE_N (WORK,STREAM,CHKSW,SWSYM,SIE(1)) - IF (IAND(IS,1).EQ.0) GOTO 995 ! decode error - PTR = PTR+3 ! skip delimiter - SW = 2 ! expect end value - SAVPTR(2) = PTR ! its start position - WORK = BLANK - LW = 0 ! clear work string -C -C BY ? -C - ELSE IF (STRING(PTR:PTR+3).EQ.BYDELIM) THEN - IF (NRIE.EQ.1) GOTO 992 ! TOBY not allowed - IF (SW.NE.2) GOTO 994 ! no end val expected - IS = PV_VAL_DECODE_N (WORK,STREAM,CHKSW,SWSYM,SIE(2)) - IF (IAND(IS,1).EQ.0) GOTO 995 ! decode error - PTR = PTR+3 - SW = 3 ! expect increment - SAVPTR(3) = PTR - WORK = BLANK - LW = 0 ! clear work string -C -C Just a blank -C - ELSE - IS = STR_COPY (STRING(PTR:PTR),WORK,LW) - IF (IS.LT.0) GOTO 990 ! work string too short - PTR = PTR+1 ! copy it - ENDIF -C -C End of value found -C - ELSE - IF (SW.EQ.1) THEN ! start value expected - IF (LW.EQ.0 .OR. WORK(:LW).EQ.BLANK) THEN - SIE(1) = UNDEF_D - ELSE - IS = PV_VAL_DECODE_N (WORK,STREAM,CHKSW,SWSYM,SIE(1)) - IF (IAND(IS,1).EQ.0) GOTO 995 ! decode error - SIE(2) = SIE(1) - SIE(3) = 1 - ENDIF - ELSE ! end or increment exp. - IS = PV_VAL_DECODE_N (WORK,STREAM,CHKSW,SWSYM,SIE(SW)) - IF (IAND(IS,1).EQ.0) GOTO 995 ! decode error - IF (SW.EQ.2) SIE(3) = 1 - ENDIF -C -C If value defined: -C - check/modify increment -C - put (sub)value(s) in array -C - IF (SIE(1).NE.UNDEF_D) THEN - IF (SIE(2).EQ.SIE(1)) THEN -CC930413 SIE(3) = SIE(1) - SIE(3) = 1 ! 930413 - IF (SIE(3).EQ.0) SIE(3) = 1 - ELSE IF ((SIE(2)-SIE(1))*SIE(3).LT.0) THEN - IF (.NOT.SWSYM) GOTO 996 ! wrong increment sign - ENDIF - IF (NRVAL.LT.NRARR) THEN ! 930413 CVT BACK/FOR -C ! to check low int value - IS = GEN_CVT_D_NR (DTYP2,SIE(3),ARRAY(1,NRVAL+1)) - IS = GEN_CVT_NR_D (DTYP2,ARRAY(1,NRVAL+1),SIE(3)) - END IF - IF (SIE(3).EQ.0) THEN - IF (.NOT.SWSYM) GOTO 997 ! zero increment - ENDIF - DO I = 1,NRIE - NRVAL = NRVAL+1 - IF (NRVAL.GT.NRARR) GOTO 998 ! too many values - SWDEF(NRVAL) = .TRUE. - IS = GEN_CVT_D_NR (DTYP2,SIE(I),ARRAY(1,NRVAL)) - IF (IAND(IS,7).NE.1) THEN ! no success - IF (.NOT.SWSYM) GOTO 999 ! conversion error - ENDIF - IF (DTYPE.EQ.'L') THEN - IS = GEN_CVT_NR_L (DTYP2,ARRAY(1,NRVAL)) - IF (IAND(IS,1).EQ.0) GOTO 999 - ENDIF - ENDDO -C -C If undefined value: -C - only check the nr of values -C - ELSE - DO I = 1,NRIE - NRVAL = NRVAL+1 - IF (NRVAL.GT.NRARR) GOTO 998 ! too many values - ENDDO - ENDIF -C -C Save pointers and switch -C - PTR = PTR+1 - IF (PTR.LE.LSTR+1) THEN ! comma found: more - SW = 1 ! expect start value - SAVPTR(1) = PTR ! its start position - WORK = BLANK - LW = 0 ! clear work string - ENDIF - ENDIF - ENDDO -C -C - PV_SET_DECODE_N = DWC_SUCCESS - ERRPTR = 0 - RETURN - 990 PV_SET_DECODE_N = MSG_SET (DWC_STRTOOSHO,1) - CALL WNCTXT(DWLOG,DWMSG,LEN(WORK)) - ERRPTR = 0 ! work string too short - RETURN - 991 PV_SET_DECODE_N = MSG_SET (DWC_UNBPAREN,0) - ERRPTR = PTR ! position of offending/missing ')' - RETURN - 992 PV_SET_DECODE_N = MSG_SET (DWC_TSNOTALL,0) - ERRPTR = PTR ! position of offending ' TO ' or ' BY ' - RETURN - 993 PV_SET_DECODE_N = MSG_SET (DWC_TONOTALL,0) - ERRPTR = PTR ! position of offending ' TO ' - RETURN - 994 PV_SET_DECODE_N = MSG_SET (DWC_STEPNOTAL,0) - ERRPTR = PTR ! position of offending ' BY ' - RETURN - 995 PV_SET_DECODE_N = IS ! error in PV_VAL_DECODE_N - ERRPTR = SAVPTR(SW) ! position of offending value - RETURN - 996 PV_SET_DECODE_N = MSG_SET (DWC_STEPSIGN,0) - ERRPTR = SAVPTR(3) ! position of offending increment value - RETURN - 997 PV_SET_DECODE_N = MSG_SET (DWC_STEPISZER,0) - ERRPTR = SAVPTR(3) ! position of offending increment value - RETURN - 998 PV_SET_DECODE_N = MSG_SET (DWC_TOOMANYEL,0,NRARR/NRIE) - ERRPTR = SAVPTR(I) ! position of offending value - RETURN - 999 IF (IAND(IS,1).EQ.0) THEN - PV_SET_DECODE_N = IS ! conversion error - ELSE - PV_SET_DECODE_N = MSG_SET (DWC_INTOVERFL,1) - CALL WNCTXT(DWLOG,DWMSG,DTYP2) - ENDIF - ERRPTR = SAVPTR(I) ! position of offending value - RETURN - END -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - INTEGER*4 FUNCTION PV_SET_READ (DTYPE,LARR,NRARR,ARRAY,VALNR, - 1 COUNT,VALUE) -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' -C - CHARACTER*1 DTYPE ! (i) data type (B,I,J,R,D,L,C) - INTEGER*4 LARR ! (i) length of value (in bytes) - INTEGER*4 NRARR ! (i) nr of values in the set - BYTE ARRAY(LARR,*) ! (i) value set - INTEGER*4 VALNR ! (m) sequence nr of value in set - INTEGER*4 COUNT ! (m) counter for TO/BY arrays - BYTE VALUE(*) ! (o) next value -C -C.Purpose: Get the next value from a value set -C.Returns: Status code (.TRUE. for success, .FALSE. otherwise) -C success DWC_SUCCESS -C warning 0 end of set reached -C false status codes returned by referenced routines -C.Notes: -C - NRARR > 0 required (no "null" or "wild" sets allowed). -C - VALNR must be 0 for the first time; it will be reset to 0 -C when the end of the set is reached. -C - Logical values will be treated as integers (B,I,J depending on LARR). -C------------------------------------------------------------------------- -C -C - INTEGER*4 PV_SET_TOBY_C, PV_SET_TOBY_X - INTEGER*4 PPD_AMAS_GET - INTEGER*4 MOVE_BLB -C - INTEGER*4 IS, MAXCOUNT -C -C -C -C Character-type value set: -C - return the next defined value -C - IF (DTYPE.EQ.'C') THEN - IF (VALNR.LT.0) VALNR = 0 ! first time - 100 VALNR = VALNR+1 ! next value - IF (VALNR.GT.NRARR) GOTO 990 ! end of set - IF (ARRAY(1,VALNR).EQ.UNDEF_B) GOTO 100 ! undefined, try next - IS = MOVE_BLB (ARRAY(1,VALNR),VALUE,LARR) -C -C Logical value or numerical vector -C - return the first or next value -C - ELSE IF (DTYPE.EQ.'L' - 1 .OR. IAND(PPD_AMAS_GET('VECTOR'),1) .NE. 0) THEN - IF (VALNR.LT.0) VALNR = 0 ! first time - VALNR = VALNR+1 ! next value - IF (VALNR.GT.NRARR) GOTO 990 ! end of set - IS = MOVE_BLB (ARRAY(1,VALNR),VALUE,LARR) -C -C Numerical scalar or array -C - start with the first TOBY set -C or continue in current one -C - ELSE - IF (VALNR.LE.0) THEN ! first time: - VALNR = 1 ! first TOBY set - COUNT = 0 ! first value - ELSE - COUNT = COUNT+1 ! next value - ENDIF -C -C - count the values in the TOBY set -C - if the TOBY set is undefined or -C exhausted, continue with the next one -C - IS = PV_SET_TOBY_C (DTYPE,LARR,ARRAY(1,VALNR),MAXCOUNT) - DO WHILE (COUNT.GT.MAXCOUNT) ! TOBY set exhausted: - VALNR = VALNR+3 ! next TOBY set - IF (VALNR.GT.NRARR) GOTO 990 ! end of set - COUNT = 0 ! first value - IS = PV_SET_TOBY_C (DTYPE,LARR,ARRAY(1,VALNR),MAXCOUNT) - ENDDO -C -C - extract the value from the TOBY set -C - IS = PV_SET_TOBY_X (DTYPE,LARR,ARRAY(1,VALNR),COUNT,VALUE) - IF (IAND(IS,1).EQ.0) GOTO 999 - ENDIF -C - PV_SET_READ = DWC_SUCCESS - RETURN - 990 PV_SET_READ = 0 - VALNR = 0 - RETURN - 999 PV_SET_READ = IS - RETURN - END -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - INTEGER*4 FUNCTION PV_SET_TOBY_C (DTYPE,LARR,ARRAY,MAXCOUNT) -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' -C - CHARACTER*1 DTYPE ! (i) data type (B,I,J,R,D) - INTEGER*4 LARR ! (i) length of value (in bytes) - BYTE ARRAY(*) ! (i) TOBY set - INTEGER*4 MAXCOUNT ! (o) maximum of TOBY counter -C -C.Purpose: Count the values in a TOBY set -C.Returns: Status code (.TRUE. for success, .FALSE. otherwise) -C success DWC_SUCCESS -C error DWC_CALINVTYP invalid data type -C false status code returned by referenced routine -C.Notes: -C - MAXCOUNT+1 is the nr of values defined. -C - The set is undefined (MAXCOUNT = -1) if the start value is undefined. -C------------------------------------------------------------------------- -C -C - INTEGER*4 MOVE_BLB, MSG_SET -C - BYTE BVAL(8), BSET(24) - INTEGER*2 IVAL, ISET(3) - INTEGER*4 JVAL, JSET(3), IS - REAL*4 RVAL, RSET(3) - REAL*8 DVAL, DSET(3) - EQUIVALENCE (BVAL,IVAL,JVAL,RVAL,DVAL) - EQUIVALENCE (BSET,ISET,JSET,RSET,DSET) -C -C - MAXCOUNT = -1 ! assume no values - IS = MOVE_BLB (ARRAY,BSET,3*LARR) - IF (IAND(IS,1).EQ.0) GOTO 999 -C - IF (DTYPE.EQ.'B') THEN - IF (BSET(1).NE.UNDEF_B) MAXCOUNT = (BSET(2)-BSET(1))/BSET(3) - ELSE IF (DTYPE.EQ.'I') THEN - IF (ISET(1).NE.UNDEF_I) MAXCOUNT = (ISET(2)-ISET(1))/ISET(3) - ELSE IF (DTYPE.EQ.'J') THEN - IF (JSET(1).NE.UNDEF_J) MAXCOUNT = (JSET(2)-JSET(1))/JSET(3) - ELSE IF (DTYPE.EQ.'R') THEN - IF (RSET(1).NE.UNDEF_R) MAXCOUNT = - 1 (RSET(2)-RSET(1)+.01*RSET(3))/RSET(3) - ELSE IF (DTYPE.EQ.'D') THEN - IF (DSET(1).NE.UNDEF_D) MAXCOUNT = - 1 (DSET(2)-DSET(1)+.01*DSET(3))/DSET(3) - ELSE - GOTO 992 ! invalid data type - ENDIF -C -C - PV_SET_TOBY_C = DWC_SUCCESS - RETURN - 992 PV_SET_TOBY_C = MSG_SET (DWC_CALINVTYP,1) - CALL WNCTXT(DWLOG,DWMSG,DTYPE) - RETURN - 999 PV_SET_TOBY_C = IS - RETURN - END -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - INTEGER*4 FUNCTION PV_SET_TOBY_X (DTYPE,LARR,ARRAY,COUNT,VALUE) -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' -C - CHARACTER*1 DTYPE ! (i) data type (B,I,J,R,D) - INTEGER*4 LARR ! (i) length of value (in bytes) - BYTE ARRAY(*) ! (i) TOBY set - INTEGER*4 COUNT ! (i) TOBY counter for value - BYTE VALUE(*) ! (o) extracted value -C -C.Purpose: Extract a value from the TOBY set -C.Returns: Status code (.TRUE. for success, .FALSE. otherwise) -C success DWC_SUCCESS -C error DWC_CALINVTYP invalid data type -C error 2 invalid COUNT -C false status code returned by referenced routine -C.Notes: -C - COUNT must be in the range [0,MAXCOUNT]. -C - MAXCOUNT+1 is the nr of values defined in the TOBY set. -C - The set is undefined (MAXCOUNT = -1) if the start value is undefined. -C------------------------------------------------------------------------- -C -C - INTEGER*4 MOVE_BLB, MSG_SET -C - BYTE BVAL(8), BSET(24) - INTEGER*2 IVAL, ISET(3) - INTEGER*4 JVAL, JSET(3), IS, MAXCOUNT - REAL*4 RVAL, RSET(3) - REAL*8 DVAL, DSET(3) - EQUIVALENCE (BVAL,IVAL,JVAL,RVAL,DVAL) - EQUIVALENCE (BSET,ISET,JSET,RSET,DSET) -C -C - IF (COUNT.LT.0) GOTO 991 ! invalid count - IS = MOVE_BLB (ARRAY,BSET,3*LARR) - IF (IAND(IS,1).EQ.0) GOTO 999 -C - IF (DTYPE.EQ.'B') THEN - IF (BSET(1).NE.UNDEF_B) MAXCOUNT = (BSET(2)-BSET(1))/BSET(3) - IF (COUNT.GT.MAXCOUNT) GOTO 991 - BVAL(1) = BSET(1)+COUNT*BSET(3) - ELSE IF (DTYPE.EQ.'I') THEN - IF (ISET(1).NE.UNDEF_I) MAXCOUNT = (ISET(2)-ISET(1))/ISET(3) - IF (COUNT.GT.MAXCOUNT) GOTO 991 - IVAL = ISET(1)+COUNT*ISET(3) - ELSE IF (DTYPE.EQ.'J') THEN - IF (JSET(1).NE.UNDEF_J) MAXCOUNT = (JSET(2)-JSET(1))/JSET(3) - IF (COUNT.GT.MAXCOUNT) GOTO 991 - JVAL = JSET(1)+COUNT*JSET(3) - ELSE IF (DTYPE.EQ.'R') THEN - IF (RSET(1).NE.UNDEF_R) MAXCOUNT = - 1 (RSET(2)-RSET(1)+.01*RSET(3))/RSET(3) - IF (COUNT.GT.MAXCOUNT) GOTO 991 - RVAL = RSET(1)+COUNT*RSET(3) - ELSE IF (DTYPE.EQ.'D') THEN - IF (DSET(1).NE.UNDEF_D) MAXCOUNT = - 1 (DSET(2)-DSET(1)+.01*DSET(3))/DSET(3) - IF (COUNT.GT.MAXCOUNT) GOTO 991 - DVAL = DSET(1)+COUNT*DSET(3) - ELSE - GOTO 992 ! invalid data type - ENDIF -C - IS = MOVE_BLB (BVAL,VALUE,LARR) - IF (IAND(IS,1).EQ.0) GOTO 999 -C - PV_SET_TOBY_X = DWC_SUCCESS - RETURN - 991 PV_SET_TOBY_X = 2 - CALL WNCTXT(DWLOG,'Invalid TOBY count !SJ',COUNT) - RETURN - 992 PV_SET_TOBY_X = MSG_SET (DWC_CALINVTYP,1) - CALL WNCTXT(DWLOG,DWMSG,DTYPE) - RETURN - 999 PV_SET_TOBY_X = IS - RETURN - END diff --git a/src/dwarf/pvval.for b/src/dwarf/pvval.for deleted file mode 100644 index 794d38adb6afc25b6e30fbb1cb93a8ac43a0b145..0000000000000000000000000000000000000000 --- a/src/dwarf/pvval.for +++ /dev/null @@ -1,384 +0,0 @@ -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ -C.Ident: PV_VAL -C.Keywords: Parameter Values, Single Value -C.Author: Friso Olnon (NFRA, Dwingeloo) -C.Language: DWARF-Fortran -C.Environment: VAX or Alliant -C.Comments: -C.Version: 900420 FMO - recreation -C.Version: 910730 FMO - corrected STR_FAO arg in ENCODE_N -C.Version: 920214 GvD - no optional arguments in MSG anymore -C.Version: 940119 CMV - use WNCTXS i.s.o. STR_FAO -C------------------------------------------------------------------------- -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - INTEGER*4 FUNCTION PV_VAL () -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' -C -C -C.Purpose: Make source module name known -C.Returns: Status code (.TRUE. for success, .FALSE. otherwise) -C success DWC_SUCCESS -C.Notes: Dummy function -C------------------------------------------------------------------------- -C - PV_VAL = DWC_SUCCESS - RETURN - END -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - INTEGER*4 FUNCTION PV_VAL_ENCODE (DTYPE,LVAL,VALUE,STRING,LSTR) -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' -C - CHARACTER*1 DTYPE ! (i) data type code (B,I,J,R,D,L,C) - INTEGER*4 LVAL ! (i) length of value (in bytes) - BYTE VALUE(*) ! (i) value - CHARACTER*(*) STRING ! (o) value string - INTEGER*4 LSTR ! (o) significant length of STRING -C -C.Purpose: Convert a single parameter value to a standard value string -C.Returns: Status code (.TRUE. for success, .FALSE. otherwise) -C success DWC_SUCCESS -C warning DWC_STRTOOSHO string is truncated -C error DWC_CALINVTYP invalid data type -C error 2 encoding error in STR_FAO (-> asterisks) -C false code returned by referenced routine -C.Notes: -C Logical (data type L): -C - The output string will be 'YES' or 'NO'. -C Character (data type C): -C - An undefined value (starting with UNDEF_C) will be converted to an -C empty string (LSTR = 0). -C - If the value is not extended alphanumeric (uppercase characters, -C dollar and underscore), the string will be enclosed in quotes. -C - Embedded quotes will be converted to double quotes. -C - A white value (only blanks and tabs) will be converted to a single -C quoted blank. -C Numerical (data types B,I,J,R,D): -C - An undefined value (UNDEF_<type>) will be converted to an empty -C string (LSTR = 0). -C - Leading blanks, non-significant zero's and a trailing decimal point -C are removed from the output string. -C - If the PPD file gives a unit for the parameter, it will be appended -C to the output string, preceeded by a blank. -C - For unit codes DMS and HMS the number is converted to the format -C DD:MM:SS.SS or HH:MM:SS.SS, where SS is rounded to 3 or 6 decimals -C for single or double precision reals. -C------------------------------------------------------------------------- -C -C - INTEGER*4 PV_VAL_ENCODE_C, PV_VAL_ENCODE_N - INTEGER*4 PPD_USTR_GET - INTEGER*4 MOVE_BLB -C - CHARACTER WORK*255 - INTEGER*4 IS, LW -C -C - IF (DTYPE.EQ.'C') THEN - IS = MOVE_BLB (VALUE,%REF(WORK),LVAL) - IF (IAND(IS,1).EQ.0) GOTO 999 - IS = PV_VAL_ENCODE_C (WORK(:LVAL),STRING,LSTR) - ELSE - IS = PPD_USTR_GET (WORK,LW) - IF (IAND(IS,1).EQ.0) GOTO 999 - IS = PV_VAL_ENCODE_N (DTYPE,LVAL,VALUE,WORK(:LW),STRING,LSTR) - ENDIF -C - PV_VAL_ENCODE = DWC_SUCCESS - RETURN - 999 PV_VAL_ENCODE = IS - RETURN - END -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - INTEGER*4 FUNCTION PV_VAL_ENCODE_C (VALUE,STRING,LSTR) -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' -C - CHARACTER*(*) VALUE ! (i) value - CHARACTER*(*) STRING ! (o) value string - INTEGER*4 LSTR ! (o) significant length of STRING -C -C.Purpose: Convert a character-type value to a standard value string -C.Returns: Status code (.TRUE. for success, .FALSE. otherwise) -C success DWC_SUCCESS -C warning DWC_STRTOOSHO string is truncated -C.Notes: -C------------------------------------------------------------------------- -C -C - CHARACTER*(*) BLANK, QUOTE, QUOTE2, BLANKVAL - PARAMETER (BLANK = ' ' ) - PARAMETER (QUOTE = '"' ) - PARAMETER (QUOTE2 = QUOTE//QUOTE) - PARAMETER (BLANKVAL = QUOTE//BLANK//QUOTE) -C - INTEGER*4 STR_COPY, STR_COPY_U, STR_CHECK_ANUMX - INTEGER*4 MSG_SET - INTEGER WNCAL0 -C - INTEGER*4 LVAL, NCOPY, PTR -C -C - STRING = BLANK - LSTR = 0 - LVAL = WNCAL0(VALUE) -C -C Blank value -> quoted blank -C - IF (LVAL.EQ.0) THEN - NCOPY = STR_COPY (BLANKVAL,STRING,LSTR) -C -C Undefined value -> empty string -C - ELSE IF (VALUE(1:1).EQ.UNDEF_C) THEN - NCOPY = 0 -C -C Extended alpha-numeric -> straight copy -C - ELSE IF (IAND(STR_CHECK_ANUMX(VALUE(:LVAL)),1) .NE. 0) THEN - NCOPY = STR_COPY (VALUE(:LVAL),STRING,LSTR) -C -C Otherwise: -C - enclose in quotes -C - double embedded quotes -C - ELSE - PTR = 1 - NCOPY = STR_COPY (QUOTE,STRING,LSTR) - DO WHILE (PTR.LE.LVAL) - NCOPY = STR_COPY_U (QUOTE,VALUE(:LVAL),PTR,STRING,LSTR) - IF (PTR.LE.LVAL) THEN - NCOPY = STR_COPY (QUOTE2,STRING,LSTR) - PTR = PTR+1 - ENDIF - ENDDO - NCOPY = STR_COPY (QUOTE,STRING,LSTR) - ENDIF - IF (NCOPY.LT.0) GOTO 999 ! truncated -C - PV_VAL_ENCODE_C = DWC_SUCCESS - RETURN - 999 PV_VAL_ENCODE_C = MSG_SET (DWC_STRTOOSHO,1) - CALL WNCTXT(DWLOG,DWMSG,LEN(STRING)) - RETURN - END -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - INTEGER*4 FUNCTION PV_VAL_ENCODE_N (DTYPE,LVAL,VALUE,UNIT, - 1 STRING,LSTR) -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' -C - CHARACTER*1 DTYPE ! (i) data type (B,I,J,R,D,L) - INTEGER*4 LVAL ! (i) length of value (in bytes) - BYTE VALUE(*) ! (i) value - CHARACTER*(*) UNIT ! (i) unit code - CHARACTER*(*) STRING ! (o) value string - INTEGER*4 LSTR ! (o) significant length of STRING -C -C.Purpose: Convert a numerical-type value to a standard value string -C.Returns: Status code (.TRUE. for success, .FALSE. otherwise) -C success DWC_SUCCESS -C error DWC_CALINVTYP invalid data type -C error 2 encoding error in STR_FAO (-> asterisks) -C false code returned by referenced routine -C.Notes: -C------------------------------------------------------------------------- -C -C - CHARACTER*(*) BLANK, ASTER - PARAMETER (BLANK = ' ') - PARAMETER (ASTER = '*') -C - INTEGER WNCAL0 -C - INTEGER*4 MOVE_BLB, MSG_SET -C - BYTE B(8) - INTEGER*2 II - INTEGER*4 LU, IS, DD, MM - REAL*4 R - REAL*8 D, SS - LOGICAL*1 LL1 - LOGICAL*2 L2 - LOGICAL*4 L4 - EQUIVALENCE (B,II,J,R,D,LL1,L2,L4) - LOGICAL*4 LSW, IS_DMS -C -C - STRING = BLANK - LSTR = 0 - LU = LEN (UNIT) - IS_DMS = UNIT.EQ.'DMS' .OR. UNIT.EQ.'HMS' - IS = MOVE_BLB (VALUE,B,LVAL) - IF (IAND(IS,1).EQ.0) GOTO 999 -C - IF (DTYPE.EQ.'L') THEN - IF (LVAL.EQ.1) THEN - LSW = LL1 - ELSE IF (LVAL.EQ.2) THEN - LSW = L2 - ELSE - LSW = L4 - ENDIF - CALL WNCTXS(STRING,'!L',LSW) -C - ELSE IF (DTYPE.EQ.'B') THEN - IF (B(1).EQ.UNDEF_B) THEN - ELSE IF (IS_DMS) THEN - CALL WNCTXS(STRING,'!SB:0:0 !AS',B(1),UNIT) - ELSE IF (LU.GT.0) THEN - CALL WNCTXS(STRING,'!SB !AS',,B(1),UNIT) - ELSE - CALL WNCTXS(STRING,'!SB',B(1)) - ENDIF -C - ELSE IF (DTYPE.EQ.'I') THEN - IF (II.EQ.UNDEF_I) THEN - ELSE IF (IS_DMS) THEN - CALL WNCTXS(STRING,'!SI:0:0 !AS',II,UNIT) - ELSE IF (LU.GT.0) THEN - CALL WNCTXS(STRING,'!SI !AS',II,UNIT) - ELSE - CALL WNCTXS(STRING,'!SI',II) - ENDIF -C - ELSE IF (DTYPE.EQ.'J') THEN - IF (J.EQ.UNDEF_J) THEN - ELSE IF (IS_DMS) THEN - CALL WNCTXS(STRING,'!SJ:0:0 !AS',J,UNIT) - ELSE IF (LU.GT.0) THEN - CALL WNCTXS(STRING,'!SJ !AS',J,UNIT) - ELSE - CALL WNCTXS(STRING,'!SJ',J) - ENDIF -C - ELSE IF (DTYPE.EQ.'R') THEN - IF (R.EQ.UNDEF_R) THEN - ELSE IF (IS_DMS) THEN - DD = INT(R) ! signed DD or HH - R = ABS(R-DD)*60 ! decimal minutes - MM = INT(R) ! unsigned MM - SS = ABS(R-MM)*60 ! decimal seconds - CALL WNCTXS(STRING,'!SJ:!SJ:!D.3 !AS', - 1 DD,MM,SS,UNIT) - ELSE IF (LU.GT.0) THEN - CALL WNCTXS(STRING,'!E !AS',R,UNIT) - ELSE - CALL WNCTXS(STRING,'!E',R) - ENDIF -C - ELSE IF (DTYPE.EQ.'D') THEN - IF (D.EQ.UNDEF_D) THEN - ELSE IF (IS_DMS) THEN - DD = INT(D) ! signed DD or HH - D = ABS(D-DD)*60 ! decimal minutes - MM = INT(D) ! unsigned MM - SS = ABS(D-MM)*60 ! decimal seconds - CALL WNCTXS(STRING,'!SJ:!SJ:!D.6 !AS', - 1 DD,MM,SS,UNIT) - ELSE IF (LU.GT.0) THEN - CALL WNCTXS(STRING,'!D !AS',D,UNIT) - ELSE - CALL WNCTXS(STRING,'!D',D) - ENDIF - ELSE - GOTO 991 ! invalid data type - ENDIF - LSTR=WNCAL0(STRING) - IF (IAND(IS,1).EQ.0) GOTO 999 - IF (STRING(1:1).EQ.ASTER) GOTO 992 -C - PV_VAL_ENCODE_N = DWC_SUCCESS - RETURN - 991 PV_VAL_ENCODE_N = MSG_SET (DWC_CALINVTYP,1) - CALL WNCTXT(DWLOG,DWMSG,DTYPE) - RETURN - 992 PV_VAL_ENCODE_N = 2 - CALL WNCTXT(DWLOG,'Encoding error in STR_FAO') - RETURN - 999 PV_VAL_ENCODE_N = IS - RETURN - END -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - INTEGER*4 FUNCTION PV_VAL_DECODE_N (STRING,STREAM,CHKSW, - 1 SWSYM,VALUE) -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' -C - CHARACTER*(*) STRING ! (m) expression - CHARACTER*(*) STREAM ! (i) stream name (symbol substitution) - LOGICAL*4 CHKSW ! (i) unknown symbols allowed ? - LOGICAL*4 SWSYM ! (m) unknown symbols found ? - REAL*8 VALUE ! (o) value -C -C.Purpose: Evaluate an expression to a REAL*8 value -C.Returns: Status code (.TRUE. for success, .FALSE. otherwise) -C success DWC_SUCCESS -C error DWC_EXPERRMSG evaluation error -C false status codes returned by referenced routines -C.Notes: -C - STRING will be modified if symbols are present. -C - If a unit is defined in the PPD file, the result of the evaluation -C will be expressed in that unit. Otherwise degrees are used for -C trigonometric functions. -C------------------------------------------------------------------------- -C -C - CHARACTER*(*) BLANK, VALDELIM, DEFCODE - PARAMETER (BLANK = ' ') - PARAMETER (VALDELIM = ',') - PARAMETER (DEFCODE = 'DEG') -C - INTEGER*4 PPD_USTR_GET - INTEGER*4 DWC_EXPR_SOLVE - INTEGER*4 READ_UNIT, READ_UNITG, MSG_SET -C - INTEGER WNCAL0 -C - CHARACTER UNITLIST*100, DEFUNIT*10, GROUP*10 - INTEGER*4 IS, LU, ERRPTR - REAL*8 FACTOR -C -C -C Build the list of possible units: -C - if a unit is given in the PPD file, -C start with that unit code and -C append all units in the same group -C - otherwise, only 'DEG' -C - IS = PPD_USTR_GET (DEFUNIT,LU) - IF (IAND(IS,1).EQ.0) GOTO 999 - IF (LU.EQ.0 .OR. DEFUNIT(:LU).EQ.'1') THEN - DEFUNIT = DEFCODE - UNITLIST = DEFCODE - IS = READ_UNIT (DEFUNIT,GROUP,FACTOR) - IF (IAND(IS,1).EQ.0) GOTO 999 - ELSE - IS = READ_UNIT (DEFUNIT(:LU),GROUP,FACTOR) - IF (IAND(IS,1).EQ.0) GOTO 999 - UNITLIST = DEFUNIT(:LU)//VALDELIM - IS = READ_UNITG (GROUP,UNITLIST(LU+2:)) - IF (IAND(IS,1).EQ.0) GOTO 999 - ENDIF - LU = WNCAL0(UNITLIST) -C -C Evaluate the expression -C - IS = DWC_EXPR_SOLVE (STRING,STREAM,FACTOR,UNITLIST(:LU),VALUE, - 1 ERRPTR,CHKSW,SWSYM) - IF (IAND(IS,1).EQ.0) GOTO 991 -C - PV_VAL_DECODE_N = DWC_SUCCESS - RETURN - 991 PV_VAL_DECODE_N = MSG_SET (DWC_EXPERRMSG,1) - CALL WNCTXT(DWLOG,DWMSG,BLANK,ERRPTR,STRING) - RETURN - 999 PV_VAL_DECODE_N = IS - RETURN - END diff --git a/src/dwarf/restore.for b/src/dwarf/restore.for deleted file mode 100644 index 15ac0be74c710faabb6f3b841736aa08906b1c7c..0000000000000000000000000000000000000000 --- a/src/dwarf/restore.for +++ /dev/null @@ -1,298 +0,0 @@ -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ -C.Ident: SYS_RESTORE -C.Keywords: DWARF Environment, Restore -C.Author: Johan Hamaker (NFRA, Dwingeloo) -C.Language: VAX-Fortran -C.Environment: VAX -C.Comments: -C.Version: 870407 JPH - creation RSTENVRMT.FOR -C.Version: 900108 FMO - new name, new code; do not overwrite existing -C definitions -C.Version: 900227 FMO - new LNM routine used -C.Version: 900502 FMO - new GEN_LUN module -C.Version: 910117 FMO - add /NOLOG qualifier -C.Version: 910124 FMO - correct small error -C.Version: 910508 FMO - use CLI and set proper exit status, suppress -C logging (start/end-message problem) -C.Version: 910814 FMO - Separate program for full-environment restore -C (called ENVRESTORE.FOR). This program only restores -C proper DWARF symbols. -C - Simplify parsing (assume standard format as produced -C by old or new SAVE commands; old ones start with -C a .GLOBAL line) -C - Added various qualifiers -C.Version: 920206 GvD - add former optional arguments to CLI_GET/DWC_INPUT -C.Version: 940119 CMV - use WNGLUN i.s.o GEN_LUN -C.Version: 940315 CMV - default extension now .par -C------------------------------------------------------------------------- -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - SUBROUTINE RESTORE -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' -C -C.Purpose: Implement DWARF's RESTORE command -C.Returns: Not applicable -C.Notes: -C - Parameter: -C Save_file required -C - Qualifiers (the names can be abbreviated to a single letter): -C /INCLUDE=list default: /INCLUDE=*$*_* -C /EXCLUDE=list default: /NOEXCLUDE -C /LOG=LONG or /NOLOG default: /LOG=SHORT -C /CONFIRM default: /NOCONFIRM -C /OVERWRITE default: /NOOVERWRITE -C - All new symbols defined in the save file with names matching the -C include list but not the exclude list will be defined. Existing -C symbols may be redefined if the /OVERRIDE qualifiers is given. -C - All lines in the file that do not have the proper format for a symbol -C definition, are just ignored. This opens many ways to add comments. -C -C - The symbol lists (/INCLUDE and /EXCLUDE values) are comma-separated -C lists of DWARF symbol names: -C <program_name>$<stream_name>_<parameter_name> -C where each name can be absent or wildcarded (*). The dollar and -C underscore prefixes are part of the stream and parameter name -C components. -C - The lists will be expanded as follows: each absent component will be -C replaced by the component from the previous symbol name, except that -C the stream for global programs will be set to $0. The default for the -C first name is -C *$<current_stream>_*. -C - /CONFIRM will ask for you to confirm each individual restore action; -C the qualifier will be ignored in batch mode. -C - /OVERWRITE will also redefine already existing symbols. -C - /LOG=L reports each individual restore action and the total nr of -C symbols restored, /LOG=S only reports the total number, and /NOLOG -C reports nothing. -C------------------------------------------------------------------------- -C - CHARACTER*(*) PROGNAME, BLANK, ASTER, EQUAL, QUOTE - PARAMETER (PROGNAME= 'RESTORE') - PARAMETER (BLANK = ' ') - PARAMETER (ASTER = '*') - PARAMETER (EQUAL = '=') - PARAMETER (QUOTE = '"') - CHARACTER*(*) ANUMX - PARAMETER (ANUMX = 'ABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789$_') - INTEGER NRARG, PR, Q, QV, QVD - PARAMETER (NRARG = 6) - PARAMETER (PR = CLI__EXPRESSION+CLI__REQUIRED) - PARAMETER (Q = CLI__QUALIFIER) - PARAMETER (QV = CLI__QUALIFIER+CLI__VALUE) - PARAMETER (QVD = CLI__QUALIFIER+CLI__VALUE+CLI__DEFAULT) - CHARACTER*9 NAME(NRARG) - INTEGER ATTR(NRARG) - CHARACTER*26 PROMPT(NRARG) - CHARACTER*5 DEFVAL(NRARG) - DATA NAME /'SAVFILE' - 1 ,'INCLUDE','EXCLUDE','LOG' ,'CONFIRM','OVERWRITE'/ - DATA ATTR / PR - 1 , QVD , QV , QVD , Q , Q / - DATA PROMPT /'Save file (default ext .par)' ,5*BLANK / - DATA DEFVAL /BLANK - 1 ,'*$*_*' ,BLANK ,'SHORT',BLANK ,BLANK / -C - INTEGER DWC_CTL_OPEN, DWC_CTL_FILL - INTEGER DWC_IBMODE_INQ, DWC_INPUT, DWC_SYMLIST_EXPAND - INTEGER CLI_INIT, CLI_GET, FILNAM_FULL - INTEGER MSG_INIT, MSG_SET - INTEGER GEN_FORIOS - INTEGER SYMBOL_GET, SYMBOL_DEFINE, SYMBOL_EXIT - INTEGER STR_SIGLEN, STR_COPY, STR_COPY_W, STR_MATCH_L -C - CHARACTER*255 VALUE, INCLIST, EXCLIST, WORK, LINE*512 - CHARACTER NAM*64, SAVFILE*80, YN*1, DUM*1 - INTEGER LV, LI, LE, LW, LL, LN, LF, LDUM - INTEGER IS, TMP, LUN, PTR, NRDEF, MATCHNR - LOGICAL NEW_STYLE, NEW_DWARF, DO_CONFIRM, DO_OVERWRITE - LOGICAL DO_RESTORE, LONG_LOG, SHORT_LOG - DATA NRDEF /0/ - DATA NEW_DWARF /.FALSE./ - DATA DO_CONFIRM /.FALSE./ - DATA DO_OVERWRITE /.FALSE./ - DATA LONG_LOG /.FALSE./ - DATA SHORT_LOG /.TRUE./ -C -C -C Initialize -C - get DWARF control variables -C - start messenger -C - initialize command-line interpreter -C - IS = DWC_CTL_OPEN () ! ignore false return - IS = MSG_INIT (PROGNAME,F_T) - IF (IAND(IS,1).NE.0) IS = CLI_INIT (NRARG,NAME,ATTR,PROMPT,DEFVAL) - IF (IAND(IS,1).EQ.0) GOTO 999 -C -C Interpret the command line -C - get full save-file specification -C - get and expand symbol list -C - get and expand exclude list -C - get confirm qualifier -C - get overwrite qualifier -C - get log qualifier -C - IS = CLI_GET ('SAVFILE',VALUE,LV) - IF (IAND(IS,1).NE.0) - 1 IS = FILNAM_FULL (VALUE(:LV),SAVFILE,LF,'.PAR') - IF (IAND(IS,1).EQ.0) GOTO 999 -C - IS = CLI_GET ('INCLUDE',VALUE,LV) - IF (IAND(IS,1).NE.0) - 1 IS = DWC_SYMLIST_EXPAND (VALUE(:LV),INCLIST,LI) - IF (IAND(IS,1).EQ.0) GOTO 999 -C - IS = CLI_GET ('EXCLUDE',VALUE,LV) - IF (IAND(IS,1).EQ.0) GOTO 999 - IF (LV.EQ.0) THEN - EXCLIST = BLANK - LE = 1 - ELSE - IS = DWC_SYMLIST_EXPAND (VALUE(:LV),EXCLIST,LE) - IF (IAND(IS,1).EQ.0) GOTO 999 - IF (LE.EQ.0) LE = 1 - END IF -C - IF (IAND(DWC_IBMODE_INQ('BATCH'),1).EQ.0) THEN - IS = CLI_GET ('CONFIRM',DUM,LDUM) - IF (IAND(IS,1).EQ.0) GOTO 999 - DO_CONFIRM = IS.EQ.DWC_PRESENT - END IF -C - IS = CLI_GET ('OVERWRITE',DUM,LDUM) - IF (IAND(IS,1).EQ.0) GOTO 999 - DO_OVERWRITE = IS.EQ.DWC_PRESENT -C - IS = CLI_GET ('LOG',VALUE,LV) - IF (IAND(IS,1).EQ.0) GOTO 999 - IF (LV.EQ.0) THEN - SHORT_LOG = .FALSE. - ELSE IF (VALUE(1:1).EQ.'L') THEN - LONG_LOG = .TRUE. - END IF -C -C Open the save file and check the first -C line to see whether it is an old- or -C new-style save file -C - old files start with a .GLOBAL line -C - CALL WNGLUN(LUN) - IF (LUN.EQ.0) THEN - IS = GEN_LUNNOFREE - GOTO 999 - END IF - OPEN (LUN,NAME=SAVFILE(:LF),STATUS='OLD',ERR=998) - READ (LUN,'(Q,A)',END=900,ERR=998) LL, LINE - NEW_STYLE = LINE.NE.'.GLOBAL' - IF (NEW_STYLE) GOTO 101 -C -C Read and check the next line -C - skip non-definition lines -C - 100 READ (LUN,'(Q,A)',END=900,ERR=998) LL, LINE - 101 IF (LL.GT.0) LL = STR_SIGLEN (LINE(:LL)) - IF (NEW_STYLE) THEN - IF (LL.EQ.10) GOTO 100 !too short a line - IF (LINE(1:1).NE.BLANK) GOTO 100 !wrong start - PTR = 2 !skip to start name - ELSE - IF (LL.EQ.14) GOTO 100 - IF (LINE(1:2).NE.BLANK) GOTO 100 - PTR = 3 - END IF - IF (LINE(LL:LL).NE.QUOTE) GOTO 100 !wrong end -C -C - extract the name and check against -C the include and exclude lists -C - remove a possible abbreviation -C character (asterisk) -C - LN = 0 !clear name - IS = STR_COPY_W (ANUMX,LINE(:LL),PTR,NAM,LN) !extract name - IF (PTR.LT.LL .AND. LINE(PTR:PTR).EQ.ASTER) THEN!asterisk encountered: - PTR = PTR+1 ! skip it - IS = STR_COPY_W (ANUMX,LINE(:LL),PTR,NAM,LN)!extract rest name - END IF - IF (LN.EQ.0) GOTO 100 !no name: skip - IS = STR_MATCH_L (NAM(:LN),INCLIST(:LI),MATCHNR)!included ? - IF (IS.NE.1) GOTO 100 !no: skip - IF (EXCLIST(:LE).NE.BLANK) THEN !excluded ? - IS = STR_MATCH_L (NAM(:LN),EXCLIST(:LE),MATCHNR) - IF (IS.EQ.1) GOTO 100 !yes: skip - END IF -C -C - extract the value (must be quoted) -C - IF (NEW_STYLE) THEN - IF (PTR+2.GE.LL) GOTO 100 !too short aline - IF (LINE(PTR:PTR+1).NE.EQUAL//QUOTE) - 1 GOTO 100 !value not quoted - PTR = PTR+2 - ELSE - IF (PTR+5.GE.LL) GOTO 100 - IF (LINE(PTR:PTR+4).NE.BLANK//EQUAL//EQUAL//BLANK//QUOTE) - 1 GOTO 100 - PTR = PTR+5 - END IF - LV = 0 !clear value - IS = STR_COPY (LINE(PTR:LL-1),VALUE,LV) !extract value - IF (IS.LT.0) GOTO 100 !too long: skip -C -C Possibly restore the symbol: -C - get current symbol value (if any) -C - check overwrite if necessary -C - ask confirmation (if active) -C - define the symbol -C - increment counter and log (if active) -C - IS = SYMBOL_GET (NAM(:LN),WORK,LW) !get current value - IF (IAND(IS,1).EQ.0) THEN - IS = MSG_SET(IS,0) - GOTO 999 - END IF - IF (LW.EQ.0) THEN !no current symbol: - DO_RESTORE = .TRUE. ! restore - ELSE IF (WORK(:LW).EQ.VALUE(:LV)) THEN !no new definition: - DO_RESTORE = .FALSE. ! do not restore - ELSE IF (DO_OVERWRITE) THEN !overwrite allowed: - DO_RESTORE = .TRUE. ! restore - ELSE !otherwise: - DO_RESTORE = .FALSE. ! do not restore - END IF - IF (DO_RESTORE .AND. DO_CONFIRM) THEN - IF (LW.EQ.0) THEN - IS = DWC_INPUT (YN,NAM(:LN)//' = '//VALUE(:LV)// - 1 ', restore this symbol? (Y,[N])',LDUM,1,0) - ELSE - CALL WNCTXT(DWLOG,'Currently: !AS = !AS', - 1 NAM(:LN),WORK(:LW)) - IS = DWC_INPUT (YN,' overwrite with value '// - 1 VALUE(:LV)//'? (Y,[N])',LDUM,1,0) - END IF - IF (IAND(IS,1).EQ.0) YN = 'N' - DO_RESTORE = YN.EQ.'Y' - END IF - IF (DO_RESTORE) THEN - IS = SYMBOL_DEFINE (NAM(:LN),VALUE(:LV),DWC__GLOBALSYM) - IF (IAND(IS,1).EQ.0) GOTO 999 - NRDEF = NRDEF+1 - IF (LONG_LOG) CALL WNCTXT(DWLOG, - 1 'Symbol !AS = !AS is restored',NAM(:LN),VALUE(:LV)) - IF (NAM(:8).EQ.'DWARF$0_') NEW_DWARF = .TRUE. - END IF - GOTO 100 -C -C Wrap up -C - define DWARF control symbol -C - report -C - close symbol facility -C - 998 IS = GEN_FORIOS (SAVFILE(:LF)) !open or read error - 900 IF (NEW_DWARF) TMP = DWC_CTL_FILL () - 999 CONTINUE - IF (SHORT_LOG) CALL WNCTXT(DWLOG, - 1 '!SJ symbols restored from file !AS',NRDEF,SAVFILE(:LF)) - IF (NRDEF.GT.0) TMP = SYMBOL_EXIT () - E_C=MSG_SET(IS,0) !WNGEX exit code - END diff --git a/src/dwarf/save.for b/src/dwarf/save.for deleted file mode 100644 index 1ce951b1baa0e3e7b3538bc384543b1f188ec0cb..0000000000000000000000000000000000000000 --- a/src/dwarf/save.for +++ /dev/null @@ -1,210 +0,0 @@ -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ -C.Ident: SYS_SAVE -C.Keywords: Program Parameters, External Defaults, Save -C.Author: Friso Olnon (NFRA, Dwingeloo) -C.Language: DWARF-Fortran -C.Environment: VAX or Alliant -C.Comments: -C.Version: 850315 JPH - creation SYSDWARF:SAVE.COM -C.Version: 850522 JPH - suppress control symbols; confirm execution via -C editor (writing directly wouldn't work) -C.Version: 850531 JPH - assume dummy P1 parameter in SAVE symbol -C (This makes it possible to specify SAVE /<qualifiers> -C without any parameter.) -C.Version: 850617 JPH - insert .GLOBAL in DWARF defaults save file -C.Version: 851015 JPH - deassign DWF_SLATE which for unknown reasons -C sometimes remains after a spawn -C.Version: 900108 FMO - new code; use wild cards in SHOW SYMBOL command; -C don't remove DWARF$0_IBMODE and DWARF$0_IDENT -C (RESTORE will suppress their restoration) -C.Version: 910813 FMO - recreation as a fortran program -C - only save DWARF symbols (default list *$*_*) -C - added qualifiers /EXCLUDE and /LOG -C.Version: 920206 GvD - add former optional arguments to CLI_GET/DWC_INPUT -C.Version: 920318 GvD - open save file as UNKNOWN, because NEW fails -C on DECstation if already existing -C.Version: 930923 CMV - logical names for new maintenance system -C.Version: 940119 CMV - use WNGLUN i.s.o GEN_LUN -C.Version: 940315 CMV - default output name now: dwarf.par -C.Version: 940628 CMV - add CLOSE for HP -C------------------------------------------------------------------------- -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - SUBROUTINE SAVE -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' -C -C.Purpose: Save the specified external defaults in a file -C.Returns: Not applicable -C.Notes: -C - Parameter: -C symbol_list default *$*_* -C - Qualifiers (the names can be abbreviated to a single letter): -C /OUTPUT=file default: /OUTPUT=[]DWARFSAVE.PAR -C /CONFIRM default: /NOCONFIRM -C /EXCLUDE=list default: /NOEXCLUDE -C /LOG=LONG or /NOLOG default: /LOG=SHORT -C -C - The symbol lists (parameter and /EXCLUDE value) are comma-separated -C lists of DWARF symbol names: -C <program_name>$<stream_name>_<parameter_name> -C where each name can be absent or wildcarded (*). The dollar and -C underscore prefixes are part of the stream and parameter name -C components. -C - The lists will be expanded as follows: each absent component will be -C replaced by the component from the previous symbol name, except that -C the stream for global programs will be set to $0. The default for the -C first name is -C *$<current_stream>_*. -C - If an incomplete output file specification is given, the missing -C components will be taken from the default file specification. -C - /CONFIRM will ask for you to confirm each individual save action; -C the qualifier will be ignored in batch mode. -C - /LOG=L reports each individual save action and the total nr of -C symbols saved, /LOG=S only reports the total number, and /NOLOG -C reports nothing. -C------------------------------------------------------------------------- -C - CHARACTER*(*) PROGNAME, BLANK - PARAMETER (PROGNAME = 'SAVE') - PARAMETER (BLANK = ' ' ) -C - INTEGER NRARG, P, Q, QV, QVD - PARAMETER (NRARG = 5) - PARAMETER (P = CLI__PARAMETER) - PARAMETER (Q = CLI__QUALIFIER) - PARAMETER (QV = CLI__QUALIFIER+CLI__VALUE) - PARAMETER (QVD = CLI__QUALIFIER+CLI__VALUE+CLI__DEFAULT) - CHARACTER*7 NAME(NRARG) - INTEGER ATTR(NRARG) - CHARACTER*12 PROMPT(NRARG) - CHARACTER*13 DEFVAL(NRARG) - DATA NAME /'INCLIST','EXCLUDE','CONFIRM','LOG' ,'OUTPUT'/ - DATA ATTR / P , QV , Q , QVD , QVD / - DATA PROMPT /' ' ,' ' ,' ' ,' ' ,' ' / - DATA DEFVAL /'*$*_*' ,' ' ,' ','SHORT', 'dwarf.par'/ -C - INTEGER CLI_INIT, CLI_GET, FILNAM_FULL - INTEGER MSG_INIT, MSG_SET - INTEGER DWC_CTL_OPEN, DWC_IBMODE_INQ, DWC_INPUT - INTEGER DWC_SYMLIST_EXPAND, SYMBOL_SEARCH, SYMBOL_GET - INTEGER GEN_FORIOS -C - CHARACTER*255 VALUE, INCLIST, EXCLIST - CHARACTER NAM*64, FILE*80, YN*1, DUM*1 - INTEGER LV, LI, LE, LN, LF, LDUM - INTEGER IS, TMP, NRSAVE, NR, LUN - LOGICAL DO_SAVE, DO_CONFIRM, LONG_LOG, SHORT_LOG - DATA NRSAVE /0/ - DATA DO_SAVE /.TRUE./ - DATA DO_CONFIRM /.FALSE./ - DATA SHORT_LOG /.TRUE./ - DATA LONG_LOG /.FALSE./ -C -C -C Initialize -C - get DWARF control variables -C - start messenger -C - initialize command-line interpreter -C - LUN=0 - IS = DWC_CTL_OPEN () - IF (IAND(IS,1).NE.0) IS = MSG_INIT (PROGNAME,F_T) - IF (IAND(IS,1).NE.0) IS = CLI_INIT (NRARG,NAME,ATTR,PROMPT,DEFVAL) - IF (IAND(IS,1).EQ.0) GOTO 999 -C -C Interpret the command line -C - get and expand symbol list -C - get and expand exclude list -C - get confirm qualifier -C - get log qualifier -C - get output file -C - IS = CLI_GET ('INCLIST',VALUE,LV) - IF (IAND(IS,1).NE.0) - 1 IS = DWC_SYMLIST_EXPAND (VALUE(:LV),INCLIST,LI) - IF (IAND(IS,1).EQ.0) GOTO 999 -C - IS = CLI_GET ('EXCLUDE',VALUE,LV) - IF (IAND(IS,1).EQ.0) GOTO 999 - IF (LV.EQ.0) THEN - EXCLIST = BLANK - LE = 1 - ELSE - IS = DWC_SYMLIST_EXPAND (VALUE(:LV),EXCLIST,LE) - IF (IAND(IS,1).EQ.0) GOTO 999 - IF (LE.EQ.0) LE = 1 - END IF -C - IF (IAND(DWC_IBMODE_INQ('BATCH'),1).EQ.0) THEN - IS = CLI_GET ('CONFIRM',DUM,LDUM) - IF (IAND(IS,1).EQ.0) GOTO 999 - DO_CONFIRM = IS.EQ.DWC_PRESENT - ENDIF -C - IS = CLI_GET ('LOG',VALUE,LV) - IF (IAND(IS,1).EQ.0) GOTO 999 - IF (LV.EQ.0) THEN - SHORT_LOG = .FALSE. - ELSE IF (VALUE(1:1).EQ.'L') THEN - LONG_LOG = .TRUE. - END IF -C - IS = CLI_GET ('OUTPUT',VALUE,LV) - IF (VALUE.EQ.' ') THEN - VALUE='dwarfsave' - LV=9 - ENDIF - IF (IAND(IS,1).NE.0) - 1 IS = FILNAM_FULL (VALUE(:LV),FILE,LF,'.par') - IF (IAND(IS,1).EQ.0) GOTO 999 -C -C Open the save file -C - CALL WNGLUN(LUN) - IF (LUN.EQ.0) GOTO 999 - OPEN (UNIT=LUN,FILE=FILE(:LF),STATUS='UNKNOWN',ERR=998) - WRITE(LUN,'(A)') '! Written by save.exe' -C -C Find the next symbol name -C matching INCLIST but not EXCLIST -C - NR = 0 - IS = SYMBOL_SEARCH (INCLIST(:LI),EXCLIST(:LE),NR,NAM,LN) - IF (IAND(IS,1).EQ.0) GOTO 999 - DO WHILE (LN.GT.0) -C -C - get the symbol value -C - ask confirmation (if active) -C - delete the symbol -C - increment counter and log (if active) -C - IS = SYMBOL_GET (NAM(:LN),VALUE,LV) - IF (DO_CONFIRM) THEN - IS = DWC_INPUT (YN,NAM(:LN)//' = '//VALUE(:LV)// - 1 ', save this symbol? (Y,[N])',LDUM,1,0) - IF (IAND(IS,1).EQ.0) YN = 'N' - DO_SAVE = YN.EQ.'Y' - END IF - IF (DO_SAVE) THEN - WRITE (LUN,'(1X,A)',ERR=998) - 1 NAM(:LN)//'="'//VALUE(:LV)//'"' - NRSAVE = NRSAVE+1 - IF (LONG_LOG) CALL WNCTXT(DWLOG, - 1 'Symbol !AS = !AS is saved',NAM(:LN),VALUE(:LV)) - ENDIF - IS = SYMBOL_SEARCH (INCLIST(:LI),EXCLIST(:LE),NR,NAM,LN) - IF (IAND(IS,1).EQ.0) GOTO 999 - ENDDO - GOTO 999 -C -C Wrap up -C - write any remaining messages -C - write the nr of symbols saved -C - 998 IS = GEN_FORIOS (FILE(:LF)) - 999 IF (LUN.NE.0) CLOSE(LUN) - IF (SHORT_LOG) CALL WNCTXT(DWLOG, - 1 '!SJ symbols saved in !AS',NRSAVE,FILE) - E_C = MSG_SET(IS,0) !WNGEX exit code - END diff --git a/src/dwarf/spclear.for b/src/dwarf/spclear.for deleted file mode 100644 index ca36157a5116b6beeae5352a2d83a48f40e95778..0000000000000000000000000000000000000000 --- a/src/dwarf/spclear.for +++ /dev/null @@ -1,71 +0,0 @@ -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ -C.Ident: SP_CLEAR -C.Keywords: Program Parameters, External Defaults, Clear -C.Author: Friso Olnon (NFRA, Dwingeloo) -C.Language: DWARF-Fortran -C.Environment: VAX or Alliant -C.Comments: -C.Version: 900416 FMO - recreation -C.Version: 920214 GvD - no optional arguments in MSG anymore -C------------------------------------------------------------------------- -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - INTEGER*4 FUNCTION SP_CLEAR (PROGNAM,STREAM) -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' -C - CHARACTER*(*) PROGNAM ! (i) program name - CHARACTER*(*) STREAM ! (i) stream name -C -C.Purpose: Clear all external defaults for a given program and stream -C.Returns: Status code (.TRUE. for success, .FALSE. otherwise) -C success DWC_SUCCESS -C false status code returned by referenced modules -C.Notes: -C - All symbols containing the default values for input-type program -C parameters (listed in the PPD file) are deleted. -C------------------------------------------------------------------------- -C -C - CHARACTER*(*) BLANK - PARAMETER (BLANK = ' ') -C - INTEGER*4 DWC_TEST_INQ, DWC_SYM_BUILD - INTEGER*4 PPD_READ_U, PPD_READ_UNXT - INTEGER*4 PPD_AMAS_GET, PPD_IOCD_GET, PPD_UNAM_GET - INTEGER*4 SYMBOL_DELETE -C - CHARACTER SYMBOL*50, KEY*16, IOCD*8 - INTEGER*4 IS, LS, LK, LMIN, LI - LOGICAL*4 TEST_MODE, PROTO -C -C -C Loop through the PPD file -C - accept only input parameters -C and test parameters if in test mode -C - TEST_MODE = DWC_TEST_INQ () - IS = PPD_READ_U (BLANK) - DO WHILE (IAND(IS,1).NE.0 .AND. IS.NE.PPD_ENDOFFILE) - IF (TEST_MODE .OR. IAND(PPD_AMAS_GET('TEST'),1).EQ.0) THEN - IS = PPD_IOCD_GET (IOCD,LI) - IF (IAND(IS,1).EQ.0) GOTO 999 - IF (INDEX('MI',IOCD(:1)).NE.0) THEN - IS = PPD_UNAM_GET (KEY,LK,LMIN,PROTO) - IF (IAND(IS,1).NE.0) IS = DWC_SYM_BUILD (PROGNAM,STREAM, - 1 KEY(:LK),SYMBOL,LS) - IF (IAND(IS,1).NE.0) IS = SYMBOL_DELETE (SYMBOL(:LS), - 1 DWC__GLOBALSYM) - IF (IAND(IS,1).EQ.0) GOTO 999 - ENDIF - ENDIF - IS = PPD_READ_UNXT () - ENDDO - IF (IAND(IS,1).EQ.0) GOTO 999 -C - SP_CLEAR = DWC_SUCCESS - RETURN -C - 999 SP_CLEAR = IS - RETURN - END diff --git a/src/dwarf/spcopy.for b/src/dwarf/spcopy.for deleted file mode 100644 index e5d0a76d85fa928ec047ea438a7d591d4bba1d75..0000000000000000000000000000000000000000 --- a/src/dwarf/spcopy.for +++ /dev/null @@ -1,76 +0,0 @@ -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ -C.Ident: SP_COPY -C.Keywords: Program Parameters, External Defaults, Copy -C.Author: Friso Olnon (NFRA, Dwingeloo) -C.Language: DWARF-Fortran -C.Environment: VAX or Alliant -C.Comments: -C.Version: 900416 FMO - recreation -C.Version: 920214 GvD - no optional arguments in MSG anymore -C------------------------------------------------------------------------- -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - INTEGER*4 FUNCTION SP_COPY (OUTPROG,OUTSTREAM,INPROG,INSTREAM) -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' -C - CHARACTER*(*) OUTPROG ! (i) name of output program - CHARACTER*(*) OUTSTREAM ! (i) name of output stream - CHARACTER*(*) INPROG ! (i) name of input program - CHARACTER*(*) INSTREAM ! (i) name of input stream -C -C.Purpose: Copy the external defaults from one prognam$stream to another -C.Returns: Status code (.TRUE. for success, .FALSE. otherwise) -C success DWC_SUCCESS -C false status codes returned by referenced routines -C.Notes: -C------------------------------------------------------------------------- -C -C - CHARACTER*(*) BLANK - PARAMETER (BLANK = ' ') -C - INTEGER*4 DWC_TEST_INQ, DWC_SYM_BUILD - INTEGER*4 PPD_READ_U, PPD_READ_UNXT - INTEGER*4 PPD_AMAS_GET, PPD_IOCD_GET, PPD_UNAM_GET - INTEGER*4 SYMBOL_GET, SYMBOL_DEFINE -C - CHARACTER WORK*255, SYMBOL*50, KEY*16, IOCD*8 - INTEGER*4 IS, LW, LS, LK, LMIN, LI - LOGICAL*4 TEST_MODE, PROTO -C -C -C Loop through the PPD file -C - accept only input parameters -C and test parameters if in test mode -C - TEST_MODE = DWC_TEST_INQ () - IS = PPD_READ_U (BLANK) - DO WHILE (IAND(IS,1).NE.0 .AND. IS.NE.PPD_ENDOFFILE) - IF (TEST_MODE .OR. IAND(PPD_AMAS_GET('TEST'),1).EQ.0) THEN - IS = PPD_IOCD_GET (IOCD,LI) - IF (IAND(IS,1).EQ.0) GOTO 999 - IF (INDEX('MI',IOCD(:1)).NE.0) THEN - IS = PPD_UNAM_GET (KEY,LK,LMIN,PROTO) - IF (IAND(IS,1).NE.0) IS = DWC_SYM_BUILD (INPROG,INSTREAM, - 1 KEY(:LK),SYMBOL,LS) - IF (IAND(IS,1).NE.0) IS = SYMBOL_GET (SYMBOL(:LS),WORK,LW) - IF (IAND(IS,1).NE.0 .AND. LW.GT.0) THEN - IS = DWC_SYM_BUILD (OUTPROG,OUTSTREAM, - 1 KEY(:LK),SYMBOL,LS) - IF (IAND(IS,1).NE.0) IS = SYMBOL_DEFINE (SYMBOL(:LS), - 1 WORK(:LW),DWC__GLOBALSYM) - ENDIF - IF (IAND(IS,1).EQ.0) GOTO 999 - ENDIF - ENDIF - IS = PPD_READ_UNXT () - ENDDO - IF (IAND(IS,1).EQ.0) GOTO 999 -C - SP_COPY = DWC_SUCCESS - RETURN -C - 999 SP_COPY = IS - RETURN - END diff --git a/src/dwarf/spdefcheck.for b/src/dwarf/spdefcheck.for deleted file mode 100644 index 978c444e56a77e2cb3d1a79dc288ef75a2d57884..0000000000000000000000000000000000000000 --- a/src/dwarf/spdefcheck.for +++ /dev/null @@ -1,225 +0,0 @@ -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ -C.Ident: SP_DEF_CHECK -C.Keywords: Program Parameters, Specify, Check Values -C.Author: Friso Olnon (NFRA, Dwingeloo) -C.Language: DWARF-Fortran -C.Environment: VAX or Alliant -C.Comments: -C.Version: 900416 FMO - recreation -C.Version: 920206 GvD - add former optional arguments to CLI_GET -C------------------------------------------------------------------------- -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - INTEGER*4 FUNCTION SP_DEF_CHECK (SYMBOL,DLEVEL,HELPSW, - 1 VALUE,VALOUT,LOUT,DO_SUBST) -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' -C - CHARACTER*(*) SYMBOL ! (i) symbol name (for messages) - INTEGER*4 DLEVEL ! (m) helplevel minus userlevel - INTEGER*4 HELPSW ! (i) print control for help info - CHARACTER*(*) VALUE ! (i) input value string - CHARACTER*(*) VALOUT ! (o) output value string - INTEGER*4 LOUT ! (o) significant length of VALOUT - LOGICAL*4 DO_SUBST ! (i) substitution requested by SPECIFY -C -C.Purpose: Process the value string for a program parameter -C.Returns: Status code (.TRUE. for success, .FALSE. otherwise) -C success DWC_SUCCESS -C warning DWC_KEYVAHELP value was a help request -C warning DWC_SYMBOLCLR /CLEAR was given as value -C false status codes returned by referenced modules -C.Notes: -C - HELPSW > 0 (for SPECIFIY/NOMENU): always print help on request -C = 0 (for SPECIFY/MENU): only print if helplevel < max level -C - The input string may contain a value string and qualifiers. -C - The /CLEAR qualifier (no value string allowed) causes the current -C SPECIFY default to be deleted. -C - The /(NO)ASK qualifier is accepted and will be (part of) the -C default "value". -C - The value string will be checked completely if (in that order): -C the IMMEDIATE-switch in the PPD file is set, or -C the qualifier /SUBSTITUTE is appended to the value string, or -C no /NOSUBSTITUTE was given on the value string or the SPECIFY command. -C - DO_SUBST = .TRUE. unless SPECIFY/NOSUBSTITUTE was given. -C------------------------------------------------------------------------- -C -C - INTEGER*4 CLI_RESET, CLI_PARSE, CLI_GET - INTEGER*4 DWC_STR_SUBST, DWC_SYM_SPLIT, DWC_HELP - INTEGER*4 PV_BLK_ALLOC, PV_BLK_RELEASE - INTEGER*4 PV_BLK_DECODE, PV_BLK_ENCODE - INTEGER*4 PPD_AMAS_GET - INTEGER*4 STR_SIGLEN, STR_COPY - INTEGER*4 SYMBOL_DELETE, MSG_SET -C - INTEGER*4 NRARG, EXPR, QUAL - PARAMETER (NRARG = 4) - PARAMETER (EXPR = CLI__EXPRESSION) - PARAMETER (QUAL = CLI__QUALIFIER) - CHARACTER*10 NAME(NRARG) - INTEGER*4 ATTR(NRARG) - CHARACTER*1 PROMPT(NRARG) - CHARACTER*1 DEFVAL(NRARG) - DATA NAME /'VALSTR' ,'ASK' ,'SUBSTITUTE' ,'CLEAR'/ - DATA ATTR / EXPR , QUAL , QUAL , QUAL / - DATA PROMPT /' ' ,' ' ,' ' ,' ' / - DATA DEFVAL /' ' ,' ' ,' ' ,' ' / -C - CHARACTER WORK*255, VALSTR*255, PROG*16, STREAM*16, KEY*16 - CHARACTER DUM*1 - INTEGER*4 IS, LW, LVAL, LD, LP, LS, LK, VALBLK(8) - INTEGER*4 ERRPTR, COUNT, Q_ASK - LOGICAL*4 DO_CHECK, SWSYM - BYTE DEFARR(1) ! dummy -C -C -C Substitute symbols (unknown allowed) -C - IS = DWC_SYM_SPLIT (SYMBOL,PROG,LP,STREAM,LS,KEY,LK) - IF (IAND(IS,1).EQ.0) GOTO 999 - SWSYM = .FALSE. - IS = DWC_STR_SUBST (VALUE,WORK,LW,STREAM(:LS),ERRPTR,.TRUE.,SWSYM) - IF (IAND(IS,1).EQ.0) GOTO 991 -C -C If help request: -C - give help and return -C - IS = DWC_HELP (WORK(:LW),HELPSW,DLEVEL) - IF (IAND(IS,1).EQ.0) GOTO 999 -C -C Analyse the string -C - reset the Command-Line Interpreter -C - parse the string -C - extract the pure value string -C - IS = CLI_RESET (NRARG,NAME,ATTR,PROMPT,DEFVAL) - IF (IAND(IS,1).NE.0) IS = CLI_PARSE (WORK(:LW)) - IF (IAND(IS,1).NE.0) IS = CLI_GET ('VALSTR',VALSTR,LVAL) - IF (IAND(IS,1).EQ.0) GOTO 999 -C -C Analyse the ASK qualifier -C - COUNT = 0 - IS = CLI_GET ('ASK',DUM,LD) - IF (IAND(IS,1).EQ.0) GOTO 999 - IF (IS.EQ.DWC_PRESENT) THEN - Q_ASK = 1 - COUNT = COUNT+1 - ELSE IF (IS.EQ.DWC_NEGATED) THEN - Q_ASK = -1 - COUNT = COUNT+1 - ELSE - Q_ASK = 0 - ENDIF -C -C Must the value must be checked ? -C - DO_CHECK = .TRUE. ! yes by default - IS = CLI_GET ('SUBSTITUTE',DUM,LD) - IF (IAND(IS,1).EQ.0) GOTO 999 - IF (IS.EQ.DWC_PRESENT) THEN ! explicitly requested - IF (LVAL.EQ.0) GOTO 992 ! (value required) - COUNT = COUNT+1 - ELSE IF (IS.EQ.DWC_NEGATED) THEN ! explicitly suppressed - IF (LVAL.EQ.0) GOTO 993 ! (value required) - DO_CHECK = .FALSE. - COUNT = COUNT+1 - ELSE - DO_CHECK = DO_SUBST ! follow SPECIFY - ENDIF -C - IF (IAND(PPD_AMAS_GET('IMMEDIATE'),1) .NE. 0) THEN ! PPD forces full check - IF (.NOT.DO_CHECK) THEN - IS = MSG_SET (DWC_IMMNOSUBS,0) ! issue info message - DO_CHECK = .TRUE. - ENDIF - ENDIF -C -C If /CLEAR was given: -C - no other qualifiers allowed -C - no value allowed -C - clear the symbol -C - return with 'cleared' status -C - IS = CLI_GET ('CLEAR',DUM,LD) - IF (IAND(IS,1).EQ.0) GOTO 999 - IF (IS.EQ.DWC_PRESENT) THEN - IF (COUNT.GT.0) GOTO 994 - IF (LVAL.GT.0) GOTO 995 - IS = SYMBOL_DELETE (SYMBOL,DWC__GLOBALSYM) - IF (IAND(IS,1).NE.0) IS = DWC_SYMBOLCLR - GOTO 999 - ENDIF -C -C If the value must be checked and -C unknown symbols were found: -C - repeat substitution to trap the error -C Otherwise: -C - the proper VALSTR is already there -C - IF (DO_CHECK .AND. SWSYM) THEN - IS = DWC_STR_SUBST (VALUE,WORK,LW,STREAM(:LS),ERRPTR, - 1 .FALSE.,SWSYM) - GOTO 991 - ENDIF -C -C Allocate memory for the value block -C - IS = PV_BLK_ALLOC (VALSTR(:LVAL),VALBLK) - IF (IAND(IS,1).EQ.0) GOTO 999 -C -C Decode and check the value -C - IS = PV_BLK_DECODE (VALSTR(:LVAL),VALBLK,STREAM(:LS), - 1 .NOT.DO_CHECK,SWSYM,.FALSE.,DEFARR,0) - IF (IAND(IS,1).EQ.0) GOTO 996 -C -C If full value check has been done: -C - convert back to value string and -C append ASK qualifier to string -C (substitute qual no longer important) -C Otherwise: -C - return the original value string -C - IF (DO_CHECK) THEN - IS = PV_BLK_ENCODE (VALBLK,VALOUT,LOUT) - IF (IAND(IS,1).EQ.0) GOTO 996 - IF (Q_ASK.GT.0) THEN - IS = STR_COPY (' /ASK',VALOUT,LOUT) - ELSE IF (Q_ASK.LT.0) THEN - IS = STR_COPY (' /NOASK',VALOUT,LOUT) - ENDIF - ELSE - VALOUT = VALUE - LOUT = STR_SIGLEN (VALUE) - ENDIF -C -C Release virtual memory and return -C - IS = PV_BLK_RELEASE (VALBLK) - SP_DEF_CHECK = DWC_SUCCESS - RETURN -C -C - 991 SP_DEF_CHECK = MSG_SET (DWC_EXPERRMSG,1) - CALL WNCTXT(DWLOG,DWMSG,'keyword '//KEY(:LK),ERRPTR,WORK(:LW)) - RETURN - 992 SP_DEF_CHECK = MSG_SET (DWC_MANDATVAL,1) - CALL WNCTXT(DWLOG,DWMSG,'/SUBSTITUTE') - RETURN - 993 SP_DEF_CHECK = MSG_SET (DWC_MANDATVAL,1) - CALL WNCTXT(DWLOG,DWMSG,'/NOSUBSTITUTE') - RETURN - 994 SP_DEF_CHECK = MSG_SET (DWC_MULTIQUAL,1) - CALL WNCTXT(DWLOG,DWMSG,'/CLEAR') - RETURN - 995 SP_DEF_CHECK = MSG_SET (DWC_NOVALALL,1) - CALL WNCTXT(DWLOG,DWMSG,'/CLEAR') - RETURN - 996 SP_DEF_CHECK = IS - IS = PV_BLK_RELEASE (VALBLK) - RETURN - 999 SP_DEF_CHECK = IS - RETURN - END diff --git a/src/dwarf/specify.for b/src/dwarf/specify.for deleted file mode 100644 index 3d9a138edc0a2dfe0edee031388410ec67ac819c..0000000000000000000000000000000000000000 --- a/src/dwarf/specify.for +++ /dev/null @@ -1,190 +0,0 @@ -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ -C.Ident: SYS_SPECIFY -C.Keywords: Program Parameters, External Defaults, Specify -C.Author: Friso Olnon (NFRA, Dwingeloo) -C.Language: VAX-Fortran -C.Environment: VAX -C.Comments: -C.Version: 900325 FMO - creation -C.Version: 900411 FMO - commented out LIB$DO_COMMAND -C.Version: 910814 FMO - add SYMBOL_EXIT call at the end -C.Version: 920206 GvD - add former optional arguments to CLI_GET -C------------------------------------------------------------------------- -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - SUBROUTINE SPECIFY -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' -C -C.Purpose: Define external defaults for program parameters -C.Returns: Not applicable -C.Notes: -C - Parameter: -C prog[$stream] required -C - Qualifiers: -C /CLEAR default: /NOCLEAR -C /NOMENU default: /MENU -C /COPY=prog[$stream] default: /NOCOPY -C /TEST or /NOTEST default: current DWARF control parm -C /NOSUBSTITUTE default: /SUBSTITUTE -C /EXTERNAL default: /NOEXTERNAL -C------------------------------------------------------------------------- -C - CHARACTER*(*) PROGRAM - PARAMETER (PROGRAM = 'SPECIFY') -C - INTEGER NRARG, PREQ, Q, QDEF, QVAL - PARAMETER (NRARG = 7) - PARAMETER (PREQ = CLI__PARAMETER+CLI__REQUIRED) - PARAMETER (Q = CLI__QUALIFIER) - PARAMETER (QDEF = CLI__QUALIFIER+CLI__DEFAULT) - PARAMETER (QVAL = CLI__QUALIFIER+CLI__VALUE) - CHARACTER*10 NAME(NRARG) - INTEGER ATTR(NRARG) - CHARACTER*14 PROMPT(NRARG) - CHARACTER*1 DEFVAL(NRARG) - DATA NAME /'PROGSTRM', - 1 'CLEAR','MENU','COPY','TEST','SUBSTITUTE','EXTERNAL'/ - DATA ATTR /PREQ, - 1 Q ,QDEF ,QVAL ,Q ,QDEF ,Q / - DATA PROMPT /'Program$stream',6*' '/ - DATA DEFVAL /7*' '/ -C - INTEGER SP_MENU, SP_NOMENU, SP_CLEAR, SP_COPY - INTEGER CLI_INIT, CLI_GET - INTEGER MSG_INIT, MSG_SET - INTEGER DWC_TEST_PUT, DWC_SYM_SPLIT, DWC_PROG_PUT - INTEGER DWC_PROG_CHECK, DWC_STREAM_CHECK, DWC_STREAM_GET - INTEGER DWC_CTL_OPEN, DWC_CTL_FILL, DWC_IBMODE_INQ - INTEGER PPD_INIT, PPD_EXIT - INTEGER SYMBOL_EXIT -C - CHARACTER PROGSTRM*22, PROG*9, TMPSTRM*12, STREAM*12, KEY*16 - CHARACTER INPUTPS*22, INPROG*9, INSTREAM*12, LINE*255, DUM*1 - INTEGER IS, LPS, LP, LS, LK, LIPS, LIP, LIS, LL, LDUM - LOGICAL IS_GLOBAL, IS_DCL - LOGICAL DO_MENU, DO_LOCAL, DO_SUBST, DO_EXTERN -C -C -C -C Initialize -C - get DWARF control variables -C - start messenger -C - initialize command-line interpreter -C - IS = DWC_CTL_OPEN () - IF (IAND(IS,1).EQ.0) IS = DWC_CTL_FILL () - IF (IAND(IS,1).NE.0) IS = MSG_INIT (PROGRAM,F_T) - IF (IAND(IS,1).NE.0) IS = CLI_INIT (NRARG,NAME,ATTR,PROMPT,DEFVAL) - IF (IAND(IS,1).EQ.0) GOTO 999 -C -C Get program and stream names -C - IS = CLI_GET ('PROGSTRM',PROGSTRM,LPS) - IF (IAND(IS,1).NE.0) - 1 IS = DWC_SYM_SPLIT (PROGSTRM(:LPS),PROG,LP,TMPSTRM,LS,KEY,LK) - IF (IAND(IS,1).NE.0) - 1 IS = DWC_PROG_CHECK (PROG(:LP),LP,IS_GLOBAL) - IF (IAND(IS,1).EQ.0) GOTO 999 - IF (LS.GT.0) THEN - IS = DWC_STREAM_CHECK (TMPSTRM(:LS),STREAM,LS,IS_GLOBAL) - ELSE - IS = DWC_STREAM_GET (STREAM,LS,IS_GLOBAL) - END IF - IF (IAND(IS,1).EQ.0) GOTO 999 -C -C If the TEST qualifier is given, -C enable or disable test mode accordingly -C - IS = CLI_GET ('TEST',DUM,LDUM) - IF (IAND(IS,1).EQ.0) GOTO 999 - IF (IS.NE.DWC_ABSENT) IS = DWC_TEST_PUT (IS.EQ.DWC_PRESENT) -C -C Get names of input program and stream -C - IS = CLI_GET ('COPY',INPUTPS,LIPS) - IF (IAND(IS,1).EQ.0) GOTO 999 - IF (LIPS.GT.0) THEN - IS = DWC_SYM_SPLIT (INPUTPS(:LIPS),INPROG,LIP, - 1 TMPSTRM,LIS,KEY,LK) - IF (IAND(IS,1).NE.0) - 1 IS = DWC_PROG_CHECK (INPROG(:LIP),LIP,IS_GLOBAL) - IF (IAND(IS,1).NE.0 .AND. LIS.GT.0) THEN - IS = DWC_STREAM_CHECK (TMPSTRM(:LIS),INSTREAM,LIS, - 1 IS_GLOBAL) - ELSE - IS = DWC_STREAM_GET (INSTREAM,LIS,IS_GLOBAL) - END IF - IF (IAND(IS,1).EQ.0) GOTO 999 - END IF -C -C /MENU is not allowed in batch mode -C - IS = CLI_GET ('MENU',DUM,LDUM) - IF (IAND(IS,1).EQ.0) GOTO 999 - DO_MENU = IS.NE.DWC_NEGATED - IF (DO_MENU .AND. IAND(DWC_IBMODE_INQ('BATCH'),1).NE.0) THEN - IS = MSG_SET (DWC_QUALBATCH,1) - CALL WNCTXT(DWLOG,DWMSG,'/MENU') - IS = DWC_SUCCESS - GOTO 999 - END IF -C -C Open the PPD file -C - IS = PPD_INIT (PROG(:LP)) - IF (IAND(IS,1).EQ.0) GOTO 999 -C -C Set program name to program being specified -C - IS = DWC_PROG_PUT (PROG(:LP)) -C -C Check whether local defaults are -C allowed if program is not 'GLOBAL' -C - DO_LOCAL = PROG(:LP).NE.'GLOBAL' -C -C Clear existing defaults if requested -C - IS = CLI_GET ('CLEAR',DUM,LDUM) - IF (IAND(IS,1).EQ.0) GOTO 999 - IF (IS.EQ.DWC_PRESENT) THEN - IS = SP_CLEAR (PROG(:LP),STREAM(:LS)) - IF (IAND(IS,1).EQ.0) GOTO 999 - END IF -C -C Copy defaults if requested -C - IF (LIPS.GT.0) THEN - IS = SP_COPY (PROG(:LP),STREAM(:LS),INPROG(:LIP),INSTREAM(:LIS)) - IF (IAND(IS,1).EQ.0) GOTO 999 - END IF -C - IS = CLI_GET ('SUBSTITUTE',DUM,LDUM) - IF (IAND(IS,1).EQ.0) GOTO 999 - DO_SUBST = IS.NE.DWC_NEGATED -C - IS = CLI_GET ('EXTERNAL',DUM,LDUM) - IF (IAND(IS,1).EQ.0) GOTO 999 - DO_EXTERN = IS.EQ.DWC_PRESENT -C -C Ask or accept default values -C - IS_DCL = .FALSE. - IF (DO_MENU) THEN - IS = SP_MENU (PROG(:LP),STREAM(:LS),DO_LOCAL,DO_SUBST,DO_EXTERN) - ELSE - IS = SP_NOMENU (PROG(:LP),STREAM(:LS),DO_LOCAL,DO_SUBST, - 1 IS_DCL,LINE,LL) - END IF -C -C Wrap-up -C - close the PPD file -C - assemble DWARF symbols (if applicable) -C - terminate the program -C - IS = PPD_EXIT () - IF (PROG(:LP).EQ.'DWARF') IS = DWC_CTL_FILL () - IS = SYMBOL_EXIT () - 999 E_C = MSG_SET(IS,0) !WNGEX exit code - END diff --git a/src/dwarf/splist.for b/src/dwarf/splist.for deleted file mode 100644 index d27e79109f84d32a2907ef89410a5c7ef78ae782..0000000000000000000000000000000000000000 --- a/src/dwarf/splist.for +++ /dev/null @@ -1,208 +0,0 @@ -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ -C.Ident: SP_LIST -C.Keywords: Program Parameters, External Defaults, Specify -C.Author: Friso Olnon (NFRA, Dwingeloo) -C.Language: DWARF-Fortran -C.Environment: VAX or Alliant -C.Comments: -C.Version: 910911 FMO - created -C.Version: 911206 GvD - function was LOGICAL iso. INTEGER -C split into SP_LIST and SP_LIST_KEY -C.Version: 920214 GvD - no optional arguments in MSG anymore -C.Version: 940223 CMV - Handle quotes properly -C.Version: 010709 AXC - Linux port - Quals(QPTR:QPTR) changed -C------------------------------------------------------------------------- -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - INTEGER FUNCTION SP_LIST (PROGNAM,STREAM,QUALS) -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' -C - CHARACTER*(*) PROGNAM !(i) DWARF program name - CHARACTER*(*) STREAM !(i) stream name (with $ prefix) - CHARACTER*(*) QUALS !(i) line with qualifiers -C -C -C.Purpose: Define external defaults for program parameters -C.Returns: Status code (.TRUE. for success, otherwise .FALSE.) -C success DWC_SUCCESS -C error 2 -C.Notes: -C - The qualifier line consists of concatenated elements of the format: -C /<keyword>=<value_string> -C where <keyword> is the user's name for a parameter in the current -C program, and where <value_string> must obey the same rules as the -C answers to DWARF prompts, except that question marks and value -C qualifiers are not allowed. -C - If QUALS is blank or does not start with a slash, the routine -C immediately returns with a success status. -C - The keywords and values will be checked and if they are correct, the -C corresponding DWARF symbols will be defined. -C------------------------------------------------------------------------- -C -C - CHARACTER*(*) BLANK, TAB, WHITE, QUOTE - PARAMETER (BLANK = ' ') - PARAMETER (TAB = ' ') - PARAMETER (WHITE = BLANK//TAB) - PARAMETER (QUOTE = '"') -C - INTEGER SP_LIST_KEY - INTEGER DWC_STR_STANDARD - INTEGER STR_COPY_U, STR_SKIP_W, WNCAL0, WNCALN -C - CHARACTER LINE*255, WORK*255, KEY*16 - INTEGER LW, LL, LK, LQ - INTEGER IS, TMP, PTR, QPTR, QPTR2 - LOGICAL QUOTED -C -C -C QUALS string must start with / -C - LQ = WNCAL0(QUALS) - IF (LQ.EQ.0 .OR. QUALS(1:1).NE.'/') GOTO 900 -C -C Extract next qualifier -C - QPTR = 1 - 100 IF (QPTR.GE.LQ) GOTO 900 !end of QUALS: ready - QPTR = QPTR+1 !skip slash - TMP= STR_SKIP_W (WHITE,QUALS(:LQ),QPTR) !skip leading whites - LW = 0 !clear work string -C -C Skip up to the next slash that appears outside quotes -C - QUOTED=.FALSE. - QPTR2=QPTR - DO WHILE (QPTR.LT.LQ.AND. - 1 (QUALS(QPTR:QPTR).NE.'/'.OR.QUOTED)) - IF (QUALS(QPTR:QPTR).EQ.QUOTE) THEN - QUOTED=.NOT.QUOTED - END IF - QPTR=QPTR+1 - END DO - IF (QUALS(QPTR:QPTR).EQ.'/') QPTR=QPTR-1 - IF (QPTR.EQ.QPTR2) GOTO 100 !empty: go for next - WORK=QUALS(QPTR2:QPTR) - LW=WNCALN(WORK) - TMP = DWC_STR_STANDARD (WORK(:LW),LINE,LL) !standardise string - IF (LL.EQ.0) GOTO 100 !empty: go for next -C -C Extract keyword -C - PTR = 1 - KEY = BLANK - LK = 0 !clear keyword - IF (LINE(1:1).EQ.'?') GOTO 991 !no ? allowed - IS = STR_COPY_U ('=',LINE(:LL),PTR,KEY,LK) !read keyword - IF (LK.EQ.0 .OR. PTR.GE.LL) GOTO 991 !key or value missing - PTR = PTR+1 !skip equal sign - IF (LINE(PTR:PTR).EQ.BLANK) PTR = PTR+1 !skip blank -C -C Check and define the value -C Go for next qualifier -C - IS = SP_LIST_KEY (PROGNAM,STREAM,KEY,LINE(PTR:LL)) - IF (IAND(IS,1).EQ.0) GOTO 999 - GOTO 100 -C - 900 SP_LIST = DWC_SUCCESS - RETURN -C - 991 IS=2 - CALL WNCTXT(DWLOG,'Incorrect definition syntax: !AS',LINE(:LL)) - GOTO 999 -C - 999 SP_LIST = IS - RETURN - END -C------------------------------------------------------------------------- -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - INTEGER FUNCTION SP_LIST_KEY (PROGNAM,STREAM,PKEY,VAL) -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' -C - CHARACTER*(*) PROGNAM !(i) DWARF program name - CHARACTER*(*) STREAM !(i) stream name (with $ prefix) - CHARACTER*(*) PKEY !(i) PPD keyword name - CHARACTER*(*) VAL !(i) keyword value -C -C -C.Purpose: Define external default for program parameter -C.Returns: Status code (.TRUE. for success, otherwise .FALSE.) -C success DWC_SUCCESS -C error 2 -C.Notes: -C - The keyword and value will be checked and if they are correct, the -C corresponding DWARF symbol will be defined. -C------------------------------------------------------------------------- -C -C - INTEGER SP_DEF_CHECK - INTEGER DWC_SYM_BUILD - INTEGER PPD_READ_U, PPD_SSTR_GET, PPD_IOCD_GET - INTEGER SYMBOL_DEFINE, WNCALN -C - CHARACTER WORK*255, SYMBOL*40, KEY*16 - CHARACTER SSTR*5, GROUP*9, IOCD*8 - INTEGER LK, LW, LS, LG, LI, LSYM - INTEGER IS, LEVEL -C -C Read parameter description from PPD -C - read by user's name -C - only accept input-type parms -C which can have a local default -C - KEY = PKEY - LK = WNCALN (PKEY) - IS = PPD_READ_U (KEY) !key maybe expanded !! - IF (IS.EQ.PPD_KEYAMBIG) GOTO 992 !ambiguous abbrev - IF (IAND(IS,1).EQ.0) GOTO 993 !unknown key - LK = WNCALN (KEY) - IS = PPD_IOCD_GET (IOCD,LI) !get I/O code - IF (IAND(IS,1).EQ.0) GOTO 999 - IF (INDEX('MI',IOCD(:1)).EQ.0) GOTO 994 !no input parameter - IS = PPD_SSTR_GET (SSTR,LS,GROUP,LG) !get default types - IF (IAND(IS,1).EQ.0) GOTO 999 - IF (INDEX(SSTR(:LS),'L').EQ.0) GOTO 995 !no local default -C -C Check the value -C - LEVEL = 0 !dummy help level - IS = DWC_SYM_BUILD (PROGNAM,STREAM,KEY(:LK),SYMBOL,LSYM) - IF (IAND(IS,1).EQ.0) GOTO 999 - IS = SP_DEF_CHECK (SYMBOL(:LSYM),LEVEL,-1,VAL,WORK,LW,.TRUE.) - IF (IS.EQ.DWC_KEYVAHELP) GOTO 996 !no ? allowed - IF (IAND(IS,1).EQ.0) GOTO 999 -C -C Define the symbol -C - IS = SYMBOL_DEFINE (SYMBOL(:LSYM),WORK(:LW),DWC__GLOBALSYM) - IF (IAND(IS,1).EQ.0) GOTO 999 -C -C - 900 SP_LIST_KEY = DWC_SUCCESS - RETURN -C - 992 IS = 2 - CALL WNCTXT(DWLOG,'Ambiguous abbreviation, !AS, matches:', - 1 KEY(:LK)) - GOTO 999 - 993 IS = 2 - CALL WNCTXT(DWLOG,'Unknown parameter: !AS',KEY(:LK)) - GOTO 999 - 994 IS = 2 - CALL WNCTXT(DWLOG,'Unknown input paramater: !AS',KEY(:LK)) - GOTO 999 - 995 IS = 2 - CALL WNCTXT(DWLOG,'No local default allowed for !AS',KEY(:LK)) - GOTO 999 - 996 IS = 2 - CALL WNCTXT(DWLOG,'Incorrect value for !AS: !AS',KEY(:LK), - 1 WORK(:LW)) - GOTO 999 -C - 999 SP_LIST_KEY = IS - RETURN - END diff --git a/src/dwarf/spmenu.for b/src/dwarf/spmenu.for deleted file mode 100644 index db76b6b0fc3ac7cf99466e327827106ae0b498f2..0000000000000000000000000000000000000000 --- a/src/dwarf/spmenu.for +++ /dev/null @@ -1,159 +0,0 @@ -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ -C.Ident: SP_MENU -C.Keywords: Program Parameters, External Defaults, Specify -C.Author: Friso Olnon (NFRA, Dwingeloo) -C.Language: DWARF-Fortran -C.Environment: VAX or Alliant -C.Comments: -C.Version: 900416 FMO - recreation -C.Version: 901217 FMO - write messages on retry (label 300) -C.Version: 920206 GvD - add former optional arguments to DWC_INPUT -C------------------------------------------------------------------------- -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - INTEGER*4 FUNCTION SP_MENU (PROGNAM,STREAM,DO_LOCAL,DO_SUBST, - 1 DO_EXTERN) -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' -C - CHARACTER*(*) PROGNAM ! (i) program name - CHARACTER*(*) STREAM ! (i) stream name - LOGICAL*4 DO_LOCAL ! (i) only prompt for local defaults ? - LOGICAL*4 DO_SUBST ! (i) symbol substitution requested ? - LOGICAL*4 DO_EXTERN ! (i) only change external defaults ? -C -C.Purpose: Let the user define external defaults -C.Returns: Status code (.TRUE. for success, .FALSE. otherwise) -C success DWC_SUCCESS -C.Notes: -C - The user will be prompted to specify default values for all -C parameters defined in the PPD file of the current program. -C - The given values will be checked and if they are correct, the -C corresponding DWARF symbols will be defined. -C - The user can get help information for each parameter by answering -C with a question mark. The value prompt will be repeated. -C - The user can give a CTRL/Z or # answer to indicate that he doesn't -C wish to set any further defaults. -C -C Special features (see PPD definitions): -C - OUTPUT type parameters are never shown. -C - For parameters that cannot have an external default the current -C default will be shown, but the user cannot specify an other default. -C - TEST parameters will only be shown if DWARF is in test mode (set -C via SPECIFY DWARF or by giving the command SPECIFY/TEST program). -C - In DO_EXTERN mode (SPECIFY/EXTERNAL was given), the routine will -C only show (and prompt for) those parameters for which an external -C default already exists. -C This mode can be used to edit a set of defaults created through -C EXECUTE/SAVE without interference from parameters irrelevant to the -C application. -C------------------------------------------------------------------------- -C -C - CHARACTER*(*) BLANK, OPNPAR, CLOPAR, EQUALS - PARAMETER (BLANK = ' ' ) - PARAMETER (OPNPAR = ' (') - PARAMETER (CLOPAR = ')' ) - PARAMETER (EQUALS = ' = ') -C - INTEGER*4 DWC_TEST_INQ, DWC_LEVEL_GET, DWC_SYM_BUILD - INTEGER*4 DWC_INPUT, SP_DEF_CHECK, PV_DEF_GET - INTEGER*4 PPD_READ_U, PPD_READ_UNXT, PPD_UNAM_GET, PPD_IOCD_GET - INTEGER*4 PPD_AMAS_GET, PPD_SSTR_GET, PPD_PROMPT - INTEGER*4 STR_COPY, SYMBOL_DEFINE - INTEGER*4 MSG_SET -C - CHARACTER*255 VALUE, WORK, PROMP1, PROMP2 - INTEGER*4 LVAL, LW, LP1, LP2 - CHARACTER SYMBOL*50, UKEY*16, IOCD*8, TYPE*16, SSTR*5, GROUP*9 - INTEGER*4 LSYM, LU, LMIN, LI, LT, LS, LG - INTEGER*4 IS, CURLEVEL, MAXLEVEL, DLEVEL - LOGICAL*4 SWP, PROTO, TEST_MODE -C -C - SP_MENU = DWC_SUCCESS -C -C Go through the PPD file -C - TEST_MODE = DWC_TEST_INQ () - IS = PPD_READ_U (BLANK) - IF (IAND(IS,1).EQ.0) GOTO 999 - DO WHILE (IAND(IS,7).EQ.1) - IS = PPD_UNAM_GET (UKEY,LU,LMIN,PROTO) - IF (IAND(IS,1).NE.0) IS = PPD_IOCD_GET (IOCD,LI) - IF (IAND(IS,1).EQ.0) GOTO 999 -C -C - skip TEST params unless in test mode -C - skip non-input params -C - IF (.NOT.TEST_MODE - 1 .AND. IAND(PPD_AMAS_GET('TEST'),1).NE.0) GOTO 500 - IF (IOCD(1:1).NE.'I' .AND. IOCD(1:1).NE.'M') GOTO 500 -C -C Get the current value for this parameter -C - in DO_EXTERN mode, prompt only if -C an external default already exists. -C - IS = DWC_SYM_BUILD (PROGNAM,STREAM,UKEY,SYMBOL,LSYM) - DLEVEL = 0 - 300 IS = PV_DEF_GET (SYMBOL(:LSYM),VALUE,LVAL,TYPE,LT) - IF (DO_EXTERN .AND. (LT.EQ.0 .OR. TYPE(1:1).EQ.'p')) GOTO 500 -C -C Put the type of default and its value -C in the prompt string -C - LP2 = 0 - IF (LT.NE.0) THEN - IS = STR_COPY (OPNPAR//TYPE(:LT)//CLOPAR,PROMP2,LP2) - IF (LVAL.GT.0) IS = STR_COPY (EQUALS//VALUE(:LVAL), - 1 PROMP2,LP2) - ENDIF -C -C If the user cannot specify a local -C value, print the value and a message -C - IF (DO_LOCAL) THEN - IS = PPD_SSTR_GET (SSTR,LS,GROUP,LG) - IF (INDEX(SSTR(:LS),'L').EQ.0) THEN - IS = MSG_SET (DWC_NOLOCVAL,1) - CALL WNCTXT(DWLOG,DWMSG,UKEY) - IF (LVAL.GT.0) THEN - CALL WNCTXT (DWLOG,' !AS!AS', - 1 UKEY,PROMP2(:LP2)) - ENDIF - GOTO 500 - ENDIF - ENDIF -C -C Prompt on SYS$COMMAND (= terminal) -C - SWP = .FALSE. - IS = DWC_LEVEL_GET (CURLEVEL,MAXLEVEL) - IS = PPD_PROMPT (BLANK,CURLEVEL+DLEVEL,SWP,PROMP1,LP1) - IS = DWC_INPUT (WORK,PROMP1(:LP1)//PROMP2(:LP2),LW,1,0) - IF (IAND(IS,1).EQ.0) GOTO 999 !CTRL/Z -C -C Check the value -C - if OK: define the symbol -C - otherwise: repeat the question -C - IF (LW.GT.0) THEN - IS = SP_DEF_CHECK (SYMBOL(:LSYM),DLEVEL,0,WORK(:LW), - 1 VALUE,LVAL,DO_SUBST) - IF (IAND(IS,1).EQ.0) THEN - GOTO 300 - ENDIF - IS = SYMBOL_DEFINE (SYMBOL(:LSYM),VALUE(:LVAL), - 1 DWC__GLOBALSYM) - ENDIF - 500 IS = PPD_READ_UNXT () - IF (IAND(IS,1).EQ.0) GOTO 999 - ENDDO -C -C - SP_MENU = DWC_SUCCESS - RETURN -C - 999 SP_MENU = DWC_SUCCESS - RETURN - END diff --git a/src/dwarf/spnomenu.for b/src/dwarf/spnomenu.for deleted file mode 100644 index c291f33e144d92f7328d8d514139dc214a2281ad..0000000000000000000000000000000000000000 --- a/src/dwarf/spnomenu.for +++ /dev/null @@ -1,153 +0,0 @@ -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ -C.Ident: SP_NOMENU -C.Keywords: Program Parameters, External Defaults, Specify -C.Author: Friso Olnon (NFRA, Dwingeloo) -C.Language: DWARF-Fortran -C.Environment: VAX or Alliant -C.Comments: -C.Version: 900412 FMO - new code -C.Version: 920206 GvD - add former optional arguments to DWC_INPUT -C------------------------------------------------------------------------- -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - INTEGER*4 FUNCTION SP_NOMENU (PROGNAM,STREAM,DO_LOCAL,DO_SUBST, - 1 IS_DCL,LINE,LL) -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' -C - CHARACTER*(*) PROGNAM ! (i) program name - CHARACTER*(*) STREAM ! (i) stream name - LOGICAL*4 DO_LOCAL ! (i) only prompt for local defaults ? - LOGICAL*4 DO_SUBST ! (i) symbol substitution requested ? - LOGICAL*4 IS_DCL ! (o) DCL command given ? - CHARACTER*(*) LINE ! (o) last input line given - INTEGER*4 LL ! (o) significant length of LINE -C -C.Purpose: Let the user define external defaults -C.Returns: Status code (.TRUE. for success, .FALSE. otherwise) -C success DWC_SUCCESS -C.Notes: -C - The user can enter value definitions in the format: -C <keyword> = <value_string> -C where <keyword> is the user's name for a parameter in the current -C program, and where the value string must obey the same rules as the -C answers to DWARF prompts. -C - The values will be checked and if they are correct, the -C corresponding DWARF symbols will be defined. -C - The user can get help information on all parameters by entering -C one or more question marks. He can also request help for a single -C parameter by entering question marks as the value. -C - An empty answer (just pressing RETURN) signals the end of input. -C - An answer starting with '$' is interpreted as a DCL command line. -C In that case, the function returns with IS_DCL set to .TRUE. and the -C command line in LINE(:LL). -C - If an answer is found to be wrong in any way, the relevant messages -C will be written and the routine expects the next input line. -C------------------------------------------------------------------------- -C -C - CHARACTER*(*) BLANK, DOLLAR, WILD, EQUAL - PARAMETER (BLANK = ' ') - PARAMETER (DOLLAR = '$') - PARAMETER (WILD = '*') - PARAMETER (EQUAL = '=') -C - INTEGER*4 SP_DEF_CHECK - INTEGER*4 DWC_SYM_BUILD, DWC_HELP, DWC_INPUT - INTEGER*4 PPD_HELP, PPD_READ_U, PPD_SSTR_GET, PPD_IOCD_GET - INTEGER*4 MSG_SET - INTEGER*4 STR_COPY_U, STR_SIGLEN, SYMBOL_DEFINE -C - CHARACTER WORK*255, SYMBOL*40, KEY*16 - CHARACTER SSTR*5, GROUP*9, IOCD*8 - INTEGER*4 LW, LSYM, LK, LS, LG, LI - INTEGER*4 IS, LEVEL, PTR -C -C -C Accept next value definition -C - 100 IS = DWC_INPUT (LINE,BLANK,LL,0,0) - IF (IAND(IS,1).EQ.0 .OR. LL.EQ.0) GOTO 900 ! end of input - IF (LINE(1:1).EQ.DOLLAR) GOTO 990 ! DCL command -C -C Help requested ? -C - IS = DWC_HELP (LINE(:LL),-1,LEVEL) ! returns nr of '?' - IF (IAND(IS,1).EQ.0) GOTO 999 - IF (IS.EQ.DWC_KEYVAHELP) THEN - IS = PPD_HELP (WILD,.FALSE.,.TRUE.,.FALSE.,LEVEL,6) - IF (IAND(IS,1).EQ.0) GOTO 999 - GOTO 100 - ENDIF -C -C Extract keyword -C - KEY = BLANK - LK = 0 - PTR = 1 - IS = STR_COPY_U (EQUAL,LINE(:LL),PTR,KEY,LK) - IF (LK.EQ.0 .OR. PTR.GE.LL) GOTO 991 ! no key or value - PTR = PTR+1 ! skip equal sign - IF (LINE(PTR:PTR).EQ.BLANK) PTR = PTR+1 ! skip blank -C -C Read parameter description from PPD -C - read by user's name -C - only accept input-type parms -C - IS = PPD_READ_U (KEY) ! key maybe expanded !! - LK = STR_SIGLEN (KEY) - IF (IS.EQ.PPD_KEYAMBIG) GOTO 992 ! ambiguous abbrev - IF (IAND(IS,1).EQ.0) GOTO 993 ! unknown parameter - IS = PPD_IOCD_GET (IOCD,LI) - IF (IAND(IS,1).EQ.0) GOTO 999 - IF (INDEX('MI',IOCD(:1)).EQ.0) GOTO 994 ! no input parameter -C -C Compose the symbol name -C - IS = DWC_SYM_BUILD (PROGNAM,STREAM,KEY(:LK),SYMBOL,LSYM) - IF (IAND(IS,1).EQ.0) GOTO 999 -C -C Interpret the value -C - IS = SP_DEF_CHECK (SYMBOL(:LSYM),LEVEL,1,LINE(PTR:LL), - 1 WORK,LW,DO_SUBST) - IF (IS.EQ.DWC_KEYVAHELP) GOTO 100 ! help given - IF (IAND(IS,1).EQ.0) GOTO 999 -C -C Can we specify a local default ? -C - IF (DO_LOCAL) THEN - IS = PPD_SSTR_GET (SSTR,LS,GROUP,LG) - IF (IAND(IS,1).EQ.0) GOTO 999 - IF (INDEX(SSTR(:LS),'L').EQ.0) GOTO 995 - ENDIF -C -C Define the symbol -C - IS = SYMBOL_DEFINE (SYMBOL(:LSYM),WORK(:LW),DWC__GLOBALSYM) - IF (IAND(IS,1).EQ.0) GOTO 999 -C - GOTO 100 -C - 991 IS = MSG_SET (DWC_SPECWRSYN,0) - GOTO 100 - 992 IS = MSG_SET (PPD_KEYAMBIG,1) - CALL WNCTXT(DWLOG,DWMSG,KEY(:LK)) - GOTO 100 - 993 IS = MSG_SET (DWC_UNKKEYW,1) - CALL WNCTXT(DWLOG,DWMSG,KEY(:LK),BLANK,PROGNAM) - GOTO 100 - 994 IS = MSG_SET (DWC_UNKKEYW,1) - CALL WNCTXT(DWLOG,DWMSG,KEY(:LK),' input-',PROGNAM) - GOTO 100 - 995 IS = MSG_SET (DWC_NOLOCVAL,1) - CALL WNCTXT(DWLOG,DWMSG,KEY(:LK)) - GOTO 100 - 999 GOTO 100 -C -C - 990 IS_DCL = .TRUE. - 900 SP_NOMENU = DWC_SUCCESS - RETURN - END - diff --git a/src/dwarf/src.grp b/src/dwarf/src.grp deleted file mode 100644 index 42231af742b6fb2aa7f9ea0a8792c86a32006b1f..0000000000000000000000000000000000000000 --- a/src/dwarf/src.grp +++ /dev/null @@ -1,107 +0,0 @@ -!+ SRC.GRP -! WNB 920915 -! -! Revisions: -! HjV 921104 Add routine and entry names -! WNB 921214 Remove NGIDS (see NPLOT) -! Remove DATAB (not relevant) -! HjV 930226 Add DWARFINI.COM (For VAX) -! Add DWARFCSHRC_WSRT.SUN -! Make DWARFCSHRC_NFRA.SSC iso. .SUN -! WNB 930302 Remove DWARFINI.COM; make all SSC ipv SUN/COM -! Add RAIUB -! HjV 930630 Add KOSMA -! HjV 930914 Add ARECB -! CMV 931019 Change MESSENGERBLOCK.FOR to MSG_BD.FOR -! CMV 940120 Removed PRINTBLOCK.FOR and DID.PIN -! CMV 940131 Keep only SSC files here, obsolete with new -! maintenance system -! HjV 940218 Add contents of SYS.GRP -! WNB 940304 Add DWE.DSC -! -! General routines for DWARF programs -! -! Group definition: -! -SRC.GRP -! -! Masks for program development -! -! PIN files -! -DWARF.PIN ! -GLOBAL.PIN ! -! -! Structure files -! -DWE.DSC ! Switch handling in DWE -! -! Help files -! -CALCULATE.HLP ! -DWARFINI.HLP ! -DWARFNEWS.HLP ! -! -! -! General command files -! -DWARF_ALIAS.SSC ! -DWARFCSHRC.SSC ! -DWARFCSHRC_ATNF.SSC ! -DWARFCSHRC_NFRA.SSC ! -DWARFCSHRC_RAIUB.SSC ! -DWARFCSHRC_RUG.SSC ! -DWARFCSHRC_WSRT.SSC ! -DWARFCSHRC_KOSMA.SSC ! -DWARFCSHRC_ARECB.SSC ! -DWARFLOGIN.SSC ! -DWARFLOGOUT.SSC ! -! -! Initialisation command files -! -! -! Fortran definition files: -! -! -! Programs: -! -!- -SYS_BLDPPD.FOR !SYS_BLDPPD -CALCULATE.FOR !CALCULATE - !CALCUL_QUAL - !CALCUL_DEF -CLEAR.FOR !CLEAR -EXECUTE.FSC !EXECUTE -INITDW.FOR !INITDW -LET.FOR !LET -PRTPPD.FOR !SYS_PRTPPD -RESTORE.FOR !RESTORE -SAVE.FOR !SAVE -SPECIFY.FOR !SPECIFY - SPCLEAR.FOR !SP_CLEAR - SPCOPY.FOR !SP_COPY - SPDEFCHECK.FOR !SP_DEF_CHECK - SPLIST.FOR !SP_LIST - !SP_LIST_KEY - SPMENU.FOR !SP_MENU - SPNOMENU.FOR !SP_NOMENU -VIEW.FOR !VIEW - VPDEFCHECK.FOR !VP_DEF_CHECK -! -! Executables -! -SYS_BLDPPD.EXE -A1 ! -CALCULATE.EXE -A1 ! -CLEAR.EXE -A1 ! -EXECUTE.EXE -A1 ! -INITDW.EXE -A1 ! -LET.EXE -A1 ! -SYS_PRTPPD.EXE -A1 ! -PRTUNITS.EXE -A1 ! -RESTORE.EXE -A1 ! -SAVE.EXE -A1 ! -SPECIFY.EXE -A1 ! -VIEW.EXE -A1 ! - - - diff --git a/src/dwarf/strcheck.for b/src/dwarf/strcheck.for deleted file mode 100644 index 2f8e4da9eac37243f942a795f9440ad781e1af7b..0000000000000000000000000000000000000000 --- a/src/dwarf/strcheck.for +++ /dev/null @@ -1,107 +0,0 @@ -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ -C.Ident: STR_CHECK -C.Keywords: String, Check Type -C.Author: Ger van Diepen (NFRA, Dwingeloo) -C.Language: DWARF-Fortran -C.Environment: VAX or Alliant -C.Comments: -C.Version: 821203 GVD - creation of GENISNUM -C.Version: 831110 GVD -C.Version: 890112 FMO - removed optional arguments: length check must be -C done by caller, no messages are stored. -C - no GEN status codes are returned -C - new code using STR_SKIP -C------------------------------------------------------------------------- -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - INTEGER*4 FUNCTION STR_CHECK_ALPH (STRING) -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' - INTEGER*4 STR_CHECK_NUM !(STRING) - INTEGER*4 STR_CHECK_ANUM !(STRING) - INTEGER*4 STR_CHECK_ANUM_ !(STRING) - INTEGER*4 STR_CHECK_ANUMX !(STRING) - INTEGER*4 STR_CHECK_ANUMA !(STRING) -C - CHARACTER*(*) STRING ! (i) string to be checked -C -C.Purpose: Check the type of the string -C.Returns: Status code (.TRUE. for success, .FALSE. otherwise) -C.Notes: -C ALPH alphabetic (uppercase only) -C NUM numeric (digits only) -C ANUM alphanumeric -C ANUM_ extended alphanumeric (_ also allowed) -C ANUMX extended alphanumeric (_ and $ also allowed) -C ANUMA alphanumeric but first character must be alphabetic -C -C Null-strings are acceptable for all types except ANUMA. -C------------------------------------------------------------------------- -C - CHARACTER*(*) ALPHABET, DIGITS, USCORE, DOLLAR - PARAMETER (ALPHABET = 'ABCDEFGHIJKLMNOPQRSTUVWXYZ') - PARAMETER (DIGITS = '0123456789') - PARAMETER (USCORE = '_') - PARAMETER (DOLLAR = '$') -C - INTEGER*4 STR_SKIP_W -C - INTEGER*4 PTR, NSKIP -C -C -C ENTRY STR_CHECK_ALPH (STRING) -C - PTR = 1 - NSKIP = STR_SKIP_W (ALPHABET,STRING,PTR) - STR_CHECK_ALPH = NSKIP.EQ.LEN(STRING) - RETURN -C -C - ENTRY STR_CHECK_NUM (STRING) -C - PTR = 1 - NSKIP = STR_SKIP_W (DIGITS,STRING,PTR) - STR_CHECK_NUM = NSKIP.EQ.LEN(STRING) - RETURN -C -C - ENTRY STR_CHECK_ANUM (STRING) -C - PTR = 1 - NSKIP = STR_SKIP_W (ALPHABET//DIGITS,STRING,PTR) - STR_CHECK_ANUM = NSKIP.EQ.LEN(STRING) - RETURN -C -C - ENTRY STR_CHECK_ANUM_ (STRING) -C - PTR = 1 - NSKIP = STR_SKIP_W (ALPHABET//DIGITS//USCORE,STRING,PTR) - STR_CHECK_ANUM_ = NSKIP.EQ.LEN(STRING) - RETURN -C -C - ENTRY STR_CHECK_ANUMX (STRING) -C - PTR = 1 - NSKIP = STR_SKIP_W (ALPHABET//DIGITS//USCORE//DOLLAR,STRING,PTR) - STR_CHECK_ANUMX = NSKIP.EQ.LEN(STRING) - RETURN -C -C - ENTRY STR_CHECK_ANUMA (STRING) -C - PTR = 1 - NSKIP = STR_SKIP_W (ALPHABET,STRING,PTR) - IF (NSKIP.EQ.0) THEN - STR_CHECK_ANUMA = 0 - ELSE IF (PTR.GT.LEN(STRING)) THEN - STR_CHECK_ANUMA = 1 - ELSE - NSKIP = STR_SKIP_W (ALPHABET//DIGITS,STRING,PTR) - STR_CHECK_ANUMA = PTR.GT.LEN(STRING) - ENDIF - RETURN -C -C - END diff --git a/src/dwarf/strcollaps.for b/src/dwarf/strcollaps.for deleted file mode 100644 index 5127af026d8d7845c30e1d747288bb5eb26d6865..0000000000000000000000000000000000000000 --- a/src/dwarf/strcollaps.for +++ /dev/null @@ -1,69 +0,0 @@ -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ -C.Ident: STR_COLLAPS -C.Keywords: String, Collapse -C.Author: Ger van Diepen (NFRA, Dwingeloo) -C.Language: DWARF-Fortran -C.Environment: VAX or Alliant -C.Comments: -C.Version: 821115 GVD - creation DWC_REMBLK -C.Version: 881018 FMO - complete revision -C.Version: 920221 GvD - no optional arguments in MSG anymore -C------------------------------------------------------------------------- -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - INTEGER*4 FUNCTION STR_COLLAPS (STRING) -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' -C - CHARACTER*(*) STRING ! (m) character string -C -C.Purpose: Remove blanks and tabs that are not part of a quoted substring -C.Returns: Significant length of collapsed string -C.Notes: -C------------------------------------------------------------------------- -C - CHARACTER*(*) QUOTE, BLANK, TAB, WHITE - PARAMETER (QUOTE = '"') - PARAMETER (BLANK = ' ') - PARAMETER (TAB = ' ') - PARAMETER (WHITE = BLANK//TAB) -C - INTEGER*4 STR_SIGLEN, STR_COPY, STR_COPY_U, STR_SKIP_W -C - CHARACTER*255 WORK - INTEGER*4 IS, PTR, LS, LW -C -C - LS = STR_SIGLEN (STRING) - PTR = 1 - LW = 0 -C - IS = STR_COPY_U (WHITE//QUOTE,STRING(:LS),PTR,WORK,LW) - if (is.lt.0) goto 999 - DO WHILE (PTR.LE.LS) - IF (STRING(PTR:PTR).NE.QUOTE) THEN - IS = STR_SKIP_W (WHITE,STRING(:LS),PTR) - ELSE - IS = STR_COPY (QUOTE,WORK,LW) - PTR = PTR+1 - IS = STR_COPY_U (QUOTE,STRING(:LS),PTR,WORK,LW) - IF (PTR.LE.LS) THEN - IS = STR_COPY (QUOTE,WORK,LW) - PTR = PTR+1 - ENDIF - if (is.lt.0) goto 999 - ENDIF - IS = STR_COPY_U (WHITE//QUOTE,STRING(:LS),PTR,WORK,LW) - if (is.lt.0) goto 999 - ENDDO -C - STRING = WORK(:LW) - STR_COLLAPS = LW - RETURN -C - 999 IS = 4 - CALL WNCTXT(DWLOG,'Work string in STR_COLLAPS is too short') - STR_COLLAPS = LS - RETURN -C - END diff --git a/src/dwarf/strcopy.for b/src/dwarf/strcopy.for deleted file mode 100644 index 171e474ba6f73d8c78425050caad7254f0ccfbe6..0000000000000000000000000000000000000000 --- a/src/dwarf/strcopy.for +++ /dev/null @@ -1,132 +0,0 @@ -C+++ -C.Ident: STR_COPY -C.Keywords: String, Copy -C.Author: Friso Olnon (NFRA, Dwingeloo) -C.Language: DWARF-Fortran -C.Environment: VAX or Alliant -C.File: [.SRC.GEN]STRCOPY.FOR -C.Comments: -C.Version: 880516 FMO - creation -C------------------------------------------------------------------------- -C++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - INTEGER*4 FUNCTION STR_COPY_R (STRIN,STROUT,LOUT,WIDTH) -C ENTRY STR_COPY (STRIN,STROUT,LOUT) -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' - INTEGER*4 STR_COPY ! entry point -C - CHARACTER*(*) STRIN ! (i) source string - CHARACTER*(*) STROUT ! (m) destination string - INTEGER*4 LOUT ! (m) its current length - INTEGER*4 WIDTH ! (i) width of destination field -C -C.Purpose: Copy string with or without right-adjustment -C.Returns: Nr of characters copied or -nr of characters truncated -C.Notes: -C First, LOUT is forced to a correct value: >= 0 and <= LEN(STROUT). -C Then, if WIDTH is given and positive, the source string is written -C right-adjusted into a field of that width (padded with blanks or -C truncated on the left), and the field is appended to the destination -C string. If necessary, the field is truncated on the left. -C If WIDTH is not given or not positive, the source string is appended -C to the destination string (truncated on the right if necessary). -C------------------------------------------------------------------------- -C - INTEGER*4 SAVL, NDIF -C -C - IF (WIDTH.LE.0) GOTO 100 ! no right adjust -C - SAVL = MAX(0,MIN(LOUT,LEN(STROUT))) ! destination length - LOUT = MIN(LEN(STROUT),SAVL+WIDTH) ! new dest length - NDIF = LOUT-SAVL-LEN(STRIN) ! nr chars to pad/trunc -C - IF (LEN(STRIN).EQ.0) THEN ! append blanks - IF (NDIF.GT.0) STROUT(SAVL+1:LOUT) = ' ' - STR_COPY_R = 0 - ELSE IF (NDIF.GT.0) THEN ! padded copy - STROUT(SAVL+1:SAVL+NDIF) = ' ' - STROUT(SAVL+NDIF+1:LOUT) = STRIN - STR_COPY_R = LEN(STRIN) - ELSE IF (NDIF.EQ.0) THEN ! exact copy - STROUT(SAVL+1:LOUT) = STRIN - STR_COPY_R = LEN(STRIN) - ELSE ! truncated copy - STROUT(SAVL+1:LOUT) = STRIN(1-NDIF:) - STR_COPY_R = NDIF - ENDIF -C - RETURN -C -C - ENTRY STR_COPY (STRIN,STROUT,LOUT) -C - 100 SAVL = MAX(0,MIN(LOUT,LEN(STROUT))) ! destination length - LOUT = MIN(LEN(STROUT),SAVL+LEN(STRIN)) ! new dest length - NDIF = LOUT-SAVL-LEN(STRIN) ! nr chars to truncate -C - IF (LEN(STRIN).EQ.0) THEN ! empty copy - STR_COPY = 0 - ELSE IF (NDIF.EQ.0) THEN ! exact copy - STROUT(SAVL+1:LOUT) = STRIN - STR_COPY = LEN(STRIN) - ELSE ! truncated copy - STROUT(SAVL+1:LOUT) = STRIN - STR_COPY = NDIF - ENDIF -C - RETURN - END -C++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - INTEGER*4 FUNCTION STR_COPY_U (MATCH,STRIN,PTR,STROUT,LOUT) -C INTEGER*4 ENTRY STR_COPY_W (MATCH,STRIN,PTR,STROUT,LOUT) -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' -C - INTEGER*4 STR_COPY_W -C - CHARACTER*(*) MATCH ! (i) match characters - CHARACTER*(*) STRIN ! (i) source string - INTEGER*4 PTR ! (m) current position in source string - CHARACTER*(*) STROUT ! (m) destination string - INTEGER*4 LOUT ! (m) its current length -C -C.Purpose: Copy characters until/while the character matches -C.Returns: Nr of characters copied or -nr of characters truncated -C.Notes: -C First a skip_until or skip_while operation is performed on the -C source string to find the substring to be copied. -C Then the substring is appended to the destination string via STR_COPY. -C -C Conceptually, the source string is preceded and followed by an -C infinite number of non-skip characters: -C The end of the string corresponds to PTR=LEN(STRIN)+1). If at the -C start PTR < 1 or PTR > LEN(STRIN), the function just forces LOUT -C to be correct and returns a function value 0, leaving PTR unchanged. -C------------------------------------------------------------------------- -C - INTEGER*4 STR_SKIP_U, STR_SKIP_W, STR_COPY -C - INTEGER*4 SAVP, NSKIP -C -C -C Find substring to be copied -C - SAVP = PTR - NSKIP = STR_SKIP_U (MATCH,STRIN,PTR) - GOTO 100 -C - ENTRY STR_COPY_W (MATCH,STRIN,PTR,STROUT,LOUT) -C - SAVP = PTR - NSKIP = STR_SKIP_W (MATCH,STRIN,PTR) - GOTO 100 -C -C Do the copy -C - 100 STR_COPY_U = STR_COPY (STRIN(SAVP:PTR-1),STROUT,LOUT) -C - RETURN - END diff --git a/src/dwarf/strlength.for b/src/dwarf/strlength.for deleted file mode 100644 index 03d463b5732a4a93b85fbde6c9652704308b3aa6..0000000000000000000000000000000000000000 --- a/src/dwarf/strlength.for +++ /dev/null @@ -1,42 +0,0 @@ -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ -C.Ident: STR_LENGTH -C.Keywords: String, Significant length -C.Author: Johan Hamaker (NFRA, Dwingeloo) -C.Language: DWARF-Fortran -C.Environment: VAX or Alliant -C.File: [.SRC.GEN]STRLENGTH.FOR -C.Comments: -C.Version: 840220 JPH - creation VAX-macro version (GENLENCH) -C.Version: 880309 FMO - Fortran version; no minimum length of 1 -C.Version: 920221 GvD - set correct file name in header -C------------------------------------------------------------------------- -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - INTEGER*4 FUNCTION STR_SIGLEN (STRING) -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' -C - CHARACTER*(*) STRING ! (i) character string -C -C.Purpose: Get significant length of a character string -C.Returns: Significant length -C.Notes: -C The significant length of a string is the position of the last -C non-blank/tab character (0 if there is none). -C------------------------------------------------------------------------- -C - CHARACTER*(*) BLANK, TAB, WHITE - PARAMETER (BLANK=' ') - PARAMETER (TAB=' ') - PARAMETER (WHITE=BLANK//TAB) -C -C - I = LEN(STRING) - DO WHILE (I.GT.0 .AND. INDEX(WHITE,STRING(I:I)).NE.0) - I = I-1 - ENDDO - STR_SIGLEN = I - RETURN -C -C - END diff --git a/src/dwarf/strmatch.for b/src/dwarf/strmatch.for deleted file mode 100644 index 78d9872a3a4efd0f35775d374862ae2349dddd2b..0000000000000000000000000000000000000000 --- a/src/dwarf/strmatch.for +++ /dev/null @@ -1,321 +0,0 @@ -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ -C.Ident: STR_MATCH -C.Keywords: String, Match -C.Author: Friso Olnon (NFRA, Dwingeloo) -C.Language: DWARF-Fortran -C.Environment: VAX or Alliant -C.Comments: -C.Version: 880313 FMO - creation -C.Version: 881017 FMO - ignore leading blanks and tabs in all strings -C.Version: 881228 FMO - allow empty array -C.Version: 890612 FMO - ignore leading/trailing CR and LF 's -C.Version: 910805 FMO - allow wilcards (*) in STRING, add STR_MATCH -C 941019 JPH - COMMA --> COMMA//';|' for oprions formatting -C 941212 JPH - Add '/[]' delimiters; COMMA --> DELIM -C 010709 AXC - linux port - Parameter -C------------------------------------------------------------------------- -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - INTEGER FUNCTION STR_MATCH (STR1,STR2) -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' -C - CHARACTER*(*) STR1 !(i) string to be matched - CHARACTER*(*) STR2 !(i) string to be matched with -C -C.Purpose: Check whether two strings match -C.Returns: Status code (.TRUE. if unique match, .FALSE. if not) -C success 1 full match (with or without wildcards in STR2) -C info 3 abbreviated match (only if no wildcards in STR2) -C error 2 no match -C.Notes: -C - STR1 cannot contain wildcards (*). If STR2 contains wildcards, only -C a complete match will be recognised: i.e. all non-wild substrings of -C STR2 must be present in STR1 and in the right order, and all the -C remaining substrings in STR1 must correspond with a wildcard in STR2. -C - Trailing blanks and tabs are ignored in both strings. An empty string -C never matches. -C------------------------------------------------------------------------- -C - CHARACTER*(*) WILD - PARAMETER (WILD = '*') -C - INTEGER STR_SIGLEN, STR_SKIP_U, STR_SKIP_W, STR_SKIP_PAST -C - INTEGER IS, LL1, L2, LS, P1, P2, S1, S2 - LOGICAL WILD_END -C -C - LL1 = STR_SIGLEN (STR1) !length of STR1 - IF (LL1.EQ.0) GOTO 999 !zero: no match - L2 = STR_SIGLEN (STR2) !length of STR2 - IF (L2.EQ.0) GOTO 999 !zero: no match -C -C If no wildcard in STR2: -C - IF (INDEX(STR2(:L2),WILD).EQ.0) THEN - IF (LL1.GT.L2) GOTO 999 !no match - IF (STR1(:LL1).NE.STR2(:LL1)) GOTO 999 - IF (LL1.EQ.L2) THEN - STR_MATCH = 1 !full match - ELSE - STR_MATCH = 3 !abbreviated match - END IF -C -C Otherwise: -C - check start of STR2 for wildcards -C - ELSE - P1 = 1 !pointer in STR1 - P2 = 1 !pointer in STR2 - IS = STR_SKIP_W (WILD,STR2(:L2),P2) !skip leading wildcards - IF (P2.GT.L2) THEN !completely wild STR2 - STR_MATCH = 1 ! STR1 always matches - RETURN - END IF -C -C - check next non-wild substring -C - DO WHILE (P2.LE.L2) - S2 = P2 !start of subs in STR2 - LS = STR_SKIP_U (WILD,STR2(:L2),P2) !extract subs from STR2 - S1 = STR_SKIP_PAST (STR2(S2:P2-1),STR1(:LL1),P1)!find it in STR1 - IF (S2.EQ.1) THEN !non-wild STR2 start - IF (S1.NE.1) GOTO 999 ! not equal: no match - ELSE !internal non-wild subs - IF (S1.EQ.0) GOTO 999 ! no match in STR1 - END IF - IF (P2.LE.L2) THEN !wildcard in STR2 - IS = STR_SKIP_W (WILD,STR2(:L2),P2) ! skip wildcards - WILD_END = P2.GT.L2 ! wild end of STR2 ? - END IF - END DO - IF (.NOT.WILD_END .AND. - 1 STR1(LL1-LS+1:LL1).NE.STR2(S2:S2+LS-1)) goto 999 - STR_MATCH = 1 - END IF -C - RETURN -C - 999 STR_MATCH = 2 - RETURN - END -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - INTEGER FUNCTION STR_MATCH_A (STRING,NARR,ARRAY,MATCHNR) -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' -C - CHARACTER*(*) STRING ! (i) string to be matched - INTEGER NARR ! (i) number of match strings - CHARACTER*(*) ARRAY(*) ! (i) array with match strings - INTEGER MATCHNR ! (o) nr of matching string -C -C.Purpose: Find the character-array element that matches a string -C.Returns: Status code (.TRUE. if unique match, .FALSE. if not) -C success 1 full match (with or without wildcards in ARRAY) -C info 3 unique abbreviated match (no wildcards in ARRAY) -C warning 0 more than one abbreviated match (no wildcards in ARRAY) -C error 2 no match (MATCHNR = 0) -C.Notes: -C - STRING cannot contain wildcards (*), array elements can. -C - Abbreviated matches are only recognised if ARRAY does not contain -C wildcards. -C - In the case of multiple abbreviated or wildcard matches, MATCHNR will -C contain the nr of the first match. -C - Leading and trailing blanks, tabs, LF's and CR's are ignored in all -C strings. An empty string never matches. -C------------------------------------------------------------------------- -C - INTEGER STR_SIGLEN, STR_SKIP_W, STR_MATCH -C - CHARACTER*1 BLANK, TAB, LF, CR, WILD - CHARACTER*4 WHITE - PARAMETER (BLANK = ' ') - PARAMETER (WILD = '*') -C - INTEGER LL1, P1, P2 - INTEGER STATUS, NSKIP, IS -C -C - TAB = CHAR(9) - LF = CHAR(10) - CR = CHAR(13) - WHITE = BLANK//TAB//LF//CR -C - MATCHNR = 0 !no match - STATUS = 2 -C -C Ignore leading and trailing whites -C - P1 = 1 !start of string - LL1 = STR_SIGLEN (STRING) !end of string - NSKIP = STR_SKIP_W (WHITE,STRING(:LL1),P1) !skip leading whites - IF (P1.GT.LL1) GOTO 900 !empty: no match -C -C Check whether ARRAY contains wildcards -C - DO I = 1,NARR - IF (INDEX(ARRAY(I),WILD).NE.0) GOTO 100 - END DO -C -C If ARRAY does not contain wildcards: -C - search through array until a full -C match is found, or until the end -C - DO I = 1,NARR - P2 = 1 !start of element - NSKIP = STR_SKIP_W (WHITE,ARRAY(I),P2) !skip leading whites - IS = STR_MATCH (STRING(P1:LL1),ARRAY(I)(P2:)) !check match - IF (IS.EQ.2) THEN !no match: - CONTINUE ! continue - ELSE IF (IS.EQ.1) THEN !full match: - STATUS = 1 ! set "full" status - MATCHNR = I ! set matchnr - GOTO 900 ! break - ELSE IF (MATCHNR.EQ.0) THEN !first short match: - STATUS = 3 ! set "abbrev" status - MATCHNR = I ! set matchnr - ELSE !duplicate short match: - STATUS = 0 ! set "duplic" status -CCC MATCHNR = MATCHNR ! keep first matchnr - END IF - END DO - GOTO 900 -C -C If ARRAY does contain wildcards: -C - search through array until a -C match is found, or until the end -C - 100 DO I = 1,NARR - P2 = 1 !start of element - NSKIP = STR_SKIP_W (WHITE,ARRAY(I),P2) !skip leading whites - IS = STR_MATCH (STRING(P1:LL1),ARRAY(I)(P2:)) !check match - IF (IS.EQ.1) THEN !match: - STATUS = 1 ! set "full" status - MATCHNR = I ! set matchnr - GOTO 900 ! break - END IF - END DO -C - 900 STR_MATCH_A = STATUS - RETURN - END -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - INTEGER FUNCTION STR_MATCH_L (STRING,LIST,MATCHNR) -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' -C - CHARACTER*(*) STRING ! (i) string to be matched - CHARACTER*(*) LIST ! (i) list with match strings - INTEGER MATCHNR ! (o) nr of matching string -C -C.Purpose: Find the field in a comma-separated list that matches a string -C.Returns: Status code (.TRUE. if unique match, .FALSE. if not) -C success 1 full match (with or without wildcards in ARRAY) -C info 3 unique abbreviated match (no wildcards in ARRAY) -C warning 0 more than one abbreviated match (no wildcards in ARRAY) -C error 2 no match (MATCHNR = 0) -C.Notes: -C - STRING cannot contain wildcards (*), list elements can. -C - Abbreviated matches are only recognised if LIST does not contain -C wildcards. -C - In the case of multiple abbreviated or wildcard matches, MATCHNR will -C contain the nr of the first match. -C - Leading and trailing blanks, tabs, LF's and CR's are ignored in all -C strings. An empty string never matches. -C------------------------------------------------------------------------- -C - INTEGER STR_SIGLEN, STR_SKIP_W, STR_SKIP_U, STR_MATCH -C - CHARACTER*(*) BLANK, COMMA, WILD, DELIM - CHARACTER TAB*1, LF*1, CR*1, WHITE*4 - PARAMETER (BLANK = ' ') - PARAMETER (COMMA = ',') - PARAMETER (WILD = '*') - PARAMETER (DELIM = ',;|[]:' ) -C - INTEGER LL, LL1, P1, P2 - INTEGER STATUS, IS, PTR, NSKIP -C -C - TAB = CHAR(9) - LF = CHAR(10) - CR = CHAR(13) - WHITE = BLANK//TAB//LF//CR -C - MATCHNR = 0 !no match - STATUS = 2 -C -C Ignore leading and trailing whites -C - P1 = 1 !start of string - LL1 = STR_SIGLEN (STRING) !end of string - NSKIP = STR_SKIP_W (WHITE,STRING(:LL1),P1) !skip leading whites - IF (P1.GT.LL1) GOTO 900 !empty: no match - LL = STR_SIGLEN (LIST) !length of list -C -C Check whether LIST contains wildcards -C - IF (INDEX(LIST(:LL),WILD).NE.0) GOTO 100 -C -C If LIST does not contain wildcards: -C - search through list until a full -C match is found, or until the end -C - I = 1 !element nr - PTR = 1 !list pointer - DO WHILE (PTR.LE.LL) - NSKIP = STR_SKIP_W (WHITE,LIST(:LL),PTR) !skip leading whites - P2 = PTR !start of element -!! NSKIP = STR_SKIP_U (COMMA//';|/[]',LIST(:LL),PTR) - !find end of element - NSKIP = STR_SKIP_U (DELIM,LIST(:LL),PTR) !find end of element - IF (PTR.GT.P2) THEN !non-empty element - IS = STR_MATCH (STRING(P1:LL1),LIST(P2:PTR-1)) !check match - IF (IS.EQ.2) THEN !no match: - CONTINUE ! continue - ELSE IF (IS.EQ.1) THEN !full match: - STATUS = 1 ! set "full" status - MATCHNR = I ! set matchnr - GOTO 900 ! break - ELSE IF (MATCHNR.EQ.0) THEN !first short match: - STATUS = 3 ! set "abbrev" status - MATCHNR = I ! set matchnr - ELSE !duplicate short match: - STATUS = 0 ! set "duplic" status -CCC MATCHNR = MATCHNR ! keep first matchnr - END IF - END IF - I = I+1 !increment element nr - PTR = PTR+1 !skip list separator - END DO - GOTO 900 -C -C If LISTdoes contain wildcards: -C - search through LIST until a -C match is found, or until the end -C - 100 I = 1 !element nr - PTR = 1 !list pointer - DO WHILE (PTR.LE.LL) - NSKIP = STR_SKIP_W (WHITE,LIST(:LL),PTR) !skip leading whites - P2 = PTR !start of element - NSKIP = STR_SKIP_U (DELIM,LIST(:LL),PTR) !find end of element -!! NSKIP = STR_SKIP_U (COMMA,LIST(:LL),PTR) !find end of element - IF (PTR.GT.P2) THEN !non-empty element - IS = STR_MATCH (STRING(P1:LL1),LIST(P2:PTR-1)) !check match - IF (IS.EQ.1) THEN !match: - STATUS = 1 ! set "full" status - MATCHNR = I ! set matchnr - GOTO 900 ! break - END IF - END IF - I = I+1 !increment element nr - PTR = PTR+1 !skip list separator - END DO -C - 900 STR_MATCH_L = STATUS - RETURN - END diff --git a/src/dwarf/strread.for b/src/dwarf/strread.for deleted file mode 100644 index 70528f6cbc6daaf2f0311b1bdcbc52976c16df02..0000000000000000000000000000000000000000 --- a/src/dwarf/strread.for +++ /dev/null @@ -1,93 +0,0 @@ -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ -C.Ident: STR_READ -C.Keywords: String, Read -C.Author: Friso Olnon (NFRA, Dwingeloo) -C.Language: DWARF-Fortran -C.Environment: VAX or Alliant -C.Comments: -C.Version: 880921 FMO - creation -C.Version: 960628 WNB - Solaris problem -C------------------------------------------------------------------------- -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - INTEGER*4 FUNCTION STR_READ_B (STR,BVAL) ! byte -C ENTRY STR_READ_I (STR,IVAL) ! integer*2 -C ENTRY STR_READ_J (STR,JVAL) ! integer*4 -C ENTRY STR_READ_R (STR,RVAL) ! real*4 -C ENTRY STR_READ_D (STR,DVAL) ! real*8 -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' - INTEGER*4 STR_READ_I, STR_READ_J, STR_READ_R, STR_READ_D -C - CHARACTER*(*) STR ! (i) string to be decoded - BYTE BVAL ! (o) decoded value - INTEGER*2 IVAL ! (o) decoded value - INTEGER*4 JVAL ! (o) decoded value - REAL*4 RVAL ! (o) decoded value - REAL*8 DVAL ! (o) decoded value -C -C.Purpose: Decode a character string into an integer or real value -C.Returns: Status code (.TRUE. for success, .FALSE. otherwise) -C success 1 -C warning 0 in case of any error -C.Notes: -C------------------------------------------------------------------------- -C - INTEGER*4 STR_SIGLEN -C - CHARACTER*7 FORM - DATA FORM /'(F00.0)'/ - CHARACTER*5 FORMI - DATA FORMI /'(I00)'/ - INTEGER*4 LSTR -C -C -C ENTRY STR_READ_B (STR,BVAL) -C - LSTR = STR_SIGLEN (STR) - WRITE (FORMI(3:4),'(I2.2)') LSTR - READ (STR(:LSTR),FORMI,ERR=999) BVAL - STR_READ_B = 1 - RETURN -C -C - ENTRY STR_READ_I (STR,IVAL) -C - LSTR = STR_SIGLEN (STR) - WRITE (FORMI(3:4),'(I2.2)') LSTR - READ (STR(:LSTR),FORMI,ERR=999) IVAL - STR_READ_I = 1 - RETURN -C -C - ENTRY STR_READ_J (STR,JVAL) -C - LSTR = STR_SIGLEN (STR) - WRITE (FORMI(3:4),'(I2.2)') LSTR - READ (STR(:LSTR),FORMI,ERR=999) JVAL - STR_READ_J = 1 - RETURN -C -C - ENTRY STR_READ_R (STR,RVAL) -C - LSTR = STR_SIGLEN (STR) - WRITE (FORM(3:4),'(I2.2)') LSTR - READ (STR(:LSTR),FORM,ERR=999) RVAL - STR_READ_R = 1 - RETURN -C -C - ENTRY STR_READ_D (STR,DVAL) -C - LSTR = STR_SIGLEN (STR) - WRITE (FORM(3:4),'(I2.2)') LSTR - READ (STR(:LSTR),FORM,ERR=999) DVAL - STR_READ_D = 1 - RETURN -C -C -C - 999 STR_READ_B = 0 - RETURN - END diff --git a/src/dwarf/strskip.for b/src/dwarf/strskip.for deleted file mode 100644 index 4db90460e6428455435f39d71a7973f75b273a93..0000000000000000000000000000000000000000 --- a/src/dwarf/strskip.for +++ /dev/null @@ -1,105 +0,0 @@ -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ -C.Ident: STR_SKIP -C.Keywords: String, Skip characters -C.Author: Friso Olnon (NFRA, Dwingeloo) -C.Language: DWARF-Fortran -C.Environment: VAX or Alliant -C.Comments: -C.Version: 880303 FMO - creation -C.Version: 910805 FMO - add STR_SKIP_PAST -C------------------------------------------------------------------------- -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - INTEGER FUNCTION STR_SKIP_U (MATCH,STRING,PTR) -C INTEGER ENTRY STR_SKIP_W (MATCH,STRING,PTR) -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' -C - INTEGER STR_SKIP_W -C - CHARACTER*(*) MATCH ! (i) match characters - CHARACTER*(*) STRING ! (i) string - INTEGER PTR ! (m) current position in string -C -C.Purpose: Skip through a string until/while the character matches -C.Returns: Number of characters skipped (0 if none) -C.Notes: -C - Skipping also stops at the end of the string. Conceptually, the -C string is preceded and followed by an infinite number of non-skip -C characters: -C - The end of the string corresponds to PTR=LEN(STRING)+1). -C - If at the start PTR < 1 or PTR > LEN(STRING), the function just -C returns a function value 0 and leaves PTR as it is. -C------------------------------------------------------------------------- -C - INTEGER COUNT -C -C Skip until -C - COUNT = 0 - IF (PTR.GT.0 .AND. PTR.LE.LEN(STRING)) THEN - DO PTR = PTR,LEN(STRING) - IF (INDEX(MATCH,STRING(PTR:PTR)).NE.0) GOTO 100 - COUNT = COUNT+1 - END DO - 100 CONTINUE - ENDIF - STR_SKIP_U = COUNT - RETURN -C -C -C Skip while -C - ENTRY STR_SKIP_W (MATCH,STRING,PTR) -C - COUNT = 0 - IF (PTR.GT.0 .AND. PTR.LE.LEN(STRING)) THEN - DO PTR = PTR,LEN(STRING) - IF (INDEX(MATCH,STRING(PTR:PTR)).EQ.0) GOTO 200 - COUNT = COUNT+1 - END DO - 200 CONTINUE - ENDIF - STR_SKIP_W = COUNT - RETURN - END -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - INTEGER FUNCTION STR_SKIP_PAST (SUBSTR,STRING,PTR) -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' -C - CHARACTER*(*) SUBSTR ! (i) substring - CHARACTER*(*) STRING ! (i) string - INTEGER PTR ! (m) current position in string -C -C.Purpose: Skip past a substring in a string -C.Returns: Start position of the substring in the string (or zero) -C.Notes: -C - If PTR > LEN(STRING) or if the substring is not present in -C STRING(PTR:), PTR will be left unchanged and a zero function value -C will be returned. -C - Otherwise, PTR will be set to the first position after the substring -C and the start position of the substring will be returned. -C - If the substring is empty, PTR will be left unchanged and will be -C returned as the value value. -C------------------------------------------------------------------------- -C -C -C - PTR = MAX(PTR,1) - IF (PTR.GT.LEN(STRING)) THEN - STR_SKIP_PAST = 0 - ELSE IF (LEN(SUBSTR).EQ.0) THEN - STR_SKIP_PAST = PTR - ELSE - I = INDEX (STRING(PTR:),SUBSTR) - IF (I.EQ.0) THEN - STR_SKIP_PAST = 0 - ELSE - STR_SKIP_PAST = PTR+I-1 - PTR = PTR+I-1+LEN(SUBSTR) - END IF - END IF - RETURN - END diff --git a/src/dwarf/strupcase.for b/src/dwarf/strupcase.for deleted file mode 100644 index 1ed94d2abf16e015d25b8c91ab92687882d876a2..0000000000000000000000000000000000000000 --- a/src/dwarf/strupcase.for +++ /dev/null @@ -1,99 +0,0 @@ -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ -C.Ident: STR_UPCASE -C.Keywords: String, Convert to upper case -C.Author: Friso Olnon (NFRA, Dwingeloo) -C.Language: DWARF-Fortran -C.Environment: VAX or Alliant -C.File: [.SRC.GEN]STRUPCASE.FOR -C.Comments: -C.Version: 880309 FMO - creation -C------------------------------------------------------------------------- -C++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - INTEGER*4 FUNCTION STR_UPCASE (STRING) -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' -C - CHARACTER*(*) STRING ! (m) string to be modified -C -C.Purpose: Convert a character string to uppercase -C.Returns: 1 -C.Notes: -C------------------------------------------------------------------------- -C - CHARACTER*26 LOW, UP - PARAMETER (LOW = 'abcdefghijklmnopqrstuvwxyz') - DATA UP / 'ABCDEFGHIJKLMNOPQRSTUVWXYZ'/ -C - INTEGER*4 PTR, INX -C -C -C Uppercase conversion -C - DO PTR = 1,LEN(STRING) - INX = INDEX(LOW,STRING(PTR:PTR)) - IF (INX.GT.0) THEN - STRING(PTR:PTR) = UP(INX:INX) - ENDIF - ENDDO -C -C Set function value -C - STR_UPCASE = 1 - RETURN - END -C++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - INTEGER*4 FUNCTION STR_UPCCPY (STRING,STROUT,LENOUT) -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' -C - CHARACTER*(*) STRING ! (i) source string - CHARACTER*(*) STROUT ! (m) destination string - INTEGER*4 LENOUT ! (m) current used length of STROUT -C -C.Purpose: Make uppercase copy of a character string -C.Returns: Nr of characters copied or -nr of characters truncated -C.Notes: -C First, LENOUT is forced to a correct value: >= 0 and <= LEN(STROUT). -C Then, the source string is converted to upper case and appended -C to STROUT(:LENOUT) as far as possible. LENOUT will be updated. -C------------------------------------------------------------------------- -C - CHARACTER*26 LOW, UP - PARAMETER (LOW = 'abcdefghijklmnopqrstuvwxyz') - DATA UP / 'ABCDEFGHIJKLMNOPQRSTUVWXYZ'/ -C - INTEGER*4 PTR, INX - INTEGER*4 LENSTR, SAVLEN, NCOPY -C -C -C -C Determine lengths -C - LENSTR = LEN(STRING) - SAVLEN = MAX(0,MIN(LENOUT,LEN(STROUT))) ! current length of dest-string - LENOUT = MIN(LEN(STROUT),SAVLEN+LENSTR) ! new length of dest-string - NCOPY = LENOUT-SAVLEN ! actual length of copy-string -C -C Uppercase/copy as much as possible -C - DO PTR = 1,NCOPY - INX = INDEX(LOW,STRING(PTR:PTR)) - IF (INX.GT.0) THEN - STROUT(SAVLEN+PTR:SAVLEN+PTR) = UP(INX:INX) - ELSE - STROUT(SAVLEN+PTR:SAVLEN+PTR) = STRING(PTR:PTR) - ENDIF - ENDDO -C -C Set function value -C - IF (LENSTR.EQ.NCOPY) THEN ! complete copy - STR_UPCCPY = NCOPY ! nr of characters copied - ELSE ! incomplete copy - STR_UPCCPY = NCOPY-LENSTR ! negated nr of lost characters - ENDIF -C - RETURN - END diff --git a/src/dwarf/sys_bldppd.for b/src/dwarf/sys_bldppd.for deleted file mode 100644 index b24d50a29f79cf299f057e3cd11e9c7d8743694b..0000000000000000000000000000000000000000 --- a/src/dwarf/sys_bldppd.for +++ /dev/null @@ -1,136 +0,0 @@ -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ -C.Ident: SYS_BLDPPD -C.Keywords: PPD File, Build -C.Author: Friso Olnon (NFRA, Dwingeloo) -C.Language: DWARF-Fortran -C.Environment: VAX or Alliant -C.Comments: -C.Version: 900426 FMO - recreation -C.Version: 920206 GvD - add former optional arguments to CLI_GET and MSG -C.Version: 930923 CMV - logical names for new maintenance system -C.Version: 010709 AXC - Linux port - init. E_C -C------------------------------------------------------------------------- -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - SUBROUTINE SYS_BLDPPD -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' -C -C -C.Purpose: Build a PPD file from a PIN file -C.Returns: Not applicable -C.Notes: -C------------------------------------------------------------------------- -C - CHARACTER*(*) LISTYPES, COMMA - PARAMETER (LISTYPES = 'COMPILATION,MAP,REFERENCE') - PARAMETER (COMMA = ',') -C - INTEGER*4 NRARG, PR, Q, QV, QVD - PARAMETER (NRARG = 3) - PARAMETER (PR = CLI__PARAMETER+CLI__REQUIRED) - PARAMETER (Q = CLI__QUALIFIER) - PARAMETER (QV = CLI__QUALIFIER+CLI__VALUE) - PARAMETER (QVD = CLI__QUALIFIER+CLI__VALUE+CLI__DEFAULT) - CHARACTER*7 NAME(NRARG) - INTEGER*4 ATTR(NRARG) - CHARACTER*12 PROMPT(NRARG) - CHARACTER*1 DEFVAL(NRARG) - DATA NAME /'PROGNAM' ,'LIST','PRINT'/ - DATA ATTR / PR , QVD , Q / - DATA PROMPT /'Program name',' ' ,' ' / - DATA DEFVAL /' ' ,'COMP',' ' / -C - INTEGER*4 BPD_COMPILE, BPD_REF_WRITE, BPD_REF_LIST, PPD_LIST - INTEGER*4 CLI_INIT, CLI_GET - INTEGER MSG_INIT, MSG_SET - INTEGER*4 DWC_PROG_CHECK, GEN_LNM_DEFINE - INTEGER*4 STR_COPY_U, STR_MATCH_L -C - CHARACTER PROGNAM*16, LIST*80, LISTYP*12, DUM*1 - INTEGER*4 LP, LD, LL, LT, LDUM - INTEGER*4 IS, PRTFLAGS, PTR, MATCHNR - LOGICAL*4 DO_CLIST, DO_MLIST, DO_RLIST, IS_GLOBAL -C -C -C Initialize -C - start messenger -C - initialize command-line interpreter -C - IS = MSG_INIT ('BLDPPD',F_T) - IF (IAND(IS,1).NE.0) IS = CLI_INIT (NRARG,NAME,ATTR,PROMPT,DEFVAL) - IF (IAND(IS,1).EQ.0) GOTO 999 -C -C Get and check the program name -C - IS = CLI_GET ('PROGNAM',PROGNAM,LP) - IF (IAND(IS,1).NE.0) - 1 IS = DWC_PROG_CHECK (PROGNAM(:LP),LP,IS_GLOBAL) - IF (IAND(IS,1).EQ.0) GOTO 999 -C -C Set list and print flags -C - DO_CLIST = .FALSE. - DO_MLIST = .FALSE. - DO_RLIST = .FALSE. - PRTFLAGS = F_YES -C - IS = CLI_GET ('LIST',LIST,LL) - IF (IAND(IS,1).EQ.0) GOTO 999 - IF (IS.EQ.DWC_PRESENT) THEN - PTR = 1 - DO WHILE (PTR.LE.LL) - LT = 0 - IS = STR_COPY_U (COMMA,LIST(:LL),PTR,LISTYP,LT) - IS = STR_MATCH_L (LISTYP(:LT),LISTYPES,MATCHNR) - IF (MATCHNR.EQ.1) THEN - DO_CLIST = .TRUE. - ELSE IF (MATCHNR.EQ.2) THEN - DO_MLIST = .TRUE. - ELSE IF (MATCHNR.EQ.3) THEN - DO_RLIST = .TRUE. - ELSE - IS = MSG_SET (PPD_INVQUAVAL,0) - GOTO 999 - ENDIF - PTR = PTR+1 - ENDDO - IS = CLI_GET ('PRINT',DUM,LDUM) - IF (IAND(IS,1).EQ.0) GOTO 999 - IF (IS.EQ.DWC_PRESENT) - 1 PRTFLAGS = F_SP - ENDIF -C -C Compile with UPDATE -C - IS = BPD_COMPILE (PROGNAM(:LP),DO_CLIST,PRTFLAGS,.TRUE.) -C -C If compilation succesful: -C - list the new PPD file -C - create a new PPD cross-reference file -C - list the references to the new PPD -C - IF (IS.EQ.PPD_SUCCESS) THEN - IF (DO_MLIST) IS = PPD_LIST (PROGNAM(:LP),PRTFLAGS) - IF (IAND(IS,1).NE.0) IS = BPD_REF_WRITE (PROGNAM(:LP)) - IF (IAND(IS,1).NE.0 .AND.DO_RLIST) - 1 IS = BPD_REF_LIST (PROGNAM(:LP),PRTFLAGS) - ENDIF -C -C - 999 E_C = MSG_SET(IS,0) !WNGEX exit code - E_C = 0 - END - - - - - - - - - - - - - diff --git a/src/dwarf/udfunit.for b/src/dwarf/udfunit.for deleted file mode 100644 index f4c26b673c1636d55432ebc72a6d6afab8d61a1a..0000000000000000000000000000000000000000 --- a/src/dwarf/udfunit.for +++ /dev/null @@ -1,242 +0,0 @@ -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ -C.Ident: UDF_UNIT -C.Keywords: UDF File, Units -C.Author: Kasper Kombrink (NFRA, Dwingeloo) -C.Language: DWARF-Fortran -C.Environment: VAX or Alliant -C.Comments: -C.Version: 840614 KK - creation -C.Version: 850225 JPH - correct errors in table (there were many) -C.Version: 860917 GVD - wavelength group added to distance group; -C added a few new units (MHz, kmh, mile, nautmile, etc.) -C.Version: 880929 GVD - added entry READ_UNITG_ALL -C.Version: 900111 FMO - Fortran version -C.Version: 920224 GvD - no optional arguments in MSG anymore -C.Version: 931220 WNB - add SAVE for compiler cv/dw -C------------------------------------------------------------------------- -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - INTEGER*4 FUNCTION READ_UNIT (UNIT,GROUP,FACTOR) -C ENTRY READ_UNITG (GROUP,UNITLIST) -C ENTRY READ_UNITG_ALL (GROUPLIST) -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' -C - INTEGER*4 READ_UNITG, READ_UNITG_ALL -C - CHARACTER*(*) UNIT ! (i) unit code - CHARACTER*(*) GROUP ! (o/i) unit group - REAL*8 FACTOR ! (o) conversion factor - CHARACTER*(*) UNITLIST ! (o) list of all units in the group - CHARACTER*(*) GROUPLIST ! (o) list of all group names -C -C.Purpose: Get information about a unit, unit group, or all groups -C.Returns: Status code (.TRUE. for success, .FALSE. otherwise) -C success UDF_SUCCESS success -C error UDF_UNINOTFND invalid unit code -C error UDF_GRPNOTFND invalid unit group -C fatal UDF_STRTOOSML overflow in output string -C.Notes: -C - UNITLIST and GROUPLIST are comma-separated lists. -C - If UNIT(i) and UNIT(j) are units in the same group: -C FACTOR(i) UNIT(i) = FACTOR(j) UNIT(j) -C------------------------------------------------------------------------- -C - CHARACTER*(*) BLANK, COMMA - PARAMETER (BLANK = ' ') - PARAMETER (COMMA = ',') -C - INTEGER*4 NUNITS ! nr of unit codes - PARAMETER (NUNITS=59) - CHARACTER*10 G(NUNITS) ! unit group names - CHARACTER*8 U(NUNITS) ! unit names - REAL*8 F(NUNITS) ! conversion factors - COMMON /UDF_UNIT_COM/ F,U,G -C -C - DATA G(1) ,U(1) ,F(1) /'ANGLE' ,'RAD' , - 1 6.283185307179586477/ - DATA G(2) ,U(2) ,F(2) /'ANGLE' ,'DEG' ,360 / - DATA G(3) ,U(3) ,F(3) /'ANGLE' ,'CIR' ,1 / - DATA G(4) ,U(4) ,F(4) /'ANGLE' ,'DMS' ,360 / - DATA G(5) ,U(5) ,F(5) /'ANGLE' ,'HMS' ,24 / - DATA G(6) ,U(6) ,F(6) /'ANGLE' ,'ARCMIN' ,2.160D4 / - DATA G(7) ,U(7) ,F(7) /'ANGLE' ,'ARCSEC' ,1.296D6 / -C - DATA G(8) ,U(8) ,F(8) /'FREQUENCY' ,'GHZ' ,1D-9 / - DATA G(9) ,U(9) ,F(9) /'FREQUENCY' ,'MHZ' ,1D-6 / - DATA G(10),U(10),F(10) /'FREQUENCY' ,'KHZ' ,1D-3 / - DATA G(11),U(11),F(11) /'FREQUENCY' ,'HZ' ,1 / -C - DATA G(12),U(12),F(12) /'DISTANCE' ,'PM' ,1D15 / - DATA G(13),U(13),F(13) /'DISTANCE' ,'ANG' ,1D13 / - DATA G(14),U(14),F(14) /'DISTANCE' ,'NM' ,1D12 / - DATA G(15),U(15),F(15) /'DISTANCE' ,'MICRON' ,1D9 / - DATA G(16),U(16),F(16) /'DISTANCE' ,'MMM' ,1D9 / - DATA G(17),U(17),F(17) /'DISTANCE' ,'MUM' ,1D9 / - DATA G(18),U(18),F(18) /'DISTANCE' ,'MM' ,1D6 / - DATA G(20),U(20),F(20) /'DISTANCE' ,'M' ,1D3 / - DATA G(21),U(21),F(21) /'DISTANCE' ,'KM' ,1 / - DATA G(22),U(22),F(22) /'DISTANCE' ,'INCH' ,39398.4 / - DATA G(23),U(23),F(23) /'DISTANCE' ,'FT' ,3283.2 / - DATA G(19),U(19),F(19) /'DISTANCE' ,'CM' ,1D5 / - DATA G(24),U(24),F(24) /'DISTANCE' ,'YARD' ,1094.4 / - DATA G(25),U(25),F(25) /'DISTANCE' ,'YRD' ,1094.4 / - DATA G(26),U(26),F(26) /'DISTANCE' ,'MILE' ,.621371192237334/ - DATA G(27),U(27),F(27) /'DISTANCE' ,'NAUTMILE',.54 / - DATA G(28),U(28),F(28) /'DISTANCE' ,'AU' , - 1 6.68458581303615D-9/ - DATA G(29),U(29),F(29) /'DISTANCE' ,'LY' , - 1 1.05702323231362D-13/ - DATA G(30),U(30),F(30) /'DISTANCE' ,'PC' , - 1 3.24077884989914D-14/ - DATA G(31),U(31),F(31) /'DISTANCE' ,'KPC' , - 1 3.24077884989914D-17/ - DATA G(32),U(32),F(32) /'DISTANCE' ,'MPC' , - 1 3.24077884989914D-20/ -C - DATA G(33),U(33),F(33) /'VELOCITY' ,'KMS' ,1 / - DATA G(34),U(34),F(34) /'VELOCITY' ,'KMH' ,3600 / - DATA G(35),U(35),F(35) /'VELOCITY' ,'MS' ,1D3 / - DATA G(36),U(36),F(36) /'VELOCITY' ,'VC' ,3.335635D-6/ - DATA G(37),U(37),F(37) /'VELOCITY' ,'PCY' ,1.022495D-6/ -C - DATA G(38),U(38),F(38) /'TIME' ,'SEC' ,1 / - DATA G(39),U(39),F(39) /'TIME' ,'MSEC' ,1D3 / - DATA G(40),U(40),F(40) /'TIME' ,'MUSEC' ,1D6 / - DATA G(41),U(41),F(41) /'TIME' ,'MMSEC' ,1D6 / - DATA G(42),U(42),F(42) /'TIME' ,'NSEC' ,1D9 / - DATA G(43),U(43),F(43) /'TIME' ,'MIN' , - 1 1.666666666666667D-2/ - DATA G(44),U(44),F(44) /'TIME' ,'HR' , - 1 2.777777777777778D-4/ - DATA G(45),U(45),F(45) /'TIME' ,'DAY' , - 1 1.157407407407407D-5/ - DATA G(46),U(46),F(46) /'TIME' ,'YR' ,3.1687536D-8/ - DATA G(47),U(47),F(47) /'TIME' ,'SSEC' ,1.002737875/ - DATA G(48),U(48),F(48) /'TIME' ,'SYR' ,3.1688765D-8/ -C - DATA G(49),U(49),F(49) /'FLUX' ,'WU' ,200 / - DATA G(50),U(50),F(50) /'FLUX' ,'MJY' ,1D3 / - DATA G(51),U(51),F(51) /'FLUX' ,'JY' ,1 / - DATA G(52),U(52),F(52) /'FLUX' ,'MUJ' ,1D6 / -C - DATA G(53),U(53),F(53) /'WEIGHT' ,'KG' ,1 / - DATA G(54),U(54),F(54) /'WEIGHT' ,'GR' ,1D3 / - DATA G(55),U(55),F(55) /'WEIGHT' ,'MG' ,1D6 / - DATA G(56),U(56),F(56) /'WEIGHT' ,'LBS' ,2.20462262184878/ - DATA G(57),U(57),F(57) /'WEIGHT' ,'OZ' ,35.2739907229404/ -C - DATA G(58),U(58),F(58) /'NODIM' ,BLANK ,1 / - DATA G(59),U(59),F(59) /'NODIM' ,'1' ,1 / -C - INTEGER*4 STR_MATCH_A, STR_COPY_U - INTEGER MSG_SET -C - INTEGER*4 IS, LG, LL, PTR, MATCH -C -C -C Initialize output arguments -C - GROUP = BLANK - LG = 0 - FACTOR = 1 -C -C Check whether valid unit code -C - IF (UNIT.EQ.BLANK) THEN - MATCH = NUNITS-1 - ELSE - IS = STR_MATCH_A (UNIT,NUNITS,U,MATCH) - IF (IAND(IS,1).EQ.0) GOTO 991 - ENDIF -C -C Fill output arguments -C - PTR = 1 - IS = STR_COPY_U (BLANK,G(MATCH),PTR,GROUP,LG) - IF (IS.LT.0) GOTO 992 - FACTOR = F(MATCH) -C -C Return -C - READ_UNIT = DWC_SUCCESS - RETURN -C - 991 READ_UNIT = MSG_SET (UDF_UNINOTFND,1) - CALL WNCTXT(DWLOG,DWMSG,UNIT) - RETURN -C - 992 READ_UNIT = MSG_SET (UDF_STRTOOSML,0) - RETURN -C -C -C ================ - ENTRY READ_UNITG (GROUP,UNITLIST) -C ================ -C -C Initialize output argument -C - UNITLIST = BLANK - LL = 0 -C -C Check whether valid unit group -C - IS = STR_MATCH_A (GROUP,NUNITS,G,MATCH) - IF (MATCH.EQ.0) GOTO 993 -C -C Fill output argument -C - PTR = 1 - IS = STR_COPY_U (BLANK,U(MATCH),PTR,UNITLIST,LL) - IF (IS.LT.0) GOTO 994 - MATCH = MATCH+1 - DO WHILE (MATCH.LE.NUNITS .AND. G(MATCH).EQ.G(MATCH-1)) - PTR = 1 - IS = STR_COPY_U (BLANK,COMMA//U(MATCH),PTR,UNITLIST,LL) - IF (IS.LT.0) GOTO 994 - MATCH = MATCH+1 - ENDDO -C -C Return -C - READ_UNITG = DWC_SUCCESS - RETURN -C - 993 READ_UNITG = MSG_SET (UDF_GRPNOTFND,1) - CALL WNCTXT(DWLOG,DWMSG,GROUP) - RETURN -C - 994 READ_UNITG = MSG_SET (UDF_STRTOOSML,0) - RETURN -C -C -C ==================== - ENTRY READ_UNITG_ALL (GROUPLIST) -C ==================== -C -C Initialize output argument -C - GROUPLIST = BLANK - LL = 0 -C -C Fill output argument -C - PTR = 1 - IS = STR_COPY_U (BLANK,G(1),PTR,GROUPLIST,LL) - DO J = 2,NUNITS - IF (G(J).NE.G(J-1)) THEN - PTR = 1 - IS = STR_COPY_U (BLANK,COMMA//G(J),PTR,GROUPLIST,LL) - ENDIF - ENDDO - IF (IS.LT.0) GOTO 995 -C -C Return -C - READ_UNITG_ALL = DWC_SUCCESS - RETURN -C - 995 READ_UNITG_ALL = MSG_SET (UDF_STRTOOSML,0) - RETURN - END diff --git a/src/dwarf/view.for b/src/dwarf/view.for deleted file mode 100644 index b755a64547c802864e7e37b0d2375f0b68a6c7d7..0000000000000000000000000000000000000000 --- a/src/dwarf/view.for +++ /dev/null @@ -1,409 +0,0 @@ -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ -C.Ident: SYS_VIEW -C.Keywords: Program Parameters, Defaults, Show -C.Author: Friso Olnon (NFRA, Dwingeloo) -C.Language: DWARF-Fortran -C.Environment: VAX or Alliant -C.Comments: -C.Version: 900421 FMO - recreation -C.Version: 910718 FMO - allow for longer-than-132 output lines (patch) -C.Version: 910817 FMO - downgraded: no /INFO, /PRINT, /LEVEL, /ALL -C.Version: 920206 GvD - add former optional arguments to CLI_GET -C.Version: 930728 CMV - add /GENERAL switch -C.Version: 930923 CMV - logical names for new maintenance system -C.Version: 931108 CMV - new option /SHORT -C.Version: 940119 CMV - use WNGLUN i.s.o GEN_LUN -C------------------------------------------------------------------------- -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - SUBROUTINE VIEW -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' -C -C -C.Purpose: Show the current defaults for program parameters -C.Returns: Not applicable -C.Notes: -C - Parameter: -C symbol_list default: *$*_* (i.e. all) -C - Qualifiers (the names can be abbreviated to a single letter): -C /INPUT=save_file default: /NOINPUT -C /SUBSTITUTE default: /NOSUBSTITUTE -C /EXTERNAL default: /NOEXTERNAL -C /SHORT default: /NOSHORT -C /TEST or /NOTEST default: DWARF control parameter -C /GENERAL default: /NOGENERAL -C -C - The symbol lists (parameter and /EXCLUDE value) are comma-separated -C lists of DWARF symbol names: -C <program_name>$<stream_name>_<parameter_name> -C where each name can be absent or wildcarded (*). The dollar and -C underscore prefixes are part of the stream and parameter name -C components. -C - The lists will be expanded as follows: each absent component will be -C replaced by the component from the previous symbol name, except that -C the stream for global programs will be set to $0. The default for the -C first name is -C *$<current_stream>_*. -C -C - If /GENERAL is given, the symbol list can contain general symbols -C as well, and only the value for each symbol is given. -C - Normally, output is <keyword> = <value>; if /GENERAL is given with -C a single keyword, only value is output. -C -C - If /SHORT is given, no program prefixes etc will be given, only -C external keys will be shown without the "(user)" remark. -C -C - If /INPUT is given, all the definitions in the save file (defaults: -C current directory and type .SAV) that match the symbol list will be -C displayed. -C - If the symbol list contains a wildcard program or stream name, all -C the current external defaults with names matching the symbol list -C will be displayed. -C - Otherwise all the program parameters matching the symbol list will be -C displayed together with their external or PPD defaults (if present). -C But if you give /EXTERNAL only those parameters will be displayed -C which have an external default. -C------------------------------------------------------------------------- -C - CHARACTER*(*) PROGRAM, BLANK, ASTER, COMMA - CHARACTER*(*) OPAR, CPAR, EQUALS - PARAMETER (PROGRAM = 'VIEW') - PARAMETER (BLANK = ' ' ) - PARAMETER (ASTER = '*' ) - PARAMETER (COMMA = ',' ) - PARAMETER (OPAR = ' (' ) - PARAMETER (CPAR = ')' ) - PARAMETER (EQUALS = ' = ' ) - CHARACTER*(*) ANUMX - PARAMETER (ANUMX = 'ABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789_$') -C - INTEGER NRARG, PAR, Q, QVAL - PARAMETER (NRARG = 7) - PARAMETER (PAR = CLI__PARAMETER) - PARAMETER (Q = CLI__QUALIFIER) - PARAMETER (QVAL = CLI__QUALIFIER+CLI__VALUE) - CHARACTER*11 NAME(NRARG) - INTEGER ATTR(NRARG) - CHARACTER*12 PROMPT(NRARG) - CHARACTER*5 DEFVAL(NRARG) - DATA NAME /'SYMLIST','INPUT','SUBSTITUTE', - & 'TEST','EXTERNAL','GENERAL','SHORT'/ - DATA ATTR / PAR , QVAL ,Q , - & Q , Q ,Q,Q / - DATA PROMPT /' ' ,' ' ,' ' , - & ' ' ,' ' ,' ',' '/ - DATA DEFVAL /'*$*_*' ,' ' ,' ' , - & ' ' ,' ' ,' ',' '/ -C - INTEGER CLI_INIT, CLI_GET - INTEGER MSG_INIT, MSG_SET - INTEGER DWC_CTL_OPEN, DWC_TEST_PUT, DWC_TEST_INQ - INTEGER VP_DEF_CHECK, DWC_LEVEL_GET, DWC_SYM_BUILD - INTEGER DWC_SYMLIST_EXPAND, DWC_SYM_SPLIT - INTEGER PV_DEF_GET - INTEGER PPD_INIT, PPD_EXIT - INTEGER PPD_READ_U, PPD_READ_UNXT, PPD_UNAM_GET, PPD_AMAS_GET - INTEGER STR_SIGLEN, STR_SKIP_W, STR_COPY_W, STR_COPY_U - INTEGER STR_MATCH_L - INTEGER FILNAM_FULL, GEN_FORIOS - INTEGER SYMBOL_SEARCH, SYMBOL_GET -C - CHARACTER SYMLIST*512, VALUE*255, WORK*512, SAVFILE*80, TYPE*20 - CHARACTER NAM*64, PROG*9, STREAM*12, KEY*16, DUM*1 - CHARACTER LASTPROG*9, KEYWORD*16 - INTEGER LL, LV, LW, LF, LT, LDUM - INTEGER LN, LP, LS, LK - INTEGER IS, IOS, TMP, LUN, MINL, PTR - INTEGER USERLEVEL, MAXLEVEL, NRSYM, NR - LOGICAL DO_SUBST, ALL_DEFAULTS, FIRST_KEY - LOGICAL DO_GENERAL, DO_SHORT - LOGICAL TEST_MODE, PROG_DEF, PROTO, FOUND, SINGLE - DATA LASTPROG /BLANK/ - DATA NRSYM /0/ -C -C -C Initialize -C - get DWARF control variables -C - start messenger -C - initialize command-line interpreter -C - IS = DWC_CTL_OPEN () - IF (IAND(IS,1).NE.0) IS = MSG_INIT (PROGRAM,F_T) - IF (IAND(IS,1).NE.0) IS = CLI_INIT (NRARG,NAME,ATTR,PROMPT,DEFVAL) - IF (IAND(IS,1).EQ.0) GOTO 999 - -C -C Check /GENERAL, if given do not -C expand symbol list -C - IS = CLI_GET ('GENERAL',DUM,LDUM) - IF (IAND(IS,1).EQ.0) GOTO 999 - DO_GENERAL=(IS.EQ.DWC_PRESENT) -C -C Get and expand the symbol list -C - IS = CLI_GET ('SYMLIST',VALUE,LV) - IF (IAND(IS,1).NE.0) THEN - IF (DO_GENERAL) THEN - LL=LV - SYMLIST(:LL)=VALUE(:LV) - ELSE - IS = DWC_SYMLIST_EXPAND (VALUE(:LV),SYMLIST,LL) - END IF - END IF - IF (IAND(IS,1).EQ.0) GOTO 999 -C -C +----------------------+ -C | List general symbols | -C +----------------------+ -C If /GENERAL is given: -C - just display all matching symbols -C - IF (DO_GENERAL) THEN - NR = 0 - SINGLE=(INDEX(SYMLIST(:LL),ASTER).EQ.0 .AND. - & INDEX(SYMLIST(:LL),COMMA).EQ.0 ) - TMP = SYMBOL_SEARCH (SYMLIST(:LL),BLANK,NR,NAM,LN) - IF (IAND(TMP,1).EQ.0) IS = TMP - DO WHILE (LN.GT.0) - TMP = SYMBOL_GET (NAM(:LN),VALUE,LV) - IF (IAND(TMP,1).EQ.0) IS = TMP - IF (SINGLE) THEN - CALL WNCTXT(DWLOG,'!AS',VALUE(:LV)) - ELSE - CALL WNCTXT(DWLOG,' !AS = !AS',NAM(:LN),VALUE(:LV)) - END IF -C NRSYM = NRSYM+1 - TMP = SYMBOL_SEARCH (SYMLIST(:LL),BLANK,NR,NAM,LN) - IF (IAND(TMP,1).EQ.0) IS = TMP - END DO - IF (IAND(IS,1).EQ.0) THEN !some symbol error: - ELSE IF (NRSYM.EQ.0) THEN !no matching defaults: -C CALL WNCTXT(DWLOG,' No symbols found') ! tell - END IF - GOTO 999 !anyway: exit - END IF -C -C +---------------------+ -C | List from save file | -C +---------------------+ -C If /INPUT=file is given: -C - display all the lines in which the -C symbol name matches the symbol list -C - exit -C - IS = CLI_GET ('INPUT',VALUE,LV) - IF (IAND(IS,1).EQ.0) GOTO 999 - IF (LV.GT.0) THEN - IS = FILNAM_FULL (VALUE(:LV),SAVFILE,LF,'.SAV') - IF (IAND(IS,1).EQ.0) GOTO 999 - CALL WNGLUN(LUN) - IF (LUN.EQ.0) THEN - IS=GEN_LUNNOFREE - GOTO 999 - END IF - CALL WNCTXT(DWLOG,'!/List from save file !AS',SAVFILE(:LF)) - OPEN (UNIT=LUN,FILE=SAVFILE(:LF),TYPE='OLD',IOSTAT=IOS) - IF (IOS.EQ.0) READ (LUN,'(Q,A)',IOSTAT=IOS) LW,WORK - DO WHILE (IOS.EQ.0) - PTR = 1 - LN = 0 !extract name - TMP = STR_SKIP_W (BLANK,WORK(:LW),PTR) - TMP = STR_COPY_W (ANUMX,WORK(:LW),PTR,NAM,LN) - IF (PTR.LT.LW .AND. WORK(PTR:PTR).EQ.ASTER) THEN - PTR = PTR+1 !skip asterisk - TMP = STR_COPY_W (ANUMX,WORK(:LW),PTR,NAM,LN) - END IF - IF (LN.GT.0) THEN !matching name ? - TMP = STR_MATCH_L (NAM(:LN),SYMLIST(:LL),NR) - IF (TMP.EQ.1) THEN !yes: - CALL WNCTXT(DWLOG,'!AS',WORK(:LW)) - NRSYM = NRSYM+1 - END IF - END IF - READ (LUN,'(Q,A)',IOSTAT=IOS) LW,WORK - END DO - IF (IOS.GT.0) THEN !I/O error: - IS = GEN_FORIOS (SAVFILE(:LF)) ! set error status - ELSE IF (NRSYM.EQ.0) THEN !no matching symbols: - CALL WNCTXT(DWLOG,' No symbols found') ! tell - END IF - GOTO 999 !anyway: exit - END IF -C -C +-----------------------------+ -C | List only external defaults | -C +-----------------------------+ -C If the symbol list contains a wild -C program and/or stream name: -C - display all the external defaults -C with names matching the symbol list -C - exit -C - IF (INDEX(SYMLIST(:LL),'*$').NE.0 .OR. - 1 INDEX(SYMLIST(:LL),'$*').NE.0) THEN - NR = 0 - TMP = SYMBOL_SEARCH (SYMLIST(:LL),BLANK,NR,NAM,LN) - IF (IAND(TMP,1).EQ.0) IS = TMP - DO WHILE (LN.GT.0) - TMP = SYMBOL_GET (NAM(:LN),VALUE,LV) - IF (IAND(TMP,1).EQ.0) IS = TMP - CALL WNCTXT(DWLOG,' !AS = !AS',NAM(:LN),VALUE(:LV)) - NRSYM = NRSYM+1 - TMP = SYMBOL_SEARCH (SYMLIST(:LL),BLANK,NR,NAM,LN) - IF (IAND(TMP,1).EQ.0) IS = TMP - END DO - IF (IAND(IS,1).EQ.0) THEN !some symbol error: - ELSE IF (NRSYM.EQ.0) THEN !no matching defaults: - CALL WNCTXT(DWLOG,' No symbols found') ! tell - END IF - GOTO 999 !anyway: exit - END IF -C -C +-------------------------+ -C | List program parameters | -C +-------------------------+ -C Inspect the qualifiers -C - IS = CLI_GET ('EXTERNAL',DUM,LDUM) - IF (IAND(IS,1).EQ.0) GOTO 999 - ALL_DEFAULTS = IS.NE.DWC_PRESENT !list all defaults ? -C - IS = CLI_GET ('SHORT',DUM,LDUM) - IF (IAND(IS,1).EQ.0) GOTO 999 - DO_SHORT=(IS.EQ.DWC_PRESENT) - IF (DO_SHORT) ALL_DEFAULTS=.FALSE. -C - IS = CLI_GET ('TEST',DUM,LDUM) - IF (IAND(IS,1).EQ.0) GOTO 999 - IF (IS.NE.DWC_ABSENT) THEN !/[NO]TEST given: - TEST_MODE = IS.EQ.DWC_PRESENT ! en/disable test mode - IS = DWC_TEST_PUT (TEST_MODE) - ELSE !no test qualifier: - IS=DWC_SUCCESS - TEST_MODE = DWC_TEST_INQ () ! get default mode - END IF -C - IS = CLI_GET ('SUBSTITUTE',DUM,LDUM) - IF (IAND(IS,1).EQ.0) GOTO 999 - DO_SUBST = IS.EQ.DWC_PRESENT !substitute symbols ? - IS = DWC_LEVEL_GET (USERLEVEL,MAXLEVEL) !get userlevel -C -C Loop through the symbol list -C - PTR = 0 - 100 PTR = PTR+1 - IF (PTR.GT.LL) GOTO 900 !end of list - LN = 0 - TMP = STR_COPY_U (COMMA,SYMLIST(:LL),PTR,NAM,LN) - TMP = DWC_SYM_SPLIT (NAM(:LN),PROG,LP,STREAM,LS,KEY,LK) -C -C If new program name: -C - close PPD file and open new one -C - no error if PPD file is not found -C - IF (PROG.NE.LASTPROG) THEN - IF (LASTPROG.NE.BLANK) TMP = PPD_EXIT () - TMP = PPD_INIT (PROG) - IF (IAND(TMP,1).EQ.0) THEN - IF (TMP.EQ.PPD_PPDNOTFND) THEN - ELSE - IS = MSG_SET (TMP,0) - END IF - LASTPROG = BLANK - GOTO 100 !next list element - END IF - LASTPROG = PROG - END IF -C -C Get the full parameter name -C - if explicit keyword: just that one -C - FIRST_KEY = .TRUE. - 200 IF (KEY(:LK).NE.'*') THEN - KEYWORD = KEY - TMP = PPD_READ_U (KEYWORD) - LK = STR_SIGLEN (KEYWORD) - IF (IAND(TMP,1).EQ.0) THEN - IF (TMP.EQ.PPD_KEYAMBIG) THEN - IS = MSG_SET (TMP,1) - CALL WNCTXT(DWLOG,DWMSG,KEY) - ELSE - IS = MSG_SET (DWC_UNKKEYW,1) - CALL WNCTXT(DWLOG,DWMSG,KEY,' ',PROG(:LP)) - ENDIF - GOTO 100 !next list element - END IF -C -C - if wildcard keyword, get the first or -C next one from the PPD file, accepting -C test parameters only if in test mode -C - ELSE - FOUND = .FALSE. - DO WHILE (.NOT.FOUND) - IF (FIRST_KEY) THEN - FIRST_KEY = .FALSE. - TMP = PPD_READ_U (' ') - ELSE - TMP = PPD_READ_UNXT () - ENDIF - IF (TMP.EQ.PPD_ENDOFFILE) GOTO 100 !PPD end: next list elm - IF (IAND(TMP,1).NE.0) - 1 TMP = PPD_UNAM_GET (KEYWORD,LK,MINL,PROTO) - IF (IAND(TMP,1).EQ.0) THEN !PPD error: - GOTO 100 ! next list element - END IF - FOUND = TEST_MODE .OR. IAND(PPD_AMAS_GET('TEST'),1).EQ.0 - END DO - END IF -C -C Process the parameter default: -C - build full name -C - get the value -C - if /EXTERNAL: skip unless external -C - if /SUBSTITUTE: expand the value -C - display the name and value -C - go for the next parameter -C - TMP = DWC_SYM_BUILD (PROG(:LP),STREAM(:LS),KEYWORD(:LK),NAM,LN) - TMP = PV_DEF_GET (NAM(:LN),WORK,LW,TYPE,LT) - PROG_DEF = LT.NE.0 .AND. TYPE(1:1).EQ.'p' - IF (ALL_DEFAULTS .OR. (LT.NE.0.AND.TYPE(1:1).NE.'p')) THEN - IF (DO_SUBST) THEN - TMP = VP_DEF_CHECK (NAM(:LN),WORK(:LW),PROG_DEF, - 1 USERLEVEL,VALUE,LV) - IF (IAND(TMP,1).EQ.0) IS = TMP - ELSE - VALUE = WORK(:LW) - LV = LW - END IF - IF (DO_SHORT.AND.LV.GT.0) THEN - CALL WNCTXT(DWLOG,' !AS = !AS',KEYWORD(:LK), - 1 VALUE(:LV)) - ELSE IF (DO_SHORT) THEN - CALL WNCTXT(DWLOG,' !AS = /NOASK',KEYWORD(:LK)) - ELSE IF (LV.GT.0) THEN - CALL WNCTXT(DWLOG,' !AS (!AS) = !AS', - 1 NAM(:LN),TYPE(:LT),VALUE(:LV)) - ELSE - CALL WNCTXT(DWLOG,' !AS (!AS)',NAM(:LN),TYPE(:LT)) - END IF - NRSYM = NRSYM+1 - END IF - IF (KEY(:LK).EQ.'*') GOTO 200 !go for next parameter - GOTO 100 !or next list element -C - 900 CONTINUE !end of symbol list - IF (LASTPROG.NE.BLANK) TMP = PPD_EXIT () !close PPD file - IF (IAND(IS,1).EQ.0) THEN !some error: - ELSE IF (NRSYM.EQ.0) THEN !no matching defaults: - CALL WNCTXT(DWLOG,' No symbols found') ! tell - END IF - GOTO 999 !anyway: exit -C -C Terminate the program -C - 999 E_C = MSG_SET(IS,0) !WNGEX exit code - END diff --git a/src/dwarf/vpdefcheck.for b/src/dwarf/vpdefcheck.for deleted file mode 100644 index ecd6ec5dda952fa02613063e6ba1edd6dce8d0df..0000000000000000000000000000000000000000 --- a/src/dwarf/vpdefcheck.for +++ /dev/null @@ -1,126 +0,0 @@ -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ -C.Ident: VP_DEF_CHECK -C.Keywords: Program Parameters, View, Check Values -C.Author: Friso Olnon (NFRA, Dwingeloo) -C.Language: DWARF-Fortran -C.Environment: VAX or Alliant -C.Comments: -C.Version: 900416 FMO - recreation -C.Version: 920206 GvD - add former optional arguments to CLI_GET -C------------------------------------------------------------------------- -C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - INTEGER*4 FUNCTION VP_DEF_CHECK (SYMBOL,VALUE,PROG_DEF,DLEVEL, - 1 VALOUT,LOUT) -C - INCLUDE 'WNG_DEF' - INCLUDE 'DWC_DEF' -C - CHARACTER*(*) SYMBOL ! (i) full parameter name - CHARACTER*(*) VALUE ! (i) input value string - LOGICAL*4 PROG_DEF ! (i) is value a program default ? - INTEGER*4 DLEVEL ! (m) helplevel minus userlevel - CHARACTER*(*) VALOUT ! (o) output value string - INTEGER*4 LOUT ! (o) significant length of VALOUT -C -C.Purpose: Process the value of a program parameter -C.Returns: Status code (.TRUE. for success, .FALSE. otherwise) -C success DWC_SUCCESS -C false status codes returned by referenced modules -C.Notes: -C - Check and evaluate the input string. -C - There may be no unknown symbols. -C - The allowed qualifier is /(NO)ASK. -C - An output string will be generated which is the fully evaluated and -C expanded input string (including possible qualifiers). -C------------------------------------------------------------------------- -C - INTEGER*4 CLI_RESET, CLI_PARSE, CLI_GET - INTEGER*4 DWC_STR_SUBST, DWC_SYM_SPLIT, DWC_HELP - INTEGER*4 PV_BLK_DECODE, PV_BLK_ENCODE - INTEGER*4 PV_BLK_ALLOC, PV_BLK_RELEASE - INTEGER STR_COPY, MSG_SET -C -C - INTEGER*4 NRARG - PARAMETER (NRARG = 3) - CHARACTER*10 NAME(NRARG) - INTEGER*4 ATTR(NRARG) - CHARACTER*1 PROMPT(NRARG) - CHARACTER*1 DEFVAL(NRARG) - DATA NAME /'VALSTR' ,'ASK' ,'SUBSTITUTE' / - DATA ATTR /CLI__EXPRESSION,CLI__QUALIFIER,CLI__QUALIFIER/ - DATA PROMPT /' ' ,' ' ,' ' / - DATA DEFVAL /' ' ,' ' ,' ' / -C - CHARACTER WORK*255, VALSTR*255, PROG*16, STREAM*16, KEY*16 - CHARACTER DUM*1 - INTEGER*4 IS, LW, LVAL, LD, LP, LS, LK - INTEGER*4 ERRPTR, VALBLK(8) - LOGICAL*4 SWSYM - BYTE DEFARR(1) ! dummy -C -C -C Substitute symbols -C - SWSYM = .FALSE. - IS = DWC_SYM_SPLIT (SYMBOL,PROG,LP,STREAM,LS,KEY,LK) - IF (IAND(IS,1).NE.0) IS = DWC_STR_SUBST - 1 (VALUE,WORK,LW,STREAM(:LS),ERRPTR,.FALSE.,SWSYM) - IF (IAND(IS,1).EQ.0) GOTO 991 -C -C If help request: -C - give help and return -C - IS = DWC_HELP (WORK(:LW),1,DLEVEL) - IF (IAND(IS,1).EQ.0) GOTO 999 -C -C Analyse the string -C - reset the Command-Line Interpreter -C - parse the string -C - extract the pure value string -C - IS = CLI_RESET (NRARG,NAME,ATTR,PROMPT,DEFVAL) - IF (IAND(IS,1).NE.0) IS = CLI_PARSE (WORK(:LW)) - IF (IAND(IS,1).NE.0) IS = CLI_GET ('VALSTR',VALSTR,LVAL) - IF (IAND(IS,1).EQ.0) GOTO 999 -C -C Check the value string -C - allocate memory for the value block -C - IS = PV_BLK_ALLOC (VALSTR(:LVAL),VALBLK) - IF (IAND(IS,1).EQ.0) GOTO 999 -C -C - convert value string to value block -C - IS = PV_BLK_DECODE (VALSTR(:LVAL),VALBLK,STREAM(:LS), - 1 .FALSE.,SWSYM,PROG_DEF,DEFARR,0) - IF (IAND(IS,1).EQ.0) GOTO 992 -C -C - convert back to string and -C append ASK qualifier to string -C (substitute qual no longer important) -C - IS = PV_BLK_ENCODE (VALBLK,VALOUT,LOUT) - IF (IAND(IS,1).NE.0) IS = CLI_GET ('ASK',DUM,LD) - IF (IAND(IS,1).EQ.0) GOTO 992 - IF (IS.EQ.DWC_PRESENT) THEN - IS = STR_COPY (' /ASK',VALOUT,LOUT) - ELSE IF (IS.EQ.DWC_NEGATED) THEN - IS = STR_COPY (' /NOASK',VALOUT,LOUT) - ENDIF -C -C - release memory and return -C - IS = PV_BLK_RELEASE (VALBLK) - VP_DEF_CHECK = DWC_SUCCESS - RETURN -C - 991 IS = MSG_SET (DWC_EXPERRMSG,1) - CALL WNCTXT(DWLOG,DWMSG,' ',ERRPTR,WORK(:LW)) - GOTO 999 - 992 IS = PV_BLK_RELEASE (VALBLK) - GOTO 999 - 999 VP_DEF_CHECK = MSG_SET (DWC_PARWRDEF,1) - CALL WNCTXT(DWLOG,DWMSG,KEY(:LK)) - RETURN - END diff --git a/src/ncopy/nco.dsc b/src/ncopy/nco.dsc deleted file mode 100644 index e4c65e21f078322491449f580d0f86667ecdb50d..0000000000000000000000000000000000000000 --- a/src/ncopy/nco.dsc +++ /dev/null @@ -1,64 +0,0 @@ -!+ NCO.DSC -! JPH 930317 -! -! Revisions: -%REVISION=JPH=961213="Add SCANS" -%REVISION=JPH=960220="Add SIFRS" -%REVISION=JPH=940518="Add DO_MDL and DO_IFH" -%REVISION=JPH=931101="New maintenance system" -%REVISION=JPH=930317="Clone from NSC.DSC" -%REVISION=AXC=010709="Linux Port - TABS " -! -! Layout of overall include file (NCO.DEF) -! -%COMMENT="NCO.DEF is an INCLUDE file for the NCOPY program" -%COMMENT=" " -! -%VERSION=1 -%SYSTEM=1 -%USER=JPH -%%DATE -%%NAME -! -! Get number of telescopes -! -%INCLUDE=NSTAR_DSF -! -%LOCAL=MXNSCT=64 !SETS per job -%LOCAL=NIFR=NSTAR_TEL*(NSTAR_TEL+1)/2 !# INTERFEROMETERS - - !MAX. # OF MOSAICK FIELDS -!- -.DEFINE - .PARAMETER - MXNSCT J /MXNSCT/ !MAX. # OF SETS - .DATA -! -! Local variables: -! - .COMMON - OPTION C24 !PROGRAM OPTION - OPT=OPTION C3 - IFILE C80 !INPUT FILE NAME - OFILE C80 !OUTPUT FILE NAME - NODE C80 !OUTPUT NODE - INSCTS J(0:7,0:MXNSCT) !sectors TO DO - OUTSCTS J(0:7,0:MXNSCT) !output sectors pattern - SCANS J(0:1) ! scans selection - SIFRS B(0:NSTAR_TEL-1,0:NSTAR_TEL-1) !SELECTED INTERFEROMETERS - HARAN E(0:1) /-.49999,.49999/ !HA range - OINT J !OUTPUT INTEGRATION TIME (SEC) - CVUTST D !UT/ST CONVERSION FACTOR - FCAOUT J !OUTPUT FCA - NODOUT C80 !OUTPUT NODE - FCAIN J !INPUT FCA - NODIN C80 !INPUT NODE - INPOL J !# of input - ONPOL J ! & output polsns - SGPH J(0:7) !SUB-GROUP POINTER - SGNR J(0:7) !SUB-GROUP NUMBER - CAP J /0/ !apply - CDAP J /0/ ! /deapply bitmasks - DO_MDL L !copy model - DO_IFH L !copy IF-data -.END diff --git a/src/ncopy/nco.grp b/src/ncopy/nco.grp deleted file mode 100644 index f34f36f7dba9b15df6788699604bff8d1ca68881..0000000000000000000000000000000000000000 --- a/src/ncopy/nco.grp +++ /dev/null @@ -1,37 +0,0 @@ -!+ NCO.GRP -! JPH 931101! -! Revisions: -! HjV 940214 Remove NCOREV -! -! -! Group definition: -! -NCO.GRP -! -! PIN files -! -NCOPY.PSC -! -! Structure files -! -! -! Fortran definition files: -! -NCO.DSC ! Program common/parameters -! NCO.DEF ! Fortran include -! NCO.INC ! C include -! -! Programs: -! -NCOPY.FOR ! Main routine -NCOCPB.FOR ! Make unique copy of block ! -NCOCPY.FOR ! Main copy routine -NCODAT.FOR ! Get user parameters -NCOINI.FOR ! Program start -NCOOVV.FOR ! Overview of sectors in SCN file -! -! Executables -! -NCOPY.EXE ! SCN selective copy - ! SCN simulation -!- diff --git a/src/ncopy/ncocpb.for b/src/ncopy/ncocpb.for deleted file mode 100644 index 31942439c9d2bca02003667b641f3b14bd0002cb..0000000000000000000000000000000000000000 --- a/src/ncopy/ncocpb.for +++ /dev/null @@ -1,124 +0,0 @@ -C+ NCOCPB.FOR -C JPH 930202 -C -C Revisions: -C JPH 930331 Correct indexing of CHKJ -C JPH 930517 Optional suppression of CHKLST update -C JPH 930610 Negative IDATP option -C AXC 010709 Linux port - TABS -C -C - LOGICAL FUNCTION - 1 NCOCPB(FCAIN,FCAOUT,LEN,IDATP,BUF,ODATP,CHK,COPIED) -C -C Make unique copy of input block to output file -C -C Result: -C -C NCOCPB_L= -C NCOCPB( FCAIN_J:I, FCAOUT_J:I, LEN_J:I, IDATP_J:I, -C BUF_B:[I]O, ODATP_J:O, -C CHKJ[2,0:*]:IO, COPIED_L:O ) -C Copy data block of LEN bytes at file address IDATP in file FCAIN -C to file FCAOUT, using buffer BUF in which the blocks contents are -C also returned to caller. The output file address is returned in -C ODATP. -C To copy only once, IDATP/ODATP pairs are collected in a list CHK, -C against which a check is made before a copy is performed. -C COPIED indicates whether a copy was actually made. -C Caller is responsible for: -C - allocating CHK(2,0:n) and initialising -C its first element with the value -n, where n is >= the number of -C different blocks to be copied; -C - making BUF >= LEN bytes -C Special cases: -C - CHKLST(0,0)=0 (or an argument 0 submitted in lieu of CHKLST): Do not -C record this copy, - to be used when caller is certain that a block being -C copied will not be presented again. -C - IDATP <0: Input from file address -IDATP is already in BUF, do not read it -C again -C -C -C Include files: -C - INCLUDE 'WNG_DEF' -C -C Parameters: -C -C Arguments: -C - INTEGER FCAIN, FCAOUT !file pointers - INTEGER LEN !data block length - INTEGER IDATP,ODATP !file addresses - BYTE BUF(0:*) !data block - INTEGER CHK(2,0:*) !ckeck list - max and actual - ! lengths are maintained in - ! row 0 - LOGICAL COPIED !"copied" status -C -C Function references: - LOGICAL WNFRD,WNFWR !buffered read, write - INTEGER WNFEOF !find EOF file address -C -C Data declarations: -C - INTEGER MXNCHK, NCHK !max and actual CHK lengths -C- -C Initialise -C - NCOCPB=.FALSE. !preset failure -C -C Initialise check list: -C - IF (CHK(1,0).NE.0) THEN !valid check list? - IF (CHK(1,0).LT.0) THEN !yes, first call? - CHK(1,0)=-CHK(1,0) !yes, initialise max. and - CHK(2,0)=0 ! actual list lengths - ENDIF - NCHK=CHK(2,0) !copy to local - ELSE !no check list - NCHK=0 !set nothing to check - ENDIF - MXNCHK=CHK(1,0) -C -C test if already done -C - DO I=1,NCHK - IF (ABS(IDATP).EQ.CHK(1,I)) THEN !this IDATP? - ODATP=CHK(2,I) !yes, return corresp. ODATP - COPIED=.FALSE. !report not copied - GOTO 800 ! and exit - ENDIF - ENDDO -C -C not done, copy block, update checklist -C - IF (IDATP.GT.0) THEN - IF (.NOT.WNFRD - 1 (FCAIN,LEN,BUF,IDATP)) THEN !read - CALL WNCTXT(F_TP,'Error reading data') - GOTO 900 - ENDIF - ENDIF - ODATP=WNFEOF(FCAOUT) !get output file address - IF (.NOT.WNFWR(FCAOUT,LEN,BUF,ODATP)) THEN !write - CALL WNCTXT(F_TP,'Error writing data') - GOTO 900 - ENDIF - COPIED=.TRUE. !report block was copied -C - IF (MXNCHK.NE.0) THEN !valid check list? - NCHK=NCHK+1 !new entry - IF (NCHK.GT.MXNCHK) THEN - CALL WNCTXT(F_TP,'NCOCPB checklist overflow') - CALL WNGEX - ENDIF - CHK(2,0)=NCHK !new list length - CHK(1,NCHK)=ABS(IDATP) !entry: in- and corresponding - CHK(2,NCHK)=ODATP ! output file address - ENDIF -C - 800 NCOCPB=.TRUE. !success - 900 RETURN -C - END diff --git a/src/ncopy/ncocpy.for b/src/ncopy/ncocpy.for deleted file mode 100644 index 1ee362ebbbbcfee11114eefaf2e0bb5938b2a216..0000000000000000000000000000000000000000 --- a/src/ncopy/ncocpy.for +++ /dev/null @@ -1,683 +0,0 @@ -C+ NCOCPY.FOR -C JPH 930119 -C -C Revisions: -C JPH 930329 integrate NSCREG code for OUTPUT_SCTS -C JPH 930426 replace STH(,IN:OUT) arrays by ISTH, OSTH etc. -C JPH 930514 restructure with internal subroutines -C all-wildcard output sets means new group -C JPH 930525 check if sector already copied -C JPH 930719 output sector numbering -C JPH 930720 proper addressing of polarisations in model -C JPH 930824 Simplify for 1always 4-polarisation model -C JPH 931007 OSCH eqv ISCH. - Zero Y noises for 1 output polsn -C JPH 931018 Add model input for SIM option. - Use DAT i.s.o. XMOD -C JPH 931109 Remove simulation -C JPH 940107 Use NSCSCF/NSCSFW i.s.o. NSCSCR/NSCSDW to also copy -C flags -C JPH 940208 Do not record STH addresses in checklist, Reinitialise -C checklist for every new input group. Extend checklist. -C JPH 940218 FLW I*2 --> I*4 -C CMV 940228 Correct call to NSCPFL -C CMV 940518 Select copy of Model and IF-data -C JPH 941006 Remove c#print, c#error lines -C JPH 960220 Interferometer selection for ifr table, visibilities. -C JPH 960305 Also for model, - no selection is needed for the IF data -C JPH 960617 Correct order of actions. Bug fix: Remove comment C from -C OIFR=0. -C JPH 960624 Zero SCH_IFRA/MC -C JPH 960725 Add YX mode (ONPOL=-2) -C JPH 961213 SHORTCOPY option: SCANS selection -C AXC 010709 Linux port - TABS -C CMV 040629 Allow to copy autocorrelations -C CMV 041102 Corrected (severe and stupid) bug in copy of autos -C -C - SUBROUTINE NCOCPY -C -C Create new SCN file -C -C Result: -C -C CALL NCOCPY -C Copies selected sets from input to output file -C Input and output files have been opened by NSCNOD, -C which has also initialised a new output file -C with a GFH block -C -C Include files: -C - INCLUDE 'WNG_DEF' - INCLUDE 'FDW_O_DEF' - INCLUDE 'FDX_O_DEF' - INCLUDE 'OHW_O_DEF' - INCLUDE 'SCW_O_DEF' - INCLUDE 'SHW_O_DEF' - INCLUDE 'GFH_O_DEF' !group file header - INCLUDE 'SGH_O_DEF' !subgroup header - INCLUDE 'MDH_O_DEF' - INCLUDE 'MDL_O_DEF' - INCLUDE 'IFH_O_DEF' - INCLUDE 'STH_O_DEF' !SET HEADER - INCLUDE 'SCH_O_DEF' !SCAN HEADER - INCLUDE 'NCO_DEF' - INCLUDE 'SCN_DEF' -C -C Parameters: - INTEGER C,S, XX,XY,YX,YY - PARAMETER (C=0,S=1, XX=0,XY=1,YX=2,YY=3) -C Estimate of checklist size: 128-field mosaic, 8 frequencies, 18 sectors per -C frequency: 128 OH, 128*8 SH, 128*8 MDH give 2176 - INTEGER CHKLEN - PARAMETER (CHKLEN=4096) -C -C Arguments: -C -C -C Function references: -C - INTEGER WNFEOF !FILE LENGTH - LOGICAL WNFWR !WRITE DISK - LOGICAL WNFRD !READ DISK - LOGICAL WNDLNF,WNDLNG,WNDLNK !LINK sectors - CHARACTER*32 WNTTSG !sector NAME - LOGICAL NCOCPB !make unique copy of block - LOGICAL NSCSIF !READ IFR DATA - LOGICAL NSCSCM !read model data - LOGICAL NSCSCR, NSCSCF !READ SCANls *.for - LOGICAL NSCSDW, NSCSFW !write scan - LOGICAL NSCSTG !GET SET -C -C Data declarations: -C - LOGICAL COPIED !"data copied" flag from NCOCPB -C - INTEGER LEN, ILEN, OLEN !data block lengths - INTEGER SCNFST, SCNLST !scan # range within HA range - INTEGER ONPOLC !# of polsn in current output - INTEGER ISCN,OSCN !scan loop index - INTEGER OPOL !output polsn index - INTEGER INIFR !# of input IFRs - INTEGER ONIFR !# of output IFRs - INTEGER IIFR !input IFR index - INTEGER OIFR !output IFR index - INTEGER*2 IIFRT(0:STHIFR-1) !buffer for input IFR TABLE - INTEGER*2 OIFRT(0:STHIFR-1) !buffer for output IFR TABLE - EQUIVALENCE (IIFRT,OIFRT) !build OIFRT in place -C - REAL IWGT(0:STHIFR-1,XX:YY), - 1 OWGT(0:STHIFR-1,XX:YY) !weights - INTEGER IFLW(0:STHIFR-1,XX:YY), - 1 OFLW(0:STHIFR-1,XX:YY) !flag/weight words - REAL IDAT(C:S,0:STHIFR-1,XX:YY), - 1 ODAT(C:S,0:STHIFR-1,XX:YY) !data (cos/sin, ifr, polsn) - INTEGER IIFRA (0:1, 0:STHIFR-1) - REAL ANG (0:2, 0:STHIFR-1) - REAL BASEL (0:STHIFR-1) ! BASELINE TABLE: -1 indicates - ! ifr absent - - INTEGER IPOL !polarisation index in WGT, DAT -C - COMPLEX ICMOD(XX:YY,0:STHIFR-1) !MODEL DATA, 4 polsns - COMPLEX OCMOD(XX:YY,0:STHIFR-1) -C - INTEGER ISRC, IFR, IPL !source, ifr, polsn loop indices - INTEGER INP !input pointer - INTEGER OUTP !output pointer - INTEGER MDHP !model hdr ptr offset in STH - INTEGER MDDP !model data ptr offset in STH -C - INTEGER ISNAM(0:7) !current input set name - INTEGER OSNAM(0:7) !current output set name - INTEGER LVL !SGH level: index for xxSNAM - INTEGER ISTHP,OSTHP !SEctor HEADER POINTER - INTEGER OMODP !output model ptr - INTEGER ICURGRP !input current group -C - - - BYTE ISTH(0:STHHDL-1)!input sector header - INTEGER*2 ISTHI(0:STHHDL/2-1) - INTEGER ISTHJ(0:STHHDL/4-1) - REAL ISTHE(0:STHHDL/4-1) - DOUBLE PRECISION ISTHD(0:STHHDL/8-1) - EQUIVALENCE (ISTH,ISTHI,ISTHJ,ISTHE,ISTHD) -C - BYTE OSTH(0:STHHDL-1)!output sector header - INTEGER*2 OSTHI(0:STHHDL/2-1) - INTEGER OSTHJ(0:STHHDL/4-1) - REAL OSTHE(0:STHHDL/4-1) - DOUBLE PRECISION OSTHD(0:STHHDL/8-1) - EQUIVALENCE (OSTH,OSTHI,OSTHJ,OSTHE,OSTHD) -C - BYTE ISCH(0:SCHHDL-1)!input SCAN HEADER - INTEGER*2 ISCHI(0:SCHHDL/2-1) - INTEGER ISCHJ(0:SCHHDL/4-1) - REAL ISCHE(0:SCHHDL/4-1) - DOUBLE PRECISION ISCHD(0:SCHHDL/8-1) - EQUIVALENCE (ISCH,ISCHI,ISCHJ,ISCHE,ISCHD) -C - BYTE OSCH(0:SCHHDL-1)!output SCAN HEADER - INTEGER*2 OSCHI(0:SCHHDL/2-1) - INTEGER OSCHJ(0:SCHHDL/4-1) - REAL OSCHE(0:SCHHDL/4-1) - DOUBLE PRECISION OSCHD(0:SCHHDL/8-1) - EQUIVALENCE (OSCH,OSCHI,OSCHJ,OSCHE,OSCHD) -C - EQUIVALENCE (OSCH,ISCH) -C - INTEGER CHKLST(2,0:CHKLEN)!checklist for NCOCPB -C - BYTE IFH(0:MDHHDL-1) !IF HEADER - INTEGER*2 IFHI(0:IFHHDL/2-1) - INTEGER IFHJ(0:IFHHDL/4-1) - REAL IFHE(0:IFHHDL/4-1) - EQUIVALENCE (IFH,IFHI,IFHJ,IFHE) -C - INTEGER GFHJ(0:GFHHDL/4-1) !group file header - BYTE MDH(0:MDHHDL-1) !MODEL HEADER - INTEGER MDHJ(0:MDHHDL/4-1) - EQUIVALENCE (MDH,MDHJ) - BYTE FDW(FDWHDL+FDXHDL)!WSRT TAPE BLOCKS - BYTE OHW(OHWHDL) - BYTE SCW(SCWHDL) - BYTE SHW(SHWHDL) - INTEGER*2 BUF(0:2,XX:YY,0:STHIFR-1)!work buffer for NCOCPB; also - ! used for copying IF data - EQUIVALENCE (GFHJ,MDH,FDW,OHW,SCW,SHW,BUF) ! length is largest of - ! these blocks: OHWHDL=25380 -C - REAL MAXD !maximum data value - REAL HA !current hour angle -C- -C -C INIT -C - ICURGRP=-1 -C -C INPUT SET LOOP -C - DO WHILE (NSCSTG(FCAIN,INSCTS(0,0), - 1 ISTH(0),ISTHP,ISNAM(0))) !Read next STH - CALL WNDSTI(FCAIN,ISNAM) !get "." input name - INIFR=ISTHJ(STH_NIFR_J) !# of input ifrs -C -C Check which scans are within HA range -C - SCNFST=-( (-HARAN(0)+ISTHE(STH_HAB_E)) - 1 /ISTHE(STH_HAI_E) ) !start of range: round up - SCNLST= ( HARAN(1)-ISTHE(STH_HAB_E)) - 1 /ISTHE(STH_HAI_E) !end of range: round down - SCNFST=MAX(SCNFST,SCANS(0)) !acknowledge SHORTCOPY SCANS - SCNLST=MIN(SCNLST,SCANS(1)) ! specification - IF (SCNFST.LT.0) SCNFST=0 - IF (SCNLST.GE.ISTHJ(STH_SCN_J)) - 1 SCNLST=ISTHJ(STH_SCN_J)-1 - IF (SCNFST.LE.SCNLST) THEN !any scan within HA range? -C -C Check for enough input polarisations -C - INPOL=ISTHI(STH_PLN_I) !yes, get # of input polsns - IF (ABS(ONPOL).GT.INPOL) THEN !enough input polsns? - CALL WNCTXT(F_TP, - 1 'Can only copy !UJ polarisations in input sector !AS', - 1 INPOL,WNTTSG(ISNAM,0)) - ENDIF - ONPOLC=MIN(INPOL,ABS(ONPOL)) -C -C****************************************************************************** -C Copy sector with everything attached -C****************************************************************************** -C -C Make output sector name -C - DO LVL=SCN_OBS,SCN_CHN !obs, field, channel - OSNAM(LVL)=ISNAM(LVL) !copy input component - END DO - IF (ISNAM(SCN_GRP).NE.ICURGRP) THEN !new input group? - ICURGRP=ISNAM(SCN_GRP) - IF (.NOT.WNFRD(FCAOUT,GFHHDL,GFHJ,0))!yes, read GFH - 1 GOTO 990 - OSNAM(SCN_GRP)=GFHJ(GFH_LLEN_J) !first free group nr - CALL WNCTXT(F_TP, - 1 'Copying input group !UJ to output group !UJ', - 1 ISNAM(SCN_GRP),OSNAM(SCN_GRP)) -C - CHKLST(1,0)=-CHKLEN !re-initialise checklist - ENDIF -C -C Make a preliminary disk copy of the STH just to check if it is new and -C to get it entered in CHKLST -C - OSTHP=WNFEOF(FCAOUT) - IF (.NOT.WNFWR(FCAOUT,STHHDL,ISTH(0),OSTHP) ) - 1 THEN - GOTO 990 - ENDIF -C -C Set up output STH and adjust scan parameters in it -C - CALL WNGMV - 1 (STHHDL,ISTH(0),OSTH(0)) !copy STH block - OSTHE(STH_HAB_E)= - 1 ISTHE(STH_HAB_E) +SCNFST*ISTHE(STH_HAI_E) - OSTHJ(STH_SCN_J)=SCNLST-SCNFST+1 - OSTHI(STH_PLN_I)=ONPOLC -C -C Clear noise entries for Y that become invalid if only XX present -C - IF (ONPOLC.EQ.1) THEN - OSTHE(STH_REDNS_E+2)=0 - OSTHE(STH_REDNS_E+3)=0 - OSTHE(STH_ALGNS_E+2)=0 - OSTHE(STH_ALGNS_E+3)=0 - OSTHE(STH_OTHNS_E+2)=0 - OSTHE(STH_OTHNS_E+3)=0 - ENDIF -C -C Read input, build output IFR table AND WRITE IT -C - IF (.NOT.WNFRD(FCAIN,LB_I*INIFR, !read input IFR table - 1 IIFRT,ISTHJ(STH_IFRP_J))) THEN - CALL WNCTXT - 1 ('Error reading interferometer table for set !AS, - 1 WNTTSG(ISNAM(0))') - GOTO 990 - END IF - CALL NSCMBL(ISTHE(STH_RTP_E),INIFR,IIFRT, - 1 SIFRS,BASEL) ! MAKE BASEL. - OIFR=0 - DO IIFR=0,INIFR-1 - IF (BASEL(IIFR).GE.0) THEN - OIFRT(OIFR)=IIFRT(IIFR) - OIFR=OIFR+1 - ENDIF - ENDDO - ONIFR=OIFR - OSTHJ(STH_NIFR_J)=ONIFR - OSTHJ(STH_SCNL_J)=SCHHDL+3*LB_I*ONIFR*ONPOLC - OUTP=WNFEOF(FCAOUT) - IF (.NOT.WNFWR(FCAOUT,LB_I*ONIFR, - 1 OIFRT,OUTP)) THEN !write output IFR table - GOTO 990 - ENDIF - OSTHJ(STH_IFRP_J)=OUTP !set pointer in STH -C -C Copy WSRT header blocks -C - GOTO 2000 -2001 CONTINUE -C -C Copy scans -C - OUTP=WNFEOF(FCAOUT) - OSTHJ(STH_SCNP_J)=OUTP !set scans pointer in STH - GOTO 2020 - 2021 CONTINUE -C -C Copy model -C - IF (DO_MDL) THEN !Copy model - GOTO 2010 - 2011 CONTINUE - ELSE !No model - OSTHJ(STH_MDL_J )=0 !Clear pointers - OSTHJ(STH_MDL_J+1)=0 - OSTHJ(STH_MDD_J )=0 - OSTHJ(STH_MDD_J+1)=0 - END IF -C -C Copy IF data -C - IF (DO_IFH.AND.ISTHJ(STH_IFHP_J).NE.0) THEN !Copy IF data - GOTO 2030 - 2031 CONTINUE - ELSE - OSTHJ(STH_IFHP_J)=0 - OSTHJ(STH_IFHL_J)=0 - END IF -C -C** manipulate STH corrections here -C -C Rewrite output STH -C - IF (.NOT.WNFWR(FCAOUT,STHHDL, - 1 OSTH(0),OSTHP)) THEN !rewrite output STH - CALL WNCTXT(F_TP, - 1 'Error writing sector header !AS', WNTTSG(OSNAM)) - GOTO 990 - ENDIF - -C****************************************************************************** -C Link output sector -C****************************************************************************** -C - IF (.NOT.WNDLNK(0+GFH_LINK_1, !link sector in absolute list - 1 OSTHP,STH_SETN_1,FCAOUT)) THEN - GOTO 990 - ENDIF -C - IF (.NOT.WNDLNF(0+GFH_LHD_1, - 1 OSNAM(SCN_GRP),SGH_NAME_1, - 1 FCAOUT,SGPH(SCN_GRP), - 1 SGNR(SCN_GRP))) THEN !find/create group SGH -C - ENDIF - DO LVL=SCN_OBS,SCN_CHN !find/create obsvn, field, -C ! channel SGHs - IF (.NOT.WNDLNF - 1 (SGPH(LVL-1)+SGH_LHD_1, - 1 OSNAM(LVL), - 1 SGH_NAME_1,FCAOUT,SGPH(LVL), - 1 SGNR(LVL))) THEN - GOTO 990 - ENDIF - ENDDO - IF (.NOT.WNDLNG !create sector SGH and - 1 (SGPH(SCN_CHN)+SGH_LHD_1,OSTHP, ! link STH to it - 1 SGH_NAME_1,FCAOUT,SGPH(SCN_SCT), - 1 SGNR(SCN_SCT))) THEN - GOTO 990 - ENDIF - ENDIF ! any scan within HA range" - 800 CONTINUE - ENDDO !sector loop -C -C READY -C - 900 CONTINUE - CALL NSCPFH (F_TP, FCAOUT) !show output header - CALL NSCPFL (F_TP, FCAOUT,NODOUT,.FALSE.)! and layout - CALL WNFCL(FCAIN) - CALL WNFCL(FCAOUT) -C - RETURN -C -C Fatal-error exits -C - 990 CONTINUE - CALL WNCTXT(F_TP, - 1 'Error copying sector !AS',WNTTSG(ISNAM)) - CALL WNGEX !STOP -C - RETURN - -C****************************************************************************** -C Internal subroutine to copy WSRT blocks -C****************************************************************************** -C - 2000 CONTINUE - IF (.NOT.NCOCPB(FCAIN,FCAOUT, !FD plus FDX block - 1 ISTHJ(STH_NFD_J), - 1 ISTHJ(STH_FDP_J),BUF, - 1 OSTHJ(STH_FDP_J),CHKLST, - 1 COPIED)) THEN -CC CALL WNCTXT(F_TP,'Error copying FD/FDX block') -C#ERROR 'copy FD/FDX' - GOTO 990 - ENDIF -C - IF (.NOT.NCOCPB(FCAIN,FCAOUT, !OH block - 1 ISTHJ(STH_NOH_J), - 1 ISTHJ(STH_OHP_J),BUF, - 1 OSTHJ(STH_OHP_J),CHKLST, - 1 COPIED)) THEN -CC CALL WNCTXT(F_TP,'Error copying OH block') -C#ERROR 'copy OH' - GOTO 990 - ENDIF -C - IF (.NOT.NCOCPB(FCAIN,FCAOUT, !SC block - 1 ISTHJ(STH_NSC_J), - 1 ISTHJ(STH_SCP_J),BUF, - 1 OSTHJ(STH_SCP_J),CHKLST, - 1 COPIED)) THEN - CALL WNCTXT(F_TP,'Error copying SC block') - GOTO 990 - ENDIF -C - IF (.NOT.NCOCPB(FCAIN,FCAOUT, !SH block - 1 ISTHJ(STH_NSH_J), - 1 ISTHJ(STH_SHP_J),MDH, - 1 OSTHJ(STH_SHP_J),CHKLST, - 1 COPIED)) THEN - CALL WNCTXT(F_TP,'Error copying SH block') - GOTO 990 - ENDIF - GOTO 2001 - - 2010 CONTINUE -C****************************************************************************** -C Internal subroutine to copy model -C****************************************************************************** -C -C Model: MDH blocks -C - DO MDHP=STH_MDL_J,STH_MDL_J+1 !loop over MDH[0:1] in STH - IF (ISTHJ(MDHP).NE.0) THEN - IF (.NOT.NCOCPB(FCAIN,FCAOUT,MDHHDL, - 1 ISTHJ(MDHP),MDHJ, !copy MDH block - 1 OSTHJ(MDHP),CHKLST, - 1 COPIED)) THEN - CALL WNCTXT(F_TP,'Error copying MDH block') -C#ERROR 'copy MDH' - GOTO 990 - ENDIF -C#PRINT 'MDH', WNFEOF(FCAOUT) -C -C Model components. If there is an MDH, COPIED tells us if it was already there -C or copied now, in which case the components must also be copied. In that -C case the header was returned in MDHJ so we can read it. -C We process the model components one by one because we cannot be sure -C that BUF can hold them all. -C (It would be more efficient to process them at least in groups.) -C This section will be executed only when the MDH is copied for the first -C time, so there is no need for NCOCPB to remember the source components in -C CHKLST -C - IF (COPIED) THEN - INP=MDHJ(MDH_MODP_J) !input file address of model - OMODP=WNFEOF(FCAOUT) !remember output model ptr - DO ISRC=0,MDHJ(MDH_NSRC_J)-1 !MDH_NSRC sources - IF (.NOT.NCOCPB(FCAIN, !of length MDLHDL each - 1 FCAOUT,MDLHDL,INP,BUF, - 1 OUTP,0,COPIED)) THEN - CALL WNCTXT(F_TP,'Error copying model sources') - GOTO 990 - ENDIF - INP=INP+MDLHDL !next source - ENDDO !end source loop -C - J=OSTHJ(MDHP) !output file addr. of model hdr - IF (.NOT.WNFWR(FCAOUT,LB_J,OMODP, - 1 J+MDH_MODP_1)) THEN !store remembered MODP in MDH - CALL WNCTXT(F_TP,'Error copying MDH block') -C#ERROR 'update MDH' - GOTO 990 - ENDIF - ENDIF! COPIED - ENDIF! model present - ENDDO! models #1 and 2 -C -C Model visibilities. Input is pointed at by STH_MDD[0:1], output is appended -C and its address stored in STH_MDD. The range [SCNFST,SCNLST] of scans to -C be copied was determined above -C - DO MDDP=STH_MDD_J,STH_MDD_J+1 !model data 1 and 2 - IF (ISTHJ(MDDP).NE.0) THEN !present? - ILEN=4*INIFR*LB_X !the model data area has - ! 4 polsns regardless of - OLEN=4*ONIFR*LB_X ! what is actually needed - - INP=ISTHJ(MDDP)+SCNFST*LEN !input file addr. of model data - !for first scan processed - OUTP=WNFEOF(FCAOUT) - OSTHJ(STH_MDD_J)=OUTP !pointer in output STH - DO ISCN=SCNFST,SCNLST - IF (.NOT.WNFRD(FCAIN,ILEN,ICMOD,INP)) - 1 GOTO 2029 - OIFR=0 - DO IIFR=0,INIFR-1 - IF (BASEL(IIFR).GE.0) THEN - DO IPL=XX,YY - OCMOD(IPL,OIFR)=ICMOD(IPL,IIFR) - ENDDO - OIFR=OIFR+1 - ENDIF - ENDDO - IF (.NOT.WNFWR(FCAOUT,OLEN,OCMOD,OUTP)) - 1 GOTO 2029 - OUTP=OUTP+OLEN !move to next output - INP=INP+ILEN ! and input scans - ENDDO !ISCN -C#PRINT 'Model visibilities', WNFEOF(FCAOUT) - ENDIF !MDDP#0 - ENDDO !MDDP - GOTO 2011 -C -C Error -C -2029 CONTINUE - CALL WNCTXT(F_TP,'Error copying model visibilities') - GOTO 990 - - 2020 CONTINUE -C****************************************************************************** -C Internal subroutine to copy scan -C****************************************************************************** -C -C Copy observed visibilities -C - CALL WNCTXT(F_TP,'Copying sector !AS',WNTTSG(ISNAM,0)) - DO ISCN=SCNFST,SCNLST - OSCN=ISCN-SCNFST - IF (.NOT.NSCSCF(FCAIN,ISTH(0), !read input scan - 1 IIFRT,ISCN,CAP,CDAP, - 1 ISCH(0),IWGT,IDAT,IFLW)) THEN - CALL WNCTXT(F_TP,'Error reading scan !UJ of sector !AS', - 1 ISCN,WNTTSG(ISNAM,0)) - GOTO 990 - ENDIF -C -C Invalidate interferometer corrections. - This is a quick and dirty fix! -C - OSCHJ(SCH_IFRMC_J)=0 - OSCHJ(SCH_IFRAC_J)=0 -C -C Invalidate terms that are absent if only XX present -C NOTE: There may also be correction parameters for Y but we need not bother -C with them because they will be ignored by everyone -C - IF (ONPOLC.EQ.1) THEN - OSCHE(SCH_REDNS_E+2)=0 - OSCHE(SCH_REDNS_E+3)=0 - OSCHE(SCH_ALGNS_E+2)=0 - OSCHE(SCH_ALGNS_E+3)=0 - OSCHE(SCH_OTHNS_E+2)=0 - OSCHE(SCH_OTHNS_E+3)=0 - ENDIF -C -C Select data for selected interferometers. -C - OIFR=0 - DO IIFR=0,INIFR-1 - IF (BASEL(IIFR).GE.0) THEN - DO IPL=XX,YY - ODAT(C,OIFR,IPL)=IDAT(C,IIFR,IPL) - ODAT(S,OIFR,IPL)=IDAT(S,IIFR,IPL) - OWGT( OIFR,IPL)=IWGT( IIFR,IPL) - OFLW( OIFR,IPL)=IFLW( IIFR,IPL) - ENDDO - OIFR=OIFR+1 - ENDIF - ENDDO -C -C Copy XY to XX, YX to YY for YX mode -C - IF (ONPOL.EQ.-2) THEN ! YX mode? - DO OIFR=0,ONIFR-1 - DO IPL=XY,YX - ODAT(C,OIFR,3*(IPL-1))=ODAT(C,OIFR,IPL) - ODAT(S,OIFR,3*(IPL-1))=ODAT(S,OIFR,IPL) - OWGT( OIFR,3*(IPL-1))=OWGT( OIFR,IPL) - OFLW( OIFR,3*(IPL-1))=OFLW( OIFR,IPL) - ENDDO - ENDDO - ENDIF -C -C** manipulate SCH corrections here -C - IF (.NOT.NSCSFW(FCAOUT,OSTH(0), !write output scan - 1 0,OSCN,0,0, - 1 OSCH(0),OWGT,ODAT,OFLW)) THEN - CALL WNCTXT(F_TP,'Error writing scan !UJ of sector !AS', - 1 OSCN, WNTTSG(OSNAM,0)) -C#ERRORC 'scan write', WNTTSG(OSNAM,0) - GOTO 990 - ENDIF - ENDDO -C - GOTO 2021 - - 2030 CONTINUE -C -C************************************************************* -C Internal subroutine to copy the IF data (total powers) -C************************************************************* -C - IF (.NOT.NCOCPB(FCAIN,FCAOUT,IFHHDL, - 1 ISTHJ(STH_IFHP_J),IFH, - 1 OSTHJ(STH_IFHP_J),CHKLST,COPIED)) THEN !Copy header - CALL WNCTXT(F_TP,'Error copying IFH block') - GOTO 990 - END IF -C -C If the header was copied, we also need to do the data -C The hour-angle range has to be the same as for the visibilities -C - IF (COPIED) THEN !Copy data - J=ISTHJ(STH_IFHP_J)+IFHHDL !Input data pointer - J1=OSTHJ(STH_IFHP_J)+IFHHDL !Output data pointer - I1=4*STHTEL*LB_I !Data length -C - OSCN=0 !Count output scans - DO ISCN=0,IFHJ(IFH_NTP_J)-1 !Total powers - HA=IFHE(IFH_HAB_E)+ISCN*IFHE(IFH_HAI_E) !Get Hour angle - IF (HA.GE.HARAN(0).AND.HA.LE.HARAN(1)) THEN !In range - OSCN=OSCN+1 !Count scan - IF (.NOT.WNFRD(FCAIN,I1,BUF,J)) GOTO 990 !Read data - IF (.NOT.WNFWR(FCAOUT,I1,BUF,J1)) GOTO 990 !Write data - J1=J1+I1 !Next in output - END IF - J=J+I1 !Next in input - END DO - IFHJ(IFH_NTP_J)=OSCN !Update number of scans -C - OSCN=0 !Count output scans - DO ISCN=0,IFHJ(IFH_NIF_J)-1 !IF-data (not yet used) - HA=IFHE(IFH_HAB_E)+ISCN*IFHE(IFH_HAI_E) !Get Hour angle - IF (HA.GE.HARAN(0).AND.HA.LE.HARAN(1)) THEN !In range - OSCN=OSCN+1 !Count scan - IF (.NOT.WNFRD(FCAOUT,I1,BUF,J)) GOTO 990 !Read data - - IF (.NOT.WNFWR(FCAOUT,I1,BUF,J1)) GOTO 990 !Write data - J1=J1+I1 !Next in output - END IF - J=J+I1 !Next in input - END DO - IFHJ(IFH_NIF_J)=OSCN !Update number of scans -C - OSTHJ(STH_IFHL_J)=IFHHDL+I1*(IFHJ(IFH_NTP_J)+IFHJ(IFH_NIF_J)) -C - IF (HARAN(0).GT.IFHE(IFH_HAB_E)) IFHE(IFH_HAB_E)=HARAN(0) !And HAB - IF (.NOT.WNFWR(FCAOUT,IFHHDL, - 1 IFH,OSTHJ(STH_IFHP_J))) THEN !Rewrite - CALL WNCTXT(F_TP,'Error rewriting IFH') - GOTO 990 - END IF - END IF -C - GOTO 2031 -C -C - END diff --git a/src/ncopy/ncodat.for b/src/ncopy/ncodat.for deleted file mode 100644 index eb29b8a2adaa6c40d17921e003c6d12410266145..0000000000000000000000000000000000000000 --- a/src/ncopy/ncodat.for +++ /dev/null @@ -1,226 +0,0 @@ -C+ NCODAT.FOR -C JPH 930317 -C -C Revisions: -C JPH 930610 Restrict polsn selection to XX/XY/XYX -C JPH 930831 Suppress OUTPUT_SECTORS prompt -C JPH 931012 Add SIM option. - Remove 'XYX' default from -C WNDPAR('SELECT_XYX'...) call. -C JPH 931102 Add KEEP_MODEL. SELECT_XYX --> POLARISATION -C CMV 931220 Pass FCA of input file to WNDXLP and WNDSTA/Q -C JPH 940107 Remove 'SIM' option. Correct previous: FCAOUT --> FCAIN -C CMV 940518 Add options to select copy of model and IF-data -C CMV 940926 Close old file before asking new one -C JPH 941006 APPLY, DE_APPLY prompts -C JPH 960220 NSCIFS -C JPH 960625 Message on MIFR corrections -C JPH 960725 Add YX polarisation mode -C JPH 961213 SHORTCOPY option, SCANS parameter -C JPH 961218 Call NSCHAS with type=1: '*' prompt -C JPH 970403 Init SCANS to 0,65536 for standard COPY option -C AXC 010709 Linux port - TABS -C -C - SUBROUTINE NCODAT -C -C Get NCOPY program parameters -C -C Result: -C -C CALL NCODAT will ask and set all program parameters -C -C PIN references: -C -C OPTION -C INPUT_SCN_NODE -C OUTPUT_SCN_NODE -C INPUT_SECTORS -C HA_RANGE -C POLARISATION -C COPY_MODEL -C COPY_IFDATA -C -C Include files: -C - INCLUDE 'WNG_DEF' - INCLUDE 'NCO_DEF' -C -C Parameters: -C -C -C Arguments: -C -C -C Function references: -C - INTEGER*4 PUT_PARM - LOGICAL WNDPAR !GET DWARF PARAMETER - LOGICAL WNDNOD !GET NODE NAME - LOGICAL WNDDA1, WNDDA2 ! get APPLY, DE_APPLY - LOGICAL WNDPAP ! set interface-parameter value - LOGICAL WNFMOU !MOUNT TAPE - LOGICAL WNFOP,WNFOPF !OPEN FILE - LOGICAL WNDSTA !GET SCTS TO DO - LOGICAL NSCHAS !GET HA-RANGE - LOGICAL NSCIFS ! select ifrs -C -C Data declarations: -C - CHARACTER*4 POLC !POLARISATION CODE - CHARACTER*80 FILOUT - LOGICAL BB1 -C- -C -C GET OPTION -C - 100 CONTINUE - IF (.NOT.WNDPAR('OPTION',OPTION, - 1 LEN(OPTION),J0,'QUIT')) THEN - OPTION='QUIT' !ASSUME END - ELSE IF (J0.LE.0) THEN - OPTION='QUIT' !ASSUME END - END IF - IF (OPT.EQ.'QUI') GOTO 900 - -C****************************************************************************** -C COPY OR SIMULOATE DATA: SELECT IN- AND OUTPUTS -C****************************************************************************** -C Open input SCN file -C - IF (OPT.EQ.'COP' .OR. OPT.EQ.'SHO') THEN - 110 CONTINUE - IF (.NOT.WNDNOD('INPUT_SCN_NODE',NODIN, - 1 'SCN','R',NODIN,IFILE)) THEN - IF (E_C.EQ.DWC_ENDOFLOOP) GOTO 100 !RETRY OUTPUT - GOTO 110 !REPEAT - ELSE IF (E_C.EQ.DWC_NULLVALUE) THEN - GOTO 100 !RETRY OUTPUT - ELSE IF (E_C.EQ.DWC_WILDCARD) THEN - GOTO 110 !MUST SPECIFY - END IF - IF (.NOT.WNFOP(FCAIN,IFILE,'R')) !OPEN INPUT SCAN FILE - 1 GOTO 110 !RETRY -C -C Open output SCN file -C - 120 CONTINUE - CALL WNFCL(FCAOUT) - IF (.NOT.WNDNOD('OUTPUT_SCN_NODE',NODOUT,'SCN', - 1 'U',NODOUT,FILOUT)) THEN - IF (E_C.EQ.DWC_ENDOFLOOP) GOTO 110 - GOTO 120 !error - ELSE IF (E_C.EQ.DWC_NULLVALUE) THEN - GOTO 110 - ELSE IF (E_C.EQ.DWC_WILDCARD) THEN - GOTO 120 !MUST SPECIFY - END IF - IF (.NOT.WNFOP(FCAOUT,FILOUT,'U')) !OPEN OUTPUT SCAN FILE - 1 GOTO 120 !RETRY -C -C Open SCN file for update -C - ELSEIF (OPT.EQ.'REV') THEN - 125 CONTINUE - IF (.NOT.WNDNOD('SCN_NODE',NODOUT,'SCN', - 1 'R',NODOUT,FILOUT)) THEN - IF (E_C.EQ.DWC_ENDOFLOOP) GOTO 100 !RETRY OPTION - GOTO 125 !REPEAT - ELSE IF (E_C.EQ.DWC_NULLVALUE) THEN - GOTO 100 !RETRY OPTION - ELSE IF (E_C.EQ.DWC_WILDCARD) THEN - GOTO 125 !MUST SPECIFY - END IF - IF (.NOT.WNFOP(FCAOUT,FILOUT,'U')) !OPEN OUTPUT SCAN FILE - 1 GOTO 125 !RETRY - ENDIF! copy, simulate or reverse -C -C Sectors specification -C - 130 CONTINUE - IF (OPT.NE.'OVE') THEN - IF (.NOT.WNDSTA('SCN_SETS',MXNSCT,INSCTS,FCAIN)) - 1 GOTO 120 - IF (INSCTS(0,0).EQ.0) GOTO 120 !NO SCTS SPECIFIED -C - 131 CONTINUE -CC IF (.NOT.WNDSTQ('OUTPUT_SECTORS',1,OUTSCTS,0)) -CC 1 GOTO 120 !GET SCTS TO MAKE -CC IF (OUTSCTS(0,0).EQ.0) GOTO 120 !NONE - ENDIF -C -C Hour angle specification -C - IF (OPT.EQ.'COP' .OR. OPT.EQ.'SHO') THEN - 140 CONTINUE - IF (.NOT.NSCHAS(1,HARAN)) GOTO 130 - IF (OPT.EQ.'SHO') THEN - IF (.NOT.WNDPAR('SCANS',SCANS,2*LB_J,J0)) GOTO 130 - ELSE - SCANS(0)=0 - SCANS(1)=65536 - ENDIF - IF (.NOT.NSCIFS(1,SIFRS)) GOTO 130 -C -C Polarisation specification -C - 150 CONTINUE - IF (.NOT.WNDPAR('POLARISATION',POLC,LEN(POLC),J0)) THEN - IF (E_C.EQ.DWC_ENDOFLOOP) GOTO 140 - GOTO 150 ! error - ENDIF - IF (J0.EQ.0) GOTO 140 ! RETRY HA range - IF (J0.LT.0) POLC='XYX' ! ALL - IF (POLC.EQ.'XYX') THEN ! SET CODE - ONPOL=4 - ELSEIF (POLC.EQ.'XY') THEN ! XX,YY - ONPOL=2 - ELSEIF (POLC.EQ.'YX') THEN ! copy XY,YX to XX,YY - ONPOL=-2 - ELSE ! XX only - ONPOL=1 - ENDIF -C -C Copy model and/or IF data? -C - DO_MDL=.TRUE. !COPY MODEL - DO_IFH=.TRUE. !COPY IFH -C - IF (.NOT.WNDPAR('COPY_MODEL',BB1,LB_L,J0,'YES')) THEN - IF (E_C.EQ.DWC_ENDOFLOOP) GOTO 150 !RETRY - GOTO 100 !RETRY OPTION - END IF - IF (.NOT.BB1) DO_MDL=.FALSE. !DO NOT COPY -C - IF (.NOT.WNDPAR('COPY_IFDATA',BB1,LB_L,J0,'YES')) THEN - IF (E_C.EQ.DWC_ENDOFLOOP) GOTO 150 !RETRY - GOTO 100 !RETRY OPTION - END IF - IF (.NOT.BB1) DO_IFH=.FALSE. !DO NOT COPY -C - CALL WNCTXT(F_T, - 1'!/NOTES: - 1 !/!4C\The corrections that you specify below will be applied resp. - 1 !/!4C\de-applied to the visibilities that will be written to the - 1 !/!4C\output file. This modification of the visibilities is - 1 !/!4C\IRREVERSIBLE, so the only path back to the uncorrected data - 1 !/!4C\will be via the input file. - 1 !/!4C\The corresponding correction parameters must be set to zero, - 1 !/!4C\lest they be applied for a second time later. This is not - 1 !/!4C\implemented yet, so you must "manually" zero them using - 1 !/!4C\NCALIB.!/ - 1 !/ - 1 !/!4C\Multiplicative and additive interferometer corrections are - 1 !/!4C\currently NOT copied!! Use NCALIB SET ICOPY instead.!!') -C - IF (.NOT.WNDPAP('X_APPLY',' NONE /ASK')) CALL WNGEX! force prompting - IF (.NOT.WNDPAP('X_DE_APPLY',' NONE /ASK')) CALL WNGEX - IF (.NOT.WNDDA1('X_APPLY',CAP)) CALL WNGEX ! get APPLY bits - IF (.NOT.WNDDA2('X_DE_APPLY',CDAP)) CALL WNGEX! get DE_APPLY bits -C - ENDIF! copy -C - 900 CONTINUE - RETURN !READY -C -C - END diff --git a/src/ncopy/ncoini.for b/src/ncopy/ncoini.for deleted file mode 100644 index 77315888274a21d322e45169fe8100eeb43badd7..0000000000000000000000000000000000000000 --- a/src/ncopy/ncoini.for +++ /dev/null @@ -1,55 +0,0 @@ -c+ NCOINI.FOR -C JPH 930317 -C -C Revisions: -C JPH 930825 WNDDAB --> WNDDA0 -C AXC 010709 Linux ports - TABS -C - SUBROUTINE NCOINI -C -C Initialize NCOPY program -C -C Result: -C -C CALL NCOINI will set header lines, logging, DWARF interface -C -C Include files: -C - INCLUDE 'WNG_DEF' - INCLUDE 'NSC_DEF' -C -C Parameters: -C -C -C Arguments: -C -C -C Function references: -C - LOGICAL WNDINI !INIT DWARF - LOGICAL WNDDA0 !OPEN DATABASE -C -C Data declarations: -C -C- -C -C SET HEADER LINES -C - CALL WNCFHD(F_P,1,'!40C\NCOPY: Program to copy SCN files') -C -C START DWARF -C - IF (.NOT.WNDINI(PRGNAM)) CALL WNGEX !EXIT IF NO DWARF START -C -C LOGGING -C - CALL WNDLOG(LOGCD) !PROPER LOGGING -C -C DATABASE -C - IF (.NOT.WNDDA0()) CALL WNGEX !OPEN DATABASE -C - RETURN !READY -C -C - END diff --git a/src/ncopy/ncoovv.for b/src/ncopy/ncoovv.for deleted file mode 100644 index 2c2149d6138acc158b3f3d0fc505b3825828ca60..0000000000000000000000000000000000000000 --- a/src/ncopy/ncoovv.for +++ /dev/null @@ -1,173 +0,0 @@ -C+ NCOOVV.FOR -C JPH 930519 -C -C Revisions: -C JPH 931006 Fieldwidth 6 --> 7 for VOLGNR printout -C JPH 931007 NSCSTH --> NSCSTG -C JPH 941006 NSC_DEF --> NCO_DEF -C AXC 010709 Linux Port - TABS -C - SUBROUTINE NCOOVV -C -C Print overview of sectors in SCN file -C -C Result: -C -C CALL NCOOVV -C -C Include files: -C - INCLUDE 'WNG_DEF' - INCLUDE 'NCO_DEF' - INCLUDE 'GFH_O_DEF' !GENERAL FILE HEADER - INCLUDE 'SGH_O_DEF' !SUB-GROUP HEADER - INCLUDE 'STH_O_DEF' !SET HEADER - INCLUDE 'SCH_O_DEF' !SCAN HEADER -C -C Parameters: - INTEGER PWIDTH, TWIDTH !width of ASCII output lines - PARAMETER (PWIDTH=131, TWIDTH=78) - !allow for WNCTXT's 1-wide left margin -C -C -C Arguments: -C -C -C Function references: -C - LOGICAL WNDNOD - LOGICAL WNFOP - LOGICAL WNFRD !READ DATA - LOGICAL WNFWR !WRITE DATA - INTEGER WNFEOF !GET FILE POINTER - CHARACTER*32 WNTTSG !PRINT SET NAME - LOGICAL NSCSTG !GET A SET WITH VERSION CHECK - LOGICAL NSCSCH !READ SCAN HEADER - LOGICAL NSCSCW !WRITE SCAN HEADER -C -C Data declarations: -C - INTEGER SET(0:7,0:1) !ALL SETS - INTEGER STHP !SET HEADER POINTER - INTEGER SNAM(0:7) !SET NAME - INTEGER PSNAM(0:7) !previous sector name - BYTE STH(0:STHHDL-1) !SET HEADER - INTEGER*2 STHI(0:STHHDL/2-1) - INTEGER STHJ(0:STHHDL/4-1) - REAL STHE(0:STHHDL/4-1) - DOUBLE PRECISION STHD(0:STHHDL/8-1) - EQUIVALENCE (STH,STHI,STHJ,STHE,STHD) - CHARACTER*19 CSNAM !ASCII sector name - REAL HAE !end HA -C- -C -C***************************************************************************** -C GET NODE -C - 100 CONTINUE - IF (.NOT.WNDNOD('INPUT_SCN_NODE',' ', - 1 'SCN','R',NODIN,IFILE)) THEN !NODE -C******* - IF (E_C.EQ.DWC_ENDOFLOOP) RETURN !READY WITH SHOW - CALL WNCTXT(F_TP,'Node does not exist') - GOTO 100 - ELSE IF (E_C.EQ.DWC_NULLVALUE) THEN - RETURN !END - ELSE IF (E_C.EQ.DWC_WILDCARD) THEN - GOTO 100 !MUST SPECIFY - END IF - IF (.NOT.WNFOP(FCAIN,IFILE,'R')) THEN !OPEN SCN FILE - CALL WNCTXT(F_TP,'Cannot open file attached to node') - GOTO 100 - END IF - CALL NSCPFH(F_TP,FCAIN) !PRINT FILE HEADER -C -C INIT -C - DO I=0,7 - PSNAM(I)=-1 - DO I1=0,1 - SET(I,I1)=0 - END DO - END DO - SET(0,0)=1 !1 LINE - DO I=0,7 - SET(I,1)=-1 !* - END DO -C -C Output header -C - CALL WNCFSV(F_P,F_LL,PWIDTH) !set record length - CALL WNCFSV(F_T,F_LL,TWIDTH) - CALL WNCTXT (F_TP, 'Size !UJ bytes !/', - 1 WNFEOF(FCAIN)) !report file size - CALL WNCTXT (F_TP, !print heading - 1 '!-19$AS !3$AS'// !SNAM, SETN - 1 ' !-7$AS'// !field - 1 ' !-7$AS'// !volgnr - 1 ' !-7$AS !-7$AS'// !FREQ, BAND - 1 ' !-5$AS !-5$AS'// !HAB, HAE - 1 ' !-4$AS'// !SCN - 1 ' !-4$AS'// !NIFR,PLN - 1 ' !-8$AS'// !MDL - 1 ' !-30AS'// - 1 '!/', - 1 'Sector','(#)', - 1 'Field', - 1 'Volgnr', - 1 'FREQ', 'BAND', - 1 'HAB','HAE', - 1 'SCNS', - 1 'IF P', - 1 'MDL', - 1 'STHP FDP OHP SHP' ) -C -C Loop over all sectors -C - DO WHILE (NSCSTG(FCAIN,SET,STH,STHP,SNAM))!all sets - CSNAM=WNTTSG(SNAM,3) !get "." set name - DO I=0,7 - IF (SNAM(I).NE.PSNAM(I)) GOTO 10 !compare against previous - ENDDO - 10 CONTINUE - IF (I.GT.0) CSNAM(1:4*I)=' ' !blank out components that have -C ! not changed - DO I=0,7 - PSNAM(I)=SNAM(I) - ENDDO - HAE= STHE(STH_HAB_E) + (STHJ(STH_SCN_J)-1)*STHE(STH_HAI_E) - CALL WNCTXT (F_TP, - 1 '!19$AS !3$UJ3'// !SNAM, SETN - 1 ' !-7$AD'// !field - 1 ' !7$UJ7'// !volgnr - 1 ' !7$D7.2 !7$E7.3'// !FREQ, BAND - 1 ' !5$EAF5.1 !5$EAF5.1'// !HAB, HAE - 1 ' !4$UJ4'// !SCN - 1 ' !2$UJ2 !1$UI1'// !NIFR,PLN - 1 ' !8$XJ8'// !MDL - 1 ' !8$XJ8 !8$XJ8 !8$XJ8 !8$XJ8', !STHP,FDP,OHP,SHP - 1 CSNAM,STHJ(STH_SETN_J), - 1 STH(STH_FIELD_1),STH_FIELD_N, - 1 STHJ(STH_VNR_J), - 1 STHD(STH_FRQ_D),STHE(STH_BAND_E), - 1 STHE(STH_HAB_E),HAE, - 1 STHJ(STH_SCN_J), - 1 STHJ(STH_NIFR_J),STHI(STH_PLN_I), - 1 STHJ(STH_MDL_J), - 1 STHP,STHJ(STH_FDP_J),STHJ(STH_OHP_J),STHJ(STH_SHP_J) ) - END DO -C -C READY -C - 800 CALL WNCTXT (F_TP, '!/!/!/') - CALL WNFCL(FCAIN) !CLOSE FILE -C - RETURN -C -C ERROR -C - 900 CONTINUE - GOTO 800 -C -C - END diff --git a/src/ncopy/ncopy.for b/src/ncopy/ncopy.for deleted file mode 100644 index 9856efaf9b99004645768206330430ed0e28b36c..0000000000000000000000000000000000000000 --- a/src/ncopy/ncopy.for +++ /dev/null @@ -1,58 +0,0 @@ -C+ NCOPY.FOR -C JPH 930316 -C -C Revisions: -C JPH 931018 SIM, REV options -C JPH 9411.. Remove SIM, REV -C CMV 960122 Warning if /NORUN ignored -C JPH 961213 SHORTCOPY option -C AXC 010709 Linux port - TABS -C - SUBROUTINE NCOPY -C -C Main routine to copy Scan files -C -C Result: -C -C -C Include files: -C - INCLUDE 'WNG_DEF' - INCLUDE 'NCO_DEF' -C -C Parameters: -C -C -C Arguments: -C -C -C Function references: -C - LOGICAL WNDRUN !TEST RUN -C -C Data declarations: -C -C- -C -C PRELIMINARIES -C - CALL NCOINI !INIT PROGRAM - IF (.NOT.WNDRUN()) - 1 CALL WNCTXT(F_TP,'Ignored option /NORUN') -C -C DISTRIBUTE -C - 10 CONTINUE - CALL NCODAT !GET USER DATA - IF (OPT.EQ.'QUI') THEN - CALL WNGEX !READY - ELSEIF (OPT.EQ.'COP' .OR. OPT.EQ.'SHO') THEN - CALL NCOCPY - ELSEIF (OPT.EQ.'OVE') THEN - CALL NCOOVV - END IF - GOTO 10 -C -C -C - END diff --git a/src/ncopy/ncopy.psc b/src/ncopy/ncopy.psc deleted file mode 100644 index 7464ea0698e3e328fce9abc962ef2485e44fc5d0..0000000000000000000000000000000000000000 --- a/src/ncopy/ncopy.psc +++ /dev/null @@ -1,134 +0,0 @@ -!+ NCOPY.PSC -! JPH 930316 -! -! Revisions: -! JPH 931012 Add SIMULATE option -! JPH 931102 Add KEEP_MODEL. - Clone i.s.o. inherit POLARISATION -! CMV 940518 Add COPY_MODEL and COPY_IFDATA -! JPH 940913 Correct OUTPUT_SECTORS prompt -! Remove () from prompts -! JPH 941005 Reorganise .pef files. -! Add X_ NGEN parameters and APPLY/DE_APPLY, MODELB -! JPH 960220 SELECT_IFRS -! JPH 960725 Add YX polarisation mode -! -! Get overall action -! Ref: NCODAT -! -KEYWORD=OPTION - DATA_TYP=C - IO=I - LENGTH=12 - NVALUES=1 - CHECKS=ABBREV_OPTIONS - SWITCHES=LOOP,NULL_VALUES - SEARCH=L,P - OPTIONS=COPY,SHORTCOPY, OVERVIEW,QUIT - HELP=" -Actions: -. - COPY Copy sectors from one SCN file to another. - SHORTCOPY As copy, but only scans selected by scan number; this option - allows you to cut out the invalid trailing scan from a mosaic - sector -. - OVERWIEW Display and log an overview of all sectors in a SCN file - QUIT Exit from NCOPY " -! -! -! input and output nodes -! -INCLUDE=SCNNODE_PEF -! -! sector selection -! -INCLUDE=SCNSETS_PEF:SCN_SETS,OVERVIEW ! -INCLUDE=SCNSETS_PEF:SCN_GROUPS,SCN_OBSS,SCN_FIELDS,SCN_CHANNELS,SCN_SECTORS -! -! -! Until further notice, user can not control output sector numbering. The -! following entry is just a placeholder. -!!KEYWORD=OUTPUT_SECTORS -!! DATA_TYP=C -!! IO=I -!! LENGTH=32 -!! NVALUES=1 -!! DEFAULT=*/NOASK -!! SWITCHES=LOOP,NULL_VALUES,WILD_CARDS -! SEARCH=L,P -!! PROMPT="new index pattern (grp.obs.fld.chn.seq)" -!! HELP=" -!!Do not override the default value" -! -! -INCLUDE=SELECT_PEF:HA_RANGE,SELECT_IFRS -! -! -KEYWORD=SCANS - DATA_TYP=J - IO=I - NVALUES=2 - SEARCH=L,P - PROMPT="First and last scan number from each sector" - DEFAULTS= 0,10000 - HELP=" -From all sectors selected, only the scan numbers within the selected scan -number and HA ranges wiull be copied. E.g., the specification -. - SCANS= 0,4 -. -will remove the last scan (number 5) from allo sectors of a mosaic observation -that produces 6-scan sectors. -. -Remember that the first scan in a sector is numbered 0. " -! -! -KEYWORD=POLARISATION - DATA_TYP=C - LENGTH=4 - IO=I - CHECKS=ABBREV_OPTIONS - SWITCHES=LOOP,NULL_VALUES - SEARCH=L,P - OPTIONS=XYX,XY,X; [YX] - DEFAULT=XYX - PROMPT="Select polarisations" - HELP=" -Select polarisations to be copied: - XYX: XX, XY, YX, YY - XY: XX, YY only - X: XX only -. - YX: for special applications only: - overwrite XX with XY, YY with YX, then output as if XY " -! -! -! Specify model needs to be copied -! Ref: NCODAT -! -KEYWORD=COPY_MODEL - DATA_TYP=L - IO=I - SWITCH=NULL_VALUES,WILD_CARDS - SEARCH=L,P - PROMPT="copy model data?" - HELP=" Specify YES if you want to copy the model together with the data" -! -! Specify details wanted -! Ref: NCADAT -! -KEYWORD=COPY_IFDATA - DATA_TYP=L - IO=I - SWITCH=NULL_VALUES,WILD_CARDS - SEARCH=L,P - PROMPT="copy IF-data/Total Powers?" - HELP=" Specify YES if you want to copy IF-data (Total Powers) together -with the data" -! -! -! NGEN except FLAG parameters -! -INCLUDE=NGEN_PEF:X_LOG,LOG,X_RUN,RUN,X_INFIX,INFIX,X_DATAB,DATAB ! -INCLUDE=NGEN_PEF:X_MEMORY,MEMORY ! -INCLUDE=NGEN_PEF:X_APPLY,APPLY,X_DE_APPLY,DE_APPLY,X_MODELB,MODELB diff --git a/src/nmap/mdlnode.pef b/src/nmap/mdlnode.pef deleted file mode 100644 index 56297daa8aa5c6ae3f6a6ea3f28f5cb7546223ee..0000000000000000000000000000000000000000 --- a/src/nmap/mdlnode.pef +++ /dev/null @@ -1,54 +0,0 @@ -!+MDLNODE.PEF: MDL_NODE keywords -! JPH 941005 Split from NCOMM.PEF -! JPH 951023 .WMP --> .MDL -! -! Revisions: -! -! -! Get input/output MDL node -! Ref: -! -KEYWORD=MDL_NODE - DATA_TYP=C - IO=I - LENGTH=80 - SWITCHES=LOOP,NULL_VALUES,WILD_CARDS - SEARCH=L,P - PROMPT="input/output .MDL file name" - HELP=" Specify the .MDL file name. -. -Enter ** (or e.g. /user0/mydata/**) to get a list of .MDL files in your current -(or the indicated) directory; then enter #<n> to select the <n>th file from -such a list." -! -! Get input MDL node -! Ref: -! -KEYWORD=INPUT_MDL_NODE - DATA_TYP=C - IO=I - LENGTH=80 - SWITCHES=LOOP,NULL_VALUES,WILD_CARDS - SEARCH=L,P - PROMPT="input .MDL file name" - HELP=" Specify the input .MDL filee name. -. -Enter ** (or e.g. /user0/mydata/**) to get a list of .MDL files in your current -(or the indicated) directory; then enter #<n> to select the <n>th file from -such a list." -! -! Get output MDL node -! Ref: -! -KEYWORD=OUTPUT_MDL_NODE - DATA_TYP=C - IO=I - LENGTH=80 - SWITCHES=LOOP,NULL_VALUES,WILD_CARDS - SEARCH=L,P - PROMPT="output .MDL file name" - HELP=" Specify the output .MDL file name. -. -Enter ** (or e.g. /user0/mydata/**) to get a list of .MDL files in your current -(or the indicated) directory; then enter #<n> to select the <n>th file from -such a list." diff --git a/src/nmap/mph.dsc b/src/nmap/mph.dsc deleted file mode 100644 index f1d42fe4ff5271c1d725b121ce8e1d16c956b525..0000000000000000000000000000000000000000 --- a/src/nmap/mph.dsc +++ /dev/null @@ -1,111 +0,0 @@ -!+ MPH.DSC -! WNB 910219 -! -! Revisions: -! -%REVISION=CMV=940517="Add JOBP (pointer to job-summary)" -%REVISION=WNB=931216="Add some edit formats" -%REVISION=WNB=931015="Use SSH" -%REVISION=WNB=930803="Text only" -%REVISION=WNB=920828="Add VELC, VELR, FRQ0, FRQV, FRQC, INST" -%REVISION=WNB=920818="Add VEL" -%REVISION=WNB=910219="Original version" -! -! Define Map Header block -! -%COMMENT="MPH.DSC defines the map header block" -%COMMENT=" " -! -%VERSION=1 !VERSION -%SYSTEM=1 -%USER=WNB -%%DATE -%%NAME -!- -.PARAMETER -.BEGIN=MPH -%INCLUDE=SSH_DSF !STANDARD AREA - FNM C12 !FIELD NAME - EPO E <E12.1> !EPOCH (E.G. 1950.0) - RA D <DAF12.7> !RIGHT ASCENSION (CIRCLES) - DEC D <DAF12.7> !DECLINATION (CIRCLES) - FRQ D <D12.6> !FREQUENCY (MHZ) - BDW D <D12.6> !BANDWIDTH (MHZ) - RAO D <DAF12.7> !OBSERVED RIGHT ASCENSION (CIR) - DECO D <DAF12.7> !OBSERVED DECL. (CIRCLES) - FRQO D <D12.6> !OBSERVED FREQ. (MHZ) - ODY I !OBSERVED DAY SINCE JAN 0 - OYR I !OBSERVED YEAR OR 0 (E.G. 1985) - DCD I !DATA CODE: - ! 2= I - ! 4= J - ! 5= E - ! 8= D - PCD I !PROGRAM CODE: 0= NMAP - SRA D <DAF12.7,1> !SEPARATION IN RA (CIRCLES) - SDEC D <DAF12.7,1> !SEPARATION DEC (CIRCLES) - SFRQ D <D12.6> !SEPARATION FREQ. (MHZ) - NRA J <,1> !# OF POINTS IN RA - NDEC J <,1> !# OF POINTS IN DEC - NFRQ J <,1> !# OF POINTS IN FREQ. - ZRA J !CENTRE RA (1ST POINT=0) - ZDEC J !CENTRE DEC (1ST LINE=0) - ZFRQ J !CENTRE FREQUENCY (1ST MAP=0) - MXR J !POSITION MAX. IN RA - MXD J !POSITION MAX. IN DEC - MXF J !POSITION MAX. IN FREQUENCY - MNR J !POS. MIN. RA - MND J !POS. MIN. DEC - MNF J !POS. MIN. FREQ. - MAX E <E12.3> !MAX. IN MAPS - MIN E <E12.3> !MIN. IN MAPS - SHR D <DAF12.7> !SHIFT IN RA (ADD, CIRCLES) - SHD D <DAF12.7> !SHIFT IN DEC (ADD, CIRCLES) - SHF D <D12.6> !SHIFT IN FREQ. (ADD, MHZ) - SUM D <D12.6> !NORMALISING SUM - UNI E <E12.1> !MULTIPLIER TO GET JY - UCM C24 !USER COMMENT - NPT J !# OF INPUT DATA POINTS - TYP C4 !MAP TYPE (MAP, AP, COV ETC) - POL C2 !POL. TYPE (OR SO) - CD I(0:7) ! 0: TAPER TYPE - ! 1: CONVOLUTION TYPE - ! 2: CORRECT FOR CONVOLUTION - ! 3: CLIPPING DONE - ! 4: SOURCE SUBTRACTION - ! 5: DATA TYPE - ! 6: UV COORDINATE TYPE - ! 7: DE-BEAM COUNT - EPT I !MAP EPOCH USED: - ! 0: APPARENT - ! 1: AS SPECIFIED IN EPOCH - OEP E <E12.2> !OBSERVATION EPOCH (EG 1985.78) - NOS E <E12.3> !MAP NOISE (W.U.) - FRA E <EAF12.4> !FIELD SIZE RA (CIRCLES) - FDEC E <EAF12.4> !FIELD SIZE DEC (CIRCLES) - FFRQ E <E12.3> !FIELD SIZE FREQ (MHZ) - TEL C8 !NAME OF TELESCOPE - FSR J !FFT SIZE RA - FSD J !FFT SIZE DEC - MDP J <XJ,1> !MAP DATA POINTER - NBL J !# OF BASELINES IN MAP - NST J !# OF SETS IN MAP - VEL E <E12.1> !VELOCITY IN M/S - VELC J !VELOCITY CODE: - ! 0= CONTINUUM - ! 1= HELIOCENTRIC RADIO - ! 2= LSR RADIO - ! 3= HELIOCENTRIC OPTICAL - ! 4= LSR OPTICAL - VELR E <E12.4> !VELOCITY AT REF. FREQ. (FRQC) - INST J !INSTRUMENT: - ! 0= WSRT - ! 1= ATCA - FRQ0 D <D12.6> !REST FREQUENCY FOR LINE (MHZ) - FRQV D <D12.6> !REAL FREQUENCY FOR LINE (MHZ) - FRQC D <D12.6> !CENTRE FREQUENCY FOR LINE (MHZ) - JOBP J <XJ,1> !POINTER TO JOB SUMMARY LOG - JOBL J <XJ,1> !LENGTH (IN BYTES) OF LOG - - -(152) !RESERVED -.END -!- diff --git a/src/nmap/ncl.dsc b/src/nmap/ncl.dsc deleted file mode 100644 index 294835c4498462b00246bf15cd85745c8036a1c7..0000000000000000000000000000000000000000 --- a/src/nmap/ncl.dsc +++ /dev/null @@ -1,94 +0,0 @@ -!+ NCL.DSC -! WNB 910809 -! -! Revisions: -! -%REVISION=HjV=950512="Add DATAFAC" -%REVISION=WNB=930803="Remove .INCLUDE" -%REVISION=WNB=921216="Add GRFAC" -%REVISION=WNB=910809="Original version" -! JPH 940223 Comments -! -! Layout of overall include file (NCL.DEF) -! -%COMMENT="NCL.DEF is an INCLUDE file for the NCLEAN program" -%COMMENT=" " -! -%VERSION=1 -%SYSTEM=1 -%USER=WNB -%%DATE -%%NAME -%LOCAL=MXNSET=16 !MAX. # OF SET DEFINITIONS -%LOCAL=MXNAR=32 !MAX. # OF SUB-AREAS -!- -.DEFINE - .PARAMETER - MXNSET J /MXNSET/ !MAX. # OF MAP SETS - MXNAR J /MXNAR/ !MAX. # OF AREAS - MNBPAT J /3/ !MIN. BEAM PATCH SIZE - MXBPAT J /128/ !MAX. BEAM PATCH SIZE - .DATA -! -! Local variables: -! - .COMMON - OPTION C24 !PROGRAM OPTION - OPT=OPTION C3 - MEMSIZ J !SIZE OF DYNAMIC MEMORY TO USE - NODMAP C80 !MAP NODE - FILMAP C160 !MAP FILE - FCAMAP J !MAP FCA - MSETS J(0:7,0:MXNSET) !MAP SETS - NODAP C80 !AP NODE - FILAP C160 !AP FILE - FCAAP J !AP FCA - ASETS J(0:7,0:MXNSET) !AP SETS - APDCV L !APPLY DECONVOLUTION -! - CMPLOG J(2) !LOG CODE COMPON_LOG: -! Each CMPLOG(1)th component will be reported on terminal. -! Each CMPLOG(2)th component will be reported in log file. -! - CLLIM E !CLEAN LIMIT - CLFAC E !CLEAN LOOP FACTOR - SRCLIM J !# OF SOURCES LIMIT -! - TAREA J(0:3,0:1) !TOTAL AREA - PAREA J(0:3,MXNAR,0:1) !PARTIAL AREAS - NAREA J !NUMBER OF AREAS -! Area format: 0,0 hor. centre 0,1 left edge -! 1,0 vert. centre 1,1 right edge -! 2,0 hor. width 2,1 bottom edge -! 3,0 vert. width 3,1 top edge -! - PRHAT E !PRUSSIAN HAT VALUE - RESMDL L !OUTPUT RESIDUAL MODEL SWITCH - RSTMDL L !RESTORED OUTPUT SWITCH - RONMDL L !ONLY RESTORE SWITCH - MPDEP E !CYCLE DEPTH - GRFAC E !GRATING FACTOR - DATAFAC E !DATACLEAN FACTOR -! -! History -! - CURMAX E !CURRENT MAP MAX. - CURMXP J(2) !POS. CURRENT MAX. - MAPNAM J(0:7) !CURRENT MAP NAME - APNAM J(0:7) !CURRENT AP NAME - BEMPAT J !SIZE BEAM PATCH - MAPPAT J !# OF POINTS IN MAP PATCH - MAPLIM E !MAP DATA LIMIT IN PATCH - CLBXLM E !MAX. CORRECTION OUTSIDE PATCH - CURPMX J !CURRENT MAX. POINTER - MINLIM E !MAP INPUT MAXIMUM - CVBFU J !U CONVOLUTION FUNCTION ptr - CVBFV J !V CONVOLUTION FUNCTION ptr - RESDL E !RESTORE BEAM L - RESDM E !RESTORE BEAM M - RESDAN E !RESTORE BEAM SKEW ANGLE - MPHAD J !MAP HISTOGRAM AREA ptr - BMHAD J !BEAM HISTOGRAM AREA ptr - MPHMXI E !MAX. IN MAP HISTOGRAM -! -.END diff --git a/src/nmap/ncl.grp b/src/nmap/ncl.grp deleted file mode 100644 index 366b80ea964b05f3fc1a3382c66513b2e0b8e8f7..0000000000000000000000000000000000000000 --- a/src/nmap/ncl.grp +++ /dev/null @@ -1,66 +0,0 @@ -!+ NCL.GRP -! WNB 910809 -! -! Revisions: -! WNB 920117 Add CMP -! WNB 921202 Add CDT -! WNB 921211 Add PSC -! -! Map cleaning -! -! Group definition: -! -NCL.GRP -! -! PIN files -! -NCLEAN.PSC -! -! Structure files -! -! -! Fortran definition files: -! -NCL.DSC ! Program common/parameters -! NCL.DEF ! Fortran include -! NCL.INC ! C include -! -! Programs: -! -NCLEAN.FOR ! Main routine -NCLBCL.FOR !NCLBCL Clean for NCLBEA -NCLBEA.FOR !NCLBEA Normal Hogbom clean -NCLBRD.FOR !NCLBRD Read map and beam -NCLBWR.FOR !NCLBWR Write residual map -NCLCCL.FOR !NCLCCL Clean for NCLUV -NCLCDT.FOR !NCLCDT Data type clean -NCLCMP.FOR !NCLCMP Get component list -NCLCRD.FOR !NCLCRD Read beam and map patch -NCLCWR.FOR !NCLCWR Write initial residual map -NCLDAT.FOR !NCLDAT Program parameters -NCLFUN.FOR ! Some general functions - !NCLFD2 Divide buffer by 2 - !NCLFCJ Take conjugate of buffer - !NCLFAM Add 2 buffers with multiplication - !NCLFSM Subtract 2 buffers with multiplication - !NCLFS2 Subtract 2 buffers with double mult. - !NCLFBM Calculate transform of beam - !NCLF1D Take 1/buffer -NCLHIM.FOR !NCLHM0 Determine map histogram - !NCLHM9 Clear map histogram - !NCLHB0 Determine beam histogram - !NCLHB9 Clear beam histogram -NCLHIS.FOR !NCLHIS Determine map and beam histogram - !NCLHID Determine histos and beam patch to use - !NCLHIE Determine beam patch to use - !NCLHIX Clear beam histogram -NCLINI.FOR !NCLINI Initialise program -NCLUCL.FOR !NCLUCL Clean major cycle -NCLUC1.FOR !NCLUC1 Clean a map line -NCLUV.FOR !NCLUV UV cover clean -NCLUVT.FOR !NCLUVT Transform beam to UV cover -! -! Executables -! -NCLEAN.EXE ! Clean/restore maps -!- diff --git a/src/nmap/nclbcl.for b/src/nmap/nclbcl.for deleted file mode 100644 index 696e875ae93af4404cd6aac886a205d1600a9b37..0000000000000000000000000000000000000000 --- a/src/nmap/nclbcl.for +++ /dev/null @@ -1,109 +0,0 @@ -C+ NCLBCL.FOR -C WNB 910809 -C -C Revisions: -C WNB 931006 Text -C - SUBROUTINE NCLBCL(CLAR3,CLAR4,BEM,MAP,MPHD,MDHJ) -C -C Get a clean component -C -C Result: -C CALL NCLBCL( CLAR3_J:I, CLAR4_J:I, -C BEM_E(-*:*,0:*):I, MAP_E(-*:*,-*:*):IO, -C MPHD_D(0:*), MDHJ_J(0:*):IO) -C Do clean of one component, using BEaM and MAP. -C CLAR3 and CLAR4 are the map boundaries. -C MPHD and MDHJ are the map and model headers. -C -C -C Include files: -C - INCLUDE 'WNG_DEF' - INCLUDE 'MPH_O_DEF' !MAP HEADER - INCLUDE 'MDH_O_DEF' !MODEL HEADER - INCLUDE 'MDL_O_DEF' !MODEL LINE - INCLUDE 'NCL_DEF' -C -C Parameters: -C -C -C Arguments: -C - INTEGER CLAR3,CLAR4 !ARRAY BOUNDARIES - REAL BEM(-CLAR3:CLAR3,0:CLAR4) !BEAM - REAL MAP(-CLAR3/2:CLAR3/2,-CLAR4/2:CLAR4/2) !MAP - DOUBLE PRECISION MPHD(0:MPHHDL/8-1) !MAP HEADER - INTEGER MDHJ(0:MDHHDL/4-1) !MODEL HEADER -C -C Function references: -C -C -C Data declarations: -C - INTEGER JC !CLEAN AREA CNT - INTEGER RG(0:1) !SOURCE RANGE - BYTE MDL(0:MDLHDL-1) !MODEL LINE - INTEGER MDLJ(0:MDLHDL/4-1) - REAL MDLE(0:MDLHDL/4-1) - EQUIVALENCE (MDL,MDLJ,MDLE) -C- - R0=CLFAC*MAP(CURMXP(1),CURMXP(2)) !NEW SRC - CALL WNGMVZ(MDLHDL,MDL) !EMPTY MODEL - MDLE(MDL_I_E)=R0 !AMPLITUDE - MDLE(MDL_L_E)=DPI2*(MPHD(MPH_SRA_D)* - 1 (CURMXP(1)+TAREA(0,0))+MPHD(MPH_SHR_D)) !L - MDLE(MDL_M_E)=DPI2*(MPHD(MPH_SDEC_D)* - 1 (CURMXP(2)+TAREA(1,0))+MPHD(MPH_SHD_D)) !M - MDLJ(MDL_ID_J)=3001+MDHJ(MDH_NSRC_J) !ID - MDL(MDL_TP_B)=MDLCLN_M !CLEAN COMPONENT - CALL WNGMV(MDLHDL,MDL,A_B(MDHJ(MDH_MODP_J)-A_OB+ - 1 MDHJ(MDH_NSRC_J)*MDLHDL)) !SAVE SOURCE - MDHJ(MDH_NSRC_J)=MDHJ(MDH_NSRC_J)+1 !COUNT SOURCE - I1=0 !PRINT CODE - IF (CMPLOG(1).NE.0) THEN - IF (MOD(MDHJ(MDH_NSRC_J)-1,CMPLOG(1)).EQ.0) I1=I1+F_T - END IF - IF (CMPLOG(2).NE.0) THEN - IF (MOD(MDHJ(MDH_NSRC_J)-1,CMPLOG(2)).EQ.0) I1=I1+F_P - END IF - IF (I1.NE.0) THEN - RG(0)=MDHJ(MDH_NSRC_J) !SOURCE RANGE - RG(1)=RG(0) - CALL NMOPRM(I1,RG,MDL) !PRINT SOURCE - END IF -C -C CLEAN -C - CURMAX=-1E20 !NEW MAX - I4=CURMXP(1) !SAVE OLD POS. - I5=CURMXP(2) - DO I=-TAREA(3,0)/2,TAREA(3,0)/2 !ALL LINES - J1=0 !START POINT - DO JC=1,NAREA !ALL AREAS - IF (I+TAREA(1,0).GE.PAREA(2,JC,1) .AND. - 1 I+TAREA(1,0).LE.PAREA(3,JC,1)) THEN !LINE OK - J1=MAX(J1,PAREA(0,JC,1)-TAREA(0,1)) !START POINT - DO I1=J1-TAREA(2,0)/2,PAREA(1,JC,1)-TAREA(0,0) !ALL POINTS - I3=I1-I4 !BEAM L OFFSET - I2=I-I5 !BEAM M OFFSET - IF (I2.LT.0) THEN !TAKE SYMMETRIC - I2=-I2 - I3=-I3 - END IF - MAP(I1,I)=MAP(I1,I)-R0*BEM(I3,I2) !CLEAN POINT - IF (CURMAX.LT.ABS(MAP(I1,I))) THEN !NEW MAX. - CURMAX=ABS(MAP(I1,I)) - CURMXP(1)=I1 - CURMXP(2)=I - END IF - J1=J1+1 !CNT POINT - END DO - END IF - END DO - END DO -C - RETURN -C -C - END diff --git a/src/nmap/nclbea.for b/src/nmap/nclbea.for deleted file mode 100644 index 826b514117c18ecf4e8083bb8a3a4edf5eb62eca..0000000000000000000000000000000000000000 --- a/src/nmap/nclbea.for +++ /dev/null @@ -1,125 +0,0 @@ -C+ NCLBEA.FOR -C WNB 910809 -C -C Revisions: -C WNB 920403 Typo in model epoch setting -C WNB 921202 Cater for J2000 -C WNB 930928 Add instrument -C CMV 931117 Corrected instrument: MPH_INST_J should be _1 -C - SUBROUTINE NCLBEA(MPH,APH) -C -C Clean for BEAM option -C -C Result: -C CALL NCLBEA( MPH_B(0:*):I, APH_B(0:*):I) -C Cleans a map according to BEAM option. -C MPH and APH are the map and antenna pattern -C headers. -C -C -C Include files: -C - INCLUDE 'WNG_DEF' - INCLUDE 'MPH_O_DEF' !MAP HEADER - INCLUDE 'MDH_O_DEF' !MODEL HEADER - INCLUDE 'NCL_DEF' -C -C Parameters: -C -C -C Arguments: -C - BYTE MPH(0:*) !MAP HEADER - BYTE APH(0:*) !AP HEADER -C -C Function references: -C - LOGICAL WNGGVA !GET MEMORY - INTEGER*2 WNGGI !GET I VALUE - REAL WNGGE !GET E VALUE - LOGICAL NMOSLG !GET SOURCE SPACE -C -C Data declarations: -C - INTEGER BEMADR,MPADR !BUFFER ADDRESSES - INTEGER RG(0:1) !SOURCE RANGE - DATA RG/1,10000000/ - INTEGER MDHJ(0:MDHHDL/4-1) !MODEL HEADER - REAL MDHE(0:MDHHDL/4-1) - DOUBLE PRECISION MDHD(0:MDHHDL/8-1) - EQUIVALENCE (MDHJ,MDHE,MDHD) -C- -C -C GET BUFFERS -C - J=TAREA(2,0) !# OF LINES - JS=WNGGVA(LB_E*(2*J+1)*(TAREA(3,0)+1),BEMADR) !BEAM AREA - IF (JS) JS=WNGGVA(LB_E*J*TAREA(3,0),MPADR) !MAP AREA - IF (.NOT.JS) THEN - CALL WNCTXT(F_TP,'Cannot obtain map/beam buffers') - CALL WNGEX !STOP - END IF -C -C READ DATA INTO BUFFERS -C - CALL NCLBRD(TAREA(2,0),TAREA(3,0), - 1 A_B(BEMADR-A_OB),A_B(MPADR-A_OB),MPH,APH) -C -C INIT SOURCE LIST -C - CALL NMOHMF(7,MDHJ) !GET HEADER 7 - CALL NMOHZD(MDHJ) !CLEAR SOURCES - CALL WNGMV(LB_D,MPH(MPH_RA_1),MDHD(MDH_RA_D)) !SET RA - CALL WNGMV(LB_D,MPH(MPH_DEC_1),MDHD(MDH_DEC_D)) !SET DEC - CALL WNGMV(LB_D,MPH(MPH_FRQ_1),MDHD(MDH_FRQ_D)) !SET FREQ. - IF (WNGGI(MPH(MPH_EPT_1)).EQ.1) THEN !1950/2000 - MDHJ(MDH_TYP_J)=2 - MDHE(MDH_EPOCH_E)=WNGGE(MPH(MPH_EPO_1)) - ELSE !APPARENT - MDHJ(MDH_TYP_J)=1 - MDHE(MDH_EPOCH_E)=0 - END IF - CALL WNGMV(LB_J,MPH(MPH_INST_1),MDHJ(MDH_BITS_J)) !SET INSTRUMENT - IF (.NOT.NMOSLG(SRCLIM,MDHJ)) THEN !GET AREA - CALL WNCTXT(F_TP,'No space for clean source list') - CALL WNGEX !STOP - END IF -C -C DO ACTUAL CLEAN -C - DO WHILE (CURMAX.GT.ABS(CLLIM*WNGGE(MPH(MPH_MAX_1))) .AND. - 1 MDHJ(MDH_NSRC_J).LT.SRCLIM) - CALL NCLBCL(TAREA(2,0),TAREA(3,0), - 1 A_B(BEMADR-A_OB),A_B(MPADR-A_OB),MPH,MDHJ) !CLEAN - END DO -C -C FINISH -C - CALL NMOHMT(MDHJ,7) !SET HEADER DATA - CALL NMORDM(7,-1) !ADD SOURCES TO GENERAL HEADER - CALL NMOAMG !MERGE COMPONENETS - CALL NMOPTT(F_TP,RG) !SHOW TOTAL FLUX - IF (FCAAP.EQ.0) THEN !NO MODEL FILE GIVEN - CALL NMODAX(J) !LET USER ACT - ELSE - CALL NMOWRI(FCAAP,-1) !WRITE SOURCE MODEL - END IF -C -C WRITE RESIDUAL -C - IF (RESMDL) THEN !RESIDUAL MAP WANTED - CALL NCLBWR(TAREA(2,0),TAREA(3,0),A_B(MPADR-A_OB),MPH) !WRITE RESID. - END IF -C -C CLEAR BUFFERS -C - J=2*TAREA(2,0)+1 - CALL WNGFVA(LB_E*J*(TAREA(3,0)/2+1),BEMADR) - J=TAREA(2,0) - CALL WNGFVA(LB_E*J*TAREA(3,0),MPADR) -C -C - RETURN -C - END diff --git a/src/nmap/nclbrd.for b/src/nmap/nclbrd.for deleted file mode 100644 index 11cb70ca910ba659969bcfceb7da1b9d558a9cee..0000000000000000000000000000000000000000 --- a/src/nmap/nclbrd.for +++ /dev/null @@ -1,96 +0,0 @@ -C+ NCLBRD.FOR -C WNB 910809 -C -C Revisions: -C - SUBROUTINE NCLBRD(CLAR3,CLAR4,BEM,MAP,MPHJ,APHJ) -C -C Read beam and map -C -C Result: -C CALL NCLBRD( CLAR3_J:I, CLAR4_J:I, -C BEM_E(-*:*,0:*):O, MAP_E(-*:*,-*:*):O, -C MPHJ_J(0:*):I, APHJ_J(0:*):I) -C Read beam and map into memory, using the map -C and antenna pattern headers, and the -C clean area borders. -C -C -C PIN references: -C -C -C Include files: -C - INCLUDE 'WNG_DEF' - INCLUDE 'MPH_O_DEF' !MAP HEADER - INCLUDE 'NCL_DEF' -C -C Parameters: -C -C -C Arguments: -C - INTEGER CLAR3,CLAR4 !ARRAY BOUNDARIES - REAL BEM(-CLAR3:CLAR3,0:CLAR4) !BEAM - REAL MAP(-CLAR3/2:CLAR3/2,-CLAR4/2:CLAR4/2) !MAP - INTEGER MPHJ(0:MPHHDL/4-1) !MAP HEADER - INTEGER APHJ(0:MPHHDL/4-1) !AP HEADER -C -C Function references: -C - LOGICAL WNFRD !READ DISK -C -C Data declarations: -C - INTEGER JC !MULTIPLE AREA CNT -C- -C -C READ BEAM -C - J=APHJ(MPH_NRA_J) !LENGTH LINE - J=APHJ(MPH_MDP_J)+LB_E*(J*APHJ(MPH_NDEC_J)/2+ - 1 APHJ(MPH_NRA_J)/2-TAREA(2,0)) !OFFSET LINE 0 - DO I=0,TAREA(3,0) - J1=LB_E*(2*TAREA(2,0)+1) - IF (.NOT.WNFRD(FCAMAP,J1,BEM(-TAREA(2,0),I),J)) THEN - CALL WNCTXT(F_TP,'Read error beam') - CALL WNGEX - END IF - J=J+LB_E*APHJ(MPH_NRA_J) !NEXT LINE - END DO - BEM(0,0)=BEM(0,0)+PRHAT !SET PRUSSIAN HAT -C -C READ MAP -C - CURMAX=-1E20 !INIT. MAX - J=MPHJ(MPH_NRA_J) !LENGTH LINE - J=MPHJ(MPH_MDP_J)+LB_E*(J*(MPHJ(MPH_NDEC_J)/2+ - 1 TAREA(2,1))+MPHJ(MPH_NRA_J)/2+TAREA(0,1)) - DO I=-TAREA(3,0)/2,TAREA(3,0)/2 - J1=LB_E*TAREA(2,0) - IF (.NOT.WNFRD(FCAMAP,J1,MAP(-TAREA(2,0)/2,I),J)) THEN - CALL WNCTXT(F_TP,'Read error map') - CALL WNGEX - END IF - J=J+LB_E*MPHJ(MPH_NRA_J) !NEXT LINE - J1=0 !START POINT - DO JC=1,NAREA !ALL AREAS - IF (I+TAREA(1,0).GE.PAREA(2,JC,1) .AND. - 1 I+TAREA(1,0).LE.PAREA(3,JC,1)) THEN !LINE OK - J1=MAX(J1,PAREA(0,JC,1)-TAREA(0,1)) !START POINT - DO I1=J1-TAREA(2,0)/2,PAREA(1,JC,1)-TAREA(0,0) !ALL POINTS - IF (CURMAX.LT.ABS(MAP(I1,I))) THEN - CURMAX=ABS(MAP(I1,I)) !SET MAXIMUM - CURMXP(1)=I1 - CURMXP(2)=I - END IF - J1=J1+1 !CNT POINT - END DO - END IF - END DO - END DO -C - RETURN -C -C - END diff --git a/src/nmap/nclbwr.for b/src/nmap/nclbwr.for deleted file mode 100644 index 8b82e10b44c2e29f3553e2692946f310f5434b64..0000000000000000000000000000000000000000 --- a/src/nmap/nclbwr.for +++ /dev/null @@ -1,151 +0,0 @@ -C+ NCLBWR.FOR -C WNB 910809 -C -C Revisions: -C JPH 940228 Comments -C - SUBROUTINE NCLBWR(CLAR3,CLAR4,MAP,IMPH) -C -C Write residual map -C -C Result: -C CALL NCLBWR( CLAR3_J:I, CLAR4_J:I, MAP_E(-*:*,-*:*), IMPH_B(0:*):I) -C Write residual map using MAP area of size -C CLAR3, CLAR4 and the original map header IMPH. -C -C -C Include files: -C - INCLUDE 'WNG_DEF' - INCLUDE 'GFH_O_DEF' !GENERAL FILE HEADER - INCLUDE 'SGH_O_DEF' !SUB-GROUP HEADER - INCLUDE 'MPH_O_DEF' !MAP HEADER - INCLUDE 'NCL_DEF' -C -C Parameters: -C -C -C Arguments: -C - INTEGER CLAR3,CLAR4 !MAP BOUNDARIES - REAL MAP(-CLAR3/2:CLAR3/2,-CLAR4/2:CLAR4/2) !MAP - BYTE IMPH(0:MPHHDL-1) !MAP HEADER -C -C Function references: -C - LOGICAL WNFRD !READ DISK - LOGICAL WNFWR !WRITE DISK - INTEGER WNFEOF !FILE POINTER - LOGICAL WNDLNF,WNDLNG,WNDLNK !FIND/MAKE SUB-GROUPS - INTEGER WNGGJ !GET VALUE - CHARACTER*32 WNTTSG !SET NAME -C -C Data declarations: -C - INTEGER JC !MULTIPLE AREA CNT - INTEGER HIST !HISTOGRAM AREA - CHARACTER*32 TXT - REAL RMAX,RMIN !MAX/MIN - INTEGER RMXR,RMXD,RMNR,RMND !POS. MAX/MIN - INTEGER SGNR(0:7),SGPH(0:7) !NAME FINDERS - INTEGER MPHP !POINTER RES. MAP HEADER - BYTE MPH(0:MPHHDL-1) !RESIDUAL MAP HEADER - INTEGER MPHJ(0:MPHHDL/4-1) - REAL MPHE(0:MPHHDL/4-1) - EQUIVALENCE (MPH,MPHJ,MPHE) - REAL LBUF(0:8192) !DATA BUFFER -C- -C -C INITIALISE -C - CALL WNGMV(MPHHDL,IMPH,MPH) !INIT. RESIDUAL MAP HEADER - MPHP=WNFEOF(FCAMAP) !HEADER POINTER - IF (.NOT.WNFWR(FCAMAP,MPHHDL,MPH,MPHP)) GOTO 10 !WRITE RESIDUAL HEADER - RMAX=-1E36 !INIT MAX/MIN - RMIN=1E36 - D0=1D0 !NORMALISATION - CALL WNMHS8(HIST,1,1E0) !GET HISTO AREA - IF (.NOT.WNDLNF(GFH_LINKG_1,MAPNAM(0),SGH_GROUPN_1,FCAMAP,SGPH(0), - 1 SGNR(0))) THEN !FIND CORRECT SET - 20 CONTINUE - CALL WNCTXT(F_TP,'Cannot create residual map linkage') - CALL WNGEX !STOP PROGRAM - END IF - DO I=1,4 !FIND ALL LEVELS - IF (.NOT.WNDLNF(SGPH(I-1)+SGH_LINKG_1,MAPNAM(I),SGH_GROUPN_1, - 1 FCAMAP,SGPH(I),SGNR(I))) GOTO 20 - END DO - IF (.NOT.WNDLNK(GFH_LINK_1,MPHP,MPH_SETN_1,FCAMAP)) GOTO 20 !LINK MAP - IF (.NOT.WNDLNG(SGPH(4)+SGH_LINKG_1,MPHP,SGH_GROUPN_1, - 1 FCAMAP,SGPH(5),SGNR(5))) GOTO 20 !LINK SUB-GROUP - SGNR(6)=-1 !CLOSE OFF NAME - IF (.NOT.WNFRD(FCAMAP,MPHHDL,MPH,MPHP)) GOTO 10 !REREAD RESIDUAL HEADER -C -C WRITE CLEANED MAP -C - J=WNGGJ(IMPH(MPH_MDP_1)) !START DISK POINTER - J0=WNFEOF(FCAMAP) !START WRITE POINTER - MPHJ(MPH_MDP_J)=J0 !SAVE POINTER - J2=LB_E*MPHJ(MPH_NRA_J) !LENGTH LINE - DO I=-MPHJ(MPH_NDEC_J)/2,MPHJ(MPH_NDEC_J)/2-1 !ALL MAP LINES - IF (.NOT.WNFRD(FCAMAP,J2,LBUF,J)) THEN !READ LINE -C -C All errors associated with writing the residuals are reported here; rereading -C the map header is part of thios and therefor reported as a write error -C - 10 CONTINUE - CALL WNCTXT(F_TP,'!/Write error residual map!/') - CALL WNGEX - END IF - IF (I.GE.TAREA(2,1) .AND. I.LE.TAREA(3,1)) THEN !GET RESIDUAL - J1=0 !START POINT - DO JC=1,NAREA !ALL AREAS - IF (I.GE.PAREA(2,JC,1) .AND. - 1 I.LE.PAREA(3,JC,1)) THEN !LINE OK - J1=MAX(J1,PAREA(0,JC,1)-TAREA(0,1)) !START POINT - DO I1=J1+TAREA(0,1),PAREA(1,JC,1) !ALL POINTS - LBUF(I1+MPHJ(MPH_NRA_J)/2)= - 1 MAP(I1-TAREA(0,1)-TAREA(2,0)/2, - 1 I-TAREA(2,1)-TAREA(3,0)/2) !SET RESIDUAL POINT - J1=J1+1 !CNT POINT - END DO - END IF - END DO - END IF - IF (.NOT.WNFWR(FCAMAP,J2,LBUF,J0)) GOTO 10 !WRITE - R0=-1E36 - R1=1E36 - CALL WNMFMX(MPHJ(MPH_NRA_J),LBUF,1D0,R0,I3,R1,I4) !FIND MAX/MIN - IF (R0.GT.RMAX) THEN - RMAX=R0 !NEW MAX - RMXR=I3-MPHJ(MPH_NRA_J)/2 - RMXD=I - END IF - IF (R1.LT.RMIN) THEN - RMIN=R1 !NEW MIN - RMNR=I4-MPHJ(MPH_NRA_J)/2 - RMND=I - END IF - CALL WNMHS1(HIST,MPHJ(MPH_NRA_J),LBUF) !MAKE HISTOGRAM - J=J+J2 !NEXT LINE POINTER - J0=J0+J2 !NEXT OUTPUT POINTER - END DO - CALL WNMHS4(HIST,MPHE(MPH_NOS_E),F_TP) !SET NOISE - MPHE(MPH_MAX_E)=RMAX !SAVE MAX/MIN - MPHE(MPH_MIN_E)=RMIN - MPHJ(MPH_MXR_J)=RMXR - MPHJ(MPH_MNR_J)=RMNR - MPHJ(MPH_MXD_J)=RMXD - MPHJ(MPH_MND_J)=RMND - CALL WNCTXS(TXT,'Residual !AS',WNTTSG(MAPNAM,0)) !SET TEXT - CALL WNGMFS(MPH_UCM_N,TXT,MPH(MPH_UCM_1)) - IF (.NOT.WNFWR(FCAMAP,MPHHDL,MPH,MPHP)) GOTO 10 !REWRITE HEADER - CALL WNMHS3(HIST,1,F_P) !SHOW RESIDUAL HISTO - CALL WNCTXT(F_P,'!^') - CALL NMAPMH(F_TP,MPH,SGNR,NODMAP) !SHOW RESIDUAL MAP - CALL WNMHS9(HIST) !RELEASE HISTO BUFFER -C - RETURN -C -C - END diff --git a/src/nmap/nclccl.for b/src/nmap/nclccl.for deleted file mode 100644 index 99c529c8e1d8bf0ee5055f64ce903eaaa4f48409..0000000000000000000000000000000000000000 --- a/src/nmap/nclccl.for +++ /dev/null @@ -1,112 +0,0 @@ -C+ NCLCCL.FOR -C WNB 920103 -C -C Revisions: -C WNB 921216 Add Grating factor -C WNB 931006 Text -C JPH 940221 Comments -C - SUBROUTINE NCLCCL(BEM,MAP,IMAP,SRC1,MDHJ,MPHD,SUMGL) -C -C Do patch type clean cycle -C -C Result: -C CALL NCLCCL( BEM_E(-*:*,0:*):I, MAP_E(2,0:*):I, IMAP_I(4,0:*):I, -C SRC1_J:I, MDHJ_J(*):IO, MPHD_D(*):I, SUMGL_E:IO) -C Clean a patch using beam area BEM and map -C area MAP,IMAP starting at source SRC1 in -C model header MDHJ. SUMGL gives the maximum -C contribution outside beam patch -C -C Include files: -C - INCLUDE 'WNG_DEF' - INCLUDE 'MPH_O_DEF' !MAP HEADER - INCLUDE 'MDH_O_DEF' !MODEL HEADER - INCLUDE 'MDL_O_DEF' !MODEL LINE - INCLUDE 'NCL_DEF' -C -C Parameters: -C -C -C Arguments: -C - REAL BEM(-BEMPAT:BEMPAT,0:BEMPAT) !BEAM - REAL MAP(2,0:*) !MAP - INTEGER*2 IMAP(4,0:*) !MAP - INTEGER SRC1 !FIRST SOURCE IN CYCLE - INTEGER MDHJ(0:*) !MODEL HEADER - DOUBLE PRECISION MPHD(0:*) !MAP HEADER - REAL SUMGL !GRATING POSSIBLE CONTRIBUTION -C -C Function references: -C -C -C Data declarations: -C - INTEGER RG(0:1) !SOURCE RANGE - BYTE MDL (0:MDLHDL-1) !MODEL LINE - INTEGER MDLJ(0:MDLHDL/4-1) - REAL MDLE(0:MDLHDL/4-1) - EQUIVALENCE (MDL,MDLJ,MDLE) -C- -C -C ADD SOURCE to model list -C - R0=CLFAC*MAP(2,CURPMX) !NEW AMPL - R1=ABS(CLBXLM*R0)*GRFAC !MAX. CORRECTION OUTSIDE PATCH - SUMGL=SUMGL+R1 !POSSIBLE MAX. OUTSIDE CONTRIB. - IF (MDHJ(MDH_NSRC_J).LT.SRCLIM) THEN !CAN ADD MORE - CALL WNGMVZ(MDLHDL,MDL) !EMPTY SOURCE - MDLE(MDL_I_E)=R0 !AMPL - MDLE(MDL_L_E)=DPI2*(MPHD(MPH_SRA_D)* - 1 IMAP(1,CURPMX)+MPHD(MPH_SHR_D)) !L - MDLE(MDL_M_E)=DPI2*(MPHD(MPH_SDEC_D)* - 1 IMAP(2,CURPMX)+MPHD(MPH_SHD_D)) !M - MDLJ(MDL_ID_J)=3001+MDHJ(MDH_NSRC_J) !ID - MDL(MDL_TP_B)=MDLCLN_M !CLEAN COMPONENT - CALL WNGMV(MDLHDL,MDL,A_B(MDHJ(MDH_MODP_J)-A_OB+ - 1 MDHJ(MDH_NSRC_J)*MDLHDL)) !SAVE SOURCE - MDHJ(MDH_NSRC_J)=MDHJ(MDH_NSRC_J)+1 !CNT SRC -C -C.. output source component to terminal and/or log -C - I1=0 !PRINT CODE - IF (CMPLOG(1).NE.0) THEN - IF (MOD(MDHJ(MDH_NSRC_J)-SRC1,CMPLOG(1)).EQ.0) I1=I1+F_T - END IF - IF (CMPLOG(2).NE.0) THEN - IF (MOD(MDHJ(MDH_NSRC_J)-SRC1,CMPLOG(2)).EQ.0) I1=I1+F_P - END IF - IF (I1.NE.0) THEN - RG(0)=MDHJ(MDH_NSRC_J) !SOURCE RANGE - RG(1)=RG(0) - CALL NMOPRM(I1,RG,MDL) !PRINT SOURCE - END IF - END IF -C -C CLEAN -C - CURMAX=-1E20 !NEW MAX - I4=IMAP(1,CURPMX) !OLD MAX L - I5=IMAP(2,CURPMX) !M - DO J=0,MAPPAT-1 !ALL MAP POINTS - I1=IMAP(1,J)-I4 !OFFSET L - I2=IMAP(2,J)-I5 !OFFSET M - IF (ABS(I1).LE.BEMPAT .AND. ABS(I2).LE.BEMPAT) THEN !DO CLEAN - IF (I2.LT.0) THEN !TAKE SYMMETRIC - MAP(2,J)=MAP(2,J)-R0*BEM(-I1,-I2) !DO CLEAN - ELSE - MAP(2,J)=MAP(2,J)-R0*BEM(I1,I2) !DO CLEAN OF POINT - END IF - END IF - IF (CURMAX.LT.ABS(MAP(2,J))) THEN !NEW MAX - CURMAX=ABS(MAP(2,J)) - CURPMX=J - END IF - END DO -C - RETURN -C -C - END diff --git a/src/nmap/nclcdt.for b/src/nmap/nclcdt.for deleted file mode 100644 index 815822aef2df1ecacb9aa38c149ae9a2d923a4c2..0000000000000000000000000000000000000000 --- a/src/nmap/nclcdt.for +++ /dev/null @@ -1,230 +0,0 @@ -C+ NCLCDT.FOR -C WNB 921202 -C -C Revisions: -C WNB 921207 Some changes to source handling -C HjV 921228 Line too long for HP -C WNB 930108 Typo re-patch -C WNB 930407 Keep correct noise -C WNB 930928 Add instrument -C CMV 950616 Account for DATAFAC in map limits -C - SUBROUTINE NCLCDT(MPHP,APHP) -C -C Do data cleaning -C -C Result: -C CALL NCLCDT( MPHP_J:I, APHP_J:I) -C Do a data clean. -C MPHP and APHP are the -C map and beam header pointers. -C -C Include files: -C - INCLUDE 'WNG_DEF' - INCLUDE 'MPH_O_DEF' !MAP HEADER - INCLUDE 'MDH_O_DEF' !MODEL HEADER - INCLUDE 'NCL_DEF' -C -C Parameters: -C -C -C Arguments: -C - INTEGER MPHP !MAP HEADER POINTER - INTEGER APHP !BEAM HEADER POINTER -C -C Function references: -C - LOGICAL WNGGVM !GET VIRTUAL MEMORY - LOGICAL WNFOP !OPEN FILE - LOGICAL WNFRD !READ DISK - CHARACTER*20 WNFFNM !GET FILE NAME - LOGICAL NMOSLG !GET SOURCE SPACE -C -C Data declarations: -C - INTEGER RMPP !RESIDUAL/RESTORE MAP POINTER - INTEGER RSNAM(0:7) !RESTORE SET NAME - INTEGER BMSIZ,MPSIZ !PATCH BUFFER SIZES - INTEGER BMPAD,MPPAD !PATCH BUFFER ADDRESSES - INTEGER FCATMP !TEMP. FILE FOR RESTORE - REAL SUMGL !GRATING LOBE SUM - INTEGER MDHJ(0:MDHHDL/4-1) !MODEL HEADER - REAL MDHE(0:MDHHDL/4-1) - DOUBLE PRECISION MDHD(0:MDHHDL/8-1) - EQUIVALENCE (MDHJ,MDHE,MDHD) - BYTE MPH(0:MPHHDL-1) !MAP HEADER - INTEGER*2 MPHI(0:MPHHDL/2-1) - INTEGER MPHJ(0:MPHHDL/4-1) - REAL MPHE(0:MPHHDL/4-1) - DOUBLE PRECISION MPHD(0:MPHHDL/8-1) - EQUIVALENCE (MPH,MPHI,MPHJ,MPHE,MPHD) - BYTE RMPH(0:MPHHDL-1) !RESIDUAL MAP HEADER - INTEGER RMPHJ(0:MPHHDL/4-1) - REAL RMPHE(0:MPHHDL/4-1) - EQUIVALENCE (RMPH,RMPHJ,RMPHE) - BYTE APH(0:MPHHDL-1) !BEAM HEADER - INTEGER RG(0:1) !SOURCE RANGE - DATA RG/1,1000000/ -C- -C -C INIT -C - IF (.NOT.WNFRD(FCAMAP,MPHHDL,MPH,MPHP)) THEN !READ MAP HEADER - CALL WNCTXT(F_TP,'Error reading map header') - CALL WNGEX !STOP - END IF - MINLIM=MAX(ABS(MPHE(MPH_MAX_E)*DATAFAC), - 1 ABS(MPHE(MPH_MIN_E)*DATAFAC)) !SET MAP MAX - IF (APHP.NE.0) THEN !BEAM PRESENT - IF (.NOT.WNFRD(FCAMAP,MPHHDL,APH,APHP)) THEN !READ BEAM HEADER - CALL WNCTXT(F_TP,'Error reading beam header') - CALL WNGEX !STOP - END IF - ELSE !NO BEAM - CALL WNGMV(MPHHDL,MPH,APH) !MAKE SURE DATA PRESENT - END IF -C -C GET HISTOGRAMS AND PATCH DATA -C - CALL WNCTXT(F_TP,' ') - CALL WNCCSX(F_TP,'Histogramming') - CALL NCLHID(MPHP,APHP) !GET BEAM PATCH, SHOW HISTO - CALL WNCTXT(F_P,'!^') -C -C INIT SOURCE LISTS -C - DO I=4,5 !MINOR LIST; TOTAL LIST - CALL NMOHMF(I,MDHJ) !GET HEADER - CALL NMOHZD(MDHJ) !CLEAR SOURCES - MDHD(MDH_RA_D)=MPHD(MPH_RA_D) !SET MAP RA - MDHD(MDH_DEC_D)=MPHD(MPH_DEC_D) !SET MAP DEC - MDHD(MDH_FRQ_D)=MPHD(MPH_FRQ_D) !SET MAP FREQ. - IF (MPHI(MPH_EPT_I).EQ.1) THEN !1950 COORDINATES - MDHJ(MDH_TYP_J)=2 !EPOCH TYPE - MDHE(MDH_EPOCH_E)=MPHE(MPH_EPO_E) !EPOCH - ELSE !APPARENT - MDHJ(MDH_TYP_J)=1 !EPOCH TYPE - MDHE(MDH_EPOCH_E)=0. !EPOCH - END IF - MDHJ(MDH_BITS_J)=MPHJ(MPH_INST_J) !SET INSTRUMENT - IF (.NOT.NMOSLG(SRCLIM,MDHJ)) THEN !GET AREA - CALL WNCTXT(F_TP,'No space for clean source list') - CALL WNGEX !STOP - END IF - CALL NMOHMT(MDHJ,I) !SAVE LIST - END DO -C -C GET PATCH BUFFER -C - 10 CONTINUE - BMSIZ=LB_E*(2*BEMPAT+1)*(BEMPAT+1) !BEAM BUFFER SIZE - MPSIZ=(LB_E+2*LB_I)*MAPPAT !MAP BUFFER SIZE - JS=WNGGVM(BMSIZ,BMPAD) !GET BEAM PATCH BUF - IF (JS) JS=WNGGVM(MPSIZ,MPPAD) !GET MAP POINT BUFFER - IF (.NOT.JS) THEN - CALL WNCTXT(F_TP,'Cannot obtain beam and/or map patch buffers') - CALL WNGEX !STOP - END IF - CALL WNCTXT(F_TP,'!/Beam patch of !UJ points, '// - 1 '!UJ mappoints down to !E10.3 W.U. (!E7.2%)!/', - 1 2*BEMPAT+1,MAPPAT,MAPLIM,100.*MAPLIM/MINLIM) -C -C READ DATA -C - CALL NCLCRD(FCAMAP,APH,A_B(BMPAD-A_OB),FCAMAP, - 1 MPHJ(MPH_MDP_J), - 1 MPH,A_B(MPPAD-A_OB),A_B(MPPAD-A_OB)) !BEAM, MAP PATCH -C -C DO CLEAN -C - CALL NMOHMF(4,MDHJ) !GET NEW TOTAL LIST - CALL WNCCSX(F_TP,'Cleaning') - J=MDHJ(MDH_NSRC_J)+1 !START SOURCE - SUMGL=0 !START GRATING RESPONSE - DO WHILE (CURMAX.GT.MAPLIM .AND. - 1 MDHJ(MDH_NSRC_J).LT.SRCLIM .AND. - 1 CURMAX.GE.SUMGL) - CALL NCLCCL(A_B(BMPAD-A_OB),A_B(MPPAD-A_OB),A_B(MPPAD-A_OB), - 1 J,MDHJ,MPH,SUMGL) !CLEAN CYCLE - END DO -C -C SHOW SOURCES -C - CALL NMOHMT(MDHJ,4) !SET HEADER 4 - CALL NMORDA(4,5,J) !ADD TO TOTAL LIST - CALL NMOAM1(5) !MERGE TOTAL LIST - CALL NMOPTI(F_TP,RG,5) !SHOW TOTAL TILL NOW -C -C RELEASE PATCH BUFFERS -C - CALL WNGFVM(BMSIZ,BMPAD) - CALL WNGFVM(MPSIZ,MPPAD) -C -C CLEAN MAJOR CYCLE -C - CALL NMORDA(4,-1,J) !SET SOURCES IN GENERAL LIST - CALL NMAMAC(MPHP,MAPNAM) !MAKE NEW MAP -C -C RECYCLE -C - IF (MDHJ(MDH_NSRC_J).LT.SRCLIM) THEN - CALL NCLHM0(MPHAD,MPHP) !NEW AREA MAP HISTOGRAM - CALL WNMHS7(MPHAD,I1,I2,MPHMXI,R0) !GET NEW MAX. - IF (MPHMXI.GT.CLLIM*MINLIM .AND. - 1 MDHJ(MDH_NSRC_J).LT.SRCLIM) THEN - CALL NCLHIE(MPHP,APHP) !GET PATCH DATA - GOTO 10 !MORE TO DO - END IF - END IF -C -C FINISH SOURCE LIST -C - CALL NMOAMG !MERGE COMPONENTS - CALL NMOPTT(F_TP,RG) !SHOW TOTAL FLUX - IF (FCAAP.EQ.0) THEN !NO MODEL FILE GIVEN - CALL NMODAX(J) !LET USER ACT - ELSE - CALL NMOWRI(FCAAP,-1) !WRITE SOURCE MODEL - END IF -C -C RESTORE MAP -C - 20 CONTINUE - IF (RSTMDL) THEN !RESTORE MAP - CALL NMOHMF(-1,MDHJ) !SOURCES - IF (.NOT.WNFOP(FCATMP,WNFFNM('NCL','TMP'),'WT')) THEN - CALL WNCTXT(F_TP,'Cannot open temporary restore file') - CALL WNGEX !STOP - END IF - CALL NCLCWR(FCAMAP,MPH,RMPP,RSNAM) !START RESTORED MAP - IF (.NOT.WNFRD(FCAMAP,MPHHDL,MPH,MPHP)) THEN !READ RESIDUAL HEADER - CALL WNCTXT(F_TP,'Error reading residual map header') - CALL WNGEX !STOP - END IF - R0=MPHE(MPH_NOS_E) !KEEP NOISE - IF (.NOT.WNFRD(FCAMAP,MPHHDL,RMPH,RMPP)) THEN !READ RESTORED HEADER - CALL WNCTXT(F_TP,'Error reading restored map header') - CALL WNGEX !STOP - END IF - RMPHE(MPH_NOS_E)=R0 !SET NOISE - CALL WNCCSX(F_TP,'Restoring') - CALL NCLUCL(1,MDHJ(MDH_NSRC_J),FCATMP,0,FCAMAP,FCAMAP, - 1 MDHJ,MPHJ(MPH_MDP_J),RMPP,RMPH,APH) - CALL WNCTXT(F_P,'!^') - CALL NMAPMH(F_TP,RMPH,RSNAM,NODMAP) !SHOW RESIDUAL HEADER - END IF -C -C READY -C - CALL NCLHIX(MPHP,APHP) !DELETE BEAM HISTO - CALL WNFCL(FCATMP) !CLOSE AND DELETE TMP FILE - CALL WNCTXT(F_TP,' ') - CALL WNCCSX(F_TP,'End') - CALL WNCTXT(F_TP,' ') -C - RETURN -C -C - END diff --git a/src/nmap/nclcmp.for b/src/nmap/nclcmp.for deleted file mode 100644 index f243ed0f85c70bd802cd5e3323fadf4ee1c4feb1..0000000000000000000000000000000000000000 --- a/src/nmap/nclcmp.for +++ /dev/null @@ -1,158 +0,0 @@ -C+ NCLCMP.FOR -C WNB 920117 -C -C Revisions: -C HjV 920520 HP does not allow extended source lines -C WNB 921202 Free buffers; cater for J2000 -C WNB 930928 Add instrument -C - SUBROUTINE NCLCMP(MPHP,APHP) -C -C Get clean component list -C -C Result: -C CALL NCLCMP( MPHP_J:I, APHP_J:I) -C Do a Clark type clean, using the UV cover -C to obtain a source list. MPHP and APHP are the -C map and beam header pointers. -C -C Include files: -C - INCLUDE 'WNG_DEF' - INCLUDE 'MPH_O_DEF' !MAP HEADER - INCLUDE 'MDH_O_DEF' !MODEL HEADER - INCLUDE 'NCL_DEF' -C -C Parameters: -C -C -C Arguments: -C - INTEGER MPHP !MAP HEADER POINTER - INTEGER APHP !BEAM HEADER POINTER -C -C Function references: -C - LOGICAL WNGGVM !GET VIRTUAL MEMORY - LOGICAL WNFRD !READ DISK - LOGICAL NMOSLG !GET SOURCE SPACE -C -C Data declarations: -C - INTEGER BMSIZ,MPSIZ !PATCH BUFFER SIZES - INTEGER BMPAD,MPPAD !PATCH BUFFER ADDRESSES - REAL SUMGL !GRATING LOBE SUM - INTEGER MDHJ(0:MDHHDL/4-1) !MODEL HEADER - REAL MDHE(0:MDHHDL/4-1) - DOUBLE PRECISION MDHD(0:MDHHDL/8-1) - EQUIVALENCE (MDHJ,MDHE,MDHD) - BYTE MPH(0:MPHHDL-1) !MAP HEADER - INTEGER*2 MPHI(0:MPHHDL/2-1) - INTEGER MPHJ(0:MPHHDL/4-1) - REAL MPHE(0:MPHHDL/4-1) - DOUBLE PRECISION MPHD(0:MPHHDL/8-1) - EQUIVALENCE (MPH,MPHI,MPHJ,MPHE,MPHD) - BYTE APH(0:MPHHDL-1) !BEAM HEADER - INTEGER RG(0:1) !SOURCE RANGE - DATA RG/1,1000000/ -C- -C -C INIT -C - IF (.NOT.WNFRD(FCAMAP,MPHHDL,MPH,MPHP)) THEN !READ MAP HEADER - CALL WNCTXT(F_TP,'Error reading map header') - CALL WNGEX !STOP - END IF - MINLIM=MAX(ABS(MPHE(MPH_MAX_E)),ABS(MPHE(MPH_MIN_E))) !SET MAP MAX - IF (APHP.NE.0) THEN !BEAM PRESENT - IF (.NOT.WNFRD(FCAMAP,MPHHDL,APH,APHP)) THEN !READ BEAM HEADER - CALL WNCTXT(F_TP,'Error reading beam header') - CALL WNGEX !STOP - END IF - ELSE !NO BEAM - CALL WNGMV(MPHHDL,MPH,APH) !MAKE SURE DATA PRESENT - END IF -C -C GET HISTOGRAMS AND PATCH DATA -C - CALL WNCTXT(F_TP,' ') - CALL WNCCSX(F_TP,'Histogramming') - CALL NCLHID(MPHP,APHP) !GET BEAM PATCH, SHOW HISTO - CALL WNCTXT(F_P,'!^') -C -C INIT SOURCE LIST -C - CALL NMOHMF(7,MDHJ) !GET HEADER 7 - CALL NMOHZD(MDHJ) !CLEAR SOURCES - MDHD(MDH_RA_D)=MPHD(MPH_RA_D) !SET MAP RA - MDHD(MDH_DEC_D)=MPHD(MPH_DEC_D) !SET MAP DEC - MDHD(MDH_FRQ_D)=MPHD(MPH_FRQ_D) !SET MAP FREQ. - IF (MPHI(MPH_EPT_I).EQ.1) THEN !1950/2000 COORDINATES - MDHJ(MDH_TYP_J)=2 !EPOCH TYPE - MDHE(MDH_EPOCH_E)=MPHE(MPH_EPO_E) !EPOCH - ELSE !APPARENT - MDHJ(MDH_TYP_J)=1 !EPOCH TYPE - MDHE(MDH_EPOCH_E)=0. !EPOCH - END IF - MDHJ(MDH_BITS_J)=MPHJ(MPH_INST_J) !SET INSTRUMENT - IF (.NOT.NMOSLG(SRCLIM,MDHJ)) THEN !GET AREA - CALL WNCTXT(F_TP,'No space for clean source list') - CALL WNGEX !STOP - END IF -C -C GET PATCH BUFFER -C - BMSIZ=LB_E*(2*BEMPAT+1)*(BEMPAT+1) !BEAM BUFFER SIZE - MPSIZ=(LB_E+2*LB_I)*MAPPAT !MAP BUFFER SIZE - JS=WNGGVM(BMSIZ,BMPAD) !GET BEAM PATCH BUF - IF (JS) JS=WNGGVM(MPSIZ,MPPAD) !GET MAP POINT BUFFER - IF (.NOT.JS) THEN - CALL WNCTXT(F_TP,'Cannot obtain beam and/or map patch buffers') - CALL WNGEX !STOP - END IF - CALL WNCTXT(F_TP,'!/Beam patch of !UJ points, '// - 1 '!UJ mappoints down to !E10.3 W.U. (!E7.2%)!/', - 1 2*BEMPAT+1,MAPPAT,MAPLIM,100.*MAPLIM/MINLIM) -C -C READ DATA -C - CALL NCLCRD(FCAMAP,APH,A_B(BMPAD-A_OB),FCAMAP,MPHJ(MPH_MDP_J), - 1 MPH,A_B(MPPAD-A_OB),A_B(MPPAD-A_OB)) !BEAM, MAP PATCH -C -C DO CLEAN -C - CALL WNCCSX(F_TP,'Cleaning') - J=MDHJ(MDH_NSRC_J)+1 !START SOURCE - SUMGL=0 !START GRATING RESPONSE - DO WHILE (CURMAX.GT.MAPLIM .AND. - 1 MDHJ(MDH_NSRC_J).LT.SRCLIM .AND. - 1 CURMAX.GE.SUMGL) - CALL NCLCCL(A_B(BMPAD-A_OB),A_B(MPPAD-A_OB),A_B(MPPAD-A_OB), - 1 J,MDHJ,MPH,SUMGL) !CLEAN CYCLE - END DO -C -C FINISH SOURCE LIST -C - CALL NMOHMT(MDHJ,7) !SET HEADER 7 - CALL NMORDM(7,-1) !ADD SOURCES TO GENERAL LIST - CALL NMOAMG !MERGE COMPONENTS - CALL NMOPTT(F_TP,RG) !SHOW TOTAL FLUX - IF (FCAAP.EQ.0) THEN !NO MODEL FILE GIVEN - CALL NMODAX(J) !LET USER ACT - ELSE - CALL NMOWRI(FCAAP,-1) !WRITE SOURCE MODEL - END IF -C -C READY -C - CALL NCLHIX(MPHP,APHP) !DELETE BEAM HISTO - CALL WNGFVM(BMSIZ,BMPAD) !RELEASE PATCH BUFFERS - CALL WNGFVM(MPSIZ,MPPAD) - CALL WNCTXT(F_TP,' ') - CALL WNCCSX(F_TP,'End') - CALL WNCTXT(F_TP,' ') -C - RETURN -C -C - END diff --git a/src/nmap/nclcrd.for b/src/nmap/nclcrd.for deleted file mode 100644 index 5b8159e5d3f14b37def922dc7e1aea26d840e9dc..0000000000000000000000000000000000000000 --- a/src/nmap/nclcrd.for +++ /dev/null @@ -1,121 +0,0 @@ -C+ NCLCRD.FOR -C WNB 920103 -C -C Revisions: -C JPH 920224 Comments -C HjV 950512 Add DATAFAC -C -C - SUBROUTINE NCLCRD(FBM,BMH,BEM,FMP,DPTIN,MPH,MAP,IMAP) -C -C Read beam and map for patch type clean -C -C Result: -C CALL NCLCRD ( FBM_J:I, BMH_B(*)_I, BEM_E(-*:*,0:*):O, -C FMP_J:I, DPTIN_J:I, MPH_B(*):I, -C MAP_E(2,0:*):O, IMAP_I(4,0:*):O) -C Read beam (BEM) and map (MAP, IMAP) patch into -C memory, using files FBM, FMP and map header -C MPH and beam header BMH, and data at DPTIN. -C MAP points are cast in the format (L,M,flux) -C BEM is in standard array format with the -C Prussian-hat peak added to the central point -C The following COMMON variables are set: -C MAPPAT nr of points in map patch -C CURMAX maximum absolute value in patch -C CURPMX linear position in patch of -C maximum -C -C -C -C Include files: -C - INCLUDE 'WNG_DEF' - INCLUDE 'MPH_O_DEF' !MAP HEADER - INCLUDE 'NCL_DEF' -C -C Parameters: -C -C -C Arguments: -C - INTEGER FBM !BEAM FILE - BYTE BMH(0:*) !BEAM HEADER - REAL BEM(-BEMPAT:BEMPAT,0:BEMPAT) !BEAM - INTEGER FMP !INPUT MAP FILE - INTEGER DPTIN !DATA POINTER - BYTE MPH(0:*) !MAP HEADER - REAL MAP(2,0:*) !MAP - INTEGER*2 IMAP(4,0:*) !MAP -C -C Function references: -C - LOGICAL WNFRD !READ DISK - INTEGER WNGGJ !GET J VALUE -C -C Data declarations: -C - INTEGER MCNT !CNT POINTS - INTEGER JC !AREA COUNT - REAL LBUF(0:8191) !DATA BUFFER -C- -C -C READ BEAM -C - J=WNGGJ(BMH(MPH_NRA_1)) !LENGTH LINE - J=WNGGJ(BMH(MPH_MDP_1))+LB_E*(J*WNGGJ(BMH(MPH_NDEC_1))/2+ - 1 WNGGJ(BMH(MPH_NRA_1))/2-BEMPAT) !OFFSET LINE 0 - DO I=0,BEMPAT - IF (.NOT.WNFRD(FBM,LB_E*(2*BEMPAT+1),BEM(-BEMPAT,I),J)) THEN - CALL WNCTXT(F_TP,'Read error beam') - CALL WNGEX !STOP PROGRAM - END IF - J=J+LB_E*WNGGJ(BMH(MPH_NRA_1)) !NEXT LINE - END DO - BEM(0,0)=BEM(0,0)+PRHAT !ADD PRUSSIAN HAT -C -C READ MAP -C - CURMAX=-1E20 !INIT. MAX - MCNT=0 !# OF POINTS - J=WNGGJ(MPH(MPH_NRA_1)) !MAP PTR - J=DPTIN+LB_E*(J*(WNGGJ(MPH(MPH_NDEC_1))/2+ - 1 TAREA(2,1))+WNGGJ(MPH(MPH_NRA_1))/2+TAREA(0,1)) - J1=LB_E*WNGGJ(MPH(MPH_NRA_1)) !LINE LENGTH - J2=LB_E*TAREA(2,0) !LENGTH TO READ - DO I=TAREA(2,1),TAREA(3,1) !ALL MAP LINES - IF (.NOT.WNFRD(FMP,J2,LBUF(0),J)) THEN !READ LINE - CALL WNCTXT(F_TP,'Read error map') - CALL WNGEX !STOP - END IF - J=J+J1 !NEXT PTR - I2=0 !START POINT - DO JC=1,NAREA !ALL AREAS - IF (I.GE.PAREA(2,JC,1) .AND. I.LE.PAREA(3,JC,1)) THEN !LINE OK - I2=MAX(I2,PAREA(0,JC,1)-TAREA(0,1)) !START POINT - DO I1=I2+TAREA(0,1),PAREA(1,JC,1) !ALL POINTS - R0=ABS(LBUF(I2))*DATAFAC !MAP VALUE - IF (R0.GT.MAPLIM) THEN - IMAP(1,MCNT)=I1 !PTR IN LINE - IMAP(2,MCNT)=I !LINE # - MAP(2,MCNT)=LBUF(I2)*DATAFAC !FLUX - IF (CURMAX.LT.R0) THEN !NEW MAX - CURMAX=R0 - CURPMX=MCNT !POS. MAX - END IF - MCNT=MCNT+1 !CNT POINT - IF (MCNT.GE.MAPPAT) GOTO 20 !BUFFER FULL - END IF - I2=I2+1 !NEXT POINT - END DO - END IF - END DO - END DO -C - 20 CONTINUE - MAPPAT=MCNT !# OF POINTS PRESENT -C - RETURN -C -C - END diff --git a/src/nmap/nclcwr.for b/src/nmap/nclcwr.for deleted file mode 100644 index 7ce80143b60fad8fcb0260b1cb7e03fc3f6ff257..0000000000000000000000000000000000000000 --- a/src/nmap/nclcwr.for +++ /dev/null @@ -1,100 +0,0 @@ -C+ NCLCWR.FOR -C WNB 920106 -C -C Revisions: -C WNB 920131 Logic error in pointer value -C - SUBROUTINE NCLCWR(FCAR,IMPH,MPHP,SGNR) -C -C Write initial residual map -C -C Result: -C CALL NCLCWR( FCAR_J:I, IMPH_B(0:*):I, MPHP_J:O, SGNR_J(0:7):O) -C Write residual map by copying the map -C header IMPH, and returning header pointer -C MPHP on file FCAR, and possible set name -C in SGNR -C -C Include files: -C - INCLUDE 'WNG_DEF' - INCLUDE 'GFH_O_DEF' !GENERAL FILE HEADER - INCLUDE 'SGH_O_DEF' !SUB-GROUP HEADER - INCLUDE 'MPH_O_DEF' !MAP HEADER - INCLUDE 'NCL_DEF' -C -C Parameters: -C -C -C Arguments: -C - INTEGER FCAR !RESIDUAL FILE - BYTE IMPH(0:MPHHDL-1) !MAP HEADER - INTEGER MPHP !POINTER TO OUTPUT MAP - INTEGER SGNR(0:7) !SET NAME -C -C Function references: -C - LOGICAL WNFRD !READ DISK - LOGICAL WNFWR !WRITE DISK - INTEGER WNFEOF !FILE POINTER - LOGICAL WNDLNF,WNDLNG,WNDLNK !FIND/MAKE SUB-GROUPS - INTEGER WNGGJ !GET VALUE - CHARACTER*32 WNTTSG !SET NAME -C -C Data declarations: -C - CHARACTER*32 TXT - INTEGER SGPH(0:7) !NAME FINDER - BYTE MPH(0:MPHHDL-1) !RESIDUAL MAP HEADER - INTEGER MPHJ(0:MPHHDL/4-1) - REAL MPHE(0:MPHHDL/4-1) - EQUIVALENCE (MPH,MPHJ,MPHE) -C- -C -C INITIALISE -C - CALL WNGMV(MPHHDL,IMPH,MPH) !INIT. RESIDUAL MAP HEADER - IF (FCAR.EQ.FCAMAP) THEN !RESIDUAL WANTED - MPHP=WNFEOF(FCAR) !HEADER POINTER - ELSE - MPHP=MPHHDL - END IF - IF (.NOT.WNFWR(FCAR,MPHHDL,MPH,MPHP)) THEN !WRITE RESIDUAL HEADER - 10 CONTINUE - CALL WNCTXT(F_TP,'Initiation error residual map') - CALL WNGEX !STOP - END IF - IF (FCAR.EQ.FCAMAP) THEN !INIT. MAP SET FOR RESIDUAL - IF (.NOT.WNDLNF(GFH_LINKG_1,MAPNAM(0),SGH_GROUPN_1,FCAR,SGPH(0), - 1 SGNR(0))) THEN !FIND CORRECT SET - 20 CONTINUE - CALL WNCTXT(F_TP,'Cannot create residual map linkage') - CALL WNGEX !STOP PROGRAM - END IF - DO I=1,4 !FIND ALL LEVELS - IF (.NOT.WNDLNF(SGPH(I-1)+SGH_LINKG_1,MAPNAM(I),SGH_GROUPN_1, - 1 FCAR,SGPH(I),SGNR(I))) GOTO 20 - END DO - IF (.NOT.WNDLNK(GFH_LINK_1,MPHP,MPH_SETN_1,FCAR)) GOTO 20 !LINK MAP - IF (.NOT.WNDLNG(SGPH(4)+SGH_LINKG_1,MPHP,SGH_GROUPN_1, - 1 FCAR,SGPH(5),SGNR(5))) GOTO 20 !LINK SUB-GROUP - SGNR(6)=-1 !CLOSE OFF NAME - END IF - IF (.NOT.WNFRD(FCAR,MPHHDL,MPH,MPHP)) GOTO 10 !REREAD RESIDUAL HEADER -C -C FILL HEADER DATA -C - IF (FCAR.EQ.FCAMAP) THEN !RESIDUAL WANTED SAVED - MPHJ(MPH_MDP_J)=WNFEOF(FCAR) !SET DATA POINTER - ELSE - MPHJ(MPH_MDP_J)=MPHHDL+MPHHDL !SET DATA POINTER - END IF - CALL WNCTXS(TXT,'Residual !AS',WNTTSG(MAPNAM,0)) !SET TEXT - CALL WNGMFS(MPH_UCM_N,TXT,MPH(MPH_UCM_1)) - IF (.NOT.WNFWR(FCAR,MPHHDL,MPH,MPHP)) GOTO 10 !REWRITE HEADER -C - RETURN -C -C - END diff --git a/src/nmap/ncldat.for b/src/nmap/ncldat.for deleted file mode 100644 index 9f11baae01f6e0f9db38f01b09ba33aae903d400..0000000000000000000000000000000000000000 --- a/src/nmap/ncldat.for +++ /dev/null @@ -1,502 +0,0 @@ -C+ NCLDAT.FOR -C WNB 910809 -C -C Revisions: -C WNB 910916 Error in error handling WNDNOD -C HjV 920520 HP does not allow extended source lines -C WNB 920810 Changed sign restore beam angle -C WNB 921202 Add DATA clean -C WNB 921216 Add grating factor -C HjV 921228 Line to long for HP -C HjV 930423 Change name of some keywords -C CMV 931116 Change query for memory use with /ASK -C CMV 931220 Pass FCA of input file to WNDXLP and WNDSTA/Q -C JPH 940221 Comments. - DMEMORY_USE prompt with default -C HjV 950512 Add data factor -C WNB 950621 New LSQ routines -C WNB 100128 Allow larger beam clean area -C -C - SUBROUTINE NCLDAT -C -C Get NCLEAN program parameters -C -C Result: -C -C CALL NCLDAT will ask and set all program parameters -C -C PIN references: -C -C OPTION -C CMEMORY_USE -C MAP_FACTOR -C CLEAN_LIMIT -C COMPON LIMIT -C LOOP_GAIN -C PRUSSIAN_HAT -C DECONVOLUTION -C CYCLE_DEPTH -C GRATING_FACTOR -C DATA_FACTOR -C RESIDUAL -C RESTORE -C RESTORE_BEAM -C -C Include files: -C - INCLUDE 'WNG_DEF' - INCLUDE 'LSQ_O_DEF' - INCLUDE 'NCL_DEF' - INCLUDE 'MPH_O_DEF' !MAP HEADER -C -C Parameters: -C -C -C Arguments: -C -C -C Function references: -C - LOGICAL WNDPAR !GET DWARF PARAMETER - LOGICAL WNDNOD !GET NODE NAME - LOGICAL WNDSTA !GET SETS TO DO - LOGICAL WNFOP !OPEN FILE - LOGICAL WNFRD !READ FILE - LOGICAL WNMLTN !TRIANGULAR EQUATIONS - LOGICAL NMASTG !GET A SET -C -C Data declarations: -C - INTEGER FAREA(0:3) !FULL MAP AREA - INTEGER MXAREA(0:3) !MAX. SHOW AREA - INTEGER BMAR !SOLUTION AREA - REAL BMC(3),BMS(3),BMU,BMMU !RESTORE BEAM SOL. - REAL CVCON !CONVERSION FACTOR - INTEGER MPHP !MAP POINTER - BYTE MPH(0:MPHHDL-1) !MAP HEADER - INTEGER MPHJ(0:MPHHDL/4-1) - REAL MPHE(0:MPHHDL/4-1) - DOUBLE PRECISION MPHD(0:MPHHDL/8-1) - EQUIVALENCE (MPH,MPHJ,MPHE,MPHD) - INTEGER APHP !AP POINTER - BYTE APH(0:MPHHDL-1) !AP HEADER - INTEGER APHJ(0:MPHHDL/4-1) - DOUBLE PRECISION APHD(0:MPHHDL/8-1) - EQUIVALENCE (APH,APHJ,APHD) - REAL LBUF(0:8191) !LINE BUFFER - BYTE LBT -C- -C -C GET OPTION -C - CVCON=2.*3600.*360.*SQRT(LOG(2.)) !CONVERSION ARCSEC/INTERNAL - 100 CONTINUE - IF (.NOT.WNDPAR('OPTION',OPTION,LEN(OPTION),J0,'QUIT')) THEN - OPTION='QUIT' !ASSUME END - ELSE IF (J0.LE.0) THEN - OPTION='QUIT' !ASSUME END - END IF - IF (OPT.EQ.'QUI') RETURN !READY -C -C GET MEMORY SIZE -C - IF (.NOT.WNDPAR('CMEMORY_USE',MEMSIZ,LB_J,J0,'150000')) THEN - MEMSIZ=150000 !ASSUME VALUE - ELSE IF (J0.LE.0) THEN - MEMSIZ=150000 !ASSUME VALUE - END IF -C -C HIST -C - IF (OPT.EQ.'HIS') THEN - 10 CONTINUE - IF (.NOT.WNDNOD('INPUT_WMP_NODE',' ','WMP','R',NODMAP,FILMAP)) THEN - IF (E_C.EQ.DWC_ENDOFLOOP) GOTO 100 !RETRY OPTION - GOTO 10 !REPEAT - ELSE IF (E_C.EQ.DWC_NULLVALUE) THEN - GOTO 100 !RETRY OPTION - ELSE IF (E_C.EQ.DWC_WILDCARD) THEN - GOTO 10 !MUST SPECIFY - END IF - IF (.NOT.WNFOP(FCAMAP,FILMAP,'R')) THEN !OPEN MAP FILE - GOTO 10 !RETRY - END IF - IF (.NOT.WNDSTA('WMP_SETS',MXNSET,MSETS,FCAMAP)) THEN !MAPS TO DO - GOTO 10 !RETRY FILE - END IF - IF (.NOT.NMASTG(FCAMAP,MSETS,MPH,MPHP,MAPNAM)) GOTO 10 !NO MAP - CALL WNDSTR(FCAMAP,MSETS) !RESET SEARCH STATUS - CALL WNDSTI(FCAMAP,MAPNAM) !MAKE INDEX - DO I=0,3 - TAREA(I,0)=0 !DEFAULT AREA - FAREA(I)=0 !FULL AREA - MXAREA(I)=0 !MAX. AREA - END DO - FAREA(2)=MPHJ(MPH_NRA_J) !LENGTH LINE - FAREA(3)=MPHJ(MPH_NDEC_J) - DO I=2,3 - MXAREA(I)=FAREA(I) - TAREA(I,0)=FAREA(I) - END DO - CALL NMADAR(MXNAR,NAREA,FAREA,0,MXAREA,TAREA(0,0),PAREA(0,1,0), - 1 TAREA(0,1),PAREA(0,1,1)) !GET AREA - IF (NAREA.LE.0) GOTO 10 !NO AREA SPECIFIED -C -C Clean and restore options -C - ELSE IF (OPT.EQ.'BEA' .OR. OPT.EQ.'UVC' .OR. - 1 OPT.EQ.'URE' .OR. OPT.EQ.'COM' .OR. - 1 OPT.EQ.'DAT') THEN - 20 CONTINUE - IF (.NOT.WNDNOD('INPUT_WMP_NODE',' ','WMP','R',NODMAP,FILMAP)) THEN - IF (E_C.EQ.DWC_ENDOFLOOP) GOTO 100 !RETRY OPTION - GOTO 20 !REPEAT - ELSE IF (E_C.EQ.DWC_NULLVALUE) THEN - GOTO 100 !RETRY OPTION - ELSE IF (E_C.EQ.DWC_WILDCARD) THEN - GOTO 20 !MUST SPECIFY - END IF - IF (.NOT.WNFOP(FCAMAP,FILMAP,'R')) THEN !OPEN MAP FILE - CALL WNCTXT(F_TP,'Cannot open map') - GOTO 20 !RETRY - END IF - 21 CONTINUE - IF (.NOT.WNDSTA('WMP_SETS',MXNSET,MSETS,FCAMAP)) THEN !MAPS TO DO - GOTO 20 !RETRY FILE - END IF - DO I=1,MSETS(0,0) !ALL LINES - MSETS(4,I)=0 !MAKE SURE MAP - END DO - IF (.NOT.NMASTG(FCAMAP,MSETS,MPH,MPHP,MAPNAM)) GOTO 27 !NO MAP - CALL WNDSTR(FCAMAP,MSETS) !RESET SEARCH STATUS - CALL WNDSTI(FCAMAP,MAPNAM) !MAKE INDEX - IF (MAPNAM(4).NE.0) THEN - 27 CONTINUE - CALL WNCTXT(F_TP,'Specified map set does not exist, '// - 1 'or not of type MAP') - GOTO 21 - END IF - 22 CONTINUE - IF (.NOT.WNDSTA('AP_WMP_SET',MXNSET,ASETS,FCAMAP)) THEN !APS TO USE - IF (E_C.EQ.DWC_NULLVALUE .AND. OPT.EQ.'URE') GOTO 28 - GOTO 20 !RETRY FILE - END IF - DO I=1,ASETS(0,0) !ALL LINES - ASETS(4,I)=1 !MAKE SURE AP - END DO - IF (.NOT.NMASTG(FCAMAP,ASETS,APH,APHP,APNAM)) GOTO 28 !NO AP - CALL WNDSTR(FCAMAP,ASETS) !RESET SEARCH STATUS - CALL WNDSTI(FCAMAP,APNAM) !MAKE INDEX - IF (APNAM(4).NE.1) THEN - 28 CONTINUE - IF (OPT.EQ.'URE') THEN - ASETS(0,0)=0 !NO AP - ELSE - CALL WNCTXT(F_TP,'Unknown map set, or not of type AP') - GOTO 22 - END IF - END IF - IF (ASETS(0,0).NE.0 .AND. OPT.NE.'URE') THEN - IF (APHJ(MPH_NRA_J).NE.MPHJ(MPH_NRA_J) .OR. - 1 APHJ(MPH_NDEC_J).NE.MPHJ(MPH_NDEC_J)) THEN - CALL WNCTXT(F_TP,'Map and antenna pattern differ in size') - GOTO 20 - END IF - END IF - IF (OPT.EQ.'UVC') THEN !TEST POWER OF 2 - IF (2**NINT(LOG(FLOAT(APHJ(MPH_NRA_J)))/LOG(2.)).NE. - 1 APHJ(MPH_NRA_J) .OR. - 1 2**NINT(LOG(FLOAT(APHJ(MPH_NDEC_J)))/LOG(2.)).NE. - 1 APHJ(MPH_NDEC_J)) THEN - CALL WNCTXT(F_TP,'Sorry, but I can only cater for power'// - 1 'of 2 sizes') - GOTO 20 - END IF - END IF -C -C AREA -C - 23 CONTINUE - DO I=0,3 - TAREA(I,0)=0 !DEFAULT AREA - FAREA(I)=0 !FULL AREA - MXAREA(I)=0 !MAX. AREA - END DO - FAREA(2)=MPHJ(MPH_NRA_J) !LENGTH LINE - FAREA(3)=MPHJ(MPH_NDEC_J) - DO I=2,3 - MXAREA(I)=FAREA(I) - TAREA(I,0)=31 - IF (OPT.EQ.'UVC' .OR. OPT.EQ.'COM' .OR. - 1 OPT.EQ.'DAT') THEN - TAREA(I,0)=2*(NINT(0.50*MPHJ(MPH_NRA_J+I-2))/2)+1 !MAKE ODD - END IF - END DO - IF (OPT.NE.'URE') THEN !all cleaning options - CALL NMADAR(MXNAR,NAREA,FAREA,3,MXAREA,TAREA(0,0), - 1 PAREA(0,1,0),TAREA(0,1),PAREA(0,1,1)) !GET AREAS - ELSE - NAREA=1 !FORCE FULL MAP - DO I=0,3 - TAREA(I,0)=FAREA(I) - PAREA(I,1,0)=FAREA(I) - END DO - DO I=0,1 - TAREA(2*I,1)=TAREA(I,0)-TAREA(I+2,0)/2 - TAREA(2*I+1,1)=TAREA(I,0)+TAREA(I+2,0)/2-1 - END DO - DO I=0,3 - PAREA(I,1,1)=TAREA(I,1) - END DO - END IF - IF (NAREA.LE.0) GOTO 10 !NO AREA SPECIFIED - I=TAREA(2,0)*TAREA(3,0)*LB_E*3 - IF (OPT.EQ.'BEA' .AND. I.GT.MEMSIZ) THEN -C -C This used to be done by asking CMEMORY_USE with /ASK in the default. -C That did not work, at least not for UNIX (didn't test on VAX). -C Now we ask for a different keyword which has the additional -C advantage that we can supply more extensive help. -C - CALL WNCTXT(F_TP,'Cannot do this area in memory work area') - CALL WNCTXT(F_TP,'You may try to increase the memory size') - IF (.NOT.WNDPAR('DMEMORY_USE', !prompt with I as default value - 1 MEMSIZ,LB_J,J0, - 1 A_B(-A_OB),I/16,1)) THEN - MEMSIZ=I !ASSUME VALUE - ELSE IF (J0.LE.0) THEN - MEMSIZ=I !ASSUME VALUE - END IF - MEMSIZ=16*MEMSIZ+16 !MAKE LARGER - GOTO 23 !RETRY - END IF -C -C LIMITS -C - 24 CONTINUE - IF (OPT.EQ.'DAT') THEN !data - IF (.NOT.WNDPAR('DATA_FACTOR',DATAFAC,LB_E,J0,'1.')) THEN - IF (E_C.EQ.DWC_ENDOFLOOP) GOTO 23 !NEW AREA - GOTO 24 !RETRY - END IF - IF (J0.EQ.0) GOTO 23 - IF (J0.LT.0) DATAFAC=1. - ELSE - DATAFAC=1. - END IF - IF (OPT.EQ.'URE') THEN !restore - IF (.NOT.WNDPAR('MAP_FACTOR',CLFAC,LB_E,J0,'1.')) THEN - IF (E_C.EQ.DWC_ENDOFLOOP) GOTO 23 !NEW AREA - GOTO 24 !RETRY - END IF - IF (J0.EQ.0) GOTO 23 - IF (J0.LT.0) CLFAC=1 - ELSE !all clean operations - IF (OPT.NE.'COM') THEN !Hogbom, Clark - IF (.NOT.WNDPAR('CLEAN_LIMIT',CLLIM,LB_E,J0,'.1')) THEN - IF (E_C.EQ.DWC_ENDOFLOOP) GOTO 23 !NEW AREA - GOTO 24 !RETRY - END IF - IF (J0.EQ.0) GOTO 23 - IF (J0.LE.0) CLLIM=.1 - ELSE - CLLIM=.1 !COMPON operation - END IF - IF (.NOT.WNDPAR('COMPON_LIMIT',SRCLIM,LB_J,J0,'100')) GOTO 24 - IF (J0.EQ.0) GOTO 24 - IF (J0.LE.0) SRCLIM=100 - CMPLOG(1)=MAX(1,SRCLIM/40) - CMPLOG(2)=CMPLOG(1) - IF (.NOT.WNDPAR('COMPON_LOG',CMPLOG,2*LB_J,J0,A_B(-A_OB), - 1 CMPLOG,2)) GOTO 24 - IF (J0.EQ.0) GOTO 24 - IF (J0.LE.0) THEN - CMPLOG(1)=MAX(1,SRCLIM/40) - CMPLOG(2)=CMPLOG(1) - END IF - IF (.NOT.WNDPAR('LOOP_GAIN',CLFAC,LB_E,J0,'.4')) GOTO 24 - IF (J0.EQ.0) GOTO 24 - IF (J0.LE.0) CLFAC=.4 - IF (OPT.NE.'DAT') THEN - IF (.NOT.WNDPAR('PRUSSIAN_HAT',PRHAT,LB_E,J0,'0.')) GOTO 24 - IF (J0.EQ.0) GOTO 24 - IF (J0.LE.0) PRHAT=0 - END IF - IF (OPT.EQ.'UVC') THEN - IF (.NOT.WNDPAR('DECONVOLUTION',LBT,LB_B,J0,'NO')) GOTO 24 - IF (J0.EQ.0) GOTO 24 - IF (J0.LE.0) LBT=.FALSE. - APDCV=LBT - END IF - IF (OPT.EQ.'UVC' .OR. OPT.EQ.'COM' .OR. - 1 OPT.EQ.'DAT') THEN - IF (.NOT.WNDPAR('CYCLE_DEPTH',MPDEP,LB_E,J0,'.05')) GOTO 24 - IF (J0.EQ.0) GOTO 24 - IF (J0.LE.0) MPDEP=.05 - IF (.NOT.WNDPAR('GRATING_FACTOR',GRFAC,LB_E,J0,'1.')) - 1 GOTO 24 - IF (J0.EQ.0) GOTO 24 - IF (J0.LE.0) GRFAC=1. - END IF - END IF -C -C RESIDUAL/RESTORE/MODEL -C - 25 CONTINUE - RONMDL=.FALSE. !NOT RESTORE ONLY - RSTMDL=.FALSE. !NOT RESTORE - IF (OPT.EQ.'URE') THEN - RESMDL=.FALSE. !NO RESIDUAL - RSTMDL=.TRUE. !WANT RESTORE - RONMDL=.TRUE. !RESTORE ONLY - ELSE IF (OPT.NE.'COM') THEN - IF (OPT.NE.'DAT') THEN - IF (.NOT.WNDPAR('RESIDUAL',LBT,LB_B,J0,'YES')) THEN - IF (E_C.EQ.DWC_ENDOFLOOP) GOTO 24 !BACK UP - GOTO 25 - END IF - IF (J0.EQ.0) LBT=.FALSE. !ASSUME NOT - IF (J0.LT.0) LBT=.TRUE. !ASSUME YES - RESMDL=LBT !SAVE RESULT - END IF - IF (OPT.EQ.'UVC' .OR. OPT.EQ.'DAT') THEN - IF (.NOT.WNDPAR('RESTORE',LBT,LB_B,J0,'NO')) THEN - IF (E_C.EQ.DWC_ENDOFLOOP) GOTO 24 !BACK UP - GOTO 25 - END IF - IF (J0.EQ.0) LBT=.FALSE. !ASSUME NOT - IF (J0.LT.0) LBT=.TRUE. !ASSUME YES - RSTMDL=LBT !SAVE RESULT - END IF - END IF - IF (RESMDL .OR. RSTMDL .OR. - 1 OPT.EQ.'DAT') THEN !MAKE WRITEABLE OUTPUT - CALL WNFCL(FCAMAP) - IF (.NOT.WNFOP(FCAMAP,FILMAP,'U')) THEN !OPEN MAP (SHOULD DO) - CALL WNCTXT(F_TP, - 1 'Cannot open !AS for update',FILMAP) - GOTO 20 - END IF - END IF - 26 CONTINUE - IF (OPT.EQ.'URE') THEN - CALL NMODAX(J) !GET MODEL TO RESTORE - IF (J.LE.0) GOTO 25 !NO SOURCES PRESENT - ELSE - IF (.NOT.WNDNOD('OUTPUT_MDL_NODE',' ','MDL','W',NODAP,FILAP)) - 1 GOTO 25 !ASK FOR AUTO MODEL - CALL WNFCL(FCAAP) !SURE NO - IF (E_C.NE.DWC_NULLVALUE .AND. E_C.NE.DWC_WILDCARD) THEN !SPECIFIED - IF (.NOT.WNFOP(FCAAP,FILAP,'U')) THEN - CALL WNCTXT(F_TP,'Cannot open model output file') - GOTO 26 - END IF - END IF - END IF -C -C GET BEAM VALUES -C - 30 CONTINUE - IF (RSTMDL) THEN !RESTORE ASKED - IF (ASETS(0,0).EQ.0) THEN !no antenna pattern, - BMS(1)=12.*1400./MPHD(MPH_FRQ_D) ! so GUESS BEAM - BMS(2)=BMS(1)/ABS(SIN(MPHD(MPH_DEC_D)*PI2)) - BMS(3)=0 - ELSE !fit beam parameters to - ! antenna pattern - CALL WNMLGA(BMAR,LSQ_T_REAL,3) !ZERO SOLUTION - J=APHJ(MPH_NRA_J) !GET BEAM POINTER - J=APHJ(MPH_MDP_J)+LB_E*(J*APHJ(MPH_NDEC_J)/2) - 1 !BEAM LINE ZERO - J2=LB_E*APHJ(MPH_NRA_J) !LENGTH LINE - DO I=0,APHJ(MPH_NDEC_J)/2-1 !DO ALL LINES - IF (.NOT.WNFRD(FCAMAP,J2,LBUF,J)) THEN !READ A LINE - CALL WNCTXT(F_TP,'Read error beam') - CALL WNGEX !STOP - END IF - J=J+J2 !NEXT PTR - BMC(2)=-(FLOAT(I)**2) !EQUATION - DO I1=APHJ(MPH_NRA_J)/2, - 1 APHJ(MPH_NRA_J)-1 !ALL POS. POINTS - IF (LBUF(I1).LT.0.25) GOTO 40 !READY - BMC(1)=-(FLOAT(I1-APHJ(MPH_NRA_J)/2)**2) - BMC(3)=-FLOAT(I1-APHJ(MPH_NRA_J)/2)*FLOAT(I) - CALL WNMLMN(BMAR,LSQ_C_REAL, - 1 BMC,1E0,LOG(LBUF(I1))) !MAKE EQUATION - END DO - 40 CONTINUE - IF (I.NE.0) THEN !OTHER HALF - DO I1=APHJ(MPH_NRA_J)/2-1,0,-1 !ALL NEG. POINTS - IF (LBUF(I1).LT.0.25) GOTO 41 !READY - BMC(1)=-(FLOAT(I1-APHJ(MPH_NRA_J)/2)**2) - BMC(3)=-FLOAT(I1-APHJ(MPH_NRA_J)/2)*FLOAT(I) - CALL WNMLMN(BMAR,LSQ_C_REAL, - 1 BMC,1E0,LOG(LBUF(I1))) !MAKE EQUATION - END DO - END IF - 41 CONTINUE - IF (LBUF(APHJ(MPH_NRA_J)/2).LT.0.25) GOTO 42 !READY - END DO - 42 CONTINUE - IF (.NOT.WNMLTN(BMAR)) THEN !INVERT - BMS(1)=1 !ASSUME 1 GRID POINT - BMS(2)=1 - BMS(3)=0 - ELSE - CALL WNMLSN(BMAR,BMS,BMMU,BMU) !SOLVE - IF (BMS(1).LE.0 .OR. BMS(2).LE.0) THEN - BMS(1)=1 !FORCE - BMS(2)=1 - BMS(3)=0 - ELSE IF (ABS(BMS(3)).LT.1E-6) THEN - BMS(3)=0 !CANNOT SOLVE ANGLE - ELSE - R0=ATAN2(BMS(3),BMS(1)-BMS(2)) !2*ANGLE - BMS(3)=BMS(3)/SIN(R0) !L**2-M**2 - BMS(1)=(BMS(1)+BMS(2)+BMS(3))/2. !L**2 - BMS(2)=BMS(1)-BMS(3) !M**2 - BMS(3)=R0/2. !ANGLE - IF (BMS(1).LE.0) BMS(1)=1 - IF (BMS(2).LE.0) BMS(2)=1 - END IF - END IF - BMS(1)=CVCON*APHD(MPH_SRA_D)*SQRT(1./BMS(1)) !MAKE ARCSEC FWHP - BMS(2)=CVCON*APHD(MPH_SDEC_D)*SQRT(1./BMS(2)) - BMS(3)=180.*BMS(3)/PI !DEGREES - CALL WNMLFA(BMAR) !FREE SOLUTION AREA - END IF - IF (.NOT.WNDPAR('RESTORE_BEAM',BMS,3*LB_E,J0, - 1 A_B(-A_OB),BMS,3)) THEN !ASK BEAM - IF (E_C.EQ.DWC_ENDOFLOOP) GOTO 26 !BACKUP - GOTO 30 !RETRY - END IF - IF (J0.LE.0) GOTO 26 - IF (ASETS(0,0).EQ.0) THEN !DEFAULT BEAM - RESDL=PI*BMS(1)/CVCON/MPHD(MPH_SRA_D)/ - 1 MPHJ(MPH_NRA_J) !MAKE UNITS - RESDM=PI*BMS(2)/CVCON/MPHD(MPH_SDEC_D)/ - 1 MPHJ(MPH_NDEC_J) - RESDAN=+BMS(3)*PI/180. !RADIANS - ELSE - RESDL=PI*BMS(1)/CVCON/APHD(MPH_SRA_D)/ - 1 APHJ(MPH_NRA_J) !MAKE UNITS - RESDM=PI*BMS(2)/CVCON/APHD(MPH_SDEC_D)/ - 1 APHJ(MPH_NDEC_J) - RESDAN=+BMS(3)*PI/180. !RADIANS - END IF - END IF! RSTMDL -C - END IF! clean and restore options -C -C GET MAP MAKE DATA -C - IF (OPT.EQ.'DAT') THEN - CALL NMADAC(FCAMAP,MPHP) - END IF -C - 900 CONTINUE -C - RETURN !READY -C -C - END diff --git a/src/nmap/nclean.for b/src/nmap/nclean.for deleted file mode 100644 index 40ffbd065e24b1dd03b39e9d45505eb3df5b8c12..0000000000000000000000000000000000000000 --- a/src/nmap/nclean.for +++ /dev/null @@ -1,122 +0,0 @@ -C+ NCLEAN.FOR -C WNB 910809 -C -C Revisions: -C WNB 910828 Add RUN -C WNB 921202 Add DATA clean -C CMV 960122 Warning if /NORUN ignored -C - SUBROUTINE NCLEAN -C -C Main routine to clean Map files -C -C Result: -C -C -C Include files: -C - INCLUDE 'WNG_DEF' - INCLUDE 'NCL_DEF' - INCLUDE 'MPH_O_DEF' !MAP HEADER -C -C Parameters: -C -C -C Arguments: -C -C -C Function references: -C - LOGICAL NMASTG !GET A MAP - LOGICAL WNDRUN !TEST RUN -C -C Data declarations: -C - INTEGER MPHP !MAP POINTER - BYTE MPH(0:MPHHDL-1) !MAP HEADER - INTEGER MPHJ(0:MPHHDL/4-1) - EQUIVALENCE (MPH,MPHJ) - INTEGER APHP !AP POINTER - BYTE APH(0:MPHHDL-1) !AP HEADER - INTEGER APHJ(0:MPHHDL/4-1) - EQUIVALENCE (APH,APHJ) -C- -C -C PRELIMINARIES -C - CALL NCLINI !INIT PROGRAM - IF (.NOT.WNDRUN()) - 1 CALL WNCTXT(F_TP,'Ignored option /NORUN') -C -C DISTRIBUTE -C - 10 CONTINUE - CALL NCLDAT !GET USER DATA - IF (OPT.EQ.'HIS') THEN !MAKE HISTOGRAM - IF (.NOT.WNDRUN()) CALL WNGEX !NO RUN - DO WHILE (NMASTG(FCAMAP,MSETS,MPH,MPHP,MAPNAM)) !ALL SETS - CALL WNDSTI(FCAMAP,MAPNAM) !MAKE INDEX - IF (MAPNAM(4).EQ.0) THEN !MAP - CALL NCLHIS(MPHP,0) - ELSE IF (MAPNAM(4).EQ.1) THEN !AP - DO I=0,7 - APNAM(I)=MAPNAM(I) !SET NAME - END DO - NODAP=NODMAP !NODE NAME - CALL NCLHIS(0,MPHP) - END IF - END DO - CALL WNFCL(FCAMAP) !CLOSE INPUT - ELSE IF (OPT.EQ.'BEA') THEN !HOGBOM CLEAN - IF (.NOT.WNDRUN()) CALL WNGEX !NO RUN - IF (NMASTG(FCAMAP,MSETS,MPH,MPHP,MAPNAM)) THEN !GET MAP - CALL WNDSTI(FCAMAP,MAPNAM) !MAKE INDEX - IF (NMASTG(FCAMAP,ASETS,APH,APHP,APNAM)) THEN !GET AP - CALL WNDSTI(FCAMAP,APNAM) !MAKE INDEX - CALL NCLBEA(MPH,APH) !DO CLEAN - END IF - END IF - CALL WNFCL(FCAMAP) !CLOSE FILE - ELSE IF (OPT.EQ.'UVC') THEN !CLARK CLEAN - IF (.NOT.WNDRUN()) CALL WNGEX !NO RUN - IF (NMASTG(FCAMAP,MSETS,MPH,MPHP,MAPNAM)) THEN !GET MAP - CALL WNDSTI(FCAMAP,MAPNAM) !MAKE INDEX - IF (NMASTG(FCAMAP,ASETS,APH,APHP,APNAM)) THEN !GET AP - CALL WNDSTI(FCAMAP,APNAM) !MAKE INDEX - CALL NCLUV(MPHP,APHP) !DO CLEAN - END IF - END IF - CALL WNFCL(FCAMAP) !CLOSE FILE - ELSE IF (OPT.EQ.'DAT') THEN !DATA CLEAN - IF (.NOT.WNDRUN()) CALL WNGEX !NO RUN - IF (NMASTG(FCAMAP,MSETS,MPH,MPHP,MAPNAM)) THEN !GET MAP - CALL WNDSTI(FCAMAP,MAPNAM) !MAKE INDEX - IF (NMASTG(FCAMAP,ASETS,APH,APHP,APNAM)) THEN !GET AP - CALL WNDSTI(FCAMAP,APNAM) !MAKE INDEX - CALL NCLCDT(MPHP,APHP) !DO CLEAN - END IF - END IF - CALL WNFCL(FCAMAP) !CLOSE FILE - ELSE IF (OPT.EQ.'COM') THEN !CLARK CLEAN COMPONENT LIST - IF (.NOT.WNDRUN()) CALL WNGEX !NO RUN - IF (NMASTG(FCAMAP,MSETS,MPH,MPHP,MAPNAM)) THEN !GET MAP - CALL WNDSTI(FCAMAP,MAPNAM) !MAKE INDEX - IF (NMASTG(FCAMAP,ASETS,APH,APHP,APNAM)) THEN !GET AP - CALL WNDSTI(FCAMAP,APNAM) !MAKE INDEX - CALL NCLCMP(MPHP,APHP) !DO CLEAN - END IF - END IF - CALL WNFCL(FCAMAP) !CLOSE FILE - ELSE IF (OPT.EQ.'URE') THEN !CLARK CLEAN - IF (.NOT.WNDRUN()) CALL WNGEX !NO RUN - IF (NMASTG(FCAMAP,MSETS,MPH,MPHP,MAPNAM)) THEN !GET MAP - CALL WNDSTI(FCAMAP,MAPNAM) !MAKE INDEX - CALL NCLUV(MPHP,0) !DO CLEAN - END IF - CALL WNFCL(FCAMAP) !CLOSE FILE - END IF -C - RETURN !READY -C -C - END diff --git a/src/nmap/nclean.psc b/src/nmap/nclean.psc deleted file mode 100644 index 2f3e64aa39f6b465244a4e13866bc2af98c3869c..0000000000000000000000000000000000000000 --- a/src/nmap/nclean.psc +++ /dev/null @@ -1,535 +0,0 @@ -!+ NCLEAN.PSC -! WNB 910809 -! -! Revisions: -! WNB 910828 Add RUN -! WNB 910909 Add DATAB and INFIX -! WNB 910913 New (de-)apply and loops -! WNB 911007 Include instrum. pol. -! WNB 911230 NMODEL -! WNB 920106 Add UVCOVER -! WNB 920114 Add restore -! WNB 920626 Add DCLOW, change Rotation measure description -! WNB 921104 Add J2000 -! WNB 921202 Add DATA clean; change MEMORY_USE to CMEMORY_USE -! WNB 921211 Make PSC -! WNB 921216 Add GRATING_FACTOR -! JEN 930308 INCLUDE=NSETS_PEF, remove keyword MAPS,MAP -! JEN 930308 change keyword AP into AP_SET -! JEN 930312 INCLUDE=NCOMM_PEF -! JEN 930312 Remove keyword(s) INPUT_MAP -! HjV 930426 Change name keyword AP_SET -! CMV 931116 Add DMEMORY_USE for second try if too small -! JPH 940221 Comment out BEAM_TYPE. - Correct language -! CMV 940810 Removed max. check for memory size -! JPH 940913 Correct antenna-pattern prompt -! Remove () from prompts -! JPH 941018 Reorganisation of PEF files -! JPH 941025 Remove SELECT_PEF. -! JPH 941028 Shift in-line comments to new lines. -! Newlines between HELP=" and text -! HjV 941115 Use entire MDLNODE_PEF -! JPH 941201 Help texts, prompt formatting -! CMV 950306 Included HA_RANGE once more (SELECT_PEF) -! HjV 950512 Add DATA_FACTOR -! JPH 960411 Merge changes from 941025 to present -! JPH 991018 Extend memory space [C]MEMORY_USE from 4 to 32 MB -! CMV 050115 Extend memory space to 128MB, components to 100k -! -! -! Work memory size -! Ref: NCLDAT -! -! -KEYWORD=CMEMORY_USE - DATA_TYP=J - IO=I - SWITCH=NULL_VALUES,WILD_CARDS - CHECKS=MINIMUM,MAXIMUM - MINIMUM=32000 - MAXIMUM=128000000 - SEARCH=L,P - DEFAULT=150000 /NOASK - PROMPT="UV-clean memory size" - HELP=" -Specify the work memory size in bytes for the UV Clean option, to be allowed in -defining the beam patch and to be used in executing the Fourier transforms. -. -The default shown is normally adequate; a larger value may speed up the -execution of major cycles in UV Clean. -!. -!NCLEAN will not accept a value in excess of 32000000 (32 MB). -" -! -! Work memory size -! Ref: NCLDAT -! -KEYWORD=DMEMORY_USE - DATA_TYP=J - IO=I - SWITCH=NULL_VALUES,WILD_CARDS - CHECKS=MINIMUM,MAXIMUM - MINIMUM=32000 - MAXIMUM=32000000 - SEARCH=L,P - DEFAULT=300000 - PROMPT="Work memory size" - HELP=" -The memory workspace in bytes needed is 12 times the size of the rectangle -enclosing all selected areas in the map plane. NCLEAN normally allocates up to -300 KB for this purpose. To satisfy the present need, you must either accept -the value suggested here or specify a smaller set of areas, or both. -!. -!NCLEAN will not accept a value in excess of 32000000 (32 MB). -" -! -! Specify clean type -! Ref: NCLDAT -! -KEYWORD=OPTION - DATA_TYPE=C - LENGTH=24 - IO=I - SWITCH=LOOP,NULL_VALUES,WILD_CARDS - SEARCH=L,P - CHECKS=ABBREV_OPT - OPTIONS=BEAM,UVCOVER,DATA, UREST; COMPON,HISTO; QUIT - PROMPT="Operation wanted" - HELP=" -CLEANing: -. - BEAM Hogbom clean: Use the map and the beam to clean. This - method is inaccurate away from the map centre due to the - aliasing associated with visibility gridding. -. - UVCOVER Standard Clark Clean: Find and provisionally subtract sources - in some map areas first (minor cycles), then properly subtract - the sources found (major cycle). The number of minor cycles - between major cycles is determined by the program; the user can - steer this through a few control parameters. - The method suffers from the same limitations as BEAM, but is - faster for cleaning extended sources. -. - DATA Cotton-Schwab Clean: Find sources as in UVCOVER, but perform - the major cycle on the original SCN-file visibilities, making a - new map from the residuals as input for the next major cycle. - This method rigorously avoids the aliasing limitations of BEAM - and UVCOVER, at the price of being very much slower. -. - UREST Use a clean component list and a map to restore the clean - components in the map. -. -For exploring the data before committing more serious work: -. - HISTO Produce only a histogram of selected areas in the map and/or - antenna pattern -. - COMPON Execute minor cycles as for UVCOVER, but omit the following - major cycle. The result is a source model and a map in which - these sources are provisionally subtracted in selected areas. - It is the fastest of the four CLEAN variants but produces an - inaccurate residual map. - This option may be used to quickly get a feel for the - minor-cycle control of UVCOVER and DATA Clean, or to make an - initial data model for NCALIB SELFCAL or NMODEL UPDATE. -. -Other options: -. - QUIT Terminate NCLEAN." -! -! -! Get input map -! Ref: NCLDAT -! -KEYWORD=WMP_SETS0 -!! should be INPUT_MAP - DATA_TYP=C - IO=I - LENGTH=32 - NVALUES=1 !!was 32 - SWITCHES=LOOP,NULL_VALUES,WILD_CARDS - SEARCH=L,P - PROMPT="ONE input map: grp.fld.chn.pol.0.seq" - HELP=" -Specify ONE input map (group.field.channel.polar.type(=0).sequence_number)" -! -! -! Get input antenna pattern -! Ref: NCLDAT -! -KEYWORD=AP_WMP_SET -!! should be ANTENNA_PATTERN - DATA_TYP=C - IO=I - LENGTH=32 - NVALUES=1 !!was 32 - SWITCHES=LOOP,NULL_VALUES,WILD_CARDS - SEARCH=L,P - PROMPT="ONE antenna pattern (grp.fld.chn.pol.1.seq)" - HELP=" -Specify ONE antenna pattern - (group.field.channel.polarisation.type(=1).sequence_number)" -! -! Specify clean sub-type -! Ref: NCLDAT -! -!!KEYWORD=BEAM_TYPE -!! DATA_TYPE=C -!! LENGTH=24 -!! IO=I -!! SWITCH=LOOP,NULL_VALUES,WILD_CARDS -!! SEARCH=L,P -!! CHECKS=ABBREV_OPT -!! OPTIONS=FULL,PATCH -!! PROMPT="Beam action option" -!! HELP=" -!!Specify the type of clean to do: -!! -!!PATCH Use in the clean a contiguous patch area of the beam. This produces -!! a faster minor cycle, but maybe more major cycles if there are -!! grating rings present -!!FULL Use in the clean all points in the beam above a certain level. -!! -!!******************* This option is not yet implemented *******************" -! -! Deconvolution -! Ref: NCLDAT -! -KEYWORD=DECONVOLUTION - DATA_TYP=L - IO=I - SWITCH=NULL_VALUES,WILD_CARDS - SEARCH=L,P - DEFAULT=NO /NOASK - PROMPT="Correct antenna pattern for mapping taper: YES/NO" - HELP=" -The gridding convolution in map-making is usually compensated for by -multiplying the output map and antenna pattern with a taper function that rises -toward the map edges. -. -If this is the case, answering YES here will instruct the program to account -for this effect; this will reduce the aliasing errors in the residual map, -allowing you to clean a somewhat larger part of the map. YES will in general -produce a result with less aliasing, NO the reverse." -! -! Log components -! Ref: NCLDAT -! -KEYWORD=COMPON_LOG - DATA_TYP=J - IO=I - NVALUES=2 - SWITCH=LOOP,VECTOR,NULL_VALUES,WILD_CARDS - CHECKS=MINIMUM - MINIMUM=0,0 - SEARCH=L,P - PROMPT="Reporting interval for components found: | terminal, printer" - HELP=" -You may give two numbers <n> here, indicating that every <n>-th component must -be reported. The first number applies to your terminal window, the second to -the log file. A value of 0 means 'no reporting at all. -. -Example: - 2,0 specifies that every other component will be typed, and none -logged. " -!! default? -! -! Major cycle step depth -! Ref: NCLDAT -! -KEYWORD=CYCLE_DEPTH - DATA_TYP=R - IO=I - SWITCH=LOOP,NULL_VALUE,WILD_CARD - SEARCH=L,P - CHECK=MAXIMUM,MINIMUM - MAXIMUM=1. - MINIMUM=.001 - DEFAULT=.05 /ASK - PROMPT="Major cycle depth" - HELP=" -Specify the level relative to the initial map maximum in the CLEAN window to -which you want to clean in one major cycle." -!! maximum in first or in current major cycle?? -! -! Data multiplication factor -! Ref: NCLDAT -! -KEYWORD=DATA_FACTOR - DATA_TYP=R - IO=I - SWITCH=LOOP,NULL_VALUE,WILD_CARD - SEARCH=L,P - DEFAULT=1. /ASK - PROMPT="Data multiplication factor" - HELP=" -Specify the factor by which to multiply the input map-data. -. -This option is only relevant for DATA clean. The first input-map and all maps -created by DATA clean will be multiplied by this factor." -! -! Map multiplication factor -! Ref: NCLDAT -! -KEYWORD=MAP_FACTOR - DATA_TYP=R - IO=I - SWITCH=LOOP,NULL_VALUE,WILD_CARD - SEARCH=L,P - DEFAULT=1. /ASK - PROMPT="Multiplication factor" - HELP=" -Specify the factor by which to multiply the residual map before restoring. -. -Normally one should use the default value of 1; a value of 0 serves to make a -map of the CLEAN components only." -! -! Clean limit -! Ref: NCLDAT -! -KEYWORD=CLEAN_LIMIT - DATA_TYP=R - IO=I - SWITCH=LOOP,NULL_VALUES,WILD_CARD - SEARCH=L,P - CHECKS=MINIMUM,MAXIMUM - MINIMUM=.00001 - MAXIMUM=1. - DEFAULT=.1 /ASK - PROMPT="Limit in fraction of map maximum" - HELP=" -Specify the level to which to clean in fraction of the initial map maximum." -! -! Number of components -! Ref: NCLDAT -! -KEYWORD=COMPON_LIMIT - DATA_TYP=J - IO=I - SWITCH=LOOP,NULL_VALUE,WILD_CARD - SEARCH=L,P - CHECKS=MINIMUM,MAXIMUM - MINIMUM=1 - MAXIMUM=100000 - DEFAULT=100 /ASK - PROMPT="Maximum number of components to find" - HELP=" -Specify the maximum number of components to be cleaned." -! -! Clean factor -! Ref: NCLDAT -! -KEYWORD=LOOP_GAIN - DATA_TYP=R - IO=I - SWITCH=LOOP,NULL_VALUES,WILD_CARD - SEARCH=L,P - CHECKS=MINIMUM,MAXIMUM - MINIMUM=.01 - MAXIMUM=1. - DEFAULT=.4 /ASK - PROMPT="Clean loop-gain factor" - HELP=" -For each component found, the antenna pattern shifted to its position is -subtracted from the CLEAN window. To prevent overshoots, it is customary to -subtract not the complete component but only a fraction of it. The magnitude of -this fraction is defined here. " -! -! Get area -! Ref: NMADAR -! -KEYWORD=AREA - DATA_TYP=J - IO=I - NVALUES=4 - SWITCHES=LOOP,VECTOR,NULL_VALUES,WILD_CARD - SEARCH=L,P - PROMPT="Window area l,m,dl,dm" - HELP=" -The CLEAN window is defined as the union of up to 32 rectangular areas (which -may arbitrarily overlap). For BEAM clean this is also the window within which -source responses will be subtracted. -. -You are being prompted for these areas one by one until you give a null reply -(<CR> only). An area is specified by four numbers: l,m, dl,dm, where -. - l,m l and m in grid points for the area centre; (l,m)=(0,0) at the map - centre, increasing toward the upper right (i.e. with decreasing RA - and increasing DEC) - dl,dm width and height of the area in grid points " -! -! Major cycle grating correction -! Ref: NCLDAT -! -KEYWORD=GRATING_FACTOR - DATA_TYP=R - IO=I - SWITCH=LOOP,NULL_VALUE,WILD_CARD - SEARCH=L,P - CHECK=MINIMUM - MINIMUM=0. - DEFAULT=1. /ASK - PROMPT="Grating factor" - HELP=" -In the minor cycles of UVCOVER, DATA and COMPON clean, the maximum error made -in only subtracting part of the antenna pattern is estimated by <number of -sources> times <ypical sidelobe level in antenna pattern> times GRATING_FACTOR. -. -You may lower this latter factor if you are not worried about the effects of -far-out sidelobes on the minor-cycle cleaning process. A lower value will allow -more source components to be collected in minor cycles before a major cycle -must be started." -!! -!!When determining the end of a minor cycle, the program also looks at the -!!total influence of parts outside the beam patch on the remaining data. By -!!lowering this factor, this influence will be taken only partly into -!!account. Make it small if you are not worried about the total influence of -!!far-out sidelobes on the result." -! -! Get prussian hat -! Ref: NCLDAT -! -KEYWORD=PRUSSIAN_HAT - DATA_TYP=R - IO=I - SWITCH=LOOP,NULL_VALUE,WILD_CARD - SEARCH=L,P - CHECKS=MAXIMUM,MINIMUM - MAXIMUM=.5 - MINIMUM=0. - PROMPT="Prussian hat value" - HELP=" -For extended sources a prussian hat (i.e. a nominal additional peak value on -the central value of the antenna pattern) may give better clean results. Values -of .1 to .4 could be tried." -! \whichref{Cornwell} -! -! Get residual wanted -! Ref: NCLDAT -! -KEYWORD=RESIDUAL - DATA_TYP=L - IO=I - SWITCH=NULL_VALUE,WILD_CARD - SEARCH=L,P - PROMPT="residual map?" - HELP=" -Specify if the residual map must be written. -. -For BEAM and UVCOVER cleaning, this map is an automatic by-product of the -process and the choice is whether or not to write it to the .WMP file. The map -will be given the same indices as the input map except for an incremented -sequence number. -. -For UVDAT cleaning, the residual map must be constructed by making a new map -from the original visibilities, in which the CLEAN components just found are -subtracted. The new map will OVERWRITE the input map." -! {\em See elsewhere for the\ -! \textref{rationale}{nclean_descr.residual.map} } -! -! Get restored wanted -! Ref: NCLDAT -! -KEYWORD=RESTORE - DATA_TYP=L - IO=I - SWITCH=NULL_VALUE,WILD_CARD - SEARCH=L,P - PROMPT="restored map (YES/NO)?" - HELP=" -Specify if a restored map must be written. -. -A restored map consists of the CLEAN components convolved with a hypothetical -beam that has no sidelobes, superimposed on the residuals. It is an -approximation to what you would have observed with complete contiguous UV -coverage (hoth in hour angle and baseline) up to the longest baseline available. -. -You will be given the option to suppress the residuals (parameter MAP_FACTOR), -in which case you get a map of the CLEAN components only." -! -! Get restore beam -! Ref: NCLDAT -! -KEYWORD=RESTORE_BEAM - DATA_TYP=R - IO=I - NVALUES=3 - SWITCH=LOOP,VECTOR,NULL_VALUE,WILD_CARD - SEARCH=L,P - PROMPT="dl, dm arcsec, pa deg" - HELP=" -Specify the restore beam width: -. - dl width of beam in arcsec (full-halfwidth) -. - dm width of beam in arcsec (full-halfwidth) -. - pa position angle of skewed beam in degrees (anti-clockwise; - 0 deg is horizontally to the right (+l direction) -. -The default beam is a two-dimensional Gaussian truncated at a level of .xx -relative to the maxiumum. If an antenna pattern for your map is available, the -l,m beam widths are derived from it; else a rule-of-thumb formula is used: -. - half-width = 12 arcsec * 1400/frequency(MHz) " -!! How about RA, DEC widths? -! -! Clip area -! Ref: NMADAT -! -KEYWORD=CLIP_AREA - DATA_TYP=R - IO=I - NVALUES=2 - SWITCH=LOOP,VECTOR - CHECK=MINIMUM - MINIMUM=0.,0. -!! UNITS="m" - PROMPT="UV-radius range for clipping (m)" - DEFAULTS=0.,100000. - SEARCH=L,P - HELP=" -Specify the (circular) UV-plane radii (in metres) between which you want to -clip the data. The default is to clip everywhere." -! -! Clip levels -! Ref: NMADAT -! -KEYWORD=CLIP_LEVELS - DATA_TYP=R - IO=I - NVALUES=2 - SWITCH=LOOP,VECTOR - CHECKS=NON_DESCENDING - SEARCH=L,P - PROMPT="Amplitude range to be discarded" - DEFAULTS=100000.,100000. - HELP=" -Specify amplitude range (in Westerbork Units) of visibility magnitudes that you -want to discard. -. -In the annulus defined by CLIP_AREA, values between the limits you specify will -be discarded. -! {\em parameter \textref{CLIP_AREA}{.clip.area} } -. -NOTE: It would be more natural to define a range within which visibilities are -considered valid. As it is, only the lower limit is actually useful, allowing -you to define a rejection threshold for interference. To do so, specify your -threshold for the lower and 'infinity' for the upper limit, e.g. -. - <threshold>,100000 " -!- -INCLUDE=NMAP_PEF ! for data clean -!- -INCLUDE=NGEN_PEF -!- -INCLUDE=WMPNODE_PEF ! -INCLUDE=WMPSETS_PEF ! -!- -INCLUDE=MDLNODE_PEF ! -INCLUDE=NMODEL_PEF ! -!- -INCLUDE=SCNNODE_PEF:SCN_NODE ! -INCLUDE=SCNSETS_PEF ! -INCLUDE=SELECT_PEF -!- diff --git a/src/nmap/nclfun.for b/src/nmap/nclfun.for deleted file mode 100644 index f2697d0f21d4a7505dfa39ac1da39c58b9a00d54..0000000000000000000000000000000000000000 --- a/src/nmap/nclfun.for +++ /dev/null @@ -1,145 +0,0 @@ -C+ NCLFUN.FOR -C WNB 910809 -C -C Revisions: -C - SUBROUTINE NCLFD2(BUF,LEN) -C -C General functions for NCLEAN programs -C -C Result: -C -C CALL NCLFD2( BUF_E(0:LEN-1):IO, LEN_J:I) -C Divide BUF by 2 -C CALL NCLFCJ( CBUF_X(0:LEN-1):IO, LEN_J:I) -C Take conjugate of CBUF -C CALL NCLFAM( MUL_E:I, BUF0_E(0:LEN-1):I, BUF1_E(0:LEN-1):IO, LEN1_J:I) -C Add BUF to MUL*BUF1 -C CALL NCLFSM( MUL_E:I, BUF0_E(0:LEN-1):I, BUF1_E(0:LEN-1):IO, LEN1_J:I) -C Subtract BUF1 from MUL*BUF -C CALL NCLFS2( MUL_E:I, MUL2_E:I, BUF1_E(0:LEN-1):I, BUF2_E(0:LEN-1):I, -C LEN2_J:I) -C Subtract MUL*BUF1 from MUL2*BUF -C CALL NCLFBM( L_J:I, LEN_J:I, FDL_E:I, FDM_E:I, FDA_E:I, -C BUF3_E(0:LEN-1):O, SUM_E:O) -C Fill BUF with transformed beam -C CALL NCLF1D( BUF_E(0:LEN-1):IO, LEN_J:I) -C Take 1/buffer -C -C -C Include files: -C - INCLUDE 'WNG_DEF' -C -C Parameters: -C -C -C Arguments: -C - REAL MUL !MULTIPLIERS - REAL MUL2 - REAL BUF(0:*) !BUFFER TO DO - REAL BUF0(0:*) - REAL BUF1(0:*) - REAL BUF2(0:*) - REAL BUF3(0:*) - COMPLEX CBUF(0:*) !BUFFER TO DO - INTEGER LEN !BUFFER LENGTH - INTEGER LEN1 - INTEGER LEN2 - INTEGER L !LINE TO DO - REAL FDL !WIDTH L - REAL FDM !WIDTH M - REAL FDA !ROTATION ANGLE - REAL SUM !SUM AP -C -C Function references: -C -C -C Data declarations: -C - REAL R2 -C- -C -C DIVIDE BY 2 -C - DO I=0,LEN-1 - BUF(I)=BUF(I)/2 - END DO -C - RETURN -C -C TAKE CONJUGATE -C - ENTRY NCLFCJ(CBUF,LEN) -C - DO I=0,LEN-1 - CBUF(I)=CONJG(CBUF(I)) - END DO -C - RETURN -C -C ADD BUFFERS -C - ENTRY NCLFAM(MUL,BUF0,BUF1,LEN1) -C - DO I=0,LEN1-1 - BUF1(I)=MUL*BUF1(I)+BUF0(I) - END DO -C - RETURN -C -C SUBTRACT BUFFERS -C - ENTRY NCLFSM(MUL,BUF0,BUF1,LEN1) -C - DO I=0,LEN1-1 - BUF1(I)=BUF0(I)-MUL*BUF1(I) - END DO -C - RETURN -C -C SUBTRACT BUFFERS -C - ENTRY NCLFS2(MUL,MUL2,BUF1,BUF2,LEN2) -C - DO I=0,LEN2-1 - BUF2(I)=MUL2*BUF1(I)-MUL*BUF2(I) - END DO -C - RETURN -C -C MAKE GAUSSIAN WEIGHT BUFFER -C - ENTRY NCLFBM(L,LEN,FDL,FDM,FDA,BUF3,SUM) -C - R0=(FLOAT(L)**2)*((FDL*COS(FDA))**2+(FDM*SIN(FDA))**2) - R1=(FDL*SIN(FDA))**2+(FDM*COS(FDA))**2 - R2=FDL*FDL*SIN(2.*FDA)-FDM*FDM*SIN(2.*FDA) - IF (L.EQ.0) R0=R0+LOG(2.) !FOR HALF FFT - I1=LEN/2 - DO I=1,I1-1 - BUF3(I+I1)=EXP(-(R0+(FLOAT(I)**2)*R1+ - 1 FLOAT(L)*FLOAT(I)*R2)) - BUF3(I1-I)=EXP(-(R0+(FLOAT(I)**2)*R1- - 1 FLOAT(L)*FLOAT(I)*R2)) - SUM=SUM+BUF3(I+I1)+BUF3(I1-I) - END DO - BUF3(I1)=EXP(-R0) - BUF3(0)=EXP(-(R0+FLOAT(I1)*FLOAT(I1)*R1+FLOAT(L)*FLOAT(I1)*R2)) - SUM=SUM+BUF3(I1)+BUF3(0) -C - RETURN -C -C TAKE INVERSE -C - ENTRY NCLF1D(BUF,LEN) -C - DO I=0,LEN-1 - IF (BUF(I).NE.0) BUF(I)=1./BUF(I) - END DO -C - RETURN -C -C - END diff --git a/src/nmap/nclhim.for b/src/nmap/nclhim.for deleted file mode 100644 index 767f861ddf3c0ed998cae8ccf8d5c97566245d2b..0000000000000000000000000000000000000000 --- a/src/nmap/nclhim.for +++ /dev/null @@ -1,169 +0,0 @@ -C+ NCLHIM.FOR -C WNB 910809 -C -C Revisions: -C JPH 940224 Comments -C CMV 950616 Account for DATAFAC in map limits -C -C - SUBROUTINE NCLHM0(LPHAD,MPHP) -C -C Determine histograms -C -C Result: -C -C CALL NCLHM0( LPHAD_J:O, MPHP_J:I) -C Determine the map histogram for selected areas. -C The map header is assumed at MPHP, and the -C histogram area is returned in LPHAD. -C CALL NCLHM9( LPHAD_J:IO) -C Clear the map histogram -C CALL NCLHB0( LPHAD_J:O, MPHP_J:I) -C Determine the beam histogram. -C The beam header is assumed at MPHP, and the -C histogram area is returned in LPHAD. -C CALL NCLHB9( LPHAD_J:IO) -C Clear the beam histogram -C -C Include files: -C - INCLUDE 'WNG_DEF' - INCLUDE 'MPH_O_DEF' !MAP HEADER - INCLUDE 'NCL_DEF' -C -C Parameters: -C -C -C Arguments: -C - INTEGER LPHAD !HISTOGRAM AREA - INTEGER MPHP !MAP HEADER POINTER -C -C Function references: -C - LOGICAL WNFRD !READ DISK - CHARACTER*32 WNTTSG !MAP NAME -C -C Data declarations: -C - BYTE MPH(0:MPHHDL-1) !MAP HEADER - INTEGER MPHJ(0:MPHHDL/4-1) - REAL MPHE(0:MPHHDL/4-1) - EQUIVALENCE (MPH,MPHJ,MPHE) - REAL BUF(0:8191) !MAP LINE -C- -C -C HM0 -C -C -C GET MAP HEADER -C - IF (.NOT.WNFRD(FCAMAP,MPHHDL,MPH,MPHP)) THEN - 10 CONTINUE - CALL WNCTXT(F_TP,'Error reading map') - CALL WNGEX !STOP PROGRAM - END IF -C -C Allocate histogram buffer, initialise its range with max. abs. value in map -C - CALL WNMHS8(LPHAD,+1,MAX(ABS(MPHE(MPH_MAX_E)*DATAFAC), - 1 ABS(MPHE(MPH_MIN_E)*DATAFAC))) !GET HISTO BUFFER -C -C Fill histogram with all lines in selected areas -C - DO I=TAREA(2,1),TAREA(3,1) !ALL LINES - IF (.NOT.WNFRD(FCAMAP,LB_E*MPHJ(MPH_NRA_J), - 1 BUF,MPHJ(MPH_MDP_J)+ - 1 (I+MPHJ(MPH_NDEC_J)/2)*LB_E*MPHJ(MPH_NRA_J))) - 1 GOTO 10 !ERROR - IF (DATAFAC.NE.1.) THEN !NEED TO MULTIPLY - DO I1=1,MPHJ(MPH_NRA_J) - BUF(I1)=BUF(I1)*DATAFAC !MULTIPLY BUFFER - END DO - END IF - J2=-32768 !START POINT - DO I1=1,NAREA !ALL AREAS - IF (I.GE.PAREA(2,I1,1) .AND. I.LE.PAREA(3,I1,1)) THEN !THIS LINE - J2=MAX(J2,PAREA(0,I1,1)) !START POINT - J1=PAREA(1,I1,1)-J2+1 !LENGTH - CALL WNMHS1(LPHAD,J1, - 1 BUF(J2+MPHJ(MPH_NRA_J)/2)) !HISTO DATA - J2=PAREA(1,I1,1)+1 !NEXT START POINT - END IF !END SUB-AREA - END DO !END SUB AREAS - END DO !END LINES -C -C SHOW HISTO DATA -C - CALL WNCFHD(F_P,4,'Node: !AS Map: !AS(#!UJ) Field: !AL12', - 1 NODMAP,WNTTSG(MAPNAM,0), - 1 MPH(MPH_SETN_1),MPH(MPH_FNM_1)) - CALL WNCFHD(F_P,5,' ') - CALL WNMHS3(LPHAD,1,F_P) !SHOW HISTOGRAM - CALL WNMHS4(LPHAD,R0,F_P) !GET NOISE - CALL WNCFHD(F_P,-4,' ') !DELETE HEADER - CALL WNCFHD(F_P,-5,' ') -C - RETURN -C -C HM9 -C - ENTRY NCLHM9(LPHAD) -C - CALL WNMHS9(LPHAD) !CLEAR HISTOGRAM -C - RETURN -C -C HB0 -C - ENTRY NCLHB0(LPHAD,MPHP) -C -C GET beam HEADER: MPHP is the beam header pointer -C - IF (.NOT.WNFRD(FCAMAP,MPHHDL,MPH,MPHP)) THEN - 20 CONTINUE - CALL WNCTXT(F_TP,'Error reading beam') - CALL WNGEX !STOP PROGRAM - END IF -C -C Allocate a histogram buffer whose length is 1/2* the minimum of the -C horizontal size and the vertical size of the beam -C - CALL WNMHB0(LPHAD,+1, - 1 MIN(MPHJ(MPH_NRA_J),MPHJ(MPH_NDEC_J))/2) !GET BUFFER -C -C DO ALL LINES in the lower half of the beam -C - I1=MIN(2*TAREA(2,0),MPHJ(MPH_NRA_J)) !LENGTH LINE - DO I=-MIN(TAREA(3,0),MPHJ(MPH_NDEC_J)/2),0 !ALL NEGATIVE LINES - IF (.NOT.WNFRD(FCAMAP,LB_E*MPHJ(MPH_NRA_J), - 1 BUF,MPHJ(MPH_MDP_J)+ - 1 (I+MPHJ(MPH_NDEC_J)/2)*LB_E*MPHJ(MPH_NRA_J))) - 1 GOTO 20 !ERROR - CALL WNMHB1(LPHAD,I1, - 1 BUF(-I1/2+MPHJ(MPH_NRA_J)/2),I) !HISTO DATA - END DO !END LINES -C -C SHOW HISTO DATA -C - CALL WNCFHD(F_P,4,'Node: !AS Beam: !AS(#!UJ) Field: !AL12', - 1 NODAP,WNTTSG(APNAM,0), - 1 MPH(MPH_SETN_1),MPH(MPH_FNM_1)) - CALL WNCFHD(F_P,5,' ') - CALL WNMHB2(LPHAD,F_P) !SHOW HISTOGRAM - CALL WNCFHD(F_P,-4,' ') !DELETE HEADER - CALL WNCFHD(F_P,-5,' ') - -C - RETURN -C -C HB9 -C - ENTRY NCLHB9(LPHAD) -C - CALL WNMHB9(LPHAD) !CLEAR HISTOGRAM -C - RETURN -C -C - END diff --git a/src/nmap/nclhis.for b/src/nmap/nclhis.for deleted file mode 100644 index a6d8912553a787847906fb5afe25c2e01a3e2221..0000000000000000000000000000000000000000 --- a/src/nmap/nclhis.for +++ /dev/null @@ -1,174 +0,0 @@ -C+ NCLHIS.FOR -C WNB 910809 -C -C Revisions: -C WNB 920103 Add HID -C WNB 920131 Change accumulation -C JPH 940224 Comments -C -C - SUBROUTINE NCLHIS(MPHP,APHP) -C -C Determine histograms -C -C Result: -C -C CALL NCLHIS ( MPHP_J:I, APHP_J:I) -C Determine the beam and map histograms. -C The MAP is assumed at MPHP, the beam -C at APHP. Dynamic memmory allocated for the -C histograms is pointed at by -C COMMON variables BMHAD and MPHAD, which are -C indices into the array A_J -C CALL NCLHID ( MPHP_J:I, APHP_J:I) -C Determine histograms as above plus the beam -C patch size and associated parameters in -C COMMON variables: -C BEMPAT beam-patch size -c MAPLIM map-data limit in patch -C MAPPAT nr of pts in map patch -C CLBXLM max. corrn. outside patch -C CALL NCLHIE ( MPHP_J:I, APHP_J:I) -C Determine beam patch size (BEMPAT) and -C associated parameters -C CALL NCLHIX ( MPHP_J:I, APHP_J:I) -C Deallocate beam histogram buffer -C -C Include files: -C - INCLUDE 'WNG_DEF' - INCLUDE 'MPH_O_DEF' !MAP HEADER - INCLUDE 'NCL_DEF' -C -C Parameters: -C -C -C Arguments: -C - INTEGER MPHP !MAP POINTER - INTEGER APHP !AP POINTER -C -C Function references: -C -C -C Data declarations: -C - LOGICAL LHID !HID SWITCH - INTEGER BMSIZ,MPSIZ !HISTO SIZES - INTEGER BMPTR,MPPTR !HISTO POINTERS - REAL MPMAX !MAP HISTO DATA -C- -C -C HIS -C - LHID=.FALSE. !NOT PATCH - GOTO 10 -C -C HID -C - ENTRY NCLHID(MPHP,APHP) -C - LHID=.TRUE. - GOTO 10 -C -C make BEAM HISTOGRAM -C - 10 CONTINUE - IF (APHP.NE.0) THEN - CALL NCLHB0(BMHAD,APHP) !make histogram of entire beam, - ! BMHAD points to histogram bufr - IF (LHID) - 1 CALL WNMHB6(BMHAD,BMSIZ,BMPTR) !make cumulative BEAM histogram, - ! set size and pointer for it, - ! but do nothing with it yet - END IF -C -C make MAP HISTOGRAM -C - IF (MPHP.NE.0) THEN !MAKE MAP HISTO - CALL NCLHM0(MPHAD,MPHP) !MPHAD points to histogram bufr - END IF - GOTO 30 -C -C HIE -C - ENTRY NCLHIE(MPHP,APHP) -C - LHID=.TRUE. - GOTO 30 -C -C GET PATCH -C NOTE: THe lower-case comments in this section are tentative, -C it is not really clear what happers here -C - 30 CONTINUE - IF (LHID .AND. MPHP.NE.0 .AND. APHP.NE.0) THEN - CALL WNMHB7(BMHAD,BMSIZ,BMPTR) !GET len and ptr to beam hgram - CALL WNMHS6(MPHAD,MPSIZ,MPPTR, !GET len and ptr to cumulative - ! map hgram. plus the maximum - 1 MPHMXI,MPMAX) ! value found and the range - ! of the histogram - J=MNBPAT !MIN. BEAM PATCH -C -C MNBPAT (=3) defines the smallest patch size allowed -C MXBPAT (=...) defines an absolute largest patch size -C The patch can not be larger than the beam and is further limited by the -C horizontal and vertical sizes of the union of all selected areas -C - DO I=MNBPAT,MIN(BMSIZ-1,MXBPAT, - 1 MAX(TAREA(2,0),TAREA(3,0))) !try successively larger patches - R0=A_E(BMPTR+I) !BEAM FRACTION TO CATER = - ! largest beam value within - ! patch size being tried - I0=INT(R0*MPSIZ*MPHMXI/MPMAX) !CORRESPONDING MAP PTR - IF ((2*I+1)*(I+1)+2*A_J(MPPTR+I0) - 1 .GT.MEMSIZ/LB_E) GOTO 20 !TOO LARGE - J=I !CAN FIT MORE - IF ((I0*MPMAX)/MPSIZ - 1 .LT.MPDEP*MPHMXI) GOTO 20 !DEEP ENOUGH - END DO -C - 20 CONTINUE - BEMPAT=J -C -C We now have a beam patch size -C - I0=INT(A_E(BMPTR+J)*MPSIZ*MPHMXI/MPMAX)!MAP HISTO PTR - IF (BEMPAT.EQ.MNBPAT) THEN !LIMIT TO CYCLE DEPTH - DO WHILE(I0.LT.MPSIZ .AND. - 1 (I0*MPMAX)/MPSIZ.LT. - 1 MPDEP*MPHMXI) - I0=I0+1 - END DO - I0=MAX(0,I0-1) !GO ONE BACK - END IF - MAPLIM=(I0*MPMAX)/MPSIZ !MAP LIMIT - MAPPAT=A_J(MPPTR+I0) !# OF POINTS IN BUF - CLBXLM=A_E(BMPTR+J+1) !MAX. CORRECTION OUTSIDE - END IF -C -C CLEAR HISTOGRAMS -C - IF (MPHP.NE.0) THEN - CALL NCLHM9(MPHAD) !free MAP HISTO buffer - END IF - GOTO 40 -C -C HIX -C - ENTRY NCLHIX(MPHP,APHP) -C - LHID=.FALSE. - GOTO 40 -C -C CLEAR BEAM HISTOGRAM -C - 40 CONTINUE - IF (APHP.NE.0 .AND. .NOT.LHID) THEN - CALL NCLHB9(BMHAD) !free BEAM HISTO buffer - END IF -C - RETURN -C -C - END diff --git a/src/nmap/nclini.for b/src/nmap/nclini.for deleted file mode 100644 index f2b1c8a1414af049bd4670749aff389a0174d42b..0000000000000000000000000000000000000000 --- a/src/nmap/nclini.for +++ /dev/null @@ -1,53 +0,0 @@ -C+ NCLINI.FOR -C WNB 910809 -C -C Revisions: -C - SUBROUTINE NCLINI -C -C Initialize NCLEAN program -C -C Result: -C -C CALL NCLINI will set header lines, logging, DWARF interface -C -C Include files: -C - INCLUDE 'WNG_DEF' - INCLUDE 'NCL_DEF' -C -C Parameters: -C -C -C Arguments: -C -C -C Function references: -C - LOGICAL WNDINI !INIT DWARF - LOGICAL WNDDAB !OPEN DATABASE -C -C Data declarations: -C -C- -C -C SET HEADER LINES -C - CALL WNCFHD(F_P,1,'!40C\Program to clean MAP files') -C -C START DWARF -C - IF (.NOT.WNDINI(PRGNAM)) CALL WNGEX !EXIT IF NO DWARF START -C -C LOGGING -C - CALL WNDLOG(LOGCD) !PROPER LOGGING -C -C DATABASE -C - IF (.NOT.WNDDAB()) CALL WNGEX !OPEN DATABASE -C - RETURN !READY -C -C - END diff --git a/src/nmap/ncluc1.for b/src/nmap/ncluc1.for deleted file mode 100644 index b68a424f3a8f292d62e373e3e2b0ce84ba864334..0000000000000000000000000000000000000000 --- a/src/nmap/ncluc1.for +++ /dev/null @@ -1,210 +0,0 @@ -C+ NCLUC1.FOR -C WNB 920106 -C -C Revisions: -C WNB 931006 Text -C WNB 931124 Limit source positions to within map -C JPH 940224 Comments - Check map limits also for non-clean -C components -C -C - SUBROUTINE NCLUC1(STSRC,NDSRC,NLIN,MLIN,BLIN,WLIN1,WLIN2, - 1 MDHJ,MPH,APH,EXBUF) -C -C Clean/restore 1 map line using transformed beam -C -C Result: -C CALL NCLUC1 ( STSRC_J:I, NDSRC_J:I, NLIN_J:I, MLIN_X(0:*):IO, -C BLIN_E(0:*):I, WLIN1_X(0:*):I, WLIN2_X(0:*):I, -C MDHJ_J(*):I, MPH_B(*):I, APH_B(*):I, -C EXBUF_E(*):O) -C Clean/restore sources STSRC until NDSRC using -C the beam line in BLIN from the map line in -C MLIN. -C NLIN is the line number. WLIN1 is the -C FFT cos/sin buffer, WLIN2 its conjugate -C (sin --> -sin), EXBUF a buffer that can be used -C for extended-source weights. -C MPH and APH are the map and beam headers, -C MDH the model header -C -C NOTES: -C This routine is part of NCLUCL and can only be understood in -C connection with it. It is used first to subtract source components and later -C to restore them. -C NCLUCL calls this routine with MLIN cleared. -C The transformed beam is in transposed format, so BLIN in fact contains -C a column of the beam. Correspondingly, MLIN is used to hold a column of -C the map and WLINB1/2 contain cos/sin tables for the FFT in the DEC direction. -C It is assumed that the source model may contain non-clean point sources. -C These are forced onto the nearest grid point. -C -C -C Include files: -C - INCLUDE 'WNG_DEF' - INCLUDE 'MPH_O_DEF' !MAP HEADER - INCLUDE 'MDH_O_DEF' !MODEL HEADER - INCLUDE 'MDL_O_DEF' !MODEL LINE - INCLUDE 'NCL_DEF' -C -C Parameters: -C -C -C Arguments: -C - INTEGER STSRC !START SOURCE # - INTEGER NDSRC !END SOURCE # - INTEGER NLIN !MAP LINE # - COMPLEX MLIN(0:*) !MAP LINE - REAL BLIN(0:*) !BEAM LINE - COMPLEX WLIN1(0:*) !FFT WEIGHT LINE - COMPLEX WLIN2(0:*) !FFT CONJUGATE WEIGHT LINE - INTEGER MDHJ(0:*) !MODEL HEADER - BYTE MPH(0:*) !MAP HEADER - BYTE APH(0:*) !BEAM HEADER - REAL EXBUF(0:*) !WEIGHT FOR EXTENDED SOURCES -C -C Function references: -C - INTEGER WNGGJ !GET J VALUE - DOUBLE PRECISION WNGGD !GET D VALUE -C -C Data declarations: -C - INTEGER JNRA,JNDC !MAP SIZES - INTEGER JRA2,JDC2,JRAM1,JDCM1 - REAL BMS(3) !EXTENSIONS - COMPLEX C0,C1,C2 - REAL R2 -C- - JNDC=WNGGJ(APH(MPH_NDEC_1)) !# OF LINES - JNRA=WNGGJ(APH(MPH_NRA_1)) !LINE LENGTH - JRA2=-JNRA/2 !MAP LIMITS from -n to +n-1 - JDC2=-JNDC/2 - JRAM1=-JRA2-1 - JDCM1=-JDC2-1 -C -C Do a slow Fourier transform of the clean components in the l direction -C using buffer MLIN to hold a single column of the source transform -C Check that the source is within the map, lest sources outside are aliased into -C it by the FFT -C - DO I=MAX(0,STSRC-1),NDSRC-1 !ALL SOURCES - J0=(MDHJ(MDH_MODP_J)+ - 1 I*MDLHDL-A_OB)/LB_E !MODEL POINTER - I0=A_B(J0*LB_E+MDL_TP_B) !BITS - IF (A_E(J0+MDL_I_E).NE.0 .AND. - 1 IAND(I0,MDLCLN_M).NE.0) THEN !NOT DELETED AND a CLEAN comp. - I1=NINT((A_E(J0+MDL_M_E)/PI2- !SRC POS. M LINE - 1 WNGGD(MPH(MPH_SHD_1)))/ ! SHD= DEC shift - 1 WNGGD(MPH(MPH_SDEC_1))) ! SDEC= DEC grid spacing - I2=NINT((A_E(J0+MDL_L_E)/PI2- - 1 WNGGD(MPH(MPH_SHR_1)))/ - 1 WNGGD(MPH(MPH_SRA_1))) !L - IF (I1.GT.JDC2 .AND. I1.LT.JDCM1 - 1 .AND. I2.GT.JRA2 - 1 .AND. I2.LT.JRAM1) THEN !SOURCE IN MAP - R0=PI2*I2*NLIN/JNRA !PHASE OF SOURCE - C0=-A_E(J0+MDL_I_E)* - 1 CMPLX(COS(R0),SIN(R0)) !SOURCE COMPONENT - IF (I1.LT.0) I1=JNDC+I1 !SWAP - MLIN(I1)=MLIN(I1)+C0 !PUT SRC IN LINE (SWAPPED!) - END IF - END IF - END DO -C -C TRANSFORM SOURCE column TO PROPER UV: m-direction transform -C - CALL WNMFTC(APH(MPH_NDEC_1),MLIN,WLIN1) !DO FFT -C -C DO non-clean POINT SOURCES - similar to above. Th -C Such point sources may have been entered in the model by other mechanisms -C than Clean and therefore are not necessarily on grid points. - -C - DO I=MAX(0,STSRC-1),NDSRC-1 !ALL SOURCES - J0=(MDHJ(MDH_MODP_J)+I*MDLHDL-A_OB)/LB_E !MODEL POINTER - I0=A_B(J0*LB_E+MDL_TP_B) !BITS - IF (A_E(J0+MDL_I_E).NE.0 .AND. - 1 IAND(I0,MDLCLN_M).EQ.0) THEN !NOT DELETED AND NOT CLEAN - R1=(A_E(J0+MDL_M_E)/PI2- - 1 WNGGD(MPH(MPH_SHD_1)))/ - 1 WNGGD(MPH(MPH_SDEC_1)) !SRC POS. M LINE - R2=(A_E(J0+MDL_L_E)/PI2- - 1 WNGGD(MPH(MPH_SHR_1)))/ - 1 WNGGD(MPH(MPH_SRA_1)) !L - IF (R1.GT.JDC2 .AND. R1.LT.JDCM1 - 1 .AND.R2.GT.JRA2 - 1 .AND. R2.LT.JRAM1) THEN !SOURCE IN MAP - R0=PI2*R2*NLIN/JNRA !L PHASE OF SOURCE - C0=-A_E(J0+MDL_I_E)* - 1 CMPLX(COS(R0),SIN(R0)) !L SOURCE COMPONENT - C1=EXP(CMPLX(0.,PI2*R1/JNDC)) !M PHASE STEP - C2=C0 - IF (A_E(J0+MDL_EXT_E+2).EQ.0 .AND.!NOT EXTENDED - 1 A_E(J0+MDL_EXT_E+1) - 1 -A_E(J0+MDL_EXT_E).EQ.0) THEN - MLIN(0)=MLIN(0)+C0 !SET SOURCE - DO I1=1,JNDC/2 - C0=C0*C1 !NEXT DATA - C2=C2*CONJG(C1) - MLIN(I1)=MLIN(I1)+C0 !PUT SOURCE IN LINE - MLIN(JNDC-I1)=MLIN(JNDC-I1)+C2 - END DO - ELSE !EXTENDED - CALL NMOEXT(A_E(J0)) !EXTERNAL FORMAT - R0=2.*3600.*360.*SQRT(LOG(2.)) !CONVERSION ARCSEC/INTERNAL - BMS(1)=0.5*PI*A_E(J0+MDL_EXT_E+0) - 1 /R0/WNGGD(APH(MPH_SRA_1))/ - 1 JNRA !MAKE UNITS - BMS(2)=0.5*PI*A_E(J0+MDL_EXT_E+1) - 1 /R0/WNGGD(APH(MPH_SDEC_1))/ - 1 JNDC - BMS(3)=-A_E(J0+MDL_EXT_E+2) - 1 *PI/180. !RADIANS - IF (NLIN.EQ.0) THEN !GET NORM. WEIGHT FIRST - A_E(J0+MDL_RS_E)=0 !START NORM - DO I1=0,JNRA/2 - CALL NCLFBM(I1,JNDC,BMS(1), - 1 BMS(2),BMS(3), - 1 EXBUF,A_E(J0+MDL_RS_E)) !MAKE WEIGHTS - END DO - A_E(J0+MDL_RS_E)=JNRA*JNDC/4 - 1 /A_E(J0+MDL_RS_E) !NORM. WEIGHT - END IF - CALL NCLFBM(NLIN,JNDC,BMS(1), - 1 BMS(2),BMS(3), - 1 EXBUF,R1) !MAKE WEIGHTS - C0=C0*A_E(J0+MDL_RS_E) - C2=C2*A_E(J0+MDL_RS_E) - MLIN(0)=MLIN(0)+EXBUF(JNDC/2)*C0!SET SOURCE - DO I1=1,JNDC/2 - C0=C0*C1 !NEXT DATA - C2=C2*CONJG(C1) - MLIN(I1)=MLIN(I1)+EXBUF(JNDC/2+I1)*C0 !PUT SOURCE IN LINE - MLIN(JNDC-I1)=MLIN(JNDC-I1)+EXBUF(JNDC/2-I1)*C2 - END DO - CALL NMOEXF(A_E(J0)) !INTERNAL FORMAT - END IF - END IF - END IF - END DO -C -C WEIGHT column with beam column -C - CALL WNMFCS(APH(MPH_NDEC_1),MLIN) !SWAP HALVES - DO I=0,JNDC-1 - MLIN(I)=MLIN(I)*BLIN(I) - END DO -C -C FIRST PART MAP TRANSFORM -C - CALL WNMFCS(APH(MPH_NDEC_1),MLIN) !SWAP HALVES - CALL WNMFTC(APH(MPH_NDEC_1),MLIN,WLIN2) !TRANSFORM - CALL WNMFCS(APH(MPH_NDEC_1),MLIN) !SWAP HALVES -C - RETURN -C -C - END diff --git a/src/nmap/nclucl.for b/src/nmap/nclucl.for deleted file mode 100644 index 0311727bb019586202697c355213544aeab7542d..0000000000000000000000000000000000000000 --- a/src/nmap/nclucl.for +++ /dev/null @@ -1,315 +0,0 @@ -C+ NCLUCL.FOR -C WNB 920103 -C -C Revisions: -C JPH 940224 Comments. - Fix final deallocation of BUFPTR (was JNDC, -C must be JNRA). -C HjV 950529 Multiply map with DATAFAC (data factor) -C CMV 950616 Account for DATAFAC in map limits, noise and comment -C -C - SUBROUTINE NCLUCL(STSRC,NDSRC,FTMP,FBEM,FOUT,FIN, - 1 MDH,MDPT,MPHP,MPH,APH) -C -C Clean map using transformed beam -C -C Result: -C CALL NCLUCL ( STSRC_J:I, NDSRC_J:I, FTMP_J:I, FBEM_J:I, -C FOUT_J:I, FIN_J:I, MDH_B(*), MDPT_J:I, -C MPHP_J:I, MPH_B(*):IO, APH_B(*):I) -C Clean sources STSRC until NDSRC using -C the beam in file FBEM from the map with header -C MPH at MPHP. MDH is the model header, MDPT -C the input data pointer. FOUT and FIN describe -C the input/output files. -C The "beam" in file FBEM is the transposed Fourier transform of the -C antenna pattern, made by NCLUVT. -C -C -C Include files: -C - INCLUDE 'WNG_DEF' - INCLUDE 'MPH_O_DEF' !MAP HEADER - INCLUDE 'NCL_DEF' -C -C Parameters: -C -C -C Arguments: -C - INTEGER STSRC !START SOURCE # - INTEGER NDSRC !END SOURCE # - INTEGER FTMP !TEMP. FILE - INTEGER FBEM !BEAM FILE - INTEGER FOUT !RESIDUAL FILE - INTEGER FIN !MAP/RESIDUAL FILE - BYTE MDH(0:*) !MODEL HEADER - INTEGER MDPT !INPUT DATA POINTER - INTEGER MPHP !MAP HEADER POINTER - BYTE MPH(0:*) !MAP HEADER - BYTE APH(0:*) !BEAM HEADER -C -C Function references: -C - LOGICAL WNFRD !READ DISK - LOGICAL WNFWR !WRITE DISK - LOGICAL WNGGVA !GET VIRTUAL MEMORY - INTEGER WNMEJC !CEIL(X) - INTEGER WNGGJ !GET J VALUE - REAL WNGGE !GET E VALUE -C -C Data declarations: -C - CHARACTER CBUF*(MPH_UCM_N) !NAME FOR CALCULATED OUTPUT MAP - INTEGER VLEN,VAD,XAD !LENGTH, ADDRESS BEAM BUF - INTEGER JV !BEAM DISK PTR - INTEGER MLEN,MAD !LENGTH, ADDRESS MAP BUF - INTEGER JM,JMI !MAP DISK PTR - INTEGER WLEN,WAD(2) !FFT WEIGHT BUFFER - INTEGER BUFPTR !TRANSPOSE BUFFER - INTEGER FTBUF !FFT BUFFER - INTEGER LSIZE !LENGTH TRANSPOSE STAGE - INTEGER LSIZ8 - INTEGER LSTEP !TRANSPOSE DISK STEP - REAL RMAX,RMIN !MAX/MIN VALUES - INTEGER RMXR,RMXD,RMNR,RMND !POS. MAX/MIN - REAL RSUM !SUM RESTORE AP - INTEGER JC !AREA CNT - INTEGER JNRA,JNDC - INTEGER JJ2,JJ3,II1 - REAL RR1 -C- -C -C GET BUFFERS -C - JNDC=WNGGJ(APH(MPH_NDEC_1)) - JNRA=WNGGJ(APH(MPH_NRA_1)) - VLEN=LB_E*JNDC !LENGTH BEAM BUF, 1 line (Note - ! that beam is transposed!) - JS=WNGGVA(VLEN,VAD) !GET 2 BEAM BUFFERS - IF (JS) JS=WNGGVA(VLEN,XAD) - MLEN=2*VLEN !LENGTH MAP BUF - IF (JS) JS=WNGGVA(MLEN,MAD) !GET MAP/source LINE BUFFERS - WLEN=2*VLEN/2 !LENGTH FFT BUF - IF (JS) JS=WNGGVA(WLEN,WAD(1)) !GET FFT cos/sin BUFFERS - IF (JS) JS=WNGGVA(WLEN,WAD(2)) - IF (.NOT.JS) THEN - CALL WNCTXT(F_TP,'Cannot obtain clean buffers') - CALL WNGEX !STOP - END IF -C -C FILL cos/sin buffers: WAD(1) with cos/sin, WAD with cos/-sin -C (NOTE: Unnecessary duplication of sin/cos calculations) -C - DO I=0,JNDC/2-1 - CALL WNGMV(LB_E,COS(I*PI2/JNDC),A_B(WAD(1)-A_OB+2*LB_E*I)) - CALL WNGMV(LB_E,SIN(I*PI2/JNDC),A_B(WAD(1)-A_OB+LB_E+2*LB_E*I)) - CALL WNGMV(LB_E,COS(I*PI2/JNDC),A_B(WAD(2)-A_OB+2*LB_E*I)) - CALL WNGMV(LB_E,-SIN(I*PI2/JNDC),A_B(WAD(2)-A_OB+LB_E+2*LB_E*I)) - END DO -C -C DO ALL BEAM columns -C - JV=0 !BEAM PTR - JJ2=LB_E*JNDC - JM=0 !TMP OUTPUT PTR - RSUM=0 !RESTORE AP SUM - DO I=0,JNRA/2 !ALL BEAM columns - JJ3=2*LB_E*JNDC - CALL WNGMVZ(JJ3,A_B(MAD-A_OB)) !CLEAR MAP column buffer - IF (FBEM.NE.0) THEN - IF (.NOT.WNFRD(FBEM,JJ2, - 1 A_B(VAD-A_OB),JV)) THEN !READ transformed-beam column - CALL WNCTXT(F_TP,'Read error transformed beam') - CALL WNGEX !STOP - END IF - ELSE - CALL NCLFBM(I,JNDC,RESDL,RESDM, - 1 RESDAN,A_B(VAD-A_OB),RSUM) !FILL RESTORE BEAM - END IF - JV=JV+JJ2 !NEXT BEAM-column PTR - CALL NCLUC1(STSRC,NDSRC,I,A_B(MAD-A_OB),A_B(VAD-A_OB), - 1 A_B(WAD(1)-A_OB), - 1 A_B(WAD(2)-A_OB), - 1 MDH,MPH,APH,A_B(XAD-A_OB)) !create column of source -C ! transform - IF (.NOT.WNFWR(FTMP,2*JJ2, - 1 A_B(MAD-A_OB),JM)) THEN !WRITE source column to TMP file - CALL WNCTXT(F_TP,'Write error source map') - CALL WNGEX !STOP - END IF - JM=JM+2*JJ2 !NEXT MAP PTR - END DO -C -C CLEAR BUFFERS -C - CALL WNGFVA(VLEN,VAD) !BEAM BUFFERS - CALL WNGFVA(VLEN,XAD) - CALL WNGFVA(MLEN,MAD) !MAP LINE BUFFERS - CALL WNGFVA(WLEN,WAD(1)) !FFT WEIGHT BUFFERS - CALL WNGFVA(WLEN,WAD(2)) -C -C Transform the sources back from UV to map plane and subtract them -C -C GET BUFFERS -C - LSIZE=MIN(WNMEJC(MEMSIZ/(REAL(LB_X)*(JNRA/2+1))),JNDC) !LENGTH STAGE - LSIZ8=LB_X*LSIZE - JS=WNGGVA(LSIZ8*(JNRA/2+1),BUFPTR) !TRANSPOSE BUFfer - J=LB_X*JNRA !FFT BUFFER - IF (JS) JS=WNGGVA(J,FTBUF) - IF (JS) JS=WNGGVA(J,MAD) !MAP INPUT BUFfer - IF (JS) JS=WNGGVA(J/2,WAD(1)) !FFT WEIGHT BUFfer - IF (.NOT.JS) THEN - CALL WNCTXT(F_TP,'Cannot obtain map clean buffers') - CALL WNGEX !STOP - END IF - DO I=0,JNRA/2-1 !FILL cos/sin BUFfer - CALL WNGMV(LB_E,COS(I*PI2/JNRA), - 1 A_B(WAD(1)-A_OB+LB_X*I)) - CALL WNGMV(LB_E,-SIN(I*PI2/JNRA), - 1 A_B(WAD(1)-A_OB+LB_E+LB_X*I)) - END DO - LSTEP=LB_X*JNDC !DISK INPUT STEP -C -C DO ALL LINES in "stages" of LSIZE lines -C - RMAX=-1E36 !START MAX/MIN SEARCH - RMIN=1E36 - D0=4D0/JNRA/JNDC !NORMALISATION - IF (FBEM.EQ.0) D0=1D0/RSUM - CALL WNMHS8(MPHAD,+1, - 1 MAX(ABS(WNGGE(MPH(MPH_MAX_1))*DATAFAC), - 1 ABS(WNGGE(MPH(MPH_MIN_1))*DATAFAC))) !initialise MAP HISTO AREA - JM=WNGGJ(MPH(MPH_MDP_1)) !MAP OUTPUT PTR - JMI=MDPT !MAP INPUT POINTER - JJ2=LB_E*JNRA - DO I2=0,JNDC-1,LSIZE !DO STAGES - J0=MIN(LSIZE,JNDC-I2) !LENGTH TO DO IN STAGE -C -C Inverse transform for stage -C - DO J=0,JNRA/2 !READ A STAGE - JS=WNFRD(FTMP,LB_X*J0, - 1 A_B(BUFPTR-A_OB+J*LSIZ8), - 1 J*LSTEP+LB_X*I2) - END DO - DO J1=0,J0-1 !ALL LINES IN STAGE - I5=I2+J1-JNDC/2 !POSition in DECLINATION - DO J=0,JNRA/2 - CALL WNGMV(LB_X, - 1 A_B(BUFPTR-A_OB+J*LSIZ8+LB_X*J1), - 1 A_B(FTBUF-A_OB+LB_X*J)) !TRANSPOSE - END DO - J2=LB_X*(JNRA/2-1) !ZERO LENGTH - CALL WNGMVZ(J2, - 1 A_B(FTBUF-A_OB+LB_X*(JNRA/2+1)))!clear upper half of BUF - CALL WNMFTC(JNRA,A_B(FTBUF-A_OB), - 1 A_B(WAD(1)-A_OB)) !FFT in FTBUF - CALL WNMFCS(JNRA,A_B(FTBUF-A_OB)) !SWAP HALVES - CALL WNMFCR(JNRA,A_B(FTBUF-A_OB)) !MAKE REAL -C -C Combine map with sources in FTBUF and write to residuals file FOUT -C - IF (.NOT.WNFRD(FIN,JJ2, - 1 A_B(MAD-A_OB),JMI)) THEN !READ MAP - CALL WNCTXT(F_TP,'Read error map') - CALL WNGEX !STOP - END IF - DO I=0,JNRA-1 - A_E(MAD/LB_E-A_OE+I)=A_E(MAD/LB_E-A_OE+I)*DATAFAC - END DO - IF (FBEM.NE.0) THEN - RR1=D0 - CALL NCLFAM(RR1,A_B(MAD-A_OB), !ADD SOURCES: - 1 A_B(FTBUF-A_OB),JNRA) ! FTBUF = MAD + RR1*FTBUF - ELSE !SUBTRACT SOURCES - RR1=D0 - IF (.NOT.RONMDL) THEN !NOT RESTORE ONLY - CALL NCLFSM(RR1,A_B(MAD-A_OB), !subtract: - 1 A_B(FTBUF-A_OB),JNRA) ! FTBUF = MAD - RR1*FTBUF - ELSE - CALL NCLFS2(RR1,CLFAC, ! - 1 A_B(MAD-A_OB), ! FTBUF = CLFAC*FTBUF - RR1*MAD - 1 A_B(FTBUF-A_OB),JNRA) - END IF - END IF - IF (.NOT.WNFWR(FOUT,JJ2,A_B(FTBUF-A_OB),JM)) THEN !WRITE RESIDUAL - CALL WNCTXT(F_TP,'Write error residual file') - CALL WNGEX !STOP - END IF - - JM=JM+LB_E*JNRA !NEXT MAP IN/OUT PTR - JMI=JMI+LB_E*JNRA ! for next line -C -C inspect line for extremes -C - R0=-1E36 - R1=1E36 - CALL WNMFMX(JNRA,A_B(FTBUF-A_OB),1D0, - 1 R0,I3,R1,I4) !FIND MAX/MIN AND NORMALIZE - IF (R0.GT.RMAX) THEN - RMAX=R0 !NEW MAX with its L and M - RMXR=I3-JNRA/2 - RMXD=I5 - END IF - IF (R1.LT.RMIN) THEN !NEW MIN with its L and M - RMIN=R1 - RMNR=I4-JNRA/2 - RMND=I5 - END IF -C -C Make histogram of residuals in selected areas -C - J2=-32768 !START POINT - DO JC=1,NAREA !ALL AREAS - IF (I5.GE.PAREA(2,JC,1) .AND. I5.LE.PAREA(3,JC,1)) THEN !LINE OK - J2=MAX(J2,PAREA(0,JC,1)) !START POINT - II1=PAREA(1,JC,1)-J2+1 - CALL WNMHS1(MPHAD,II1, - 1 A_B(FTBUF-A_OB+ - 1 LB_E*(JNRA/2+J2))) - J2=PAREA(1,JC,1)+1 !NEXT START - END IF - END DO - END DO !END LINES - END DO !END STAGE - CALL WNGMV(LB_E,RMAX,MPH(MPH_MAX_1)) !SAVE MAX/MIN - CALL WNGMV(LB_E,RMIN,MPH(MPH_MIN_1)) - CALL WNGMV(LB_J,RMXR,MPH(MPH_MXR_1)) - CALL WNGMV(LB_J,RMNR,MPH(MPH_MNR_1)) - CALL WNGMV(LB_J,RMXD,MPH(MPH_MXD_1)) - CALL WNGMV(LB_J,RMND,MPH(MPH_MND_1)) - IF (FBEM.NE.0) THEN - CBUF='RESIDUAL' - ELSE - CBUF='RESTORED' - END IF - IF (DATAFAC.NE.1.0) - 1 CALL WNCTXS(CBUF(9:),' (*!E5.2)',DATAFAC) - CALL WNGMFS(MPH_UCM_N,CBUF,MPH(MPH_UCM_1)) - IF (FBEM.NE.0) THEN - CALL WNMHS4(MPHAD,MPH(MPH_NOS_1),0) !SET NOISE - ELSE IF (RONMDL) THEN !ONLY RESTORE - RR1=WNGGE(MPH(MPH_NOS_1)) - RR1=CLFAC*RR1 - CALL WNGMV(LB_E,RR1,MPH(MPH_NOS_1)) - ELSE !RESTORE ON RESIDUAL - RR1=WNGGE(MPH(MPH_NOS_1)) !USE DATAFAC - RR1=DATAFAC*RR1 - CALL WNGMV(LB_E,RR1,MPH(MPH_NOS_1)) - END IF - JS=WNFWR(FOUT,MPHHDL,MPH,MPHP) !SET RESIDUAL HEADER -C -C release BUFFERS -C - CALL WNGFVA(LSIZ8*(JNRA/2+1),BUFPTR) !TRANSPOSE BUF - J=LB_X*JNRA !FFT BUFFER - CALL WNGFVA(J,FTBUF) - CALL WNGFVA(MLEN,MAD) !MAP INPUT BUFFER - CALL WNGFVA(WLEN,WAD(1)) !FFT WEIGHT BUF -C - RETURN -C -C - END diff --git a/src/nmap/ncluv.for b/src/nmap/ncluv.for deleted file mode 100644 index fdcdfed3bf1641a63dd6814cf8a9869c4e3be2ae..0000000000000000000000000000000000000000 --- a/src/nmap/ncluv.for +++ /dev/null @@ -1,278 +0,0 @@ -C+ NCLUV.FOR -C WNB 920103 -C -C Revisions: -C WNB 920131 Error if no residual map asked -C HjV 920520 HP does not allow extended source lines -C WNB 921202 Cater for J2000 -C WNB 921222 Correct retore if no residual -C WNB 930407 Correct noise for some restored maps -C WNB 930928 Add instrument -C JPH 940302 Comments -C - SUBROUTINE NCLUV(MPHP,APHP) -C -C Do cleaning using UV cover -C -C Result: -C CALL NCLUV( MPHP_J:I, APHP_J:I) -C Do a Clark type clean, using the UV cover -C to subtract the sources. MPHP and APHP are the -C map and beam header pointers. -C -C Include files: -C - INCLUDE 'WNG_DEF' - INCLUDE 'MPH_O_DEF' !MAP HEADER - INCLUDE 'MDH_O_DEF' !MODEL HEADER - INCLUDE 'NCL_DEF' -C -C Parameters: -C -C -C Arguments: -C - INTEGER MPHP !MAP HEADER POINTER - INTEGER APHP !BEAM HEADER POINTER -C -C Function references: -C - LOGICAL WNGGVM !GET VIRTUAL MEMORY - LOGICAL WNFOP !OPEN FILE - LOGICAL WNFRD !READ DISK - LOGICAL WNFWR !WRITE DISK - CHARACTER*20 WNFFNM !FILE NAME - LOGICAL NMOSLG !GET SOURCE SPACE -C -C Data declarations: -C - INTEGER RMPP !RESIDUAL MAP POINTER - INTEGER RSNAM(0:7) !RESIDUAL SET NAME - INTEGER BMSIZ,MPSIZ !PATCH BUFFER SIZES - INTEGER BMPAD,MPPAD !PATCH BUFFER ADDRESSES - INTEGER FCAUVT !BEAM COVER FILE - INTEGER FCATMP !TEMP. FILE - INTEGER FCARSD !RESIDUAL FILE - INTEGER FCAIN !INPUT FILE SWITCH - INTEGER DPTIN !INPUT POINTER SWITCH - REAL SUMGL !GRATING LOBE SUM - INTEGER MDHJ(0:MDHHDL/4-1) !MODEL HEADER - REAL MDHE(0:MDHHDL/4-1) - DOUBLE PRECISION MDHD(0:MDHHDL/8-1) - EQUIVALENCE (MDHJ,MDHE,MDHD) - BYTE MPH(0:MPHHDL-1) !MAP HEADER - INTEGER*2 MPHI(0:MPHHDL/2-1) - INTEGER MPHJ(0:MPHHDL/4-1) - REAL MPHE(0:MPHHDL/4-1) - DOUBLE PRECISION MPHD(0:MPHHDL/8-1) - EQUIVALENCE (MPH,MPHI,MPHJ,MPHE,MPHD) - BYTE RMPH(0:MPHHDL-1) !RESIDUAL MAP HEADER - INTEGER RMPHJ(0:MPHHDL/4-1) - REAL RMPHE(0:MPHHDL/4-1) - EQUIVALENCE (RMPH,RMPHJ,RMPHE) - BYTE APH(0:MPHHDL-1) !BEAM HEADER - INTEGER RG(0:1) !SOURCE RANGE - DATA RG/1,1000000/ -C- -C -C INIT -C - IF (.NOT.WNFRD(FCAMAP,MPHHDL,MPH,MPHP)) THEN !READ MAP HEADER - CALL WNCTXT(F_TP,'Error reading map header') - CALL WNGEX !STOP - END IF - MINLIM=MAX(ABS(MPHE(MPH_MAX_E)),ABS(MPHE(MPH_MIN_E))) !SET MAP MAX - IF (APHP.NE.0) THEN !BEAM PRESENT - IF (.NOT.WNFRD(FCAMAP,MPHHDL,APH,APHP)) THEN !READ BEAM HEADER - CALL WNCTXT(F_TP,'Error reading beam header') - CALL WNGEX !STOP - END IF - ELSE !NO BEAM - CALL WNGMV(MPHHDL,MPH,APH) !MAKE SURE DATA PRESENT - END IF - FCARSD=FCAMAP !ASSUME RESIDUAL IN MAP - IF (.NOT.RONMDL) THEN !NOT RESTORE ONLY - IF (.NOT.RESMDL) THEN !RESIDUAL NOT ASKED - FCARSD=0 !NO RESIDUAL OPEN - IF (.NOT.WNFOP(FCARSD,WNFFNM('NCL','TMP'),'WT')) THEN - CALL WNCTXT(F_TP,'Cannot open temporary residual file') - CALL WNGEX !STOP - END IF - END IF - CALL NCLCWR(FCARSD,MPH,RMPP,RSNAM) !START RESIDUAL MAP - IF (.NOT.WNFRD(FCARSD,MPHHDL,RMPH,RMPP)) THEN !READ RESIDUAL HEADER - CALL WNCTXT(F_TP,'Error reading residual map header') - CALL WNGEX !STOP - END IF - END IF - FCAIN=FCAMAP !FIRST INPUT FROM MAP - DPTIN=MPHJ(MPH_MDP_J) -C -C GET TEMPORARY FILE FOR TRANSPOSE -C - IF (.NOT.WNFOP(FCATMP,WNFFNM('NCL','TMP'),'WT')) THEN - CALL WNCTXT(F_TP,'Cannot open temporary transpose file') - CALL WNGEX !STOP - END IF -C - IF (RONMDL) GOTO 20 !RESTORE ONLY -C -C GET HISTOGRAMS AND PATCH DATA. NCLHID sets the COMMON variables -C BEMPAT= beam patch size -C MAPPAT= map patch size -C MAPLIM= map data limit in patch -C - CALL WNCTXT(F_TP,' ') - CALL WNCCSX(F_TP,'Histogramming') - CALL NCLHID(MPHP,APHP) !GET BEAM PATCH, SHOW HISTO - CALL WNCTXT(F_P,'!^') -C -C GET BEAM COVER -C - IF (.NOT.WNFOP(FCAUVT,WNFFNM('NCL','TMP'),'WT')) THEN - CALL WNCTXT(F_TP,'Cannot obtain UV cover file') - CALL WNGEX !STOP - END IF - CALL WNCCSX(F_TP,'Beaming') - CALL NCLUVT(FCATMP,FCAUVT,APH) !transform beam back to UV COVER -C -C INIT SOURCE LIST -C - CALL NMOHMF(7,MDHJ) !GET HEADER 7 - CALL NMOHZD(MDHJ) !CLEAR SOURCES - MDHD(MDH_RA_D)=MPHD(MPH_RA_D) !SET MAP RA - MDHD(MDH_DEC_D)=MPHD(MPH_DEC_D) !SET MAP DEC - MDHD(MDH_FRQ_D)=MPHD(MPH_FRQ_D) !SET MAP FREQ. - IF (MPHI(MPH_EPT_I).EQ.1) THEN !1950/2000 COORDINATES - MDHJ(MDH_TYP_J)=2 !EPOCH TYPE - MDHE(MDH_EPOCH_E)=MPHE(MPH_EPO_E) !EPOCH - ELSE !APPARENT - MDHJ(MDH_TYP_J)=1 !EPOCH TYPE - MDHE(MDH_EPOCH_E)=0. !EPOCH - END IF - MDHJ(MDH_BITS_J)=MPHJ(MPH_INST_J) !SET INSTRUMENT - IF (.NOT.NMOSLG(SRCLIM,MDHJ)) THEN !GET AREA - CALL WNCTXT(F_TP,'No space for clean source list') - CALL WNGEX !STOP - END IF -C -C GET PATCH BUFFER using patch sizes defined bu NCLHID above -C The map points will be formatted as (l,m,flux) -C - 10 CONTINUE - BMSIZ=LB_E*(2*BEMPAT+1)*(BEMPAT+1) !BEAM BUFFER SIZE - MPSIZ=(LB_E+2*LB_I)*MAPPAT !MAP BUFFER SIZE - JS=WNGGVM(BMSIZ,BMPAD) !GET BEAM PATCH BUF - IF (JS) JS=WNGGVM(MPSIZ,MPPAD) !GET MAP POINT BUFFER - IF (.NOT.JS) THEN - CALL WNCTXT(F_TP,'Cannot obtain beam and/or map patch buffers') - CALL WNGEX !STOP - END IF - CALL WNCTXT(F_TP,'!/Beam patch of !UJ points, '// - 1 '!UJ mappoints down to !E10.3 W.U. (!E7.2%)!/', - 1 2*BEMPAT+1,MAPPAT,MAPLIM,100.*MAPLIM/MINLIM) -C -C READ DATA - The map pints are cast in the form (l,m,flux), the beam is left -C in the standard array format with the Prussian-hat peak added -C The floowing COMMON variables are set: -C MAPPAT nr of pints in map patch -C CURMAX max. abs. value in patch -C CURPMX linear posn of maximum in patch -C - CALL NCLCRD(FCAMAP,APH,A_B(BMPAD-A_OB),FCAIN,DPTIN, - 1 MPH,A_B(MPPAD-A_OB),A_B(MPPAD-A_OB)) !BEAM, MAP PATCH -C -C DO CLEAN -C - CALL WNCCSX(F_TP,'Cleaning') - J=MDHJ(MDH_NSRC_J)+1 !START SOURCE - SUMGL=0 !START GRATING RESPONSE - DO WHILE (CURMAX.GT.MAPLIM .AND. - 1 MDHJ(MDH_NSRC_J).LT.SRCLIM .AND. - 1 CURMAX.GE.SUMGL) - CALL NCLCCL(A_B(BMPAD-A_OB),A_B(MPPAD-A_OB),A_B(MPPAD-A_OB), - 1 J,MDHJ,MPH,SUMGL) !CLEAN 1 point (1 minor cycle) - END DO -C -C SHOW SOURCES -C - CALL NMOHMT(MDHJ,7) !SET HEADER 7 - CALL NMOAM2(7,J,MDHJ(MDH_NSRC_J)) !MERGE SOURCES - CALL NMOPTI(F_TP,RG,7) !SHOW TOTAL TILL NOW -C -C RELEASE PATCH BUFFERS -C - CALL WNGFVM(BMSIZ,BMPAD) - CALL WNGFVM(MPSIZ,MPPAD) -C -C CLEAN MAJOR CYCLE -C - CALL NCLUCL(J,MDHJ(MDH_NSRC_J),FCATMP,FCAUVT,FCARSD,FCAIN, - 1 MDHJ,DPTIN,RMPP,RMPH,APH) - FCAIN=FCARSD !INPUT FROM RESIDUAL - DPTIN=RMPHJ(MPH_MDP_J) -C -C RECYCLE -C - CALL WNMHS7(MPHAD,I1,I2,MPHMXI,R0) !GET HISTO DATA - IF (MPHMXI.GT.CLLIM*MINLIM .AND. MDHJ(MDH_NSRC_J).LT.SRCLIM) THEN - CALL NCLHIE(RMPP,APHP) !GET PATCH DATA - GOTO 10 !MORE TO DO - END IF -C -C FINISH ALL -C - CALL WNFCL(FCAUVT) !CLOSE AND DELETE BEAM COVER - CALL WNMHS3(MPHAD,1,F_P) !SHOW RESIDUAL HISTO - IF (RESMDL) THEN !RESIDUAL WANTED - CALL WNCTXT(F_P,'!^') - CALL NMAPMH(F_TP,RMPH,RSNAM,NODMAP) !SHOW RESIDUAL HEADER - END IF -C -C FINISH SOURCE LIST -C - CALL NMORDM(7,-1) !ADD SOURCES TO GENERAL LIST - CALL NMOAMG !MERGE COMPONENTS - CALL NMOPTT(F_TP,RG) !SHOW TOTAL FLUX - IF (FCAAP.EQ.0) THEN !NO MODEL FILE GIVEN - CALL NMODAX(J) !LET USER ACT - ELSE - CALL NMOWRI(FCAAP,-1) !WRITE SOURCE MODEL - END IF -C -C RESTORE MAP -C - 20 CONTINUE - IF (RSTMDL) THEN !RESTORE MAP - CALL NMOHMF(-1,MDHJ) !SOURCES - R0=RMPHE(MPH_NOS_E) !KEEP RESIDUAL NOISE - CALL NCLCWR(FCAMAP,MPH,RMPP,RSNAM) !START RESTORED MAP - IF (.NOT.WNFRD(FCAMAP,MPHHDL,RMPH,RMPP)) THEN !READ RESTORED HEADER - CALL WNCTXT(F_TP,'Error reading restored map header') - CALL WNGEX !STOP - END IF - CALL WNCCSX(F_TP,'Restoring') - IF (.NOT.RONMDL) RMPHE(MPH_NOS_E)=R0 !SET PROPER NOISE - CALL NCLUCL(1,MDHJ(MDH_NSRC_J),FCATMP,0,FCAMAP,FCAIN, - 1 MDHJ,DPTIN,RMPP,RMPH,APH) - CALL WNCTXT(F_P,'!^') - CALL NMAPMH(F_TP,RMPH,RSNAM,NODMAP) !SHOW RESIDUAL HEADER - END IF -C -C READY -C - IF (.NOT.RONMDL) THEN !NOT RESTORE ONLY - CALL NCLHIX(MPHP,APHP) !DELETE BEAM HISTO - END IF - IF (.NOT. RONMDL .AND. .NOT.RESMDL) THEN !NO RESIDUAL SAVE - CALL WNFCL(FCARSD) !DELETE RESIDUAL - END IF - CALL WNFCL(FCATMP) !CLOSE AND DELETE TEMP. FILE - CALL WNCTXT(F_TP,' ') - CALL WNCCSX(F_TP,'End') - CALL WNCTXT(F_TP,' ') -C - RETURN -C -C - END diff --git a/src/nmap/ncluvt.for b/src/nmap/ncluvt.for deleted file mode 100644 index e37a39e926329e3645e464322179f866125070c6..0000000000000000000000000000000000000000 --- a/src/nmap/ncluvt.for +++ /dev/null @@ -1,222 +0,0 @@ -C+ NCLUVT.FOR -C WNB 920103 -C -C Revisions: -C JPH 940223 Comments -C CMV 940419 Pass outsize to NMACVF (TSIZ may be larger than that) -C - SUBROUTINE NCLUVT(FTMP,FOUT,APH) -C -C Transform beam to UV cover. If possible, the map taper that copmpensates -C for the gridding convolution is removed first so the UV coverage obtained -C is the one from which the beam was originally made. -C -C Result: -C CALL NCLUVT ( FTMP_J:I, FOUT_J:I, APH_B(*):I) -C Transform beam to UV cover, and output -C to specified file FOUT. -C -C Include files: -C - INCLUDE 'WNG_DEF' - INCLUDE 'MPH_O_DEF' !MAP HEADER - INCLUDE 'NCL_DEF' -C -C Parameters: -C -C -C Arguments: -C - INTEGER FTMP !TEMP. FILE - INTEGER FOUT !OUTPUT FILE - BYTE APH(0:*) !BEAM HEADER -C -C Function references: -C - LOGICAL WNFOP !OPEN FILE - LOGICAL WNFRD !READ DISK - LOGICAL WNFWR !WRITE DISK - LOGICAL WNGGVA !GET VIRTUAL MEMORY - LOGICAL WNGFVA !FREE VIRTUAL MEMORY - INTEGER WNMEJC !CEIL(X) - INTEGER WNGGJ !GET J VALUE - INTEGER*2 WNGGI !GET I VALUE - REAL WNGGE !GET E VALUE -C -C Data declarations: -C - INTEGER WTBUF !FFT WEIGHT BUF ADDRESS - INTEGER FTBUF !FFT BUFFER ADDRESSES - INTEGER CVBF !CONVOLUTION BUFFER - INTEGER LSIZE,LSIZ8 !SIZE ONE TRANSPOSE STAGE - INTEGER LSTEP !TRANSPOSE INPUT DISK STEP - INTEGER BUFPTR !TRANSPOSE BUF ADDRESS - INTEGER OSIZ(2) !COPY OUTSIZE = MAP SIZES - INTEGER TSIZ(2) !COPY FTSIZE - INTEGER JNRA,JNDC !MAP SIZES -C- -C -C Set up size parameters, get buffers, set up tables -C - JNRA=WNGGJ(APH(MPH_NRA_1)) !MAP SIZES - JNDC=WNGGJ(APH(MPH_NDEC_1)) - OSIZ(1)=JNRA !COPY TO PASS TO NMACVF - OSIZ(2)=JNDC - CALL WNGMV(2*LB_J,APH(MPH_FSR_1),TSIZ(1)) !FFT SIZES - J=2*LB_E*JNRA !LENGTH FFT BUFFER - JS=WNGGVA(J,FTBUF) !FFT BUFFER - IF (JS) JS=WNGGVA(J/2,WTBUF) !FFT cos/sin ("weight") BUFFER - IF (JS) JS=WNGGVA((J+16)/4,CVBFU) !DECONVOLUTION BUFFERS - J=(LB_E/2)*JNDC+LB_E - IF (JS) JS=WNGGVA(J,CVBFV) - I1=3*32+1 !CONV. LENGTH - IF (JS) JS=WNGGVA(LB_E*I1,CVBF) !CONVOLUTION BUFFER - IF (.NOT.JS) THEN - CALL WNCTXT(F_TP,'Cannot obtain UV FFT buffers') - CALL WNGEX !STOP - END IF -C -C Make cos/sin tables for FFT -C - DO I=0,JNRA/2-1 !FILL FFT WEIGHT - CALL WNGMV(LB_E,COS(I*PI2/JNRA),A_B(WTBUF-A_OB+2*LB_E*I)) - CALL WNGMV(LB_E,SIN(I*PI2/JNRA),A_B(WTBUF-A_OB+LB_E+2*LB_E*I)) - END DO -C -C The map may have been tapered to componsate for the effect of the convolution -C function in the gridding process. We will undo this taper if we can -C - I2=32 !CONV. STEP - I3=WNGGI(APH(MPH_CD_1+2*LB_I)) !CONVOLUTION TYPE - IF (I3.NE.0 .AND. !DECONVOLUTION - 1 WNGGJ(APH(MPH_FSR_1)).EQ.JNRA .AND. - 1 WNGGJ(APH(MPH_FSD_1)).EQ.JNDC .AND. - 1 APDCV) THEN - CALL NMACVF(I1,I3,I2,TSIZ,OSIZ,A_B(CVBF-A_OB), - 1 A_B(CVBFU-A_OB),A_B(CVBFV-A_OB))!make convolution-functn tables - CALL WNCTXT(F_TP, - 1 '!/Correction for deconvolution '// - 1 'effects applied!/') - ELSE - CALL NMACVF(I1,0,I2,TSIZ,OSIZ,A_B(CVBF-A_OB), - 1 A_B(CVBFU-A_OB),A_B(CVBFV-A_OB))!make dummy table (all 1s) - CALL WNCTXT(F_TP, - 1 '!/No correction for possible '// - 1 'deconvolution effects applied!/') - END IF - JS= WNGFVA(I1,CVBF) !we do not need this one - CALL NCLF1D(A_B(CVBFU-A_OB),JNRA/2+1) !INVERT DECONVOLUTION BUFS - CALL NCLF1D(A_B(CVBFV-A_OB),JNDC/2+1) -C -C DO FIRST PASS FFT: horizontal -C - J=LB_E*JNRA !LINE LENGTH - J=WNGGJ(APH(MPH_MDP_1))+J*JNDC/2 !PTR TO INPUT LINE ZERO - J2=0 !OUTPUT PTR - DO J1=0,JNDC/2 !ALL LINES - IF (J1.EQ.JNDC/2) THEN !LAST LINE - J=WNGGJ(APH(MPH_MDP_1)) !LAST LINE == FIRST - END IF - IF (.NOT.WNFRD(FCAMAP,LB_E*JNRA,A_B(FTBUF-A_OB),J)) THEN !READ LINE - CALL WNCTXT(F_TP,'Read error beam') - CALL WNGEX !STOP - END IF - J=J+LB_E*JNRA !NEXT LINE PTR - IF (J1.EQ.0) THEN - CALL NCLFD2(A_B(FTBUF-A_OB),JNRA) !divide first and last - ELSE IF (J1.EQ.JNDC/2) THEN ! - CALL NCLFD2(A_B(FTBUF-A_OB),JNRA) ! lines by 2 - END IF - I4=JNRA/2 -C -C DECONVOLVE by multiplying with the inverted horizontal and vertical tapers -C - CALL WNMFSN(I4,A_B(FTBUF-A_OB+LB_E*I4),!right half with 1/taper - 1 A_B(CVBFU-A_OB), - 1 A_B(CVBFV-A_OB+LB_E*J1)) - CALL WNMFIN(I4,A_B(FTBUF-A_OB), !left half with 1/taper in - 1 A_B(CVBFU-A_OB+LB_E), ! reverse direction - 1 A_B(CVBFV-A_OB+LB_E*J1)) - CALL WNMFRC(JNRA,A_B(FTBUF-A_OB)) !convert REAL TO COMPLEX - CALL WNMFCS(JNRA,A_B(FTBUF-A_OB)) !SWAP HALVES - CALL WNMFTC(JNRA,A_B(FTBUF-A_OB), - 1 A_B(WTBUF-A_OB)) !in-place FFT - IF (.NOT.WNFWR(FTMP,2*LB_E*(JNRA/2+1), - 1 A_B(FTBUF-A_OB),J2)) THEN !OUTPUT PART LINE - CALL WNCTXT(F_TP,'Write error temporary UV file') - CALL WNGEX !STOP - END IF - J2=J2+2*LB_E*(JNRA/2+1) !NEXT OUTPUT PTR - END DO -C -C CLEAR BUFFERS -C - J=2*LB_E*JNRA !FFT BUFFER - JS= WNGFVA(J,FTBUF) - JS= WNGFVA(J/2,WTBUF) !FFT cos/sin BUFFER -C -C SECOND PASS FFT: vertical -C -C GET BUFFERS -C - LSIZE=MIN(WNMEJC(MEMSIZ/(REAL(2*LB_E)*(JNDC/2+1))),JNRA/2+1) - !LENGTH ONE STAGE - LSIZ8=2*LB_E*LSIZE - JS=WNGGVA(LSIZ8*(JNDC/2+1),BUFPTR) !TRANSPOSE BUF - J=2*LB_E*JNDC !FFT BUFFER - IF (JS) JS=WNGGVA(J,FTBUF) - IF (JS) JS=WNGGVA(J/2,WTBUF) !FFT cos/sin ("WEIGHT") BUF - IF (.NOT.JS) THEN - CALL WNCTXT(F_TP,'Cannot obtain UV cover transpose buffers') - CALL WNGEX !STOP - END IF - DO I=0,JNDC/2-1 !FILL WEIGHT BUF - CALL WNGMV(LB_E,COS(I*PI2/JNDC),A_B(WTBUF-A_OB+2*LB_E*I)) - CALL WNGMV(LB_E,SIN(I*PI2/JNDC),A_B(WTBUF-A_OB+LB_E+2*LB_E*I)) - END DO - LSTEP=2*LB_E*(JNRA/2+1) !DISK INPUT STEP -C -C DO ALL LINES in "stages" of LSIZE lines -C - DO I2=0,JNRA/2,LSIZE !DO STAGES - J0=MIN(LSIZE,JNRA/2+1-I2) !LENGTH TO DO IN STAGE - DO J=0,JNDC/2 !READ A STAGE - JS=WNFRD(FTMP,2*LB_E*J0, - 1 A_B(BUFPTR-A_OB+J*LSIZ8), - 1 J*LSTEP+2*LB_E*I2) - END DO - DO J1=0,J0-1 !ALL LINES IN STAGE - DO J=0,JNDC/2 - CALL WNGMV(LB_X,A_B(BUFPTR-A_OB+J*LSIZ8+LB_X*J1), - 1 A_B(FTBUF-A_OB+LB_X*J)) !TRANSPOSE - END DO - J2=LB_X*(JNDC/2-1) !ZERO LENGTH - CALL WNGMVZ(J2, - 1 A_B(FTBUF-A_OB+LB_X*(JNDC/2+1)))!ZERO BUF - CALL WNMFTC(JNDC,A_B(FTBUF-A_OB), - 1 A_B(WTBUF-A_OB)) !FFT - CALL WNMFCS(JNDC,A_B(FTBUF-A_OB)) !SWAP HALVES - CALL WNMFCR(JNDC,A_B(FTBUF-A_OB)) !MAKE REAL - IF (I2+J1.EQ.0) CALL - 1 NCLFD2(A_B(FTBUF-A_OB),JNDC) !HALve VALUES - IF (.NOT.WNFWR(FOUT,LB_E*JNDC, - 1 A_B(FTBUF-A_OB),-1)) THEN !OUTPUT LINE - CALL WNCTXT(F_TP,'Write error UV cover') - CALL WNGEX !STOP - END IF - END DO !END LINES - END DO !END STAGE -C -C CLEAR BUFFERS -C - JS= WNGFVA(LSIZ8*(JNDC/2+1),BUFPTR) !TRANSPOSE BUF - J=2*LB_E*JNDC !FFT BUFFER - JS= WNGFVA(J,FTBUF) - JS= WNGFVA(J/2,WTBUF) !FFT WEIGHT BUF - CALL NCLF1D(A_B(CVBFU-A_OB),JNRA/2+1) !INVERT DECONVOLUTION BUFS, - CALL NCLF1D(A_B(CVBFV-A_OB),JNDC/2+1) ! save for later -C - RETURN -C -C - END diff --git a/src/nmap/nma.dsc b/src/nmap/nma.dsc deleted file mode 100644 index 1007f975299cf61b756f2120d1a48c2cc19a4a3a..0000000000000000000000000000000000000000 --- a/src/nmap/nma.dsc +++ /dev/null @@ -1,251 +0,0 @@ -!+ NMA.DSC -! WNB 910219 -! -! Revisions: -! -%REVISION=CMV=951127="Add CSUM and RSUM, add MXRMVAL, RMVAL" -%REVISION=WNB=950817="Add BSTEP for polarised intensity" -%REVISION=WNB=950809="Add NPTRF for polarised intensity" -%REVISION=WNB=950120="Add %ALIGN to cater for wrong IUNIT etc" -%REVISION=JPH=940930="Add CENTRE, change LSHIFT; comments" -%REVISION=HjV=940714="Add IUNIT, ILAB, NLAB, MXNLAB" -%REVISION=CMV=940530="Add JOBSUM" -%REVISION=WNB=930930="Add Fiddle type codes" -%REVISION=WNB=930826="Add POLTJ" -%REVISION=WNB=930803="Remove .INCLUDE" -%REVISION=WNB=930602="Add BEMLIM" -%REVISION=WNB=930127="Add proper bandwidth" -%REVISION=WNB=921104="Add J2000" -%REVISION=WNB=920828="Change length CNTDVL" -%REVISION=WNB=920817="Add CWGTYP and CWGVAL" -%REVISION=WNB=910219="Original version" -! -! Layout of overall include file (NMA.DEF) -! -%COMMENT="NMA.DEF is an INCLUDE file for the NMAP program" -%COMMENT=" " -! -%VERSION=1 -%SYSTEM=1 -%USER=WNB -%%DATE -%%NAME -%LOCAL=STHTEL=14 !# OF TELESCOPES -! -%GLOBAL=MXNFIL=8 !MAX. # OF INPUT FILE SETS -%GLOBAL=MXNSET=16 !MAX. # OF SETS PER INPUT JOB -%GLOBAL=MXSBB=2048 !SIZE SINGLE SORTING BUFFER -%GLOBAL=MXSBJ=MXSBB/LB_J !SIZE SORTING BUFFER IN J -%GLOBAL=DFTSIZ=17 !SIZE DFT (MUST BE ODD) -%GLOBAL=CNTJ=7 !# OF COUNTS AND AVERAGES -%GLOBAL=CNTD=16 !# OF AVERAGES -%GLOBAL=CNTC=2 !# OF CHARACTER DATA -%GLOBAL=CVLSTP=32 !# OF GRID POINTS PER CONVOL. STEP -%GLOBAL=NOPT=7 !# OF POSSIBLE OUTPUTS -%GLOBAL=MXNLAB=256 !MAX. # OF LABS -%GLOBAL=NPTRF=4096 !LENGTH FOURIER TRANSFORM FOR POL. INT -%GLOBAL=MXRMVAL=512 !MAX NUMBER OF RM VALUES -!- -! -! Make sure common block correctly aligned -! -%ALIGN -! -.DEFINE - .PARAMETER - ORDOPT C(3*NOPT) /MAPAPTCOVREAIMAAMPPHA/ !OUTPUT OPTION ORDER - BEMLIM D /0.01/ !LOWEST BEAM VALUE USED - BSTEP E /1.5/ !STEP FOR POL. INT CONVOLUTION -! -! Fiddle types -! - FID A:(0) /ADD,AVERAGE/ !ADDING - FID A*:(3) /POLAR,ANGLE/ !POLARISATION - FID A*:(10) /SUM,NSUM,BSUM,BNSUM,FSUM,NSSUM,CSUM,RSUM/ !SUMMING - FID A*:(20) /EXTRACT,COPY/ !COPYING - FID A*:(100) /BEAM,DEBEAM,FACTOR/ !MULTIPLICATION - FID A*:(200) /MOSCOM,LMMOS,RAMOS/ !MOSAIC - FID A*:(300) /RHOLOG,WMP/ !LOAD - FID A*:(310) /UNLOAD/ !UNLOAD - FID A*:(-1) /DUMMY/ !DUMMY - .DATA -! -! Local variables: -! - .COMMON - OPTION C24 !PROGRAM OPTION - OPT=OPTION C3 - MEMSIZ J !SIZE OF DYNAMIC MEMORY TO USE - LFLDS J(0:1) !LOOP OUTPUT FIELDS - LCHANS J(0:1) !LOOP OUTPUT CHANNELS - NFILE J !# OF INPUT FILE GROUPS - IUNIT C1 !INPUT UNIT - ILAB J(MXNLAB) !LABELS TO DO - NLAB J !# OF LABELS TO DO - NODIN C80(MXNFIL) !INPUT NODE - FILIN C160(MXNFIL) !INPUT FILE - FCATAP J !TAPE FILE - OLABEL J !OUTPUT TAPE LABEL - OUNIT C1 !OUTPUT UNIT - OUNRS C3 !FILL - SETS J(0:7,0:MXNSET,MXNFIL) !SETS PER JOB - HA E(0:1,MXNFIL) !HA-RANGE PER JOB - SIFRS B(0:STHTEL-1,0:STHTEL-1,MXNFIL) !SELECT INTERFEROMETERS - FCAOUT J !OUTPUT FCA - NODOUT C80 !OUTPUT NODE - FILOUT C160 !OUTPUT FILE - OUTOPT L(NOPT) !SELECTED UV PLANE OUTPUTS: - ! 1= MAP - ! 2= AP - ! 3= COVER - ! 4= REAL PLANE - ! 5= IMAG. PLANE - ! 6= AMPL. PLANE - ! 7= PHASE PLANE - NPOL J !# OF OUTPUT POLARISATIONS - POLC C4(0:3) !POLARISATION CODES - POLT E(-2:3,0:3) !POLARISATION TRANSLATION: - ! -2: IMAGINARY MULTIPLIER - ! -1: MIN. # TO BE PRESENT - ! 0..:XX,XY,YX,YY FACTOR - POLTJ=POLT J(-2:3,0:3) - DODFT L !DO DFT I.S.O. FFT - UVCDT J !UV COORDINATE TYPE: - ! 0= STANDARD - ! 1= BAS-HA - ! 2= IFR-HA - UVDTP J !UV DATA TYPE: - ! 0= STANDARD - ! 1= MODEL - UWGT J !UV WEIGHTING TYPE: - ! 0= NATURAL - ! 1= STANDARD - ! 2= FULL - DATTYP J !UV DATA TYPE: - ! 1= NORMAL - ! 2= COSINE - ! 3= SINE - ! 4= AMPLITUDE - ! 5= PHASE - FIELD E(0:1) ! FIELD SIZE (RADIANS) - CVLTYP J ! CONVOLUTION TYPE: - ! 1= GAUSSIAN - ! 2= BOX - ! 3= PROLATE 4*4 - ! 4= EXPSINC - ! 5= PROLATE 6*6 - CVLWID E(0:1) !HALF CONVOLUTION WIDTH (CELLS) - DECVL L !APPLY DECONVOLVE FACTOR - FTSIZ J(0:1) !FFT SIZE (CELLS, POWER OF 2) - OUTSIZ J(0:1) !OUTPUT SIZE (CELLS) - CAP J !APPLY CORRECTIONS CODE - CDAP J !DE-APPLY CORRECTIONS CODE - MAKMAP L !MAKE A MAP - MAKAP L !MAKE AN ANTENNA PATTERN - TAPTYP J !TAPER TYPE - ! 1= GAUSSIAN - ! 2= LINEAR - ! 3= NATURAL - ! 4= OVERR - ! 5= RGAUSS - TAPVAL E !TAPER VALUE (M) - MAPCTP J !COORDINATE TYPES: - ! -2= REF. B1950 - ! -1= REF. APPARENT - ! 1= APPARENT - ! 2= B1950 - MAPCRD D(0:1) !RA/DEC MAP CENTRE per map - SUB L ! SUBTRACT SOURCES - UVRAD E(0:1) ! inner and outer radii of UV - ! annulus selected - CLIP L ! CLIP DATA - CLPRAD E(0:1) ! inner and outer radii of UV - ! annulus for clipping - CLPLEV E(0:1) ! CLIP LEVELS - LSHIFT J ! SHIFT FIELD: 0=no, 1=shift, - ! -1=centre - SHIFT E(0:1) ! FIELD SHIFT - CENTRE D(0:1) ! field centre - BEMFAC E(0:1,0:5) ! BEAM FACTORS - CWGTYP J ! CIRC. WEIGHT TYPE - ! 0=natural, 1=gaussian, - ! 2=triangular - CWGVAL E ! CIRC. WEIGHT VALUE - RES1 J -! -! History -! -! Loops -! - LPOFF J(0:7) !CURRENT SET OFFSETS -! -! Sorting -! - NBIN J !# OF SORTING BINS - BINSIZ J !U EXTEND PER SORTING BIN - BINADM J !ADDRESS BIN ADMINISTRATION - ! 1= PTR IN BUFFER - ! 2= CURRENT BUFFER FOR BIN (OR -1) - ! 3= LAST POSSIBLE ENTRY IN THIS BUFFER - ! 4= PTR PREVIOUS BUFFER (OR -1) - BINBUF J !ADDRESS BIN BUFFER - ! LAST ADDRESS= PTR PREVIOUS DISK -! -! DFTing -! - DFTBFA J(0:3) !BUFFERS FOR DFT - DFTWT E(0:3) !TOTAL WEIGHTS DFT -! -! Convolution -! - UHIGH J !HIGHEST U COORD. (CELLS) - VLOW J !LOWEST V COORD. (CELLS) - VHIGH J !HIGHEST V COORD. (CELLS) - USIZE J !# OF LINES PER CONVOL. BIN - VSIZE J !# OF POINTS PER CONVOL. LINE - ULOB J !LOW BOUND CURRENT CONVOL. BIN - DECVB J(0:1) !BUFFERS DECONVOLUTION -! - UVMAX E(0:1) !MAX. U,V - UV1MAX E(0:1) !MAX. U,V FOR BAS-HA TYPE - UV2MAX E(0:1) !MAX. U,V FOR IFR-HA TYPE - UVCMAX J(0:1) !MAX. U,V COORDINATE - UVSC E !U,V INTERNAL SCALE - FRQMAX E !MAX. FREQUENCY IN INPUT - FRQMIN E !MIN. FREQUENCY IN INPUT -! - CNTJVL J(0:CNTJ-1) !AVERAGE VALUES AND COUNTS: - ! 0= OBS. DAY - ! 1= OBS. YEAR - ! 2= SET COUNT - ! 3= VELOCITY TYPE - ! 4= DATA POINT COUNT - ! 5= BASELINE COUNT - ! 6= INSTRUMENT TYPE - CNTDVL D(0:CNTD-1) !AVERAGE VALUES AND COUNTS: - ! 0= OBS. RA FIRST SET - ! 1= OBS. DEC FIRST SET - ! 2= EPOCH RA FIRST SET - ! 3= EPOCH DEC FIRST SET - ! 4= EPOCH - ! 5= TOTAL AVERAGE BANDWIDTH - ! 6= AVERAGE WEIGHTED FREQUENCY - ! 7= VELOCITY - ! 8= REF. VELOCITY - ! 9= REF. LINE FREQUENCY - !10= RESID. MOSAIC L SHIFT - !11= RESID. MOSAIC M SHIFT - !12= REST. LINE FREQ. - !13= 1950/2000 - !14= AVERAGE BANDWIDTH -! - SUM D !NORMALIZING SUM - SGPH J(0:7) !SUB-GROUP POINTER - SGNR J(0:7) !SUB-GROUP NUMBER - CNTCVL C24(0:CNTC-1) !CHARACTER DATA: - ! 0= FIELDNAME - ! 1= USER COMMENT -! - JOBSUM J(0:1) !PTR/LENGTH JOB SUMMARY - RMVAL E(0:MXRMVAL-1) !ROTATION MEASURE VALUES -.END diff --git a/src/nmap/nma.grp b/src/nmap/nma.grp deleted file mode 100644 index 3504479ce3fd57a75b790b3be389e8ab749cc8ae..0000000000000000000000000000000000000000 --- a/src/nmap/nma.grp +++ /dev/null @@ -1,94 +0,0 @@ -!+ NMA.GRP -! WNB 910219 -! -! Revisions: -! WNB 910822 Add NMAFID -! WNB 911031 Add NMAFMC -! WNB 921202 Add NMAMAC, NMADAC -! WNB 921211 Add PEF/PSC -! WNB 930929 Add SMP.DSC; NMAFLD.FOR -! CMV 940607 Add NMAJSL.FOR -! HjV 940714 Add NMARFT.FOR, NMARFH.FOR -! CMV 940821 Add WMPSETS.PEF -! CMV 940929 Add NMARFS -! JPH 941017 Add MDLNODE.PEF, WMPNODE.PEF, WMPSETS.PEF -! WNB 950809 Add NMAMKP -! -! Map handling -! -! Group definition: -! -NMA.GRP -! -! PIN files -! -MDLNODE.PEF ! MDL_NODE keywords -WMPNODE.PEF ! WMP_NODE keywords -WMPSETS.PEF ! WMP_SETS keywords -NMAP.PEF ! MAP-making keywords -NMAP.PSC -! -! Structure files -! -MPH.DSC ! Map header block -SMP.DSC ! R-series map header block -! -! Fortran definition files: -! -NMA.DSC ! Program common/parameters -! -! Programs: -! -NMAP.FOR ! Main routine -NMACVF.FOR !NMACVF Calculate convolution function -NMACVL.FOR !NMACVL Convolve a sorted data set -NMACVX.FOR !NMACVX Convolve a data point -NMADAR.FOR !NMADAR Get map area(s) -NMADAT.FOR !NMADAT Get program data - !NMADAC ... for data clean -NMADFT.FOR !NMADFT Build DFT map - !NMADF1 Show DFT map -NMAFID.FOR !NMAFID Combine maps -NMAFLD.FOR !NMAFLD Load foreign format maps -NMAFMC.FOR !NMAFMC Combine mosaic maps -NMAINI.FOR !NMAINI Init program -NMAJSL.FOR !NMAJSL Init job summary log - !NMAJSS Add scan to log - !NMAJSM Add map to log - !NMAJSP Print log -NMAMAK.FOR !NMAMAK Make maps - !NMAMAC Make map for data clean -NMAMKP.FOR !NMAMKP Convert U,V visibil. into P intensity -NMANVS.FOR !NMANVS Update version -NMAOFR.FOR !NMAOFR Convert from old format -NMAOTO.FOR !NMAOTO Convert toi old format -NMAPFL.FOR !NMAPFL Print file layout -NMAPMH.FOR !NMAPMH Print map header -NMAPRT.FOR !NMAPRT Show map data -NMARFH.FOR !NMARFH Read FITS header -NMARFS.FOR !NMARFS Decode FITS string header record -NMARFT.FOR !NMARFT Read FITS data -NMASCN.FOR !NMASCN Read a corrected scan -NMASOI.FOR !NMASOI Init UV sort -NMASON.FOR !NMASON End UV sort -NMASOR.FOR !NMASOR Do UV sort -NMASOT.FOR !NMASOT UV sort for one scan -NMASST.FOR !NMASST Get input statistics all data - !NMASS1 Get input statistics one map -NMASTG.FOR !NMASTG Get next set specified - !NMASTH Get next set, no version check - !NMASTL Get next set with loop info -NMATRP.FOR !NMATRP Transpose and output -NMAUNI.FOR !NMAUNI Do uniforming -NMAUNU.FOR !NMAUNU Get uniform factor -NMAUNX.FOR !NMAUNX Do uniform convolution -NMAWFH.FOR !NMAWFH Write FITS header -NMAWFT.FOR !NMAWFT Write FITS data -NMAXCV.FOR !NMAXCV Convert data format between machines -NMAXMH.FOR !NMAXMH Show map header in full detail - !NMAEMH Edit map header -! -! Executables -! -NMAP.EXE ! Map handling -!- diff --git a/src/nmap/nmacvf.for b/src/nmap/nmacvf.for deleted file mode 100644 index 6225fe0331481c697941edbca05b51707cae55f5..0000000000000000000000000000000000000000 --- a/src/nmap/nmacvf.for +++ /dev/null @@ -1,208 +0,0 @@ -C+ NMACVF.FOR -C WNB 910304 -C -C Revisions: -C - SUBROUTINE NMACVF(N,CVLTP,CVSTP,FTSZ,OUTSZ,TAB,TABU,TABV) -C -C Calculate convolution function -C -C Result: -C -C CALL NMACVF ( N_J:I, CVLTP_J:I, CVSTP_J:I, FTSZ_J(0:1):I, -C OUTSZ_J(0:1), TAB_E(0:*):O, TABU_E(0:*):O, -C TABV_E(0:*):O,) -C Calculate convolution function in TAB, -C and the convolution correction functions -C in TABU and TABV respectively. TAB will be N -C points long, TABU and V resp. OUTSZ(0) and (1). -C CVLTP is the type of function, CVLSTP the -C interval. -C -C -C PIN references: -C -C -C Include files: -C - INCLUDE 'WNG_DEF' -C -C Parameters: -C -C -C Arguments: -C - INTEGER N !NUMBER OF POINTS IN TABLE - REAL TAB(0:*) !CONVOLUTION FUNCTION TABLE - REAL TABU(0:*) !U CORRECTION TABLE - REAL TABV(0:*) !V CORRECTION TABLE - INTEGER CVLTP !CONVOLUTION TYPE - INTEGER CVSTP !CONVOLUTION STEP - INTEGER FTSZ(0:1) !FFT SIZE - INTEGER OUTSZ(0:1) !OUTPUT SIZE -C -C Function references: -C -C -C Data declarations: -C - REAL SN,CS,DSN,DCS !SIN/COS VALUES FT - REAL P1,P2,P3 !PARAMETERS - REAL R2 -C- -C -C CONSTANT -C - IF (CVLTP.LT.1 .OR. CVLTP.GT.5) THEN - DO I=0,N-1 - TAB(I)=1 - END DO -C - DO I=0,OUTSZ(0)/2 - TABU(I)=1 - END DO - DO I=0,OUTSZ(1)/2 - TABV(I)=1 - END DO -C -C INIT -C - ELSE - DO I=0,OUTSZ(0)/2 !EMPTY RESULT U - TABU(I)=0 - END DO - DO I=0,OUTSZ(1)/2 !EMPTY RESULT V - TABV(I)=0 - END DO -C -C GAUSSIAN -C - IF (CVLTP.EQ.1) THEN - P1=SQRT(-.25*PI*PI/LOG(.25))/CVSTP !PARAMETER -C -C BOX -C -C -C PROLATE 4*4 -C - ELSE IF (CVLTP.EQ.3) THEN - P1=1./(2.*CVSTP) -C -C EXP*SINC -C - ELSE IF (CVLTP.EQ.4) THEN - P1=PI/1.55/CVSTP !PARAMETERS - P2=1./2.52/CVSTP - P3=2. -C -C PROLATE 6*6 -C - ELSE IF (CVLTP.EQ.5) THEN - P1=1./(3.*CVSTP) - END IF -C -C DETERMINE CORRECTION FUNCTION -C - DO I1=0,N-1 -C -C GAUSS -C - IF (CVLTP.EQ.1) THEN - R1=EXP(-((P1*I1)**2)) !VALUE -C -C BOX -C - ELSE IF (CVLTP.EQ.2) THEN - IF (I1.LT.CVSTP/2) THEN - R1=1 - ELSE IF (I1.EQ.CVSTP/2) THEN - R1=.5 - ELSE - R1=0 - END IF -C -C PROLATE 4*4 -C - ELSE IF (CVLTP.EQ.3) THEN - R2=I1*P1 - IF (R2.LE.1.) THEN - R0=R2*R2-1. - R1=(((((2.853104E-2*R0-1.215569E-1)*R0+2.363775E-1)*R0- - 1 1.971357E-1)*R0+5.007900E-2)/ - 2 ((6.458640E-2*R0+4.228767E-1)*R0+1))*(1-R2*R2) - ELSE - R1=0 - END IF -C -C EXP*SINC -C - ELSE IF (CVLTP.EQ.4) THEN - IF (I1.EQ.0) THEN - R1=1 - ELSE - R1=(SIN(P1*I1)/(P1*I1))*EXP(-((P2*I1)**P3)) - END IF -C -C PROLATE 6*6 -C - ELSE IF (CVLTP.EQ.5) THEN - R2=I1*P1 - IF (R2.GT.1.) THEN - R1=0 - ELSE IF (R2.LE.0.75) THEN - R0=R2*R2-.5625 - R1=(((((2.312756E-1*R0-5.335581E-1)*R0+6.278660E-1)*R0- - 1 3.644705E-1)*R0+8.203343E-2)/ - 2 ((2.078043E-1*R0+8.212018E-1)*R0+1))*(1-R2*R2) - ELSE - R0=R2*R2-1. - R1=(((((6.412774E-2*R0-1.201436E-1)*R0+1.021332E-1)*R0- - 1 3.697768E-2)*R0+4.028559E-3)/ - 2 ((2.918724E-1*R0+9.599102E-1)*R0+1))*(1-R2*R2) - END IF - END IF -C -C CONVOLUTION VALUE -C - TAB(I1)=R1 !SAVE VALUE - IF (I1.EQ.0) R1=.5*R1 !CENTRE VALUE - CS=1 !START COS/SIN - SN=0 - DSN=PI2*I1/FLOAT(CVSTP)/FLOAT(FTSZ(0)) !STEP COS/SIN U - DCS=COS(DSN) - DSN=SIN(DSN) - DO I=0,OUTSZ(0)/2 !ADD TO ALL CORRECTION U - TABU(I)=TABU(I)+R1*CS - R0=CS*DCS-SN*DSN !NEW COS/SIN - SN=SN*DCS+CS*DSN - CS=R0 - END DO - CS=1 !START COS/SIN - SN=0 - DSN=PI2*I1/FLOAT(CVSTP)/FLOAT(FTSZ(1)) !STEP COS/SIN V - DCS=COS(DSN) - DSN=SIN(DSN) - DO I=0,OUTSZ(1)/2 !ADD TO ALL CORRECTION V - TABV(I)=TABV(I)+R1*CS - R0=CS*DCS-SN*DSN !NEW COS/SIN - SN=SN*DCS+CS*DSN - CS=R0 - END DO - END DO -C -C GET CORRECTION FUNCTION -C - R0=TABU(0) - DO I=0,OUTSZ(0)/2 !NORMALIZE U - IF (TABU(I).NE.0) TABU(I)=R0/TABU(I) - END DO - R0=TABV(0) - DO I=0,OUTSZ(1)/2 !NORMALIZE V - IF (TABV(I).NE.0) TABV(I)=R0/TABV(I) - END DO - END IF -C - RETURN -C -C - END diff --git a/src/nmap/nmacvl.for b/src/nmap/nmacvl.for deleted file mode 100644 index 05ffde725f5912bd4f78472dd33c7809a5b9de70..0000000000000000000000000000000000000000 --- a/src/nmap/nmacvl.for +++ /dev/null @@ -1,443 +0,0 @@ -C+ NMACVL.FOR -C WNB 910307 -C -C Revisions: -C WNB 910730 Reverse order FFT -C WNB 911009 Typo in declarations -C WNB 911105 Change RAO/DECO definition -C WNB 920406 Typo in map output UV plane -C WNB 920423 Type correct set # -C WNB 920423 Make max/min for UV output correct for size -C WNB 920828 Update line frequencies and instrument type -C WNB 921104 J2000 -C WNB 930127 New bandwidth -C WNB 930510 Make sure even sized output -C - SUBROUTINE NMACVL(FIN,FOUT,BAD,NP) -C -C Do convolution to rectangular grid -C -C Result: -C -C CALL NMACVL ( FIN_J:I, FOUT_J:I, BAD_J(4,0:*):I, NP_J:I) -C Do convolution to rectangular grid, -C using sorted data in FIN, and writing -C convolved data to FOUT. BAD is the -C bin administration. NP is the -C polarisation. -C -C -C Include files: -C - INCLUDE 'WNG_DEF' - INCLUDE 'GFH_O_DEF' !GENERAL FILE HEADER - INCLUDE 'SGH_O_DEF' !SUB-GROUP HEADER - INCLUDE 'MPH_O_DEF' !MAP HEADER - INCLUDE 'NMA_DEF' -C -C Parameters: -C -C -C Arguments: -C - INTEGER FIN !SORTED INPUT FILE - INTEGER FOUT !CONVOLVED OUTPUT FILE - INTEGER BAD(4,0:*) !SORT BIN ADMINISTRATION - INTEGER NP !POLARISATION TO DO (0,1..) -C -C Function references: -C - LOGICAL WNGGVA !GET VIRTUAL MEMORY - LOGICAL WNFOP !OPEN FILE - LOGICAL WNFRD !READ FILE - LOGICAL WNFWR,WNFWRS !WRITE FILE - INTEGER WNFEOF !FILE POINTER - LOGICAL WNDLNG,WNDLNF !LINK SUB-GROUP - LOGICAL WNDLNK !LINK SET - INTEGER WNMEJC !CEIL(X) - INTEGER WNMEJF !FLOOR(X) - CHARACTER*20 WNFFNM !GET FILE NAME -C -C Data declarations: -C - INTEGER CVFLEN !LENGTH CONVOL. TABLE (BYTES) - INTEGER CVLFUN !ADDRESS CONVOLUTION FUNCTION - INTEGER MAPBUF,MAPBFX !ADDRESS MAP CONVOL. BUFFER - INTEGER APBUF,APBUFE !ADDRESS AP CONVOL. BUFFER - INTEGER FTBUF,FTBUFE,FTBUFX !FFT BUFFER - INTEGER WTBUF,WTBUFX !FFT WEIGHT BUFFER - INTEGER UVBUF(NOPT),UVBUFE(NOPT) !UV OUTPUT BUFFER - INTEGER UVPTR(NOPT) !UV OUTPUT POINTER - INTEGER UOUT !CURRENT U OUTPUT - REAL UVMN(NOPT),UVMX(NOPT) !MIN/MAX - INTEGER MINR(NOPT),MAXR(NOPT),MIND(NOPT),MAXD(NOPT) !POS. MIN/MAX - REAL BUF(0:MXSBJ-1) !INPUT BUFFER - INTEGER JBUF(0:MXSBJ-1) - EQUIVALENCE (BUF,JBUF) - BYTE MPH(0:MPHHDL-1) !MAP HEADER - INTEGER*2 MPHI(0:MPHHDL/2-1) - INTEGER MPHJ(0:MPHHDL/4-1) - REAL MPHE(0:MPHHDL/4-1) - DOUBLE PRECISION MPHD(0:MPHHDL/8-1) - EQUIVALENCE (MPH,MPHI,MPHJ,MPHE,MPHD) -C- -C -C INIT -C - UHIGH=2*((UVCMAX(0)-1)/2)+1 !MAXIMUM U COORDINATE - VHIGH=UVCMAX(1) !MAXIMUM V COORDINATE - VLOW=-UVCMAX(1) !MINIMUM V COORDINATE - VSIZE=2*UVCMAX(1)+1 !LENGTH CONVOLUTION LINE - USIZE=WNMEJC(BINSIZ+2*CVLWID(0)) !SIZE OF ONE U CONVOLUTION BUF. - ULOB=0 !START WITH U=0 -C - SUM=0 !NORMALIZING SUM -C -C GET OUTPUT FILES -C - IF (.NOT.WNFOP(FOUT,WNFFNM('NMA','TMP'),'WT')) THEN !OPEN OUTPUT FILE - CALL WNCTXT(F_TP,'Cannot open convolution output file') - CALL WNGEX !FINISH PROGRAM - END IF -C - J=WNFEOF(FCAOUT) !OUTPUT DISK POINTER - DO I=3,NOPT !OPEN UV PLANE OUTPUT FILES - IF (OUTOPT(I)) THEN !THIS ONE WANTED - UVPTR(I)=J !HERE TO WRITE - J=J+MPHHDL+LB_E*(VSIZE+1)*(UHIGH+1) !NEXT OUTPUT POINTER - END IF - END DO -C -C GET BUFFERS -C -C CONVOLUTION -C - CVFLEN=LB_E*(WNMEJC(CVLWID(0)*CVLSTP)+1) !LENGTH CONVOLUTION TABLE - JS=WNGGVA(CVFLEN,CVLFUN) !CONVOLUTION FUNCTION TABLE - IF (JS) JS=WNGGVA(LB_E*(OUTSIZ(0)/2+1),DECVB(0)) !U CORR. TABLE - IF (JS) JS=WNGGVA(LB_E*(OUTSIZ(1)/2+1),DECVB(1)) !V CORR. TABLE - IF (.NOT.JS) THEN - CALL WNCTXT(F_TP,'Cannot obtain convolution function buffer') - CALL WNGEX !STOP PROGRAM - END IF - CALL NMACVF(CVFLEN/LB_E,CVLTYP,CVLSTP,FTSIZ,OUTSIZ, - 1 A_B(CVLFUN-A_OB),A_B(DECVB(0)-A_OB), - 1 A_B(DECVB(1)-A_OB)) !MAKE CONVOLUTION FUNCTION -C -C FFT -C - JS=WNGGVA(LB_X*FTSIZ(1),FTBUF) !GET FFT BUF - FTBUFE=(FTBUF-A_OB)/LB_E - FTBUFX=(FTBUF-A_OB)/LB_X - IF (JS) JS=WNGGVA(LB_X*FTSIZ(1)/2,WTBUF) !GET FFT WEIGHT BUF - WTBUFX=(WTBUF-A_OB)/LB_X - IF (.NOT.JS) THEN - CALL WNCTXT(F_TP,'Cannot obtain FFT1 buffer') - CALL WNGEX !STOP PROGRAM - END IF - DO I=0,FTSIZ(1)/2-1 !FILL FFT WEIGHT - R0=I*PI2/FTSIZ(1) - A_X(WTBUFX+I)=CMPLX(COS(R0),-SIN(R0)) - END DO -C -C MAP CONVOLUTION -C - IF (MAKMAP) THEN - IF (.NOT.WNGGVA(LB_X*USIZE*(VSIZE+1), - 1 MAPBUF)) THEN !GET MAP CONVOLUTION BUFFER - CALL WNCTXT(F_TP,'Cannot obtain map convolution buffer') - CALL WNGEX !STOP PROGRAM - END IF - MAPBFX=(MAPBUF-A_OB)/LB_X - CALL WNGMVZ(LB_X*(VSIZE+1)*USIZE,A_X(MAPBFX)) !CLEAR BUF - END IF - IF (MAKAP) THEN - IF (.NOT.WNGGVA(LB_E*USIZE*(VSIZE+1), - 1 APBUF)) THEN !GET AP CONVOLUTION BUFFER - CALL WNCTXT(F_TP,'Cannot obtain antenna pattern '// - 1 'convolution buffer') - CALL WNGEX !STOP PROGRAM - END IF - APBUFE=(APBUF-A_OB)/LB_E - CALL WNGMVZ(LB_E*(VSIZE+1)*USIZE,A_E(APBUFE)) !CLEAR BUF - END IF -C -C UV PLANES -C - DO I=3,NOPT - IF (OUTOPT(I)) THEN !UV PLANE OUTPUT - IF (.NOT.WNGGVA(LB_E*(VSIZE+1),UVBUF(I))) THEN !GET BUFFER - CALL WNCTXT(F_TP,'Cannot obtain UV plane output buffers') - CALL WNGEX !STOP PROGRAM - END IF - UVBUFE(I)=(UVBUF(I)-A_OB)/LB_E - END IF - END DO -C -C DO CONVOLUTION -C -C INIT -C - UOUT=0 !START U OUTPUT - DO I=3,NOPT - UVMX(I)=-1E36 !MAX - UVMN(I)=1E36 !MIN - END DO -C -C ALL BINS -C - DO I=0,NBIN-1 !DO FOR ALL BINS - J=BAD(4,I) !BLOCK IN BIN - DO WHILE (J.NE.-1) !MORE DATA IN BIN - IF (WNFRD(FIN,MXSBB,BUF,J)) THEN !READ BUF - J=JBUF(MXSBJ-1) !POINTER TO NEXT BUF - ELSE - CALL WNCTXT(F_TP,'Read error sorted file') - CALL WNGEX !STOP PROGRAM - END IF - DO I1=0,BAD(3,I)-1,3+2*NPOL !DO ALL DATA POINTS - IF (JBUF(I1+2).EQ.0) GOTO 10 !BUFFER READY - CALL NMACVX(BUF(I1+2),BUF(I1),BUF(I1+3+2*NP), - 1 A_B(CVLFUN-A_OB),A_X(MAPBFX), - 1 A_E(APBUFE)) !DO CONVOLUTION - END DO !END POINTS - 10 CONTINUE - END DO !MORE IN BIN -C -C OUTPUT DATA FOR A BIN -C -C UV -C - J2=MIN(WNMEJF((I+1)*BINSIZ-CVLWID(0)),UHIGH) !MAX. U TO OUTPUT - IF (I.EQ.NBIN-1) J2=UHIGH !LAST BIN: DO REMAINDER - DO J1=UOUT,J2 !OUTPUT WHAT IS POSSIBLE - J0=J1-ULOB !OFFSET IN BUF - IF (J0.GE.USIZE) J0=J0-USIZE !WRAP - DO I5=3,NOPT - IF (OUTOPT(I5)) THEN !OUTPUT UV PLANE - A_E(UVBUFE(I5))=0 !CENTRE POINT - IF (I5.EQ.4) THEN !REAL - CALL WNMARL(VSIZE,A_X(MAPBFX+J0*VSIZE), - 1 A_E(UVBUFE(I5)+1)) - ELSE IF (I5.EQ.5) THEN !IMAGINARY - CALL WNMAIM(VSIZE,A_X(MAPBFX+J0*VSIZE), - 1 A_E(UVBUFE(I5)+1)) - ELSE IF (I5.EQ.6) THEN !AMPLITUDE - CALL WNMAAM(VSIZE,A_X(MAPBFX+J0*VSIZE), - 1 A_E(UVBUFE(I5)+1)) - ELSE IF (I5.EQ.7) THEN !PHASE - CALL WNMAPH(VSIZE,A_X(MAPBFX+J0*VSIZE), - 1 A_E(UVBUFE(I5)+1)) - ELSE !COVER - CALL WNGMV(LB_E*VSIZE, - 1 A_E(APBUFE+J0*VSIZE), - 1 A_E(UVBUFE(I5)+1)) !FILL OUTPUT BUF - END IF - R0=-1E36 !FIND MAX/MIN - R1=1E36 - CALL WNMFMX(VSIZE+1,A_E(UVBUFE(I5)),1D0,R0, - 1 I3,R1,I4) !FIND MAX/MIN - IF (R0.GT.UVMX(I5)) THEN !NEW MAX - UVMX(I5)=R0 - MAXR(I5)=I3-(VSIZE+1)/2 - MAXD(I5)=J1-(UHIGH+1)/2 !920423 - END IF - IF (R1.LT.UVMN(I5)) THEN !NEW MIN - UVMN(I5)=R1 - MINR(I5)=I4-(VSIZE+1)/2 - MIND(I5)=J1-(UHIGH+1)/2 !920423 - END IF - IF (.NOT.WNFWR(FCAOUT,LB_E*(VSIZE+1), - 1 A_E(UVBUFE(I5)), - 1 UVPTR(I5)+MPHHDL+J1*LB_E*(VSIZE+1))) THEN !OUTPUT 920406 - 20 CONTINUE - CALL WNCTXT(F_TP,'Write error convolved data') - CALL WNGEX !STOP PROGRAM - END IF - END IF - END DO -C -C MAP -C - IF (OUTOPT(1)) THEN - CALL WNGMV(LB_X*(VHIGH+1),A_X(MAPBFX+J0*VSIZE-VLOW), - 1 A_X(FTBUFX)) !0...VMAX - CALL WNGMV(-LB_X*VLOW,A_X(MAPBFX+J0*VSIZE), - 1 A_X(FTBUFX+FTSIZ(1)+VLOW)) !VLOW...0 - CALL WNGMVZ(LB_X*(FTSIZ(1)-VSIZE), - 1 A_X(FTBUFX+VHIGH+1)) !VHIGH...VLOW - CALL WNMFTC(FTSIZ(1),A_X(FTBUFX),A_X(WTBUFX)) !FFT - CALL WNMFCS(FTSIZ(1),A_X(FTBUFX)) !SWAP HALVES - IF (.NOT.WNFWRS(FOUT,LB_X*OUTSIZ(1), - 1 A_X(FTBUFX+(FTSIZ(1)- - 1 OUTSIZ(1))/2))) GOTO 20 !OUTPUT MAP LINE - END IF - IF (MAKMAP) CALL WNGMVZ(LB_X*VSIZE, - 1 A_X(MAPBFX+J0*VSIZE)) !CLEAR BUF -C -C AP -C - IF (OUTOPT(2)) THEN - CALL WNGMV(LB_E*(VHIGH+1),A_E(APBUFE+J0*VSIZE-VLOW), - 1 A_E(FTBUFE)) !0...VMAX - CALL WNGMV(-LB_E*VLOW,A_E(APBUFE+J0*VSIZE), - 1 A_E(FTBUFE+FTSIZ(1)+VLOW)) !VLOW...0 - CALL WNGMVZ(LB_E*(FTSIZ(1)-VSIZE), - 1 A_E(FTBUFE+VHIGH+1)) !VHIGH...VLOW - CALL WNMFRC(FTSIZ(1),A_E(FTBUFE)) !REAL TO COMPLEX - CALL WNMFTC(FTSIZ(1),A_X(FTBUFX),A_X(WTBUFX)) !FFT - CALL WNMFCS(FTSIZ(1),A_X(FTBUFX)) !SWAP HALVES - IF (.NOT.WNFWRS(FOUT,LB_X*OUTSIZ(1), - 1 A_X(FTBUFX+(FTSIZ(1)- - 1 OUTSIZ(1))/2))) GOTO 20 !OUTPUT AP LINE - END IF - IF (MAKAP) CALL WNGMVZ(LB_E*VSIZE, - 1 A_E(APBUFE+J0*VSIZE)) !CLEAR BUF - END DO - UOUT=J2+1 !NEXT OUTPUT START - IF (UOUT-ULOB.GE.USIZE) ULOB=ULOB+USIZE !WRAPPING - END DO !END BINS -C -C FREE BUFFERS -C - CALL WNGFVA(CVFLEN,CVLFUN) !CONVOLUTION FUNCTION - CALL WNGFVA(LB_X*FTSIZ(1),FTBUF) !FFT BUFFER - CALL WNGFVA(LB_X*FTSIZ(1)/2,WTBUF) !FFT WEIGHT BUFFER - IF (MAKMAP) CALL WNGFVA(LB_X*USIZE*(VSIZE+1), - 1 MAPBUF) !RELEASE MAP BUFFER - IF (MAKAP) CALL WNGFVA(LB_E*USIZE*(VSIZE+1), - 1 APBUF) !RELEASE AP BUFFER - DO I=3,NOPT - IF (OUTOPT(I)) THEN !UV PLANE OUTPUT - CALL WNGFVA(LB_E*(VSIZE+1),UVBUF(I)) - END IF - END DO -C -C CLOSE UV PLANE OUTPUT -C - DO I=3,NOPT - IF (OUTOPT(I)) THEN - CALL WNGMVZ(MPHHDL,MPH) !CLEAR HEADER - MPHJ(MPH_MDP_J)=UVPTR(I)+MPHHDL !DATA POINTER - MPHI(MPH_VER_I)=MPHHDV !HEADER VERSION - MPHI(MPH_LEN_I)=MPHHDL !HEADER LENGTH - MPHJ(MPH_NRA_J)=VSIZE+1 !FILL HEADER - SIZE RA - MPHJ(MPH_NDEC_J)=UHIGH+1 !SIZE DEC - MPHJ(MPH_NFRQ_J)=1 !SIZE FREQ. - MPHD(MPH_SUM_D)=SUM !NORMALISATION - CALL WNGMFS(MPH_FNM_N,CNTCVL(0),MPH(MPH_FNM_1)) !FIELD NAME - MPHD(MPH_BDW_D)=CNTDVL(14) !OBS. BANDWIDTH - MPHD(MPH_RA_D)=MAPCRD(0) !RA - MPHD(MPH_DEC_D)=MAPCRD(1) !DEC - IF (ABS(MAPCTP).EQ.2) THEN !EPOCH - MPHD(MPH_RAO_D)=CNTDVL(0) !RA - MPHD(MPH_DECO_D)=CNTDVL(1) !DEC - ELSE !DATE - MPHD(MPH_RAO_D)=CNTDVL(2) !RA - MPHD(MPH_DECO_D)=CNTDVL(3) !DEC - END IF - MPHD(MPH_FRQO_D)=CNTDVL(6) !FREQ. - MPHD(MPH_FRQ_D)=CNTDVL(6) !FREQ. - MPHI(MPH_ODY_I)=CNTJVL(0) !DAY - MPHI(MPH_OYR_I)=CNTJVL(1) !YEAR - MPHJ(MPH_INST_J)=CNTJVL(6) !INSTRUMENT TYPE - MPHI(MPH_DCD_I)=5 !DATA CODE (E) - MPHI(MPH_PCD_I)=0 !PROGRAM CODE NMAP - MPHD(MPH_SRA_D)=FIELD(0)/FTSIZ(0)/PI2 !RA GRID STEP - MPHD(MPH_SDEC_D)=FIELD(1)/FTSIZ(1)/PI2 !DEC GRID STEP - MPHD(MPH_SHR_D)=SHIFT(0)/3600./360. !FIELDSHIFT RA - MPHD(MPH_SHD_D)=SHIFT(1)/3600./360. !FIELDSHIFT DEC - MPHJ(MPH_NPT_J)=CNTJVL(4) !# POINTS - MPHJ(MPH_NBL_J)=CNTJVL(5) !# BASELINES - MPHJ(MPH_NST_J)=CNTJVL(2) !# SETS - MPHJ(MPH_VELC_J)=CNTJVL(3) !VEL. CODE - MPHE(MPH_VEL_E)=CNTDVL(7) !VELOCITY - MPHD(MPH_FRQC_D)=CNTDVL(9) !REF. FREQ. - MPHE(MPH_VELR_E)=CNTDVL(8) !REF. VELOCITY - MPHD(MPH_FRQV_D)=MPHD(MPH_FRQO_D) !OBS. CHANNEL FREQUENCY - MPHD(MPH_FRQ0_D)=CNTDVL(12) !REST FREQ. - MPHE(MPH_UNI_E)=5./1000. !FACTOR TO GET JY - CALL WNGMFS(MPH_UCM_N,CNTCVL(1),MPH(MPH_UCM_1)) !USER COMMENT - IF (I.EQ.3) THEN !SET OUTPUT TYPE - CALL WNGMFS(MPH_TYP_N,'COVER',MPH(MPH_TYP_1)) - ELSE IF (I.EQ.4) THEN - CALL WNGMFS(MPH_TYP_N,'REAL',MPH(MPH_TYP_1)) - ELSE IF (I.EQ.5) THEN - CALL WNGMFS(MPH_TYP_N,'IMAG',MPH(MPH_TYP_1)) - ELSE IF (I.EQ.6) THEN - CALL WNGMFS(MPH_TYP_N,'AMPL',MPH(MPH_TYP_1)) - ELSE IF (I.EQ.7) THEN - CALL WNGMFS(MPH_TYP_N,'PHASE',MPH(MPH_TYP_1)) - END IF - CALL WNGMFS(MPH_POL_N,POLC(NP),MPH(MPH_POL_1)) !POL. CODE - MPHI(MPH_CD_I+0)=TAPTYP !TAPER TYPE - MPHI(MPH_CD_I+1)=CVLTYP !CONVOLUTION TYPE - IF (DECVL) THEN - MPHI(MPH_CD_I+2)=1 !DE-CONVOLVE - ELSE - MPHI(MPH_CD_I+2)=0 !NO DE-CONVOLVE - END IF - IF (CLIP) THEN - MPHI(MPH_CD_I+3)=1 !CLIP - ELSE - MPHI(MPH_CD_I+3)=0 !NO CLIP - END IF - IF (SUB) THEN - MPHI(MPH_CD_I+4)=1 !SOURCE SUBTRACTS - ELSE - MPHI(MPH_CD_I+4)=0 !NO SUBTRACTS - END IF - MPHI(MPH_CD_I+5)=DATTYP !DATA TYPE - MPHI(MPH_CD_I+6)=UVCDT !UV COORD. TYPE - MPHI(MPH_CD_I+7)=0 !DE-BEAM COUNT - IF (ABS(MAPCTP).EQ.2) THEN !EPOCH - MPHI(MPH_EPT_I)=1 !EPOCH TYPE - MPHE(MPH_EPO_E)=CNTDVL(13) !EPOCH - MPHE(MPH_OEP_E)=CNTDVL(4) !OBS. EPOCH - ELSE !DATE - MPHI(MPH_EPT_I)=0 !DATE TYPE - MPHE(MPH_EPO_E)=CNTDVL(4) !EPOCH - MPHE(MPH_OEP_E)=CNTDVL(4) !OBS. EPOCH - END IF - MPHE(MPH_FRA_E)=(OUTSIZ(0)-1)*MPHD(MPH_SRA_D) !FIELD SIZE RA - MPHE(MPH_FDEC_E)=(OUTSIZ(1)-1)*MPHD(MPH_SDEC_D) !FIELD SIZE DEC - MPHE(MPH_FFRQ_E)=0 !FIELD SIZE FREQ - CALL WNGMFS(MPH_TEL_N,'WSRT',MPH(MPH_TEL_1)) !TEL. NAME - MPHJ(MPH_FSR_J)=FTSIZ(0) !FFT SIZES - MPHJ(MPH_FSD_J)=FTSIZ(1) -C - MPHE(MPH_MAX_E)=UVMX(I) !MAX/MIN - MPHE(MPH_MIN_E)=UVMN(I) - MPHJ(MPH_MNR_J)=MINR(I) - MPHJ(MPH_MND_J)=MIND(I) - MPHJ(MPH_MXR_J)=MAXR(I) - MPHJ(MPH_MXD_J)=MAXD(I) - MPHJ(MPH_ZRA_J)=(VSIZE+1)/2 !CENTRE RA - MPHJ(MPH_ZDEC_J)=0 !CENTRE DEC - IF (.NOT.WNFWR(FCAOUT,MPHHDL,MPH,UVPTR(I))) THEN !WRITE HEADER - CALL WNCTXT(F_TP,'I/O error UV plane') - END IF - IF (.NOT.WNDLNF(SGPH(3)+SGH_LINKG_1,I-1,SGH_GROUPN_1,FCAOUT, - 1 SGPH(4),SGNR(4))) THEN !FIND/CREATE SUB-GROUP - 30 CONTINUE - CALL WNCTXT(F_TP,'Error creating sub-group') - CALL WNGEX !STOP PROGRAM - END IF - IF (.NOT.WNDLNK(GFH_LINK_1,UVPTR(I), - 1 MPH_SETN_1,FCAOUT)) GOTO 30 !LINK THE SET - IF (.NOT.WNDLNG(SGPH(4)+SGH_LINKG_1,UVPTR(I), - 1 SGH_GROUPN_1,FCAOUT,SGPH(5), - 1 SGNR(5))) GOTO 30 !LINK THE SUB-GROUP - CALL WNCTXT(F_P,'!^') !NEW PAGE - CALL WNCTXT(F_TP,'!2/Description of the !AL4'// - 1 ' output produced:',MPH(MPH_TYP_1)) - SGNR(6)=-1 !FINISH NAME - IF (.NOT.WNFRD(FCAOUT,MPHHDL,MPH,UVPTR(I))) GOTO 30 !REREAD HEADER - CALL NMAPMH(F_TP,MPH,SGNR,NODOUT) - END IF - END DO -C - RETURN -C -C - END diff --git a/src/nmap/nmacvx.for b/src/nmap/nmacvx.for deleted file mode 100644 index 1f645043cd85764a0dde61da7a6d69674b2119b6..0000000000000000000000000000000000000000 --- a/src/nmap/nmacvx.for +++ /dev/null @@ -1,111 +0,0 @@ -C+ NMACVX.FOR -C WNB 910306 -C -C Revisions: -C - SUBROUTINE NMACVX(APD,UVD,CSD,CVF,CSMAP,CSAP) - -C -C Do actual convolution of a data point -C -C Result: -C -C CALL NMACVX( APD_E:I, UVD_E(0:1):I, CSD_X:I, CVF_E(0:*):I, -C CSMAP_X(0:*):O, CSAP_E(0:*):O) -C Do the actual convolution of a point with -C weight APD, with CSD as cos/sin data, and -C UVD as U, V. CVF is the convolution weight -C to be used. CSMAP is the output map data -C plane, CSAP the antenna pattern plane. -C -C -C PIN references: -C -C -C Include files: -C - INCLUDE 'WNG_DEF' - INCLUDE 'NMA_DEF' -C -C Parameters: -C -C -C Arguments: -C - REAL APD !DATA WEIGHT - REAL UVD(0:1) !U, V COORDINATE - COMPLEX CSD !COS/SIN DATA - REAL CVF(0:*) !CONVOLUTION FUNCTION - COMPLEX CSMAP(0:*) !OUTPUT MAP PLANE - REAL CSAP(0:*) !OUTPUT AP PLANE -C -C Function references: -C - INTEGER WNMEJC !CEIL(X) - INTEGER WNMEJF !FLOOR(X) -C -C Data declarations: -C - INTEGER LOU !START U OFFSET - INTEGER HIU !HIGH U OFFSET - INTEGER LOV !LOW V OFFSET - INTEGER HIV !HIGH V OFFSET - INTEGER FRU !U FRACTION START - INTEGER FRV !V FRACTION START - COMPLEX DAT !DATA -C- -C -C INIT -C - LOU=WNMEJC(UVD(0)-CVLWID(0)) !LOWEST U - HIU=MIN(WNMEJF(UVD(0)+CVLWID(0)),UHIGH)-ULOB !HIGHEST RELATIVE U - LOV=MAX(WNMEJC(UVD(1)-CVLWID(1)),VLOW) !LOWEST V - HIV=MIN(WNMEJF(UVD(1)+CVLWID(1)),VHIGH)-LOV !V LENGTH - FRU=NINT(CVLSTP*(LOU-UVD(0))) !START IN U CONVOL. TABLE - FRV=NINT(CVLSTP*(LOV-UVD(1))) !START IN V CONVOL. TABLE - LOU=LOU-ULOB !RELATIVE START U -C -C ACTUAL CONVOLUTION -C - DO I=LOU,HIU !ALL U LINES - IF (I.LT.0) THEN !LEFT-HALF OF PLANE - J=ABS(I) !TAKE CONJUGATE - DAT=CONJG(CSD) - J1=-LOV-VLOW !OFFSET V - J2=-1 !STEP IN V - ELSE - J=I - DAT=CSD - J1=LOV-VLOW - J2=1 - END IF - IF (J.GE.USIZE) J=J-USIZE !WRAP AROUND - J=J*VSIZE+J1 !ARRAY POINTER - R0=APD*CVF(ABS(FRU)) !U WEIGHT * WEIGHT - J0=FRV !V WEIGHT POINTER - IF (APD.GE.0) THEN - DO I1=0,HIV !ALL V POINTS - R1=R0*CVF(ABS(J0)) !TOTAL WEIGHT - IF (MAKMAP) CSMAP(J)=CSMAP(J)+R1*DAT !SUM MAP - IF (MAKAP) CSAP(J)=CSAP(J)+R1 !SUM AP - SUM=SUM+R1 !NORMALIZE - J=J+J2 !NEXT V POINT - J0=J0+CVLSTP !NEXT V WEIGHT - END DO - ELSE - DO I1=0,HIV !ALL V POINTS - R1=R0*CVF(ABS(J0)) !TOTAL WEIGHT - IF (MAKMAP) CSMAP(J)=CSMAP(J)+R1*DAT !SUM MAP - IF (MAKAP) CSAP(J)=CSAP(J)-R1 !SUM AP - SUM=SUM-R1 !NORMALIZE - J=J+J2 !NEXT V POINT - J0=J0+CVLSTP !NEXT V WEIGHT - END DO - END IF - FRU=FRU+CVLSTP !NEXT U WEIGHT - END DO -C - RETURN -C -C - END diff --git a/src/nmap/nmadar.for b/src/nmap/nmadar.for deleted file mode 100644 index a1afe5859948bce24b473f72d7050bc9cf327980..0000000000000000000000000000000000000000 --- a/src/nmap/nmadar.for +++ /dev/null @@ -1,210 +0,0 @@ -C+ NMADAR.FOR -C WNB 910402 -C -C Revisions: -C WNB 911220 Error for negative centre -C WNB 920109 Error for odd checking -C HjV 920520 HP does not allow extended source lines -C - SUBROUTINE NMADAR(MXNAR,NAR,FAREA,MNWID,MXAREA,TAREA,PAREA, - 1 TEAR,PEAR) -C -C Get area parameters -C -C Result: -C -C CALL NMADAR( MXNAR_J:I, NAR_J:O, FAREA_J(0:3):I, MNWID_J:I, -C MXAREA_J(0:3):I, TAREA_J(0:3):IO, -C PAREA_J(0:3,*):O, TEAR_J(0:3):O, -C PEAR_J(0:3,*):O) -C Get areas maximally MXNAR sub-area's, -C and return the number found in NAR. -C FAREA specifies the full field coordinates, -C MNWID indicates a minimum width if >0, and -C a check for odd/even. -C MXAREA specifies the maximum area that can be -C found; TAREA will be used as default, and -C return the total enclosing area; PAREA are -C the partial area's found. -C TEAR and PEAR are the same in edge format. -C -C PIN references: -C -C AREA -C -C Include files: -C - INCLUDE 'WNG_DEF' -C -C Parameters: -C -C -C Arguments: -C - INTEGER MXNAR !MAX. AREAS TO FIND - INTEGER NAR !# OF AREAS FOUND - INTEGER FAREA(0:3) !TOTAL INPUT AREA - INTEGER MNWID !MIN. WIDTH AND ODD/EVEN CHECK - INTEGER MXAREA(0:3) !MAX. AREA THAT MAYBE GOT - INTEGER TAREA(0:3) !TOTAL ENCLOSING AREA FOUND/DEFAULT - INTEGER PAREA(0:3,*) !SUB-AREAS FOUND - INTEGER TEAR(0:3) !EDGE FORMAT TOTAL AREA - INTEGER PEAR(0:3,*) !EDGE FORMAT AREAS -C -C Function references: -C - LOGICAL WNDPAR !GET USER DATA -C -C Data declarations: -C - INTEGER LAREA(0:3) !LOCAL AREA -C- -C -C INIT -C - NAR=0 !NO AREA'S FOUND -C -C GET AREA -C - 10 CONTINUE - DO I=0,3 - LAREA(I)=TAREA(I) !DEFAULT AREA - END DO - IF (NAR.GE.MXNAR) GOTO 20 !NO MORE - IF (NAR.GT.0 .OR. LAREA(2).EQ.0 .OR. LAREA(3).EQ.0) THEN - JS=WNDPAR('AREA',LAREA,4*LB_J,J0,'""') !NO DEFAULT - ELSE - JS=WNDPAR('AREA',LAREA,4*LB_J,J0,A_B(-A_OB),LAREA,4) !DEFAULT - END IF - IF (.NOT.JS) THEN - IF (E_C.EQ.DWC_ENDOFLOOP) GOTO 20 !NO MORE - GOTO 10 !RETRY - ELSE IF (J0.EQ.0) THEN - GOTO 20 !ASSUME END - ELSE IF (J0.LT.0) THEN !FULL AREA - DO I=0,3 - LAREA(I)=FAREA(I) - END DO - END IF -C -C SAVE AN AREA IN EDGES FORMAT -C - PEAR(0,NAR+1)=MAX(FAREA(0)-FAREA(2)/2, - 1 LAREA(0)-LAREA(2)/2) !LEFT EDGE - PEAR(1,NAR+1)=MIN(FAREA(0)+(FAREA(2)-1)/2, - 1 LAREA(0)+(LAREA(2)-1)/2) !RIGHT EDGE - PEAR(2,NAR+1)=MAX(FAREA(1)-FAREA(3)/2, - 1 LAREA(1)-LAREA(3)/2) !BOTTOM EDGE - PEAR(3,NAR+1)=MIN(FAREA(1)+(FAREA(3)-1)/2, - 1 LAREA(1)+(LAREA(3)-1)/2) !TOP EDGE -C -C CHECK MAXIMUM AREA -C - IF (PEAR(1,NAR+1)-PEAR(0,NAR+1).GE.MXAREA(2)) THEN !WIDTH - I=(PEAR(1,NAR+1)+PEAR(0,NAR+1)+1)/2 !CENTRE - PEAR(0,NAR+1)=I-MXAREA(2)/2 !LEFT EDGE - PEAR(1,NAR+1)=I+(MXAREA(2)-1)/2 !RIGHT EDGE - END IF - IF (PEAR(3,NAR+1)-PEAR(2,NAR+1).GE.MXAREA(3)) THEN !HEIGHT - I=(PEAR(3,NAR+1)+PEAR(2,NAR+1)+1)/2 !CENTRE - PEAR(2,NAR+1)=I-MXAREA(3)/2 !BOTTOM EDGE - PEAR(3,NAR+1)=I+(MXAREA(3)-1)/2 !TOP EDGE - END IF -C -C CHECK MINIMUM WIDTH -C - IF (MNWID.EQ.0) THEN !NO CHECK - ELSE IF (IAND(MNWID,1).EQ.0) THEN !EVEN AND MINIMUM - IF (IAND(1,PEAR(1,NAR+1)-PEAR(0,NAR+1)).EQ.0) THEN !ADJUST EVEN - PEAR(1,NAR+1)=PEAR(1,NAR+1)-1 - END IF - IF (IAND(1,PEAR(3,NAR+1)-PEAR(2,NAR+1)).EQ.0) THEN !ADJUST EVEN - PEAR(3,NAR+1)=PEAR(3,NAR+1)-1 - END IF - IF (PEAR(1,NAR+1)-PEAR(0,NAR+1).LT.MNWID-1) GOTO 11 !TOO SMALL - IF (PEAR(3,NAR+1)-PEAR(2,NAR+1).LT.MNWID-1) GOTO 11 !TOO SMALL - ELSE !ODD AND MINIMUM - IF (IAND(1,PEAR(1,NAR+1)-PEAR(0,NAR+1)).NE.0) THEN !ADJUST ODD - PEAR(0,NAR+1)=PEAR(0,NAR+1)+1 - END IF - IF (IAND(1,PEAR(3,NAR+1)-PEAR(2,NAR+1)).NE.0) THEN !ADJUST ODD - PEAR(2,NAR+1)=PEAR(2,NAR+1)+1 - END IF - IF (PEAR(1,NAR+1)-PEAR(0,NAR+1).LT.MNWID-1) GOTO 11 !TOO SMALL - IF (PEAR(3,NAR+1)-PEAR(2,NAR+1).LT.MNWID-1) GOTO 11 !TOO SMALL - END IF -C -C CHECK IF ANYTHING LEFT -C - IF (PEAR(1,NAR+1).LT.PEAR(0,NAR+1) .OR. - 1 PEAR(3,NAR+1).LT.PEAR(2,NAR+1)) THEN !CHECK IF ANYTHING - 11 CONTINUE - CALL WNCTXT(F_TP,'Area has wrong boundaries') - ELSE - NAR=NAR+1 !COUNT AREA - END IF - GOTO 10 !MORE -C -C SORT ON LEFT EDGES -C - 20 CONTINUE - IF (NAR.LE.0) GOTO 800 !READY - DO I=1,NAR - DO I1=I+1,NAR - IF (PEAR(0,I).GT.PEAR(0,I1)) THEN - DO I2=0,3 !SORT - I3=PEAR(I2,I) - PEAR(I2,I)=PEAR(I2,I1) - PEAR(I2,I1)=I3 - END DO - END IF - END DO - END DO -C -C FIND TOTAL WIDTH -C - DO I=0,3 !START VALUE - TEAR(I)=PEAR(I,1) - END DO - DO I=2,NAR - DO I1=0,3,2 - TEAR(I1)=MIN(TEAR(I1),PEAR(I1,I)) - TEAR(I1+1)=MAX(TEAR(I1+1),PEAR(I1+1,I)) - END DO - END DO -C -C SAVE IN OTHER FORMAT -C - TAREA(2)=TEAR(1)-TEAR(0)+1 !WIDTH - TAREA(3)=TEAR(3)-TEAR(2)+1 - TAREA(0)=TEAR(0)+TAREA(2)/2 !CENTRE - TAREA(1)=TEAR(2)+TAREA(3)/2 - DO I=1,NAR - PAREA(2,I)=PEAR(1,I)-PEAR(0,I)+1 !WIDTH - PAREA(3,I)=PEAR(3,I)-PEAR(2,I)+1 - PAREA(0,I)=PEAR(0,I)+PAREA(2,I)/2 !CENTRE - PAREA(1,I)=PEAR(2,I)+PAREA(3,I)/2 - END DO -C -C SHOW RESULT: -C - CALL WNCTXT(F_TP,'!/Area(s) selected:') - CALL WNCTXT(F_TP,'Total : l= !SJ, m= !SJ, dl= !SJ, dm= !SJ', - 1 TAREA(0),TAREA(1),TAREA(2),TAREA(3)) - IF (NAR.GT.1) THEN - DO I=1,NAR - CALL WNCTXT(F_TP, - 1 'Area!3$UJ : l= !SJ, m= !SJ, dl= !SJ, dm= !SJ', - 1 I,PAREA(0,I),PAREA(1,I),PAREA(2,I),PAREA(3,I)) - END DO - END IF - CALL WNCTXT(F_TP,' ') -C -C READY -C - 800 CONTINUE -C - RETURN !READY -C -C - END diff --git a/src/nmap/nmadat.for b/src/nmap/nmadat.for deleted file mode 100644 index d44c8445c5345bd1d76de7e760bf1800ff4a8bf6..0000000000000000000000000000000000000000 --- a/src/nmap/nmadat.for +++ /dev/null @@ -1,1742 +0,0 @@ -C+ NMADAT.FOR -C WNB 910219 -C -C Revisions: -C WNB 910822 Add FIDDLE -C WNB 910826 Retain values -C WNB 910911 Add NSUM -C WNB 910912 Add other sums -C WNB 910913 Change loops -C WNB 911104 Add mosaic combine -C WNB 920128 Prompt error node -C WNB 920423 Natural taper default for BASHA -C HjV 920520 HP does not allow extended source lines -C WNB 920811 Add USE_NOISE -C WNB 920812 Add loops for Fiddle sums -C WNB 920817 Add circular weights -C WNB 920818 Add Fits scale -C WNB 921104 Full HA scale; J2000 -C WNB 921119 Add WRLFITS, CUBIC -C WNB 921123 Nicer HA-range question -C WNB 921201 Larger default memory use -C WNB 921201 Prepare for Data clean: add NMADAC -C WNB 921208 Data clean subtract -C WNB 921216 Change clip for data clean -C HjV 930423 Change name of some keywords -C HjV 930525 Change MAPS_SETS into WMP_SETS -C WNB 930602 Add WGT_LIMIT -C WNB/HjV 930621 Change of keywords was wrong for CVX -C WNB 930711 Typo AREF -C WNB 930824 New interferometer selection -C WNB 930826 New HA selection; new Stokes calculation; beam factor -C WNB 930929 Add Fiddle LOAD option -C WNB 930930 Use Fiddle codes -C CMV 931210 Add 'WMP/SCN_LOOPS' argument to WNDXLP -C CMV 931220 Pass FCA of input file to WNDXLP and WNDSTA/Q -C CMV 940110 Pass FCA for FIDDLE options (Close later) -C CMV 940214 Default HA range -90,90 for WSRT, -180,180 for AT -C CMV 940214 If NULL at FIELD_SIZE, ask GRID_SIZE -C JPH 940221 Comments - NEW_VERSION: SCN_NODE --> WMP_NODE -C CMV 940225 Enable default model file (use NMODAW) -C CMV 940415 Open SCN file first with 'R' to prevent creation -C of new file when non-existing one is specified -C CMV 940418 Give warning if pointing centra differ to much -C CMV 940422 Correct error in WNFOP for NVS (called for SCN) -C CMV 940425 Define DWARF symbol PCDEC -C CMV 940517 Define DWARF symbol SD -C HjV 940518 Add OLD_DATTYP -C CMV 940530 Add creation of Job Summary Log -C HjV 940714 Add RFITS, re-orden labels -C CMV 940808 Add call to WNFMLI to list tape definitions -C JPH 940923 Add WNDPOH calls for input data-set selection -C JPH 940929 Add FIELD_CENTRE -C JPH 941013 Comments. - Remove dead code, e.g. for wildcards on -C keywords that donot allow them -C LCL --> CLEAN -C HA_RESOLUTION in UT seconds i.s.o. ST -C HjV 941027 Open file for answering WMP_SET_2 -C WNB 950817 Set POLTJ for pol. int. and cleaning -C JPH 950911 Bug fix in FIELD_SHIFT: FIELD_CENTRE prompt conditional -C on NULL_VALUE status i.s.o FIELD_SHIFT=0,0 -C CMV 951127 Interface for CSUM and RSUM fiddle options -C CMV 951204 Add RMVAL and (real) weights for RSUM -C WNB 951212 Correct REF_COORD backtrack error (194) -C CMV 960126 RA of REF_COORD always positive (193) -C JPH 960402 HOLOG --> OLDHOLOG; synonym NEWHOLOG for WMP -C CMV 030123 Corrected BYTE test for g77 -C CMV 061023 Added buffer size for large maps and too wide field -C -C - SUBROUTINE NMADAT -C -C Get NMAP program parameters -C -C Result: -C -C CALL NMADAT will ask and set all program parameters -C CALL NMADAC ( CMFCA_J:I, CMHP_J:I) -C will ask and set all program -C parameters for DATA type clean. CMHP points to -C map header in CMFCA. -C -C PIN references: -C -C OPTION -C FIDDLE_OPTION -C SUM_OPTION -C LOAD_OPTION -C MEMORY_USE -C MAP_FACTORS -C SUM_FACTORS -C CSUM_FACTORS -C ROTATION_MEASURE -C MAP_LEVEL -C WMP_NODE -C WMP_NODE_1 -C WMP_NODE_2 -C OUTPUT_UNIT -C FILENAME -C INPUT_FILE -C WMP_SETS -C WMP_SET_1 -C WMP_SET_2 -C OUTPUT_LABEL -C CUBIC -C USE_NOISE -C WGT_LIMIT -C LOOPS -C QMAPS -C QDATAS -C SCN_NODE -C SCN_SETS -C USER_COMMENT -C SELECT_IFRS -C APPLY -C DE_APPLY -C MAP_POLAR -C MAP_COORD -C REF_COORD -C UV_COORDINATES -C HA_RESOLUTION -C BAS_RESOLTUTION -C IFR_RESOLUTION -C USER_DATA -C FT_SIZE -C OUT_SIZE -C OUT_CENTRE -C LM_CENTRE -C RADEC_CENTRE -C FIELD_SIZE -C GRID_SIZE -C UNIFORM -C TAPER -C TAPER_VALUE -C CWEIGHT_TYPE -C CWEIGHT_VALUE -C CONVOLVE -C DECONVOLVE -C UV_AREA -C CLIPPING -C CLIP_AREA -C CLIP_LEVELS -C FIELD_SHIFT -C DATA_TYPE -C FITS_SCALE -C OUTPUT -C OUTPUT_WMP_NODE -C SUBTRACT -C -C Include files: -C - INCLUDE 'WNG_DEF' - INCLUDE 'CBITS_DEF' - INCLUDE 'STH_O_DEF' !SET HEADER - INCLUDE 'MPH_O_DEF' !MAP HEADER - INCLUDE 'NMA_DEF' -C -C Parameters: -C - INTEGER MXNPCD !# OF POLARISATION CODES - PARAMETER (MXNPCD=18) !KNOWN POL. CODES - INTEGER I_ML,XX_PI,XY_PI,YX_PI,YY_PI, - 1 I_MI,Q_MI,U_MI,V_MI,I_MLI !SPECIAL CODES - PARAMETER (I_ML=I_M+LINE_P,XX_PI=XX_P+IMAG_P, - 1 XY_PI=XY_P+IMAG_P,YX_PI=YX_P+IMAG_P, - 1 YY_PI=YY_P+IMAG_P,I_MI=I_M+IMAG_P, - 1 Q_MI=Q_M+IMAG_P,U_MI=U_M+IMAG_P, - 1 V_MI=V_M+IMAG_P,I_MLI=I_M+IMAG_P+LINE_P) -C -C Arguments: -C - INTEGER CMFCA !CLEAN MAP FILE - INTEGER CMHP !POINTER TO MAP HEADER -C -C Function references: -C - DOUBLE PRECISION WNGDPF,WNGDNF !NORMALISE ANGLE - DOUBLE PRECISION WNGDPD,WNGDND !NORMALISE ANGLE - REAL WNGEDF,WNGEFR !CONVERT ANGLE - DOUBLE PRECISION WNGDDF,WNGDFD - LOGICAL WNDPAR !GET DWARF PARAMETER - LOGICAL WNDNOD !GET NODE NAME - LOGICAL WNDNOC !CHANGE TO NODE TO 'UPDATE' - LOGICAL WNDXLP,WNDXL1 !GET LOOP PARAMETERS - LOGICAL WNFOP !OPEN FILE - LOGICAL WNFRD !READ FILE - LOGICAL WNFMOU !MOUNT TAPE - CHARACTER*80 WNFTVL !GET TAPE VOLUME - INTEGER WNMEJC !CEIL(X) - LOGICAL WNDSTQ !GET SETS TO DO - CHARACTER*32 WNTTSG !GET SET NAME - LOGICAL NSCIF1 !INTERFEROMETER SELECTION - LOGICAL NSCSTG !READ A SET - LOGICAL NSCHAS !SELECT HA - LOGICAL NMOBMR !GET BEAM DATA -C -C Data declarations: -C - INTEGER FCAIN !INPUT FCA - INTEGER SETNAM(0:7) !SET NAME - INTEGER STHP !STH POINTER - INTEGER CIFR !CHECK IFRS - LOGICAL CLEAN ! IN CLEAN - CHARACTER*80 TXT ! prompt buffer - CHARACTER*80 VOLHD !TAPE VOLUME HEADER - CHARACTER*80 C1,CEP - CHARACTER*8 C2(8) - CHARACTER*24 SUBOPT !SUB-OPTION - CHARACTER*3 SUBOP3 - EQUIVALENCE (SUBOPT,SUBOP3) - REAL*8 FRA,FDEC !First apparent RA,DEC - INTEGER FINST !First instrument - CHARACTER*25 PCDEC !Define DWARF symbol - INTEGER NSRC(0:2) !# OF SOURCES IN MODEL - CHARACTER*4 PCD(MXNPCD) !KNOWN POL. CODES - DATA PCD/'XX','XY','YX','YY','I','Q','U','V','L', - 1 'XXI','XYI','YXI','YYI','II','QI','UI','VI','LI'/ - REAL PCDT(MXNPCD) !TABLE TO SET (IMAG, N, XX,XY,YX,YY) - DATA PCDT(1) /XX_P/ !XX - DATA PCDT(2) /XY_P/ !XY - DATA PCDT(3) /YX_P/ !YX - DATA PCDT(4) /YY_P/ !YY - DATA PCDT(5) /I_M/ !I - DATA PCDT(6) /Q_M/ !Q - DATA PCDT(7) /U_M/ !U - DATA PCDT(8) /V_M/ !V - DATA PCDT(9) /I_ML/ !L - DATA PCDT(10) /XX_PI/ !XXI - DATA PCDT(11) /XY_PI/ !XYI - DATA PCDT(12) /YX_PI/ !YXI - DATA PCDT(13) /YY_PI/ !YYI - DATA PCDT(14) /I_MI/ !II - DATA PCDT(15) /Q_MI/ !QI - DATA PCDT(16) /U_MI/ !UI - DATA PCDT(17) /V_MI/ !VI - DATA PCDT(18) /I_MLI/ !LI - BYTE MPH(0:MPHHDL-1) !MAP HEADER - INTEGER*2 MPHI(0:MPHHDL/2-1) - INTEGER MPHJ(0:MPHHDL/4-1) - REAL MPHE(0:MPHHDL/4-1) - DOUBLE PRECISION MPHD(0:MPHHDL/8-1) - EQUIVALENCE (MPH,MPHI,MPHJ,MPHE,MPHD) - BYTE STH(0:STH__L-1) !SET HEADER - INTEGER STHJ(0:STH__L/LB_J-1) - REAL*8 STHD(0:STH__L/LB_D-1) - EQUIVALENCE (STH,STHJ,STHD) - BYTE BB1 -C- -C -C MAPDAT -C - CLEAN=.FALSE. ! NOT DAC - GOTO 300 -C -C MAPDAC -C - ENTRY NMADAC(CMFCA,CMHP) -C - CLEAN=.TRUE. ! DAC - OPTION='CLEAN' !OPTION TO DO - IF (.NOT.WNFRD(CMFCA,MPHHDL,MPH,CMHP)) THEN !READ CLEAN MAP HEADER - CALL WNCTXT(F_TP,'Error reading clean map header') - CALL WNGEX !STOP - END IF - GOTO 300 -C -C SET DEFAULTS -C - 300 CONTINUE - IF (OPT.EQ.'FID') GOTO 60 !ALREADY IN FIDDLE - MEMSIZ=200000 - NODOUT=' ' - FILIN(1)='""' - FILIN(2)='*' - DO I=1,MXNFIL - SETS(0,0,I)=0 - NODIN(I)=' ' - END DO - IUNIT='D' - OUNIT='D' - OLABEL=-1 - MAPCRD(0)=-1000 - HA(0,1)=-179.99/360. - HA(1,1)=+179.99/360. - CIFR=3 - FTSIZ(0)=-1 - FIELD(0)=-100 - SUB=.FALSE. -!! POLC(0)='XX' - CEP='B1950' -C -C GET OPTION -C - 100 CONTINUE - IF (CLEAN) THEN !NMADAC call from NCLEAN - OPTION='CLEAN' ! no need to prompt - ELSE - IF (.NOT.WNDPAR('OPTION',OPTION,LEN(OPTION),J0,'QUIT')) THEN - OPTION='QUIT' !ASSUME END - ELSE IF (J0.LE.0) THEN - OPTION='QUIT' !ASSUME END - END IF - END IF - IF (OPT.EQ.'QUI') RETURN !READY -C -C GET MEMORY SIZE AND BEAM FACTORS -C - IF (.NOT.WNDPAR('MEMORY_USE',MEMSIZ,LB_J,J0, - 1 A_B(-A_OB),MEMSIZ,1)) THEN - MEMSIZ=200000 !ASSUME VALUE - ELSE IF (J0.LE.0) THEN - MEMSIZ=200000 !ASSUME VALUE - END IF - MEMSIZ=4*MEMSIZ !Allow large fields-wnb061023 - 50 CONTINUE - IF (.NOT.NMOBMR()) GOTO 50 !MUST SPECIFY -C -C CONVERT VAX TO LOCAL -C - 60 CONTINUE - IF (OPT.EQ.'CVX') THEN - 61 CONTINUE - IF (.NOT.WNDNOD('WMP_NODE',NODOUT,'WMP', - 1 'R',NODOUT,FILOUT)) THEN - IF (E_C.EQ.DWC_ENDOFLOOP) GOTO 100 !RETRY OPTION - GOTO 61 !REPEAT - ELSE IF (E_C.EQ.DWC_NULLVALUE) THEN - GOTO 100 !RETRY OPTION - ELSE IF (E_C.EQ.DWC_WILDCARD) THEN - GOTO 61 !MUST SPECIFY - END IF - IF (.NOT.WNFOP(FCAOUT,FILOUT,'U')) THEN !OPEN OUTPUT MAP FILE - GOTO 61 !RETRY - END IF -C -C CONVERT TO NEWEST VERSION -C - ELSE IF (OPT.EQ.'NVS') THEN - 70 CONTINUE - IF (.NOT.WNDNOD('WMP_NODE',NODOUT,'WMP', - 1 'R',NODOUT,FILOUT)) THEN - IF (E_C.EQ.DWC_ENDOFLOOP) GOTO 100 !RETRY OPTION - GOTO 70 !REPEAT - ELSE IF (E_C.EQ.DWC_NULLVALUE) THEN - GOTO 100 !RETRY OPTION - ELSE IF (E_C.EQ.DWC_WILDCARD) THEN - GOTO 70 !MUST SPECIFY - END IF - IF (.NOT.WNFOP(FCAOUT,FILOUT,'U')) THEN !OPEN OUTPUT MAP FILE - GOTO 70 !RETRY - END IF -C -C FROM OLD FORMAT -C - ELSE IF (OPT.EQ.'FRO') THEN - 80 CONTINUE - IF (.NOT.WNDPAR('INPUT_FILE',FILIN(1),LEN(FILIN(1)),J0, - 1 FILIN(1))) THEN - IF (E_C.EQ.DWC_ENDOFLOOP) GOTO 100 !RETRY OPTION - GOTO 80 !RETRY - END IF - IF (J0.EQ.0) GOTO 100 !RETRY OPTION - IF (J0.LT.0) GOTO 80 !MUST SPECIFY - IF (.NOT.WNFOP(FCATAP,FILIN(1),'R')) THEN !NO SUCH FILE - CALL WNCTXT(F_TP,'Cannot find file !AS',FILIN(1)) - GOTO 80 !RETRY - END IF - CALL WNFCL(FCATAP) !CLOSE FILE - IF (.NOT.WNDPAR('OLD_DATTYP',DATTYP,LB_J,J0,'0')) THEN - IF (E_C.EQ.DWC_ENDOFLOOP) GOTO 100 !RETRY OPTION - GOTO 80 !RETRY - END IF - IF (J0.EQ.0) GOTO 100 !RETRY OPTION - IF (J0.LT.0) GOTO 80 !MUST SPECIFY - 81 CONTINUE - IF (.NOT.WNDNOD('OUTPUT_WMP_NODE',NODOUT,'WMP', - 1 'U',NODOUT,FILOUT)) THEN - IF (E_C.EQ.DWC_ENDOFLOOP) GOTO 80 !RETRY FILE - GOTO 81 !REPEAT - END IF - IF (J0.EQ.0) GOTO 80 !RETRY INPUT - IF (J0.LT.0) GOTO 81 !MUST SPECIFY - IF (.NOT.WNFOP(FCAOUT,FILOUT,'U')) THEN !OPEN MAP FILE - GOTO 81 !RETRY - END IF -C -C TO OLD FORMAT -C - ELSE IF (OPT.EQ.'TO_') THEN - 90 CONTINUE - IF (.NOT.WNDPAR('FILENAME',FILIN(1),LEN(FILIN(1)),J0, - 1 FILIN(1))) THEN - IF (E_C.EQ.DWC_ENDOFLOOP) GOTO 100 !RETRY OPTION - GOTO 90 !RETRY - END IF - IF (J0.EQ.0) GOTO 100 !RETRY OPTION - IF (J0.LT.0) GOTO 90 !MUST SPECIFY - 91 CONTINUE - IF (.NOT.WNDNOD('INPUT_WMP_NODE',NODOUT,'WMP', - 1 'R',NODOUT,FILOUT)) THEN - IF (E_C.EQ.DWC_ENDOFLOOP) GOTO 90 !RETRY FILE - GOTO 91 !REPEAT - END IF - IF (J0.EQ.0) GOTO 90 !RETRY INPUT - IF (J0.LT.0) GOTO 91 !MUST SPECIFY - IF (.NOT.WNFOP(FCAOUT,FILOUT,'R')) THEN !OPEN MAP FILE - GOTO 81 !RETRY - END IF - IF (.NOT.WNDSTQ('WMP_SETS',MXNSET,SETS(0,0,1),FCAOUT)) THEN !MAPS TO DO - GOTO 90 !RETRY FILE - END IF -C -C READ FITS -C - ELSE IF (OPT.EQ.'RFI') THEN - 110 CONTINUE - IF (.NOT.WNDPAR('INPUT_UNIT',IUNIT,LEN(IUNIT),J0,IUNIT)) THEN !GET UNIT - IF (E_C.EQ.DWC_ENDOFLOOP) GOTO 100 !RETRY OPTION - GOTO 110 !REPEAT - ELSE IF (E_C.EQ.DWC_WILDCARD) THEN !LIST TAPEUNITS AND RETRY - CALL WNFMLI() - GOTO 110 - ELSE IF (J0.EQ.0) THEN - GOTO 100 !RETRY OPTION - ELSE IF (J0.LT.0) THEN - GOTO 110 !MUST SPECIFY - END IF - IF (IUNIT.EQ.'D') THEN !DISK INPUT - 111 CONTINUE - IF (.NOT.WNDPAR('INPUT_FILE',FILIN(1),LEN(FILIN(1)), - 1 J0,FILIN(1))) THEN - IF (E_C.EQ.DWC_ENDOFLOOP) GOTO 110 !RETRY UNIT - GOTO 111 !REPEAT - ELSE IF (J0.EQ.0) THEN - GOTO 110 !RETRY UNIT - ELSE IF (J0.LT.0) THEN - GOTO 111 !MUST SPECIFY - END IF - ELSE !TAPE INPUT - IF (.NOT.WNFMOU(FCATAP,IUNIT,'R')) THEN !MOUNT TAPE - CALL WNCTXT(F_TP,'Cannot mount tape on unit !AS (!XJ)', - 1 IUNIT,E_C) - GOTO 110 !RETRY UNIT - END IF - VOLHD=WNFTVL(FCATAP) !GET VOLUME HEADER - IF (VOLHD(1:4).EQ.'VOL1') THEN - CALL WNCTXT(F_TP,'!/Volume !AS mounted on unit !AS!/', - 1 VOLHD(5:10),IUNIT) - ELSE - CALL WNCTXT(F_TP,'!/Unlabeled tape mounted on unit !AS!/', - 1 IUNIT) - END IF - END IF - 112 CONTINUE - IF (IUNIT.EQ.'D') ILAB(1)=1 !Correct default for disk label - IF (.NOT.WNDPAR('INPUT_LABELS',ILAB,MXNLAB*LB_J, - 1 NLAB,'*')) THEN - IF (E_C.EQ.DWC_ENDOFLOOP) THEN !RETRY OPTION - ILAB(1)=0 !NOT SPECIFIED - ELSE - GOTO 112 !RETRY - END IF - END IF - 113 CONTINUE - IF (.NOT.WNDNOD('OUTPUT_WMP_NODE',NODOUT,'WMP', - 1 'U',NODOUT,FILOUT)) THEN - IF (E_C.EQ.DWC_ENDOFLOOP) GOTO 80 !RETRY FILE - GOTO 113 !REPEAT - ELSE IF (E_C.EQ.DWC_NULLVALUE) THEN - GOTO 100 !RETRY OUTPUT - ELSE IF (E_C.EQ.DWC_WILDCARD) THEN - GOTO 113 !MUST SPECIFY - END IF - IF (.NOT.WNFOP(FCAOUT,FILOUT,'U')) THEN !OPEN MAP FILE - GOTO 113 !RETRY - END IF -C -C MAKE FITS -C - ELSE IF (OPT.EQ.'W16' .OR. OPT.EQ.'W32' .OR. OPT.EQ.'WRL') THEN - 120 CONTINUE - IF (.NOT.WNDNOD('INPUT_WMP_NODE',NODOUT,'WMP', - 1 'R',NODOUT,FILOUT)) THEN - IF (E_C.EQ.DWC_ENDOFLOOP) GOTO 100 !RETRY OPTION - GOTO 120 !REPEAT - END IF - IF (J0.EQ.0) GOTO 100 !RETRY OPTION - IF (J0.LT.0) GOTO 120 !MUST SPECIFY - IF (.NOT.WNFOP(FCAOUT,FILOUT,'R')) THEN !OPEN MAP FILE - GOTO 120 !RETRY - END IF - IF (.NOT.WNDSTQ('WMP_SETS',MXNSET,SETS(0,0,1),FCAOUT)) THEN !MAPS TO DO - GOTO 120 !RETRY FILE - END IF - IF (.NOT.WNDPAR('CUBIC',BB1,LB_B,J0,'NO')) GOTO 120 - IF (J0.EQ.0) GOTO 120 !RETRY INPUTS - IF (J0.LT.0) BB1=.FALSE. !ASSUME NO - IF (BB1) THEN - POLT(0,0)=1 - ELSE - POLT(0,0)=0 !INDICATE NOT WANTED - END IF - 122 CONTINUE - IF (.NOT.WNDPAR('OUTPUT_UNIT',OUNIT,LEN(OUNIT),J0,OUNIT)) THEN - IF (E_C.EQ.DWC_ENDOFLOOP) GOTO 120 !RETRY FILE - GOTO 122 !REPEAT - ELSE IF (E_C.EQ.DWC_WILDCARD) THEN !LIST TAPEUNITS AND RETRY - CALL WNFMLI() - GOTO 122 - END IF - IF (J0.EQ.0) GOTO 120 !RETRY - IF (J0.LT.0) OUNIT='D' !ASSUME DISK - 124 CONTINUE - IF (.NOT.WNDPAR('FITS_SCALE',SUBOPT, - 1 LEN(SUBOPT),J0,'JY')) THEN - IF (E_C.EQ.DWC_ENDOFLOOP) GOTO 120 !RETRY FILE - GOTO 124 !RETRY - END IF - IF (J0.LT.0) GOTO 124 !MUST SPECIFY - IF (J0.LE.0) SUBOPT='JY' - IF (SUBOPT.EQ.'JY') THEN - CWGVAL=200. !SCALE - ELSE - CWGVAL=1. - END IF - 126 CONTINUE - IF (OUNIT.EQ.'D') THEN - IF (.NOT.WNDPAR('FILENAME',FILIN(1),LEN(FILIN(1)),J0, - 1 FILIN(1))) THEN - IF (E_C.EQ.DWC_ENDOFLOOP) GOTO 120 !RETRY FILE - GOTO 126 !RETRY - END IF - IF (J0.EQ.0) GOTO 120 !RETRY FILE - IF (J0.LT.0) GOTO 126 !MUST SPECIFY - ELSE - IF (.NOT.WNFMOU(FCATAP,OUNIT,'W')) THEN - CALL WNCTXT(F_TP,'Cannot mount tape') - GOTO 126 - END IF - VOLHD=WNFTVL(FCATAP) !GET VOLUME HEADER - IF (VOLHD(1:4).EQ.'VOL1') THEN - CALL WNCTXT(F_TP,'!/Volume !AS mounted on unit !AS!/', - 1 VOLHD(5:10),OUNIT) - ELSE - CALL WNCTXT(F_TP,'!/Unlabeled tape mounted on unit !AS!/', - 1 OUNIT) - END IF - END IF - 128 CONTINUE - IF (OLABEL.LT.0) THEN - JS=WNDPAR('OUTPUT_LABEL',OLABEL,LB_J,J0,'*') - ELSE - JS=WNDPAR('OUTPUT_LABEL',OLABEL,LB_J,J0, - 1 A_B(-A_OB),OLABEL,1) - END IF - IF (.NOT.JS) THEN - IF (E_C.EQ.DWC_ENDOFLOOP) GOTO 120 !RETRY FILE - GOTO 128 !RETRY - END IF - IF (J0.EQ.0) GOTO 120 !RETRY FILE - IF (J0.LT.0) OLABEL=-1 !SET AT END -C -C FIDDLE -C - ELSE IF (OPT.EQ.'FID') THEN - 200 CONTINUE - IF (.NOT.WNDPAR('FIDDLE_OPTION',SUBOPT, - 1 LEN(SUBOPT),J0,'QUIT')) THEN - SUBOPT='QUIT' !ASSUME END - ELSE IF (J0.LE.0) THEN - SUBOPT='QUIT' !ASSUME END - END IF - IF (SUBOP3.EQ.'ADD') THEN !SET CODES - DATTYP=FID_ADD - ELSE IF (SUBOP3.EQ.'AVE') THEN - DATTYP=FID_AVE - ELSE IF (SUBOP3.EQ.'POL') THEN - DATTYP=FID_POL - ELSE IF (SUBOP3.EQ.'ANG') THEN - DATTYP=FID_ANG - ELSE IF (SUBOP3.EQ.'CSU') THEN - DATTYP=FID_CSU - ELSE IF (SUBOP3.EQ.'RSU') THEN - DATTYP=FID_RSU - ELSE IF (SUBOP3.EQ.'SUM') THEN - IF (.NOT.WNDPAR('SUM_OPTION',SUBOPT, - 1 LEN(SUBOPT),J0,'QUIT')) THEN - SUBOPT='QUIT' !ASSUME END - ELSE IF (J0.LE.0) THEN - SUBOPT='QUIT' !ASSUME END - END IF - IF (SUBOP3.EQ.'SUM') THEN - DATTYP=FID_SUM - ELSE IF (SUBOP3.EQ.'NSU') THEN - DATTYP=FID_NSU - ELSE IF (SUBOP3.EQ.'BSU') THEN - DATTYP=FID_BSU - ELSE IF (SUBOP3.EQ.'BNS') THEN - DATTYP=FID_BNS - ELSE IF (SUBOP3.EQ.'FSU') THEN - DATTYP=FID_FSU - ELSE IF (SUBOP3.EQ.'NSS') THEN - DATTYP=FID_NSS - ELSE - DATTYP=FID_DUM - RETURN - END IF - ELSE IF (SUBOP3.EQ.'LOA') THEN - IF (.NOT.WNDPAR('LOAD_OPTION',SUBOPT, - 1 LEN(SUBOPT),J0,'QUIT')) THEN - SUBOPT='QUIT' !ASSUME END - ELSE IF (J0.LE.0) THEN - SUBOPT='QUIT' !ASSUME END - END IF - IF (SUBOP3.EQ.'OLD') THEN - DATTYP=FID_RHO - ELSE IF (SUBOP3.EQ.'WMP') THEN - DATTYP=FID_WMP - ELSE IF (SUBOP3.EQ.'NEW') THEN - DATTYP=FID_WMP - CALL WNCTXT(F_T, - 1 '!/ NOTE: The following prompts will be in error:!/' // - 1 '!4C For WMP_NODE_2 give the name of an OUTPUT .WMP file!/' // - 1 '!6C in which the map will be stored.!/' // - 1 '!4C For OUTPUT_FILE, give the name plus extension of the!/' // - 1 '!6C binary input file. !/!/' ) - ELSE IF (SUBOP3.EQ.'UNL') THEN - DATTYP=FID_UNL - ELSE - DATTYP=FID_DUM - RETURN - END IF - ELSE IF (SUBOP3.EQ.'EXT') THEN - DATTYP=FID_EXT - ELSE IF (SUBOP3.EQ.'COP') THEN - DATTYP=FID_COP - ELSE IF (SUBOP3.EQ.'BEA') THEN - DATTYP=FID_BEA - ELSE IF (SUBOP3.EQ.'DEB') THEN - DATTYP=FID_DEB - ELSE IF (SUBOP3.EQ.'FAC') THEN - DATTYP=FID_FAC - ELSE IF (SUBOP3.EQ.'MOS') THEN - DATTYP=FID_MOS - ELSE - DATTYP=FID_DUM !INDICATE END - RETURN !READY - END IF - 201 CONTINUE - IF (DATTYP.LT.FID_RHO .OR. - 1 DATTYP.GE.FID_UNL) THEN ! NOT LOAD - IF (.NOT.WNDNOD('WMP_NODE_1',NODIN(1),'WMP', - 1 'R',NODIN(1),FILIN(1))) THEN - IF (E_C.EQ.DWC_ENDOFLOOP) GOTO 200! RETRY OUTPUT - GOTO 201 ! REPEAT - ELSE IF (E_C.EQ.DWC_NULLVALUE) THEN - GOTO 200 ! RETRY OUTPUT - ELSE IF (E_C.EQ.DWC_WILDCARD) THEN - GOTO 201 ! MUST SPECIFY - END IF - IF (.NOT.WNFOP(FCAOUT,FILIN(1),'R')) - 1 GOTO 201 ! OPEN OUTPUT FILE - END IF - IF (DATTYP.GE.FID_SUM .AND. - 1 DATTYP.LT.FID_EXT) THEN ! LOOPS - IF (.NOT.WNDXLP('WMP_LOOPS',FCAOUT)) - 1 GOTO 201 ! GET LOOPS, RETRY FILE - END IF - IF (DATTYP.LT.FID_RHO .OR. - 1 DATTYP.GE.FID_UNL) THEN ! NOT LOAD - IF (.NOT.WNDSTQ('WMP_SET_1',MXNSET, - 1 SETS(0,0,1),FCAOUT)) THEN ! MAPS TO USE - CALL WNFCL(FCAOUT) - GOTO 201 ! RETRY FILE - END IF - CALL WNFCL(FCAOUT) - IF (SETS(0,0,1).LE.0) GOTO 201 ! NONE SPECIFIED - END IF - 202 CONTINUE - IF (DATTYP.LT.FID_SUM .OR. - 1 (DATTYP.GE.FID_EXT .AND. DATTYP.LT.FID_BEA) .OR. - 1 (DATTYP.GE.FID_MOS .AND. DATTYP.LT.FID_UNL)) - 1 THEN ! SECOND FILE - IF (DATTYP.GE.FID_RHO .AND. - 1 FILIN(2).EQ.'*') THEN ! ONLY OUTPUT - JS=WNDNOD('WMP_NODE_2',' ','WMP', - 1 'U',NODIN(2),FILIN(2)) - ELSE IF (FILIN(2).EQ.'*') THEN - JS=WNDNOD('WMP_NODE_2','*','WMP', - 1 'U',NODIN(2),FILIN(2)) - ELSE - JS=WNDNOD('WMP_NODE_2',NODIN(2), - 1 'WMP','U',NODIN(2),FILIN(2)) - END IF - IF (.NOT.JS) THEN - IF (E_C.EQ.DWC_ENDOFLOOP) GOTO 200! RETRY OUTPUT - GOTO 202 ! REPEAT - ELSE IF (E_C.EQ.DWC_NULLVALUE) THEN - GOTO 200 ! RETRY OUTPUT - ELSE IF (E_C.EQ.DWC_WILDCARD) THEN - IF (DATTYP.GE.FID_RHO) GOTO 200 ! LOAD - FILIN(2)='*' ! INDICATE SAME - NODIN(2)=NODIN(1) - END IF - IF (FILIN(2).NE.'*') THEN - IF (.NOT.WNFOP(FCAOUT,FILIN(2),'U')) GOTO 202 !OPEN OUTPUT FILE - CALL WNFCL(FCAOUT) - END IF - END IF - IF (DATTYP.LT.FID_SUM) THEN - IF (FILIN(2).NE.'*') THEN - IF (.NOT.WNFOP(FCAOUT,FILIN(2),'U')) GOTO 202 !OPEN OUTPUT FILE - ELSE - IF (.NOT.WNFOP(FCAOUT,FILIN(1),'U')) GOTO 202 !OPEN OUTPUT FILE - END IF - IF (.NOT.WNDSTQ('WMP_SET_2',MXNSET,SETS(0,0,2),FCAOUT)) THEN !MAPS TO USE - GOTO 201 !RETRY FILE - END IF - CALL WNFCL(FCAOUT) - IF (SETS(0,0,2).LE.0) GOTO 202 !NONE SPECIFIED - END IF - 203 CONTINUE - JS=.TRUE. !ASSUME - J0=1 - IF (DATTYP.EQ.FID_ADD) THEN - JS=WNDPAR('MAP_FACTORS',POLT(0,0),2*LB_E,J0,'1.,-1.') - ELSE IF (DATTYP.EQ.FID_AVE) THEN - JS=WNDPAR('MAP_FACTORS',POLT(0,0),2*LB_E,J0,'1.,1.') - ELSE IF (DATTYP.EQ.FID_FAC) THEN - JS=WNDPAR('MAP_FACTORS',POLT(0,0),2*LB_E,J0,'1.,0.') - ELSE IF (DATTYP.EQ.FID_POL .OR. DATTYP.EQ.FID_ANG) THEN - JS=WNDPAR('MAP_LEVEL',POLT(0,0),LB_E,J0,'1.') - ELSE IF (DATTYP.EQ.FID_FSU) THEN - JS=WNDPAR('SUM_FACTORS',POLT(-2,0),8*LB_E,J0,'1.') - ELSE IF (DATTYP.EQ.FID_CSU) THEN - JS=WNDPAR('CSUM_FACTORS',POLT(-2,0),16*LB_E,J0,'1.') - ELSE IF (DATTYP.EQ.FID_RSU) THEN - JS=WNDPAR('SUM_FACTORS',POLT(-2,0),8*LB_E,J0,'1.') - JS=WNDPAR('ROTATION_MEASURE', - 1 RMVAL,MXRMVAL*LB_E,NLAB,'0.') - END IF - IF (.NOT.JS) THEN - IF (E_C.EQ.DWC_ENDOFLOOP) GOTO 200 - GOTO 203 - END IF - IF (J0.EQ.0) GOTO 200 - IF (J0.LT.0) GOTO 203 - IF (DATTYP.EQ.FID_FSU.OR.DATTYP.EQ.FID_RSU) THEN !FILL FACTORS - DO I=J0,7 - POLT(-2+I,0)=POLT(-2+MOD(I,J0),0) - END DO - END IF - IF (DATTYP.EQ.FID_CSU) THEN !FILL FACTORS - DO I=J0,15 - POLT(-2+I,0)=POLT(-2+MOD(I,J0),0) - END DO - END IF - IF (DATTYP.GE.FID_MOS .AND. DATTYP.LT.FID_RHO) THEN !MOSAIC COMBINE - IF (.NOT.WNDPAR('USE_NOISE',BB1,LB_B,J0,'NO')) GOTO 200 - IF (J0.EQ.0) GOTO 200 !RETRY OUTPUTS - IF (J0.LT.0) BB1=.FALSE. !ASSUME NO - IF (BB1) THEN - POLT(0,0)=1 - ELSE - POLT(0,0)=0 !INDICATE NOT WANTED - END IF - IF (.NOT.WNDPAR('WGT_LIMIT',POLT(1,0),LB_E,J0,'0.1')) GOTO 200 - IF (J0.EQ.0) GOTO 200 !RETRY OUTPUTS - IF (J0.LT.0) POLT(1,0)=0.05 !DEFAULT WEIGHT LIMIT - IF (FTSIZ(0).EQ.-1) THEN !MAKE DEFAULTS - DO I=0,1 - OUTSIZ(I)=1024 !SIZE - FTSIZ(I)=0 !CENTRE - END DO - END IF - IF (.NOT.WNDPAR('OUT_SIZE',OUTSIZ,2*LB_J,J0,A_B(-A_OB), - 1 OUTSIZ,2)) GOTO 200 !OUTPUT SIZE - IF (J0.LT.2) GOTO 200 - DO I=0,1 - OUTSIZ(I)=MAX(16,2*((OUTSIZ(I)+1)/2)) !MAKE EVEN - END DO - IF (.NOT.WNDPAR('OUT_CENTRE',FTSIZ,2*LB_J,J0,A_B(-A_OB), - 1 FTSIZ,2)) GOTO 200 !OUTPUT CENTRE - DATTYP=FID_MOS !ASSUME PIXELS - IF (J0.EQ.-1) THEN !TRY LM - IF (.NOT.WNDPAR('LM_CENTRE',CNTDVL,2*LB_D,J0,'*')) - 1 GOTO 200 !OUTPUT CENTRE - DATTYP=FID_LMM !ASSUME LM - IF (J0.EQ.-1) THEN !TRY RADEC - IF (.NOT.WNDPAR('RADEC_CENTRE',CNTDVL,2*LB_D,J0,'*')) - 1 GOTO 200 !OUTPUT CENTRE - DATTYP=FID_RAM !ASSUME RADEC - CNTDVL(0)=CNTDVL(0)/360. !MAKE CIRCLES - CNTDVL(1)=CNTDVL(1)/360. - END IF - END IF - IF (J0.LT.2) GOTO 200 - END IF -C -C MAKE MAP - 'CLE'an is the option for entry point NMADAC, -C which also set CLEAN true -C - ELSE IF (OPT.EQ.'MAK' .OR. OPT.EQ.'CLE') THEN -C -C LOOPS -C - 800 CONTINUE - CALL WNCTXT(F_T, - 1'!/!4C\You may select up to !UJ input data sets!/ - 1 !8C\(node, sectors, HA range, interferometers)!/', - 1 MXNFIL) - IF (CLEAN) THEN !NO LOOP - IF (.NOT.WNDXL1()) GOTO 100 !INIT NO LOOP - ELSE - CALL WNDPOH( - 1'Loop specifications for all data sets: nr of cycles, index increment - 1 per cycle',' ',' ') - IF (.NOT.WNDXLP('SCN_LOOPS',0)) THEN - IF (E_C.EQ.DWC_ENDOFLOOP) GOTO 100 !RETRY OPTION - GOTO 800 !REPEAT - END IF - END IF -C -C INPUT SPECIFICATIONS -C - 810 CONTINUE - NFILE=0 - 210 CONTINUE - CALL WNCTXT(F_T,' ') - CALL WNCTXS(TXT, - 1 'Node for data set #!UJ (null if no more)',NFILE+1) - CALL WNDPOH(TXT,' ',' ') - IF (.NOT.WNDNOD('SCN_NODE',NODIN(NFILE+1),'SCN', - 1 'R',NODIN(NFILE+1), - 1 FILIN(NFILE+1))) THEN - IF (E_C.EQ.DWC_ENDOFLOOP) GOTO 800 !RETRY LOOPS - GOTO 210 !REPEAT - ELSE IF (E_C.EQ.DWC_NULLVALUE) THEN - GOTO 220 !NO MORE INPUT - ELSE IF (E_C.EQ.DWC_WILDCARD) THEN - GOTO 210 !MUST SPECIFY - END IF -C -C Change mode to 'U': we might want to subtract a model -C - IF (.NOT.WNDNOC(' ',' ','SCN','U',' ',FILIN(NFILE+1))) THEN - IF (.NOT.WNFOP(FCAIN,FILIN(NFILE+1),'R')) GOTO 210 !OPEN INPUT - ELSE - IF (.NOT.WNFOP(FCAIN,FILIN(NFILE+1),'U')) GOTO 210 !OPEN INPUT - END IF -C - CALL WNCTXS(TXT,'Sector sets for data set #!UJ',NFILE+1) - CALL WNDPOH(TXT,' ',' ') - IF (.NOT.WNDSTQ('SCN_SETS',MXNSET,SETS(0,0,NFILE+1),FCAIN)) THEN - 213 CONTINUE - CALL WNFCL(FCAIN) !CLOSE FOR NOW - GOTO 210 !RETRY FILE - END IF - IF (NFILE.EQ.0) THEN - IF (.NOT.NSCSTG(FCAIN,SETS,STH,STHP,SETNAM)) GOTO 213 !FIND A SET - CALL WNDSTR(FCAIN,SETS) !RESET SET SEARCH - FRA=STHD(STH_RA_D) !First set of first file - FDEC=STHD(STH_DEC_D) - FINST=STHJ(STH_INST_J) - CALL WNCTXS(PCDEC,'!DAF9.4',FDEC) !WRITE IN STRING - CALL WNDPAG('PCDEC',PCDEC) !DEFINE SYMBOL - CALL WNCTXS(PCDEC,'!D6.4',SIN(FDEC*DPI2)) !WRITE SIN(DEC) IN STRING - CALL WNDPAG('SD',PCDEC) !DEFINE SYMBOL - END IF -C -C Some elementary consistency checks (only first loop) -C - DO WHILE (NSCSTG(FCAIN,SETS(0,0,NFILE+1),STH,STHP,SETNAM)) !ALL SETS - IF (ABS(STHD(STH_RA_D) -FRA) .GT.2./360. .OR. - 1 ABS(STHD(STH_DEC_D)-FDEC).GT.2./360. ) THEN !Diff. pos. - CALL WNCTXT(F_TP,'WARNING: Pointing of !AS is '// - 1 '(!4$DPF4.0,!4$DAF4.0), not (!4$DPF4.0,!4$DAF4.0)', - 1 WNTTSG(SETNAM,0), - 1 STHD(STH_RA_D),STHD(STH_DEC_D),FRA,FDEC) - END IF - IF (STHJ(STH_INST_J).NE.FINST) THEN !Diff. inst. - CALL WNCTXT(F_TP,'WARNING: Different instrument '// - 1 'on set !AS',WNTTSG(SETNAM,0)) - END IF - END DO - CALL WNDSTR(FCAIN,SETS) !RESET SET SEARCH -C - CALL WNFCL(FCAIN) !CLOSE FOR NOW -C -C Get HA range, for WSRT limit default to -90,90 -C - DO I=0,1 - HA(I,NFILE+1)=HA(I,MAX(1,NFILE)) !DEFAULT - END DO - IF (STHJ(STH_INST_J).EQ.0) THEN - HA(0,NFILE+1)=MAX(HA(0,NFILE+1),-90./360.) - HA(1,NFILE+1)=MIN(HA(1,NFILE+1), 90./360.) - END IF - CALL WNCTXS(TXT,'Hour-angle range for data set #!UJ',NFILE+1) - CALL WNDPOH(TXT,' ',' ') - IF (.NOT.NSCHAS(0,HA(0,NFILE+1))) GOTO 210 -C - CALL WNCTXS(TXT,'Interferometers for data set #!UJ',NFILE+1) - CALL WNDPOH(TXT,' ',' ') - IF (NFILE.LE.0) THEN - IF (.NOT.NSCIF1(CIFR,SIFRS(0,0,1),STHJ)) GOTO 210 !GET IFRS SELECTED - ELSE - DO I=0,STHTEL-1 !COPY PREVIOUS - DO I1=0,STHTEL-1 - SIFRS(I1,I,NFILE+1)=SIFRS(I1,I,NFILE) - END DO - END DO - IF (.NOT.NSCIF1(0,SIFRS(0,0,NFILE+1),STHJ)) GOTO 210 !GET IFRS - END IF - CIFR=0 !NEXT ROUND -C - NFILE=NFILE+1 !NEXT FILE - IF (NFILE.LT.MXNFIL) GOTO 210 !MAYBE MORE -C -C GET SOME INPUT STATISTICS -C - 220 CONTINUE - IF (NFILE.LE.0) THEN !NO DATA - CALL WNCTXT(F_TP,'!/No data specified!/') - GOTO 800 !RESTART - END IF - CALL NMASST !GET INPUT DATA - IF (CNTJVL(2).LE.0) THEN !NO SETS FOUND - NFILE=0 - GOTO 220 - END IF - 222 CONTINUE - IF (CLEAN) THEN - CNTCVL(1)='Data-cleaned' - ELSE - IF (.NOT.WNDPAR('USER_COMMENT',CNTCVL(1),24,J0,'""')) THEN - IF (E_C.EQ.DWC_ENDOFLOOP) GOTO 210 !RETRY FILE - GOTO 222 !RETRY - END IF - IF (J0.LE.0) CNTCVL(1)=' ' !NO COMMENT - END IF -C -C MAP SPECIFICATIONS -C - 820 CONTINUE - IF (.NOT.CLEAN) CALL WNCTXT(F_TP,'!/Map properties:') -C -C Type of UV COORDINATES: -C Standard geometric: UVCDT=0 -C BASHA: UVCDT=1 -C IFRHA: UVCDT=2 -C - 224 CONTINUE - IF (CLEAN) THEN - C1='UV' - ELSE - IF (.NOT.WNDPAR('UV_COORDINATES',C1,LEN(C1),J0,'UV')) THEN !UV TYPE - IF (E_C.EQ.DWC_ENDOFLOOP) GOTO 810 !RETRY INPUTS - GOTO 224 ! RETRY - END IF - IF (J0.EQ.0) GOTO 810 ! RETRY INPUTS - END IF - IF (C1(1:1).EQ.'B') THEN - UVCDT=1 ! BASHA - ELSE IF (C1(1:1).EQ.'I') THEN - UVCDT=2 ! IFRHA - ELSE - UVCDT=0 ! STANDARD - END IF -C -C Scales for BASHA/IFRHA -C - 226 CONTINUE - IF (UVCDT.NE.0) THEN ! BASHA, IFRHA? - IF (.NOT.WNDPAR('HA_RESOLUTION',R0, - 1 LB_E,J0)) THEN ! HA RESOLUTION in UT sec - IF (E_C.EQ.DWC_ENDOFLOOP) GOTO 820! RETRY OUTPUTS - GOTO 226 - END IF - IF (J0.EQ.0) GOTO 820 - R0=WNGEFR(WNGEDF(R0*1.0027379)) ! convert to ST RADIANS - END IF - IF (UVCDT.EQ.1) THEN ! BASHA? - IF (.NOT.WNDPAR('BAS_RESOLUTION',R1,LB_E, - 1 J0,'18.')) THEN ! BASEL. RESOL. - IF (E_C.EQ.DWC_ENDOFLOOP) GOTO 820! RETRY OUTPUTS - GOTO 226 - END IF - IF (J0.EQ.0) GOTO 820 - ELSE IF (UVCDT.EQ.2) THEN ! IFRHA? - IF (.NOT.WNDPAR('IFR_RESOLUTION',R1,LB_E, - 1 J0,'1.')) THEN ! IFR RESOLUTION - IF (E_C.EQ.DWC_ENDOFLOOP) GOTO 820! RETRY OUTPUTS - GOTO 226 - END IF - IF (J0.EQ.0) GOTO 820 - R1=1./R1 ! CONVERT STEP IN RESOLUTION - END IF -C -C MAP SIZE AND FIELD -C - IF (CLEAN) THEN - FTSIZ(0)=MPHJ(MPH_FSR_J) - FTSIZ(1)=MPHJ(MPH_FSD_J) - ELSE - IF (FTSIZ(0).LT.0) THEN ! NEED DEFAULTS - IF (UVCDT.EQ.0) THEN ! NORMAL - FTSIZ(0)=512 ! DEFAULT - FTSIZ(1)=MAX(2**( - 1 NINT(LOG(ABS(SIN(REAL(MAPCRD(1))*PI2))* - 1 FTSIZ(0))/LOG(2.))),16) - ELSE - FTSIZ(1)=2*WNMEJC(UV1MAX(1)/R0)+1! HA MAX - IF (UVCDT.EQ.1) THEN - FTSIZ(0)=2* - 1 WNMEJC(UV1MAX(0)/R1)+1 ! BASEL MAX - ELSE - FTSIZ(0)=2* - 1 WNMEJC(UV2MAX(0)/R1)+1 ! IFR MAX - END IF - END IF - END IF ! not LCL - 228 CONTINUE - IF (.NOT.WNDPAR('FT_SIZE',FTSIZ,2*LB_J,J0, - 1 A_B(-A_OB),FTSIZ,2)) THEN! FFT SIZE - IF (E_C.EQ.DWC_ENDOFLOOP) GOTO 820! RETRY ALL - GOTO 228 ! RETRY - END IF - IF (J0.EQ.0) GOTO 820 ! RETRY ALL - END IF - DODFT=.FALSE. - IF (.NOT.CLEAN .AND. - 1 FTSIZ(0).LE.DFTSIZ .AND. - 1 FTSIZ(1).LE.DFTSIZ) DODFT=.TRUE. -C -C Output size -C - IF (DODFT) THEN ! DFT? - OUTSIZ(0)=FTSIZ(0) - OUTSIZ(1)=FTSIZ(1) - GOTO 232 - END IF - IF (CLEAN) THEN ! data clean? - OUTSIZ(0)=MPHJ(MPH_NRA_J) ! yes, use input map sizes - OUTSIZ(1)=MPHJ(MPH_NDEC_J) - FIELD(0)=MPHD(MPH_SRA_D)*PI2*FTSIZ(0) - FIELD(1)=MPHD(MPH_SDEC_D)*PI2*FTSIZ(1) - ELSE ! autonomous make - DO I=0,1 - FTSIZ(I)=MAX(FTSIZ(I),32) - IF (UVCDT.NE.0) ! BASHA/IFRHA - 1 OUTSIZ(I)=FTSIZ(I) - FTSIZ(I)=2**(WNMEJC(LOG(FLOAT(FTSIZ(I))) - 1 /LOG(2.)-.001)) ! power of 2 - IF (UVCDT.EQ.0) OUTSIZ(I)= ! FFT: min. 32, max. 1024 - 1 MIN(1024,MAX(FTSIZ(I),32)) - END DO - 230 CONTINUE - IF (.NOT.WNDPAR('OUT_SIZE',OUTSIZ, - 1 2*LB_J,J0,A_B(-A_OB),OUTSIZ,2)) THEN - IF (E_C.EQ.DWC_ENDOFLOOP) GOTO 820! RETRY ALL - GOTO 230 ! RETRY - END IF - IF (J0.EQ.0) GOTO 820 ! RETRY ALL - DO I=0,1 ! PROPER OUTPUT SIZE - OUTSIZ(I)= - 1 MIN(FTSIZ(I),2*((OUTSIZ(I)+1)/2)) - END DO -C -C Field size -C - 232 CONTINUE - IF (UVCDT.EQ.0) THEN ! NORMAL? - IF (FIELD(0).EQ.-100) THEN ! NEED DEFAULTS - FIELD(0)=WNMEJC - 1 (100.*(FTSIZ(0)/2.5)*10.* - 1 (1400./FRQMAX)/3600.)/100. - FIELD(1)=FIELD(0) - 1 *FTSIZ(1)/FTSIZ(0) ! /ABS(SIN(PI2*SFHDEC)) - ELSE - DO I=0,1 - FIELD(I)=FIELD(I)*DEG - END DO - END IF - DO I=0,1 ! MAKE ROUND NUMBERS - IF (FIELD(I).GE.10.) THEN - FIELD(I)=ANINT(FIELD(I)/2.)*2. - ELSE IF (FIELD(I).GE.5.) THEN - FIELD(I)=ANINT(FIELD(I)/1.)*1. - ELSE IF (FIELD(I).GE.1.) THEN - FIELD(I)=ANINT(FIELD(I)/.2)*.2 - ELSE IF (FIELD(I).GE..5) THEN - FIELD(I)=ANINT(FIELD(I)/.1)*.1 - ELSE IF (FIELD(I).GE..1) THEN - FIELD(I)=ANINT(FIELD(I)/.02)*.02 - ELSE IF (FIELD(I).GE..05) THEN - FIELD(I)=ANINT(FIELD(I)/.01)*.01 - END IF - END DO - IF (.NOT.WNDPAR('FIELD_SIZE',FIELD,2*LB_E, - 1 J0,A_B(-A_OB),FIELD,2)) THEN - IF (E_C.EQ.DWC_ENDOFLOOP) GOTO 820 !RETRY ALL - GOTO 232 ! RETRY - END IF -C -C NULL answer: ask GRID_SIZE -C - IF (E_C.EQ.DWC_NULLVALUE) THEN - DO I=0,1 ! GRID=FIELD/NPIXEL - FIELD(I)=FIELD(I) - 1 /FTSIZ(I)*3600. - END DO - IF (.NOT.WNDPAR('GRID_SIZE',FIELD,2*LB_E, - 1 J0,A_B(-A_OB),FIELD,2)) THEN - IF (E_C.EQ.DWC_ENDOFLOOP) GOTO 820! RETRY ALL - GOTO 232 ! RETRY - END IF - DO I=0,1 ! FIELD=GRID*NPIXEL - FIELD(I)=FIELD(I)*FTSIZ(I)/3600. - END DO - END IF -C - IF (J0.EQ.0) GOTO 820 ! RETRY ALL - DO I=0,1 - FIELD(I)=FIELD(I)/DEG ! MAKE RADIANS - END DO - ELSE ! BASHA/IFRHA - FIELD(1)=1./(R0*FRQMIN/(CL*1E-6)) - IF (UVCDT.EQ.1) THEN ! BASHA - FIELD(0)=1./(R1*FRQMIN/(CL*1E-6)) - ELSE ! IFRHA - FIELD(0)=1./(R1*FRQMIN/(CL*1E-6)) - END IF - END IF - END IF ! not CLEAN -C -C QMAPS DETAILS -C - 830 CONTINUE - IF (.NOT.WNDPAR('QMAPS',BB1,LB_B,J0)) THEN - IF (E_C.EQ.DWC_ENDOFLOOP) GOTO 820 ! RETRY OUTPUTS - GOTO 830 ! REPEAT - END IF - IF (J0.EQ.0) GOTO 820 ! RETRY OUTPUTS -C -C Clean defaults -C - IF (CLEAN) THEN - UWGT=0 - TAPTYP=MPHI(MPH_CD_I+0) - CVLTYP=MPHI(MPH_CD_I+1) - IF (CVLTYP.EQ.1) THEN - CVLWID(0)=3.98 - ELSE IF (CVLTYP.EQ.2) THEN - CVLWID(0)=1.0 - ELSE IF (CVLTYP.EQ.3) THEN - CVLWID(0)=4 - ELSE IF (CVLTYP.EQ.4) THEN - CVLWID(0)=6 - ELSE - CVLWID(0)=6 - END IF - DECVL=MPHI(MPH_CD_I+2).EQ.1 - END IF - IF (BB1) THEN ! QMAPS=yes, either NMAP or CLEAN -C -C UWGT: Method of determining UV coverage -C - 234 CONTINUE - IF (UVCDT.EQ.0) THEN ! standard UV plane? - IF (.NOT.WNDPAR('UNIFORM',C1, ! type of UV coverage - 1 LEN(C1),J0,'STANDARD')) THEN - IF (E_C.EQ.DWC_ENDOFLOOP) GOTO 830! back to QMAPS - GOTO 234 ! error, RETRY - END IF - ELSE ! BASHA/IFRHA? - IF (.NOT.WNDPAR('UNIFORM',C1, - 1 LEN(C1),J0,'NATURAL')) THEN ! type of UV coverage - IF (E_C.EQ.DWC_ENDOFLOOP) GOTO 830! back to QMAPS - GOTO 234 ! error, RETRY - END IF - END IF -C - IF (J0.EQ.0) GOTO 830 ! RETRY ALL - IF (C1(1:1).EQ.'N') THEN ! NATURAL - UWGT=0 - ELSE IF (C1(1:1).EQ.'F') THEN ! FULL - UWGT=2 - ELSE ! STANDARD - UWGT=1 - END IF -C -C TAPTYP: Type of UV taper and width -C - 236 CONTINUE - IF (.NOT.CLEAN) THEN - IF (UVCDT.EQ.0) THEN ! standard UV plane? - IF (.NOT.WNDPAR('TAPER',C1,LEN(C1), - 1 J0,'GAUSS')) THEN ! yes, default is Gaussian - IF (E_C.EQ.DWC_ENDOFLOOP) GOTO 830! back to QMAPS - GOTO 236 ! error, RETRY - END IF - ELSE ! BASHA/IFRHA -C -CC It is pointless to taper BASHA/IFRHA plots and it is unlikely that such plots -CC are made in batch mode, so I suppress this prompt. JPH 941013 -CC -CC IF (.NOT.WNDPAR('TAPER',C1,LEN(C1), -CC 1 J0,'NATURAL')) THEN ! BASHA/IFRHA, default is none -CC IF (E_C.EQ.DWC_ENDOFLOOP) GOTO 830 !RETRY ALL -CC GOTO 236 ! RETRY -CC END IF - C1='NATURAL' - END IF - IF (C1(1:1).EQ.'G') THEN ! GAUSS - TAPTYP=1 ! TAPER TYPE - ELSE IF (C1(1:1).EQ.'L') THEN ! LINEAR - TAPTYP=2 - ELSE IF (C1(1:1).EQ.'N') THEN ! NATURAL - TAPTYP=3 - ELSE IF (C1(1:1).EQ.'O') THEN ! OVERR - TAPTYP=4 - ELSE IF (C1(1:1).EQ.'R') THEN ! RGAUSS - TAPTYP=5 - ELSE - GOTO 236 - END IF - END IF ! not LCL -C -C TAPVAL: Taper width -C - 240 CONTINUE - IF (TAPTYP.EQ.1 .OR. TAPTYP.EQ.5) THEN! gaussian taper - IF (.NOT.WNDPAR('TAPER_VALUE',TAPVAL, - 1 LB_E,J0,'2548.')) THEN - IF (E_C.EQ.DWC_ENDOFLOOP) GOTO 830! back to QMAPS - GOTO 240 - END IF - ELSE IF (TAPTYP.EQ.2) THEN ! triangular taper - IF (.NOT.WNDPAR('TAPER_VALUE',TAPVAL, - 1 LB_E,J0,'4000.')) THEN - IF (E_C.EQ.DWC_ENDOFLOOP) GOTO 830! back to QMAPS - GOTO 240 - END IF - ELSE ! natural or 1/R - TAPVAL=0 - J0=1 - END IF - IF (J0.EQ.0) GOTO 240 -C -C CWGTYP, CWGVAL: Circular weight function and width -C - 242 CONTINUE - IF (.NOT.WNDPAR('CWEIGHT_TYPE',C1,LEN(C1),J0, - 1 'NATURAL')) THEN ! TYPE - IF (E_C.EQ.DWC_ENDOFLOOP) GOTO 830! RETRY ALL - GOTO 242 ! RETRY - END IF - IF (J0.EQ.0) GOTO 830 - IF (C1(1:1).EQ.'N') THEN ! NONE - CWGTYP=0 ! CWEIGHT TYPE - ELSE IF (C1(1:1).EQ.'G') THEN ! GAUSS - CWGTYP=1 - ELSE IF (C1(1:1).EQ.'L') THEN !LINEAR - CWGTYP=2 - ELSE - GOTO 242 - END IF -C - 244 CONTINUE - C1=' ' - IF (CWGTYP.EQ.1 .OR. CWGTYP.EQ.5) THEN - C1='2548.' - ELSE IF (CWGTYP.EQ.2) THEN - C1='4000.' - ELSE - CWGVAL=0 - J0=1 - ENDIF - IF (C1.NE.' ') THEN - IF (.NOT.WNDPAR('CWEIGHT_VALUE', - 1 CWGVAL,LB_E,J0,C1)) THEN - IF (E_C.EQ.DWC_ENDOFLOOP) GOTO 830! RETRY ALL - GOTO 244 - END IF - IF (J0.EQ.0) GOTO 244 - ENDIF -C -C UV convolution function: Type and width -C - 246 CONTINUE - IF (.NOT.DODFT) THEN ! NO CONVOLUTION FOR DFT - IF (.NOT.CLEAN) THEN - IF (UVCDT.EQ.0) THEN - C1='EXPSINC' - ELSE - C1='BOX' - ENDIF - IF (.NOT.WNDPAR('CONVOLVE',C1, - 1 LEN(C1),J0,C1)) THEN - IF (E_C.EQ.DWC_ENDOFLOOP) GOTO 830 ! RETRY ALL - GOTO 246 ! RETRY - END IF - IF (C1(1:1).EQ.'G') THEN ! GAUSS - CVLTYP=1 - ELSE IF (C1(1:1).EQ.'B') THEN ! BOX - CVLTYP=2 - ELSE IF (C1(1:2).EQ.'P4') THEN ! PROLATE 4*4 - CVLTYP=3 - ELSE IF (C1(1:1).EQ.'E') THEN ! EXP*SINC - CVLTYP=4 - ELSE IF (C1(1:2).EQ.'P6') THEN ! PROLATE 6*6 - CVLTYP=5 - ELSE - GOTO 246 - END IF - END IF - IF (CVLTYP.EQ.1) THEN ! GAUSS - CVLWID(0)=3.98 - ELSE IF (CVLTYP.EQ.2) THEN ! BOX - CVLWID(0)=1.0 - ELSE IF (CVLTYP.EQ.3) THEN ! P4*4 - CVLWID(0)=4 - ELSE IF (CVLTYP.EQ.4) THEN ! EXPSINC - CVLWID(0)=6 - ELSE ! P6*6 - CVLWID(0)=6 - END IF - CVLWID(0)=CVLWID(0)/2. ! SET HALF WIDTH - CVLWID(1)=CVLWID(0) -C -C Correction of map for convolution taper -C - 248 CONTINUE - IF (.NOT.CLEAN) THEN - IF (.NOT.WNDPAR('DECONVOLVE', - 1 BB1,LB_B,J0)) THEN - IF (E_C.EQ.DWC_ENDOFLOOP) GOTO 830! RETRY ALL - GOTO 248 - END IF - IF (J0.EQ.0) GOTO 830 - DECVL=BB1 - END IF ! not CLEAN - ENDIF ! not DODFT - ELSE -C -C BASHA/IFRHA defaults -C - IF (UVCDT.NE.0) THEN ! BASHA/IFRHA? - UWGT=0 ! NATURAL - TAPTYP=3 ! NATURAL - TAPVAL=0 - CVLTYP=2 ! BOX - CVLWID(0)=1. -C -C 'Make' defaults -C - ELSE ! standard UV plane? - UWGT=1 ! STANDARD - IF (.NOT.CLEAN) THEN - TAPTYP=1 ! GAUSS - CVLTYP=4 ! EXPSINC - CVLWID(0)=6. - END IF - TAPVAL=2548. - END IF - CWGTYP=0 ! NO CIRC. WEIGHT - CVLWID(0)=CVLWID(0)/2. ! SET HALF WIDTH - CVLWID(1)=CVLWID(0) - IF (.NOT.CLEAN) THEN - DECVL=.TRUE. ! DECONVOLVE - END IF -C - ENDIF ! QMAPS - -C -C QDATAS CORRECTIONS -C - 840 CONTINUE -CC IF (.NOT.CLEAN) CALL WNCTXT(F_TP,'!/Data manipulations:') - 850 CONTINUE - IF (CLEAN) THEN - BB1=.FALSE. ! NO DATA MANIPULATIONS - ELSE - IF (.NOT.WNDPAR('QDATAS',BB1,LB_B,J0)) THEN - IF (E_C.EQ.DWC_ENDOFLOOP) GOTO 830! RETRY OUTPUTS - GOTO 850 ! REPEAT - END IF - IF (J0.EQ.0) GOTO 820 ! RETRY OUTPUTS - END IF - IF (CLEAN) THEN ! CLEAN DEFAULTS - UVDTP=0 - DATTYP=MPHI(MPH_CD_I+5) - CLIP=MPHI(MPH_CD_I+3).EQ.1 - LSHIFT=0 - SHIFT(0)=0 - SHIFT(1)=0 - END IF - IF (BB1) THEN ! CLEAN or QDATAS=no? - ELSE -C -C Defaults for CLEAN -C - UVRAD(0)=0 ! UV AREA - UVRAD(1)=10000 - CLPRAD(0)=0 - CLPRAD(1)=10000 - CLPLEV(0)=100000 - CLPLEV(1)=100000 -C -C Defaults for .NOT.CLEAN, i.e. for QDATAS=no -C - IF (.NOT.CLEAN) THEN - CALL NSCSAD(CAP,CDAP) ! GET CORRECTIONS TO APPLY - UVDTP=0 ! STANDARD - CLIP=.FALSE. ! NO CLIP - SHIFT(0)=0 ! NO FIELDSHIFT - SHIFT(1)=0 - LSHIFT=0 - DATTYP=1 ! NORMAL MAP - GOTO 860 ! skip rest of QDATAS section - END IF - END IF -C -C QDATAS prompts for CLEAN or QDATAS-yes -C - CALL NSCSAD(CAP,CDAP) ! GET CORRECTIONS TO APPLY - 250 CONTINUE - IF (.NOT.CLEAN) THEN - IF (.NOT.WNDPAR('USER_DATA',C1,LEN(C1), - 1 J0,'STANDARD')) THEN - IF (E_C.EQ.DWC_ENDOFLOOP) GOTO 850! RETRY ALL - GOTO 250 ! RETRY - END IF - IF (J0.EQ.0) GOTO 850 ! RETRY ALL - IF (C1(1:1).EQ.'M') THEN ! MODEL - UVDTP=1 - ELSE ! STANDARD - UVDTP=0 - END IF - END IF - 252 CONTINUE - IF (.NOT.WNDPAR('UV_AREA',UVRAD, - 1 2*LB_E,J0)) THEN - IF (E_C.EQ.DWC_ENDOFLOOP) GOTO 850 ! RETRY DATA PARAMETERS - GOTO 252 ! RETRY - END IF - IF (J0.EQ.0) GOTO 850 ! RETRY DATA -C -C Clipping -C - 254 CONTINUE - IF (.NOT.CLEAN) THEN - IF (.NOT.WNDPAR('CLIPPING',BB1,LB_B, - 1 J0,'NO')) THEN - IF (E_C.EQ.DWC_ENDOFLOOP) GOTO 850! RETRY DATA - GOTO 254 ! RETRY - END IF - CLIP=BB1 - IF (J0.EQ.0) GOTO 850 ! RETRY UV AREA - IF (J0.LT.0) CLIP=.FALSE. ! NO - END IF - 256 CONTINUE - IF (CLIP) THEN - IF (.NOT.WNDPAR('CLIP_AREA',CLPRAD, - 1 2*LB_E,J0)) THEN - IF (E_C.EQ.DWC_ENDOFLOOP) GOTO 850! RETRY ALL - GOTO 256 ! RETRY - END IF - IF (J0.EQ.0) GOTO 850 ! RETRY ALL - IF (.NOT.WNDPAR('CLIP_LEVELS',CLPLEV, - 1 2*LB_E,J0)) THEN - IF (E_C.EQ.DWC_ENDOFLOOP) GOTO 850! RETRY DATA - GOTO 256 ! RETRY - END IF - IF (J0.EQ.0) GOTO 850 ! RETRY ALL - END IF - 258 CONTINUE -C -C Shift -C - IF (.NOT.CLEAN) THEN - IF (.NOT.WNDPAR('FIELD_SHIFT',SHIFT, - 1 2*LB_E,J0)) THEN - IF (E_C.EQ.DWC_ENDOFLOOP) GOTO 850! RETRY ALL - GOTO 258 ! RETRY - END IF - IF (E_C.NE.DWC_NULLVALUE) THEN - LSHIFT=1 - ELSE - 259 CONTINUE - CENTRE(0)=MAPCRD(0)*360D0 - IF (CENTRE(0).LT.0) - 1 CENTRE(0)=CENTRE(0)+360D0 - D0=CENTRE(0) - CENTRE(1)=MAPCRD(1)*360D0 - D1=CENTRE(1) - IF (.NOT.WNDPAR('FIELD_CENTRE',CENTRE, - 1 2*LB_D,J0,A_B(-A_OB),CENTRE,2)) THEN - IF (E_C.EQ.DWC_ENDOFLOOP) GOTO 850! RETRY ALL - GOTO 259 ! RETRY - END IF - IF (CENTRE(0).NE.D0 .OR. - 1 CENTRE(1).NE.D1) THEN ! input given? - CENTRE(0)=CENTRE(0)/360D0 - CENTRE(1)=CENTRE(1)/360D0 - LSHIFT=-1 - ENDIF - ENDIF - END IF - 260 CONTINUE - IF (.NOT.CLEAN) THEN - IF (.NOT.WNDPAR('DATA_TYPE',C1, - 1 LEN(C1),J0,)) THEN ! complex, C, S, A or P - IF (E_C.EQ.DWC_ENDOFLOOP) GOTO 850! RETRY ALL - GOTO 260 ! RETRY - END IF - IF (J0.EQ.0) GOTO 850 ! RETRY ALL - DATTYP=1 ! ASSUME NORMAL - IF (C1(1:1).EQ.'N') THEN ! NORMAL MAP - DATTYP=1 - ELSE IF (C1(1:1).EQ.'C') THEN ! COSINE - DATTYP=2 - ELSE IF (C1(1:1).EQ.'S') THEN ! SINE - DATTYP=3 - ELSE IF (C1(1:1).EQ.'A') THEN ! AMPLITUDE - DATTYP=4 - ELSE IF (C1(1:1).EQ.'P') THEN ! PHASE - DATTYP=5 - END IF - ENDIF ! end of QDATAS section - -C -C SOURCE SUBTRACTION -C - 860 CONTINUE - IF (CLEAN) THEN - SUB=.TRUE. ! clean: ALWAYS SUBTRACT - ELSE - IF (UVDTP.NE.1) THEN ! SUBTRACT? - IF (.NOT.WNDPAR('SUBTRACT',BB1,LB_B,J0, - 1 A_B(-A_OB),SUB,1)) THEN - IF (E_C.EQ.DWC_ENDOFLOOP) GOTO 840! RETRY DATA - GOTO 860 ! RETRY - END IF - SUB=BB1 ! SET SUBTRACTION - IF (J0.EQ.0) GOTO 840 ! RETRY DATA - END IF - END IF - IF (SUB .OR. UVDTP.EQ.1) THEN ! SOURCES WANTED - CALL NMODAW(NSRC(0),STH) ! GET SOURCES - CALL NSCSAD(CAP,CDAP) ! GET CORRECTIONS AGAIN - IF (NSRC(0).LE.0 .AND. .NOT.CLEAN) THEN - CALL WNCTXT(F_TP,'No sources specified') - GOTO 860 ! RETRY - END IF - CALL NMOMUI ! GET MODEL USAGE - END IF -C -C OUTPUT FILES -C - 870 CONTINUE - IF (.NOT.CLEAN) CALL WNCTXT(F_TP,'!/!4C\Output files:') -C -C POLARISATIONS -C - 262 CONTINUE - IF (CLEAN) THEN - CALL WNGMTS(MPH_POL_N,MPH(MPH_POL_1), - 1 POLC(0)) ! clean: SET POL. TO DO - NPOL=1 - POLTJ(-1,1)=1 !CLEAN - ELSE - IF (.NOT.WNDPAR('MAP_POLAR',POLC, - 1 4*LEN(POLC(0)),J0)) THEN - IF (E_C.EQ.DWC_ENDOFLOOP) GOTO 840! RETRY DATA - GOTO 262 ! ERROR, retry - END IF - IF (J0.EQ.0) GOTO 840 ! RETRY ALL - NPOL=J0 ! # OF POLARISATIONS - POLTJ(-1,1)=0 !NOT CLEAN - END IF - DO I=0,3 ! CLEAR POL. TABLE - POLT(I,0)=0 - END DO - DO I=0,NPOL-1 ! SET CODES - DO I1=1,MXNPCD ! FIND CORRECT ONE - IF (POLC(I).EQ.PCD(I1)) THEN ! FOUND - POLTJ(I,0)=PCDT(I1) - GOTO 264 ! READY - END IF - END DO - 264 CONTINUE - END DO - IF (NPOL.EQ.1 .AND. POLTJ(0,0).EQ.I_M+IMAG_P+LINE_P) THEN - POLTJ(-1,0)=1 !SET POL. INT. - ELSE IF (NPOL.EQ.1 .AND. POLTJ(0,0).EQ.Q_M+IMAG_P) THEN - POLTJ(-1,0)=2 !SET POL. INT. - ELSE - POLTJ(-1,0)=0 !SET NOT POL. INT. - END IF -C -C Map COORDINATE system -C - 266 CONTINUE - IF (CLEAN) THEN ! clean defaults - IF (MPHI(MPH_EPT_I).EQ.1) THEN - CEP='REF' - ELSE - CEP='AREF' - END IF - ELSE - IF (.NOT.WNDPAR('MAP_COORD',CEP, - 1 LEN(CEP),J0,CEP)) THEN - IF (E_C.EQ.DWC_ENDOFLOOP) GOTO 870! RETRY DATA - GOTO 266 ! ERROR, retry - END IF - IF (J0.EQ.0) GOTO 870 ! RETRY ALL - END IF - IF (CEP(1:1).EQ.'B') THEN ! B1950/J2000 - MAPCTP=+2 - ELSE IF (CEP(1:3).EQ.'APP') THEN ! APPARENT - MAPCTP=+1 - ELSE IF (CEP(1:3).EQ.'REF') THEN ! 1950/2000 REFERENCE - MAPCTP=-2 - ELSE IF (CEP(1:3).EQ.'ARE') THEN ! APPARENT REFERENCE - MAPCTP=-1 - ELSE - GOTO 266 ! MUST FILL - END IF - 268 CONTINUE - IF (MAPCTP.LT.0) THEN ! GET REFERENCE COORD. - IF (CLEAN) THEN - MAPCRD(0)=MPHD(MPH_RA_D) ! MAP COORDINATES - MAPCRD(1)=MPHD(MPH_DEC_D) - ELSE - IF (MAPCRD(0).EQ.-1000) THEN ! no value yet? - JS=WNDPAR('REF_COORD',MAPCRD(0), - 1 2*LB_D,J0) - ELSE ! use previous as default - MAPCRD(0)=WNGDPD(WNGDFD(MAPCRD(0))) ! MAKE DEGREES - MAPCRD(1)=WNGDND(WNGDFD(MAPCRD(1))) ! MAKE DEGREES - JS=WNDPAR('REF_COORD',MAPCRD(0),2*LB_D,J0, - 1 A_B(-A_OB),MAPCRD(0),2) - END IF - If (MAPCRD(0).NE.-1000) THEN - MAPCRD(0)=WNGDPF(WNGDDF(MAPCRD(0))) ! MAKE circles - MAPCRD(1)=WNGDNF(WNGDDF(MAPCRD(1))) - END IF - IF (.NOT.JS) THEN - IF (E_C.EQ.DWC_ENDOFLOOP) GOTO 870 !RETRY ALL - GOTO 268 !RETRY - END IF - IF (J0.EQ.0) GOTO 870 ! RETRY ALL - END IF - END IF -C -C OUTPUT types: Map, AP, cover, real, imag, ampl, phase -C - 270 CONTINUE - IF (CLEAN) THEN - J0=1 ! ONLY MAP OUT - C2(1)='MAP' - ELSE - IF (FCAOUT.NE.0) CALL WNFCL(FCAOUT) ! MAKE SURE NEW ONE - IF (DODFT) GOTO 880 ! DFT - IF (UVCDT.EQ.0) THEN ! make - IF (.NOT.WNDPAR('OUTPUT',C2, - 1 8*LEN(C2(1)),J0, - 1 'MAP,AP')) THEN - IF (E_C.EQ.DWC_ENDOFLOOP) GOTO 870 !RETRY ALL - GOTO 270 !RETRY - END IF - IF (J0.EQ.0) GOTO 870 ! RETRY ALL - ELSE ! BASHA/IFRHA - CALL WNDPOH(' ', - 1 'COVER,REAL,IMAG,AMPL,PHASE',' ') - IF (.NOT.WNDPAR('OUTPUT',C2, - 1 8*LEN(C2(1)),J0, - 1 'AMPL,PHASE')) THEN - IF (E_C.EQ.DWC_ENDOFLOOP) GOTO 870! RETRY ALL - GOTO 270 ! RETRY - END IF - IF (J0.EQ.0) GOTO 870 ! RETRY ALL - END IF - END IF - DO I=1,NOPT ! SET NO OUTPUTS - OUTOPT(I)=.FALSE. - END DO - MAKMAP=.FALSE. ! NO MAP MAKING - MAKAP=.FALSE. - DO I=1,J0 ! SET OUTPUTS - IF (C2(I)(1:1).EQ.'M') THEN ! MAP - OUTOPT(1)=.TRUE. - MAKMAP=.TRUE. - ELSE IF (C2(I)(1:2).EQ.'AP') THEN ! AP - OUTOPT(2)=.TRUE. - MAKAP=.TRUE. - ELSE IF (C2(I)(1:1).EQ.'C') THEN ! COVER - OUTOPT(3)=.TRUE. - MAKAP=.TRUE. - ELSE IF (C2(I)(1:1).EQ.'R') THEN ! REAL PLANE - OUTOPT(4)=.TRUE. - MAKMAP=.TRUE. - ELSE IF (C2(I)(1:1).EQ.'I') THEN ! IMAG. PLANE - OUTOPT(5)=.TRUE. - MAKMAP=.TRUE. - ELSE IF (C2(I)(1:2).EQ.'AM') THEN ! AMPL. PLANE - OUTOPT(6)=.TRUE. - MAKMAP=.TRUE. - ELSE IF (C2(I)(1:1).EQ.'P') THEN ! PHASE PLANE - OUTOPT(7)=.TRUE. - MAKMAP=.TRUE. - END IF - END DO - 272 CONTINUE - IF (CLEAN) THEN - FCAOUT=CMFCA ! DEFAULT OUTPUT FCA - ELSE - IF (.NOT.WNDNOD('OUTPUT_WMP_NODE', - 1 NODOUT,'WMP','U',NODOUT,FILOUT)) THEN - IF (E_C.EQ.DWC_ENDOFLOOP) GOTO 870! RETRY OUTPUT - GOTO 272 ! REPEAT - ELSE IF (E_C.EQ.DWC_NULLVALUE) THEN - GOTO 870 ! RETRY OUTPUT - ELSE IF (E_C.EQ.DWC_WILDCARD) THEN - GOTO 272 ! MUST SPECIFY - END IF - IF (.NOT.WNFOP(FCAOUT,FILOUT,'U')) GOTO 272 -C - IF (MAKMAP) CALL NMAJSL() ! CREATE JOB SUMMARY LOG - END IF -C -C READY -C - 880 CONTINUE -C - END IF ! END MAKE/CLEAN - 900 CONTINUE - RETURN ! READY -C -C - END diff --git a/src/nmap/nmadft.for b/src/nmap/nmadft.for deleted file mode 100644 index 84b32ca3c4b0188f18937acc1aa926b8f625959d..0000000000000000000000000000000000000000 --- a/src/nmap/nmadft.for +++ /dev/null @@ -1,118 +0,0 @@ -C+ NMADFT.FOR -C WNB 910318 -C -C Revisions: -C - SUBROUTINE NMADFT(N,CSD,UVD,APD) -C -C Do DFT -C -C Result: -C -C CALL NMADFT (N_J:I,CSD_X(0:*,0:3):I, -C UVD_E(0:1,0:*):I, APD_E(0:*):I) -C Calculate DFT for selected polarisations. -C N is number of input points. -C CSD the data, UVD the coordinates, APD the -C weight. -C CALL NMADF1 Output the maps. -C -C Include files: -C - INCLUDE 'WNG_DEF' - INCLUDE 'STH_O_DEF' - INCLUDE 'NMA_DEF' -C -C Parameters: -C -C -C Arguments: -C - INTEGER N !NUMBER OF POINTS - COMPLEX CSD(0:STHIFR-1,0:3) !DATA - REAL UVD(0:1,0:*) !U,V COORDINATES - REAL APD(0:*) !DATA WEIGHT -C -C Function references: -C -C -C Data declarations: -C - REAL ARG !DFT ANGLE - INTEGER UOF !OFFSET U - INTEGER VOF !OFFSET V - INTEGER LU !LENGTH LINE - REAL RPI1,RPI2 !WORK - COMPLEX CARG,CDAT - INTEGER NP !POL. COUNT - INTEGER BFPE !BUFFER OFFSET - INTEGER I6 -C- -C -C PREPARE -C - UOF=(FTSIZ(0)/2) - VOF=(FTSIZ(1)/2) !OFFSETS IN MAP - I4=2*UOF !HIGHEST COORD. - I5=2*VOF - LU=I4+1 !LENGTH LINE - RPI1=PI2/(I4+1) - RPI2=PI2/(I5+1) -C - DO NP=0,NPOL-1 !ALL POLARISATIONS - BFPE=(DFTBFA(NP)-A_OB)/LB_E !BUFFER POINTER - DO I1=0,N-1 !DO ALL DATA POINTS - R0=APD(I1) !WEIGHT - IF (R0.NE.0) THEN !DO - DFTWT(NP)=DFTWT(NP)+ABS(R0) !TOTAL WEIGHT - DO I2=0,I4 - R1=RPI1*(I2-UOF) - IF (I2.GE.UOF) THEN - I6=VOF-1 - ELSE - I6=VOF - END IF - DO I3=0,I6 - ARG=UVD(0,I1)*R1+UVD(1,I1)*RPI2*(I3-VOF) - CARG=CMPLX(COS(ARG),SIN(ARG)) - CDAT=CSD(I1,NP) - A_E(BFPE+I3*LU+I2)=A_E(BFPE+I3*LU+I2)+ - 1 R0*REAL(CDAT*CONJG(CARG)) - A_E(BFPE+(I5-I3)*LU+I4-I2)=A_E(BFPE+(I5-I3)*LU+I4-I2)+ - 1 R0*REAL(CDAT*CARG) - END DO - END DO - A_E(BFPE+VOF*LU+UOF)=A_E(BFPE+VOF*LU+UOF)+ - 1 R0*REAL(CDAT) !CORRECT CENTRE - END IF - END DO - END DO -C - RETURN -C -C SHOW RESULT -C - ENTRY NMADF1 -C - UOF=FTSIZ(0)/2 - VOF=FTSIZ(1)/2 - LU=I4+1 !LENGTH LINE - DO NP=0,NPOL-1 !ALL POLARISATIONS - BFPE=(DFTBFA(NP)-A_OB)/LB_E !BUFFER POINTER - CALL WNCTXT(F_TP,' ') - DO I=0,2*VOF - DO I1=0,2*UOF !NORMALISE - A_E(BFPE+I*LU+I1)=A_E(BFPE+I*LU+I1)/DFTWT(NP) - END DO - CALL WNCTXT(F_TP,'!80$9Q1\!8$#E7.1', - 1 2*UOF+1,A_E(BFPE+I*LU)) - END DO - CALL WNCTXT(F_TP,' ') - CALL WNGFVA(LB_E*((FTSIZ(0)/2)*2+1)*((FTSIZ(1)/2)*2+1), - 1 DFTBFA(NP)) !RELEASE BUFFER - END DO -C - RETURN -C -C - END diff --git a/src/nmap/nmafid.for b/src/nmap/nmafid.for deleted file mode 100644 index 2e034902002bd6621848cba5ee5b3d888ff8a1e0..0000000000000000000000000000000000000000 --- a/src/nmap/nmafid.for +++ /dev/null @@ -1,818 +0,0 @@ -C+ NMAFID.FOR -C WNB 910815 -C -C Revisions: -C WNB 910911 Add type 5 and weights -C WNB 910912 Add types 1* and band, frequency etc. -C WNB 910927 Add bandwidths -C WNB 911105 Change de-beam factors -C WNB 911115 Change minimum beam factor -C HjV 920520 HP does not allow extended source lines -C WNB 920626 FSUM error for 2nd negative factor -C WNB 920626 Beam/Debeam scale error -C WNB 920812 Change types < 10 to iterate across 2nd sets -C WNB 920812 Add loops for SUM -C WNB 920818 Do not set new noise for copy/extract -C WNB 920828 Update for line velocities -C HjV 930311 Change some text -C WNB 930602 Use BEMLIM -C WNB 930826 New beam factors -C WNB 930928 Multiple instruments for beaming -C WNB 930930 Use Fiddle codes -C WNB 940628 Change sign field shift RA -C CMV 940808 Retain original comment for COPy -C CMV 940815 Correct call to WNDSTI (FCA(0), not FCA(2)) -C CMV 940929 Clear JSS pointer in output map if different file -C CMV 941017 Change fieldsize for extract -C CMV 951127 Implement CSUM and RSUM -C CMV 951204 Add RMVAL and weights for RSUM -C WNB 951212 Correct typo's in MOD(real,integer) funtions -C - SUBROUTINE NMAFID(TYP) -C -C Combine/extract/replace maps -C -C Result: -C -C CALL NMAFID ( TYP_J:I) Combine maps: -C TYP=ADD Add: Mout=(F1*M1+F2*M2) -C TYP=AVE Average Mout=(F1*M1+F2*M2)/norm -C TYP=POL Pol: Mout=sqrt(M1**2+M2**2) -C TYP=ANG Angle: Mout=.5*atan(M1,M2) -C TYP=SUM Sum: Mout=sum(Mi) -C TYP=NSU Nsum: Mout=norm. sum(Mi) -C TYP=BSU Bsum: Mout=band sum(Mi) -C TYP=BNS BNsum: Mout=band+norm. sum(Mi) -C TYP=FSU Fsum: Mout=factored sum(Mi) -C TYP=NSS Nssum: Mout=noised sum(Mi) -C TYP=EXT Extract Mout=Area(M1) -C TYP=COP Copy: Mout=M1 -C TYP=BEA Beam: M1=M1/primary_beam -C TYP=DEB Debeam: M1=M1*primary_beam -C TYP=FAC Factor: M1=F1*M1 -C -C Include files: -C - INCLUDE 'WNG_DEF' - INCLUDE 'GFH_O_DEF' !FILE HEADER - INCLUDE 'SGH_O_DEF' !SUB-GROUP HEADER - INCLUDE 'MPH_O_DEF' !MAP HEADER - INCLUDE 'NMA_DEF' -C -C Parameters: -C -C -C Arguments: -C - INTEGER TYP !TYPE OF OPERATION -C -C Function references: -C - LOGICAL WNFOP !OPEN FILE - INTEGER WNFEOF !FILE LENGTH - LOGICAL WNFWR !WRITE DISK - LOGICAL WNFRD !READ DISK - LOGICAL WNDLNF,WNDLNG,WNDLNK !LINK MAPS - CHARACTER*32 WNTTSG !MAP NAME - LOGICAL NMASTG,NMASTL !GET SET - LOGICAL WNDSTR !RESET SET SEARCH - LOGICAL NMOBMF !GET BEAM RANGE - DOUBLE PRECISION NMOBMV !BEAM VALUES -C -C Data declarations: -C - INTEGER FCA(0:2) !FILE AREAS - INTEGER HIST !MAP HISTOGRAM ADDRESS - LOGICAL LINK !NEW LINK? - LOGICAL LFIRST !FIRST LINK? - CHARACTER*32 TXT,CS1,CS2 !TEXT DATA - DOUBLE PRECISION NORM !NORMALISATION - REAL NADD -C - DOUBLE PRECISION FRQ0 !REFERENCE FRQ FOR RSUM - DOUBLE PRECISION SAVFRQ !SAVE FRQ FOR RSUM TEST - DOUBLE PRECISION THETA !ROT.ANGLE FOR RSUM - INTEGER IRM !LOOP OVER ROT.MEASURES FOR RSUM - LOGICAL DO_IM !FLAG RE/IM FOR CSUM/RSUM - INTEGER POLRE,POLIM !POLARIZATIONS OF RE and IM MAP - CHARACTER*2 CPOLRE,CPOLIM ! ALSO AS CHARACTERS - INTEGER LPSAV(0:7) !SAVE LOOP VALUES FOR RSUM/CSUM -C - DOUBLE PRECISION FAC(0:2) !FACTORS - INTEGER FAREA(0:3) !FULL AREA - INTEGER TAREA(0:3,0:1) !TOTAL AREA (CENTRE, EDGE) - INTEGER PAREA(0:3,1,0:1) !PARTIAL AREAS - INTEGER MXAREA (0:3) !MAX. AREA - INTEGER BORDER(0:1,0:1) !MAP OUTPUT BORDERS - INTEGER LSIZE !LINE SIZE - INTEGER OUTP !OUTPUT POINTER - INTEGER SNAM(0:7,0:2) !SET NAME - INTEGER MPHP(0:2) !MAP HEADER POINTER - BYTE MPH(0:MPHHDL-1,0:2) !MAP HEADER - INTEGER*2 MPHI(0:MPHHDL/2-1,0:2) - INTEGER MPHJ(0:MPHHDL/4-1,0:2) - REAL MPHE(0:MPHHDL/4-1,0:2) - DOUBLE PRECISION MPHD(0:MPHHDL/8-1,0:2) - EQUIVALENCE (MPH,MPHI,MPHJ,MPHE,MPHD) - REAL DAT(0:8191,0:1) !MAP LINE INPUT - REAL ODAT(0:8191) !MAP LINE OUTPUT -C- -C -C INIT -C - CALL WNCTXT(F_T,'Initialising files and histograms') - DO I=0,7 !SAVE LOOP INFO - LPSAV(I)=LPOFF(I) - END DO - LFIRST=.TRUE. !FIRST LINK - IRM=0 !FOR LOOP OVER ROT.MEASURES - IF (.NOT.WNFOP(FCA(0),FILIN(1),'U')) THEN !OPEN INPUT/OUTPUT - CALL WNCTXT(F_TP,'Cannot open !AS',FILIN(1)) - GOTO 900 - END IF - FCA(1)=FCA(0) !ASSUME SAME - IF (TYP.LT.FID_BEA) THEN !COULD BE SECOND - IF (FILIN(2).NE.'*') THEN !NOT SAME - FCA(1)=0 !SET EMPTY - IF (TYP.GE.FID_EXT) THEN !OUTPUT - JS=WNFOP(FCA(1),FILIN(2),'U') - ELSE - JS=WNFOP(FCA(1),FILIN(2),'R') - END IF - IF (.NOT.JS) THEN - CALL WNCTXT(F_TP,'Cannot open !AS',FILIN(2)) - GOTO 900 - END IF - END IF - END IF -C -C OUTER LOOP FOR COMPLEX SUMMATION (quick and dirty) -C - DO_IM=.FALSE. !FIRST REAL PART - 100 CONTINUE - NADD=0 !SUMMING - CALL WNMHS8(HIST,1,1E0) !INIT HISTO - J0=WNDSTR(FCA(0),SETS) !RESET SET SEARCH - DO I=0,7 !RESTORE LOOP INFO - LPOFF(I)=LPSAV(I) - END DO -C -C GET SETS -C - CALL WNCTXT(F_T,'Starting operations...') - DO WHILE(NMASTL(FCA(0),SETS(0,0,1),MPH(0,0), - 1 MPHP(0),SNAM(0,0),LPOFF)) !GET A SET (LOOPED) - IF (TYP.LT.FID_SUM) THEN !NEED SECOND SET - IF (.NOT.NMASTG(FCA(1),SETS(0,0,2),MPH(0,1), - 1 MPHP(1),SNAM(0,1))) THEN !NO SECOND, RECYCLE - IF (.NOT.NMASTG(FCA(1),SETS(0,0,2),MPH(0,1), - 1 MPHP(1),SNAM(0,1))) GOTO 900 !NO SECOND, READY - END IF - ELSE IF (TYP.LT.FID_EXT) THEN !SUMMATION - IF (NADD.EQ.0) THEN !FIRST ADDITION - IF (.NOT.NMASTL(FCA(0),SETS(0,0,1),MPH(0,1), - 1 MPHP(1),SNAM(0,1))) GOTO 900 !GET A SET - IF (TYP.EQ.FID_CSU .OR. TYP.EQ.FID_RSU) THEN - FRQ0=MPHD(MPH_FRQ_D,0) !REF FRQ (RSUM) - POLRE=SNAM(3,0) !SAVE POL. CHANNELS - POLIM=SNAM(3,1) - CALL WNGMFS(MPH_POL_N,MPH(MPH_POL_1,0),CPOLRE) - CALL WNGMFS(MPH_POL_N,MPH(MPH_POL_1,1),CPOLIM) - IF (DO_IM) THEN - CALL WNCTXT(F_TP, - 1 'Making imaginary part (!A2)',CPOLIM) - ELSE - CALL WNCTXT(F_TP, - 1 'Making real part (!A2)',CPOLRE) - END IF - END IF - ELSE !MORE ADDITIONS - MPHP(1)=MPHP(2) !INPUT=OUTPUT - CALL WNGMV(MPHHDL,MPH(0,2),MPH(0,1)) - CALL WNGMV(8*LB_J,SNAM(0,2),SNAM(0,1)) - FCA(1)=FCA(2) - IF (TYP.EQ.FID_CSU .OR. TYP.EQ.FID_RSU) THEN - IF (MOD(NADD+1,2.).EQ.1 .AND. - 1 SNAM(3,0).NE.POLIM) THEN - CALL WNCTXT(F_TP, - 1 'Unexpected pol. !UJ for Im(U) map', - 1 SNAM(3,0)) - ELSE IF (MOD(NADD+1,2.).EQ.0 .AND. - 1 SNAM(3,0).NE.POLRE) THEN - CALL WNCTXT(F_TP, - 1 'Unexpected pol. !UJ for Re(Q) map', - 1 SNAM(3,0)) - END IF - END IF - END IF - END IF -C -C CHECK IF CAN DO -C - IF (TYP.LT.FID_EXT) THEN !NEED 2 EQUAL SIZES - IF (MPHJ(MPH_NRA_J,0).NE.MPHJ(MPH_NRA_J,1) .OR. - 1 MPHJ(MPH_NDEC_J,0).NE.MPHJ(MPH_NDEC_J,1)) THEN - CALL WNCTXT(F_TP,'Unequal map sizes in Sets !AS and !AS', - 1 WNTTSG(SNAM(0,0),0),WNTTSG(SNAM(0,1),0)) - GOTO 10 !TRY NEXT PAIR - END IF - END IF -C -C GET AREA -C - IF (TYP.EQ.FID_EXT .AND. NADD.EQ.0) THEN !FIRST EXTRACT - DO I=0,3 !INIT - TAREA(I,0)=0 - FAREA(I)=0 - MXAREA(I)=0 - END DO - FAREA(2)=MPHJ(MPH_NRA_J,0) - FAREA(3)=MPHJ(MPH_NDEC_J,0) - MXAREA(2)=FAREA(2) - MXAREA(3)=FAREA(3) - TAREA(2,0)=FAREA(2) - TAREA(3,0)=FAREA(3) - CALL NMADAR(1,J0,FAREA,8,MXAREA,TAREA(0,0),PAREA(0,1,0), - 1 TAREA(0,1),PAREA(0,1,1)) !GET AREA - IF (J0.LE.0) GOTO 900 !NO AREA - FTSIZ(0)=TAREA(2,1) !DEC - FTSIZ(1)=TAREA(3,1) - OUTSIZ(0)=TAREA(0,1) !RA - OUTSIZ(1)=TAREA(1,1) - END IF -C -C GET OUTPUT DATA -C - LINK=.TRUE. !ASSUME NEW LINK - IF (TYP.LT.FID_SUM) THEN !COMBINE - OUTP=WNFEOF(FCA(0)) !NEW MAP - NODOUT=NODIN(1) !OUTPUT NAME - FCA(2)=FCA(0) !OUTPUT=INPUT - CALL WNGMV(MPHHDL,MPH(0,0),MPH(0,2)) !NEW HEADER - ELSE IF (TYP.LT.FID_EXT) THEN !SUMMATION - IF (NADD.EQ.0) THEN !FIRST - OUTP=WNFEOF(FCA(0)) - FCA(2)=FCA(0) !OUTPUT=INPUT - NODOUT=NODIN(1) !OUTPUT NAME - CALL WNGMV(MPHHDL,MPH(0,0),MPH(0,2)) !NEW HEADER - ELSE - OUTP=MPHJ(MPH_MDP_J,2) !OLD - LINK=.FALSE. - END IF - ELSE IF (TYP.LT.FID_BEA) THEN - OUTP=WNFEOF(FCA(1)) !NEW MAP - FCA(2)=FCA(1) !MAYBE NEW OUTPUT - NODOUT=NODIN(2) !OUTPUT NAME - CALL WNGMV(MPHHDL,MPH(0,0),MPH(0,2)) !NEW HEADER - ELSE - OUTP=MPHJ(MPH_MDP_J,0) !OVERWRITE INPUT - FCA(2)=FCA(0) !OUTPUT=INPUT - NODOUT=NODIN(1) !OUTPUT NAME - CALL WNGMV(MPHHDL,MPH(0,0),MPH(0,2)) !NEW HEADER - LINK=.FALSE. - CALL WNGMV(8*LB_J,SNAM(0,0),SGNR(0)) !SAVE NAME - MPHP(2)=MPHP(0) !MAP HEADER - END IF -C -C NORMALISATION -C - NADD=NADD+1 !COUNT MAPS - NORM=1 !ASSUME 1 - FAC(0)=1 !DEFAULT FACTORS - FAC(1)=0 - IF (TYP.LT.FID_POL) THEN !ADD - FAC(0)=POLT(0,0) !FACTORS - FAC(1)=POLT(1,0) - IF (TYP.EQ.FID_AVE) THEN !AVERAGE - NORM=ABS(POLT(0,0))+ABS(POLT(1,0)) - END IF - ELSE IF (TYP.LT.FID_SUM) THEN !POL. - FAC(0)=1 - FAC(1)=1 - ELSE IF (TYP.LT.FID_EXT) THEN !SUMMATION - IF (TYP.EQ.FID_SUM) THEN !SUM - FAC(1)=NADD - ELSE IF (TYP.EQ.FID_NSU) THEN !NSUM - FAC(0)=MPHD(MPH_SUM_D,0) - FAC(1)=MPHD(MPH_SUM_D,1) - ELSE IF (TYP.EQ.FID_BSU) THEN !BSUM - FAC(0)=MPHD(MPH_BDW_D,0) - FAC(1)=MPHD(MPH_BDW_D,1) - ELSE IF (TYP.EQ.FID_BNS) THEN !BNSUM - FAC(0)=MPHD(MPH_SUM_D,0)*MPHD(MPH_BDW_D,0) - FAC(1)=MPHD(MPH_SUM_D,1)*MPHD(MPH_BDW_D,1) - ELSE IF (TYP.EQ.FID_FSU) THEN !FSUM - IF (NADD.EQ.1) THEN - FAC(0)=POLT(-2+MOD(NADD-1,8.),0) - FAC(2)=POLT(-2+MOD(NADD,8.),0) - ELSE - FAC(0)=POLT(-2+MOD(NADD,8.),0) - END IF - FAC(1)=FAC(2) - FAC(2)=ABS(FAC(2))+ABS(FAC(0)) !!920626 - ELSE IF (TYP.EQ.FID_CSU) THEN !CSUM - IF (NADD.EQ.1) THEN - FAC(2)=0 ! RESET TOTAL WEIGHT - IF (DO_IM) THEN ! Bn*REn + An*IMn - FAC(0)= POLT(-2+NADD,0) - FAC(1)= POLT(-2+NADD-1,0) - ELSE ! An*REn - Bn*IMn - FAC(0)= POLT(-2+NADD-1,0) - FAC(1)= -POLT(-2+NADD,0) - END IF - ELSE IF (DO_IM) THEN ! Swap An/Bn - IF (MOD(NADD,2.).EQ.0) THEN ! Re input map - FAC(0)= POLT(-2+NADD+1,0) - ELSE ! Im input map - FAC(0)= POLT(-2+NADD-1,0) - END IF - ELSE ! Negative Bn - IF (MOD(NADD,2.).EQ.0) THEN ! Re input map - FAC(0)= POLT(-2+NADD,0) - ELSE ! Im input map - FAC(0)= -POLT(-2+NADD,0) - END IF - END IF -C - IF (MOD(NADD,2.).EQ.0) THEN ! Re input map - FAC(1)=FAC(2) - NORM=1. - ELSE ! Im input map - IF (NADD.NE.1) FAC(1)= 1. ! First (Re,Im) pair - FAC(2)=FAC(2)+SQRT(POLT(-2+NADD ,0)**2+ - 1 POLT(-2+NADD-1,0)**2) - NORM=FAC(2) - END IF - CALL WNCTXT(F_TP,'CSUM Fac: !D9.2 , !D9.2',FAC(0),FAC(1)) -C - ELSE IF (TYP.EQ.FID_RSU) THEN !RSUM -C -C Check frequencies and calculate rot.angle -C - IF ((NADD.EQ.1 .AND. - 1 MPHD(MPH_FRQ_D,0).NE.MPHD(MPH_FRQ_D,1)) .OR. - 1 (NADD.GT.1 .AND. MOD(NADD,2.).NE.0 .AND. - 1 MPHD(MPH_FRQ_D,0).NE.SAVFRQ) ) THEN - CALL WNCTXT(F_TP, - 1 'Input !AS and !AS not same frequency', - 1 CPOLRE,CPOLIM) - ELSE IF (MOD(NADD,2.).EQ.0) THEN - SAVFRQ=MPHD(MPH_FRQ_D,0) !SAVE FREQUENCY Re MAP - END IF -C - THETA=2.*RMVAL(IRM)*( - 1 (DCL*1D-6/FRQ0)**2 - - 1 (DCL*1D-6/MPHD(MPH_FRQ_D,0))**2) !ROT.ANGLE -C - IF (NADD.EQ.1) THEN - FAC(2)=0 ! RESET TOTAL WEIGHT - IF (DO_IM) THEN ! Bn*REn + An*IMn - FAC(0)= SIN(THETA) - FAC(1)= COS(THETA) - ELSE ! An*REn - Bn*IMn - FAC(0)= COS(THETA) - FAC(1)= -SIN(THETA) - END IF - ELSE IF (DO_IM) THEN ! Swap An/Bn - IF (MOD(NADD,2.).EQ.0) THEN ! Re input map - FAC(0)= SIN(THETA) - ELSE ! Im input map - FAC(0)= COS(THETA) - END IF - ELSE ! Negative Bn - IF (MOD(NADD,2.).EQ.0) THEN ! Re input map - FAC(0)= COS(THETA) - ELSE ! Im input map - FAC(0)= -SIN(THETA) - END IF - END IF -C - I2=NADD/2 - D0=POLT(-2+MOD(I2,8),0) ! Weight factor - FAC(0)=FAC(0)*D0 ! Weight input map - IF (MOD(NADD,2.).EQ.0) THEN ! Re input map - FAC(1)=FAC(2) ! Undo normalisation - NORM=1. - ELSE ! Im input map - IF (NADD.NE.1) THEN - FAC(1)= 1. - ELSE ! First (Re,Im) pair - FAC(1)=FAC(1)*D0 ! Weight second input map - END IF - FAC(2)=FAC(2)+D0 !Total weight - NORM=FAC(2) - END IF - CALL WNCTXT(F_TP, - 1 'RSUM Fac: !D6.4, !D6.4, Norm !D6.2, '// - 1 'Theta !D9.4 deg, RM=!E9.3, FRQ=!D9.4', - 1 FAC(0),FAC(1),NORM,THETA/PI2*180, - 1 RMVAL(IRM),MPHD(MPH_FRQ_D,0)) -C - ELSE IF (TYP.EQ.FID_NSS) THEN !NSSUM - DO I=0,1 - IF (MPHE(MPH_NOS_E,I).NE.0) THEN - FAC(I)=1./(MPHE(MPH_NOS_E,I)**2) - ELSE - FAC(I)=0 - END IF - END DO - END IF - IF (TYP.NE.FID_CSU .AND. TYP.NE.FID_RSU) THEN - NORM=ABS(FAC(0))+ABS(FAC(1)) - END IF - ELSE IF (TYP.EQ.FID_FAC) THEN - FAC(0)=POLT(0,0) - END IF - IF (NORM.NE.0) THEN - NORM=1/NORM - ELSE - NORM=1 - END IF -C -C SET BORDERS -C - IF (TYP.EQ.FID_EXT) THEN !SET BORDERS - BORDER(0,0)=FTSIZ(0)+MPHJ(MPH_NDEC_J,0)/2 !DEC LOW - BORDER(1,0)=FTSIZ(1)+MPHJ(MPH_NDEC_J,0)/2 !DEC HIGH - BORDER(0,1)=OUTSIZ(0)+MPHJ(MPH_NRA_J,0)/2 !RA LOW - BORDER(1,1)=OUTSIZ(1)+MPHJ(MPH_NRA_J,0)/2 !RA HIGH - ELSE - BORDER(0,0)=0 !DEC LOW - BORDER(1,0)=MPHJ(MPH_NDEC_J,0)-1 !DEC HIGH - BORDER(0,1)=0 !RA LOW - BORDER(1,1)=MPHJ(MPH_NRA_J,0)-1 !RA HIGH - END IF - LSIZE=BORDER(1,1)-BORDER(0,1)+1 !LENGTH LINE -C -C PREPARE OUTPUT HEADER -C - CALL WNMHS9(HIST) !CLEAR HISTO - CALL WNMHS8(HIST,1,1E0) !INIT HISTO - MPHI(MPH_PCD_I,2)=1 !INDICATE FIDDLE - MPHD(MPH_SHR_D,2)=MPHD(MPH_SHR_D,2)+MPHD(MPH_SRA_D,2)* - 1 ((BORDER(0,1)+BORDER(1,1)+1)/2-MPHJ(MPH_ZRA_J,2)) - MPHD(MPH_SHD_D,2)=MPHD(MPH_SHD_D,2)+MPHD(MPH_SDEC_D,2)* - 1 ((BORDER(0,0)+BORDER(1,0)+1)/2-MPHJ(MPH_ZDEC_J,2)) - MPHJ(MPH_NRA_J,2)=LSIZE !LENGTH LINE - MPHJ(MPH_NDEC_J,2)=BORDER(1,0)-BORDER(0,0)+1 !# OF LINES - MPHE(MPH_FRA_E,2)=MPHJ(MPH_NRA_J,2)*MPHD(MPH_SRA_D,2) !FIELD SIZE RA - MPHE(MPH_FDEC_E,2)=MPHJ(MPH_NDEC_J,2)*MPHD(MPH_SDEC_D,2) !IDEM DEC - MPHJ(MPH_ZRA_J,2)=LSIZE/2 !CENTRE POINT - MPHJ(MPH_ZDEC_J,2)=(BORDER(1,0)-BORDER(0,0)+1)/2 !CENTRE LINE - MPHJ(MPH_MXR_J,2)=0 !POS. MAX/MIN - MPHJ(MPH_MXD_J,2)=0 - MPHJ(MPH_MNR_J,2)=0 - MPHJ(MPH_MND_J,2)=0 - MPHE(MPH_MAX_E,2)=-1E36 !MAX. - MPHE(MPH_MIN_E,2)=1E36 !MIN. - IF (TYP.LT.FID_EXT) THEN - MPHJ(MPH_NPT_J,2)=MPHJ(MPH_NPT_J,0)+MPHJ(MPH_NPT_J,1) !# OF POINTS - MPHJ(MPH_NBL_J,2)=MPHJ(MPH_NBL_J,0)+MPHJ(MPH_NBL_J,1) !# OF BASEL. - MPHJ(MPH_NST_J,2)=MPHJ(MPH_NST_J,0)+MPHJ(MPH_NST_J,1) !# OF SETS - IF (TYP.NE.FID_POL .AND. TYP.NE.FID_ANG) THEN !NOT POL. - D0=ABS(FAC(0))+ABS(FAC(1)) - IF (D0.NE.0) THEN - MPHD(MPH_BDW_D,2)=MPHD(MPH_BDW_D,0)+ - 1 MPHD(MPH_BDW_D,1) - MPHD(MPH_FRQ_D,2)=(MPHD(MPH_FRQ_D,0)*ABS(FAC(0))+ - 1 MPHD(MPH_FRQ_D,1)*ABS(FAC(1)))/D0 - MPHD(MPH_FRQO_D,2)=(MPHD(MPH_FRQO_D,0)*ABS(FAC(0))+ - 1 MPHD(MPH_FRQO_D,1)*ABS(FAC(1)))/D0 - MPHE(MPH_VEL_E,2)=(MPHE(MPH_VEL_E,0)*ABS(FAC(0))+ - 1 MPHE(MPH_VEL_E,1)*ABS(FAC(1)))/D0 - MPHE(MPH_VELR_E,2)=(MPHE(MPH_VELR_E,0)*ABS(FAC(0))+ - 1 MPHE(MPH_VELR_E,1)*ABS(FAC(1)))/D0 - MPHD(MPH_FRQC_D,2)=(MPHD(MPH_FRQC_D,0)*ABS(FAC(0))+ - 1 MPHD(MPH_FRQC_D,1)*ABS(FAC(1)))/D0 - MPHD(MPH_FRQ0_D,2)=(MPHD(MPH_FRQ0_D,0)*ABS(FAC(0))+ - 1 MPHD(MPH_FRQ0_D,1)*ABS(FAC(1)))/D0 - MPHD(MPH_FRQV_D,2)=(MPHD(MPH_FRQV_D,0)*ABS(FAC(0))+ - 1 MPHD(MPH_FRQV_D,1)*ABS(FAC(1)))/D0 - END IF - END IF - END IF - D0=MPHD(MPH_SUM_D,1)*(FAC(0)**2)+ - 1 MPHD(MPH_SUM_D,0)*(FAC(1)**2) - IF (TYP.LT.FID_EXT) THEN !NORM. SUM - IF (D0.GT.1E-6) THEN - MPHD(MPH_SUM_D,2)=MPHD(MPH_SUM_D,0)*MPHD(MPH_SUM_D,1)/ - 1 NORM/NORM/D0 - ELSE - MPHD(MPH_SUM_D,2)=MPHD(MPH_SUM_D,0) - END IF - ELSE IF (TYP.LT.FID_BEA) THEN - MPHD(MPH_SUM_D,2)=MPHD(MPH_SUM_D,0) - ELSE IF (TYP.EQ.FID_FAC) THEN - IF (POLT(0,0).NE.0) THEN - MPHD(MPH_SUM_D,2)=MPHD(MPH_SUM_D,0)/(POLT(0,0)**2) - ELSE - MPHD(MPH_SUM_D,2)=MPHD(MPH_SUM_D,0) - END IF - ELSE - MPHD(MPH_SUM_D,2)=MPHD(MPH_SUM_D,0) - END IF - IF (TYP.EQ.FID_POL) THEN !POL. TYPE - CALL WNGMFS(MPH_POL_N,'PI',MPH(MPH_POL_1,2)) - ELSE IF (TYP.EQ.FID_ANG) THEN - CALL WNGMFS(MPH_POL_N,'PA',MPH(MPH_POL_1,2)) - ELSE IF (TYP.EQ.FID_CSU.OR.TYP.EQ.FID_RSU) THEN - IF (DO_IM) THEN - CALL WNGMFS(MPH_POL_N,CPOLIM,MPH(MPH_POL_1,2)) - ELSE - CALL WNGMFS(MPH_POL_N,CPOLRE,MPH(MPH_POL_1,2)) - END IF - END IF - IF (TYP.EQ.FID_ADD) THEN !COMMENT - CALL WNCTXS(TXT,'!E9.2\*!AS\+!E9.2\*!AS', - 1 POLT(0,0),WNTTSG(SNAM(0,0),0), - 1 POLT(1,0),WNTTSG(SNAM(0,1),0)) - ELSE IF (TYP.EQ.FID_AVE) THEN - CALL WNCTXS(TXT,'Norm. !E9.2\*!AS\+!E9.2\*!AS', - 1 POLT(0,0),WNTTSG(SNAM(0,0),0), - 1 POLT(1,0),WNTTSG(SNAM(0,1),0)) - ELSE IF (TYP.EQ.FID_POL) THEN - CALL WNCTXS(TXT,'Pol. I !AS\ and !AS', - 1 WNTTSG(SNAM(0,0),0), - 1 WNTTSG(SNAM(0,1),0)) - ELSE IF (TYP.EQ.FID_ANG) THEN - CALL WNCTXS(TXT,'Pol. angle !AS\ and !AS', - 1 WNTTSG(SNAM(0,0),0), - 1 WNTTSG(SNAM(0,1),0)) - ELSE IF (TYP.EQ.FID_SUM) THEN - CALL WNCTXS(TXT,'Sum of maps') - ELSE IF (TYP.EQ.FID_NSU) THEN - CALL WNCTXS(TXT,'Nsum of maps') - ELSE IF (TYP.EQ.FID_BSU) THEN - CALL WNCTXS(TXT,'Bsum of maps') - ELSE IF (TYP.EQ.FID_BNS) THEN - CALL WNCTXS(TXT,'BNsum of maps') - ELSE IF (TYP.EQ.FID_FSU) THEN - CALL WNCTXS(TXT,'Fsum of maps') - ELSE IF (TYP.EQ.FID_CSU) THEN - IF (DO_IM) THEN - CALL WNCTXS(TXT,'Csum (Im)') - ELSE - CALL WNCTXS(TXT,'Csum (Re)') - END IF - ELSE IF (TYP.EQ.FID_RSU) THEN - IF (DO_IM) THEN - CALL WNCTXS(TXT,'Rsum (!AS) RM=!E9.3', - 1 CPOLIM,RMVAL(IRM)) - ELSE - CALL WNCTXS(TXT,'Rsum (!AS) RM=!E9.3', - 1 CPOLRE,RMVAL(IRM)) - END IF - ELSE IF (TYP.EQ.FID_NSS) THEN - CALL WNCTXS(TXT,'NSsum of maps') - ELSE IF (TYP.EQ.FID_EXT) THEN - CALL WNCTXS(TXT,'Extract from !AS', - 1 WNTTSG(SNAM(0,0),0)) - ELSE IF (TYP.EQ.FID_COP) THEN -C CALL WNCTXS(TXT,'Copy from !AS', -C 1 WNTTSG(SNAM(0,0),0)) - CALL WNGMTS(MPH_UCM_N,MPH(MPH_UCM_1,0),TXT) - ELSE IF (TYP.EQ.FID_BEA) THEN - MPHI(MPH_CD_I+7,2)=MPHI(MPH_CD_I+7,2)+1 - CALL WNGMTS(MPH_UCM_N,MPH(MPH_UCM_1,0),TXT) - ELSE IF (TYP.EQ.FID_DEB) THEN - MPHI(MPH_CD_I+7,2)=MPHI(MPH_CD_I+7,2)-1 - CALL WNGMTS(MPH_UCM_N,MPH(MPH_UCM_1,0),TXT) - ELSE IF (TYP.EQ.FID_FAC) THEN - CALL WNCTXS(TXT,'!E9.2\*!AS', - 1 POLT(0,0),WNTTSG(SNAM(0,0),0)) - END IF - CALL WNGMFS(MPH_UCM_N,TXT,MPH(MPH_UCM_1,2)) !SET COMMENT - MPHJ(MPH_MDP_J,2)=OUTP !DATA POINTER -C -C GET BEAM FACTOR -C - IF (.NOT.NMOBMF(MPHJ(MPH_INST_J,2), - 1 MPHD(MPH_FRQO_D,2))) THEN !RANGE - CALL WNCTXT(F_TP,'Cannot get beam information for map !AS', - 1 WNTTSG(SNAM(0,0),1)) - CALL WNGEX !STOP - END IF -C -C READ DATA -C - DO I=BORDER(0,0),BORDER(1,0) !ALL LINES -C -C SET 1 -C - IF (.NOT.WNFRD(FCA(0),LB_E*MPHJ(MPH_NRA_J,0),DAT(0,0), - 1 MPHJ(MPH_MDP_J,0)+ - 1 LB_E*I*MPHJ(MPH_NRA_J,0))) THEN !READ LINE - CALL WNCTXT(F_TP,'Error reading Map !AS', - 1 WNTTSG(SNAM(0,0),1)) - CALL WNGEX !STOP - END IF -C -C SET 2 -C - IF (TYP.LT.FID_EXT) THEN !NEED SET 2 - IF (.NOT.WNFRD(FCA(1),LB_E*MPHJ(MPH_NRA_J,1),DAT(0,1), - 1 MPHJ(MPH_MDP_J,1)+ - 1 LB_E*I*MPHJ(MPH_NRA_J,1))) THEN !READ LINE - CALL WNCTXT(F_TP,'Error reading Map !AS', - 1 WNTTSG(SNAM(0,0),1)) - CALL WNGEX !STOP - END IF - END IF -C -C MAKE OUTPUT -C - DO I1=BORDER(0,1),BORDER(1,1) !ALL POINTS - IF (TYP.LT.FID_POL) THEN !ADD/AVERAGE - ODAT(I1)=FAC(0)*DAT(I1,0)+FAC(1)*DAT(I1,1) - ELSE IF (TYP.LT.FID_SUM) THEN !POL - R0=SQRT(ABS(DAT(I1,0)**2+DAT(I1,1)**2)) - IF (R0.GE.POLT(0,0)) THEN !CAN DO - IF (TYP.EQ.FID_POL) THEN !POL. AMPL - ODAT(I1)=R0 - ELSE !POL. ANGLE - ODAT(I1)=0.5*ATAN2(DAT(I1,0),DAT(I1,1)) - END IF - ELSE - ODAT(I1)=0 - END IF - ELSE IF (TYP.LT.FID_EXT) THEN !SUM - ODAT(I1)=FAC(0)*DAT(I1,0)+FAC(1)*DAT(I1,1) - ELSE IF (TYP.EQ.FID_EXT) THEN !EXTRACT - ODAT(I1-BORDER(0,1))=DAT(I1,0) - ELSE IF (TYP.EQ.FID_COP) THEN !COPY - ODAT(I1)=DAT(I1,0) - ELSE IF (TYP.LT.FID_FAC) THEN !BEAM/DEBEAM - CALL WNMDLM(MPHD(MPH_RA_D,0),MPHD(MPH_DEC_D,0), - 1 ((I1-MPHJ(MPH_NRA_J,0)/2)*MPHD(MPH_SRA_D,0)+ - 1 MPHD(MPH_SHR_D,0))*DPI2, - 1 ((I-MPHJ(MPH_NDEC_J,0)/2)*MPHD(MPH_SDEC_D,0)+ - 1 MPHD(MPH_SHD_D,0))*DPI2, - 1 D0,D1) !RA,DEC POINT - CALL WNMCRD(MPHD(MPH_RAO_D,0),MPHD(MPH_DECO_D,0), - 1 R0,R1, - 1 D0,D1) !L,M BEAM POINT - D0=NMOBMV(MPHD(MPH_FRQO_D,0),R0,R1, - 1 BEMLIM,TYP.NE.FID_BEA) !VALUE - ODAT(I1)=D0*DAT(I1,0) !DO - ELSE IF (TYP.EQ.FID_FAC) THEN !FACTOR - ODAT(I1)=FAC(0)*DAT(I1,0) - ELSE - ODAT(I1)=DAT(I1,0) !UNKNOWN - END IF - END DO !END POINTS -C -C STATISTICS -C - R0=-1E36 !MAX - R1=1E36 !MIN - CALL WNMFMX(LSIZE,ODAT,NORM,R0,I3,R1,I4) !NORM. AND FIND MAX/MIN - IF (R0.GT.MPHE(MPH_MAX_E,2)) THEN !NEW MAX - MPHE(MPH_MAX_E,2)=R0 - MPHJ(MPH_MXR_J,2)=I3-LSIZE/2 - MPHJ(MPH_MXD_J,2)=I-(BORDER(1,0)+BORDER(0,0)+1)/2 - END IF - IF (R1.LT.MPHE(MPH_MIN_E,2)) THEN !NEW MIN - MPHE(MPH_MIN_E,2)=R1 - MPHJ(MPH_MNR_J,2)=I4-LSIZE/2 - MPHJ(MPH_MND_J,2)=I-(BORDER(1,0)+BORDER(0,0)+1)/2 - END IF - CALL WNMHS1(HIST,LSIZE,ODAT) !MAKE HISTO -C -C OUTPUT LINE -C - IF (.NOT.WNFWR(FCA(2),LB_E*LSIZE,ODAT,OUTP)) THEN - 20 CONTINUE - CALL WNCTXT(F_TP,'Error writing output map') - CALL WNGEX !STOP - END IF - OUTP=OUTP+LB_E*LSIZE !NEXT OUTPUT POINTER -C -C NEXT LINE -C - END DO -C -C WRITE MAP HEADER -C - IF (TYP.LT.FID_SUM .OR. TYP.GE.FID_EXT) THEN !NOT SUM - CALL WNMHS3(HIST,1,F_P) !SHOW HISTOGRAM - END IF - IF (TYP.GE.FID_EXT .AND. TYP.LT.FID_BEA) THEN !NO NEW NOISE SET - CALL WNMHS4(HIST,R0,F_P) !SHOW NOISE - ELSE - CALL WNMHS4(HIST,MPHE(MPH_NOS_E,2),F_P) !SET NOISE - END IF - IF (LINK) THEN !NEW HEADER - MPHP(2)=WNFEOF(FCA(2)) !WHERE TO WRITE - CALL WNDSTI(FCA(0),SNAM(0,0)) !MAKE AN INDEX IF NECESSARY - END IF - IF (FCA(2).NE.FCA(0)) THEN !JSS NO LONGER THERE - MPHJ(MPH_JOBP_J,2)=0 !SO CLEAR IT - MPHJ(MPH_JOBL_J,2)=0 - END IF - IF (.NOT.WNFWR(FCA(2),MPHHDL,MPH(0,2),MPHP(2))) GOTO 20 !WRITE HEADER - IF (LINK.AND.LFIRST) THEN !MAKE NEW JOB - CALL WNCTXT(F_TP,'Creating new group') - IF (.NOT.WNDLNG(GFH_LINKG_1,0,SGH_GROUPN_1, - 1 FCA(2),SGPH(0),SGNR(0))) THEN - 30 CONTINUE - CALL WNCTXT(F_TP,'Error creating sub-group') - CALL WNGEX !STOP - END IF - LFIRST=.FALSE. - END IF - IF (LINK) THEN !RE-LINK - I=1 !Same Field - IF (.NOT.WNDLNF(SGPH(I-1)+SGH_LINKG_1,SNAM(I,0), - 1 SGH_GROUPN_1,FCA(2),SGPH(I),SGNR(I))) GOTO 30 - I=2 !For sum: channel 0 - IF (TYP.GE.FID_SUM.AND.TYP.LT.FID_EXT) THEN - IF (.NOT.WNDLNF(SGPH(I-1)+SGH_LINKG_1,0, - 1 SGH_GROUPN_1,FCA(2),SGPH(I),SGNR(I))) GOTO 30 - ELSE !Else: same channel - IF (.NOT.WNDLNF(SGPH(I-1)+SGH_LINKG_1,SNAM(I,0), - 1 SGH_GROUPN_1,FCA(2),SGPH(I),SGNR(I))) GOTO 30 - END IF - I=3 !For Pol/Ang: pol 0 - IF (TYP.EQ.FID_POL .OR. TYP.EQ.FID_ANG) THEN - IF (.NOT.WNDLNG(SGPH(I-1)+SGH_LINKG_1,0,SGH_GROUPN_1, - 1 FCA(2),SGPH(I),SGNR(I))) GOTO 30 - ELSE IF (TYP.EQ.FID_CSU .OR. TYP.EQ.FID_RSU) THEN - IF (DO_IM) THEN !Imaginary output map - IF (.NOT.WNDLNF(SGPH(I-1)+SGH_LINKG_1,POLIM, - 1 SGH_GROUPN_1,FCA(2),SGPH(I),SGNR(I))) GOTO 30 - ELSE !Real output map - IF (.NOT.WNDLNF(SGPH(I-1)+SGH_LINKG_1,POLRE, - 1 SGH_GROUPN_1,FCA(2),SGPH(I),SGNR(I))) GOTO 30 - END IF - ELSE !Else same pol - IF (.NOT.WNDLNF(SGPH(I-1)+SGH_LINKG_1,SNAM(I,0), - 1 SGH_GROUPN_1,FCA(2),SGPH(I),SGNR(I))) GOTO 30 - END IF - I=4 !Same Type - IF (.NOT.WNDLNF(SGPH(I-1)+SGH_LINKG_1,SNAM(I,0),SGH_GROUPN_1, - 1 FCA(2),SGPH(I),SGNR(I))) GOTO 30 - I=5 !Same Map - IF (.NOT.WNDLNK(GFH_LINK_1,MPHP(2),MPH_SETN_1, - 1 FCA(2))) GOTO 30 - IF (.NOT.WNDLNG(SGPH(I-1)+SGH_LINKG_1,MPHP(2),SGH_GROUPN_1, - 1 FCA(2),SGPH(I),SGNR(I))) GOTO 30 - IF (.NOT.WNFRD(FCA(2),MPHHDL,MPH(0,2),MPHP(2))) GOTO 30 !HEADER - END IF - SGNR(6)=-1 !END NAME - CS1=WNTTSG(SNAM(0,0),0) !Input set 1 - CS2=WNTTSG(SNAM(0,1),0) !Input set 2 - IF (TYP.LT.FID_EXT) THEN - CALL WNCTXT(F_T,'!AS, !AS -> !AS', - 1 CS1,CS2,WNTTSG(SGNR,0)) - ELSE - CALL WNCTXT(F_T,'!AS -> !AS',CS1,WNTTSG(SGNR,0)) - END IF - CALL WNGMV(8*LB_J,SGNR(0),SNAM(0,2)) -C - IF (TYP.LT.FID_SUM .OR. TYP.GE.FID_EXT) THEN !NOT SUM - CALL WNCTXT(F_P,'!^') - CALL NMAPMH(F_P,MPH(0,2),SGNR,NODOUT) !PRINT HEADER - END IF -C -C NEXT SET -C - 10 CONTINUE - END DO -C -C SHOW HISTO -C - IF (TYP.GE.FID_SUM .AND. TYP.LT.FID_EXT .AND. NADD.GT.0) THEN - CALL WNMHS3(HIST,1,F_P) !SHOW HISTOGRAM - CALL WNCTXT(F_P,'!^') - CALL NMAPMH(F_P,MPH(0,2),SGNR,NODOUT) !PRINT HEADER - END IF -C -C MAKE IMAGINARY PART IF NEEDED (quick and dirty loop) -C - IF (TYP.EQ.FID_CSU.OR.TYP.EQ.FID_RSU) THEN - IF (.NOT.DO_IM) THEN - DO_IM=.TRUE. ! IMAGINARY PART NOW - CALL WNMHS9(HIST) ! CLEAR HISTO - GOTO 100 ! OFF AND GO - ELSE IF (TYP.EQ.FID_RSU) THEN !LOOP OVER ROT.MEASURES - IRM=IRM+1 - IF (IRM.LT.NLAB) THEN ! MORE VALUES LEFT? - DO_IM=.FALSE. ! REAL PART FIRST - LFIRST=.TRUE. ! MAKE NEW GROUP - CALL WNMHS9(HIST) ! CLEAR HISTO - GOTO 100 ! OFF AND GO - END IF - END IF - END IF -C -C READY -C - 900 CONTINUE - CALL WNMHS9(HIST) !CLEAR HISTO - CALL WNFCL(FCA(0)) !CLOSE FILES - CALL WNFCL(FCA(1)) -C - RETURN -C -C - END diff --git a/src/nmap/nmafld.for b/src/nmap/nmafld.for deleted file mode 100644 index 0aed014026cc706a820cba87453321201804d72a..0000000000000000000000000000000000000000 --- a/src/nmap/nmafld.for +++ /dev/null @@ -1,296 +0,0 @@ -C+ NMAFLD.FOR -C WNB 930929 -C -C Revisions: -C JPH 950125 Report file name for all open failures -C AXC 010709 Linux port - HOLO string -C - SUBROUTINE NMAFLD(TYP) -C -C Load/unload maps -C -C Result: -C -C CALL NMAFLD ( TYP_J:I) Load foreign maps: -C TYP=RHO Holog loading -C TYP=WMP Standard WMP loading -C TYP=UNL Standard unloading -C -C -C PIN references: -C -C FILENAME -C -C Include files: -C - INCLUDE 'WNG_DEF' - INCLUDE 'GFH_O_DEF' !FILE HEADER - INCLUDE 'SGH_O_DEF' !SUB-GROUP HEADER - INCLUDE 'MPH_O_DEF' !MAP HEADER - INCLUDE 'SMP_O_DEF' !R-SERIES MAP FORMAT - INCLUDE 'SMP_T_DEF' !R-SERIES MAP TRANSLATION - INCLUDE 'NMA_DEF' -C -C Parameters: -C -C -C Arguments: -C - INTEGER TYP !TYPE OF OPERATION -C -C Function references: -C - LOGICAL WNFOP !OPEN FILE - LOGICAL WNFWR !WRITE DISK - LOGICAL WNFRD !READ DISK - INTEGER WNFEOF !FILE POINTER - LOGICAL WNDLNF,WNDLNG,WNDLNK !LINK MAPS - LOGICAL WNDPAR !GET USER DATA - CHARACTER*32 WNTTSG !MAP NAME - LOGICAL NMASTG !GET MAP -C -C Data declarations: -C - INTEGER FCA(0:1) !FILE AREAS - LOGICAL FIRST !FIRST NEW - CHARACTER*32 TXT !TEXT DATA - INTEGER SNAM(0:7) !SET NAME - INTEGER MPHP !MAP HEADER POINTER - BYTE MPH(0:MPH__L-1) !MAP HEADER - INTEGER*2 MPHI(0:MPH__L/LB_I-1) - INTEGER MPHJ(0:MPH__L/LB_J-1) - REAL MPHE(0:MPH__L/LB_E-1) - DOUBLE PRECISION MPHD(0:MPH__L/LB_D-1) - EQUIVALENCE (MPH,MPHI,MPHJ,MPHE,MPHD) - BYTE SMP(0:SMP__L-1) !RMAP HEADER - INTEGER*2 SMPI(0:SMP__L/LB_I-1) - INTEGER SMPJ(0:SMP__L/LB_J-1) - REAL SMPE(0:SMP__L/LB_E-1) - DOUBLE PRECISION SMPD(0:SMP__L/LB_D-1) - EQUIVALENCE (SMP,SMPI,SMPJ,SMPE,SMPD) - REAL DAT(0:8191) !MAP LINE - INTEGER*2 PLC(0:1,0:7) !POL. CODES - DATA PLC/'XX',0,'XY',1,'YX',2,'YY',3, - 1 'I ',0,'Q ',2,'U ',2,'V ',3/ - INTEGER TPC(0:1,0:7) !TYPE CODES - DATA TPC/'MAP ',0,'AP ',1,'COVE',2,'REAL',3, - 1 'IMAG',4,'AMPL',5,'PHAS',6,'HOLO',7/ - INTEGER TIDAT(4) !DATA TRANSLATION - DATA TIDAT /4,0,0,1/ -C- -C -C INIT -C - IF (TYP.EQ.FID_UNL) THEN !UNLOAD - IF (.NOT.WNFOP(FCA(1),FILIN(1),'R')) THEN - CALL WNCTXT(F_TP,'1 Cannot open input file !AS', FILIN(1)) - GOTO 800 !READY - END IF - ELSE !LOAD - IF (.NOT.WNFOP(FCA(1),FILIN(2),'U')) THEN - CALL WNCTXT(F_TP,'1 Cannot open output file !AS', FILIN(2)) - GOTO 800 !READY - END IF - IF (.NOT.WNDLNG(GFH_LINKG_1,0,SGH_GROUPN_1,FCA(1), - 1 SGPH(0),SGNR(0))) THEN !CREATE JOB LEVEL - 30 CONTINUE - CALL WNCTXT(F_TP,'Error creating sub-group') - CALL WNGEX !STOP - END IF - END IF -C -C GET FILE -C - 10 CONTINUE - IF (TYP.EQ.FID_UNL) THEN !UNLOAD - IF (.NOT.WNDPAR('FILENAME',FILIN(2),LEN(FILIN(2)),J0, - 1 '""')) THEN - IF (E_C.EQ.DWC_ENDOFLOOP) GOTO 810 !READY - GOTO 10 !RETRY - END IF - ELSE !LOAD - IF (.NOT.WNDPAR('FILENAME',FILIN(1),LEN(FILIN(1)),J0, - 1 '""')) THEN - IF (E_C.EQ.DWC_ENDOFLOOP) GOTO 810 !READY - GOTO 10 !RETRY - END IF - IF (.NOT.WNDLNG(SGPH(0)+SGH_LINKG_1,0,SGH_GROUPN_1, - 1 FCA(1),SGPH(1),SGNR(1))) GOTO 30 !CREATE FIELD - END IF - IF (J0.EQ.0) GOTO 810 !READY - IF (J0.LT.0) GOTO 10 !RETRY - IF (TYP.EQ.FID_UNL) THEN !UNLOAD - IF (.NOT.WNFOP(FCA(0),FILIN(2),'W')) THEN - CALL WNCTXT(F_TP,'2 Cannot open output file !AS', - 1 FILIN(2)) - GOTO 810 - END IF - ELSE !LOAD - IF (.NOT.WNFOP(FCA(0),FILIN(1),'R')) THEN - CALL WNCTXT(F_TP,'2 Cannot open input file !AS', - 1 FILIN(1)) - GOTO 810 - END IF - END IF -C -C UNLOAD -C - IF (TYP.EQ.FID_UNL) THEN - J0=0 !OUTPUT POINTER - DO WHILE (NMASTG(FCA(1),SETS(0,0,1),MPH,MPHP,SNAM)) !GET A SET - IF (.NOT.WNFWR(FCA(0),MPH__L,MPH,J0)) THEN !WRITE HEADER - 20 CONTINUE - CALL WNCTXT(F_TP,'Error writing !AS',FILIN(2)) - GOTO 820 - END IF - J0=J0+MPH__L !OUTPUT POINTER - J1=MPHJ(MPH_MDP_J) !INPUT POINTER - DO I=0,MPHJ(MPH_NDEC_J)-1 !ALL LINES - IF (.NOT.WNFRD(FCA(1),MPHJ(MPH_NRA_J)*LB_E,DAT,J1)) THEN - CALL WNCTXT(F_TP,'Error reading set !AS', - 1 WNTTSG(SNAM,0)) - GOTO 820 - END IF - J1=J1+MPHJ(MPH_NRA_J)*LB_E !INPUT POINTER - IF (.NOT.WNFWR(FCA(0),MPHJ(MPH_NRA_J)*LB_E,DAT,J0)) - 1 GOTO 20 !WRITE DATA - J0=J0+MPHJ(MPH_NRA_J)*LB_E !OUTPUT POINTER - END DO - CALL WNCTXT(F_TP,'Map !AS(!AD) unloaded to !AS', - 1 WNTTSG(SNAM,0),MPH(MPH_FNM_1), - 1 MPH_FNM_N,FILIN(2)) - END DO - GOTO 820 !READY -C -C LOAD -C - ELSE - J1=0 !INPUT POINTER - 41 CONTINUE - IF (TYP.EQ.FID_WMP) THEN - IF (.NOT.WNFRD(FCA(0),MPH__L,MPH,J1)) GOTO 40 !READ HEADER - J1=J1+MPH__L !INPUT POINTER - ELSE !HOLOG - IF (.NOT.WNFRD(FCA(0),SMP__L,SMP,J1)) GOTO 40 !READ HEADER - J1=J1+SMP__L !INPUT POINTER - CALL WNTTIL(SMP__L,SMP,SMP_T) !TRANSLATE - CALL WNGMVZ(MPH__L,MPH) !MAKE NEW HEADER - CALL WNGMV(MPH_FNM_N,SMP(SMP_FNM_1),MPH(MPH_FNM_1)) - MPHE(MPH_EPO_E)=SMPE(SMP_EPO_E) - MPHD(MPH_RA_D)=SMPD(SMP_RA_D) - MPHD(MPH_DEC_D)=SMPD(SMP_DEC_D) - MPHD(MPH_FRQ_D)=SMPD(SMP_FRQ_D) - MPHD(MPH_BDW_D)=SMPD(SMP_BDW_D) - MPHD(MPH_RAO_D)=SMPD(SMP_RAO_D) - MPHD(MPH_DECO_D)=SMPD(SMP_DCO_D) - MPHD(MPH_FRQO_D)=SMPD(SMP_FRO_D) - MPHI(MPH_ODY_I)=SMPI(SMP_ODY_I) - MPHI(MPH_OYR_I)=SMPI(SMP_OYR_I) - MPHI(MPH_PCD_I)=SMPI(SMP_PCD_I) - MPHD(MPH_SRA_D)=SMPD(SMP_SRA_D) - MPHD(MPH_SDEC_D)=SMPD(SMP_SDC_D) - MPHD(MPH_SFRQ_D)=SMPD(SMP_SFR_D) - MPHJ(MPH_NRA_J)=SMPI(SMP_NRA_I) - MPHJ(MPH_NDEC_J)=SMPI(SMP_NDC_I) - MPHJ(MPH_NFRQ_J)=SMPI(SMP_NFR_I) - MPHJ(MPH_ZRA_J)=SMPI(SMP_ZRA_I) - MPHJ(MPH_ZDEC_J)=SMPI(SMP_ZDC_I) - MPHJ(MPH_ZFRQ_J)=SMPI(SMP_ZFR_I) - MPHJ(MPH_MXR_J)=SMPI(SMP_MXR_I) - MPHJ(MPH_MXD_J)=SMPI(SMP_MXD_I) - MPHJ(MPH_MXF_J)=SMPI(SMP_MXF_I) - MPHJ(MPH_MNR_J)=SMPI(SMP_MNR_I) - MPHJ(MPH_MND_J)=SMPI(SMP_MND_I) - MPHE(MPH_MAX_E)=SMPE(SMP_MAX_E) - MPHE(MPH_MIN_E)=SMPE(SMP_MIN_E) - MPHD(MPH_SHR_D)=SMPD(SMP_SHR_D) - MPHD(MPH_SHD_D)=SMPD(SMP_SHD_D) - MPHD(MPH_SHF_D)=SMPD(SMP_SHF_D) - MPHD(MPH_SUM_D)=SMPD(SMP_SUM_D) - MPHE(MPH_UNI_E)=SMPE(SMP_UNI_E) - CALL WNGMV(MPH_UCM_N,SMP(SMP_UCM_1),MPH(MPH_UCM_1)) - MPHJ(MPH_NPT_J)=SMPJ(SMP_NPT_J) - MPHJ(MPH_NBL_J)=SMPI(SMP_NBS_I) - MPHJ(MPH_NST_J)=SMPI(SMP_NST_I) - MPH(MPH_TYP_1)=ICHAR('H') - MPH(MPH_TYP_1+1)=ICHAR('O') - MPH(MPH_TYP_1+2)=ICHAR('L') - MPH(MPH_TYP_1+3)=ICHAR('O') - CALL WNGMV(MPH_POL_N,SMP(SMP_POL_1),MPH(MPH_POL_1)) - DO I=0,7 - MPHI(MPH_CD_I+I)=SMPI(SMP_CD_I+I) - END DO - MPHI(MPH_EPT_I)=SMPI(SMP_EPT_I) - MPHE(MPH_OEP_E)=SMPE(SMP_OEP_E) - MPHE(MPH_NOS_E)=SMPE(SMP_NOS_E) - MPHE(MPH_FRA_E)=SMPE(SMP_FRA_E) - MPHE(MPH_FDEC_E)=SMPE(SMP_FDC_E) - MPHE(MPH_FFRQ_E)=SMPE(SMP_FFR_E) - CALL WNGMV(MPH_TEL_N,SMP(SMP_TEL_1),MPH(MPH_TEL_1)) - MPHJ(MPH_FSR_J)=SMPI(SMP_FSR_I) - MPHJ(MPH_FSD_J)=SMPI(SMP_FSD_I) - END IF - MPHI(MPH_LEN_I)=MPH__L !LENGTH - MPHI(MPH_VER_I)=MPH__V !VERSION - MPHI(MPH_DCD_I)=5 !REAL VALUES - J0=WNFEOF(FCA(1)) !OUTPUT POINTER - MPHJ(MPH_MDP_J)=J0+MPH__L !DATA POINTER - IF (.NOT.WNFWR(FCA(1),MPH__L,MPH, - 1 J0)) GOTO 20 !WRITE HEADER - J0=J0+MPH__L - TIDAT(2)=MPHJ(MPH_NRA_J) !LENGTH LINE - DO I=0,MPHJ(MPH_NDEC_J)-1 !ALL LINES - IF (.NOT.WNFRD(FCA(0),MPHJ(MPH_NRA_J)*LB_E,DAT,J1)) THEN - CALL WNCTXT(F_TP,'Error reading !AS', - 1 FILIN(1)) - GOTO 820 - END IF - J1=J1+MPHJ(MPH_NRA_J)*LB_E !INPUT POINTER - IF (TYP.EQ.FID_RHO) THEN !TRANSLATE - CALL WNTTIL(MPHJ(MPH_NRA_J)*LB_E,DAT,TIDAT) !TRANSLATE - END IF - IF (.NOT.WNFWR(FCA(1),MPHJ(MPH_NRA_J)*LB_E,DAT,J0)) - 1 GOTO 20 !WRITE DATA - J0=J0+MPHJ(MPH_NRA_J)*LB_E !OUTPUT POINTER - END DO - IF (.NOT.WNDLNG(SGPH(1)+SGH_LINKG_1,0,SGH_GROUPN_1, - 1 FCA(1),SGPH(2),SGNR(2))) GOTO 30 !CREATE CHANNEL - I1=0 !POL. CODE - DO I=0,7 - IF (MPHI(MPH_POL_1/LB_I).EQ.PLC(0,I)) I1=PLC(1,I) - END DO - IF (.NOT.WNDLNF(SGPH(2)+SGH_LINKG_1,I1,SGH_GROUPN_1, - 1 FCA(1),SGPH(3),SGNR(3))) GOTO 30 !CREATE CHANNEL - I1=0 !TYPE CODE - DO I=0,7 - IF (MPHJ(MPH_TYP_1/LB_J).EQ.TPC(0,I)) I1=TPC(1,I) - END DO - IF (.NOT.WNDLNF(SGPH(3)+SGH_LINKG_1,I1,SGH_GROUPN_1, - 1 FCA(1),SGPH(4),SGNR(4))) GOTO 30 !CREATE CHANNEL - IF (.NOT.WNDLNK(GFH_LINK_1,MPHJ(MPH_MDP_J)-MPH__L, - 1 MPH_SETN_1,FCA(1))) GOTO 30 !LINK MAP - IF (.NOT.WNDLNG(SGPH(4)+SGH_LINKG_1, - 1 MPHJ(MPH_MDP_J)-MPH__L,SGH_GROUPN_1, - 1 FCA(1),SGPH(5),SGNR(5))) GOTO 30 !CREATE CHANNEL - SGNR(6)=-1 - CALL WNCTXT(F_TP,'Map !AS(!AD) loaded from !AS', - 1 WNTTSG(SGNR,0),MPH(MPH_FNM_1), - 1 MPH_FNM_N,FILIN(1)) - IF (TYP.EQ.FID_WMP) GOTO 41 !READ MORE MAPS - 40 CONTINUE - CALL WNFCL(FCA(0)) !CLOSE INPUT FILE - GOTO 10 !NEXT FILE - END IF -C -C READY -C - 820 CONTINUE - CALL WNFCL(FCA(0)) !CLOSE INPUT FILE - 810 CONTINUE - CALL WNFCL(FCA(1)) !CLOSE OUTPUT FILE - 800 CONTINUE -C - RETURN -C -C - END diff --git a/src/nmap/nmafmc.for b/src/nmap/nmafmc.for deleted file mode 100644 index 85891f240584d97a175f7aa6188d32ece33fa3f5..0000000000000000000000000000000000000000 --- a/src/nmap/nmafmc.for +++ /dev/null @@ -1,362 +0,0 @@ -C+ NMAFMC.FOR -C WNB 911031 -C -C Revisions: -C WNB 911115 Change minimum beam factor -C HjV 920520 HP does not allow extended source lines -C WNB 920811 Add possibility to use noise as weight -C WNB 920828 Update for line velocities -C HjV 930311 Change some text -C WNB 930602 Use BEMLIM, check weight limit -C WNB 930826 New beam factors -C WNB 930928 Multiple instruments for beam -C WNB 930930 Use Fiddle codes -C CMV 940506 Increase buffer size for output lines -C CMV 940513 Also increase maximum number of input maps -C - SUBROUTINE NMAFMC(TYP) -C -C Combine mosaic maps -C -C Result: -C -C CALL NMAFMC ( TYP_J:I) Combine mosaic maps. TYP: -C MOS: FTSIZ gives pixel centre -C LMM: CNTDVL gives lm (arcsec) centre -C RAM: CNTDVL gives RADEC (fract) centre -C -C Include files: -C - INCLUDE 'WNG_DEF' - INCLUDE 'GFH_O_DEF' !FILE HEADER - INCLUDE 'SGH_O_DEF' !SUB-GROUP HEADER - INCLUDE 'MPH_O_DEF' !MAP HEADER - INCLUDE 'NMA_DEF' -C -C Parameters: -C - INTEGER MXNMP !MAX. OF INPUT MAPS - PARAMETER (MXNMP=1024) - INTEGER MXBUF !BUFFER SIZE - PARAMETER (MXBUF=16384) -C -C Arguments: -C - INTEGER TYP !TYPE TO DO -C -C Function references: -C - LOGICAL WNFOP !OPEN FILE - INTEGER WNFEOF !FILE LENGTH - LOGICAL WNFWR !WRITE DISK - LOGICAL WNFRD !READ DISK - LOGICAL WNDLNF,WNDLNG,WNDLNK !LINK MAPS - CHARACTER*32 WNTTSG !MAP NAME - LOGICAL NMASTG !GET SET - LOGICAL NMOBMF !GET RANGE FOR BEAM - DOUBLE PRECISION NMOBMV !BEAM VALUES -C -C Data declarations: -C - INTEGER FCA,FCAO !FILE AREAS - INTEGER HIST !MAP HISTOGRAM ADDRESS - INTEGER NIN !# OF INPUT MAPS - CHARACTER*32 TXT !TEXT DATA - REAL WTMAX !MAX. WEIGHT FOUND - INTEGER LM0(0:1,0:MXNMP-1) !OUTPUT CENTRE IN INPUT MAP COORD. - INTEGER OUTP !OUTPUT POINTER - INTEGER SNAM(0:7,0:MXNMP-1) !SET NAME - INTEGER MPHP(-1:MXNMP-1) !MAP HEADER POINTER - BYTE MPH(0:MPHHDL-1,-1:MXNMP-1) !MAP HEADER - INTEGER*2 MPHI(0:MPHHDL/2-1,-1:MXNMP-1) - INTEGER MPHJ(0:MPHHDL/4-1,-1:MXNMP-1) - REAL MPHE(0:MPHHDL/4-1,-1:MXNMP-1) - DOUBLE PRECISION MPHD(0:MPHHDL/8-1,-1:MXNMP-1) - EQUIVALENCE (MPH,MPHI,MPHJ,MPHE,MPHD) - REAL DAT(0:MXBUF-1) !MAP LINE INPUT - REAL ODAT(0:MXBUF-1) !MAP LINE OUTPUT - REAL WDAT(0:MXBUF-1) !MAP LINE WEIGHT - REAL LDAT(0:MXBUF-1) !MAP LINE CHECK WEIGHT -C- -C -C INIT -C - CALL WNMHS8(HIST,1,1E0) !INIT HISTO - IF (.NOT.WNFOP(FCA,FILIN(1),'U')) THEN !OPEN INPUT/OUTPUT - CALL WNCTXT(F_TP,'Cannot open !AS',FILIN(1)) - GOTO 900 - END IF -C -C GET SETS -C - NIN=0 !COUNT SETS - DO WHILE (NIN.LT.MXNMP .AND. - 1 NMASTG(FCA,SETS(0,0,1),MPH(0,NIN), - 1 MPHP(NIN),SNAM(0,NIN))) !GET SETS - IF (ABS(MPHD(MPH_RA_D,0)-MPHD(MPH_RA_D,NIN)).GT.1D-6 .OR. - 1 ABS(MPHD(MPH_DEC_D,0)-MPHD(MPH_DEC_D,NIN)).GT.1D-6) THEN - CALL WNCTXT(F_TP,'Wrong reference coordinates for !AS', - 1 WNTTSG(SNAM(0,NIN),0)) - ELSE IF (ABS(MPHD(MPH_SRA_D,0)-MPHD(MPH_SRA_D,NIN)).GT.1D-9 .OR. - 1 ABS(MPHD(MPH_SDEC_D,0)-MPHD(MPH_SDEC_D,NIN)).GT.1D-9) THEN - CALL WNCTXT(F_TP,'Wrong l,m steps for !AS', - 1 WNTTSG(SNAM(0,NIN),0)) - ELSE IF (ABS(MPHD(MPH_FRQO_D,0)-MPHD(MPH_FRQO_D,NIN)) - 1 .GT.10) THEN - CALL WNCTXT(F_TP, - 1 'Cannot combine different frequencies for !AS', - 1 WNTTSG(SNAM(0,NIN),0)) - ELSE - NIN=NIN+1 !COUNT MAP - END IF - END DO - IF (NIN.LE.0) THEN - CALL WNCTXT(F_TP,'No input data specified') - GOTO 900 - ELSE - CALL WNCTXT(F_TP,'Total of !UJ valid input maps',NIN) - END IF -C -C GET OUTPUT DATA -C - IF (FILIN(2).NE.'*') THEN !OTHER OUTPUT - FCAO=0 !FORCE NEW - IF (.NOT.WNFOP(FCAO,FILIN(2),'U')) THEN - CALL WNCTXT(F_TP,'Cannot open !AS',FILIN(2)) - GOTO 900 - END IF - ELSE - FCAO=FCA !OUTPUT=INPUT - END IF - OUTP=WNFEOF(FCAO) !NEW MAP - NODOUT=NODIN(1) !OUTPUT NAME - CALL WNGMV(MPHHDL,MPH(0,0),MPH(0,-1)) !NEW HEADER - CALL WNGMV(8*LB_J,SNAM(0,0),SGNR(0)) !SAVE NAME -C -C PREPARE OUTPUT HEADER -C - MPHI(MPH_PCD_I,-1)=1 !INDICATE FIDDLE - IF (TYP.EQ.FID_LMM) THEN !LM CENTRE - FTSIZ(0)=NINT(CNTDVL(0)/3600./360./MPHD(MPH_SRA_D,-1)) - FTSIZ(1)=NINT(CNTDVL(1)/3600./360./MPHD(MPH_SDEC_D,-1)) - ELSE IF (TYP.EQ.FID_RAM) THEN !RADEC CENTRE - CALL WNMDRD(MPHD(MPH_RA_D,-1),MPHD(MPH_DEC_D,-1), - 1 D0,D1, - 1 CNTDVL(0),CNTDVL(1)) !L,M CENTRE - FTSIZ(0)=NINT(D0/DPI2/MPHD(MPH_SRA_D,-1)) - FTSIZ(1)=NINT(D1/DPI2/MPHD(MPH_SDEC_D,-1)) - END IF - MPHD(MPH_SHR_D,-1)=FTSIZ(0)*MPHD(MPH_SRA_D,-1) !CENTRE L,M - MPHD(MPH_SHD_D,-1)=FTSIZ(1)*MPHD(MPH_SDEC_D,-1) - MPHJ(MPH_NRA_J,-1)=OUTSIZ(0) !LENGTH LINE - MPHJ(MPH_NDEC_J,-1)=OUTSIZ(1) !# OF LINES - MPHJ(MPH_ZRA_J,-1)=OUTSIZ(0)/2 !CENTRE POINT - MPHJ(MPH_ZDEC_J,-1)=OUTSIZ(1)/2 !CENTRE LINE - MPHJ(MPH_MXR_J,-1)=0 !POS. MAX/MIN - MPHJ(MPH_MXD_J,-1)=0 - MPHJ(MPH_MNR_J,-1)=0 - MPHJ(MPH_MND_J,-1)=0 - MPHE(MPH_MAX_E,-1)=-1E36 !MAX. - MPHE(MPH_MIN_E,-1)=1E36 !MIN. - MPHJ(MPH_NPT_J,-1)=0 !# OF POINTS - MPHJ(MPH_NBL_J,-1)=0 !# OF BASEL. - MPHJ(MPH_NST_J,-1)=0 !# OF SETS - MPHD(MPH_SUM_D,-1)=0 - MPHD(MPH_BDW_D,-1)=0 - MPHD(MPH_FRQ_D,-1)=0 - CALL WNMDLM(MPHD(MPH_RA_D,-1),MPHD(MPH_DEC_D,-1), - 1 DPI2*MPHD(MPH_SHR_D,-1),DPI2*MPHD(MPH_SHD_D,-1), - 1 MPHD(MPH_RAO_D,-1),MPHD(MPH_DECO_D,-1)) !RA, DEC CENTRE OUTPUT - MPHD(MPH_FRQO_D,-1)=0 - DO I=0,NIN-1 - MPHJ(MPH_NPT_J,-1)=MPHJ(MPH_NPT_J,I)+MPHJ(MPH_NPT_J,-1) !# OF POINTS - MPHJ(MPH_NBL_J,-1)=MPHJ(MPH_NBL_J,I)+MPHJ(MPH_NBL_J,-1) !# OF BASEL. - MPHJ(MPH_NST_J,-1)=MPHJ(MPH_NST_J,I)+MPHJ(MPH_NST_J,-1) !# OF SETS - MPHD(MPH_SUM_D,-1)=MPHD(MPH_SUM_D,I)+MPHD(MPH_SUM_D,-1) !NORM. - MPHD(MPH_BDW_D,-1)=MPHD(MPH_BDW_D,I)+MPHD(MPH_BDW_D,-1) !BANDW. - MPHD(MPH_FRQ_D,-1)=MPHD(MPH_FRQ_D,I)*MPHD(MPH_BDW_D,I)+ - 1 MPHD(MPH_FRQ_D,-1) !FREQ. - MPHD(MPH_FRQO_D,-1)=MPHD(MPH_FRQO_D,I)*MPHD(MPH_BDW_D,I)+ - 1 MPHD(MPH_FRQO_D,-1) !FREQ. - MPHE(MPH_VEL_E,-1)=MPHE(MPH_VEL_E,I)*MPHD(MPH_BDW_D,I)+ - 1 MPHE(MPH_VEL_E,-1) !VEL. - MPHE(MPH_VELR_E,-1)=MPHE(MPH_VELR_E,I)*MPHD(MPH_BDW_D,I)+ - 1 MPHE(MPH_VELR_E,-1) !REF. VEL. - MPHD(MPH_FRQC_D,-1)=MPHD(MPH_FRQC_D,I)*MPHD(MPH_BDW_D,I)+ - 1 MPHD(MPH_FRQC_D,-1) !FREQ. - MPHD(MPH_FRQ0_D,-1)=MPHD(MPH_FRQ0_D,I)*MPHD(MPH_BDW_D,I)+ - 1 MPHD(MPH_FRQ0_D,-1) !FREQ. - MPHD(MPH_FRQV_D,-1)=MPHD(MPH_FRQV_D,I)*MPHD(MPH_BDW_D,I)+ - 1 MPHD(MPH_FRQV_D,-1) !FREQ. - END DO - MPHD(MPH_FRQ_D,-1)=MPHD(MPH_FRQ_D,-1)/MPHD(MPH_BDW_D,-1) - MPHD(MPH_FRQO_D,-1)=MPHD(MPH_FRQO_D,-1)/MPHD(MPH_BDW_D,-1) - MPHE(MPH_VEL_E,-1)=MPHE(MPH_VEL_E,-1)/MPHD(MPH_BDW_D,-1) - MPHE(MPH_VELR_E,-1)=MPHE(MPH_VELR_E,-1)/MPHD(MPH_BDW_D,-1) - MPHD(MPH_FRQC_D,-1)=MPHD(MPH_FRQC_D,-1)/MPHD(MPH_BDW_D,-1) - MPHD(MPH_FRQ0_D,-1)=MPHD(MPH_FRQ0_D,-1)/MPHD(MPH_BDW_D,-1) - MPHD(MPH_FRQV_D,-1)=MPHD(MPH_FRQV_D,-1)/MPHD(MPH_BDW_D,-1) - MPHE(MPH_FRA_E,-1)=(OUTSIZ(0)-1)*MPHD(MPH_SRA_D,-1) !FIELD SIZE RA - MPHE(MPH_FDEC_E,-1)=(OUTSIZ(1)-1)*MPHD(MPH_SDEC_D,-1) !FIELD SIZE DEC - MPHE(MPH_FFRQ_E,-1)=0 !FIELD SIZE FREQ - MPHI(MPH_CD_I+7,-1)=1 !SET DE-BEAMED - CALL WNCTXS(TXT,'Mosaic sum') - CALL WNGMFS(MPH_UCM_N,TXT,MPH(MPH_UCM_1,-1)) !SET COMMENT - MPHJ(MPH_MDP_J,-1)=OUTP !DATA POINTER -C -C GET BEAM FACTOR -C - IF (.NOT.NMOBMF(MPHJ(MPH_INST_J,-1),MPHD(MPH_FRQO_D,-1))) THEN - CALL WNCTXT(F_TP,'Cannot obtain (de-)beam information '// - 1 'for mosaic') - CALL WNGEX !STOP - END IF -C -C MAP POSITIONS -C - CALL WNMDLM(MPHD(MPH_RA_D,-1),MPHD(MPH_DEC_D,-1), - 1 DPI2*MPHD(MPH_SHR_D,-1),DPI2*MPHD(MPH_SHD_D,-1), - 1 D0,D1) !RA, DEC CENTRE OUTPUT MAP - DO I=0,NIN-1 !ALL INPUT MAPS - CALL WNMCRD(MPHD(MPH_RA_D,I),MPHD(MPH_DEC_D,I), - 1 R0,R1,D0,D1) !L, M THIS POINT IN INPUT MAP - LM0(0,I)=NINT((R0/PI2-MPHD(MPH_SHR_D,I))/MPHD(MPH_SRA_D,I)) !POINT L - LM0(1,I)=NINT((R1/PI2-MPHD(MPH_SHD_D,I))/MPHD(MPH_SDEC_D,I)) !POINT M - END DO -C -C READ DATA -C - DO I=0,OUTSIZ(1)-1 !ALL LINES - CALL WNGMVZ(LB_E*OUTSIZ(0),ODAT) !ZERO SUM - CALL WNGMVZ(LB_E*OUTSIZ(0),WDAT) !ZERO WEIGHT - CALL WNGMVZ(LB_E*OUTSIZ(0),LDAT) !ZERO LIMIT WEIGHT - WTMAX=0. !MAX. LINE WEIGHT -C -C MAPS -C - DO I1=0,NIN-1 - J0=I-OUTSIZ(1)/2+LM0(1,I1)+MPHJ(MPH_NDEC_J,I1)/2 !LINE TO DO - IF (J0.GE.0 .AND. - 1 J0.LT.MPHJ(MPH_NDEC_J,I1)) THEN !INCLUDE LINE - IF (.NOT.WNFRD(FCA,LB_E*MPHJ(MPH_NRA_J,I1),DAT, - 1 MPHJ(MPH_MDP_J,I1)+ - 1 LB_E*J0*MPHJ(MPH_NRA_J,I1))) THEN !READ LINE - CALL WNCTXT(F_TP,'Error reading Map !AS', - 1 WNTTSG(SNAM(0,I1),0)) - CALL WNGEX !STOP - END IF -C -C MAKE OUTPUT -C - DO I2=0,OUTSIZ(0)-1 !ALL POINTS - J1=I2-OUTSIZ(0)/2+LM0(0,I1)+MPHJ(MPH_NRA_J,I1)/2 - IF (J1.GE.0 .AND. J1.LT.MPHJ(MPH_NRA_J,I1)) THEN - CALL WNMDLM(MPHD(MPH_RA_D,-1),MPHD(MPH_DEC_D,-1), - 1 (I2-OUTSIZ(0)/2+FTSIZ(0))*MPHD(MPH_SRA_D,-1)*DPI2, - 1 (I-OUTSIZ(1)/2+FTSIZ(1))*MPHD(MPH_SDEC_D,-1)*DPI2, - 1 D0,D1) !RA,DEC POINT - CALL WNMCRD(MPHD(MPH_RAO_D,I1),MPHD(MPH_DECO_D,I1), - 1 R0,R1, - 1 D0,D1) !L,M BEAM POINT - D0=NMOBMV(MPHD(MPH_FRQO_D,-1), - 1 R0,R1, - 1 BEMLIM,.TRUE.) !VALUE - D1=MPHE(MPH_NOS_E,I1)**2 !NOISE - IF (POLT(0,0).EQ.0 .OR. D1.LE.0) THEN !NO NOISE - ODAT(I2)=ODAT(I2)+DAT(J1)* - 1 (D0**(MPHI(MPH_CD_I+7,I1)+1)) - WDAT(I2)=WDAT(I2)+D0**2 - LDAT(I2)=LDAT(I2)+1. - ELSE - ODAT(I2)=ODAT(I2)+DAT(J1)* - 1 (D0**(MPHI(MPH_CD_I+7,I1)+1))/D1 - WDAT(I2)=WDAT(I2)+D0**2/D1 - LDAT(I2)=LDAT(I2)+1./D1 - END IF - END IF - WTMAX=MAX(WTMAX,LDAT(I2)) !MAX. WEIGHT THIS LINE - END DO !END POINTS - END IF -C -C NEXT MAP -C - END DO -C -C MAKE OUTPUT -C - DO I2=0,OUTSIZ(0)-1 !ALL POINTS - IF (WDAT(I2).NE.0) THEN - ODAT(I2)=ODAT(I2)/WDAT(I2) - IF (WDAT(I2).LT.POLT(1,0)*WTMAX) ODAT(I2)=0 !LIMIT EDGE OUTPUT - END IF - END DO !END POINTS -C -C STATISTICS -C - R0=-1E36 !MAX - R1=1E36 !MIN - CALL WNMFMX(OUTSIZ(0),ODAT,1D0,R0,I3,R1,I4) !NORM. AND FIND MAX/MIN - IF (R0.GT.MPHE(MPH_MAX_E,-1)) THEN !NEW MAX - MPHE(MPH_MAX_E,-1)=R0 - MPHJ(MPH_MXR_J,-1)=I3-OUTSIZ(0)/2 - MPHJ(MPH_MXD_J,-1)=I-OUTSIZ(1)/2 - END IF - IF (R1.LT.MPHE(MPH_MIN_E,-1)) THEN !NEW MIN - MPHE(MPH_MIN_E,-1)=R1 - MPHJ(MPH_MNR_J,-1)=I4-OUTSIZ(0)/2 - MPHJ(MPH_MND_J,-1)=I-OUTSIZ(1)/2 - END IF - CALL WNMHS1(HIST,OUTSIZ(0),ODAT) !MAKE HISTO -C -C OUTPUT LINE -C - IF (.NOT.WNFWR(FCAO,LB_E*OUTSIZ(0),ODAT,OUTP)) THEN - 20 CONTINUE - CALL WNCTXT(F_TP,'Error writing output map') - CALL WNGEX !STOP - END IF - OUTP=OUTP+LB_E*OUTSIZ(0) !NEXT OUTPUT POINTER -C -C NEXT LINE -C - END DO -C -C WRITE MAP HEADER -C - CALL WNMHS3(HIST,1,F_P) !SHOW HISTOGRAM - CALL WNMHS4(HIST,MPHE(MPH_NOS_E,-1),F_P) !SET NOISE - MPHP(-1)=WNFEOF(FCAO) !WHERE TO WRITE - CALL WNDSTI(FCA,SNAM(0,0)) !MAKE AN INDEX IF NECESSARY - IF (.NOT.WNFWR(FCAO,MPHHDL,MPH(0,-1),MPHP(-1))) GOTO 20 !WRITE HEADER - IF (.NOT.WNDLNG(GFH_LINKG_1,0,SGH_GROUPN_1, - 1 FCAO,SGPH(0),SGNR(0))) THEN - 30 CONTINUE - CALL WNCTXT(F_TP,'Error creating sub-group') - CALL WNGEX !STOP - END IF - DO I=1,4 - IF (.NOT.WNDLNF(SGPH(I-1)+SGH_LINKG_1,SNAM(I,0),SGH_GROUPN_1, - 1 FCAO,SGPH(I),SGNR(I))) GOTO 30 - END DO - I=5 - IF (.NOT.WNDLNK(GFH_LINK_1,MPHP(-1),MPH_SETN_1, - 1 FCAO)) GOTO 30 - IF (.NOT.WNDLNG(SGPH(I-1)+SGH_LINKG_1,MPHP(-1),SGH_GROUPN_1, - 1 FCAO,SGPH(I),SGNR(I))) GOTO 30 - IF (.NOT.WNFRD(FCAO,MPHHDL,MPH(0,-1),MPHP(-1))) GOTO 30 !HEADER - SGNR(6)=-1 !END NAME - CALL WNCTXT(F_T,'MAP !AS created',WNTTSG(SGNR,0)) - CALL WNCTXT(F_P,'!^') - CALL NMAPMH(F_P,MPH(0,-1),SGNR,NODOUT) !PRINT HEADER -C -C READY -C - 900 CONTINUE - CALL WNMHS9(HIST) !CLEAR HISTO - CALL WNFCL(FCA) !CLOSE FILES - CALL WNFCL(FCAO) -C - RETURN -C -C - END diff --git a/src/nmap/nmaini.for b/src/nmap/nmaini.for deleted file mode 100644 index 49b6fa07eee868b79a87e941747152bdcf89749b..0000000000000000000000000000000000000000 --- a/src/nmap/nmaini.for +++ /dev/null @@ -1,53 +0,0 @@ -c+ NMAINI.FOR -C WNB 910219 -C -C Revisions: -C - SUBROUTINE NMAINI -C -C Initialize NMAP program -C -C Result: -C -C CALL NMAINI will set header lines, logging, DWARF interface -C -C Include files: -C - INCLUDE 'WNG_DEF' - INCLUDE 'NMA_DEF' -C -C Parameters: -C -C -C Arguments: -C -C -C Function references: -C - LOGICAL WNDINI !INIT DWARF - LOGICAL WNDDAB !OPEN DATABASE -C -C Data declarations: -C -C- -C -C SET HEADER LINES -C - CALL WNCFHD(F_P,1,'!40C\Program to handle MAP files') -C -C START DWARF -C - IF (.NOT.WNDINI(PRGNAM)) CALL WNGEX !EXIT IF NO DWARF START -C -C LOGGING -C - CALL WNDLOG(LOGCD) !PROPER LOGGING -C -C DATABASE -C - IF (.NOT.WNDDAB()) CALL WNGEX !OPEN DATABASE -C - RETURN !READY -C -C - END diff --git a/src/nmap/nmajsl.for b/src/nmap/nmajsl.for deleted file mode 100644 index 6969dc52676e099b1fca1ee84fbe7a3c44dbf47a..0000000000000000000000000000000000000000 --- a/src/nmap/nmajsl.for +++ /dev/null @@ -1,488 +0,0 @@ -C+ NMAJSL.FOR -C CMV 940530 -C -C Revisions: -C CMV 940530 Created -C CMV 940614 Removed type -C HjV 970415 Do not divide by zero for % OF 12h OBS. -C AXC 010709 Linux port Changed check -C - SUBROUTINE NMAJSL -C -C Create/show a job summary log -C -C Result: -C -C CALL NMAJSL() will write the general part of the job summary -C log and show sets pointer/length in JOBSUM -C -C CALL NMAJSS(FCAIN_J:I,STH(0:*)_J:I,SCNHA_E:I,IFRT(0:*)_I:I, -C BASEL(0:*)_E:I,APDATA(0:*)_E:I) -C will update the summary for a set of input data -C defined by Sector header STH with baselines in -C BASEL and weights in APDATA. This routine should -C be called for each scan with hour angle SCNHA. -C -C CALL NMAJSM(MPH) -C will update the summary for output map MPH -C -C CALL NMAJSP(OUT_J:I,FCA2_J:I,MPHJ(0:*)_J:I, -C SNAM(0:*)_J:I,NODNAM_C*(*):I) -C will show the summary for the header in MPHJ -C and file FCAIN on output OUT (F_T, F_TP etc) -C using SNAM and NODNAM as a description. -C -C PIN references: -C -C -C Include files: -C - INCLUDE 'WNG_DEF' - INCLUDE 'NMA_DEF' - INCLUDE 'STH_O_DEF' !SECTOR HEADER - INCLUDE 'MPH_O_DEF' !MAP HEADER - INCLUDE 'OHW_O_DEF' !OH BLOCK -C -C Parameters: -C - INTEGER MAXCHAR !MAX NUMBER OF CHARACTERS ON A LINE - PARAMETER (MAXCHAR=80) - INTEGER MAXLINE !MAX NUMBER OF LINES IN SUMMARY - PARAMETER (MAXLINE=23+STHIFR) - INTEGER MAXSEQ !MAX NUMBER OF SEQUENCE-NO'S KEPT - PARAMETER (MAXSEQ=8) -C -C Entry points: -C -C -C Arguments: -C - INTEGER FCAIN !INPUT FILE - BYTE STH(0:*) !SECTOR HEADER - REAL SCNHA !HA of Scan - INTEGER*2 IFRT(0:*) !IFR TABLE - REAL BASEL(0:*) !BASELINES - REAL APDATA(0:*) !WEIGHTS -C - BYTE MPH_I(0:*) !MAP HEADER -C - INTEGER OUT !OUTPUT FILE(S) - INTEGER FCA2 !INPUT FILE - INTEGER MPHJ_I(0:*) !MAP HEADER - INTEGER SNAM(0:7) !SET NAME - CHARACTER NODNAM*(*) !NODE NAME -C -C Function references: -C - LOGICAL WNFWR !WRITE FILE - LOGICAL WNFRD !READ FILE - INTEGER WNFEOF !FIND END OF FILE - CHARACTER*32 WNTTSG !GET MAP SET NAME - INTEGER WNGGJ !GET INTEGER - INTEGER*2 WNGGI !GET INTEGER - REAL*8 WNGGD !GET DOUBLE PRECISION - REAL*4 WNGGE !GET SINGLE PRECISION -C -C Data declarations: -C - INTEGER SIFR !NO OF IFRS IN SECTOR - INTEGER ICOL !COLUMN NUMBER - INTEGER ISEQ !INDEX IN SEQ ARRAY - INTEGER CSEQ !CURRENT SEQ NO - INTEGER ITIM(4) !BUFFER FOR TIMES - REAL*8 FRQ !OBS. FREQUENCY - REAL BS0,BS1 !BUFFER FOR RESOLUTION -C - BYTE MPH(0:MPHHDL-1) !LOCAL MAP HEADER - INTEGER*2 MPHI(0:MPHHDL/2-1) - INTEGER MPHJ(0:MPHHDL/4-1) - REAL MPHE(0:MPHHDL/4-1) - DOUBLE PRECISION MPHD(0:MPHHDL/8-1) - EQUIVALENCE (MPH,MPHI,MPHJ,MPHE,MPHD) -C - BYTE OHW(0:OHWHDL-1) !OH - INTEGER*2 OHWI(0:OHWHDL/2-1) - INTEGER OHWJ(0:OHWHDL/4-1) - REAL OHWE(0:OHWHDL/4-1) - REAL*8 OHWD(0:OHWHDL/8-1) - EQUIVALENCE (OHW,OHWI,OHWJ,OHWE,OHWD) -C - CHARACTER TMP1*32,TMP2*32,TMP3*32 !TEMP. BUFFERS - CHARACTER LINE*80 !BUFFER FOR LINE OF TEXT - BYTE JBUF(1:80,1:MAXLINE) !BUFFER FOR SUMMARY -C - INTEGER LI(0:STHIFR-1) !LOOKUP TABLE FOR ORDERING IFRS - INTEGER NIFR !NUMBER OF IFRS SAVED - INTEGER SEQ(MAXSEQ) !SEQUENCE NUMBERS - REAL TOT12(2,MAXSEQ) !PERCENTAGE OF 12 HR OBS - REAL SCN(MAXSEQ) !NUMBER OF SCANS - REAL CNT(0:STHIFR-1,MAXSEQ) !POINTS USED - REAL HAR(0:1,MAXSEQ) !HOUR ANGLE RANGE - REAL MBAS !MAX BASELINE - LOGICAL FIRST !INITIALISE RANGES - REAL VLR(0:1) !VELOCITY RANGE - INTEGER CHR(0:1) !CHANNEL RANGE - REAL DTR(0:1) !DATA RANGE - REAL TBW !TOTAL BANDWIDTH FROM FIRST OH - REAL CBW !AVERAGE CHANNEL BANDWIDTH - REAL NOS !AVERAGE NOISE - REAL NMAP !NUMBER OF MAPS - INTEGER*2 PRJ !PROJECT (OF FIRST SEQ) -C - CHARACTER STR(0:5)*16 !SOME STRINGS - DATA STR/'No subtract', 'Model subtracted', - 1 'no clip', 'clipped', - 1 'not corrected','corrected'/ - CHARACTER CVL(0:5)*12 !Convolution types - DATA CVL/'No ','Gaussian','Box','Prolate 4*4', - 1 'ExpSinc','Prolate 6*6'/ - CHARACTER TPR(0:5)*8 !Taper types - DATA TPR/'None', 'Gaussian','Linear','Natural', - 1 'Overr','Rgauss'/ -C - COMMON /JSL_COM/JBUF,LI,NIFR,SEQ,SCN,TOT12,CNT,HAR, - 1 FIRST,VLR,CHR,DTR,TBW,CBW,NOS,NMAP,PRJ -C- -C -C Initialise -C - JOBSUM(0)=0 !DEFAULT: NO LOG - JOBSUM(0)=0 - CALL WNGMVB(80*MAXLINE,JBUF) !CLEAR BUFFER - DO I=1,MAXSEQ - SEQ(I)=0 !NOT YET DEFINED - END DO - FIRST=.TRUE. !NEED TO INITIALISE RANGES - TBW= -1 !UNKNOWN YET - PRJ= -1 !UNKNOWN YET - CHR(0)= 32768 !UNKNOWN YET - CHR(1)= -1 !UNKNOWN YET - MBAS=3000 !SOME DEFAULT -C -C Initialise order for ifrs -C - LI(0)= 9+10*256 !9a - LI(1)= 9+11*256 !9b - LI(2)= 9+12*256 !9c - LI(3)= 9+13*256 !9d - LI(4)=10+11*256 !ab - LI(5)=10+12*256 !ac - LI(6)=10+13*256 !ad - LI(7)=11+12*256 !bc - LI(8)=11+13*256 !bd - LI(9)=12+13*256 !cd - NIFR=10 - DO I=8,0,-1 - LI(NIFR) =I+10*256 !8a..0a - LI(NIFR+1)=I+11*256 !8b..0b - NIFR=NIFR+2 - END DO - DO I=8,0,-1 - LI(NIFR) =I+12*256 !8c..0c - LI(NIFR+1)=I+13*256 !8d..0d - NIFR=NIFR+2 - END DO -C -C Fill in header line and first row for SCN items -C - CALL WNGSGU(TMP1) !User - CALL WNCTXS(LINE,'Job !AS '// - 1 '!40C\Date !%DN !%T by !AS', - 1 CNTCVL(1),TMP1) !Write to string - CALL WNGMFS(80,LINE,JBUF(1,1)) !Save in buffer -C - CALL WNGMFS(13,'Sequenceno. ',JBUF(1,19)) - CALL WNGMFS(13,'Obs.date ',JBUF(1,20)) - CALL WNGMFS(13,'UT time ',JBUF(1,21)) - CALL WNGMFS(13,'HA-range ',JBUF(1,22)) - CALL WNGMFS(13,'% of 12h obs ',JBUF(1,23)) - DO I=0,NIFR-1 - CALL WNCTXS(TMP1,' !1$X!1$X ',MOD(LI(I),256),LI(I)/256) - CALL WNGMFS(4,TMP1,JBUF(1,24+I)) - END DO -C -C Write to file -C - JOBSUM(0)=WNFEOF(FCAOUT) !APPEND TO FILE - JOBSUM(1)=(23+NIFR)*80 !NUMBER OF CHARACTERS - GOTO 10 -C -C Add input data to summary log -C - ENTRY NMAJSS(FCAIN,STH,SCNHA,IFRT,BASEL,APDATA) -C -C Find column -C - SIFR=WNGGJ(STH(STH_NIFR_1)) !GET NO OF IFRS - CSEQ=WNGGJ(STH(STH_VNR_1)) !GET SEQUENCE NUMBER - ISEQ=1 - DO WHILE (SEQ(ISEQ).NE.CSEQ.AND. - 1 SEQ(ISEQ).NE.0.AND.ISEQ.LT.MAXSEQ) !NO MATCH - ISEQ=ISEQ+1 !TRY NEXT - END DO - ICOL=13*ISEQ !FIND COLUMN -C -C If not found and still space, create new column -C - IF (SEQ(ISEQ).EQ.0) THEN - SEQ(ISEQ)=CSEQ !SAVE SEQUENCE NUMBER - SCN(ISEQ)=0 !NO SCANS YET - HAR(0,ISEQ)= 999 !NO RANGE KNOWN - HAR(1,ISEQ)= -999 -C -C Fill in fixed items for column, extra things in header for first col. -C - CALL WNCTXS(TMP1,'!12$UJ',CSEQ) !WRITE TO STRING - CALL WNGMFS(12,TMP1,JBUF(ICOL,19)) !SAVE IN BUFFER - J=WNGGJ(STH(STH_OHP_1)) !GET POINTER TO OH - I1=WNGGJ(STH(STH_NOH_1)) !GET LENGTH OF OH - IF (J.NE.0) THEN !Read OH block if any - IF (WNFRD(FCAIN,I1,OHW,J)) THEN - CALL WNCTXS(TMP1,'!2$ZI!2$ZI!2$ZI (!3$ZI)', - 1 OHWI(OHW_DATE_I+1),OHWI(OHW_DATE_I+2), - 1 OHWI(OHW_DATE_I+3),OHWI(OHW_SDAY_I)) !yymmdd (day) - CALL WNGMFS(12,TMP1,JBUF(ICOL,20)) !SAVE IN BUFFER - I1=OHWI(OHW_STIM_I)*10 !MAKE SECONDS - ITIM(1)=I1/3600 !GET HOURS - ITIM(2)=MOD(I1/60,60) !GET MINUTES - I1=OHWI(OHW_ETIM_I)*10 !MAKE SECONDS - ITIM(3)=I1/3600 !GET HOURS - ITIM(4)=MOD(I1/60,60) !GET MINUTES - CALL WNCTXS(TMP1,'!2$ZJ:!2$ZJ-!2$ZJ:!2$ZJ', - 1 ITIM(1),ITIM(2),ITIM(3),ITIM(4)) !UT-time - CALL WNGMFS(12,TMP1,JBUF(ICOL,21)) !SAVE IN BUFFER -C - IF (PRJ.LT.0) PRJ=OHWI(OHW_PROJECT_I) !SAVE FIRST PROJECT - IF (TBW.LT.0) TBW=OHWE(OHW_BAND_E) !SAVE FIRST TOTAL BAND -C - END IF - END IF -C - I1=0 !NO. OF SEL. IFR'S - DO I=0,NIFR-1 !FOR ALL IFR'S - CNT(I,ISEQ)=0 !NO POINTS YET - DO I3=0,SIFR !FIND IFR IN TABLE - IF (IFRT(I3).EQ.LI(I)) THEN !FOUND - IF (BASEL(I3).GT.MBAS.AND. - 1 SIFRS(I3/256,MOD(I3,256),0).NE.0) - 1 MBAS=BASEL(I3) !NEW MAX - IF (BASEL(I3).GT.0) THEN !SELECTED - I1=I1+1 !COUNT IFR - CALL WNCTXS(TMP1,'!6$E6.0',BASEL(I3)) !WRITE TO STRING - CALL WNGMFS(6,TMP1,JBUF(ICOL,24+I)) - ELSE - CALL WNGMFS(11,' ---- (--)',JBUf(ICOL,24+I)) !NOT SELECTED - END IF - END IF - END DO - END DO -C - R0=0.5/WNGGE(STH(STH_HAI_1)) !HA SCANS IN 12h OBS. - TOT12(1,ISEQ)=R0*I1 !TOTAL POINTS - TOT12(2,ISEQ)=0 !INIT COUNTER -C - END IF -C -C If found, update the percentage used and Ha range -C - IF (SEQ(ISEQ).EQ.CSEQ) THEN - SCN(ISEQ)=SCN(ISEQ)+1 !ADD THIS SCAN - IF (SCNHA.LT.HAR(0,ISEQ)) THEN !NEW MINIMUM - HAR(0,ISEQ)=SCNHA - CALL WNCTXS(TMP1,'!4$E4.0 -',SCNHA*360) - CALL WNGMFS(6,TMP1,JBUF(ICOL,22)) - END IF - IF (SCNHA.GT.HAR(1,ISEQ)) THEN !NEW MAXIMUM - HAR(1,ISEQ)=SCNHA - CALL WNCTXS(TMP1,'- !4$E4.0',SCNHA*360) - CALL WNGMFS(6,TMP1,JBUF(ICOL+5,22)) - END IF -C - DO I=0,NIFR-1 !FOR ALL IFR'S - DO I3=0,SIFR !FIND IFR IN TABLE - IF (IFRT(I3).EQ.LI(I).AND. - 1 BASEL(I3).GT.0) THEN !FOUND AND SELECTED - IF (APDATA(I3).GT.0) THEN ! AND NOT FLAGGED - CNT(I,ISEQ)=CNT(I,ISEQ)+1 !COUNT FOR IFR - TOT12(2,ISEQ)=TOT12(2,ISEQ)+1 !COUNT FOR TOTAL - END IF - R0=100.*CNT(I,ISEQ)/SCN(ISEQ) !MAKE % - IF (R0.GT.99) THEN !ALL - CALL WNGMFS(4,'(**)',JBUF(ICOL+7,24+I)) - ELSE IF (CNT(I,ISEQ).EQ.0) THEN !NONE - CALL WNGMFS(4,'(..)',JBUF(ICOL+7,24+I)) - ELSE !0...100% - CALL WNCTXS(TMP1,'(!2$E2.0)',R0) !WRITE TO STRING - CALL WNGMFS(4,TMP1,JBUF(ICOL+7,24+I)) - END IF - END IF - END DO - END DO -C - IF (TOT12(1,ISEQ).LE.0.0) THEN - CALL WNCTXS(TMP1,' 0.0') - ELSE - CALL WNCTXS(TMP1,'!5$E5.1', - 1 100.*TOT12(2,ISEQ)/TOT12(1,ISEQ)) !% OF 12h OBS. - ENDIF - CALL WNGMFS(5,TMP1,JBUF(ICOL+6,23)) !SAVE IN BUFFER -C -C Check channel range here, since output map starts at channel 0 always -C - I1=WNGGI(STH(STH_CHAN_1)) - IF (I1.LT.CHR(0)) CHR(0)=I1 - IF (I1.GT.CHR(1)) CHR(1)=I1 -C - END IF -C - RETURN !DO NOT YET UPDATE IN FILE -C -C Add next output map to summary log -C - ENTRY NMAJSM(MPH_I) -C - IF (JOBSUM(0).EQ.0) RETURN !QUIT IF NOT SUMMARY YET -C - CALL WNGMV(MPHHDL,MPH_I,MPH) !LOCAL COPY OF HEADER - IF (FIRST) THEN !INITIALISE RANGES - FIRST=.FALSE. - CBW=0 - NOS=0 - NMAP=0 - VLR(0)=MPHD(MPH_VEL_E) !AVERAGE OVER STH_VEL - VLR(1)=MPHD(MPH_VEL_E) - DTR(0)=MPHE(MPH_MIN_E) - DTR(1)=MPHE(MPH_MAX_E) - ELSE - IF (MPHD(MPH_VEL_E).LT.VLR(0)) VLR(0)=MPHE(MPH_VEL_E) - IF (MPHD(MPH_VEL_E).GT.VLR(1)) VLR(1)=MPHE(MPH_VEL_E) - IF (MPHE(MPH_MIN_E).LT.DTR(0)) DTR(0)=MPHE(MPH_MIN_E) - IF (MPHE(MPH_MAX_E).GT.DTR(1)) DTR(1)=MPHE(MPH_MAX_E) - END IF - CBW=CBW+MPHD(MPH_BDW_D) !UPDATE AV. CHANNEL BANDWIDTH - NOS=NOS+MPHE(MPH_NOS_E) - NMAP=NMAP+1 -C - R0=MBAS !MAX BASELINE - IF (TAPTYP.NE.0) R0=MIN(R0,TAPVAL) !MAY BE TAPER LIMITED - IF (CWGTYP.NE.0) R0=MIN(R0,CWGVAL) - FRQ=CNTDVL(12) !OBS. FREQ - IF (D1.EQ.0) FRQ=CNTDVL(6) !FALLBACK: CHANNEL FREQ - BS0=1.5D0/(R0*DPI2*FRQ/CL/(1.D-6)) !BEAM IN RAD D*c/(2pi f) - BS0=BS0/DPI2 !BEAM IN CIRCLES - IF (CWGTYP.NE.0.AND.R0.EQ.CWGVAL) THEN - BS1=BS0 !CIRC.WEIGHT - ELSE - BS1=BS0/SIN(MPHD(MPH_DEC_D)*DPI2) !ASSYMMETRIC - END IF -C - CALL WNCTXS(LINE,'Taper !6$E6.1 (!AS)'// - 1 '!40C\FFT Size !6$UJ x !6$UJ pix', - 1 TAPVAL,TPR(TAPTYP), - 1 MPHJ(MPH_FSR_J),MPHJ(MPH_FSD_J)) - CALL WNGMFS(80,LINE,JBUF(1,3)) - CALL WNCTXS(LINE,'Circ.weight !6$E6.1 (!AS)'// - 1 '!40C\Outsize !6$UJ x !6$UJ pix', - 1 CWGVAL,TPR(CWGTYP), - 1 MPHJ(MPH_NRA_J),MPHJ(MPH_NDEC_J)) - CALL WNGMFS(80,LINE,JBUF(1,4)) - CALL WNCTXS(LINE,'Polarisations: !#AS'// - 1 '!40C\Fieldsize !5$E5.1 x !5$E5.1 arcmin', - 1 NPOL,POLC, - 1 MPHE(MPH_FRA_E )*360*60, - 1 MPHE(MPH_FDEC_E)*360*60) - CALL WNGMFS(80,LINE,JBUF(1,5)) - CALL WNCTXS(LINE,'Convolution: !AS (!AS)'// - 1 '!40C\ = !7$EAF7.2 x !6$EAF6.2 deg', - 1 CVL(MPHI(MPH_CD_I+1)),STR(4+MPHI(MPH_CD_I+2)), - 1 MPHE(MPH_FRA_E),MPHE(MPH_FDEC_E)) - CALL WNGMFS(80,LINE,JBUF(1,6)) - CALL WNCTXS(LINE,'!AS, !AS'// - 1 '!40C\Pix. size !6$D6.2 x !6$D6.2 arcsec', - 1 STR( MPHI(MPH_CD_I+4)), - 1 STR(2+MPHI(MPH_CD_I+3)), - 1 MPHD(MPH_SRA_D)*360D0*3600D0, - 1 MPHD(MPH_SDEC_D)*360D0*3600D0) - CALL WNGMFS(80,LINE,JBUF(1,7)) -C - CALL WNCTXS(LINE,'Pix/beam !6$D6.1 x !6$D6.1'// - 1 '!40C\Beam size !6$D6.2 x !6$D6.2 arcsec', - 1 BS0/MPHD(MPH_SRA_D),BS1/MPHD(MPH_SDEC_D), - 1 BS0*360D0*3600D0,BS1*360D0*3600D0) - CALL WNGMFS(80,LINE,JBUF(1,8)) -C - CALL WNCTXS(LINE,'Field !AS'// - 1 '!40C\Project !12$UI', - 1 CNTCVL(0),PRJ) !GET FIELD AND PROJECT - CALL WNGMFS(80,LINE,JBUF(1,10)) !SAVE IN BUFFER -C - CALL WNCTXS(LINE,'RA !8$DHF6 = !8$DPF8.3 deg'// - 1 '!40C\Dec !8$DDF6 = !8$DAF8.3 (!E5.0)', - 1 MPHD(MPH_RA_D), MPHD(MPH_RA_D), - 1 MPHD(MPH_DEC_D),MPHD(MPH_DEC_D), - 1 MPHE(MPH_EPO_E)) - CALL WNGMFS(80,LINE,JBUF(1,11)) -C - CALL WNCTXS(LINE,'Obs.frq. !10$D10.3 MHz '// - 1 '!40C\Cen. vel. !8$D8.1 km/s', - 1 FRQ,CNTDVL(8)) - CALL WNGMFS(80,LINE,JBUF(1,13)) - CALL WNCTXS(LINE,'Bandwidth !8$E8.3 MHz '// - 1 '!40C\Vel. range !8$E8.1 - !8$E8.1 km/s', - 1 TBW,VLR(0),VLR(1)) - CALL WNGMFS(80,LINE,JBUF(1,14)) - CALL WNCTXS(LINE,'Channel bw !6$E6.1 kHz'// - 1 '!40C\Channels !4$UJ - !4$UJ ', - 1 CBW/NMAP*1000,CHR(0),CHR(1)) - CALL WNGMFS(80,LINE,JBUF(1,15)) - CALL WNCTXS(LINE,'Datarange !8$E8.2 - !8$E8.2 '// - 1 '!40C\Av. noise !10$E10.4', - 1 DTR(0),DTR(1),NOS/NMAP) - CALL WNGMFS(80,LINE,JBUF(1,16)) -C - GOTO 10 !UPDATE IN FILE -C -C Update in file -C - 10 CONTINUE - IF (.NOT.WNFWR(FCAOUT,JOBSUM(1),JBUF,JOBSUM(0))) THEN !WRITE - JOBSUM(0)=0 !DISABLE JOB SUMMARY - JOBSUM(1)=0 - CALL WNCTXT(F_TP,'Cannot write job summary log') - END IF - RETURN -C -C Print job summary log -C - ENTRY NMAJSP(OUT,FCA2,MPHJ_I,SNAM,NODNAM) -C - IF (MPHJ_I(MPH_JOBP_J).EQ.0.OR. - 1 MPHJ_I(MPH_JOBL_J).EQ.0) THEN !CHECK IF IT'S THERE - CALL WNCTXT(F_TP,'No Job Summary Log for !AS in node !AS', - 1 WNTTSG(SNAM,0),NODNAM) - RETURN - END IF - IF (.NOT.WNFRD(FCA2,MPHJ_I(MPH_JOBL_J), - 1 JBUF,MPHJ_I(MPH_JOBP_J))) THEN !TRY TO READ - CALL WNCTXT(F_TP, - 1 'Cannot read Job Summary Log for !AS in node !AS', - 1 WNTTSG(SNAM,0),NODNAM) - RETURN - END IF -C - CALL WNCTXT(OUT,'!/\#Job Summary Log of !AS in node !AS', - 1 WNTTSG(SNAM,0),NODNAM) -C - I1=1 !FIRST LINE - I2=MPHJ_I(MPH_JOBL_J)/80 !LAST LINE - DO WHILE (I1.LE.I2) !ALL LINES - CALL WNGMTS(80,JBUF(1,I1),LINE) !MOVE INTO STRING - CALL WNCTXT(OUT,'!AS',LINE) !PRINT - I1=I1+1 !NEXT LINE - END DO -C - CALL WNCTXT(OUT,'#End') - RETURN -C - END - diff --git a/src/nmap/nmamak.for b/src/nmap/nmamak.for deleted file mode 100644 index ff9212fdd7026306e87123759d1c371eeb678d70..0000000000000000000000000000000000000000 --- a/src/nmap/nmamak.for +++ /dev/null @@ -1,220 +0,0 @@ -C+ NMAMAK.FOR -C WNB 910305 -C -C Revisions: -C WNB 910913 Change loops -C WNB 921202 Add data clean (NMAMAC) -C CMV 931216 Change grouping for loops -C CMV 931216 Again change grouping (did not check on SCN-group) -C - SUBROUTINE NMAMAK -C -C Make maps -C -C Result: -C -C CALL NMAMAK will make all maps asked -C CALL NMAMAC ( CMHP_J:I, CMPNAM_J(0:7):I) -C will make a cleaned map overwriting map pointed -C to by CMHP with name CMPNAM -C -C Include files: -C - INCLUDE 'WNG_DEF' - INCLUDE 'GFH_O_DEF' !GENERAL FILE HEADER - INCLUDE 'SGH_O_DEF' !SUB-GROUP HEADER - INCLUDE 'NMA_DEF' -C -C Parameters: -C -C -C Arguments: -C - INTEGER CMHP !CLEAN MAP HEADER POINTER - INTEGER CMPNAM(0:7) !CLEAN MAP SET NAME -C -C Function references: -C - LOGICAL WNDLNG,WNDLNF !LINK SUB-GROUP - LOGICAL WNDXLN !NEXT LOOP VALUE -C -C Data declarations: -C - INTEGER FCATMP !SORT FILE - INTEGER FCACVL !CONVOLUTION OUTPUT FILE - LOGICAL SOAP,SOCV,SAP !SAVE AP OPTIONS - LOGICAL LCL !CLEAN SWITCH - INTEGER LPCHK(0:7) !CHECK OFFSETS - INTEGER EQCHK(0:7) !MORE CHECK OFFSETS -C- -C -C NMAMAK -C - LCL=.FALSE. !NOT CLEAN - GOTO 100 -C -C NMAMAC -C - ENTRY NMAMAC(CMHP,CMPNAM) -C - LCL=.TRUE. - SGPH(5)=CMHP !SAVE MAP HEADER - GOTO 100 -C -C INIT -C - 100 CONTINUE - CALL WNDXLI(LPOFF) !INIT LOOP OFFSETS - DO I=0,7 !OFFSET CHECKS - LPCHK(I)=0 - EQCHK(I)=0 - END DO -C -C ALL OUTPUTS -C - IF (.NOT.LCL) THEN !NORMAL - DO WHILE (WNDXLN(LPOFF)) !LOOP - IF (.NOT.DODFT) THEN !FIND LINKS - IF ( (LPOFF(1).LT.LPCHK(1) .AND. - 1 LPOFF(2).LT.LPCHK(2) .AND. - 1 LPOFF(3).LT.LPCHK(3)) .OR. - 1 (LPOFF(1).EQ.LPCHK(1) .AND. - 1 LPOFF(1).EQ.EQCHK(1) .AND. - 1 LPOFF(2).EQ.LPCHK(2) .AND. - 1 LPOFF(2).EQ.EQCHK(2) .AND. - 1 LPOFF(3).EQ.LPCHK(3) .AND. - 1 LPOFF(3).EQ.EQCHK(3))) THEN !NEW JOB - IF (.NOT.WNDLNG(GFH_LINKG_1,0,SGH_GROUPN_1, - 1 FCAOUT,SGPH(0),SGNR(0))) THEN !CREATE JOB - 10 CONTINUE - CALL WNCTXT(F_TP,'!/Cannot create map header linkage') - CALL WNGEX !STOP PROGRAM - END IF - END IF -C - DO I=1,3 !NEW CHECK - LPCHK(I)=MAX(LPCHK(I),LPOFF(I)) - END DO - IF (LPOFF(1).EQ.LPCHK(1).AND. - 1 LPOFF(2).EQ.LPCHK(2).AND. - 1 LPOFF(3).EQ.LPCHK(3)) THEN - EQCHK(1)=LPOFF(1) - EQCHK(2)=LPOFF(2) - EQCHK(3)=LPOFF(3) - END IF -C - IF (.NOT.WNDLNF(SGPH(0)+SGH_LINKG_1,LPOFF(2), - 1 SGH_GROUPN_1,FCAOUT, - 1 SGPH(1),SGNR(1))) GOTO 10 !CREATE FIELD - IF (.NOT.WNDLNF(SGPH(1)+SGH_LINKG_1,LPOFF(3), - 1 SGH_GROUPN_1,FCAOUT, - 1 SGPH(2),SGNR(2))) GOTO 10 !CREATE CHANNEL - END IF -C -C SORT DATA -C - CALL WNCTXT(F_TP,' ') - IF (DODFT) THEN - CALL WNCCSX(F_TP,'DFTing') !STATISTICS - ELSE - CALL WNCCSX(F_TP,'Sorting') !STATISTICS - END IF - CALL NMASOR(FCATMP) !SORT/DFT DATA - IF (CNTJVL(4).LE.0) THEN !NO DATA FOUND - CALL WNCTXT(F_TP,'No data found') -C -C CONVOLVE DATA -C - ELSE IF (.NOT.DODFT) THEN - IF (UWGT.EQ.2) THEN !UNIFORM WEIGHT - CALL WNCCSX(F_TP,'Uniforming') - CALL NMAUNI(FCATMP,A_B(BINADM-A_OB)) !FULL UNIFORM - END IF - SOAP=OUTOPT(2) !SAVE AP OUTPUT OPTION - SOCV=OUTOPT(3) !SAVE COVER OUTPUT OPTION - SAP=MAKAP !SAVE AP MAKING - DO I2=0,NPOL-1 !ALL POLARISATIONS - IF (.NOT.WNDLNG(SGPH(2)+SGH_LINKG_1,0, - 1 SGH_GROUPN_1,FCAOUT, - 1 SGPH(3),SGNR(3))) GOTO 10 !CREATE POLAR. - CALL WNCCSX(F_TP,'Convolving') !STATISTICS - CALL NMACVL(FCATMP,FCACVL,A_B(BINADM-A_OB),I2) !CONVOLVE DATA -C -C TRANSPOSE DATA -C - CALL WNCCSX(F_TP,'Transposing') !STATISTICS - CALL NMATRP(FCACVL,I2,A_B(DECVB(0)-A_OB), - 1 A_B(DECVB(1)-A_OB)) !TRANSPOSE AND OUTPUT -C -C NEXT POLARISATION -C - OUTOPT(2)=.FALSE. !MAKE ONLY ONE AP PER POL. SET - OUTOPT(3)=.FALSE. - MAKAP=.FALSE. - CALL WNFCL(FCACVL) !CLOSE AND DELETE CONVOLVED DATA - END DO - OUTOPT(2)=SOAP !RESTORE AP OUTPUT OPTION - OUTOPT(3)=SOCV !RESTORE COVER OUTPUT OPTION - MAKAP=SAP !RESTORE AP MAKING - CALL WNFCL(FCATMP) !CLOSE AND DELETE SORTED DATA - CALL WNGFVM(4*(L_J/L_B)*NBIN,BINADM) !RELEASE ADMINISTRATION - END IF -C -C NEXT LOOP -C - END DO !MORE -C -C CLEAN MAP -C - ELSE - DO I=0,7 !SET LINKS - SGNR(I)=CMPNAM(I) - END DO -C -C SORT DATA -C - CALL WNCTXT(F_TP,' ') - CALL WNCCSX(F_TP,'Sorting') !STATISTICS - CALL NMASOR(FCATMP) !SORT/DFT DATA - IF (CNTJVL(4).LE.0) THEN !NO DATA FOUND - CALL WNCTXT(F_TP,'No data found') -C -C CONVOLVE DATA -C - ELSE - IF (UWGT.EQ.2) THEN !UNIFORM WEIGHT - CALL WNCCSX(F_TP,'Uniforming') - CALL NMAUNI(FCATMP,A_B(BINADM-A_OB)) !FULL UNIFORM - END IF - SOAP=OUTOPT(2) !SAVE AP OUTPUT OPTION - SOCV=OUTOPT(3) !SAVE COVER OUTPUT OPTION - SAP=MAKAP !SAVE AP MAKING - CALL WNCCSX(F_TP,'Convolving') !STATISTICS - CALL NMACVL(FCATMP,FCACVL,A_B(BINADM-A_OB),I2) !CONVOLVE DATA -C -C TRANSPOSE DATA -C - CALL WNCCSX(F_TP,'Transposing') !STATISTICS - CALL NMATRP(FCACVL,I2,A_B(DECVB(0)-A_OB), - 1 A_B(DECVB(1)-A_OB)) !TRANSPOSE AND OUTPUT -C -C NEXT POLARISATION -C - CALL WNFCL(FCATMP) !CLOSE AND DELETE SORTED DATA - CALL WNGFVM(4*(L_J/L_B)*NBIN,BINADM) !RELEASE ADMINISTRATION - END IF - END IF -C -C READY -C - 21 CONTINUE - IF (.NOT.LCL) THEN - CALL WNFCL(FCAOUT) !CLOSE OUTPUT - CALL WNCTXT(F_TP,' ') - CALL WNCCSX(F_TP,'End') !STATISTICS - END IF -C - RETURN !READY -C -C - END diff --git a/src/nmap/nmamkp.for b/src/nmap/nmamkp.for deleted file mode 100644 index 74504697c9f63e93c72925e44f29aafbb5542353..0000000000000000000000000000000000000000 --- a/src/nmap/nmamkp.for +++ /dev/null @@ -1,182 +0,0 @@ -C NMAMKP.FOR -C WNB 950809 -C -C Revisions: -C WNB 950917 Add more buffers; change convolution -C - SUBROUTINE NMAMKP(STH,BASEL,CMOD,CDAT,APDAT,FTBUF,FTW,FTBE,FTBJ, - 1 UV0,UV,NOTPT) -C -C Convert a scan to Polarisation intensity -C -C Result: -C -C CALL NMAMKP ( STH_B(0:*), BASEL_E(0:*):I, CMOD_X(0:3,0:*):I, -C CDAT_X(0:*,0:3):O, APDAT_E(0:*):O, -C FTBUF_X(0:*,0:1):IO, FTW_E(0:*):IO, -C FTBE_E(0:1,0:*):IO, FTBJ(0:*):IO, UV0_E(0:1):I, -C UV_E(0:1,0:*):O, NOTPT_J:O) -C -C Convert the scan data in CDAT with weights APDAT -C to polarised intensity in BUFFERS. -C FTBUF, FTBE, FTBE and FTW are FT help buffers. -C NOTPT is the number of output points -C -C Include files: -C - INCLUDE 'WNG_DEF' - INCLUDE 'STH_O_DEF' !SET HEADER - INCLUDE 'NMA_DEF' -C -C Parameters: -C -C -C Arguments: -C - BYTE STH(0:*) ! SET HEADER - REAL BASEL(0:*) ! BASELINES in metres - COMPLEX CMOD(0:3,0:STHIFR-1) ! INPUT DATA - COMPLEX CDAT(0:STHIFR-1,0:3) ! INPUT DATA - REAL APDAT(0:*) ! DATA WEIGHT - COMPLEX C0,C1 - COMPLEX FTBUF(0:NPTRF-1,0:1) !FT BUFFER (U,V) - REAL FTW(0:NPTRF-1) !FT WEIGHT BUFFER - !(FORWARD/REVERSE) - REAL FTBE(0:1,0:NPTRF-1) !U,V BUFFER - INTEGER FTBJ(0:NPTRF-1) !COUNT BUFFER - REAL UV0(0:1) !STANDARD UV - REAL UV(0:1,0:*) !UV - INTEGER NOTPT !# OF OUTPUT POINTS -C -C Function references: -C - INTEGER WNGGJ !GET VALUE -C -C Data declarations: -C - INTEGER NIFR ! # OF INTERFEROMETERS -C- -C -C INIT -C - NIFR=WNGGJ(STH(STH_NIFR_1)) ! # OF IFRS - CALL WNGMVZ(NPTRF*2*LB_X,FTBUF) !CLEAR DATA - CALL WNGMVZ(NPTRF*2*LB_E,FTBE) !CLEAR U,V - CALL WNGMVZ(NPTRF*LB_J,FTBJ) !CLEAR COUNT - CALL WNGMVZ(NPTRF*LB_E,FTW) !CLEAR WEIGHT -C -C CONVOLVE SCAN -C - DO I=NIFR-1,0,-1 - IF (APDAT(I).NE.0) THEN !PRESENT - R0=APDAT(I)*APDAT(I) !WEIGHT - IF (POLTJ(-1,0).EQ.1) THEN !ZERO OFFSET - DO I1=0,1 !Q,U - FTBUF(0,I1)=FTBUF(0,I1)+2*R0*CDAT(I,I1)* - 1 CONJG(CDAT(I,I1)) - END DO - FTBJ(0)=FTBJ(0)+1 !COUNT - FTW(0)=FTW(0)+2*R0 !WEIGHT - END IF - DO I1=I-1,0,-1 !POSITIVE SIDE - IF (APDAT(I1).NE.0) THEN - R0=APDAT(I)*APDAT(I1) !WEIGHT - J0=NINT((BASEL(I)-BASEL(I1))/BSTEP) !POINTER - DO I2=0,1 !Q,U - FTBUF(J0,I2)=FTBUF(J0,I2)+2*R0*CDAT(I,I2)* - 1 CONJG(CDAT(I1,I2)) - END DO - FTBJ(J0)=FTBJ(J0)+1 !COUNT - FTW(J0)=FTW(J0)+2*R0 !WEIGHT - DO I2=0,1 - FTBE(I2,J0)=FTBE(I2,J0)+UV(I2,I)-UV(I2,I1) !U,V - END DO - END IF - END DO - DO I1=0,I-1 !NEGATIVE SIDE - IF (APDAT(I1).NE.0) THEN - R0=APDAT(I)*APDAT(I1) !WEIGHT - J0=NINT((BASEL(I)+BASEL(I1))/BSTEP) !POINTER - DO I2=0,1 !Q,U - FTBUF(J0,I2)=FTBUF(J0,I2)+2*R0*CDAT(I,I2)* - 1 CDAT(I1,I2) - END DO - FTBJ(J0)=FTBJ(J0)+1 !COUNT - FTW(J0)=FTW(J0)+2*R0 !WEIGHT - DO I2=0,1 - FTBE(I2,J0)=FTBE(I2,J0)+UV(I2,I)+UV(I2,I1) !U,V - END DO - END IF - END DO - R0=APDAT(I)*APDAT(I1) !WEIGHT LAST POINT - J0=NINT((BASEL(I)+BASEL(I))/BSTEP) !POINTER - DO I2=0,1 !Q,U - FTBUF(J0,I2)=FTBUF(J0,I2)+R0*CDAT(I,I2)* - 1 CDAT(I,I2) - END DO - FTBJ(J0)=FTBJ(J0)+1 !COUNT - FTW(J0)=FTW(J0)+R0 !WEIGHT - DO I2=0,1 - FTBE(I2,J0)=FTBE(I2,J0)+UV(I2,I)+UV(I2,I) !U,V - END DO - END IF - END DO - J0=0 !OUTPUT POINTER - DO I=0,NPTRF-1 !NORMALISE - IF (FTW(I).NE.0) THEN - FTBUF(J0,0)=(FTBUF(I,0)+FTBUF(I,1))/FTW(I) !DATA - DO I1=0,1 !U,V - FTBE(I1,J0)=FTBE(I1,I)/FTBJ(I) !AVERAGE U,V - END DO - FTW(J0)=FTW(I) !WEIGHT - J0=J0+1 !COUNT POINTS - END IF - END DO - NOTPT=J0 !RETURN POINT COUNT -CC DO I=1,NPTRF/2-1 !FILL OTHER HALF -CCC DO I1=0,1 !Q,U -CC FTBUF(NPTRF-I,I1)=CONJG(FTBUF(I,I1)) -CC END DO -CC END DO -CC DO I1=0,1 -CC CALL WNMFTC(NPTRF,FTBUF(0,I1),FTW(0,0)) !TRANSFORM U,V -CC END DO -C -C MAKE P -C -CC DO I=0,NPTRF-1 -CC FLB(2*I)=SQRT(FTBUF(I,0)**2+FTBUF(I,1)**2) -CC FLB(2*I+1)=0 -CC R0=PI*I/REAL(NPTRF) -CC FLBW(I)=CMPLX(COS(R0),-SIN(R0)) -CC END DO -CCCC DO I=NPTRF/4,NPTRF/2-1 -CCCC FTBUF(I,0)=0 -CCCC FTBUF(NPTRF-I,0)=0 -CCCC END DO -CCC -CCC TRANSFORM BACK -CCC -CCCC CALL WNMFTC(NPTRF,FTBUF(0,0),FTW(0,1)) !TRANSFORM P -CC CALL WNMFTC(2*NPTRF,FLB(0),FLBW(0)) !TRANSFORM P -CC DO I=0,NIFR-1 !ALL DATA -CC IF (APDAT(I).NE.0) THEN -CC I1=NINT(BASEL(I)/BSTEP) !FT BIN -CCCC cdat(i,0)=0 -CCCC do i2=0,nptrf-1 -CCCC r0=pi2*i1*i2/real(nptrf) -CCCC cdat(i,0)=cdat(i,0)+ftbuf(i2,0)*cmplx(cos(r0),-sin(r0)) -CCCC end do -CCCC CDAT(I,0)=FTBUF(I1,0)/APDAT(I) -CC CDAT(I,0)=FLB(I1)/APDAT(I) -CC END IF -CC END DO -C -C READY -C - 900 CONTINUE -C - RETURN -C -C - END diff --git a/src/nmap/nmanvs.for b/src/nmap/nmanvs.for deleted file mode 100644 index 620872204885705716eaf56111a1c4981da61b09..0000000000000000000000000000000000000000 --- a/src/nmap/nmanvs.for +++ /dev/null @@ -1,91 +0,0 @@ -C+ NMANVS.FOR -C WNB 910327 -C -C Revisions: -C HjV 930311 Change some text -C - SUBROUTINE NMANVS -C -C Convert WMP file to newest format -C -C Result: -C -C CALL NMANVS will convert a WMP file to newest version -C -C Include files: -C - INCLUDE 'WNG_DEF' - INCLUDE 'NMA_DEF' - INCLUDE 'MPH_O_DEF' !SET HEADER -C -C Parameters: -C -C -C Arguments: -C -C -C Function references: -C - LOGICAL WNFRD !READ DATA - LOGICAL WNFWR !WRITE DATA - LOGICAL NMASTH !GET A SET WITH NO VERSION CHECK -C -C Data declarations: -C - INTEGER SET(0:7,0:1) !ALL SETS - INTEGER MPHP !SET HEADER POINTER - INTEGER SNAM(0:7) !SET NAME - BYTE MPH(0:MPHHDL-1) !SET HEADER - INTEGER*2 MPHI(0:MPHHDL/2-1) - INTEGER MPHJ(0:MPHHDL/4-1) - REAL MPHE(0:MPHHDL/4-1) - EQUIVALENCE (MPH,MPHI,MPHJ,MPHE) -C- -C -C INIT -C - DO I=0,7 !SET SET *.*.*.*.*.*.* - DO I1=0,1 - SET(I,I1)=0 - END DO - END DO - SET(0,0)=1 !1 LINE - DO I=0,7 - SET(I,1)=-1 !* - END DO -C -C DO ALL SETS -C - DO WHILE (NMASTH(FCAOUT,SET,MPH,MPHP,SNAM)) !GET SET -C -C MAKE FROM VERSION 1 -C - IF (MPHI(MPH_VER_I).EQ.1) THEN !STILL VERSION 1 - MPHI(MPH_LEN_I)=MPHHDL !NEW LENGTH - MPHI(MPH_VER_I)=MPHHDV !NEW VERSION - END IF !VERSION 1 -C -C FINISH -C - IF (.NOT.WNFWR(FCAOUT,MPHHDL,MPH(0),MPHP)) THEN !REWRITE SET HEADER -10 CONTINUE - CALL WNCTXT(F_TP,'!/Error rewriting Map Set(s)') - GOTO 900 - END IF - END DO -C -C READY -C - 800 CONTINUE - CALL WNFCL(FCAOUT) !CLOSE FILE -C - RETURN -C -C ERROR -C - 900 CONTINUE - CALL WNFCL(FCAOUT) !CLOSE FILE - RETURN !READY -C -C - END diff --git a/src/nmap/nmaofr.for b/src/nmap/nmaofr.for deleted file mode 100644 index 8cde93b36614038d0a12a9b618e6607c2917e7d7..0000000000000000000000000000000000000000 --- a/src/nmap/nmaofr.for +++ /dev/null @@ -1,198 +0,0 @@ -C+ NMAOFR.FOR -C WNB 910403 -C -C Revisions: -C WNB 930930 Use SMP -C HjV 950519 Make available for VAX R-series files -C - SUBROUTINE NMAOFR -C -C Load map data from old SMP file -C -C Result: -C -C CALL NMAOFR will load map data in WMP file from old SMP file -C -C Include files: -C - INCLUDE 'WNG_DEF' - INCLUDE 'NMA_DEF' - INCLUDE 'GFH_O_DEF' !GENERAL FILE HEADER - INCLUDE 'SGH_O_DEF' !SUB-GROUP HEADER - INCLUDE 'MPH_O_DEF' !MAP HEADER - INCLUDE 'SMP_O_DEF' !RMAP HEADER - INCLUDE 'SMP_T_DEF' -C -C Parameters: -C -C -C Arguments: -C -C -C Function references: -C - LOGICAL WNFOP,WNFOPF !OPEN FILE - LOGICAL WNFRD !READ DATA - LOGICAL WNFWR !WRITE DATA - INTEGER WNFEOF !FILE POSITION - INTEGER WNCALN !STRING LENGTH - LOGICAL WNDLNK !LINK SET - LOGICAL WNDLNG,WNDLNF !LINK GROUP - CHARACTER*32 WNTTSG !MAKE SUB-GROUP STRING -C -C Data declarations: -C - INTEGER FCAIN !INPUT FILE - REAL LBUF(0:8191) !DATA LINE - BYTE MPH(0:MPHHDL-1) !MAP HEADER - INTEGER*2 MPHI(0:MPHHDL/2-1) - INTEGER MPHJ(0:MPHHDL/4-1) - REAL MPHE(0:MPHHDL/4-1) - REAL*8 MPHD(0:MPHHDL/8-1) - EQUIVALENCE (MPH,MPHI,MPHJ,MPHE,MPHD) - BYTE OFH(0:SMP__L-1) !OLD FILE HEADER - CHARACTER*(SMP__L) OFHC - INTEGER*2 OFHI(0:SMP__L/LB_I-1) - INTEGER OFHJ(0:SMP__L/LB_J-1) - REAL OFHE(0:SMP__L/LB_E-1) - REAL*8 OFHD(0:SMP__L/LB_D-1) - EQUIVALENCE (OFH,OFHC,OFHI,OFHJ,OFHE,OFHD) - CHARACTER*32 SETSTR !GROUP NAME - INTEGER*2 DBH_T(0:1,0:1) !DATA TRANSLATION - DATA DBH_T/4,0,0,1/ -C- -C -C INIT -C - IF (.NOT.WNFOP(FCAIN,FILIN,'R')) THEN - 10 CONTINUE - CALL WNCTXT(F_TP,'!/I/O error input file') - GOTO 800 - END IF - IF (.NOT.WNFRD(FCAIN,SMP__L,OFH,0)) GOTO 10 !READ FILE HEADER - IF (DATTYP.NE.0) CALL WNTTTL(SMP__L,OFH,SMP_T,DATTYP) - IF (OFHC(1:4).NE.'.SMP') THEN - CALL WNCTXT(F_TP,'!/Input file not old SMP file') - GOTO 800 - END IF - IF (.NOT.WNDLNG(GFH_LINKG_1,0,SGH_GROUPN_1,FCAOUT, - 1 SGPH(0),SGNR(0))) THEN !MAKE JOB GROUP - 11 CONTINUE - CALL WNCTXT(F_TP,'!/Cannot create sub-group') - GOTO 800 - END IF - IF (.NOT.WNDLNG(SGPH(0)+SGH_LINKG_1,0,SGH_GROUPN_1,FCAOUT, - 1 SGPH(1),SGNR(1))) GOTO 11 !MAKE FIELD GROUP - IF (.NOT.WNDLNG(SGPH(1)+SGH_LINKG_1,0,SGH_GROUPN_1,FCAOUT, - 1 SGPH(2),SGNR(2))) GOTO 11 !MAKE CHANNEL GROUP - IF (.NOT.WNDLNG(SGPH(2)+SGH_LINKG_1,0,SGH_GROUPN_1,FCAOUT, - 1 SGPH(3),SGNR(3))) GOTO 11 !MAKE POLARISATION GROUP - IF (.NOT.WNDLNG(SGPH(3)+SGH_LINKG_1,0,SGH_GROUPN_1,FCAOUT, - 1 SGPH(4),SGNR(4))) GOTO 11 !MAKE MAP/AP GROUP - SGNR(5)=0 !FINISH - SGNR(6)=-1 - SETSTR=WNTTSG(SGNR(0),0) !GROUP NAME - CALL WNCTXT(F_TP,'Map !AS being copied to !AS', - 1 FILIN,SETSTR) - CALL WNGMVZ(MPHHDL,MPH(0)) !CLEAR MPH - MPHI(MPH_LEN_I)=MPHHDL !LENGTH - MPHI(MPH_VER_I)=MPHHDV !VERSION - CALL WNGMV(MPH_FNM_N,OFH(SMP_FNM_1),MPH(MPH_FNM_1)) !FIELD NAME - MPHE(MPH_EPO_E)=OFHE(SMP_EPO_E) !EPOCH - MPHD(MPH_RA_D)=OFHD(SMP_RA_D) !RA - MPHD(MPH_DEC_D)=OFHD(SMP_DEC_D) !DEC - MPHD(MPH_FRQ_D)=OFHD(SMP_FRQ_D) !FREQ - MPHD(MPH_BDW_D)=OFHD(SMP_BDW_D) !BANDWIDTH - MPHD(MPH_RAO_D)=OFHD(SMP_RAO_D) !OBS. RA - MPHD(MPH_DECO_D)=OFHD(SMP_DCO_D) !OBS. DEC - MPHD(MPH_FRQO_D)=OFHD(SMP_FRO_D) !OBS. FREQ - MPHI(MPH_ODY_I)=OFHI(SMP_ODY_I) !OBS. DAY - MPHI(MPH_OYR_I)=OFHI(SMP_OYR_I) !OBS. YEAR - MPHI(MPH_DCD_I)=OFHI(SMP_DCD_I) !DATA CODE - MPHI(MPH_PCD_I)=OFHI(SMP_PCD_I) !PROG. CODE - MPHD(MPH_SRA_D)=OFHD(SMP_SRA_D) !SEP. RA - MPHD(MPH_SDEC_D)=OFHD(SMP_SDC_D) !SEP. DEC - MPHD(MPH_SFRQ_D)=OFHD(SMP_SFR_D) !SEP. FREQ - MPHJ(MPH_NRA_J)=OFHI(SMP_NRA_I) !# RA - MPHJ(MPH_NDEC_J)=OFHI(SMP_NDC_I) !# DEC - MPHJ(MPH_NFRQ_J)=OFHI(SMP_NFR_I) !# FREQ - MPHJ(MPH_ZRA_J)=OFHI(SMP_ZRA_I) !0 RA - MPHJ(MPH_ZDEC_J)=OFHI(SMP_ZDC_I) !0 DEC - MPHJ(MPH_ZFRQ_J)=OFHI(SMP_ZFR_I) !0 FREQ - MPHJ(MPH_MXR_J)=OFHI(SMP_MXR_I) !MAX. POS. RA - MPHJ(MPH_MXD_J)=OFHI(SMP_MXD_I) !MAX. POS. DEC - MPHJ(MPH_MXF_J)=OFHI(SMP_MXF_I) !MAX. POS. FREQ - MPHJ(MPH_MNR_J)=OFHI(SMP_MNR_I) !MIN. POS. RA - MPHJ(MPH_MND_J)=OFHI(SMP_MND_I) !MIN. POS. DEC - MPHJ(MPH_MNF_J)=OFHI(SMP_MNF_I) !MIN. POS. FREQ - MPHE(MPH_MAX_E)=OFHE(SMP_MAX_E) !MAX. - MPHE(MPH_MIN_E)=OFHE(SMP_MIN_E) !MIN. - MPHD(MPH_SHR_D)=OFHD(SMP_SHR_D) !SHIFT RA - MPHD(MPH_SHD_D)=OFHD(SMP_SHD_D) !SHIFT DEC - MPHD(MPH_SHF_D)=OFHD(SMP_SHF_D) !SHIFT FREQ - MPHD(MPH_SUM_D)=OFHD(SMP_SUM_D) !NORM. SUM - MPHE(MPH_UNI_E)=OFHE(SMP_UNI_E) !UNIT FACTOR - CALL WNGMV(MPH_UCM_N,OFH(SMP_UCM_1),MPH(MPH_UCM_1)) !USER COMMENT - MPHJ(MPH_NPT_J)=OFHJ(SMP_NPT_J) !# OF POINTS - MPHJ(MPH_NBL_J)=OFHI(SMP_NBS_I) !# OF BASELINES - MPHJ(MPH_NST_J)=OFHI(SMP_NST_I) !# OF SETS - CALL WNGMV(MPH_TYP_N,OFH(SMP_TYP_1),MPH(MPH_TYP_1)) !MAP TYPE - CALL WNGMV(MPH_POL_N,OFH(SMP_POL_1),MPH(MPH_POL_1)) !POL. TYPE - DO I=0,7 !TAPER TYPE ETC - MPHI(MPH_CD_I+I)=OFHI(SMP_CD_I+I) - END DO - MPHI(MPH_EPT_I)=OFHI(SMP_EPT_I) !APP. TYPE - MPHE(MPH_OEP_E)=OFHE(SMP_OEP_E) !OBS. EPOCH - MPHE(MPH_NOS_E)=OFHE(SMP_NOS_E) !NOISE - MPHE(MPH_FRA_E)=OFHE(SMP_FRA_E) !FIELD RA - MPHE(MPH_FDEC_E)=OFHE(SMP_FDC_E) !FIELD DEC - MPHE(MPH_FFRQ_E)=OFHE(SMP_FFR_E) !FIELD FREQ - CALL WNGMV(MPH_TEL_N,OFH(SMP_TEL_1),MPH(MPH_TEL_1)) !TEL. NAME - MPHJ(MPH_FSR_J)=OFHI(SMP_FSR_I) !FFT SIZE RA - MPHJ(MPH_FSD_J)=OFHI(SMP_FSD_I) !FFT SIZE DEC - MPHJ(MPH_MDP_J)=WNFEOF(FCAOUT)+MPHHDL !MAP DATA POINTER - IF (.NOT.WNFWR(FCAOUT,MPHHDL,MPH(0),MPHJ(MPH_MDP_J)-MPHHDL)) - 1 THEN !WRITE MAP HEADER - 12 CONTINUE - CALL WNCTXT(F_TP,'!/Write error') - GOTO 800 - END IF -C -C COPY DATA -C - IF (MPHI(MPH_DCD_I).EQ.2) THEN - DBH_T(0,0)=2 !I - ELSE IF (MPHI(MPH_DCD_I).EQ.4) THEN - DBH_T(0,0)=3 !J - ELSE IF (MPHI(MPH_DCD_I).EQ.5) THEN - DBH_T(0,0)=4 !E - ELSE IF (MPHI(MPH_DCD_I).EQ.8) THEN - DBH_T(0,0)=5 !D - ELSE - DBH_T(0,0)=4 !ASSUME E - END IF - DBH_T(1,0)=LB_E*MPHJ(MPH_NRA_J) - J=DBH_T(1,0) - DO I=0,MPHJ(MPH_NDEC_J)-1 !ALL LINES - IF (.NOT.WNFRD(FCAIN,LB_E*MPHJ(MPH_NRA_J),LBUF, - 1 SMP__L+I*LB_E*MPHJ(MPH_NRA_J))) - 1 GOTO 10 !READ LINE - IF (DATTYP.NE.0) CALL WNTTTL(J,LBUF,DBH_T,DATTYP) - IF (.NOT.WNFWR(FCAOUT,LB_E*MPHJ(MPH_NRA_J),LBUF, - 1 MPHJ(MPH_MDP_J)+I*LB_E*MPHJ(MPH_NRA_J))) - 1 GOTO 12 !WRITE LINE - END DO - IF (.NOT.WNDLNK(GFH_LINK_1,MPHJ(MPH_MDP_J)-MPHHDL, - 1 MPH_SETN_1,FCAOUT)) GOTO 12 !LINK SET - IF (.NOT.WNDLNG(SGPH(4)+SGH_LINKG_1,MPHJ(MPH_MDP_J)-MPHHDL, - 1 SGH_GROUPN_1,FCAOUT, - 1 SGPH(5),SGNR(5))) GOTO 11 !MAKE DATA GROUP -C - 800 CONTINUE - CALL WNFCL(FCAIN) !CLOSE INPUT - CALL WNFCL(FCAOUT) !CLOSE OUTPUT -C - RETURN !READY -C -C - END diff --git a/src/nmap/nmaoto.for b/src/nmap/nmaoto.for deleted file mode 100644 index a61621d8fd136b3500b2aca5b7c4a2ec7aa3a6de..0000000000000000000000000000000000000000 --- a/src/nmap/nmaoto.for +++ /dev/null @@ -1,188 +0,0 @@ -C+ NMAOTO.FOR -C WNB 910403 -C -C Revisions: -C WNB 911023 Correct APT type -C WNB 930930 Use SMP -C AXC 010709 Linux port - APT string -C - SUBROUTINE NMAOTO -C -C Load map data into old SMP file -C -C Result: -C -C CALL NMAOTO will load map data in old SMP file from WMP file -C -C Include files: -C - INCLUDE 'WNG_DEF' - INCLUDE 'NMA_DEF' - INCLUDE 'GFH_O_DEF' !GENERAL FILE HEADER - INCLUDE 'MPH_O_DEF' !MAP HEADER - INCLUDE 'SMP_O_DEF' !RMAP HEADER -C -C Parameters: -C -C -C Arguments: -C -C -C Function references: -C - LOGICAL WNFOP,WNFOPF !OPEN FILE - LOGICAL WNFRD !READ DATA - LOGICAL WNFWR !WRITE DATA - INTEGER WNFEOF !FILE POSITION - INTEGER WNCALN !STRING LENGTH - LOGICAL WNDLNK !LINK SET - LOGICAL WNDLNG,WNDLNF !LINK GROUP - CHARACTER*32 WNTTSG !MAKE SUB-GROUP STRING - LOGICAL NMASTG !GET A MAP -C -C Data declarations: -C - INTEGER OMCA !OUTPUT FILE - INTEGER OFILN !OUTPUT FILE # - CHARACTER*160 OFILE !OUTPUT FILE NMAE - REAL LBUF(0:8191) !DATA LINE - INTEGER MPHP !MAP HEADER POINTER - BYTE MPH(0:MPHHDL-1) !MAP HEADER - INTEGER*2 MPHI(0:MPHHDL/2-1) - INTEGER MPHJ(0:MPHHDL/4-1) - REAL MPHE(0:MPHHDL/4-1) - REAL*8 MPHD(0:MPHHDL/8-1) - EQUIVALENCE (MPH,MPHI,MPHJ,MPHE,MPHD) - BYTE GFH(0:GFHHDL-1) !GENERAL FILE HEADER - INTEGER GFHJ(0:GFHHDL/4-1) - EQUIVALENCE (GFH,GFHJ) - BYTE OFH(0:SMP__L-1) !OLD FILE HEADER - CHARACTER*(SMP__L) OFHC - INTEGER*2 OFHI(0:SMP__L/LB_I-1) - INTEGER OFHJ(0:SMP__L/LB_J-1) - REAL OFHE(0:SMP__L/LB_E-1) - REAL*8 OFHD(0:SMP__L/LB_D-1) - EQUIVALENCE (OFH,OFHC,OFHI,OFHJ,OFHE,OFHD) - CHARACTER*32 SETSTR !GROUP NAME -C- -C -C INIT -C - OFILN=0 !OUTPUT COUNT - 100 CONTINUE - OFILN=OFILN+1 !NEXT OUTPUT - CALL WNCTXS(OFILE,'!AS\.!6$ZJ',FILIN,OFILN) !MAKE FILE NAME -C -C GET A MAP -C - IF (.NOT.NMASTG(FCAOUT,SETS,MPH,MPHP,SGNR)) GOTO 800 !NO MORE MAPS - IF (.NOT.WNFOP(OMCA,OFILE,'W')) THEN - 10 CONTINUE - CALL WNCTXT(F_TP,'!/I/O error output file') - GOTO 800 - END IF - IF (.NOT.WNFRD(FCAOUT,GFHHDL,GFH,0)) THEN !READ FILE HEADER - 11 CONTINUE - CALL WNCTXT(F_TP,'!/I/O error input file') - GOTO 800 - END IF -C -C MAKE FILE HEADER -C - CALL WNGMVZ(SMP__L,OFH) !CLEAR HEADER - CALL WNGMFS(4,'.SMP',OFH(SMP_ID_1)) !ID - OFHI(SMP_LEN_I)=SMP__L !LENGTH - CALL WNGMV(32,GFH(GFH_CDAT_1),OFH(SMP_CRD_1)) !CREATION/UPD. DATES/TIMES - OFHI(SMP_RVN_I)=GFHJ(GFH_RCNT_J) !REV. COUNT - OFHI(SMP_VER_I)=4 !VERSION - OFHJ(SMP_MLH_J)=SMP__L !LINK TO MAP - SETSTR=WNTTSG(SGNR(0),0) !GROUP NAME - CALL WNCTXT(F_TP,'Map !AS being copied to !AS', - 1 SETSTR,OFILE) - CALL WNGMV(MPH_FNM_N,MPH(MPH_FNM_1),OFH(SMP_FNM_1)) !FIELD NAME - OFHE(SMP_EPO_E)=MPHE(MPH_EPO_E) !EPOCH - OFHD(SMP_RA_D)=MPHD(MPH_RA_D) !RA - OFHD(SMP_DEC_D)=MPHD(MPH_DEC_D) !DEC - OFHD(SMP_FRQ_D)=MPHD(MPH_FRQ_D) !FREQ - OFHD(SMP_BDW_D)=MPHD(MPH_BDW_D) !BANDWIDTH - OFHD(SMP_RAO_D)=MPHD(MPH_RAO_D) !OBS. RA - OFHD(SMP_DCO_D)=MPHD(MPH_DECO_D) !OBS. DEC - OFHD(SMP_FRO_D)=MPHD(MPH_FRQO_D) !OBS. FREQ - OFHI(SMP_ODY_I)=MPHI(MPH_ODY_I) !OBS. DAY - OFHI(SMP_OYR_I)=MPHI(MPH_OYR_I) !OBS. YEAR - OFHI(SMP_DCD_I)=MPHI(MPH_DCD_I) !DATA CODE - OFHI(SMP_PCD_I)=MPHI(MPH_PCD_I) !PROG. CODE - OFHD(SMP_SRA_D)=MPHD(MPH_SRA_D) !SEP. RA - OFHD(SMP_SDC_D)=MPHD(MPH_SDEC_D) !SEP. DEC - OFHD(SMP_SFR_D)=MPHD(MPH_SFRQ_D) !SEP. FREQ - OFHI(SMP_NRA_I)=MPHJ(MPH_NRA_J) !# RA - OFHI(SMP_NDC_I)=MPHJ(MPH_NDEC_J) !# DEC - OFHI(SMP_NFR_I)=MPHJ(MPH_NFRQ_J) !# FREQ - OFHI(SMP_ZRA_I)=MPHJ(MPH_ZRA_J) !0 RA - OFHI(SMP_ZDC_I)=MPHJ(MPH_ZDEC_J) !0 DEC - OFHI(SMP_ZFR_I)=MPHJ(MPH_ZFRQ_J) !0 FREQ - OFHI(SMP_MXR_I)=MPHJ(MPH_MXR_J) !MAX. POS. RA - OFHI(SMP_MXD_I)=MPHJ(MPH_MXD_J) !MAX. POS. DEC - OFHI(SMP_MXF_I)=MPHJ(MPH_MXF_J) !MAX. POS. FREQ - OFHI(SMP_MNR_I)=MPHJ(MPH_MNR_J) !MIN. POS. RA - OFHI(SMP_MND_I)=MPHJ(MPH_MND_J) !MIN. POS. DEC - OFHI(SMP_MNF_I)=MPHJ(MPH_MNF_J) !MIN. POS. FREQ - OFHE(SMP_MAX_E)=MPHE(MPH_MAX_E) !MAX. - OFHE(SMP_MIN_E)=MPHE(MPH_MIN_E) !MIN. - OFHD(SMP_SHR_D)=MPHD(MPH_SHR_D) !SHIFT RA - OFHD(SMP_SHD_D)=MPHD(MPH_SHD_D) !SHIFT DEC - OFHD(SMP_SHF_D)=MPHD(MPH_SHF_D) !SHIFT FREQ - OFHD(SMP_SUM_D)=MPHD(MPH_SUM_D) !NORM. SUM - OFHE(SMP_UNI_E)=MPHE(MPH_UNI_E) !UNIT FACTOR - CALL WNGMV(MPH_UCM_N,MPH(MPH_UCM_1),OFH(SMP_UCM_1)) !USER COMMENT - OFHJ(SMP_NPT_J)=MPHJ(MPH_NPT_J) !# OF POINTS - OFHI(SMP_NBS_I)=MPHJ(MPH_NBL_J) !# OF BASELINES - OFHI(SMP_NST_I)=MPHJ(MPH_NST_J) !# OF SETS - CALL WNGMV(MPH_TYP_N,MPH(MPH_TYP_1),OFH(SMP_TYP_1)) !MAP TYPE - IF (MPHI(MPH_TYP_1/LB_I).EQ. - 1 ICHAR('A')*256+ICHAR('P')) THEN !SET APT - OFH(SMP_TYP_1)=ICHAR('A') - OFH(SMP_TYP_1+1)=ICHAR('P') - OFH(SMP_TYP_1+2)=ICHAR('T') - OFH(SMP_TYP_1+3)=ICHAR(' ') - END IF - CALL WNGMV(MPH_POL_N,MPH(MPH_POL_1),OFH(SMP_POL_1)) !POL. TYPE - DO I=0,7 !TAPER TYPE ETC - OFHI(SMP_CD_I+I)=MPHI(MPH_CD_I+I) - END DO - OFHI(SMP_EPT_I)=MPHI(MPH_EPT_I) !APP. TYPE - OFHE(SMP_OEP_E)=MPHE(MPH_OEP_E) !OBS. EPOCH - OFHE(SMP_NOS_E)=MPHE(MPH_NOS_E) !NOISE - OFHE(SMP_FRA_E)=MPHE(MPH_FRA_E) !FIELD RA - OFHE(SMP_FDC_E)=MPHE(MPH_FDEC_E) !FIELD DEC - OFHE(SMP_FFR_E)=MPHE(MPH_FFRQ_E) !FIELD FREQ - CALL WNGMV(MPH_TEL_N,MPH(MPH_TEL_1),OFH(SMP_TEL_1)) !TEL. NAME - OFHI(SMP_FSR_I)=MPHJ(MPH_FSR_J) !FFT SIZE RA - OFHI(SMP_FSD_I)=MPHJ(MPH_FSD_J) !FFT SIZE DEC - IF (.NOT.WNFWR(OMCA,SMP__L,OFH,0)) - 1 THEN !WRITE MAP HEADER - 12 CONTINUE - CALL WNCTXT(F_TP,'!/Write error') - GOTO 800 - END IF -C -C COPY DATA -C - DO I=0,MPHJ(MPH_NDEC_J)-1 !ALL LINES - IF (.NOT.WNFRD(FCAOUT,LB_E*MPHJ(MPH_NRA_J),LBUF, - 1 MPHJ(MPH_MDP_J)+I*LB_E*MPHJ(MPH_NRA_J))) - 1 GOTO 10 !READ LINE - IF (.NOT.WNFWR(OMCA,LB_E*MPHJ(MPH_NRA_J),LBUF, - 1 SMP__L+I*LB_E*MPHJ(MPH_NRA_J))) - 1 GOTO 12 !WRITE LINE - END DO - CALL WNFCL(OMCA) !CLOSE OUTPUT - GOTO 100 !TRY FOR MORE -C - 800 CONTINUE - CALL WNFCL(FCAOUT) !CLOSE INPUT -C - RETURN !READY -C -C - END diff --git a/src/nmap/nmap.for b/src/nmap/nmap.for deleted file mode 100644 index 1f5bccbdaf56101b400c68076dd08226bde835fb..0000000000000000000000000000000000000000 --- a/src/nmap/nmap.for +++ /dev/null @@ -1,112 +0,0 @@ -C+ NMAP.FOR -C WNB 910219 -C -C Revisions: -C WNB 910828 Add run option -C WNB 911104 Add mosaic combine -C WNB 920811 Add loops for Fiddle sums -C WNB 921119 Add WRLFITS -C WNB 930929 Add Fiddle LOAD -C WNB 930930 Use Fiddle codes -C HjV 940714 Add RFITS -C JPH 950117 Return to NMADAT after most actions -C -C - SUBROUTINE NMAP -C -C Main routine to handle Map files -C -C Result: -C -C -C Include files: -C - INCLUDE 'WNG_DEF' - INCLUDE 'NMA_DEF' -C -C Parameters: -C -C -C Arguments: -C -C -C Function references: -C - LOGICAL WNDXLN !TEST LOOP - LOGICAL WNDRUN !TEST RUN OPTION -C -C Data declarations: -C - INTEGER FCADUM !DUMMY FCA - DATA FCADUM/0/ -C- -C -C PRELIMINARIES -C - CALL NMAINI !INIT PROGRAM -C -C DISTRIBUTE -C - 11 CONTINUE - OPT=' ' !MAKE SURE NOT FIDDLE - 10 CONTINUE - CALL NMADAT !GET USER DATA - IF (OPT.EQ.'MAK') THEN !MAKE MAPS - IF (.NOT.WNDRUN()) CALL WNGEX !DO NOT RUN - CALL NMAMAK - GOTO 10 - ELSE IF (OPT.EQ.'SHO') THEN !SHOW MAP DATA - CALL NMAPRT - GOTO 10 !RETRY - ELSE IF (OPT.EQ.'FRO') THEN !FROM OLD FORMAT - CALL NMAOFR - GOTO 10 !RETRY - ELSE IF (OPT.EQ.'TO_') THEN !TO OLD FORMAT - IF (.NOT.WNDRUN()) CALL WNGEX !DO NOT RUN - CALL NMAOTO - ELSE IF (OPT.EQ.'RFI') THEN !READ FITS - IF (.NOT.WNDRUN()) CALL WNGEX !DO NOT RUN - CALL NMARFT - GOTO 10 - ELSE IF (OPT.EQ.'W16') THEN !16 BITS FITS - IF (.NOT.WNDRUN()) CALL WNGEX !DO NOT RUN - CALL NMAWFT(16) - GOTO 10 - ELSE IF (OPT.EQ.'W32') THEN !32 BITS FITS - IF (.NOT.WNDRUN()) CALL WNGEX !DO NOT RUN - CALL NMAWFT(32) - GOTO 10 - ELSE IF (OPT.EQ.'WRL') THEN !32 BITS REAL FITS - IF (.NOT.WNDRUN()) CALL WNGEX !DO NOT RUN - CALL NMAWFT(-32) - GOTO 10 - ELSE IF (OPT.EQ.'CVX') THEN !CONVERT VAX TO LOCAL - CALL NMAXCV - GOTO 10 !RETRY - ELSE IF (OPT.EQ.'NVS') THEN !MAKE NEWEST VERSION - CALL NMANVS - GOTO 10 !RETRY - ELSE IF (OPT.EQ.'FID') THEN !FIDDLE - CALL WNDXLI(LPOFF) !INIT LOOPS - CALL WNDSTR(FCADUM,SETS(0,0,1)) !RESET SET SEARCH - CALL WNDSTR(FCADUM,SETS(0,0,2)) !RESET SET SEARCH - IF (DATTYP.LE.FID_DUM) THEN !QUIT - GOTO 11 - ELSE IF (DATTYP.GE.FID_RHO) THEN !LOAD/UNLOAD FOREIGN - CALL NMAFLD(DATTYP) - ELSE IF (DATTYP.GE.FID_MOS) THEN !MOSAIC COMBINE - CALL NMAFMC(DATTYP) - ELSE IF (DATTYP.GE.FID_SUM .AND. DATTYP.LT.FID_EXT) THEN !SUM'S - DO WHILE (WNDXLN(LPOFF)) !LOOP - CALL NMAFID(DATTYP) !DO FIDDLE - END DO - ELSE - CALL NMAFID(DATTYP) !DO FIDDLE - END IF - GOTO 10 !RETRY - END IF -C - RETURN !READY -C -C - END diff --git a/src/nmap/nmap.pef b/src/nmap/nmap.pef deleted file mode 100644 index c7b6a35fb6369a9d848aec6dc50ba940327f736d..0000000000000000000000000000000000000000 --- a/src/nmap/nmap.pef +++ /dev/null @@ -1,217 +0,0 @@ -!+ NMAP.PEF -! WNB 910219 -! -! Revisions: -! WNB 910815 Circular UV_AREA -! WNB 910820 Add extinction, refraction, Faraday -! WNB 910822 Add FIDDLE -! WNB 910828 Add RUN -! WNB 910909 Add DATAB and INFIX -! WNB 910911 Add NSUM -! WNB 910912 Add other sums -! WNB 910913 New (de-)apply, loops -! WNB 910918 Text magtapes -! WNB 911007 Add instrum. pol. -! WNB 911104 Add mosaic combine -! WNB 911105 Add EDIT keyword -! WNB 911230 NMODEL -! WNB 920626 Add DCLOW, change Rotation measure description -! WNB 920811 Add USE_NOISE -! WNB 920817 Add circular weight -! WNB 920818 Add FITS_SCALE -! WNB 921022 Text magtapes -! WNB 921104 Text select ifrs; J2000 -! WNB 921119 Add WRLFITS, CUBIC -! WNB 921201 Larger map size; default memory -! WNB 921202 Reorganise for data clean -! WNB 921211 Make PEF -! JEN 930308 Remove keyword(s) SETS (now UVDAT_SETS in NSETS.PEF) -! JEN 930312 Remove keyword(s) SCAN_NODE -! JEN 930312 Remove keyword(s) SELECT_IFRS, HA_RANGE -! WNB 931216 Remove UNITS=M (problems dw, cv,..) -! WNB 931221 UNITS=M ok -! JPH 941005 Help texts -! JPH 941013 Remove invalid NULL_VALUES, WILDCARDS -! USER_COMMENT, QDATAS, UV_ARREA, CLIP_AREA, CLIP_LEVELS -! to NMAP.PSC -! Remove UNITS, put units in prompts. (First tried -! UNITS="m" but this failed.) -! Many changes in texts -! -! -! Work memory size -! Ref: NMADAT -! -KEYWORD=MEMORY_USE - DATA_TYP=J - IO=I - CHECKS=MINIMUM,MAXIMUM - MINIMUM=20000 - MAXIMUM=4000000 - SEARCH=L,P - DEFAULT=200000 /NOASK - PROMPT="Work memory size" - HELP=" -Specify an approximate value for the work memory size to be used in the -transform (bytes)." -! -! Specify map details -! Ref: NMADAT -! -KEYWORD=QMAPS - DATA_TYP=L - IO=I -!! SWITCH=NULL_VALUES - SEARCH=L,P - PROMPT="UV taper/convolution details?" - DEFAULTS=NO - HELP=" -The standard defaults used for the taper and convolution functions in the -map-making process will produce maps of excellent quality for normal -applications at an acceptable expense of computing resources. -. -There may be particular situations, however, where a non-standard taper and/or -convolution function is more suitable. Answer YES if you want to make your own -selection out of the possible options." -! -! Uniform coverage -! Ref: NMADAT -! -KEYWORD=UNIFORM - DATA_TYP=C - LENGTH=8 - IO=I - SWITCH=LOOP - CHECKS=ABBREV_OPTIONS - OPTIONS=NATURAL,STANDARD,FULL - SEARCH=L,P - PROMPT="Measure function for UV coverage" - HELP=" -Specify the way the UV coverage should be determined: -. - STANDARD: Weigh each observed point with the track length it covers in - the UV plane, and average sets of redundant baselines. This - method accounts properly for the fact that the density of - measured points is inversely proportional to the baseline, - for the multiplicity of redundant baselines and for - variations in integration times. -. - FULL: Weigh each point according to the actual UV point density. In - this case care is also taken of all local UV plane density - enhancements, e.g. because there is overlap between - observations. -. - NATURAL: Take each individual measured point separately, without - weighing for the UV track covered by it. This option gives - the maximum possible signal/noise ratio in your map, but it - generally weighs the short baselines much too heavily which - results in a very fat synthesized beam. -. -Of these options, FULL gives the cleanest synthesized beam, but it is slower -because it necessitates an extra read pass over the .SCN-file data." -! -! Get taper width -! Ref: NMADAT -! -KEYWORD=TAPER_VALUE - DATA_TYP=R - IO=I - SWITCH=LOOP,NULL_VALUES - CHECKS=MINIMUM - MINIMUM=10. - SEARCH=L,P -!! UNITS="m" - PROMPT="Taper half-width (metres)" - HELP=" -Specify the baseline in metres of the taper function at which the taper -function will fall to 1/e of its central value. -. -The default is defined such that the taper function you selected has a value of -1/4 for a baseline length of 3000 m." -! -! Circular weight type -! Ref: NMADAT -! -KEYWORD=CWEIGHT_TYPE - DATA_TYP=C - IO=I - LENGTH=8 - SWITCH=LOOP - CHECKS=ABBREV_OPTIONS - OPTIONS=GAUSS,LINEAR,NATURAL - SEARCH=L,P - PROMPT="Circular weight type" - HELP=" -ON TOP of the standard taper function which is circular in the equatorial UV -plane, you nay specify a taper that is circular in the projected UV plane (i.e. -the plane as seen from the field centre). You can select one out of the -following functions: -. - GAUSS exp -(<projected baseline>/CWEIGHT_VALUE)**2 -. - LINEAR max (0, 1-<projected baseline>/CWEIGHT_VALUE) -. - NATURAL unity weight everywhere, i.e. no circular taper -. -NOTE that the circular weighing does not replace the standard tapering, but is -applied as an EXTRA weight function. This is probably not what you want; you -may eliminate the normal tapering by specifying TAPER=NATURAL and -UNIFORM=STANDARD to take into account the radial density dependence of measured -visibilities." -! -! Get circular weight width -! Ref: NMADAT -! -KEYWORD=CWEIGHT_VALUE - DATA_TYP=R - IO=I - SWITCH=LOOP - CHECKS=MINIMUM - MINIMUM=10. - SEARCH=L,P -!! UNITS="m" - DEFAULT=2548. - PROMPT="Circular-weight width (metres)" - HELP=" -Specify the width for your circular weight function. -. -If you have selected a gaussian for the circular_weight function -(CWEIGHT_TYPE=GAUSS), the value you specify here will be the projected baseline -radius for which the weight is 1/e times its value in the origin. The default -value makes the weight equal to 1/4 at a projected baseline of 3000 m. -. -If you have selected a triangular weight function (CWEIGHT_TYPE=LINEAR), the -value you specify here is the projected baseline at which the weight reaches -zero." -! -! Select UV area -! Ref: NMADAT -! -KEYWORD=UV_AREA - DATA_TYP=R - IO=I - NVALUES=2 - SWITCH=LOOP,VECTOR - CHECKS=MINIMUM - MINIMUM=0.,0. - DEFAULTS=0.,100000. - SEARCH=L,P -!! UNITS="m" - PROMPT="projected UV radius range (metres)" - HELP=" -Specify the range of PROJECTED baselines for which you want to include the data. -. -You may use this option, - at the expense of throwing away data -, for such -purposes as -. - - To make the projected synthesised aperture and hence the synthesised - beam somewhat more circularly symmetric. -. - - To exclude noise from long projected baselines where you know there is - no signal of interest. -. - - To eliminate data from the short baselines, e.g. to suppress - interference. -. -The default is not to eliminate any baselines." -!- diff --git a/src/nmap/nmap.psc b/src/nmap/nmap.psc deleted file mode 100644 index d46360b6216d59becea277bfbb6f1661baf41e07..0000000000000000000000000000000000000000 --- a/src/nmap/nmap.psc +++ /dev/null @@ -1,1296 +0,0 @@ -!+ NMAP.PSC -! WNB 910219 -! -! Revisions: -! WNB 910815 Circular UV_AREA -! WNB 910820 Add extinction, refraction, Faraday -! WNB 910822 Add FIDDLE -! WNB 910828 Add RUN -! WNB 910909 Add DATAB and INFIX -! WNB 910911 Add NSUM -! WNB 910912 Add other sums -! WNB 910913 New (de-)apply, loops -! WNB 910918 Text magtapes -! WNB 911007 Add instrum. pol. -! WNB 911104 Add mosaic combine -! WNB 911105 Add EDIT keyword -! WNB 911230 NMODEL -! WNB 920626 Add DCLOW, change Rotation measure description -! WNB 920811 Add USE_NOISE -! WNB 920817 Add circular weight -! WNB 920818 Add FITS_SCALE -! WNB 921022 Text magtapes -! WNB 921104 Text select ifrs; J2000 -! WNB 921119 Add WRLFITS, CUBIC -! WNB 921201 Larger map size; default memory -! WNB 921202 Reorganise for data clean -! WNB 921211 Make PSC -! JEN 930308 INCLUDE=NSETS_PEF, remove keyword MAPS -! JEN 930312 INCLUDE=NCOMM_PEF -! JEN 930312 Remove keyword(s) INPUT_MAP, OUTPUT_MAP, INOUT_MAP -! JEN 930312 Remove keyword(s) OUTPUT_UNIT -! HjV 930426 Change name keywords NODE_1, NODE_2 ,MAPS_1, MAPS_2 -! WNB 930602 Add WGT_LIMIT -! WNB 930826 Change Stokes text -! WNB 930928 Continuation lines -! WNB 930929 Text FILENAME; Add Fiddle LOAD, LOAD_OPTION -! WNB 930930 Add UNLOAD -! WNB 921215 Describe new EDIT; use NSHOW_PEF -! CMV 940506 Increase max. mapsize for MOSCOM -! HjV 940518 Add OLD_DATTYP -! HjV 940714 Add RFITS as option for OPTION -! JPH 940913 Correct WMP_SET_1/2 prompts -! Remove () from prompts -! JPH 940923 NSETS --> WMPSETS, SCNSETS -! JPH 940929 FIELD_CENTRE -! JPH 941013 Remove WILD_CARDS and NULL_VALUES where they are invalid -! USER_COMMENT, QDATAS, UV_ARREA,CLIP_AREA, CLIP_LEVELS -! from NMAP.PEF -! Remove CONVOL_WIDTH -! Remove UNITS=M, put metres in prompts. (First tried -! UNITS="m" but this failed.) -! HA_RESOLUTION in UT rather than ST seconds -! Many changes in texts -! JPH 941107 Correct CLIP_LEVEL help text. -! JPH 941116 CLIP_LEVEL NON_DESCENDING -! JPH 941117 Fine-tuning. \textrefs -! JPH 950112 LENGTHs back to low values. - Minor text changes. -! Remove all UNITS -! JPH 950126 Correct HELP text for MAP_COORD -! JPH 950207 More HELP text -! CMV 951113 Add option CSUM/RSUM for complex summation -! JPH 960402 Help user in HOLOG chaos: HOLOG --> OLDHOLOG, NEWHOLOG -! as synonym for WMP -! JPH 960814 Prompt texts -! JPH 961112 Help texts -! WNB 061023 Changed max FT size to 8192 -! -! -! Get overall action -! Ref: NMADAT -! -KEYWORD=OPTION - DATA_TYP=C - IO=I - LENGTH=8 - CHECKS=ABBREV_OPTIONS - SWITCHES=LOOP - SEARCH=L,P - PROMPT="Action|" - OPTIONS=- -MAKE,FIDDLE; W16FITS,W32FITS,WRLFITS, RFITS; SHOW; QUIT;|- -[FROM_OLD,TO_OLD, CVX,NVS] - HELP=" -Specify action to perform: -. - Primary operations: - MAKE make map(s) from visibility data in .SCN file - FIDDLE combine or change maps in .WMP file -. - FITS conversions: - W16FITS write FITS tape/disk with 16 bits data - W32FITS write FITS tape/disk with 32 bits data - WRLFITS write FITS tape/disk with 32 bits float data - RFITS read FITS tape/disk data -. - Miscellaneous: - SHOW show/edit map data - QUIT finish -. - Format conversions: - CVX convert a map file from other machine's format to local - machine's - NVS convert a map file to newest version. Needs to be run only if - indicated by program - FROM_OLD convert from R-series format - TO_OLD convert to R-series format " -! -! Get Fiddle action -! Ref: NMADAT -! -KEYWORD=FIDDLE_OPTION - DATA_TYP=C - IO=I - LENGTH=8 - CHECKS=ABBREV_OPTIONS - SWITCHES=LOOP - SEARCH=L,P - PROMPT="Fiddle action|" - OPTIONS=- -BEAM,DEBEAM, FACTOR; EXTRACT, COPY, LOAD;|- -ADD,AVER, POL,ANGLE; SUM,CSUM,RSUM,MOSCOM; QUIT - HELP=" -Specify action to perform. -. - In-place modifications: Modify data of (an) input image(s): -. - BEAM correct map for primary beam attenuation so it will represent - the 'true' sky - DEBEAM apply primary beam attenuation to map so it will reprsent the - product of the 'true' sky and the primary beam - FACTOR multiply image with a constant factor -. - Unary operations: Create 1 new image from each input image: -. - EXTRACT extract an area from (a) image(s) - COPY copy image(s) - LOAD read or write (an) image(s) in a foreign format (e.g. Holog) -. - Binary combinations: make (a) new output image(s) from (a) pair(s) of input - images: -. - ADD weighted sum of two images: F1*image1 + F2*image2 - AVER weighted average of two images: - (F1*image1 + F2*image2) / [abs(F1) + abs(F2)] - POL degree of linear polarisation from Q and U maps: - sqrt (Qmap**2 + Umap**2)] - ANGLE polarisation orientation (radians) from Q and U maps: - 0.5*atan (Umap / Qmap) -. - Combinations of more than two images: -. - SUM weighted summation of (a) set(s) of images in a single .WMP file - (you will be prompted to select the weighing method) - CSUM weighted summation of pairs of images. You will be prompted - for (a) set(s) of "real" images and (a) set(s) of - "imaginary" images and complex weighting factors. - RSUM idem, but the complex weighting factors will be calculated - based on a specified rotation measure. - MOSCOM 'mosaic combine': merge a set of maps (generally for different - field centres) into one output map -. - Miscellaneous: -. - QUIT Return to OPTIONS level " -! -! Specify cube output FITS -! Ref: NMADAT -! -KEYWORD=CUBIC - DATA_TYP=L - IO=I - SEARCH=L,P - PROMPT="Make line cube (Yes/No) ?" - HELP=" -Specify if you want to output the FITS maps in one cube or in separate maps" -! -! Specify noise use in MOSCOM -! Ref: NMADAT -! -KEYWORD=USE_NOISE - DATA_TYP=L - IO=I - SEARCH=L,P - PROMPT="Weigh with noise (Yes/No) ?" - HELP=" -Specify if you want the noise of the individual maps to be used as a weight in -the MOSCOM combination" -! -! Specify lowest relative weight for MOSCOM -! Ref: NMADAT -! -KEYWORD=WGT_LIMIT - DATA_TYP=R - IO=I - SEARCH=L,P - CHECKS=MAXIMUM,MINIMUM - MAXIMUM=1. - MINIMUM=0. - PROMPT="Relative weight limit" - HELP=" -Specifies the relative weight as compared to the expected maximum weight of -data points combined on one line, below which no output will be generated" -! -! Get Sum action -! Ref: NMADAT -! -KEYWORD=SUM_OPTION - DATA_TYP=C - IO=I - LENGTH=8 - CHECKS=ABBREV_OPTIONS - SWITCHES=LOOP - SEARCH=L,P - OPTIONS=SUM,NSUM,NSSUM, BSUM,BNSUM, FSUM; QUIT - PROMPT="Weighing method" - HELP=" -Specify the type of weight to use in the averaging. In all cases the summation -produces a weighted average map over all SETS_1, the weights depending on the -method you select: -. - SUM weight(i)= 1 - NSUM weight(i)= normalisation factor of map(i) - NSSUM weight(i)= 1 / (<noise in map(i)>**2) -. - BSUM weight(i)= bandwidth of map(i) - BNSUM weight(i)= bandwidth * normalisation factor of map(i) -. - FSUM weight(i)= factors to be specified by you. -. - QUIT quit AVERaging" -! -! Get Load action -! Ref: NMADAT -! -KEYWORD=LOAD_OPTION - DATA_TYP=C - IO=I - LENGTH=8 - CHECKS=ABBREV_OPTIONS - SWITCHES=LOOP - SEARCH=L,P - OPTIONS=WMP, UNLOAD; NEWHOLOG, [OLDHOLOG]; QUIT - PROMPT="Load action/image type |" - HELP=" -Specify the type of foreign map and what to do with it: -. - WMP read WMP format maps from contiguous binary file - UNLOAD inverse of WMP: write WMP maps to contiguous binary file - this option can also be used to load in an SAOIMAGE file - (specify a data offset of 512) -. - NEWHOLOG read HOLOG file from the WSRT (this option, synonymous with - WMP, was added to help the user) - OLDHOLOG read a Holog map in old IBM-coded format (this option used to - be called HOLOG) -. - QUIT quit LOADing" -! -! Map multiplication factors -! Ref: NMADAT -! -KEYWORD=MAP_FACTORS - DATA_TYP=R - IO=I - NVALUES=2 - SWITCH=VECTOR - SEARCH=L,P - PROMPT="Input-map multipliers" - HELP=" -Specify the factors by which the input maps have to be multiplied. -. -You may specify up to 8 factors which will be used as multipliers in the -weighted summation the input maps you selected. If there are more maps to be -summed than factors specified, the factors will be cyclically re-used. " -! -! Sum multiplication factors -! Ref: NMADAT -! -KEYWORD=SUM_FACTORS - DATA_TYP=R - IO=I - NVALUES=8 - SEARCH=L,P - PROMPT="Summing multipliers" - HELP=" -Specify up to 8 weight factors by which the input maps have to be multiplied. -If the number of weights you give is less than the number of maps to be -combined, the weights will re-used in a cyclic fashion. -. -Example: - 1,-1 will average the first, third, ... maps in your WMP_SETS -specification with the negated second, fourth ... maps. -. -Note: When used together with the RSUM option, the weights will be used both -for the Real and Imaginary map (they are real weights)." -! -! -! Complex sum multiplication factors -! Ref: NMADAT -! -KEYWORD=CSUM_FACTORS - DATA_TYP=R - IO=I - NVALUES=16 - SEARCH=L,P - PROMPT="Summing multipliers" - HELP=" -Specify up to 8 complex weight factors by which the input maps have to be -multiplied. For each factor the real part should be given first, the imaginary -next. So 1,0,0,-1 means add the real part of the first map-pair to the -imagingary part of the second map-pair: -. - (1+0*i)*(map1r + i*map1i) + (0-1*i)*(map2r + i*map2i) -. -If the number of weights you give is less than the number of maps to be -combined, the weights will re-used in a cyclic fashion. Example: - 1,1,-1,-1 will average the first, third, ... pairs in your WMP_SETS -specification with the negated second, fourth ... pairs." -! -! Rotation measure -! Ref: NMADAT -! -KEYWORD=ROTATION_MEASURE - DATA_TYP=R - IO=I - NVALUES=512 - SEARCH=L,P - PROMPT="Rotation measure" - HELP=" -Specify one (or more) rotation measure(s) (RM). Pairs of input maps will be -phase-rotated to the the frequency of the first input map and averaged: - - THETAn = 2 * RM * ( (c/FRQn)**2 - (c/FRQ1)**2 ) - - Qout = SUM( Wn * ( cos(THETAn)*Qn - sin(THETAn)*Un ) ) / SUM( Wn ) - Uout = SUM( Wn * ( sin(THETAn)*Qn + cos(THETAn)*Un ) ) / SUM( Wn ) - -A pair of Qout/Uout will be produced for each RM given. E.g. to get average Q/U -maps for rotation measures from 0 to 5 with intervals of 0.5, specify -ROTATION_MEASURE=0 TO 5 BY 0.5." -! -! Polarisation level -! Ref: NMADAT -! -KEYWORD=MAP_LEVEL - DATA_TYP=R - IO=I - CHECK=MINIMUM - MINIMUM=0. - SEARCH=L,P - PROMPT="Polarisation threshold (W.U)" - HELP=" -Specify the minimum level in Wetsrebork Units that is still to be considered -valid linear polarisation. Polarisation levels below this threshold will be set -to zero in the output map(s)." -! -! Get FITS comment -! Ref: NMAWFT -! -KEYWORD=COMMENT - DATA_TYP=C - IO=I - LENGTH=70 - SWITCHES=NULL_VALUES - SEARCH=L,P - PROMPT="FITS comment (<=70 chars)" - HELP=" -The given text will be included as COMMENT in FITS output." -! -! Get FITS scale -! Ref: NMADAT -! -KEYWORD=FITS_SCALE - DATA_TYP=C - IO=I - LENGTH=4 - CHECKS=ABBREV_OPTIONS - SWITCHES=LOOP - SEARCH=L,P - OPTIONS=JY,WU - PROMPT="Units of source flux" - HELP=" -Specify the output units of the FITS data: -. - JY jansky per beam - WU Westerbork units (1 W.U. = 5 mJy)" -!! WU per beam??? -! -! Get input file -! Ref: NMADAT -! -KEYWORD=INPUT_FILE - DATA_TYP=C - IO=I - LENGTH=80 - SWITCHES=LOOP,NULL_VALUES - SEARCH=L,P - PROMPT="Input file name" - HELP=" -Specify the file name (including extension) of the file to be converted." -! -! Get file name -! Ref: NMADAT, NMAFLD -! -KEYWORD=FILENAME - DATA_TYP=C - IO=I - LENGTH=80 - SWITCHES=LOOP,NULL_VALUES - SEARCH=L,P - PROMPT="Name for output disk file" - HELP=" -Specify the file name (without an extension) to be used in creating a -pseudo-tape output file name (e.g. FITS write). -. -Specify a full filename otherwise (e.g. LOAD/UNLOAD in FIDDLE)." -!! To be covered by WNDPOH -! -! Get input labels -! Ref: NMADAT -! -KEYWORD=INPUT_LABELS - DATA_TYP=J - IO=I - NVALUES=256 - SWITCHES=LOOP,WILD_CARDS - SEARCH=L,P - PROMPT="Input tape labels" - HELP=" -Specify the tape labels to be read. * specifies all labels on the tape. -. -Remember that WMP-file images are identified by indices grp.obs.fld.chn.seq). -Each of the selected tape labels will be stored in the WMP-file as a separate -field (FLD) in the group (GRP) being created. The CHN, POL and TYP indices will -reflect the nature of the input data, SEQ will be 0. -. -Example: - INPUT_LABELS=3,6,8 will cause a new GRP to be created in which these -labels will be stored under the image indices -. - <newgrp>. 0. <chn for label 3>. <pol for label 3>. <typ for label 3>. 0 - <newgrp>. 1. <chn for label 6>. <pol for label 6>. <typ for label 6>. 0 - <newgrp>. 2. <chn for label 8>. <pol for label 8>. <typ for label 8>. 0 -" -!! JPH 941005: The old text referred to index 1 as observation i.s.o field. This -!! is clearly wrong, but it must be checked if the new interpretation is -!! correct. -! -! -! Get output label -! Ref: NMADAT -! -KEYWORD=OUTPUT_LABEL - DATA_TYP=J - IO=I - SWITCHES=LOOP,WILD_CARDS - SEARCH=L,P - PROMPT="Output label" - HELP=" -Specify the first output tape label. If this label already exists, it and all -the subsequent labels will be overwritten. - -Specify * or 0 to write the new label behind all existing ones." -! -! -! Get input/output Fiddle node -! Ref: NMADAT -! -KEYWORD=WMP_NODE_1 - DATA_TYP=C - IO=I - LENGTH=80 - SWITCHES=LOOP,WILD_CARDS,NULL_VALUE - SEARCH=L,P - PROMPT="First WMP node name" - HELP=" -Specify the node name for the first Fiddle input set of images." -!! WNDPOH -! -! Get second Fiddle node -! Ref: NMADAT -! -KEYWORD=WMP_NODE_2 - DATA_TYP=C - IO=I - LENGTH=80 - SWITCHES=LOOP,WILD_CARDS,NULL_VALUE - SEARCH=L,P - PROMPT="Second WMP node name" - HELP=" -Specify the node name for the second Fiddle input set of images. -. -Specify * if this is the same as the first node (NODE_1)." -!! WNDPOH -! -! Get input maps -! Ref: NMADAT -! -KEYWORD=WMP_SET_1 - DATA_TYP=C - IO=I - LENGTH=32 - NVALUES=64 - SWITCHES=LOOP,WILD_CARDS,NULL_VALUE - SEARCH=L,P - PROMPT="First image set(s) to be used: grp.fld.chn.pol.typ.seq" - HELP=" -Specify the first image set(s) to be used." -! -! Get input maps -! Ref: NMADAT -! -KEYWORD=WMP_SET_2 - DATA_TYP=C - IO=I - LENGTH=32 - NVALUES=64 - SWITCHES=LOOP,WILD_CARDS,NULL_VALUE - SEARCH=L,P - PROMPT="Second image set(s) to be used: grp.fld.chn.pol.typ.seq" - HELP=" -Specify the second image Set(s) to be used" -! -! Get area -! Ref: NMADAR -! -KEYWORD=AREA - DATA_TYP=J - IO=I - NVALUES=4 - SWITCHES=LOOP,VECTOR,WILD_CARDS,NULL_VALUE - SEARCH=L,P - PROMPT="Area: l,m, dl,dm" - HELP=" -Specify the area to be selected: -. - l, m position in grid spacings of centre of area - 0,0 is the map centre, increaing toward the upper right (i.e. - with DEcreasing RA and INcreasing DEC) -. - dl, dm horizontal and vertical area sizes" -! -! Get data action -! Ref: NMAPRT -! -KEYWORD=DATA_ACTION - DATA_TYP=C - IO=I - LENGTH=8 - CHECKS=ABBREV_OPTIONS - SWITCHES=LOOP,NULL_VALUES - SEARCH=L,P - PROMPT="Action to perform on the data" - OPTIONS=SHOW; NOISE,OFFSET; QUIT - HELP=" -Specify action to perform: -. - SHOW show detailed map data -. - NOISE calculate noise - OFFSET calculate noise and offset -. - QUIT quit data part" -! -! Get polarisation -! Ref: NMADAT -! -KEYWORD=MAP_POLAR - DATA_TYP=C - LENGTH=4 - IO=I - NVALUES=4 - CHECKS=OPTIONS - SWITCHES=LOOP - SEARCH=L,P - PROMPT="Select 1 to 4 output-map polarisation(s)|" - OPTIONS=- -XX,XY,YX,YY; I,L, Q,U,V; XXI,XYI,YXI,YYI; II,LI, QI,UI,VI - DEFAULTS=XX - HELP=" -Specify up to four polarisations for the maps to make: -. - XX XX only - XY XY only - YX YX only - YY YY only -. - I Stokes I - L 'line' Stokes I: Incomplete input data (e.g. no valid XX or YY) - will be filled in aassuming that the field is unpolarised - (Q=U=V=0) - Q Stokes Q - U Stokes U - V Stokes V -. -Each of the above may be suffixed with 'I' to indicate that visibilities must -be pre-multiplied with sqrt(-1)" -! -! Get coordinate type -! Ref: NMADAT -! -KEYWORD=MAP_COORD - DATA_TYP=C - LENGTH=12 - IO=I - CHECKS=ABBREV_OPTIONS - SWITCHES=LOOP - SEARCH=L,P - PROMPT="Map coordinate system| " - OPTIONS=B1950_J2000,APPARENT; REFERENCE,AREFERENCE - HELP=" -Specify the coordinate system for the map. -. -There are two choices to be made: The first is whether the map is to be made in -apparent coordinates for the epoch of the observation or in fixed-epoch -coordinates. The latter are fixed for each instrument: B1950 for the WSRT, -J2000 for the ATNF. The second choice is whether the 'reference position' for -the map must coincide with the fringe-stopping centre or is to be specified by -you. -. -The reference position is the position at which the map plane is tangent to the -celestial sphere; it defines the geometry of the map's (l,m) grid in terms of -RA and DEC. -. -The reference position is important for mosaic mapping: The FIDDLE/MOSCOM -operation that combines mosaic subfields into a single large map will only work -if all input maps have the same reference. -. -For a single mosaic, the program by default uses the mosaic centre as the -reference for all subfield maps. However, if you intend to combine multiple -mosaics into a 'super-mosaic', only you can define the common reference centre -that will be needed. -. -You have the following options for your reply: -. - Reference position defined by the observation (i.e. coinciding with the - fringe stopping centre): -. - B1950_J2000 in epoch coordinates for the epoch defined by the - instrument with which the observation was made: - B1950 for the WSRT - J2000 for the ATNF -. - APPARENT in apparent coordinates at the time of observation -. - Reference position to be defined by the user through an additional parameter - REF_COORD: -. - REFER in B1950_J2000 coordinates -. - AREFER in APPARENT coordinates. Note that this will not work for -" -! -! Get reference coordinates -! Ref: NMADAT -! -KEYWORD=REF_COORD - DATA_TYP=D - IO=I - NVALUES=2 - SWITCHES=LOOP,VECTOR - SEARCH=L,P - PROMPT="Map reference coordinates: RA,DEC (decimal deg)" - HELP=" -Specify (in decimal degrees) the RA and DEC of the reference coordinates to use -in producing the map. The coordinate system is B1950/J2000 or apparent as -defined by your value for parameter MAP_COORD. " -! -! Get user comment -! Ref: NMADAT -! -KEYWORD=USER_COMMENT - DATA_TYP=C - IO=I - LENGTH=24 - SWITCHES=NULL_VALUES - SEARCH=L,P - PROMPT="Comment to be included in map header(s) (<=24 chars)|" - HELP=" -Give, optionally, a descriptive comment for the maps." -! -! UV special coordinates -! Ref: NMADAT -! -KEYWORD=UV_COORDINATES - DATA_TYP=C - LENGTH=8 - IO=I - SWITCH=LOOP - CHECKS=ABBREV_OPTIONS - SEARCH=L,P - PROMPT="UV coordinate system" - OPTIONS=UV,BASHA,IFRHA - HELP=" -Specify the type of UV coordinates wanted for UV-plane type output -! {\em \textref{OUTPUT}{.output}: COVER, REAL, IMAG, AMPL, PHASE options } -. - UV standard UV coordinates: interferometer tracks are ellipses -. - BASHA hour-angle (horizontal) and interferometer baseline (vertical) - coordinates: interferometer tracks are horizontal lines; - redundant baselines overlap -. - IFRHA as BASHA, but vertical axis is the interferometer ordinal number - in the sequence 01,02,...,0D,12,13,...,CD)" -!! Check redundant overlap -! -! HA resolution -! Ref: NMADAT -! -KEYWORD=HA_RESOLUTION - DATA_TYPE=R - IO=I - SWITCH=LOOP - CHECKS=MAXIMUM,MINIMUM - MAXIMUM=15. - MINIMUM=.04 - SEARCH=L,P -!! UNITS=DEG,RAD,CIR,HMS - PROMPT="Hour-angle averaging interval (UT seconds)" - DEFAULTS=.50137 - HELP=" -Specify the width in UT degrees of hour angle over which visibilities will be -averaged (to reduce the noise per plotted point). -. -Note: Observations are taken at multiples of 10 UT seconds and it is - therefore convenient to specify this parameter in UT seconds as well. - The number you specify will be converted to a sidereal hour-angle - interval." -! -! Baseline resolution -! Ref: NMADAT -! -KEYWORD=BAS_RESOLUTION - DATA_TYP=R - IO=I - SWITCH=LOOP - CHECKS=MAXIMUM,MINIMUM - MINIMUM=9. - MAXIMUM=300. - SEARCH=L,P - PROMPT="Baseline averaging interval (m)" - HELP=" -Specify the width in metres of baseline over which visibilities will be -averaged. -. -The minimum value is 9, representing the smallest baseline increment ever -present in practice in a (set of) WSRT observation(s). The maximum is -(arbitrarily) fixed at 300." -! -! Interferometer resolution -! Ref: NMADAT -! -KEYWORD=IFR_RESOLUTION - DATA_TYP=R - IO=I - SWITCH=LOOP - CHECKS=MAXIMUM,MINIMUM - MINIMUM=.1 - MAXIMUM=16. - SEARCH=L,P - PROMPT="Interferometer separation" - HELP=" -Specify the vertical separation in grid points between interferometers" -!! Check what this means -! -! FFT size -! Ref: NMADAT -! -KEYWORD=FT_SIZE - DATA_TYP=J - IO=I - SWITCH=LOOP,VECTOR - NVALUES=2 - CHECKS=MINIMUM,MAXIMUM - MINIMUM=4,4 - MAXIMUM=8192,8192 - SEARCH=L,P - PROMPT="FFT size" - HELP=" -Specify the size of the Fourier transform in the horizontal and vertical -directions. Note that for 8k*8k maps the number of points/beam should -not be too close to 2 to stay within map size. -. -If the size in both direction is <= 17, a Direct Fourier Transform (DFT) will -be made instead of the standard operation of interpolating onto a rectangular -grid followed by a Fast Fourier Transform (FFT). -. -The standard operation suffers from 'aliasing' artefacts associated with the -periodic nature of the FFT. These artefacts are suppressed, to a level that is -generally acceptable, through a very careful choice of the convolution function -used in the interpolstion to a rectangular grid, but they cannot be avoided -completely. -. -By avoiding the interpolation altogether, the DFT method is free from these -aliasing effects." -! -! Output size -! Ref: NMADAT -! -KEYWORD=OUT_SIZE - DATA_TYP=J - IO=I - SWITCH=LOOP,VECTOR - NVALUES=2 - CHECKS=MINIMUM,MAXIMUM - MINIMUM=16,16 - MAXIMUM=16384,16384 - SEARCH=L,P - PROMPT="Output map size" - HELP=" -Specify the size in grid points of the output map(s) in the horizontal and -vertical directions." -! -! Output centre -! Ref: NMADAT -! -KEYWORD=OUT_CENTRE - DATA_TYP=J - IO=I - SWITCH=LOOP,VECTOR - NVALUES=2 - SEARCH=L,P - PROMPT="Output map centre" - HELP=" -Specify the centre of the output map in the l and m direction in pixels with -respect to the mosaic reference position. -. -If you specify an *, you will be prompted for l,m and RA,DEC position" -! ?? OUT_CENTRE <--> LM_CENTRE ? -! -! Output centre -! Ref: NMADAT -! -KEYWORD=LM_CENTRE - DATA_TYP=D - IO=I - SWITCH=LOOP,VECTOR,NULL_VALUES,WILD_CARDS - NVALUES=2 - SEARCH=L,P - PROMPT="Output map centre" - HELP=" -Specify the centre of the output map in the l and m direction; in arcsec with -respect to the mosaic reference position. -. -If you specify an *, you will prompted for RA,DEC position" -! -! Output centre -! Ref: NMADAT -! -KEYWORD=RADEC_CENTRE - DATA_TYP=D - IO=I - SWITCH=LOOP,VECTOR - NVALUES=2 - SEARCH=L,P - PROMPT="Output map centre: RA,DEC (decimal deg)" - HELP=" -Specify the centre of the output map: RA and DEC in decimal degrees." -! -! Field size -! Ref: NMADAT -! -KEYWORD=FIELD_SIZE - DATA_TYP=R - IO=I - NVALUES=2 - SWITCH=LOOP,VECTOR,NULL_VALUES - SEARCH=L,P - CHECKS=MINIMUM,MAXIMUM - MINIMUM=.001,.001 - MAXIMUM=180.,180. - PROMPT="Fieldsize l,m (deg)" - HELP=" -Specify the l and m field size of the map to be transformed. The default will -produce a map with a resolution of about 3.5 grid intervals per -synthesized-beam half-width. -. -If you give a NULL answer (two double quotes), you will be prompted for the -grid steps. " -! -! Grid size -! Ref: NMADAT -! -KEYWORD=GRID_SIZE - DATA_TYP=R - IO=I - NVALUES=2 - SWITCH=LOOP,VECTOR,NULL_VALUES - SEARCH=L,P - CHECKS=MINIMUM,MAXIMUM - MINIMUM=.001,.001 - MAXIMUM=180.,180. - PROMPT="Grid interval in l,m (arcsec)" - HELP=" -Specify the l and m grid steps in arcseconds for the map to be made. - -In most applications you may define GRID_SIZE as you please. NOTE however, that -any number of maps that you want to combine into a single mosaic (FIDDLE MOSCOM -option) must all share the same GRID_SIZE (as well as the same reference -coordinates, parameters MAP_COORD and REF_COORD) -!! {\em See \textref{MAP_COORD}{.map.coord}, -!! \textref{REF_COORD}{.ref.coord} } -" -! -! Taper type -! Ref: NMADAT -! Note: The associated UNIFORM and TAPER_VALUE parameters are in NMAP.PEF -! -KEYWORD=TAPER - DATA_TYP=C - IO=I - LENGTH=8 - SWITCH=LOOP - CHECKS=ABBREV_OPTIONS - OPTIONS=GAUSS, LINEAR, OVERR, RGAUSS, NATURAL -!! DEFAULTS= - SEARCH=L,P - PROMPT="Taper type" - HELP=" -The taper is a function of baseline length used to de-emphasize the long -baselines and consequently reduce the near-in sidelobes of the synthesized beam. -. -You may specify the following functions, some of them to be supplemented later -with a baseline-scale parameter TAPER_VALUE: - -! {\em see public parameter -! \textref{TAPER_VALUE}{nmap_public_intfc.taper.value} } -. - GAUSS exp -(<baseline>/TAPER_VALUE)**2 - standard WSRT beam: good compromise between near-in sidelobes, - beam width and noise -. - LINEAR max (0, 1-baseline/TAPER_VALUE) -. - OVERR 1 / baseline (no scale) -. - RGAUSS exp -(<baseline>/TAPER_VALUE)**2 / <baseline> - broader beam, very low near-in sidelobes, poorer noise -. - NATURAL no taper (no scale) - optimum signal/noise ratio, narrower beam with very strong - near-in sidelobes -. -NOTES: - Unless you have specified UNIFORM=NATURAL for the UV coverage mode, the - 1/<baseline> density variation of measured visibility points is already - being accounted for, so OVERR and RGAUSS should not be chosen. LINEAR - does not combine very well with NATURAL either. - -! {\em cf. parameter \textref{UNIFORM}{nmap_public_intfc.uniform} } -" -! -! Convolution type -! Ref: NMADAT -! -KEYWORD=CONVOLVE - DATA_TYP=C - LEN=8 - SWITCH=LOOP - CHECK=ABBREV_OPTION - OPTIONS=GAUSS,BOX,P4ROL,P6ROL,EXPSINC - SEARCH=L,P - PROMPT="Convolution type" - HELP=" -This is the interpolation function to be used in horizontally and vertically -interpolating the observed visibilities onto the rectangular grid to be used in -the Fast Fourier Transform. -. -The choice of function determines the detailed aliasing properties of the -map(s). NMAP chooses appropriate horizontal and vertical width parameters for -each. You may specify one of the following functions: -. - Gaussian-based: -. - EXPSINC Sinc*exp on 6*6 grid points: An 'approximation' to the ideal - sinc (=sin(x)/x) function. This is the function selected as the - default for map-making after extensive experience with all of - the options available here. - - GAUSS Gaussian type over 4*4 grid points: The function used in the - first years of WSRT operations; it was later replaced by the - prolate spheroids. The expense in computing time is the same as - for P4ROL. -. - Prolate spheroids: These function minimise the 'power' (= the integral of the - intensity squared) 'aliased in' from sources outside the map -. - P4ROL Prolate spheroidal function with 4*4 grid points. - P6ROL Prolate spheroidal function with 6*6 grid points: By using more - points in the interpolation, this function pushes the aliasing - down considerably, - at the expense of a factor two or more in - computing time for the interpolation -. -All the above functions may also be used in constructing a UV-plane for display -(UV_COORDINATES=UV). -. -For plotting visibilities versus baseline or interferometer -(UV_COORDINATES=BASHA or IFRHA), they are of little use, and the default one -would normally select is -. - BOX Shift to nearest grid point. -! {\em see parameter \textref{UV\_COORDINATES}{.uv.coordinates} } -" -!!! -!!! Specify the convolution width -!!! Ref: NMADAT -!!! -!!KEYWORD=CONVOL_WIDTH -!! DATA_TYP=R -!! IO=I -!! SWITCH=LOOP,VECTOR -!! NVALUES=2 -!! MIN_NVALUES=2 -!! CHECKS=MINIMUM,MAXIMUM -!! MINIMUM=.5,.5 -!! MAXIMUM=8.,8. -!! SEARCH=L,P -!! PROMPT="Convolution width" -!! HELP=" -!!Specify the number of grid intervals at which to truncate the convolution -!!function in the U and V coordinate directions." -! -! Specify correction for convolution -! Ref: NMADAT -! -KEYWORD=DECONVOLVE - DATA_TYP=L - IO=I - SWITCH=NULL_VALUES - SEARCH=L,P - PROMPT="Correct map for convolution taper (Yes/No) ?" - DEFAULTS=YES - HELP=" -The interpolation (convolution) in the visibility domain results in a -multiplication ('tapering') of the output map(s) and antenna pattern(s) by the -Fourier transform of the convolving function; i.e., toward the edge of the map -the sources, sidelobes and grating responses appear weaker than they actually -are. -. -By default this effect will be corrected for by dividing the map through the -taper. A side effect of this correction is that the noise, which is uniform -over the whole uncorrected map, is amplified toward the map edges. -. -Here you are given the option to bypass this correction. e.g. because uniform -noise is more important for your application than source fluxes. " -! -! Specify data details -! Ref: NMADAT -! -KEYWORD=QDATAS - DATA_TYP=L - IO=I - SWITCH=NULL_VALUES - SEARCH=L,P - PROMPT="Special data selection (Yes/No) ?" - DEFAULTS=NO - HELP=" -Maps are normally made directly from the .SCN-file visibilities. Answering YES -here gives you access to some specials including -. - - making a map from model visibilities in the .SCN file; - - selecting visibilities from an annulus in the UV plane; - - clipping extreme amplitudes in an annulus in the UV plane; - - shifting the pointing centre to which the visibilities refer (and - consequently the centre of the map to be made from them)." -! -! Define data to use -! Ref: NMADAT -! -KEYWORD=USER_DATA - DATA_TYP=C - LENGTH=8 - IO=I - SWITCH=LOOP - CHECKS=ABBREV_OPTIONS - OPTIONS=STANDARD,MODEL - SEARCH=L,P - PROMPT="Visibilities to use" - HELP=" -Specify the type of visibilities to use: -. - STANDARD observed visibilities -. - MODEL model visibilities (to be specified later with type=0 -sources) " -! -! Clipping -! Ref: NMADAT -! -KEYWORD=CLIPPING - DATA_TYP=L - IO=I - SEARCH=L,P - PROMPT="Clipping?" - HELP=" -'Clipping' means discarding data in a certain annulus that fall within a -certain range of values (yet to be specified). -! {\em parameters \textref{CLIP_AREA}{.clip.area}, -! \textref{CLIP_LEVELS}{.clip.levels} } -. -It is a simple (and primitive) method of eliminating data affected by strong -interference. (Note that NFLAG provides a much wider scala of operations to -find and suppress interference.)" -! -! Clip area -! Ref: NMADAT -! -KEYWORD=CLIP_AREA - DATA_TYP=R - IO=I - NVALUES=2 - SWITCH=LOOP,VECTOR - CHECK=MINIMUM - MINIMUM=0.,0. -!! UNITS="m" - PROMPT="UV-radius range for clipping (m)" - DEFAULTS=0.,100000. - SEARCH=L,P - HELP=" -Specify the (circular) UV-plane radii (in metres) between which you want to -clip the data. The default is to clip everywhere." -! -! Clip levels -! Ref: NMADAT -! -KEYWORD=CLIP_LEVELS - DATA_TYP=R - IO=I - NVALUES=2 - SWITCH=LOOP,VECTOR - CHECKS=NON_DESCENDING - SEARCH=L,P - PROMPT="Amplitude range to be discarded" - DEFAULTS=100000.,100000. - HELP=" -Specify amplitude range (in Westerbork Units) of visibility magnitudes that you -want to discard. -. -In the annulus defined by CLIP_AREA, values between the limits you specify will -be discarded. -! {\em parameter \textref{CLIP_AREA}{.clip.area} } -. -NOTE: It would be more natural to define a range within which visibilities are -considered valid. As it is, only the lower limit is actually useful, allowing -you to define a rejection threshold for interference. To do so, specify your -threshold for the lower and 'infinity' for the upper limit, e.g. -. - <threshold>,100000 " -! -! Source subtraction -! Ref: NMADAT -! -KEYWORD=SUBTRACT - DATA_TYP=L - IO=I - SEARCH=L,P - PROMPT="Model subtraction (Yes/No) ?" - HELP=" -Reply YES if you want to subtract a source model. You will then be prompted to -provide details on the model you want to subtract. -! {\em see the \textref{NMODEL HANDLE}{nmodel_public_intfc} interface } -" -! -! Field centre shifts -! Ref: NMADAT -! -KEYWORD=FIELD_SHIFT - DATA_TYP=R - IO=I - NVALUES=2 - SWITCH=LOOP,VECTOR,NULL_VALUES - DEFAULTS=0.,0. - SEARCH=L,P - PROMPT="l,m field shift (arcsec)" - HELP=" -Specify the field-centre shift in l,m coordinates. -. -(l,m) are 'horizontal' and 'vertical' Cartesian coordinates in a plane tangent -to the celestial sphere at the reference centre. The coordinate system is -B1950/J2000 or apparent as defined by your value for parameter MAP_COORD. -!! {\it See \textref{MAP_COORD}{.map.coord}, -!! \textref{REF_COORD}{.ref.coord} } -. -If you enter a null value (\ or ""), you will be prompted for a FIELD_CENTRE -instead. This option is intended for instrumental test programs only and has -not been tested for general applications; use it at your own risk if you wish. " -! -! Field centre shifts -! Ref: NMADAT -! -KEYWORD=FIELD_CENTRE - DATA_TYP=D - IO=I - NVALUES=2 - SWITCH=LOOP,VECTOR,NULL_VALUES - SEARCH=L,P - PROMPT="Field centre: RA,DEC (decimal deg)" - HELP=" -Specify the map centre wanted in the apparent-coordinate frame. - -Default is the fringe-stopping centre. " -! -! Data type used -! Ref: NMADAT -! -KEYWORD=DATA_TYPE - DATA_TYP=C - LEN=8 - SWITCH=LOOP - CHECKS=ABBREV_OPTION - OPTION=NORMAL, COS,SIN, AMPL,PHASE - DEFAULTS=NORMAL - SEARCH=L,P - PROMPT="Data transformation for display" - HELP=" -Specify how to transform the complex input visibilities. NORMAL is the default; -the others are for special experiments and diagnostics only. -. - NORMAL Complex value -. - COS Real part - SIN Imaginary part -. - AMPL Amplitude - PHASE Phase " -! -! Output maps -! Ref: NMADAT -! -KEYWORD=OUTPUT - DATA_TYP=C - LENGTH=8 - NVALUES=8 - SWITCH=LOOP - CHECKS=ABBREV_OPTION - SEARCH=L,P -!! PROMPT="Specify up to 8 output image types" -!! PROMPT set by WNDPOH - OPTIONS=MAP,AP; COVER; REAL,IMAG, AMPL,PHASE -!! DEFAULT=MAP,AP - HELP=" -Specify one or more output types: -. - Standard image types for map-making: - MAP Output (a) map(s) - AP Output (an) antenna pattern(s) -. - Visibility-domain outputs, for diagnostics only: - COVER Output the 'antenna-pattern' convolved visibilities -. - REAL Output the real part of the convolved visibilities - IMAG Output the imaginary part of the convolved visibilities -. - AMPL Output the amplitude of the convolved visibilities - PHASE Output the phase of the convolved visibilities" -! -! -! Get old R-series data type -! Ref: NMADAT -! -KEYWORD=OLD_DATTYP - DATA_TYP=J - IO=I - SWITCHES=LOOP - SEARCH=L,P - PROMPT="Old R-series data format" - HELP=" -Specify the old R-series data type: -. - 0 local - 1 VAX, D_FORMAT - 2 VAX, G_FORMAT - 3 ALLIANT - 4 CONVEX - 5 IEEE - 6 DEC station - 7 SUN station - 8 HP station" -!- -INCLUDE=NGEN_PEF ! -INCLUDE=NSHOW_PEF ! -!- -INCLUDE=NMODEL_PEF ! -INCLUDE=MDLNODE_PEF ! -!- -INCLUDE=SCNNODE_PEF ! -INCLUDE=SCNSETS_PEF ! -INCLUDE=SELECT_PEF ! -! -INCLUDE=NMAP_PEF ! -INCLUDE=WMPNODE_PEF ! -INCLUDE=WMPSETS_PEF ! -! -INCLUDE=UNIT_PEF -!- - diff --git a/src/nmap/nmapfl.for b/src/nmap/nmapfl.for deleted file mode 100644 index e4211028f01801d7ba7fda6bd6fa3cb9339d642e..0000000000000000000000000000000000000000 --- a/src/nmap/nmapfl.for +++ /dev/null @@ -1,233 +0,0 @@ -C+ NMAPFL.FOR -C WNB 910403 -C -C Revisions: -C WNB 920609 Correct printout -C CMV 931119 Change format of output (more user oriented) -C CMV 931216 Separate option for extended output (overview) -C - SUBROUTINE NMAPFL(PTYPE,INFCA,NODIN,OVV) -C -C Show WMP file layout -C -C Result: -C -C CALL NMAPFL ( PTYPE_J:I, INFCA_J:I, NODIN_C(*):I, OVV_L:I) -C Show on output PTYPE the file layout -C of file INFCA (if OVV is .false.) or -C give an overview (if OVV is .true.). -C -C Include files: -C - INCLUDE 'WNG_DEF' - INCLUDE 'MPH_O_DEF' !MAP HEADER - INCLUDE 'GFH_O_DEF' !GENERAL FILE HEADER - INCLUDE 'SGH_O_DEF' !SUB-GROUP HEADER -C -C Parameters: -C - INTEGER MAXCMT !Max. number of comments to remember - PARAMETER(MAXCMT=25) -C -C Arguments: -C - INTEGER PTYPE !PRINT TYPE (F_P, F_T ETC) - INTEGER INFCA !FILE DESCRIPTOR - CHARACTER NODIN*(*) !NAME OF NODE - LOGICAL OVV !OVERVIEW (else layout)? -C -C Function references: -C - LOGICAL WNFRD !READ DATA - INTEGER WNFEOF !GET FILE POINTER - LOGICAL NMASTG !GET DATASET - INTEGER WNCALN !Length of string - CHARACTER*32 WNTTSG !MAKE SET NAME -C -C Data declarations: -C - INTEGER SET(0:7,0:1) !ALL SETS - INTEGER SNAM(0:7) !SET NAME - CHARACTER CNAM*23,TNAM*32 !IN CHARACTERS - INTEGER MPHP !SET POINTER -C - INTEGER CGROUP !Current group - INTEGER CFIELD !Current field - INTEGER CCHAN !Current channel - INTEGER LCHAN !Last channel - CHARACTER CCMT*24 !Current comment - CHARACTER CMT(MAXCMT)*24 !List of comments - INTEGER NCMT !Number of unique comments - LOGICAL DO_PRINT !Print line for map -C - BYTE GFH(0:GFHHDL-1) !FILE HEADER - BYTE SGH(0:SGHHDL-1,0:7) !SUB-GROUP HEADER - INTEGER SGHJ(0:SGHHDL/4-1,0:7) - EQUIVALENCE(SGH,SGHJ) -C - BYTE MPH(0:MPHHDL-1) !MAP HEADER - INTEGER MPHJ(0:MPHHDL/4-1) - INTEGER*2 MPHI(0:MPHHDL/2-1) - REAL MPHE(0:MPHHDL/4-1) - EQUIVALENCE (MPH,MPHJ,MPHI,MPHE) -C- -C -C INIT -C - DO I=0,7 !SET SET *.*.*.*.*.*.* - DO I1=0,1 - SET(I,I1)=0 - END DO - SET(I,1)=-1 !1 LINE - END DO - SET(0,0)=1 !1 LINE -C -C SHOW NAME AND SIZE -C - IF (NODIN.EQ.' ') THEN - IF (.NOT.WNFRD(INFCA,GFHHDL,GFH,0)) THEN - CALL WNCTXT(PTYPE, - 1 '!/File layout of WMP node (!UJ bytes):!/', - 1 WNFEOF(INFCA)) - ELSE - CALL WNCTXT(PTYPE, - 1 '!/File layout of WMP node !AD (!UJ bytes):!/', - 1 GFH(GFH_NAME_1),GFH_NAME_N,WNFEOF(INFCA)) - END IF - ELSE - CALL WNCTXT(PTYPE, - 1 '!/File layout of WMP node !AS (!UJ bytes):!/', - 1 NODIN,WNFEOF(INFCA)) - END IF -C -C SHOW LAYOUT -C - IF (.NOT.OVV) THEN - DO WHILE(NMASTG(INFCA,SET,MPH,MPHP,SNAM)) !GET SETS - DO I=0,7 !CLEAR LEVEL COUNT - SGHJ(SGH_HEADH_J-SGH_LINKG_J,I)=0 - END DO - I=SET(1,0)-1 !CURRENT LEVEL - IF (.NOT.WNFRD(INFCA,SGHHDL-SGH_LINKG_1,SGH(0,I), - 1 SET(3,0)+SGH_LINKG_1)) THEN !READ TOP - 10 CONTINUE - CALL WNCTXT(PTYPE,'Error reading file') - RETURN - END IF - DO WHILE(I.GT.0) !READ LEVELS - I=I-1 - IF (.NOT.WNFRD(INFCA,SGHHDL-SGH_LINKG_1,SGH(0,I), - 1 SGHJ(SGH_HEADH_J-SGH_LINKG_J,I+1))) GOTO 10 - END DO - SNAM(1)=-1 !ONLY LOWER LEVELS - CALL WNCTXT(PTYPE,'!AS : !4$UJ fields, !4$UJ '// - 1 'channels, !4$UJ pol.s and !4$UJ '// - 1 'types for !AD', - 1 WNTTSG(SNAM(0),0), - 1 SGHJ(SGH_LINKGN_J-SGH_LINKG_J,0), - 1 SGHJ(SGH_LINKGN_J-SGH_LINKG_J,1), - 1 SGHJ(SGH_LINKGN_J-SGH_LINKG_J,2), - 1 SGHJ(SGH_LINKGN_J-SGH_LINKG_J,3), - 1 MPH(MPH_FNM_1),MPH_FNM_N) - IF (.NOT.WNFRD(INFCA,SGHHDL,SGH(0,0),SET(3,0))) GOTO 10 !READ CURRENT - DO WHILE (SET(1,0).GT.1) !DECREASE LEVEL - SET(1,0)=SET(1,0)-1 !DECREASE LEVEL - SET(3,0)=SGHJ(SGH_HEADH_J,0)-SGH_LINKG_1+SGH_LINK_1 !LOWER HEADER - IF (.NOT.WNFRD(INFCA,SGHHDL,SGH(0,0),SET(3,0))) GOTO 10 !CURRENT - SET(4,0)=SGHJ(SGH_HEADH_J,0) !NEW LOWER HEAD - END DO - END DO - CALL WNCTXT(PTYPE,' ') -C -C Else print summary of contents -C - ELSE -C - CALL WNCTXT(PTYPE,'grp.fld.chn.pol.typ.map (#) '// - & 'Type Pol Field Comment') -C - CGROUP=-1 !Group unknown so far - CFIELD=-1 !Field unknown so far - LCHAN=-1 !No channel printed yet -C - DO WHILE(NMASTG(INFCA,SET,MPH,MPHP,SNAM)) !GET SETS -C -C If this is a new group, make sure we print the final -C channel of the previous group and that we print the first -C channel of this group -C - IF (CGROUP.NE.SNAM(0)) THEN - IF (LCHAN.NE.-1) THEN - CALL WNCTXT(PTYPE,' - !3$UJ',LCHAN) - LCHAN=-1 - ENDIF - CCHAN=SNAM(2) !Print this channel - NCMT=0 !No comments yet - END IF -C -C We do not print a continuous range of channels -C - DO_PRINT=(SNAM(2).NE.CCHAN+1) -C -C Unless they have a different comment -C - CALL WNGMTS(24,MPH(MPH_UCM_1),CCMT) !Current comment - TNAM=WNTTSG(SNAM,0) !Set name - I2=1 - DO WHILE (TNAM(I2:I2).NE.'.') !Strip group - I2=I2+1 - END DO - TNAM=TNAM(I2+1:) - I2=WNCALN(TNAM) - I1=INDEX(CCMT,TNAM(:I2)) !Comment contains set name? - IF (I1.NE.0) THEN !Then replace by ... - CCMT=CCMT(:I1-1)//'...'//CCMT(I1+I2:) - END IF -C -C Check all previous comments -C - I=1 - DO WHILE (I.LE.NCMT.AND.CCMT.NE.CMT(I)) - I=I+1 - END DO - IF (I.GT.NCMT) THEN - DO_PRINT=.TRUE. - IF (NCMT.EQ.MAXCMT) THEN !End of buffer - CMT(2)=CCMT !Overwrite second comment - ELSE - NCMT=NCMT+1 !Fill buffer - CMT(NCMT)=CCMT - ENDIF - ENDIF -C -C If we do need to print this one, do so now, else keep channel -C - IF (DO_PRINT) THEN - CNAM=WNTTSG(SNAM,3) !ONLY 23 CHARS (4*6-1) - IF (CGROUP.EQ.SNAM(0)) THEN - CNAM(1:4)=' ' !Wipe group - IF (CFIELD.EQ.SNAM(1)) CNAM(5:8)=' ' !Wipe field - END IF - CALL WNCTXT(PTYPE, - & '!23$AS !3$UJ !-4$AL4 !AL2 !-12$AL12 !AL24', - & CNAM,MPHJ(MPH_SETN_J), - & MPH(MPH_TYP_1),MPH(MPH_POL_1),MPH(MPH_FNM_1),CCMT) - END IF -C - CGROUP=SNAM(0) !Keep group for check - CFIELD=SNAM(1) !Keep field for check - CCHAN=SNAM(2) !Keep channel for check - LCHAN=CCHAN !Channel may be printed later - IF (DO_PRINT) LCHAN=-1 !Channel has been printed -C - END DO -C - IF (LCHAN.NE.-1) CALL WNCTXT(PTYPE,' - !3$UJ',LCHAN) - CALL WNCTXT(PTYPE,' ') -C - END IF -C - RETURN -C -C - END diff --git a/src/nmap/nmapmh.for b/src/nmap/nmapmh.for deleted file mode 100644 index f361ba49176431f91238f0fe3941460b75edd089..0000000000000000000000000000000000000000 --- a/src/nmap/nmapmh.for +++ /dev/null @@ -1,137 +0,0 @@ -C+ NMAPMH.FOR -C WNB 910320 -C -C Revisions: -C WNB 911105 Change RAO/DECO definition -C WNB 920114 Add Set name on type at end -C HjV 930311 Change some text -C CMV 931123 Make bottomline fit on single line -C CMV 931206 Change text (#of input sectors) -C CMV 940523 Add space in output text -C - SUBROUTINE NMAPMH(T,MPH,MNAM,WMPNOD) -C -C Print/type Map-header -C -C Result: -C -C CALL NMAPMH (T_J:I, MPH_B(0:*):I, MNAM_J(0:7):I, WMPNOD_C*:I) -C Show on output T the map header -C MPH with name MNAM in node WMPNOD. -C Include files: -C - INCLUDE 'WNG_DEF' - INCLUDE 'MPH_O_DEF' -C -C Parameters: -C -C -C Arguments: -C - INTEGER T !PRINTING TYPE - BYTE MPH(0:*) !MAP HEADER - INTEGER MNAM(0:7) !MAP NAME - CHARACTER*(*) WMPNOD !NODE NAME -C -C Function references: -C - CHARACTER*32 WNTTSG !GET MAP SET NAME - DOUBLE PRECISION WNGDFD !CONVERT ANGLE - INTEGER*2 WNGGI !GET I VALUE - DOUBLE PRECISION WNGGD !GET D VALUE -C -C Data declarations: -C - CHARACTER*8 TAPCOD(0:5) !TAPERS - DATA TAPCOD/'No','Gaussian','Linear','Natural', - 1 'Overr','Rgauss'/ - CHARACTER*12 CVLCOD(0:5) !CONVOLUTIONS - DATA CVLCOD/'No','Gaussian','Box','Prolate 4*4', - 1 'Expsinc','Prolate 6*6'/ - CHARACTER*5 CCVCOD(0:1) !DE-CONVOLVE - DATA CCVCOD/'not c','c'/ - CHARACTER*3 CLPCOD(0:1) !CLIP - DATA CLPCOD/'Not',' '/ - CHARACTER*2 SSBCOD(0:1) !SOURCE SUBTRACT - DATA SSBCOD/'No',' '/ -C- -C -C FILE INFO -C - CALL WNCTXT(T,'!/!AS(#!UJ) type !AL4 in node !AS', - 1 WNTTSG(MNAM,0), MPH(MPH_SETN_1), - 1 MPH(MPH_TYP_1),WMPNOD) -C -C GENERAL INFO -C - CALL WNCTXT(T,'!/Field: !AL12!38C\User comment: !AL24', - 1 MPH(MPH_FNM_1),MPH(MPH_UCM_1)) - CALL WNCTXT(T,'RA: !DPF10.5 deg Dec: !DAF10.5 deg '// - 1 'Epoch: !E6.1 Frequency: !D6.0 MHz', - 1 MPH(MPH_RA_1),MPH(MPH_DEC_1), - 1 MPH(MPH_EPO_1),MPH(MPH_FRQ_1)) -C -C DATA DESCRIPTION -C - CALL WNCTXT(T,'!/RA (!E12.0)!12C!10$DPF10.5 deg!56C'// - 1 'Obs.day!72C!4$UI', - 1 MPH(MPH_EPO_1), - 1 MPH(MPH_RAO_1),MPH(MPH_ODY_1)) - CALL WNCTXT(T,'Dec(!E12.0)!12C!10$DAF10.5 deg!56C'// - 1 'Obs.year!72C!4$UI', - 1 MPH(MPH_EPO_1), - 1 MPH(MPH_DECO_1),MPH(MPH_OYR_1)) - CALL WNCTXT(T,'Frequency!12C!10$D10.5 MHz!56C'// - 1 'Epoch!69C!7$E7.2', - 1 MPH(MPH_FRQO_1),MPH(MPH_OEP_1)) - CALL WNCTXT(T,'Bandwidth!12C!10$D10.5 MHz!56C'// - 1 'Map epoch!69C!7$E7.2', - 1 MPH(MPH_BDW_1),MPH(MPH_EPO_1)) -C -C MAP DESCRIPTION -C - CALL WNCTXT(T,'!/Type: !AL4(!AL2)!38CSize: !UJ*!UJ'// - 1 '!56CFFT size: !UJ*!UJ', - 1 MPH(MPH_TYP_1),MPH(MPH_POL_1), - 1 MPH(MPH_NRA_1),MPH(MPH_NDEC_1), - 1 MPH(MPH_FSR_1),MPH(MPH_FSD_1)) - CALL WNCTXT(T,'Fieldsize: !EAF8.4*!EAF8.4 deg!38C'// - 1 'Grid step: !D8.2*!D8.2 arcsec', - 1 MPH(MPH_FRA_1),MPH(MPH_FDEC_1), - 1 3600*WNGDFD(MPH(MPH_SRA_1)), - 1 3600*WNGDFD(MPH(MPH_SDEC_1))) - CALL WNCTXT(T,'!38C\Fieldshift: !D12.2*!D12.2 arcsec', - 1 WNGGD(MPH(MPH_SHR_1))*3600.*360, - 1 WNGGD(MPH(MPH_SHD_1))*3600.*360.) - CALL WNCTXT(T,'Maximum: !E9.2 W.U. at !SJ,!SJ!38C'// - 1 'Minimum: !E9.2 W.U.at !SJ,!SJ', - 1 MPH(MPH_MAX_1),MPH(MPH_MXR_1),MPH(MPH_MXD_1), - 1 MPH(MPH_MIN_1),MPH(MPH_MNR_1),MPH(MPH_MND_1)) - CALL WNCTXT(T,'!/Input baselines: !UJ!30C'// - 1 'Input sectors: !UJ!56C\Input points: !UJ!/'// - 1 'Normalisation: !D6'// - 1 '!30C\Noise: !E9.3 W.U.!/', - 1 MPH(MPH_NBL_1),MPH(MPH_NST_1),MPH(MPH_NPT_1), - 1 MPH(MPH_SUM_1),MPH(MPH_NOS_1)) - CALL WNCTXT(T,'!AS taper; !AS conv.(!AS\orrected); '// - 1 '!AS clipped; !AS subtract; !SI de-beam!/', - 1 TAPCOD(WNGGI(MPH(MPH_CD_1+0*LB_I))), - 1 CVLCOD(WNGGI(MPH(MPH_CD_1+1*LB_I))), - 1 CCVCOD(WNGGI(MPH(MPH_CD_1+2*LB_I))), - 1 CLPCOD(WNGGI(MPH(MPH_CD_1+3*LB_I))), - 1 SSBCOD(WNGGI(MPH(MPH_CD_1+4*LB_I))), - 1 MPH(MPH_CD_1+7*LB_I)) -C -C FILE INFO -C - I=IAND(T,-F_P-1) - IF (I.NE.0) THEN - CALL WNCTXT(I,'!AS(#!UJ) type !AL4 in node !AS!/', - 1 WNTTSG(MNAM,0), MPH(MPH_SETN_1), - 1 MPH(MPH_TYP_1),WMPNOD) - END IF -C - RETURN -C -C - END diff --git a/src/nmap/nmaprt.for b/src/nmap/nmaprt.for deleted file mode 100644 index bac7bf3c949b512c36d6bff7085fc957dc8c76dd..0000000000000000000000000000000000000000 --- a/src/nmap/nmaprt.for +++ /dev/null @@ -1,295 +0,0 @@ -C+ NMAPRT.FOR -C WNB 910402 -C -C Revisions: -C HjV 930423 Change name of some keywords -C CMV 931119 Change call to NMAPFL (include NODIN) -C WNB 931214 Delete auto SHOW for EDIT -C CMV 931216 Separate layout/overview options -C CMV 931220 Pass FCA of input file to WNDXLP and WNDSTA/Q -C CMV 940331 Add total flux calculation to Noise and Show Data -C CMV 940530 Option to print Job Summary -C - SUBROUTINE NMAPRT -C -C Show/edit data in WMP file -C -C Result: -C -C CALL NMAPRT will show and/or edit data in WMP file -C -C PIN references: -C -C INPUT_WMP_NODE -C WMP_SETS -C FILE_ACTION -C MAP_ACTION -C DATA_ACTION -C -C Include files: -C - INCLUDE 'WNG_DEF' - INCLUDE 'NMA_DEF' - INCLUDE 'MPH_O_DEF' !MAP HEADER -C -C Parameters: -C - INTEGER MXNAR !MAX. # OF AREAS - PARAMETER (MXNAR=10) -C -C Arguments: -C -C -C Function references: -C - LOGICAL WNDPAR !GET DWARF PARAMETER - LOGICAL WNDNOD !GET NODE NAME - LOGICAL WNDNOC !UPDATE NODE - LOGICAL WNFOP !OPEN FILE - LOGICAL WNFRD !READ FILE - LOGICAL WNDSTA !GET MAPS TO DO - LOGICAL NMASTG !GET A MAP -C -C Data declarations: -C - INTEGER FCAIN !INPUT FILE - CHARACTER*24 ACT !ACTION ASKED - INTEGER MPHP !SUB-GROUP POINTER - INTEGER SNAM(0:7) !SET NAME - CHARACTER*12 F1000 !FORMATS - LOGICAL LOF !CALCULATE OFFSET - INTEGER HISBAD !HISTOGRAM AREA - REAL NOIS(0:1) !CALCULATED NOISE AND OFFSET - REAL R2 - CHARACTER*1 MODE !FILE-OPEN MODE - INTEGER FAREA(0:3) !FULL MAP AREA - INTEGER TAREA(0:3,0:1) !TOTAL AREA (0=NORM, 1=EDGE) - INTEGER PAREA(0:3,MXNAR,0:1) !PARTIAL AREAS - INTEGER MXAREA(0:3) !MAX. SHOW AREA - DATA MXAREA/0,0,20,20/ - INTEGER MXARE2(0:3) - DATA MXARE2/0,0,0,0/ - REAL LBUF(0:8191) !DATA BUF - BYTE MPH(0:MPHHDL-1) !MAP HEADER - INTEGER MPHJ(0:MPHHDL/4-1) - INTEGER*2 MPHI(0:MPHHDL/2-1) - REAL MPHE(0:MPHHDL/4-1) - EQUIVALENCE (MPH,MPHJ,MPHI,MPHE) -C- -C -C GET NODE -C - MODE='R' !ASSUME READ-ONLY FOR NOW - 100 CONTINUE - IF (.NOT.WNDNOD('INPUT_WMP_NODE',' ','WMP','R',NODIN,FILIN)) THEN !NODE - IF (E_C.EQ.DWC_ENDOFLOOP) RETURN !READY WITH SHOW - CALL WNCTXT(F_TP,'Node does not exist') - GOTO 100 - ELSE IF (E_C.EQ.DWC_NULLVALUE) THEN - RETURN !END - ELSE IF (E_C.EQ.DWC_WILDCARD) THEN - GOTO 100 !MUST SPECIFY - END IF - IF (.NOT.WNFOP(FCAIN,FILIN,MODE)) THEN !OPEN MAP FILE - CALL WNCTXT(F_TP,'Cannot open file attached to node') - GOTO 100 - END IF - CALL NSCPFH(F_TP,FCAIN) !PRINT FILE HEADER -C -C FILE ACTION -C - 101 CONTINUE - IF (.NOT.WNDPAR('FILE_ACTION',ACT,LEN(ACT),J,'CONT')) THEN !FILE ACTION - IF (E_C.EQ.DWC_ENDOFLOOP) THEN !^Z - 102 CONTINUE - CALL WNFCL(FCAIN) !CLOSE FILE - GOTO 100 !RETRY NODE - END IF - GOTO 101 !RETRY - ELSE IF (E_C.EQ.DWC_NULLVALUE) THEN - GOTO 102 !READY - ELSE IF (E_C.EQ.DWC_WILDCARD) THEN - ACT='CONT' !ASSUME CONT - END IF - IF (ACT.EQ.'LAYOUT') THEN !SHOW LAYOUT - CALL NMAPFL(F_TP,FCAIN,NODIN,.FALSE.) !SHOW LAYOUT - ELSE IF (ACT.EQ.'OVERVIEW') THEN !SHOW OVERVIEW - CALL NMAPFL(F_TP,FCAIN,NODIN,.TRUE.) !SHOW OVERVIEW - ELSE IF (ACT.EQ.'SHOW') THEN !SHOW DETAILS - CALL NSCXFH(F_TP,FCAIN) - ELSE IF (ACT.EQ.'EDIT') THEN !EDIT - IF (MODE.EQ.'R') THEN !CHANGE TO UPDATE MODE - MODE='U' !MAKE UPDATE - CALL WNFCL(FCAIN) !CLOSE FILE - IF (.NOT.WNDNOC(' ',' ','WMP',MODE,' ',FILIN)) THEN !CHANGE DATES - CALL WNCTXT(F_TP,'Node is not writable') - GOTO 100 - END IF - IF (.NOT.WNFOP(FCAIN,FILIN,MODE)) THEN !OPEN WMP FILE - CALL WNCTXT(F_TP,'Cannot write to file attached to node') - GOTO 100 - END IF - END IF - CALL NSCEFH(F_TP,FCAIN) !EDIT HEADER - ELSE IF (ACT.EQ.'CONT') THEN !CONT - GOTO 200 !DO MAP - ELSE - GOTO 102 !QUIT - END IF - GOTO 101 !UNKNOWN -C -C DO MAP -C - 200 CONTINUE - IF (.NOT.WNDSTA('WMP_SETS',MXNSET,SETS,FCAIN)) GOTO 102 !GET SETS TO DO - IF (SETS(0,0,1).EQ.0) GOTO 102 !NONE - 201 CONTINUE !DO NEXT SET - IF (.NOT.NMASTG(FCAIN,SETS,MPH,MPHP,SNAM)) GOTO 102 !GET MAP - CALL NMAPMH(F_TP,MPH,SNAM,NODIN) !SHOW MAP HEADER -C -C MAP ACTION -C - 301 CONTINUE - IF (.NOT.WNDPAR('MAP_ACTION',ACT,LEN(ACT),J,'CONT')) THEN !MAP ACTION - IF (E_C.EQ.DWC_ENDOFLOOP) GOTO 101 !^Z, RETRY FILE ACTION - GOTO 301 !RETRY - ELSE IF (E_C.EQ.DWC_NULLVALUE) THEN - GOTO 101 !RETRY FILE ACTION - ELSE IF (E_C.EQ.DWC_WILDCARD) THEN - ACT='CONT' !ASSUME CONT - END IF - IF (ACT.EQ.'NEXT') THEN !NEXT MAP - GOTO 201 !NEXT MAP - ELSE IF (ACT.EQ.'SHOW') THEN !SHOW DETAILS - CALL NMAXMH(F_TP,FCAIN,MPHP,SNAM) - ELSE IF (ACT.EQ.'JOB') THEN !SHOW JOB SUMMARY - CALL NMAJSP(F_TP,FCAIN,MPHJ,SNAM,NODIN) - ELSE IF (ACT.EQ.'EDIT') THEN !EDIT - IF (MODE.EQ.'R') THEN !CHANGE TO UPDATE MODE - MODE='U' !MAKE UPDATE - CALL WNFCL(FCAIN) !CLOSE FILE - IF (.NOT.WNDNOC(' ',' ','WMP',MODE,' ',FILIN)) THEN !CHANGE DATES - CALL WNCTXT(F_TP,'Node is not writable') - GOTO 100 - END IF - IF (.NOT.WNFOP(FCAIN,FILIN,MODE)) THEN !OPEN WMP FILE - CALL WNCTXT(F_TP,'Cannot write to file attached to node') - GOTO 100 - END IF - END IF - CALL NMAEMH(F_TP,FCAIN,MPHP,SNAM) !EDIT - ELSE IF (ACT.EQ.'CONT') THEN !CONT - GOTO 400 !DO DATA - ELSE - GOTO 101 !QUIT - END IF - GOTO 301 !UNKNOWN -C -C DO DATA -C - 400 CONTINUE - 401 CONTINUE - IF (.NOT.WNDPAR('DATA_ACTION',ACT,LEN(ACT),J,'Q')) THEN !ACTION - IF (E_C.EQ.DWC_ENDOFLOOP) GOTO 301 !^Z, RETRY SET ACTION - GOTO 401 !RETRY - ELSE IF (E_C.EQ.DWC_NULLVALUE) THEN - GOTO 301 !RETRY SET ACTION - ELSE IF (E_C.EQ.DWC_WILDCARD) THEN - ACT='Q' !ASSUME > - END IF - CALL WNCAUC(ACT) !MAKE UC - IF (ACT(1:1).EQ.'Q') THEN !QUIT - GOTO 301 -C -C NOISE -C - ELSE IF (ACT(1:1).EQ.'N' .OR. ACT(1:1).EQ.'O') THEN !NOISE - IF (ACT(1:1).EQ.'O') THEN !OFFSET - LOF=.TRUE. - ELSE - LOF=.FALSE. - END IF - DO I=0,3 - TAREA(I,0)=0 !DEFAULT AREA - FAREA(I)=0 !FULL AREA - END DO - FAREA(2)=MPHJ(MPH_NRA_J) !LENGTH LINE - FAREA(3)=MPHJ(MPH_NDEC_J) - TAREA(2,0)=FAREA(2) !DEFAULT=FULL - TAREA(3,0)=FAREA(3) - MXARE2(2)=FAREA(2) !MAX=FULL - MXARE2(3)=FAREA(3) - CALL NMADAR(MXNAR,J0,FAREA,0,MXARE2,TAREA(0,0),PAREA(0,1,0), - 1 TAREA(0,1),PAREA(0,1,1)) !GET AREAS - IF (J0.GT.0) THEN !AREA GIVEN - R0=0.0 !INIT. SUM - IF (LOF) THEN !INIT. HISTOGRAM - CALL WNMHS8(HISBAD,-1,0.25E0) - ELSE - CALL WNMHS8(HISBAD,+1,0.25E0) - END IF - DO I=TAREA(2,1),TAREA(3,1) !ALL LINES - IF (.NOT.WNFRD(FCAIN,LB_E*MPHJ(MPH_NRA_J), - 1 LBUF,MPHJ(MPH_MDP_J)+ - 1 (I+MPHJ(MPH_NDEC_J)/2)*LB_E*MPHJ(MPH_NRA_J))) THEN !READ - CALL WNCTXT(F_TP,'Error reading map') - GOTO 401 - END IF - J2=-32768 !START POINT - DO I1=1,J0 !ALL AREAS - IF (I.GE.PAREA(2,I1,1) .AND. I.LE.PAREA(3,I1,1)) THEN !THIS LINE - J2=MAX(J2,PAREA(0,I1,1)) !START POINT - J1=PAREA(1,I1,1)-J2+1 !LENGTH - DO J3=0,J1-1 - R0=R0+LBUF(J2+MPHJ(MPH_NRA_J)/2+J3) - END DO - CALL WNMHS1(HISBAD,J1, - 1 LBUF(J2+MPHJ(MPH_NRA_J)/2)) !HISTO DATA - J2=PAREA(1,I1,1)+1 !NEXT START POINT - END IF !END SUB-AREA - END DO !END SUB AREAS - END DO !END LINES - CALL WNMHS3(HISBAD,1,F_P) !SHOW HISTOGRAM - CALL WNMHS4(HISBAD,NOIS,F_TP) !GET NOISE (AND OFFSET) - CALL WNMHS9(HISBAD) !CLEAR HISTOGRAM - CALL WNCTXT(F_TP,'Total flux in areas: !8$E7.1',R0) - END IF !END AREA - ELSE IF (ACT(1:1).EQ.'S') THEN !SHOW DATA -C -C DATA DISPLAY -C - DO I=0,3 - TAREA(I,0)=0 !DEFAULT AREA - FAREA(I)=0 !FULL AREA - END DO - FAREA(2)=MPHJ(MPH_NRA_J) !LENGTH LINE - FAREA(3)=MPHJ(MPH_NDEC_J) - CALL NMADAR(1,J0,FAREA,0,MXAREA,TAREA(0,0),PAREA(0,1,0), - 1 TAREA(0,1),PAREA(0,1,1)) !GET AREA - IF (J0.GT.0) THEN !AREA SPECIFIED - CALL WNCTXT(F_TP,'!/ l m!/') !HEADING - R0=0.0 !INIT. SUM - DO I=TAREA(2,1),TAREA(3,1) !ALL LINES - IF (.NOT.WNFRD(FCAIN,LB_E*MPHJ(MPH_NRA_J), - 1 LBUF,MPHJ(MPH_MDP_J)+ - 1 (I+MPHJ(MPH_NDEC_J)/2)*LB_E*MPHJ(MPH_NRA_J))) THEN !READ - CALL WNCTXT(F_TP,'Error reading map') - GOTO 401 - END IF - DO J3=0,TAREA(1,1)-TAREA(0,1) - R0=R0+LBUF(TAREA(0,1)+MPHJ(MPH_NRA_J)/2+J3) - END DO - CALL WNCTXT(F_TP,'!80$13Q1!5$SJ !5$SJ !13C!8$#E7.1', - 1 TAREA(0,1),I,TAREA(1,1)-TAREA(0,1)+1, - 1 LBUF(TAREA(0,1)+MPHJ(MPH_NRA_J)/2)) !SHOW DATA - END DO !END LINES - CALL WNCTXT(F_TP,'Total flux in area: !8$E7.1',R0) - END IF !END AREAS - END IF -C -C NEXT ACTION -C - GOTO 401 !NEXT ACTION -C -C - END diff --git a/src/nmap/nmarfh.for b/src/nmap/nmarfh.for deleted file mode 100644 index 595e032f5cdad35e9259787dc1b648e66cb40e09..0000000000000000000000000000000000000000 --- a/src/nmap/nmarfh.for +++ /dev/null @@ -1,565 +0,0 @@ -C+ NMARFH.FOR -C HjV 940714 -C -C Revisions: -C CMV 940926 Use both SCAL and OFF, variable length headers -C CMV 950116 Initialise return value -C CMV 951221 Catch any decoding errors, report but ignore -C CMV 010101 Decode dates in yyyy-mm-dd as well -C - LOGICAL FUNCTION NMARFH(FBFLEN, FBUF, LFBUF,TP,OLABEL, - 1 MPH,MPHI,MPHJ,MPHE,MPHD, - 2 SCAL,OFF,NRCUB,NRDPTS,RPI,JJ2,FCATAP) !GET HEADER -C -C Read FITS map header -C -C Result: -C -C CALL NMARFH( FBFLEN_J:I, FBUF_C(FBFLEN):O, LFBUF_B(FBFLEN):O, -C TP_J:I, OLABEL_J:I, -C MPH_B(0:*):I, MPHI_I(0:*):I, -C MPHJ_J(0:*):I, MPHE_E(0:*):I, MPHD_D(0:*):I, -C SCAL_E:O,OFF_E:ONRCUB_J:O,NRDPTS_J:O,RPI_E:O, -C JJ2_J:O) -C Read FITS header of type TP (16 or 32) -C from MPH map header in FBUF=lFBUF (with -C length of buffers FBFLEN), -C and return SCALe, # of cubics, # of datapoints, -C Ref. Pixel INDEX (Hor. and Vert.) -C OLABEL is current label. -C JJ2 is the offset on the tape at FCATAP -C (should be zero at entry). -C -C PIN references: -C -C COMMENT Comment line(s) -C -C Include files: -C - INCLUDE 'WNG_DEF' - INCLUDE 'MPH_O_DEF' !MAP HEADER -C -C Parameters: -C -C -C Arguments: -C - INTEGER FBFLEN - CHARACTER*(*) FBUF !FITS BUFFER - BYTE LFBUF(0:FBFLEN-1) ! Equivalenced in calling routine - INTEGER TP !HEADER TYPE (16 OR 32) - INTEGER OLABEL !OUTPUT LABEL - BYTE MPH(0:*) !MPH MAP HEADER - INTEGER*2 MPHI(0:*) - INTEGER MPHJ(0:*) - REAL MPHE(0:*) - DOUBLE PRECISION MPHD(0:*) - INTEGER CNF !SIMULTANEOUS INPUT MAPS - REAL SCAL,OFF !DATA SCALE and OFFSET - INTEGER NRCUB !# OF CUBICS - INTEGER NRDPTS !# OF DATAPOINTS - REAL RPI(0:1) !REFERENCE PIXEL INDEX (HOR,VERT) - INTEGER JJ2 !Pointer on input tape - INTEGER FCATAP !Input tape -C -C Function references: -C - LOGICAL WNDPAR !GET USER DATA - INTEGER STR_MATCH !COMPARE STRINGS - LOGICAL WNFRD !READ DATA -C -C Data declarations: -C - LOGICAL END_FOUND !FOUND END-RECORD? - REAL UNIT !SCALE OUTPUT (200 OR 1) - INTEGER BITPIX !HEADER TYPE (16 OR 32) - REAL BSCALE !DATA SCALE - REAL BZERO ! - CHARACTER*8 BUNIT ! - CHARACTER*4 MAPTYP !MAP TYPE - CHARACTER*2 POLCOD !POLARISATION CODE - CHARACTER*8 DATE !DATE FITS-TAPE MADE - CHARACTER*10 TMP !TMP FOR DATE-OBS - CHARACTER*64 ORIGIN !WHO MADE THIS FITS-TAPE - REAL EPOCH !EPOCHE OF MAP - CHARACTER*12 INSTRUME ! - CHARACTER*12 OBJECT !FIELDNAME - REAL DATE_OBS !OBSERVATION DATE - DOUBLE PRECISION BANDW !TOTAL BANDWIDTH OF OBS(HERTZ) - REAL VEL !CENTRE VELOCITY (M/S) - CHARACTER*12 VELCODE !VELOCITY CODE - REAL VELR !REFERENCE VELOCITY (M/S) - DOUBLE PRECISION FREQR !REFERENCE FREQUENCY (HERTZ) - DOUBLE PRECISION FREQ0 !REST FREQUENCY (HERTZ) - DOUBLE PRECISION PCRA !POINTING CENTRE R.A. (DEG) - DOUBLE PRECISION PCDEC !POINTING CENTRE DEC (DEG) - INTEGER NBLANK !# OF UNDEFINED VALUES - CHARACTER*11 BLGRAD !TAPER TYPE - CHARACTER*11 UVGRID !CONVOLUTION TYPE - INTEGER*2 CORGRID !CORRECT FOR CONVOLUTION - INTEGER*2 CLIP !CLIPPING DONE - INTEGER*2 SUBTR !SOURCE SUBTRACTION - CHARACTER*11 DATTYP !DATA TYPE - CHARACTER*11 UVCDT !UV COORDINATE TYPE - INTEGER*2 DEBEAM !DE-BEAM COUNT - REAL DATAMAX !MAX. INTENSITY - REAL DATAMIN !MIN. INTENSITY - INTEGER NINTF !TOTAL INTERFEROMETERS - INTEGER NFREQ !TOTAL # OF FREQUNECY POINTS - REAL NOISE !NOISE IN MAP - DOUBLE PRECISION NORM !NORM. FACTOR IN FFT - INTEGER FFTRA !FFT SIZE IN R.A. - INTEGER FFTDEC !FFT SIZE IN DEC. - CHARACTER*70 COMMENT !USERS COMMENT - INTEGER NST !# OF SETS IN MAP - INTEGER NPT !# OF INPUT DATA POINTS - INTEGER SETN !# OF SET - INTEGER*2 PCD !PROGRAM CODE - INTEGER UNKNOWN !UNKNOWN LINES - INTEGER NAXIS !# OF AXIS - INTEGER AXIS(8) ! - DOUBLE PRECISION CRVAL(8) ! - DOUBLE PRECISION CRPIX(8) ! - DOUBLE PRECISION CDELT(8) ! - DOUBLE PRECISION CRESL(8) ! - CHARACTER*8 CTYPE(8) !DESCRIPTION -C - INTEGER ML(12) !LENGTH OF MONTHS, FORGET LEAPYEAR - DATA ML/31,28,31,30,31,30,31,31,30,31,30,31/ -C -C INITIALIZE -C - NMARFH=.TRUE. !ASSUME SUCCESS - BITPIX=-1 - NAXIS=-1 - DO I=1,8 - AXIS(I)=0 - CRPIX(I)=0.0 - CRVAL(I)=0.0 - CRESL(I)=0.0 - CTYPE(I)=' ' - END DO - BSCALE=0.0 - BZERO=0.0 - BUNIT=' ' - MAPTYP='MAP' - POLCOD='I' - DATE=' ' - ORIGIN=' ' - EPOCH=0.0 - INSTRUME=' ' - OBJECT=' ' - BANDW=0.0 - VEL=0.0 - VELCODE='UNKNOWN' - VELR=0.0 - FREQR=0.0 - FREQ0=0.0 - PCRA=0.0 - PCDEC=0.0 - NBLANK=-1 - BLGRAD='NATURAL' - UVGRID='GAUSSIAN' - CORGRID=-1 - CLIP=-1 - SUBTR=-1 - DATTYP='MAP' - UVCDT='NORMAL' - DEBEAM=0 - DATAMAX=0.0 - DATAMIN=0.0 - NINTF=0 - NFREQ=0 - NOISE=0.0 - NORM=0.0 - FFTRA=0 - FFTDEC=0 - OLABEL=0 - NPT=-1 - NST=-1 - SETN=-1 - PCD=-1 - COMMENT=' ' -C -C REQUIRED HEADER PARAMETERS -C - END_FOUND=.FALSE. - DO WHILE (.NOT.END_FOUND) -C -C READ NEXT BUFFER -C - IF (.NOT.WNFRD(FCATAP,FBFLEN,LFBUF,JJ2)) THEN !READ FITS HEADER - CALL WNCTXT(F_TP,'Error reading FITS header') - NMARFH=.FALSE. !INDICATE ERROR - RETURN !AND EXIT - END IF - JJ2=JJ2+FBFLEN -C -C DECODE HEADER LINES -C - J=1 - DO WHILE (.NOT.END_FOUND.AND.J.LT.FBFLEN) - I5=0 !IO STATUS DEFAULT OK - IF (FBUF(J:J+6).EQ.'BITPIX ') THEN - READ (FBUF(J+11:),*,IOSTAT=I5) BITPIX - ELSE IF (FBUF(J:J+5).EQ.'NAXIS ') THEN - READ (FBUF(J+11:),*,IOSTAT=I5) NAXIS - ELSE IF (FBUF(J:J+6).EQ.'NAXIS1 ') THEN - READ (FBUF(J+11:),*,IOSTAT=I5) AXIS(1) - ELSE IF (FBUF(J:J+6).EQ.'NAXIS2 ') THEN - READ (FBUF(J+11:),*,IOSTAT=I5) AXIS(2) - ELSE IF (FBUF(J:J+6).EQ.'NAXIS3 ') THEN - READ (FBUF(J+11:),*,IOSTAT=I5) AXIS(3) - ELSE IF (FBUF(J:J+6).EQ.'NAXIS4 ') THEN - READ (FBUF(J+11:),*,IOSTAT=I5) AXIS(4) - ELSE IF (FBUF(J:J+6).EQ.'NAXIS5 ') THEN - READ (FBUF(J+11:),*,IOSTAT=I5) AXIS(5) - ELSE IF (FBUF(J:J+6).EQ.'NAXIS6 ') THEN - READ (FBUF(J+11:),*,IOSTAT=I5) AXIS(6) - ELSE IF (FBUF(J:J+6).EQ.'NAXIS7 ') THEN - READ (FBUF(J+11:),*,IOSTAT=I5) AXIS(7) - ELSE IF (FBUF(J:J+6).EQ.'NAXIS8 ') THEN - READ (FBUF(J+11:),*,IOSTAT=I5) AXIS(8) - ELSE IF (FBUF(J:J+6).EQ.'BSCALE ') THEN - READ (FBUF(J+11:),*,IOSTAT=I5) BSCALE - ELSE IF (FBUF(J:J+5).EQ.'BZERO ') THEN - READ (FBUF(J+11:),*,IOSTAT=I5) BZERO - ELSE IF (FBUF(J:J+5).EQ.'BUNIT ') THEN - CALL NMARFS(BUNIT,FBUF(J:J+80)) - ELSE IF (FBUF(J:J+6).EQ.'MAPTYP ') THEN - CALL NMARFS(MAPTYP,FBUF(J:J+80)) - ELSE IF (FBUF(J:J+3).EQ.'POL ') THEN - CALL NMARFS(POLCOD,FBUF(J:J+80)) - ELSE IF (FBUF(J:J+4).EQ.'DATE ') THEN - CALL NMARFS(DATE,FBUF(J:J+80)) - ELSE IF (FBUF(J:J+6).EQ.'ORIGIN ') THEN - CALL NMARFS(ORIGIN,FBUF(J:J+80)) - ELSE IF (FBUF(J:J+5).EQ.'EPOCH ') THEN - READ (FBUF(J+11:),*,IOSTAT=I5) EPOCH - ELSE IF (FBUF(J:J+7).EQ.'INSTRUME') THEN - CALL NMARFS(INSTRUME,FBUF(J:J+80)) - ELSE IF (FBUF(J:J+6).EQ.'OBJECT ') THEN - CALL NMARFS(OBJECT,FBUF(J:J+80)) - ELSE IF (FBUF(J:J+7).EQ.'DATE-OBS') THEN - IF (INDEX(FBUF(J:J+80),'''').NE.0) THEN - CALL NMARFS(TMP,FBUF(J:J+80)) - IF (TMP(3:3).EQ.'/') THEN !DECODE FROM dd/mm/yy - READ(TMP,'(I2,''/'',I2,''/'',I2)') I1,I2,I3 - DATE_OBS=1900.+REAL(I3)+REAL(I1)/365.25 - ELSE !DECODE FROM yyyy-mm-dd - READ(TMP,'(I4,''-'',I2,''/'',I2)') I3,I2,I1 - DATE_OBS=REAL(I3)+REAL(I1)/365.25 - END IF - IF (I2.GT.12) I2=0 !ONLY 12 MONTHS - DO I=1,I2-1 - DATE_OBS=DATE_OBS+REAL(ML(I)/365.25) - END DO - ELSE - READ (FBUF(J+11:),*,IOSTAT=I5) DATE_OBS - END IF - ELSE IF (FBUF(J:J+5).EQ.'BANDW ') THEN - READ (FBUF(J+11:),*,IOSTAT=I5) BANDW - ELSE IF (FBUF(J:J+3).EQ.'VEL ') THEN - READ (FBUF(J+11:),*,IOSTAT=I5) VEL - ELSE IF (FBUF(J:J+7).EQ.'VELCODE ') THEN - CALL NMARFS(VELCODE,FBUF(J:J+80)) - ELSE IF (FBUF(J:J+4).EQ.'VELR ') THEN - READ (FBUF(J+11:),*,IOSTAT=I5) VELR - ELSE IF (FBUF(J:J+5).EQ.'FREQR ') THEN - READ (FBUF(J+11:),*,IOSTAT=I5) FREQR - ELSE IF (FBUF(J:J+4).EQ.'PCRA ') THEN - READ (FBUF(J+11:),*,IOSTAT=I5) PCRA - ELSE IF (FBUF(J:J+5).EQ.'PCDEC ') THEN - READ (FBUF(J+11:),*,IOSTAT=I5) PCDEC - ELSE IF (FBUF(J:J+6).EQ.'NBLANK ') THEN - READ (FBUF(J+11:),*,IOSTAT=I5) NBLANK - ELSE IF (FBUF(J:J+6).EQ.'BLGRAD ') THEN - CALL NMARFS(BLGRAD,FBUF(J:J+80)) - ELSE IF (FBUF(J:J+6).EQ.'UVGRID ') THEN - CALL NMARFS(UVGRID,FBUF(J:J+80)) - ELSE IF (FBUF(J:J+7).EQ.'CORGRID ') THEN - READ (FBUF(J+11:),*,IOSTAT=I5) CORGRID - ELSE IF (FBUF(J:J+4).EQ.'CLIP ') THEN - READ (FBUF(J+11:),*,IOSTAT=I5) CLIP - ELSE IF (FBUF(J:J+5).EQ.'SUBTR ') THEN - READ (FBUF(J+11:),*,IOSTAT=I5) SUBTR - ELSE IF (FBUF(J:J+6).EQ.'DATTYP ') THEN - CALL NMARFS(DATTYP,FBUF(J:J+80)) - ELSE IF (FBUF(J:J+5).EQ.'UVCDT ') THEN - CALL NMARFS(UVCDT,FBUF(J:J+80)) - ELSE IF (FBUF(J:J+6).EQ.'DEBEAM ') THEN - READ (FBUF(J+11:),*,IOSTAT=I5) DEBEAM - ELSE IF (FBUF(J:J+7).EQ.'DATAMAX ') THEN - READ (FBUF(J+11:),*,IOSTAT=I5) DATAMAX - ELSE IF (FBUF(J:J+7).EQ.'DATAMIN ') THEN - READ (FBUF(J+11:),*,IOSTAT=I5) DATAMIN - ELSE IF (FBUF(J:J+5).EQ.'NINTF ') THEN - READ (FBUF(J+11:),*,IOSTAT=I5) NINTF - ELSE IF (FBUF(J:J+5).EQ.'NFREQ ') THEN - READ (FBUF(J+11:),*,IOSTAT=I5) CNF - ELSE IF (FBUF(J:J+5).EQ.'NOISE ') THEN - READ (FBUF(J+11:),*,IOSTAT=I5) NOISE - ELSE IF (FBUF(J:J+4).EQ.'NORM ') THEN - READ (FBUF(J+11:),*,IOSTAT=I5) NORM - ELSE IF (FBUF(J:J+5).EQ.'FFTRA ') THEN - READ (FBUF(J+11:),*,IOSTAT=I5) FFTRA - ELSE IF (FBUF(J:J+6).EQ.'FFTDEC ') THEN - READ (FBUF(J+11:),*,IOSTAT=I5) FFTDEC - ELSE IF (FBUF(J:J+6).EQ.'MAPLAB ') THEN - READ (FBUF(J+11:),*,IOSTAT=I5) OLABEL - ELSE IF (FBUF(J:J+6).EQ.'INSECT ') THEN - READ (FBUF(J+11:),*,IOSTAT=I5) NST - ELSE IF (FBUF(J:J+5).EQ.'INPTS ') THEN - READ (FBUF(J+11:),*,IOSTAT=I5) NPT - ELSE IF (FBUF(J:J+5).EQ.'SETNR ') THEN - READ (FBUF(J+11:),*,IOSTAT=I5) SETN - ELSE IF (FBUF(J:J+7).EQ.'COMMENT ') THEN - IF (COMMENT.EQ.' ') COMMENT=FBUF(J+10:j+79) - ELSE IF (FBUF(J:J+6).EQ.'CRVAL1 ') THEN - READ (FBUF(J+11:),*,IOSTAT=I5) CRVAL(1) - ELSE IF (FBUF(J:J+6).EQ.'CRPIX1 ') THEN - READ (FBUF(J+11:),*,IOSTAT=I5) CRPIX(1) - ELSE IF (FBUF(J:J+6).EQ.'CDELT1 ') THEN - READ (FBUF(J+11:),*,IOSTAT=I5) CDELT(1) - ELSE IF (FBUF(J:J+6).EQ.'CRESL1 ') THEN - READ (FBUF(J+11:),*,IOSTAT=I5) CRESL(1) - ELSE IF (FBUF(J:J+6).EQ.'CTYPE1 ') THEN - CALL NMARFS(CTYPE(1),FBUF(J:J+80)) - ELSE IF (FBUF(J:J+6).EQ.'CRVAL2 ') THEN - READ (FBUF(J+11:),*,IOSTAT=I5) CRVAL(2) - ELSE IF (FBUF(J:J+6).EQ.'CRPIX2 ') THEN - READ (FBUF(J+11:),*,IOSTAT=I5) CRPIX(2) - ELSE IF (FBUF(J:J+6).EQ.'CDELT2 ') THEN - READ (FBUF(J+11:),*,IOSTAT=I5) CDELT(2) - ELSE IF (FBUF(J:J+6).EQ.'CRESL2 ') THEN - READ (FBUF(J+11:),*,IOSTAT=I5) CRESL(2) - ELSE IF (FBUF(J:J+6).EQ.'CTYPE2 ') THEN - CALL NMARFS(CTYPE(2),FBUF(J:J+80)) - ELSE IF (FBUF(J:J+6).EQ.'CRVAL3 ') THEN - READ (FBUF(J+11:),*,IOSTAT=I5) CRVAL(3) - ELSE IF (FBUF(J:J+6).EQ.'CRPIX3 ') THEN - READ (FBUF(J+11:),*,IOSTAT=I5) CRPIX(3) - ELSE IF (FBUF(J:J+6).EQ.'CDELT3 ') THEN - READ (FBUF(J+11:),*,IOSTAT=I5) CDELT(3) - ELSE IF (FBUF(J:J+6).EQ.'CRESL3 ') THEN - READ (FBUF(J+11:),*,IOSTAT=I5) CRESL(3) - ELSE IF (FBUF(J:J+6).EQ.'CTYPE3 ') THEN - CALL NMARFS(CTYPE(3),FBUF(J:J+80)) - ELSE IF (FBUF(J:J+6).EQ.'CRVAL4 ') THEN - READ (FBUF(J+11:),*,IOSTAT=I5) CRVAL(4) - ELSE IF (FBUF(J:J+6).EQ.'CRPIX4 ') THEN - READ (FBUF(J+11:),*,IOSTAT=I5) CRPIX(4) - ELSE IF (FBUF(J:J+6).EQ.'CDELT4 ') THEN - READ (FBUF(J+11:),*,IOSTAT=I5) CDELT(4) - ELSE IF (FBUF(J:J+6).EQ.'CRESL4 ') THEN - READ (FBUF(J+11:),*,IOSTAT=I5) CRESL(4) - ELSE IF (FBUF(J:J+6).EQ.'CTYPE4 ') THEN - CALL NMARFS(CTYPE(4),FBUF(J:J+80)) - ELSE IF (FBUF(J:J+6).EQ.'CRVAL5 ') THEN - READ (FBUF(J+11:),*,IOSTAT=I5) CRVAL(5) - ELSE IF (FBUF(J:J+6).EQ.'CRPIX5 ') THEN - READ (FBUF(J+11:),*,IOSTAT=I5) CRPIX(5) - ELSE IF (FBUF(J:J+6).EQ.'CDELT5 ') THEN - READ (FBUF(J+11:),*,IOSTAT=I5) CDELT(5) - ELSE IF (FBUF(J:J+6).EQ.'CRESL5 ') THEN - READ (FBUF(J+11:),*,IOSTAT=I5) CRESL(5) - ELSE IF (FBUF(J:J+6).EQ.'CTYPE5 ') THEN - CALL NMARFS(CTYPE(5),FBUF(J:J+80)) - ELSE IF (FBUF(J:J+6).EQ.'CRVAL6 ') THEN - READ (FBUF(J+11:),*,IOSTAT=I5) CRVAL(6) - ELSE IF (FBUF(J:J+6).EQ.'CRPIX6 ') THEN - READ (FBUF(J+11:),*,IOSTAT=I5) CRPIX(6) - ELSE IF (FBUF(J:J+6).EQ.'CDELT6 ') THEN - READ (FBUF(J+11:),*,IOSTAT=I5) CDELT(6) - ELSE IF (FBUF(J:J+6).EQ.'CRESL6 ') THEN - READ (FBUF(J+11:),*,IOSTAT=I5) CRESL(6) - ELSE IF (FBUF(J:J+6).EQ.'CTYPE6 ') THEN - CALL NMARFS(CTYPE(6),FBUF(J:J+80)) - ELSE IF (FBUF(J:J+6).EQ.'CRVAL7 ') THEN - READ (FBUF(J+11:),*,IOSTAT=I5) CRVAL(7) - ELSE IF (FBUF(J:J+6).EQ.'CRPIX7 ') THEN - READ (FBUF(J+11:),*,IOSTAT=I5) CRPIX(7) - ELSE IF (FBUF(J:J+6).EQ.'CDELT7 ') THEN - READ (FBUF(J+11:),*,IOSTAT=I5) CDELT(7) - ELSE IF (FBUF(J:J+6).EQ.'CRESL7 ') THEN - READ (FBUF(J+11:),*,IOSTAT=I5) CRESL(7) - ELSE IF (FBUF(J:J+6).EQ.'CTYPE7 ') THEN - CALL NMARFS(CTYPE(7),FBUF(J:J+80)) - ELSE IF (FBUF(J:J+6).EQ.'CRVAL8 ') THEN - READ (FBUF(J+11:),*,IOSTAT=I5) CRVAL(8) - ELSE IF (FBUF(J:J+6).EQ.'CRPIX8 ') THEN - READ (FBUF(J+11:),*,IOSTAT=I5) CRPIX(8) - ELSE IF (FBUF(J:J+6).EQ.'CDELT8 ') THEN - READ (FBUF(J+11:),*,IOSTAT=I5) CDELT(8) - ELSE IF (FBUF(J:J+6).EQ.'CRESL8 ') THEN - READ (FBUF(J+11:),*,IOSTAT=I5) CRESL(8) - ELSE IF (FBUF(J:J+6).EQ.'CTYPE8 ') THEN - CALL NMARFS(CTYPE(8),FBUF(J:J+80)) - ELSE IF (FBUF(J:J+4).EQ.'END ') THEN - END_FOUND=.TRUE. - ELSE - UNKNOWN=UNKNOWN+1 - END IF - IF (I5.NE.0) THEN - CALL WNCTXT(F_TP, - 1 'Error decoding header card (ignored):!/!AS', - 1 FBUF(J:J+79)) - END IF - J=J+80 !NEXT CARD IN HEADER - END DO - END DO !NEXT HEADER RECORD -C -C FILL MPH -C - 100 TP=BITPIX - CNF=NFREQ - IF (PCRA.EQ.0) PCRA=CRVAL(1) - IF (PCDEC.EQ.0) PCDEC=CRVAL(2) - UNIT=200. - IF (BUNIT(1:7).EQ.'JY/BEAM') THEN - IF (MAPTYP.EQ.'AP ') THEN - UNIT=1. - END IF - ELSE IF (BUNIT.EQ.'W.U. ') THEN - UNIT=1. - END IF -C -C Before release 4.75, the scaling for the AP was written to -C tape incorrectly. RFITS repaired this. Now WFITS has been -C repaired, so RFITS uses the value from tape (W.U. regardless -C of units). -C - OFF=BZERO - IF (MAPTYP.EQ.'AP ') THEN - SCAL=1./BSCALE - ELSE IF (MAPTYP.EQ.'PA ') THEN - SCAL=1./BSCALE*(180./PI) ! MPH needs Radians - ELSE - SCAL=1./(BSCALE*UNIT) ! MPH needs W.U. - END IF - IF (INSTRUME.EQ.'ATCA') THEN - MPHJ(MPH_INST_J)=1 - ELSE - MPHJ(MPH_INST_J)=0 - END IF - MPHJ(MPH_NRA_J)=AXIS(1) - MPHJ(MPH_NDEC_J)=AXIS(2) - MPHD(MPH_RA_D)=CRVAL(1)/360.D0 - MPHD(MPH_SRA_D)=-CDELT(1)/360.D0 - MPHD(MPH_DEC_D)=CRVAL(2)/360.D0 - MPHD(MPH_SDEC_D)=CDELT(2)/360.D0 - MPHE(MPH_FRA_E)=-(CDELT(1)*AXIS(1))/360.D0 - MPHE(MPH_FDEC_E)=(CDELT(2)*AXIS(2))/360.D0 - MPHD(MPH_FRQ_D)=(CRVAL(3)+CDELT(3)*(AXIS(3)-CRPIX(3)))/1.D6 - CALL WNGMV(MPH_FNM_N,OBJECT,MPH(MPH_FNM_1)) - CALL WNGMV(MPH_TYP_N,MAPTYP,MPH(MPH_TYP_1)) - CALL WNGMV(MPH_POL_N,POLCOD,MPH(MPH_POL_1)) - MPHE(MPH_EPO_E)=EPOCH - MPHE(MPH_OEP_E)=DATE_OBS - MPHD(MPH_BDW_D)=BANDW/1.D6 - MPHE(MPH_VEL_E)=VEL - MPHE(MPH_VELR_E)=VELR - MPHD(MPH_FRQC_D)=FREQR/1.D6 - MPHD(MPH_FRQ0_D)=FREQ0/1.D6 - MPHD(MPH_RAO_D)=PCRA/360.D0 - MPHD(MPH_DECO_D)=PCDEC/360.D0 - MPHE(MPH_MAX_E)=DATAMAX*UNIT - MPHE(MPH_MIN_E)=DATAMIN*UNIT - MPHJ(MPH_NBL_J)=NINTF - MPHE(MPH_NOS_E)=NOISE*UNIT - MPHD(MPH_SUM_D)=NORM - MPHJ(MPH_FSR_J)=FFTRA - MPHJ(MPH_FSD_J)=FFTDEC - MPHJ(MPH_NST_J)=NST - MPHJ(MPH_NPT_J)=NPT - MPHJ(MPH_SETN_J)=SETN - MPHI(MPH_OYR_I)=INT(DATE_OBS)-1900. - MPHI(MPH_ODY_I)=NINT((DATE_OBS-(1900.+MPHI(MPH_OYR_I)))*365.25) - MPHD(MPH_SHR_D)=(MPHJ(MPH_NRA_J)/2+1.D0-CRPIX(1))* - 1 MPHD(MPH_SRA_D) - MPHD(MPH_SHD_D)=(MPHJ(MPH_NDEC_J)/2+1.D0-CRPIX(2))* - 1 MPHD(MPH_SDEC_D) - IF (VELCODE.EQ.'UNKNOWN') THEN - MPHJ(MPH_VELC_J)=0 - MPHD(MPH_FRQO_D)=CRVAL(3)/1.D6 - ELSE - MPHD(MPH_FRQV_D)=CRVAL(3)/1.D6 - IF (VELCODE.EQ.'RHEL') THEN - MPHJ(MPH_VELC_J)=1 - ELSE IF (VELCODE.EQ.'RLSR') THEN - MPHJ(MPH_VELC_J)=2 - ELSE IF (VELCODE.EQ.'OHEL') THEN - MPHJ(MPH_VELC_J)=3 - ELSE IF (VELCODE.EQ.'OLSR') THEN - MPHJ(MPH_VELC_J)=4 - END IF - END IF - IF (BLGRAD.EQ.'GAUSSIAN') THEN - MPHI(MPH_CD_I+0)=1 - ELSE IF (BLGRAD.EQ.'LINEAR') THEN - MPHI(MPH_CD_I+0)=2 - ELSE IF (BLGRAD.EQ.'NATURAL') THEN - MPHI(MPH_CD_I+0)=3 - ELSE IF (BLGRAD.EQ.'OVERR') THEN - MPHI(MPH_CD_I+0)=4 - ELSE IF (BLGRAD.EQ.'RGAUSS') THEN - MPHI(MPH_CD_I+0)=5 - ELSE - MPHI(MPH_CD_I+0)=0 - END IF - IF (UVGRID.EQ.'GAUSSIAN') THEN - MPHI(MPH_CD_I+1)=1 - ELSE IF (UVGRID.EQ.'BOX') THEN - MPHI(MPH_CD_I+1)=2 - ELSE IF (UVGRID.EQ.'PROLATE 4*4') THEN - MPHI(MPH_CD_I+1)=3 - ELSE IF (UVGRID.EQ.'EXP*SINC') THEN - MPHI(MPH_CD_I+1)=4 - ELSE IF (UVGRID.EQ.'PROLATE 6*6') THEN - MPHI(MPH_CD_I+1)=5 - ELSE - MPHI(MPH_CD_I+1)=0 - END IF - MPHI(MPH_CD_I+2)=CORGRID - MPHI(MPH_CD_I+3)=CLIP - MPHI(MPH_CD_I+4)=SUBTR - IF (DATTYP.EQ.'NORMAL') THEN - MPHI(MPH_CD_I+5)=1 - ELSE IF (DATTYP.EQ.'COSINE') THEN - MPHI(MPH_CD_I+5)=2 - ELSE IF (DATTYP.EQ.'SINE') THEN - MPHI(MPH_CD_I+5)=3 - ELSE IF (DATTYP.EQ.'AMPLITUDE') THEN - MPHI(MPH_CD_I+5)=4 - ELSE IF (DATTYP.EQ.'PHASE') THEN - MPHI(MPH_CD_I+5)=5 - ELSE - MPHI(MPH_CD_I+5)=0 - END IF - IF (UVCDT.EQ.'NORMAL') THEN - MPHI(MPH_CD_I+6)=0 - ELSE IF (UVCDT.EQ.'BAS-HA') THEN - MPHI(MPH_CD_I+6)=1 - ELSE IF (UVCDT.EQ.'IFR-HA') THEN - MPHI(MPH_CD_I+6)=2 - ELSE - MPHI(MPH_CD_I+6)=-1 - END IF - MPHI(MPH_CD_I+7)=DEBEAM - CALL WNGMV(MPH_UCM_N,COMMENT,MPH(MPH_UCM_1)) - IF (STR_MATCH('NMAP',ORIGIN)) THEN - MPHI(MPH_PCD_I)=0 - ELSE - END IF - NRCUB=1 - DO I1=3,NAXIS - NRCUB=NRCUB*AXIS(I1) !# OF CUBICS - END DO - NRDPTS=AXIS(1)*AXIS(2) !# OF DATAPOINTS - RPI(0)=CRPIX(1) !REF.PIX. HORIZONTAL INDEX - RPI(1)=CRPIX(2) !REF.PIX. VERTICAL INDEX -C -C - RETURN -C - END diff --git a/src/nmap/nmarfs.for b/src/nmap/nmarfs.for deleted file mode 100644 index bd6830fe73788d5a531c924db42a0582846173cc..0000000000000000000000000000000000000000 --- a/src/nmap/nmarfs.for +++ /dev/null @@ -1,49 +0,0 @@ -C+ NMARFS.FOR -C CMV 940929 -C -C Revisions: -C CMV 940929 Created -C - SUBROUTINE NMARFS(OUT,IN) -C -C Convert FITS string -C -C Result: -C -C CALL NMAWFS( OUT_C(*), IN_C(*) ) -C Copies FITS String in header record IN to OUT -C -C PIN references: -C -C Include files: -C - INCLUDE 'WNG_DEF' - INCLUDE 'MPH_O_DEF' !MAP HEADER -C -C Parameters: -C -C -C Arguments: -C - CHARACTER*(*) IN !INPUT FITS HEADER RECORD - CHARACTER*(*) OUT !OUTPUT STRING -C - OUT=' ' !DEFAULT TO BLANK - I1=10 - DO WHILE (IN(I1:I1).EQ.' '.AND.I1.LT.LEN(IN)) !SKIP SPACES - I1=I1+1 - END DO -C - IF (IN(I1:I1).EQ.'''') THEN !QUOTED STRING - I1=I1+1 - I2=I1 - DO WHILE (IN(I2:I2).NE.''''.AND.I2.LE.LEN(IN)) !FIND END - I2=I2+1 - END DO - OUT=IN(I1:I2-1) !COPY - ELSE IF (I1.LT.LEN(IN)) THEN !UNQUOTED STRING - OUT=IN(I1:) !COPY - END IF -C - RETURN - END diff --git a/src/nmap/nmarft.for b/src/nmap/nmarft.for deleted file mode 100644 index 95849819ad956e0666c3560f6fdf92a8e1954a07..0000000000000000000000000000000000000000 --- a/src/nmap/nmarft.for +++ /dev/null @@ -1,280 +0,0 @@ -C+ NMARFT.FOR -C HjV 940714 -C -C Revisions: -C CMV 940926 Use both SCAL and OFF, variable length headers -C JPH 950116 No missing label report for wildcard label -C HjV 950131 Typo in calculation MIN DEC position, buffer too small -C CMV 960126 Message if LABEL=* and diskfile not found -C HjV 970407 Check for return status after WNFRD -C - SUBROUTINE NMARFT -C -C Read FITS format in WMP maps -C -C -C Result: -C -C CALL NMAWFT Read FITS tape -C -C Include files: -C - INCLUDE 'WNG_DEF' - INCLUDE 'GFH_O_DEF' !GENERAL FILE HEADER - INCLUDE 'SGH_O_DEF' !SUB-GROUP HEADER - INCLUDE 'NMA_DEF' - INCLUDE 'MPH_O_DEF' !MAP HEADER -C -C Parameters: -C - INTEGER FBFLEN !FITS BUFFER LENGTH - PARAMETER (FBFLEN=2880) -C -C Arguments: -C -C -C Function references: -C - LOGICAL NMARFH !READ FITS HEADER - LOGICAL WNFMOU !MOUNT TAPE - LOGICAL WNFOP,WNFOPF !OPEN FILE - LOGICAL WNFWR !WRITE DATA - LOGICAL WNFRD !READ DATA - INTEGER WNFTLB !CURRENT TAPE LABEL - CHARACTER*32 WNTTSG !MAP SET NAME - INTEGER WNCALN !STRING LENGTH - LOGICAL WNDLNF,WNDLNG,WNDLNK !LINK SUB-GROUP - INTEGER WNFEOF !FILE POINTER - LOGICAL NMASTG !GET MAP SET -C -C Data declarations: -C - INTEGER TP !# OF BITS PER DATAPOINT - CHARACTER*160 OFILE !FILE NAME - INTEGER MPHP !MAP HEADER POINTER - BYTE MPH(0:MPHHDL-1) !MAP HEADER - INTEGER*2 MPHI(0:MPHHDL/2-1) - INTEGER MPHJ(0:MPHHDL/4-1) - REAL MPHE(0:MPHHDL/4-1) - DOUBLE PRECISION MPHD(0:MPHHDL/8-1) - EQUIVALENCE (MPH,MPHI,MPHJ,MPHE,MPHD) - CHARACTER*(FBFLEN) FBUF !FITS BUFFER - BYTE LFBUF(0:FBFLEN-1) - INTEGER*2 IFBUF(0:FBFLEN/2-1) - INTEGER JFBUF(0:FBFLEN/4-1) - REAL EFBUF(0:FBFLEN/4-1) - EQUIVALENCE (FBUF,LFBUF,IFBUF,JFBUF,EFBUF) - REAL INBUF(0:FBFLEN-1) !MAP LINE BUFFER - REAL SCAL,OFF !DATA SCALE and OFFSET - INTEGER*2 ITRB(0:3) !DATA TRANSLATION I - DATA ITRB/2,1440,0,1/ - INTEGER*2 JTRB(0:3) !DATA TRANSLATION J - DATA JTRB/3,720,0,1/ - INTEGER*2 ETRB(0:3) !DATA TRANSLATION E - DATA ETRB/4,720,0,1/ - INTEGER*2 PLC(0:1,0:7) !POL. CODES - DATA PLC/'XX',0,'XY',1,'YX',2,'YY',3, - 1 'I ',0,'Q ',2,'U ',2,'V ',3/ - INTEGER TPC(0:1,0:7) !TYPE CODES - DATA TPC/'MAP ',0,'AP ',1,'COVE',2,'REAL',3, - 1 'IMAG',4,'AMPL',5,'PHAS',6,'HOLO',7/ - INTEGER ILABEL !LABEL TO PROCESS - INTEGER NRCUB !# OF CUBICS - INTEGER NRDPTS !# OF DATAPOINTS - REAL RPI(0:1) !REFERENCE PIXEL INDEX (HOR,VERT) -C- -C -C INIT -C - IF (.NOT.WNDLNG(GFH_LINKG_1,0,SGH_GROUPN_1,FCAOUT, - 1 SGPH(0),SGNR(0))) THEN !CREATE JOB LEVEL - 30 CONTINUE - CALL WNCTXT(F_TP,'Error creating sub-group') - CALL WNGEX !STOP - END IF -C -C OPEN INPUT -C - J=0 - 20 CONTINUE - J=J+1 !COUNT INPUT LABEL - IF (NLAB.LT.0) THEN !ALL LABELS ON TAPE - ILABEL=J !NEXT INPUT LABEL - ELSE IF (J.LE.NLAB) THEN - ILABEL=ILAB(J) !NEXT INPUT LABEL - ELSE - GOTO 800 !READY WITH JOB - END IF - IF (IUNIT.EQ.'D') THEN - CALL WNCTXS(OFILE,'!AS\.!6$ZJ',FILIN,ILABEL) !MAKE FILE NAME - IF (.NOT.WNFOP(FCATAP,OFILE(1:WNCALN(OFILE)),'R')) THEN - IF (NLAB.GT.0) THEN - CALL WNCTXT(F_TP,'Cannot open input file !AS',OFILE) - ELSE - CALL WNCTXT(F_TP,'No files found for !AS',FILIN) - CALL WNCTXT(F_T,'Expecting file !AS',OFILE) - END IF - GOTO 800 - END IF - ELSE - IF (ILABEL.LE.0) THEN !AT END OF TAPE - IF (.NOT.WNFOPF(FCATAP,' ','R',0,FBFLEN,80,0)) THEN - 51 CONTINUE - CALL WNCTXT(F_TP,'Cannot open input tape') - GOTO 800 - END IF - ILABEL=WNFTLB(FCATAP) !LABEL - ELSE - IF (.NOT.WNFOPF(FCATAP,' ','R',0,FBFLEN, - 1 80,ILABEL)) GOTO 51 !OPEN TAPE - END IF - CALL WNCTXS(OFILE,'!6$ZJ',ILABEL) !LABEL NAME - END IF - IF (.NOT.WNDLNG(SGPH(0)+SGH_LINKG_1,0,SGH_GROUPN_1, - 1 FCAOUT,SGPH(1),SGNR(1))) GOTO 30 !CREATE FIELD -C -C READ HEADER DATA -C - J2=0 !OUTPUT POINTER - CALL WNGMVZ(MPH__L,MPH) !CLEAR MAP HEADER - IF (.NOT.NMARFH(FBFLEN,FBUF,LFBUF,TP,ILABEL-1, - 1 MPH,MPHI,MPHJ,MPHE,MPHD, - 2 SCAL,OFF,NRCUB,NRDPTS,RPI,J2,FCATAP)) GOTO 800 !GET HEADER -C -C WRITE MPH -C - IF (.NOT.WNDLNG(SGPH(1)+SGH_LINKG_1,0,SGH_GROUPN_1, - 1 FCAOUT,SGPH(2),SGNR(2))) GOTO 30 !CREATE CHANNEL - I1=0 !POL. CODE - DO I=0,7 - IF (MPHI(MPH_POL_1/LB_I).EQ.PLC(0,I)) I1=PLC(1,I) - END DO - IF (.NOT.WNDLNF(SGPH(2)+SGH_LINKG_1,I1,SGH_GROUPN_1, - 1 FCAOUT,SGPH(3),SGNR(3))) GOTO 30 !CREATE CHANNEL - I1=0 !TYPE CODE - DO I=0,7 - IF (MPHJ(MPH_TYP_1/LB_J).EQ.TPC(0,I)) I1=TPC(1,I) - END DO - IF (.NOT.WNDLNF(SGPH(3)+SGH_LINKG_1,I1,SGH_GROUPN_1, - 1 FCAOUT,SGPH(4),SGNR(4))) GOTO 30 !CREATE CHANNEL - MPHI(MPH_LEN_I)=MPH__L !LENGTH - MPHI(MPH_VER_I)=MPH__V !VERSION - MPHI(MPH_DCD_I)=5 !REAL VALUES - J4=0 !OUTPUT BUF POINTER - DO I2=1,NRCUB - MPHP=WNFEOF(FCAOUT) !MAP HEADER POINTER - IF (.NOT.WNFWR(FCAOUT,MPH__L,MPH,MPHP)) THEN !WRITE HEADER - CALL WNCTXT(F_TP,'Error writing !AS',FILOUT) - GOTO 800 - END IF - IF (.NOT.WNDLNK(GFH_LINK_1,MPHP, - 1 MPH_SETN_1,FCAOUT)) GOTO 30 !LINK MAP - IF (.NOT.WNDLNG(SGPH(4)+SGH_LINKG_1,MPHP,SGH_GROUPN_1, - 1 FCAOUT,SGPH(5),SGNR(5))) GOTO 30 !CREATE CHANNEL - IF (.NOT.WNFRD(FCAOUT,MPH__L,MPH,MPHP)) GOTO 30 !REREAD HEADER - MPHJ(MPH_MDP_J)=WNFEOF(FCAOUT) !MAP DATA POINTER - J0=MPHJ(MPH_MDP_J) !OUTPUT POINTER -C -C READ MAP DATA -C - J3=0 !# OF DATAPOINTS PROCESSED - MPHE(MPH_MAX_E)=-1E36 !MAX - MPHJ(MPH_MXR_J)=-1 !POSITION MAX. IN RA - MPHJ(MPH_MXD_J)=-1 !POSITION MAX. IN DEC - MPHE(MPH_MIN_E)=1E36 !MIN - MPHJ(MPH_MNR_J)=-1 !POSITION MIN. IN RA - MPHJ(MPH_MND_J)=-1 !POSITION MIN. IN DEC - DO WHILE (J3.LT.NRDPTS) - IF (.NOT.WNFRD(FCATAP,FBFLEN,LFBUF,J2)) THEN !READ FITS BLOCK - IF (E_C .NE. '00000870'X .AND. E_C .NE. '00000000'X) THEN - CALL WNCTXT(F_TP,'ERROR: ') - CALL WNCTXT(F_TP,'ERROR: Error reading FITS DATA') - CALL WNCTXT(F_TP,'ERROR: Program halted with error !XJ',E_C) - CALL WNCTXT(F_TP,'ERROR: ') - ENDIF - GOTO 800 - END IF - J2=J2+FBFLEN !INPUT DISK POINTER - IF (TP.EQ.8) THEN - J4=FBFLEN - DO I4=0,J4-1 !INPUT BYTES - I1=LFBUF(I4) - IF (I1.LT.0) I1=I1+255 - INBUF(I4)=I1/SCAL+OFF !SCALE DATA - END DO - ELSE IF (TP.EQ.16) THEN - CALL WNTTTL(FBFLEN,IFBUF,ITRB,5) - J4=FBFLEN/LB_I - DO I4=0,J4-1 !INPUT WORDS - INBUF(I4)=IFBUF(I4)/SCAL+OFF !SCALE DATA - END DO - ELSE IF (TP.EQ.32) THEN !32 BITS - CALL WNTTTL(FBFLEN,JFBUF,JTRB,5) - J4=FBFLEN/LB_J - DO I4=0,J4-1 !INPUT WORDS - INBUF(I4)=JFBUF(I4)/SCAL+OFF !SCALE DATA - END DO - ELSE IF (TP.EQ.-32) THEN !REAL - CALL WNTTTL(FBFLEN,EFBUF,ETRB,5) - J4=FBFLEN/LB_E - DO I4=0,J4-1 !INPUT WORDS - INBUF(I4)=EFBUF(I4)/SCAL+OFF !SCALE DATA - END DO - ELSE !UNKNOWN INPUT TYPE - CALL WNCTXT(F_TP,'ERROR: Unknown BITPIX !UJ',TP) - CALL WNCTXT(F_TP,'Cannot write map data, aborting...') - GOTO 800 - END IF -C - IF (J3+J4.GT.NRDPTS) J4=NRDPTS-J3 !FORGET REST OF RECORD - IF (.NOT.WNFWR(FCAOUT,LB_E*J4,INBUF,J0)) THEN !WRITE A RECORD - 44 CALL WNCTXT(F_TP,'Error writing data') - GOTO 800 - END IF - J0=J0+LB_E*J4 -C - DO I4=0,J4-1 - J3=J3+1 !COUNT DATAPOINT - IF (INBUF(I4).GE.MPHE(MPH_MAX_E)) THEN - MPHE(MPH_MAX_E)=INBUF(I4) !MAX - MPHJ(MPH_MXR_J)=MOD(J3,MPHJ(MPH_NRA_J)) !POSITION IN RA - MPHJ(MPH_MXD_J)=J3/MPHJ(MPH_NRA_J) !POSITION IN DEC - ELSE IF (INBUF(I4).LE.MPHE(MPH_MIN_E)) THEN - MPHE(MPH_MIN_E)=INBUF(I4) !MIN - MPHJ(MPH_MNR_J)=MOD(J3,MPHJ(MPH_NRA_J)) !POSITION IN RA - MPHJ(MPH_MND_J)=J3/MPHJ(MPH_NRA_J) !POSITION IN DEC - END IF - END DO - END DO -C -C READY WITH THIS MAP -C - MPHJ(MPH_MXR_J)=MPHJ(MPH_MXR_J)-RPI(0) !POSITION MAX. IN RA - MPHJ(MPH_MXD_J)=MPHJ(MPH_MXD_J)-RPI(1)+1 !POSITION MAX. IN DEC - MPHJ(MPH_MNR_J)=MPHJ(MPH_MNR_J)-RPI(0) !POSITION MIN. IN RA - MPHJ(MPH_MND_J)=MPHJ(MPH_MND_J)-RPI(1)+1 !POSITION MIN. IN DEC - IF (.NOT.WNFWR(FCAOUT,MPH__L,MPH,MPHP)) THEN !REWRITE HEADER - CALL WNCTXT(F_TP,'Error writing !AS',FILOUT) - GOTO 800 - END IF - SGNR(6)=-1 - CALL WNCTXT(F_TP,'Map !AS (!AD) loaded from !AS', - 1 WNTTSG(SGNR,0),MPH(MPH_FNM_1), - 2 MPH_FNM_N,OFILE) -cc CALL NMAPMH(F_TP,MPH,SGNR,NODOUT) !PRINT MAP-HEADER - END DO !NEXT CUBE-VLAK -C -C READY -C - CALL WNFCL(FCATAP) !CLOSE INPUT - GOTO 20 !NEXT LABEL -C - 800 CONTINUE - CALL WNFCL(FCATAP) !CLOSE INPUT - CALL WNFDMO(FCATAP) !DISMOUNT INPUT - CALL WNFCL(FCAOUT) !CLOSE OUTPUT -C - RETURN -C -C - END diff --git a/src/nmap/nmascn.for b/src/nmap/nmascn.for deleted file mode 100644 index e20f20911b5147be484d4ee78ed866d5c5f3c304..0000000000000000000000000000000000000000 --- a/src/nmap/nmascn.for +++ /dev/null @@ -1,355 +0,0 @@ -C+ NMASCN.FOR -C WNB 910305 -C -C Revisions: -C WNB 910815 Make circular uv-area selection -C WNB 910923 Sign shifts -C WNB 911009 Correct baseline-ifr for circular uv-area -C WNB 911025 Perfection mosaicking -C WNB 920421 Scale for BASHA/IFRHA -C WNB 920423 idem -C WNB 920424 Cater for autocorrelation in IFR-HA -C WNB 920515 Change SHIFT for BASHA, IFRHA to normal position shift -C WNB 920817 Add circular weights -C WNB 921104 Correct for left half (U<0) part of UV plane -C WNB 930826 New model data -C WNB 931008 Add MINST -C CMV 940601 Add update of Job Summary Log -C JPH 940930 Add code for CENTRE -C WNB 950809 Add code for polarised intensity -C WNB 950817 More Pol. Int. buffers -C JPH 960403 Add comment on code for CENTRE -C -C - SUBROUTINE NMASCN(FCA,CHHA,STH,IFRT,ANG,BASEL,IRED,TAPER,SCAN, - 1 STP,SRA,SDEC,LM0,FRQ0,TF,MINST, - 1 CDAT,APDAT,UV,FTBUF,FTW,FTBE,FTBJ, - 1 NOTPT) -C -C Read one scan and correct for everything -C -C Result: -C -C CALL NMASCN ( FCA_J:I, CHHA_E(0:1):I, STH_B(0:*), IFRT_I(0:*), -C ANG_E(0:2,0:*), -C BASEL_E(0:*):I, IRED_J(0:*):I, TAPER_E(0:*):I, SCAN_J:I, -C STP_J:I, SRA_D:I, SDEC_D:I, LM0_E(0:1):I, -C FRQ0_D:I, TF_E(0:1), MINST_J:I, -C CDAT_X(0:*,0:3):O, APDAT_E(0:*):O, UV_E(0:1,0:*):O -C FTBUF_X(*):IO, FTW_X(*):I, FTBE_E(*):IO, FTBJ_J(*):IO, -C NOTPT_J:O) -C Read the scan SCAN from FCA and belonging to -C the set with header STH and interferometer table IFRT, -C baselines BASEL, redundant baselines IRED and -C taper TAPER. -C CHHA gives the range of selectable hour angles. -C STP through MINST are source model calculation aids. -C Correct the scan for everything wanted, and output -C the data CDAT, the weight APDAT and the UV coordinates -C UV. ANG the dipole angles. NOTPT # of pol. int. points. -C FTW, FTBJ, FTBE and FTBUF for use in NMAMKP -C -C -C Include files: -C - INCLUDE 'WNG_DEF' - INCLUDE 'CBITS_DEF' - INCLUDE 'STH_O_DEF' !SET HEADER - INCLUDE 'SCH_O_DEF' !SCAN HEADER - INCLUDE 'NMA_DEF' -C -C Parameters: -C -C -C Arguments: -C - INTEGER FCA ! FILE - REAL CHHA(0:1) ! SELECTED HA-RANGE - BYTE STH(0:*) ! SET HEADER - INTEGER*2 IFRT(0:*) ! INTERFEROMETER TABLE - REAL ANG(0:2,0:*) ! DIPOLE ANGLE INFORMATION - REAL BASEL(0:*) ! BASELINES in metres - INTEGER IRED(0:*) ! REDUNDANT BASELINES - REAL TAPER(0:*) ! TAPER values versus baseline - INTEGER SCAN ! SCAN number TO DO - INTEGER STP ! SOURCE TYPE - DOUBLE PRECISION SRA,SDEC ! SOURCE CENTRE RA, DEC - REAL LM0(0:1) ! SOURCE COORD. OFFSETS - DOUBLE PRECISION FRQ0 ! SOURCE FREQ. - REAL TF(0:1) ! INTEGR. TIME AND BANDWIDTH SMEARING - INTEGER MINST ! INSTRUMENT - COMPLEX CDAT(0:STHIFR-1,0:3) ! DATA - REAL APDAT(0:*) ! DATA WEIGHT: 0 or 1, per interferomtr - REAL UV(0:1,0:*) ! U, V COORDINATES per interferometer - ! (radians) - COMPLEX FTBUF(0:*) ! FT BUFFER (DATA POL. INT) - REAL FTW(0:*) ! FT WEIGHTS (POL.INT.) - REAL FTBE(0:1,0:*) ! UV BUFFER (POL. INT.) - INTEGER FTBJ(0:*) ! COUNT BUFFER (POL. INT.) - INTEGER NOTPT ! # OF OUTPUT POL INT POINTS -C -C Function references: -C - LOGICAL NSCSCR !READ A SCAN - INTEGER WNGGJ !GET VALUES - INTEGER*2 WNGGI - REAL WNGGE - DOUBLE PRECISION WNGGD -C -C Data declarations: -C - LOGICAL DOPI ! DO POL INT - INTEGER LNPOL !LOCAL # OF POL - INTEGER LPOLTJ(0:1,0:3) !LOCAL POL CODE - DATA LPOLTJ(0,0),LPOLTJ(1,0) /Q_M,U_M/ - COMPLEX CMOD(0:3,0:STHIFR-1) ! MODEL DATA (I,Q,U,V) - INTEGER RWT(0:STHIFR-1) ! REDUNDANT COUNT - INTEGER NIFR ! # OF INTERFEROMETERS - INTEGER IPOL ! # OF INPUT POLARISATIONS - REAL UV0(0:3),UV0S(0:3) ! BASIC UV DATA - REAL RADSC ! UV SCALE TO RADIANS = projection fctr - REAL CWG(0:STHIFR-1) ! CIRC. WEIGHT BUFFER - BYTE SCH(0:SCH__L-1) ! SCAN HEADER - REAL SCHE(0:SCH__L/LB_E-1) - EQUIVALENCE (SCH,SCHE) - REAL WGT(0:STHIFR-1,0:3) ! DATA WEIGHTS -C- -C -C INIT -C - NIFR=WNGGJ(STH(STH_NIFR_1)) ! # OF IFRS - DOPI=.FALSE. - DO I=0,NIFR-1 ! preset NO DATA - APDAT(I)=0 - END DO - IPOL=WNGGI(STH(STH_PLN_1)) ! # OF INPUT POLARISATIONS -C -C READ the SCAN -C - IF (.NOT.NSCSCR(FCA,STH,IFRT,SCAN,CAP,CDAP,SCH,WGT,CDAT)) - 1 GOTO 901 !READ AND CORRECT SCAN DATA - IF (SCHE(SCH_HA_E).LT.CHHA(0) .OR. SCHE(SCH_HA_E).GT.CHHA(1)) - 1 GOTO 900 !NOT WANTED -C -C MAKE UV, depending on UVCDT: -C UVCDT=0: Standard UV coordinates -C UVCDT=1: BASHA: U=baseline, V=hour angle -C UVCDT=2: IFRHA: U=ifr designation, V=hour angle -C - J=1 ! APPARENT - IF (ABS(MAPCTP).EQ.2) J=2 ! MAKE 1950.0 - CALL NMOMUV(J,MAPCRD(0),MAPCRD(1),STH, ! MAKE UV FOR 1M IN RAD.: - 1 SCH,UV0) ! UV0 = U, V scales in rad/m - ! projected perpendicular to - ! the line of sight - RADSC=DPI2*WNGGD(STH(STH_FRQ_1)) ! 2pi *freq /c = 2pi /lambda = - 1 /DCL/1D-6 ! radians/m in the equatorial - ! plane - RADSC=RADSC/SQRT(UV0(0)**2+UV0(1)**2) ! LENGTH UV VECTOR 1M = - ! projection factor - R0=SCHE(SCH_HA_E)*PI2 ! HA in radians - R1=WNGGD(STH(STH_FRQ_1))/(DCL*1D-6) ! SCALE: 1/lambda -C - DO I=0,NIFR-1 ! ALL INTERFEROMETERS - IF (BASEL(I).GE.0 .AND. ! SELECTED BASELINE - 1 BASEL(I).GE.UVRAD(0)*RADSC .AND. - 1 BASEL(I).LE.UVRAD(1)*RADSC) THEN! WANTED? - APDAT(I)=1 ! yes - IF (UVCDT.EQ.0) THEN ! NORMAL UV? - DO I1=0,1 - UV(I1,I)=UV0(I1)*BASEL(I) ! U, V IN RAD. - END DO -C - ELSE ! BASHA or IFRHA - UV(1,I)=NINT(R0*R1*FIELD(1)) - 1 *PI2/FIELD(1) ! vertical: HA (rounded) - IF (UVCDT.EQ.1) THEN ! BASHA? - UV(0,I)=NINT(BASEL(I)*R1 - 1 *FIELD(0))*PI2/FIELD(0) ! horizontal: baseline (rounded) - ELSE ! IFRHA? - J1=MOD(IFRT(I),256) ! TEL # WEST - J2=IFRT(I)/256 ! TEL # East - UV(0,I)=NINT(( - 1 (J1*(2*STHTEL-1-J1))/2+J2) - 1 *R1*FIELD(0))* ! horizontal: ifr designation - 1 PI2/FIELD(0) ! 920424 (rounded) - ENDIF - ENDIF - ENDIF - END DO -C -C CIRCULAR WEIGHTS -C - IF (CWGTYP.GT.0) THEN ! CIRC. WEIGHT ASKED? - D0=WNGGD(STH(STH_FRQ_1)) ! FREQUENCY - DO I=0,NIFR-1 - IF (APDAT(I).GT.0) THEN ! baseln selected for this scan -CC IF (CWGTYP.EQ.1 .OR. CWGTYP.EQ.5) THEN - IF (CWGTYP.EQ.1) THEN ! gaussian weight - CWG(I)=EXP(-((BASEL(I)/RADSC*FRQMAX/CWGVAL/D0)**2)) - ELSE IF (CWGTYP.EQ.2) THEN ! triangular weight - CWG(I)=MAX(0D0,1D0-BASEL(I)/RADSC*FRQMAX/CWGVAL/D0) - ELSE - CWG(I)=1 - END IF - ELSE - CWG(I)=0 !DELETED SCAN - END IF - END DO - END IF -C -C SOURCE SUBTRACTION / MODEL DATA -C - IF (SUB .OR. UVDTP.EQ.1) THEN !SOURCE SUBTRACT - CALL NMOMUV(STP,SRA,SDEC,STH,SCH,UV0S) !GET UV DATA - CALL NMOMU4(0,FCA,SCAN,STH,UV0S,LM0,FRQ0,STH(STH_RTP_1), - 1 IPOL,NIFR,IFRT,TF,MINST,CMOD) !GET MODEL DATA - IF (UVDTP.EQ.1) THEN !MODEL DATA - CALL NMOCIX(STH,SCHE,ANG,CDAT,CMOD) !GET MODEL DATA - ELSE !STANDARD - CALL NMOCIY(STH,SCHE,ANG,CDAT,CMOD,-1) !CORRECT FOR MODEL - END IF - END IF -C -C MAKE CORRECT POLARISATIONS -C - IF (POLTJ(-1,0).NE.0) THEN !LI == POL.INT. ASKED - DOPI=.TRUE. - LNPOL=2 !LOCAL - CALL NMOCXX(STH,SCHE,ANG,WGT,APDAT,CDAT,CDAT,LNPOL,LPOLTJ(0,0)) - !MAKE Q,U - ELSE - LNPOL=NPOL !LOCAL - CALL NMOCXX(STH,SCHE,ANG,WGT,APDAT,CDAT,CDAT,NPOL,POLTJ(0,0)) - END IF -C -C CLIPPING -C - IF (CLIP) THEN ! CLIPPING TEST - DO I=0,NIFR-1 - IF (APDAT(I).GT.0) THEN ! STILL PRESENT - IF (BASEL(I).GE.CLPRAD(0) .AND. - 1 BASEL(I).LE.CLPRAD(1)) THEN ! within clip annulus? - DO I1=0,LNPOL-1 - R0=ABS(CDAT(I,I1)) ! AMPLITUDE - IF (R0.GE.CLPLEV(0) .AND. - 1 R0.LE.CLPLEV(1)) ! clip BETWEEN limits - 1 APDAT(I)=0 - END DO - END IF - END IF - END DO - END IF -C -C FIELD SHIFT AND DATA CONVERSION If the shift is specified in the form of a -C FIELD_CENTRE, we convert it to the corresponding L,M shift. This will result -C in all maps being made for the same centre. This feature is thought to be -C useful only in special applications, notably mosaic observations of -C instrumental polarisation. -C LSHIFT indicates the type of shift: 0=none, 1=shift, 2=centre -C - IF (LSHIFT.LT.0) THEN ! FIELD_CENTRE specified - CALL WNMCRD (CNTDVL(0),CNTDVL(1), - 1 SHIFT(0),SHIFT(1), - 1 CENTRE(0),CENTRE(1)) ! convert to l,m - SHIFT(0)=SHIFT(0)*DEG*3600. ! rad to arcsec - SHIFT(1)=SHIFT(1)*DEG*3600. - ENDIF - DO I=0,NIFR-1 ! ALL IFRS - IF (LSHIFT.NE.0 .OR. - 1 MAPCTP.LT.0) THEN ! FIELD SHIFT - IF (LSHIFT.NE.0) THEN - R0=-UVSC*(SHIFT(0)*UV0(0)*BASEL(I)+ - 1 SHIFT(1)*UV0(1)*BASEL(I)) - ELSE - R0=0 - END IF - IF (MAPCTP.LT.0) THEN ! FIELD SHIFT MOSAIC - R0=R0-(CNTDVL(10)*UV0(0)*BASEL(I)+ - 1 CNTDVL(11)*UV0(1)*BASEL(I)) - END IF - DO I1=0,LNPOL-1 - CDAT(I,I1)=CDAT(I,I1)*CMPLX(COS(R0),SIN(R0)) - END DO - END IF -C -C U<0 CORRECTION -C - IF (UV(0,I).LT.0) THEN ! ON LEFT HALF - DO I1=0,1 ! REVERSE UV - UV(I1,I)=-UV(I1,I) - END DO - DO I1=0,LNPOL-1 ! CONJUGATE DATA - CDAT(I,I1)=CONJG(CDAT(I,I1)) - END DO - END IF -C -C SPECIAL DATA TYPES -C - DO I1=0,LNPOL-1 - IF (DATTYP.EQ.1) THEN !NOTHING - ELSE IF (DATTYP.EQ.2) THEN !COS - CDAT(I,I1)=CMPLX(REAL(CDAT(I,I1)),0.) - ELSE IF (DATTYP.EQ.3) THEN !SIN - CDAT(I,I1)=CMPLX(0.,AIMAG(CDAT(I,I1))) - ELSE IF (DATTYP.EQ.4) THEN !AMPL - CDAT(I,I1)=CMPLX(ABS(CDAT(I,I1)),0E0) - ELSE IF (DATTYP.EQ.5) THEN !PHASE - R0=ABS(CDAT(I,I1)) !AMPL - IF (R0.GT.0) CDAT(I,I1)=CDAT(I,I1)/R0 !PHASE ONLY - END IF - END DO -C -C TAPER/CIRC. WEIGHT -C - APDAT(I)=APDAT(I)*TAPER(I) !ANTENNA PATTERN FACTOR - IF (CWGTYP.GT.0) APDAT(I)=APDAT(I)*CWG(I) !CIRC. WEIGHT -C -C UV -C - DO I1=0,1 !MAKE OUTPUT UV - UV(I1,I)=UV(I1,I)*FIELD(I1)/PI2 !OUTPUT UV - END DO - IF (APDAT(I).NE.0) CNTJVL(4)=CNTJVL(4)+1 !COUNT # OF DATAPOINTS - END DO -C -C CORRECT FOR REDUNDANT BASELINES -C - IF (UWGT.EQ.1 .AND. .NOT.DOPI) THEN !STANDARD UNIFORM - DO I=0,NIFR-1 !REDUNDANT TEST - RWT(I)=0 - END DO - DO I=0,NIFR-1 !ALL INTERFEROMETERS - IF (IRED(I).GT.0) THEN !REDUNDANT - IF (APDAT(I).NE.0) THEN - RWT(IRED(I))=RWT(IRED(I))+1 !COUNT FOR SET - END IF - END IF - END DO - DO I=0,NIFR-1 !CORRECT WEIGHTS - IF (IRED(I).GT.0) THEN - IF (APDAT(I).NE.0) APDAT(I)=APDAT(I)/RWT(IRED(I)) - END IF - END DO - END IF -C -C MAKE P**2 -C - IF (DOPI) THEN - CALL NMAMKP(STH,BASEL,CMOD,CDAT,APDAT,FTBUF,FTW,FTBE,FTBJ, - 1 UV0,UV,NOTPT) !MAKE P - END IF -C -C UPDATE JOB SUMMARY LOG -C - 901 CONTINUE - CALL NMAJSS(FCA,STH,SCHE(SCH_HA_E),IFRT,BASEL,APDAT) -C -C READY -C - 900 CONTINUE -C - RETURN -C -C - END diff --git a/src/nmap/nmasoi.for b/src/nmap/nmasoi.for deleted file mode 100644 index 0313870c2f345daf90d6c9e89b5ff17e4d64804a..0000000000000000000000000000000000000000 --- a/src/nmap/nmasoi.for +++ /dev/null @@ -1,148 +0,0 @@ -C+ NMASOI.FOR -C WNB 910304 -C -C Revisions: -C HjV 920520 HP does not allow extended source lines -C WNB 950809 Add BUFPP -C WNB 950817 Enlarge UV plane for Pol. Int. -C - SUBROUTINE NMASOI(FCA,BUFPP) -C -C Initiate sorting -C -C Result: -C -C CALL NMASOI( FCA_J:I, BUFPP_J:O) -C Initiate UV plane sorting to temporary file -C with FCA as control, and BUFPP a pointer to -C a buffer for polarised intensities -C -C -C PIN references: -C -C -C Include files: -C - INCLUDE 'WNG_DEF' - INCLUDE 'NMA_DEF' -C -C Parameters: -C -C -C Arguments: -C - INTEGER FCA !FILE CONTROL - INTEGER BUFPP !FT BUFFER POLARISED INTENSITIES -C -C Function references: -C - LOGICAL WNFOP !OPEN FILE - LOGICAL WNGGVM,WNGGVA !GET VIRTUAL MEMORY - INTEGER WNMEJC !CEIL(X) - CHARACTER*20 WNFFNM !GET A FILE NAME -C -C Data declarations: -C -C- -C -C DFT -C - IF (DODFT) THEN - DO I2=0,NPOL-1 !GET BUFFERS - IF (.NOT.WNGGVA(LB_E*((FTSIZ(0)/2)*2+1)* - 1 ((FTSIZ(1)/2)*2+1),DFTBFA(I2))) THEN - CALL WNCTXT(F_TP,'Cannot obtain DFT buffers') - CALL WNGEX !STOP PROGRAM - END IF - CALL WNGMVZ(LB_E*((FTSIZ(0)/2)*2+1)*((FTSIZ(1)/2)*2+1), - 1 A_B(DFTBFA(I2)-A_OB)) !CLEAR BUFFER - DFTWT(I2)=0 !TOTAL WEIGHT - END DO - GOTO 10 - END IF -C -C POL BUFFER -C - IF (.NOT.WNGGVA((3*LB_X+2*LB_E+LB_J)*NPTRF,BUFPP)) THEN - CALL WNCTXT(F_TP,'Cannot obtain FT buffer pol. int') - CALL WNGEX !STOP PROGRAM - END IF - I1=(BUFPP-A_OB)/LB_X - DO I=0,NPTRF/2-1 !FILL WEIGHTS - R0=I*PI2/REAL(NPTRF) - A_X(I1+I)=CMPLX(COS(R0),SIN(R0)) - A_X(I1+I+NPTRF/2)=CMPLX(COS(R0),-SIN(R0)) - END DO -C -C OPEN FILE -C - IF (.NOT.WNFOP(FCA,WNFFNM('NMA','TMP'),'WT')) THEN !OPEN OUTPUT - CALL WNCTXT(F_TP,'Cannot open temporary sort file') - CALL WNGEX !FINISH PROGRAM - END IF -C -C GET SIZES -C - IF (UVCDT.EQ.0) THEN !STANDARD - DO I=0,1 - IF (POLTJ(-1,0).EQ.0) THEN !NORMAL - UVCMAX(I)=WNMEJC(UVMAX(I)*FIELD(I)+CVLWID(I)) !MAX UV - !COORD - ELSE !POL. INT. - UVCMAX(I)=2*WNMEJC(UVMAX(I)*FIELD(I)+CVLWID(I)) !MAX UV - !COORD - END IF - END DO - ELSE IF (UVCDT.EQ.1) THEN !BASHA - DO I=0,1 - IF (I.EQ.1 .OR. (I.EQ.0 .AND. POLTJ(-1,0).EQ.0)) THEN !NORMAL - UVCMAX(I)=WNMEJC(UV1MAX(I)*FIELD(I)* - 1 FRQMAX/(CL*1E-6)+CVLWID(I)) - ELSE !POL. INT. - UVCMAX(I)=2*WNMEJC(UV1MAX(I)*FIELD(I)* - 1 FRQMAX/(CL*1E-6)+CVLWID(I)) - END IF - END DO - ELSE !IFRHA - DO I=0,1 - UVCMAX(I)=WNMEJC(UV2MAX(I)*FIELD(I)* - 1 FRQMAX/(CL*1E-6)+CVLWID(I)) - END DO - END IF - DO I=0,1 - UVCMAX(I)=MIN(FTSIZ(I)/2-1,UVCMAX(I)) !MAX UV COORD - END DO - BINSIZ=MIN(UVCMAX(0)+1,MAX(1,(MEMSIZ/8-(2*UVCMAX(1)+1)* - 1 WNMEJC(2*CVLWID(0)))/(2*UVCMAX(1)+1))) !# OF LINES/BIN - NBIN=WNMEJC(FLOAT(UVCMAX(0)+1)/BINSIZ) !# OF BINS -C -C PREPARE MEMORY -C - JS=WNGGVM(4*LB_J*NBIN,BINADM) !BIN ADMINISTRATION - IF (JS) JS=WNGGVM(MXSBB*NBIN,BINBUF) !BIN BUFFERS - IF (.NOT.JS) THEN !ERROR - CALL WNCTXT(F_TP,'Cannot obtain sorting buffers') - CALL WNGEX !EXIT PROGRAM - END IF -C - J2=(BINADM-A_OB)/LB_J !ADDRESS ADMINISTRATION BUFFER - J1=(BINBUF-A_OB)/LB_J !ADDRESS BUFFERS - DO I=0,NBIN-1 !PREPARE ALL BUFFERS - A_J(J2)=0 !POINTER IN THIS BUFFER - A_J(J2+1)=I !CURRENT BUFFER FOR THIS BIN - A_J(J2+2)=((MXSBJ-1)/(3+2*NPOL))* - 1 (3+2*NPOL) !# OF ENTRIES IN BUFFER - A_J(J2+3)=-1 !POINTER TO PREVIOUS DISK BUFFER - A_J(J1+MXSBJ-1)=-1 !POINTER TO PREVIOUS BUFFER - J2=J2+4 !DESCRIBE NEXT BUFFER - J1=J1+MXSBJ - END DO -C -C READY -C - 10 CONTINUE -C - RETURN -C -C - END diff --git a/src/nmap/nmason.for b/src/nmap/nmason.for deleted file mode 100644 index 52241f11b193dc402c0fc8db70da57b735aec5d4..0000000000000000000000000000000000000000 --- a/src/nmap/nmason.for +++ /dev/null @@ -1,68 +0,0 @@ -C+ NMASON.FOR -C WNB 910304 -C -C Revisions: -C WNB 950809 Add BUFPP -C WNB 950817 Larger BUFPP -C - SUBROUTINE NMASON(FCA,BAD,BUF,BUFPP) -C -C Finish UV sorting -C -C Result: -C -C CALL NMASON( FCA_J:I, BAD_J(4,0:*):IO, BUF_J(0:*):I, BUFPP_J:I) -C Finish UV data sorting. BAD is the buffer -C administration, BUF the buffers, FCA the -C output. BUFPP points to FT Pol. Int buffer. -C -C -C Include files: -C - INCLUDE 'WNG_DEF' - INCLUDE 'NMA_DEF' -C -C Parameters: -C -C -C Arguments: -C - INTEGER FCA !FILE CONTROL - INTEGER BAD(4,0:*) !BUFFER ADMINISTRATION - INTEGER BUF(0:MXSBJ-1,0:*) !BUFFERS - INTEGER BUFPP !POL INT FT BUFFER -C -C Function references: -C - INTEGER WNFEOF !FILE END - LOGICAL WNFWR !WRITE DISK - LOGICAL WNFPUR !PURGE BUFFERS TO FILE -C -C Data declarations: -C -C- - DO I3=0,NBIN-1 !EMPTY BUFFERS - I1=BAD(2,I3) !CURRENT BUF # - IF (BAD(1,I3).GT.0) THEN !BUF NOT EMPTY - IF (BAD(1,I3).LT.BAD(3,I3)) THEN !BUFFER NOT FULL - BUF(BAD(1,I3)+2,I1)=0 !SET APD=0 TO INDICATE END - END IF - J=WNFEOF(FCA) !CURRENT FILE END - IF (.NOT.WNFWR(FCA,MXSBB,BUF(0,I1),J)) THEN !WRITE - 10 CONTINUE - CALL WNCTXT(F_TP,'Write error sorted UV data') - CALL WNGEX !LEAVE PROGRAM - END IF - BAD(4,I3)=J !SAVE LAST - END IF - END DO -C - IF (.NOT.WNFPUR(FCA)) GOTO 10 !WRITE ALL TO DISK -C - CALL WNGFVM(NBIN*MXSBB,BINBUF) !RELEASE BUFFERS - CALL WNGFVA((3*LB_X+2*LB_E+LB_J)*NPTRF,BUFPP) -C - RETURN -C -C - END diff --git a/src/nmap/nmasor.for b/src/nmap/nmasor.for deleted file mode 100644 index ea4ba79c79e427e19394eabc422f329449f7f2e9..0000000000000000000000000000000000000000 --- a/src/nmap/nmasor.for +++ /dev/null @@ -1,338 +0,0 @@ -C+ NMASOR.FOR -C WNB 910304 -C -C Revisions: -C WNB 910927 Typo file loops -C WNB 911025 Perfection mosaicking positions -C HjV 920520 HP does not allow extended source lines -C WNB 920828 Update for line velocities -C WNB 920831 Correct logics if change of file, but not setname -C WNB 920902 Typo in set change check -C WNB 930127 Change weighting averages, proper bandwidth -C WNB 930224 Correct for incorrect new weighting scheme -C WNB 930414 Cater for empty set -C HjV 930423 Change some text -C WNB 930607 Delete INCLUDE SCH_O -C WNB 930619 Change incorrect text -C WNB 930825 Add dipole angles -C WNB 930826 New model calculation; redundant baselines -C WNB 930928 Multiple SCN files with model -C WNB 931008 Add MINST -C CMV 950314 Add MAXPOS (also works if RTP(13)=0) -C WNB 950817 Use Pol. Int. buffers -C - SUBROUTINE NMASOR(FCA) -C -C Sort all input data into temporary file -C -C Result: -C -C CALL NMASOR ( FCA_J:I) Sort all input data into a -C temporary file defined by FCA. -C -C -C PIN references: -C -C -C Include files: -C - INCLUDE 'WNG_DEF' - INCLUDE 'STH_O_DEF' !SET HEADER - INCLUDE 'NMA_DEF' -C -C Parameters: -C -C -C Arguments: -C - INTEGER FCA !FILE CONTROL SORTED OUTPUT -C -C Function references: -C - LOGICAL WNFOP !OPEN FILE - LOGICAL NSCSTL !GET A SET - LOGICAL NSCSIF !GET INTERFEROMETER TABLE - LOGICAL NMOMSL !CALCULATE MODEL FOR SETS - LOGICAL NMORDH !GET SOURCE PARAMETERS - CHARACTER*32 WNTTSG !SHOW SET NAME -C -C Data declarations: -C - LOGICAL FIRST !FIRST SET INDICATOR - INTEGER FCAIN !INPUT FILE - REAL BASEL(0:STHIFR-1) !BASELINES - INTEGER IRED(0:STHIFR-1) !REDUNDANT BASELINES - REAL TAPER(0:STHIFR-1) !TAPER - INTEGER*2 IFRT(0:STHIFR-1) !INTERFEROMETER TABLE - INTEGER IFRA(0:1,0:STHIFR-1) - REAL ANG(0:2,0:STHIFR-1) - COMPLEX CDAT(0:STHIFR-1,0:3) !DATA - REAL APDAT(0:STHIFR-1) !WEIGHT - REAL UV(0:1,0:STHIFR-1) !UV DATA - REAL MAXPOS !MAX. TELESCOPE POSITION - INTEGER STP !SOURCE TYPE - DOUBLE PRECISION SRA,SDEC,SFRQ !SOURCE RA, DEC, FREQ CENTRE - DOUBLE PRECISION MLM(0:1) !MAP CENTRE L,M - REAL LM0(0:1) !BASIC SOURCE DISPLACEMENT - DOUBLE PRECISION FRQ0 !BASIC FREQUENCY - REAL TF(0:1) !SOURCE INTEGR. TIME, BANDWIDTH - INTEGER MINST !INSTRUMENT - INTEGER STHP !SET HEADER POINTER - INTEGER SETNAM(0:7) !SET ID - INTEGER TSTNAM(0:7),CHKNAM(0:7) !SET ID CHECK - INTEGER BUFPP !POINTER FT BUFFER POL INT - BYTE STH(0:STH__L-1) !SET HEADER - INTEGER*2 STHI(0:STH__L/LB_I-1) - INTEGER STHJ(0:STH__L/LB_J-1) - REAL STHE(0:STH__L/LB_E-1) - DOUBLE PRECISION STHD(0:STH__L/LB_D-1) - EQUIVALENCE (STH,STHI,STHJ,STHE,STHD) -C- -C -C PREPARE OUTPUT -C - FIRST=.TRUE. !SET FIRST SET - CALL NMASOI(FCA,BUFPP) !OPEN OUTPUT, PREPARE BUFFERS - DO I=0,7 !SET CHECK SET ID - TSTNAM(I)=-1 - END DO -C -C GET ALL DATA -C - DO I1=1,NFILE !ALL INPUT FILES - IF (.NOT.WNFOP(FCAIN,FILIN(I1),'U')) THEN - CALL WNCTXT(F_TP,'Error reading node !AS',NODIN(I1)) - CALL WNGEX !STOP PROGRAM - END IF - CALL WNCTXT(F_TP,'Scan node !AS started at !%T',NODIN(I1)) -C -C MODEL INIT -C - IF (SUB .OR. UVDTP.EQ.1) THEN !MAKE MODEL - IF (.NOT.NMOMSL(FCAIN,SETS(0,0,I1),LPOFF)) THEN - 10 CONTINUE - CALL WNCTXT(F_TP,'Error in model calculation') - CALL WNGEX !STOP PROGRAM - END IF - END IF -C -C ALL SETS -C - DO WHILE (NSCSTL(FCAIN,SETS(0,0,I1),STH,STHP, - 1 SETNAM,LPOFF)) !DO ALL SETS - IF (STHJ(STH_SCN_J).LE.0) GOTO 20 !SKIP EMPTY SET - DO I=0,3 - IF (SETNAM(I).NE.TSTNAM(I) .OR. - 1 TSTNAM(7).NE.I1) THEN !NEW SET OR FILE - DO I2=0,3 !SAVE IT - TSTNAM(I2)=SETNAM(I2) - END DO - TSTNAM(7)=I1 !FILE NUMBER - CALL WNCTXT(F_TP,'Sector !AS started at !%T', - 1 WNTTSG(TSTNAM,0)) - END IF - END DO -C -C GET BASELINE TABLES -C - IF (.NOT.NSCSIF(FCAIN,STH,IFRT,IFRA,ANG)) THEN !READ IFR TABLES - CALL WNCTXT(F_TP,'Error reading interferometer tables') - CALL WNGEX !END PROGRAM - END IF - CALL NSCMBL(STHE(STH_RTP_E),STHJ(STH_NIFR_J),IFRT, - 1 SIFRS(0,0,I1),BASEL) !MAKE BASELINES - CALL NCARRT(STHJ(STH_NIFR_J),BASEL,1E0,IRED,ANG) !GET REDUNDANT - UVSC=1./(3600.*DEG) !SCALE FACTOR MAP SHIFT - MAXPOS=0 !FIND MAX. TEL.POS. - DO I=0,STHTEL-1 - MAXPOS=MAX(MAXPOS,STHE(STH_RTP_E+I)) - END DO - MAXPOS=MAXPOS-STHE(STH_RTP_E) -C -C MAKE TAPER -C - DO I=0,STHJ(STH_NIFR_J)-1 !MAKE TAPER - IF (BASEL(I).GE.0) THEN - IF (TAPTYP.EQ.1 .OR. TAPTYP.EQ.5) THEN - TAPER(I)=EXP(-((BASEL(I)*FRQMAX/TAPVAL/STHD(STH_FRQ_D))**2)) - ELSE IF (TAPTYP.EQ.2) THEN - TAPER(I)=MAX(0D0,1D0-BASEL(I)*FRQMAX/TAPVAL/STHD(STH_FRQ_D)) - ELSE - TAPER(I)=1 - END IF - IF ((TAPTYP.EQ.4 .OR. TAPTYP.EQ.5) .AND. BASEL(I).GT.0) - 1 TAPER(I)=TAPER(I)/(BASEL(I)* - 1 STHD(STH_FRQ_D)/FRQMAX) !CORRECT 1/R - IF (UWGT.EQ.1) TAPER(I)=TAPER(I)*BASEL(I)*STHD(STH_FRQ_D)* - 1 STHE(STH_HAV_E)/2./FRQMAX - ELSE - TAPER(I)=0 !DELETED SCAN - END IF - END DO -C -C SOURCE MODEL -C - IF (SUB .OR. UVDTP.EQ.1) THEN !MODEL WANTED - IF (.NOT.NMORDH(6,STP,SRA,SDEC,SFRQ)) GOTO 10 !GET SOME INFO - CALL NMOMST(STP,SRA,SDEC,STH,LM0,FRQ0,TF,MINST) !GET SOME DATA - END IF -C -C GET STATISTICS -C - IF (FIRST) THEN !FIRST SET - CALL NMASS1(FCAIN,STHP) !INIT STATISTICS - DO I2=0,STHJ(STH_NIFR_J)-1 !COUNT BASELINES - IF (BASEL(I2).GE.0) CNTJVL(5)=CNTJVL(5)+1 - END DO - DO I=0,3 !SAVE CHECKNAME - CHKNAM(I)=SETNAM(I) - END DO - CHKNAM(7)=I1 !FILE # -C -C CALCULATE AN INTEGER MAP CENTRE COORDINATE -C - IF (MAPCTP.LT.0) THEN !MOSAIC - CALL WNMDRD(MAPCRD(0),MAPCRD(1),MLM(0),MLM(1), - 1 CNTDVL(-2-2*MAPCTP), - 1 CNTDVL(-1-2*MAPCTP)) !MAKE L,M - DO I=0,1 !L,M - D0=ANINT(MLM(I)/(FIELD(I)/FTSIZ(I))) !CENTRE POSITION - MLM(I)=D0*(FIELD(I)/FTSIZ(I)) - END DO - CALL WNMDLM(MAPCRD(0),MAPCRD(1),MLM(0),MLM(1), - 1 CNTDVL(-2-2*MAPCTP), - 1 CNTDVL(-1-2*MAPCTP)) !MAKE RA,DEC - END IF - FIRST=.FALSE. - ELSE - DO I=0,3 !CHECK FOR NEW - IF (SETNAM(I).NE.CHKNAM(I) .OR. - 1 CHKNAM(7).NE.I1) THEN !NEW SET OR FILE - DO I2=0,3 !NEW TEST - CHKNAM(I2)=SETNAM(I2) - END DO - CHKNAM(7)=I1 !NEW FILE - DO I2=0,STHJ(STH_NIFR_J)-1 !COUNT BASELINES - IF (BASEL(I2).GE.0) CNTJVL(5)=CNTJVL(5)+1 - END DO - FRQMAX=MAX(FRQMAX,REAL(STHD(STH_FRQ_D))) !MAX. FREQ. - FRQMIN=MIN(FRQMIN,REAL(STHD(STH_FRQ_D))) !MIN. FREQ. - UVMAX(0)=MAX(UVMAX(0),REAL(MAXPOS* - 1 STHD(STH_FRQ_D)/(CL*1E-6))) !MAX. U - UVMAX(1)=MAX(UVMAX(1),ABS(REAL(SIN(STHD(STH_DEC_D)*PI2)* - 1 MAXPOS* - 1 STHD(STH_FRQ_D)/(CL*1E-6)))) !MAX. V - UV1MAX(0)=MAX(UV1MAX(0),STHE(STH_RTP_E+STHTEL-1)) !MAX U BASHA - IF (MAPCTP.GE.0) THEN !NON-MOSAIC - CNTDVL(0)=CNTDVL(0)*CNTJVL(2)+STHD(STH_RA_D) !RA - CNTDVL(1)=CNTDVL(1)*CNTJVL(2)+STHD(STH_DEC_D) !DEC - CNTDVL(2)=CNTDVL(2)*CNTJVL(2)+STHD(STH_RAE_D) !RA EPOCH - CNTDVL(3)=CNTDVL(3)*CNTJVL(2)+STHD(STH_DECE_D) !DEC EPOCH - END IF - CNTDVL(4)=CNTDVL(4)*CNTJVL(2)+STHE(STH_OEP_E) !OBS. EPOCH - D0=STHE(STH_BAND_E)*STHJ(STH_SCN_J)*STHE(STH_HAV_E) !WEIGHT - CNTDVL(14)=2*D0*CNTDVL(5)*ABS(STHD(STH_FRQ_D)-CNTDVL(6))/ - 1 (CNTDVL(5)**2+D0**2)*(CNTDVL(5)+D0)+ - 1 CNTDVL(5)*CNTDVL(14)+D0* - 1 STHE(STH_BAND_E) !BANDWIDTH - CNTDVL(6)=CNTDVL(5)*CNTDVL(6)+D0* - 1 STHD(STH_FRQ_D) !FREQUENCY - CNTDVL(7)=CNTDVL(5)*CNTDVL(7)+D0* - 1 STHE(STH_VEL_E) !VELOCITY - CNTDVL(8)=CNTDVL(5)*CNTDVL(8)+D0* - 1 STHE(STH_VELR_E) !REF. VEL. - CNTDVL(9)=CNTDVL(5)*CNTDVL(9)+D0* - 1 STHD(STH_FRQC_D) !BAND REF. FREQUENCY - CNTDVL(12)=CNTDVL(5)*CNTDVL(12)+D0* - 1 STHD(STH_FRQ0_D) !REST FREQUENCY - CNTDVL(5)=CNTDVL(5)+D0 !TOTAL WEIGHTED BAND - CNTDVL(6)=CNTDVL(6)/CNTDVL(5) !AVERAGE FREQUENCY - CNTDVL(7)=CNTDVL(7)/CNTDVL(5) !AVERAGE VELOCITY - CNTDVL(8)=CNTDVL(8)/CNTDVL(5) !AVERAGE REF. VEL. - CNTDVL(9)=CNTDVL(9)/CNTDVL(5) !AVERAGE REF. FREQ. - CNTDVL(12)=CNTDVL(12)/CNTDVL(5) !AVERAGE REST FREQ. - CNTDVL(14)=CNTDVL(14)/CNTDVL(5) !AVERAGE BANDWIDTH - CNTJVL(2)=CNTJVL(2)+1 !COUNT SETS - IF (MAPCTP.GE.0) THEN !NON-MOSAIC - CNTDVL(0)=CNTDVL(0)/CNTJVL(2) !RA - CNTDVL(1)=CNTDVL(1)/CNTJVL(2) !DEC - CNTDVL(2)=CNTDVL(2)/CNTJVL(2) !RA EPOCH - CNTDVL(3)=CNTDVL(3)/CNTJVL(2) !DEC EPOCH - END IF - CNTDVL(4)=CNTDVL(4)/CNTJVL(2) !OBS. EPOCH - END IF - END DO - END IF -C -C RESIDUAL MOSAIC SHIFT -C - IF (MAPCTP.LT.0) THEN !MOSAIC - CALL WNMDRD(MAPCRD(0),MAPCRD(1),MLM(0),MLM(1), - 1 CNTDVL(-2-2*MAPCTP), - 1 CNTDVL(-1-2*MAPCTP)) !MAKE L,M MAP - IF (MAPCTP.EQ.-2) THEN !B1950 - CALL WNMDRD(MAPCRD(0),MAPCRD(1),CNTDVL(10),CNTDVL(11), - 1 STHD(STH_RAE_D), - 1 STHD(STH_DECE_D)) !MAKE L,M SET - ELSE !APPARENT - CALL WNMDRD(MAPCRD(0),MAPCRD(1),CNTDVL(10),CNTDVL(11), - 1 STHD(STH_RA_D), - 1 STHD(STH_DEC_D)) !MAKE L,M SET - END IF - DO I=0,1 !SAVE SHIFT - CNTDVL(10+I)=-CNTDVL(10+I)+MLM(I) - END DO - END IF -C -C DO ALL SCANS -C - DO I=0,STHJ(STH_SCN_J)-1 - CALL NMASCN(FCAIN,HA(0,I1),STH,IFRT,ANG, - 1 BASEL,IRED,TAPER,I, - 1 STP,SRA,SDEC,LM0,FRQ0,TF,MINST, - 1 CDAT,APDAT,UV, - 1 A_X((BUFPP-A_OB)/LB_X+NPTRF), - 1 A_X((BUFPP-A_OB)/LB_X), - 1 A_X((BUFPP-A_OB)/LB_X+3*NPTRF), - 1 A_X((BUFPP-A_OB)/LB_X+4*NPTRF),J0) !READ SCAN - IF (DODFT) THEN - IF (POLTJ(-1,0).EQ.0) THEN - CALL NMADFT(STHJ(STH_NIFR_J),CDAT,UV,APDAT) !DO DFT - ELSE - CALL NMADFT(J0,A_X((BUFPP-A_OB)/LB_X+NPTRF), - 1 A_X((BUFPP-A_OB)/LB_X+3*NPTRF), - 1 A_X((BUFPP-A_OB)/LB_X)) !DO DFT - END IF - ELSE - IF (POLTJ(-1,0).EQ.0) THEN !STANDARD - CALL NMASOT(FCA,A_B(BINADM-A_OB), - 1 A_B(BINBUF-A_OB),A_B(BINBUF-A_OB), - 1 STHJ(STH_NIFR_J),NPOL, - 1 CDAT,UV,APDAT) !SORT AND OUTPUT - ELSE !POL. INT. - CALL NMASOT(FCA,A_B(BINADM-A_OB), - 1 A_B(BINBUF-A_OB),A_B(BINBUF-A_OB), - 1 J0,1,A_X((BUFPP-A_OB)/LB_X+NPTRF), - 1 A_X((BUFPP-A_OB)/LB_X+3*NPTRF), - 1 A_X((BUFPP-A_OB)/LB_X)) !SORT AND OUTPUT - END IF - END IF - END DO - 20 CONTINUE - END DO !SETS - CALL WNFCL(FCAIN) !CLOSE INPUT - END DO !FILES -C -C FINISH -C - IF (DODFT) THEN - CALL NMADF1 !PRINT DFT - ELSE - CALL NMASON(FCA,A_B(BINADM-A_OB),A_B(BINBUF-A_OB), - 1 BUFPP) !FINISH OUTPUT - END IF -C - RETURN -C -C - END diff --git a/src/nmap/nmasot.for b/src/nmap/nmasot.for deleted file mode 100644 index 2ee27dfced8444a5ee83af50b026e1c52fbb78d5..0000000000000000000000000000000000000000 --- a/src/nmap/nmasot.for +++ /dev/null @@ -1,87 +0,0 @@ -C+ NMASOT.FOR -C WNB 910304 -C -C Revisions: -C WNB 911009 Cater for multiple polarisations correctly -C - SUBROUTINE NMASOT(FCA,BAD,BUFR,BUFJ,NI,NP,CSD,UVD,APD) -C -C Output sorted UV data -C -C Result: -C -C CALL NMASOT (FCA_J:I, BAD_J(4,0:*):IO, BUFR_E(0:*,0:*):IO, -C BUFJ_J(0:*,0:*):IO, -C NI_J:I, NP_J:I, CSD_X(0:*,0:3):I, -C UVD_E(0:1,0:*):I, APD_E(0:*):I) -C Output sorted UV data to temporary file. -C CALL NMASOI to prepare buffers first, NMASON to -C finish after last. -C FCA is the file control, BAD the buffer admini- -C stration, BUF the output buffers, NI the number of -C input points, NP the number of polarisations, -C CSD, UVD, APD resp. the data, the UV- -C coordinates and the antenna pattern weight. -C -C -C Include files: -C - INCLUDE 'WNG_DEF' - INCLUDE 'STH_O_DEF' - INCLUDE 'NMA_DEF' -C -C Parameters: -C -C -C Arguments: -C - INTEGER FCA !OUTPUT FILE CONTROL - INTEGER BAD(4,0:*) !BUFFER ADMINISTRATION - REAL BUFR(0:MXSBJ-1,0:*) !OUTPUT BUFFERS - INTEGER BUFJ(0:MXSBJ-1,0:*) !OUTPUT BUFFERS - INTEGER NI !# OF INPUT POINTS - INTEGER NP !# OF POLARISATIONS - REAL CSD(0:1,0:STHIFR-1,0:*) !DATA - REAL UVD(0:1,0:*) !UV COORDINATES - REAL APD(0:*) !ANTENNA PATTERN WEIGHT -C -C Function references: -C - INTEGER WNFEOF !CURRENT FILE END - LOGICAL WNFWR !DISK WRITING -C -C Data declarations: -C -C- - DO I=0,NI-1 !DO ALL INPUT POINTS - IF (APD(I).NE.0) THEN !PRESENT - I3=INT(UVD(0,I)/BINSIZ) !GET BIN - IF (I3.LT.NBIN) THEN !CAN FIT - I2=BAD(1,I3) !PTR IN BIN BUF - I1=BAD(2,I3) !CURRENT BUF - BUFR(I2,I1)=UVD(0,I) !SET U,V - BUFR(I2+1,I1)=UVD(1,I) - BUFR(I2+2,I1)=APD(I) !SET ANTENNA WEIGHT - DO I4=0,NP-1 - BUFR(I2+3+2*I4,I1)=CSD(0,I,I4) !SET DATA - BUFR(I2+4+2*I4,I1)=CSD(1,I,I4) - END DO - BAD(1,I3)=BAD(1,I3)+3+2*NP !UPDATE PTR IN BUF - IF (BAD(1,I3).GE.BAD(3,I3)) THEN !BUF FULL - J=WNFEOF(FCA) !CURRENT FILE END - IF (.NOT.WNFWR(FCA,MXSBB,BUFJ(0,I1),J)) THEN !WRITE - CALL WNCTXT(F_TP,'Write error sorted UV data') - CALL WNGEX !END PROGRAM - END IF - BAD(1,I3)=0 !BUF PTR - BUFJ(MXSBJ-1,I1)=J !POINT TO PREVIOUS - BAD(4,I3)=J !SAVE LAST - END IF - END IF - END IF - END DO -C - RETURN -C -C - END diff --git a/src/nmap/nmasst.for b/src/nmap/nmasst.for deleted file mode 100644 index cd77b0f06fae5203ca53cf579abe1e2d50747ad4..0000000000000000000000000000000000000000 --- a/src/nmap/nmasst.for +++ /dev/null @@ -1,195 +0,0 @@ -C+ NMASST.FOR -C WNB 910307 -C -C Revisions: -C WNB 910417 Read only one set for test values -C WNB 910913 Change loops -C WNB 920828 Update for line velocities and INST -C WNB 921104 J2000 -C WNB 930127 Change weighting averages, proper bandwidth -C WNB 930414 Cater for empty sets -C HjV 930423 Change some text -C CMV 950314 Add MAXPOS (also works if RTP(13)=0) -C - SUBROUTINE NMASST -C -C Get sorting statistics map making -C -C Result: -C -C CALL NMASST will get the statistics from input data to -C be able to produce a map. -C CALL NMASS1(STHFCA_J:I, STHPX_J:I) -C will get the start statistics for data of one map. -C Data to be found in file STHFCA at STHPX. -C -C Include files: -C - INCLUDE 'WNG_DEF' - INCLUDE 'STH_O_DEF' !SET HEADER - INCLUDE 'NMA_DEF' -C -C Parameters: -C - INTEGER STHFCA !DATA FILE - INTEGER STHPX !SET HEADER POINTER -C -C Arguments: -C -C -C Function references: -C - LOGICAL WNDXLN !NEXT LOOP - LOGICAL WNFOP !OPEN FILE - LOGICAL WNFRD !READ DATA - LOGICAL NSCSTL !GET SET -C -C Data declarations: -C - LOGICAL ONLY1 !SS1 INDICATOR - REAL MAXPOS !MAX. TELESCOPE POSITION - INTEGER FCAIN !FILE AREA - INTEGER SNAM(0:7) !FULL SET NAME - INTEGER STHP !SET HEADER POINTER - BYTE STH(0:STHHDL-1) !SET HEADER - INTEGER*2 STHI(0:STHHDL/2-1) - INTEGER STHJ(0:STHHDL/4-1) - REAL STHE(0:STHHDL/4-1) - DOUBLE PRECISION STHD(0:STHHDL/8-1) - EQUIVALENCE (STH,STHI,STHJ,STHE,STHD) -C- - ONLY1=.FALSE. - GOTO 10 -C -C NMASS1 -C - ENTRY NMASS1(STHFCA,STHPX) -C - ONLY1=.TRUE. - GOTO 10 -C -C INIT -C - 10 CONTINUE - DO I=0,CNTJ-1 !ZERO AVERAGES AND COUNTS - CNTJVL(I)=0 - END DO - DO I=0,CNTD-1 - CNTDVL(I)=0 - END DO - DO I=0,CNTC-1 - IF (I.NE.1) CNTCVL(I)=' ' !SKIP USER COMMENT - END DO - DO I=0,1 - UVMAX(I)=0 !MAX. UV - UV1MAX(I)=0 !MAX. UV FOR BASHA - UV2MAX(I)=0 !MAX. UV FOR IFRHA - END DO - FRQMIN=1E30 !MIN FREQ. - FRQMAX=-1E30 !MAX FREQ. - UV1MAX(1)=PI/2 !MAX V BASHA - UV2MAX(0)=STHIFR !MAX U IFRHA - UV2MAX(1)=PI/2 !MAX V IFRHA - IF (.NOT.ONLY1) THEN - CALL WNDXLI(LPOFF) !INIT LOOP OFFSETS - END IF -C -C CHECK ALL FILES AND SETS -C - IF (ONLY1) THEN !ONLY ONE - IF (.NOT.WNFRD(STHFCA,STHHDL,STH,STHPX)) THEN !READ SET HEADER - CALL WNCTXT(F_TP,'Fatal error reading MAP header') - CALL WNGEX !STOP - END IF - GOTO 40 !FOUND ONE - END IF - DO WHILE (WNDXLN(LPOFF)) !LOOP - DO I=1,NFILE !ALL FILES - IF (.NOT.WNFOP(FCAIN,FILIN(I),'R')) THEN - CALL WNCTXT(F_TP,'Cannot open input node !AS',NODIN(I)) - CALL WNGEX !STOP PROGRAM - END IF - 20 CONTINUE - IF (NSCSTL(FCAIN,SETS(0,0,I),STH,STHP,SNAM,LPOFF)) THEN !SET FOUND - IF (STHJ(STH_SCN_J).LE.0) GOTO 20 !NO DATA IN SET - CALL WNFCL(FCAIN) !CLOSE FILE - DO I3=1,7 !RESET SETS - SETS(I3,0,I)=0 - END DO - GOTO 40 !FOUND ONE - END IF - CALL WNFCL(FCAIN) !CLOSE FILE - END DO !END FILES - END DO -C - RETURN !NONE FOUND -C -C A SET WAS FOUND -C - 40 CONTINUE - MAXPOS=0 !FIND MAX. TEL.POS. - DO I=0,STHTEL-1 - MAXPOS=MAX(MAXPOS,STHE(STH_RTP_E+I)) - END DO - MAXPOS=MAXPOS-STHE(STH_RTP_E) - FRQMAX=MAX(FRQMAX,REAL(STHD(STH_FRQ_D))) !MAX. FREQ. - FRQMIN=MIN(FRQMIN,REAL(STHD(STH_FRQ_D))) !MIN. FREQ. - UVMAX(0)=MAX(UVMAX(0),REAL(MAXPOS* - 1 STHD(STH_FRQ_D)/(CL*1E-6))) !MAX. U - UVMAX(1)=MAX(UVMAX(1),ABS(REAL(SIN(STHD(STH_DEC_D)*PI2)* - 1 MAXPOS* - 1 STHD(STH_FRQ_D)/(CL*1E-6)))) !MAX. V - UV1MAX(0)=MAX(UV1MAX(0),MAXPOS) !MAX U BASHA - CNTDVL(0)=STHD(STH_RA_D) !RA - CNTDVL(1)=STHD(STH_DEC_D) !DEC - CNTDVL(2)=STHD(STH_RAE_D) !RA EPOCH - CNTDVL(3)=STHD(STH_DECE_D) !DEC EPOCH - CNTDVL(4)=STHE(STH_OEP_E) !OBS. EPOCH - CNTDVL(13)=STHE(STH_EPO_E) !1950/2000 - CNTJVL(0)=STHI(STH_OBS_I) !OBS. DAY - CNTJVL(1)=STHI(STH_OBS_I+1) !OBS. YEAR - CNTJVL(3)=STHJ(STH_VELC_J) !VELOCITY CODE - CNTJVL(6)=STHJ(STH_INST_J) !INSTRUMENT TYPE - CALL WNGMTS(STH_FIELD_N,STH(STH_FIELD_1),CNTCVL(0)) !FIELD NAME - D0=STHE(STH_BAND_E)*STHJ(STH_SCN_J)*STHE(STH_HAV_E) !SET WEIGHT - CNTDVL(14)=2*D0*CNTDVL(5)*ABS(STHD(STH_FRQ_D)-CNTDVL(6))/ - 1 (CNTDVL(5)**2+D0**2)*(CNTDVL(5)+D0)+ - 1 CNTDVL(5)*CNTDVL(14)+D0* - 1 STHE(STH_BAND_E) !BANDWIDTH - CNTDVL(6)=CNTDVL(5)*CNTDVL(6)+D0* - 1 STHD(STH_FRQ_D) !FREQUENCY - CNTDVL(7)=CNTDVL(5)*CNTDVL(7)+D0* - 1 STHE(STH_VEL_E) !VELOCITY - CNTDVL(8)=CNTDVL(5)*CNTDVL(8)+D0* - 1 STHE(STH_VELR_E) !REF. VELOCITY - CNTDVL(9)=CNTDVL(5)*CNTDVL(9)+D0* - 1 STHD(STH_FRQC_D) !BAND REF. FREQUENCY - CNTDVL(12)=CNTDVL(5)*CNTDVL(12)+D0* - 1 STHD(STH_FRQ0_D) !REST FREQUENCY - CNTDVL(5)=CNTDVL(5)+D0 !TOTAL WEIGHTED BAND - CNTDVL(6)=CNTDVL(6)/CNTDVL(5) !AVERAGE FREQUENCY - CNTDVL(7)=CNTDVL(7)/CNTDVL(5) !AVERAGE VELOCITY - CNTDVL(8)=CNTDVL(8)/CNTDVL(5) !AVERAGE REF. VEL. - CNTDVL(9)=CNTDVL(9)/CNTDVL(5) !AVERAGE REF. FREQ. - CNTDVL(12)=CNTDVL(12)/CNTDVL(5) !AVERAGE REST FREQ. - CNTDVL(14)=CNTDVL(14)/CNTDVL(5) !AVERAGE BANDWIDTH - CNTJVL(2)=CNTJVL(2)+1 !COUNT SETS -C -C A COORDINATE -C - 30 CONTINUE - IF (.NOT.ONLY1) THEN - MAPCRD(0)=CNTDVL(0) !APP. RA FIRST SET - MAPCRD(1)=CNTDVL(1) !APP. DEC FIRST SET - ELSE IF (MAPCTP.EQ.1) THEN !APPARENT - MAPCRD(0)=CNTDVL(0) !APP. RA FIRST SET - MAPCRD(1)=CNTDVL(1) !APP. DEC FIRST SET - ELSE IF (MAPCTP.EQ.2) THEN !B1950 - MAPCRD(0)=CNTDVL(2) !RA FIRST SET - MAPCRD(1)=CNTDVL(3) !DEC FIRST SET - END IF -C - RETURN !READY -C -C - END diff --git a/src/nmap/nmastg.for b/src/nmap/nmastg.for deleted file mode 100644 index 8cc11efdb574fa4d4b8755e7f151b77fdb5c486e..0000000000000000000000000000000000000000 --- a/src/nmap/nmastg.for +++ /dev/null @@ -1,98 +0,0 @@ -C+ NMASTG.FOR -C WNB 910327 -C -C Revisions: -C - LOGICAL FUNCTION NMASTG(FCA,SETS,MPH,MPHP,SNAM) -C -C Get next map set -C -C Result: -C -C NMASTG_L = NMASTG( FCA_J:I, SETS_J(0:7,0:*):IO, MPH_B(0:*):O, -C MPHP_J:O, SNAM_J(0:7):O) -C Get next set in file FCA, using the -C specification in SETS (see WNDSTA). -C NMASTG will be .false. if no more sets. -C MPH will be the header of the set, MPHP the -C diskpointer. SNAM is the full name of the -C group, coded. A check is made for the right -C version. -C NMASTH_L = NMASTH( FCA_J:I, SETS_J(0:7,0:*):IO, MPH_B(0:*):O, -C MPHP_J:O, SNAM_J(0:7):O) -C Same, but no check for version -C NMASTL_L = NMASTL( FCA_J:I, SETS_J(0:7,0:*):IO, MPH_B(0:*):O, -C MPHP_J:O, SNAM_J(0:7):O, -C OFFSET_J(0:7):I) -C As NMASTG, but the check in the set list SETS -C is done with offsets OFFSET. -C -C Include files: -C - INCLUDE 'WNG_DEF' - INCLUDE 'MPH_O_DEF' !SET HEADER -C -C Parameters: -C -C -C Entry points: -C - LOGICAL NMASTH !NO VERSION CHECK - LOGICAL NMASTL !OFFSET FOR LOOPS -C -C Arguments: -C - INTEGER FCA !FILE TO SEARCH - INTEGER SETS(0:7,0:*) !SETS TO DO - BYTE MPH(0:*) !SET HEADER - INTEGER MPHP !POINTER TO SET HEADER - INTEGER SNAM(0:7) !FULL SET NAME - INTEGER OFFSET(0:7) !CHECK OFFSET FOR LOOPS -C -C Function references: -C - LOGICAL WNFRD !READ DISK - LOGICAL WNDSTG !FUNCTIONS THAT DO THE WORK - LOGICAL WNDSTH,WNDSTL -C -C Data declarations: -C -C- - NMASTG=WNDSTG(FCA,SETS,MPHHDV,MPHP,SNAM) !GET SET - GOTO 10 -C -C NMASTH -C - ENTRY NMASTH(FCA,SETS,MPH,MPHP,SNAM) -C - NMASTH=WNDSTH(FCA,SETS,MPHHDV,MPHP,SNAM) !GET SET - GOTO 10 -C -C NMASTL -C - ENTRY NMASTL(FCA,SETS,MPH,MPHP,SNAM,OFFSET) -C - NMASTL=WNDSTL(FCA,SETS,MPHHDV,MPHP,SNAM,OFFSET) !GET SET - GOTO 10 -C -C SET SET HEADER -C - 10 CONTINUE - IF (NMASTG) THEN !ONE FOUND - IF (.NOT.WNFRD(FCA,MPHHDL,MPH(0),MPHP)) GOTO 900 !READ SET HEADER - END IF -C - RETURN -C -C ERROR -C - 900 CONTINUE - DO I=1,7 - SETS(I,0)=0 !RESET SEARCH - END DO - NMASTG=.FALSE. !NO MORE -C - RETURN -C -C - END diff --git a/src/nmap/nmatrp.for b/src/nmap/nmatrp.for deleted file mode 100644 index bbffd0ee58cd0fa8221070f02d92ee1100553395..0000000000000000000000000000000000000000 --- a/src/nmap/nmatrp.for +++ /dev/null @@ -1,343 +0,0 @@ -C+ NMATRP.FOR -C WNB 910318 -C -C Revisions: -C WNB 910730 Reverse order FFT -C WNB 911105 Change RAO/DECO definition -C HjV 920520 HP does not allow extended source lines -C WNB 920828 Update line velocities -C WNB 921104 J2000 -C WNB 921202 Add for data clean -C WNB 930127 New bandwidth -C CMV 940530 Add pointer to Job Summary Log -C - SUBROUTINE NMATRP(FIN,NP,TABU,TABV) -C -C Transpose and do second step FFT -C -C Result: -C -C CALL NMATRP( FIN_J:I, NP_J:I, TABU_E(0:*):I, TABV_E(0:*):I) -C Do transpose of map, and the second step -C of the FFT. FIN specifies the input file, -C NP the polarisation being done. -C TABU and TABV the convolution correction -C tables. -C -C -C Include files: -C - INCLUDE 'WNG_DEF' - INCLUDE 'GFH_O_DEF' !GENERAL FILE HEADER - INCLUDE 'SGH_O_DEF' !SUB-GROUP HEADER - INCLUDE 'MPH_O_DEF' !MAP HEADER - INCLUDE 'NMA_DEF' -C -C Parameters: -C -C -C Arguments: -C - INTEGER FIN !INPUT FILE - INTEGER NP !POLARISATION BEING DONE - REAL TABU(0:*) !CORRECTION CONVOLUTION U - REAL TABV(0:*) !IBID. V -C -C Function references: -C - INTEGER WNMEJC !CEIL(X) - INTEGER WNFEOF !GET DISK POSITION - LOGICAL WNDLNF,WNDLNG !LINK SUB-GROUP - LOGICAL WNDLNK !LINK A SET - LOGICAL WNFOP !OPEN DISK FILE - LOGICAL WNFRD !READ DISK - LOGICAL WNFWR !WRITE DISK - LOGICAL WNGGVA !GET MEMORY -C -C Data declarations: -C - LOGICAL LCL !DATA CLEAN SWITCH - INTEGER MPHP !MAP HEADER POINTER - BYTE MPH(0:MPHHDL-1) !MAP HEADER - INTEGER*2 MPHI(0:MPHHDL/2-1) - INTEGER MPHJ(0:MPHHDL/4-1) - REAL MPHE(0:MPHHDL/4-1) - DOUBLE PRECISION MPHD(0:MPHHDL/8-1) - EQUIVALENCE (MPH,MPHI,MPHJ,MPHE,MPHD) - INTEGER LSIZE !# OF LINES PER STAGE - INTEGER LSIZX !IBID. IN BYTES - INTEGER LSTEP !LINE LENGTH ON DISK - INTEGER LOFF !OFFSET ON DISK START AP/MAP - INTEGER BUFPTR,BFPTRX !TRANSPOSE BUFFER ADDR - INTEGER FTBUF,FTBUFE,FTBUFX !FFT BUFFER - INTEGER WTBUF,WTBUFX !FFT WEIGHT BUFFER - INTEGER HIST !HISTOGRAM BUFFER ADDRESS -C- -C -C INITIALIZE -C - LCL=OPT.EQ.'CLE' !SET CLEAN - LSIZE=MIN(WNMEJC(MEMSIZ/FLOAT(LB_X*(UHIGH+1))), - 1 OUTSIZ(1)) !LENGTH ONE STAGE - LSIZX=LB_X*LSIZE !STAGE LENGTH IN BYTES - JS=WNGGVA(LSIZX*(UHIGH+1),BUFPTR) !GET TRANSPOSE BUFFER - IF (JS) JS=WNGGVA(LB_X*FTSIZ(0),FTBUF) !GET FFT BUFFER - IF (JS) JS=WNGGVA(LB_X*FTSIZ(0)/2,WTBUF) !FFT WEIGHT BUFFER - IF (.NOT. JS) THEN - CALL WNCTXT(F_TP,'Cannot obtain transpose buffers') - CALL WNGEX !STOP PROGRAM - END IF - BFPTRX=(BUFPTR-A_OB)/LB_X - WTBUFX=(WTBUF-A_OB)/LB_X - FTBUFE=(FTBUF-A_OB)/LB_E - FTBUFX=(FTBUF-A_OB)/LB_X - DO I=0,FTSIZ(0)/2-1 !FILL WEIGHT BUF - R0=I*PI2/FTSIZ(0) - A_X(WTBUFX+I)=CMPLX(COS(R0),-SIN(R0)) - END DO - LSTEP=0 !STEP - IF (OUTOPT(1)) LSTEP=LSTEP+LB_X*OUTSIZ(1) !DISK INPUT STEP - IF (OUTOPT(2)) LSTEP=LSTEP+LB_X*OUTSIZ(1) -C -C DO ALL LINES -C - DO I1=0,1 !DO MAP AND AP - LOFF=0 !OFFSET ON DISK - IF (I1.EQ.0) THEN - IF (.NOT.OUTOPT(1)) GOTO 10 !DO NOT DO MAP - IF (.NOT.LCL) THEN - IF (.NOT.WNDLNF(SGPH(3)+SGH_LINKG_1,I1,SGH_GROUPN_1,FCAOUT, - 1 SGPH(4),SGNR(4))) THEN !FIND/CREATE SUB-GROUP - 20 CONTINUE - CALL WNCTXT(F_TP,'Error creating sub-group') - CALL WNGEX !STOP PROGRAM - END IF - END IF - ELSE !AP - IF (OUTOPT(1)) LOFF=LB_X*OUTSIZ(1) !OFFSET ON DISK - IF (.NOT.OUTOPT(2)) GOTO 10 !DO NOT DO AP - IF (.NOT.WNDLNF(SGPH(3)+SGH_LINKG_1,I1,SGH_GROUPN_1,FCAOUT, - 1 SGPH(4),SGNR(4))) GOTO 20 !FIND/CREATE SUB-GROUP - END IF - IF (LCL) THEN - MPHP=SGPH(5) - ELSE - CALL WNGMVZ(MPHHDL,MPH) !CLEAR MAP HEADER - MPHP=WNFEOF(FCAOUT) !POINTER TO MAP HEADER - IF (.NOT.WNFWR(FCAOUT,MPHHDL,MPH,MPHP)) GOTO 20 !WRITE MAP HEADER - IF (.NOT.WNDLNK(GFH_LINK_1,MPHP, - 1 MPH_SETN_1,FCAOUT)) GOTO 20 !LINK THE SET - IF (.NOT.WNDLNG(SGPH(4)+SGH_LINKG_1,MPHP, - 1 SGH_GROUPN_1,FCAOUT,SGPH(5), - 1 SGNR(5))) GOTO 20 !LINK SUB-GROUP - END IF - IF (.NOT.WNFRD(FCAOUT,MPHHDL,MPH,MPHP)) GOTO 20 !REREAD MAP HEADER - IF (.NOT.LCL) MPHJ(MPH_MDP_J)=WNFEOF(FCAOUT) !MAP DATA POINTER - MPHI(MPH_VER_I)=MPHHDV !SET MAP VERSION - MPHI(MPH_LEN_I)=MPHHDL !HEADER LENGTH - MPHE(MPH_MAX_E)=-1E30 !INIT MAX/MIN - MPHE(MPH_MIN_E)=+1E30 - IF (I1.EQ.0) THEN !INIT HISTOGRAM - CALL WNMHS8(HIST,1,1E0) !GET HISTO BUFFER - END IF - DO I2=0,OUTSIZ(1)-1,LSIZE !DO STAGES - J0=MIN(LSIZE,OUTSIZ(1)-I2) !LENGTH TO DO IN STAGE - DO J=0,UHIGH !READ A STAGE INTO BUFFER - IF (.NOT.WNFRD(FIN,LB_X*J0,A_X(BFPTRX+J*LSIZE), - 1 LOFF+J*LSTEP+LB_X*I2)) THEN - CALL WNCTXT(F_TP,'Read error transpose file') - CALL WNGEX !STOP PROGRAM - END IF - END DO - DO J1=0,J0-1 !ALL LINES IN STAGE - I5=I2+J1-OUTSIZ(1)/2 !DECLINATION POSITION - DO J=0,UHIGH - A_X(FTBUFX+J)=A_X(BFPTRX+J*LSIZE+J1) !TRANSPOSE - END DO - CALL WNGMVZ(LB_X*(FTSIZ(0)-UHIGH-1), - 1 A_X(FTBUFX+UHIGH+1)) !ZERO BUF - CALL WNMFTC(FTSIZ(0),A_X(FTBUFX), - 1 A_X(WTBUFX)) !FFT - CALL WNMFCS(FTSIZ(0),A_X(FTBUFX)) !SWAP HALVES - CALL WNMFCR(FTSIZ(0),A_X(FTBUFX)) !MAKE REAL -C -C CORRECT FOR CONVOL -C - IF (DECVL) THEN !CORRECT FOR CONVOLUTION - J2=ABS(LB_E*I5) !POS. IN BUF - CALL WNMFSN(OUTSIZ(0)/2,A_E(FTBUFE+FTSIZ(0)/2), - 1 A_B(DECVB(0)-A_OB),A_B(DECVB(1)-A_OB+J2)) - CALL WNMFIN(OUTSIZ(0)/2,A_E(FTBUFE+(FTSIZ(0)- - 1 OUTSIZ(0))/2),A_B(DECVB(0)-A_OB+LB_E), - 1 A_B(DECVB(1)-A_OB+J2)) !NORMALIZE - END IF -C -C NORMALIZE AND FIND MAX/MIN -C - R0=-1E36 !MAX - R1=1E36 !MIN - CALL WNMFMX(OUTSIZ(0),A_E(FTBUFE+(FTSIZ(0)-OUTSIZ(0))/2), - 1 1D0/SUM,R0,I3,R1,I4) !NORM., FIND MIN/MAX - IF (R0.GT.MPHE(MPH_MAX_E)) THEN !NEW MAX - MPHE(MPH_MAX_E)=R0 - MPHJ(MPH_MXR_J)=I3-OUTSIZ(0)/2 - MPHJ(MPH_MXD_J)=I5 - END IF - IF (R1.LT.MPHE(MPH_MIN_E)) THEN !NEW MIN - MPHE(MPH_MIN_E)=R1 - MPHJ(MPH_MNR_J)=I4-OUTSIZ(0)/2 - MPHJ(MPH_MND_J)=I5 - END IF -C -C OUTPUT MAP (OUTSIZ(0)) -C - IF (.NOT.WNFWR(FCAOUT,LB_E*OUTSIZ(0), - 1 A_E(FTBUFE+(FTSIZ(0)-OUTSIZ(0))/2), - 1 MPHJ(MPH_MDP_J)+ - 1 LB_E*(I2+J1)*OUTSIZ(0))) THEN !OUTPUT A LINE - 11 CONTINUE - CALL WNCTXT(F_TP,'Write error Map/AP file') - CALL WNGEX !STOP PROGRAM - END IF - IF (I1.EQ.0) THEN - CALL WNMHS1(HIST,OUTSIZ(0), !MAKE HISTO - 1 A_E(FTBUFE+(FTSIZ(0)-OUTSIZ(0))/2)) - END IF - END DO !END LINES - END DO !END STAGE - CALL WNGMFS(MPH_FNM_N,CNTCVL(0),MPH(MPH_FNM_1)) !FIELD NAME - IF (ABS(MAPCTP).EQ.2) THEN !MAP EPOCH - MPHE(MPH_EPO_E)=CNTDVL(13) - ELSE - MPHE(MPH_EPO_E)=CNTDVL(4) - END IF - MPHD(MPH_RA_D)=MAPCRD(0) !RA MAP - MPHD(MPH_DEC_D)=MAPCRD(1) !DEC MAP - MPHD(MPH_FRQ_D)=CNTDVL(6) !FREQUENCY MAP - MPHD(MPH_BDW_D)=CNTDVL(14) !TOTAL BANDWIDTH - IF (ABS(MAPCTP).EQ.2) THEN !MAP EPOCH - MPHD(MPH_RAO_D)=CNTDVL(2) !EPOCH RA - MPHD(MPH_DECO_D)=CNTDVL(3) !EPOCH DEC - ELSE !APPARENT - MPHD(MPH_RAO_D)=CNTDVL(0) !APPAR. RA - MPHD(MPH_DECO_D)=CNTDVL(1) !APPAR. DEC - END IF - MPHD(MPH_FRQO_D)=CNTDVL(6) !OBS. FREQ. - MPHI(MPH_ODY_I)=CNTJVL(0) !OBS. DAY - MPHI(MPH_OYR_I)=CNTJVL(1) !OBS. YEAR - MPHJ(MPH_INST_J)=CNTJVL(6) !INSTRUMENT TYPE - MPHI(MPH_DCD_I)=5 !E FORMAT - MPHI(MPH_PCD_I)=0 !PROGRAM NMAP - MPHD(MPH_SRA_D)=FIELD(0)/FTSIZ(0)/PI2 !RA GRID STEP - MPHD(MPH_SDEC_D)=FIELD(1)/FTSIZ(1)/PI2 !DEC GRID STEP - MPHD(MPH_SFRQ_D)=0 !FREQ GRID STEP - MPHJ(MPH_NRA_J)=OUTSIZ(0) !SIZE RA - MPHJ(MPH_NDEC_J)=OUTSIZ(1) !SIZE DEC - MPHJ(MPH_NFRQ_J)=1 !SIZE FREQ - MPHJ(MPH_ZRA_J)=OUTSIZ(0)/2 !POS. CENTRE MAP RA - MPHJ(MPH_ZDEC_J)=OUTSIZ(1)/2 !POS. CENTRE MAP DEC - MPHJ(MPH_ZFRQ_J)=0 !POS. CENTRE MAP FREQ - IF (ABS(MAPCTP).EQ.2) THEN !MAP EPOCH - CALL WNMCRD(MPHD(MPH_RA_D),MPHD(MPH_DEC_D),R0,R1, - 1 CNTDVL(2),CNTDVL(3)) - ELSE - CALL WNMCRD(MPHD(MPH_RA_D),MPHD(MPH_DEC_D),R0,R1, - 1 CNTDVL(0),CNTDVL(1)) - END IF - MPHD(MPH_SHR_D)=SHIFT(0)/3600./360.+R0/PI2 !SHIFT RA - MPHD(MPH_SHD_D)=SHIFT(1)/3600./360.+R1/PI2 !SHIFT DEC - MPHD(MPH_SHF_D)=0 !SHIFT FREQ - MPHD(MPH_SUM_D)=SUM !NORMALISATION - MPHE(MPH_UNI_E)=5./1000. !TO GET JY FROM W.U. - CALL WNGMFS(MPH_UCM_N,CNTCVL(1),MPH(MPH_UCM_1)) !USER COMMENT - MPHJ(MPH_NPT_J)=CNTJVL(4) !# OF DATA POINTS - IF (I1.EQ.0) THEN !MAP - CALL WNGMFS(MPH_TYP_N,'MAP',MPH(MPH_TYP_1)) - ELSE !AP - CALL WNGMFS(MPH_TYP_N,'AP',MPH(MPH_TYP_1)) - END IF - CALL WNGMFS(MPH_POL_N,POLC(NP),MPH(MPH_POL_1)) !POL. CODE - MPHI(MPH_CD_I+0)=TAPTYP !TAPER TYPE - MPHI(MPH_CD_I+1)=CVLTYP !CONVOLUTION TYPE - IF (DECVL) THEN - MPHI(MPH_CD_I+2)=1 !DE-CONVOLVE - ELSE - MPHI(MPH_CD_I+2)=0 !NO DE-CONVOLVE - END IF - IF (CLIP) THEN - MPHI(MPH_CD_I+3)=1 !CLIP - ELSE - MPHI(MPH_CD_I+3)=0 !NO CLIP - END IF - IF (SUB) THEN - MPHI(MPH_CD_I+4)=1 !SOURCE SUBTRACTS - ELSE - MPHI(MPH_CD_I+4)=0 !NO SUBTRACTS - END IF - MPHI(MPH_CD_I+5)=DATTYP !DATA TYPE - MPHI(MPH_CD_I+6)=UVCDT !UV COORD. TYPE - MPHI(MPH_CD_I+7)=0 !DE-BEAM COUNT - IF (ABS(MAPCTP).EQ.2) THEN !EPOCH - MPHI(MPH_EPT_I)=1 - MPHE(MPH_OEP_E)=CNTDVL(4) !OBS. EPOCH - ELSE !APPARENT - MPHI(MPH_EPT_I)=0 - MPHE(MPH_OEP_E)=CNTDVL(4) !OBS. EPOCH - END IF - IF (I1.EQ.0) THEN - CALL WNMHS3(HIST,1,F_P) !PRINT HISTO - CALL WNMHS4(HIST,MPHE(MPH_NOS_E),F_P) !GET NOISE - CALL WNMHS9(HIST) !RELEASE BUFFER - END IF - MPHE(MPH_FRA_E)=(OUTSIZ(0)-1)*MPHD(MPH_SRA_D) !FIELD SIZE RA - MPHE(MPH_FDEC_E)=(OUTSIZ(1)-1)*MPHD(MPH_SDEC_D) !FIELD SIZE DEC - MPHE(MPH_FFRQ_E)=0 !FIELD SIZE FREQ - CALL WNGMFS(MPH_TEL_N,'WSRT',MPH(MPH_TEL_1)) !TEL. NAME - MPHJ(MPH_FSR_J)=FTSIZ(0) !FFT SIZES - MPHJ(MPH_FSD_J)=FTSIZ(1) - MPHJ(MPH_NBL_J)=CNTJVL(5) !BASELINE COUNT - MPHJ(MPH_NST_J)=CNTJVL(2) !# OF SETS - MPHJ(MPH_VELC_J)=CNTJVL(3) !VEL. CODE - MPHE(MPH_VEL_E)=CNTDVL(7) !VELOCITY - MPHD(MPH_FRQC_D)=CNTDVL(9) !REF. FREQ. - MPHE(MPH_VELR_E)=CNTDVL(8) !REF. VELOCITY - MPHD(MPH_FRQV_D)=MPHD(MPH_FRQO_D) !OBS. CHANNEL FREQUENCY - MPHD(MPH_FRQ0_D)=CNTDVL(12) !REST FREQ. - IF (I1.EQ.0) THEN - MPHJ(MPH_JOBP_J)=JOBSUM(0) !POINTER TO JOB SUMMARY - MPHJ(MPH_JOBL_J)=JOBSUM(1) !LENGTH OF JOB SUMMARY - CALL NMAJSM(MPH) !UPDATE JOB-SUMMARY - ELSE - MPHJ(MPH_JOBP_J)=0 !NO JOB SUMMARY - MPHJ(MPH_JOBL_J)=0 - END IF - IF (.NOT.WNFWR(FCAOUT,MPHHDL,MPH,MPHP)) GOTO 11 !REWRITE HEADER - CALL WNCTXT(F_P,'!^') !FORM FEED - IF (LCL) THEN !ONLY PRINT (?) - I2=F_TP - ELSE - I2=F_TP - END IF - IF (I1.EQ.0) THEN - CALL WNCTXT(I2,'!2/Description of the map produced:') - ELSE - CALL WNCTXT(I2, - 1 '!2/Description of the antenna pattern produced:') - END IF - SGNR(6)=-1 !FINISH NAME - CALL NMAPMH(I2,MPH,SGNR,NODOUT) - CALL WNCTXT(I2,' ') - CALL WNCCSX(I2,'Finished') !STATISTICS - 10 CONTINUE !SKIP AP OR MAP - END DO !END AP/MAP -C -C FREE BUFFERS -C - CALL WNGFVA(LB_X*FTSIZ(0),FTBUF) !FFT BUFFER - CALL WNGFVA(LB_X*FTSIZ(0)/2,WTBUF) !FFT WEIGHT BUFFER - CALL WNGFVA(LSIZX*(UHIGH+1),BUFPTR) !TRANSPOSE BUFFER -C - RETURN -C -C - END diff --git a/src/nmap/nmauni.for b/src/nmap/nmauni.for deleted file mode 100644 index 03dd30558b5e1b44fc5189ba1bdfd58be4ad25f9..0000000000000000000000000000000000000000 --- a/src/nmap/nmauni.for +++ /dev/null @@ -1,134 +0,0 @@ -C+ NMAUNI.FOR -C WNB 910328 -C -C Revisions: -C - SUBROUTINE NMAUNI(FIN,BAD) -C -C Do uniforming of grid -C -C Result: -C -C CALL NMAUNI( FIN_J:I, BAD_J(4,0:*):I) -C Do uniforming of rectangular grid, -C using sorted data in FIN. -C BAD is the bin administration. -C -C -C Include files: -C - INCLUDE 'WNG_DEF' - INCLUDE 'NMA_DEF' -C -C Parameters: -C -C -C Arguments: -C - INTEGER FIN !SORTED INPUT FILE - INTEGER BAD(4,0:*) !SORT BIN ADMINISTRATION -C -C Function references: -C - LOGICAL WNGGVA !GET VIRTUAL MEMORY - LOGICAL WNFRD !READ FILE - LOGICAL WNFWR !WRITE FILE - INTEGER WNMEJC !CEIL(X) - REAL NMAUNU !UNIFORM FACTOR -C -C Data declarations: -C - INTEGER MAPBUF,MAPBFJ !ADDRESS MAP CONVOL. BUFFER - INTEGER UOUT !CURRENT U OUTPUT - REAL BUF(0:MXSBJ-1) !INPUT BUFFER - INTEGER JBUF(0:MXSBJ-1) - EQUIVALENCE (BUF,JBUF) -C- -C -C INIT -C - UHIGH=UVCMAX(0) !MAXIMUM U COORDINATE - VHIGH=UVCMAX(1) !MAXIMUM V COORDINATE - VLOW=-UVCMAX(1) !MINIMUM V COORDINATE - VSIZE=2*UVCMAX(1)+1 !LENGTH CONVOLUTION LINE - USIZE=WNMEJC(BINSIZ+2*CVLWID(0)) !SIZE OF ONE U CONVOLUTION BUF. - ULOB=0 !START WITH U=0 -C -C GET BUFFER -C - IF (.NOT.WNGGVA(LB_J*USIZE*(VSIZE+1), - 1 MAPBUF)) THEN !GET MAP CONVOLUTION BUFFER - CALL WNCTXT(F_TP,'Cannot obtain uniforming buffer') - CALL WNGEX !STOP PROGRAM - END IF - MAPBFJ=(MAPBUF-A_OB)/LB_J - CALL WNGMVZ(LB_J*(VSIZE+1)*USIZE,A_J(MAPBFJ)) !CLEAR BUF -C -C DO UNIFORMING -C -C INIT -C - UOUT=0 !START U OUTPUT -C -C ALL BINS -C - DO I=0,NBIN !DO FOR ALL BINS - IF (I.LT.NBIN) THEN !READ A BIN - J=BAD(4,I) !BLOCK IN BIN - DO WHILE (J.NE.-1) !MORE DATA IN BIN - IF (WNFRD(FIN,MXSBB,BUF,J)) THEN !READ BUF - J=JBUF(MXSBJ-1) !POINTER TO NEXT BUF - ELSE - 11 CONTINUE - CALL WNCTXT(F_TP,'Read error sorted file') - CALL WNGEX !STOP PROGRAM - END IF - DO I1=0,BAD(3,I)-1,3+2*NPOL !DO ALL DATA POINTS - IF (JBUF(I1+2).EQ.0) GOTO 10 !BUFFER READY - CALL NMAUNX(BUF(I1),A_J(MAPBFJ)) !UNIFORM IT - END DO !END POINTS - 10 CONTINUE - END DO !MORE IN BIN - END IF -C -C CORRECT DATA FOR A BIN -C - IF (I.GT.0) THEN !CORRECT PREVIOUS BIN - I2=I-1 !PREVIOUS BIN - J=BAD(4,I2) !BLOCK IN BIN - DO WHILE (J.NE.-1) !MORE DATA IN BIN - IF (.NOT.WNFRD(FIN,MXSBB,BUF,J)) GOTO 11 !READ BUF - DO I1=0,BAD(3,I2)-1,3+2*NPOL !DO ALL DATA POINTS - IF (JBUF(I1+2).EQ.0) GOTO 20 !BUFFER READY - BUF(I1+2)=BUF(I1+2)*NMAUNU(BUF(I1),A_J(MAPBFJ)) !CORRECT - END DO !END POINTS - 20 CONTINUE - IF (WNFWR(FIN,MXSBB,BUF,J)) THEN !REWRITE BUF - J=JBUF(MXSBJ-1) !POINTER TO NEXT BUF - ELSE - CALL WNCTXT(F_TP,'Rewrite error sorted file') - CALL WNGEX !STOP PROGRAM - END IF - END DO !MORE IN BIN -C -C ZERO BUFFER -C - J2=BINSIZ*I-1 !MAX. U TO DO - DO J1=UOUT,J2 !OUTPUT WHAT IS POSSIBLE - J0=J1-ULOB !OFFSET IN BUF - IF (J0.GE.USIZE) J0=J0-USIZE !WRAP - CALL WNGMVZ(LB_J*VSIZE,A_J(MAPBFJ+J0*VSIZE)) !CLEAR BUF - END DO - UOUT=J2+1 !NEXT OUTPUT START - IF (UOUT-ULOB.GE.USIZE) ULOB=ULOB+USIZE !WRAPPING - END IF !END CORRECTION - END DO !END BINS -C -C FREE BUFFERS -C - CALL WNGFVA(LB_J*USIZE*(VSIZE+1),MAPBUF) !RELEASE MAP BUFFER -C - RETURN -C -C - END diff --git a/src/nmap/nmaunu.for b/src/nmap/nmaunu.for deleted file mode 100644 index a992b47177aa2aa6488dbbf3aea86723a5dfa4eb..0000000000000000000000000000000000000000 --- a/src/nmap/nmaunu.for +++ /dev/null @@ -1,61 +0,0 @@ -C+ NMAUNU.FOR -C WNB 910327 -C -C Revisions: -C - REAL FUNCTION NMAUNU(UVD,CSMAP) - -C -C Determine uniform factor -C -C Result: -C -C NMAUNU_E = NMAUNU( UVD_E(0:1):I, CSMAP_J(0:*):O) -C Determine the UV distribution factor for -C point UVD from CSMAP. -C -C Include files: -C - INCLUDE 'WNG_DEF' - INCLUDE 'NMA_DEF' -C -C Parameters: -C -C -C Arguments: -C - REAL UVD(0:1) !U, V COORDINATE - INTEGER CSMAP(0:*) !OUTPUT PLANE -C -C Function references: -C -C -C Data declarations: -C - INTEGER U !U CELL - INTEGER V !V CELL -C- -C -C INIT -C - U=NINT(UVD(0)) !U CELL - V=NINT(UVD(1)) !V CELL - I=U-ULOB !RELATIVE START U -C -C ACTUAL DETERMINATION -C - IF (I.LT.0) THEN !LEFT-HALF OF PLANE - J=ABS(I) !TAKE CONJUGATE - J1=-V-VLOW !OFFSET V - ELSE - J=I - J1=V-VLOW - END IF - IF (J.GE.USIZE) J=J-USIZE !WRAP AROUND - J=J*VSIZE+J1 !ARRAY POINTER - NMAUNU=1./MAX(1,CSMAP(J)) !FACTOR -C - RETURN -C -C - END diff --git a/src/nmap/nmaunx.for b/src/nmap/nmaunx.for deleted file mode 100644 index 1623f7c67eae3177611d0ee8ca666d31cab221f4..0000000000000000000000000000000000000000 --- a/src/nmap/nmaunx.for +++ /dev/null @@ -1,61 +0,0 @@ -C+ NMAUNX.FOR -C WNB 910327 -C -C Revisions: -C - SUBROUTINE NMAUNX(UVD,CSMAP) - -C -C Determine uniform coverage -C -C Result: -C -C CALL NMAUNX( UVD_E(0:1):I, CSMAP_J(0:*):O) -C Determine the UV distribution of point UVD -C in CSMAP. -C -C Include files: -C - INCLUDE 'WNG_DEF' - INCLUDE 'NMA_DEF' -C -C Parameters: -C -C -C Arguments: -C - REAL UVD(0:1) !U, V COORDINATE - INTEGER CSMAP(0:*) !OUTPUT PLANE -C -C Function references: -C -C -C Data declarations: -C - INTEGER U !U CELL - INTEGER V !V CELL -C- -C -C INIT -C - U=NINT(UVD(0)) !U CELL - V=NINT(UVD(1)) !V CELL - I=U-ULOB !RELATIVE START U -C -C ACTUAL CONVOLUTION -C - IF (I.LT.0) THEN !LEFT-HALF OF PLANE - J=ABS(I) !TAKE CONJUGATE - J1=-V-VLOW !OFFSET V - ELSE - J=I - J1=V-VLOW - END IF - IF (J.GE.USIZE) J=J-USIZE !WRAP AROUND - J=J*VSIZE+J1 !ARRAY POINTER - CSMAP(J)=CSMAP(J)+1 !COUNT POINT -C - RETURN -C -C - END diff --git a/src/nmap/nmawfh.for b/src/nmap/nmawfh.for deleted file mode 100644 index 043070547a655a99ddbc32fd7cc38a07852e0ff2..0000000000000000000000000000000000000000 --- a/src/nmap/nmawfh.for +++ /dev/null @@ -1,507 +0,0 @@ -C+ NMAWFH.FOR -C WNB 910403 -C -C Revisions: -C WNB 920808 Change sign for RA shift -C WNB 920811 Change coordinates if shift -C WNB 920818 Make for longer header; option for units -C WNB 920828 Update for line velocities, instrument -C WNB 921110 Correct mosaic positions -C WNB 921113 ... and sign -C WNB 921119 Correct some velocity formats -C WNB 921119 Add real output; cube -C WNB 930118 Correct typo CRPIX1 -C HjV 940714 Add several keywords, change 'APT' in 'AP' -C CMV 940929 Write pol.angle in degrees -C CMV 940930 Correct division by zero in freq. spacing -C JPH 950116 Backtrack on comment input: SUBROUTINE becomes FUNCTION -C CMV/JPH 960402 Use DAF/DPF formatting to output RA and DEC -C -C - LOGICAL FUNCTION NMAWFH(FBUF,TP,UNIT,OLABEL, - 1 MPH,MPHI,MPHJ,MPHE,MPHD, - 1 CNM,CNF,FMXMN,ABW,SCAL) -C -C Create FITS map header -C -C Result: -C -C NMAWFH_L = NMAWFH( FBUF_C5760:O, TP_J:I, UNIT_E:I, OLABEL_J:I, -C MPH_B(0:*):I, MPHI_I(0:*):I, -C MPHJ_J(0:*):I, MPHE_E(0:*):I, MPHD_D(0:*):I, -C CNM_J:I, CNF_J:I, FMXMN_D(0:1):I, ABW_D:I, -C SCAL_E:O) -C Create FITS header of type TP (16 or 32) -C from MPH map header in FBUF, and return SCALe. -C UNIT is 200. for Jy output, 1. for W.U. -C OLABEL is current label. -C CNM # of maps/file, CNF # of input maps, -C FMXMN max/min frequency, ABW average bandwidth. -C Return value: -C .FALSE. if backtrack requested -C -C PIN references: -C -C COMMENT Comment line(s) -C -C Include files: -C - INCLUDE 'WNG_DEF' - INCLUDE 'MPH_O_DEF' !MAP HEADER -C -C Parameters: -C - INTEGER FHDLEN !LENGTH HEADER - PARAMETER (FHDLEN=2*2880) -C -C Arguments: -C - CHARACTER*(FHDLEN) FBUF !FITS BUFFER - INTEGER TP !HEADER TYPE (16 OR 32) - REAL UNIT !SCALE OUTPUT (200 OR 1) - INTEGER OLABEL !OUTPUT LABEL - BYTE MPH(0:*) !MPH MAP HEADER - INTEGER*2 MPHI(0:*) - INTEGER MPHJ(0:*) - REAL MPHE(0:*) - DOUBLE PRECISION MPHD(0:*) - INTEGER CNM !SIMULTANEOUS OUTPUT MAPS - INTEGER CNF !SIMULTANEOUS INPUT MAPS - DOUBLE PRECISION FMXMN(0:1) !MAX/MIN FREQUENCY - DOUBLE PRECISION ABW !AVERAGE BANDWIDTH - REAL SCAL !DATA SCALE -C -C Function references: -C - LOGICAL WNDPAR !GET USER DATA -C -C Data declarations: -C - REAL LUNIT !DATA UNIT - INTEGER LVEL !VEL TEST - CHARACTER*4 C2 - CHARACTER*4 C4 - CHARACTER*8 C8 -C- - NMAWFH = .TRUE. -C -C REQUIRED HEADER PARAMETERS -C - J=1 - FBUF=' ' - CALL WNCTXS(FBUF(J:J+79), - 1 'SIMPLE = T') - J=J+80 - IF (TP.EQ.16) THEN - CALL WNCTXS(FBUF(J:J+79), - 1 'BITPIX = 16') - ELSE IF (TP.EQ.32) THEN - CALL WNCTXS(FBUF(J:J+79), - 1 'BITPIX = 32') - ELSE - CALL WNCTXS(FBUF(J:J+79), - 1 'BITPIX = -32') - END IF - J=J+80 - CALL WNCTXS(FBUF(J:J+79), - 1 'NAXIS = 3') - J=J+80 - CALL WNCTXS(FBUF(J:J+79), - 1 'NAXIS1 =!21$UJ',MPHJ(MPH_NRA_J)) - J=J+80 - CALL WNCTXS(FBUF(J:J+79), - 1 'NAXIS2 =!21$UJ',MPHJ(MPH_NDEC_J)) - J=J+80 - CALL WNCTXS(FBUF(J:J+79), - 1 'NAXIS3 =!21$UJ',CNM) - J=J+80 - SCAL=MAX(ABS(MPHE(MPH_MAX_E)),ABS(MPHE(MPH_MIN_E))) !SCALE - IF (SCAL.NE.0.0) THEN - IF (TP.EQ.16) THEN - SCAL=(2.**15-1.)/SCAL - ELSE IF (TP.EQ.32) THEN - SCAL=(2.**30-1.)/SCAL - ELSE - SCAL=1. - END IF - ELSE - SCAL=1. - END IF - CALL WNGMTS(4,MPH(MPH_TYP_1),C4) !MAP TYPE - CALL WNCTXS(FBUF(J:J+79), - 1 'MAPTYP = ''!AS''',C4) - J=J+80 - CALL WNGMTS(2,MPH(MPH_POL_1),C2) !POL. CODE - CALL WNCTXS(FBUF(J:J+79), - 1 'POL = ''!AS''',C2) - J=J+80 - IF (C4.EQ.'AP') THEN - CALL WNCTXS(FBUF(J:J+79), - 1 'BSCALE =!21$E7!32C/REAL = TAPE *BSCALE + BZERO', - 1 1./SCAL) - LUNIT=1. !NO UNIT -C -C Convert radians to degrees using AIPS convention -C - ELSE IF (C2.EQ.'PA') THEN !POL. ANGLE - CALL WNCTXS(FBUF(J:J+79), - 1 'BSCALE =!21$E7!32C/REAL = TAPE *BSCALE + BZERO', - 1 (1./SCAL)*(180./PI)) - LUNIT=1. !DEGREE - ELSE - CALL WNCTXS(FBUF(J:J+79), - 1 'BSCALE =!21$E7!32C/REAL = TAPE *BSCALE + BZERO', - 1 1./SCAL/UNIT) - LUNIT=UNIT - END IF - J=J+80 - CALL WNCTXS(FBUF(J:J+79), - 1 'BZERO = 0.0') - J=J+80 - IF (C2.EQ.'PA') THEN - CALL WNCTXS(FBUF(J:J+79), - 1 'BUNIT = ''DEGREE ''') - ELSE IF (UNIT.EQ.200. .OR. C4.EQ.'AP') THEN - CALL WNCTXS(FBUF(J:J+79), - 1 'BUNIT = ''JY/BEAM ''') - ELSE - CALL WNCTXS(FBUF(J:J+79), - 1 'BUNIT = ''W.U. ''') - END IF - J=J+80 - CALL WNCTXS(C8,'!%DN') - CALL WNCTXS(FBUF(J:J+79), - 1 'DATE = ''!AS/!AS/!AS''', - 1 C8(5:6),C8(3:4),C8(1:2)) - J=J+80 - CALL WNCTXS(FBUF(J:J+79), - 1 'ORIGIN = ''DWINGELOO (NL) PGM=NMAP(!AS)''', - 1 PRGVER) - J=J+80 - CALL WNCTXS(FBUF(J:J+79), - 1 'EPOCH =!21$E7!32C/EPOCH OF MAP', - 1 MPHE(MPH_EPO_E)) - J=J+80 - IF (MPHJ(MPH_INST_J).EQ.1) THEN - CALL WNCTXS(FBUF(J:J+79), - 1 'INSTRUME= ''ATCA ''') - ELSE - CALL WNCTXS(FBUF(J:J+79), - 1 'INSTRUME= ''WSRT ''') - END IF - J=J+80 - CALL WNCTXS(FBUF(J:J+79), - 1 'CRVAL1 =!21$DPF7!32C/REF. PIXEL RIGHT ASCENSION (DEGREES)', - 1 MPHD(MPH_RA_D)) - J=J+80 - CALL WNCTXS(FBUF(J:J+79), - 1 'CRPIX1 =!21$D7!32C/REF. PIXEL HOR. INDEX, LL=(1,1)', - 1 MPHJ(MPH_NRA_J)/2+1D0- - 1 MPHD(MPH_SHR_D)/MPHD(MPH_SRA_D)) - J=J+80 - CALL WNCTXS(FBUF(J:J+79), - 1 'CDELT1 =!21$DAF7!32C/RA INCREMENT (DEGREES)', - 1 -MPHD(MPH_SRA_D)) - J=J+80 - CALL WNCTXS(FBUF(J:J+79), - 1 'CTYPE1 = ''RA---NCP''') - J=J+80 - CALL WNCTXS(FBUF(J:J+79), - 1 'CRVAL2 =!21$DAF7!32C/REF. PIXEL DECLINATION (DEGREES)', - 1 MPHD(MPH_DEC_D)) - J=J+80 - CALL WNCTXS(FBUF(J:J+79), - 1 'CRPIX2 =!21$D7!32C/REF. PIXEL VERT. INDEX, LL=(1,1)', - 1 MPHJ(MPH_NDEC_J)/2+1D0- - 1 MPHD(MPH_SHD_D)/MPHD(MPH_SDEC_D)) - J=J+80 - CALL WNCTXS(FBUF(J:J+79), - 1 'CDELT2 =!21$DAF7!32C/DEC INCREMENT (DEGREES)', - 1 MPHD(MPH_SDEC_D)) - J=J+80 - CALL WNCTXS(FBUF(J:J+79), - 1 'CTYPE2 = ''DEC--NCP''') - J=J+80 - IF (MPHJ(MPH_VELC_J).GT.0 .AND. MPHJ(MPH_VELC_J).LE.4) THEN - CALL WNCTXS(FBUF(J:J+79), - 1 'CRVAL3 =!21$D13!32C/FREQUENCY (HERTZ)', - 1 (MPHD(MPH_FRQV_D))*1.D6) - LVEL=1 - ELSE - CALL WNCTXS(FBUF(J:J+79), - 1 'CRVAL3 =!21$D7!32C/FREQUENCY (HERTZ)', - 1 (MPHD(MPH_FRQO_D))*1.D6) - LVEL=0 - END IF - J=J+80 - IF (LVEL.EQ.1 .AND. CNF.GT.1 .AND. - 1 ABS(FMXMN(0)-FMXMN(1)).GT.1E-16) THEN - CALL WNCTXS(FBUF(J:J+79), - 1 'CRPIX3 =!21$D7', - 1 (MPHD(MPH_FRQV_D)-FMXMN(1))/ - 1 ((FMXMN(0)-FMXMN(1))/(CNF-1))+1D0) - J=J+80 - CALL WNCTXS(FBUF(J:J+79), - 1 'CDELT3 =!21$D7!32C/CHANNEL SEPARATION (HERTZ)', - 1 ((FMXMN(0)-FMXMN(1))*1.D6)/(CNF-1)) - ELSE - CALL WNCTXS(FBUF(J:J+79), - 1 'CRPIX3 =!19$UJ\.0', - 1 1) - J=J+80 - CALL WNCTXS(FBUF(J:J+79), - 1 'CDELT3 =!21$D7!32C/CHANNEL SEPARATION (HERTZ)', - 1 MPHD(MPH_BDW_D)*1.D6) - END IF - J=J+80 - IF (LVEL.EQ.1) THEN - CALL WNCTXS(FBUF(J:J+79), - 1 'CRESL3 =!21$D7!32C/BANDWIDTH (HERTZ)', - 1 ABW*1.D6) - ELSE - CALL WNCTXS(FBUF(J:J+79), - 1 'CRESL3 =!21$D7!32C/BANDWIDTH (HERTZ)', - 1 MPHD(MPH_BDW_D)*1.D6) - END IF - J=J+80 - CALL WNCTXS(FBUF(J:J+79), - 1 'CTYPE3 = ''FREQ ''') - J=J+80 - CALL WNCTXS(FBUF(J:J+79), - 1 'OBJECT = '' ''') - CALL WNGMTS(12,MPH(MPH_FNM_1),FBUF(J+11:J+22)) - J=J+80 - CALL WNCTXS(FBUF(J:J+79), - 1 'DATE-OBS=!21$E21.3', - 1 MPHE(MPH_OEP_E)) - J=J+80 - IF (LVEL.EQ.1 .AND. CNF.GT.1) THEN - CALL WNCTXS(FBUF(J:J+79), - 1 'BANDW =!21$D7!32C/TOTAL BANDWIDTH OF OBS(HERTZ)', - 1 (ABS((FMXMN(0)-FMXMN(1)))*1.D6*CNF)/(CNF-1)) - ELSE - CALL WNCTXS(FBUF(J:J+79), - 1 'BANDW =!21$D7!32C/TOTAL BANDWIDTH OF OBS(HERTZ)', - 1 MPHD(MPH_BDW_D)*1.D6) - END IF - J=J+80 - CALL WNCTXS(FBUF(J:J+79), - 1 'VEL =!21$E7!32C/CENTRE VELOCITY (M/S)', - 1 MPHE(MPH_VEL_E)) - J=J+80 - IF (LVEL.EQ.1) THEN - IF (MPHJ(MPH_VELC_J).EQ.1) THEN - CALL WNCTXS(FBUF(J:J+79), - 1 'VELCODE = ''RHEL ''') !!! - ELSE IF (MPHJ(MPH_VELC_J).EQ.2) THEN - CALL WNCTXS(FBUF(J:J+79), - 1 'VELCODE = ''RLSR ''') !!! - ELSE IF (MPHJ(MPH_VELC_J).EQ.3) THEN - CALL WNCTXS(FBUF(J:J+79), - 1 'VELCODE = ''OHEL ''') !!! - ELSE IF (MPHJ(MPH_VELC_J).EQ.4) THEN - CALL WNCTXS(FBUF(J:J+79), - 1 'VELCODE = ''OLSR ''') !!! - END IF - J=J+80 - CALL WNCTXS(FBUF(J:J+79), - 1 'VELR =!21$E7!32C/REFERENCE VELOCITY (M/S)', - 1 MPHE(MPH_VELR_E)) - J=J+80 - CALL WNCTXS(FBUF(J:J+79), - 1 'FREQR =!21$D13!32C/REFERENCE FREQUENCY (HERTZ)', - 1 (MPHD(MPH_FRQC_D))*1.D6) - J=J+80 - CALL WNCTXS(FBUF(J:J+79), - 1 'FREQ0 =!21$D13!32C/REST FREQUENCY (HERTZ)', - 1 (MPHD(MPH_FRQ0_D))*1.D6) - J=J+80 - END IF - CALL WNCTXS(FBUF(J:J+79), - 1 'PCRA =!21$DPF7!32C/POINTING CENTRE R.A. (DEG)', - 1 MPHD(MPH_RAO_D)) - J=J+80 - CALL WNCTXS(FBUF(J:J+79), - 1 'PCDEC =!21$DAF7!32C/POINTING CENTRE DEC (DEG)', - 1 MPHD(MPH_DECO_D)) - J=J+80 - CALL WNCTXS(FBUF(J:J+79), - 1 'NBLANK =!21$UJ!32C/NUMBER OF UNDEF. VALUES', - 1 0) - J=J+80 - IF (MPHI(MPH_CD_I+0).EQ.1) THEN - CALL WNCTXS(FBUF(J:J+79), - 1 'BLGRAD = ''GAUSSIAN ''') - ELSE IF (MPHI(MPH_CD_I+0).EQ.2) THEN - CALL WNCTXS(FBUF(J:J+79), - 1 'BLGRAD = ''LINEAR ''') - ELSE IF (MPHI(MPH_CD_I+0).EQ.3) THEN - CALL WNCTXS(FBUF(J:J+79), - 1 'BLGRAD = ''NATURAL ''') - ELSE IF (MPHI(MPH_CD_I+0).EQ.4) THEN - CALL WNCTXS(FBUF(J:J+79), - 1 'BLGRAD = ''OVERR ''') - ELSE IF (MPHI(MPH_CD_I+0).EQ.5) THEN - CALL WNCTXS(FBUF(J:J+79), - 1 'BLGRAD = ''RGAUSS ''') - ELSE - CALL WNCTXS(FBUF(J:J+79), - 1 'BLGRAD = ''UNKNOWN ''') - END IF - CALL WNCTXS(FBUF(J+31:J+79),'/TAPER TYPE') - J=J+80 - IF (MPHI(MPH_CD_I+1).EQ.1) THEN - CALL WNCTXS(FBUF(J:J+79), - 1 'UVGRID = ''GAUSSIAN ''') - ELSE IF (MPHI(MPH_CD_I+1).EQ.2) THEN - CALL WNCTXS(FBUF(J:J+79), - 1 'UVGRID = ''BOX ''') - ELSE IF (MPHI(MPH_CD_I+1).EQ.3) THEN - CALL WNCTXS(FBUF(J:J+79), - 1 'UVGRID = ''PROLATE 4*4''') - ELSE IF (MPHI(MPH_CD_I+1).EQ.4) THEN - CALL WNCTXS(FBUF(J:J+79), - 1 'UVGRID = ''EXP*SINC ''') - ELSE IF (MPHI(MPH_CD_I+1).EQ.5) THEN - CALL WNCTXS(FBUF(J:J+79), - 1 'UVGRID = ''PROLATE 6*6''') - ELSE - CALL WNCTXS(FBUF(J:J+79), - 1 'UVGRID = ''UNKNOWN ''') - END IF - CALL WNCTXS(FBUF(J+31:J+79),'/CONVOLUTION TYPE') - J=J+80 - CALL WNCTXS(FBUF(J:J+79), - 1 'CORGRID =!21$UI!32C/CORRECT FOR CONVOLUTION', - 1 MPHI(MPH_CD_I+2)) - J=J+80 - CALL WNCTXS(FBUF(J:J+79), - 1 'CLIP =!21$UI!32C/CLIPPING DONE', - 1 MPHI(MPH_CD_I+3)) - J=J+80 - CALL WNCTXS(FBUF(J:J+79), - 1 'SUBTR =!21$UI!32C/SOURCE SUBTRACTION', - 1 MPHI(MPH_CD_I+4)) - J=J+80 - IF (MPHI(MPH_CD_I+5).EQ.1) THEN - CALL WNCTXS(FBUF(J:J+79), - 1 'DATTYP = ''NORMAL ''') - ELSE IF (MPHI(MPH_CD_I+5).EQ.2) THEN - CALL WNCTXS(FBUF(J:J+79), - 1 'DATTYP = ''COSINE ''') - ELSE IF (MPHI(MPH_CD_I+5).EQ.3) THEN - CALL WNCTXS(FBUF(J:J+79), - 1 'DATTYP = ''SINE ''') - ELSE IF (MPHI(MPH_CD_I+5).EQ.4) THEN - CALL WNCTXS(FBUF(J:J+79), - 1 'DATTYP = ''AMPLITUDE ''') - ELSE IF (MPHI(MPH_CD_I+5).EQ.5) THEN - CALL WNCTXS(FBUF(J:J+79), - 1 'DATTYP = ''PHASE ''') - ELSE - CALL WNCTXS(FBUF(J:J+79), - 1 'DATTYP = ''UNKNOWN ''') - END IF - CALL WNCTXS(FBUF(J+31:J+79),'/DATA TYPE') - J=J+80 - IF (MPHI(MPH_CD_I+6).EQ.0) THEN - CALL WNCTXS(FBUF(J:J+79), - 1 'UVCDT = ''NORMAL ''') - ELSE IF (MPHI(MPH_CD_I+6).EQ.1) THEN - CALL WNCTXS(FBUF(J:J+79), - 1 'UCVDT = ''BAS-HA ''') - ELSE IF (MPHI(MPH_CD_I+6).EQ.2) THEN - CALL WNCTXS(FBUF(J:J+79), - 1 'UVCDT = ''IFR-HA ''') - ELSE - CALL WNCTXS(FBUF(J:J+79), - 1 'UVCDT = ''UNKNOWN ''') - END IF - CALL WNCTXS(FBUF(J+31:J+79),'/UV COORDINATE TYPE') - J=J+80 - CALL WNCTXS(FBUF(J:J+79), - 1 'DEBEAM =!21$UI!32C/DE-BEAM COUNT', - 1 MPHI(MPH_CD_I+7)) - J=J+80 - CALL WNCTXS(FBUF(J:J+79), - 1 'DATAMAX =!21$E7!32C/MAX. INTENSITY', - 1 MPHE(MPH_MAX_E)/LUNIT) - J=J+80 - CALL WNCTXS(FBUF(J:J+79), - 1 'DATAMIN =!21$E7!32C/MIN. INTENSITY', - 1 MPHE(MPH_MIN_E)/LUNIT) - J=J+80 - CALL WNCTXS(FBUF(J:J+79), - 1 'NINTF =!21$UJ!32C/TOTAL INTERFEROMETERS', - 1 MPHJ(MPH_NBL_J)) - J=J+80 - CALL WNCTXS(FBUF(J:J+79), - 1 'NFREQ =!21$UJ!32C/TOTAL # OF FREQUENCY POINTS', - 1 CNF) - J=J+80 - CALL WNCTXS(FBUF(J:J+79), - 1 'NOISE =!21$E7!32C/NOISE IN MAP', - 1 MPHE(MPH_NOS_E)/LUNIT) - J=J+80 - CALL WNCTXS(FBUF(J:J+79), - 1 'NORM =!21$D7!32C/NORM. FACTOR IN FFT', - 1 MPHD(MPH_SUM_D)) - J=J+80 - CALL WNCTXS(FBUF(J:J+79), - 1 'FFTRA =!21$UJ!32C/FFT SIZE IN R.A.', - 1 MPHJ(MPH_FSR_J)) - J=J+80 - CALL WNCTXS(FBUF(J:J+79), - 1 'FFTDEC =!21$UJ!32C/FFT SIZE IN DEC.', - 1 MPHJ(MPH_FSD_J)) - J=J+80 - CALL WNCTXS(FBUF(J:J+79), - 1 'SETNR =!21$UJ!32C/# OF SET.', - 1 MPHJ(MPH_SETN_J)) - J=J+80 - CALL WNCTXS(FBUF(J:J+79), - 1 'INSECT =!21$UJ!32C/INPUT SECTORS.', - 1 MPHJ(MPH_NST_J)) - J=J+80 - CALL WNCTXS(FBUF(J:J+79), - 1 'INPTS =!21$UJ!32C/INPUT POINTS.', - 1 MPHJ(MPH_NPT_J)) - J=J+80 - CALL WNCTXS(FBUF(J:J+79), - 1 'MAPLAB =!21$UJ!32C/LABEL OF THIS MAP', - 1 OLABEL) - J=J+80 -C -C COMMENT -C - J1=J ! remember - 10 CONTINUE - JS=.TRUE. - J0=1 - DO WHILE (J.LT.FHDLEN-80 .AND. J0.GT.0 .AND. JS) - 11 CONTINUE - FBUF(J:J+79)='COMMENT' - JS=WNDPAR('COMMENT',FBUF(J+10:J+79),70,J0,'""') - IF (.NOT.JS) THEN - IF (E_C.EQ.DWC_ENDOFLOOP) THEN - IF (J.GT.J1) THEN - CALL WNCTXT(F_TP,' Restarting comment input') - GOTO 10 - ELSE - CALL WNCTXT(F_TP,' Aborting FITS write') - NMAWFH=.FALSE. - GOTO 900 - ENDIF - ENDIF - ELSE - J=J+80 - ENDIF - END DO -C - FBUF(J:)='END' -C -900 CONTINUE - RETURN -C -C - END diff --git a/src/nmap/nmawft.for b/src/nmap/nmawft.for deleted file mode 100644 index 7402ca953be5c8c01c6a37a7c4399366fc9a059f..0000000000000000000000000000000000000000 --- a/src/nmap/nmawft.for +++ /dev/null @@ -1,303 +0,0 @@ -C+ NMAWFT.FOR -C WNB 910403 -C -C Revisions: -C WNB 920818 Longer header -C WNB 920828 Correct label count -C WNB 921119 Add real format; cube -C WNB 930118 Correct FMXMN(0) -C WNB 930224 Typo (FRQ0) for FMXMN; close wrong place -C WNB 930304 Make cube output contiguous -C JPH 950117 NMAWFH becomes a function, quit if .FALSE. returned -C (This is a backtracking mechanism.) - Make FITS header -C before opening output, so latter is skipped in case of -C backtrack. -C Find free label if wildcard specified. -C (Up to now, * was equivalent to 1.) -C HjV 970408 Ask COMMENT only for first CUBE -C -C - SUBROUTINE NMAWFT(TP) -C -C Write maps in FITS format -C -C -C Result: -C -C CALL NMAWFT( TP_J:I) Write FITS header with type TP (16 or 32) -C -C Include files: -C - INCLUDE 'WNG_DEF' - INCLUDE 'NMA_DEF' - INCLUDE 'MPH_O_DEF' !MAP HEADER -C -C Parameters: -C - INTEGER FBFLEN,FHDLEN !FITS BUFFER LENGTH, HEADER LENGTH - PARAMETER (FBFLEN=2880) - PARAMETER (FHDLEN=2*FBFLEN) -C -C Arguments: -C - INTEGER TP !# OF BITS (16 OR 32) PER DATA POINT -C -C Function references: -C - LOGICAL WNFMOU !MOUNT TAPE - LOGICAL WNFOP,WNFOPF !OPEN FILE - LOGICAL WNFWR !WRITE DATA - LOGICAL WNFRD !READ DATA - INTEGER WNFTLB !CURRENT TAPE LABEL - CHARACTER*32 WNTTSG !MAP SET NAME - INTEGER WNCALN !STRING LENGTH - LOGICAL NMASTG !GET MAP SET - LOGICAL NMAWFH !make fits header -C -C Data declarations: -C - CHARACTER*160 OFILE !FILE NAME - INTEGER MPHP !MAP HEADER POINTER - BYTE MPH(0:MPHHDL-1) !MAP HEADER - INTEGER*2 MPHI(0:MPHHDL/2-1) - INTEGER MPHJ(0:MPHHDL/4-1) - REAL MPHE(0:MPHHDL/4-1) - DOUBLE PRECISION MPHD(0:MPHHDL/8-1) - EQUIVALENCE (MPH,MPHI,MPHJ,MPHE,MPHD) - CHARACTER*(FHDLEN) FBUF !FITS BUFFER - BYTE LFBUF(0:FHDLEN-1) - INTEGER*2 IFBUF(0:FHDLEN/2-1) - INTEGER JFBUF(0:FHDLEN/4-1) - REAL EFBUF(0:FHDLEN/4-1) - EQUIVALENCE (FBUF,LFBUF,IFBUF,JFBUF,EFBUF) - REAL INBUF(0:16383) !MAP LINE BUFFER - INTEGER JI1,JI2 !COUNTS - REAL SCAL !DATA SCALE - INTEGER*2 ITRB(0:3) !DATA TRANSLATION I - DATA ITRB/2,1440,0,1/ - INTEGER*2 JTRB(0:3) !DATA TRANSLATION J - DATA JTRB/3,720,0,1/ - INTEGER*2 ETRB(0:3) !DATA TRANSLATION E - DATA ETRB/4,720,0,1/ - LOGICAL FMAP,FLINE !FIRST MAP, LINE POSSIBLE - REAL CMAX,CMIN !CURRENT MAX/MIN - DOUBLE PRECISION CBW,ABW !CURRENT, AVERAGE BANDWIDTH - DOUBLE PRECISION CDF !CURRENT CHANNEL INCREMENT - INTEGER CSZ(0:1) !CURRENT SIZES - DOUBLE PRECISION CCRD(0:1) !CURRENT COORDINATES - INTEGER CNF,CNM !MAP COUNT - DOUBLE PRECISION FMXMN(0:1) !CURRENT MAX/MIN FREQ. - DOUBLE PRECISION CFRQ !CURRENT FREQ. -C- -C -C INIT -C -C -C GET INFO MAPS -C - FMAP=.TRUE. !FIRST MAP - FLINE=.TRUE. !ASSUME LINE POSSIBLE - CNF=0 !NO MAPS SEEN - CDF=0 !FREQ. INCREMENT - DO WHILE(NMASTG(FCAOUT,SETS,MPH,MPHP,SGNR)) !READ MAPS - IF (FMAP) THEN - FMAP=.FALSE. !NOT FIRST - CMAX=MPHE(MPH_MAX_E) !CURRENT MAX/MIN - CMIN=MPHE(MPH_MIN_E) - CBW=MPHD(MPH_BDW_D) !BANDWIDTH - CSZ(0)=MPHJ(MPH_NRA_J) !SIZE - CSZ(1)=MPHJ(MPH_NDEC_J) - CCRD(0)=MPHD(MPH_RA_D) !RA/DEC - CCRD(1)=MPHD(MPH_DEC_D) - CNF=1 !# OF MAPS - ABW=CBW !AVERAGE BANDWIDTH - FMXMN(0)=MPHD(MPH_FRQV_D) !FREQ. - FMXMN(1)=MPHD(MPH_FRQV_D) - CFRQ=MPHD(MPH_FRQV_D) - ELSE - CMAX=MAX(CMAX,MPHE(MPH_MAX_E)) - CMIN=MIN(CMIN,MPHE(MPH_MIN_E)) - IF (ABS(CBW-MPHD(MPH_BDW_D)).GT.1E-3*CBW) FLINE=.FALSE. !NO LINE - IF (CSZ(0)-MPHJ(MPH_NRA_J).NE.0) FLINE=.FALSE. - IF (CSZ(1)-MPHJ(MPH_NDEC_J).NE.0) FLINE=.FALSE. - IF (ABS(CCRD(0)-MPHD(MPH_RA_D)).GT.1E-5) FLINE=.FALSE. - IF (ABS(CCRD(1)-MPHD(MPH_DEC_D)).GT.1E-5) FLINE=.FALSE. - ABW=ABW+MPHD(MPH_BDW_D) !AVERAGE BANDWIDTH - IF (CNF.EQ.1) THEN !2ND MAP - CDF=MPHD(MPH_FRQV_D)-CFRQ !FREQ. INTERVAL - ELSE - IF (ABS(MPHD(MPH_FRQV_D)-CFRQ-CDF).GT.1E-2*ABS(CDF)) - 1 FLINE=.FALSE. !CANNOT DO LINE - END IF - CFRQ=MPHD(MPH_FRQV_D) - FMXMN(0)=MAX(FMXMN(0),MPHD(MPH_FRQV_D)) - FMXMN(1)=MIN(FMXMN(1),MPHD(MPH_FRQV_D)) - CNF=CNF+1 !COUNT MAPS - END IF - END DO - IF (CNF.GT.0) ABW=ABW/CNF !AVERAGE BANDWIDTH - IF (POLT(0,0).EQ.1 .AND. .NOT.FLINE) THEN !CUBIC ASKED, BUT NOT TO DO - CALL WNCTXT(F_TP,'Cubic asked, but maps do not conform') - POLT(0,0)=0 !SET NO CUBIC - END IF - IF (POLT(0,0).EQ.0) THEN !NO CUBE - CNM=1 !SIMULTANEOUS MAPS - ELSE - CNM=CNF - END IF - IF (CDF.LT.0) THEN !REVERSE ORDER FREQ. - D0=FMXMN(0) - FMXMN(0)=FMXMN(1) - FMXMN(1)=D0 - END IF -C -C GET MAP -C - FMAP=.TRUE. !FIRST MAP - J4=0 !OUTPUT POINT COUNT - 50 CONTINUE - IF (.NOT.NMASTG(FCAOUT,SETS,MPH,MPHP,SGNR)) GOTO 810 !NO MORE MAPS -C -C Make FITS header in core. -C NMAWFH prompts for user comments, returns .FALSE. if user requests backtrack -C - IF (FMAP) THEN ! skip if CUBE - IF (POLT(0,0).EQ.1) THEN !CUBE - MPHE(MPH_MAX_E)=CMAX !CURRENT MAX/MIN - MPHE(MPH_MIN_E)=CMIN - END IF - IF (.NOT.NMAWFH(FBUF,TP,CWGVAL,OLABEL-1, - 1 MPH,MPHI,MPHJ,MPHE,MPHD,CNM,CNF,FMXMN,ABW, - 1 SCAL)) GOTO 800 ! GET HEADER -C -C For wildcard (OLABEL<0) find the first non-existent label. Open output -C - IF (OUNIT.EQ.'D') THEN - IF (OLABEL.LE.0) THEN - OLABEL=-1 - DO WHILE (OLABEL.LT.0) - CALL WNCTXS(OFILE,'!AS\.!6$ZJ',FILIN,-OLABEL) !MAKE FILE NAME - IF (WNFOP(FCATAP,OFILE(1:WNCALN(OFILE)),'R')) THEN - OLABEL=OLABEL-1 - ELSE - GOTO 30 - ENDIF - ENDDO - ENDIF - 30 CONTINUE - OLABEL=-OLABEL -C - CALL WNCTXS(OFILE,'!AS\.!6$ZJ',FILIN,ABS(OLABEL)) !MAKE FILE NAME -!! OLABEL=OLABEL+1 !COUNT LABELS - IF (.NOT.WNFOP(FCATAP,OFILE(1:WNCALN(OFILE)),'W')) THEN - CALL WNCTXT(F_TP,'Cannot open output file !AS',OFILE) - GOTO 800 - END IF - ELSE - IF (OLABEL.LE.0) THEN !AT END OF TAPE - IF (.NOT.WNFOPF(FCATAP,' ','W',0,FBFLEN,80,0)) THEN - 51 CONTINUE - CALL WNCTXT(F_TP,'Cannot open output tape') - GOTO 800 - END IF - OLABEL=WNFTLB(FCATAP) !LABEL - ELSE - IF (.NOT.WNFOPF(FCATAP,' ','W',0,FBFLEN, - 1 80,OLABEL)) GOTO 51 !OPEN TAPE - END IF - CALL WNCTXS(OFILE,'!6$ZJ',OLABEL) !LABEL NAME - OLABEL=OLABEL+1 !NEXT LABEL - END IF - CALL WNCTXT(F_TP,'Writing !AS to file/label !AS', - 1 WNTTSG(SGNR,0),OFILE) -C -C WRITE HEADER DATA -C - J2=0 !OUTPUT POINTER - DO I=0,FHDLEN-1,FBFLEN - IF (.NOT.WNFWR(FCATAP,FBFLEN,LFBUF(I),J2)) THEN !WRITE FITS HEADER - 52 CONTINUE - CALL WNCTXT(F_TP,'Error writing FITS data') - GOTO 800 - END IF - J2=J2+FBFLEN - END DO - IF (POLT(0,0).EQ.1 .AND. CNF.GT.1) FMAP=.FALSE. !WRITE CUBE - ENDIF -C -C WRITE MAP DATA -C - J3=MPHJ(MPH_MDP_J) !INPUT DATA POINTER - JI1=MPHJ(MPH_NRA_J) !POINTS PER LINE - JI2=MPHJ(MPH_NDEC_J) !LINES - DO I3=1,JI2 !ALL LINES - IF (.NOT.WNFRD(FCAOUT,LB_E*JI1,INBUF,J3)) THEN !READ A LINE - CALL WNCTXT(F_TP,'Error reading data') - GOTO 800 - END IF - J3=J3+LB_E*JI1 !INPUT POINTER UPDATE - DO I4=0,JI1-1 !OUTPUT WORDS - IF (TP.EQ.16) THEN - IFBUF(J4/LB_I)=INBUF(I4)*SCAL !SCALE DATA - J4=J4+LB_I - ELSE IF (TP.EQ.32) THEN !32 BITS - JFBUF(J4/LB_J)=INBUF(I4)*SCAL !SCALE DATA - J4=J4+LB_J - ELSE !REAL - EFBUF(J4/LB_E)=INBUF(I4)*SCAL !SCALE DATA - J4=J4+LB_E - END IF - IF (J4.GE.FBFLEN) THEN !OUTPUT BLOCK - IF (TP.EQ.16) THEN !MAKE IEEE FORMAT - CALL WNTTLT(FBFLEN,IFBUF,ITRB,5) - ELSE IF (TP.EQ.32) THEN - CALL WNTTLT(FBFLEN,JFBUF,JTRB,5) - ELSE - CALL WNTTLT(FBFLEN,EFBUF,ETRB,5) - END IF - IF (.NOT.WNFWR(FCATAP,FBFLEN,LFBUF,J2)) GOTO 52 !WRITE FITS BLOCK - J2=J2+FBFLEN !OUTPUT DISK POINTER - J4=0 !OUTPUT BUF POINTER - END IF - END DO - END DO - IF (FMAP .AND. J4.GT.0) THEN !OUTPUT LAST FOR SINGLE MAP - CALL WNGMVZ(FBFLEN-J4,LFBUF(J4)) !ZERO LAST BLOCK - IF (TP.EQ.16) THEN !MAKE IEEE FORMAT - CALL WNTTLT(FBFLEN,IFBUF,ITRB,5) - ELSE IF (TP.EQ.32) THEN - CALL WNTTLT(FBFLEN,JFBUF,JTRB,5) - ELSE - CALL WNTTLT(FBFLEN,EFBUF,ETRB,5) - END IF - IF (.NOT.WNFWR(FCATAP,FBFLEN,LFBUF,J2)) GOTO 52 !WRITE FITS BLOCK - J2=J2+FBFLEN !OUTPUT DISK POINTER - J4=0 !OUTPUT BUF POINTER - END IF - GOTO 50 !NEXT MAP -C -C READY -C - 810 CONTINUE - IF (J4.GT.0) THEN !OUTPUT LAST FOR CUBE - CALL WNGMVZ(FBFLEN-J4,LFBUF(J4)) !ZERO LAST BLOCK - IF (TP.EQ.16) THEN !MAKE IEEE FORMAT - CALL WNTTLT(FBFLEN,IFBUF,ITRB,5) - ELSE IF (TP.EQ.32) THEN - CALL WNTTLT(FBFLEN,JFBUF,JTRB,5) - ELSE - CALL WNTTLT(FBFLEN,EFBUF,ETRB,5) - END IF - IF (.NOT.WNFWR(FCATAP,FBFLEN,LFBUF,J2)) GOTO 52 !WRITE FITS BLOCK - J2=J2+FBFLEN !OUTPUT DISK POINTER - J4=0 !OUTPUT BUF POINTER - END IF - 800 CONTINUE - CALL WNFCL(FCATAP) !CLOSE OUTPUT - CALL WNFDMO(FCATAP) !DISMOUNT OUTPUT - CALL WNFCL(FCAOUT) !CLOSE INPUT -C - RETURN -C -C - END diff --git a/src/nmap/nmaxcv.for b/src/nmap/nmaxcv.for deleted file mode 100644 index 23681cc48c3294ece58e2a7d7b5676861462b97c..0000000000000000000000000000000000000000 --- a/src/nmap/nmaxcv.for +++ /dev/null @@ -1,160 +0,0 @@ -C+ NMAXCV.FOR -C WNB 910327 -C -C Revisions: -C CMV 940422 Use correct pointer to convert map-data -C HJV 940518 Better DCD test -C - SUBROUTINE NMAXCV -C -C Convert WMP file from VAX to local format -C -C Result: -C -C CALL NMAXCV will convert a WMP file from VAX to local format -C -C Include files: -C - INCLUDE 'WNG_DEF' - INCLUDE 'NMA_DEF' - INCLUDE 'GFH_O_DEF' !GENERAL FILE HEADER - INCLUDE 'GFH_T_DEF' - INCLUDE 'SGH_O_DEF' !SUB-GROUP HEADER - INCLUDE 'SGH_T_DEF' - INCLUDE 'MPH_O_DEF' !SET HEADER - INCLUDE 'MPH_T_DEF' -C -C Parameters: -C - INTEGER DBUFL !LENGTH DATA BUFFER - PARAMETER (DBUFL=1024) -C -C Arguments: -C -C -C Function references: -C - LOGICAL WNFRD !READ DATA - LOGICAL WNFWR !WRITE DATA -C -C Data declarations: -C - INTEGER CVT !CONVERSION TYPE - INTEGER*2 DBH_T(0:1,0:1) !DATA TRANSLATION - DATA DBH_T/4,0,0,1/ - BYTE GFH(0:GFHHDL-1) !GENERAL FILE HEADER - BYTE SGH(0:SGHHDL-1) !SUB-GROUP HEADER - INTEGER SGHJ(0:SGHHDL/4-1) - EQUIVALENCE (SGH,SGHJ) - BYTE MPH(0:MPHHDL-1) !SET HEADER - INTEGER*2 MPHI(0:MPHHDL/2-1) - INTEGER MPHJ(0:MPHHDL/4-1) - EQUIVALENCE (MPH,MPHI,MPHJ) - REAL DBUF(0:DBUFL-1) -C- -C -C INIT -C -C -C GENERAL FILE HEADER -C - IF (.NOT.WNFRD(FCAOUT,GFHHDL,GFH,0)) THEN !READ GENERAL FILE HEADER - 10 CONTINUE - CALL WNCTXT(F_TP,'!/I/O error on WMP file') - GOTO 900 !READY - END IF - IF (GFH(GFH_DATTP_B).EQ.0) GFH(GFH_DATTP_B)=1 !ASSUME VAX INPUT - IF (GFH(GFH_DATTP_B).EQ.PRGDAT) THEN - CALL WNCTXT(F_TP,'!/Data already converted') - GOTO 800 - END IF - CVT=GFH(GFH_DATTP_B) !INPUT TYPE - CALL WNTTTL(GFHHDL,GFH,GFH_T,CVT) !CONVERT - GFH(GFH_DATTP_B)=PRGDAT !SET CURRENT DATA TYPE - IF (.NOT.WNFWR(FCAOUT,GFHHDL,GFH,0)) GOTO 10 !REWRITE HEADER -C -C GROUP HEADERS -C - J=1 !LEVEL 1 - J1=GFH_LINKG_1 !CURRENT GROUP - J2=GFH_LINKG_1 !CURRENT LINK HEAD - 22 CONTINUE - IF (.NOT.WNFRD(FCAOUT,SGHHDL,SGH,J1)) GOTO 10 !READ CURRENT - 20 CONTINUE - IF (SGHJ(SGH_LINK_J).EQ.J2) THEN !END OF LIST - J=J-1 !DECREASE LEVEL - IF (J.EQ.0) GOTO 21 !READY - J1=SGHJ(SGH_HEADH_J)-SGH_LINKG_1+SGH_LINK_1 !LOWER HEADER ADDR. - IF (.NOT.WNFRD(FCAOUT,SGHHDL,SGH,J1)) GOTO 10 !READ IT - J2=SGHJ(SGH_HEADH_J) !NEW LINK HEAD - GOTO 20 !CONTINUE - END IF - J1=SGHJ(SGH_LINK_J) !NEXT ENTRY - IF (.NOT.WNFRD(FCAOUT,SGHHDL,SGH,J1)) GOTO 10 !READ IT - CALL WNTTTL(SGHHDL,SGH,SGH_T,CVT) !CONVERT IT - IF (.NOT.WNFWR(FCAOUT,SGHHDL,SGH,J1)) GOTO 10 !WRITE IT - IF (SGHJ(SGH_DATAP_J).EQ.0) THEN !MORE LEVELS - IF (SGHJ(SGH_LINKG_J).EQ.J1+SGH_LINKG_1) GOTO 20 !NO NEXT LEVEL - J=J+1 !NEXT LEVEL - IF (J.GT.8) GOTO 10 !TOO MANY LEVELS - J2=J1+SGH_LINKG_1 !NEW HEADER PTR - J1=J2 !NEXT CURRENT - GOTO 22 !CONTINUE - END IF - GOTO 20 !MORE - 21 CONTINUE -C -C DO SETS -C - IF (.NOT.WNFRD(FCAOUT,8,MPH,GFH_LINK_1)) GOTO 10 !READ SET HEADER START -30 CONTINUE - J=MPHJ(MPH_LINK_J) !NEXT IN LIST - IF (J.EQ.GFH_LINK_1) GOTO 800 !ALL DONE - IF (.NOT.WNFRD(FCAOUT,MPHHDL,MPH,J)) GOTO 10 !READ SET HEADER - CALL WNTTTL(MPHHDL,MPH,MPH_T,CVT) !CONVERT IT - IF (.NOT.WNFWR(FCAOUT,MPHHDL,MPH,J)) GOTO 10 !WRITE SET HEADER -C -C MAPS -C - IF (MPHI(MPH_DCD_I).EQ.2) THEN - DBH_T(0,0)=2 !I - ELSE IF (MPHI(MPH_DCD_I).EQ.4) THEN - DBH_T(0,0)=3 !J - ELSE IF (MPHI(MPH_DCD_I).EQ.5) THEN - DBH_T(0,0)=4 !E - ELSE IF (MPHI(MPH_DCD_I).EQ.8) THEN - DBH_T(0,0)=5 !D - ELSE - DBH_T(0,0)=4 !ASSUME E - END IF -C*** J=J+MPHHDL !POINTER TO DATA - J=MPHJ(MPH_MDP_J) !POINTER TO DATA - I2=MPHJ(MPH_NRA_J)*MPHJ(MPH_NDEC_J) !MAP LENGTH - DO WHILE (I2.GT.0) !DO PER LINE - I3=MIN(I2,DBUFL) !DO THIS TIME - I1=LB_E*I3 !IN BYTES - DBH_T(1,0)=I1 !TRANSLATION LENGTH - IF (.NOT.WNFRD(FCAOUT,I1,DBUF,J)) GOTO 10 !READ DATA - CALL WNTTTL(I1,DBUF,DBH_T,CVT) !CONVERT - IF (.NOT.WNFWR(FCAOUT,I1,DBUF,J)) GOTO 10 !WRITE DATA - J=J+I1 !UPDATE POINTER - I2=I2-I3 !UPDATE COUNT - END DO !NEXT LINE - GOTO 30 !NEXT SET -C -C READY -C - 800 CONTINUE - CALL WNFCL(FCAOUT) !CLOSE FILE -C - RETURN -C -C ERROR -C - 900 CONTINUE - CALL WNFCL(FCAOUT) !CLOSE FILE -C - RETURN !READY -C -C - END diff --git a/src/nmap/nmaxmh.for b/src/nmap/nmaxmh.for deleted file mode 100644 index 494504d3ee4ccc1fcb8f735b15c2691ddfcdf5d8..0000000000000000000000000000000000000000 --- a/src/nmap/nmaxmh.for +++ /dev/null @@ -1,221 +0,0 @@ -C+ NMAXMH.FOR -C WNB 910402 -C -C Revisions: -C WNB 931214 Allow for P: -C - SUBROUTINE NMAXMH(PTYPE,INFCA,MPHP,SNAM) -C -C Show map header -C -C Result: -C -C CALL NMAXMH ( PTYPE_J:I, INFCA_J:I, MPHP_J:I, SNAM_J(*):I) -C Show on output PTYPE the map at MPHP -C of file INFCA. -C CALL NMAEMH ( PTYPE_J:I, INFCA_J:I, MPHP_J:I, SNAM_J(*):I) -C Edit map header -C -C Include files: -C - INCLUDE 'WNG_DEF' - INCLUDE 'MPH_O_DEF' !MAP HEADER - INCLUDE 'GFH_O_DEF' - INCLUDE 'SGH_O_DEF' - INCLUDE 'MPH_E_DEF' !EDIT INFORMATION - INCLUDE 'GFH_E_DEF' - INCLUDE 'SGH_E_DEF' -C -C Parameters: -C - INTEGER MXDEP !MAX. NESTING DEPTH - PARAMETER (MXDEP=8) - INTEGER D_GEDL !GENERAL DATA - PARAMETER (D_GEDL=1) -C -C Arguments: -C - INTEGER PTYPE !PRINT TYPE (f_p, f_t ETC) - INTEGER INFCA !FILE DESCRIPTOR - INTEGER MPHP !MAP HEADER POINTER - INTEGER SNAM(*) !SET NAME -C -C Function references: -C - LOGICAL WNFRD !READ DATA - LOGICAL WNFWR !WRITE DATA - INTEGER WNGGJ !GET J - CHARACTER*32 WNTTSG !SHOW SET NUMBER -C -C Data declarations: -C - CHARACTER*8 PLIST(11) !KNOWN P: AREAS - DATA PLIST/ 'MPH','GFH','SGH', - 1 'B','I','J','E','D','X','Y', - 1 ' '/ - INTEGER PLEN(0:1,11) !P: LENGTH - DATA PLEN/ -1,MPHHDL, - 1 -1,GFHHDL, - 1 -1,SGHHDL, - 1 -1,LB_B,-1,LB_I,-1,LB_J,-1,LB_E, - 1 -1,LB_D,-1,LB_X,-1,LB_Y, - 1 0,0/ - INTEGER DEP !CURRENT DEPTH - INTEGER DEPAR(4,MXDEP) !SAVE DEPTH - INTEGER CHP,CHDL !CURRENT HEADER LENGTH, PTR - INTEGER CTYP,CEDP !CURRENT HEADER TYPE #, PTR INTO EDIT - INTEGER CHPT !NEXT HEADER POINTER - INTEGER PSZ(0:1) !P: OFFSET AND SIZE - BYTE MPH(0:MPHHDL-1) !MAP HEADER - BYTE GFH(0:GFHHDL-1) - BYTE SGH(0:SGHHDL-1) - EQUIVALENCE (MPH,GFH,SGH) - CHARACTER*8 D_G_EC(4,7) !DATA TABLES - DATA D_G_EC/ 'B','SB',' ',' ', - 1 'I','SI',' ',' ', - 1 'J','SJ',' ',' ', - 1 'E','E12.6',' ',' ', - 1 'D','D12.8',' ',' ', - 1 'X','26$EC12.6',' ',' ', - 1 'Y','26$DC12.8',' ',' '/ - INTEGER D_G_EJ(4,7) - DATA D_G_EJ/ 0,1,0,LB_B, - 1 0,1,0,LB_I, - 1 0,1,0,LB_J, - 1 0,1,0,LB_E, - 1 0,1,0,LB_D, - 1 0,1,0,LB_X, - 1 0,1,0,LB_Y/ -C- -C -C GET HEADER -C - IF (.NOT.WNFRD(INFCA,MPHHDL,MPH,MPHP)) THEN - CALL WNCTXT(PTYPE,'Read error on input node') - RETURN - END IF -C -C SHOW HEADER -C - CALL WNCTXT(PTYPE,'!/Map header description !AS\:!/', - 1 WNTTSG(SNAM,0)) - CALL NSCXXS(PTYPE,MPH,MPHEDL,MPH_EC,MPH_EJ) !ACTUAL SHOW -C - RETURN -C -C NSCESH -C - ENTRY NMAEMH(PTYPE,INFCA,MPHP,SNAM) -C -C INIT -C - DEP=0 !CURRENT DEPTH - CHP=MPHP !HEADER POINTER - CTYP=1 !CURRENT TYPE (MPH) - CEDP=-1 !CURRENT POINTER IN EDIT LIST - CHDL=MPHHDL !CURRENT LENGTH -C -C ACTION -C - 10 CONTINUE - DO WHILE (CTYP.GT.0) !SOMETHING TO DO - IF (CHDL.LE.0) THEN !GET NEW HEADER - IF (PLEN(0,CTYP).GE.0 .AND. CEDP.GT.0) THEN - CHDL=WNGGJ(MPH(PLEN(0,CTYP))) !LENGTH FROM FILE - ELSE - CHDL=PLEN(1,CTYP) !DEFAULT LENGTH - END IF - CHDL=MIN(CHDL,PLEN(1,CTYP)) !MAKE SURE NO PROBLEMS - IF (CHDL.LE.0) GOTO 20 !NOT PRESENT; RESTART CURRENT - END IF -C -C GET HEADER -C - IF (CHP.EQ.0 .AND. - 1 (CTYP.LT.2 .OR. - 1 (CTYP.GT.3 .AND. CTYP.LT.4) .OR. - 1 (CTYP.GT.10))) GOTO 20 !NOT PRESENT - IF (CHP.GT.0 .AND. CHP.LT.GFHHDL .AND. - 1 (CTYP.LT.4 .OR. CTYP.GT.10)) THEN !MUST BE GFH - CTYP=2 - CHDL=PLEN(1,CTYP) - CHP=0 - CEDP=-1 - END IF - CALL WNGMVZ(PLEN(1,CTYP),MPH) !CLEAR BEFORE READ - IF (.NOT.WNFRD(INFCA,CHDL,MPH,CHP)) THEN - CALL WNCTXT(PTYPE,'Read error on input node') - RETURN - END IF -C -C EDIT HEADER -C - CALL WNCTXT(PTYPE,'*** Editing !AS ***',PLIST(CTYP)) - IF (DEP.GE.MXDEP) THEN !SHIFT ONE - DO I=1,MXDEP-1 - DO I1=1,4 - DEPAR(I1,I)=DEPAR(I1,I+1) - END DO - END DO - DEP=MXDEP-1 - END IF - DEP=DEP+1 !SAVE PREVIOUS - DEPAR(1,DEP)=CHP - DEPAR(2,DEP)=CTYP - DEPAR(3,DEP)=CEDP - DEPAR(4,DEP)=CHDL - IF (CTYP.EQ.1) THEN - CALL NSCXES(PTYPE,MPH,MPHEDL,MPH_EC,MPH_EJ,PLIST, - 1 CTYP,CEDP,CHPT,PSZ) - ELSE IF (CTYP.EQ.2) THEN - CALL NSCXES(PTYPE,MPH,GFHEDL,GFH_EC,GFH_EJ,PLIST, - 1 CTYP,CEDP,CHPT,PSZ) - ELSE IF (CTYP.EQ.3) THEN - CALL NSCXES(PTYPE,MPH,SGHEDL,SGH_EC,SGH_EJ,PLIST, - 1 CTYP,CEDP,CHPT,PSZ) - ELSE IF (CTYP.GE.4 .AND. CTYP.LE.10) THEN - CALL NSCXES(PTYPE,MPH,D_GEDL, - 1 D_G_EC(1,CTYP-3),D_G_EJ(1,CTYP-3),PLIST, - 1 CTYP,CEDP,CHPT,PSZ) - END IF - IF (CTYP.GE.1000) THEN !RELATIVE ADDRESS - CTYP=MOD(CTYP,1000) !GET CORRECT TYPE - CHPT=CHP+CHPT !CATER FOR OFFSET GIVEN - END IF - IF (CTYP.GE.4 .AND. CTYP.LE.10) THEN - CHPT=CHPT+PSZ(0)*D_G_EJ(4,CTYP-3) !CATER FOR GIVEN OFFSET - D_G_EJ(2,CTYP-3)=MAX(1,MIN(PSZ(1),MPHHDL/LB_Y)) !MAX. NUMBER TO DO - END IF -C -C REWRITE HEADER -C - IF (.NOT.WNFWR(INFCA,CHDL,MPH,CHP)) THEN - 30 CONTINUE - CALL WNCTXT(PTYPE,'Write error on input node') - RETURN - END IF - CHP=CHPT !NEXT HEADER POINTER - IF (CTYP.GE.4 .AND. CTYP.LE.10) THEN - CHDL=D_G_EJ(2,CTYP-3)*D_G_EJ(4,CTYP-3) !NEW LENGTH - ELSE - CHDL=0 !NEXT HEADER LENGTH - END IF - END DO -C -C RETURN PREVIOUS LEVEL -C - DEP=DEP-1 - 20 CONTINUE - IF (DEP.GT.0) THEN !CAN DO MORE - CHP=DEPAR(1,DEP) - CTYP=DEPAR(2,DEP) - CEDP=DEPAR(3,DEP) - CHDL=DEPAR(4,DEP) - DEP=DEP-1 - GOTO 10 - END IF -C - RETURN -C -C - END diff --git a/src/nmap/smp.dsc b/src/nmap/smp.dsc deleted file mode 100644 index 4a263e40f4718dac796063cf7a55eb46dd601343..0000000000000000000000000000000000000000 --- a/src/nmap/smp.dsc +++ /dev/null @@ -1,108 +0,0 @@ -!+ SMP.DSC -! WNB 930929 -! -! Revisions: -! -%REVISION=WNB=930929="Original version" -! -! Define R-series map header -! -%COMMENT="SMP.DSC defines the R-series map header block" -%COMMENT=" " -! -%VERSION=1 !VERSION -%SYSTEM=1 -%USER=WNB -%%DATE -%%NAME -! -%LOCAL=QSMPL=512 !REQUIRED LENGTH -%LOCAL=QFNM=64 !OFFSET TO FILE NAME REQUIRED -!- -.PARAMETER -.BEGIN=SMP - ID C4 !IDENTIFICATION (E.G. '.SMP') - LEN I !LENGTH HEADER - CRD C11 !CREATION DATE (DD-MMM-YYYY) - CRT C5 !CREATION TIME (HH:MM) - RVD C11 !REVISION DATE (DD-MMM-YYYY) - RVT C5 !REVISION TIME (HH:MM) - RVN I !REVISION COUNT - VER I !VERSION - - -(0:1) !RESERVED - MLH J !LINK TO MAP - .OFF=QFNM !RESERVED - FNM C12 !FIELD NAME - EPO E !EPOCH (E.G. 1950.0) - RA D !RIGHT ASCENSION (CIRCLES) - DEC D !DECLINATION (CIRCLES) - FRQ D !FREQUENCY (MHZ) - BDW D !BANDWIDTH (MHZ) - RAO D !OBSERVED RIGHT ASCENSION (CIR) - DCO D !OBSERVED DECL. (CIRCLES) - FRO D !OBSERVED FREQ. (CIRCLES) - ODY I !OBSERVED DAY SINCE JAN 0 - OYR I !OBSERVED YEAR OR 0 (E.G. 1985) - DCD I !DATA CODE: 2=I2 - ! 4=I4 - ! 5=R4 - ! 8=R8 - PCD I !PROGRAM CODE: 0=RMAP - SRA D !SEPARATION IN RA (CIRCLES) - SDC D !SEPARATION DEC (CIRCLES) - SFR D !SEPARATION FREQ. (MHZ) - NRA I !# OF POINTS IN RA - NDC I !# OF POINTS IN DEC - NFR I !# OF POINTS IN FREQ. - ZRA I !CENTRE RA (1ST POINT=0) - ZDC I !CENTRE DEC (1ST LINE=0) - ZFR I !CENTRE FREQUENCY (1ST MAP=0) - MXR I !POSITION MAX. IN RA - MXD I !POSITION MAX. IN DEC - MXF I !POSITION MAX. IN FREQUENCY - MNR I !POS. MIN. RA - MND I !POS. MIN. DEC - MNF I !POS. MIN. FREQ. - MAX E !MAX. IN MAPS - MIN E !MIN. IN MAPS - SHR D !SHIFT IN RA (ADD, CIRCLES) - SHD D !SHIFT IN DEC (ADD, CIRCLES) - SHF D !SHIFT IN FREQ. (ADD, MHZ) - SUM D !NORMALISING SUM (?ALL MAPS?) - UNI E !MULTIPLIER TO GET JY - UCM C24 !USER COMMENT - NPT J !# OF INPUT DATA POINTS - NBS I !# OF INPUT BASELINES - NST I !# OF INPUT SETS (=MEASUREM.) - TYP C4 !MAP TYPE (MAP, AP, COV ETC) - POL C2 !POL. TYPE (OR SO) - CD I(0:7) !0: TAPER TYPE - !1: CONVOLUTION TYPE - !2: CORRECT FOR CONVOLUTION - !3: CLIPPING DONE - !4: SOURCE SUBTRACTION - !5: DATA TYPE - !6: UV COORDINATE TYPE - EPT I !MAP EPOCH USED: - !0: APPARENT - !1: AS SPECIFIED IN EPOCH - OEP E !OBSERVATION EPOCH (EG 1985.78) - NOS E !MAP NOISE - FRA E !FIELD SIZE RA (CIRCLES) - FDC E !FIELD SIZE DEC (CIRCLES) - FFR E !FIELD SIZE FREQ (MHZ) - TEL C8 !NAME OF TELESCOPE - FSR I !FFT SIZE VERSION 3 RA - FSD I !FFT SIZE VERSION 3 DEC - - -(0:3) -! NEXT 5 SPECIAL OH INFO FOR GRONINGEN - GBD E !BAND - GVL E !VLCTY - GFR I !FREQC - GNF I !NRFREQ - GVC I !VELC - - -(0:1) !FILL - CFR D !AVERAGE CORRECTED FREQUENCY - .OFF=QSMPL -.END -!- diff --git a/src/nmap/wmpnode.pef b/src/nmap/wmpnode.pef deleted file mode 100644 index d4a08a670b811cf435b894204149a87e90ba2a16..0000000000000000000000000000000000000000 --- a/src/nmap/wmpnode.pef +++ /dev/null @@ -1,57 +0,0 @@ -!+WMPNODE.PEF: WMP_NODE keywords -! JPH 941005 Split from NCOMM.PEF -! -! Revisions: -! JPH 941018 Typo -! JPH 941208 Prompt and help texts -! -! Revisions: -! -! Ref: -! -KEYWORD=WMP_NODE - DATA_TYP=C - IO=I - LENGTH=80 - SWITCHES=LOOP,NULL_VALUES,WILD_CARDS - SEARCH=L,P - PROMPT=".WMP file name" - HELP=" -Specify the file name (no extension). -. -You may enter '[<directory>/]**' to get a list of .WMP files in your current or -another directory; then enter '#<n>' to select the <n>th file from that list. -"! -!---------------------------------------------------------------------------- -! Ref: -! -KEYWORD=INPUT_WMP_NODE - DATA_TYP=C - IO=I - LENGTH=80 - SWITCHES=LOOP,NULL_VALUES,WILD_CARDS - SEARCH=L,P - PROMPT="Input .WMP file name" - HELP=" -Specify the file name (no extension). -. -You may enter '[<directory>/]**' to get a list of .WMP files in your current or -another directory; then enter '#<n>' to select the <n>th file from that list. -" -! -!-------------------------------------------------------------------------- -! Ref: -! -KEYWORD=OUTPUT_WMP_NODE - DATA_TYP=C - IO=I - LENGTH=80 - SWITCHES=LOOP,NULL_VALUES,WILD_CARDS - SEARCH=L,P - PROMPT="Output .WMP file name" - HELP=" -Specify the file name (no extension). -. -You may enter '[<directory>/]**' to get a list of .WMP files in your current or -another directory; then enter '#<n>' to select the <n>th file from that list. -" diff --git a/src/nmap/wmpsets.pef b/src/nmap/wmpsets.pef deleted file mode 100644 index 78510328bff6d7094ec5f169ab04833c8195e347..0000000000000000000000000000000000000000 --- a/src/nmap/wmpsets.pef +++ /dev/null @@ -1,309 +0,0 @@ -!+ WMPSETS.PEF: WMP-file Sets specification. -! JPH 940812 -! -! Revisions: -! WNB 930630 Add NGF sub-fields -! CMV 930712 Correct typo -! CMV 931210 Changed LOOPS to SCN/WMP/MDL/NGF_LOOPS -! CMV 931220 Add info about L and O answers to ???_LOOPS/SETS -! JPH 940812 Split from nsets.pef -! 3-character index names -! improve HELP texts -! JPH 940913 Improve LOOPS prompt and help -! JPH 940920 Remove () from prompts -! JPH 941005 Correct some damage from automatic line merging -! Correct some residuals from nsets.pef -! JPH 941018 Sectors --> Images -! JPH 941129 Add <grp...> to LOOPS prompt -! -! -! Ref: WNDSTA -! -KEYWORD=WMP_SETS - DATA_TYP=C - IO=I - LENGTH=32 - NVALUES=64 - SWITCHES=LOOP,NULL_VALUES,WILD_CARDS - SEARCH=L,P - PROMPT="Images to process: grp.fld.chn.pol.typ.seq |" - HELP=" - A NEWSTAR .WMP file contains maps and antenna patterns for one or more -objects. The basic unit of data is the two-dimensional IMAGE representing -either a MAP of a piece of sky or the synthesised ANTENNA PATTERN. Images are -addressed through an IMAGE INDEX which is a string of six integers separated by -dots: -. - grp.fld.chn.pol.typ.seq -. - A GROUP is basically an administrative unit, allowing the user to subdivide - his data, e.g. per object. -. - The FIELD and CHANNEL are the field and channel numbers of the observation(s) - in the .SCN file from which the image was made. These numbers are defined by - the way the observation was made and should be indentical for - all observations involved (which could, e.g., be several 12-hour mosaic - observations with different baseline sets.). -. - POL is a code indicating the polarisation. The code distinguishes the - four components of a full polarisation represntation: -. - 0,1,2,3 = XX.XY.YX.YY or - 0,1,2,3 = I,Q,U,V -. - but it is your responsibility to remember which of the two representations - applies. -. - TYP codes the type of image: 0 for a map, 1 for an antenna pattern. -. - The image SEQ uence number distinguishes images for which all five of - the preceding indices are identical. It is used in particular to distinguish - residual maps in a CLEAN sequence. It is your responsibility to know what - the different SEQ values represent. -. -Index values start at zero. (Remember that for the CHN index 0 is the continuum -channel.) -. -You may select SETS of images for processing through [ranges of] values for the -five indices, e.g. -. - 2.3-5:2.*.1-7.* -. -The WILDCARD value '*' means 'all'. Each index may also be specified as a -RANGE: <first>-<last>[<:increment>]. Indices omitted are assumed to be '*', -i.e. ....1.0 means *.*.*.*.1.0. For wildcards at the end the dots may also be -omitted, i.e. 1.0 means 1.0.*.*.*.* -. -The notation 3-5:2 stands for 'from 3 through 5 in steps of 2'. The step must -be positive; if it is omitted, it is taken to be 1 (as in '1-7' above). -. -Multiple image SETS may be specified, separated by comma's: <Set1>,<Set2>,... -The associated WMP_LOOPS keyword allows even more looping over index values. -. -IF YOU WANT TO BE REMINDED OF WHAT IMAGES ARE IN YOUR FILE: - Type O or L in response to this prompt to get an Overview or Layout - of your .WMP file. -. -IF YOU DO NOT YET FEEL COMFORTABLE WITH THESE CONCEPTS MORE HELP IS PROVIDED: - Type '@' or '>' to be prompted for each of the 6 indices separately, - with more specific explanation per index. -. -IF YOU GET BORED WITH 6-NUMBER INDICES: - Absolute Cut nrs '#<n>' can be used as an alternative." -! -! Get loop parameters -! Ref: WNDSTA (via WNDXLP) -! -KEYWORD=WMP_LOOPS - DATA_TYP=C - IO=I - LENGTH=32 - NVALUES=16 - SWITCHES=NULL_VALUES,WILD_CARDS - SEARCH=L,P - DEFAULT=""" /ASK" - PROMPT="Loop specifications: |- -nr of cycles, index increment (grp.fld.chn.pol.typ.seq) per cycle |" - HELP=" -Using the WMP_LOOPS parameter in combination with your WMP_SETS soecification, -you may specify repetitions of the operation you are currently defining, -systematically incrementing the Group, Channel, etc. indices for each new cycle. -. -This is done by specifying here pairs of values: -. - n1,incr1, n2,incr2, ... -. -In each pair, the first value (n) indicates the number of times the loop has to -execute; the second value (incr) indicates how the imaqge index is to be -changed at the start of the successive loops. -. -Example: - The specification WMP_SETS = grp.fld.1-2.* would select the combination -of all images of frequency channels 1 and 2 for the field grp.fld. If you wish -to process 32 sets of successive such pairs of frequency channels, you would -have to type in all the successive WMP_SETS specifications: -. - grp.fld.1-2, grp.fld.3-4, ....., grp.fld.63-64 -. -Instead, you may specify WMP_LOOPS=32,0.0.2 and the first index only for -WMP_SETS. This will cause the program to execute the present operation 32 times -in a loop, starting with your WMP_SETS specification and then incrementing its -indices by 0.0.2 for every iteration; this is equivalent to the above 32 -separate runs of the program. -. -n must be > 0, and the increment can be any index string with simple positive -or negative integers. An increment of 0 may be omitted, i.e. the increment -specifications 0.0.3.0 and ..3 are equivalent. -. -Loops may be nested (to a limiting depth of 8 levels). A following loop -specification is executed inside the preceding one(s). -. -Example of NESTED loops: - To run your program for 64 fields (fld index), for 10 odd channels (chn -index) per field, starting at channel 7 and combining all polarisations (pol -index) every time, specify: -. - WMP_LOOPS=64,.1, 10,..2 - WMP_SETS=grp.0.7.* (initial set of images) -. -The second loop is executed as an inner loop inside the first one, that is, for -each mosaic subfield the channels are processed in a contiguous sequence. -. -IF YOU WANT TO BE REMINDED OF WHAT IMAGES ARE IN YOUR FILE: - Type O or L in response to this prompt to get an Overview or Layout - of the file for which you need to specify the sets. " -! -! Ref: WNDSTA_X -! -KEYWORD=WMP_GROUPS - DATA_TYP=C - IO=I - LENGTH=32 - SWITCHES=LOOP,NULL_VALUES,WILD_CARDS - SEARCH=L,P - PROMPT="1st index: grp = groups" - HELP=" -Give the group index (range) GRP of an image-Set specification - (GRP.fld.chn.pol.typ.seq) -. -Possible answers ([]=optional): -. - 0 take first (or only) group - n1 take group nr n1 (n1=0,1,2,3,....) - n1-n2[:n3] loop over groups n1 through n2 [step n3] - * loop over all available groups (wildcard) - n1-[*][:n3] loop over all available groups, - starting with n1 [step n3] -. -Note: - The associated WMP_LOOPS keyword allows even more looping over index values." -! -! Ref: WNDSTA_X -! -KEYWORD=WMP_FIELDS - DATA_TYP=C - IO=I - LENGTH=32 - SWITCHES=LOOP,NULL_VALUES,WILD_CARDS - SEARCH=L,P - PROMPT="2nd index: field(s)" - HELP=" -Give the field index (range) FLD of an image-Set specification - (grp.FLD.chn.pol.typ.seq) -. -Possible answers ([]=optional): -. - 0 take first (or only) field - n1 take field nr n1 (n1=0,1,2,3,....) - n1-n2[:n3] loop over fields n1 through n2 [step n3] - * loop over all fields in the observation (wildcard) - n1-[*][:n3] loop over all fields in the observation, - starting with n1 [step n3] -. -Note: - The associated WMP_LOOPS keyword allows even more looping over index values." -! -! Ref: WNDSTA_X -! -KEYWORD=WMP_CHANNELS - DATA_TYP=C - IO=I - LENGTH=32 - SWITCHES=LOOP,NULL_VALUES,WILD_CARDS - SEARCH=L,P - PROMPT="3rd index: channel(s)" - HELP=" -Give the channel index-range CHN of an image-Set specification - (grp.fld.CHN.pol.typ.seq) -. -Remember that channel 0 is the 'continuum' channel. -. -Possible answers ([]=optional): -. - 0 take the continuum channel - n1 take channel nr n1 (n1=0,1,2,3,....) - n1-n2[:n3] loop over channels n1 through n2 [step n3] - * loop over all channels for the field (wildcard) - n1-[*] loop over all channels for the field, - starting with n1 [step n3] -. -Note: - The associated WMP_LOOPS keyword allows even more looping over index values." -! -! Ref: WNDSTA_X -! -KEYWORD=WMP_POLARS - DATA_TYP=C - IO=I - LENGTH=32 - SWITCHES=LOOP,NULL_VALUES,WILD_CARDS - SEARCH=L,P - PROMPT="4th index: polarisation(s)" - HELP=" -Give the polarisation index (range) POL of an image-Set specification - (grp.fld.chn.POL.typ.seq) -. - POL is a number indicating the polarisation. For interferometer data, -pol=0,1,2,3 represents XX,XY,YX,YY. For telescope data, pol=0,1 represents X,Y. -. - This index is useful for defining loops (WMP_LOOPS parameter). -Otherwise you may find the SELECT_XYX parameter more convenient. -. - If you prefer to use WMP_POLARS here, examples of reasonable answers -are: - * XX, XY, YX, YY - 0-3:3 XX, YY - 0 XX - 3 YY -. -Note: - The associated WMP_LOOPS keyword allows even more looping over index values." -! -! Ref: WNDSTA_X -! -KEYWORD=WMP_TYPES - DATA_TYP=C - IO=I - LENGTH=32 - SWITCHES=LOOP,NULL_VALUES,WILD_CARDS - SEARCH=L,P - PROMPT="5th index: typ = map (0) or antenna (1)" - HELP=" -Give the type index (range) TYP of an image-Set specification - (grp.fld.chn.pol.TYP.seq) -. -This index is most useful in loop specifications (parameter WMP_LOOPS). -. -Possible answers: -. - 0 maps only - 1 antenna patterns only - 0-1 or * both maps and antenna patterns" -! -! Ref: WNDSTA_X -! -KEYWORD=WMP_MAPS - DATA_TYP=C - IO=I - LENGTH=32 - SWITCHES=LOOP,NULL_VALUES,WILD_CARDS - SEARCH=L,P - PROMPT="6th index: image sequence number(s)" - HELP=" -Give the sequence-number index (range) SEQ of an image-Set specification - (grp.fld.chn.pol.typ.SEQ) -. -Possible answers ([]=optional): -. - 0 take the first image - n1 take image nr n1 (n1=0,1,2,3,....) - n1-n2[:n3] loop over images n1 through n2 [step n3] - * loop over all - (wildcard) - n1-[*][:n3] loop over all available ifrs|tels, - starting with n1 [step n3] -. -Note: - The associated WMP_LOOPS keyword allows even more looping over index values. -" -!- diff --git a/src/nplot/ngc.dsc b/src/nplot/ngc.dsc deleted file mode 100644 index 5e7f36cd864515ae09c75080c233b355750456e9..0000000000000000000000000000000000000000 --- a/src/nplot/ngc.dsc +++ /dev/null @@ -1,106 +0,0 @@ -!+ NGC.DSC -! WNB 920818 -! -! Revisions: -! -%REVISION=HjV=940428="Add IF_MODE" -%REVISION=WNB=930825="Chnage SPOL definition" -%REVISION=WNB=930824="Change STELS definition" -%REVISION=WNB=930803="Remove .INCLUDE" -%REVISION=WNB=930628="Alignment error" -%REVISION=WNB=920902="Add MXNCHN" -%REVISION=WNB=920818="Original version" -! -! Layout of overall include file (NGC.DEF) -! -%COMMENT="NGC.DEF is an INCLUDE file for the NGCALC program" -%COMMENT=" " -! -%VERSION=1 -%SYSTEM=1 -%USER=WNB -%%DATE -%%NAME -! -%LOCAL=XX_P=1 !Polarisation bits (check with CBITS.dsc) -%LOCAL=YY_P=8 -! -! Get number of telescopes -! -%INCLUDE=NSTAR_DSF -! -%LOCAL=MXNMON=14 !MAX. # OF MONGO COLUMNS -%LOCAL=MXNSET=64 !MAX. # OF SETS -%LOCAL=MXNCHN=1024 !MAX. # OF TRANSPOSE CHANNELS -%LOCAL=NGCSDL=16777216 !SKIP DO LOOP CODE -%LOCAL=STHIFR=NSTAR_TEL*(NSTAR_TEL+1)/2 !# OF INTERFEROMETERS -%LOCAL=MXNPAG=6 !MAX. # OF PAGES PER PLOT -%LOCAL=MXNPG2=3 !MXNPAG/2 -!- -.DEFINE - .PARAMETER - MXNPLT J /MXNSET/ !MAX. # OF PLOTS - MXNMON J /MXNMON/ !MAX. # OF MONGO COLUMNS - MXNSET J /MXNSET/ !MAX. # OF SETS - MXNCHN J /MXNCHN/ !MAX. # OF TRANSPOSE CHANNELS - NGCDLC E /"-1.E30"/ !PLOT DELETE CODE - NGCSDL J /NGCSDL/ !SKIP DO LOOP CODE - MXNPAG J /MXNPAG/ !MAX. OF SIMULTANEOUS PAGES - XFAC E /4./ !MM TO UNITS X DIRECTION - YFAC E /4./ !MM TO UNITS Y DIRECTION - TXTHGT E /9./ !HEIGHT TEXT - XWND E /1056./ !NORMAL RECTANGLE - YWND E /780./ - XWM1 E /XWND-1./ - YWM1 E /YWND-1./ - ASPECT E /"YWND/XWND"/ !ASPECT RATIO - STASP E /"0.1/ASPECT"/ !SMALL NDC MAP - .DATA -! -! Local variables: -! - .COMMON - OPTION C24 !PROGRAM OPTION - OPT=OPTION C3 - SOPT C24 !SUB OPTION - IF_MODE C8 !TPON, TPOFF, ... - PLDEV C8 !PLOT DEVICE - NODOUT C80 /" "/ !OUTPUT NODE - FILOUT C160 !OUTPUT FILE - FCAOUT J /0/ !FILE CONTROL BLOCK - NODIN C80 /" "/ !INPUT SCAN NODE - FILIN C160 !INPUT FILE - FCAIN J /0/ !FILE CONTROL - SETS J(0:7,0:MXNSET) !SETS PER PLOT - POLC C4 /"XY"/ !POL. CODE TO DO (not used more) - SPOL J /XX_P+YY_P/ !POL.BITS - STELS B(0:NSTAR_TEL-1) !SELECT TELESCOPES - - B(20-NSTAR_TEL) !KEEP PREVIOUS ALIGNMENT - TELNAM C(NSTAR_TEL) /0123456789ABCD/ !TEL. NAMES - RES1 -(2) !FILL OUT FOR ALIGNMENT - POLNAM C4(0:3) /"XX","XY","YX","YY"/ !POL. NAMES - CORAP J !CORR. TO APPLY - CORDAP J !CORR. TO DE-APPLY - SIFR B(0:NSTAR_TEL-1,0:NSTAR_TEL-1) !IFR SELECTION -! -! History -! - SGPH J(0:7) !SUB-GROUP POINTER - SGNR J(0:7) !SUB-GROUP NUMBER -! -! Loops -! - LPOFF J(0:7) !CURRENT SET OFFSETS -! -! Plot parameters -! - DQID J(MXNPAG) !PLOT AREA'S - DQID2 J(MXNPG2,MXNPG2) - NPAG J !# OF PAGES IN CURRENT PLOT - WINDOW E(2,2) /0.,0.,XWM1,YWM1/ !WC WINDOW - VIEW E(2,2) /0.,0.9,STASP,1./ !NDC VIEWPORT - DVWIN E(2,2) !DEVICE WINDOW - PG E(2,5) !TEXT CROSSES - TXTXY E(4) !TEXT STRING POSITIONS - POINXY E(2,2) !BEGIN/END POINTS -.END diff --git a/src/nplot/ngc.grp b/src/nplot/ngc.grp deleted file mode 100644 index 89bf184c27bc207220af40730723b6806b295dcb..0000000000000000000000000000000000000000 --- a/src/nplot/ngc.grp +++ /dev/null @@ -1,68 +0,0 @@ -!+ NGC.GRP -! WNB 920818 -! -! Revisions: -! WNB 920902 Add NGCTRP -! WNB 921211 Add PSC -! CMV 940805 Add NGCBAS -! CMV 940821 Add NGFSETS.PEF -! JPH 941206 PLOTTER_PEF -! -! General data calculation and plotting -! -! Group definition: -! -NGC.GRP -! -! PIN file -! -NGCALC.PSC -NGFSETS.PEF -PLOTTER.PEF -! -! Structure files -! -NGF.DSC ! Plot header block -! -! Fortran definition files: -! -NGC.DSC ! Program common parameters -! -! Programs: -! -NGCALC.FOR ! Main routine -NGCBAS.FOR !NGCBAS Transpose ifr/HA axes -NGCCAL.FOR !NGCCAL Calculate plots -NGCCOB.FOR !NGCCOB Combine plots -NGCCOP.FOR !NGCCOP Copy plots -NGCDAT.FOR !NGCDAT Get user data -NGCEXC.FOR !NGCEXC Execute program -NGCEXN.FOR ! Help for NGCEXP - !NGCEX1 Put/clean on r-p stack - !NGCEX2 Update string pointer - !NGCEX3 Save environment on rps - !NGCEX4 Put on code stack - !NGCEX5 Put on rps -NGCEXP.FOR !NGCEXP Analyse expression -NGCEXT.FOR !NGCEXT Extract data -NGCINI.FOR !NGCINI Init program -NGCMON.FOR !NGCMON Make MONGO file -NGCNVS.FOR !MGCNVS Make new version -NGCPBR.FOR !NGCPBR Brief plot description -NGCPFL.FOR !NGCPFL Print file layout -NGCPLT.FOR !NGCPLT Plot data -NGCPMH.FOR !NGCPMH Print plot header -NGCPRT.FOR !NGCPRT Show file data -NGCSPH.FOR !NGCSPH Show plot header brief -NGCSTG.FOR !NGCSTG Get next set specified - !NGCSTH Get next set, no version check - !NGCSTL Get next set with loop info -NGCTRP.FOR !NGCTRP Transpose frequency/HA axes -NGCXCV.FOR !NGCXCV Convert data from one machine to other -NGCXMH.FOR !NGCXMH Show map header in full detail - !NGCEMH Edit plot header -! -! Executables -! -NGCALC.EXE -!- diff --git a/src/nplot/ngcalc.for b/src/nplot/ngcalc.for deleted file mode 100644 index 549f59e1a9a36ea8a4bbd94ad1cce91f5900b941..0000000000000000000000000000000000000000 --- a/src/nplot/ngcalc.for +++ /dev/null @@ -1,78 +0,0 @@ -C+ NGCALC.FOR -C WNB 920818 -C -C Revisions: -C WNB 920902 Add TRANSpose -C CMV 940805 Add BASEline -C - SUBROUTINE NGCALC -C -C Main program for plotting NGC files -C -C Include files: -C - INCLUDE 'WNG_DEF' - INCLUDE 'NGC_DEF' -C -C Parameters: -C -C -C Arguments: -C -C -C Function references: -C - INTEGER NGCNOD !GET NGC NODE -C -C Data declarations: -C -C- -C -C PRELIMINARIES -C - CALL NGCINI !INIT PROGRAM -C -C DISTRIBUTE -C - 10 CONTINUE - CALL NGCDAT !GET DATA - IF (OPT.EQ.'QUI') THEN !EXIT - CALL WNFCL(FCAOUT) !CLOSE DATA - RETURN !EXIT - ELSE IF (OPT.EQ.'NOD') THEN !SWITCH NODE - CALL WNFCL(FCAOUT) !CLOSE CURRENT NODE - ELSE IF (OPT.EQ.'SHO') THEN !SHOW - CALL NGCPRT - ELSE IF (OPT.EQ.'BRI') THEN !SHOW BRIEF - CALL NGCPBR - ELSE IF (OPT.EQ.'DEL') THEN !DELETE - 12 CONTINUE - CALL WNCTXT(3,'!/Option not yet implemented!/') - ELSE IF (OPT.EQ.'COM') THEN !COMBINE - CALL NGCCOB - ELSE IF (OPT.EQ.'MER') THEN !MERGE - CALL NGCCOB - ELSE IF (OPT.EQ.'TRA') THEN !TRANSPOSE - CALL NGCTRP - ELSE IF (OPT.EQ.'BAS') THEN !BASELINE TRANSPOSE - CALL NGCBAS - ELSE IF (OPT.EQ.'CAL') THEN !CALCULATE - CALL NGCCAL - ELSE IF (OPT.EQ.'EXT') THEN !EXTRACT - CALL NGCEXT - ELSE IF (OPT.EQ.'COP') THEN !COPY - CALL NGCCOP - ELSE IF (OPT.EQ.'MON') THEN !MONGO - CALL NGCMON - ELSE IF (OPT.EQ.'PLO') THEN !PLOT - CALL NGCPLT - ELSE IF (OPT.EQ.'NVS') THEN - CALL NGCNVS !NEW VERSION - ELSE IF (OPT.EQ.'CVX') THEN - CALL NGCXCV !MACHINE FORMAT CONVERSION - END IF -C - GOTO 10 !CYCLE -C -C - END diff --git a/src/nplot/ngcalc.psc b/src/nplot/ngcalc.psc deleted file mode 100644 index a5b835815c26ef1437090b7556044bf17edc5eff..0000000000000000000000000000000000000000 --- a/src/nplot/ngcalc.psc +++ /dev/null @@ -1,631 +0,0 @@ -!+ NGCALC.PSC -! WNB 920819 -! -! Revisions: -! WNB 920902 Add transpose option -! WNB 921021 Add A3 plotter -! WNB 921104 Text Select ifrs, HA_range max/min; J2000 -! WNB 921211 Make PSC -! JEN 930308 INCLUDE=NSETS_PEF, remove keyord SETS,PLOTS -! JEN 930312 INCLUDE=NCOMM_PEF -! JEN 930312 Remove keyword(s) SCAN_NODE, CALC_NODE -! JEN 930312 Remove keyword(s) SELECT_IFRS, POLAR, HA_RANGE -! HjV 930426 Change name keywords PLOT_SET, OUT_NODE -! WNB 930628 Change PLOT_ACTION into SET_ACTION -! WNB 930630 Add SHIFT calculation; more functions -! WNB 930824 Remove TELESCOPES -! HjV 930914 Add keyword EDIT -! WNB 931216 New EDIT format; use NSHOW.PEF -! HjV 940428 Add IF options -! CMV 940805 Add BASEline option -! CMV 940811 Add MAX_BASE and POLY_USE -! JPH 940812 Private version of SELECT_XYX with specific HELP -! Individual selection of INCLUDEd keywords -! JPH 940823 Remove DELETE option. Add FULL option -! JPH 940913 Remove () from promts. Reactivate DELETE option -! JPH 940922 Correct text on comparisons in EXPRESSION help -! JPH 941005 NGF_NODE keywords absorbed from NCOMM_PEF, use only -! NGF_NODE and OUTPUT_NGF_NODE -! May text improvements -! Remove WILDCARDS where inappropriate -! CMV 941027 Remove option formatting -! HjV 941031 Add MDLNODE_PEF -! CMV 941122 Add HA_RANGE for SELECT -! HjV 950530 Changed SET_ACTION in SECTOR_ACTION, add EDIT -! HjV 950705 Use PLOTTER_PEF -! -! Get action -! Ref: NGCDAT -! -KEYWORD=ACTION - DATA_TYP=C - IO=I - LENGTH=24 - SWITCH=LOOP,NULL_VALUES - CHECKS=ABBREV_OPTIONS - SEARCH=L,P - PROMPT="type of action |" - OPTIONS=EXTRACT,COPY,CALC,MERGE,COMBINE,TRANS,BASE,MONGO,PLOT,- -SHOW,BRIEF,FULL,DELETE,NODE,CVX,NVS,QUIT - HELP=" -Specify the action to be performed: -. - Creating cuts from external data: - EXTRACT extract information from SCN file into cuts - COPY copy cuts to other NGF file, retaining their indices - (this action is mainly useful for discarding cuts no longer - needed and thereby freeing disk space) -. - Viewing the contents of the .NGF file: - SHOW show information in cut headers and data - BRIEF show summary per group/field showing numbers of polarisations, - interferometers, cuts and data points -. - Calculations: - CALC Perform one of a set of predefined algorithms on individual cuts - MERGE Merge a number of cuts into a single new cut. - NOTE: Overlapping points will be averaged so you may use MERGE - to average e.g. a set of interferometers with data points - at coincident hour angles. - COMBINE Combine cut(s) in user-specified expression -. - Sorting: - Starting from a cut in the HA direction, these actions produce a new cut -in the frequency or baseline direction for each hour angle present in any of -the input cuts. Use the HA_RANGE parameter to limit the number of output cuts. - The output cuts are in a primitive format in which the data are transposed -but NOT the coordinate axes. These wrong axes appear in plots of the transposed -cuts and must be interpreted as indicated below. In calculations, however, -coordinates will be interpreted correctly (provided you specify a sensible -calculation). -. - Transposing a transposed group of cuts reproduces the original cuts. You -may also try to combine TRANS and BASE operations but sensible results are not -guaranteed. -. - TRANS transpose frequency and HA axes. - In the transposed cuts, each channel is represented by an hour - angle of <channel number>*0.125 deg. - Each hour-angle bin of 0.125 deg is represented by a channel - number, which starts at 0 for the lowest hour angle present. -. - BASE transpose interferometer and hour-angle axes. - In the transposed cuts, each baseline bin of 10 metres is - represented by an HA bin of .125 deg at HA = <baseline>/10*.125 - deg; baselines landing in the same bin are averaged. - Each hour-angle bin of .125 deg is represented by a baseline - sequence number of HA*.125. -. - Plotting: - MONGO output cut data in a MONGO-readable file - PLOT plot data in NGF cut(s) -. - Miscellaneous: - DELETE delete cuts. (Only the index linkage is removed but the cut data - remain in the file: Use COPY to free the file space.) - BEWARE: This action is IRREVERSIBLE. - NODE switch to other NGF file - QUIT terminate NGCALC -. - Data-format conversions: - CVX convert NGF file from other machine's format to local format - NVS update to latest NGF-file format " -! -! Get input/output NGF node -! Ref: -! -KEYWORD=NGF_NODE - DATA_TYP=C - IO=I - LENGTH=80 - SWITCHES=LOOP,NULL_VALUES - SEARCH=L,P - PROMPT="Input[+output] 'node' name" - HELP=" -This is the file from which input cuts will be read. -. -Except in COPY operations, it is also the file to which new cuts will be -written. -. -Enter ** (or e.g. /user0/mydata/**) to get a list of files, then enter #<n> to -select the <n>-th file from such that list." -! -! Get output NGF node -! Ref: NGCCOP -! -KEYWORD=OUTPUT_NGF_NODE - DATA_TYP=C - IO=I - LENGTH=80 - SWITCHES=LOOP,NULL_VALUES,WILD_CARDS - SEARCH=L,P - PROMPT="Output 'node' name" - HELP=" -This is the file to which cuts will be copied. - -The source and output files MUST be different. -. -Enter ** (or e.g. /user0/mydata/**) to get a list of files, enter #nn to select -the nn-th file from such a list." -! -! Get extract action -! Ref: NGCEXT -! -KEYWORD=EXTRACT_TYPE - DATA_TYP=C - IO=I - LENGTH=24 - SWITCH=LOOP,NULL_VALUES - CHECKS=ABBREV_OPTIONS - SEARCH=L,P - OPTIONS=TCOR,ICOR,IFDATA,DATA,MODEL,WEIGHT,QUIT - DEFAULTS=QUIT - PROMPT="data type" - HELP=" -Specify the type of data to extract: -. - DATA Observed visibilities - WEIGHT Visibility weights - MODEL Model visibilities -. - TCOR Telescope gain/phase corrections - ICOR Interferometer gain/phase corrections - IFDATA 'IF' data: gain/system-temperature parameters from the WSRT - on-line system; you will be asked for details later. -. - QUIT quit EXTRACT action -" -! -! Get IF action -! Ref: NGCEXT -! -KEYWORD=IF_MODE - DATA_TYP=C - IO=I - LENGTH=8 - CHECKS=ABBREV_OPTIONS - SWITCHES=LOOP,NULL_VALUES - SEARCH=L,P - OPTIONS=TPON,TPOFF,TNOISI,TSYS,TSYSI,GAIN,GNCAL,TSYSI,TNOISI,RGAINI - PROMPT="type of IF data" - HELP=" -Specify type of 'IF' data to extract: -. - Quantities related to telescope noise sources: - TPON total-power data for noise source on - TPOFF total-power data for noise source off - TNOISI constant noise source temperature -. - Quanitities related to telescope system temperatiures: - TSYS system temperatures - TSYSI constant system temperature -. - Quantities related to interferometer gain correction: - GAIN IF gains - GNCAL gain correction method - RGAINI constant receiver gain -" -! -! Get calculation action -! Ref: NGCCAL -! -KEYWORD=CALC_TYPE - DATA_TYP=C - IO=I - LENGTH=24 - SWITCH=LOOP - CHECKS=ABBREV_OPTIONS - SEARCH=L,P - OPTIONS=AVER,SMOOTH,POLY,CPOLY,DPOLY,SHIFT,NULL,QUIT - DEFAULTS=QUIT - PROMPT="calculation type" - HELP=" -Specify the action to be performed on individual cut(s). -. - AVER average cut and report results -. - The following actions will create a new cut for each input cut with the same - index numbers except for a new SEQ number. -. - SMOOTH create new cut(s) by smoothing cut data with a triangular - function (whose halfwidth you will specify) -. - POLY fit N+1 coefficients of an Nth-order polynomial - P= c0 +c1*HA +c2*HA**2 +... +cN*HA**N - through cut data and create new cut(s) from the residuals -. - CPOLY as POLY, but fitting only N selected coefficients of an - Mth-order polynomial. M>N; the missing coefficients are held - at 0. (This method can be used, e.g., to fit a polynomial for - which you know a priori that it must be even.) -. - DPOLY subtract values of a polynomial (yet to be specified) from cut - data and create new cut(s) from the results -. - SHIFT create new cuts with visibility values transformed to a - different sky position -. - NULL create new cuts with data points in an HA range (yet to be - selected) deleted -. - QUIT leave CALC - -Note: All calculations are done with complex numbers. To use e.g. only - amplitude, convert it first with an expression= AMPL(#..) in - a COMBINE action. -" -! -! Get smoothing width -! Ref: NGCCAL -! -KEYWORD=HA_WIDTH - DATA_TYP=R - IO=I - SWITCH=LOOP - SEARCH=L,P - PROMPT="smoothing width" - UNITS=DEG - HELP=" -Specify smoothing halfwidth of triangular smoothing function in degrees of HA." -! -! Get polynomial degree -! Ref: NGCCAL -! -KEYWORD=POLY_N - DATA_TYP=J - IO=I - SWITCH=LOOP - SEARCH=L,P - CHECKS=MAXIMUM,MINIMUM - MAXIMUM=10 - MINIMUM=0 - PROMPT="number of coefficients to fit" - HELP=" -Specify number of coefficients of the polynomial to be fitted to the data. -. -For CALC=POLY, this is 1 + the polynomial's degree. -. -For CALC=DPOLY it is the number of non-zero coefficients. You will be prompted -later for there orders." -! -! Get degrees of polynomial to fit -! Ref: NGCCAL -! -KEYWORD=POLY_USE - DATA_TYP=J - NVALUES=11 - IO=I - SWITCH=LOOP,NULL_VALUE - SEARCH=L,P - PROMPT="orders of coefficients to fit" - HELP=" -Specify the orders of the polynomial coefficients to fit to. Default is -0,...,<N>, where <N> is the number you gave for POLY_N. -. -Example: - To fit a 6th-degree even polynomial, specify POLY_N=3 and POLY_USE=0,2,4,6." -! -! Get polynomial coefficients -! Ref: NGCCAL -! -KEYWORD=POLY_COEF - DATA_TYP=R - NVALUES=11 - IO=I - SWITCH=LOOP,NULL_VALUE - SEARCH=L,P - PROMPT="polynomial coefficients" - HELP=" -Specify the coefficients of the polynomial to be subtracted: -. - P= c0 +c1*HA +c2*(HA**2) +... +cN*(HA**N) -" -! -! Get l,m shifts -! Ref: NGCCAL -! -KEYWORD=SHIFT - DATA_TYP=R - IO=I - NVALUES=2 - SWITCHES=LOOP,VECTOR - SEARCH=L,P - PROMPT="l,m shifts to apply to data (arcsec)" - HELP=" -Specify the l,m shifts in arcsec to be applied to data" -! -! Get plot device, plot-format -! Ref: NGCPLT -!- -INCLUDE=PLOTTER_PEF -!- -! -! Get HA scale -! Ref: NGCPLT -! -KEYWORD=HA_SCALE - DATA_TYP=R - IO=I - SWITCH=LOOP - CHECKS=MINIMUM - MINIMUM=0. - SEARCH=L,P - DEFAULT=15. - PROMPT="hour-angle plot scale degree/cm" -! -! Get Baseline range -! Ref: NGCPLT -! -KEYWORD=BAS_RANGE - DATA_TYP=R - NVALUES=2 - SWITCHES=VECTOR,NULL_VALUES,WILD_CARDS - CHECKS=MAXIMUM,MINIMUM,NON_DESCENDING - MINIMUM=0,3000 - MAXIMUM=0,3000 - UNITS=M,KM - IO=I - SEARCH=L,P - DEFAULT=0,3000 - PROMPT="Baseline range (metres)" - HELP=" -Enter the the lower and upper ends of baseline range to plot." -! -! Get Baseline scale -! Ref: NGCPLT -! -KEYWORD=BAS_SCALE - DATA_TYP=R - IO=I - SWITCH=LOOP - CHECKS=MINIMUM - MINIMUM=0. - SEARCH=L,P - DEFAULT=150. - PROMPT="Baseline plot scale (metres/cm)" -! -! Get plot scale -! Ref: NGCPLT -! -KEYWORD=SCALE - DATA_TYP=R - IO=I - SWITCH=LOOP - CHECKS=MINIMUM - MINIMUM=0. - SEARCH=L,P - DEFAULTS=10. - PROMPT="plot scale (data units/mm)" - HELP=" -Specify the scale in units/mm." -! -! Get plot offset -! Ref: NGCPLT -! -KEYWORD=OFFSET - DATA_TYP=R - IO=I - SWITCH=LOOP - SEARCH=L,P - DEFAULTS=0. - PROMPT="plot offset (data units)" - HELP=" -Example: - If you enter 100, <data values>-100 will be plotted. -" -! -! Get input plot -! Ref: NGCCOB -! -KEYWORD=USE_NGF_SET - DATA_TYP=C - IO=I - LENGTH=32 - NVALUES=1 - SWITCHES=LOOP,NULL_VALUES,WILD_CARDS - SEARCH=L,P - PROMPT="Cut to use" - HELP=" -Define the cut represented by each of the variables of the form -#<n> and ##<n> in your expression. You are being prompted for each such -variable that is present in the expression. Your reply must designate ONE cut." -! -! Get expression -! Ref: NGCCOM -! -KEYWORD=EXPRESSION - DATA_TYP=C - IO=I - LENGTH=80 - SWITCH=LOOP,NULL_VALUE,WILD_CARD - SEARCH=L,P - PROMPT="expression" - HELP=" -Specify the expression defining the new output cut. It is safest to enclose the -expression in double quotes. -. -Each data point in the output cut will be set to the value of your expression, -using the values of the corresponding data point in each of the input cuts in -the expression. Elements of an expression can be: -. - References to input cuts of the form #<number> or ##<number> (see NOTE - below). You will be prompted later to identify one cut to be associated - with each of the numbers you use in the expression. For each output - point, a reference refers to the input point at the same hour angle. -. - Real constants, e.g. 5, -1.23E-12 -. - Symbolic constants - PI [=3.14..], EE [=2.71..], CC [=light velocity in km/s], - DRAD [=180/PI] -. - Standard functions of real or complex argument (angles always in - degrees): - SIN(x), COS(x), ASIN(x), ACOS(x), ATAN(x), ATAN(real,imag) - EXP(x), EXP10(x), EXP2(x), LOG(x), LOG10(x), LOG2(x) - ABS(X), SQRT(X( - REAL(x), IMAG(x), AMPL(x), PHASE(x), IMUL(x) (mmultiply x by i) -. - Standard functions of a real argument that will be performed separately - on the real and imaginary components of a complex argument - FLOOR(x), CEIL(x), ROUND(x), INT(x), FRACT(x) -. - Cut-data-point coordinates: - RA [right-ascension], DEC [declination], HA [hour-angle], - UT [univ.time], FQ [freq. in MHz], BL [baseline in m], - UU [U in lambda], VV [V in lambda] -. - Operators, in order of decreasing priority (results of logical and - relation expressions are 0. (False) or 1. (True)): -. - unary +,- - **,^ (power) - *, /, +, - - >=,<=,=,<,>,<> (comparisons: if either value to be compared is - complex, absolute values are used in the comparison) - <> (not) & (and) ! (or) -. -Example: - #1*(REAL(#1)<0)+#2*(REAL(#2)>0): for each hour angle, take the data - value from cut #1 if it is <0 and the data value from cut #2 if - it is >0, and add them to get the data point at the same hour - angle in the output cut -. -NOTE: - You may loop over sectors in the standard way. Each of the input -sectors in the expression will be incremented at the start of a new loop cycle. -You may, however, inhibit this incrementing by using a double '#', e.g. ##2." -! -! Get data action -! Ref: NGCPRT -! -KEYWORD=SECTOR_ACTION - DATA_TYP=C - IO=I - LENGTH=24 - CHECKS=ABBREV_OPTIONS - SWITCHES=NULL_VALUES,WILD_CARDS - SEARCH=L,P - PROMPT="Sector-header action |" - OPTIONS=SHOW,EDIT; NEXT,CONT,QUIT - HELP=" Specify interaction with this sector header: -. - Show details of the sector header: - SHOW show entire sector header - EDIT edit fields (values) in the Sector header by name -. - Navigation: - NEXT: proceed to the header for the next sector selected - CONT: descend into the scans of this sector - QUIT: return to the file-header level" -! -! Get data action -! Ref: NGCPRT -! -KEYWORD=DATA_ACTION - DATA_TYP=C - IO=I - LENGTH=24 - CHECKS=ABBREV_OPTIONS - SWITCHES=LOOP - SEARCH=L,P - PROMPT="data representation" - OPTIONS=SHOW,AMPLITUDE,PHASE,QUIT - HELP=" -Specify action to perform: -. - SHOW show detailed cut data -. - AMPL show amplitude of cut data - PHASE show phase of cut data -. - QUIT quit data part" -! -! Get cut type -! Ref: NGCMON -! -KEYWORD=PLOT_TYPE - DATA_TYP=C - IO=I - LENGTH=24 - CHECKS=ABBREV_OPTIONS - SWITCHES=LOOP - SEARCH=L,P - OPTIONS=COS,SIN,AMPLITUDE,PHASE - PROMPT="cut-data component" - HELP=" -Specify the data component for the output cut: -. - COS real part - SIN imaginary part - AMPL ABS(data) - PHASE ARG(data)" -! -! Get MONGO file name -! Ref: NGCMON -! -KEYWORD=MONGO_FILE - DATA_TYP=C - IO=I - LENGTH=80 - SWITCH=LOOP - SEARCH=L,P - PROMPT="Mongo file name" - HELP=" -Specify the name of the file to be used in Mongo plotting." -! -! Get max baseline to use -! Ref: NGCBAS -! -KEYWORD=MAX_BASE - DATA_TYP=R - IO=I - SWITCH=LOOP,NULL_VALUE - SEARCH=L,P - PROMPT="max. baseline to include (metres)" - UNITS=M - HELP=" -Specify maximum baseline to include in output cut." -! -!- -INCLUDE=NGEN_PEF -!- -INCLUDE=NGFSETS_PEF -! -INCLUDE=SCNNODE_PEF:SCN_NODE ! -INCLUDE=SCNSETS_PEF ! -INCLUDE=SELECT_PEF:SELECT_TELS,SELECT_IFRS,HA_RANGE -!- -INCLUDE=MDLNODE_PEF -!- -INCLUDE=NMODEL_PEF -!- -INCLUDE=NSHOW_PEF:FILE_ACTION,EDIT -! -! Polarisation selection - modified from SELECT_PEF -!! TO BE REPLACED WITH WNDPOH -! -KEYWORD=SELECT_XYX - DATA_TYP=C - LENGTH=4 - IO=I - CHECKS=ABBREV_OPTIONS - SWITCHES=LOOP,WILD_CARDS - OPTIONS=XYX,XY,Y,X,YX,YYX,XXY - SEARCH=L,P - PROMPT="polarisation(s)" - HELP=" -Select the polarisation(s) to be used. Your answer will be interpreted -according to the data type you will select hereafter -. - Interferometer Telescope - ============== ========= - XYX XX, YX, YX and YY X and Y - XY XX and YY X and Y - X XX only X only - Y YY only Y only - YX XY and YX none - YYX YX none - XXY XY none -" -! diff --git a/src/nplot/ngcbas.for b/src/nplot/ngcbas.for deleted file mode 100644 index 70bc69d3def76184129bcc3e427c9f33661f3ac7..0000000000000000000000000000000000000000 --- a/src/nplot/ngcbas.for +++ /dev/null @@ -1,325 +0,0 @@ -C+ NGCBAS.FOR -C CMV 940805 -C -C Revisions: -C CMV 940805 Created -C CMV 940811 Report range, minimum baseline set to zero -C HjV 941031 Typo -C - SUBROUTINE NGCBAS -C -C Make plots with baseline along axis -C -C Result: -C -C CALL NGCBAS Make plots with baseline along axis -C -C -C Pin references: -C -C NGF_SETS Plots to use -C MAX_BASE Maximum baseline to include -C -C Include files: -C - INCLUDE 'WNG_DEF' - INCLUDE 'GFH_O_DEF' !GENERAL FILE HEADER - INCLUDE 'SGH_O_DEF' !SUB-GROUP HEADER - INCLUDE 'NGF_O_DEF' !PLOT HEADER - INCLUDE 'NGC_DEF' -C -C Parameters: -C -C -C Arguments: -C -C -C Function references: -C - LOGICAL WNDPAR !GET USER DATA - LOGICAL WNDLNG,WNDLNK,WNDLNF !LINK SETS - LOGICAL WNDSTA !GET SETS - LOGICAL WNDXLP !GET LOOPS - LOGICAL WNDXLN !NEXT LOOP - LOGICAL WNFRD !READ DISK - LOGICAL WNFWR !WRITE DISK - INTEGER WNFEOF !EOF POINTER - LOGICAL WNGGVA !GET MEMORY - CHARACTER*32 WNTTSG !SET NAME - LOGICAL NGCSTG,NGCSTL !GET PLOT - LOGICAL NSCHAS !GET HA RANGE -C -C Data declarations: -C - INTEGER NPLOT !# OF PLOTS TO USE - INTEGER PLOTS(MXNCHN,2) !PLOTS TO USE - INTEGER SNAM(0:7,MXNCHN) !PLOT NAME - REAL HASRA(0:1) !HA RANGE - INTEGER NGFHP !HEADER POINTER - CHARACTER*(NGF_TYP_N) HSTR,HSTR1 - INTEGER NPTS !LENGTH SINGLE PLOT - REAL HA,HAE !START,END HA OUTPUT PLOT - REAL HAINC !HA INCREMENT OUTPUT PLOT - REAL CHA !HA CURRENT POINT - REAL CUT !UT CURRENT POINT - REAL BLRANGE(0:1) !BASELINE RANGE - REAL BLSTEP !SMALLEST STEP IN BASELINES - REAL BLMAX !MAX BASELINE FROM USER - INTEGER NOUT !NUMBER OF POINTS IN OUTPUT PLOT - INTEGER TRTYP !CURRENT TRANSPOSE TYPE - INTEGER BUFL,BUFL1,BUFL2 !LENGTH DATA BUFFERS - INTEGER BUFAD,BUFAD1,BUFAD2 !ADDRESS DATA BUFFERS - BYTE NGF(0:NGFHDL-1,0:MXNCHN) !PLOT HEADERS - INTEGER*2 NGFI(0:NGFHDL/2-1,0:MXNCHN) - INTEGER NGFJ(0:NGFHDL/4-1,0:MXNCHN) - REAL NGFE(0:NGFHDL/4-1,0:MXNCHN) - EQUIVALENCE (NGF,NGFI,NGFJ,NGFE) - COMPLEX C2 -C- -C -C INIT -C - DO I=0,7 !SET CURRENT JOB - SETS(I,1)=-1 - END DO - SETS(0,0)=1 - SETS(0,1)=SGNR(0) - CALL WNDSTR(FCAOUT,SETS) !RESET SEARCH - IF (NGCSTG(FCAOUT,SETS,NGF(0,0), - 1 NGFHP,SNAM(0,0))) THEN !ONE PRESENT - IF (.NOT.WNDLNG(GFH_LINKG_1,0,SGH_GROUPN_1,FCAOUT, - 1 SGPH(0),SGNR(0))) GOTO 51 !CREATE JOB SET - END IF -C -C GET PLOTS -C - 10 CONTINUE - IF (.NOT.WNDSTA('NGF_SETS',MXNSET,SETS,FCAOUT)) GOTO 900 !PLOTS TO USE - IF (SETS(0,0).EQ.0) GOTO 900 -C -C GET RANGE -C - IF (.NOT.NSCHAS(1,HASRA)) GOTO 10 !GET HA RANGE - HASRA(0)=HASRA(0)*360. !MAKE DEGREES - HASRA(1)=HASRA(1)*360. - 11 CONTINUE - IF (.NOT.WNDPAR('MAX_BASE',BLMAX,LB_E,J0,'3000')) THEN !LIMIT - IF (E_C.EQ.DWC_ENDOFLOOP) GOTO 10 - GOTO 11 - END IF - IF (J0.EQ.0) GOTO 10 - IF (J0.LT.0) BLMAX=3000 -C -C GET LOOPS -C - 12 CONTINUE - IF (.NOT.WNDXLP('NGF_LOOPS',FCAOUT)) THEN - IF (E_C.EQ.DWC_ENDOFLOOP) GOTO 10 !SETS AGAIN - GOTO 12 - END IF - CALL WNDXLI(LPOFF) !INIT LOOPING -C -C GET PLOTS -C - 30 CONTINUE - IF (.NOT.WNDXLN(LPOFF)) GOTO 10 !NO MORE LOOPS - NPLOT=0 !CNT PLOTS - DO WHILE(NGCSTL(FCAOUT,SETS,NGF(0,NPLOT+1), - 1 NGFHP,SNAM(0,NPLOT+1),LPOFF)) !GET PLOT - IF (NPLOT.LT.MXNCHN-1) THEN - NPLOT=NPLOT+1 !COUNT - PLOTS(NPLOT,2)=NGFHP !SAVE HEADER POINTER - PLOTS(NPLOT,1)=NPLOT !A NUMBER - CALL WNDSTI(FCAOUT,SNAM(0,NPLOT)) !PROPER NAME - END IF - END DO - IF (NPLOT.LE.0) GOTO 30 !NEXT LOOP -C -C SET LENGTHS PLOTS -C - NPTS=NGFJ(NGF_SCN_J,1) !INIT VALUES - HA=NGFE(NGF_HAB_E,1)*360. - HAINC=NGFE(NGF_HAI_E,1)*360. - HAE=NGFE(NGF_HAB_E,1)*360.+(NPTS-1)*HAINC - BLRANGE(0)=NGFE(NGF_BLN_E,1) - BLRANGE(1)=NGFE(NGF_BLN_E,1) - BLSTEP=1E30 !NEVER SO LARGE -C - TRTYP=NGFJ(NGF_TRTYP_J,1) - IF (TRTYP.NE.0) THEN - CALL WNCTXT(F_TP, - 1 '!/Input plot has been transposed, cannot sort on baseline') - GOTO 30 !NEXT LOOP - END IF -C - DO I=2,NPLOT - NPTS=MAX(NPTS,NGFJ(NGF_SCN_J,I)) - HA=MIN(HA,NGFE(NGF_HAB_E,I)*360.) - HAINC=MIN(HAINC,NGFE(NGF_HAI_E,I)*360.) - HAE=MAX(HAE,NGFE(NGF_HAB_E,I)*360.+(NGFJ(NGF_SCN_J,I)-1)* - 1 NGFE(NGF_HAI_E,I)*360.) - BLRANGE(0)=MIN(BLRANGE(0),NGFE(NGF_BLN_E,I)) - BLRANGE(1)=MAX(BLRANGE(1),NGFE(NGF_BLN_E,I)) - DO I1=1,I-1 - R0=ABS(NGFE(NGF_BLN_E,I)-NGFE(NGF_BLN_E,I1)) - IF (R0.LT.BLSTEP.AND.R0.GT.1) BLSTEP=R0 - END DO - END DO -C - IF (BLRANGE(0).LT.BLSTEP.AND.BLRANGE(0).GT.1) - 1 BLSTEP=BLRANGE(0) !NEEDED FOR START AT 0 Meters - IF (BLMAX.LT.BLRANGE(1)) BLRANGE(1)=BLMAX !USER MAXIMUM - CALL WNCTXT(F_TP, - 1 'Baseline range: !E6.0 - !E6.0, stepsize: !E6.1', - 1 BLRANGE(0),BLRANGE(1),BLSTEP) - BLRANGE(0)=0 !START PLOT AT 0 Meters -C - NPTS=MAX(NPTS,NINT((HAE-HA)/HAINC)+1) - BUFL=LB_X*(NPLOT+1)*NPTS !GET DATA BUFFER - IF (.NOT.WNGGVA(BUFL,BUFAD)) THEN - 22 CONTINUE - CALL WNCTXT(F_TP,'!/Cannot get plotdata buffer') - GOTO 900 - END IF - BUFAD=(BUFAD-A_OB)/LB_X -C - NOUT=(BLRANGE(1)-BLRANGE(0))/BLSTEP+1 - BUFL1=LB_X*NOUT !OUTPUT BUFFER - IF (.NOT.WNGGVA(BUFL1,BUFAD1)) THEN - CALL WNGFVA(BUFL,BUFAD*LB_X+A_OB) - GOTO 22 - END IF - BUFAD1=(BUFAD1-A_OB)/LB_X -C - BUFL2=LB_J*NOUT !COUNT BUFFER - IF (.NOT.WNGGVA(BUFL2,BUFAD2)) THEN - CALL WNGFVA(BUFL,BUFAD*LB_X+A_OB) - CALL WNGFVA(BUFL1,BUFAD1*LB_X+A_OB) - GOTO 22 - END IF - BUFAD2=(BUFAD2-A_OB)/LB_J -C - CALL WNGMVZ(BUFL,A_X(BUFAD)) !ZERO BUFFERS -C -C READ PLOT DATA -C - DO I=1,NPLOT !READ ALL DATA - IF (.NOT.WNFRD(FCAOUT,LB_X*NGFJ(NGF_SCN_J,I), - 1 A_X(BUFAD+I*NPTS),NGFJ(NGF_DPT_J,I))) THEN - 21 CONTINUE - CALL WNCTXT(F_TP,'!/Error reading plot file #!UJ', - 1 IAND(PLOTS(I,1),NOT(NGCSDL))) - GOTO 10 !RETRY EXPRESSION - END IF - END DO -C -C BUILD TRANSPOSED PLOTS -C - DO I1=0,NPTS-1 !ALL DATA - CHA=HA+I1*HAINC !CURRENT HA - IF (CHA.GE.HASRA(0) .AND. CHA.LE.HASRA(1)) THEN !SELECTED - - DO I=0,NOUT-1 !SET DELETED - A_X(BUFAD1+I)=CMPLX(NGCDLC,NGCDLC) - END DO - CALL WNGMVZ(BUFL2,A_J(BUFAD2)) !NO OUTPUT POINTS YET - - DO I=1,NPLOT !ALL SETS - R1=(CHA/360.-NGFE(NGF_HAB_E,I))/NGFE(NGF_HAI_E,I) !OFFSET - I2=NINT(R1) - I3=(NGFE(NGF_BLN_E,I)-BLRANGE(0)+0.5*BLSTEP)/BLSTEP !PLOT # - IF (I2.GE.0 .AND. I2.LT. NGFJ(NGF_SCN_J,I) .AND. - 1 I3.GE.0 .AND. I3.LT. NOUT) THEN - IF (REAL(A_X(BUFAD1+I3)).NE.NGCDLC) THEN - A_X(BUFAD1+I3)=A_X(BUFAD1+I3)+ - 1 A_X(BUFAD+I*NPTS+I2) !ADD - ELSE - A_X(BUFAD1+I3)=A_X(BUFAD+I*NPTS+I2) !SET - END IF - A_J(BUFAD2+I3)=A_J(BUFAD2+I3)+1 - END IF - END DO -C -C ADD NEW POINT TO PLOT FILE -C - CALL WNGMVZ(NGFHDL,NGF(0,0)) !ZERO NGF - NGFE(NGF_MAX_E,0)=-1E20 !INIT MAX/MIN - NGFE(NGF_MIN_E,0)=1E20 - DO I=0,NOUT-1 !ALL POINTS - IF (REAL(A_X(BUFAD1+I)).NE.NGCDLC) THEN - A_X(BUFAD1+I)=A_X(BUFAD1+I)/CMPLX(A_J(BUFAD2+I),0) !AVERAGE - C2=A_X(BUFAD1+I) - NGFE(NGF_MAX_E,0)=MAX(NGFE(NGF_MAX_E,0),ABS(C2)) !NEW MAX/MIN - NGFE(NGF_MIN_E,0)=MIN(NGFE(NGF_MIN_E,0),ABS(C2)) - ELSE - NGFJ(NGF_DEL_J,0)=NGFJ(NGF_DEL_J,0)+1 !COUNT - END IF - END DO - NGFI(NGF_VER_I,0)=NGFHDV !FILL PLOT HEADER - NGFI(NGF_LEN_I,0)=NGFHDL - CALL WNGMV(NGF_NAM_N,NGF(NGF_NAM_1,1),NGF(NGF_NAM_1,0)) - NGFE(NGF_RA_E,0)=NGFE(NGF_RA_E,1) - NGFE(NGF_DEC_E,0)=NGFE(NGF_DEC_E,1) - NGFE(NGF_FRQ_E,0)=NGFE(NGF_FRQ_E,1) - NGFE(NGF_BDW_E,0)=NGFE(NGF_BDW_E,1) - NGFJ(NGF_TRTYP_J,0)=2 !BASELINE PLOT - NGFE(NGF_TRHAI_E,0)=HAINC/360. - NGFE(NGF_TRHA_E,0)=CHA/360. - NGFE(NGF_TRFB_E,0)=0. - NGFE(NGF_TRFI_E,0)=0. - NGFE(NGF_HAB_E,0)=BLRANGE(0)/10./360. - NGFE(NGF_HAI_E,0)=BLSTEP/10./360. - NGFJ(NGF_BDN_J,0)=NGFJ(NGF_BDN_J,1) - NGFE(NGF_HAV_E,0)=NGFE(NGF_HAV_E,1) - NGFE(NGF_UTB_E,0)=NGFE(NGF_UTB_E,1) - NGFE(NGF_UTE_E,0)=NGFE(NGF_UTE_E,1) - NGFJ(NGF_SCN_J,0)=NOUT - NGFJ(NGF_VNR_J,0)=NGFJ(NGF_VNR_J,1) - CALL WNGMV(NGF_IFR_N,'All ',NGF(NGF_IFR_1,0)) - CALL WNGMV(NGF_POL_N,NGF(NGF_POL_1,1),NGF(NGF_POL_1,0)) - NGFI(NGF_ODY_I,0)=NGFI(NGF_ODY_I,1) - NGFI(NGF_OYR_I,0)=NGFI(NGF_OYR_I,1) - NGFE(NGF_BLN_E,0)=BLRANGE(1) - HSTR1='BASEL' - CALL WNCTXS(HSTR,'!AS(!AS-!AS)', - 1 HSTR1,WNTTSG(SNAM(0,1),0),WNTTSG(SNAM(0,NPLOT),0)) - CALL WNGMFS(NGF_TYP_N,HSTR,NGF(NGF_TYP_1,0)) - IF (.NOT.WNDLNF(SGPH(0)+SGH_LINKG_1,SNAM(1,1), - 1 SGH_GROUPN_1,FCAOUT,SGPH(1),SGNR(1))) THEN - 51 CONTINUE - CALL WNCTXT(F_TP,'!/Error linking sub-group') - GOTO 900 - END IF - IF (.NOT.WNDLNF(SGPH(1)+SGH_LINKG_1, - 1 NGFJ(NGF_BDN_J,0), - 1 SGH_GROUPN_1,FCAOUT,SGPH(2),SGNR(2))) GOTO 51 - IF (.NOT.WNDLNF(SGPH(2)+SGH_LINKG_1,SNAM(3,1), - 1 SGH_GROUPN_1,FCAOUT,SGPH(3),SGNR(3))) GOTO 51 - IF (.NOT.WNDLNF(SGPH(3)+SGH_LINKG_1,SNAM(4,1), - 1 SGH_GROUPN_1,FCAOUT,SGPH(4),SGNR(4))) GOTO 51 - J=WNFEOF(FCAOUT) !OUTPUT POINTER - NGFJ(NGF_DPT_J,0)=J+NGFHDL !DATA POINTER - IF (.NOT.WNFWR(FCAOUT,NGFHDL,NGF,J)) GOTO 21 !WRITE HEADER - IF (.NOT.WNFWR(FCAOUT,LB_X*NGFJ(NGF_SCN_J,0), - 1 A_X(BUFAD1),J+NGFHDL)) GOTO 21 !DATA - IF (.NOT.WNDLNK(GFH_LINK_1,J, - 1 NGF_SETN_1,FCAOUT)) GOTO 51 !LINK DATA - IF (.NOT.WNDLNG(SGPH(4)+SGH_LINKG_1,J, - 1 SGH_GROUPN_1,FCAOUT,SGPH(5),SGNR(5))) GOTO 51 !INDEX - CALL NGCSPH(SGNR,NGF(0,0)) !SHOW NEW PLOT - END IF - END DO - CALL WNGFVA(BUFL,BUFAD*LB_X+A_OB) !RELEASE BUFFER - CALL WNGFVA(BUFL1,BUFAD1*LB_X+A_OB) !RELEASE BUFFER -C -C LOOP IF NECESSARY -C - GOTO 30 !NEXT LOOP -C -C READY -C - 900 CONTINUE - RETURN !READY -C -C - END diff --git a/src/nplot/ngccal.for b/src/nplot/ngccal.for deleted file mode 100644 index 43c43a649c817376a074597eccd58383aaedbc73..0000000000000000000000000000000000000000 --- a/src/nplot/ngccal.for +++ /dev/null @@ -1,463 +0,0 @@ -C+ NGCCAL.FOR -C WNB 920821 -C -C Revisions: -C WNB 930504 Change for new complex solution -C HjV 930518 Change name of some keywords -C WNB 930630 Add SHIFT option -C WNB 930707 Change sign SHIFT option; allow average option -C WNB 930826 New HA range -C CMV 931220 Pass FCA of input file to WNDXLP and WNDSTA/Q -C CMV 940518 Correct typo in pol.subtraction -C CMV 940805 Add TRTYP=2 and CPOLY -C CMV 940811 Option to fit only some coefficients -C WNB 950621 New LSQ routines -C - SUBROUTINE NGCCAL -C -C Calculate something for a plot -C -C Result: -C -C CALL NGCCAL Calculate something for plot -C -C -C Pin references: -C -C CALC_TYPE Type of calculation -C HA_WIDTH Smoothing width -C NGF_SETS Plots to do -C POLY_N Polynomial degree -C POLY_USE Polynomial coefficients to fit -C POLY_COEF Polynomial coefficients -C SHIFT Shift values -C -C Include files: -C - INCLUDE 'WNG_DEF' - INCLUDE 'LSQ_O_DEF' - INCLUDE 'GFH_O_DEF' !GENERAL FILE HEADER - INCLUDE 'SGH_O_DEF' !SUB-GROUP HEADER - INCLUDE 'NGF_O_DEF' !PLOT HEADER - INCLUDE 'NGC_DEF' -C -C Parameters: -C - INTEGER MXPOLY !MAX. POLYNOMIAL DEGREE - PARAMETER (MXPOLY=10) -C -C Arguments: -C -C -C Function references: -C - INTEGER WNMEJC !CEIL - INTEGER WNMEJF !FLOOR - LOGICAL WNDPAR !GET USER DATA - LOGICAL WNDSTA !ASK SETS - LOGICAL WNDLNF,WNDLNG,WNDLNK !LINK DATA SET - LOGICAL WNFRD !READ DISK - LOGICAL WNFWR !WRITE DISK - LOGICAL WNGGVA !GET MEMORY - INTEGER WNFEOF !EOF POINTER - LOGICAL WNMLGA !GET LSQ AREA - LOGICAL WNMLTN !MATRIX INVERSION - CHARACTER*32 WNTTSG !SHOW SET - LOGICAL NSCHAS !HET HA RANGE - LOGICAL NGCSTG !GET A PLOT -C -C Data declarations: -C - INTEGER NGFP !PLOT HEADER PTR - INTEGER MAREA !LSQ AREA - INTEGER SNAM(0:7) !PLOT NAME - INTEGER NPLOT !# OF PLOTS - INTEGER PLOTS(MXNPLT) !PLOT LIST - INTEGER BUFAD !DATA BUFFER ADDRESS - INTEGER BLEN !DATA BUFFER LENGTH - INTEGER POLYN !POLYNOMIAL DEGREE - LOGICAL ILTEST !INDEFINITE LOOP TEST - LOGICAL CPOLY !TEST ON FIT/RESIDUAL - INTEGER DOPOLY(0:MXPOLY) !COEF's to FIT - REAL SOLP(0:MXPOLY) - COMPLEX CSOL,CRMS !SOLUTION - REAL MU - COMPLEX CCSOL(0:MXPOLY),CCRMS(0:MXPOLY) - COMPLEX C2SOL(0:MXPOLY) !SOLUTION FOR HA in hours - COMPLEX CP(0:MXPOLY) - REAL HARA(2) !HA RANGE - REAL HAST !HA SMOOTHING WIDTH - REAL CBL !CURRENT BASELINE - REAL SHFT(0:1) !SHIFT VALUES - REAL UV0(0:1) !U,V VALUES - BYTE NGF(0:NGFHDL-1) !PLOT HEADER - INTEGER*2 NGFI(0:NGFHDL/2-1) - INTEGER NGFJ(0:NGFHDL/4-1) - REAL NGFE(0:NGFHDL/4-1) - EQUIVALENCE (NGF,NGFI,NGFJ,NGFE) - REAL R2,R3,R4 - COMPLEX C2,C3 - CHARACTER*40 TX40 -C- -C -C GET CALCULATION TYPE -C - 10 CONTINUE - IF (.NOT.WNDPAR('CALC_TYPE',OPTION,LEN(OPTION),J0,'QUIT')) THEN - IF (E_C.EQ.DWC_ENDOFLOOP) GOTO 900 - GOTO 10 - END IF - IF (J0.LE.0) OPT='QUIT' - IF (OPT.EQ.'QUI') GOTO 900 -C -C GET SOLUTION VALUES -C - 12 CONTINUE - IF (OPT.EQ.'SMO') THEN - IF (.NOT.WNDPAR('HA_WIDTH',HAST,LB_E,J0,'.25')) THEN !SMOOTH WIDTH - IF (E_C.EQ.DWC_ENDOFLOOP) GOTO 10 - GOTO 12 - END IF - IF (J0.EQ.0) GOTO 10 - IF (J0.LT.0) HAST=0.25 - HAST=HAST/360. !CIRCLES - ELSE IF (OPT.EQ.'POL'.OR.OPT.EQ.'CPO') THEN - CPOLY=(OPT.EQ.'CPO') !OUTPUT RESIDUALS/FIT - IF (.NOT.WNDPAR('POLY_N',POLYN,LB_J,J0,'3')) THEN !POLYNOMIAL DEGREE - IF (E_C.EQ.DWC_ENDOFLOOP) GOTO 10 - GOTO 12 - END IF - IF (J0.EQ.0) GOTO 10 - IF (J0.LT.0) POLYN=3 - POLYN=MIN(MXPOLY,POLYN) !DEGREE -C - DO I=0,POLYN - DOPOLY(I)=I - END DO - IF (.NOT.WNDPAR('POLY_USE',DOPOLY,LB_J*(MXPOLY+1), - 1 J0,A_B(-A_OB),DOPOLY,POLYN+1)) THEN !COEFF. TO USE - IF (E_C.EQ.DWC_ENDOFLOOP) GOTO 10 - GOTO 12 - END IF - IF (J0.LE.0) THEN !DEFAULT: ALL - DO I=0,POLYN - DOPOLY(I)=I - END DO - END IF - CALL WNCTXT(F_TP,'Fitting !UJ: !1$#UJ', - 1 POLYN,POLYN+1,DOPOLY) -C - ELSE IF (OPT.EQ.'DPO') THEN - CPOLY=.FALSE. !OUTPUT RESIDUALS - IF (.NOT.WNDPAR('POLY_COEF',SOLP,LB_E*(MXPOLY+1), - 1 POLYN,'""')) THEN !COEFF. - IF (E_C.EQ.DWC_ENDOFLOOP) GOTO 10 - GOTO 12 - END IF - IF (POLYN.LE.0) GOTO 12 - POLYN=MIN(MXPOLY,POLYN-1) !DEGREE - ELSE IF (OPT.EQ.'NUL') THEN - IF (.NOT.NSCHAS(1,HARA)) GOTO 10 !GET HA RANGE - ELSE IF (OPT.EQ.'SHI') THEN - 13 CONTINUE - IF (.NOT.WNDPAR('SHIFT',SHFT,2*LB_E,J0,'0.,0.')) THEN !SHIFTS - IF (E_C.EQ.DWC_ENDOFLOOP) GOTO 10 - GOTO 12 - END IF - IF (J0.EQ.0) GOTO 10 - IF (J0.LT.0) GOTO 13 !MUST SPECIFY - ELSE IF (OPT.EQ.'AVE') THEN - ELSE - CALL WNCTXT(F_TP,'Unknown calculation option') - GOTO 900 - END IF -C -C GET PLOTS -C - 11 CONTINUE - IF (.NOT.WNDSTA('NGF_SETS',MXNPLT,SETS(0,0),FCAOUT)) GOTO 10 !GET PLOTS TO DO - ILTEST=.TRUE. !INDEFINITE LOOP TEST -C -C DO FOR ALL PLOTS -C - 20 CONTINUE - IF (.NOT.NGCSTG(FCAOUT,SETS,NGF,NGFP,SNAM)) GOTO 10 !READY - CALL WNDSTI(FCAOUT,SNAM) !MAKE PROPER NAME - 21 CONTINUE - IF (SNAM(0).GE.SGNR(0)) THEN !CAN BE INFINITE LOOP - IF (.NOT.ILTEST) GOTO 10 !INFINITE LOOP - IF (.NOT.WNDLNG(GFH_LINKG_1,0,SGH_GROUPN_1,FCAOUT, - 1 SGPH(0),SGNR(0))) THEN !CREATE JOB SET - CALL WNCTXT(F_TP,'!/Cannot create sub-group') - GOTO 10 !REPEAT - END IF - ILTEST=.FALSE. !CAN BE LOOP - GOTO 21 - END IF -C -C ACTION -C - 30 CONTINUE - BLEN=2*LB_X*NGFJ(NGF_SCN_J) !LENGTH DATA BUFFER - IF (.NOT.WNGGVA(BLEN,BUFAD)) THEN - CALL WNCTXT(F_TP,'!/Cannot get file databuffer') - GOTO 900 - END IF - BUFAD=(BUFAD-A_OB)/LB_X - IF (.NOT.WNFRD(FCAOUT,LB_X*NGFJ(NGF_SCN_J),A_X(BUFAD), - 1 NGFJ(NGF_DPT_J))) THEN !READ DATA - 31 CONTINUE - CALL WNCTXT(F_TP,'!/Error reading/writing plot data') - 32 CONTINUE - CALL WNGFVA(BLEN,BUFAD*LB_X+A_OB) !FREE BUFFER - GOTO 10 - END IF -C -C AVERAGE -C - IF (OPT.EQ.'AVE') THEN - IF (.NOT.WNMLGA(MAREA,LSQ_T_COMPLEX,1)) THEN - 33 CONTINUE - CALL WNCTXT(F_TP,'!/No memory for solution') - GOTO 32 - END IF - I1=0 !COUNT - DO I=0,NGFJ(NGF_SCN_J)-1 !AVERAGE - IF (REAL(A_X(BUFAD+I)).NE.NGCDLC) THEN - CALL WNMLMN(MAREA,LSQ_C_REAL,CMPLX(1.,1.),1., - 1 A_X(BUFAD+I)) !USE POINT - I1=I1+1 !COUNT - END IF - END DO - IF (WNMLTN(MAREA)) THEN !INVERT - CALL WNMLSN(MAREA,CSOL,MU,R0) !SOLVE - CALL WNMLME(MAREA,CRMS) !ERRORS - CALL WNCTXT(F_TP,'!/Average for plot !AS: '// - 1 '!24$EC5(!24$EC5)'// - 1 ' for !5$UJ points', - 1 WNTTSG(SNAM,0),CSOL,CRMS,I1) - END IF - CALL WNMLFA(MAREA) !FREE AREA -C -C SMOOTH -C - ELSE IF (OPT.EQ.'SMO') THEN - NGFE(NGF_MAX_E)=-1E20 !INIT MAX/MIN - NGFE(NGF_MIN_E)=1E20 - NGFJ(NGF_DEL_J)=0 !COUNT DELETED POINTS - DO I=0,NGFJ(NGF_SCN_J)-1 !ALL POINTS - R0=NGFE(NGF_HAB_E)+I*NGFE(NGF_HAI_E) !CURRENT HA - R1=0. !WEIGHT - C2=0. !SUM - DO I1=WNMEJC(-HAST/NGFE(NGF_HAI_E))+I, - 1 WNMEJF(HAST/NGFE(NGF_HAI_E))+I !SMOOTH - IF (I1.GE.0 .AND. I1.LT.NGFJ(NGF_SCN_J)) THEN !PRESENT - IF (REAL(A_X(BUFAD+I1)).NE.NGCDLC) THEN - R4=1.-ABS(I-I1)*NGFE(NGF_HAI_E)/HAST !WEIGHT - R1=R1+R4 - C2=C2+R4*A_X(BUFAD+I1) !SUM - END IF - END IF - END DO - IF (R1.NE.0) THEN - C3=C2/R1 !SMOOTHED VALUE - NGFE(NGF_MAX_E)=MAX(NGFE(NGF_MAX_E),ABS(C3)) !NEW MAX/MIN - NGFE(NGF_MIN_E)=MIN(NGFE(NGF_MIN_E),ABS(C3)) - ELSE - C3=CMPLX(NGCDLC,NGCDLC) !DELETED - NGFJ(NGF_DEL_J)=NGFJ(NGF_DEL_J)+1 !COUNT - END IF - A_X(BUFAD+I+NGFJ(NGF_SCN_J))=C3 !SAVE VALUE - END DO - CALL WNDSTI(FCAOUT,SNAM) !MAKE PROPER NAME - CALL WNCTXS(TX40,'SMOOTH #!AS IN !E9.2 DEG', - 1 WNTTSG(SNAM,0),360.*HAST) !DATA TYPE - CALL WNGMFS(NGF_TYP_N,TX40,NGF(NGF_TYP_1)) - 50 CONTINUE - IF (.NOT.WNDLNF(SGPH(0)+SGH_LINKG_1,SNAM(1), - 1 SGH_GROUPN_1,FCAOUT,SGPH(1),SGNR(1))) THEN !LINK - 51 CONTINUE - CALL WNCTXT(F_TP,'!/Cannot link sub-group') - GOTO 32 - END IF - IF (.NOT.WNDLNF(SGPH(1)+SGH_LINKG_1,SNAM(2), - 1 SGH_GROUPN_1,FCAOUT,SGPH(2),SGNR(2))) GOTO 51 - IF (.NOT.WNDLNF(SGPH(2)+SGH_LINKG_1,SNAM(3), - 1 SGH_GROUPN_1,FCAOUT,SGPH(3),SGNR(3))) GOTO 51 - IF (.NOT.WNDLNF(SGPH(3)+SGH_LINKG_1,SNAM(4), - 1 SGH_GROUPN_1,FCAOUT,SGPH(4),SGNR(4))) GOTO 51 - J=WNFEOF(FCAOUT) !OUTPUT POINTER - NGFJ(NGF_DPT_J)=J+NGFHDL !DATA POINTER - IF (.NOT.WNFWR(FCAOUT,NGFHDL,NGF,J)) GOTO 31 !WRITE HEADER - IF (.NOT.WNFWR(FCAOUT,LB_X*NGFJ(NGF_SCN_J), - 1 A_X(BUFAD+NGFJ(NGF_SCN_J)),J+NGFHDL)) GOTO 31 !DATA - IF (.NOT.WNDLNK(GFH_LINK_1,J, - 1 NGF_SETN_1,FCAOUT)) GOTO 51 !LINK DATA - IF (.NOT.WNDLNG(SGPH(4)+SGH_LINKG_1,J, - 1 SGH_GROUPN_1,FCAOUT,SGPH(5),SGNR(5))) GOTO 51 !INDEX - CALL NGCSPH(SGNR,NGF) !SHOW NEW PLOT -C -C POLYNOMIAL -C - ELSE IF (OPT.EQ.'POL'.OR.OPT.EQ.'CPO') THEN - IF (.NOT.WNMLGA(MAREA,LSQ_T_COMPLEX,POLYN+1)) GOTO 33 !GET SOL. AREA - DO I=0,NGFJ(NGF_SCN_J)-1 !AVERAGE - R1=NGFE(NGF_HAB_E)+I*NGFE(NGF_HAI_E) !HA (CIRCLES) - DO I1=0,POLYN !COEFFICIENTS - CP(I1)=R1**DOPOLY(I1) - END DO - IF (REAL(A_X(BUFAD+I)).NE.NGCDLC) THEN - IF (NGFJ(NGF_TRTYP_J).EQ.2) THEN - CALL WNCTXT(F_T,'Using !7$E6.1 m baseline',R1*360.*10.) - END IF - CALL WNMLMN(MAREA,LSQ_C_COMPLEX,CP,1.,A_X(BUFAD+I)) !USE POINT - END IF - END DO - IF (WNMLTN(MAREA)) THEN !INVERT - CALL WNMLSN(MAREA,CCSOL,MU,R0) !SOLVE - CALL WNMLME(MAREA,CCRMS) !ERRORS - CALL WNCTXT(F_TP,'!/Polynomial coefficients for !AS:!/'// - 1 ' !24$#EC5!/m.e. !24$#EC5', - 1 WNTTSG(SNAM,0),POLYN+1,CCSOL, - 1 POLYN+1,CCRMS) - CALL WNCTXT(F_TP,' (in W.U. as function of HA in circles)') - IF (NGFJ(NGF_TRTYP_J).EQ.0) THEN - DO I1=0,POLYN !CALCULATE PER HOUR - R0=(1./24.)**DOPOLY(I1) - C2SOL(I1)=CCSOL(I1)*R0 - END DO - CALL WNCTXT(F_TP,' !24$#EC5',POLYN+1,C2SOL) - CALL WNCTXT(F_TP,' (in W.U. as function of HA in hours)') - ELSE IF (NGFJ(NGF_TRTYP_J).EQ.2) THEN - DO I1=0,POLYN !CALCULATE PER METER - R0=(1./360./10.)**DOPOLY(I1) - C2SOL(I1)=CCSOL(I1)*R0 - END DO - CALL WNCTXT(F_TP,'HA: !9$EAF9.4 !24$#EC5', - 1 NGFE(NGF_TRHA_E),POLYN+1,C2SOL) - CALL WNCTXT(F_TP,' (in W.U. as function of BASELINE in M)') - END IF - ELSE - CALL WNCTXT(F_TP,'!/Cannot solve polynomial for !AS', - 1 WNTTSG(SNAM,0)) - END IF - CALL WNMLFA(MAREA) !FREE AREA - 40 CONTINUE - NGFE(NGF_MAX_E)=-1E20 !INIT MAX/MIN - NGFE(NGF_MIN_E)=1E20 - NGFJ(NGF_DEL_J)=0 !COUNT DELETED POINTS - DO I=0,NGFJ(NGF_SCN_J)-1 !ALL POINTS - R0=NGFE(NGF_HAB_E)+I*NGFE(NGF_HAI_E) !CURRENT HA - C2=0 - DO I1=0,POLYN - C2=C2+CCSOL(I1)*(R0**DOPOLY(I1)) - END DO -C DO I1=POLYN,0,-1 !CALCULATE FIT -C C2=C2*R0+CCSOL(I1) -C END DO - IF (.NOT.CPOLY) THEN !CALCULATE RESIDUAL - IF (REAL(A_X(BUFAD+I)).NE.NGCDLC) THEN - C2=A_X(BUFAD+I)-C2 !RESIDUAL - ELSE - C2=CMPLX(NGCDLC,NGCDLC) !DELETED - END IF - END IF - IF (REAL(C2).NE.NGCDLC) THEN - NGFE(NGF_MAX_E)=MAX(NGFE(NGF_MAX_E),ABS(C2)) !NEW MAX/MIN - NGFE(NGF_MIN_E)=MIN(NGFE(NGF_MIN_E),ABS(C2)) - ELSE - NGFJ(NGF_DEL_J)=NGFJ(NGF_DEL_J)+1 !COUNT - END IF - A_X(BUFAD+I+NGFJ(NGF_SCN_J))=C2 !SAVE VALUE - END DO - CALL WNDSTI(FCAOUT,SNAM) !MAKE PROPER NAME - CALL WNCTXS(TX40,'DPOLY #!AS, !UJ DEGREE', - 1 WNTTSG(SNAM,0),POLYN) !DATA TYPE - CALL WNGMFS(NGF_TYP_N,TX40,NGF(NGF_TYP_1)) - GOTO 50 -C -C DPOLY -C - ELSE IF (OPT.EQ.'DPO') THEN - DO I=0,POLYN !SET COEFFICIENTS - CCSOL(I)=SOLP(I) - DOPOLY(I)=I - END DO - GOTO 40 -C -C NULL -C - ELSE IF (OPT.EQ.'NUL') THEN - NGFE(NGF_MAX_E)=-1E20 !INIT MAX/MIN - NGFE(NGF_MIN_E)=1E20 - NGFJ(NGF_DEL_J)=0 !COUNT DELETED POINTS - I1=NINT((HARA(1)-NGFE(NGF_HAB_E))/ - 1 NGFE(NGF_HAI_E)) !START DELETE - I2=NINT((HARA(2)-NGFE(NGF_HAB_E))/ - 1 NGFE(NGF_HAI_E)) !END DELETE - DO I=0,NGFJ(NGF_SCN_J)-1 !ALL POINTS - IF (REAL(A_X(BUFAD+I)).NE.NGCDLC) THEN !IF NOT DELETED - IF (I.GE.I1 .AND. I.LE.I2) THEN !DELETE POINT - C2=CMPLX(NGCDLC,NGCDLC) - NGFJ(NGF_DEL_J)=NGFJ(NGF_DEL_J)+1 !COUNT - ELSE !LEAVE POINT - C2=A_X(BUFAD+I) - NGFE(NGF_MAX_E)=MAX(NGFE(NGF_MAX_E),ABS(C2)) !NEW MAX/MIN - NGFE(NGF_MIN_E)=MIN(NGFE(NGF_MIN_E),ABS(C2)) - END IF - ELSE - C2=A_X(BUFAD+I) !DELETED - NGFJ(NGF_DEL_J)=NGFJ(NGF_DEL_J)+1 !COUNT - END IF - A_X(BUFAD+I+NGFJ(NGF_SCN_J))=C2 !SAVE VALUE - END DO - CALL WNDSTI(FCAOUT,SNAM) !MAKE PROPER NAME - CALL WNCTXS(TX40,'NULL #!AS (!2EAF9.2) DEGREES', - 1 WNTTSG(SNAM,0),HARA) !DATA TYPE - CALL WNGMFS(NGF_TYP_N,TX40,NGF(NGF_TYP_1)) - GOTO 50 -C -C SHIFT -C - ELSE IF (OPT.EQ.'SHI') THEN - DO I=0,NGFJ(NGF_SCN_J)-1 !ALL POINTS - CBL=NGFE(NGF_BLN_E) - R0=NGFE(NGF_HAB_E)+I*NGFE(NGF_HAI_E) !CURRENT HA - IF (NGFJ(NGF_TRTYP_J).EQ.0) THEN !NORMAL - R1=NGFE(NGF_FRQ_E) !CURRENT FREQUENCY - ELSE IF (NGFJ(NGF_TRTYP_J).EQ.2) THEN !BASELINE - CBL=R0*360. !CURRENT BASELINE - R1=NGFE(NGF_FRQ_E) !CURRENT FREQUENCY - R0=NGFE(NGF_TRHA_E) !CURRENT HA - ELSE !TRANSPOSE - R1=NGFE(NGF_TRFB_E)+R0/FRHACV*NGFE(NGF_TRFI_E) !CURRENT FREQ. - R0=NGFE(NGF_TRHA_E) !CURRENT HA - END IF - UV0(0)=PI2*R1/CL/1E-6*COS(PI2*R0) !U - UV0(1)=-PI2*R1/CL/1E-6*SIN(PI2*R0)*SIN(PI2*NGFE(NGF_DEC_E)) - DO I1=0,1 - UV0(I1)=1/(3600.*DEG)*SHFT(I1)*UV0(I1)*CBL !SHIFT PHASE - END DO - C2=A_X(BUFAD+I) !VALUE - IF (REAL(A_X(BUFAD+I)).NE.NGCDLC) THEN !NOT DELETED - C2=C2*EXP(CMPLX(0.,-UV0(0)-UV0(1))) !NEW VALUE - END IF - A_X(BUFAD+I+NGFJ(NGF_SCN_J))=C2 !SAVE VALUE - END DO - CALL WNDSTI(FCAOUT,SNAM) !MAKE PROPER NAME - CALL WNCTXS(TX40,'SHIFT #!AS (!2E9.2) ARCSEC', - 1 WNTTSG(SNAM,0),SHFT) !DATA TYPE - CALL WNGMFS(NGF_TYP_N,TX40,NGF(NGF_TYP_1)) - GOTO 50 - END IF -C - CALL WNGFVA(BLEN,BUFAD*LB_X+A_OB) !FREE BUFFER - GOTO 20 !NEXT PLOT -C -C READY -C - 900 CONTINUE - RETURN -C -C - END diff --git a/src/nplot/ngccob.for b/src/nplot/ngccob.for deleted file mode 100644 index 8b8a65b75f707704a60c4a57ecfe6897d6fedde5..0000000000000000000000000000000000000000 --- a/src/nplot/ngccob.for +++ /dev/null @@ -1,407 +0,0 @@ -C+ NGCCOB.FOR -C WNB 920821 -C -C Revisions: -C HjV 930423 Change name of some keywords -C WNB 930628 Add POL and BLN in output; TRHA, TRHAI, TRFB, TRFI -C WNB 930711 Make sure print shows correct file # -C CMV 931210 Add 'NGF_LOOPS' argument to WNDXLP -C CMV 931220 Pass FCA of input file to WNDXLP and WNDSTA/Q -C CMV 940805 Add TRTYP=2 -C JPH 940819 NGF_LOOPS before NGF_SETS as in all Newstar programs -C Include input data type in MERGE data type -C 'plot' --> 'cut' -C Replace CONTINUE/GOTO by DO WHILE/ENDDO -C JPH 940823 Comments (lowercase) -C New output group for every new input group -C Do not store empty sets -C NGCSPH --> NGCSPL -C HjV 941031 Line too long -C -C - SUBROUTINE NGCCOB -C -C Make combination file -C -C Result: -C -C CALL NGCCOB Make combination output file using -C user specified expression. -C -C -C Pin references: -C -C EXPRESSION Expression to use -C USE_NGF_SET Plot to use -C NGF_SETS Plots to use -C -C Include files: -C - INCLUDE 'WNG_DEF' - INCLUDE 'GFH_O_DEF' !GENERAL FILE HEADER - INCLUDE 'SGH_O_DEF' !SUB-GROUP HEADER - INCLUDE 'NGF_O_DEF' !CUT HEADER - INCLUDE 'NGC_DEF' -C -C Parameters: -C -C -C Arguments: -C -C -C Function references: -C - LOGICAL WNDPAR !GET USER DATA - LOGICAL WNDLNG,WNDLNK,WNDLNF !LINK SETS - LOGICAL WNDSTA !GET SETS - LOGICAL WNDXLP !GET LOOPS - LOGICAL WNDXLN !NEXT LOOP - LOGICAL WNFRD !READ DISK - LOGICAL WNFWR !WRITE DISK - INTEGER WNFEOF !EOF POINTER - LOGICAL WNGGVA !GET MEMORY - CHARACTER*32 WNTTSG !SET NAME - LOGICAL NGCSTG,NGCSTL !GET CUT - LOGICAL NGCEXP !ANALYZE EXPRESSION - LOGICAL NGCEXC !CALCULATE EXPRESSION -C -C Data declarations: -C - INTEGER PRVGRP ! previous group nr - INTEGER NDONE ! CUTS DONE - INTEGER NCUT !# OF CUTS TO USE - INTEGER CUTS(MXNPLT,2) !CUTS TO USE - INTEGER PSET(0:7,0:1,MXNPLT) !CUTS IN EXPRESSION - INTEGER SNAM(0:7,MXNPLT) !CUT NAME - INTEGER NGFHP !HEADER POINTER - CHARACTER*80 INSTR !EXPRESSION STRING - CHARACTER*80 OUTSTR !ERROR STRING - CHARACTER*(NGF_TYP_N) HSTR,HSTR1 - INTEGER COD(256) !CODED EXPRESSION - INTEGER NPTS !LENGTH SINGLE CUT - REAL HA,HAE !START,END HA OUTPUT CUT - REAL HAINC !HA INCREMENT OUTPUT CUT - REAL CHA !HA CURRENT POINT - REAL CUT !UT CURRENT POINT - REAL CFQ !FREQ CURRENT POINT - REAL CBL !BASELINE CURRENT POINT - REAL CRA !RA CURRENT POINT - REAL CDEC !DEC CURRENT POINT - COMPLEX CUTV(MXNPLT) !CUT VALUE LIST - INTEGER BUFL,BUFL1 !LENGTH DATA BUFFER - INTEGER BUFAD,BUFAD1 !ADDRESS DATA BUFFER - BYTE NGF(0:NGFHDL-1,0:MXNPLT) !CUT HEADERS - INTEGER*2 NGFI(0:NGFHDL/2-1,0:MXNPLT) - INTEGER NGFJ(0:NGFHDL/4-1,0:MXNPLT) - REAL NGFE(0:NGFHDL/4-1,0:MXNPLT) - EQUIVALENCE (NGF,NGFI,NGFJ,NGFE) - COMPLEX C2 -C- -C -C GET EXPRESSION -C - 10 CONTINUE - IF (OPT.EQ.'COM') THEN !COMBINE - IF (.NOT.WNDPAR('EXPRESSION',INSTR,LEN(INSTR), - 1 J0,'""')) THEN !EXPRESSION - IF (E_C.EQ.DWC_ENDOFLOOP) GOTO 900 - GOTO 10 - END IF - IF (J0.LE.0) GOTO 900 - IF (.NOT.NGCEXP(INSTR,OUTSTR,COD,CUTS,NCUT)) THEN - CALL WNCTXT(F_TP,'!/Error in expression:!/ !AS!/', - 1 OUTSTR) - GOTO 10 - END IF - IF (NCUT.EQ.0) THEN - CALL WNCTXT(F_TP,'!/No cuts used in expression') - GOTO 10 - END IF - ELSE !MERGE - 12 CONTINUE - IF (.NOT.WNDXLP('NGF_LOOPS',FCAOUT)) THEN - IF (E_C.EQ.DWC_ENDOFLOOP) GOTO 900 !EXIT - GOTO 12 - END IF - IF (.NOT.WNDSTA('NGF_SETS',MXNSET,SETS,FCAOUT)) GOTO 12 !CUTS TO USE - IF (E_C.EQ.DWC_ENDOFLOOP) GOTO 12 !EXPRESSION AGAIN - IF (SETS(0,0).EQ.0) GOTO 12 - CALL WNDXLI(LPOFF) !INIT LOOPING - END IF -C -C GET CUTS -C - 14 CONTINUE - IF (OPT.EQ.'COM') THEN !COMBINE - DO I=1,NCUT - CUTS(I,2)=-1 !SET NOT SEEN - END DO - DO I=1,NCUT - CALL WNCTXT(F_TP,'Define cut #!UJ:', - 1 IAND(CUTS(I,1),NOT(NGCSDL))) - 11 CONTINUE - IF (.NOT.WNDSTA('USE_NGF_SET',1,PSET(0,0,I),FCAOUT)) THEN - IF (E_C.EQ.DWC_ENDOFLOOP) GOTO 10 !RETRY EXPRESSION - END IF - IF (PSET(0,0,I).EQ.0) GOTO 11 !RETRY - END DO - END IF -C -C GET CUTS -C - PRVGRP=-1 - NDONE=0 - DO WHILE (WNDXLN(LPOFF)) - IF (OPT.EQ.'COM') THEN !COMBINE - DO I=1,NCUT - CALL WNDSTR(FCAOUT,PSET(0,0,I)) !RESET CUT SEARCH - IF (IAND(CUTS(I,1),NGCSDL).EQ.0) THEN !LOOP WANTED - IF (.NOT.NGCSTL(FCAOUT,PSET(0,0,I),NGF(0,I), - 1 NGFHP,SNAM(0,I),LPOFF)) THEN - 20 CONTINUE - CALL WNCTXT(F_TP,'!/Expression cut #!UJ not present!/', - 1 IAND(CUTS(I,1),NOT(NGCSDL))) - GOTO 10 !RETRY EXPRESSION - END IF - ELSE !NO LOOP WANTED - IF (.NOT.NGCSTG(FCAOUT,PSET(0,0,I),NGF(0,I), - 1 NGFHP,SNAM(0,I))) GOTO 20 - END IF - CALL WNDSTI(FCAOUT,SNAM(0,I)) !MAKE SURE PROPER NAME - CUTS(I,2)=NGFHP !SAVE HEADER POINTER - END DO - ELSE !MERGE - NCUT=0 !CNT CUTS - DO WHILE(NGCSTL(FCAOUT,SETS,NGF(0,NCUT+1), - 1 NGFHP,SNAM(0,NCUT+1),LPOFF)) !GET CUT - IF (NCUT.LT.MXNPLT-1) THEN - NCUT=NCUT+1 !COUNT - CUTS(NCUT,2)=NGFHP !SAVE HEADER POINTER - CUTS(NCUT,1)=NCUT !A NUMBER - END IF - END DO - IF (NCUT.LE.0) GOTO 30 ! nothing found, NEXT LOOP - END IF -C -C SET LENGTHS CUTS: Find extremes HA and HAE of HA-range, set HAINC to the -C smallest increment -C - NPTS=NGFJ(NGF_SCN_J,1) !INIT VALUES - HA=NGFE(NGF_HAB_E,1)*360. - HAINC=NGFE(NGF_HAI_E,1)*360. - HAE=NGFE(NGF_HAB_E,1)*360.+(NPTS-1)*HAINC - DO I=2,NCUT - NPTS=MAX(NPTS,NGFJ(NGF_SCN_J,I)) - HA=MIN(HA,NGFE(NGF_HAB_E,I)*360.) - HAINC=MIN(HAINC,NGFE(NGF_HAI_E,I)*360.) - HAE=MAX(HAE,NGFE(NGF_HAB_E,I)*360.+(NGFJ(NGF_SCN_J,I)-1)* - 1 NGFE(NGF_HAI_E,I)*360.) - END DO - NPTS=MAX(NPTS,NINT((HAE-HA)/HAINC)+1) ! points in output cut - BUFL=LB_X*(NCUT+1)*NPTS ! GET DATA BUFFER - IF (.NOT.WNGGVA(BUFL,BUFAD)) THEN - 22 CONTINUE - CALL WNCTXT(F_TP,'!/Cannot get cut-data buffer') - GOTO 900 - END IF - BUFAD=(BUFAD-A_OB)/LB_X - CALL WNGMVZ(BUFL,A_X(BUFAD)) ! clear BUFFER -C - IF (OPT.NE.'COM') THEN !MERGE - BUFL1=LB_J*NPTS ! COUNT BUFFER - IF (.NOT.WNGGVA(BUFL1,BUFAD1)) THEN - CALL WNGFVA(BUFL,BUFAD*LB_X+A_OB) - GOTO 22 - END IF - BUFAD1=(BUFAD1-A_OB)/LB_J - CALL WNGMVZ(BUFL1,A_J(BUFAD1)) - END IF -C -C READ CUT DATA -C - DO I=1,NCUT !READ ALL DATA - IF (.NOT.WNFRD(FCAOUT,LB_X*NGFJ(NGF_SCN_J,I), - 1 A_X(BUFAD+I*NPTS),NGFJ(NGF_DPT_J,I))) THEN -21 CONTINUE - CALL WNCTXT(F_TP,'!/Error reading cut file #!UJ', - 1 IAND(CUTS(I,1),NOT(NGCSDL))) - GOTO 10 !RETRY EXPRESSION - END IF - END DO -C -C BUILD COMBINED CUT. For every HA in the output cut, the nearest value in each -C of the input cuts is used. This results in some smoothing, in particular if -C the input cuts do not all have the same HAINC. -C - CRA=NGFE(NGF_RA_E,1)*360. !CURRENT RA - CDEC=NGFE(NGF_DEC_E,1)*360. - CFQ=NGFE(NGF_FRQ_E,1) - CBL=NGFE(NGF_BLN_E,1) - DO I1=0,NPTS-1 !ALL DATA - CHA=HA+I1*HAINC !CURRENT HA - CUT=360.*((CHA/360.-NGFE(NGF_HAB_E,1))*0.99727+ - 1 NGFE(NGF_UTB_E,1)) !CURRENT UT - DO I=1,NCUT !ALL SETS - R1=(CHA/360.-NGFE(NGF_HAB_E,I))/NGFE(NGF_HAI_E,I) !OFFSET - I2=NINT(R1) - IF (I2.LT.0 .OR. I2.GE. NGFJ(NGF_SCN_J,I)) THEN - CUTV(I)=CMPLX(NGCDLC,NGCDLC) !SET DELETE VALUE - ELSE - CUTV(I)=A_X(BUFAD+I*NPTS+I2) !DATA - END IF - END DO - IF (OPT.EQ.'COM') THEN !COMBINE - IF (NGFJ(NGF_TRTYP_J,1).EQ.1) THEN !TRANSPOSE - CFQ=NGFE(NGF_TRFB_E,1)+CHA/FRHACV*NGFE(NGF_TRFI_E,1) - CHA=NGFE(NGF_TRHA_E,1)*360. - ELSE IF (NGFJ(NGF_TRTYP_J,1).EQ.2) THEN !BASELINE - CBL=CHA - CHA=NGFE(NGF_TRHA_E,1)*360. - END IF - IF (.NOT.NGCEXC(COD,COD,CUTV,CHA,CUT,CFQ,CBL,CRA,CDEC, - 1 C2)) THEN !CALCULATE POINT - CALL WNCTXT(F_TP, - 1 '!/Unexpected compile error during execution'// - 2 '- operation aborted !/') - CALL WNGFVA(BUFL,BUFAD*LB_X+A_OB) !RELEASE BUFFER - GOTO 10 !RETRY EXPRESSION - END IF - A_X(BUFAD+I1)=C2 ! value OK, copy it - ELSE !MERGE - DO I=1,NCUT - IF (REAL(CUTV(I)).NE.NGCDLC) THEN !PRESENT - A_X(BUFAD+I1)=A_X(BUFAD+I1)+CUTV(I) ! ADD value - A_J(BUFAD1+I1)=A_J(BUFAD1+I1)+1 ! and COUNT it - END IF - END DO - END IF - END DO -C -C ADD NEW POINT TO CUT FILE -C - CALL WNGMVZ(NGFHDL,NGF(0,0)) !ZERO NGF - NGFE(NGF_MAX_E,0)=NGCDLC !INIT MAX/MIN - NGFE(NGF_MIN_E,0)=-NGCDLC ! (note: NGCDLC defined neg.!) - DO I=0,NPTS-1 !ALL POINTS - IF (OPT.NE.'COM') THEN !MERGE - IF (A_J(BUFAD1+I).GT.0) THEN ! >0 input points found: average - A_X(BUFAD+I)=A_X(BUFAD+I)/A_J(BUFAD1+I) - ELSE ! none found: set "invalid" - A_X(BUFAD+I)=CMPLX(NGCDLC,NGCDLC) - END IF - END IF - IF (REAL(A_X(BUFAD+I)).NE.NGCDLC) THEN - C2=A_X(BUFAD+I) - NGFE(NGF_MAX_E,0)=MAX(NGFE(NGF_MAX_E,0),ABS(C2)) !NEW MAX/MIN - NGFE(NGF_MIN_E,0)=MIN(NGFE(NGF_MIN_E,0),ABS(C2)) - ELSE - C2=CMPLX(NGCDLC,NGCDLC) !DELETED - NGFJ(NGF_DEL_J,0)=NGFJ(NGF_DEL_J,0)+1 !COUNT - END IF - A_X(BUFAD+I+NGFJ(NGF_SCN_J,0))=C2 !SAVE VALUE - END DO -C - NGFI(NGF_VER_I,0)=1 !FILL CUT HEADER - NGFI(NGF_LEN_I,0)=NGFHDL - CALL WNGMV(NGF_NAM_N,NGF(NGF_NAM_1,1),NGF(NGF_NAM_1,0)) - NGFE(NGF_RA_E,0)=NGFE(NGF_RA_E,1) - NGFE(NGF_DEC_E,0)=NGFE(NGF_DEC_E,1) - NGFE(NGF_FRQ_E,0)=NGFE(NGF_FRQ_E,1) - NGFE(NGF_BDW_E,0)=NGFE(NGF_BDW_E,1) - NGFE(NGF_HAB_E,0)=HA/360. - NGFE(NGF_HAI_E,0)=HAINC/360. - NGFE(NGF_HAV_E,0)=NGFE(NGF_HAV_E,1) - NGFE(NGF_UTB_E,0)=NGFE(NGF_UTB_E,1) - NGFE(NGF_UTE_E,0)=NGFE(NGF_UTE_E,1) - NGFJ(NGF_SCN_J,0)=NPTS - NGFJ(NGF_VNR_J,0)=NGFJ(NGF_VNR_J,1) - NGFJ(NGF_BDN_J,0)=NGFJ(NGF_BDN_J,1) - CALL WNGMV(NGF_IFR_N,NGF(NGF_IFR_1,1),NGF(NGF_IFR_1,0)) - CALL WNGMV(NGF_POL_N,NGF(NGF_POL_1,1),NGF(NGF_POL_1,0)) - NGFI(NGF_ODY_I,0)=NGFI(NGF_ODY_I,1) - NGFI(NGF_OYR_I,0)=NGFI(NGF_OYR_I,1) - NGFE(NGF_BLN_E,0)=NGFE(NGF_BLN_E,1) - NGFE(NGF_TRHAI_E,0)=NGFE(NGF_TRHAI_E,1) - NGFE(NGF_TRHA_E,0)=NGFE(NGF_TRHA_E,1) - NGFE(NGF_TRFB_E,0)=NGFE(NGF_TRFB_E,1) - NGFE(NGF_TRFI_E,0)=NGFE(NGF_TRFI_E,1) - IF (OPT.EQ.'COM') THEN !COMBINE - HSTR=OUTSTR !EXPRESSION - ELSE -C -C Make TYP string -C - CALL WNGMTS(8, NGF(NGF_TYP_1,1), HSTR) - DO I=1,8 - IF (HSTR(I:I).LT.'A' .OR. HSTR(I:I).GT.'Z') GOTO 511 - ENDDO -511 CONTINUE - I=I-1 - END IF - HSTR1=HSTR(1:I) - CALL WNCTXS(HSTR,'!AS !AS-!AS', - 1 HSTR1,WNTTSG(SNAM(0,1),0) ,WNTTSG(SNAM(0,NCUT),0)) - HSTR1=HSTR - CALL WNCTXS(HSTR,'!AS',HSTR1) - CALL WNGMFS(NGF_TYP_N,HSTR,NGF(NGF_TYP_1,0)) -C -C Create indices; new group for each new input group, copy remainder, new -C sequence number -C - IF (SNAM(0,1).NE.PRVGRP) THEN - IF (.NOT.WNDLNG(GFH_LINKG_1,0,SGH_GROUPN_1,FCAOUT, - 1 SGPH(0),SGNR(0))) THEN !CREATE new group - 51 CONTINUE - CALL WNCTXT(F_TP,'!/Error linking sub-group') - GOTO 900 - ENDIF - END IF - PRVGRP=SNAM(0,1) - IF (.NOT.WNDLNF(SGPH(0)+SGH_LINKG_1,SNAM(1,1), - 1 SGH_GROUPN_1,FCAOUT,SGPH(1),SGNR(1))) GOTO 51 - IF (.NOT.WNDLNF(SGPH(1)+SGH_LINKG_1,SNAM(2,1), - 1 SGH_GROUPN_1,FCAOUT,SGPH(2),SGNR(2))) GOTO 51 - IF (.NOT.WNDLNF(SGPH(2)+SGH_LINKG_1,SNAM(3,1), - 1 SGH_GROUPN_1,FCAOUT,SGPH(3),SGNR(3))) GOTO 51 - IF (.NOT.WNDLNF(SGPH(3)+SGH_LINKG_1,SNAM(4,1), - 1 SGH_GROUPN_1,FCAOUT,SGPH(4),SGNR(4))) GOTO 51 -C -C Store data only if there are any -C - IF (NGFE(NGF_MAX_E,0).NE.NGCDLC) THEN - J=WNFEOF(FCAOUT) !OUTPUT POINTER - NGFJ(NGF_DPT_J,0)=J+NGFHDL !DATA POINTER - IF (.NOT.WNFWR(FCAOUT,NGFHDL,NGF,J)) GOTO 21 !WRITE HEADER - IF (.NOT.WNFWR(FCAOUT,LB_X*NGFJ(NGF_SCN_J,0), - 1 A_X(BUFAD),J+NGFHDL)) GOTO 21 !DATA - IF (.NOT.WNDLNK(GFH_LINK_1,J, - 1 NGF_SETN_1,FCAOUT)) GOTO 51 !LINK DATA - IF (.NOT.WNDLNG(SGPH(4)+SGH_LINKG_1,J, - 1 SGH_GROUPN_1,FCAOUT,SGPH(5),SGNR(5))) GOTO 51 !INDEX -C - IF (.NOT.WNFRD(FCAOUT,NGFHDL,NGF,J)) GOTO 21 !REREAD HEADER - ELSE - CALL WNGMFS(40,'EMPTY, no data stored ', - 1 NGF(NGF_TYP_1,0)) - ENDIF - NDONE=NDONE+1 - IF (MOD(NDONE,100).EQ.0) - 1 CALL NGCSPL(SGNR,NGF(0,0),NDONE)! sign of line - CALL WNGFVA(BUFL,BUFAD*LB_X+A_OB) !RELEASE BUFFER - IF (OPT.NE.'COM') !MERGE - 1 CALL WNGFVA(BUFL1,BUFAD1*LB_J+A_OB) !RELEASE BUFFER -C -C LOOP IF NECESSARY -C -30 CONTINUE - ENDDO - CALL WNCTXT(F_TP,'!UJ cuts created',NDONE) !NEXT LOOP - GOTO 10 -C -C READY -C - 900 CONTINUE - RETURN !READY -C -C - END diff --git a/src/nplot/ngccop.for b/src/nplot/ngccop.for deleted file mode 100644 index 7bfabc11aa82d357bfa66a63ab0b7e7de57c94fe..0000000000000000000000000000000000000000 --- a/src/nplot/ngccop.for +++ /dev/null @@ -1,218 +0,0 @@ -C+ NGCCOP.FOR -C WNB 920827 -C -C Revisions: -C HjV 930423 Change name of some keywords -C CMV 931220 Pass FCA of input file to WNDXLP and WNDSTA/Q -C WNB 940617 Correct data copy buffer pointer -C JPH 940823 Include input TYP in output TYP -C NGCSPH --> NGCSPL -C -C - SUBROUTINE NGCCOP -C -C Copy plots -C -C Result: -C -C CALL NGCCOP Copy plots -C -C -C Pin references: -C -C OUTPUT_NGF_NODE Output node -C NGF_SETS Plots to do -C -C Include files: -C - INCLUDE 'WNG_DEF' - INCLUDE 'GFH_O_DEF' !GENERAL FILE HEADER - INCLUDE 'SGH_O_DEF' !SUB-GROUP HEADER - INCLUDE 'NGF_O_DEF' !PLOT HEADER - INCLUDE 'NGC_DEF' -C -C Parameters: -C -C -C Arguments: -C -C -C Function references: -C - LOGICAL WNDSTA !ASK SETS - LOGICAL WNDNOD !ASK NODE - LOGICAL WNDLNF,WNDLNG,WNDLNK !LINK DATA SET - LOGICAL WNFOP !OPEN FILE - LOGICAL WNFRD !READ DISK - LOGICAL WNFWR !WRITE DISK - LOGICAL WNGGVA !GET MEMORY - INTEGER WNFEOF !EOF POINTER - CHARACTER*32 WNTTSG !SHOW SET - LOGICAL NGCSTG !GET A PLOT -C -C Data declarations: -C - INTEGER NDONE ! cuts-done counter - INTEGER NGFP !PLOT HEADER PTR - INTEGER SNAM(0:7) !PLOT NAME - INTEGER SGNR1(0:7) !OUTPUT NAME - INTEGER SGPH1(0:7) !OUTPUT POINTER - INTEGER BUFAD !DATA BUFFER ADDRESS - INTEGER BLEN !DATA BUFFER LENGTH - LOGICAL ILTEST !INDEFINITE LOOP TEST - LOGICAL LFIRST !FIRST LOOP - BYTE NGF(0:NGFHDL-1) !PLOT HEADER - INTEGER*2 NGFI(0:NGFHDL/2-1) - INTEGER NGFJ(0:NGFHDL/4-1) - REAL NGFE(0:NGFHDL/4-1) - EQUIVALENCE (NGF,NGFI,NGFJ,NGFE) - CHARACTER*40 TX40 ! output TYP buffer - CHARACTER*8 HSTR ! input TYP buffer -C- -C -C GET OUTPUT NODE -C - LFIRST=.TRUE. !FIRST OUTPUT - 10 CONTINUE - FILIN='*' !MAKE SURE NO CLOSE - IF (LFIRST) THEN - IF (.NOT.WNDNOD('OUTPUT_NGF_NODE','*','NGF','U', - 1 NODIN,FILIN)) THEN - 13 CONTINUE - IF (E_C.EQ.DWC_ENDOFLOOP) THEN - FILIN='*' - GOTO 900 !READY - END IF - GOTO 10 - END IF - ELSE - IF (.NOT.WNDNOD('OUTPUT_NGF_NODE','""','NGF','U', - 1 NODIN,FILIN)) GOTO 13 - END IF - IF (E_C.EQ.DWC_NULLVALUE) THEN - FILIN='*' - GOTO 900 !READY - END IF - IF (E_C.EQ.DWC_WILDCARD) THEN - FILIN='*' !INDICATE INPUT - NODIN='*' - FCAIN=FCAOUT - ELSE - IF (.NOT.WNFOP(FCAIN,FILIN,'U')) THEN - CALL WNCTXT(F_TP,'!/Cannot open output file') - GOTO 10 - END IF - END IF -C -C GET PLOTS -C - 11 CONTINUE - IF (.NOT.WNDSTA('NGF_SETS',MXNPLT,SETS(0,0),FCAOUT)) THEN - 12 CONTINUE - IF (FILIN.NE.'*') CALL WNFCL(FCAIN) !CLOSE OUTPUT - GOTO 10 !GET PLOTS TO DO - END IF - ILTEST=.TRUE. !INDEFINITE LOOP TEST - IF (FILIN.NE.'*') THEN !CREATE NEW OUTPUT - IF (.NOT.WNDLNG(GFH_LINKG_1,0,SGH_GROUPN_1,FCAIN, - 1 SGPH1(0),SGNR1(0))) THEN !CREATE JOB SET - CALL WNCTXT(F_TP,'!/Cannot create sub-group') - GOTO 12 !REPEAT - END IF - ELSE - SGNR1(0)=SGNR(0) !COPY - SGPH1(0)=SGPH(0) - END IF -C -C DO FOR ALL PLOTS -C - NDONE=0 - DO WHILE (NGCSTG(FCAOUT,SETS,NGF,NGFP,SNAM)) - LFIRST=.FALSE. !AT LEAST ONE COPIED - CALL WNDSTI(FCAOUT,SNAM) !MAKE PROPER NAME - 21 CONTINUE - IF (FILIN.EQ.'*' .AND. SNAM(0).GE.SGNR(0)) THEN !CAN BE INFINITE LOOP - IF (.NOT.ILTEST) GOTO 12 !INFINITE LOOP - IF (.NOT.WNDLNG(GFH_LINKG_1,0,SGH_GROUPN_1,FCAOUT, - 1 SGPH(0),SGNR(0))) THEN !CREATE JOB SET - CALL WNCTXT(F_TP,'!/Cannot create sub-group') - GOTO 12 !REPEAT - END IF - ILTEST=.FALSE. !CAN BE LOOP - SGNR1(0)=SGNR(0) !COPY - SGPH1(0)=SGPH(0) - GOTO 21 - END IF -C -C ACTION -C - 30 CONTINUE - BLEN=2*LB_X*NGFJ(NGF_SCN_J) !LENGTH DATA BUFFER - IF (.NOT.WNGGVA(BLEN,BUFAD)) THEN - CALL WNCTXT(F_TP,'!/Cannot get file databuffer') - GOTO 900 - END IF - BUFAD=(BUFAD-A_OB)/LB_X - IF (.NOT.WNFRD(FCAOUT,LB_X*NGFJ(NGF_SCN_J),A_X(BUFAD), - 1 NGFJ(NGF_DPT_J))) THEN !READ DATA - 31 CONTINUE - CALL WNCTXT(F_TP,'!/Error reading/writing plot data') - 32 CONTINUE - CALL WNGFVA(BLEN,BUFAD*LB_X+A_OB) !FREE BUFFER - GOTO 12 - END IF -C -C COPY -C - CALL WNDSTI(FCAOUT,SNAM) !MAKE PROPER NAME - - CALL WNGMTS(8, NGF(NGF_TYP_1), HSTR) - DO I=1,8 - IF (HSTR(I:I).LT.'A' .OR. HSTR(I:I).GT.'Z') GOTO 511 - ENDDO -511 CONTINUE - I=I-1 - - CALL WNCTXS(TX40,'!AS COPY !AS !AS', - 1 HSTR(1:I),NODOUT,WNTTSG(SNAM,0)) !DATA TYPE - CALL WNGMFS(NGF_TYP_N,TX40,NGF(NGF_TYP_1)) - IF (.NOT.WNDLNF(SGPH1(0)+SGH_LINKG_1,SNAM(1), - 1 SGH_GROUPN_1,FCAIN,SGPH1(1),SGNR1(1))) THEN !LINK - 51 CONTINUE - CALL WNCTXT(F_TP,'!/Cannot link sub-group') - GOTO 32 - END IF - IF (.NOT.WNDLNF(SGPH1(1)+SGH_LINKG_1,SNAM(2), - 1 SGH_GROUPN_1,FCAIN,SGPH1(2),SGNR1(2))) GOTO 51 - IF (.NOT.WNDLNF(SGPH1(2)+SGH_LINKG_1,SNAM(3), - 1 SGH_GROUPN_1,FCAIN,SGPH1(3),SGNR1(3))) GOTO 51 - IF (.NOT.WNDLNF(SGPH1(3)+SGH_LINKG_1,SNAM(4), - 1 SGH_GROUPN_1,FCAIN,SGPH1(4),SGNR1(4))) GOTO 51 - J=WNFEOF(FCAIN) !OUTPUT POINTER - NGFJ(NGF_DPT_J)=J+NGFHDL !DATA POINTER - IF (.NOT.WNFWR(FCAIN,NGFHDL,NGF,J)) GOTO 31 !WRITE HEADER - IF (.NOT.WNFWR(FCAIN,LB_X*NGFJ(NGF_SCN_J), - 1 A_X(BUFAD),J+NGFHDL)) GOTO 31 !DATA - IF (.NOT.WNDLNK(GFH_LINK_1,J, - 1 NGF_SETN_1,FCAIN)) GOTO 51 !LINK DATA - IF (.NOT.WNDLNG(SGPH1(4)+SGH_LINKG_1,J, - 1 SGH_GROUPN_1,FCAIN,SGPH1(5),SGNR1(5))) GOTO 51 !INDEX - NDONE=NDONE+1 - IF (MOD(NDONE,100).EQ.0) CALL NGCSPL(SGNR1,NGF,NDONE) ! sign of life -C - CALL WNGFVA(BLEN,BUFAD*LB_X+A_OB) !FREE BUFFER - 20 CONTINUE - ENDDO !NEXT PLOT - CALL WNCTXT(F_TP,'!UJ cuts copied',NDONE) - GOTO 12 -C -C READY -C - 900 CONTINUE - IF (FILIN.NE.'*') CALL WNFCL(FCAIN) !CLOSE OUTPUT - FCAIN=0 !MAKE SURE -C - RETURN -C -C - END diff --git a/src/nplot/ngcdat.for b/src/nplot/ngcdat.for deleted file mode 100644 index bef68ce95b9d15a2cf7f0742039366acc46dda8c..0000000000000000000000000000000000000000 --- a/src/nplot/ngcdat.for +++ /dev/null @@ -1,165 +0,0 @@ -C+ NGCDAT.FOR -C WNB 920819 -C -C Revisions: -C HjV 930423 Change name of some keywords -C WNB 930824 Change interferometer/telescope select -C WNB 930825 Change pol. selection -C CMV 931220 Pass FCA of input file to WNDXLP and WNDSTA/Q -C HjV 940428 Add plotting of IF data -C JPH 940822 Remove subgroup creation. (Is done by action routines) -C Open SCN file read-only -C -C - SUBROUTINE NGCDAT -C -C Get NGCALC program parameters -C -C Result: -C -C CALL NGCDAT will ask and set all program parameters -C -C PIN references: -C -C ACTION -C NGF_NODE -C SCN_SETS Sets to do -C EXTRACT_TYPE Type of data -C IF_MODE -C -C Include files: -C - INCLUDE 'WNG_DEF' - INCLUDE 'GFH_O_DEF' !GENERAL FILE HEADER - INCLUDE 'SGH_O_DEF' !SUB-GROUP HEADER - INCLUDE 'STH_O_DEF' - INCLUDE 'NGC_DEF' -C -C Parameters: -C -C -C Arguments: -C -C -C Function references: -C - LOGICAL WNDPAR !GET DWARF PARAMETER - LOGICAL WNDSTA !GET SETS TO DO - LOGICAL WNDNOD !GET NODE NAME - LOGICAL WNDLNG !LINK SUB-GROUP - LOGICAL WNFOP !OPEN FILE - LOGICAL NSCSTG !FIND A SET - LOGICAL NSCIF1 !SELECT INTERFEROMETERS - LOGICAL NSCTL1 !SELECT TELESCOPES - LOGICAL NSCPLS !SELECT POLARISATION -C -C Data declarations: -C - INTEGER SETNAM(0:7) !SET NAME - INTEGER STHP !SET POINTER - BYTE STH(0:STH__L-1) !SET HEADER - INTEGER STHJ(0:STH__L/LB_J-1) - EQUIVALENCE (STH,STHJ) -C- -C -C GET DATA NODE -C - 10 CONTINUE - IF (FCAOUT.EQ.0) THEN !NO NODE PRESENT - IF (.NOT.WNDNOD('NGF_NODE',NODOUT,'NGF', - 1 'U',NODOUT,FILOUT)) THEN - IF (E_C.EQ.DWC_ENDOFLOOP) THEN - OPT='QUIT' !ASSUME END - GOTO 100 - END IF - GOTO 10 !REPEAT - ELSE IF (E_C.EQ.DWC_NULLVALUE) THEN - GOTO 10 !RETRY - ELSE IF (E_C.EQ.DWC_WILDCARD) THEN - GOTO 10 !MUST SPECIFY - END IF - IF (.NOT.WNFOP(FCAOUT,FILOUT,'U')) THEN !OUTPUT NGF FILE - GOTO 10 !RETRY - END IF - END IF -C -C GET ACTION -C - 20 CONTINUE - IF (.NOT.WNDPAR('ACTION',OPTION,LEN(OPTION),J0,'QUIT')) THEN - OPTION='QUIT' !ASSUME END - ELSE IF (J0.LE.0) THEN - OPTION='QUIT' !ASSUME END - END IF -C -C EXTRACT -C - IF (OPT.EQ.'EXT') THEN - 110 CONTINUE - IF (.NOT.WNDNOD('SCN_NODE',NODIN,'SCN','R',NODIN,FILIN)) THEN - IF (E_C.EQ.DWC_ENDOFLOOP) GOTO 20 !FORGET - GOTO 110 !RETRY - ELSE IF (E_C.EQ.DWC_NULLVALUE) THEN - GOTO 20 !FORGET - ELSE IF (E_C.EQ.DWC_WILDCARD) THEN - GOTO 110 !MUST SPECIFY - END IF - IF (.NOT.WNFOP(FCAIN,FILIN,'R')) GOTO 110 !OPEN INPUT -C -C GET SETS -C - 111 CONTINUE - IF (.NOT.WNDSTA('SCN_SETS',MXNSET,SETS(0,0),FCAIN)) THEN !GET SETS TO DO - 116 CONTINUE - CALL WNFCL(FCAIN) - GOTO 110 - END IF - IF (.NOT.NSCSTG(FCAIN,SETS,STH,STHP,SETNAM)) GOTO 116 !FIND A SET - CALL WNDSTR(FCAIN,SETS) !RESET SET SEARCH -C -C GET POLARISATION -C - 112 CONTINUE - IF (.NOT.NSCPLS(0,SPOL)) GOTO 116 !GET POL. TO DO -C -C CORRECTIONS -C - CALL NSCSAD(CORAP,CORDAP) !GET CORRECTIONS WANTED -C -C EXTRACT TYPE -C - 113 CONTINUE - IF (.NOT.WNDPAR('EXTRACT_TYPE',SOPT,LEN(SOPT), - 1 J0,'QUIT')) THEN - IF (E_C.EQ.DWC_ENDOFLOOP) GOTO 112 !RETRY POL. - GOTO 113 - END IF - IF (J0.EQ.0) GOTO 112 !RETRY POL - IF (J0.LT.0) GOTO 113 !MUST SPECIFY - IF (SOPT.EQ.'QUIT') GOTO 111 - IF_MODE=' ' - IF (SOPT.EQ.'IFDATA') THEN !Get IF Option - IF (.NOT.WNDPAR('IF_MODE',IF_MODE,LEN(IF_MODE),J0, - 1 'TSYS')) THEN - GOTO 20 !RETRY OPTION - ELSE IF (J0.LE.0) THEN - IF_MODE='TSYS' - END IF - SOPT='T' - END IF - IF (SOPT(1:1).EQ.'T') THEN - 114 CONTINUE - IF(.NOT.NSCTL1(1,STELS,STHJ)) GOTO 113 !SELECT TELESCOPES - ELSE - IF (.NOT.NSCIF1(4,SIFR,STHJ)) GOTO 113 !GET IFRS TO DO - END IF - END IF -C -C READY -C - 100 CONTINUE -C - RETURN -C -C - END diff --git a/src/nplot/ngcexc.for b/src/nplot/ngcexc.for deleted file mode 100644 index 0f13d7794036fb18824a2ed6828dd95b931bb9e7..0000000000000000000000000000000000000000 --- a/src/nplot/ngcexc.for +++ /dev/null @@ -1,473 +0,0 @@ -C+ NGCEXC.FOR -C WNB 920821 -C -C Revisions: -C WNB 930630 Add functions 78-83; change HA value for transpose -C WNB 930711 Correct REAL, IMAG, PHASE, AMPL -C - LOGICAL FUNCTION NGCEXC(COD,LCOD,PLOT,HA,UT,FQ,BL,RA,DEC,VALUE) -C -C Calculate expression -C -C Result: -C -C NGCEXC_L = NGCEXC( COD_J(*):I, LCOD_B(4,*):I, PLOT_X(*):I, HA_E:I, -C UT_E:I, FQ_E:I, BL_E:I, RA_E:I, DEC_E:I, -C VALUE_X:O) -C Calculate VALUE using program in COD, and -C values in PLOT. HA is hour angle of current -C execution; as are UTime, FreQ, BaseLine, -C RA, DEC -C -C Include files: -C - INCLUDE 'WNG_DEF' - INCLUDE 'NGC_DEF' -C -C Parameters: -C -C -C Arguments: -C - INTEGER COD(*) !EXECUTABLE CODES - BYTE LCOD(4,*) - COMPLEX PLOT(*) !PLOT VALUES - REAL HA !HA OF THIS POINT (DEG) - REAL UT !UT OF THIS POINT (DEG) - REAL FQ !FQ OF THIS POINT (MHZ) - REAL BL !BL OF THIS POINT (M) - REAL RA !RA OF THIS POINT (DEG) - REAL DEC !DEC OF THIS POINT (DEG) - COMPLEX VALUE !RETURNED VALUE -C -C Function references: -C - REAL WNMEEF !FLOOR - REAL WNMEEC !CEIL -C -C Data declarations: -C - INTEGER CDP !CODE POINTER - INTEGER NVAL !VALUES ON STACK - COMPLEX VAL(256) !VALUE STACK -C- -C -C INIT -C - NGCEXC=.TRUE. !ASSUME OK - NVAL=0 !NO VALUES - CDP=0 !CODE POINTER -C -C EXECUTE CODE -C -10000 CONTINUE - CDP=CDP+1 !NEXT CODE - IF (COD(CDP).EQ.0) THEN !READY -12000 CONTINUE - IF (NVAL.EQ.1) THEN !OK - VALUE=VAL(NVAL) !RETURN VALUE - ELSE !SOMETHING WRONG -11000 CONTINUE - NGCEXC=.FALSE. !ERROR - VALUE=CMPLX(NGCDLC,NGCDLC) !DELETE CODE - END IF -C - RETURN - END IF - IF (LCOD(1,CDP).LT.30) THEN !NORMAL OPERATION - GOTO (10,20,30,40,50,60,70,80,90,100,110,120,130,140,150, - 1 160,170,180) LCOD(1,CDP) !DISTRIBUTE - ELSE !FUNCTION - GOTO (500,510,520,530,540,550,560,570,580,590,600,610,620, - 1 630,640,650,660,670,680,690,700,710,720,730,740, - 1 750,760,770,780,790,800,810,820,830,840,850) - 1 LCOD(1,CDP)-49 !DISTRIBUTE - END IF - GOTO 11000 !ERROR -C -C OPERATORS -C -C + - 10 CONTINUE - IF (NVAL.LT.1) GOTO 11000 !CANNOT DO - GOTO 10000 !NOP -C - - 20 CONTINUE - IF (NVAL.LT.1) GOTO 11000 !CANNOT DO - VAL(NVAL)=-VAL(NVAL) - GOTO 10000 -C **, ^ - 30 CONTINUE - IF (NVAL.LT.2) GOTO 11000 !CANNOT DO - J=NINT(ABS(VAL(NVAL))) !DO ONLY FOR INTEGER EXPONENT - IF (ABS(VAL(NVAL)).NE.J .OR. J.GT.30) THEN - 31 CONTINUE - NVAL=1 !SET DELETE CODE - VAL(NVAL)=CMPLX(NGCDLC,NGCDLC) - GOTO 12000 - END IF - VAL(NVAL-1)=VAL(NVAL-1)**J !CALCULATE - 32 CONTINUE - NVAL=NVAL-1 - GOTO 10000 -C * - 40 CONTINUE - IF (NVAL.LT.2) GOTO 11000 !CANNOT DO - VAL(NVAL-1)=VAL(NVAL-1)*VAL(NVAL) - GOTO 32 -C / - 50 CONTINUE - IF (NVAL.LT.2) GOTO 11000 !CANNOT DO - IF (ABS(VAL(NVAL)).GT.1.E-20) THEN - VAL(NVAL-1)=VAL(NVAL-1)/VAL(NVAL) - ELSE - VAL(NVAL-1)=CMPLX(1.,0.) - END IF - GOTO 32 -C + - 60 CONTINUE - IF (NVAL.LT.2) GOTO 11000 !CANNOT DO - VAL(NVAL-1)=VAL(NVAL-1)+VAL(NVAL) - GOTO 32 -C - - 70 CONTINUE - IF (NVAL.LT.2) GOTO 11000 !CANNOT DO - VAL(NVAL-1)=VAL(NVAL-1)-VAL(NVAL) - GOTO 32 -C >= - 80 CONTINUE - IF (NVAL.LT.2) GOTO 11000 !CANNOT DO - IF (ABS(VAL(NVAL-1)).GE.ABS(VAL(NVAL))) THEN - VAL(NVAL-1)=CMPLX(1.,0.) - ELSE - VAL(NVAL-1)=CMPLX(0.,0.) - END IF - GOTO 32 -C <= - 90 CONTINUE - IF (NVAL.LT.2) GOTO 11000 !CANNOT DO - IF (ABS(VAL(NVAL-1)).LE.ABS(VAL(NVAL))) THEN - VAL(NVAL-1)=CMPLX(1.,0.) - ELSE - VAL(NVAL-1)=CMPLX(0.,0.) - END IF - GOTO 32 -C = - 100 CONTINUE - IF (NVAL.LT.2) GOTO 11000 !CANNOT DO - IF (ABS(VAL(NVAL-1)).EQ.ABS(VAL(NVAL))) THEN - VAL(NVAL-1)=CMPLX(1.,0.) - ELSE - VAL(NVAL-1)=CMPLX(0.,0.) - END IF - GOTO 32 -C < - 110 CONTINUE - IF (NVAL.LT.2) GOTO 11000 !CANNOT DO - IF (ABS(VAL(NVAL-1)).LT.ABS(VAL(NVAL))) THEN - VAL(NVAL-1)=CMPLX(1.,0.) - ELSE - VAL(NVAL-1)=CMPLX(0.,0.) - END IF - GOTO 32 -C > - 120 CONTINUE - IF (NVAL.LT.2) GOTO 11000 !CANNOT DO - IF (ABS(VAL(NVAL-1)).GT.ABS(VAL(NVAL))) THEN - VAL(NVAL-1)=CMPLX(1.,0.) - ELSE - VAL(NVAL-1)=CMPLX(0.,0.) - END IF - GOTO 32 -C <> - 130 CONTINUE - IF (NVAL.LT.2) GOTO 11000 !CANNOT DO - IF (ABS(VAL(NVAL-1)).NE.ABS(VAL(NVAL))) THEN - VAL(NVAL-1)=CMPLX(1.,0.) - ELSE - VAL(NVAL-1)=CMPLX(0.,0.) - END IF - GOTO 32 -C <> UNARY - 140 CONTINUE - IF (NVAL.LT.1) GOTO 11000 !CANNOT DO - IF (ABS(VAL(NVAL)).NE.0.) THEN - VAL(NVAL)=CMPLX(0.,0.) - ELSE - VAL(NVAL)=CMPLX(1.,0.) - END IF - GOTO 10000 -C & - 150 CONTINUE - IF (NVAL.LT.2) GOTO 11000 !CANNOT DO - IF (ABS(VAL(NVAL-1)).NE.0. .AND. ABS(VAL(NVAL)).NE.0.) THEN - VAL(NVAL-1)=CMPLX(1.,0.) - ELSE - VAL(NVAL-1)=CMPLX(0.,0.) - END IF - GOTO 32 -C ! - 160 CONTINUE - IF (NVAL.LT.2) GOTO 11000 !CANNOT DO - IF (ABS(VAL(NVAL-1)).NE.0. .OR. ABS(VAL(NVAL)).NE.0.) THEN - VAL(NVAL-1)=CMPLX(1.,0.) - ELSE - VAL(NVAL-1)=CMPLX(0.,0.) - END IF - GOTO 32 -C PLOT VALUE - 170 CONTINUE - NVAL=NVAL+1 !GET VALUE - CDP=CDP+1 - J=COD(CDP) !# OF PLOT - VAL(NVAL)=PLOT(J) - IF (REAL(VAL(NVAL)).EQ.NGCDLC) GOTO 31 !READY - GOTO 10000 -C CONSTANT VALUE - 180 CONTINUE - NVAL=NVAL+1 - CDP=CDP+1 - CALL WNGMV(LB_E,COD(CDP),R0) !SET VALUE - VAL(NVAL)=CMPLX(R0,0.) - GOTO 10000 -C -C FUNCTIONS -C -C ATAN1 - 500 CONTINUE - IF (NVAL.LT.1) GOTO 11000 !CANNOT DO - IF (VAL(NVAL)*VAL(NVAL).EQ.CMPLX(0.,-1.)) THEN - VAL(NVAL)=CMPLX(0.,0.) - ELSE - R0=REAL(VAL(NVAL)) - R1=AIMAG(VAL(NVAL)) - VAL(NVAL)=CMPLX(0.5*ATAN2(2*R0,1-R0*R0-R1*R1), - 1 0.25*LOG((R0*R0+(R1+1)**2)/ - 1 (R0*R0+(R1-1)**2)))*DEG - END IF - GOTO 10000 -C ATAN2 - 510 CONTINUE - IF (NVAL.LT.2) GOTO 11000 !CANNOT DO - IF (ABS(VAL(NVAL-1)).EQ.0. .AND. - 1 ABS(VAL(NVAL)).EQ.0.) THEN - VAL(NVAL-1)=CMPLX(0.,0.) - ELSE IF(ABS(VAL(NVAL)).EQ.0) THEN - VAL(NVAL-1)=CMPLX(PI/2.,0.) - ELSE - VAL(NVAL-1)=VAL(NVAL-1)/VAL(NVAL) - R0=REAL(VAL(NVAL-1)) - R1=AIMAG(VAL(NVAL-1)) - VAL(NVAL-1)=CMPLX(0.5*ATAN2(2*R0,1-R0*R0-R1*R1), - 1 0.25*LOG((R0*R0+(R1+1)**2)/ - 1 (R0*R0+(R1-1)**2)))*DEG - END IF - GOTO 32 -C SIN - 520 CONTINUE - IF (NVAL.LT.1) GOTO 11000 !CANNOT DO - VAL(NVAL)=SIN(VAL(NVAL)/DEG) - GOTO 10000 -C COS - 530 CONTINUE - IF (NVAL.LT.1) GOTO 11000 !CANNOT DO - VAL(NVAL)=COS(VAL(NVAL)/DEG) - GOTO 10000 -C ASIN - 540 CONTINUE - IF (NVAL.LT.1) GOTO 11000 !CANNOT DO - IF (ABS(VAL(NVAL)).GT.1.) THEN - GOTO 31 !ILLEGAL - ELSE - VAL(NVAL)=-CMPLX(0.,1.)* - 1 LOG(SQRT(CMPLX(1.,0.)-VAL(NVAL)*VAL(NVAL))+ - 1 CMPLX(0.,1.)*VAL(NVAL))*DEG - END IF - GOTO 10000 -C ACOS - 550 CONTINUE - IF (NVAL.LT.1) GOTO 11000 !CANNOT DO - IF (ABS(VAL(NVAL)).GT.1.) THEN - GOTO 31 !ILLEGAL - ELSE - VAL(NVAL)=-CMPLX(0.,1.)* - 1 LOG(CMPLX(0.,1.)* - 1 SQRT(CMPLX(1.,0.)-VAL(NVAL)*VAL(NVAL))+ - 1 VAL(NVAL))*DEG - END IF - GOTO 10000 -C EXP - 560 CONTINUE - IF (NVAL.LT.1) GOTO 11000 !CANNOT DO - VAL(NVAL)=EXP(VAL(NVAL)) - GOTO 10000 -C EXP10 - 570 CONTINUE - IF (NVAL.LT.1) GOTO 11000 !CANNOT DO - VAL(NVAL)=EXP(VAL(NVAL)*LOG(10.)) - GOTO 10000 -C EXP2 - 580 CONTINUE - IF (NVAL.LT.1) GOTO 11000 !CANNOT DO - VAL(NVAL)=EXP(VAL(NVAL)*LOG(2.)) - GOTO 10000 -C LOG - 590 CONTINUE - IF (NVAL.LT.1) GOTO 11000 !CANNOT DO - IF (ABS(VAL(NVAL)).LT.1.E-30) THEN - GOTO 31 !SET DELETE CODE - ELSE - VAL(NVAL)=LOG(VAL(NVAL)) - END IF - GOTO 10000 -C LOG10 - 600 CONTINUE - IF (NVAL.LT.1) GOTO 11000 !CANNOT DO - IF (ABS(VAL(NVAL)).LT.1.E-30) THEN - GOTO 31 !SET DELETE CODE - ELSE - VAL(NVAL)=LOG(VAL(NVAL))/LOG(10.) - END IF - GOTO 10000 -C LOG2 - 610 CONTINUE - IF (NVAL.LT.1) GOTO 11000 !CANNOT DO - IF (ABS(VAL(NVAL)).LT.1.E-30) THEN - GOTO 31 !SET DELETE CODE - ELSE - VAL(NVAL)=LOG(VAL(NVAL))/LOG(2.) - END IF - GOTO 10000 -C PI - 620 CONTINUE - NVAL=NVAL+1 - VAL(NVAL)=CMPLX(PI,0.) - GOTO 10000 -C EE - 630 CONTINUE - NVAL=NVAL+1 - VAL(NVAL)=CMPLX(EXP(1.),0.) - GOTO 10000 -C ABS - 640 CONTINUE - IF (NVAL.LT.1) GOTO 11000 !CANNOT DO - VAL(NVAL)=ABS(VAL(NVAL)) - GOTO 10000 -C FLOOR - 650 CONTINUE - IF (NVAL.LT.1) GOTO 11000 !CANNOT DO - VAL(NVAL)=CMPLX(WNMEEF(REAL(VAL(NVAL))), - 1 WNMEEF(AIMAG(VAL(NVAL)))) - GOTO 10000 -C CEIL - 660 CONTINUE - IF (NVAL.LT.1) GOTO 11000 !CANNOT DO - VAL(NVAL)=CMPLX(WNMEEC(REAL(VAL(NVAL))), - 1 WNMEEC(AIMAG(VAL(NVAL)))) - GOTO 10000 -C ROUND - 670 CONTINUE - IF (NVAL.LT.1) GOTO 11000 !CANNOT DO - VAL(NVAL)=CMPLX(ANINT(REAL(VAL(NVAL))), - 1 ANINT(AIMAG(VAL(NVAL)))) - GOTO 10000 -C INT - 680 CONTINUE - IF (NVAL.LT.1) GOTO 11000 !CANNOT DO - VAL(NVAL)=CMPLX(AINT(REAL(VAL(NVAL))), - 1 AINT(AIMAG(VAL(NVAL)))) - GOTO 10000 -C FRACT - 690 CONTINUE - IF (NVAL.LT.1) GOTO 11000 !CANNOT DO - VAL(NVAL)=VAL(NVAL)-CMPLX(AINT(REAL(VAL(NVAL))), - 1 AINT(AIMAG(VAL(NVAL)))) - GOTO 10000 -C REAL - 700 CONTINUE - IF (NVAL.LT.1) GOTO 11000 !CANNOT DO - VAL(NVAL)=CMPLX(REAL(VAL(NVAL)),0.) - GOTO 10000 -C IMAG - 710 CONTINUE - IF (NVAL.LT.1) GOTO 11000 !CANNOT DO - VAL(NVAL)=CMPLX(AIMAG(VAL(NVAL)),0.) - GOTO 10000 -C AMPL - 720 CONTINUE - IF (NVAL.LT.1) GOTO 11000 !CANNOT DO - VAL(NVAL)=CMPLX(ABS(VAL(NVAL)),0.) - GOTO 10000 -C PHASE - 730 CONTINUE - IF (NVAL.LT.1) GOTO 11000 !CANNOT DO - IF (REAL(VAL(NVAL)).EQ.0. .AND. AIMAG(VAL(NVAL)).EQ.0.) THEN - VAL(NVAL)=CMPLX(0.,0.) - ELSE - VAL(NVAL)=CMPLX(ATAN2(AIMAG(VAL(NVAL)), - 1 REAL(VAL(NVAL)))*DEG,0.) - END IF - GOTO 10000 -C SQRT - 740 CONTINUE - IF (NVAL.LT.1) GOTO 11000 !CANNOT DO - VAL(NVAL)=SQRT(VAL(NVAL)) - GOTO 10000 -C HA - 750 CONTINUE - NVAL=NVAL+1 - VAL(NVAL)=CMPLX(HA,0.) - GOTO 10000 -C UT - 760 CONTINUE - NVAL=NVAL+1 - VAL(NVAL)=CMPLX(UT,0.) - GOTO 10000 -C IMUL - 770 CONTINUE - IF (NVAL.LT.1) GOTO 11000 !CANNOT DO - VAL(NVAL)=VAL(NVAL)*CMPLX(0.,1.) - GOTO 10000 -C CC - 780 CONTINUE - NVAL=NVAL+1 - VAL(NVAL)=CMPLX(CL/1E6,0.) - GOTO 10000 -C DRAD - 790 CONTINUE - NVAL=NVAL+1 - VAL(NVAL)=CMPLX(DEG,0.) - GOTO 10000 -C FQ - 800 CONTINUE - NVAL=NVAL+1 - VAL(NVAL)=CMPLX(FQ,0.) - GOTO 10000 -C BL - 810 CONTINUE - NVAL=NVAL+1 - VAL(NVAL)=CMPLX(BL,0.) - GOTO 10000 -C UU - 820 CONTINUE - NVAL=NVAL+1 - VAL(NVAL)=CMPLX(FQ/CL/1E-6*COS(HA/DEG),0.) - GOTO 10000 -C VV - 830 CONTINUE - NVAL=NVAL+1 - VAL(NVAL)=CMPLX(-FQ/CL/1E-6*SIN(HA/DEG)*SIN(DEC/DEG),0.) - GOTO 10000 -C RA - 840 CONTINUE - NVAL=NVAL+1 - VAL(NVAL)=CMPLX(RA,0.) - GOTO 10000 -C DEC - 850 CONTINUE - NVAL=NVAL+1 - VAL(NVAL)=CMPLX(DEC,0.) - GOTO 10000 -C -C - END diff --git a/src/nplot/ngcexn.for b/src/nplot/ngcexn.for deleted file mode 100644 index 48321418e7d8fdf225a079c75ef36f82493928ac..0000000000000000000000000000000000000000 --- a/src/nplot/ngcexn.for +++ /dev/null @@ -1,196 +0,0 @@ -C+ NGCEXN.FOR -C WNB 920819 -C -C Revisions: -C - LOGICAL FUNCTION NGCEX1(TCOD,LTCOD,COD,CDP,RPS,LRPS,RPP,LRPP,NVAL) -C -C Help analyze expression -C -C Result: -C -C NGCEX1_L = NGCEX1( TCOD_J:I, LTCOD_B(4):I, COD_J(*):O, CDP_J(*):IO, -C RPS_J(*):IO, LRPS_B(4,*):IO, RPP_J:IO, -C LRPP_J:IO, NVAL_J:I) -C Set TCOD in reverse polish stack -C and cleanup Reverse Polish stack -C RPS, by putting into executable -C stack COD if possible. LRPP is -C the current low RPP, and NVAL -C the current # of values on -C the COD stack. -C NGCEX2_L = NGCEX2( N_J:I, STR_C*:I, STP_J:IO) -C Update string pointer STP into -C string STR with N. Error if -C beyond end-of-string. -C NGCEX3_L = NGCEX3( TCOD_J:I, LTCOD_B(4):I, COD_J(*):O, CDP_J(*):IO, -C RPS_J(*):IO, LRPS_B(4,*):IO, RPP_J:IO, -C LRPP_J:IO, NVAL_J:I) -C Set TCOD in RPS. -C NGCEX4_L = NGCEX4( TCOD_J:I, LTCOD_B(4):I, COD_J(*):O, CDP_J(*):IO, -C RPS_J(*):IO, LRPS_B(4,*):IO, RPP_J:IO, -C LRPP_J:IO, NVAL_J:I) -C Set TCOD in COD stack. -C -C -C Include files: -C - INCLUDE 'WNG_DEF' -C -C Parameters: -C -C -C Arguments: -C - INTEGER TCOD !EXECUTABLE CODE - BYTE LTCOD(4) - INTEGER COD(*) !EXECUTABLE STACK - INTEGER CDP !COD POINTER - INTEGER RPS(*) !REVERSE POLISH STACK - BYTE LRPS(4,*) - INTEGER RPP !RPS POINTER - INTEGER LRPP !LOW CURRENT RPP - INTEGER NVAL !# OF VALUES ON COD - INTEGER N !STRING SKIP - CHARACTER*(*) STR !STRING - INTEGER STP !STR POINTER -C -C Entry points -C - LOGICAL NGCEX2 - LOGICAL NGCEX3 - LOGICAL NGCEX4 -C -C Function references: -C -C -C Data declarations: -C -C- -C -C NGCEX1 -C - NGCEX1=.TRUE. -C - DO WHILE (RPP.GT.LRPP) !CHECK ALL ON RPS - IF (LTCOD(2).LT.LRPS(2,RPP)) THEN !NEW PRIORITY LESS THAN OLD - 11 CONTINUE - CDP=CDP+1 !SET ON CODE STACK - COD(CDP)=RPS(RPP) - IF (NVAL.LT.LRPS(3,RPP)) THEN !NOT ENOUGH VALUES FOR OPERATION - 12 CONTINUE - NGCEX1=.FALSE. -C - RETURN - END IF - NVAL=NVAL-LRPS(4,RPP) !UPDATE # VALUES ON STACK - RPP=RPP-1 !DELETE FROM RPS - ELSE IF (LTCOD(2).GT.LRPS(2,RPP)) THEN !NEW PRIORITY GREATHER THAN OLD - 10 CONTINUE - GOTO 20 !CANNOT CLEAN RPS - ELSE !NEW PRIORITY EQUAL OLD - IF (LTCOD(2).GE.44) THEN - GOTO 10 !EXECUTE RIGHT-TO-LEFT - ELSE - GOTO 11 !EXECUTE LEFT-TO RIGHT - END IF - END IF - END DO -C -C SPECIAL TCOD -C - 20 CONTINUE - IF (LTCOD(1).GE.40) THEN !SAVE ENVIRONMENT ( FUNC, ( ...) - RPS(RPP+1)=TCOD !SET TYPE - RPS(RPP+2)=0 !ARGUMENT COUNT - RPS(RPP+3)=NVAL !OLD NVAL - NVAL=0 - RPS(RPP+4)=LRPP !OLD LOW RPS POINTER - RPP=RPP+4 !NEW RPS START - LRPP=RPP !CONTINUE IF START - ELSE IF (LTCOD(1).GE.30) THEN !SPECIAL FINAL CODES - IF (LTCOD(1).EQ.30) THEN !, - IF (LRPP.NE.RPP .OR. LRPP.LT.4 .OR. NVAL.NE.1) GOTO 12 !ERROR - RPS(LRPP-2)=RPS(LRPP-2)+1 !COUNT ARGUMENTS - NVAL=0 !START AFRESH - ELSE IF (LTCOD(1).EQ.31) THEN !END OF STRING - IF (LRPP.NE.RPP .OR. LRPP.NE.0 .OR. NVAL.NE.1) GOTO 12 !ERROR - CDP=CDP+1 - COD(CDP)=0 !END OF ALL - ELSE IF (LTCOD(1).EQ.32) THEN !) - IF (LRPP.NE.RPP .OR. LRPP.LT.4) GOTO 12 !ERROR - IF (LRPS(1,LRPP-3).EQ.40) THEN !() - IF (NVAL.NE.1) GOTO 12 !ERROR - NVAL=RPS(LRPP-1)+NVAL !RESTORE NVAL - LRPP=RPS(LRPP) !RESTORE PREVIOUS ENVIRONMENT - RPP=RPP-4 !DELETE ENVIRONMENT FROM RPS - ELSE IF (LRPS(1,LRPP-3).GE.50) THEN !FUNCTION - IF (NVAL.NE.1) THEN - IF (LRPS(3,LRPP-3).EQ.0 .AND. NVAL.EQ.0) THEN !OK - ELSE - GOTO 12 !ERROR - END IF - END IF - RPS(LRPP-2)=RPS(LRPP-2)+NVAL !COUNT ARGUMENTS - IF (RPS(LRPP-2).NE.LRPS(3,LRPP-3)) THEN !WRONG # OF ARGUMENTS - IF (LRPS(1,LRPP-3).EQ.50 .AND. RPS(LRPP-2).EQ.2) THEN !ATAN - LRPS(1,LRPP-3)=LRPS(1,LRPP-3)+1 !MAKE ATAN 2 ARGUMENTS - LRPS(3,LRPP-3)=LRPS(3,LRPP-3)+1 - ELSE - GOTO 12 !ERROR - END IF - END IF - NVAL=RPS(LRPP-1)+LRPS(4,LRPP-3) !NEW ARGUMENTS - CDP=CDP+1 !SET FUNCTION - COD(CDP)=RPS(LRPP-3) - LRPP=RPS(LRPP) !PREVIOUS ENVIRONMENT - RPP=RPP-4 !DELETE SAVED ENVIRONMENT - ELSE - GOTO 12 !ERROR - END IF - ELSE - GOTO 12 !ERROR - END IF - ELSE !NORMAL OPERATION - RPP=RPP+1 !SET ON STACK - RPS(RPP)=TCOD - END IF -C - RETURN -C -C NGCEX2 -C - ENTRY NGCEX2(N,STR,STP) -C - IF (STP+N.GT.LEN(STR)) THEN - NGCEX2=.FALSE. !ERROR - STP=LEN(STR) - ELSE - NGCEX2=.TRUE. - STP=STP+N - END IF -C - RETURN -C -C NGCEX3 -C - ENTRY NGCEX3(TCOD,LTCOD,COD,CDP,RPS,LRPS,RPP,LRPP,NVAL) -C - NGCEX3=.TRUE. - RPP=RPP+1 !UPDATE POINTER - RPS(RPP)=TCOD !SET IN RPS -C - RETURN -C -C NGCEX4 -C - ENTRY NGCEX4(TCOD,LTCOD,COD,CDP,RPS,LRPS,RPP,LRPP,NVAL) -C - NGCEX4=.TRUE. - CDP=CDP+1 !UPDATE POINTER - COD(CDP)=TCOD !SET IN COD -C - RETURN -C -C - END diff --git a/src/nplot/ngcexp.for b/src/nplot/ngcexp.for deleted file mode 100644 index ec2ac5d508750300c0395e7e8d970aff1a53385f..0000000000000000000000000000000000000000 --- a/src/nplot/ngcexp.for +++ /dev/null @@ -1,340 +0,0 @@ -C+ NGCEXP.FOR -C WNB 920819 -C -C Revisions: -C WNB 930630 Add operator ^, and functions 78-85 -C AXC 010709 Linux port - init data -C - LOGICAL FUNCTION NGCEXP(INSTR,OUTSTR,COD,PLT,NPLT) -C -C Analyze expression -C -C Result: -C -C NGCEXP_L = NGCEXP( INSTR_C*:I, OUTSTR_C*:O, COD_J(*):O, PLT_J(*):O, -C NPLT_J:O) -C Analyze expression given in INSTR, -C and return executable program in COD. -C NPLT will return the number of different plots -C used, PLT(NPLT) will then contain a reference -C to these plots. OUTSTR gives the string -C analyzed without errors. -C -C -C Include files: -C - INCLUDE 'WNG_DEF' - INCLUDE 'NGC_DEF' -C -C Parameters: -C - INTEGER NFUNCT !# OF FUNCTIONS DEFINED - PARAMETER (NFUNCT=35) -C -C Arguments: -C - CHARACTER*(*) INSTR !EXPRESSION - CHARACTER*(*) OUTSTR !ANALYZED PART OF EXPRESSION - INTEGER COD(*) !EXECUTABLE - INTEGER PLT(*) !PLOTS USED - INTEGER NPLT !# OF PLOTS USED -C -C Function references: -C - LOGICAL NGCEX1 !SET CODE IN RPS - LOGICAL NGCEX2 !STRING UPDATE - LOGICAL WNCATD !TEST IF DIGIT - LOGICAL WNCATA !TEST IF ALPHA - LOGICAL WNCACU !GET UNSIGNED INTEGER VALUE - LOGICAL WNCAFN !GET NAME -C -C Data declarations: -C -C CODED AS: FUNCTION #, PRIORITY, # OF ARGUMENTS, # OF ARGUMENTS USED UP -C - CHARACTER*6 UN2 !2 CHAR UNARY - DATA UN2/'<>,><,'/ - INTEGER UN2C(2) - BYTE LUN2C(4,2) - EQUIVALENCE (UN2C,LUN2C) - DATA LUN2C/ 14,28,1,0,14,28,1,0/ - CHARACTER*4 UN1 !1 CHAR UNARY - DATA UN1/'+,-,'/ - INTEGER UN1C(2) - BYTE LUN1C(4,2) - EQUIVALENCE (UN1C,LUN1C) - DATA LUN1C/ 1,48,1,0,2,48,1,0/ - CHARACTER*15 BIN2 !2 CHAR BINARY - DATA BIN2/'**,>=,<=,<>,><,'/ - INTEGER BIN2C(5) - BYTE LBIN2C(4,5) - EQUIVALENCE (BIN2C,LBIN2C) - DATA LBIN2C/ 3,44,2,1,8,32,2,1,9,32,2,1,13,32,2,1,13,32,2,1/ - CHARACTER*20 BIN1 !1 CHAR BINARY - DATA BIN1/'+,-,*,/,<,>,=,!,&,^,'/ - INTEGER BIN1C(10) - BYTE LBIN1C(4,10) - EQUIVALENCE (BIN1C,LBIN1C) - DATA LBIN1C/ 6,36,2,1,7,36,2,1,4,40,2,1,5,40,2,1,11,32,2,1, - 1 12,32,2,1,10,32,2,1,16,20,2,1,15,20,2,1, - 1 3,44,2,1/ - INTEGER PLTC !PLOT - BYTE LPLTC(4) - EQUIVALENCE (PLTC,LPLTC) - DATA LPLTC/ 17,0,0,-1/ - INTEGER VALC !CONSTANT VALUE - BYTE LVALC(4) - EQUIVALENCE (VALC,LVALC) - DATA LVALC/ 18,0,0,-1/ - INTEGER BRC !( - BYTE LBRC(4) - EQUIVALENCE (BRC,LBRC) - DATA LBRC/ 40,60,0,0/ - INTEGER RBRC !) - BYTE LRBRC(4) - EQUIVALENCE (RBRC,LRBRC) - DATA LRBRC/ 32,0,0,0/ - INTEGER COMC !, - BYTE LCOMC(4) - EQUIVALENCE (COMC,LCOMC) - DATA LCOMC/ 30,0,0,0/ - INTEGER FINC !FINISH - BYTE LFINC(4) - EQUIVALENCE (FINC,LFINC) - DATA LFINC/ 31,0,0,0/ - CHARACTER*6 NAML(NFUNCT) - DATA NAML/'SIN','COS','ATAN','ASIN','ACOS', - 1 'EXP','EXP10','EXP2','LOG','LOG10','LOG2', - 1 'PI','EE','ABS','FLOOR','CEIL','ROUND', - 1 'INT','FRACT','REAL','IMAG','AMPL','PHASE', - 1 'SQRT','HA','UT','IMUL','CC','DRAD', - 1 'FQ','BL','UU','VV','RA','DEC'/ - INTEGER NAMC(NFUNCT) - BYTE LNAMC(4,NFUNCT) - EQUIVALENCE (NAMC,LNAMC) -C -C CODED AS: FUNCTION NUMBER, PRIORITY, # OF ARGUMENTS NECESSARY, # OF VALUES -C PRODUCED -C - DATA LNAMC/ 52,60,1,1,53,60,1,1,50,60,1,1, !SIN,COS,ATAN - 1 54,60,1,1,55,60,1,1,56,60,1,1, !ASIN,ACOS,EXP - 1 57,60,1,1,58,60,1,1,59,60,1,1, !EXP10,EXP2,LOG - 1 60,60,1,1,61,60,1,1,62,60,0,1, !LOG10,LOG2,PI - 1 63,60,0,1,64,60,1,1,65,60,1,1, !EE,ABS,FLOOR - 1 66,60,1,1,67,60,1,1,68,60,1,1, !CEIL,ROUND,INT - 1 69,60,1,1,70,60,1,1,71,60,1,1, !FRACT,REAL,IMAG - 1 72,60,1,1,73,60,1,1,74,60,1,1, !AMPL,PHASE,SQRT - 1 75,60,0,1,76,60,0,1,77,60,1,1, !HA,UT,IMUL - 1 78,60,0,1,79,60,0,1,80,60,0,1, !CC,DRAD,FQ - 1 81,60,0,1,82,60,0,1,83,60,0,1, !BL,UU,VV - 1 84,60,0,1,85,60,0,1/ !RA,DEC -C - CHARACTER*256 STR !EXPRESSION STRING - CHARACTER*6 NAM !FUNCTION NAME - INTEGER TCOD !STACK CODE - BYTE LTCOD(4) - EQUIVALENCE (TCOD,LTCOD) - INTEGER STP !STRING POINTER - INTEGER CDP !CODE POINTER - INTEGER RPS(512) !REVERSE POLISH STACK - BYTE LRPS(4,512) - EQUIVALENCE (RPS,LRPS) - INTEGER RPP !RPS POINTER - INTEGER NVAL !# OF VALUES ON STACK - INTEGER LRPP !CURRENT LOW RPP - INTEGER JJ1,JJ2 -C- -C -C INIT OUTPUT -C - NGCEXP=.TRUE. !ASSUME OK - OUTSTR=' ' !ANALYZED STRING - NPLT=0 !PLOTS PRODUCED - STR=INSTR !MAKE SURE ALL USABLE - STR(LEN(STR)-1:)=' ' -C -C COMPRESS ETC. STRING -C - 10 CONTINUE - J=INDEX(STR,' ') !DELETE TABS - IF (J.GT.0) THEN - STR(J:J)=' ' - GOTO 10 - END IF - 12 CONTINUE - J=INDEX(STR,'"') !DELETE " - IF (J.GT.0) THEN - STR(J:J)=' ' - GOTO 12 - END IF - DO I=1,LEN(STR) !DELETE SPACES - IF (STR(I:).EQ.' ') GOTO 11 !READY - DO WHILE (STR(I:I).EQ.' ') - DO I1=I,LEN(STR)-1 - STR(I1:I1)=STR(I1+1:I1+1) - END DO - END DO - END DO - 11 CONTINUE - CALL WNCAUC(STR) !CONVERT TO CAPITAL -C -C INIT -C - STP=1 !STRING POINTER - NVAL=0 !# OF VALUES ON STACK - RPP=0 !RPS POINTER - LRPP=0 !LOW CURRENT RPP - CDP=0 !CODE POINTER -C -C UNARY OPERATORS -C - 20 CONTINUE - J=INDEX(UN2,STR(STP:STP+1)//',') !LOOK - IF (J.GT.0) THEN - J1=2 !LENGTH OPERATOR - TCOD=UN2C((J+2)/3) !EXECUTE CODE - 21 CONTINUE - IF (.NOT.NGCEX1(TCOD,LTCOD,COD,CDP,RPS,LRPS,RPP,LRPP,NVAL)) - 1 GOTO 23 !SET CODE - 22 CONTINUE - IF (NGCEX2(J1,STR,STP)) THEN - GOTO 20 !MORE - ELSE - 23 CONTINUE - NGCEXP=.FALSE. !ERROR - 25 CONTINUE - OUTSTR=STR(:STP) !ANALYZED PART OF INPUT -C - RETURN -C - END IF - END IF -C - J=INDEX(UN1,STR(STP:STP)//',') !1 CHAR. UNARY - IF (J.GT.0) THEN - J1=1 !LENGTH OPERATOR - TCOD=UN1C((J+1)/2) !EXECUTE CODE - GOTO 21 !SET CODE - END IF -C -C ( -C - IF (STR(STP:STP).EQ.'(') THEN - 24 CONTINUE - IF (.NOT.NGCEX1(BRC,LBRC,COD,CDP,RPS,LRPS,RPP,LRPP,NVAL)) - 1 GOTO 23 !SET CODE - 26 CONTINUE - J1=1 !SKIP - GOTO 22 - END IF -C -C VALUE -C - IF (STR(STP:STP).EQ.'#') THEN !PLOT - IF (.NOT.NGCEX2(1,STR,STP)) GOTO 23 !ERROR - IF (STR(STP:STP).EQ.'#') THEN !SKIP DO LOOP - IF (.NOT.NGCEX2(1,STR,STP)) GOTO 23 !SKIP # - J2=NGCSDL !INDICATE SKIP - ELSE - J2=0 !ACCEPT DO LOOP - END IF - IF (.NOT.WNCATD(STR,STP)) GOTO 23 !ERROR - IF (.NOT.WNCACU(STR,STP,10,D0,D1)) GOTO 23 !GET PLOT # - JJ1=NINT(D0) - JJ1=JJ1+J2 - JJ2=1 - DO WHILE(JJ2.LE.NPLT .AND. PLT(JJ2).NE.JJ1) - JJ2=JJ2+1 - END DO - IF (JJ2.GT.NPLT) THEN - NPLT=NPLT+1 !NEW PLOT - PLT(NPLT)=JJ1 !REFERENCE - J1=NPLT - ELSE - J1=JJ2 !REFERENCE - END IF - 30 CONTINUE - CALL NGCEX4(PLTC,LPLTC,COD,CDP,RPS,LRPS,RPP,LRPP,NVAL) !PLOT CODE - CALL NGCEX4(J1,J1,COD,CDP,RPS,LRPS,RPP,LRPP,NVAL) !PLOT NUMBER - ELSE IF (WNCATD(STR,STP) .OR. STR(STP:STP).EQ.'.') THEN !VALUE - IF (.NOT.WNCACU(STR,STP,10,D0,D1)) GOTO 23 !INTEGER PART - R0=NINT(D0) - IF (STR(STP:STP).EQ.'.') THEN !FRACTION - IF (.NOT.NGCEX2(1,STR,STP)) GOTO 23 !SKIP . - J=STP !FOR FRACTION - IF(.NOT.WNCACU(STR,STP,10,D0,D1)) GOTO 23 !FRACTION - J1=NINT(D0) - R0=R0+J1*(10.**(J-STP)) !VALUE - END IF - IF (STR(STP:STP).EQ.'E') THEN !EXPONENT - J=0 !SIGN - 31 CONTINUE - IF (.NOT.NGCEX2(1,STR,STP)) GOTO 23 !SKIP E,+,- - IF (STR(STP:STP).EQ.'+') THEN !+ - GOTO 31 - ELSE IF (STR(STP:STP).EQ.'-') THEN !- - J=MOD(J+1,2) !SET SIGN - GOTO 31 - END IF - IF (.NOT.WNCATD(STR,STP)) GOTO 23 !ERROR - IF (.NOT.WNCACU(STR,STP,10,D0,D1)) GOTO 23 !EXPONENT - J1=NINT(D0) - IF (J1.NE.0) J1=-J1 !SIGN - R0=R0*(10.**MIN(38,J1)) !VALUE - END IF - CALL NGCEX4(VALC,LVALC,COD,CDP,RPS,LRPS,RPP,LRPP,NVAL) !VALUE CODE - CALL NGCEX4(R0,R0,COD,CDP,RPS,LRPS,RPP,LRPP,NVAL) !VALUE - ELSE IF(WNCATA(STR,STP)) THEN !NAME - IF (.NOT.WNCAFN(STR,STP,NAM)) GOTO 23 !GET NAME - DO I=1,NFUNCT !SEE IF OK - IF (NAML(I).EQ.NAM) THEN !FOUND - J=I - GOTO 32 - END IF - END DO - GOTO 23 !NAME NOT FOUND - 32 CONTINUE - IF (.NOT.NGCEX1(NAMC(J),LNAMC(1,J),COD,CDP,RPS,LRPS,RPP, - 1 LRPP,NVAL)) GOTO 23 !SET NAME - IF (STR(STP:STP).NE.'(') GOTO 41 !FINISH FUNCTION - GOTO 26 !SKIP ( - ELSE - GOTO 23 !ERROR - END IF - NVAL=NVAL+1 !COUNT VALUES -C -C BINARY OPERATOR -C - 40 CONTINUE - IF (STR(STP:).EQ.' ') THEN !END - IF (.NOT.NGCEX1(FINC,LFINC,COD,CDP,RPS,LRPS,RPP,LRPP,NVAL)) - 1 GOTO 23 !SET FINAL CODE - GOTO 25 !READY - ELSE IF (STR(STP:STP).EQ.')') THEN !FINISH SUBEXPRESSION - IF (.NOT.NGCEX2(1,STR,STP)) GOTO 23 !SKIP ) - 41 CONTINUE - IF (.NOT.NGCEX1(RBRC,LRBRC,COD,CDP,RPS,LRPS,RPP,LRPP,NVAL)) - 1 GOTO 23 !SET CODE FOR ) - GOTO 40 !CONTINUE - ELSE IF (STR(STP:STP).EQ.',') THEN !ARGUMENT SUBEXPRESSION - IF (.NOT.NGCEX2(1,STR,STP)) GOTO 23 !SKIP , - IF (.NOT.NGCEX1(COMC,LCOMC,COD,CDP,RPS,LRPS,RPP,LRPP,NVAL)) - 1 GOTO 23 !SET CODE FOR , - ELSE IF (INDEX(BIN2,STR(STP:STP+1)//',').GT.0) THEN !2 CHAR BINARY - J=INDEX(BIN2,STR(STP:STP+1)//',') !LOCATE - J1=2 - TCOD=BIN2C((J+2)/3) !EXECUTE CODE - GOTO 21 !SET CODE - ELSE IF (INDEX(BIN1,STR(STP:STP)//',').GT.0) THEN !1 CHAR BINARY - J=INDEX(BIN1,STR(STP:STP)//',') !LOCATE - J1=1 - TCOD=BIN1C((J+1)/2) !EXECUTE CODE - GOTO 21 !SET CODE - ELSE - GOTO 23 !ERROR - END IF -C - GOTO 20 !NEXT SUBEXPRESSION -C -C - END diff --git a/src/nplot/ngcext.for b/src/nplot/ngcext.for deleted file mode 100644 index 71912290723174d69c30cef16172b5bb76a49fc9..0000000000000000000000000000000000000000 --- a/src/nplot/ngcext.for +++ /dev/null @@ -1,360 +0,0 @@ -C+ NGCEXT.FOR -C WNB 920819 -C -C Revisions: -C WNB 930608 New weights/flags -C HJV 930618 Symbolic names for mask bits in CBITS_O_DEF -C WNB 930628 Fill baseline/tel. position -C WNB 930803 CBITS_DEF -C WNB 930824 Change telescope selection -C WNB 930825 Add dipole positions; pol. codes -C WNB 930826 New HA range -C HjV 940428 Add IFData option -C CMV 940705 Correct IFData option -C JPH 940811 Reduce action reporting -C JPH 940822 Create Group header (moved from ngcdat.for), and create -C a new one for every new input group -C Interferometer index contiguous i.s.o. from input -C WNB 061023 Change test for telescope (error in Linux) -C -C - SUBROUTINE NGCEXT -C -C Extract data from scan file -C -C Result: -C -C CALL NGCEXT Extract data from SCN file, -C and save in NGF file. -C -C -C Include files: -C - INCLUDE 'WNG_DEF' - INCLUDE 'CBITS_DEF' - INCLUDE 'NGF_O_DEF' !PLOT HEADER - INCLUDE 'GFH_O_DEF' !GENERAL FILE HEADER - INCLUDE 'SGH_O_DEF' !SUB-GROUP HEADER - INCLUDE 'STH_O_DEF' !SCAN SET HEADER - INCLUDE 'SCH_O_DEF' !SCAN HEADER - INCLUDE 'NGC_DEF' -C -C Parameters: -C -C -C Arguments: -C -C -C Function references: -C - LOGICAL WNFOP !OPEN FILE - LOGICAL WNFRD !READ DISK - LOGICAL WNFWR !WRITE DISK - LOGICAL WNGGVA !GET MEMORY - INTEGER WNFEOF !EOF POINTER - DOUBLE PRECISION WNGDPF - LOGICAL WNDLNF,WNDLNG,WNDLNK !LINK DATA SET - LOGICAL NSCSIF !GET IFR TABLE - LOGICAL NSCSTG !GET NEXT SCAN SET - LOGICAL NSCSCT !GET SCAN TEL. CORR. - LOGICAL NSCSCR !READ SCAN DATA - LOGICAL NSCSCM !READ MODEL DATA - LOGICAL NSCSCI !READ IFR DATA - LOGICAL NSCGIF !Read IF data - LOGICAL NSCGF1 !Get some data from IF header -C -C Data declarations: -C - REAL MODDAT(2,0:STHIFR-1) !MODEL DATA - REAL WGT(0:STHIFR-1,0:3) !DATA WEIGHT - COMPLEX CDAT(0:STHIFR-1,0:3) !DATA - INTEGER*2 IFRT(0:STHIFR-1) !INTERFEROMETER LIST - INTEGER IFRA(0:1,0:STHIFR-1) - REAL ANG(0:2,0:STHIFR-1) - INTEGER BUFAD !DATA BUFFER ADDRESS - INTEGER BLEN !DATA BUFFER LENGTH - INTEGER STHP !SET HEADER POINTER - INTEGER PTR(0:1) !PLOT LINK POINTER - INTEGER POLN,IPOL !CURRENT POINTERS - COMPLEX TCOR(0:STHTEL-1,0:1) !TEL. CORRECTIONS - REAL IFDATA(0:STHTEL-1,0:1) !TOTAL POWERS ETC. - INTEGER SETNAM(0:7) !SET NAME - INTEGER UFL !FLAGS TO DISCARD - REAL LHA !LOCAL HA - REAL HAB,HAI !START HA, INCREMENT - INTEGER NSCN !NUMBER OF SCANS - INTEGER NDONE !NUMBER OF CUTS MADE - INTEGER POLCD(0:3) !POL. CODES - INTEGER PRVNAM ! PREVIOUS GRP INDEX - DATA POLCD/XX_P,XY_P,YX_P,YY_P/ - BYTE NGF(0:NGFHDL-1) !PLOT HEADER - INTEGER*2 NGFI(0:NGFHDL/2-1) - INTEGER NGFJ(0:NGFHDL/4-1) - REAL NGFE(0:NGFHDL/4-1) - CHARACTER*(NGFHDL) NGFC - EQUIVALENCE (NGF,NGFC,NGFI,NGFJ,NGFE) - BYTE STH(0:STHHDL-1) !SET HEADER - INTEGER*2 STHI(0:STHHDL/2-1) - INTEGER STHJ(0:STHHDL/4-1) - REAL STHE(0:STHHDL/4-1) - DOUBLE PRECISION STHD(0:STHHDL/8-1) - EQUIVALENCE (STH,STHI,STHJ,STHE,STHD) - BYTE SCH(0:SCHHDL-1) !SCAN HEADER - INTEGER*2 SCHI(0:SCHHDL/2-1) - INTEGER SCHJ(0:SCHHDL/4-1) - REAL SCHE(0:SCHHDL/4-1) - DOUBLE PRECISION SCHD(0:SCHHDL/8-1) - EQUIVALENCE (SCH,SCHI,SCHJ,SCHE,SCHD) - COMPLEX C0 -C- -C -C INIT -C - CALL WNDDUF(UFL) !GET UNFLAG DATA - UFL=IAND(FL_ALL,NOT(UFL)) !SELECTOR -C -C DO SETS -C - NDONE=0 - PRVNAM=-1 - DO WHILE (NSCSTG(FCAIN,SETS,STH(0),STHP,SETNAM)) !ALL SETS - IF (SETNAM(0).NE.PRVNAM) THEN - IF (.NOT.WNDLNG(GFH_LINKG_1,0,SGH_GROUPN_1,FCAOUT, - 1 SGPH(0),SGNR(0))) GOTO 10 !CREATE JOB SET - PRVNAM=SETNAM(0) - ENDIF - CALL WNDSTI(FCAIN,SETNAM) !MAKE SURE PROPER NAME - IF (.NOT.WNDLNF(SGPH(0)+SGH_LINKG_1,SETNAM(2), - 1 SGH_GROUPN_1,FCAOUT,SGPH(1),SGNR(1))) THEN !FIELD - 10 CONTINUE - CALL WNCTXT(F_TP,'!/Cannot create sub-group') - GOTO 900 !STOP - END IF - IF (.NOT.WNDLNF(SGPH(1)+SGH_LINKG_1,SETNAM(3), - 1 SGH_GROUPN_1,FCAOUT,SGPH(2),SGNR(2))) GOTO 10 !CHAN. -C -C GET POLARISATION -C - POLN=0 !POL. COUNT - 40 CONTINUE - IF (IAND(SPOL,POLCD(POLN)).EQ.0) GOTO 42 !NOT THIS POL. -C -C TELESCOPE TYPE DATA -C - CALL WNGMVZ(NGFHDL,NGF) !ZERO FILE - NGFE(NGF_MAX_E)=-1E20 !INIT MAX/MIN - NGFE(NGF_MIN_E)=1E20 - IF (SOPT(1:1).EQ.'T') THEN !TELESCOPE - IF (POLN.EQ.1 .OR. POLN.EQ.2) GOTO 42 !ONLY X,Y - IPOL=MOD(POLN,2) - IF (.NOT.WNDLNF(SGPH(2)+SGH_LINKG_1,IPOL, - 1 SGH_GROUPN_1,FCAOUT,SGPH(3),SGNR(3))) GOTO 10 !POL. - DO I1=1,STHTEL !FOR ALL TELESCOPES - IF (STELS(I1-1).NE..TRUE.) GOTO 44 !DO NOT DO TELESCOPE-wnb061023 - IF (.NOT.WNDLNF(SGPH(3)+SGH_LINKG_1,I1-1, - 1 SGH_GROUPN_1,FCAOUT,SGPH(4),SGNR(4))) GOTO 10 !TEL. - BLEN=STHJ(STH_SCN_J)*LB_X !LENGTH DATA - IF (.NOT.WNGGVA(BLEN,BUFAD)) THEN !GET BUFFER - CALL WNCTXT(F_TP,'!/No buffer space') - GOTO 900 - END IF - BUFAD=(BUFAD-A_OB)/LB_X !BUFFER OFFSET - HAB=STHE(STH_HAB_E) !START HA - HAI=STHE(STH_HAI_E) !HA INCREMENT - NSCN=STHJ(STH_SCN_J) - IF (IF_MODE.NE.' ') JS=NSCGF1(FCAIN,STH,HAB,HAI,NSCN) !GET FROM IFH - DO J=0,NSCN-1 !ALL SCANS - LHA=HAB+J*HAI !HA - IF (IF_MODE.EQ.' ') THEN - IF (.NOT.NSCSCT(FCAIN,STH,0,J,CORAP,CORDAP, - 1 SCH,TCOR,R0)) THEN !READ TEL. CORRECTIONS - CALL WNCTXT(F_TP,'!/Error reading scan header') - GOTO 900 - END IF - IF (IAND(SCHJ(SCH_BITS_J),UFL).NE.0) THEN - C0=CMPLX(NGCDLC,NGCDLC) !DELETED - ELSE - C0=EXP(-TCOR(I1-1,IPOL)) !SELECT CORRECTION - END IF - ELSE !GET IF DATA - IF (.NOT.NSCGIF(IF_MODE,FCAIN,STH, - 1 LHA,LHA,IFDATA)) GOTO 43 !IGNORE SCAN - C0=CMPLX(IFDATA(I1-1,IPOL),0.) !SELECT CORRECTION - END IF - CALL WNGMV(LB_X,C0,A_X(BUFAD+J)) !SET BUFFER POINT - IF (REAL(C0).EQ.NGCDLC) THEN !DELETED POINT - NGFJ(NGF_DEL_J)=NGFJ(NGF_DEL_J)+1 - ELSE - NGFE(NGF_MAX_E)=MAX(ABS(C0),NGFE(NGF_MAX_E)) - NGFE(NGF_MIN_E)=MIN(ABS(C0),NGFE(NGF_MIN_E)) - END IF - 43 CONTINUE - END DO !NEXT SCAN - NGFI(NGF_VER_I)=1 !FILL PLOT HEADER - NGFI(NGF_LEN_I)=NGFHDL - CALL WNGMTS(STH_FIELD_N,STH(STH_FIELD_1), - 1 NGFC(NGF_NAM_C+1:NGF_NAM_C+NGF_NAM_N)) - NGFE(NGF_RA_E)=STHD(STH_RA_D) - NGFE(NGF_DEC_E)=STHD(STH_DEC_D) - NGFE(NGF_FRQ_E)=STHD(STH_FRQ_D) - NGFE(NGF_BDW_E)=STHE(STH_BAND_E) - NGFE(NGF_HAB_E)=STHE(STH_HAB_E) - NGFE(NGF_HAI_E)=STHE(STH_HAI_E) - NGFE(NGF_HAV_E)=STHE(STH_HAV_E) - NGFJ(NGF_SCN_J)=STHJ(STH_SCN_J) - NGFE(NGF_UTB_E)=MOD(STHD(STH_MJD_D),1D0) - NGFE(NGF_UTE_E)=WNGDPF(NGFE(NGF_UTB_E)+ - 1 (NGFJ(NGF_SCN_J)-1)*NGFE(NGF_HAI_E)/ - 1 STHD(STH_UTST_D)) - NGFJ(NGF_VNR_J)=STHJ(STH_VNR_J) - NGFJ(NGF_BDN_J)=SETNAM(3) - NGFC(NGF_IFR_C+1:NGF_IFR_C+NGF_IFR_N)=TELNAM(I1:I1) - NGFC(NGF_POL_C+1:NGF_POL_C+NGF_POL_N)=POLNAM(POLN) - NGFE(NGF_BLN_E)=STHE(STH_RTP_E+I1-1) - NGFI(NGF_ODY_I)=STHI(STH_OBS_I+0) - NGFI(NGF_OYR_I)=STHI(STH_OBS_I+1) - IF (IF_MODE.EQ.' ') THEN - NGFC(NGF_TYP_C+1:NGF_TYP_C+NGF_TYP_N)=SOPT - ELSE - NGFC(NGF_TYP_C+1:NGF_TYP_C+NGF_TYP_N)=IF_MODE - END if - J=WNFEOF(FCAOUT) !OUTPUT POINTER - NGFJ(NGF_DPT_J)=J+NGFHDL !DATA POINTER - JS=WNFWR(FCAOUT,NGFHDL,NGF,J) !NEW PLOT HEADER - IF (JS) JS=WNFWR(FCAOUT,BLEN, - 1 A_X(BUFAD),J+NGFHDL) !NEW DATA - IF (.NOT.JS) GOTO 10 !ERROR - CALL WNGFVA(BLEN,BUFAD*LB_X+A_OB) !RELEASE BUFFER - IF (.NOT.WNDLNK(GFH_LINK_1,J, - 1 NGF_SETN_1,FCAOUT)) GOTO 10 !LINK SET - IF (.NOT.WNDLNG(SGPH(4)+SGH_LINKG_1,J, - 1 SGH_GROUPN_1,FCAOUT,SGPH(5),SGNR(5))) GOTO 10 !INDEX - NDONE=NDONE+1 - IF (MOD(NDONE,100).EQ.0) CALL NGCSPL(SGNR,NGF,NDONE) !SIGN OF LIFE - 44 CONTINUE - END DO !NEXT TELESCOPE -C -C IFR TYPE DATA -C - ELSE !IFR - IPOL=POLN - IF (.NOT.WNDLNF(SGPH(2)+SGH_LINKG_1,IPOL, - 1 SGH_GROUPN_1,FCAOUT,SGPH(3),SGNR(3))) GOTO 10 !POL. - IF (.NOT.NSCSIF(FCAIN,STH,IFRT,IFRA,ANG)) THEN - CALL WNCTXT(F_TP,'!/Error reading interferometer table') - GOTO 900 - END IF - I2=0 ! output IFR index - DO I1=1,STHJ(STH_NIFR_J) !FOR ALL IFRS - IF (.NOT.SIFR(IFRA(0,I1-1),IFRA(1,I1-1))) GOTO 54 !NOT THIS IFR - IF (.NOT.WNDLNF(SGPH(3)+SGH_LINKG_1,I2, - 1 SGH_GROUPN_1,FCAOUT,SGPH(4),SGNR(4))) GOTO 10 !IFR. - I2=I2+1 - BLEN=STHJ(STH_SCN_J)*LB_X !LENGTH DATA - IF (.NOT.WNGGVA(BLEN,BUFAD)) THEN !GET BUFFER - CALL WNCTXT(F_TP,'!/No buffer space') - GOTO 900 - END IF - BUFAD=(BUFAD-A_OB)/LB_X !BUFFER OFFSET - DO J=0,STHJ(STH_SCN_J)-1 !ALL SCANS - IF (SOPT(1:1).EQ.'D') THEN !DATA - IF (.NOT.NSCSCR(FCAIN,STH,IFRT,J,CORAP,CORDAP, - 1 SCH,WGT,CDAT)) THEN !READ DATA - 51 CONTINUE - CALL WNCTXT(F_TP,'!/Error reading scan data') - GOTO 900 - END IF - ELSE IF (SOPT(1:1).EQ.'M') THEN !MODEL - IF (.NOT.NSCSCM(FCAIN,STH,IFRT,J,CORAP,CORDAP, - 1 SCH,WGT,CDAT)) GOTO 51 !READ MODEL - ELSE IF (SOPT(1:1).EQ.'W') THEN !WEIGHT - IF (.NOT.NSCSCR(FCAIN,STH,IFRT,J,CORAP,CORDAP, - 1 SCH,WGT,CDAT)) GOTO 51 !READ DATA - ELSE !IFR CORRECTIONS - IF (.NOT.NSCSCI(FCAIN,STH,IFRT,J,CORAP,CORDAP, - 1 SCH,WGT,CDAT)) GOTO 51 !READ IFR CORR. - END IF - IF (IAND(SCHJ(SCH_BITS_J),UFL).NE.0) THEN - C0=CMPLX(NGCDLC,NGCDLC) !DELETED - ELSE IF (SOPT(1:1).EQ.'D') THEN - IF (WGT(I1-1,IPOL).LE.0) THEN - C0=CMPLX(NGCDLC,NGCDLC) !DELETED - ELSE - C0=CDAT(I1-1,IPOL) - END IF - ELSE IF (SOPT(1:1).EQ.'M') THEN !MODEL - C0=-CDAT(I1-1,IPOL) - ELSE IF (SOPT(1:1).EQ.'W') THEN !WEIGHT - IF (WGT(I1-1,IPOL).LE.0) THEN - C0=CMPLX(NGCDLC,NGCDLC) !DELETED - ELSE - C0=CMPLX(WGT(I1-1,IPOL),0.) - END IF - ELSE !IFR CORRECTIONS - C0=CDAT(I1-1,IPOL) - END IF - CALL WNGMV(LB_X,C0,A_X(BUFAD+J)) !SET BUFFER POINT - IF (REAL(C0).EQ.NGCDLC) THEN !DELETED POINT - NGFJ(NGF_DEL_J)=NGFJ(NGF_DEL_J)+1 - ELSE - NGFE(NGF_MAX_E)=MAX(ABS(C0),NGFE(NGF_MAX_E)) - NGFE(NGF_MIN_E)=MIN(ABS(C0),NGFE(NGF_MIN_E)) - END IF - END DO !NEXT SCAN - NGFI(NGF_VER_I)=1 !FILL PLOT HEADER - NGFI(NGF_LEN_I)=NGFHDL - CALL WNGMTS(STH_FIELD_N,STH(STH_FIELD_1), - 1 NGFC(NGF_NAM_C+1:NGF_NAM_C+NGF_NAM_N)) - NGFE(NGF_RA_E)=STHD(STH_RA_D) - NGFE(NGF_DEC_E)=STHD(STH_DEC_D) - NGFE(NGF_FRQ_E)=STHD(STH_FRQ_D) - NGFE(NGF_BDW_E)=STHE(STH_BAND_E) - NGFE(NGF_HAB_E)=STHE(STH_HAB_E) - NGFE(NGF_HAI_E)=STHE(STH_HAI_E) - NGFE(NGF_HAV_E)=STHE(STH_HAV_E) - NGFJ(NGF_SCN_J)=STHJ(STH_SCN_J) - NGFE(NGF_UTB_E)=MOD(STHD(STH_MJD_D),1D0) - NGFE(NGF_UTE_E)=WNGDPF(NGFE(NGF_UTB_E)+ - 1 (NGFJ(NGF_SCN_J)-1)*NGFE(NGF_HAI_E)/ - 1 STHD(STH_UTST_D)) - NGFJ(NGF_VNR_J)=STHJ(STH_VNR_J) - NGFJ(NGF_BDN_J)=SETNAM(3) - NGFC(NGF_IFR_C+1:NGF_IFR_C+NGF_IFR_N)= - 1 TELNAM(IFRA(0,I1-1)+1:IFRA(0,I1-1)+1)// - 1 TELNAM(IFRA(1,I1-1)+1:IFRA(1,I1-1)+1) - NGFC(NGF_POL_C+1:NGF_POL_C+NGF_POL_N)=POLNAM(POLN) - NGFE(NGF_BLN_E)=STHE(STH_RTP_E+IFRA(1,I1-1))- - 1 STHE(STH_RTP_E+IFRA(0,I1-1)) - NGFI(NGF_ODY_I)=STHI(STH_OBS_I+0) - NGFI(NGF_OYR_I)=STHI(STH_OBS_I+1) - NGFC(NGF_TYP_C+1:NGF_TYP_C+NGF_TYP_N)=SOPT - J=WNFEOF(FCAOUT) !OUTPUT POINTER - NGFJ(NGF_DPT_J)=J+NGFHDL !DATA POINTER - JS=WNFWR(FCAOUT,NGFHDL,NGF,J) !NEW PLOT HEADER - IF (JS) JS=WNFWR(FCAOUT,BLEN, - 1 A_X(BUFAD),J+NGFHDL) !NEW DATA - IF (.NOT.JS) GOTO 10 !ERROR - CALL WNGFVA(BLEN,BUFAD*LB_X+A_OB) !RELEASE BUFFER - IF (.NOT.WNDLNK(GFH_LINK_1,J, - 1 NGF_SETN_1,FCAOUT)) GOTO 10 !LINK SET - IF (.NOT.WNDLNG(SGPH(4)+SGH_LINKG_1,J, - 1 SGH_GROUPN_1,FCAOUT,SGPH(5),SGNR(5))) GOTO 10 !INDEX - NDONE=NDONE+1 - IF (MOD(NDONE,100).EQ.0) CALL NGCSPL(SGNR,NGF,NDONE) !SIGN OF LIFE - 54 CONTINUE - END DO !NEXT IFR - END IF -C - 42 CONTINUE - POLN=POLN+1 !NEXT POL - IF (POLN.LT.4) GOTO 40 - END DO !NEXT SET - CALL WNCTXT(F_T,'!UJ cuts created',NDONE) -C - 900 CONTINUE - CALL WNFCL(FCAIN) !CLOSE INPUT -C - RETURN -C -C - END diff --git a/src/nplot/ngcini.for b/src/nplot/ngcini.for deleted file mode 100644 index 0995ff3c045fad07219c1b98d7c483b14ce13c3d..0000000000000000000000000000000000000000 --- a/src/nplot/ngcini.for +++ /dev/null @@ -1,53 +0,0 @@ -C+ NGCINI.FOR -C WNB 920819 -C -C Revisions: -C - SUBROUTINE NGCINI -C -C Initialize NGCALC program -C -C Result: -C -C CALL NGCINI will set header lines, logging, DWARF interface -C -C Include files: -C - INCLUDE 'WNG_DEF' - INCLUDE 'NGC_DEF' -C -C Parameters: -C -C -C Arguments: -C -C -C Function references: -C - LOGICAL WNDINI !INIT DWARF - LOGICAL WNDDAB !OPEN DATABASE -C -C Data declarations: -C -C- -C -C SET HEADER LINES -C - CALL WNCFHD(F_P,1,'!40C\Program to handle NGCALC files') -C -C START DWARF -C - IF (.NOT.WNDINI(PRGNAM)) CALL WNGEX !EXIT IF NO DWARF START -C -C LOGGING -C - CALL WNDLOG(LOGCD) !PROPER LOGGING -C -C DATABASE -C - IF (.NOT.WNDDAB()) CALL WNGEX !OPEN DATABASE -C - RETURN !READY -C -C - END diff --git a/src/nplot/ngcmon.for b/src/nplot/ngcmon.for deleted file mode 100644 index 23653df1726c9813eb87d4d65de772b421e5590b..0000000000000000000000000000000000000000 --- a/src/nplot/ngcmon.for +++ /dev/null @@ -1,217 +0,0 @@ -C+ NGCMON.FOR -C WNB 920821 -C -C Revisions: -C HjV 930423 Change name of some keywords -C CMV 931210 Add 'NGF_LOOPS' argument to WNDXLP -C CMV 931220 Pass FCA of input file to WNDXLP and WNDSTA/Q -C JPH 940818 NGF_LOOPS before NGF_SETS as in other Newstar programs -C -C - SUBROUTINE NGCMON -C -C Make MONGO file -C -C Result: -C -C CALL NGCMON Make MONGO output file -C -C -C Pin references: -C -C NGF_SETS Plots to show -C PLOT_TYPE Output type -C MONGO_FILE MONGO file name -C -C Include files: -C - INCLUDE 'WNG_DEF' - INCLUDE 'NGF_O_DEF' !PLOT HEADER - INCLUDE 'NGC_DEF' -C -C Parameters: -C -C -C Arguments: -C -C -C Function references: -C - LOGICAL WNDPAR !GET USER DATA - LOGICAL WNFRD !READ DISK - LOGICAL WNGGVA !GET MEMORY - LOGICAL WNDSTA !ASK PLOTS - LOGICAL WNDXLP !ASK LOOPS - LOGICAL WNDXLN !LOOP - INTEGER WNCALN !STRING LENGTH - CHARACTER*20 WNFFNM !GET A FILE NAME - LOGICAL NGCSTL !GET PLOT -C -C Data declarations: -C - INTEGER NPLOT !# OF PLOTS TO SHOW - INTEGER NMON !# OF COLUMNS - INTEGER MONPT(MXNMON) !PLOT HEADER POINTERS - INTEGER NGFP !PLOT HEADER POINTER - INTEGER SNAM(0:7) !PLOT NAME - LOGICAL LFIRST !FIRST LOOP - INTEGER BUFAD !DATA BUFFER - INTEGER BUFL !DATA BUFFER LENGTH - REAL MONDAT(0:MXNMON) !DATA - CHARACTER*80 MONFIL !MONGO FILE NAME - REAL HA !START HA - INTEGER NPTS !NUMBER OF MONGO LINES - REAL HAINC !HA INCREMENT - BYTE NGF(0:NGFHDL-1,MXNMON) !PLOT HEADER - INTEGER*2 NGFI(0:NGFHDL/2-1,MXNMON) - INTEGER NGFJ(0:NGFHDL/4-1,MXNMON) - REAL NGFE(0:NGFHDL/4-1,MXNMON) - CHARACTER*(NGFHDL) NGFC(MXNMON) - EQUIVALENCE (NGF,NGFC,NGFI,NGFJ,NGFE) -C- -C -C INIT -C - OPTION='COS' !ASSUME DEFAULT PLOT -C -C SELECT PLOTS -C - 10 CONTINUE - IF (.NOT.WNDXLP('NGF_LOOPS',FCAOUT)) GOTO 10 !GET LOOPS - LFIRST=.TRUE. !FIRST LOOP - 20 CONTINUE - IF (.NOT.WNDSTA('NGF_SETS',MXNSET,SETS,FCAOUT)) GOTO 10 - !GET PLOTS TO USE - IF (SETS(0,0).EQ.0) GOTO 900 !READY - CALL WNDXLI(LPOFF) !INIT. LOOPS - IF (.NOT.WNDXLN(LPOFF)) GOTO 10 !NO MORE IN LOOP -C -C FIND PLOTS TO USE -C - NMON=0 !# TO DO - DO WHILE(NGCSTL(FCAOUT,SETS,NGF,NGFP,SNAM,LPOFF)) !GET PLOT - IF (NMON.LT.MXNMON) THEN - NMON=NMON+1 !COUNT - MONPT(NMON)=NGFP !POINTER - END IF - END DO - IF (NMON.LE.0) GOTO 20 !READY, NEXT LOOP -C -C DO OUTPUT -C - 31 CONTINUE - MONFIL=WNFFNM('NGC','MON') !UNIQUE NAME - IF (LFIRST) THEN !FIRST LOOP - IF (.NOT.WNDPAR('MONGO_FILE',MONFIL,LEN(MONFIL), - 1 J0,MONFIL)) THEN - IF (E_C.EQ.DWC_ENDOFLOOP) GOTO 10 !RETRY FROM START - GOTO 31 !RETRY - END IF - IF (J0.LT.0) GOTO 31 !MUST SPECIFY - IF (J0.EQ.0) GOTO 10 - 32 CONTINUE - IF (.NOT.WNDPAR('PLOT_TYPE',OPTION,LEN(OPTION), - 1 J0,OPTION)) THEN !GET TYPE OF PLOT - IF (E_C.EQ.DWC_ENDOFLOOP) GOTO 31 !RETRY FILE - GOTO 32 !RETRY - END IF - IF (J0.LT.0) OPTION='COS' !DEFAULT - IF (J0.EQ.0) GOTO 31 !RETRY FILE - END IF - LFIRST=.FALSE. !NOT FIRST -C -C OPEN MONGO FILE -C - CALL WNCFSV(F_0,F_LL,230) !MAX. LINE LENGTH - CALL WNCFSV(F_0,F_PL,0) !NO PAGING - CALL WNCFSV(F_0,F_DIS,F_YES) !KEEP FILE - CALL WNCFOP(F_0,MONFIL(1:WNCALN(MONFIL))) !OPEN OUTPUT FILE -C -C READ PLOT HEADERS -C - 33 CONTINUE - DO I=1,NMON !READ PLOT HEADERS - IF (.NOT.WNFRD(FCAOUT,NGFHDL,NGF(0,I),MONPT(I))) THEN - 36 CONTINUE - CALL WNCTXT(F_TP,'!/Error reading plot file') - 34 CONTINUE - CALL WNCFCL(F_0) !CLOSE FILE - GOTO 900 - END IF - END DO -C -C FIND RANGE -C - NPTS=NGFJ(NGF_SCN_J,1) !INIT VALUES - HA=NGFE(NGF_HAB_E,1)*360. - HAINC=NGFE(NGF_HAI_E,1)*360. - DO I=2,NMON - NPTS=MAX(NPTS,NGFJ(NGF_SCN_J,I)) - HA=MIN(HA,NGFE(NGF_HAB_E,I)*360.) - HAINC=MIN(HAINC,NGFE(NGF_HAI_E,I)*360.) - END DO -C -C GET DATA -C - BUFL=LB_X*NMON*NPTS !GET DATA BUFFER - IF(.NOT.WNGGVA(BUFL,BUFAD)) THEN - CALL WNCTXT(F_TP,'!/Cannot get data buffer') - GOTO 34 - END IF - BUFAD=(BUFAD-A_OB)/LB_X !DATA POINTER - DO I=1,NMON !READ DATA - IF (.NOT.WNFRD(FCAOUT,LB_X*NGFJ(NGF_SCN_J,I), - 1 A_X(BUFAD+(I-1)*NPTS),NGFJ(NGF_DPT_J,I))) GOTO 36 - END DO -C -C DO ACTUAL OUTPUT -C - DO I1=1,NPTS !ALL DATA - MONDAT(0)=HA - DO I=1,NMON !ALL SETS - R0=(HA/360.-NGFE(NGF_HAB_E,I))/NGFE(NGF_HAI_E,I) !OFFSET - I2=NINT(R0) !SELECT POINT - IF (I2.LT.0 .OR. I2.GE.NGFJ(NGF_SCN_J,I)) THEN - MONDAT(I)=NGCDLC !SET DELETED - ELSE - IF (REAL(A_X(BUFAD+(I-1)*NPTS+I2)).EQ.NGCDLC) THEN - MONDAT(I)=NGCDLC !DELETED DATA - ELSE IF (OPT(1:1).EQ.'S') THEN - MONDAT(I)=AIMAG(A_X(BUFAD+(I-1)*NPTS+I2)) - ELSE IF (OPT(1:1).EQ.'A') THEN - MONDAT(I)=ABS(A_X(BUFAD+(I-1)*NPTS+I2)) - ELSE IF (OPT(1:1).EQ.'P') THEN - IF (REAL(A_X(BUFAD+(I-1)*NPTS+I2)).EQ.0) THEN - MONDAT(I)=SIGN(PI/2.,AIMAG(A_X(BUFAD+(I-1)*NPTS+I2))) - ELSE - MONDAT(I)=ATAN2(AIMAG(A_X(BUFAD+(I-1)*NPTS+I2)), - 1 REAL(A_X(BUFAD+(I-1)*NPTS+I2))) - END IF - ELSE - MONDAT(I)=REAL(A_X(BUFAD+(I-1)*NPTS+I2)) - END IF - END IF - IF (MONDAT(I).EQ.NGCDLC) GOTO 40 !SKIP LINE - END DO - CALL WNCTXT(F_0,'!Q1!15$#E6',NMON+1,MONDAT(0)) !WRITE LINE - 40 CONTINUE - HA=HA+HAINC - END DO - CALL WNGFVA(BUFL,BUFAD*LB_X+A_OB) !RELEASE MEMORY - CALL WNCFCL(F_0) !CLOSE FILE -C -C FINISH -C - CALL WNCTXT(F_TP,'!/Mongo file !AS produced with !UJ columns, '// - 1 '!UJ lines!/', - 1 MONFIL,NMON+1,NPTS) - GOTO 20 !LOOP -C -C READY -C - 900 CONTINUE -C - RETURN -C -C - END diff --git a/src/nplot/ngcnvs.for b/src/nplot/ngcnvs.for deleted file mode 100644 index 7e0acf1bd2a197d50338487d751029335c0b69f8..0000000000000000000000000000000000000000 --- a/src/nplot/ngcnvs.for +++ /dev/null @@ -1,89 +0,0 @@ -C+ NGCNVS.FOR -C WNB 920826 -C -C Revisions: -C HjV 930311 Change some text -C - SUBROUTINE NGCNVS -C -C Convert NGF file to newest format -C -C Result: -C -C CALL NGCNVS will convert a NGF file to newest version -C -C Include files: -C - INCLUDE 'WNG_DEF' - INCLUDE 'NGC_DEF' - INCLUDE 'NGF_O_DEF' !SET HEADER -C -C Parameters: -C -C -C Arguments: -C -C -C Function references: -C - LOGICAL WNFRD !READ DATA - LOGICAL WNFWR !WRITE DATA - LOGICAL NGCSTH !GET A SET WITH NO VERSION CHECK -C -C Data declarations: -C - INTEGER SET(0:7,0:1) !ALL SETS - INTEGER NGFP !SET HEADER POINTER - INTEGER SNAM(0:7) !SET NAME - BYTE NGF(0:NGFHDL-1) !SET HEADER - INTEGER*2 NGFI(0:NGFHDL/2-1) - INTEGER NGFJ(0:NGFHDL/4-1) - REAL NGFE(0:NGFHDL/4-1) - EQUIVALENCE (NGF,NGFI,NGFJ,NGFE) -C- -C -C INIT -C - DO I=0,7 !SET SET *.*.*.*.*.*.* - DO I1=0,1 - SET(I,I1)=0 - END DO - END DO - SET(0,0)=1 !1 LINE - DO I=0,7 - SET(I,1)=-1 !* - END DO -C -C DO ALL SETS -C - DO WHILE (NGCSTH(FCAOUT,SET,NGF,NGFP,SNAM)) !GET SET -C -C MAKE FROM VERSION 1 -C - IF (NGFI(NGF_VER_I).EQ.1) THEN !STILL VERSION 1 - NGFI(NGF_LEN_I)=NGFHDL !NEW LENGTH - NGFI(NGF_VER_I)=NGFHDV !NEW VERSION - END IF !VERSION 1 -C -C FINISH -C - IF (.NOT.WNFWR(FCAOUT,NGFHDL,NGF(0),NGFP)) THEN !REWRITE SET HEADER -10 CONTINUE - CALL WNCTXT(F_TP,'!/Error rewriting Plot Set(s)') - GOTO 900 - END IF - END DO -C -C READY -C - 800 CONTINUE -C - RETURN -C -C ERROR -C - 900 CONTINUE - RETURN !READY -C -C - END diff --git a/src/nplot/ngcpbr.for b/src/nplot/ngcpbr.for deleted file mode 100644 index 79000477f9de28914b3ee54151da9a5fd5a59e50..0000000000000000000000000000000000000000 --- a/src/nplot/ngcpbr.for +++ /dev/null @@ -1,89 +0,0 @@ -C+ NGCPBR.FOR -C WNB 920820 -C -C Revisions: -C HjV 930423 Change name of some keywords -C WNB 930628 Change SCN_SETS into NGF_SETS -C CMV 931220 Pass FCA of input file to WNDXLP and WNDSTA/Q -C JPH 940822 FULL option, make BRIEF truly brief -C -C - SUBROUTINE NGCPBR -C -C Show brief data in NGF file -C -C Result: -C -C CALL NGCPBR will show data in NGF file -C -C PIN references: -C -C -C Include files: -C - INCLUDE 'WNG_DEF' - INCLUDE 'NGC_DEF' - INCLUDE 'NGF_O_DEF' !PLOT HEADER -C -C Parameters: -C -C -C Arguments: -C -C -C Function references: -C - LOGICAL WNDSTA !GET PLOTS TO DO - CHARACTER*32 WNTTSG !SET NAME - LOGICAL NGCSTG !GET A PLOT -C -C Data declarations: -C - INTEGER NGFP !SUB-GROUP POINTER - INTEGER SNAM(0:7) !SET NAME - BYTE NGF(0:NGFHDL-1) !PLOT HEADER - INTEGER SAVNAM(0:7) !PREVIOUS SNAM - BYTE SAVNGF(NGFHDL) - INTEGER CNT(3:5) !CUT COUNTERS -C- -C -C DO PLOTS -C - CALL WNCTXT(F_TP,' ') - IF (.NOT.WNDSTA('NGF_SETS',MXNSET,SETS,FCAOUT)) - 1 GOTO 900 !GET SETS TO DO - - SAVNAM(0)=-1 ! INIT INVALID - DO WHILE(NGCSTG(FCAOUT,SETS,NGF,NGFP,SNAM)) !GET CUT - IF (SAVNAM(0).NE.SNAM(0) - 1 .OR.SAVNAM(1).NE.SNAM(1) - 1 .OR.SAVNAM(2).NE.SNAM(2)) THEN - IF (SAVNAM(0).GE.0) CALL NGCSPC(SAVNAM,SAVNGF,CNT) - CNT(3)=0 ! NEW CHN, INIT COUNTS - CNT(4)=0 - CNT(5)=0 - CALL WNGMV(NGFHDL,NGF,SAVNGF) ! SAVE HEADER - ENDIF - IF (SAVNAM(3).NE.SNAM(3) .OR. CNT(3).EQ.0) THEN - CNT(3)=CNT(3)+1 ! NEW POL - CNT(4)=CNT(4)+1 ! AND IORT - ELSEIF (SAVNAM(4).NE.SNAM(4)) THEN - CNT(4)=CNT(4)+1 ! NEW IORT - ENDIF - CNT(5)=CNT(5)+1 ! NEW CUT - DO I=0,5 - SAVNAM(I)=SNAM(I) - ENDDO - END DO - IF (OPT.EQ.'BRI') CALL NGCSPC(SAVNAM,SAVNGF,CNT) - IF (OPT.EQ.'FUL') CALL NGCSPH(SAVNAM,SAVNGF) - CALL WNCTXT(F_TP,' ') -C -C READY -C - 900 CONTINUE -C - RETURN -C -C - END diff --git a/src/nplot/ngcpfl.for b/src/nplot/ngcpfl.for deleted file mode 100644 index 9c7521040064349c75cad41d2a814d5f714057c8..0000000000000000000000000000000000000000 --- a/src/nplot/ngcpfl.for +++ /dev/null @@ -1,235 +0,0 @@ -C+ NGCPFL.FOR -C WNB 920820 -C -C Revisions: -C CMV 931220 Add OVERVIEW option -C JPH 940809 'WMP node' --> 'NGF node' -C -C - SUBROUTINE NGCPFL(PTYPE,INFCA,NODIN,OVV) -C -C Show NGF file layout -C -C Result: -C -C CALL NGCPFL ( PTYPE_J:I, INFCA_J:I, NODIN_C*(*):I, OVV_L:I) -C Show on output PTYPE the file layout -C of file INFCA (if OVV is .false.) or -C give ann overview (if OVV is .true.). -C -C Include files: -C - INCLUDE 'WNG_DEF' - INCLUDE 'NGF_O_DEF' !PLOT HEADER - INCLUDE 'GFH_O_DEF' !GENERAL FILE HEADER - INCLUDE 'SGH_O_DEF' !SUB-GROUP HEADER -C -C Parameters: -C - INTEGER MAXCMT !Max. number of comments to remember - PARAMETER(MAXCMT=25) -C -C Arguments: -C - INTEGER PTYPE !PRINT TYPE (F_P, F_T ETC) - INTEGER INFCA !FILE DESCRIPTOR - CHARACTER NODIN*(*) !NAME OF NODE - LOGICAL OVV !OVERVIEW (else layout)? -C -C Function references: -C - LOGICAL WNFRD !READ DATA - INTEGER WNFEOF !GET FILE POINTER - LOGICAL NGCSTG !GET DATASET - INTEGER WNCALN !Length of string - CHARACTER*32 WNTTSG !MAKE SET NAME -C -C Data declarations: -C - INTEGER SET(0:7,0:1) !ALL SETS - INTEGER SNAM(0:7) !SET NAME - CHARACTER CNAM*23,TNAM*32 !IN CHARACTERS - INTEGER NGFP !SET POINTER -C - INTEGER CGROUP !Current group - INTEGER CFIELD !Current field - INTEGER CCHAN !Current channel - INTEGER LCHAN !Last channel - CHARACTER CCMT*40 !Current comment - CHARACTER CMT(MAXCMT)*40 !List of comments - INTEGER NCMT !Number of unique comments - LOGICAL DO_PRINT !Print line for map -C - BYTE GFH(0:GFHHDL-1) !FILE HEADER - BYTE SGH(0:SGHHDL-1,0:7) !SUB-GROUP HEADER - INTEGER SGHJ(0:SGHHDL/4-1,0:7) - EQUIVALENCE(SGH,SGHJ) -C - BYTE NGF(0:NGFHDL-1) !PLOT HEADER - INTEGER NGFJ(0:NGFHDL/4-1) - INTEGER*2 NGFI(0:NGFHDL/2-1) - REAL NGFE(0:NGFHDL/4-1) - EQUIVALENCE (NGF,NGFJ,NGFI,NGFE) -C- -C -C INIT -C - DO I=0,7 !SET SET *.*.*.*.*.*.* - DO I1=0,1 - SET(I,I1)=0 - END DO - SET(I,1)=-1 !1 LINE - END DO - SET(0,0)=1 !1 LINE -C -C SHOW NAME AND SIZE -C - IF (NODIN.EQ.' ') THEN - IF (.NOT.WNFRD(INFCA,GFHHDL,GFH,0)) THEN - CALL WNCTXT(PTYPE, - 1 '!/File layout of NGF node (!UJ bytes):!/', - 1 WNFEOF(INFCA)) - ELSE - CALL WNCTXT(PTYPE, - 1 '!/File layout of NGF node !AD (!UJ bytes):!/', - 1 GFH(GFH_NAME_1),GFH_NAME_N,WNFEOF(INFCA)) - END IF - ELSE - CALL WNCTXT(PTYPE, - 1 '!/File layout of NGF node !AS (!UJ bytes):!/', - 1 NODIN,WNFEOF(INFCA)) - END IF -C -C SHOW LAYOUT -C - IF (.NOT.OVV) THEN - DO WHILE(NGCSTG(INFCA,SET,NGF,NGFP,SNAM)) !GET SETS - DO I=0,7 !CLEAR LEVEL COUNT - SGHJ(SGH_HEADH_J-SGH_LINKG_J,I)=0 - END DO - I=SET(1,0)-1 !CURRENT LEVEL - IF (.NOT.WNFRD(INFCA,SGHHDL-SGH_LINKG_1,SGH(0,I), - 1 SET(3,0)+SGH_LINKG_1)) THEN !READ TOP - 10 CONTINUE - CALL WNCTXT(PTYPE,'Error reading file') - RETURN - END IF - DO WHILE(I.GT.0) !READ LEVELS - I=I-1 - IF (.NOT.WNFRD(INFCA,SGHHDL-SGH_LINKG_1,SGH(0,I), - 1 SGHJ(SGH_HEADH_J-SGH_LINKG_J,I+1))) GOTO 10 - END DO - SNAM(1)=-1 !ONLY LOWER LEVELS - CALL WNCTXT(PTYPE,'!AS!10C contains !4$UJ fields, !4$UJ '// - 1 'channels, !4$UJ pol.s and !4$UJ '// - 1 'tel/ifrs for !AD', - 1 WNTTSG(SNAM(0),0), - 1 SGHJ(SGH_LINKGN_J-SGH_LINKG_J,0), - 1 SGHJ(SGH_LINKGN_J-SGH_LINKG_J,1), - 1 SGHJ(SGH_LINKGN_J-SGH_LINKG_J,2), - 1 SGHJ(SGH_LINKGN_J-SGH_LINKG_J,3), - 1 NGF(NGF_NAM_1),NGF_NAM_N) - IF (.NOT.WNFRD(INFCA,SGHHDL,SGH(0,0),SET(3,0))) GOTO 10 !READ CURRENT - DO WHILE (SET(1,0).GT.1) !DECREASE LEVEL - SET(1,0)=SET(1,0)-1 !DECREASE LEVEL - SET(3,0)=SGHJ(SGH_HEADH_J,0)-SGH_LINKG_1+SGH_LINK_1 !LOWER HEADER - IF (.NOT.WNFRD(INFCA,SGHHDL,SGH(0,0),SET(3,0))) GOTO 10 !CURRENT - SET(4,0)=SGHJ(SGH_HEADH_J,0) !NEW LOWER HEAD - END DO - END DO - CALL WNCTXT(PTYPE,' ') -C -C Else print summary of contents -C - ELSE -C - CALL WNCTXT(PTYPE,'grp.fld.chn.pol.ifr.cut (#) '// - & 'Ifr Pol Field Type') -C - CGROUP=-1 !Group unknown so far - CFIELD=-1 !Field unknown so far - LCHAN=-1 !No channel printed yet -C -C Loop over all sectors -C - DO WHILE (NGCSTG(INFCA,SET,NGF,NGFP,SNAM))!all sets -C -C If this is a new group, make sure we print the final -C channel of the previous group and that we print the first -C channel of this group -C - IF (CGROUP.NE.SNAM(0)) THEN - IF (LCHAN.NE.-1) THEN - CALL WNCTXT(PTYPE,' - !3$UJ',LCHAN) - LCHAN=-1 - ENDIF - CCHAN=SNAM(2) !Print this channel - NCMT=0 !No comments yet - END IF -C -C We do not print a continuous range of channels -C - DO_PRINT=(SNAM(2).NE.CCHAN+1) -C -C Unless they have a different comment -C - CALL WNGMTS(40,NGF(NGF_TYP_1),CCMT) !Current comment - TNAM=WNTTSG(SNAM,0) !Set name - I2=1 - DO WHILE (TNAM(I2:I2).NE.'.') !Strip group - I2=I2+1 - END DO - TNAM=TNAM(I2+1:) - I2=WNCALN(TNAM) - I1=INDEX(CCMT,TNAM(:I2)) !Comment contains set name? - IF (I1.NE.0) THEN !Then replace by ... - CCMT=CCMT(:I1-1)//'...'//CCMT(I1+I2:) - END IF -C -C Check all previous comments -C - I=1 - DO WHILE (I.LE.NCMT.AND.CCMT.NE.CMT(I)) - I=I+1 - END DO - IF (I.GT.NCMT) THEN - DO_PRINT=.TRUE. - IF (NCMT.EQ.MAXCMT) THEN !End of buffer - CMT(2)=CCMT !Overwrite second comment - ELSE - NCMT=NCMT+1 !Fill buffer - CMT(NCMT)=CCMT - ENDIF - ENDIF -C -C If we do need to print this one, do so now, else keep channel -C - IF (DO_PRINT) THEN - CNAM=WNTTSG(SNAM,3) !ONLY 23 CHARS (4*6-1) - IF (CGROUP.EQ.SNAM(0)) THEN - CNAM(1:4)=' ' !Wipe group - IF (CFIELD.EQ.SNAM(1)) CNAM(5:8)=' ' !Wipe field - END IF - CALL WNCTXT(PTYPE, - & '!23$AS !3$UJ !-4$AL4 !AL2 !-12$AL12 !AL40', - & CNAM,NGFJ(NGF_SETN_J), - & NGF(NGF_IFR_1),NGF(NGF_POL_1),NGF(NGF_NAM_1),CCMT) - END IF -C - CGROUP=SNAM(0) !Keep group for check - CFIELD=SNAM(1) !Keep field for check - CCHAN=SNAM(2) !Keep channel for check - LCHAN=CCHAN !Channel may be printed later - IF (DO_PRINT) LCHAN=-1 !Channel has been printed -C - END DO -C - IF (LCHAN.NE.-1) CALL WNCTXT(PTYPE,' - !3$UJ',LCHAN) - CALL WNCTXT(PTYPE,' ') -C - END IF -C - RETURN -C -C - END diff --git a/src/nplot/ngcplt.for b/src/nplot/ngcplt.for deleted file mode 100644 index 4b06286a8528d7a5c1fab58a6e0b3d0b03113826..0000000000000000000000000000000000000000 --- a/src/nplot/ngcplt.for +++ /dev/null @@ -1,519 +0,0 @@ -C+ NGCPLT.FOR -C WNB 920821 -C -C Revisions: -C WNB 921104 Full HA range -C WNB 921221 Default plotter EPS -C HjV 930423 Change name of some keywords and some text -C WNB 930707 Text only -C WNB 930708 Add plot type to header -C WNB 930826 New HA range -C HjV 930924 Change HARA in HASRA in NSCHAS-call -C CMV 931210 Add 'NGF_LOOPS' argument to WNDXLP -C CMV 931220 Pass FCA of input file to WNDXLP and WNDSTA/Q -C HjV 940428 Change position NGF_SETS (now after NGF_LOOPS) -C CMV 940811 Ask scales in baseline for TRTYP=2 -C JPH 940824 'plot' --> 'cut' -C CONTINUE/GOTO --> DOWHILE/ENDDO -C Annotation: Abs. cut nrs --> ifr/tel + pol -C Plot dashed line over deleted points, dash connecting -C lines to ref. level -C Emphasize isolated points -C HjV 950705 Add keyword PLOT_FORMAT -C -C - SUBROUTINE NGCPLT -C -C Make plots -C -C Result: -C -C CALL NGCPLT Make plots from RGP files. -C -C -C Pin references: -C -C PLOTTER Plotter to use -C PLOT_FORMAT Format for EPS/PS-plots -C NGF_SETS Plots to plot -C HA_RANGE HA range to plot -C HA_SCALE HA scale -C SCALE Plot scale -C OFFSET Plot offset -C PLOT_TYPE Type of plot -C -C Include files: -C - INCLUDE 'WNG_DEF' - INCLUDE 'NGF_O_DEF' !PLOT HEADER - INCLUDE 'NGC_DEF' -C -C Parameters: -C - INTEGER DRAWN, DASHED - PARAMETER (DRAWN=1, DASHED=2) -C -C Arguments: -C -C -C Function references: -C - LOGICAL WNDPAR !GET USER DATA - LOGICAL WNDSTA !ASK PLOTS - LOGICAL WNDXLP !ASK LOOPS - LOGICAL WNDXLN !NEXT LOOP - LOGICAL WNFRD !READ DISK - LOGICAL WNGGVA !GET MEMORY - LOGICAL WQ_MPAGE !OPEN PLOT DEVICE - INTEGER WNMEJC !CEIL - INTEGER WNMEJF !FLOOR - CHARACTER*32 WNTTSG !SET NAME - LOGICAL NGCSTL !GET NEXT SET - LOGICAL NGCSTG !GET NEXT SET - LOGICAL NSCHAS !GET HA_RANGE - INTEGER WNCALN !STRING LENGTH -C -C Data declarations: -C - INTEGER LIX ! LINE-TYPE INDEX - INTEGER NCUT !# OF PLOTS TO USE - INTEGER MXNHV(0:1) !MAX. NR OF PAGES - INTEGER NHV(0:1) !# OF PAGES - INTEGER NPTS !LENGTH SINGLE PLOT - INTEGER NGFP !PLOT HEADER POINTER - INTEGER SNAM(0:7) !PLOT NAME - INTEGER CSET(0:7,0:1) !CHECK SETS - LOGICAL LFIRST !FIRST LOOP - INTEGER PLCNT !PLOT COUNT - REAL HA !START HA OUTPUT PLOT - REAL HAINC !HA INCREMENT OUTPUT PLOT - REAL HAFAC !CONVERSION TO DEGREES OR METERS - REAL CHA !HA CURRENT POINT - REAL HARA(2),HASRA(2) !HA RANGE - REAL HASC !HA SCALE - REAL SCAL !PLOT SCALE - REAL OFFS !PLOT OFFSET - INTEGER BUFL !LENGTH DATA BUFFER - INTEGER BUFAD !ADDRESS DATA BUFFER - REAL NEW(0:MXNSET-1) ! Current plot values - REAL OLD(0:MXNSET-1) ! Previous plot values - REAL LASTV(0:MXNSET-1) ! Last valid plot values - REAL LASTH(0:MXNSET-1) ! and its vertical coord. - LOGICAL*1 EMPH(0:MXNSET-1) ! 'contiguous valid points' flag - REAL UP(6) !TEXT UP VECTOR - DATA UP/0.,1.,1.,0.,-1.,0./ - INTEGER IFOFF(0:MXNSET-1) !Plot offset - CHARACTER*132 TEXT !Text lines - CHARACTER*(MXNSET) TXT(2) !Annotation - CHARACTER*(MXNSET) TXT1,TXT2 !Top line - CHARACTER*1 TXT3 !Used for select char. - CHARACTER*32 DUSER !USERNAME - BYTE NGF(0:NGFHDL-1,0:MXNSET) !PLOT HEADERS - INTEGER*2 NGFI(0:NGFHDL/2-1,0:MXNSET) - INTEGER NGFJ(0:NGFHDL/4-1,0:MXNSET) - REAL NGFE(0:NGFHDL/4-1,0:MXNSET) - CHARACTER*(NGFHDL) NGFC - EQUIVALENCE(NGF,NGFC,NGFI,NGFJ,NGFE) -C- -C -C INIT -C - MXNHV(0)=1 !MAX. # OF PAGES - MXNHV(1)=MXNPAG - PLDEV='PL' - OPTION='COS' - PLCNT=0 !PLOT COUNT -C -C GET PLOT INFO -C - 10 CONTINUE - IF (PLCNT.NE.0) PLDEV='""' !PLOT END - IF (.NOT.WNDPAR('PLOTTER',PLDEV,LEN(PLDEV),J0,PLDEV)) THEN - GOTO 900 - ELSE IF (J0.LE.0) THEN - GOTO 900 - END IF -C -C GET PLOT-FORMAT -C ONLY FOR (ENCAPSULATED) POSTSCRIPT -C - IF (PLDEV(1:2).EQ.'EL' .OR. PLDEV(1:2).EQ.'EP' .OR. - 1 PLDEV(1:2).EQ.'PL' .OR. PLDEV(1:2).EQ.'PP' ) THEN - IF (.NOT.WNDPAR('PLOT_FORMAT',PLDEV(3:3),LEN(PLDEV(3:3)), - 1 J0,PLDEV(3:3))) THEN - GOTO 900 - ELSE IF (J0.LE.0) THEN - GOTO 900 - END IF - END IF -C - 11 CONTINUE - IF (.NOT.WNDXLP('NGF_LOOPS',FCAOUT)) GOTO 10 !LOOPS - IF (.NOT.WNDSTA('NGF_SETS',MXNSET,SETS,FCAOUT)) GOTO 10 !PLOTS TO USE - IF (SETS(0,0).EQ.0) GOTO 10 - IF (.NOT.NGCSTG(FCAOUT,SETS,NGF(0,0),NGFP,SNAM)) GOTO 11 !ONE PRESENT - CALL WNDSTR(FCAOUT,SETS) !RESET SEARCH - CALL WNDXLI(LPOFF) !INIT LOOPS - LFIRST=.TRUE. - PLCNT=0 !COUNT PLOTS -C - DO WHILE (WNDXLN(LPOFF)) - 14 CONTINUE - IF (LFIRST) THEN - IF (.NOT.WNDPAR('PLOT_TYPE',OPTION,LEN(OPTION), - 1 J0,OPTION)) THEN !GET TYPE OF PLOT - IF (E_C.EQ.DWC_ENDOFLOOP) GOTO 11 !RETRY SETS - GOTO 14 !RETRY - END IF - IF (J0.LT.0) OPTION='COS' !DEFAULT - IF (J0.EQ.0) GOTO 11 !RETRY SETS - 12 CONTINUE - IF (NGFJ(NGF_TRTYP_J,0).EQ.2) THEN ! baseline sequence - HAFAC=360.*10. !"Circles" to Meters - IF (.NOT.WNDPAR('BAS_RANGE',HASRA, - 1 2*LB_E,J0,'0,3000')) THEN - IF (E_C.EQ.DWC_ENDOFLOOP) GOTO 14 !RETRY - GOTO 12 - END IF - IF (J0.EQ.0) GOTO 14 - IF (J0.LT.0) THEN - HASRA(0)=0. - HASRA(1)=3000. - END IF - 15 CONTINUE - IF (.NOT.WNDPAR('BAS_SCALE',HASC,LB_E,J0,'150.')) THEN !HA_SCALE - IF (E_C.EQ.DWC_ENDOFLOOP) GOTO 12 !RETRY - GOTO 15 - END IF - IF (J0.EQ.0) GOTO 12 - IF (J0.LT.0) HASC=150. !DEFAULT - HASC=HASC/10. !MAKE PER MM - ELSE ! HA sequence - HAFAC=360. !Circles to Deg - IF (.NOT.NSCHAS(1,HASRA)) GOTO 11 !GET HA RANGE - HASRA(1)=HASRA(1)*360. !MAKE DEGREES - HASRA(2)=HASRA(2)*360. - 13 CONTINUE - IF (.NOT.WNDPAR('HA_SCALE',HASC,LB_E,J0,'15.')) THEN !HA_SCALE - IF (E_C.EQ.DWC_ENDOFLOOP) GOTO 12 !RETRY - GOTO 13 - END IF - IF (J0.EQ.0) GOTO 12 - IF (J0.LT.0) HASC=15. !DEFAULT - HASC=HASC/10. !MAKE PER MM - END IF - END IF -C -C GET CUTS -C - 20 CONTINUE - NCUT=0 !CNT CUTS - CSET(0,0)=-1 !CHECK CUTS - CSET(0,1)=-1 - DO WHILE(NGCSTL(FCAOUT,SETS,NGF,NGFP,SNAM,LPOFF)) !GET CUT - IF (NCUT.LT.MXNSET) THEN - NCUT=NCUT+1 !COUNT - IF (.NOT.WNFRD(FCAOUT,NGFHDL,NGF(0,NCUT),NGFP)) THEN - 21 CONTINUE - CALL WNCTXT(F_TP,'!/Error reading cut file') - GOTO 900 - END IF - IF (CSET(0,0).EQ.-1) THEN !SAVE FIRST SET - DO I=0,7 - CSET(I,0)=SNAM(I) - END DO - END IF - DO I=0,7 !SAVE LAST SET - CSET(I,1)=SNAM(I) - END DO - END IF - END DO - IF (NCUT.LE.0) GOTO 40 !NEXT LOOP -C -C SET LENGTHS CUTS -C - 30 CONTINUE - NPTS=NGFJ(NGF_SCN_J,1) !INIT VALUES - HA=NGFE(NGF_HAB_E,1)*HAFAC - HAINC=NGFE(NGF_HAI_E,1)*HAFAC - R0=NGFE(NGF_MAX_E,1) - R1=NGFE(NGF_MIN_E,1) - DO I=2,NCUT - NPTS=MAX(NPTS,NGFJ(NGF_SCN_J,I)) - HA=MIN(HA,NGFE(NGF_HAB_E,I)*HAFAC) - HAINC=MIN(HAINC,NGFE(NGF_HAI_E,I)*HAFAC) - R0=MAX(R0,NGFE(NGF_MAX_E,I)) - R1=MIN(R1,NGFE(NGF_MIN_E,I)) - END DO - CALL WNCTXT(F_TP,'Range: !E5, !E5 units',R1,R0) - 31 CONTINUE - IF (LFIRST) THEN - IF (.NOT.WNDPAR('SCALE',SCAL,LB_E,J0,A_B(-A_OB), - 1 MAX(ABS(R0),ABS(R1))/10.,1)) THEN !GET SCALE - IF (E_C.EQ.DWC_ENDOFLOOP) GOTO 11 - GOTO 31 - END IF - IF (J0.EQ.0) GOTO 11 - IF (J0.LT.0) SCAL=MAX(ABS(R0),ABS(R1))/10. - 32 CONTINUE - IF (.NOT.WNDPAR('OFFSET',OFFS,LB_E,J0,'0.')) THEN !GET OFFSET - IF (E_C.EQ.DWC_ENDOFLOOP) GOTO 31 - GOTO 32 - END IF - IF (J0.EQ.0) GOTO 31 - IF (J0.LT.0) OFFS=0. - END IF - LFIRST=.FALSE. -C -C GET DATA BUFFER -C - BUFL=LB_X*(NCUT+1)*NPTS !GET DATA BUFFER - IF (.NOT.WNGGVA(BUFL,BUFAD)) THEN - CALL WNCTXT(F_TP,'!/Cannot get cutdata buffer') - GOTO 900 - END IF - BUFAD=(BUFAD-A_OB)/LB_X -C -C READ CUT DATA -C - DO I=1,NCUT !READ ALL DATA - IF (.NOT.WNFRD(FCAOUT,NGFJ(NGF_SCN_J,I)*LB_X, - 1 A_X(BUFAD+NPTS*I),NGFJ(NGF_DPT_J,I))) GOTO 21 - END DO -C -C INIT PLOT -C Define page boundaries -C - 60 CONTINUE - HARA(1)=MAX(HASRA(1),HA) !START HA - HARA(2)=MAX(HARA(1),MIN(HASRA(2),HA+(NPTS-1)*HAINC)) !END HA - PG(1,1)=0 !TOTAL AREA - PG(1,2)=XWND-1 - PG(2,1)=YWND-1-(50.+(HARA(2)-HARA(1))/HASC)*YFAC - PG(2,2)=YWND - IF (.NOT.WQ_MPAGE(DQID,NHV,PLDEV,MXNHV,780.,PG(1,1))) THEN - CALL WNCTXT(F_TP,'!Cannot find plotter') - GOTO 80 - END IF -C -C Make heading -C - CALL WNGSGU(DUSER) !GET USER - CALL WQ_MPLR(DQID,NHV,1,1,1.,0) !NORMAL UNITS - CALL WQSTXH(TXTHGT) !TEXT HEIGHT - CALL WNCTXS(TEXT, - 1 ' NGCALC (!AS-!AS) by !AS ',OPTION, - 1 NGFC(NGF_TYP_C+1:NGF_TYP_C+ - 1 NGF_TYP_N),DUSER) !SHOW CUT TYPE - CALL WQ_MDATE(DQID,NHV,TEXT) !DATE - CALL WNCTXS(TEXT,'Node: !AS !60CFile: !AS', - 1 NODOUT,FILOUT) - TXTXY(1)=0. !WRITE HEADING - TXTXY(2)=YWND-9*YFAC - CALL WQTEXT(TXTXY,TEXT) !TEXT - CALL WNCTXS(TEXT,'Sector range: !AS - !AS'// - 1 '!60CField: !AL12', - 1 WNTTSG(CSET(0,0),0),WNTTSG(CSET(0,1),0), - 1 NGF(NGF_NAM_1,1)) - TXTXY(1)=0. !WRITE HEADING - TXTXY(2)=YWND-12*YFAC - CALL WQTEXT(TXTXY,TEXT) !TEXT - CALL WNCTXS(TEXT, - 1 '!60COffset: !E10.3 units',OFFS)!ZERO OFFSET - TXTXY(1)=0. !WRITE HEADING - TXTXY(2)=YWND-15*YFAC - CALL WQTEXT(TXTXY,TEXT) !TEXT - TXTXY(1)=210*XFAC !CUT 1CM.LINE BEGIN (Y) - TXTXY(2)=YWND-13*YFAC - TXTXY(3)=210*XFAC - TXTXY(4)=YWND-15*YFAC - CALL WQPOLL(2,TXTXY) !POLYLINE - TXTXY(1)=210*XFAC !CUT 1CM. LINE (X) - TXTXY(2)=YWND-14*YFAC - TXTXY(3)=220*XFAC - TXTXY(4)=TXTXY(2) - CALL WQPOLL(2,TXTXY) !POLYLINE - TXTXY(1)=220*XFAC !CUT 1CM. LINE END (Y) - TXTXY(2)=YWND-13*YFAC - TXTXY(3)=220*XFAC - TXTXY(4)=YWND-15*YFAC - CALL WQPOLL(2,TXTXY) !POLYLINE - CALL WNCTXS(TXT2,'= !E10.3 units',SCAL*10.) - TXTXY(1)=222.*XFAC !CUT RULE - TXTXY(2)=YWND-15*YFAC - CALL WQTEXT(TXTXY,TXT2) !TEXT -C -C HA ANNOTATION -C - R0=10.*HASC !DEGREE PER CM - IF (R0.LE.2) THEN - I=2 - ELSE IF (R0.LE.5) THEN - I=5 - ELSE IF (R0.LE.10) THEN - I=10 - ELSE IF (R0.LE.30) THEN - I=30 - ELSE IF (R0.LE.45) THEN - I=45 - ELSE - I=90 - END IF - DO R1=WNMEJC(HARA(1)/FLOAT(I))*FLOAT(I), - 1 WNMEJF(HARA(2)/FLOAT(I))*FLOAT(I), - 1 FLOAT(I) ! DRAW HA MARKS - CALL WNCTXS(TXT1,'!3$SJ',NINT(R1)) - POINXY(1,1)=0 - POINXY(2,1)=YWND-(35.+ - 1 (R1-HARA(1))/HASC)*YFAC-TXTHGT/(18./7.) - CALL WQTEXT(POINXY,TXT1) - TXTXY(1)=30. ! PLOT 1CM. LINE (X) - TXTXY(2)=YWND-(35.+(R1-HARA(1))/HASC)*YFAC - TXTXY(3)=40. - TXTXY(4)=TXTXY(2) - CALL WQPOLL(2,TXTXY) ! - TXTXY(1)=XWND-11. ! PLOT 0.25 CM. LINE (X) - TXTXY(3)=XWND-1 - CALL WQPOLL(2,TXTXY) - END DO -C -C Leading zero level plus annotation -C - R0=(XWND-80)/(NCUT+1) ! CUT SPACING IN MM - CALL WQSTXU(UP(3)) ! TEXT DIRECTION - DO I=0,NCUT-1 - IFOFF(I)=NINT(40.+((I+1)*R0)) ! horizontal OFFSETS of CUTS - TXTXY(1)=IFOFF(I) - TXTXY(2)=YWND-27.*YFAC - TXTXY(3)=IFOFF(I) - TXTXY(4)=YWND-YFAC*31. - CALL WQPOLL(2,TXTXY) ! zero lines - POINXY(1,1)=IFOFF(I)-TXTHGT/2. - POINXY(2,1)=TXTXY(2)+4.*TXTHGT*8./9. - CALL WNCTXS(TEXT(1:4),'!2$AL2!2$AL2', - 1 NGF(NGF_IFR_1,I+1), - 1 NGF(NGF_POL_1,I+1)) ! annotation, e.g. 37XY or 3 X - CALL WQTEXT(POINXY,TEXT(1:4)) -C -C Start values for plot -C - NEW(I)=IFOFF(I) - OLD(I)=NGCDLC ! force dashed connecting line - LASTV(I)=NEW(I) - LASTH(I)=TXTXY(4) ! vert. end posn. of zero line - END DO - CALL WQSTXU(UP(1)) !TEXT DIRECTION -C -C PLOT: For each HA value, plot connecting line between current and previous -C point for all plots. -C - DO R1=HARA(1),HARA(2)+1.1*HAINC,HAINC ! all HA plus one to get - ! last point emphasised - DO I=0,NCUT-1 ! ALL cuts - I2=NINT((R1/HAFAC-NGFE(NGF_HAB_E,I+1))/ - 1 NGFE(NGF_HAI_E,I+1)) !DATA OFFSET in cut vector -C -C Get data value -C - NEW(I)=NGCDLC ! assume DELETE - IF (R1.LE.HARA(2)+.1*HAINC) THEN ! regular value - IF (I2.LT.0 .OR. I2.GE. NGFJ(NGF_SCN_J,I+1)) THEN - ELSE - IF (REAL(A_X(BUFAD+(I+1)*NPTS+I2)) - 1 .EQ.NGCDLC) THEN - R0=NGCDLC !DELETED DATA - ELSE IF (OPT(1:1).EQ.'S') THEN ! sine - R0=AIMAG(A_X(BUFAD+(I+1)*NPTS+I2)) - ELSE IF (OPT(1:1).EQ.'A') THEN ! amplitude - R0=ABS(A_X(BUFAD+(I+1)*NPTS+I2)) - ELSE IF (OPT(1:1).EQ.'P') THEN ! phase - IF (REAL(A_X(BUFAD+(I+1)*NPTS+I2)).EQ.0) THEN - R0=SIGN(PI/2.,AIMAG(A_X(BUFAD+(I+1)*NPTS+I2))) - ELSE - R0=ATAN2(AIMAG(A_X(BUFAD+(I+1)*NPTS+I2)), - 1 REAL(A_X(BUFAD+(I+1)*NPTS+I2))) - END IF - ELSE - R0=REAL(A_X(BUFAD+(I+1)*NPTS+I2))! cosine - END IF - IF (R0.NE.NGCDLC) NEW(I)=(R0-OFFS)/SCAL* - 1 XFAC+IFOFF(I) ! SCALE VALUE - END IF - ENDIF -C -C Plot line from previous point -C - IF (NEW(I).NE.NGCDLC) THEN ! valid point - IF (OLD(I).NE.NGCDLC) THEN ! was previous point skipped? - LIX=DRAWN ! no, full line - ELSE - LIX=DASHED ! next line dashed - ENDIF - POINXY(1,1)=LASTV(I) ! retrieve last - POINXY(2,1)=LASTH(I) ! valid point - POINXY(1,2)=NEW(I) ! current hor. posn - POINXY(2,2)=YWND-YFAC*(35.+(R1-HARA(1)) - 1 /HASC) ! current vert. posn - CALL WQPOLL_IX(2,POINXY,LIX) ! line from last val. to current - LASTV(I)=NEW(I) ! new last valid - LASTH(I)=POINXY(2,2) - EMPH(I)=OLD(I).EQ.NGCDLC - ELSEIF (EMPH(I)) THEN ! if prev. point was an - POINXY(1,1)=LASTV(I) ! isolated one, emphasise it - POINXY(1,2)=LASTV(I) - POINXY(2,1)=LASTH(I)-.25*YFAC - POINXY(2,2)=LASTH(I)+.25*YFAC - CALL WQPOLL_IX(2,POINXY,DRAWN) - EMPH(I)=.FALSE. ! emphasise only once - ENDIF - OLD(I)=NEW(I) ! new last - END DO - END DO -C -C Trailing reference line -C - POINXY(2,2)=POINXY(2,2)-YFAC*4. ! 4 units for connecting line - DO I=0,NCUT-1 - NEW(I)=IFOFF(I) - POINXY(1,1)=LASTV(I) ! last valid point - POINXY(2,1)=LASTH(I) - POINXY(1,2)=NEW(I) - CALL WQPOLL_IX(2,POINXY,DASHED) ! connecting line, dashed - END DO - POINXY(2,1)=POINXY(2,2) - POINXY(2,2)=POINXY(2,1)-YFAC*4. ! 4 units for zero line - DO I=0,NCUT-1 - POINXY(1,1)=IFOFF(I) - POINXY(1,2)=IFOFF(I) - CALL WQPOLL_IX(2,POINXY,DRAWN) ! zero line, full - END DO - CALL WQSTXU(UP(5)) ! TEXT DIRECTION - POINXY(2,1)=POINXY(2,2)-4.*TXTHGT*8./9. - DO I=0,NCUT-1 - POINXY(1,1)=IFOFF(I)+TXTHGT/2. - CALL WNCTXS(TEXT(1:4),'!2$AL2!2$AL2', - 1 NGF(NGF_IFR_1,I+1), - 1 NGF(NGF_POL_1,I+1)) ! annotation, e.g. 37XY or 3 X - CALL WQTEXT(POINXY,TEXT(1:4)) - END DO - CALL WQSTXU(UP(1)) ! TEXT DIRECTION - PLCNT=PLCNT+1 ! PLOT COUNT - CALL WNCTXT(F_TP,'Plot !UJ produced',PLCNT) -C -C FINISH -C - 80 CONTINUE - CALL WNGFVA(BUFL,BUFAD*LB_X+A_OB) !RELEASE BUFFER - CALL WQ_MCLOSE(DQID,NHV) !CLOSE DEVICE - CALL WQCLOS !CLOSE WQ SYSTEM -40 CONTINUE - ENDDO ! next plot - GOTO 11 !MORE LOOPS -C -C READY -C - 900 CONTINUE - RETURN -C -C - END diff --git a/src/nplot/ngcpmh.for b/src/nplot/ngcpmh.for deleted file mode 100644 index b1cbae58f7fc27c0fc5c181cd67c656b86eae33e..0000000000000000000000000000000000000000 --- a/src/nplot/ngcpmh.for +++ /dev/null @@ -1,82 +0,0 @@ -C+ NGCPMH.FOR -C WNB 920820 -C -C Revisions: -C - SUBROUTINE NGCPMH(T,NGF,MNAM,WMPNOD) -C -C Print/type Plot-header -C -C Result: -C -C CALL NGCPMH (T_J:I, NGF_B(0:*):I, MNAM_J(0:7):I, WMPNOD_C*:I) -C Show on output T the plot header -C NGF with name MNAM in node WMPNOD. -C Include files: -C - INCLUDE 'WNG_DEF' - INCLUDE 'NGF_O_DEF' -C -C Parameters: -C -C -C Arguments: -C - INTEGER T !PRINTING TYPE - BYTE NGF(0:*) !PLOT HEADER - INTEGER MNAM(0:7) !PLOT NAME - CHARACTER*(*) WMPNOD !NODE NAME -C -C Function references: -C - CHARACTER*32 WNTTSG !GET PLOT SET NAME - INTEGER WNGGJ !GET J VALUE - REAL WNGGE !GET E VALUE -C -C Data declarations: -C -C- -C -C FILE INFO -C - CALL WNCTXT(T,'!/!AS(#!UJ) in node !AS', - 1 WNTTSG(MNAM,0),NGF(NGF_SETN_1),WMPNOD) -C -C GENERAL INFO -C - CALL WNCTXT(T,'!/Field: !AL12!26CInterf.'// - 1 '/Tel.: !AL4'// - 1 '!51CPol: !AL4', - 1 NGF(NGF_NAM_1),NGF(NGF_IFR_1),NGF(NGF_POL_1)) -C -C DATA DESCRIPTION -C - CALL WNCTXT(T, '!/RA (date)!12C!9$EPF9.4 deg!26CFrequency'// - 1 '!37C!9$E9.4 MHz!51CUT start!67C!EHF4'// - 1 '!/DEC(date)!12C!9$EAF9.4 deg!26CBandwidth'// - 1 '!37C!9$E9.4 MHz!51CUT end!67C!EHF4'// - 1 '!/HA start!12C!9$EAF9.4 deg!26CBand!40C!6$UJ'// - 1 '!51CHA step!63C!9$EPF9.4 deg'// - 1 '!/HA end!12C!9$EAF9.4 deg!26CVolgnumber!10$UJ'// - 1 '!51CObs.date!67C!2$UI.!3$ZI'// - 1 '!/Maximum!11C!10$E10.2!26CMinimum!36C!10$E10.2'// - 1 '!51CDeleted!66C!6$UJ'// - 1 '!/Datapoints!15C!6$UJ!26CType!35C!AL40!/', - 1 NGF(NGF_RA_1),NGF(NGF_FRQ_1),NGF(NGF_UTB_1), - 1 NGF(NGF_DEC_1),NGF(NGF_BDW_1),NGF(NGF_UTE_1), - 1 NGF(NGF_HAB_1),NGF(NGF_BDN_1), - 1 NGF(NGF_HAI_1),WNGGE(NGF(NGF_HAB_1))+ - 1 (WNGGJ(NGF(NGF_SCN_1))-1)* - 1 WNGGE(NGF(NGF_HAI_1)), - 1 NGF(NGF_VNR_1),NGF(NGF_OYR_1), - 1 NGF(NGF_ODY_1), - 1 NGF(NGF_MAX_1),NGF(NGF_MIN_1),NGF(NGF_DEL_1), - 1 NGF(NGF_SCN_1),NGF(NGF_TYP_1)) -C -C FILE INFO -C -C - RETURN -C -C - END diff --git a/src/nplot/ngcprt.for b/src/nplot/ngcprt.for deleted file mode 100644 index 233b6c8bdbeb56796aed4dfd025f66395c893006..0000000000000000000000000000000000000000 --- a/src/nplot/ngcprt.for +++ /dev/null @@ -1,203 +0,0 @@ -C+ NGCPRT.FOR -C WNB 920820 -C -C Revisions: -C HjV 930423 Change name of some keywords -C WNB 930628 Change PLOT_ACTION into SET_ACTION -C SCN_SETS into NGF_SETS -C WNB 931214 No auto SHOW if EDIT -C CMV 931220 Separate LAYOUT and OVERVIEW options -C CMV 931220 Pass FCA of input file to WNDXLP and WNDSTA/Q -C CMV 940811 Print only defined baselines if TRTYP=2 -C HjV 950530 Change SET_ACTION in SECTOR_ACTION -C - SUBROUTINE NGCPRT -C -C Show/edit data in NGF file -C -C Result: -C -C CALL NGCPRT will show and/or edit data in NGF file -C -C PIN references: -C -C FILE_ACTION -C SECTOR_ACTION -C DATA_ACTION -C -C Include files: -C - INCLUDE 'WNG_DEF' - INCLUDE 'NGC_DEF' - INCLUDE 'NGF_O_DEF' !PLOT HEADER -C -C Parameters: -C -C -C Arguments: -C -C -C Function references: -C - LOGICAL WNDPAR !GET DWARF PARAMETER - LOGICAL WNFRD !READ FILE - LOGICAL WNDSTA !GET PLOTS TO DO - LOGICAL NGCSTG !GET A PLOT -C -C Data declarations: -C - CHARACTER*24 ACT !ACTION ASKED - INTEGER NGFP !SUB-GROUP POINTER - INTEGER SNAM(0:7) !SET NAME - COMPLEX LBUF(0:8191) !DATA BUF - REAL EBUF(0:8191) - EQUIVALENCE (LBUF,EBUF) - BYTE NGF(0:NGFHDL-1) !PLOT HEADER - INTEGER NGFJ(0:NGFHDL/4-1) - INTEGER*2 NGFI(0:NGFHDL/2-1) - REAL NGFE(0:NGFHDL/4-1) - EQUIVALENCE (NGF,NGFJ,NGFI,NGFE) -C- -C -C SHOW FILE HEADER -C - CALL NSCPFH(F_TP,FCAOUT) !PRINT FILE HEADER -C -C FILE ACTION -C - 101 CONTINUE - IF (.NOT.WNDPAR('FILE_ACTION',ACT,LEN(ACT),J,'CONT')) THEN !FILE ACTION - IF (E_C.EQ.DWC_ENDOFLOOP) THEN !^Z - 102 CONTINUE - RETURN !READY - END IF - GOTO 101 !RETRY - ELSE IF (E_C.EQ.DWC_NULLVALUE) THEN - GOTO 102 !READY - ELSE IF (E_C.EQ.DWC_WILDCARD) THEN - ACT='CONT' !ASSUME CONT - END IF - IF (ACT.EQ.'LAYOUT') THEN !SHOW LAYOUT - CALL NGCPFL(F_TP,FCAOUT,NODOUT,.FALSE.) !SHOW LAYOUT - ELSE IF (ACT.EQ.'OVERVIEW') THEN !SHOW OVERVIEW - CALL NGCPFL(F_TP,FCAOUT,NODOUT,.TRUE.) !SHOW OVERVIEW - ELSE IF (ACT.EQ.'SHOW') THEN !SHOW DETAILS - CALL NSCXFH(F_TP,FCAOUT) - ELSE IF (ACT.EQ.'EDIT') THEN !EDIT - CALL NSCEFH(F_TP,FCAOUT) !EDIT HEADER - ELSE IF (ACT.EQ.'CONT') THEN !CONT - GOTO 200 !DO PLOT - ELSE - GOTO 102 !QUIT - END IF - GOTO 101 !UNKNOWN -C -C DO PLOT -C - 200 CONTINUE - IF (.NOT.WNDSTA('NGF_SETS',MXNSET,SETS,FCAOUT)) GOTO 102 !GET SETS TO DO - IF (SETS(0,0).EQ.0) GOTO 102 !NONE - 201 CONTINUE !DO NEXT SET - IF (.NOT.NGCSTG(FCAOUT,SETS,NGF,NGFP,SNAM)) GOTO 102 !GET PLOT - CALL NGCPMH(F_TP,NGF,SNAM,NODOUT) !SHOW PLOT HEADER -C -C PLOT ACTION -C - 301 CONTINUE - IF (.NOT.WNDPAR('SECTOR_ACTION',ACT,LEN(ACT),J,'CONT')) THEN !PLOT ACTION - IF (E_C.EQ.DWC_ENDOFLOOP) GOTO 101 !^Z, RETRY FILE ACTION - GOTO 301 !RETRY - ELSE IF (E_C.EQ.DWC_NULLVALUE) THEN - GOTO 101 !RETRY FILE ACTION - ELSE IF (E_C.EQ.DWC_WILDCARD) THEN - ACT='CONT' !ASSUME CONT - END IF - IF (ACT.EQ.'NEXT') THEN !NEXT PLOT - GOTO 201 !NEXT PLOT - ELSE IF (ACT.EQ.'SHOW') THEN !SHOW DETAILS - CALL NGCXMH(F_TP,FCAOUT,NGFP,SNAM) - ELSE IF (ACT.EQ.'EDIT') THEN !EDIT - CALL NGCEMH(F_TP,FCAOUT,NGFP,SNAM) !EDIT - ELSE IF (ACT.EQ.'CONT') THEN !CONT - GOTO 400 !DO DATA - ELSE - GOTO 101 !QUIT - END IF - GOTO 301 !UNKNOWN -C -C DO DATA -C - 400 CONTINUE - 401 CONTINUE - IF (.NOT.WNDPAR('DATA_ACTION',ACT,LEN(ACT),J,'Q')) THEN !ACTION - IF (E_C.EQ.DWC_ENDOFLOOP) GOTO 301 !^Z, RETRY SET ACTION - GOTO 401 !RETRY - ELSE IF (E_C.EQ.DWC_NULLVALUE) THEN - GOTO 301 !RETRY SET ACTION - ELSE IF (E_C.EQ.DWC_WILDCARD) THEN - ACT='Q' !ASSUME > - END IF - CALL WNCAUC(ACT) !MAKE UC - IF (ACT(1:1).EQ.'Q') THEN !QUIT - GOTO 301 - ELSE IF (ACT(1:1).EQ.'S' .OR. ACT(1:1).EQ.'A' .OR. - 1 ACT(1:1).EQ.'P') THEN !SHOW DATA -C -C DATA DISPLAY -C - IF (.NOT.WNFRD(FCAOUT,LB_X*NGFJ(NGF_SCN_J), - 1 LBUF,NGFJ(NGF_DPT_J))) THEN !READ - CALL WNCTXT(F_TP,'Error reading plot') - GOTO 401 - END IF - IF (NGFJ(NGF_TRTYP_J).EQ.2) THEN - DO I=0,NGFJ(NGF_SCN_J)-1 - IF (REAL(LBUF(I)).NE.NGCDLC) THEN - R1=(NGFE(NGF_HAB_E)+I*NGFE(NGF_HAI_E))*360.*10. - IF (ACT(1:1).EQ.'S') THEN - CALL WNCTXT(F_TP,'!5$UJ\. !6$E6.0 m !20$EC9.2', - 1 I,R1,LBUF(I)) - ELSE IF (ACT(1:1).EQ.'A') THEN - CALL WNCTXT(F_TP,'!5$UJ\. !6$E6.0 m !10$E9.2', - 1 I,R1,ABS(LBUF(I))) - ELSE IF (ACT(1:1).EQ.'P') THEN - IF (REAL(LBUF(I)).EQ.0) THEN - R0=SIGN(PI/2.,AIMAG(LBUF(I))) - ELSE - R0=ATAN2(AIMAG(LBUF(I)),REAL(LBUF(I))) - END IF - CALL WNCTXT(F_TP, - 1 '!5$UJ\. !6$E6.0 m !20$EAR9.2',I,R1,R0) - END IF - END IF - END DO - ELSE - IF (ACT(1:1).EQ.'S') THEN - CALL WNCTXT(F_TP,'!80$1Q1!20$#EC9.2', - 1 NGFJ(NGF_SCN_J),LBUF) !SHOW DATA - ELSE IF (ACT(1:1).EQ.'A') THEN !SHOW AMPL. DATA - DO I=0,NGFJ(NGF_SCN_J)-1 - EBUF(I)=ABS(LBUF(I)) - END DO - CALL WNCTXT(F_TP,'!80$1Q1!10$#E9.2', - 1 NGFJ(NGF_SCN_J),LBUF) - ELSE IF (ACT(1:1).EQ.'P') THEN !SHOW PHASE DATA - DO I=0,NGFJ(NGF_SCN_J)-1 - IF (REAL(LBUF(I)).EQ.0) THEN - EBUF(I)=SIGN(PI/2.,AIMAG(LBUF(I))) - ELSE - EBUF(I)=ATAN2(AIMAG(LBUF(I)),REAL(LBUF(I))) - END IF - END DO - CALL WNCTXT(F_TP,'!80$1Q1!10$#EAR9.2', - 1 NGFJ(NGF_SCN_J),LBUF) - END IF - END IF - END IF -C -C NEXT ACTION -C - GOTO 401 !NEXT ACTION -C -C - END diff --git a/src/nplot/ngcsph.for b/src/nplot/ngcsph.for deleted file mode 100644 index c790fabc872362e94e0888d60a27489b5985f270..0000000000000000000000000000000000000000 --- a/src/nplot/ngcsph.for +++ /dev/null @@ -1,94 +0,0 @@ -C+ NGCSPH.FOR -C WNB 920826 -C -C Revisions: -C WNB 930709 Add file number -C JPH 940810 Narrow down format to <80 chars. -C Add NGCSPL -C JPH 940818 Widen space for index from 24 to 32 chars -C JPH 940819 Add NGCSPC -C Leave out VNR to get more space for TYP -C -C - SUBROUTINE NGCSPH(SNAM,NGF) -C -C Show brief data in NGF file -C -C Result: -C -C CALL NGCSPH( SNAM_J(0:7):I, NGF_B(*):I -C will show data in NGF file SNAM -C CALL NGCSPL( SNAM_J(0:7):I, NGF_B(*):I -C will give a terminal message showing the -C program is alive -C CALL NGCSPC( SNAM_J(0:7):I, NGF_B(*):I, COUNTS_J(4:5):I) -C will show grp.fld.chn with pol, iort and seq -C counts -C -C Include files: -C - INCLUDE 'WNG_DEF' - INCLUDE 'NGC_DEF' - INCLUDE 'NGF_O_DEF' !PLOT HEADER - -C -C Parameters: -C -C -C Arguments: -C - INTEGER SNAM(0:7) !SET NAME - BYTE NGF(0:NGFHDL-1) !DATA - INTEGER NDONE !NR OF CUTS DONE - INTEGER CNT(3:5) !POL, IFR/TEL AND CUT COUNTS -C -C Function references: -C - CHARACTER*32 WNTTSG !SET NAME -C -C Data declarations: - INTEGER S3 !SAVE SNAM(3) -C -C- -C -C SHOW PLOT -C - SNAM(6)=-1 !ASSURE END - CALL WNCTXT(F_TP,'!5$UJ !AS!24C !-12$AL12'// - 1 ' !-35$AL35'// - 1 ' !2$AL2!2$AL2', - 1 NGF(NGF_SETN_1),WNTTSG(SNAM,0),NGF(NGF_NAM_1), - 1 NGF(NGF_TYP_1), - 1 NGF(NGF_IFR_1),NGF(NGF_POL_1)) -C -C READY -C - RETURN -C -C - ENTRY NGCSPL(SNAM,NGF,NDONE) -C - S3=SNAM(3) - SNAM(3)=-1 - CALL WNCTXT(F_T,'At !AS!18C !-12$AL12 !-35$AL35 - !UJ done', - 1 WNTTSG(SNAM,0),NGF(NGF_NAM_1), - 1 NGF(NGF_TYP_1), NDONE) - SNAM(3)=S3 - RETURN -C -C - ENTRY NGCSPC(SNAM,NGF,CNT) -C - S3=SNAM(3) - SNAM(3)=-1 - CALL WNGMV(4,NGF(NGF_SCN_1),I) - CALL WNCTXT(F_TP,'!5$UJ !AS!14C !-12$AL12 !-35$AL35'// - 1 ' !1$UJ\*!3$UJ\*!4$UJ*!4$UJ', - 1 NGF(NGF_SETN_1), - 1 WNTTSG(SNAM,0),NGF(NGF_NAM_1), - 1 NGF(NGF_TYP_1), - 1 CNT(3), CNT(4)/CNT(3), CNT(5)/CNT(4), - 1 I) - SNAM(3)=S3 -C - END diff --git a/src/nplot/ngcstg.for b/src/nplot/ngcstg.for deleted file mode 100644 index a1628f56ed1e857569c008b1465c7209fa20dc42..0000000000000000000000000000000000000000 --- a/src/nplot/ngcstg.for +++ /dev/null @@ -1,98 +0,0 @@ -C+ NGCSTG.FOR -C WNB 920820 -C -C Revisions: -C - LOGICAL FUNCTION NGCSTG(FCA,SETS,NGF,NGFP,SNAM) -C -C Get next plot set -C -C Result: -C -C NGCSTG_L = NGCSTG( FCA_J:I, SETS_J(0:7,0:*):IO, NGF_B(0:*):O, -C NGFP_J:O, SNAM_J(0:7):O) -C Get next set in file FCA, using the -C specification in SETS (see WNDSTA). -C NGCSTG will be .false. if no more sets. -C NGF will be the header of the set, NGFP the -C diskpointer. SNAM is the full name of the -C group, coded. A check is made for the right -C version. -C NGCSTH_L = NGCSTH( FCA_J:I, SETS_J(0:7,0:*):IO, NGF_B(0:*):O, -C NGFP_J:O, SNAM_J(0:7):O) -C Same, but no check for version -C NGCSTL_L = NGCSTL( FCA_J:I, SETS_J(0:7,0:*):IO, NGF_B(0:*):O, -C NGFP_J:O, SNAM_J(0:7):O, -C OFFSET_J(0:7):I) -C As NGCSTG, but the check in the set list SETS -C is done with offsets OFFSET. -C -C Include files: -C - INCLUDE 'WNG_DEF' - INCLUDE 'NGF_O_DEF' !SET HEADER -C -C Parameters: -C -C -C Entry points: -C - LOGICAL NGCSTH !NO VERSION CHECK - LOGICAL NGCSTL !OFFSET FOR LOOPS -C -C Arguments: -C - INTEGER FCA !FILE TO SEARCH - INTEGER SETS(0:7,0:*) !SETS TO DO - BYTE NGF(0:*) !SET HEADER - INTEGER NGFP !POINTER TO SET HEADER - INTEGER SNAM(0:7) !FULL SET NAME - INTEGER OFFSET(0:7) !CHECK OFFSET FOR LOOPS -C -C Function references: -C - LOGICAL WNFRD !READ DISK - LOGICAL WNDSTG !FUNCTIONS THAT DO THE WORK - LOGICAL WNDSTH,WNDSTL -C -C Data declarations: -C -C- - NGCSTG=WNDSTG(FCA,SETS,NGFHDV,NGFP,SNAM) !GET SET - GOTO 10 -C -C NGCSTH -C - ENTRY NGCSTH(FCA,SETS,NGF,NGFP,SNAM) -C - NGCSTH=WNDSTH(FCA,SETS,NGFHDV,NGFP,SNAM) !GET SET - GOTO 10 -C -C NGCSTL -C - ENTRY NGCSTL(FCA,SETS,NGF,NGFP,SNAM,OFFSET) -C - NGCSTL=WNDSTL(FCA,SETS,NGFHDV,NGFP,SNAM,OFFSET) !GET SET - GOTO 10 -C -C SET SET HEADER -C - 10 CONTINUE - IF (NGCSTG) THEN !ONE FOUND - IF (.NOT.WNFRD(FCA,NGFHDL,NGF(0),NGFP)) GOTO 900 !READ SET HEADER - END IF -C - RETURN -C -C ERROR -C - 900 CONTINUE - DO I=1,7 - SETS(I,0)=0 !RESET SEARCH - END DO - NGCSTG=.FALSE. !NO MORE -C - RETURN -C -C - END diff --git a/src/nplot/ngctrp.for b/src/nplot/ngctrp.for deleted file mode 100644 index e040dede8b51ffb102dbdcbeea77301d17e59a60..0000000000000000000000000000000000000000 --- a/src/nplot/ngctrp.for +++ /dev/null @@ -1,324 +0,0 @@ -C+ NGCTRP.FOR -C WNB 920902 -C -C Revisions: -C WNB 921104 Full HA range -C HjV 930423 Change name of some Keywords -C WNB 930628 Add POL and BLN in output -C WNB 930630 Some small typos; add TRHA, TRHAI, TRFB, TRFI, FRHACV -C WNB 930630 Better HA and frequency calculation -C WNB 930826 New HA range -C CMV 931210 Add 'NGF_LOOPS' argument to WNDXLP -C CMV 931220 Pass FCA of input file to WNDXLP and WNDSTA/Q -C CMV 940805 No action for TRTYP=2 on input plot -C JPH 940818 NGF_LOOPD before NGF_SETS as in other Newstar programs -C -C - SUBROUTINE NGCTRP -C -C Make transposed files -C -C Result: -C -C CALL NGCTRP Make transposed (freq. channel <> HA) -C plots -C -C -C Pin references: -C -C NGF_SETS Plots to use -C -C Include files: -C - INCLUDE 'WNG_DEF' - INCLUDE 'GFH_O_DEF' !GENERAL FILE HEADER - INCLUDE 'SGH_O_DEF' !SUB-GROUP HEADER - INCLUDE 'NGF_O_DEF' !PLOT HEADER - INCLUDE 'NGC_DEF' -C -C Parameters: -C -C -C Arguments: -C -C -C Function references: -C - LOGICAL WNDPAR !GET USER DATA - LOGICAL WNDLNG,WNDLNK,WNDLNF !LINK SETS - LOGICAL WNDSTA !GET SETS - LOGICAL WNDXLP !GET LOOPS - LOGICAL WNDXLN !NEXT LOOP - LOGICAL WNFRD !READ DISK - LOGICAL WNFWR !WRITE DISK - INTEGER WNFEOF !EOF POINTER - LOGICAL WNGGVA !GET MEMORY - CHARACTER*32 WNTTSG !SET NAME - LOGICAL NGCSTG,NGCSTL !GET PLOT - LOGICAL NSCHAS !GET HA RANGE -C -C Data declarations: -C - INTEGER NPLOT !# OF PLOTS TO USE - INTEGER PLOTS(MXNCHN,2) !PLOTS TO USE - INTEGER SNAM(0:7,MXNCHN) !PLOT NAME - REAL HASRA(0:1) !HA RANGE - INTEGER NGFHP !HEADER POINTER - CHARACTER*(NGF_TYP_N) HSTR,HSTR1 - INTEGER NPTS !LENGTH SINGLE PLOT - REAL HA,HAE !START,END HA OUTPUT PLOT - REAL HAINC !HA INCREMENT OUTPUT PLOT - REAL CHA !HA CURRENT POINT - REAL CUT !UT CURRENT POINT - REAL FRQ,BDW,FRQI,TRHA !CURRENT FREQUENCY DATA - INTEGER BDN,FRQIN - INTEGER CRANGE(0:1) !MIN. MAX. CHANNEL - INTEGER TRTYP !CURRENT TRANSPOSE TYPE - INTEGER BUFL,BUFL1 !LENGTH DATA BUFFER - INTEGER BUFAD,BUFAD1 !ADDRESS DATA BUFFER - BYTE NGF(0:NGFHDL-1,0:MXNCHN) !PLOT HEADERS - INTEGER*2 NGFI(0:NGFHDL/2-1,0:MXNCHN) - INTEGER NGFJ(0:NGFHDL/4-1,0:MXNCHN) - REAL NGFE(0:NGFHDL/4-1,0:MXNCHN) - EQUIVALENCE (NGF,NGFI,NGFJ,NGFE) - COMPLEX C2 -C- -C -C INIT -C - DO I=0,7 !SET CURRENT JOB - SETS(I,1)=-1 - END DO - SETS(0,0)=1 - SETS(0,1)=SGNR(0) - CALL WNDSTR(FCAOUT,SETS) !RESET SEARCH - IF (NGCSTG(FCAOUT,SETS,NGF(0,0), - 1 NGFHP,SNAM(0,0))) THEN !ONE PRESENT - IF (.NOT.WNDLNG(GFH_LINKG_1,0,SGH_GROUPN_1,FCAOUT, - 1 SGPH(0),SGNR(0))) GOTO 51 !CREATE JOB SET - END IF -C -C GET PLOTS -C - 10 CONTINUE - 12 CONTINUE - IF (.NOT.WNDXLP('NGF_LOOPS',FCAOUT)) THEN - IF (E_C.EQ.DWC_ENDOFLOOP) GOTO 10 !SETS AGAIN - END IF - IF (.NOT.WNDSTA('NGF_SETS',MXNSET,SETS,FCAOUT)) GOTO 900 !PLOTS TO USE - IF (SETS(0,0).EQ.0) GOTO 900 - CALL WNDXLI(LPOFF) !INIT LOOPING -C -C GET RANGE -C - IF (.NOT.NSCHAS(1,HASRA)) GOTO 10 !GET HA RANGE - HASRA(0)=HASRA(0)*360. !MAKE DEGREES - HASRA(1)=HASRA(1)*360. -C -C GET PLOTS -C - 30 CONTINUE - IF (.NOT.WNDXLN(LPOFF)) GOTO 10 !NO MORE LOOPS - NPLOT=0 !CNT PLOTS - DO WHILE(NGCSTL(FCAOUT,SETS,NGF(0,NPLOT+1), - 1 NGFHP,SNAM(0,NPLOT+1),LPOFF)) !GET PLOT - IF (NPLOT.LT.MXNCHN-1) THEN - NPLOT=NPLOT+1 !COUNT - PLOTS(NPLOT,2)=NGFHP !SAVE HEADER POINTER - PLOTS(NPLOT,1)=NPLOT !A NUMBER - CALL WNDSTI(FCAOUT,SNAM(0,NPLOT)) !PROPER NAME - END IF - END DO - IF (NPLOT.LE.0) GOTO 30 !NEXT LOOP -C -C SET LENGTHS PLOTS -C - NPTS=NGFJ(NGF_SCN_J,1) !INIT VALUES - HA=NGFE(NGF_HAB_E,1)*360. - HAINC=NGFE(NGF_HAI_E,1)*360. - HAE=NGFE(NGF_HAB_E,1)*360.+(NPTS-1)*HAINC - CRANGE(0)=SNAM(2,1) - CRANGE(1)=SNAM(2,1) -C - TRTYP=NGFJ(NGF_TRTYP_J,1) - IF (TRTYP.NE.0.AND.TRTYP.NE.1) THEN - CALL WNCTXT(F_TP, - 1 '!/Cannot transpose plots with transpose type !UJ', - 1 TRTYP) - GOTO 30 !NEXT LOOP - END IF -C - FRQ=NGFE(NGF_FRQ_E,1) - BDW=NGFE(NGF_BDW_E,1) - BDN=SNAM(2,1) - FRQI=0 - FRQIN=0 - TRHA=NGFE(NGF_TRHA_E,1) -C - DO I=2,NPLOT - NPTS=MAX(NPTS,NGFJ(NGF_SCN_J,I)) - HA=MIN(HA,NGFE(NGF_HAB_E,I)*360.) - HAINC=MIN(HAINC,NGFE(NGF_HAI_E,I)*360.) - HAE=MAX(HAE,NGFE(NGF_HAB_E,I)*360.+(NGFJ(NGF_SCN_J,I)-1)* - 1 NGFE(NGF_HAI_E,I)*360.) - CRANGE(0)=MIN(CRANGE(0),SNAM(2,I)) - CRANGE(1)=MAX(CRANGE(1),SNAM(2,I)) - IF (CRANGE(0).EQ.SNAM(2,I)) TRHA=NGFE(NGF_TRHA_E,I) !LOWEST HA - IF (SNAM(2,I).NE.BDN) THEN !FREQ. DIFFERENCE - FRQI=FRQI+(NGFE(NGF_FRQ_E,I)-FRQ)/(SNAM(2,I)-BDN) - FRQIN=FRQIN+1 - END IF - IF (TRTYP.NE.NGFJ(NGF_TRTYP_J,I)) THEN - CALL WNCTXT(F_TP,'!/Cannot transpose different types') - GOTO 30 !NEXT LOOP - END IF - END DO -C - NPTS=MAX(NPTS,NINT((HAE-HA)/HAINC)+1) - IF (FRQIN.EQ.0) THEN - FRQI=BDW - ELSE - FRQI=FRQI/FRQIN !AVERAGE FREQ. STEP - END IF -C - BUFL=LB_X*(NPLOT+1)*NPTS !GET DATA BUFFER - IF (.NOT.WNGGVA(BUFL,BUFAD)) THEN - 22 CONTINUE - CALL WNCTXT(F_TP,'!/Cannot get plotdata buffer') - GOTO 900 - END IF - BUFAD=(BUFAD-A_OB)/LB_X -C - BUFL1=LB_X*(CRANGE(1)-CRANGE(0)+1) !COUNT BUFFER - IF (.NOT.WNGGVA(BUFL1,BUFAD1)) THEN - CALL WNGFVA(BUFL,BUFAD*LB_X+A_OB) - GOTO 22 - END IF - BUFAD1=(BUFAD1-A_OB)/LB_X - CALL WNGMVZ(BUFL,A_X(BUFAD)) !ZERO BUFFERS - DO I=0,CRANGE(1)-CRANGE(0) !SET DELETED - A_X(BUFAD1+I)=CMPLX(NGCDLC,NGCDLC) - END DO -C -C READ PLOT DATA -C - DO I=1,NPLOT !READ ALL DATA - IF (.NOT.WNFRD(FCAOUT,LB_X*NGFJ(NGF_SCN_J,I), - 1 A_X(BUFAD+I*NPTS),NGFJ(NGF_DPT_J,I))) THEN -21 CONTINUE - CALL WNCTXT(F_TP,'!/Error reading plot file #!UJ', - 1 IAND(PLOTS(I,1),NOT(NGCSDL))) - GOTO 10 !RETRY EXPRESSION - END IF - END DO -C -C BUILD TRANSPOSED PLOTS -C - DO I1=0,NPTS-1 !ALL DATA - CHA=HA+I1*HAINC !CURRENT HA - IF (CHA.GE.HASRA(0) .AND. CHA.LE.HASRA(1)) THEN !SELECTED - CUT=360.*((CHA/360.-NGFE(NGF_HAB_E,1))*0.99727+ - 1 NGFE(NGF_UTB_E,1)) !CURRENT UT - DO I=1,NPLOT !ALL SETS - R1=(CHA/360.-NGFE(NGF_HAB_E,I))/NGFE(NGF_HAI_E,I) !OFFSET - I2=NINT(R1) - I3=SNAM(2,I)-CRANGE(0) !PLOT # - IF (I2.LT.0 .OR. I2.GE. NGFJ(NGF_SCN_J,I)) THEN - A_X(BUFAD1+I3)=CMPLX(NGCDLC,NGCDLC) - ELSE - A_X(BUFAD1+I3)=A_X(BUFAD+I*NPTS+I2) !DATA - END IF - END DO -C -C ADD NEW POINT TO PLOT FILE -C - CALL WNGMVZ(NGFHDL,NGF(0,0)) !ZERO NGF - NGFE(NGF_MAX_E,0)=-1E20 !INIT MAX/MIN - NGFE(NGF_MIN_E,0)=1E20 - DO I=0,CRANGE(1)-CRANGE(0) !ALL POINTS - IF (REAL(A_X(BUFAD1+I)).NE.NGCDLC) THEN - C2=A_X(BUFAD1+I) - NGFE(NGF_MAX_E,0)=MAX(NGFE(NGF_MAX_E,0),ABS(C2)) !NEW MAX/MIN - NGFE(NGF_MIN_E,0)=MIN(NGFE(NGF_MIN_E,0),ABS(C2)) - ELSE - NGFJ(NGF_DEL_J,0)=NGFJ(NGF_DEL_J,0)+1 !COUNT - END IF - END DO - NGFI(NGF_VER_I,0)=NGFHDV !FILL PLOT HEADER - NGFI(NGF_LEN_I,0)=NGFHDL - CALL WNGMV(NGF_NAM_N,NGF(NGF_NAM_1,1),NGF(NGF_NAM_1,0)) - NGFE(NGF_RA_E,0)=NGFE(NGF_RA_E,1) - NGFE(NGF_DEC_E,0)=NGFE(NGF_DEC_E,1) - NGFE(NGF_FRQ_E,0)=NGFE(NGF_FRQ_E,1) - NGFE(NGF_BDW_E,0)=NGFE(NGF_BDW_E,1) - NGFJ(NGF_TRTYP_J,0)=MOD(NGFJ(NGF_TRTYP_J,1)+1,2) - IF (NGFJ(NGF_TRTYP_J,0).EQ.1) THEN - NGFE(NGF_TRHAI_E,0)=HAINC/360. - NGFE(NGF_TRHA_E,0)=CHA/360. - NGFE(NGF_TRFB_E,0)=FRQ+(CRANGE(0)-BDN)*FRQI - NGFE(NGF_TRFI_E,0)=FRQI - NGFE(NGF_HAB_E,0)=CRANGE(0)*FRHACV/360. - NGFE(NGF_HAI_E,0)=FRHACV/360. - NGFJ(NGF_BDN_J,0)=I1 - ELSE - NGFE(NGF_TRHAI_E,0)=0. - NGFE(NGF_TRHA_E,0)=0. - NGFE(NGF_TRFB_E,0)=0. - NGFE(NGF_TRFI_E,0)=0. - NGFE(NGF_HAB_E,0)=TRHA - NGFE(NGF_HAI_E,0)=NGFE(NGF_TRHAI_E,1) - NGFJ(NGF_BDN_J,0)=NINT(CHA/FRHACV) - END IF - NGFE(NGF_HAV_E,0)=NGFE(NGF_HAV_E,1) - NGFE(NGF_UTB_E,0)=NGFE(NGF_UTB_E,1) - NGFE(NGF_UTE_E,0)=NGFE(NGF_UTE_E,1) - NGFJ(NGF_SCN_J,0)=CRANGE(1)-CRANGE(0)+1 - NGFJ(NGF_VNR_J,0)=NGFJ(NGF_VNR_J,1) - CALL WNGMV(NGF_IFR_N,NGF(NGF_IFR_1,1),NGF(NGF_IFR_1,0)) - CALL WNGMV(NGF_POL_N,NGF(NGF_POL_1,1),NGF(NGF_POL_1,0)) - NGFI(NGF_ODY_I,0)=NGFI(NGF_ODY_I,1) - NGFI(NGF_OYR_I,0)=NGFI(NGF_OYR_I,1) - NGFE(NGF_BLN_E,0)=NGFE(NGF_BLN_E,1) - HSTR1='TRANSP' - CALL WNCTXS(HSTR,'!AS(!AS-!AS)', - 1 HSTR1,WNTTSG(SNAM(0,1),0),WNTTSG(SNAM(0,NPLOT),0)) - CALL WNGMFS(NGF_TYP_N,HSTR,NGF(NGF_TYP_1,0)) - IF (.NOT.WNDLNF(SGPH(0)+SGH_LINKG_1,SNAM(1,1), - 1 SGH_GROUPN_1,FCAOUT,SGPH(1),SGNR(1))) THEN - 51 CONTINUE - CALL WNCTXT(F_TP,'!/Error linking sub-group') - GOTO 900 - END IF - IF (.NOT.WNDLNF(SGPH(1)+SGH_LINKG_1, - 1 NGFJ(NGF_BDN_J,0), - 1 SGH_GROUPN_1,FCAOUT,SGPH(2),SGNR(2))) GOTO 51 - IF (.NOT.WNDLNF(SGPH(2)+SGH_LINKG_1,SNAM(3,1), - 1 SGH_GROUPN_1,FCAOUT,SGPH(3),SGNR(3))) GOTO 51 - IF (.NOT.WNDLNF(SGPH(3)+SGH_LINKG_1,SNAM(4,1), - 1 SGH_GROUPN_1,FCAOUT,SGPH(4),SGNR(4))) GOTO 51 - J=WNFEOF(FCAOUT) !OUTPUT POINTER - NGFJ(NGF_DPT_J,0)=J+NGFHDL !DATA POINTER - IF (.NOT.WNFWR(FCAOUT,NGFHDL,NGF,J)) GOTO 21 !WRITE HEADER - IF (.NOT.WNFWR(FCAOUT,LB_X*NGFJ(NGF_SCN_J,0), - 1 A_X(BUFAD1),J+NGFHDL)) GOTO 21 !DATA - IF (.NOT.WNDLNK(GFH_LINK_1,J, - 1 NGF_SETN_1,FCAOUT)) GOTO 51 !LINK DATA - IF (.NOT.WNDLNG(SGPH(4)+SGH_LINKG_1,J, - 1 SGH_GROUPN_1,FCAOUT,SGPH(5),SGNR(5))) GOTO 51 !INDEX - END IF - END DO - CALL NGCSPH(SGNR,NGF(0,0)) !SHOW NEW PLOT - CALL WNGFVA(BUFL,BUFAD*LB_X+A_OB) !RELEASE BUFFER - CALL WNGFVA(BUFL1,BUFAD1*LB_X+A_OB) !RELEASE BUFFER -C -C LOOP IF NECESSARY -C - GOTO 30 !NEXT LOOP -C -C READY -C - 900 CONTINUE - RETURN !READY -C -C - END diff --git a/src/nplot/ngcxcv.for b/src/nplot/ngcxcv.for deleted file mode 100644 index e1d8f3af05943b97b019790747706fd1370bcaeb..0000000000000000000000000000000000000000 --- a/src/nplot/ngcxcv.for +++ /dev/null @@ -1,144 +0,0 @@ -C+ NGCXCV.FOR -C WNB 920826 -C -C Revisions: -C - SUBROUTINE NGCXCV -C -C Convert NGF file from external machine to local format -C -C Result: -C -C CALL NGCXCV will convert a NGF file from VAX to local format -C -C Include files: -C - INCLUDE 'WNG_DEF' - INCLUDE 'NGC_DEF' - INCLUDE 'GFH_O_DEF' !GENERAL FILE HEADER - INCLUDE 'GFH_T_DEF' - INCLUDE 'SGH_O_DEF' !SUB-GROUP HEADER - INCLUDE 'SGH_T_DEF' - INCLUDE 'NGF_O_DEF' !SET HEADER - INCLUDE 'NGF_T_DEF' -C -C Parameters: -C - INTEGER DBUFL !LENGTH DATA BUFFER - PARAMETER (DBUFL=1024) -C -C Arguments: -C -C -C Function references: -C - LOGICAL WNFRD !READ DATA - LOGICAL WNFWR !WRITE DATA -C -C Data declarations: -C - INTEGER CVT !CONVERSION TYPE - INTEGER*2 DBH_T(0:1,0:1) !DATA TRANSLATION - DATA DBH_T/4,0,0,1/ - BYTE GFH(0:GFHHDL-1) !GENERAL FILE HEADER - BYTE SGH(0:SGHHDL-1) !SUB-GROUP HEADER - INTEGER SGHJ(0:SGHHDL/4-1) - EQUIVALENCE (SGH,SGHJ) - BYTE NGF(0:NGFHDL-1) !SET HEADER - INTEGER*2 NGFI(0:NGFHDL/2-1) - INTEGER NGFJ(0:NGFHDL/4-1) - EQUIVALENCE (NGF,NGFI,NGFJ) - REAL DBUF(0:DBUFL-1) -C- -C -C INIT -C -C -C GENERAL FILE HEADER -C - IF (.NOT.WNFRD(FCAOUT,GFHHDL,GFH,0)) THEN !READ GENERAL FILE HEADER - 10 CONTINUE - CALL WNCTXT(F_TP,'!/I/O error on NGF file') - GOTO 900 !READY - END IF - IF (GFH(GFH_DATTP_B).EQ.0) GFH(GFH_DATTP_B)=1 !ASSUME VAX INPUT - IF (GFH(GFH_DATTP_B).EQ.PRGDAT) THEN - CALL WNCTXT(F_TP,'!/Data already converted') - GOTO 800 - END IF - CVT=GFH(GFH_DATTP_B) !INPUT TYPE - CALL WNTTTL(GFHHDL,GFH,GFH_T,CVT) !CONVERT - GFH(GFH_DATTP_B)=PRGDAT !SET CURRENT DATA TYPE - IF (.NOT.WNFWR(FCAOUT,GFHHDL,GFH,0)) GOTO 10 !REWRITE HEADER -C -C GROUP HEADERS -C - J=1 !LEVEL 1 - J1=GFH_LINKG_1 !CURRENT GROUP - J2=GFH_LINKG_1 !CURRENT LINK HEAD - 22 CONTINUE - IF (.NOT.WNFRD(FCAOUT,SGHHDL,SGH,J1)) GOTO 10 !READ CURRENT - 20 CONTINUE - IF (SGHJ(SGH_LINK_J).EQ.J2) THEN !END OF LIST - J=J-1 !DECREASE LEVEL - IF (J.EQ.0) GOTO 21 !READY - J1=SGHJ(SGH_HEADH_J)-SGH_LINKG_1+SGH_LINK_1 !LOWER HEADER ADDR. - IF (.NOT.WNFRD(FCAOUT,SGHHDL,SGH,J1)) GOTO 10 !READ IT - J2=SGHJ(SGH_HEADH_J) !NEW LINK HEAD - GOTO 20 !CONTINUE - END IF - J1=SGHJ(SGH_LINK_J) !NEXT ENTRY - IF (.NOT.WNFRD(FCAOUT,SGHHDL,SGH,J1)) GOTO 10 !READ IT - CALL WNTTTL(SGHHDL,SGH,SGH_T,CVT) !CONVERT IT - IF (.NOT.WNFWR(FCAOUT,SGHHDL,SGH,J1)) GOTO 10 !WRITE IT - IF (SGHJ(SGH_DATAP_J).EQ.0) THEN !MORE LEVELS - IF (SGHJ(SGH_LINKG_J).EQ.J1+SGH_LINKG_1) GOTO 20 !NO NEXT LEVEL - J=J+1 !NEXT LEVEL - IF (J.GT.8) GOTO 10 !TOO MANY LEVELS - J2=J1+SGH_LINKG_1 !NEW HEADER PTR - J1=J2 !NEXT CURRENT - GOTO 22 !CONTINUE - END IF - GOTO 20 !MORE - 21 CONTINUE -C -C DO SETS -C - IF (.NOT.WNFRD(FCAOUT,8,NGF,GFH_LINK_1)) GOTO 10 !READ SET HEADER START -30 CONTINUE - J=NGFJ(NGF_LINK_J) !NEXT IN LIST - IF (J.EQ.GFH_LINK_1) GOTO 800 !ALL DONE - IF (.NOT.WNFRD(FCAOUT,NGFHDL,NGF,J)) GOTO 10 !READ SET HEADER - CALL WNTTTL(NGFHDL,NGF,NGF_T,CVT) !CONVERT IT - IF (.NOT.WNFWR(FCAOUT,NGFHDL,NGF,J)) GOTO 10 !WRITE SET HEADER -C -C PLOTS -C - J=NGFJ(NGF_DPT_J) !POINTER TO DATA - I2=NGFJ(NGF_SCN_J) !PLOT LENGTH - DO WHILE (I2.GT.0) !DO PER LINE - I3=MIN(I2,DBUFL) !DO THIS TIME - I1=2*LB_E*I3 !IN BYTES - DBH_T(1,0)=I1 !TRANSLATION LENGTH - IF (.NOT.WNFRD(FCAOUT,I1,DBUF,J)) GOTO 10 !READ DATA - CALL WNTTTL(I1,DBUF,DBH_T,CVT) !CONVERT - IF (.NOT.WNFWR(FCAOUT,I1,DBUF,J)) GOTO 10 !WRITE DATA - J=J+I1 !UPDATE POINTER - I2=I2-I3 !UPDATE COUNT - END DO !NEXT LINE - GOTO 30 !NEXT SET -C -C READY -C - 800 CONTINUE -C - RETURN -C -C ERROR -C - 900 CONTINUE -C - RETURN !READY -C -C - END diff --git a/src/nplot/ngcxmh.for b/src/nplot/ngcxmh.for deleted file mode 100644 index c325ed41d6d9702011ea1ecf3fba41e60db11400..0000000000000000000000000000000000000000 --- a/src/nplot/ngcxmh.for +++ /dev/null @@ -1,221 +0,0 @@ -C+ NGCXMH.FOR -C WNB 920820 -C -C Revisions: -C WNB 931214 Allow P: -C - SUBROUTINE NGCXMH(PTYPE,INFCA,NGFP,SNAM) -C -C Show plot header -C -C Result: -C -C CALL NGCXMH ( PTYPE_J:I, INFCA_J:I, NGFP_J:I, SNAM_J(*):I) -C Show on output PTYPE the plot at NGFP -C of file INFCA. -C CALL NGCEMH ( PTYPE_J:I, INFCA_J:I, NGFP_J:I, SNAM_J(*):I) -C Edit plot header -C -C Include files: -C - INCLUDE 'WNG_DEF' - INCLUDE 'NGF_O_DEF' !PLOTHEADER - INCLUDE 'GFH_O_DEF' - INCLUDE 'SGH_O_DEF' - INCLUDE 'NGF_E_DEF' !EDIT INFORMATION - INCLUDE 'GFH_E_DEF' - INCLUDE 'SGH_E_DEF' -C -C Parameters: -C - INTEGER MXDEP !MAX. NESTING DEPTH - PARAMETER (MXDEP=8) - INTEGER D_GEDL !GENERAL DATA - PARAMETER (D_GEDL=1) -C -C Arguments: -C - INTEGER PTYPE !PRINT TYPE (f_p, f_t ETC) - INTEGER INFCA !FILE DESCRIPTOR - INTEGER NGFP !PLOT HEADER POINTER - INTEGER SNAM(*) !SET NAME -C -C Function references: -C - LOGICAL WNFRD !READ DATA - LOGICAL WNFWR !WRITE DATA - INTEGER WNGGJ !GET J - CHARACTER*32 WNTTSG !SHOW SET NUMBER -C -C Data declarations: -C - CHARACTER*8 PLIST(11) !KNOWN P: AREAS - DATA PLIST/ 'NGF','GFH','SGH', - 1 'B','I','J','E','D','X','Y', - 1 ' '/ - INTEGER PLEN(0:1,11) !P: LENGTH - DATA PLEN/ -1,NGFHDL, - 1 -1,GFHHDL, - 1 -1,SGHHDL, - 1 -1,LB_B,-1,LB_I,-1,LB_J,-1,LB_E, - 1 -1,LB_D,-1,LB_X,-1,LB_Y, - 1 0,0/ - INTEGER DEP !CURRENT DEPTH - INTEGER DEPAR(4,MXDEP) !SAVE DEPTH - INTEGER CHP,CHDL !CURRENT HEADER LENGTH, PTR - INTEGER CTYP,CEDP !CURRENT HEADER TYPE #, PTR INTO EDIT - INTEGER CHPT !NEXT HEADER POINTER - INTEGER PSZ(0:1) !P: OFFSET AND SIZE - BYTE NGF(0:NGFHDL-1) !MAP HEADER - BYTE GFH(0:GFHHDL-1) - BYTE SGH(0:SGHHDL-1) - EQUIVALENCE (NGF,GFH,SGH) - CHARACTER*8 D_G_EC(4,7) !DATA TABLES - DATA D_G_EC/ 'B','SB',' ',' ', - 1 'I','SI',' ',' ', - 1 'J','SJ',' ',' ', - 1 'E','E12.6',' ',' ', - 1 'D','D12.8',' ',' ', - 1 'X','26$EC12.6',' ',' ', - 1 'Y','26$DC12.8',' ',' '/ - INTEGER D_G_EJ(4,7) - DATA D_G_EJ/ 0,1,0,LB_B, - 1 0,1,0,LB_I, - 1 0,1,0,LB_J, - 1 0,1,0,LB_E, - 1 0,1,0,LB_D, - 1 0,1,0,LB_X, - 1 0,1,0,LB_Y/ -C- -C -C GET HEADER -C - IF (.NOT.WNFRD(INFCA,NGFHDL,NGF,NGFP)) THEN - CALL WNCTXT(PTYPE,'Read error on input node') - RETURN - END IF -C -C SHOW HEADER -C - CALL WNCTXT(PTYPE,'!/Plot header description !AS\:!/', - 1 WNTTSG(SNAM,0)) - CALL NSCXXS(PTYPE,NGF,NGFEDL,NGF_EC,NGF_EJ) !ACTUAL SHOW -C - RETURN -C -C NGCESH -C - ENTRY NGCEMH(PTYPE,INFCA,NGFP,SNAM) -C -C INIT -C - DEP=0 !CURRENT DEPTH - CHP=NGFP !HEADER POINTER - CTYP=1 !CURRENT TYPE (NGF) - CEDP=-1 !CURRENT POINTER IN EDIT LIST - CHDL=NGFHDL !CURRENT LENGTH -C -C ACTION -C - 10 CONTINUE - DO WHILE (CTYP.GT.0) !SOMETHING TO DO - IF (CHDL.LE.0) THEN !GET NEW HEADER - IF (PLEN(0,CTYP).GE.0 .AND. CEDP.GT.0) THEN - CHDL=WNGGJ(NGF(PLEN(0,CTYP))) !LENGTH FROM FILE - ELSE - CHDL=PLEN(1,CTYP) !DEFAULT LENGTH - END IF - CHDL=MIN(CHDL,PLEN(1,CTYP)) !MAKE SURE NO PROBLEMS - IF (CHDL.LE.0) GOTO 20 !NOT PRESENT; RESTART CURRENT - END IF -C -C GET HEADER -C - IF (CHP.EQ.0 .AND. - 1 (CTYP.LT.2 .OR. - 1 (CTYP.GT.3 .AND. CTYP.LT.4) .OR. - 1 (CTYP.GT.10))) GOTO 20 !NOT PRESENT - IF (CHP.GT.0 .AND. CHP.LT.GFHHDL .AND. - 1 (CTYP.LT.4 .OR. CTYP.GT.10)) THEN !MUST BE GFH - CTYP=2 - CHDL=PLEN(1,CTYP) - CHP=0 - CEDP=-1 - END IF - CALL WNGMVZ(PLEN(1,CTYP),NGF) !CLEAR BEFORE READ - IF (.NOT.WNFRD(INFCA,CHDL,NGF,CHP)) THEN - CALL WNCTXT(PTYPE,'Read error on input node') - RETURN - END IF -C -C EDIT HEADER -C - CALL WNCTXT(PTYPE,'*** Editing !AS ***',PLIST(CTYP)) - IF (DEP.GE.MXDEP) THEN !SHIFT ONE - DO I=1,MXDEP-1 - DO I1=1,4 - DEPAR(I1,I)=DEPAR(I1,I+1) - END DO - END DO - DEP=MXDEP-1 - END IF - DEP=DEP+1 !SAVE PREVIOUS - DEPAR(1,DEP)=CHP - DEPAR(2,DEP)=CTYP - DEPAR(3,DEP)=CEDP - DEPAR(4,DEP)=CHDL - IF (CTYP.EQ.1) THEN - CALL NSCXES(PTYPE,NGF,NGFEDL,NGF_EC,NGF_EJ,PLIST, - 1 CTYP,CEDP,CHPT,PSZ) - ELSE IF (CTYP.EQ.2) THEN - CALL NSCXES(PTYPE,NGF,GFHEDL,GFH_EC,GFH_EJ,PLIST, - 1 CTYP,CEDP,CHPT,PSZ) - ELSE IF (CTYP.EQ.3) THEN - CALL NSCXES(PTYPE,NGF,SGHEDL,SGH_EC,SGH_EJ,PLIST, - 1 CTYP,CEDP,CHPT,PSZ) - ELSE IF (CTYP.GE.4 .AND. CTYP.LE.10) THEN - CALL NSCXES(PTYPE,NGF,D_GEDL, - 1 D_G_EC(1,CTYP-3),D_G_EJ(1,CTYP-3),PLIST, - 1 CTYP,CEDP,CHPT,PSZ) - END IF - IF (CTYP.GE.1000) THEN !RELATIVE ADDRESS - CTYP=MOD(CTYP,1000) !GET CORRECT TYPE - CHPT=CHP+CHPT !CATER FOR OFFSET GIVEN - END IF - IF (CTYP.GE.4 .AND. CTYP.LE.10) THEN - CHPT=CHPT+PSZ(0)*D_G_EJ(4,CTYP-3) !CATER FOR GIVEN OFFSET - D_G_EJ(2,CTYP-3)=MAX(1,MIN(PSZ(1),NGFHDL/LB_Y)) !MAX. NUMBER TO DO - END IF -C -C REWRITE HEADER -C - IF (.NOT.WNFWR(INFCA,CHDL,NGF,CHP)) THEN - 30 CONTINUE - CALL WNCTXT(PTYPE,'Write error on input node') - RETURN - END IF - CHP=CHPT !NEXT HEADER POINTER - IF (CTYP.GE.4 .AND. CTYP.LE.10) THEN - CHDL=D_G_EJ(2,CTYP-3)*D_G_EJ(4,CTYP-3) !NEW LENGTH - ELSE - CHDL=0 !NEXT HEADER LENGTH - END IF - END DO -C -C RETURN PREVIOUS LEVEL -C - DEP=DEP-1 - 20 CONTINUE - IF (DEP.GT.0) THEN !CAN DO MORE - CHP=DEPAR(1,DEP) - CTYP=DEPAR(2,DEP) - CEDP=DEPAR(3,DEP) - CHDL=DEPAR(4,DEP) - DEP=DEP-1 - GOTO 10 - END IF -C - RETURN -C -C - END diff --git a/src/nplot/ngf.dsc b/src/nplot/ngf.dsc deleted file mode 100644 index f3fb48cba6ffa6d167004f3f64cac6bdb50ad16b..0000000000000000000000000000000000000000 --- a/src/nplot/ngf.dsc +++ /dev/null @@ -1,86 +0,0 @@ -!+ NGF.DSC -! WNB 920818 -! -! Revisions: -! -%REVISION=CMV=940805="Add TRTYP=2 (comments only)" -%REVISION=WNB=931216="Add some edit formats" -%REVISION=WNB=931015="Use SSH_DSF" -%REVISION=WNB=930630="Change TRVAL in TRHAI; add TRHA, TRFB, TRFI, FRHACV" -%REVISION=WNB=930628="Add BLN" -%REVISION=WNB=920902="Add TRTYP, TRVAL" -%REVISION=WNB=920819="Original version NGF" -! -! -! Define layout of general calculation/plot file plot header -! -%COMMENT="NGF.DSC defines the NGCALC file header" -%COMMENT=" " -! -! -%VERSION=1 !VERSION -%SYSTEM=1 -%USER=WNB -%%DATE -%%NAME -!- -.PARAMETER - FRHACV E /0.125/ !EACH FREQ. CHANNEL 0.125 DEGREE -.BEGIN=NGF -%INCLUDE=SSH_DSF !STANDARD AREA - NAM C12 !FIELD NAME - RA E <EAF12.7> !RA (CIRCLES) - DEC E <EAF12.7> !DEC (CIRCLES) - FRQ E <E12.6> !FREQUENCY (MHZ) - BDW E <E12.6> !BANDWIDTH (MHZ) - ! - ! Number refers to TRTYPE - ! - HAB E <EAF12.2> ! 0: START HA (CIRCLES) - ! 1: START BANDNO*FRHACV/360 - ! 2: START BLN/360 (DECAM) - ! - HAI E <EAF12.2> ! 0: INCREMENT HA (CIRCLES) - ! 1: FRHACV/360 - ! 2: INCREMENT BLN/360 (DECAM) - ! - HAV E <EAF12.2> !AVERAGE HA (CIRCLES) - UTB E <EHF4> !START UT (CIRCLES) - UTE E <EHF4> !END UT (CIRCLES) - DPT J <XJ,1> !DATA POINTER - SCN J <,1> !NUMBER OF DATAPOINTS - VNR J !VOLGNUMBER - BDN J !BANDNUMBER - IFR C4 !INTERFEROMETER/TELESCOPE - ! 2: SET TO 'ALL' - POL C4 !POLARISATION - ODY I !OBS. DAY - OYR I !OBS. YEAR (E.G. 1986) - TYP C40 !TYPE OF DATA - DEL J !DELETED POINTS - MAX E <E12.4> !MAXIMUM VALUE - MIN E <E12.4> !MINIMUM VALUE - ! - TRTYP J !TRANSPOSE TYPE: - ! 0: HA AXIS - ! 1: BAND AXIS - ! 2: BASELINE AXIS - ! - TRHAI E <EAF12.2> ! 0: 0 - ! 1,2: HAI (CIRCLES) - ! - BLN E <E12.3> ! 0,1: BASELINE/ - ! TEL. POSITION (M) - ! 2: MAX. BASL/TEL.POS (M) - ! - TRHA E <EAF12.2> ! 0: 0 - ! 1,2: HA (CIRCLES) - TRFB E <E12.6> ! 0,2: 0 - ! 1: BEGIN FREQUENCY - ! - TRFI E <E12.6> ! 0,2: 0 - ! 1: INCR. FREQUENCY - ! - .OFF=512 !LENGTH -.END !END STRUCTURE -!- diff --git a/src/nplot/ngfsets.pef b/src/nplot/ngfsets.pef deleted file mode 100644 index a14dc9e7ecc3d27cbcd0f6f26c6406b4513a0e13..0000000000000000000000000000000000000000 --- a/src/nplot/ngfsets.pef +++ /dev/null @@ -1,308 +0,0 @@ -!+ NGFSETS.PEF: NGF-file Sets specification. -! JPH 940812 -! -! Revisions: -! WNB 930630 Add NGF sub-fields -! CMV 930712 Correct typo -! CMV 931210 Changed LOOPS to SCN/WMP/MDL/NGF_LOOPS -! CMV 931220 Add info about L and O answers to ???_LOOPS/SETS -! JPH 940812 Split from nsets.pef -! 3-character index names -! improve HELP texts -! JPH 940920 Remove () from prompts -! JPH 941005 Fine-tuning -! -! -! Ref: WNDSTA -! -KEYWORD=NGF_SETS - DATA_TYP=C - IO=I - LENGTH=32 - NVALUES=64 - SWITCHES=LOOP,NULL_VALUES,WILD_CARDS - SEARCH=L,P - PROMPT="Sectors to do: grp.fld.chn.pol.iort.seq " - HELP=" - A NEWSTAR .NGF file contains visibilities and associated data for one -or more objects. The basic unit of data is the CUT, which is a one-dimensional -vector of some type of data extracted from a .SCN file. The data may be either -visibilities or associated data such as corrections; they may be associated -with an interferometer or with a telescope. Cuts are addressed through a CUT -INDEX which is a string of six integers separated by dots: -. - grp.fld.chn.pol.iort.seq -. - A GROUP is basically an administrative unit, allowing the user to -subdivide his data, e.g. per object. - The FIELD and CHANNEL are the field and channel numbers in the .SCN -file of the observation from which the cut was taken. - POL is a number indicating the polarisation. For interferometer data, -pol=0,1,2,3 represents XX,XY,YX,YY. For telescope data pol=0,1 represents X,Y. - Depending on the type of data, IORT is the interferometer or telescope -number. (The former is difficult to interpret; rather use the SELECT_IFRS -parameter if you want to select interferometers.) - The cut SEQuence number distinguishes cuts for which all five of the -preceding indices are identical. It is your responsibility to know what the -different seq values represent. - - Index values start at zero. (Remember that for the CHN index 0 is the -continuum channel.) -. - You may select SETS of cuts for processing through [ranges of] values -for the ive indices, e.g. -. - 2.3-5:2.*.1-7.*.2 -. -The WILDCARD value '*' means 'all'. Each index may also be specified as a -RANGE: <first>-<last>[<:increment>]. Indices omitted are assumed to be '*', -i.e. ...1.0 means *.*.*.1.0. For wildcards at the end the dots may also be -omitted, i.e. 1.0 means 1.0.*.*.* -. - The notation 3-5:2 stands for 'from 3 through 5 in steps of 2'. The -step must be positive. If it is omitted, it is taken to be 1 (as in '1-7' -above). -. - Multiple cut SETS may be specified, separated by comma's: -<Set1>,<Set2>,... The associated NGF_LOOPS keyword allows even more looping -over index values. -. -IF YOU WANT TO BE REMINDED OF WHAT CUTS ARE IN YOUR FILE: - Type O or L in response to this prompt to get an Overview or Layout - of your .NGF file. -. -IF YOU DO NOT YET FEEL COMFORTABLE WITH THESE CONCEPTS MORE HELP IS PROVIDED: - Type '@' or '>' to be prompted for each of the 6 indices separately, - with more specific explanation per index. -. -IF YOU GET BORED WITH 6-NUMBER INDICES: - Absolute Cut nrs '#<n>' can be used as an alternative. -" -! -! Get loop parameters -! Ref: WNDSTA (via WNDXLP) -! -KEYWORD=NGF_LOOPS - DATA_TYP=C - IO=I - LENGTH=32 - NVALUES=16 - SWITCHES=NULL_VALUES,WILD_CARDS - SEARCH=L,P - DEFAULT=""" /ASK" - PROMPT="Loop specifications: nr of cycles, index increment per cycle" - HELP=" -With the NGF_LOOPS keyword, you may specify repetitions of the operation you -are currently defining, systematically incrementing the Group, Channel, Field -etc. indices for each new cycle. -. -This is done by specifying pairs of values: -. - niter1,index_incr1, niter2,index_incr2, ... -. -In each pair, the first value (n_iter) indicates the number of times the loop -has to execute; the second value (index_incr) indicates how the Cut index is to -be changed at the start of a new cycle. -. -Example: - The specification NGF_SETS = grp.fld.1-2.* would select the combination -of all cuts of frequency channels 1 and 2 for the field grp.fld. If one wishes -to process 32 sets of successive such pairs of frequency channels, you would -have to type in the successive NGF_SETS specifications by hand: -. - grp.fld.1-2, grp.fld.3-4, ....., grp.fld.63-64 -. -Instead, you may specify NGF_LOOPS=32, 0.0.2 This will cause the program to -execute the present operation 32 times in a loop, starting with the NGF_SETS -specification and then incrementing its indices by 0.0.2 for every iteration; -this is equivalent to the above 32 separate runs of the program. -. - n_iter must be > 0, and the increment can be any index string with -simple positive or negative integers. An increment of 0 may be omitted, i.e. -the increment specifications 0.0.3.0 and ..3 are all equivalent. -. - Loops may be nested (to a limiting depth of 8 levels). A following loop -specification is executed inside the preceding ones. -. -Example of nested loops: - To run your program on group 3 for 64 fields (fld index), for 10 odd -channels (chn index) per field, starting at channel 7 and combining all -polarisations (pol index) every time, specify: -. - NGF_SETS=3.0.7.* (initial set of cuts) - NGF_LOOPS=64,.1, 10,..2 -. -The second loop is executed as an inner loop inside the first one, that is, for -each mosaic subfield the channels are processed in a contiguous sequence. -. -IF YOU WANT TO BE REMINDED OF WHAT CUTS ARE IN YOUR FILE: - Type O or L in response to this prompt to get an Overview or Layout - of the file for which you need to specify the sets. -" -! -! Ref: WNDSTA_X -! -KEYWORD=NGF_GROUPS - DATA_TYP=C - IO=I - LENGTH=32 - SWITCHES=LOOP,NULL_VALUES,WILD_CARDS - SEARCH=L,P - PROMPT=" 1st index: grp = groups" - HELP=" -Give the group index (range) GRP of a cut-Set specification - (GRP.fld.chn.pol.iort.seq) -. -Possible answers ([]=optional): -. - 0 take first (or only) group - n1 take group nr n1 (n1=0,1,2,3,....) - n1-n2[:n3] loop over groups n1 through n2 [step n3] - * loop over all available groups (wildcard) - n1-[*][:n3] loop over all available groups, - starting with n1 [step n3] -. -Note: - The associated NGF_LOOPS keyword allows even more looping over index values." -! -! Ref: WNDSTA_X -! -KEYWORD=NGF_FIELDS - DATA_TYP=C - IO=I - LENGTH=32 - SWITCHES=LOOP,NULL_VALUES,WILD_CARDS - SEARCH=L,P - PROMPT=" 2nd index: field(s)" - HELP=" Give the field index (range) FLD of a cut-Set specification - (grp.FLD.chn.pol.iort.seq) -. -Possible answers ([]=optional): -. - 0 take first (or only) field - n1 take field nr n1 (n1=0,1,2,3,....) - n1-n2[:n3] loop over fields n1 through n2 [step n3] - * loop over all fields in the observation (wildcard) - n1-[*][:n3] loop over all fields in the observation, - starting with n1 [step n3] -. -Note: - The associated NGF_LOOPS keyword allows even more looping over index values." -! -! Ref: WNDSTA_X -! -KEYWORD=NGF_CHANNELS - DATA_TYP=C - IO=I - LENGTH=32 - SWITCHES=LOOP,NULL_VALUES,WILD_CARDS - SEARCH=L,P - PROMPT="3rd index: channel(s)" - HELP=" -Give the channel index (range) CHN of a cut-Set specification - (grp.fld.CHN.pol.iort.seq) -. -Remember that channel 0 is the 'continuum' channel. -. -Possible answers ([]=optional): -. - 0 take the continuum channel - n1 take channel nr n1 (n1=0,1,2,3,....) - n1-n2[:n3] loop over channels n1 through n2 [step n3] - * loop over all channels for the field (wildcard) - n1-[*] loop over all channels for the field, - starting with n1 [step n3] -. -Note: - The associated NGF_LOOPS keyword allows even more looping over index values." -! -! Ref: WNDSTA_X -! -KEYWORD=NGF_POLARS - DATA_TYP=C - IO=I - LENGTH=32 - SWITCHES=LOOP,NULL_VALUES,WILD_CARDS - SEARCH=L,P - PROMPT="4th index: polarisation(s)" - HELP=" -Give the polarisation index (range) POL of a cut-Set specification - (grp.fld.chn.POL.iort.seq) -. - POL is a number indicating the polarisation. For interferometer data, -pol=0,1,2,3 represents XX,XY,YX,YY. For telescope data pol=0,1 represents X,Y. -. -This index is useful for defining loops (NGF_LOOPS parameter). Otherwise you -may find the SELECT_XYX parameter more convenient. -. -If you prefer to use NGF_POLAR here, examples of reasonable answers are: - For interferometer data - * (=XX,XY,YX,YY) 0-3:3 (=XX,YY) 0 (=XX) 3 (=YY) - For telescope data - * (=X,Y) 0 (=X) 1 (=Y) -. -Note: - The associated NGF_LOOPS keyword allows even more looping over index values." -! -! Ref: WNDSTA_X -! -KEYWORD=NGF_IFRS - DATA_TYP=C - IO=I - LENGTH=32 - SWITCHES=LOOP,NULL_VALUES,WILD_CARDS - SEARCH=L,P - PROMPT="5th index: iort = interferometers or telescopes" - HELP=" -Give the interferometer or telescope index (range) IORT of a cut-Set -specification - (grp.fld.chn.pol.IORT.seq) -. -This index is most useful in loop specifications (parameter NGF_LOOPS). -. -For interferometer data, iort is an interferometer sequence number which can -not be easily interpreted. Therefore, this index is useful only in loop -specifications (parameter NGF_LOOPS). Specify a wildcard ('*') here and rely on -the SELECT_IFRS parameter for selecting interferometers. -. -For telescope data, iort is the telescope number (A-D being represented by -10-13). The selection possibilities are limited here and you may prefer to rely -on the SELECT_TELS parameter. -. -Possible answers ([]=optional): -. - 0 take first (or only) ifr|tel - n1 take ifr|tel nr n1 (n1=0,1,2,3,....) - n1-n2[:n3] loop over ifr|tels n1 through n2 [step n3] - * loop over all available ifrs|tels (wildcard) - n1-[*][:n3] loop over all available ifrs|tels, - starting with n1 [step n3] -. -Note: - The associated NGF_LOOPS keyword allows even more looping over index values." -! -! Ref: WNDSTA_X -! -KEYWORD=NGF_CUTS - DATA_TYP=C - IO=I - LENGTH=32 - SWITCHES=LOOP,NULL_VALUES,WILD_CARDS - SEARCH=L,P - PROMPT=" 6th index: cut(s)" - HELP=" Give the sequence-number index (range) SEQ of a cut-Set - specification (grp.fld.chn.pol.iort.SEQ). -. -Possible answers ([]=optional): -. - 0 take the first cut - n1 take cut nr n1 (n1=0,1,2,3,....) - n1-n2[:n3] loop over cuts n1 through n2 [step n3] - * loop over all - (wildcard) - n1-[*] loop over all cuts for the field and channel, - starting with n1 [step n3] -. -Note: -The associated NGF_LOOPS keyword allows even more looping over index values." - diff --git a/src/nplot/ngi.dsc b/src/nplot/ngi.dsc deleted file mode 100644 index 7cd2daea2d1b02631e7d24302c460a71f9a816b2..0000000000000000000000000000000000000000 --- a/src/nplot/ngi.dsc +++ /dev/null @@ -1,115 +0,0 @@ -!+ NGI.DSC -! HJV 920827 -! -! Revisions: -! -%REVISION=CMV=940817="Add DO_CLIP" -%REVISION=CMV=940218="Add DO_BLANK" -%REVISION=CMV=940203="Add ALL_POL" -%REVISION=WNB=931221="Alignment problem; use NSTAR_DSF" -%REVISION=CMV=931123="Add parameters for NGIDS DATA and RAW option" -%REVISION=WNB=930803="Remove .INCLUDE" -%REVISION=WNB=930621="Add DFAR; UFL" -%REVISION=WNB=930510="Major revision" -%REVISION=HJV=930219="Add OPTION" -%REVISION=HJV=920827="Original version" -! -! Layout of overall include file (NGI.DEF) -! -%COMMENT="NGI.DEF is an INCLUDE file for the NGIDS program" -%COMMENT=" " -! -%VERSION=3 -%SYSTEM=1 -%USER=HJV -%%DATE -%%NAME -! -%ALIGN !Align structures -! -%INCLUDE=NSTAR_DSF !# OF TELESCOPES ETC -%GLOBAL=MXNSET=16 !MAX. # OF SETS PER INPUT JOB -%GLOBAL=MXNSEQ=256 !MAX. # OF GIDS SEQUENCES -!- -.DEFINE - .DATA -! -! Parameters -! - .PARAMETER -! -! Local variables: -! - .COMMON -! -! Values defined in NGIDAT -! - OPTION C24 !PROGRAM OPTION - OPT=OPTION C3 - MAPTYP C16 / / !MAP/IFRS/CHAN -! - NODIN C80 !NODE - FILIN C160 !FILE NAME - FCAIN J !FILE IDENTIFIER - SETS J(0:7,0:MXNSET) !SETS TO SHOW - SETNAM J(0:7) !SET NAME - RANGE E(2) !MINIMUM/MAXIMUM -! - TAREA J(0:3) !AREA TO SHOW - PAREA J(0:3) - TEAR J(0:3) - PEAR J(0:3) - MXAREA J(0:3) - FAREA J(0:3) - NRA J !X-DIMENSION - NDEC J !Y-DIMENSION - COMPR J !COMPRESSION -! - HARAN E(0:1) !HOUR ANGLE RANGE - HAINC E !HOUR ANGLE INCREMENT - SIFRS B(0:NSTAR_TEL-1,0:NSTAR_TEL-1) !SELECT INTERFEROMETERS - STELS B(0:NSTAR_TEL-1) !SELECT TELESCOPES - SPOL J !POLARISATION BITS - RCHAN J(0:1) !RANGE IN CHANNELS - NIFR J !NUMBER OF IFR'S - DATTYP C16 !DATA TYPES TO DO - DO_BLANK L !BLANK FLAGGED DATA -! - IDXLUT J(0:NSTAR_TEL-1,0:NSTAR_TEL-1) !FIND LINE NO FOR EACH IFR - IFRLUT J(0:NSTAR_TEL*NSTAR_TEL-1) !FIND IFR FOR EACH LINE NO - TELPOS E(0:NSTAR_TEL-1) !TELESCOPE POSITIONS -! - CORAP J !CORRECTIONS TO APPLY - CORDAP J !CORRECTIONS TO DE-APPLY - NSRC J(0:2) !SOURCE COUNTS IN MODEL -! - DO_FLAG L !FLAG DATA AFTER LOAD (regions) - DO_CLIP L !FLAG DATA AFTER LOAD (clipping) - ALLCH L /.TRUE./ !FLAG IN ALL CHANNELS - ALLPOL L /.TRUE./ !FLAG IN ALL POLARISATIONS - UFL J /0/ !FLAG TO SET -! -! These variables describe the state of the GIDS display -! - GID J !GIDS DISPLAY ID - DEFIMG L /.TRUE./ !Call GDI_DEFIMG required? - NRMAP J !#MAPS LOADED - DMAP J /0/ !MAP PLANE AREA - DFLG J /0/ !FLAG PLANE AREA - IPTR J !Pointer in areas - LBUF J !Size of areas - CSCALE E !FOR SCALING DATA - CZERO E - BLANK J !BLANK VALUE IN GIDS - MAXCOL J !Colorrange in GIDS - MINCOL J - XSIZ J !Size of GIDS window - YSIZ J - AVGFAC E !Averaging factor -! -! Some general things -! - TELNAM CNSTAR_TEL /0123456789ABCD/ !TEL. NAMES - DFAR J /0/ !FLAG FILE AREA - PTR J /0/ !Pointer to header -.END diff --git a/src/nplot/ngi.grp b/src/nplot/ngi.grp deleted file mode 100644 index 3c7ba705b28392497c605dc73f810e52ffbd5c84..0000000000000000000000000000000000000000 --- a/src/nplot/ngi.grp +++ /dev/null @@ -1,61 +0,0 @@ -!+ NGI.GRP -! HJV 920827 -! -! Revisions: -! WNB 921211 Add PSC -! HjV 930222 Add NGDI.CUN -! WNB 930329 Make FSC -! WNB 930331 Correct gdi.cun name -! WNB 930510 Add NGIDAT, PNT -! WNB 930514 Add NGIDOP, NGIDCL. NGIDPT, NGIDLM -! CMV 931029 Remove NGIMAP, add NGIREC, NGIDIF, NGIDCH, NGISET -! HjV 940217 Add/change missing entry-points/functions -! WNB 940301 Correct NGIDMP entry point name -! -! General data calculation and plotting -! -! Group definition: -! -NGI.GRP -! -! PIN file -! -NGIDS.PSC -! -! Structure files -! -! -! Fortran definition files: -! -NGI.DSC ! Program common parameters -! -! Programs: -! -NGIDS.FSC ! Main routine -NGIDAT.FOR !NGIDAT Get user parameters -NGIDMP.FOR !NGIDMP Load map areas in GIDS -NGIDIF.FOR !NGIDIF Load ha,ifr areas in GIDS -NGIDCH.FOR !NGIDCG Load ha,chan areas in GIDS -NGIDOP.FOR !NGIDOP Open GIDS - !NGIDCL Close GIDS -NGICDT.FOR !NGICDT Convert single datapoint - !NGICDI Initialise model for sector - !NGICDS Read corrected data per scan -NGIDLM.FOR !NGIDLM Load single map area in GIDS -NGIDPT.FOR !NGIDPT Get point from screen -NGIGDI.CUN ! Interface calls to GIPSY-routines - !N_GDI_* interface face to gdi_* -NGIINI.FOR !NGIINI Initialise program -NGILOD.FOR !NGILOD Load one or more plots -NGIREC.FOR !NGIREC Record plane in GIDS -NGISET.FOR !NGISET Set size, grid and scale in GIDS - !NGICLR Clear virtual memory - !NGICOV Clear overlay planes - !NGISFL Handle flags - !NGITRA Transfer data, write ID -NGIPNT.FOR !NGIPNT Give GIDS map info on points/areas -! -! Executables -! -NGIDS.EXE -!- diff --git a/src/nplot/ngicdt.for b/src/nplot/ngicdt.for deleted file mode 100644 index 33e791b511cb37fd1ac55c9228e086a8a874d150..0000000000000000000000000000000000000000 --- a/src/nplot/ngicdt.for +++ /dev/null @@ -1,165 +0,0 @@ -C+ NGICDT.FOR -C CMV 931123 -C -C Revisions: -C CMV 931123 Created -C WNB 931221 Double declared RDAT; wnctxt format error; Ampl/phaes -C CMV 940218 Add option to blank flagged data, -C CMV 940218 Changed sequence in NSCSCF -C CMV 940415 Phases in range -180, 180 -C CMV 940622 Move DO_BLANK to calling routine -C - LOGICAL FUNCTION NGICDT(ISCN,STH_IN,HEAD,IFRT,FLG,RDAT) -C -C Initialise sector and scan, read corrected data and flags, -C get requested data type. -C -C Result: -C -C NGICDT_J = NGICDT(ISCN_J:I, STH_IN_B(0:*):I, -C HEAD_L:O, IFRT_I(0:*):O, -C FLG(0:*,0:3)_J:O, RDAT(0:*,0:3)_E:O) -C -C Include files: -C - INCLUDE 'WNG_DEF' - INCLUDE 'NGI_DEF' - INCLUDE 'CBITS_DEF' - INCLUDE 'STH_O_DEF' - INCLUDE 'SCH_O_DEF' -C -C Parameters: -C -C -C Arguments: -C - INTEGER ISCN !SCAN TO READ - BYTE STH_IN(0:*) !SET HEADER - LOGICAL HEAD !FLAG SET IN SCAN HEADER? - INTEGER*2 IFRT(0:STHIFR-1) !IFR TABLE - INTEGER FLG(0:STHIFR-1,0:3) !FLAGS AND WEIGHTS - REAL RDAT(0:STHIFR-1,0:3) !CORRECTED DATA -C -C Entry points: -C -C -C Function references: -C - REAL WNGEFD !FRACTIONS TO DEGREES - LOGICAL NMORDH !Read model header - LOGICAL NSCSCF !Read corrected data - LOGICAL NSCSIF !READ IFR TABLE - CHARACTER*32 WNTTSG !PRINT SET NAME -C -C Data declarations: -C - INTEGER STP !Source type of model - DOUBLE PRECISION SRA,SDEC,SFRQ !Model info - REAL UV0(0:3) !Basic uv coordinates - REAL LM0(0:1) !Basic source displacement - DOUBLE PRECISION FRQ0 !Basic frequency - REAL TF(0:1) !Integr. time, bandwidth - INTEGER MINST !Instrument -C - SAVE STP,SRA,SDEC,SFRQ,UV0,LM0,FRQ0,TF,MINST -C - COMPLEX CV1,CV2 !Complex data,model - REAL WGT(0:STHIFR-1,0:3) !Weights - REAL DAT(0:1,0:STHIFR-1,0:3) !Data - COMPLEX CDAT(0:STHIFR-1,0:3) - EQUIVALENCE(DAT,CDAT) - COMPLEX CMOD(0:3,0:STHIFR-1) !Model IQUV - COMPLEX CAMOD(0:STHIFR-1,0:3) !Model XYX -C - INTEGER*2 IFRX(0:STHIFR-1) !IFR TABLE - INTEGER IFRA(0:1,0:STHIFR-1) ! IFR TABLE - REAL ANG(0:2,0:STHIFR-1) ! DIPOLE ANGLES -C - BYTE STH(0:STH__L-1) !SET HEADER - INTEGER STHJ(0:STH__L/LB_J-1) - INTEGER*2 STHI(0:STH__L/LB_I-1) - REAL STHE(0:STH__L/LB_E-1) - EQUIVALENCE (STH,STHI,STHJ,STHE) -C - BYTE SCH(0:SCHHDL-1) !SCAN HEADER - INTEGER SCHJ(0:SCHHDL/4-1) - INTEGER*2 SCHI(0:SCHHDL/2-1) - REAL SCHE(0:SCHHDL/4-1) - EQUIVALENCE (SCH,SCHJ,SCHI,SCHE) -C- -C - NGICDT=.TRUE. ! Assume ok -C -C Make local copy of sector header, initialise if first sector -C - CALL WNGMV(STH__L,STH_IN,STH) ! Move bytes - IF (ISCN.EQ.0) THEN - IF (.NOT.NSCSIF(FCAIN,STH,IFRX,IFRA,ANG)) THEN !READ IFR TABLE - CALL WNCTXT(F_TP,'Error reading interferometer table') - GOTO 990 - ELSE IF (OPT.EQ.'DAT'.AND.NSRC(0).GT.0) THEN !MODEL - IF (.NOT.NMORDH(6,STP,SRA,SDEC,SFRQ)) THEN !NEXT SET - CALL WNCTXT(F_TP,'Error: cannot initialise model') - CALL WNCTXT(F_TP, - 1 'You may need write access to the SCN-file') - GOTO 990 - ELSE - CALL NMOMST(STP,SRA,SDEC,STH,LM0,FRQ0,TF,MINST) !GET DATA - END IF - END IF - END IF - DO I=0,STHIFR-1 - IFRT(I)=IFRX(I) - END DO -C -C Read data and flags, get model -C - IF (.NOT.NSCSCF(FCAIN,STH,IFRX,ISCN, - & CORAP,CORDAP,SCH,WGT,CDAT,FLG)) THEN !Get corrected data - GOTO 980 !Error correcting - ELSE IF (NSRC(0).GT.0) THEN - CALL NMOMUV(STP,SRA,SDEC,STH,SCH,UV0) !Get model UV data - CALL NMOMU4(0,FCAIN,ISCN,STH,UV0,LM0,FRQ0, - & STHE(STH_RTP_E),STHI(STH_PLN_I), - & STHJ(STH_NIFR_J),IFRT,TF,MINST,CMOD) ! Model data - CALL NMOCIX(STH,SCH,ANG,CAMOD,CMOD) !Convert - END IF -C -C Check if Flags set in header -C - HEAD=(IAND(FL_ALL,SCHJ(SCH_BITS_J)).NE.0) -C -C Convert to proper datatype -C - DO I1=0,STHJ(STH_NIFR_J)-1 ! SCAN ALL IFRs - DO I2=0,3 - CV1=CDAT(I1,I2) ! DATA - CV2=0 ! NO MODEL - IF (NSRC(0).GT.0) CV2=CAMOD(I1,I2) ! MODEL - IF (DATTYP(1:3).EQ.'COS') THEN - RDAT(I1,I2)=REAL(CV1-CV2) - ELSE IF (DATTYP(1:3).EQ.'SIN') THEN - RDAT(I1,I2)=AIMAG(CV1-CV2) - ELSE IF (DATTYP(1:3).EQ.'AMP') THEN - CALL WNMAAM(1,CV1-CV2,RDAT(I1,I2)) !MAKE AMPL - ELSE IF (DATTYP(1:3).EQ.'PHA') THEN !No model subtraction yet - CALL WNMAPH(1,CV1-CV2,RDAT(I1,I2)) !MAKE PHASE - RDAT(I1,I2)=WNGEFD(RDAT(I1,I2)) !MAKE DEGREES - IF (RDAT(I1,i2).GT.180) RDAT(I1,I2)=RDAT(I1,I2)-360. !-180..180 - END IF - END DO - END DO -C - RETURN -C - 980 CONTINUE - NGICDT=.FALSE. !ERROR - CALL WNCTXT(F_TP,'Error in scan !SJ',ISCN) - RETURN -C - 990 CONTINUE - NGICDT=.FALSE. !ERROR - CALL WNCTXT(F_TP,'Error in sector !AS',WNTTSG(SETNAM,0)) - RETURN -C - END diff --git a/src/nplot/ngidat.for b/src/nplot/ngidat.for deleted file mode 100644 index e7b03f9f7b07da95083927e6b97ab65f9a59c794..0000000000000000000000000000000000000000 --- a/src/nplot/ngidat.for +++ /dev/null @@ -1,636 +0,0 @@ -C+ NGIDAT.FOR -C WNB 930510 -C -C Revisions: -C WNB 930514 Use NGID routines -C WNB 930514 Calculate realistic max/min range -C HjV 930518 Change some keywords -C WNB 930621 Remove AREA; add FLAG, CLEAR, SAVE, WRITE -C WNB 930622 Rename some options -C WNB 930803 CBITS_DEF -C CMV 930930 Change LOAD to MAP, add DATA option -C CMV 930930 Reset NRMAPS for GCLEAR -C CMV 931025 Close GIDS again, re-open in NGILOD (for resize) -C CMV 931123 Option to plot corrected data with model subtract -C CMV 931213 Added BASE option for MAPTYP, use prescan to get -C decent scaling, add use of DEFIMG -C CMV 931220 Pass FCA of input file to WNDXLP and WNDSTA/Q -C CMV 931220 Do not use first scans for range determination -C WNB 931221 Changed FLOAT to REAL; to CEIL/FLOOR; MAX to MIN -C CMV 940111 Initialise NGICDT, use MPH min/max if possible -C CMV 940203 Added ALL_POLS keyword, changed UNLOAD/SAVE -C CMV 940218 Added BLANK_FLAGS keyword, quit if open fails -C CMV 940225 Enable default model file (use NMODAW) -C CMV 940316 Reload CAP/CDAP since INTERN may be used -C CMV 940415 Cleared text if internal model used -C CMV 940817 Added CLIPFLAG option -C CMV 000828 HARAN(0) is always an integer of HAINC -C - SUBROUTINE NGIDAT(ACT) -C -C Get NGIDS program parameters -C -C Result: -C -C CALL NGIDAT( ACT_L:I) will ask and set all program parameters -C If ACT .true. open display first -C -C PIN references: -C -C OPTION -C MAP_COMPRESS -C MAP_RANGE -C MAP_SEQUENCES -C USER_FLAG -C -C Include files: -C - INCLUDE 'WNG_DEF' - INCLUDE 'CBITS_DEF' - INCLUDE 'MPH_O_DEF' - INCLUDE 'STH_O_DEF' - INCLUDE 'FLH_O_DEF' - INCLUDE 'NGI_DEF' -C -C Parameters: -C -C -C Arguments: -C - LOGICAL ACT !TRUE IF FIRST CALL -C -C Function references: -C - LOGICAL WNDPAR !GET DWARF PARAMETER - LOGICAL WNDNOD !GET NODE NAME - LOGICAL WNFOP !OPEN FILE - LOGICAL WNFRD !READ DISK - LOGICAL WNDSTQ !GET SETS TO DO - INTEGER WNMEJC !CEIL - INTEGER WNMEJF !FLOOR - LOGICAL NMASTG !GET A SET - LOGICAL NSCSTG !GET A SET - LOGICAL NGIDOP !OPEN GIDS - LOGICAL NSCHAS !GET HOUR-ANGLE RANGE - LOGICAL NSCPLS !GET Polarisations - LOGICAL NSCIF1 !GET INTERFEROMETERS - INTEGER NGIDCL !CLOSE GIDS - LOGICAL NGICDT !READ AND CONVERT DATA - INTEGER N_GDI_REMOVE !REMOVE GIDS MAP - LOGICAL NFLFLS,NFLFL0,NFLFL9,NFLFL5,NFLFL7 !FLAG AREA HANDLING - LOGICAL NMOMSC !Set model data -C -C Data declarations: -C - CHARACTER OLDTYP*16 !Temp save value of MAPTYP - REAL OMIN,OMAX !Temp save old range - LOGICAL FULL_AREA !Flag wether full map asked - INTEGER MPHP !MAP HEADER POINTER - INTEGER STHP !SET HEADER POINTER - INTEGER SEQS(2) !DELETE RANGE - BYTE LBT !TEMP TO GET DWARF LOGICAL -C - BYTE MPH(0:MPHHDL-1) !MAP HEADER - INTEGER MPHJ(0:MPHHDL/4-1) - REAL MPHE(0:MPHHDL/4-1) - EQUIVALENCE (MPH,MPHJ,MPHE) - BYTE STH(0:STH__L-1) !SET HEADER - INTEGER STHJ(0:STH__L/LB_J-1) - INTEGER*2 STHI(0:STH__L/LB_I-1) - REAL STHE(0:STH__L/LB_E-1) - EQUIVALENCE (STH,STHI,STHJ,STHE) - BYTE FLH(0:FLHHDL-1) !FLAG HEADER - INTEGER FLHJ(0:FLHHDL/LB_J-1) - REAL FLHE(0:FLHHDL/LB_E-1) - EQUIVALENCE (FLH,FLHJ,FLHE) -C - REAL RBUF(0:8191) !DATA BUFFER - REAL RDAT(0:STHIFR-1,0:3) !DATA VALUE (ifr, pol) - EQUIVALENCE (RBUF,RDAT) !SAVE SPACE -C - INTEGER FLG(0:STHIFR-1,0:3) !FLAGS/WEIGHTS (ifr, pol) - INTEGER*2 IFRT(0:STHIFR-1) !IFR TABLE -C- -C -C INIT -C - IF (ACT) THEN !FIRST TIME - IF (.NOT.NGIDOP(GID)) THEN - CALL WNCTXT (F_TP,'Error opening GIDS display') - OPTION='QUIT' - GOTO 900 - END IF -C -C We cannot resize the GIDS window if a client is connected. -C So we close the connection here and re-open in NGILOD. -C This allows for resizing before a map is loaded. -C - JS=NGIDCL(GID) - OPTION='MAP' - NRMAP=0 !NO MAPS LOADED - DO_FLAG=.FALSE. !NO FLAGGING - DO_CLIP=.FALSE. !NO CLIPPING - DO_BLANK=.FALSE. !DO NOT BLANK FLAGS - NSRC(0)=0 !NO MODEL SO FAR - DEFIMG=.TRUE. !NEED TO SET UP - RANGE(1)= 1E30 !Initialise range - RANGE(2)=-1E30 - NODIN='""' !No node known yet - END IF - ACT=.FALSE. !NOT FIRST TIME -C -C GET OPTION -C - 100 CONTINUE - IF (.NOT.WNDPAR('OPTION',OPTION,LEN(OPTION),J0,OPTION)) THEN - OPTION='QUIT' !ASSUME END - ELSE IF (J0.LE.0) THEN - OPTION='QUIT' !ASSUME END - END IF -C -C QUIT -C - IF (OPT.EQ.'QUI') THEN !READY - JS=NGIDCL(GID) !CLOSE GIDS CONNECTION - JS=NFLFL9(DFAR) !MAKE SURE FLAG FILE GONE - GOTO 900 -C -C MAP -C - ELSE IF (OPT.EQ.'MAP') THEN - IF (MAPTYP.NE.'MAP') DEFIMG=.TRUE. !New type, need re-define - MAPTYP='MAP' !Ordinary MAPS from WMP - 200 CONTINUE - IF (.NOT.WNDNOD('INPUT_WMP_NODE',NODIN,'WMP','R',NODIN,FILIN)) THEN - IF (E_C.EQ.DWC_ENDOFLOOP) GOTO 100 !RETRY OPTION - GOTO 200 !RETRY - ELSE IF (E_C.EQ.DWC_NULLVALUE) THEN - GOTO 200 !RETRY OPTION - ELSE IF (E_C.EQ.DWC_WILDCARD) THEN - GOTO 200 !MUST SPECIFY - END IF - IF (.NOT.WNFOP(FCAIN,FILIN,'R')) GOTO 200 !OPEN INPUT - 201 CONTINUE - IF (.NOT.WNDSTQ('WMP_SETS',MXNSET,SETS(0,0),FCAIN)) THEN - GOTO 200 !RETRY FILE - END IF - IF (NMASTG(FCAIN,SETS,MPH,MPHP,SETNAM)) THEN !FIND A SET - CALL WNDSTR(FCAIN,SETS) !RESET SET SEARCH - ELSE - GOTO 201 !RETRY - END IF -C -C GET AREA -C - DO I=0,3 !SET DEFAULT - TAREA(I)=0 !DEFAULT AREA - FAREA(I)=0 !FULL AREA - MXAREA(I)=0 !MAX. AREA - END DO - FAREA(2)=MPHJ(MPH_NRA_J) !LINE LENGTH - FAREA(3)=MPHJ(MPH_NDEC_J) - TAREA(2)=FAREA(2) !DEFAULT=FULL - TAREA(3)=FAREA(3) - MXAREA(2)=FAREA(2) !MAX. AREA - MXAREA(3)=FAREA(3) - CALL NMADAR(1,J0,FAREA,2,MXAREA,TAREA,PAREA, - 1 TEAR,PEAR) !GET AREA - IF (J0.LE.0) GOTO 200 !NO AREA GIVEN -C -C Check if the user wanted the whole map -C - FULL_AREA=.TRUE. - DO I=0,3 - IF (TAREA(I).NE.FAREA(I)) FULL_AREA=.FALSE. - END DO - IF (FULL_AREA) CALL WNCTXT(F_T,'Full map asked') -C -C COMPRESS -C - IF (.NOT.WNDPAR('MAP_COMPRESS',COMPR,LB_J,J0,'1')) THEN - GOTO 200 !RETRY - END IF - IF (J0.EQ.0) GOTO 200 - IF (J0.LT.0) COMPR=1 !DEFAULT -C -C DETERMINE MAX/MIN (save old for a while) -C - OMIN=RANGE(1) - OMAX=RANGE(2) - NRA = MPHJ(MPH_NRA_J) !RA-DIMENSION - NDEC = MPHJ(MPH_NDEC_J) !DEC-DIMENSION - RANGE(1)=1E30 !MINIMUM - RANGE(2)=-1E30 !MAXIMUM - DO WHILE(NMASTG(FCAIN,SETS,MPH,MPHP,SETNAM)) !ALL SETS - IF (NRA.EQ.MPHJ(MPH_NRA_J) .AND. - 1 NDEC.EQ.MPHJ(MPH_NDEC_J)) THEN !CAN DO -C -C Full area: can take the max and min from the map-header -C - IF (FULL_AREA) THEN - RANGE(2)=MAX(RANGE(2),MPHE(MPH_MAX_E)) !SET MAX - RANGE(1)=MIN(RANGE(1),MPHE(MPH_MIN_E)) !SET MIN -C -C Sub-area: calculate actual range -C - ELSE - DO I=TEAR(2),TEAR(3) !ALL LINES - IF (.NOT.WNFRD(FCAIN,LB_E*MPHJ(MPH_NRA_J), - 1 RBUF,MPHJ(MPH_MDP_J)+ - 1 (I+MPHJ(MPH_NDEC_J)/2)*LB_E*MPHJ(MPH_NRA_J))) THEN - CALL WNCTXT(F_TP,'Error reading map data') - CALL WNGEX !STOP PROGRAM - END IF - DO I1=TEAR(0)+MPHJ(MPH_NRA_J)/2, - 1 TEAR(1)+MPHJ(MPH_NRA_J)/2 !ALL POINTS - IF (RBUF(I1).NE.0.0) THEN !FORGET EMPTY UV POINTS - RANGE(2)=MAX(RANGE(2),RBUF(I1)) !SET MAX - RANGE(1)=MIN(RANGE(1),RBUF(I1)) !SET MIN - END IF - END DO - END DO - END IF - END IF - END DO - IF (.NOT.WNDPAR('MAP_RANGE',RANGE,2*LB_E,J0, - 1 A_B(-A_OB),RANGE,2)) GOTO 200 !RETRY - IF (J0.EQ.0) GOTO 200 - IF (RANGE(1).NE.OMIN.OR.RANGE(2).NE.OMAX) DEFIMG=.TRUE. -C -C DATA -C - ELSE IF (OPT.EQ.'DAT') THEN -C -C Inform about flagging mode -C - IF (DO_FLAG) THEN - JS=NFLFLS(DFAR,FLH) - CALL WNCTXT(F_T, - 1 'Flagging mode is on, !UJ flags in list', - 1 FLHJ(FLH_FLFN_J)) - END IF -C -C GET PLOTTING AXES -C -C Horizontal axis will always be Hourangle, Vertical axis may be -C Interferometers, Baseline or Channel number. -C -C If Channel number choosen: sequence in IFR -C If IFR/Basel choosen: sequence in Sets (Channel number) -C - 315 CONTINUE - OLDTYP=MAPTYP - IF (MAPTYP.NE.'IFRS'.AND.MAPTYP.NE.'BASE' !DEFAULT - 1 .AND.MAPTYP.NE.'CHAN') THEN - MAPTYP='IFRS' - RANGE(1)=+1E10 !Range for MAP no - RANGE(2)=-1E10 ! use for SCN - END IF - IF (.NOT.WNDPAR('PLOT_TYPE',MAPTYP,LEN(MAPTYP),J0,MAPTYP)) - 1 THEN - IF (E_C.EQ.DWC_ENDOFLOOP) GOTO 100 !RETRY OPTION - GOTO 315 !RETRY - END IF - IF (OLDTYP.NE.MAPTYP) DEFIMG=.TRUE. !New type, need re-define -C -C Get input SCN file -C - 300 CONTINUE - IF (.NOT.WNDNOD('INPUT_SCN_NODE',NODIN,'SCN','R',NODIN,FILIN)) THEN - IF (E_C.EQ.DWC_ENDOFLOOP) GOTO 315 !RETRY PLOT-OPTION - GOTO 300 !RETRY - ELSE IF (E_C.EQ.DWC_NULLVALUE) THEN - GOTO 315 !RETRY PLOT-OPTION - ELSE IF (E_C.EQ.DWC_WILDCARD) THEN - GOTO 300 !MUST SPECIFY - END IF -C -C We may want to change flags and do things with models, so -C open with Update. If this fails, try to open with Read only. -C - IF (.NOT.WNFOP(FCAIN,FILIN,'U')) THEN - IF (.NOT.WNFOP(FCAIN,FILIN,'R')) GOTO 300 - END IF -C -C Get sectors to operate upon -C - 301 CONTINUE - IF (.NOT.WNDSTQ('SCN_SETS',MXNSET,SETS(0,0),FCAIN)) THEN - GOTO 300 !RETRY FILE - END IF -C -C Check if we have at least one, find ha-increment and channel range -C - IF (NSCSTG(FCAIN,SETS,STH,STHP,SETNAM)) THEN !FIND A SET - HAINC=STHE(STH_HAI_E) !GET INCREMENT - HARAN(0)=STHE(STH_HAB_E) !GET START - HARAN(1)=STHE(STH_HAB_E)+HAINC*STHJ(STH_SCN_J) !GET END - NIFR=STHJ(STH_NIFR_J) !Assume all have the same - DO I1=0,STHTEL-1 - TELPOS(I1)=STHE(STH_RTP_E+I1) - END DO - RCHAN(0)=STHI(STH_CHAN_I) !WE HAD THE FIRST SET ALREADY - RCHAN(1)=STHI(STH_CHAN_I) - DO WHILE (NSCSTG(FCAIN,SETS,STH,STHP,SETNAM)) !SCAN THE REST - I1=STHI(STH_CHAN_I) !Get channel range - IF (I1.LT.RCHAN(0)) RCHAN(0)=I1 - IF (I1.GT.RCHAN(1)) RCHAN(1)=I1 - R0=STHE(STH_HAB_E) - IF (R0.LT.HARAN(0)) HARAN(0)=R0 !Get HA range - IF (R0+HAINC*STHJ(STH_SCN_J).GT.HARAN(1)) - 1 HARAN(1)=R0+HAINC*STHJ(STH_SCN_J) - END DO - CALL WNCTXT(F_TP,'Channel range: !UJ - !UJ', - 1 RCHAN(0),RCHAN(1)) - IF (MAPTYP.EQ.'CHAN') THEN - TEAR(2)=RCHAN(0) - TEAR(3)=RCHAN(1) - ELSE - TEAR(2)=0 - TEAR(3)=STHTEL*STHTEL-1 - ENDIF - CALL WNDSTR(FCAIN,SETS) !RESET SET SEARCH - ELSE - GOTO 301 !RETRY - END IF -C -C GET AREA = HA-RANGE and Polarisations/Interferometers -C - D0=HARAN(0) - IF (.NOT.NSCHAS(0,HARAN)) GOTO 300 !GET HA RANGE - J0=(HARAN(0)-D0)/HAINC - HARAN(0)=D0+J0*HAINC !Integer number of HAINCs - TEAR(0)=WNMEJF(HARAN(0)/HAINC) - TEAR(1)=WNMEJC(HARAN(1)/HAINC) -C - IF (.NOT.NSCPLS(2,SPOL)) GOTO 300 !GET POLARISATION SELECTION -C - IF (MAPTYP.EQ.'CHAN') THEN - IF (.NOT.NSCIF1(2,SIFRS,STHJ)) GOTO 300 !GET IFRS - ENDIF -C -C GET DATA TYPE -C -C Since GIDS uses the same clipping for all planes, plotting Amp -C and Phase in the same sequence is pretty useless (either of them -C will show up as rubbish in most cases). -C -C In principle, we could display I,Q,U,V with the DATA option, -C however, too keep things simple at first we forget about that -C for the while. It may be inserted later here and in NGICDT -C - 306 CONTINUE - IF (.NOT.WNDPAR('DATA_TYPE',DATTYP,LEN(DATTYP),J0,'AMPL')) - 1 THEN - IF (E_C.EQ.DWC_ENDOFLOOP) GOTO 300 !RETRY FILE - GOTO 306 - END IF - COMPR=1 !No compression allowed -C -C For DATA option, get corrections and model -C - 308 CONTINUE - CALL NSCSAD(CORAP,CORDAP) !Get corrections - IF (IAND(CORDAP,CAP_MOD).EQ.0) THEN !No DEAPPLY=MODEL - CALL WNCTXT(F_TP,'Choose CLEAR and QUIT '// - & 'if you do not want model subtraction') - CALL NMODAW(NSRC(0),STH) !Get model - CALL NSCSAD(CORAP,CORDAP) !Get corrections - IF (NSRC(0).GT.0) THEN !Model given - CALL NMOMUI() ! so get the type - IF (.NOT.NMOMSC(FCAIN,SETS)) THEN ! and set it - CALL WNCTXT(F_TP,'Error in model calculation') - GOTO 308 - END IF - ELSE - CALL WNCTXT(F_TP,'No model subtraction') - END IF - END IF - IF (IAND(CORDAP,CAP_MOD).NE.0) THEN !DEAPPLY=MODEL - CALL WNCTXT(F_TP, - & 'The model present in the SCN file will be subtracted') - END IF -C -C Save old max and min: if the same, we can continue a sequence -C - OMIN=RANGE(1) - OMAX=RANGE(2) -C -C Do a prescan on the first sector to get an idea of the range -C We use all scans from the first sector to get a reasonable range, -C but exclude the first and last few since they are most likely to -C contain execptional values. Please mind the range is just used as -C a default for the range prompt. -C - CALL WNCTXT(F_T,'Calculating range...') - CALL WNDSTR(FCAIN,SETS) !RESET SET SEARCH - IF (NSCSTG(FCAIN,SETS,STH,STHP,SETNAM)) THEN !READ FIRST HEADER - JS=NGICDT(0,STH,JS,IFRT,FLG,RDAT) !Initialise -C -C For amplitudes we calculate a second minimum for points above 100, -C and count the number of points with values below 100. -C This allows us to give a more useful minimum (a full -C histogram analysis might be better but is slower). -C - I3=0 !Counter - R0=1E30 !Biased minimum -C - DO I=2,STHJ(STH_SCN_J)-3 !SOME SCANS - IF (NGICDT(I,STH,JS,IFRT,FLG,RDAT)) THEN !READ DATA - DO I1=0,STHJ(STH_NIFR_J)-1 !ALL IFRs - DO I2=0,3 !ALL POLs -C -C Scale based on points with data and no flags -C - IF (IAND(FLG(I1,I2),'000000ff'X).NE.0.AND. - 1 IAND(FLG(I1,I2),'0000ff00'X).EQ.0) THEN - IF (RDAT(I1,I2).GT.RANGE(2)) - 1 RANGE(2)=RDAT(I1,I2) !NEW MAXIMUM - IF (DATTYP(1:3).EQ.'AMP') THEN - IF (RDAT(I1,I2).LT.100.) THEN - I3=I3+1 !Count low points - ELSE IF (RDAT(I1,I2).LT.R0) THEN - R0=RDAT(I1,I2) !Biased minimum - END IF - END IF - IF (RDAT(I1,I2).LT.RANGE(1)) - 1 RANGE(1)=RDAT(I1,I2) !NEW MINIMUM - END IF - END DO - END DO - END IF - END DO - END IF - CALL WNDSTR(FCAIN,SETS) !RESET SET SEARCH -C -C Ask the range, if not the same as before: need to initialise GIDS again -C - IF (RANGE(1).GE.RANGE(2)) THEN !No data found - RANGE(1)=0 - RANGE(2)=100 - ELSE IF (RANGE(1).LT.100..AND. - 1 I3.GT.0.AND.I3.LT.100) THEN !Low points - CALL WNCTXT(F_TP,'Found only !UJ points <100, '// - 1 'discard true minumum !E',I3,RANGE(1)) - RANGE(1)=R0 - END IF - IF (.NOT.WNDPAR('MAP_RANGE',RANGE,2*LB_E,J0, - 1 A_B(-A_OB),RANGE,2)) GOTO 300 !RETRY - IF (J0.EQ.0) GOTO 300 - IF (RANGE(1).NE.OMIN.OR.RANGE(2).NE.OMAX) DEFIMG=.TRUE. -C -C Should flagged data points be set to blank? -C - DO_BLANK=.FALSE. - IF (.NOT.WNDPAR('BLANK_FLAGS',LBT,LB_B,J0,'NO')) THEN - GOTO 100 !RETRY - END IF - IF (LBT) DO_BLANK=.TRUE. - IF (J0.LE.0) DO_BLANK=.FALSE. -C -C -C -C --- This option is there for downward compatibility -C -C -C POINT/FLAG -C - ELSE IF (OPT.EQ.'POI' .OR. OPT.EQ.'FLA') THEN - IF (NRMAP.LE.0) THEN - CALL WNCTXT(F_TP,'Load a map first') - OPTION='MAP' - GOTO 100 - END IF - IF (OPT.EQ.'FLA') THEN - IF (.NOT.NFLFL0(DFAR)) THEN - CALL WNCTXT(F_TP,'Error getting flag file/area') - OPTION='QUIT' - GOTO 100 - END IF - IF (UFL.EQ.0) UFL=FL_MAN !ASSUME MANUAL FLAG - END IF -C -C --- The remaining options are handled completely inside this routine -C - -C -C FLAG -C - ELSE IF (OPT.EQ.'DOF'.OR.OPT.EQ.'CLI') THEN - IF (.NOT.NFLFL0(DFAR)) THEN - CALL WNCTXT(F_TP,'Error getting flag file/area') - OPTION='QUIT' - GOTO 100 - END IF - DO_FLAG=.TRUE. !SET FLAGGING TOGGLE - UFL=FL_MAN !DEFAULT IS MANUAL FLAG - ALLCH=.TRUE. - ALLPOL=.TRUE. - IF (OPT.EQ.'DOF') THEN !Using regions - DO_CLIP=.FALSE. - CALL WNCTXT(F_T, - & '-------------------------------------------') - CALL WNCTXT(F_T, - & ' Flag data after a plane has been loaded:') - CALL WNCTXT(F_T, - & ' Goto Etc menu in GIDS, press Region') - CALL WNCTXT(F_T, - & ' Press Define to set flags with the mouse') - CALL WNCTXT(F_T, - & ' Left: Draw linepiece of polygon') - CALL WNCTXT(F_T, - & ' Middle: Erase linepiece of polygon') - CALL WNCTXT(F_T, - & ' Right: Close polygon') - CALL WNCTXT(F_T, - & ' Press Ready when done') - CALL WNCTXT(F_T, - & '-------------------------------------------') - ELSE !Using cliplevels - DO_CLIP=.TRUE. - CALL WNCTXT(F_T,'You have to specify a cliplevel later') - END IF - CALL WNCTXT(F_T,'NB: You should load a plane NOW') - CALL WNCTXT(F_T,'You cannot flag in the current plane') -C - 400 IF (.NOT.WNDPAR('ALL_CHAN',LBT,LB_B,J0,'YES')) THEN - GOTO 100 !BACK TO MENU - END IF - IF (.NOT.LBT) ALLCH=.FALSE. - IF (J0.EQ.0) GOTO 100 - IF (J0.LE.0) ALLCH=.TRUE. - IF (.NOT.WNDPAR('ALL_POLS',LBT,LB_B,J0,'YES')) THEN - GOTO 400 !RETRY - END IF - IF (.NOT.LBT) ALLPOL=.FALSE. - IF (J0.EQ.0) GOTO 400 - IF (J0.LE.0) ALLPOL=.TRUE. -C - CALL WNDDA3('USER_FLAG',UFL) - IF (UFL.EQ.0) UFL=FL_MAN !ASSUME MANUAL FLAG - OPTION='DATA' - GOTO 100 -C -C NOFLAG -C - ELSE IF (OPT.EQ.'NOF') THEN - JS=NFLFL9(DFAR) !MAKE SURE FLAG FILE GONE - DO_FLAG=.FALSE. !RESET FLAGGING TOGGLE - OPTION='DATA' - GOTO 100 -C -C CLEAR -C - ELSE IF (OPT.EQ.'CLE') THEN - JS=NFLFL9(DFAR) !MAKE SURE FLAG FILE GONE - OPTION='DOFLAG' - GOTO 100 -C -C UNLOAD/WRITE -C - ELSE IF (OPT.EQ.'UNL' .OR. OPT.EQ.'WRI') THEN - IF (.NOT.NFLFL0(DFAR)) THEN - CALL WNCTXT(F_TP,'Error getting flag file/area') - ELSE - JS=NFLFLS(DFAR,FLH) - IF (FLHJ(FLH_FLFN_J).EQ.0) THEN - CALL WNCTXT(F_TP,'No flags to be saved') - ELSE IF (OPT.EQ.'UNL') THEN - JS=NFLFL5(DFAR) !SAVE FLAG AREA - ELSE - JS=NFLFL7(DFAR,-1,NODIN,SETS) !WRITE FLAG FILE - END IF - END IF - OPTION='QUIT' - GOTO 100 -C -C CLEAR GIDS DISPLAY -C - ELSE IF (OPT.EQ.'GCL') THEN - SEQS(1)=1 - SEQS(2)=MAX(1,NRMAP) - IF (.NOT.WNDPAR('MAP_SEQUENCES',SEQS,2*LB_J,J0, - 1 A_B(-A_OB),SEQS,2)) GOTO 200 !RETRY - IF (J0.EQ.0) GOTO 100 !Retry option - IF (J0.LT.0) THEN - SEQS(1)=1 - SEQS(2)=MXNSEQ - END IF - DO I=SEQS(1),SEQS(2) - I0=N_GDI_REMOVE(GID,I) !REMOVE SEQUENCE FROM GIDS - END DO - NRMAP=0 !CLEAR NUMBER OF MAPS - CALL WNCTXT(F_TP,'Sequence cleared') - DEFIMG=.TRUE. !Re-define for next map - OPTION='DATA' !New default option - GOTO 100 -C -C READY -C - END IF -C - 900 CONTINUE - RETURN !READY -C -C - END diff --git a/src/nplot/ngidch.for b/src/nplot/ngidch.for deleted file mode 100644 index f94d7a06e2f5172dd852dbf16b03b4b6f276bfa7..0000000000000000000000000000000000000000 --- a/src/nplot/ngidch.for +++ /dev/null @@ -1,172 +0,0 @@ -C+ NGIDCH.FOR -C CMV 930914 -C -C Revisions: -C CMV 930914 Created -C CMV 931123 Add option for corrected data -C CMV 931216 Revise for use with NSCSCF -C WNB 931221 Correct IAND use; format typo -C CMV 940203 Use call to NGICOV -C CMV 940622 Handle DO_BLANK here -C CMV 000828 Offset for X-index (cause problems with mosaic) -C - LOGICAL FUNCTION NGIDCH(IFRS,IPOL,MID,SID) -C -C Load data as a (HA,CHAN) map into the GIDS-display -C -C Result: -C -C NGIDCH_L = NGIDCH( IFRS_I(2):I, MID_C(*):I, SID_C(*):I) -C Load map in GIDS display using: -C IFRS(2) the two interferometers -C IPOL current polarisation -C MID,SID GIDS Headers -C -C Include files: -C - INCLUDE 'WNG_DEF' - INCLUDE 'CBITS_DEF' - INCLUDE 'STH_O_DEF' - INCLUDE 'NGI_DEF' -C -C Parameters: -C -C -C Arguments: -C - INTEGER IFRS(2) - INTEGER IPOL - CHARACTER MID*(*),SID*(*) !GIDS Header -C -C Function references: -C - INTEGER N_GDI_IMWRITE, N_GDI_GRWRITE, N_GDI_GRCLEAR -C - LOGICAL NSCSTG !READ SET HEADER - CHARACTER*32 WNTTSG !PRINT SET NAME - LOGICAL NGITRA !SHOW DATA - LOGICAL NGISFL !HANDLE FLAGS - LOGICAL NGICOV !CLEAR DATA AND OVERLAYS - LOGICAL NGICDT !READ AND CONVERT DATA -C -C Data declarations: -C - REAL RDAT(0:STHIFR-1,0:3) !DATA VALUE (ifr, pol) - INTEGER FLG(0:STHIFR-1,0:3) !FLAGS/WEIGHTS (ifr, pol) - INTEGER*2 IFRT(0:STHIFR-1) !IFR TABLE - LOGICAL HEAD !FLAG SET IN SCAN HEADER - INTEGER STHP !SET HEADER POINTER - REAL HACUR !CURRENT HOUR ANGLE - INTEGER XX,YY !ARRAY OFFSETS - INTEGER CCHAN !Current channel -C - BYTE STH(0:STH__L-1) !SET HEADER - INTEGER STHJ(0:STH__L/LB_J-1) - INTEGER*2 STHI(0:STH__L/LB_I-1) - REAL STHE(0:STH__L/LB_E-1) - EQUIVALENCE (STH,STHI,STHJ,STHE) -C -C- - NGIDCH=.TRUE. !ASSUME OK -C -C Clear map data and (some) flags -C - JS=NGICOV(IPOL,-1) !No current channel -C -C Loop over all sets and fill in the appropriate pixels -C -C We use a single loop and calculate the pixel based on the HA -C and the Channel number. This is not the most efficient (we access -C the array in a scattered fashion) but it works and can be changed -C later if delays are unacceptably large. -C -C Get the next header and channel number -C - CALL WNDSTR(FCAIN,SETS) !RESET SET SEARCH - DO WHILE (NSCSTG(FCAIN,SETS,STH,STHP,SETNAM)) - CCHAN=STHI(STH_CHAN_I) !CURRENT CHANNEL -C -C Check hour-angle increment -C - IF (STHE(STH_HAI_E).NE.HAINC) THEN - CALL WNCTXT(F_TP, - 1 'Error: Sector !AS has hour-angle increment !EAF12.7', - 1 WNTTSG(SETNAM,0),STHE(STH_HAI_E)) - GOTO 990 - END IF -C -C Loop through all scans in the sector -C - DO I=0,STHJ(STH_SCN_J)-1 !ALL SCANS - HACUR=STHE(STH_HAB_E)+I*STHE(STH_HAI_E) !HA OF SCAN - IF (HACUR.GE.HARAN(0) .AND. HACUR.LT.HARAN(1)) THEN !IN RANGE -C -C Read scan-header, corrected data and flags -C - IF (.NOT.NGICDT(I,STH,HEAD,IFRT,FLG,RDAT)) THEN !READ DATA - CALL WNCTXT(F_TP,'Error reading scan !UJ',I) - GOTO 990 - END IF -C -C Check if data present -C - DO I1=0,STHJ(STH_NIFR_J)-1 !SCAN ALL IFRS - IF (MOD(IFRT(I1),256).EQ.IFRS(1).AND. - 1 IFRT(I1)/256.EQ.IFRS(2)) THEN !Take this one - XX=(HACUR-HARAN(0))/HAINC+0.01 - YY=CCHAN-RCHAN(0) - IPTR=YY*XSIZ+XX - IF (IPTR.GE.LBUF) THEN - CALL WNCTXT(F_TP,'Out of range???') - IPTR=LBUF-1 - END IF -C - IF (IAND(FLG(I1,IPOL),'0000ffff'X) .NE.0) THEN !DATA PRESENT -C -C Scale data into buffer -C - IF (RDAT(I1,IPOL).LT.RANGE(1)) THEN - I5=MINCOL - ELSE IF (RDAT(I1,IPOL).GT.RANGE(2)) THEN - I5=MAXCOL - ELSE - I5=NINT(RDAT(I1,IPOL)*CSCALE+CZERO) - END IF - IF (I5.GT.127) I5=I5-256 !MAP 256 TO -1 - A_B(DMAP+IPTR)=I5 -C -C Set graphics plane 1 if data flagged, optionally blank data -C - IF (HEAD.OR. - 1 IAND('0000ff00'X,FLG(I1,IPOL)).NE.0) THEN - A_B(DFLG+IPTR)=1 - IF (DO_BLANK) A_B(DMAP+IPTR)=BLANK - ENDIF -C - END IF ! IF DATA PRESENT - END IF ! IF CORRECT IFR - END DO ! LOOP OVER IFRs - END IF ! IF IN HOUR-ANGLE RANGE - END DO ! LOOP OVER SCANS - END DO ! LOOP OVER SETS -C -C Write the data -C - IF (.NOT.NGITRA(MID,SID)) GOTO 990 -C -C If flagging required, enter regions mode and make flagfile -C - IF (DO_FLAG) JS=NGISFL(IPOL,IFRS(1)+256*IFRS(2),-1) !THIS IFR ONLY -C - - GOTO 800 -C -C ERRORS -C - 990 CONTINUE - NGIDCH=.FALSE. -C - 800 CONTINUE -C - RETURN - END diff --git a/src/nplot/ngidif.for b/src/nplot/ngidif.for deleted file mode 100644 index 6b864658cc4ed394a3e8bdb33b7e17dba722f542..0000000000000000000000000000000000000000 --- a/src/nplot/ngidif.for +++ /dev/null @@ -1,163 +0,0 @@ -C+ NGIDIF.FOR -C CMV 930913 -C -C Revisions: -C CMV 930913 Created -C CMV 931123 Add option for corrected data -C CMV 931216 Revise for use with NSCSCF -C WNB 931221 Correct IAND usage; format typo -C CMV 940203 Use call to NGICOV -C CMV 940622 Handle DO_BLANK here -C - LOGICAL FUNCTION NGIDIF(IPOL,CCHAN,MID,SID) -C -C Load data into the GIDS-display as an (HA,IFR) map -C -C Result: -C -C NGIDIF_L = NGIDIF(IPOL, CCHAN, MID_C(*):I, SID_C(*):I) -C Load map in GIDS display using: -C IPOL Current polarisation -C CCHAN Current channel -C MID,SID Header names -C Remaining parameters from NGI_DEF -C -C Include files: -C - INCLUDE 'WNG_DEF' - INCLUDE 'CBITS_DEF' - INCLUDE 'STH_O_DEF' - INCLUDE 'NGI_DEF' -C -C Parameters: -C -C -C Arguments: -C - INTEGER IPOL !Current polarisation - INTEGER CCHAN !Current channel - CHARACTER MID*(*),SID*(*) !GIDS Header -C -C Function references: -C - INTEGER N_GDI_IMWRITE, N_GDI_GRWRITE, N_GDI_GRCLEAR -C - LOGICAL NSCSTG !READ SET HEADER - CHARACTER*32 WNTTSG !PRINT SET NAME - LOGICAL NGITRA !SHOW DATA - LOGICAL NGISFL !HANDLE FLAGS - LOGICAL NGICOV !CLEAR DATA AND OVERLAYS - LOGICAL NGICDT !CONVERT AND SCALE DATA -C -C Data declarations: -C - REAL RDAT(0:STHIFR-1,0:3) !DATA VALUE (ifr, pol) - INTEGER FLG(0:STHIFR-1,0:3) !FLAGS/WEIGHTS (ifr, pol) - INTEGER*2 IFRT(0:STHIFR-1) !IFR TABLE - LOGICAL HEAD !FLAG SET IN SCAN HEADER - INTEGER STHP !SET HEADER POINTER - INTEGER HA0 !HOUR ANGLE OF FIRST SCAN IN SECTOR - INTEGER XX,YY !ARRAY OFFSETS -C - BYTE STH(0:STH__L-1) !SET HEADER - INTEGER STHJ(0:STH__L/LB_J-1) - INTEGER*2 STHI(0:STH__L/LB_I-1) - REAL STHE(0:STH__L/LB_E-1) - EQUIVALENCE (STH,STHI,STHJ,STHE) -C -C- - NGIDIF=.TRUE. !ASSUME OK -C -C Clear map data and (some) flags -C - JS=NGICOV(IPOL,CCHAN) -C -C Loop through all sectors with current channel -C - CALL WNDSTR(FCAIN,SETS) !RESET SET SEARCH - DO WHILE (NSCSTG(FCAIN,SETS,STH,STHP,SETNAM)) !FIND CHANNEL - IF (STHI(STH_CHAN_I).EQ.CCHAN) THEN -C -C Check hour-angle increment -C - IF (STHE(STH_HAI_E).NE.HAINC) THEN - CALL WNCTXT(F_TP, - 1 'Error: Set !AS has hour-angle increment !EAF12.7', - 1 WNTTSG(SETNAM,0),STHE(STH_HAI_E)) - GOTO 990 - END IF -C -C Loop through all scans in the sector -C - HA0=(STHE(STH_HAB_E)-HARAN(0)+HAINC/2.0)/HAINC - DO I=0,STHJ(STH_SCN_J)-1 !ALL SCANS - XX=HA0+I !HA OF SCAN - IF (XX.GE.0.AND.XX.LT.XSIZ) THEN !IN RANGE - -C -C Read scan-header, corrected data and flags -C - IF (.NOT.NGICDT(I,STH,HEAD,IFRT,FLG,RDAT)) THEN !READ DATA - CALL WNCTXT(F_TP,'Error reading scan !UJ',I) - GOTO 990 - END IF -C -C Loop over all interferometers for the requested polarisation (IPOL) -C - DO I1=0,STHJ(STH_NIFR_J)-1 !SCAN ALL IFRS - YY=IDXLUT(MOD(IFRT(I1),256),IFRT(I1)/256) - IPTR=YY*XSIZ+XX - IF (IPTR.GE.LBUF) THEN - CALL WNCTXT(F_TP,'Out of range???') - IPTR=LBUF-1 - END IF -C - IF (IAND(FLG(I1,IPOL),'0000ffff'X) .NE.0) THEN !DATA PRESENT -C -C Scale data into buffer -C - IF (RDAT(I1,IPOL).LT.RANGE(1)) THEN - I5=MINCOL - ELSE IF (RDAT(I1,IPOL).GT.RANGE(2)) THEN - I5=MAXCOL - ELSE - I5=NINT(RDAT(I1,IPOL)*CSCALE+CZERO) - END IF - IF (I5.GT.127) I5=I5-256 !MAP 256 TO -1 - A_B(DMAP+IPTR)=I5 -C -C Set graphics plane 1 if data flagged, optionally blank data -C - IF (HEAD.OR. - 1 IAND('0000ff00'X,FLG(I1,IPOL)).NE.0) THEN - A_B(DFLG+IPTR)=1 - IF (DO_BLANK) A_B(DMAP+IPTR)=BLANK - ENDIF -C - END IF ! IF DATA PRESENT - END DO ! LOOP OVER IFRS -C - END IF ! IF IN HOUR-ANGLE RANGE - END DO ! LOOP OVER SCANS - END IF - END DO ! LOOP OVER SECTORS -C -C Transfer map and flags to GIDS -C - IF (.NOT.NGITRA(MID,SID)) GOTO 990 -C -C If flagging required, enter regions mode and make flagfile -C - IF (DO_FLAG) JS=NGISFL(IPOL,-1,CCHAN) -C - GOTO 800 -C -C ERRORS -C - 990 CONTINUE - NGIDIF=.FALSE. -C - 800 CONTINUE -C - RETURN - END diff --git a/src/nplot/ngidlm.for b/src/nplot/ngidlm.for deleted file mode 100644 index 67ba3e8dcd114f211fa8cf160509732584e10112..0000000000000000000000000000000000000000 --- a/src/nplot/ngidlm.for +++ /dev/null @@ -1,178 +0,0 @@ -C+ NGIDLM.FOR -C WNB 930514 -C -C Revisions: -C WNB 930517 Blank data points outside range -C WNB 930602 Correct compression range -C CMV 940929 Correct rounding for odd axis length -C - LOGICAL FUNCTION NGIDLM(GID,FCAIN,MPHJ,COMPR,TAREA,TEAR, - 1 RANGE,MID,SID) -C -C Load a map into the GIDS-display -C -C Result: -C -C NGIDLM_L = NGIDLM( GID_J:I, FCAIN_J:I, MPHJ_J(0:*):I, -C COMPR_J:I, TAREA_J(0:3):I, TEAR_J(0:3):I, -C RANGE_E(2):I, MID_C*:I, SID_C*:I) -C Load map in GIDS display GID. Using: -C FCAIN file -C MPHJ map header -C COMPR compression factor (>=1) -C TAREA area -C TEAR edge-type area -C RANGE min/max value to be coded -C MID map id -C SID map sub-id -C -C -C Include files: -C - INCLUDE 'WNG_DEF' - INCLUDE 'MPH_O_DEF' -C -C Parameters: -C - INTEGER BUFSIZ !SIZE LINE BUFFER - PARAMETER (BUFSIZ=8192) -C -C Arguments: -C - INTEGER GID !GIDS DISPLAY ID - INTEGER FCAIN !INPUT FILE - INTEGER MPHJ(0:MPHHDL/4-1) !MAP HEADER - INTEGER COMPR !COMPRESSION FACTOR (>=1) - INTEGER TAREA(0:3) !AREA TO LOAD - INTEGER TEAR(0:3) !AREA IN EDGE-FORMAT - REAL RANGE(2) !RANGE OF DATA VALUES TO USE - CHARACTER*(*) MID !MAP ID - CHARACTER*(*) SID !MAP SUB-ID -C -C Function references: -C - INTEGER N_GDI_CINFO,N_GDI_DEFIMG,N_GDI_IMWRITE - INTEGER N_GDI_IMMID,N_GDI_IMSID - LOGICAL WNFRD !READ FILE - INTEGER WNCALN !LENGTH STRING -C -C Data declarations: -C - INTEGER LPTR !DATA POINTER - INTEGER MINCOL,MAXCOL,NCOL,BLANK !GIDS color-values - INTEGER GLO(2),GHI(2) ! GIDS image boundaries - REAL SCLFAC ! Color scale factor - REAL AVGFAC ! Compression factor - REAL BSCALE ! Scaling factor from - REAL BZERO ! display data to real data -C ! REAL = BSCALE*DISPLAY+BZERO - INTEGER LBUF,DX2 - INTEGER XX,XSIZ,YBEG,YY,YSIZ,YSIZMAX - REAL RBUF(BUFSIZ),DBUF(BUFSIZ) - BYTE BUF(BUFSIZ) -C -C- - NGIDLM=.TRUE. !ASSUME OK -C -C Obtain minimum and maximum color value. -C - E_C=N_GDI_CINFO(GID,MINCOL,MAXCOL,NCOL,BLANK) - IF (E_C.LT.0) GOTO 990 !ERROR -C -C Define the image-size for GIDS. -C - GLO(1)=TEAR(0)/COMPR - GLO(2)=TEAR(2)/COMPR - GHI(1)=GLO(1)+(TEAR(1)-TEAR(0)+1)/COMPR-1 - GHI(2)=GLO(2)+(TEAR(3)-TEAR(2)+1)/COMPR-1 -C -C Define the map size. -C - BSCALE=(RANGE(2)-RANGE(1))/NCOL !SCALE FACTOR - BZERO=RANGE(1)-(BSCALE*MINCOL) - E_C=N_GDI_DEFIMG(GID,GLO,GHI,BSCALE,BZERO) - IF (E_C.LT.0) GOTO 990 !ERROR -C -C Now load the map. -C First determine sizes and factors. -C - XSIZ=GHI(1)-GLO(1)+1 !NR MEMORY PIXELS/LINE - YSIZMAX=BUFSIZ/XSIZ !NR OF LINES PER BUFFER - AVGFAC=1./COMPR**2 !AVERAGING FACTOR - SCLFAC=NCOL/(RANGE(2)-RANGE(1)) !SCALE FACTOR -C -C Fill and load the buffer -C - in bunches of YSIZMAX memory lines -C - DX2=MPHJ(MPH_NRA_J)/2 - LPTR=MPHJ(MPH_MDP_J)+LB_E* - 1 (MPHJ(MPH_NDEC_J)*DX2+TEAR(2)*MPHJ(MPH_NRA_J)) !FIRST LINE TO READ - DO YBEG=GLO(2),GHI(2),YSIZMAX - LBUF=0 - YSIZ=MIN(YSIZMAX,GHI(2)-YBEG+1) !NR LINES TO BE LOADED -C -C For each memory line: -C - average the next band of map lines -C in boxes of COMPRESS*COMPRESS pixels -C - DO YY=1,YSIZ !DO ysiz MEMORY LINES - CALL WNGMVZ(LB_E*XSIZ,RBUF) !CLEAR COMPRESSION BUF - DO I2=1,COMPR !DO LINES IN COMPR BAND - IF (.NOT.WNFRD(FCAIN,LB_E*TAREA(2),DBUF, - 1 LPTR+LB_E*(TEAR(0)+DX2))) GOTO 990 - LPTR=LPTR+MPHJ(MPH_NRA_J)*LB_E !NEXT LINE - J1=1 !POINT TO FIRST PIXEL - DO XX=1,XSIZ !DO COMPRESSION BOXES - DO I1=1,COMPR !DO PIXELS IN BOX - RBUF(XX)=RBUF(XX)+AVGFAC*DBUF(J1) !ADD IN VALUE - J1=J1+1 !POINT TO NEXT PIXEL - END DO - END DO - END DO -C -C - truncate and scale the compressed -C data points, and pack them into -C the byte buffer -C - DO XX=1,XSIZ - IF (RBUF(XX).LT.RANGE(1)) THEN - I2=BLANK !!MINCOL - ELSE IF (RBUF(XX).GT.RANGE(2)) THEN - I2=BLANK !!MAXCOL - ELSE - I2=NINT(SCLFAC*(RBUF(XX)-RANGE(1))) + MINCOL - END IF - IF (I2.GT.127) I2=I2-256 !MAP 256 TO -1, ETC. - LBUF=LBUF+1 !TO HANDLE IT AS A BYTE - BUF(LBUF)=I2 - END DO - END DO -C -C Write the YSIZ memory lines -C - E_C=N_GDI_IMWRITE(GID,BUF,LBUF,0) - IF (E_C.LT.0) GOTO 990 - END DO -C -C Write the image identification -C (Max. 15 characters are possible). -C Take last part of filename. -C - I2=WNCALN(MID) - I1=MAX(1,I2-14) - I0=N_GDI_IMMID(GID,MID(I1:I2)) - I0=N_GDI_IMSID(GID,SID(:MIN(15,LEN(SID)))) -C - GOTO 800 -C -C ERRORS -C - 990 CONTINUE - NGIDLM=.FALSE. -C - 800 CONTINUE -C - RETURN -C -C - END diff --git a/src/nplot/ngidmp.for b/src/nplot/ngidmp.for deleted file mode 100644 index 8bfbd2911ef7c1aff9b73850e4533db5a7cb7e88..0000000000000000000000000000000000000000 --- a/src/nplot/ngidmp.for +++ /dev/null @@ -1,127 +0,0 @@ -C+ NGIDMP.FOR -C WNB 930514 -C -C Revisions: -C WNB 930517 Blank data points outside range -C WNB 930602 Correct compression range -C CMV 931029 Changed parameter list -C CMV 931220 Correct compression -C CMV 940120 Correct test on buffer size (was XSIZ*LB_E) -C CMV 940506 Increase buffer size -C CMV 940929 Correct rounding if odd number of pixels on axis -C - LOGICAL FUNCTION NGIDMP(MPHJ,MID,SID) -C -C Load a map into the GIDS-display -C -C Result: -C -C NGIDMP_L = NGIDMP( MPHJ_J(0:*):I, MID_C(*):I, SID_C(*):I ) -C Load map in GIDS display GID. Using: -C MPHJ map header -C MID,SID GIDS Headers -C -C Include files: -C - INCLUDE 'WNG_DEF' - INCLUDE 'MPH_O_DEF' - INCLUDE 'NGI_DEF' -C -C Parameters: -C - INTEGER BUFSIZ !SIZE LINE BUFFER - PARAMETER (BUFSIZ=2*8192) -C -C Arguments: -C - INTEGER MPHJ(0:MPHHDL/4-1) !MAP HEADER - CHARACTER MID*(*),SID*(*) !GIDS Header -C -C Function references: -C - INTEGER N_GDI_IMWRITE - LOGICAL WNFRD !READ FILE - INTEGER WNCALN !LENGTH STRING - LOGICAL NGITRA !SHOW DATA -C -C Data declarations: -C - INTEGER LPTR !DATA POINTER - INTEGER XX,YY,DX2 - REAL RBUF(BUFSIZ),DBUF(BUFSIZ) -C -C- - NGIDMP=.TRUE. !ASSUME OK -C - IPTR=0 !OFFSET IN BYTE BUFFER -C - DX2=MPHJ(MPH_NRA_J)/2 - LPTR=MPHJ(MPH_MDP_J)+LB_E* - 1 (MPHJ(MPH_NDEC_J)*DX2+TEAR(2)*MPHJ(MPH_NRA_J)) !FIRST LINE TO READ -C -C Some tests -C - IF (BUFSIZ.LT.XSIZ .OR. BUFSIZ.LT.TAREA(2)) THEN - CALL WNCTXT(F_TP,'Internal buffer too small...') - CALL WNGEX() - END IF -C -C Fill and load the buffer -C - DO YY=1,YSIZ -C -C For each memory line: -C average the next band of map lines -C in boxes of COMPRESS*COMPRESS pixels -C - CALL WNGMVZ(LB_E*XSIZ,RBUF) !CLEAR COMPRESSION BUF - DO I2=1,COMPR !DO LINES IN COMPR BAND - IF (.NOT.WNFRD(FCAIN,LB_E*TAREA(2),DBUF, - 1 LPTR+LB_E*(TEAR(0)+DX2))) GOTO 990 - LPTR=LPTR+MPHJ(MPH_NRA_J)*LB_E !NEXT LINE - J1=1 !POINT TO FIRST PIXEL - DO XX=1,XSIZ !DO COMPRESSION BOXES - DO I1=1,COMPR !DO PIXELS IN BOX - RBUF(XX)=RBUF(XX)+AVGFAC*DBUF(J1) !ADD IN VALUE - J1=J1+1 !POINT TO NEXT PIXEL - END DO - END DO - END DO -C -C truncate and scale the compressed data points, -C and pack them into the byte buffer -C - DO XX=1,XSIZ - IF (RBUF(XX).LT.RANGE(1)) THEN - I2=MINCOL - ELSE IF (RBUF(XX).GT.RANGE(2)) THEN - I2=MAXCOL - ELSE - I2=NINT(RBUF(XX)*CSCALE+CZERO) - END IF - IF (I2.GT.127) I2=I2-256 !MAP 256 TO -1, ETC. - IF (IPTR.GT.LBUF) THEN - CALL WNCTXT(F_TP,'Arghh, out of buffer') - END IF - A_B(DMAP+IPTR)=I2 - IPTR=IPTR+1 - END DO - END DO -C -C Write the plane -C - IF (.NOT.NGITRA(MID,SID)) GOTO 990 -C - GOTO 800 -C -C ERRORS -C - 990 CONTINUE - NGIDMP=.FALSE. -C - 800 CONTINUE -C - RETURN -C -C - END diff --git a/src/nplot/ngidop.for b/src/nplot/ngidop.for deleted file mode 100644 index b3d0b98c4f242d6b0ec0f9e7c4bcf30c0768eb54..0000000000000000000000000000000000000000 --- a/src/nplot/ngidop.for +++ /dev/null @@ -1,99 +0,0 @@ -C+ NGIDOP.FOR -C WNB 930514 -C -C Revisions: -C CMV 931112 Changed call to N_GDI_OPEN -C CMV 940218 More info if fails -C - LOGICAL FUNCTION NGIDOP(GID) -C -C Open/close GIDS -C -C Result: -C -C NGIDOP_L = NGIDOP( GID_J:O) will open GIDS and return the GID ID -C NGIDCL_L = NGIDCL( GID_J:I) will close the GIDS with ID GID -C -C Include files: -C - INCLUDE 'WNG_DEF' -C -C Parameters: -C -C -C Arguments: -C - INTEGER GID !DISPLAY ID -C -C Entry points: -C - LOGICAL NGIDCL !CLOSE GIDS DISPLAY -C -C Function references: -C - LOGICAL WNDDIS !GET DISPLAY - INTEGER WNCALN !STRING LENGTH - INTEGER N_GDI_OPEN !OPEN GIDS - INTEGER N_GDI_CLOSE !CLOSE GIDS -C -C Data declarations: -C - CHARACTER*24 DISP !DISPLAY - CHARACTER*128 CTMP !TEMP FOR PRINTING ERRORS - INTEGER FCAT !TEMP IN CASE OF ERRORS -C- -C -C NGIDOP -C - JS=WNDDIS(.TRUE.,DISP) !GET DISPLAY - GID=N_GDI_OPEN(DISP(:WNCALN(DISP))) !OPEN DISPLAY - IF (GID.LT.0) THEN - NGIDOP=.FALSE. - CALL WNCTXT(F_TP,'Error opening Gids display') -C - CALL WNGSEG('DISPLAY',CTMP) - I2=WNCALN(CTMP) - CALL WNCTXT(F_TP,'DISPLAY: !AS',CTMP(:I2)) -C - CALL WNGSEG(DISP,CTMP) - I1=WNCALN(DISP) - I2=WNCALN(CTMP) - CALL WNCTXT(F_TP,'GIDS file: !AS=!AS',DISP(:I1),CTMP(:I2)) - IF (CTMP.NE.' ') THEN - CALL WNGLUN(J1) - OPEN(UNIT=J1,FILE=CTMP(:I2),STATUS='OLD',ERR=11) - CALL WNCTXT(F_TP, - 1 'File exists, delete and try again...') - CLOSE(UNIT=J1,STATUS='DELETE',ERR=12) - GID=N_GDI_OPEN(DISP(:WNCALN(DISP))) !OPEN DISPLAY AGAIN - 12 CONTINUE - IF (GID.LT.0) THEN - CALL WNCTXT(F_TP,'Did not help, contact NFRA') - ELSE - CALL WNCTXT(F_TP,'Hurray, it worked fine now') - NGIDOP=.TRUE. - END IF - 11 CONTINUE - CALL WNGLUF(J1) - END IF - ELSE - NGIDOP=.TRUE. - END IF -C - RETURN -C -C NGIDCL -C - ENTRY NGIDCL(GID) -C - I=N_GDI_CLOSE(GID) - IF (I.LT.0) THEN - NGIDCL=.FALSE. - ELSE - NGIDCL=.TRUE. - END IF -C - RETURN -C -C - END diff --git a/src/nplot/ngidpt.for b/src/nplot/ngidpt.for deleted file mode 100644 index f536640cc4eb3a696fa9e983329d63c6b4937262..0000000000000000000000000000000000000000 --- a/src/nplot/ngidpt.for +++ /dev/null @@ -1,120 +0,0 @@ -C+ NGIDPT.FOR -C WNB 930514 -C -C Revisions: -C CMV 931220 Change call to N_GDI_PGPLOT -C -C - LOGICAL FUNCTION NGIDPT(GID,COMPR,TEAR,RB,RBUF,BUT) -C -C Get point from GIDS screen -C -C Result: -C NGIPNT_L = NGIPNT( GID_J:I, COMPR_J:I, TEAR_J(0:3), RB_E:(2):IO, -C RBUF_E(2):O, BUT_J:O) -C Give for GIDS display GID the position -C of the cursor if MB1 pressed in RBUF, and -C return .FALSE. after MB3. -C RB gives the screen coordinates, and will -C be filled if initially -1 with centre. -C COMPR gives a possible area compression. -C TEAR is the area displayed in edge-format -C BUT returns button pressed (or 0 if error) -C -C -C -C Include files: -C - INCLUDE 'WNG_DEF' -C -C Parameters: -C -C -C Arguments: -C - INTEGER GID !DISPLAY ID - INTEGER COMPR !COMPRESSION - INTEGER TEAR(0:3) !EDGE-FORMAT AREA DISPLAYED - REAL RB(2) !SCREEN X,Y - REAL RBUF(2) !RETURNED X,Y IN USER COORDINATES - INTEGER BUT !BUTTON PRESSED -C -C Function references: -C - INTEGER N_GDI_PGPLOT !GET DATA INFO - INTEGER N_GDI_FRAME !GET FRAME INFO - LOGICAL WNFRD !READ DISK -C -C Data declarations: -C - REAL RB1(4) !PGPLOT DATA - REAL GLO(2),GHI(2),GLH(4) !FRAME DATA - EQUIVALENCE (GLO,GLH),(GHI,GLH(3)) - CHARACTER*4 CBUF -C- -C -C INIT -C - NGIDPT=.TRUE. !ASSUME OK - I=N_GDI_PGPLOT(GID,6,RB1,4,LEN(CBUF),CBUF) !WINDOW - IF (I.LT.0) THEN !ERROR - E_C=I - GOTO 900 - END IF - IF (RB(1).EQ.-1. .OR. RB(2).EQ.-1.) THEN - RB(1)=RB1(2)/2+1 !POINT TO CENTRE - RB(2)=RB1(4)/2+1 - END IF -C -C GET DATA POINT FROM USER -C - 10 CONTINUE - I=N_GDI_FRAME(GID,GLO,GHI) !CURRENT FRAME AREA - IF (I.LT.0) THEN !ERROR - E_C=I - GOTO 900 - END IF - I=N_GDI_PGPLOT(GID,17,RB,2,LEN(CBUF),CBUF) !GET DATA POINT - IF (I.LT.0) THEN !ERROR - E_C=I - GOTO 900 - END IF - IF (CBUF(1:1).EQ.'1') THEN !MB1 - BUT=1 - ELSE IF (CBUF(1:1).EQ.'2') THEN - BUT=2 !MB2 - ELSE IF (CBUF(1:1).EQ.'3') THEN - BUT=3 !MB3 - E_C=0 !READY - GOTO 900 - ELSE - GOTO 10 !RETRY - END IF - IF (RB(1).LT.RB1(1) .OR. RB(1).GT.RB1(2) .OR. - 1 RB(2).LT.RB1(3) .OR. RB(2).GT.RB1(4)) GOTO 10 !OUT WINDOW - DO I=1,2 !CORRECT FOR CURRENT FRAME - RBUF(I)=(RB(I)/(RB1(2*I)+1.))* - 1 (GHI(I)-GLO(I))*(1.+1./(RB1(2*I)+1.))+ - 1 GLO(I) - END DO - DO I=1,2 - RBUF(I)=ANINT(COMPR*(RBUF(I))) !CORRECT FOR COMPRESS - END DO - DO I=1,2 - IF (RBUF(I).LT.TEAR(2*I-2) .OR. - 1 RBUF(I).GT.TEAR(2*I-1)) GOTO 10 !OUTSIDE AREA - END DO - GOTO 800 -C -C ERROR -C - 900 CONTINUE - NGIDPT=.FALSE. - BUT=0 !NO BUTTON PRESSED -C - 800 CONTINUE -C - RETURN -C -C - END diff --git a/src/nplot/ngids.fsc b/src/nplot/ngids.fsc deleted file mode 100644 index b0b147825ae752783ea107bfe5bef73c11eb48fd..0000000000000000000000000000000000000000 --- a/src/nplot/ngids.fsc +++ /dev/null @@ -1,70 +0,0 @@ -C+ NGIDS.FSC -C GvD 920525 -C -C Revisions: -C HjV 920723 Replace DWARF-routines by Newstar-routines -C WNB 930329 Make FSC -C WNB 930330 Make Gipsy dependent -C WNB 930510 Major rewrite -C WNB 930621 Remove area option; add FLAG, SAVE, CLEAR, WRITE -C CMV 930830 Added option DATA and RAW, renamed LOAD to MAP -C CMV 940203 Uncommented "no Gipsy" error -C CMV 960122 Warning if /NORUN ignored -C - SUBROUTINE NGIDS -C -C Main routine load maps into Groningen Image Display System -C -C Result: -C -C -C Include files: -C - INCLUDE 'WNG_DEF' - INCLUDE 'NGI_DEF' -C -C Parameters: -C -C -C Arguments: -C -C -C Function references: -C - LOGICAL WNDRUN - LOGICAL NGILOD !Load maps for GIDS -C -C Data declarations: -C - LOGICAL FIRST !FIRST INDICATOR -C- -C -C Preliminaries -C - CALL NGIINI !INIT PROGRAM - IF (.NOT.WNDRUN()) - 1 CALL WNCTXT(F_TP,'Ignored option /NORUN') - SETS(0,0)=0 !NO SETS DEFINED - FIRST=.TRUE. !FIRST RUN -C -C GET OPTIONS -C -#ifndef wn_gipsy__ - CALL WNCTXT(F_TP,'!/NGIDS cannot be run on this machine!/') -#else - 10 CONTINUE - CALL NGIDAT(FIRST) !GET OPTIONS - IF (OPT.EQ.'MAP'.OR.OPT.EQ.'DAT'.OR.OPT.EQ.'RAW') THEN !LOAD - JS=NGILOD() !LOAD MAPS - ELSE IF (OPT.EQ.'POI') THEN - CALL NGIPNT(0) !GET MAP INFO - ELSE IF (OPT.EQ.'FLA') THEN - CALL NGIPNT(1) !GET FLAG INFO - END IF - IF (OPT.NE.'QUI') GOTO 10 !MORE -#endif -C - RETURN !READY -C -C - END diff --git a/src/nplot/ngids.psc b/src/nplot/ngids.psc deleted file mode 100644 index 1760498e2e5d24abd0d907d58f44dfd0eff408df..0000000000000000000000000000000000000000 --- a/src/nplot/ngids.psc +++ /dev/null @@ -1,361 +0,0 @@ -!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ -!.Ident: NGIDS.PSC -!.Keywords: GIDS Image Display -!.Author: Ger van Diepen (NFRA, Dwingeloo) -!.Language: DWARF-Fortran -!.Environment: UNIX -!.Comments: -!.Version: GvD 920610 Created -!. WNB 921211 Add INCLUDE -!. HjV 930215 Add OPTION -!. WNB 930325 Change some text; make PSC -!. WNB 930330 Add DISPLAY -!. WNB 930427 Change host into xhost -!. WNB 930510 Delete DISPLAY, WINDOW, add options -!. WNB 930514 Use MB2 -!. HjV 930518 Change some keywords -!. WNB 930621 Add CLEAR, SAVE ,FLAG option; remove AREA option -!. WNB 930622 Change some option names -!. JEN 930723 Improve on-line HELP texts -!. CMV 930914 Add keywords for DATA option -!. CMV 931220 Improved some help texts -!. CMV 940103 Added ALL_POL keyword, changed text for -!. SAVE and UNLOAD. -!. CMV 940218 Added BLANK_FLAGS keyword -!. CMV 940817 Add CLIPFLAG option -! JPH 941205 Help texts, prompt formatting -! JPH 950215 Typo -!------------------------------------------------------------------------- -!+ -!! Terminology: Image already in use for maps. Picture? -!! Plane? -! Get overall action -! Ref: NGIDAT -! -KEYWORD=OPTION - DATA_TYP=C - IO=I - LENGTH=24 - CHECKS=ABBREV_OPTIONS - SWITCHES=LOOP,NULL_VALUES,WILD_CARDS - SEARCH=L,P - PROMPT="action" - OPTIONS=- -MAP,DATA; DOFLAG,CLIPFLAG, FLAG; UNLOAD,WRITE, CLEAR;| - -GCLEAR,NOFLAG,QUIT; POINT - HELP=" -!! POINT?? -Specify the action to perform. -. - Loading/unloading visibility data or images for half-tone/colour display. The - visibility 'planes' or images that you select are stored in display memory - for rapid access. The number of pictures that you can store is limited by the - availablity of this memory. -!! Correct? -. - MAP Load images(s) from map (.WMP) files. - DATA Load (corrected) data from visibility (.SCN) files -. - Select mode for flagging of visibility data on the display. The flags you set - will not yet be written back to the .SCN file, so you can freely experiment. -. - DOFLAG Switch to Flagging mode for .SCN-file visibilities - CLIPFLAG Switch to Flagging mode using cliplevels - FLAG Flagging in .WMP maps using the PGPLOT cursor in GIDS -. -!! In this mode, no maps will be stored in GIDS (this allows you to flag in a -!! lot of channels etc in a single command, without overloading the GIDS -!! memory). In normal display mode, consequtive images will be stored in GIDS -!! for playback (this sequence is reset with the GCLEAR command). -!! Is this relevant? -. - Saving the flags you set on your display: -. - UNLOAD Save flags list in a .FLF (binary file), from which you can - then transfer to the .SCN file through NFLAG LOAD. - WRITE Save flags list in an ASCII file, which you may manually - edit before transferringt it to the .SCN file through NFLAG - READ. - CLEAR Clear flags list. -! {\em see -! \textref{NFLAG OPS_FLIST}{nflag_private_keys.ops.flist} -! parameter }\ -. - Terminate current action sequence: -. - GCLEAR Remove a sequence of loaded pictures. - NOFLAG Switch back to normal display mode. - QUIT Leave NGIDS (the GIDS window will remain on the screen)." -! -! Get compression factor -! Ref: NGIDAT -! -KEYWORD=MAP_COMPRESS - DATA_TYPE=J - SWITCHES=LOOP,NULL_VALUES,WILD_CARD - CHECKS=MINIMUM - MINIMUM=1 - DEFAULTS=1 - SEARCH=L,P - PROMPT="display-size compression factor" - HELP=" -For a value N, the points in a N*N box are averaged into a single display -point. . Example: - A 1024*1024 map loaded with N=2 will result in a 512*512 image." -! -! Get output display range -! Ref: NGIDAT -! -KEYWORD=MAP_RANGE - DATA_TYPE=R - NVALUES=2 - SWITCHES=VECTOR - CHECKS=ASCENDING - SEARCH=L,P - PROMPT="Data-value range for diaplay" - HELP=" -Data values outside the limuts will be truncated to the coresponding limit. -. -By choosing suitable limits you can concentrate the display on a particular -range of intensities in the map. The defaults shown are the extremes in the -image to be displayed. -" -! -! Get type of DATA plot -! Ref: NGIDAT -! -KEYWORD=PLOT_TYPE - DATA_TYP=C - IO=I - LENGTH=16 - CHECKS=ABBREV_OPTIONS - SWITCHES=LOOP,NULL_VALUES,WILD_CARDS - SEARCH=L,P - OPTIONS=IFRS,BASE,CHAN -! PROMPT="(action)" - HELP=" -In displaying visibilities, you can choose between three two-dimensional cross -sections: -. - IFRS Hour angle (horizontal) versus interferometer (vertical), one picture - per frequency channel. Interferometers in the order - .... -. - BASE As IFRS, but interferometers in order of increasing baseline, - and of - increasing East telecope number within sets of redundant baselines. -. - CHAN Hour angle (horizontal) versus frequency channel (vertical), one - picture per interferometer. -. -NOTE: - You select the channels to be displayed through the SCN_SETS parameter, -in the form <grp>.<obs>.<fld>.<CHN>. You have the liberty to select SCN_SETS -with channels for more than one <grp>.<obs>.<fld>. You may think of some good -use of this option (e.g. displaying the same channel for all fields in a -mosaic). -" -! -! Get data types to plot -! Ref: NGIDAT -! -KEYWORD=DATA_TYPE - DATA_TYP=C - LENGTH=16 - NVALUES=1 - SWITCH=LOOP,NULL_VALUES,WILD_CARD - CHECKS=ABBREV_OPTIONS - SEARCH=L,P - OPTIONS=AMPLITUDE,PHASE, COSINE,SINE - DEFAULT=AMPLITUDE - PROMPT="Select visibility component to display" - HELP=" -Specify how to display complex visibility values" -! -! Get delete map range -! Ref: NGIDAT -! -KEYWORD=MAP_SEQUENCES - DATA_TYPE=J - NVALUES=2 - SWITCHES=VECTOR,WILD_CARD,NULL_VALUES,LOOP - CHECKS=NON_DESCENDING,MINIMUM - MINIMUM=1,1 - SEARCH=L,P - PROMPT="Display-plane range to delete" - HELP=" -The display planes are numbered sequentially in the order in which they were -loaded. You may specify here the first and last value for a range of planes -that will be removed from the GIDS display memory. -" -! -! Ask wether flagged data should be blanked -! Ref: NGIDAT -! -KEYWORD=BLANK_FLAGS - DATA_TYP=L - IO=I - NVALUES=1 - SWITCHES=NULL_VALUES,WILD_CARDS - SEARCH=L,P - PROMPT="Blank flagged data-points (Yes/No)?" - HELP=" -If you answer YES to this prompt, data points that are flagged will be set to -blank in the GIDS window. -. -A single red overlay plane is used to display flagged data points. This plane -will contain the flags for the last plane loaded. The BLANK_FLAGS option allows -you to discern flagged data in other pictures. -" -! -! Get output file -! Ref: NFLFL5 -! -KEYWORD=OUTPUT_FILE - DATA_TYP=C - IO=I - LENGTH=80 - SWITCHES=LOOP,NULL_VALUES,WILD_CARDS - SEARCH=L,P - PROMPT="(output filename)" - HELP=" Specify the full name for the output disk-file." -! -! Ask wether channels should be wildcarded -! Ref: NGIDAT -! -KEYWORD=ALL_CHAN - DATA_TYP=L - IO=I - NVALUES=1 - SWITCHES=NULL_VALUES,WILD_CARDS - SEARCH=L,P - PROMPT="Propagate flag changes to all channels (Yes/No)?" - HELP=" -If you answer Yes to this prompt, each flag will be set for all channels. That -is: If you set a flag in channel <i> it will be copied (in the flag list) to -the corresponding points in all other frequency channels." -! -! Ask wether polarisations should be wildcarded -! Ref: NGIDAT -! -KEYWORD=ALL_POLS - DATA_TYP=L - IO=I - NVALUES=1 - SWITCHES=NULL_VALUES,WILD_CARDS - SEARCH=L,P - PROMPT="Propagate flag changes to all polarisations (Yes/No)?" - HELP=" -If you answer Yes to this prompt, each flag will be set for all polarisations. -That is: if you set a flag on an XX visibility it will be copied (in the flag -list) to the corresponding XY, YX and YY visibilities. -" -!! What if you Clear a flag? -! -! Get user specified flag to use -! Ref: NGIDAT -! -KEYWORD=USER_FLAG - DATA_TYP=C - IO=I - LENGTH=16 - NVALUES=16 - CHECKS=ABBREV_OPTIONS - SWITCHES=NULL_VALUES,WILD_CARDS - SEARCH=L,P - OPTIONS=NONE,ALL; MAN,OLD,CLIP,NOISE,ADD,SHAD, U1,U2,U3 - PROMPT="Flags to use" - HELP=" -Each of the flagging modes (parameter OPTION, options FLAG, DOFLAG, CLIPFLAG) -uses a specific flag type by default. You may define here one ore more flags to -use instead. The use foreseen for this option is to experiment using one of -'user' flags without getting the experimental settings tangled up with settings -already in existence. -! {\em see parameter \textref{OPTION}{.option} } -. - NONE revert to default types per flagging mode - ALL or * use all flag types (not a very sensible idea) -. - MAN use the flag type for the MANUAL class of operations - CLIP use the flag type for the CLIP class of operations - NOISE use the flag type for the NOISE class of operations - SHAD use the flag type for the SHADOW class of operations - ADD use the flag type for the ADDITIVE class of operations -. - U1 use a separate flag for some user-defined operations - U2 use a separate flag for some user-defined operations - U3 use a separate flag for some user-defined operations -" -! -! Get area -! Ref: NGIDAT -! -KEYWORD=AREA - DATA_TYP=J - IO=I - NVALUES=4 - SWITCHES=LOOP,VECTOR,NULL_VALUES,WILD_CARD - SEARCH=L,P - PROMPT=" Display area (l,m, dl,dm)" - HELP=" -Specify the map area to be displayed. The coordinates are in grid units. (0,0) -is the map centre increase is toward the upper right (decreasing RA, incrasing -DEC). The area is defined by four values: -. - l,m area centre - dl,dm area size -" -! -! Get output file -! Ref: NFLFL5 -! -KEYWORD=NEXT - DATA_TYP=C - IO=I - LENGTH=5 - CHECKS=ABBREV_OPTIONS - SWITCHES=LOOP,NULL_VALUES,WILD_CARDS - SEARCH=L,P - OPTIONS=YES,NO, ALL - DEFAULT=ALL - PROMPT="Load next picture" - HELP=" -This prompt appears after the loading of a picture. NGIDS will wait for your -reply while you may manipulate the GIDS display. Your reply options are: -. - YES Load next picture, then return with this prompt - NO Quit loading, return to OPTION prompt - ALL Load all remaining pictures without intervening consultations -" -! -! Get cliplevel -! Ref: NGIDAT -! -KEYWORD=CLIP_LEVEL - DATA_TYP=R - IO=I - NVALUES=1 - SWITCHES=LOOP,NULL_VALUES,WILD_CARD - SEARCH=L,P - PROMPT="Clip limit for flagging" - HELP=" -All visibilities that exceed the limit in the quantity displayed (cf. parameter -DATA_TYPE) will be flagged. Select a suitable level by consulting the display. -The colour bar to the left is annotated with values and you the pixel value -pointed at by the cursor is shown in the upper left corner. -! {\em see parameter \textref{DATA_TYPE}{.data.type} } -" -!- -! -! NMODEL_PEF is included for model subtraction -! -INCLUDE=NMODEL_PEF -! -INCLUDE=NGEN_PEF -!- -INCLUDE=SCNNODE_PEF ! -INCLUDE=SCNSETS_PEF ! -INCLUDE=SELECT_PEF -!- -INCLUDE=WMPNODE_PEF ! -INCLUDE=WMPSETS_PEF -!- diff --git a/src/nplot/ngigdi.cun b/src/nplot/ngigdi.cun deleted file mode 100644 index a5a06a29f00f0ce19518dcc0fff44059d35db89f..0000000000000000000000000000000000000000 --- a/src/nplot/ngigdi.cun +++ /dev/null @@ -1,1451 +0,0 @@ -/* ngigdi.cun -. HjV 930203 -. -. Revisions: -. WNB 930331 Changed name -. WNB 930510 IINFO, GDSID, IMMID, IMSID, OPEN, MHEAD, SETID error -. WNB 930510 Add PGPLOT, FRAME -. CMV 930913 Corrected several parameter lists -. CMV 931004 Added setxgrid, setygrid -. CMV 931108 Changed calls to gdi_*_c -. CMV 931112 Proper interface for characters (fchar) -. CMV 931220 Changed call to n_gdi_pgplot -. HjV 960729 Add test for Solaris (wn_so__) -. Test should be before wn_sw__ -test because for -. Solaris that switch is also set -... */ -/* -. Description: -. Dummy interface for GIPSY routines used by NGIDS -. The available routines are: -. -. GDI_OPEN Opens a display. -. GDI_CLOSE Closes an opened display device. -. GDI_CINFO Obtains info about the color tables of the display. -. GDI_GINFO Obtains info about the graphics planes. -. GDI_RINFO Obtains info about the number of recorded images. -. GDI_IINFO Obtains info about GDS image loaded in DISPLAY SERVER. -. GDI_GRCOL Sets the color for a graphics plane. -. GDI_GRON Turns graphics planes on. -. GDI_GROFF Turns graphics planes off. -. GDI_GRCLEAR Clears graphics planes. -. GDI_GRREGION Lets user define a region in graphics planes. -. GDI_RECORD Records the images currently on the display -. GDI_REMOVE Remove a recorded image. -. GDI_RMASK Obtain mask of recorded images. -. GDI_SEQUENCE Set playback sequence for recorded images. -. GDI_COLPUT Sends a color Look Up Table to the display. -. GDI_COLGET Obtains color Look Up Table from the display. -. GDI_DEFIMG Defines the sizes and scaling of a display image. -. GDI_MHEAD Creates an image header from a GDS set for -. the display. -. GDI_IMWRITE Sends display data to server. -. GDI_GRREAD Gets the graphics data. -. GDI_GRWRITE Puts the graphics data. -. GDI_IMMID Main identification of image. -. GDI_IMSID Sub identification of image. -. GDI_SETID Constitutes a main and sub id from a subset for the -. display device. -. GDI_SETXGRID Set text for X grid coordinates -. GDI_SETYGRID Set text for Y grid coordinates -. GDI_GDSID Sends GDS database name and subset level -. to DISPLAY SERVER. -. GDI_PGPLOT Use PGPLOT on GDS -. GDI_FRAME Get current frame parameters -. -. NOTE on calling with character strings: -. -. Characters are passed to C as a pointer to the character -. string followed by an integer (not a pointer) which is -. the length of the string. If the Fortran call has an -. integer behind the character, the length will be suppressed. -. -. In this interface, we assume that the string is passed -. without an explicit length argument, so use -. -. N_GDI_OPEN(GID,DISP(:WNCALN(DISP)) -. -. in stead of -. -. N_GDI_OPEN(GID,DISP,WNCALN(DISP)) -. -. The sequence of arguments for n_gdi_setxgrid and _setygrid -. has been changed in the call to the interface (for this same -. reason). -. -. -/* -. Include files: -... */ - - -#ifdef wn_hp__ -typedef long fint; -typedef struct { char *a; fint l; } fchar; -#else -typedef long fint; -typedef struct { char *a; fint l; } fchar; -#endif -#ifdef wn_li__ -/* Fake errno for old gdilib. Will of course cause some problems... CMV20031229*/ -int errno=0; -#endif - -/* -. Function: N_GDI_OPEN -... */ - n_gdi_open_(display,len) -/* -. Arguments: -... - */ - char *display; /* display device */ - fint len; -{ -/* -. Use: INTEGER N_GDI_OPEN( DISPLAY ) Input CHARACTER*(*) -. -. GDI_OPEN Returns on success a non-negative display -. identifier for further use. Negative -. values indicate an error condition. -. DISPLAY Name of display device. If DISPLAY -. is not present or empty, the default -. display (DEFAULT_DISPLAY) will be used. -... */ -/* -. Include files: -... -*/ -/* -. Parameters: -... */ -/* -. Function references: -... */ -/* -. Data declarations: -... */ -/*- */ -#ifdef wn_so__ - fchar c; - c.l=len; - c.a=display; - return (gdi_open_c(c)); -#else -#ifdef wn_sw__ - return (gdi_open_c(display,len)); -#else - fchar c; - c.l=len; - c.a=display; - return (gdi_open_c(c)); -#endif -#endif -} - -/* -. Function: N_GDI_CLOSE -... */ - n_gdi_close_(gdi_id) -/* -. Arguments: -... */ - int *gdi_id; /* display id */ -{ -/* -. Use: INTEGER N_GDI_CLOSE( GDI_ID ) Input INTEGER -. -. GDI_CLOSE Returns zero if successful, otherwize a -. negative value is returned. -. GDI_ID Display id as returned by GDI_OPEN. -. -... */ -/* -. Include files: -... */ -/* -. Parameters: -... */ -/* -. Function references: -... */ -/* -. Data declarations: -... */ -/*- */ - return (gdi_close_c(gdi_id)); -} - -/* -. Function: N_GDI_CINFO -... */ - n_gdi_cinfo_(gdi_id,mincol,maxcol,ncolors,blank) -/* -. Arguments: -... */ - int *gdi_id; /* display id */ - int *mincol; /* min. display value */ - int *maxcol; /* max. display value */ - int *ncolors; /* nr. of colors */ - int *blank; -{ -/* -. Use: INTEGER GDI_CINFO( GDI_ID, Input INTEGER -. MINCOL, Output INTEGER -. MAXCOL, Output INTEGER -. NCOLORS, Output INTEGER -. BLANK ) Output INTEGER -. -. GDI_CINFO Returns zero on success, negative on error. -. GDI_ID Display id as returned by GDI_OPEN. -. MINCOL Minimum display value for which a -. color can be assigned. -. MAXCOL Maximum display value for which a -. color can be assigned. -. NCOLORS Number of colors (MAXCOL - MINCOL + 1). -. BLANK Display value reserved for undefined -. data. -. -... */ -/* -. Include files: -... */ -/* -. Parameters: -... */ -/* -. Function references: -... */ -/* -. Data declarations: -... */ -/*- */ - return (gdi_cinfo_c(gdi_id,mincol,maxcol,ncolors,blank)); -} - -/* -. Function: N_GDI_GINFO -... */ - n_gdi_ginfo_(gdi_id,nplanes,pmask) -/* -. Arguments: -... */ - int *gdi_id; /* display id */ - int *nplanes; /* nr. planes available */ - int *pmask; /* mask which planes on */ -{ -/* -. Use: INTEGER GDI_GINFO( GDI_ID , Input INTEGER -. NPLANES , Output INTEGER -. PMASK ) Output INTEGER -. -. GDI_GINFO Returns zero on succes, negative on error. -. GDI_ID Display id as returned by GDI_OPEN. -. NPLANES Number of graphics planes available. -. PMASK Mask which specifies which planes are on. -. -... */ -/* -. Include files: -... */ -/* -. Parameters: -... */ -/* -. Function references: -... */ -/* -. Data declarations: -... */ -/*- */ - return (gdi_ginfo_c(gdi_id,nplanes,pmask)); -} - -/* -. Function: N_GDI_RINFO -... */ - n_gdi_rinfo_(gdi_id,nrecord,mrecord) -/* -. Arguments: -... */ - int *gdi_id; /* display id */ - int *nrecord; /* nr. recorded image */ - int *mrecord; /* max. recorded image */ -{ -/* -. Use: INTEGER GDI_RINFO( GDI_ID , Input INTEGER -. NRECORD , Output INTEGER -. MRECORD ) Output INTEGER -. -. GDI_RINFO Returns zero on succes, negative on error. -. GDI_ID Display id as returned by GDI_OPEN. -. NRECORD Number of recorded images. -. MRECORD Maximum number of recorded images. -. -... */ -/* -. Include files: -... */ -/* -. Parameters: -... */ -/* -. Function references: -... */ -/* -. Data declarations: -... */ -/*- */ - return (gdi_rinfo_c(gdi_id,nrecord,mrecord)); -} - -/* -. Function: N_GDI_GRCOL -... */ - n_gdi_grcol_(gdi_id,plane,red,green,blue) -/* -. Arguments: -... */ - int *gdi_id; /* display id */ - int *plane; /* plane nr. */ - float *red; /* red color intensity */ - float *green; /* green color intens. */ - float *blue; /* blue color intensity */ -{ -/* -. Use: INTEGER GDI_GRCOL( GDI_ID , Input INTEGER -. PLANE, Input INTEGER -. RED , Input REAL -. GREEN , Input REAL -. BLUE ) Input REAL -. -. GDI_GRCOL Returns zero on succes, negative on error. -. GDI_ID Display id as returned by GDI_OPEN. -. PLANE Plane number (1, 2, 4, etc. ). -. RED Red color intensity (0.0 .. 1.0). -. GREEN Green color intensity (0.0 .. 1.0). -. BLUE Blue color intensity (0.0 .. 1.0 ). -. -... */ -/* -. Include files: -... */ -/* -. Parameters: -... */ -/* -. Function references: -... */ -/* -. Data declarations: -... */ -/*- */ - return (gdi_grcol_c(gdi_id,plane,red,green,blue)); -} - -/* -. Function: N_GDI_GRON -... */ - n_gdi_gron_(gdi_id,pmask) -/* -. Arguments: -... */ - int *gdi_id; /* display id */ - int *pmask; /* turn which planes on */ -{ -/* -. Use: INTEGER GDI_GRON( GDI_ID , Input INTEGER -. PMASK ) Input INTEGER -. -. GDI_GRON Returns zero on succes, negative on error. -. GDI_ID Display id as returned by GDI_OPEN. -. PMASK Mask which specifies which planes should be -. turned on. -. -... */ -/* -. Include files: -... */ -/* -. Parameters: -... */ -/* -. Function references: -... */ -/* -. Data declarations: -... */ -/*- */ - return (gdi_gron_c(gdi_id,pmask)); -} - -/* -. Function: N_GDI_GROFF -... */ - n_gdi_groff_(gdi_id,pmask) -/* -. Arguments: -... */ - int *gdi_id; /* display id */ - int *pmask; /* turn which planes off*/ -{ -/* -. Use: INTEGER GDI_GROFF( GDI_ID , Input INTEGER -. PMASK ) Input INTEGER -. -. GDI_GROFF Returns zero on succes, negative on error. -. GDI_ID Display id as returned by GDI_OPEN. -. PMASK Mask which specifies which planes should be -. turned off. -. -... */ -/* -. Include files: -... */ -/* -. Parameters: -... */ -/* -. Function references: -... */ -/* -. Data declarations: -... */ -/*- */ - return (gdi_groff_c(gdi_id,pmask)); -} - -/* -. Function: N_GDI_GRCLEAR -... */ - n_gdi_grclear_(gdi_id,pmask) -/* -. Arguments: -... */ - int *gdi_id; /* display id */ - int *pmask; /* clear which planes */ -{ -/* -. Use: INTEGER GDI_GRCLEAR( GDI_ID , Input INTEGER -. PMASK ) Input INTEGER -. -. GDI_GRCLEAR Returns zero on succes, negative on error. -. GDI_ID Display id as returned by GDI_OPEN. -. PMASK Mask which specifies which planes should be -. cleared. -. -... */ -/* -. Include files: -... */ -/* -. Parameters: -... */ -/* -. Function references: -... */ -/* -. Data declarations: -... */ -/*- */ - return (gdi_grclear_c(gdi_id,pmask)); -} - -/* -. Function: N_GDI_GRREGION -... */ - n_gdi_grregion_(gdi_id,plane) -/* -. Arguments: -... */ - int *gdi_id; /* display id */ - int *plane; /* plane nr. */ -{ -/* -. Use: INTEGER GDI_GRREGION( GDI_ID , Input INTEGER -. PLANE ) Input INTEGER -. -. GDI_GRREGION Returns zero on succes, negative on error. -. GDI_ID Display id as returned by GDI_OPEN. -. PLANE Graphics plane. -. -... */ -/* -. Include files: -... */ -/* -. Parameters: -... */ -/* -. Function references: -... */ -/* -. Data declarations: -... */ -/*- */ - return (gdi_grregion_c(gdi_id,plane)); -} - -/* -. Function: N_GDI_RECORD -... */ - n_gdi_record_(gdi_id,record) -/* -. Arguments: -... */ - int *gdi_id; /* display id */ - int *record; /* record nr. */ -{ -/* -. Use: INTEGER GDI_RECORD( GDI_ID , Input INTEGER -. RECORD ) Input INTEGER -. -. GDI_RECORD Returns zero on succes, negative on error. -. GDI_ID Display id as returned by GDI_OPEN. -. RECORD record number (0 to .....). -. -... */ -/* -. Include files: -... */ -/* -. Parameters: -... */ -/* -. Function references: -... */ -/* -. Data declarations: -... */ -/*- */ - return (gdi_record_c(gdi_id,record)); -} - -/* -. Function: N_GDI_REMOVE -... */ - n_gdi_remove_(gdi_id,record) -/* -. Arguments: -... */ - int *gdi_id; /* display id */ - int *record; /* record nr. to remove */ -{ -/* -. Use: INTEGER GDI_REMOVE( GDI_ID , Input INTEGER -. RECORD ) Input INTEGER -. -. GDI_REMOVE Returns zero on succes, negative on error. -. GDI_ID Display id as returned by GDI_OPEN. -. RECORD Record number (0 to .....) of image to be -. removed. -. -... */ -/* -. Include files: -... */ -/* -. Parameters: -... */ -/* -. Function references: -... */ -/* -. Data declarations: -... */ -/*- */ - return (gdi_remove_c(gdi_id,record)); -} - -/* -. Function: N_GDI_RMASK -... */ - n_gdi_rmask_(gdi_id,records,nrecords) -/* -. Arguments: -... */ - int *gdi_id; /* display id */ - int *records; /* image present ?? */ - int *nrecords; /* size of RECORDS */ -{ -/* -. Use: INTEGER GDI_RMASK( GDI_ID , Input INTEGER -. RECORDS , Output INTEGER -. NRECORDS ) Input INTEGER -. -. GDI_RMASK Returns zero on succes, negative on error. -. GDI_ID Display id as returned by GDI_OPEN. -. RECORDS Contains one if recorded image is present, -. zero if not. -. NRECORDS Size of RECORDS. -. -... */ -/* -. Include files: -... */ -/* -. Parameters: -... */ -/* -. Function references: -... */ -/* -. Data declarations: -... */ -/*- */ - return (gdi_rmask_c(gdi_id,records,nrecords)); -} - -/* -. Function: N_GDI_SEQUENCE -... */ - n_gdi_sequence_(gdi_id,records,nrecords) -/* -. Arguments: -... */ - int *gdi_id; /* display id */ - int *records; /* sequence of image */ - int *nrecords; /* size of RECORDS */ -{ -/* -. Use: INTEGER GDI_SEQUENCE( GDI_ID , Input INTEGER -. RECORDS , Output INTEGER -. NRECORDS ) Input INTEGER -. -. GDI_RMASK Returns zero on succes, negative on error. -. GDI_ID Display id as returned by GDI_OPEN. -. RECORDS Containse sequence of recorded images. -. NRECORDS Size of RECORDS. -. -... */ -/* -. Include files: -... */ -/* -. Parameters: -... */ -/* -. Function references: -... */ -/* -. Data declarations: -... */ -/*- */ - return (gdi_sequence_c(gdi_id,records,nrecords)); -} - -/* -. Function: N_GDI_COLPUT -... */ - n_gdi_colput_(gdi_id,values,red,green,blue,ncolors) -/* -. Arguments: -... */ - int *gdi_id; /* display id */ - int *values; /* display values */ - float *red; /* red color intensity */ - float *green; /* green color intens. */ - float *blue; /* blue color intensity */ - int *ncolors; /* nr. of colors */ -{ -/* -. Use: INTEGER GDI_COLPUT( GDI_ID, Input INTEGER -. VALUES, Input INTEGER ARRAY -. RED, Input REAL ARRAY -. GREEN, Input REAL ARRAY -. BLUE, Input REAL ARRAY -. NCOLORS ) Input INTEGER -. -. GDI_COLPUT Returns zero on succes, negative on error. -. VALUES Array containing the display values which -. should have the new colors. -. RED Red intensities in the range 0.0 to 1.0. -. GREEN Green intensities in the range 0.0 to 1.0. -. BLUE Blue intensities in the range 0.0 to 1.0. -. NCOLORS Total number of colors to send to display. -. -... */ -/* -. Include files: -... */ -/* -. Parameters: -... */ -/* -. Function references: -... */ -/* -. Data declarations: -... */ -/*- */ - return (gdi_colput_c(gdi_id,values,red,green,blue,ncolors)); -} - -/* -. Function: N_GDI_IMMID -... */ - n_gdi_immid_(gdi_id,text,len) -/* -. Arguments: -... */ - int *gdi_id; /* display id */ - char *text; - fint len; -{ -/* -. Use: INTEGER GDI_IMMID( GDI_ID, Input INTEGER -. TEXT ) Input CHARACTER*(*) -. -. GDI_IMMID Returns zero on succes, negative on error. -. TEXT Text as main image identifier. -. -... */ -/* -. Include files: -... */ -/* -. Parameters: -... */ -/* -. Function references: -... */ -/* -. Data declarations: -... */ -/*- */ -#ifdef wn_so__ - fchar c; - c.l=len; - c.a=text; - return (gdi_immid_c(gdi_id,c)); -#else -#ifdef wn_sw__ - return (gdi_immid_c(gdi_id,text,len)); -#else - fchar c; - c.l=len; - c.a=text; - return (gdi_immid_c(gdi_id,c)); -#endif -#endif -} - -/* -. Function: N_GDI_IMSID -... */ - n_gdi_imsid_(gdi_id,text,len) -/* -. Arguments: -... */ - int *gdi_id; /* display id */ - char *text; - fint len; -{ -/* -. Use: INTEGER GDI_IMSID( GDI_ID, Input INTEGER -. TEXT ) Input CHARACTER*(*) -. -. GDI_IMSID Returns zero on succes, negative on error. -. TEXT Text as main image identifier. -. -... */ -/* -. Include files: -... */ -/* -. Parameters: -... */ -/* -. Function references: -... */ -/* -. Data declarations: -... */ -/*- */ -#ifdef wn_so__ - fchar c; - c.l=len; - c.a=text; - return (gdi_imsid_c(gdi_id,c)); -#else -#ifdef wn_sw__ - return (gdi_imsid_c(gdi_id,text,len)); -#else - fchar c; - c.l=len; - c.a=text; - return (gdi_imsid_c(gdi_id,c)); -#endif -#endif -} - -/* -. Function: N_GDI_COLGET -... */ - n_gdi_colget_(gdi_id,values,red,green,blue,ncolors) -/* -. Arguments: -... */ - int *gdi_id; /* display id */ - int *values; /* display values */ - float *red; /* red color intensity */ - float *green; /* green color intens. */ - float *blue; /* blue color intensity */ - int *ncolors; /* nr. of colors */ -{ -/* -. Use: INTEGER GDI_COLGET( GDI_ID, Input INTEGER -. VALUES, Input INTEGER ARRAY -. RED, Output REAL ARRAY -. GREEN, Output REAL ARRAY -. BLUE, Output REAL ARRAY -. NCOLORS ) Input INTEGER -. -. GDI_COLGET Returns zero on success, negative on error. -. VALUES Array containing the display values for -. which the colors should be obtained. -. RED Red intensities in the range 0.0 to 1.0. -. GREEN Green intensities in the range 0.0 to 1.0. -. BLUE Blue intensities in the range 0.0 to 1.0. -. NCOLORS Total number of colors to read from display. -. -... */ -/* -. Include files: -... */ -/* -. Parameters: -... */ -/* -. Function references: -... */ -/* -. Data declarations: -... */ -/*- */ - return (gdi_colget_c(gdi_id,values,red,green,blue,ncolors)); -} - -/* -. Function: N_GDI_DEFIMG -... */ - n_gdi_defimg_(gdi_id,glo,ghi,bscale,bzero) -/* -. Arguments: -... */ - int *gdi_id; /* display id */ - int *glo; /* lower grid units */ - int *ghi; /* upper grid units */ - float *bscale; /* scaling factor */ - float *bzero; -{ -/* -. Use: INTEGER GDI_DEFIMG( GDI_ID , Input INTEGER -. GLO , Input INTEGER ARRAY -. GHI , Input INETEGR ARRAY -. BSCALE , Input REAL -. BZERO ) Input REAL -. -. GDI_DEFIMG Returns zero on succes, negative on error. -. GDI_ID Display identifier. -. GLO Array containing the lower grid units -. (first X, then Y) of image on display. -. GHI Array containing the upper grid units -. (fitst X, then Y) of image on display. -. BSCALE Scaling factor from display data to -. real data: -. real = BSCALE * display + BZERO -. BZERO See above. -. -.Notes: GDI_DEFIMG must be called prior to GDI_IMWRITE. -. -... */ -/* -. Include files: -... */ -/* -. Parameters: -... */ -/* -. Function references: -... */ -/* -. Data declarations: -... */ -/*- */ - return (gdi_defimg_c(gdi_id,glo,ghi,bscale,bzero)); -} - -/* -. Function: N_GDI_MHEAD -... */ - n_gdi_mhead_(gdi_id,set,len,cwlo,cwhi) -/* -. Arguments: -... */ - int *gdi_id; /* display id */ - char *set; /* set name */ - fint len; - int *cwlo; /* lower c.w. */ - int *cwhi; /* upper c.w. */ -{ -/* -. Use: INTEGER GDI_MHEAD( GDI_ID , Input INTEGER -. SET , Input CHARACTER*(*) -. CWLO , Input INTEGER -. CWHI ) Input INTEGER -. -. GDI_MHEAD Returns zero on success, negative on error. -. GDI_ID Id of display. -. SET Name of GDS set. -. CWLO Lower coordinate word of frame. -. CWHI Upper coordinate word of frame. -. -... */ -/* -. Include files: -... */ -/* -. Parameters: -... */ -/* -. Function references: -... */ -/* -. Data declarations: -... */ -/*- */ -#ifdef wn_so__ - fchar c; - c.l=len; - c.a=set; - return (gdi_mhead_c(gdi_id,c,cwlo,cwhi)); -#else -#ifdef wn_sw__ - return (gdi_imsid_c(gdi_id,set,len,cwlo,cwhi)); -#else - fchar c; - c.l=len; - c.a=set; - return (gdi_mhead_c(gdi_id,c,cwlo,cwhi)); -#endif -#endif -} - -/* -. Function: N_GDI_IMWRITE -... */ - n_gdi_imwrite_(gdi_id,data,ndata,packed) -/* -. Arguments: -... */ - int *gdi_id; /* display id */ - int *data; /* display data */ - int *ndata; /* nr. of dispaly data */ - int *packed; /* packing code */ -{ -/* -. Use: INTEGER GDI_IMWRITE( GDI_ID , Input INTEGER -. DATA , Input INTEGER ARRAY -. NDATA , Input INTEGER -. PACKED ) Input INTEGER -. -. GDI_IMWRITE Returns zero on success, negative on error. -. GDI_ID Id of display. -. DATA Array containing display data packed -. according to the PACKED code. -. NDATA Number of display data packed into DATA. -. PACKED Number of display data per integer. -. The least significant part of the -. integer contains the most left display -. datum. A value of zero means that -. DATA contains plain bytes. -. -... */ -/* -. Include files: -... */ -/* -. Parameters: -... */ -/* -. Function references: -... */ -/* -. Data declarations: -... */ -/*- */ - return (gdi_imwrite_c(gdi_id,data,ndata,packed)); -} - -/* -. Function: N_GDI_GRREAD -... */ - n_gdi_grread_(gdi_id,data,ndata,packed) -/* -. Arguments: -... */ - int *gdi_id; /* display id */ - int *data; /* display data */ - int *ndata; /* nr. of dispaly data */ - int *packed; /* packing code */ -{ -/* -. Use: INTEGER GDI_GRREAD( GDI_ID , Input INTEGER -. DATA , Input INTEGER ARRAY -. NDATA , Input INTEGER -. PACKED ) Input INTEGER -. -. GDI_GRREAD Returns zero on success, negative on error. -. GDI_ID Id of display. -. DATA Array containing graphics data packed -. according to the PACKED code. -. NDATA Number of graphics data packed into DATA. -. PACKED Number of graphics data per integer. -. The least significant part of the -. integer contains the most left graphics -. datum. A value of zero means that -. DATA contains plain bytes. -. -... */ -/* -. Include files: -... */ -/* -. Parameters: -... */ -/* -. Function references: -... */ -/* -. Data declarations: -... */ -/*- */ - return (gdi_grread_c(gdi_id,data,ndata,packed)); -} - -/* -. Function: N_GDI_GRWRITE -... */ - n_gdi_grwrite_(gdi_id,data,ndata,packed) -/* -. Arguments: -... */ - int *gdi_id; /* display id */ - int *data; /* display data */ - int *ndata; /* nr. of dispaly data */ - int *packed; /* packing code */ -{ -/* -. Use: INTEGER GDI_GRWRITE( GDI_ID , Input INTEGER -. DATA , Output INTEGER ARRAY -. NDATA , Input INTEGER -. PACKED ) Input INTEGER -. -. GDI_GRWRITE Returns zero on success, negative on error. -. GDI_ID Id of display. -. DATA Array containing graphics data packed -. according to the PACKED code. -. NDATA Number of graphics data packed into DATA. -. PACKED Number of graphics data per integer. -. The least significant part of the -. integer contains the most left graphics -. datum. A value of zero means that -. DATA contains plain bytes. -. -... */ -/* -. Include files: -... */ -/* -. Parameters: -... */ -/* -. Function references: -... */ -/* -. Data declarations: -... */ -/*- */ - return (gdi_grwrite_c(gdi_id,data,ndata,packed)); -} - -/* -. Function: N_GDI_GDSID -... */ - n_gdi_gdsid_(gdi_id,set,len,subset) -/* -. Arguments: -... */ - int *gdi_id; /* display id */ - char *set; /* set name */ - fint len; - int *subset; /* subset level */ -{ -/* -. Use: INTEGER GDI_GDSID( GDI_ID , Input INTEGER -. SET , Input CHARACTER*(*) -. SUBSET ) Input INTEGER -. -. GDI_GDSID Returns zero on success, negative on error. -. GDI_ID Id of display. -. SET Name of GDS database. -. SUBSET Subset level of GDS database. -. -... */ -/* -. Include files: -... */ -/* -. Parameters: -... */ -/* -. Function references: -... */ -/* -. Data declarations: -... */ -/*- */ -#ifdef wn_so__ - fchar c; - c.l=len; - c.a=set; - return (gdi_gdsid_c(gdi_id,c,subset)); -#else -#ifdef wn_sw__ - return (gdi_gdsid_c(gdi_id,set,len,subset)); -#else - fchar c; - c.l=len; - c.a=set; - return (gdi_gdsid_c(gdi_id,c,subset)); -#endif -#endif -} - -/* -. Function: N_GDI_IINFO -... */ - n_gdi_iinfo_(gdi_id,set,len,subset,blo,bhi) -/* -. Arguments: -... */ - int *gdi_id; /* display id */ - char *set; /* set name */ - fint len; - int *subset; /* subset level */ - int *blo; /* lower grids */ - int *bhi; /* upper grids */ -{ -/* -. Use: INTEGER GDI_IINFO( GDI_ID , Input INTEGER -. SET , Output CHARACTER*(*) -. SUBSET , Output INTEGER -. BLO , Output INTEGER ARRAY -. BHI ) Output INTEGER ARRAY -. -. GDI_GDSID Returns zero on success, negative on error. -. GDI_ID Id of display. -. SET Name of GDS database. -. SUBSET Subset level of GDS database. -. BLO Contains lower X and Y grids of loaded image. -. BHI Contains upper X and Y grids of loaded image. -. -... */ -/* -. Include files: -... */ -/* -. Parameters: -... */ -/* -. Function references: -... */ -/* -. Data declarations: -... */ -/*- */ -#ifdef wn_so__ - fchar c; - c.l=len; - c.a=set; - return (gdi_iinfo_c(gdi_id,c,subset,blo,bhi)); -#else -#ifdef wn_sw__ - return (gdi_iinfo_c(gdi_id,set,len,subset,blo,bhi)); -#else - fchar c; - c.l=len; - c.a=set; - return (gdi_iinfo_c(gdi_id,c,subset,blo,bhi)); -#endif -#endif -} - -/* -. Function: N_GDI_SETID -... */ - n_gdi_setid_(gdi_id,set,len,subset,axperm) -/* -. Arguments: -... */ - int *gdi_id; /* display id */ - char *set; /* set name */ - fint len; - int *subset; /* subset level */ - int *axperm; /* axis permutation */ -{ -/* -. Use: INTEGER GDI_SETID( ID , Input INTEGER -. SET , Input CHARACTER*(*) -. SUBSET , Input INTEGER -. AXPERM ) Input INTEGER ARRAY -. -. GDI_SETID Return 0 on success, negative on error. -. ID Display id, i.e. returned from GDI_OPEN. -. SET Name of set. -. SUBSET Subset coordinate word. -. AXPERM Axes premutation array as returned from GDSINP. -. -... */ -/* -. Include files: -... */ -/* -. Parameters: -... */ -/* -. Function references: -... */ -/* -. Data declarations: -... */ -/*- */ -#ifdef wn_so__ - fchar c; - c.l=len; - c.a=set; - return (gdi_setid_c(gdi_id,c,subset,axperm)); -#else -#ifdef wn_sw__ - return (gdi_setid_c(gdi_id,set,len,subset,axperm)); -#else - fchar c; - c.l=len; - c.a=set; - return (gdi_setid_c(gdi_id,c,subset,axperm)); -#endif -#endif -} - -/* -. Function: N_GDI_SETXGRID -... */ - n_gdi_setxgrid_(gdi_id,nn,text,len) -/* -. Arguments: -... */ - int *gdi_id; /* display id */ - char *text; /* set name */ - fint len; - int *nn; /* items in text */ -{ -/* -.Use: INTEGER GDI_SETXGRID( ID , Input INTEGER -. TEXT , Input CHARACTER*(*) ARRAY -. XSIZE ) Input INTEGER -. -. GDI_SETXGRID Returns 0 on success, negative on error. -. ID Display id, i.e. returned from GDI_OPEN. -. TEXT Text to be displayed on display instead of -. grid coordinates. Usually only 7 characters -. are used. -. XSIZE Number of items in TEXT. Must be equal to -. the size as defined with gdi_defimg. -. -.Notes: The call to gds_setxgrid should immediately follow the call to -. gdi_defimg. -. -... */ -/* -. Include files: -... */ -/* -. Parameters: -... */ -/* -. Function references: -... */ -/* -. Data declarations: -... */ -/*- */ -#ifdef wn_so__ - fchar c; - c.l=len; - c.a=text; - return (gdi_setxgrid_c(gdi_id,c,nn)); -#else -#ifdef wn_sw__ - return (gdi_setxgrid_c(gdi_id,text,len,nn)); -#else - fchar c; - c.l=len; - c.a=text; - return (gdi_setxgrid_c(gdi_id,c,nn)); -#endif -#endif -} - -/* -. Function: N_GDI_SETYGRID -... */ - n_gdi_setygrid_(gdi_id,nn,text,len) -/* -. Arguments: -... */ - int *gdi_id; /* display id */ - char *text; /* set name */ - fint len; - int *nn; /* items in text */ -{ -/* -.Use: INTEGER GDI_SETYGRID( ID , Input INTEGER -. TEXT , Input CHARACTER*(*) ARRAY -. YSIZE ) Input INTEGER -. -. GDI_SETXGRID Returns 0 on success, negative on error. -. ID Display id, i.e. returned from GDI_OPEN. -. TEXT Text to be displayed on display instead of -. grid coordinates. Usually only 7 characters -. are used. -. YSIZE Number of items in TEXT. Must be equal to -. the size as defined with gdi_defimg. -. -.Notes: The call to gds_setxgrid should immediately follow the call to -. gdi_defimg. -. -... */ -/* -. Include files: -... */ -/* -. Parameters: -... */ -/* -. Function references: -... */ -/* -. Data declarations: -... */ -/*- */ -#ifdef wn_so__ - fchar c; - c.l=len; - c.a=text; - return (gdi_setygrid_c(gdi_id,c,nn)); -#else -#ifdef wn_sw__ - return (gdi_setygrid_c(gdi_id,text,len,nn)); -#else - fchar c; - c.l=len; - c.a=text; - return (gdi_setygrid_c(gdi_id,c,nn)); -#endif -#endif -} - -/* -. Function: N_GDI_PGPLOT -... */ - n_gdi_pgplot_(gdi_id,ifunc,rbuf,nrbf,lchr,cbuf,len) -/* -. Arguments: -... */ - int *gdi_id; /* display id */ - int *ifunc; - float *rbuf; - int *nrbf; - int *lchr; - char *cbuf; - fint len; -{ -/* -. Use: INTEGER GDI_PGPLOT( ID , Input INTEGER -. IFUNC, Input INTEGER - RBUF, In/out FLOAT ARRAY - NRBUF, Input INTEGER - CBUF, In/out CHARACTER*(*) - LEN) Input INTEGER -. -. GDI_PGPLOT Return 0 on success, negative on error. -. ID Display id, i.e. returned from GDI_OPEN. -. IFUNC Function to perform -. -... */ -/* -. Include files: -... */ -/* -. Parameters: -... */ -/* -. Function references: -... */ -/* -. Data declarations: -... */ -/*- */ -#ifdef wn_so__ - fchar c; - c.l=len; - c.a=cbuf; - return (gdi_pgplot_c(gdi_id,ifunc,rbuf,nrbf,c,lchr)); -#else -#ifdef wn_sw__ - return (gdi_pgplot_c(gdi_id,ifunc,rbuf,nrbf,cbuf,len,lchr)); -#else - fchar c; - c.l=len; - c.a=cbuf; - return (gdi_pgplot_c(gdi_id,ifunc,rbuf,nrbf,c,lchr)); -#endif -#endif -} - -/* -. Function: N_GDI_FRAME -... */ - n_gdi_frame_(gdi_id,glo,ghi) -/* -. Arguments: -... */ - int *gdi_id; /* display id */ - float *glo; - float *ghi; -{ -/* -. Use: INTEGER GDI_FRAME( ID , Input INTEGER -. GLO, Output FLOAT ARRAY - GHI) Output FLOAT ARRAY -. -. GDI_PGPLOT Return 0 on success, negative on error. -. ID Display id, i.e. returned from GDI_OPEN. -. -... */ -/* -. Include files: -... */ -/* -. Parameters: -... */ -/* -. Function references: -... */ -/* -. Data declarations: -... */ -/*- */ - return (gdi_frame_c(gdi_id,glo,ghi)); -} diff --git a/src/nplot/ngiini.for b/src/nplot/ngiini.for deleted file mode 100644 index 22f13a7cadbd03624b9793d6f746241bba124f72..0000000000000000000000000000000000000000 --- a/src/nplot/ngiini.for +++ /dev/null @@ -1,53 +0,0 @@ -C+ NGIINI.FOR -C HJV 920723 -C -C Revisions: -C - SUBROUTINE NGIINI -C -C Initialize NGIDS program -C -C Result: -C -C CALL NGIINI will set header lines, logging, DWARF interface -C -C Include files: -C - INCLUDE 'WNG_DEF' - INCLUDE 'NPL_DEF' -C -C Parameters: -C -C -C Arguments: -C -C -C Function references: -C - LOGICAL WNDINI !INIT DWARF - LOGICAL WNDDAB !OPEN DATABASE -C -C Data declarations: -C -C- -C -C SET HEADER LINES -C - CALL WNCFHD(F_P,1,'!40C\Program to load maps in GIDS-display') -C -C START DWARF -C - IF (.NOT.WNDINI(PRGNAM)) CALL WNGEX !EXIT IF NO DWARF START -C -C LOGGING -C - CALL WNDLON(LOGCD) !PROPER LOGGING -C -C DATABASE -C - IF (.NOT.WNDDAB()) CALL WNGEX !OPEN DATABASE -C - RETURN !READY -C -C - END diff --git a/src/nplot/ngilod.for b/src/nplot/ngilod.for deleted file mode 100644 index 2b580b7decaa5af744d596f69cf1b2c1a5ce68e0..0000000000000000000000000000000000000000 --- a/src/nplot/ngilod.for +++ /dev/null @@ -1,197 +0,0 @@ -C+ NGILOD.FOR -C GvD 920525 -C -C Revisions: -C HjV 920723 Replace DWARF-routines by Newstar-routines -C HjV 920827 Add NGI.DEF -C HjV 930215 Change GDI calls to N_GDI calls -C Add OPTION -C WNB 930330 Add DISPLAY -C WNB 930406 Correct set printing -C WNB 930416 Correct set show -C WNB 930427 Make automatic GIDS environment -C WNB 930510 Use NGIDAT, remove R-series -C WNB 930514 Changed NGIMAP -C CMV 930913 Change checks depending on MAPTYP -C CMV 931025 Add re-open to allow for resizing (see NGIDAT.FOR) -C CMV 940120 Change position of NGIREC to avoid clearing first map -C - LOGICAL FUNCTION NGILOD() -C -C Load one or more maps for GIDS -C -C Result: -C NGILOD_L = NGILOD() Get a map (MAPTYP='MAP') or data -C (MAPTYP='IFRS' or 'CHAN') -C -C -C -C Include files: -C - INCLUDE 'WNG_DEF' - INCLUDE 'CBITS_DEF' - INCLUDE 'NGI_DEF' - INCLUDE 'MPH_O_DEF' - INCLUDE 'STH_O_DEF' -C -C Parameters: -C -C -C Arguments: -C -C -C Function references: -C - INTEGER WNCALN !STRING LENGTH - LOGICAL NMASTG !GET A SET (WMP) - LOGICAL NSCSTG !GET A SET (SCN) - CHARACTER*32 WNTTSG !PRINT SET NAME - LOGICAL NGIREC !RECORD MAP INTO GIDS-DISPLAY - LOGICAL NGIDMP !Load WMP map into gids - LOGICAL NGIDIF !Load SCN data as (HA,Ifr) map - LOGICAL NGIDCH !Load SCN data as (HA,Chan) map - LOGICAL NGIDOP !OPEN CONNECTION TO GIDS WINDOW - LOGICAL NGIDCL !CLOSE CONNECTION TO GIDS WINDOW -C -C Data declarations: -C - CHARACTER*32 STR !SET NAME - CHARACTER*2 POLNAM(0:3) !NAME OF POLARISATION - DATA POLNAM/'XX','XY','YX','YY'/ - INTEGER POLCOD(0:3) !POLARISATION CODE - DATA POLCOD/XX_P,XY_P,YX_P,YY_P/ - INTEGER IPOL !CURRENT POL. BITS - INTEGER CCHAN !CURRENT CHANNEL - LOGICAL FOUND !Channel in range - LOGICAL FIRST !First map in this call - INTEGER MPHP !MAP HEADER PTR - INTEGER STHP !SET HEADER POINTER - INTEGER IFRS(0:1) !CURRENT IFR'S - BYTE MPH(0:MPHHDL-1) ! N-map header - INTEGER MPHJ(0:MPHHDL/4-1) - REAL MPHE(0:MPHHDL/4-1) - EQUIVALENCE (MPH,MPHJ,MPHE) - BYTE STH(0:STH__L-1) !SET HEADER - INTEGER STHJ(0:STH__L/LB_J-1) - INTEGER*2 STHI(0:STH__L/LB_I-1) - REAL STHE(0:STH__L/LB_E-1) - EQUIVALENCE (STH,STHI,STHJ,STHE) -C- - NGILOD=.TRUE. !ASSUME OK -C -C Re-open GIDS window -C - IF (.NOT.NGIDOP(GID)) THEN - CALL WNCTXT (F_TP,'Error re-opening GIDS display') - NGILOD=.FALSE. - RETURN - END IF -C -C Check if at least one map can be loaded, record first map -C (if necessary) to prevent clearing it in NGISET (defimg call) -C - FIRST=.TRUE. - IF (.NOT.NGIREC(.TRUE.)) GOTO 901 !No more space -C -C Set up the size of the window etc. -C - CALL NGISET(TEAR) -C -C Load maps from WMP file -C - IF (MAPTYP.EQ.'MAP') THEN !WMP MAP - DO WHILE (NMASTG(FCAIN,SETS,MPH,MPHP,SETNAM)) - IF (NRA.EQ.MPHJ(MPH_NRA_J) .AND. - 1 NDEC.EQ.MPHJ(MPH_NDEC_J)) THEN !CAN DO - PTR=MPHP - CALL WNCTXS (STR,'Set !AS',WNTTSG(SETNAM,0)) !SET NAME - IF (.NOT.FIRST) THEN - IF (.NOT.NGIREC(.TRUE.)) GOTO 901 !No more space - END IF - CALL WNCTXT(F_TP,'Loading !AS (!AS)',NODIN,STR) - IF (.NOT.NGIDMP(MPHJ,NODIN,STR)) GOTO 900 !ERROR - IF (.NOT.NGIREC(.FALSE.)) GOTO 901 !Cannot record - FIRST=.FALSE. - END IF - END DO -C -C Load data from SCN file as (HA,IFR) maps -C - ELSE IF (MAPTYP.EQ.'IFRS'.OR. - 1 MAPTYP.EQ.'BASE') THEN !SCN FILE DATA: (HA,IFRS) - - DO IPOL=0,3 - IF (IAND(SPOL,POLCOD(IPOL)).NE.0) THEN !SELECTED THIS POL. - DO CCHAN=RCHAN(0),RCHAN(1) !ALL CHANNELS - FOUND=.FALSE. - CALL WNDSTR(FCAIN,SETS) !RESET SET SEARCH - DO WHILE (.NOT.FOUND.AND. - 1 NSCSTG(FCAIN,SETS,STH,STHP,SETNAM)) !FIND CHANNEL - FOUND=(CCHAN.EQ.STHI(STH_CHAN_I)) - END DO - IF (FOUND) THEN - CALL WNCTXS (STR,'Ch. !UJ (!AS)', - 1 CCHAN,POLNAM(IPOL)) !SET NAME - IF (.NOT.FIRST) THEN - IF (.NOT.NGIREC(.TRUE.)) GOTO 901 !No more space - END IF - CALL WNCTXT(F_TP,'Loading !AS (!AS)',NODIN,STR) - IF (.NOT.NGIDIF(IPOL,CCHAN,NODIN,STR)) GOTO 900 !ERROR - IF (.NOT.NGIREC(.FALSE.)) GOTO 901 !Cannot record - FIRST=.FALSE. - END IF - END DO - END IF - END DO -C -C Load data from SCN file as (HA,CHAN) maps -C - ELSE IF (MAPTYP.EQ.'CHAN') THEN !SCN FILE DATA: (HA,CHAN) - DO IPOL=0,3 - IF (IAND(SPOL,POLCOD(IPOL)).NE.0) THEN !SELECTED THIS POL. - DO I1=0,STHTEL-1 - DO I2=I1,STHTEL-1 - IF (SIFRS(I1,I2)) THEN !SELECTED - IFRS(0)=I1 - IFRS(1)=I2 - STR='Ifr '//TELNAM(I1+1:I1+1)// - 1 TELNAM(I2+1:I2+1)// - 1 ' ('//POLNAM(IPOL)//')' !IFR NAME + POL - IF (.NOT.FIRST) THEN - IF (.NOT.NGIREC(.TRUE.)) GOTO 901 !No more space - END IF - CALL WNCTXT(F_TP,'Loading !AS (!AS)',NODIN,STR) - IF (.NOT.NGIDCH(IFRS,IPOL,NODIN,STR)) GOTO 900 !ERROR - IF (.NOT.NGIREC(.FALSE.)) GOTO 901 !Cannot record - FIRST=.FALSE. - END IF - END DO - END DO - END IF - END DO -C -C No other options yet... -C - ELSE !ERROR - CALL WNCTXT('Unknown MAPTYP !AS',MAPTYP) - ENDIF - GOTO 800 !READY -C - 900 CONTINUE - CALL WNCTXT(F_TP,'Error in loading of map!/') - 901 CONTINUE - NGILOD=.FALSE. - 800 CONTINUE -C -C Free any memory -C - CALL NGICLR() -C -C Close GIDS window again -C - JS=NGIDCL(GID) -C - RETURN -C -C - END diff --git a/src/nplot/ngipnt.for b/src/nplot/ngipnt.for deleted file mode 100644 index 0b4071603a16a9e24084f03a56e8542ebab7f9f8..0000000000000000000000000000000000000000 --- a/src/nplot/ngipnt.for +++ /dev/null @@ -1,331 +0,0 @@ -C+ NGIPNT.FOR -C WNB 930510 -C -C Revisions: -C WNB 930514 Use NGIDPT; make use of MB2 -C WNB 930621 Add flagging -C WNB 930803 CBITS_DEF -C WNB 930820 Interchange East/West telescope in IFR -C CMV 931026 Add re-open to allow for resizing (see NGIDAT.FOR) -C AXC 010709 Linux port - DTC setting and checking -C - SUBROUTINE NGIPNT(PTP) -C -C Show information on map points -C -C Result: -C CALL NGIPNT( PTP_J:I) Gives information on points/area in map -C (PTP=0) or flags (PTP=1) -C MB1(or 1) gives info -C MB3(or 3) leaves -C MB2(or 2) starts area (MB1 other point) -C others nothing -C -C -C -C Include files: -C - INCLUDE 'WNG_DEF' - INCLUDE 'NGI_DEF' - INCLUDE 'CBITS_DEF' - INCLUDE 'MPH_O_DEF' - INCLUDE 'STH_O_DEF' - INCLUDE 'FLF_O_DEF' !FLAG FILE ENTRY -C -C Parameters: -C -C -C Arguments: -C - INTEGER PTP !TYPE TO DO -C -C Function references: -C - LOGICAL WNFRD !READ DISK - LOGICAL NGIDPT !GET POINT - LOGICAL NFLFL1 !WRITE FLAG ENTRY - LOGICAL NGIDOP !OPEN CONNECTION TO GIDS WINDOW - LOGICAL NGIDCL !CLOSE CONNECTION TO GIDS WINDOW -C -C Data declarations: -C - REAL RBUF(0:1,0:1),RB(2) !PGPLOT DATA (X:Y,MB2:MB1) - INTEGER BUT !BUTTON PRESSED - REAL LM(2),L,M !L,M - EQUIVALENCE (L,LM(1)),(M,LM(2)) - DOUBLE PRECISION D00(0:1),D10(0:1) !COORDINATES - REAL SCL(0:1) !UV COORDINATES - REAL DAT(0:1) !DATA - INTEGER UVTP !UV DATA TYPE - INTEGER LAR(0:3,0:1) !LOCAL DEFINED AREA - INTEGER ACNT !AREA INPUT COUNT - INTEGER ARSN !AREA SEEN (1) - CHARACTER*16 TSTR !TELESCOPE NAMES - DATA TSTR /'0123456789ABCDEF'/ - BYTE MPH(0:MPHHDL-1) !MAP HEADER - INTEGER*2 MPHI(0:MPHHDL/2-1) - INTEGER MPHJ(0:MPHHDL/4-1) - REAL MPHE(0:MPHHDL/4-1) - DOUBLE PRECISION MPHD(0:MPHHDL/8-1) - EQUIVALENCE (MPH,MPHI,MPHJ,MPHE,MPHD) - BYTE FLF(0:FLFHDL-1) !FLAG ENTRY - INTEGER*2 FLFI(0:FLFHDL/LB_I-1) - INTEGER FLFJ(0:FLFHDL/LB_J-1) - REAL FLFE(0:FLFHDL/LB_E-1) - EQUIVALENCE(FLF,FLFI,FLFJ,FLFE) - CHARACTER*2 STR1,STR2 - CHARACTER*4 DTC -C- -C -C Re-open GIDS window -C - IF (.NOT.NGIDOP(GID)) THEN - CALL WNCTXT (F_TP,'Error re-opening GIDS display') - GOTO 800 - END IF -C -C GET MAP INFO -C - IF (.NOT.WNFRD(FCAIN,MPHHDL,MPH,PTR)) GOTO 11 !READ HEADER - J0=MPHJ(MPH_TYP_1/LB_J) !DATA TYPE - DTC(4:4)=CHAR(J0/256/256/256) - DTC(3:3)=CHAR(MOD(J0/256/256,256)) - DTC(2:2)=CHAR(MOD(J0/256,256)) - DTC(1:1)=CHAR(MOD(J0,256)) - IF (DTC.EQ.'COVE') THEN !SET DATA TYPE - UVTP=1 - ELSE IF (DTC.EQ.'REAL') THEN - UVTP=2 - ELSE IF (DTC.EQ.'IMAG') THEN - UVTP=3 - ELSE IF (DTC.EQ.'AMPL') THEN - UVTP=4 - ELSE IF (DTC.EQ.'PHAS') THEN - UVTP=5 - ELSE - UVTP=0 !STANDARD MAP - END IF - IF (PTP.EQ.1 .AND. UVTP.EQ.0) THEN - CALL WNCTXT(F_TP,'Cannot FLAG on standard map; POINT assumed') - END IF - RB(1)=-1. !POINT TO CENTRE - RB(2)=-1. - ACNT=0 !NO AREA POINT -C -C GET DATA POINTS FROM USER -C - FLFJ(FLF_FLAG_J)=UFL !FILL FLAG TO USE - 10 CONTINUE - ARSN=0 !NO AREA SEEN - IF (.NOT.NGIDPT(GID,COMPR,TEAR,RB,RBUF(0,ACNT),BUT)) - 1 GOTO 800 !GET A POINT - IF (BUT.EQ.2) ACNT=0 !START AREA - IF (BUT.EQ.2 .OR. ACNT.NE.0) THEN !AREA - DO I=0,1 !SET CORNER - LAR(I+2*ACNT,0)=RBUF(I,ACNT) - END DO - ACNT=ACNT+1 !COUNT - IF (ACNT.EQ.2) THEN !HAVE TWO - ACNT=0 !RESET COUNT - DO I=1,2 - LAR(I+1,1)=MAX(LAR(I-1,0),LAR(I+1,0)) !MAX - LAR(I-1,0)=MIN(LAR(I-1,0),LAR(I+1,0)) !MIN - LAR(I+1,1)=LAR(I+1,1)-LAR(I-1,0)+1 !WIDTH - LAR(I-1,1)=LAR(I-1,0)+LAR(I+1,1)/2 !CENTRE - END DO - CALL WNCTXT(F_TP,'(!5$4SJ)',LAR(0,1)) !SHOW - ARSN=1 !HANDLE AREA - END IF - IF (ARSN.EQ.0 .OR. PTP.EQ.0) GOTO 10 !NO FLAGGING - END IF -C -C GET DISK DATA -C - IF (ARSN.EQ.0) THEN - J0=MPHJ(MPH_MDP_J)+(RBUF(1,0)+NDEC/2)*NRA*LB_E+ - 1 (RBUF(0,0)+NRA/2)*LB_E !GET DATA POINTER - IF (.NOT.WNFRD(FCAIN,2*LB_E,DAT,J0)) THEN !READ DATA - 11 CONTINUE - CALL WNCTXT(F_TP,'Error reading data') - GOTO 800 - END IF - END IF -C -C SHOW/FLAG DATA -C -C STANDARD MAP -C - IF (UVTP.EQ.0) THEN !STANDARD MAP - IF (ARSN.EQ.0) THEN - L=RBUF(0,0)*(MPHD(MPH_SRA_D))+(MPHD(MPH_SHR_D)) !MAKE L,M - M=RBUF(1,0)*(MPHD(MPH_SDEC_D))+(MPHD(MPH_SHD_D)) - CALL WNMCLM(((MPHD(MPH_RA_D))), - 1 ((MPHD(MPH_DEC_D))), - 1 PI2*L,PI2*M,D0,D1) !RA/DEC - L=L*3600*360 !ARCSEC - M=M*3600*360 - CALL WNCTXT(F_TP,'!5$2E: !15C!9$E9.2 WU at !31C(!9$2E10.2)'// - 1 '!54C(!11$DPF11.5, !11$DAF11.5)'// - 1 '!/!15C!9$E9.5 Jy!54C(!11$DHF8, !11$DDF7)', - 1 RBUF(0,0),DAT(0),LM,D0,D1, - 1 DAT(0)/200.,D0,D1) - END IF -C -C UV TYPE: GET SCALES AND COORDINATES -C - ELSE !UV TYPE - DO I=0,1 !GET SCALES - SCL(I)=MPHD(MPH_SRA_D+I)*MPHJ(MPH_FSR_J+I)*2*DPI - END DO - IF (MPHI(MPH_CD_I+6).NE.0) THEN - DO I=0,1 - SCL(I)=SCL(I)*MPHD(MPH_FRQ_D)/(DCL*1D-6) !ABS. SCALE - END DO - SCL(1)=SCL(1)*DPI/180D0 !MAKE DEGREES - END IF - DO I2=0,ARSN - D00(I2)=(RBUF(1,I2)+NDEC/2)/SCL(0) !GET COORD - D10(I2)=RBUF(0,I2)/SCL(1) - END DO - IF (ARSN.EQ.0) THEN - IF (UVTP.EQ.5) THEN !PHASE - STR1='dg' - DAT(0)=DAT(0)*360 !MAKE DEGREES - ELSE IF (UVTP.EQ.1) THEN !COVER - STR1=' ' - ELSE !AMPL. TYPE - STR1='WU' - END IF - END IF -C -C UV -C - IF (MPHI(MPH_CD_I+6).EQ.0) THEN !UV - IF (ARSN.EQ.0 .AND. DAT(0).EQ.0.0) THEN - CALL WNCTXT(F_TP,'Blank data') - ELSE - IF (ARSN.EQ.0) - 1 CALL WNCTXT(F_TP,'!5$2E: !15C!9$E9.2 !2$AS at '// - 1 '!31C(!10$D10.1, !10$D10.1)'// - 1 '!56C(!10$D10.2, !10$D10.2)', - 1 RBUF(0,0),DAT(0),STR1,D00(0),D10(0), - 1 D00(0)/(MPHD(MPH_FRQ_D)/(DCL*1D-6)), - 1 D10(0)/(MPHD(MPH_FRQ_D)/(DCL*1D-6))) - IF (PTP.EQ.1) THEN !FLAG ENTRY - FLFJ(FLF_FLAG_J)=IOR(IAND(FL_ALL,FLFJ(FLF_FLAG_J)), - 1 '01000000'X) - FLFI(FLF_POL_I)=-1 - FLFJ(FLF_CHAN_J)=-1 - DO I2=0,ARSN - IF (MPHD(MPH_DEC_D).NE.0) D10(I2)= - 1 D10(I2)/SIN(DPI2*MPHD(MPH_DEC_D)) - D00(I2)=D00(I2)/(MPHD(MPH_FRQ_D)/(DCL*1D-6)) - D10(I2)=D10(I2)/(MPHD(MPH_FRQ_D)/(DCL*1D-6)) - FLFI(FLF_IFR_I)=NINT(SQRT(ABS(D00(I2)*D00(I2)+ - 1 D10(I2)*D10(I2)))) - IF (ABS(D00(I2))+ABS(D10(I2)).NE.0) THEN - FLFE(FLF_HA_E)=ATAN2(-D10(I2),D00(I2))/DPI2 - ELSE - FLFE(FLF_HA_E)=0. - END IF - IF (I2.EQ.0) THEN - FLFJ(FLF_FLAG_J)=IOR(FLFJ(FLF_FLAG_J),ARSN) - ELSE - FLFJ(FLF_FLAG_J)=IOR(FLFJ(FLF_FLAG_J),2) - END IF - IF (.NOT.NFLFL1(DFAR,FLF)) - 1 CALL WNCTXT(F_TP,'Error writing FLF entry') - FLFJ(FLF_FLAG_J)=IAND(FLFJ(FLF_FLAG_J),NOT(3)) - END DO - END IF - END IF -C -C BAS-HA -C - ELSE IF (MPHI(MPH_CD_I+6).EQ.1) THEN !BAS-HA - IF (ARSN.EQ.0 .AND. DAT(0).EQ.0.0) THEN - CALL WNCTXT(F_TP,'Blank data') - ELSE - IF (ARSN.EQ.0) - 1 CALL WNCTXT(F_TP,'!5$2E: !15C!9$E9.2 !2$AS at '// - 1 '!31C(!10$D10.1, !10$D10.1)', - 1 RBUF(0,0),DAT(0),STR1,D00(0),D10(0)) - IF (PTP.EQ.1) THEN !FLAG ENTRY - FLFJ(FLF_FLAG_J)=IOR(IAND(FL_ALL,FLFJ(FLF_FLAG_J)), - 1 '01000000'X) - FLFI(FLF_POL_I)=-1 - FLFJ(FLF_CHAN_J)=-1 - DO I2=0,ARSN - FLFI(FLF_IFR_I)=NINT(D00(I2)) - FLFE(FLF_HA_E)=D10(I2)/360. - IF (I2.EQ.0) THEN - FLFJ(FLF_FLAG_J)=IOR(FLFJ(FLF_FLAG_J),ARSN) - ELSE - FLFJ(FLF_FLAG_J)=IOR(FLFJ(FLF_FLAG_J),2) - END IF - IF (.NOT.NFLFL1(DFAR,FLF)) - 1 CALL WNCTXT(F_TP,'Error writing FLF entry') - FLFJ(FLF_FLAG_J)=IAND(FLFJ(FLF_FLAG_J),NOT(3)) - END DO - END IF - END IF -C -C IFR-HA -C - ELSE !IFR-HA - IF (ARSN.EQ.0 .AND. DAT(0).EQ.0.0) THEN - CALL WNCTXT(F_TP,'Blank data') - ELSE - IF (PTP.EQ.1) THEN !FLAG ENTRY - FLFJ(FLF_FLAG_J)=IAND(FL_ALL,FLFJ(FLF_FLAG_J)) - FLFI(FLF_POL_I)=-1 - FLFJ(FLF_CHAN_J)=-1 - END IF - DO I2=0,ARSN - I0=NINT(D00(I2)) !IFR NUMBER - I=STHTEL !FIND IFR NAME - I1=0 - I0=MOD(I0,STHIFR) - DO WHILE (I0.GE.0) - I0=I0-I - I=I-1 - I1=I1+1 - END DO - I1=I1-1 - I=I+1 - I0=MIN(I0+I+I1,STHTEL) !EAST TEL. - I1=MIN(I1,STHTEL) !WEST TELESCOPE - IF (ARSN.EQ.0 .AND. I2.EQ.0) THEN - STR2=TSTR(I1+1:I1+1)//TSTR(I0+1:I0+1) - CALL WNCTXT(F_TP,'!5$2E: !15C!9$E9.2 !2$AS at '// - 1 '!31C(!2$AS, !10$D10.1)', - 1 RBUF(0,0),DAT(0),STR1,STR2,D10(0)) - END IF - IF (PTP.EQ.1) THEN !FLAG ENTRY - FLFI(FLF_IFR_I)=I0*256+I1 !EAST*256 + WEST - FLFE(FLF_HA_E)=D10(I2)/360. - IF (I2.EQ.0) THEN - FLFJ(FLF_FLAG_J)=IOR(FLFJ(FLF_FLAG_J),ARSN) - ELSE - FLFJ(FLF_FLAG_J)=IOR(FLFJ(FLF_FLAG_J),2) - END IF - IF (.NOT.NFLFL1(DFAR,FLF)) - 1 CALL WNCTXT(F_TP,'Error writing FLF entry') - FLFJ(FLF_FLAG_J)=IAND(FLFJ(FLF_FLAG_J),NOT(3)) - END IF - END DO - END IF - END IF - END IF - GOTO 10 !CYCLE -C - 800 CONTINUE -C -C Close GIDS window again -C - JS=NGIDCL(GID) -C - RETURN -C -C - END diff --git a/src/nplot/ngirec.for b/src/nplot/ngirec.for deleted file mode 100644 index b3d85e89e4b46ee7648b661990b38b6db441363f..0000000000000000000000000000000000000000 --- a/src/nplot/ngirec.for +++ /dev/null @@ -1,139 +0,0 @@ -C+ NGIREC.FOR -C CMV 931029 -C -C Revisions: -C CMV 931029 Created -C - LOGICAL FUNCTION NGIREC(CHECK) -C -C This file has all subroutines needed for the recording options of NGIDS -C -C -C Result: -C -C NGIREC_L = NGIREC(CHECK_L:I) -C If CHECK is true, a check will be made if the next plane -C can be loaded (return .true. if space left) -C If CHECK is false, the plane that has just been loaded is -C recorded (return .true. if successful) -C -C Typical use: IF (NGIREC(.TRUE.)) THEN -C Load_plane -C JS=NGIREC(.FALSE.) -C END IF -C -C -C -C Include files: -C - INCLUDE 'WNG_DEF' - INCLUDE 'NGI_DEF' -C -C Parameters: -C -C -C Arguments: -C - LOGICAL CHECK -C -C Function references: -C - INTEGER N_GDI_SEQUENCE,N_GDI_RECORD,N_GDI_RINFO !GDI INTERFACE - LOGICAL WNDPAR !GET DWARF KEYWORD - INTEGER WNCALN !LENGTH STRING -C -C Data declarations: -C - INTEGER SEQ(MXNSEQ) ! GIDS playback sequence - INTEGER NREC,MREC ! GIDS map recording - CHARACTER*5 NEXT ! DO NEXT MAP (allow for resize etc) - DATA NEXT/'ALL'/ - SAVE NEXT ! Keep next for next time -C- - NGIREC=.TRUE. !ASSUME OK -C -C If CHECK is true, check wether we can have more planes -C - IF (CHECK) THEN -C -C We ask for the NEXT keyword to give the user time to zoom. -C Zooming is applied to all preceding planes until a GCLEAR is given. -C - IF (.NOT.DO_FLAG.AND.(NRMAP.EQ.1.OR.NEXT(1:1).EQ.'Y')) THEN - IF (NEXT(1:1).EQ.'N') NEXT='ALL' - IF (.NOT.WNDPAR('NEXT',NEXT,LEN(NEXT),J0,NEXT)) GOTO 990 - IF (NEXT(1:1).EQ.'N') GOTO 990 -C -C If only one map is in memory, record it, since with the map -C that will be loaded now we have a movie. -C -C If we are in flagging mode, only the current plane is shown. -C - IF (NRMAP.EQ.1)THEN - IF (N_GDI_RECORD(GID,1).LT.0) THEN - CALL WNCTXT(F_TP,'Could not record first map!/') - GOTO 990 - END IF - END IF - END IF -C -C Test if we have space to record the new image. -C - IF (.NOT.DO_FLAG.AND.NRMAP.GT.0) THEN - IF (N_GDI_RINFO(GID,NREC,MREC).LT.0) THEN - CALL WNCTXT(F_TP,'Error in GDI_RINFO!/') - GOTO 990 - END IF - IF (NRMAP .GT. MREC) THEN - CALL WNCTXT(F_TP, - 1 'The maximum of !SL maps have already been loaded!/',MREC) - GOTO 990 - END IF - END IF -C -C If check is false, record the plane just loaded -C - ELSE -C -C -C If we are not flagging, the map is recorded. -C We do not want to record just one map, so only maps 2,3,... -C are recorded here, the first map is recorded right before the -C second map is loaded. -C - NRMAP=NRMAP+1 - IF (.NOT.DO_FLAG) THEN - IF (NRMAP.NE.1) THEN - IF (N_GDI_RECORD(GID,NRMAP).LT.0) THEN - CALL WNCTXT(F_TP,'Could not record map !SL!/',NRMAP) - GOTO 990 - END IF - END IF -C -C Define the new playback sequence -C - DO I1=1,MIN(MXNSEQ,NRMAP) - SEQ(I1)=I1 - END DO - IF (NRMAP.GT.1) THEN - IF (N_GDI_SEQUENCE(GID,SEQ, - 1 MIN(MXNSEQ,NRMAP)).LT.0) THEN - CALL WNCTXT(F_TP,'Error in GDI_SEQUENCE!/') - END IF - END IF -C - ENDIF ! NOT DO_FLAG -C - ENDIF ! if (check) - GOTO 800 -C -C ERRORS: could not record, or no space left to load new map -C - 990 CONTINUE - NGIREC=.FALSE. !Cannot load more maps -C - 800 CONTINUE !Everything all right -C - RETURN - END - diff --git a/src/nplot/ngiset.for b/src/nplot/ngiset.for deleted file mode 100644 index 1db3e111f467db30232bdae2a4a889e216186177..0000000000000000000000000000000000000000 --- a/src/nplot/ngiset.for +++ /dev/null @@ -1,519 +0,0 @@ -C+ NGISET.FOR -C CMV 931029 -C -C Revisions: -C CMV 931029 Created -C WNB 931221 Correct use of IAND -C CMV 940120 Removed %VAL -C CMV 940203 Changed handling of polarisation -C CMV 940817 Add DO_CLIP for flagging -C - LOGICAL FUNCTION NGISET(TEAR_I) -C -C Set size, scale and grid in GIDS display -C -C Result: -C -C NGISET_L = NGISET(TEAR_J(0:3):I) -C -C Call NGISET before a series of planes is loaded. -C It will define the scales and define the size of the -C image based on TEAR. Virtual memory will be allocated -C for map and flag planes (in DMAP and DFLG). -C -C NGICOV_L = NGICOV() -C -C Clears the overlay for the planes determined by ALL_CHAN -C and ALL_POLS. -C -C NGITRA_L = NGITRA(MID_C*(*):I,SID_C*(*):I) -C -C Write Map ID and Sub ID to GIDS header for this set -C -C -C NGISFL_L = NGISFL(IPOL_J:I,IFR_J:I,CCHAN_J:I) -C -C Handle flags using regions mode, for polarisation IPOL, -C interferometer IFR (if CHAN mode) or channel CCHAN (if IFRS mode). -C -C NGICLR_L = NGICLR() -C -C Frees DMAP and DFLG is they had been previously set. -C -C NOTE: The bits in array DFLG are used as follows: -C -C bit 0: Flags that have been read from the SCN file ('old') -C bit 1: Flags that have been set earlier by NGIDS ('fresh') -C bit 2: Flags that are set by the regions option ('new') -C bit 3: not used -C -C PIN references -C CLIP_LEVEL -C -C -C -C Include files: -C - INCLUDE 'WNG_DEF' - INCLUDE 'CBITS_DEF' - INCLUDE 'FLF_O_DEF' !FLAG FILE ENTRY - INCLUDE 'STH_O_DEF' !FOR STHTEL - INCLUDE 'NGI_DEF' -C -C Parameters: -C - INTEGER MAXGRID !MAX NUMBER OF ANNOTATED GRIDPOINTS - PARAMETER(MAXGRID=2048) -C -C Arguments: -C - INTEGER TEAR_I(0:3) !AREA in edge-format -C - CHARACTER*(*) MID !MAP ID - CHARACTER*(*) SID !MAP SUB-ID -C - INTEGER IPOL !CURRENT POLARISATION - INTEGER IFR !CURRENT INTERFEROMETER - INTEGER CCHAN !CURRENT CHANNEL -C -C Entry points: -C - LOGICAL NGITRA !Transfer data, write ID - LOGICAL NGICLR !Deallocate any memory etc - LOGICAL NGICOV !Clear overlay planes - LOGICAL NGISFL !Handle flags -C -C Function references: -C - INTEGER N_GDI_CINFO,N_GDI_DEFIMG,N_GDI_IMWRITE - INTEGER N_GDI_SETXGRID, N_GDI_SETYGRID - INTEGER N_GDI_IMMID,N_GDI_IMSID - INTEGER N_GDI_GRON, N_GDI_GRCOL, N_GDI_GRWRITE, N_GDI_GRREAD - INTEGER N_GDI_GRCLEAR, N_GDI_GRREGION - LOGICAL NFLFL1 !WRITE FLAG ENTRY - LOGICAL WNGGVM !GET VIRTUAL MEMORY - LOGICAL WNCALN - LOGICAL WNDPAR !GET User Input -C -C Data declarations: -C - INTEGER GLO(2),GHI(2) !GIDS image boundaries - INTEGER XX,YY !Counters in flags array - REAL RBUF(3) !RGB VALUES - REAL RDAT !DATA VALUE - CHARACTER CGRID(0:MAXGRID-1)*7 !GRID DESCRIPTION - REAL BSCALE,BZERO !SCALES FOR GIDS - INTEGER NCOL !NUMBER OF COLORS AVAILABLE -C - LOGICAL COLSET !HAVE COLORS BEEN SET? - DATA COLSET/.FALSE./ !INITIALLY NOT (OF COURSE) - INTEGER SAVPOL !PREVIOUS POLARISATION - DATA SAVPOL/-9999/ !NONE - INTEGER SAVCHAN !PREVIOUS CHANNEL - DATA SAVCHAN/-9999/ !NONE - SAVE COLSET,SAVPOL,SAVCHAN !REMEMBER -C - REAL CLEVEL !Clip level for flagging - INTEGER ILEVEL !Level after scaling -C - REAL BASEL(0:STHTEL*STHTEL-1) !BASELINE LNGTHS (FOR SORT) -C - BYTE FLF(0:FLFHDL-1) !FLAG ENTRY - INTEGER*2 FLFI(0:FLFHDL/LB_I-1) - INTEGER FLFJ(0:FLFHDL/LB_J-1) - REAL FLFE(0:FLFHDL/LB_E-1) - EQUIVALENCE(FLF,FLFI,FLFJ,FLFE) -C- - NGISET=.TRUE. !ASSUME OK - SAVPOL=-9999 !NO PREVIOUS - SAVCHAN=-9999 !NO PREVIOUS -C -C Obtain minimum and maximum color value. -C - E_C=N_GDI_CINFO(GID,MINCOL,MAXCOL,NCOL,BLANK) - IF (E_C.LT.0) GOTO 990 !ERROR -C -C Define and clear graphics planes for existing and new flags flags -C - CALL N_GDI_GINFO(GID,I1,I2) - IF (I2.NE.7) THEN - E_C=N_GDI_GRON(GID,7) !PLANE=1:old, 2:fresh, 4:new - IF (E_C.LT.0) GOTO 990 !ERROR - END IF -C - IF (.NOT.COLSET) THEN - COLSET=.TRUE. -C - I1=1 - RBUF(1)=0.75 !COLOR OF PLANE - RBUF(2)=0.0 - RBUF(3)=0.25 - E_C=N_GDI_GRCOL(GID,I1,RBUF(1),RBUF(2),RBUF(3)) - IF (E_C.LT.0) GOTO 990 !ERROR -C - I1=2 - RBUF(1)=0.25 !COLOR OF PLANE - RBUF(2)=0.0 - RBUF(3)=0.75 - E_C=N_GDI_GRCOL(GID,I1,RBUF(1),RBUF(2),RBUF(3)) - IF (E_C.LT.0) GOTO 990 !ERROR -C - I1=3 - RBUF(1)=0.25 !COLOR OF PLANE - RBUF(2)=0.75 - RBUF(3)=0.0 - E_C=N_GDI_GRCOL(GID,I1,RBUF(1),RBUF(2),RBUF(3)) - IF (E_C.LT.0) GOTO 990 !ERROR -C - END IF -C -C Inform GIDS about map size and scale if these are new values. -C - IF (DEFIMG.OR. - 1 (TEAR_I(1)-TEAR_I(0)+1)/COMPR.NE.XSIZ.OR. - 1 (TEAR_I(3)-TEAR_I(2)+1)/COMPR.NE.YSIZ ) THEN -C -C Define scales based on range -C - RDAT=FLOAT(MAXCOL-MINCOL) - BSCALE=(RANGE(2)-RANGE(1))/RDAT !SCALE FACTOR - BZERO=(MAXCOL*RANGE(1)-MINCOL*RANGE(2))/RDAT - CSCALE=1.0/BSCALE - CZERO=(MAXCOL*RANGE(1)-MINCOL*RANGE(2))/(RANGE(1)-RANGE(2)) -C -C Define the image-size for GIDS -C - GLO(1)=TEAR_I(0)/COMPR - GLO(2)=TEAR_I(2)/COMPR - GHI(1)=GLO(1)+(TEAR_I(1)-TEAR_I(0)+1)/COMPR-1 - GHI(2)=GLO(2)+(TEAR_I(3)-TEAR_I(2)+1)/COMPR-1 -C -C Inform GIDS about those values (this will reset the zooming!) -C - E_C=N_GDI_DEFIMG(GID,GLO,GHI,BSCALE,BZERO) - IF (E_C.LT.0) GOTO 990 !ERROR - DEFIMG=.FALSE. !Done -C -C Initialise some local parameters -C - XSIZ=GHI(1)-GLO(1)+1 !NR MEMORY PIXELS/LINE - YSIZ=GHI(2)-GLO(2)+1 !NR OF LINES IN THE MAP - AVGFAC=1./COMPR**2 !AVERAGING FACTOR -C -C Define the grid if IFRS or CHAN -C - IF (MAPTYP.EQ.'IFRS'.OR.MAPTYP.EQ.'BASE'.OR. - 1 MAPTYP.EQ.'CHAN') THEN - DO I1=0,MIN(XSIZ,MAXGRID)-1 - WRITE(CGRID(I1),'(F7.2)') - 1 360.0*(HARAN(0)+HAINC*FLOAT(I1)) - END DO - I1=MIN(XSIZ,MAXGRID) - E_C=N_GDI_SETXGRID(GID,I1,CGRID) - END IF - IF (MAPTYP.EQ.'IFRS'.OR.MAPTYP.EQ.'BASE') THEN !Show ifr's - DO I1=0,STHTEL*STHTEL-1 !Init: none - IFRLUT(I1)=-1 - BASEL(I1)=10.E10 - END DO - DO I1=0,STHTEL-1 - DO I2=0,STHTEL-1 !No line known yet - IDXLUT(I1,I2)=0 - END DO - DO I2=I1,STHTEL-1 !Fill with normal order - IFRLUT(I2*STHTEL+I1)=I2*256+I1 - BASEL( I2*STHTEL+I1)=TELPOS(I1)-TELPOS(I2) - END DO - END DO - IF (MAPTYP.EQ.'BASE') THEN !Sort on baseline - DO I=0,STHTEL*STHTEL-2 - DO I1=0,STHTEL*STHTEL-2-I - IF (ABS(BASEL(I1)-BASEL(I1+1)).GT.1.AND. - 1 BASEL(I1).LT.BASEL(I1+1)) THEN !Swap - R0=BASEL(I1) - BASEL(I1)=BASEL(I1+1) - BASEL(I1+1)=R0 - I2=IFRLUT(I1) - IFRLUT(I1)=IFRLUT(I1+1) - IFRLUT(I1+1)=I2 - END IF - END DO - END DO - END IF - DO I=0,STHTEL*STHTEL-1 !Make linenumbers and strings - IF (IFRLUT(I).LT.0) THEN - CGRID(I)=' ' - ELSE - I1=MOD(IFRLUT(I),256) - I2=IFRLUT(I)/256 - IDXLUT(I1,I2)=I - CGRID(I)='Ifr '//TELNAM(I1+1:I1+1)// - 1 TELNAM(I2+1:I2+1) - END IF - END DO - I1=STHTEL*STHTEL !Pass to GIDS - E_C=N_GDI_SETYGRID(GID,I1,CGRID) - ELSE IF (MAPTYP.EQ.'CHAN') THEN - DO I1=0,YSIZ-1 - WRITE(CGRID(I1),'(A3,I4)') 'Ch ',RCHAN(0)+I1 - END DO - E_C=N_GDI_SETYGRID(GID,YSIZ,CGRID) - END IF - END IF -C -C Get memory for the map if not already there -C - IF (DMAP.EQ.0.OR.DFLG.EQ.0.OR.XSIZ*YSIZ.GT.LBUF) THEN - IF (DMAP.NE.0) CALL WNGFVM(LBUF,DMAP+A_OB) !FREE BUFFERS - IF (DFLG.NE.0) CALL WNGFVM(LBUF,DFLG+A_OB) - DMAP=0 - DFLG=0 -C - LBUF=XSIZ*YSIZ - IF (.NOT.WNGGVM(LBUF,DMAP)) THEN !GET AREA FOR DATA - CALL WNCTXT(F_TP,'Cannot allocate memory buffer') - GOTO 990 - END IF - DMAP=(DMAP-A_OB) !ARRAY POINTER - DO I=0,LBUF-1 - A_B(DMAP+I)=BLANK - END DO -C - IF (MAPTYP.NE.'MAP') THEN - IF (.NOT.WNGGVM(LBUF,DFLG)) THEN !GET AREA FOR FLAGS - CALL WNCTXT(F_TP,'Cannot allocate memory buffer') - CALL WNGFVM(LBUF,DMAP+A_OB) !FREE BUFFER - DMAP=0 - GOTO 990 - END IF - DFLG=(DFLG-A_OB) !ARRAY POINTER - DO I=0,LBUF-1 - A_B(DFLG+I)=0 - END DO - END IF - END IF -C - RETURN -C -C Entry NGITRA transfers data and writes two ID's to GIDS header -C - ENTRY NGITRA(MID,SID) -C - NGITRA=.TRUE. -C -C Write the map from the byte-buffer -C - E_C=N_GDI_IMWRITE(GID,A_B(DMAP),XSIZ*YSIZ,0) - IF (E_C.LT.0) THEN - CALL WNCTXT(F_TP,'Cannot write map-data') - GOTO 990 - END IF -C -C Write the image identification (Max. 15 characters are possible). -C - I2=WNCALN(MID) - I1=MAX(1,I2-14) - I0=N_GDI_IMMID(GID,MID(I1:I2)) - I0=N_GDI_IMSID(GID,SID( :MIN(15,LEN(SID)) )) -C -C Write graphics plane for existing flags -C - IF (DFLG.NE.0) THEN - E_C=N_GDI_GRWRITE(GID,A_B(DFLG),XSIZ*YSIZ,0) - IF (E_C.LT.0) THEN - CALL WNCTXT(F_TP,'Cannot write graphics plane') - GOTO 990 - END IF - END IF -C - RETURN -C -C Entry NGICLR clears virtual memory -C - ENTRY NGICLR -C - NGICLR=.TRUE. - IF (DMAP.NE.0) CALL WNGFVM(LBUF,DMAP+A_OB) !FREE BUFFERS - IF (DFLG.NE.0) CALL WNGFVM(LBUF,DFLG+A_OB) - DMAP=0 - DFLG=0 -C - RETURN -C - ENTRY NGICOV(IPOL,CCHAN) -C -C Clear map data and flags, keep "fresh" flags if ALLCH set -C - DO I=0,LBUF-1 - A_B(DMAP+I)=BLANK - END DO -C - I1=2 !Keep plane 2 and bit 4-7 - IF (.NOT.ALLCH) THEN !Not all channels the same - IF (CCHAN.NE.SAVCHAN) I1=0 !Keep nothing if not same - END IF ! channel as previous - SAVCHAN=CCHAN -C - IF (.NOT.ALLPOL) THEN !Not all pol's the same - IF (IPOL.NE.SAVPOL) I1=0 !Keep nothing if not same - END IF ! pol as previous - SAVPOL=IPOL -C - DO I=0,LBUF-1 - I3=A_B(DFLG+I) - A_B(DFLG+I)=IAND(I3,I1) - END DO -C - RETURN -C - ENTRY NGISFL(IPOL,IFR,CCHAN) -C - NGISFL=.TRUE. !ASSUME ALL RIGHT -C -C Fill in the fixed part of the flag entry -C - FLFJ(FLF_FLAG_J)=IAND(FL_ALL,UFL) !FILL FLAG TO USE -C - IF (ALLPOL) THEN - FLFI(FLF_POL_I)=-1 !ALL POLS - ELSE - FLFI(FLF_POL_I)=IPOL !POL.CODE - END IF -C - IF (ALLCH) THEN - FLFJ(FLF_CHAN_J)=-1 !ALL CHANNELS - ELSE IF (MAPTYP.EQ.'IFRS'.OR.MAPTYP.EQ.'BASE') THEN - FLFJ(FLF_CHAN_J)=CCHAN !THIS CHANNEL ONLY - END IF -C - IF (MAPTYP.EQ.'CHAN') FLFI(FLF_IFR_I)=IFR !THIS IFR ONLY -C -C Either use regions or cliplevel -C - IF (DO_CLIP) THEN -C -C Get the cliplevel -C - 300 CONTINUE - IF (.NOT.WNDPAR('CLIP_LEVEL',CLEVEL,LB_E,J0,'""')) THEN - IF (E_C.EQ.DWC_ENDOFLOOP) RETURN !NO FLAGS SET - GOTO 300 !RETRY - ELSE IF (E_C.EQ.DWC_NULLVALUE.OR.J0.EQ.0) THEN - RETURN !NO FLAGS SET - ELSE IF (E_C.EQ.DWC_WILDCARD) THEN - GOTO 300 !MUST SPECIFY - END IF - ILEVEL=NINT(CLEVEL*CSCALE+CZERO) !SCALE AS GIDS DATA -C -C Go through the data and the graphics plane -C - I1=0 !NUMBER OF FLAGS SET - DO XX=0,XSIZ-1 - DO YY=0,YSIZ-1 - I3=A_B(DFLG+YY*XSIZ+XX) !FLAG FOR PIXEL - I4=A_B(DMAP+YY*XSIZ+XX) !VALUE OF PIXEL - IF (I4.LT.0) I4=I4+256 !CORRECT FOR SIGNED BYTE - IF (I4.NE.BLANK.AND.I4.GE.ILEVEL.AND. - 1 IAND(I3,2).EQ.0) THEN !FOUND NEW FLAG - I1=I1+1 - FLFE(FLF_HA_E)=XX*HAINC+HARAN(0) !HA of pixel -C -C IFRS/BASE mode: get IFR and mark pixel as freshly flagged -C - IF (MAPTYP.EQ.'IFRS'.OR.MAPTYP.EQ.'BASE') THEN - FLFI(FLF_IFR_I)=IFRLUT(YY) !IFR of pixel - A_B(DFLG+YY*XSIZ+XX)=IAND(I3,1)+2 -C -C CHAN mode and ALLCH: mark all channels as freshly flagged -C - ELSE IF (ALLCH) THEN - DO I2=0,YSIZ-1 - A_B(DFLG+YY*XSIZ+XX)=IAND(I3,1)+2 - END DO -C -C CHAN mode and .NOT.ALLCH: get channel for this map -C - ELSE - FLFJ(FLF_CHAN_J)=YY+RCHAN(0) !THIS CHANNEL ONLY - END IF - IF (.NOT.NFLFL1(DFAR,FLF)) - 1 CALL WNCTXT(F_TP,'Error writing FLF entry') - END IF - END DO - END DO -C - ELSE -C -C Enter regions mode -C - CALL WNCTXT(F_T,'Press DEFINE to start, READY when done') - I1=4 - E_C=N_GDI_GRREGION(GID,I1) - IF (E_C.LT.0) GOTO 990 !ERROR -C -C Read back the graphics plane -C - E_C=N_GDI_GRREAD(GID,A_B(DFLG),XSIZ*YSIZ,0) - IF (E_C.LT.0) THEN - CALL WNCTXT(F_TP,'Cannot read graphics plane') - GOTO 990 - END IF -C -C Scan every pixel and output the appropriate flag word -C - I1=0 !NUMBER OF FLAGS SET - DO XX=0,XSIZ-1 - DO YY=0,YSIZ-1 - I3=A_B(DFLG+YY*XSIZ+XX) - IF (A_B(DMAP+YY*XSIZ+XX).NE.BLANK.AND. - 1 IAND(I3,4).NE.0.AND.IAND(I3,2).EQ.0) THEN !FOUND NEW FLAG - I1=I1+1 - FLFE(FLF_HA_E)=XX*HAINC+HARAN(0) !HA of pixel -C -C IFRS/BASE mode: get IFR and mark pixel as freshly flagged -C - IF (MAPTYP.EQ.'IFRS'.OR.MAPTYP.EQ.'BASE') THEN - FLFI(FLF_IFR_I)=IFRLUT(YY) !IFR of pixel - A_B(DFLG+YY*XSIZ+XX)=IAND(I3,1)+2 -C -C CHAN mode and ALLCH: mark all channels as freshly flagged -C - ELSE IF (ALLCH) THEN - DO I2=0,YSIZ-1 - A_B(DFLG+YY*XSIZ+XX)=IAND(I3,1)+2 - END DO -C -C CHAN mode and .NOT.ALLCH: get channel for this map -C - ELSE - FLFJ(FLF_CHAN_J)=YY+RCHAN(0) !THIS CHANNEL ONLY - END IF - IF (.NOT.NFLFL1(DFAR,FLF)) - 1 CALL WNCTXT(F_TP,'Error writing FLF entry') - END IF - END DO - END DO - END IF -C -C If Flags found, rewrite graphics plane -C - CALL WNCTXT(F_T,'Found !UJ new flags',I1) - IF (I1.NE.0) THEN - I1=2 - E_C=N_GDI_GRWRITE(GID,A_B(DFLG),XSIZ*YSIZ,0) - IF (E_C.LT.0) THEN - CALL WNCTXT(F_TP,'Cannot rewrite graphics plane') - GOTO 990 - END IF - END IF -C - RETURN -C -C Errors for all entry points -C - 990 CONTINUE - NGISET=.FALSE. -C - RETURN - - END diff --git a/src/nplot/npl.dsc b/src/nplot/npl.dsc deleted file mode 100644 index 51719bc56e9b9fde25f7a41b2d0254efa318f4d3..0000000000000000000000000000000000000000 --- a/src/nplot/npl.dsc +++ /dev/null @@ -1,169 +0,0 @@ -!+ NPL.DSC -! WNB 910617 -! -! Revisions: -! -%REVISION=WNB=990723="Change MXNCH to 8192 from 2048 for long 10s files" -%REVISION=JPH=961115="Add HAINT" -%REVISION=JPH=960805="Add ANNOTN. Add ST_INIT" -%REVISION=JPH=960619="ST_MODE integer" -%REVISION=JPH=960402="Add ST_MODE" -%REVISION=HjV=950711="Add PLTHDR" -%REVISION=CMV=940713="Add NO_MORE and MAPDTYP" -%REVISION=CMV=940713="Changed MAXCHN from 1024 to 2048" -%REVISION=CMV=940426="Add IF_MODE" -%REVISION=CMV=940420="Make PLTSRC J" -%REVISION=HjV=940224="Add MOSAIK" -%REVISION=HjV=940124="Add several variables" -%REVISION=HjV=931126="Add DATA_TYPES AP and CS, so change MXNDTP to 6" -%REVISION=WNB=930824="Change STELS type" -%REVISION=WNB=930803="Remove .INCLUDE" -%REVISION=WNB=920901="Add MXNCHN" -%REVISION=WNB=911220="Add polarisation and ruled surface" -%REVISION=WNB=910617="Original version" -! -! Layout of overall include file (NPL.DEF) -! -%COMMENT="NPL.DEF is an INCLUDE file for the NPLOT program" -%COMMENT=" " -! -%VERSION=1 -%SYSTEM=1 -%USER=WNB -%%DATE -%%NAME -%LOCAL=MXNSET=16 !MAX. # OF SETS PER INPUT JOB -%LOCAL=MXNPAG=6 !MAX. # OF PAGES PER PLOT -%LOCAL=MXNDTP=6 !MAX. # OF DATA TYPES -%LOCAL=MXNC=32 !MAX. # OF CONTOURS PER TYPE -%LOCAL=MXNTRF=256 !LENGTH HALFTONE TRANFORMATION -%LOCAL=MXNCHN=8192 !MAX. # OF CHANNELS -%LOCAL=STHTEL=14 !# OF TEL. -%LOCAL=STHIFR=STHTEL*(STHTEL+1)/2 !# OF IFRS -!- -.DEFINE - .PARAMETER - MXNSET J /MXNSET/ !MAX. # OF SETS PER PLOT - MXNDTP J /MXNDTP/ !MAX. # OF DATA TYPES - MXNPAG J /MXNPAG/ !MAX. OF SIMULTANEOUS PAGES - MXNC J /MXNC/ !MAX. # OF CONTOURS PER TYPE - MXNTRF J /MXNTRF/ !LENGTH HALFTONE TRANSFORM - MXNCHN J /MXNCHN/ !MAX. # OF CHANNELS PER PLOT - XFAC E /4./ !MM TO UNITS X DIRECTION - YFAC E /4./ !MM TO UNITS Y DIRECTION - TXTHGT E /9./ !HEIGHT TEXT - XWND E /1056./ !NORMAL RECTANGLE - YWND E /780./ - XWM1 E /XWND-1./ - YWM1 E /YWND-1./ - ASPECT E /"YWND/XWND"/ !ASPECT RATIO - STASP E /"0.1/ASPECT"/ !SMALL NDC MAP - .DATA -! -! Local variables: -! - .COMMON - OPTION C24 !PROGRAM OPTION - OPT=OPTION C3 - PLDEV C8 !PLOT DEVICE - IFR_MODE C16 !NORMAL, SPECTRAL, SORT - ST_MODE I ! HA_MODE selection: - ! 0=HA, 1=ST, -1=SEQUENCE - ST_INIT I ! HA_MODE init. control - HAINT E ! integration interval - IF_MODE C8 !TPON, TPOFF, ... - LFLDS J(0:1) !LOOP OUTPUT FIELDS - LCHANS J(0:1) !LOOP OUTPUT CHANNELS - NODIN C80 !INPUT NODE - FILIN C160 !INPUT FILE - FCAIN J !INPUT FCA - SETS J(0:7,0:MXNSET) !SETS PER PLOT - ASET J(0:1,1:MXNSET) !POL. ANGLE SETS - SETNAM J(0:7) !SET NAME - HARA E(0:1) !HA-RANGE PER PLOT - HASC E !SCALE HA - SCAL E(2) !PLOT SCALE - SIFRS B(0:STHTEL-1,0:STHTEL-1) !SELECT INTERFEROMETERS - STELS B(0:STHTEL-1) !SELECT TELESCOPES - - B(20-STHTEL) !FILL TO ALIGN WITH PREVIOUS - POLC C4 !POLARISATION CODE - SPOL J !POLARISATION BITS - CORAP J !CORRECTIONS TO APPLY - CORDAP J !CORRECTIONS TO DE-APPLY - NDATTP J !# OF DATA TYPES WANTED - DATTYP C16(MXNDTP) !DATA TYPES TO DO - MAPDTYP C16 !IDEM FOR MAPS - PTYP J(1:MXNSET) !POL. TYPE TO DO - !BIT 0: CONT - !BIT 1: HALF - !BIT 2: POL - !BIT 3: RULE - PPP J(2) !PLOTS PER PAGE - PPPNR J !PLOT NUMBER PER PAGE - PLOTAP L !TRUE=AP OR CS, FALSE=A,P,C OR S - FNAM C12 !FIELDNAME - OBSDY I(2) !OBSERVATION DAY/YEAR - PLUVO L !IFR_MODE = SPECTRAL - MOSAIK L !MOSAICK OBSERVATION - TAREA J(0:3) !AREA TO PLOT - PAREA J(0:3) - TEAR J(0:3) - PEAR J(0:3) - RTEAR J(0:3) !RULED SURFACE AREA - PTEAR J(0:3) !POL. AREA - SIZE E(2) !MAP PLOT SIZE - NCF J !# OF FULL CONTOURS - NCD J !# OF DOTTED CONTOURS - FCONT E(MXNC) !FULL CONTOURS - DCONT E(MXNC) !DOTTED CONTOURS - HALF J !HALFTONE TYPE - POLMAG L !POL. AS MAGNETIC FIELD - RANGE E(2) !HALFTONE RANGE - PRANGE E(2) !POL. RANGE - RRANGE E(2) !RULED RANGE - PSCAL E !POL. SCALE - RSCAL E !RULED SCALE - CRD J !COORDINATE TICK TYPE - CRDTYP J !LINE TYPE COORDINATES - TRF E(0:MXNTRF) !HALFTONE TRANSFORM - PLTSRC J !SOURCES WANTED IN PLOT - PLTHDR L !PLOT HEADING -! -! History -! - ANNOTN C80 !user's annotation -! Loops -! - LPOFF J(0:7) !CURRENT SET OFFSETS -! -! Plot parameters -! - DQID J(MXNPAG) !PLOT AREA'S - DQID2 J(MXNPAG/2,MXNPAG/2) - NPAG J !# OF PAGES IN CURRENT PLOT - WINDOW E(2,2) /0.,0.,XWM1,YWM1/ !WC WINDOW - VIEW E(2,2) /0.,0.9,STASP,1./ !NDC VIEWPORT - DVWIN E(2,2) !DEVICE WINDOW - PG E(2,5) !TEXT CROSSES - TXTXY E(4) !TEXT STRING POSITIONS - POINXY E(2,2) !BEGIN/END POINTS - NO_MORE L !ABORT PLOTTING -! -! Plot data -! - IFOFF J(0:MXNCHN-1) !OFFSET PER PLOT - NEW E(0:MXNCHN-1) !DATA POSITION - OLD E(0:MXNCHN-1) !DATA POSITION - TEXT C132 !PLOT TEXT - TXT CMXNCHN(2) !ANNOTATION TEXT - TELNAM CSTHTEL /0123456789ABCD/ !TEL. NAMES -! -! Map info -! - MPMXMN E(2) !MAX./MIN. IN MAP -! -! Source data -! - NSRC J(0:2) !SOURCE COUNTS -! -.END diff --git a/src/nplot/npl.grp b/src/nplot/npl.grp deleted file mode 100644 index 10fb9c738889bf954d92e077c530e8a4d98fda6a..0000000000000000000000000000000000000000 --- a/src/nplot/npl.grp +++ /dev/null @@ -1,58 +0,0 @@ -!+ NPL.GRP -! WNB 910617 -! -! Revisions: -! WNB 921211 Add PSC -! HjV 931202 Change NPLMAP.FOR to NPLMAP.FSC -! HjV 940202 Split NPLRES/NPLTEL in several routines and -! add new routines for new options. -! CMV 940822 All closing of plot devices in NPLCLO -! JPH 941206 PLOTTER.PEF -! HjV 960620 Add NPLSST.FOR -! -! Data/map plotting -! -! Group definition: -! -NPL.GRP -! -! PIN files -! -NPLOT.PSC -PLOTTER.PEF -! -! Structure files -! -! -! Fortran definition files: -! -NPL.DSC ! Program common/parameters -! NPL.DEF ! Fortran include -! NPL.INC ! C include -! -! Programs: -! -NPLOT.FOR ! Main routine -NPLBAP.FOR !NPLBAP Plot box ap/cs plots -NPLCLO.FOR !NPLCLO Close plot device (option to abort) -NPLCON.FOR !NPLCON Plot connection lines -NPLDAT.FOR !NPLDAT Get program data -NPLDCH.FOR !NPLDCH Load data as (ha, chan) -NPLDHA.FOR !NPLDHA Load data as (chan, ifr) -NPLDIF.FOR !NPLDIF Load data as (ha, ifr) -NPLINI.FOR !NPLINI Init program -NPLLOD.FOR !NPLLOD Load data -NPLMAP.FSC !NPLMAP Plot maps -NPLONE.FOR !NPLONE Plot A/P/C/S -NPLOPN.FOR !NPLOPN Open plot and plot heading -NPLPBE.FOR !NPLPBE Plot polyline at begin/end A/P/C/S plot -NPLPLT.FOR !NPLPLT Do actual plotting -NPLRES.FOR !NPLRES Fill buffer with intf. (residual) data -NPLSST.FOR !NPLSST Calculate sidereal time -NPLTEL.FOR !NPLTEL Fill buffer with telescope data -NPLTWO.FOR !NPLTWO Plot AP/CS -! -! Executables -! -NPLOT.EXE ! Map handling -!- diff --git a/src/nplot/nplbap.for b/src/nplot/nplbap.for deleted file mode 100644 index 519d071453c643f84b07a974435f501683a7f33b..0000000000000000000000000000000000000000 --- a/src/nplot/nplbap.for +++ /dev/null @@ -1,279 +0,0 @@ -C+ NPLBAP.FOR -C HjV 931115 -C -C Revisions: -C HjV 940602 Add some more text when more than one plot per page -C - SUBROUTINE NPLBAP (LDATTP,IPOL,PTXT,NHV,MINMAX,NHACH) -C -C Plot box ampl./phase plots per IFR on same page (old PLOTAP) -C -C Result: -C -C CALL NPLBAP Plot ampl./phase on same page -C -C -C Include files: -C - INCLUDE 'WNG_DEF' - INCLUDE 'NPL_DEF' -C -C Parameters: -C -C -C Arguments: -C - INTEGER LDATTP !CURRENT DATA TYPE - INTEGER IPOL - INTEGER PTXT(MXNCHN) !CROSS CHANNELS - INTEGER NHV(0:1) !# PAGES - REAL MINMAX(2,2) !MIN./MAX. AMPL/COS AND PHASE/SIN - INTEGER NHACH !# OF HARA OR CHANNELS -C -C Function references: -C - INTEGER WNMEJC !CEIL(X) - INTEGER WNMEJF !FLOOR(X) -C -C Data declarations: -C - REAL STEP(2) !X,Y DISTANCE BETWEEN POINTS - LOGICAL UVPL !UV-PLANE OUTPUT - REAL YSIZ - REAL R2,R3,R4 - REAL STVAL,LENYAS,LENMM,INCRYAS - INTEGER AXINT !AXIS INTERVAL FOR BAND-OPTION - CHARACTER*2 POLNAM(0:3) !NAME OF POLARISATION - DATA POLNAM/'XX','XY','YX','YY'/ -C- -C -C INITIALIZE -C -C - DO I0=1,2 - POINXY(1,1)=PAREA(0) - POINXY(2,1)=PAREA(1) - POINXY(1,2)=PAREA(2) - POINXY(2,2)=PAREA(3) - CALL WQ_MPLR(DQID2,NHV,1,1,1.,0) !SET LINE REPRESENTATION - CALL WQ_MPLR(DQID2,NHV,3,3,1.,0) - YSIZ=(POINXY(2,2)-POINXY(2,1))/2.+25./PPP(2) !BOTTOM LEFT CORNER -C -C GRID -C - CALL WQSTXX(1.) !CHARACTER EXPANSION - CALL WQSPLI(1) - IF (I0.EQ.1) THEN !AMPL - POINXY(2,1)=PAREA(1)+YSIZ !Y LEFT/RIGHT BOTTOM - ELSE !PHASE - POINXY(2,2)=PAREA(3)-YSIZ !Y LEFT/RIGHT TOP - ENDIF - PG(1,1)=POINXY(1,1) !X LEFT TOP/BOTTOM - PG(2,1)=POINXY(2,1) !Y LEFT/RIGHT TOP - PG(1,2)=POINXY(1,2) !X RIGHT TOP/BOTTOM - PG(2,2)=PG(2,1) - PG(1,3)=PG(1,2) - PG(2,3)=POINXY(2,2) !Y LEFT/RIGHT BOTTOM - PG(1,4)=PG(1,1) - PG(2,4)=PG(2,3) - PG(1,5)=PG(1,1) - PG(2,5)=PG(2,1) - CALL WQ_MPLR(DQID2,NHV,1,1,2.,0) !THICK LINE - CALL WQPOLL(5,PG) !BOX - CALL WQ_MPLR(DQID2,NHV,1,1,1.,0) !NORMAL LINE -C -C AMPL./COS. OR PHASE/SIN INFO -C - CALL WQSTXH(TXTHGT*2./PPP(1)) !TEXT HEIGHT - TXTXY(1)=POINXY(1,2)+10./PPP(1) - TXTXY(2)=POINXY(2,2)-10./PPP(2) - IF ((PPP(1).GT.1).OR.(PPP(2).GT.1)) THEN - TEXT=DATTYP(LDATTP)(I0:I0)//' '//TXT(1)(1:1)// - 1 TXT(2)(1:1)//'-'//POLNAM(IPOL) - CALL WQTEXT(TXTXY,TEXT(1:7)) - ELSE - CALL WNCTXS(TEXT,'!1$AS',DATTYP(LDATTP)(I0:I0)) - CALL WQTEXT(TXTXY,TEXT(1:1)) - END IF - CALL WQSTXH(TXTHGT/PPP(1)) !TEXT HEIGHT STANDARD - CALL WNCTXS(TEXT,'MAX: !7$E7.2',MINMAX(2,I0)) - TXTXY(1)=POINXY(1,2)+10./PPP(1) - TXTXY(2)=POINXY(2,2)-30./PPP(2) - CALL WQTEXT(TXTXY,TEXT(1:12)) - CALL WNCTXS(TEXT,'MIN: !7$E7.2',MINMAX(1,I0)) - TXTXY(1)=POINXY(1,2)+10./PPP(1) - TXTXY(2)=POINXY(2,2)-45./PPP(2) - CALL WQTEXT(TXTXY,TEXT(1:12)) - END DO -C -C HA ANNOTATION (X-AXIS) -C - IF (IFR_MODE.EQ.'BAND') THEN - IF (NHACH.EQ.1) THEN - AXINT=PAREA(2)-PAREA(0) - ELSE - AXINT=(PAREA(2)-PAREA(0))/(NHACH-1) - END IF - J1=1 - DO WHILE ((AXINT*J1).LT.15) - J1=J1*2 - END DO - CALL WQSTXH(TXTHGT/PPP(1)) !TEXT HEIGHT STANDARD - POINXY(2,2)=PAREA(1)+YSIZ !Y LEFT/RIGHT BOTTOM AMPL - R2=5./PPP(2) - DO I0=0,NHACH-1,J1 - CALL WNCTXS (TEXT,'!4$UJ',PTXT(I0+1)) !CHANNEL NAME - TXTXY(1)=PAREA(0)+I0*AXINT-TXTHGT/PPP(1) - TXTXY(2)=POINXY(2,2)-30./PPP(2)+R2 - CALL WQTEXT(TXTXY,TEXT) - R2=R2*-1. - DO I1=0,1 - PG(1,1)=POINXY(1,1)+I0*AXINT - PG(2,1)=POINXY(2,2)-(I1*40./PPP(2)) !PLOT 0.25 CM. LINE (Y) - PG(1,2)=PG(1,1) - PG(2,2)=PG(2,1)-10./PPP(2) - CALL WQPOLL(2,PG) !POLYLINE - END DO - END DO - ELSE - R0=10.*HASC !DEGREE PER CM - IF (R0.LE..1) THEN - R4=.1 - ELSE IF (R0.LE..2) THEN - R4=.2 - ELSE IF (R0.LE..5) THEN - R4=.5 - ELSE IF (R0.LE.1.) THEN - R4=1. - ELSE IF (R0.LE.2.) THEN - R4=2. - ELSE IF (R0.LE.5.) THEN - R4=5. - ELSE IF (R0.LE.10.) THEN - R4=10. - ELSE IF (R0.LE.15.) THEN - R4=15. - ELSE IF (R0.LE.20.) THEN - R4=20. - ELSE IF (R0.LE.30.) THEN - R4=30. - ELSE IF (R0.LE.45.) THEN - R4=45. - ELSE - R4=90. - END IF - CALL WQSTXH(TXTHGT/PPP(1)) !TEXT HEIGHT STANDARD - POINXY(2,2)=PAREA(1)+YSIZ !Y LEFT/RIGHT BOTTOM AMPL - R2=5./PPP(2) - DO R1=WNMEJC(360.*HARA(0)/R4)*R4, - 1 WNMEJF(360.*HARA(1)/R4)*R4,R4 !DRAW HA MARKS - CALL WNCTXS(TEXT,'!5$E5.1',R1) - TXTXY(1)=TAREA(0)+50./PPP(1)+(R1-360.*HARA(0))/HASC* - 1 XFAC-TXTHGT/(18./7./PPP(1)) - TXTXY(2)=POINXY(2,2)-30./PPP(2)+R2 - CALL WQTEXT(TXTXY,TEXT(1:5)) - R2=R2*-1. - DO I1=0,1 - PG(1,1)=POINXY(1,1)+(R1-360.*HARA(0))/HASC*XFAC - PG(2,1)=POINXY(2,2)-(I1*40./PPP(2)) !PLOT 0.25 CM. LINE (Y) - PG(1,2)=PG(1,1) - PG(2,2)=PG(2,1)-10./PPP(2) - CALL WQPOLL(2,PG) !POLYLINE - END DO - END DO - END IF -C -C AMPL/PHASE ANNOTATION (Y-AXIS) -C - DO I0=1,2 - MINMAX(1,I0)=NINT(MINMAX(1,I0)-.5)*1. !MIN. - MINMAX(2,I0)=NINT(MINMAX(2,I0)+.5)*1. !MAX. - END DO - INCRYAS=50./PPP(2) - DO I0=1,2 - POINXY(1,1)=PAREA(0) - POINXY(2,1)=PAREA(1) - POINXY(1,2)=PAREA(2) - POINXY(2,2)=PAREA(3) - IF (I0.EQ.1) THEN !AMPL - POINXY(2,1)=PAREA(1)+YSIZ !Y LEFT/RIGHT BOTTOM - ELSE !PHASE - POINXY(2,2)=PAREA(3)-YSIZ !Y LEFT/RIGHT TOP - ENDIF - LENYAS=YSIZ-50./PPP(2) !LENGTH Y-AX - LENMM=MINMAX(2,I0)-MINMAX(1,I0) !MAX-MIN - R1=LENMM/LENYAS - R2=-1. - R3=.001 - DO WHILE (R2.LT.0.) - R3=R3*10. - IF (R1.LE.(R3*.1)) THEN - R2=R3*.1 - ELSE IF (R1.LE.(R3*.2)) THEN - R2=R3*.2 - ELSE IF (R1.LE.(R3*.5)) THEN - R2=R3*.5 - END IF - END DO - R1=((R2*LENYAS)-LENMM)/2. - MINMAX(1,I0)=MINMAX(1,I0)-R1 - MINMAX(2,I0)=MINMAX(2,I0)+R1 - LENMM=MINMAX(2,I0)-MINMAX(1,I0) !MAX-MIN - STVAL=MOD((LENYAS/2.),INCRYAS) !START VALUE - DO R1=STVAL,LENYAS,INCRYAS !DRAW HA MARKS AND TEXT - R2=MINMAX(2,I0)-LENMM*((LENYAS-R1)/LENYAS) - CALL WNCTXS(TEXT,'!7$E7.2',R2) - TXTXY(1)=TAREA(0) - TXTXY(2)=POINXY(2,1)+R1 - CALL WQTEXT(TXTXY,TEXT(1:7)) - PG(1,1)=POINXY(1,1) - PG(2,1)=POINXY(2,1)+R1 !PLOT 0.25 CM. LINE (Y) - PG(1,2)=PG(1,1)-10./PPP(1) - PG(2,2)=PG(2,1) - CALL WQPOLL(2,PG) !POLYLINE - CALL WQSPLI(3) !DOTTED - PG(1,1)=POINXY(1,1) - PG(2,1)=POINXY(2,1)+R1 - PG(1,2)=POINXY(1,2) - PG(2,2)=PG(2,1) - CALL WQPOLL(2,PG) !POLYLINE - CALL WQSPLI(1) !NORMAL - END DO - END DO -C -C DRAW DOTTES LINES -C -C X-AXIS -C - CALL WQSPLI(3) !DOTTED - DO I0=1,2 - POINXY(1,1)=PAREA(0) - POINXY(2,1)=PAREA(1) - POINXY(1,2)=PAREA(2) - POINXY(2,2)=PAREA(3) - IF (I0.EQ.1) THEN !AMPL - POINXY(2,1)=PAREA(1)+YSIZ !Y LEFT/RIGHT BOTTOM - ELSE !PHASE - POINXY(2,2)=PAREA(3)-YSIZ !Y LEFT/RIGHT TOP - ENDIF - PG(2,1)=POINXY(2,1) - PG(2,2)=POINXY(2,2) - IF (IFR_MODE.EQ.'BAND') THEN - DO I1=0,NHACH-1 - PG(1,1)=POINXY(1,1)+I1*AXINT - PG(1,2)=PG(1,1) - CALL WQPOLL(2,PG) !POLYLINE - END DO - ELSE - DO R1=WNMEJC(360.*HARA(0)/R4)*R4, - 1 WNMEJF(360.*HARA(1)/R4)*R4,R4 - PG(1,1)=POINXY(1,1)+(R1-360.*HARA(0))/HASC*XFAC - PG(1,2)=PG(1,1) - CALL WQPOLL(2,PG) !POLYLINE - END DO - END IF - END DO - CALL WQSPLI(1) !NORMAL -C -C - END diff --git a/src/nplot/nplclo.for b/src/nplot/nplclo.for deleted file mode 100644 index 7d575f46b52c1b4046090a4282f1b65c31939cbe..0000000000000000000000000000000000000000 --- a/src/nplot/nplclo.for +++ /dev/null @@ -1,56 +0,0 @@ -C+NPLCLO.FOR -C CMV 940822 -C -C Close plot, check close status -C -C Revisions: -C CMV 940822 Created -C -C - SUBROUTINE NPLCLO(DQID_I,NHV_I) -C -C Result: -C -C CALL NPLCLO(DQID_J(*):I,NHV_J(*):I) Close plot, check output status -C -C Include files: -C - INCLUDE 'WNG_DEF' - INCLUDE 'WQG_DEF' - INCLUDE 'NPL_DEF' -C -C Parameters: -C -C -C Arguments: -C - INTEGER DQID_I(*) !DEVICE ID - INTEGER NHV_I(*) !PAGE LAYOUT -C -C Function references: -C -C -C Data declarations: -C -C- -C -C CLOSE PLOT -C - CALL WQ_MCLOSE (DQID_I,NHV_I) !CLOSE DEVICE -C -C CHECK CLOSE STATUS -C - IF (WQG_XSTAT(1:2).EQ.'>X') THEN !EXIT ALL - NO_MORE=.TRUE. - ELSE - IF (WQG_XSTAT(1:2).EQ.'>D') THEN !ASKED HARDCOPY - !NOT YET IMPLEMENTED - END IF - END IF -C -C CLOSE WQ SYSTEM -C - CALL WQCLOS !CLOSE WQ SYSTEM -C - RETURN - END diff --git a/src/nplot/nplcon.for b/src/nplot/nplcon.for deleted file mode 100644 index f5b4ff5a7a74cc54e3a7a9735d879f4867753911..0000000000000000000000000000000000000000 --- a/src/nplot/nplcon.for +++ /dev/null @@ -1,75 +0,0 @@ -C+ NPLCON.FOR -C HjV 931108 -C -C Revisions: -C JPH 9711.. Changes in connecting dotted lines (replacing a mess by -C somethging which is somewhat better ...) -C -C - SUBROUTINE NPLCON (NPLOT,CPO,HPO,BEGIN) -C -C Plot connection lines -C -C Result: -C -C CALL NPLCON Plot connection lines -C -C Include files: -C - INCLUDE 'WNG_DEF' - INCLUDE 'NPL_DEF' -C -C Parameters: -C -C -C Arguments: -C - INTEGER NPLOT !# OF INTERFEROMETERS TO DO - REAL CPO !CURRENT POINT OFFSET - REAL HPO !HALF POINT OFFSET - LOGICAL BEGIN !.TRUE.=FIRST SCAN, .FALSE.=LAST SCAN -C -C Function references: -C -C -C Data declarations: -C -C- - IF (BEGIN) THEN !AT BEGIN PLOT - CALL WQSPLI(4) !DOTTED =3 -cc POINXY(2,1)=PAREA(3)-YFAC*11./PPP(2) - POINXY(2,1)=CPO+YFAC*4./PPP(2) - POINXY(2,2)=CPO ! +HPO - DO I=0,NPLOT-1 - IF (NEW(I).NE.1E20) THEN - POINXY(1,1)=IFOFF(I) - POINXY(1,2)=NEW(I) - CALL WQPOLL(2,POINXY) - END IF - END DO - ELSE !AT END PLOT - DO I2=0,NPLOT-1 !LAST BIT SCAN - IF (NEW(I2).NE.1E20) THEN - POINXY(1,1)=NEW(I2) - POINXY(2,1)=CPO - POINXY(1,2)=NEW(I2) - POINXY(2,2)=CPO-HPO - CALL WQPOLL(2,POINXY) - END IF - END DO - CALL WQSPLI(4) !DOTTED =3 - POINXY(2,1)=CPO - POINXY(2,2)=CPO-YFAC*4./PPP(2) - DO I=0,NPLOT-1 - IF (NEW(I).NE.1E20) THEN - POINXY(1,1)=NEW(I) - POINXY(1,2)=IFOFF(I) - CALL WQPOLL(2,POINXY) - END IF - END DO - ENDIF - CALL WQSPLI(1) !FULL -cc print*, parea(3), ppp(2), yfac, begin, cpo,hpo,poinxy(2,1),poinxy(2,2) -C -C - END diff --git a/src/nplot/npldat.for b/src/nplot/npldat.for deleted file mode 100644 index 1d19d7a2eab93e98442459969e929beec0d657bc..0000000000000000000000000000000000000000 --- a/src/nplot/npldat.for +++ /dev/null @@ -1,1166 +0,0 @@ -C+ NPLDAT.FOR -C WNB 910617 -C -C Revisions: -C WNB 910913 New loops -C WNB 910918 Add plot of XY,YX only -C WNB 910930 New logics -C WNB 911217 Change halftone -C WNB 911220 Add polarisation -C WNB 920812 Wrong residual message -C WNB 920831 Add PLUVO -C WNB 921102 Correct for full HA range -C WNB 921221 Default plotter EPS -C HjV 930209 Add default countours -C Change default SIZE: 1.3, 1.3 -C Change default PLOTTER: PSP -C WNB 930401 Default size dependent on orientation -C HjV 930423 Change name of some keywords and some text -C WNB 930517 Calculate range without empty UV points -C HjV 930722 Change PLUVO in IFR_MODE -C WNB 930824 Change telescope selection -C WNB 930825 New pol. selection -C WNB 930826 New HA range -C CMV 931104 Add GDI and fire X windows in advance -C CMV 931210 Add '???_LOOPS' argument to WNDXLP -C CMV 931220 Pass FCA of input file to WNDXLP and WNDSTA/Q -C HjV 940104 Change DATA_TYPES, add PPP, change HASC -C HjV 940224 Add mosaik test -C HjV 940324 Correct HA-scale default (was done afterwards) -C HjV 940413 Also use loops for testing HA-range -C CMV 940418 Use NMODAW (default model name) and reread CAP/CDAP -C CMV 940420 Make PLTSRC integer to allow more options -C CMV 940426 Add plotting of IF data -C CMV 940428 Initialise namelist for annotation using NMONM1 -C CMV 940516 Change default HA-range -C CMV 940620 Correct HA-range for X11, handle Internal model option -C CMV 940622 Add EDIT option to PLOT_POSITIONS -C CMV 940622 Add INTERFEROMETER option -C CMV 940817 Options to ignore pixel coordinate axes -C CMV 940822 Save some more defaults -C JPH 940824 Open files readonly -C CMV 940829 Ask TICK_TYPE also if no pixel-coordinates asked -C CMV 940927 Answer * to SCALES gives the default -C CMV 941005 Correct default for OPTIONS if IFDATA choosen -C CMV 941118 Correct jump if # at WMP_LOOPS prompt -C WNB 950120 Accept only X,Y for TEL option -C HjV 950120 Correct HA_SCALE -C HjV 950503 Re-open SCN-file for update when models found -C HjV 950705 Add keyword PLOT_FORMAT, PLOT_HEADING -C HjV 970718 Change PLOT_HEADING (problem on HP with logical) -C JPH 950817 Remove x11 close (WQDVCL) -C Remove plot device GDI -C Be more careful in truncating PLDEV to 2 chars (so no -C crash when backtracking with ctrl-D) -C PLTYP 16 chars -C JPH 960305 Split IF block at label 10 into a block before and -C after with the same condition: WAW03 compiler objects -C against GOTOs into a block. -C JPH 960306 Reactivate X11 close (cf. JPH 950817) -C Modify HAB calculation to work with ST -C JPH 960402 STxxx options to select HA or ST ordinate -C Backtracking from PLOT_HEADING prompt -C HjV 960415 Do not ask IFR_MODE when OPTION=TELESCOPE -C JPH 960523 ST selection via OPTION i.s.o. IFR_MODE (change mandated -C by HjV 960415). -C JPH 960619 ST selection through HA_MODE keyword -C JPH 960726 SETNAM argument for NPLSST -C JPH 960730 Select scale defaults for AGAIN, PGAIN data -C JPH 960805 Add ANNOTN. -C ST_INIT in common i.s.o. NPLSST argument -C WNB 970605 Add COORD_PREC default 256 -C -C - SUBROUTINE NPLDAT(ACT) -C -C Get NPLOT program parameters -C -C Result: -C -C CALL NPLDAT( ACT_L:IO) will ask and set all program parameters -C -C PIN references: -C -C PLOTTER -C PLOT_FORMAT -C PLOT_HEADING -C OPTION -C IF_MODE -C IFR_MODE -C SCN_NODE -C WMP_NODE -C SCN_SETS -C WMP_SETS -C POLARISATION -C APPLY -C DE_APPLY -C DATA_TYPES -C DATA_TYPE -C APPLY -C DE_APPLY -C SCALE_AMPL -C SCALE_PHASE -C HA_SCALE -C FULL_CONT -C DOT_CONT -C HALFTONE -C RANGE -C TRANSFORM -C COORD -C COORD_TYPE -C PLOT_POSITIONS -C -C Include files: -C - INCLUDE 'WNG_DEF' - INCLUDE 'CBITS_DEF' - INCLUDE 'STH_O_DEF' !SET HEADER - INCLUDE 'MPH_O_DEF' - INCLUDE 'NPL_DEF' -C -C Parameters: -C -C -C Arguments: -C - LOGICAL ACT !ASK PLOTTER (TRUE) -C -C Function references: -C - LOGICAL WNDPAR !GET DWARF PARAMETER - LOGICAL WNDNOD,WNDNOC !GET/CHANGE NODE NAME - LOGICAL WNDXLN !NEXT LOOP - LOGICAL WNDXLP !GET LOOPS TO DO - LOGICAL WNFOP !OPEN FILE - LOGICAL WNFRD !READ DATA - LOGICAL WNDSTQ,WNDSTA !GET SETS TO DO - CHARACTER*32 WNTTSG !SHOW SET NAME - LOGICAL NSCSTG,NMASTG !GET A SET - LOGICAL NSCSTL !GET A SET - LOGICAL NSCIF1 !SELECT INTERFEROMETERS - LOGICAL NSCTL1 !SELECT TELESCOPES - LOGICAL NSCPLS !SELECT POLARISATION - LOGICAL NSCHAS !SELECT HA RANGE - LOGICAL WQDVOP !TOO FIRE OFF X11/GIDS WINDOW - LOGICAL NMONM1 !OPEN NAMELIST FOR MODEL - LOGICAL NMORDX !READ MODEL FROM SECTOR - LOGICAL NMORDM !MOVE MODEL INTO OTHER INDEX - INTEGER WNCALN !GET LENGTH OF STRING -C -C Data declarations: -C - INTEGER MXAREA(0:3) !MAX. MAP AREA - DATA MXAREA/0,0,0,0/ - INTEGER FAREA(0:3) !FULL MAP AREA - INTEGER TREA(0:3),PREA(0:3),PPREA(0:3) !HELP AREAS - CHARACTER*16 LPTYP(4) !PLOT TYPE - INTEGER HISBAD !HISTOGRAM BUFFER POINTER - INTEGER NRPOL,NRRUL !POL, RULE SEEN - INTEGER NRCON,NRHALF !CONTOUR, HALFTONE SEEN - REAL MPNOS !NOISE - REAL TRIN(5) !TRANSFORM DATA - CHARACTER*24 LOPT !LOCAL OPTION - INTEGER STHP !SET POINTER - REAL LBUF(0:8191) !DATA BUFFER - BYTE STH(0:STH__L-1) !SET HEADER - INTEGER*2 STHI(0:STH__L/LB_I-1) - INTEGER STHJ(0:STH__L/LB_J-1) - REAL STHE(0:STH__L/LB_E-1) - double precision sthd(0:sth__l/lb_d-1) - EQUIVALENCE (STH,STHI,STHJ,STHE,STHD) - BYTE MPH(0:MPHHDL-1) !MAP HEADER - INTEGER MPHJ(0:MPHHDL/4-1) - EQUIVALENCE (MPH,MPHJ) - BYTE AMPH(0:MPHHDL-1) !MAP HEADER (ANGLES) - INTEGER AMPHJ(0:MPHHDL/4-1) - EQUIVALENCE (AMPH,AMPHJ) - REAL CVAL - INTEGER CSET(0:7,0:1) !TEST SET NAMES - CHARACTER*256 DFLTXT - INTEGER DQTMP !Used to fire off X11 windows -C - CHARACTER CRDNAM(-6:6)*4 !Names of coordinate types - DATA CRDNAM/'ODEG','ODDE','ORAD','ODRA','OLM','ODLM', - 1 'NONE','DLM','LM','DRA','RAD','DDE','DEG'/ - CHARACTER TYPNAM(1:3)*4 !Names of tick types - DATA TYPNAM/'TICK','DOT','FUL'/ - CHARACTER SRCNAM(0:3)*4 !Names for PLOT_POSITIONS - DATA SRCNAM/'NO','YES','NAME','EDIT'/ -C - REAL HA(0:1) !HA RANGE IN DATA - REAL OHA(0:1) !HA RANGE IN PREVIOUS DATA - LOGICAL GOT_IFR,GOT_TEL !CHECK IF IFRS/TELS SELECTED - INTEGER NRCHAN !# CHANNELS - REAL HAB ! local HAB or ST -CC INTEGER INIT ! for NPLSST - CHARACTER*10 HAMODE ! HA/ST/SEQ mode - LOGICAL LOGGAIN ! 'gain/phase residuals' flag - SAVE HA,OHA,GOT_IFR,GOT_TEL !SAVE FOR DEFAULTS -C- -C -C INIT -C - IF (ACT) THEN !FIRST TIME - ACT=.FALSE. !NOT FIRST TIME - OPTION='QUIT' - PLDEV='PP' - NODIN=' ' - SETS(0,0)=0 - HARA(0)=-179.99/360. - HARA(1)=179.99/360. - IFR_MODE='NORMAL' - IF_MODE=' ' - SPOL=XY_M - GOT_IFR=.FALSE. - GOT_TEL=.FALSE. - HA(0)=1 !START RANGE HA - HA(1)=-1 - NDATTP=2 - DATTYP(1)='AMPL' - DATTYP(2)='PHASE' - MAPDTYP='DATA' - DO I=0,3 !INIT MAP AREAS - TAREA(I)=0 !DEFAULT AREA - FAREA(I)=0 !FULL AREA - END DO - CRD=0 !NO ANNOTATION OF MAPS - CRDTYP=1 !TICKS - PLTSRC=0 !NO POSITIONS - END IF -C - OHA(0)=HA(0) !SAVE OLD RANGE - OHA(1)=HA(1) - HA(0)=1 !START RANGE HA - HA(1)=-1 - FNAM=' ' !INIT FIELD NAME - NO_MORE=.FALSE. !MAKE ALL PLOTS - HAMODE=' ' -C -C GET OPTION -C - 100 CONTINUE - IF (IF_MODE.NE.' ') OPT='IFD' !RESET OPTION - IF (.NOT.WNDPAR('OPTION',OPTION,LEN(OPTION),J0,OPTION)) THEN - OPTION='QUIT' !ASSUME END - ELSE IF (J0.LE.0) THEN - OPTION='QUIT' !ASSUME END - END IF - IF (OPT.EQ.'QUI') RETURN !READY -C -C Special hour-angle conversions -C - IF (OPT.EQ.'SPE') THEN -2 IF (.NOT.WNDPAR('HA_MODE',HAMODE,LEN(HAMODE),J0,HAMODE)) THEN - HAMODE=' ' !ASSUME END - ELSE IF (J0.LE.0) THEN - HAMODE=' ' !ASSUME END - END IF - ST_MODE=0 - IF (HAMODE(1:1).EQ.'I') THEN - HAMODE=HAMODE(2:) - IF (.NOT.WNDPAR('HA_INTEGRATION',HAINT,LB_E,J0,'*')) GOTO 100 - ENDIF - IF (HAMODE.EQ.'ST') THEN - ST_MODE=1 ! ST i.s.o. HA - ELSEIF (HAMODE.EQ.'SEQUENCE') THEN - ST_MODE=-1 ! monotonous quasi-ST - ENDIF - IF (.NOT.WNDPAR('ANNOTATION',ANNOTN,LEN(ANNOTN),J0,ANNOTN)) - 1 ANNOTN=' ' - GOTO 100 ! now select primary option - ENDIF -C -C GET PLOTTER -C - IF (PLDEV(1:1).EQ.'P' .OR. PLDEV(1:1).EQ.'E') PLDEV(3:3)=' ' - IF (.NOT.WNDPAR('PLOTTER',PLDEV,LEN(PLDEV),J0,PLDEV)) THEN - GOTO 100 - ELSE IF (J0.LE.0) THEN - GOTO 100 - END IF -C -C GET PLOT-FORMAT -C ONLY FOR (ENCAPSULATED) POSTSCRIPT -C - IF (PLDEV(1:2).EQ.'EL' .OR. PLDEV(1:2).EQ.'EP' .OR. - 1 PLDEV(1:2).EQ.'PL' .OR. PLDEV(1:2).EQ.'PP' ) THEN - IF (.NOT.WNDPAR('PLOT_FORMAT',PLDEV(3:3),LEN(PLDEV(3:3)), - 1 J0,PLDEV(3:3))) THEN - GOTO 100 - ELSE IF (J0.LE.0) THEN - GOTO 100 - END IF - END IF -C -C FIRE OFF X11 Stuff (Open and close again) -C -CC IF (PLDEV.EQ.'GDI'.OR.PLDEV.EQ.'X11') THEN - IF (PLDEV.EQ.'X11') THEN - DQTMP=0 - IF (.NOT.WQDVOP(DQTMP,PLDEV)) GOTO 100 - CALL WQDVCL(DQTMP) - END IF -C -C TELESCOPE ERRORS/RESIDUALS/DATA/MODEL -C - IF (OPT.EQ.'TEL' .OR. OPT.EQ.'DAT' .OR. OPT.EQ.'MOD' .OR. - 1 OPT.EQ.'RES' .OR. OPT.EQ.'INT' .OR. OPT.EQ.'IFD') THEN -C -C IF-Data is plotted much alike to TELescope data, so we set the option -C to TEL and make the difference in IFR_MODE. This saves us the trouble -C of changing tests on OPT.EQ.'TEL' in a lot of files... -C - IF_MODE=' ' !Not IF-data - IF (OPT.EQ.'IFD') THEN !Get IF Option - OPT='TEL' - IF (.NOT.WNDPAR('IF_MODE',IF_MODE, - 1 LEN(IF_MODE),J0,'TSYS')) THEN - GOTO 100 !RETRY OPTION - ELSE IF (J0.LE.0) THEN - IF_MODE='TSYS' - END IF - END IF -C - IF (OPT.NE.'TEL') THEN !Not relevant for TELESCOPE - IF (.NOT.WNDPAR('IFR_MODE',IFR_MODE, - 1 LEN(IFR_MODE),J0,IFR_MODE)) THEN - GOTO 100 !RETRY OPTION - ELSE IF (J0.LE.0) THEN - IFR_MODE='NORMAL' - END IF - END IF - IF (IFR_MODE.EQ.'SPECTRAL') THEN - PLUVO=.TRUE. - ELSE - PLUVO=.FALSE. - END IF -C -C GET SCAN FILE -C - ENDIF - 10 CONTINUE - IF (OPT.EQ.'TEL' .OR. OPT.EQ.'DAT' .OR. OPT.EQ.'MOD' .OR. - 1 OPT.EQ.'RES' .OR. OPT.EQ.'INT' .OR. OPT.EQ.'IFD') THEN - IF (.NOT.WNDNOD('SCN_NODE',NODIN,'SCN','R',NODIN,FILIN)) THEN - IF (E_C.EQ.DWC_ENDOFLOOP) GOTO 100 !RETRY OPTION - GOTO 10 !RETRY - ELSE IF (E_C.EQ.DWC_NULLVALUE) THEN - GOTO 100 !RETRY OPTION - ELSE IF (E_C.EQ.DWC_WILDCARD) THEN - GOTO 10 !MUST SPECIFY - END IF - IF (.NOT.WNFOP(FCAIN,FILIN,'R')) GOTO 10 !OPEN INPUT -C -C GET SETS -C - 11 CONTINUE - IF (.NOT.WNDXLP('SCN_LOOPS',FCAIN)) THEN - IF (E_C.EQ.DWC_ENDOFLOOP) GOTO 10 !SCAN NODE AGAIN - GOTO 11 - END IF - IF (.NOT.WNDSTQ('SCN_SETS',MXNSET,SETS(0,0),FCAIN)) THEN - GOTO 10 !RETRY FILE - END IF - IF (.NOT.NSCSTG(FCAIN,SETS,STH,STHP,SETNAM)) GOTO 10 !FIND A SET - CALL WNDSTR(FCAIN,SETS) !RESET SET SEARCH -C -C FIND HA_RANGE, NR. OF CHANNELS AND TEST IF MOSAIC -C - NRCHAN=0 - CSET(0,0)=-1 - CSET(0,1)=-1 - MOSAIK=.FALSE. - CALL WNDXLI(LPOFF) !CLEAR OFFSET - DO WHILE (WNDXLN(LPOFF)) - ST_INIT=ST_MODE ! init for NPLSST - DO WHILE(NSCSTL(FCAIN,SETS,STH(0),STHP,SETNAM,LPOFF)) !NEXT SET - IF (CSET(0,0).EQ.-1) THEN - DO I1=0,7 - CSET(I1,0)=SETNAM(I1) - END DO - CALL WNGMTS(STH_FIELD_N,STH(STH_FIELD_1),FNAM) !SET FIELD NAME - OBSDY(1)=STHI(STH_OBS_I) !OBS. DAY - OBSDY(2)=STHI(STH_OBS_I+1) !OBS. YEAR - END IF - IF (CSET(0,1).NE.-1) THEN - IF ((CSET(0,1).EQ.SETNAM(0)).AND. - 1 (CSET(1,1).EQ.SETNAM(1))) THEN - IF (CSET(2,1).NE.SETNAM(2)) THEN - MOSAIK=.TRUE. - ELSE - IF ((CSET(3,1).EQ.SETNAM(3)).AND. - 1 (CSET(4,1).NE.SETNAM(4))) MOSAIK=.TRUE. - END IF - END IF - END IF - DO I1=0,7 - CSET(I1,1)=SETNAM(I1) - END DO - IF (ST_MODE.NE.0) THEN - CALL NPLSST(STHD,STHE(STH_HAB_E),SETNAM,HAB) - ELSE - HAB=STHE(STH_HAB_E) - ENDIF - R0=HAB-STHE(STH_HAI_E)/2. !START SET HA - IF (R0.LT.HA(0)) HA(0)=R0 !NEW HA-RANGE - R0=HAB+(STHJ(STH_SCN_J)-0.5)*STHE(STH_HAI_E)!END HA - IF (R0.GT.HA(1)) HA(1)=R0 - NRCHAN=NRCHAN+1 - END DO! sectors - IF (HAMODE.EQ.'SEQUENCE') GOTO 12 ! assume all loops - ! cover same range - END DO ! loops - 12 CONTINUE - - CALL WNDXLI(LPOFF) !CLEAR OFFSET - CALL WNDSTR(FCAIN,SETS) !RESET SET SEARCH - IF ((IFR_MODE.EQ.'BAND').AND.(NRCHAN.LT.2)) THEN - CALL WNCTXT(F_TP,'IFR_MODE !AS with !UJ channels not useful', - 1 IFR_MODE,NRCHAN) - GOTO 10 - END IF - IF (HA(0).NE.OHA(0).OR.HA(1).NE.OHA(1)) THEN !NEW RANGE IN DATA - HARA(0)=HA(0) !SO CHANGE DEFAULT - HARA(1)=HA(1) - END IF -C -C GET HA RANGE -C - 13 CONTINUE - IF (ST_MODE.EQ.0) THEN - IF (.NOT.NSCHAS(0,HARA)) GOTO 10 !GET HA RANGE - ENDIF - HARA(0)=MAX(HARA(0),HA(0)) !LIMIT TO INPUT - HARA(1)=MIN(HARA(1),HA(1)) - IF (HARA(1)-HARA(0).LT.1./360.) HARA(1)=HARA(0)+1./360. -C -C GET POLARISATION -C - 14 CONTINUE - IF (.NOT.NSCPLS(0,SPOL)) GOTO 10 !GET POLARISATION SELECTION -CC#135 IF (IF_MODE.NE.' '.AND.IAND(SPOL,YX_M).NE.0) - IF (OPT.EQ.'TEL' .AND. IAND(SPOL,YX_M).NE.0) - 1 SPOL=IAND(SPOL,XY_M) !IF/TEL only X,Y -C -C GET MODEL -C - IF (OPT.EQ.'RES' .OR. OPT.EQ.'MOD') THEN - CALL NMODAW(NSRC(0),STH) !GET MODEL - CALL NSCSAD(CORAP,CORDAP) !GET CORRECTIONS AGAIN - IF (NSRC(0).GT.0) THEN !YES, models found - CALL NMOMUI !GET TYPE -C We found models, so re-open the SCN-file for Update mode - CALL WNFCL(FCAIN) !CLOSE FILE - IF (.NOT.WNDNOC(' ',' ','SCN','U',' ',FILIN)) THEN !CHANGE DATES - CALL WNCTXT(F_TP,'Node is not writable') - GOTO 10 - END IF - IF (.NOT.WNFOP(FCAIN,FILIN,'U')) THEN !OPEN SCN FILE - CALL WNCTXT(F_TP,'Cannot write to file attached to node') - GOTO 10 - END IF - ELSE IF (IAND(CORDAP,CAP_MOD).NE.0) THEN !DEAPPLY=MODEL - IF (OPT.EQ.'RES') THEN !RESIDUAL OF INTERNAL MODEL - CALL WNCTXT(F_TP, - 1 'The model present in the SCN file will be used') - NSRC(0)= -1 !INDICATE NOT REDUNDANCY - ELSE - CALL WNCTXT(F_TP, - 1 'Extracting the internal model...') - DO WHILE (NSCSTG(FCAIN,SETS,STH,STHP,SETNAM)) - IF (STHJ(STH_MDL_J).NE.0) THEN !THIS ONE - IF (NMORDX(FCAIN,STHJ(STH_MDL_J),7)) THEN !FOUND - IF (NMORDM(7,-1)) GOTO 800 !READY - END IF - END IF - END DO - CALL WNCTXT(F_TP,'No model found in scan-file') - GOTO 10 !RETRY FILE IF NO MODEL - 800 CONTINUE !FOUND, ENTER NMODAW AGAIN - CALL WNDSTR(FCAIN,SETS) !RESET SET SEARCH - CALL WNCTXT(F_TP, - 1 'You may read additional components now...') - CALL NMODAW(NSRC(0),STH) !GET MODEL AGAIN - CALL NMOMUI !GET TYPE - END IF - ELSE IF (OPT.EQ.'MOD') THEN - GOTO 10 !RETRY FILE IF NO MODEL - ELSE - CALL WNCTXT(F_TP,'Redundancy residuals selected') - END IF - ELSE - NSRC(0)=0 !SET NO MODEL - END IF -C -C GET TELESCOPES/INTERFEROMETERS -C - 15 CONTINUE - IF (OPT.EQ.'TEL') THEN - IF (GOT_TEL) THEN - IF (.NOT.NSCTL1(0,STELS,STHJ)) GOTO 10 !GET TELESCOPES TO DO - ELSE - IF (.NOT.NSCTL1(1,STELS,STHJ)) GOTO 10 !GET TELESCOPES TO DO - END IF - GOT_TEL=.TRUE. - ELSE - IF (GOT_IFR) THEN - IF (.NOT.NSCIF1(0,SIFRS,STHJ)) GOTO 10 !GET IFRS - ELSE IF (OPTION(4:4).EQ.'P') THEN - IF (.NOT.NSCIF1(4,SIFRS,STHJ)) GOTO 10 !GET IFRS - ELSE IF (OPT.EQ.'DAT' .OR. OPT.EQ.'INT' .OR. - 1 (OPT.EQ.'RES' .AND. NSRC(0).EQ.0)) THEN - IF (.NOT.NSCIF1(2,SIFRS,STHJ)) GOTO 10 !GET IFRS - ELSE IF (OPT.EQ.'MOD' .OR. - 1 (OPT.EQ.'RES' .AND. NSRC(0).NE.0)) THEN - IF (.NOT.NSCIF1(3,SIFRS,STHJ)) GOTO 10 !GET IFRS - END IF - GOT_IFR=.TRUE. - END IF -C -C GET CORRECTIONS TO DO -C - CALL NSCSAD(CORAP,CORDAP) !GET CORRECTIONS TO PLOT -C -C GET DATA TYPES -C - 16 CONTINUE -C -C Dwarf refuses array of characters as default. Should work, but -C I don't want to search for the bug. Just fill in default string -C here. -C - DFLTXT=' ' - I1=0 - DO I=1,NDATTP - DFLTXT(I1+1:)=DATTYP(I) - I1=WNCALN(DFLTXT)+1 - DFLTXT(I1:I1)=',' - END DO -C - IF (.NOT.WNDPAR('DATA_TYPES',DATTYP,MXNDTP*LEN(DATTYP(1)), - 1 NDATTP,DFLTXT(:I1-1))) THEN - IF (E_C.EQ.DWC_ENDOFLOOP) GOTO 10 !RETRY FILE - GOTO 16 - END IF - IF (NDATTP.EQ.0) GOTO 10 - IF (NDATTP.LT.0) THEN - DATTYP(1)='AMPLITUDE' - DATTYP(2)='PHASE' - NDATTP=2 - END IF - IF (IF_MODE.NE.' ') THEN !IF Option - I=1 - DO WHILE (I.LE.NDATTP) - IF (DATTYP(I)(1:1).NE.'A') THEN - CALL WNCTXT(F_TP,'!AS plots not relevant for IF_DATA', - 1 DATTYP(I)) - NDATTP=NDATTP-1 - DO I2=I,NDATTP - DATTYP(I2)=DATTYP(I2+1) - END DO - ELSE - I=I+1 - END IF - END DO - IF (NDATTP.EQ.0) THEN - CALL WNCTXT(F_TP,'Only Amplitude plots relevant for IF_DATA') - GOTO 16 - END IF - END IF - L0=.FALSE. !GET SCALES - L1=.FALSE. - DO I=1,NDATTP - IF (DATTYP(I)(1:2).EQ.'AP') THEN - L1=.TRUE. !PHASE SCALE - L0=.TRUE. !AMPL SCALE - ELSE IF (DATTYP(I)(1:1).EQ.'P') THEN - L1=.TRUE. !PHASE SCALE - ELSE - L0=.TRUE. !AMPL SCALE - END IF - IF ((DATTYP(I)(1:2).EQ.'AP').OR.(DATTYP(I)(1:2).EQ.'CS')) THEN - PLOTAP=.TRUE. - ELSE - PLOTAP=.FALSE. - ENDIF - END DO - IF (PLOTAP.AND.MOSAIK) THEN - CALL WNCTXT(F_TP,'AP or CS not possible for Mosaic observation') - GOTO 16 - END IF -C -C GET PLOTS PER PAGE -C - 19 CONTINUE - PPP(1)=1 - PPP(2)=1 - IF (.NOT.WNDPAR('PLOTS_PER_PAGE',PPP,2*LB_J,J0,A_B(-A_OB), - 1 PPP,2)) THEN - IF (E_C.EQ.DWC_ENDOFLOOP) GOTO 10 !RETRY FILE - GOTO 19 - END IF - IF (J0.EQ.0) GOTO 10 - IF (J0.LT.0) THEN - PPP(1)=1 - PPP(2)=1 - END IF - PPPNR=-1 !PLOT NUMBER ON PAGE -C -C GET DATA SCALE -C - 17 CONTINUE - LOGGAIN=.FALSE. - DO I=1,NDATTP - IF ((DATTYP(I)(1:2).EQ.'AP').OR.(DATTYP(I)(1:2).EQ.'CS')) GOTO 18 - IF ((DATTYP(I)(1:2).EQ.'AG').OR.(DATTYP(I)(1:2).EQ.'PG')) - 1 LOGGAIN=.TRUE. - END DO - SCAL(1)=100 !DEFAULTS - SCAL(2)=10 - IF (OPT.EQ.'RES') THEN !GET NOISES - IF (NSRC(0).NE.0) THEN !ALIGN - DO I1=0,1 - SCAL(I1+1)=1 !LOWEST DEFAULT - DO I=0,1 - SCAL(I1+1)=MAX(STHE(STH_REDNS_E+2*I+I1),SCAL(I1+1)) - SCAL(I1+1)=MAX(STHE(STH_ALGNS_E+2*I+I1),SCAL(I1+1)) - END DO - SCAL(I1+1)=4*SCAL(I1+1) !CORRECT SCALE - END DO - ELSE !REDUN - DO I1=0,1 - SCAL(I1+1)=1 !LOWEST DEFAULT - DO I=0,1 - SCAL(I1+1)=MAX(STHE(STH_REDNS_E+2*I+I1),SCAL(I1+1)) - END DO - SCAL(I1+1)=4*SCAL(I1+1) !CORRECT SCALE - END DO - END IF - END IF - IF (L0) THEN - IF (IF_MODE(1:2).EQ.'TP') THEN - IF (.NOT.WNDPAR('SCALE_AMPL',SCAL(1),LB_E,J0,'500.')) THEN - IF (E_C.EQ.DWC_ENDOFLOOP) GOTO 10 !RETRY FILE - GOTO 17 - END IF - IF (J0.EQ.0) GOTO 10 - IF (J0.LT.0.OR.E_C.EQ.DWC_WILDCARD) SCAL(1)=500 - ELSE IF (OPT.EQ.'TEL' .OR. LOGGAIN) THEN - IF (.NOT.WNDPAR('SCALE_AMPL',SCAL(1),LB_E,J0,'4.')) THEN - IF (E_C.EQ.DWC_ENDOFLOOP) GOTO 10 !RETRY FILE - GOTO 17 - END IF - IF (J0.EQ.0) GOTO 10 - IF (J0.LT.0.OR.E_C.EQ.DWC_WILDCARD) SCAL(1)=4 - ELSE IF (OPT.EQ.'DAT' .OR. OPT.EQ.'MOD' - 1 .OR. OPT.EQ.'INT') THEN - IF (.NOT.WNDPAR('SCALE_AMPL',SCAL(1),LB_E,J0,'100.')) THEN - IF (E_C.EQ.DWC_ENDOFLOOP) GOTO 10 !RETRY FILE - GOTO 17 - END IF - IF (J0.EQ.0) GOTO 10 - IF (J0.LT.0.OR.E_C.EQ.DWC_WILDCARD) SCAL(1)=100 - ELSE IF (OPT.EQ.'RES') THEN - IF (.NOT.WNDPAR('SCALE_AMPL',SCAL(1),LB_E,J0, - 1 A_B(-A_OB),SCAL(1),1)) THEN - IF (E_C.EQ.DWC_ENDOFLOOP) GOTO 10 !RETRY FILE - GOTO 17 - END IF - IF (J0.EQ.0) GOTO 10 - IF (J0.LT.0.OR.E_C.EQ.DWC_WILDCARD) SCAL(1)=100 - END IF - END IF -C - IF (L1) THEN - IF (OPT.EQ.'TEL' .OR. LOGGAIN) THEN - IF (.NOT.WNDPAR('SCALE_PHASE',SCAL(2),LB_E,J0,'2.')) THEN - IF (E_C.EQ.DWC_ENDOFLOOP) GOTO 10 !RETRY FILE - GOTO 17 - END IF - IF (J0.EQ.0) GOTO 10 - IF (J0.LT.0.OR.E_C.EQ.DWC_WILDCARD) SCAL(2)=2 - ELSE IF (OPT.EQ.'DAT' .OR. OPT.EQ.'MOD' - 1 .OR. OPT.EQ.'INT') THEN - IF (.NOT.WNDPAR('SCALE_PHASE',SCAL(2),LB_E,J0,'10.')) THEN - IF (E_C.EQ.DWC_ENDOFLOOP) GOTO 10 !RETRY FILE - GOTO 17 - END IF - IF (J0.EQ.0) GOTO 10 - IF (J0.LT.0.OR.E_C.EQ.DWC_WILDCARD) SCAL(2)=10 - ELSE IF (OPT.EQ.'RES') THEN - IF (.NOT.WNDPAR('SCALE_PHASE',SCAL(2),LB_E,J0, - 1 A_B(-A_OB),SCAL(2),1)) THEN - IF (E_C.EQ.DWC_ENDOFLOOP) GOTO 10 !RETRY FILE - GOTO 17 - END IF - IF (J0.EQ.0) GOTO 10 - IF (J0.LT.0.OR.E_C.EQ.DWC_WILDCARD) SCAL(2)=10 - END IF - END IF -C -C HA SCALE -C - 18 CONTINUE - IF (IFR_MODE.NE.'BAND') THEN - DO I=1,NDATTP - IF ((DATTYP(I)(1:2).EQ.'AP').OR.(DATTYP(I)(1:2).EQ.'CS')) THEN - R0=10.*PPP(1) - ELSE - R0=30.*(HARA(1)-HARA(0))*PPP(2) -CC Before 950120 it was as below, but for ELSE it was wrong -CC Just leave it here temporary, in case of -C ELSE IF (PLDEV.EQ.'GDI'.OR.PLDEV.EQ.'X11') THEN -C R0=30.*(HARA(1)-HARA(0))*PPP(2) -C ELSE -CC R0=15.*(HARA(1)-HARA(0))*PPP(2) - ENDIF - END DO - IF (.NOT.WNDPAR('HA_SCALE',HASC,LB_E,J0,A_B(-A_OB),R0,1)) THEN - IF (E_C.EQ.DWC_ENDOFLOOP) GOTO 10 !RETRY FILE - GOTO 18 - END IF - IF (J0.EQ.0) GOTO 10 - IF (J0.LT.0.OR.E_C.EQ.DWC_WILDCARD) HASC=R0 - HASC=HASC/10. !MAKE PER MM - END IF -C -C MAP -C - ELSE IF (OPT.EQ.'MAP') THEN -C -C GET FILE -C - 20 CONTINUE - IF (.NOT.WNDNOD('WMP_NODE',NODIN,'WMP','R',NODIN,FILIN)) THEN - IF (E_C.EQ.DWC_ENDOFLOOP) GOTO 100 !RETRY OPTION - GOTO 20 !RETRY - ELSE IF (E_C.EQ.DWC_NULLVALUE) THEN - GOTO 100 !RETRY OPTION - ELSE IF (E_C.EQ.DWC_WILDCARD) THEN - GOTO 20 !MUST SPECIFY - END IF - IF (.NOT.WNFOP(FCAIN,FILIN,'R')) GOTO 20 !OPEN INPUT -C -C GET SETS -C - 21 CONTINUE - IF (.NOT.WNDXLP('WMP_LOOPS',FCAIN)) THEN - IF (E_C.EQ.DWC_ENDOFLOOP) GOTO 20 !MAP NODE AGAIN - GOTO 21 - END IF - IF (.NOT.WNDSTQ('WMP_SETS',MXNSET,SETS(0,0),FCAIN)) THEN - GOTO 20 !RETRY FILE - END IF - IF (NMASTG(FCAIN,SETS,MPH,STHP,SETNAM)) THEN !FIND A SET - CALL WNDSTR(FCAIN,SETS) !RESET SET SEARCH - ELSE - GOTO 21 !RETRY - END IF -C -C GET PLOT TYPES -C - 28 CONTINUE - I=0 !COUNT SETS - NRPOL=0 !NOT POL - NRRUL=0 !NOT RULE - NRCON=0 !NOT CONTOUR - NRHALF=0 !NOT HALFTONE - DO WHILE (NMASTG(FCAIN,SETS,MPH,STHP,SETNAM)) - CALL WNCTXT(F_TP,'Map: !AS',WNTTSG(SETNAM,0)) !SHOW SET - IF (.NOT.WNDPAR('PLOT_TYPE',LPTYP,64,J0,'CONT,HALF')) THEN - CALL WNDSTR(FCAIN,SETS) !RESET SET SEARCH - IF (E_C.EQ.DWC_ENDOFLOOP) GOTO 20 !RETRY FILE - GOTO 28 - END IF - IF (J0.EQ.0) THEN - CALL WNDSTR(FCAIN,SETS) !RESET SET SEARCH - GOTO 20 !RETRY FILE - END IF - IF (J0.LT.0) THEN !DEFAULT - J0=2 - LPTYP(1)='CONTOUR' - LPTYP(2)='HALFTONE' - END IF - I=I+1 !COUNT SET - PTYP(I)=0 !NO PLOT TYPE - DO I1=1,J0 - IF (LPTYP(I1).EQ.'CONTOUR') THEN - PTYP(I)=IOR(PTYP(I),1) - NRCON=NRCON+1 - ELSE IF (LPTYP(I1).EQ.'HALFTONE') THEN - PTYP(I)=IOR(PTYP(I),2) - NRHALF=NRHALF+1 - ELSE IF (LPTYP(I1).EQ.'POLARISATION') THEN - PTYP(I)=IOR(PTYP(I),4) - NRPOL=NRPOL+1 - ELSE IF (LPTYP(I1).EQ.'RULED') THEN - PTYP(I)=IOR(PTYP(I),8) - NRRUL=NRRUL+1 - END IF - END DO - IF (IAND(4,PTYP(I)).NE.0) THEN !GET ANGLE SET - IF (.NOT.WNDSTA('ANGLE_WMP_SET',1,ASET(0,I),FCAIN)) THEN - GOTO 20 !RETRY FILE - END IF - IF (NMASTG(FCAIN,ASET(0,I),AMPH,STHP,SETNAM)) THEN !FIND A SET - CALL WNDSTR(FCAIN,ASET(0,I)) !RESET SEARCH - ELSE - GOTO 20 !NO SUCH SET - END IF - END IF - END DO -C -C GET DATA TYPES -C - 22 CONTINUE - IF (.NOT.WNDPAR('DATA_TYPE',MAPDTYP,LEN(MAPDTYP), - 1 J0,MAPDTYP)) THEN - IF (E_C.EQ.DWC_ENDOFLOOP) GOTO 20 !RETRY FILE - GOTO 22 - END IF - IF (J0.EQ.0) GOTO 20 - IF (J0.LT.0) MAPDTYP='DATA' -C -C GET AREA -C - IF (MPHJ(MPH_NRA_J).NE.FAREA(2).OR. - 1 MPHJ(MPH_NDEC_J).NE.FAREA(3)) THEN !NEW AREA - DO I=0,3 !SET DEFAULT - TAREA(I)=0 !DEFAULT AREA - FAREA(I)=0 !FULL AREA - END DO - FAREA(2)=MPHJ(MPH_NRA_J) !LINE LENGTH - FAREA(3)=MPHJ(MPH_NDEC_J) - TAREA(2)=FAREA(2) !DEFAULT=FULL - TAREA(3)=FAREA(3) - MXAREA(2)=FAREA(2) !MAX. AREA - MXAREA(3)=FAREA(3) - END IF - CALL NMADAR(1,J0,FAREA,0,MXAREA,TAREA,PAREA, - 1 TEAR,PEAR) !GET AREA - IF (J0.LE.0) GOTO 20 !NO AREA GIVEN -C -C DETERMINE MAX/MIN -C - MPMXMN(2)=-1E30 !MAX - MPMXMN(1)=1E30 !MIN - CALL WNMHS8(HISBAD,+1,0.25E0) !INIT HISTOGRAM - DO I=TEAR(2),TEAR(3) !ALL LINES - IF (.NOT.WNFRD(FCAIN,LB_E*MPHJ(MPH_NRA_J), - 1 LBUF,MPHJ(MPH_MDP_J)+ - 1 (I+MPHJ(MPH_NDEC_J)/2)*LB_E*MPHJ(MPH_NRA_J))) THEN - CALL WNCTXT(F_TP,'Error reading map data') - CALL WNGEX !STOP PROGRAM - END IF - CALL WNMHS1(HISBAD,TAREA(2),LBUF(TEAR(0)+MPHJ(MPH_NRA_J)/2)) !HISTO - DO I1=TEAR(0)+MPHJ(MPH_NRA_J)/2, - 1 TEAR(1)+MPHJ(MPH_NRA_J)/2 !ALL POINTS - IF (LBUF(I1).NE.0.0) THEN - MPMXMN(2)=MAX(MPMXMN(2),LBUF(I1)) !SET MAX - MPMXMN(1)=MIN(MPMXMN(1),LBUF(I1)) !SET MIN - ENDIF - END DO - END DO - CALL WNMHS4(HISBAD,MPNOS,F_TP) !GET NOISE - CALL WNMHS9(HISBAD) !FREE HISTOGRAM - CALL WNCTXT(F_TP,'Range: !2E7',MPMXMN) !SHOW MAX/MIN -C -C GET SIZE -C - 23 CONTINUE - IF (PLDEV(2:2).EQ.'P') THEN !PORTRAIT - SIZE(1)=1.3 - SIZE(2)=1.3 - ELSE - SIZE(1)=1 - SIZE(2)=1 - END IF - IF (.NOT.WNDPAR('SIZE',SIZE,2*LB_E,J0,A_B(-A_OB), - 1 SIZE,2)) THEN - IF (E_C.EQ.DWC_ENDOFLOOP) GOTO 20 !RETRY FILE - GOTO 23 - END IF - IF (J0.EQ.0) GOTO 20 - IF (J0.LT.0) THEN - IF (PLDEV(2:2).EQ.'P') THEN !PORTRAIT - SIZE(1)=1.3 - SIZE(2)=1.3 - ELSE - SIZE(1)=1 - SIZE(2)=1 - END IF - END IF -C -C GET CONTOURS -C - 24 CONTINUE - IF (NRCON.EQ.0) THEN !NO CONTOURS - NCF=0 - NCD=0 - GOTO 25 - END IF - CVAL = MAX(0.001,2*MPNOS) ! 2 SIGMA (W.U.) - CVAL = 2.**(INT(LOG(CVAL)/LOG(2.))) ! ROUNDED TO POWER OF 2 - IF (CVAL.GE.MPMXMN(2)) CVAL = CVAL/2. ! LOWER IF NECESSARY - NCF = 0 ! NR OF FULL CONTOURS - NCD = 0 ! NR OF DOTTED CONTOURS - DO WHILE ((CVAL.LT.MPMXMN(2)).AND.(NCF.LT.MXNC/2)) - NCF = NCF+1 - FCONT(NCF) = CVAL ! FULL CONTOURS (>0) - IF (-CVAL.GT.MPMXMN(1)) THEN - NCD = NCD+1 - DCONT(NCD) = -CVAL ! DOTTED CONTOURS (<0) - ENDIF - CVAL = CVAL*SQRT(2.) ! LOGARITHMIC SUCCESSION - END DO - CALL WNCTXS (DFLTXT,' !#E6 ',NCF,FCONT) ! ENCODE FCONT(NCF) - IF (.NOT.WNDPAR('FULL_CONT',FCONT,MXNC*LB_E,NCF,DFLTXT)) THEN - IF (E_C.EQ.DWC_ENDOFLOOP) GOTO 20 - GOTO 24 - END IF - IF (NCF.LT.0) NCF=0 - CALL WNCTXS (DFLTXT,' !#E6 ',NCD,DCONT) ! ENCODE DCONT(NCD) - IF (.NOT.WNDPAR('DOT_CONT',DCONT,MXNC*LB_E,NCD,DFLTXT)) THEN - IF (E_C.EQ.DWC_ENDOFLOOP) GOTO 20 - GOTO 24 - END IF - IF (NCD.LT.0) NCD=0 -C -C GET HALFTONE -C - 25 CONTINUE - IF (NRHALF.EQ.0) THEN - HALF=-1 !NO HALFTONE - GOTO 30 - END IF - IF (.NOT.WNDPAR('HALFTONE',LOPT,LEN(LOPT),J0,'NONE')) THEN - IF (E_C.EQ.DWC_ENDOFLOOP) GOTO 20 !RETRY FILE - GOTO 25 - END IF - IF (J0.LE.0) LOPT='NONE' - IF (LOPT(1:3).EQ.'CON') THEN - HALF=0 - ELSE IF (LOPT(1:3).EQ.'STE') THEN - HALF=1 - ELSE IF (LOPT(1:3).EQ.'PAT') THEN - HALF=2 - ELSE - HALF=-1 - END IF - IF (HALF.GE.0) THEN - IF (.NOT.WNDPAR('RANGE',RANGE,2*LB_E,J0,A_B(-A_OB), - 1 MPMXMN,2)) THEN - IF (E_C.EQ.DWC_ENDOFLOOP) GOTO 20 !RETRY FILE - GOTO 25 - END IF - IF (J0.LE.0) THEN - RANGE(1)=MPMXMN(1) - RANGE(2)=MPMXMN(2) - END IF - DO I=0,MXNTRF !DEFAULT TRANSFORM - TRF(I)=I - END DO - IF (.NOT.WNDPAR('TRANSFORM',TRIN,5*LB_E,J0,'""')) THEN - IF (E_C.EQ.DWC_ENDOFLOOP) GOTO 20 !RETRY FILE - GOTO 25 - END IF - IF (J0.GT.0) THEN !MAKE TRANSFORM - DO I=NINT(MAX(0.,TRIN(1)*MXNTRF)), - 1 NINT(MIN(FLOAT(MXNTRF),TRIN(2)*MXNTRF)) - R1=1. - R0=0. - DO I1=3,J0 - R0=R0+R1*TRIN(I1)*MXNTRF - R1=R1*I/MXNTRF - END DO - TRF(I)=R0 - END DO - END IF - END IF -C -C GET POL. SCALE -C - 30 CONTINUE - PSCAL=0. !NO POL. - IF (NRPOL.NE.0) THEN - PRANGE(1)=0.1*MPMXMN(2) - PRANGE(2)=MPMXMN(2) - IF (.NOT.WNDPAR('POL_RANGE',PRANGE,2*LB_E,J0,A_B(-A_OB), - 1 PRANGE,2)) THEN - IF (E_C.EQ.DWC_ENDOFLOOP) GOTO 20 !RETRY FILE - GOTO 30 - END IF - IF (J0.LE.0) THEN - PRANGE(1)=0.1*MPMXMN(2) - PRANGE(2)=MPMXMN(2) - END IF - IF (.NOT.WNDPAR('POL_SCALE',PSCAL,LB_E,J0, - 1 A_B(-A_OB),MAX(1.,PRANGE(2))/2.)) THEN - IF (E_C.EQ.DWC_ENDOFLOOP) GOTO 10 !RETRY FILE - GOTO 30 - END IF - IF (J0.EQ.0) GOTO 10 - IF (J0.LT.0) PSCAL=MAX(1.,PRANGE(2))/2. - PSCAL=PSCAL/10. !MAKE PER MM - IF (PSCAL.NE.0) PSCAL=1./PSCAL !CORRECT FORMAT - IF (.NOT.WNDPAR('POL_TYPE',LPTYP,16,J0,'POL')) THEN - IF (E_C.EQ.DWC_ENDOFLOOP) GOTO 20 !RETRY FILE - GOTO 30 - END IF - IF (J0.EQ.0) GOTO 10 - IF (J0.LT.0) LPTYP(1)='POL' - POLMAG=.FALSE. - IF (LPTYP(1).EQ.'MAG') POLMAG=.TRUE. - FAREA(0)=TAREA(0) - FAREA(1)=TAREA(1) - FAREA(2)=TAREA(2) !LINE LENGTH - FAREA(3)=TAREA(3) - TREA(0)=TAREA(0) - TREA(1)=TAREA(1) - TREA(2)=MAX(3,FAREA(2)-2) !DEFAULT=-2 - TREA(3)=MAX(3,FAREA(3)-2) - MXAREA(2)=FAREA(2) !MAX. AREA - MXAREA(3)=FAREA(3) - CALL NMADAR(1,J0,FAREA,0,MXAREA,TREA,PREA, - 1 PTEAR,PPREA) !GET AREA - IF (J0.LE.0) GOTO 20 !NO AREA GIVEN - END IF -C -C GET RULE SCALE -C - 31 CONTINUE - RSCAL=0. !NO RULE - IF (NRRUL.NE.0) THEN - IF (.NOT.WNDPAR('RULE_RANGE',RRANGE,2*LB_E,J0,A_B(-A_OB), - 1 MPMXMN,2)) THEN - IF (E_C.EQ.DWC_ENDOFLOOP) GOTO 20 !RETRY FILE - GOTO 31 - END IF - IF (J0.LE.0) THEN - RRANGE(1)=MPMXMN(1) - RRANGE(2)=MPMXMN(2) - END IF - IF (.NOT.WNDPAR('RULE_SCALE',RSCAL,LB_E,J0, - 1 A_B(-A_OB),MAX(1.,RRANGE(2))/2.,1)) THEN - IF (E_C.EQ.DWC_ENDOFLOOP) GOTO 10 !RETRY FILE - GOTO 30 - END IF - IF (J0.EQ.0) GOTO 10 - IF (J0.LT.0) RSCAL=MAX(1.,RRANGE(2))/2. - RSCAL=RSCAL/10. !MAKE PER MM - IF (RSCAL.NE.0) RSCAL=1./RSCAL !CORRECT FORMAT - FAREA(0)=TAREA(0) - FAREA(1)=TAREA(1) - FAREA(2)=TAREA(2) !LINE LENGTH - FAREA(3)=TAREA(3) - TREA(0)=TAREA(0) - TREA(1)=TAREA(1) - TREA(2)=MAX(3,FAREA(2)-2) !DEFAULT=-2 - TREA(3)=MAX(3,FAREA(3)-2) - MXAREA(2)=FAREA(2) !MAX. AREA - MXAREA(3)=FAREA(3) - CALL NMADAR(1,J0,FAREA,0,MXAREA,TREA,PREA, - 1 RTEAR,PPREA) !GET AREA - IF (J0.LE.0) GOTO 20 !NO AREA GIVEN - END IF -C -C GET COORDINATE TYPE -C - 26 CONTINUE - IF (CRD.LT.-6.OR.CRD.GT.6) CRD=0 !FIT IN RANGE - IF (.NOT.WNDPAR('COORD',LOPT,LEN(LOPT), - 1 J0,CRDNAM(CRD))) THEN - IF (E_C.EQ.DWC_ENDOFLOOP) GOTO 20 !RETRY FILE - GOTO 26 - END IF - IF (J0.LE.0) LOPT='NONE' - I1=1 !PLOT GRIDS COORDS - IF (LOPT(1:1).EQ.'O') THEN !NO GRIDS - I1= -1 - LOPT=LOPT(2:) !STRIP THE 'O' - END IF - IF (LOPT(:3).EQ.'DLM') THEN !SET COORD. TYPE - CRD=1 - ELSE IF (LOPT(:3).EQ.'LM') THEN - CRD=2 - ELSE IF (LOPT(:3).EQ.'DRA') THEN - CRD=3 - ELSE IF (LOPT(:3).EQ.'RAD') THEN - CRD=4 - ELSE IF (LOPT(:3).EQ.'DDE') THEN - CRD=5 - ELSE IF (LOPT(:3).EQ.'DEG') THEN - CRD=6 - ELSE - CRD=0 - END IF - CRD=I1*CRD !MERGE WITH GRIDS - IF (CRD.NE.0) THEN !COORD. WANTED - IF (CRDTYP.GT.3.OR.CRDTYP.LT.1) CRDTYP=1 !FIT IN RANGE - IF (.NOT.WNDPAR('COORD_TYPE',LOPT,LEN(LOPT), - 1 J0,TYPNAM(CRDTYP))) THEN - IF (E_C.EQ.DWC_ENDOFLOOP) GOTO 20 !RETRY FILE - GOTO 26 - END IF - IF (J0.LE.0) LOPT='TICK' - IF (LOPT(:3).EQ.'DOT') THEN !SET COORD. TYPE - CRDTYP=2 - ELSE IF (LOPT(:3).EQ.'FUL') THEN - CRDTYP=3 - ELSE - CRDTYP=1 - END IF - END IF -C -C GET CONTOURING FOR COORD PRECISION -C - IF (.NOT.WNDPAR('COORD_PREC',I,LB_J,J0)) THEN - I=256 - ELSE IF (J0.LE.0) THEN - I=256 - END IF - HAINT=I -C -C GET PLOT POSITIONS -C - 27 CONTINUE - IF (PLTSRC.LT.0.OR.PLTSRC.GT.3) PLTSRC=0 !FIT IN RANGE - IF (.NOT.WNDPAR('PLOT_POSITIONS',LOPT,LEN(LOPT), - 1 J0,SRCNAM(PLTSRC))) THEN - IF (E_C.EQ.DWC_ENDOFLOOP) GOTO 20 !RETRY FILE - GOTO 27 - END IF - IF (J0.LE.0) LOPT='NO' - IF (LOPT(1:2).EQ.'NO') PLTSRC=0 !NO POSITIONS - IF (LOPT(1:3).EQ.'YES') PLTSRC=1 !PLOT POSITIONS - IF (LOPT(1:3).EQ.'NAM') PLTSRC=2 !ALSO WRITE NAME - IF (LOPT(1:3).EQ.'EDI') PLTSRC=3 !AND WANTS TO EDIT - IF (PLTSRC.GT.0) THEN !WANT SOURCES, SO... - CALL NMODAX(NSRC) !GET SOURCES - IF (PLTSRC.GT.1) THEN - JS=NMONM1() !INITIALISE NAMELIST - IF (E_C.EQ.DWC_ENDOFLOOP) GOTO 27 !RETRY - END IF - END IF -C -C GET PLOT POSITIONS -C - 35 CONTINUE - IF (.NOT.WNDPAR('PLOT_HEADING',LOPT,LEN(LOPT), - 1 J0,'YES')) THEN - LOPT='YES' - ELSE IF (J0.LE.0) THEN - LOPT='YES' - END IF - IF (LOPT(1:2).EQ.'NO') PLTHDR=.FALSE. !NO HEADING - IF (LOPT(1:3).EQ.'YES') PLTHDR=.TRUE. !PLOT HEADING -C -C READY -C - END IF -C - 900 CONTINUE - RETURN !READY -C -C - END diff --git a/src/nplot/npldch.for b/src/nplot/npldch.for deleted file mode 100644 index 85a8df6d1c0e67f9d1c04f8139125b0f6074c1ef..0000000000000000000000000000000000000000 --- a/src/nplot/npldch.for +++ /dev/null @@ -1,113 +0,0 @@ -C+ NPLDCH.FOR -C HjV 940112 -C Combined parts of old version of NPLTEL and NPLRES -C -C Revisions: -C HjV 940329 Fill in dummy arguments in call to NPLTEL and NPLRES -C JPH 960729 Comments -C - SUBROUTINE NPLDCH (LDATTP,IPOL,NHV,IFRS) -C -C Load data in buffer as (HA, CHAN) -C -C Result: -C -C CALL NPLDCH Load data in buffer as (HA, CHAN) -C -C Include files: -C - INCLUDE 'WNG_DEF' - INCLUDE 'STH_O_DEF' !SET HEADER - INCLUDE 'NPL_DEF' -C -C Parameters: -C - INTEGER LDATTP !CURRENT DATA TYPE - INTEGER IPOL - INTEGER NHV(0:1) !# OF PAGES - INTEGER IFRS(0:1) !CURRENT IFR'S -C -C Arguments: -C -C -C Function references: -C - LOGICAL NSCSIF !READ IFR TABLE - LOGICAL NSCSTL !GET A SET -C -C Data declarations: -C - INTEGER NPLOT !# OF INTERFEROMETERS TO DO - INTEGER PTXT(MXNCHN) !CROSS CHANNELS - INTEGER SCHAN(0:MXNCHN-1) !CHANNELS TO DO - INTEGER*2 IFRT(0:STHIFR-1) !IFR TABLE - INTEGER IFRA(0:1,0:STHIFR-1) - REAL ANG(0:2,0:STHIFR-1) - REAL BASEL(0:STHIFR-1) !BASELINES - INTEGER IRED(0:STHIFR-1) !REDUNDANT INDICATORS - INTEGER STHP !SET HEADER POINTER - BYTE STH(0:STH__L-1) !SET HEADER - INTEGER*2 STHI(0:STH__L/LB_I-1) - INTEGER STHJ(0:STH__L/LB_J-1) - REAL STHE(0:STH__L/LB_E-1) - DOUBLE PRECISION STHD(0:STH__L/LB_D-1) - EQUIVALENCE (STH,STHI,STHJ,STHE,STHD) -C- -C -C FIND REDUNDANT INTERFEROMETERS -C - CALL WNGMVZ(STH__L,STH(0)) !MAKE SURE PROPER NUMBERS - IF (NSCSTL(FCAIN,SETS,STH(0),STHP,SETNAM,LPOFF)) THEN !A SET - CALL WNDSTR(FCAIN,SETS) !RESET SET SEARCH - IF (OPT.EQ.'RES' .AND. NSRC(0).EQ.0) THEN !REDUNDANCY ASKED - IF (.NOT.NSCSIF(FCAIN,STH,IFRT,IFRA,ANG)) THEN !READ IFR TABLE - CALL WNCTXT(F_TP,'Read error IFR table') - RETURN - END IF - CALL NSCMBL(STHE(STH_RTP_E),STHJ(STH_NIFR_J),IFRT, - 1 SIFRS,BASEL) !MAKE BASELINES - CALL NCARRT(STHJ(STH_NIFR_J),BASEL,1E0,IRED,ANG) !GET REDUNDANT - DO I1=0,STHJ(STH_NIFR_J)-1 !DELETE NON-REDUNDANT - IF (IRED(I1).LE.0) THEN !NON-REDUNDANT - SIFRS(IFRA(0,I1),IFRA(1,I1))=.FALSE. - SIFRS(IFRA(1,I1),IFRA(0,I1))=.FALSE. - END IF - END DO - END IF - END IF -C -C FIND CHANNELS TO DO -C - NPLOT=0 !SELECTED CIFRS - DO I=0,MXNCHN-1 !SET NOT CHANNEL - SCHAN(I)=-1 - END DO - DO WHILE(NSCSTL(FCAIN,SETS,STH(0),STHP,SETNAM,LPOFF)) !ALL SETS - CALL WNDSTI(FCAIN,SETNAM) !MAKE SURE OF NAME - IF (SETNAM(3).LT.MXNCHN) THEN !CAN DO - IF (SCHAN(SETNAM(3)).LT.0) THEN !NEW ONE - SCHAN(SETNAM(3))=1 !SET CHANNEL SELECTED - NPLOT=NPLOT+1 !COUNT PLOT - END IF - END IF - END DO - I1=0 - DO I=0,MXNCHN-1 !SET ORDER - IF (SCHAN(I).GT.0) THEN - SCHAN(I)=I1 !SET ORDER - I1=I1+1 - PTXT(I1)=I !SAVE CHANNEL NUMBER - END IF - END DO -C -C PLOT TELESCOPE/RESIDUALS ERRORS -C - IF (OPT.EQ.'TEL') THEN ! plot telescopes - CALL NPLTEL (LDATTP,IPOL,NPLOT,PTXT,NHV,I1,SCHAN,IFRS) - ELSE ! plot interferometers - CALL NPLRES (LDATTP,IPOL,NPLOT,PTXT,NHV,I1,SCHAN,IFRS) - ENDIF -C -C - END - diff --git a/src/nplot/npldha.for b/src/nplot/npldha.for deleted file mode 100644 index 523e7b6954464bc4367b94d777d78c0037afccc7..0000000000000000000000000000000000000000 --- a/src/nplot/npldha.for +++ /dev/null @@ -1,158 +0,0 @@ -C+ NPLDHA.FOR -C HjV 940117 -C -C Revisions: -C HjV 940329 Fill in dummy arguments in call to NPLTEL and NPLRES -C - SUBROUTINE NPLDHA (LDATTP,IPOL,NHV) -C -C Load data in buffer as (CHAN, IFR) -C -C Result: -C -C CALL NPLDHA Load data in buffer as (CHAN, IFR) -C -C Include files: -C - INCLUDE 'WNG_DEF' - INCLUDE 'STH_O_DEF' !SET HEADER - INCLUDE 'NPL_DEF' -C -C Parameters: -C - INTEGER LDATTP !CURRENT DATA TYPE - INTEGER IPOL - INTEGER NHV(0:1) !# OF PAGES -C -C Arguments: -C -C -C Function references: -C - LOGICAL NSCSIF !READ IFR TABLE - LOGICAL NSCSTL !GET A SET -C -C Data declarations: -C - INTEGER NPLOT !# OF INTERFEROMETERS TO DO - INTEGER PTXT(MXNCHN) !CROSS CHANNELS - INTEGER SCHAN(0:MXNCHN-1) !CHANNELS TO DO - INTEGER TABIFR(0:STHTEL-1,0:STHTEL-1) !IFR PLOT POINTERS - INTEGER BTEL(0:1,0:STHIFR-1) !TEL. TO PLOT - INTEGER*2 IFRT(0:STHIFR-1) !IFR TABLE - INTEGER IFRA(0:1,0:STHIFR-1) - REAL ANG(0:2,0:STHIFR-1) - REAL BASEL(0:STHIFR-1) !BASELINES - INTEGER IRED(0:STHIFR-1) !REDUNDANT INDICATORS - INTEGER STHP !SET HEADER POINTER - BYTE STH(0:STH__L-1) !SET HEADER - INTEGER*2 STHI(0:STH__L/LB_I-1) - INTEGER STHJ(0:STH__L/LB_J-1) - REAL STHE(0:STH__L/LB_E-1) - DOUBLE PRECISION STHD(0:STH__L/LB_D-1) - EQUIVALENCE (STH,STHI,STHJ,STHE,STHD) -C- -C -C FIND REDUNDANT INTERFEROMETERS -C - CALL WNGMVZ(STH__L,STH(0)) !MAKE SURE PROPER NUMBERS - IF (NSCSTL(FCAIN,SETS,STH(0),STHP,SETNAM,LPOFF)) THEN !A SET - CALL WNDSTR(FCAIN,SETS) !RESET SET SEARCH - IF (OPT.EQ.'RES' .AND. NSRC(0).EQ.0) THEN !REDUNDANCY ASKED - IF (.NOT.NSCSIF(FCAIN,STH,IFRT,IFRA,ANG)) THEN !READ IFR TABLE - CALL WNCTXT(F_TP,'Read error IFR table') - RETURN - END IF - CALL NSCMBL(STHE(STH_RTP_E),STHJ(STH_NIFR_J),IFRT, - 1 SIFRS,BASEL) !MAKE BASELINES - CALL NCARRT(STHJ(STH_NIFR_J),BASEL,1E0,IRED,ANG) !GET REDUNDANT - DO I1=0,STHJ(STH_NIFR_J)-1 !DELETE NON-REDUNDANT - IF (IRED(I1).LE.0) THEN !NON-REDUNDANT - SIFRS(IFRA(0,I1),IFRA(1,I1))=.FALSE. - SIFRS(IFRA(1,I1),IFRA(0,I1))=.FALSE. - END IF - END DO - END IF - END IF -C -C FIND CHANNELS TO DO -C - NPLOT=0 !SELECTED CIFRS - DO I=0,MXNCHN-1 !SET NOT CHANNEL - SCHAN(I)=-1 - END DO - DO WHILE(NSCSTL(FCAIN,SETS,STH(0),STHP,SETNAM,LPOFF)) !ALL SETS - CALL WNDSTI(FCAIN,SETNAM) !MAKE SURE OF NAME - IF (SETNAM(3).LT.MXNCHN) THEN !CAN DO - IF (SCHAN(SETNAM(3)).LT.0) THEN !NEW ONE - SCHAN(SETNAM(3))=1 !SET CHANNEL SELECTED - NPLOT=NPLOT+1 - END IF - END IF - END DO - I1=0 - DO I=0,MXNCHN-1 !SET ORDER - IF (SCHAN(I).GT.0) THEN - SCHAN(I)=I1 !SET ORDER - I1=I1+1 - PTXT(I1)=I !SAVE CHANNEL NUMBER - END IF - END DO -C -C FIND TELESCOPE/INTERFEROMETERS TO DO -C - NPLOT=0 !SELECTED CIFRS - IF (OPT.EQ.'TEL') THEN !FIND TELESCOPES TO DO - DO I1=1,STHTEL !ANNOTATION - IF (STELS(I1-1)) THEN - NPLOT=NPLOT+1 !SELECTED - TXT(1)(NPLOT:NPLOT)=TELNAM(I1:I1) - END IF - END DO - ELSE !FIND INTERF. to DO - DO I=0,STHTEL-1 - DO I1=I,STHTEL-1 !ANNOTATION - TABIFR(I,I1)=-1 !SET NOT SELECTED - IF (SIFRS(I,I1)) THEN !SELECTED - BTEL(0,NPLOT)=I !SAVE TEL. TO PLOT - BTEL(1,NPLOT)=I1 - BASEL(NPLOT)=ABS(STHE(STH_RTP_E+I)-STHE(STH_RTP_E+I1)) - NPLOT=NPLOT+1 - END IF - END DO - END DO - IF (IFR_MODE.EQ.'SORT') THEN !SORT ON BASELINE - DO I=0,NPLOT-2 - DO I1=0,NPLOT-2-I - IF (ABS(BASEL(I1)-BASEL(I1+1)).GT.1 .AND. - 1 BASEL(I1).GT.BASEL(I1+1)) THEN !SWAP - R0=BASEL(I1) - BASEL(I1)=BASEL(I1+1) - BASEL(I1+1)=R0 - DO I2=0,1 - I3=BTEL(I2,I1) - BTEL(I2,I1)=BTEL(I2,I1+1) - BTEL(I2,I1+1)=I3 - END DO - END IF - END DO - END DO - END IF - DO I=0,NPLOT-1 !SET IFR NAMES - TXT(1)(I+1:I+1)=TELNAM(BTEL(0,I)+1:BTEL(0,I)+1) - TXT(2)(I+1:I+1)=TELNAM(BTEL(1,I)+1:BTEL(1,I)+1) - TABIFR(BTEL(0,I),BTEL(1,I))=I !SET IFR PTR - END DO - END IF -C -C PLOT TELESCOPE/RESIDUALS ERRORS -C - IF (OPT.EQ.'TEL') THEN !FIND TELESCOPES TO DO - CALL NPLTEL (LDATTP,IPOL,NPLOT,PTXT,NHV,TABIFR,SCHAN,I1) - ELSE !FIND REDUNDANT INTERF. - CALL NPLRES (LDATTP,IPOL,NPLOT,PTXT,NHV,TABIFR,SCHAN,I1) - ENDIF -C -C - END - diff --git a/src/nplot/npldif.for b/src/nplot/npldif.for deleted file mode 100644 index 3543b0181cf2eb9c1bf51310ed08571f9472745c..0000000000000000000000000000000000000000 --- a/src/nplot/npldif.for +++ /dev/null @@ -1,151 +0,0 @@ -C+ NPLDIF.FOR -C HjV 940112 -C Combined parts of old version of NPLTEL and NPLRES -C -C Revisions: -C HjV 940329 Fill in dummy arguments in call to NPLTEL and NPLRES -C JPH 960730 Add sort for IFR_MODE = INVERT -C -C - SUBROUTINE NPLDIF (LDATTP,IPOL,NHV) -C -C Load data in buffer as (HA,IFR) -C -C Result: -C -C CALL NPLDIF Load data in buffer as (HA,IFR) -C -C Include files: -C - INCLUDE 'WNG_DEF' - INCLUDE 'STH_O_DEF' !SET HEADER - INCLUDE 'NPL_DEF' -C -C Parameters: -C - INTEGER LDATTP !CURRENT DATA TYPE - INTEGER IPOL - INTEGER NHV(0:1) !# OF PAGES -C -C Arguments: -C -C -C Function references: -C - LOGICAL NSCSIF !READ IFR TABLE - LOGICAL NSCSTL !GET A SET -C -C Data declarations: -C - INTEGER NPLOT !# OF INTERFEROMETERS TO DO - INTEGER PTXT(MXNCHN) !CROSS CHANNELS - INTEGER TABIFR(0:STHTEL-1,0:STHTEL-1) !IFR PLOT POINTERS - INTEGER*2 IFRT(0:STHIFR-1) !IFR TABLE - INTEGER IFRA(0:1,0:STHIFR-1) - REAL ANG(0:2,0:STHIFR-1) - REAL BASEL(0:STHIFR-1) !BASELINES - INTEGER BTEL(0:1,0:STHIFR-1) !TEL. TO PLOT - INTEGER IRED(0:STHIFR-1) !REDUNDANT INDICATORS - INTEGER STHP !SET HEADER POINTER - BYTE STH(0:STH__L-1) !SET HEADER - INTEGER*2 STHI(0:STH__L/LB_I-1) - INTEGER STHJ(0:STH__L/LB_J-1) - REAL STHE(0:STH__L/LB_E-1) - DOUBLE PRECISION STHD(0:STH__L/LB_D-1) - EQUIVALENCE (STH,STHI,STHJ,STHE,STHD) -C- -C -C FIND REDUNDANT INTERFEROMETERS -C - CALL WNGMVZ(STH__L,STH(0)) !MAKE SURE PROPER NUMBERS - IF (NSCSTL(FCAIN,SETS,STH(0),STHP,SETNAM,LPOFF)) THEN !A SET - CALL WNDSTR(FCAIN,SETS) !RESET SET SEARCH - IF (OPT.EQ.'RES' .AND. NSRC(0).EQ.0) THEN !REDUNDANCY ASKED - IF (.NOT.NSCSIF(FCAIN,STH,IFRT,IFRA,ANG)) THEN !READ IFR TABLE - CALL WNCTXT(F_TP,'Read error IFR table') - RETURN - END IF - CALL NSCMBL(STHE(STH_RTP_E),STHJ(STH_NIFR_J),IFRT, - 1 SIFRS,BASEL) !MAKE BASELINES - CALL NCARRT(STHJ(STH_NIFR_J),BASEL,1E0,IRED,ANG) !GET REDUNDANT - DO I1=0,STHJ(STH_NIFR_J)-1 !DELETE NON-REDUNDANT - IF (IRED(I1).LE.0) THEN !NON-REDUNDANT - SIFRS(IFRA(0,I1),IFRA(1,I1))=.FALSE. - SIFRS(IFRA(1,I1),IFRA(0,I1))=.FALSE. - END IF - END DO - END IF - END IF -C -C FIND TELESCOPE/INTERFEROMETERS TO DO -C - NPLOT=0 !SELECTED CIFRS - IF (OPT.EQ.'TEL') THEN !FIND TELESCOPES TO DO - DO I1=1,STHTEL !ANNOTATION - IF (STELS(I1-1)) THEN - NPLOT=NPLOT+1 !SELECTED - TXT(1)(NPLOT:NPLOT)=TELNAM(I1:I1) - END IF - END DO - ELSE !FIND INTERF. to DO - DO I=0,STHTEL-1 - DO I1=I,STHTEL-1 !ANNOTATION - TABIFR(I,I1)=-1 !SET NOT SELECTED - IF (SIFRS(I,I1)) THEN !SELECTED - BTEL(0,NPLOT)=I !SAVE TEL. TO PLOT - BTEL(1,NPLOT)=I1 - BASEL(NPLOT)=ABS(STHE(STH_RTP_E+I)-STHE(STH_RTP_E+I1)) - NPLOT=NPLOT+1 - END IF - END DO - END DO - IF (IFR_MODE.EQ.'INVERT') THEN !SORT ON East tel - DO I=0,NPLOT-2 - DO I1=0,NPLOT-2-I - IF (BTEL(0,I1 )+STHTEL*BTEL(1,I1 ) .GT. - 1 BTEL(0,I1+1)+STHTEL*BTEL(1,I1+1)) THEN !SWAP - R0=BASEL(I1) - BASEL(I1)=BASEL(I1+1) - BASEL(I1+1)=R0 - DO I2=0,1 - I3=BTEL(I2,I1) - BTEL(I2,I1)=BTEL(I2,I1+1) - BTEL(I2,I1+1)=I3 - END DO - END IF - END DO - END DO - ENDIF - IF (IFR_MODE.EQ.'SORT') THEN !SORT ON BASELINE - DO I=0,NPLOT-2 - DO I1=0,NPLOT-2-I - IF (ABS(BASEL(I1)-BASEL(I1+1)).GT.1 .AND. - 1 BASEL(I1).GT.BASEL(I1+1)) THEN !SWAP - R0=BASEL(I1) - BASEL(I1)=BASEL(I1+1) - BASEL(I1+1)=R0 - DO I2=0,1 - I3=BTEL(I2,I1) - BTEL(I2,I1)=BTEL(I2,I1+1) - BTEL(I2,I1+1)=I3 - END DO - END IF - END DO - END DO - END IF - DO I=0,NPLOT-1 !SET IFR NAMES - TXT(1)(I+1:I+1)=TELNAM(BTEL(0,I)+1:BTEL(0,I)+1) - TXT(2)(I+1:I+1)=TELNAM(BTEL(1,I)+1:BTEL(1,I)+1) - TABIFR(BTEL(0,I),BTEL(1,I))=I !SET IFR PTR - END DO - END IF -C -C PLOT TELESCOPE/RESIDUALS ERRORS -C - IF (OPT.EQ.'TEL') THEN !FIND TELESCOPES TO DO - CALL NPLTEL (LDATTP,IPOL,NPLOT,PTXT,NHV,TABIFR,I1,I1) - ELSE !FIND REDUNDANT INTERF. - CALL NPLRES (LDATTP,IPOL,NPLOT,PTXT,NHV,TABIFR,I1,I1) - ENDIF -C - END diff --git a/src/nplot/nplini.for b/src/nplot/nplini.for deleted file mode 100644 index 2be7e9a628713077a2c919b175aa2e708d44126b..0000000000000000000000000000000000000000 --- a/src/nplot/nplini.for +++ /dev/null @@ -1,54 +0,0 @@ -C+ NPLINI.FOR -C WNB 910617 -C -C Revisions: -C WNB 910930 Change default spooling -C - SUBROUTINE NPLINI -C -C Initialize NPLOT program -C -C Result: -C -C CALL NPLINI will set header lines, logging, DWARF interface -C -C Include files: -C - INCLUDE 'WNG_DEF' - INCLUDE 'NPL_DEF' -C -C Parameters: -C -C -C Arguments: -C -C -C Function references: -C - LOGICAL WNDINI !INIT DWARF - LOGICAL WNDDAB !OPEN DATABASE -C -C Data declarations: -C -C- -C -C SET HEADER LINES -C - CALL WNCFHD(F_P,1,'!40C\Program to plot NSCAN/NMAP data') -C -C START DWARF -C - IF (.NOT.WNDINI(PRGNAM)) CALL WNGEX !EXIT IF NO DWARF START -C -C LOGGING -C - CALL WNDLON(LOGCD) !PROPER LOGGING -C -C DATABASE -C - IF (.NOT.WNDDAB()) CALL WNGEX !OPEN DATABASE -C - RETURN !READY -C -C - END diff --git a/src/nplot/npllod.for b/src/nplot/npllod.for deleted file mode 100644 index 1e0dd17c1006c3d46aa7a95f680dc7978b5c0764..0000000000000000000000000000000000000000 --- a/src/nplot/npllod.for +++ /dev/null @@ -1,122 +0,0 @@ -C+ NPLLOD.FOR -C HjV 940111 -C Combined parts of old version of NPLTEL and NPLRES -C Solve small bug with PLUVO plot -C -C Revisions: -C HjV 940530 Plot different datatypes on one page -C CMV 940822 Option to abort during loop of plots -C JPH 960622 Interchange order of data-type and polarisation loops -C JPH 960726 Donot reenable control-C -C JPH 960730 IFR_MODE INVERT -C HjV 970723 Remove control-C stuff (commented out with CCC) -C - SUBROUTINE NPLLOD -C -C Load telescope/residual data/errors for NPLOT -C -C Result: -C -C CALL NPLLOD Load telescope/residual data/errors -C -C Include files: -C - INCLUDE 'WNG_DEF' - INCLUDE 'CBITS_DEF' - INCLUDE 'STH_O_DEF' !SET HEADER - INCLUDE 'NPL_DEF' -C -C Parameters: -C -C -C Arguments: -C -C -C Function references: -C - LOGICAL NMOMSL !CALCULATE MODEL DATA -CCC INTEGER WNGCCN ! acknowledge and enable control-C -C -C Data declarations: -C - INTEGER NHV(0:1) !# OF PAGES - INTEGER LDATTP !CURRENT DATA TYPE - INTEGER POLCOD(0:3) !POLARISATION CODE - DATA POLCOD/XX_P,XY_P,YX_P,YY_P/ - INTEGER IPOL !CURRENT POL. BITS - INTEGER IFRS(0:1) !CURRENT IFR'S - BYTE STH(0:STH__L-1) !SET HEADER - INTEGER*2 STHI(0:STH__L/LB_I-1) - INTEGER STHJ(0:STH__L/LB_J-1) - REAL STHE(0:STH__L/LB_E-1) - DOUBLE PRECISION STHD(0:STH__L/LB_D-1) - EQUIVALENCE (STH,STHI,STHJ,STHE,STHD) -C- -C -C INIT SOURCE MODEL -C - IF (OPT.NE.'TEL') THEN - IF (NSRC(0).GT.0) THEN !MODEL WANTED - IF (.NOT.NMOMSL(FCAIN,SETS,LPOFF)) THEN !SET MODEL DATA - CALL WNCTXT(F_TP,'Error in model calculation') - RETURN - END IF - END IF - END IF -C -C Load data ... -C - DO IPOL=0,3 - DO LDATTP=1,NDATTP -CCC CALL WNGCCD ! trap control-C, zero - ! count - IF (IAND(SPOL,POLCOD(IPOL)).NE.0) THEN !SELECTED THIS POL. - IF (IFR_MODE.EQ.'NORMAL' .OR. - 1 IFR_MODE.EQ.'INVERT' .OR. - 1 IFR_MODE.EQ.'SORT') THEN !SCN FILE: (HA,IFRS) -C from SCN file as (HA,IFR) per CHAN - CALL NPLDIF (LDATTP,IPOL,NHV) - ELSE IF (IFR_MODE.EQ.'SPECTRAL') THEN !SCN DATA: (HA,CHAN) -C from SCN file as (HA,CHAN) per IFR - DO I1=0,STHTEL-1 - IF (OPT.EQ.'TEL') THEN - IF (STELS(I1)) THEN !SELECTED - IFRS(0)=I1 - CALL NPLDCH(LDATTP,IPOL,NHV,IFRS) - END IF - IF (NO_MORE) RETURN - ELSE - DO I2=I1,STHTEL-1 - IF (SIFRS(I1,I2)) THEN !SELECTED - IFRS(0)=I1 - IFRS(1)=I2 - CALL NPLDCH(LDATTP,IPOL,NHV,IFRS) - END IF - IF (NO_MORE) RETURN - END DO - END IF - END DO - ELSE IF (IFR_MODE.EQ.'BAND') THEN !SCN FILE: (CHAN,IFR) -C from SCN file as (CHAN,IFR) per HA - CALL NPLDHA (LDATTP,IPOL,NHV) - ELSE !ERROR -C No other options yet... - CALL WNCTXT('Unknown IFR_MODE !AS',IFR_MODE) - ENDIF - END IF -CCC IF (WNGCCN().GT.1) NO_MORE=.TRUE. ! acknowledge double control-C -CCC CALL WNGCCS(1) ! simulate (if none seen) - IF (NO_MORE) RETURN - END DO - END DO -C -C CLOSE PLOT-DEVICE -C - IF ((PPP(1).GT.1).OR.(PPP(2).GT.1)) THEN - CALL NPLCLO(DQID,NHV) - PPPNR=-1 - END IF -C - RETURN -C - END diff --git a/src/nplot/nplmap.fsc b/src/nplot/nplmap.fsc deleted file mode 100644 index 949163c8f37396e95102f65f041e7f5499b81af3..0000000000000000000000000000000000000000 --- a/src/nplot/nplmap.fsc +++ /dev/null @@ -1,1548 +0,0 @@ -C+ NPLMAP.FOR -C WNB 910619 -C -C Revisions: -C WNB 911217 Change to WNP/WQ -C WNB 911220 Add loops, pol., ruled surface -C WNB 920130 Change multiple pages -C WNB 920423 Allow UV-plane coordinates -C HjV 920728 Change annotation for contours: -C Print 9 iso. 15 values per line -C WNB 920811 Change limited range to white at top end -C HjV 920827 Change character expansion for plot-info -C WNB 930401 Do shading first; then plots; then coordinates -C HjV 930423 Change some text -C HjV 930705 RULE plot horizontal plotted -C WNB 931018 RULE plot horizontal small errors -C CMV 931130 Plot markers in color for X11 -C HjV 940131 Small error RULE PLOT when SIZE <> 1,1 -C CMV 940420 Option to annotate sources in plot -C CMV 940428 Use NMONAM to get proper names for annotation -C CMV 940622 Option to connect sources and annotate -C WNB 940624 Correct len statement -C CMV 940817 Options to ignore pixel coordinate axes -C CMV 940829 Correct linetype of rotation vectors if overlayed -C CMV 940930 More spacing between annotation and axis -C HjV 941205 Fix bug with RA =~ 0.0 (No coordinates plotted) -C HjV 950711 Add PLTHDR (Plot heading) -C JPH 960812 Control-C handling -C JPH 960815 Display user comment from MPH -C Report first map index on terminal -C WNB 970521 Plot coordinates as contours above DEC=80 deg -C WNB 970527 Adjustment for very special cases above 80 deg -C WNB 970604 Further sdjustment for very special cases at pole -C WNB 970605 Default COORD_PREC to 256 -C HjV 970723 Remove control-C stuff (commented out with CCC) -C - SUBROUTINE NPLMAP -C -C Plot maps -C -C Result: -C -C CALL NPLMAP Plot maps -C -C PIN references: -C -C SOURCES -C TEXT -C -C Include files: -C - INCLUDE 'WNG_DEF' - INCLUDE 'MPH_O_DEF' - INCLUDE 'MDH_O_DEF' !MODEL HEADER - INCLUDE 'MDL_O_DEF' !MODEL LINE - INCLUDE 'STH_O_DEF' !SET HEADER - INCLUDE 'NPL_DEF' -C -C Parameters: -C -C -C Arguments: -C -C -C Function references: -C - LOGICAL WQ_MPAGE !OPEN PLOT DEVICE - LOGICAL WNFRD !READ DISK - LOGICAL WNDPAR !GET USER INPUT - INTEGER WNMEJC !CEIL(X) - INTEGER WNMEJF !FLOOR(X) - INTEGER WNCALN !STRING LENGTH -CCC INTEGER WNGCCN ! check control-C's - CHARACTER*32 WNTTSG !SET NAME - LOGICAL NMASTL !GET MAP - LOGICAL WNGGVA !GET MEMORY - DOUBLE PRECISION WNGDPF,WNGDNF !NORMALISE ANGLE - REAL WNGENF !NORMALISE ANGLE - DOUBLE PRECISION WNGDPD,WNGDND !NORMALISE ANGLE - LOGICAL NMONAM !FIND PROPER NAME -C -C Data declarations: -C - CHARACTER*32 DUSER !USERNAME - INTEGER NHV(0:1) !# PAGES - INTEGER MXNHV(0:1) !MAX. # OF PAGES - INTEGER NRPLT !SET COUNT - INTEGER STARTJ !USED FOR RULE - INTEGER BUFPTR,BFPTRE !TRANSPOSE BUFFER ADDR - INTEGER LSIZE !BYTES PER RA NEEDED - INTEGER RPPD !RA POINTS PER DEC - INTEGER RA_AX,DEC_AX !RA-AXIS, DEC-AXIS - INTEGER RA_PP !RA PER POINT - INTEGER NRPNTS !NR. OF POINTS TO DE - INTEGER MEMUSE !MEMORY TO USE - INTEGER OFFRA,OFFDEC !ADDR OFFSET FOR RA AND DEC - REAL STEP(2) !X,Y DISTANCE BETWEEN POINTS - LOGICAL UVPL !UV-PLANE OUTPUT - CHARACTER*132 STR !ANNOTATION - CHARACTER*10 NAMES(2) !SOURCE NAMES (INPUT) - REAL RD(2,2) !SOURCE COORDINATES - INTEGER KI,KJ,KT !IFR COUNTS - CHARACTER*16 TSTR !TEL. NAMES - DATA TSTR/'0123456789ABCDEF'/ - REAL PC(2) !LOWER LEFT CORNER - REAL PCD(2,2) !PLOT STEPS - REAL PGRD(2,0:64) !COORDINATE LINES - REAL PGRD1(0:128) - EQUIVALENCE(PGRD,PGRD1) - REAL WEDGE(0:256) !WEDGE - REAL WRANGE(2) !WEDGE INTENSITY RANGE - DATA WRANGE/0.,256./ - INTEGER CID1,CID2,SID,CIDC2 !CONTOUR/SHADING ID - DATA CID1,CID2,SID,CIDC2/0,0,0,0/ - INTEGER CONTLP,CONTP,CONTPE !LENGTH, POINTER, E_PTR COORD CONTOURS - INTEGER COCOLP,COCOP,COCOPE !LENGTH, PTR, E_PTR COORD. BUFFER - INTEGER PID1,PID2 !POL, RULED ID - DATA PID1,PID2/0,0/ - REAL LBUF(0:4095) !DATA BUFFER - REAL ABUF(0:4095) !ANGLE BUFFER - INTEGER GRTAB1(19) !TEST TABLE INCREMENT - DATA GRTAB1/1,2,5,10,30,60,120,300,600,1800,3600, - 1 7200,18000,36000,72000,180000,360000, - 1 720000,1440000/ - INTEGER GRTAB(22) !TEST TABLE INCREMENT - DATA GRTAB/1,2,5,10,20,50,100,200,500,1000,2000,5000, - 1 10000,20000,50000,100000,200000,500000, - 1 1000000,2000000,5000000,10000000/ - REAL DIR(2,2) !TEXT DIRECTION - DATA DIR/0.,1.,-1.,0/ !HORIZONTAL, VERTICAL - REAL L,M !L,M POSITIONS - DOUBLE PRECISION RA,DEC !RA, DEC POSITIONS - REAL FSC,FSCSGN !RA, DEC SCALE - LOGICAL PLCR !PLOT CROSS - LOGICAL FIRST ! new plot - LOGICAL DONE !DONE WITH EDIT LOOP? - DOUBLE PRECISION SAVRA(2) !SAVE APPARENT COORDINATES - DOUBLE PRECISION CCRD(2,4) !CORNER RA,DEC - CHARACTER*12 TXTT1 - CHARACTER*24 TXTT2 - REAL R2,R3,R4,R5,R6,R0C - INTEGER J6 - REAL CHREXP !CHARACTER EXPANSION - DATA CHREXP/0.7/ - INTEGER MPHP,MPHP1 !MAP POINTER - INTEGER SETNAM1(0:7) !SET NAME - BYTE MPH(0:MPHHDL-1) !MAP HEADER - INTEGER*2 MPHI(0:MPHHDL/2-1) - INTEGER MPHJ(0:MPHHDL/4-1) - REAL MPHE(0:MPHHDL/4-1) - DOUBLE PRECISION MPHD(0:MPHHDL/8-1) - EQUIVALENCE (MPH,MPHI,MPHJ,MPHE,MPHD) - BYTE MPH1(0:MPHHDL-1) !MAP HEADER - INTEGER*2 MPH1I(0:MPHHDL/2-1) - INTEGER MPH1J(0:MPHHDL/4-1) - REAL MPH1E(0:MPHHDL/4-1) - DOUBLE PRECISION MPH1D(0:MPHHDL/8-1) - EQUIVALENCE (MPH1,MPH1I,MPH1J,MPH1E,MPH1D) - BYTE MDL(0:MDLHDL-1) !MODEL LINE - INTEGER MDLJ(0:MDLHDL/LB_J-1) - REAL MDLE(0:MDLHDL/LB_E-1) - EQUIVALENCE (MDL,MDLJ,MDLE) - BYTE GDES(0:MDHHDL-1) !MODEL HEADER - INTEGER GDESJ(0:MDHHDL/4-1) - EQUIVALENCE (GDES,GDESJ) -C- -C Init -C - NO_MORE=.FALSE. - FIRST=.TRUE. -C -C GET MAP -C - MXNHV(0)=MXNPAG/2 !SET MAX. # OF PAGES - MXNHV(1)=MXNPAG/2 - IF (.NOT.NMASTL(FCAIN,SETS,MPH,MPHP,SETNAM,LPOFF)) RETURN !NONE - CALL WNDSTI(SETNAM,SETNAM) - IF (FIRST) THEN - CALL WNCTXT(F_T,'Next plot, first image: !AS', WNTTSG(SETNAM,0)) - FIRST=.FALSE. - ENDIF - CALL WNGMTS(MPH_TYP_N,MPH(MPH_TYP_1),TXTT1) !GET TYPE - IF (TXTT1.EQ.'COVER' .OR. TXTT1.EQ.'REAL' .OR. - 1 TXTT1.EQ.'IMAG' .OR. TXTT1.EQ.'AMPL' .OR. - 1 TXTT1.EQ.'PHASE') THEN - UVPL=.TRUE. !UV-PLANE - ELSE - UVPL=.FALSE. !MAP - END IF -C -C SET UP SIZE -C - R0=32. !START SIZE - J1=16 - IF (TAREA(2).GT.TAREA(3)) THEN !USE LARGEST SIZE - J2=2 - ELSE - J2=3 - END IF - DO I=1,8 - IF (TAREA(J2).LE.J1) GOTO 10 !CORRECT FOUND - J1=2*J1 - R0=R0/2. !NEXT - END DO - 10 STEP(1)=R0*SIZE(1) !STEP X TO USE - STEP(2)=R0*SIZE(2) !STEP Y TO USE - POINXY(1,1)=30. !POSITION TOP LEFT - POINXY(2,1)=542. - POINXY(1,2)=POINXY(1,1)+(TAREA(2)-1)*STEP(1) !POS. BOTTOM RIGHT - POINXY(2,2)=POINXY(2,1)-(TAREA(3)-1)*STEP(2) -C -C MAKE PAGES AND OVERLAP CROSSES -C - PG(1,1)=0 !TOTAL AREA - PG(2,1)=POINXY(2,2)-30. - PG(1,2)=POINXY(1,2)+30. - PG(2,2)=780 - IF (.NOT.WQ_MPAGE(DQID2,NHV,PLDEV,MXNHV,780.,PG(1,1))) THEN - CALL WNCTXT(F_TP,'!/Cannot open plotter!/') - CALL WNGEX !STOP PROGRAM - END IF -C -C ANNOTATION -C - IF (PLTHDR) THEN !PLOT HEADING - CALL WNGSGU(DUSER) !GET USER - CALL WNCTXS(STR,' !12$AS !24$AS (!AS) by !AS ', - 1 TXTT1,TXTT2,MAPDTYP,DUSER) !NAME OF FIELD - CALL WQ_MDATE(DQID2,NHV,STR) - CALL WQSTXH(9.) !TEXT SIZE - CALL WQSTXX(CHREXP) !CHARACTER EXPANSION - TXTXY(1)=0. !TEXT - TXTXY(2)=740. - CALL WNCTXS(STR,'Node: !AS!45CFile: !AS',NODIN,FILIN) - CALL WQTEXT(TXTXY,STR(:WNCALN(STR))) - TXTXY(2)=725. - CALL WNCTXS(STR,'Map: !AS (!AL2)!45CField: !AL# ', - 1 WNTTSG(SETNAM,0), MPH(MPH_POL_1), - 1 MPH_FNM_N,MPH(MPH_FNM_1) ) ! 2nd !AL# on WNCTXS - CALL WNGMTS(MPH_UCM_N,MPH(MPH_UCM_1),STR(80:))! will not work - CALL WQTEXT(TXTXY,STR(:WNCALN(STR))) - TXTXY(2)=690. - IF (NCF.GT.0) THEN - CALL WQTEXT(TXTXY,'Full contours: ') - TXTXY(1)=128. - DO I=1,NCF,9 - CALL WNCTXS(STR,'!#E5',MIN(9,NCF-I+1),FCONT(I)) - CALL WQTEXT(TXTXY,STR(:WNCALN(STR))) - TXTXY(2)=TXTXY(2)-15. - END DO - TXTXY(1)=0. - END IF - IF (NCD.GT.0) THEN - CALL WQTEXT(TXTXY,'Dotted contours: ') - TXTXY(1)=128. - DO I=1,NCD,9 - CALL WNCTXS(STR,'!#E5',MIN(9,NCD-I+1),DCONT(I)) - CALL WQTEXT(TXTXY,STR(:WNCALN(STR))) - TXTXY(2)=TXTXY(2)-15. - END DO - TXTXY(1)=0. - END IF - IF (HALF.GE.0) THEN !WEDGE - PG(1,1)=700.*CHREXP - PG(2,1)=740. - PG(1,2)=PG(1,1)+256. - PG(2,2)=PG(2,1) - PG(1,3)=PG(1,2) - PG(2,3)=710. - PG(1,4)=PG(1,1) - PG(2,4)=PG(2,3) - PG(1,5)=PG(1,1) - PG(2,5)=PG(2,1) - DO I=0,256 - WEDGE(I)=TRF(I) !INTENSITIES - END DO - PCD(1,1)=1. - PCD(2,1)=0. - PCD(1,2)=0. - PCD(2,2)=30. - CALL WQ_SHADI(SID,257,PG(1,4),PCD,HALF,WRANGE,0.) - CALL WQ_SHADE(SID,WEDGE) - CALL WQ_SHADE(SID,WEDGE) - CALL WQ_SHADX(SID) - CALL WQ_MPLR(DQID2,NHV,1,1,1.,0) - CALL WQSPLI(1) - CALL WQPOLL(5,PG) !BOX - PG(1,1)=PG(1,1)+128. - PG(2,1)=710. - PG(1,2)=PG(1,1) - PG(2,2)=720. - CALL WQPOLL(2,PG) !TICK - TXTXY(1)=649.*CHREXP - TXTXY(2)=698. - CALL WNCTXS(STR,'!10$E10.3',RANGE(1)) - CALL WQTEXT(TXTXY,STR(:WNCALN(STR))) - TXTXY(1)=TXTXY(1)+128. - CALL WNCTXS(STR,'!10$E10.3',RANGE(1)+(RANGE(2)-RANGE(1))/2.) - CALL WQTEXT(TXTXY,STR(:WNCALN(STR))) - TXTXY(1)=TXTXY(1)+128. - CALL WNCTXS(STR,'!10$E10.3',RANGE(2)) - CALL WQTEXT(TXTXY,STR(:WNCALN(STR))) - END IF - IF (RSCAL.NE.0) THEN !RULE - PG(1,1)=770.*CHREXP - PG(2,1)=675. - PG(1,2)=PG(1,1)+40. - PG(2,2)=PG(2,1) - CALL WQPOLL(2,PG) - TXTXY(1)=PG(1,1)+50. - TXTXY(2)=670. - CALL WNCTXS(STR,'!10$E10.3 W.U. (ruled)',10./RSCAL) - CALL WQTEXT(TXTXY,STR(:WNCALN(STR))) - END IF - IF (PSCAL.NE.0) THEN !POL - PG(1,1)=770.*CHREXP - PG(2,1)=645. - PG(1,2)=PG(1,1)+40. - PG(2,2)=PG(2,1) - CALL WQPOLL(2,PG) - TXTXY(1)=PG(1,1)+50. - TXTXY(2)=640. - CALL WNCTXS(STR,'!10$E10.3 W.U. (pol.)',10./PSCAL) - CALL WQTEXT(TXTXY,STR(:WNCALN(STR))) - END IF - END IF -C -C INIT PLOTTING -C -CCC CALL WNGCCD ! trap control-C - CALL WQSTXH(9.) !TEXT SIZE - NRPLT=0 !COUNT SETS - 100 CONTINUE - NRPLT=NRPLT+1 - PC(1)=POINXY(1,1) !BOTTOM LEFT CORNER - PC(2)=POINXY(2,2) - PCD(1,1)=STEP(1) !STEP ALONG LINE - PCD(2,1)=0. - PCD(1,2)=0. !STEP VERTICAL - PCD(2,2)=STEP(2) - CALL WQ_MPLR(DQID2,NHV,1,1,1.,0) !SET LINE REPRESENTATION - CALL WQ_MPLR(DQID2,NHV,3,3,1.,0) - J1=TAREA(2) - IF (IAND(1,PTYP(NRPLT)).NE.0 .AND. NCF.GT.0) !CONT - 1 CALL WQ_CONJ(CID1,J1,PC,PCD,NCF,FCONT, - 1 0.,1) - IF (IAND(1,PTYP(NRPLT)).NE.0 .AND. NCD.GT.0) !CONT - 1 CALL WQ_CONJ(CID2,J1,PC,PCD,NCD,DCONT, - 1 0.,3) - IF (IAND(2,PTYP(NRPLT)).NE.0 .AND. HALF.GE.0) !HALF - 1 CALL WQ_SHADI(SID,J1,PC,PCD,HALF,WRANGE,0.) - IF (IAND(8,PTYP(NRPLT)).NE.0) THEN !RULE - PCD(1,1)=0. !STEP ALONG LINE - PCD(2,1)=STEP(2) - PCD(1,2)=STEP(1) !STEP HORIZONTAL - PCD(2,2)=0. - PC(1)=POINXY(1,1)+(RTEAR(0)-TEAR(0))*STEP(1) - PC(2)=POINXY(2,2)+(RTEAR(2)-TEAR(2))*STEP(2) - CALL WQ_RULI(PID2,RTEAR(3)-RTEAR(2)+1,PC,PCD, - 1 4.*RSCAL,RRANGE,0.,0) - END IF - IF (IAND(4,PTYP(NRPLT)).NE.0) THEN !POL - PC(1)=POINXY(1,1)+(PTEAR(0)-TEAR(0))*STEP(1) - PC(2)=POINXY(2,2)+(PTEAR(2)-TEAR(2))*STEP(2) - CALL WQ_POLI(PID1,PTEAR(1)-PTEAR(0)+1,PC,PCD, - 1 4.*PSCAL,PRANGE,0.) - IF (.NOT.NMASTL(FCAIN,ASET(0,NRPLT),MPH1,MPHP1,SETNAM1,LPOFF)) - 1 GOTO 110 !GET ANGLES - END IF -C -C PLOT SHADING -C - IF (IAND(2,PTYP(NRPLT)).NE.0 .AND. HALF.GE.0) THEN - J1=LB_E*TAREA(2) !LENGTH LINE - J=MPHJ(MPH_NRA_J) !DATALINE LENGTH - J=MPHJ(MPH_MDP_J)+LB_E*(J*(MPHJ(MPH_NDEC_J)/2+ - 1 TEAR(2))+MPHJ(MPH_NRA_J)/2+TEAR(0)) !DATA POINTER - DO I=TEAR(2),TEAR(3) !PLOT ALL LINES - IF (.NOT.WNFRD(FCAIN,J1,LBUF(0),J)) GOTO 20 !READ A LINE - J=J+LB_E*MPHJ(MPH_NRA_J) !NEXT LINE - IF (MAPDTYP.EQ.'SLOPE') THEN !CALCULATE SLOPE - DO I1=1,TAREA(2)-1 - LBUF(I1-1)=LBUF(I1)-LBUF(I1-1) - END DO - LBUF(TAREA(2)-1)=LBUF(TAREA(2)-2) - END IF - R0=RANGE(2)-RANGE(1) - IF (R0.GT.0) THEN - R0=MXNTRF/R0 - R1=-RANGE(1)*R0 - DO I1=0,TAREA(2)-1 !CONVERT DATA - R2=LBUF(I1)*R0+R1 - IF (R2.LT.0.) THEN - R2=0. - ELSE IF (R2.GT.FLOAT(MXNTRF)) THEN - R2=0. !WAS: FLOAT(MXNTRF) - END IF - LBUF(I1)=TRF(NINT(R2)) - END DO - END IF - CALL WQ_SHADE(SID,LBUF(0)) !SHADING -CCC IF (WNGCCN().GT.0) GOTO 101 - END DO -CCC 101 CONTINUE - CALL WQ_SHADX(SID) !FINISH SHADING - END IF -C -C PLOT RULE -C - IF (IAND(8,PTYP(NRPLT)).NE.0) THEN - STARTJ=MPHJ(MPH_MDP_J)+LB_E*(MPHJ(MPH_NRA_J)* - 1 (MPHJ(MPH_NDEC_J)/2+TEAR(2))+ - 1 MPHJ(MPH_NRA_J)/2+TEAR(0)) !DATA POINTER - LSIZE=MIN(TAREA(3),MPHJ(MPH_NDEC_J))*LB_E !BYTES PER RA NEEDED - MEMUSE=132000 !MEMORY TO USE - RPPD=MAX(WNMEJC(FLOAT(MEMUSE)/FLOAT(LSIZE)),1) !POINTS READ PER DEC - MEMUSE=RPPD*LSIZE !ACTUAL MEMORY TO USE - IF (.NOT.WNGGVA(MEMUSE,BUFPTR)) THEN !GET TRANSPOSE BUFFER - CALL WNCTXT(F_TP,'Cannot obtain transpose buffer') - CALL WNGEX !STOP PROGRAM - END IF - BFPTRE=(BUFPTR-A_OB)/LB_E - DO RA_AX=TEAR(0),TEAR(1),RPPD !X-AXIS (=RA) - NRPNTS=MIN(RPPD,TEAR(1)+1-RA_AX) !NR. OF POINTS TO DO - OFFRA=(RA_AX-TEAR(0))*LB_E - DO DEC_AX=TEAR(2),TEAR(3) !Y-AXIS (=DEC) - OFFDEC=(DEC_AX-TEAR(2))*MPHJ(MPH_NRA_J)*LB_E - IF (.NOT.WNFRD(FCAIN,LB_E*NRPNTS, - 1 A_E(BFPTRE+(DEC_AX-TEAR(2))*NRPNTS), - 1 STARTJ+OFFRA+OFFDEC)) GOTO 20 - END DO - DO RA_PP=RA_AX,RA_AX+NRPNTS-1 !PARTS X-AXIS - DO DEC_AX=TEAR(2),TEAR(3) !Y-AXIS - LBUF(DEC_AX-TEAR(2))=A_E(BFPTRE+ - 1 (DEC_AX-TEAR(2))*NRPNTS+(RA_PP-RA_AX)) - END DO - IF (MAPDTYP.EQ.'SLOPE') THEN !CALCULATE SLOPE - DO I1=1,TAREA(3)-1 - LBUF(I1-1)=LBUF(I1)-LBUF(I1-1) - END DO - LBUF(TAREA(3)-1)=LBUF(TAREA(3)-2) - END IF - IF (RA_PP.GE.RTEAR(0) .AND. RA_PP.LE.RTEAR(1)) THEN !DO - CALL WQ_RULE(PID2,LBUF(RTEAR(0)-TEAR(0))) !RULED SURFACE - END IF -CCC IF (WNGCCN().GT.0) GOTO 102 - END DO - END DO -CCC 102 CONTINUE - CALL WNGFVA(MEMUSE,BUFPTR) !FREE TRANSPOSE BUFFER - END IF -C -C PLOT OTHERS -C - IF ((IAND(1,PTYP(NRPLT)).NE.0 .AND. NCF.GT.0) .OR. - 1 (IAND(1,PTYP(NRPLT)).NE.0 .AND. NCD.GT.0) .OR. - 1 (IAND(4,PTYP(NRPLT)).NE.0)) THEN - J1=LB_E*TAREA(2) !LENGTH LINE - J=MPHJ(MPH_NRA_J) !DATALINE LENGTH - J=MPHJ(MPH_MDP_J)+LB_E*(J*(MPHJ(MPH_NDEC_J)/2+ - 1 TEAR(2))+MPHJ(MPH_NRA_J)/2+TEAR(0)) !DATA POINTER - DO I=TEAR(2),TEAR(3) !PLOT ALL LINES - IF (.NOT.WNFRD(FCAIN,J1,LBUF(0),J)) THEN !READ A LINE - 20 CONTINUE - CALL WNCTXT(F_TP,'!/Read error map') - CALL WNGEX !STOP - END IF - IF (IAND(4,PTYP(NRPLT)).NE.0) THEN !POL - IF (.NOT.WNFRD(FCAIN,J1,ABUF(0), - 1 J-MPHJ(MPH_MDP_J)+MPH1J(MPH_MDP_J))) THEN !READ ANGLES - GOTO 20 - END IF - IF (POLMAG) THEN !MAGNETIC FIELD - DO I1=0,J1/LB_E-1 - ABUF(I1)=ABUF(I1)+PI/2. !ROTATE 90 DEGREES - END DO - END IF - END IF - J=J+LB_E*MPHJ(MPH_NRA_J) !NEXT LINE - IF (MAPDTYP.EQ.'SLOPE') THEN !CALCULATE SLOPE - DO I1=1,TAREA(2)-1 - LBUF(I1-1)=LBUF(I1)-LBUF(I1-1) - END DO - LBUF(TAREA(2)-1)=LBUF(TAREA(2)-2) - END IF - IF (IAND(1,PTYP(NRPLT)).NE.0 .AND. NCF.GT.0) - 1 CALL WQ_CONT(CID1,LBUF(0)) !FULL CONTOURS - IF (IAND(1,PTYP(NRPLT)).NE.0 .AND. NCD.GT.0) - 1 CALL WQ_CONT(CID2,LBUF(0)) !DOTTED CONTOURS - IF (IAND(4,PTYP(NRPLT)).NE.0) THEN - IF (I.GE.PTEAR(2) .AND. I.LE.PTEAR(3)) THEN !DO - CALL WQSPLI(1) !SELECT FULL DRAWN LINE - CALL WQ_POLT(PID1,LBUF(PTEAR(0)-TEAR(0)), - 1 ABUF(PTEAR(0)-TEAR(0))) !POL. VECTORS - END IF - END IF -CCC IF (WNGCCN().GT.0) GOTO 110 - END DO - END IF - 110 CONTINUE - IF (IAND(1,PTYP(NRPLT)).NE.0 .AND. NCF.GT.0) - 1 CALL WQ_CONX(CID1) !FINISH PLOT - IF (IAND(1,PTYP(NRPLT)).NE.0 .AND. NCD.GT.0) - 1 CALL WQ_CONX(CID2) - IF (IAND(8,PTYP(NRPLT)).NE.0) - 1 CALL WQ_RULX(PID2) - IF (IAND(4,PTYP(NRPLT)).NE.0) - 1 CALL WQ_POLX(PID1) -C -C Check control-C status -C -CCC IF (WNGCCN().GT.0) GOTO 9000 -C -C MORE MAPS -C - IF (NMASTL(FCAIN,SETS,MPH,MPHP,SETNAM,LPOFF)) GOTO 100 !MORE -C -C GRID -C - CALL WQSTXX(1.) !CHARACTER EXPANSION - CALL WQSPLI(1) - PG(1,1)=POINXY(1,1) - PG(2,1)=POINXY(2,1) - PG(1,2)=POINXY(1,2) - PG(2,2)=POINXY(2,1) - PG(1,3)=POINXY(1,2) - PG(2,3)=POINXY(2,2) - PG(1,4)=POINXY(1,1) - PG(2,4)=POINXY(2,2) - PG(1,5)=POINXY(1,1) - PG(2,5)=POINXY(2,1) - CALL WQ_MPLR(DQID2,NHV,1,1,2.,0) !THICK LINE - CALL WQPOLL(5,PG) !BOX - CALL WQ_MPLR(DQID2,NHV,1,1,1.,0) !NORMAL LINE -C -C GRID COORDINATES -C - IF (CRD.GE.0) THEN !DO GRID COORDINATES - DO I=1,2 !LEFT/UP - J1=WNMEJC(80./STEP(I)) !MINIMUM GRID INCREMENT - I1=1 - DO WHILE(J1.GT.GRTAB(I1)) !FIND GRID INCREMENT - I1=I1+1 - END DO - J1=GRTAB(I1) !ACTUAL INCREMENT - J2=TAREA(I+1)/2 !CENTRE OFFSET - R0=J2*STEP(I)+POINXY(I,I) !CENTRE OFFSET - J2=TAREA(I-1) !CENTRE POSITION - DO WHILE (R0.GT.POINXY(I,I)) - R0=R0-J1*STEP(I) - J2=J2-J1 - END DO - R0=R0+J1*STEP(I) !FIRST POS. - J2=J2+J1 - DO WHILE(R0.LT.POINXY(I,3-I)) !DRAW TICKS - PG(I,1)=R0 - PG(3-I,1)=POINXY(3-I,I) - PG(I,2)=R0 - PG(3-I,2)=PG(3-I,1)+10. - CALL WQPOLL(2,PG) !TICK - CALL WNCTXS(STR,'!SJ',J2) !VALUE - CALL WQSTXU(DIR(1,I)) !DIRECTION - PG(I,1)=PG(I,1)-4*WNCALN(STR)+1. !TEXT POSITION - PG(3-I,1)=PG(3-I,1)+(9*I-6)+10. - CALL WQTEXT(PG,STR(:5)) !PRINT GRID - R0=R0+J1*STEP(I) !NEXT POS. - J2=J2+J1 - END DO - END DO - END IF - CALL WQSTXU(DIR(1,1)) !SET HORIZONTAL - -C -C COORDINATES -C - IF (ABS(CRD).EQ.1 .OR. ABS(CRD).EQ.2) THEN !LM/DLM - DO I=1,2 !LEFT/UP - IF (.NOT.UVPL) THEN !MAP - R1=((MPHD(MPH_SRA_D+I-1))*3600.*360.) !PLOT COORD. ASEC - ELSE !UV-PLANE - IF (MPHI(MPH_CD_I+6).EQ.0) THEN !UV - R1=1./(MPHD(MPH_SRA_D+2-I)*MPHJ(MPH_FSR_J+2-I)*PI2) !WAVEL. - ELSE IF (MPHI(MPH_CD_I+6).EQ.1) THEN !BAS-HA - R1=1./(MPHD(MPH_SRA_D+2-I)*MPHJ(MPH_FSR_J+2-I)*PI2)/ - 1 (MPHD(MPH_FRQ_D)/(CL*1E-6)) !M - IF (I.EQ.1) R1=DEG*R1 !DEGREE - ELSE !IFR-HA - R1=1./(MPHD(MPH_SRA_D+2-I)*MPHJ(MPH_FSR_J+2-I)*PI2)/ - 1 (MPHD(MPH_FRQ_D)/(CL*1E-6)) !IFR NUMBER - IF (I.EQ.1) R1=DEG*R1 !DEGREE - END IF - END IF - R1=STEP(I)/R1 !PLOT COORD. PER UNIT - J1=WNMEJC(80./R1) !MINIMUM INCREMENT - I1=1 - DO WHILE(J1.GT.GRTAB(I1)) !FIND GRID INCREMENT - I1=I1+1 - END DO - J1=GRTAB(I1) !ACTUAL INCREMENT - R0=0. !CENTRE LM - IF (.NOT.UVPL) THEN - IF (ABS(CRD).EQ.2) THEN !LM - R0=TAREA(I-1)*(MPHD(MPH_SRA_D+I-1))+ - 1 (MPHD(MPH_SHR_D+I-1)) !CENTRE LM - END IF - R0=R0*3600.*360. !MAKE ARCSEC - ELSE !UV-PLANE - IF (I.EQ.1) THEN !V - R0=TAREA(I-1)*STEP(I)/R1 !CENTRE LM - ELSE !U - R0=(TAREA(I-1)+MPHJ(MPH_NRA_J+I-1)/2)*STEP(I)/R1 - END IF - END IF - J2=WNMEJC(R0/J1)*J1 !VALUE OF A TICK - R0=(TAREA(I+1)/2)*STEP(I)+POINXY(I,I)+((J2-R0)*R1) !POS. TICK - DO WHILE (R0.GT.POINXY(I,I)) - R0=R0-J1*R1 - J2=J2-J1 - END DO - R0=R0+J1*R1 !FIRST POS. - J2=J2+J1 - IF (CRDTYP.EQ.2) CALL WQSPLI(3) !SELECT DOTTED LINE - DO WHILE(R0.LT.POINXY(I,3-I)) !DRAW TICKS - PG(I,1)=R0 - PG(3-I,1)=POINXY(3-I,3-I) - PG(I,2)=R0 - IF (CRDTYP.EQ.1) THEN !TICK - PG(3-I,2)=PG(3-I,1)+10. - ELSE !LINE - PG(3-I,2)=POINXY(3-I,I) - END IF - CALL WQPOLL(2,PG) !TICK - IF (UVPL .AND. MPHI(MPH_CD_I+6).EQ.2) THEN !IFR - KT=STHTEL !# OF TELESCOPES - KJ=0 !WEST TELESCOPE - KI=MOD(J2,STHIFR) !CATER FOR ERRORS - DO WHILE (KI.GE.0) !FIND WEST - KI=KI-KT - KT=KT-1 - KJ=KJ+1 - END DO - KJ=KJ-1 - KT=KT+1 - KI=KI+KT+KJ !EAST TEL - STR=TSTR(KJ+1:KJ+1)//TSTR(KI+1:KI+1) - ELSE - CALL WNCTXS(STR,'!SJ',J2) !VALUE - END IF - CALL WQSTXU(DIR(1,I)) !DIRECTION - PG(I,1)=PG(I,1)-4*WNCALN(STR)+1. !TEXT POSITION - PG(3-I,1)=PG(3-I,1)+(9*I-20) - CALL WQTEXT(PG,STR(:10)) !PRINT GRID - IF (CRDTYP.EQ.1) THEN - PG(I,1)=R0 - PG(3-I,1)=POINXY(3-I,I) - PG(I,2)=R0 - PG(3-I,2)=PG(3-I,1)-10. - CALL WQPOLL(2,PG) !TICK - END IF - R0=R0+J1*R1 !NEXT POS. - J2=J2+J1 - END DO - END DO - CALL WQSPLI(1) !SELECT FULL DRAWN LINE - CALL WQSTXU(DIR(1,1)) !SET HORIZONTAL - PG(1,1)=POINXY(1,1) !COORDINATE TYPE - PG(2,1)=POINXY(2,2)-30. - IF (.NOT.UVPL) THEN !MAP - CALL WNCTXS(STR,'l (arcsec,!E6.1)',MPHE(MPH_EPO_E)) !EPOCH - ELSE IF (MPHI(MPH_CD_I+6).EQ.0) THEN !UV - CALL WNCTXS(STR,'V (wavel.)') - ELSE IF (MPHI(MPH_CD_I+6).EQ.1) THEN !BAS-HA - CALL WNCTXS(STR,'HA (deg)') - ELSE !IFR-HA - CALL WNCTXS(STR,'HA (deg)') - END IF - CALL WQTEXT(PG,STR(:WNCALN(STR))) - PG(1,1)=10. - PG(2,1)=POINXY(2,2) - CALL WQSTXU(DIR(1,2)) !VERTICAL - IF (.NOT.UVPL) THEN !MAP - CALL WNCTXS(STR,'m (arcsec,!E6.1)',MPHE(MPH_EPO_E)) !EPOCH - ELSE IF (MPHI(MPH_CD_I+6).EQ.0) THEN !UV - CALL WNCTXS(STR,'U (wavel.)') - ELSE IF (MPHI(MPH_CD_I+6).EQ.1) THEN !BAS-HA - CALL WNCTXS(STR,'Basel. (m)') - ELSE !IFR-HA - CALL WNCTXS(STR,'Ifr') - END IF - CALL WQTEXT(PG,STR(:WNCALN(STR))) - CALL WQSTXU(DIR(1,1)) !SET HORIZONTAL - END IF -C -C RA -C - IF (ABS(CRD).GE.3 .AND. ABS(CRD).LE.6 - 1 .AND. .NOT.UVPL) THEN !RA/DRA - IF (ABS(CRD).LE.4) THEN - FSC=360.*240. !SCALE - ELSE - FSC=360.*1000. - END IF - L=(TAREA(0))*(MPHD(MPH_SRA_D))+(MPHD(MPH_SHR_D)) - M=(-(TAREA(3)/2)+TAREA(1))*(MPHD(MPH_SDEC_D))+ - 1 (MPHD(MPH_SHD_D)) - CALL WNMCLM(((MPHD(MPH_RA_D))), - 1 ((MPHD(MPH_DEC_D))), - 1 PI2*L,PI2*M,D0,DEC) !RA CENTRE - R0=D0 - CALL WNMCLM(((MPHD(MPH_RA_D))), - 1 ((MPHD(MPH_DEC_D))), - 1 REAL(PI2*(L+10.*(MPHD(MPH_SRA_D)))), - 1 PI2*M,D0,DEC) !RA 1 GRID POINT AWAY - R1=D0 - FSCSGN=FSC !SIGNED FSC - R1=WNGENF(R1-R0) - IF (R1.GT.0) FSCSGN=-FSCSGN - R1=ABS(R1)*FSC/10. !GRID STEP IN TIME SEC - R0=R0*FSC !POS. IN TIME SEC - R1=STEP(1)/R1 !PLOT COORD. PER SEC - J1=WNMEJC(80./R1) !MINIMUM INCREMENT - I1=1 - IF (ABS(CRD).LE.4) THEN - DO WHILE(J1.GT.GRTAB1(I1)) !FIND GRID INCREMENT - I1=I1+1 - END DO - J1=GRTAB1(I1) !ACTUAL INCREMENT - ELSE - DO WHILE(J1.GT.GRTAB(I1)) !FIND GRID INCREMENT - I1=I1+1 - END DO - J1=GRTAB(I1) !ACTUAL INCREMENT - END IF - IF (ABS(CRD).EQ.4 .OR. ABS(CRD).EQ.6) THEN - R2=0 !NO OFFSET - ELSE - R2=R0 !OFFSET - END IF - L=L-(TAREA(2)/2)*(MPHD(MPH_SRA_D)) !BOTTOM LEFT CORNER - CALL WNMCLM(((MPHD(MPH_RA_D))), - 1 ((MPHD(MPH_DEC_D))), - 1 PI2*L,PI2*M, - 1 CCRD(1,1),CCRD(2,1)) !BOTTOM LEFT - L=L+(TAREA(2)-1)*(MPHD(MPH_SRA_D)) !BOTTOM RIGHT CORNER - CALL WNMCLM(((MPHD(MPH_RA_D))), - 1 ((MPHD(MPH_DEC_D))), - 1 PI2*L,PI2*M, - 1 CCRD(1,2),CCRD(2,2)) !BOTTOM RIGHT - M=M+(TAREA(3)-1)*(MPHD(MPH_SDEC_D)) !TOP LEFT CORNER - L=L-(TAREA(2)-1)*(MPHD(MPH_SRA_D)) - CALL WNMCLM(((MPHD(MPH_RA_D))), - 1 ((MPHD(MPH_DEC_D))), - 1 PI2*L,PI2*M, - 1 CCRD(1,4),CCRD(2,4)) !TOP LEFT - L=L+(TAREA(2)-1)*(MPHD(MPH_SRA_D)) !TOP RIGHT CORNER - CALL WNMCLM(((MPHD(MPH_RA_D))), - 1 ((MPHD(MPH_DEC_D))), - 1 PI2*L,PI2*M, - 1 CCRD(1,3),CCRD(2,3)) !TOP RIGHT - IF (FSCSGN.GT.0) THEN - R0=CCRD(1,1) !BOTTOM LEFT RA - R1=CCRD(1,2) !BOTTOM RIGHT - IF (CCRD(1,1).LT.CCRD(1,2)) R0=R0+1. !FOR 24H - IF (WNGDNF(CCRD(1,4)-CCRD(1,3)).GT.0) THEN - R3=WNGDNF(CCRD(1,4)-CCRD(1,1)) - IF (R3.GT.0) R0=R0+R3 - R3=WNGDNF(CCRD(1,3)-CCRD(1,2)) - IF (R3.LT.0) R1=R1+R3 - ELSE - R3=WNGDNF(CCRD(1,3)-CCRD(1,1)) - IF (R3.GT.0) R0=R0+R3 - R3=WNGDNF(CCRD(1,4)-CCRD(1,2)) - IF (R3.LT.0) R1=R1+R3 - END IF - ELSE - R0=CCRD(1,2) !BOTTOM RIGHT RA - R1=CCRD(1,2) !BOTTOM LEFT - IF (CCRD(1,1).GT.CCRD(1,2)) R1=R1+1. !FOR 24H - IF (WNGDNF(CCRD(1,3)-CCRD(1,4)).GT.0) THEN - R3=WNGDNF(CCRD(1,3)-CCRD(1,2)) - IF (R3.GT.0) R0=R0+R3 - R3=WNGDNF(CCRD(1,4)-CCRD(1,1)) - IF (R3.LT.0) R1=R1+R3 - ELSE - R3=WNGDNF(CCRD(1,4)-CCRD(1,2)) - IF (R3.GT.0) R0=R0+R3 - R3=WNGDNF(CCRD(1,3)-CCRD(1,1)) - IF (R3.LT.0) R1=R1+R3 - END IF - END IF - J2=WNMEJF((R0*FSC-R2)/J1)*J1 !FIRST TICK - R0=R1*FSC !LAST TICK - IF (CRDTYP.EQ.2) THEN !DOTTED - CALL WQSPLI(3) - ELSE - CALL WQSPLI(1) !FULL - END IF - IF ((J2+R2).LT.R0) J2=J2+FSC - DO WHILE(J2+R2.GT.R0) !DRAW TICKS - M=(-(TAREA(3)/2)+TAREA(1))*(MPHD(MPH_SDEC_D))+ - 1 (MPHD(MPH_SHD_D)) !BOTTOM LINE - CALL WNMCRM(((MPHD(MPH_RA_D))), - 1 ((MPHD(MPH_DEC_D))), - 1 R1,PI2*M,DBLE((J2+R2)/FSC),DEC) !GET L - PG(1,1)=STEP(1)*(R1/PI2-L)/(MPHD(MPH_SRA_D))+ - 1 POINXY(1,2) - PG(2,1)=POINXY(2,2) - CALL WNMCRM(((MPHD(MPH_RA_D))), - 1 ((MPHD(MPH_DEC_D))), - 1 R1,REAL(PI2*(M+(MPHD(MPH_SDEC_D))* - 1 10./STEP(2))), - 1 DBLE((J2+R2)/FSC),DEC) !GET L - PG(1,2)=STEP(1)*(R1/PI2-L)/(MPHD(MPH_SRA_D))+ - 1 POINXY(1,2) - PG(2,2)=PG(2,1)+10. - IF (PG(1,1).GE.POINXY(1,1) .AND. PG(1,1).LE.POINXY(1,2) .AND. - 1 PG(1,2).GE.POINXY(1,1) .AND. - 1 PG(1,2).LE.POINXY(1,2)) THEN - IF (ABS(CCRD(2,1)).LT.80.0/360.) - 1 CALL WQPOLL(2,PG) !TICK - J3=MOD(J2,NINT(FSC)) - IF (J3.LT.0) J3=J3+NINT(FSC) - IF (ABS(CRD).LE.4) THEN - CALL WNCTXS(STR,'!8$EHD6',J3/240.) - ELSE - CALL WNCTXS(STR,'!E10.3',J3/1000.) - END IF - CALL WQSTXU(DIR(1,1)) !DIRECTION - PG(1,1)=PG(1,1)-4*WNCALN(STR)+1. !TEXT POSITION - PG(2,1)=PG(2,1)-11. - IF (PG(1,1).GE.POINXY(1,1) .AND. - 1 (ABS(WNGDNF(DBLE((J2+R2)/FSC-CCRD(1,1)))).LT.0.25 .OR. - 1 ABS(WNGDNF(DBLE((J2+R2)/FSC-CCRD(1,2)))).LT.0.25) .AND. - 1 ABS(WNGDNF(DBLE((J2+R2)/FSC-CCRD(1,1)))- - 1 WNGDNF(DBLE((J2+R2)/FSC-CCRD(1,2)))).LT.0.5) - 1 CALL WQTEXT(PG,STR(:9)) !PRINT GRID - END IF - IF (ABS(CCRD(2,1)).LT.80.0/360.) THEN - M=M+(TAREA(3)-1)*(MPHD(MPH_SDEC_D)) !TOP LINE - CALL WNMCRM(((MPHD(MPH_RA_D))), - 1 ((MPHD(MPH_DEC_D))), - 1 R1,PI2*M,DBLE((J2+R2)/FSC),DEC) !GET L - PG(1,1)=STEP(1)*(R1/PI2-L)/ - 1 (MPHD(MPH_SRA_D))+POINXY(1,2) - PG(2,1)=POINXY(2,1) - CALL WNMCRM(((MPHD(MPH_RA_D))), - 1 ((MPHD(MPH_DEC_D))), - 1 R1,REAL(PI2*(M-(MPHD(MPH_SDEC_D))* - 1 10./STEP(2))), - 1 DBLE((J2+R2)/FSC),DEC) !GET L - PG(1,2)=STEP(1)*(R1/PI2-L)/ - 1 (MPHD(MPH_SRA_D))+POINXY(1,2) - PG(2,2)=PG(2,1)-10. - IF (PG(1,1).GE.POINXY(1,1) .AND. PG(1,1).LE.POINXY(1,2) .AND. - 1 PG(1,2).GE.POINXY(1,1) .AND. - 1 PG(1,2).LE.POINXY(1,2)) THEN - IF (ABS(CCRD(2,1)).LT.80.0/360.) - 1 CALL WQPOLL(2,PG) !TICK - END IF - IF (CRDTYP.GT.1 .AND. - 1 ABS(CCRD(2,1)).LT.80.0/360.) THEN !DRAW GRID - M=M-(TAREA(3)-1)*(MPHD(MPH_SDEC_D)) !BOTTOM LINE - DO I1=0,64 - R3=I1*((TAREA(3)-1)/64.) !GRID POINT - CALL WNMCRM(((MPHD(MPH_RA_D))), - 1 ((MPHD(MPH_DEC_D))), - 1 R1,REAL(PI2*(M+R3* - 1 (MPHD(MPH_SDEC_D)))), - 1 DBLE((J2+R2)/FSC),DEC) !GET L - PGRD(1,I1)=STEP(1)*(R1/PI2-L)/(MPHD(MPH_SRA_D))+ - 1 POINXY(1,2) - PGRD(2,I1)=POINXY(2,2)+STEP(2)*R3 - END DO - J3=0 !TEST INSIDE - DO WHILE (J3.LT.65 .AND. (PGRD(1,J3).LT.POINXY(1,1) .OR. - 1 PGRD(1,J3).GT.POINXY(1,2))) - J3=J3+1 !SKIP - END DO - J4=J3 - DO WHILE (J4.LT.64 .AND. (PGRD(1,J4+1).LE.POINXY(1,2) .AND. - 1 PGRD(1,J4+1).GE.POINXY(1,1))) - J4=J4+1 - END DO - CALL WQPOLL(J4-J3+1,PGRD(1,J3)) !DRAW - END IF - END IF - J2=J2-J1 !NEXT POS. - END DO - J5=J1 !SAVE RA STEP - R5=R2/FSC !AND OFFSET -C -C DEC -C - IF (ABS(CRD).LE.4) FSC=360.*3600. !SCALE - FSC=ABS(FSC) - L=(-(TAREA(2)/2)+TAREA(0))*(MPHD(MPH_SRA_D))+ - 1 (MPHD(MPH_SHR_D)) - M=(TAREA(1))*(MPHD(MPH_SDEC_D))+ - 1 (MPHD(MPH_SHD_D)) - CALL WNMCLM(((MPHD(MPH_RA_D))), - 1 ((MPHD(MPH_DEC_D))), - 1 PI2*L,PI2*M,RA,D0) !DEC CENTRE - R0=D0 - R0C=R0 - CALL WNMCLM(((MPHD(MPH_RA_D))), - 1 ((MPHD(MPH_DEC_D))), - 1 PI2*L,REAL(PI2*(M+10.* - 1 (MPHD(MPH_SDEC_D)))),RA,D0) !DEC 5 GRID AWAY - R1=D0 - FSCSGN=FSC !SIGNED FSC - IF (R1-R0.LT.0) FSCSGN=-FSCSGN - R1=ABS(R1-R0)*FSC/10. !GRID STEP IN ARCSEC - CALL WNMCLM(((MPHD(MPH_RA_D))), - 1 ((MPHD(MPH_DEC_D))), - 1 PI2*L, - 1 REAL(PI2*(M-(TAREA(3)/4)*MPHD(MPH_SDEC_D))), - 1 RA,D0) !DEC CENTRE - 0.25 - R2=D0 - CALL WNMCLM(((MPHD(MPH_RA_D))), - 1 ((MPHD(MPH_DEC_D))), - 1 PI2*L, - 1 REAL(PI2*(M-(TAREA(3)/4)*MPHD(MPH_SDEC_D) - 1 -10.*MPHD(MPH_SDEC_D))), - 1 RA,D0) !DEC CENTRE - 0.25 - R3=ABS(REAL(D0)-R2)*FSC/10. - R1=MAX(R1,R3) - CALL WNMCLM(((MPHD(MPH_RA_D))), - 1 ((MPHD(MPH_DEC_D))), - 1 PI2*L, - 1 REAL(PI2*(M+(TAREA(3)/4)*MPHD(MPH_SDEC_D))), - 1 RA,D0) !DEC CENTRE - 0.25 - R2=D0 - CALL WNMCLM(((MPHD(MPH_RA_D))), - 1 ((MPHD(MPH_DEC_D))), - 1 PI2*L, - 1 REAL(PI2*(M+(TAREA(3)/4)*MPHD(MPH_SDEC_D) - 1 +10.*MPHD(MPH_SDEC_D))), - 1 RA,D0) !DEC CENTRE - 0.25 - R3=ABS(REAL(D0)-R2)*FSC/10. - R1=MAX(R1,R3) - R0=R0*FSC !POS. IN ARCSEC - R1=STEP(2)/R1 !PLOT COORD. PER SEC - J1=WNMEJC(80./R1) !MINIMUM INCREMENT - I1=1 - IF (ABS(CRD).LE.4) THEN - DO WHILE(J1.GT.GRTAB1(I1)) !FIND GRID INCREMENT - I1=I1+1 - END DO - J1=GRTAB1(I1) !ACTUAL INCREMENT - ELSE - DO WHILE(J1.GT.GRTAB(I1)) !FIND GRID INCREMENT - I1=I1+1 - END DO - J1=GRTAB(I1) !ACTUAL INCREMENT - END IF - IF (ABS(CRD).EQ.4 .OR. ABS(CRD).EQ.6) THEN - R2=0 !NO OFFSET - ELSE - R2=R0 !OFFSET - END IF - IF (FSCSGN.GT.0) THEN - R0=CCRD(2,1) !BOTTOM LEFT DEC - J2=WNMEJC((R0*FSC-R2)/J1)*J1 !FIRST TICK - R0=CCRD(2,2) !BOTTOM RIGHT DEC - J2=MIN(J2,WNMEJC((R0*FSC-R2)/J1)*J1) - R0=MAX(CCRD(2,3),CCRD(2,4)) !TOP DEC - ELSE - R0=CCRD(2,4) !TOP LEFT DEC - J2=WNMEJF((R0*FSC-R2)/J1)*J1 !FIRST TICK - R0=CCRD(2,3) !TOP RIGHT DEC - J2=MIN(J2,WNMEJF((R0*FSC-R2)/J1)*J1) - R0=MAX(CCRD(2,1),CCRD(2,2)) !BOTTOM DEC - END IF - IF (R0C.GT.R0) R0=0.25 !REALLY NEAR POLE - R0=R0*FSC - IF (CRDTYP.EQ.2) THEN !DOTTED - CALL WQSPLI(3) - ELSE - CALL WQSPLI(1) !FULL - END IF - M=M-(TAREA(3)/2)*(MPHD(MPH_SDEC_D)) !BOTTOM LINE - DO WHILE(J2+R2.LT.R0) !DRAW TICKS - L=(-(TAREA(2)/2)+TAREA(0))*(MPHD(MPH_SRA_D))+ - 1 (MPHD(MPH_SHR_D)) !LEFT LINE - CALL WNMCDL(((MPHD(MPH_RA_D))), - 1 ((MPHD(MPH_DEC_D))), - 1 PI2*L,R1,RA,DBLE((J2+R2)/FSC)) !GET M - IF (R1.EQ.-100. .AND. RA.EQ.-100.) THEN - PG(2,1)=POINXY(2,2)-1. - ELSE - PG(2,1)=STEP(2)*(R1/PI2-M)/ - 1 (MPHD(MPH_SDEC_D))+POINXY(2,2) - IF (PG(2,1).LE.POINXY(2,2) .OR. - 1 PG(2,1).GE.POINXY(2,1)) THEN - CALL WNMCD2(((MPHD(MPH_RA_D))), - 1 ((MPHD(MPH_DEC_D))), - 1 PI2*L,R1,RA,DBLE((J2+R2)/FSC)) !GET M - PG(2,1)=STEP(2)*(R1/PI2-M)/ - 1 (MPHD(MPH_SDEC_D))+POINXY(2,2) - END IF - END IF - PG(1,1)=POINXY(1,1) - CALL WNMCDL(((MPHD(MPH_RA_D))), - 1 ((MPHD(MPH_DEC_D))), - 1 REAL(PI2*(L+(MPHD(MPH_SRA_D))* - 1 10./STEP(1))),R1, - 1 RA,DBLE((J2+R2)/FSC)) !GET M - IF (R1.EQ.-100. .AND. RA.EQ.-100.) THEN - PG(2,2)=POINXY(2,2)-1. - ELSE - PG(2,2)=STEP(2)*(R1/PI2-M)/ - 1 (MPHD(MPH_SDEC_D))+POINXY(2,2) - IF (PG(2,2).LE.POINXY(2,2) .OR. - 1 PG(2,2).GE.POINXY(2,1)) THEN - CALL WNMCD2(((MPHD(MPH_RA_D))), - 1 ((MPHD(MPH_DEC_D))), - 1 REAL(PI2*(L+(MPHD(MPH_SRA_D))* - 1 10./STEP(1))),R1, - 1 RA,DBLE((J2+R2)/FSC)) !GET M - PG(2,2)=STEP(2)*(R1/PI2-M)/ - 1 (MPHD(MPH_SDEC_D))+POINXY(2,2) - END IF - END IF - PG(1,2)=PG(1,1)+10. - IF (PG(2,1).GE.POINXY(2,2) .AND. PG(2,1).LE.POINXY(2,1) .AND. - 1 PG(2,2).GE.POINXY(2,2) .AND. - 1 PG(2,2).LE.POINXY(2,1)) THEN - IF (ABS(CCRD(2,1)).LT.80.0/360.) - 1 CALL WQPOLL(2,PG) !TICK - J3=MOD(J2,NINT(FSC)) - IF (J3.LT.0) THEN - STR(1:1)='-' - J3=-J3 - ELSE - STR(1:1)=' ' - END IF - IF (ABS(CRD).LE.4) THEN - CALL WNCTXS(STR(2:),'!EDD', - 1 J3/3600.) - ELSE - CALL WNCTXS(STR(2:),'!E10.3',J3/1000.) - END IF - CALL WQSTXU(DIR(1,2)) !DIRECTION - PG(2,1)=PG(2,1)-4*WNCALN(STR)+1. !TEXT POSITION - PG(1,1)=PG(1,1)-2. - IF (PG(2,1).GE.POINXY(2,2)) - 1 CALL WQTEXT(PG,STR(:9)) !PRINT GRID - END IF - IF (ABS(CCRD(2,1)).LT.80.0/360.) THEN - L=L+(TAREA(2)-1)*(MPHD(MPH_SRA_D)) !RIGHT LINE - CALL WNMCDL(((MPHD(MPH_RA_D))), - 1 ((MPHD(MPH_DEC_D))), - 1 PI2*L,R1,RA,DBLE((J2+R2)/FSC)) !GET M - IF (R1.EQ.-100. .AND. RA.EQ.-100.) THEN - PG(2,1)=POINXY(2,2)-1. - ELSE - PG(2,1)=STEP(2)*(R1/PI2-M)/ - 1 (MPHD(MPH_SDEC_D))+POINXY(2,2) - IF (PG(2,1).LE.POINXY(2,2) .OR. - 1 PG(2,1).GE.POINXY(2,1)) THEN - CALL WNMCD2(((MPHD(MPH_RA_D))), - 1 ((MPHD(MPH_DEC_D))), - 1 PI2*L,R1,RA,DBLE((J2+R2)/FSC)) !GET M - PG(2,1)=STEP(2)*(R1/PI2-M)/ - 1 (MPHD(MPH_SDEC_D))+POINXY(2,2) - END IF - END IF - PG(1,1)=POINXY(1,2) - CALL WNMCDL(((MPHD(MPH_RA_D))), - 1 ((MPHD(MPH_DEC_D))), - 1 REAL(PI2*(L-(MPHD(MPH_SRA_D))* - 1 10./STEP(1))),R1, - 1 RA,DBLE((J2+R2)/FSC)) !GET M - IF (R1.EQ.-100. .AND. RA.EQ.-100.) THEN - PG(2,2)=POINXY(2,2)-1. - ELSE - PG(2,2)=STEP(2)*(R1/PI2-M)/ - 1 (MPHD(MPH_SDEC_D))+POINXY(2,2) - IF (PG(2,2).LE.POINXY(2,2) .OR. - 1 PG(2,2).GE.POINXY(2,1)) THEN - CALL WNMCD2(((MPHD(MPH_RA_D))), - 1 ((MPHD(MPH_DEC_D))), - 1 REAL(PI2*(L-(MPHD(MPH_SRA_D))* - 1 10./STEP(1))),R1, - 1 RA,DBLE((J2+R2)/FSC)) !GET M - PG(2,2)=STEP(2)*(R1/PI2-M)/ - 1 (MPHD(MPH_SDEC_D))+POINXY(2,2) - END IF - END IF - PG(1,2)=PG(1,1)-10. - IF (PG(2,1).GE.POINXY(2,2) .AND. PG(2,1).LE.POINXY(2,1) .AND. - 1 PG(2,2).GE.POINXY(2,2) .AND. - 1 PG(2,2).LE.POINXY(2,1)) THEN - CALL WQPOLL(2,PG) !TICK - END IF - IF (CRDTYP.GT.1 .AND. - 1 ABS(CCRD(2,1)).LT.80.0/360.) THEN !DRAW GRID - L=L-(TAREA(2)-1)*(MPHD(MPH_SRA_D)) !LEFT LINE - DO I1=0,64 - R3=I1*((TAREA(2)-1)/64.) !GRID POINT - CALL WNMCDL(((MPHD(MPH_RA_D))), - 1 ((MPHD(MPH_DEC_D))), - 1 REAL(PI2*(L+R3*(MPHD(MPH_SRA_D)))), - 1 R1, - 1 RA,DBLE((J2+R2)/FSC)) !GET M - IF (R1.EQ.-100. .AND. RA.EQ.-100.) THEN - PGRD(2,I1)=POINXY(2,2)-1. - ELSE - PGRD(2,I1)=STEP(2)*(R1/PI2-M)/ - 1 (MPHD(MPH_SDEC_D))+POINXY(2,2) - END IF - PGRD(1,I1)=POINXY(1,1)+STEP(1)*R3 - END DO - J3=0 !TEST INSIDE - DO WHILE (J3.LT.65 .AND. (PGRD(2,J3).LT.POINXY(2,2) .OR. - 1 PGRD(2,J3).GT.POINXY(2,1))) - J3=J3+1 !SKIP - END DO - J4=J3 - DO WHILE (J4.LT.64 .AND. (PGRD(2,J4+1).LE.POINXY(2,1) .AND. - 1 PGRD(2,J4+1).GE.POINXY(2,2))) - J4=J4+1 - END DO - CALL WQPOLL(J4-J3+1,PGRD(1,J3)) !DRAW - END IF - END IF - J2=J2+J1 !NEXT POS. - END DO - J6=J1 !SAVE DEC STEP - R6=R2/FSC !AND OFFSET -C -C CONTOUR TYPE GRID -C -C DEC -C - IF (ABS(CCRD(2,1)).GE.80.0/360.) THEN !NEAR POLE - COCOLP=HAINT - IF (.NOT.WNGGVA((COCOLP+1)*LB_E,COCOP)) THEN - CALL WNCTXT(F_TP,'Cannot obtain coordinate line buffer') - CALL WNGEX !STOP PROGRAM - END IF - COCOPE=(COCOP-A_OB)/LB_E - L=(-(TAREA(2)/2)+TAREA(0))*(MPHD(MPH_SRA_D))+ - 1 (MPHD(MPH_SHR_D)) !LEFT LINE - M=(-(TAREA(3)/2)+TAREA(1))*(MPHD(MPH_SDEC_D))+ - 1 (MPHD(MPH_SHD_D)) !BOTTOM LINE - J2=WNMEJF((79.-R6*360.)*3600./J6) !LOWEST CONTOUR - CONTLP=WNMEJC((90.-R6*360.)*3600./J6)-J2+1 !LENGTH CONTOUR BUFFER - IF(.NOT.WNGGVA(CONTLP*LB_E,CONTP)) THEN - CALL WNCTXT(F_TP,'Cannot obtain contour buffer') - CALL WNGEX !STOP PROGRAM - END IF - CONTPE=(CONTP-A_OB)/LB_E - DO I2=0,CONTLP-1 - A_E(CONTPE+I2)=(J2+I2)*J6 - END DO - IF (CRDTYP.GT.1) THEN !FULL GRID - PC(1)=POINXY(1,1) !BOTTOM LEFT CORNER - PC(2)=POINXY(2,2) - PCD(1,1)=STEP(1)*(TAREA(2)-1)/REAL(COCOLP) !STEP ALONG LINE - PCD(2,1)=0. - PCD(1,2)=0. !STEP VERTICAL - PCD(2,2)=STEP(2)*(TAREA(3)-1)/REAL(COCOLP) - IF (CRDTYP.EQ.2) THEN - CALL WQ_CONJ(CIDC2,COCOLP+1,PC,PCD, - 1 CONTLP,A_E(CONTPE),0.0,3) !DOTTED - ELSE - CALL WQ_CONJ(CIDC2,COCOLP+1,PC,PCD, - 1 CONTLP,A_E(CONTPE),0.0,1) - END IF - R4=0 !BOTTOM LINE - DO I2=0,COCOLP !LINES - DO I1=0,COCOLP !POINTS IN LINE - R3=I1*((TAREA(2)-1)/REAL(COCOLP)) !GRID POINT L - CALL WNMCLM(((MPHD(MPH_RA_D))), - 1 ((MPHD(MPH_DEC_D))), - 1 REAL(PI2*(L+R3* - 1 (MPHD(MPH_SRA_D)))), - 1 REAL(PI2*(M+R4* - 1 (MPHD(MPH_SDEC_D)))), - 1 RA,D0) - A_E(COCOPE+I1)=REAL(D0-R6)*360.*3600. !DEC - END DO - CALL WQ_CONT(CIDC2,A_E(COCOPE)) - R4=R4+((TAREA(3)-1)/REAL(COCOLP)) !LINE M - END DO - CALL WQ_CONX(CIDC2) - ELSE !TICKS ONLY - PC(1)=POINXY(1,1) !BOTTOM LEFT CORNER - PC(2)=POINXY(2,2) - PCD(1,1)=0. !STEP ALONG LINE - PCD(2,1)=STEP(2)*(TAREA(3)-1)/REAL(COCOLP) - PCD(1,2)=10. !STEP VERTICAL - PCD(2,2)=0. - IF (CRDTYP.EQ.2) THEN - CALL WQ_CONJ(CIDC2,COCOLP+1,PC,PCD, - 1 CONTLP,A_E(CONTPE),0.0,3) !DOTTED - ELSE - CALL WQ_CONJ(CIDC2,COCOLP+1,PC,PCD, - 1 CONTLP,A_E(CONTPE),0.0,1) - END IF - R4=0 !LEFT LINE - DO I2=0,1 !LINES - DO I1=0,COCOLP !POINTS IN LINE - R3=I1*((TAREA(3)-1)/REAL(COCOLP)) !GRID POINT M - CALL WNMCLM(((MPHD(MPH_RA_D))), - 1 ((MPHD(MPH_DEC_D))), - 1 REAL(PI2*(L+R4* - 1 (MPHD(MPH_SRA_D)))), - 1 REAL(PI2*(M+R3* - 1 (MPHD(MPH_SDEC_D)))), - 1 RA,D0) - A_E(COCOPE+I1)=REAL(D0-R6)*360.*3600. !DEC - END DO - CALL WQ_CONT(CIDC2,A_E(COCOPE)) - R4=R4+10./STEP(1) - END DO - CALL WQ_CONX(CIDC2) - PC(1)=POINXY(1,2) !BOTTOM RIGHT CORNER - PC(2)=POINXY(2,2) - PCD(1,1)=0. !STEP ALONG LINE - PCD(2,1)=STEP(2)*(TAREA(3)-1)/REAL(COCOLP) - PCD(1,2)=-10. !STEP VERTICAL - PCD(2,2)=0. - IF (CRDTYP.EQ.2) THEN - CALL WQ_CONJ(CIDC2,COCOLP+1,PC,PCD, - 1 CONTLP,A_E(CONTPE),0.0,3) !DOTTED - ELSE - CALL WQ_CONJ(CIDC2,COCOLP+1,PC,PCD, - 1 CONTLP,A_E(CONTPE),0.0,1) - END IF - R4=TAREA(2)-1 !RIGHT LINE - DO I2=0,1 !LINES - DO I1=0,COCOLP !POINTS IN LINE - R3=I1*((TAREA(3)-1)/REAL(COCOLP)) !GRID POINT M - CALL WNMCLM(((MPHD(MPH_RA_D))), - 1 ((MPHD(MPH_DEC_D))), - 1 REAL(PI2*(L+R4* - 1 (MPHD(MPH_SRA_D)))), - 1 REAL(PI2*(M+R3* - 1 (MPHD(MPH_SDEC_D)))), - 1 RA,D0) - A_E(COCOPE+I1)=REAL(D0-R6)*360.*3600. !DEC - END DO - CALL WQ_CONT(CIDC2,A_E(COCOPE)) - R4=R4-10./STEP(1) - END DO - CALL WQ_CONX(CIDC2) - END IF - CALL WNGFVA(CONTLP*LB_E,CONTP) !FREE LINE BUFFER -C -C RA -C - CONTLP=WNMEJC(24.*3600./J5+1) !LENGTH CONTOUR BUFFER - IF(.NOT.WNGGVA(CONTLP*LB_E,CONTP)) THEN - CALL WNCTXT(F_TP,'Cannot obtain contour buffer') - CALL WNGEX !STOP PROGRAM - END IF - CONTPE=(CONTP-A_OB)/LB_E - DO I2=0,CONTLP-1 - A_E(CONTPE+I2)=(I2-WNMEJF(R5*24.*3600./J5))*J5 - END DO - IF (CRDTYP.GT.1) THEN !FULL GRID - PC(1)=POINXY(1,1) !BOTTOM LEFT CORNER - PC(2)=POINXY(2,2) - PCD(1,1)=STEP(1)*(TAREA(2)-1)/REAL(COCOLP) !STEP ALONG LINE - PCD(2,1)=0. - PCD(1,2)=0. !STEP VERTICAL - PCD(2,2)=STEP(2)*(TAREA(3)-1)/REAL(COCOLP) - IF (CRDTYP.EQ.2) THEN - CALL WQ_CONJ(CIDC2,COCOLP+1,PC,PCD, - 1 CONTLP,A_E(CONTPE),1.E20,3) - ELSE - CALL WQ_CONJ(CIDC2,COCOLP+1,PC,PCD, - 1 CONTLP,A_E(CONTPE),1.E20,1) - END IF - R4=0 !BOTTOM LINE - DO I2=0,COCOLP !LINES - DO I1=0,COCOLP !POINTS IN LINE - R3=I1*((TAREA(2)-1)/REAL(COCOLP)) !GRID POINT L - CALL WNMCLM(((MPHD(MPH_RA_D))), - 1 ((MPHD(MPH_DEC_D))), - 1 REAL(PI2*(L+R3* - 1 (MPHD(MPH_SRA_D)))), - 1 REAL(PI2*(M+R4* - 1 (MPHD(MPH_SDEC_D)))), - 1 D0,DEC) - D0=WNGDPF(D0-R5) - IF (ABS(DEC*360.).GT.90.-J6/3600.) THEN - A_E(COCOPE+I1)=1.E20 - ELSE IF (D0.GT.(1.-J5/360./360.)) THEN - IF (D0.GT.(1.-J5/720./360.)) THEN - A_E(COCOPE+I1)=REAL(D0-1.)*24.*3600. - ELSE - A_E(COCOPE+I1)=1.E20 - END IF - ELSE - A_E(COCOPE+I1)=REAL(D0)*24.*3600. !RA - END IF - END DO - CALL WQ_CONT(CIDC2,A_E(COCOPE)) - R4=R4+((TAREA(3)-1)/REAL(COCOLP)) !LINE M - END DO - CALL WQ_CONX(CIDC2) - ELSE !TICKS ONLY - PC(1)=POINXY(1,1) !BOTTOM LEFT CORNER - PC(2)=POINXY(2,2) - PCD(1,1)=STEP(1)*(TAREA(2)-1)/REAL(COCOLP) !STEP ALONG LINE - PCD(2,1)=0. - PCD(1,2)=0. !STEP VERTICAL - PCD(2,2)=10. - IF (CRDTYP.EQ.2) THEN - CALL WQ_CONJ(CIDC2,COCOLP+1,PC,PCD, - 1 CONTLP,A_E(CONTPE),0.0,3) !DOTTED - ELSE - CALL WQ_CONJ(CIDC2,COCOLP+1,PC,PCD, - 1 CONTLP,A_E(CONTPE),0.0,1) - END IF - R4=0 !BOTTOM LINE - DO I2=0,1 !LINES - DO I1=0,COCOLP !POINTS IN LINE - R3=I1*((TAREA(2)-1)/REAL(COCOLP)) !GRID POINT L - CALL WNMCLM(((MPHD(MPH_RA_D))), - 1 ((MPHD(MPH_DEC_D))), - 1 REAL(PI2*(L+R3* - 1 (MPHD(MPH_SRA_D)))), - 1 REAL(PI2*(M+R4* - 1 (MPHD(MPH_SDEC_D)))), - 1 D0,DEC) - D0=WNGDPF(D0-R5) - IF (D0.GT.(1.-J5/360./360.)) THEN - IF (D0.GT.(1.-J5/720./360.)) THEN - A_E(COCOPE+I1)=REAL(D0-1.)*24.*3600. - ELSE - A_E(COCOPE+I1)=1.E20 - END IF - ELSE - A_E(COCOPE+I1)=REAL(D0)*24.*3600. !RA - END IF - END DO - CALL WQ_CONT(CIDC2,A_E(COCOPE)) - R4=R4+10./STEP(2) - END DO - CALL WQ_CONX(CIDC2) - PC(1)=POINXY(1,1) !TOP LEFT CORNER - PC(2)=POINXY(2,1) - PCD(1,1)=STEP(1)*(TAREA(2)-1)/REAL(COCOLP) !STEP ALONG LINE - PCD(2,1)=0. - PCD(1,2)=0. !STEP VERTICAL - PCD(2,2)=-10. - IF (CRDTYP.EQ.2) THEN - CALL WQ_CONJ(CIDC2,COCOLP+1,PC,PCD, - 1 CONTLP,A_E(CONTPE),0.0,3) !DOTTED - ELSE - CALL WQ_CONJ(CIDC2,COCOLP+1,PC,PCD, - 1 CONTLP,A_E(CONTPE),0.0,1) - END IF - R4=TAREA(3)-1 !TOP LINE - DO I2=0,1 !LINES - DO I1=0,COCOLP !POINTS IN LINE - R3=I1*((TAREA(2)-1)/REAL(COCOLP)) !GRID POINT L - CALL WNMCLM(((MPHD(MPH_RA_D))), - 1 ((MPHD(MPH_DEC_D))), - 1 REAL(PI2*(L+R3* - 1 (MPHD(MPH_SRA_D)))), - 1 REAL(PI2*(M+R4* - 1 (MPHD(MPH_SDEC_D)))), - 1 D0,DEC) - D0=WNGDPF(D0-R5) - IF (D0.GT.(1.-J5/360./360.)) THEN - IF (D0.GT.(1.-J5/720./360.)) THEN - A_E(COCOPE+I1)=REAL(D0-1.)*24.*3600. - ELSE - A_E(COCOPE+I1)=1.E20 - END IF - ELSE - A_E(COCOPE+I1)=REAL(D0)*24.*3600. !RA - END IF - END DO - CALL WQ_CONT(CIDC2,A_E(COCOPE)) - R4=R4-10./STEP(2) - END DO - CALL WQ_CONX(CIDC2) - END IF - CALL WNGFVA(CONTLP*LB_E,CONTP) - CALL WNGFVA((COCOLP+1)*LB_E,COCOP) - END IF -C -C ANNOTATION -C - - CALL WQSPLI(1) !SELECT FULL DRAWN LINE - CALL WQSTXU(DIR(1,1)) !SET HORIZONTAL - PG(1,1)=POINXY(1,1) !COORDINATE TYPE - PG(2,1)=POINXY(2,2)-30. - IF (ABS(CRD).LE.4) THEN - CALL WNCTXS(STR,'RA (h:m:s,!E6.1)',MPHE(MPH_EPO_E)) !EPOCH - CALL WQTEXT(PG,STR(:WNCALN(STR))) - ELSE - CALL WNCTXS(STR,'RA (deg,!E6.1)',MPHE(MPH_EPO_E)) !EPOCH - CALL WQTEXT(PG,STR(:WNCALN(STR))) - END IF - PG(1,1)=10. - PG(2,1)=POINXY(2,2) - CALL WQSTXU(DIR(1,2)) !VERTICAL - IF (ABS(CRD).LE.4) THEN - CALL WNCTXS(STR,'DEC (d.m.s,!E6.1)',MPHE(MPH_EPO_E)) !EPOCH - CALL WQTEXT(PG,STR(:WNCALN(STR))) - ELSE - CALL WNCTXS(STR,'DEC (deg,!E6.1)',MPHE(MPH_EPO_E)) !EPOCH - CALL WQTEXT(PG,STR(:WNCALN(STR))) - END IF - CALL WQSTXU(DIR(1,1)) !SET HORIZONTAL - END IF -C -C SOURCES -C - IF (PLTSRC.GT.0) THEN -#ifndef wn_vx__ - R0=2 - IF (PLDEV.EQ.'X11') CALL XWDRIV(15,R0,1,' ',0) -#endif - CALL WQSTXX(1.0) !CHARACTER EXPANSION -C - CALL NMOGSH(GDES) !GET SOURCE HEADER - DO J=0,GDESJ(MDH_NSRC_J)-1 !ALL SOURCES - CALL WNGMV(MDLHDL,A_B(GDESJ(MDH_MODP_J)+J*MDLHDL-A_OB), - 1 MDL) !GET MODEL LINE - IF (PLTSRC.GT.1) JS=NMONAM(MDL,GDES,STR,.TRUE.) !GET NAME FOR SOURCE - CALL NMOEXT(MDL) !MAKE EXTERNAL FORMAT - IF (MDLE(MDL_I_E).NE.0 .AND. !NOT DELETED - 1 MDL(MDL_TP1_B).LE.4) THEN !AND WANTED - IF (MDL(MDL_TP1_B).EQ.0) THEN - CALL WQSPMI(2) !+ - ELSE IF (MDL(MDL_TP1_B).EQ.1) THEN - CALL WQSPMI(5) !X - ELSE IF (MDL(MDL_TP1_B).EQ.2) THEN - CALL WQSPMI(3) !* - ELSE IF (MDL(MDL_TP1_B).EQ.3) THEN - CALL WQSPMI(1) !. - ELSE IF (MDL(MDL_TP1_B).EQ.4) THEN - CALL WQSPMI(4) !O - END IF - PLCR=.TRUE. !ASSUME INSIDE MAP - DO I=1,2 !GET X,Y - R0=(MDLE(MDL_L_E+I-1)/360./3600.- - 1 (MPHD(MPH_SHR_D+I-1)))/ - 1 (MPHD(MPH_SRA_D+I-1)) !GRID POINT SOURCE - R0=R0-(TAREA(I-1)-(TAREA(I+1)/2)) !GRID POINT OFFSET - IF (R0.GE.0 .AND. R0.LT.TAREA(I+1)) THEN !INSIDE MAP - PG(I,1)=R0*STEP(I)+POINXY(I,I) !PLOT COORDINATES - ELSE - PLCR=.FALSE. !DO NOT PLOT - END IF - END DO - IF (PLCR) THEN - CALL WQPOLM(1,PG) !SET POSITION - IF (PLTSRC.GT.1) THEN - TXTXY(1)=PG(1,1)+10*STEP(1) - TXTXY(2)=PG(2,1)+ 5*STEP(2) - CALL WQTEXT(TXTXY,STR) - END IF - END IF - END IF - END DO -C - IF (PLTSRC.GT.2) THEN !CONNECTIONS - DONE=.FALSE. -#ifndef wn_vx__ - R0=3 - IF (PLDEV.EQ.'X11') CALL XWDRIV(15,R0,1,' ',0) -#endif - CALL WQSTXX(0.5) !CHARACTER EXPANSION -C - DO WHILE (.NOT.DONE) - IF (.NOT.WNDPAR('SOURCES',NAMES, - 1 2*LEN(NAMES(1)),J0,'*')) DONE=.TRUE. - IF (J0.LT.2) DONE=.TRUE. - IF (.NOT.DONE) THEN !FIND SOURCES -C - I1=0 !NO MATCH YET - DO J=0,GDESJ(MDH_NSRC_J)-1 !ALL SOURCES - CALL WNGMV(MDLHDL, - 1 A_B(GDESJ(MDH_MODP_J)+J*MDLHDL-A_OB), - 1 MDL) !GET MODEL LINE - JS=NMONAM(MDL,GDES,STR,.FALSE.) !GET NAME FOR SOURCE - IF (STR.EQ.NAMES(1).OR.STR.EQ.NAMES(2)) THEN !MATCH - CALL NMOEXT(MDL) !MAKE EXTERNAL FORMAT - PLCR=.TRUE. !ASSUME INSIDE MAP - DO I=1,2 !GET X,Y - R0=(MDLE(MDL_L_E+I-1)/360./3600.- - 1 (MPHD(MPH_SHR_D+I-1)))/ - 1 (MPHD(MPH_SRA_D+I-1)) !GRID POINT SOURCE - R0=R0-(TAREA(I-1)-(TAREA(I+1)/2)) !GRID POINT OFFSET - IF (R0.GE.0 .AND. R0.LT.TAREA(I+1)) THEN !INSIDE MAP - PG(I,I1+1)=R0*STEP(I)+POINXY(I,I) !SAVE POSITION - RD(I,I1+1)=MDLE(MDL_L_E+I-1) !SAVE COORDINATE - ELSE - PLCR=.FALSE. !DO NOT USE - END IF - END DO - IF (PLCR) I1=I1+1 !COUNT MATCH - END IF - END DO -C - IF (I1.NE.2) THEN !TOO FEW FOUND - CALL WNCTXT(F_TP, - 1 'Not both sources found inside map') - ELSE - CALL WQPOLL(2,PG) !DRAW LINE - R0=SQRT( ( (RD(1,1)-RD(1,2)) )**2 + - 1 ( (RD(2,1)-RD(2,2)) )**2 ) !DISTANCE - CALL WNCTXS(STR,'!6$E6.2 deg',R0/3600) !IN DEGREES - IF (WNDPAR('TEXT',STR,LEN(STR),J0,STR)) THEN - IF (J0.GT.0.AND.STR.NE.' ') THEN - IF ( (PG(1,1)-PG(1,2))* - 1 (PG(2,1)-PG(2,2)) .LE. 0) THEN - TXTXY(1)=(PG(1,1)+PG(1,2))/2+4*STEP(1) - TXTXY(2)=(PG(2,1)+PG(2,2))/2+4*STEP(2) - ELSE - TXTXY(1)=(PG(1,1)+PG(1,2))/2+4*STEP(1) - TXTXY(2)=(PG(2,1)+PG(2,2))/2-8*STEP(2) - END IF - CALL WQTEXT(TXTXY,STR) - END IF - END IF - END IF - END IF - END DO - END IF -C -#ifndef wn_vx__ - R0=1 - IF (PLDEV.EQ.'X11') CALL XWDRIV(15,R0,1,' ',0) -#endif - END IF -C -C FINISH PLOT -C -CCC9000 CONTINUE - CALL NPLCLO(DQID2,NHV) !CLOSE -CCC CALL WNGSLP(1) ! allow for 2nd control-C -CCC IF (WNGCCN().GT.1) NO_MORE=.TRUE. ! two seen? -CCC CALL WNGCCC ! clear control-C count -C - RETURN -C - END diff --git a/src/nplot/nplone.for b/src/nplot/nplone.for deleted file mode 100644 index 38737fd33059f80ccf7d50c0b8d64870dfaa62d2..0000000000000000000000000000000000000000 --- a/src/nplot/nplone.for +++ /dev/null @@ -1,62 +0,0 @@ -C+ NPLONE.FOR -C HjV 931108 -C Combined parts of old version of NPLTEL and NPLRES -C -C Revisions: -C - SUBROUTINE NPLONE (NPLOT,CPO,HPO) -C -C Plot A/P/C/S scan/sets -C -C Result: -C -C CALL NPLONE Plot scan/sets -C -C Include files: -C - INCLUDE 'WNG_DEF' - INCLUDE 'NPL_DEF' -C -C Parameters: -C -C -C Arguments: -C - INTEGER NPLOT !# OF INTERFEROMETERS TO DO - REAL CPO !CURRENT POINT OFFSET - REAL HPO !HALF POINT OFFSET -C -C Function references: -C -C -C Data declarations: -C -C- - DO I=0,NPLOT-1 - IF (NEW(I).EQ.1E20) THEN - IF (OLD(I).NE.1E20) THEN - POINXY(1,1)=OLD(I) - POINXY(2,1)=CPO+2*HPO - POINXY(1,2)=OLD(I) - POINXY(2,2)=CPO+HPO - CALL WQPOLL(2,POINXY) - END IF - ELSE - IF (OLD(I).NE.1E20) THEN - POINXY(1,1)=OLD(I) - POINXY(2,1)=CPO+2*HPO - POINXY(1,2)=NEW(I) - POINXY(2,2)=CPO - CALL WQPOLL(2,POINXY) - ELSE - POINXY(1,1)=NEW(I) - POINXY(2,1)=CPO+HPO - POINXY(1,2)=NEW(I) - POINXY(2,2)=CPO - CALL WQPOLL(2,POINXY) - END IF - END IF - END DO !PLOT IFR/TEL -C -C - END diff --git a/src/nplot/nplopn.for b/src/nplot/nplopn.for deleted file mode 100644 index deea63ff2a22b4779948ebf300bd3da1c3e9c904..0000000000000000000000000000000000000000 --- a/src/nplot/nplopn.for +++ /dev/null @@ -1,374 +0,0 @@ -C+ NPLOPN.FOR -C HjV 931108 -C Combined parts of old version of NPLTEL and NPLRES -C -C Revisions: -C HjV 940224 Add mosaik test -C HjV 940428 Add plotting of IF data -C HjV 940503 Change PLOT SCALE for IF data -C HjV 940530 Plot different datatypes on one page -C HjV 960415 Option to stop during loop or more plots per page -C JPH 960730 Data types AGAIN and PGAIN: Scales % and deg -C JPH 9611.. Plot annotation -C JPH 970129 Move annotation to left side, Sector: closer to plot -C -C - SUBROUTINE NPLOPN (LDATTP,IPOL,NHV,IFRS) -C -C Open plot and plot heading -C -C Result: -C -C CALL NPLOPN Open plot and plot heading -C -C Include files: -C - INCLUDE 'WNG_DEF' - INCLUDE 'NPL_DEF' - INCLUDE 'WND_DEF' -C -C Parameters: -C -C -C Arguments: -C - INTEGER LDATTP !CURRENT DATA TYPE - INTEGER IPOL - INTEGER NHV(0:1) !# OF PAGES - INTEGER IFRS(0:1) !CURRENT IFR'S -C -C Function references: -C - LOGICAL WQ_MPAGE !OPEN PLOT DEVICE - CHARACTER*32 WNTTSG !SHOW SET NAME - LOGICAL WNDSTM !DECODE SET SPECIFICATION - INTEGER WNCALN !STRING LENGTH -C -C Data declarations: -C - CHARACTER*6 CORTXT(0:7) !CORRECTION TEXT - DATA CORTXT /' ','R','A','R+A','O','R+O','A+O','R+A+O'/ - CHARACTER*6 CORT - CHARACTER*2 POLNAM(0:3) !NAME OF POLARISATION - DATA POLNAM/'XX','XY','YX','YY'/ - INTEGER MXNHV(0:1) !MAX. # OF PAGES - INTEGER XINTPP,YINTPP !SIZE PER PLOT - INTEGER XOFF,YOFF !PLOT POSITION - CHARACTER*2 IFRNM !NAME IFR - CHARACTER*32 DUSER !USERNAME - CHARACTER*80 LINE !DATATYPE OR DECODED SETS -C -C TAREA = SPACE FOR PLOT + AXIS-INFO -C PAREA = SPACE FOR PLOT -C- -C -C MORE PLOTS ON ONE PAGE ??? -C - IF ((PPP(1).GT.1).OR.(PPP(2).GT.1)) THEN - MXNHV(0)=1 !SET MAX. # OF PAGES - MXNHV(1)=1 - PG(1,1)=0. !TOTAL AREA - PG(2,1)=0. - PG(1,2)=XWND - PG(2,2)=YWND - XINTPP=INT(XWND/PPP(1)) - YINTPP=INT((YWND-YFAC*20.+1)/PPP(2)) - PPPNR=PPPNR+1 - IF (PPPNR.EQ.(PPP(1)*PPP(2))) THEN - CALL NPLCLO(DQID,NHV) - IF (NO_MORE) RETURN !USER SAID: STOP - PPPNR=0 - ENDIF - XOFF=MOD(PPPNR,PPP(1)) - YOFF=INT(PPPNR/PPP(1)) - TAREA(0)=XOFF*XINTPP - TAREA(1)=(PPP(2)-YOFF-1)*YINTPP+5. - TAREA(2)=(XOFF+1)*XINTPP - TAREA(3)=(PPP(2)-YOFF)*YINTPP-5. - PAREA(1)=TAREA(1) - PAREA(2)=TAREA(2) - PAREA(3)=TAREA(3) - IF (PLOTAP) THEN - PAREA(0)=TAREA(0)+70./PPP(1) - IF (IFR_MODE.EQ.'BAND') THEN - PAREA(2)=TAREA(2)-220./PPP(1) - ELSE - PAREA(2)=PAREA(0)+360.*(HARA(1)-HARA(0))/HASC*XFAC - END IF - ELSE - PAREA(0)=TAREA(0)+50./PPP(1) - IF (IFR_MODE.EQ.'BAND') THEN - PAREA(1)=TAREA(1)+50/PPP(2)*YFAC - ELSE - PAREA(1)=TAREA(1)-1.-(50./PPP(2)+360*(HARA(1)-HARA(0))/HASC)*YFAC - END IF - ENDIF - ELSE -C -C MAKE PAGES AND OVERLAP CROSSES -C - XINTPP=0 - YINTPP=0 - XOFF=0 - YOFF=0 - PPPNR=0 - IF (PLOTAP) THEN - MXNHV(0)=MXNPAG !SET MAX. # OF PAGES - MXNHV(1)=1 - PG(1,1)=0. !TOTAL AREA - PG(2,1)=0. - IF (IFR_MODE.EQ.'BAND') THEN - PG(1,2)=XWND-220. - ELSE - PG(1,2)=360.*(HARA(1)-HARA(0))/HASC*XFAC - END IF - PG(2,2)=YWND - ELSE - MXNHV(0)=1 !MAX. # OF PAGES - MXNHV(1)=MXNPAG - PG(1,1)=0 !TOTAL AREA - IF (IFR_MODE.EQ.'BAND') THEN - PG(2,1)=0. - ELSE - PG(2,1)=YWND-1.-(50.+360.*(HARA(1)-HARA(0))/HASC)*YFAC - END IF - PG(1,2)=XWND-1. - PG(2,2)=YWND - END IF - TAREA(0)=PG(1,1) !PLOT AREA. - TAREA(1)=PG(2,1)+1. - TAREA(2)=PG(1,2) - TAREA(3)=PG(2,2)-YFAC*20.+1. - IF (PLOTAP) THEN - PAREA(0)=TAREA(0)+70. - PAREA(2)=TAREA(2)+70. - ELSE - PAREA(0)=TAREA(0)+50. - PAREA(2)=TAREA(2) - ENDIF - PAREA(1)=TAREA(1) - PAREA(3)=TAREA(3) - END IF -C -C OPEN PLOT -C - IF (PPPNR.EQ.0) THEN - IF (.NOT.WQ_MPAGE(DQID,NHV,PLDEV,MXNHV,780.,PG(1,1))) THEN - CALL WNCTXT(F_TP,'Cannot find plotter') - CALL WNGEX !STOP PROGRAM - END IF -C -C PLOT HEADING -C - CALL WNGSGU(DUSER) !GET USER - CALL WQ_MPLR(DQID,NHV,1,1,1.,0) !NORMAL UNITS - CALL WQSTXH(TXTHGT) !TEXT HEIGHT - CORT=CORTXT(IAND(CORAP,7)) - IF (((PPP(1).GT.1).OR.(PPP(2).GT.1)).AND.(NDATTP.GT.1)) THEN - LINE=' ' - ELSE - LINE=DATTYP(LDATTP) - END IF - IF (OPT.EQ.'TEL') THEN - IF (IF_MODE.EQ.' ') THEN !No IF data - CALL WNCTXS(TEXT,' !AS (!AS) corrections by !AS ', - 1 LINE,CORT,DUSER) - ELSE - CALL WNCTXS(TEXT,' !AS (!AS) !AS by !AS ', - 1 LINE,CORT,IF_MODE,DUSER) - END IF - ELSE IF (OPT.EQ.'RES') THEN - CALL WNCTXS(TEXT,' !AS (!AS) residuals by !AS ', - 1 LINE,CORT,DUSER) - ELSE IF (OPT.EQ.'DAT') THEN - CALL WNCTXS(TEXT,' !AS (!AS) data by !AS ', - 1 LINE,CORT,DUSER) - ELSE IF (OPT.EQ.'INT') THEN - CALL WNCTXS(TEXT,' !AS (!AS) ifr.corrections by !AS ', - 1 LINE,CORT,DUSER) - ELSE IF (OPT.EQ.'MOD') THEN - CALL WNCTXS(TEXT,' !AS (!AS) model data by !AS ', - 1 LINE,CORT,DUSER) - END IF - CALL WQ_MDATE(DQID,NHV,TEXT) !DATE MESSAGE - CALL WNCTXS(TEXT,'Node: !AS !50CFile: !AS',NODIN,FILIN) - TXTXY(1)=0. !WRITE HEADING - TXTXY(2)=PAREA(3)+15*YFAC - CALL WQTEXT(TXTXY,TEXT) !TEXT - CALL WNCTXS(TEXT,'Field: !AS !50CObs. yy.day: !2$UI\.!3$ZI', - 1 FNAM,OBSDY(2),OBSDY(1)) - TXTXY(1)=0. !WRITE HEADING - TXTXY(2)=PAREA(3)+12*YFAC - CALL WQTEXT(TXTXY,TEXT) !TEXT - TXTXY(1)=0. !WRITE HEADING - TXTXY(2)=PAREA(3)+9*YFAC - CALL WQTEXT(TXTXY,ANNOTN) -C -C PLOT SCALE -C - IF (.NOT.PLOTAP) THEN - IF ((PPP(1).GT.1).OR.(PPP(2).GT.1)) THEN - I2=14 - ELSE - I2=13 - END IF - POINXY(1,1)=210*XFAC !PLOT 1CM LINE BEGIN (Y) - POINXY(2,1)=PAREA(3)+(I2+1)*YFAC - POINXY(1,2)=POINXY(1,1) - POINXY(2,2)=PAREA(3)+(I2-1)*YFAC - CALL WQPOLL(2,POINXY) !POLYLINE - POINXY(1,1)=210*XFAC !PLOT 1CM. LINE (X) - POINXY(2,1)=PAREA(3)+I2*YFAC - POINXY(1,2)=220*XFAC - POINXY(2,2)=POINXY(2,1) - CALL WQPOLL(2,POINXY) !POLYLINE - POINXY(1,1)=220*XFAC !PLOT 1CM. LINE END (Y) - POINXY(2,1)=PAREA(3)+(I2+1)*YFAC - POINXY(1,2)=POINXY(1,1) - POINXY(2,2)=PAREA(3)+(I2-1)*YFAC - CALL WQPOLL(2,POINXY) !POLYLINE - I2=0 - I1=12 !Y-POSITION - IF ((PPP(1).EQ.1).AND.(PPP(2).EQ.1).AND. - 1 (DATTYP(LDATTP)(1:1).EQ.'P')) I2=1 - IF (I2.EQ.0) THEN - IF (OPT.EQ.'TEL') THEN - IF (IF_MODE(1:4).EQ.'TSYS' .OR. - 1 IF_MODE(1:5).EQ.'TNOIS') THEN - CALL WNCTXS(TEXT,'= !E9.2 K',SCAL(1)*10.) - ELSE IF (IF_MODE.NE.' ') THEN - CALL WNCTXS(TEXT,'= !E9.2 units',SCAL(1)*10.) - ELSE - CALL WNCTXS(TEXT,'= !E9.2 %',SCAL(1)*10.) - END IF - ELSEIF (OPT.EQ.'RES'.AND.DATTYP(LDATTP)(1:2).EQ.'AG') THEN - CALL WNCTXS(TEXT,'= !E9.2 %',SCAL(1)*10.) - ELSE - CALL WNCTXS(TEXT,'= !E9.2 W.U.',SCAL(1)*10.) - ENDIF - TXTXY(1)=222.*XFAC !PLOT RULE - TXTXY(2)=PAREA(3)+I1*YFAC - CALL WQTEXT(TXTXY,TEXT) !TEXT - I1=15 !Y-POSITION - END IF - I2=0 - IF ((PPP(1).EQ.1).AND.(PPP(2).EQ.1).AND. - 1 (DATTYP(LDATTP)(1:1).NE.'P')) I2=1 - IF (I2.EQ.0) THEN - IF (OPT.EQ.'DAT' .OR. OPT.EQ.'MOD' .OR. - 1 OPT.EQ.'INT' .OR. OPT.EQ.'TEL' .OR. - 1 OPT.EQ.'RES'.AND.DATTYP(LDATTP)(1:2).EQ.'PG') THEN - CALL WNCTXS(TEXT,'= !E9.2 degrees (Ph)',SCAL(2)*10.) - ELSE - CALL WNCTXS(TEXT,'= !E9.2 W.U. (Ph)',SCAL(2)*10.) - END IF - TXTXY(1)=222.*XFAC !PLOT RULE - TXTXY(2)=PAREA(3)+I1*YFAC - CALL WQTEXT(TXTXY,TEXT) !TEXT - END IF - END IF -C -C DRAW PLOTS-SEPERATOR -C - IF ((PPP(1).GT.1).OR.(PPP(2).GT.1)) THEN - CALL WQSPLI(3) !DOTTED - DO I0=1,PPP(1)-1 - POINXY(1,1)=I0*XINTPP - POINXY(2,1)=0. - POINXY(1,2)=POINXY(1,1) - POINXY(2,2)=YWND-20*YFAC - CALL WQPOLL(2,POINXY) - END DO - DO I1=1,PPP(2)-1 - POINXY(1,1)=0. - POINXY(2,1)=I1*YINTPP - POINXY(1,2)=XWND - POINXY(2,2)=POINXY(2,1) - CALL WQPOLL(2,POINXY) - END DO - CALL WQSPLI(1) !NORMAL - END IF - ENDIF -C -C WRITE PLOT INFO PER PLOT IN HEADER -C - IF (MOSAIK.AND.(XPOFF(0,1,0).EQ.1).AND. - 1 (XPOFF(0,0,1).EQ.1).AND.(XPOFF(1,0,1).EQ.0)) THEN - JS=WNDSTM(SETS,LINE) !DECODE SETS - ELSE - LINE=WNTTSG(SETNAM,0) !SET NAME - END IF - I2=WNCALN(LINE) !LENGTH LINE - IF (IFR_MODE.EQ.'NORMAL' .OR. - 1 IFR_MODE.EQ.'INVERT' .OR. - 1 IFR_MODE.EQ.'SORT') THEN !SCN FILE DATA: (HA,IFRS) - IF (PLOTAP) THEN - IFRNM=TXT(1)(1:1)//TXT(2)(1:1) - CALL WNCTXS (TEXT,'Sector: !AS (!AS-!AS)', - 1 LINE(1:I2),IFRNM,POLNAM(IPOL)) !SET NAME + IFR + POL - ELSE - CALL WNCTXS (TEXT,'Sector: !AS (!AS-!AS)', - 1 LINE(1:I2),POLNAM(IPOL),DATTYP(LDATTP)(1:3)) !SET NAME + POL + DATTYP - END IF - ELSE IF (IFR_MODE.EQ.'SPECTRAL') THEN !SCN FILE DATA: (HA,CHAN) - IF (OPT.EQ.'TEL') THEN - IFRNM=TELNAM(IFRS(0)+1:IFRS(0)+1)//POLNAM(IPOL)(1:1) - CALL WNCTXS (TEXT,'Tel: !AS (!AS)',IFRNM, - 1 DATTYP(LDATTP)(1:3)) !TEL + POL + DATTYP - ELSE - IFRNM=TELNAM(IFRS(0)+1:IFRS(0)+1)// - 1 TELNAM(IFRS(1)+1:IFRS(1)+1) - CALL WNCTXS (TEXT,'Ifr: !AS (!AS-!AS)', - 1 IFRNM,POLNAM(IPOL),DATTYP(LDATTP)(1:3)) !IFR + POL + DATTYP - END IF - ELSE IF (IFR_MODE.EQ.'BAND') THEN !SCN FILE DATA: (CHAN,IFR) - IF (PLOTAP) THEN - IFRNM=TXT(1)(1:1)//TXT(2)(1:1) - CALL WNCTXS (TEXT,'HA: !6$E6.2 - !6$E6.2 (!AS-!AS)', - 1 HARA(0)*360.,HARA(1)*360.,IFRNM,POLNAM(IPOL)) -C !SECTOR + HA + IFR + POL - ELSE - CALL WNCTXS (TEXT,'HA: !6$E6.2 - !6$E6.2 (!AS-!AS)', - 1 HARA(0)*360.,HARA(1)*360.,POLNAM(IPOL), - 2 DATTYP(LDATTP)(1:3)) !SECTOR + HA + POL + DATTYP - END IF - END IF - IF (PPP(1).GT.4) THEN - CALL WQSTXH(TXTHGT/1.5) !TEXT HEIGHT - ELSE - CALL WQSTXH(TXTHGT) !TEXT HEIGHT - END IF - TXTXY(1)=XOFF*XINTPP - TXTXY(2)=PG(2,2)-(15+YOFF*3)*YFAC - CALL WQTEXT(TXTXY,TEXT) !TEXTC -C -C WRITE PLOT INFO PER PLOT -C - IF ((PPP(1).GT.1).OR.(PPP(2).GT.1)) THEN - IF (.NOT.PLOTAP) THEN - IF (IFR_MODE.EQ.'NORMAL'.OR. - 1 IFR_MODE.EQ.'INVERT' .OR. - 1 IFR_MODE.EQ.'SORT') THEN !SCN FILE DATA: (HA,IFRS) - TEXT=POLNAM(IPOL)//'-'//DATTYP(LDATTP)(1:1) - CALL WNCTXS (TEXT,'!AS-!AS',POLNAM(IPOL),DATTYP(LDATTP)(1:1)) - ELSE IF (IFR_MODE.EQ.'SPECTRAL') THEN !SCN FILE DATA: (HA,CHAN) - IF (OPT.EQ.'TEL') THEN - TEXT=TELNAM(IFRS(0)+1:IFRS(0)+1)//POLNAM(IPOL)(1:1)// - 1 '-'//DATTYP(LDATTP)(1:1) - ELSE - TEXT=TELNAM(IFRS(0)+1:IFRS(0)+1)// - 1 TELNAM(IFRS(1)+1:IFRS(1)+1)//POLNAM(IPOL)// - 2 '-'//DATTYP(LDATTP)(1:1) - END IF - ELSE IF (IFR_MODE.EQ.'BAND') THEN !SCN FILE DATA: (CHAN,IFR) - TEXT=POLNAM(IPOL)//'-'//DATTYP(LDATTP)(1:1) - END IF - CALL WQSTXH(TXTHGT/PPP(2)) !TEXT HEIGHT - TXTXY(1)=TAREA(0) - TXTXY(2)=PAREA(3)-9./PPP(2)*YFAC - CALL WQTEXT(TXTXY,TEXT(1:6)) !TEXTC - CALL WQSTXH(TXTHGT) !TEXT HEIGHT - END IF - END IF -C - END diff --git a/src/nplot/nplot.for b/src/nplot/nplot.for deleted file mode 100644 index eaaf462a3fa4b544e03a5be75e6625dbfea72e9c..0000000000000000000000000000000000000000 --- a/src/nplot/nplot.for +++ /dev/null @@ -1,100 +0,0 @@ -C+ NPLOT.FOR -C WNB 910617 -C -C Revisions: -C WNB 910828 Add RUN -C WNB 910913 Change loops -C WNB 911220 Loop maps -C HjV 940112 Reorganize NPLTEL and NPLRES -C CMV 940822 Option to abort loops -C CMV 960122 Warning if /NORUN ignored -C JPH 960622 Call WNGSCC -C JPH 960805 ST_INIT=ST_MODE -C JPH 960814 Close FCAIN after map NO_MORE -C JPH 961120 Clear control-C count before exit -C JPH 970129 Minor change to message text -C HjV 970723 Remove control-C stuff (commented out with CCC) -C -C - SUBROUTINE NPLOT -C -C Main routine to handle data/map plotting -C -C Result: -C -C -C Include files: -C - INCLUDE 'WNG_DEF' - INCLUDE 'NPL_DEF' -C -C Parameters: -C -C -C Arguments: -C -C -C Function references: -C - LOGICAL WNDRUN !TEST RUN - LOGICAL WNDXLN !NEXT LOOP -C -C Data declarations: -C - LOGICAL ACT !FIRST ACTION ASK PLOTTER - DATA ACT/.TRUE./ -C- -C -C PRELIMINARIES -C - CALL NPLINI !INIT PROGRAM - IF (.NOT.WNDRUN()) - 1 CALL WNCTXT(F_TP,'Ignored option /NORUN') -C -C DISTRIBUTE -C - 10 CONTINUE - CALL NPLDAT(ACT) !GET USER DATA - IF (ACT) RETURN !NOTHING DEFINED - IF (OPT.EQ.'QUI') THEN !READY -CCC CALL WNGCCC ! clear control-C count - CALL WNGEX -CCC ELSE -CCC CALL WNCTXT(F_T, -CCC 1 '!/!4C\'// -CCC 1 'Use control-C to interrupt a plot and start the next one'// -CCC 1 '!/!4C\'// -CCC 1 'Use two control-C''s to abort the program!/' ) - ENDIF - IF (OPT.EQ.'DAT' .OR. - 1 OPT.EQ.'MOD' .OR. - 2 OPT.EQ.'RES' .OR. - 3 OPT.EQ.'INT' .OR. - 4 OPT.EQ.'TEL') THEN !PLOT DATA/RESID. OR TEL. ERRORS - CALL WNDXLI(LPOFF) !CLEAR OFFSETS - DO WHILE (WNDXLN(LPOFF)) !MORE - CALL NPLLOD !DO PLOTS - IF (NO_MORE) GOTO 10 - END DO - CALL WNFCL(FCAIN) !CLOSE SCAN FILE - GOTO 10 !RETRY - ELSE IF (OPT.EQ.'MAP') THEN !PLOT MAP - CALL WNDXLI(LPOFF) !CLEAR OFFSETS - DO WHILE (WNDXLN(LPOFF)) !MORE - CALL NPLMAP !DO PLOTS - IF (NO_MORE) GOTO 11 - END DO - 11 CONTINUE - CALL WNFCL(FCAIN) !CLOSE MAP FILE - GOTO 10 - END IF -C - RETURN !READY -C -C - END - - - - - diff --git a/src/nplot/nplot.psc b/src/nplot/nplot.psc deleted file mode 100644 index a02054f34f473b06d17a8b53a0c5dfac6d8e3459..0000000000000000000000000000000000000000 --- a/src/nplot/nplot.psc +++ /dev/null @@ -1,870 +0,0 @@ -!+ NPLOT.PSC -! WNB 910617 -! -! Revisions: -! WNB 910828 Add RUN -! WNB 910909 Add DATAB and INFIX -! WNB 910913 New (de-)apply and loops -! WNB 911007 Include instrum. pol. -! WNB 911217 Change halftone -! WNB 911219 Change plot devices -! WNB 911220 Add pol, ruled surface -! WNB 911230 NMODEL -! WNB 920423 Text for DLM coordinate option -! WNB 920626 Add DCLOW, change Rotation measure description -! WNB 920820 Change range explanation -! WNB 920831 Add PLUVO -! WNB 921021 Add A3 plotter -! WNB 921104 Text Select ifrs; J2000 -! WNB 921211 Make PSC -! HjV 921222 X11-plotter option partly available (NOT halftone) -! JEN 930308 INCLUDE=NSETS_PEF, remove keyword SETS -! JEN 930312 INCLUDE=NCOMM_PEF -! JEN 930312 Remove keyword(s) SCAN_NODE, MAP_NODE -! JEN 930312 Remove keyword(s) SELECT_IFRS, POLARISATION, HA_RANGE -! WNB 930402 Add DISPLAY info -! HjV 930426 Change name keyword ANGLE_SET -! HjV 930722 Change PLUVO in IFR_MODE -! WNB 930824 Remove TELESCOPES -! HjV 940119 Add AP and CS to DATA_TYPES, add keyword -! PLOT_PER_PAGE, add BAND to IFR_MODE -! CMV 940420 Add option NAME to PLOT_POSITIONS -! CMV 940425 Add IF options -! CMV 940622 Add EDIT option to PLOT_POSITIONS, add SOURCES, TEXT -! CMV 940622 Add INTERFEROMETER option to OPTION -! CMV 940628 Add ISYS option to IF_MODE -! CMV 940817 Options to ignore pixel coordinate axes -! JPH 940913 Correct ANGLE_WMP_SET prompt -! Remove () from promts -! JPH 941025 NCOMM, NSETS --> SCNNODE/SETS, WMP_NODE/SETS, SELECT -! Fix damage from automatic line merging -! JPH 941206 PLOTTER_PEF. Help texts, prompt formatting -! JPH 950215 Typo -! JPH 950818 HjV 941031 from master copy: Add MDLNODE_PEF -! HjV 950711 from master copy: Use PLOTTER_PEF, add -! annotation PLOT_HEADING -! Text mods -! JPH 960126 Correct help text on IFR_MODE (bug 201) -! HjV 960201 Correct wrong change made by JPH for PLOT_HEADING -! JPH 960523 Change ST_ options in IFR_MODE into S_ options in OPTION -! JPH 960619 Replace S_ option selection by OPTION=SPECIAL and -! HA_MODE -! JPH 960805 ANNOTATION -! JPH 961115 HA integration -! WNB 970529 Add COORD_PREC -! WNB 970605 Make default COORD_PREC 256 -! -! -! -! Get plot device -! Ref: NPLDAT -! -INCLUDE=PLOTTER_PEF ! -! -! Get overall action -! Ref: NPLDAT -! -KEYWORD=OPTION - DATA_TYP=C - IO=I - LENGTH=24 - CHECKS=ABBREV_OPTIONS - SWITCHES=LOOP,NULL_VALUES,WILD_CARDS - SEARCH=L,P - PROMPT="Type of data to plot|" - OPTIONS= MAP; DATA, RESID, MODEL; TELESC, INTERFM, IFDATA;|- -SPECIAL; QUIT - DEFAULT="QUIT" - HELP=" -Specify type of data to plot: -. - .WMP-file data: -. - MAP image(s) from .WMP file -. - .SCN-file visibilities: - DATA observed visibilities - MODEL model visibilities - RESIDUAL visibility residuals (after correction of all known - errors and division by the visibilities of a source - model (yet to be specified) - (sets I=1, QUV=0) -. - .SCN-file correction parameters: -. - TELESCOPE telescope phase/gain corrections - INTERFEROMETER interferometer phase/gain corrections (i.e. all - corrections combined per interferometer) -! I rechecked this 960523 - JPH - IFDATA IF-data: total powers, system temperatures etc. -. - Plotting versus sidereal time i.s.o. hour angle: -. - SPECIAL will prompt for a special mode -. - QUIT terminate NPLOT " -! -! Get special hour-angle plotting mode -! Ref: NPLDAT -KEYWORD=HA_MODE - DATA_TYP=C - IO=I - LENGTH=10 - CHECKS=ABBREV_OPTIONS - SWITCHES=LOOP,NULL_VALUES,WILD_CARDS - SEARCH=L,P - PROMPT="Special HA plot coordinates" - OPTIONS=ST,IST, SEQUENCE,ISEQUENCE - DEFAULT="" - HELP=" -This parameter selects a coordinate conversion for the vertical (HA) plot -coordinate in plots of .SCN-file entities. -. - ST Sidereal time i.s.o. HA. This is useful for plotting a series of - observations (e.g. calibrators-object-calibrators) in a time - sequence, e.g. to survey interference. Vertical coordinate is - ST in degrees -. - SEQUENCE Pseudo sidereal time: Sidereal time is forced into an ascending - sequence: When the start ST for a sector is less than that of - the one just plotted, it is changed to make the new sector - follow the previous one contiguously. Within each sector, - vertical scale size is that of HA or ST, but the sectors are - displaced in ST. Sectors are plotted in order of their index. - This mode is useful to stuff a lot of information into a single - plot, e.g. to check for interference, but the plot may become - too confusing. -. - I<xxx> The prefix I indicates that you want to integrate scans; you - will be prompted for the HA interval over which to integrate. - As currently implemented, this mode is effective only for plots - that have HA or (pseudo)ST as vertical coordinate. The plot - scale for this coordinate will not be affected. -. -NPLOT will set plotting mode according to your reply and return to the OPTION -prompt. The mode will remain in force until you change it or NPLOT exits. " -! -! Get integration time -! -KEYWORD=HA_INTEGRATION - DATA_TYP=R - IO=I - SWITCH=LOOP,WILD_CARD - CHECKS=MAXIMUM - MAXIMUM=3600. - SEARCH=L,P - PROMPT="Integration time (sec)" - HELP=" -Specify the time interval over which you want to integrate (if possible) before -calibrating. The value you specify will be rounded down to a multiple of the -hour-angle interval between successive scans. -. -'*' and '0' mean do not integrate, i.e. calibrate per scan. -. -The largest value allowed is 3600 (= 1 hour). " -! -! Get plot annotation -! -KEYWORD=ANNOTATION - DATA_TYP=C - IO=I - LENGTH=80 - SWITCHES=LOOP,NULL_VALUES,WILD_CARDS - SEARCH=L,P - PROMPT="Annotation text, up to 80 characters in double quotes" - HELP=" -This text will be displayed on all plots for this NPLOT run until you change it -" -! -! Get IF action -! Ref: NPLDAT -KEYWORD=IF_MODE - DATA_TYP=C - IO=I - LENGTH=8 - CHECKS=ABBREV_OPTIONS - SWITCHES=LOOP,NULL_VALUES,WILD_CARDS - SEARCH=L,P - PROMPT="Parameter to plot" - OPTIONS=- -TPON,TPOFF, TSYS,ISYS, GAIN; GNCAL, TSYSI,TNOISI, RGAINI - HELP=" -Specify action to perform: -. - Telescope parameters: -. - TPON total power data (noise source off) - TPOFF total power data (noise source on) - TSYS system temperatures - ISYS system temperatures (X+Y) - GAIN IF gains -. - Interferometer parameters: -. - GNCAL gain correction method - TSYSI constant system temperature - TNOISI constant noise source temperature - RGAINI constant receiver gain" -! -! Get PLUVO action -! Ref: NPLDAT -! -KEYWORD=IFR_MODE - DATA_TYP=C - IO=I - LENGTH=16 - CHECKS=ABBREV_OPTIONS - SWITCHES=LOOP,NULL_VALUES,WILD_CARDS - SEARCH=L,P - OPTIONS=NORMAL, INVERT, SORT; SPECTRAL, BAND - PROMPT="Select data cross-section" - HELP=" -Specify the cross section through the visibility data cube to be plotted: - Consider the interferometers arranged in an upper-triangular matrix: -. - 00 01 02 ... 0B 0C 0D - 11 12 ... 1B 1C 1D - 22 ... 2B 2C 2D - : : : - BB BC BD - CC CD - DD -. -Then the possible plotting modes are -. - visibilities as function of hour angle per interferometer: -. - NORMAL interferometer order in the matrix is row by row -. - INVERT interferometer order in the matrix is column by column . - SORT interferometers in order of ascending baseline -. - other cross sections of the hour-angle/interferometer/channel cube: -. - SPECTRAL visibilities as function of spectral channel and hour angle, - per interferometer (the WSRT 'PLUVO' format) -!! i.e. one plot per ifr? -. - BAND visibilities as function of channel and interferometer, - interferometer order as for NORMAL -!! for one HA or averaged? -" -! -! -! Get angle input set -! Ref: NPLDAT -! -KEYWORD=ANGLE_WMP_SET - DATA_TYP=C - IO=I - LENGTH=32 - NVALUES=1 - SWITCHES=LOOP,NULL_VALUES,WILD_CARDS - SEARCH=L,P - PROMPT="ONE position-angle map: grp.fld.chn.pol.0.seq" - HELP=" -Select a .WMP-file image holding polarisation position angles. If the image you -specify contains anything else, your plot will be garbage. -. -The .WMP-file indices are: -. - group.field.channel.polarisation.type(=0).sequence_number" -! -! Get data types to plot -! Ref: NPLDAT -! -KEYWORD=DATA_TYPES - DATA_TYP=C - LENGTH=16 - NVALUES=6 - SWITCH=LOOP,NULL_VALUES,WILD_CARD - CHECKS=ABBREV_OPTIONS - SEARCH=L,P - PROMPT="Visibility component to plot" - OPTIONS=AMPLITUDE,PHASE; AGAIN,PGAIN; COSINE,SINE; AP,CS - DEFAULT=AMPLITUDE - HELP=" -Specify the visibility component to be plotted. -. - The quantity plotted depends on the data selected. For TEL or INTERF -and for redund. RES : gain-1(%), phase(deg) For DATA: - ampl (WU), phase(deg For Selfcal RES with external model: - -. - Standard representations of complex data: -. - Model Resid Int.model - AMPLITUDE - PHASE - COSINE - SINE -. - Instrumental gain/phase for DATA_TYPE=RES: - AGAIN Re log(data/model) * 100 = gain in % - PGAIN Im log(data/model) * 180/pi = phase in deg -. - Old WSRT 'PLOTAP' formats: -. - AP amplitude/phase plots, one pair per page - CS cosine/sine plots, one pair per page -. - -" -! -! Get number of plots per page -! Ref: NPLDAT -! -KEYWORD=PLOTS_PER_PAGE - DATA_TYPE=J - IO=I - NVALUES=2 - SWITCH=LOOP,VECTOR - CHECKS=MAXIMUM,MINIMUM - MAXIMUM=5,3 - MINIMUM=1,1 - DEFAULT=1,1 /ASK - SEARCH=L,P - PROMPT="Number of plots per page in hor. and vert. directions" - HELP=" -Specify number of plots to be plotted on one page." -! -! Get map data types to plot -! Ref: NPLDAT -! -KEYWORD=DATA_TYPE - DATA_TYP=C - LENGTH=16 - SWITCH=LOOP,NULL_VALUES,WILD_CARD - CHECKS=ABBREV_OPTIONS - SEARCH=L,P - OPTIONS=DATA; SLOPE - DEFAULT=DATA /ASK - PROMPT="data types to plot" - HELP=" -Specify the data type(s) to be plotted. -. - DATA or * plot the data as given in the map - SLOPE plot the horizontal slope of the data (This option is still - experimental!) -!! purpose? -" -! -! Get plot types -! Ref: NPLDAT -! -KEYWORD=PLOT_TYPE - DATA_TYP=C - LENGTH=16 - NVALUES=4 - SWITCH=LOOP,NULL_VALUES,WILD_CARD - CHECKS=ABBREV_OPTIONS - SEARCH=L,P - PROMPT="Data representation(s)" - OPTIONS=CONTOUR, HALFTONE, RULED; POLARISATION - HELP=" -Specify the (combination of) data representations: -. - CONTOUR Contour plot - HALFTONE Halftone plot - * Equivalent to CONTOUR,HALFTONE - RULED Ruled-surface -. - POLARISATION Pseudo-vectors of linear polarisation. This requires two - input maps, one holding polarisation strengths - sqrt(Q*Q+U*U) and the other position angles atan(U/Q)/2. -! {\em Such maps are prepared with -! \whichref{NMAP FIDDLE xxx}{} } -" -! -! Get scale amplitude -! Ref: NPLDAT -! -KEYWORD=SCALE_AMPL - DATA_TYP=R - IO=I - SWITCH=LOOP,NULL_VALUES,WILD_CARDS - CHECKS=MINIMUM - MINIMUM=0. - SEARCH=L,P - DEFAULTS=10. - PROMPT="Magnitude scale (W.U./mm or %/mm)" - HELP=" -Specify the magnitude scale: -. - in Westerbork Units /mm for source/model visibilities and visibility - residuals - in percent/mm for telescope corrections -. -The ugly default for DATA_TYPE=RES is 4 times the maximum of the Redun/Align -amplitude noises recorded in the sector headers selected. For other DATA_TYPEs -it is a value that is likely to give reasonable output. " -!! this must be incomplete! -! -! Get scale phase -! Ref: NPLDAT -! -KEYWORD=SCALE_PHASE - DATA_TYP=R - IO=I - SWITCH=LOOP,NULL_VALUES,WILD_CARDS - CHECKS=MINIMUM - MINIMUM=0. - SEARCH=L,P - DEFAULTS=1. - PROMPT="Phase scale (W.U./mm or deg/mm)" - HELP=" -Specify the phase scale: -. - in Westerbork Units /mm for residuals - in degrees/mm for source/model visibilities; for telescope - corrections. -. -The default is a value that is likely to give reasonable output. " -!! verify -! -! Get scale HA -! Ref: NPLDAT -! -KEYWORD=HA_SCALE - DATA_TYP=R - IO=I - SWITCH=LOOP,NULL_VALUES,WILD_CARDS - CHECKS=MINIMUM - MINIMUM=0. - SEARCH=L,P - DEFAULT=1. - PROMPT="HA plot scale (degree/cm)" - HELP=" -Specify the hour-angle scale in degree/cm." -! -! Get scale polarisation -! Ref: NPLDAT -! -KEYWORD=POL_SCALE - DATA_TYP=R - IO=I - SWITCH=LOOP,NULL_VALUES,WILD_CARDS - CHECKS=MINIMUM - MINIMUM=0. - SEARCH=L,P - PROMPT="Polarisation pseudo-vector length scale W.U./cm" - HELP=" -Specify the polarisation pseudo-vector length scale in Westerbork Units /cm." -! -! Get scale ruled -! Ref: NPLDAT -! -KEYWORD=RULE_SCALE - DATA_TYP=R - IO=I - SWITCH=LOOP,NULL_VALUES,WILD_CARDS - CHECKS=MINIMUM - MINIMUM=0. - SEARCH=L,P - PROMPT="Ruled-surface height scale (W.U./cm)" - HELP=" -Specify the ruled-surface height scale in Westerbork Units /cm." -! -! Get area -! Ref: NPLDAT -! -KEYWORD=AREA - DATA_TYP=J - IO=I - NVALUES=4 - SWITCHES=LOOP,VECTOR,NULL_VALUES,WILD_CARD - SEARCH=L,P - PROMPT="Area centre (l,m) and width (dl,dm) in grid units" - HELP=" -Specify an area of a map: -. - l,m grid coordinates of area centre: 0,0 is the map centre, - increasing to the upper right (i.e. with DEcreasing - right ascension and INcreasing declination) -. - dl,dm area width and height " -! -! Get plot size -! Ref: NPLDAT -! -KEYWORD=SIZE - DATA_TYPE=R - IO=I - NVALUES=2 - SWITCH=LOOP,VECTOR - CHECKS=MAXIMUM,MINIMUM - MAXIMUM=5.,5. - MINIMUM=.001,.001 - DEFAULT=1.,1. /ASK - SEARCH=L,P - PROMPT="Plot scaling factors (horizontal, vertical)" - HELP=" -At this point, the plot has been dimensioned to fit on a single plotter page or -terminal screen, but will not necessarily fill it. You may blow it up in either -or both dimensions with the factors you specify here. -. -If necessary, the blown-up plot will be distributed over more tham one page. -!! Explain default size -!! ''(i.e. a QMS plot of a power of 2 length will be 12.8 cm).'' -" -! -! Get full drawn contours -! Ref: NPLDAT -! -KEYWORD=FULL_CONT - DATA_TYPE=R - IO=I - NVALUES=32 - SWITCH=LOOP,NULL_VALUE - SEARCH=L,P - PROMPT="Full-contour levels" - HELP=" -Specify up to 32 values of the contours to be drawn as full lines. " -! -! Get dotted contours -! Ref: NPLDAT -! -KEYWORD=DOT_CONT - DATA_TYPE=R - IO=I - NVALUES=32 - SWITCH=LOOP,NULL_VALUE - SEARCH=L,P - PROMPT="Dotted-contour levels" - HELP=" -Specify up to 32 values of the contours to be drawn as dotted lines. " -! -! Specify halftone -! Ref: NPLDAT -! -KEYWORD=HALFTONE - DATA_TYP=C - IO=I - LENGTH=24 - SWITCH=LOOP,NULL_VALUE,WILD_CARD - CHECKS=ABBREV_OPTIONS - SEARCH=L,P - OPTIONS=NONE,CONTINUE; STEP,PATTERN - DEFAULT=NONE /ASK - PROMPT="Halftone transfer function" - HELP=" -At this point, data values have been normalised to lie within the interval -[0,1]. Halftones are represented by the same interval: 0=white, 1=black. You -are now to define the transfer function F for mapping data values onto -halftones: -. - halftone = F (normalised data value) -. - Continuous functions: -. - CONTINUE a quadratic function (you will be prompted for the - coefficients) - NONE direct mapping: halftone level = normalised data value -. - Discontinuous functions: -. - STEP F is a staircase function; halftone shades are generated by a - stochastic algorithm - PATTERN as STEP, but halftone shades are represented by a set of - fixed patterns -. -In selecting a method, bear in mind that the human eye is quite sensitive to -density variations in light shades while very poorly perceiving the same -variations in the dark shades; in other words, its response to density -variations is quasi-logarithmic. -. -To compensate for this, a quasi-exponential transfer function is suitable. The -best approximation to this available here is a steeply quadratic function (i.e. -specify CONTINUE here and consult the on-line help for the TRANSFORM parameter). -. -You may judge the quality of your transfer function from the grey-scale wedge -that will appear side by side with your plot. " -! -! Get halftone range -! Ref: NPLDAT -! -KEYWORD=RANGE - DATA_TYPE=R - IO=I - NVALUES=2 - SWITCH=LOOP,VECTOR,NULL_VALUE,WILD_CARD - CHECKS=ASCENDING - SEARCH=L,P - PROMPT="Halftone saturation limits" - HELP=" -Specify the range of values to be covered by the full range of halftone shades. -. -The first value is the minimum to be represented by 'white', the second value -the to be represented by 'black'. -. -NOTES: - Values outside this range will always be white. (If you think this is a -bad idea, please submit a Bug Report.) - It is not possible to invert the scale by specifying a maximum<minimum." -! -! Get halftone conversion -! Ref: NPLDAT -! -KEYWORD=TRANSFORM - DATA_TYPE=R - IO=I - NVALUES=5 - MIN_NVALUE=3 - SWITCH=LOOP,NULL_VALUE,WILD_CARD - SEARCH=L,P - PROMPT="Grey-scale transfer coefficients:|- -up to 5 groups of 2 limits plus 3 coefficients of quadratic|" - HELP=" -Specify the range coefficients for the CONTINUOUS quadratic transfer function -that you selected. -! {\em parameter \textref{HALFTONE}{.halftone} } -. -Remember that the data at this point have been normalised to the range [0,1]. -You may specify 5 values, of which the first three are REQUIRED: -. - m,M Range of normalised data values to be represented by the full - halftone range. Values outside this range will be truncated. - a,b,c The 0-th through 2nd-order coefficients in the transfer - quadratic. -. -The result will be ('ndv' = normalised data value): -. - ndv < m: OUT = 0 (white) - m < ndv < M: OUT = a + b*IN + c*IN*IN (grey scale) - ndv > M: OUT = 1 (black) -. -You may break the IN range up into partial ranges by specifying multiple sets -of m,M,a,b,c separated by semicolons, or specifying the sets one by one as the -prompt is repeated. Input will be considered complete when you give no new -reply. -. -Examples: - standard linear, halftone=ndv: 0,1, 0,1 - ndv distance from .5: 0,.5, 1,-2; .5,1, -1,2 - four grey levels: 0,.25,0; .25,.5,.25; .5,.75,.5; .75,1,1 - an approximation to an exp - that seeks to match the - quasi-logarithic response - of the human eye: 0,1, 0,.1,.9 " -! -! Get polarisation range -! Ref: NPLDAT -! -KEYWORD=POL_RANGE - DATA_TYPE=R - IO=I - NVALUES=2 - SWITCH=LOOP,VECTOR,NULL_VALUE,WILD_CARD - CHECKS=ASCENDING - SEARCH=L,P - PROMPT="Polarised-flux limits (W.U.)" -!! units? - HELP=" -No polarisation pseudo-vector will be drown if the intensity of linear -polarisation is below the lower limit (and therefore mainly noise); above the -upper limit it will be truncated to that limit. -. -Please specify the limits in Westerbork Units. " -! -! Get polarisation type -! Ref: NPLDAT -! -KEYWORD=POL_TYPE - DATA_TYP=C - LENGTH=16 - SWITCH=LOOP,NULL_VALUES,WILD_CARD - CHECKS=ABBREV_OPTIONS - SEARCH=L,P - OPTIONS=POL,MAG - PROMPT="Polarisation representation" - HELP=" -Specify if polarisation (POL) or magnetic field (MAG) should be plotted" -! -! Get ruled range -! Ref: NPLDAT -! -KEYWORD=RULE_RANGE - DATA_TYPE=R - IO=I - NVALUES=2 - SWITCH=LOOP,VECTOR,NULL_VALUE,WILD_CARD - CHECKS=ASCENDING - SEARCH=L,P - PROMPT="Ruled-surface intensity range (W.U.)" - HELP=" -Specify the intensity limits in Westerbork Units for the ruled surface plot. -Values outside the limits will be truncated." -! -! Specify annotation type -! Ref: NPLDAT -! -KEYWORD=COORD - DATA_TYP=C - IO=I - LENGTH=24 - SWITCH=LOOP,NULL_VALUE,WILD_CARD - CHECKS=ABBREV_OPTIONS - SEARCH=L,P - OPTIONS=|- - NONE; LM, DEGREE, RADEC; DLM, DDEGREE, DRADEC;|- -ONONE; OLM, ODEGREE,ORADEC; ODLM, ODDEGREE,ODRADEC - DEFAULT=NONE /ASK - PROMPT="Axis annotation style" - HELP=" -Select ONE style of axis annotations: -. - NONE no annotation (only pixel coordinates) -. - Relative quasi-Cartesian coordinates: -. - LM l, m in arcsec with respect to map centre - (or annotation for UV-plane plots) - DLM l, m in arcsec with respect to centre of plot - (or annotation for UV-plane plots) -. - Equatorial coordinates: -. - DEGREE right ascension and declination in decimal degrees - RADEC right ascension (hhmmss) and declination (ddmmss) - DDEGREE relative right ascension and declination in decimal degrees - w.r.t. centre of plot - DRADEC relative right ascension (hhmmss) and declination (ddmmss) - w.r.t. centre of plot -. -These annotations will be printed along the left and bottom sides of the plot. -. -By default, (l,m) pixel-coordinates are shown along the top and right axes side -irrespective of what you select. You may suppress these, by prefixing any of -the above options with an O for 'Only'. -. -Example: - ONONE will suppress all annotations. " -! -! Specify annotation type -! Ref: NPLDAT -! -KEYWORD=COORD_TYPE - DATA_TYP=C - IO=I - LENGTH=24 - SWITCH=LOOP,NULL_VALUE,WILD_CARD - CHECKS=ABBREV_OPTIONS - SEARCH=L,P - OPTIONS=TICK,DOTTED,FULL - DEFAULT=TICK /ASK - PROMPT="Coordinate grid style" - HELP=" -Select the style for plotting coordinate grid lines: -. - TICK give along plot edges only - DOTTED dotted grid - FULL full-drawn grid " -! -! Specify source plotting -! Ref: NPLDAT -! -KEYWORD=PLOT_POSITIONS - DATA_TYP=C - IO=I - LENGTH=24 - SWITCH=LOOP,NULL_VALUE,WILD_CARD - CHECKS=ABBREV_OPTIONS - SEARCH=L,P - OPTIONS=NO,YES,NAMES; EDIT - DEFAULT=NO /ASK - PROMPT="Mark source positions" - HELP=" -Specify if you want model-source positions marked in your plot. The answers may -be: -. - NO - YES position markers only - MAMES position markers annotated with their IDs from the model list -. -The marker symbol used is determined per source by its Type (which is the -suffix number in its ID). -. - EDIT invoke model-handling code to modify model-components' Types, - (FEDIT option), then return to this prompt. This path also - allows you to define additional annotations. -!\whichref{NMODEL HANDLE/EDIT}{nmodel_public_keys.} -!\whichref{parameter SOURCES}{} -!\whichref{parameter TEXT}{} -" -! -! Specify source plotting -! Ref: NPLDAT -! -KEYWORD=SOURCES - DATA_TYP=C - IO=I - LENGTH=10 - NVALUES=2 - SWITCH=LOOP,VECTOR,NULL_VALUE,WILD_CARD - SEARCH=L,P - DEFAULT=* /ASK - PROMPT="Source pair for annotation" - HELP=" -Give the names of two sources that you have selected for plotting. A connecting -line will be drawn between them. You will be prompted for an annotation, which -defaults to the separation in degrees." -! -! Specify source plotting -! Ref: NPLDAT -! -KEYWORD=TEXT - DATA_TYP=C - IO=I - LENGTH=80 - SWITCH=LOOP,NULL_VALUE,WILD_CARD - SEARCH=L,P - DEFAULT=* /ASK - PROMPT="Annotation for source pair" - HELP=" -The annotation (max 80 characters) for the source pair just selected" -! -! Specify heading plotting -! Ref: NPLDAT -! -KEYWORD=PLOT_HEADING - DATA_TYP=C - IO=I - LENGTH=24 - SWITCH=LOOP,NULL_VALUE,WILD_CARD - CHECKS=ABBREV_OPTIONS - SEARCH=L,P - OPTIONS=YES,NO - DEFAULT=YES /NOASK - PROMPT="Plot heading (Yes/No) ?" - HELP=" -Specify if you want to have a MAP plot with or without the heading." -! -! Specify precision for coordinate steps -! Ref: NPLDAT -! -KEYWORD=COORD_PREC - DATA_TYP=J - IO=I - SWITCH=LOOP,NULL_VALUE,WILD_CARD - CHECKS=MAXIMUM,MINIMUM - MAXIMUM=32768 - MINIMUM=8 - DEFAULT=256 /NOASK - SEARCH=L,P - PROMPT="Number of steps for coordinate contouring near pole" - HELP=" -Specify the number of steps across the map to use in defining the -coordinate grid for contouring of coordinates near the pole." -!- -INCLUDE=NGEN_PEF -!- -INCLUDE=SCNNODE_PEF ! -INCLUDE=SCNSETS_PEF ! -INCLUDE=SELECT_PEF -!- -INCLUDE=WMPNODE_PEF ! -INCLUDE=WMPSETS_PEF -!- -INCLUDE=MDLNODE_PEF ! -INCLUDE=NMODEL_PEF -!- diff --git a/src/nplot/nplpbe.for b/src/nplot/nplpbe.for deleted file mode 100644 index b91689bca4e9dcc3c7e555b6adf2982cb36f5243..0000000000000000000000000000000000000000 --- a/src/nplot/nplpbe.for +++ /dev/null @@ -1,227 +0,0 @@ -C+ NPLPBE.FOR -C HjV 931112 -C Combined parts of old version of NPLTEL and NPLRES -C -C Revisions: -C HjV 940602 Add some more text when more than one plot per page -C CMV 940705 Change AXINT to REAL (for 256 channels, 2x2 page) -C CMV 940822 Option to abort during loop of plots -C JPH 961118 Grid: dotted lines connecting HA ticks and tel/ifr ticks -C JPH 961212 Make PLUVO telesc. annotation same as other (was -C illegibly small) -C JPH 970124 Remove NPLCLO, in order that raster can be drawn through -C end-annotation call before data plotting. -C -C - SUBROUTINE NPLPBE (BEGIN,NPLOT,PTXT,NHV,NHACH) -C -C Plot polyline and IFR/TEL line at begin and end of plot -C -C Result: -C -C CALL NPLPBE Plot polyline and IFR/TEL line at begin -C and end of plot -C -C Include files: -C - INCLUDE 'WNG_DEF' - INCLUDE 'NPL_DEF' -C -C Parameters: -C -C -C Arguments: -C - LOGICAL BEGIN !BEGIN (TRUE) OR END (FALSE) OF PLOT - INTEGER NPLOT !# OF INTERFEROMETERS TO DO - INTEGER PTXT(MXNCHN) !CROSS CHANNELS - INTEGER NHV(0:1) !# OF PAGES - INTEGER NHACH !# OF HA OR CHANNELS -C -C Function references: -C - LOGICAL NSCSTL !GET A SET - INTEGER WNMEJC !CEIL - INTEGER WNMEJF !FLOOR -C -C Data declarations: -C - REAL UP1(2) !DIRECTIONS - DATA UP1/1.,0./ - REAL UP0(2) - DATA UP0/0.,1./ - INTEGER START,END - REAL YOFF, YOFF0 !Y OFFSET - REAL AXINT !AXIS INTERVAL FOR BAND-OPTION -C- - IF (BEGIN) THEN - R0=(TAREA(2)-TAREA(0)-80./PPP(1))/(NPLOT+1) !IFR/TEL SPACING IN MM - DO I1=0,NPLOT-1 - IFOFF(I1)=NINT(TAREA(0)+40./PPP(1)+((I1+1)*R0)) !OFFSETS IFR/TEL - NEW(I1)=1E20 - OLD(I1)=NEW(I1) - END DO - START=0 - END=1 - IF (PLUVO) THEN - YOFF=PAREA(3) - ELSE - YOFF=PAREA(3)-YFAC*3./PPP(2) - END IF - YOFF0=YOFF - ELSE! end - START=1 - END=2 - IF (IFR_MODE.EQ.'BAND') THEN - YOFF=PAREA(1)+YFAC*(11./PPP(2)) - ELSE - YOFF=PAREA(3)-YFAC*(19./PPP(2)+360.*(HARA(1)-HARA(0))/HASC) - END IF - END IF! begin/end -C -C - 10 IF (MOD(START,2).EQ.0) THEN ! PLOT IFR/TEL TEXT -CC IF (PLUVO) THEN -CC CALL WQSTXH(TXTHGT*2./3./PPP(2)) !SMALLER -CC CALL WQSTXU(UP1) !CHANGE DIRECTION -CC ELSE - CALL WQSTXH(TXTHGT/PPP(2)) !SMALLER -CC END IF - TXTXY(2)=YOFF - DO I=0,NPLOT-1 ! all tel. or ifr - IF (PLUVO) THEN - CALL WNCTXS(TEXT,'!4$UJ',PTXT(I+1)) - TXTXY(1)=IFOFF(I)-TXTHGT/3./PPP(1) !PLOT IFR FIRST LINE - ELSE - TEXT=TXT(1)(I+1:I+1) - TXTXY(1)=IFOFF(I)-TXTHGT/(18./7.)/PPP(1) !PLOT TEL FIRST LINE - END IF - CALL WQTEXT(TXTXY,TEXT) !TEXT - END DO - IF (PLUVO) THEN - YOFF=YOFF-YFAC*6./PPP(2) - ELSE - YOFF=YOFF-YFAC*3./PPP(2) - ENDIF - TXTXY(2)=YOFF - IF (OPT.NE.'TEL') THEN - IF (.NOT.PLUVO) THEN - DO I=0,NPLOT-1 - TEXT=TXT(2)(I+1:I+1) - TXTXY(1)=IFOFF(I)-TXTHGT/(18./7.)/PPP(1)!PLOT IFR 2ND LINE - CALL WQTEXT(TXTXY,TEXT) !TEXT - END DO - END IF - END IF - YOFF=YOFF-YFAC - CALL WQSTXH(TXTHGT) !TEXT HEIGHT STANDARD - CALL WQSTXU(UP0) !STANDARD DIRECTION -C -C PLOT tickmarks and vertical raster lines -C - ELSE! end - POINXY(2,2)=YOFF-YFAC*4./PPP(2) - DO I=0,NPLOT-1 - POINXY(2,1)=YOFF - POINXY(1,1)=IFOFF(I) - POINXY(1,2)=IFOFF(I) - CALL WQPOLL(2,POINXY) ! tick mark - IF (.NOT.BEGIN) THEN - POINXY(2,1)=YOFF0 - CALL WQSPLI(3) ! dotted - CALL WQPOLL(2,POINXY) ! line - CALL WQSPLI(1) ! reset full-line - ENDIF - END DO - YOFF=YOFF-YFAC*7./PPP(2) - ENDIF - START=START+1 - IF (START.LE.END) GOTO 10 -C -C HA/CHANNEL ANNOTATION -C - IF (BEGIN) THEN !PLOT HA/CHAN ANNOTATION - CALL WQSTXH(TXTHGT/PPP(2)) !TEXT HEIGHT STANDARD - IF (IFR_MODE.EQ.'BAND') THEN - IF (NHACH.EQ.1) THEN - AXINT=(PAREA(3)-PAREA(1)-YFAC*2*(15./REAL(PPP(2)))) - ELSE - AXINT=(PAREA(3)-PAREA(1)-YFAC*2*(15./REAL(PPP(2)))) - 1 /REAL(NHACH-1) - END IF - J1=1 - DO WHILE ((AXINT*J1).LT.15) - J1=J1*2 - END DO - DO I0=0,NHACH-1,J1 - CALL WNCTXS (TEXT,'!4$UJ',PTXT(I0+1)) !CHANNEL NAME - TXTXY(1)=TAREA(0) - TXTXY(2)=PAREA(3)-(15./PPP(2)*YFAC+(I0*AXINT))- - 1 TXTHGT/(18./7.)/PPP(1) - CALL WQTEXT(TXTXY,TEXT) - POINXY(1,1)=TAREA(0)+35./PPP(1) !PLOT 0.25 CM. LINE (X) - POINXY(2,1)=PAREA(3)-(15./PPP(2)*YFAC+(I0*AXINT)) - POINXY(1,2)=TAREA(0)+45./PPP(1) - POINXY(2,2)=POINXY(2,1) - CALL WQPOLL(2,POINXY) !POLYLINE - POINXY(1,1)=PAREA(2)-11./PPP(1) !PLOT 0.25 CM. LINE (X) - POINXY(1,2)=PAREA(2)-1./PPP(1) - CALL WQPOLL(2,POINXY) !POLYLINE - END DO - ELSE - R0=10.*HASC !DEGREE PER CM - IF (R0.LE.1.) THEN - I=1 - ELSE IF (R0.LE.2.) THEN - I=2 - ELSE IF (R0.LE.5.) THEN - I=5 - ELSE IF (R0.LE.10.) THEN - I=10 - ELSE IF (R0.LE.15.) THEN - I=15 - ELSE IF (R0.LE.30.) THEN - I=30 - ELSE IF (R0.LE.45.) THEN - I=45 - ELSE - I=90 - END IF - DO R1=WNMEJC(360.*HARA(0)/FLOAT(I))*FLOAT(I), - 1 WNMEJF(360.*HARA(1)/FLOAT(I))*FLOAT(I),! DRAW HA MARKS - 1 FLOAT(I) - CALL WNCTXS(TEXT,'!4$SJ',NINT(R1)) - TXTXY(1)=TAREA(0) - TXTXY(2)=PAREA(3)-(15./PPP(2)+(R1-360.*HARA(0))/ - 1 HASC)*YFAC-TXTHGT/(18./7.)/PPP(1) - CALL WQTEXT(TXTXY,TEXT(1:4)) - POINXY(1,1)=TAREA(0)+35./PPP(1) ! PLOT 0.25 CM. LINE (X) - POINXY(2,1)=PAREA(3)-(15./PPP(2)+(R1-360.*HARA(0))/ - 1 HASC)*YFAC - POINXY(1,2)=TAREA(0)+45./PPP(1) - POINXY(2,2)=POINXY(2,1) - CALL WQPOLL(2,POINXY) ! POLYLINE - POINXY(1,1)=PAREA(2)-11./PPP(1) ! PLOT 0.25 CM. LINE (X) - POINXY(1,2)=PAREA(2)-1./PPP(1) - CALL WQPOLL(2,POINXY) ! POLYLINE - POINXY(1,2)=TAREA(0)+45./PPP(1) - CALL WQSPLI(3) ! DOTTED - CALL WQPOLL(2,POINXY) - CALL WQSPLI(1) ! DRAWN - END DO - END IF - CALL WQSTXH(TXTHGT) !TEXT HEIGHT STANDARD -C -C CLOSE -C - ELSE! end - CALL WQSTXH(TXTHGT) !TEXT HEIGHT STANDARD - CALL WQSTXU(UP0) !STANDARD DIRECTION -cc IF ((PPP(1).EQ.1).AND.(PPP(2).EQ.1)) THEN -cc CALL NPLCLO(DQID,NHV) !CLOSE PLOT -cc END IF - ENDIF -C -C - END - diff --git a/src/nplot/nplplt.for b/src/nplot/nplplt.for deleted file mode 100644 index e8accddf8eb1fdf1cc9ea610009649ae6d06290a..0000000000000000000000000000000000000000 --- a/src/nplot/nplplt.for +++ /dev/null @@ -1,230 +0,0 @@ -C+ NPLPLT.FOR -C HjV 940119 -C Combined parts of NPLRES and NPLTEL -C -C Revisions: -C HjV 940224 Add mosaik test -C HjV 940324 Better check for MOSAIK with BANDPASS -C HjV 940413 Changed check for opening plot -C CMV 940822 Option to abort during loop of plots -C HjV 960415 Correct option to stop during loop or more plots per -C page -C JPH 960621 Control-C interrupt -C JPH 960730 Recognise PGAIN data type -C JPH 960802 No connection lines is SEQ mode -C HJV 970123 I1 --> AXINT -C HjV 970723 Remove control-C stuff (commented out with CCC) -C AXC 010709 Linux port - .NE.0 changed -C -C - SUBROUTINE NPLPLT (LDATTP,IPOL,NPLOT,PTXT,NHV,TABIFR,SCHAN, - 1 IFRS,NHACH,NIFRTEL,HAB,HAI,PLTIFR,IFRA,AMCO) -C -C Plot residual/telescope errors of individual scans -CCC Interruption by control-C: single = next plot, double = exit routine -C -C Result: -C -C CALL NPLPLT Plot residual/telescope errors -C -C Include files: -C - INCLUDE 'WNG_DEF' - INCLUDE 'STH_O_DEF' !SET HEADER - INCLUDE 'NPL_DEF' -C -C Parameters: -C - INTEGER LDATTP !CURRENT DATA TYPE - INTEGER IPOL - INTEGER NPLOT !# OF INTERFEROMETERS TO DO - INTEGER PTXT(MXNCHN) !CROSS CHANNELS - INTEGER NHV(0:1) !# OF PAGES - INTEGER TABIFR(0:STHTEL-1,0:STHTEL-1) !IFR PLOT POINTERS - INTEGER SCHAN(0:MXNCHN-1) !CHANNELS TO DO - INTEGER IFRS(0:1) !CURRENT IFR'S - INTEGER NHACH !# OF HARA OR CHANNELS - INTEGER NIFRTEL !# OF ALL INTERF. OR TELESC. - REAL HAB !HA BEGIN - REAL HAI !HA INCR. - LOGICAL PLTIFR(0:STHIFR-1) !.TRUE.= PLOT THIS INTERFEROMETER - INTEGER IFRA(0:1,0:STHIFR-1) - REAL AMCO(2,0:STHIFR-1,0:MXNCHN-1) !DATA values per interf. per HA/CHAN -C -C Arguments: -C -C -C Function references: -C -CCC INTEGER WNGCCN ! check for control-C -C -C Data declarations: -C - REAL LHA !LOCAL HA - REAL MINMAX(2,2) !MIN./MAX. AMPL/COS AND PHASE/SIN - REAL LENMM - REAL CPO !CURRENT POINT OFFSET - REAL HPO !HALF POINT OFFSET - REAL AXINT ! -C- -C -C PLOT PER IFR -C - IF (PLOTAP) THEN - I5=0 - DO I1=0,NIFRTEL-1 !ALL IFRS/TELS - IF (((OPT.EQ.'TEL').AND. - 1 ((.NOT.PLUVO .AND. STELS(I1).NE.0) .OR. - 1 (PLUVO .AND. I1.EQ.IFRS(0)))) .OR. - 1 ((OPT.NE.'TEL').AND.(PLTIFR(I1)))) THEN !PLOT THIS ONE - IF (PLUVO) THEN - I4=SCHAN(SETNAM(3)) !PLOT POINTER - ELSE - IF (OPT.EQ.'TEL') THEN - I4=I5 - ELSE - I4=TABIFR(IFRA(0,I1),IFRA(1,I1)) !PLOT POINTER - END IF - END IF - IF (OPT.EQ.'TEL') THEN - TXT(1)(1:1)=TELNAM(I1+1:I1+1) - TXT(2)(1:1)=' ' - ELSE - TXT(1)(1:1)=TELNAM(IFRA(0,I1)+1:IFRA(0,I1)+1) - TXT(2)(1:1)=TELNAM(IFRA(1,I1)+1:IFRA(1,I1)+1) - END IF - CALL NPLOPN (LDATTP,IPOL,NHV,IFRS) !OPEN PLOT, PLOT HEADING - IF (NO_MORE) RETURN !USER SAID: STOP -C -C DETERMINE MIN/MAX - MINMAX(1,1)=100000. !MIN AMPL OR COS - MINMAX(2,1)=-100000. !MAX AMPL OR COS - MINMAX(1,2)=100000. !MIN PHASE OR SIN - MINMAX(2,2)=-100000. !MAX PHASE OR SIN - DO I2=0,NHACH-1 !ALL SCANS/CHANNELS - IF (AMCO(1,I4,I2).NE.1E20) THEN - IF (AMCO(1,I4,I2).LT.MINMAX(1,1)) MINMAX(1,1)=AMCO(1,I4,I2) - IF (AMCO(1,I4,I2).GT.MINMAX(2,1)) MINMAX(2,1)=AMCO(1,I4,I2) - END IF - IF (AMCO(2,I4,I2).NE.1E20) THEN - IF (AMCO(2,I4,I2).LT.MINMAX(1,2)) MINMAX(1,2)=AMCO(2,I4,I2) - IF (AMCO(2,I4,I2).GT.MINMAX(2,2)) MINMAX(2,2)=AMCO(2,I4,I2) - END IF - END DO !NEXT SCAN - CALL NPLBAP(LDATTP,IPOL,PTXT,NHV,MINMAX,NHACH) !PLOT BOX - DO I3=1,2 ! LOOP AMPL/COS OR - ! PHASE/SIN - LENMM=MINMAX(2,I3)-MINMAX(1,I3) !MAX-MIN - OLD(0)=1E20 - DO I2=0,NHACH-1 !ALL SCANS/CHANNELS - NEW(I2)=AMCO(I3,I4,I2) - OLD(I2+1)=NEW(I2) - END DO !NEXT SCAN/CHAN - LHA=HAB-HAI*2. - CALL NPLTWO (I3,NHACH,LENMM,MINMAX,HAI,LHA) !PLOT DATA - END DO !NEXT I3 - IF ((PPP(1).EQ.1).AND.(PPP(2).EQ.1)) THEN - CALL NPLCLO(DQID,NHV) - IF (NO_MORE) RETURN !USER SAID: STOP - END IF - I5=I5+1 - END IF -CCC IF (WNGCCN().NE.0) THEN ! control-C seen? -CCC CALL WNGSLP(1) ! allow for another one -CCC GOTO 50 -CCC ENDIF - END DO !NEXT IFR -CCC 50 CONTINUE -C -C Normal plot -C - ELSE - DO I1=0,NPLOT-1 !SET OLD - NEW(I1)=1E20 - OLD(I1)=1E20 - END DO - IF (MOSAIK.AND.(IFR_MODE.EQ.'BAND')) THEN - CALL NPLOPN (LDATTP,IPOL,NHV,IFRS) !OPEN, PLOT HEADING - IF (NO_MORE) RETURN !USER SAID: STOP - CALL NPLPBE (.TRUE.,NPLOT,PTXT,NHV,NHACH) !PLOT BEGIN-ANNOTATIONS - END IF - IF ((DATTYP(LDATTP)(1:2).EQ.'AM').OR. - 1 (DATTYP(LDATTP)(1:2).EQ.'CO')) THEN !AMPL. OR COS - I3=1 - ELSE - I3=2 - END IF - IF (DATTYP(LDATTP)(1:1).EQ.'P') THEN - R1=SCAL(2) - ELSE - R1=SCAL(1) - ENDIF - DO I0=0,NHACH-1 !ALL SCANS/CHAN - I5=0 - DO I1=0,NIFRTEL-1 !ALL IFRS/TELS - IF (((OPT.EQ.'TEL').AND. - 1 ((.NOT.PLUVO .AND. STELS(I1).NE.0) .OR. - 1 (PLUVO .AND. I1.EQ.IFRS(0)))) .OR. - 1 ((OPT.NE.'TEL').AND.(PLTIFR(I1)))) THEN !PLOT THIS ONE - IF (PLUVO) THEN - I4=SCHAN(SETNAM(3)) !PLOT POINTER - ELSE - IF (OPT.EQ.'TEL') THEN - I4=I5 - ELSE - I4=TABIFR(IFRA(0,I1),IFRA(1,I1)) !PLOT POINTER - END IF - END IF - OLD(I4)=NEW(I4) - IF (AMCO(I3,I4,I0).EQ.1E20) THEN - NEW(I4)=AMCO(I3,I4,I0) - ELSE - NEW(I4)=IFOFF(I4)+AMCO(I3,I4,I0)/R1*XFAC - END IF - I5=I5+1 - END IF - END DO !NEXT IFR/TELS - IF (IFR_MODE.EQ.'BAND') THEN - IF (NHACH.EQ.1) THEN - AXINT=PAREA(3)-PAREA(1)-YFAC*2*(15./PPP(2)) - ELSE - AXINT=(PAREA(3)-PAREA(1)-YFAC*2*(15./PPP(2)))/(NHACH-1) - END IF - CPO=PAREA(3)-YFAC*(15./PPP(2))-(I0*AXINT) - ! CURRENT POINT OFFSET - IF ((I0.GT.0).AND.(I0.LT.NHACH)) THEN - HPO=AXINT/2 - ELSE - HPO=0. - END IF - ELSE - LHA=HAB+I0*HAI ! HA - CPO=PAREA(3)-YFAC*(15./PPP(2)+360.*(LHA-HARA(0))/HASC) - ! CURRENT POINT OFFSET - HPO=180.*YFAC*HAI/HASC ! HALF POINT OFFSET - END IF - IF ( (.NOT.MOSAIK) .AND. I0.EQ.0 .AND. ST_MODE.GE.0 ) - 1 CALL NPLCON (NPLOT,CPO,HPO,.TRUE.) !FIRST SCAN - CALL NPLONE (NPLOT,CPO,HPO) -CCC IF (WNGCCN().NE.0) THEN ! control-C seen? -CCC CALL WNGSLP(1) ! yes: allow time -CCC ! for another one -CCC GOTO 100 -CCC ENDIF - END DO ! scans -CCC 100 CONTINUE - IF (IFR_MODE.EQ.'BAND') HPO=0. - IF (.NOT.MOSAIK .AND. ST_MODE.GE.0) - 1 CALL NPLCON (NPLOT,CPO,HPO,.FALSE.) ! connection lines - IF (MOSAIK.AND.(IFR_MODE.EQ.'BAND')) THEN - CALL NPLPBE (.FALSE.,NPLOT,PTXT,NHV,NHACH) ! END-ANNOTATIONS - IF ((PPP(1).EQ.1).AND.(PPP(2).EQ.1)) THEN - CALL NPLCLO(DQID,NHV) !CLOSE PLOT - END IF - END IF - END IF ! plotap -C - RETURN -C - END - diff --git a/src/nplot/nplres.for b/src/nplot/nplres.for deleted file mode 100644 index 0701ee4579e1ce50c89a322b360c18d4d75a5b69..0000000000000000000000000000000000000000 --- a/src/nplot/nplres.for +++ /dev/null @@ -1,591 +0,0 @@ -C+ NPLRES.FOR -C WNB 910618 -C -C Revisions: -C WNB 911025 Change ampl/phase residuals -C WNB 911217 Change to WQ -C WNB 920130 Multipage change -C WNB 920403 Rearrange pol. test -C WNB 920811 Change R+A+O text (Unix problem) -C WNB 920831 Add PLUVO -C WNB 920902 Typo in weight check -C WNB 921104 Cater for large HA -C HjV 930311 Change some text -C WNB 930608 New flags -C HJV 930618 Symbolic names for mask bits in CBITS_O_DEF -C HjV 930722 Add IFR_MODE (sort baselines) -C WNB 930803 CBITS_DEF -C WNB 930825 Add dipole positions; polarisation codes -C WNB 930826 New model calculation; redundant baselines -C WNB 931008 Add MINST -C HjV 940112 Removed some parts to new subroutines, -C Add 'PLOTAP' plots, more plots per page -C HjV 940224 Add mosaik test, add filling of FNAM and OBSYD -C HjV 940324 Better check for MOSAIK with BANDPASS -C HjV 940413 Changed check for opening plot -C HjV 940506 Changed place for opening plot -C CMV 940822 Option to abort during loop of plots -C HjV 950503 Plot all PHASE residuals in W.U. -C HjV 950522 Set PLTIFR to false for every set -C JPH 960411 ST_MODE: plotting versus ST i.s.o. HA -C HjV 960415 Correct option to stop during loop or more plots per -C page -C JPH 960619 ST_MODE integer, copy to ST_INIT. - Report progress -C JPH 960622 Acknowledge control-C -C JPH 960726 SETNAM in NPLSST call. -C Check CC after each scan -C Comments -C JPH 960730 AGAIN, PGAIN data types -C JPH 860805 ST_INIT in COMMON. Convert loop-index variable names -C JPH 960806 Fix an index variable -C JPH 960814 Use I i.s.o. ICS for WNGCCN argument -C JPH 970124 Call NPLPBE(.FALSE.,...) immediately after -C NPLPBE(.TRUE.,...) to draw raster first -C HjV 970723 Add PLUVO-check in HA-integration part. -C Remove control-C stuff (commented out with CCC) -C -C - SUBROUTINE NPLRES (LDATTP,IPOL,NPLOT,PTXT,NHV,TABIFR,SCHAN,IFRS) -C -C Fill buffers for plotting residual errors of individual scans -C -C Result: -C -C CALL NPLRES Fill buffers for plotting residual errors -C -C Include files: -C - INCLUDE 'WNG_DEF' - INCLUDE 'CBITS_DEF' - INCLUDE 'STH_O_DEF' ! SET HEADER - INCLUDE 'SCH_O_DEF' ! SCAN HEADER - INCLUDE 'NPL_DEF' -C -C Parameters: -C - INTEGER LDATTP ! CURRENT DATA TYPE - INTEGER IPOL - INTEGER NPLOT ! # OF INTERFEROMETERS TO DO - INTEGER PTXT(MXNCHN) ! CROSS CHANNELS - INTEGER NHV(0:1) ! # OF PAGES - INTEGER TABIFR(0:STHTEL-1,0:STHTEL-1) ! IFR PLOT POINTERS - INTEGER SCHAN(0:MXNCHN-1) ! CHANNELS TO DO - INTEGER IFRS(0:1) ! CURRENT IFR'S' -C -C Arguments: -C -C -C Function references: -C - LOGICAL NSCSIF ! READ IFR TABLE - LOGICAL NSCSTL ! GET A SET - LOGICAL NSCSCR ! READ SCAN DATA - LOGICAL NSCSCI ! READ SCAN CORRECTIONS - LOGICAL NMORDH ! READ MODEL HEADER - CHARACTER*32 WNTTSG ! character sector name -CCC INTEGER WNGCCN ! check control-C interrupts - REAL WNGENR ! convert angle -C -C Data declarations: -C - LOGICAL OPENSW ! PLOT OPEN OR CLOSED - INTEGER NCHAN ! # CHANNELS TO DO - INTEGER UFL ! FLAGS TO DISCARD - INTEGER*2 IFRT(0:STHIFR-1) ! IFR TABLE - INTEGER IFRA(0:1,0:STHIFR-1) - REAL ANG(0:2,0:STHIFR-1) - REAL BASEL(0:STHIFR-1) ! BASELINES - REAL HAB ! loc. copy of HAB or ST - INTEGER BTEL(0:1,0:STHIFR-1) ! TEL. TO PLOT - INTEGER IRED(0:STHIFR-1) ! REDUNDANT INDICATORS - REAL WGT(0:STHIFR-1,0:3) ! DATA WEIGHT - REAL DAT(0:1,0:STHIFR-1,0:3) ! DATA - COMPLEX CDAT(0:STHIFR-1,0:3) - EQUIVALENCE (DAT,CDAT) - INTEGER STP ! SOURCE TYPE - DOUBLE PRECISION SRA,SDEC,SFRQ ! MODEL INFO - REAL UV0(0:3) ! BASIC UV COORDINATES - REAL LM0(0:1) ! BASIC SOURCE DISPLACEMENT - DOUBLE PRECISION FRQ0 ! BASIC FREQUENCY - REAL TF(0:1) ! INTEGR. TIME, BANDWIDTH - INTEGER MINST ! INSTRUMENT - COMPLEX CMOD(0:3,0:STHIFR-1) ! SOURCE MODEL I,Q,U,V - COMPLEX CAMOD(0:STHIFR-1,0:3) ! XYX SOURCE MODEL - REAL MWGT(0:STHIFR-1) ! CELESTIAL WEIGHTS - REAL LHA ! LOCAL HA - REAL PHASE ! PHASE CORRECTION - REAL AMPL ! AMPLITUDE CORRECTION - REAL VAL(0:1) - COMPLEX CVAL - EQUIVALENCE (CVAL,VAL) - EQUIVALENCE (AMPL,VAL(0)) - EQUIVALENCE (PHASE,VAL(1)) - COMPLEX CRES ! DATA MODEL - REAL RRES(0:1) - EQUIVALENCE (CRES,RRES) - INTEGER NPOL ! # OF POLAR. - INTEGER NTINT ! # of scans to integrate - INTEGER STHP ! SET HEADER POINTER - BYTE STH(0:STH__L-1) ! SET HEADER - INTEGER*2 STHI(0:STH__L/LB_I-1) - INTEGER STHJ(0:STH__L/LB_J-1) - REAL STHE(0:STH__L/LB_E-1) - DOUBLE PRECISION STHD(0:STH__L/LB_D-1) - EQUIVALENCE (STH,STHI,STHJ,STHE,STHD) - BYTE SCH(0:SCH__L-1) ! SCAN HEADER - INTEGER*2 SCHI(0:SCH__L/LB_I-1) - INTEGER SCHJ(0:SCH__L/LB_J-1) - REAL SCHE(0:SCH__L/LB_E-1) - DOUBLE PRECISION SCHD(0:SCH__L/LB_D-1) - EQUIVALENCE (SCH,SCHI,SCHJ,SCHE,SCHD) - REAL AMCO(2,0:STHIFR-1,0:MXNCHN-1) ! DATA VALUES PER INTERF. PER HA - INTEGER NRAMCO(0:STHIFR-1,0:MXNCHN-1) ! # OF POINTS IN AMCO FOR - ! BAND OPTION - REAL TMPVAL(2) ! TEMP. A/P OR C/S - LOGICAL PLTIFR(0:STHIFR-1) ! .TRUE.= PLOT THIS IFR - INTEGER CSET(0:7,0:1) ! TEST SET NAMES - LOGICAL REPORT ! 'new plot' flag - INTEGER ICH, ICS, IFR, ISCN,ISCN0,ISCN1 ! loop indices - INTEGER N ! integration counter - REAL SUM ! accumulator - INTEGER PLTPTR, REDPTR ! data pointers -C- -C - CALL WNDDUF(UFL) ! GET UNFLAG DATA - UFL=IAND(FL_ALL,NOT(UFL)) ! SELECTOR -C -C INIT PLOT -C - ST_INIT=ST_MODE - NCHAN=0 - CSET(0,0)=-1 - CSET(0,1)=-1 - OPENSW=.FALSE. - IF (IFR_MODE.EQ.'BAND') THEN -!= I1=ICH I2=IFR - DO ICH=0,MXNCHN-1 - ! CLEAR - DO IFR=0,STHIFR-1 - AMCO(1,IFR,ICH)=1E20 - AMCO(2,IFR,ICH)=1E20 - END DO - END DO - END IF -!= -C -C PLOT SETS -C - REPORT=.TRUE. - DO WHILE(NSCSTL(FCAIN,SETS,STH(0),STHP,SETNAM,LPOFF)) - ! NEXT SET - CALL WNDSTI(FCAIN,SETNAM) ! PROPER NAME - IF (REPORT) CALL WNCTXT(F_T,'Next plot, first sector: !AS', - 1 WNTTSG(SETNAM,0) ) - REPORT=.FALSE. - CALL WNGMTS(STH_FIELD_N,STH(STH_FIELD_1),FNAM) - ! SET FIELD NAME - IF (ST_MODE.NE.0) THEN - CALL NPLSST(STHD,STHE(STH_HAB_E),SETNAM,HAB) - ELSE - HAB=STHE(STH_HAB_E) - ENDIF - OBSDY(1)=STHI(STH_OBS_I) ! OBS. DAY - OBSDY(2)=STHI(STH_OBS_I+1) ! OBS. YEAR -!= I2=IFR - DO IFR=0,STHIFR-1 - PLTIFR(IFR)=.FALSE. - END DO -C -C GET IFR TABLES/MODEL -C - IF (.NOT.NSCSIF(FCAIN,STH,IFRT,IFRA,ANG)) THEN - ! READ IFR TABLE - CALL WNCTXT(F_TP,'Read error IFR table') - GOTO 51 - END IF - NPOL=STHI(STH_PLN_I) ! # OF POL. - IF (NSRC(0).GT.0) THEN ! MODEL WANTED - IF (.NOT.NMORDH - 1 (6,STP,SRA,SDEC,SFRQ)) GOTO 51 ! NEXT SET - CALL NMOMST - 1 (STP,SRA,SDEC,STH,LM0,FRQ0,TF,MINST) - ! GET SOME DATA - ELSE IF (OPT.EQ.'RES'.AND.NSRC(0).EQ.0) THEN - ! REDUNDANT DATA - CALL NSCMBL(STHE(STH_RTP_E), - 1 STHJ(STH_NIFR_J),IFRT,SIFRS,BASEL) - ! MAKE BASELINES - CALL NCARRT - 1 (STHJ(STH_NIFR_J),BASEL,1E0,IRED,ANG) - ! GET REDUNDANT - END IF -C -C DO ALL SCANS -C - IF (IFR_MODE.NE.'BAND') THEN - NCHAN=NCHAN+1 -!= I1=ICH I2=IFR - DO ICH=0,MXNCHN-1 ! CLEAR - DO IFR=0,STHIFR-1 - AMCO(1,IFR,ICH)=1E20 - AMCO(2,IFR,ICH)=1E20 - END DO - END DO -!= I2=IFR - ELSE! ifr_mode=band - IF (MOSAIK) THEN - IF (CSET(0,0).EQ.-1) THEN - DO I1=0,7 - CSET(I1,0)=SETNAM(I1) - END DO - END IF - IF (CSET(0,1).EQ.-1) THEN - NCHAN=NCHAN+1 - DO IFR=0,STHIFR-1 - NRAMCO(IFR,NCHAN-1)=0 - END DO - ELSE - IF ((CSET(0,1).NE.SETNAM(0)).OR. - 1 (CSET(1,1).NE.SETNAM(1)).OR. - 2 (CSET(2,1).NE.SETNAM(2)).OR. - 3 (CSET(3,1).NE.SETNAM(3))) THEN - NCHAN=NCHAN+1 - DO IFR=0,STHIFR-1 - NRAMCO(IFR,NCHAN-1)=0 - END DO - END IF - END IF - DO I1=0,7 - CSET(I1,1)=SETNAM(I1) - END DO - ELSE - NCHAN=NCHAN+1 - DO IFR=0,STHIFR-1 - NRAMCO(IFR,NCHAN-1)=0 - END DO - END IF - END IF - DO ISCN=0,STHJ(STH_SCN_J)-1 - ! ALL SCANS - LHA=HAB+ISCN*STHE(STH_HAI_E) - ! HA - IF (LHA.LT.HARA(0) .OR. LHA.GT.HARA(1)) GOTO 50 - ! NEXT SCAN - IF (OPT.EQ.'INT') THEN ! GET CORRECTIONS - JS=NSCSCI(FCAIN,STH,IFRT,ISCN,CORAP,CORDAP, - 1 SCH,WGT,DAT) ! READ - ELSE ! GET CORRECTED DATA - JS=NSCSCR(FCAIN,STH,IFRT,ISCN,CORAP,CORDAP, - 1 SCH,WGT,DAT) ! READ - END IF - IF (.NOT.JS) THEN ! ERROR - CALL WNCTXT(F_TP,'Error reading scan') - GOTO 50 ! NEXT SCAN - END IF - IF (IAND(SCHJ(SCH_BITS_J),UFL).NE.0) GOTO 50 - ! DELETE SCAN -C -C If model accessed, get it -C - IF (NSRC(0).GT.0) THEN ! GET SOURCE MODEL - CALL NMOMUV(STP,SRA,SDEC,STH,SCH,UV0) - ! GET UV DATA - CALL NMOMU4(0,FCAIN,ISCN,STH,UV0,LM0,FRQ0, - 1 STHE(STH_RTP_E),NPOL,STHJ(STH_NIFR_J), - 1 IFRT,TF,MINST,CMOD) ! GET MODEL DATA - CALL NMOCIX(STHJ,SCHE,ANG,CAMOD,CMOD) - ! XYX in CAMOD -C -C NOTE: In the following, NSCR(0) is used as a flag set by NPLDAT: <= 0 means -C no model required, < 0 means INTERNAL model is used -C -C Redundancy: The averages of redundant interferometer groups are used as -C reference against which the residuals are calculated -C - ELSE IF (OPT.EQ.'RES'.AND.NSRC(0).EQ.0) THEN - ! REDUNDANT - DO I1=0,STHJ(STH_NIFR_J)-1 ! ZERO CELESTIAL DATA - CAMOD(I1,IPOL)=0 ! use CAMOD as buffer - MWGT(I1)=0 - END DO - DO IFR=0,STHJ(STH_NIFR_J)-1 - IF (IRED(IFR).GT.0) THEN ! REDUNDANT - IF (WGT(IFR,IPOL).GT.0) THEN ! CAN USE - REDPTR=IRED(IFR) ! redundancy POINTER - CAMOD(REDPTR,IPOL)=CAMOD(REDPTR,IPOL)+ - 1 WGT(IFR,IPOL)*CDAT(IFR,IPOL) - ! weighted sum - MWGT(REDPTR)=MWGT(REDPTR)+WGT(IFR,IPOL) - END IF - END IF - END DO - DO IFR=0,STHJ(STH_NIFR_J)-1 ! make average - IF (MWGT(IFR).GT.0) CAMOD(IFR,IPOL)= - 1 CAMOD(IFR,IPOL)/MWGT(IFR) - END DO - END IF -C -C CAMOD now contains either the model or the redundancy averages. -C Now we fill the plot buffer -C - DO IFR=0,STHJ(STH_NIFR_J)-1 - IF ((.NOT.PLUVO .AND. - 1 TABIFR(IFRA(0,IFR),IFRA(1,IFR)).GE.0 .AND. - 1 WGT(IFR,IPOL).GT.0) .OR. - 1 (PLUVO .AND. IFRA(0,IFR).EQ.IFRS(0) .AND. - 1 IFRA(1,IFR).EQ.IFRS(1) .AND. - 1 WGT(IFR,IPOL).GT.0)) THEN - PLTIFR(IFR)=.TRUE. ! PLOT THIS ONE - IF (PLUVO) THEN - PLTPTR=SCHAN(SETNAM(3)) ! PLOT POINTER - ELSE - PLTPTR=TABIFR(IFRA(0,IFR),IFRA(1,IFR)) ! PLOT POINTER - END IF -C -C First we copy the visibility to CVAL and the comparison reference to CRES -C - IF (OPT.EQ.'DAT'.OR. OPT.EQ.'INT' .OR. - ! visib., intfr corrns - 1 (OPT.EQ.'RES'.AND.NSRC(0).LT.0)) THEN - ! or internal model - CVAL=CDAT(IFR,IPOL) ! visibility - CRES=0 ! no reference -C - ELSE IF (OPT.EQ.'MOD') THEN - CVAL=CAMOD(IFR,IPOL) ! model visib. - CRES=0 ! no reference -C - ELSE IF (OPT.EQ.'RES') THEN - CVAL=CDAT(IFR,IPOL) ! visibility -C - IF (NSRC(0).GT.0) THEN ! model residual - CRES=CAMOD(IFR,IPOL) ! model visib. -C - ELSE IF (NSRC(0).EQ.0) THEN ! redundancy residual - CRES=CAMOD(IRED(IFR),IPOL) ! average of red. ifrs -C - ELSE ! USED DEAPPLY=MODEL - CRES=0 ! (JPH: ??) - END IF - END IF -C -C CVAL = AMPL + i PHASE contains visibility, CRES the reference -C - IF (OPT.EQ.'RES' .AND. NSRC(0).EQ.0 .AND. - ! skip non-redundant - 1 IRED(IFR).LE.0) THEN ! ifr if redundancy -C - ELSE ! int. or ext. model -C -C Plot-data selection for ampl/phase -C - IF ((DATTYP(LDATTP)(1:2).EQ.'AP').OR. - 1 (DATTYP(LDATTP)(1:1).EQ.'A').OR. - 1 (DATTYP(LDATTP)(1:1).EQ.'P')) THEN - ! ampl and/or phase plot -C -C For all cases, ampl. is the same; phase is defined per case -C - TMPVAL(1)=(ABS(CVAL)-ABS(CRES)) - ! vis. ampl - ref. ampl. -C -C Model residual: phase in WU = model ampl * arg (visib/model) -C - IF (OPT.EQ.'RES'.AND.NSRC(0).GE.0) THEN - IF (DATTYP(LDATTP)(1:2).EQ.'AG' .OR. - ! instr. g/ph. resid. - 1 DATTYP(LDATTP)(1:2).EQ.'PG') THEN - CVAL=LOG(CVAL/CRES) ! visib./model - TMPVAL(1)=100*AMPL ! gain - R0=WNGENR(PHASE)*DEG ! phase - ELSE - R0=ABS(CRES) ! model amplitude - IF (R0.GT.1E-6) THEN - CVAL=CVAL/CRES ! visib./model = - ! complex gain resid - R0=R0*ATAN2(PHASE,AMPL) - ! * model ampl. - ELSE - R0=0 ! model too weak - ENDIF - END IF -C -C Internal-model residual: differential model residual = visib. - model: -C phase in WU = ampl * arg(res) -C - ELSE IF (OPT.EQ.'RES') THEN - R0=ABS(CVAL) ! abs (visib - model) - IF (R0.GT.1E-6) THEN - R0=R0*ATAN2(PHASE,AMPL) ! (JPH: looks dubious) - ELSE - R0=0 - END IF -C -C Measured visibility or edundancy residual -C - ELSE - R0=ABS(CVAL) ! visibility - IF (R0.GT.1E-6) THEN - R0=ATAN2(PHASE,AMPL)*DEG! true phase - ELSE - R0=0 - END IF - END IF -C - TMPVAL(2)=R0 ! PHASE -C -C -C Data selection for cos/sin plots: Always visib - ref -C - ELSE IF ((DATTYP(LDATTP)(1:2).EQ.'CS').OR. - 1 (DATTYP(LDATTP)(1:2).EQ.'CO').OR. - 1 (DATTYP(LDATTP)(1:2).EQ.'SI')) THEN - TMPVAL(1)=REAL(CVAL-CRES) ! visib - reference - TMPVAL(2)=AIMAG(CVAL-CRES) - END IF - IF (IFR_MODE.EQ.'BAND') THEN - NRAMCO(PLTPTR,NCHAN-1)=NRAMCO(PLTPTR,NCHAN-1)+1 - DO ICS=1,2 - IF (AMCO(ICS,PLTPTR,NCHAN-1).EQ.1E20) THEN - AMCO(ICS,PLTPTR,NCHAN-1)=TMPVAL(ICS) - ELSE - AMCO(ICS,PLTPTR,NCHAN-1)= - 1 AMCO(ICS,PLTPTR,NCHAN-1)+TMPVAL(ICS) - ENDIF - END DO - ELSE ! mode#band - AMCO(1,PLTPTR,ISCN)=TMPVAL(1) - AMCO(2,PLTPTR,ISCN)=TMPVAL(2) - ENDIF - END IF - END IF - END DO ! IFR - 50 CONTINUE -CCC I=WNGCCN() ! nr of control-C seen -CCC IF (I.GT.1) NO_MORE=.TRUE. -CCC IF (I.NE.0) GOTO 501 - END DO ! scans -CCC 501 CONTINUE - IF (NO_MORE) RETURN -C -C HA integration -C - IF (IFR_MODE.NE.'BAND') THEN - NTINT=MAX(1, ! scans to integrate - 1 NINT(HAINT/24./3600./STHE(STH_HAI_E))) - DO IFR=0,STHJ(STH_NIFR_J)-1 ! new HA increment - IF (PLUVO) THEN - PLTPTR=SCHAN(SETNAM(3)) ! PLOT POINTER - ELSE - PLTPTR=TABIFR(IFRA(0,IFR),IFRA(1,IFR)) ! PLOT POINTER - END IF - DO ISCN0=0,STHJ(STH_SCN_J)-1,NTINT - ISCN1=MIN(ISCN0+NTINT,STHJ(STH_SCN_J))-1 - DO ICS=1,2 - N=0 - SUM=0 - DO ISCN=ISCN0,ISCN1 - IF (AMCO(ICS,PLTPTR,ISCN).NE.1E20) THEN - SUM=SUM+AMCO(ICS,PLTPTR,ISCN) - N=N+1 - ENDIF - ENDDO - IF (N.NE.0) THEN - SUM=SUM/N - DO ISCN=ISCN0,ISCN1 - AMCO(ICS,PLTPTR,ISCN)=SUM - ENDDO - ENDIF - ENDDO - ENDDO - ENDDO -C -C PLOT PER IFR -C - IF (.NOT.OPENSW) THEN - IF ((.NOT.MOSAIK.AND..NOT.PLOTAP).OR. - 1 ((MOSAIK.AND.(IFR_MODE.NE.'BAND'))))THEN - CALL NPLOPN (LDATTP,IPOL,NHV,IFRS) - ! OPEN PLOT, PLOT HEADING - IF (NO_MORE) RETURN ! USER SAID: STOP - CALL NPLPBE (.TRUE.,NPLOT,PTXT,NHV,NCHAN) - ! PLOT BEGIN-ANNOTATIONS - CALL NPLPBE (.FALSE.,NPLOT,PTXT,NHV,NCHAN) - ! PLOT END-ANNOTATIONS - OPENSW=.TRUE. - END IF - END IF - CALL NPLPLT (LDATTP,IPOL,NPLOT,PTXT,NHV,TABIFR,SCHAN,IFRS, - 1 STHJ(STH_SCN_J),STHJ(STH_NIFR_J),HAB, - 1 STHE(STH_HAI_E),PLTIFR,IFRA,AMCO) - IF (NO_MORE) RETURN ! USER SAID: STOP - ELSE ! mode=band -C -C CALCULATE AVERAGE -C - IF (.NOT.MOSAIK) THEN - DO PLTPTR=0,STHJ(STH_NIFR_J)-1 - DO ICS=1,2 - IF ((AMCO(ICS,PLTPTR,NCHAN-1).NE.1E20).AND. - 1 (NRAMCO(PLTPTR,NCHAN-1).NE.0)) THEN - AMCO(ICS,PLTPTR,NCHAN-1)= - 1 AMCO(ICS,PLTPTR,NCHAN-1)/NRAMCO(PLTPTR,NCHAN-1) - END IF - END DO - END DO - END IF - END IF ! band - 51 CONTINUE -CCC I=WNGCCN() ! nr of control-C seen -CCC IF (I.GT.1) NO_MORE=.TRUE. -CCC IF (I.NE.0) GOTO 52 - END DO ! sectors -CCC 52 CONTINUE -CCC IF (NO_MORE) RETURN ! USER SAID: STOP -C - IF (IFR_MODE.EQ.'BAND') THEN ! CALCULATE AVERAGE - IF (MOSAIK) THEN -!= I1=ICH I4=IFR I2=ICS - DO ICH=0,NCHAN-1 - DO IFR=0,STHJ(STH_NIFR_J)-1 - DO ICS=1,2 - IF ((AMCO(ICS,IFR,ICH).NE.1E20).AND.(NRAMCO(IFR,ICH).NE.0)) - 1 AMCO(ICS,IFR,ICH)=AMCO(ICS,IFR,ICH)/NRAMCO(IFR,ICH) - END DO - END DO - END DO - END IF - IF (.NOT.OPENSW) THEN - IF ((.NOT.MOSAIK.AND..NOT.PLOTAP).OR. - 1 ((MOSAIK.AND.(IFR_MODE.NE.'BAND'))))THEN - CALL NPLOPN (LDATTP,IPOL,NHV,IFRS)! OPEN PLOT, PLOT HEADING - IF (NO_MORE) RETURN ! USER SAID: STOP - CALL NPLPBE (.TRUE.,NPLOT,PTXT,NHV,NCHAN) - ! PLOT BEGIN-ANNOTATIONS - CALL NPLPBE (.FALSE.,NPLOT,PTXT,NHV,NCHAN) - ! PLOT END-ANNOTATIONS - OPENSW=.TRUE. - END IF - END IF - CALL NPLPLT (LDATTP,IPOL,NPLOT,PTXT,NHV,TABIFR,SCHAN,IFRS, - 1 NCHAN,STHJ(STH_NIFR_J),HAB, - 2 STHE(STH_HAI_E),PLTIFR,IFRA,AMCO) -CCC IF (WNGCCN().GT.1) NO_MORE=.TRUE. - IF (NO_MORE) RETURN ! USER SAID: STOP - END IF - IF (OPENSW) THEN - IF ((.NOT.MOSAIK.AND..NOT.PLOTAP).OR. - 1 ((MOSAIK.AND.(IFR_MODE.NE.'BAND'))))THEN -CC CALL NPLPBE (.FALSE.,NPLOT,PTXT,NHV,NCHAN) -CC ! PLOT END-ANNOTATIONS - IF ((PPP(1).EQ.1).AND.(PPP(2).EQ.1)) THEN - CALL NPLCLO(DQID,NHV) ! CLOSE PLOT - OPENSW=.FALSE. - END IF - END IF - END IF -C - RETURN -C - END - diff --git a/src/nplot/nplsst.for b/src/nplot/nplsst.for deleted file mode 100644 index aae3bd18fb08d62656669fdca2c58bb9a4725e32..0000000000000000000000000000000000000000 --- a/src/nplot/nplsst.for +++ /dev/null @@ -1,131 +0,0 @@ -C+ NPLSST.FOR -C JPH 960305 -C -C Revisions: -C JPH 960522 Remove spurious print statement -C JPH 960619 Add monotony option -C JPH 960806 Straighten out. - Init ST=0 for monotony mode -C JPH 960808 Bug fix: ST0 real i.s.o. integer -C JPH 961118 Remove HA jumps -C -C -C - SUBROUTINE NPLSST(STHD, HA, SNAM, ST) -C -C Calculate sidereal time -C -C Result: -C NPLSST (STH_D(0:*):I, HA_R:I, SNAM_J(0:*):I, ST_R:O) -C Calculate ST in circles from HA and STHD(STH_RA_D). -C If ST_INIT#0, set ST_INIT to 0 and save ST and STHD(STH_MJD_D) -C in ST0 and MJD0; if common ST_INIT<0 set STPREV for monotony -C else use these saved values to resolve 1-circle ambiguity -C by requiring that STHD(STH_MJD_D)-MJD0 be almost equal -C to ST-ST0. -C In monotony mode, ST must always be larger than previous; this -C is achieved by predicting ST from the ST and HA length of the -C previous sector and using it when appropriate. Moreover, an ST -C gap is created to mark the transitions to a new grp, obs, fld; -C these are detected by comparing SNAM with the previous one -C -C Include files: -C - INCLUDE 'WNG_DEF' - INCLUDE 'NPL_DEF' - INCLUDE 'STH_O_DEF' -C -C Parameters: -C - INTEGER NNAM ! # of SNAM comp. of interest - PARAMETER (NNAM=3) ! grp,obs,fld -C -C Arguments: -C - DOUBLE PRECISION STHD(0:*) ! sector header - REAL HA ! hour angle (circles) - INTEGER SNAM(0:NNAM-1) ! sector name - REAL ST ! sidereal time (circles) -C -C -C Entry points: -C -C -C Function references: -C - REAL NPLSSR, NPLSSS -C -C Data declarations: - DOUBLE PRECISION MJD0 ! reference MJD - REAL ST0 ! reference ST - REAL STPRED ! predicted ST - LOGICAL MONOT ! monotony-mode flag - INTEGER PNAM(0:NNAM-1) ! saved sector name - SAVE STPRED, ST0, MJD0, MONOT, PNAM -C -C Equivalences: -C -C -C Commons: -C -C- -C Initialisation: ST_INIT ><0 -C - ST=STHD(STH_RA_D)+HA - IF (ST_INIT .GT.0) THEN ! init ST mode - MJD0= STHD(STH_MJD_D) - ST0= ST ! reference ST - MONOT=.FALSE. - ELSEIF (ST_INIT.LT.0) THEN ! init monotonous mode - STPRED=0 - MONOT=.TRUE. - DO I=0,NNAM-1 - PNAM(I)=-1 ! init name - ENDDO - ENDIF - ST_INIT=0 -C -C Running: ST_INIT =0 -C - IF (.NOT.MONOT) THEN ! ST mode - ST= ST +INT( (STHD(STH_MJD_D)-MJD0) ! eliminate 1-day jumps - 1 *STHD(STH_UTST_D) -ST+ST0 ) - ELSE ! monotonous mode - ST=STPRED -!! DO I=0,NNAM-1 ! extra space for new group, -!! IF (PNAM(I).NE.SNAM(I)) THEN ! obs. or field -!! ST=ST+(NNAM-I)*NPLSSS(STHD) -!! GOTO 10 -!! ENDIF -!! ENDDO - 10 CONTINUE - STPRED=ST+NPLSSR(STHD,STHD) ! predict next - DO I=0,NNAM-1 - PNAM(I)=SNAM(I) ! save name - ENDDO - ENDIF -C - RETURN - END -C -C - REAL FUNCTION NPLSSR(STHE,STHJ) ! auxiliary function -C - INCLUDE 'STH_O_DEF' - REAL STHE(0:*) - INTEGER STHJ(0:*) -C - NPLSSR=STHE(STH_HAI_E)*STHJ(STH_SCN_J) - RETURN -C - END -C -C - REAL FUNCTION NPLSSS(STHE) ! auxiliary function -C - INCLUDE 'STH_O_DEF' - REAL STHE(0:*) -C - NPLSSS=STHE(STH_HAI_E) - RETURN -C - END diff --git a/src/nplot/npltel.for b/src/nplot/npltel.for deleted file mode 100644 index 9d8cd67695ba9225dcc9323c199bdde22f729542..0000000000000000000000000000000000000000 --- a/src/nplot/npltel.for +++ /dev/null @@ -1,418 +0,0 @@ -C+ NPLTEL.FOR -C WNB 910617 -C -C Revisions: -C WNB 910815 Phase scale -C WNB 911009 Limit phase errors -C WNB 911217 Convert to WQ -C WNB 920130 New multiple pages -C WNB 920403 Stop infinite loop for YY polarisation -C WNB 920403 Rearrange pol. test -C WNB 920901 Add PLUVO -C WNB 921104 Cater for large HA -C HjV 930311 Change some text -C WNB 930608 New flags -C HJV 930618 Symbolic names for mask bits in CBITS_O_DEF -C WNB 930803 CBITS_DEF -C WNB 930824 New STELS -C WNB 930825 Polarisation codes -C HjV 940113 Removed some parts to new subroutines -C HjV 940224 Add mosaik test, add filling of FNAM and OBSYD -C HjV 940324 Better check for MOSAIK with BANDPASS -C HjV 940413 Changed check for opening plot -C CMV 940426 Add IFData option -C HjV 940506 Changed place for opening plot -C CMV 940822 Option to abort during loop of plots -C WNB 950120 Correct Y polarisation (#135) -C HjV 950206 Call NSCGF1 only when NO mosaik -C JPH 960402 ST_MODE: Plotting versus ST i.s.o. HA -C HjV 960415 Correct option to stop during loop or more plots per -C page -C JPH 960619 ST_MODE integer, copy to INIT. - Report progress -C JPH 960726 SETNAM in NPLSST call -C JPH 960805 ST_INIT in common -C JPH 960814 Test WNGCCN >1 i.s.o. >0 at end of routine -C JPH 9611.. HA integration -C JPH 961204 100*(exp(gn)-1) --> 100*gn -C JPH 961210 Set output undefined if no data after HA integration -C JPH 970123 Use 100*(gain-1) for gain<0, 100*ln(gain) for gain>0. -C JPH 970124 Call NPLPBE(.FALSE.,...) immediately after -C NPLPBE(.TRUE.,...) to draw raster first -C HjV 970723 Remove control-C stuff (commented out with CCC) -C JPH 970825 Restore control-C. - NO_MORE exits through 1000 -C JPH 980113 Phase continuity -C JPH 980127 Remove WNGCxx calls: control-C interaction abandoned -C because of problems with multiple plots per page -C AXC 010709 Linux port - .NE.0 changed -C CMV 030628 Removed phase continuity -C - SUBROUTINE NPLTEL (LDATTP,IPOL,NPLOT,PTXT,NHV,TABIFR,SCHAN,IFRS) -C -C Fill buffers for plotting telescope errors of individual scans -C -C Result: -C -C CALL NPLTEL Fill buffers for plotting telescope errors -C -C Include files: -C - INCLUDE 'WNG_DEF' - INCLUDE 'CBITS_DEF' - INCLUDE 'STH_O_DEF' !SET HEADER - INCLUDE 'SCH_O_DEF' !SCAN HEADER - INCLUDE 'NPL_DEF' -C -C Parameters: -C -C -C Arguments: -C - INTEGER LDATTP !CURRENT DATA TYPE - INTEGER IPOL - INTEGER NPLOT !# OF TELESCOPES TO DO - INTEGER PTXT(MXNCHN) !CROSS CHANNELS - INTEGER NHV(0:1) !# OF PAGES - INTEGER TABIFR(0:STHTEL-1,0:STHTEL-1) !IFR PLOT POINTERS - INTEGER SCHAN(0:MXNCHN-1) !CHANNELS TO DO - INTEGER IFRS(0:1) !CURRENT TELESCOPE -C -C Function references: -C - REAL WNGENR !LIMIT PHASE - LOGICAL NSCSTL !GET A SET - LOGICAL NSCSCH !READ SCAN HEADER - LOGICAL NSCGIF !Read IF data - LOGICAL NSCGF1 !Get some data from IF header - CHARACTER*32 WNTTSG ! ASCII sector name -CC INTEGER WNGCCN ! control-C check -C -C Data declarations: -C - LOGICAL OPENSW !PLOT OPEN OR CLOSED - INTEGER NCHAN !# OF CHANNELS TO DO - INTEGER IFRA(0:1,0:STHIFR-1) - LOGICAL PLTIFR(0:STHIFR-1) !.TRUE.= PLOT THIS INTERFEROMETER - INTEGER UFL !FLAGS TO DISCARD - REAL LHA !LOCAL HA - REAL PHASE !PHASE CORRECTION - REAL AMPL !AMPLITUDE CORRECTION - REAL HAB,HAI !START HA, INCREMENT - INTEGER NTINT ! # scans for ha integration - INTEGER NSCN !NUMBER OF SCANS - INTEGER TCP !TEL. CORR. POINTER - INTEGER STHP !SET HEADER POINTER - BYTE STH(0:STH__L-1) !SET HEADER - INTEGER*2 STHI(0:STH__L/LB_I-1) - INTEGER STHJ(0:STH__L/LB_J-1) - REAL STHE(0:STH__L/LB_E-1) - DOUBLE PRECISION STHD(0:STH__L/LB_D-1) - EQUIVALENCE (STH,STHI,STHJ,STHE,STHD) - BYTE SCH(0:SCH__L-1) !SCAN HEADER - INTEGER*2 SCHI(0:SCH__L/LB_I-1) - INTEGER SCHJ(0:SCH__L/LB_J-1) - REAL SCHE(0:SCH__L/LB_E-1) - DOUBLE PRECISION SCHD(0:SCH__L/LB_D-1) - EQUIVALENCE (SCH,SCHI,SCHJ,SCHE,SCHD) - REAL IFBUF(0:STHTEL-1,0:1) !BUFFER FOR IF-DATA - REAL AMCO(2,0:STHIFR-1,0:MXNCHN-1)!DATA VALUES PER INTERF. PER HA - INTEGER NRAMCO(0:STHIFR-1,0:MXNCHN-1) - !# OF POINTS IN AMCO FOR BAND OPTION - REAL TMPVAL(2) !TEMP. VALUE A/P OR C/S - INTEGER CSET(0:7,0:1) !TEST SET NAMES - LOGICAL REPORT ! 'new plot' flag - INTEGER ISCN,ISCN0,ISCN1,ICS,ITL! loop indices - INTEGER N ! averaging counter - REAL SUM ! acumulator - LOGICAL FIRST ! 'first scan' flag -C- -C -C - CALL WNDDUF(UFL) !GET UNFLAG DATA - UFL=IAND(FL_ALL,NOT(UFL)) !SELECTOR -C -C INIT PLOT -C - FIRST=.TRUE. ! no previous scan yet - ST_INIT=ST_MODE - REPORT=.TRUE. - NCHAN=0 - CSET(0,0)=-1 - CSET(0,1)=-1 - OPENSW=.FALSE. - IF (IFR_MODE.EQ.'BAND') THEN - DO I1=0,MXNCHN-1 !CLEAR - DO I2=0,STHIFR-1 - AMCO(1,I2,I1)=1E20 - AMCO(2,I2,I1)=1E20 - END DO - END DO - END IF -C -C FILL TEL DATA IN BUFFER -C - DO WHILE(NSCSTL(FCAIN,SETS,STH(0),STHP,SETNAM,LPOFF)) !NEXT SET - CALL WNDSTI(FCAIN,SETNAM) !PROPER NAME - IF (REPORT) CALL WNCTXT(F_T,'Next plot, first sector: !AS', - 1 WNTTSG(SETNAM,0) ) - REPORT=.FALSE. - CALL WNGMTS(STH_FIELD_N,STH(STH_FIELD_1),FNAM) !SET FIELD NAME - OBSDY(1)=STHI(STH_OBS_I) !OBS. DAY - OBSDY(2)=STHI(STH_OBS_I+1) !OBS. YEAR - IF (IFR_MODE.NE.'BAND') THEN - NCHAN=NCHAN+1 - DO I1=0,MXNCHN-1 !CLEAR - DO I2=0,STHIFR-1 - AMCO(1,I2,I1)=1E20 - AMCO(2,I2,I1)=1E20 - END DO - END DO - ELSE - IF (MOSAIK) THEN - IF (CSET(0,0).EQ.-1) THEN - DO I1=0,7 - CSET(I1,0)=SETNAM(I1) - END DO - END IF - IF (CSET(0,1).EQ.-1) THEN - NCHAN=NCHAN+1 - DO I2=0,STHIFR-1 - NRAMCO(I2,NCHAN-1)=0 - END DO - ELSE - IF ((CSET(0,1).NE.SETNAM(0)).OR. - 1 (CSET(1,1).NE.SETNAM(1)).OR. - 1 (CSET(2,1).NE.SETNAM(2)).OR. - 1 (CSET(3,1).NE.SETNAM(3))) THEN - NCHAN=NCHAN+1 - DO I2=0,STHIFR-1 - NRAMCO(I2,NCHAN-1)=0 - END DO - END IF - END IF - DO I1=0,7 - CSET(I1,1)=SETNAM(I1) - END DO - ELSE - NCHAN=NCHAN+1 - DO I2=0,STHIFR-1 - NRAMCO(I2,NCHAN-1)=0 - END DO - END IF - END IF - IF (ST_MODE.NE.0) THEN - CALL NPLSST (STHD,STHE(STH_HAB_E),SETNAM,HAB) - ELSE - HAB=STHE(STH_HAB_E) - ENDIF !START HA - HAI=STHE(STH_HAI_E) !HA INCREMENT - NSCN=STHJ(STH_SCN_J) - IF (.NOT.MOSAIK) THEN - IF (IF_MODE.NE.' ') JS=NSCGF1(FCAIN,STH,HAB,HAI,NSCN) !GET FROM IFH - END IF - DO I0=0,NSCN-1 !ALL SCANS - LHA=HAB+I0*HAI !HA - IF (LHA.LT.HARA(0) .OR. LHA.GT.HARA(1)) GOTO 50 !NEXT SCAN -C - IF (IF_MODE.EQ.' ') THEN - IF (.NOT.NSCSCH(FCAIN,STH,0,I0,0,0,SCH)) THEN !READ SCAN HEADER - CALL WNCTXT(F_TP,'Error reading scan header') - GOTO 50 !NEXT SCAN - END IF - IF (IAND(SCHJ(SCH_BITS_J),UFL).NE.0) GOTO 50 !DELETE SCAN - ELSE !GET IF DATA - IF (.NOT.NSCGIF(IF_MODE,FCAIN,STH, - 1 LHA,LHA,IFBUF)) GOTO 50 !IGNORE SCAN - END IF -C - I5=0 !TEL COUNT - DO I1=0,STHTEL-1 !ALL TELESCOPES - IF ((.NOT.PLUVO .AND. STELS(I1).NE.0) .OR. - 1 (PLUVO .AND. I1.EQ.IFRS(0))) THEN - IF (PLUVO) THEN - I4=SCHAN(SETNAM(3)) !PLOT POINTER - ELSE - I4=I5 !PLOT POINTER - END IF - PHASE=0. !PHASE - AMPL=0. !AMPLITUDE -C - IF (IF_MODE.EQ.' ') THEN !GET CORRECTIONS - TCP=2*STHTEL*(IPOL/2)+2*I1 !TEL. CORR. POINTER - IF (IAND(CORAP,1).NE.0) THEN !RED. ASKED - AMPL=AMPL+SCHE(SCH_REDC_E+TCP+0) !GAIN - PHASE=PHASE+SCHE(SCH_REDC_E+TCP+1) !PHASE - END IF - IF (IAND(CORAP,2).NE.0) THEN !ALIGN ASKED - AMPL=AMPL+SCHE(SCH_ALGC_E+TCP+0) !GAIN - PHASE=PHASE+SCHE(SCH_ALGC_E+TCP+1) !PHASE - END IF - IF (IAND(CORAP,4).NE.0) THEN !OTHERS ASKED - AMPL=AMPL+SCHE(SCH_OTHC_E+TCP+0) !GAIN - PHASE=PHASE+SCHE(SCH_OTHC_E+TCP+1) !PHASE - END IF - IF (IAND(CORDAP,4).NE.0) THEN !OTHERS DEAPPLY ASKED - AMPL=AMPL-SCHE(SCH_AOTHC_E+TCP+0) !GAIN - PHASE=PHASE-SCHE(SCH_AOTHC_E+TCP+1) !PHASE - END IF - PHASE=WNGENR(PHASE)*DEG !PHASE IN DEGREES -C -C Use linear scale for ln(gain)<0, logarithmic for >0. For gain values close -C to 0, ln becomes too large; on the large side, ln compresses the scale which -C helps keeping large gains within plot range. For the most common case of -C small gain errors, the two functions are approximately the same. -C - IF (AMPL.GT.0) AMPL=100*AMPL ! ln% - IF (AMPL.LT.0.) AMPL=100.*(EXP(AMPL)-1)! % - ELSE !GET IF DATA - AMPL=IFBUF(I1,IPOL/2) !CAN BE ONLY X/Y - END IF -C - IF ((DATTYP(LDATTP)(1:2).EQ.'AP').OR. - 1 (DATTYP(LDATTP)(1:2).EQ.'AM').OR. - 1 (DATTYP(LDATTP)(1:2).EQ.'PH')) THEN !AMP./PHASE - TMPVAL(1)=AMPL -C -C Phase continuity -C -C IF (FIRST) THEN -C FIRST=.FALSE. -C ELSE -C IF (PHASE-AMCO(2,I4,I0-1) .LT.-PI) PHASE=PHASE+PI2 -C IF (PHASE-AMCO(2,I4,I0-1) .GT. PI) PHASE=PHASE-PI2 -C ENDIF - TMPVAL(2)=PHASE - ELSE IF ((DATTYP(LDATTP)(1:2).EQ.'CS').OR. - 1 (DATTYP(LDATTP)(1:2).EQ.'CO').OR. - 1 (DATTYP(LDATTP)(1:2).EQ.'SI')) THEN !COS/SIN - TMPVAL(1)=AMPL*COS(PHASE/360*PI2) !COSINE - TMPVAL(2)=AMPL*SIN(PHASE/360*PI2) !SINE - END IF - IF (IFR_MODE.EQ.'BAND') THEN - NRAMCO(I4,NCHAN-1)=NRAMCO(I4,NCHAN-1)+1 - DO I2=1,2 - IF (AMCO(I2,I4,NCHAN-1).EQ.1E20) THEN - AMCO(I2,I4,NCHAN-1)=TMPVAL(I2) - ELSE - AMCO(I2,I4,NCHAN-1)=AMCO(I2,I4,NCHAN-1)+TMPVAL(I2) - ENDIF - END DO - ELSE - AMCO(1,I4,I0)=TMPVAL(1) - AMCO(2,I4,I0)=TMPVAL(2) - ENDIF - I5=I5+1 - END IF - ENDDO ! telescopes - 50 CONTINUE -CC I2=WNGCCN() ! nr of control-C seen -CC IF (I2.GT.1) NO_MORE=.TRUE. -CC IF (I2.NE.0) GOTO 501 - ENDDO ! scans -C -C HA integration -C - IF (IFR_MODE.NE.'BAND') THEN - NTINT=MAX(1, ! scans to integrate - 1 NINT(HAINT/24./3600./STHE(STH_HAI_E))) - HAI=NTINT*HAI ! new HA increment - DO ITL=0,STHTEL-1 - DO ISCN0=0,STHJ(STH_SCN_J)-1,NTINT ! integration intervals - ISCN1=MIN(ISCN0+NTINT,STHJ(STH_SCN_J))-1 - DO ICS=1,2 - N=0 - SUM=0 - DO ISCN=ISCN0,ISCN1 ! integrate - IF (AMCO(ICS,ITL,ISCN).NE.1E20 .AND. - 1 AMCO(ICS,ITL,ISCN).NE.0) THEN ! defined? - SUM=SUM+AMCO(ICS,ITL,ISCN) - N=N+1 - ENDIF - ENDDO - IF (N.NE.0) THEN - SUM=SUM/N - ELSE - SUM=1E20 ! set undefined - ENDIF - DO ISCN=ISCN0,ISCN1 - AMCO(ICS,ITL,ISCN)=SUM - ENDDO - ENDDO - ENDDO - ENDDO -C -C PLOT PER TEL -C - IF (.NOT.OPENSW) THEN - IF ((.NOT.MOSAIK.AND..NOT.PLOTAP).OR. - 1 ((MOSAIK.AND.(IFR_MODE.NE.'BAND'))))THEN - CALL NPLOPN (LDATTP,IPOL,NHV,IFRS) !OPEN PLOT, PLOT HEADING - IF (NO_MORE) GOTO 1000 !USER SAID: STOP - CALL NPLPBE (.TRUE., NPLOT,PTXT,NHV,NCHAN) - !PLOT BEGIN-ANNOTATIONS - CALL NPLPBE (.FALSE.,NPLOT,PTXT,NHV,NCHAN) - !PLOT END-ANNOTATIONS - OPENSW=.TRUE. - END IF - END IF - CALL NPLPLT (LDATTP,IPOL,NPLOT,PTXT,NHV,TABIFR,SCHAN,IFRS, - 1 NSCN,STHTEL,HAB,HAI,PLTIFR,IFRA,AMCO) - IF (NO_MORE) GOTO 1000 !USER SAID: STOP - ELSE ! mode= band -C CALCULATE AVERAGE - IF (.NOT.MOSAIK) THEN - DO I4=0,STHTEL-1 - DO I2=1,2 - IF ((AMCO(I2,I4,NCHAN-1).NE.1E20).AND. - 1 (NRAMCO(I4,NCHAN-1).NE.0)) THEN - AMCO(I2,I4,NCHAN-1)=AMCO(I2,I4,NCHAN-1)/NRAMCO(I4,NCHAN-1) - END IF - END DO - END DO - END IF - END IF - END DO ! sectors - 501 CONTINUE - IF (NO_MORE) GOTO 1000 -C - IF (IFR_MODE.EQ.'BAND') THEN !CALCULATE AVERAGE - IF (MOSAIK) THEN - DO I1=0,NCHAN-1 - DO I4=0,STHJ(STH_NIFR_J)-1 - DO I2=1,2 - IF ((AMCO(I2,I4,I1).NE.1E20).AND.(NRAMCO(I4,I1).NE.0)) - 1 AMCO(I2,I4,I1)=AMCO(I2,I4,I1)/NRAMCO(I4,I1) - END DO - END DO - END DO - END IF - IF (.NOT.OPENSW) THEN - IF ((.NOT.MOSAIK.AND..NOT.PLOTAP).OR. - 1 ((MOSAIK.AND.(IFR_MODE.NE.'BAND'))))THEN - CALL NPLOPN (LDATTP,IPOL,NHV,IFRS) !OPEN PLOT, PLOT HEADING - IF (NO_MORE) GOTO 1000 !USER SAID: STOP - CALL NPLPBE (.TRUE., NPLOT,PTXT,NHV,NCHAN)!PLOT BEGIN-ANNOTATIONS - CALL NPLPBE (.FALSE.,NPLOT,PTXT,NHV,NCHAN)!PLOT END-ANNOTATIONS - OPENSW=.TRUE. - END IF - END IF - CALL NPLPLT (LDATTP,IPOL,NPLOT,PTXT,NHV,TABIFR,SCHAN,IFRS, - 1 NCHAN,STHTEL,HAB,HAI,PLTIFR,IFRA,AMCO) -CC IF (WNGCCN().GT.1) NO_MORE=.TRUE. - IF (NO_MORE) GOTO 1000 !USER SAID: STOP - END IF - IF (OPENSW) THEN - IF ((.NOT.MOSAIK.AND..NOT.PLOTAP).OR. - 1 ((MOSAIK.AND.(IFR_MODE.NE.'BAND'))))THEN -cc CALL NPLPBE (.FALSE.,NPLOT,PTXT,NHV,NCHAN) !PLOT END-ANNOTATIONS -C - 1000 CONTINUE ! NO_MORE exit - IF ((PPP(1).EQ.1).AND.(PPP(2).EQ.1)) THEN - CALL NPLCLO(DQID,NHV) !CLOSE PLOT - OPENSW=.FALSE. - END IF - END IF - END IF -C - RETURN -C - END diff --git a/src/nplot/npltwo.for b/src/nplot/npltwo.for deleted file mode 100644 index 59774a3ebc9e42ab7dc546a7e906a5a63080d60c..0000000000000000000000000000000000000000 --- a/src/nplot/npltwo.for +++ /dev/null @@ -1,117 +0,0 @@ -C+ NPLTWO.FOR -C HjV 931108 -C Combined parts of old version of NPLTEL and NPLRES -C -C Revisions: -C - SUBROUTINE NPLTWO (APCS,NHACH,LENMM,MINMAX,HAINCR,LHA) -C -C Plot AP/CS scan/sets -C -C Result: -C -C CALL NPLTWO Plot scan/sets -C -C Include files: -C - INCLUDE 'WNG_DEF' - INCLUDE 'NPL_DEF' -C -C Parameters: -C -C -C Arguments: -C - INTEGER APCS !1=AMPL/COS, 2=PHASE/SIN - INTEGER NHACH !# OF HA/CHAN TO DO - REAL LENMM !MAX-MIN - REAL MINMAX(2,2) !MIN./MAX. AMPL/COS AND PHASE/SIN - REAL HAINCR !HA INCREMENT - REAL LHA !LOCAL HA - REAL CPO !CURRENT POINT OFFSET - REAL HPO !HALF POINT OFFSET -C -C Function references: -C -C -C Data declarations: -C - REAL YSIZ,LENYAS -C- - POINXY(1,1)=PAREA(0) - POINXY(2,1)=PAREA(1) - POINXY(1,2)=PAREA(2) - POINXY(2,2)=PAREA(3) - YSIZ=(POINXY(2,2)-POINXY(2,1))/2.+25./PPP(2) !BOTTOM LEFT CORNER - IF (APCS.EQ.1) THEN !AMPL - POINXY(2,1)=PAREA(1)+YSIZ !Y LEFT/RIGHT BOTTOM - ELSE !PHASE - POINXY(2,2)=PAREA(3)-YSIZ !Y LEFT/RIGHT TOP - ENDIF - LENYAS=YSIZ-50./PPP(2) !LENGTH Y-AX - IF (IFR_MODE.EQ.'BAND') THEN - IF (NHACH.EQ.1) THEN - I1=PAREA(2)-PAREA(0) - ELSE - I1=(PAREA(2)-PAREA(0))/(NHACH-1) - END IF - END IF - DO I0=0,NHACH-1 - IF (IFR_MODE.EQ.'BAND') THEN - CPO=PAREA(0)-I1+I0*I1 !CURRENT POINT OFFSET - IF ((I0.GT.0).AND.(I0.LT.NHACH)) THEN - HPO=I1/2 - ELSE - HPO=0. - END IF - ELSE - LHA=LHA+HAINCR - CPO=PAREA(0)+XFAC*(360.*(LHA-HARA(0))/HASC) !CURRENT POINT OFFSET - HPO=180*XFAC*HAINCR/HASC !HALF POINT OFFSET - END IF -c -c This version will not plot points with deleted points directly -c before and after it -c IF ((NEW(I0).NE.1E20).AND.(OLD(I0).NE.1E20)) THEN -c PG(1,1)=CPO -c PG(2,1)=POINXY(2,2)-LENYAS* -c 1 ((MINMAX(2,APCS)-OLD(I0))/LENMM) -c PG(1,2)=CPO+2*HPO -c PG(2,2)=POINXY(2,2)-LENYAS* -c 1 ((MINMAX(2,APCS)-NEW(I0))/LENMM) -c CALL WQPOLL(2,PG) -c END IF -c The version below will plot them - IF (NEW(I0).EQ.1E20) THEN - IF (OLD(I0).NE.1E20) THEN - PG(1,1)=CPO - PG(2,1)=POINXY(2,2)-LENYAS* - 1 ((MINMAX(2,APCS)-OLD(I0))/LENMM) - PG(1,2)=CPO+HPO - PG(2,2)=POINXY(2,2)-LENYAS* - 1 ((MINMAX(2,APCS)-OLD(I0))/LENMM) - CALL WQPOLL(2,PG) - END IF - ELSE - IF (OLD(I0).NE.1E20) THEN - PG(1,1)=CPO - PG(2,1)=POINXY(2,2)-LENYAS* - 1 ((MINMAX(2,APCS)-OLD(I0))/LENMM) - PG(1,2)=CPO+2*HPO - PG(2,2)=POINXY(2,2)-LENYAS* - 1 ((MINMAX(2,APCS)-NEW(I0))/LENMM) - CALL WQPOLL(2,PG) - ELSE - PG(1,1)=CPO+2*HPO - PG(2,1)=POINXY(2,2)-LENYAS* - 1 ((MINMAX(2,APCS)-NEW(I0))/LENMM) - PG(1,2)=CPO+HPO - PG(2,2)=POINXY(2,2)-LENYAS* - 1 ((MINMAX(2,APCS)-NEW(I0))/LENMM) - CALL WQPOLL(2,PG) - END IF - END IF - END DO !PLOT IFR/TEL -C -C - END diff --git a/src/nplot/plotter.pef b/src/nplot/plotter.pef deleted file mode 100644 index 4c834484cb1ef39cad2edca4ab7777ebf8475980..0000000000000000000000000000000000000000 --- a/src/nplot/plotter.pef +++ /dev/null @@ -1,65 +0,0 @@ -!+ PLOTTER.PEF -! JPH 941206 -! HjV 950705 Add A0-plotter, so change names for postscript file/printers -! and add keyword PLOT_FORMAT (only used for postscript) -! JPH 950818 Text corrections -! -! Revisions: -! -! -KEYWORD=PLOTTER - DATA_TYP=C - IO=I - LENGTH=8 - SWITCH=LOOP,NULL_VALUE - CHECKS=ABBREV_OPTIONS - SEARCH=L,P - PROMPT="plotter to use" - OPTIONS=- -X11; QMS,QMSP; PL,PP, EL,EP;|- -REGIS,FREGIS; BIT1,BIT2,BIT3 -! ; USE1,USE2 - HELP=" Select device/mode for plotting: -. - Xwindows: - X11 X11 terminal - The display used is given by (NGEN-) keyword DISPLAY - and/or the environment variable DISPLAY -. - PostScript printer: - QMS QMS laser printer in landscape orientation - QMSP QMS laser printer in portrait orientation -. - PostScript files:: - PL Postscript file in landscape mode - PP PostScript file in portrait mode - EL Encapsulated Postscript file in landscape mode - EP Encapsulated Postscript file in portrait mode -. - Miscellaneous graphics: - REGIS graphics VT terminal - FREGIS (*) REGIS to file -. - Bitmap graphics: - BIT1 (*) bitmap for 100 dpi - BIT2 (*) bitmap for 200 dpi - BIT3 (*) bitmap for 300 bpi -" -! -KEYWORD=PLOT_FORMAT - DATA_TYP=C - IO=I - LENGTH=1 - SWITCH=LOOP,NULL_VALUE - CHECKS=ABBREV_OPTIONS - SEARCH=L,P - PROMPT="A<n>-format of plot" - OPTIONS=0,1,2,3,4 - DEFAULT=4 /ASK - HELP=" Select format for (Encapsulated) PostScript plots: - 0 = A0 - 1 = A1 - 2 = A2 - 3 = A3 - 4 = A4 -" diff --git a/src/nscan/bmd.dsc b/src/nscan/bmd.dsc deleted file mode 100644 index 2c75902e5e7af349488056ccf1ea2b97ce2c0e52..0000000000000000000000000000000000000000 --- a/src/nscan/bmd.dsc +++ /dev/null @@ -1,45 +0,0 @@ -!+ BMD.DSC -! WNB 930826 -! -! Revisions: -! -%REVISION=WNB=930928="Change to cater for different beam definitions" -%REVISION=CMV=930917="Made COMMON" -%REVISION=WNB=930826="Original header" -! -! Define beam data -! -%COMMENT="BMD.DSC defines the (de-)beam data" -! -! -%VERSION=1 !VERSION -%SYSTEM=1 -%USER=WNB -%%DATE -%%NAME -! -%GLOBAL=BEMNDV=4 !# OF DESCRIPTORS/INSTRUMENT -%GLOBAL=BEMMFQ=8 !MAX. # OF FREQUENCY RANGES -%GLOBAL=BEMMIN=8 !MAX. # OF INSTRUMENTS -%GLOBAL=BEMMTP=2 !MAX. PROCESS. TYPE KNOWN: - !0= COS(A1.X)^6 - !1= 1/(1+A1.X^2+A2.X^4+...) - !2= 1+A1.X^2+A2.X^4+...) -%GLOBAL=BEMMFC=8 !MAX. # OF FACTORS/FREQ. RANGE -%ALIGN -!- -.DEFINE -.COMMON - BEMNIN J /-1/ !# OF INSTRUMENTS DEFINED - BEMSC E /1/ !BEAM SCALING: TAKE X.BEMSC - BEMCOD J(0:BEMNDV-1,0:BEMMIN-1) !BEAM DECSCRIPTOR: - !0: BEAM_FREQ_, _FACTOR_ CODE - !1: PROCESSING TYPE - !2: # OF COEFF./FREQ. RANGE - !3: # OF FREQ. RANGES - BEMFQ E(0:BEMMFQ-1,0:BEMMIN-1) !FREQUENCY RANGES - BEMFC E(0:BEMMFC*BEMMFQ-1,0:BEMMIN-1) !BEAM FACTORS - BEMCIN J /0/ !CURRENT INSTRUMENT - BEMCFP J /0/ !CURRENT FACTOR POINTER -.END -!- diff --git a/src/nscan/cbits.dsc b/src/nscan/cbits.dsc deleted file mode 100644 index 62cb557c125a2a1c3d2452df52c61b08ca4a3a7c..0000000000000000000000000000000000000000 --- a/src/nscan/cbits.dsc +++ /dev/null @@ -1,129 +0,0 @@ -!+ CBITS.DSC -! JPH 930615 -! -! Revisions: -! -%REVISION=WNB=940812="Add QUB_OUT" -%REVISION=WNB=940809="Add QUB_M" -%REVISION=WNB=940803="Add QUB and QINFO" -%REVISION=CMV=940506="Removed ZAP bits (use CAP instead)" -%REVISION=WNB=930904="Add INStrument and IFr" -%REVISION=WNB=930902="Use R:, F: and *:" -%REVISION=WNB=930826="Some more Polarisation bits" -%REVISION=WNB=930825="Add Polarisation bits" -%REVISION=WNB=930803="Use WNTINC options" -%REVISION=JPH=930618="FL_ bits from sch.dsc. - CAP_SHFT, rearrange " -%REVISION=JPH=930618=" definitions of xxx_TELMSK to work around wntab bug " -%REVISION=JPH=930615="Original version" -! -! Define bits in CAP, CDAP, ZAP bitmasks -! -%COMMENT="Define bits in CAP, CDAP, ZAP bitmasks" -! -%VERSION=1 -%SYSTEM=1 -%USER=JPH -%%DATE -%%NAME -! -!- -.PARAMETER -! -! Apply/deapply mask bits -! - CAP M*: /REDUN,ALGN,OTHER,XTNCTION,REFRACTION, \ !APPLY/DEAPPLY BITS - IREFRACTION,CLKCORR,PH,POLAR,FARADAY, \ - SHFT,,MODEL,AIFR,MIFR/ - !bit 0: redundancy corrections - !bit 1: align corrections - !bit 2: other telescope corrections - !bit 3: extinction - !bit 4: refraction - !bit 5: ionos. refraction - !bit 6: clock correction - !bit 8: instrum. polarisn - !bit 9: Faraday rotation - !bit 10: shift - !bit 12: source model - !bit 13: additive ifr - !bit 14: multiplicative ifr - CAP MF*: /,,,XTNC,REFR, \ !Extended names - IREF,,,,, \ - SHFT,,,AIFR,MIFR/ - CAP NF*:(CAP_RED+CAP_ALG+CAP_OTH+CAP_XTN+CAP_REF+ \ - CAP_IRE+CAP_CLK+CAP_SHF, \ !All telescope corr. - CAP_POL+CAP_FAR, \ !All pol. corr. - CAP_MOD+CAP_AIF+CAP_MIF) \ !All ifr-based corr. - /TELMSK,POLMSK,IFRMSK/ - CAP NF*:(CAP_TELMSK+CAP_POLMSK+CAP_IFRMSK) \ !All corrections - /ALLMSK/ -! -! Delete/flagging bits in SCH block - in cbits.dsc because wnddab uses them -! - FL M*:(256) /1,2,3,4,5,6,7,8/ !FLAG BITS - !FLAG2 1,2,3 ARE PURE USER TYPE - FL NF*:(FL_8+FL_8-FL_1, \ !ALL, MANUAL, OLD, CLIP, - FL_8,FL_8,FL_7, \ ! NOISE, ADD, SHADOW TYPE - FL_6,FL_5,FL_4) \ - /ALL, \ - MAN,OLD,CLIP, \ - NOIS,ADD,SHAD/ -! -! Polarisation bits -! - P MR*:(1) /XX,XY,YX,YY/ !POLARISATION BITS (_P) - P MR*:(1) /SI,SQ,SU,SV/ !STOKES BITS (_P) - P MRF*:(16) /STOKES,IMAG,LINE/ !STOKES, IMAGINARY, LINE IND. - P A:(0) /XX,XY,YX,YY/ !POLARISATION OFFSETS (P_) - PS A:(0) /I,Q,U,V/ !STOKES OFFSTES (PS_) - M NRF*:(XX_P,YY_P, \ !VARIOUS MASKS: (_M) - \ ! X: XX Y: YY - \ ! XYX: XX XY YX YY - \ ! XY: XX YY YX: XY YX - \ ! XXY: XY YYX: YX - \ ! IQUV: I Q U V - \ ! IQ: I Q UV: U V - \ ! I: I Q: Q - \ ! U: U V: V - XX_P+YY_P+XY_P+YX_P, \ - XX_P+YY_P,XY_P+YX_P, \ - XY_P,YX_P, \ - SI_P+SQ_P+SU_P+SV_P+STOKES_P, \ - SI_P+SQ_P+STOKES_P, \ - SU_P+SV_P+STOKES_P, \ - SI_P+STOKES_P,SQ_P+STOKES_P, \ - SU_P+STOKES_P,SV_P+STOKES_P) \ - /X,Y, \ - XYX, \ - XY,YX, \ - XXY,YYX, \ - IQUV, \ - IQ, \ - UV, \ - I,Q, \ - U,V/ -! -! Instruments -! - INS A:(0) /WSRT,ATCA/ !WSRT and ATCA -! -! Interferometer -! - IFJ A:(0) /WT,ET,IFR/ !W telescope, E telescope, IFR - IFE A:(0) /ANG,SB,CB/ !W X-dipole angle (circles), - !sin(beta=E X-dipole offset) - !cos(beta) -! -! Qube -! - QUB M*:(1) /FTI,TFI,FIT,IFT,TIF,ITF, \ - M,OUT/ !Order of search through a - !data cube(t=ha,f=freq,i=ifr) - !and model wanted (M), and - !ifr errors output (OUT) - QUB N*:(QUB_FTI+QUB_TFI, \ !Last axes - QUB_FIT+QUB_IFT, \ - QUB_TIF+QUB_ITF) \ - /I,T,F/ - QINFO A:(0) /FLD,F,T,I/ !Offset in INFO from NSCQOP -!- diff --git a/src/nscan/dldm.dsc b/src/nscan/dldm.dsc deleted file mode 100644 index 2b7625122e674d57fb4198a504d7bb02b686683e..0000000000000000000000000000000000000000 --- a/src/nscan/dldm.dsc +++ /dev/null @@ -1,23 +0,0 @@ -!+ DLDM.DSC -! JPH 960610 -! -! Revisions: -! -! -! Define Common block for transmitting STH_DLDM to NMOBMV -! This is a quick and dirty bypass to implement model calculations for -! interferometers in which one primary beam is offset -! -! -%VERSION=0 !VERSION -%SYSTEM=4 -%USER=JPH -%%DATE -%%NAME -! -.DEFINE - .COMMON DLDM -DLDM E(0:1) ! position of fringe-stop centre in beam of - ! scanning telescope (rad) -.END -!- diff --git a/src/nscan/fdl.dsc b/src/nscan/fdl.dsc deleted file mode 100644 index da84733189aff62fb4781794b1e4c87513c9fa64..0000000000000000000000000000000000000000 --- a/src/nscan/fdl.dsc +++ /dev/null @@ -1,37 +0,0 @@ -!+ FDL.DSC -! HjV 950116 -! -! Revisions: -! -%REVISION=HJV=950116="Tape vs -1, system 1" -! -! Define LEIDEN FD block -! -%COMMENT="FDL.DSC defines the LEIDEN FD block" -! -! -%VERSION=-1 !VERSION -%SYSTEM=1 -%USER=HJV -%%DATE -%%NAME -!- -.PARAMETER -.BEGIN=FDL - CBI I !'32767' - CBT C2 !Type identification (='FD') - CURRREC J !Recordnr. of this record - NEXTREC J !Recordnr. of next FD-record - NBL J !# blocks within dataset - BYPBL I !# bytes per block (=3840) - TOTFREQ I !# of requency-bands - FREQBND I !Current frequency-band - NRINTF I !# of interferometers - FVERS I !Tape-format version (=-1) - PROG C6 !Program that wrote old Leiden tape - OLDVOL C6 !Volume label of old Leiden tape - OLDLAB C4 !Dataset label on old Leiden tape - - -(0:17) - OFFINTF J(0:159) !Offset in bytes of start FDB interf. -.END !END DEFINITION -!- diff --git a/src/nscan/fdw.dsc b/src/nscan/fdw.dsc deleted file mode 100644 index af09ce1ec2dabe250ddf78b73e60c88e3fcc819c..0000000000000000000000000000000000000000 --- a/src/nscan/fdw.dsc +++ /dev/null @@ -1,76 +0,0 @@ -!+ FDW.DSC -! WNB 900118 -! -! Revisions: -! -%REVISION=CMV=940414="Add historical notes" -%REVISION=WNB=931215="Add some edit formats" -%REVISION=WNB=900118="Tape vs 7, system 59" -! -! Define WSRT FD block -! -%COMMENT="FDW.DSC defines the WSRT FD block" -! -! -%VERSION=7 !VERSION -%SYSTEM=59 -%USER=WNB -%%DATE -%%NAME -!- -.PARAMETER -.BEGIN=FDW - ! (*) means use with care, not repaired - CBI I !Unequal data block flag (32767) - CBT C2 !Type identification: File Description (FD) - NFD J !Record number of this record - LFD J !Number of FD records in this group - NFDE J !First FD record number at end of dataset - SDAY I !Local U.T. day number - ! FVERS<5: ST - STIM I !Start U.T. time in units of 10 sec. - ! FVERS<5: ST - ! FVERS<3: units of minutes - ETIM I !End U.T. time in units of 10 sec. (*) - ! ols<43: -32768 - - I !Empty (Delete character) - FVERS I !Tape format version - LRCRD I !Record length in bytes - PHBLL I !Total number of records per block - NOBS I !Number of simultaneous observations - OLSYS I !Online program system nr. (*) - ! ols<46: reserved - - -(0:1) - COH C2 !'OH' - LOH I !Number of OH records per OH group - NOH J !First record number of first OH group - MOH J !Number of OH groups - ! FVERS<7: NOHE = recnr backup OH record - CSC C2 !'SC' - LSC I !Number of SC records per SC group - NSC J !First record number of first SC group - MSC J !Number of SC groups - CSH C2 !'SH' - LSH I !Number of SH records per SH group (*) - ! FVERS>6: Max length, SH's may differ - NSH J !First record number of first SH group - MSH J !Number of SH groups or number of sets - CIH C2 !'IH' - LIH I !Number of IH records per IH group - NIH J !First record number of first IH group - MIH J !Total number of IH groups - CDB C2 !'DB' - LDB I !1 - NDB J !First record number of first DB group - MDB J !Total number of DB records - - -(0:3) - NBL J !Total number of blocks within the dataset - VOLUME C6 !Name of magnetic volume or tape - LABEL C4 !Name of dataset or label - LENGTH I !Total length in feet of the dataset - REDDATE J !Civil date on which the dataset was made in - !the format YYDDD (Y : year, D : daynumber) - REDTIME I !Civil time in minutes on which the dataset was made - - -(0:5) -.END !END DEFINITION -!- diff --git a/src/nscan/fdx.dsc b/src/nscan/fdx.dsc deleted file mode 100644 index 3b3bc34fb801b129bfda135d54624158ca6d0200..0000000000000000000000000000000000000000 --- a/src/nscan/fdx.dsc +++ /dev/null @@ -1,39 +0,0 @@ -!+ FDX.DSC -! WNB 900118 -! -! Revisions: -! -%REVISION=WNB=931215="Add some edit formats" -%REVISION=WNB=920812="Changed format of data" -%REVISION=WNB=920812="Changed all fields to H(=I2): Essential to be able" -%REVISION=WNB=920812="... to use some critical data translated properly!" -%REVISION=HJV=920714="Tape vs 7, system 63" -%REVISION=HJV=930714="Extend INFTB from 384 to 512 bytes (H's!!)," -%REVISION=HJV=930714="Remove COM (Westerbork common area first 128 words)" -%REVISION=WNB=900118="Tape vs 7, system 59" -! -! -! Define WSRT FD extension block -! -! -! -%VERSION=7 !VERSION -%SYSTEM=63 -%USER=HJV -%%DATE -%%NAME -%COMMENT="FDX.DSC defines the WSRT FD extension block" -!- -.PARAMETER -.BEGIN=FDX - INFTB I(0:511) !Interferometer table. -1 if not present - WBOH I(0:255) !OH information for Westerbork use - CHAN0 I(0:24) !This and following fields provide the - CHLSP I(0:24) !FINDX information to obtain disk location - FLREC I(0:49) !of data in Westerbork. - RCCNT I(0:24) !id. - ABIT I !id. - VOLGN I !id. - NA I !id. -.END !END DEFINITION -!- diff --git a/src/nscan/flf.dsc b/src/nscan/flf.dsc deleted file mode 100644 index 2b20a577e43e4c6380e7c3b56182b962acd071aa..0000000000000000000000000000000000000000 --- a/src/nscan/flf.dsc +++ /dev/null @@ -1,28 +0,0 @@ -!+ FLF.DSC -! WNB 930615 -! -! Revisions: -! -! -! Define delete file contents -! -! -! -%VERSION=1 !VERSION -%SYSTEM=1 -%USER=WNB -%%DATE -%%NAME -%REVISION=WNB=930615="Original header" -%COMMENT="FLF.DSC defines the delete file contents" -%COMMENT=" " -!- -.PARAMETER -.BEGIN=FLF - FLAG J !Flag seen (bit 0=1: 1st of range; b1=1: 2nd) - CHAN J !Channel (or -1) - HA E !HA (or (J) -1) - IFR I !Interferometer as 'TT'X (or -1) - POL I !Polarisation (or -1) -.END !END DEFINITION -!- diff --git a/src/nscan/flfnode.pef b/src/nscan/flfnode.pef deleted file mode 100644 index ea5f65bb33ab33ac78ea136d2f28bdd4763a8877..0000000000000000000000000000000000000000 --- a/src/nscan/flfnode.pef +++ /dev/null @@ -1,76 +0,0 @@ -!+FLFNODE.PEF: FLF_NODE keywords -! JPH 941005 Split from NCOMM.PEF -! JPH 950124 Help texts -! -! Revisions: -! -! Ref: -! -KEYWORD=FLF_NODE - DATA_TYP=C - IO=I - LENGTH=80 - SWITCHES=LOOP,NULL_VALUES,WILD_CARDS - SEARCH=L,P - PROMPT="Input/output .FLF file name" - HELP=" -Specify the file name (no extension). -. -You may enter - - [<directory>/]** -. -to get a list of .SCN files in your current or another directory; then enter -. - #<n> -. -to select the <n>'th file from that list. -" -! -!---------------------------------------------------------------------------- -! Ref: -! -KEYWORD=INPUT_FLF_NODE - DATA_TYP=C - IO=I - LENGTH=80 - SWITCHES=LOOP,NULL_VALUES,WILD_CARDS - SEARCH=L,P - PROMPT="Input .FLF file name" - HELP=" -Specify the file name (no extension). -. -You may enter - - [<directory>/]** -. -to get a list of .SCN files in your current or another directory; then enter -. - #<n> -. -to select the <n>'th file from that list. -" -! -!-------------------------------------------------------------------------- -! Ref: -! -KEYWORD=OUTPUT_FLF_NODE - DATA_TYP=C - IO=I - LENGTH=80 - SWITCHES=LOOP,NULL_VALUES,WILD_CARDS - SEARCH=L,P - PROMPT="Output .FLF file name" - HELP=" -Specify the file name (no extension). -. -You may enter - - [<directory>/]** -. -to get a list of .SCN files in your current or another directory; then enter -. - #<n> -. -to select the <n>'th file from that list. -" diff --git a/src/nscan/flh.dsc b/src/nscan/flh.dsc deleted file mode 100644 index d62b5de7d30892a638aa4d8995e649c69fcb33fc..0000000000000000000000000000000000000000 --- a/src/nscan/flh.dsc +++ /dev/null @@ -1,47 +0,0 @@ -!+ FLH.DSC -! WNB 930616 -! -! Revisions: -! -! -! Define flag file header -! -! -! -%VERSION=1 !VERSION -%SYSTEM=1 -%USER=WNB -%%DATE -%%NAME -%REVISION=WNB=930616="Original header" -%COMMENT="FLH.DSC defines the delete file header" -%COMMENT=" " -!- -.PARAMETER -.BEGIN=FLH - LINK J(0:1) !Link files (not used) - DID J !File ID (not used) - VER J !Version (not used) - FLFL J !Length entry - FLFN J !# of entries in file - FLFP J !Pointer to entries - TYP J !Not used, but e.g. baselines vs interferometers - FLAG J !OR of all entry flags - FLD J !Not used - CHAN J !For channel: -1: all ranges present; 0: range - HA J !For HA: -1/0 - IFR J !Interferometer: -1/0 - POL J !Polarisation: -1/0 - R1 J !Reserved: -1/0 - R2 J !Reserved: -1/0 - - J(4) !Fill - RFLD J(0:1) !Range fields (not used) - RCHAN J(0:1) !Range channels if CHAN 0 - RHA E(0:1) !Range HA - RIFR J(0:1) !Range interferometers - RPOL J(0:1) !Range polarisation - RR1 E(0:1) !Range reserved - RR2 E(0:1) !Range reserved - - J(8) !Fill -.END !END DEFINITION -!- diff --git a/src/nscan/ifh.dsc b/src/nscan/ifh.dsc deleted file mode 100644 index 89189ab4c21608d873423b5582114699f7151423..0000000000000000000000000000000000000000 --- a/src/nscan/ifh.dsc +++ /dev/null @@ -1,50 +0,0 @@ -!+ IFH.DSC -! CMV 940420 -! -! Revisions: -! -%REVISION=CMV=941003="Add IFHAB (only used at loading)" -%REVISION=CMV=940420="Original version" -! -! Define IF/TotalPower Header block -! -! The IF data is organised as follows: -! -! IFH -! Total Powers 0..NTP,0..NSTAR_TEL,X..Y,On..Off -! IF Corrections not yet used -! -! -%COMMENT="IFH.DSC defines the IF/Total Power header block" -%COMMENT=" " -! -%VERSION=1 !VERSION -%SYSTEM=4 -%USER=CMV -%%DATE -%%NAME -! -! Get number of telescopes -! -%INCLUDE=NSTAR_DSF -!- -.BEGIN=IFH - CHAN I !BAND NUMBER - GCODE I !PRINCIPAL GAIN CORR. METHOD - GNCAL I(0:NSTAR_TEL-1,0:1) !ACTUAL GAIN CORR. METHOD - - -(4) - TSYSI E(0:NSTAR_TEL-1,0:1) !CONSTANT SYSTEM TEMP. - - -(16) - RGAINI E(0:NSTAR_TEL-1,0:1) !CONSTANT RECEIVER GAIN - - -(16) - TNOISEI E(0:NSTAR_TEL-1,0:1) !CONSTANT NOISE TEMP. - - -(16) - TPINT J !Total Power Int.time - HAB E <EAF12.7> !FIRST HA APP. - HAI E <EAF12.7> !HA INCREMENT - NTP J <,1> !# OF TOTAL POWER SCANS - NIF J <,1> !# OF IF GAIN/PHASE SCANS - IFHAB E <EAF12.7> !HAB from IH block - - -(40) !RESERVED -.END -!- diff --git a/src/nscan/ihl.dsc b/src/nscan/ihl.dsc deleted file mode 100644 index b9c8a3bb475dc885f52659bcc3fee359f9740ad8..0000000000000000000000000000000000000000 --- a/src/nscan/ihl.dsc +++ /dev/null @@ -1,55 +0,0 @@ -!+ IHL.DSC -! HjV 950116 -! -! Revisions: -! -%REVISION=HJV=950116="Tape vs -1, system 1" -! -! Define LEIDEN FDB block (=interferometer block) -! -%COMMENT="FDL.DSC defines the LEIDEN FDB block (=interferometer block)" -! -! -%VERSION=-1 !VERSION -%SYSTEM=1 -%USER=HJV -%%DATE -%%NAME -!- -.PARAMETER -.BEGIN=IHL - field C16 !Object-name - ra1 D !Right Ascension - dec1 D !Declination - freq D !Frequency - band D !Bandwidth - chinfo B(0:1) !Info on this channel - - -(0:1) - sday J !Sidereal date (YYDDD) - stim D !Sidereal starttime - etim D !Sidereal endtime - gainl I !Gain level - prname C3 !Project name - receiv B !Receiver versionnr. - olsys B !Online computer program versionnr. - geninfo B !General information - obstech B !Type of observing technique - - -(0:2) - reddate J !Reduction date (YYDDD) - redtime J !Reduction time, MET - appdecl R !Apparent declination - rotang R !The angle ofrotation - - -(0:27) - chnum I !Channelnr. - ndatp I !# of observed points - drt R !Baseline - hab R !Start hour-angle - dha R !Increment in hour-angle - volume C6 !Volume label - label C4 !Dataset label - blknr I !Block sequencenr. - redlev B !Reduction level - - -(0:0) - ndelp I !# of deleted and/or missing points -.END !END DEFINITION -!- diff --git a/src/nscan/ihw.dsc b/src/nscan/ihw.dsc deleted file mode 100644 index 0f8f5ab605381a07f234d00ee2c3466e1225d5c9..0000000000000000000000000000000000000000 --- a/src/nscan/ihw.dsc +++ /dev/null @@ -1,91 +0,0 @@ -!+ IHW.DSC -! WNB 900118 -! -! Revisions: -! -! -! Define WSRT IH block -! -! -! -%VERSION=7 !VERSION -%SYSTEM=59 -%USER=WNB -%%DATE -%%NAME -%REVISION=CMV=940414="Add historical notes" -%REVISION=WNB=900118="Tape vs 7, system 59" -%COMMENT="FDW.DSC defines the WSRT IH block" -!- -.PARAMETER -.BEGIN=IHW - ! (*) means use with care, not repaired - CBI I !Unequal data block flag (32767) - CBT C2 !Identification: Interferometer Header (IH) - NIH J !Record number of this record - LIH J !Number of IH records in this group - IHLNK J !First record of the next IH group - SDAY I !Local U.T. day number - ! FVERS<5: ST - STIM I !Start U.T. time in units of 10 sec - ! FVERS<5: ST - ! FVERS<3: units of minutes - BANDNR I !Frequentie bandnr. (*) - ! FVERS<6: Setnr. - INFNR I !Interferometer number of this infr. (*) - ! See SHW.DSC - WTEL I !West telescope indicator: 0-D is 0...13 (*) - ! See SHW.DSC - OTEL I !East telescope indicator: 0-D is 0...13 (*) - ! See SHW.DSC - BFREQ J !Set frequency (2**(-16) Mhz) (*) - ! FVERS<2: single float (E) - DRT E !Baseline of the interferometer (M) - HAB E !Start hourangle, middle of the first - !integration time in U.T. sec - ! FVERS<5: in S.T. sec - HAE E !End hourangle, middle of the last - !integration time in U.T. sec - ! FVERS<5: in S.T. sec - DHA E !Hour angle increment (Integration time in U.T. sec) - ! FVERS<5: in S.T. sec - LD I !Number of data records in this group (*) - ! FVERS<6: in S.T. sec - NDATP I !Number of data points, inclusive NDELP - NDELP I !Number of deleted data points - NEXP I !Common exponential scaling factor - ! ols=42: should be 1 - FSCAL I !Common multiplication scaling factor - ! ols=42: should be 1 - OFFS I !Common offset scaling factor - NOISE E !Amplitude noise - ! FVERS<3: NOISE...MEPHA are empty - ACOS E !Average cosine - MECOS E !Mean error in average cosine - MACOS I !Maximal cosine - MICOS I !Minimal cosine - ASIN E !Average sine - MESIN E !Mean error in average sine - MASIN I !Maximal sine - MISIN I !Minimal sine - AAMP E !Average amplitude - MEAMP E !Mean error in average amplitude - MAAMP I !Maximal amplitude - MIAMP I !Minimal amplitude - APHA E !Average phase - MEPHA E !Mean error in average phase - INCT I !Increment time in U.T. sec. - ! ols=52: float - ! FVERS<5: in S.T. sec. - DWELT I !Time per mosaicking pattern pos. per radial - !in sec. (=INCT if no mosaicking) - ! ols<60: reserved - VOLGNR J !Observation number (*) - ! FVERS<2: reserved - INTT E !Integration time in U.T sec. - ! ols<53: reserved - DRADT I !Time between 2 successive radials of the same - !mosaicking pattern in sec (=INCT if no mos.) - - -(0:5) ! - -.END !END DEFINITION -!- diff --git a/src/nscan/mdh.dsc b/src/nscan/mdh.dsc deleted file mode 100644 index 81aeeb33851c5c8689f95071b09cdea03aa67b48..0000000000000000000000000000000000000000 --- a/src/nscan/mdh.dsc +++ /dev/null @@ -1,49 +0,0 @@ -!+ MDH.DSC -! WNB 900327 -! -! Revisions: -! -%REVISION=JPH=960612="Correct RA edit: DPF i.s.o. DAF" -%REVISION=WNB=940228="Add unknown-flux bit" -%REVISION=WNB=931215="Add some edit formats" -%REVISION=WNB=930928="Add instrument" -%REVISION=WNB=930819="Some text" -%REVISION=WNB=900327="Original header" -! -! Define Model header -! -%COMMENT="MDH.DSC defines the model header" -! -! -%VERSION=1 !VERSION -%SYSTEM=1 -%USER=WNB -%%DATE -%%NAME -! -%GLOBAL=MDHNIN=8 !Number of instruments that can be used - !(see also BMD.DSC) -%ALIGN -!- -.PARAMETER - MDHINS_M J /MDHNIN-1/ !Mask for instrument in BITS - MDHUNF_M J /65536/ !Mask for "unknown flux" bit in BITS -.BEGIN=MDH - LINK J(0:1) <,1> !Link models (not used) - MID J <,1> !Model ID (not used) - MODL J <,1> !Max. # of lines in model or disk version - MODP J <XJ,1,,P:MDL> !Pointer to model - NSRC J <,1> !# of sources in model - TYP J !Type of model (0: no ra,dec, 1=app, 2=epoch) - EPOCH E <E12.2> !Epoch (e.g. 1950) if TYP=2 - RA D <DPF12.7> !Model centre RA (circles) - DEC D <DAF12.7> !Model centre DEC (circles) - FRQ D <D12.6> !Model centre FRQ (MHz) - ACT J <XJ> !Model action (only on disk) - BITS J <XJ> !Detailed data: - ! lowest 3 bits (MDHINS_M): instrument - ! bit 17 (MDHUNF_M): model has - ! components with unknown flux. - ! (feature used in NCALIB) -.END !END DEFINITION -!- diff --git a/src/nscan/mdl.dsc b/src/nscan/mdl.dsc deleted file mode 100644 index e17dabf73fc604980fdb6abf61b7d7e6b8fa23e6..0000000000000000000000000000000000000000 --- a/src/nscan/mdl.dsc +++ /dev/null @@ -1,46 +0,0 @@ -!+ MDL.DSC -! WNB 900327 -! -! Revisions: -! -%REVISION=CMV=950518="Improve comment for TP" -%REVISION=WNB=931215="Add some edit formats" -%REVISION=WNB=931005="Add mask parameters" -%REVISION=JPH=930825="Comments" -%REVISION=WNB=900327="Original definition" -! -! Define Model line -! -%COMMENT="MDL.DSC defines a model line" -! -%VERSION=1 !VERSION -%SYSTEM=1 -%USER=WNB -%%DATE -%%NAME -!- -.PARAMETER - MDLCLN_M J /1/ !Clean type (TP) - MDLBEM_M J /8/ !Corrected for beam (TP) - MDLEXT_M J /1/ !Extended (BITS) - MDLQUV_M J /2/ !Q,U,V <> 0 (BITS) -! -.BEGIN=MDL - I E <E12.3> !Amplitude (Stokes I) - L E <EAF12.7> !l offset - M E <EAF12.7> !m offset - ID J !Identification - Q E <E12.4> !Q (fraction of I) - U E <E12.4> !U - V E <E12.4> !V - EXT E(0:2) <E12.4> !Extension parameters: - ! (0:1)= x:y ext, (2)= pos. angle of x (??) - SI E <E12.2> !Spectral index - RM E <E12.3> !Rotation measure - RS E !Reserved (used for Update calculations) - BITS B <XB> !Bits: bit 0= extended; bit 1= Q|U|V <>0 - TP B <XB> !Type: bit 0= clean component; bit 3= beamed - TP1 B !Selection type (0..7) - TP2 B <XB> -.END !END DEFINITION -!- diff --git a/src/nscan/mdu.dsc b/src/nscan/mdu.dsc deleted file mode 100644 index 3b3487bc6c965d2dc5c8c7fbf77870c2e3b96f2b..0000000000000000000000000000000000000000 --- a/src/nscan/mdu.dsc +++ /dev/null @@ -1,59 +0,0 @@ -!+ MDU.DSC -! WNB 950622 -! -! Revisions: -! -%REVISION=WNB=950622="Original definition" -%REVISION=WNB=950630="Add few types" -%REVISION=WNB=950706="Add LOOP" -%REVISION=WNB=990729="Add X types" -! -! Define Model update area -! -%COMMENT="MDU.DSC defines a model update area" -! -! -%VERSION=1 !VERSION -%SYSTEM=1 -%USER=WNB -%%DATE -%%NAME -!- -%ALIGN -! -.PARAMETER - MDU_T MF: \ !Update type bits: - /ILM, \ !Intensity, LM-position, - EXT, \ !Extended - SILM, \ !Spectral index, I, L, M - QUV, \ !Polarisation - LM, \ !LM-poosition - I, \ !Intensity - PEST, \ !Polarisation estimate - X00, \ !Extra type's (tbd) - X01, \ - X02, \ - X03/ -! - MDU_M MF:(2*MDU_T__H) \ !Mode bits - /CLUST, \ !Clustered sources - COMBI, \ !Combined - CONSTR, \ !Use constraints - LOOP, \ !Loop solution - ELOOP/ !Last loop - MXLCNT J /20/ !Loop count -! -.BEGIN=MDU - TYPE J !Type of update for source(s) - LEN J !Length CEQ+SOL area (bytes) - NUN J !# of unknowns per source - NSRC J !# of sources covered by area - OFF J !Offset of this source in list - OFFS J !Offset of this solution in list - LAR J <XJ,1> !Pointer to LSQ area - CEQ J <XJ,1> !Pointer to condition equation area(E) - SOL J <XJ,1> !Pointer to solution/m.e. vector(E) - MOD J <XJ,1> !Pointer to model save area (4*IFR,X) - RAR J <XJ,1> !Reference to actual solution area(MDU) -.END !END DEFINITION -!- diff --git a/src/nscan/nat.dsc b/src/nscan/nat.dsc deleted file mode 100644 index f388bde9251e8875ae54c8daac13dc0b1c15dd75..0000000000000000000000000000000000000000 --- a/src/nscan/nat.dsc +++ /dev/null @@ -1,78 +0,0 @@ -!+ NAT.DSC -! WNB 920428 -! -! Revisions: -! -%REVISION=WNB=930803="Remove .INCLUDE" -%REVISION=WNB=930405="Add IF selection" -%REVISION=WNB=921028="Add source, band, channel, average selection" -%REVISION=WNB=920428="Original version" -! -! Layout of overall include file (NAT.DEF) -! -%COMMENT="NAT.DEF is an INCLUDE file for the NATNF program" -%COMMENT=" " -! -%VERSION=1 -%SYSTEM=1 -%USER=WNB -%%DATE -%%NAME -%LOCAL=MXNLAB=256 !LABELS per job -%LOCAL=MXNJOB=16 !MAX. # OF JOBS -%LOCAL=MXNCHN=256 !MAX. # OF SELECTED CHANNELS -%LOCAL=MXNSRC=256 !MAX. # OF SELECTED SOURCES -%LOCAL=MXLSRC=16 !LENGTH SOURCE NAME -%LOCAL=MXFSRC=2048 !MAX. # OF SOURCES FOUND -%LOCAL=MXNBND=16 !MAX. # OF SELECTED BANDS -%LOCAL=MXNTEL=6 !MAX. # OF TELESCOPES -%LOCAL=MXNIFR=21 !MAX. # OF INTERFEROMETERS -%LOCAL=MXNCNT=8 !MAX. # OF CONTINUUM PAIRS -%LOCAL=MXNCN2=16 !MAKE ENTRIES -!- -.DEFINE - .PARAMETER - MXNLAB J /MXNLAB/ !MAX. LABELS PER JOB - MXNJOB J /MXNJOB/ !MAX. # OF JOBS - MXNCHN J /MXNCHN/ !MAX. # OF CHANNELS - MXNSRC J /MXNSRC/ !MAX. # OF SOURCES - MXLSRC J /MXLSRC/ !LENGTH OF SOURCE - MXFSRC J /MXFSRC/ !MAX. # OF SOURCES FOUND - MXNBND J /MXNBND/ !MAX. # OF BANDS - MXNTEL J /MXNTEL/ !MAX. # OF TELESCOPES - MXNIFR J /MXNIFR/ !MAX. # OF INTERFEROMETERS - MXNCNT J /MXNCNT/ !MAX. # OF CONTINUUM PAIRS - .DATA -! -! Local variables: -! - .COMMON - OPTION C24 !PROGRAM OPTION - OPT=OPTION C3 - UNIT C4 !INPUT UNIT - OUNIT C4 !OUTPUT UNIT - IFILE C80(0:MXNJOB) !INPUT FILE NAME - NJOB J !# OF JOBS TO DO - NLAB J(MXNJOB) !# OF LABELS TO DO - ILAB J(MXNLAB,MXNJOB) !LABELS TO DO - NSRC J(MXNJOB) !# OF SOURCES TO DO - ISRC CMXLSRC(MXNSRC,MXNJOB) !SOURCES TO DO - NBND J(MXNJOB) !# OF BANDS TO DO - IBND E(MXNBND,MXNJOB) !BANDS TO DO - NIFS J(MXNJOB) !# OF IFS TO DO - IIFS J(MXNBND,MXNJOB) !IFS TO DO - NCHN J(MXNJOB) !# OF CHANNELS TO DO - ICHN J(MXNCHN,MXNJOB) !CHANNELS TO DO - INTTIM E !INTEGRATION TIME (SEC) - INTOFF E !START OFFSET (SEC) - CONTIN J(0:MXNCN2) !CONTINUUM SELECTION - CVUTST D !UT/ST CONVERSION FACTOR - IMCA J !INPUT MCA/FCA - FCAOUT J !OUTPUT FCA - NODOUT C80 !OUTPUT NODE - FCAIN J !INPUT FCA - SGPH J(0:7) !SUB-GROUP POINTER - SGNR J(0:7) !SUB-GROUP NUMBER - NFSRC J !# OF SOURCES FOUND - FSRC CMXLSRC(MXFSRC) !SOURCES FOUND -.END diff --git a/src/nscan/nat.grp b/src/nscan/nat.grp deleted file mode 100644 index a7730e0defe42e5bbbdf1afdd918f3a79d40713a..0000000000000000000000000000000000000000 --- a/src/nscan/nat.grp +++ /dev/null @@ -1,58 +0,0 @@ -!+ NAT.GRP -! WNB 920428 -! -! Revisions: -! WNB 921211 Change PEF/PSC -! -! RPFITS handling -! -! Group definition: -! -NAT.GRP -! -! Command files -! -! -! PIN files -! -NATNF.PSC -! -! Structure files -! -RPF.DSC -! -! Fortran definition files: -! -NAT.DSC ! Program common/parameters -! NAT.DEF ! Fortran include -! NAT.INC ! C include -! -! Programs: -! -NATNF.FOR ! Main routine -NATDAT.FOR !NATDAT Get program data -NATINI.FOR !NATINI Initialise program -NATLOD.FOR !NATLOD Load RPFITS data in SCN file -NATLRD.FOR !NATLRD Read data to temp. file -NATLWD.FOR !NATLWD Write data to SCN file -NATRGP.FOR !NATRGP Read header data -NATRIF.FOR !NATRIF Read IF table - !NATRSU Read SU table - !NATRFG Read FG table - !NATRAN Read AN table - !NATRMT Read MT table - !NATRCU Read CU table -NATRPF.FOR !NATRPO Read first header RPFITS file - !NATRPH Read RPFITS header - !NATRPD Read RPFITS visibility data -NATRRT.FOR !NATRRT Read RPFITS table -NATXCJ.FOR !NATXCJ Convert J from VAX to local - !NATXCE Convert E from VAX to local -NATXIB.FOR !NATXIB Test illegal baseline -NATXSF.FOR !NATXSF Test if start ("SIMPLE") or FG Table -NATXST.FOR !NATXST Skip through till known data -! -! Executables -! -NATNF.EXE ! RPFITS handling -!- diff --git a/src/nscan/natdat.for b/src/nscan/natdat.for deleted file mode 100644 index 2746ab79613276ded820403e07aa777e18f73414..0000000000000000000000000000000000000000 --- a/src/nscan/natdat.for +++ /dev/null @@ -1,298 +0,0 @@ -C+ NATDAT.FOR -C WNB 920428 -C -C Revisions: -C WNB 921028 Add SOURCES, BANDS, CHANNELS, INTEGRATION -C WNB 921104 Some ease of use if files -C WNB 921123 Add Continuum and start time -C HjV 930423 Change name of some keywords -C CMV 940808 Add call to WNFMLI to list tape definitions -C CMV 940926 Close old file before asking new one -C HjV 941128 Initialize NIFS to select all interf. Until now -C they are not asked anywhere but tested in NATLOD.FOR -C - SUBROUTINE NATDAT -C -C Get NATNF program parameters -C -C Result: -C -C CALL NATDAT will ask and set all program parameters -C -C PIN references: -C -C OPTION -C INPUT_UNIT -C INPUT_FILE -C INPUT_LABELS -C INPUT_SOURCES -C INPUT_BANDS -C INPUT_CHANNELS -C INTEGRATION_TIME -C START_OFFSET -C CONTINUUM -C OUTPUT_SCN_NODE -C -C Include files: -C - INCLUDE 'WNG_DEF' - INCLUDE 'NAT_DEF' -C -C Parameters: -C -C -C Arguments: -C -C -C Function references: -C - LOGICAL WNDPAR !GET DWARF PARAMETER - LOGICAL WNDNOD !GET NODE NAME - LOGICAL WNFMOU !MOUNT TAPE - LOGICAL WNFOP !OPEN FILE - CHARACTER*80 WNFTVL !GET VOLUME HEADER -C -C Data declarations: -C - CHARACTER*80 VOLHD !VOLUME HEADER - CHARACTER*160 FILOUT !OUTPUT FILE NAME -C- -C -C SET DEFAULTS -C - UNIT='""' - IFILE(0)='""' - NODOUT=' ' - NLAB(1)=0 - NSRC(1)=0 - NBND(1)=0 - NCHN(1)=0 - NFSRC=0 -C -C GET INTERFEROMETERS -C Until now (941128) there wasn't a question to specify which -C interferometers one wants to use, so assume * (which gives value -1) -C See NATLOD.FOR: IF (NIFS(I1).GE.0) THEN -C - DO I=1,MXNIFR - NIFS(I)=-1 - END DO -C -C GET OPTION -C - 100 CONTINUE - IF (.NOT.WNDPAR('OPTION',OPTION,LEN(OPTION),J0,'QUIT')) THEN - OPTION='QUIT' !ASSUME END - ELSE IF (J0.LE.0) THEN - OPTION='QUIT' !ASSUME END - END IF -C -C LOAD RPFITS -C - IF (OPT.EQ.'LOA') THEN !LOAD RPFITS - 10 CONTINUE - IF (.NOT.WNDPAR('INPUT_UNIT',UNIT,LEN(UNIT),J0,UNIT)) THEN !GET UNIT - IF (E_C.EQ.DWC_ENDOFLOOP) GOTO 100 !RETRY OPTION - GOTO 10 !REPEAT - ELSE IF (E_C.EQ.DWC_WILDCARD) THEN !LIST TAPEUNITS AND RETRY - CALL WNFMLI() - GOTO 10 - ELSE IF (J0.EQ.0) THEN - GOTO 100 !RETRY OPTION - ELSE IF (J0.LT.0) THEN - GOTO 10 !MUST SPECIFY - END IF - IF (UNIT.EQ.'D') THEN !DISK INPUT - 11 CONTINUE - IF (.NOT.WNDPAR('INPUT_FILE',IFILE(0),LEN(IFILE(0)), - 1 J0,IFILE(0))) THEN - IF (E_C.EQ.DWC_ENDOFLOOP) GOTO 10 !RETRY UNIT - GOTO 11 !REPEAT - ELSE IF (J0.EQ.0) THEN - GOTO 10 !RETRY UNIT - ELSE IF (J0.LT.0) THEN - GOTO 11 !MUST SPECIFY - END IF - ELSE !TAPE INPUT - IF (.NOT.WNFMOU(IMCA,UNIT,'R')) THEN !MOUNT TAPE - CALL WNCTXT(F_TP,'Cannot mount tape on unit !AS (!XJ)' - 1 ,UNIT,E_C) - GOTO 10 !RETRY UNIT - END IF - VOLHD=WNFTVL(IMCA) !GET VOLUME HEADER - IF (VOLHD(1:4).EQ.'VOL1') THEN - CALL WNCTXT(F_TP,'!/Volume !AS mounted on unit !AS!/', - 1 VOLHD(5:10),UNIT) - ELSE - CALL WNCTXT(F_TP,'!/Unlabeled tape mounted on unit !AS!/', - 1 UNIT) - END IF - END IF - 30 CONTINUE - CALL WNFCL(FCAOUT) - IF (.NOT.WNDNOD('OUTPUT_SCN_NODE',NODOUT,'SCN','U',NODOUT, - 1 FILOUT)) THEN - IF (E_C.EQ.DWC_ENDOFLOOP) GOTO 10 !RETRY UNIT - GOTO 30 !REPEAT - ELSE IF (E_C.EQ.DWC_NULLVALUE) THEN - GOTO 10 !RETRY UNIT - ELSE IF (E_C.EQ.DWC_WILDCARD) THEN - GOTO 30 !MUST SPECIFY - END IF - IF (.NOT.WNFOP(FCAOUT,FILOUT,'U')) THEN !OPEN OUTPUT SCAN FILE - GOTO 30 !RETRY - END IF -C -C GET INTEGRATION TIME -C - 23 CONTINUE - IF (.NOT.WNDPAR('INTEGRATION_TIME',INTTIM,LB_E, - 1 J0,'60.')) THEN - IF (E_C.EQ.DWC_ENDOFLOOP) GOTO 10 !RETRY JOB - GOTO 23 !RETRY - END IF - IF (J0.EQ.0) GOTO 10 !RETRY JOB - IF (J0.LT.0) INTTIM=60. !DEFAULT -C -C GET START TIME -C - 24 CONTINUE - IF (.NOT.WNDPAR('START_OFFSET',INTOFF,LB_E, - 1 J0,'0.')) THEN - IF (E_C.EQ.DWC_ENDOFLOOP) GOTO 23 !RETRY JOB - GOTO 24 !RETRY - END IF - IF (J0.EQ.0) GOTO 23 !RETRY JOB - IF (J0.LT.0) INTOFF=0. !DEFAULT -C -C GET CONTINUUM DEFINITION -C - 25 CONTINUE - IF (.NOT.WNDPAR('CONTINUUM',CONTIN(1),MXNCNT*2*LB_J, - 1 CONTIN(0),'*')) THEN - IF (E_C.EQ.DWC_ENDOFLOOP) GOTO 23 !RETRY JOB - GOTO 25 !RETRY - END IF -C -C GET JOBS -C - NJOB=0 !# OF JOBS - 15 CONTINUE - IF (NJOB.GE.MXNJOB) GOTO 900 !NO MORE - NJOB=NJOB+1 - IFILE(NJOB)=IFILE(NJOB-1) !COPY FILE NAME - CALL WNCTXT(F_TP,'!/Specify parameters for job !UJ\:!/',NJOB) - 14 CONTINUE - IF (UNIT.EQ.'D' .AND. INDEX(IFILE(NJOB),'.').GT.0) THEN !EXTENSION - IF (NJOB.EQ.1) THEN - JS=WNDPAR('INPUT_FILE',IFILE(NJOB),LEN(IFILE(NJOB)), - 1 J0,IFILE(NJOB)) - ELSE - JS=WNDPAR('INPUT_FILE',IFILE(NJOB),LEN(IFILE(NJOB)), - 1 J0,'""') - END IF - IF (.NOT.JS) THEN - IF (E_C.EQ.DWC_ENDOFLOOP) THEN - NJOB=NJOB-1 !NO MORE JOBS - GOTO 900 - END IF - GOTO 14 !REPEAT - ELSE IF (J0.EQ.0) THEN - NJOB=NJOB-1 !NO MORE JOBS - GOTO 900 - ELSE IF (J0.LT.0) THEN - GOTO 14 !MUST SPECIFY - END IF - END IF - IF (UNIT.NE.'D' .OR. INDEX(IFILE(NJOB),'.').EQ.0) THEN !NO EXT. - IF (NLAB(NJOB).LE.0) THEN !DEFAULTS - IF (NJOB.EQ.1) THEN - JS=WNDPAR('INPUT_LABELS',ILAB(1,NJOB), - 1 MXNLAB*LB_J,NLAB(NJOB),'*') - ELSE - JS=WNDPAR('INPUT_LABELS',ILAB(1,NJOB), - 1 MXNLAB*LB_J,NLAB(NJOB),'""') - END IF - ELSE - JS=WNDPAR('INPUT_LABELS',ILAB(1,NJOB), - 1 MXNLAB*LB_J,NLAB(NJOB), - 1 A_B(-A_OB),ILAB(1,NJOB),NLAB(NJOB)) - END IF - IF (.NOT.JS) THEN - IF (E_C.EQ.DWC_ENDOFLOOP) THEN !READY - NJOB=NJOB-1 !NO MORE JOBS - GOTO 900 - END IF - GOTO 14 !RETRY - END IF - IF (NLAB(NJOB).EQ.0) THEN !READY - NJOB=NJOB-1 - GOTO 900 - END IF - IF (NJOB.LT.MXNJOB) THEN !DEFAULTS FOR NEXT - NLAB(NJOB+1)=0 - NSRC(NJOB+1)=0 - NCHN(NJOB+1)=0 - NBND(NJOB+1)=0 - END IF - END IF -C -C GET SOURCES -C - 20 CONTINUE - IF (NSRC(NJOB).LE.0) THEN !DEFAULTS - JS=WNDPAR('INPUT_SOURCES',ISRC(1,NJOB),MXNSRC*MXLSRC, - 1 NSRC(NJOB),'*') - ELSE - JS=WNDPAR('INPUT_SOURCES',ISRC(1,NJOB),MXNSRC*MXLSRC, - 1 NSRC(NJOB),A_B(-A_OB),ISRC(1,NJOB),NSRC(NJOB)) - END IF - IF (.NOT.JS) THEN - IF (E_C.EQ.DWC_ENDOFLOOP) GOTO 14 !RETRY JOB - GOTO 20 !RETRY - END IF - IF (NSRC(NJOB).EQ.0) GOTO 14 !RETRY JOB -C -C GET BANDS -C - 21 CONTINUE - IF (NBND(NJOB).LE.0) THEN !DEFAULTS - JS=WNDPAR('INPUT_BANDS',IBND(1,NJOB),MXNBND*LB_E, - 1 NBND(NJOB),'*') - ELSE - JS=WNDPAR('INPUT_BANDS',IBND(1,NJOB),MXNBND*LB_E, - 1 NBND(NJOB),A_B(-A_OB),IBND(1,NJOB),NBND(NJOB)) - END IF - IF (.NOT.JS) THEN - IF (E_C.EQ.DWC_ENDOFLOOP) GOTO 14 !RETRY JOB - GOTO 21 !RETRY - END IF - IF (NBND(NJOB).EQ.0) GOTO 14 !RETRY JOB -C -C GET CHANNELS -C - 22 CONTINUE - IF (NCHN(NJOB).LE.0) THEN !DEFAULTS - JS=WNDPAR('INPUT_CHANNELS',ICHN(1,NJOB),MXNCHN*LB_J, - 1 NCHN(NJOB),'*') - ELSE - JS=WNDPAR('INPUT_CHANNELS',ICHN(1,NJOB),MXNCHN*LB_J, - 1 NCHN(NJOB),A_B(-A_OB),ICHN(1,NJOB),NCHN(NJOB)) - END IF - IF (.NOT.JS) THEN - IF (E_C.EQ.DWC_ENDOFLOOP) GOTO 14 !RETRY JOB - GOTO 22 !RETRY - END IF - IF (NCHN(NJOB).EQ.0) GOTO 14 !RETRY JOB -C -C MORE JOBS -C - GOTO 15 !MORE JOBS - END IF -C - - 900 CONTINUE - RETURN !READY -C -C - END diff --git a/src/nscan/natini.for b/src/nscan/natini.for deleted file mode 100644 index f763490fb56eca0cd21102e837c9c999b98e9c74..0000000000000000000000000000000000000000 --- a/src/nscan/natini.for +++ /dev/null @@ -1,53 +0,0 @@ -c+ NATINI.FOR -C WNB 920428 -C -C Revisions: -C - SUBROUTINE NATINI -C -C Initialize NATNF program -C -C Result: -C -C CALL NATINI will set header lines, logging, DWARF interface -C -C Include files: -C - INCLUDE 'WNG_DEF' - INCLUDE 'NAT_DEF' -C -C Parameters: -C -C -C Arguments: -C -C -C Function references: -C - LOGICAL WNDINI !INIT DWARF - LOGICAL WNDDAB !OPEN DATABASE -C -C Data declarations: -C -C- -C -C SET HEADER LINES -C - CALL WNCFHD(F_P,1,'!40C\Program to handle RPFITS files') -C -C START DWARF -C - IF (.NOT.WNDINI(PRGNAM)) CALL WNGEX !EXIT IF NO DWARF START -C -C LOGGING -C - CALL WNDLOG(LOGCD) !PROPER LOGGING -C -C DATABASE -C - IF (.NOT.WNDDAB()) CALL WNGEX !OPEN DATABASE -C - RETURN !READY -C -C - END diff --git a/src/nscan/natlod.for b/src/nscan/natlod.for deleted file mode 100644 index 8a53c1f22f5fdced7551a03e1608517cef02b818..0000000000000000000000000000000000000000 --- a/src/nscan/natlod.for +++ /dev/null @@ -1,237 +0,0 @@ -C+ NATLOD.FOR -C WNB 920506 -C -C Revisions: -C WNB 921028 Add selections -C WNB 921125 More selections -C WNB 930405 Add IF selection -C WNB 930819 Remove STH -C CMV 931220 Changed parameters of call to NSCPFL -C - SUBROUTINE NATLOD -C -C Load ATNF WSRT data into SCN file -C -C Result: -C -C CALL NATLOD will load ATNF data in SCN file -C -C Include files: -C - INCLUDE 'WNG_DEF' - INCLUDE 'NAT_DEF' - INCLUDE 'RPF_DEF' !RPFITS DATA - INCLUDE 'GFH_O_DEF' !GENERAL FILE HEADER - INCLUDE 'SGH_O_DEF' !SUB-GROUP HEADER -C -C Parameters: -C -C -C Arguments: -C -C -C Function references: -C - LOGICAL WNFOP,WNFOPF !OPEN FILE - LOGICAL WNFRD !READ DATA - LOGICAL WNFWR !WRITE DATA - INTEGER WNFEOF !FILE POSITION - DOUBLE PRECISION WNGDNF !NORM. ANGLE - INTEGER WNCALN !STRING LENGTH - LOGICAL WNDLNG !LINK SUB-GROUP - LOGICAL WNGGVM !GET MEMORY - LOGICAL NATRPO !READ FIRST HEADER - LOGICAL NATRPH !READ NEXT HEADER -C -C Data declarations: -C - INTEGER FCAPT !INPUT FILE POINTER - CHARACTER*6 LTXT !LABEL NAME - INTEGER FCAT !TMP FILE DESCRIPTOR - INTEGER TAB(MAX_SU,MAX_IF,0:10) !TMP DATA - REAL TABE(MAX_SU,MAX_IF,0:10) - EQUIVALENCE (TAB,TABE) - LOGICAL FILLED !DATA READ IN BUFFER - INTEGER IFRS !INTERFEROMETERS SEEN - INTEGER VISP,BUFP !DATA BUFFER PTRS -C- -C -C INIT -C - IF (.NOT.WNFOP(FCAT,'NSCAN.TMP','WT')) THEN !OPEN TMP FILE - CALL WNCTXT(F_TP,'Cannot open TMP file (!XJ)',E_C) - GOTO 900 - END IF - J1=0 !JOB COUNT - 30 CONTINUE - J1=J1+1 !NEXT JOB - IF (J1.GT.NJOB) GOTO 900 !READY - J=0 !START LABEL INPUT - IF (.NOT.WNDLNG(GFH_LINKG_1,0,SGH_GROUPN_1,FCAOUT,SGPH(0), - 1 SGNR(0))) THEN - CALL WNCTXT(F_TP,'!/Cannot create sub-group') - GOTO 800 !NEXT JOB - END IF !SUB-GROUP LINKED - CALL WNCTXT(F_P,'!_') !NEW PAGE - CALL WNCTXT(F_TP,'!/Job !UJ\: Group !UJ',J1,SGNR(0)) -C -C DO A LABEL -C - 10 CONTINUE - J=J+1 !COUNT INPUT LABEL - IF (NLAB(J1).LT.0) THEN !ALL LABELS ON TAPE - J0=J !NEXT INPUT LABEL - ELSE IF (J.LE.NLAB(J1)) THEN - J0=ILAB(J,J1) !NEXT INPUT LABEL - ELSE - GOTO 800 !READY WITH JOB - END IF -C -C OPEN INPUT -C - IF (UNIT.EQ.'D') THEN !DISK INPUT - IF (INDEX(IFILE(J1),'.').EQ.0) THEN !NO EXT. - CALL WNCTXS(LTXT,'!6$ZJ',J0) !MAKE LABEL NAME - IF (.NOT.WNFOP(IMCA,IFILE(J1)(1:WNCALN(IFILE(J1))) - 1 //'.'//LTXT,'R')) THEN - CALL WNCTXT(F_TP,'Cannot find file !AS\.!AS', - 1 IFILE(J1),LTXT) - GOTO 800 !STOP JOB - END IF - ELSE - IF (.NOT.WNFOP(IMCA,IFILE(J1)(1:WNCALN(IFILE(J1))), - 1 'R')) THEN - CALL WNCTXT(F_TP,'Cannot find file !AS', - 1 IFILE(J1)) - GOTO 800 !STOP JOB - END IF - END IF - ELSE !TAPE INPUT - IF (.NOT.WNFOPF(IMCA,' ','R',0,0,0,J0)) THEN - CALL WNCTXT(F_TP,'!/Cannot find label !UJ',J0) - GOTO 800 !NEXT JOB - END IF - END IF -C -C READ FIRST HEADER AND TABLES -C - 20 CONTINUE - IF (.NOT.NATRPO(IMCA,FCAPT)) THEN !READ HEADER - CALL WNCTXT(F_TP,'Read error header at !XJ',FCAPT) - GOTO 700 !NEXT LABEL - END IF -C -C GET POLARISATIONS TO DO -C - 21 CONTINUE -C -C CHECK SELECTION -C - J2=0 !NO BANDS - DO I=1,N_IF !BANDS - TAB(1,I,8)=0 !NOT SELECT - IF (NIFS(J1).GE.0) THEN !MUST CHECK FOR IF - DO I1=1,NIFS(J1) - IF (IIFS(I1,J1).EQ.I) THEN - TAB(1,I,8)=1 !CHECK THIS ONE FOR BAND - END IF - END DO - ELSE - TAB(1,I,8)=1 !CHECK THIS ONE FOR BAND - END IF - IF (TAB(1,I,8).NE.0) THEN !COULD WANT THIS IF - TAB(1,I,8)=0 !ASSUME NOT - IF (NBND(J1).GE.0) THEN !MUST CHECK - DO I1=1,NBND(J1) - IF (ABS(LOG(DCL*100./IF_FREQ(I)/IBND(I1,J1))/LOG(2D0)) - 1 .LE.0.5) THEN !FOUND SELECTION - J2=J2+1 - TAB(1,I,8)=1 - END IF - END DO - ELSE - TAB(1,I,8)=1 !SELECT - J2=J2+1 - END IF - END IF - END DO - J3=0 !NONE SELECTED - DO I=1,N_SU !SOURCES - TAB(I,1,9)=0 !NOT SELECTED - IF (NSRC(J1).GE.0) THEN !MUST CHECK - DO I1=1,NSRC(J1) - I2=WNCALN(ISRC(I1,J1)) !LENGTH CHECK NAME - IF (ISRC(I1,J1)(1:I2).EQ.SU_NAME(I)(1:I2)) THEN - J3=J3+1 !COUNT - TAB(I,1,9)=1 !SET SELECTED - END IF - END DO - ELSE - J3=J3+1 !COUNT - TAB(I,1,9)=1 !SET SELECTED - END IF - END DO - IF (J2.EQ.0 .OR. J3.EQ.0) GOTO 50 !NOTHING SELECTED -C -C READ DATA IN TMP -C - I0=1 !FREQ. CHANNELS - I1=1 !POL. - DO I=1,N_IF - I0=MAX(I0,IF_NFREQ(I)) - I1=MAX(I1,IF_NSTOK(I)) - END DO - IF (.NOT.WNGGVM(LB_X*I0*I1,VISP)) THEN !VIS. BUFFER - 41 CONTINUE - CALL WNCTXT(F_TP,'No memory for visibility buffers') - CALL WNGEX !STOP - END IF - IF (.NOT.WNGGVM(MXNIFR*LB_X*I0*I1,BUFP)) GOTO 41 !TIME SLICE BUFFER - FILLED=.FALSE. !NO DATA YET - 40 CONTINUE - CALL NATLRD(IMCA,FCAPT,FCAT,TAB,TABE,FILLED,IFRS,VISP,BUFP) !READ -C -C MAKE SCN FILE -C - IFRS=IAND(IFRS,NOT('148841'X)) !DELETE AUTO CORRELATIONS - CALL NATLWD(FCAT,TAB,TABE,BUFP,IFRS,J1) !WRITE SCN FILE AND HEADERS - IF (FILLED) GOTO 40 !MORE DATA - CALL WNGFVM(LB_X*I0*I1,VISP) !FREE MEMORY BUFFERS - CALL WNGFVM(MXNIFR*LB_X*I0*I1,BUFP) -C -C MORE HEADERS -C - 50 CONTINUE - IF (NATRPH(IMCA,FCAPT)) GOTO 21 !NEXT HEADER - IF (E_C.NE.3) THEN !NOT EOF - IF (NATRPH(IMCA,FCAPT)) GOTO 21 !LOOK AGAIN - END IF -C -C FINISH HEADER -C - 600 CONTINUE -C -C FINISH LABEL -C - 700 CONTINUE - CALL WNFCL(IMCA) !CLOSE LABEL - GOTO 10 !NEXT LABEL -C -C FINISH JOB -C - 800 CONTINUE - GOTO 30 !NEXT JOB -C -C READY -C - 900 CALL WNFCL(IMCA) !CLOSE INPUT - CALL WNFDMO(IMCA) !DISMOUNT INPUT - CALL WNFCL(FCAT) !CLOSE/DELETE TMP FILE - CALL NSCPFH(F_TP,FCAOUT) !SHOW FILE HEADER - CALL NSCPFL(F_TP,FCAOUT,NODOUT,.FALSE.) !SHOW LAYOUT - CALL WNFCL(FCAOUT) !CLOSE OUTPUT -C - RETURN !READY -C -C - END diff --git a/src/nscan/natlrd.for b/src/nscan/natlrd.for deleted file mode 100644 index 02d2106a7205e363780a7a3e46fb3898cceab4c0..0000000000000000000000000000000000000000 --- a/src/nscan/natlrd.for +++ /dev/null @@ -1,212 +0,0 @@ -C+ NATLRD.FOR -C WNB 920514 -C -C Revisions: -C WNB 921110 Typo in input ptr -C WNB 921124 Add FLAG -C WNB 921125 Change FLAG; limit scan length -C WNB 930406 Multiple source/IF correction; tape error handling -C WNB 930407 Correct HA -C WNB 930414 Correct HA -C - SUBROUTINE NATLRD(FCA,FCAPT,FCAT,TAB,TABE,FILLED,IFRS,VISP,BUFP) -C -C Read ATNF data into TMP file -C -C Result: -C -C CALL NATLRD( FCA_J:I, FCAPT_J:IO, FCAT_J:I, TAB_J(MAX_SU,MAX_IF,0:*):O, -C TABE_E(MAX_SU,MAX_IF,0:*):O, -C FILLED_L:IO, IFRS_J:O, VISP_J:I, BUFP_J:I) -C Will load ATNF data into TMP file, reading from -C FCA into FCATMP. Detailing the output in TAB: -C 0: COUNT -C 1: START UT(E) -C 2: DUT(E) -C 3: FIRST TMP POINTER -C 4: CURRENT UT -C 5: PREVIOUS TMP POINTER (OR -1) -C 6: START HA -C 7: CURRENT INTERFEROMETERS -C 8: SELECT IF -C 9: SELECT SOURCE -C and using the visibility and time slice array -C ptrs VISP and WGTP. If FILLED, already data in -C buf. -C IFRS gives the interferometers found. -C -C Include files: -C - INCLUDE 'WNG_DEF' - INCLUDE 'NAT_DEF' - INCLUDE 'RPF_DEF' !RPFITS DATA -C -C Parameters: -C -C -C Arguments: -C - INTEGER FCA !INPUT FILE - INTEGER FCAPT !INPUT FILE PTR - INTEGER FCAT !OUTPUT FILE - INTEGER TAB(MAX_SU,MAX_IF,0:*) !DESCRIPTION TABLE - REAL TABE(MAX_SU,MAX_IF,0:*) - LOGICAL FILLED !INDICATE READ STATUS - INTEGER IFRS !INTERFEROMETERS SEEN - INTEGER VISP !VISIBILITY ARRAY PTR - INTEGER BUFP !TIME SLICE ARRAY PTR -C -C Function references: -C - LOGICAL WNFWR !WRITE DATA - LOGICAL NATRPD !READ DATA -C -C Data declarations: -C - LOGICAL LAST,FIRST !LAST DATA - INTEGER CSRCNO,CIFNO !CURRENT ID - INTEGER DATJ(0:9) !DATA AREA - REAL DATE(0:9) - EQUIVALENCE (DATJ,DATE) - INTEGER LDAT !LINK DATA - EQUIVALENCE (LDAT,DATJ(0)) - INTEGER BAS !BASELINE CODE - EQUIVALENCE (BAS,DATJ(1)) - REAL UT,U,V,W !COORDINATES - EQUIVALENCE (UT,DATE(2)),(U,DATE(3)),(V,DATE(4)),(W,DATE(5)) - INTEGER FLAG !FLAG DATA - EQUIVALENCE (FLAG,DATJ(6)) - INTEGER BIN !PULSAR BIN - EQUIVALENCE (BIN,DATJ(7)) - INTEGER IFNO !IF - EQUIVALENCE (IFNO,DATJ(8)) - INTEGER SRCNO !SOURCE - EQUIVALENCE (SRCNO,DATJ(9)) -C -C Common: -C - COMMON /RPDLOC/ DATJ -C- -C -C INIT -C - DO I=1,MAX_IF - DO I1=1,MAX_SU - TAB(I1,I,0)=0 !PREPARE TABLE - END DO - END DO - J0=0 !TMP FILE PTR - IFRS=0 !NO INTERFEROMETERS - LAST=.FALSE. !NOT LAST - CSRCNO=-1 !CURRENT DATA - CIFNO=-1 -C -C READ DATA -C - 10 CONTINUE - IF (.NOT.FILLED) THEN !NO DATA YET - IF (.NOT.NATRPD(FCA,FCAPT,A_B(VISP-A_OB), - 1 BAS,UT,U,V,W,FLAG,BIN,IFNO,SRCNO)) THEN - LAST=.TRUE. - ELSE - IF (BAS.GT.0 .AND. FLAG.NE.0) !ZERO BAD DATA - 1 CALL WNGMVZ(LB_X*IF_NSTOK(IFNO)*IF_NFREQ(IFNO), - 1 A_B(VISP-A_OB)) - END IF - END IF - FILLED=.FALSE. !ASSUME NOT FILLED - IF (LAST) GOTO 12 !NO MORE - IF (BAS.LE.0) GOTO 10 !SKIP SPECIAL - IF (TAB(1,IFNO,8).EQ.0) GOTO 10 !IF NOT SELECTED - IF (TAB(SRCNO,1,9).EQ.0) GOTO 10 !SOURCE NOT SELECTED -C -C FILL TABLE -C - FIRST=.TRUE. !ASSUME NEW BUFFER - IF (TAB(SRCNO,IFNO,0).EQ.0) THEN !FIRST DATA - TABE(SRCNO,IFNO,1)=UT !SAVE UT - TAB(SRCNO,IFNO,0)=1 !COUNT - TAB(SRCNO,IFNO,5)=-1 !FIRST DISK BLOCK - TABE(SRCNO,IFNO,6)=ATAN2(REAL(V*SIN(SU_DEC(SRCNO))- - 1 W*COS(SU_DEC(SRCNO))),U) !GET HA - TAB(SRCNO,IFNO,7)=0 !CURRENT IFRS - ELSE IF (UT.EQ.TABE(SRCNO,IFNO,4)) THEN !SAME UT - FIRST=.FALSE. !MORE IN SAME BUFFER - ELSE IF (TAB(SRCNO,IFNO,0).EQ.1) THEN !NEXT DATA - R0=UT-TABE(SRCNO,IFNO,1) !DUT - IF (R0.LT.0) R0=R0+24.*3600. !CORRECT - TABE(SRCNO,IFNO,2)=R0 !SAVE DUT - TAB(SRCNO,IFNO,0)=2 !COUNT - ELSE - R0=UT-TABE(SRCNO,IFNO,1) !DUT - IF (R0.LT.0) R0=R0+24.*3600. !CORRECT - IF (ABS(R0-TABE(SRCNO,IFNO,2)*NINT(R0/TABE(SRCNO,IFNO,2))).GT. - 1 0.01 .OR. - 1 TAB(SRCNO,IFNO,0).GE.360) THEN !NEW START - FILLED=.TRUE. - ELSE - TAB(SRCNO,IFNO,0)=TAB(SRCNO,IFNO,0)+1 !COUNT TIME - END IF - END IF - TABE(SRCNO,IFNO,4)=UT !CURRENT UT -C -C WRITE PREVIOUS -C - 12 CONTINUE - IF (LAST .OR. FILLED .OR. FIRST) THEN !WRITE PREVIOUS - IF (CSRCNO.GT.0 .AND. CIFNO.GT.0) THEN !SOME PRESENT - IF (TAB(CSRCNO,CIFNO,0).GT.0) THEN - LDAT=0 !LAST LINK - IF (TAB(CSRCNO,CIFNO,5).NE.-1) THEN !NOT FIRST - IF (.NOT.WNFWR(FCAT,LB_J,J0,TAB(CSRCNO,CIFNO,5))) GOTO 11 !LINK - ELSE - TAB(CSRCNO,CIFNO,3)=J0 !FIRST DISK POINTER - END IF - TAB(CSRCNO,CIFNO,5)=J0 - IF (.NOT.WNFWR(FCAT,LB_J,LDAT,J0)) GOTO 11 !WRITE LINK - J0=J0+LB_J - IF (.NOT.WNFWR(FCAT,LB_J,TAB(CSRCNO,CIFNO,7),J0)) GOTO 11 !IFRS - J0=J0+LB_J - IF (.NOT.WNFWR(FCAT, - 1 LB_X*MXNIFR*IF_NFREQ(CIFNO)*IF_NSTOK(CIFNO), - 1 A_B(BUFP-A_OB),J0)) THEN !WRITE DATA - 11 CONTINUE - CALL WNCTXT(F_TP,'Error writing TMP scan file') - CALL WNGEX !STOP - END IF - J0=J0+LB_X*MXNIFR*IF_NFREQ(CIFNO)*IF_NSTOK(CIFNO) !TMP PTR - END IF - END IF - END IF -C -C FILL BUFFER -C - IF (.NOT.LAST .AND. .NOT.FILLED) THEN - I=MOD(BAS,256) !TELESCOPES - I1=BAS/256 - IF (I.LE.I1) THEN - I=I1-(I*(I-13)+14)/2 !IFR PTR - ELSE - I=I-(I1*(I1-13)+14)/2 !IFR PTR - END IF - IF (I.GE.0 .AND. I.LT.31) THEN - IFRS=IOR(IFRS,2**I) !SET SEEN - TAB(SRCNO,IFNO,7)=IOR(TAB(SRCNO,IFNO,7),2**I) !SET SEEN - END IF - DO I1=0,IF_NFREQ(IFNO)-1 !FILL BUFFER - J2=(BUFP-A_OB)/LB_E+(I1*MXNIFR+I)*IF_NSTOK(IFNO)*LB_X/LB_E !PTR - J1=(VISP-A_OB)/LB_E+I1*IF_NSTOK(IFNO)*LB_X/LB_E !INPUT PTR - DO I2=0,(LB_X/LB_E)*IF_NSTOK(IFNO)-1 - A_E(J2+I2)=A_E(J1+I2) - END DO - END DO - CSRCNO=SRCNO !SAVE CURRENT ID - CIFNO=IFNO - GOTO 10 !MORE DATA - END IF -C - 900 CONTINUE - RETURN !READY -C -C - END diff --git a/src/nscan/natlwd.for b/src/nscan/natlwd.for deleted file mode 100644 index b296f0092649a426b157ebeb2de911f6650e2ffa..0000000000000000000000000000000000000000 --- a/src/nscan/natlwd.for +++ /dev/null @@ -1,468 +0,0 @@ -C+ NATLWD.FOR -C WNB 920514 -C -C Revisions: -C WNB 921028 Correct MJD and selection, integration -C WNB 921102 Correct integration -C WNB 921104 Add UT= -C WNB 921110 Typo in UT= -C WNB 921123 Add Continuum and offset -C WNB 921124 Better continuum; add invert; flagging -C WNB 921125 Limit integration -C WNB 921210 Change invert sign -C WNB 921222 Add PANG -C WNB 930407 Change HA and phase direction -C WNB 930414 Change HAV; sign phase; cater for no data -C WNB 930819 Add DIPC -C - SUBROUTINE NATLWD(FCAT,TAB,TABE,BUFP,IFRS,CJOB) -C -C Write ATNF data into SCN file -C -C Result: -C -C CALL NATLWD( FCAT_J:I, TAB_J(MAX_SU,MAX_IF,0:*):O, -C TABE_E(MAX_SU,MAX_IF,0:*):O, BUFP_J:I, -C IFRS_J:I, CJOB_J:I) -C Will load ATNF data into SCN file, reading from -C FCAT for IFRS encountered. -C CJOB is the current job. -C BUFP points to a usable buffer -C TAB: -C 0: COUNT -C 1: START UT(E) -C 2: DUT(E) -C 3: FIRST TMP POINTER -C 4: CURRENT UT -C 5: PREVIOUS TMP POINTER (OR -1) -C 6: START HA (RAD.) -C 7: IFRS -C 8: SELECT IF -C 9: SELECT SOURCE -C -C Include files: -C - INCLUDE 'WNG_DEF' - INCLUDE 'NAT_DEF' - INCLUDE 'RPF_DEF' !RPFITS DATA - INCLUDE 'GFH_O_DEF' !GENERAL FILE HEADER - INCLUDE 'SGH_O_DEF' !SUB-GROUP HEADER - INCLUDE 'STH_O_DEF' !SET HEADER - INCLUDE 'SCH_O_DEF' !SCAN HEADER -C -C Parameters: -C -C -C Arguments: -C - INTEGER FCAT !INPUT FILE - INTEGER TAB(MAX_SU,MAX_IF,0:*) !DESCRIPTION TABLE - REAL TABE(MAX_SU,MAX_IF,0:*) - INTEGER BUFP !A USABLE BUFFER - INTEGER IFRS !INTERFEROMETERS SEEN - INTEGER CJOB !CURRENT JOB -C -C Function references: -C - INTEGER WNCALN !STRING LENGTH - LOGICAL WNFRD !READ DATA - LOGICAL WNFWR !WRITE DATA - INTEGER WNFEOF !FILE POSITION - LOGICAL WNDLNG,WNDLNF,WNDLNK !LINK SUB-GROUP - REAL WNGENF !NORMALIZE ANGLE - INTEGER WNMEJF !FLOOR -C -C Data declarations: -C - INTEGER*2 IFRT(0:STHIFR-1) !INTERFEROMETER TABLE - INTEGER MONTH(12) !DAYS IN MONTH - DATA MONTH/31,28,31,30,31,30,31,31,30,31,30,31/ - INTEGER PX(0:3) !POL. ORDER - DATA PX/0,3,1,2/ - INTEGER I10,I101,I102,I103 - INTEGER I11,I1IF,I12,I13 - INTEGER LCONT(-4:2*MXNCNT) !CONTINUUM DATA - INTEGER TCNT !AVERAGE COUNT - COMPLEX DATXX !DATA POINT - REAL DATXE(0:1) - EQUIVALENCE (DATXX,DATXE) - INTEGER DATJ(0:9) !DATA AREA - REAL DATE(0:9) - EQUIVALENCE (DATJ,DATE) - INTEGER LDAT !LINK DATA - EQUIVALENCE (LDAT,DATJ(0)) - INTEGER BAS !BASELINE CODE - EQUIVALENCE (BAS,DATJ(1)) - REAL UT,U,V,W !COORDINATES - EQUIVALENCE (UT,DATE(2)),(U,DATE(3)),(V,DATE(4)),(W,DATE(5)) - INTEGER FLAG !FLAG DATA - EQUIVALENCE (FLAG,DATJ(6)) - INTEGER BIN !PULSAR BIN - EQUIVALENCE (BIN,DATJ(7)) - INTEGER IFNO !IF - EQUIVALENCE (IFNO,DATJ(8)) - INTEGER SRCNO !SOURCE - EQUIVALENCE (SRCNO,DATJ(9)) - REAL BUFE(0:MXNIFR*4*3-1) !DATA BUFFER - INTEGER*2 BUFI(0:MXNIFR*4*3-1) - BYTE STH(0:STHHDL-1) !SET HEADER - INTEGER*2 STHI(0:STHHDL/2-1) - INTEGER STHJ(0:STHHDL/4-1) - REAL STHE(0:STHHDL/4-1) - REAL*8 STHD(0:STHHDL/8-1) - EQUIVALENCE (STH,STHI,STHJ,STHE,STHD) - BYTE SCH(0:SCHHDL-1) !SCAN HEADER - INTEGER*2 SCHI(0:SCHHDL/2-1) - INTEGER SCHJ(0:SCHHDL/4-1) - REAL SCHE(0:SCHHDL/4-1) - REAL*8 SCHD(0:SCHHDL/8-1) - EQUIVALENCE (SCH,SCHI,SCHJ,SCHE,SCHD) - INTEGER I6 - REAL R2 -C- -C -C INIT -C -C MAKE SET HEADERS -C - CALL WNGMVZ(STHHDL,STH(0)) !CLEAR - STHI(STH_LEN_I)=STHHDL !LENGTH - STHI(STH_VER_I)=STHHDV !VERSION - STHE(STH_EPO_E)=2000. !EPOCH - READ (DATOBS,'(I2,X,I2,X,I2)') I,I1,STHI(STH_OBS_I+1) !DATE AND YEAR - DO I2=1,I1-1 - I=I+MONTH(I2) - END DO - IF (MOD(STHI(STH_OBS_I+1),4).EQ.0 .AND. I1.GT.2) I=I+1 !LEAP YEAR - STHI(STH_OBS_I)=I !DAY - STHD(STH_MJD_D)=INT(STHI(STH_OBS_I+1)*365.25+0.1)+ - 1 STHI(STH_OBS_I)+24150. !MJD AT 0HR UT - STHE(STH_OEP_E)=(STHD(STH_MJD_D)-24150.)/365.25+1900. !OBS. DATE IN JUL. - DO I=1,NANT !TEL. POSITIONS - IF (I.LE.MXNTEL) THEN - STHE(STH_RTP_E+STHTEL-MXNTEL+I-1)= - 1 SQRT((X(I)-X(1))**2+(Y(I)-Y(1))**2+ - 1 (Z(I)-Z(1))**2) - END IF - IF (I.EQ.1) THEN !AVERAGE E-W ANGLE - R0=0 - R1=0 - ELSE - R0=R0+(X(I)-X(1)) - R1=R1+(Y(I)-Y(1)) - END IF - END DO - IF (NANT.GT.1) R2=ATAN2(R1,R0) - STHD(STH_UTST_D)=1.002737909265+.589E-10* - 1 (STHD(STH_MJD_D)-24150.)/36525. !UT/ST DAY - STHJ(STH_INST_J)=1 !INDICATE ATCA - STHJ(STH_DIPC_J)='0aaaaaaa'X !ASSUME PARALLEL DIPOLES - I=0 !BASELINE COUNT - STHJ(STH_NIFR_J)=0 !IFR COUNT - DO I1=1,6 !ALL TEL. - DO I2=I1,6 - IF (IAND(IFRS,2**I).NE.0) THEN !SEEN - IFRT(STHJ(STH_NIFR_J))=(7+I2)*256+(7+I1) - STHJ(STH_NIFR_J)=STHJ(STH_NIFR_J)+1 !COUNT - END IF - I=I+1 !NEXT BASELINE - END DO - END DO - IF (STHJ(STH_NIFR_J).LE.0) GOTO 900 !NO DATA - STHJ(STH_IFRP_J)=WNFEOF(FCAOUT) !SAVE INTERFEROMETER TABLE - IF (.NOT.WNFWR(FCAOUT,LB_I*STHJ(STH_NIFR_J), - 1 IFRT,STHJ(STH_IFRP_J))) GOTO 10 -C -C LOOP IF -C - DO I1=1,N_IF !ALL IF'S - IF (TAB(1,I1,8).EQ.0) GOTO 30 !NOT SELECTED - 20 CONTINUE - STHI(STH_PLN_I)=IF_NSTOK(I1) !# OF POLARISATIONS - IF (IF_NSTOK(I1).EQ.3) STHI(STH_PLN_I)=2 !MAKE CORRECT - STHI(STH_PLN_I)=MIN(4,STHI(STH_PLN_I)) - STHD(STH_FRQ0_D)=RFREQ/1D6 !REST FREQUENCY LINE - STHE(STH_VEL_E)=VEL1 !VELOCITY - IF (IVELREF.EQ.258) THEN !VELOCITY CODE - STHJ(STH_VELC_J)=1 !HELIOC. RADIO - ELSE IF (IVELREF.EQ.258) THEN - STHJ(STH_VELC_J)=1 !HELIOC. RADIO - ELSE IF (IVELREF.EQ.257) THEN - STHJ(STH_VELC_J)=2 !LSR RADIO - ELSE IF (IVELREF.EQ.2) THEN - STHJ(STH_VELC_J)=3 !HELIOC. OPTICAL - ELSE IF (IVELREF.EQ.1) THEN - STHJ(STH_VELC_J)=4 !LSR OPTICAL - ELSE - STHJ(STH_VELC_J)=0 !UNKNOWN - END IF - STHD(STH_FRQC_D)=IF_FREQ(I1)/1E6 !CENTRE LINE FREQUENCY - I1IF=ABS(MIN(0,NINT(LOG(DCL*100/IF_FREQ(I1)/90.) - 1 /LOG(2D0)))) !BAND NUMBER - IF (.NOT.WNDLNF(SGPH(0)+SGH_LINKG_1,I1IF, - 1 SGH_GROUPN_1,FCAOUT, - 1 SGPH(1),SGNR(1))) THEN !FIND/CREATE SUB-GROUP - CALL WNCTXT(F_TP,'!/Cannot link sub-group') - GOTO 900 !QUIT - END IF -C -C LOOP SOURCES -C - DO I=1,N_SU !ALL SOURCES - IF (TAB(I,1,9).EQ.0) GOTO 31 !NOT SELECTED - 21 CONTINUE - STHI(STH_PTS_I)=I-1 !POINTING SET # - CALL WNGMFS(STH_FIELD_N,SU_NAME(I),STH(STH_FIELD_1)) !FIELD NAME - STHD(STH_RAE_D)=SU_RA(I)/DPI2 !RA EPOCH - STHD(STH_DECE_D)=SU_DEC(I)/DPI2 !DEC EPOCH - IF (SU_RAD(I).EQ.0 .AND. SU_DECD(I).EQ.0) THEN - STHD(STH_RA_D)=SU_RA(I)/DPI2 !APP. RA - STHD(STH_DEC_D)=SU_DEC(I)/DPI2 !APP. DEC - ELSE - STHD(STH_RA_D)=SU_RAD(I)/DPI2 !APP. RA - STHD(STH_DEC_D)=SU_DECD(I)/DPI2 !APP. DEC - END IF - STHE(STH_PHI_E)=STHE(STH_PHI_E)/PI2 !MAKE CIRCLES - I10=NFSRC !FOR SAFETY OPTIMIZING - DO I2=1,NFSRC - IF (SU_NAME(I).EQ.FSRC(I2)) THEN !FOUND SOURCE - I10=I2-1 !SAVE POSITION - GOTO 23 - END IF - END DO - NFSRC=MIN(MXFSRC,NFSRC+1) !SAVE NEW SOURCE - FSRC(NFSRC)=SU_NAME(I) - 23 CONTINUE - IF (.NOT.WNDLNF(SGPH(1)+SGH_LINKG_1,I10,SGH_GROUPN_1,FCAOUT, - 1 SGPH(2),SGNR(2))) THEN !FIND/CREATE SUB-GROUP - CALL WNCTXT(F_TP,'!/Cannot link sub-group') - GOTO 900 !QUIT - END IF - CALL WNCTXT(F_TP,'!6C\Src/IF !4$UJ/!2$UJ: !UJ\.!UJ\.!UJ'// - 1 '!32C\RA= !10$DPF15.5 Dec= !10$DAF15.5'// - 1 ' UT= !5$EHF4', - 1 I10,I1IF,SGNR(0),SGNR(1),SGNR(2), - 1 STHD(STH_RAE_D),STHD(STH_DECE_D), - 1 TABE(I,I1,1)/3600./24.) -C -C LOOP CHANNELS -C - DO I2=0,2*MXNCNT !GET CONT. DEFINITION - LCONT(I2)=CONTIN(I2) - END DO - LCONT(-1)=0 !COUNT - LCONT(-2)=0 !AVERAGE - LCONT(-3)=1000000 !LOWEST - LCONT(-4)=0 !HIGHEST - IF (CONTIN(0).EQ.-1) THEN !SELECT 75% - LCONT(0)=1 - I2=NINT(0.7501*IF_NFREQ(I1)) !CHANNELS TO GET - LCONT(2)=(IF_NFREQ(I1)+1+I2)/2 !HIGHEST - LCONT(1)=LCONT(2)-I2+1 !LOWEST - END IF - IF (LCONT(0).NE.0) THEN !GET RANGE - DO I2=1,LCONT(0) !PAIRS - LCONT(2*I2-1)=MAX(1,LCONT(2*I2-1)) !LIMIT - LCONT(2*I2)=MIN(IF_NFREQ(I1),LCONT(2*I2)) - DO I10=LCONT(2*I2-1),LCONT(2*I2) !EACH PAIR - LCONT(-1)=LCONT(-1)+1 !COUNT - LCONT(-2)=LCONT(-2)+I10 !AVERAGE CHANNEL - LCONT(-3)=MIN(LCONT(-3),I10) !LOWEST - LCONT(-4)=MAX(LCONT(-4),I10) !HIGHEST - END DO - END DO - IF (LCONT(-1).LE.0) THEN !NONE - LCONT(0)=0 - ELSE - LCONT(-2)=LCONT(-2)/LCONT(-1) !AVERAGE CHANNEL - LCONT(-3)=LCONT(-4)-LCONT(-3)+1 !WIDTH - END IF - END IF - DO I2=0,IF_NFREQ(I1) !ALL BANDS - IF (I2.EQ.0) THEN !CONTINUUM - IF (LCONT(0).EQ.0) GOTO 32 !NOT WANTED - ELSE - LCONT(0)=1 !SET NORMAL - LCONT(1)=I2 - LCONT(2)=I2 - IF (NCHN(CJOB).GE.0) THEN !MUST CHECK - DO I10=1,NCHN(CJOB) - IF (ICHN(I10,CJOB).EQ.I2) - 1 GOTO 22 !FOUND SELECTION - END DO - GOTO 32 !NOT SELECTED - END IF - END IF - 22 CONTINUE - IF (.NOT.WNDLNF(SGPH(2)+SGH_LINKG_1,I2, - 1 SGH_GROUPN_1,FCAOUT, - 1 SGPH(3),SGNR(3))) THEN !FIND/CREATE SUB-GROUP - CALL WNCTXT(F_TP,'!/Cannot link sub-group') - GOTO 900 !QUIT - END IF - STHI(STH_CHAN_I)=I2 - IF (I2.EQ.0) THEN !CONT. CHANNEL - STHD(STH_FRQ_D)=(IF_FREQ(I1)-(IF_REF(I1)-LCONT(-2))* - 1 (IF_INVERT(I1)*IF_BW(I1)/(IF_NFREQ(I1)-1)))/1E6 - STHE(STH_BAND_E)=IF_BW(I1)/(IF_NFREQ(I1)-1)/1E6 - 1 *LCONT(-3) !CONTINUUM BAND - ELSE !SPECTRAL - STHD(STH_FRQ_D)=(IF_FREQ(I1)-(IF_REF(I1)-I2)* - 1 IF_INVERT(I1)*IF_BW(I1)/(IF_NFREQ(I1)-1))/1E6 - STHE(STH_BAND_E)=IF_BW(I1)/(IF_NFREQ(I1)-1)/1E6 - END IF - STHD(STH_FRQE_D)=STHD(STH_FRQ_D) - STHE(STH_HAV_E)=MAX(REAL(INTIME),TABE(I,I1,2))* - 1 STHD(STH_UTST_D)/240./360. !HA AVERAGE -C -C WRITE DATA -C - STHE(STH_HAI_E)=TABE(I,I1,2)*STHD(STH_UTST_D)/240./360. !HA INC. - IF (STHE(STH_HAI_E).LE.0) STHE(STH_HAI_E)=STHE(STH_HAV_E) - STHJ(STH_SCN_J)=TAB(I,I1,0) !# OF SCANS - STHJ(STH_SCNL_J)=SCHHDL+3*LB_I*STHJ(STH_NIFR_J)* - 1 STHI(STH_PLN_I) !LENGTH SCAN - STHE(STH_HAB_E)=WNGENF((TABE(I,I1,6))/PI2) !START HA - STHD(STH_MJD_D)=AINT(STHD(STH_MJD_D))+ - 1 TABE(I,I1,1)/(24.*3600.) !START MJD - I101=MAX(0,MIN(NINT(INTOFF/24./3600./STHE(STH_HAI_E)), - 1 STHJ(STH_SCN_J)-1)) !START OFFSET - I10=MAX(1,MIN(NINT(INTTIM/24./3600./STHE(STH_HAI_E)), - 1 STHJ(STH_SCN_J)-I101)) !SCANS INTEGRATED - STHJ(STH_SCN_J)=(STHJ(STH_SCN_J)-I101)/I10 !# OF OUTPUT SCANS - STHE(STH_HAB_E)=STHE(STH_HAB_E)+((I10-1)/2.+I101)* - 1 STHE(STH_HAI_E) !NEW START - STHE(STH_HAI_E)=STHE(STH_HAI_E)*I10 !NEW STEP - STHE(STH_HAV_E)=STHE(STH_HAV_E)*I10 !NEW AVERAGE - IF (STHJ(STH_SCN_J).LE.0) GOTO 32 !NO SCANS, SKIP -C -C WRITE AND LINK SET HEADER -C - I3=WNFEOF(FCAOUT) !POINTER - IF (.NOT.WNFWR(FCAOUT,STHHDL,STH(0),I3)) THEN - 10 CONTINUE - CALL WNCTXT(F_TP,'Error writing scan data') - CALL WNGEX !STOP - END IF - IF (.NOT.WNDLNK(GFH_LINK_1,I3,STH_SETN_1,FCAOUT)) - 1 GOTO 10 !LINK SET - IF (.NOT.WNDLNG(SGPH(3)+SGH_LINKG_1,I3,SGH_GROUPN_1,FCAOUT, - 1 SGPH(4),SGNR(4))) GOTO 10 !LINK SUB-GROUP - IF (.NOT.WNFRD(FCAOUT,STHHDL,STH(0),I3)) GOTO 10 !RE-READ STH - STHJ(STH_SCNP_J)=WNFEOF(FCAOUT) !DATA POINTER - IF (.NOT.WNFWR(FCAOUT,STHHDL,STH(0),I3)) GOTO 10 !RE-WRITE STH - J0=TAB(I,I1,3) !TMP POINTER -C -C LOOP SCANS -C - DO I3=0,MIN(I101,STHJ(STH_SCN_J)*I10)-1 !SKIP START - IF (.NOT.WNFRD(FCAT,2*LB_J,DATJ(0),J0)) GOTO 10 !LINK DATA - J0=DATJ(0) !NEXT LINK POINTER - END DO - DO I3=0,STHJ(STH_SCN_J)-1 !ALL OUTPUT TIMES - CALL WNGMVZ(STHJ(STH_NIFR_J)*STHI(STH_PLN_I)* - 1 3*LB_E,BUFE) !EMPTY SUMS - TCNT=0 - DO I11=0,I10-1 !ALL INPUT SCANS - IF (.NOT.WNFRD(FCAT,2*LB_J,DATJ(0),J0)) GOTO 10 !LINK DATA - DO I102=1,LCONT(0) !ALL CONT. GROUPS - DO I103=LCONT(2*I102-1),LCONT(2*I102) !ALL SUB-CHANNELS - IF (.NOT.WNFRD(FCAT,MXNIFR*IF_NSTOK(I1)*LB_X, !READ DATA - 1 A_B(BUFP-A_OB),J0+2*LB_J+ - 1 (I103-1)*MXNIFR*IF_NSTOK(I1)*LB_X)) GOTO 10 - I5=0 !COUNT IFR - DO I4=0,MXNIFR-1 !COPY ALL - IF (IAND(IFRS,2**I4).NE.0) THEN !SELECTED - IF (IAND(DATJ(1),2**I4).NE.0) THEN !PRESENT - DO I6=0,STHI(STH_PLN_I)-1 !ALL POL - CALL WNGMV(LB_X, - 1 A_B(BUFP-A_OB+ - 1 LB_X*(IF_NSTOK(I1)*I4+I6)), - 1 DATXX) !DATA - DATXE(1)=-IF_INVERT(I1)*DATXE(1) !INVERT PHASE - I12=I5*3*STHI(STH_PLN_I)+I6*3 !POINTER - IF (DATXE(0).EQ.0 .AND. DATXE(1).EQ.0) THEN !BAD - GOTO 11 - ELSE - IF (STHI(STH_PLN_I).NE.4) THEN !SAME ORDER - BUFE(I12)=BUFE(I12)+DATXE(0) - BUFE(I12+1)=BUFE(I12+1)+DATXE(1) - ELSE !SWITCH ORDER - I13=I5*3*STHI(STH_PLN_I)+PX(I6)*3 - BUFE(I13)=BUFE(I13)+DATXE(0) - BUFE(I13+1)=BUFE(I13+1)+DATXE(1) - END IF - BUFE(I12+2)=BUFE(I12+2)+1. !WEIGHT - END IF - END DO - 11 CONTINUE - END IF - I5=I5+1 !COUNT - END IF - END DO !IFR - TCNT=TCNT+1 !COUNT POINTS - END DO !SUB-CHANNELS - END DO !CHANNEL GROUPS - J0=DATJ(0) !NEXT LINK POINTER - END DO !INPUT SCANS -C -C AVERAGE AND MAX. -C - R0=0 - DO I4=0,STHJ(STH_NIFR_J)-1 !FIND MAX AND AVERAGE - DO I5=0,STHI(STH_PLN_I)-1 - I12=I4*3*STHI(STH_PLN_I)+I5*3 !POINTER - IF (TCNT.GT.0 .AND. - 1 BUFE(I12+2).EQ.TCNT) THEN - BUFE(I12+0)=BUFE(I12+0)/BUFE(I12+2) !AVERAGE - BUFE(I12+1)=BUFE(I12+1)/BUFE(I12+2) - BUFE(I12+2)=BUFE(I12+2)/BUFE(I12+2) - R0=MAX(R0,ABS(BUFE(I12+0)*200.)) - R0=MAX(R0,ABS(BUFE(I12+1)*200.)) - ELSE - CALL WNGMVZ(3*LB_E,BUFE(I12)) !BAD DATA - END IF - END DO - END DO - R1=1 !FIND SCALE - DO WHILE (R0.GT.32760.) - R1=R1*2. - R0=R0/2. - END DO - DO I4=0,STHJ(STH_NIFR_J)-1 !WRITE DATA - DO I5=0,STHI(STH_PLN_I)-1 - I12=I4*3*STHI(STH_PLN_I)+I5*3 - BUFI(I12+1)=BUFE(I12+0)/R1*200. !COS - BUFI(I12+2)=BUFE(I12+1)/R1*200. !SIN - BUFI(I12+0)=BUFE(I12+2) !WEIGHT - END DO - END DO - CALL WNGMVZ(SCHHDL,SCH) !MAKE SCAN HEADER - SCHE(SCH_HA_E)=STHE(STH_HAB_E)+I3*STHE(STH_HAI_E) !HA - SCHE(SCH_MAX_E)=R0*R1 !SAVE MAX - SCHE(SCH_SCAL_E)=R1-1. !SAVE SCALE - SCHE(SCH_PANG_E)= !PARALL. ANGLE - 1 ATAN2(DBLE(CLATA*SIN(PI2*SCHE(SCH_HA_E))), - 1 COS(PI2*STHD(STH_DEC_D))* - 1 CLATA*SIN(PI2*STHD(STH_DEC_D))* - 1 COS(PI2*SCHE(SCH_HA_E)))/PI2 - IF (.NOT.WNFWR(FCAOUT,SCHHDL,SCH, - 1 STHJ(STH_SCNP_J)+ - 1 I3*STHJ(STH_SCNL_J))) GOTO 10 !WRITE SCAN - IF (.NOT.WNFWR(FCAOUT,STHJ(STH_SCNL_J)-SCHHDL, - 1 BUFI, - 1 SCHHDL+STHJ(STH_SCNP_J)+ - 1 I3*STHJ(STH_SCNL_J))) GOTO 10 !WRITE SCAN - END DO !SCANS - 32 CONTINUE - END DO !CHANNELS - 31 CONTINUE - END DO !SOURCES - 30 CONTINUE - END DO !BANDS -C - 900 CONTINUE - RETURN !READY -C -C - END diff --git a/src/nscan/natnf.for b/src/nscan/natnf.for deleted file mode 100644 index aded17997c6e4915009422f46d0756e7dd6e15e0..0000000000000000000000000000000000000000 --- a/src/nscan/natnf.for +++ /dev/null @@ -1,50 +0,0 @@ -C+ NATNF.FOR -C WNB 920428 -C -C Revisions: -C - SUBROUTINE NATNF -C -C Main routine to handle RPFITS files -C -C Result: -C -C -C Include files: -C - INCLUDE 'WNG_DEF' - INCLUDE 'NAT_DEF' -C -C Parameters: -C -C -C Arguments: -C -C -C Function references: -C - LOGICAL WNDRUN !TEST RUN -C -C Data declarations: -C -C- -C -C PRELIMINARIES -C - CALL NATINI !INIT PROGRAM -C -C DISTRIBUTE -C - 10 CONTINUE - CALL NATDAT !GET USER DATA - IF (OPT.EQ.'QUI') THEN !READY - CALL WNGEX !FINISH - ELSE IF (OPT.EQ.'LOA') THEN !LOAD - IF (.NOT.WNDRUN()) CALL WNGEX !NO RUN - CALL NATLOD - END IF -C - CALL WNGEX !READY -C -C - END diff --git a/src/nscan/natnf.psc b/src/nscan/natnf.psc deleted file mode 100644 index a63403b5a020f80ea2d5287dfe4085371f456055..0000000000000000000000000000000000000000 --- a/src/nscan/natnf.psc +++ /dev/null @@ -1,162 +0,0 @@ -!+ NATNF.PSC -! WNB 920428 -! -! Revisions: -! WNB 921022 Magtape text -! WNB 921028 Add SOURCES, BANDS, CHANNELS, INTEGRATION -! WNB 921123 Add START_OFFSET. CONTINUUM -! WNB 921211 Make PSC -! JEN 930312 INCLUDE=NCOMM_PEF -! JEN 930312 Remove keywords INPUT_UNIT, OUTPUT_SCAN -! JPH 960403 Format corrections - UNIT_PEF -! -! -! Get overall action -! Ref: NATDAT -! -KEYWORD=OPTION - DATA_TYP=C - IO=I - LENGTH=24 - CHECKS=ABBREV_OPTIONS - SWITCHES=LOOP,NULL_VALUES,WILD_CARDS - SEARCH=L,P - OPTIONS=LOAD,QUIT -! PROMPT="action" - HELP=" -Specify action to perform: -. - LOAD load RPFITS data into scan file - QUIT finish" -! -! -! Get input file -! Ref: NATDAT -! -KEYWORD=INPUT_FILE - DATA_TYP=C - IO=I - LENGTH=80 - SWITCHES=LOOP,NULL_VALUES,WILD_CARDS - SEARCH=L,P - PROMPT="input filename" - HELP=" -Specify the input filename (without an extension for the LOAD from disk -option). " -! -! Get input labels -! Ref: NATDAT -! -KEYWORD=INPUT_LABELS - DATA_TYP=J - IO=I - NVALUES=256 - SWITCHES=LOOP,NULL_VALUES,WILD_CARDS - SEARCH=L,P - PROMPT="input labels" - HELP=" -Specify the tape labels to be read. * specifies all labels on the tape " -! -! Get input sources -! Ref: NATDAT -! -KEYWORD=INPUT_SOURCES - DATA_TYP=C - IO=I - LENGTH=16 - NVALUES=256 - SWITCHES=LOOP,NULL_VALUES,WILD_CARDS - SEARCH=L,P - PROMPT="sources to get" - HELP=" -Specify the sources to be read. * specifies all sources on the tape" -! -! Get input bands -! Ref: NATDAT -! -KEYWORD=INPUT_BANDS - DATA_TYP=R - IO=I - NVALUES=16 - SWITCHES=LOOP,NULL_VALUES,WILD_CARDS - SEARCH=L,P - PROMPT="input bands in cm" - HELP=" -Specify the bands to be read (20 etc in octave steps. * specifies all bands on -the tape" -! -! Get input channels -! Ref: NATDAT -! -KEYWORD=INPUT_CHANNELS - DATA_TYP=J - IO=I - NVALUES=256 - SWITCHES=LOOP,NULL_VALUES,WILD_CARDS - CHECK=MINIMUM - MINIMUM=1 - SEARCH=L,P - PROMPT="input channels" - HELP=" -Specify the channels (1,..) to be read. * specifies all channels on the tape " -! -! Get integration time -! Ref: NATDAT -! -KEYWORD=INTEGRATION_TIME - DATA_TYP=R - IO=I - SWITCHES=LOOP,NULL_VALUES,WILD_CARDS - CHECK=MAXIMUM,MINIMUM - MAXIMUM=3600. - MINIMUM=10. - SEARCH=L,P - PROMPT="integration time (sec)" - HELP=" -Specify the integration time per scan. " -! -! Get time offset -! Ref: NATDAT -! -KEYWORD=START_OFFSET - DATA_TYP=R - IO=I - SWITCHES=LOOP,NULL_VALUES,WILD_CARDS - CHECK=MAXIMUM,MINIMUM - MAXIMUM=180. - MINIMUM=0. - SEARCH=L,P - PROMPT="scan start offset (sec)" - HELP=" -Often the first 10 sec of a scan are bad. By specifying an offset here, the -first n seconds of a scan will be discarded. E.g. specifying an integration of -70 sec and an offset of 10 sec will produce 4 points for a 5 min observation, -discarding the first and last 10 sec. " -! -! Continuum definition -! Ref: NATDAT -! -KEYWORD=CONTINUUM - DATA_TYP=J - IO=I - NVALUES=16 - SWITCHES=LOOP,NULL_VALUES,WILD_CARDS - SEARCH=L,P - PROMPT="define channels for continuum" - HELP=" -A continuum channel can be made by specifying up to 8 pairs of channel numbers. -The channel values will be averaged to produce a single continuum value. Each -pair specifies a low and high channel number to be included. -. -Special values: - "" No continuum wanted - * Central 75% of channels used" -! -!- -INCLUDE=NGEN_PEF -!- -INCLUDE=SCNNODE_PEF ! -INCLUDE=SCNSETS_PEF ! -INCLUDE=SELECT_PEF ! -INCLUDE=UNIT_PEF -!- diff --git a/src/nscan/natrgp.for b/src/nscan/natrgp.for deleted file mode 100644 index 93ec017114e8adcc9ddfd34bdcd1a08da32a2438..0000000000000000000000000000000000000000 --- a/src/nscan/natrgp.for +++ /dev/null @@ -1,115 +0,0 @@ -C+ NATRGP.FOR -C WNB 920501 -C -C Revisions: -C RPN 17/11/90 -C - SUBROUTINE NATRGP(FCA,FCAPT,GRPHDR,I_GRPHDR,GRPPTR,BUFPTR,BUFFER, - 1 PCOUNT,U,V,W,BASEL, - 1 UT,FLAG,BIN,IFNO,SRCNO) -C -C Read header data (based on GETPARM) -C -C Result: -C -C CALL NATRGP( FCA_J:I, FCAPT_J:IO, GRPHDR_E(640):I, -C I_GRPHDR_J(640):I, GRPPTR_J:IO, BUFPTR_J:IO, -C BUFFER_E(20,32):IO, -C PCOUNT_J:O, U_E:O, V_E:O, W_E:O, -C BASEL_J:O, UT_E:O, FLAG_J:O, BIN_J:O, -C IFNO_J:O, SRCNO_J:O) -C Read general header data -C and check for legality. -C If legal data is not found, then the data -C is skipped until some legal data are found, -C and then the new buffer and bufptr are returned. -C -C E_C is 0 on exit for immediate success, -2 if -C success was achieved after skipping data, -1 -C for a total lack of success -C -C Include files: -C - INCLUDE 'WNG_DEF' - INCLUDE 'RPF_DEF' !RPFITS DATA -C -C Parameters: -C -C -C Arguments: -C - INTEGER FCA !FILE CONTROL AREA - INTEGER FCAPT !FILE POINTER - REAL GRPHDR(640) - INTEGER I_GRPHDR(640) - INTEGER GRPPTR - INTEGER BUFPTR - REAL BUFFER(20,32) !CARD BUFFER - INTEGER PCOUNT - REAL U,V,W - INTEGER BASEL - REAL UT - INTEGER FLAG - INTEGER BIN - INTEGER IFNO - INTEGER SRCNO -C -C Entry points: -C -C -C Function references: -C - LOGICAL NATXIB !CHECK BASELINE - INTEGER NATXCJ !MAKE J - REAL NATXCE !MAKE E - LOGICAL NATXST !SKIP DATA -C -C Data declarations: -C - REAL RBASE !BASELINE -C- -C -C First 5 parameters are always there (you hope!) -C - U=NATXCE(GRPHDR(GRPPTR)) - V=NATXCE(GRPHDR(GRPPTR+1)) - W=NATXCE(GRPHDR(GRPPTR+2)) - RBASE=NATXCE(GRPHDR(GRPPTR+3)) - BASEL=NINT(RBASE) - UT=NATXCE(GRPHDR(GRPPTR+4)) -C -C Now look for syscal parameters -C - IF (BASEL.EQ.-1) THEN - SC_UT=UT - SC_ANT=NATXCJ(I_GRPHDR(GRPPTR+5)) - SC_IF=NATXCJ(I_GRPHDR(GRPPTR+6)) - SC_Q=NATXCJ(I_GRPHDR(GRPPTR+7)) - SC_SRCNO=NATXCJ(I_GRPHDR(GRPPTR+8)) -C -C Else pick up remaining parameters -C - ELSE IF (PCOUNT.GT.5) THEN - FLAG=NATXCJ(I_GRPHDR(GRPPTR+5)) - BIN=NATXCJ(I_GRPHDR(GRPPTR+6)) - IFNO=NATXCJ(I_GRPHDR(GRPPTR+7)) - SRCNO=NATXCJ(I_GRPHDR( GRPPTR+8)) - END IF -C -C Check for illegal params. -C - IF (NATXIB(RBASE,IFNO,UT,U,V,W) )THEN -C -C This can be caused by a bad block, so look for more data -C - CALL WNCTXT(F_TP,' Illegal data (or end of scan on older data)') - E_C=NATXST(FCA,FCAPT,BUFPTR,BUFFER) -C - RETURN - END IF - E_C=0 -C - RETURN -C -C - END diff --git a/src/nscan/natrif.for b/src/nscan/natrif.for deleted file mode 100644 index 55ce7a40146c49415daab6a24f5ef4940883f602..0000000000000000000000000000000000000000 --- a/src/nscan/natrif.for +++ /dev/null @@ -1,284 +0,0 @@ -C+ NATRIF.FOR -C WNB 920429 -C -C Revisions: -C RPN 29/9/88 -C HM 14/Dec/91 Added if_simul and if_chain. Old data -C without them is given if_simul=if_chain=1 in the IF table. -C - SUBROUTINE NATRIF(FCA,FCAPT,M,II) -C -C Read RPFITS tape table. Based on RPFITS_READ_TABLE -C -C Result: -C -C CALL NATRIF( FCA_J:I, FCAPT_J:IO, M_C32(32):IO, II_J:IO) -C Read IF table from FCA based on card images in M -C starting at II currently (-1 indicates only FG -C wanted). -C CALL NATRSU( ...) Read SU table -C CALL NATRFG( ...) Read FG table -C CALL NATRAN( ...) Read AN table -C CALL NATRMT( ...) Read MT table -C CALL NATRCU( ...) Read CU table -C -C Include files: -C - INCLUDE 'WNG_DEF' - INCLUDE 'RPF_DEF' !RPFITS OUTPUT -C -C Parameters: -C -C -C Arguments: -C - INTEGER FCA !FILE CONTROL AREA - INTEGER FCAPT !FILE POINTER - CHARACTER*80 M(32) !CARD IMAGES - INTEGER II !CURRENT CARD IMAGE (OR -1 FOR FG) -C -C Entry points: -C -C -C Function references: -C - LOGICAL WNFRD !READ DISK -C -C Data declarations: -C - INTEGER IAXIS_OFFSET - INTEGER ICHR(20,32) !BUFFER - INTEGER K,L -C- -C -C NATRIF -C - N_IF=0 - DO WHILE (.TRUE.) - DO J=II+1,32 - IF (NCARD.LT.0) THEN - CARD(-NCARD)=M(J) - NCARD=NCARD-1 - END IF - IF (M(J)(1:8).EQ.'ENDTABLE') THEN - II=J - GOTO 999 - ELSE IF (M(J)(1:8).EQ.'HEADER') THEN - ELSE IF (M(J)(1:8).EQ.'COMMENT') THEN - ELSE - K=N_IF+1 - READ(M(J),'(I2,1X,F16.3,1X,I2, 1X, F16.3, 1X, I4, - 1 1X, I2, 1X, 4A2, 1X,I1, 1X,F6.1, 1X, BZ, I2, - 1 1X, I2 )') - 1 IF_NUM(K), IF_FREQ(K), IF_INVERT(K), - 1 IF_BW(K), IF_NFREQ(K), IF_NSTOK(K), - 1 (IF_CSTOK(L,K),L=1,4), IF_SAMPL(K), - 1 IF_REF(K), IF_SIMUL(K), IF_CHAIN(K) - IF (IF_SIMUL(K).EQ.0) THEN - IF_SIMUL(K)=1 - END IF - IF (IF_CHAIN(K).EQ.0) THEN - IF_CHAIN(K)=1 - END IF - N_IF=N_IF+1 - END IF - END DO - JS=WNFRD(FCA,2560,ICHR,FCAPT) !READ BLOCK - FCAPT=FCAPT+2560 !UPDATE PTR - DO I1=1,32 !SET CHAR, - CALL WNGMTS(80,ICHR(1,I1),M(I1)) - END DO - II=0 - END DO - 999 CONTINUE - IF_FOUND=.TRUE. -C - RETURN -C -C NATRSU -C - ENTRY NATRSU(FCA,FCAPT,M,II) -C - N_SU=0 - DO WHILE (.TRUE.) - DO J=II+1,32 - IF (NCARD.LT.0) THEN - CARD(-NCARD)=M(J) - NCARD=NCARD-1 - END IF - IF (M(J)(1:8).EQ.'ENDTABLE') THEN - II=J - GOTO 998 - ELSE IF (M(J)(1:8).EQ.'HEADER') THEN - ELSE IF (M(J)(1:8).EQ.'COMMENT') THEN - ELSE - K=N_SU+1 - READ(M(J),'(I2,1X,A16,1X,F12.9,1X,F12.9,1X,A4, - 1 1X,F11.9,1X,F11.9)') - 1 SU_NUM(K),SU_NAME(K),SU_RA(K),SU_DEC(K), - 1 SU_CAL(K),SU_RAD(K),SU_DECD(K) - N_SU=N_SU+1 - END IF - END DO - JS=WNFRD(FCA,2560,ICHR,FCAPT) !READ BLOCK - FCAPT=FCAPT+2560 !UPDATE PTR - DO I1=1,32 !SET CHAR, - CALL WNGMTS(80,ICHR(1,I1),M(I1)) - END DO - II=0 - END DO - 998 CONTINUE - SU_FOUND=.TRUE. -C - RETURN -C -C NATRFG -C - ENTRY NATRFG(FCA,FCAPT,M,II) -C - N_FG=0 - DO WHILE (.TRUE.) - DO K=II+1,32 - IF (NCARD.LT.0) THEN - CARD(-NCARD)=M(K) - NCARD=NCARD-1 - END IF - IF (M(K)(1:8).EQ.'ENDTABLE') THEN - II=K - GOTO 997 - ELSE IF ( M(K)(1:8).EQ.'HEADER' ) THEN - ELSE IF ( M(J)(1:8).EQ.'COMMENT') THEN - ELSE - READ(M(K),'(I2,2(1X,I2),2(1X,F8.1),2(1X,I2), - 1 2(1X,I4),2(1X,I1),A24)') J, - 1 FG_ANT(1,J),FG_ANT(2,J),FG_UT(1,J),FG_UT(2,J), - 1 FG_IF(1,J),FG_IF(2,J),FG_CHAN(1,J),FG_CHAN(2,J), - 1 FG_STOK(1,J),FG_STOK(2,J),FG_REASON - N_FG=N_FG+1 - END IF - END DO - JS=WNFRD(FCA,2560,ICHR,FCAPT) !READ BLOCK - FCAPT=FCAPT+2560 !UPDATE PTR - DO I1=1,32 !SET CHAR, - CALL WNGMTS(80,ICHR(1,I1),M(I1)) - END DO - II=0 - END DO - 997 CONTINUE - FG_FOUND=.TRUE. -C - RETURN -C -C NATRAN -C - ENTRY NATRAN(FCA,FCAPT,M,II) -C - NANT=0 - DO WHILE (.TRUE.) - DO J=II+1,32 - IF (NCARD.LT.0) THEN - CARD(-NCARD)=M(J) - NCARD=NCARD-1 - END IF - IF (M(J)(1:8).EQ.'ENDTABLE') THEN - II=J - GOTO 996 - ELSE IF (M(J)(1:8).EQ.'HEADER' ) THEN - ELSE IF (M(J)(1:8).EQ.'COMMENT') THEN - ELSE - NANT=NANT+1 - READ(M(J),100) ANT_NUM(NANT),STA(NANT), - 1 ANT_MOUNT(NANT),X(NANT),Y(NANT),Z(NANT), - 1 IAXIS_OFFSET - AXIS_OFFSET(NANT)=IAXIS_OFFSET/1000.0 - END IF - END DO - JS=WNFRD(FCA,2560,ICHR,FCAPT) !READ BLOCK - FCAPT=FCAPT+2560 !UPDATE PTR - DO I1=1,32 !SET CHAR, - CALL WNGMTS(80,ICHR(1,I1),M(I1)) - END DO - II=0 - END DO - 996 CONTINUE - AN_FOUND=.TRUE. -C - RETURN -C -C NATRMT -C - ENTRY NATRMT(FCA,FCAPT,M,II) -C - N_MT=0 - DO WHILE (.TRUE.) - DO J=II+1,32 - IF (NCARD.LT.0) THEN - CARD(-NCARD)=M(J) - NCARD=NCARD-1 - END IF - IF (M(J)(1:8).EQ.'ENDTABLE') THEN - II=J - GOTO 995 - ELSE IF (M(J)(1:8).EQ.'HEADER' ) THEN - ELSE IF (M(J)(1:8).EQ.'COMMENT') THEN - ELSE - N_MT=N_MT+1 - READ(M(J),101) MT_ANT(N_MT),MT_UT(N_MT), - 1 MT_PRESS(N_MT),MT_TEMP(N_MT),MT_HUMID(N_MT) - END IF - END DO - JS=WNFRD(FCA,2560,ICHR,FCAPT) !READ BLOCK - FCAPT=FCAPT+2560 !UPDATE PTR - DO I1=1,32 !SET CHAR, - CALL WNGMTS(80,ICHR(1,I1),M(I1)) - END DO - II=0 - END DO - 995 CONTINUE - MT_FOUND=.TRUE. -C - RETURN -C -C NATRCU -C - ENTRY NATRCU(FCA,FCAPT,M,II) -C - N_CU=0 - DO WHILE (.TRUE.) - DO J=II+1,32 - IF (NCARD.LT.0) THEN - CARD(-NCARD)=M(J) - NCARD=NCARD-1 - END IF - IF (M(J)(1:8).EQ.'ENDTABLE') THEN - II=J - GOTO 994 - ELSE IF (M(J)(1:8).EQ.'HEADER' ) THEN - ELSE IF (M(J)(1:8).EQ.'COMMENT') THEN - ELSE - N_CU=N_CU+1 - READ(M(J),102) CU_UT(N_CU),CU_ANT(N_CU),CU_IF(N_CU), - 1 CU_CAL1(N_CU),CU_CAL2(N_CU),CU_CH1(N_CU), - 1 CU_CH2(N_CU) - END IF - END DO - JS=WNFRD(FCA,2560,ICHR,FCAPT) !READ BLOCK - FCAPT=FCAPT+2560 !UPDATE PTR - DO I1=1,32 !SET CHAR, - CALL WNGMTS(80,ICHR(1,I1),M(I1)) - END DO - II=0 - END DO - 994 CONTINUE - CU_FOUND=.TRUE. -C - RETURN -C -C FORMATS -C - 100 FORMAT (I2,1X,A8,1X,I1,3(1X,F13.3),1X,I4) - 101 FORMAT (I2,1X,F8.1,1X,F6.1,2(1X,F4.1)) - 102 FORMAT (F8.1,1X,I2,1X,I2,2(1X,F6.1),2(1X,I4)) -C -C - END diff --git a/src/nscan/natrpf.for b/src/nscan/natrpf.for deleted file mode 100644 index a6475dcaea509e446d8a6d7cc4d8249419d005b3..0000000000000000000000000000000000000000 --- a/src/nscan/natrpf.for +++ /dev/null @@ -1,674 +0,0 @@ -C+ NATRPF.FOR -C WNB 920428 -C -C Revisions: -C RPN 29/9/88: major changes for IF axis and tables -C -C rpn 9/11/88 major change in treatment of if's. For multi-IF data, -C rpfits should be called once per IF (i.e. several -C times per integration), with a formal parameter if_no -C varying from 1 to n_if. -C A new group will be written for each IF, and needn't -C be the same length. THUS GRPLENGTH CAN NOW VARY FROM -C GROUP TO GROUP -C PTI data will continue to be written with nstok = 2 -C Also added parameters FLAG, BIN, if_no, and source no -C and FG and SU tables -C rpn 8/2/89: changed dates from AEST to UT -C rpn 17/2/89: major mods: (1) changed to use FORTRAN BLK routines -C (2) changed record length from 512 to 2560, -C but included common RECL so -C that old data can still be read. -C (3) Put IN_ and OUT_RECNO and RP_IOSTAT in -C INDEX common, and got rid of -C OLD_RPFITSIN -C rpn 8/5/89: Allow use of either blk_read or AT_READ by editing -C the logical USE_BLK in the include -C file RPFITS_SEL.INC -C hm 9/5/89 Call routines (dummies on VAX) to translate -C real and integer numbers from VAX format as they are -C read from the RPFITS file, and before they are -C written to the RPFITS file. -C rpn 23/5/89 Fixed bugs in use of VAXI4, etc. -C rpn 10/10/89 Allow FG table to be at the end of the data -C rpn 10/10/89 Equivalence m(80) to buffer so FG table can be read -C from data buffer (Yes this does work on the VAX) -C rpn 20/3/90 Write IF tabel even if n_if=1 -C Don't bother writing ANTENNA, TEMP, etc. cards -C Introduced n_complex -C rpn 21/3/90 MAJOR MODS: introduced syscal data group into -C RPFITSIN and RPFITSOUT -C hm 10/5/90 Split routines into separate files and made -C mods necessary for compilation on SUNs. -C hm 21/5/90 Added write_wt tests. -C hm 28/5/90 Eliminated need for rpfits_sel.inc -C hm 19/6/90 End of scan check changed. -C hm 9/8/90 Recover from illegal randon parameters, possibly -C caused by missing blocks. -C rpn 16/11/90 Changed SIMPLE test to work on buffer instead of m -C rpn 17/11/90 Tidied up code by using routine getparm -C rpn 17/11/90 Tidied up group synch tests -C hm 13/12/90 Made OK for AIPS: -C . no tabs in col 1 -C . no code past col 72 -C . 'C' not 'c' for comments -C JER 04/01/91 GETPARM was being called with 4 more actual args -C than formal args. Remove SC_UT, SC_ANT, SC_IF and -C SC_Q from calling arg list: they're in common anyway. -C JER 04/01/91 Initialise IF_CSTOK to blanks if no IF table found. -C HM 03/02/91 Add more checks for bad data to illbase. -C HM 15/11/91 Initialize new new IF entries if missing. -C NEBK 08/01/92 Reworked conversion of floating point buffer value -C into integer baseline to avoid problems with -C arithmetic exceptions on wildly corrupt values -C CHanges in GETPARM, SKIPTHRU and ILLBASE for this -C HM 19/02/92 For SYSCAL data - Put source number into sc_srcno . -C Note that for syscal, it is not returned as argument -C sorceno. -C - LOGICAL FUNCTION NATRPO(FCA,FCAPT) -C -C Read RPFITS tape. Based on RPFITSIN -C -C Result: -C -C NATRPO_L = NATRPO( FCA_J:I, FCAPT_J:O) -C Start a file ON FCA and read first header. -C FCAPT is the current file pointer -C NATRPH_L = NATRPH( FCA_J:I, FCAPT_J:IO) -C Read next header -C NATRPD_L = NATRPD( FCA_J:I, FCAPT_J:IO, VIS_X(*):O, -C BASEL_J:O, UT_E:O, U_E:O, V_E:O, W_E:O, -C FLAG_J:O, BIN_J:O, IFNO_J:O, SRCNO_J:O) -C Read next data group -C -C Include files: -C - INCLUDE 'WNG_DEF' - INCLUDE 'RPF_DEF' !RPFITS OUTPUT -C -C Parameters: -C - INTEGER ILLEGAL !ILLEGAL DATA ENTITY - PARAMETER (ILLEGAL=32768) - INTEGER SS$_ENDOFFILE !EOF INDICATOR - PARAMETER (SS$_ENDOFFILE='870'X) -C -C Arguments: -C - INTEGER FCA !FILE CONTROL AREA - INTEGER FCAPT !FILE POINTER - COMPLEX VIS(*) !VISIBILITIES - INTEGER BASEL !IFR DATA - REAL UT !UT - REAL U,V,W !U,V,W - INTEGER FLAG !FLAG DATA - INTEGER BIN !PULSAR BIN - INTEGER IFNO !IF NUMBER - INTEGER SRCNO !SOURCE NUMBER -C -C Entry points: -C - LOGICAL NATRPH,NATRPD -C -C Function references: -C - INTEGER NATXSF !CHECK HEADER/TABLE FG - LOGICAL WNFRD !READ A FILE - INTEGER NATXCJ !MAKE J - REAL NATXCE !MAKE E -C -C Data declarations: -C - LOGICAL ENDHDR,STARTHDR !HEADER SEARCH - INTEGER BUFPTR !PTR TO NEXT VIS. IN GROUP - INTEGER BUFLEFT !# OF WORDS STILL TO BE READ IN BUF. - INTEGER BUFLEFT3 - INTEGER GRPLENGTH !# VIS. IN GRP - INTEGER GRPPTR !PTR TO NEXT VIS. IN GROUP - REAL GRPHDR(9) - INTEGER I_GRPHDR(9) - EQUIVALENCE (GRPHDR,I_GRPHDR) - REAL REVIS - INTEGER N_COMPLEX - LOGICAL NEW_ANTENNA - DATA NEW_ANTENNA/.FALSE./ - LOGICAL ENDSCAN - REAL CRPIX4 - REAL VELREF - INTEGER PCOUNT - INTEGER ICHAR,NCHAR - REAL SC_BUF(MAX_SC*MAX_IF*ANT_MAX) - EQUIVALENCE (SC_BUF,SC_CAL) - INTEGER I_BUFF(640) !DATA BUFFER - REAL BUFFER(640) - CHARACTER*80 M(32) - EQUIVALENCE (I_BUFF,BUFFER,M) - INTEGER ICARD - REAL LAST_GOOD_UT - DATA LAST_GOOD_UT/0/ - INTEGER K -C -C Common: -C - COMMON /BUFPAR/ BUFPTR,BUFFER - DATA BUFPTR/0/ !START FRESH -C- -C -C RPO -C - NATRPO=.TRUE. !ASSUME OK - FCAPT=0 !START AT BEGIN - GOTO 10 -C -C RPH -C - ENTRY NATRPH(FCA,FCAPT) -C - NATRPH=.TRUE. !ASSUME OK - 10 CONTINUE -C -C READ HEADER -C - ENDHDR=.FALSE. - STARTHDR=.FALSE. - BUFPTR=0 - ICARD=1 - IF (NCARD.LT.0) NCARD=-1 - N_IF=0 - AN_FOUND=.FALSE. - IF_FOUND=.FALSE. - SU_FOUND=.FALSE. - FG_FOUND=.FALSE. - NX_FOUND=.FALSE. - MT_FOUND=.FALSE. - CU_FOUND=.FALSE. - LAST_GOOD_UT=0. -C -C LOOK FOR START OF NEXT HEADER -C - DO WHILE (.NOT.STARTHDR) - IF (.NOT.WNFRD(FCA,2560,BUFFER,FCAPT)) THEN !READ A BLOCK - 21 CONTINUE - IF (E_C.EQ.SS$_ENDOFFILE) THEN !EOF SEEN - E_C=3 - GOTO 20 - END IF - CALL WNCTXT(F_TP,'Unable to read header block or data') - E_C=-1 !ERROR TYPE - 20 CONTINUE - NATRPH=.FALSE. -C - RETURN - END IF - FCAPT=FCAPT+2560 !READ POINTER - IF (M(1)(1:8).EQ.'SIMPLE') THEN - STARTHDR=.TRUE. - ELSE IF (M(1)(1:8).EQ.'TABLE FG') THEN - CALL NATRRT(FCA,FCAPT,M,-1,ENDHDR) !READ FG - E_C=4 !ERROR TYPE - GOTO 20 - END IF - END DO -C -C SCAN THROUGH HEADER, GETTING THE INTERESTING BITS -C - DO WHILE (.NOT.ENDHDR) - IF (.NOT.STARTHDR) THEN - IF (.NOT.WNFRD(FCA,2560,BUFFER,FCAPT)) GOTO 21 !READ A BLOCK - FCAPT=FCAPT+2560 !UPDATE PTR - END IF - STARTHDR=.FALSE. - VERSION=' ' - DO I=1,32 - IF(M(I)(1:8).EQ.'NAXIS2') THEN - READ (M(I)(11:30),'(I20)')N_COMPLEX - ELSE IF (M(I)(1:8).EQ.'NAXIS3') THEN - READ (M(I)(11:30),'(I20)')NSTOK - ELSE IF (M(I)(1:8).EQ.'NAXIS4') THEN - READ (M(I)(11:30),'(I20)')NFREQ - ELSE IF (M(I)(1:8).EQ.'NAXIS7') THEN -C -C Note fudge for intermediate format PTI data -C - READ (M(I)(11:30),'(I20)')NSTOK - ELSE IF (M(I)(1:8).EQ.'GCOUNT') THEN - READ (M(I)(11:30),'(I20)')NCOUNT - ELSE IF (M(I)(1:8).EQ.'PCOUNT') THEN - READ (M(I)(11:30),'(I20)')PCOUNT - ELSE IF (M(I)(1:8).EQ.'SCANS ') THEN - READ (M(I)(11:30),'(I20)')NSCAN - ELSE IF (M(I)(1:8).EQ.'INTIME') THEN - READ (M(I)(11:30),'(I20)')INTIME - ELSE IF (M(I)(1:8).EQ.'CRPIX4') THEN - READ (M(I)(11:30),'(G20.12)')CRPIX4 - ELSE IF (M(I)(1:8).EQ.'CRVAL4') THEN - READ (M(I)(11:30),'(G20.12)')FREQ - ELSE IF (M(I)(1:8).EQ.'CDELT4') THEN - READ (M(I)(11:30),'(G20.12)')DFREQ - ELSE IF (M(I)(1:8).EQ.'CRVAL5') THEN - READ (M(I)(11:30),'(G20.12)')RA - ELSE IF (M(I)(1:8).EQ.'CRVAL6') THEN - READ (M(I)(11:30),'(G20.12)')DEC - ELSE IF (M(I)(1:8).EQ.'RESTFREQ') THEN - READ (M(I)(11:30),'(G20.12)')RFREQ - ELSE IF (M(I)(1:8).EQ.'VELREF ') THEN - READ (M(I)(11:30),'(G20.12)')VELREF - ELSE IF (M(I)(1:8).EQ.'ALTRVAL ') THEN - READ (M(I)(11:30),'(G20.12)')VEL1 - ELSE IF (M(I)(1:8).EQ.'OBJECT ') THEN - READ (M(I)(12:30),'(A16)')OBJECT - ELSE IF (M(I)(1:8).EQ.'INSTRUME') THEN - READ (M(I)(12:30),'(A16)')INSTRUMENT - ELSE IF (M(I)(1:8).EQ.'CAL ') THEN - READ (M(I)(12:30),'(A16)')CAL - ELSE IF (M(I)(1:8).EQ.'OBSERVER') THEN - READ (M(I)(12:30),'(A16)') RP_OBSERVER - ELSE IF (M(I)(1:8).EQ.'VERSION ') THEN - READ (M(I)(12:30),'(A8)') VERSION - ELSE IF (M(I)(1:8).EQ.'DATE-OBS') THEN - READ (M(I)(12:40),'(A8,16X,A4)') DATOBS,DATSYS - ELSE IF (M(I)(1:8).EQ.'DATE ') THEN - READ (M(I)(12:30),'(A8)')DATWRIT - ELSE IF (M(I)(1:8).EQ.'EPOCH') THEN - READ (M(I)(12:30),'(A8)')COORD - ELSE IF (M(I)(1:5).EQ.'PRESS') THEN - READ (M(I)(6:40),'(I2,4X,G20.12)') K,MT_PRESS(K) - ELSE IF (M(I)(1:5).EQ.'TEMPE') THEN - READ (M(I)(6:40),'(I2,4X,G20.12)') K,MT_TEMP(K) - ELSE IF (M(I)(1:5).EQ.'HUMID') THEN - READ (M(I)(6:40),'(I2,4X,G20.12)') K,MT_HUMID(K) - ELSE IF (M(I)(1:5).EQ.'EPHEM') THEN - READ (M(I)(6:40),'(I2,4X,G20.12)') K,RP_C(K) - ELSE IF (M(I)(1:8).EQ.'DEFEAT ') THEN - READ (M(I)(11:30),'(I20)') RP_DEFEAT - ELSE IF (M(I)(1:8).EQ.'UTCMTAI ') THEN - READ (M(I)(11:30),'(G20.12)') RP_UTCMTAI - ELSE IF (M(I)(1:8).EQ.'DJMREFP ') THEN - READ (M(I)(11:30),'(G20.12)') RP_DJMREFP - ELSE IF (M(I)(1:8).EQ.'DJMREFT ') THEN - READ (M(I)(11:30),'(G20.12)') RP_DJMREFT - ELSE IF (M(I)(1:6).EQ.'TABLE ') THEN -C -C SORT OUT TABLES -C - CALL NATRRT(FCA,FCAPT,M,I,ENDHDR) - ELSE IF (M(I)(1:8).EQ.'END ') THEN -C -C END card. -C - ENDHDR=.TRUE. - END IF -C -C Write into "cards" array if necessary -C - IF (NCARD.GT.0) THEN - DO J=1,NCARD - NCHAR=0 - DO ICHAR=1,12 - IF (CARD(J)(ICHAR:ICHAR).NE.' ') NCHAR=ICHAR - END DO - IF (M(I)(1:NCHAR).EQ.CARD(J)(1:NCHAR)) CARD(J)=M(I) - END DO - ELSE IF (NCARD.LT.0) THEN - IF (ICARD.LE.MAX_CARD .AND. .NOT.ENDHDR) THEN - CARD(-NCARD)=M(I) - ICARD=ICARD+1 - NCARD=NCARD-1 - END IF - END IF -C -C Read antenna parameters (a) OLD FORMAT -C - IF(M(I)(1:8).EQ.'ANTENNA:') THEN - IF (.NOT.NEW_ANTENNA) THEN - NANT=0 - NEW_ANTENNA=.TRUE. - END IF - READ (M(I)(12:71),900) K,X(K),Y(K),Z(K),STA(K) - 900 FORMAT(I1,4X,G13.6,' Y=',G13.6,' Z=',G13.6,' STA=',A3) - NANT=NANT+1 - END IF -C -C Read antenna parameters (b) NEW FORMAT -C - IF (M(I)(1:8).EQ.'ANTENNA ') THEN - IF (.NOT.NEW_ANTENNA) THEN - NANT=0 - NEW_ANTENNA=.TRUE. - END IF - READ (M(I)(11:80),910) K,STA(K),X(K),Y(K),Z(K) - 910 FORMAT(i1,1X,A3,3X,G17.10,3X,G17.10,3X,G17.10) - NANT=NANT+1 - END IF - IF (ENDHDR) GO TO 2400 - END DO - 2400 CONTINUE - END DO - NCARD=ABS(NCARD) -C -C See whether WEIGHT is to be written -C - IF (N_COMPLEX.EQ.3) THEN - WRITE_WT=.TRUE. - ELSE - WRITE_WT=.FALSE. - END IF -C -C Insert default values into table commons if tables weren't found -C - IF (.NOT.IF_FOUND) THEN - N_IF=1 - IF_FREQ(1)=FREQ - IF_INVERT(1)=1 - IF_BW(1)=NFREQ*DFREQ - IF_NFREQ(1)=NFREQ - IF_NSTOK(1)=NSTOK - IF_REF(1)=CRPIX4 - DO I=1,4 - IF_CSTOK(I,1)=' ' - END DO - IF_SIMUL(1)=1 - IF_CHAIN(1)=1 - ELSE - FREQ=IF_FREQ(1) - NFREQ=IF_NFREQ(1) -C -C hm 18may90 added -1 below -C - IF (IF_NFREQ(1).GT.1) THEN - DFREQ=IF_BW(1)/(IF_NFREQ(1)-1) - ELSE - DFREQ=IF_BW(1)/IF_NFREQ(1) - END IF - NSTOK=IF_NSTOK(1) - END IF - IF (.NOT.SU_FOUND) THEN - N_SU=1 - SU_NAME(1)=OBJECT - SU_RA(1)=RA - SU_DEC(1)=DEC - ELSE - OBJECT=SU_NAME(1) - RA=SU_RA(1) - DEC=SU_DEC(1) - END IF -C -C Tidy up -C - IF (INSTRUMENT.EQ.'PTI') N_IF=1 - N_IF=MAX(N_IF,1) - IVELREF=VELREF+0.5 - NEW_ANTENNA=.FALSE. - BUFPTR=0 -C - RETURN !READY -C -C RPD -C - ENTRY NATRPD(FCA,FCAPT,VIS,BASEL,UT,U,V,W, - 1 FLAG,BIN,IFNO,SRCNO) -C - - NATRPD=.TRUE. !ASSUME OK -C -C READ DATA GROUP HEADER -C -C THE FOLLOWING POINTERS AND COUNTERS ARE USED HERE: -C GRPLENGTH No. of visibilities in group -C GRPPTR Pointer to next visibility in group to be read -C BUFPTR Pointer to next word to be read in current buffer -C BUFLEFT No. of words still to be read from current buffer -C -C Note that data are read in blocks of 5 records=640 (4byte) words -C - GRPPTR=1 - IFNO=1 - IF (WRITE_WT) THEN !WRITE WEIGHT - N_COMPLEX=3 - ELSE - N_COMPLEX=2 - END IF - IF (BUFPTR.EQ.0 .OR. BUFPTR.EQ.641) THEN - IF (.NOT.WNFRD(FCA,2560,BUFFER,FCAPT)) GOTO 21 !READ A BLOCK - FCAPT=FCAPT+2560 !UPDATE PTR - E_C=NATXSF(FCA,FCAPT,BUFFER) - IF (E_C.NE.0) THEN - FCAPT=FCAPT-2560 !RE-READ - GOTO 20 !ERROR - END IF - BUFPTR=1 - END IF -C -C READ PARAMETERS FROM FITS FILE -C FORMAT FROM RPFITS IS: -C ------ VIS data ------------- ----------- SYSCAL data ---- -C (baseline > 0) (baseline = -1) -C param 1=u in m 0.0 -C param 2=v in m 0.0 -C param 3=w in m 0.0 -C param 4=baseline number -1.0 -C param 5=UT in seconds sc_ut: UT in seconds -C param 6= flag (if present) sc_ant -C param 7= bin (if present) sc_if -C param 8= ifno (if present) sc_q -C param 9=sourceno (if present) sc_srcno -C - 3100 CONTINUE - BUFLEFT=641-BUFPTR -C -C ---------check for end of scan ------------- -C This is indicated by buffer being padded out with reserved -C operands. -C -C Old rpfits files may be padded with zeros, so check for u, -C baseline no and UT all zero. Assume that if next vis -C incomplete at end of buffer, next buffer will be all zeros. -C Mod by HM 19jun90 -C - ENDSCAN=.FALSE. - IF (BUFLEFT.GE.PCOUNT) THEN - IF (NATXCJ(I_BUFF(BUFPTR)).EQ.0 - 1 .AND. NATXCJ(I_BUFF(BUFPTR+3)).EQ. 0 - 1 .AND. NATXCJ(I_BUFF(BUFPTR+4)).EQ. 0) THEN - ENDSCAN=.TRUE. - END IF - END IF - IF (NATXCJ(I_BUFF(BUFPTR)).EQ.ILLEGAL .OR. ENDSCAN ) THEN - IF (.NOT.WNFRD(FCA,2560,BUFFER,FCAPT)) GOTO 21 !READ A BLOCK - FCAPT=FCAPT+2560 !FILE PTR - E_C=NATXSF(FCA,FCAPT,BUFFER) - IF (E_C.NE.0) THEN - FCAPT=FCAPT-2560 !RE-READ - GOTO 20 !ERROR - END IF - E_C=5 - GOTO 20 - END IF -C -C ------------NOW READ DATA ------------- -C - IF (BUFLEFT.GE.PCOUNT) THEN -C -C If it will all fit in current buffer, then things are easy -C - CALL NATRGP(FCA,FCAPT,BUFFER,I_BUFF,BUFPTR,BUFPTR,BUFFER, - 1 PCOUNT,U,V,W,BASEL, - 1 UT,FLAG,BIN,IFNO,SRCNO) - IF (E_C.EQ.-2) GOTO 3100 - IF (E_C.NE.0) GOTO 20 - BUFPTR=BUFPTR+PCOUNT - ELSE -C -C We can recover only part of the group header. -C dispose of what we have, then read the remainder from -C the next batch of data (pcount blocks). -C - DO I=1,BUFLEFT - GRPHDR(I)=BUFFER(BUFPTR+I-1) - END DO - IF (.NOT.WNFRD(FCA,2560,BUFFER,FCAPT)) GOTO 21 !READ A BLOCK - FCAPT=FCAPT+2560 !UPDATE PTR - E_C=NATXSF(FCA,FCAPT,BUFFER) - IF (E_C.NE.0) THEN - FCAPT=FCAPT-2560 !RE-READ - GOTO 20 - END IF - BUFPTR=PCOUNT-BUFLEFT -C -C Extract bufptr items from the next buffer -C - DO I=1,BUFPTR - GRPHDR(I+BUFLEFT)=BUFFER(I) - END DO - CALL NATRGP(FCA,FCAPT,GRPHDR,I_GRPHDR,1,BUFPTR,BUFFER, - 1 PCOUNT,U,V,W,BASEL, - 1 UT,FLAG,BIN,IFNO,SRCNO) - IF (E_C.EQ.-2) GOTO 3100 - IF (E_C.NE.0) GOTO 20 -C -C Set bufptr to the first visibility in the new buffer. -C - BUFPTR=BUFPTR+1 - END IF -C -C Determine GRPLENGTH -C - IF (BASEL.EQ.-1) THEN - GRPLENGTH=SC_Q*SC_IF*SC_ANT - ELSE IF (IFNO.GT.1) THEN - GRPLENGTH=IF_NFREQ(IFNO)*IF_NSTOK(IFNO) - ELSE - GRPLENGTH=NSTOK*NFREQ - END IF - IF (BASEL.EQ.-1) GO TO 4000 -C -C----------------------READ VIS DATA GROUP ----------------------------- -C -C READ DATA FROM FITS FILE, FORMAT FROM RPFITS IS: -C word 1= Re(vis) -C word 2= Imag(vis) -C word 3= weight (if n_complex=3) -C - 3500 CONTINUE - LAST_GOOD_UT=UT - BUFLEFT=641-BUFPTR - IF (BUFLEFT.GE.(N_COMPLEX*(GRPLENGTH-GRPPTR+1))) THEN -C -C If entire group can be filled from existing buffer then do so -C - DO I=GRPPTR,GRPLENGTH - VIS(I)=CMPLX(NATXCE(BUFFER(BUFPTR)), - 1 NATXCE(BUFFER(BUFPTR+1))) -C IF (WRITE_WT) THEN -C WEIGHT(I)=NATXCE(BUFFER(BUFPTR+2)) -C END IF - BUFPTR=BUFPTR+N_COMPLEX - END DO - E_C=0 -C - RETURN - ELSE -C -C Otherwise things are a bit more complicated, first read -C complete visibilities in old buffer. -C - BUFLEFT3=BUFLEFT/N_COMPLEX - DO I=1,BUFLEFT3 - VIS(GRPPTR+I-1)=CMPLX(NATXCE(BUFFER(BUFPTR)), - 1 NATXCE(BUFFER(BUFPTR+1))) -C IF (WRITE_WT) THEN -C WEIGHT(GRPPTR+I-1)=NATXCE(BUFFER(BUFPTR+2)) -C END IF - BUFPTR=BUFPTR+N_COMPLEX - END DO - GRPPTR=GRPPTR+BUFLEFT3 -C -C Read the fraction of a visibility left in old buffer -C - BUFLEFT=BUFLEFT-N_COMPLEX*BUFLEFT3 - IF (BUFLEFT.EQ.1) REVIS=NATXCE(BUFFER(640)) - IF (N_COMPLEX.EQ.3 .AND. BUFLEFT.EQ.2) VIS(GRPPTR)= - 1 CMPLX(NATXCE(BUFFER(639)),NATXCE(BUFFER(640))) -C -C Now read in a new buffer -C - IF (.NOT.WNFRD(FCA,2560,BUFFER,FCAPT)) GOTO 21 !READ A BLOCK - FCAPT=FCAPT+2560 !UPDATE PTR - E_C=NATXSF(FCA,FCAPT,BUFFER) - IF (E_C.NE.0) THEN - FCAPT=FCAPT-2560 !RE-READ - GOTO 20 - END IF -C -C Fill any incomplete visibility -C - IF (BUFLEFT.EQ.0) THEN - BUFPTR=1 - ELSE IF (BUFLEFT.EQ.1) THEN - VIS(GRPPTR)=CMPLX(REVIS,NATXCE(BUFFER(1))) -C IF (WRITE_WT) THEN -C WEIGHT(GRPPTR)=NATXCE(BUFFER(2)) -C ENDIF - GRPPTR=GRPPTR+1 - BUFPTR=N_COMPLEX - ELSE IF (BUFLEFT.EQ.2 .AND. N_COMPLEX.EQ.3) THEN -C IF (WRITE_WT) THEN -C WEIGHT(GRPPTR)=NATXCE(BUFFER(1)) -C END IF - GRPPTR=GRPPTR+1 - BUFPTR=2 - END IF -C -C Return to pick up the rest of the group -C - END IF - GO TO 3500 -C -C----------------------READ SYSCAL DATA GROUP -------------------------- -C -C READ DATA FROM FITS FILE -C note that in this conmtext GRPLENGTH is in units of words, -C not visibilities . -C - 4000 CONTINUE - BUFLEFT=641-BUFPTR - IF (BUFLEFT.GE.(GRPLENGTH-GRPPTR+1)) THEN -C -C If entire group can be filled from existing buffer then do so -C - DO I=GRPPTR,GRPLENGTH - SC_BUF(I)=NATXCE(BUFFER(BUFPTR)) - BUFPTR=BUFPTR+1 - END DO - E_C=0 -C - RETURN - ELSE -C -C Otherwise read complete visibilities in old buffer -C - DO I=1,BUFLEFT - SC_BUF(GRPPTR+I-1)=NATXCE(BUFFER(BUFPTR)) - BUFPTR=BUFPTR+1 - END DO - GRPPTR=GRPPTR+BUFLEFT -C -C Then read in a new buffer -C - IF (.NOT.WNFRD(FCA,2560,BUFFER,FCAPT)) GOTO 21 !READ A BLOCK - FCAPT=FCAPT+2560 !UPDATE PTR - E_C=NATXSF(FCA,FCAPT,BUFFER) - IF (E_C.NE.0) THEN - FCAPT=FCAPT-2560 !RE-READ - GOTO 20 - END IF - BUFPTR=1 -C -C and then return to pick up the rest of the group -C - END IF - GO TO 4000 -C -C - END diff --git a/src/nscan/natrrt.for b/src/nscan/natrrt.for deleted file mode 100644 index cda8a5edaf1df7b951ee0f6fd497622943080f8f..0000000000000000000000000000000000000000 --- a/src/nscan/natrrt.for +++ /dev/null @@ -1,97 +0,0 @@ -C+ NATRRT.FOR -C WNB 920429 -C -C Revisions: -C RPN 29/9/88 -C HM 11/5/90 Made mods necessary for compilation on SUNs -C HM 29/1/91 Reduced lines to 72 chars -C - SUBROUTINE NATRRT(FCA,FCAPT,M,II,ENDHDR) -C -C Read RPFITS tape table. Based on RPFITS_READ_TABLE -C -C Result: -C -C CALL NATRRT( FCA_J:I, FCAPT_J:IO, M_C80(32):IO, II_J:I, -C ENDHDR_L:IO) -C Read a table from FCA based on card images in M -C starting at II currently (-1 indicates only FG -C wanted). ENDHDR will be set .true. if -C end-of-header encountered. -C -C Include files: -C - INCLUDE 'WNG_DEF' - INCLUDE 'RPF_DEF' !RPFITS OUTPUT -C -C Parameters: -C -C -C Arguments: -C - INTEGER FCA !FILE CONTROL AREA - INTEGER FCAPT !FILE POINTER - CHARACTER*80 M(32) !CARD IMAGES - INTEGER II !CURRENT CARD IMAGE (OR -1 FOR FG) - LOGICAL ENDHDR !END-OF-HEADER SEEN -C -C Entry points: -C -C -C Function references: -C - LOGICAL WNFRD !READ DISK -C -C Data declarations: -C - LOGICAL FG_ONLY !ONLY FG - INTEGER ICHR(20,32) !BUFFER -C- - I=ABS(II) - FG_ONLY=(II.EQ.-1) - DO WHILE (.NOT.ENDHDR) - IF (NCARD.LT.0) THEN - CARD(-NCARD)=M(I) - NCARD=NCARD-1 - END IF - IF (M(I)(1:8).EQ.'TABLE IF') THEN - CALL NATRIF(FCA,FCAPT,M,I) - ELSE IF (M(I)(1:8).EQ.'TABLE SU') THEN - CALL NATRSU(FCA,FCAPT,M,I) - ELSE IF (M(I)(1:8).EQ.'TABLE FG') THEN - CALL NATRFG(FCA,FCAPT,M,I) - ELSE IF (M(I)(1:8).EQ.'TABLE AN') THEN - CALL NATRAN(FCA,FCAPT,M,I) - ELSE IF (M(I)(1:8).EQ.'TABLE MT') THEN - CALL NATRMT(FCA,FCAPT,M,I) - ELSE IF (M(I)(1:8).EQ.'TABLE CU') THEN - CALL NATRCU(FCA,FCAPT,M,I) - ELSE IF (M(I)(1:8).EQ.'END ') THEN - ENDHDR=.TRUE. -C - RETURN - END IF - IF (FG_ONLY) THEN - ENDHDR=.FALSE. -C - RETURN - END IF - I=I+1 - IF (I.GT.32) THEN - IF (.NOT.WNFRD(FCA,2560,ICHR,FCAPT)) THEN !READ BLOCK - ENDHDR=.TRUE. !ASSUME END IF READ -C !ERROR - RETURN - END IF - FCAPT=FCAPT+2560 !UPDATE POINTER - DO I=1,32 - CALL WNGMTS(80,ICHR(1,I),M(I)) !SAVE IN STRING - END DO - I=0 - END IF - END DO -C - RETURN -C -C - END diff --git a/src/nscan/natxcj.for b/src/nscan/natxcj.for deleted file mode 100644 index 671c4641f13ef1a4bb1fa39d7646881f3a7e1515..0000000000000000000000000000000000000000 --- a/src/nscan/natxcj.for +++ /dev/null @@ -1,63 +0,0 @@ -C+ NATXCJ.FOR -C WNB 920506 -C -C Revisions: -C - INTEGER FUNCTION NATXCJ(VALJ) -C -C Convert VAX values to local values -C -C Result: -C -C NATXCJ_J = NATXCJ( VALJ_J:I) -C Convert VALJ from VAX to local -C NATXCE_E = NATXCE( VALE_E:I) -C Convert VALE from VAX to local -C -C Include files: -C - INCLUDE 'WNG_DEF' -C -C Parameters: -C -C -C Arguments: -C - INTEGER VALJ !VALUE TO CONVERT - REAL VALE -C -C Entry points: -C - REAL NATXCE !CONVERT REAL -C -C Function references: -C -C -C Data declarations: -C - INTEGER*2 CODJ(4) !CONVERT J - DATA CODJ/3,1,0,1/ - INTEGER*2 CODE(4) !CONVERT E - DATA CODE/4,1,0,1/ -C- -C -C NATXCJ -C - J0=VALJ !VALUE - CALL WNTTDL(LB_J,J0,CODJ) !CONVERT - NATXCJ=J0 -C - RETURN -C -C NATXCE -C - ENTRY NATXCE(VALE) -C - R0=VALE !VALUE - CALL WNTTDL(LB_E,R0,CODE) !CONVERT - NATXCE=R0 -C - RETURN -C -C - END diff --git a/src/nscan/natxib.for b/src/nscan/natxib.for deleted file mode 100644 index bca5ef3b551885d254712722885df42a69181da8..0000000000000000000000000000000000000000 --- a/src/nscan/natxib.for +++ /dev/null @@ -1,80 +0,0 @@ -C+ NATXIB.FOR -C WNB 920506 -C -C Revisions: -C - LOGICAL FUNCTION NATXIB(BASEL,IFNO,UT,U,V,W) -C -C Check for illegal baseline (based on ILLBASE) -C -C Result: -C -C NATXIB_L = NATXIB( BASEL_E:I, IFNO_J:I, UT_E:I, U_E:I, V_E:I, W_E:I) -C Test for illegal BASEL and IFNO -C -C Include files: -C - INCLUDE 'WNG_DEF' - INCLUDE 'RPF_DEF' !RPFITS DATA AREA -C -C Parameters: -C - REAL BMAX,BMIN !MAX, MIN BASEL ALLOWED - PARAMETER (BMAX=256*6+6, - 1 BMIN=256+1) -C -C Arguments: -C - REAL BASEL !BASELINE TO CHECK - INTEGER IFNO !IF # TO CHECK - REAL UT !TIME TO CHECK - REAL U,V,W !BASELINE TO CHECK -C -C Entry points: -C -C -C Function references: -C -C -C Data declarations: -C - LOGICAL SYSC -C- -C -C Deal with floating point baseline first -C - NATXIB=.FALSE. !ASSUME LEGAL - SYSC=(BASEL.GT.-1.0001 .AND. BASEL.LT.-0.9999) - IF (.NOT.SYSC) THEN - IF (BASEL.GT.BMAX .OR. BASEL.LT.BMIN) THEN - NATXIB=.TRUE. -C - RETURN - ELSE IF (ABS(BASEL-NINT(BASEL)).GT.0.001) THEN -C -C This value is not close enough to an integer to be valid -C - NATXIB=.TRUE. -C - RETURN - END IF - END IF -C -C Now check the rest -C - NATXIB=( - 1 (UT.LT.0. .OR. UT.GT.172800.) .OR. - 1 (.NOT.SYSC .AND. - 1 ((IFNO.LT.0 .OR. IFNO.GT.MAX_IF) .OR. - 1 (U.LT.-1.E10 .OR. U.GT. 1.E10) .OR. - 1 (V.LT.-1.E10 .OR. V.GT. 1.E10) .OR. - 1 (W.LT.-7.E6 .OR. W.GT. 7.E6))) .OR. - 1 (SYSC .AND. - 1 ((SC_ANT.LT.1 .OR. SC_ANT.GT.ANT_MAX) .OR. - 1 (SC_IF.LT.1 .OR. SC_IF.GT.MAX_IF) .OR. - 1 (SC_Q.LT.1 .OR. SC_Q.GT.100)))) -C - RETURN -C -C - END diff --git a/src/nscan/natxsf.for b/src/nscan/natxsf.for deleted file mode 100644 index adc3eca938c0301200519037b3e16ebd98792442..0000000000000000000000000000000000000000 --- a/src/nscan/natxsf.for +++ /dev/null @@ -1,70 +0,0 @@ -C+ NATXSF.FOR -C WNB 920429 -C -C Revisions: -C - INTEGER FUNCTION NATXSF(FCA,FCAPT,BUFFER) -C -C Test for header or FG table (based on SIMPLE) -C -C Result: -C -C NATXSF_J = NATXSF( FCA_J:I, FCAPT_J:IO, BUFFER_E(20,32):IO) -C Test for start new header or FG table. Return -C 0 (no), 1 (yes), 4 (FG) -C -C Include files: -C - INCLUDE 'WNG_DEF' -C -C Parameters: -C -C -C Arguments: -C - INTEGER FCA !FILE CONTROL AREA - INTEGER FCAPT !FILE POINTER - REAL BUFFER(20,32) !CARD BUFFER -C -C Entry points: -C -C -C Function references: -C -C -C Data declarations: -C - LOGICAL ENDHDR !END-OF-HEADER SEEN - CHARACTER*80 M(32) !BUFFER -C- -C -C NATXSF -C -C Assume not found -C - NATXSF=0 -C -C Write first 8 characters from buffer into character string m -C - CALL WNGMTS(8,BUFFER(1,1),M(1)) - IF (M(1)(1:6).EQ.'SIMPLE') THEN -C -C Start of header. -C - NATXSF=1 - ELSE IF (M(1)(1:8).EQ.'FG TABLE') THEN -C -C Start of FG (flag) table. -C - ENDHDR=.FALSE. - DO I=1,32 !SET CHAR. BUFFER - CALL WNGMTS(80,BUFFER(1,I),M(I)) - END DO - CALL NATRRT(FCA,FCAPT,M,-1,ENDHDR) - NATXSF=4 - END IF -C - RETURN -C -C - END diff --git a/src/nscan/natxst.for b/src/nscan/natxst.for deleted file mode 100644 index f42d66859266ad23dc8f15136dbdfee7f9f491a4..0000000000000000000000000000000000000000 --- a/src/nscan/natxst.for +++ /dev/null @@ -1,108 +0,0 @@ -c+ NATXST.FOR -C WNB 920506 -C -C Revisions: -C - LOGICAL FUNCTION NATXST(FCA,FCAPT,BUFPTR,BUFFER) -C -C Skip to recognisable data (based on SKIPTHRU) -C -C Result: -C -C NATXST_L = NATXST( FCA_J:I, FCAPT_J:IO, BUFPTR_J:IO, BUFFER_E(640):O) -C Skip through data to look for recognisable -C data. -C -C Include files: -C - INCLUDE 'WNG_DEF' - INCLUDE 'RPF_DEF' !RPFITS DATA AREA -C -C Parameters: -C - INTEGER SS$_ENDOFFILE !EOF INDICATOR - PARAMETER (SS$_ENDOFFILE='870'X) -C -C Arguments: -C - INTEGER FCA !FILE - INTEGER FCAPT !FILE POINTER - INTEGER BUFPTR !BUFFER PTR - REAL BUFFER(640) !DATA BUFFER -C -C Entry points: -C -C -C Function references: -C - LOGICAL WNFRD !READ DATA - INTEGER NATXSF !CHECK FOR SIMPLE OR FG TABLE - INTEGER NATXCJ !MAKE J - INTEGER WNGGJ !DO AS IF J - REAL NATXCE !MAKE E - LOGICAL NATXIB !CHECK BASELINE -C -C Data declarations: -C - INTEGER BASEL !BASELINE - REAL RBASE !BASELINE - INTEGER IFNO !IF - REAL UT,U,V,W !COORDINATES -C- - NATXST=.FALSE. !ASSUME ERROR - DO WHILE(.TRUE.) !LOOP THROUGH FILE -C -C First read a new block, since remains of old one is unlikely to -C contain anything useful (and at most one integration) -C - IF (.NOT.WNFRD(FCA,2560,BUFFER,FCAPT)) THEN !READ A BLOCK - IF (E_C.EQ.SS$_ENDOFFILE) THEN !EOF SEEN - E_C=3 -C - RETURN - END IF - CALL WNCTXT(F_TP,'Unable to read next block') - E_C=-1 !ERROR TYPE -C - RETURN - END IF - FCAPT=FCAPT+2560 !UPDATE PTR -C -C Check to see if it's a header block -C - E_C=NATXSF(FCA,FCAPT,BUFFER) - IF (E_C.NE.0) THEN - FCAPT=FCAPT-2560 !RE-READ - NATXST=.TRUE. !FOUND HEADER -C - RETURN - END IF - BUFPTR=1 -C -C Skip through the block looking for something legal -C - DO WHILE (BUFPTR.LE.632) - U =NATXCE(BUFFER(BUFPTR)) - V =NATXCE(BUFFER(BUFPTR+1)) - W =NATXCE(BUFFER(BUFPTR+2)) - RBASE =NATXCE(BUFFER(BUFPTR+3)) - UT =NATXCE(BUFFER(BUFPTR+4)) - IFNO =NATXCJ(WNGGJ(BUFFER(BUFPTR+7))) - IF (.NOT.NATXIB(RBASE,IFNO,UT,U,V,W)) THEN - BASEL=NINT(RBASE) - NATXST=.TRUE. !FOUND DATA - E_C=-2 -C - RETURN - END IF - BUFPTR=BUFPTR+1 - END DO -C -C OK lets do it all again -C - END DO -C - RETURN -C -C - END diff --git a/src/nscan/nca.dsc b/src/nscan/nca.dsc deleted file mode 100644 index e31648e9155c627cc500f6f0fc7bab62de83f4c9..0000000000000000000000000000000000000000 --- a/src/nscan/nca.dsc +++ /dev/null @@ -1,130 +0,0 @@ -!+ NCA.DSC -! WNB 900306 -! -! Revisions: -! -%REVISION=JPH=970403="Add USIGN" -%REVISION=JPH=960802="Shorten OPTION, insert DOWNWT" -%REVISION=JPH=951124="Comments" -%REVISION=WNB=950614="Add DOMIFR" -%REVISION=HjV=95-6-9="Add CIFRS" -%REVISION=CMV=940503="Add CEQUAL" -%REVISION=CMV=940429="Add IFRCOR -%REVISION=CMV=940331="Add TELS" -%REVISION=WNB=931126="Add XOSOL" -%REVISION=JPH=930825="Comments. - COR_ parameters" -%REVISION=JPH=930825="Comments. - COR_ parameters" -%REVISION=WNB=930803="Remove .INCLUDE; use NSTAR.DSF" -%REVISION=WNB=921120="Change units HAINT" -%REVISION=WNB=910812="Add ALIGN" -%REVISION=WNB=910612="Add loops" -%REVISION=WNB=900306="Original version" -! -! Layout of overall include file (NCA.DEF) -! -%COMMENT="NCA.DEF is an INCLUDE file for the NCALIB program" -%COMMENT=" " -! -%VERSION=1 -%SYSTEM=1 -%USER=WNB -%%DATE -%%NAME -! -! Get number of telescopes -! -%INCLUDE=NSTAR_DSF -! -%LOCAL=MXNSET=64 !SETS per job -%LOCAL=NIFR=NSTAR_TEL*(NSTAR_TEL+1)/2 !# INTERFEROMETERS -!- -.DEFINE - .PARAMETER - MXNSET J /MXNSET/ !MAX. SETS PER GO -!enumerate correction types for NCASTY !MAX. SETS PER GO - COR_FRQ J /1/ - COR_DX J /2/ - COR_DY J /3/ - COR_DZ J /4/ - COR_POLE J /5/ - COR_MUL J /16/ -!and for NCASTX etc - COR_EXT J /6/ - COR_REF J /7/ - COR_CLK J /8/ - COR_FAR J /9/ - COR_IRF J /10/ - COR_AIFR J /11/ - COR_MIFR J /12/ - .DATA -! -! Local variables: -! - .COMMON - OPTION C20 !PROGRAM OPTION - OPT=OPTION C3 - DOWNWT R ! weight reduction factor - SETS J(0:7,0:MXNSET) !SETS TO DO - FCAOUT J !OUTPUT FCB - FILOUT C160 !FILE NAME - NODOUT C80 !NODE NAME - SETINP J(0:7,0:MXNSET) !SETS TO DO - FCAINP J !OUTPUT FCB - FILINP C160 !FILE NAME - NODINP C80 !NODE NAME - RS1 J !ALIGNMENT - HARAN E(2) !HA RANGE - HAINT E !INTEGRATION TIME - BASDEV E !BASELINE DEVIATION - WGTMIN E !MIN. WEIGHT - XYSOL L(0:1) !X/Y SOLUTION - APSOL L(0:1) !AMPL/PHASE SOLUTION - XSOLVE L !COMPLEX SOLUTION - CSOLVE L !CONTINUITY IN SOLUTION - DOALG L !DO ALIGN/SELFCAL - DOSCAL L !DO SELFCAL - FORFRE L(0:1) !FORCE ALIGN FREEDOMS - XOSOL L !SOLVE ONLY COMPLEX - RES1 L - FREGPH J(0:NSTAR_TEL-1,0:1) !GAIN/PHASE FREEDOM - FORPER E(0:13) !PHASE START - RIN E(3) !CHECK VALUES - SHLV J(0:4) !PRINT LEVELS -! - JAV J(0:NIFR-1,0:4,0:1,0:1) !COUNTS FOR NOISE AVERAGES - EAV E(0:NIFR-1,0:4,0:1,0:1) !NOISE AVERAGES - DAV D(0:NIFR-1,0:4,0:1,0:1) !NOISE AVERAGES RMS - ! see NCARPS for details on the - ! use of these arrays -! - SIFRS B(0:NSTAR_TEL-1,0:NSTAR_TEL-1) !SELECTED INTERFEROMETERS - SPOL J !SELECTED POLARISATIONS - NSRC J(0:2) !SOURCES TO USE - MWGT J !MODEL WEIGHT TYPE - MWGTD E(0:2) !MODEL WEIGHT DATA - CORAP J !CORRECTIONS TO APPLY - CORDAP J !CORRECTIONS TO DE-APPLY - CORZE J !CORRECTIONS TO ZERO - CFREF E(0:2) !REFRACTION COEFFICIENTSS in - !the formula - ! N = C0 +C1*FRQ +C2*FRQ**2 - ! (with 0FRQ in GHz) - !also used as buffer for value - ! of STH_SHFT, STH_CLK, - ! STH_IREF - CFEXT E(0:2) !EXTINCTION COEFFICIENTS - ! (same) - PCGAN E(0:NSTAR_TEL-1,0:1) !GAIN CORRECTIONS GIVEN - PCPHS E(0:NSTAR_TEL-1,0:1) !PHASE CORRECTIONS GIVEN - LFLDS J(0:1) !LOOP FIELDS - LCHANS J(0:1) !LOOP CHANNELS - LPOFF J(0:7) !LOOP OFFSETS - TELS B(0:NSTAR_TEL-1) !TELESCOPES SELECTED - IFRCOR X(0:NIFR-1,0:3) !IFR CORRECTIONS (XX,XY,YX,YY) - CEQUAL J !Copy cal's with equal length - CIFRS B(0:NSTAR_TEL-1,0:NSTAR_TEL-1) !Selected correction IFRS -%ALIGN - DOMIFR L !Indicate MIFR asked - USIGN E !Stokes-U sign: 0 or PI for U - ! <0 or >0 -.END diff --git a/src/nscan/nca.grp b/src/nscan/nca.grp deleted file mode 100644 index 06998bc46a46ad4eef5fdb6bafd644c501e95cdc..0000000000000000000000000000000000000000 --- a/src/nscan/nca.grp +++ /dev/null @@ -1,119 +0,0 @@ -!+ NCA.GRP -! WNB 900306 -! -! Revisions: -! WNB 910812 Add ALIGN -! WNB 910923 Add POT,POE,POC -! WNB 911004 Add NCAPVZ, PVA, PVM, PVQ -! WNB 911009 Add STN -! WNB 921211 Change PEF/PSC -! WNB 921217 Add NCACCP, NCACL1, NCAST1 -! HjV 921221 Now really added NCACCP -! WNB 930602 Add NCASTI, NCASTK, NCASTY -! WNB 930617 Add NCASTS -! HjV 940217 Add/change missing entry-points/functions -! CMV 940428 Add NCATEL -! HjV 940726 Add missing entry-point NCATL1 -! WNB 950611 Remove NCARDS routine -! HjV 950713 Add NCACIC -! AXC 010628 Changes for linux port -! WNB 080711 Add NCASTV -! WNB 081226 Add NCAPOI -! -! Calibration -! -! Group definition: -! -NCA.GRP -! -! PIN files -! -NCALIB.PSC -! -! Structure files -! -! -! Fortran definition files: -! -NCA.DSC ! Program common/parameters -! NCA.DEF ! Fortran include -! NCA.INC ! C include -! -! Programs: -! -NCALIB.FOR ! Main routine -NCACCP.FOR ! Set interpolated calibrator corrections -NCACIC.FOR !NCACIC Calculate average MIFR corrections - !NCACI1 Calculate MIFR for limites # of scans -NCACLC.FOR !NCACLC Calculate average scan corrections - !NCACL1 Calculate for limites # of scans -NCADAT.FOR !NCADAT Get program data -NCAINI.FOR !NCAINI Initialise program -NCAPOL.FOR !NCAPOL Calculate polarisation corrections - !NCAPOS Show polarisation corrections - !NCAPOZ Zero polarisation corrections - !NCAPOT Set corrections manually - !NCAPOE Edit corrections - !NCAPOC Copy corrections - !NCAPOI Invert corrections -NCAPVZ.FOR !NCAPVZ Calculate and show X-Y phase - !NCAPVA Apply X-Y phase - !NCAPVQ Apply after user consent - !NCAPVM Apply user supplied value -NCARAW.FOR !NCARAW Calculate align weights -NCARCS.FOR !NCARCS Get redundancy complex solution - !NCARCE Set complex solution error statistics - !NCARCC Correct error statistics - !NCASCS Get selfcal complex solution - !NCASCE Set selfcal complex error statistics - !NCASCC Correct selfcal error statistics - !NCAACS Get align complex solution - !NCAACE Set align complex error statistics - !NCAACC Correct align error statistics -NCARED.FOR !NCARED Do redundancy -NCARGR.FOR !NCARGR Print graphical info -NCARGS.FOR !NCARGS Get redundancy gain solution - !NCARGE Set gain solution error statistics - !NCARGC Correct error statistics - !NCARG1 Solve X/Y - !NCARG2 Solve X/Y with Q=0 - !NCASGS Get selfcal gain solution - !NCASGE Set selfcal gain error statistics - !NCASGC Correct selfcal error statistics - !NCAAGS Get align gain solution - !NCAAGE Set align gain error statistics - !NCAAGC Correct align error statistics -NCARMD.FOR !NCARMD Make data for redundancy -NCARPS.FOR !NCARPS Get redundancy phase solution - !NCARPE Set phase solution error statistics - !NCARPC Correct error statistics - !NCARP1 Solve X/Y - !NCARP2 Solve X/Y with Q=0 - !NCASPS Get selfcal phase solution - !NCASPE Set selfcal phase error statistics - !NCASPC Correct selfcal error statistics - !NCAAPS Get align phase solution - !NCAAPE Set align phase error statistics - !NCAAPC Correct align error statistics -NCARRT.FOR !NCARRT Get redundant table -NCARWR.FOR !NCARWR Write redundancy solution -NCASTZ.FSC !NCASTZ Zero corrections in scan file - !NCASTV Invert corrections in scanfile - !NCASTC Set corrections in scan file - !NCAST1 Set corrections in # of scans - !NCASTX Set extinction correction - !NCASTR Set refraction correction - !NCASTF Set Faraday rotation - !NCASTL Copy continuum corrections to line - !NCASTN Normalise telescope corrections - !NCASTI Set ionospheric refraction - !NCASTK Set clock corrections - !NCASTY Set dx etc corrections - !NCASTS Set shift corrections -NCATEL.FOR !NCATEL Find initial gain/phase corrections - !NCATL1 Idem but for single sector -! -! Executables -! -NCALIB.EXE ! Scan handling -!- diff --git a/src/nscan/ncaccp.for b/src/nscan/ncaccp.for deleted file mode 100644 index 87638f733cb7a379a766ac51b1b09dffdd7c7b60..0000000000000000000000000000000000000000 --- a/src/nscan/ncaccp.for +++ /dev/null @@ -1,156 +0,0 @@ -C+ NCACCP.FOR -C WNB 921217 -C -C Revisions: -C WNB 930606 Remove INCLUDE SCH_O -C - SUBROUTINE NCACCP(CSOL,CME) -C -C Set interpolated calibrator corrections on others sets -C -C Result: -C -C CALL NCACCP( CSOL_X(0:*,0:1):O, CME_X(0:*,0:1):O) -C will set interpolated calibrator corrections -C -C Include files: -C - INCLUDE 'WNG_DEF' - INCLUDE 'NCA_DEF' - INCLUDE 'STH_O_DEF' !SET HEADER -C -C Parameters: -C - INTEGER NEINIT !# TABLE ENTRIES INITIAL - PARAMETER (NEINIT=1024) -C -C Arguments: -C - REAL CSOL(0:1,0:STHTEL-1,0:1) !AVERAGE ERRORS G,P TEL X,Y - REAL CME(0:1,0:STHTEL-1,0:1) !AND M.E. -C -C Function references: -C - LOGICAL NSCSTL !GET A SET - LOGICAL WNGGVA !GET MEMORY -C -C Data declarations: -C - INTEGER NELEN !TABLE LENGTH - INTEGER NENR !# IN TABLE - INTEGER ENLEN,ENLJ,ENLD !ENTRY LENGTH - INTEGER TABAR !TABLE AREA - INTEGER TABD,TABJ !TABLE POINTERS - INTEGER STHP,STHPI(0:1) !POINTER TO SET HEADER - INTEGER SETNAM(0:7) !FULL SET NAME - BYTE STH(0:STHHDL-1) !SET HEADER - INTEGER*2 STHI(0:STHHDL/2-1) - INTEGER STHJ(0:STHHDL/4-1) - REAL STHE(0:STHHDL/4-1) - REAL*8 STHD(0:STHHDL/8-1) - EQUIVALENCE(STH,STHI,STHJ,STHE,STHD) -C- -C -C INIT -C - ENLEN=LB_D+2*LB_J !ENTRY LENGTH - ENLJ=ENLEN/LB_J - ENLD=ENLEN/LB_D - NELEN=0 !START TABLE LENGTH - NENR=0 !NO ENTRIES - TABAR=0 !NO TABLE -C -C SET UP TABLE -C - 10 CONTINUE - DO WHILE(NSCSTL(FCAINP,SETINP,STH(0),STHP,SETNAM,LPOFF)) !NEXT SET - CALL WNDSTI(FCAINP,SETNAM) !MAKE SURE PROPER NAME - D0=STHD(STH_MJD_D)+(STHJ(STH_SCN_J)-1)*STHE(STH_HAI_E)* - 1 STHD(STH_UTST_D) !MIDDLE OF OBS - J0=SETNAM(3) !CHANNEL - IF (NENR.GE.NELEN) THEN !NO TABLE SPACE - IF (.NOT.WNGGVA((NELEN+NEINIT)*ENLEN,J1)) THEN !NEW TABLE - CALL WNCTXT(F_TP,'No memory for calibrator table') - CALL WNGEX !STOP - END IF - IF (TABAR.NE.0) THEN - DO I=0,NENR-1 !MOVE TABLE - CALL WNGMV(ENLEN,A_B(TABAR-A_OB+ENLEN*I), - 1 A_B(J1-A_OB+ENLEN*I)) - END DO - CALL WNGFVA(NELEN*ENLEN,TABAR) !FREE OLD AREA - END IF - TABAR=J1 !NEW AREA - TABJ=(TABAR-A_OB+LB_D)/LB_J !TABLE J OFFSET - TABD=(TABAR-A_OB)/LB_D !TABLE D OFFSET - NELEN=NELEN+NEINIT !NEW LENGTH - END IF - DO I=0,NENR !FIND CHANNEL - IF (I.EQ.NENR .OR. - 1 A_J(TABJ+ENLJ*I).GT.J0 .OR. - 1 (A_J(TABJ+ENLJ*I).EQ.J0 .AND. - 1 A_D(TABD+ENLD*I).GT.D0)) THEN !INSERT HERE - DO I1=NENR-1,I,-1 !CREATE SPACE - CALL WNGMV(ENLEN,A_D(TABD+ENLD*I1), - 1 A_D(TABD+ENLD*(I1+1))) - END DO - A_D(TABD+ENLD*I)=D0 !SET TIME - A_J(TABJ+ENLJ*I)=J0 !SET CHANNEL - A_J(TABJ+ENLJ*I+1)=STHP !SET SET HEADER PTR - NENR=NENR+1 !COUNT ENTRY - END IF - END DO - END DO !NEXT INPUT SET -C -C DO ALL OUTPUT SETS -C - DO WHILE(NSCSTL(FCAOUT,SETS,STH(0),STHP,SETNAM,LPOFF)) !NEXT SET - CALL WNDSTI(FCAINP,SETNAM) !MAKE SURE PROPER NAME - D0=STHD(STH_MJD_D)+(STHJ(STH_SCN_J)-1)*STHE(STH_HAI_E)* - 1 STHD(STH_UTST_D) !MIDDLE OF OBS - J0=SETNAM(3) !CHANNEL - J1=-1 !NO CHANNEL - DO I=0,NENR-1 !FIND IF CHANNEL PRESENT - IF (A_J(TABJ+ENLJ*I).EQ.0 .AND. J1.LT.0) J1=0 !CHANNEL 0 PRESENT - IF (A_J(TABJ+ENLJ*I).EQ.J0) THEN !FOUND CHANNEL - J1=J0 - GOTO 20 - END IF - END DO - 20 CONTINUE - DO I=0,1 - STHPI(I)=0 !SET NONE FOUND - END DO - IF (J1.GE.0) THEN !FIND TIME - DO I=0,NENR !FIND TIME - IF (I.EQ.NENR .OR. - 1 A_J(TABJ+ENLJ*I).GT.J1 .OR. - 1 (A_J(TABJ+ENLJ*I).EQ.J1 .AND. - 1 A_D(TABD+ENLD*I).GT.D0)) THEN !FOUND BEYOND - IF (I.LT.NENR .AND. A_J(TABJ+ENLJ*I).EQ.J1) - 1 STHPI(1)=A_J(TABJ+ENLJ*I+1) !BEYOND STHP - IF (I.GT.0 .AND. A_J(TABJ+ENLJ*(I-1)).EQ.J1) - 1 STHPI(0)=A_J(TABJ+ENLJ*(I-1)+1) !BEFORE STHP - GOTO 21 !READY WITH CHECK - END IF - END DO - 21 CONTINUE - ENDIF - CALL NCACL1(CSOL,CME,2,STHPI) !CALUCULATE AVERAGES - DO I3=0,1 !X,Y - DO I2=0,STHTEL-1 !EXTERNAL FORMAT - PCGAN(I2,I3)=EXP(CSOL(0,I2,I3)) !GAIN - PCPHS(I2,I3)=CSOL(1,I2,I3)*DEG !PHASE - END DO - END DO - CALL NCAST1(STHP) !SET AVERAGES - END DO !NEXT SET -C -C READY -C - IF (TABAR.NE.0) CALL WNGFVA(NELEN*ENLEN,TABAR) !FREE TABLE -C - RETURN !READY -C -C - END diff --git a/src/nscan/ncacic.for b/src/nscan/ncacic.for deleted file mode 100644 index 960b3bf4499323cebe257b036050aaed343ba3a5..0000000000000000000000000000000000000000 --- a/src/nscan/ncacic.for +++ /dev/null @@ -1,292 +0,0 @@ -C+ NCACIC.FOR -C HjV 950620 Copy of NCACLC -C HjV 960411 Take all interferometers. (Also 00, 11 etc.) -C -C Revisions: -C -C - SUBROUTINE NCACIC(CSOL,CME) -C -C Calculate average MIFR corrections in scan file. -C - -C -C Result: -C -C CALL NCACIC( CSOL_X(0:3,0:*,0:1):O, CME_X():3,0:*,0:1):O) -C will calculate MIFR average log. corrections in scans -C CALL NCACI1( CSOL_X(0:3,0:*,0:1):O, CME_X(0:3,0:*,0:1):O, -C NSTHPI_J:I, STHPI_J(0:*):I) -C will calculate MIFR average corrections for NSTHPI scans -C whose file addresses are in STHPI -C -C The method is to first average sine and cosine values to get an initial -C guess for the phase. Then, using this guess. the gains and phases are -C averaged. -C This guarantees phase continuity except in pathological cases where the -C averages would be meaningless anyway. -C -C -C Include files: -C - INCLUDE 'WNG_DEF' - INCLUDE 'NCA_DEF' - INCLUDE 'LSQ_O_DEF' - INCLUDE 'STH_O_DEF' !SET HEADER - INCLUDE 'SCH_O_DEF' !SCAN HEADER -C -C Parameters: -C -C -C Arguments: -C - REAL CSOL(0:1,0:3,0:STHIFR-1,0:1) !AVERAGE ERRORS (G/P,POL,IFR,APP/DE-APP) - REAL CME(0:1,0:3,0:STHIFR-1,0:1) !AND M.E. (VARIANCES) - INTEGER NSTHPI !# OF INPUT SETS - INTEGER STHPI(0:*) !INPUT SETS -C -C Function references: -C - CHARACTER*32 WNTTSG !SET NAME - LOGICAL WNMLGA !INIT. LSQ - LOGICAL WNFRD !READ DATA - REAL WNGENR !NORM. ANGLE - LOGICAL NSCSTL !GET A SET - LOGICAL NSCSCX !GET SCAN ERRORS - LOGICAL NSCSIF !GET INTERFEROMETER TABLE -C -C Data declarations: -C - LOGICAL DOCL1 !CL1/CLC SWITCH - LOGICAL GUESS !GUESS LOOP - INTEGER CSTHI !STH COUNT - INTEGER MINSCN !MINIMUM NUMBER OF SCANS - INTEGER CNTSCN !COUNT NUMBER OF SCANS - INTEGER MAR !LSQ AREA - INTEGER SETNAM(0:7) !FULL SET NAME - REAL HA !HA OF SCAN - INTEGER IFRA(0:1,0:STHIFR-1) - INTEGER*2 IFRT(0:STHIFR-1) !IFR TABLES - REAL ANG(0:2,0:STHIFR-1) - REAL TCOR(0:1,0:STHTEL-1,0:1) !ERRORS READ (G/P,TEL,X/Y) - COMPLEX CCOR(0:STHTEL-1,0:1) !TEL. CORRECTIONS - EQUIVALENCE (TCOR,CCOR) - REAL IMCOR(0:1,0:3,0:STHIFR-1,0:1) !(G/P,POL,IFR,APPLY/DE-APPLY) - COMPLEX CIMCOR(0:3,0:STHIFR-1,0:1) !(DE-)APPLY MIFR CORR - EQUIVALENCE (IMCOR,CIMCOR) - REAL CPIMCOR(0:1,0:3,0:STHIFR-1,0:1) !(G/P,POL,IFR,APPLY/DE-APPLY) - COMPLEX CPCIMCOR(0:3,0:STHIFR-1,0:1) !(DE-)APPLY MIFR CORR - EQUIVALENCE (CPIMCOR,CPCIMCOR) - REAL FACOR(2,2) !FARADAY ROTATION - COMPLEX PLCOR(0:STHTEL-1,0:1) !POL. CORRECTION - REAL CMU(0:1,0:3,0:STHIFR-1,0:1) !M.E. PER WEIGHT - REAL CMUD(0:1,0:3,0:STHIFR-1,0:1) !M.E. - INTEGER IFRARR(0:STHIFR-1) !GIVE EVERY INTF ITS OWN PLACE - INTEGER STHP !POINTER TO SET HEADER - BYTE STH(0:STHHDL-1) !SET HEADER - INTEGER*2 STHI(0:STHHDL/2-1) - INTEGER STHJ(0:STHHDL/4-1) - REAL STHE(0:STHHDL/4-1) - DOUBLE PRECISION STHD(0:STHHDL/8-1) - EQUIVALENCE(STH,STHI,STHJ,STHE,STHD) - BYTE SCH(0:SCHHDL-1) !SCAN HEADER - INTEGER*2 SCHI(0:SCHHDL/2-1) - INTEGER SCHJ(0:SCHHDL/4-1) - REAL SCHE(0:SCHHDL/4-1) - DOUBLE PRECISION SCHD(0:SCHHDL/8-1) - EQUIVALENCE(SCH,SCHI,SCHJ,SCHE,SCHD) -C- -C -C NCACIC -C - DOCL1=.FALSE. - GOTO 40 -C -C NCACI1 -C - ENTRY NCACI1(CSOL,CME,NSTHPI,STHPI) -C - DOCL1=.TRUE. - GOTO 40 -C -C INIT -C - 40 CONTINUE - GUESS=.FALSE. !GUESS LOOP - CORDAP=0 !NOTHING DE-APPLIED - CORAP=-1 !ALL CORRECTIONS - CORZE=0 !NO ZEROING - MINSCN=-1 !NO LIMIT ON SCANS - CALL WNGMVZ(2*4*STHIFR*2*LB_X,CSOL) !ZERO BUFFER - I=-1 - DO I1=0,STHTEL-1 - DO I2=I1,STHTEL-1 - I=I+1 - IFRARR(I)=I2*256+I1 !GIVE EVERY INTF ITS OWN PLACE - END DO - END DO -C -C GUESS LOOP. Entry is with .NOT.GUESS, so the first time the loop at label -C 20 is executed with GUESS true. When all sectors are done, control returns -C through label 50 to label 10. The loop at label 20 is then re-executed with -C GUESS false and finally exits through label 50. -C - 10 CONTINUE - GUESS=.NOT.GUESS !SWAP GUESSING - CSTHI=0 !STH COUNT - IF (.NOT.WNMLGA(MAR,LSQ_T_REAL+LSQ_T_MULTIPLE,1,2*4*STHIFR*2)) THEN - !GET LSQ AREA - CALL WNCTXT(F_TP,'Cannot obtain LSQ area') - CALL WNGEX !STOP - END IF -C -C DO SETS. This section contains two modes of loop control: Standard sector -C search through NSCSTL for NCACIC; and direct reading of sector header -C specified by file address for NCACI1. The same variables are set in both -C modes, but in the latter the set name is necessarily an absolute number -C rather than an index. -C - 20 CONTINUE - IF (.NOT.DOCL1) THEN !LOOP THROUGH SETS - IF (.NOT.NSCSTL(FCAINP,SETINP,STH(0),STHP,SETNAM,LPOFF)) - 1 GOTO 50 !NO MORE SETS - ELSE - STHP=STHPI(CSTHI) !STH - CSTHI=CSTHI+1 !COUNT SETS - IF (CSTHI.GT.NSTHPI) GOTO 50 !NO MORE SETS GIVEN - IF (STHP.EQ.0) GOTO 20 !SKIP THIS ONE - IF (.NOT.WNFRD(FCAINP,STHHDL,STH(0),STHP)) THEN !READ SET HEADER - CALL WNCTXT(F_TP,'Error reading sector header') - GOTO 20 !NEXT SET - END IF - SETNAM(0)=STHJ(STH_SETN_J) !PREPARE SET NAME - SETNAM(1)=-2 !INDICATE # - END IF -C -C GET IFR TABLES -C - IF (.NOT.NSCSIF(FCAINP,STH,IFRT,IFRA,ANG)) THEN - CALL WNDSTI(FCAINP,SETNAM) !MAKE PROPER SET NAME - CALL WNCTXT(F_TP,'Error reading interferometer tables '// - 1 'sector(s) !AS',WNTTSG(SETNAM,0)) - GOTO 20 !NEXT SET - END IF -C -C DO SCANS -C - CNTSCN=0 !NO SCANS YET - DO J=0,STHJ(STH_SCN_J)-1 !ALL SCANS -C -C MAKE SETS OF EQUAL LENGTH -C - IF (.NOT.GUESS.AND.CEQUAL.GT.0.AND. - 1 CNTSCN.GE.MINSCN) GOTO 31 !DONE FOR THIS SECTOR -C -C GET SCAN ERRORS -C - IF (.NOT.NSCSCX(FCAINP,STH,IFRT,J,CORAP,CORDAP, - 1 SCH,CCOR,CPCIMCOR,FACOR,PLCOR)) THEN - HA=STHE(STH_HAB_E)+J*STHE(STH_HAI_E) - CALL WNCTXT(F_TP,'!7$EAF7.2 Error reading scan data',HA) - GOTO 31 !TRY NEXT SET - END IF -CC HjV 950627: No test on deleted scans - CNTSCN=CNTSCN+1 !COUNT SCAN -C First put interf. in correct place. -C During testing I combined 40 interf. with 87 interf. -C which gave very strange results. -C So first put every interf. on its own place. - CALL WNGMVZ(4*STHIFR*2*LB_X,CIMCOR) !ZERO BUFFER - I=-1 - DO I1=0,STHTEL-1 - DO I2=I1,STHTEL-1 - I=I+1 !NEXT ENTRY - I4=0 !INDEX INPUT - DO WHILE (I4.LT.(STHJ(STH_NIFR_J))) !FIND IFR INDEX - IF (IFRT(I4).EQ.IFRARR(I)) THEN !FOUND - DO I3=0,3 !POL - DO I5=0,1 !APPLY/DE-APPLY - CIMCOR(I3,I,I5)=CPCIMCOR(I3,I4,I5) - END DO - END DO - GOTO 55 - END IF - I4=I4+1 - END DO - 55 CONTINUE - END DO - END DO -C -C - I=-1 - DO I1=0,STHTEL-1 - DO I2=I1,STHTEL-1 - I=I+1 !NEXT ENTRY - IF (SIFRS(I1,I2)) THEN !SELECTED - DO I3=0,3 !POL - DO I5=0,1 !APPLY/DE-APPLY - IF (GUESS) THEN !MAKE COS/SIN GAINS - CIMCOR(I3,I,I5)=EXP(CIMCOR(I3,I,I5)) - ELSE !+- 180 DEG FROM GUESS - IMCOR(1,I3,I,I5)=WNGENR(IMCOR(1,I3,I,I5)- - 1 CSOL(1,I3,I,I5))+CSOL(1,I3,I,I5) - ENDIF - END DO - END DO - END IF - END DO - END DO - CALL WNMLMN(MAR,LSQ_C_REAL,1.,1.,IMCOR) !MAKE SUMS -C -C NEXT SCAN -C - 30 CONTINUE - END DO !END SCANS -C -C NEXT SEctor -C - 31 CONTINUE - IF (GUESS) THEN - IF (MINSCN.LT.0.OR. - 1 (CNTSCN.GT.0.AND.CNTSCN.LT.MINSCN)) THEN !FIRST OR SMALLER - MINSCN=CNTSCN !NEW MINIMUM - END IF - ELSE - CALL WNDSTI(FCAINP,SETNAM) !MAKE PROPER SET NAME - CALL WNCTXT(F_TP,'Input sector !AS\:!40C!UJ scans used', - 1 WNTTSG(SETNAM,0),CNTSCN) !SHOW NUMBER USED - END IF - GOTO 20 -C -C CALCULATE RESULT -C Note: The weird way of calculating an ATAN2 must be for portability reasons -C - 50 CONTINUE - CALL WNMLTN(MAR) !DE-COMPOSE - CALL WNMLSN(MAR,CSOL,CMU,CMUD) !GET SOLUTION - CALL WNMLME(MAR,CME) !VARIANCES - CALL WNMLFA(MAR) !CLEAR LSQ AREA - IF (GUESS) THEN !STILL GUESSING - I=-1 - DO I1=0,STHTEL-1 - DO I2=I1,STHTEL-1 - I=I+1 !NEXT ENTRY - IF (SIFRS(I1,I2)) THEN !SELECTED - DO I3=0,3 !POL - DO I5=0,1 !APPLY/DE-APPLY - IF (CSOL(0,I3,I,I5).NE.0 .AND. - 1 CSOL(1,I3,I,I5).NE.0) - 1 CSOL(1,I3,I,I5)=AIMAG(LOG(CMPLX( - 1 CSOL(0,I3,I,I5),CSOL(1,I3,I,I5)))) !GET GUESSED ANGLE - END DO - END DO - END IF - END DO - END DO - GOTO 10 ! end of main loop - END IF -C - RETURN !READY -C -C - END diff --git a/src/nscan/ncaclc.for b/src/nscan/ncaclc.for deleted file mode 100644 index 33adffcc1d531cc47e163ec1ab51c7e70e6d2e0c..0000000000000000000000000000000000000000 --- a/src/nscan/ncaclc.for +++ /dev/null @@ -1,246 +0,0 @@ -C+ NCACLC.FOR -C WNB 910814 -C -C Revisions: -C WNB 921104 Full HA range -C WNB 921217 Add CL1 -C HjV 930311 Change some text -C WNB 930825 Add dipole positions -C WNB 931213 Add code for possible phase ambiguities -C CMV 940513 Option to give all sets equal weight -C JPH 940913 Preempt singularity in logarithmic conversion -C Comments -C WNB 950611 Change least squares calls -C -C - SUBROUTINE NCACLC(CSOL,CME) -C -C Calculate average corrections in scan file. -C - -C -C Result: -C -C CALL NCACLC( CSOL_X(0:*,0:1):O, CME_X(0:*,0:1):O) -C will calculate average log. corrections in scans -C CALL NCACL1( CSOL_X(0:*,0:1):O, CME_X(0:*,0:1):O, -C NSTHPI_J:I, STHPI_J(0:*):I) -C will calculate average corrections for NSTHPI scans -C whose file addresses are in STHPI -C -C The method is to first average sine and cosine values to get an initial -C guess for the phase. Then, using this guess. the gains and phases are -C averaged. -C This guarantees phase continuity except in pathological cases where the -C averages would be meaningless anyway. -C -C -C Include files: -C - INCLUDE 'WNG_DEF' - INCLUDE 'NCA_DEF' - INCLUDE 'LSQ_O_DEF' - INCLUDE 'STH_O_DEF' !SET HEADER - INCLUDE 'SCH_O_DEF' !SCAN HEADER -C -C Parameters: -C -C -C Arguments: -C - REAL CSOL(0:1,0:STHTEL-1,0:1) !AVERAGE ERRORS G,P TEL X,Y - REAL CME(0:1,0:STHTEL-1,0:1) !AND M.E. (VARIANCES) - INTEGER NSTHPI !# OF INPUT SETS - INTEGER STHPI(0:*) !INPUT SETS -C -C Function references: -C - CHARACTER*32 WNTTSG !SET NAME - LOGICAL WNMLGA !INIT. LSQ - LOGICAL WNFRD !READ DATA - REAL WNGENR !NORM. ANGLE - LOGICAL NSCSTL !GET A SET - LOGICAL NSCSCT !GET SCAN ERRORS - LOGICAL NSCSIF !GET INTERFEROMETER TABLE -C -C Data declarations: -C - LOGICAL DOCL1 !CL1/CLC SWITCH - LOGICAL GUESS !GUESS LOOP - INTEGER CSTHI !STH COUNT - INTEGER MINSCN !MINIMUM NUMBER OF SCANS - INTEGER CNTSCN !COUNT NUMBER OF SCANS - INTEGER MAR !LSQ AREA - INTEGER SETNAM(0:7) !FULL SET NAME - REAL HA !HA OF SCAN - INTEGER*2 IFRT(0:STHIFR-1) !IFR TABLES - INTEGER IFRA(0:1,0:STHIFR-1) - REAL ANG(0:2,0:STHIFR-1) - REAL TCOR(0:1,0:STHTEL-1,0:1) !ERRORS READ G,P TEL X,Y - COMPLEX CCOR(0:STHTEL-1,0:1) - EQUIVALENCE (TCOR,CCOR) - REAL TMU !M.E. READ DATA - REAL CMU(0:1,0:STHTEL-1,0:1) !M.E. PER WEIGHT - REAL CMUD(0:1,0:STHTEL-1,0:1) !M.E. - INTEGER STHP !POINTER TO SET HEADER - BYTE STH(0:STHHDL-1) !SET HEADER - INTEGER*2 STHI(0:STHHDL/2-1) - INTEGER STHJ(0:STHHDL/4-1) - REAL STHE(0:STHHDL/4-1) - DOUBLE PRECISION STHD(0:STHHDL/8-1) - EQUIVALENCE(STH,STHI,STHJ,STHE,STHD) - BYTE SCH(0:SCHHDL-1) !SCAN HEADER - INTEGER*2 SCHI(0:SCHHDL/2-1) - INTEGER SCHJ(0:SCHHDL/4-1) - REAL SCHE(0:SCHHDL/4-1) - DOUBLE PRECISION SCHD(0:SCHHDL/8-1) - EQUIVALENCE(SCH,SCHI,SCHJ,SCHE,SCHD) -C- -C -C NCACLC -C - DOCL1=.FALSE. - GOTO 40 -C -C NCACL1 -C - ENTRY NCACL1(CSOL,CME,NSTHPI,STHPI) -C - DOCL1=.TRUE. - GOTO 40 -C -C INIT -C - 40 CONTINUE - GUESS=.FALSE. !GUESS LOOP - CORDAP=0 !NOTHING DE-APPLIED - CORAP=-1 !ALL CORRECTIONS - CORZE=0 !NO ZEROING - MINSCN=-1 !NO LIMIT ON SCANS -C -C GUESS LOOP. Entry is with .NOT.GUESS, so the first time the loop at label -C 20 is executed with GUESS true. When all sectors are done, control returns -C through label 50 to label 10. The loop at label 20 is then re-executed with -C GUESS false and finally exits through label 50. -C - 10 CONTINUE - GUESS=.NOT.GUESS !SWAP GUESSING - CSTHI=0 !STH COUNT - IF (.NOT.WNMLGA(MAR,LSQ_T_REAL+LSQ_T_MULTIPLE,1,2*2*STHTEL)) THEN - !GET LSQ AREA - CALL WNCTXT(F_TP,'Cannot obtain LSQ area') - CALL WNGEX !STOP - END IF -C -C DO SETS. This section contains two modes of loop control: Standard sector -C search through NSCSTL for NCACLC; and direct reading of sector header -C specified by file address for NCACL1. The same variables are set in both -C modes, but in the latter the set name is necessarily an absolute number -C rather than an index. -C - 20 CONTINUE - IF (.NOT.DOCL1) THEN !LOOP THROUGH SETS - IF (.NOT.NSCSTL(FCAINP,SETINP,STH(0),STHP,SETNAM,LPOFF)) - 1 GOTO 50 !NO MORE SETS - ELSE - STHP=STHPI(CSTHI) !STH - CSTHI=CSTHI+1 !COUNT SETS - IF (CSTHI.GT.NSTHPI) GOTO 50 !NO MORE SETS GIVEN - IF (STHP.EQ.0) GOTO 20 !SKIP THIS ONE - IF (.NOT.WNFRD(FCAINP,STHHDL,STH(0),STHP)) THEN !READ SET HEADER - CALL WNCTXT(F_TP,'Error reading sector header') - GOTO 20 !NEXT SET - END IF - SETNAM(0)=STHJ(STH_SETN_J) !PREPARE SET NAME - SETNAM(1)=-2 !INDICATE # - END IF -C -C GET IFR TABLES -C - IF (.NOT.NSCSIF(FCAINP,STH,IFRT,IFRA,ANG)) THEN - CALL WNDSTI(FCAINP,SETNAM) !MAKE PROPER SET NAME - CALL WNCTXT(F_TP,'Error reading interferometer tables '// - 1 'sector(s) !AS',WNTTSG(SETNAM,0)) - GOTO 20 !NEXT SET - END IF -C -C DO SCANS -C - CNTSCN=0 !NO SCANS YET - DO I=0,STHJ(STH_SCN_J)-1 !ALL SCANS -C -C MAKE SETS OF EQUAL LENGTH -C - IF (.NOT.GUESS.AND.CEQUAL.GT.0.AND. - 1 CNTSCN.GE.MINSCN) GOTO 31 !DONE FOR THIS SECTOR -C -C GET SCAN ERRORS -C - IF (.NOT.NSCSCT(FCAINP,STH,IFRT,I,CORAP,CORDAP, - 1 SCH,CCOR,TMU)) THEN - HA=STHE(STH_HAB_E)+I*STHE(STH_HAI_E) - CALL WNCTXT(F_TP,'!7$EAF7.2 Error reading scan data',HA) - GOTO 31 !TRY NEXT SET - END IF - IF (TMU.GE.0) THEN !NOT DELETED - CNTSCN=CNTSCN+1 !COUNT SCAN - IF (GUESS) THEN !GUESS - DO I1=0,1 !X,Y - DO I2=0,STHTEL-1 !TELESCOPES - CCOR(I2,I1)=EXP(CCOR(I2,I1)) !MAKE COS/SIN GAINS - END DO - END DO - ELSE !NOT GUESS - DO I1=0,1 !X,Y - DO I2=0,STHTEL-1 !TEL - TCOR(1,I2,I1)=WNGENR(TCOR(1,I2,I1)-CSOL(1,I2,I1))+ - 1 CSOL(1,I2,I1) !+- 180 DEG FROM GUESS - END DO - END DO - END IF - CALL WNMLMN(MAR,0,1.,1.,TCOR) !MAKE SUMS - END IF -C -C NEXT SCAN -C - 30 CONTINUE - END DO !END SCANS -C -C NEXT SEctor -C - 31 CONTINUE - IF (GUESS) THEN - IF (MINSCN.LT.0.OR. - 1 (CNTSCN.GT.0.AND.CNTSCN.LT.MINSCN)) THEN !FIRST OR SMALLER - MINSCN=CNTSCN !NEW MINIMUM - END IF - ELSE - CALL WNDSTI(FCAINP,SETNAM) !MAKE PROPER SET NAME - CALL WNCTXT(F_TP,'Input sector !AS\:!40C!UJ scans used', - 1 WNTTSG(SETNAM,0),CNTSCN) !SHOW NUMBER USED - END IF - GOTO 20 -C -C CALCULATE RESULT -C Note: The weird way of calculating an ATAN2 must be for portability reasons -C - 50 CONTINUE - CALL WNMLTN(MAR) !DE-COMPOSE - CALL WNMLSN(MAR,CSOL,CMU,CMUD) !GET SOLUTION - CALL WNMLME(MAR,CME) !VARIANCES - CALL WNMLFA(MAR) !CLEAR LSQ AREA - IF (GUESS) THEN !STILL GUESSING - DO I1=0,1 !X,Y - DO I2=0,STHTEL-1 !TEL. - IF (CSOL(0,I2,I1).NE.0 .AND. CSOL(1,I2,I1).NE.0) - 1 CSOL(1,I2,I1)=AIMAG(LOG(CMPLX( - 1 CSOL(0,I2,I1),CSOL(1,I2,I1)))) !GET GUESSED ANGLE - END DO - END DO - GOTO 10 ! end of main loop - END IF -C - RETURN !READY -C -C - END diff --git a/src/nscan/ncadat.for b/src/nscan/ncadat.for deleted file mode 100644 index 4dd32c64559e29fb3a7f06256cbf88612dfab2c8..0000000000000000000000000000000000000000 --- a/src/nscan/ncadat.for +++ /dev/null @@ -1,1425 +0,0 @@ -C+ NCADAT.FOR -C WNB 900306 -C -C Revisions: -C WNB 910621 Add loops -C WNB 910812 Add ALIGN -C WNB 910813 Add copy -C WNB 910820 Add refraction, extinction, Faraday rotation -C WNB 910826 Add retainment of parameters typed -C WNB 910827 Add QDETAILS -C WNB 910913 Change loops -C WNB 910923 Add POLAR SET,EDIT,COPY -C WNB 910930 Loops in POLAR COPY -C WNB 910930 Add VZERO -C WNB 911007 Default no complex for redundancy -C WNB 911009 Add SET RENORM option -C HjV 920520 HP does not allow extended source lines -C WNB 921104 Full HA range -C WNB 921120 Add HA_INTEGRATION -C WNB 921217 Add CCOPY -C HjV 930423 Change name of some keywords -C WNB 930602 Add IREF, CLK -C WNB 930603 Add POLE, DX, DY, DZ, FREQ setting -C WNB 930614 Set polarisation to do for POLE, ... -C WNB 930617 Add SET SHIFT -C WNB 930619 Typo -C WNB 930825 New polarisation selection -C WNB 930826 New HA range -C CMV 930830 Change decalration NSCPLS (LOGICAL iso. INTEGER) -C HjV 930914 NSCIFS is now a function iso. a subroutine -C CMV 931027 Some extra output -C WNB 931123 Use RIN(1), (2) for complex loops -C WNB 931126 Add COMPLEX_ONLY -C CMV 931210 Add 'SCN_LOOPS' argument to WNDXLP -C CMV 931220 Pass FCA of input file to WNDXLP and WNDSTA/Q -C CMV 940214 SOLVE and COMPLEX before QDETAILS -C CMV 940223 Add DSHIFT for differential shifts -C CMV 940225 Enable default model file (use NMODAW) -C CMV 940228 Default no Amp solution if 'Unknown flux' set in MDL -C CMV 940331 Select telescopes to copy corrections for -C CMV 940428 Option INIT added for SET -C CMV 940429 Option IFR en MIFR added to SET, some added to ZERO -C CMV 940503 Keyword CAL_EQUAL added (not yet used) -C CMV 940513 Add some keywords to list of PIN references -C CMV 940518 Add selection of IFRs to SET INIT -C CMV 940711 Initialise TELS array always -C JPH 940909 WNDPOH calls -C For telescope polarisation, set XY as default, call -C NSCPLS with XY_P default -C Remove defaults for SHOW_LEVEL (are defined in .psc) -C CMV 940927 Reorganised SET options, add SET OTHER MULTIPLY -C JPH 940928 Help for NSCPLS overrides .ppd help -C JPH 941214 WNFCL before all WNDNOD. -C Straighten GOTO's on # parameter input -C JPH 950124 WNDPOH texts. Merge with CMV940927 -C CMV 950131 Uncomment lines in which STH was read (used to -C construct default model name later) -C CMV 950202 Limits for gains parametrised and changed -C CMV 941214 Do not create non-existing SCN files -C CMV 940220 Lower lower-limit for gains -C HjV 950609 For REDUN: ask CIFRS (interf. which should get MIFR -C correction) -C WNB 950614 Ask if MIFR wanted; more complex loops default -C HjV 950623 Add option ICOPY for SET_OPTION (Copy MIFR-corrections) -C CMV 960123 Add message before NMODAV call -C JPH 960801 Replace function codes with legible ones -C JPH 960802 Restore CCOPY function (at some time accidentally -C replaced by COPY) -C WNB 981022 Added loops for SET--INIT -C CMV 030101 Add CALCHAN for linear combination in fiddle -C WNB 080711 Add SETINVERT option -C WNB 081226 Add INVERT polarisation corrections -C -C - SUBROUTINE NCADAT -C -C Get NCALIB program parameters -C -C Result: -C -C CALL NCADAT will ask and set all program parameters -C -C PIN references: -C -C OPTION -C POLAR_OPTION -C SET_OPTION -C SCN_SETS -C USE_SCN_SETS -C POLARISATION -C SCN_NODE -C USE_SCN_NODE -C MWEIGHT_TYPE -C MWEIGHT_DATA -C ALIGN_OPTION -C FORCE_FREEDOM -C GAIN_FREEDOM -C PHASE_FREEDOM -C GAIN_NORM -C PHASE_NORM -C HA_INTEGRATION -C SELECT_IFRS -C SHOW_LEVEL -C ZERO -C INVERT -C GAIN_X -C PHASE_X -C GAIN_Y -C PHASE_Y -C GAIN_NORM -C PHASE_NORM -C IFR_XX/XY/YX/YY -C GAIN_XX/XY/YX/YY -C PHASE_XX/XY/YX/YY -C EXTINCTION -C REFRACTION -C CLOCK_CORR -C SHIFT -C DSHIFT -C FARADAY_FILE -C IREFRACT_FILE -C BASEL_POLE -C BASEL_DX -C BASEL_DY -C BASEL_DZ -C FREQ_CORR -C QDETAILS -C BASEL_CHECK -C WEIGHT_MIN -C SOLVE -C COMPLEX -C COMPLEX_ONLY -C FORCE_PHASE -C CONTINUITY -C CHECKS -C CAL_EQUAL -C -C Include files: -C - INCLUDE 'WNG_DEF' - INCLUDE 'CBITS_DEF' - INCLUDE 'STH_O_DEF' !SET HEADER - INCLUDE 'NCA_DEF' -C -C Parameters: -C - REAL*4 GANMIN,GANMAX !RANGE FOR MANUAL GAINS - PARAMETER(GANMIN=0.0001) - PARAMETER(GANMAX=5000.) -C -C Arguments: -C -C -C Function references: -C - INTEGER WNCALN !LENGTH STRING - LOGICAL WNDPAR !GET DWARF PARAMETER - LOGICAL WNDNOD !GET NODE NAME - LOGICAL WNDNOC !CHANGE MODE TO UPDATE - LOGICAL WNDXLP !GET LOOP PARAMETERS - LOGICAL WNFOP !OPEN FILE - LOGICAL WNDSTQ !ASK SETS - LOGICAL NSCPLS !ASK POLARISATIONS - LOGICAL NSCHAS !SELECT HA - LOGICAL NSCIFS !Select/deselect interferometers - LOGICAL NSCTL1 !Select/deselect telescopes - LOGICAL NSCSTG !Read sector header -C -C Data declarations: -C - INTEGER ARJ(0:1) !TEST DATA - CHARACTER*24 MWTP,CMWTP !WEIGHT TYPE - INTEGER CIFR !CHECK TYPE IFRS - CHARACTER*24 SUBOPT !SUB OPTION - CHARACTER*3 SUBOP3 - EQUIVALENCE (SUBOPT,SUBOP3) - CHARACTER*24 SELOPT !ALIGN OPTION - CHARACTER*1 PCTP(0:1) !PCORR TYPE - DATA PCTP/'X','Y'/ - CHARACTER*2 PLTP(0:3) !IFR COR. POLARISATIONS - DATA PLTP/'XX','XY','YX','YY'/ - INTEGER PLFL(0:3) - DATA PLFL/XX_P,XY_P,YX_P,YY_P/ -C - BYTE BB1 - BYTE BB2(0:1) - REAL RBUF(2) !BUFFER FOR IFR CORRECTIONS - INTEGER STHP !SET POINTER - INTEGER SETNAM(0:7) !SET NAME - BYTE STH(0:STH__L-1) !SET HEADER -C- -C -C SET DEFAULTS -C - IF (OPT(1:2).EQ.'PD') GOTO 50 !ASSUME MORE POLAR. - IF (OPT(1:2).EQ.'PV') GOTO 110 !ASSUME MORE VZERO - NODOUT=' ' !ASSUME NO NODE GIVEN - NODINP='*' - SETS(0,0)=0 !NO SETS - SETINP(0,0)=0 - SPOL=XYX_M !POL. - CMWTP='STEP' !WEIGHT TYPE - MWGTD(0)=0 !WEIGTHING DATA - MWGTD(1)=100000 - MWGTD(2)=1 - SELOPT='SELFCAL' !SUB-OPTION - FORFRE(0)=.FALSE. !FORCE FREEDOM - FORFRE(1)=.FALSE. - DO I=0,STHTEL-1 !FREEDOMS - FREGPH(I,0)=1 - FREGPH(I,1)=1 - END DO - HARAN(1)=-179.99/360. !HA RANGE - HARAN(2)=+179.99/360. - HAINT=0 !HA INTEGRATION - DO I=0,STHTEL-1 !SELECT ALL TELS - TELS(I)=.TRUE. - END DO - CIFR=2 !START IFRS - ARJ(0)=1 !TYPE/PRINT DEFAULTS - ARJ(1)=2 - CFEXT(0)=+0.00557 !SET DEFAULTS EXTINCTION - CFEXT(1)=+0.00461 - CFEXT(2)=-0.000544 - CFREF(0)=+0.00031 !SET DEFAULTS REFRACTION - CFREF(1)=+0 - CFREF(2)=+0 - DO I=0,1 !EMPTY CORRECTIONS - DO I1=0,STHTEL-1 - PCGAN(I1,I)=1 - PCPHS(I1,I)=0 - END DO - END DO - BASDEV=0.5 !DETAILS - WGTMIN=.01 - APSOL(0)=.TRUE. - APSOL(1)=.TRUE. - XSOLVE=.TRUE. - XOSOL=.FALSE. - DO I=0,STHTEL-1 - FORPER(I)=0 - END DO - CSOLVE=.TRUE. - RIN(1)=20 !COMPLEX ITERATION COUNT - RIN(2)=1E-3 !COMPLEX CHECK LEVEL - RIN(3)=3 !M.E. TEST -C -C GET OPTION -C - CALL WNCTXT(F_T,' ') - 100 CONTINUE - IF (.NOT.WNDPAR('OPTION',OPTION,LEN(OPTION),J0,'QUIT')) THEN - OPTION='QUIT' !ASSUME END - ELSE IF (J0.LE.0) THEN - OPTION='QUIT' !ASSUME END - END IF - IF (OPT.EQ.'QUI') RETURN !READY - IF (OPT.EQ.'RED') THEN !REDUNDANCY - GOTO 10 - ELSE IF (OPT.EQ.'POL') THEN !POLAR. CORRECTIONS - GOTO 50 - ELSE IF (OPT.EQ.'SET') THEN !SET CORRECTIONS - GOTO 20 - ELSE IF (OPT.EQ.'SHO') THEN !LIST CORRECTIONS - GOTO 70 - END IF - OPTION='QUIT' !UNKNOWN -C - RETURN -C -C REDUNDANCY ******************************************************************* -C - 10 CONTINUE - 11 CONTINUE - CALL WNDPOH('SCN file to be processed', ' ', - 1'The SCN file from which your input data will be read and the derived - 1 |corrections written') - CALL WNFCL(FCAOUT) - IF (.NOT.WNDNOD('SCN_NODE',NODOUT,'SCN','R',NODOUT,FILOUT)) THEN - IF (E_C.EQ.DWC_ENDOFLOOP) GOTO 100 !RETRY option - GOTO 11 !REPEAT - ELSE IF (E_C.EQ.DWC_NULLVALUE) THEN - GOTO 100 !RETRY OPTION - ELSE IF (E_C.EQ.DWC_WILDCARD) THEN - GOTO 11 !MUST SPECIFY - END IF - IF (.NOT.WNDNOC('SCN_NODE',NODOUT,'SCN', - 1 'U',NODOUT,FILOUT)) GOTO 11 - IF (.NOT.WNFOP(FCAOUT,FILOUT,'U')) THEN !OPEN OUTPUT SCAN FILE - GOTO 11 !RETRY - END IF -C - 16 CONTINUE - IF (.NOT.WNDXLP('SCN_LOOPS',FCAOUT)) THEN - IF (E_C.EQ.DWC_ENDOFLOOP) GOTO 11 !RETRY NODE - GOTO 16 !REPEAT - END IF -C - IF (.NOT.WNDSTQ('SCN_SETS',MXNSET,SETS,FCAOUT)) THEN !NO SETS -CC 12 CONTINUE -CC CALL WNFCL(FCAOUT) - GOTO 11 - END IF - IF (SETS(0,0).EQ.0) GOTO 11 !NONE SPECIFIED - IF (.NOT.NSCSTG(FCAOUT,SETS,STH,STHP,SETNAM)) GOTO 11 !FIND A SET - CALL WNDSTR(FCAOUT,SETS) !RESET SET SEARCH -C - 14 CONTINUE - CALL WNDPOH('Telescope polarisation', 'X,Y,XY', - 1'The telescope dipoles for which solutions will be made - 1 |The valid options are X only, Y only or both |#-') - IF (.NOT.NSCPLS(XY_P,SPOL)) GOTO 16 !GET POLARISATION SELECTION - IF (IAND(SPOL,XY_M).EQ.0) GOTO 14 !NO XX OR YY SPECIFIED - XYSOL(0)=IAND(SPOL,XX_P).NE.0 !SET X,Y TYPE - XYSOL(1)=IAND(SPOL,YY_P).NE.0 -C - CALL WNCTXT(F_T,'Give the selfcal-model, '// - 1 'or QUIT for pure redundancy.') - CALL WNCTXT(F_T,'Note: using the INTERNAL model '// - 1 'here is inherently confusing.') - CALL NMODAV(NSRC(0),STH,APSOL(0)) !GET MODEL, TEST IF FLUXES KNOWN - IF (NSRC(0).GT.0) THEN !SOURCES PRESENT - CALL NMOMUI !MODEL USAGE - 15 CONTINUE - IF (.NOT.WNDPAR('MWEIGHT_TYPE',MWTP,LEN(MWTP),J0,CMWTP)) THEN - IF (E_C.EQ.DWC_ENDOFLOOP) GOTO 14 !RETRY pol - GOTO 15 - END IF - CMWTP=MWTP !SAVE FOR REPEAT - MWGT=1 !STEP TYPE - IF (MWTP(1:1).EQ.'I') THEN !INVERT TYPE - MWGT=-MWGT - DO I=2,LEN(MWTP) - MWTP(I-1:I-1)=MWTP(I:I) - END DO - END IF - IF (MWTP.EQ.'GAUSSIAN') THEN - MWGT=MWGT*2 - ELSE IF (MWTP.EQ.'TRIANGLE') THEN - MWGT=MWGT*3 - END IF - IF (.NOT.WNDPAR('MWEIGHT_DATA',MWGTD(0),2*LB_E,J0,A_B(-A_OB), - 1 MWGTD,2)) THEN - IF (E_C.EQ.DWC_ENDOFLOOP) GOTO 15 !RETRY weight-type - GOTO 15 - END IF - IF (J0.EQ.0) GOTO 15 - IF (J0.EQ.-1) THEN !DEFAULT - MWGTD(0)=0 - MWGTD(1)=100000 - END IF - DOALG=.TRUE. !SELFCAL/ALIGN - IF (SELOPT.NE.'SELFCAL' .AND. - 1 SELOPT.NE.'ALIGN') SELOPT='SELFCAL' - IF (.NOT.WNDPAR('ALIGN_OPTION',SUBOPT,LEN(SUBOPT), - 1 J0,SELOPT(1:WNCALN(SELOPT)))) THEN - GOTO 15 !ASSUME END - ELSE IF (J0.LE.0) THEN - GOTO 15 !ASSUME END - END IF - IF (SUBOP3.EQ.'SEL') THEN !SELFCAL - DOSCAL=.TRUE. - CALL WNCTXT(F_TP,'!/\Selfcalibration selected!/') - SELOPT='SELFCAL' - ELSE !ALIGN - SELOPT='ALIGN' - BB2(0)=FORFRE(0) - BB2(1)=FORFRE(1) - IF (.NOT.WNDPAR('FORCE_FREEDOM',BB2,2*LB_B, - 1 J0,A_B(-A_OB), - 1 BB2,2)) GOTO 15 !ERROR FREEDOMS - FORFRE(0)=BB2(0) - FORFRE(1)=BB2(1) - IF (J0.LE.0) GOTO 15 - IF (FORFRE(0)) THEN !GAIN FREEDOM - IF (.NOT.WNDPAR('GAIN_FREEDOM',FREGPH(0,0),STHTEL*LB_J, - 1 J0,A_B(-A_OB),FREGPH(0,0),STHTEL)) GOTO 15 - IF (J0.EQ.0) GOTO 15 - IF (J0.LT.0) THEN - DO I=0,STHTEL-1 !SET FREEDOM - FREGPH(I,0)=1 - END DO - END IF - END IF - IF (FORFRE(1)) THEN !PHASE FREEDOM - IF (.NOT.WNDPAR('PHASE_FREEDOM',FREGPH(0,1),STHTEL*LB_J, - 1 J0,A_B(-A_OB),FREGPH(0,1),STHTEL)) GOTO 15 - IF (J0.EQ.0) GOTO 15 - IF (J0.LT.0) THEN - DO I=0,STHTEL-1 !SET FREEDOM - FREGPH(I,1)=1 - END DO - END IF - END IF - DOSCAL=.FALSE. !SET ALIGN - CALL WNCTXT(F_TP,'!/\Align selected!/') - END IF - ELSE - CALL WNCTXT(F_TP,'Pure redundancy selected!/') - DOALG=.FALSE. - XSOLVE=.FALSE. !ASSUME NO COMPLEX - XOSOL=.FALSE. - END IF -C - 18 CONTINUE - IF (.NOT.NSCHAS(0,HARAN)) GOTO 14 -C - IF (HAINT.LE.0) THEN - JS=WNDPAR('HA_INTEGRATION',HAINT,LB_E,J0,'*') - ELSE - JS=WNDPAR('HA_INTEGRATION',HAINT,LB_E,J0,A_B(-A_OB),HAINT,1) - END IF - IF (.NOT.JS) GOTO 18 -C - IF (.NOT.NSCIFS(CIFR,SIFRS)) GOTO 18 !SELECT INTERFEROMETERS - CIFR=0 !SET SEEN -C - IF (.NOT.WNDPAR('SAVE_RESIDUALS',BB1,LB_B,J0,'NO')) THEN - GOTO 18 !RETRY - END IF - DOMIFR=.FALSE. - IF (BB1) THEN - DOMIFR=.TRUE. - CALL WNDPOH('Interferometers to get MIFR corrections',' ', - 1 'Specify which interferometers must get the MIFR corrections - 1 |Default is NONE |#-') - IF (.NOT.NSCIFS(4,CIFRS)) GOTO 18 !SELECT INTERFEROMETERS - END IF -C - IF (.NOT.WNDPAR('SHOW_LEVEL',ARJ(0),2*LB_J,J0, - 1 A_B(-A_OB),ARJ,2)) THEN - IF (E_C.EQ.DWC_ENDOFLOOP) GOTO 18 !RETRY - END IF - DO I=0,4 - SHLV(I)=0 !NO SHOW - IF (ARJ(0).GE.I) SHLV(I)=SHLV(I)+F_T !LIMIT TYPE - IF (ARJ(1).GE.I) SHLV(I)=SHLV(I)+F_P !LIMIT PRINT - END DO -C - CALL NSCSAD(CORAP,CORDAP) !GET CORRECTIONS TO (DE-)APPLY -C - 19 CONTINUE - BB2(0)=APSOL(0) - BB2(1)=APSOL(1) - IF (.NOT.WNDPAR('SOLVE',BB2,2*LB_B,J0, - 1 A_B(-A_OB),BB2,2)) THEN - IF (E_C.EQ.DWC_ENDOFLOOP) GOTO 18 !RETRY - END IF - APSOL(0)=BB2(0) - APSOL(1)=BB2(1) -C - IF (APSOL(0) .AND. APSOL(1)) THEN - BB1=XSOLVE - IF (.NOT.WNDPAR('COMPLEX',BB1,LB_B,J0, - 1 A_B(-A_OB),BB1,1)) THEN - IF (E_C.EQ.DWC_ENDOFLOOP) GOTO 19 !RETRY - END IF - XSOLVE=BB1 - ELSE - XSOLVE=.FALSE. - END IF - IF (XSOLVE) THEN - BB1=XOSOL - IF (.NOT.WNDPAR('COMPLEX_ONLY',BB1,LB_B,J0, - 1 A_B(-A_OB),BB1,1)) THEN - IF (E_C.EQ.DWC_ENDOFLOOP) GOTO 19 !RETRY - END IF - XOSOL=BB1 - ELSE - XOSOL=.FALSE. - END IF -C - 17 CONTINUE - IF (.NOT.WNDPAR('QDETAILS',BB1,LB_B,J0,'NO')) THEN - IF (E_C.EQ.DWC_ENDOFLOOP) GOTO 19 !RETRY - GOTO 80 !LEAVE - END IF - IF (BB1) THEN ! DETAILS - IF (.NOT.WNDPAR('BASEL_CHECK',BASDEV,LB_E,J0, - 1 A_B(-A_OB),BASDEV,1)) THEN - IF (E_C.EQ.DWC_ENDOFLOOP) GOTO 17 !RETRY - END IF -C - IF (.NOT.WNDPAR('WEIGHT_MIN',WGTMIN,LB_E,J0, - 1 A_B(-A_OB),WGTMIN,1)) THEN - IF (E_C.EQ.DWC_ENDOFLOOP) GOTO 17 !RETRY - END IF - WGTMIN=MAX(0.,MIN(0.99,WGTMIN)) -C - DO I=0,STHTEL-1 - FORPER(I)=FORPER(I)*DEG !MAKE DEGREES - END DO - IF (.NOT.WNDPAR('FORCE_PHASE',FORPER(0),STHTEL*LB_E,J0, - 1 A_B(-A_OB),FORPER(0),STHTEL)) THEN - IF (E_C.EQ.DWC_ENDOFLOOP) GOTO 17 !RETRY - END IF - DO I=0,STHTEL-1 - FORPER(I)=FORPER(I)/DEG !MAKE RADIANS - END DO -C - BB1=CSOLVE - IF (.NOT.WNDPAR('CONTINUITY',BB1,LB_B,J0, - 1 A_B(-A_OB),BB1,1)) THEN - IF (E_C.EQ.DWC_ENDOFLOOP) GOTO 17 !RETRY - END IF - CSOLVE=BB1 -C - IF (.NOT.WNDPAR('CHECKS',RIN,3*LB_E,J0, - 1 A_B(-A_OB),RIN,3)) THEN - IF (E_C.EQ.DWC_ENDOFLOOP) GOTO 17 !RETRY - END IF - ENDIF -C - 80 CONTINUE - IF (APSOL(0) .AND. APSOL(1)) THEN !MAKE SURE - ELSE - XSOLVE=.FALSE. - XOSOL=.FALSE. - END IF -C -C READY REDUNDANCY -C - GOTO 900 -C -C POLARISATION -C - 50 CONTINUE - IF (.NOT.WNDPAR('POLAR_OPTION',SUBOPT,LEN(SUBOPT),J0,'QUIT')) THEN - SUBOPT='QUIT' !ASSUME END - ELSE IF (J0.LE.0) THEN - SUBOPT='QUIT' !ASSUME END - END IF - IF (SUBOP3.EQ.'QUI') GOTO 100 !NEXT OPTION - IF (SUBOP3.EQ.'CAL') THEN !CALCULATE - OPTION='PDCALC' !INDICATE CALC - 51 CONTINUE - CALL WNFCL(FCAOUT) - IF (.NOT.WNDNOD('SCN_NODE',NODOUT,'SCN', - 1 'R',NODOUT,FILOUT)) THEN - IF (E_C.EQ.DWC_ENDOFLOOP) GOTO 50 !RETRY OPTION - GOTO 51 !REPEAT - ELSE IF (E_C.EQ.DWC_NULLVALUE) THEN - GOTO 50 !RETRY OPTION - ELSE IF (E_C.EQ.DWC_WILDCARD) THEN - GOTO 51 !MUST SPECIFY - END IF - IF (.NOT.WNDNOC('SCN_NODE',NODOUT,'SCN', - 1 'U',NODOUT,FILOUT)) GOTO 51 - IF (.NOT.WNFOP(FCAOUT,FILOUT,'U')) THEN !OPEN OUTPUT SCAN FILE - GOTO 51 !RETRY - END IF -C - 52 CONTINUE - IF (.NOT.WNDXLP('SCN_LOOPS',FCAOUT)) THEN - IF (E_C.EQ.DWC_ENDOFLOOP) GOTO 51 !RETRY NODE - GOTO 51 !REPEAT - END IF - IF (.NOT.WNDSTQ('SCN_SETS',MXNSET,SETS,FCAOUT)) THEN !NO SETS -CC 52 CONTINUE -CC CALL WNFCL(FCAOUT) - GOTO 50 - END IF - IF (SETS(0,0).EQ.0) GOTO 52 !NONE SPECIFIED -C - IF (.NOT.NSCHAS(0,HARAN)) GOTO 52 -C - IF (.NOT.NSCIFS(CIFR,SIFRS)) GOTO 52 !SELECT INTERFEROMETERS - CIFR=0 !SET SEEN -C - CALL NSCSAD(CORAP,CORDAP) !GET CORRECTIONS TO (DE-)APPLY -C - IF (.NOT.WNDPAR('BASEL_CHECK',BASDEV,LB_E,J0)) THEN - IF (E_C.EQ.DWC_ENDOFLOOP) GOTO 52 !RETRY - END IF - ELSE IF (SUBOP3.EQ.'VZE') THEN !CALCULATE VZERO - 110 CONTINUE - IF (.NOT.WNDPAR('VZERO_OPTION',SUBOPT, - 1 LEN(SUBOPT),J0,'QUIT')) THEN - SUBOPT='QUIT' !ASSUME END - ELSE IF (J0.LE.0) THEN - SUBOPT='QUIT' !ASSUME END - END IF - IF (SUBOP3.EQ.'QUI') GOTO 50 !NEXT OPTION - IF (SUBOP3.EQ.'CAL') THEN !CALCULATE - OPTION='PVCALC' - ELSE IF (SUBOP3.EQ.'APP') THEN !APPLY - OPTION='PVAPPLY' - ELSE IF (SUBOP3.EQ.'ASK') THEN !ASK - OPTION='PVASK' - ELSE IF (SUBOP3.EQ.'MAN') THEN !MANUAL - OPTION='PVMAN' - ELSE IF (SUBOP3.EQ.'SCA') THEN !SCAN - OPTION='PVSCAN' - ELSE IF (SUBOP3.EQ.'COP') THEN !COPY - OPTION='PVCOPY' - CALL WNDPOH('Target SCN file to which to write corrections', - 1 ' ',' ') - END IF - 111 CONTINUE - CALL WNFCL(FCAOUT) - IF (.NOT.WNDNOD('SCN_NODE',NODOUT,'SCN', - 1 'R',NODOUT,FILOUT)) THEN - IF (E_C.EQ.DWC_ENDOFLOOP) GOTO 110 !RETRY OPTION - GOTO 112 !REPEAT - ELSE IF (E_C.EQ.DWC_NULLVALUE) THEN - GOTO 110 !RETRY OPTION - ELSE IF (E_C.EQ.DWC_WILDCARD) THEN - GOTO 112 !MUST SPECIFY - END IF - IF (.NOT.WNDNOC('SCN_NODE',NODOUT,'SCN', - 1 'U',NODOUT,FILOUT)) GOTO 111 - IF (.NOT.WNFOP(FCAOUT,FILOUT,'U')) THEN !OPEN OUTPUT SCAN FILE - GOTO 112 !RETRY - END IF -C - IF (OPTION.EQ.'PVCOPY') CALL WNDPOH - 1 ('Loop control for both source and target files',' ',' ') - IF (.NOT.WNDXLP('SCN_LOOPS',FCAOUT)) THEN - IF (E_C.EQ.DWC_ENDOFLOOP) GOTO 111 !RETRY NODE - GOTO 111 !REPEAT - END IF - IF (OPTION.EQ.'PVCOPY') - 1 CALL WNDPOH('Any number of sets of target sectors',' ',' ') - IF (.NOT.WNDSTQ('SCN_SETS',MXNSET,SETS,FCAOUT)) THEN !NO SETS - 112 CONTINUE -CC CALL WNFCL(FCAOUT) - GOTO 50 - END IF - IF (SETS(0,0).EQ.0) GOTO 50 !NONE SPECIFIED -C - 114 CONTINUE - IF (OPTION.EQ.'PVCOPY') THEN !NEED INPUT FOR COPY - FCAINP=0 !MAKE SURE NOT THERE - CALL WNDPOH('Source SCN file from which to read data',' ',' ') -CC CALL WNFCL(FCAINP) - IF (.NOT.WNDNOD('USE_SCN_NODE',NODINP,'SCN', - 1 'R',NODINP,FILINP)) THEN - IF (E_C.EQ.DWC_ENDOFLOOP) GOTO 110 !RETRY OPTION - GOTO 114 !REPEAT - ELSE IF (E_C.EQ.DWC_NULLVALUE) THEN - GOTO 110 !RETRY OPTION - ELSE IF (E_C.EQ.DWC_WILDCARD) THEN - FCAINP=FCAOUT !SAME AS OUTPUT - END IF - IF (FCAINP.EQ.0) THEN - IF (.NOT.WNFOP(FCAINP,FILINP,'R')) THEN !OPEN INPUT SCAN FILE - GOTO 114 !RETRY - END IF - END IF - CALL WNDPOH('ONE sector (grp.obs.fld.chn.seq) - 1 |from which to read data',' ',' ') - IF (.NOT.WNDSTQ('USE_SCN_SETS',0,SETINP,FCAINP)) THEN !NO SETS - 115 CONTINUE - GOTO 110 - END IF - IF (SETINP(0,0).EQ.0) GOTO 115 !NONE SPECIFIED - END IF -C - CALL WNDPOH('Hour-angle range in the target sectors',' ', - 3'Hour-angle range for the scans to which to write corrections') - IF (.NOT.NSCHAS(0,HARAN)) GOTO 50 !GET HA. RANGE -C - IF (OPTION.NE.'PVMAN') THEN !NOT MANUAL - IF (.NOT.NSCIFS(CIFR,SIFRS)) GOTO 50 !SELECT INTERFEROMETERS - CIFR=0 !SET SEEN - END IF -C - CALL NSCSAD(CORAP,CORDAP) !GET CORRECTIONS TO (DE-)APPLY -C - BASDEV=0.5 !BASELINE DEVIATION -C -C SHOW POLAR -C - ELSE IF (SUBOP3.EQ.'SHO') THEN !SHOW - OPTION='PDSHOW' !INDICATE SHOW - 55 CONTINUE - CALL WNFCL(FCAOUT) - IF (.NOT.WNDNOD('SCN_NODE',NODOUT,'SCN', - 1 'R',NODOUT,FILOUT)) THEN - IF (E_C.EQ.DWC_ENDOFLOOP) GOTO 50 !RETRY polar OPTION - GOTO 55 !REPEAT - ELSE IF (E_C.EQ.DWC_NULLVALUE) THEN - GOTO 50 !RETRY OPTION - ELSE IF (E_C.EQ.DWC_WILDCARD) THEN - GOTO 55 !MUST SPECIFY - END IF - IF (.NOT.WNFOP(FCAOUT,FILOUT,'R')) THEN !OPEN OUTPUT SCAN FILE - GOTO 55 !RETRY - END IF -C - IF (.NOT.WNDSTQ('SCN_SETS',MXNSET,SETS,FCAOUT)) THEN !NO SETS - 56 CONTINUE -CC CALL WNFCL(FCAOUT) - GOTO 50 - END IF - IF (SETS(0,0).EQ.0) GOTO 56 !NONE SPECIFIED -C -C ZERO/SET/EDIT/INVERT POLAR -C - ELSE IF (SUBOP3.EQ.'ZER' .OR. SUBOP3.EQ.'SET' .OR. - 1 SUBOP3.EQ.'EDI' .OR. SUBOP3.EQ.'INV') THEN - IF (SUBOP3.EQ.'ZER') THEN - OPTION='PDZERO' !INDICATE ZERO - ELSE IF (SUBOP3.EQ.'INV') THEN - OPTION='PDINV' !INVERT - ELSE IF (SUBOP3.EQ.'SET') THEN - OPTION='PDSET' !SET - ELSE - OPTION='PDEDIT' !EDIT - END IF - 57 CONTINUE - CALL WNFCL(FCAOUT) - IF (.NOT.WNDNOD('SCN_NODE',NODOUT,'SCN', - 1 'R',NODOUT,FILOUT)) THEN - IF (E_C.EQ.DWC_ENDOFLOOP) GOTO 50 !RETRY polar OPTION - GOTO 57 !REPEAT - ELSE IF (E_C.EQ.DWC_NULLVALUE) THEN - GOTO 50 !RETRY OPTION - ELSE IF (E_C.EQ.DWC_WILDCARD) THEN - GOTO 57 !MUST SPECIFY - END IF - IF (.NOT.WNDNOC('SCN_NODE',NODOUT,'SCN', - 1 'U',NODOUT,FILOUT)) GOTO 57 - IF (.NOT.WNFOP(FCAOUT,FILOUT,'U')) THEN !OPEN OUTPUT SCAN FILE - GOTO 57 !RETRY - END IF -C - IF (.NOT.WNDSTQ('SCN_SETS',MXNSET,SETS,FCAOUT)) THEN !NO SETS - 58 CONTINUE -CC CALL WNFCL(FCAOUT) - GOTO 50 - END IF - IF (SETS(0,0).EQ.0) GOTO 58 !NONE SPECIFIED -C -C COPY POLAR -C - ELSE IF (SUBOP3.EQ.'COP') THEN !COPY - OPTION='PDCOPY' !INDICATE COPY - 90 CONTINUE - CALL WNDPOH('Target node to which to write corrections',' ', - 3'POLAR COPY creates dipole corrections for any number of sectors | - 3using the corrections from 1 input sector in the same or another | - 3 SCN file.') - CALL WNFCL(FCAOUT) - IF (.NOT.WNDNOD('SCN_NODE',NODOUT,'SCN', - 1 'R',NODOUT,FILOUT)) THEN - IF (E_C.EQ.DWC_ENDOFLOOP) GOTO 50 !RETRY polar OPTION - GOTO 90 !REPEAT - ELSE IF (E_C.EQ.DWC_NULLVALUE) THEN - GOTO 50 !RETRY OPTION - ELSE IF (E_C.EQ.DWC_WILDCARD) THEN - GOTO 90 !MUST SPECIFY - END IF - IF (.NOT.WNDNOC('SCN_NODE',NODOUT,'SCN', - 1 'U',NODOUT,FILOUT)) GOTO 90 - IF (.NOT.WNFOP(FCAOUT,FILOUT,'U')) THEN !OPEN OUTPUT SCAN FILE - GOTO 90 !RETRY - END IF -C - CALL WNDPOH('Loop control for both source and target files',' ',' ') - IF (.NOT.WNDXLP('SCN_LOOPS',FCAOUT)) THEN - IF (E_C.EQ.DWC_ENDOFLOOP) GOTO 90 !RETRY NODE - GOTO 90 !REPEAT - END IF - CALL WNDPOH('Any number of sets of target sectors',' ',' ') - IF (.NOT.WNDSTQ('SCN_SETS',MXNSET,SETS,FCAOUT)) THEN !NO SETS - 92 CONTINUE -CC CALL WNFCL(FCAOUT) - GOTO 90 - END IF - IF (SETS(0,0).EQ.0) GOTO 92 !NONE SPECIFIED -C - 96 CONTINUE - FCAINP=0 !MAKE SURE NOT THERE - CALL WNDPOH('Source SCN file for dipole corrections',' ',' ') -CC CALL WNFCL(FCAINP) - IF (.NOT.WNDNOD('USE_SCN_NODE',NODINP,'SCN', - 1 'R',NODINP,FILINP)) THEN - IF (E_C.EQ.DWC_ENDOFLOOP) GOTO 50 !RETRY polar OPTION - GOTO 96 !REPEAT - ELSE IF (E_C.EQ.DWC_NULLVALUE) THEN - GOTO 50 !RETRY OPTION - ELSE IF (E_C.EQ.DWC_WILDCARD) THEN - FCAINP=FCAOUT !SAME AS OUTPUT - END IF - IF (FCAINP.EQ.0) THEN - IF (.NOT.WNFOP(FCAINP,FILINP,'R')) THEN !OPEN INPUT SCAN FILE - GOTO 96 !RETRY - END IF - END IF -C - CALL WNDPOH('ONE sector (grp.obs.fld.chn.seq) - 1 |from which to read corrections',' ', - 1 'Specify the sector from which to copy the corrections |#-') - IF (.NOT.WNDSTQ('USE_SCN_SETS',0,SETINP,FCAINP)) THEN !NO SETS - 97 CONTINUE - CALL WNFCL(FCAINP) !CHANGED 931220 - GOTO 90 - END IF - IF (SETINP(0,0).EQ.0) GOTO 97 !NONE SPECIFIED -C - END IF !END POLAR -C -C READY POLARISATION -C - GOTO 900 -C -C SET CORRECTIONS -C - 20 CONTINUE - IF (.NOT.WNDPAR('SET_OPTION',SUBOPT,LEN(SUBOPT),J0,'QUIT')) THEN - SUBOPT='QUIT' - ELSE IF (J0.LE.0) THEN - SUBOPT='QUIT' - END IF - IF (SUBOP3.EQ.'QUI') GOTO 100 !NEXT OPTION - IF (SUBOP3.EQ.'OTH') THEN - IF (.NOT.WNDPAR('OTH_OPTION',SUBOPT,LEN(SUBOPT),J0,'QUIT')) THEN - SUBOPT='QUIT' - ELSE IF (J0.LE.0) THEN - SUBOPT='QUIT' - END IF - IF (SUBOP3.EQ.'QUI') GOTO 20 !TRY SET_OPTION - END IF -C -C -C GET VALUES FOR ZERO/EXTINCTION/REFRACTION/FARADAY ETC -C - IF (SUBOP3.EQ.'ZER' .OR. SUBOP3.EQ.'EXT' .OR. SUBOP3.EQ.'INV' .OR. - 1 SUBOP3.EQ.'REF' .OR. SUBOP3.EQ.'FAR' .OR. - 1 SUBOP3.EQ.'IRE' .OR. SUBOP3.EQ.'CLK' .OR. - 1 SUBOP3.EQ.'POL' .OR. SUBOP3.EQ.'FRE' .OR. - 1 SUBOP3.EQ.'DX' .OR. SUBOP3.EQ.'DY' .OR. - 1 SUBOP3.EQ.'DZ' .OR. SUBOP3.EQ.'SHI') THEN - DO I=0,STHTEL-1 !SELECT ALL TELS - TELS(I)=.TRUE. - END DO - IF (SUBOP3.EQ.'ZER') THEN - OPTION='SETZERO' - CALL NSCSAZ(CORZE,APSOL) !GET TO ZERO - IF (CORZE.EQ.0) GOTO 20 !NOTHING TO ZERO - ELSE IF (SUBOP3.EQ.'INV') THEN - OPTION='SETINVERT' - CALL NSCSAZ(CORZE,APSOL) !GET WHAT TO INVERT - IF (CORZE.EQ.0) GOTO 20 !NOTHING TO INVERT - ELSE IF (SUBOP3.EQ.'EXT') THEN - OPTION='SETEXT' - 30 CONTINUE - IF (.NOT.WNDPAR('EXTINCTION',CFEXT,3*LB_E, - 1 J0,' ',CFEXT,3)) THEN - IF (E_C.EQ.DWC_ENDOFLOOP) GOTO 20 !RETRY - GOTO 30 - END IF - IF (J0.EQ.0) GOTO 20 - ELSE IF (SUBOP3.EQ.'REF') THEN - OPTION='SETREF' - 31 CONTINUE - IF (.NOT.WNDPAR('REFRACTION',CFREF,3*LB_E, - 1 J0,' ',CFREF,3)) THEN - IF (E_C.EQ.DWC_ENDOFLOOP) GOTO 20 !RETRY - GOTO 31 - END IF - IF (J0.EQ.0) GOTO 20 - ELSE IF (SUBOP3.EQ.'CLK') THEN - OPTION='SETCLK' - 34 CONTINUE - CFREF(0)=0 - IF (.NOT.WNDPAR('CLOCK_CORR',CFREF,LB_E, - 1 J0,'0')) THEN - IF (E_C.EQ.DWC_ENDOFLOOP) GOTO 20 !RETRY - GOTO 34 - END IF - IF (J0.EQ.0) GOTO 20 - ELSE IF (SUBOP3.EQ.'SHI') THEN - OPTION='SETSHIFT' - 38 CONTINUE - CFREF(0)=0 - CFREF(1)=0 - CFEXT(0)=0 - CFEXT(1)=0 - IF (.NOT.WNDPAR('SHIFT',CFREF,2*LB_E, - 1 J0,'0,0')) THEN - IF (E_C.EQ.DWC_ENDOFLOOP) GOTO 20 !RETRY - GOTO 38 - END IF - IF (J0.EQ.0) GOTO 20 - IF (.NOT.WNDPAR('DSHIFT',CFEXT,2*LB_E, - 1 J0,'0,0')) THEN - IF (E_C.EQ.DWC_ENDOFLOOP) GOTO 20 !RETRY - GOTO 38 - END IF - IF (J0.EQ.0) GOTO 20 - ELSE IF (SUBOP3.EQ.'POL') THEN - OPTION='SETPOLE' - 35 CONTINUE - PCGAN(0,0)=0 - IF (.NOT.WNDPAR('BASEL_POLE',PCGAN(0,0),LB_E, - 1 J0,'0')) THEN - IF (E_C.EQ.DWC_ENDOFLOOP) GOTO 20 !RETRY - GOTO 35 - END IF - IF (J0.EQ.0) GOTO 20 - ELSE IF (SUBOP3.EQ.'FRE') THEN - OPTION='SETFREQ' - 36 CONTINUE - PCGAN(0,0)=0 - IF (.NOT.WNDPAR('FREQ_CORR',PCGAN(0,0),LB_E, - 1 J0,'0')) THEN - IF (E_C.EQ.DWC_ENDOFLOOP) GOTO 20 !RETRY - GOTO 36 - END IF - IF (J0.EQ.0) GOTO 20 - ELSE IF (SUBOP3.EQ.'DX' .OR. SUBOP3.EQ.'DY' .OR. - 1 SUBOP3.EQ.'DZ') THEN - IF (SUBOP3.EQ.'DX') THEN - OPTION='SETDX' - ELSE IF (SUBOP3.EQ.'DY') THEN - OPTION='SETDY' - ELSE - OPTION='SETDZ' - END IF - DO I1=0,STHTEL-1 !EMPTY DATA - PCGAN(I1,0)=0 - END DO - 37 CONTINUE - IF (.NOT.WNDPAR('BASEL_'//SUBOP3,PCGAN(0,0), - 1 STHTEL*LB_E,J0,A_B(-A_OB), - 1 PCGAN(0,0),STHTEL)) THEN - IF (E_C.EQ.DWC_ENDOFLOOP) GOTO 20 !RETRY - GOTO 37 - END IF - IF (J0.EQ.0) GOTO 20 - ELSE IF (SUBOP3.EQ.'FAR') THEN - OPTION='SETFAR' - 32 CONTINUE - IF (.NOT.WNDPAR('FARADAY_FILE',FILINP,LEN(FILINP), - 1 J0,'""')) THEN - IF (E_C.EQ.DWC_ENDOFLOOP) GOTO 20 !RETRY - GOTO 32 - END IF - IF (J0.EQ.0) GOTO 20 - IF (J0.LT.0) GOTO 32 !MUST SPECIFY - CALL WNFCL(FCAINP) - IF (.NOT.WNFOP(FCAINP,FILINP,'R')) GOTO 32 !NO SUCH FILE - CALL WNFCL(FCAINP) !CLOSE FILE - ELSE IF (SUBOP3.EQ.'IRE') THEN - OPTION='SETIREFRAC' - 33 CONTINUE - IF (.NOT.WNDPAR('IREFRACT_FILE',FILINP,LEN(FILINP), - 1 J0,'""')) THEN - IF (E_C.EQ.DWC_ENDOFLOOP) GOTO 20 !RETRY - GOTO 33 - END IF - IF (J0.EQ.0) GOTO 20 - IF (J0.LT.0) GOTO 33 !MUST SPECIFY - CALL WNFCL(FCAINP) - IF (.NOT.WNFOP(FCAINP,FILINP,'R')) GOTO 32 !NO SUCH FILE - END IF -C -C SPECIFY UV-DATA -C - 21 CONTINUE - CALL WNFCL(FCAOUT) - IF (.NOT.WNDNOD('SCN_NODE',NODOUT,'SCN', - 1 'R',NODOUT,FILOUT)) THEN - IF (E_C.EQ.DWC_ENDOFLOOP) GOTO 20 !RETRY UNIT - GOTO 21 !REPEAT - ELSE IF (E_C.EQ.DWC_NULLVALUE) THEN - GOTO 20 !RETRY OPTION - ELSE IF (E_C.EQ.DWC_WILDCARD) THEN - GOTO 21 !MUST SPECIFY - END IF - IF (.NOT.WNDNOC('SCN_NODE',NODOUT,'SCN', - 1 'U',NODOUT,FILOUT)) GOTO 21 - IF (.NOT.WNFOP(FCAOUT,FILOUT,'U')) THEN !OPEN OUTPUT SCAN FILE - GOTO 21 !RETRY - END IF -C - IF (.NOT.WNDSTQ('SCN_SETS',MXNSET,SETS,FCAOUT)) THEN !NO SETS - 22 CONTINUE - GOTO 21 - END IF - IF (SETS(0,0).EQ.0) GOTO 22 !NONE SPECIFIED - IF (.NOT.NSCSTG(FCAOUT,SETS,STH,STHP,SETNAM)) GOTO 22 !FIND A SET - CALL WNDSTR(FCAOUT,SETS) !RESET SET SEARCH -C - IF (SUBOP3.EQ.'ZER' .OR. SUBOP3.EQ.'INV') THEN - CALL WNDPOH('Telescope polarisation', 'X,Y,XY', - 3'The telescope dipoles for which corrections will be zeroed/inverted | - 3The valid options are X only, Y only or both |#-') - IF (.NOT.NSCPLS(XY_P,SPOL)) GOTO 22 !GET POLARISATION SELECTION - XYSOL(0)=IAND(SPOL,XX_P).NE.0 !SET X,Y TYPE - XYSOL(1)=IAND(SPOL,YY_P).NE.0 - IF (.NOT.NSCTL1(1,TELS,STH)) GOTO 22 !GET TELESCOPES TO DO - ELSE IF (SUBOP3.EQ.'POL' .OR. SUBOP3.EQ.'FRE' .OR. - 1 SUBOP3.EQ.'DX' .OR. SUBOP3.EQ.'DY' .OR. - 1 SUBOP3.EQ.'DZ') THEN - XYSOL(0)=.TRUE. !SET X,Y TYPE - XYSOL(1)=.TRUE. - END IF - IF (.NOT.NSCHAS(0,HARAN)) GOTO 22 !GET HA. RANGE -C -C MANUAL/INIT/IFR/MIFR/RENORM CORRECTIONS -C -C SPECIFY UV-DATA -C - ELSE IF (SUBOP3.EQ.'MAN' .OR. SUBOP3.EQ.'INI' .OR. - 1 SUBOP3.EQ.'MUL' .OR. SUBOP3.EQ.'REN') THEN - IF (SUBOP3.EQ.'MAN') THEN - OPTION='SETMANINI' !MANUAL - ELSE IF (SUBOP3.EQ.'INI') THEN - OPTION='SETMANINI2' !INIT - ELSE IF (SUBOP3.EQ.'MUL') THEN - OPTION='SETCLK' - ELSE - OPTION='SETRENORM' !RENORM - END IF - 40 CONTINUE - CALL WNFCL(FCAOUT) - IF (.NOT.WNDNOD('SCN_NODE',NODOUT,'SCN', - 1 'R',NODOUT,FILOUT)) THEN - IF (E_C.EQ.DWC_ENDOFLOOP) GOTO 20 !RETRY set OPTION - GOTO 40 !REPEAT - ELSE IF (E_C.EQ.DWC_NULLVALUE) THEN - GOTO 20 !RETRY set OPTION - ELSE IF (E_C.EQ.DWC_WILDCARD) THEN - GOTO 40 !MUST SPECIFY - END IF - IF (.NOT.WNDNOC('SCN_NODE',NODOUT,'SCN', - 1 'U',NODOUT,FILOUT)) GOTO 40 - IF (.NOT.WNFOP(FCAOUT,FILOUT,'U')) GOTO 40 !OPEN OUTPUT SCAN FILE -C - 409 CONTINUE - IF (SUBOP3.EQ.'INI') THEN !GET LOOPS - IF (.NOT.WNDXLP('SCN_LOOPS',FCAOUT)) THEN - IF (E_C.EQ.DWC_ENDOFLOOP) GOTO 40 !RETRY NODE - GOTO 409 !REPEAT - END IF - ENDIF -C - 42 CONTINUE - IF (.NOT.WNDSTQ('SCN_SETS',MXNSET,SETS,FCAOUT)) - 1 GOTO 40 - IF (SETS(0,0).EQ.0) GOTO 42 !NONE SPECIFIED -C - CALL WNDPOH('Telescope polarisation', 'X,Y,XY', - 3'The telescope dipoles for which corrections will be modified | - 3The valid options are X only, Y only or both |#-') - IF (.NOT.NSCPLS(XY_P,SPOL)) GOTO 42 !GET POL. SELECTION - XYSOL(0)=IAND(SPOL,XX_P).NE.0 !SET X,Y TYPE - XYSOL(1)=IAND(SPOL,YY_P).NE.0 - IF (.NOT.NSCHAS(0,HARAN)) GOTO 42 !GET HA. RANGE - DO I=0,1 !EMPTY CORRECTIONS - DO I1=0,STHTEL-1 - PCGAN(I1,I)=1 - PCPHS(I1,I)=0 - END DO - END DO -C -C GET USER DATA -C - 45 CONTINUE - IF (SUBOP3.EQ.'MAN' .OR. SUBOP3.EQ.'MUL') THEN !MANUAL - DO I=0,1 !X,Y - IF (XYSOL(I)) THEN !X - IF (.NOT.WNDPAR('GAIN_'//PCTP(I),PCGAN(0,I),STHTEL*LB_E,J0, - 1 A_B(-A_OB),PCGAN(0,I),STHTEL)) THEN - IF (E_C.EQ.DWC_ENDOFLOOP) GOTO 42 !RETRY NODE - GOTO 45 !RETRY - END IF - IF (J0.LE.0) GOTO 45 !MUST SPECIFY - IF (SUBOP3.EQ.'MAN') THEN - IF (.NOT.WNDPAR('PHASE_'//PCTP(I),PCPHS(0,I),STHTEL*LB_E,J0, - 1 A_B(-A_OB),PCPHS(0,I),STHTEL)) THEN - IF (E_C.EQ.DWC_ENDOFLOOP) GOTO 42 !RETRY NODE - GOTO 45 !RETRY - END IF - IF (J0.LE.0) GOTO 45 !MUST SPECIFY - ENDIF - END IF - DO I1=0,STHTEL-1 - IF (PCGAN(I1,I).LT.GANMIN.OR. - 1 PCGAN(I1,I).GT.GANMAX) THEN - PCGAN(I1,I)=1 !LIMIT VALUE - CALL WNCTXT(F_TP,'Gains limited between !E and !E', - 1 GANMIN,GANMAX) - END IF - END DO - END DO -C - ELSE IF (SUBOP3.EQ.'INI') THEN !INITIALISE - IF (.NOT.NSCIFS(CIFR,SIFRS)) GOTO 42 !SELECT INTERFEROMETERS -CC981022 CALL NCATEL(FCAOUT,SETS,HARAN(1),HARAN(2),SIFRS, -CC981022 1 PCGAN,PCPHS,F_T) !GET VALUES -C - ELSE IF (SUBOP3.EQ.'REN') THEN !RENORM - CALL NSCSAD(CORAP,CORDAP) !GET CORRECTIONS TO (DE-)APPLY - IF (.NOT.WNDPAR('GAIN_NORM',FREGPH(0,0),STHTEL*LB_J, - 1 J0,A_B(-A_OB),FREGPH(0,0),STHTEL)) GOTO 42 !RETRY NODE - IF (J0.EQ.0) THEN - DO I=0,STHTEL-1 !SET ALL TELESCOPES - FREGPH(I,0)=1 !WAS 0??? CMV940428 - END DO - J0=STHTEL !ALL SET - END IF - IF (J0.LT.0) THEN - DO I=0,STHTEL-1 !SET ALL TELESCOPES - FREGPH(I,0)=1 - END DO - J0=STHTEL !ALL SET - END IF - DO I=J0,STHTEL-1 !DESELECT SOME - FREGPH(I,0)=0 - END DO - IF (.NOT.WNDPAR('PHASE_NORM',FREGPH(0,1),STHTEL*LB_J, - 1 J0,A_B(-A_OB),FREGPH(0,1),STHTEL)) GOTO 42 - IF (J0.EQ.0) THEN - DO I=0,STHTEL-1 !SET FREEDOM - FREGPH(I,1)=1 !WAS 0??? CMV940428 - END DO - J0=STHTEL !ALL SET - END IF - IF (J0.LT.0) THEN - DO I=0,STHTEL-1 !SET FREEDOM - FREGPH(I,1)=1 - END DO - J0=STHTEL !ALL SET - END IF - DO I=J0,STHTEL-1 !DESELECT SOME - FREGPH(I,1)=0 - END DO - END IF -C -C IFR CORRECTIONS -C -C SPECIFY UV-DATA -C - ELSE IF (SUBOP3.EQ.'IFR' .OR. SUBOP3.EQ.'MIF') THEN - IF (SUBOP3.EQ.'IFR') THEN - OPTION='SETIFR' !Additive ifr - ELSE IF (SUBOP3.EQ.'MIF') THEN - OPTION='SETMIFR' !Multiplicative ifr - END IF - 46 CONTINUE - CALL WNFCL(FCAOUT) - IF (.NOT.WNDNOD('SCN_NODE',NODOUT,'SCN', - 1 'R',NODOUT,FILOUT)) THEN - IF (E_C.EQ.DWC_ENDOFLOOP) GOTO 20 !RETRY set OPTION - GOTO 46 !REPEAT - ELSE IF (E_C.EQ.DWC_NULLVALUE) THEN - GOTO 20 !RETRY OPTION - ELSE IF (E_C.EQ.DWC_WILDCARD) THEN - GOTO 46 !MUST SPECIFY - END IF - IF (.NOT.WNDNOC('SCN_NODE',NODOUT,'SCN', - 1 'U',NODOUT,FILOUT)) GOTO 46 - IF (.NOT.WNFOP(FCAOUT,FILOUT,'U')) THEN !OPEN OUTPUT SCAN FILE - GOTO 46 !RETRY - END IF -C - 47 CONTINUE - IF (.NOT.WNDSTQ('SCN_SETS',MXNSET,SETS,FCAOUT)) GOTO 46 !NO SETS - IF (SETS(0,0).EQ.0) GOTO 47 !NONE SPECIFIED - IF (.NOT.NSCSTG(FCAOUT,SETS,STH,STHP,SETNAM)) GOTO 47 !FIND A SET - CALL WNDSTR(FCAOUT,SETS) !RESET SET SEARCH -C - CALL WNDPOH('Interferometer polarisation', 'XYX,XY,YX,X,Y', - 3'The telescope dipole set for which solutions will be made | - 3The valid options are |. | - 3 XYX meaning XX, XY, YX, YY | - 3 XY meaning XX, YY | - 3 YX meaning XY, YX | - 3 X meaning XX | - 3 Y meaning YY | - 3#-') - IF (.NOT.NSCPLS(0,SPOL)) GOTO 47 !GET POL. SELECTION - IF (.NOT.NSCHAS(0,HARAN)) GOTO 47 !GET HA. RANGE - IF (.NOT.NSCIFS(CIFR,SIFRS)) GOTO 47 !SELECT INTERFEROMETERS - CIFR=0 !SET SEEN -C -C GET USER DATA -C - I= -1 !POINTER IN ARRAY - DO I1=0,STHTEL-1 - DO I2=I1+1,STHTEL-1 - IF (SIFRS(I1,I2)) THEN !IFR SELECTED - CALL WNCTXT(F_TP,'Interferometer !1$XJ!1$XJ',I1,I2) - I=I+1 !NEXT ELEMENT IN ARRAY - DO I3=0,3 - 49 CONTINUE - IF (IAND(SPOL,PLFL(I3)).NE.0) THEN !POL SELECTED - IF (SUBOP3.EQ.'IFR') THEN !ADDITIVE - IF (.NOT.WNDPAR('IFR_'//PLTP(I3),RBUF, - 1 2*LB_E,J0,'0,0')) THEN - IF (E_C.EQ.DWC_ENDOFLOOP) GOTO 47 !RETRY HA - GOTO 49 !RETRY - END IF - IFRCOR(I,I3)=CMPLX(RBUF(1),RBUF(2)) !COS,SIN WILL BE ADDED - ELSE !MULTIPLICATIVE - IF (.NOT.WNDPAR('GAIN_'//PLTP(I3),R0, - 1 LB_E,J0,'1')) THEN - IF (E_C.EQ.DWC_ENDOFLOOP) GOTO 47 !RETRY HA - GOTO 49 !RETRY - END IF - IF (R0.LT.GANMIN.OR.R0.GT.GANMAX) THEN - R0=1 !LIMIT GAIN - CALL WNCTXT(F_TP, - 1 'Gains limited between !E and !E', - 1 GANMIN,GANMAX) - END IF - IF (.NOT.WNDPAR('PHASE_'//PLTP(I3),R1, - 1 LB_E,J0,'0')) THEN - IF (E_C.EQ.DWC_ENDOFLOOP) GOTO 47 !RETRY HA - GOTO 49 !RETRY - END IF - IFRCOR(I,I3)=CMPLX(LOG(ABS(R0)),R1/180.*PI) - !DATA WILL BE MULTIPLIED - !BY EXP(-CMPLX) - END IF - END IF - END DO - END IF - END DO - END DO -C -C COPY CORRECTIONS -C - ELSE IF (SUBOP3.EQ.'COP' .OR. SUBOP3.EQ.'LIN' .OR. - 1 SUBOP3.EQ.'CCO' .OR. SUBOP3.EQ.'ICO') THEN - 60 CONTINUE - CALL WNDPOH( - 1'Target node to which to write corrections',' ',' ') - IF (SUBOP3.EQ.'COP') THEN - OPTION='SETCOPY' - CALL WNDPOH(' ',' ', - 3'SET COPY creates corrections for any number of scans (to be | - 3selected) using the corrections from all specified input sector | - 3in the same or another SCN file.') -C - ELSE IF (SUBOP3.EQ.'LIN') THEN - OPTION='SETLINE' - CALL WNDPOH(' ',' ', - 3'SET LINE copies telescope corrections from the continuum channel | - 3(Channel 0) to selected parts of the corresponding line-channel | - 3sectors.') -C - ELSE IF (SUBOP3.EQ.'CCO') THEN - OPTION='SETCCOPY' - CALL WNDPOH(' ',' ', - 3'SET CCOPY interpolates/copies the average telescope corrections | - 3from 2 complete input sectors to selected parts of any number of | - 3output sectors.') -C - ELSE IF (SUBOP3.EQ.'ICO') THEN - OPTION='SETICOPY' - CALL WNDPOH(' ',' ', - 3'SET ICOPY creates corrections for any number of scans (to be | - 3selected) using the MIFR corrections from all specified input sector | - 3in the same or another SCN file.') - ENDIF -C - CALL WNFCL(FCAOUT) - IF (.NOT.WNDNOD('SCN_NODE',NODOUT,'SCN', - 1 'R',NODOUT,FILOUT)) THEN - IF (E_C.EQ.DWC_ENDOFLOOP) GOTO 20 !RETRY set OPTION - GOTO 60 !REPEAT - ELSE IF (E_C.EQ.DWC_NULLVALUE) THEN - GOTO 60 !RETRY OPTION - ELSE IF (E_C.EQ.DWC_WILDCARD) THEN - GOTO 60 !MUST SPECIFY - END IF - IF (.NOT.WNDNOC('SCN_NODE',NODOUT,'SCN', - 1 'U',NODOUT,FILOUT)) GOTO 60 - IF (.NOT.WNFOP(FCAOUT,FILOUT,'U')) THEN !OPEN OUTPUT SCAN FILE - GOTO 60 !RETRY - END IF -C - 65 CONTINUE - IF (SUBOP3.EQ.'COP' .OR. SUBOP3.EQ.'CCO' .OR. SUBOP3.EQ.'ICO') THEN - CALL WNDPOH - 1 ('Loop control for both source and target files',' ',' ') - IF (.NOT.WNDXLP('SCN_LOOPS',FCAOUT)) THEN - IF (E_C.EQ.DWC_ENDOFLOOP) GOTO 60 !RETRY NODE - GOTO 65 !REPEAT - END IF -C - CEQUAL=0 !DEFAULT: NO - BB1=.FALSE. - IF (WNDPAR('CAL_EQUAL',BB1,LB_B,J0,'NO')) THEN - IF (BB1) CEQUAL=1 - END IF - END IF -C - 67 CONTINUE - CALL WNDPOH( - 1'Any number of target sectors (grp.obs.fld.chn.seq) - 1 | to which to write corrections',' ',' ') - IF (SUBOPT.EQ.'LIN') THEN - ELSE - CALL WNDPOH(' ',' ', - 3'For each target sector, corrections will be copied from the | - 3corresponding continuum channel (chn=0). No harm will be done if | - 3your selection includes continuum channels (e.g. because you use a - 3 wildcard).') - ENDIF - IF (.NOT.WNDSTQ('SCN_SETS',MXNSET,SETS,FCAOUT)) GOTO 65 - IF (SETS(0,0).EQ.0) GOTO 65 !NONE SPECIFIED -CC IF (.NOT.NSCSTG(FCAOUT,SETS,STH,STHP,SETNAM)) GOTO 65 !FIND A SET -CC CALL WNDSTR(FCAOUT,SETS) !RESET SET SEARCH -C - IF (SUBOP3.EQ.'ICO') THEN - CALL WNDPOH('Interferometer polarisation', 'XYX,XY,YX,X,Y', - 3'The telescope dipole set for which solutions will be made | - 3The valid options are |. | - 3 XYX meaning XX, XY, YX, YY | - 3 XY meaning XX, YY | - 3 YX meaning XY, YX | - 3 X meaning XX | - 3 Y meaning YY | - 3#-') - IF (.NOT.NSCPLS(0,SPOL)) GOTO 67 !GET POL. SELECTION - ELSE - CALL WNDPOH('Telescope polarisation', 'X,Y,XY', - 1'The telescope dipole set for which solutions will be made | - 1The valid options are X only, Y only or both |#-') - IF (.NOT.NSCPLS(XY_P,SPOL)) GOTO 67 !GET POL. SELECTION - XYSOL(0)=IAND(SPOL,XX_P).NE.0 !SET X,Y TYPE - XYSOL(1)=IAND(SPOL,YY_P).NE.0 - IF (.NOT.NSCTL1(1,TELS,STH)) GOTO 67 !GET TELESCOPES TO DO - ENDIF -C - IF (.NOT.NSCHAS(0,HARAN)) GOTO 67 !GET HA. RANGE - IF (SUBOP3.EQ.'ICO') THEN - IF (.NOT.NSCIFS(4,SIFRS)) GOTO 47 !SELECT INTERFEROMETERS - ENDIF -C - 66 CONTINUE - IF (SUBOP3.EQ.'COP' .OR. SUBOP3.EQ.'CCO' .OR. SUBOP3.EQ.'ICO') THEN - CALL WNDPOH('Source SCN file from which to read corrections |', - 1' ', - 1'The default "*" means: "The same as the target file"') -CC CALL WNFCL(FCAINP) - IF (.NOT.WNDNOD('USE_SCN_NODE',NODINP,'SCN', - 1 'R',NODINP,FILINP)) THEN - IF (E_C.EQ.DWC_ENDOFLOOP) GOTO 67 ! retry SCN_SETS - GOTO 66 !REPEAT - ELSE IF (E_C.EQ.DWC_NULLVALUE) THEN - GOTO 65 !RETRY OPTION - ELSE IF (E_C.EQ.DWC_WILDCARD) THEN - FCAINP=FCAOUT !SAME AS OUTPUT - END IF - IF (FCAINP.EQ.0) THEN - IF (.NOT.WNFOP(FCAINP,FILINP,'R')) THEN !OPEN INPUT SCAN FILE - GOTO 66 !RETRY - END IF - END IF -C - 68 CONTINUE - CALL WNDPOH('Sectors (grp.obs.fld.chn.seq) - 1 |from which to read corrections',' ',' ') - IF (.NOT.WNDSTQ('USE_SCN_SETS',MXNSET,SETINP,FCAINP)) !NO SETS - 1 GOTO 66 - IF (SETINP(0,0).EQ.0) GOTO 68 !NONE SPECIFIED - END IF - IF (SUBOP3.EQ.'LIN') THEN - RS1=0 - JS=WNDPAR('CALCHAN',RS1,LB_J,J0,A_B(-A_OB),RS1,1) - IF (.NOT.JS) GOTO 68 !NONE SPECIFIED - END IF -C -C READY SET -C - END IF - GOTO 900 -C -C SHOW -C - 70 CONTINUE - IF (NODINP.EQ.'*') NODINP=' ' - CALL WNDPOH('SCN file to be shown',' ',' ') - CALL WNFCL(FCAINP) - IF (.NOT.WNDNOD('USE_SCN_NODE',NODINP,'SCN','R',NODINP,FILINP)) THEN - IF (E_C.EQ.DWC_ENDOFLOOP) GOTO 100 !RETRY OPTION - GOTO 100 !REPEAT - ELSE IF (E_C.EQ.DWC_NULLVALUE) THEN - GOTO 100 !RETRY OPTION - ELSE IF (E_C.EQ.DWC_WILDCARD) THEN - GOTO 70 !MUST SPECIFY - END IF - IF (.NOT.WNFOP(FCAINP,FILINP,'R')) THEN !OPEN INPUT SCAN FILE - GOTO 70 !RETRY - END IF -C - 75 CONTINUE - IF (.NOT.WNDXLP('SCN_LOOPS',FCAINP)) THEN - IF (E_C.EQ.DWC_ENDOFLOOP) GOTO 70 !RETRY - GOTO 75 !REPEAT - END IF -C - CALL WNDPOH('Sectors (grp.obs.fld.chn.seq) to be shown |',' ',' ') - IF (.NOT.WNDSTQ('USE_SCN_SETS',MXNSET,SETINP,FCAINP)) THEN !NO SETS - 77 CONTINUE -CC CALL WNFCL(FCAINP) - GOTO 70 - END IF - IF (SETINP(0,0).EQ.0) GOTO 77 !NONE SPECIFIED -C - CEQUAL=0 !DEFAULT: NO - BB1=.FALSE. - IF (WNDPAR('CAL_EQUAL',BB1,LB_B,J0,'NO')) THEN - IF (BB1) CEQUAL=1 - END IF -C -C READY SHOW -C - GOTO 900 -C -C READY -C - 900 CONTINUE -C - RETURN !READY -C -C - END diff --git a/src/nscan/ncaini.for b/src/nscan/ncaini.for deleted file mode 100644 index 876edc9d2231232a3d655db310e9c5cb1a408850..0000000000000000000000000000000000000000 --- a/src/nscan/ncaini.for +++ /dev/null @@ -1,53 +0,0 @@ -C+ NCAINI.FOR -C WNB 900306 -C -C Revisions: -C - SUBROUTINE NCAINI -C -C Initialize NCALIB program -C -C Result: -C -C CALL NCAINI will set header lines, logging, DWARF interface -C -C Include files: -C - INCLUDE 'WNG_DEF' - INCLUDE 'NCA_DEF' -C -C Parameters: -C -C -C Arguments: -C -C -C Function references: -C - LOGICAL WNDINI !INIT DWARF - LOGICAL WNDDAB !OPEN DATABASE -C -C Data declarations: -C -C- -C -C SET HEADER LINES -C - CALL WNCFHD(F_P,1,'!40C\Program to calibrate SCN files') -C -C START DWARF -C - IF (.NOT.WNDINI(PRGNAM)) CALL WNGEX !EXIT IF NO DWARF START -C -C LOGGING -C - CALL WNDLOG(LOGCD) !PROPER LOGGING -C -C DATABASE -C - IF (.NOT.WNDDAB()) CALL WNGEX !OPEN DATABASE -C - RETURN !READY -C -C - END diff --git a/src/nscan/ncalib.for b/src/nscan/ncalib.for deleted file mode 100644 index 7ea30814b3f6fb2fc7eb4d3c01249ec1715db18e..0000000000000000000000000000000000000000 --- a/src/nscan/ncalib.for +++ /dev/null @@ -1,289 +0,0 @@ -C+ NCALIB.FOR -C WNB 900306 -C -C Revisions: -C WNB 910612 Add loops -C WNB 910813 Add copy -C WNB 910828 Add RUN -C WNB 910913 Change loops -C WNB 910923 Add PDSET,PDEDIT,PDCOPY -C WNB 910930 Add loops on POLAR COPY -C WNB 910930 Add VZERO -C WNB 911009 Add RENORM -C WNB 921217 Add CCOPY -C WNB 930602 Add IREF, CLK -C WNB 930603 Add BASEL_POLE, DX, DY, DZ, FREQ_CORR -C WNB 930614 Text for DX.... -C WNB 930617 Add SHIFT SET -C CMV 931027 Tell user SHOW is in log-file -C JPH 931201 Remove useless comments to make the good ones visible -C CMV 940503 Add IFR corrections, enumerate NCASTX etc -C JPH 940902 Combine all duplicated WNDRUNs and WNFCLs in single -C calls. (Consequently WNDRUN is now checked for all -C options, - I assume that the old situation was -C incorrect.) -C Loop back to NCADAT for all options. (see NOTE below) -C CMV 940927 Add option SET MULTIPLY (SETCLK) -C JPH 941214 Remove temporary message -C JPH 950124 Merge CMV940927 -C CMV 950220 Format in SHOW set back to original -C HjV 950622 Add NCACIC-part (Copy IFR corrections) -C WNB 950629 Change LOOP -C HjV 960411 Correct Copy MIFR corrections part. -C Take all interferometers. (Also 00, 11 etc.) -C JPH 960627 Revised SHOW format, also on terminal -C JPH 960718 NCAPVZ --> PVA for VZERO COPY -C JPH 960801 Replace function codes by legible ones. Fix dispatching -C error. (CLK and MIFR were mixed up so CLK wouldn't -C work.) -C JPH 961120 NCAPVx MDONE argument to control message emission. -C (Local flag ith DATA is reinitialised every time the -C routine is entered!) -C JPH 961209 JDONE argument on NCASTN -C JPH 970128 SHOW: Change calculation of gain ME, add comment. -C WNB 981022 Added loops for SET--INIT -C WNB 080711 Added SETINVERT option -C WNB 081226 Added PDINV polarisation invert option -C -C - SUBROUTINE NCALIB -C -C Main routine to do calibration of scan files -C -C Result: -C -C -C Include files: -C - INCLUDE 'WNG_DEF' - INCLUDE 'STH_O_DEF' !SET HEADER - INCLUDE 'NCA_DEF' -C -C Parameters: -C -C -C Arguments: -C -C -C Function references: -C - LOGICAL WNDRUN - LOGICAL WNDXLN !NEXT -C -C Data declarations: -C - CHARACTER*1 IPC(0:1) !X,Y CODE - DATA IPC/'X','Y'/ - COMPLEX CSOL(0:STHTEL-1,0:1) !AVERAGE CORRECTION TEL X,Y - REAL RSOL(0:1,0:STHTEL-1,0:1) - EQUIVALENCE (CSOL,RSOL) - COMPLEX CME(0:STHTEL-1,0:1) !M.E. AVERAGE TEL X,Y - REAL RME(0:STHTEL,0:1,0:1) !TEL G,P X,Y - COMPLEX CISOL(0:3,0:STHIFR-1,0:1) ! AVERAGE CORRECTION - ! POL,IFR,APPLY/DE_APPLY - REAL RISOL(0:1,0:3,0:STHIFR-1,0:1) - EQUIVALENCE (CISOL,RISOL) - COMPLEX CIME(0:3,0:STHIFR-1,0:1) !M.E. AVERAGE POL,IFR,APP/DE_APP - CHARACTER*1 TELNMA(0:35) - CHARACTER*36 TELNAM - EQUIVALENCE (TELNAM,TELNMA) - DATA TELNAM /'0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ'/ - LOGICAL MDONE ! NCAPVx message control - INTEGER JDONE ! NCASTN message control -C- -C -C NOTE - JPH 940902: -C All options now loop back to NCADAT after completion and the only -C program exit is through QUIT. For those options that used to exit -C autonomously, the exit in batch mode will now be through the path: -C -C OPTION prompt in NCADAT finds no new value, returns ENDOFLOOP -C NCADAT converts this status into a QUIT option value. -C This routine exits on QUIT -C -C PRELIMINARIES -C - CALL NCAINI !INIT PROGRAM - JDONE=0 -C -C DISPATCH -C - 10 CONTINUE - CALL NCADAT !GET USER DATA - MDONE=.FALSE. ! 'message given' flag - CALL WNCTXT(F_TP,'!/') - IF (OPT.EQ.'QUI' .OR. .NOT.WNDRUN()) THEN - CALL WNGEX - END IF - CALL WNDXLI(LPOFF) - IF (OPT.EQ.'RED') THEN - DO WHILE (WNDXLN(LPOFF)) - CALL NCARED - END DO -C -C Polarisation corrections -C - ELSE IF (OPTION.EQ.'PDCALC') THEN !CALCULATE POL. CORRECTION - DO WHILE (WNDXLN(LPOFF)) - CALL NCAPOL - END DO - ELSE IF (OPTION.EQ.'PDSHOW') THEN !SHOW POL. CORRECTION - CALL NCAPOS - ELSE IF (OPTION.EQ.'PDZERO') THEN !ZERO POL. CORRECTION - CALL NCAPOZ - ELSE IF (OPTION.EQ.'PDINV') THEN !INVERT POL. CORRECTION - CALL NCAPOI - ELSE IF (OPTION.EQ.'PDSET') THEN !SET POL. CORRECTION - CALL NCAPOT - ELSE IF (OPTION.EQ.'PDEDIT') THEN !EDIT POL. CORRECTION - CALL NCAPOE - ELSE IF (OPTION.EQ.'PDCOPY') THEN !COPY POL. CORRECTION - DO WHILE (WNDXLN(LPOFF)) - CALL NCAPOC - END DO - CALL WNFCL(FCAINP) - ELSE IF (OPTION.EQ.'PVCALC') THEN !VZERO CALC - DO WHILE (WNDXLN(LPOFF)) - CALL NCAPVZ(MDONE) - END DO - ELSE IF (OPTION.EQ.'PVAPPLY') THEN !VZERO APPLY - DO WHILE (WNDXLN(LPOFF)) - CALL NCAPVA(MDONE) - END DO - ELSE IF (OPTION.EQ.'PVASK') THEN !VZERO ASK - DO WHILE (WNDXLN(LPOFF)) - CALL NCAPVQ(MDONE) - END DO - ELSE IF (OPTION.EQ.'PVMAN') THEN !VZERO MANUAL - DO WHILE (WNDXLN(LPOFF)) - CALL NCAPVM(MDONE) - END DO - ELSE IF (OPTION.EQ.'PVSCAN') THEN !VZERO SCAN - DO WHILE (WNDXLN(LPOFF)) -C CALL NCAPVZ(MDONE) - END DO - ELSE IF (OPTION.EQ.'PVCOPY') THEN !VZERO COPY - DO WHILE (WNDXLN(LPOFF)) - CALL NCAPVA(MDONE) - END DO - CALL WNFCL(FCAINP) -C -C Set and copy various corrections -C - ELSE IF (OPTION.EQ.'SETZERO') THEN !ZERO CORRECTION - CALL NCASTZ - ELSE IF (OPTION.EQ.'SETINVERT') THEN !INVERT CORRECTIONS - CALL NCASTV - ELSE IF (OPTION.EQ.'SETMANINI') THEN !MANUAL CORRECTION - CALL NCASTC - ELSE IF (OPTION.EQ.'SETMANINI2') THEN !MANUAL init CORRECTION - DO WHILE (WNDXLN(LPOFF)) !NEXT LOOP - CALL NCATEL(FCAOUT,SETS,HARAN(1),HARAN(2),SIFRS, - 1 PCGAN,PCPHS,F_T) !GET VALUES - CALL NCASTC - END DO - ELSE IF (OPTION.EQ.'SETMIFR') THEN !MULTIPLY CORRECTION - CALL NCASTY(COR_MUL) - ELSE IF (OPTION.EQ.'SETCOPY') THEN !COPY TEL CORRECTION - DO WHILE (WNDXLN(LPOFF)) !NEXT LOOP - CALL NCACLC(CSOL,CME) !MAKE AVERAGES - DO I3=0,1 !X,Y - DO I2=0,STHTEL-1 !EXTERNAL FORMAT - PCGAN(I2,I3)=EXP(RSOL(0,I2,I3)) !GAIN - PCPHS(I2,I3)=RSOL(1,I2,I3)*DEG !PHASE - END DO - END DO - CALL NCASTC !SET DATA - END DO - CALL WNFCL(FCAINP) - ELSE IF (OPTION.EQ.'SETICOPY') THEN !COPY MIFR CORRECTION - DO WHILE (WNDXLN(LPOFF)) !NEXT LOOP - CALL NCACIC(CISOL,CIME) !MAKE AVERAGES - I4=-1 - DO I1=0,STHTEL-1 - DO I2=I1,STHTEL-1 - I4=I4+1 !INDEX INPUT - IF (SIFRS(I1,I2)) THEN !SELECTED - DO I3=0,3 !POL - IFRCOR(I4,I3)=CISOL(I3,I4,0) !Only APPLY - END DO - END IF - END DO - END DO - CALL NCASTX(COR_MIFR) !SET DATA - END DO - CALL WNFCL(FCAINP) -C - ELSE IF (OPTION.EQ.'SETEXT') THEN !EXTINCTION - CALL NCASTX(COR_EXT) - ELSE IF (OPTION.EQ.'SETREF') THEN !REFRACTION - CALL NCASTX(COR_REF) - ELSE IF (OPTION.EQ.'SETFAR') THEN !FARADAY ROTATION - CALL NCASTX(COR_FAR) -C - ELSE IF (OPTION.EQ.'SETLINE') THEN !LINE CORRECTIONS - CALL NCASTL - ELSE IF (OPTION.EQ.'SETRENORM') THEN !RENORM CORRECTIONS - CALL NCASTN(JDONE) - ELSE IF (OPTION.EQ.'SETCCOPY') THEN !INTERPOLATE CALIB. CORRECTION - DO WHILE (WNDXLN(LPOFF)) ! - CALL NCACCP(CSOL,CME) !COPY CORRECTIONS - END DO - CALL WNFCL(FCAINP) -C - ELSE IF (OPTION.EQ.'SETIREFRAC') THEN !IONOS. REFRACTION - CALL NCASTX(COR_IRF) - ELSE IF (OPTION.EQ.'SETCLK') THEN !CLOCK CORRECTION - CALL NCASTX(COR_CLK) - ELSE IF (OPTION.EQ.'SETIFR') THEN !ADDITIVE IFR CORRECTION - CALL NCASTX(COR_AIFR) - ELSE IF (OPTION.EQ.'SETMIFR') THEN !MULTIPLICATIVE IFR CORRECTION - CALL NCASTX(COR_MIFR) -C - ELSE IF (OPTION.EQ.'SETPOLE') THEN !BASEL POLE - CALL NCASTY(COR_POLE) - ELSE IF (OPTION.EQ.'SETFREQ') THEN !FREQ. - CALL NCASTY(COR_FRQ) - ELSE IF (OPTION.EQ.'SETDX') THEN !DX - CALL NCASTY(COR_DX) - ELSE IF (OPTION.EQ.'SETDY') THEN !DY - CALL NCASTY(COR_DY) - ELSE IF (OPTION.EQ.'SETDZ') THEN !DZ - CALL NCASTY(COR_DZ) - ELSE IF (OPTION.EQ.'SETSHIFT') THEN !SHIFT - CALL NCASTS -C -C NCACLC calculates the average and ME of ln(gain) and phase. -C Shown here are (gain-1) and the mean error of ln(gain). For small errors, the C transformation between the two representatoions has little effect; for large -C errors, this rep[resentation is as good or bad a any other one. To do it -C more properly, one should either average gain itself rather than ln(gain), -C or show ln(gain) rather than (gain-1). -C - ELSE IF (OPT.EQ.'SHO') THEN !SHOW AVERAGE CORRECTION - DO WHILE (WNDXLN(LPOFF)) !NEXT LOOP - CALL NCACLC(CSOL,CME) !MAKE AVERAGES - CALL WNCTXT(F_P,'!/!Q1!7C!8$#AS',STHTEL,TELNMA(0)) !HEADING - DO I3=0,1 !X,Y - DO I2=0,STHTEL-1 !EXTERNAL FORMAT - PCGAN(I2,I3)=1000*(EXP(RSOL(0,I2,I3))-1) !GAIN % - PCPHS(I2,I3)=10*RSOL(1,I2,I3)*DEG !PHASE -CC RME(I2,0,I3)=10*REAL(CME(I2,I3))*(PCGAN(I2,I3)+100.) !M.E. GAIN - RME(I2,0,I3)=1000*REAL(CME(I2,I3)) - RME(I2,1,I3)=10*AIMAG(CME(I2,I3))*DEG !M.E. PHASE - END DO - CALL WNCTXT(F_TP, - 1 '!/!Q1!AS\g(.1%) !5$#E9.0!/!2C\(M.E.) !5$#E9.0', - 1 IPC(I3),STHTEL,PCGAN(0,I3),STHTEL,RME(0,0,I3)) - CALL WNCTXT(F_TP, - 1 '!Q1!AS\p(.1d) !5$#E9.0!/!2C\(M.E.) !5$#E9.0!/', - 1 IPC(I3),STHTEL,PCPHS(0,I3),STHTEL,RME(0,1,I3)) - END DO - CALL WNCTXT(F_P,' ') - END DO - - END IF - CALL WNFCL(FCAINP) - CALL WNFCL(FCAOUT) - GOTO 10 -C - END diff --git a/src/nscan/ncalib.psc b/src/nscan/ncalib.psc deleted file mode 100644 index d72729841cceb8cb3c2e5b7263cbb0d80045e86b..0000000000000000000000000000000000000000 --- a/src/nscan/ncalib.psc +++ /dev/null @@ -1,1394 +0,0 @@ -!+ NCALIB.PSC -! WNB 900306 -! -! Revisions: -! WNB 910612 Add loops -! WNB 910812 Add ALIGN -! WNB 910820 Add extinction, refraction, Faraday rotation -! WNB 910827 Add QDETAILS -! WNB 910828 Add RUN -! WNB 910909 Add DATAB and INFIX -! WNB 910913 New (de-)apply and loops -! WNB 910923 Add some polarisation info -! WNB 911003 Add VZERO_OPTION -! WNB 911007 Include instrum. pol. -! WNB 911009 Add RENORM SET option -! WNB 911230 NMODEL -! WNB 920626 Add DCLOW, change Rotation measure description -! WNB 921104 Text Select ifrs; HA range; J2000 -! WNB 921120 Change HA_INTEGRATION -! WNB 921201 Allow gain/phase separate zero -! WNB 921211 Make PSC -! WNB 921217 Add CCOPY -! JEN 930308 INCLUDE=NSETS_PEF, remove keyword SETS -! JEN 930312 INCLUDE=NCOMM_PEF -! JEN 930312 Remove keyword(s) SCAN_NODE -! JEN 930312 Remove keyword(s) SELECT_IFRS, POLARISATION, HA_RANGE -! HjV 930426 Change name keywords INPUT_SETS, INPUT_NODE -! WNB 930602 Add CLK; IREFRACT_FILE, CLOCK_CORR -! WNB 930603 Add BASEL_POLE, BASEL_DX, -DY, -DZ, FREQ_CORR -! WNB 930617 Add SHIFT SET option; SHIFT -! WNB 931123 Use CHECKS for complex loop also -! WNB 931126 Add COMPLEX_ONLY -! JPH 931201 Improve prompts for BASEL_*, FREQ_CORR -! WNB 931216 UNITS=M removed (not accepted anymore on atleast dw,cv) -! WNB 931221 UNITS=M back -! CMV 940223 Add DSHIFT for differential shifts -! CMV 940428 Add option INIT to SET_OPTION -! CMV 940429 Add option IFRA en IFRM to SET_OPTION, add missing -! options to ZERO, add and change some text -! JPH 940912 Conform to format requirements of doc_key -! Improve HELP texts -! Remove parentheses from prompt texts -! Remove SHOW_LEVEL 3, make 1,1 the default -! JPH 941020 OPTIONS formats. - Remove invalid NULL_VALUEs, -! WILD_CARDS -! JPH 941109 MDLNODE_PEF -! JPH 941116 NULL_VALUES back in FARADAY_FILE, IREFRACT_FILE -! JPH 941216 Some WILD_CARDS back. Remove all UNITS -! JPH 941219 Donot use / as option delimiter -! JPH 950124 Help texts -! CMV 940927 Reorganise SET options, add option SET OTH MULTIPLY -! CMV 950202 Restore above changes (removed by JPH) -! WNB 950614 Add SAVE_RESIDUALS -! WNB 950614 Change Complex loop count -! HjV 950623 Add option ICOPY for SET_OPTION (Copy MIFR-corrections) -! CMV 950725 Correct units for IREF -! CMV 951212 Change text for FARAD -! JPH 960513 Expand text for BASEL_DX, _DY, _DZ, _POLE -! JPH 960802 WGT_FACTOR -! JPH 970205 GAIN_NORM negative-values option -! WNB 080711 Add INVERT SET option -! WNB 081226 Add polarisation correction INVERT option -! -! -! Get overall action -! Ref: NCADAT -! -KEYWORD=OPTION - DATA_TYP=C - IO=I - LENGTH=12 - CHECKS=ABBREV_OPTIONS - SWITCHES=LOOP - SEARCH=L,P - PROMPT="Type of action" - OPTIONS= REDUNDANCY,POLAR,SET; SHOW; QUIT - HELP=" -Specify type of action to perform: -. - REDUNDANCY create telescope corrections by solving the - redundancy/align/selfcal equations - POLAR operations on polarisation corrections - SET operations on all other corrections -. - SHOW show (in logfile) average corrections in specified sector(s) - QUIT finish" -! -! Get polarisation action -! Ref: NCADAT -! -KEYWORD=POLAR_OPTION - DATA_TYP=C - IO=I - LENGTH=8 - CHECKS=ABBREV_OPTIONS - SWITCHES=LOOP - SEARCH=L,P - PROMPT="action on polarisation corrections|" - OPTIONS=- -CALC,VZERO; COPY,SET,ZERO,INVERT; SHOW,EDIT; QUIT - HELP=" -Specify action to perform on polarisation corrections: -. - Calculate corrections from calibrator visibilities. The new correction values - are ADDED to existing ones: -. - CALC calculate dipole corrections -. - VZERO select the set of operations dealing with the phase-zero - difference ('PZD') between the X and Y channel groups -. - Copy/set corrections. The new corrections values generally OVERWRITE the - existing ones: -. - COPY create dipole corrections in target sectors by copying them - from one source sector -. - SET set dipole corrections manually -. - ZERO zero dipole corrections -. - INVERT invert dipole corrections -. - Inspection: -. - SHOW show dipole corrections -. - EDIT edit dipole corrections -. - Other: -. - QUIT exit from POLAR" -! -! Get VZERO action -! Ref: NCADAT -! -KEYWORD=VZERO_OPTION - DATA_TYP=C - IO=I - LENGTH=8 - CHECKS=ABBREV_OPTIONS - SWITCHES=LOOP - SEARCH=L,P - PROMPT="VZERO action" - OPTIONS=CALC,COPY,MANUAL; SCAN,APPLY,ASK; QUIT - HELP=" -This branch of NCALIB implements methods to define the unknown X-Y phase-zero -difference ('PZD') in the parallel-dipole configuration. -. -Correction values may be saved in an arbitrary selection of target sectors, -selected by the SCN_<xxx> parameters. The new corrections are OTH telescope -phases which will be ADDED to any existing ones in each of the sectors you -specify for output. -. -In determining the corrections, the program uses a collection of input sectors, -which may coincide with the target sectors or be selected by the USE_SCN_ -parameters (for the COPY option). It is assumed that the source for these is a -calibrator with significant Stokes U and 'negligibly' small Stokes V. If this -condition is not fulfilled, the result will be meaningless. -. -The PZD is a phase value that is ADDED to the existing OTH phase correction of -the X channels. For this reason, you must be cautious to -. - - avoid more than one COPY to the same target data and - - avoid ruining a calibrator observation by doing an APPLY on it. (If - you should do this by accident, use MANUAL to restore the observation - to its previous state.) -. -Specify action to perform: -. - Actions recommended for routine use: -. - CALC calculate PZD from the selected node and sectors (SCN_ - parameters) and display it with its mean error. Use this option - to check if a calibrator observation is suitable for - determining the PZD. -. - COPY as APPLY, but use X-Y phase-difference value derived from - a calibrator observation (USE_SCN_<xxx> parameters). Use this - option to set the correction for your observations -. - MANUAL manually input phase-difference value -. - Other actions: -. - SCAN as CALC, but per individual scan -. - APPLY as CALC, then apply the correction to the sectors selected - (SCN_<xxx> parameters). - NOTE that once you have performed this operation, a CALC or COPY - operation on the same input data will yield PZD=0, so these - data can no longer be used to calibrate another observation. -. - ASK as APPLY, but display and ask for confirmation before modifying - the existing values -. - QUIT exit from VZERO " -! -! Get set action -! Ref: NCADAT -! -KEYWORD=SET_OPTION - DATA_TYP=C - IO=I - LENGTH=8 - CHECKS=ABBREV_OPTIONS - SWITCHES=LOOP - SEARCH=L,P - PROMPT="SET action|" - OPTIONS=- -QUIT; COPY,CCOPY,ICOPY,LINE; ZERO,MANUAL,INIT,RENORM,INVERT;| - -EXT,REF, IREF,FAR, IFR,MIFR; SHIFT, CLK, OTHER - HELP=" -Specify action to perform to alter correction values. -. - Note: POLARISATION corrections are NOT included here. They must be handled - sparately through the POLAR main option. -. -These option write correction values in (a) set(s) of target sectors (selected -by the SCN_<xxx> parameters). These corrections are copied/calulated from -corrections /data in the same file or another one (USE_SCN_<xxx> parameters). -The calculations will use all source sectors you specify to obtain a single set -of corrections. Unless stated otherwise below, the new values will be ADDED to -the existing ones in each of the target sectors. -. - Transfer of corrections from a reference source: -. - COPY copy all corrections from somewhere else - (all corrections in the input set(s) are averaged) - CCOPY copy corrections from surrounding (in time) observations - in the input sets with the same frequency channel - (corrections for the two input sets are averaged). - ICOPY copy all MIFR corrections from somewhere else - (all corrections in the input set(s) are averaged) - LINE copy all corrections from corresponding continuum channel -. - Initialisation: -. - ZERO zero corrections - MANUAL copy input values into the OTH telescope corrections for - selected scans - INIT make an initial estimate of telescope corrections and shift the - present values accordingly - RENORM renormalise telescope corrections - INVERT invert the signs of corrections. I.e. divide, rather - than multiply during application -. - Manual-input actions. Each option represents a correction type for which - your values will be requested. - - - For the following actions, your values will OVERWRITE the existing ones: - - EXT set extinction in selected scans - REF set refraction in selected scans - IREF set ionospheric refraction in selected scans - FAR set Faraday rotation in selected scans - IFR set additive interferometer corrections in selected scans - MIFR set multiplicative interferometer corrections in selected scans - CLK set clock correction in selected scans - SHIFT set (de-apply!) coordinate shift in selected sectors -. - QUIT exit SET " -! -! -! Get set action -! Ref: NCADAT -! -KEYWORD=OTH_OPTION - DATA_TYP=C - IO=I - LENGTH=6 - CHECKS=ABBREV_OPTIONS - SWITCHES=LOOP - SEARCH=L,P - OPTIONS=MULT,POLE,DX,DY,DZ,FREQ,QUIT - PROMPT="SET action (others)|" - HELP=" -Specify action to perform to ADD corrections into the OTHer telescope -corrections: - - MULT set an extra gain factor (multiply existing values) - DX add telescope X correction in selected scans - DY add telescope Y correction in selected scans - DZ add telescope Z correction in selected scans - POLE add baseline pole correction in selected scans - FREQ add frequency offset correction in selected scans -. - QUIT exit SET " -! -! Get input sets -! Ref: NCADAT -! -KEYWORD=USE_SCN_SETS - DATA_TYP=C - IO=I - LENGTH=32 - NVALUES=64 - SWITCHES=LOOP,NULL_VALUES,WILD_CARDS - SEARCH=L,P - PROMPT="Sets of input .SCN-file sectors: grp.obs.fld.chn.seq|" - HELP=" -Specify the .SCN-file sectors to be used as input in the calculations. " -! -! Should calibrators be copied with equal length? -! Ref: NCADAT -! -KEYWORD=CAL_EQUAL - DATA_TYP=L - IO=I - SEARCH=L,P - DEFAULT="NO /NOASK" - PROMPT="Copy with equal length?" - HELP=" -If YES, all calibrators specified with USE_SCN_SETS will be made of equal -length, that is: the number of HA scans used for each calibrator will be the -same (and equal to the smallest number available). -. -This is necessary when calibrators have frequencies that have been offset (plus -and minus respectively) to the observing frequency of the target source. " -! -!!! WHY??? -! -! -! Get scan node -! Ref: NCADAT -! -KEYWORD=USE_SCN_NODE - DATA_TYP=C - IO=I - LENGTH=80 - SWITCHES=LOOP,NULL_VALUES,WILD_CARDS - SEARCH=L,P - PROMPT="Input .SCN-file name" - HELP=" -Specify the input .SCN file from which the corrections should be calculated or -copied. A wildcard value ('*') indicates the same as the output .SCN file." -! -! Select model weight type -! Ref: NCADAT -! -KEYWORD=MWEIGHT_TYPE - DATA_TYP=C - IO=I - LENGTH=10 - CHECKS=ABBREV_OPTIONS - SWITCHES=LOOP,NULL_VALUES - SEARCH=L,P - PROMPT="Type of weight function|" - OPTIONS=- -STEP,ISTEP; GAUSSIAN,IGAUSSIAN; TRIANGLE,ITRIANGLE -! NCADAT saves last input as default for repeat - HELP=" -MWEIGHT_TYPE and MWEIGHT_DATA allow you to weigh baselines according to their -lengths, in order to take advantage of source characteristics that are a priori -known. The defaults for these parameters give all baselines the same weight. -. -This parameter selects the form of the weighting function; its position and -half-width will be defined by MWEIGHT_DATA. The following shapes can be chosen: -. - STEP a step function: 1 out to some radius, 0 beyond - GAUSSIAN a Gaussian - TRIANGLE a triangular function: linearly decreasing from 1 to 0 -. - Each of these can be prefixed with an 'I' to invert it, i.e. ISTEP means - '1 minus STEP' " -! -! Select model weight data -! Ref: NCADAT -! -KEYWORD=MWEIGHT_DATA - DATA_TYP=R - IO=I - SWITCH=LOOP,VECTOR,WILD_CARDS - NVALUES=2 - CHECKS=MINIMUM - MINIMUM=0,0 - SEARCH=L,P - PROMPT="Centre, halfwidth (metres)" -! NCADAT saves last input as default for repeat - HELP=" -Specify the centre and the halfpower-halfwidth in metres of the model weight -function to be applied. -. -Only positive values are accepted. Note that the function you define may extend -over negative baselines but actual baselines are positive by definition." -! -! Get align/selfcal type -! Ref: NCADAT -! -KEYWORD=ALIGN_OPTION - DATA_TYP=C - IO=I - LENGTH=8 - CHECKS=ABBREV_OPTIONS - SWITCHES=LOOP - SEARCH=L,P - PROMPT="Type of Selfcal desired" - OPTIONS=SELFCAL,ALIGN - HELP=" -Selfcal is the generic name for all methods that use a source model in -combination with your visibilities to estimate the telecope gain/phase -corrections. Since you have selected a model, NCALIB assumes that you want to -use it, by doing a Selfcal. (If you had not, it would propose a REDUNdancy-only -solution.) -. -The alternative you have here is to use the source model to recover the unknown -position shift that scans suffer when they are processed with the redundancy -constraints only (REDUN solution). In this operation the source model is only -used as a position reference. The telescope phases are shifted by an amount -that is a linear function of position along the array; the telescope gains do -not change at all. -. -To summarise, the choices you have are: -. - SELFCAL use the model to constrain in position a redundancy solution - that will be made now - ALIGN use the model to constrain a redundancy solution that was made - earlier " -! -! Force freedom? -! Ref: NCADAT -! -KEYWORD=FORCE_FREEDOM - DATA_TYP=L - IO=I - SWITCH=LOOP,VECTOR - NVALUES=2 - SEARCH=L,P - PROMPT=" Manual constraints for gain (1st value)|- -and phase (2nd value)? YES/NO" -! NCADAT saves last input as default for repeat - HELP=" -Specify if you want to force the constraint equations for the align solution. -If you reply NO, the program will determine them by itself from the -interferometers selected. -. -Your first reply refers to Gain, the second one to Phase." -! -! Select gain freedom -! Ref: NCADAT -! -KEYWORD=GAIN_FREEDOM - DATA_TYP=J - IO=I - SWITCH=LOOP,VECTOR,WILD_CARDS - NVALUES=14 - SEARCH=L,P - PROMPT="Gain grouping" - HELP=" -Define the telescope groups for which the gains will be solved independently. -. -To solve e.g. separate gains for the 10 fixed telescopes (0 through 9) and the - 4 movable ones (A through D), specify: -. - 1,1,1,1,1,1,1,1,1,1, 2,2,2,2 -. -* means one group containing all telescopes (i.e. 1,1,...,1,1). " -!! Is * equivalent to NO ? -! -! Select phase freedom -! Ref: NCADAT -! -KEYWORD=PHASE_FREEDOM - DATA_TYP=J - IO=I - SWITCH=LOOP,VECTOR - NVALUES=14 - SEARCH=L,P - PROMPT="Phase grouping" - HELP=" -Define the telescope groups for which the phases will be solved independently. -. -To solve e.g. separate gains for the 10 fixed telescopes (0 through 9) and the - 4 movable ones (A through D), specify: -. - 1,1,1,1,1,1,1,1,1,1, 2,2,2,2 -. -* means one group containing all telescopes (i.e. 1,1,...,1,1). Up to 14 groups -may be defined. " -!! Is * equivalent to NO ? -! -! Select gain telescopes -! Ref: NCADAT -! -KEYWORD=GAIN_NORM - DATA_TYP=J - IO=I - SWITCH=LOOP,WILD_CARDS - NVALUES=14 - SEARCH=L,P - PROMPT="Gain reference telescopes" - HELP=" -Define the telescopes to be used as reference for renormalising the telescope -gains. -. -Your reply should be an array of values (separated by commas) for telescopes 0 -through D; 1 means that you select the telescope, 0 that you don't. Trailing 0s -may be omitted. -. -A wildcard ('*') means 'all', i.e. 1,1,1,1,1,1,1,1,1,1,1,1,1,1 -. -Example: - 0,1,0,1,0 means 'use telescopes 1 and 3 as reference' -. -NOTES: -. -Renormalisation adjusts the gains so that the average for the fixed telescopes -selected equals that for the moving telescopes. If either group is absent from -yous selection, the average gain of the other group is made 0. -. -Consequently, proper gain renormalisation is possible only for the 'standard' -WSRT configuration: If there are any fixed-fixed or movable-movable -interferometers, a message will be given and the operation aborted. -. -You may, however, insist by putting a -1 instead of any of the 1s in your -reply. The renormalisation will then be performed as if the fixed-movable -interferometers were absent, and a warning given that the gain corrections for -those interferometers are jeopardized. -" -! -! Select phase telescopes -! Ref: NCADAT -! -KEYWORD=PHASE_NORM - DATA_TYP=J - IO=I - SWITCH=LOOP,WILD_CARDS - NVALUES=14 - SEARCH=L,P - PROMPT="Phase reference telescopes" - HELP=" -Define the telescopes to use as reference for renormalising the telescope -phases. -. -Your reply should be an array of values (separated by commas) for telescopes 0 -through D; 1 means that you select the telescope, 0 that you don't. Trailing 0s -may be omitted. -. -A wildcard ('*') means 'all', i.e. 1,1,1,1,1,1,1,1,1,1,1,1,1,1 -. -Example: - 0,1,0,1,0 means 'use telescopes 1 and 3 as reference" -! -! HA integration -! Ref: NCADAT -! -KEYWORD=HA_INTEGRATION - DATA_TYP=R - IO=I - SWITCH=LOOP,WILD_CARD - CHECKS=MAXIMUM - MAXIMUM=3600. - SEARCH=L,P - PROMPT="Integration time (sec)" - HELP=" -Specify the time interval over which you want to integrate (if possible) before -calibrating. The value you specify will be rounded down to a multiple of the -hour-angle interval between successive scans. -. -'*' and '0' mean do not integrate, i.e. calibrate per scan. -. -The largest value allowed is 3600 (= 1 hour). " -!! What happens if any point is missing? -!! UT/ST ?? -! -! Do we want to save Selfcal residuals? -! Ref: NCADAT -! -KEYWORD=SAVE_RESIDUALS - DATA_TYP=L - IO=I - SEARCH=L,P - DEFAULT="NO" - PROMPT="Save the interferometer residuals as interferometer errors?" - HELP=" -If YES, the interferometer residuals after Selfcal, Align or Redun will be -saved for later use as Multiplicative Interferometer errors. " -! -! -! Output level -! Ref: NCADAT -! -KEYWORD=SHOW_LEVEL - DATA_TYP=J - IO=I - NVALUES=2 - SWITCH=LOOP,VECTOR - CHECKS=MINIMUM,MAXIMUM - MINIMUM=0,0 - MAXIMUM=4,4 - SEARCH=L,P - DEFAULTS=1,1 /ASK - PROMPT="Levels of terminal (1st value)| and log (2nd value) output" - HELP=" -Specify the level of the type and print output you want: -. - 0 none - 1 sector numbers, errors and summary of results only (the summary in the - log file includes phase constraints and solution details which are not - shown on the terminal) - 2 detailed report (several pages!) per integration interval (parameter - HA_INTEGRATION) - intended primarily for debugging purposes " -! -! Get corrections to zero -! Ref: NSCSAZ -! -KEYWORD=ZERO - DATA_TYP=C - IO=I - LENGTH=8 - NVALUES=12 - CHECKS=ABBREV_OPTIONS - SWITCHES=WILD_CARDS - SEARCH=L,P - PROMPT="Corrections (plural) to be zeroed or inverted |" - OPTIONS=- -ALL,NONE; RED,ALG,OTH; IFR,MIFR; EXT,REF,IREF,FAR, CLK,SHIFT;| - -NOGAIN,NOPHASE| - DEFAULT=NONE - HELP=" -Specify any number of corrections you want to zero or invert: -. - Generic: - ALL or * All corrections - NONE None of the corrections: Return to previous prompt -. - Telescope gains and phases: - RED Redundancy telescope corrections - ALG Align telescope corrections - OTH 'Other' telescope gain/phase corrections -. - Interferometer gains and phases: - IFR Additive interferometer corrections - MIFR Multiplicative interferometer corrections -. - Corrections for the instrument as a whole: - EXT Extinction correction - REF Refraction correction - IREF Ionospheric refraction correction - FAR Faraday rotation - CLK Clock correction - SHIFT Coordinate shifts (de-apply!) -. -You may restrict the above to phase-only or gain-only by appending AT THE END -of your reply either of: -. - NOGAIN Zero only phases - NOPHASE Zero only gain" -! -! Get corrections -! Ref: NCADAT -! -KEYWORD=GAIN_X - DATA_TYP=R - IO=I - NVALUES=14 - SWITCHES=LOOP,VECTOR -! CHECKS=MAXIMUM,MINIMUM -! MAXIMUM=100,100,100,100,100,100,100,100,100,100,100,100,100,100 -! MINIMUM=.01,.01,.01,.01,.01,.01,.01,.01,.01,.01,.01,.01,.01,.01 - SEARCH=L,P - PROMPT="Gain corrections X (factors) |" - HELP=" -Specify the X gain corrections per telescope as factors (1= no change). -. -The values you give will be multiplied with the existing gain factors if you -choose SET option MULT, they will replace the existing factors if you choose -SET option MANUAL." -! -! Get corrections -! Ref: NCADAT -! -KEYWORD=GAIN_Y - DATA_TYP=R - IO=I - NVALUES=14 - SWITCHES=LOOP,VECTOR -! CHECKS=MAXIMUM,MINIMUM -! MAXIMUM=100,100,100,100,100,100,100,100,100,100,100,100,100,100 -! MINIMUM=.01,.01,.01,.01,.01,.01,.01,.01,.01,.01,.01,.01,.01,.01 - SEARCH=L,P - PROMPT="Gain corrections Y (factors) |" - HELP=" -Specify the Y gain corrections per telescope as factors (1= no change). -. -The values you give will be multiplied with the existing gain factors if you -choose SET option MULT, they will replace the existing factors if you choose -SET option MANUAL." -! -! Get corrections -! Ref: NCADAT -! -KEYWORD=PHASE_X - DATA_TYP=R - IO=I - NVALUES=14 - SWITCHES=LOOP,VECTOR - SEARCH=L,P - PROMPT="Phase corrections X (deg) |" - HELP=" -Specify the X phase corrections to be added per telescope (0 = no change). -. -The values you give will be added to the existing OTHer phases if you choose -SET option MULT, they will replace the existing phases if you choose SET option -MANUAL." -! -! Get corrections -! Ref: NCADAT -! -KEYWORD=PHASE_Y - DATA_TYP=R - IO=I - NVALUES=14 - SWITCHES=LOOP,VECTOR - SEARCH=L,P - PROMPT="Phase corrections Y (deg) |" - HELP=" -Specify the Y phase corrections to be added per telescope (0 = no change). -. -The values you give will be added to the existing OTHer phases if you choose -SET option MULT, they will replace the existing phases if you choose SET option -MANUAL." -! -!======================= IFR CORRECTIONS ========================== -! -! Get corrections -! Ref: NCADAT -! -KEYWORD=GAIN_XX - DATA_TYP=R - IO=I - NVALUES=1 - SWITCHES=LOOP - SEARCH=L,P - PROMPT="Interferometer gain corrections XX (factors) |" - HELP=" -Specify the gain corrections for XX as factors (1= no change). You will be -prompted for values, which will OVERWRITE the existing interferometer gain -corrections. " -! -KEYWORD=GAIN_XY - DATA_TYP=R - IO=I - NVALUES=1 - SWITCHES=LOOP - SEARCH=L,P - PROMPT="interferometer gain corrections XY (factors) |" - HELP=" -Specify the gain corrections for XY as factors (1= no change). You will be -prompted for values, which will OVERWRITE the existing interferometer gain -corrections. " -! -KEYWORD=GAIN_YX - DATA_TYP=R - IO=I - NVALUES=1 - SWITCHES=LOOP - SEARCH=L,P - PROMPT="interferometer gain corrections YX (factors) |" - HELP=" -Specify the gain corrections for YX as factors (1= no change). You will be -prompted for values, which will OVERWRITE the existing interferometer -corrections. " -! -KEYWORD=GAIN_YY - DATA_TYP=R - IO=I - NVALUES=1 - SWITCHES=LOOP - SEARCH=L,P - PROMPT="interferometer gain corrections YY (factors) |" - HELP=" -Specify the gain corrections for YY as factors (1= no change). You will be -prompted for values, which will OVERWRITE the existing interferometer -corrections. " -! -! Get corrections -! Ref: NCADAT -! -KEYWORD=PHASE_XX - DATA_TYP=R - IO=I - NVALUES=1 - SWITCHES=LOOP - SEARCH=L,P - PROMPT="interferometer phase corrections XX (deg) |" - HELP=" -Specify the phase corrections for XX. You will be prompted for values, which -will OVERWRITE the existing interferometer corrections. " -! -! Get corrections -! Ref: NCADAT -! -KEYWORD=PHASE_XY - DATA_TYP=R - IO=I - NVALUES=1 - SWITCHES=LOOP - SEARCH=L,P - PROMPT="interferometer phase corrections XY (deg) |" - HELP=" -Specify the phase corrections for XY. You will be prompted for values, which -will OVERWRITE the existing interferometer corrections. " -! -! Get corrections -! Ref: NCADAT -! -KEYWORD=PHASE_YX - DATA_TYP=R - IO=I - NVALUES=1 - SWITCHES=LOOP - SEARCH=L,P - PROMPT="interferometer phase corrections YX (deg) |" - HELP=" -Specify the phase corrections for YX. You will be prompted for values, which -will OVERWRITE the existing interferometer corrections. " -! -! Get corrections -! Ref: NCADAT -! -KEYWORD=PHASE_YY - DATA_TYP=R - IO=I - NVALUES=1 - SWITCHES=LOOP - SEARCH=L,P - PROMPT="interferometer phase corrections YY (deg) |" - HELP=" -Specify the phase corrections for YY. You will be prompted for values, which -will OVERWRITE the existing interferometer corrections. " -! -! Get corrections -! Ref: NCADAT -! -KEYWORD=IFR_XX - DATA_TYP=R - IO=I - NVALUES=2 - SWITCHES=LOOP,VECTOR - SEARCH=L,P - PROMPT="additive interferometer corrections cos,sin XX (W.U.) |" - HELP=" -Specify the additive interferometer corrections for XX in Westerbork Units -(W.U.). The values you specify will OVERWRITE any existing values." -! -KEYWORD=IFR_XY - DATA_TYP=R - IO=I - NVALUES=2 - SWITCHES=LOOP,VECTOR - SEARCH=L,P - PROMPT="additive interferometer corrections cos,sin XY (W.U.) |" - HELP=" -Specify the additive interferometer corrections for XY in Westerbork Units -(W.U.). The values you specify will OVERWRITE any existing values." -! -KEYWORD=IFR_YX - DATA_TYP=R - IO=I - NVALUES=2 - SWITCHES=LOOP,VECTOR - SEARCH=L,P - PROMPT="additive interferometer corrections cos,sin YX (W.U.) |" - HELP=" -Specify the additive interferometer corrections for YX in Westerbork Units -(W.U.). The values you specify will OVERWRITE any existing values." -! -KEYWORD=IFR_YY - DATA_TYP=R - IO=I - NVALUES=2 - SWITCHES=LOOP,VECTOR - SEARCH=L,P - PROMPT="additive interferometer corrections cos,sin YY (W.U.) |" - HELP=" -Specify the additive interferometer corrections for YY in Westerbork Units -(W.U.). The values you specify will OVERWRITE any existing values." -! -! Get extinction coefficient -! Ref: NCADAT -! -KEYWORD=EXTINCTION - DATA_TYP=R - IO=I - SWITCH=LOOP,VECTOR - NVALUES=3 - SEARCH=L,P - DEFAULT=.00557,.00461,-.000544 - PROMPT="Extinction-1: quadratic's coefficients|" - HELP=" -Specify the coefficients A, B and C in the quadratic representation of the -zenith extinction oefficient as a function of frequency F in GHz: -. - EXT= (1+A) + B*F +C*F*F" -! -! Get refraction coefficient -! Ref: NCADAT -! -KEYWORD=REFRACTION - DATA_TYP=R - IO=I - SWITCH=LOOP,VECTOR - NVALUES=3 - SEARCH=L,P - DEFAULT=.00031,0.,0. - PROMPT="Refraction-1: quadratic's coefficients|" - HELP=" -Specify the coefficients A, B and C in the quadratic representation of the -refraction coefficient as a function of frequency F in GHz: -. - EXT= (1+A) + B*F +C*F*F" -! -! Get clock correction -! Ref: NCADAT -! -KEYWORD=CLOCK_CORR - DATA_TYP=R - IO=I - SWITCH=LOOP - NVALUES=1 - SEARCH=L,P - PROMPT="Clock correction (sec)" - HELP=" -Specify the clock correction in seconds to be applied to data. The new value -will be ADDED to the existing one." -! -! Get baseline-pole correction -! Ref: NCADAT -! -KEYWORD=BASEL_POLE - DATA_TYP=R - IO=I - SWITCH=LOOP - NVALUES=1 - SEARCH=L,P - PROMPT=- -"Increment to baseline-pole declination correction (deg) |" - HELP=" -Specify the baseline-pole declination correction in degrees. -. -The correction will be added as an HA-dependent phase to the OTH telescope -corrections. It can only be undone by either zeroing the entire OTH corrections -by means of the SET ZERO option (which will destroy whatever other corrections -have been stored there), or by inserting the same BASEL_POLE value with -opposite sign.. -. -The default value 0 leaves the corrections unchanged." -! -! Get frequency correction -! Ref: NCADAT -! -KEYWORD=FREQ_CORR - DATA_TYP=R - IO=I - SWITCH=LOOP - NVALUES=1 - SEARCH=L,P - PROMPT="Increment to frequency correction (MHz)" - HELP=" -Specify the 'frequency correction' in MHz. -. -This is an idiosyncratic way of representing a correction to the metric scale -of the interferometer array: A scale correction with a factor (1+x) is -represented by correcting the nominal observing frequency F with an additive -term -x.F. -. -Clearly this does not represent a real frequency shift since the observing -frequency is precisely defined by the settings of local-oscillator frequencies -and fringe-stopping parameters during the observation. -. -The correction will be ADDED as an hour-angle-dependent phase to the OTH -telescope corrections, and can only be undone by either zeroing these -corrections, or inserting the same BASEL_POLE value with opposite sign. " -! -! Get baseline X correction -! Ref: NCADAT -! -KEYWORD=BASEL_DX - DATA_TYP=R - IO=I - NVALUES=14 - SWITCHES=LOOP,VECTOR - SEARCH=L,P - PROMPT="Increments to telescope X positions (mm) |" - HELP=" -Specify the X telescope corrections in mm, one value per telescope. -. -The correction will be added as an HA-dependent phase to the OTH telescope -corrections. It can only be undone by either zeroing the entire OTH corrections -by means of the SET ZERO option (which will destroy whatever other corrections -have been stored there), or by inserting the same BASEL_DX value with opposite -sign. -. -The default value 0,0,...0,0 leaves the corrections unchanged." -! -! Get baseline Y correction -! Ref: NCADAT -! -KEYWORD=BASEL_DY - DATA_TYP=R - IO=I - NVALUES=14 - SWITCHES=LOOP,VECTOR - SEARCH=L,P - PROMPT="Increments to telescope Y positions (mm) |" - HELP=" -Specify 14 Y telescope corrections in mm, one value per telescope. -. -The correction will be added as an HA-dependent phase to the OTH telescope -corrections. It can only be undone by either zeroing the entire OTH corrections -by means of the SET ZERO option (which will destroy whatever other corrections -have been stored there), or by inserting the same BASEL_DY value with opposite -sign. -. -The default value 0,0,...0,0 leaves the corrections unchanged." -! -! Get baseline Z correction -! Ref: NCADAT -! -KEYWORD=BASEL_DZ - DATA_TYP=R - IO=I - NVALUES=14 - SWITCHES=LOOP,VECTOR - SEARCH=L,P - PROMPT="increments to telescope Z positions (mm) |" - HELP=" -Specify the Z telescope corrections in mm, one value per telescope. -. -The correction will be added as an HA-dependent phase to the OTH telescope -corrections. It can only be undone by either zeroing the entire OTH corrections -by means of the SET ZERO option (which will destroy whatever other corrections -have been stored there), or by inserting the same BASEL_DZ value with opposite -sign. -. -The default value 0,0,...0,0 leaves the corrections unchanged." -! -! Get l,m shifts -! Ref: NCADAT -! -KEYWORD=SHIFT - DATA_TYP=R - IO=I - NVALUES=2 - SWITCHES=LOOP,VECTOR - SEARCH=L,P - PROMPT="Shift to de-apply to data (arcsec)" - HELP=" -Specify the l,m shift in arcsec to be applied to data whenever the DE_APPLY -SHIFT correction is requested. (Ignore the 'de-apply) in the prompt.) -. -In the case where the shift is time-dependent (e.g. for a planet) it is -approximated by a linear function -. - Total shift = SHIFT + DSHIFT * (HA-HAB) -. -In this case the SHIFT you specify here is the value at the meridian, DSHIFT is -a second parameter for which you will be prompted. -! \whichref{}{} -!! HA-HAB or just HA? -" -! -! Get l,m differential shifts -! Ref: NCADAT -! -KEYWORD=DSHIFT - DATA_TYP=R - IO=I - NVALUES=2 - SWITCHES=LOOP,VECTOR - SEARCH=L,P - PROMPT="Shift rate (dl/dt, dm/dt, arcsec/day)" - HELP=" -Specify the SHIFT rate in arcsec per sidereal day to be applied to the data -whenever the DE_APPLY SHIFT correction is requested. -. -This parameter is used for a first-order approximation to the proper motion of -a solar-system object through the formula: -. - Total shift = SHIFT + DSHIFT * (HA-HAB) -. -where hour angles are measured as fractions of a full circle and HAB is the -starting HA of the sector. -! \whichref{}{}. -" -! -! Faraday rotation -! Ref: NCADAT -! -KEYWORD=FARADAY_FILE - DATA_TYP=C - IO=I - LEN=160 - SWITCH=LOOP,NULL_VALUES - SEARCH=L,P - PROMPT="Faraday-rotation data file" - HELP=" -Specify the name of a file with Faraday rotation data. The file must be an -ASCII file with lines -. - <hour angle in degrees>, <faraday rotation in degrees at 1GHz> -. -The file will be used to calculate Faraday rotation values for each scan by -interpolation between the values in this file and scaling to the observing -frequency. The calculated values will be stored in the scans as corrections. " -! Ionospheric refraction -! Ref: NCADAT -! -KEYWORD=IREFRACT_FILE - DATA_TYP=C - IO=I - LEN=160 - SWITCH=LOOP,NULL_VALUES - SEARCH=L,P - PROMPT="Ionospheric refraction data file" - HELP=" -Specify the name of a file with ionospheric refraction data. The file must be -an ASCII file with lines -. - <hour angle in degrees>, <refraction in degrees/km at 1GHz> -. -The file will be used to calculate ionospheric refraction for each scan by -interpolation between the values in this file and scaling to the observing -frequency. The calculated values will be stored in the scans as corrections. " -! -! Dipole position -! Ref: NCAPOL -! -KEYWORD=POL_ROTAN - DATA_TYP=R - IO=I - NVALUES=14 - SWITCH=LOOP,VECTOR - SEARCH=L,P - PROMPT="Dipole positions (deg)|" - HELP=" -Specify the position angles of the dual-dipole assemblies per telescope in -degrees." -! -! Dipole orthogonality -! Ref: NCAPOL -! -KEYWORD=POL_ORTHOG - DATA_TYP=R - IO=I - NVALUES=14 - SWITCH=LOOP,VECTOR - SEARCH=L,P - PROMPT="Dipole orthogonalities (deg)|" - HELP=" -Specify the deviations from orthogonality in the dual-dipole assemblies per -telescope in degrees." -! -! Dipole ellipticity (X) -! Ref: NCAPOL -! -KEYWORD=POL_X_ELLIPS - DATA_TYP=R - IO=I - NVALUES=14 - SWITCH=LOOP,VECTOR - SEARCH=L,P - PROMPT="X-dipole ellipticities (%)|" - HELP=" -Specify the X-dipole ellipticities per telescope in %." -! -! Dipole ellipticity (Y) -! Ref: NCAPOL -! -KEYWORD=POL_Y_ELLIPS - DATA_TYP=R - IO=I - NVALUES=14 - SWITCH=LOOP,VECTOR - SEARCH=L,P - PROMPT="Y-dipole ellipticities (%)|" - HELP=" -Specify the Y-dipole ellipticities per telescope in %." -! -! Get X-Y phase difference -! Ref: NCAPVZ -! -KEYWORD=VZERO_PHASE - DATA_TYP=R - IO=I - SWITCH=LOOP - SEARCH=L,P - PROMPT="X-Y phase-zero difference 'PZD' (deg)" - HELP=" -Specify the 'phase-zero difference' (PZD) in degrees. -. -In the parallel-dipole configuration, performing a Redundancy or Selfcal fit of -telescope errors to the visibilities introduces an unknown phase offset for the -set of telescope X channels and another unknown phase offset for the Y dipoles. -For correctly determining Stokes U and V, the (equally unknown) difference -between these must be corrected for. -. -This is a tricky problem and you should remain suspicious of the results that -you get. " -!! Sort this out -! -! Specify details wanted -! Ref: NCADAT -! -KEYWORD=QDETAILS - DATA_TYP=L - IO=I - SWITCH=NULL_VALUES - SEARCH=L,P - PROMPT="More details? (YES/NO)" - HELP=" -Specify if you want to specify details of the solution procedure yourself -rather than relying on NCALIB's expert defaults." -! -! Baseline deviation check -! Ref: NCADAT -! -KEYWORD=BASEL_CHECK - DATA_TYP=R - IO=I - CHECKS=MINIMUM,MAXIMUM - MINIMUM=.001 - MAXIMUM=10. - DEFAULTS=.5 -!! UNITS=M - SEARCH=L,P - PROMPT="Redundant-baseline difference allowed (metres)" - HELP=" -Specify the maximum difference between baselines for them still to be -considered identical in Redundancy calculations. " -! -! Minimum allowable weight -! Ref: NCADAT -! -KEYWORD=WEIGHT_MIN - DATA_TYP=R - IO=I - CHECKS=MINIMUM,MAXIMUM - MAXIMUM=1. - MINIMUM=0. - DEFAULTS=0.01 - SEARCH=L,P - PROMPT="Relative minimum weight accepted" - HELP=" -Specify the minimum relative weight of a data point that is still acceptable. -. -The weight is relative to the maximum weight in the same scan, and in most -cases can be seen as the minimum data amplitude accepted as fraction of the -maximum in the scan." -! -! Force phase zero -! Ref: NCADAT -! -KEYWORD=FORCE_PHASE - DATA_TYP=R - IO=I - NVALUES=14 - SWITCH=VECTOR - SEARCH=L,P - DEFAULTS=0,0,0,0,0,0,0,0,0,0,0,0,0,0 - PROMPT="Define phase-zeroes" - HELP=" -Define initial phase zeros per telescope. -. -This is useful for pathological cases where NCALIB on its own cannot correctly -resolve the 360-deg phase ambiguities. " -! -! Continuity in solution -! Ref: NCADAT -! -KEYWORD=CONTINUITY - DATA_TYP=L - IO=I - SEARCH=L,P - DEFAULTS=YES - PROMPT="Continuity in solution (YES/NO)?" - HELP=" -Specify if you want continuity in gain solution. If not, the initial guess for -the solution will be 0 (gain) and the forced phases (phase), else the solution -found in a previous scan. " -! -! Continuity in solution -! Ref: NCADAT -! -KEYWORD=FLW_FACTOR - DATA_TYP=R - IO=I - SEARCH=L,P - DEFAULTS=1 - PROMPT="Weight for points flagged with WGT flag" - HELP=" -The WGT flag directs NCALIB to multiply the data weight with an additional -weighing factor. -. -You may use this feature to reduce the weight of data affected by interference -without rejecting it completely. The effect of this in a Selfcal solution is -that it prevents the interference from bad interferometers to infect the -healthy ones. -. -A value of 1 will give all interferometers the weight they have in the .SCN -file. " -! -! Select solution type -! Ref: NCADAT -! -KEYWORD=SOLVE - DATA_TYP=L - IO=I - NVALUES=2 - SWITCH=VECTOR - SEARCH=L,P - DEFAULTS=YES,YES - PROMPT="Solve for gain, phase (YES/NO, 2 values)?" - HELP=" -Specify if you want solutions for gain and for phase." -! -! Complex solution -! Ref: NCADAT -! -KEYWORD=COMPLEX - DATA_TYP=L - IO=I - SEARCH=L,P - DEFAULTS=YES - PROMPT="Complex solution (YES/NO)?" - HELP=" -Specify if you want a complex solution of gains-plus-phases." -! -! Complex solution only -! Ref: NCADAT -! -KEYWORD=COMPLEX_ONLY - DATA_TYP=L - IO=I - SEARCH=L,P - DEFAULTS=NO - PROMPT="Complex solution only (YES/NO)?" - HELP=" -Specify if you want ONLY a complex solution. -. -Note: will only work if an initial guess for the gains (e.g. from a calibrator) -has been specified " -! -! Check deviations -! Ref: NCADAT -! -KEYWORD=CHECKS - DATA_TYP=R - IO=I - NVALUES=3 - SWITCH=VECTOR - CHECKS=MINIMUM,MAXIMUM - MINIMUM=5,1E-6,1. - MAXIMUM=50.,1.,20. - DEFAULTS=20,1E-3,3 - SEARCH=L,P - PROMPT="Iterations, gain deviation, relative mean error: 3 values|" - HELP=" -Specify: -. - - the maximum number of iterations in the complex solution; -. - - the relative allowable gain deviation for successive complex solutions; -. - - the mean error allowed per scan, relative to the average mean error - for all scans already solved." -! -! "Channel Zero" for LINE option -! Ref: NCADAT -! -KEYWORD=CALCHAN - DATA_TYP=J - IO=I - NVALUES=1 - SWITCH=LOOP - CHECKS=MINIMUM - MINIMUM=0 - SEARCH=L,P - DEFAULTS=1,1 /ASK - PROMPT="Channel to take calibration from (Channel Zero)" - HELP=" -Enter the number of the channel to take calibration data from. -Typically this is channel 0: the average channel for line datasets" -!- -INCLUDE=NGEN_PEF -!- -INCLUDE=SCNNODE_PEF ! -INCLUDE=SCNSETS_PEF ! -INCLUDE=SELECT_PEF -!- -INCLUDE=MDLNODE_PEF ! -INCLUDE=NMODEL_PEF -!- diff --git a/src/nscan/ncapol.for b/src/nscan/ncapol.for deleted file mode 100644 index 61a764dcf89c8dbf7c45d0307a0d69b541452a33..0000000000000000000000000000000000000000 --- a/src/nscan/ncapol.for +++ /dev/null @@ -1,679 +0,0 @@ -C+ NCAPOL.FOR -C WNB 910421 -C -C Revisions: -C WNB 911209 Correct ifrs selection -C WNB 921104 Full HA range -C HjV 930311 Change some text -C WNB 930825 Add dipole position -C WNB 930826 New redundant baselines -C WNB 930901 Change to full solution -C CMV 930907 Changed array indices to solve SHOW/COPY problem -C JPH 940809 Left-justify mean errors in Position and Ellipticity -C output. -C Correct width (was 81). -C Reduced scan-reading output -C JPH 940831 Improve scan-read reporting throughout -C JPH 940926 MOD(NDONE,50) --> ...,100). Typo. -C JPH 940927 NCAPOL: Report absence of data. Correct set name in -C progress reporting. -C Improve reporting of NCAPOL results -C JPH 941215 Init NDONE on entry of NCAPOT -C WNB 950611 Change to WNML routines for least squares -C JPH 960625 Narrower format for constraints output -C JPH 960627 Suppress constraints output -C JPH 970123 Include HA in "No valid data" report -C WNB 081226 Add NCAPOI: invert corrections -C -C - SUBROUTINE NCAPOL -C -C Calculate polarisation corrections -C -C Result: -C -C CALL NCAPOL will calculate the polarisation corrections -C CALL NCAPOZ will zero the polarisation corrections -C CALL NCAPOS will show the polarisation corrections -C CALL NCAPOT will set the polarisation corrections manually -C CALL NCAPOE will edit the polarisation corrections manually -C CALL NCAPOC will copy the polarisation corrections -C CALL NCAPOI will invert the polarisation corrections -C -C PIN reference: -C -C POL_ROTAN -C POL_ORTHOG -C POL_X_ELLIPS -C POL_Y_ELLIPS -C -C Include files: -C - INCLUDE 'WNG_DEF' - INCLUDE 'CBITS_DEF' - INCLUDE 'LSQ_O_DEF' - INCLUDE 'STH_O_DEF' !SET HEADER - INCLUDE 'SCH_O_DEF' !SCAN HEADER - INCLUDE 'NCA_DEF' -C -C Parameters: -C - INTEGER V_MI !FOR IV - PARAMETER (V_MI=V_M+IMAG_P) -C -C Arguments: -C -C -C Function references: -C - LOGICAL WNFRD !READ DISK - LOGICAL WNFWR !WRITE DATA - CHARACTER*32 WNTTSG !MAKE SUB-GROUP NAME - LOGICAL WNDPAR !USER PARAMETER - LOGICAL WNMLGA !GET LSQ AREA - LOGICAL NSCSTG,NSCSTL !GET A SET - LOGICAL NSCSIF !READ IFR TABLE - LOGICAL NSCSCR !READ DATA FROM SCAN -C -C Data declarations: -C - CHARACTER*16 TXT ! message text - INTEGER NDAT ! valid-data counter - INTEGER SETNAM(0:7) !FULL SET NAME - INTEGER CSTNAM(0:7) !CHECK SET NAME - DATA CSTNAM/8*-1/ - INTEGER*2 IFRT(0:STHIFR-1) !INTERFEROMETER TABLE - INTEGER IFRA(0:1,0:STHIFR-1) - REAL ANG(0:2,0:STHIFR-1) - REAL BASEL(0:STHIFR-1) !BASELINE TABLE - REAL WGT(0:STHIFR-1,0:3) !DATA WEIGHTS XX,XY,YX,YY - REAL DAT(0:1,0:STHIFR-1,0:3) !DATA XX,XY,YX,YY - COMPLEX DATC(0:STHIFR-1,0:3) - EQUIVALENCE (DAT,DATC) - COMPLEX ODATC(0:STHIFR-1,0:3) !DATA IQUV - INTEGER APDAT(0:STHIFR-1) !FOUND INDICATOR - INTEGER PTYP(0:2) !POLARISATION WANTED - DATA PTYP/I_M,V_MI,U_M/ - REAL HA !HA OF SCAN - INTEGER NDONE !scan counter for reporting - COMPLEX CI !I - COMPLEX CCF(0:2*STHTEL-1) !COEFFICIENTS - INTEGER NDEG !DEGENERACY - INTEGER MAR !MATRIX AREA - REAL SOL(0:1,0:2*STHTEL-1) !SOLUTION REAL/IMAG - COMPLEX CSOL(0:1,0:STHTEL-1) !X/Y - REAL SSOL(0:1,0:1,0:STHTEL-1) !Gain:Phase,X:Y,Telescopes - EQUIVALENCE (SOL,SSOL,CSOL) - REAL CEQ(0:4*STHTEL-1,0:4*STHTEL-1) !CONSTRAINT EQUATIONS GAIN/PHASE - REAL MU,SD !ADJUSTMENT ERROR GAIN/PHASE - REAL ME(0:1,0:1,0:STHTEL-1) !M.E. REAL/IMAG, X/Y - COMPLEX CME(0:1,0:STHTEL-1) - EQUIVALENCE (ME,CME) - INTEGER STHP !POINTER TO SET HEADER - CHARACTER*16 TELNAM !TEL. NAMES - CHARACTER*1 TELNMA(0:15) - EQUIVALENCE (TELNAM,TELNMA) - DATA TELNAM/'0123456789ABCDEF'/ - BYTE STH(0:STHHDL-1) !SET HEADER - INTEGER*2 STHI(0:STHHDL/2-1) - INTEGER STHJ(0:STHHDL/4-1) - REAL STHE(0:STHHDL/4-1) - REAL*8 STHD(0:STHHDL/8-1) - EQUIVALENCE(STH,STHI,STHJ,STHE,STHD) - BYTE SCH(0:SCHHDL-1) !SCAN HEADER - INTEGER*2 SCHI(0:SCHHDL/2-1) - INTEGER SCHJ(0:SCHHDL/4-1) - REAL SCHE(0:SCHHDL/4-1) - REAL*8 SCHD(0:SCHHDL/8-1) - EQUIVALENCE(SCH,SCHI,SCHJ,SCHE,SCHD) -C- -C -C INIT -C - IF (.NOT.WNMLGA(MAR,LSQ_T_COMPLEX,2*STHTEL)) THEN !MATRIX AREA - CALL WNCTXT(F_TP,'ERROR: Cannot obtain solution area') - GOTO 70 - END IF -C -C DO SETS - NOTE: The loop control (WNDXLN) is in the calling routine NCALIB! -C - NDONE=0 - DO WHILE(NSCSTL(FCAOUT,SETS,STH(0),STHP,SETNAM,LPOFF)) !NEXT SET -C -C Save first sector name -C - IF (NDONE.EQ.0) THEN - DO I2=0,7 - CSTNAM(I2)=SETNAM(I2) - END DO - ENDIF -C -C GET IFR TABLES -C - IF (STHI(STH_PLN_I).NE.4) THEN !CANNOT USE - CALL WNCTXT(F_TP,'Sector !AS has only !UI polarisations', - 1 WNTTSG(SETNAM,0),STHI(STH_PLN_I)) - GOTO 20 !NEXT SET - END IF - IF (.NOT.NSCSIF(FCAOUT,STH,IFRT,IFRA,ANG)) THEN !READ IFR TABLE - CALL WNCTXT(F_TP,'!/Error reading IFR table !AS', - 1 WNTTSG(SETNAM,0)) - GOTO 20 !TRY NEXT SET - END IF - CALL NSCMBL(STHE(STH_RTP_E),STHJ(STH_NIFR_J),IFRT, - 1 SIFRS,BASEL) !MAKE BASEL. -C -C DO SCANS -C - DO I=0,STHJ(STH_SCN_J)-1 !ALL SCANS -C -C INIT -C - HA=STHE(STH_HAB_E)+I*STHE(STH_HAI_E) !HA OF SCAN - IF (HA.LT.HARAN(1) .OR. HA.GT.HARAN(2)) GOTO 30 !FORGET -C -C GET DATA -C - IF (.NOT.NSCSCR(FCAOUT,STH,IFRT,I,CORAP,CORDAP, - 1 SCH,WGT,DAT)) THEN !READ SCAN DATA - CALL WNCTXT(F_TP,'!7$EAF7.2 Error reading scan data',HA) - GOTO 20 !TRY NEXT SET - END IF - DO I1=0,STHJ(STH_NIFR_J)-1 !ALL IFRS - APDAT(I1)=1 !ASSUME PRESENT - END DO - CALL NMOCXX(STHJ,SCHE,ANG,WGT,APDAT,DATC,ODATC,3,PTYP) !MAKE I,IV,U - NDAT=0 - DO I1=0,STHJ(STH_NIFR_J)-1 !ALL IFRS - IF (APDAT(I1).NE.0 .AND. - 1 BASEL(I1).GE.0) THEN !PRESENT, SELECTED - IF (ABS(ODATC(I1,0)).GT.0) THEN !I OK - NDAT=NDAT+1 - DO I2=0,2*STHTEL-1 !COEFF. - CCF(I2)=0 - END DO - CCF(2*IFRA(0,I1))=CMPLX(1.,-1.) !DXW - CCF(2*IFRA(1,I1)+1)=CMPLX(-1.,-1.) !DYE -cc CALL WNMLMN(MAR,LSQ_C_REAL,CCF,1., -cc 1 (DATC(I1,1)+ODATC(I1,2))/ODATC(I1,0)) !XY+U - CALL WNMLMN(MAR,LSQ_C_REAL,CCF,1., - 1 (DATC(I1,1))/ODATC(I1,0)) !XY - CCF(2*IFRA(0,I1))=0 !DXW - CCF(2*IFRA(1,I1)+1)=0 !DYE - CCF(2*IFRA(0,I1)+1)=CMPLX(1.,-1.) !DYW - CCF(2*IFRA(1,I1))=CMPLX(-1.,-1.) !DXE -cc CALL WNMLMN(MAR,LSQ_C_REAL,CCF,1., -cc 1 (DATC(I1,2)-ODATC(I1,2))/ODATC(I1,0)) !YX-U - CALL WNMLMN(MAR,LSQ_C_REAL,CCF,1., - 1 (DATC(I1,2))/ODATC(I1,0)) !YX - END IF - END IF - END DO - IF (NDAT.EQ.0) THEN - CALL WNCTXT(F_TP,'!AS !7$EAF7.2: No valid data in scan', - 1 WNTTSG(SETNAM,0),SCHE(SCH_HA_E)) - ELSE - NDONE=NDONE+1 - ENDIF -C -C NEXT SCAN -C - 30 CONTINUE - IF (MOD(NDONE,100) .EQ.0) - 1 CALL WNCTXT(F_T,'Now in sector !AS: !UJ valid scans read', - 1 WNTTSG(SETNAM,0), NDONE) - END DO !END SCANS -C -C NEXT SEctor -C - 20 CONTINUE - END DO !END SETS -C -C MAKE SOLUTION -C - CALL WNMLID(MAR) !FIX MISSING TEL. - CALL WNMLTR(MAR,NDEG) !DECOMP + RANK - CALL WNMLSN(MAR,CSOL,MU,SD) !GET SOLUTION - CALL WNMLGC(MAR,J,CEQ) !GET CONSTRAINTS - CALL WNMLME(MAR,CME) !GET M.E. -CC CALL WNCTXT(F_P,'!/(X,Y) constraints:') -CC DO I1=0,J-1 !SHOW CONSTRAINTS -CC CALL WNCTXT(F_P,'!79$5Q1!5C!3$#E7.0', -CC 1 4*STHTEL,CEQ(0,I1)) -CC END DO -C -C SAVE SOLUTION -C - DO WHILE(NSCSTL(FCAOUT,SETS,STH(0),STHP,SETNAM,LPOFF)) !NEXT SET - DO I=0,1 !GAIN/PHASE - DO I1=0,STHTEL-1 !TEL. - DO I2=0,1 !X,Y - IF (IAND(CORAP,256).EQ.0) THEN !NOT APPLIED BEFORE - STHE(STH_POLC_E+I+2*I1+2*STHTEL*I2)= - 1 SSOL(I,I2,I1)/PI2 !SAVE CORRECTIONS - ELSE !ADD CORRECTIONS - STHE(STH_POLC_E+I+2*I1+2*STHTEL*I2)= - 1 STHE(STH_POLC_E+I+2*I1+2*STHTEL*I2)+ - 1 SSOL(I,I2,I1)/PI2 !SAVE CORRECTIONS - END IF - END DO - END DO - END DO - IF (.NOT.WNFWR(FCAOUT,STHHDL,STH,STHP)) THEN !WRITE CORRECTIONS - CALL WNCTXT(F_TP,'Error saving corrections in set !AS', - 1 WNTTSG(SETNAM,0)) - END IF - END DO !END SET -C -C SHOW SOLUTION -C - CALL WNCTXT(F_TP,'Sectors !AS-!AS: !UJ valid scans', - 1 WNTTSG(CSTNAM,0),WNTTSG(SETNAM,0),NDONE) - CALL WNCTXT(F_TP, - 1 'Incremental corrections, being added to existing ones!/'// - 1 'Tel.!14C\Pos. angle!43C\Ellipticity!65C\Rotatn Orthog.!/'// - 1 '!10C\X(%)!25C\Y(%)!40C\X(%)!55C\Y(%)!67C\(deg) (deg)') - DO I=0,STHTEL-1 !ALL TELESCOPES - CALL WNCTXT(F_TP,'!AS !7$E7.2(!-4$E4.2) !7$E7.2(!-4$E4.2)'// - 1 ' !7$E7.2(!-4$E4.2) !7$E7.2(!-4$E4.2)'// - 1 ' !7$E7.2 !7$E7.2', - 1 TELNMA(I), - 1 100.*SSOL(0,0,I),100.*ME(0,0,I), - 1 100.*SSOL(0,1,I),100.*ME(0,1,I), - 1 100.*SSOL(1,0,I),100.*ME(1,0,I), - 1 100.*SSOL(1,1,I),100.*ME(1,1,I), - 1 (SSOL(0,0,I)+SSOL(0,1,I))*180./PI2, - 1 (SSOL(0,1,I)-SSOL(0,0,I))*360./PI2) - END DO - CALL WNCTXT(F_TP,' ') -C -C READY -C - CALL WNMLFA(MAR) !FREE MATRICES -C - 40 CONTINUE - RETURN !READY -C -C ZERO CORRECTIONS -C - ENTRY NCAPOZ -C -C ZERO SOLUTION -C - CALL WNCTXT(F_TP,' ') - NDONE=0 - DO WHILE(NSCSTG(FCAOUT,SETS,STH(0),STHP,SETNAM)) !NEXT SET - DO I=0,1 !GAIN/PHASE - DO I1=0,STHTEL-1 !TEL. - DO I2=0,1 !X,Y - STHE(STH_POLC_E+I+2*I1+2*STHTEL*I2)=0 - END DO - END DO - END DO - IF (.NOT.WNFWR(FCAOUT,STHHDL,STH,STHP)) THEN !WRITE CORRECTIONS - CALL WNCTXT(F_TP,'Error zeroing corrections in sector !AS', - 1 WNTTSG(SETNAM,0)) - END IF - NDONE=NDONE+1 - IF (MOD(NDONE,100).EQ.0) - 1 CALL WNCTXT(F_T,'!AS: !UJ sectors done', - 1 WNTTSG(SETNAM,0),NDONE) - END DO !END SET -C - CALL WNCTXT(F_TP,'!UJ sectors processed',NDONE) - RETURN -C -C INVERT CORRECTIONS -C - ENTRY NCAPOI -C -C INVERT SOLUTION -C - CALL WNCTXT(F_TP,' ') - NDONE=0 - DO WHILE(NSCSTG(FCAOUT,SETS,STH(0),STHP,SETNAM)) !NEXT SET - DO I=0,1 !GAIN/PHASE - DO I1=0,STHTEL-1 !TEL. - DO I2=0,1 !X,Y - STHE(STH_POLC_E+I+2*I1+2*STHTEL*I2)= - 1 -STHE(STH_POLC_E+I+2*I1+2*STHTEL*I2) - END DO - END DO - END DO - IF (.NOT.WNFWR(FCAOUT,STHHDL,STH,STHP)) THEN !WRITE CORRECTIONS - CALL WNCTXT(F_TP,'Error inverting corrections in sector !AS', - 1 WNTTSG(SETNAM,0)) - END IF - NDONE=NDONE+1 - IF (MOD(NDONE,100).EQ.0) - 1 CALL WNCTXT(F_T,'!AS: !UJ sectors done', - 1 WNTTSG(SETNAM,0),NDONE) - END DO !END SET -C - CALL WNCTXT(F_TP,'!UJ sectors processed',NDONE) - RETURN -C -C SHOW CORRECTIONS -C - ENTRY NCAPOS -C -C GET CORRECTIONS -C - DO WHILE(NSCSTG(FCAOUT,SETS,STH(0),STHP,SETNAM)) !NEXT SET - CALL WNCTXT(F_TP,'!/\Sector: !AS', - 1 WNTTSG(SETNAM,0)) - DO I=0,1 !GAIN/PHASE - DO I1=0,STHTEL-1 !TEL. - DO I2=0,1 !X,Y -C CMV930907 Use SSOL in stead of sol - SSOL(I,I2,I1)= !GET CORRECTIONS - 1 STHE(STH_POLC_E+I+2*I1+2*STHTEL*I2)*PI2 - END DO - END DO - END DO -C -C SHOW SOLUTION -C - CALL WNCTXT(F_TP,'!/ Position '// - 1 ' Ellipticity '// - 1 ' Rotation Orthog.!/'// - 1 ' X(%) Y(%) '// - 1 ' X(%) Y(%) '// - 1 ' (deg) (deg)!/') !HEADING - DO I=0,STHTEL-1 !ALL TELESCOPES - CALL WNCTXT(F_TP,'!AS !7$E7.2 !7$E7.2'// - 1 ' !7$E7.2 !7$E7.2'// - 1 ' !7$E7.2 !7$E7.2', - 1 TELNMA(I), - 1 100.*SSOL(0,0,I), - 1 100.*SSOL(0,1,I), - 1 100.*SSOL(1,0,I), - 1 100.*SSOL(1,1,I), - 1 (SSOL(0,0,I)+SSOL(0,1,I))*180./PI2, - 1 (SSOL(0,1,I)-SSOL(0,0,I))*360./PI2) - END DO - END DO !END SETS - CALL WNCTXT(F_TP,' ') -C - RETURN -C -C SET CORRECTIONS -C - ENTRY NCAPOT -C -C GET VALUES -C -C -C Here we assume the SSOL array is dimensioned -C SSOL(0:STHTEL-1,X:Y,GAIN:PHASE) -C -C This is not the case and might give errors if array bound -C checking would be done -C - NDONE=0 -41 CONTINUE - DO I1=0,STHTEL-1 !MAKE ZERO - SSOL(I1,0,0)=0 - END DO - IF (.NOT.WNDPAR('POL_ROTAN',SSOL(0,0,0),STHTEL*LB_E,J0, - 1 A_B(-A_OB),SSOL(0,0,0),STHTEL)) THEN - IF (E_C.EQ.DWC_ENDOFLOOP) GOTO 40 !STOP - GOTO 41 !RETRY - END IF - IF (J0.LE.0) THEN !SET ZERO - DO I1=0,STHTEL-1 - SSOL(I1,0,0)=0 - END DO - END IF -42 CONTINUE - DO I1=0,STHTEL-1 !MAKE ZERO - SSOL(I1,1,0)=0 - END DO - IF (.NOT.WNDPAR('POL_ORTHOG',SSOL(0,1,0),STHTEL*LB_E,J0, - 1 A_B(-A_OB),SSOL(0,1,0),STHTEL)) THEN - IF (E_C.EQ.DWC_ENDOFLOOP) GOTO 41 !STOP - GOTO 42 !RETRY - END IF - IF (J0.LE.0) THEN !SET ZERO - DO I1=0,STHTEL-1 - SSOL(I1,1,0)=0 - END DO - END IF -43 CONTINUE - DO I1=0,STHTEL-1 !MAKE ZERO - SSOL(I1,0,1)=0 - END DO - IF (.NOT.WNDPAR('POL_X_ELLIPS',SSOL(0,0,1),STHTEL*LB_E,J0, - 1 A_B(-A_OB),SSOL(0,0,1),STHTEL)) THEN - IF (E_C.EQ.DWC_ENDOFLOOP) GOTO 42 !STOP - GOTO 43 !RETRY - END IF - IF (J0.LE.0) THEN !SET ZERO - DO I1=0,STHTEL-1 - SSOL(I1,0,1)=0 - END DO - END IF -44 CONTINUE - DO I1=0,STHTEL-1 !MAKE ZERO - SSOL(I1,1,1)=0 - END DO - IF (.NOT.WNDPAR('POL_Y_ELLIPS',SSOL(0,1,1),STHTEL*LB_E,J0, - 1 A_B(-A_OB),SSOL(0,1,1),STHTEL)) THEN - IF (E_C.EQ.DWC_ENDOFLOOP) GOTO 43 !STOP - GOTO 44 !RETRY - END IF - IF (J0.LE.0) THEN !SET ZERO - DO I1=0,STHTEL-1 - SSOL(I1,1,1)=0 - END DO - END IF -C -C MAKE PROPER FORMAT -C - DO I1=0,STHTEL-1 !TEL. - DO I2=0,1 !X,Y - SSOL(I1,I2,1)=SSOL(I1,I2,1)/100 !ELLIPTICITY - END DO - R0=(SSOL(I1,0,0)*PI2/180-SSOL(I1,1,0)*PI2/360)/2 !POS. X - SSOL(I1,1,0)=(SSOL(I1,0,0)*PI2/180+SSOL(I1,1,0)*PI2/360)/2 !POS. Y - SSOL(I1,0,0)=R0 !POS. X - END DO -C -C SAVE SOLUTION -C - CALL WNCTXT(F_TP,' ') - DO WHILE(NSCSTG(FCAOUT,SETS,STH(0),STHP,SETNAM)) !NEXT SET - DO I=0,1 !GAIN/PHASE - DO I1=0,STHTEL-1 !TEL. - DO I2=0,1 !X,Y - STHE(STH_POLC_E+I+2*I1+2*STHTEL*I2)= - 1 SSOL(I1,I2,I)/PI2 !SET - END DO - END DO - END DO - IF (.NOT.WNFWR(FCAOUT,STHHDL,STH,STHP)) THEN !WRITE CORRECTIONS - CALL WNCTXT(F_TP,'Error setting corrections in set !AS', - 1 WNTTSG(SETNAM,0)) - END IF - NDONE=NDONE+1 - IF (MOD(NDONE,100).EQ.0) - 1 CALL WNCTXT(F_T,'!AS: !UJ sectors done', - 1 WNTTSG(SETNAM,0),NDONE) - END DO !END SET -C - 70 CONTINUE - CALL WNCTXT(F_TP,'!UJ sectors processed',NDONE) - RETURN -C -C EDIT CORRECTIONS -C - ENTRY NCAPOE -C -C GET SOLUTION -C -C -C Again assume SSOL(0:STHTEL-1,X:Y,GAIN:PHASE) -C - CALL WNCTXT(F_TP,' ') - NDONE=0 - DO WHILE(NSCSTG(FCAOUT,SETS,STH(0),STHP,SETNAM)) !NEXT SET - DO I=0,1 !GAIN/PHASE - DO I1=0,STHTEL-1 !TEL. - DO I2=0,1 !X,Y - SSOL(I1,I2,I)=PI2* - 1 STHE(STH_POLC_E+I+2*I1+2*STHTEL*I2) !GET CORRECTIONS - END DO - END DO - END DO -C -C MAKE EXTERNAL FORMAT -C - DO I1=0,STHTEL-1 !TEL. - DO I2=0,1 !X,Y - SSOL(I1,I2,1)=100*SSOL(I1,I2,1) !ELLIPTICITY - END DO - R0=(SSOL(I1,0,0)+SSOL(I1,1,0))*180./PI2 - SSOL(I1,1,0)=(SSOL(I1,1,0)-SSOL(I1,0,0))*360./PI2 !ORTHOG. - SSOL(I1,0,0)=R0 !ROTAT. ANGLE - END DO -C -C EDIT -C -51 CONTINUE - IF (.NOT.WNDPAR('POL_ROTAN',SSOL(0,0,0),STHTEL*LB_E,J0, - 1 A_B(-A_OB),SSOL(0,0,0),STHTEL)) THEN - IF (E_C.EQ.DWC_ENDOFLOOP) GOTO 50 !STOP - GOTO 51 !RETRY - END IF - IF (J0.EQ.0) THEN !SET ZERO - DO I1=0,STHTEL-1 - SSOL(I1,0,0)=0 - END DO - END IF -52 CONTINUE - IF (.NOT.WNDPAR('POL_ORTHOG',SSOL(0,1,0),STHTEL*LB_E,J0, - 1 A_B(-A_OB),SSOL(0,1,0),STHTEL)) THEN - IF (E_C.EQ.DWC_ENDOFLOOP) GOTO 51 !STOP - GOTO 52 !RETRY - END IF - IF (J0.EQ.0) THEN !SET ZERO - DO I1=0,STHTEL-1 - SSOL(I1,1,0)=0 - END DO - END IF -53 CONTINUE - IF (.NOT.WNDPAR('POL_X_ELLIPS',SSOL(0,0,1),STHTEL*LB_E,J0, - 1 A_B(-A_OB),SSOL(0,0,1),STHTEL)) THEN - IF (E_C.EQ.DWC_ENDOFLOOP) GOTO 52 !STOP - GOTO 53 !RETRY - END IF - IF (J0.EQ.0) THEN !SET ZERO - DO I1=0,STHTEL-1 - SSOL(I1,0,1)=0 - END DO - END IF -54 CONTINUE - IF (.NOT.WNDPAR('POL_Y_ELLIPS',SSOL(0,1,1),STHTEL*LB_E,J0, - 1 A_B(-A_OB),SSOL(0,1,1),STHTEL)) THEN - IF (E_C.EQ.DWC_ENDOFLOOP) GOTO 53 !STOP - GOTO 54 !RETRY - END IF - IF (J0.EQ.0) THEN !SET ZERO - DO I1=0,STHTEL-1 - SSOL(I1,1,1)=0 - END DO - END IF -C -C MAKE PROPER FORMAT -C - DO I1=0,STHTEL-1 !TEL. - DO I2=0,1 !X,Y - SSOL(I1,I2,1)=SSOL(I1,I2,1)/100 !ELLIPTICITY - END DO - R0=(SSOL(I1,0,0)*PI2/180-SSOL(I1,1,0)*PI2/360)/2 !POS. X - SSOL(I1,1,0)=(SSOL(I1,0,0)*PI2/180+SSOL(I1,1,0)*PI2/360)/2 !POS. Y - SSOL(I1,0,0)=R0 !POS. X - END DO -C -C SET NEW CORRECTIONS -C - DO I=0,1 !GAIN/PHASE - DO I1=0,STHTEL-1 !TEL. - DO I2=0,1 !X,Y - STHE(STH_POLC_E+I+2*I1+2*STHTEL*I2)= - 1 SSOL(I1,I2,I)/PI2 !SET - END DO - END DO - END DO - IF (.NOT.WNFWR(FCAOUT,STHHDL,STH,STHP)) THEN !WRITE CORRECTIONS - CALL WNCTXT(F_TP,'Error setting corrections in set !AS', - 1 WNTTSG(SETNAM,0)) - END IF - NDONE=NDONE+1 - IF (MOD(NDONE,100).EQ.0) - 1 CALL WNCTXT(F_T,'Now at output sector !AS: !UJ sectors done', - 1 WNTTSG(SETNAM,0),NDONE) - END DO !END SET -C - 50 CONTINUE - CALL WNCTXT(F_TP,'Total of !UJ sectors processed',NDONE) - RETURN -C -C COPY CORRECTIONS -C - ENTRY NCAPOC -C -C GET DATA -C - IF (.NOT.NSCSTL(FCAINP,SETINP,STH(0),STHP,CSTNAM,LPOFF)) THEN - CALL WNCTXT(F_TP,'No input set can be found') - GOTO 60 !READY - END IF -C -C FORMAT IT -C - DO I=0,1 !GAIN/PHASE - DO I1=0,STHTEL-1 !TEL. - DO I2=0,1 !X,Y -C CMV930907 Please use proper SSOL here... -C SSOL(I1,I2,I)=PI2* - SSOL(I,I2,I1)=PI2* - 1 STHE(STH_POLC_E+I+2*I1+2*STHTEL*I2) !GET CORRECTIONS - END DO - END DO - END DO -C -C SAVE THEM -C -CC CALL WNCTXT(F_TP,' ') - NDONE=0 - DO WHILE(NSCSTL(FCAOUT,SETS,STH(0),STHP,SETNAM,LPOFF)) !NEXT output sctr -C -C SET NEW CORRECTIONS -C - DO I=0,1 !GAIN/PHASE - DO I1=0,STHTEL-1 !TEL. - DO I2=0,1 !X,Y -C CMV930907 Also proper SSOL - STHE(STH_POLC_E+I+2*I1+2*STHTEL*I2)= - 1 SSOL(I,I2,I1)/PI2 !SET - END DO - END DO - END DO - IF (.NOT.WNFWR(FCAOUT,STHHDL,STH,STHP)) THEN !WRITE CORRECTIONS - CALL WNCTXT(F_TP,'Error setting corrections in sector !AS', - 1 WNTTSG(SETNAM,0)) - END IF - NDONE=NDONE+1 - IF (MOD(NDONE,100).EQ.0) - 1 CALL WNCTXT(F_T,'Input sector !AS, !UJ output sectors done', - 1 WNTTSG(CSTNAM,0),NDONE) - END DO !END SET -C - CALL WNCTXT(F_TP,'Input sector !AS copied to !UJ output sectors', - 1 WNTTSG(CSTNAM,0),NDONE) - 60 CONTINUE - RETURN -C -C - END diff --git a/src/nscan/ncapvz.for b/src/nscan/ncapvz.for deleted file mode 100644 index 1aaa1d054d87631ad6e81bc168b604b2a90a84d5..0000000000000000000000000000000000000000 --- a/src/nscan/ncapvz.for +++ /dev/null @@ -1,408 +0,0 @@ -C+ NCAPVZ.FOR -C WNB 910930 -C -C Revisions: -C GvD 920429 Declare WNDPAR as logical iso. integer -C WNB 921104 Full HA range -C WNB 930504 Change for new complex solution -C HjV 930518 Change some text -C WNB 930825 Add dipole position -C WNB 930826 New redundant -C WNB 950611 New least squares -C JPH 960625 Correct reporting text -C Make filler arguments of NSCSCW calls 0 for clarity -C Remove NSCMBL, NCARRT calls -C JPH 960715 Iteration, double reading of scan data -C Local apply/deapply masks -C Use IF/ENDIF for block structure -C JPH 960725 Do not add correction to 0 values -C JPH 960806 Fix previous: Test sum RED+ALG+OTH i.s.o. OTH only -C Use cross-correlation XY.XY* to determine phase -C Apply phase correction also to dipole corrections -C JPH 960815 Report gain-difference factor (no action yet) -C Emit message on change of algorithm -C JPH 960824 Emit message only once -C JPH 970311 atan2(cos,sin) --> atans (-cos,-sin): rotation by pi/2 -C JPH 970403 Add USIGN to XYDIF -C JPH 971128 Add ifr selection: call NSCMBL, check BASEL(IFR) -C JPH 980917 Use FCARD for calculation, FCAOUT for output (some -C calc. input was still using FCAOUT) -C -C - SUBROUTINE NCAPVZ(MDONE) -C -C Calculate X-Y phase difference -C -C Result: -C -C CALL NCAPVZ will calculate the X-Y phase difference assuming V=0 -C CALL NCAPVA calculate and apply -C CALL NCAPVM apply value asked -C CALL NCAPVQ calculated, ask and apply -C -C PIN reference: -C -C VZERO_PHASE -C -C Include files: -C - INCLUDE 'WNG_DEF' - INCLUDE 'CBITS_DEF' ! apply/deapply bits - INCLUDE 'NCA_DEF' - INCLUDE 'LSQ_O_DEF' - INCLUDE 'STH_O_DEF' ! SET HEADER - INCLUDE 'SCH_O_DEF' ! SCAN HEADER -C -C Parameters: -C - INTEGER X,Y - PARAMETER (X=0,Y=1) -C -C -C Arguments: -C - LOGICAL MDONE ! 'message done' flag -C -C Function references: -C - LOGICAL WNFWR ! READ/write DISK - CHARACTER*32 WNTTSG ! MAKE SUB-GROUP NAME - REAL WNGENR ! NORM. ANGLE - INTEGER WNGARA ! variable address - LOGICAL WNDPAR ! GET USER DATA - LOGICAL WNMLGA ! GET LSQ AREA - LOGICAL NSCSTL ! GET A SET - LOGICAL NSCSIF ! READ IFR TABLE - LOGICAL NSCSCR ! READ DATA FROM SCAN - LOGICAL NSCSCH ! READ SCAN HEADER - LOGICAL NSCSCW ! WRITE SCAN HEADER -C -C Data declarations: -C - real a - REAL BASEL(0:STHIFR-1) ! BASELINE TABLE - COMPLEX CPOLC(0:STHTEL-1,0:1) ! complex dipole corrns. X,Y - EQUIVALENCE (CPOLC,STHE(STH_POLC_E)) - COMPLEX CE(0:1) ! phase factor - LOGICAL LCALC ! CALCULATE - LOGICAL LAPPLY ! APPLY - LOGICAL LASK ! ASK VALUE - INTEGER LCAP ! apply/deapply masks - INTEGER FCARD ! local copy of input FCA - INTEGER INXRD ! pointer to corresponding SETS - REAL XYDIF ! phase-zero diff - INTEGER SETNAM(0:7) ! FULL SET NAME - INTEGER CSTNAM(0:7) ! CHECK SET NAME - DATA CSTNAM/8*-1/ - INTEGER*2 IFRT(0:STHIFR-1) ! INTERFEROMETER TABLE - INTEGER IFRA(0:1,0:STHIFR-1) - REAL ANG(0:2,0:STHIFR-1) - REAL HA ! HOUR-ANGLE - REAL WGT(0:STHIFR-1,0:3) ! DATA WEIGHTS XX,XY,YX,YY - REAL DAT(0:1,0:STHIFR-1,0:3) ! DATA XX,XY,YX,YY without - COMPLEX DATC(0:STHIFR-1,0:3) ! dipole correction - EQUIVALENCE (DAT,DATC) - COMPLEX CF - DATA CF/1/ - COMPLEX D(3) ! data XY.YX*, XY, YX - COMPLEX CSOL(3),CME(3) ! solutions and ME - REAL RSOL(2), RME(2) ! temporaries - REAL MU(3),SD(3) - INTEGER MAR ! LSQ AREA - INTEGER STHP ! POINTER TO SET HEADER - BYTE STH(0:STHHDL-1) ! SET HEADER - INTEGER*2 STHI(0:STHHDL/2-1) - INTEGER STHJ(0:STHHDL/4-1) - REAL STHE(0:STHHDL/4-1) - REAL*8 STHD(0:STHHDL/8-1) - EQUIVALENCE(STH,STHI,STHJ,STHE,STHD) - BYTE SCH(0:SCHHDL-1) ! SCAN HEADER - INTEGER*2 SCHI(0:SCHHDL/2-1) - INTEGER SCHJ(0:SCHHDL/4-1) - REAL SCHE(0:SCHHDL/4-1) - REAL*8 SCHD(0:SCHHDL/8-1) - EQUIVALENCE(SCH,SCHI,SCHJ,SCHE,SCHD) - INTEGER IFR, ISCN, ITL, IXY ! loop indices -C- - LCALC=.TRUE. - LAPPLY=.FALSE. - LASK=.FALSE. - GOTO 10 -C -C NCAPVA -C - ENTRY NCAPVA(MDONE) -C - LCALC=.TRUE. - LAPPLY=.TRUE. - LASK=.FALSE. - GOTO 10 -C -C NCAPVM -C - ENTRY NCAPVM(MDONE) -C - LCALC=.FALSE. - LAPPLY=.TRUE. - LASK=.TRUE. - GOTO 10 -C -C NCAPVQ -C - ENTRY NCAPVQ(MDONE) -C - LCALC=.TRUE. - LAPPLY=.TRUE. - LASK=.TRUE. - GOTO 10 -C -C CALCULATE -C - 10 CONTINUE - LCAP=CAP_TELMSK+CAP_IFRMSK+CAP_POL - XYDIF=0 ! ASSUME 0 - CALL WNCTXT (F_TP, ' ') - IF (LCALC) THEN -C -C INIT -C - IF (.NOT.WNMLGA(MAR,LSQ_T_COMPLEX+LSQ_T_MULTIPLE,1,3)) THEN - ! GET LSQ AREA - CALL WNCTXT(F_TP,'ERROR: Cannot obtain work area') - GOTO 200 - END IF -C -C Read FCA? INP if it is open (COPY) FCAOUT otherwise -C - IF (FCAINP.NE.0) THEN ! VZERO COPY - FCARD=FCAINP - INXRD=WNGARA(SETINP) - ELSE ! VZERO CALC or APPLY - FCARD=FCAOUT - INXRD=WNGARA(SETS) - ENDIF - INXRD=(INXRD-A_OB)/LB_J -C - DO WHILE (NSCSTL(FCARD,A_J(INXRD),STH(0),STHP,SETNAM,LPOFF)) -C -C GET IFR TABLES -C - IF (STHI(STH_PLN_I).NE.4) THEN ! CANNOT USE - CALL WNCTXT(F_TP,'Sector !AS has only !UI polarisations', - 1 WNTTSG(SETNAM,0),STHI(STH_PLN_I)) - GOTO 20 ! NEXT SET - END IF - IF (.NOT.NSCSIF(FCARD,STH,IFRT,IFRA,ANG)) THEN - ! READ IFR TABLE - CALL WNCTXT(F_TP,'!/Error reading IFR table !AS', - 1 WNTTSG(SETNAM,0)) - GOTO 20 ! TRY NEXT SET - END IF - CALL NSCMBL(STHE(STH_RTP_E),STHJ(STH_NIFR_J),IFRT, - 1 SIFRS,BASEL) ! BASELine table, >=0 selected - -C -C SHOW CURRENT SET -C - DO I1=0,3 - IF (CSTNAM(I1).NE.SETNAM(I1)) THEN - DO I2=0,3 - CSTNAM(I2)=SETNAM(I2) - END DO - CALL WNCTXT(F_TP,'Source sector: !AS',WNTTSG(CSTNAM,0)) - END IF - END DO -C -C DO SCANS -C - DO ISCN=0,STHJ(STH_SCN_J)-1 ! ALL SCANS - HA=STHE(STH_HAB_E)+ISCN*STHE(STH_HAI_E) - ! HA OF SCAN - IF (HA.LT.HARAN(1) .OR. HA.GT.HARAN(2)) GOTO 30 - ! FORGET -C -C GET DATA -C - IF (.NOT.NSCSCR(FCARD,STH,IFRT,ISCN, - ! read with dipole corrn - 1 LCAP,0,SCH,WGT,DATC)) THEN - CALL WNCTXT(F_TP,'!7$EAF7.2 Error reading scan data',HA) - GOTO 20 ! TRY NEXT SET - END IF - DO IFR=0,STHJ(STH_NIFR_J)-1 ! ALL IFRS - IF (BASEL(IFR).GT.0) THEN ! selected? - IF (WGT(IFR,1).GT.0 .AND. WGT(IFR,2).GT.0) THEN - D(1)=DATC(IFR,2)*CONJG(DATC(IFR,1)) - ! XY.YX* - D(2)=DATC(IFR,1) ! XY - D(3)=DATC(IFR,2) ! YX - CALL WNMLMN(MAR,LSQ_C_COMPLEX,CF,1.,D) - ! accumulate - ENDIF - ENDIF - END DO - 30 CONTINUE - ENDDO ! scans -C -C NEXT SET -C - 20 CONTINUE - END DO -C -C MAKE SOLUTION -C - CALL WNMLID(MAR) ! FIX MISSING TEL. - - CALL WNMLTN(MAR) ! TRIANGLE - CALL WNMLSN(MAR,CSOL,MU,SD) ! GET SOLUTION - CALL WNMLME(MAR,CME) ! GET M.E. - CALL WNMLFA(MAR) ! FREE MATRICES -C -C The solution for XYDIF has a PI ambiguity due to the factor .5; this is -C resolved by adding USIGN, which is 0 for Stokes U<0 and PI for U>0. USIGN is -C set by NCADAT -C - IF (ABS(CSOL(1)).NE.0) THEN - XYDIF=.5*ATAN2( -AIMAG(CSOL(1)),-REAL(CSOL(1)) ) + USIGN - ELSE - XYDIF=0 - ENDIF - RSOL(1)=ABS(CSOL(2)) ! |XY| average - RSOL(2)=ABS(CSOL(3)) ! |YX| average - RME(1)=REAL(CME(2))/RSOL(1) ! XY rel. error - RME(2)=REAL(CME(3))/RSOL(2) ! YX rel. error - RSOL(1)=SQRT(RSOL(1)/RSOL(2)) ! |XY/YX| - RME(1)=.5*(RME(1)+RME(2))*RSOL(1) ! and its error - CALL WNCTXT(F_TP,' - 1!/Average of XY.YX*: !EC9.3 (!E9.3) - 1!/X-Y phase-zero difference to be added: !EAR9.1 deg - 1!/XY/YX gain-difference factor: !E9.3 (!E9.3)', - 1 CSOL(1),REAL(CME(1)), XYDIF, RSOL(1), RME(1) ) -C - ENDIF ! calc -C -C ASK -C - IF (LASK) THEN ! NO ASK - IF (.NOT.WNDPAR('VZERO_PHASE',XYDIF,LB_E,J0,A_B(-A_OB), - 1 XYDIF*DEG,1)) THEN - RETURN ! READY - END IF - IF (J0.LE.0) RETURN ! STOP - XYDIF=WNGENR(XYDIF*RAD) ! MAKE RADIANS - ENDIF -C -C APPLY -C - IF (LAPPLY) THEN -C -C Message -C - IF (.NOT.MDONE) THEN - CALL WNCTXT(F_TP,' - 1!/!4C\In July 1996 an error in Newstar polarisation processing was - 1!/!4C\discovered: It is necessary to adjust the dipole correction - 1!/!4C\terms (orientations and ellipticities) when a phase-zero - 1!/!4C\difference correction is applied. This was never done in Newstar - 1!/!4C\(nor probably in any prior WSRT software); the fact that this - 1!/!4C\error was not detected earlier suggests that its impact on - 1!/!4C\astronomical results has been limited.') - CALL WNCTXT(F_TP,' - 1!/!4C\NCALIB now does apply this correction. As a result, you may find - 1!/!4C\differences between present results and earlier ones obtained - 1!/!4C\with the same input data. !/') - MDONE=.TRUE. - ENDIF -C -C DO SETS -C - CE(X)=EXP(CMPLX(0.,-XYDIF)) ! factors for dipole - CE(Y)=CONJG(CE(X)) ! corrections - CSTNAM(0)=-1 ! reset - DO WHILE(NSCSTL(FCAOUT,SETS,STH(0),STHP,SETNAM,LPOFF)) - ! NEXT SET -C -C SHOW CURRENT SET -C - DO IFR=0,3 - IF (CSTNAM(IFR).NE.SETNAM(IFR)) THEN - DO I2=0,3 - CSTNAM(I2)=SETNAM(I2) - END DO - CALL WNCTXT(F_TP,'Target sector: !AS',WNTTSG(CSTNAM,0)) - END IF - END DO -C -C Adjust dipole corrections -C - DO ITL=0,STHTEL-1 - DO IXY=X,Y - IF (CPOLC(ITL,IXY).NE.0) - 1 CPOLC(ITL,IXY)=CPOLC(ITL,IXY)*CE(IXY) - ENDDO - ENDDO - IF (.NOT.WNFWR(FCAOUT,STHHDL,STH,STHP)) THEN - ! WRITE CORRECTIONS - CALL WNCTXT(F_TP,'Error writing dipole corrections in sector !AS', - 1 WNTTSG(SETNAM,0)) - END IF -C -C DO SCANS -C - DO ISCN=0,STHJ(STH_SCN_J)-1 ! ALL SCANS -C -C INIT -C - HA=STHE(STH_HAB_E)+ISCN*STHE(STH_HAI_E) - ! HA OF SCAN - IF (HA.LT.HARAN(1) .OR. HA.GT.HARAN(2)) GOTO 130 - ! FORGET -C -C GET DATA -C - IF (.NOT.NSCSCH(FCAOUT,STH,IFRT,ISCN,CORAP,CORDAP, - 1 SCH)) THEN ! READ SCAN HEADER - CALL WNCTXT(F_TP,'!7$EAF7.2 Error reading scan header',HA) - GOTO 120 ! TRY NEXT SET - END IF -C -C APPLY CORRECTION only to telescopes that are present -C - DO ITL=0,STHTEL-1 ! ALL TELESCOPES - IF (SCHE(SCH_REDC_E+2*ITL+1)+ - 1 SCHE(SCH_ALGC_E+2*ITL+1)+ - 1 SCHE(SCH_OTHC_E+2*ITL+1).NE.0) THEN - SCHE(SCH_OTHC_E+2*ITL+1)= - 1 WNGENR(SCHE(SCH_OTHC_E+2*ITL+1)-XYDIF) - ! APPLY ANGLE - ENDIF - ENDDO -C -C WRITE SCAN HEADER -C - IF (.NOT.NSCSCW(FCAOUT,STH,IFRT,ISCN,0,0, - 1 SCH)) THEN ! WRITE SCAN HEADER - CALL WNCTXT(F_TP,'!7$EAF7.2 Error writing scan header',HA) - GOTO 120 ! TRY NEXT SET - END IF -C -C NEXT SCAN -C - 130 CONTINUE - END DO ! END SCANS -C -C NEXT SET -C - 120 CONTINUE - END DO ! sectors - ENDIF ! apply -C -C READY -C - 200 CONTINUE -C - RETURN ! READY -C -C - END - diff --git a/src/nscan/ncaraw.for b/src/nscan/ncaraw.for deleted file mode 100644 index 79633c7501e793319aa2577b661928381e53012c..0000000000000000000000000000000000000000 --- a/src/nscan/ncaraw.for +++ /dev/null @@ -1,71 +0,0 @@ -C+ NCARAW.FOR -C WNB 910207 -C -C Revisions: -C - SUBROUTINE NCARAW(MWGT,MWGTD,NIFR,BASEL,RAWGT) -C -C Calculate align weights -C -C Result: -C -C CALL NCARAW( MWGT_J:I, MWGTD_E(0:1):I, NIFR_J:I, -C BASEL(0:*):I, RAWGT_R(0:*):O) -C Calculate the align weights RAWGT for -C NIFR interferometers at baselines (m) -C BASEL. -C MWGT is the type: -C 1= step; 2= gaussian; 3= triangle -C -1,...= 1-function. -C MWGTD specifies (m) the centre (0) and -C the halfwidth (1) of the function. -C -C Include files: -C - INCLUDE 'WNG_DEF' - INCLUDE 'STH_O_DEF' !SET HEADER -C -C Entry points: -C -C -C Parameters: -C -C -C Arguments: -C - INTEGER MWGT !TYPE OF WEIGHT - REAL MWGTD(0:1) !WEIGTH CENTRE, HALFWIDTH - INTEGER NIFR !# OF INTERFEROMETERS - REAL BASEL(0:*) !BASELINES - REAL RAWGT(0:*) !WEIGHT CALCULATED -C -C Function references: -C -C -C Data declarations: -C -C- - DO I=0,NIFR-1 !ALL BASELINES - R0=ABS(BASEL(I)-MWGTD(0)) !BASELINE OFFSET - IF (ABS(MWGT).EQ.2) THEN !GAUSSIAN - RAWGT(I)=EXP(-LOG(2.)*((R0/MWGTD(1))**2)) - ELSE IF (ABS(MWGT).EQ.3) THEN !TRIANGLE - IF (R0.LE.2*MWGTD(1)) THEN !IN TRIANGLE - RAWGT(I)=1-R0 - ELSE - RAWGT(I)=0 - END IF - ELSE !STEP - IF (R0.LE.MWGTD(1)) THEN !IN STEP - RAWGT(I)=1 - ELSE - RAWGT(I)=0 - END IF - END IF - IF (MWGT.LT.0) RAWGT(I)=1.-RAWGT(I) !INVERT - END DO -C - RETURN !READY -C -C - END diff --git a/src/nscan/ncarcs.for b/src/nscan/ncarcs.for deleted file mode 100644 index b0c1b9b5d507447d521484592915470fe4cd6fda..0000000000000000000000000000000000000000 --- a/src/nscan/ncarcs.for +++ /dev/null @@ -1,630 +0,0 @@ -C+ NCARCS.FOR -C WNB 910131 -C -C Revisions: -C WNB 910812 Add ALIGN -C WNB 910930 Narrower check -C WNB 911024 Running noise -C WNB 930504 Make proper complex solution -C WNB 930628 Typo for ALIGN part -C WNB 950613 New LSQ routines -C WNB 950614 Change non-linear LSQ -C WNB 950621 Organisational changes -C WNB 950628 Second order error correction -C WNB 950718 Typo for some machines -C WNB 980701 Add for new MIFR calculations -C CMV 030116 Acommodated for unsorted IFR table -C WNB 070814 Change in inconsistency calculations -C WNB 091019 Change back to old (pre-070814) -C - LOGICAL FUNCTION NCARCS(MAR,NIFR,IFR,BASEL,NDEG, - 1 IRED,WGT,AWGT,CDAT,AMP,PHAS,CMOD,CWGT, - 1 CSOL,SOL,MU,ME) -C -C Calculate redundancy complex solution -C -C Result: -C -C NCARCS_L = NCARCS( MAR_J:I, NIFR_J:I, -C IFR_I(0:*):I, BASEL_E(0:*):I, NDEG_J:IO, -C IRED_J(0:NIFR-1):I, WGT_E(0:*,0:*):I, -C AWGT_E(0:8,0:1):I, CDAT_X(0:*,0:1):I -C AMP_E(0:*,0:*):I, PHAS_E(0:*,0:*):I, -C CMOD_X(0:*,0:1):I, CWGT_E(0:*):I, -C CSOL_E(0:*,0:1,0:1):I,SOL_E(0:*,0:1,0:1):O, -C MU_E:O, ME_E:O) -C Calculate the redundancy complex solution -C in SOL, with adjustment error MU and -C mean errors ME using CSOL as approximate -C solution. -C WGT/AWGT is the weight, AMP/PHAS/CDAT -C the data. IRED specifies the -C redundant baselines. -C CMOD is the model with sqrt(weights) -C CWGT. -C MAR is the solution area for the -C telescopes, using NIFR interferometers -C and a degeneracy of NDEG. -C IFR are the interferometer -C specifications. -C NCASCS_L = NCASCS( ...) -C Selfcal solution -C NCAACS_L = NCAACS( ..., NUK_J(0:1):I, ALEQ_E(0:*,0:*,0:1):I) -C Use model for aligning NUK parameters -C with constraint ALEQ -C -C NCARCE_L = NCARCE( MAR_J:I, NIFR_J:I, -C IFR_I(0:*):I, BASEL_E(0:*):I, NDEG_J:IO, -C IRED_J(0:NIFR-1):I, WGT_E(0:*,0:1):I, -C AWGT_E(0:*,0:1):I, CDAT_X(0:*,0:1):I, -C AMP_E(0:*,0:1):I, PHAS_E(0:*,0:1):I, -C CMOD_X(0:*,0:1):I, CWGT_E(0:*):I, -C CSOL_E(0:*,0:1,0:1):I,SOL_E(0:*,0:1,0:1):I, -C MU_E:I, ME_E:I, ARMS_E(0:2):I, -C JAV_J(0:*,0:*,0:1):IO, EAV_E(0:*,0:*,0:1):IO, -C DAV_D(0:*,0:*,0:1):IO) -C Calculate all errors in the average -C arrays JAV, EAV and DAV. -C ARMS is the average amplitude of scan -C NCARCC_L = NCARCC( ...) -C Correct errors back -C NCASCE_L = NCASCE( ...) -C Calculate selfcal errors -C NCASCC_L = NCASCC( ...) -C Correct selfcal errors back -C NCAACE_L = NCAACE( ...) -C Calculate align errors -C NCAACC_L = NCAACC( ...) -C Correct align errors back -C -C JAV, EAV, DAV contain: -C *,*,0 gain -C *,*,1 phase -C 0,0 noise per scan -C 1,0 inconsistency per scan -C 2,0 total noise -C 3,0 overall running noise -C 4,0 max. deviation in scan -C 5,0 total average noise -C 6,0 total average incons. -C 7,0 total average ampl. -C *,1 inconsistency per ifr -C *,2 average rms per ifr -C *,3 gain per telescope -C!980701 *,4 weighted incons per ifr -C -C Include files: -C - INCLUDE 'WNG_DEF' - INCLUDE 'LSQ_O_DEF' - INCLUDE 'STH_O_DEF' !SET HEADER -C -C Entry points: -C - LOGICAL NCASCS !SELFCAL SOLUTION - LOGICAL NCAACS !ALIGN SOLUTION - LOGICAL NCARCE,NCARCC !CALCULATE ERRORS - LOGICAL NCASCE,NCASCC !CALCULATE SELFCAL ERRORS - LOGICAL NCAACE,NCAACC !CALCULATE ALIGN ERRORS -C -C Parameters: -C -C -C Arguments: -C - INTEGER MAR !SOLUTION AREA POINTERS - INTEGER NIFR !TOTAL # OF INTERFEROMETERS - INTEGER*2 IFR(0:*) !INTERFEROMETER TELESCOPES - INTEGER NDEG !DEGENERACY LEVEL (OUT) - !LOOP COUNT (IN) - REAL BASEL(0:*) !BASELINES - INTEGER IRED(0:*) !REDUNDANCY INDICATOR - REAL WGT(0:STHIFR-1,0:*) !DATA WEIGHT X,Y - REAL AWGT(0:STHIFR-1,0:*) !AMPL. WEIGHTED WEIGHT X,Y - COMPLEX CDAT(0:STHIFR-1,0:*) !DATA COMPLEX X,Y - REAL AMP(0:STHIFR-1,0:*) !DATA AMPLITUDE X,Y - REAL PHAS(0:STHIFR-1,0:*) !DATA PHASE X,Y - COMPLEX CMOD(0:STHIFR-1,0:*) !MODEL COMPLEX X,Y - REAL CWGT(0:*) !MODEL WEIGHT**0.5 - REAL SOL(0:STHTEL-1,0:1,0:1) !SOLUTION X,Y G,P - REAL CSOL(0:STHTEL-1,0:1,0:1) !CONTINUITY SOLUTION G,P X,Y - REAL MU !ADJUSTMENT ERROR - REAL ME !MEAN ERRORS SOLUTION - INTEGER NUK(0:1) !# OF CONSTRAINTS - REAL ALEQ(0:STHTEL-1,0:STHTEL-1,0:1) !CONSTRAINT EQUATIONS G,P - REAL ARMS(0:2) !AVERAGE AMPL. - INTEGER JAV(0:STHIFR-1,0:4,0:1) !COUNT FOR AVERAGES - REAL EAV(0:STHIFR-1,0:4,0:1) !SUM FOR AVERAGES - REAL*8 DAV(0:STHIFR-1,0:4,0:1) !SUM FOR RMS -C -C Function references: -C -C -C Data declarations: -C - COMPLEX CCF(0:2*STHTEL-1) !COEFFICIENTS FOR SOLUTION - INTEGER TW1,TE1 !TELESCOPES - INTEGER TW2,TE2 - REAL W2,W22 !WEIGHTS - REAL W4,W24 - REAL R2 !980701 - COMPLEX CC1,CC2 - COMPLEX CELES(0:STHIFR-1) !CELESTIAL DATA - REAL WCELES(0:STHIFR-1) - COMPLEX CLSOL(0:STHTEL-1) !LOCAL SOLUTION - REAL LSOL(0:STHTEL-1,0:1) !LOCAL ALIGN SOLUTION - INTEGER NR !RANK SOLUTION - INTEGER NU !# OF UNKNOWNS - LOGICAL DOSC !SELFCAL OPTION - LOGICAL DOAL !ALIGN OPTION - REAL MMAX !MODEL MAX - COMPLEX C0,C1,C2 !ADD C2 - WNB070814 - REAL R3 !ADD WNB070814 -C- -C -C INIT -C - NCARCS=.TRUE. !ASSUME OK - NU=STHTEL !# OF UNKNOWNS - DOSC=.FALSE. !NOT SELFCAL - DOAL=.FALSE. !NOT ALIGN - GOTO 20 -C -C SELFCAL SOLUTION -C - ENTRY NCASCS(MAR,NIFR,IFR,BASEL,NDEG, - 1 IRED,WGT,AWGT,CDAT,AMP,PHAS,CMOD,CWGT, - 1 CSOL,SOL,MU,ME) -C - NCASCS=.TRUE. !ASSUME OK - NU=STHTEL !# OF UNKNOWNS - DOSC=.TRUE. !SELFCAL - DOAL=.FALSE. !NOT ALIGN - GOTO 21 -C -C ALIGN SOLUTION -C - ENTRY NCAACS(MAR,NIFR,IFR,BASEL,NDEG, - 1 IRED,WGT,AWGT,CDAT,AMP,PHAS,CMOD,CWGT, - 1 CSOL,SOL,MU,ME,NUK,ALEQ) -C - NCAACS=.TRUE. !ASSUME OK - NU=MAX(NUK(0),NUK(1)) !# OF UNKNOWNS - DOSC=.FALSE. !NOT SELFCAL - DOAL=.TRUE. !ALIGN - GOTO 21 -C -C INIT -C - 21 CONTINUE - MMAX=ABS(CMOD(0,0)) !WEIGHT SCALING - DO I=1,NIFR-1 - MMAX=MAX(MMAX,ABS(CMOD(I,0))) - END DO - MMAX=MAX(MMAX,1.) !MAKE SURE - 20 CONTINUE -C -C ZERO SOLUTION MATRIX -C - CALL WNMLIA(MAR,LSQ_I_ALL) !FULL AREA - ME=1. !START LOOP - DO I=0,STHTEL-1 !START SOLUTION - IF (DOAL) THEN - CLSOL(I)=0 - ELSE - CLSOL(I)=CMPLX(1.,0.) - END IF - END DO -C -C LOOP -C - DO WHILE((ME.GT.0 .OR. ME.LT.-0.001) .AND. NCARCS - 1 .AND. NDEG.GE.0) - NDEG=NDEG-1 !LOOP COUNT -C -C MAKE MATRIX -C - I1=0 !TEST REDUNDANT BASELINE - DO I=0,NIFR-1 !ALL IFRS - IF (.NOT.DOAL .AND. IRED(I).GT.0) THEN !REDUNDANT - IF (IRED(I).GT.I1) THEN !NEXT SET - IF (WGT(I,0).NE.0) THEN !CAN USE AS BASE - I1=IRED(I) !NEW TEST VALUE - I4=I - TE1=IFR(I)/256 !TELESCOPES - TW1=MOD(IFR(I),256) - W2=AWGT(I,0) !SAVE WEIGHT - CC1=CDAT(I,0)* !CORRECTED DATA - 1 EXP(CMPLX(-CSOL(TW1,0,0)-CSOL(TE1,0,0), - 1 -CSOL(TW1,1,0)+CSOL(TE1,1,0))) - IF (DOSC) THEN !SELFCAL - W4=WGT(I,0)*(CWGT(I)**2) !MODEL WEIGHT - W24=(ABS(CMOD(I,0))/MMAX)**2 - IF (W24.NE.0) THEN - CC2=CC1/CMOD(I,0) - DO I2=0,2*NU-1 !ZERO COEFFICIENTS - CCF(I2)=0 - END DO - CCF(2*TW1)=CONJG(CLSOL(TE1)) - CCF(2*TE1+1)=CLSOL(TW1) - CALL WNMLMN(MAR,LSQ_C_CCOMPLEX,CCF,W4*W24, - 1 CC2-CLSOL(TW1)*CONJG(CLSOL(TE1))) - END IF - END IF - DO I3=I+1,NIFR-1 !FIND OTHERS - IF (IRED(I3).EQ.I1.AND.WGT(I3,0).GT.0) THEN !SHOULD INCLUDE - TE2=IFR(I3)/256 !TELESCOPES - TW2=MOD(IFR(I3),256) - W22=AWGT(I3,0) !WEIGHT - CC2=CDAT(I3,0)* !CORRECTED DATA - 1 EXP(CMPLX(-CSOL(TW2,0,0)-CSOL(TE2,0,0), - 1 -CSOL(TW2,1,0)+CSOL(TE2,1,0))) - IF (W2.NE.0) THEN - CC2=CC2/CC1 - DO I2=0,2*NU-1 - CCF(I2)=0 !ZERO COEFFICIENTS - END DO - C0=CONJG(CLSOL(TE2))*CLSOL(TW2)/ - 1 (CONJG(CLSOL(TE1))*CLSOL(TW1)) - CCF(2*TW1)=-C0/CLSOL(TW1) - CCF(2*TE1+1)=-C0/CONJG(CLSOL(TE1)) - CCF(2*TW2)=C0/CLSOL(TW2) - CCF(2*TE2+1)=C0/CONJG(CLSOL(TE2)) - CALL WNMLMN(MAR,LSQ_C_CCOMPLEX,CCF,W2*W22, - 1 CC2-C0) - END IF - END IF - END DO - END IF - END IF - ELSE IF (DOSC .AND. WGT(I,0).GT.0) THEN !SELFCAL - W22=WGT(I,0)*(CWGT(I)**2) !WEIGHTS - W24=(ABS(CMOD(I,0))/MMAX)**2 - TE2=IFR(I)/256 !TELESCOPES - TW2=MOD(IFR(I),256) - CC2=CDAT(I,0)* !CORRECTED DATA - 1 EXP(CMPLX(-CSOL(TW2,0,0)-CSOL(TE2,0,0), - 1 -CSOL(TW2,1,0)+CSOL(TE2,1,0))) - IF (W24.NE.0) THEN - CC2=CC2/CMOD(I,0) - DO I2=0,2*NU-1 - CCF(I2)=0 !ZERO COEFFICIENTS - END DO - CCF(2*TW2)=CONJG(CLSOL(TE2)) - CCF(2*TE2+1)=CLSOL(TW2) - CALL WNMLMN(MAR,LSQ_C_CCOMPLEX,CCF,W22*W24, - 1 CC2-CLSOL(TW2)*CONJG(CLSOL(TE2))) - END IF - ELSE IF (DOAL .AND. WGT(I,0).GT.0) THEN !ALIGN - W22=WGT(I,0)*(CWGT(I)**2) !WEIGHTS - W24=(ABS(CMOD(I,0))/MMAX)**2 - TE2=IFR(I)/256 !TELESCOPES - TW2=MOD(IFR(I),256) - CC2=CDAT(I,0)* !CORRECTED DATA - 1 EXP(CMPLX(-CSOL(TW2,0,0)-CSOL(TE2,0,0), - 1 -CSOL(TW2,1,0)+CSOL(TE2,1,0))) - IF (W24.NE.0) THEN !CAN DO - CC2=CC2/CMOD(I,0) - DO I2=0,2*NU-1 !ZERO COEEFICIENTS - CCF(I2)=0 - END DO - DO I2=0,NUK(0)-1 - CCF(2*I2)=(ALEQ(TW2,I2,0)+ALEQ(TE2,I2,0)) - END DO - DO I2=0,NUK(1)-1 - CCF(2*I2+1)=ALEQ(TW2,I2,1)-ALEQ(TE2,I2,1) - END DO - C0=1 - DO I2=0,NU-1 - C1=EXP(CMPLX(0.,REAL(CCF(2*I2+1))*AIMAG(CLSOL(I2)))) - C0=C0*(1+REAL(CLSOL(I2))*CCF(2*I2))*C1 - END DO - DO I2=0,NU-1 - CCF(2*I2)=CCF(2*I2)*C0/(1+REAL(CLSOL(I2))*CCF(2*I2)) - CCF(2*I2+1)=CCF(2*I2+1)*C0 - END DO - CALL WNMLMN(MAR,LSQ_C_DCOMPLEX,CCF,W22*W24, - 1 CC2-C0) - END IF - END IF - END DO -C -C INVERT/SOLVE NORMAL EQUATIONS -C - CALL WNMLNR(MAR,NR,CLSOL,MU,ME) !LU DECOMP. + RANK + SOLVE - DO I=0,NU-1 !CHECK SOLUTION - IF (DOAL) THEN - IF (ABS(1+CLSOL(I)).GT.1E-6) THEN - C0=1+CLSOL(I) - IF (ABS(C0).GT.5) THEN - NCARCS=.FALSE. - END IF - ELSE - NCARCS=.FALSE. - END IF - ELSE IF (ABS(CLSOL(I)).GT.1E-6) THEN !MAKE PROPER UNITS - C0=LOG(CLSOL(I)) - IF (ABS(C0).GT.10) THEN !CHECK FUNNY - NCARCS=.FALSE. - END IF - ELSE - NCARCS=.FALSE. - END IF - END DO - END DO - IF (NCARCS) THEN - DO I=0,NU-1 !SET SOLUTION - IF (.NOT.DOAL) THEN - C0=LOG(CLSOL(I)) - ELSE - C0=LOG(1+CLSOL(I)) - END IF - SOL(I,0,0)=REAL(C0) - SOL(I,0,1)=AIMAG(C0) - END DO - IF (DOAL) THEN !MAKE ALIGN SOLUTION - DO I2=0,1 !COS/SIN - DO I=0,NUK(I2)-1 - LSOL(I,I2)=SOL(I,0,I2) !SAVE SOLUTION - END DO - END DO - DO I=0,STHTEL-1 !SET ALIGN SOLUTION - DO I2=0,1 !COS/SIN - SOL(I,0,I2)=0 - DO I1=0,NUK(I2)-1 - SOL(I,0,I2)=SOL(I,0,I2)+ALEQ(I,I1,I2)*LSOL(I1,I2) - END DO - END DO - END DO - END IF - END IF !NON-LINEAR LOOP -C - RETURN !READY -C -C ERROR CALCULATION -C - ENTRY NCARCE(MAR,NIFR,IFR,BASEL,NDEG, - 1 IRED,WGT,AWGT,CDAT,AMP,PHAS,CMOD,CWGT, - 1 CSOL,SOL,MU,ME, - 1 ARMS,JAV,EAV,DAV) -C - NCARCE=.TRUE. !ASSUME OK - J0=1 !ADD ERRORS - DOSC=.FALSE. !NO SELFCAL - DOAL=.FALSE. !NO ALIGN - GOTO 10 -C -C ERROR CORRECTION -C - ENTRY NCARCC(MAR,NIFR,IFR,BASEL,NDEG, - 1 IRED,WGT,AWGT,CDAT,AMP,PHAS,CMOD,CWGT, - 1 CSOL,SOL,MU,ME, - 1 ARMS,JAV,EAV,DAV) -C - NCARCC=.TRUE. !ASSUME OK - J0=-1 !SUBTRACT ERROR - DOSC=.FALSE. !NO SELFCAL - DOAL=.FALSE. !NO ALIGN - GOTO 10 -C -C SELFCAL ERROR CALCULATION -C - ENTRY NCASCE(MAR,NIFR,IFR,BASEL,NDEG, - 1 IRED,WGT,AWGT,CDAT,AMP,PHAS,CMOD,CWGT, - 1 CSOL,SOL,MU,ME, - 1 ARMS,JAV,EAV,DAV) -C - NCASCE=.TRUE. !ASSUME OK - J0=1 !ADD ERRORS - DOSC=.TRUE. !SELFCAL - DOAL=.FALSE. !NOT ALIGN - GOTO 10 -C -C SELFCAL ERROR CORRECTION -C - ENTRY NCASCC(MAR,NIFR,IFR,BASEL,NDEG, - 1 IRED,WGT,AWGT,CDAT,AMP,PHAS,CMOD,CWGT, - 1 CSOL,SOL,MU,ME, - 1 ARMS,JAV,EAV,DAV) -C - NCASCC=.TRUE. !ASSUME OK - J0=-1 !SUBTRACT ERROR - DOSC=.TRUE. !SELFCAL - DOAL=.FALSE. !NOT ALIGN - GOTO 10 -C -C ALIGN ERROR CALCULATION -C - ENTRY NCAACE(MAR,NIFR,IFR,BASEL,NDEG, - 1 IRED,WGT,AWGT,CDAT,AMP,PHAS,CMOD,CWGT, - 1 CSOL,SOL,MU,ME, - 1 ARMS,JAV,EAV,DAV) -C - NCAACE=.TRUE. !ASSUME OK - J0=1 !ADD ERRORS - DOSC=.FALSE. !NOT SELFCAL - DOAL=.TRUE. !ALIGN - GOTO 10 -C -C ALIGN ERROR CORRECTION -C - ENTRY NCAACC(MAR,NIFR,IFR,BASEL,NDEG, - 1 IRED,WGT,AWGT,CDAT,AMP,PHAS,CMOD,CWGT, - 1 CSOL,SOL,MU,ME, - 1 ARMS,JAV,EAV,DAV) -C - NCAACC=.TRUE. !ASSUME OK - J0=-1 !SUBTRACT ERROR - DOSC=.FALSE. !NOT SELFCAL - DOAL=.TRUE. !ALIGN - GOTO 10 -C -C GET CELESTIAL GAIN/PHASES -C - 10 CONTINUE - IF (DOSC .OR. DOAL) THEN !ALIGN/SELFCAL - DO I=0,NIFR-1 - CELES(I)=CMOD(I,0) - END DO - ELSE - DO I=0,NIFR-1 !ZERO CELESTIAL SOLUTION - CELES(I)=0 - WCELES(I)=0 - END DO - DO I=0,NIFR-1 !CALCULATE - IF (IRED(I).GT.0) THEN !REDUNDANT - IF (WGT(I,0).GT.0) THEN !CAN USE - I1=IRED(I) !POINTER - TE1=IFR(I)/256 !TELESCOPES - TW1=MOD(IFR(I),256) - W2=AWGT(I,0) !WEIGHT - CELES(I1)=CELES(I1)+W2*CDAT(I,0)* - 1 EXP(CMPLX(-CSOL(TW1,0,0)-CSOL(TE1,0,0), - 1 -CSOL(TW1,1,0)+CSOL(TE1,1,0))) !SUM - WCELES(I1)=WCELES(I1)+W2 !SUM WEIGHT - END IF - END IF - END DO - DO I=0,NIFR-1 !SOLVE - IF (WCELES(I).GT.0) CELES(I)=CELES(I)/WCELES(I) - END DO - END IF -C -C INIT -C - DO I=0,1 !GAIN/PHASE - JAV(0,0,I)=0 !NOISE - EAV(0,0,I)=0 - DAV(0,0,I)=0 - JAV(1,0,I)=0 !FRACT. NOISE (INCONS.) - EAV(1,0,I)=0 - DAV(1,0,I)=0 - JAV(4,0,I)=0 !MAX. DEVIATION - EAV(4,0,I)=0 - IF (JAV(2,0,I).NE.0) THEN !TOTAL COUNT - EAV(3,0,I)=SQRT(EAV(2,0,I)/JAV(2,0,I)) !OVERALL RUNNING NOISE - ELSE - EAV(3,0,I)=0 - END IF - END DO -C -C DO FOR IFRS -C - DO I=0,NIFR-1 !ALL IFRS - IF (DOSC .OR. DOAL .OR. IRED(I).GT.0) THEN !REDUNDANT - IF (WGT(I,0).GT.0) THEN !CAN USE - IF (DOSC .OR. DOAL) THEN !ALIGN - I1=I - ELSE - I1=IRED(I) !REDUNDANT POINTER - END IF - TE1=IFR(I)/256 !TELESCOPES - TW1=MOD(IFR(I),256) -C -C ERROR -C - C1=CDAT(I,0)*EXP(CMPLX(-CSOL(TW1,0,0)-CSOL(TE1,0,0), - 1 -CSOL(TW1,1,0)+CSOL(TE1,1,0))) !CORRECTED DATA - C0=C1-CELES(I1) !ERROR - IF (ABS(CELES(I1)).NE.0) THEN - C2=C0/CELES(I1) !070814 - ELSE - C2=0 - END IF - IF (ABS(C1).NE.0) THEN !FRACT. ERROR - C1=2.-CELES(I1)/C1 - IF (ABS(C1).NE.0) THEN - C1=LOG(C1) - ELSE - C1=-10 - END IF - ELSE - C1=0 - END IF - R2=AMP(I,0) !980701 - DO I2=0,1 !GAIN/PHASE - IF (I2.EQ.0) THEN !GAIN - R1=REAL(C0) - R0=REAL(C1) - R3=REAL(C2) !070814 - ELSE !PHASE - R1=AIMAG(C0) - R0=AIMAG(C1) - R3=AIMAG(C2) !070814 - END IF -C -C EXTREME -C - IF (ABS(R0).GT.ABS(EAV(4,0,I2))) THEN !MAX. DEVIATION - EAV(4,0,I2)=R0 - JAV(4,0,I2)=TW1*16+TE1 !WHERE - END IF -C -C NOISE -C - JAV(0,0,I2)=JAV(0,0,I2)+J0 !COUNT - EAV(0,0,I2)=EAV(0,0,I2)+J0*(R1**2) !NOISE - JAV(1,0,I2)=JAV(1,0,I2)+J0 !INCONSISTENCY - EAV(1,0,I2)=EAV(1,0,I2)+J0*(R0**2) - JAV(5,0,I2)=JAV(5,0,I2)+J0 !AVG NOISE - EAV(5,0,I2)=EAV(5,0,I2)+J0*R1 - JAV(6,0,I2)=JAV(6,0,I2)+J0 !AVG INCONSISTENCY - EAV(6,0,I2)=EAV(6,0,I2)+J0*R0 - JAV(2,0,I2)=JAV(2,0,I2)+J0 !AVG RMS - EAV(2,0,I2)=EAV(2,0,I2)+J0*(R1**2) - JAV(I,1,I2)=JAV(I,1,I2)+J0 !IFR AVG NOISE - DAV(I,1,I2)=DAV(I,1,I2)+J0*R1 - EAV(I,1,I2)=EAV(I,1,I2)+J0*R0 !FRACT. NOISE - JAV(I,2,I2)=JAV(I,2,I2)+J0 !IFR AVG RMS - DAV(I,2,I2)=DAV(I,2,I2)+J0*(R1**2) - EAV(I,4,I2)=EAV(I,4,I2)+J0*R0*R2*R2 !980701 070814 091019 - DAV(I,4,I2)=DAV(I,4,I2)+J0*R2*R2 !980701 - END DO - END IF - END IF - END DO -C -C NOISES AND TEL. PHASES -C - DO I2=0,1 !GAIN/PHASE - IF (JAV(0,0,I2).GT.0) THEN !AVERAGE POSSIBLE - EAV(0,0,I2)=SQRT(EAV(0,0,I2)/JAV(0,0,I2)) !NOISE - EAV(1,0,I2)=SQRT(EAV(1,0,I2)/JAV(1,0,I2)) !INCONSISTENCY - DO I=0,STHTEL-1 !PER TELESCOPE - JAV(I,3,I2)=JAV(I,3,I2)+J0 !COUNT - EAV(I,3,I2)=EAV(I,3,I2)+J0*CSOL(I,I2,0) !AVERAGE CORRECTION - DAV(I,3,I2)=DAV(I,3,I2)+J0*CSOL(I,I2,0)*CSOL(I,I2,0) !PHASE RMS - END DO - END IF - END DO -C -C AVERAGE AMPLITUDE -C - JAV(7,0,0)=JAV(7,0,0)+J0 !AVERAGE AMPLITUDE - EAV(7,0,0)=EAV(7,0,0)+J0*DBLE(ARMS(1)) !SUM - DAV(7,0,0)=DAV(7,0,0)+J0*(DBLE(ARMS(1))**2) !RMS -C - RETURN -C -C - END - - - - - - - - - - - - - - - - - - - - diff --git a/src/nscan/ncared.for b/src/nscan/ncared.for deleted file mode 100644 index 35096deba6d21a5566f48740b8fc2e2b33244c1c..0000000000000000000000000000000000000000 --- a/src/nscan/ncared.for +++ /dev/null @@ -1,1572 +0,0 @@ -C+ NCARED.FOR -C WNB 900306 -C -C Revisions: -C WNB 910613 Average data per channel -C WNB 910808 Change call to NCARMD -C WNB 910812 Add ALIGN -C WNB 910816 Add complex -C WNB 910820 Add Histograms -C WNB 910930 Check funny continuity -C WNB 910930 Check extreme values -C GvD 920501 JS is now logical iso. integer (use SWDIS now as well) -C WNB 921104 Cater for full HA range -C WNB 921120 Include scan integration -C WNB 930504 Proper complex solutions -C HjV 930518 Change some text -C WNB 930708 Allow more (8 i.s.o. 3) complex iterations; mesage -C WNB 930825 Add dipole position -C WNB 930826 Use new model data calculation; new redundant -C WNB 931008 Add MINST -C WNB 931123 Use RIN for complex loop determination -C WNB 931126 Add XOSOL test -C CMV 940215 Add tags in printout for reduction group batch files -C CMV 940301 Extra space between HA and X/Y -C CMV 940331 Pass (dummy) telescopes array to NSCSWU -C JPH 940912 Make graphics print depend on SHLV (SHOW_LEVEL -C parameter). Make level 2 the highest. -C JPH 940927 Automatically flag header of bad scan -C JPH 941129 Undo 940927 - this should be done through NFLAG -C JPH 950111 Correct scan number (I --> I2) in reading model scans -C JPH 950126 Restore printing to condition prior to 940912 -C HjV 950609 Add MIFR part -C WNB 950613 Change to new LSQ routines -C WNB 950614 New non-linear routines; change max loop -C WNB 950628 Better logic MIFR errors -C WNB 950629 Correct logics for MIFR write missing interferometers -C JPH 950926 Iteration count !UJ i.s.o. -C JPH 960528 Alphabetise declarations. - Meaningful names for loop -C variables. - CBITS_DEF, CAP_<xxx> -C Compress output of gain/phases and also show on -C terminal. - All HA printout in .01 deg (most were .1). -C - Make print headings/leaders more informative. -C JPH 960607 Merge HjV: Include autocorrelations in MIFR save -C JPH 960802 FL_WGT flag: Reduce data weight -C JPH 960812 No histogram output for SHLVL < 2 -C JPH 961023 CSTNAM=-1 at entry -C Comment out FL_WGT code -C JPH 961212 NSCSCF --> NSCSCR (F does not set weights!) -C Skip solution if No data in scan -C WNB 980701 New MIFR calculations -C WNB 000725 Add variability calculation options polarisation -C WNB 070814 CHANGE MIFR -C WNB 091019 Back to pre-070814 -C -C - SUBROUTINE NCARED -C -C Calculate redundancy solution -C -C Result: -C -C CALL NCARED will calculate the redundancy solution(s) -C -C Include files: -C - INCLUDE 'WNG_DEF' - INCLUDE 'CBITS_DEF' - INCLUDE 'NCA_DEF' - INCLUDE 'LSQ_O_DEF' - INCLUDE 'STH_O_DEF' !sector HEADER - INCLUDE 'SCH_O_DEF' !SCAN HEADER -C -C Parameters: -C - INTEGER MXITCT !DEFAULT COMPLEX ITERATION COUNT - PARAMETER (MXITCT=50) - INTEGER X, Y, XX, XY, YX, YY, G, P - PARAMETER (X=0,Y=1, XX=0,XY=1,YX=2,YY=3, G=0,P=1) - ! loop indices -C -C Arguments: -C -C -C Function references: -C - LOGICAL WNFRD !READ DISK - LOGICAL WNFWR !WRITE DATA - CHARACTER*32 WNTTSG !MAKE SUB-GROUP NAME - REAL WNGENR !NORMALISE ANGLE - LOGICAL WNMLGA !GET LSQ AREA - LOGICAL NSCSTL !GET A sector - LOGICAL NSCSIF !READ IFR TABLE - LOGICAL NSCSCR,NSCSCF !READ DATA FROM SCAN - LOGICAL NSCSWU !WRITE CORRECTION RESULTS - LOGICAL NCARMD !GET DATA IN CORRECT FORMAT - LOGICAL NCARGS,NCARG2 !GAIN SOLUTION - LOGICAL NCARPS,NCARP2 !PHASE SOLUTION - LOGICAL NCASGS,NCASPS !SELFCAL SOLUTION - LOGICAL NCAAGS,NCAAPS !ALIGN SOLUTION - LOGICAL NCARCS,NCASCS,NCAACS !COMPLEX SOLUTION - LOGICAL NMOMSL !MODEL CALCULATION IN SCAN - LOGICAL NMORDH !GET MODEL HEADER DATA -C -C Data declarations: -C - INTEGER ICS, IFR, IGP, ISCN, ISCN1, ITL, ITL1 -C - REAL ANG(0:2,0:STHIFR-1) - REAL ARMS(0:2,0:1) !AVER. AMPL. XX,YY - REAL CSRMS(0:2,0:3,0:2) !AVER. XX,..., A,C,S - REAL AWGT(0:STHIFR-1,0:1) !AMPLITUDE WEIGHTED WEIGHTS X,Y - REAL BASEL(0:STHIFR-1) !BASELINE TABLE - BYTE BTMP - COMPLEX CAMOD(0:STHIFR-1,0:3) !SOURCE MODEL XYX - COMPLEX CDAT(0:STHIFR-1,0:1) !DATA COMPLEX X,Y - REAL CEQ(0:STHTEL-1,0:STHTEL-1,0:1,0:1) !CONSTRAINT EQUATIONS G,P X,Y - COMPLEX CMOD(0:3,0:STHIFR-1) !SOURCE MODEL I,Q,U,V - REAL CSOL(0:STHTEL-1,0:1,0:1) !CONTINUITY SOLUTION G,P X,Y - INTEGER CSTNAM(0:7) !CHECK sector NAME - DATA CSTNAM/8*-1/ - REAL DAMP(0:STHIFR-1,0:1) ! DATA AMPL. X,Y - REAL DAT(0:1,0:STHIFR-1,0:3) ! DATA XX,XY,YX,YY - REAL DAT1(0:1,0:STHIFR-1,0:3) ! DATA XX,XY,YX,YY - INTEGER FLW(0:STHIFR-1,0:3) ! flags XX,XY,YX,YY - REAL DPHAS(0:STHIFR-1,0:1) ! DATA PHASE X,Y - REAL DWGT(0:STHIFR-1,0:1) ! DATA WEIGHT X,Y - INTEGER DAV0(0:STHIFR-1) ! scaled copy for printing - INTEGER EAV0(0:STHIFR-1) ! scaled copy for printing - LOGICAL FLGERR(0:3,0:1) ! ERRORS G,P,C X,Y - DOUBLE PRECISION FRQ0 ! BASIC FREQUENCY - CHARACTER*8 GPTXT(0:1) ! GAIN/PHASE - DATA GPTXT/'gain','phase'/ - REAL HA !HA OF SCAN - INTEGER HISBAD(0:2,0:1) !HISTOGRAMS X,Y - INTEGER IFRA(0:1,0:STHIFR-1) - INTEGER*2 IFRT(0:STHIFR-1) !INTERFEROMETER TABLE - INTEGER IXY !POL. COUNT - CHARACTER*1 IPC(0:1) !CURRENT DIPOLE - DATA IPC/'X','Y'/ - INTEGER IRED(0:STHIFR-1) !REDUNDANT INTERFEROMETERS - INTEGER ITCNT,ITCNT1 !ITERATION COUNT - REAL LM0(0:1) !BASIC SOURCE DISPLACEMENT - INTEGER MAR(0:1),CMAR !MATRIX AREAS GAIN/PHASE - INTEGER MAR1(0:1) - INTEGER MAR2(0:1),CMAR2(0:1) - REAL ME !M.E. - REAL MENS(0:1,0:1) !SCAN NOISE G,P X,Y - INTEGER MINST !INSTRUMENT - REAL MU !ADJUSTMENT ERROR - INTEGER NDEG(0:1,0:1,0:1) !DEGENERACY GAIN,PHASE X,Y - INTEGER NPOL !# OF POL. - INTEGER NRINT !# OF SCANS INTEGRATED - INTEGER NTINT !# OF SCANS TO INTEGRATE - REAL RAWGT(0:STHIFR-1) !SELFCAL WEIGHTS - REAL SAVSOL(0:STHTEL-1,0:1) !SAVE SOLUTION G,P - BYTE SCH(0:SCH__L-1) !SCAN HEADER - INTEGER*2 SCHI(0:SCH__L/LB_I-1) - INTEGER SCHJ(0:SCH__L/LB_J-1) - REAL SCHE(0:SCH__L/LB_E-1) - DOUBLE PRECISION SCHD(0:SCH__L/LB_D-1) - EQUIVALENCE(SCH,SCHI,SCHJ,SCHE,SCHD) - INTEGER SETNAM(0:7) !FULL sector NAME - REAL SOL(0:STHTEL-1,0:1,0:1) !SOLUTION X,Y GAIN,PHASE - DOUBLE PRECISION SRA,SDEC,SFRQ !SOURCE RA, DEC, FREQ - BYTE STH(0:STH__L-1) !sector HEADER - INTEGER*2 STHI(0:STH__L/LB_I-1) - INTEGER STHJ(0:STH__L/LB_J-1) - REAL STHE(0:STH__L/LB_E-1) - DOUBLE PRECISION STHD(0:STH__L/LB_D-1) - EQUIVALENCE(STH,STHI,STHJ,STHE,STHD) - INTEGER STHP ! STH, SCH pointers - INTEGER STP !SOURCE TYPE - LOGICAL SWDIS !DISCARD? - CHARACTER*16 TELNAM !TEL. NAMES - CHARACTER*1 TELNMA(0:15) - EQUIVALENCE (TELNAM,TELNMA) - DATA TELNAM/'0123456789ABCDEF'/ - CHARACTER*20 TEXT ! message text buffer - REAL TF(0:1) !INTEGR. TIME, BANDWIDTH - REAL UV0(0:3) !BASIC UV COORDINATES - REAL WGT(0:STHIFR-1,0:3) !DATA WEIGHTS XX,XY,YX,YY - REAL WGT1(0:STHIFR-1,0:3) !DATA WEIGHTS XX,XY,YX,YY - INTEGER N !DATA COUNTS - REAL R2,R3 -C!091019 COMPLEX C0 !WNB070814 -C- -C -C INIT -C - JS=.TRUE. - CSTNAM(0)=-1 -!= I=IGP - DO IGP=0,1 - MAR(IGP)=0 - IF (JS) JS=WNMLGA(MAR(IGP),LSQ_T_REAL,STHTEL) - !MATRIX AREAS - MAR1(IGP)=0 - IF (JS) JS=WNMLGA(MAR1(IGP),LSQ_T_REAL,2*STHTEL) - END DO - CMAR=0 - IF (JS) JS=WNMLGA(CMAR,LSQ_T_COMPLEX,STHTEL) - IF (.NOT.JS) THEN - CALL WNCTXT(F_TP,'ERROR: no memory for works paces') - GOTO 901 - END IF -!= I=IGP I1=ITL - DO ITL=0,1 - DO IGP=0,2 !HISTO AREAS - CALL WNMHS8(HISBAD(IGP,ITL),1,1.) - END DO - END DO -! - DO I1=0,STHTEL-1 - TELS(I1)=.TRUE. - END DO -C -C HEADINGS -C - CALL WNCFHD(F_P,3,'Node:!AS File:!AS',NODOUT,FILOUT) - IF (APSOL(0) .OR. APSOL(1)) THEN - CALL WNCFHD(F_P,5, ' HA Rk A(%) P(deg) A(WU) P(WU) '// - 1 ' Amax Aavg Arms dAmax(%) dPmax(d) I') - !HEADER - ELSE - CALL WNCFHD(F_P,5, ' HA Amax Aavg Arms'// - 1 ' Cmax Cavg Crms Smax Savg Srms') - END IF - CALL WNCFHD(F_P,6,' ') - IF (IAND(SHLV(2),F_T).NE.0) THEN !LIST WANTED - IF (APSOL(0) .OR. APSOL(1)) THEN - CALL WNCTXT(F_T,'!/ HA Rk A(%) P(deg) A(WU) P(WU) '// - 1 ' Amax Aavg Arms dAmax(%) dPmax(d) I!/') - ELSE - CALL WNCTXT(F_T,'!/ HA Amax Aavg Arms'// - 1 ' Cmax Cavg Crms Smax Savg Srms!/') - END IF - END IF - CALL WNCTXT(F_P,'!^') !NEW PAGE -C -C CLEAR ARRAYS -C -!= I=IFR I2=IGP I3=IXY - DO IXY=0,1 !CLEAR NOISES X,Y - DO IGP=0,1 !GAIN/PHASE - DO I1=0,4 !DATA TYPES - DO IFR=0,STHIFR-1 !# IFRS - JAV(IFR,I1,IGP,IXY)=0 - EAV(IFR,I1,IGP,IXY)=0E0 - DAV(IFR,I1,IGP,IXY)=0D0 - END DO - END DO - END DO - END DO -!= I1=IGP I2=IXY - DO IGP=0,1 !CLEAR RANK CHECK G/P - DO IXY=0,1 !X,Y - NDEG(IXY,1,IGP)=0 - END DO - END DO -C -C FORCED PHASES -C -!= I1=ITL I2=IGP I3=IXY - DO IXY=0,1 !CONTINUITY SOL. X,Y - DO IGP=0,1 !G,P - DO ITL=0,STHTEL-1 !TEL. - IF (IGP.EQ.0) THEN !GAIN - CSOL(ITL,IGP,IXY)=0. - ELSE !PHASE - CSOL(ITL,IGP,IXY)=FORPER(ITL) - END IF - END DO - END DO - END DO -C -C INIT ERROR FLAGS -C -!= I1=IXY I2=IGP - DO IXY=0,1 !X,Y - DO IGP=0,3 !G,P,C - FLGERR(IGP,IXY)=.TRUE. - END DO - END DO -C -C MODEL INIT -C - IF (DOALG) THEN - IF (.NOT.NMOMSL(FCAOUT,SETS,LPOFF)) THEN - !CALCULATE MODEL - CALL WNCTXT(F_TP,'!/Error in model calculation') - GOTO 900 !STOP - END IF - END IF -C -C ALIGN INIT -C - JS=.TRUE. -!= I=IGP - DO IGP=0,1 !CLEAR LSQ AREAS - MAR2(IGP)=0 - CMAR2(IGP)=0 - END DO - IF (DOALG .AND. .NOT.DOSCAL) THEN !ALIGN -!= I=IGP I1=ITL I2=ITL1 - DO IGP=0,1 !GAIN/PHASE - DO ITL=0,STHTEL-1 !ZERO EQUATIONS - DO ITL1=0,STHTEL-1 - CEQ(ITL1,ITL,IGP,0)=0 - CEQ(ITL1,ITL,IGP,1)=0 - END DO - END DO - IF (FORFRE(IGP)) THEN !FORCE FREEDOM - J=0 !COUNT EQUATIONS - DO ITL=0,STHTEL-1 !ALL FREEDOMS - IF (FREGPH(ITL,IGP).LE.STHTEL .AND. - 1 FREGPH(ITL,IGP).GT.0) THEN - !SELECTED - J=MAX(0,FREGPH(ITL,IGP)) !FIND # OF EQUATIONS - CEQ(ITL,FREGPH(ITL,IGP)-1,IGP,0)=1 - CEQ(ITL,FREGPH(ITL,IGP)-1,IGP,1)=1 - END IF - END DO - NDEG(IGP,1,0)=J !SAVE # OF EQUATIONS - NDEG(IGP,1,1)=J !FOR Y - IF (JS) JS=WNMLGA(MAR2(IGP),LSQ_T_REAL,NDEG(IGP,1,0)) - !GET LSQ AREA - IF (JS) JS=WNMLGA(CMAR2(IGP),LSQ_T_COMPLEX,NDEG(IGP,1,0)) - END IF - END DO - END IF - IF (.NOT.JS) THEN - CALL WNCTXT(F_TP,'ERROR: No space for aligning') - GOTO 902 - END IF - -C -C DO sectors -C - DO WHILE(NSCSTL(FCAOUT,SETS,STH(0),STHP,SETNAM,LPOFF)) - !NEXT sector -C -C GET IFR TABLES -C - IF (.NOT.NSCSIF(FCAOUT,STH,IFRT,IFRA,ANG)) THEN - !READ IFR TABLE - CALL WNCTXT(F_TP,'!/Error reading IFR table !AS', - 1 WNTTSG(SETNAM,0)) - GOTO 20 !TRY NEXT SET - END IF - CALL NSCMBL(STHE(STH_RTP_E),STHJ(STH_NIFR_J),IFRT, - 1 SIFRS,BASEL) !MAKE BASEL. - CALL NCARRT(STHJ(STH_NIFR_J),BASEL,BASDEV,IRED(0),ANG) - !GET REDUN. - IF (DOALG) !GET SELFCAL WEIGHTS - 1 CALL NCARAW(MWGT,MWGTD,STHJ(STH_NIFR_J),BASEL,RAWGT) -C -C SHOW CURRENT sector -C - DO I1=0,3 - IF (CSTNAM(I1).NE.SETNAM(I1)) THEN - DO I2=0,3 - CSTNAM(I2)=SETNAM(I2) - END DO - CALL WNCTXT(SHLV(1),'Sector: !AS',WNTTSG(CSTNAM,3)) - END IF - END DO -C -C SOURCE MODEL -C - NPOL=STHI(STH_PLN_I) !# OF POL. - IF (DOALG) THEN !MODEL PRESENT - IF (.NOT.NMORDH(6,STP,SRA,SDEC,SFRQ)) GOTO 20 - !MODEL PARAMETERS - CALL NMOMST(STP,SRA,SDEC,STH,LM0,FRQ0,TF,MINST) - !GET SOME DATA - END IF -C -C ALIGN DATA -C - IF (DOALG .AND. .NOT.DOSCAL) THEN !ALIGN - IF (FORFRE(1)) THEN !FORCED PHASE FREEDOM -!= I2=ITL - DO I1=0,NDEG(1,1,0)-1 !SET ALL EQUATIONS - DO ITL=0,STHTEL-1 - IF (CEQ(ITL,I1,1,0).NE.0) THEN!SET CORRECT SLOPE - CEQ(ITL,I1,1,0)=(STHE(STH_RTP_E+ITL)-STHE(STH_RTP_E))/72. - CEQ(ITL,I1,1,1)=CEQ(ITL,I1,1,0) - END IF - END DO - END DO - END IF - END IF -C -C DO SCANS -C - NTINT=MAX(1,NINT(HAINT/24./3600./STHE(STH_HAI_E))) - !# TO INTEGRATE -!= I=ISCN - DO ISCN=0,STHJ(STH_SCN_J)-1,NTINT !ALL SCANS -C -C INIT -C - HA=STHE(STH_HAB_E)+ISCN*STHE(STH_HAI_E) - !HA OF first SCAN - IF (HA.LT.HARAN(1) .OR. HA.GT.HARAN(2)) GOTO 30 - !FORGET -C -C GET FIRST DATA -C - IF (.NOT.NSCSCF(FCAOUT,STH,IFRT,ISCN,CORAP,CORDAP, - 1 SCH,WGT,DAT,FLW)) THEN ! flags, first scan - 19 CONTINUE - CALL WNCTXT(F_TP,' !6$EAF7.2 Error reading scan data',HA) - GOTO 20 ! TRY NEXT sector - END IF - IF (.NOT.NSCSCR(FCAOUT,STH,IFRT,ISCN,CORAP,CORDAP, - 1 SCH,WGT,DAT)) GOTO 19 ! weighted data, first scan -CC DO IXY=0,3,3 -CC DO IFR=0,STHJ(STH_NIFR_J)-1 -CC IF (IAND(FLW(IFR,IXY),FL_WGT) ! honour FL_WGT flag -CC 1 .NE.0) WGT(IFR,IXY)=WGT(IFR,IXY)*DOWNWT -CC END DO -CC END DO -C -C GET FIRST SOURCE MODEL -C - IF (DOALG) THEN !MODEL PRESENT - CALL NMOMUV(STP,SRA,SDEC,STH,SCH,UV0) - !GET UV DATA - CALL NMOMU4(0,FCAOUT,ISCN,STH,UV0,LM0,FRQ0, - 1 STHE(STH_RTP_E),NPOL,STHJ(STH_NIFR_J), - 1 IFRT,TF,MINST,CMOD) !GET MODEL - CALL NMOCIX(STHJ,SCHE,ANG,CAMOD,CMOD) - !MAKE XYX MODEL DATA - END IF -C -C INTEGRATE -C -!= I=ISCN I2=ISCN1 I1=IFR I4=ICS IP=IXY - NRINT=1 ! 1 done - DO ISCN1=ISCN+1,ISCN+NTINT-1 ! read following scans - IF (NSCSCF(FCAOUT,STH,IFRT,ISCN1,CORAP,CORDAP, - 1 SCH,WGT1,DAT1,FLW)) THEN ! ... flags - IF (NSCSCR(FCAOUT,STH,IFRT,ISCN1,CORAP,CORDAP, - 1 SCH,WGT1,DAT1)) THEN ! ... data - DO IXY=0,3 ! XX AND YY -- WNB ADD XY AND YX - DO IFR=0,STHJ(STH_NIFR_J)-1 - IF (WGT(IFR,IXY).LE.0 .OR. - 1 WGT1(IFR,IXY).LE.0) THEN - DO ICS=0,1 - DAT(ICS,IFR,IXY)=0. - END DO - WGT(IFR,IXY)=0 - ELSE -CC IF (IAND(FLW(IFR,IXY),FL_WGT).NE.0) -CC 1 WGT1(IFR,IXY)=WGT1(IFR,IXY)*DOWNWT -CC ! honour FL_WGT flag - DO ICS=0,1 - DAT(ICS,IFR,IXY)=(WGT(IFR,IXY)*DAT(ICS,IFR,IXY)+ - 1 WGT1(IFR,IXY)*DAT1(ICS,IFR,IXY))/ - 1 (WGT(IFR,IXY)+WGT1(IFR,IXY)) - END DO - WGT(IFR,IXY)=WGT(IFR,IXY)+WGT1(IFR,IXY) - !NEW WEIGHT - END IF - END DO - END DO - IF (DOALG) THEN !MODEL PRESENT - CALL NMOMUV(STP,SRA,SDEC,STH,SCH,UV0) - !GET UV DATA - CALL NMOMU4(0,FCAOUT,ISCN1,STH,UV0,LM0,FRQ0, - 1 STHE(STH_RTP_E),NPOL,STHJ(STH_NIFR_J), - 1 IFRT,TF,MINST,CMOD) !GET MODEL - CALL NMOCIY(STHJ,SCHE,ANG,CAMOD,CMOD, - 1 NRINT,1) !AVERAGE MODEL XYX - END IF - NRINT=NRINT+1 !COUNT INTEGRATIONS - ELSE - GOTO 21 - ENDIF - ELSE - GOTO 21 !NO MORE - END IF - END DO - 21 CONTINUE - HA=STHE(STH_HAB_E)+(ISCN+(NRINT-1.)/2.)* - 1 STHE(STH_HAI_E) !HA OF INTEGRATED SCAN -C -C MAKE CORRECT DATA -C -!= I=ISCN IP=IXY - DO IXY=0,1 !X,Y - ARMS(0,IXY)=0 !sector NOT PRESENT - IF (IXY.EQ.0) THEN !X - IF (XYSOL(0).EQ.0) GOTO 10 !NO X WANTED - ELSE !Y - IF (XYSOL(1).EQ.0) GOTO 10 !NO Y WANTED - IF (STHI(STH_PLN_I).LE.1) GOTO 10 - !NO YY PRESENT - END IF - IF (.NOT.NCARMD(STHJ(STH_NIFR_J),IFRT,3*IXY,WGT,DAT, - 1 SIFRS,WGTMIN, - 1 DWGT(0,IXY),AWGT(0,IXY),CDAT(0,IXY),DAMP(0,IXY), - 1 DPHAS(0,IXY),ARMS(0,IXY))) THEN - !MAKE DATA - TEXT='scan' - IF (NTINT.GT.1) - 1 CALL WNCTXS(TEXT,'!UJ integrated scans', NTINT) - CALL WNCTXT(SHLV(1),' !6$EAF7.2 !AS '// - 1 'No data in !AS',HA,IPC(IXY),TEXT) - END IF - 10 CONTINUE ! NEXT POL. - END DO -C -C WNB 000725 -- Make various averages -C -C -C GET WEIGHTS -C - DO I1=0,2 !MAX, AVER, RMS - DO IXY=0,3 !XX etc - DO I2=0,2 !A, C, S - CSRMS(I1,IXY,I2)=0 !CLEAR - END DO - END DO - END DO - DO IXY=0,3 !XX,XY,YX,YY - DO I2=0,2 !A,C,S - D0=0 !RMS - R0=0 !MAX. WEIGHT - R1=0 - N=0 !COUNT - DO I=0,STHJ(STH_NIFR_J)-1 !ALL IFRS - R2=0 !ASSUME ZERO WEIGHT - R3=0 - IF (WGT(I,IXY).GT.0 .AND. !DATA PRESENT - 1 SIFRS(IFRT(I)/256,MOD(IFRT(I),256)).NE.0) THEN !IFR SELECTED - IF (I2.EQ.0) THEN - D1=ABS(CMPLX(DAT(0,I,IXY),DAT(1,I,IXY))) !AMPL - ELSE IF (I2.EQ.1) THEN - D1=DAT(0,I,IXY) !COS - ELSE - D1=DAT(1,I,IXY) !SIN - END IF - R2=SQRT(WGT(I,IXY)) !WEIGHT - IF (R2.GT.0) THEN - R3=R2*D1 - R0=MAX(R0,R2) !GET MAXIMA - R1=MAX(R1,R3) - CSRMS(0,IXY,I2)=MAX(CSRMS(0,IXY,I2),ABS(D1)) - CSRMS(1,IXY,I2)=CSRMS(1,IXY,I2)+D1 !AVERAGE - D0=D0+D1*D1 !RMS - N=N+1 !COUNT - END IF - END IF - END DO -C -C CHECK DATA PRESENCE -C - IF (CSRMS(0,IXY,I2).NE.0) THEN !DATA PRESENT -C -C NORMALISE WEIGHT -C - DO I=0,STHJ(STH_NIFR_J)-1 - IF (R2.GT.0) THEN - R2=(R2/R0)**2 - R3=R3/R1 - IF (R3.LT.WGTMIN) THEN !FORGET POINT - R2=0 - R3=0 - N=N-1 !CORRECT AVERAGES - CSRMS(1,IXY,I2)=CSRMS(1,IXY,I2)-D1 - D0=D0-D1*D1 - ELSE - R3=R3**2 - END IF - END IF - END DO -C -C CALCULATE AMPL. STATISTICS -C - IF (N.LE.0) THEN !NO DATA LEFT - CSRMS(0,IXY,I2)=0 - ELSE - CSRMS(1,IXY,I2)=CSRMS(1,IXY,I2)/N !AVER. AMPL - CSRMS(2,IXY,I2)=SQRT(ABS(D0- - 1 CSRMS(1,IXY,I2)*CSRMS(1,IXY,I2)*N)/N) !RMS - END IF - END IF - END DO - END DO -C -C -C NOTE (JPH 961212): -C The course to take in the absence of data is not clear. As is, the code -C copies the corrections from the previous integration interval (at least in -C some cases that I have seen). Since the error is reported correctly, this -C behaviour is probably intended. It is also in tune with what happens for a -C no-data scan in an integration interval. -C One may argue that instead it would be better to be honest and leave -C the corrections undefined. At any rate, it is not clear what implications a -C change in the code might have... -C -C RESET CONTINUITY -C User parameter CONTINUITY: If NO, CSOLVE=.false.. -C If this is so, the gain and phase values from a -C previous run are discarded by resetting CSOL(*,0, ) to 0 (phase) and -C CSOL(*,1, ) to the forcing phases. The same is done if the -C previous run left an error status. -C -C - IF (.NOT.CSOLVE) THEN !NO CONTINUITY -!= I=ISCN I1=IXY I2=IGP I3=ITL - DO IXY=0,1 !X,Y - DO ITL=0,STHTEL-1 !TELESCOPES - CSOL(ITL,0,IXY)=0 - CSOL(ITL,1,IXY)=FORPER(ITL) - END DO - END DO - ELSE !RESET AFTER ERRORS - DO IXY=0,1 !X,Y - IF (.NOT.FLGERR(0,IXY) .OR. .NOT.FLGERR(1,IXY)) THEN - !RESET - DO ITL=0,STHTEL-1 - CSOL(ITL,0,IXY)=0 !GAIN - CSOL(ITL,1,IXY)=FORPER(ITL) !PHASE - END DO - END IF - END DO - END IF -C -C INIT ERROR FLAGS -C -!= I=ISCN I1=IXY I2=IGP - DO IXY=0,1 !X,Y - DO IGP=0,3 !G,P,C - FLGERR(IGP,IXY)=.TRUE. - END DO - END DO -!= -C -C XYSOL(X=0:Y=1) indicates which of XX and YY polarisations -C must be processed -C APSOL(gn=0:ph=1) does the same for gain, phase -C XOSOL indicates complex-only processing -C DOALG: align or selfcal -C DOSCAL: selfcal -C SWDIS: A local switch to check if any solution branch is taken -C FORFRE: -C -C CSOL is the accumulated solution that is used as starting point, SOL is the -C increment calculated in the present iteration -C -C The routines called are organised in families NCA<x><y><z> where <x> is R, S -C or A for Redun/Selfcal/Align, <y> is G, P, C for gain/phase/complex, -C <z> has no specific meaning -C -C SOLVE WITH Stokes Q=0 -C - ITCNT1=0 !ITERATION COUNT - IF (XYSOL(0).NE.0 .AND. XYSOL(1).NE.0 .AND. - 1 ARMS(0,0).NE.0 .AND. - 1 ARMS(0,1).NE.0) THEN !XX AND YY PRESENT - IF (APSOL(0) .AND. .NOT.DOALG .AND. .NOT.XOSOL) THEN - !DO GAIN - ITCNT1=ITCNT1+1 - IF (.NOT.NCARG2(MAR1(0),STHJ(STH_NIFR_J),IFRT,BASEL, - 1 I1,IRED(0),DWGT(0,0),AWGT(0,0),CDAT(0,0), - 1 DAMP(0,0),DPHAS(0,0),CAMOD(0,0),RAWGT(0), - 1 CSOL(0,0,0),SOL(0,0,0),MU,ME)) THEN - !GET GAIN SOLUTION - ELSE -!= I=ISCN I1=IXY I2=ITL - DO IXY=0,1 !MAKE CONTINUITY X/Y - DO ITL=0,STHTEL-1 - CSOL(ITL,0,IXY)=CSOL(ITL,0,IXY)+SOL(ITL,IXY,0) - END DO - END DO - END IF -! - END IF - IF (APSOL(1) .AND. .NOT.DOALG .AND. .NOT.XOSOL) THEN - !DO PHASE - ITCNT1=ITCNT1+1 - IF (.NOT.NCARP2(MAR1(1),STHJ(STH_NIFR_J),IFRT,BASEL, - 1 IXY,IRED(0),DWGT(0,0),AWGT(0,0),CDAT(0,0), - 1 DAMP(0,0),DPHAS(0,0),CAMOD(0,0),RAWGT(0), - 1 CSOL(0,0,0),SOL(0,0,0),MU,ME)) THEN - !GET PHASE SOLUTION - ELSE -!= I=ISCN I1=IXY I2=ITL - DO IXY=0,1 !MAKE CONTINUITY - DO ITL=0,STHTEL-1 - CSOL(ITL,1,IXY)=CSOL(ITL,1,IXY)+SOL(ITL,IXY,1) - END DO - END DO -! - END IF - END IF - END IF -C -C SOLVE X, Y -C -C The following IXY loop contains a gain section followed by a phase section, -C the two being identical except for a few index values changing from 0 to 1 -C and the use of either NCA<x>G<z> or NCA<x>P<z> routines -C -!= IP=IXY - DO IXY=0,1 -!! print *,ixy - ITCNT=ITCNT1 - IF (ARMS(0,IXY).NE.0) THEN !CAN DO -C -C Gain -C - IF (APSOL(0) .AND. .NOT.XOSOL) THEN - !DO GAIN - SWDIS=.TRUE. !DISCARD -C Redun gain - IF (.NOT.DOALG) THEN - SWDIS=.FALSE. - JS=NCARGS(MAR(0),STHJ(STH_NIFR_J),IFRT,BASEL, - 1 NDEG(0,0,IXY),IRED(0),DWGT(0,IXY),AWGT(0,IXY), - 1 CDAT(0,IXY),DAMP(0,IXY),DPHAS(0,IXY), - 1 CAMOD(0,3*IXY),RAWGT(0), - 1 CSOL(0,0,IXY),SOL(0,IXY,0),MU,ME) -C Selfcal gain - ELSE IF (DOSCAL) THEN - SWDIS=.FALSE. - JS=NCASGS(MAR(0),STHJ(STH_NIFR_J),IFRT,BASEL, - 1 NDEG(0,0,IXY),IRED(0),DWGT(0,IXY),AWGT(0,IXY), - 1 CDAT(0,IXY),DAMP(0,IXY),DPHAS(0,IXY), - 1 CAMOD(0,3*IXY),RAWGT(0), - 1 CSOL(0,0,IXY),SOL(0,IXY,0),MU,ME) -C Full align gain - ELSE IF (.NOT.FORFRE(0)) THEN - SWDIS=.FALSE. - JS=NCARGS(MAR(0),STHJ(STH_NIFR_J),IFRT,BASEL, - 1 NDEG(0,0,IXY),IRED(0),DWGT(0,IXY),AWGT(0,IXY), - 1 CDAT(0,IXY),DAMP(0,IXY),DPHAS(0,IXY), - 1 CAMOD(0,3*IXY),RAWGT(0), - 1 CSOL(0,0,IXY),SOL(0,IXY,0),MU,ME) - !GET GAIN SOLUTION - END IF -C - IF (.NOT.SWDIS) THEN ! valid solution? - ITCNT=ITCNT+1 - IF (.NOT.JS) THEN - IF (SHLV(1).NE.0) - 1 CALL WNCTXT(SHLV(1), - 1 ' !6$EAF7.2 !AS Cannot solve gain',HA,IPC(IXY)) - FLGERR(0,IXY)=.FALSE. - ELSE !SET ERRORS -!= I=ISCN I1=IXY I2=ITL IP=IXY - DO ITL=0,STHTEL-1 !MAKE CONTINUITY - CSOL(ITL,0,IXY)=CSOL(ITL,0,IXY)+SOL(ITL,IXY,0) - END DO -!= IP=IXY - END IF - END IF - END IF -C -C Phase -C - IF (APSOL(1) .AND. .NOT.XOSOL) THEN - !DO PHASE - SWDIS=.TRUE. !DISCARD -C Redun phase - IF (.NOT.DOALG) THEN - SWDIS=.FALSE. - JS=NCARPS(MAR(1),STHJ(STH_NIFR_J),IFRT,BASEL, - 1 NDEG(1,0,IXY),IRED(0),DWGT(0,IXY),AWGT(0,IXY), - 1 CDAT(0,IXY),DAMP(0,IXY),DPHAS(0,IXY), - 1 CAMOD(0,3*IXY),RAWGT(0), - 1 CSOL(0,0,IXY),SOL(0,IXY,1),MU,ME) -C Selfcal phase - ELSE IF (DOSCAL) THEN - SWDIS=.FALSE. - JS=NCASPS(MAR(1),STHJ(STH_NIFR_J),IFRT,BASEL, - 1 NDEG(1,0,IXY),IRED(0),DWGT(0,IXY),AWGT(0,IXY), - 1 CDAT(0,IXY),DAMP(0,IXY),DPHAS(0,IXY), - 1 CAMOD(0,3*IXY),RAWGT(0), - 1 CSOL(0,0,IXY),SOL(0,IXY,1),MU,ME) -C Full align phase - ELSE IF (.NOT.FORFRE(1)) THEN - SWDIS=.FALSE. - JS=NCARPS(MAR(1),STHJ(STH_NIFR_J),IFRT,BASEL, - 1 NDEG(1,0,IXY),IRED(0),DWGT(0,IXY),AWGT(0,IXY), - 1 CDAT(0,IXY),DAMP(0,IXY),DPHAS(0,IXY), - 1 CAMOD(0,3*IXY),RAWGT(0), - 1 CSOL(0,0,IXY),SOL(0,IXY,1),MU,ME) - END IF -C - IF (.NOT.SWDIS) THEN ! valid solution? - ITCNT=ITCNT+1 - IF (.NOT.JS) THEN - IF (SHLV(1).NE.0) - 1 CALL WNCTXT(SHLV(1), - 1 ' !6$EAF7.2 !AS Cannot solve phase',HA,IPC(IXY)) - FLGERR(1,IXY)=.FALSE. - ELSE !SET ERRORS -!= I=ISCN I2=ITL - DO ITL=0,STHTEL-1 !MAKE CONTINUITY - CSOL(ITL,1,IXY)=CSOL(ITL,1,IXY)+SOL(ITL,IXY,1) - END DO -! - END IF - END IF - END IF -C -C GET CONSTRAINTS -C - IF (DOALG .AND. .NOT.DOSCAL .AND. - 1 FORFRE(0)) THEN - ELSE ! GET CONSTRAINTS - IF (NDEG(0,0,IXY).NE.NDEG(0,1,IXY)) THEN - ! GAIN - CALL WNMLGC(MAR(0),J,CEQ(0,0,0,IXY)) - ! GET CONSTRAINT EQS - IF (SHLV(2).NE.0) THEN ! SHOW - CALL WNCTXT(SHLV(2), - 1 ' !6$EAF7.2 !AS New gain constraints:', - 1 HA,IPC(IXY)) - DO I1=0,NDEG(0,0,IXY)-1 - CALL WNCTXT(SHLV(2),'!80$10Q1!10C\!4$#E7.0', - 1 STHTEL,CEQ(0,I1,0,IXY)) - END DO - END IF - NDEG(0,1,IXY)=NDEG(0,0,IXY) !NEW CHECK - END IF - IF (NDEG(1,0,IXY).NE.NDEG(1,1,IXY)) THEN - !PHASE - CALL WNMLGC(MAR(1),J,CEQ(0,0,1,IXY)) - !GET CONSTRAINT EQS - IF (SHLV(2).NE.0) THEN !SHOW - CALL WNCTXT(SHLV(2), - 1 ' !6$EAF7.2 !AS New phase constraints:', - 1 HA,IPC(IXY)) - DO I1=0,NDEG(1,0,IXY)-1 - CALL WNCTXT(SHLV(2),'!80$10Q1!10C\!4$#E7.0', - 1 STHTEL,CEQ(0,I1,1,IXY)) - END DO - END IF - NDEG(1,1,IXY)=NDEG(1,0,IXY) !NEW CHECK - END IF - END IF -C -C ALIGN only -C Init ALIGN -C - IF (DOALG .AND. .NOT.DOSCAL) THEN - JS=.TRUE. -!= I=ISCN I2=IGP - DO IGP=0,1 - IF (APSOL(IGP)) THEN !DO GAIN/PHASE - IF (.NOT.FORFRE(IGP)) THEN - !NEED LSQ AREA - IF (JS) JS=WNMLGA(MAR2(IGP),LSQ_T_REAL, - 1 NDEG(IGP,1,IXY)) - !GET LSQ AREA - IF (JS) JS=WNMLGA(CMAR2(IGP),LSQ_T_COMPLEX, - 1 NDEG(IGP,1,IXY)) - END IF - END IF - END DO -! - IF (.NOT.JS) THEN - CALL WNCTXT(F_TP,'ERROR: Cannot align: no workspace') - GOTO 902 - END IF -!! END IF -C - -!! IF (DOALG .AND. .NOT.DOSCAL) THEN - IF (APSOL(0) .AND. .NOT.XOSOL) THEN -C -C Do ALIGN gain -C ITCNT=ITCNT+1 - IF (.NOT.NCAAGS(MAR2(0),STHJ(STH_NIFR_J),IFRT,BASEL, - 1 J,IRED(0),DWGT(0,IXY),AWGT(0,IXY), - 1 CDAT(0,IXY),DAMP(0,IXY),DPHAS(0,IXY), - 1 CAMOD(0,3*IXY),RAWGT(0), - 1 CSOL(0,0,IXY),SOL(0,IXY,0),MU,ME, - 1 NDEG(0,1,IXY),CEQ(0,0,0,IXY))) THEN - !GET GAIN SOLUTION - IF (SHLV(1).NE.0) CALL WNCTXT(SHLV(1), - 1 ' !6$EAF7.2 !AS Cannot solve gain',HA,IPC(IXY)) - FLGERR(0,IXY)=.FALSE. - ELSE !SET ERRORS -!= I=ISCN I2=ITL - DO ITL=0,STHTEL-1 !MAKE CONTINUITY - CSOL(ITL,0,IXY)=CSOL(ITL,0,IXY)+SOL(ITL,IXY,0) - END DO - END IF -! - END IF -C -C Do ALIGN phase -C - IF (APSOL(1) .AND. .NOT.XOSOL) THEN - ITCNT=ITCNT+1 - IF (.NOT.NCAAPS(MAR2(1),STHJ(STH_NIFR_J),IFRT,BASEL, - 1 J,IRED(0),DWGT(0,IXY),AWGT(0,IXY), - 1 CDAT(0,IXY),DAMP(0,IXY),DPHAS(0,IXY), - 1 CAMOD(0,3*IXY),RAWGT(0), - 1 CSOL(0,0,IXY),SOL(0,IXY,1),MU,ME, - 1 NDEG(1,1,IXY),CEQ(0,0,1,IXY))) THEN - !GET PHASE SOL. - IF (SHLV(1).NE.0) CALL WNCTXT(SHLV(1), - 1 ' !6$EAF7.2 !AS Cannot solve phase',HA,IPC(IXY)) - FLGERR(1,IXY)=.FALSE. - ELSE !SET ERRORS -!= I=ISCN I2=ITL - DO ITL=0,STHTEL-1 !MAKE CONTINUITY - CSOL(ITL,1,IXY)=CSOL(ITL,1,IXY)+SOL(ITL,IXY,1) - END DO -! - END IF - END IF - END IF ! align -C -C DO COMPLEX -C - IF (XSOLVE.NE.0 .AND. - 1 FLGERR(0,IXY) .AND. FLGERR(1,IXY)) THEN -!= I=ISCN I2=ITL I4=IGP -C -C Save the present solution for the present polarisation IXY -C - DO IGP=0,1 - DO ITL=0,STHTEL-1 - SAVSOL(ITL,IGP)=CSOL(ITL,IGP,IXY) - END DO - END DO -! - J=MIN(MXITCT,NINT(RIN(1))) !MAX. LOOPS -C Redun - IF (.NOT.DOALG) THEN - JS=NCARCS(CMAR,STHJ(STH_NIFR_J),IFRT,BASEL, - 1 J,IRED(0),DWGT(0,IXY),AWGT(0,IXY), - 1 CDAT(0,IXY),DAMP(0,IXY),DPHAS(0,IXY), - 1 CAMOD(0,3*IXY),RAWGT(0), - 1 CSOL(0,0,IXY),SOL(0,IXY,0),MU,ME) -C Selfcal - ELSE IF (DOSCAL) THEN - JS=NCASCS(CMAR,STHJ(STH_NIFR_J),IFRT,BASEL, - 1 J,IRED(0),DWGT(0,IXY),AWGT(0,IXY), - 1 CDAT(0,IXY),DAMP(0,IXY),DPHAS(0,IXY), - 1 CAMOD(0,3*IXY),RAWGT(0), - 1 CSOL(0,0,IXY),SOL(0,IXY,0),MU,ME) -C Align - ELSE - I4=1 !ASSUME MORE PHASE - IF (NDEG(0,1,IXY).GT.NDEG(1,1,IXY)) I4=0 - JS=NCAACS(CMAR2(I4),STHJ(STH_NIFR_J),IFRT,BASEL, - 1 J,IRED(0),DWGT(0,IXY),AWGT(0,IXY), - 1 CDAT(0,IXY),DAMP(0,IXY),DPHAS(0,IXY), - 1 CAMOD(0,3*IXY),RAWGT(0), - 1 CSOL(0,0,IXY),SOL(0,IXY,0),MU,ME, - 1 NDEG(0,1,IXY),CEQ(0,0,0,IXY)) - !GET COMPLEX - END IF - ITCNT=ITCNT+MIN(MXITCT,NINT(RIN(1)))-J - !COUNT DONE - IF (.NOT.JS) THEN - IF (SHLV(1).NE.0) CALL WNCTXT(SHLV(1), - 1 ' !6$EAF7.2 !AS Cannot solve complex',HA,IPC(IXY)) - FLGERR(2,IXY)=.FALSE. - ELSE !SET ERRORS -!= I=ISCN I2=ITL I4=IGP - DO IGP=0,1 - DO ITL=0,STHTEL-1 !MAKE CONTINUITY - CSOL(ITL,IGP,IXY)=CSOL(ITL,IGP,IXY)+SOL(ITL,IXY,IGP) - END DO - END DO -! - IF (ME.GT.0 .OR. ME.LT.-.001) GOTO 51 - !NOT FINISHED - END IF - GOTO 50 !NO MORE - 51 CONTINUE - IF (SHLV(1).NE.0) CALL WNCTXT(SHLV(1), - 1 ' !6$EAF7.2 !AS Complex solution too slow', - 1 HA,IPC(IXY)) - FLGERR(2,IXY)=.FALSE. - 50 CONTINUE - IF (.NOT.FLGERR(2,IXY)) THEN !RESTORE SOL -!= I=ISCN I2=ITL I4=IGP - DO IGP=0,1 !G,P - DO ITL=0,STHTEL-1 - CSOL(ITL,IGP,IXY)=SAVSOL(ITL,IGP) - END DO - END DO -! - END IF - END IF -C -C EXIT ALIGN -C - IF (DOALG .AND. .NOT.DOSCAL) THEN -!= I=ISCN I2=IGP - DO IGP=0,1 - IF (APSOL(IGP)) THEN !DO GAIN - IF (.NOT.FORFRE(IGP)) THEN - !NEED LSQ AREA - CALL WNMLFA(MAR2(IGP)) - !FREE - CALL WNMLFA(CMAR2(IGP)) - END IF - END IF - END DO -! - END IF -C -C GET ERRORS -C -!= I=ISCN I2=ITL - DO ITL=0,STHTEL-1 !NORMALIZE CORRECTIONS - CSOL(ITL,1,IXY)=WNGENR(CSOL(ITL,1,IXY)) - END DO -! - IF (APSOL(0) .AND. APSOL(1)) THEN - !COMPLEX ERRORS - IF (.NOT.DOALG) THEN - CALL NCARCE(MAR(0),STHJ(STH_NIFR_J),IFRT,BASEL, - 1 NDEG(0,0,IXY),IRED(0),DWGT(0,IXY),AWGT(0,IXY), - 1 CDAT(0,IXY),DAMP(0,IXY),DPHAS(0,IXY), - 1 CAMOD(0,3*IXY),RAWGT(0), - 1 CSOL(0,0,IXY),SOL(0,IXY,0),MU,ME,ARMS(0,IXY), - 1 JAV(0,0,0,IXY),EAV(0,0,0,IXY),DAV(0,0,0,IXY)) - ELSE IF (DOSCAL) THEN !SELFCAL - CALL NCASCE(MAR(0),STHJ(STH_NIFR_J),IFRT,BASEL, - 1 NDEG(0,0,IXY),IRED(0),DWGT(0,IXY),AWGT(0,IXY), - 1 CDAT(0,IXY),DAMP(0,IXY),DPHAS(0,IXY), - 1 CAMOD(0,3*IXY),RAWGT(0), - 1 CSOL(0,0,IXY),SOL(0,IXY,0),MU,ME,ARMS(0,IXY), - 1 JAV(0,0,0,IXY),EAV(0,0,0,IXY),DAV(0,0,0,IXY)) - ELSE !ALIGN - CALL NCAACE(MAR(0),STHJ(STH_NIFR_J),IFRT,BASEL, - 1 NDEG(0,0,IXY),IRED(0),DWGT(0,IXY),AWGT(0,IXY), - 1 CDAT(0,IXY),DAMP(0,IXY),DPHAS(0,IXY), - 1 CAMOD(0,3*IXY),RAWGT(0), - 1 CSOL(0,0,IXY),SOL(0,IXY,0),MU,ME,ARMS(0,IXY), - 1 JAV(0,0,0,IXY),EAV(0,0,0,IXY),DAV(0,0,0,IXY)) - END IF - ELSE - IF (APSOL(0)) THEN - IF (.NOT.DOALG) THEN - CALL NCARGE(MAR(0),STHJ(STH_NIFR_J),IFRT,BASEL, - !GAIN ERR - 1 NDEG(0,0,IXY),IRED(0),DWGT(0,IXY),AWGT(0,IXY), - 1 CDAT(0,IXY),DAMP(0,IXY),DPHAS(0,IXY), - 1 CAMOD(0,3*IXY),RAWGT(0), - 1 CSOL(0,0,IXY),SOL(0,IXY,0),MU,ME,ARMS(0,IXY), - 1 JAV(0,0,0,IXY),EAV(0,0,0,IXY),DAV(0,0,0,IXY)) - ELSE IF (DOSCAL) THEN !SELFCAL - CALL NCASGE(MAR(0),STHJ(STH_NIFR_J),IFRT,BASEL, - !GAIN ERR - 1 NDEG(0,0,IXY),IRED(0),DWGT(0,IXY),AWGT(0,IXY), - 1 CDAT(0,IXY),DAMP(0,IXY),DPHAS(0,IXY), - 1 CAMOD(0,3*IXY),RAWGT(0), - 1 CSOL(0,0,IXY),SOL(0,IXY,0),MU,ME,ARMS(0,IXY), - 1 JAV(0,0,0,IXY),EAV(0,0,0,IXY),DAV(0,0,0,IXY)) - ELSE !ALIGN - CALL NCAAGE(MAR(0),STHJ(STH_NIFR_J),IFRT,BASEL, - !GAIN ERR - 1 NDEG(0,0,IXY),IRED(0),DWGT(0,IXY),AWGT(0,IXY), - 1 CDAT(0,IXY),DAMP(0,IXY),DPHAS(0,IXY), - 1 CAMOD(0,3*IXY),RAWGT(0), - 1 CSOL(0,0,IXY),SOL(0,IXY,0),MU,ME,ARMS(0,IXY), - 1 JAV(0,0,0,IXY),EAV(0,0,0,IXY),DAV(0,0,0,IXY)) - END IF - END IF - IF (APSOL(1)) THEN - IF (.NOT.DOALG) THEN - CALL NCARPE(MAR(1),STHJ(STH_NIFR_J),IFRT,BASEL, - !PHASE ERR - 1 NDEG(1,0,IXY),IRED(0),DWGT(0,IXY),AWGT(0,IXY), - 1 CDAT(0,IXY),DAMP(0,IXY),DPHAS(0,IXY), - 1 CAMOD(0,3*IXY),RAWGT(0), - 1 CSOL(0,0,IXY),SOL(0,IXY,1),MU,ME,ARMS(0,IXY), - 1 JAV(0,0,0,IXY),EAV(0,0,0,IXY),DAV(0,0,0,IXY)) - ELSE IF (DOSCAL) THEN !SELFCAL - CALL NCASPE(MAR(1),STHJ(STH_NIFR_J),IFRT,BASEL, - !PHASE ERR - 1 NDEG(1,0,IXY),IRED(0),DWGT(0,IXY),AWGT(0,IXY), - 1 CDAT(0,IXY),DAMP(0,IXY),DPHAS(0,IXY), - 1 CAMOD(0,3*IXY),RAWGT(0), - 1 CSOL(0,0,IXY),SOL(0,IXY,1),MU,ME,ARMS(0,IXY), - 1 JAV(0,0,0,IXY),EAV(0,0,0,IXY),DAV(0,0,0,IXY)) - ELSE !ALIGN - CALL NCAAPE(MAR(1),STHJ(STH_NIFR_J),IFRT,BASEL, - !PHASE ERR - 1 NDEG(1,0,IXY),IRED(0),DWGT(0,IXY),AWGT(0,IXY), - 1 CDAT(0,IXY),DAMP(0,IXY),DPHAS(0,IXY), - 1 CAMOD(0,3*IXY),RAWGT(0), - 1 CSOL(0,0,IXY),SOL(0,IXY,1),MU,ME,ARMS(0,IXY), - 1 JAV(0,0,0,IXY),EAV(0,0,0,IXY),DAV(0,0,0,IXY)) - END IF - END IF - END IF -C -C SHOW RESULT -C - IF (SHLV(2).NE.0) THEN - IF (APSOL(0) .OR. APSOL(1)) THEN - CALL WNCTXT(SHLV(2), - !SHOW LINE - 1 '!6$EAF7.2 !AS !1$XJ!1$XJ !5$E7.1 !5$EAR7.1 '// - 1 '!6$E7.1 !6$E7.1 !5$E7.0 !7$E8.1 !4$E7.0 '// - 1 '!5$E7.0 !2$XJ !6$EAR7.1 !2$XJ !2$UJ', - 1 HA,IPC(IXY), - 1 NDEG(0,0,IXY),NDEG(1,0,IXY), - 1 100*EAV(1,0,0,IXY),EAV(1,0,1,IXY), - 1 EAV(0,0,0,IXY),EAV(0,0,1,IXY), - 1 ARMS(0,IXY),ARMS(1,IXY),ARMS(2,IXY), - 1 100*EAV(4,0,0,IXY),JAV(4,0,0,IXY), - 1 EAV(4,0,1,IXY),JAV(4,0,1,IXY),ITCNT) - ELSE - CALL WNCTXT(SHLV(2), - 1 '!6$EAF7.2 !AS!AS !7$E8.1 !7$E8.1 !5$E8.1'// - 1 ' !7$E8.1 !7$E8.1 !5$E8.1'// - 1 ' !7$E8.1 !7$E8.1 !5$E8.1', - 1 HA,IPC(IXY),IPC(0), - 1 CSRMS(0,2*IXY,0),CSRMS(1,2*IXY,0),CSRMS(2,2*IXY,0), - 1 CSRMS(0,2*IXY,1),CSRMS(1,2*IXY,1),CSRMS(2,2*IXY,1), - 1 CSRMS(0,2*IXY,2),CSRMS(1,2*IXY,2),CSRMS(2,2*IXY,2)) - CALL WNCTXT(SHLV(2), - 1 '!6$EAF7.2 !AS!AS !7$E8.1 !7$E8.1 !5$E8.1'// - 1 ' !7$E8.1 !7$E8.1 !5$E8.1'// - 1 ' !7$E8.1 !7$E8.1 !5$E8.1', - 1 HA,IPC(IXY),IPC(1), - 1 CSRMS(0,2*IXY+1,0),CSRMS(1,2*IXY+1,0), - 1 CSRMS(2,2*IXY+1,0), - 1 CSRMS(0,2*IXY+1,1),CSRMS(1,2*IXY+1,1), - 1 CSRMS(2,2*IXY+1,1), - 1 CSRMS(0,2*IXY+1,2),CSRMS(1,2*IXY+1,2), - 1 CSRMS(2,2*IXY+1,2)) - END IF - END IF - IF (SHLV(3).NE.0) THEN !SHOW SOLUTIONS - IF (APSOL(0) .OR. APSOL(1)) THEN - CALL WNCTXT(SHLV(3),'!80$15Q1!10C\Gain:!6$#E9.3', - 1 STHTEL,CSOL(0,0,IXY)) - CALL WNCTXT(SHLV(3),'!80$15Q1!10C\Phase:!6$#E9.3', - 1 STHTEL,CSOL(0,1,IXY)) - END IF - END IF -C -C CHECK RESULT -C -!= I=ISCN I2=IGP - DO IGP=0,1 !G,P - IF (APSOL(IGP).NE.0 .AND. FLGERR(IGP,IXY)) THEN - !DO CHECK - IF (EAV(0,0,IGP,IXY).GT.RIN(3)*EAV(3,0,IGP,IXY) .AND. - 1 JAV(2,0,IGP,IXY).GT.2*STHJ(STH_NIFR_J)) - 1 THEN !OUT OF LIMITS - IF (SHLV(1).NE.0) CALL WNCTXT(SHLV(1), - 1 '!7$EAF7.2 !AS Bad scan !AS', - 1 HA,IPC(IXY),GPTXT(IGP)) - FLGERR(IGP,IXY)=.FALSE. !INDICATE ERROR - END IF - END IF - END DO -! -C -C RESET ERROR -C - IF (APSOL(0) .AND. APSOL(1)) THEN - !COMPLEX ERRORS - IF (.NOT.FLGERR(0,IXY) .OR. .NOT.FLGERR(1,IXY)) THEN - FLGERR(0,IXY)=.FALSE. !BOTH - FLGERR(1,IXY)=.FALSE. - IF (.NOT.DOALG) THEN - CALL NCARCC(MAR(0),STHJ(STH_NIFR_J),IFRT,BASEL, - 1 NDEG(0,0,IXY),IRED(0),DWGT(0,IXY),AWGT(0,IXY), - 1 CDAT(0,IXY),DAMP(0,IXY),DPHAS(0,IXY), - 1 CAMOD(0,3*IXY),RAWGT(0), - 1 CSOL(0,0,IXY),SOL(0,IXY,0),MU,ME,ARMS(0,IXY), - 1 JAV(0,0,0,IXY),EAV(0,0,0,IXY),DAV(0,0,0,IXY)) - ELSE IF (DOSCAL) THEN !SELFCAL - CALL NCASCC(MAR(0),STHJ(STH_NIFR_J),IFRT,BASEL, - 1 NDEG(0,0,IXY),IRED(0),DWGT(0,IXY),AWGT(0,IXY), - 1 CDAT(0,IXY),DAMP(0,IXY),DPHAS(0,IXY), - 1 CAMOD(0,3*IXY),RAWGT(0), - 1 CSOL(0,0,IXY),SOL(0,IXY,0),MU,ME,ARMS(0,IXY), - 1 JAV(0,0,0,IXY),EAV(0,0,0,IXY),DAV(0,0,0,IXY)) - ELSE !ALIGN - CALL NCAACC(MAR(0),STHJ(STH_NIFR_J),IFRT,BASEL, - 1 NDEG(0,0,IXY),IRED(0),DWGT(0,IXY),AWGT(0,IXY), - 1 CDAT(0,IXY),DAMP(0,IXY),DPHAS(0,IXY), - 1 CAMOD(0,3*IXY),RAWGT(0), - 1 CSOL(0,0,IXY),SOL(0,IXY,0),MU,ME,ARMS(0,IXY), - 1 JAV(0,0,0,IXY),EAV(0,0,0,IXY),DAV(0,0,0,IXY)) - END IF - END IF - ELSE - IF (.NOT.FLGERR(0,IXY)) THEN - IF (.NOT.DOALG) THEN - CALL NCARGC(MAR(0),STHJ(STH_NIFR_J),IFRT,BASEL, - !GAIN ERR - 1 NDEG(0,0,IXY),IRED(0),DWGT(0,IXY),AWGT(0,IXY), - 1 CDAT(0,IXY),DAMP(0,IXY),DPHAS(0,IXY), - 1 CAMOD(0,3*IXY),RAWGT(0), - 1 CSOL(0,0,IXY),SOL(0,IXY,0),MU,ME,ARMS(0,IXY), - 1 JAV(0,0,0,IXY),EAV(0,0,0,IXY),DAV(0,0,0,IXY)) - ELSE IF (DOSCAL) THEN !SELFCAL - CALL NCASGC(MAR(0),STHJ(STH_NIFR_J),IFRT,BASEL, - !GAIN ERR - 1 NDEG(0,0,IXY),IRED(0),DWGT(0,IXY),AWGT(0,IXY), - 1 CDAT(0,IXY),DAMP(0,IXY),DPHAS(0,IXY), - 1 CAMOD(0,3*IXY),RAWGT(0), - 1 CSOL(0,0,IXY),SOL(0,IXY,0),MU,ME,ARMS(0,IXY), - 1 JAV(0,0,0,IXY),EAV(0,0,0,IXY),DAV(0,0,0,IXY)) - ELSE !ALIGN - CALL NCAAGC(MAR(0),STHJ(STH_NIFR_J),IFRT,BASEL, - !GAIN ERR - 1 NDEG(0,0,IXY),IRED(0),DWGT(0,IXY),AWGT(0,IXY), - 1 CDAT(0,IXY),DAMP(0,IXY),DPHAS(0,IXY), - 1 CAMOD(0,3*IXY),RAWGT(0), - 1 CSOL(0,0,IXY),SOL(0,IXY,0),MU,ME,ARMS(0,IXY), - 1 JAV(0,0,0,IXY),EAV(0,0,0,IXY),DAV(0,0,0,IXY)) - END IF - END IF - IF (.NOT.FLGERR(1,IXY)) THEN - IF (.NOT.DOALG) THEN - CALL NCARPC(MAR(1),STHJ(STH_NIFR_J),IFRT,BASEL, - !PHASE ERR - 1 NDEG(1,0,IXY),IRED(0),DWGT(0,IXY),AWGT(0,IXY), - 1 CDAT(0,IXY),DAMP(0,IXY),DPHAS(0,IXY), - 1 CAMOD(0,3*IXY),RAWGT(0), - 1 CSOL(0,0,IXY),SOL(0,IXY,1),MU,ME,ARMS(0,IXY), - 1 JAV(0,0,0,IXY),EAV(0,0,0,IXY),DAV(0,0,0,IXY)) - ELSE IF (DOSCAL) THEN !SELFCAL - CALL NCASPC(MAR(1),STHJ(STH_NIFR_J),IFRT,BASEL, - !PHASE ERR - 1 NDEG(1,0,IXY),IRED(0),DWGT(0,IXY),AWGT(0,IXY), - 1 CDAT(0,IXY),DAMP(0,IXY),DPHAS(0,IXY), - 1 CAMOD(0,3*IXY),RAWGT(0), - 1 CSOL(0,0,IXY),SOL(0,IXY,1),MU,ME,ARMS(0,IXY), - 1 JAV(0,0,0,IXY),EAV(0,0,0,IXY),DAV(0,0,0,IXY)) - ELSE !ALIGN - CALL NCAAPC(MAR(1),STHJ(STH_NIFR_J),IFRT,BASEL, - !PHASE ERR - 1 NDEG(1,0,IXY),IRED(0),DWGT(0,IXY),AWGT(0,IXY), - 1 CDAT(0,IXY),DAMP(0,IXY),DPHAS(0,IXY), - 1 CAMOD(0,3*IXY),RAWGT(0), - 1 CSOL(0,0,IXY),SOL(0,IXY,1),MU,ME,ARMS(0,IXY), - 1 JAV(0,0,0,IXY),EAV(0,0,0,IXY),DAV(0,0,0,IXY)) - END IF - END IF - END IF -C -C SET HISTOGRAMS -C -!= I=ISCN I2=IGP - DO IGP=0,1 !G,P - IF (FLGERR(IGP,IXY)) THEN - CALL WNMHS1(HISBAD(IGP,IXY),1,EAV(0,0,IGP,IXY)) - END IF - END DO -! - CALL WNMHS1(HISBAD(2,IXY),1,ARMS(0,IXY)) - END IF - END DO ! IXY polarisation loop X, Y -C -C WRITE RESULTS: corrections in scan header -C -!= I=ISCN I1=IXY I2=IGP - DO IXY=0,1 !X,Y - DO IGP=0,1 !G,P - MENS(IGP,IXY)=EAV(0,0,IGP,IXY) !SAVE SCAN NOISES - END DO - END DO -! - IF (DOALG) THEN !SELECT SELFCAL - I1=CAP_ALG ! 2 - I2=0 !NOTHING ZEROED - ELSE !SELECT REDUN - I1=CAP_RED ! 1 - I2=CAP_ALG ! 2 - END IF -!= I=ISCN - DO I3=ISCN,ISCN+NRINT-1 !WRITE INTEGRATED - IF (.NOT.NSCSWU(FCAOUT,STH,I3,CSOL,I1,APSOL,XYSOL,TELS, - 1 CORAP,CORDAP,I2,MENS)) THEN - CALL WNCTXT(F_TP,'!7$EAF7.2 Error writing scan data',HA) - GOTO 20 !TRY NEXT sector - END IF - END DO -! -C - 30 CONTINUE - END DO! iscn: scans - 20 CONTINUE! - END DO! sectors -C -C SHOW OVERALL INFO -C - CALL WNCFHD(F_TP,4,' ') !RESET HEADERS - CALL WNCFHD(F_TP,5,' ') - CALL WNCTXT(F_TP,' ') -C -C PRINT AVERAGES -C - IF (APSOL(0) .OR. APSOL(1)) THEN - DO IXY=0,1 !BOTH POL. - IF (JAV(7,0,0,IXY).GT.0) THEN !DATA PRESENT - CALL WNCTXT(F_TP,'!AS average amplitude= !E10.3 (!D10.3)', - 1 IPC(IXY),EAV(7,0,0,IXY)/JAV(7,0,0,IXY), - 1 SQRT(ABS(DAV(7,0,0,IXY)-EAV(7,0,0,IXY)* - 1 EAV(7,0,0,IXY)/JAV(7,0,0,IXY))/JAV(7,0,0,IXY))) - END IF - END DO - CALL WNCTXT(F_TP,'!/!Q1!7C!5$#AS',STHTEL,TELNMA(0)) - !HEADING -!= I1=ITL I2=IGP - DO IXY=0,1 !BOTH POL. - DO ITL=0,STHTEL-1 !ALL TEL. - DO IGP=0,1 !GAIN/PHASE - IF (JAV(ITL,3,IGP,IXY).GT.0) THEN !PRESENT - EAV(ITL,3,IGP,IXY)=EAV(ITL,3,IGP,IXY)/JAV(ITL,3,IGP,IXY) - !AVERAGE - DAV(ITL,3,IGP,IXY)= - 1 SQRT(ABS(DAV(ITL,3,IGP,IXY) - 1 -JAV(ITL,3,IGP,IXY) - 1 *EAV(ITL,3,IGP,IXY)*EAV(ITL,3,IGP,IXY)) - 1 /JAV(ITL,3,IGP,IXY)) - !RMS - IF (IGP.EQ.0) THEN !GAIN - EAV(ITL,3,IGP,IXY)=100*(EXP(EAV(ITL,3,IGP,IXY))-1) - DAV(ITL,3,IGP,IXY)=100*(EXP(DAV(ITL,3,IGP,IXY))-1) - ELSE !PHASE - EAV(ITL,3,IGP,IXY)=DEG*EAV(ITL,3,IGP,IXY) - DAV(ITL,3,IGP,IXY)=DEG*DAV(ITL,3,IGP,IXY) - END IF - END IF - END DO - END DO -! - IF (XYSOL(IXY)) THEN !TO DO - DO ITL=0,STHTEL-1 - EAV0(ITL)=NINT(10*EAV(ITL,3,0,IXY)) - DAV0(ITL)=NINT(10*DAV(ITL,3,0,IXY)) - ENDDO - CALL WNCTXT(F_TP,'!Q1!AS\g(.1%) !5$#SJ5!/!2C\(M.E.) !5$#SJ5', - 1 IPC(IXY),STHTEL,EAV0(0),STHTEL,DAV0(0)) - DO ITL=0,STHTEL-1 - EAV0(ITL)=NINT(10*EAV(ITL,3,1,IXY)) - DAV0(ITL)=NINT(10*DAV(ITL,3,1,IXY)) - ENDDO - CALL WNCTXT(F_TP,'!Q1!AS\p(.1d) !5$#SJ5!/!2C\(M.E.) !5$#SJ5', - 1 IPC(IXY),STHTEL,EAV0(0),STHTEL,DAV0(0)) - END IF - END DO ! IXY - END IF -C -C CALCULATE AVERAGES -C -!= I1=IFR I2=IGP - DO IXY=0,1 !BOTH POL. - I4=0 !COUNT - DO IFR=0,STHIFR-1 !ALL IFRS - IF (JAV(IFR,1,0,IXY).GT.0 .OR. JAV(IFR,1,1,IXY).GT.0) THEN - DO IGP=0,1 !GAIN/PHASE - IF (JAV(IFR,1,IGP,IXY).GT.0 .AND. - 1 DAV(IFR,4,IGP,IXY).GT.0) THEN !980701 - !PRESENT - JAV(I4,2,IGP,IXY)=IFR !BASELINE - DAV(I4,1,IGP,IXY)=DAV(IFR,1,IGP,IXY)/JAV(IFR,1,IGP,IXY) - !AVER. ERROR - DAV(I4,2,IGP,IXY)=SQRT(MAX(0D0,DAV(IFR,2,IGP,IXY)/ - 1 JAV(IFR,1,IGP,IXY)-DAV(I4,1,IGP,IXY)**2)) - IF (IGP.EQ.0) THEN !GAIN -C!980701 EAV(I4,1,IGP,IXY)=100*(EXP(EAV(IFR,1,IGP,IXY)/ -C!980701 1 JAV(IFR,1,IGP,IXY))-1) -C!070814 EAV(I4,1,IGP,IXY)=100*(EXP(EAV(IFR,4,IGP,IXY)/ !980701 -C!070814 1 DAV(IFR,4,IGP,IXY))-1) !980701 - EAV(I4,1,IGP,IXY)=100*(EXP(EAV(IFR,4,IGP,IXY)/ !091019 - 1 DAV(IFR,4,IGP,IXY))-1) !091019 -C!091019 C0=CMPLX(EAV(IFR,4,IGP,IXY)/DAV(IFR,4,IGP,IXY), -C!091019 1 EAV(IFR,4,1,IXY)/DAV(IFR,4,1,IXY)) !070814 -C!091019 IF (ABS(C0).NE.0) THEN !070814 -C!091019 EAV(IFR,4,IGP,IXY)=100*REAL(LOG(C0)) !070814 -C!091019 EAV(IFR,4,1,IXY)=DEG*AIMAG(LOG(C0)) !070814 -C!091019 ELSE -C!091019 EAV(IFR,4,IGP,IXY)=0 !070814 -C!091019 EAV(IFR,4,1,IXY)=0 !070814 -C!091019 END IF - ELSE !PHASE -C!980701 EAV(I4,1,IGP,IXY)=DEG*EAV(IFR,1,IGP,IXY)/JAV(IFR,1,IGP,IXY) -C!070814 EAV(I4,1,IGP,IXY)=DEG*EAV(IFR,4,IGP,IXY)/DAV(IFR,4,IGP,IXY) - EAV(I4,1,IGP,IXY)=DEG*EAV(IFR,4,IGP,IXY)/DAV(IFR,4, - 1 IGP,IXY) !091019 - END IF - EAV(I4,2,IGP,IXY)=DAV(I4,2,IGP,IXY) - EAV(I4,3,IGP,IXY)=DAV(I4,1,IGP,IXY) - ELSE - JAV(I4,2,IGP,IXY)=IFR - EAV(I4,1,IGP,IXY)=0 - EAV(I4,2,IGP,IXY)=0 - EAV(I4,3,IGP,IXY)=0 - END IF - END DO - I4=I4+1 !COUNT - END IF - END DO - JAV(0,1,0,IXY)=I4 !SAVE COUNT - END DO -! - CALL WNCTXT(F_TP,' ') - DO IXY=0,1 - IF (JAV(2,0,0,IXY)+JAV(2,0,1,IXY).GT.0) THEN -!= I2=IGP - DO IGP=0,1 - IF (JAV(2,0,IGP,IXY).GT.0) - 1 EAV(2,0,IGP,IXY)=SQRT(EAV(2,0,IGP,IXY)/JAV(2,0,IGP,IXY)) - END DO -! - END IF - END DO -C -C SAVE MIFR ERRORS -C - IF (DOMIFR) THEN - CALL WNGMVZ(4*LB_X*STHIFR,IFRCOR) !EMPTY CORRECTIONS - DO IXY=0,1 !X,Y - I=-1 -!= I1=ITL I2=ITL1 - DO ITL=0,STHTEL-1 - DO ITL1=ITL,STHTEL-1 - I=I+1 !NEXT ENTRY IFRCOR - IF (CIFRS(ITL,ITL1)) THEN !WRITE SELECTED - I4=0 !INDEX INPUT - DO WHILE (I4.LT.JAV(0,1,0,IXY)) - !FIND IFR INDEX - IF (IFRT(JAV(I4,2,0,IXY)).EQ.ITL*256+ITL1 .OR. - 1 IFRT(JAV(I4,2,0,IXY)).EQ.ITL1*256+ITL) THEN - !FOUND - R0=EAV(I4,1,0,IXY) !GAIN (%) - R0=LOG(ABS(R0/100+1)) - !GAIN - R1=EAV(I4,1,1,IXY)/DEG - !PHASE - IFRCOR(I,3*IXY)=CMPLX(R0,R1) - !FOR EXP(-CMPLX) - GOTO 60 - END IF - I4=I4+1 - END DO - 60 CONTINUE - END IF - END DO - END DO -! - END DO !X,Y -C -C SWAP SIFRS AND CIFRS FOR USE BY NCASTX -C -!= I1=ITL I2=ITL1 - DO ITL=0,STHTEL-1 - DO ITL1=ITL,STHTEL-1 - BTMP=SIFRS(ITL,ITL1) - SIFRS(ITL,ITL1)=CIFRS(ITL,ITL1) - CIFRS(ITL,ITL1)=BTMP - END DO - END DO - CALL NCASTX(COR_MIFR) !SAVE CORRECTIONS - DO ITL=0,STHTEL-1 - DO ITL1=ITL,STHTEL-1 - BTMP=SIFRS(ITL,ITL1) - SIFRS(ITL,ITL1)=CIFRS(ITL,ITL1) - CIFRS(ITL,ITL1)=BTMP - END DO - END DO -! - END IF -C -C SAVE OVERALL NOISE -C - DO WHILE(NSCSTL(FCAOUT,SETS,STH(0),STHP,SETNAM,LPOFF)) - !NEXT sector - DO IXY=0,1 !POL. - IF (XYSOL(IXY)) THEN !TO DO -!= I1=IGP - DO IGP=0,1 !GAIN/PHASE - IF (APSOL(IGP)) THEN !TO DO - I4=IXY*2+IGP - IF (.NOT.DOALG) THEN - STHE(STH_REDNS_E+I4)=EAV(2,0,IGP,IXY) - !SET REDUN - ELSE - STHE(STH_ALGNS_E+I4)=EAV(2,0,IGP,IXY) - !SET SELFCAL - END IF - END IF - END DO -! - END IF - END DO - IF (.NOT.WNFWR(FCAOUT,STH__L,STH(0),STHP)) THEN - !RESET HEADER - CALL WNCTXT(F_TP,'Error rewriting sector header') - END IF - END DO - DO IXY=0,1 - IF (JAV(2,0,0,IXY)+JAV(2,0,1,IXY).GT.0) THEN - CALL WNCTXT(F_TP,'!AS overall noise '// - 1 '(gain, phase in W.U.): !8$E8.1 !8$E8.1', - 1 IPC(IXY),EAV(2,0,0,IXY),EAV(2,0,1,IXY)) - END IF - END DO - CALL WNCTXT(F_TP,' ') -C -C PRINT GRAPHICS -C - IF (SHLV(2).NE.0 .AND. - 1 (APSOL(0).NE.0 .OR. APSOL(1).NE.0)) THEN - DO IXY=0,1 !X,Y - IF (XYSOL(IXY)) THEN !TO DO - CALL WNCFHD(F_P,4,'Polarisation:!AS',IPC(IXY)) - CALL WNCFHD(F_P,5,'Overall noise (gain, phase in W.U.): '// - 1 '!8$E8.1!8$E8.1',EAV(2,0,0,IXY),EAV(2,0,1,IXY)) - CALL WNCTXT(F_P,'!^') - CALL NCARGR('Average residual error '// - 1 IPC(IXY)//' (W.U.)',JAV(0,2,0,IXY),IFRT, - 1 EAV(0,3,0,IXY),EAV(0,3,1,IXY), - 1 JAV(0,1,0,IXY),APSOL) - CALL NCARGR('Average residual error '// - 1 IPC(IXY)//' (%, deg)',JAV(0,2,0,IXY),IFRT, - 1 EAV(0,1,0,IXY),EAV(0,1,1,IXY), - 1 JAV(0,1,0,IXY),APSOL) - CALL NCARGR('RMS '//IPC(IXY)//' (W.U.)',JAV(0,2,0,IXY),IFRT, - 1 EAV(0,2,0,IXY),EAV(0,2,1,IXY), - 1 JAV(0,1,0,IXY),APSOL) - CALL WNMHS2(HISBAD(0,IXY),3,SHLV(2)) !PRINT HISTOGRAM - CALL WNCTXT(F_P, - 1 '+= amplitude noise, *= phase noise, o= max. amplitude') - ENDIF - END DO - ENDIF -C -C READY -C - 900 CONTINUE - CALL WNCFHD(F_P,-4,' ') !CLEAR HEADERS - CALL WNCFHD(F_P,-5,' ') - CALL WNCFHD(F_P,-6,' ') - 902 CONTINUE -!= I=IGP - DO IGP=0,1 - CALL WNMLFA(MAR2(IGP)) - CALL WNMLFA(CMAR2(IGP)) - END DO - DO I2=0,1 - DO I1=0,2 - CALL WNMHS9(HISBAD(I1,I2)) !CLEAR HISTO - END DO - END DO - 901 CONTINUE - DO IGP=0,1 !FREE MATRICES - CALL WNMLFA(MAR(IGP)) - CALL WNMLFA(MAR1(IGP)) - END DO -! - CALL WNMLFA(CMAR) -C - RETURN !READY -C -C - END diff --git a/src/nscan/ncargr.for b/src/nscan/ncargr.for deleted file mode 100644 index 1da16b38399282f89f48e369560a87544ad54403..0000000000000000000000000000000000000000 --- a/src/nscan/ncargr.for +++ /dev/null @@ -1,137 +0,0 @@ -C+ NCARGR.FOR -C WNB 910128 -C -C Revisions: -C WNB 910813 Selection of baselines -C JPH 960520 Left and right plot annotations: F7.0 --> E7.0 to -C prevent overflow -C - SUBROUTINE NCARGR(HEAD,IFTAB,IFR,ADAT,PDAT,NIFR,AP) -C -C Print graphical ampl/phase data -C -C Result: -C -C CALL NCARGR( HEAD_C*:I, IFTAB_J(0:NIFR-1):I, IFR_I(0:*):I, -C ADAT_E(0:NIFR-1):I, PDAT_E(0:NIFR-1):I, -C NIFR_J:I, AP_B(0:1):I) -C -C Print a graph of Ampl/Phase data given in -C DAT, for NIFR interferometers, selecting -C the ones pointed to in IFTAB. -C HEAD specifies a title, AP indicates if ampl -C and/or phase(.TRUE.) are present. -C -C Include files: -C - INCLUDE 'WNG_DEF' - INCLUDE 'STH_O_DEF' -C -C Parameters: -C -C -C Arguments: -C - CHARACTER*(*) HEAD !TITLE OF GRAPH - INTEGER IFTAB(0:*) !SELECTION TABLE - INTEGER*2 IFR(0:*) !INTERFEROMETER NAMES - REAL ADAT(0:*),PDAT(0:*) !AMPL/PHASE DATA - INTEGER NIFR !# OF INTERFEROMETERS TO DO - BYTE AP(0:1) !AMPL/PHASE INDICATOR - LOGICAL AP0 - LOGICAL AP1 - CHARACTER*80 ARGSTR -C -C Function references: -C -C -C Data declarations: -C -C- - REAL GMX,GMN,PMX,PMN !MAX/MIN VALUES A/P - REAL PMD,GMD !MIDDLE VALUES - REAL PD,GD !INTERVALS - CHARACTER*(STHIFR+6) TXT !TEXT LINE - CHARACTER*36 TELC !TELESCOPE NAMES - DATA TELC/'0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ'/ -C -C INIT -C - IF (NIFR.LE.0) RETURN !NO DATA -C - PMX=-1E6 !INIT. VALUES - PMN=1E6 - GMX=-1E6 - GMN=1E6 - DO I=0,NIFR-1 !FIND MAX/MIN - GMX=MAX(GMX,ADAT(I)) !AMPL - GMN=MIN(GMN,ADAT(I)) - PMX=MAX(PMX,PDAT(I)) !PHASE - PMN=MIN(PMN,PDAT(I)) - END DO -C - GMD=(GMX+GMN)/2 !MIDDLE VALUES - PMD=(PMX+PMN)/2 - GD=MAX(1E-6,(GMX-GMN)/12) !STEP - PD=MAX(1E-6,(PMX-PMN)/12) -C - I1=MIN(NIFR+5,LEN(HEAD)) !ARANGE HEADER LINE - I2=(NIFR+6-I1)/2 - TXT=' ' - ARGSTR=' (A)'//TXT(:I2)//HEAD(:I1)//TXT(:NIFR+6-I1-I2)//'(P)' - CALL WNCTXT(F_P,ARGSTR) -C -C PRINT GRAPH -C - DO I=6,-6,-1 - TXT=' ' - DO I1=0,NIFR-1 - AP0=AP(0) - AP1=AP(1) - IF (NINT((ADAT(I1)-GMD)/GD).EQ.I .AND. AP0) - 1 TXT(I1+1:I1+1)='A' - IF (NINT((PDAT(I1)-PMD)/PD).EQ.I .AND. AP1) THEN - IF (TXT(I1+1:I1+1).EQ.'A') THEN - TXT(I1+1:I1+1)='X' - ELSE - TXT(I1+1:I1+1)='P' - END IF - END IF - END DO - CALL WNCTXT(F_P,'!7$E7.0 '//TXT(:NIFR)// - 1 ' !7$E7.0',GMD+I*GD,PMD+I*PD) - END DO -C -C PRINT BOTTOM LINES -C - TXT=' ' - DO I=0,NIFR-1 - TXT(I+1:I+1)=TELC(MOD(IFR(IFTAB(I)),256)+1:) !TELESCOPE NAME - END DO - CALL WNCTXT(F_P,'!9C!AS',TXT(:NIFR)) - TXT=' ' - DO I=0,NIFR-1 - TXT(I+1:I+1)=TELC(IFR(IFTAB(I))/256+1:) !TELESCOPE NAME - END DO - CALL WNCTXT(F_P,'!9C!AS!/',TXT(:NIFR)) -C - RETURN -C -C - END - - - - - - - - - - - - - - - - diff --git a/src/nscan/ncargs.for b/src/nscan/ncargs.for deleted file mode 100644 index 443f0956af2af16862dc982823399db69120da4a..0000000000000000000000000000000000000000 --- a/src/nscan/ncargs.for +++ /dev/null @@ -1,568 +0,0 @@ -C+ NCARGS.FOR -C WNB 900312 -C -C Revisions: -C WNB 910812 Add ALIGN -C WNB 910930 Narrower check -C WNB 911024 Running noise -C WNB 911025 Zero division check -C WNB 930826 New model data -C WNB 950613 New LSQ routines -C WNB 980701 Add for new MIFR calculations -C CMV 030116 Acommodated for unsorted IFR table -C - LOGICAL FUNCTION NCARGS(MAR,NIFR,IFR,BASEL,NDEG, - 1 IRED,WGT,AWGT,CDAT,AMP,PHAS,CMOD,CWGT, - 1 CSOL,SOL,MU,ME) -C -C Calculate redundancy gain solution -C -C Result: -C -C NCARGS_L = NCARGS( MAR_J:I, NIFR_J:I, -C IFR_I(0:*):I, BASEL_E(0:*):I, NDEG_J:IO, -C IRED_J(0:NIFR-1):I, WGT_E(0:*,0:1):I, -C AWGT_E(0:*,0:1):I, CDAT_X(0:*,0:1):I, -C AMP_E(0:*,0:1):I, PHAS_E(0:*,0:1):I, -C CMOD_X(0:*,0:3):I, CWGT_E(0:*):I, -C CSOL_E(0:*,0:1,0:1):I,SOL_E(0:*,0:1,0:1):O, -C MU_E:O, ME_E:O) -C Calculate the redundancy gain solution -C in SOL, with adjustment error MU and -C mean errors ME using CSOL as approximate -C solution. -C WGT is the weight, AWGT the amplitude -C eighted weight, CDAT/AMP/PHAS -C the data. IRED specifies the -C redundant baselines. -C CMOD is the model with sqrt(weights) -C CWGT. -C MAR is the solution area for the -C telescopes, using NIFR interferometers -C and a degeneracy of NDEG. -C IFR are the interferometer -C specifications. -C NCASGS_L = NCASGS( ...) -C Use model for constraints (selfcal) -C NCAAGS_L = NCAAGS( ..., NUK_J:I, ALEQ_E(0:*,0:*):I) -C Use model to align NUK parameters using -C equations ALEQ -C NCARG1_L = NCARG1( ...) -C Calculate X and Y simultaneous -C NCARG2_L = NCARG2( ...) -C Calculate X and Y simultaneous with Q=0 -C NCARGE_L = NCARGE( MAR_J:I, NIFR_J:I, -C IFR_I(0:*):I, BASEL_E(0:*):I, NDEG_J:IO, -C IRED_J(0:NIFR-1):I, WGT_E(0:*,0:1):I, -C AWGT_E(0:*,0:1):I, CDAT_X(0:*,0:1):I, -C AMP_E(0:*,0:1):I, PHAS_E(0:*,0:1):I, -C CMOD_X(0:*,0:3):I, CWGT_E(0:*):I, -C CSOL_E(0:*,0:1,0:1):I,SOL_E(0:*,0:1,0:1):I, -C MU_E:I, ME_E:I, ARMS_E(0:2):I, -C JAV_J(0:*,0:*,0:1):IO, EAV_E(0:*,0:*,0:1):IO, -C DAV_D(0:*,0:*,0:1):IO) -C Calculate all errors in the average -C arrays JAV, EAV and DAV. -C ARMS is the average amplitude of scan -C NCARGC_L = NCARGC( ...) -C Correct errors back -C NCASGE_L = NCASGE( ...) -C Calculate selfcal errors -C NCASGC_L = NCASGC( ...) -C Correct selfcal errors back -C NCAAGE_L = NCAAGE( ...) -C Calculate align errors -C NCAAGC_L = NCAAGC( ...) -C Correct align errors back -C -C JAV, EAV, DAV contain: -C *,*,0 gain -C *,*,1 phase -C 0,0 noise per scan -C 1,0 inconsistency per scan -C 2,0 total noise -C 3,0 overall running noise -C 4,0 max. deviation in scan -C 5,0 total average noise -C 6,0 total average incons. -C 7,0 total average ampl. -C *,1 inconsistency per ifr -C *,2 average rms per ifr -C *,3 gain per telescope -C!980701 *,4 weighted incons per ifr -C -C Include files: -C - INCLUDE 'WNG_DEF' - INCLUDE 'LSQ_O_DEF' - INCLUDE 'STH_O_DEF' !SET HEADER -C -C Entry points: -C - LOGICAL NCARG1,NCARG2 !CALCULATE X/Y SIMULTANEOUS - LOGICAL NCASGS !CALCULATE SELFCAL - LOGICAL NCAAGS !CALCULATE ALIGN - LOGICAL NCARGE,NCARGC !CALCULATE ERRORS - LOGICAL NCASGE,NCASGC !CALCULATE SELFCAL ERRORS - LOGICAL NCAAGE,NCAAGC !CALCULATE ALIGN ERRORS -C -C Parameters: -C -C -C Arguments: -C - INTEGER MAR !SOLUTION AREA POINTER - INTEGER NIFR !TOTAL # OF INTERFEROMETERS - INTEGER*2 IFR(0:*) !INTERFEROMETER TELESCOPES - INTEGER NDEG !DEGENERACY LEVEL - REAL BASEL(0:*) !BASELINES - INTEGER IRED(0:*) !REDUNDANCY INDICATOR - REAL WGT(0:STHIFR-1,0:*) !DATA WEIGHT X,Y - REAL AWGT(0:STHIFR-1,0:*) !AMPLITUDE WEIGHTED WEIGHT X,Y - COMPLEX CDAT(0:STHIFR-1,0:*) !DATA COMPLEX X,Y - REAL AMP(0:STHIFR-1,0:*) !DATA AMPLITUDE X,Y - REAL PHAS(0:STHIFR-1,0:*) !DATA PHASE X,Y - COMPLEX CMOD(0:STHIFR-1,0:*) !MODEL COMPLEX XYX - REAL CWGT(0:*) !MODEL WEIGHT**0.5 - REAL SOL(0:STHTEL-1,0:1,0:1) !SOLUTION X,Y G,P - REAL CSOL(0:STHTEL-1,0:1,0:1) !CONTINUITY SOLUTION G,P X,Y - REAL MU !ADJUSTMENT ERROR - REAL ME !MEAN ERRORS SOLUTION - INTEGER NUK !# OF ALIGN PARAMETERS - REAL ALEQ(0:STHTEL-1,0:*) !ALIGN EQUATIONS - REAL ARMS(0:2) !AVERAGE AMPL. - INTEGER JAV(0:STHIFR-1,0:4,0:1) !COUNT FOR AVERAGES - REAL EAV(0:STHIFR-1,0:4,0:1) !SUM FOR AVERAGES - REAL*8 DAV(0:STHIFR-1,0:4,0:1) !SUM FOR RMS -C -C Function references: -C -C -C Data declarations: -C - REAL CF(0:2*STHTEL-1),CG(0:2*STHTEL-1) !COEFFICIENTS FOR SOLUTION - INTEGER TW1,TE1,TW2,TE2 !TELESCOPES - REAL W2,W22 !WEIGHTS - REAL W4,W24 - REAL R2 !980701 - REAL CELES(0:STHIFR-1),WCELES(0:STHIFR-1) !CELESTIAL GAINS - REAL LSOL(0:STHTEL-1) !LOCAL SOLUTION - INTEGER NR !RANK SOLUTION - INTEGER NU !# UNKNOWNS - LOGICAL DOQ0 !RG1/RG2 SWITCH - LOGICAL DOXY !XY SIMULTANEOUS SWITCH - LOGICAL DOSC !SELFCAL OPTION - LOGICAL DOAL !ALIGN SWITCH -C- -C -C INIT -C - NCARGS=.TRUE. !ASSUME OK - NU=STHTEL !# OF UNKNOWNS - DOXY=.FALSE. !SEPARATE X/Y - DOQ0=.FALSE. !NO Q=0 - GOTO 20 -C -C X/Y SIMULTANEOUS -C - ENTRY NCARG1(MAR,NIFR,IFR,BASEL,NDEG, - 1 IRED,WGT,AWGT,CDAT,AMP,PHAS,CMOD,CWGT, - 1 CSOL,SOL,MU,ME) -C - NCARG1=.TRUE. !ASSUME OK - NU=2*STHTEL !# OF UNKNOWNS - DOXY=.TRUE. !COMBINE X/Y - DOQ0=.FALSE. !NO Q=0 - GOTO 20 -C -C X/Y SIMULTANEOUS WITH Q=0 -C - ENTRY NCARG2(MAR,NIFR,IFR,BASEL,NDEG, - 1 IRED,WGT,AWGT,CDAT,AMP,PHAS,CMOD,CWGT, - 1 CSOL,SOL,MU,ME) -C - NCARG2=.TRUE. !ASSUME OK - NU=2*STHTEL !# OF UNKNOWNS - DOXY=.TRUE. !COMBINE X/Y - DOQ0=.TRUE. !Q=0 - GOTO 20 -C -C SELFCAL SOLUTION -C - ENTRY NCASGS(MAR,NIFR,IFR,BASEL,NDEG, - 1 IRED,WGT,AWGT,CDAT,AMP,PHAS,CMOD,CWGT, - 1 CSOL,SOL,MU,ME) -C - NCASGS=.TRUE. !ASSUME OK - NU=STHTEL !# OF UNKNOWNS - DOXY=.FALSE. !NO COMBINE X/Y - DOQ0=.FALSE. !NO Q=0 - DOSC=.TRUE. !SELFCAL - GOTO 21 -C -C ALIGN SOLUTION -C - ENTRY NCAAGS(MAR,NIFR,IFR,BASEL,NDEG, - 1 IRED,WGT,AWGT,CDAT,AMP,PHAS,CMOD,CWGT, - 1 CSOL,SOL,MU,ME,NUK,ALEQ) -C - NCAAGS=.TRUE. !ASSUME OK - NU=NUK !# OF UNKNOWNS - DOXY=.FALSE. !NO COMBINE X/Y - DOQ0=.FALSE. !NO Q=0 - DOSC=.FALSE. !NO SELFCAL - DOAL=.TRUE. !ALIGN - GOTO 22 -C -C ZERO SOLUTION MATRIX -C - 20 CONTINUE - DOSC=.FALSE. !NOT SELFCAL - 21 CONTINUE - DOAL=.FALSE. !NOT ALIGN - 22 CONTINUE - CALL WNMLIA(MAR,LSQ_I_ALL) !FULL AREA -C -C MAKE MATRIX -C - I1=0 !TEST REDUNDANT BASELINE - DO I=0,NIFR-1 !ALL IFRS - IF (.NOT.DOAL .AND. IRED(I).GT.0) THEN !REDUNDANT - IF (IRED(I).GT.I1) THEN !NEXT SET - IF (WGT(I,0).GT.0 .AND. (.NOT.DOXY .OR. (DOXY .AND. - 1 WGT(I,1).GT.0))) THEN !CAN USE AS BASE - I1=IRED(I) !NEW TEST VALUE - I4=I - TE1=IFR(I)/256 !TELESCOPES - TW1=MOD(IFR(I),256) - W2=AWGT(I,0) !SAVE WEIGHT - IF (DOXY) W4=AWGT(I,1) - IF (DOQ0) THEN !Q=0 - DO I2=0,NU-1 - CF(I2)=0 !ZERO COEFFICIENTS - END DO - CF(TW1)=CF(TW1)+1 - CF(STHTEL+TW1)=CF(STHTEL+TW1)-1 - CF(TE1)=CF(TE1)+1 - CF(STHTEL+TE1)=CF(STHTEL+TE1)-1 - CALL WNMLMN(MAR,LSQ_C_REAL,CF,W4*W2/(W4+W2), - 1 LOG(AMP(I,0))-LOG(AMP(I,1))- - 1 CSOL(TW1,0,0)-CSOL(TE1,0,0) - 1 +CSOL(TW1,0,1)+CSOL(TE1,0,1)) - END IF - IF (DOSC) THEN !SELFCAL - W4=(CWGT(I)*ABS(CMOD(I,0)))**2 !MODEL WEIGHT - IF (W4.NE.0) THEN - DO I2=0,NU-1 - CF(I2)=0 !ZERO COEFFICIENTS - END DO - CF(TW1)=CF(TW1)+1 - CF(TE1)=CF(TE1)+1 - CALL WNMLMN(MAR,LSQ_C_REAL,CF,W4*W2/(W4+W2), - 1 LOG(AMP(I,0))-LOG(ABS(CMOD(I,0)))- - 1 CSOL(TW1,0,0)-CSOL(TE1,0,0)) - END IF - END IF - DO I3=I+1,NIFR-1 !FIND OTHERS - IF (IRED(I3).EQ.I1.AND. - 1 WGT(I3,0).GT.0 .AND. (.NOT.DOXY .OR. (DOXY .AND. - 1 WGT(I3,1).GT.0))) THEN !CAN INCLUDE - TE2=IFR(I3)/256 !TELESCOPES - TW2=MOD(IFR(I3),256) - W22=AWGT(I3,0) !WEIGHTS - IF (DOXY) W24=AWGT(I3,1) - DO I2=0,NU-1 - CF(I2)=0 !ZERO COEFFICIENTS - END DO - CF(TW1)=CF(TW1)+1 !SET COEFFICIENTS - CF(TE1)=CF(TE1)+1 - CF(TW2)=CF(TW2)-1 - CF(TE2)=CF(TE2)-1 - CALL WNMLMN(MAR,LSQ_C_REAL,CF,W2*W22/(W2+W22), - 1 LOG(AMP(I4,0))-LOG(AMP(I3,0))-CSOL(TW1,0,0)- - 1 CSOL(TE1,0,0)+CSOL(TW2,0,0)+CSOL(TE2,0,0)) - IF (DOXY) THEN !XY SIMULTANEOUS - DO I2=0,NU-1 - CF(I2)=0 !ZERO COEFFICIENTS - END DO - CF(STHTEL+TW1)=CF(STHTEL+TW1)+1 !SET COEFFICIENTS - CF(STHTEL+TE1)=CF(STHTEL+TE1)+1 - CF(STHTEL+TW2)=CF(STHTEL+TW2)-1 - CF(STHTEL+TE2)=CF(STHTEL+TE2)-1 - CALL WNMLMN(MAR,LSQ_C_REAL,CF,W4*W24/(W4+W24), - 1 LOG(AMP(I4,1))-LOG(AMP(I3,1))-CSOL(TW1,0,1)- - 1 CSOL(TE1,0,1)+CSOL(TW2,0,1)+CSOL(TE2,0,1)) - END IF - END IF - END DO - END IF - END IF - ELSE IF (DOQ0 .AND. WGT(I,0).GT.0 .AND. WGT(I,1).GT.0) THEN - W22=AWGT(I,0) !WEIGHTS - W24=AWGT(I,1) - TE2=IFR(I)/256 !TELESCOPES - TW2=MOD(IFR(I),256) - DO I2=0,NU-1 - CF(I2)=0 !ZERO COEFFICIENTS - END DO - CF(TW2)=CF(TW2)+1 - CF(STHTEL+TW2)=CF(STHTEL+TW2)-1 - CF(TE2)=CF(TE2)+1 - CF(STHTEL+TE2)=CF(STHTEL+TE2)-1 - CALL WNMLMN(MAR,LSQ_C_REAL,CF,W24*W22/(W24+W22), - 1 LOG(AMP(I,0))-LOG(AMP(I,1))- - 1 CSOL(TW2,0,0)-CSOL(TE2,0,0) - 1 +CSOL(TW2,0,1)+CSOL(TE2,0,1)) - ELSE IF (DOSC .AND. WGT(I,0).GT.0) THEN - W22=AWGT(I,0) !DATA WEIGHT - W24=(CWGT(I)*ABS(CMOD(I,0)))**2 !MODEL WEIGHT - TE2=IFR(I)/256 !TELESCOPES - TW2=MOD(IFR(I),256) - IF (W24.NE.0) THEN - DO I2=0,NU-1 - CF(I2)=0 !ZERO COEFFICIENTS - END DO - CF(TW2)=CF(TW2)+1 - CF(TE2)=CF(TE2)+1 - CALL WNMLMN(MAR,LSQ_C_REAL,CF,W22*W24/(W22+W24), - 1 LOG(AMP(I,0))-LOG(ABS(CMOD(I,0)))- - 1 CSOL(TW2,0,0)-CSOL(TE2,0,0)) - END IF - ELSE IF (DOAL .AND. WGT(I,0).GT.0) THEN !ALIGN - W22=AWGT(I,0) !DATA WEIGHT - W24=(CWGT(I)*ABS(CMOD(I,0)))**2 !MODEL WEIGHT - TE2=IFR(I)/256 !TELESCOPES - TW2=MOD(IFR(I),256) - IF (W24.NE.0) THEN - DO I2=0,NU-1 - CF(I2)=ALEQ(TW2,I2)+ALEQ(TE2,I2) !SET COEFFICIENTS - END DO - CALL WNMLMN(MAR,LSQ_C_REAL,CF,W22*W24/(W22+W24), - 1 LOG(AMP(I,0))-LOG(ABS(CMOD(I,0)))- - 1 CSOL(TW2,0,0)-CSOL(TE2,0,0)) - END IF - END IF - END DO -C -C INVERT NORMAL EQUATIONS -C - CALL WNMLID(MAR) !FIX MISSING TELESCOPES - CALL WNMLTR(MAR,NR) !LU DECOMP. + RANK - NDEG=NU-NR !DEGENERACY -C -C SOLVE -C - CALL WNMLSN(MAR,SOL,MU,ME) !GET SOLUTION - DO I=0,NU-1 !CHECK FUNNY SOLUTION - IF (ABS(SOL(I,0,0)).GT.5.) NCARGS=.FALSE. - END DO - IF (NCARGS .AND. DOAL) THEN !MAKE ALIGN SOLUTION - DO I=0,NU-1 !SAVE SOLUTION - LSOL(I)=SOL(I,0,0) - END DO - DO I=0,STHTEL-1 !SET TELESCOPE ERRORS - SOL(I,0,0)=0 - DO I1=0,NU-1 - SOL(I,0,0)=SOL(I,0,0)+ALEQ(I,I1)*LSOL(I1) - END DO - END DO - END IF -C - RETURN !READY -C -C ERROR CALCULATION -C - ENTRY NCARGE(MAR,NIFR,IFR,BASEL,NDEG, - 1 IRED,WGT,AWGT,CDAT,AMP,PHAS,CMOD,CWGT, - 1 CSOL,SOL,MU,ME, - 1 ARMS,JAV,EAV,DAV) -C - NCARGE=.TRUE. !ASSUME OK - J0=1 !ADD ERRORS - DOSC=.FALSE. !NOT SELFCAL - DOAL=.FALSE. !NO ALIGN - GOTO 10 -C -C ERROR CORRECTION -C - ENTRY NCARGC(MAR,NIFR,IFR,BASEL,NDEG, - 1 IRED,WGT,AWGT,CDAT,AMP,PHAS,CMOD,CWGT, - 1 CSOL,SOL,MU,ME, - 1 ARMS,JAV,EAV,DAV) -C - NCARGC=.TRUE. !ASSUME OK - J0=-1 !SUBTRACT ERROR - DOSC=.FALSE. !NOT SELFCAL - DOAL=.FALSE. !NO ALIGN - GOTO 10 -C -C SELFCAL ERROR CALCULATION -C - ENTRY NCASGE(MAR,NIFR,IFR,BASEL,NDEG, - 1 IRED,WGT,AWGT,CDAT,AMP,PHAS,CMOD,CWGT, - 1 CSOL,SOL,MU,ME, - 1 ARMS,JAV,EAV,DAV) -C - NCASGE=.TRUE. !ASSUME OK - J0=1 !ADD ERRORS - DOSC=.TRUE. !SELFCAL - DOAL=.FALSE. !NO ALIGN - GOTO 10 -C -C SELFCAL ERROR CORRECTION -C - ENTRY NCASGC(MAR,NIFR,IFR,BASEL,NDEG, - 1 IRED,WGT,AWGT,CDAT,AMP,PHAS,CMOD,CWGT, - 1 CSOL,SOL,MU,ME, - 1 ARMS,JAV,EAV,DAV) -C - NCASGC=.TRUE. !ASSUME OK - J0=-1 !SUBTRACT ERROR - DOSC=.TRUE. !SELFCAL - DOAL=.FALSE. !NO ALIGN - GOTO 10 -C -C ALIGN ERROR CALCULATION -C - ENTRY NCAAGE(MAR,NIFR,IFR,BASEL,NDEG, - 1 IRED,WGT,AWGT,CDAT,AMP,PHAS,CMOD,CWGT, - 1 CSOL,SOL,MU,ME, - 1 ARMS,JAV,EAV,DAV) -C - NCAAGE=.TRUE. !ASSUME OK - J0=1 !ADD ERRORS - DOSC=.FALSE. !NO SELFCAL - DOAL=.TRUE. !ALIGN - GOTO 10 -C -C ALIGN ERROR CORRECTION -C - ENTRY NCAAGC(MAR,NIFR,IFR,BASEL,NDEG, - 1 IRED,WGT,AWGT,CDAT,AMP,PHAS,CMOD,CWGT, - 1 CSOL,SOL,MU,ME, - 1 ARMS,JAV,EAV,DAV) -C - NCAAGC=.TRUE. !ASSUME OK - J0=-1 !SUBTRACT ERROR - DOSC=.FALSE. !NO SELFCAL - DOAL=.TRUE. !ALIGN - GOTO 10 -C -C GET CELESTIAL GAINS -C - 10 CONTINUE - IF (DOSC .OR. DOAL) THEN !SELFCAL/ALIGN - DO I=0,NIFR-1 !GET MODEL AMPLITUDES - CELES(I)=LOG(ABS(CMOD(I,0))) - END DO - ELSE - DO I=0,NIFR-1 !ZERO CELESTIAL SOLUTION - CELES(I)=0 - WCELES(I)=0 - END DO - DO I=0,NIFR-1 !CALCULATE - IF (IRED(I).GT.0) THEN !REDUNDANT - IF (WGT(I,0).GT.0) THEN !CAN USE - I1=IRED(I) !POINTER - TE1=IFR(I)/256 !TELESCOPES - TW1=MOD(IFR(I),256) - W2=AWGT(I,0) !WEIGHT - CELES(I1)=CELES(I1)+W2*(LOG(AMP(I,0))- - 1 CSOL(TW1,0,0)-CSOL(TE1,0,0)) !SUM - WCELES(I1)=WCELES(I1)+W2 !SUM WEIGHT - END IF - END IF - END DO - DO I=0,NIFR-1 !SOLVE - IF (WCELES(I).GT.0) CELES(I)=CELES(I)/WCELES(I) - END DO - END IF -C -C INIT -C - JAV(0,0,0)=0 !NOISE - EAV(0,0,0)=0 - DAV(0,0,0)=0 - JAV(1,0,0)=0 !FRACT. NOISE (INCONS.) - EAV(1,0,0)=0 - DAV(1,0,0)=0 - JAV(4,0,0)=0 !MAX. DEVIATION - EAV(4,0,0)=0 - IF (JAV(2,0,0).NE.0) THEN !TOTAL COUNT - EAV(3,0,0)=SQRT(EAV(2,0,0)/JAV(2,0,0)) !OVERALL RUNNING NOISE - ELSE - EAV(3,0,0)=0 - END IF -C -C DO FOR IFRS -C - DO I=0,NIFR-1 !ALL IFRS - IF (DOSC .OR. DOAL .OR. IRED(I).GT.0) THEN !REDUNDANT - IF (WGT(I,0).GT.0) THEN !CAN USE - IF (DOSC .OR. DOAL) THEN !SELFCAL/ALIGN - I1=I - ELSE - I1=IRED(I) !REDUNDANT POINTER - END IF - TE1=IFR(I)/256 !TELESCOPES - TW1=MOD(IFR(I),256) -C -C ERROR -C - R0=LOG(AMP(I,0))-CSOL(TW1,0,0)-CSOL(TE1,0,0)-CELES(I1) !ERROR - IF (R0.GT.10) R0=10 !LIMIT EXTREME - R1=(EXP(R0)-1)*AMP(I,0) !FRACTIONAL ERROR - R2=AMP(I,0) !980701 -C -C EXTREME -C - IF (ABS(R0).GT.ABS(EAV(4,0,0))) THEN !MAX. DEVIATION - EAV(4,0,0)=R0 - JAV(4,0,0)=TW1*16+TE1 !WHERE - END IF -C -C NOISE -C - JAV(0,0,0)=JAV(0,0,0)+J0 !COUNT - EAV(0,0,0)=EAV(0,0,0)+J0*(R1**2) !NOISE - JAV(1,0,0)=JAV(1,0,0)+J0 !INCONSISTENCY - EAV(1,0,0)=EAV(1,0,0)+J0*(R0**2) - JAV(5,0,0)=JAV(5,0,0)+J0 !AVG NOISE - EAV(5,0,0)=EAV(5,0,0)+J0*R1 - JAV(6,0,0)=JAV(6,0,0)+J0 !AVG INCONSISTENCY - EAV(6,0,0)=EAV(6,0,0)+J0*R0 - JAV(2,0,0)=JAV(2,0,0)+J0 !AVG RMS - EAV(2,0,0)=EAV(2,0,0)+J0*(R1**2) - JAV(I,1,0)=JAV(I,1,0)+J0 !IFR AVG NOISE - DAV(I,1,0)=DAV(I,1,0)+J0*R1 - EAV(I,1,0)=EAV(I,1,0)+J0*R0 !FRACT. NOISE - JAV(I,2,0)=JAV(I,2,0)+J0 !IFR AVG RMS - DAV(I,2,0)=DAV(I,2,0)+J0*(R1**2) - EAV(I,4,0)=EAV(I,4,0)+J0*R0*R2*R2 !980701 - DAV(I,4,0)=DAV(I,4,0)+J0*R2*R2 !980701 - END IF - END IF - END DO -C -C NOISES AND TEL. GAINS -C - IF (JAV(0,0,0).GT.0) THEN !AVERAGE POSSIBLE - EAV(0,0,0)=SQRT(EAV(0,0,0)/JAV(0,0,0)) !NOISE - EAV(1,0,0)=SQRT(EAV(1,0,0)/JAV(1,0,0)) !INCONSISTENCY - DO I=0,STHTEL-1 !PER TELESCOPE - JAV(I,3,0)=JAV(I,3,0)+J0 !COUNT - EAV(I,3,0)=EAV(I,3,0)+J0*CSOL(I,0,0) !AVERAGE CORRECTION - DAV(I,3,0)=DAV(I,3,0)+J0*CSOL(I,0,0)*CSOL(I,0,0) !GAIN RMS - END DO - END IF -C -C AVERAGE AMPLITUDE -C - JAV(7,0,0)=JAV(7,0,0)+J0 !AVERAGE AMPLITUDE - EAV(7,0,0)=EAV(7,0,0)+J0*DBLE(ARMS(1)) !SUM - DAV(7,0,0)=DAV(7,0,0)+J0*(DBLE(ARMS(1))**2) !RMS -C - RETURN -C -C - END diff --git a/src/nscan/ncarmd.for b/src/nscan/ncarmd.for deleted file mode 100644 index 76961374b74eeb2cbaff2559683cb445aeaeac0e..0000000000000000000000000000000000000000 --- a/src/nscan/ncarmd.for +++ /dev/null @@ -1,133 +0,0 @@ -C+ NCARMD.FOR -C WNB 900312 -C -C Revisions: -C WNB 910808 Include ifrs deletion -C - LOGICAL FUNCTION NCARMD(NIFR,IFR,POL,WI,DAT,SIFRS, - 1 WGTMIN,WGT,AWGT,CDAT, - 1 AMP,PHAS,ARMS) -C -C Get redundancy scan data -C -C Result: -C -C NCARMD_L = NCARMD( NIFR_J:I, IFR_I(0:*):I, POL_J:I, WI_E(0:*,0:3):I, -C DAT_E(0:1,0:*,0:3):I, -C SIFRS_B(0:*,0:*):I, WGTMIN_E:I, -C WGT_E(0:*):O, AWGT_E(0:*):O, -C CDAT_X(0:*):O, AMP_E(0:*):O, PHAS_E(0:*):O, -C ARMS_E(0:2):O) -C Get data for redundancy calculations, -C using the data in DAT, the interferom. -C selection in SIFRS, and the weights WI. -C Output is the normalised weight WGT, -C the normalised amplitude weight AWGT, -C the complex data CDAT, the amplitude -C AMP, and the phase PHAS. -C ARMS give amplitude statistics. -C -C Include files: -C - INCLUDE 'WNG_DEF' - INCLUDE 'STH_O_DEF' !SET HEADER -C -C Parameters: -C -C -C Arguments: -C - INTEGER NIFR !# OF INTERFEROMETERS - INTEGER*2 IFR(0:*) !INTERFEROMETER TABLE - INTEGER POL !POLARISATION TO DO (0,1,2,3) - REAL WI(0:STHIFR-1,0:3) !WEIGHT OF DATA - REAL DAT(0:1,0:STHIFR-1,0:3) !COS/SIN DATA - BYTE SIFRS(0:STHTEL-1,0:STHTEL-1) !IFR SELECTION - REAL WGTMIN !MINIMUM ACCEPTABLE WEIGHT - REAL WGT(0:*) !NORMALISED DATA WEIGHT - REAL AWGT(0:*) !NORMALISED AMPLITUDE WEIGHTED WEIGHT - COMPLEX CDAT(0:*) !COMPLEX DATA POINTS - REAL AMP(0:*) !AMPLITUDES - REAL PHAS(0:*) !PHASES - REAL ARMS(0:2) !AVERAGE AMPLITUDE DATA -C -C Function references: -C -C -C Data declarations: -C - INTEGER N !COUNT IFRS WITH DATA -C- -C -C INIT -C - NCARMD=.TRUE. !ASSUME OK -C -C GET WEIGHTS -C - ARMS(0)=0 !MAX. AMPL. - ARMS(1)=0 !AVER. AMPL - D0=0 !RMS - R0=0 !MAX. WEIGHT - R1=0 - N=0 !COUNT - DO I=0,NIFR-1 !ALL IFRS - WGT(I)=0 !ASSUME ZERO WEIGHT - AWGT(I)=0 - IF (WI(I,POL).GT.0 .AND. !DATA PRESENT - 1 SIFRS(IFR(I)/256,MOD(IFR(I),256)).NE.0) THEN !IFR SELECTED - AMP(I)=ABS(CMPLX(DAT(0,I,POL),DAT(1,I,POL))) !AMPL - IF (AMP(I).GT.0) THEN - PHAS(I)=ATAN2(DAT(1,I,POL),DAT(0,I,POL)) !PHASE - CDAT(I)=CMPLX(DAT(0,I,POL),DAT(1,I,POL)) !COMPLEX - WGT(I)=SQRT(WI(I,POL)) !WEIGHT - AWGT(I)=WGT(I)*AMP(I) - R0=MAX(R0,WGT(I)) !GET MAXIMA - R1=MAX(R1,AWGT(I)) - ARMS(0)=MAX(ARMS(0),AMP(I)) - ARMS(1)=ARMS(1)+AMP(I) !AVERAGE - D0=D0+AMP(I)*AMP(I) !RMS - N=N+1 !COUNT - END IF - END IF - END DO -C -C CHECK DATA PRESENCE -C - 10 CONTINUE - IF (ARMS(0).EQ.0) THEN !NO DATA - NCARMD=.FALSE. - RETURN - END IF -C -C NORMALISE WEIGHT -C - DO I=0,NIFR-1 - IF (WGT(I).GT.0) THEN - WGT(I)=(WGT(I)/R0)**2 - AWGT(I)=AWGT(I)/R1 - IF (AWGT(I).LT.WGTMIN) THEN !FORGET POINT - WGT(I)=0 - AWGT(I)=0 - N=N-1 !CORRECT AVERAGES - ARMS(1)=ARMS(1)-AMP(I) - D0=D0-AMP(I)*AMP(I) - ELSE - AWGT(I)=AWGT(I)**2 - END IF - END IF - END DO -C -C CALCULATE AMPL. STATISTICS -C - IF (N.LE.0) THEN !NO DATA LEFT - ARMS(0)=0 - GOTO 10 - END IF - ARMS(1)=ARMS(1)/N !AVER. AMPL - ARMS(2)=SQRT(ABS(D0-ARMS(1)*ARMS(1)*N)/N) !RMS -C - RETURN !READY -C -C - END diff --git a/src/nscan/ncarps.for b/src/nscan/ncarps.for deleted file mode 100644 index 909f69147a63e9c5f1cad7d88a646730e847b382..0000000000000000000000000000000000000000 --- a/src/nscan/ncarps.for +++ /dev/null @@ -1,655 +0,0 @@ -C+ NCARPS.FOR -C WNB 900312 -C -C Revisions: -C WNB 910812 Add ALIGN -C WNB 910930 Narrower check -C WNB 911024 Overall running noise -C WNB 9110245 Check zero division -C HjV 920520 HP does not allow extended source lines -C WNB 930826 New model data -C JPH 940928 Comments -C WNB 950613 New LSQ routines -C WNB 980701 Add for new MIFR calculations -C CMV 030116 Acommodated for unsorted IFR table -C -C - LOGICAL FUNCTION NCARPS(MAR,NIFR,IFR,BASEL,NDEG, - 1 IRED,WGT,AWGT,CDAT,AMP,PHAS,CMOD,CWGT, - 1 CSOL,SOL,MU,ME) -C -C Calculate redundancy phase solution -C -C Result: -C -C NCARPS_L = NCARPS( -C MAR_J:I, NIFR_J:I,IFR_I(0:*):I, BASEL_E(0:*):I, -C NDEG_J:IO,IRED_J(0:NIFR-1):I, -C WGT_E(0:*,0:1):I,AWGT_E(0:*,0:1):I, -C CDAT_X(0:*,0:1):I,AMP_E(0:*,0:1):I,PHAS_E(0:*,0:1):I, -C CMOD_X(0:*,0:3):I, CWGT_E(0:*):I, -C CSOL_E(0:*,0:1,0:1):I, -C SOL_E(0:*,0:1,0:1):O,MU_E:O, ME_E:O) -C -C Calculate the redundancy phase solution in SOL, using CSOL as -C approximate solution, resulting in adjustment error MU and mean errors ME. -C -C MAR is the solution area for the telescopes, using NIFR interferometers -C tabulated in IFR with baselines BASEL and a degeneracy of NDEG. -C IRED specifies the redundant baselines. -C WGT is the weight, AWGT the amplitude-weighted weight -C CDAT/AMP/PHAS sre the data. -C CMOD is the model with sqrt(weights) CWGT. -C -C NCASPS_L = NCASPS( ...) -C Use model for constraints (selfcal) -C NCAAPS_L = NCAAPS( ..., NUK_J:I, ALEQ_E(0:*,0:*):I) -C Use model for aligning NUK parameters -C using equations ALEQ -C NCARP1_L = NCARP1( ...) -C Calculate X and Y simultaneous -C NCARP2_L = NCARP2( ...) -C Calculate X and Y simultaneous with Q=0 -C NCARPE_L = NCARPE( -C MAR_J:I, NIFR_J:I,IFR_I(0:*):I, BASEL_E(0:*):I, -C NDEG_J:IO,IRED_J(0:NIFR-1):I, -C WGT_E(0:*,0:1):I,AWGT_E(0:*,0:1):I, -C CDAT_X(0:*,0:1):I,AMP_E(0:*,0:1):I, PHAS_E(0:*,0:1):I, -C CMOD_X(0:*,0:3):I, CWGT_E(0:*):I, -C CSOL_E(0:*,0:1,0:1):I, -C SOL_E(0:*,0:1,0:1):I,MU_E:I, ME_E:I, -C ARMS_E(0:2):I, -C JAV_J(0:*,0:*,0:1):IO, EAV_E(0:*,0:*,0:1):IO, -C DAV_D(0:*,0:*,0:1):IO) -C Calculate all errors in the average -C arrays JAV, EAV and DAV. -C ARMS is the average amplitude of scan -C NCARPC_L = NCARPC( ...) -C Correct errors back -C NCASPE_L = NCASPE( ...) -C Calculate selfcal errors -C NCASPC_L = NCASPC( ...) -C Correct selfcal errors back -C NCAAPE_L = NCAAPE( ...) -C Calculate align errors -C NCAAPC_L = NCAAPC( ...) -C Correct align errors back -C -C JAV, EAV, DAV contain: -C *,*,0 gain -C *,*,1 phase -C 0,0 noise per scan -C 1,0 inconsistency per scan -C 2,0 total noise -C 3,0 overall running noise -C 4,0 max. deviation in scan -C 5,0 total average noise -C 6,0 total average incons. -C 7,0 total average ampl. -C *,1 inconsistency per ifr -C *,2 average rms per ifr -C *,3 gain per telescope -C!980701 *,4 weighted incons per ifr -C -C Include files: -C - INCLUDE 'WNG_DEF' - INCLUDE 'LSQ_O_DEF' - INCLUDE 'STH_O_DEF' !SET HEADER -C -C Entry points: -C - LOGICAL NCARP1,NCARP2 !CALCULATE X/Y SIMULTANEOUS - LOGICAL NCASPS !CALCULATE SELFCAL - LOGICAL NCAAPS !CALCULATE ALIGN - LOGICAL NCARPE,NCARPC !CALCULATE ERRORS - LOGICAL NCASPE,NCASPC !CALCULATE SELFCAL ERRORS - LOGICAL NCAAPE,NCAAPC !CALCULATE ALIGN ERRORS -C -C Parameters: -C -C -C Arguments: -C - INTEGER MAR !SOLUTION AREA POINTER - INTEGER NIFR !TOTAL # OF INTERFEROMETERS - INTEGER*2 IFR(0:*) !INTERFEROMETER TELESCOPES - INTEGER NDEG !DEGENERACY LEVEL - REAL BASEL(0:*) !BASELINES - INTEGER IRED(0:*) !REDUNDANCY INDICATOR - REAL WGT(0:STHIFR-1,0:*) !DATA WEIGHT X,Y - REAL AWGT(0:STHIFR-1,0:*) !AMPLITUDE WEIGHTED WEIGHT X,Y - COMPLEX CDAT(0:STHIFR-1,0:*) !DATA COMPLEX X,Y - REAL AMP(0:STHIFR-1,0:*) !DATA AMPLITUDE X,Y - REAL PHAS(0:STHIFR-1,0:*) !DATA PHASE X,Y - COMPLEX CMOD(0:STHIFR-1,0:*) !MODEL COMPLEX X,Y - REAL CWGT(0:*) !MODEL WEIGHT**0.5 - REAL SOL(0:STHTEL-1,0:1,0:1) !SOLUTION X,Y G,P - REAL CSOL(0:STHTEL-1,0:1,0:1) !CONTINUITY SOLUTION G,P X,Y - REAL MU !ADJUSTMENT ERROR - REAL ME !MEAN ERRORS SOLUTION - INTEGER NUK !# OF ALIGN EQUATIONS - REAL ALEQ(0:STHTEL-1,0:*) !ALIGN EQUATIONS - REAL ARMS(0:2) !AVERAGE AMPL. - INTEGER JAV(0:STHIFR-1,0:4,0:1) !COUNT FOR AVERAGES - REAL EAV(0:STHIFR-1,0:4,0:1) !SUM FOR AVERAGES - REAL*8 DAV(0:STHIFR-1,0:4,0:1) !SUM FOR RMS -C -C Function references: -C - REAL WNGENR !ANGLE -180,+180 -C -C Data declarations: -C - REAL CF(0:2*STHTEL-1),CG(0:2*STHTEL-1) !COEFFICIENTS FOR SOLUTION - INTEGER TW1,TE1,TW2,TE2 !TELESCOPES - REAL W2,W22 !WEIGHTS - REAL W4,W24 - REAL R2 !980701 - REAL CELES(0:STHIFR-1),WCELES(0:STHIFR-1) !CELESTIAL PHASES - COMPLEX CX(0:STHIFR-1,0:1) !SUM FOR GUESS - REAL PHASX(0:STHIFR-1,0:1),PHASY(0:STHIFR-1,0:1) !CORRECTED PHASES - REAL LSOL(0:STHTEL-1) !LOCAL ALIGN SOLUTION - INTEGER NR !RANK SOLUTION - INTEGER NU !# UNKNOWNS - LOGICAL DOQ0 !RG1/RG2 SWITCH - LOGICAL DOXY !XY SIMULTANEOUS SWITCH - LOGICAL DOSC !SELFCAL SWITCH - LOGICAL DOAL !ALIGN SWITCH -C- -C -C INIT -C - NCARPS=.TRUE. !ASSUME OK - NU=STHTEL !# OF UNKNOWNS - DOXY=.FALSE. !SEPARATE X/Y - DOQ0=.FALSE. !NO Q=0 - GOTO 20 -C -C X/Y SIMULTANEOUS -C - ENTRY NCARP1(MAR,NIFR,IFR,BASEL,NDEG, - 1 IRED,WGT,AWGT,CDAT,AMP,PHAS,CMOD,CWGT, - 1 CSOL,SOL,MU,ME) -C - NCARP1=.TRUE. !ASSUME OK - NU=2*STHTEL !# OF UNKNOWNS - DOXY=.TRUE. !COMBINE X/Y - DOQ0=.FALSE. !NO Q=0 - GOTO 20 -C -C X/Y SIMULTANEOUS WITH Q=0 -C - ENTRY NCARP2(MAR,NIFR,IFR,BASEL,NDEG, - 1 IRED,WGT,AWGT,CDAT,AMP,PHAS,CMOD,CWGT, - 1 CSOL,SOL,MU,ME) -C - NCARP2=.TRUE. !ASSUME OK - NU=2*STHTEL !# OF UNKNOWNS - DOXY=.TRUE. !COMBINE X/Y - DOQ0=.TRUE. !Q=0 - GOTO 20 -C -C SELFCAL SOLUTION -C - ENTRY NCASPS(MAR,NIFR,IFR,BASEL,NDEG, - 1 IRED,WGT,AWGT,CDAT,AMP,PHAS,CMOD,CWGT, - 1 CSOL,SOL,MU,ME) - NCASPS=.TRUE. !ASSUME OK - NU=STHTEL !# OF UNKNOWNS - DOXY=.FALSE. !SEPARATE X/Y - DOQ0=.FALSE. !NO Q=0 - DOSC=.TRUE. !SELFCAL - GOTO 21 -C -C ALIGN SOLUTION -C - ENTRY NCAAPS(MAR,NIFR,IFR,BASEL,NDEG, - 1 IRED,WGT,AWGT,CDAT,AMP,PHAS,CMOD,CWGT, - 1 CSOL,SOL,MU,ME,NUK,ALEQ) - NCAAPS=.TRUE. !ASSUME OK - NU=NUK !# OF UNKNOWNS - DOXY=.FALSE. !SEPARATE X/Y - DOQ0=.FALSE. !NO Q=0 - DOSC=.FALSE. !NO SELFCAL - DOAL=.TRUE. !ALIGN - GOTO 22 -C -C ZERO SOLUTION MATRIX -C - 20 CONTINUE - DOSC=.FALSE. !NOT SELFCAL - 21 CONTINUE - DOAL=.FALSE. !NOT ALIGN - 22 CONTINUE - CALL WNMLIA(MAR,LSQ_I_ALL) !FULL AREA -C -C MAKE GUESS FOR LOW LEVEL AMPLITUDES -C - DO I=0,NIFR-1 !ZERO AVERAGE - CX(I,0)=0 - END DO - IF (DOXY) THEN - DO I=0,NIFR-1 !ZERO AVERAGE Y - CX(I,1)=0 - END DO - END IF - IF (.NOT.DOAL) THEN !NOT FOR ALIGN - DO I=0,NIFR-1 !MAKE SUMS - IF (IRED(I).GT.0) THEN !REDUNDANT - I1=IRED(I) !REDUNDANT POINTER - TE1=IFR(I)/256 !TELESCOPES - TW1=MOD(IFR(I),256) - IF (WGT(I,0).GT.0) THEN - CX(I1,0)=CX(I1,0)+CDAT(I,0)*EXP(-CSOL(TW1,0,0)- - 1 CSOL(TE1,0,0))*CMPLX(COS(-CSOL(TW1,1,0)+ - 1 CSOL(TE1,1,0)),SIN(-CSOL(TW1,1,0)+ - 1 CSOL(TE1,1,0))) - END IF - IF (DOXY) THEN !X/Y SIMULTANEOUS - IF (WGT(I,1).GT.0) THEN - IF (DOQ0) THEN !Q=0 - CX(I1,0)=CX(I1,0)+CDAT(I,1)*EXP(-CSOL(TW1,0,1)- - 1 CSOL(TE1,0,1))*CMPLX(COS(-CSOL(TW1,1,1)+ - 1 CSOL(TE1,1,1)),SIN(-CSOL(TW1,1,1)+ - 1 CSOL(TE1,1,1))) - ELSE - CX(I1,1)=CX(I1,1)+CDAT(I,1)*EXP(-CSOL(TW1,0,1)- - 1 CSOL(TE1,0,1))*CMPLX(COS(-CSOL(TW1,1,1)+ - 1 CSOL(TE1,1,1)),SIN(-CSOL(TW1,1,1)+ - 1 CSOL(TE1,1,1))) - END IF - END IF - END IF - END IF - END DO - DO I=0,NIFR-1 !MAKE GUESS - IF (ABS(CX(I,0)).NE.0) THEN - PHASY(I,0)=ATAN2(AIMAG(CX(I,0)),REAL(CX(I,0))) - ELSE - PHASY(I,0)=0 - END IF - END DO - IF (DOXY .AND. .NOT.DOQ0) THEN - DO I=0,NIFR-1 !MAKE GUESS - IF (ABS(CX(I,1)).NE.0) THEN - PHASY(I,1)=ATAN2(AIMAG(CX(I,1)),REAL(CX(I,1))) - ELSE - PHASY(I,1)=0 - END IF - END DO - END IF - END IF - DO I=0,NIFR-1 !CORRECT PHASES - I1=IRED(I) !REDUNDANT POINTER - TE1=IFR(I)/256 !TELESCOPES - TW1=MOD(IFR(I),256) - IF (.NOT.DOAL .AND. IRED(I).GT.0) THEN !REDUNDANT - PHASX(I,0)=WNGENR(PHAS(I,0)-CSOL(TW1,1,0)+ - 1 CSOL(TE1,1,0)-PHASY(I1,0)) - IF (DOXY) THEN - IF (DOQ0) THEN - PHASX(I,1)=WNGENR(PHAS(I,1)-CSOL(TW1,1,1)+ - 1 CSOL(TE1,1,1)-PHASY(I1,0)) - ELSE - PHASX(I,1)=WNGENR(PHAS(I,1)-CSOL(TW1,1,1)+ - 1 CSOL(TE1,1,1)-PHASY(I1,1)) - END IF - END IF - ELSE IF (DOSC .OR. DOAL) THEN - PHASX(I,0)=WNGENR(PHAS(I,0)-CSOL(TW1,1,0)+ - 1 CSOL(TE1,1,0)) - IF (DOXY) THEN - IF (DOQ0) THEN - PHASX(I,1)=WNGENR(PHAS(I,1)-CSOL(TW1,1,1)+ - 1 CSOL(TE1,1,1)) - ELSE - PHASX(I,1)=WNGENR(PHAS(I,1)-CSOL(TW1,1,1)+ - 1 CSOL(TE1,1,1)) - END IF - END IF - END IF - END DO -C -C MAKE MATRIX -C - I1=0 !TEST REDUNDANT BASELINE - DO I=0,NIFR-1 !ALL IFRS - IF (.NOT.DOAL .AND. IRED(I).GT.0) THEN !REDUNDANT - IF (IRED(I).GT.I1) THEN !NEXT SET - IF (WGT(I,0).GT.0 .AND. (.NOT.DOXY .OR. (DOXY .AND. - 1 WGT(I,1).GT.0))) THEN !CAN USE AS BASE - I1=IRED(I) !NEW TEST VALUE - I4=I - TE1=IFR(I)/256 !TELESCOPES - TW1=MOD(IFR(I),256) - W2=AWGT(I,0) !SAVE WEIGHT - IF (DOXY) W4=AWGT(I,1) - IF (DOQ0) THEN !Q=0 - DO I2=0,NU-1 - CF(I2)=0 !ZERO COEFFICIENTS - END DO - CF(TW1)=CF(TW1)+1 - CF(STHTEL+TW1)=CF(STHTEL+TW1)-1 - CF(TE1)=CF(TE1)-1 - CF(STHTEL+TE1)=CF(STHTEL+TE1)+1 - CALL WNMLMN(MAR,LSQ_C_REAL,CF,W4*W2/(W4+W2), - 1 WNGENR(PHAS(I,0)-PHAS(I,1)- - 1 CSOL(TW1,1,0)+CSOL(TE1,1,0) - 1 +CSOL(TW1,1,1)-CSOL(TE1,1,1))) - END IF - IF (DOSC) THEN !SELFCAL - W4=(CWGT(I)*ABS(CMOD(I,0)))**2 !MODEL WEIGHT - IF (W4.NE.0) THEN - DO I2=0,NU-1 - CF(I2)=0 !ZERO COEFFICIENTS - END DO - CF(TW1)=CF(TW1)+1 - CF(TE1)=CF(TE1)-1 - CALL WNMLMN(MAR,LSQ_C_REAL,CF,W4*W2/(W4+W2), - 1 WNGENR(PHAS(I,0)- - 1 ATAN2(AIMAG(CMOD(I,0)),REAL(CMOD(I,0)))- - 1 CSOL(TW1,1,0)+CSOL(TE1,1,0))) - END IF - END IF - DO I3=I+1,NIFR-1 !FIND OTHERS - IF (IRED(I3).EQ.I1.AND. - 1 WGT(I3,0).GT.0 .AND. (.NOT.DOXY .OR. (DOXY .AND. - 1 WGT(I3,1).GT.0))) THEN !CAN INCLUDE - TE2=IFR(I3)/256 !TELESCOPES - TW2=MOD(IFR(I3),256) - W22=AWGT(I3,0) !WEIGHTS - IF (DOXY) W24=AWGT(I3,1) - DO I2=0,NU-1 - CF(I2)=0 !ZERO COEFFICIENTS - END DO - CF(TW1)=CF(TW1)+1 !SET COEFFICIENTS - CF(TE1)=CF(TE1)-1 - CF(TW2)=CF(TW2)-1 - CF(TE2)=CF(TE2)+1 - CALL WNMLMN(MAR,LSQ_C_REAL,CF,W2*W22/(W2+W22), - 1 PHASX(I4,0)-PHASX(I3,0)) - IF (DOXY) THEN !XY SIMULTANEOUS - DO I2=0,NU-1 - CF(I2)=0 !ZERO COEFFICIENTS - END DO - CF(STHTEL+TW1)=CF(STHTEL+TW1)+1 !SET COEFFICIENTS - CF(STHTEL+TE1)=CF(STHTEL+TE1)-1 - CF(STHTEL+TW2)=CF(STHTEL+TW2)-1 - CF(STHTEL+TE2)=CF(STHTEL+TE2)+1 - CALL WNMLMN(MAR,LSQ_C_REAL,CF,W4*W24/(W4+W24), - 1 PHASX(I4,1)-PHASX(I3,1)) - END IF - END IF - END DO - END IF - END IF - ELSE IF (DOQ0 .AND. WGT(I,0).GT.0 .AND. WGT(I,1).GT.0) THEN - W22=AWGT(I,0) !WEIGHTS - W24=AWGT(I,1) - TE2=IFR(I)/256 !TELESCOPES - TW2=MOD(IFR(I),256) - DO I2=0,NU-1 - CF(I2)=0 !ZERO COEFFICIENTS - END DO - CF(TW2)=CF(TW2)+1 - CF(STHTEL+TW2)=CF(STHTEL+TW2)-1 - CF(TE2)=CF(TE2)-1 - CF(STHTEL+TE2)=CF(STHTEL+TE2)+1 - CALL WNMLMN(MAR,LSQ_C_REAL,CF,W24*W22/(W24+W22), - 1 WNGENR(PHAS(I,0)-PHAS(I,1)- - 1 CSOL(TW2,1,0)+CSOL(TE2,1,0) - 1 +CSOL(TW2,1,1)-CSOL(TE2,1,1))) - ELSE IF (DOSC .AND. WGT(I,0).GT.0) THEN - W22=AWGT(I,0) !WEIGHTS - W24=(CWGT(I)*ABS(CMOD(I,0)))**2 - TE2=IFR(I)/256 !TELESCOPES - TW2=MOD(IFR(I),256) - IF (W24.NE.0) THEN - DO I2=0,NU-1 - CF(I2)=0 !ZERO COEFFICIENTS - END DO - CF(TW2)=CF(TW2)+1 - CF(TE2)=CF(TE2)-1 - CALL WNMLMN(MAR,LSQ_C_REAL,CF,W24*W22/(W24+W22), - 1 WNGENR(PHAS(I,0)- - 1 ATAN2(AIMAG(CMOD(I,0)),REAL(CMOD(I,0)))- - 1 CSOL(TW2,1,0)+CSOL(TE2,1,0))) - END IF - ELSE IF (DOAL .AND. WGT(I,0).GT.0) THEN !ALIGN - W22=AWGT(I,0) !WEIGHTS - W24=(CWGT(I)*ABS(CMOD(I,0)))**2 - TE2=IFR(I)/256 !TELESCOPES - TW2=MOD(IFR(I),256) - IF (W24.NE.0) THEN - DO I2=0,NU-1 - CF(I2)=ALEQ(TW2,I2)-ALEQ(TE2,I2) !SET COEFFICIENTS - END DO - CALL WNMLMN(MAR,LSQ_C_REAL,CF,W24*W22/(W24+W22), - 1 WNGENR(PHAS(I,0)- - 1 ATAN2(AIMAG(CMOD(I,0)),REAL(CMOD(I,0)))- - 1 CSOL(TW2,1,0)+CSOL(TE2,1,0))) - END IF - END IF - END DO -C -C INVERT NORMAL EQUATIONS -C - CALL WNMLID(MAR) !FIX MISSING TELESCOPES - CALL WNMLTR(MAR,NR) !LU DECOMP. + RANK - NDEG=NU-NR !DEGENERACY -C -C SOLVE -C - CALL WNMLSN(MAR,SOL,MU,ME) !GET SOLUTION - DO I=0,NU-1 !CHECK FUNNY SOLUTION - IF (ABS(SOL(I,0,0)).GT.5.) NCARPS=.FALSE. - END DO - IF (NCARPS .AND. DOAL) THEN !MAKE ALIGN SOLUTION - DO I=0,NU-1 - LSOL(I)=SOL(I,0,0) !SAVE SOLUTION - END DO - DO I=0,STHTEL-1 !SET ALIGN SOLUTION - SOL(I,0,0)=0 - DO I1=0,NU-1 - SOL(I,0,0)=SOL(I,0,0)+ALEQ(I,I1)*LSOL(I1) - END DO - END DO - END IF -C - RETURN !READY -C -C ERROR CALCULATION -C - ENTRY NCARPE(MAR,NIFR,IFR,BASEL,NDEG, - 1 IRED,WGT,AWGT,CDAT,AMP,PHAS,CMOD,CWGT, - 1 CSOL,SOL,MU,ME, - 1 ARMS,JAV,EAV,DAV) -C - NCARPE=.TRUE. !ASSUME OK - J0=1 !ADD ERRORS - DOSC=.FALSE. !NO SELFCAL - DOAL=.FALSE. !NOT ALIGN - GOTO 10 -C -C ERROR CORRECTION -C - ENTRY NCARPC(MAR,NIFR,IFR,BASEL,NDEG, - 1 IRED,WGT,AWGT,CDAT,AMP,PHAS,CMOD,CWGT, - 1 CSOL,SOL,MU,ME, - 1 ARMS,JAV,EAV,DAV) -C - NCARPC=.TRUE. !ASSUME OK - J0=-1 !SUBTRACT ERROR - DOSC=.FALSE. !NO SELFCAL - DOAL=.FALSE. !NOT ALIGN - GOTO 10 -C -C SELFCAL ERROR CALCULATION -C - ENTRY NCASPE(MAR,NIFR,IFR,BASEL,NDEG, - 1 IRED,WGT,AWGT,CDAT,AMP,PHAS,CMOD,CWGT, - 1 CSOL,SOL,MU,ME, - 1 ARMS,JAV,EAV,DAV) -C - NCASPE=.TRUE. !ASSUME OK - J0=1 !ADD ERRORS - DOSC=.TRUE. !SELFCAL - DOAL=.FALSE. !NOT ALIGN - GOTO 10 -C -C SELFCAL ERROR CORRECTION -C - ENTRY NCASPC(MAR,NIFR,IFR,BASEL,NDEG, - 1 IRED,WGT,AWGT,CDAT,AMP,PHAS,CMOD,CWGT, - 1 CSOL,SOL,MU,ME, - 1 ARMS,JAV,EAV,DAV) -C - NCASPC=.TRUE. !ASSUME OK - J0=-1 !SUBTRACT ERROR - DOSC=.TRUE. !SELFCAL - DOAL=.FALSE. !NOT ALIGN - GOTO 10 -C -C ALIGN ERROR CALCULATION -C - ENTRY NCAAPE(MAR,NIFR,IFR,BASEL,NDEG, - 1 IRED,WGT,AWGT,CDAT,AMP,PHAS,CMOD,CWGT, - 1 CSOL,SOL,MU,ME, - 1 ARMS,JAV,EAV,DAV) -C - NCAAPE=.TRUE. !ASSUME OK - J0=1 !ADD ERRORS - DOSC=.FALSE. !NOT SELFCAL - DOAL=.TRUE. !ALIGN - GOTO 10 -C -C ALIGN ERROR CORRECTION -C - ENTRY NCAAPC(MAR,NIFR,IFR,BASEL,NDEG, - 1 IRED,WGT,AWGT,CDAT,AMP,PHAS,CMOD,CWGT, - 1 CSOL,SOL,MU,ME, - 1 ARMS,JAV,EAV,DAV) -C - NCAAPC=.TRUE. !ASSUME OK - J0=-1 !SUBTRACT ERROR - DOSC=.FALSE. !NOT SELFCAL - DOAL=.TRUE. !ALIGN - GOTO 10 -C -C GET CELESTIAL PHASES -C - 10 CONTINUE - IF (DOSC .OR. DOAL) THEN !SELFCAL/ALIGN - DO I=0,NIFR-1 - IF (ABS(CMOD(I,0)).NE.0) THEN - CELES(I)=ATAN2(AIMAG(CMOD(I,0)),REAL(CMOD(I,0))) - ELSE - CELES(I)=0 - END IF - END DO - ELSE - DO I=0,NIFR-1 !ZERO CELESTIAL SOLUTION - CELES(I)=0 - WCELES(I)=0 - END DO - DO I=0,NIFR-1 !CALCULATE - IF (IRED(I).GT.0) THEN !REDUNDANT - IF (WGT(I,0).GT.0) THEN !CAN USE - I1=IRED(I) !POINTER - TE1=IFR(I)/256 !TELESCOPES - TW1=MOD(IFR(I),256) - W2=AWGT(I,0) !WEIGHT - CELES(I1)=CELES(I1)+W2*WNGENR(PHAS(I,0)- - 1 CSOL(TW1,1,0)+CSOL(TE1,1,0)) !SUM - WCELES(I1)=WCELES(I1)+W2 !SUM WEIGHT - END IF - END IF - END DO - DO I=0,NIFR-1 !SOLVE - IF (WCELES(I).GT.0) CELES(I)=CELES(I)/WCELES(I) - END DO - END IF -C -C INIT -C - JAV(0,0,1)=0 !NOISE - EAV(0,0,1)=0 - DAV(0,0,1)=0 - JAV(1,0,1)=0 !FRACT. NOISE (INCONS.) - EAV(1,0,1)=0 - DAV(1,0,1)=0 - JAV(4,0,1)=0 !MAX. DEVIATION - EAV(4,0,1)=0 - IF (JAV(2,0,1).NE.0) THEN !TOTAL COUNT - EAV(3,0,1)=SQRT(EAV(2,0,1)/JAV(2,0,1)) !OVERALL RUNNING NOISE - ELSE - EAV(3,0,1)=0 - END IF -C -C DO FOR IFRS -C - DO I=0,NIFR-1 !ALL IFRS - IF (DOSC .OR. DOAL .OR. IRED(I).GT.0) THEN !REDUNDANT - IF (WGT(I,0).GT.0) THEN !CAN USE - IF (DOSC .OR. DOAL) THEN !SELFCAL/ALIGN - I1=I - ELSE - I1=IRED(I) !REDUNDANT POINTER - END IF - TE1=IFR(I)/256 !TELESCOPES - TW1=MOD(IFR(I),256) -C -C ERROR -C - R0=WNGENR(PHAS(I,0)-CSOL(TW1,1,0)+CSOL(TE1,1,0)-CELES(I1)) !ERROR - IF (ABS(R0).GT.PI/2.) R0=R0-SIGN(PI,R0) !LIMIT EXTREME - R1=SIN(R0)*AMP(I,0) !FRACTIONAL ERROR - R2=AMP(I,0) !980701 -C -C EXTREME -C - IF (ABS(R0).GT.ABS(EAV(4,0,1))) THEN !MAX. DEVIATION - EAV(4,0,1)=R0 - JAV(4,0,1)=TW1*16+TE1 !WHERE - END IF -C -C NOISE -C - JAV(0,0,1)=JAV(0,0,1)+J0 !COUNT - EAV(0,0,1)=EAV(0,0,1)+J0*(R1**2) !NOISE - JAV(1,0,1)=JAV(1,0,1)+J0 !INCONSISTENCY - EAV(1,0,1)=EAV(1,0,1)+J0*(R0**2) - JAV(5,0,1)=JAV(5,0,1)+J0 !AVG NOISE - EAV(5,0,1)=EAV(5,0,1)+J0*R1 - JAV(6,0,1)=JAV(6,0,1)+J0 !AVG INCONSISTENCY - EAV(6,0,1)=EAV(6,0,1)+J0*R0 - JAV(2,0,1)=JAV(2,0,1)+J0 !AVG RMS - EAV(2,0,1)=EAV(2,0,1)+J0*(R1**2) - JAV(I,1,1)=JAV(I,1,1)+J0 !IFR AVG NOISE - DAV(I,1,1)=DAV(I,1,1)+J0*R1 - EAV(I,1,1)=EAV(I,1,1)+J0*R0 !FRACT. NOISE - JAV(I,2,1)=JAV(I,2,1)+J0 !IFR AVG RMS - DAV(I,2,1)=DAV(I,2,1)+J0*(R1**2) - EAV(I,4,1)=EAV(I,4,1)+J0*R0*R2*R2 !980701 - DAV(I,4,1)=DAV(I,4,1)+J0*R2*R2 !980701 - END IF - END IF - END DO -C -C NOISES AND TEL. PHASES -C - IF (JAV(0,0,1).GT.0) THEN !AVERAGE POSSIBLE - EAV(0,0,1)=SQRT(EAV(0,0,1)/JAV(0,0,1)) !NOISE - EAV(1,0,1)=SQRT(EAV(1,0,1)/JAV(1,0,1)) !INCONSISTENCY - DO I=0,STHTEL-1 !PER TELESCOPE - JAV(I,3,1)=JAV(I,3,1)+J0 !COUNT - EAV(I,3,1)=EAV(I,3,1)+J0*CSOL(I,1,0) !AVERAGE CORRECTION - DAV(I,3,1)=DAV(I,3,1)+J0*CSOL(I,1,0)*CSOL(I,1,0) !PHASE RMS - END DO - END IF -C - RETURN -C -C - END diff --git a/src/nscan/ncarrt.for b/src/nscan/ncarrt.for deleted file mode 100644 index 7fc54d40128376c37ddec8e9b09873197604c207..0000000000000000000000000000000000000000 --- a/src/nscan/ncarrt.for +++ /dev/null @@ -1,76 +0,0 @@ -C+ NCARRT.FOR -C WNB 900312 -C -C Revisions: -C WNB 930826 Add dipole angle check -C CMV 030116 Acommodated IFR tables that are not sorted -C - SUBROUTINE NCARRT(NIFR,BAS,BASDEV,IRED,ANG) -C -C Get redundancy table -C -C Result: -C -C CALL NCARRT( NIFR_J:I, BAS_E(0:*):I, BASDEV_E:I, -C IRED_J(0:*):O, ANG_E(0:2,0:*):I) -C Get the table of redundant baselines -C in IRED, using NIFR interferometers -C with baselines BAS. BASDEV gives the -C maximum deviation for redundancy. -C ANG is the dipole position -C -C Include files: -C - INCLUDE 'WNG_DEF' -C -C Parameters: -C -C -C Arguments: -C - INTEGER NIFR !# OF INTERFEROMETERS - REAL BAS(0:*) !BASELINES (<0: FORGET) - REAL BASDEV !BASELINE DEVIATION - INTEGER IRED(0:*) !REDUNDANCY VECTOR - REAL ANG(0:2,0:*) !DIPOLE POSITIONS -C -C Function references: -C -C -C Data declarations: -C - REAL DA(0:2) !ANGLE CHECKS -C- -C -C FIND BASELINES (NO SINGLES WILL BE COUNTED) -C - I=0 !BASELINE COUNT - DO I1=0,NIFR-1 !INITIALIZE - IRED(I1)=-1 !DEFAULT NON-REDUNDANT - END DO -C -C CHECK EACH BASELINE AGAINST ALL OTHERS, COUNT IF AT LEAST ONE MATCH -C - DO I1=0,NIFR-1 !ALL BASELINES - IF (IRED(I1).EQ.-1.AND.BAS(I1).GE.0) THEN !NOT YET CHECKED - R0=BAS(I1) !NEW CHECK BASELINE - DA(0)=ANG(0,I1) - DA(1)=ANG(1,I1) - DA(2)=ANG(2,I1) - DO I2=I1+1,NIFR-1 - IF (ABS(BAS(I2)-R0).LE.BASDEV .AND. - 1 ABS(DA(0)-ANG(0,I2)).LE.1E-6 .AND. - 1 ABS(DA(1)-ANG(1,I2)).LE.1E-6 .AND. - 1 ABS(DA(2)-ANG(2,I2)).LE.1E-6) THEN !FOUND ONE - IF (IRED(I1).EQ.-1) THEN !FIRST MATCH - I=I+1 !COUNT - IRED(I1)=I - END IF - IRED(I2)=I - END IF - END DO - END IF - END DO -C - RETURN !READY - END diff --git a/src/nscan/ncarwr.for b/src/nscan/ncarwr.for deleted file mode 100644 index 47a9b8ef62b5e7ebfdba6c917e899c36e5e6c462..0000000000000000000000000000000000000000 --- a/src/nscan/ncarwr.for +++ /dev/null @@ -1,110 +0,0 @@ -C+ NCARWR.FOR -C WNB 900822 -C -C Revisions: -C WNB 930606 Use LB_ iso L_ -C WNB 930825 Use XYX bits -C - LOGICAL FUNCTION NCARWR(FCA,STH,SCN,SCH,SOL,SPOL,TSOL,JAV,EAV,DAV) -C -C Write redundancy data to scan -C -C Result: -C -C NCARWR_L = NCARWR( FCA_J:I, STH_B(0:*):I, SCN_J:I, SCH_B(0:*):O, -C SOL_E(0:*,0:1,0:1):I, SPOL_J:I, TSOL_J:I, -C JAV,EAV,DAV) -C Read scan number SCN from FCA, using the -C set header STH. The scan header SCH, after -C filling with data from SOLution and AVerages -C will be written and -C returned for all four polarisations. -C SPOL and TSOL indicate the polarisations -C (1=x, 8=y) and type (1=gain, 2=phase) to do. -C -C Include files: -C - INCLUDE 'WNG_DEF' - INCLUDE 'CBITS_DEF' - INCLUDE 'STH_O_DEF' !SET HEADER - INCLUDE 'SCH_O_DEF' !SCAN HEADER -C -C Parameters: -C -C -C Arguments: -C - INTEGER FCA !FILE CONTROL AREA - BYTE STH(0:*) !CURRENT SET HEADER - INTEGER SCN !SCAN TO DO - BYTE SCH(0:*) !SCAN HEADER - REAL SOL(0:STHTEL-1,0:1,0:1) !SOL. X/Y, G/P - INTEGER SPOL !POL TO DO - INTEGER TSOL !GAIN/PHASE TO DO - INTEGER JAV(0:STHIFR-1,0:4,0:1,0:1) !AVERAGES - REAL EAV(0:STHIFR-1,0:4,0:1,0:1) - REAL*8 DAV(0:STHIFR-1,0:4,0:1,0:1) -C -C Function references: -C - LOGICAL WNFRD !READ DATA - LOGICAL WNFWR !WRITE DATA - INTEGER WNGARA !ADDRESS OF VARIABLE -C -C Data declarations: -C - INTEGER STHP,STHPI,STHPJ !SET HEADER POINTER - INTEGER SCHP,SCHPI,SCHPJ,SCHPE !SCAN HEADER POINTER - INTEGER*2 LDAT(0:2,0:4*STHIFR-1) !DATA BUFFER - INTEGER CDPOL(0:1) - DATA CDPOL/XX_P,YY_P/ !POLARISATION TYPES -C- -C -C INIT -C - NCARWR=.TRUE. !ASSUME OK - STHP=WNGARA(STH(0)) !ADDRESS SET HEADER - STHPI=(STHP-A_OB)/LB_I - STHPJ=(STHP-A_OB)/LB_J - SCHP=WNGARA(SCH(0)) !ADDRESS SCAN HEADER - SCHPI=(SCHP-A_OB)/LB_I - SCHPJ=(SCHP-A_OB)/LB_J - SCHPE=(SCHP-A_OB)/LB_E - IF (SCN.LT.0 .OR. SCN.GE.A_J(STHPJ+STH_SCN_J)) GOTO 900 !UNKNOWN SCAN - I=A_J(STHPJ+STH_SCNL_J) !LENGTH SCAN - J=A_J(STHPJ+STH_SCNP_J)+SCN*I !POINTER TO SCAN -C -C READ A SCAN -C - IF (.NOT.WNFRD(FCA,SCHHDL,SCH,J)) GOTO 900 !READ SCAN HEADER - DO I=0,1 !POL. - IF (IAND(SPOL,CDPOL(I)).NE.0) THEN !TO DO - DO I1=0,1 !GAIN, PHASE - IF (IAND(TSOL,2**I1).NE.0) THEN !TO DO - DO I2=0,STHTEL-1 !TEL. - I3=I1+2*I2+2*STHTEL*I !OFFSET - A_E(SCHPE+SCH_REDC_E+I3)=SOL(I2,I,I1) !SET CORRECTION - A_E(SCHPE+SCH_ALGC_E+I3)=0. !NO ALIGN - A_E(SCHPE+SCH_OTHC_E+I3)=0. !NO OTHERS - I4=2*I2+I1 - A_E(SCHPE+SCH_REDNS_E+I4)=EAV(0,0,I1,I) !SAVE NOISE - A_E(SCHPE+SCH_ALGNS_E+I4)=0 - A_E(SCHPE+SCH_OTHNS_E+I4)=0 - END DO - END IF - END DO - END IF - END DO - IF (.NOT.WNFWR(FCA,SCHHDL,SCH,J)) GOTO 900 !REWRITE SCAN HEADER -C - RETURN -C -C ERROR -C - 900 CONTINUE - NCARWR=.FALSE. -C - RETURN -C -C - END diff --git a/src/nscan/ncastz.fsc b/src/nscan/ncastz.fsc deleted file mode 100644 index 6ae732e2c573a45bc841d2562fb3743727576b41..0000000000000000000000000000000000000000 --- a/src/nscan/ncastz.fsc +++ /dev/null @@ -1,963 +0,0 @@ -C+ NCASTZ.FOR -C WNB 910813 -C -C Revisions: -C WNB 910820 Add STX, STR, STF, STL -C WNB 911009 Add STN -C WNB 911121 Typo in STF -C WNB 921104 Full HA range -C WNB 921201 Add gain/phase -C WNB 921217 Add NCAST1 -C HjV 930311 Change some text -C WNB 930602 Add NCASTI, NCASTK -C WNB 930602 Add NCASTY -C WNB 930606 Change scaling ionospheric refraction -C WNB 930614 Change scaling DX... -C WNB 930617 Add NCASTS -C WNB 930619 Add CBITS -C WNB 930623 Correct STL -C WNB 930803 CBITS_DEF -C WNB 930825 Change pol. definitions -C CMV 931027 Tell user what has been done (ZERO, MAN, COPY) -C JPH 931103 RTP factor in baseline pole -C CMV 940224 Add differential shifts -C CMV 940331 Select telescopes to copy corrections for -C CMV 940503 NCASTZ uses APSOL to select gains/phases -C CMV 940503 Enumerate types in NCASTX etc, zero SHIFT -C HjV 940516 Typo -C JPH 940809 Reduce frequency of "Scan done" outputs -C WNB 940811 Use NSCSWI for interferometer errors -C JPH 940902 Improve reporting (940809) -C CMV 940927 Add COR_MUL for extra gain factors -C JPH 950124 Merge CMV 940927 -C WNB 950614 Modify loop -C WNB 950628 Use CORAP/CORDAP in call to NSCSWI -C WNB 950629 Always assume loops -C CMV 960123 Clear NDONE/NSEC for SET ZERO -C HjV 960411 Put values on correct places in XCOR (NCASTX) -C Take all interferometers. (Also 00, 11 etc.) -C JPH 960614 NCASTN: Leave undefined corrections unchanged -C JPH 960725 Fix GP initialisation -C JPH 961118 Fix handling of absent values in renormalisation -C NCASTN: STL --> STG -C JPH 961209 Reorganise renormalisation to produce meaningful result C for gain -C JPH 9701.. Optional gain renormalisation for non-FM configuration, -C controlled by FREGPH<0 -C JPH 970204 Emit 'forced renormalisation' message only once. -C WNB 080711 Added NCASTV -C WNB 080726 Made NCASTV for multiple sets -C -C - SUBROUTINE NCASTZ -C -C Set corrections in scan file -C -C Result: -C -C CALL NCASTZ will zero the specified corrections in scan files -C CALL NCASTV will invert the specified corrections in scan files -C (only the 'apply' ones; not de-apply) -C CALL NCASTC will set the provided corrections in scans -C CALL NCAST1( STHPI_J:I) will set the corrections in one set -C CALL NCASTL will copy continuum corrections to line channels -C CALL NCASTN will renormalise telescope corrections -C CALL NCASTX will set various corrections in scans -C TYP = COR_EXT : extinction -C COR_CLK : clock correction -C COR_IRF : ion. refraction -C COR_FAR : faraday rotation -C COR_AIFR : additive ifr.errors -C COR_MIFR : multiplicative ifr. -C CALL NCASTY( TYP_J:I) will set the corrections in OTHS: -C TYP = COR_POLE : baseline pole -C COR_FRQ : frequency -C COR_DX : dx -C COR_DY : dy -C COR_DZ : dz -C CALL NCASTS will set the (de-apply) shifts in STH -C -C Include files: -C - INCLUDE 'WNG_DEF' - INCLUDE 'CBITS_DEF' - INCLUDE 'STH_O_DEF' ! SET HEADER - INCLUDE 'SCH_O_DEF' ! SCAN HEADER - INCLUDE 'NCA_DEF' -C -C Parameters: -C - INTEGER MXNFAR ! LENGTH FARADAY FILE - PARAMETER (MXNFAR=100) - INTEGER FIRSTM ! first movable telescope - PARAMETER (FIRSTM=10) - INTEGER G,P, F,M, E,W, X,Y ! gain,phase, fixed,movable, - ! East,West, X,Y - PARAMETER (G=0,P=1, F=0,M=1, W=0,E=1, X=0,Y=1) - INTEGER RED,ALG,OTH - PARAMETER (RED=1, ALG=2, OTH=3) !corrn table index -C -C Arguments: -C - INTEGER STHPI ! STHP FOR ST1 - INTEGER TYP ! TYPE OF CORRECTION - INTEGER JDONE ! messaging flag -C -C Function references: -C - LOGICAL WNFWR ! WRITE FILE - LOGICAL WNFRD ! READ FILE - INTEGER WNFEOF ! FIND END OF FILE - CHARACTER*32 WNTTSG ! GET SET NAME - REAL WNGEND ! NORMALISE ANGLE - LOGICAL NSCSTL,NSCSTG ! GET A SET - LOGICAL NSCSCH,NSCSCT ! READ SCAN HEADER - LOGICAL NSCSCW ! WRITE SCAN HEADER - LOGICAL NSCSWC ! WRITE CORRECTION RESULTS - LOGICAL NSCSWI ! WRITE IFR CORRECTIONS - LOGICAL NSCSIF ! GET IFR TABLE -C -C Data declarations: -C - LOGICAL DOST1 ! ST1 SWITCH - LOGICAL DOINV ! INV SWITCH - INTEGER SNAM(0:7,0:2) ! SET NAMES - INTEGER SETNAM(0:7) ! FULL SET NAME - EQUIVALENCE (SETNAM,SNAM(0,1)) - REAL HA ! HA OF SCAN - REAL CHA,SHA ! COS, SIN(HA) - DOUBLE PRECISION CDEC,SDEC ! COS, SIN(DEC) - REAL SFRQ ! FREQ. SCALE - REAL CLAT,SLAT ! COS, SIN(LAT) - REAL CSOL(0:STHTEL-1,0:1,0:1) ! SOLUTION G,P X,Y - INTEGER NFARAD ! # OF FARADAY LINES - REAL FAROT(2,MXNFAR) ! FARADAY DATA - REAL TCOR(0:1,0:STHTEL-1,0:1) ! TELESCOPE CORRECTIONS - COMPLEX XCOR(0:3,0:STHIFR-1) ! INTERFEROMETER CORRECTIONS - REAL TMU ! M.E. (OR <0 IF DELETED SCAN) - INTEGER STHP,STHP1 ! POINTER TO SET HEADER - COMPLEX C0 ! DUMMY COMPLEX - INTEGER IGP, ISCN, ITL, ITL1, IXY, IFR ! loop indices - INTEGER RPTR ! CORR. TABLE PTR - INTEGER INDX ! TEL. INDEX IN TABLE - INTEGER CTYP ! LOOP CORRECTION TYPE -C - INTEGER CDPOL(0:1) ! POL. CODES - DATA CDPOL/XX_P,YY_P/ - INTEGER PLFL(0:3) - DATA PLFL/XX_P,XY_P,YX_P,YY_P/ - INTEGER NSOFF(0:1,0:2) ! OFFSETS FOR NOISES - DATA NSOFF/CAP_RED,STH_REDNS_E, - 1 CAP_ALG,STH_ALGNS_E, - 1 CAP_OTH,STH_OTHNS_E/ -C - INTEGER*2 IFRT(0:STHIFR-1) ! INTERFEROMETER TABLE - INTEGER IFRA(0:1,0:STHIFR-1) - REAL ANG(0:2,0:STHIFR-1) - INTEGER NDONE, NSEC ! scans/sectors-done counters - CHARACTER POL (0:1) - DATA POL/'X','Y'/ - CHARACTER*5 GP(G:P) - DATA GP/'gain','phase'/ - CHARACTER*(STHTEL+STHTEL/5) TELMSK ! telescope mask message text - CHARACTER SYMB(0:1) ! mask symbols - DATA SYMB/'1','.'/ - REAL SUM(F:M) ! remorm. accum., fixed and mov. - REAL N(F:M) ! counts - INTEGER FM ! fixed/movable index - LOGICAL DOGAIN ! 'gain normalisation' flag - LOGICAL FCGAIN ! 'force gain normalisn' flag - INTEGER BIT ! MASK BIT TEST -C - BYTE STH(0:STHHDL-1) ! SET HEADER - INTEGER*2 STHI(0:STHHDL/2-1) - INTEGER STHJ(0:STHHDL/4-1) - REAL STHE(0:STHHDL/4-1) - REAL*8 STHD(0:STHHDL/8-1) - EQUIVALENCE(STH,STHI,STHJ,STHE,STHD) - BYTE STH1(0:STHHDL-1) ! SET HEADER - INTEGER*2 STH1I(0:STHHDL/2-1) - INTEGER STH1J(0:STHHDL/4-1) - REAL STH1E(0:STHHDL/4-1) - REAL*8 STH1D(0:STHHDL/8-1) - EQUIVALENCE(STH1,STH1I,STH1J,STH1E,STH1D) - BYTE SCH(0:SCHHDL-1) ! SCAN HEADER - INTEGER*2 SCHI(0:SCHHDL/2-1) - INTEGER SCHJ(0:SCHHDL/4-1) - REAL SCHE(0:SCHHDL/4-1) - REAL*8 SCHD(0:SCHHDL/8-1) - EQUIVALENCE(SCH,SCHI,SCHJ,SCHE,SCHD) - BYTE SCH1(0:SCHHDL-1) ! SCAN HEADER - INTEGER*2 SCH1I(0:SCHHDL/2-1) - INTEGER SCH1J(0:SCHHDL/4-1) - REAL SCH1E(0:SCHHDL/4-1) - REAL*8 SCH1D(0:SCHHDL/8-1) - EQUIVALENCE(SCH1,SCH1I,SCH1J,SCH1E,SCH1D) -C- -C -C INIT -C - DOINV=.FALSE. ! INDICATE ZERO - GOTO 12 -C -C STV -C - ENTRY NCASTV -C - DOINV=.TRUE. - GOTO 12 -C - 12 CONTINUE - DOST1=.FALSE. - CORDAP=0 ! NOTHING DE-APPLIED - CORAP=NOT(CORZE) ! CORRECT FOR ZERO - DO I3=0,1 ! X,Y - DO I2=0,1 ! G,P - DO I1=0,STHTEL-1 ! TEL. - CSOL(I1,I2,I3)=0 ! ZERO CORRECTION - END DO - END DO - END DO - NSEC=0 - NDONE=0 - GOTO 10 -C -C STC -C - ENTRY NCASTC -C - DOST1=.FALSE. - DOINV=.FALSE. - GOTO 11 -C -C ST1 -C - ENTRY NCAST1(STHPI) -C - DOST1=.TRUE. - DOINV=.FALSE. - STHP=STHPI ! GET STHP - GOTO 11 -C - 11 CONTINUE - NSEC=0 - NDONE=0 - APSOL(0)=.TRUE. ! DO GAIN - APSOL(1)=.TRUE. ! DO PHASE - CORDAP=0 ! NOTHING DE-APPLIED - CORAP=0 ! NOTHING APPLIED - CORZE=0 ! NO ZEROING - DO I3=0,1 ! X,Y - DO I1=0,STHTEL-1 ! TEL. - CSOL(I1,0,I3)=LOG(ABS(PCGAN(I1,I3)))! PUT CORRECTION - CSOL(I1,1,I3)=PCPHS(I1,I3)/180.*PI ! MAKE RADIANS - END DO - END DO - GOTO 10 -C -C DO SEcTorS -C - 10 CONTINUE - IF (.NOT.DOST1) THEN - IF (.NOT.NSCSTL(FCAOUT,SETS,STH(0),STHP,SETNAM,LPOFF)) - 1 GOTO 21 ! NO MORE SETS - ELSE - IF (.NOT.WNFRD(FCAOUT,STHHDL,STH(0),STHP)) GOTO 22 - ! READ SET HEADER - SETNAM(0)=STHJ(STH_SETN_J) ! SAVE SET NUMBER - SETNAM(1)=-2 - END IF - NSEC=NSEC+1 -C -C DO SCANS -C - DO I=0,STHJ(STH_SCN_J)-1 ! ALL SCANS -C -C INIT SCAN -C - HA=STHE(STH_HAB_E)+I*STHE(STH_HAI_E) ! HA OF SCAN - IF (HA.LT.HARAN(1) .OR. HA.GT.HARAN(2)) GOTO 30 - ! FORGET -C -C ZERO -C - IF (.NOT.DOINV) THEN - IF (.NOT.NSCSWC(FCAOUT,STH,I,CSOL,CAP_OTH,APSOL,XYSOL,TELS, - 1 CORAP,CORDAP,CORZE)) THEN - 31 CONTINUE - CALL WNCTXT(F_TP,' !7$EAF7.2 Error writing scan data',HA) - GOTO 20 ! TRY NEXT SET - END IF - IF (.NOT.NSCSWI(FCAOUT,STH,I,IFRT,0,IAND(CORZE,CAP_MIFR), - 1 0,0,CORZE)) GOTO 31 - IF (.NOT.NSCSWI(FCAOUT,STH,I,IFRT,0,IAND(CORZE,CAP_AIFR), - 1 0,0,CORZE)) GOTO 31 - ELSE -C -C INVERT -C - IF (.NOT.NSCSCH(FCAOUT,STH,0,I,0,0,SCH)) THEN ! READ SCAN HDR - GOTO 32 ! TRY NEXT SCAN - END IF -CC CALL WNCTXT(F_TP, 'corze !UL',CORZE) ! xxx - DO IXY=X,Y ! X,Y - IF (XYSOL(IXY)) THEN ! X OR Y TODO? - DO ITL=0,STHTEL-1 - IF (TELS(ITL)) THEN !THIS TELESCOPE TODO? - INDX=2*ITL+2*STHTEL*IXY ! OFFSET ON CORRECTION ARRAY - BIT=1 ! MASK BIT - RPTR=SCH_REDC_E ! START WITH REDUN - DO CTYP=RED,OTH ! RED,ALG,OTH - IF (IAND(CORZE,BIT).NE.0) THEN ! DO THIS CORRECTION - DO IGP=G,P ! GAIN AND PHASE - IF (APSOL(IGP)) THEN - SCHE(RPTR+INDX+IGP)=-SCHE(RPTR+INDX+IGP) !INVERT - END IF - END DO - END IF - BIT=2*BIT !NEXT CORR. TABLE - RPTR=RPTR+SCH_ALGC_E-SCH_REDC_E - END DO ! END CTYP LOOP - END IF - END DO ! END TELESCOPE LOOP - END IF - END DO ! END XY LOOP - IF (.NOT.NSCSCW(FCAOUT,STH,0,I,0,0,SCH)) THEN ! WRITE SCAN HDR - GOTO 31 - END IF - END IF ! END INVERT -C -C NEXT SCAN -C - 30 CONTINUE - NDONE=NDONE+1 - 32 CONTINUE - IF (MOD(NDONE,100).EQ.0) - 1 CALL WNCTXT(F_TP,'Now at output sector !AS: !UJ scans done', - 1 WNTTSG(SETNAM,0), NDONE) - END DO ! END SCANS -C -C NEXT SEcTor -C - 20 CONTINUE - IF (.NOT.DOINV) THEN - IF (IAND(CAP_SHF,CORZE).NE.0) THEN ! ZERO SHIFT - DO I=0,1 ! SET SHIFTS - STHE(STH_SHFT_E+I)= 0 - STHE(STH_DSHFT_E+I)=0 - END DO - END IF -C - IF (CORZE.NE.0) THEN ! ZERO NOISES - DO I=0,2 ! RESET NOISES - IF (IAND(NSOFF(0,I),CORZE).NE.0) THEN - ! CORRECTION SET ZERO - DO I3=0,1 ! GAIN,PHASE - IF (APSOL(I3)) THEN ! DO - DO I4=0,1 ! X,Y - IF (XYSOL(I4)) STHE(NSOFF(1,I)+I3+2*I4)=0 - ! ZERO NOISE - END DO - END IF - END DO - END IF - END DO - IF (.NOT.WNFWR(FCAOUT,STHHDL,STH,STHP)) THEN - ! REWRITE SET HEADER - 22 CONTINUE - CALL WNCTXT(F_TP,'Error reading/writing '// - 1 'Sector header !AS',WNTTSG(SETNAM,0)) - END IF - END IF ! END ZERO NOISES - END IF - IF (.NOT.DOST1) GOTO 10 ! NEXT SET -C -C READY -C - 21 CONTINUE - CALL WNCTXT(F_TP, - 1 '!13C\Total of !UJ output sectors, !UJ scans', NSEC, NDONE) - RETURN ! READY -C -C STL -C - ENTRY NCASTL -C -C DO SETS -C - DO WHILE (NSCSTL(FCAOUT,SETS,STH(0),STHP,SETNAM,LPOFF)) - ! NEXT SET - DO I=1,7 ! MAKE CONTINUUM SEARCH - SNAM(I,0)=0 - END DO - SNAM(0,0)=1 - SETNAM(3)=RS1 ! CONTINUUM CHANNEL - IF (.NOT.NSCSTG(FCAOUT,SNAM,STH1(0),STHP1,SNAM(0,2))) THEN - ! NO CONT. - CALL WNCTXT(F_TP,'No continuum channel !AS', - 1 WNTTSG(SETNAM,0)) - GOTO 61 ! NEXT SET - END IF -C -C DO SCANS -C - DO I=0,STHJ(STH_SCN_J)-1 ! ALL SCANS -C -C INIT SCAN -C - HA=STHE(STH_HAB_E)+I*STHE(STH_HAI_E)! HA OF SCAN - IF (HA.LT.HARAN(1) .OR. HA.GT.HARAN(2)) GOTO 60 - ! FORGET - IF (.NOT.NSCSCH(FCAOUT,STH,0,I,0,0,SCH)) THEN - ! READ SCAN - GOTO 61 ! TRY NEXT SCAN - END IF -C -C CONTINUUM DATA -C - I1=NINT((HA-STH1E(STH_HAB_E))/STH1E(STH_HAI_E)) - ! INPUT SCAN # - IF (.NOT.NSCSCH(FCAOUT,STH1,0,I1,0,0,SCH1)) THEN - GOTO 61 ! TRY NEXT SCAN - END IF -C -C COPY DATA -C - DO I2=0,1 ! NOISES - IF (IAND(SPOL,CDPOL(I2)).NE.0) THEN - ! WANT POL. - DO I3=0,1 - SCHE(SCH_REDNS_E+2*I2+I3)=SCH1E(SCH_REDNS_E+2*I2+I3) - SCHE(SCH_ALGNS_E+2*I2+I3)=SCH1E(SCH_ALGNS_E+2*I2+I3) - SCHE(SCH_OTHNS_E+2*I2+I3)=SCH1E(SCH_OTHNS_E+2*I2+I3) - END DO - END IF - END DO - SCHE(SCH_EXT_E)=SCH1E(SCH_EXT_E) ! EXTINCTION - SCHE(SCH_REFR_E)=SCH1E(SCH_REFR_E) ! REFRACTION - SCHE(SCH_FARAD_E)=SCH1E(SCH_FARAD_E)! FARADAY - SCHE(SCH_IREF_E)=SCH1E(SCH_IREF_E) ! IONOS REFRACTION - SCHE(SCH_CLKC_E)=SCH1E(SCH_CLKC_E) ! CLOCK CORRECTION - DO I2=0,1 ! CORRECTIONS - IF (IAND(SPOL,CDPOL(I2)).NE.0) THEN - ! WANT POL. - DO I3=0,STHTEL-1 - DO I4=0,1 - SCHE(SCH_REDC_E+2*STHTEL*I2+2*I3+I4)= - 1 SCH1E(SCH_REDC_E+2*STHTEL*I2+2*I3+I4) - SCHE(SCH_ALGC_E+2*STHTEL*I2+2*I3+I4)= - 1 SCH1E(SCH_ALGC_E+2*STHTEL*I2+2*I3+I4) - SCHE(SCH_OTHC_E+2*STHTEL*I2+2*I3+I4)= - 1 SCH1E(SCH_OTHC_E+2*STHTEL*I2+2*I3+I4) - END DO - END DO - END IF - END DO - SCHJ(SCH_IFRAC_J)=SCH1J(SCH_IFRAC_J)! IFR CORRECTIONS - SCHJ(SCH_IFRMC_J)=SCH1J(SCH_IFRMC_J) -C -C WRITE HEADER -C - IF (.NOT.NSCSCW(FCAOUT,STH,0,I,0,0,SCH)) THEN - CALL WNCTXT(F_TP,'!7$EAF7.2 Error writing scan data',HA) - GOTO 61 ! TRY NEXT SET - END IF -C -C NEXT SCAN -C - 61 CONTINUE - END DO ! END SCANS -C -C NEXT SET -C - 60 CONTINUE - END DO ! END SETS -C - RETURN ! READY -C -C STN -C - ENTRY NCASTN(JDONE) -C -C INIT -C - APSOL(0)=.TRUE. ! DO GAIN - APSOL(1)=.TRUE. ! DO PHASE - IF (JDONE.EQ.0) THEN - JDONE=1 - CALL WNCTXT(F_TP,' - 1!/!4C\ As of December 1996, the gain renormalisation algorithm has - 1!/!4C\been changed. Gain renormalisations made earlier are in error. - 1!/!4C\To redo them, first zero the ALG corrections with the SET ZERO - 1!/!4C\option. - 1!/ - 1!/!4C\ The revised code is valid exclusively for the "standard" - 1!/!4C\WSRT configuration with only fixed-movable interferometers. It - 1!/!4C\will equalise the average gains of the fixed and movable - 1!/!4C\telescope groups. If either group is absent in the selection - 1!/!4C\(FORCE_GAIN parameter), the average for the telescopes selected - 1!/!4C\will be zeroed !/' ) - ENDIF -C -C Gain renormalisation requested? To be forced for non-standard configuration? -C -!= I1=ITL - DOGAIN=.FALSE. - FCGAIN=.FALSE. - DO ITL=0,STHTEL-1 - IF (FREGPH(ITL,G).NE.0) DOGAIN=.TRUE. - IF (FREGPH(ITL,G).LT.0) FCGAIN=.TRUE. - ENDDO -!= -C C Sector loop -C - DO WHILE (NSCSTG(FCAOUT,SETS,STH(0),STHP,SETNAM)) - CALL WNDSTI(FCAOUT,SETNAM) -C -C Get IFR table and check for FM configuration. -C - IF (DOGAIN) THEN ! Gain normalisation - IF (FCGAIN) THEN ! Forcing requested - IF (JDONE.LT.2) THEN - JDONE=2 - CALL WNCTXT(F_TP, - 1'!4C\Forced gain renormalisation:!/' // - 1'!4C\' // - 1'Resulting gain corrections are WRONG for FF and MM interferometers' ) - ENDIF - ELSE - IF (.NOT.NSCSIF(FCAOUT,STH,IFRT,IFRA,ANG)) GOTO 73 - DO IFR=0,STHJ(STH_NIFR_J)-1 - IF (IFRA(W,IFR).GE.FIRSTM .OR. - 1 IFRA(E,IFR).LT.FIRSTM) THEN - CALL WNCTXT(F_TP, - 1'!-18$AS Aborting gain renormalisation for a nonstandard WSRT' // - 1'!/!20C\configuration: !XJ!XJ is not fixed-movable', - 1 WNTTSG(SETNAM,0), IFRA(W,IFR),IFRA(E,IFR) ) - GOTO 70 - ENDIF - ENDDO - ENDIF - ENDIF -C -C Scan loop -C -!= I=ISCN - DO ISCN=0,STHJ(STH_SCN_J)-1 ! ALL SCANS - HA=STHE(STH_HAB_E)+ISCN*STHE(STH_HAI_E) - IF (HA.LT.HARAN(1) .OR. HA.GT.HARAN(2)) GOTO 71 -C -C GET HEADER AND CORRECTIONS -C - IF (.NOT.NSCSCT(FCAOUT,STH,0,ISCN,CORAP,0,SCH, - 1 TCOR,TMU)) THEN - 73 CONTINUE - CALL WNCTXT(F_TP,'!7$EAF7.2 Error reading/writing scan data',HA) - GOTO 70 ! TRY NEXT SET - END IF - -C -C DO -C Phase renormalisation simply reduces the average of selected telescopes -C to zero. -C Gain renormalisation is meaningful only in the case where the telescopes -C form two groups, with no correlations within each group. Renormalisation -C consists of making the gain averages for the two groups equal. The present -C code covers only the specific case of fixed and movable groups, which is by -C far the most common one. -C For phase the F accumulator is used for all telescopes and the M -C accumulator is left at 0. For gain, the F and M accumulations are done -C separately and then combined. -C In the special case that only F or M telescopes are selected, the gain -C average for these selected telescopes is reduced to 0. -C The renormalisation corrections are store in the OTH table. -C -!= I=ISCN I1=IGP I2=ITL I3=IXY - IF (TMU.GE.0) THEN ! PRESENT - DO IGP=G,P ! GAIN, PHASE - DO IXY=0,1 ! X,Y - SUM(F)=0 ! AVERAGES - SUM(M)=0 - N(F)=0 ! COUNTS - N(M)=0 - I=1 ! TELMSK index - FM=F ! begin with fixed telescopes - DO ITL=0,STHTEL-1 - IF (IGP.EQ.G .AND. ! for gain, - 1 ITL.EQ.FIRSTM) FM=M ! switch to moving telescopes - CSOL(ITL,IGP,IXY)=0 ! preset - IF (FREGPH(ITL,IGP).NE.0 .AND.! selected - 1 TCOR(IGP,ITL,IXY).NE.0.)! and present - 1 THEN - N(FM)=N(FM)+1 - SUM(FM)=SUM(FM)+TCOR(IGP,ITL,IXY) - TELMSK(I:I)='.' - ELSEIF (FREGPH(ITL,IGP).NE.0) THEN - TELMSK(I:I)='1' ! selected and not present - ELSE - TELMSK(I:I)='.' ! not selected - ENDIF - I=I+1 ! next char in TELMSK - IF (MOD(ITL+1,5).EQ.0) THEN - TELMSK(I:I)=' ' ! insert a blank - I=I+1 - ENDIF - ENDDO - IF (N(F)+N(M).NE.0) THEN ! some values found - IF (TELMSK.NE.'..... ..... ....') THEN - ! some values missing - CALL WNCTXT(F_TP,'!-18$AS !6$EAF7.2' // - 1 ' Missing !1$AS !-5$AS value(s): !AS', - 1 WNTTSG(SETNAM,0),SCHE(SCH_HA_E), - 1 POL(IXY),GP(IGP), TELMSK ) - END IF - IF (N(F).NE.0) SUM(F)=SUM(F)/N(F) - IF (N(M).NE.0) SUM(M)=SUM(M)/N(M) - IF (IGP.EQ.G) THEN ! for gain, - SUM(F)=SUM(F)-SUM(M) ! make F and M averages equal - IF (N(F).NE.0 .AND. N(M).NE.0) - 1 SUM(F)=SUM(F)/2 - ENDIF - I=-1 - DO ITL=0,STHTEL-1 - IF (IGP.EQ.0 .AND. ITL.EQ.FIRSTM) - 1 I=1 ! reverse gain for moving tel. - IF (TCOR(IGP,ITL,IXY) .NE.0.)! if correction defined, - 1 CSOL(ITL,IGP,IXY)=I*SUM(F)! set normalising value - END DO - ENDIF - END DO! x, y - END DO! gain, phase - END IF -!= -C -C WRITE HEADER -C - IF (.NOT.NSCSWC(FCAOUT,STH,ISCN,CSOL,CAP_OTH,APSOL,XYSOL,TELS, - 1 -1,0,0)) GOTO 73 -C -C NEXT SCAN -C - 71 CONTINUE - END DO! scans -C -C NEXT SET -C - 70 CONTINUE - END DO! sectors -C - RETURN -C -C STX -C - ENTRY NCASTX(TYP) -C -C -C READ FARADAY DATA -C - IF (TYP.EQ.COR_FAR.OR.TYP.EQ.COR_IRF) THEN - ! NEED IONOSPHERE - CALL WNGLUN(J3) -#ifdef wn_li__ - OPEN (UNIT=J3,ERR=50,FILE=FILINP,STATUS='OLD') -#else - OPEN (UNIT=J3,ERR=50,FILE=FILINP,READONLY,STATUS='OLD') -#endif - ! OPEN INPUT - NFARAD=0 - DO WHILE (NFARAD.LT.MXNFAR) ! READ - READ (UNIT=J3,FMT=*,ERR=50,END=51) - 1 FAROT(1,NFARAD+1),FAROT(2,NFARAD+1) - NFARAD=NFARAD+1 - END DO - 51 CONTINUE - CLOSE (UNIT=J3,ERR=52) - 52 CONTINUE - CALL WNGLUF(J3) -C -C SORT -C - DO I=1,NFARAD-1 - DO I1=1,NFARAD-1 - IF (FAROT(1,I1).GT.FAROT(1,I1+1)) THEN - DO I2=1,2 - R0=FAROT(I2,I1) - FAROT(I2,I1)=FAROT(I2,I1+1) - FAROT(I2,I1+1)=R0 - END DO - END IF - END DO - END DO - END IF -C - GOTO 42 ! SET CORRECTIONS -C -C ERROR READING IONOSPHERE -C - 50 CALL WNCTXT(F_TP,'Cannot open/read Faraday file !AS',FILINP) - CLOSE (UNIT=J3,ERR=53) - 53 CONTINUE - RETURN -C -C DO SETS -C - 42 CONTINUE - DO WHILE(NSCSTL(FCAOUT,SETS,STH(0),STHP,SETNAM,LPOFF)) - ! NEXT SET -C -C READ IFR TABLE AND SORT CORRECTIONS -C - IF (TYP.EQ.COR_MIFR.OR.TYP.EQ.COR_AIFR) THEN - ! NEED IFR TABLE - IF (.NOT.NSCSIF(FCAOUT,STH,IFRT,IFRA,ANG)) THEN - ! READ IFR TABLE - CALL WNCTXT(F_TP,'!/Error reading IFR table !AS', - 1 WNTTSG(SETNAM,0)) - GOTO 40 ! TRY NEXT SET - END IF -C - IF (TYP.EQ.COR_MIFR) THEN - C0=CMPLX(LOG(1.),0.) ! ASSUME PERFECT GAIN - ELSE - C0=CMPLX(0,0) ! ASSUME NO OFFSET - END IF - DO I4=0,STHJ(STH_NIFR_J)-1 - DO I3=0,3 - XCOR(I3,I4)=C0 ! DEFAULT VALUE - END DO - END DO -C - I4=0 ! INDEX IN ICOR - DO WHILE (I4.LT.STHJ(STH_NIFR_J)) ! FIND INDEX IN IFRT - I=-1 ! POINTER IN IFRCOR - DO I1=0,STHTEL-1 - DO I2=I1,STHTEL-1 - I=I+1 ! NEXT ENTRY IN IFRCOR - IF (SIFRS(I1,I2)) THEN ! IFR SELECTED - IF (IFRT(I4).EQ.I1*256+I2.OR. - 1 IFRT(I4).EQ.I2*256+I1) THEN - ! FOUND - DO I3=0,3 - IF (IAND(SPOL,PLFL(I3)).NE.0) THEN - ! POL SELECTED - XCOR(I3,I4)=IFRCOR(I,I3) - ! COPY - END IF - END DO - GOTO 44 - END IF - END IF - END DO ! I2 - END DO ! I1 - 44 CONTINUE - I4=I4+1 - END DO ! WHILE I4 - END IF -C -C DO SCANS -C - DO I=0,STHJ(STH_SCN_J)-1 ! ALL SCANS -C -C INIT SCAN -C - HA=STHE(STH_HAB_E)+I*STHE(STH_HAI_E)! HA OF SCAN - IF (HA.LT.HARAN(1) .OR. HA.GT.HARAN(2)) GOTO 41 - ! FORGET -C -C GET HEADER -C - IF (.NOT.NSCSCH(FCAOUT,STH,0,I,0,0,SCH)) THEN - 43 CONTINUE - CALL WNCTXT(F_TP, - 1 '!7$EAF7.2 Error reading/writing scan data',HA) - GOTO 40 ! TRY NEXT SET - END IF -C -C DO -C - IF (TYP.EQ.COR_CLK) THEN ! CLOCK CORRECTION - SCHE(SCH_CLKC_E)=CFREF(0) - ELSE IF (TYP.EQ.COR_EXT) THEN ! EXTINCTION - SCHE(SCH_EXT_E)=CFEXT(0)+STHD(STH_FRQ_D)/1000.* - 1 (CFEXT(1)+STHD(STH_FRQ_D)/1000.*CFEXT(2)) - ELSE IF (TYP.EQ.COR_REF) THEN ! REFRACTION - SCHE(SCH_REFR_E)=CFREF(0)+STHD(STH_FRQ_D)/1000.* - 1 (CFREF(1)+STHD(STH_FRQ_D)/1000.*CFREF(2)) - ELSE IF (TYP.EQ.COR_FAR.OR.TYP.EQ.COR_IRF) THEN - ! IONOSPHERIC - R0=HA*360. ! HA DEGREES - IF (NFARAD.GT.0) THEN - I1=1 - DO WHILE (I1.LE.NFARAD) - IF (R0.LE.FAROT(1,I1)) GOTO 54! FOUND - I1=I1+1 - END DO - 54 CONTINUE - IF (I1.LE.1) THEN - R1=FAROT(2,1) ! ROTATION - ELSE IF (I1.GT.NFARAD) THEN - R1=FAROT(2,NFARAD) - ELSE - R1=(R0-FAROT(1,I1-1))/(FAROT(1,I1)-FAROT(1,I1-1)) - ! FRACTION - R1=(1-R1)*FAROT(2,I1-1)+R1*FAROT(2,I1) - END IF - ELSE - R1=0 ! NO FARADAY/REFRACTION - END IF - IF (TYP.EQ.COR_FAR) THEN ! FARADAY - R1=R1/((STHD(STH_FRQ_D)/1000.)**2) - ! SCALE - SCHE(SCH_FARAD_E)=WNGEND(R1)/DEG! SAVE RADIANS - ELSE ! IONOS. REFRACTION - R1=R1/(STHD(STH_FRQ_D)/1000.) ! SCALE - SCHE(SCH_IREF_E)=WNGEND(R1)/360.! SAVE CIRCLES - END IF - END IF -C -C WRITE HEADER -C - IF (.NOT.NSCSCW(FCAOUT,STH,0,I,0,0,SCH)) GOTO 43 -C -C WRITE IFR ERRORS -C - IF (TYP.EQ.COR_AIFR) THEN ! ADD. IFR - IF (.NOT.NSCSWI(FCAOUT,STH,I,IFRT,XCOR,CAP_AIFR, - 1 CORAP,CORDAP,0)) GOTO 43! SAVE - ELSE IF (TYP.EQ.COR_MIFR) THEN ! MUL. IFR - IF (.NOT.NSCSWI(FCAOUT,STH,I,IFRT,XCOR,CAP_MIFR, - 1 CORAP,CORDAP,0)) GOTO 43! SAVE - END IF -C -C NEXT SCAN -C - 41 CONTINUE - END DO ! END SCANS -C -C NEXT SET -C - 40 CONTINUE - END DO -C - RETURN -C -C STY -C - ENTRY NCASTY(TYP) -C - APSOL(0)=.FALSE. ! NO GAIN - APSOL(1)=.TRUE. ! DO PHASE - IF (TYP.EQ.COR_MUL) THEN ! EXTRA GAIN FACTORS - APSOL(0)=.TRUE. ! ONLY GAIN - APSOL(1)=.FALSE. ! NO PHASE - END IF - DO I1=0,STHTEL-1 ! ALL TELESCOPES - TELS(I1)=.TRUE. - END DO - CORDAP=0 ! NOTHING DE-APPLIED - CORAP=CAP_OTH ! ADD TO OTHS APPLIED - CORZE=0 ! NO ZEROING -C -C DO SETS -C - DO WHILE (NSCSTL(FCAOUT,SETS,STH(0),STHP,SETNAM,LPOFF)) - SDEC=SIN(STHD(STH_DEC_D)*PI2) ! SIN(DEC) - CDEC=COS(STHD(STH_DEC_D)*PI2) ! COS(DEC) - SFRQ=STHD(STH_FRQ_D)/(CL*1E-6) ! FREQ. SCALE - IF (STHJ(STH_INST_J).EQ.1) THEN ! ATNF - SLAT=SLATA - CLAT=CLATA - ELSE ! WSRT - SLAT=SLATW - CLAT=CLATW - END IF -C -C DO SCANS -C - DO I=0,STHJ(STH_SCN_J)-1 ! ALL SCANS -C -C INIT SCAN -C - HA=STHE(STH_HAB_E)+I*STHE(STH_HAI_E)! HA OF SCAN - IF (HA.LT.HARAN(1) .OR. HA.GT.HARAN(2)) GOTO 81 - ! FORGET - SHA=SIN(HA*PI2) - CHA=COS(HA*PI2) -C -C GET CORRECTIONS -C - DO I1=0,STHTEL-1 ! TEL. - IF (TYP.EQ.COR_FRQ) THEN ! FREQ. - CSOL(I1,1,0)=-PI2*STHE(STH_RTP_E+I1)* - 1 PCGAN(0,0)*SFRQ*CDEC*SHA/ - 1 STHD(STH_FRQ_D) - CSOL(I1,1,1)=CSOL(I1,1,0) ! Y CORR= X CORR - ELSE IF (TYP.EQ.COR_DX) THEN ! DX - CSOL(I1,1,0)=PI2* - 1 PCGAN(I1,0)/1000.*SFRQ* - 1 CDEC*SHA - CSOL(I1,1,1)=CSOL(I1,1,0) ! Y CORR= X CORR - ELSE IF (TYP.EQ.COR_DY) THEN ! DY - CSOL(I1,1,0)=-PI2* - 1 PCGAN(I1,0)/1000.*SFRQ* - 1 (SDEC*CLAT-CDEC*CHA*SLAT) - CSOL(I1,1,1)=CSOL(I1,1,0) ! Y CORR= X CORR - ELSE IF (TYP.EQ.COR_DZ) THEN ! DZ - CSOL(I1,1,0)=-PI2* - 1 PCGAN(I1,0)/1000.*SFRQ* - 1 (SDEC*SLAT+CDEC*CHA*CLAT) - CSOL(I1,1,1)=CSOL(I1,1,0) ! Y CORR= X CORR - ELSE IF (TYP.EQ.COR_POLE) THEN ! BASEL. POLE - CSOL(I1,1,0)=-PI2*STHE(STH_RTP_E+I1)* - 1 PCGAN(0,0)/DEG*SFRQ* - 1 SDEC - CSOL(I1,1,1)=CSOL(I1,1,0) ! Y CORR= X CORR - ELSE IF (TYP.EQ.COR_MUL) THEN ! EXTRA FACTOR - CSOL(I1,0,0)=LOG(ABS(PCGAN(I1,0))) - CSOL(I1,0,1)=LOG(ABS(PCGAN(I1,1))) - END IF - END DO ! END TEL. -C -C APPLY -C - IF (.NOT.NSCSWC(FCAOUT,STH,I,CSOL,CAP_OTH,APSOL,XYSOL,TELS, - 1 CORAP,CORDAP,CORZE)) THEN - CALL WNCTXT(F_TP,'!7$EAF7.2 Error writing scan data',HA) - GOTO 80 ! TRY NEXT SET - END IF -C -C NEXT SCAN -C - 81 CONTINUE - END DO ! END SCANS -C -C NEXT SET -C - 80 CONTINUE - END DO ! END SETS -C -C READY -C - RETURN ! READY -C -C STS -C - ENTRY NCASTS -C -C DO SETS -C - DO WHILE (NSCSTL(FCAOUT,SETS,STH(0),STHP,SETNAM,LPOFF)) - DO I=0,1 ! SET SHIFTS - STHE(STH_SHFT_E+I)= CFREF(I) - STHE(STH_DSHFT_E+I)=CFEXT(I) - END DO - IF (.NOT.WNFWR(FCAOUT,STHHDL,STH,STHP)) GOTO 22 - ! REWRITE SET HEADER - END DO ! END SETS -C -C READY -C - RETURN ! READY -C -C - END - diff --git a/src/nscan/ncatel.for b/src/nscan/ncatel.for deleted file mode 100644 index 3c462fe9dcac5be73d3ecf7489368daeaf93271f..0000000000000000000000000000000000000000 --- a/src/nscan/ncatel.for +++ /dev/null @@ -1,252 +0,0 @@ -C+ NCATEL.FOR -C CMV 940428 -C -C Revisions: -C CMV 940428 Created based on 'T' option in NFLPRT.FOR -C HjV 940516 Remove R0 declaration -C CMV 940518 Add option to select interferometers -C JPH 940909 Comments -C WNB 981022 Make usable for loops -C - SUBROUTINE NCATEL(FCA,SETS1,HA1,HA2,SIFRS1,PCGAN1,PCPHS1,OUT) -C -C Get initial estimates for gain and phase -C -C Result: -C -C CALL NCATEL(FCA_J:I,SETS1(0:7,0:*)_J:I, -C HA1_E:I, HA2_E:I, SIFRS1(0:STHTEL-1,0:STHTEL-1)_B:I, -C PCGAN1(0:STHTEL-1,0:1)_E:O, -C PCPHS1(0:STHTEL-1,0:1)_E:O),OUT_J:I -C -C Will find average gains in PCGAN1 and phase offsets in PCPHS1 -C for the data in the specified SETS1 in FCA, in hour-angle -C range HA1..HA2 and for the interferometers in SIFRS. -C Print result on OUT if >0 (F_T,F_TP). -C -C CALL NCATL1(FCA_J:I,STH(0:*)_B:I, -C HA1_E:I, HA2_E:I, SIFRS1(0:STHTEL-1,0:STHTEL-1)_J:I, -C PCGAN1(0:STHTEL-1,0:1)_E:O, -C PCPHS1(0:STHTEL-1,0:1)_E:O,OUT_J:I) -C -C Idem but for single sector described by STH -C -C -C PIN references: -C -C -C Include files: -C - INCLUDE 'WNG_DEF' - INCLUDE 'NCA_DEF' - INCLUDE 'CBITS_DEF' - INCLUDE 'STH_O_DEF' !SET HEADER - INCLUDE 'SCH_O_DEF' !SCAN HEADER -C -C Parameters: -C -C -C Arguments: -C - INTEGER FCA !FILE TO SEARCH - INTEGER SETS1(0:7,0:*) !SETS TO DO - BYTE STH_IN(0:*) !HEADER OF SINGLE SET - REAL HA1,HA2 !HOUR ANGLE RANGE - BYTE SIFRS1(0:STHTEL-1,0:STHTEL-1) !IFR SELECTION - REAL PCGAN1(0:STHTEL-1,0:1) !RETURN GAIN CORRECTIONS - REAL PCPHS1(0:STHTEL-1,0:1) !RETURN PHASE OFFSETS - INTEGER OUT !OUTPUT FOR PRINT -C -C Function references: -C - LOGICAL WNFRD !READ FILE - LOGICAL NSCSTL !GET SETS TO DO - CHARACTER*32 WNTTSG !SET NAME - REAL WNGEFD !FRACTIONS TO DEGREES - LOGICAL NSCSIF !READ IFR TABLE -C -C Data declarations: -C - LOGICAL SINGLE !SINGLE SET - LOGICAL MORE !MORE SETS TO DO - REAL HA !HA OF SCAN - COMPLEX C0 !COMPLEX BUFFER - INTEGER SNAM(0:7) !SET NAME - CHARACTER*78 TEXT(-1:STHTEL) !TEXT LINES - CHARACTER*(STHTEL) TELS1 !TELESCOPE NAMES - DATA TELS1/'0123456789ABCD'/ -C - INTEGER*2 IFRT(0:STHIFR-1) !IFR TABLE - INTEGER IFRA(0:1,0:STHIFR-1) ! IFR TABLE - REAL ANG(0:2,0:STHIFR-1) ! DIPOLE ANGLES -C - INTEGER GPN(0:STHTEL-1,0:1) !TEL. GAIN COUNTS - COMPLEX GPV(0:STHTEL-1,0:1) !TEL. GAINS -C - INTEGER STHP !SET HEADER POINTER - INTEGER SCHP !SCAN HEADER POINTER - BYTE STH(0:STHHDL-1) !SET HEADER - INTEGER STHJ(0:STHHDL/4-1) - INTEGER*2 STHI(0:STHHDL/2-1) - REAL STHE(0:STHHDL/4-1) - EQUIVALENCE (STH,STHJ,STHI,STHE) - BYTE SCH(0:SCHHDL-1) !SCAN HEADER - INTEGER*2 ODAT(0:2,0:800) !DATA -C- -C - SINGLE=.FALSE. !NOT SINGLE SET - MORE=NSCSTL(FCA,SETS1,STH,STHP,SNAM,LPOFF) !GET FIRST SET - GOTO 10 -C - ENTRY NCATL1(FCA,STH_IN,HA1,HA2,SIFRS1,PCGAN1,PCPHS1,OUT) -C - SINGLE=.TRUE. !SINGLE SET - MORE=.TRUE. !ONE SET MORE TO DO - CALL WNGMV(STHHDL,STH_IN,STH) !COPY SET HEADER - GOTO 10 -C - 10 CONTINUE -C -C Initialise buffers -C - DO I1=0,1 !X,Y - DO I2=0,STHTEL-1 !TELESCOPES - GPN(I2,I1)=0 !NO DATA - GPV(I2,I1)=CMPLX(1.,0.) !ASSUME PERFECT GAIN - PCGAN1(I2,I1)=1 ! IDEM - PCPHS1(I2,I1)=0 ! IDEM - END DO - END DO -C -C Loop over all sectors -C - DO WHILE (MORE) - IF (.NOT.NSCSIF(FCA,STH,IFRT,IFRA,ANG)) THEN !READ IFR TABLE - CALL WNCTXT(F_TP,'Error reading interferometer table') - GOTO 100 !TRY NEXT SET - END IF -C -C Loop over all scans per sector -C - DO I3=0,STHJ(STH_SCN_J)-1 !ALL SCANS - HA=STHE(STH_HAB_E)+I3*STHE(STH_HAI_E) !HA OF SCAN - IF (HA.GE.HA1-STHE(STH_HAI_E)/2+1E-5 .AND. - 1 HA.LE.HA2+STHE(STH_HAI_E)/2-1E-5) THEN !DO - SCHP=STHJ(STH_SCNP_J)+I3*STHJ(STH_SCNL_J) !SCAN HEADER POINTER - IF (.NOT.WNFRD(FCA,SCHHDL,SCH,SCHP)) THEN !READ SCAN - CALL WNCTXT(F_TP,'Error reading scan header') - ELSE IF (.NOT.WNFRD(FCA, - 1 3*LB_I*STHI(STH_PLN_I)*STHJ(STH_NIFR_J), - 1 ODAT(0,0),SCHP+SCHHDL)) THEN !READ DATA - CALL WNCTXT(F_TP,'Error reading scan header') - ELSE -C -C Loop over all interferometers and polarisations -C - DO I2=0,STHJ(STH_NIFR_J)-1 !ALL INTERFEROMETERS - DO I1=0,1 ! xx, yy - IF (I1.EQ.0) THEN - I=STHI(STH_PLN_I)*I2 ! xx DATA POINTER - ELSE IF (STHI(STH_PLN_I).EQ.2) THEN - I=STHI(STH_PLN_I)*I2+1 ! yy DATA POINTER - ELSE IF (STHI(STH_PLN_I).EQ.4) THEN - I=STHI(STH_PLN_I)*I2+3 ! yy DATA POINTER - ELSE - I=-1 !NOT PRESENT - END IF - IF (I.GE.0) THEN !POL. PRESENT - IF (ODAT(0,I).NE.0) THEN !DATA PRESENT - I5=ODAT(0,I) !WEIGHT/FLAGS - IF (IAND(FL_ALL,I5).EQ.0) THEN !USE DATA -C - I4=IFRT(I2)/256 !EAST - I5=MOD(IFRT(I2),256) !WEST - IF (SIFRS1(I5,I4)) THEN !SELECTED - C0=CMPLX(ODAT(1,I),ODAT(2,I)) !MAKE COMPLEX - C0=C0/GPV(I4,I1)/CONJG(GPV(I5,I1)) !CORRECT FOR KNOWN - IF (GPN(I4,I1).EQ.0) THEN !DISTRIBUTE - IF (GPN(I5,I1).EQ.0) THEN - C0=SQRT(C0) !TO USE - GPV(I4,I1)=GPV(I4,I1)*C0 - GPV(I5,I1)=GPV(I5,I1)*CONJG(C0) - ELSE - GPV(I4,I1)=GPV(I4,I1)*C0 - END IF - ELSE - IF (GPN(I5,I1).EQ.0) THEN - GPV(I5,I1)=GPV(I5,I1)*CONJG(C0) - ELSE - C0=SQRT(C0) !TO USE - GPV(I4,I1)=GPV(I4,I1)*C0 - GPV(I5,I1)=GPV(I5,I1)*CONJG(C0) - END IF - END IF - GPN(I4,I1)=1 !INDICATE USED - GPN(I5,I1)=1 - END IF - END IF - END IF - END IF - END DO - END DO - END IF - END IF - END DO -C - 100 CONTINUE - IF (SINGLE) THEN !SINGLE SET: DONE - MORE=.FALSE. - ELSE - MORE=NSCSTL(FCA,SETS1,STH,STHP,SNAM,LPOFF) !GET NEXT SET - END IF - END DO -C -C Calculate average gain and phase offset -C - DO I1=0,1 !X,Y - R0=0 - I3=0 - DO I2=0,STHTEL-1 !DETERMINE AVERAGE GAIN - IF (GPN(I2,I1).NE.0) THEN - R0=R0+ABS(GPV(I2,I1)) - I3=I3+1 - END IF - END DO - IF (I3.NE.0) THEN !APPLY AVERAGE - R0=R0/I3 - DO I2=0,STHTEL-1 - IF (GPN(I2,I1).NE.0) GPV(I2,I1)=GPV(I2,I1)/R0 - PCGAN1(I2,I1)=ABS(GPV(I2,I1)) !GAIN - PCPHS1(I2,I1)=-1*DEG*ATAN2(AIMAG(GPV(I2,I1)), - 1 REAL(GPV(I2,I1))) !PHASE - END DO - END IF - END DO -C -C Print at request -C - IF (OUT.NE.0) THEN - TEXT(-1)=' ' !HEADING - DO I=0,STHTEL-1 - TEXT(-1)(I*5+12:I*5+12)=TELS1(I+1:I+1) - PCGAN1(I,0)=PCGAN1(I,0)*100 !Make % - PCGAN1(I,1)=PCGAN1(I,1)*100 - END DO -C - CALL WNCTXT(OUT,'!/!#$AS',LEN(TEXT(0)),TEXT(-1)) !SHOW HEADING - CALL WNCTXT(OUT,'!Q1\Gain(%):!10C!5$#E10.0', - 1 STHTEL,PCGAN1(0,0)) !GAIN X - CALL WNCTXT(OUT,'!Q1\!10C!5$#E10.0',STHTEL,PCGAN1(0,1)) !GAIN Y - CALL WNCTXT(OUT,'!Q1\Phase(d):!10C!5$#E10.0', - 1 STHTEL,PCPHS1(0,0)) !PHASE X - CALL WNCTXT(OUT,'!Q1\!10C!5$#E10.0',STHTEL,PCPHS1(0,1)) !PHASE Y - CALL WNCTXT(OUT,' ') -C - DO I=0,STHTEL-1 - PCGAN1(I,0)=PCGAN1(I,0)/100 !Back to fractions - PCGAN1(I,1)=PCGAN1(I,1)/100 - END DO - END IF -C - RETURN - END diff --git a/src/nscan/ncopy.com b/src/nscan/ncopy.com deleted file mode 100644 index 2f1abcb2ec71e7804edb58aabf5db7d3fa54f84c..0000000000000000000000000000000000000000 --- a/src/nscan/ncopy.com +++ /dev/null @@ -1,231 +0,0 @@ -$ ! Created from ncopy.ssc on Wed Sep 1 08:35:08 METDST 1993 at rzmws5 -$ ! -$ ! -$! ncopy.ssc -$! wnb 910930 -$! -$! Revisions: -$! WNB 920913 Include NGCALC files; more options -$! WNB 921006 Make more general -$! WNB 921230 Make SSC -$! WNB 930901 Make sure aliases -$! -$! Copy and convert Newstar data from one machine to other -$! -$! Uses environment: WNG_SITE -$! -$! Intro -$! -$ ON CONTROL_Y THEN GOTO EXEX -$ SET NOVERIFY -$ IF P1 .NES. "" THEN SET VERIFY -$ TELL="WRITE SYS$OUTPUT" !FOR EASE OF USE -$ DELETE="DELETE" !FOR SAFETY -$ TELL " " -$ TELL "Copy files from other machine (TCPIP) and convert them." -$ TELL " Give empty answers to exit gracefully." -$ TELL " " -$! -$! Get data type -$! -$ LA: READ/TIME=90/END=LA1/ERROR=LA1 - - /PROMPT="Type (model, scan, map, gcalc, mongo): " - - SYS$COMMAND TYPE -$ IF TYPE .EQS. "" THEN GOTO LA1 -$ TYPE=F$EDIT(TYPE,"UPCASE")+"XXX" -$ IF F$EXTRACT(0,3,TYPE) .EQS. "MOD" THEN TYPE="MODEL" -$ IF F$EXTRACT(0,3,TYPE) .EQS. "MON" THEN TYPE="MONGO" -$ IF F$EXTRACT(0,2,TYPE) .EQS. "MA" THEN TYPE="MAP" -$ IF F$EXTRACT(0,1,TYPE) .EQS. "S" THEN TYPE="SCAN" -$ IF F$EXTRACT(0,1,TYPE) .EQS. "G" THEN TYPE="GCALC" -$ IF F$LOCATE("XX",TYPE) .LT. F$LENGTH(TYPE) -$ THEN -$ TELL "Unknown type" -$ TELL " " -$ GOTO LA -$ ENDIF -$! -$! Get machine info -$! -$ READ/TIME=90/END=LA1/ERROR=LA1 - - /PROMPT="Input machine (eg RZMALL): " - - SYS$COMMAND VMACH -$ IF VMACH .EQS. "" THEN GOTO LA -$ VMACH=F$EDIT(VMACH,"UPCASE") -$! -$! Get file info -$! -$ READ/TIME=90/END=LA1/ERROR=LA1 - - /PROMPT="''VMACH' user (eg GER): " - - SYS$COMMAND VUS -$ IF VUS .EQS. "" THEN GOTO LA -$ VUS=F$EDIT(VUS,"LOWERCASE") -$ READ/TIME=90/END=LA1/ERROR=LA1 - - /PROMPT="''VMACH' full directory (eg /usr/ger/data): " - - SYS$COMMAND VDIR -$ IF VDIR .EQS. "" THEN GOTO LA -$ VDIR=F$EDIT(VDIR,"LOWERCASE") -$ LC: READ/TIME=90/END=LA1/ERROR=LA1 - - /PROMPT="''VMACH' filename (eg NGC891.WMP): " - - SYS$COMMAND VFIL -$ IF VFIL .EQS. "" THEN GOTO LA -$ VFIL=F$EDIT(VFIL,"UPCASE") -$ READ/TIME=90/END=LA1/ERROR=LA1 - - /PROMPT="Full directory or empty if current: " - - SYS$COMMAND ADAT -$ IF ADAT .EQS. "" THEN ADAT=F$ENVIRONMENT("DEFAULT") -$ ANOD="''VFIL'" -$ A=F$SEARCH("''ADAT'''ANOD'") -$ IF A .NES. "" -$ THEN -$ READ/TIME=90/END=LA1/ERROR=LA1 - - /PROMPT="Node exists. Delete it? (y,n) [n]: " - - SYS$COMMAND ANS -$ IF F$EXTRACT(0,1,F$EDIT(ANS,"UPCASE")) .NES. "Y" THEN GOTO LC -$ DELETE 'A' -$ TELL " " -$ TELL "Node ''A' deleted" -$ ENDIF -$! -$! Transfer file -$! -$ ON ERROR THEN GOTO EXEX -$ TELL " " -$ TELL "Transfering file. ''VMACH' password asked for" -$ TELL " " -$ SET TERM/NOECHO -$ READ/TIME=90/END=LA1/ERROR=LA1 - - /PROMPT="Password: " - - SYS$COMMAND PASSW -$ SET TERM/ECHO -$ TELL " " -$ QQQ="BINARY" -$ QQQ1="SET TYPE IMAGE" -$ IF TYPE .EQS. "MONGO" -$ THEN -$ QQQ="" -$ QQQ1="SET TYPE ASCII" -$ ENDIF -$ OPEN/WRITE/ERROR=LD2 FILE QQXY.TMP -$ IF WNG_SITE .EQS. "NFRA" -$ THEN -$ WRITE/ERROR=LD2 FILE "$ FTP" -$ WRITE/ERROR=LD2 FILE "CONNECT ''VMACH'" -$ WRITE/ERROR=LD2 FILE "LOGIN ""''VUS'""" -$ WRITE/ERROR=LD2 FILE "''PASSW'" -$ WRITE/ERROR=LD2 FILE "''QQQ1'" -$ WRITE/ERROR=LD2 FILE "SET DEF ""''VDIR'""" -$ WRITE/ERROR=LD2 FILE "GET ''VFIL' ""''ADAT'''ANOD'""" -$ WRITE/ERROR=LD2 FILE "EXIT" -$ WRITE/ERROR=LD2 FILE "$ EXIT" -$ ENDIF -$ IF WNG_SITE .EQS. "ATNF" -$ THEN -$ WRITE/ERROR=LD2 FILE "cd ""''VDIR'""" -$ WRITE/ERROR=LD2 FILE "''QQQ'" -$ WRITE/ERROR=LD2 FILE "get ''VFIL' ""''ADAT'''ANOD'""" -$ WRITE/ERROR=LD2 FILE "quit" -$ ELSE !RUG -$ WRITE/ERROR=LD2 FILE "$ FTP -n ''VMACH'" -$ WRITE/ERROR=LD2 FILE "LOGIN ""''VUS'"" ""''PASSW'""" -$ WRITE/ERROR=LD2 FILE "cd ""''VDIR'""" -$ WRITE/ERROR=LD2 FILE "''QQQ'" -$ WRITE/ERROR=LD2 FILE "get ''VFIL' ""''ADAT'''ANOD'""" -$ WRITE/ERROR=LD2 FILE "quit" -$ WRITE/ERROR=LD2 FILE "$ EXIT" -$ ENDIF -$ CLOSE/ERROR=LD2 FILE -$ GOTO LD3 -$ LD2: CLOSE/ERROR=LD21 FILE -$ LD21: TELL " " -$ TELL "Error creating intermediate file, abort." -$ TELL " " -$ GOTO EXEX -$ LD3: ON ERROR THEN GOTO LD4 -$ ASSIGN NL: SYS$OUTPUT -$ IF WNG_SITE .EQS "NFRA" .OR. WNG_SITE .EQS. "RUG" -$ THEN -$ @QQXY.TMP -$ ELSE -$ FTP/USER="''VUS'"/PASSW="''PASSW'"/TAKE_FILE=QQXY.TMP 'vmach' -$ ENDIF -$ IF (.NOT. $STATUS) THEN GOTO LD4 -$ DEASSIGN SYS$OUTPUT -$ ON ERROR THEN GOTO EXEX -$ IF F$SEARCH(A) .NES. "" THEN GOTO LD5 !OK -$ LD4: DEASSIGN SYS$OUTPUT -$ ON ERROR THEN GOTO EXEX -$ TELL " " -$ TELL " Error transferring file, abort." -$ TELL " " -$ GOTO EXEX -$ LD5: TELL " " -$ TELL "Transfer completed, starting conversion." -$ TELL " " -$! -$! Conversion -$! -$ OPEN/WRITE/ERROR=LE2 FILE QQXY.TMP -$ IF TYPE .EQS. "MODEL" -$ THEN -$ WRITE/ERROR=LE2 FILE "$ DWE NMODEL/LOG=NO" -$ WRITE/ERROR=LE2 FILE "CVX" -$ WRITE/ERROR=LE2 FILE """@''ADAT'''ANOD'""" -$ WRITE/ERROR=LE2 FILE "QUIT" -$ WRITE/ERROR=LE2 FILE "$ EXIT" -$ ENDIF -$ IF TYPE .EQS. "MAP" -$ THEN -$ WRITE/ERROR=LE2 FILE "$ DWE NMAP/LOG=NO" -$ WRITE/ERROR=LE2 FILE "CVX" -$ WRITE/ERROR=LE2 FILE """@''ADAT'''ANOD'""" -$ WRITE/ERROR=LE2 FILE "QUIT" -$ WRITE/ERROR=LE2 FILE "$ EXIT" -$ ENDIF -$ IF TYPE .EQS. "SCAN" -$ THEN -$ WRITE/ERROR=LE2 FILE "$ DWE NSCAN/LOG=NO" -$ WRITE/ERROR=LE2 FILE "CVX" -$ WRITE/ERROR=LE2 FILE """@''ADAT'''ANOD'""" -$ WRITE/ERROR=LE2 FILE "$ EXIT" -$ ENDIF -$ IF TYPE .EQS. "GCALC" -$ THEN -$ WRITE/ERROR=LE2 FILE "$ DWE NGCALC/LOG=NO" -$ WRITE/ERROR=LE2 FILE "CVX" -$ WRITE/ERROR=LE2 FILE """@''ADAT'''ANOD'""" -$ WRITE/ERROR=LE2 FILE "$ EXIT" -$ ENDIF -$ CLOSE/ERROR=LE2 FILE -$ GOTO LE3 -$ LE2: CLOSE/ERROR=LE21 FILE -$ LE21: TELL " " -$ TELL "Error creating intermediate file, abort." -$ TELL " " -$ GOTO EXEX -$ LE3: ON ERROR THEN GOTO LE4 -$ ASSIGN NL: SYS$OUTPUT -$ @QQXY.TMP -$ IF (.NOT. $STATUS) THEN GOTO LE4 -$ DEASSIGN SYS$OUTPUT -$ ON ERROR THEN GOTO EXEX -$ GOTO LE5 !OK -$ LE4: DEASSIGN SYS$OUTPUT -$ ON ERROR THEN GOTO EXEX -$ TELL " Error converting file, abort." -$ TELL " " -$ GOTO EXEX -$ LE5: DEASSIGN SYS$OUTPUT -$ TELL "Conversion of ''ADAT'''ANOD' finished." -$ TELL " " -$ GOTO EXEX -$! -$! Ready -$! -$ LA1: TELL "Exit requested" -$ TELL "" -$ EXEX: -$ IF F$SEARCH("QQXY.TMP") .NES. "" THEN DELETE QQXY.TMP;* -$ DEASSIGN SYS$OUTPUT -$ SET TERM/ECHO -$ EXIT diff --git a/src/nscan/ncopy.csh b/src/nscan/ncopy.csh deleted file mode 100755 index c227b464b1bc7ec0b9289ef6bac86e0a34c30bbd..0000000000000000000000000000000000000000 --- a/src/nscan/ncopy.csh +++ /dev/null @@ -1,186 +0,0 @@ -#!/bin/csh -# Created from ncopy.ssc on Wed Sep 1 08:35:07 METDST 1993 at rzmws5 -# -# ncopy.ssc -# wnb 910930 -# -# Revisions: -# WNB 920913 Include NGCALC files; more options -# WNB 921006 Make more general -# WNB 921230 Make SSC -# WNB 930901 Make sure aliases -# -# Copy and convert Newstar data from one machine to other -# -# Uses environment: WNG_SITE -# -# Intro -# - echo "Copy files from other machine (TCPIP) and convert them." - echo " Give empty answers to exit gracefully." - echo " " - if (! $?ROOTDWARF) then - echo "No dwarf environment specified; change your .cshrc" - exit - endif - source $ROOTDWARF/dwarf_alias.sun # get aliases -# -# Get data type -# -LA: - echo -n "Type (model, scan, map, gcalc, mongo): " - set type=$< - set type=`echo $type | tr A-Z a-z` - switch ($type) - case "": - echo "Exit requested" - echo "" - exit - breaksw - case mod*: - set type=model - breaksw - case s*: - set type=scan - breaksw - case ma*: - set type=map - breaksw - case mon*: - set type=mongo - breaksw - case g*: - set type=gcalc - default: - echo "Unknown type" - echo " " - goto LA - breaksw - endsw -# -# Get machine info -# - echo -n "Input machine (eg RZMVX4): " - set vmach=$< - if ($vmach == "") goto LA - set vmach=`echo $vmach | tr a-z A-Z` -# -# Get file info -# - echo -n "$vmach user (eg GER): " - set vus=$< - if ($vus == "") goto LA - echo -n "$vmach directory in $vmach format (eg USER1:[GER.DATA]): " - set vdir="$<" - if ("$vdir" == "") goto LA -LC: - echo -n "$vmach filename (eg ngc1274_21cm.scn): " - set vfil="$<" - if ("$vfil" == "") goto LA - set vfil=`echo $vfil | tr a-z A-Z` -LB: - echo -n "Full directory or empty if current: " - set adat="$<" - if ("$adat" == "") set adat=$cwd - if (!(-d $adat)) then - echo "Non-existant directory" - echo " " - goto LB - endif - set anod="$vfil" - if ($anod == "") goto LA - if (-e $adat/$anod) then - echo -n "Node exists. Delete it? (y,n) [n]: " - set ans=$< - switch ($ans) - case [yY]*: - 'rm' $adat/$anod - echo "Node $adat/$anod deleted" - breaksw - default: - goto LC - breaksw - endsw - endif -# -# Transfer file -# - echo " " - echo "Transfering file. $vmach password may be asked for." - echo " " - if ($type == mongo) then - @ ans = { ftp -n << qqq } - open $vmach - user $vus - cd "$vdir" - get $vfil $adat/$anod - close - quit -qqq - else - @ ans = { ftp -n << qqq } - open $vmach - user $vus - cd "$vdir" - binary - get $vfil $adat/$anod - close - quit -qqq - endif - if ((-e $adat/$anod)) then - echo "Transfer completed, starting conversion." - echo " " - else - echo "Transfer not completed properly, abnormal termination." - echo " " - exit - endif -# -# Conversion -# - switch ($type) - case model: - @ ans = { dwe nmodel/log=no >/dev/null <<qqq } -CVX -"@$adat/$anod" -QUIT -qqq - breaksw - case map: - @ ans = { dwe nmap/log=no >/dev/null <<qqq } -CVX -"@$adat/$anod" -QUIT -qqq - breaksw - case scan: - @ ans = { dwe nscan/log=no >/dev/null <<qqq } -CVX -"@$adat/$anod" -qqq - breaksw - case gcalc: - @ ans = { dwe ngcalc/log=no >/dev/null <<qqq } -CVX -"@$adat/$anod" -qqq - breaksw - case mongo: - breaksw - default: - echo "Programming error, abnormally terminated." - echo " " - breaksw - endsw -# -# Ready -# - if ($ans == 0) then - echo "Conversion of $adat/$anod finished." - echo " " - else - echo "Errors in conversion of $adat/$anod." - echo " " - endif - exit diff --git a/src/nscan/nfi.dsc b/src/nscan/nfi.dsc deleted file mode 100644 index 6fa2e9df24c7fe26affbed9392c23f5293c8f2c8..0000000000000000000000000000000000000000 --- a/src/nscan/nfi.dsc +++ /dev/null @@ -1,54 +0,0 @@ -!+ NFI.DSC -! WNB 940216 -! -! Revisions: -! -%REVISION=WNB=940729="General update" -%REVISION=WNB=940216="Original version" -! -! Layout of overall include file (NFI.DEF) -! -%COMMENT="NFI.DEF is an INCLUDE file for the NFILT program" -%COMMENT=" " -! -%VERSION=1 -%SYSTEM=1 -%USER=WNB -%%DATE -%%NAME -! -! Get number of telescopes -! -%INCLUDE=NSTAR_DSF -! -%ALIGN -! -%GLOBAL=MXNSET=64 !MAX. # OF SETS -%GLOBAL=MXPOLY=6 !MAX # POLYNOMIAL COEFFICIENT -%GLOBAL=MXSEL=8 !MAX # OF PAIRS SELECTED -!- -.DEFINE - .PARAMETER - .DATA -! -! Local variables: -! - .COMMON - OPTION C24 !PROGRAM OPTION - OPT=OPTION C3 - FILOUT C80 !FILE NAME - LPOFF J(0:7) !LOOPS - SETS J(0:7,0:MXNSET) !SETS TO DO - FCAOUT J !OUTPUT FCA - NODOUT C80 !OUTPUT NODE - QUAIN J !INPUT QUA - HARAN E(0:1) !HA RANGE - SIFRS B(0:NSTAR_TEL-1,0:NSTAR_TEL-1) !SELECT IFRS - NSRC J(0:2) !SOURCES TO USE - CORAP J !APPLY CORRECTIONS - CORDAP J !DE-APPLY CORRECTIONS - SPOL J !SELECTED POL - NPOLY J !SELECTED POLYNOMIAL - NSEL J !# OF SELECTED POINTS - FSEL E(0:1,0:MXSEL-1) !FREQUENCY SELECTION -.END diff --git a/src/nscan/nfi.grp b/src/nscan/nfi.grp deleted file mode 100644 index ddabdf145d9f2b98699c0b8a2492289fa707318e..0000000000000000000000000000000000000000 --- a/src/nscan/nfi.grp +++ /dev/null @@ -1,37 +0,0 @@ -!+ NFI.GRP -! WNB 940216 -! -! Revisions: -! WNB 940729 General update -! -! Scan handling -! -! Group definition: -! -NFI.GRP -! -! Command files -! -! -! PIN files -! -NFILT.PSC ! Parameters for NFILT -! -! Structure files -! -! -! Fortran definition files: -! -NFI.DSC ! Common program parameters -! -! Programs: -! -NFILT.FOR ! Main routine -NFIDAT.FOR !NFIDAT Get program data -NFIINI.FOR !NFIINI Initialise program -NFIUVL.FOR !NFIUVL Do UVLIN -! -! Executables -! -NFILT.EXE ! -!- diff --git a/src/nscan/nfidat.for b/src/nscan/nfidat.for deleted file mode 100644 index 0a95a1451d6f465ed1491a5448ee9edbc0787e80..0000000000000000000000000000000000000000 --- a/src/nscan/nfidat.for +++ /dev/null @@ -1,157 +0,0 @@ -C+ NFIDAT.FOR -C WNB 940216 -C -C Revisions: -C CMV 940926 Close old file before asking new one -C WNB 950704 General update -C - SUBROUTINE NFIDAT -C -C Get NFILT program parameters -C -C Result: -C -C CALL NFIDAT will ask and set all program parameters -C -C PIN references: -C -C OPTION -C SCN_LOOPS -C SCN_SETS -C POLY_DEGREE -C FREQ_SELECT -C -C Include files: -C - INCLUDE 'WNG_DEF' - INCLUDE 'CBITS_DEF' - INCLUDE 'SSH_O_DEF' !SET STRUCTURE DEFINITION - INCLUDE 'STH_O_DEF' !SET HEADER - INCLUDE 'NFI_DEF' -C -C Parameters: -C -C -C Arguments: -C -C -C Function references: -C - LOGICAL WNDPAR !GET DWARF PARAMETER - LOGICAL WNDXLP !GET LOOPS - LOGICAL WNDSTQ !GET SET DEFINITIONS - LOGICAL WNDNOD !GET NODE INFO - LOGICAL WNFOP !OPEN FILE - LOGICAL NSCSTG !GET SET - LOGICAL NSCPLS !ASK POL - LOGICAL NSCHAS !ASK HA RANGE - LOGICAL NSCIFS !ASK IFRS -C -C Data declarations: -C - INTEGER STHP !SET POINTER - INTEGER SETNAM(0:SOF__N-1) !SET NAME - INTEGER CIFR !IFR SELECTOR CODE - BYTE STH(0:STH__L-1) !SET HEADER -C- -C -C SET DEFAULTS -C - SETS(0,0)=0 - CIFR=2 !ASK ALL CROSS IFR - HARAN(0)=-179.99/360. !HA RANGE - HARAN(1)=+179.99/360. - SPOL=XYX_M !POL. SELECTION -C -C GET OPTION -C - 100 CONTINUE - IF (.NOT.WNDPAR('OPTION',OPTION,LEN(OPTION),J0,'QUIT')) THEN - OPTION='QUIT' !ASSUME END - ELSE IF (J0.LE.0) THEN - OPTION='QUIT' !ASSUME END - END IF - -C***************************************************************************** -C QUIT -C***************************************************************************** - IF (OPT.EQ.'QUI') THEN - -C **************************************************************************** -C CONTINUUM (UVLIN) -C **************************************************************************** - ELSE IF (OPT.EQ.'CON') THEN !UVLIN - 10 CONTINUE - CALL WNFCL(FCAOUT) - IF (.NOT.WNDNOD('SCN_NODE',NODOUT,'SCN','U',NODOUT,FILOUT)) THEN - IF (E_C.EQ.DWC_ENDOFLOOP) GOTO 100 !RETRY OPTION - GOTO 10 !REPEAT - ELSE IF (E_C.EQ.DWC_NULLVALUE) THEN - GOTO 100 !RETRY OPTION - ELSE IF (E_C.EQ.DWC_WILDCARD) THEN - GOTO 10 !MUST SPECIFY - END IF - IF (.NOT.WNFOP(FCAOUT,FILOUT,'U')) THEN !OPEN OUTPUT SCAN FILE - GOTO 10 !RETRY - END IF -C - 11 CONTINUE - IF (.NOT.WNDXLP('SCN_LOOPS',FCAOUT)) THEN - IF (E_C.EQ.DWC_ENDOFLOOP) GOTO 10 !RETRY NODE - GOTO 11 !REPEAT - END IF -C - IF (.NOT.WNDSTQ('SCN_SETS',MXNSET,SETS,FCAOUT)) THEN !NO SETS - 12 CONTINUE - CALL WNFCL(FCAOUT) - GOTO 10 - END IF - IF (SETS(0,0).EQ.0) GOTO 12 !NONE SPECIFIED - IF (.NOT.NSCSTG(FCAOUT,SETS,STH,STHP,SETNAM)) GOTO 12 !FIND A SET - CALL WNDSTR(FCAOUT,SETS) !RESET SET SEARCH -C - IF (.NOT.NSCPLS(0,SPOL)) GOTO 12 !SELECT POL -C - CALL NMODAX(NSRC(0)) !GET MODEL - IF (NSRC(0).GT.0) CALL NMOMUI !MODEL USAGE -C - IF (.NOT.NSCHAS(0,HARAN)) GOTO 12 !GET HA RANGE -C - IF (.NOT.NSCIFS(CIFR,SIFRS)) GOTO 12 !SELECT INTERFEROMETERS - CIFR=0 !SET SEEN -C - CALL NSCSAD(CORAP,CORDAP) !GET CORRECTIONS (DE-)APPLY -C - 13 CONTINUE - IF (.NOT.WNDPAR('FREQ_SELECT',FSEL,2*MXSEL*LB_E,J0, - 1 '*')) THEN !SELECT FREQ. RANGE - IF (E_C.EQ.DWC_ENDOFLOOP) GOTO 12 - GOTO 13 - END IF - IF (J0.EQ.0) GOTO 13 - IF (J0.LT.0) THEN - FSEL(0,0)=0 - FSEL(1,0)=1E9 - J0=2 - END IF - NSEL=J0/2 - IF (NSEL.LT.1) GOTO 13 -C - IF (.NOT.WNDPAR('POLY_DEGREE',NPOLY,LB_J,J0, - 1 '1')) THEN - GOTO 13 - END IF - IF (J0.EQ.0) GOTO 13 - IF (J0.LT.0) NPOLY=1 - NPOLY=MIN(MAX(NPOLY,0),MXPOLY) -C -C - ELSE - GOTO 100 - END IF -C - 900 CONTINUE - RETURN !READY -C -C - END diff --git a/src/nscan/nfiini.for b/src/nscan/nfiini.for deleted file mode 100644 index 31e67fa505ceb4aea314415f2962d0a03dff73bf..0000000000000000000000000000000000000000 --- a/src/nscan/nfiini.for +++ /dev/null @@ -1,53 +0,0 @@ -C+ NFIINI.FOR -C WNB 940216 -C -C Revisions: -C - SUBROUTINE NFIINI -C -C Initialize NFILT program -C -C Result: -C -C CALL NFIINI will set header lines, logging, DWARF interface -C -C Include files: -C - INCLUDE 'WNG_DEF' - INCLUDE 'NFI_DEF' -C -C Parameters: -C -C -C Arguments: -C -C -C Function references: -C - LOGICAL WNDINI !INIT DWARF - LOGICAL WNDDAB !OPEN DATABASE -C -C Data declarations: -C -C- -C -C SET HEADER LINES -C - CALL WNCFHD(F_P,1,'!40C\Program to ''filter'' SCN files') -C -C START DWARF -C - IF (.NOT.WNDINI(PRGNAM)) CALL WNGEX !EXIT IF NO DWARF START -C -C LOGGING -C - CALL WNDLOG(LOGCD) !PROPER LOGGING -C -C DATABASE -C - IF (.NOT.WNDDAB()) CALL WNGEX !OPEN DATABASE -C - RETURN !READY -C -C - END diff --git a/src/nscan/nfilt.for b/src/nscan/nfilt.for deleted file mode 100644 index cb81089707c7fa4332577984bb41488df9ca7d56..0000000000000000000000000000000000000000 --- a/src/nscan/nfilt.for +++ /dev/null @@ -1,56 +0,0 @@ -C+ NFILT.FOR -C WNB 940216 -C -C Revisions: -C WNB 940729 General update -C - SUBROUTINE NFILT -C -C Main routine to obtain data 'filtering' -C -C Result: -C -C -C Include files: -C - INCLUDE 'WNG_DEF' - INCLUDE 'NFI_DEF' -C -C Parameters: -C -C -C Arguments: -C -C -C Function references: -C - LOGICAL WNDRUN !TEST RUN - LOGICAL WNDXLN !LOOP -C -C Data declarations: -C -C- -C -C PRELIMINARIES -C - CALL NFIINI !INIT PROGRAM -C -C DISTRIBUTE -C - 10 CONTINUE - CALL NFIDAT !GET USER DATA - IF (OPT.EQ.'QUI') THEN !READY - CALL WNGEX !FINISH - ELSE IF (OPT.EQ.'CON') THEN !DUMP - IF (.NOT.WNDRUN()) CALL WNGEX !NO RUN - CALL WNDXLI(LPOFF) !INIT LOOPS - DO WHILE (WNDXLN(LPOFF)) - CALL NFIUVL !GET CONTINUUM - END DO - CALL WNFCL(FCAOUT) - END IF -C - CALL WNGEX !READY -C -C - END diff --git a/src/nscan/nfilt.psc b/src/nscan/nfilt.psc deleted file mode 100644 index 9e33b6271054b1c3946cdcfb34bc1871d7b8be59..0000000000000000000000000000000000000000 --- a/src/nscan/nfilt.psc +++ /dev/null @@ -1,87 +0,0 @@ -!+ NFILT.PSC -! WNB 940216 -! -! Revisions: -! HjV 941031 Add MDLNODE_PEF -! WNB 950704 Add frequency and polynomial selection -! JPH 960404 Formatting -! -! Get overall action -! Ref: NFIDAT -! -KEYWORD=OPTION - DATA_TYP=C - IO=I - LENGTH=24 - CHECKS=ABBREV_OPTIONS - SWITCHES=LOOP,NULL_VALUES,WILD_CARDS - SEARCH=L,P - OPTIONS=CONTINUUM, QUIT - PROMPT="Action" - HELP=" -Specify the action to be performed by the program NFILT: -. - CONTINUUM make a UV-based estimate of the continuum in line data. The - algoritm used fits a polynomial to the sine and cosine - components of the residual corrected data, and stores it as - additive interferometer data. Second order effects could - necessitate an iteration for the cross-polarised channels to - properly cater for polarisation correctioons and Faraday - rotation. - Although the program will handle any combination of input sets, - fastest operation is attained if loops are used to select the - fields. -. - QUIT: leave the program NSCAN -" -! -! Get polynomial degree -! Ref: NFIDAT -! -KEYWORD=POLY_DEGREE - DATA_TYP=J - IO=I - SWITCHES=LOOP,WILD_CARDS,NULL_VALUES - CHECKS=MAXIMUM,MINIMUM - MAXIMUM=6 - MINIMUM=0 - SEARCH=L,P - PROMPT="Polynomial degree" - HELP=" -Specify the degree of the polynomial to solve for: 0=constant; 1=slope -etc. -" -! -! Get frequency selection -! Ref: NFIDAT -! -KEYWORD=FREQ_SELECT - DATA_TYP=R - IO=I - NVALUES=16 - SWITCH=LOOP,WILD_CARDS,NULL_VALUES - SEARCH=L,P - PROMPT="Pairs of frequency (MHz) to select solution domain" - HELP=" - The actual solution of the continuum radiation will be based on a -subset of the input channels. The channels selected will be based on -pairs of frequencies, indicating a range. -E.g. 325,327,330,332 will use channels with frequnecies in the ranges -325-327 and 330-332 MHz. -. - * indicates all channels. -. -Note that the corrections are saved for all selected input frequency sets. -" -!- -INCLUDE=NGEN_PEF -!- -INCLUDE=SCNNODE_PEF -INCLUDE=SCNSETS_PEF -!- -INCLUDE=SELECT_PEF -!- -INCLUDE=MDLNODE_PEF -!- -INCLUDE=NMODEL_PEF -!- diff --git a/src/nscan/nfiuvl.for b/src/nscan/nfiuvl.for deleted file mode 100755 index 83518902840c324bc053633fa26b0472b45cb522..0000000000000000000000000000000000000000 --- a/src/nscan/nfiuvl.for +++ /dev/null @@ -1,178 +0,0 @@ -C+ NFIUVL.FOR -C WNB 940729 -C -C Revisions: -C WNB 940812 Change QSR call -C WNB 940825 Test IFR errors -C WNB 950630 Create proper UVLIN -C - SUBROUTINE NFIUVL -C -C UVLIN calculation -C -C Result: -C -C CALL NFIUVL try UVLIN -C -C Include files: -C - INCLUDE 'WNG_DEF' - INCLUDE 'CBITS_DEF' - INCLUDE 'LSQ_O_DEF' - INCLUDE 'STH_O_DEF' - INCLUDE 'NFI_DEF' -C -C Parameters: -C -C -C Arguments: -C -C -C Function references: -C - LOGICAL WNMLGA !GET LSQ AREA - LOGICAL NSCQOP !PRODUCE A DATA QUBE - LOGICAL NSCQFN !GET NEXT FIELD - LOGICAL NSCQSR !READ SCAN DATA - LOGICAL NSCQWA !WRITE ADDITIVE IFR ERRORS - LOGICAL NMOMSL !CALC MODEL IN SCN FILE -C -C Data declarations: -C- - INTEGER INFO(QINFO__L:QINFO__H) !QUBE MAX. INFORMATION - INTEGER FINFO(QINFO__L:QINFO__H) !QUBE FIELD INFO - INTEGER PINFO(QINFO__L:QINFO__H) !QUBE FIELD TABLE POINTERS - INTEGER PWGT,PDAT,PMOD,POUT !WEIGHT, DATA, MODEL, ERROR BUFFER PTRS - BYTE STH(0:STH__L-1) !SET HEADER - INTEGER TW,TE !TELESCOPES - INTEGER LAR !LEAST SQUARES AREA - INTEGER TPOL(0:3) !POL CHECK BITS - DATA TPOL/XX_P,XY_P,YX_P,YY_P/ - REAL EQ(0:MXPOLY) !CONDITION EQUATIONS - REAL SOL(0:(MXPOLY+1)*2*4-1) !SOLUTION (POLY,C/S,POL) - REAL MU(0:2*4-1),SD(0:2*4-1) !ERROR,S.D. (C/S,POL) - REAL R2 -C -C INIT -C - IF (NSRC(0).GT.0) THEN - IF (.NOT.NMOMSL(FCAOUT,SETS,LPOFF)) GOTO 800 !MAKE SCAN MODEL - END IF -C -C PRODUCE QUBE -C - IF (.NOT.NSCQOP(QUAIN,FCAOUT,SETS,LPOFF,INFO)) GOTO 800 - CALL WNCTXT(F_TP,'Working on !UJ cube(s), with max dimensions:', - 1 INFO(QINFO_FLD)) - CALL WNCTXT(F_TP,' !UJx!UJx!UJ (f,ha,ifr)', - 1 INFO(QINFO_F),INFO(QINFO_T),INFO(QINFO_I)) -C -C PREPARE SOLUTION -C - IF (.NOT.WNMLGA(LAR,LSQ_T_REAL+LSQ_T_MULTIPLE,NPOLY+1,8)) THEN - CALL WNCTXT(F_TP,'No memory for solution') - GOTO 800 - END IF -C -C LOOP OVER FIELDS AND READ TIF -C - DO WHILE (NSCQFN(QUAIN,FCAOUT,QUB_TIF+QUB_M+QUB_OUT, - 1 STH,FINFO,PINFO)) - CALL WNCTXT(F_TP,'Working on cube !UJ, with dimensions:', - 1 FINFO(QINFO_FLD)) - CALL WNCTXT(F_TP,' !UJx!UJx!UJ (f,ha,ifr)', - 1 FINFO(QINFO_F),FINFO(QINFO_T),FINFO(QINFO_I)) - CALL WNCTXT(F_TP,'!_Frequencies:') - CALL WNCTXT(F_TP,'!72$8Q!#D12.6', - 1 FINFO(QINFO_F),A_D(PINFO(QINFO_F))) -C -C LOOP OVER ALL HOUR ANGLES AND INTERFEROMETERS -C - DO I=0,FINFO(QINFO_T)-1 !ALL HOUR ANGLES - IF (A_E(PINFO(QINFO_T)+I).LT.HARAN(0) .OR. - 1 A_E(PINFO(QINFO_T)+I).GT.HARAN(1)) GOTO 20 !FORGET - DO I1=0,FINFO(QINFO_I)-1 !ALL INTERFEROMETERS - TW=MOD(A_I(PINFO(QINFO_I)+I1),256) !WEST TELESCOPE - TE=A_I(PINFO(QINFO_I)+I1)/256 !EAST TELESCOPE - IF (.NOT.SIFRS(TW,TE)) GOTO 30 !FORGET - IF (NSCQSR(QUAIN,FCAOUT,I,I1, - 1 CORAP,CORDAP,PWGT,PDAT,PMOD,POUT)) THEN !GET FREQ. LINE - DO I2=0,4*FINFO(QINFO_F)-1 !CORRECT FOR MODEL - A_X(PDAT+I2)=A_X(PDAT+I2)-A_X(PMOD+I2) - END DO - CALL WNMLIA(LAR,LSQ_I_ALL) !INIT LSQ - EQ(0)=1 -C -C LOOP OVER FREQUENCIES -C - DO I2=0,FINFO(QINFO_F)-1 !MAKE EQUATIONS - R0=A_D(PINFO(QINFO_F)+I2) !FREQUENCY - DO I3=0,NSEL-1 !SELECTED? - IF (R0.GE.FSEL(0,I3) .AND. R0.LE.FSEL(1,I3)) THEN - R0=R0/A_D(PINFO(QINFO_F)) !FREQUENCY NORMALISED - R1=R0 - DO I4=1,NPOLY - EQ(I4)=R1 - R1=R0*R1 - END DO - CALL WNMLMN(LAR,LSQ_C_REAL,1.,EQ, - 1 A_X(PDAT+4*I2)) - GOTO 10 - END IF - END DO - 10 CONTINUE - END DO - CALL WNMLTR(LAR,I0) !SOLVE - CALL WNMLSN(LAR,SOL,MU,SD) -C -C SAVE CORRECTIONS -C - DO I2=0,FINFO(QINFO_F)-1 !FREQUENCIES - R0=A_D(PINFO(QINFO_F)+I2) !FREQUENCY - R0=R0/A_D(PINFO(QINFO_F)) !FREQUENCY NORMALISED - DO I3=0,3 !POL - IF (IAND(SPOL,TPOL(I3)).NE.0) THEN !SELECTED - R1=SOL((NPOLY+1)*2*I3+NPOLY) !COS TERM - R2=SOL((NPOLY+1)*2*I3+NPOLY+1) !SIN TERM - DO I4=NPOLY-1,0,-1 - R1=R1*R0+SOL((NPOLY+1)*2*I3+I4) - R2=R2*R0+SOL((NPOLY+1)*2*I3+I4+1) - END DO - A_X(POUT+4*I2+I3)=CMPLX(R1,R2) - ELSE - A_X(POUT+4*I2+I3)=0 !CLEAR ERROR - END IF - END DO - END DO - IF (.NOT.NSCQWA(QUAIN,FCAOUT,I,I1,CORAP,CORDAP)) THEN - CALL WNCTXT(F_TP,'Error writing interferometer'// - 1 'errors for HA, ifr = !8$EAF12.2, !XI', - 1 A_E(PINFO(QINFO_T)+I), - 1 A_I(PINFO(QINFO_I)+I1)) - END IF - END IF -C -C NEXT INTERFEROMETER -C - 30 CONTINUE - END DO !INTERFEROMETERS -C -C NEXT HOUR ANGLE -C - 20 CONTINUE - END DO !HOUR ANGLES -C -C NEXT FIELD -C - END DO !FIELD -C -C READY -C - 800 CONTINUE - CALL WNMLFA(LAR) !FREE LSQ AREA - CALL NSCQCL(QUAIN,FCAOUT,SETS) !REMOVE QUBE INFO -C - RETURN -C -C - END diff --git a/src/nscan/nfl.def b/src/nscan/nfl.def deleted file mode 100644 index 39146286b142fdff92c37ee9dd637f9f128026c0..0000000000000000000000000000000000000000 --- a/src/nscan/nfl.def +++ /dev/null @@ -1,47 +0,0 @@ -C+ Created from nfl.dsc on 031229 at 12:46:28 at dop19 -C NFL.DEF -C WNB 031229 -C -C Revisions: -C -C WNB 930803 Remove .INCLUDE -C WNB 930618 Original version -C -C -C Given statements: -C -C -C Result: -C -C NFL.DEF is an INCLUDE file for the NFLAG program -C -C -C -C Parameters: -C - INTEGER MXNSET ! MAX. # OF SETS - PARAMETER ( MXNSET=64) - INTEGER MXNIFR ! MAX. # OF INTERFEROMETERS - PARAMETER ( MXNIFR=120) -C -C Data declarations: -C -C -C NFL common data: -C - CHARACTER*24 OPTION ! PROGRAM OPTION - CHARACTER*3 OPT - EQUIVALENCE (OPT,OPTION) - CHARACTER*80 NODIN ! INPUT NODE - CHARACTER*80 IFILE ! INPUT FILE NAME - INTEGER FCAIN ! INPUT FCA - INTEGER SETS(0:7,0:64) ! SETS TO DO -C -C NFL common block: -C - COMMON /NFL_COM/ OPTION,NODIN,IFILE, - & FCAIN,SETS -C -C Given statements: -C -C- diff --git a/src/nscan/nfl.dsc b/src/nscan/nfl.dsc deleted file mode 100644 index 7fc31ed96d6036f3331f5a958c31bc4b08aaea23..0000000000000000000000000000000000000000 --- a/src/nscan/nfl.dsc +++ /dev/null @@ -1,37 +0,0 @@ -!+ NFL.DSC -! WNB 930618 -! -! Revisions: -! -%REVISION=WNB=930803="Remove .INCLUDE" -%REVISION=WNB=930618="Original version" -! -! Layout of overall include file (NFL.DEF) -! -%COMMENT="NFL.DEF is an INCLUDE file for the NFLAG program" -%COMMENT=" " -! -%VERSION=1 -%SYSTEM=1 -%USER=WNB -%%DATE -%%NAME -%LOCAL=MXNSET=64 !MAX. # OF SETS -%LOCAL=MXNIFR=120 !MAX. # OF INTERFEROMETERS -!- -.DEFINE - .PARAMETER - MXNSET J /MXNSET/ !MAX. # OF SETS - MXNIFR J /MXNIFR/ !MAX. # OF INTERFEROMETERS - .DATA -! -! Local variables: -! - .COMMON - OPTION C24 !PROGRAM OPTION - OPT=OPTION C3 - NODIN C80 !INPUT NODE - IFILE C80 !INPUT FILE NAME - FCAIN J !INPUT FCA - SETS J(0:7,0:MXNSET) !SETS TO DO -.END diff --git a/src/nscan/nfl.grp b/src/nscan/nfl.grp deleted file mode 100644 index ad6518d623f5cc4ff06592b5cb135b0bc1a96fc2..0000000000000000000000000000000000000000 --- a/src/nscan/nfl.grp +++ /dev/null @@ -1,63 +0,0 @@ -!+ NFL.GRP -! WNB 930618 -! -! Revisions: -! WNB 930714 Add NFLFLR -! HjV 931220 Add NFLCNT, NFLCUB, NFLGET, NFLIST, NFLOPS, -! NFLPUT, NFLST1 -! HjV 940721 Add NFLST0.FOR, NFLST3.FOR, NFLSWI.FOR -! JPH 941017 Add FLFNODE.PEF -! -! Scan show/flag -! -! Group definition: -! -NFL.GRP -! -! PIN files -! -NFLAG.PSC -FLFNODE.PEF ! FLF_NODE keywords -! -! Structure files -! -FLH.DSC ! Delete file header -FLF.DSC ! Delete file entry -! -! Fortran definition files: -! -NFL.DSC ! Program common/parameters -! -! Programs: -! -NFLAG.FOR ! Main routine -NFLCNT.FOR !NFLCNT Count flags that have been set -NFLCUB.FOR !NFLCUB Deal with uv-data `hyper-cube' -NFLDAT.FOR !NFLDAT Get program data -NFLFLG.FOR !NFLFLG Flag/unflag scan data -NFLFL0.FOR !NFLFL0 Create flag file/area - !NFLFL9 Remove flag file/area - !NFLFL1 Put flag data - !NFLFL2 Get flag data - !NFLFLS Get status - !NFLFLR Reset get flag data -NFLFL5.FOR !NFLFL5 Unload list - !NFLFL6 Load list - !NFLFL7 Write list - !NFLFL8 Read list -NFLGET.FOR !NFLGET Make an internal flag list (FLF) -NFLINI.FOR !NFLINI Initialise program -NFLIST.FOR !NFLIST Interactions with the FLF -NFLOPS.FOR !NFLOPS (Un)-flag scan data -NFLPRT.FOR !NFLPRT Show/edit file data -NFLPUT.FOR !NFLPUT PUT flags -NFLST0.FOR !NFLST0 Store legend information -NFLST1.FOR !NFLST1 Deal with statistics (of scalars) -NFLST3.FOR !NFLST3 Display statistics of accumulation group -NFLSWI.FOR !NFLSWI Routine for transfer of `flagging-mode' -! switches between C sub-routines. -! -! Executables -! -NFLAG.EXE ! Scan handling -!- diff --git a/src/nscan/nfl.inc b/src/nscan/nfl.inc deleted file mode 100644 index 948047670b794758b8b761dae130884039c1d091..0000000000000000000000000000000000000000 --- a/src/nscan/nfl.inc +++ /dev/null @@ -1,47 +0,0 @@ -/*+ Created from nfl.dsc on 031229 at 12:46:28 at dop19 -.. NFL.INC -.. WNB 031229 -.. -.. Revisions: -.. -.. WNB 930803 Remove .INCLUDE -.. WNB 930618 Original version -.. */ -/* -.. Given statements: -.. */ -/* -.. Result: -.. -.. NFL.DEF is an INCLUDE file for the NFLAG program -.. -.. */ -/* -.. Parameters: -.. */ -#define MXNSET 64 /* MAX. # OF SETS */ -#define MXNIFR 120 /* MAX. # OF INTERFEROMETERS */ -/* -.. Data declarations: -.. */ -/* -.. NFL common data: -.. */ -struct nfl_com { - union { - char option[24]; /* PROGRAM OPTION */ - char opt[3]; - } option; - char nodin[80]; /* INPUT NODE */ - char ifile[80]; /* INPUT FILE NAME */ - int fcain; /* INPUT FCA */ - int sets[65][8]; /* SETS TO DO */ -}; -/* -.. NFL common block: -.. */ -extern struct nfl_com nfl_com_ ; -/* -.. Given statements: -.. */ -/*- */ diff --git a/src/nscan/nflag.for b/src/nscan/nflag.for deleted file mode 100644 index 88f0dc82740327161d48861a011fd9866e624c5f..0000000000000000000000000000000000000000 --- a/src/nscan/nflag.for +++ /dev/null @@ -1,56 +0,0 @@ -C+ NFLAG.FOR -C WNB 930618 -C -C Revisions: -C CMV 960122 Warning if /NORUN ignored -C - SUBROUTINE NFLAG -C -C Main routine to interactively handle Scan files -C -C Result: -C -C -C Include files: -C - INCLUDE 'WNG_DEF' - INCLUDE 'NFL_DEF' -C -C Parameters: -C -C -C Arguments: -C -C -C Function references: -C - LOGICAL WNDRUN !TEST RUN -C -C Data declarations: -C -C- -C -C PRELIMINARIES -C - CALL NFLINI !INIT PROGRAM - IF (.NOT.WNDRUN()) - 1 CALL WNCTXT(F_TP,'Ignored option /NORUN') -C -C DISTRIBUTE -C - 10 CONTINUE - CALL NFLDAT !GET USER DATA - IF (OPT.EQ.'QUI') THEN !READY - CALL WNGEX !FINISH - ELSE IF (OPT.EQ.'SHO') THEN !SHOW DATA - CALL NFLPRT - GOTO 10 - ELSE IF (OPT.EQ.'FLA') THEN !(UN-)FLAG DATA - CALL NFLFLG - GOTO 10 - END IF -C - CALL WNGEX !READY -C -C - END diff --git a/src/nscan/nflag.psc b/src/nscan/nflag.psc deleted file mode 100644 index 52d5a399ca16e82c6aaacf8cce5fe78a2fab08c4..0000000000000000000000000000000000000000 --- a/src/nscan/nflag.psc +++ /dev/null @@ -1,1220 +0,0 @@ -!+ NFLAG.PSC -! WNB 930618 -! -! Revisions: -! WNB 930619 Add OPERATION_2, TOTEL, RED, NORED, RRESID -! WNB 930623 Add SHOW DATA T option -! WNB 930713 Text only -! JEN 930721 Improvement of flagging help-text -! JEN 930803 Add Operation ARESID -! JEN 930811 Add Operations SHOW,STAT,STH -! JEN 930811 Put CLIP/NOIS operations into new OPERATION_2 -! Rename old OPERATION_2 to OPERATION_3 -! JEN 930818 Add operation DT1 -! JEN 930820 Add operation RESET -! JEN 930820 Add keyword DRY_SCANS -! JEN 930821 Disabled FORCE options in FLAG_MODE (tentatively) -! CMV 930826 Enable FORCE options with improved help text -! JEN 930912 Drastic reorganisation of flagging user interface: -! FLAG_OPTION hase become the central pivot for: -! - FLAG_MODE (....) -! - OPS_FLIST (interactions with flag list) -! - OPS_MANUAL (manual flagging operations) -! - OPS_CLIP (data-driven flagging operations) -! - OPS_NOISE (data-driven flagging operations) -! - OPS_DETERM (deterministic flagging operations) -! - OPS_COPY (copy flags within hypercube) -! JEN 930924 Add OPS_INSPECT -! CMV 931116 Moved SHOW-keywords to NSHOW_PEF -! JEN 931117 Added keyword SUB_CUBE -! JEN 931122 Added keyword PBAS_LIMITS, SHADOW_DIAM -! JEN 931122 Added keyword DT1_LIMITS, CLIP_LIMIT -! JEN 931123 Added keyword ABCS_LIMITS -! JEN 931126 Introduced OPS_SCANS for all Scan-header ops. -! JEN 940216 Added DRYRUN/NODRY options to FLAG_MODE -! JEN 940216 Added QXY options to OPS_CLIP -! CMV 940707 Removed SCANS option from MANUAL, added HARANGE -! JEN 940714 Added extra STATISTICS options -! CMV 940817 Added ELEVATION option -! JPH 940913 Remove () from prompts -! JPH 940923 NSETS --> SCNSETS -! JPH 940927 Disable CBI in OPS_DETERM (because not available) -! JPH 940929 Disable CHAN in OPS_INSPECT (because not available) -! Text changes. NOCO --> NOCORR, NODRY --> NODRYRUN -! JPH 941020 SCNNODE_PEF. SELECT_PEF -! JPH 941202 Extensive reworking of HELP texts. Prompt formatting. -! JPH 941222 / in OPTIONS --> , -! JPH 950109 Add USER_FLAG (which got lost somewhere?). MDLNODE_PEF -! JPH 951011 Help texts, formatting. Remove UNITS -! JEN 960225 Added UXY,VXY options to OPS_CLIP -! JPH 960402 Overdue checkin; format and text changes relative to -! version of 960130 in master system -! -! Get overall action -! Ref: NFLDAT -! -KEYWORD=OPTION - DATA_TYP=C - IO=I - LENGTH=24 - CHECKS=ABBREV_OPTIONS - SWITCHES=LOOP,NULL_VALUES - SEARCH=L,P - PROMPT="NFLAG main branch" - OPTIONS=FLAG; SHOW, QUIT - HELP=" Specify the nature of the operation you want to perform: -. - FLAG: Set, clear and/or browse data flags in a .SCN file - and/or browse its data statistics -. - SHOW: Show/edit data and header information in .SCN file. This -option - is a clone of the SHOW option in NSCAN and is available here - for convenience. -. - QUIT: Terminate NFLAG " -! -! -! Specify subset of hypercube -! Ref: NFLCUB -! -KEYWORD=SUB_CUBE - DATA_TYP=C - IO=I - LENGTH=24 - CHECKS=ABBREV_OPTIONS - SWITCHES=LOOP,NULL_VALUES - SEARCH=L,P - PROMPT="Type of secondary data cube" - OPTIONS=YES, IFR,POL,HA; NO - HELP=" You may define a 'secondary cube' that includes only part of the -primary data cube. The current flagging operation will affect only the cross -section of the primary and secondary cubes. -. -Unlike the primary cube (which can only be redefined through the FLAG_MODE -parameter), the secondary cube definition applies only to the current operation -and will evaporate when it completes. -. -Specify here how you want to define the secondary cube. You may give ONE option -at a time; the prompt will reappear until you reply with NO. -. - YES Polarisations, interferometers and hour-angle range. - IFR Interferometers - POL Polarisations - HA Hour-angle range - NO Accept the current settings -!! Check volatility, interpretation of NO, one at a time and -!! defaulting -! \whichref{}{} -" -! -! Get input file -! Ref: NFLFL5 -! -KEYWORD=INPUT_FILE - DATA_TYP=C - IO=I - LENGTH=80 - SWITCHES=LOOP,NULL_VALUES - SEARCH=L,P - PROMPT="Input .FLF file name (including extension)" - HELP=" Specify the full name of the input binary-flags file. The -recommended filename extension is .FLF." -!! Why not automatic .FLF as for other types? -! -! Get output file -! Ref: NFLFL5 -! -KEYWORD=OUTPUT_FILE - DATA_TYP=C - IO=I - LENGTH=80 - SWITCHES=LOOP,NULL_VALUES - SEARCH=L,P - PROMPT="Output .FLF file name (including extension)" - HELP=" Specify the full name for the output binary-flags file. The -recommended filename extension is .FLF." -! -! Get flag option -! Ref: NFLFLG -! -KEYWORD=FLAG_OPTION - DATA_TYP=C - IO=I - LENGTH=24 - CHECKS=ABBREV_OPTIONS - SWITCHES=LOOP,NULL_VALUES - SEARCH=L,P - PROMPT="Type of flagging operation|" - OPTIONS=- -CLIPDATA, DETERM; CLEAR, MANUAL, HASCANS, FCOPY;|- -FLIST; MODE; INSPECT, STATIST, QUIT - DEFAULT=INSPECT - HELP=" Specify the type of flagging operation to be performed: -. - Selective flagging on the basis of data/coordinate/statistics values: -. - CLIPDATA Flag data points according to a data-derived criterion - (amplitudes, selfcal residuals, etc.) - DETERM Flag data points on the basis of their coordinates (position, - elevation, etc.) -. - Deterministic clearing, setting and copying of flags: -. - CLEAR Clear flags from scan headers and data (see also MANUAL) - MANUAL Manual flagging operations (includes CLEAR flags). -!! What is this about MANUAL vs CLEAR? - HASCANS Operations on the scan-header flags. These affect ENTIRE - scans, and in doing so IGNORE the interferometers (parameter - IFRS) and polarisations (parameter SELECT_XYX) selections - that you defined for your primary/secondary data cubes. - FCOPY Copy flags from one place in the hypercube to another. -!! From somewhere into the hypercube? -!! From the hypercube to somewhere else? -. - Operation on the flag list in core: -. - FLIST Operations on the internal flag list - (including reading-from/writing-to a .FLF file). -. - Define operating environment: -. - MODE Go to FLAG_MODE parameter to change 'environment' parameter - values. This includes re-definition of the primary data -cube. -. - Navigation: -. - INSPECT Go to the flag-INSPECTion group of operations. - STATIST Go to the data-STATISTICS group of operations. -. - QUIT Return to primary OPTION. " -! -! Get flag mode -! Ref: NFLFLG -! -KEYWORD=FLAG_MODE - DATA_TYP=C - IO=I - LENGTH=24 - CHECKS=ABBREV_OPTIONS - SWITCHES=LOOP,NULL_VALUES - SEARCH=L,P - OPTIONS= - -HYPER, SECTORS, NODE; CORR, NOCORR, UFLAG;|- -DRYRUN,NODRYRUN, SHOW,NOSHOW, NOTRACE,TRACE; QUIT - DEFAULT=QUIT - PROMPT=- -"Set ONE environment parameter at a time; QUIT or <CR> when done|" - HELP=" You may select one of the options at a time. - The logical ones, such as CORR/NOCORR will take effect immediately. For the -others, you will be prompted for (a) new value(s). The values shown below as -defaults are the ones with which NFLAG starts up. -. - Redefinition of the primary data cube: -. - HYPER: Change the primary data cube by selecting new polarisation, - interferometer and hour-angle ranges. - SECTORS: As HYPER but including a change of the SCN_SECTORS selection. - NODE: Completely new primary data cube (i.e. including new .SCN - file) -. - Data-correction modes. Shown in parentheses is NFLAG's initial setting: -. - CORR/NOCORR (=NOCORR): - Reading mode for visibility data: without/with corrections - applied and ignoring/acknowledging flags. - (NOCORR mode will be ignored in those cases for which the use - of uncorrected data would be pointless, e.g. ARESID, RRESID). -. - UFLAG (=ALL): - Default flag types to be acknowledged when reading data in - CORR mode. -. - Run modes: -. - SHOW/NOSHOW (=SHOW): - After each flagging operation, show/don't show a summary of the - new flag settings for the data cube and flag types selected -for - that operation. - Note that in either mode the affected flags will be counted - anyway, so you can use INSPECT afterwards to show summatries - from various perspectives -. - DRYRUN/NODRYRUN (=DRYRUN): - For any operation that would change flags in the .SCN file, - do/don't do a 'trial run' first, - e.g. to get a feeling for - sensible default values for clip limits etc. - (For NODRYRUN safe default values will be chosen for such - limits so that nothing will happen until the user sets his own - values.) -. - NOTRACE/TRACE (=NOTRACE): - Dont't/do trace the flagging operations through messages on the - terminal. TRACE is likely to produce a lot of output and - intended for debugging purposes only. -. - Navigation: -. - QUIT: Go back to FLAG_OPTION." -! -! Operation on the internal flag list: -! Ref: NFLFLG -! -KEYWORD=OPS_FLIST - DATA_TYP=C - IO=I - LENGTH=24 - CHECKS=ABBREV_OPTIONS - SWITCHES=LOOP,NULL_VALUES - SEARCH=L,P - PROMPT="Flag-list operation|" - OPTIONS=- -DELETE, GET,PUT; LOAD,UNLOAD, READ,WRITE; HEADER, LIST, LCOUNT;|- -INSPECT, STATIST, MODE, CLEAR, QUIT - HELP=" Specify operations on the internal flag list: The entries in -this list represent flagging instructions. Each entry contains a flag type, and -ranges for the secondary data cube (i.e. hour angle, polarisation, -interferometer and channel ranges) to which it applies. -. - Flagging operations involving the internal flag list: -. - DELETE Clear the entire list. -. - GET Collect flags of specified type(s) from the specified primary - data cube, translate them into flaqg-list entries and merge - them into the list. - The default flag type is ALL, but it can be changed (parameter - FLAG_MODE). -! {\em see \whichref{paremeter FLAG_MODE}{} } -!! correct? -. - PUT Use he entries in the internal flag list to set flags for - selected visibilities or scans. - If an entry in the list results in setting the flags on all -data - points in a scan, the corresponding scan-header flag is set - instead for efficiency reasons. -. - Transfer of the flag list to/from an external file. Two types of file may be - used: -. - The .FLF file is in a compact binary format that is efficient in both - operating speed and disk-space. It is accessed through: - LOAD Merge contents of a .FLF file into the internal flag list - UNLOAD Write the internal flag list to a new .FLF file -. - The list can also be stored in an ASCII file which you can inspect and -edit - as you please. ASCII files are bulky and take much more time to process. - They are accessed through: - READ Merge contents of an ASCII flag-list file into the internal -flag - list - WRITE Write the internal flag list to a new ASCII flag-list file -. - Inspection: -. - HEADER Show the contents of the flag-list header. - LIST Show the contents of the flag-list (can be long!). -!! Implement control-C - LCOUNT Count the flags in the flag list (NOT in the data!). - These can be INSPECTed in various one-dimensional projections. -. - Navigation: -. - INSPECT Make detour into the (flag) INSPECTion section of the program - STATIST Make detour into the (data) STATISTics section of the program - MODE Make detour into the environment MODE-control section of the - program - CLEAR Go to the CLEAR-flags operation. - QUIT Go back to what you were doing before. " -! -! Manual flagging operations -! Ref: NFLFLG -! -KEYWORD=OPS_MANUAL - DATA_TYP=C - IO=I - LENGTH=24 - CHECKS=ABBREV_OPTIONS - SWITCHES=LOOP,NULL_VALUES - SEARCH=L,P - PROMPT="Manual-flagging operation|" - OPTIONS=- -CLEAR, CLDAT, CLHEAD; UVDATA, HARANGE; INSPECT, STATIST, MODE, QUIT - HELP=" Specify one of the manual flagging operations. Remember that -only the selected primary/secondary data cube is affected. Make sure that you -understand which of the 8 flag types are affected. -!! Is it the secondary? -. - Clear flags. You will be prompted for the flag-type(s) to be cleared: - BEWARE! Much work can be undone with careless clearing! -. - CLEAR Clear all flags of the specified type(s) in both the - scan headers and the uv data of the selected cube. -!! What if a scan "protrudes" outside the cube? - CLDAT Clear flags on the visibilities only (i.e. leave scan headers - alone). - CLHEAD Clear flags in the scan headers only. -. - Set flags: -. - UVDATA Set flags of the specified type(s) in the individual - visibilities, for selected interferometer(s) within the -primary - data cube. - Default flag type is MANUAL, but can be overridden (parameter - FLAG_MODE). - HARANGE Set flags of the specified type(s) on the individual - visibilities, for selected interferometer(s) within the -primary - data cube. - Default flag type is MANUAL, but can be overridden (parameter - FLAG_MODE). - You will be repeatedly prompted for an hour-angle range. -. - Navigation: -. - INSPECT Make detour into the (flag) INSPECTion section of the program - STATIST Make detour into the (data) STATISTics section of the program - MODE Make detour into the enviornment MODE-control section of the - program - CLEAR Go to the CLEAR-flags operation. - QUIT Return to FLAG_OPTION prompt. " -! -! Get flagging operation -! Ref: NFLFLG -! -KEYWORD=OPS_FCOPY - DATA_TYP=C - IO=I - LENGTH=24 - CHECKS=ABBREV_OPTIONS - SWITCHES=LOOP,NULL_VALUES - SEARCH=L,P - PROMPT="Flag-copy operation" - OPTIONS=TOTEL, TOPOL, TODATA, TOHEAD;|- -INSPECT, STATIST, MODE, CLEAR, QUIT - HELP=" FCOPY propagates flags of the selected type from individual -interferometers to groups of interferometers that have something in common with -the flagged ones. -. -Flags are looked for in the entire primary data cube, but changes affect only -the primary/secondary cube. Make sure that you understand which of the 8 flag -types are affected! -!! Primary/secondary: Correct? -. - Operations that modify flags on individual data points: -. - TOTEL Copy flags from interferometers to telescopes: For each scan - selected, flag all data that share a dipole (X or Y channel of - a telescope) with any interferometer for which the flag - selected is set. -. - TOPOL Copy flags to all polarisations: For each scan selected, flag -all - polarisations of all telescope pairs for which the flag -selected - is already set for at least one of them. (This is a sort of - mini-PUT). -!! Each scan <--> primary data cube? -. - Operations that affect ENTIRE scans. NOTE that these IGNORE ANY SELECTIONS - you have defined for interferometers (parameter IFRS) and/or polarisations - (parameter SELECT_XYX). -! {\em see the dictinction between\ -! \whichref{data and header flags}{} } -. - TOHEAD For each flag selected, set the scan-header flag if it is set - for more than a given number (paremeter TOH_LIMIT) of data - points. - This invalidates the entire scan. The operation is reversible - (parameter OPS_MANUAL = CLHEAD); the individual data flags - are not affected. -! {\em See parameters \textref{TOH_LIMIT}{.toh.limit}, -! \textref{OPS_MANUAL}{.ops.manual} } -. - TODATA Transfer flags of the type selected from the header of each -scan - to all the scan's data, deleting them in the headers. -. - Navigation: -. - INSPECT Make detour into the (flag) INSPECTion section of the program - STATIST Make detour into the (data) STATISTics section of the program - MODE Make detour into the enviornment MODE-control section of the - program - CLEAR Go to the CLEAR-flags operation. - QUIT Return to FLAG_OPTION. " -! -! Get flagging operation -! Ref: NFLFLG -! -KEYWORD=OPS_SCANS - DATA_TYP=C - IO=I - LENGTH=24 - CHECKS=ABBREV_OPTIONS - SWITCHES=LOOP,NULL_VALUES - SEARCH=L,P - PROMPT=Select scan-statistics flagging criterion | - OPTIONS=- -SCANS; MAXABCS; ANOISE, XAN, YAN, RNOISE, XRN, YRN;|- -INSPECT, STATIST, MODE, CLEAR, QUIT - HELP=" The operations available here flag scan headers and thereby -affect ENTIRE scans; in doing so they IGNORE ANY SELECTIONS you have defined -for interferometers (parameter IFRS) and/or polarisations (parameter -SELECT_XYX). Apart from this, only those scans that overlap with the primary -data cube are affected. -. -For each of the options an appropriate flag is selected, as noted below. If you -have defined your own selection through the USER_FLAGS parameter, that -selection will override NFLAG's defaults. -! {\em see \textref{FLAG_MODE}{.flag.mode} } -. -! {\em see the dictinction between -! \whichref{data and header flags}{} } -. - Flagging the scans that you select. -. - SCANS Flag scans manually; you will be given the option to select a - secondary data cube for this operation. -. - Flagging on data statistics. The default flag type is CLIP. -. - MAXABCS Flag all scans in which the modulus of either the real (cosine) - or imaginary (sine) part of any visibility falls outside a - range to be specified. -. - Flagging on noise statistics. The default flag type is NOISE. -. - ANOISE Flag all scans in which any of the four noise values (X/Y - gain/phase) recorded in the latest NCALIB ALIGN or SELFCAL - operation exceeds a threshold (yet to be prompted for). -. - XAN,YAN As ANOISE, but checking only the X resp. Y noise values. -. - RNOISE Flag all scans in which any of the four noise values (X/Y - gain/phase) recorded in the latest NCALIB REDUN operation - exceeds a threshold (yet to be prompted for). -. - XRN,YRN As RNOISE, but checking only the X resp. Y noise values. -. - Navigation: -. - INSPECT Make detour into the (flag) INSPECTion section of the program - STATIST Make detour into the (data) STATISTics section of the program - MODE Make detour into the enviornment MODE-control section of the - program - CLEAR Go to the CLEAR-flags operation. - QUIT Return to FLAG_OPTION. " -! -! Get flagging operation -! Ref: NFLFLG -! -KEYWORD=OPS_CLIPDATA - DATA_TYP=C - IO=I - LENGTH=24 - SWITCHES=LOOP,NULL_VALUES - CHECKS=ABBREV_OPTIONS - SEARCH=L,P - PROMPT=Select data-thresholding criterion | - OPTIONS=- -AMPL, COS, SIN; ARESID, RRESID; QXY,UXY,VXY; DT1;|- -INSPECT, STATIST, MODE, CLEAR, QUIT | - HELP=" Remember that only the primary data cube is affected. -. -The following operations flag individual data points, according to a flagging -criterion that is derived from the visibilities themselves. You will be -prompted for an upper limit. For each visibility point exceeding the limit the -flag will be set if it exceeds the limit, for the others it will be cleared: -Current flags are NOT preserved. -. -The flag type is CLIP, unless you have defined your own type through the -USER_FLAGS parameter. -. - Flagging on straight data values exceeding the threshold. These criteria are - intended for use with CORRECTED data (Parameter FLAG_MODE=CORR). -. - AMPL Threshold applies to absolute value - COS Threshold applies to real (cosine) part. - SIN Threshold applies to imaginary (sine) part. -. - Flagging on Selfcal/Redundancy residuals. You will be prompted to specify -the - Selfcal source model used in the latest NCALIB SEFCAL/REDUN run. - (NOTE that the residuals here are VECTOR differences between observation - and source model; this definition is different from that used by NPLOT.) -. - ARESID Threshold applies to the magnitude of the residual - RRESID Threshold is the absolute difference of the residual's -magnitude - from the average magnitude of all residuals in the scan for -the - same baseline. (In short: This flags outliers in sets of - redundant baselines.) - NOTE: This operation can be performed even on uncalibrated -data, - provided a source model is available. -. - Flagging on polarisation-related criteria: -. - QXY Threshold applies to the magnitude of the difference between XX - and YY visibilities per interferometer (i.e. magnitude of - Stokes Q for parallel dipoles). - UXY Threshold applies to ABS(XY-YX) per interferometer - (i.e. ABS(U) if the dipoles are parallel). - VXY Threshold applies to ABS(j(XY+YX)) per interferometer - (i.e. ABS(V) if the dipoles are parallel). -. - For unpolarised sources, this criterion should be as effective - as ARESID above. -. - Flagging on discontinuities in time. The flags raised here serve only as an - ALERT that there is a 'jump' in the data; you will have to decide yourself - what to do about the problem. -. - DT1 Threshold is the difference in amplitude of a data point with - its counterpart in the preceding scan. -. - Navigation: -. - INSPECT Make detour into the (flag) INSPECTion section of the program - STATIST Make detour into the (data) STATISTics section of the program - MODE Make detour into the environment MODE-control section of the - program - CLEAR Go to the CLEAR-flags operation. - QUIT Return to FLAG_OPTION. " -! -! Get flagging operation -! Ref: NFLFLG -! -KEYWORD=OPS_DETERM - DATA_TYP=C - IO=I - LENGTH=24 - CHECKS=ABBREV_OPTIONS - SWITCHES=LOOP,NULL_VALUES - SEARCH=L,P - PROMPT="Select coordinate criterion |" - OPTIONS=- -SHAD, PBAS ,ELEVATION; REDUN, NONRED; INSPECT, STATIST, MODE, CLEAR, QUIT -!CBI disabled - HELP=" Remember that only the primary data cube is affected. -. - Flagging of data points on the basis of their coordinates. The flag type is - SHADOW, unless you have selected your own type (parameter FLAG_MODE). -. - SHAD In each scan, flag all data that are affected by 'shadowing', - i.e. all interferometers in which the aperture of either - telecope is partly blocked by another telescope in the line - of sight. -. - PBAS Flag all data for which the length of the projected baseline - is within a range (for which you will be prompted). This is -a - way to eliminate short baselines susceptible to -interference, - without losing more data than necessary. -. - ELEVATION Flag all uv-data that have been taken at elevations below a - limit (for which you will be prompted). -. - REDUN Flag all redundant baselines. - NONRED Flag all non-redundant baselines. -. - Navigation: -. - INSPECT Make detour into the (flag) INSPECTion section of the program - STATIST Make detour into the (data) STATISTics section of the program - MODE Make detour into the enviornment MODE-control section of the - program - CLEAR Go to the CLEAR-flags operation. - QUIT Return to FLAG_OPTION. " -!!- CBI Flag all uv-data that are affected by interference from the -!! Control Building (CB) in Westerbork. -! -! Get flagging operation -! Ref: NFLFLG -! -KEYWORD=OPS_STATIST - DATA_TYP=C - IO=I - LENGTH=24 - SWITCHES=LOOP,NULL_VALUES - SEARCH=L,P - PROMPT=- -"Statistics operation - (ACC, SCANS, UVDAT, <name>;|- -GROUPS, EXPLAIN; INSPECT, MODE, QUIT)" - HELP=" Accumulate statistics from data and/or scan headers over the -primary or secondary data cube and display it. -. - Accumulate: - ACC Accumulate statistics from data and scan headers, excluding -data - points/headers that are flagged. - You may select a secondary data cube for this purpose -(parameter - XXX). -. - Inspect the results of accumulation: -. - SCANS Show the collected scan-header statistics. - UVDAT Show the collected visibility statistics. - <name> Show the statistics of the named 'accumulation group' (use - GROUPS and EXPLAIN above to see what choices you have). -. - These options will produce a Table with the following columns: -. - <name> The name of the quantity for which statistics have been - calculated. - mean Its average value - rms Its rms magnitude - rmsms Its rms deviation w.r.t. the mean. - rmsvar The rms difference, between pairs of successively processed - values. - wtot Total weight. Usually it indicates the total nr of samples. - minval Its minimum value. - maxval Its maximum value. - <unit> The units in which the above values (except wtot) are -expressed. -. - Get some extra help: -. - GROUPS Show the names of the currently defined 'accumulation groups' - EXPLAIN Show explanation of statistical quantities. -. - Navigation: -. - INSPECT Make detour into the (flag) INSPECTion section of the program - MODE Make detour into the enviornment MODE-control section of the - program - QUIT Go back to what you were doing before. " -! -! Get flagging operation -! Ref: NFLFLG -! -KEYWORD=OPS_INSPECT - DATA_TYP=C - IO=I - LENGTH=24 - SWITCHES=LOOP,NULL_VALUES - SEARCH=L,P - PROMPT= "- -Projection (COUNT, FTYP, TEL, IFR, HA) with optional '_' plus|- -range modifier (X, Y, XY, YX, MAN, CLIP, NOISE, ADD, SHAD, U3, U2, U1, OLD)|- -OR navigation control (STATIST, MODE)" -!!CHAN - HELP=" -Count and inspect flags in the primary data cube. A complete reply consists of -one of the primary options plus a modifier suffix. -. - Count flags (no modifier!): -. - COUNT Count the flags of all types that are set, for subsequent - inspection. - You may define a secondary data cube for this operation - By default, flags of all types are counted; you may change this - (parameter FLAG_MODE). -. - Show the flag counts in various data-cube dimensions (<mod> stands for one -of - the optional modifiers listed below): -. - FTYP_<mod> Show the counts per flag-type (data and headers). - TEL_<mod> Show the counts per telescope. - IFR_<mod> Show the counts per interferometer. - HA_<mod> Show the counts per hour-angle (total over all - interferometers and polarisations). -!! CHAN_<mod> Show the counts per frequency channel. -. - Modifiers: You may limit the display of counts to a sub-set through one of - the following modifiers (prefixed with an underscore, e.g. TEL_SHAD, or - HA_XX). The display will be equivalent to that for a secondary cube - covering the same selection. -. - X, Y XX alone, YY alone - XY, YX only XX and YY, only XY and YX - MAN, CLIP, NOIS, ADD, SHAD, U3, U2, U1, OLD - for one flag type - <interferometer designation> - for a (group of) interferometer(s), e.g. FTYP_9A, HA_8* - <telescope> - for a (group of) telescope(s), e.g. FTYP_8 -!! Implemented?? -. - Navigation: -. - STATIST Make detour into the (data) STATISTics section of the program - MODE Make detour into the enviornment MODE-control section of the - program - QUIT Back out from INSPECT: Return to what you were doing before. " -! -! Get user-specified flag to use -! Ref: NFLOPS -! -KEYWORD=USER_FLAGS - DATA_TYP=C - IO=I - LENGTH=16 - NVALUES=16 - CHECKS=ABBREV_OPTIONS - SWITCHES=NULL_VALUES,WILD_CARDS,LOOP - SEARCH=L,P - PROMPT="Select flag type(s) for ALL flagging operations|" - OPTIONS=NONE, [ALL]; MAN, CLIP, NOISE, ADD, SHAD, U1,U2,U3; [OLD] - HELP=" Each flagging operation changes a specific flag type by default. -You may define here an alternative (set of) flag type(s) to be used in ALL -subsequent flagging operations. Reply NONE to revert to the default settings. -. -The purpose is to allow you to do experimental flagging with one of the USER -flags without messing up the flagging that you have already done. -. - OLD use the flag type for the 'OLD' class (i.e. flagged before - 930609, and converted with NVS option) - NB: OLD uses the same flag-bit as MAN -!! I suppose this can now be removed. -" -! -! Get user specified flag to use -! Ref: NFLOPS -! -KEYWORD=USER_FLAG - DATA_TYP=C - IO=I - LENGTH=16 - NVALUES=16 - CHECKS=ABBREV_OPTIONS - SWITCHES=NULL_VALUES,WILD_CARDS,LOOP - SEARCH=L,P - PROMPT="default flag type(s)" - OPTIONS=NONE, ALL, MAN, CLIP, NOISE, ADD, SHAD,|- -U1,U2,U3; OLD - HELP=" Specify the default flag type(s) for flagging operations. -. - NONE: no flag type specified (i.e. use default types) - ALL or * all flag types (not very useful) - MAN flag type for the MANUAL class of operations - CLIP flag type for the CLIP class of operations - NOISE flag type for the NOISE class of operations - ADD flag type for the ADDITIVE class of operations - SHAD flag type for the SHADOW class of operations - U1, U2, U3 'user' flag types, i.e. types you may use as you please -. -Note: Flags U1, U2, U3 can be used to experiment with some flagging operation - without affecting the flag type that is 'officially' associated - with the same operation. -. - OLD use the flag type for the 'OLD' class (i.e. flagged before - 930609, and converted with NVS option) - NB: OLD uses the same flag-bit as MAN " -! -! Get user specified flag to use -! Ref: NFLOPS -! -KEYWORD=SELECT_FLAG - DATA_TYP=C - IO=I - LENGTH=16 - NVALUES=16 - CHECKS=ABBREV_OPTIONS - SWITCHES=NULL_VALUES,WILD_CARDS - SEARCH=L,P - PROMPT="Flag type(s) to use in data selection|" -!! ?? - OPTIONS=NONE, ALL, MAN, CLIP, NOISE, ADD, SHAD ,U1,U2,U3; [OLD] - HELP=" Some operations test flags in selecting data. By default, NFLAG -selects the test flags appropriate to each operation; only those data are -accepted for which these flags are CLEAR. -. -You may define here an alternative (set of) flag type(s) to be used in ALL -subsequent testing operations; you may select more than one, separated by -commas. Reply NONE to revert to the default settings. -. - ALL or * test all flag types - MAN test the flag type for the MANUAL class of operations - CLIP test the flag type for the CLIP class of operations - NOISE test the flag type for the NOISE class of operations - ADD test the flag type for the ADDITIVE class of operations - SHAD test the flag type for the SHADOW class of operations - U1, U2, U3 'user' flag types, i.e. types you may use as you please - NONE revert to NFLAG's default types per operation -. - OLD the flag type for the 'OLD' class (i.e. flagged before - 930609, and converted with NVS option) - NB: OLD uses the same flag-bit as MAN -!! I suppose this can now be removed. -" -! -! Get put range -! Ref: NFLFLG -! -KEYWORD=PUT_RANGE - DATA_TYP=C - IO=I - LENGTH=8 - NVALUES=4 - SWITCH=VECTOR,NULL_VALUES,WILD_CARD - SEARCH=L,P - PROMPT=- -Ranges for expansion volume around PUT points:|- -chan.HA.ifr.pol - HELP=" PUT performs flagging commands from the internal flag list on -your primary data cube. Each command consists of a flag/unflag mask plus ranges -in the frequency- -channel, interferometer, polarisation and hour-angle 'dimensions' of the TARGET -points to which it must be applied. -. -PUT has the capability to EXPAND, within the limits of the primary data cube, -the operation over a 4-dimensional volume of data around each target point. -The extension volume is specified through RANGES along the channel, hour-angle, -interferometer and polarisation axes in this order. Except for interferometers, -a range is formulated in terms of units of sequential position rather than -physical coordinates. It can be one of the foloowing: -. - . do not extend along this axis - * extend to all positions along this axis - <n> or <n>C extend over <n>/2-1 positions on either side (incrementing <n> - if it is even) - <n>L extend over <n>-1 positions to the 'left' (i.e. toward lower - coordinates) - <n>R extend over <n>-1 fields to the 'right' (i.e. toward higher - coordinates) -. - The following special notations can also be used in each dimension: -. - <n>=0 suppress flagging altogether (length of the nextension cube is - zero) - <n>=1 identical to . (length of extension cube is 1: no extension) - The following shorthand can be used for the entire reply: -. - * short for 1,1,1,1 or .,.,., (You may do better to avoid this - form because this use of a wildcard character is anomalous.) -. -? The interferometer range works on telescope basis, i.e. the given range is ? - valid for both receptors (e.g. 0Y and AX). -!! Clarify, it must be different from the other coordinates... -. -Example: - If a particular ineterferometer is flagged in one of frequency -channels, - PUT_RANGE= *,.,.,. - will propagate the flag to all channels for that interferometer " -!! How does one access the PUT_EXPAND_xx keywords? -! -! Get put range -! Ref: NFLFLG -! -KEYWORD=PUT_EXPAND_CH - DATA_TYP=J - IO=I - SWITCH=LOOP,NULL_VALUES,WILD_CARD - CHECKS=MINIMUM - MINIMUM=0 - SEARCH=L,P - PROMPT="PUT expansion half-width in channel numbers" - HELP=" PUT performs flagging commands from the internal flag list on -your primary data cube. Each command consists of a flag/unflag mask plus ranges -in the frequency- -channel, interferometer, polarisation and hour-angle 'dimensions' of the TARGET -points to which it must be applied. -. -You have activated PUT's option to EXPAND, within the limits of the primary -data cube, the operation over a 4-dimensional volume of data around each target -point. You may now select the number of channels on either side of a target -channel over which you want to expand the flagging. Example: - If you reply 2, a total of 5 channels centered on each target channel -will be flagged: two above and two below the target. " -! -! Get HA -! Ref: NFLFLG -! -KEYWORD=HA - DATA_TYP=R - IO=I - NVALUES=2 - SWITCHES=LOOP,NULL_VALUES,WILD_CARDS -!! UNITS=DEG,RAD,CIR,HMS - SEARCH=L,P - PROMPT="hour angle range to process (deg)" - HELP=" Specify the start and end of the HA-range to be processed. If -only one value is given, the end value will be the same." -! -! Get flagging limit -! Ref: NFLOPS -! -KEYWORD=LIMIT - DATA_TYP=R - IO=I - SWITCHES=LOOP,NULL_VALUES - SEARCH=L,P - PROMPT="Flagging threshold" - HELP=" Specify the limit threshold value for the (un)flag criterion -selected. The units (e.g. W.U.) are those appropriate for the criterion." -! -! Get clipping threshold: -! Ref: NFLOPS -! -KEYWORD=CLIP_LIMIT - DATA_TYP=R - IO=I - SWITCHES=LOOP,NULL_VALUES - SEARCH=L,P - PROMPT="Clip threshold (W.U.)" - HELP=" Specify the threshold value (W.U.) for the clipping criterion -selected. -. -The default value shown is three times the rms value calculated in a 'trial -run' through the first <N> valid (see Note below) scans in the -primary/secondary data cube. This is intended to be an educated guess at a -sensible 3-sigma threshold for your operation, but you must make your own -assessment of the probable suitability of this value. -. -Notes: - The new setting of the target flag in each scan or data point will - OVERRIDE the current one rather than being ORed into it. -. - The number <N> of dry-run scans is defined by the parameter DRY_SCANS; the - default is 25. -. - The flags used in selecting valid scans are defined by parameter ? -SELECT_FLAGS; the default is ALL. -! {\em see parameters \textref{DRY_SCANS}{.dry.scans}, -! \textref{SELECT_FLAG}{.select.flag} } -" -! -! Get flag limits -! Ref: NFLOPS -! -KEYWORD=CLIP_LIMITS - DATA_TYP=R - IO=I - NVALUES=2 - SWITCHES=LOOP,VECTOR,NULL_VALUES - SEARCH=L,P - PROMPT="Clip limits" - HELP=" Specify the range within which the test value will be accepted. -For values outside the range the flag will be set, for those within the range -it will be cleared. -. -The default value shown is three times the rms value calculated in a 'trial -run' through the first <N> valid (see Note below) scans in the -primary/secondary data cube. This is intended to be an educated guess at a -sensible 3-sigma threshold for your operation, but you must make your own -assessment of the probable suitability of this value. -. -Notes: - The new setting of the target flag in each scan or data point will - OVERRIDE the current one rather than being ORed into it. -. - The number <N> of dry-run scans is defined by the parameter DRY_SCANS; the - default is 25. -. - The flags used in selecting valid scans are defined by parameter ? -SELECT_FLAGS; the default is ALL. -! {\em see parameters \textref{DRY_SCANS}{.dry.scans}, -! \textref{SELECT_FLAG}{.select.flag} } -! -!! rms, 3-sigma is not the right thing here - clarify -" -! -! Get threshold for option DT1: -! Ref: NFLOPS -! -KEYWORD=DT1_LIMIT - DATA_TYP=R - IO=I - SWITCHES=LOOP,NULL_VALUES - SEARCH=L,P - PROMPT="Discontinuity threshold (W.U. per 10 sec)" - HELP=" The DT1 option looks for 'un-physical jumps' in time in the -cosine and sine values of the uv-data. The actual difference (in W.U.) between -successive time-samples is divided by the time that separates them, in units of -the integration time (e.g. 60 sec). The flag is set if this value exceeds the -threshold. -" -! -! Get flag limits -! Ref: NFLOPS -! -KEYWORD=LIMITS - DATA_TYP=R - IO=I - NVALUES=2 - SWITCHES=LOOP,VECTOR,NULL_VALUES - SEARCH=L,P - PROMPT="flagging limits" - HELP=" Specify the LOWER and UPPER limiting values for the (un-)flag -criterion. The unit (e.g. W.U.) depends on the criterion under consideration. -. -! -! Get flag limits -! Ref: NFLOPS -! -KEYWORD=ABCS_LIMITS - DATA_TYP=R - IO=I - NVALUES=2 - SWITCHES=LOOP,VECTOR,NULL_VALUES - SEARCH=L,P - PROMPT="Acceptance range for ABS(cos), ABS(sin)" - HELP=" An ENTIRE scan will be flagged if for any valid data point in it -the modulus of either the real (cos) or imaginary (sin) part falls outside the -acceptance range. -. -This option allows you to reject scans containing interference peaks, or 'bad' -data (i.e. abnormally low amplitudes). -. -NOTES: -. - The new setting of the target flag in each scan or data point will - OVERRIDE the current one rather than being ORed into it. -. - The flags used in selecting valid scans are defined by parameter ? -SELECT_FLAGS; the default is ALL. -! {\em see parameters \textref{DRY_SCANS}{.dry.scans}, -! \textref{SELECT_FLAG}{.select.flag} } -! -!! rms, 3-sigma is not the right thing here - clarify -NB: When new thresholds are given, all Scans in the specified data cube are -(un-)flagged accordingly, including the Scans that were flagged already. " -! -! Get flag limits -! Ref: NFLOPS -! -KEYWORD=PBAS_LIMITS - DATA_TYP=R - IO=I - NVALUES=2 - SWITCHES=LOOP,VECTOR,NULL_VALUES,WILD_CARDS - SEARCH=L,P - PROMPT="Projected-baseline range to be flagged (m)" - HELP=" Specify the range of lengths of PROJECTED baseline to be -flagged. The default flag-type is SHADOW. -. -Short baselines are more sensitive to interference. In flagging them wholesale, -however, one also loses visibility data representing extended source structure; -a more selective procedure is to be preferred. -. -Another application of this parameter is to force a uv coverage that is more -nearly circular in the PROJECTED uv plane, and hence produces a more circularly -symmetric antenna pattern. To this end, set the lower limit less than or equal -to -. - <longest baseline> * sin DEC -. -Instead of permanently modifying the .SCN file in this way, one may use the -NMAP parameters CWEIGHT_TYPE and CWEIGHT_VALUE to achieve a similar effect. -! {\em see NMAP public paremeter -! \textref{CWEIGHT_TYPE}{nmap_public_keys.cweight.type} } -. -Examples: - PBAS_LIMITS = 0, 288 -. - causes all projected baselines up to 288 m (inclusive) to be flagged. -. - For a source at a declination of 30 deg, -. - PBAS_LIMITS = 1500, 10000 -. - will flag projected baselines longer than 1500 m. " -! -! Get flag limits -! Ref: NFLOPS -! -KEYWORD=SHADOW_DIAM - DATA_TYP=R - IO=I - SWITCHES=LOOP,NULL_VALUES - SEARCH=L,P - PROMPT="Telescope shadowing diameter (metres)" - HELP=" Specify the diameter (m) of the telescopes. -. -A telescope is 'shadowed' as soon as part of its aperture gets blocked by the -presence of another telecope in its line of sight. This condition occurs when -the projected baseline between the two telecopes becomes less than the -telescope diameter D (25 m for the WSRT). If you want to retain as much as -possible of your data, you may specify a somewhat smaller number (e.g. 0.8 D) -to take into account the fact that the edge of the aperture is only weakly -illuminated. -. -For the hour-angles at which a telescope is shadowed, all intreferometers are -flagged of which it is a part. The default flag-type is SHADOW. -. - ? Another flag may be selected through the FLAG_MODE parameter. " -! -! Get flagging count limit -! Ref: NFLOPS -! -KEYWORD=TOH_LIMIT - DATA_TYP=J - IO=I - SWITCHES=LOOP,NULL_VALUES - CHECKS=MINIMUM - MINIMUM=1 - SEARCH=L,P - PROMPT="Maximum number of data flags to tolerate per scan" - HELP=" NFLAG will check in each scan the number of points for which the -flag type selected is set. If that number exceeds this value you define here, -the entire scan will be flagged. This will subsequently result in faster -processing -(because individualdata points need not be tested) at the expense of the loss -of some healthy data. -. -The operation of setting header flags is reversible: The individual data flags -are retained so you can restore the present condition by clearing the header -flags. " -! -! Get nr of scans for trial run: -! Ref: NFLOPS -! -KEYWORD=DRY_SCANS - DATA_TYP=J - IO=I - SWITCHES=LOOP,NULL_VALUES - CHECKS=MINIMUM - MINIMUM=1 - SEARCH=L,P - PROMPT="Number of scans to use in trial runs" - HELP=" -'Clipping' operations need (a) threshold value(s) that is (are) related to the -magnitude of the data at hand. -. -The program determines a 'rasonable' default for such cases by performing a -'trial run' on the first of the scans in the data cube selected. You may -specify their number here. The trial run evaluates the clipping criterion but -does NOT modify the .SCN file. For data with reasonably stationary statistics, -the default number should be adequate. A larger number obviously will take more -time to process. If you specify a very large number, the trial run will include -the entire data cube selected. " -! -! Get flag limits -! Ref: NFLOPS -! -KEYWORD=ELEVATION_LIMIT - DATA_TYP=R - IO=I - SWITCHES=LOOP,NULL_VALUES -!! UNITS=DEG,RAD,CIR,HMS - SEARCH=L,P - PROMPT="Elevation lower limit (deg)" - HELP=" Specify the lower limit for acceptable elevations. All points -corresponding to lower elevations are rejected. The default flag-type is SHADOW. -" -! -INCLUDE=NGEN_PEF -! -INCLUDE=NSHOW_PEF -! -INCLUDE=FLFNODE_PEF ! -! -INCLUDE=SCNNODE_PEF ! -INCLUDE=SCNSETS_PEF ! -INCLUDE=SELECT_PEF -! -INCLUDE=NMODEL_PEF ! -INCLUDE=MDLNODE_PEF -!- diff --git a/src/nscan/nflcnt.for b/src/nscan/nflcnt.for deleted file mode 100644 index 3009e4717d7e0a721e7305df228d49616a09beea..0000000000000000000000000000000000000000 --- a/src/nscan/nflcnt.for +++ /dev/null @@ -1,767 +0,0 @@ -C+ NFLCNT.FOR -C JEN930918 -C -C Revisions: -C JPH 940929 SHOW: Give message only when no counts available -C CMV 941023 Properly terminate line (J3:J3) -> (J3:) -C CMV 960122 Change backslash to space in IFR output -CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC -C - SUBROUTINE NFLCNT (ACTION,NAME,FLAG,MASK,IFRA,ICHAN,HA) -C -C Count flags that have been set: -C -C Result: -C -C CALL NFLCNT (ACTION_C(*):I,NAME_C(*):I, -C FLAG_J(0:*):I,MASK_J(0:*):I, -C IFRA_J(0:1,0:STHIFR-1):I, -C ICHAN_J:I,HA_R:I) -C -C CALL NFLCNT ('RESET',' ',0,0,0,0,0) -C -C CALL NFLCNT ('ACC','DATA',flacc(0:STHIFR-1,0:3), -C mask(0:STHIFR-1,0:3), -C IFRA(0:1,0:STHIFR),ICHAN,HA) -C CALL NFLCNT ('ACC','HEAD',flacc(0),mask(0),0,ICHAN,HA) -C -C CALL NFLCNT ('SHOW','FTYP',0,0,0,0,0) -C CALL NFLCNT ('SHOW','TEL',0,0,0,0,0) -C CALL NFLCNT ('SHOW','IFR',0,0,0,0,0) -C CALL NFLCNT ('SHOW','CHA',0,0,0,0,0) -C -C CALL NFLCNT ('SHOW','HA',0,0,0,0,0) !ALL POLS -C CALL NFLCNT ('SHOW','HA_XX',0,0,0,0,0) !XX -C CALL NFLCNT ('SHOW','HA_YY',0,0,0,0,0) !YY -C CALL NFLCNT ('SHOW','HA_XY',0,0,0,0,0) !XX,YY -C CALL NFLCNT ('SHOW','HA_YX',0,0,0,0,0) !XY.YX -C -C PIN references: -C -C Include files: -C - INCLUDE 'WNG_DEF' - INCLUDE 'NFL_DEF' - INCLUDE 'CBITS_DEF' - INCLUDE 'STH_O_DEF' !SET HEADER -C -C Parameters: -C - INTEGER XX,XY,YX,YY !POL. POINTERS - PARAMETER (XX=0, XY=1, YX=2, YY=3) -C - INTEGER IHAMIN,IHAMAX !HA-BIN NRS (1 degr wide) - PARAMETER (IHAMIN=-180, IHAMAX=180) -C - INTEGER ICHMIN,ICHMAX !CHANNEL NRS - PARAMETER (ICHMIN=0, ICHMAX=256) -C - INTEGER MXNFLTYP !# of flag types - PARAMETER (MXNFLTYP=8) -C - INTEGER NCPL !Nr of chars printed per line - PARAMETER (NCPL=79) -C - CHARACTER*1 C_NOTEST,C_NOFLAG,C_ALLSET - PARAMETER (C_NOTEST='.') !Data item not tested - PARAMETER (C_NOFLAG='-') !No flags set - PARAMETER (C_ALLSET='*') !All (100%) flags set -C - CHARACTER*1 C_VER,C_HOR - PARAMETER (C_VER='#') !Vertical edge of display frame - PARAMETER (C_HOR='#') !Horizontal edge of display frame - CHARACTER*79 SEPAR !Separator string (see SHOW) - PARAMETER (SEPAR= - 1 '########################################'// - 1 '#######################################') -C -C Arguments: -C - CHARACTER ACTION*(*) !ACTION TO BE PERFORMED - CHARACTER NAME*(*) !CLOSER SPECIFICATION OF ACTION - INTEGER FLAG(0:*) !HEADER/DATA FLAG(S) -C ! HEADER: FLAG(0:0) -C ! DATA : FLAG(0:STHIFR-1,0:3) - INTEGER MASK(0:*) !FLAGBYTE MASK(S) USED -C ! CONFORMAL WITH FLAG(0:*) - INTEGER IFRA(0:1,0:STHIFR-1) !TELESCOPE TABLE (W,E) - INTEGER ICHAN !FREQUENCY CHANNEL NR - REAL HA !HA OF SCAN -C -C Function references: -C -C -C Data declarations: -C - CHARACTER*2 POLNAME(0:3) !POL NAMES (XX, XY ETC) - DATA POLNAME /'XX','XY','YX','YY'/ ! -C - CHARACTER*1 TELNAME(0:STHTEL-1) !TEL NAMES (0,1,2,A, ETC) - DATA TELNAME /'0','1','2','3','4','5','6', - 1 '7','8','9','A','B','C','D'/ -C -C Array with flag-types and flag-codes -C - CHARACTER*4 FLAGNAME(0:MXNFLTYP-1) - DATA FLAGNAME /'MAN','CLIP','NOIS','ADD','SHAD', - 1 'U3','U2','U1'/ ! exclude ,'ALL'/ - INTEGER FLAGTYPE(0:MXNFLTYP-1) - DATA FLAGTYPE /FL_MAN,FL_CLIP,FL_NOIS,FL_ADD,FL_SHAD, - 1 FL_3,FL_2,FL_1/ ! exclude ,FL_ALL/ -C -C Variables: -C - INTEGER N - INTEGER IHA !NR OF HA-BIN - REAL HA1, HA2 ! HA range counted - INTEGER RTW,RTE !WEST,EAST TELESCOPE NR - INTEGER LIN,COL !LINE, COLUMN NR - INTEGER HEADMASK,DATAMASK !UTILISED MASKS - INTEGER NND,NFD,NNH,NFH !HELP VARIABLES - LOGICAL SELPOL(-1:3) !POL SELECTION (SHOW) - LOGICAL PRINTLINE !SWITCH -C -C Storage areas, buffer arrays -C - CHARACTER*80 TXT80 !GENERAL TEXT BUFFER - CHARACTER*80 TEXT(-5:STHTEL+5) !TEL-TEL MATRIX - CHARACTER*80 TXT_LEGEND !LEGEND STRING - CHARACTER*80 TXT_SCANS !SCANS TESTED (HA,CH) - CHARACTER*80 TXT_DATA !DATA TESTED (POL,IFRS) - CHARACTER*80 TXT_FLAGS !FLAGS TESTED (HEADERS,DATA) - CHARACTER*80 TXT_CALC ! - CHARACTER*80 ARGSTR -C -C HA-range and Channel-range of counted Scans: -C - REAL HARANH(0:1) !HA-RANGE OF TESTED SCAN HEADERS - REAL HARAND(0:1) !HA-RANGE OF TESTED SCAN DATA - INTEGER CHRANH(0:1) !CHANNEL-RANGE OF TESTED SCAN HEADERS - INTEGER CHRAND(0:1) !CHANNEL-RANGE OF TESTED SCAN DATA -C -C Flag count buffers: -C - INTEGER NFPTH(0:MXNFLTYP-1) !# OF SET FLAGS PER TYPE (IN HEADERS) - INTEGER NNPTH(0:MXNFLTYP-1) !# OF TESTED SCAN HEADERS PER FLAGTYPE - INTEGER NFPTD(0:3,0:MXNFLTYP-1) !# OF FLAGS PER TYPE PER POL (IN DATA) - INTEGER NNPTD(0:3,0:MXNFLTYP-1) !# OF TESTED DATA PER TYPE,POL(IN DATA) -C - INTEGER NFPHH(IHAMIN:IHAMAX) !# OF SET FLAGS PER HA-BIN (IN HEADERS) - INTEGER NNPHH(IHAMIN:IHAMAX) !# OF TESTED SCAN HEADERS PER HA-BIN - INTEGER NFPHD(0:3,IHAMIN:IHAMAX)!# OF FLAGS PER HA-BIN,POL (IN DATA) - INTEGER NNPHD(0:3,IHAMIN:IHAMAX)!# OF TESTED DATA PER HA-BIN,POL(DATA) -C - INTEGER NFPCH(ICHMIN:ICHMAX) !# OF SET FLAGS PER CHAN (IN HEADERS) - INTEGER NNPCH(ICHMIN:ICHMAX) !# OF TESTED SCAN HEADERS PER CHAN - INTEGER NFPCD(0:3,ICHMIN:ICHMAX)!# OF FLAGS PER CHAN,POL (IN DATA) - INTEGER NNPCD(0:3,ICHMIN:ICHMAX)!# OF TESTED DATA PER CHAN,POL(DATA) -C - INTEGER NPI(0:3,0:STHTEL-1,0:STHTEL-1) !# FLAGS/TESTED PER IFR PER POL -C - INTEGER NFPP(0:3) !# OF SET FLAGS PER POL - INTEGER NNPP(0:3) !# OF TESTED DATA PER POL -C - INTEGER NFPT(0:3,0:STHTEL-1) !# OF SET FLAGS PER TEL (DIP), PER POL - INTEGER NNPT(0:3,0:STHTEL-1) !# OF TESTED DATA PER TEL, PER POL -C- -C****************************************************************************** -C****************************************************************************** -C****************************************************************************** -!*** RESET flag-count-buffers: -C - IF (ACTION(:5).EQ.'RESET') THEN -C - HEADMASK = 0 !UTILISED MASK - DATAMASK = 0 !UTILISED MASK -C - DO I=0,MXNFLTYP-1 !PER FLAG TYPE - NFPTH(I) = 0 !SCAN HEADERS - NNPTH(I) = 0 - DO I3=0,3 - NFPTD(I3,I) = 0 !UV-DATA - NNPTD(I3,I) = 0 - END DO - END DO -C - DO I=IHAMIN,IHAMAX !PER HA - NFPHH(I) = 0 !SCAN HEADERS - NNPHH(I) = 0 - DO I3=0,3 - NFPHD(I3,I) = 0 !UV-DATA - NNPHD(I3,I) = 0 - END DO - END DO - HARANH(0) = +181 !DEGR - HARANH(1) = -181 - HARAND(0) = +181 - HARAND(1) = -181 -C - DO I=ICHMIN,ICHMAX !PER FREQU CHANNEL - NFPCH(I) = 0 !SCAN HEADERS - NNPCH(I) = 0 - DO I3=0,3 - NFPCD(I3,I) = 0 !UV-DATA - NNPCD(I3,I) = 0 - END DO - END DO - CHRANH(0) = ICHMAX+1 - CHRANH(1) = ICHMIN-1 - CHRAND(0) = ICHMAX+1 - CHRAND(1) = ICHMIN-1 -C - DO I3=0,3 !PER POL - NFPP(I3) = 0 - NNPP(I3) = 0 - DO I=0,STHTEL-1 !PER TEL - NFPT(I3,I) = 0 - NNPT(I3,I) = 0 - DO I1=0,STHTEL-1 - NPI(I3,I,I1) = 0 !PER IFR - END DO - END DO - END DO -C -C -C****************************************************************************** -!*** ACCUMULATE flag-counts: -C - ELSE IF (ACTION(:3).EQ.'ACC') THEN -C - IHA = NINT(HA*360) !HA-BIN NR, convert from circles -C - IF (ICHAN.LT.ICHMIN .OR. ICHAN.GT.ICHMAX) THEN - CALL WNCTXT (F_TP,'NFLCNT ACC '//NAME(:3) - 1 //': Channel nr out of range: !UJ',ICHAN) -C - ELSE IF (IHA.LT.IHAMIN .OR. IHA.GT.IHAMAX) THEN - CALL WNCTXT (F_TP,'NFLCNT ACC '//NAME(:3) - 1 //': IHA out of range: !UJ',IHA) -C - ELSE IF (NAME(:3).EQ.'DAT') THEN -C - HARAND(0) = MIN(HARAND(0),HA*360) !HA-RANGE (DEGR) - HARAND(1) = MAX(HARAND(1),HA*360) !HA-RANGE - CHRAND(0) = MIN(CHRAND(0),ICHAN) !CHAN-RANGE (NR) - CHRAND(1) = MAX(CHRAND(1),ICHAN) !CHAN-RANGE -C - DO I1=0,STHIFR-1 !ALL IFRS - RTW = IFRA(0,I1) !WEST TEL NR - RTE = IFRA(1,I1) !EAST TEL NR - DO I3=0,3 !ALL POLS - I2 = I3*STHIFR + I1 !INDEX IN FLAG/MASK - IF (MASK(I2).NE.0) THEN !.......? - DATAMASK = MASK(I2) !KEEP `THE' MASK -C - DO I4=0,MXNFLTYP-1 !ALL FLAG TYPES - IF (IAND(MASK(I2),FLAGTYPE(I4)).NE.0) THEN - NNPTD(I3,I4) = NNPTD(I3,I4) + 1 !# TESTED/TYPE - IF (IAND(FLAGTYPE(I4),FLAG(I2)).NE.0) THEN - NFPTD(I3,I4) = NFPTD(I3,I4) + 1 !FLAGS PER TYPE - END IF - END IF - END DO -C - NNPP(I3) = NNPP(I3) + 1 !TESTED DATA PER POL - NNPHD(I3,IHA) = NNPHD(I3,IHA) + 1 !TESTED DATA PER HA-BIN, - NNPCD(I3,ICHAN) = NNPCD(I3,ICHAN) + 1!TESTED DATA PER CHAN, - NPI(I3,RTE,RTW) = NPI(I3,RTE,RTW) + 1!TESTED DATA PER IFR,POL - NNPT(I3,RTW) = NNPT(I3,RTW) + 1 !TESTED DATA PER TEL,POL - NNPT(I3,RTE) = NNPT(I3,RTE) + 1 !TESTED DATA PER TEL,POL -C - IF (IAND(FLAG(I2),MASK(I2)).NE.0) THEN !SELECTED FLAGS ONLY - NFPP(I3) = NFPP(I3) + 1 !FLAGS PER POL - NFPHD(I3,IHA) = NFPHD(I3,IHA) + 1 !FLAGS PER HA-BIN,POL - NFPCD(I3,ICHAN) = NFPCD(I3,ICHAN) + 1 !FLAGS PER CHAN,POL - NPI(I3,RTW,RTE) = NPI(I3,RTW,RTE) + 1 !FLAGS PER IFR.POL - NFPT(I3,RTW) = NFPT(I3,RTW) + 1 !FLAGS PER TEL.POL - NFPT(I3,RTE) = NFPT(I3,RTE) + 1 !FLAGS PER TEL,POL - END IF -C - END IF !MASK<>0 - END DO !POLS (I3) - END DO !IFRS (I1) -C -C============================================================================= -C ACCUMULATE Header flags: -C - ELSE IF (NAME(:3).EQ.'HEA') THEN -C - HEADMASK = MASK(0) !KEEP `THE' UTILISED MASK -C - HARANH(0) = MIN(HARANH(0),HA*360) !HA-RANGE - HARANH(1) = MAX(HARANH(1),HA*360) !HA-RANGE - CHRANH(0) = MIN(CHRANH(0),ICHAN) !CHAN-RANGE - CHRANH(1) = MAX(CHRANH(1),ICHAN) !CHAN-RANGE -C - DO I4=0,MXNFLTYP-1 !ALL FLAG TYPES - IF (IAND(MASK(0),FLAGTYPE(I4)).NE.0) THEN - NNPTH(I4) = NNPTH(I4) + 1 !# OF TESTED SCANS PER TYPE - IF (IAND(FLAGTYPE(I4),FLAG(0)).NE.0) THEN - NFPTH(I4) = NFPTH(I4) + 1 !# OF SET FLAGS PER TYPE - END IF - END IF - END DO -C - NNPHH(IHA) = NNPHH(IHA) + 1 !TESTED HEADERS PER HA-BIN - NNPCH(ICHAN) = NNPCH(ICHAN) + 1 !TESTED HEADERS PER CHAN -C - IF (IAND(FLAG(0),MASK(0)).NE.0) THEN !SELECTED FLAGS ONLY - NFPHH(IHA) = NFPHH(IHA) + 1 !FLAGGED HEADERS PER HA-BIN - NFPCH(ICHAN) = NFPCH(ICHAN) + 1 !FLAGGED HEADERS PER CHANNEL - END IF -C -C============================================================================= - ELSE - ARGSTR='NFLCNT ACC'//': Name not recognised: '//NAME - CALL WNCTXT (F_TP,ARGSTR) - 1 - END IF !DATA/HEADER -C -C -C -C****************************************************************************** -C****************************************************************************** -C****************************************************************************** -C****************************************************************************** -C****************************************************************************** -!*** SHOW flag-counts: -C - ELSE IF (ACTION(:4).EQ.'SHOW') THEN -C -C Check if anything has been counted at all -C - HA1 = MIN(HARANH(0),HARAND(0)) - HA2 = MAX(HARANH(1),HARAND(1)) - IF (HA1.EQ.0 .AND. HA2.EQ.0) THEN - CALL WNCTXT(F_T,'No counts available: Do COUNT first') - ELSE -C -C Check specific instructions embedded in the input string(s): -C - TXT_CALC = ' ' - DO I3=0,3 !POLARISATIONS - SELPOL(I3) = .FALSE. !POL NOT SELECTED - END DO - IF (INDEX(NAME,'_XY').GT.0) THEN !XX,YY - TXT_CALC = C_VER//' Calculated for pols XX,YY only' - TXT_CALC(NCPL:) = C_VER - SELPOL(XX) = .TRUE. - SELPOL(YY) = .TRUE. - ELSE IF (INDEX(NAME,'_YX').GT.0) THEN !XY,YX - TXT_CALC = C_VER//' Calculated for pols XY,YX only' - TXT_CALC(NCPL:) = C_VER - SELPOL(YX) = .TRUE. - SELPOL(XY) = .TRUE. - ELSE IF (INDEX(NAME,'_XX').GT.0) THEN !XX ONLY - TXT_CALC = C_VER//' Calculated for pol XX only' - TXT_CALC(NCPL:) = C_VER - SELPOL(XX) = .TRUE. - ELSE IF (INDEX(NAME,'_YY').GT.0) THEN !YY ONLY - TXT_CALC = C_VER//' Calculated for pol YY only' - TXT_CALC(NCPL:) = C_VER - SELPOL(YY) = .TRUE. - ELSE - DO I3=0,3 - SELPOL(I3) = .TRUE. !ALL POLS SELECTED - END DO - END IF -C -C Prepare some general explanatory text-strings for later use: -C - CALL WNCTXS (TXT_LEGEND,C_VER// - 1 ' (!AS)=zero flags, (!AS)=100% flagged, (!AS)=not tested)', - 1 C_NOFLAG,C_ALLSET,C_NOTEST) - TXT_LEGEND(NCPL:) = C_VER -C - CALL WNCTXS (TXT_SCANS, - 1 C_VER//' Tested Scans:' - 1 //' channels=!UJ:!UJ' - 1 //' HA-range=!F4.0:!F4.0' - 1 ,MIN(CHRANH(0),CHRAND(0)) - 1 ,MAX(CHRANH(1),CHRAND(1)) - 1 ,HA1,HA2) - TXT_SCANS(NCPL:) = C_VER -C - TXT80 = ' ' - J1 = 7 !CHARS PER POL - DO I3=0,3 - IF (NNPP(I3).GT.0) THEN !POL TESTED - I2 = 0 - I4 = 0 - DO RTW=0,STHTEL-1 - DO RTE=RTW,STHTEL-1 - IF (NPI(I3,RTE,RTW).GT.0) THEN !IFR TESTED - IF (RTW.EQ.RTE) I4 = I4 + 1 !AUTOCORRS - IF (RTW.NE.RTE) I2 = I2 + 1 !CROSSCORRS - END IF - END DO - END DO - CALL WNCTXS (TXT80(2+J1*I3:), - 1 '!AS=!SJ',POLNAME(I3),I2) - ELSE - CALL WNCTXS (TXT80(2+J1*I3:), - 1 '!AS=--',POLNAME(I3)) - END IF - END DO - CALL WNCTXS (TXT_DATA, - 1 C_VER//' Tested nr of ifrs: !AS',TXT80) - TXT_DATA(NCPL:) = C_VER -C - TXT_FLAGS = C_VER//' Headers/data tested for flag-types: ' - I=37 !START CHAR - DO I4=0,MXNFLTYP-1 - IF ((IAND(HEADMASK,FLAGTYPE(I4)).NE.0) .OR. - 1 (IAND(DATAMASK,FLAGTYPE(I4)).NE.0)) THEN - CALL WNCTXS (TXT_FLAGS(I:),' !4$AS',FLAGNAME(I4)) - I=I+5 - END IF - END DO - TXT_FLAGS(NCPL:) = C_VER -C -C============================================================================== -C SHOW flags per polarisation and per flag-type: -C - IF (NAME(:3).EQ.'FTY') THEN -C - CALL WNCTXT (F_TP,'!/!AS',SEPAR) !SEPARATOR -C - TXT80 = C_VER//' Percentage of SET flags per flag-type.' - TXT80(NCPL:) = C_VER - CALL WNCTXT (F_TP,'!AS',TXT80) -C - CALL WNCTXT (F_TP,'!AS',TXT_LEGEND) - IF (TXT_SCANS.NE.' ') CALL WNCTXT (F_TP,TXT_SCANS) - IF (TXT_DATA.NE.' ') CALL WNCTXT (F_TP,TXT_DATA) - CALL WNCTXT (F_TP,'!AS',SEPAR) !SEPARATOR -C - J1 = 5 !NR OF CHARS PER FIELD - J2 = 12 !START OF FIELDS - J3 = J2+MXNFLTYP*J1 + 1 !START AFTER FIELDS - TXT80 = C_VER//' flagtype:' - DO I4=0,MXNFLTYP-1 - CALL WNCTXS (TXT80(J2+I4*J1:),'!#$AS',J1,FLAGNAME(I4)) - END DO - TXT80(J3:) = ' tested:' - TXT80(NCPL:) = C_VER - CALL WNCTXT (F_TP,'!AS',TXT80) -C - TXT80 = C_VER//' headers:' - PRINTLINE = .FALSE. - J0 = 0 - DO I4=0,MXNFLTYP-1 - J0 = MAX(J0,NNPTH(I4)) !COUNT SCANS - COL = J2+I4*J1 !COLUMN NR - R0 = (100.*NFPTH(I4))/MAX(1,NNPTH(I4)) !PERCENTAGE - IF (NNPTH(I4).EQ.0) THEN - CALL WNCTXS (TXT80(COL:),'!#$AS',J1,C_NOTEST) !NOT TESTED - ELSE IF (R0.GT.0) THEN - CALL WNCTXS (TXT80(COL:),'!#$UJ',J1,NINT(R0)) - PRINTLINE = .TRUE. - ELSE - CALL WNCTXS (TXT80(COL:),'!#$AS',J1,C_NOFLAG) !NO FLAGS - PRINTLINE = .TRUE. - END IF - END DO - CALL WNCTXS (TXT80(J3:),'% of !6$UJ Scans',J0) - TXT80(NCPL:) = C_VER - IF (PRINTLINE) CALL WNCTXT (F_TP,'!AS',TXT80) -C - DO I3=0,3 !ALL POLS - PRINTLINE = .FALSE. - CALL WNCTXS (TXT80,C_VER//' data !AS:',POLNAME(I3)) - DO I4=0,MXNFLTYP-1 - COL = J2+I4*J1 !COLUMN NR - R0 = (100.*NFPTD(I3,I4))/MAX(1,NNPP(I3)) - IF (NNPTD(I3,I4).EQ.0) THEN - CALL WNCTXS (TXT80(COL:),'!#$AS',J1,C_NOTEST) !NOT TESTED - ELSE IF (R0.GT.0) THEN - PRINTLINE = .TRUE. - CALL WNCTXS (TXT80(COL:),'!#$UJ',J1,NINT(R0)) - ELSE - PRINTLINE = .TRUE. - CALL WNCTXS (TXT80(COL:),'!#$AS',J1,C_NOFLAG) !NO FLAGS - END IF - END DO - CALL WNCTXS (TXT80(J3:),'% of !8$UJ uv-pts',NNPP(I3)) - TXT80(NCPL:) = C_VER - IF (PRINTLINE) CALL WNCTXT (F_TP,'!AS',TXT80) - END DO !NEXT POL -C - TXT80 = C_VER//' flagcode:' - DO I4=0,MXNFLTYP-1 - COL = J2+I4*J1 !COLUMN NR - I5 = FLAGTYPE(I4) !E.G. FL_MAN - I5 = IAND('000000ff'X,ISHFT(I5,-8)) !FLAG CODE (?) - CALL WNCTXS (TXT80(COL:),' (!2$XJ)',I5) - END DO - TXT80(NCPL:) = C_VER - PRINTLINE = .FALSE. !INHIBIT OUTPUT... - IF (PRINTLINE) CALL WNCTXT (F_TP,'!AS',TXT80) -C - CALL WNCTXT (F_TP,'!AS',SEPAR) !SEPARATOR -C -C============================================================================ -C SHOW flags per polarisation and per telescope: -C - ELSE IF (NAME(:3).EQ.'TEL') THEN -C - CALL WNCTXT (F_TP,' ') - CALL WNCTXT (F_TP,'!AS',SEPAR) !SEPARATOR -C - TXT80 = C_VER// - 1 ' Percentage of flagged uv-pnts, per telescope.' - TXT80(NCPL:) = C_VER - CALL WNCTXT (F_TP,'!AS',TXT80) -C - CALL WNCTXT (F_TP,'!AS',TXT_LEGEND) - IF (TXT_SCANS.NE.' ') CALL WNCTXT (F_TP,TXT_SCANS) - IF (TXT_DATA.NE.' ') CALL WNCTXT (F_TP,TXT_DATA) - IF (TXT_FLAGS.NE.' ') CALL WNCTXT (F_TP,TXT_FLAGS) - CALL WNCTXT (F_TP,'!AS',SEPAR) !SEPARATOR - - J1 = 4 !NR OF CHARS PER TYPE - J2 = 7 !START CHAR IN TXT80 - J3 = J2+STHTEL*J1 + 2 !START CHAR IN TXT80 - TXT80 = C_VER//' tel:' - DO I4=0,STHTEL-1 - CALL WNCTXS (TXT80(J2+I4*J1:),'!#$AS', - 1 J1,'RT'//TELNAME(I4)) - END DO - TXT80(NCPL:) = C_VER - CALL WNCTXT (F_TP,'!AS',TXT80) -C - DO I3=0,3 !ALL POLS - CALL WNCTXS (TXT80,C_VER//' !AS:',POLNAME(I3)) - DO I4=0,STHTEL-1 - COL = J2+I4*J1 !COLUMN NR - R0 = (100.*NFPT(I3,I4))/MAX(1,NNPT(I3,I4)) !PERCENTAGE - IF (R0.GT.0) THEN - CALL WNCTXS (TXT80(COL:),'!#$UJ',J1,NINT(R0)) - ELSE IF (NNPT(I3,I4).EQ.0) THEN - CALL WNCTXS (TXT80(COL:),'!#$AS',J1,C_NOTEST) !NOT TESTED - ELSE - CALL WNCTXS (TXT80(COL:),'!#$AS',J1,C_NOFLAG) !NO FLAGS - END IF - END DO - CALL WNCTXS (TXT80(J3:),'% of pts/tel') - TXT80(NCPL:) = C_VER - CALL WNCTXT (F_TP,'!AS',TXT80) - END DO !NEXT POL -C - CALL WNCTXT (F_TP,'!AS!/',SEPAR) !SEPARATOR -C -C============================================================================ -C SHOW flags per frequency channel: -C - ELSE IF (NAME(:4).EQ.'CHAN') THEN -C - CALL WNCTXT (F_TP,'NFLCNT: Not implemented yet.') -C -C============================================================================ -C SHOW flags per HA-bin: -C - ELSE IF (NAME(:2).EQ.'HA') THEN -C - CALL WNCTXT (F_TP,'!/!AS',SEPAR) !SEPARATOR -C - TXT80 = C_VER//' Flags per HA-bin (1 degree wide).' - TXT80(NCPL:) = C_VER - CALL WNCTXT (F_TP,'!AS',TXT80) - TXT80 = C_VER//' Format: 85;25 means: ' - 1 //'85% of uv-data ' - 1 //'and 25% of Scan headers flagged.' - TXT80(NCPL:) = C_VER - CALL WNCTXT (F_TP,'!AS',TXT80) - - CALL WNCTXT (F_TP,'!AS',TXT_LEGEND) - IF (TXT_SCANS.NE.' ') CALL WNCTXT (F_TP,TXT_SCANS) - IF (TXT_DATA.NE.' ') CALL WNCTXT (F_TP,TXT_DATA) - IF (TXT_FLAGS.NE.' ') CALL WNCTXT (F_TP,TXT_FLAGS) - IF (TXT_CALC.NE.' ') CALL WNCTXT (F_TP,TXT_CALC) - CALL WNCTXT (F_TP,'!AS',SEPAR) !SEPARATOR -C - J1 = 7 !NR OF CHARS PER FIELD - J2 = 7 !START OF FIELDS - J3 = J2+10*J1 + 2 !START AFTER FIELDS - TXT80 = C_VER//' HA' !COLUMN DESCRIPTION - DO I1=0,9 - COL = J2+I1*J1+4 - CALL WNCTXS (TXT80(COL:),'+!1$UJ',I1) - END DO - TXT80(J3:) = 'deg' - TXT80(NCPL:) = C_VER - CALL WNCTXT (F_TP,TXT80) -C - DO I=IHAMIN,IHAMAX,10 !10 DEGR PER LINE - PRINTLINE = .FALSE. - CALL WNCTXS (TXT80,C_VER//' !3$SJ:',I) - DO I1=0,9 - IHA = I+I1 - IF (IHA.GT.IHAMAX) GOTO 601 !ESCAPE -C - COL = J2+I1*J1 - NND = 0 - NFD = 0 - DO I3=0,3 - IF (SELPOL(I3)) THEN !SELECTED POL - NND = NND + NNPHD(I3,IHA) !TOTAL TESTED PER POL - NFD = NFD + NFPHD(I3,IHA) !TOTAL FLAGGED PER POL - END IF - END DO - R0 = (100.*NFD)/MAX(1,NND) !% OF DATA FLAGGED - IF (NND.EQ.0) THEN !NOT TESTED - CALL WNCTXS (TXT80(COL:),'!#$AS;',J1-3,C_NOTEST) - ELSE IF (R0.GT.0) THEN !SOME FLAGS SET - PRINTLINE = .TRUE. - IF (R0.LT.100) THEN !<100% FLAGGED - CALL WNCTXS (TXT80(COL:),'!#$UJ;',J1-3,NINT(R0)) - ELSE !100% FLAGGED - CALL WNCTXS (TXT80(COL:),'!#$AS',J1-3,C_ALLSET) - END IF - ELSE !NO FLAGS SET - PRINTLINE = .TRUE. - CALL WNCTXS (TXT80(COL:),'!#$AS;',J1-3,C_NOFLAG) - END IF -C - COL = COL+J1-3+1 - R0 = (100.*NFPHH(IHA))/MAX(1,NNPHH(IHA)) !% OF HEADERS FLAGGED - IF (NNPHH(IHA).EQ.0) THEN !NOT TESTED - CALL WNCTXS (TXT80(COL:),'!2$AS',C_NOTEST) - ELSE IF (R0.GT.0) THEN !SOME FLAGS SET - PRINTLINE = .TRUE. - IF (R0.LT.100) THEN !<100% FLAGGED - CALL WNCTXS (TXT80(COL:),'!2$UJ',NINT(R0)) - ELSE !100% FLAGGED - CALL WNCTXS (TXT80(COL:),'!2$AS',C_ALLSET) - END IF - ELSE !NO FLAGS SET - PRINTLINE = .TRUE. - CALL WNCTXS (TXT80(COL:),'!2$AS',C_NOFLAG) - END IF -C - END DO - 601 CONTINUE - TXT80(J3:) = ' ' !CLOSING TEXT PER LINE - TXT80(NCPL:) = C_VER - IF (PRINTLINE) CALL WNCTXT (F_TP,'!AS',TXT80) - END DO -C - CALL WNCTXT (F_TP,'!AS!/',SEPAR) !SEPARATOR -C -C============================================================================== -C SHOW flags per ifr (and per polarisation): -C The information is displayed in two `squares' side by side. -C The 1st (left) square contains XX in the upper right triangle (URT), -C and YY in the lower left triangle (LLT). -C The second (right) square has XY in URT, and YX in LLT. -C - ELSE IF (NAME(:3).EQ.'IFR') THEN -C - CALL WNCTXT (F_TP,'!/!AS',SEPAR) !SEPARATOR -C - TXT80 = C_VER//' Percentage of flagged uv-pnts, per ifr.' - TXT80(NCPL:) = C_VER - CALL WNCTXT (F_TP,'!AS',TXT80) -C - CALL WNCTXT (F_TP,'!AS',TXT_LEGEND) - IF (TXT_SCANS.NE.' ') CALL WNCTXT (F_TP,TXT_SCANS) - IF (TXT_DATA.NE.' ') CALL WNCTXT (F_TP,TXT_DATA) - IF (TXT_FLAGS.NE.' ') CALL WNCTXT (F_TP,TXT_FLAGS) - IF (TXT_CALC.NE.' ') CALL WNCTXT (F_TP,TXT_CALC) - CALL WNCTXT (F_TP,'!AS',SEPAR) !SEPARATOR -C - DO I=-3,STHTEL+3 !ALL LINES - TEXT(I)= ' ' !OPENING HASH - END DO -C - J1 = 2 !NR OF CHARS PER FIELD - J2 = 6 !RT0 COL OF FIRST SQUARE - J3 = J2+40 !RT0 COL OF SECOND SQUARE - TEXT(-3) = SEPAR - TEXT(-2)(J2+20:) = 'XX' !EXPL. FOR URT OF 1ST SQUARE - TEXT(-2)(J3+20:) = 'XY' !EXPL. FOR URT OF 2ND SQUARE -C - DO RTE=0,STHTEL-1 !ROWS OF TEL NAMES - I = RTE*J1 + J1-1 - TEXT(-1)(J2+I:J2+I) = TELNAME(RTE) !TOP ROW - TEXT(-1)(J3+I:J3+I) = TELNAME(RTE) - TEXT(STHTEL)(J2+I:J2+I) = TELNAME(RTE) !BOTTOM - TEXT(STHTEL)(J3+I:J3+I) = TELNAME(RTE) - END DO -C - DO RTW=0,STHTEL-1 !COLUMNS OF TEL NAMES - I = -2 !TO THE LEFT OF SQUARE - TEXT(RTW)(J2+I:J2+I) = TELNAME(RTW) - TEXT(RTW)(J3+I:J3+I) = TELNAME(RTW) - I = J1*STHTEL + 2 !TO THE RIGHT OF SQUARE - TEXT(RTW)(J2+I:J2+I) = TELNAME(RTW) - TEXT(RTW)(J3+I:J3+I) = TELNAME(RTW) - END DO -C - TEXT(STHTEL+1)(J2+3:) = 'YY' !EXPL. FOR LLT OF 1ST SQUARE - TEXT(STHTEL+1)(J3+3:) = 'YX' !EXPL. FOR LLT OF 2ND SQUARE - TEXT(STHTEL+2) = SEPAR !CLOSING SEPARATOR - TEXT(STHTEL+3) = ' ' !BLANK LINE -C - DO RTW = 0,STHTEL-1 !WEST TEL - DO RTE = RTW,STHTEL-1 !EAST TEL - DO I3=0,3 !ALL POLS - IF (I3.EQ.XX .OR. I3.EQ.XY) THEN !URT's - LIN = RTW - COL = J2+J1*RTE !XX - IF (I3.EQ.XY) COL = J3+J1*RTE !XY - ELSE !LLT's - LIN = RTE - COL = J2+J1*RTW !YY - IF (I3.EQ.YX) COL = J3+J1*RTW !YX - END IF - NFD = NPI(I3,RTW,RTE) !# OF FLAGS - NND = NPI(I3,RTE,RTW) !# OF DATA TESTED - R0 = (100.*NFD)/MAX(1,NND) !PERCENTAGE - IF (RTW.EQ.RTE) THEN !AUTOCORR (?) - CALL WNCTXS(TEXT(LIN)(COL:COL+J1-1), - 1 '!#$AS',J1,' ') !BACKSLASH ->SPACE - ELSE IF (R0.GT.0) THEN !NON-ZERO FLAGS - IF (NINT(R0).LT.100) THEN !<100% - CALL WNCTXS(TEXT(LIN)(COL:COL+J1-1), - 1 '!#$UJ',J1,NINT(R0)) !GIVE PERCENTAGE - ELSE - CALL WNCTXS(TEXT(LIN)(COL:COL+J1-1), - 1 '!#$AS',J1,C_ALLSET) !100% FLAGS SET - END IF - ELSE IF (NND.EQ.0) THEN !UV-PNT NOT TESTED - CALL WNCTXS(TEXT(LIN)(COL:COL+J1-1), - 1 '!#$AS',J1,C_NOTEST) - ELSE !# OF FLAGS IS ZERO - CALL WNCTXS(TEXT(LIN)(COL:COL+J1-1), - 1 '!#$AS',J1,C_NOFLAG) - END IF - END DO !POLS(I3) - END DO !RTE - END DO !RTW -C - DO I=-3,STHTEL+2 !ALL LINES - TEXT(I)(1:1) = C_VER !OPENING HASH - TEXT(I)(NCPL:) = C_VER !CLOSING HASH - CALL WNCTXT(F_TP,'!AS',TEXT(I)) !PRINT/TYPE LINE - END DO - CALL WNCTXT (F_TP,' ') -C -C***************************************************************************** -C - ELSE - ARGSTR='NFLCNT Action '//ACTION(:3)// - 1 ': Name not recognised: '//NAME - CALL WNCTXT (F_TP,ARGSTR) - END IF - ENDIF ! counts available -C****************************************************************************** -C - ELSE - CALL WNCTXT (F_TP,'NFLCNT Action '//ACTION(:3)// - 1 ': not recognised') - END IF ! actions -C -C****************************************************************************** - RETURN - END diff --git a/src/nscan/nflcub.for b/src/nscan/nflcub.for deleted file mode 100644 index 4bf67bfa20d375652af8f6357b7fb1d2f1b60b4d..0000000000000000000000000000000000000000 --- a/src/nscan/nflcub.for +++ /dev/null @@ -1,436 +0,0 @@ -C+ NFLCUB.FOR -C JEN 931116 -C -C Revisions: -C CMV 931220 Pass FCA of input file to WNDXLP and WNDSTA/Q -C CMV 940926 Close old file before asking new one -C -CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC -C - LOGICAL FUNCTION NFLCUB (ACTION,NAME,IVAL, - 1 SELHA,SELPOL,SELIFR) -C -C Deal with uv-data `hyper-cube' and its sub-cube. -C Also: hide the rather strange polarisation selection scheme. -C -C Result: -C -C JS = NFLCUB (ACTION_C(*):I,NAME_C(*):I,IVAL_J:I, -C SELHA_R(0:1):O,SELPOL_B(0:3):O, -C SELIFR_B(0:STHTEL-1,0:STHTEL-1):O) -C -C JS = NFLCUB ('SPECIFY','NODE',0,0,0,0) -C Specify input SCN-file (NODIN and FCAIN stored in Common) -C JS = NFLCUB ('SPECIFY','SETS',0,0,0,0) (alternative: 'SECTORS') -C Specify Sets of Sectors (SETS stored in Common) -C -C JS = NFLCUB ('SPECIFY','HYPERCUBE',0,0,0,0) -C Specify the hypercube (HA,POL,IFR) -C NB: This definition is kept internally. Use SELECT HYP to get it. -C JS = NFLCUB ('SELECT','HYPERCUBE',0,SELHA,SELPOL,SELIFR) -C Reset the selection (SEL) to the current hypercube. -C -C JS = NFLCUB ('SPECIFY','SUBCUBE',0,SELHA,SELPOL,SELIFR) -C Specify a `sub-cube', within the current hypercube. -C JS = NFLCUB ('SPECIFY','SUB_POL',0,SELHA,SELPOL,SELIFR) -C JS = NFLCUB ('SPECIFY','SUB_HA',0,SELHA,SELPOL,SELIFR) -C JS = NFLCUB ('SPECIFY','SUB_IFR',ICODE,SELHA,SELPOL,SELIFR) -C ICODE = 0: Use input SELIFR as default, and type SELIFR on screen. -C ICODE = 1: Pre-select all ifrs, and do not type SELIFR on screen. -C ICODE = 4: Pre-select no ifrs, and do not type SELIFR on screen. -C JS = NFLCUB ('SELECT','SUBCUBE',0,SELHA,SELPOL,SELIFR) -C Reset the selection (SEL) to the sub-cube that was specified last. -C -C JS = NFLCUB ('ADJUST','SELPOL',NPOLS,SELHA,SELPOL,SELIFR) -C Adjust SELPOL as a function of the nr of pols (NPOLS) in a Sector. -C NB: The input value is NPOLS = STHI(STH_PLN_I) from the Sector header. -C NB: This (regretfully) has to be done after reading each Sector header. -C NB: The default SELPOL in the other calls is for NPOLS=4 -C -C PIN references: -C -C SUB_CUBE !Ask whether sub-cube to be specified -C -C Include files: -C - INCLUDE 'WNG_DEF' - INCLUDE 'NFL_DEF' - INCLUDE 'CBITS_DEF' - INCLUDE 'STH_O_DEF' - INCLUDE 'SCH_O_DEF' -C -C Parameters: -C - INTEGER XX,XY,YX,YY - PARAMETER (XX=0, XY=1, YX=2, YY=3) -C -C Arguments: -C - CHARACTER ACTION*(*) !ACTION TO BE PERFORMED - CHARACTER NAME*(*) !EXTRA INFORMATION (if any) - INTEGER*2 IVAL !INTEGER INPUT VALUE (if any) -C - REAL SELHA(0:1) !SELECTED HA-RANGE (circles) - LOGICAL SELPOL(0:3) !SELECTED POL-RANGE - BYTE SELIFR(0:STHTEL-1,0:STHTEL-1) !SELECTED IFRS (RTW,RTE) -C -C Function references: -C - LOGICAL WNDPAR !GET DWARF PARAMETER - LOGICAL WNDNOD !GET NODE - LOGICAL WNFOP !OPEN FILE - LOGICAL WNFRD !READ DATA - LOGICAL WNFWR !WRITE DATA - CHARACTER*32 WNTTSG !SET NAME - LOGICAL WNDSTQ !GET SETS - INTEGER WNCAJ !GET INTEGER FROM TEXT - LOGICAL NSCSTG !GET A SET - LOGICAL NSCIFS !GET INTERFEROMETER SELECTION - LOGICAL NSCPLS !SELECT POLARISATION - LOGICAL NSCHAS !SELECT HA - CHARACTER*80 ARGSTR -C -C Data declarations: -C -C Look-up table to find existence and offset for polarisations -C depending on the number of polarisations present in the data -C - INTEGER PPOL(XX:YY,1:4,0:1) !POL. SELECT XX,XY,YX,YY FOR - ! NPOLS=1:4: - DATA PPOL/XX_P,0,0,0, XX_P,0,0,YY_P, 0,0,0,0, - 1 XX_P,XY_P,YX_P,YY_P, !BITS - 1 0,0,0,0, 0,0,0,1, 0,0,0,0, 0,1,2,3/ !OFFSETS -C -C OLD: DATA PPOL/1,0,0,0, 1,0,0,8, 0,0,0,0, 1,2,4,8, !BITS -C - CHARACTER*2 POLNAM(0:3) - DATA POLNAM /'XX','XY','YX','YY'/ -C -C Selection of hypercube (NODIN and SETS are in common block) -C - INTEGER HYPPOL !POL. CODE (BITS) - BYTE HYPIFR(0:STHTEL-1,0:STHTEL-1) !IFR SELECTION - REAL HYPHA(0:1) !HA RANGE -C -C Saved sub0cube selection: -C - INTEGER SPOL !POL. CODE (BITS) - BYTE SIFR(0:STHTEL-1,0:STHTEL-1) !IFR SELECTION - REAL SHA(0:1) !HA RANGE -C - LOGICAL ALLIF !TRUE: All ifrs selected - INTEGER NPOLS !NR OF POLS IN SSN-FILE - LOGICAL SPECIFR !TRUE: Specify ifrs - LOGICAL SPECPOL !TRUE: Specify pols - LOGICAL SPECHAR !TRUE: Specify ha-range - CHARACTER*24 SUBCUB !Option of keyword SUB_CUBE - LOGICAL PRINTSUB !Print summary of sub-cube -C - CHARACTER*80 TXT80 !TEXT BUFFER - INTEGER LPOFF(0:7) !CURRENT OFFSETS (SECTOR LOOPS) -C -C Commons: -C - COMMON /NFLCUBE/ ALLIF, - 1 HYPPOL,HYPHA,HYPIFR, - 1 SPOL,SHA,SIFR -C- -C****************************************************************************** -C****************************************************************************** -C - NFLCUB = .TRUE. !ASSUME OK - PRINTSUB = .FALSE. -CCCC CALL WNCTXT (F_T,'NFLCUB: '//ACTION(:5)//NAME) -C -C*************************************************************************** -C - IF (ACTION(:4).EQ.'SPEC') THEN -C -C---------------------------------------------------------------------------- -C SPECIFY SCN-NODE: -C - IF (NAME(:3).EQ.'NOD') THEN - CALL WNDXLI(LPOFF) ! Clear offsets (loops) - SETS(0,0)=0 !DEFAULT SETS (NONE) - HYPPOL=XYX_M !ASSUME ALL POLS - ALLIF=.TRUE. !ASSUME ALL IFRS - HYPHA(0)=-179.99/360. !ASSUME FULL HA RANGE - HYPHA(1)=+179.99/360. ! (CIRCLES) -C - 11 CONTINUE - CALL WNFCL(FCAIN) !CLOSE FIRST - IF (.NOT.WNDNOD('INPUT_SCN_NODE',NODIN,'SCN','U', - 1 NODIN,IFILE)) THEN !NODE - IF (E_C.EQ.DWC_ENDOFLOOP) THEN !READY - NFLCUB = .FALSE. !NOT SUCCESSFUL - GOTO 800 !EXIT - END IF - CALL WNCTXT(F_TP,'Node does not exist') - GOTO 11 !TRY AGAIN - ELSE IF (E_C.EQ.DWC_NULLVALUE) THEN - NFLCUB = .FALSE. !NOT SUCCESSFUL - GOTO 800 !EXIT - ELSE IF (E_C.EQ.DWC_WILDCARD) THEN - GOTO 11 !MUST SPECIFY - END IF -C - IF (.NOT.WNFOP(FCAIN,IFILE,'U')) THEN !OPEN SCAN FILE - CALL WNCTXT(F_TP,'Cannot open file attached to scan node') - GOTO 11 - END IF -C -C---------------------------------------------------------------------------- -C SPECIFY SETS OF SECTORS: -C - ELSE IF (NAME(:3).EQ.'SET') THEN -C - 14 CONTINUE - IF (.NOT.WNDSTQ('SCN_SETS',MXNSET,SETS,FCAIN)) THEN - CALL WNFCL(FCAIN) - NFLCUB = .FALSE. !NOT SUCCESSFUL - GOTO 800 !EXIT - END IF -C - IF (SETS(0,0).EQ.0) THEN !NONE SPECIFIED - CALL WNFCL(FCAIN) - NFLCUB = .FALSE. !NOT SUCCESSFUL - GOTO 800 !EXIT - END IF -C -C---------------------------------------------------------------------------- -C SPECIFY HYPERCUBE (use existing selection as default): -C - ELSE IF (NAME(:3).EQ.'HYP') THEN -C - 12 CONTINUE - IF (.NOT.NSCPLS(0,HYPPOL)) THEN !SELECT POL. - CALL WNFCL(FCAIN) - NFLCUB = .FALSE. !NOT SUCCESSFUL - GOTO 800 !EXIT - END IF -C - 15 CONTINUE - IF (ALLIF) THEN - IF (.NOT.NSCIFS(1,HYPIFR)) THEN !PRE-SELECT ALL IFRS - NFLCUB = .FALSE. !NOT SUCCESSFUL - GOTO 800 !EXIT - END IF - ELSE - IF (.NOT.NSCIFS(0,HYPIFR)) THEN !USE IFRS AS GIVEN, AND SHOW - NFLCUB = .FALSE. !NOT SUCCESSFUL - GOTO 800 !EXIT - END IF - END IF - ALLIF=.TRUE. - DO I=0,STHTEL-1 - DO I1=I,STHTEL-1 - IF (.NOT.HYPIFR(I1,I)) ALLIF=.FALSE. !NOT ALL IFRS SELECTED - END DO - END DO -C - 13 CONTINUE - IF (.NOT.NSCHAS(0,HYPHA)) THEN !SELECT HA RANGE - NFLCUB = .FALSE. !NOT SUCCESSFUL - GOTO 800 !EXIT - END IF -C -C---------------------------------------------------------------------------- -C SPECIFY SUB-CUBE (i.e. a new subset of the current hyper-cube): -C NB: Use the input selection as default, except if IVAL<>0. -C - ELSE IF (NAME(:3).EQ.'SUB') THEN - PRINTSUB = .FALSE. !PRINT SUMMARY OF SUB-CUBE - SPECIFR = .FALSE. - SPECPOL = .FALSE. - SPECHAR = .FALSE. - IF (INDEX(NAME,'IFR').GT.0) THEN - SPECIFR = .TRUE. - ELSE IF (INDEX(NAME,'POL').GT.0) THEN - SPECPOL = .TRUE. - ELSE IF (INDEX(NAME,'HA').GT.0) THEN - SPECHAR = .TRUE. - ELSE - 100 CONTINUE - IF (.NOT.WNDPAR('SUB_CUBE',SUBCUB, - 1 LEN(SUBCUB),J0,'NO')) THEN - IF (E_C.EQ.DWC_ENDOFLOOP) GOTO 800 !READY - GOTO 100 !ERROR - END IF - IF (J0.EQ.0) GOTO 100 !EMPTY STRING, TRY AGAIN - IF (J0.LT.0) GOTO 100 !WILDCARD (?) - IF (SUBCUB(:3).EQ.'YES') THEN - SPECPOL = .TRUE. - SPECIFR = .TRUE. - SPECHAR = .TRUE. - END IF - IF (SUBCUB(:3).EQ.'POL') SPECPOL = .TRUE. - IF (SUBCUB(:3).EQ.'IFR') SPECIFR = .TRUE. - IF (SUBCUB(:2).EQ.'HA') SPECHAR = .TRUE. - END IF -C - IF (SPECPOL) THEN - 110 CONTINUE - IF (.NOT.NSCPLS(0,SPOL)) THEN !POLS - GOTO 110 - END IF - SPOL = IAND(SPOL,HYPPOL) !KEEP INSIDE HYPERCUBE - DO I3=0,3 - SELPOL(I3) = (IAND(PPOL(I3,NPOLS,0),SPOL).NE.0) - END DO - END IF -C - IF (SPECIFR) THEN - 120 CONTINUE - I = IVAL !INPUT PARAMETER - IF (.NOT.NSCIFS(I,SIFR)) THEN !IFRS - GOTO 120 - END IF - DO I=0,STHTEL-1 !KEEP INSIDE HYPERCUBE - DO I1=0,STHTEL-1 - SIFR(I,I1) = (SIFR(I,I1).AND.HYPIFR(I,I1)) - SELIFR(I,I1) = SIFR(I,I1) !OUTPUT - END DO - END DO - END IF -C - IF (SPECHAR) THEN - 130 CONTINUE - IF (.NOT.NSCHAS(0,SHA)) THEN !HA-RANGE - GOTO 130 - END IF - SHA(0) = MAX(SHA(0),HYPHA(0)) !KEEP INSIDE HYPERCUBE - SHA(1) = MIN(SHA(1),HYPHA(1)) - SELHA(0) = SHA(0) !OUTPUT - SELHA(1) = SHA(1) !OUTPUT - END IF -C -C---------------------------------------------------------------------------- -C NAME NOT RECOGNISED: -C - ELSE - ARGSTR='NFLCUB '//ACTION(:3)//' Name not recognised: '//NAME - CALL WNCTXT (F_TP,ARGSTR) - NFLCUB = .FALSE. !NOT SUCCESSFUL - END IF -C -C*************************************************************************** -C SELECT HYPERCUBE (i.e. set SELxxx to the hypercube selection): -C - ELSE IF (ACTION(:3).EQ.'SEL') THEN - PRINTSUB = .FALSE. !PRINT SUMMARY OF SUB-CUBE -C -C-------------------------------------------------------------------------- -C SELECT HYPERCUBE (i.e. set SELxxx to the hypercube selection): -C - IF (NAME(:3).EQ.'HYP') THEN - SELHA(0)=HYPHA(0) !SELECTED HA-RANGE EQUAL TO HYPERCUBE - SELHA(1)=HYPHA(1) - SHA(0) = SELHA(0) !KEEP FOR LATER - SHA(1) = SELHA(1) !KEEP FOR LATER -C - NPOLS = 4 !DEFAULT: 4 POLS IN SCN-FILE - DO I3=0,3 - SELPOL(I3) = (IAND(PPOL(I3,NPOLS,0),HYPPOL).NE.0) - END DO - SPOL = HYPPOL !KEEP FOR LATER -C - DO I=0,STHTEL-1 - DO I1=0,STHTEL-1 - SELIFR(I,I1) = HYPIFR(I,I1) !IDEM IFR-SELECTION - SIFR(I,I1) = SELIFR(I,I1) !KEEP FOR LATER - END DO - END DO -C -C-------------------------------------------------------------------------- -C SELECT SUB-CUBE (i.e. set SELxxx to the last sub-cube specs): -C NB: This is useful to get beck to a known selection. -C - ELSE IF (NAME(:3).EQ.'SUB') THEN - SELHA(0)=SHA(0) !SELECTED HA-RANGE EQUAL TO HYPERCUBE - SELHA(1)=SHA(1) -C - NPOLS = 4 !DEFAULT: 4 POLS IN SCN-FILE - DO I3=0,3 - SELPOL(I3) = (IAND(PPOL(I3,NPOLS,0),SPOL).NE.0) - END DO - DO I=0,STHTEL-1 - DO I1=0,STHTEL-1 - SELIFR(I,I1) = SIFR(I,I1) !IDEM IFR-SELECTION - END DO - END DO -C -C---------------------------------------------------------------------------- -C NAME NOT RECOGNISED: -C - ELSE - ARGSTR='NFLCUB '//ACTION(:3)//' Name not recognised: '//NAME - CALL WNCTXT (F_TP,ARGSTR) - NFLCUB = .FALSE. !NOT SUCCESSFUL - END IF -C -C*************************************************************************** -C ADJUST SELPOL (as a function of NPOLS from the Sector header): -C - ELSE IF (ACTION(:3).EQ.'ADJ') THEN - PRINTSUB = .FALSE. !PRINT SUMMARY OF SUB-CUBE - NPOLS = IVAL !INPUT VALUE - IF (NPOLS.LT.0.OR.NPOLS.GT.4) THEN - CALL WNCTXT (F_TP,'NFLCUB ADJUST SELPOL: ' - 1 //' NPOLS out of range, =!SJ',NPOLS) - NFLCUB = .FALSE. - GOTO 800 - ELSE - DO I3=0,3 !DECODE POL SELECTION BITS OF SPOL - SELPOL(I3) = (IAND(PPOL(I3,NPOLS,0),SPOL).NE.0) - END DO - END IF -C -C*************************************************************************** -C ACTION NOT RECOGNISED: -C - ELSE - CALL WNCTXT (F_TP,'NFLCUB: Action '//ACTION(:8) - 1 //' not recognised (name='//NAME(:5)//')') - NFLCUB = .FALSE. !NOT SUCCESSFUL - END IF -C -C**************************************************************************** -C Finished: -C - 800 CONTINUE -C -C Print summary of sub-cube, if required: -C - IF (PRINTSUB) THEN - I4 = 1 - TXT80(I4:) = 'NFLCUB sub-cube:' - I4 = I4+16 - CALL WNCTXS (TXT80(I4:),' SELHA=!EAF6.1<>!EAF6.1' - 1 ,SELHA(0),SELHA(1)) - I4 = I4+20 - TXT80(I4:) = ' SELPOL:' - DO I3 = 0,3 - IF (SELPOL(I3)) THEN - TXT80(3*I3+I4+8:) = POLNAM(I3) - ELSE - TXT80(3*I3+I4+8:) = '-' - END IF - END DO - I4 = I4+20 - I2 = 0 - I3 = 0 - DO I=0,STHTEL-1 - DO I1=I,STHTEL-1 - IF (I.EQ.I1) THEN !AUTOCORR - IF (SELIFR(I1,I)) I3=I3+1 - ELSE !CROSSCORR - IF (SELIFR(I1,I)) I2=I2+1 - END IF - END DO - END DO - CALL WNCTXS (TXT80(I4:),' SELIFR:!SJ(!SJ) ifrs',I2,I3) - CALL WNCTXT (F_T,TXT80) - END IF -C - RETURN - END diff --git a/src/nscan/nfldat.for b/src/nscan/nfldat.for deleted file mode 100644 index 38a0351a58de20bcc1329aabe1a8406bca6b5518..0000000000000000000000000000000000000000 --- a/src/nscan/nfldat.for +++ /dev/null @@ -1,52 +0,0 @@ -C+ NFLDAT.FOR -C WNB 930618 -C -C Revisions: -C - SUBROUTINE NFLDAT -C -C Get NFLAG program parameters -C -C Result: -C -C CALL NFLDAT will ask and set all program parameters -C -C PIN references: -C -C OPTION -C -C Include files: -C - INCLUDE 'WNG_DEF' - INCLUDE 'NFL_DEF' -C -C Parameters: -C -C -C Arguments: -C -C -C Function references: -C - LOGICAL WNDPAR !GET DWARF PARAMETER -C -C Data declarations: -C -C- -C -C SET DEFAULTS -C -C -C GET OPTION -C - 100 CONTINUE - IF (.NOT.WNDPAR('OPTION',OPTION,LEN(OPTION),J0,'QUIT')) THEN - OPTION='QUIT' !ASSUME END - ELSE IF (J0.LE.0) THEN - OPTION='QUIT' !ASSUME END - END IF -C - RETURN !READY -C -C - END diff --git a/src/nscan/nflfl0.for b/src/nscan/nflfl0.for deleted file mode 100644 index 2fff8360f7fa5809b8518497a80cda62dc66176b..0000000000000000000000000000000000000000 --- a/src/nscan/nflfl0.for +++ /dev/null @@ -1,295 +0,0 @@ -C+ NFLFL0.FOR -C WNB 930610 -C -C Revisions: -C WNB 930615 Use FLF_O -C WNB 930615 Add DF5,6,7,8,3; DFS -C WNB 930616 Use FLH_O -C WNB 930617 Make sure 2nd entry in DF2; create DF7 -C WNB 930617 Split off NSCDF5.FOR -C HJV 930618 Symbolic names for mask bits in CBITS_O_DEF -C WNB 930618 Renamed from NSCDF0 -C WNB 930714 Correct ranges initialisation; add FLR -C CMV 930803 Move scaling of DFAR -C WNB 930807 Change to CBITS_DEF -C - LOGICAL FUNCTION NFLFL0(DFAR) -C -C Make and handle flagging files -C -C Result: -C -C NFLFL0_L = NFLFL0( DFAR_J:IO) -C will create area DFAR (if not 0) and a -C temporary file. -C NFLFL9_L = NFLFL9( DFAR_J:IO) -C will remove area and file -C NFLFL1_L = NFLFL1( DFAR_J:I, FLF1_B(0:*):I) -C add entry to list -C NFLFL2_L = NFLFL2( DFAR_J:I, FLF1_B(0:*):O, FLF2_B(0:*):O) -C get (area) entry from list -C NFLFLR_L = NFLFLR( DFAR_J:IO) -C reset get area for FL2 -C NFLFLS_L = NFLFLS( DFAR_J:I, CFLH_B(0:*):O) -C Return status: Current header -C -C Include files: -C - INCLUDE 'WNG_DEF' - INCLUDE 'CBITS_DEF' - INCLUDE 'GFH_O_DEF' - INCLUDE 'FLH_O_DEF' !FLF HEADER - INCLUDE 'FLF_O_DEF' !FLF ENTRY -C -C Entry points: -C - LOGICAL NFLFL9,NFLFL1,NFLFL2 - LOGICAL NFLFLS,NFLFLR -C -C Parameters: -C - INTEGER MXENT !ENTRIES IN CORE - PARAMETER (MXENT=8192) - INTEGER MXRANG !MAX. RANGE VALUE - PARAMETER (MXRANG=65536*16) -C -C Arguments: -C - INTEGER DFAR !AREA FOR FLAGS - BYTE FLF1(0:*) !ENTRY - BYTE FLF2(0:*) !ENTRY - BYTE CFLH(0:*) !FILE HEADER -C -C Function references: -C - LOGICAL WNGGVM !GET VIRTUAL MEMORY - LOGICAL WNFOP !OPEN FILE - LOGICAL WNFRD,WNFWR !READ/WRITE FILE - CHARACTER*20 WNFFNM !FILE NAME -C -C Data declarations: -C -C -C Common: -C - INTEGER BCNT !FILE COUNT - INTEGER GCNT !GET COUNT - INTEGER FCA !FILE AREA - BYTE FLH(0:FLHHDL-1) !CURRENT FILE HEADER - INTEGER FLHJ(0:FLHHDL/LB_J-1) - REAL FLHE(0:FLHHDL/LB_E-1) - EQUIVALENCE (FLH,FLHJ,FLHE) - COMMON /FLF_COM/ FLH,BCNT,GCNT,FCA -C- -C -C FL0 -C - NFLFL0=.TRUE. !ASSUME OK - IF (DFAR.EQ.0) THEN !NONE YET - IF (.NOT.WNGGVM(MXENT*FLFHDL,DFAR)) THEN !GET AREA - DFAR=0 - GOTO 900 - END IF - DFAR=(DFAR-A_OB)/LB_J !ARRAY POINTER - FCA=0 - IF (.NOT.WNFOP(FCA,WNFFNM('FLF','TMP'),'WT')) THEN !OPEN TMP FILE - GOTO 900 - END IF - BCNT=0 !BLOCK COUNT - GCNT=0 !GET COUNT - CALL WNGMVZ(FLHHDL,FLH) !INIT HEADER - FLHJ(FLH_VER_J)=FLFHDV !VERSION - FLHJ(FLH_FLFL_J)=FLFHDL !ENTRY LENGTH - FLHJ(FLH_FLFP_J)=GFHHDL+FLHHDL !ENTRY POINTER - DO I=0,1 !RANGES - FLHJ(FLH_RCHAN_J+I)=MXRANG-2*I*MXRANG - FLHJ(FLH_RIFR_J+I)=MXRANG-2*I*MXRANG - FLHJ(FLH_RPOL_J+I)=MXRANG-2*I*MXRANG - FLHE(FLH_RHA_E+I)=MXRANG-2*I*MXRANG - END DO - END IF -C - RETURN -C -C FL9 -C - ENTRY NFLFL9(DFAR) -C - NFLFL9=.TRUE. !ASSUME OK - GOTO 901 !READY -C -C FL1 -C - ENTRY NFLFL1(DFAR,FLF1) -C - IF (DFAR.EQ.0) GOTO 901 !CANNOT DO - NFLFL1=.TRUE. !ASSUME OK - IF (GCNT.NE.0) THEN !RESET BUFFERS - IF (BCNT.GT.0) THEN - IF (.NOT.WNFRD(FCA,MOD(FLHJ(FLH_FLFN_J),MXENT)*FLFHDL,A_J(DFAR), - 1 (BCNT/MXENT)*MXENT*FLFHDL)) GOTO 900 - END IF - GCNT=0 !GET FROM START - END IF - I=DFAR+MOD(FLHJ(FLH_FLFN_J),MXENT)*FLFHDL/LB_J - CALL WNGMV(FLFHDL,FLF1,A_J(I)) !GET ENTRY - FLHJ(FLH_FLAG_J)=IOR(FLHJ(FLH_FLAG_J),A_J(I+FLF_FLAG_J)) !TOTAL FLAG - IF (A_J(I+FLF_CHAN_J).EQ.-1) THEN !GET RANGE IN LIST - FLHJ(FLH_CHAN_J)=-1 - ELSE IF (FLHJ(FLH_CHAN_J).NE.-1) THEN - FLHJ(FLH_RCHAN_J+0)=MIN(A_J(I+FLF_CHAN_J),FLHJ(FLH_RCHAN_J+0)) - FLHJ(FLH_RCHAN_J+1)=MAX(A_J(I+FLF_CHAN_J),FLHJ(FLH_RCHAN_J+1)) - END IF - IF (A_J(I+FLF_HA_E).EQ.-1) THEN - FLHJ(FLH_HA_J)=-1 - ELSE IF (FLHJ(FLH_HA_J).NE.-1) THEN - FLHE(FLH_RHA_E+0)=MIN(A_E(I+FLF_HA_E),FLHE(FLH_RHA_E+0)) - FLHE(FLH_RHA_E+1)=MAX(A_E(I+FLF_HA_E),FLHE(FLH_RHA_E+1)) - END IF - I=I*(LB_J/LB_I) - I1=A_I(I+FLF_IFR_I) - IF (I1.EQ.-1) THEN - FLHJ(FLH_IFR_J)=-1 - ELSE IF (FLHJ(FLH_IFR_J).NE.-1) THEN - FLHJ(FLH_RIFR_J+0)=MIN(I1,FLHJ(FLH_RIFR_J+0)) - FLHJ(FLH_RIFR_J+1)=MAX(I1,FLHJ(FLH_RIFR_J+1)) - END IF - I1=A_I(I+FLF_POL_I) - IF (I1.EQ.-1) THEN - FLHJ(FLH_POL_J)=-1 - ELSE IF (FLHJ(FLH_POL_J).NE.-1) THEN - FLHJ(FLH_RPOL_J+0)=MIN(I1,FLHJ(FLH_RPOL_J+0)) - FLHJ(FLH_RPOL_J+1)=MAX(I1,FLHJ(FLH_RPOL_J+1)) - END IF - FLHJ(FLH_FLFN_J)=FLHJ(FLH_FLFN_J)+1 - IF (MOD(FLHJ(FLH_FLFN_J),MXENT).EQ.0) THEN - IF (.NOT.WNFWR(FCA,MXENT*FLFHDL,A_J(DFAR),BCNT*FLFHDL)) GOTO 900 - BCNT=BCNT+MXENT !COUNT FILE - END IF -C - RETURN -C -C FL2 -C - ENTRY NFLFL2(DFAR,FLF1,FLF2) -C - IF (DFAR.EQ.0) GOTO 901 !CANNOT DO - NFLFL2=.TRUE. !ASSUME OK - IF (GCNT.EQ.0 .AND. BCNT.GT.0) THEN !SAVE CURRENT BUFFER - IF (.NOT.WNFWR(FCA,MOD(FLHJ(FLH_FLFN_J),MXENT)*FLFHDL,A_J(DFAR), - 1 (BCNT/MXENT)*MXENT*FLFHDL)) GOTO 900 - IF (.NOT.WNFRD(FCA,MXENT*FLFHDL,A_J(DFAR),0)) GOTO 900 !1ST BUFFER - END IF - IF (GCNT.GE.FLHJ(FLH_FLFN_J)) THEN !NO MORE - GCNT=0 !RESTART - IF (BCNT.GT.0) THEN !REREAD LAST BUFFER - IF (.NOT.WNFRD(FCA,MOD(FLHJ(FLH_FLFN_J),MXENT)*FLFHDL,A_J(DFAR), - 1 (BCNT/MXENT)*MXENT*FLFHDL)) GOTO 900 - END IF - NFLFL2=.FALSE. - GOTO 902 - END IF - IF (MOD(GCNT,MXENT).EQ.0) THEN !READ NEXT BUFFER - IF (BCNT.GT.0) THEN - IF (.NOT.WNFRD(FCA,MIN(FLHJ(FLH_FLFN_J)-GCNT,MXENT)*FLFHDL, - 1 A_J(DFAR), - 1 (GCNT/MXENT)*MXENT*FLFHDL)) GOTO 900 - END IF - END IF - I=DFAR+MOD(GCNT,MXENT)*FLFHDL/LB_J - GCNT=GCNT+1 !NEXT - IF (IAND(A_J(I+FLF_FLAG_J),1).NE.0) THEN !GET SECOND ENTRY - IF (GCNT.GE.FLHJ(FLH_FLFN_J)) THEN !NO MORE - NFLFL2=.FALSE. !FORMAT ERROR - GOTO 902 - END IF - IF (MOD(GCNT,MXENT).EQ.0) THEN !READ NEXT BUFFER - IF (BCNT.GT.0) THEN - IF (.NOT.WNFRD(FCA,MIN(FLHJ(FLH_FLFN_J)-GCNT,MXENT)*FLFHDL, - 1 A_J(DFAR), - 1 (GCNT/MXENT)*MXENT*FLFHDL)) GOTO 900 - END IF - END IF - I1=DFAR+MOD(GCNT,MXENT)*FLFHDL/LB_J - GCNT=GCNT+1 !NEXT - IF (IAND(A_J(I1+FLF_FLAG_J),2).EQ.0) THEN - NFLFL2=.FALSE. !FORMAT ERROR - GOTO 902 - END IF - IF (A_J(I+FLF_CHAN_J).NE.-1 .AND. - 1 A_J(I+FLF_CHAN_J).GT.A_J(I1+FLF_CHAN_J)) THEN !MAX - I2=A_J(I+FLF_CHAN_J) - A_J(I+FLF_CHAN_J)=A_J(I1+FLF_CHAN_J) - A_J(I1+FLF_CHAN_J)=I2 - END IF - IF (A_J(I+FLF_HA_E).NE.-1 .AND. - 1 A_E(I+FLF_HA_E).GT.A_E(I1+FLF_HA_E)) THEN !MAX - R0=A_E(I+FLF_HA_E) - A_E(I+FLF_HA_E)=A_E(I1+FLF_HA_E) - A_E(I1+FLF_HA_E)=R0 - END IF - I=I*(LB_J/LB_I) - I1=I1*(LB_J/LB_I) - IF (A_I(I+FLF_IFR_I).NE.-1 .AND. - 1 A_I(I+FLF_IFR_I).GT.A_I(I1+FLF_IFR_I)) THEN !MAX - I2=A_I(I+FLF_IFR_I) - A_I(I+FLF_IFR_I)=A_I(I1+FLF_IFR_I) - A_I(I1+FLF_IFR_I)=I2 - END IF - IF (A_I(I+FLF_POL_I).NE.-1 .AND. - 1 A_I(I+FLF_POL_I).GT.A_I(I1+FLF_POL_I)) THEN !MAX - I2=A_I(I+FLF_POL_I) - A_I(I+FLF_POL_I)=A_I(I1+FLF_POL_I) - A_I(I1+FLF_POL_I)=I2 - END IF - CALL WNGMV(FLFHDL,A_I(I),FLF1) !GET ENTRY - CALL WNGMV(FLFHDL,A_I(I1),FLF2) !GET ENTRY - ELSE - CALL WNGMV(FLFHDL,A_J(I),FLF1) !GET ENTRY - CALL WNGMV(FLFHDL,A_J(I),FLF2) !COPY ENTRY - END IF -C - RETURN -C -C FLR -C - ENTRY NFLFLR(DFAR) -C - IF (DFAR.EQ.0) GOTO 901 !CANNOT DO - NFLFLR=.TRUE. !ASSUME OK - IF (GCNT.NE.0) THEN !RESET BUFFERS - IF (BCNT.GT.0) THEN - IF (.NOT.WNFRD(FCA,MOD(FLHJ(FLH_FLFN_J),MXENT)*FLFHDL,A_J(DFAR), - 1 (BCNT/MXENT)*MXENT*FLFHDL)) GOTO 900 - END IF - GCNT=0 !GET FROM START - END IF -C - RETURN -C -C FLS -C - ENTRY NFLFLS(DFAR,CFLH) -C - IF (DFAR.EQ.0) GOTO 901 !CANNOT DO - NFLFLS=.TRUE. !ASSUME OK - CALL WNGMV(FLHHDL,FLH,CFLH) !RETURN HEADER -C - RETURN -C -C ERRORS -C - 900 CONTINUE - NFLFL0=.FALSE. !RETURN ERROR - 901 CONTINUE - CALL WNCFCL(F_0) !MAKE SURE FILE CLOSED - CALL WNFCL(FCA) !CLOSE TMP FILE - IF (DFAR.NE.0) CALL WNGFVM(MXENT*FLFHDL, - 1 DFAR*LB_J+A_OB) !REMOVE AREA - DFAR=0 - 902 CONTINUE -C - RETURN -C -C - END diff --git a/src/nscan/nflfl5.for b/src/nscan/nflfl5.for deleted file mode 100644 index a1c74d48e179acd40a978b2f039443fb9528ee78..0000000000000000000000000000000000000000 --- a/src/nscan/nflfl5.for +++ /dev/null @@ -1,535 +0,0 @@ -C+ NFLFL5.FOR -C WNB 930617 -C -C Revisions: -C WNB 930618 Rename from NSCDF5 -C WNB 930620 More output text; add type; make FL8 -C HjV 930621 Remove declaration WNCASB -C WNB 930622 Add baseline type; more text -C WNB 930820 Change order WRITE IFR print -C JEN 931112 Extra argument (LUNOUT) for NFLFL7 (WRITE) -C JEN 931210 Make messages consistent (entries/length) -C CMV 940203 Write node-name and sets in ASCII file -C - LOGICAL FUNCTION NFLFL5(DFAR) -C -C Output/input of flagging files -C -C Result: -C -C NFLFL5_L = NFLFL5( DFAR_J:I) -C Unload list to FLF node -C NFLFL6_L = NFLFL6( DFAR_J:I) -C Load list from FLF node -C NFLFL7_L = NFLFL7( DFAR_J:I,LUNOUT_J:I,NODE_C*:I,SETS_J(0:*,0:*)) -C Write list to ASCII file or log/screen -C The node name and the decoded sets are -C written as comment. -C NFLFL8_L = NFLFL8( DFAR_J:I) -C Read list from ASCII file -C -C PIN references: -C -C INPUT_FLF_NODE -C OUTPUT_FLF_NODE -C OUTPUT_FILE -C INPUT_FILE -C -C Include files: -C - INCLUDE 'WNG_DEF' - INCLUDE 'GFH_O_DEF' - INCLUDE 'FLH_O_DEF' !FLF HEADER - INCLUDE 'FLF_O_DEF' !FLF ENTRY - INCLUDE 'STH_O_DEF' !TELESCOPE INFO - INCLUDE 'SSH_O_DEF' !SET INFO -C -C Entry points: -C - LOGICAL NFLFL6,NFLFL7,NFLFL8 -C -C Parameters: -C - INTEGER MXENT !ENTRIES IN CORE - PARAMETER (MXENT=8192) - INTEGER MXRANG !MAX. RANGE VALUE - PARAMETER (MXRANG=65536*16) -C -C Arguments: -C - INTEGER DFAR !AREA FOR FLAGS - INTEGER LUNOUT !OUTPUT UNIT NR (FOR NFLFL7) - CHARACTER*(*) NODE !INPUT NODE - INTEGER SETS(0:SOF__N-1,0:*) !SPECIFIED SETS -C -C Function references: -C - LOGICAL WNFOP !OPEN FILE - LOGICAL WNFRD,WNFWR !READ/WRITE FILE - LOGICAL WNDNOD !GET USER NODE - LOGICAL WNDPAR !GET USER DATA - LOGICAL WNDSTM !DECODE SET SPECIFICATION - LOGICAL WNCASC !SKIP CHARACTER - LOGICAL WNCAFF !GET FIELD - LOGICAL WNCACJ,WNCACE,WNCACI !GET VALUE - LOGICAL NFLFL1,NFLFL2 !SET/GET ENTRY FROM LIST - LOGICAL NFLFLS !GET HEADER FOR ENTRIES - LOGICAL NFLFLR !GO TO BEGINNING OF LIST -C -C Data declarations: -C - INTEGER DFCA !IN/OUT FCA - INTEGER LUN !LUN USED - CHARACTER*80 DNOD !NODE NAME - CHARACTER*160 DFIL !FILE NAME - CHARACTER*32 DHOST,DUSER !HOST NAME, USER NAME - CHARACTER*2 POLT(0:3) !POLARISATION NAMES - DATA POLT/'XX','XY','YX','YY'/ - CHARACTER*1 TELT(0:STHTEL-1) !TEL. NAMES - DATA TELT/'0','1','2','3','4','5','6','7','8','9', - 1 'A','B','C','D'/ - CHARACTER*1 TEL1 !TELESCOPE - CHARACTER*20 LFLD(6) !OUTPUT TEXT - CHARACTER*80 LINE,FLINE !INPUT TEXT - INTEGER PT !TEXT POINTER - BYTE LFLH(0:FLHHDL-1) !LOCAL FILE HEADER - INTEGER LFLHJ(0:FLHHDL/LB_J-1) - REAL LFLHE(0:FLHHDL/LB_E-1) - EQUIVALENCE (LFLH,LFLHJ,LFLHE) - BYTE LFLF(0:FLFHDL-1,2) !LOCAL ENTRY - INTEGER*2 LFLFI(0:FLFHDL/LB_I-1,2) - INTEGER LFLFJ(0:FLFHDL/LB_J-1,2) - REAL LFLFE(0:FLFHDL/LB_E-1,2) - EQUIVALENCE (LFLF,LFLFI,LFLFJ,LFLFE) -C- -C -C FL5 -C -C INIT -C - IF (DFAR.EQ.0) GOTO 900 !CANNOT DO - NFLFL5=.TRUE. !ASSUME OK - IF (.NOT.WNDNOD('OUTPUT_FLF_NODE',' ','FLF','W',DNOD,DFIL)) THEN - CALL WNCTXT(F_TP,'Cannot open FLF node') - GOTO 900 - END IF - IF (.NOT.WNFOP(DFCA,DFIL,'U')) THEN - CALL WNCTXT(F_TP,'Cannot open FLF node file') - GOTO 900 - END IF -C -C UNLOAD HEADER -C - IF (.NOT.NFLFLS(DFAR,LFLH)) GOTO 901 !CANNOT GET HEADER - IF (.NOT.WNFWR(DFCA,FLHHDL,LFLH,GFHHDL)) GOTO 51 !WRITE HEADER - J=LFLHJ(FLH_FLFP_J) !DATA POINTER -C -C UNLOAD ENTRIES -C - I1 = 0 !COUNTER - DO WHILE (NFLFL2(DFAR,LFLF(0,1),LFLF(0,2))) - I1 = I1+1 !COUNT ENTRIES - IF (.NOT.WNFWR(DFCA,FLFHDL,LFLF(0,1),J)) THEN !WRITE TO NODE - 51 CONTINUE - CALL WNCTXT(F_TP,'Error writing FLF node') - GOTO 901 - END IF - J=J+FLFHDL !NEXT POINTER - IF (IAND(LFLFJ(0,1),1).NE.0) THEN !WRITE SECOND - IF (.NOT.WNFWR(DFCA,FLFHDL,LFLF(0,2),J)) GOTO 51 !WRITE TO NODE - J=J+FLFHDL !NEXT POINTER - END IF - END DO !MORE -C - IF (.NOT.WNFWR(DFCA,FLHHDL,LFLH,GFHHDL)) GOTO 51 !REWRITE HEADER - CALL WNFCL(DFCA) !CLOSE OUTPUT - CALL WNCTXT(F_TP,' ') - CALL WNCTXT(F_TP,'!UJ entries stored in FLF node "!AS"' - 1 //' (list length=!UJ)' - 1 ,I1,DNOD,LFLHJ(FLH_FLFN_J)) -C - RETURN -C -C FL6 -C - ENTRY NFLFL6(DFAR) -C - IF (DFAR.EQ.0) GOTO 900 !CANNOT DO - NFLFL6=.TRUE. !ASSUME OK - IF (.NOT.WNDNOD('INPUT_FLF_NODE',' ','FLF','R',DNOD,DFIL)) THEN - CALL WNCTXT(F_TP,'Cannot open FLF node') - GOTO 900 - END IF - IF (.NOT.WNFOP(DFCA,DFIL,'R')) THEN - CALL WNCTXT(F_TP,'Cannot open FLF node file') - GOTO 900 - END IF -C -C LOAD HEADER -C - IF (.NOT.WNFRD(DFCA,FLHHDL,LFLH,GFHHDL)) THEN - 60 CONTINUE - CALL WNCTXT(F_TP,'Error reading FLF node') - GOTO 901 - END IF - J=LFLHJ(FLH_FLFP_J) !DATA POINTER -C -C LOAD DATA -C - DO I=0,LFLHJ(FLH_FLFN_J)-1 !READ ALL ENTRIES - IF (.NOT.WNFRD(DFCA,FLFHDL, - 1 LFLF(0,1),J)) GOTO 60 !READ - IF (.NOT.NFLFL1(DFAR,LFLF)) GOTO 60 !PUT ENTRY - J=J+FLFHDL !NEXT ENTRY - END DO - IF (.NOT.NFLFLS(DFAR,LFLH)) GOTO 60 !CANNOT GET STATUS - CALL WNFCL(DFCA) !CLOSE INPUT -C - JS = NFLFLR(DFAR) !BEGINNING OF FLAG LIST - I1=0 !COUNTER - DO WHILE(NFLFL2(DFAR,LFLF(0,1),LFLF(0,2))) !ALL ENTRIES - I1=I1+1 !COUNT ENTRIES - END DO -CCC CALL WNCTXT(F_TP,' ') -CCC CALL WNCTXT(F_TP,'!UJ entries in flag-list' -CCC 1 //' (list length=!UJ)' -CCC 1 ,I1,LFLHJ(FLH_FLFN_J)) -C - RETURN -C -C FL7 -C -C If LUNOUT<=0, the FLF list will be written to a file. -C If LUNOUT=F_T or F_P or F_TP, the list will be typet and/or printed. -C - ENTRY NFLFL7(DFAR,LUNOUT,NODE,SETS) -C -C INIT -C - IF (DFAR.EQ.0) GOTO 901 !CANNOT DO - NFLFL7=.TRUE. !ASSUME OK - IF ((LUNOUT.EQ.F_T).OR. - 1 (LUNOUT.EQ.F_P).OR. - 1 (LUNOUT.EQ.F_TP)) THEN !TYPE/PRINT - LUN = LUNOUT !USE INPUT LUN - DFIL = ' ' !NO FILENAME - CALL WNCTXT(LUN,'Current flag-list:') -C - ELSE !WRITE TO FILE - LUN = F_0 !USE DEFAULT LUN - DFIL='FLAG.LOG' !NAME OF ASCII FLAG-FILE - IF (.NOT.WNDPAR('OUTPUT_FILE',DFIL,LEN(DFIL),J0,DFIL)) THEN - IF (E_C.EQ.DWC_ENDOFLOOP) GOTO 902 !READY - 72 CONTINUE - CALL WNCTXT(F_TP,'No proper file specified') - GOTO 900 - END IF - IF (J0.LT.0) GOTO 72 - IF (J0.EQ.0) GOTO 902 !READY - CALL WNCFOP(LUN,DFIL) !OPEN OUTPUT FILE - CALL WNGSGH(DHOST) !GET HOST - CALL WNGSGU(DUSER) !GET USER - JS=WNDSTM(SETS,LINE) !DECODE SETS - CALL WNCTXT(LUN,'!!+ *** Flagging file !AS',DFIL) - CALL WNCTXT(LUN,'!! *** Created by !AS on !%DN '// - 1 'at !%T at !AS',DUSER,DHOST) - CALL WNCTXT(LUN,'!! *** Input node: !AS',NODE) - CALL WNCTXT(LUN,'!! *** Input sets: "!AS"',LINE) - END IF -C -C WRITE (NB: The comment-lines with *** are printed when READ) -C - CALL WNCTXT(LUN,'!! Flags:') - CALL WNCTXT(LUN,'!!!_MAN : 80 CLIP: 40 NOIS: 20 ADD : 10') - CALL WNCTXT(LUN,'!!!_SHAD: 08 U3 : 04 U2 : 02 U1 : 01') - CALL WNCTXT(LUN,'!! Types:') - CALL WNCTXT(LUN,'!!!_\00: Interprete Ifr field as interferometer') - CALL WNCTXT(LUN,'!!!_\01: Interprete Ifr field as baselines in m') - CALL WNCTXT(LUN,'!! Data following an !! are seen as comments') - CALL WNCTXT(LUN,'!! Remaining fields have format:') - CALL WNCTXT(LUN,'!!!_\*: all values') - CALL WNCTXT(LUN,'!!!_\value: single value') - CALL WNCTXT(LUN,'!!!_\val1=val2: value range (inclusive)') - CALL WNCTXT(LUN,'!!!/!!-!/'// - 1 '!!Flag!8CType!14CChannel'// - 1 '!28CHour-angle!48CIfr!60CPol') -C -C WRITE FLF ENTRIES -C - I1=0 !COUNTER - DO WHILE(NFLFL2(DFAR,LFLF(0,1),LFLF(0,2))) - I1=I1+1 !COUNT ENTRIES - CALL WNCTXS(LFLD(1),'!2$XJ', - 1 IAND(ISHFT(LFLFJ(FLF_FLAG_J,1),-8),'ff'X)) - CALL WNCTXS(LFLD(6),'!2$XJ', - 1 IAND(ISHFT(LFLFJ(FLF_FLAG_J,1),-24),'ff'X)) - IF (LFLFJ(FLF_CHAN_J,1).EQ.-1) THEN - LFLD(2)='*' - ELSE - IF (LFLFJ(FLF_CHAN_J,1).EQ.LFLFJ(FLF_CHAN_J,2)) THEN - CALL WNCTXS(LFLD(2),'!5$SJ', - 1 LFLFJ(FLF_CHAN_J,1)) - ELSE - CALL WNCTXS(LFLD(2),'!5$SJ=!5$SJ', - 1 LFLFJ(FLF_CHAN_J,1),LFLFJ(FLF_CHAN_J,2)) - END IF - END IF - IF (LFLFJ(FLF_HA_E,1).EQ.-1) THEN - LFLD(3)='*' - ELSE - IF (LFLFE(FLF_HA_E,1).EQ.LFLFE(FLF_HA_E,2)) THEN - CALL WNCTXS(LFLD(3),'!8$EAF10.2', - 1 LFLFE(FLF_HA_E,1)) - ELSE - CALL WNCTXS(LFLD(3),'!8$EAF10.2=!8$EAF10.2', - 1 LFLFE(FLF_HA_E,1),LFLFE(FLF_HA_E,2)) - END IF - END IF - IF (LFLFI(FLF_IFR_I,1).EQ.-1) THEN - LFLD(4)='*' - ELSE - IF (LFLFI(FLF_IFR_I,1).EQ.LFLFI(FLF_IFR_I,2)) THEN - IF (IAND(LFLFJ(FLF_FLAG_J,1),'01000000'X).EQ.0) THEN !IFR - CALL WNCTXS(LFLD(4),'!AS!AS', - 1 TELT(MOD(LFLFI(FLF_IFR_I,1)*1,256)), - 1 TELT(LFLFI(FLF_IFR_I,1)/256)) - ELSE !BASELINE - CALL WNCTXS(LFLD(4),'!5$UI', - 1 LFLFI(FLF_IFR_I,1)) - END IF - ELSE - IF (IAND(LFLFJ(FLF_FLAG_J,1),'01000000'X).EQ.0) THEN !IFR - CALL WNCTXS(LFLD(4),'!AS!AS=!AS!AS', - 1 TELT(MOD(LFLFI(FLF_IFR_I,1)*1,256)), - 1 TELT(LFLFI(FLF_IFR_I,1)/256), - 1 TELT(MOD(LFLFI(FLF_IFR_I,2)*1,256)), - 1 TELT(LFLFI(FLF_IFR_I,2)/256)) - ELSE !BASELINE - CALL WNCTXS(LFLD(4),'!5$UI=!5$UI', - 1 LFLFI(FLF_IFR_I,1),LFLFI(FLF_IFR_I,2)) - END IF - END IF - END IF - IF (LFLFI(FLF_POL_I,1).EQ.-1) THEN - LFLD(5)='*' - ELSE - IF (LFLFI(FLF_POL_I,1).EQ.LFLFI(FLF_POL_I,2)) THEN - CALL WNCTXS(LFLD(5),'!2$AS', - 1 POLT(IAND(LFLFI(FLF_POL_I,1),3))) - ELSE - CALL WNCTXS(LFLD(5),'!2$AS=!2$AS', - 1 POLT(IAND(LFLFI(FLF_POL_I,1),3)), - 1 POLT(IAND(LFLFI(FLF_POL_I,2),3))) - END IF - END IF - CALL WNCTXT(LUN,'!AS!8C!AS!14C!AS!28C!AS!48C!AS!60C!AS', - 1 LFLD(1),LFLD(6),LFLD(2),LFLD(3),LFLD(4),LFLD(5)) - END DO -C - CALL WNCFCL(LUN) !CLOSE OUTPUT - IF (DFIL.EQ.' ') THEN !TYPE/PRINT - JS = NFLFLS(DFAR,LFLH) !GET FLAG-LIST HEADER - CALL WNCTXT(F_TP,'!UJ entries in current flag-list' - 1 //' (list length=!UJ)' - 1 ,I1,LFLHJ(FLH_FLFN_J)) - ELSE - CALL WNCTXT(F_TP,'!UJ entries stored in ASCII file "!AS"' - 1 //' (list length=!UJ)' - 1 ,I1,DFIL,LFLHJ(FLH_FLFN_J)) - CALL WNCTXT(F_TP,' Created by !AS on !%DN '// - 1 'at !%T at !AS',DUSER,DHOST) - CALL WNCTXT(F_TP,' for input node: !AS',NODE) - CALL WNCTXT(F_TP,' and input sets: "!AS"',LINE) - END IF -C - RETURN -C -C FL8 -C - ENTRY NFLFL8(DFAR) -C - IF (DFAR.EQ.0) GOTO 901 !CANNOT DO - NFLFL8=.TRUE. !ASSUME OK - DFIL='FLAG.LOG' - IF (.NOT.WNDPAR('INPUT_FILE',DFIL,LEN(DFIL),J0,DFIL)) THEN - IF (E_C.EQ.DWC_ENDOFLOOP) GOTO 902 !READY - 82 CONTINUE - CALL WNCTXT(F_TP,'No proper file specified') - GOTO 900 - END IF - IF (J0.LT.0) GOTO 82 - IF (J0.EQ.0) GOTO 902 !READY - LUN=0 - CALL WNGLUN(LUN) !GET LUN TO USE - IF (LUN.EQ.0) THEN - 83 CONTINUE - CALL WNCTXT(F_TP,'Cannot open/read file') - NFLFL8=.FALSE. - IF (LUN.NE.0) GOTO 84 !CLOSE - GOTO 902 - END IF - OPEN (UNIT=LUN,FILE=DFIL,STATUS='OLD',ERR=83) !OPEN INPUT -C -C READ DATA -C - I1 = 0 !Entry counter - 86 CONTINUE - READ (UNIT=LUN,FMT=1000,END=87,ERR=83) LINE - 1000 FORMAT(A) - PT=1 !DATA POINTER - IF (.NOT.WNCAFF(LINE,PT,FLINE)) THEN !COMMENT-LINE (!) - IF (INDEX(LINE,'***').GT.0) THEN !IMPORTANT INFORMATION - CALL WNCTXT (F_T,'!AS',LINE) !TYPE - END IF - GOTO 86 !READ NEXT LINE - END IF - PT=1 - CALL WNCASB(FLINE,PT) !SKIP BLANK - IF (.NOT.WNCACJ(FLINE,PT,16,J0)) GOTO 86 !GET FLAGS - LFLFJ(FLF_FLAG_J,1)=ISHFT(IAND(J0,'000000ff'X),8) - CALL WNCASB(FLINE,PT) !SKIP BLANK - IF (.NOT.WNCACJ(FLINE,PT,16,J0)) GOTO 86 !GET TYPE - LFLFJ(FLF_FLAG_J,1)=IOR(LFLFJ(FLF_FLAG_J,1), - 1 ISHFT(IAND(J0,'000000ff'X),24)) - LFLFJ(FLF_FLAG_J,2)=LFLFJ(FLF_FLAG_J,1) !COPY - I0=0 !NO CONTINUATION - CALL WNCASB(FLINE,PT) !SKIP BLANK - IF (WNCASC(FLINE,PT,'*')) THEN !CHANNEL - LFLFJ(FLF_CHAN_J,1)=-1 - LFLFJ(FLF_CHAN_J,2)=-1 - ELSE - IF (.NOT.WNCACJ(FLINE,PT,10,LFLFJ(FLF_CHAN_J,1))) GOTO 86 - CALL WNCASB(FLINE,PT) !SKIP BLANK - IF (WNCASC(FLINE,PT,'=')) THEN !CONTINUATION - I0=1 !SET CONTINUATION - CALL WNCASB(FLINE,PT) !SKIP BLANK - IF (.NOT.WNCACJ(FLINE,PT,10,LFLFJ(FLF_CHAN_J,2))) GOTO 86 - ELSE - LFLFJ(FLF_CHAN_J,2)=LFLFJ(FLF_CHAN_J,1) !COPY - END IF - END IF - CALL WNCASB(FLINE,PT) !SKIP BLANK - IF (WNCASC(FLINE,PT,'*')) THEN !HA - LFLFJ(FLF_HA_E,1)=-1 - LFLFJ(FLF_HA_E,2)=-1 - ELSE - IF (.NOT.WNCACE(FLINE,PT,10,LFLFE(FLF_HA_E,1))) GOTO 86 - LFLFE(FLF_HA_E,1)=LFLFE(FLF_HA_E,1)/360. - CALL WNCASB(FLINE,PT) !SKIP BLANK - IF (WNCASC(FLINE,PT,'=')) THEN !CONTINUATION - I0=1 !SET CONTINUATION - CALL WNCASB(FLINE,PT) !SKIP BLANK - IF (.NOT.WNCACE(FLINE,PT,10,LFLFE(FLF_HA_E,2))) GOTO 86 - LFLFE(FLF_HA_E,2)=LFLFE(FLF_HA_E,2)/360. - ELSE - LFLFE(FLF_HA_E,2)=LFLFE(FLF_HA_E,1) !COPY - LFLFE(FLF_HA_E,1)=LFLFE(FLF_HA_E,1)-0.25 !******* CMV 20000804 - END IF - END IF - CALL WNCASB(FLINE,PT) !SKIP BLANK - IF (WNCASC(FLINE,PT,'*')) THEN !IFR - LFLFI(FLF_IFR_I,1)=-1 - LFLFI(FLF_IFR_I,2)=-1 - ELSE - IF (IAND(LFLFJ(FLF_FLAG_J,1),'01000000'X).EQ.0) THEN !IFR - IF (.NOT.WNCACI(FLINE,PT,16,LFLFI(FLF_IFR_I,1))) GOTO 86 - LFLFI(FLF_IFR_I,1)=(LFLFI(FLF_IFR_I,1)/16)+ - 1 MOD(LFLFI(FLF_IFR_I,1)*1,16)*256 - ELSE !BASELINE - IF (.NOT.WNCACI(FLINE,PT,10,LFLFI(FLF_IFR_I,1))) GOTO 86 - END IF - CALL WNCASB(FLINE,PT) !SKIP BLANK - IF (WNCASC(FLINE,PT,'=')) THEN !CONTINUATION - I0=1 !SET CONTINUATION - CALL WNCASB(FLINE,PT) !SKIP BLANK - IF (IAND(LFLFJ(FLF_FLAG_J,1),'01000000'X).EQ.0) THEN !IFR - IF (.NOT.WNCACI(FLINE,PT,16,LFLFI(FLF_IFR_I,2))) GOTO 86 - LFLFI(FLF_IFR_I,2)=(LFLFI(FLF_IFR_I,2)/16)+ - 1 MOD(LFLFI(FLF_IFR_I,2)*1,16)*256 - ELSE !BASELINE - IF (.NOT.WNCACI(FLINE,PT,10,LFLFI(FLF_IFR_I,2))) GOTO 86 - END IF - ELSE - LFLFI(FLF_IFR_I,2)=LFLFI(FLF_IFR_I,1) !COPY - END IF - END IF - CALL WNCASB(FLINE,PT) !SKIP BLANK - IF (WNCASC(FLINE,PT,'*')) THEN !POL - LFLFI(FLF_POL_I,1)=-1 - LFLFI(FLF_POL_I,2)=-1 - ELSE - IF (FLINE(PT:PT).EQ.'X' .OR. FLINE(PT:PT).EQ.'x') THEN - LFLFI(FLF_POL_I,1)=0 - ELSE IF (FLINE(PT:PT).EQ.'Y' .OR. FLINE(PT:PT).EQ.'y') THEN - LFLFI(FLF_POL_I,1)=2 - ELSE - GOTO 86 !FORMAT ERROR - END IF - PT=PT+1 !NEXT CHARACTER - IF (FLINE(PT:PT).EQ.'X' .OR. FLINE(PT:PT).EQ.'x') THEN - ELSE IF (FLINE(PT:PT).EQ.'Y' .OR. FLINE(PT:PT).EQ.'y') THEN - LFLFI(FLF_POL_I,1)=LFLFI(FLF_POL_I,1)+1 - ELSE - GOTO 86 !FORMAT ERROR - END IF - PT=PT+1 !NEXT CHARACTER - CALL WNCASB(FLINE,PT) !SKIP BLANK - IF (WNCASC(FLINE,PT,'=')) THEN !CONTINUATION - I0=1 !SET CONTINUATION - CALL WNCASB(FLINE,PT) !SKIP BLANK - IF (FLINE(PT:PT).EQ.'X' .OR. FLINE(PT:PT).EQ.'x') THEN - LFLFI(FLF_POL_I,2)=0 - ELSE IF (FLINE(PT:PT).EQ.'Y' .OR. FLINE(PT:PT).EQ.'y') THEN - LFLFI(FLF_POL_I,2)=2 - ELSE - GOTO 86 !FORMAT ERROR - END IF - PT=PT+1 !NEXT CHARACTER - IF (FLINE(PT:PT).EQ.'X' .OR. FLINE(PT:PT).EQ.'x') THEN - ELSE IF (FLINE(PT:PT).EQ.'Y' .OR. FLINE(PT:PT).EQ.'y') THEN - LFLFI(FLF_POL_I,2)=LFLFI(FLF_POL_I,2)+1 - ELSE - GOTO 86 !FORMAT ERROR - END IF - PT=PT+1 !NEXT CHARACTER - ELSE - LFLFI(FLF_POL_I,2)=LFLFI(FLF_POL_I,1) !COPY - END IF - END IF - IF (I0.EQ.0) THEN !ONLY 1 - IF (.NOT.NFLFL1(DFAR,LFLF)) GOTO 83 !PUT ENTRY - ELSE - LFLFJ(FLF_FLAG_J,1)=IOR(LFLFJ(FLF_FLAG_J,1),1) !INDICATE TWO - LFLFJ(FLF_FLAG_J,2)=IOR(LFLFJ(FLF_FLAG_J,2),2) - IF (.NOT.NFLFL1(DFAR,LFLF(0,1))) GOTO 83 !PUT ENTRY - IF (.NOT.NFLFL1(DFAR,LFLF(0,2))) GOTO 83 - END IF - I1 = I1+1 !Count entries - GOTO 86 !MORE -C -C READY -C - 87 CONTINUE - IF (.NOT.NFLFLS(DFAR,LFLH)) GOTO 83 !CANNOT GET STATUS - CALL WNCTXT(F_TP,' ') - CALL WNCTXT(F_TP,'!UJ entries added to flag-list',I1) - 84 CONTINUE - CLOSE (UNIT=LUN,ERR=85) !CLOSE INPUT - 85 CONTINUE - CALL WNGLUF(LUN) !FREE LUN -C - RETURN -C -C ERRORS -C - 901 CONTINUE - CALL WNFCL(DFCA) !MAKE SURE - 900 CONTINUE - NFLFL5=.FALSE. !RETURN ERROR - CALL WNCFCL(LUN) !MAKE SURE FILE CLOSED - 902 CONTINUE -C - RETURN -C -C - END diff --git a/src/nscan/nflflg.for b/src/nscan/nflflg.for deleted file mode 100644 index a0d31a74001bb8042c75ea0192e7a95c74c030a0..0000000000000000000000000000000000000000 --- a/src/nscan/nflflg.for +++ /dev/null @@ -1,652 +0,0 @@ -C+ NFLFLG.FOR -C JEN 931116 (based on nflflg.for by WNB) -C -C Revisions: -C -C JEN 940216 Add DODRYRUN mode switch -C CMV 940707 Add warning if HASCANS selected -C JPH 940929 Add explanatory texts -C Remove default option (belong in .psc file) -C HjV 941031 Line too long -C - SUBROUTINE NFLFLG -C -C (Un)-flag scan data -C -C Result: -C -C CALL NFLFLG will flag or unflag scan data -C -C PIN references: -C -C FLAG_OPTION -C FLAG_MODE -C OPS_COPY -C OPS_MANUAL -C OPS_CLIP -C OPS_NOISE -C OPS_DETERM -C USER_FLAG -C -C Include files: -C -C Include files: -C - INCLUDE 'WNG_DEF' - INCLUDE 'NFL_DEF' - INCLUDE 'CBITS_DEF' - INCLUDE 'STH_O_DEF' !SET HEADER - INCLUDE 'SCH_O_DEF' !SCAN HEADER -C -C Parameters: -C -C Arguments: -C -C Function references: -C - LOGICAL WNDPAR !GET DWARF PARAMETER - LOGICAL WNDNOD !GET NODE - LOGICAL WNFOP !OPEN FILE - LOGICAL WNFRD !READ DATA - LOGICAL WNFWR !WRITE DATA - CHARACTER*32 WNTTSG !SET NAME - LOGICAL WNDSTQ !GET SETS - INTEGER WNCAJ !GET INTEGER FROM TEXT - LOGICAL NFLFL9 !DELETE INTERNAL FLAG LIST - REAL NFLST1 !STATISTICS - LOGICAL NFLCNT !FLAG COUNTING - LOGICAL NFLCUB !UV-DATA CUBE -C -C Data declarations: -C - INTEGER MASK ! flag mask - CHARACTER*4 CFLAGS(8) ! flag names - DATA CFLAGS /'MAN','CLIP','NOIS','ADD','SHAD', - 1 'U3','U2','U1'/ -C -C NB: The variables CHARACTER OPTION*24 and OPT*3 are defined in a common. -C - CHARACTER*8 FLOPT !FLAG_MODE default - CHARACTER*8 UTILOPT !Utility option (INSP,STAT,MODE) - CHARACTER*24 OPER !CURRENT FLAGGING OPERATION - INTEGER NOPER !CURRENT OPERATION NR - INTEGER DFAR !FLAG FILE AREA (FOR FLIST OPS) - CHARACTER*80 TXT80 !TEXT BUFFER - LOGICAL FLOPS !CONTINUE TO NFLOPS -C - LOGICAL MODE_CORRDAT !MODE: CORRECT DATA BEFORE USE - LOGICAL MODE_TRACE !MODE: TRACE FLAGGING OPERATION - LOGICAL MODE_SHOW_CNT !SHOW FLAG COUNTS AFTER OPERATION - INTEGER MODE_USERFLAG !USER SPECIFIED FLAG (OVERRIDE) - LOGICAL MODE_DODRYRUN !DO DRY RUN FIRST, IF RELEVANT -C - LOGICAL CORRDAT !Transient version of MODE_CORRDAT - LOGICAL TRACE !Transient version of MODE_TRACE - LOGICAL SHOW_CNT !Transient version of MODE_SHOW_CNT - INTEGER USERFLAG !Transient version of MODE_CORRDAT - LOGICAL DODRYRUN !Transient version of MODE_DODRYRUN -C- -C****************************************************************************** -C****************************************************************************** -C INIT -C - MODE_CORRDAT=.FALSE. !NO CORRECTION OF DATA - MODE_TRACE = .FALSE. !NO TRACING OF OPS - MODE_SHOW_CNT = .TRUE. !SHOW FLAG COUNT AFTER OPS - MODE_USERFLAG = 0 !NO SELFLAG OVERRIDE - MODE_DODRYRUN = .TRUE. !DO DRY RUN FIRST, IF RELEVANT -C - DFAR=0 !NO FLAG LIST AREA YET -C - R0 = NFLST1 ('INIT',' ',' ',0,0.,0.) !Initialise Statistics buffers -C -C***************************************************************************** -C GET HYPERCUBE TO WORK ON -C - 10 CONTINUE !FALL-BACK POINT -C - CALL WNCTXT(F_T,'!/ - 1!4C\You have selected the flagging/data-statistics branch of NFLAG.!/ - 1!4C\You must now define the "primary data cube" to work on.!/ - 1!4C\(You may later define a sub-cube for specific operations or!/ - 1!4C\ redefine the primary cube.)') - IF (.NOT.NFLCUB ('SPECIFY','NODE',0,0,0,0)) GOTO 800 - IF (.NOT.NFLCUB ('SPECIFY','SETS',0,0,0,0)) GOTO 800 - IF (.NOT.NFLCUB ('SPECIFY','HYPERCUBE',0,0,0,0)) GOTO 800 - CALL WNCTXT(F_T,' ') -C -C***************************************************************************** -C GET FLAG_OPTION -C - UTILOPT = ' ' !Utility (INSP,MODE,STAT) - 100 CONTINUE - IF (.NOT.WNDPAR('FLAG_OPTION',OPTION,LEN(OPTION),J0)) THEN - IF (E_C.EQ.DWC_ENDOFLOOP) GOTO 800 !READY - FLOPT = 'QUIT' - GOTO 100 !ERROR - END IF - IF (J0.EQ.0) GOTO 100 !EMPTY STRING, TRY AGAIN - IF (J0.LT.0) GOTO 100 !WILDCARD (?) -C - 101 CONTINUE !RETURN-POINT FOR KNOWN OPTION -C -C Reset switches for flagging operations to default (MODE) values: -C - USERFLAG = MODE_USERFLAG - CORRDAT = MODE_CORRDAT - TRACE = MODE_TRACE - SHOW_CNT = MODE_SHOW_CNT - DODRYRUN = MODE_DODRYRUN -C -C If busy in `utility' group of operations, go there: -C - IF (UTILOPT(:3).EQ.'INS') GOTO 190 !INSPECT (FLAGS) - IF (UTILOPT(:3).EQ.'STA') GOTO 180 !STATISTICS (DATA) - IF (UTILOPT(:3).EQ.'MOD') GOTO 120 !MODE - UTILOPT = ' ' -C -C========================================================================= -C OPTION QUIT: -C - IF (OPTION(:3).EQ.'QUI') THEN - GOTO 800 !READY, EXIT -C -C========================================================================= -C OPTION CLEAR (example of flagging operation called from this level): -C - ELSE IF (OPTION(:3).EQ.'CLE') THEN - OPER = 'CLE' !FLAGGING OPERATION - OPTION = ' ' !ENSURE RETURN TO FLAG_OPTION - FLOPT = '""' !DEFAULT FLAG_OPTION - CONTINUE !TO "CALL NFLOPS" BELOW -C -C========================================================================= -C OPTION FLIST (Interactions with internal flag list): -C - ELSE IF (OPTION(:3).EQ.'FLI') THEN -C - 110 CONTINUE - IF (.NOT.WNDPAR('OPS_FLIST',OPER,LEN(OPER),J0,'QUIT')) THEN - IF (E_C.EQ.DWC_ENDOFLOOP) GOTO 100 !GO BACK TO FLAG_OPTION (?) - GOTO 110 !ERROR, TRY AGAIN - END IF - IF (J0.EQ.0) GOTO 110 !EMPTY STRING, TRY AGAIN - IF (J0.LT.0) GOTO 110 !WILDCARD, TRY AGAIN -C - IF (OPER(:3).EQ.'QUI') THEN - FLOPT = OPTION !DEFAULT FLAG OPTION - GOTO 100 !BACK TO FLAG_OPTION -C - ELSE IF (OPER(:3).EQ.'CLE') THEN !CLEAR FLAGS - CONTINUE - ELSE IF (OPER(:3).EQ.'STA') THEN !DATA STATISTICS - GOTO 180 - ELSE IF (OPER(:3).EQ.'INS') THEN !INSPECT FLAGS - GOTO 190 -C - ELSE !FLAG-LIST OPERATIONS - CALL NFLIST (OPER,USERFLAG,DFAR, - 1 SHOW_CNT,TRACE) - GOTO 110 !BACK TO OPS_FLIST - END IF -C -C============================================================================= -C OPTION FCOPY: -C - ELSE IF (OPTION(:3).EQ.'FCO') THEN - 130 CONTINUE - IF (.NOT.WNDPAR('OPS_FCOPY',OPER,LEN(OPER),J0,'QUIT')) THEN - IF (E_C.EQ.DWC_ENDOFLOOP) GOTO 100 !GO BACK TO FLAG_OPTION (?) - GOTO 130 !ERROR, TRY AGAIN - END IF - IF (J0.EQ.0) GOTO 130 !EMPTY STRING, TRY AGAIN - IF (J0.LT.0) GOTO 130 !WILDCARD, TRY AGAIN - IF (OPER(:3).EQ.'QUI') THEN - FLOPT = OPTION !DEFAULT FLAG OPTION - GOTO 100 !BACK TO FLAG_OPTION -C - ELSE IF (OPER(:3).EQ.'CLE') THEN !CLEAR FLAGS - CONTINUE - ELSE IF (OPER(:3).EQ.'STA') THEN !STATISTICS - GOTO 180 - ELSE IF (OPER(:3).EQ.'INS') THEN !INSPECT - GOTO 190 -C - END IF -C -C============================================================================= -C OPTION MANUAL: -C - ELSE IF (OPTION(:3).EQ.'MAN') THEN - 140 CONTINUE - IF (.NOT.WNDPAR('OPS_MANUAL',OPER,LEN(OPER),J0,'QUIT')) THEN - IF (E_C.EQ.DWC_ENDOFLOOP) GOTO 100 !GO BACK TO FLAG_OPTION (?) - GOTO 140 !ERROR, TRY AGAIN - END IF - IF (J0.EQ.0) GOTO 140 !EMPTY STRING, TRY AGAIN - IF (J0.LT.0) GOTO 140 !WILDCARD, TRY AGAIN - IF (OPER(:3).EQ.'QUI') THEN - FLOPT = OPTION !DEFAULT FLAG OPTION - GOTO 100 !BACK TO FLAG_OPTION -C - ELSE IF (OPER(:3).EQ.'CLE') THEN !CLEAR FLAGS - CONTINUE - ELSE IF (OPER(:3).EQ.'STA') THEN !DATA STATISTICS - GOTO 180 - ELSE IF (OPER(:3).EQ.'INS') THEN !INSPECT FLAGS - GOTO 190 -C - END IF -C -C============================================================================= -C OPTION HASCANS: -C - ELSE IF (OPTION(:3).EQ.'HAS') THEN - CALL WNCTXT(F_T, - 1 'BEWARE: Flagging on entire HA-Scans will override'// - 1 '!/ any hypercube settings for IFRS and POLS') - 150 CONTINUE - IF (.NOT.WNDPAR('OPS_SCANS',OPER,LEN(OPER),J0,'QUIT')) THEN - IF (E_C.EQ.DWC_ENDOFLOOP) GOTO 100 !GO BACK TO FLAG_OPTION (?) - GOTO 150 !ERROR, TRY AGAIN - END IF - IF (J0.EQ.0) GOTO 150 !EMPTY STRING, TRY AGAIN - IF (J0.LT.0) GOTO 150 !WILDCARD, TRY AGAIN - IF (OPER(:3).EQ.'QUI') THEN - FLOPT = OPTION !DEFAULT FLAG OPTION - GOTO 100 !BACK TO FLAG_OPTION -C - ELSE IF (OPER(:3).EQ.'CLE') THEN !CLEAR FLAGS - OPER = 'CLH' !HEADERS ONLY - ELSE IF (OPER(:3).EQ.'STA') THEN !DATA STATISTICS - GOTO 180 - ELSE IF (OPER(:3).EQ.'INS') THEN !INSPECT FLAGS - GOTO 190 -C - END IF -C -C============================================================================= -C OPTION CLIPDATA: -C - ELSE IF (OPTION(:3).EQ.'CLI') THEN - 160 CONTINUE - IF (.NOT.WNDPAR('OPS_CLIPDATA',OPER,LEN(OPER),J0,'QUIT')) THEN - IF (E_C.EQ.DWC_ENDOFLOOP) GOTO 100 !GO BACK TO FLAG_OPTION (?) - GOTO 160 !ERROR, TRY AGAIN - END IF - IF (J0.EQ.0) GOTO 160 !EMPTY STRING, TRY AGAIN - IF (J0.LT.0) GOTO 160 !WILDCARD, TRY AGAIN - write(*,*)oper - IF (OPER(:3).EQ.'QUI') THEN - FLOPT = OPTION !DEFAULT FLAG OPTION - GOTO 100 !BACK TO FLAG_OPTION -C - ELSE IF (OPER(:3).EQ.'CLE') THEN !CLEAR FLAGS - OPER = 'CLD' !UV-DATA ONLY - ELSE IF (OPER(:3).EQ.'STA') THEN !DATA STATISTICS - GOTO 180 - ELSE IF (OPER(:3).EQ.'INS') THEN !INSPECT FLAGS - GOTO 190 -C - END IF - write(*,*)oper -C -C============================================================================= -C OPTION DETERM: -C - ELSE IF (OPTION(:3).EQ.'DET') THEN - 170 CONTINUE - IF (.NOT.WNDPAR('OPS_DETERM',OPER,LEN(OPER),J0,'QUIT')) THEN - IF (E_C.EQ.DWC_ENDOFLOOP) GOTO 100 !GO BACK TO FLAG_OPTION (?) - GOTO 170 !ERROR, TRY AGAIN - END IF - IF (J0.EQ.0) GOTO 170 !EMPTY STRING, TRY AGAIN - IF (J0.LT.0) GOTO 170 !WILDCARD, TRY AGAIN - IF (OPER(:3).EQ.'QUI') THEN - FLOPT = OPTION !DEFAULT FLAG OPTION - GOTO 100 !BACK TO FLAG_OPTION -C - ELSE IF (OPER(:3).EQ.'CLE') THEN !CLEAR FLAGS - OPER = 'CLD' !UV-DATA ONLY - ELSE IF (OPER(:3).EQ.'STA') THEN !DATA STATISTICS - GOTO 180 - ELSE IF (OPER(:3).EQ.'INS') THEN !INSPECT FLAGS - GOTO 190 -C - END IF -C -C============================================================================= -C OPTION MODE: Can be accessed as FLAG_OPTION (main group), -C but also from the sub-groups of operations. -C - ELSE IF (OPTION(:3).EQ.'MOD') THEN -C - 120 CONTINUE - UTILOPT = 'MODE' -C - 121 CONTINUE -C -C Display the current status: -C - TXT80 = '!4C\Current environment:' - TXT80(30:) = 'NOCORR' - IF (MODE_CORRDAT) TXT80(30:) = 'CORR' - TXT80(38:) = 'NOTRACE' - IF (MODE_TRACE) TXT80(38:) = 'TRACE' - TXT80(46:) = 'NOSHOW' - IF (MODE_SHOW_CNT) TXT80(46:) = 'SHOW' - TXT80(54:) = 'NODRYRUN' - IF (MODE_DODRYRUN) TXT80(54:) = 'DRYRUN' - CALL WNCTXT (F_T,TXT80) -C - IF (MODE_USERFLAG.NE.0) THEN - I1=1 - IF (MODE_USERFLAG.EQ.FL_ALL) THEN - TXT80(1:6)='ALL=' - I1=7 - ENDIF - MASK=FL_MAN - DO I=1,8 - IF (IAND(MASK,MODE_USERFLAG) .NE.0) THEN - TXT80(I1:I1+5)=CFLAGS(I) - I1=I1+5 - MASK=MASK/2 - ENDIF - ENDDO - CALL WNCTXT (F_T,'!4C\Current USER_FLAGS: !30C!AS',TXT80(1:I1)) - END IF -C -C Prompt the user: -C - 122 CONTINUE - IF (.NOT.WNDPAR('FLAG_MODE',OPER,LEN(OPER), - 1 J0)) THEN ! get one value at a time - IF (E_C.EQ.DWC_ENDOFLOOP) GOTO 122 ! list of values exhausted - GOTO 120 ! ERROR, TRY AGAIN - END IF - IF (J0.EQ.0) OPER='QUIT' ! -C - IF (OPER(:3).EQ.'QUI') THEN - UTILOPT = ' ' - IF (OPTION(:3).EQ.'MOD') THEN !CALLED AS FLAG_OPTION - FLOPT = '""' !DEFAULT FLAG OPTION - GOTO 100 !BACK TO FLAG_OPTION - ELSE !CALLED BY OPS-SUBGROUP - GOTO 101 !BACK TO OPS-SUBGROUP - END IF -C -C Hypercube: -C - ELSE IF (OPER(:3).EQ.'HYP') THEN !HYPERCUBE (POL,IFR,HA) - IF (.NOT.NFLCUB ('SPECIFY','HYPERCUBE',0,0,0,0)) GOTO 120 -C - ELSE IF (OPER(:3).EQ.'SEC') THEN !SETS OF SECTORS - IF (.NOT.NFLCUB ('SPECIFY','SETS',0,0,0,0)) GOTO 120 - IF (.NOT.NFLCUB ('SPECIFY','HYPERCUBE',0,0,0,0)) GOTO 120 -C - ELSE IF (OPER(:4).EQ.'NODE') THEN !SCN NODE - CALL WNFCL(FCAIN) !????? - IF (.NOT.NFLCUB ('SPECIFY','NODE',0,0,0,0)) GOTO 120 - IF (.NOT.NFLCUB ('SPECIFY','SETS',0,0,0,0)) GOTO 120 - IF (.NOT.NFLCUB ('SPECIFY','HYPERCUBE',0,0,0,0)) GOTO 120 -C -!*** USERFLAG (Specify user-flag type(s) to override default type(s)) -C - ELSE IF (OPER(:3).EQ.'UFL') THEN !USER FLAG - CALL WNDDA3('USER_FLAGS',MODE_USERFLAG) !GET USER FLAGS -C -!*** CORRECT/NOCORRECT: -C - ELSE IF (OPER(:4).EQ.'CORR') THEN - MODE_CORRDAT=.TRUE. - ELSE IF (OPER(:4).EQ.'NOCO') THEN - MODE_CORRDAT=.FALSE. -C -!*** SHOW/NOSHOW: -C - ELSE IF (OPER(:4).EQ.'SHOW') THEN - MODE_SHOW_CNT=.TRUE. - ELSE IF (OPER(:4).EQ.'NOSH') THEN - MODE_SHOW_CNT=.FALSE. -C -!*** TRACE/NOTRACE: -C - ELSE IF (OPER(:4).EQ.'TRAC') THEN - MODE_TRACE=.TRUE. - ELSE IF (OPER(:4).EQ.'NOTR') THEN - MODE_TRACE=.FALSE. -C -!*** ESTIMATE DEFAULT CLIP VALUES: -C - ELSE IF (OPER(:3).EQ.'DRY') THEN - MODE_DODRYRUN=.TRUE. - ELSE IF (OPER(:4).EQ.'NODR') THEN - MODE_DODRYRUN=.FALSE. -C - ELSE - CALL WNCTXT(F_TP,'Unknown MODE operation, try again') - END IF -C -C Adapt the transient switches too: -C - USERFLAG = MODE_USERFLAG - CORRDAT = MODE_CORRDAT - TRACE = MODE_TRACE - SHOW_CNT = MODE_SHOW_CNT - DODRYRUN = MODE_DODRYRUN -C - GOTO 121 !BACK TO FLAG_MODE (ALWAYS) -C -C============================================================================= -C OPTION STATIST (Statistics): Can be accessed as FLAG_OPTION (main group), -C but also from the sub-groups of operations. -C - ELSE IF (OPTION(:3).EQ.'STA') THEN - 180 CONTINUE -C - 181 CONTINUE - UTILOPT = 'STAT' -C - IF (.NOT.WNDPAR('OPS_STATIST',OPER,LEN(OPER),J0,'QUIT')) THEN - IF (E_C.EQ.DWC_ENDOFLOOP) GOTO 183 !GO BACK TO FLAG_OPTION (?) - GOTO 181 !ERROR, TRY AGAIN - END IF - IF (J0.EQ.0) GOTO 181 !EMPTY STRING, TRY AGAIN - IF (J0.LT.0) GOTO 181 !WILDCARD, TRY AGAIN -C - 182 CONTINUE - FLOPS = .FALSE. !Default switch - IF (OPER(:3).EQ.'QUI') THEN - 183 CONTINUE - UTILOPT = ' ' - IF (OPTION(:3).EQ.'STA') THEN !CALLED AS FLAG_OPTION - FLOPT = '""' !DEFAULT FLAG OPTION - GOTO 100 !BACK TO FLAG_OPTION - ELSE !CALLED BY OPS-SUBGROUP - GOTO 101 !BACK TO OPS-SUBGROUP - END IF -C - ELSE IF (OPER(:3).EQ.'INS') THEN - GOTO 190 !INSPECT FLAGS - ELSE IF (OPER(:3).EQ.'MOD') THEN - GOTO 120 !CHANGE FLAG_MODES -C - ELSE IF (OPER(:3).EQ.'ACC') THEN !ACCUMULATE STATISTICS - SHOW_CNT = .FALSE. !DO NOT SHOW FLAG-COUNT - FLOPS = .TRUE. - ELSE IF (OPER(:3).EQ.'ACD') THEN !ACCUM. FOR DATA ONLY (?) - SHOW_CNT = .FALSE. !DO NOT SHOW FLAG-COUNT - FLOPS = .TRUE. - ELSE IF (OPER(:3).EQ.'ACH') THEN !ACCUM. FOR HEADERS ONLY - SHOW_CNT = .FALSE. !DO NOT SHOW FLAG-COUNT - FLOPS = .TRUE. -C - ELSE IF (OPER(:6).EQ.'GROUPS') THEN !SHOW DEFINED GROUPS - R0 = NFLST1 ('SHOW','#GROUPS',' ',0,0.,0.) -C - ELSE IF (OPER(:7).EQ.'EXPLAIN') THEN !EXPLAIN STATISTICAL QTS - R0 = NFLST1 ('EXPLAIN','MEAN',TXT80,0,0.,0.) - R0 = NFLST1 ('EXPLAIN','RMS',TXT80,0,0.,0.) - R0 = NFLST1 ('EXPLAIN','RMSMS',TXT80,0,0.,0.) - R0 = NFLST1 ('EXPLAIN','RMSVAR',TXT80,0,0.,0.) - R0 = NFLST1 ('EXPLAIN','DCOFF',TXT80,0,0.,0.) - R0 = NFLST1 ('EXPLAIN','MIN',TXT80,0,0.,0.) - R0 = NFLST1 ('EXPLAIN','MAX',TXT80,0,0.,0.) - R0 = NFLST1 ('EXPLAIN','WTOT',TXT80,0,0.,0.) -C - ELSE IF (OPER(:3).EQ.'SCA') THEN !SHOW SCAN HEADER STATISTICS - R0 = NFLST1 ('SHOW','#SEPAR',' ',0,0.,0.) - TXT80 = 'Some statistics of UNFLAGGED Scan header info.' - R0 = NFLST1 ('SHOW','#TEXT',TXT80,0,0.,0.) - R0 = NFLST1 ('SHOW','#SEPAR',' ',0,0.,0.) - R0 = NFLST1 ('SHOW','#HEADER',' ',0,0.,0.) - R0 = NFLST1 ('SHOW','MAXABCS',' ',1,0.,0.) ! Max(abs(cos),abs(sin)) - R0 = NFLST1 ('SHOW','##REDNS',' ',1,0.,0.) ! Redundancy noise - R0 = NFLST1 ('SHOW','##ALGNS',' ',1,0.,0.) ! Align/Selfcal noise - R0 = NFLST1 ('SHOW','#SEPAR',' ',0,0.,0.) -C - ELSE IF (OPER(:6).EQ.'SINGLE') THEN !SHOW SINGLE-SLOT GROUPS - R0 = NFLST1 ('SHOW','#SEPAR',' ',0,0.,0.) - TXT80 = 'Statistics of all single-slot groups:' - R0 = NFLST1 ('SHOW','#TEXT',TXT80,0,0.,0.) - R0 = NFLST1 ('SHOW','#SEPAR',' ',0,0.,0.) - R0 = NFLST1 ('SHOW','#HEADER',' ',0,0.,0.) - R0 = NFLST1 ('SHOW','#SINGLES',' ',1,0.,0.) - R0 = NFLST1 ('SHOW','#SEPAR',' ',0,0.,0.) -C - ELSE IF (OPER(:5).EQ.'LISTS') THEN - CALL NFLST3 (OPER,' ',' ') ! - ELSE IF (OPER(:5).EQ.'DCOFF') THEN - CALL NFLST3 (OPER,' ',' ') ! -C - ELSE IF (OPER(:5).EQ.'UVDAT') THEN !SHOW DATA STATISTICS - R0 = NFLST1 ('SHOW','#SEPAR',' ',0,0.,0.) - TXT80 = 'Some statistics of UNFLAGGED data.' - R0 = NFLST1 ('SHOW','#TEXT',TXT80,0,0.,0.) - R0 = NFLST1 ('SHOW','#SEPAR',' ',0,0.,0.) - R0 = NFLST1 ('SHOW','#HEADER',' ',0,0.,0.) - R0 = NFLST1 ('SHOW','##DAT_A_',' ',1,0.,0.) ! Amplitudes - R0 = NFLST1 ('SHOW','##DAT_P_',' ',1,0.,0.) ! Phases - R0 = NFLST1 ('SHOW','##DAT_C_',' ',1,0.,0.) ! Cosines - R0 = NFLST1 ('SHOW','##DAT_S_',' ',1,0.,0.) ! Sines - R0 = NFLST1 ('SHOW','#SEPAR',' ',1,0.,0.) -C - ELSE IF (OPER(:2).EQ.'XX' .OR. - 1 OPER(:2).EQ.'XY' .OR. - 1 OPER(:2).EQ.'YX' .OR. - 1 OPER(:2).EQ.'YY') THEN - R0 = NFLST1 ('SHOW','#SEPAR',' ',0,0.,0.) - TXT80 = 'Some statistics of UNFLAGGED data.' - R0 = NFLST1 ('SHOW','#TEXT',TXT80,0,0.,0.) - R0 = NFLST1 ('SHOW','#SEPAR',' ',0,0.,0.) - R0 = NFLST1 ('SHOW','#HEADER',' ',0,0.,0.) - R0 = NFLST1 ('SHOW','##_'//OPER(:2),' ',1,0.,0.) !overall - R0 = NFLST1 ('SHOW','#SEPAR',' ',0,0.,0.) -C - ELSE - CALL NFLST3 ('GROUP',OPER,' ') !SHOW accumulation group - END IF - IF (.NOT.FLOPS) GOTO 181 !Back to OPS_STAT -C -C============================================================================= -C OPTION INSPECT: Can be accessed as FLAG_OPTION (main group), -C but als from the sub-groups of operations. -C - ELSE IF (OPTION(:3).EQ.'INS') THEN -C - 190 CONTINUE -C - CALL WNCTXT (F_T,' ') - CALL WNCTXT (F_T,'You may now inspect a summary of the' - 1 //' flags that were counted during ') - CALL WNCTXT (F_T,'the last flagging operation.') - CALL WNCTXT (F_T,'Use COUNT to count ALL flags in' - 1 //' (a sub-cube of) the specified data hyper-cube.') - CALL WNCTXT (F_T,' ') -C - 191 CONTINUE - UTILOPT = 'INSPECT' -C - IF (.NOT.WNDPAR('OPS_INSPECT',OPER,LEN(OPER),J0,'QUIT')) THEN - IF (E_C.EQ.DWC_ENDOFLOOP) GOTO 193 !GO BACK TO FLAG_OPTION (?) - GOTO 191 !ERROR, TRY AGAIN - END IF - IF (J0.EQ.0) GOTO 191 !EMPTY STRING, TRY AGAIN - IF (J0.LT.0) GOTO 191 !WILDCARD, TRY AGAIN -C - 192 CONTINUE - IF (OPER(:3).EQ.'QUI') THEN - 193 CONTINUE - UTILOPT = ' ' - IF (OPTION(:3).EQ.'INS') THEN !CALLED AS FLAG_OPTION - FLOPT = '""' !DEFAULT FLAG OPTION - GOTO 100 !BACK TO FLAG_OPTION - ELSE !CALLED BY OPS-SUBGROUP - GOTO 101 !BACK TO OPS-SUBGROUP - END IF -C - ELSE IF (OPER(:3).EQ.'STA') THEN !STATISTICS - GOTO 180 -C - ELSE IF (OPER(:3).EQ.'CLE') THEN !CLEAR FLAGS - CONTINUE - ELSE IF (OPER(:3).EQ.'CLD') THEN !CLEAR DATA FLAGS - CONTINUE - ELSE IF (OPER(:3).EQ.'CLH') THEN !CLEAR HEADER FLAGS - CONTINUE -C - ELSE IF (OPER(:3).EQ.'COU') THEN !COUNT FLAGS - CONTINUE !TO FLAGGING OPERATIONS -C - ELSE IF ((OPER(:3).EQ.'FTY') .OR. - 1 (OPER(:2).EQ.'HA') .OR. - 1 (OPER(:3).EQ.'CHA') .OR. - 1 (OPER(:3).EQ.'TEL') .OR. - 1 (OPER(:3).EQ.'IFR')) THEN - TXT80 = OPER(:3) !TRANSFER INPUT STRING - TXT80 = OPER !Temporary - IF (INDEX(OPER,'_').GT.0) THEN - CALL WNCTXT (F_T,'Switch detected: '//OPER(3:)) - END IF - JS = NFLCNT('SHOW',TXT80,0,0,0,0,0) !SHOW FLAGS IN VARIOUS PROJ. - GOTO 191 -C - ELSE - CALL WNCTXT(F_TP,'Unknown INSPECT operation, try again') - GOTO 191 !BACK TO OPS_INSPECT - END IF -C -C============================================================================= -C UNKNOWN OPTION: -C - ELSE - CALL WNCTXT(F_TP,'Unknown FLAG_OPTION, try again') - GOTO 100 !BACK TO FLAG_OPTION - END IF -C -C***************************************************************************** -C***************************************************************************** -C***************************************************************************** -C FLAGGING OPERATIONS: -C -C Execute the specified flagging operation: -C - CALL NFLOPS (OPER,USERFLAG,CORRDAT, - 1 SHOW_CNT,TRACE,DODRYRUN) -C -C When the operation is finished, return to the relevant operations-group: -C - IF (OPTION.EQ.' ') GOTO 100 !BACK TO FLAG_OPTION - GOTO 101 !BACK TO GROUP OF OPERATIONS -C -C************************************************************************** -C Finished all flagging operations: -C - 800 CONTINUE -C -C Make sure that the flag-list area has gone properly: -C - JS=NFLFL9(DFAR) -C - RETURN - END diff --git a/src/nscan/nflget.for b/src/nscan/nflget.for deleted file mode 100644 index 7c25753098c7643c951b48b2ea526d725836252b..0000000000000000000000000000000000000000 --- a/src/nscan/nflget.for +++ /dev/null @@ -1,539 +0,0 @@ -C+ NFLGET.FOR -C JEN 931111 -C -C Updates: -C 940415 CMV Correct bug on HP (L = IAND does not work) -C -CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC -C - SUBROUTINE NFLGET (OPER,USERFLAG,DFAR, - 1 SHOW_CNT,TRACE) -C -C Make an internal flag list (FLF) from the (specified, USERFLAG) flags that -C are set in the Scan headers and/or the uv-data in the specified hypercube. -C -C Result: -C -C CALL NFLGET (OPER_C(*):I,USERFLAG_J:I,DFAR_J:IO -C SHOW_CNT_L:I,TRACE_L:I) -C -C PIN references: -C -C Include files: -C - INCLUDE 'WNG_DEF' - INCLUDE 'NFL_DEF' - INCLUDE 'CBITS_DEF' - INCLUDE 'STH_O_DEF' !SET HEADER - INCLUDE 'SCH_O_DEF' !SCAN HEADER - INCLUDE 'FLH_O_DEF' !DELETE FILE HEADER - INCLUDE 'FLF_O_DEF' !ENTRY HEADER -C -C Parameters: -C - INTEGER XX,XY,YX,YY !POL. POINTERS - PARAMETER (XX=0, XY=1, YX=2, YY=3) -C - REAL VERYLARGE !VERY LARGE VALUE - PARAMETER (VERYLARGE = 1.E38) -C - INTEGER MXNFLTYP - PARAMETER (MXNFLTYP=8) -C -C Arguments: -C (NB: NODIN, FCAIN and SETS are in common block) -C - CHARACTER OPER*(*) !SELECTED OPERATION -C - INTEGER USERFLAG !FLAGBYTE (FOR USER OVERRIDE) - INTEGER DFAR !FLAG FILE AREA CONTROL PAR -C - LOGICAL SHOW_CNT !SHOW FLAG-COUNT AFTER OPS - LOGICAL TRACE !TRACE/DEBUG FLAGGING OPERATION -C -C Function references: -C - LOGICAL WNDPAR !GET DWARF PARAMETER - LOGICAL WNFRD !READ DATA - LOGICAL WNFWR !WRITE DATA - CHARACTER*32 WNTTSG !SET NAME - LOGICAL WNDSTQ !GET SETS - INTEGER WNCAJ !GET INTEGER FROM TEXT - LOGICAL NSCSTG !GET A SET - LOGICAL NSCSCH,NSCSCW !READ/WRITE SCAN HEADER - LOGICAL NSCSIF !READ INTERFEROMETER TABLE - LOGICAL NFLFL0,NFLFL1 !FLAG FILE HANDLING - LOGICAL NFLCUB !DATA SUB/HYPERCUBE - LOGICAL NFLCNT !FLAG COUNTING -C -C Data declarations: -C -C----------------------------------------------------------------------- -C -C "Static variables" -C -C Look-up table to find existence and offset for polarisations -C depending on the number of polarisations present in the data -C - INTEGER PPOL(XX:YY,1:4,0:1) !POL. SELECT XX,XY,YX,YY FOR - ! NPOL=1:4: -C OLD: DATA PPOL/1,0,0,0, 1,0,0,8, 0,0,0,0, 1,2,4,8, !BITS - DATA PPOL/XX_P,0,0,0, XX_P,0,0,YY_P, 0,0,0,0, - 1 XX_P,XY_P,YX_P,YY_P, !BITS - 1 0,0,0,0, 0,0,0,1, 0,0,0,0, 0,1,2,3/ !OFFSETS -C - INTEGER FLAGTYPE(0:MXNFLTYP-1) - DATA FLAGTYPE /FL_MAN,FL_CLIP,FL_NOIS,FL_ADD, - 1 FL_SHAD,FL_3,FL_2,FL_1/ -C----------------------------------------------------------------------- -C -C Variables with user-input, defaults and direct derivatives -C - INTEGER I6,I7,I8,I9 !LOOP VARIABLES - INTEGER NOPER !CURRENT OPERATION NR - INTEGER CHCUR !CURRENT CHANNEL - REAL HAMIN,HAMAX !HA-range of list-entry - REAL HACUR,HANEXT !CURRENT AND NEXT HA - REAL HAMARGIN !HA MARGIN - LOGICAL TYPIFR !ENTRY TYPE IS IFR-TYPE - INTEGER SELFLAG !GLOBAL FLAGBYTE TO BE USED - INTEGER FLAGH,FLAGD !HEADER/DATA FLAGBYTE - INTEGER EFLAG !FLAGBYTE FOR LIST ENTRY - INTEGER RTW,RTE !WEST,EAST TEL NR - LOGICAL LASTSCAN !INDICATES LAST SCAN IN SECTOR - INTEGER NENT !NR OF FLF ENTRIES (1 OR 2) - INTEGER*2 NPOLS !Pol counter -C - LOGICAL SELPOL(0:3) !POL. SELECTION - BYTE SELIFR(0:STHTEL-1,0:STHTEL-1) !IFR SELECTION - REAL SELHA(0:1) !HA-RANGE SELECTION -C -C----------------------------------------------------------------------- -C -C Storage areas, buffer arrays -C - REAL HASERH (0:1,0:MXNFLTYP-1) !GET HA-series accum. array (headers) - REAL HASERD (0:1,0:MXNFLTYP-1,-1:3,0:STHIFR-1) !idem for data - LOGICAL FLAGGED(0:3,0:MXNFLTYP-1) !Indicator switches - LOGICAL NODATA(0:3) !Indicator switches -C - INTEGER FLACC(0:STHIFR-1,0:3) !FLAG COUNTS - INTEGER MASK(0:STHIFR-1,0:3) !FLAG COUNT MASKS -C - CHARACTER*80 TXT80 !TEXT BUFFER -C - INTEGER SNAM(0:7) !SET NAME - INTEGER STHP !SET HEADER POINTER - BYTE STH(0:STH__L-1) !SET HEADER - INTEGER*2 STHI(0:STH__L/LB_I-1) - INTEGER STHJ(0:STH__L/LB_J-1) - REAL STHE(0:STH__L/LB_E-1) - DOUBLE PRECISION STHD(0:STH__L/LB_D-1) - EQUIVALENCE (STH,STHJ,STHI,STHE,STHD) - BYTE SCH(0:SCH__L-1) !SCAN HEADER - INTEGER*2 SCHI(0:SCH__L/LB_I-1) - INTEGER SCHJ(0:SCH__L/LB_J-1) - REAL SCHE(0:SCH__L/LB_E-1) - EQUIVALENCE (SCH,SCHJ,SCHI,SCHE) -C - INTEGER*2 IFRT(0:STHIFR-1) !INTERFEROMETER TABLE - INTEGER IFRA(0:1,0:STHIFR-1) !RTWEST(0), RTEAST(1) - REAL ANG(0:2,STHIFR-1) !DIPOLE ANGLE INFORMATION -C - INTEGER*2 LDAT(0:2,0:4*STHIFR-1) !DATA -C - BYTE FLH(0:FLH__L-1) !FLAG FILE HEADER - INTEGER FLHJ(0:FLH__L/LB_J-1) - REAL FLHE(0:FLH__L/LB_E-1) - EQUIVALENCE (FLH,FLHJ,FLHE) - BYTE FLF(0:FLF__L-1,2) !FLAG FILE ENTRIES (RANGE) - INTEGER*2 FLFI(0:FLF__L/LB_I-1,2) - INTEGER FLFJ(0:FLF__L/LB_J-1,2) - REAL FLFE(0:FLF__L/LB_E-1,2) - EQUIVALENCE (FLF,FLFI,FLFJ,FLFE) -C- -C****************************************************************************** -C***************************************************************************** -C***************************************************************************** -C -C Only specified flag types are GOT. The default is all flag-types, -C unless the flag-types are explicitly given (USERFLAG>0). -C The user may locally override the flag-types. -C - CALL WNCTXT (F_TP,'Only GET flags of the following type(s):') - IF (TRACE) CALL WNCTXT (F_T,'NFLGET: USERFLAG=!SJ',USERFLAG) - SELFLAG=FL_ALL !DEFAULT FLAG TYPE(S): ALL TYPES - IF (USERFLAG.NE.0) SELFLAG=USERFLAG !OVERRIDE BY USER-DEFINED FLAG TYPE(S) - CALL WNDDA3 ('USER_FLAG',SELFLAG) !ASK THE USER - IF (SELFLAG.EQ.0) THEN !NONE: ESCAPE - CALL WNCTXT (F_TP,'No flag type(s) to be GOT.') - GOTO 700 !ESCAPE - END IF -C -C Select sub-cube of the uv-data hypercube (specified before): -C - IF (.NOT.NFLCUB('SELECT','HYPERCUBE',0, - 1 SELHA,SELPOL,SELIFR)) GOTO 700 - IF (.NOT.NFLCUB('SPECIFY','SUBCUBE',0, - 1 SELHA,SELPOL,SELIFR)) GOTO 700 -C -C Reset the flag count buffers: -C - JS = NFLCNT ('RESET',' ',0,0,0,0) -C -C***************************************************************************** -C Read Set(s) of Sectors: -C - DO WHILE (NSCSTG(FCAIN,SETS,STH,STHP,SNAM)) !ALL SETS - IF (.NOT.NSCSIF(FCAIN,STH,IFRT,IFRA,ANG)) THEN !READ IFR TABLE - CALL WNCTXT(F_TP,'Error reading interferometer table') - GOTO 30 !PROBLEM, NEXT SECTOR - END IF -C - CHCUR=STHI(STH_CHAN_I) !CURRENT CHANNEL NR -C - IF (.NOT.NFLCUB('ADJUST','SELPOL',STHI(STH_PLN_I), - 1 SELHA,SELPOL,SELIFR)) GOTO 30 !PROBLEM, NEXT SECTOR -C -C Initialise the accumulator arrays for HA-series: -C - DO I4=0,MXNFLTYP-1 !FLAG-TYPES - HASERH(0,I4) = VERYLARGE !DISABLE HAMIN - HASERH(1,I4) = VERYLARGE !DISABLE HAMAX - DO I1=0,STHIFR-1 !IFRS - DO I3=-1,3 !POLS - HASERD(0,I4,I3,I1) = VERYLARGE !DISABLE HAMIN - HASERD(1,I4,I3,I1) = VERYLARGE !DISABLE HAMAX - END DO - END DO - END DO -C -C****************************************************************************** -C ACT ON HA-SCANS (if required): -C - LASTSCAN = .FALSE. !IF TRUE, FLUSH ACCUMULATOR -C - DO I=0,STHJ(STH_SCN_J)-1 !ALL SCANS - HACUR=STHE(STH_HAB_E)+I*STHE(STH_HAI_E) !HA OF SCAN - HANEXT=HACUR+STHE(STH_HAI_E) !HA OF NEXT SCAN - HAMARGIN = STHE(STH_HAI_E)/2-1E-5 - IF ((HANEXT-HAMARGIN).GT.SELHA(1)) LASTSCAN=.TRUE. - IF (I.GE.STHJ(STH_SCN_J)-1) LASTSCAN = .TRUE. - IF (HACUR.GE.(SELHA(0)-HAMARGIN).AND. - 1 HACUR.LE.(SELHA(1)+HAMARGIN)) THEN !SCAN IN HYPERCUBE -C - IF (.NOT.NSCSCH(FCAIN,STH,IFRT,I,0,0,SCH)) THEN !READ HEADER - CALL WNCTXT(F_TP,'Error reading scan header !UJ',I) - GOTO 30 - END IF -C - DO I1=0,STHIFR-1 - DO I3=0,3 - FLACC(I1,I3) = 0 !FLAG COUNTERS - MASK(I1,I3) = 0 - END DO - END DO -C -C======================================================================= -C -! If the specified flags types are set in the Scan header, -! write an entry in the flag-list with ifrs=* (all) and pols=* (all). -C - FLAGH = SCHJ(SCH_BITS_J) !HEADER FLAGBYTE - EFLAG = IAND(SELFLAG,FLAGH) !SELECTED FLAG(S) ONLY - IF (EFLAG.NE.0) THEN !HEADER FLAG(S) SET -C - DO I4=0,MXNFLTYP-1 !ALL FLAG-TYPES - IF (IAND(EFLAG,FLAGTYPE(I4)).NE.0) THEN !FLAG-TYPE PRESENT - HASERH(1,I4) = HACUR !UPDATE HAMAX - IF (HASERH(0,I4).GT.HACUR) THEN !NEW SERIES - HASERH(0,I4) = HACUR !HAMIN OF NEW SERIES - END IF - END IF - END DO -C - JS = NFLCNT ('ACC','HEAD',EFLAG,SELFLAG, - 1 IFRA,CHCUR,HACUR) !COUNT ENTRY FLAGS -C -C If a Scan is flagged, all its data are flagged. This means that -C it is not necessary to interrupt any `active' flag-series for individual -C ifrs. This keeps the nr of flag-list entries to a minimum. -C - DO I4=0,MXNFLTYP-1 !ALL FLAG_TYPES - IF (IAND(FLAGTYPE(I4),EFLAG).NE.0) THEN !ENTRY-TYPES ONLY!? - DO I1=0,STHIFR-1 !ALL IFRS - DO I3=-1,3 !ALL POLS (INCL -1) - HAMAX = HASERD(1,I4,I3,I1) !LAST HA OF SERIES - IF (HAMAX.LE.HACUR) THEN !ACTIVE SERIES - HASERD(1,I4,I3,I1) = HACUR !CONTINUE IT - END IF - END DO - END DO - END IF - END DO -C -C======================================================================= -C -! Else, go through the (hypercube) uv-data in this Scan, and generate -! a separate list-entry for each data-point for which flags of -! the specified type(s) have been set: -C - ELSE - IF (.NOT.WNFRD(FCAIN,STHJ(STH_SCNL_J)-SCH__L, - 1 LDAT,STHJ(STH_SCNP_J)+I*STHJ(STH_SCNL_J)+ - 1 SCH__L)) THEN !READ SCAN DATA - CALL WNCTXT(F_TP,'Error reading scan !UJ',I) - GOTO 700 - END IF -C - DO I1=0,STHJ(STH_NIFR_J)-1 !ALL IFRS - RTW = MOD(IFRT(I1),256) !WEST TEL - RTE = IFRT(I1)/256 !EAST TEL - IF (SELIFR(RTW,RTE)) THEN !SELECTED IFR - I2=STHI(STH_PLN_I)*I1 !DATA POINTER - DO I3=0,3 !ALL POLS - NODATA(I3) = .FALSE. !RESET INDICATORS - DO I4=0,MXNFLTYP-1 - FLAGGED(I3,I4) = .FALSE. !RESET INDICATORS - END DO - IF (SELPOL(I3)) THEN !SELECTED POL - I4=I2+PPOL(I3,STHI(STH_PLN_I),1) !OFFSET - I5=LDAT(0,I4) !WEIGHT/FLAGS - I5=IAND('0000ffff'X,I5) !WEIGHT/FLAGS - IF (I5.NE.0) THEN !DATA PRESENT (NON-ZERO WEIGHT) -C - I5 = IAND(I5,SELFLAG) !SPECIFIED FLAGS ONLY - IF (I5.NE.0) THEN !SPEC. FLAG(S) SET - DO I4=0,MXNFLTYP-1 !ALL FLAG-TYPES - FLAGGED(I3,I4) = - 1 (IAND(I5,FLAGTYPE(I4)).NE.0) - END DO - FLACC(I1,I3) = IAND(SELFLAG,I5) !COUNT ENTRY FLAGS - MASK(I1,I3) = SELFLAG !MASK USED FOR THIS - END IF -C - ELSE - NODATA(I3) = .TRUE. !NO DATA PRESENT - END IF ! - END IF !POL SELECTED - END DO !POLS (I3) -C -C If no data, consider the point flagged for `active' flag-series. -C This will prevent an active series to be broken by absent data. -C NB: This works for flag-series for individual ifrs/pols, but not yet -C for ifrs for which all pols (*) are flagged. -C - DO I3=0,3 !ALL POLS - IF (NODATA(I3)) THEN !NO DATA PRESENT - DO I4=0,MXNFLTYP-1 !ALL FLAG_TYPES - HAMAX = HASERD(1,I4,I3,I1) !LAST HA IN SERIES - IF (HAMAX.LE.HACUR) THEN !IF `ACTIVE' THEN - FLAGGED(I3,I4) = .TRUE. !CONSIDER IT FLAGGED - END IF - END DO - END IF - END DO -C -C If, for the current ifr (I1), one of the specified flagtypes is set for -C a particular pol (I3) and flagtype(I4), indicate this by setting the -C maximum of the HA-range to the HA of the current Scan (HACUR). -C If the minimum of this HA-range is greater than HACUR, this indicates that -C this is a new HA-range: So the minimum HA is set equal to HACUR also. -C NB: If all 4 pols are flagged (NPOLS=4), use the special slot I3=-1 -C - DO I4=0,MXNFLTYP-1 !FLAG-TYPES - NPOLS = 0 - DO I3=0,3 - IF (FLAGGED(I3,I4)) NPOLS=NPOLS+1 - END DO - IF (NPOLS.EQ.STHI(STH_PLN_I)) THEN !ALL POLS FLAGGED - HASERD(1,I4,-1,I1) = HACUR !NEW HAMAX for POL=-1 - IF (HASERD(0,I4,-1,I1).GT.HACUR) THEN - HASERD(0,I4,-1,I1) = HACUR !NEW HAMIN for POL=-1 - END IF - ELSE - DO I3=0,3 - IF (FLAGGED(I3,I4)) THEN - HASERD(1,I4,I3,I1) = HACUR !NEW HAMAX FOR POL=I3 - IF (HASERD(0,I4,I3,I1).GT.HACUR) THEN - HASERD(0,I4,I3,I1) = HACUR !NEW HAMIN FOR POL=I3 - END IF - END IF - END DO - ENDIF - END DO -C -C NEXT IFR -C - END IF !IFR SELECTED - END DO !IFRS (I1) - -C -C***************************************************************************** -C -C FINISH THE SCAN -C - END IF !HEADER/DATA -C -C For each flagtype (I4), check whether a continuously flagged HA-series -C is `broken' by an unflagged Scan or uv-point. -C This is the case if the maximum HA (HAMAX) of such a HA-series -C is smaller than the HA of the current Scan (HACUR). -C If so, generate new FLF entry in the flag-list for this HA-range. -C NB: A flagged uv-area is described by two FLF entries (NENT=2), -C while a single flagged uv-`point' (which may contain wildcards) -C is described by a single FLF entry (NENT=1). -C -C First the Scan headers: -C - DO I4=0,MXNFLTYP-1 - HAMAX = HASERH(1,I4) !MAX HA OF SERIES - IF (HAMAX.LE.HACUR) THEN !VALID SERIES - IF (LASTSCAN.OR.(HAMAX.LT.HACUR)) THEN !SERIES ENDED -C - FLFJ(FLF_FLAG_J,1)=FLAGTYPE(I4) !FLAGBYTE - FLFJ(FLF_FLAG_J,2)=FLAGTYPE(I4) !FLAGBYTE - FLFE(FLF_HA_E,1)=HASERH(0,I4) !MIN HA - FLFE(FLF_HA_E,2)=HASERH(1,I4) !MAX HA - FLFJ(FLF_CHAN_J,1)=CHCUR !MIN CHANNEL NR - FLFJ(FLF_CHAN_J,2)=CHCUR !MAX CHANNEL NR - FLFI(FLF_IFR_I,1)=-1 !ALL IFRS - FLFI(FLF_POL_I,1)=-1 !ALL POLS -C - NENT = 1 !1 FLF ENTRY - HAMIN = HASERH(0,I4) !MIN HA OF SERIES - IF (HAMAX.GT.HAMIN) NENT=2 !2 FLF ENTRIES - FLFJ(FLF_FLAG_J,1) = - 1 IOR(FLFJ(FLF_FLAG_J,1),NENT-1) - FLFJ(FLF_FLAG_J,2) = - 1 IOR(FLFJ(FLF_FLAG_J,2),2) - DO I7=1,NENT !1 OR 2 FLF ENTRIES - IF (TRACE) THEN - CALL WNCTXT (F_T,' NFLGET: FLF scan: ' - 1 //'flag=!UJ HA=!F7.2 - !F7.2' - 1 ,FLFJ(FLF_FLAG_J,1) - 1 ,FLFE(FLF_HA_E,1)*360 - 1 ,FLFE(FLF_HA_E,2)*360) - END IF - IF (.NOT.NFLFL1(DFAR,FLF(0,I7))) THEN - CALL WNCTXT(F_TP,'Error writing FLF entry') - GOTO 700 !PROBLEM, ESCAPE - END IF - END DO -C - HASERH(0,I4) = VERYLARGE !DEACTIVATE SERIES - HASERH(1,I4) = VERYLARGE ! - END IF - END IF - END DO !FLAG-TYPES -C -C Then the uv-data: -C - DO I1=0,STHIFR-1 !ALL IFRS - DO I3=-1,3 !POLS - DO I4=0,MXNFLTYP-1 !FLAG-TYPES - HAMAX = HASERD(1,I4,I3,I1) !MAX HA - IF (HAMAX.LE.HACUR) THEN - IF (LASTSCAN.OR.(HAMAX.LT.HACUR)) THEN -C - FLFJ(FLF_FLAG_J,1)=FLAGTYPE(I4) !FLAGBYTE - FLFJ(FLF_FLAG_J,2)=FLAGTYPE(I4) !FLAGBYTE -C - FLFE(FLF_HA_E,1)=HASERD(0,I4,I3,I1) !MIN HA - FLFE(FLF_HA_E,2)=HASERD(1,I4,I3,I1) !MAX HA -C - FLFJ(FLF_CHAN_J,1)=CHCUR !MIN CHANN NR - FLFJ(FLF_CHAN_J,2)=CHCUR !MAX CHANN NR - FLFI(FLF_IFR_I,1)=IFRT(I1) !MIN IFR NR - FLFI(FLF_IFR_I,2)=IFRT(I1) !MAX IFR NR -C .... What about the TEL type of entry? .... -C - FLFI(FLF_POL_I,1)=I3 !MIN POL NR - FLFI(FLF_POL_I,2)=I3 !MIN POL NR - IF (I3.EQ.-1) FLFI(FLF_POL_I,1)=-1 !WILDCARD (ALL) -C - NENT = 1 !1 FLF ENTRY - HAMIN = HASERD(0,I4,I3,I1) !MIN HA - IF (HAMAX.GT.HAMIN) NENT = 2 !2 FLF ENTRIES - FLFJ(FLF_FLAG_J,1) = - 1 IOR(FLFJ(FLF_FLAG_J,1),NENT-1) - FLFJ(FLF_FLAG_J,2) = - 1 IOR(FLFJ(FLF_FLAG_J,2),2) - DO I7=1,NENT !1 OR 2 FLF ENTRIES - IF (TRACE) THEN - CALL WNCTXT (F_T,' NFLGET: FLF data: ' - 1 //'flag=!UJ ifr=!UI pol=!UI ' - 1 //' HA=!F7.2 - !F7.2' - 1 ,FLFJ(FLF_FLAG_J,1) - 1 ,FLFI(FLF_IFR_I,1) - 1 ,FLFI(FLF_POL_I,1) - 1 ,FLFE(FLF_HA_E,1)*360 - 1 ,FLFE(FLF_HA_E,2)*360) - END IF - IF (.NOT.NFLFL1(DFAR,FLF(0,I7))) THEN - CALL WNCTXT(F_TP,'Error writing FLF entry') - GOTO 700 !PROBLEM, ESCAPE - END IF - END DO -C - HASERD(0,I4,I3,I1) = VERYLARGE !INITIALISE HAMIN - HASERD(1,I4,I3,I1) = VERYLARGE !INITIALISE HAMAX - END IF - END IF - END DO !FLAG TYPES - END DO !POLS - END DO !IFRS -C -C---------------------------------------------------------------------------- -C -C NEXT SCAN: -C - JS = NFLCNT ('ACC','DATA',FLACC,MASK, - 1 IFRA,CHCUR,HACUR) !COUNT ENTRY FLAGS -C - END IF !WITHIN HYP HA-RANGE - END DO !NEXT SCAN -C -C**************************************************************************** -C**************************************************************************** -C -C NEXT SECTOR (if any): -C - 30 CONTINUE - END DO !NEXT SECTOR -C -C************************************************************************** -C FINISHED NORMALLY: -C -C Display a summary of flags, if required: -C - IF (SHOW_CNT) THEN - JS = NFLCNT ('SHOW','FTYP',0,0,0,0,0) - CALL WNCTXT (F_T, - 1 'NB: Tested and counted are ONLY' - 1 //' those flags that were GOT by the last') - CALL WNCTXT (F_T, - 1 'GET operation, and added to the flag-list.' - 1 //' Use INSPECT for a closer look.') - CALL WNCTXT (F_T,' ') - END IF -C -C************************************************************************** -C END OF (OR ESCAPE FROM) OPERATION: -C - 700 CONTINUE -C - GOTO 800 !BACK TO OPS_FLIST -C -C************************************************************************** -C************************************************************************** -C READY -C - 800 CONTINUE - RETURN !BACK TO FLAG_OPTION - END - - - - - diff --git a/src/nscan/nflini.for b/src/nscan/nflini.for deleted file mode 100644 index 4147c4094a7b0eaf0561724ec6f645a43d153cb1..0000000000000000000000000000000000000000 --- a/src/nscan/nflini.for +++ /dev/null @@ -1,52 +0,0 @@ -c+ NFLINI.FOR -C WNB 930618 -C -C Revisions: -C - SUBROUTINE NFLINI -C -C Initialize NFLAG program -C -C Result: -C -C CALL NFLINI will set header lines, logging, DWARF interface -C -C Include files: -C - INCLUDE 'WNG_DEF' -C -C Parameters: -C -C -C Arguments: -C -C -C Function references: -C - LOGICAL WNDINI !INIT DWARF - LOGICAL WNDDAB !OPEN DATABASE -C -C Data declarations: -C -C- -C -C SET HEADER LINES -C - CALL WNCFHD(F_P,1,'!40C\Program to handle SCN files') -C -C START DWARF -C - IF (.NOT.WNDINI(PRGNAM)) CALL WNGEX !EXIT IF NO DWARF START -C -C LOGGING -C - CALL WNDLOG(LOGCD) !PROPER LOGGING -C -C DATABASE -C - IF (.NOT.WNDDAB()) CALL WNGEX !OPEN DATABASE -C - RETURN !READY -C -C - END diff --git a/src/nscan/nflist.for b/src/nscan/nflist.for deleted file mode 100644 index 2808a2d62f5d06f617b3a2047237f2e23d5fcad4..0000000000000000000000000000000000000000 --- a/src/nscan/nflist.for +++ /dev/null @@ -1,485 +0,0 @@ -C+ NFLIST.FOR -C JEN 930916 -C -C Revisions: -C CMV 940203 Added nodename and sets to NFLFL7 call -C -CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC -C - SUBROUTINE NFLIST (OPER,USERFLAG,DFAR, - 1 SHOW_CNT,TRACE) -C -C Interactions with the internal flag-list (FLF), incl. GET/PUT operations. -C -C Result: -C -C CALL NFLIST (OPER_C(*):I,USERFLAG_J:I,DFAR_J:IO, -C SHOW_CNT_L:I,TRACE_L:I) -C -C PIN references: -C -C Include files: -C - INCLUDE 'WNG_DEF' - INCLUDE 'NFL_DEF' - INCLUDE 'CBITS_DEF' - INCLUDE 'STH_O_DEF' !SET HEADER - INCLUDE 'SCH_O_DEF' !SCAN HEADER - INCLUDE 'FLH_O_DEF' !DELETE FILE HEADER - INCLUDE 'FLF_O_DEF' !ENTRY HEADER -C -C Parameters: -C - INTEGER XX,XY,YX,YY !POL. POINTERS - PARAMETER (XX=0, XY=1, YX=2, YY=3) -C - INTEGER MXNFLTYP !NR OF FLAG TYPES - PARAMETER (MXNFLTYP=8) -C -C Arguments: -C (NB: NODIN, FCAIN and SETS are in common block) -C - CHARACTER OPER*(*) !SELECTED OPERATION -C - INTEGER USERFLAG !FLAGBYTE (FOR USER OVERRIDE) - INTEGER DFAR !FLAG-LIST AREA CONTROL PAR -C - LOGICAL SHOW_CNT !SHOW FLAG-COUNT AFTER OPS - LOGICAL TRACE !TRACE THE FLAGGING OPS -C -C Function references: -C - LOGICAL WNDPAR !GET DWARF PARAMETER - LOGICAL WNFRD !READ DATA - LOGICAL WNFWR !WRITE DATA - CHARACTER*32 WNTTSG !SET NAME - LOGICAL WNDSTQ !GET SETS - INTEGER WNCAJ !GET INTEGER FROM TEXT - LOGICAL NSCSTG !GET A SET - LOGICAL NSCSCH,NSCSCW !READ/WRITE SCAN HEADER - LOGICAL NSCSIF !READ INTERFEROMETER TABLE - LOGICAL NFLFL0,NFLFL1,NFLFL2 !FLAG FILE HANDLING - LOGICAL NFLFL5,NFLFL6 - LOGICAL NFLFL7,NFLFL8,NFLFL9 - LOGICAL NFLFLS,NFLFLR - LOGICAL NFLCNT !FLAG COUNTING -C -C Data declarations: -C - INTEGER I6,I7,I8,I9 !LOOP VARIABLES - LOGICAL TYPIFR !ENTRY TYPE IS IFR-TYPE - INTEGER NIFRTYP,NBASTYP !NR OF EITHER TYPE - INTEGER IFRMIN,IFRMAX !MIN, MAX IFR NR - INTEGER IPOLMIN,IPOLMAX !MIN, MAX POL NR - INTEGER RTW,RTE !WEST, EAST TEL NR - INTEGER RTW1,RTW2 !WEST TEL NRS - INTEGER RTE1,RTE2 !EAST TEL NRS - INTEGER RTWMIN,RTWMAX !MIN, MAX WEST TEL NR - INTEGER RTEMIN,RTEMAX !MIN, MAX EAST TEL NR - INTEGER ICHMIN,ICHMAX !MIN, MAX FREQU CHANN NR - REAL HAMIN,HAMAX !MIN, MAX HA (CIRCLES) - REAL HA1,HA2,HA3 !HA LOOP PARAMETERS (CIRCLES) - INTEGER BAS,BASMIN,BASMAX !BASELINE LENGTH (PUT, M) - INTEGER CHCUR !CURRENT CHANNEL - REAL HACUR !CURRENT HA - INTEGER LLENGTH !CURRENT LIST LENGTH -C -C Names of things etc: -C - CHARACTER*1 TELNAM(0:STHTEL-1) !TELESCOPE NAMES (WSRT) - DATA TELNAM/'0','1','2','3','4','5','6','7', - 1 '8','9','A','B','C','D'/ -C - CHARACTER*2 POLNAM(0:3) !POLARISATION NAMES (WSRT) - DATA POLNAM/'XX','XY','YX','YY'/ -C - CHARACTER*4 FLAGNAM(0:MXNFLTYP-1) !FLAG NAMES (WSRT) - DATA FLAGNAM/' MAN','CLIP','NOIS',' ADD', - 1 'SHAD',' U3',' U2',' U1'/ -C - INTEGER FLAGTYP(0:MXNFLTYP-1) !FLAG TYPES (WSRT) - DATA FLAGTYP/FL_MAN,FL_CLIP,FL_NOIS,FL_ADD, - 1 FL_SHAD,FL_3,FL_2,FL_1/ -C - -C Flow control -C - INTEGER FLAG !FLAGBYTE - INTEGER SELFLAG !SELECTED FLAG TYPE(S) - INTEGER FLAGH !FLAGBYTE FOR SCAN HEADER - INTEGER FLAGD !FLAGBYTE FOR UV-DATUM -C -C Storage areas, buffer arrays -C - CHARACTER*80 TXT80 !TEXT BUFFER - INTEGER FLACC(0:STHIFR-1,0:3) !FLAG COUNTS - INTEGER MASK(0:STHIFR-1,0:3) !FLAGBYTES USED -C - INTEGER IFRA(0:1,0:STHIFR-1) !RTWEST(0), RTEAST(1) - REAL BASEL(0:STHIFR-1) !BASELINE TABLE (M) -C - BYTE FLH(0:FLH__L-1) !FLAG FILE HEADER - INTEGER FLHJ(0:FLH__L/LB_J-1) - REAL FLHE(0:FLH__L/LB_E-1) - EQUIVALENCE (FLH,FLHJ,FLHE) - BYTE FLF(0:FLF__L-1,2) !FLAG FILE ENTRIES (RANGE) - INTEGER*2 FLFI(0:FLF__L/LB_I-1,2) - INTEGER FLFJ(0:FLF__L/LB_J-1,2) - REAL FLFE(0:FLF__L/LB_E-1,2) - EQUIVALENCE (FLF,FLFI,FLFJ,FLFE) -C- -C****************************************************************************** -C***************************************************************************** -C***************************************************************************** -C -C Always: Create the flag list area if it does not exist already, -C i.e. if DFAR=0: -C - IF (.NOT.NFLFL0(DFAR)) THEN - CALL WNCTXT(F_TP,'Error getting flag file/area') - GOTO 800 - END IF - JS = NFLFLS (DFAR,FLH) !READ FLAG-LIST HEADER - LLENGTH = FLHJ(FLH_FLFN_J) !NR OF SINGLE ENTRIES -C -C Take action according to the requested OPERation: -C -!*** DELETE the internal flag-list: -C (NB: This option used to be called CLEAR, but there is a clash with -C clearing flags in NFLFLG). -C - IF (OPER(:3).EQ.'DEL') THEN - JS = NFLFL9(DFAR) !MAKE SURE FLAG FILE GONE - IF (.NOT.NFLFL0(DFAR)) THEN - CALL WNCTXT(F_TP,'Error getting flag file/area') - GOTO 800 - END IF - - JS = NFLFLS (DFAR,FLH) !READ FLAG-LIST HEADER - LLENGTH = FLHJ(FLH_FLFN_J) !NR OF SINGLE ENTRIES - IF (LLENGTH.EQ.0) THEN - CALL WNCTXT (F_TP,' The flag-list is empty.') - ELSE - CALL WNCTXT (F_TP,' Something has gone wrong:' - 1 //' List length is !SJ',LLENGTH) - END IF -C -!*** LOAD (FLF-file) -C - ELSE IF (OPER(:3).EQ.'LOA') THEN - IF (LLENGTH.GT.0) THEN - CALL WNCTXT (F_T,' ') - CALL WNCTXT (F_T,'The contents of the FLF-file will' - 1 //' be ADDED to the current flag-list!') - END IF - JS=NFLFL6(DFAR) !LOAD - GOTO 200 !Show list header -C -!*** UNLOAD (FLF-file) -C - ELSE IF (OPER(:3).EQ.'UNL') THEN - JS=NFLFL5(DFAR) !UNLOAD - GOTO 200 !Show list header -C -!*** WRITE (Flag-file, ASCII version): -C - ELSE IF (OPER(:3).EQ.'WRI') THEN - JS=NFLFL7(DFAR,0,NODIN,SETS) !WRITE ASCII FILE - GOTO 200 !Show list header -C -!*** READ (Flag-file, ASCII version): -C - ELSE IF (OPER(:3).EQ.'REA') THEN - IF (LLENGTH.GT.0) THEN - CALL WNCTXT (F_T,' ') - CALL WNCTXT (F_T,'The contents of the ASCII-file will' - 1 //' be ADDED to the current flag-list!') - END IF - JS=NFLFL8(DFAR) !READ ASCII - GOTO 200 !Show list header -C -!*** LIST the internal flag-list: -C - ELSE IF (OPER(:3).EQ.'LIS') THEN - CALL WNCTXT (F_TP,' ') - JS = NFLFL7 (DFAR,F_T) !Type flag list on screen - GOTO 200 !Show list header -C -!*** GET flags from headers/data into flag-list: -C - ELSE IF (OPER(:3).EQ.'GET') THEN - IF (LLENGTH.GT.0) THEN - CALL WNCTXT (F_T,' ') - CALL WNCTXT (F_T,'The result of the GET operation will' - 1 //' be ADDED to the current flag-list!') - END IF - CALL NFLGET (OPER,USERFLAG,DFAR, - 1 SHOW_CNT,TRACE) - GOTO 200 !Show list header -C -!*** PUT flags from flag-list into headers/data: -C - ELSE IF (OPER(:3).EQ.'PUT') THEN - CALL NFLPUT (OPER,USERFLAG,DFAR, - 1 SHOW_CNT,TRACE) -C -C---------------------------------------------------------------------------- -!*** HEADER: Show the contents of the flag-list header: -C The header of the flag-list contains the range of HA-s and -C frequ channels that are present in the list. -C - ELSE IF (OPER(:3).EQ.'HEA') THEN - 200 CONTINUE !USED BY OTHER OPTIONS - CALL WNCTXT (F_TP,' ') - CALL WNCTXT (F_TP, - 1 'Summary of the contents of the current flag-list:') -C - JS = NFLFLS (DFAR,FLH) !READ THE FLAG-LIST HEADER -C - LLENGTH = FLHJ(FLH_FLFN_J) !LIST LENGTH (SINGLE ENTRIES) - IF (LLENGTH.LE.0) THEN - CALL WNCTXT (F_TP,' The flag-list is empty.') - CALL WNCTXT (F_TP,' ') - GOTO 800 !ESCAPE - END IF -C -C Go through the flag-list itself: -C - JS=NFLFLR(DFAR) !MAKE SURE BEGIN LIST - I1 = 0 !COUNTER (OF LIST ENTRIES) - FLAG = 0 !COMPOSITE FLAG-BYTE - NIFRTYP = 0 !NR OF IFR-TYPE ENTRIES - NBASTYP = 0 !NR OF BASEL-TYPE ENTRIES - DO WHILE(NFLFL2(DFAR,FLF(0,1),FLF(0,2))) !READ ALL ENTRIES - I1 = I1+1 !COUNT NR OF ACTUAL ENTRIES - FLAG = IOR(FLAG,FLFJ(FLF_FLAG_J,1)) !FLAG-TYPE(S) IN LIST - IF (IAND(FLFJ(FLF_FLAG_J,1),'01000000'X).EQ.0) THEN - NIFRTYP = NIFRTYP+1 - ELSE - NBASTYP = NBASTYP+1 - END IF - END DO -C - CALL WNCTXT (F_TP, - 1 ' Total nr of single and double (range) entries:' - 1 //' !SJ (list length=!SJ)' - 1 ,I1,FLHJ(FLH_FLFN_J)) - IF (NBASTYP.GT.0) THEN - CALL WNCTXT (F_TP, - 1 ' Nr of baseline-type entries: !SJ (ifrtype=!SJ)' - 1 ,NBASTYP,NIFRTYP) - END IF -C -C Summary of flag-types: - - TXT80 = ' ' - I=1 - DO I4=0,MXNFLTYP-1 - IF (IAND(FLAGTYP(I4),FLAG).NE.0) THEN - I5 = FLAGTYP(I4) - I5 = IAND('000000ff'X,ISHFT(I5,-8)) !FLAG TYPE CODE - CALL WNCTXS (TXT80(I:),'!4$AS(!2$XJ)' - 1 ,FLAGNAM(I4),I5) - I=I+8 - END IF - END DO - CALL WNCTXT (F_TP,' Flag-types: '//TXT80) -C -C Range of frequ channels: -C - ICHMIN = FLHJ(FLH_RCHAN_J+0) !MIN CHANNEL NR IN LIST - ICHMAX = FLHJ(FLH_RCHAN_J+1) !MAX CHANNEL NR IN LIST - IF (FLHJ(FLH_CHAN_J).EQ.-1) THEN !WILDCARD: ALL CHANNELS - CALL WNCTXT (F_TP, - 1 ' Range of frequ channels: All (*)') - ELSE - CALL WNCTXT (F_TP, - 1 ' Range of frequ channels: !SJ:!SJ' - 1 ,ICHMIN,ICHMAX) - END IF -C -C Range of ifrs/baselines: -C - IFRMIN = FLHJ(FLH_RIFR_J+0) !MIN IFR NR IN LIST - RTW1 = MOD(IFRMIN,256) - RTE1 = IFRMIN/256 - IFRMAX = FLHJ(FLH_RIFR_J+1) !MAX IFR NR IN LIST - RTW2 = MOD(IFRMAX,256) - RTE2 = IFRMAX/256 - IF (FLHJ(FLH_IFR_J).EQ.-1) THEN !WILDCARD: ALL IFR'S - CALL WNCTXT (F_TP, - 1 ' Range of interferometers: All (*)') - ELSE - CALL WNCTXT (F_TP, - 1 ' Range of interferometers: !AS!AS:!AS!AS' - 1 ,TELNAM(RTW1),TELNAM(RTE1) - 1 ,TELNAM(RTW2),TELNAM(RTE2)) - END IF -C -C Range of polarisations: -C - IPOLMIN = FLHJ(FLH_RPOL_J+0) !MIN POL NR IN LIST - IPOLMAX = FLHJ(FLH_RPOL_J+1) !MAX POL NR IN LIST - IF (FLHJ(FLH_POL_J).EQ.-1) THEN !WILDCARD: ALL POL'S - CALL WNCTXT (F_TP, - 1 ' Range of polarisations: All (*)') - ELSE - CALL WNCTXT (F_TP, - 1 ' Range of polarisations: !AS:!AS (!SJ:!SJ)' - 1 ,POLNAM(IPOLMIN),POLNAM(IPOLMAX) - 1 ,IPOLMIN,IPOLMAX) - END IF -C -C Range of HA's -C - HAMIN = FLHE(FLH_RHA_E+0) !MIN HA IN LIST - HAMAX = FLHE(FLH_RHA_E+1) !MAX HA IN LIST - IF (FLHJ(FLH_HA_J).EQ.-1) THEN !WILDCARD: ALL HA'S - CALL WNCTXT (F_TP, - 1 ' Range of hour-angles: All (*)') - ELSE - CALL WNCTXT (F_TP, - 1 ' Range of hour-angles: !EAF10.2:!EAF10.2' - 1 //' degr',HAMIN,HAMAX) - END IF -C - CALL WNCTXT (F_TP,' ') -C -C------------------------------------------------------------------------------ -!*** COMPACT the internal flag-list: -C - ELSE IF (OPER(:3).EQ.'COM') THEN - CALL WNCTXT(F_TP,'NFLIST: COMPACT not implemented yet.') -C -!*** LCOUNT/COUNT flags in the LIST as various 1D projections: -C - ELSE IF ((OPER(:3).EQ.'LCO') .OR. - 1 (OPER(:3).EQ.'COU')) THEN -C - CALL WNCTXT (F_TP,'NFLIST: LCOUNT not implemented yet') - GOTO 800 -C - I1 = 0 - DO RTW=0,STHTEL-1 !WEST TEL - DO RTE=RTW,STHTEL-1 !EAST TEL - IFRA(0,I1) = RTW !Home-made IFRA - IFRA(1,I1) = RTE !(i.e. not from header) - I1 = I1+1 !INCREMENT IFR NR - END DO - END DO -C - JS = NFLFLS (DFAR,FLH) !READ FLAG-LIST HEADER - HA1 = FLHE(FLH_RHA_E+0) !MIN HA IN LIST - HA2 = FLHE(FLH_RHA_E+1) !MAX HA IN LIST - HA3 = 0.25/360. !HA INCREMENT ??????? -C - SELFLAG = FL_ALL !Count ALL flag-type(s) -C - JS = NFLCNT ('RESET',' ',0,0,0,0) !RESET FLAG-COUNT BUFFERS -C -C------------------------------------------------------------------------- - DO HACUR=HA1,HA2,HA3 !ALL HA-BINS IN LIST - DO I1=0,STHIFR-1 - DO I3=0,3 - FLACC(I1,I3) = 0 !SET TO ZERO - MASK(I1,I3) = 0 !SET TO ZERO - END DO - END DO -C - JS = NFLFLR(DFAR) !MAKE SURE BEGIN FLAG-LIST - DO WHILE(NFLFL2(DFAR,FLF(0,1),FLF(0,2))) !READ ALL ENTRIES - FLAG = FLFJ(FLF_FLAG_J,1) !FLAGBYTE OF ENTRY -C - HAMIN = FLFE(FLF_HA_E,1) !MIN HA - HAMAX = FLFE(FLF_HA_E,2) !MAX HA - IF (HAMIN.EQ.-1) THEN !ALL HA-SCANS - HAMIN = HA1 !MIN HA IN LIST - HAMAX = HA2 !MAX HA IN LIST - END IF - IF (HACUR.GE.HAMIN.AND.HACUR.LE.HAMAX) THEN !IN RANGE -C - IPOLMIN = FLFI(FLF_POL_I,1) - IPOLMAX = FLFI(FLF_POL_I,2) - IF (IPOLMIN.EQ.-1) THEN !ALL IFRS - IPOLMIN = 0 - IPOLMAX = 3 - END IF -C - IF (IAND(FLAG,'01000000'X).EQ.0) THEN - TYPIFR = .TRUE. !IFR-TYPE ENTRY - IFRMIN = FLFI(FLF_IFR_I,1) - IFRMAX = FLFI(FLF_IFR_I,2) - IF (IFRMIN.EQ.-1) THEN !ALL IFRS - IFRMIN = 0 - IFRMAX = STHIFR-1 - ELSE - END IF - DO I1=IFRMIN,IFRMAX !IFRS - DO I3=IPOLMIN,IPOLMAX !POLS - FLACC(I1,I3) = FLAG - MASK(I1,I3) = SELFLAG - END DO - END DO -C - ELSE - TYPIFR = .FALSE. !BASEL-TYPE ENTRY - BASMIN = FLFI(FLF_IFR_I,1) - BASMAX = FLFI(FLF_IFR_I,2) - IF (BASMIN.EQ.-1) THEN !ALL IFRS - BASMIN = 0 - BASMAX = 3000 - ELSE - END IF - END IF !TYPIFR -C - ICHMIN = FLFJ(FLF_CHAN_J,1) !MIN CHANNEL NR - ICHMAX = FLFJ(FLF_CHAN_J,2) !MAX CHANNEL NR - IF (ICHMIN.EQ.-1) THEN !ALL CHANNELS - ICHMIN = FLHJ(FLH_RCHAN_J+0) !MIN CHANNEL NR IN LIST - ICHMAX = FLHJ(FLH_RCHAN_J+1) !MAX CHANNEL NR IN LIST - IF (ICHMIN.EQ.-1) THEN !ALL CHANNELS - ICHMIN = 0 !?? - ICHMAX = 10 !?? - END IF - END IF -C - DO CHCUR=ICHMIN,ICHMAX !ALL FREQU CHANNELS - IF ((IPOLMIN.EQ.-1).AND.(IFRMIN.EQ.-1)) THEN - JS = NFLCNT ('ACC','HEAD',FLAG,SELFLAG, - 1 IFRA,CHCUR,HACUR) - ELSE - JS = NFLCNT ('ACC','DATA',FLACC,MASK, - 1 IFRA,CHCUR,HACUR) - END IF - END DO !CHCUR -C - END IF !HACUR IN RANGE - END DO !LIST ENTRIES - END DO !HACUR -C - JS = NFLCNT ('SHOW','FTYP',0,MASK,0,0,0) - CALL WNCTXT (F_T,'Counted are the flags in the flag-list,' - 1 //' NOT in the data/headers!') - CALL WNCTXT (F_T,' ') -C -C************************************************************************** -C -!*** Operation not recognised: -C - ELSE - CALL WNCTXT(F_TP,'FLIST operation not recognised') - END IF -C -C************************************************************************** -C************************************************************************** -C READY -C - 800 CONTINUE - RETURN !BACK TO FLAG_OPTION - END - - - - - - diff --git a/src/nscan/nflops.for b/src/nscan/nflops.for deleted file mode 100644 index d592f008da48c58d5bb4baf54d12efaf6e20e794..0000000000000000000000000000000000000000 --- a/src/nscan/nflops.for +++ /dev/null @@ -1,2082 +0,0 @@ -C+ NFLOPS.FOR -C JEN 931115 (used to be part of nflflg.for) -C -C Revisions: -C -C JEN 940216 Add DODRYRUN switch -C JEN 940216 Add QXY option (this required taking the -C data-flag modification out of the POL (I3) loop) -C JEN 940217 N_SCA: If one HA given, only one Scan flagged (not 3). -C JEN 940303 Add YXY option -C JEN 940701 Replace NFLST2 with improved NFLST1 -C CMV 940707 Add HARANGE option -C CMV 940717 Add ELEVATION option -C JEN 940901 Take reset of CDATLAST/HALAST out of Sector-loop -C JEN 940901 Add option RT1 (=DT1 for residues (data-model)) -C JEN 960226 Add options UXY and VXY -C -CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC -C NFLOPS.LOGIC: -C -C What determines the flagging (JEN/CMV): -C -C Each uv-data point, and each HA-Scan header, contains a `flagbyte'. -C The 8 bits of a flagbyte represent 8 types of flags that can be set. -C Header and data flagbytes have the same structure. A flag set in a -C Scan header is entirely equivalent to the same flag being set in -C all uv-data of that Scan. The header flags may save time. -C The flagbytes are modified with the help of a `FLAGBYTE'. -C -C The main parameters that control the flags in headers and/or uv-data -C all have three levels: A global default, a local default, and an -C actual value. The latter may be changed safely when circumstances -C require it, but will revert back to a known default value afterwards. -C NB: This scheme seems complex, but it is consistent and safe, while -C giving full control over the various (and rather diverse) operations. -C -C SELFLAG Global (default) FLAGBYTE (8 flagbits) to modify flagbytes. -C Each flagging operation has its own default FLAG (i.e. the -C flag-type(s) to be affected). This default may be overridden -C with a user-defined FLAGBYTE: FLAG=UFL if UFL<>0. -C FLAGH_DFLT Default FLAGBYTE for Scan headers (default=FLAG) -C FLAGH Actual FLAGBYTE for this Scan header (default=FLAGH_DFLT) -C FLAGD_DFLT Default FLAGBYTE for individual uv-data (default=FLAG) -C FLAGD Actual FLAGBYTE for this uv-data point (default=FLAGD_DFLT) -C -C SETFLAG Global flag/unflag switch (flagging mode): -C If true: flagbyte = IOR (flagbyte,FLAGBYTE) -C If false: flagbyte = IAND(flagbyte,NOT(FLAGBYTE)) -C SETFH_DFLT Default switch to be used for Scan headers (default=SETFLAG) -C SETFH Actual switch for this Scan header (default=SETFH_DFLT) -C SETFD_DFLT Default switch for individual uv-data (default=SETFLAG) -C SETFD Actual switch for this uv-data point (default=SETFD_DFLT) -C -C MODFH_DFLT If true, modify flagbyte in Scan headers in principle. -C MODFH If true, modify flagbyte in this Scan header (deflt=MODFH_DFLT). -C MODFD_DFLT If true, modify flagbyte in individual uv-data in principle. -C MODFD If true, modify flagbyte in this uv-data pnt (deflt=MODFD_DFLT). -C -C CORTP Global default switch (flagging mode). -C CORRDAT Local switch: if true, actually use corrected uv-data. -C -C WRSCH If true, write Scan header (flagbyte has been modified) -C WRSCN If true, write Scan data (flagbyte(s) have been modified) -C -C SELECT Switch used in `criterion-operations' (headers or uv-data). -C Example: SELECT=true if residue < specified limit (ARESID). -C - MODFH=.true. (or MODFD=.true., depending on operation) -C - SETFH=SELECT (or SETFD=SELECT, depending on operation) -C This logic, combined with the SETFLAG logic above, will -C set flags if the criterion is met, and resets them if not -C (i.e. the UNFLAG mode is irrelevant here): -C -C Logic diagram of the subroutine NFLOPS.FOR (JEN,CMV) -C -C Initialise -C SETFLAG = .true. -C Specify data hypercube (node,sets,HYPPOL,HYPIFR,HYPHA) -C Get flagging option (mode, operations, inspect, statistics) -C -C CORRDAT = CORTP !default -C SELIFR may be a subset of HYPIFR -C SELPOL may be a subset of HYPPOL -C SELHA may be a subset of HYPHA -C -C Operate on the selected data (node,sets,SELPOL,SELIFR,SELHA): -C Zero the various flag counters. -C Zero the various statistics buffers. -C MODFH_DFLT = .false. -C SETFH_DFLT = SETFLAG -C FLAGH_DFLT = FLAG -C Do for all the (sets of) Sectors in the hypercube: -C Read Sector header -C Do for all the specified HA-Scans (SELHA): -C Read Scan header -C MODFH = MODFH_DFLT -C SETFH = SETFH_DFLT -C FLAGH = FLAGH_DFLT -C MODFD_DFLT = .false. -C SETFD_DFLT = SETFLAG -C FLAGD_DFLT = FLAGH_DFLT -C WRSCH = .false. -C WRSCN = .false. -C SELECT = .false. -C -C Handle various options: this may change the local switches above. -C Goto 40 if the individual uv-data can be ignored. -C -C Read Scan uv-data -C Do for all specified ifrs (SELIFR) and pols (SELPOL) -C WFDAT(I3) = IAND('0000FFFF'X,LDAT) !weightbyte,flagbyte -C if (WFDAT(I3).ne.0) then !nonzero weight, no flags! -C MODFD = MODFD_DFLT -C SETFD = SETFD_DFLT -C FLAGD = FLAGD_DFLT -C SELECT=.false. -C -C Handle various options: this may change the local switches above. -C -C 60 if (MODFD) then !modify flagbyte of uv-data point -C if (SETFD) then flagbyte = IOR (flagbyte,FLAGD) -C else flagbyte = IAND(flagbyte,NOT(FLAGD)) -C WRSCN=.true. -C endif -C if (CNTFD) Count the data flags of the specified type(s). -C if (STACCD) Accumulate statistics of data. -C end if (WFDAT(I3)) -C end do (SELPOL,SELIFR) -C -C 40 if (MODFH) then !modify flagbyte of Scan header -C if (SETFH) then flagbyte = IOR (flagbyte,FLAGH) -C else flagbyte = IAND(flagbyte,NOT(FLAGH)) -C WRSCH=.true. -C endif -C if (CNTFH) Count the header flags of the specified type(s). -C if (STACCH) Accumulate statistics of header info. -C if (WRSCH) write the modified Scan header -C if (WRSCN) write the modified Scan data -C Next Scan (SELHA) -C Next Sector (sets) -C -C Print flag summary (several 1D projections through hypercube) -C -C Back to flagging Operation. -C -CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC - - - -CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC -C - SUBROUTINE NFLOPS (OPER,USERFLAG,CORTP, - 1 SHOW_CNT,TRACE,DODRYRUN) -C -C (Un)-flag scan data -C -C Result: -C -C CALL NFLOPS (OPER_C(*):I,USERFLAG_J:I,CORTP_L:I, -C SHOW_CNT_L:I,TRACE_L:I) -C -C PIN references: -C -C SELECT_FLAG -C HA -C LIMIT -C LIMITS -C FLAG_LIMIT -C -C Include files: -C - INCLUDE 'WNG_DEF' - INCLUDE 'NFL_DEF' - INCLUDE 'CBITS_DEF' - INCLUDE 'STH_O_DEF' !SET HEADER - INCLUDE 'SCH_O_DEF' !SCAN HEADER -C -C Parameters: -C - INTEGER XX,XY,YX,YY !POL. POINTERS - PARAMETER (XX=0, XY=1, YX=2, YY=3) -C - INTEGER CBIBMAX !NR OF POINTS IN CBI BEAMSHAPE - PARAMETER (CBIBMAX=100) -C -C Codes for the flagging operations -C - INTEGER N_RT1,N_QUI,N_NEX,N_YXY,N_NOD, - 1 N_PBA,N_SCA,N_CBI,N_QXY,N_RNO, - 1 N_ANO,N_XRN,N_YRN,N_XAN,N_YAN, - 1 N_MAX,N_UVD,N_AMP,N_SHA,N_TOH, - 1 N_TOD,N_TOT,N_GET,N_PUT,N_RED, - 1 N_NON,N_RRE,N_ARE,N_ACC,N_ACH, - 1 N_COU,N_TOP,N_DT1,N_DT2,N_CLE, - 1 N_COS,N_SIN,N_CLH,N_CLD,N_ACD, - 1 N_HAR,N_ELE,N_UXY,N_VXY -C - PARAMETER (N_RT1=1, N_QUI=2, N_NEX=3, N_YXY=4, N_NOD=5) - PARAMETER (N_PBA=6, N_SCA=7, N_CBI=8, N_QXY=9, N_RNO=10) - PARAMETER (N_ANO=11,N_XRN=12,N_YRN=13,N_XAN=14,N_YAN=15) - PARAMETER (N_MAX=16,N_UVD=17,N_AMP=18,N_SHA=19,N_TOH=20) - PARAMETER (N_TOD=21,N_TOT=22,N_GET=23,N_PUT=24,N_RED=25) - PARAMETER (N_NON=26,N_RRE=27,N_ARE=28,N_ACC=29,N_ACH=30) - PARAMETER (N_COU=31,N_TOP=32,N_DT1=33,N_DT2=34,N_CLE=35) - PARAMETER (N_COS=36,N_SIN=37,N_CLH=38,N_CLD=39,N_ACD=40) - PARAMETER (N_HAR=41,N_ELE=42,N_UXY=43,N_VXY=44) -C - INTEGER MXNOPER !# OF OPERATION - PARAMETER (MXNOPER=44) -C -C Codes for the flag-types -C - INTEGER MXNFLTYP !# of flag types (JEN) - PARAMETER (MXNFLTYP=9) -C -C Misc: -C - REAL VERYLARGE !Initial value for max/min - PARAMETER (VERYLARGE=1.E38) -C - REAL DRYLIMIT !High limit value for Dry Run -C -C Arguments: -C - CHARACTER OPER*(*) !SELECTED FLAGGING OPERATION - INTEGER USERFLAG !USER-DEFINED FLAGBYTE (OVERRIDE) - LOGICAL CORTP !CORRECT DATA/NO CORRECT DATA -C - LOGICAL SHOW_CNT !SHOW THE COUNTED FLAGS AFTER OPS - LOGICAL TRACE !TRACE THE FLAGGING OPERATION - LOGICAL DODRYRUN !ESTIMATE DEFAULT CLIP LIMITS -C -C Function references: -C - LOGICAL WNDPAR !GET DWARF PARAMETER - LOGICAL WNDNOD !GET NODE - LOGICAL WNFOP !OPEN FILE - LOGICAL WNFRD !READ DATA - LOGICAL WNFWR !WRITE DATA - CHARACTER*32 WNTTSG !SET NAME - LOGICAL WNDSTQ !GET SETS - INTEGER WNCAJ !GET INTEGER FROM TEXT - LOGICAL NSCSTG !GET A SET - LOGICAL NSCSCH,NSCSCW !READ/WRITE SCAN HEADER - LOGICAL NSCSIF !READ INTERFEROMETER TABLE - LOGICAL NSCIFS !GET INTERFEROMETER SELECTION - LOGICAL NSCSCR,NSCSCM !READ CORRECTED SCAN DATA or MODEL - LOGICAL NMOMSL !CALCULATE MODEL DATA - LOGICAL NMORDH !READ MODEL HEADER - LOGICAL NSCPLS !SELECT POLARISATION - LOGICAL NSCHAS !SELECT HA - DOUBLE PRECISION NMOBMF,NMOBMV !TELESCOPE BEAM CALCULATION - REAL NFLST1 !STATISTICS - LOGICAL NFLCNT !FLAG COUNTING - LOGICAL NFLCUB !UV-DATA CUBE -C -C Data declarations: -C -C----------------------------------------------------------------------- -C -C "Static variables" -C -C List of flagging operation names and corresponding codes: -C NB: ... indicates operations that no longer exist in NFLOPS. -C - CHARACTER*3 CNOPER(MXNOPER) !OPERATION NAMES - DATA CNOPER/ - 1 'RT1','...','...','YXY','...', - 1 'PBA','SCA','CBI','QXY','RNO', - 1 'ANO','XRN','YRN','XAN','YAN', - 1 'MAX','UVD','AMP','SHA','TOH', - 1 'TOD','TOT','...','...','RED', - 1 'NON','RRE','ARE','ACC','ACH', - 1 'COU','TOP','DT1','DT2','CLE', - 1 'COS','SIN','CLH','CLD','ACD', - 1 'HAR','ELE','UXY','VXY'/ - INTEGER NNOPER(MXNOPER) - DATA NNOPER/ - 1 N_RT1,N_QUI,N_NEX,N_YXY,N_NOD, - 1 N_PBA,N_SCA,N_CBI,N_QXY,N_RNO, - 1 N_ANO,N_XRN,N_YRN,N_XAN,N_YAN, - 1 N_MAX,N_UVD,N_AMP,N_SHA,N_TOH, - 1 N_TOD,N_TOT,N_GET,N_PUT,N_RED, - 1 N_NON,N_RRE,N_ARE,N_ACC,N_ACH, - 1 N_COU,N_TOP,N_DT1,N_DT2,N_CLE, - 1 N_COS,N_SIN,N_CLH,N_CLD,N_ACD, - 1 N_HAR,N_ELE,N_UXY,N_VXY/ -C -C Look-up table to find existence and offset for polarisations -C depending on the number of polarisations present in the data -C - INTEGER PPOL(XX:YY,1:4,0:1) !POL. SELECT XX,XY,YX,YY FOR - ! NPOL=1:4: -C OLD DATA PPOL/1,0,0,0, 1,0,0,8, 0,0,0,0, 1,2,4,8, !BITS - DATA PPOL/XX_P,0,0,0, XX_P,0,0,YY_P, 0,0,0,0, - 1 XX_P,XY_P,YX_P,YY_P, !BITS - 1 0,0,0,0, 0,0,0,1, 0,0,0,0, 0,1,2,3/ !OFFSETS -C -C Names of polarisations, telescopes: -C - CHARACTER*2 POLNAME(0:3) !POL NAMES (XX, XY ETC) - DATA POLNAME /'P0','P1','P2','P3'/ !TEMPORARY, SEE BELOW -C - CHARACTER*1 TELNAME(0:STHTEL-1) !TEL NAMES (0,1,2,A, ETC) - DATA TELNAME /'0','1','2','3','4','5','6', - 1 '7','8','9','A','B','C','D'/ -C -C Array with flag-types and flag-codes -C - CHARACTER*4 FLAGNAME(0:MXNFLTYP-1) - DATA FLAGNAME /'MAN','CLIP','NOIS','ADD','SHAD', - 1 'U3','U2','U1','ALL'/ - INTEGER FLAGTYPE(0:MXNFLTYP-1) - DATA FLAGTYPE /FL_MAN,FL_CLIP,FL_NOIS,FL_ADD,FL_SHAD, - 1 FL_3,FL_2,FL_1,FL_ALL/ -C -C----------------------------------------------------------------------- -C -C Variables with user-input, defaults and direct derivatives -C NB: The variables CHARCTER OPTION*24 and OPT*3 are defined in a common. -C - INTEGER NOPER !CURRENT OPERATION NR -C -C Data selection (maybe subset of the specified hypercube): -C - LOGICAL SELPOL(0:3) !POLARISATION SELECTION - BYTE SELIFR(0:STHTEL-1,0:STHTEL-1) !IFR SELECTION - REAL SELHA(0:1) !HA-RANGE - INTEGER IFRMIN,IFRMAX !MIN,MAX IFR NR - INTEGER POLMIN,POLMAX !MIN,MAX POL NR -C -C Data correction: -C - INTEGER CAP,CDAP !Global APPLY/DEAPPLY BITS (WNDDAP) - INTEGER DUFLAG !Global User Flag (WNDDUF) -C -C Flagging operations -C -C - INTEGER I6,I7,I8,I9,I10 !GENERAL INTEGER VARIABLES - REAL R2,R3,R4,R5 !GENERAL REAL VARIABLES - CHARACTER*80 TXT80 !GENERAL TEXT BUFFER - INTEGER TOH_COUNT !FLAG COUNTER (FOR OPER. TOHEAD) - INTEGER RTW,RTE !WEST,EAST TELESCOPE NRS - REAL DHA,DHA1,DHA2 !HA-DIFFERENCE (FOR OPER. DT1) - LOGICAL SELECT !SELECTED BY CRITERION - INTEGER CHCUR !CURRENT CHANNEL NR - REAL HACUR,HAINC !CURRENT HA (circles) and increment - REAL MXLIM(0:1) !LIMITS - REAL PBASLIM(0:1) !LIMITS (Option PBAS) - REAL HAR(0:1) !LIMITS (Option HAR) - INTEGER TOH_LIMIT !FLAG LIMIT # (FOR TOHEAD) - REAL ELELIMIT !ELEVATION LIMIT (circles) - REAL SHADIAM !SHADOW DIAMETER (FOR SHA, =25m) - REAL ELEV,WSRTLAT !ELEVATION,LATITUDE (DEGR?) - REAL LREL,MREL !L,M RELATIVE TO FIELD CENTRE (ARCSEC?) - REAL CBIBEAM(0:CBIBMAX) !CBI `BEAMSHAPE' (FUNCTION OF R) - REAL CBIBINC !INCREMENT (RADIANS) OF R IN CBIBEAM - REAL CBIBPAR(0:1) !CBI BEAMSHAPE PARAMETERS - REAL CBDIR,CBDIST !DIRECTION, DISTANCE TO CONTROL BLDNG - REAL CBIFACT(0:STHTEL-1) !CONTROL BUILDING INTERFERENCE FACTOR - LOGICAL SHATEL(0:STHTEL-1) !SHADOWED TELESCOPES -C -C Flow control -C - INTEGER SELFLAG !SELECTED FLAG-TYPE(S) TO BE USED - INTEGER CFLAG !LOCAL OVERRIDE (e.g. for CLEAR) -C - INTEGER FLAGH_DFLT !DEFAULT FOR FLAGH - INTEGER FLAGH !FLAGBYTE FOR SCAN HEADER - INTEGER FLAGD_DFLT !DEFAULT FOR FLAGD - INTEGER FLAGD(0:3) !FLAGBYTE FOR UV-DATUM -C - LOGICAL VALIDAT(0:3) !VALID DATA POINT - INTEGER LDOFF(0:3) !OFFSET IN ARRAY LDAT - INTEGER WFDAT(0:3) !WGT/FLAG BYTES -C - LOGICAL SETFLAG !FLAG/UNFLAG - LOGICAL SETFH_DFLT !DEFAULT FOR SETFH - LOGICAL SETFH !SET FLAG IN HEADER - LOGICAL SETFD_DFLT ! - LOGICAL SETFD(0:3) !SET FLAG IN UV-DATUM -C - LOGICAL MODFH_DFLT !DEFAULT FOR MODFH - LOGICAL MODFH !MODIFY FLAG(S) IN HEADER - LOGICAL MODFD_DFLT !DEFAULT FOR MODFD - LOGICAL MODFD(0:3) !MODIFY FLAG(S) IN UV-DATUM -C - LOGICAL CNTFH_DFLT ! - LOGICAL CNTFH !COUNT FLAG(S) IN HEADER - LOGICAL CNTFD_DFLT ! - LOGICAL CNTFD(0:3) !COUNT FLAG(S) IN UV-DATUM -C - LOGICAL STACCH_DFLT ! - LOGICAL STACCH !ACCUM.STATISTICS FLAG(S) IN HEADER - LOGICAL STACCD_DFLT ! - LOGICAL STACCD(0:3) !ACCUM.STATISTICS FLAG(S) IN UV-DATUM -C - LOGICAL CHKDATA !TEST INDIV. UV-DATA POINTS OF SCAN - LOGICAL CORRDAT !APPLY UV-DATA CORRECTIONS -C - LOGICAL WRSCH !REWRITE (MODIFIED) SCAN HEADER - LOGICAL WRSCN !REWRITE (MODIFIED) SCAN DATA -C - LOGICAL SHOW_STAT !Show summary of statistics -C - LOGICAL DRYRUN !TO ESTIMATE DEFAULT LIMITS ETC - INTEGER NDRYSCANS,MAXDRYSCANS !NR OF SCANS IN DRY RUN -C -C Data needed to call NMO (MODEL) routines: -C - INTEGER NSRC(0:2) !Source counts - INTEGER LPOFF(0:7) !Current offsets (loops) - INTEGER NPOL !# OF POLS IN SECTOR - INTEGER STP !SOURCE TYPE - DOUBLE PRECISION SRA,SDEC,SFRQ !MODEL INFO (FROM MDL FILE) - REAL UV0(0:3) !BASIC UV COORDINATES - REAL LM0(0:1) !BASIC SOURCE DISPLACEMENT - DOUBLE PRECISION FRQ0 !BASIC FREQUENCY (FROM MDL FILE)? - REAL TF(0:1) !INTEGR. TIME, BANDWIDTH - INTEGER MINST !INSTRUMENT - DOUBLE PRECISION RA,DEC,FRQ !FROM SECTOR HEADER - DOUBLE PRECISION BEMLIM,BEAMFAC !BEAM CALC -C -C Sector header and Scan header: -C - INTEGER SNAM(0:7) !SET NAME - INTEGER STHP !SET HEADER POINTER - BYTE STH(0:STH__L-1) !SET HEADER - INTEGER*2 STHI(0:STH__L/LB_I-1) - INTEGER STHJ(0:STH__L/LB_J-1) - REAL STHE(0:STH__L/LB_E-1) - DOUBLE PRECISION STHD(0:STH__L/LB_D-1) - EQUIVALENCE (STH,STHJ,STHI,STHE,STHD) - BYTE SCH(0:SCH__L-1) !SCAN HEADER - INTEGER*2 SCHI(0:SCH__L/LB_I-1) - INTEGER SCHJ(0:SCH__L/LB_J-1) - REAL SCHE(0:SCH__L/LB_E-1) - EQUIVALENCE (SCH,SCHJ,SCHI,SCHE) -C -C Telescope configuration: -C - INTEGER*2 IFRT(0:STHIFR-1) !INTERFEROMETER TABLE - INTEGER IFRA(0:1,0:STHIFR-1) !RTWEST(0), RTEAST(1) - REAL ANG(0:2,0:STHIFR-1) !DIPOLE ANGLE INFORMATION - REAL BASEL(0:STHIFR-1) !BASELINE TABLE - INTEGER IRED(0:STHIFR-1) !REDUNDANT INDICATORS - REAL PBAS,PBAS0 !PROJECTION BASELINE FACTOR -C -C uv-data: -C - INTEGER*2 LDAT(0:2,0:4*STHIFR-1) !DATA - INTEGER*2 LDAT1(0:2,0:4*STHIFR-1) !DATA COPY - REAL WGT(0:STHIFR-1,0:3) !DATA WEIGHT - COMPLEX CDAT(0:STHIFR-1,0:3) !DATA - REAL DAT(0:1,0:STHIFR-1,0:3) - EQUIVALENCE (CDAT,DAT) - COMPLEX CMOD(0:3,0:STHIFR-1) !IQUV MODEL - COMPLEX CAMOD(0:STHIFR-1,0:3) !XYX MODEL - REAL MWGT(0:3,0:STHIFR-1) !MODEL WEIGHT -C -C Things kept for later use in flagging -C NB: 0=last unflagged point, 1=last point (flagged or not) -C - COMPLEX CDATLAST(0:STHIFR-1,0:3,0:1) !EARLIER DATA - REAL DATLAST(0:1,0:STHIFR-1,0:3,0:1) !(0=C,1=S) - EQUIVALENCE (DATLAST,CDATLAST) - REAL HALAST(0:STHIFR-1,0:3,0:1) !HA OF EARLIER DATA -C -C Statistics: -C - REAL CRITVALD(0:STHIFR-1,0:3) !CRITERION VALUE PER UV-POINT - REAL STATWGTD(0:STHIFR-1,0:3) !STATISTICS WEIGHT PER UV-POINT - REAL S_VAL(0:STHIFR),S_WGT(0:STHIFR) !TRANSFER BUFFERS - REAL CRITVALH,STATWGTH !SAME FOR HEADER VALUES - REAL WTOT ! -C -C Flag counts (input for routine NFLCNT) -C - INTEGER FLACC(0:STHIFR-1,0:3) !DATA FLAGS FOR A SCAN - INTEGER MASK(0:STHIFR-1,0:3) !FLAGBYTES USED -C- -C****************************************************************************** -C****************************************************************************** -C -C INIT -C - POLNAME(XX) = 'XX' ! Should be defined centrally - POLNAME(XY) = 'XY' - POLNAME(YX) = 'YX' - POLNAME(YY) = 'YY' -C - SETFLAG = .TRUE. !SET FLAGS - SHOW_STAT = .FALSE. !DO NOT SHOW STATISTICS - STHE(STH_HAI_E)=0.0 !NO INCREMENT KNOWN -C - MXLIM(0)=0 !CLIP/MAX/RESID LIMITS - MXLIM(1)=100000 - PBASLIM(0)=0 !PBAS LIMITS (M) - PBASLIM(1)=100 - SHADIAM=25 !SHADOW DIAMETER (M) - TOH_LIMIT=1 !FLAG LIMIT -C - DRYRUN = .FALSE. !SWITCH FOR DRY RUN - MAXDRYSCANS = 25 !NR OF SCANS IN DRY RUN -C - CALL NFLST0 ('INIT',' ',0,0.,0.) !Initialise Statistics bookkeeping - R0 = NFLST1 ('INIT',' ',' ',0,0.,0.) !Initialise Statistics buffers -C -C Read in the data hypercube definition, specified in nflflg: -C - JS = NFLCUB ('SELECT','HYPERCUBE',0,SELHA,SELPOL,SELIFR) -C -C***************************************************************************** -C***************************************************************************** -C***************************************************************************** -C***************************************************************************** -C FLAGGING OPERATIONS: -C - 200 CONTINUE -C -C Translate option name into option number (safer): -C - NOPER=-1 !ASSUME UNKNOWN - DO I=1,MXNOPER !MAKE NUMERIC OPTION - IF (OPER(:3).EQ.CNOPER(I)) THEN - NOPER=NNOPER(I) - END IF - END DO -C -C Do some initialising: -C - DRYRUN = .FALSE. !NOT A DRY RUN - SELFLAG = USERFLAG !SELECTED FLAG TYPES - CFLAG = 0 !OVERRIDE FOR CLEAR - CORRDAT = CORTP !APPLY CORRECTIONS IF ASKED -C -C------------------------------------------------------------------------ -C -!*** CLEAR ALL FLAGS -C - IF (NOPER.EQ.N_CLE .OR. - 1 NOPER.EQ.N_CLD .OR. - 1 NOPER.EQ.N_CLH) THEN - CALL WNCTXT (F_TP,' ') - IF (NOPER.EQ.N_CLE) THEN - CALL WNCTXT(F_TP,'All flags of the specified type(s)' - 1 //' will be removed, from data AND Scan headers.') - ELSE IF (NOPER.EQ.N_CLH) THEN - CALL WNCTXT(F_TP,'All flags of the specified type(s)' - 1 //' will be removed from the Scan headers ONLY.') - ELSE IF (NOPER.EQ.N_CLD) THEN - CALL WNCTXT(F_TP,'All flags of the specified type(s)' - 1 //' will be removed from the uv-data ONLY.') - END IF - CALL WNCTXT(F_TP,'Beware: much work can be undone' - 1 //' this way! Escape by specifying NONE.') - CALL WNCTXT (F_TP,' ') -C - CFLAG = 0 !DEFAULT: NONE - CALL WNCTXT (F_T,'Clear only flags of the following type(s):') - CALL WNDDA3('SELECT_FLAG',CFLAG) !SELECT FLAG TYPE(S) - IF (CFLAG.EQ.0) GOTO 700 !NONE: ESCAPE -C - IF (NOPER.EQ.N_CLE .OR. NOPER.EQ.N_CLD) THEN - IF (.NOT.NFLCUB ('SPECIFY','SUBCUBE',0, - 1 SELHA,SELPOL,SELIFR)) GOTO 800 !SUB-CUBE - ELSE IF (NOPER.EQ.N_CLH) THEN - IF (.NOT.NFLCUB ('SPECIFY','SUBCUBE_HA',0, - 1 SELHA,SELPOL,SELIFR)) GOTO 800 !SUB-CUBE - END IF -C -!*** TODATA -C - ELSE IF (NOPER.EQ.N_TOD) THEN - CFLAG=0 !DEFAULT: NONE - CALL WNCTXT (F_TP,'Copy only flags of the following type(s):') - CALL WNDDA3('SELECT_FLAG',CFLAG) - IF (CFLAG.EQ.0) GOTO 700 !NONE: ESCAPE -C -!*** TOHEAD -C - ELSE IF (NOPER.EQ.N_TOH) THEN - CFLAG=0 !DEFAULT: NONE - CALL WNCTXT (F_TP,'Copy only flags of the following type(s):') - CALL WNDDA3('SELECT_FLAG',CFLAG) - IF (CFLAG.EQ.0) GOTO 700 !NONE: ESCAPE -C - 221 CONTINUE - IF (.NOT.WNDPAR('TOH_LIMIT',TOH_LIMIT,LB_J, - 1 J0,A_B(-A_OB),TOH_LIMIT,1)) THEN - IF (E_C.EQ.DWC_ENDOFLOOP) GOTO 800 - GOTO 221 - END IF - IF (J0.EQ.0) GOTO 700 !EMPTY STRING: ESCAPE - IF (J0.LT.0) TOH_LIMIT=1 !WILDCARD (*): USE DEFAULT? -C -!*** TOTEL,TOPOL -C - ELSE IF (NOPER.EQ.N_TOT .OR. NOPER.EQ.N_TOP) THEN - CFLAG=0 !DEFAULT: NONE - CALL WNCTXT (F_TP,'Copy only flags of the following type(s):') - CALL WNDDA3('SELECT_FLAG',CFLAG) - IF (CFLAG.EQ.0) GOTO 700 !NONE: ESCAPE -C -!*** COUNT (flags in data and Scan headers) -C NB: A sub-cube of the specified data-cube may be selected. -C - ELSE IF (NOPER.EQ.N_COU) THEN - CFLAG = FL_ALL !DEFAULT: ALL TYPES - CALL WNCTXT (F_T,'Count only flags of the following type(s):') - CALL WNDDA3('SELECT_FLAG',CFLAG) !SELECT FLAG TYPE(S) - IF (CFLAG.EQ.0) GOTO 700 !NONE: ESCAPE - IF (.NOT.NFLCUB ('SPECIFY','SUBCUBE',1, - 1 SELHA,SELPOL,SELIFR)) GOTO 800 !SUB-CUBE -C -!*** ACCUMULATE STATISTICS (of data and/or header info) -C NB: A sub-cube of the specified data-cube may be selected. -C - ELSE IF (NOPER.EQ.N_ACC .OR. - 1 NOPER.EQ.N_ACH .OR. - 1 NOPER.EQ.N_ACD) THEN - SELFLAG = FL_ALL !DEFAULT: ALL TYPES - CALL WNCTXT (F_T,'Ignore data/scans that are flagged' - 1 //' with the following flag type(s):') - CALL WNDDA3('SELECT_FLAG',SELFLAG) !SELECT FLAG TYPE(S) -C - SHOW_STAT = .TRUE. !SHOW STATISTICS - IF (NOPER.EQ.N_ACC .OR. NOPER.EQ.N_ACD) THEN - IF (.NOT.NFLCUB ('SPECIFY','SUBCUBE',0, - 1 SELHA,SELPOL,SELIFR)) GOTO 800 !SUB-CUBE - ELSE IF (NOPER.EQ.N_ACH) THEN - IF (.NOT.NFLCUB ('SPECIFY','SUBCUBE_HA',0, - 1 SELHA,SELPOL,SELIFR)) GOTO 800 !SUB-CUBE - END IF -C -C----------------------------------------------------------------------------- -!*** SCANS: Manual flagging of individual Scans: -C - ELSE IF (NOPER.EQ.N_SCA) THEN - SELFLAG = FL_MAN !DEFAULT FLAG TYPE: MANUAL - IF (.NOT.NFLCUB ('SPECIFY','SUBCUBE_HA',0, - 1 SELHA,SELPOL,SELIFR)) GOTO 800 !SUB-CUBE -C -!*** IFR: Manual flagging of individual ifrs/pols -C - ELSE IF (NOPER.EQ.N_UVD) THEN - SELFLAG=FL_MAN !DEFAULT FLAG TYPE: MANUAL - IF (.NOT.NFLCUB ('SPECIFY','SUBCUBE',4, - 1 SELHA,SELPOL,SELIFR)) GOTO 800 !SUB-CUBE -C -!*** HAR: Manual flagging of ha-ranges -C - ELSE IF (NOPER.EQ.N_HAR) THEN - SELFLAG=FL_MAN !DEFAULT FLAG TYPE: MANUAL - CALL WNCTXT(F_T,'After the Sub-cube prompt, '// - 1 'you will be repeatedly prompted for a HA-range') - IF (.NOT.NFLCUB ('SPECIFY','SUBCUBE',4, - 1 SELHA,SELPOL,SELIFR)) GOTO 800 !SUB-CUBE - 321 CONTINUE - CALL WNCTXT(F_T,'Choose * to stop asking for HA-range') - IF (.NOT.NSCHAS(1,HAR)) GOTO 700 - IF (HAR(0).LE.-0.499.AND.HAR(1).GE.0.499) GOTO 700 -C -!*** (X/Y)RNOISE, (X/Y)ANOISE -C - ELSE IF (NOPER.EQ.N_RNO .OR. NOPER.EQ.N_ANO .OR. - 1 NOPER.EQ.N_XRN .OR. NOPER.EQ.N_YRN .OR. - 1 NOPER.EQ.N_XAN .OR. NOPER.EQ.N_YAN) THEN - SELFLAG=FL_NOIS !DEFAULT FLAG TYPE: NOISE - DRYRUN = .TRUE. !START WITH A DRY RUN, FOR DEFAULT LIMITS - DRYRUN = DODRYRUN !NOT IF INHIBITED - IF (DRYRUN) THEN - CONTINUE !DO A DRY RUN - ELSE - 213 DRYRUN = .FALSE. !RETURN POINT AFTER DRY RUN - TXT80 = 'CRIT_'//CNOPER(NOPER) !CRITERION NAME - MXLIM(0) = 0 !DEFAULT LOWER LIMIT - MXLIM(1) = 0 !DEFAULT UPPER LIMIT - IF (DODRYRUN) THEN - MXLIM(1) = 3 * NFLST1('CALC',TXT80,'RMS',1,R0,WTOT) - CALL WNCTXT (F_T,'Default upper threshold is 3*rms ' - 1 //' of dry-run values.') - END IF - IF (.NOT.WNDPAR('CLIP_LIMITS',MXLIM,2*LB_E, - 1 J0,A_B(-A_OB),MXLIM,2)) THEN - IF (E_C.EQ.DWC_ENDOFLOOP) GOTO 800 !ESCAPE - GOTO 213 - END IF - IF (MXLIM(0).GE.MXLIM(1)) GOTO 700 !ESCAPE - END IF - R0 = NFLST1 ('ASSIGN','CRIT_'//CNOPER(NOPER), - 1 'UNIT=W.U.',1,0.,0.) !Assign statistics group -C -!*** MAX -C - ELSE IF (NOPER.EQ.N_MAX) THEN - SELFLAG=FL_CLIP !DEFAULT FLAG TYPE: CLIP - DRYRUN = .TRUE. !START WITH A DRY RUN, FOR DEFAULT LIMITS - DRYRUN = DODRYRUN !NOT IF INHIBITED - IF (DRYRUN) THEN - CONTINUE !DO A DRY RUN - ELSE - 214 DRYRUN = .FALSE. !RETURN POINT AFTER DRY RUN - TXT80 = 'CRIT_'//CNOPER(NOPER) !CRITERION NAME - MXLIM(0) = 0 !DEFAULT LOWER LIMIT - MXLIM(1) = 0 !DEFAULT UPPER LIMIT - IF (DODRYRUN) THEN - MXLIM(1) = 3 * NFLST1('CALC',TXT80,'RMS',1,R0,WTOT) - CALL WNCTXT (F_T,'Default upper threshold is 3*rms ' - 1 //' of dry-run values.') - END IF - IF (.NOT.WNDPAR('ABCS_LIMITS',MXLIM,2*LB_E, - 1 J0,A_B(-A_OB),MXLIM,2)) THEN - IF (E_C.EQ.DWC_ENDOFLOOP) GOTO 800 !ESCAPE - GOTO 214 - END IF - IF (MXLIM(0).GT.MXLIM(1)) GOTO 700 !ESCAPE - END IF - R0 = NFLST1 ('ASSIGN','CRIT_'//CNOPER(NOPER), - 1 'UNIT=W.U.',1,0.,0.) !Assign statistics group -C -!*** CLIP (AMPL,COS,SIN): -C - ELSE IF (NOPER.EQ.N_AMP .OR. - 1 NOPER.EQ.N_COS .OR. - 1 NOPER.EQ.N_SIN) THEN - SELFLAG=FL_CLIP !DEFAULT FLAG TYPE: CLIP - DRYRUN = .TRUE. !START WITH A DRY RUN, FOR DEFAULT LIMITS - DRYRUN = DODRYRUN !NOT IF INHIBITED - IF (DRYRUN) THEN - CONTINUE !DO A DRY RUN - ELSE - 215 DRYRUN = .FALSE. !RETURN POINT AFTER DRY RUN - TXT80 = 'CRIT_'//CNOPER(NOPER) !CRITERION NAME - MXLIM(0) = 0 !DEFAULT LOWER LIMIT - MXLIM(1) = 0 !DEFAULT UPPER LIMIT - IF (DODRYRUN) THEN - MXLIM(1) = 3 * NFLST1('CALC',TXT80,'RMS',1,R0,WTOT) - CALL WNCTXT (F_T,'Default upper threshold is 3*rms ' - 1 //' of dry-run values.') - END IF - IF (.NOT.WNDPAR('CLIP_LIMITS',MXLIM,2*LB_E, - 1 J0,A_B(-A_OB),MXLIM,2)) THEN - IF (E_C.EQ.DWC_ENDOFLOOP) GOTO 800 !ESCAPE - GOTO 215 - END IF - IF (MXLIM(0).GE.MXLIM(1)) GOTO 700 !ESCAPE - END IF - R0 = NFLST1 ('ASSIGN','CRIT_'//CNOPER(NOPER), - 1 'UNIT=W.U.',1,0.,0.) !Assign statistics group -C -!*** DT1, RT1 -C - ELSE IF ((NOPER.EQ.N_DT1) .OR. - 1 (NOPER.EQ.N_RT1)) THEN - SELFLAG=FL_CLIP !DEFAULT FLAG TYPE: CLIP - IF (NOPER.EQ.N_RT1) THEN - CORRDAT = .TRUE. !CORRECTED DATA NEEDED! - CALL WNCTXT (F_T,'Corrected uv-data will be used') - END IF - DRYRUN = .TRUE. !START WITH A DRY RUN, FOR DEFAULT LIMITS - DRYRUN = DODRYRUN !NOT IF INHIBITED - IF (DRYRUN) THEN - CONTINUE !DO A DRY RUN - ELSE - 216 DRYRUN = .FALSE. !RETURN POINT AFTER DRY RUN - TXT80 = 'CRIT_'//CNOPER(NOPER) !CRITERION NAME - MXLIM(0) = 0 - MXLIM(1) = 0 !DEFAULT UPPER LIMIT - IF (DODRYRUN) THEN - MXLIM(1) = 3 * NFLST1('CALC',TXT80,'RMS',1,R0,WTOT) - CALL WNCTXT (F_T,'Default threshold is 3*rms' - 1 //' of scan-to-scan (=time) variations.') - END IF - IF (.NOT.WNDPAR('DT1_LIMIT',MXLIM(1),LB_E, - 1 J0,A_B(-A_OB),MXLIM(1),1)) THEN - IF (E_C.EQ.DWC_ENDOFLOOP) GOTO 800 - GOTO 216 - END IF - IF (MXLIM(0).GE.MXLIM(1)) GOTO 700 !ESCAPE - END IF - R0 = NFLST1 ('ASSIGN','CRIT_'//CNOPER(NOPER), - 1 'UNIT=W.U.',1,0.,0.) !Assign statistics group -C -!*** RRESID,ARESID,QXY,UXY,VXY,YXY, -C - ELSE IF (NOPER.EQ.N_RRE .OR. - 1 NOPER.EQ.N_ARE .OR. - 1 NOPER.EQ.N_YXY .OR. - 1 NOPER.EQ.N_UXY .OR. - 1 NOPER.EQ.N_VXY .OR. - 1 NOPER.EQ.N_QXY) THEN - SELFLAG=FL_CLIP !DEFAULT FLAG TYPE: CLIP - CORRDAT = .TRUE. !CORRECTED DATA NEEDED! - CALL WNCTXT (F_T,'Corrected uv-data will be used') - DRYRUN = .TRUE. !START WITH A DRY RUN, FOR DEFAULT LIMITS - DRYRUN = DODRYRUN !NOT IF INHIBITED - IF (DRYRUN) THEN - CONTINUE - ELSE - 217 DRYRUN = .FALSE. !RETURN POINT AFTER DRY RUN - TXT80 = 'CRIT_'//CNOPER(NOPER) !CRITERION NAME - MXLIM(0) = 0 !DEFAULT LOWER LIMIT - MXLIM(1) = 0 !DEFAULT UPPER LIMIT - IF (DODRYRUN) THEN - MXLIM(1) = 3 * NFLST1('CALC',TXT80,'RMS',1,R0,WTOT) - CALL WNCTXT (F_T,'Default threshold is 3*rms' - 1 //' of (unflagged) dry-run residues.') - END IF - IF (.NOT.WNDPAR('CLIP_LIMIT',MXLIM(1),LB_E, - 1 J0,A_B(-A_OB),MXLIM(1),1)) THEN - IF (E_C.EQ.DWC_ENDOFLOOP) GOTO 800 !ESCAPE - GOTO 217 - END IF - IF (MXLIM(0).GE.MXLIM(1)) GOTO 700 !ESCAPE - END IF - R0 = NFLST1 ('ASSIGN','CRIT_'//CNOPER(NOPER), - 1 'UNIT=W.U.',1,0.,0.) !Assign statistics group -C -!*** ELEVATION -C - ELSE IF (NOPER.EQ.N_ELE) THEN - SELFLAG=FL_SHAD !DEFAULT FLAG TYPE: SHADOW - ELELIMIT = 10. !DEFAULT 10 DEG - 228 CONTINUE - IF (.NOT.WNDPAR('ELEVATION_LIMIT',ELELIMIT,LB_E, - 1 J0,A_B(-A_OB),ELELIMIT,1)) THEN - IF (E_C.EQ.DWC_ENDOFLOOP) GOTO 800 - GOTO 228 - END IF - ELELIMIT=ELELIMIT/360. !MAKE CIRCLES -C -!*** SHADOW -C - ELSE IF (NOPER.EQ.N_SHA) THEN - SELFLAG=FL_SHAD !DEFAULT FLAG TYPE: SHADOW - SHADIAM = 25 !WSRT TEL DIAMETER (M) - 218 CONTINUE - IF (.NOT.WNDPAR('SHADOW_DIAM',SHADIAM,LB_E, - 1 J0,A_B(-A_OB),SHADIAM,1)) THEN - IF (E_C.EQ.DWC_ENDOFLOOP) GOTO 800 - GOTO 218 - END IF -C -!*** PROJECTED BASELINE: -C - ELSE IF (NOPER.EQ.N_PBA) THEN - SELFLAG=FL_SHAD !DEFAULT FLAG TYPE: SHADOW - 219 CONTINUE - IF (.NOT.WNDPAR('PBAS_LIMITS',PBASLIM,2*LB_E, - 1 J0,A_B(-A_OB),PBASLIM,2)) THEN - IF (E_C.EQ.DWC_ENDOFLOOP) GOTO 800 - GOTO 219 - END IF -C -!*** CONTROL BUILDING INTERFERENCE: -C - ELSE IF (NOPER.EQ.N_CBI) THEN - SELFLAG=FL_SHAD !DEFAULT FLAG TYPE: SHADOW - CALL WNCTXT(F_TP,'Operation not available yet.') - GOTO 700 !ESCAPE -C -!*** RED, NORED -C - ELSE IF (NOPER.EQ.N_RED .OR. NOPER.EQ.N_NON) THEN - SELFLAG=FL_SHAD -C -!*** UNKNOWN FLAGGING OPERATION: -C - ELSE - CALL WNCTXT(F_T,'NFLOPS: Unknown flagging operation') - GOTO 800 !ESCAPE - END IF -C -C---------------------------------------------------------------------------- -C DRYRUN: -C - IF (DRYRUN) THEN - NDRYSCANS = 0 !RESET COUNTER - END IF -C -C---------------------------------------------------------------------------- -C CORRECTED DATA: -C - IF (CORRDAT) THEN - CALL WNDDAP(CAP,CDAP) !GET GLOBAL (DE-)APPLY BITS - DUFLAG = FL_ALL !INHIBIT DATA SELECTION BY FLAGS - CALL WNDDUF_SET(DUFLAG) !OVERRIDE GLOBAL USER FLAG - END IF -C - IF (TRACE) CALL WNCTXT (F_T,'NFLOPS: CORRDAT=!LJ',CORRDAT) -C -C---------------------------------------------------------------------------- -C SELFLAG: The default flag-type(s) for each flagging operation -C can be overridden by user-selected flag-type(s), given as the -C input argument USERFLAG (if USERFLAG.NE.0). - -C - IF (USERFLAG.NE.0) SELFLAG = USERFLAG !OVERRIDE WITH USER FLAG - IF (CFLAG.NE.0) SELFLAG = CFLAG !OVERRIDE WITH LOCAL FLAG - CFLAG = 0 !ALWAYS - IF (SELFLAG.EQ.0) THEN - CALL WNCTXT (F_TP, - 1 'No flag type(s) selected for this operation.') - GOTO 700 !ESCAPE - END IF -C - TXT80 = ' ' - I=1 - DO I6=0,MXNFLTYP-1 - IF (IAND(SELFLAG,FLAGTYPE(I6)).NE.0) THEN - CALL WNCTXS (TXT80(I:),' !4$AS',FLAGNAME(I6)) - IF (FLAGTYPE(I6).EQ.FL_ALL) TXT80(I:) = ' ' - I=I+5 - END IF - END DO - IF (TRACE) CALL WNCTXT (F_TP,'Flag-types used: !AS',TXT80) -C -C***************************************************************************** -C***************************************************************************** -C***************************************************************************** -C ACT ON HYPERCUBE -C - 300 CONTINUE -C -C Reset the flag-count buffers and the data statistics accumulators: -C - JS = NFLCNT ('RESET',' ',0,0,0,0,0) !FLAG COUNTERS -C -C Reset the data statistics accumulators: -C Assign some named accumulator slots that might be needed. -C (NB: Other slots will be assigned when necessary below) -C - R0 = NFLST1('RESET','#ALLGROUPS',' ',0,0.,0.) !Reset all accum. grps -C - R0 = NFLST1('ASSIGN','MAXABCS','UNIT=W.U.',1,0.,0.) - R0 = NFLST1('ASSIGN','REDNS_GX','UNIT=W.U.',1,0.,0.) - R0 = NFLST1('ASSIGN','REDNS_PX','UNIT=degr',1,0.,0.) - R0 = NFLST1('ASSIGN','REDNS_GY','UNIT=W.U.',1,0.,0.) - R0 = NFLST1('ASSIGN','REDNS_PY','UNIT=degr',1,0.,0.) - R0 = NFLST1('ASSIGN','ALGNS_GX','UNIT=W.U.',1,0.,0.) - R0 = NFLST1('ASSIGN','ALGNS_PX','UNIT=degr',1,0.,0.) - R0 = NFLST1('ASSIGN','ALGNS_GY','UNIT=W.U.',1,0.,0.) - R0 = NFLST1('ASSIGN','ALGNS_PY','UNIT=degr',1,0.,0.) - DO I3=0,3 - R0 = NFLST1('ASSIGN','DAT_A_'//POLNAME(I3), - 1 'UNIT=W.U.',STHIFR,0.,0.) - R0 = NFLST1('ASSIGN','DAT_P_'//POLNAME(I3), - 1 'UNIT=degr',STHIFR,0.,0.) - R0 = NFLST1('ASSIGN','DAT_C_'//POLNAME(I3), - 1 'UNIT=W.U.',STHIFR,0.,0.) - R0 = NFLST1('ASSIGN','DAT_S_'//POLNAME(I3), - 1 'UNIT=W.U.',STHIFR,0.,0.) - END DO -C -C Initialise the buffers for keeping data and HA of the last Scan, -C in such a way that they will be ignored for the first Scan. -C NB: This used to be inside the Sector-loop, because there is -C usually a discontinuity between Sectors. However, for mosaic -C data, all HA-Scans belonging to a particular pointing centre -C are stored in separate Sectors, and the WENSS team wishes to -C look for "un-physical" jumps in the residues....... -C Some more thought may be needed here. -C - DO I3=0,3 !ALL POLS - DO I1=0,STHIFR-1 !ALL IFRS - DO I=0,1 ! - HALAST(I1,I3,I) = VERYLARGE !HA OF LAST SCAN - CDATLAST(I1,I3,I) = 0 !DATA IN LAST SCAN - END DO - END DO - END DO -C -C Flow control for Scan headers (for data, see below): -C - MODFH_DFLT = .false. !MODIFY SWITCH FOR HEADERS - SETFH_DFLT = SETFLAG !SET/CLEAR SWITCH - FLAGH_DFLT = SELFLAG !FLAGBYTE FOR HEADERS - CNTFH_DFLT = .FALSE. !COUNT FLAGS IN HEADERS - STACCH_DFLT = .FALSE. !ACCUM. STATISTICS FROM HEADERS -C -C============================================================================= -C Read Set(s) of Sectors: -C - DO WHILE (NSCSTG(FCAIN,SETS,STH,STHP,SNAM)) !ALL SETS - IF (.NOT.NSCSIF(FCAIN,STH,IFRT,IFRA,ANG)) THEN !READ IFR TABLE - CALL WNCTXT(F_TP,'Error reading interferometer table') - GOTO 30 !NEXT SET - END IF -C -C--------------------------------------------------------------------------- -C Do some initialising per Sector: -C - CHCUR = STHI(STH_CHAN_I) !CURRENT CHANNEL - HAINC = STHE(STH_HAI_E) !HA increment (circles) -C -C Adjust the polarisation selection according to how many polarisations -C are available in this Sector. For security, return to the sub-cube -C selection first.....(?): -C - JS = NFLCUB ('SELECT','SUBCUBE',0,SELHA,SELPOL,SELIFR) - JS = NFLCUB ('ADJUST','SELPOL',STHI(STH_PLN_I), - 1 SELHA,SELPOL,SELIFR) -C -C Read baselines -C - CALL NSCMBL(STHE(STH_RTP_E),STHJ(STH_NIFR_J),IFRT, - 1 SELIFR,BASEL) -C -C Bookkeeping for statistics: -C - CALL NFLST0 ('SET','IFRTABLE',2*STHIFR,IFRA,0.) - CALL NFLST0 ('SET','BASEL',STHIFR,0,BASEL) !Baselines (m) - CALL NFLST0 ('SET','DIPOS',STHIFR,0,ANG) !Dipole angles - CALL NFLST0 ('ADD','CHAN',1,CHCUR,0.) !Channel nr -C -C Determine IFRMIN,MAX and POLMIN,MAX, to minimise processing later: -C - POLMIN = 3 - POLMAX = 0 - DO I3=0,3 !ALL POLS - IF (SELPOL(I3)) THEN !SELECTED POL - POLMIN = MIN(POLMIN,I3) - POLMAX = MAX(POLMAX,I3) - END IF - END DO -C - IFRMIN = STHIFR-1 - IFRMAX = 0 - DO I1=0,STHJ(STH_NIFR_J)-1 !ALL IFRS - RTW = IFRA(0,I1) !WEST TEL - RTE = IFRA(1,I1) !EAST TEL - IF (SELIFR(RTW,RTE)) THEN !SELECTED IFR - IFRMIN = MIN(IFRMIN,I1) - IFRMAX = MAX(IFRMAX,I1) - END IF - END DO -C -C Progress message (if TRACE): -C - TXT80 = WNTTSG(SNAM,-1) !SET NAME STRING - IF (TRACE) CALL WNCTXT (F_T,'NFLOPS: '//TXT80(:10)//':' - 1 //' IFRMIN,MAX=!SJ:!SJ ' - 1 //' POLMIN,MAX=!SJ:!SJ ' - 1 ,IFRMIN,IFRMAX,POLMIN,POLMAX) !Temporary -C -C--------------------------------------------------------------------------- -C Get extra information for some flagging actions: -C -!*** SHADOW, PROJECTED BASELINE: -C - IF (NOPER.EQ.N_SHA .OR. NOPER.EQ.N_PBA) THEN - CALL NSCMBL(STHE(STH_RTP_E),STHJ(STH_NIFR_J),IFRT, - 1 SELIFR,BASEL) !GET BASELINES - PBAS0=COS(STHD(STH_DEC_D)*DPI2)**2 !COS(DEC)**2 - IF (TRACE) CALL WNCTXT (F_T,' SHA:' - 1 //' PBAS0=!E6.3 DEC=!DAF6.1' - 1 ,PBAS0,STHD(STH_DEC_D)) - ELSE IF (NOPER.EQ.N_ELE) THEN - DEC=STHD(STH_DEC_D)*DPI2 -C -!*** CONTROL BUILDING INTERFERENCE: -C NB: The interference gets in via the telescope beam side-lobes, -C so we cannot use the theoretical (COS**6) expression here. -C The correct `beamshape' will be developed by experimentation later. -C - ELSE IF (NOPER.EQ.N_CBI) THEN - CALL NSCMBL(STHE(STH_RTP_E),STHJ(STH_NIFR_J),IFRT, - 1 SELIFR,BASEL) !GET BASELINES - DEC = STHD(STH_DEC_D)*DPI2 !POINTING DEC (RAD) - PBAS0=COS(DEC)**2 !BASELINE PROJECTION FACTOR - WSRTLAT = 52 * (360/PI2) !WSRT LATITUDE (RAD) - FRQ = STHD(STH_FRQ0_D) !FREQUENCY (MHZ)..??? -CCCCCCCC BEAMFAC = NMOBMF (FRQ) !For theoretical (COS**6) beam - CBIBPAR(0) = 1 !CBI `BEAMSHAPE' PARAM - CBIBINC = 1 !INCREMENT IN CBIBEAM - DO I1=0,CBIBMAX - R0 = EXP(-(I1*CBIBINC/CBIBPAR(0))**2) !GAUSSIAN? (SINC?) - CBIBEAM(I1) = R0 !RADIAL CBI `BEAM-SHAPE' - END DO -C -!*** QXY: Only if both XX and YY are available, and selected: -C - ELSE IF (NOPER.EQ.N_QXY) THEN - IF (SELPOL(XX).AND.SELPOL(YY)) THEN - CONTINUE - ELSE - CALL WNCTXT (F_TP,'NFLOPS option QXY:' - 1 //' Both XX and YY data are needed!') - GOTO 30 !ESCAPE, NEXT SECTOR - END IF -C -!*** YXY,UXY,VXY: Only if both XY and YX are available, and selected: -C - ELSE IF (NOPER.EQ.N_YXY .OR. - 1 NOPER.EQ.N_UXY .OR. - 1 NOPER.EQ.N_VXY) THEN - IF (SELPOL(XY).AND.SELPOL(YX)) THEN - CONTINUE - ELSE - CALL WNCTXT (F_TP,'NFLOPS option YXY,UXY,VXY:' - 1 //' Both XY and YX data are needed!') - GOTO 30 !ESCAPE, NEXT SECTOR - END IF -C -!*** RED, NORED, RRESID -C - ELSE IF (NOPER.EQ.N_RED .OR. - 1 NOPER.EQ.N_NON .OR. - 1 NOPER.EQ.N_RRE) THEN !GET REDUNDANT BASELINES - CALL NSCMBL(STHE(STH_RTP_E),STHJ(STH_NIFR_J),IFRT, - 1 SELIFR,BASEL) - CALL NCARRT(STHJ(STH_NIFR_J),BASEL,1E0,IRED,ANG) -C - END IF -C -C****************************************************************************** -C ACT ON HA-SCANS -C - 400 CONTINUE -C - DO I=0,STHJ(STH_SCN_J)-1 !ALL SCANS - HACUR=STHE(STH_HAB_E)+I*STHE(STH_HAI_E) !HA OF SCAN - IF (HACUR.GE.(SELHA(0)-HAINC/2+1E-5) .AND. - 1 HACUR.LE.(SELHA(1)+HAINC/2-1E-5)) THEN !SELECTED -C - IF (.NOT.NSCSCH(FCAIN,STH,IFRT,I,0,0,SCH)) THEN !READ HEADER - CALL WNCTXT(F_TP,'Error reading scan header !UJ',I) - GOTO 30 - END IF -C -C Bookkeeping for statistics: -C - CALL NFLST0 ('ADD','HACIR',1,0,HACUR) -C -C Reset the actual switches for treatment of Scan header flags: -C - MODFH = MODFH_DFLT !MODIFY HEADER FLAGS - FLAGH = FLAGH_DFLT !FLAG TO BE USED FOR HEADER - SETFH = SETFH_DFLT !SET/CLEAR FOR HEADER - CNTFH = CNTFH_DFLT !COUNT FLAG IN HEADER - STACCH = STACCH_DFLT !ACCUM HEADER STATISTICS -C -C Set default switches for treatment of uv-data flags: -C - MODFD_DFLT = .FALSE. !NO MODIFICATION OF DATA FLAGS - FLAGD_DFLT = SELFLAG !FLAG TO USE FOR DATA - SETFD_DFLT = SETFLAG !SET/CLEAR FOR DATA - CNTFD_DFLT = .FALSE. !NO COUNT FLAG IN DATA - STACCD_DFLT = .FALSE. !NO ACCUM DATA STATISTICS -C -C Some initial settings per Scan: -C - SELECT = .FALSE. !SELECTION CRITERION NOT MET - CHKDATA=.TRUE. !DEFAULT: CHECK DATA (???) - WRSCH=.FALSE. !NO REWRITE SCAN HEADER - WRSCN=.FALSE. !NO REWRITE SCAN DATA - CRITVALH = 0 !FLAGGING CRITERION VALUE - STATWGTH = 0 !ACCUMULATION WEIGHT -C -!*** DRY RUN: -C - IF (DRYRUN) THEN - STACCH = .TRUE. !ACCUM. HEADER STATISTICS - STACCD_DFLT = .TRUE. !ACCUM. DATA STATISTICS - END IF -C -!*** COUNT (flags): -C - IF (NOPER.EQ.N_COU) THEN - CNTFH = .TRUE. !COUNT HEADER FLAG - CNTFD_DFLT = .TRUE. !COUNT DATA FLAGS -C -!*** STATISTICS (of header info and /or uv-data): -C - ELSE IF (NOPER.EQ.N_ACC) THEN - STACCH = .TRUE. ! - STACCD_DFLT = .TRUE. ! - CNTFH = .TRUE. !COUNT HEADER FLAG - CNTFD_DFLT = .TRUE. !COUNT DATA FLAGS - ELSE IF (NOPER.EQ.N_ACH) THEN - CHKDATA = .FALSE. !HEADERS ONLY - STACCH = .TRUE. ! - CNTFH = .TRUE. !COUNT HEADER FLAG - ELSE IF (NOPER.EQ.N_ACD) THEN - STACCD_DFLT = .TRUE. ! - CNTFD_DFLT = .TRUE. !COUNT DATA FLAGS -C -!*** CLEAR FLAGS -C - ELSE IF (NOPER.EQ.N_CLE .OR. - 1 NOPER.EQ.N_CLD .OR. - 1 NOPER.EQ.N_CLH) THEN - MODFH = .TRUE. !MODIFY SCAN HEADER FLAGS - MODFD_DFLT = .TRUE. !MODIFY ALL UV-DATA FLAGS - CHKDATA = .FALSE. !WITHOUT EVEN CHECKING IT - SETFH = .FALSE. !CLEAR HEADER FLAG(S) - SETFD_DFLT = .FALSE. !CLEAR DATA FLAG(S) - IF (NOPER.EQ.N_CLH) MODFD_DFLT = .FALSE. !HEADERS ONLY - IF (NOPER.EQ.N_CLD) MODFH = .FALSE. !DATA ONLY -C -!*** TOHEAD -C - ELSE IF (NOPER.EQ.N_TOH) THEN - TOH_COUNT = 0 !RESET FLAG COUNTER - FLAGH = 0 !INITIALISE NEW HEADER FLAG -C -!*** TODATA -C - ELSE IF (NOPER.EQ.N_TOD) THEN - FLAGH = SCHJ(SCH_BITS_J) !COPY HEADER FLAG(S) - FLAGD_DFLT = IAND(FLAGH,SELFLAG) !SELECTED FLAG TYPES ONLY - MODFD_DFLT = .TRUE. !MODIFY DATA FLAGS always - CHKDATA = .FALSE. !DO NOT LOOK AT DATA ITSELF - MODFH = .TRUE. !MODIFY HEADER FLAG(S) - SETFH = .FALSE. !CLEAR HEADER FLAG(S) -C -!*** SHADOW, PROJECTED BASELINE: -C - ELSE IF (NOPER.EQ.N_SHA .OR. NOPER.EQ.N_PBA) THEN - PBAS=SQRT(MAX(0.,1.-PBAS0* - 1 (SIN(HACUR*PI2)**2))) !BASELINE PROJECTION FACTOR -C - IF (NOPER.EQ.N_SHA) THEN !SHADOW ONLY - DO I1=0,STHTEL-1 - SHATEL(I1)=.FALSE. !TEL NOT SHADOWED - END DO - I6=0 !WEST TELS ARE SHADOWED - IF (HACUR.GE.0) I6=1 !EAST TELS ARE SHADOWED - DO I1=0,STHJ(STH_NIFR_J)-1 !ALL IFRS - IF (BASEL(I1).GT.0) THEN !BASELINE LENGTH (M) - IF ((BASEL(I1)*PBAS).LE.SHADIAM) THEN - SHATEL(IFRA(I6,I1))=.TRUE. !TEL IS SHADOWED - END IF - END IF - END DO - END IF -C -!*** ELEVATION -C - ELSE IF (NOPER.EQ.N_ELE) THEN - ELEV = ASIN(SIN(DEC)*SLATW + - 1 COS(DEC)*COS(HACUR*PI2)*CLATW) !ELEVATION - MODFD_DFLT=(ELEV.LT.ELELIMIT*PI2) !TOO LOW? - CHKDATA = .FALSE. !DO NOT LOOK AT DATA -C -!*** CONTROL BUILDING INTERFERENCE: Figure out the angle (rad) between the -! the control building (CB) and the pointing centre of each telescope. -! as a function of telescope position, source HA and elevation. -! Then calculate the beam gain factor (max=1) for each telescope, -! using a tentative CBI `beamshape', which includes the sidelobes. -! NB: The CB (i.e. correlator-cage) is at 760m east of RT0, and 60m south. -! NB: This algorithm is still experimental, and will be worked upon. -C - ELSE IF (NOPER.EQ.N_CBI) THEN - ELEV = DEC + ((PI/2)-WSRTLAT)*COS(HACUR*PI2) !ELEVATION - DO I4 = 0,STHTEL-1 !ALL TELESCOPES - R0 = STHE(STH_RTP_E+I4) !RT POSITION (M) - CBDIR = ATAN2(60.,R0-760.) !DIRECTION OF CB .... - CBDIST = SQRT(60.**2+(R0-760.)**2) !DISTANCE TO CB - LREL = CBDIR-HACUR !ARCSEC? - MREL = ELEV !ARCSEC? -CCCC NB: L,M should be rotated by angle (90-WSRTLAT)*COS(HA) -CCCC CBIFACT(I4) = NMOBMV (FRQ,BEAMFAC,LREL,MREL, -CCCC 1 BEMLIM,.TRUE.) !Theoretical (COS**6) beam: do not use! - CBIFACT(I4) = 0 !TELESCOPE CBI GAIN FACTOR - R1 = ATAN2(LREL,MREL) !BEAM ANGLE (RAD) OF CB ?? - J1 = NINT(ABS(R1)/CBIBINC) !INDEX IN CBIBEAM - IF (J1.LE.CBIBMAX) CBIFACT(I4) = CBIBEAM(J1) - CBIFACT(I4) = CBIFACT(I4)/(CBDIST**2) !CORRECT FOR DISTANCE - END DO -C -!*** SCANS: -C - ELSE IF (NOPER.EQ.N_SCA) THEN - MODFH = .TRUE. !MODIFY HEADER FLAGS - CHKDATA = .FALSE. !DO NOT LOOK AT DATA -C -!*** DATA: -C - ELSE IF (NOPER.EQ.N_UVD) THEN - MODFD_DFLT = .TRUE. !MODIFY UV-DATA FLAGS - CHKDATA = .FALSE. !DO NOT LOOK AT DATA -C -!*** HA-RANGE: -C - ELSE IF (NOPER.EQ.N_HAR) THEN - MODFD_DFLT= - 1 (HACUR.GE.(HAR(0)-HAINC/2+1E-5) .AND. - 1 HACUR.LE.(HAR(1)+HAINC/2-1E-5)) !MODIFY UV-DATA FLAGS - CHKDATA = .FALSE. !DO NOT LOOK AT DATA -C -!*** MAX (ABS(COS),ABS(SIN)): -C - ELSE IF (NOPER.EQ.N_MAX) THEN - CHKDATA=.FALSE. !SKIP DATA - STACCH = .TRUE. !ACCUMULATE STATISTICS - CRITVALH = SCHE(SCH_MAX_E) - STATWGTH = 1. !ACCUMULATION WEIGHT - IF (CRITVALH.LT.MXLIM(0)) SELECT = .TRUE. !TOO SMALL - IF (CRITVALH.GT.MXLIM(1)) SELECT = .TRUE. !TOO LARGE - MODFH = .TRUE. !MODIFY HEADER FLAGS (ALWAYS) - SETFH = SELECT !SET FLAG IF SELECTED, CLEAR OTHERWISE -C -!*** RED/ALG Noises: -C - ELSE IF ( - 1 NOPER.EQ.N_RNO .OR. NOPER.EQ.N_ANO .OR. - 1 NOPER.EQ.N_XRN .OR. NOPER.EQ.N_YRN .OR. - 1 NOPER.EQ.N_XAN .OR. NOPER.EQ.N_YAN) THEN -C - MODFH = .TRUE. !MODIFY HEADER FLAGS (ALWAYS) - CHKDATA=.FALSE. !DO NOT LOOK AT UV-DATA - STACCH = .TRUE. !ACCUMULATE HEADER STATISTICS - CRITVALH = 0 !CRITERION VALUE (HEADER) - STATWGTH = 1. !CRITVALH STATISTICS WEIGHT -C - IF (NOPER.EQ.N_RNO) THEN - DO I4=0,3 !Gain/phase, X,Y - CRITVALH = MAX(CRITVALH,SCHE(SCH_REDNS_E+I4)) - IF (SCHE(SCH_REDNS_E+I4).LT.0) SELECT=.TRUE. - END DO - ELSE IF (NOPER.EQ.N_XRN) THEN - DO I4=0,1 !Gain/phase, X only - CRITVALH = MAX(CRITVALH,SCHE(SCH_REDNS_E+I4)) - IF (SCHE(SCH_REDNS_E+I4).LT.0) SELECT=.TRUE. - END DO - ELSE IF (NOPER.EQ.N_YRN) THEN - DO I4=2,3 !Gain/phase, Y only - CRITVALH = MAX(CRITVALH,SCHE(SCH_REDNS_E+I4)) - IF (SCHE(SCH_REDNS_E+I4).LT.0) SELECT=.TRUE. - END DO -C - ELSE IF (NOPER.EQ.N_ANO) THEN - DO I4=0,3 !Gain/phase, X,Y - CRITVALH = MAX(CRITVALH,SCHE(SCH_ALGNS_E+I4)) - IF (SCHE(SCH_ALGNS_E+I4).LT.0) SELECT=.TRUE. - END DO - ELSE IF (NOPER.EQ.N_XAN) THEN - DO I4=0,1 !Gain/phase, X only - CRITVALH = MAX(CRITVALH,SCHE(SCH_ALGNS_E+I4)) - IF (SCHE(SCH_ALGNS_E+I4).LT.0) SELECT=.TRUE. - END DO - ELSE IF (NOPER.EQ.N_YAN) THEN - DO I4=2,3 !Gain/phase, Y only - CRITVALH = MAX(CRITVALH,SCHE(SCH_ALGNS_E+I4)) - IF (SCHE(SCH_ALGNS_E+I4).LT.0) SELECT=.TRUE. - END DO - END IF -C - IF (CRITVALH.LT.MXLIM(0)) SELECT = .TRUE. !TOO SMALL - IF (CRITVALH.GT.MXLIM(1)) SELECT = .TRUE. !TOO LARGE - SETFH = SELECT !SET FLAG IF SELECTED, CLEAR OTHERWISE -C - END IF -C -C***************************************************************************** -C READ SCAN DATA (If required): -C - IF ((.NOT.CHKDATA).AND.(.NOT.MODFD_DFLT)) GOTO 40 !SKIP -C - IF (.NOT.WNFRD(FCAIN,STHJ(STH_SCNL_J)-SCH__L, - 1 LDAT,STHJ(STH_SCNP_J)+I*STHJ(STH_SCNL_J)+ - 1 SCH__L)) THEN !READ SCAN DATA - CALL WNCTXT(F_TP,'Error reading scan !UJ',I) - GOTO 800 - END IF -C -!*** TOTEL,TOPOL: Make a copy (LDAT1) of the uv-data (LDAT) for later use. -C - IF (NOPER.EQ.N_TOT .OR. NOPER.EQ.N_TOP) THEN - CALL WNGMV(STHJ(STH_SCNL_J)-SCH__L,LDAT,LDAT1) !COPY DATA - END IF -C -!*** APPLY/DE-APPLY CORRECTIONS TO THE UV-DATA (if required): -C - IF (CORRDAT) THEN - IF (.NOT.NSCSCR(FCAIN,STH,IFRT,I, - 1 CAP,CDAP,SCH,WGT,CDAT)) THEN - CALL WNCTXT(F_TP, - 1 'Error reading scan !UJ (data)',I) - GOTO 30 !NEXT SECTOR (?) - END IF - END IF -C -!*** ARESID, RT1: -C NSCSCM reads the stored uv-model into CAMOD! (parallel dipoles only!) -C NB: The model is NEGATIVE! -C - IF ((NOPER.EQ.N_ARE) .OR. - 1 (NOPER.EQ.N_RT1)) THEN - IF (.NOT.NSCSCM(FCAIN,STH,IFRT,I, - 1 CAP,CDAP,SCH,WGT,CAMOD)) THEN - CALL WNCTXT(F_TP, - 1 'Error reading scan !UJ (model)',I) - GOTO 30 !NEXT SECTOR (?) - END IF -C -!*** RRESID -C - ELSE IF (NOPER.EQ.N_RRE) THEN !CALCULATE "MODEL" - DO I1=0,STHJ(STH_NIFR_J)-1 !ZERO CELESTIAL DATA - DO I3=0,3,3 !XX,YY - CAMOD(I1,I3)=0 - MWGT(I3,I1)=0 - END DO - END DO - DO I1=0,STHJ(STH_NIFR_J)-1 - I2=IRED(I1) !REDUNDANT? - IF (I2.GT.0) THEN !CAN USE - DO I3=0,3,3 !XX,YY - IF (WGT(I1,I3).GT.0) THEN !CAN USE - CAMOD(I2,I3)=CAMOD(I2,I3)+WGT(I1,I3)*CDAT(I1,I3) !SUM - MWGT(I3,I2)=MWGT(I3,I2)+WGT(I1,I3) - END IF - END DO - END IF - END DO - DO I1=0,STHJ(STH_NIFR_J)-1 !SOLVE - DO I3=0,3,3 - IF (MWGT(I3,I1).GT.0) - 1 CAMOD(I1,I3)=CAMOD(I1,I3)/MWGT(I3,I1) - END DO - END DO -C - END IF -C -C****************************************************************************** -C ACT ON UV-DATA -C - 500 CONTINUE -C -C Set flag-count and statistics accumulation buffers to undefined: -C NB: The flags and values per uv-data point are stored per Scan, -C so that they can be processed in a single call to NFLCNT/NFLSTn. -C (Separate calls for each uv-data point take too much time). -C - DO I3=0,3 !ALL POLS - VALIDAT(I3) = .FALSE. - DO I1=0,STHIFR-1 !ALL IFRS - FLACC(I1,I3) = 0 !Flag counts - MASK(I1,I3) = 0 !Masks used - STATWGTD(I1,I3) = 0. !Statistics weight - CRITVALD(I1,I3) = 0. !Criterion value - END DO - END DO -C -C Go through the uv-data: -C - DO I1=IFRMIN,IFRMAX !ALL relevant IFRS - RTW = IFRA(0,I1) !WEST TELESCOPE - RTE = IFRA(1,I1) !EAST TELESCOPE -CC RTW = MOD(IFRT(I1),256) !Alternative... -CC RTE = IFRT(I1)/256 !Alternative... - IF (SELIFR(RTW,RTE)) THEN !SELECTED IFR - I2=STHI(STH_PLN_I)*I1 !DATA POINTER - DO I3=POLMIN,POLMAX !ALL POLS - VALIDAT(I3) = .FALSE. - IF (SELPOL(I3)) THEN !SELECTED POL - LDOFF(I3)=I2+PPOL(I3,STHI(STH_PLN_I),1) !OFFSET - WFDAT(I3)=LDAT(0,LDOFF(I3)) !WEIGHT/FLAGS - WFDAT(I3)=IAND('0000ffff'X,WFDAT(I3)) !WEIGHT/FLAGS - IF (WFDAT(I3).NE.0) THEN !DATA PRESENT (WEIGHT<>0) - VALIDAT(I3) = .TRUE. !VALID DATA -C - MODFD(I3) = MODFD_DFLT !MODIFY FLAGS, OR NOT - FLAGD(I3) = FLAGD_DFLT !FLAGBYTE TO BE USED - SETFD(I3) = SETFD_DFLT !SET/CLEAR FLAG(S) - CNTFD(I3) = CNTFD_DFLT !COUNT FLAGS - STACCD(I3) = STACCD_DFLT !ACCUM. DATA STATISTICS -C - SELECT = .FALSE. !ASSUME CRITERION NOT MET - IF (.NOT.CORRDAT) THEN !UV-DATA ALWAYS IN CDAT! - DAT(0,I1,I3) = REAL(LDAT(1,LDOFF(I3))) !COS - DAT(1,I1,I3) = REAL(LDAT(2,LDOFF(I3))) !SIN - END IF - IF (NOPER.EQ.N_RT1) THEN - CDAT(I1,I3)=CDAT(I1,I3)+CAMOD(I1,I3) !RESIDUE!!! - END IF - STATWGTD(I1,I3) = 1. !STATISTICS WEIGHT NON-ZERO -C -! Check the current uv-data value for various flagging operations: -C - IF (.NOT.CHKDATA) THEN - CONTINUE !NO NOT CHECK UV-DATA -C -!*** CLIP -C - ELSE IF (NOPER.EQ.N_AMP .OR. - 1 NOPER.EQ.N_COS .OR. - 1 NOPER.EQ.N_SIN) THEN - IF (NOPER.EQ.N_AMP) R1=ABS(CDAT(I1,I3)) !AMPLITUDE - IF (NOPER.EQ.N_COS) R1=ABS(DAT(0,I1,I3)) !ABS(COS) - IF (NOPER.EQ.N_SIN) R1=ABS(DAT(1,I1,I3)) !ABS(SIN) - CRITVALD(I1,I3) = R1 !STORE FOR STATISTICS - IF (R1.LT.MXLIM(0)) SELECT=.TRUE. !TOO SMALL - IF (R1.GT.MXLIM(1)) SELECT=.TRUE. !TOO LARGE - MODFD(I3) = .TRUE. !MODIFY DATA FLAGS (ALWAYS) - SETFD(I3) = SELECT !SET/CLEAR DATA FLAGS -C -!*** ARESID -C - ELSE IF (NOPER.EQ.N_ARE) THEN - R1=ABS(CDAT(I1,I3)+CAMOD(I1,I3)) - CRITVALD(I1,I3) = R1 !STORE FOR STATISTICS - IF (R1.GT.MXLIM(1)) SELECT=.TRUE. !DO CLIP - MODFD(I3) = .TRUE. !MODIFY DATA FLAGS (ALWAYS) - SETFD(I3) = SELECT !SET/CLEAR DATA FLAGS -C - IF (TRACE) THEN !TRACE WHAT HAPPENS - CALL WNCTXT (F_T,'ARESID: HA=!7$EA7.2:' - 1 //' DAT=!12$EC6.0' - 1 //' MOD=!12$EC6.0' - 1 //' R1=!6$E6.0(!5$E5.0) !LJ' - 1 ,HACUR,CDAT(I1,I3),-CAMOD(I1,I3) - 1 ,R1,MXLIM(1),IAND(WFDAT(I3),FL_ALL)) - END IF -C -!*** RRESID -C - ELSE IF (NOPER.EQ.N_RRE) THEN - IF (IRED(I1).GT.0) THEN !REDUNDANT BASELINE - IF (I3.LT.3) THEN !CHECK XX - R1=ABS(CDAT(I1,0)-CAMOD(IRED(I1),0)) - CRITVALD(I1,I3) = R1 !STORE FOR STATISTICS - IF (R1.GT.MXLIM(1)) SELECT=.TRUE. !DO CLIP - END IF - IF (I3.GT.0) THEN !CHECK YY - R1=ABS(CDAT(I1,3)-CAMOD(IRED(I1),3)) - CRITVALD(I1,I3) = R1 !STORE FOR STATISTICS - IF (R1.GT.MXLIM(1)) SELECT=.TRUE. !DO CLIP - END IF - END IF - MODFD(I3) = .TRUE. !MODIFY DATA FLAGS (ALWAYS) - SETFD(I3) = SELECT !SET/CLEAR DATA FLAGS -C - IF (TRACE) THEN !TRACE WHAT HAPPENS - CALL WNCTXT (F_T,'RRESID: HA=!6$EA6.1:' - 1 //' DAT=!12$EC6.0' - 1 //' MOD=!12$EC6.0' - 1 //' R1=!6$E6.0(!5$E5.0)',HACUR - 1 ,CDAT(I1,I3),CAMOD(IRED(I1),0) - 1 ,R1,MXLIM(1)) - END IF -C -!*** DT1: Compare the amplitude (?) of the current uv-point with that of its -! predecessor in the last selected Scan, and calculate dA/dHA. -! If the difference is greater than the specified limit (i.e. if -! it is an `unphysical jump'), the uv-point is `selected'. -! NB: Selected points are flagged, un-selected points are unflagged! -! Experimentally, the difference with the last UNFLAGGED uv-point -! is also considered, to take care of all kinds of situations. -C*** RT1: Same as DT1, but for residues (i.e. data-model). CDAT already -C contains the residues (done above). -C - ELSE IF ((NOPER.EQ.N_DT1) .OR. - 1 (NOPER.EQ.N_RT1)) THEN - R1=ABS(CDAT(I1,I3)-CDATLAST(I1,I3,1)) !LAST POINT - DHA=(HACUR-HALAST(I1,I3,1))/HAINC !HA DIFF - IF (DHA.LE.0) R1 = 0 !??? - IF (DHA.GT.0) R1 = R1/DHA !dA/dHA -C - R0=ABS(CDAT(I1,I3)-CDATLAST(I1,I3,0)) !LAST UNFL. - DHA=(HACUR-HALAST(I1,I3,0))/HAINC !HA DIFF - IF (DHA.LE.0) R0 = 0 - IF (DHA.GT.0) R0 = R0/DHA !dA/dHA -C - R2 = MIN(R0,R1) !TAKE THE SMALLEST ??? - CRITVALD(I1,I3) = R2 !STORE FOR STATISTICS - IF (R1.GT.MXLIM(1)) SELECT=.TRUE. - MODFD(I3) = .TRUE. !MODIFY DATA FLAGS (ALWAYS) - SETFD(I3) = SELECT !SET/CLEAR DATA FLAGS -C - IF (TRACE) THEN !TRACE WHAT HAPPENS - CALL WNCTXT (F_T,'DT1/RT1: HA=!6$EA6.1:' - 1 //' CDAT=!12$EC6.0' - 1 //' R1=!6$E6.0' - 1 //' R0=!6$E6.0(!4$E4.1)' - 1 //' SEL=!LJ' - 1 ,HACUR,CDAT(I1,I3) - 1 ,R1,R0,DHA - 1 ,SELECT) - END IF -C -!*** SHADOW: Set the specified flag type(s) if one of the two telescopes -! of this interferometer is shadowed by another, as given by -! the array SHATEL (see above). -C - ELSE IF (NOPER.EQ.N_SHA) THEN - IF (SHATEL(RTW) .OR. - 1 SHATEL(RTE)) SELECT=.TRUE. - SETFD(I3) = SELECT !SET/CLEAR FLAGS - MODFD(I3) = .TRUE. !MODIFY UV-DATA FLAGS -C -!*** PROJ.BASELINE: Set the specified flag type(s) if the projected baseline is -! between the two specified limits (PBASLIM). -! NB: Earlier flags are not cleared here, because one might -! want to flag multiple rings in the uv-plane. -C - ELSE IF (NOPER.EQ.N_PBA) THEN - R1 = BASEL(I1)*PBAS - CRITVALD(I1,I3) = R1 !STORE FOR STATISTICS - IF (R1.GE.PBASLIM(0) .AND. - 1 R1.LE.PBASLIM(1)) SELECT = .TRUE. - SETFD(I3) = SELECT !SET/CLEAR FLAGS - MODFD(I3) = .TRUE. !MODIFY UV-DATA FLAGS -C -!*** CONTROL BUILDING INTERFERENCE: For each interferometer, calculate the -! product of the telescope beam gains in the direction of the control -! building (correlator cage). -C - ELSE IF (NOPER.EQ.N_CBI) THEN - R1 = CBIFACT(RTW) * CBIFACT(RTE) - CRITVALD(I1,I3) = R1 !STORE FOR STATISTICS - IF (R1.GT.MXLIM(1)) SELECT = .TRUE. - SETFD(I3) = SELECT !SET/CLEAR FLAGS - MODFD(I3) = .TRUE. !MODIFY UV-DATA FLAGS -C -!*** RED: Set the specified flag type(s) if the baseline is redundant. -C - ELSE IF (NOPER.EQ.N_RED) THEN - IF (IRED(I1).GT.0) MODFD(I3)=.TRUE. !REDUNDANT -C -!*** NONRED: Idem for non-redundant baselines. -C - ELSE IF (NOPER.EQ.N_NON) THEN - IF (IRED(I1).LE.0) MODFD(I3)=.TRUE. !NON-REDUNDANT -C -!*** TOTEL: Copy selected flags FROM other ifrs that share a telescope -! with the current ifr. -! Check the other ifrs (in a copy LDAT1 of the uv-data) for flags of -! the specified type(s) (SELFLAG). If these ifrs share a telescope -! with the current ifr, add the flags to the flagbyte (FLAGD(I3)) -C - ELSE IF (NOPER.EQ.N_TOT) THEN - FLAGD(I3)=0 !NOTHING - DO I6=0,STHJ(STH_NIFR_J)-1 !CHECK ALL IFR - IF ((RTW.EQ.IFRA(0,I6)) .OR. - 1 (RTE.EQ.IFRA(1,I6))) THEN !SHARED TEL - I7=STHI(STH_PLN_I)*I6 !DATA POINTER - I7=I7+PPOL(I3,STHI(STH_PLN_I),1) !DATA OFFSET - I8=LDAT1(0,I7) !WEIGTH/FLAG - I8=IAND('0000ffff'X,I8) !WEIGHT - IF (IAND(SELFLAG,I8).NE.0) THEN !FLAG SELECTED - FLAGD(I3)=IOR(FLAGD(I3),IAND(SELFLAG,I8)) - MODFD(I3)=.TRUE. - END IF - END IF - END DO -C -!*** TOPOL: Copy selected flags FROM the other polarisations of the -! current ifr. -! Check the other polarisations of this ifr (in a copy LDAT1 of -! the uv-data) for flags of the specified type(s) (SELFLAG). If they -! are present, add them to the flagbyte for this ifr (FLAGD(I3)) -C - ELSE IF (NOPER.EQ.N_TOP) THEN - FLAGD(I3)=0 !NOTHING - DO I6=0,3 !CHECK ALL POLS - IF (I6.NE.I3) THEN !NOT ITSELF - I7=STHI(STH_PLN_I)*I1 !DATA POINTER - I7=I7+PPOL(I6,STHI(STH_PLN_I),1) !DATA OFFSET - I8=LDAT1(0,I7) !COPY OF THE DATA - I8=IAND('0000ffff'X,I8) !WEIGHT/FLAGS - IF (IAND(SELFLAG,I8).NE.0) THEN !FLAG SELECTED - FLAGD(I3)=IOR(FLAGD(I3),IAND(SELFLAG,I8)) - MODFD(I3)=.TRUE. - END IF - END IF - END DO -C -!*** TOHEAD: Count the number of uv-data points in this Scan that have been -! flagged with the specified flag type(s). If this number exceeds -! a specified limit, set the same flag type(s) in the Scan header. -C - ELSE IF (NOPER.EQ.N_TOH) THEN - IF (IAND(WFDAT(I3),SELFLAG).NE.0) THEN !FLAGGED - FLAGH=IOR(FLAGH,IAND(WFDAT(I3),SELFLAG)) !BYTE - TOH_COUNT=TOH_COUNT+1 !COUNT FLAGS - END IF - IF (TOH_COUNT.GT.TOH_LIMIT) GOTO 50 !ENOUGH, ESCAPE -C -C - END IF !END OF NOPER -C -C NEXT POL (I3): -C - END IF !VALID DATA - END IF !POL. SELECT - END DO !POLS (I3) -C -C---------------------------------------------------------------------------- -C Operations (e.g. N_QXY) that depend on more than one pol: -C -!*** QXY: Compare XX and YY (i.e. Q if parallel dipoles): -C - IF (NOPER.EQ.N_QXY) THEN - IF (VALIDAT(XX).AND.VALIDAT(YY)) THEN !BOTH VALID - R1=ABS(CDAT(I1,XX)-CDAT(I1,YY)) - IF (R1.GT.MXLIM(1)) SELECT=.TRUE. !DO CLIP - DO I3=0,3 !ALL POLS (?) - MODFD(I3) = .TRUE. !MODIFY DATA FLAGS (ALWAYS) - SETFD(I3) = SELECT !SET/CLEAR DATA FLAGS - END DO - CRITVALD(I1,XX) = R1 !STORE FOR STATISTICS - STATWGTD(I1,XY) = 0. !NO STATISTICS FOR XY - STATWGTD(I1,YX) = 0. !NO STATISTICS FOR YX - STATWGTD(I1,YY) = 0. !NO STATISTICS FOR YY - END IF -C -!*** YXY, UXY: Compare XY and YX (i.e. U if parallel dipoles): -! NB: YXY and UXY are exactly the same (at the moment): -C - ELSE IF (NOPER.EQ.N_YXY .OR. - 1 NOPER.EQ.N_UXY) THEN - IF (VALIDAT(XY).AND.VALIDAT(YX)) THEN !BOTH VALID - R1=ABS(CDAT(I1,XY)-CDAT(I1,YX)) - IF (R1.GT.MXLIM(1)) SELECT=.TRUE. !DO CLIP - DO I3=0,3 !ALL POLS (?) - MODFD(I3) = .TRUE. !MODIFY DATA FLAGS (ALWAYS) - SETFD(I3) = SELECT !SET/CLEAR DATA FLAGS - END DO - STATWGTD(I1,XX) = 0. !NO STATISTICS FOR XY - CRITVALD(I1,XY) = R1 !STORE FOR STATISTICS - STATWGTD(I1,YX) = 0. !NO STATISTICS FOR YX - STATWGTD(I1,YY) = 0. !NO STATISTICS FOR YY - END IF -C -C -!*** VXY: ABS(j(XY+YX)) (i.e. |V| if parallel dipoles): -C - ELSE IF (NOPER.EQ.N_VXY) THEN - IF (VALIDAT(XY).AND.VALIDAT(YX)) THEN !BOTH VALID - R1=ABS(CDAT(I1,XY)+CDAT(I1,YX)) !IGNORE J - IF (R1.GT.MXLIM(1)) SELECT=.TRUE. !DO CLIP - DO I3=0,3 !ALL POLS (?) - MODFD(I3) = .TRUE. !MODIFY DATA FLAGS (ALWAYS) - SETFD(I3) = SELECT !SET/CLEAR DATA FLAGS - END DO - STATWGTD(I1,XX) = 0. !NO STATISTICS FOR XY - CRITVALD(I1,XY) = R1 !STORE FOR STATISTICS - STATWGTD(I1,YX) = 0. !NO STATISTICS FOR YX - STATWGTD(I1,YY) = 0. !NO STATISTICS FOR YY - END IF -C - END IF !END OF NOPER -C -C---------------------------------------------------------------------------- -C Go through the pols again, to modify data flags, count set flags and -C accumulate statistics, according to the switches that have been set above: -C - DO I3=POLMIN,POLMAX !ALL POLS - IF (VALIDAT(I3)) THEN !VALID DATA -C -C---------------------------------------------------------------------------- -C MODIFY UV-DATA FLAGS (IF REQUIRED): -C - IF (DRYRUN) MODFD(I3) = .FALSE. !NOT IF DRY RUN -C - IF (MODFD(I3)) THEN !MODIFY UV-DATA - IF (SETFD(I3)) THEN !SET FLAG - WFDAT(I3)=IOR(WFDAT(I3),FLAGD(I3)) - ELSE !RESET FLAG - WFDAT(I3)=IAND(WFDAT(I3),NOT(FLAGD(I3))) - END IF - IF (IAND(WFDAT(I3),'00008000'X).NE.0) - 1 WFDAT(I3)=IOR(WFDAT(I3),'ffff0000'X) !OVERFLOW - LDAT(0,LDOFF(I3))=WFDAT(I3) !MODIFIED FLAG-BYTE - WRSCN=.TRUE. !REWRITE SCAN DATA - CNTFD(I3) = .TRUE. !COUNT FLAGS - END IF -C -C---------------------------------------------------------------------------- -!*** Count flags (i.e. store them for later counting): -C - IF (CNTFD(I3)) THEN - FLACC(I1,I3) = WFDAT(I3) !DATA FLAG - MASK(I1,I3) = FLAGD(I3) !FLAGGING MASK USED - END IF -C -!*** STATISTICS: If the uv-data point is flagged with the selected -! flag type(s) (specified in FLAGD(I3)), then set the statistics weight -! to zero, so it will be ignored: -C - IF (IAND(FLAGD(I3),WFDAT(I3)).NE.0) THEN - STATWGTD(I1,I3) = 0. - END IF -C -C Store current data value (and its HA) for later use (e.g. DT1): -C - CDATLAST(I1,I3,1) = CDAT(I1,I3) !LAST UV-POINT - HALAST(I1,I3,1) = HACUR !ITS HA -C - IF (IAND(WFDAT(I3),FL_ALL).EQ.0) THEN !IF NO FLAGS SET - CDATLAST(I1,I3,0) = CDAT(I1,I3) !LAST UNFLAGGED PNT - HALAST(I1,I3,0) = HACUR !ITS HA - END IF -C---------------------------------------------------------------------------- -C -C NEXT POL (I3): -C - END IF !VALID DATA - END DO !POLS (I3) -C -C---------------------------------------------------------------------------- -C---------------------------------------------------------------------------- -C NEXT IFR (I1): -C - END IF !IFR SELECT - END DO !IFRS (I1) -C - 50 CONTINUE !FOR ESCAPE FROM IFR-LOOP -C -C COUNT data flags (always, even if CNTFD_DFLT is FALSE: CNTFD(I3) may have -C been TRUE for some individual data, for some reason): -C - JS = NFLCNT ('ACC','DATA',FLACC,MASK,IFRA,CHCUR,HACUR) -C -C ACCUMULATE DATA STATISTICS (if required): -C NB: NFLST1 takes 1 or more values that are all accumulated in separate -C slots (e.g. per ifr). In the future this information will be used -C to calculate separate flagging limits per ifr (for instance). -C NB: STATWGTD(I1,I3) gets corrupted, probably during Dryrun's only, -C and not the first time. I cannot find the cause, and therefore -C have added a kludge: since in the present incarnation STATWGTD -C can only be 1 or 0, S_WGT is set to Zero if it is not One. -C - IF (STACCD_DFLT) THEN - DO I3=0,3 !POLS - IF (SELPOL(I3)) THEN !POL SELECTED - DO I1=0,STHIFR-1 !ALL IFRS - S_WGT(I1) = STATWGTD(I1,I3) !STATISTICS WEIGHT - END DO -C - DO I1=IFRMIN,IFRMAX - S_VAL(I1) = DAT(0,I1,I3) !COS - END DO - R0 = NFLST1 ('ACC','DAT_C_'//POLNAME(I3), - 1 ' ',STHIFR,S_VAL,S_WGT) -C - DO I1=IFRMIN,IFRMAX - S_VAL(I1) = DAT(1,I1,I3) !SIN - END DO - R0 = NFLST1 ('ACC','DAT_S_'//POLNAME(I3), - 1 ' ',STHIFR,S_VAL,S_WGT) -C - DO I1=IFRMIN,IFRMAX - S_VAL(I1) = ABS(CDAT(I1,I3)) !AMPL - END DO - R0 = NFLST1 ('ACC','DAT_A_'//POLNAME(I3), - 1 ' ',STHIFR,S_VAL,S_WGT) -C - DO I1=IFRMIN,IFRMAX - S_VAL(I1) = (360/PI2)* - 1 ATAN2(DAT(1,I1,I3),DAT(0,I1,I3)) !PHASE(DEGR) - END DO - R0 = NFLST1 ('ACC','DAT_P_'//POLNAME(I3), - 1 ' ',STHIFR,S_VAL,S_WGT) -C - IF (DRYRUN) THEN - DO I1=IFRMIN,IFRMAX - S_VAL(I1) = CRITVALD(I1,I3) !CRITERION VALUE - END DO -C - R0 = NFLST1 ('ACC','CRIT_'//CNOPER(NOPER), - 1 ' ',STHIFR,S_VAL,S_WGT) -C - R0 = NFLST1 ('ACC', - 1 'CRIT_'//CNOPER(NOPER)//'_'//POLNAME(I3), - 1 ' ',STHIFR,S_VAL,S_WGT) !PER POL - END IF -C - END IF !POL SELECT - END DO !POLS - END IF -C -C MODIFY SCAN HEADER FLAGS (IF REQUIRED): -C - 40 CONTINUE !TARGET IF SKIPPING DATA -C - IF (DRYRUN) MODFH = .FALSE. !NOT IF DRY RUN -C - IF (MODFH) THEN - IF (SETFH) THEN !SET FLAG - SCHJ(SCH_BITS_J)= - 1 IOR(SCHJ(SCH_BITS_J),FLAGH) - ELSE !CLEAR FLAG - SCHJ(SCH_BITS_J)= - 1 IAND(SCHJ(SCH_BITS_J),NOT(FLAGH)) - END IF - WRSCH = .TRUE. !RE-WRITE SCAN HEADER - CNTFH = .TRUE. !COUNT HEADER FLAGS - END IF -C -!*** STATISTICS: Put criterion value and header info into statistics -C accumulators. NB: Only if the Scan header is not flagged with -C the specified flag type(s), specified by FLAGH -C - IF (STACCH) THEN - IF (IAND(FLAGH,SCHJ(SCH_BITS_J)).EQ.0) THEN - R0 = NFLST1 ('ACC','CRIT_'//CNOPER(NOPER), - 1 ' ',1,CRITVALH,STATWGTH) - R0 = NFLST1 ('ACC','CRIT_'//CNOPER(NOPER), - 1 ' ',1,CRITVALH,STATWGTH) - R0 = SCHE(SCH_MAX_E) - R0 = NFLST1('ACC','MAXABCS',' ',1,R0,1.) - R0 = SCHE(SCH_REDNS_E+0) - IF (R0.GT.0) - 1 R0 = NFLST1('ACC','REDNS_GX',' ',1,R0,1.) - R0 = SCHE(SCH_REDNS_E+1) - IF (R0.GT.0) - 1 R0 = NFLST1('ACC','REDNS_PX',' ',1,R0,1.) - R0 = SCHE(SCH_REDNS_E+2) - IF (R0.GT.0) - 1 R0 = NFLST1('ACC','REDNS_GY',' ',1,R0,1.) - R0 = SCHE(SCH_REDNS_E+3) - IF (R0.GT.0) - 1 R0 = NFLST1('ACC','REDNS_PY',' ',1,R0,1.) - R0 = SCHE(SCH_ALGNS_E+0) - IF (R0.GT.0) - 1 R0 = NFLST1('ACC','ALGNS_GX',' ',1,R0,1.) - R0 = SCHE(SCH_ALGNS_E+1) - IF (R0.GT.0) - 1 R0 = NFLST1('ACC','ALGNS_PX',' ',1,R0,1.) - R0 = SCHE(SCH_ALGNS_E+2) - IF (R0.GT.0) - 1 R0 = NFLST1('ACC','ALGNS_GY',' ',1,R0,1.) - R0 = SCHE(SCH_ALGNS_E+3) - IF (R0.GT.0) - 1 R0 = NFLST1('ACC','ALGNS_PY',' ',1,R0,1.) - END IF - END IF -C -C Count header flags (if required): -C - IF (CNTFH) THEN - FLACC(0,0) = SCHJ(SCH_BITS_J) !HEADER FLAGS - MASK(0,0) = FLAGH !FLAGBYTE USED - JS = NFLCNT ('ACC','HEAD',FLACC,MASK,IFRA,CHCUR,HACUR) - END IF -C -C REWRITE SCAN HEADER (IF REQUIRED): -C - IF (WRSCH) THEN - IF (.NOT.NSCSCW(FCAIN,STH,IFRT,I,0,0,SCH)) THEN !WRITE HEADER - CALL WNCTXT(F_TP,'Error writing scan header !UJ',I) - GOTO 30 - END IF - END IF -C -C REWRITE SCAN DATA (IF REQUIRED): -C - IF (WRSCN) THEN !REWRITE SCAN - IF (.NOT.WNFWR(FCAIN,STHJ(STH_SCNL_J)-SCH__L, - 1 LDAT,STHJ(STH_SCNP_J)+I*STHJ(STH_SCNL_J)+ - 1 SCH__L)) THEN !WRITE DATA - CALL WNCTXT(F_TP,'Error writing scan !UJ',I) - GOTO 30 !NEXT SET - END IF - END IF -C -C DRY RUN: See whether it is time to stop. -C - IF (DRYRUN) THEN - NDRYSCANS = NDRYSCANS + 1 !INCREMENT COUNTER - IF (NDRYSCANS.GE.MAXDRYSCANS) GOTO 30 !ESCAPE - END IF -C -C NEXT SCAN -C - END IF !HA RANGE - END DO !NEXT SCAN -C -C NEXT SECTOR (if any): -C NB: Do NOT jump out of the DO WHILE ... Sector loop, but let it end -C itself. Otherwise the system gets confused. -C - 30 CONTINUE - END DO !NEXT SECTOR -C -C ------------------------------------------------------------------------ -C DRY RUN: Display the result of the accumulated statistics. -C To help the user to give a good flagging threshold value. -C - IF (DRYRUN) THEN - R0 = NFLST1 ('SHOW','#SEPAR',' ',0,0.,0.) - CALL WNCTXS (TXT80, - 1 'Dry-Run: Statistics of the relevant criterion,' - 1 //' over !UJ Scans.',NDRYSCANS) - R0 = NFLST1 ('SHOW','#TEXT',TXT80,0,0.,0.) - R0 = NFLST1 ('SHOW','#SEPAR',' ',0,0.,0.) - R0 = NFLST1 ('SHOW','#HEADER',' ',0,0.,0.) - R0 = NFLST1 ('SHOW','##CRIT_'//CNOPER(NOPER),' ',1,0.,0.) - R0 = NFLST1 ('SHOW','#SEPAR',' ',0,0.,0.) -C - IF (NOPER.EQ.N_RNO .OR. - 1 NOPER.EQ.N_XRN .OR. - 1 NOPER.EQ.N_YRN) THEN - R0 = NFLST1 ('SHOW','##REDNS',' ',1,0.,0.) - R0 = NFLST1 ('SHOW','#SEPAR',' ',0,0.,0.) - GOTO 213 !BACK FOR `WET' RUN - ELSE IF (NOPER.EQ.N_ANO .OR. - 1 NOPER.EQ.N_XAN .OR. - 1 NOPER.EQ.N_YAN) THEN - R0 = NFLST1 ('SHOW','##ALGNS',' ',1,0.,0.) - R0 = NFLST1 ('SHOW','#SEPAR',' ',0,0.,0.) - GOTO 213 !BACK FOR `WET' RUN - ELSE IF (NOPER.EQ.N_MAX) THEN - R0 = NFLST1 ('SHOW','#SEPAR',' ',0,0.,0.) - GOTO 214 !BACK FOR `WET' RUN - ELSE IF (NOPER.EQ.N_AMP .OR. - 1 NOPER.EQ.N_COS .OR. - 1 NOPER.EQ.N_SIN) THEN -CCC R0 = NFLST1 ('SHOW','##DAT_',' ',1,0.,0.) - R0 = NFLST1 ('SHOW','#SEPAR',' ',0,0.,0.) - GOTO 215 !BACK FOR `WET' RUN - ELSE IF (NOPER.EQ.N_DT1 .OR. - 1 NOPER.EQ.N_RT1) THEN - R0 = NFLST1 ('SHOW','#SEPAR',' ',0,0.,0.) - GOTO 216 !BACK FOR `WET' RUN - ELSE IF (NOPER.EQ.N_RRE .OR. - 1 NOPER.EQ.N_ARE .OR. - 1 NOPER.EQ.N_YXY .OR. - 1 NOPER.EQ.N_UXY .OR. - 1 NOPER.EQ.N_VXY .OR. - 1 NOPER.EQ.N_QXY) THEN - R0 = NFLST1 ('SHOW','#SEPAR',' ',0,0.,0.) - GOTO 217 !BACK FOR `WET' RUN - ELSE !UNSPECIFIED OPERATION - R0 = NFLST1 ('SHOW','#ALLGROUPS',' ',1,0.,0.) - R0 = NFLST1 ('SHOW','#SEPAR',' ',0,0.,0.) - END IF !OPERATION - END IF ! -C-------------------------------------------------------------------------- -C Display a summary of flags, if required: -C - IF (SHOW_CNT) THEN - JS = NFLCNT ('SHOW','FTYP',0,SELFLAG,0,0,0) - END IF -C -C-------------------------------------------------------------------------- -C STATISTICS: -C - IF (SHOW_STAT) THEN - R0 = NFLST1 ('SHOW','#SEPAR',' ',0,0.,0.) - CALL WNCTXS (TXT80, - 1 'Statistics over UNFLAGGED data/headers.') - R0 = NFLST1 ('SHOW','#TEXT',TXT80,0,0.,0.) - R0 = NFLST1 ('SHOW','#SEPAR',' ',0,0.,0.) - R0 = NFLST1 ('SHOW','#HEADER',' ',0,0.,0.) - R0 = NFLST1 ('SHOW','#SINGLES',' ',1,0.,0.) - R0 = NFLST1 ('SHOW','##DAT_',' ',1,0.,0.) - R0 = NFLST1 ('SHOW','#SEPAR',' ',0,0.,0.) - END IF -C -C************************************************************************** -C************************************************************************** -C FINISHED NORMALLY -C - 600 CONTINUE -C - IF (NOPER.EQ.N_HAR) GOTO 321 !LOOP BACK FOR HA-RANGES -C - RETURN -C -C************************************************************************** -C NO ACTION -C - 700 CONTINUE - CALL WNCTXT (F_TP,'Operation '//CNOPER(NOPER) - 1 //': No action.') - RETURN -C -C************************************************************************** -C ERROR -C - 800 CONTINUE - CALL WNCTXT (F_TP,'Operation '//CNOPER(NOPER) - 1 //': Error.') - RETURN -C - END diff --git a/src/nscan/nflprt.for b/src/nscan/nflprt.for deleted file mode 100644 index 9edf9859cddef56357ccea871b65c09a8a4ad137..0000000000000000000000000000000000000000 --- a/src/nscan/nflprt.for +++ /dev/null @@ -1,915 +0,0 @@ -C+ NFLPRT.FOR -C WNB 900810 -C -C Revisions: -C JPH 930323 comments; 6 --> 3*LB_I. - L_I/L_B --> LB_I -C HjV 930423 Change name of some keywords -C JPH 930518 Call WNDSTI to display "." sector name -C WNB 930607 New weights; remove WNDSTI; remove edit stmt -C Remove NSCEDI (nowhere used/documented, problems): -C but cater for print only -C WNB 930608 Add NAME and FLAGS in SECTOR_ACTION -C WNB 930609 Add HA/POL limits for FLAGS -C JPH 930611 Add polarisation to data output headers/footers -C WNB 930614 Add polarisation to flag headings; delete F option -C HJV 930618 Symbolic names for mask bits in CBITS_O_DEF -C WNB 930618 Rename from NSCPRT -C WNB 930623 Add SCAN T option -C CMV 930803 Output telescope D in Flag-count and SCAN Flags -C WNB 930807 Change to CBITS_DEF -C WNB 930825 New pol. selection -C WNB 930826 New HA range -C HjV 930914 NSCIFS is now a function iso. a subroutine -C CMV 930929 Initialise POLNM together with POLC -C CMV 931105 Change default for SET_ACTION to NEXT -C JPH 931123 For W option, show zero weights i.s.o. dots -C WNB 931215 No auto show if edit -C CMV 931220 Add FILE_ACTION option OVERVIEW -C CMV 931220 Pass FCA of input file to WNDXLP and WNDSTA/Q -C CMV 940209 Pass Category code to NSCPSH -C CMV 940228 Add option to print corrected data -C CMV 940303 Correct stupid error (of CMV) -180/+180 binning -C CMV 940315 Change format for printing catagory to !AF -C CMV 940415 Do not scale phase while printing data -C CMV 940415 Correct double use of I3 in T/W options (use OPOL) -C CMV 940420 Correct test for UNCOR (was OPT(1:3).EQ.'U') -C CMV 940425 Add TP and GN options for total power data -C CMV 940428 Split off 'T' option in NCATEL -C CMV 940429 Add IFH option for SECTOR_ACTION -C CMV 940506 Add IFR option for SCAN_ACTION -C CMV 940518 Add IFRS argument to NCATEL -C JPH 940725 Remove '.' from diagonal of D and W display -C JPH 941213 Remove GOTO 200 after FLAG display -C HjV 960403 Small structure changes (Less goto's, more if/else/endif) -C in scan action and data display part. -C Type text for COR/UNCOR and if something NOT present -C CMV 000928 Correct bug in COR output (J reused), allow skipping over -C set-boundaries when stepping scans -C -C - SUBROUTINE NFLPRT -C -C Show/edit data in SCN file -C -C Result: -C -C CALL NFLPRT will show/edit data in SCN file -C -C PIN references: -C -C INPUT_SCN_NODE -C SCN_SETS -C FILE_ACTION -C SET_ACTION -C SCAN_ACTION -C -C Include files: -C - INCLUDE 'WNG_DEF' - INCLUDE 'CBITS_DEF' - INCLUDE 'STH_O_DEF' !SET HEADER - INCLUDE 'SCH_O_DEF' !SCAN HEADER - INCLUDE 'OHW_O_DEF' !OH BLOCK - INCLUDE 'NFL_DEF' -C -C Parameters: -C -C -C Arguments: -C -C -C Function references: -C - LOGICAL WNDPAR !GET DWARF PARAMETER - LOGICAL WNDNOD,WNDNOC !GET/CHANGE NODE NAME - LOGICAL WNFOP !OPEN FILE - LOGICAL WNFRD !READ FILE - LOGICAL WNDSTA !GET SETS TO DO - CHARACTER*32 WNTTSG !SET NAME - LOGICAL NSCSTG !GET A SET - LOGICAL NSCPLS !SELECT POL. - LOGICAL NSCHAS !SELECT HA - LOGICAl NSCIFS !Select/deselect interferometers - REAL WNGEFD !FRACTIONS TO DEGREES - LOGICAL NMOMSC !Set model in SCN file - LOGICAL NMORDH !Read model header - LOGICAL NSCSCR !Read corrected data - LOGICAL NSCSIF !READ IFR TABLE - LOGICAL NSCGIF !Read IF/Total Power data - LOGICAL NSCGF2 !Show IF header -C -C Data declarations: -C - CHARACTER*24 ACT !ACTION ASKED - LOGICAL NEWHA !DISPLAY NEW HA - LOGICAL GOSCN !SHOW SCN FOR NEW SET - INTEGER STHP !SUB-GROUP POINTER - INTEGER SCHP - INTEGER SNAM(0:7) !SET NAME - INTEGER*2 IFRT(0:STHIFR-1) !IFR TABLE - INTEGER IFRA(0:1,0:STHIFR-1) ! IFR TABLE - REAL ANG(0:2,0:STHIFR-1) ! DIPOLE ANGLES - CHARACTER*80 IFRC !IFR LIST - CHARACTER*12 F1000 !FORMATS - REAL HARAN(0:1) !HA RANGE -C - INTEGER POLC !index SELECTED POLARISATION in CDAT - CHARACTER*2 POLNM ! and its ASCII name - DATA POLNM/'XX'/ - INTEGER SPOL,OPOL !POL. CODE and Offset in ODAT - INTEGER PPOL(0:3,1:4,0:1) !POL. SELECT XX,XY,YX,YY FOR - ! NPOL=1:4: - DATA PPOL/XX_P,0,0,0, XX_P,0,0,YY_P, 0,0,0,0, - 1 XX_P,XY_P,YX_P,YY_P, !BITS - 1 0,0,0,0, 0,0,0,1, 0,0,0,0, 0,1,2,3/ !OFFSETS -C - INTEGER IFRCP(2,4) !OFFSETS FOR IFR CORRECTION POINTERS - DATA IFRCP/SCH_IFRAC_J, 0, - 1 SCH_IFRMC_J, 1, - 1 SCH_AIFRAC_J,0, - 1 SCH_AIFRMC_J,1/ !0:additive, 1:multiplicative - CHARACTER*50 IFRCC(4) !Descriptions - DATA IFRCC/'Additive ifr. correction (apply)', - 1 'Multiplicative ifr. correction (apply)', - 1 'Additive ifr. correction (de-apply)', - 1 'Multiplicative ifr. correction (de-apply)'/ -C - LOGICAL DO_COR !Show corrected data? - DATA DO_COR/.FALSE./ - INTEGER CORAP,CORDAP !Corrections to apply/deapply - INTEGER NSRC(0:2) !Source counts in model - INTEGER STP !Source type of model - DOUBLE PRECISION SRA,SDEC,SFRQ !Model info - REAL UV0(0:3) !Basic uv coordinates - REAL LM0(0:1) !Basic source displacement - DOUBLE PRECISION FRQ0 !Basic frequency - REAL TF(0:1) !Integr. time, bandwidth - INTEGER MINST !Instrument - COMPLEX CV1,CV2 !Complex data,model -C - REAL WGT(0:STHIFR-1,0:3) !Weights - REAL DAT(0:1,0:STHIFR-1,0:3) !Data - COMPLEX CDAT(0:STHIFR-1,0:3) - EQUIVALENCE(DAT,CDAT) - COMPLEX CMOD(0:3,0:STHIFR-1) !Model IQUV - COMPLEX CAMOD(0:STHIFR-1,0:3) !Model XYX -C - REAL HA !HA - REAL R2 - CHARACTER CATEG*32 !CATEGORY/TYPE/SPEFU - CHARACTER*(STHTEL) TELS !TELESCOPE NAMES - DATA TELS/'0123456789ABCD'/ - BYTE IFRS(0:STHTEL-1,0:STHTEL-1) !IFR SELECTION - INTEGER IFRSX(0:STHTEL-1,0:STHTEL-1) !IFR SELECTION - INTEGER ICNT(0:STHTEL-1,0:STHTEL-1,0:1) !DATA/FLAG COUNTS -C - REAL PCGAN(0:STHTEL-1,0:1) !BUFFER FOR GAINS - REAL PCPHA(0:STHTEL-1,0:1) !BUFFER FOR PHASE OFFSETS - REAL IFBUF(0:STHTEL-1,0:1) !BUFFER FOR Total Powers/Gains - REAL IFRCOR(2,0:4*STHIFR-1) !BUFFER FOR Interferometer corrections -C - BYTE STH(0:STHHDL-1) !SET HEADER - INTEGER STHJ(0:STHHDL/4-1) - INTEGER*2 STHI(0:STHHDL/2-1) - REAL STHE(0:STHHDL/4-1) - EQUIVALENCE (STH,STHJ,STHI,STHE) - BYTE SCH(0:SCHHDL-1) !SCAN HEADER - INTEGER SCHJ(0:SCHHDL/LB_J-1) - EQUIVALENCE (SCH,SCHJ) - BYTE OHW(0:OHW__L-1) !OH BLOCK - INTEGER*2 ODAT(0:2,0:800) !DATA - REAL RDAT(0:STHIFR-1,1:2) !CORRECTED DATA -C - CHARACTER*78 TEXT(-1:STHTEL) !TEXT LINES - CHARACTER*1 MODE !FILE-OPEN MODE - COMPLEX C0 -C- -C -C INIT -C -C***************************************************************************** -C GET NODE -C - 100 CONTINUE - MODE='R' !ASSUME READ-ONLY FOR NOW - CALL WNFCL(FCAIN) - IF (.NOT.WNDNOD('INPUT_SCN_NODE',' ','SCN',MODE,NODIN,IFILE)) THEN !NODE -C******* - IF (E_C.EQ.DWC_ENDOFLOOP) RETURN !READY WITH SHOW - CALL WNCTXT(F_TP,'Node does not exist') - GOTO 100 - ELSE IF (E_C.EQ.DWC_NULLVALUE) THEN - RETURN !END - ELSE IF (E_C.EQ.DWC_WILDCARD) THEN - GOTO 100 !MUST SPECIFY - END IF - IF (.NOT.WNFOP(FCAIN,IFILE,MODE)) THEN !OPEN SCN FILE - CALL WNCTXT(F_TP,'Cannot open file attached to node') - GOTO 100 - END IF - CALL NSCPFH(F_TP,FCAIN) !PRINT FILE HEADER -C -C***************************************************************************** -C FILE ACTION -C - 101 CONTINUE -C FILE_ACTION ******* - IF (.NOT.WNDPAR('FILE_ACTION',ACT,LEN(ACT),J,'CONT')) THEN !FILE ACTION - IF (E_C.EQ.DWC_ENDOFLOOP) THEN !^Z - 102 CONTINUE - CALL WNFCL(FCAIN) !CLOSE FILE - GOTO 100 !RETRY NODE - END IF - GOTO 101 !RETRY - ELSE IF (E_C.EQ.DWC_NULLVALUE) THEN - GOTO 102 !READY - ELSE IF (E_C.EQ.DWC_WILDCARD) THEN - ACT='CONT' !ASSUME CONT - END IF -! *** LAYOUT - IF (ACT.EQ.'LAYOUT') THEN !SHOW LAYOUT - CALL NSCPFL(F_TP,FCAIN,NODIN,.FALSE.) !SHOW LAYOUT -! *** OVERVIEW - ELSE IF (ACT.EQ.'OVERVIEW') THEN !SHOW OVERVIEW - CALL NSCPFL(F_TP,FCAIN,NODIN,.TRUE.) !SHOW OVERVIEW - ELSE IF (ACT.EQ.'SHOW') THEN !SHOW DETAILS - CALL NSCXFH(F_TP,FCAIN) -! *** EDIT - ELSE IF (ACT.EQ.'EDIT') THEN !EDIT - IF (MODE.EQ.'R') THEN !CHANGE TO UPDATE MODE - MODE='U' !MAKE UPDATE - CALL WNFCL(FCAIN) !CLOSE FILE - IF (.NOT.WNDNOC(' ',' ','SCN',MODE,' ',IFILE)) THEN !CHANGE DATES - CALL WNCTXT(F_TP,'Node is not writable') - GOTO 100 - END IF - IF (.NOT.WNFOP(FCAIN,IFILE,MODE)) THEN !OPEN SCN FILE - CALL WNCTXT(F_TP,'Cannot write to file attached to node') - GOTO 100 - END IF - END IF - CALL NSCEFH(F_TP,FCAIN) !EDIT HEADER - ELSE IF (ACT.EQ.'CONT') THEN !CONT - GOTO 200 !DO SET - ELSE - GOTO 102 !QUIT - END IF - GOTO 101 !UNKNOWN -C -C***************************************************************************** -C SETS -C - 200 CONTINUE - GOSCN=.FALSE. !DO NOT SHOW SCN RIGHT AWAY -C SETS ******* - IF (.NOT.WNDSTA('SCN_SETS',MXNSET,SETS,FCAIN)) GOTO 102 !GET SETS TO DO - IF (SETS(0,0).EQ.0) GOTO 102 !NONE - 201 CONTINUE !DO NEXT SET - IF (.NOT.NSCSTG(FCAIN,SETS,STH,STHP,SNAM)) GOTO 102 !GET SET -C - CATEG='??/??/??' !Reset category - IF (STHJ(STH_OHP_J).NE.0) THEN !Read OH if any - IF (WNFRD(FCAIN,STHJ(STH_NOH_J),OHW, - 1 STHJ(STH_OHP_J))) THEN - CALL WNCTXS(CATEG,'!AF/!AF/!AF', - 1 OHW(OHW_CATEG_1),OHW_CATEG_N, !Astr. category - 1 OHW(OHW_SPEFU_1),OHW_SPEFU_N, !Special functions - 1 OHW(OHW_TYPE_1), OHW_TYPE_N) !Obs. type-code - END IF - END IF -C - CALL NSCPSH(F_TP,STH,SNAM,CATEG) !SHOW SET HEADER -C -C READ INTERFEROMETER TABLE AND GET SELECTION -C (do it here since we need it in the Scan actions) -C - IF (.NOT.NSCSIF(FCAIN,STH,IFRT,IFRA,ANG)) THEN !READ IFR TABLE - CALL WNCTXT(F_TP,'Error reading interferometer table') - GOTO 201 !RETRY NEXT SET - END IF - DO I=0,STHTEL-1 !SET ALL NOT PRESENT - DO I1=0,STHTEL-1 - IFRSX(I1,I)=-1 - IFRS(I1,I)=.FALSE. - END DO - END DO - DO I=0,STHJ(STH_NIFR_J)-1 !MAKE SELECTION - IFRSX(MOD(IFRT(I),256),IFRT(I)/256)=I - IFRS(MOD(IFRT(I),256),IFRT(I)/256)=.TRUE. - END DO - IF (GOSCN) GOTO 400 -C -C***************************************************************************** -C SET ACTION -C - 301 CONTINUE -C SET_ACTION ******* - IF (.NOT.WNDPAR('SECTOR_ACTION',ACT, - 1 LEN(ACT),J,'NEXT')) THEN !Was 'CONT', 931105 CMV - IF (E_C.EQ.DWC_ENDOFLOOP) GOTO 101 !^Z, RETRY FILE ACTION - GOTO 301 !RETRY - ELSE IF (E_C.EQ.DWC_NULLVALUE) THEN - GOTO 101 !RETRY FILE ACTION - ELSE IF (E_C.EQ.DWC_WILDCARD) THEN - ACT='CONT' !ASSUME CONT - END IF -! *** NEXT - IF (ACT.EQ.'NEXT') THEN !NEXT SET - GOTO 201 !NEXT SET -! *** NAME - ELSE IF (ACT.EQ.'NAME') THEN !FULL NAME - CALL WNCTXT(F_TP,'!/Input name: !AS',WNTTSG(SNAM,0)) - CALL WNDSTI(FCAIN,SNAM) - CALL WNCTXT(F_TP,'Index name: !AS',WNTTSG(SNAM,0)) -! *** IFH - ELSE IF (ACT.EQ.'IFH') THEN !SHOW IF-HEADER - JS=NSCGF2(FCAIN,STH,F_TP) -! *** IFRS - ELSE IF (ACT.EQ.'IFRS') THEN !SHOW INTERFEROMETERS - CALL WNCTXT(F_TP,' ') - DO I=0,STHJ(STH_NIFR_J)-1,25 !SHOW LIST - IFRC=' ' !EMPTY STRING - DO I1=I,MIN(STHJ(STH_NIFR_J),I+25)-1 - J=MOD(IFRT(I1),256) - J1=IFRT(I1)/256 - CALL WNCTXS(IFRC(3*(I1-I)+1:3*(I1-I)+2), - 1 '!1$XJ!1$XJ',J,J1) - END DO - CALL WNCTXT(F_TP,'!AS',IFRC) !SHOW - END DO - IF (.NOT.NSCIFS(100,IFRS)) GOTO 301 !SHOW SELECTION -! *** FLAGS - ELSE IF (ACT.EQ.'FLAGS') THEN - IF (.NOT.NSCHAS(1,HARAN)) GOTO 301 !GET HA RANGE - IF (.NOT.NSCPLS(1,SPOL)) GOTO 301 !SELECT POL. - DO I=0,1 !CLEAN COUNTS - DO I1=0,STHTEL-1 - DO I2=0,STHTEL-1 - ICNT(I2,I1,I)=0 - END DO - END DO - END DO - 302 CONTINUE !ADD NEXT SET - DO J=0,STHJ(STH_SCN_J)-1 !ALL SCANS - R0=STHE(STH_HAB_E)+J*STHE(STH_HAI_E) !HA OF SCAN - IF (R0.GE.HARAN(0)-STHE(STH_HAI_E)/2+1E-5 .AND. - 1 R0.LE.HARAN(1)+STHE(STH_HAI_E)/2-1E-5) THEN !DO - SCHP=STHJ(STH_SCNP_J)+J*STHJ(STH_SCNL_J) !SCAN HEADER POINTER - IF (.NOT.WNFRD(FCAIN,SCHHDL,SCH,SCHP)) THEN !READ SCAN - 303 CONTINUE - CALL WNCTXT(F_TP,'Error reading scan file') - GOTO 200 !RETRY SETS - END IF - IF (.NOT.WNFRD(FCAIN, - 1 3*LB_I*STHI(STH_PLN_I)*STHJ(STH_NIFR_J), - 1 ODAT(0,0),SCHP+SCHHDL)) - 1 GOTO 303 !READ DATA - DO I1=0,3 !DO ALL POL. - IF (IAND(PPOL(I1,STHI(STH_PLN_I),0),SPOL).NE.0) THEN !SEL. - I0=PPOL(I1,STHI(STH_PLN_I),1) !OFFSET - DO I2=0,STHJ(STH_NIFR_J)-1 !ALL INTERFEROMETERS - I=STHI(STH_PLN_I)*I2+I0 !DATA POINTER - IF (ODAT(0,I).NE.0) THEN !DATA PRESENT - I4=MOD(IFRT(I2),256) !TELESCOPES - I5=IFRT(I2)/256 - ICNT(I4,I5,0)=ICNT(I4,I5,0)+1 !COUNT - I3=ODAT(0,I) !WEIGHT/FLAGS - IF (IAND(I3,FL_ALL).NE.0 .OR. - 1 IAND(SCHJ(SCH_BITS_J),FL_ALL).NE.0) THEN - ICNT(I4,I5,1)=ICNT(I4,I5,1)+1 !COUNT FLAGS - END IF - END IF - END DO !IFRS - END IF - END DO !POL. - END IF - END DO !SCAN - IF (NSCSTG(FCAIN,SETS,STH,STHP,SNAM)) THEN !MORE SETS - IF (.NOT.WNFRD(FCAIN,(LB_I)*STHJ(STH_NIFR_J),IFRT, - 1 STHJ(STH_IFRP_J))) THEN !READ IFRS - CALL WNCTXT(F_TP,'Error reading scan file') - GOTO 201 !RETRY NEXT SET - END IF - GOTO 302 !ADD DATA - END IF - CALL WNCTXT(F_TP,'!/!32C\Flag count') !SHOW RESULT - TEXT(-1)=' ' - DO I=0,STHTEL-1 - TEXT(-1)(I*5+6:I*5+6)=TELS(I+1:I+1) - END DO - TEXT(-1)(74:74)='.' - CALL WNCTXT(F_TP,'!#$AS',LEN(TEXT(0)),TEXT(-1)) - DO I=0,STHTEL !SET NO DATA - TEXT(I)=' ' - DO I2=0,STHTEL-1 - TEXT(I)(5*I2+6:5*I2+6)='.' - END DO - IF (I.NE.STHTEL) THEN - TEXT(I)(74:74)=TELS(I+1:I+1) - ELSE - TEXT(I)(74:74)='.' - END IF - IF (I.NE.0) THEN - TEXT(I)(1:1)=TELS(I:I) - END IF - END DO - DO I=0,STHTEL-1 !SHOW COUNTS - DO I1=0,STHTEL-1 - IF (ICNT(I1,I,1).GT.0) THEN - CALL WNCTXS(TEXT(I1)(5*I+3:5*I+7), - 1 '!5$UJ',MIN(ICNT(I1,I,1),9999)) - END IF - IF (ICNT(I1,I,0).GT.0) THEN - CALL WNCTXS(TEXT(I+1)(5*I1+3:5*I1+7), - 1 '!5$UJ',MIN(ICNT(I1,I,0),9999)) - END IF - END DO - END DO - DO I=0,STHTEL !SHOW DATA - CALL WNCTXT(F_TP,'!#$AS',LEN(TEXT(0)),TEXT(I)) - END DO - CALL WNCTXT(F_TP,'!#$AS',LEN(TEXT(0)),TEXT(-1)) !BOTTOM - CALL WNCTXT(F_TP,'!32C\Data count!/') !HEADINGS -!! GOTO 200 !ASK NEW SETS -! *** SHOW - ELSE IF (ACT.EQ.'SHOW') THEN !SHOW DETAILS - CALL NSCXSH(F_TP,FCAIN,STHP,SNAM) -! *** EDIT - ELSE IF (ACT.EQ.'EDIT') THEN !EDIT - IF (MODE.EQ.'R') THEN !CHANGE TO UPDATE MODE - MODE='U' !MAKE UPDATE - CALL WNFCL(FCAIN) !CLOSE FILE - IF (.NOT.WNDNOC(' ',' ','SCN',MODE,' ',IFILE)) THEN !CHANGE DATES - CALL WNCTXT(F_TP,'Node is not writable') - GOTO 100 - END IF - IF (.NOT.WNFOP(FCAIN,IFILE,MODE)) THEN !OPEN SCN FILE - CALL WNCTXT(F_TP,'Cannot write to file attached to node') - GOTO 100 - END IF - END IF - CALL NSCESH(F_TP,FCAIN,STHP,SNAM) !EDIT -! *** CONT - ELSE IF (ACT.EQ.'CONT') THEN !CONT - GOTO 400 !DO DATA - ELSE - GOTO 101 !QUIT - END IF - GOTO 301 !UNKNOWN -C -C***************************************************************************** -C SCAN ACTION -C - 400 CONTINUE - HA=STHE(STH_HAB_E)-STHE(STH_HAI_E) !START HA - NEWHA=.TRUE. !DISPLAY HA - GOSCN=.FALSE. !RESET JUMP FLAG - POLC=0 !START POL. - POLNM='XX' - DO_COR=.FALSE. -C - 401 CONTINUE - IF (NEWHA) THEN !DISPLAY HA - IF (HA.GE.STHE(STH_HAB_E)+ - 1 STHJ(STH_SCN_J)*STHE(STH_HAI_E)) THEN - GOSCN=.TRUE. !JUMP BACK FOR NEXT SET - GOTO 201 !GET NEXT SET - END IF - HA=MIN(MAX(STHE(STH_HAB_E),HA),STHE(STH_HAB_E)+ - 1 (STHJ(STH_SCN_J)-1)*STHE(STH_HAI_E)) !CORRECT HA - J=NINT((HA-STHE(STH_HAB_E))/STHE(STH_HAI_E)) !SCAN NUMBER - OPOL=PPOL(POLC,STHI(STH_PLN_I),1) !OFFSET IN ODAT - SCHP=STHJ(STH_SCNP_J)+J*STHJ(STH_SCNL_J) !SCAN HEADER POINTER - IF (.NOT.WNFRD(FCAIN,SCHHDL,SCH,SCHP)) THEN !READ SCAN - 411 CONTINUE - CALL WNCTXT(F_TP,'Error reading scan file') - GOTO 400 !RETRY - END IF - IF (.NOT.WNFRD(FCAIN, - 1 3*LB_I*STHI(STH_PLN_I)*STHJ(STH_NIFR_J), - 1 ODAT(0,0),SCHP+SCHHDL)) - 1 GOTO 411 !READ DATA - CALL NSCPSL(F_TP,SCH,SNAM,STH,J) !SHOW SCAN HEADER - NEWHA=.FALSE. - END IF -C -C SCAN_ACTION ******* - IF (.NOT.WNDPAR('SCAN_ACTION',ACT,LEN(ACT),J,'>')) THEN !ACTION - IF (E_C.EQ.DWC_ENDOFLOOP) GOTO 301 !^Z, RETRY SET ACTION - GOTO 401 !RETRY - ELSE IF (E_C.EQ.DWC_NULLVALUE) THEN - GOTO 301 !RETRY SET ACTION - ELSE IF (E_C.EQ.DWC_WILDCARD) THEN - ACT='>' !ASSUME > - END IF - CALL WNCAUC(ACT) !MAKE UC -! *** > - IF (ACT(1:1).EQ.'>') THEN !> - IF (ACT(2:).EQ.' ') THEN - I=1 !ASSUME 1 STEP - ELSE - WRITE (UNIT=F1000,FMT=1001,ERR=403) LEN(ACT)-1 - 1001 FORMAT('(BN,I',I4.4,')') - READ(UNIT=ACT(2:),FMT=F1000,ERR=403) I !GET I - END IF - HA=HA+I*STHE(STH_HAI_E) !SELECT HA - NEWHA=.TRUE. !DISPLAY HA -! *** < - ELSE IF (ACT(1:1).EQ.'<') THEN !< - IF (ACT(2:).EQ.' ') THEN - I=1 !ASSUME 1 STEP - ELSE - WRITE (UNIT=F1000,FMT=1001,ERR=403) LEN(ACT)-1 - READ(UNIT=ACT(2:),FMT=F1000,ERR=403) I !GET I - END IF - HA=HA-I*STHE(STH_HAI_E) !SELECT HA - NEWHA=.TRUE. !DISPLAY HA -! *** Q - ELSE IF (ACT(1:1).EQ.'Q') THEN !QUIT - GOTO 301 -! *** XX - ELSE IF (ACT.EQ.'XX') THEN !XX - POLNM='XX' - POLC=0 - NEWHA=.TRUE. !DISPLAY HA -! *** YY - ELSE IF (ACT.EQ.'YY') THEN !YY - IF (STHI(STH_PLN_I).EQ.2.OR. - 1 STHI(STH_PLN_I).EQ.4) THEN - POLNM='YY' - POLC=3 - NEWHA=.TRUE. !DISPLAY HA - ELSE - GOTO 402 - END IF -! *** XY - ELSE IF (ACT.EQ.'XY') THEN !XY - IF (STHI(STH_PLN_I).EQ.4) THEN - POLNM='XY' - POLC=1 - NEWHA=.TRUE. !DISPLAY HA - ELSE - GOTO 402 - END IF -! *** YX - ELSE IF (ACT.EQ.'YX') THEN !YX - IF (STHI(STH_PLN_I).EQ.4) THEN - POLNM='YX' - POLC=2 - NEWHA=.TRUE. !DISPLAY HA - ELSE - GOTO 402 - END IF -C -C *** COR, UNCOR -C - ELSE IF (ACT(1:1).EQ.'C') THEN - CALL NSCSAD(CORAP,CORDAP) !Get corrections - IF (IAND(CORDAP,CAP_MOD).EQ.0) THEN !No DEAPPLY=MODEL - CALL WNCTXT(F_TP,'Choose CLEAR and QUIT '// - & 'if you do not want model subtraction') - CALL NMODAW(NSRC(0),STH) !Get model - IF (NSRC(0).GT.0) THEN !Model given - CALL NMOMUI() ! so get the type - IF (.NOT.NMOMSC(FCAIN,SETS)) THEN ! and set it - CALL WNCTXT(F_TP,'Error in model calculation') - GOTO 401 - END IF - IF (.NOT.NMORDH(6,STP,SRA,SDEC,SFRQ)) THEN !Init for sector - CALL WNCTXT(F_TP,'Error: cannot initialise model') - CALL WNCTXT(F_TP, - 1 'You may need write access to the SCN-file') - GOTO 401 - ELSE - CALL NMOMST(STP,SRA,SDEC,STH,LM0,FRQ0,TF,MINST) !GET DATA - END IF - ELSE - CALL WNCTXT(F_TP,'No model subtraction') - END IF - ELSE - CALL WNCTXT(F_TP, - & 'The model present in the SCN file will be subtracted') - END IF - CALL NSCSAD(CORAP,CORDAP) !Get corrections - DO_COR=.TRUE. - CALL WNCTXT(F_TP,'D & A options will show corrected data,') - CALL WNCTXT(F_TP,'use UNCOR to show raw values again.') - ELSE IF (ACT(1:1).EQ.'U') THEN - DO_COR=.FALSE. - CALL WNCTXT(F_TP,'D & A options will show raw data,') - CALL WNCTXT(F_TP,'use COR to show corrected values again.') -C -C *** TP, GN -C - ELSE IF (ACT.EQ.'TP'.OR.ACT.EQ.'GN') THEN !Total power/Gain - IF (STHJ(STH_IFHP_J).NE.0) THEN !Can do - TEXT(-1)=' ' !HEADING - DO I=0,STHTEL-1 - TEXT(-1)(I*5+12:I*5+12)=TELS(I+1:I+1) - END DO - CALL WNCTXT(F_TP,'!/ !#$AS',LEN(TEXT(0)),TEXT(-1)) !SHOW HEADING -C - IF (ACT.EQ.'TP') THEN - IF (NSCGIF('TPon',FCAIN,STHJ,HA,HA,IFBUF)) THEN - CALL WNCTXT(F_TP,'!Q1\TPon X:!10C!5$#E10.0', - 1 STHTEL,IFBUF(0,0)) - CALL WNCTXT(F_TP,'!Q1\ Y:!10C!5$#E10.0', - 1 STHTEL,IFBUF(0,1)) - END IF - IF (NSCGIF('TPoff',FCAIN,STHJ,HA,HA,IFBUF)) THEN - CALL WNCTXT(F_TP,'!Q1\TPoff X:!10C!5$#E10.0', - 1 STHTEL,IFBUF(0,0)) - CALL WNCTXT(F_TP,'!Q1\ Y:!10C!5$#E10.0', - 1 STHTEL,IFBUF(0,1)) - END IF - ELSE - IF (NSCGIF('Gain',FCAIN,STHJ,HA,HA,IFBUF)) THEN - CALL WNCTXT(F_TP,'!Q1\Gain X:!10C!5$#E10.0', - 1 STHTEL,IFBUF(0,0)) - CALL WNCTXT(F_TP,'!Q1\ Y:!10C!5$#E10.0', - 1 STHTEL,IFBUF(0,1)) - END IF - IF (NSCGIF('Tsys',FCAIN,STHJ,HA,HA,IFBUF)) THEN - CALL WNCTXT(F_TP,'!Q1\Tsys X:!10C!5$#E10.0', - 1 STHTEL,IFBUF(0,0)) - CALL WNCTXT(F_TP,'!Q1\ Y:!10C!5$#E10.0', - 1 STHTEL,IFBUF(0,1)) - END IF - IF (NSCGIF('GNCAL',FCAIN,STHJ,HA,HA,IFBUF)) THEN - CALL WNCTXT(F_TP,'!Q1\GNC X:!10C!5$#E10.0', - 1 STHTEL,IFBUF(0,0)) - CALL WNCTXT(F_TP,'!Q1\ Y:!10C!5$#E10.0', - 1 STHTEL,IFBUF(0,1)) - END IF - END IF - CALL WNCTXT(F_TP,' ') - ELSE - CALL WNCTXT(F_TP,'No IF data available in this scan-file') - END IF -C -C***************************************************************************** -C DATA DISPLAY -C -C D, A *** - ELSE IF (ACT(1:1).EQ.'D' .OR. ACT(1:1).EQ.'A') THEN !DATA -C -C Do corrections: read data through NSCSCR, get model -C - IF (DO_COR) THEN - J=NINT((HA-STHE(STH_HAB_E))/STHE(STH_HAI_E)) !SCAN NUMBER - IF (.NOT.NSCSCR(FCAIN,STH,IFRT,J, - & CORAP,CORDAP,SCH,WGT,CDAT)) THEN !Get corrected data - CALL WNCTXT(F_TP,'Error reading corrected data') - GOTO 401 !Error correcting - ELSE IF (NSRC(0).GT.0) THEN - CALL NMOMUV(STP,SRA,SDEC,STH,SCH,UV0) !Get model UV data - CALL NMOMU4(0,FCAIN,J,STH,UV0,LM0,FRQ0, - & STHE(STH_RTP_E),STHI(STH_PLN_I), - & STHJ(STH_NIFR_J),IFRT,TF,MINST,CMOD) ! Model data - CALL NMOCIX(STH,SCH,ANG,CAMOD,CMOD) !Convert - END IF -C -C No corrections: just copy into complex array -C - ELSE - DO I1=0,STHJ(STH_NIFR_J)-1 !ALL INTERFEROMETERS - I=STHI(STH_PLN_I)*I1+OPOL - CDAT(I1,POLC)=CMPLX(ODAT(1,I),ODAT(2,I)) - END DO - END IF -C -C Convert to ampl/phase or cos/sin -C - DO I1=0,STHJ(STH_NIFR_J)-1 ! SCAN ALL IFRs - CV1=CDAT(I1,POLC) ! DATA - CV2=0 ! NO MODEL - IF (DO_COR.AND.NSRC(0).GT.0) CV2=CAMOD(I1,POLC) ! MODEL - IF (ACT(1:1).EQ.'A') THEN - CALL WNMAAM(1,CV1-CV2,RDAT(I1,1)) !MAKE AMPL - CALL WNMAPH(1,CV1-CV2,RDAT(I1,2)) !MAKE PHASE - RDAT(I1,2)=WNGEFD(RDAT(I1,2)) !MAKE DEGREES - IF (RDAT(I1,2).GT.180) RDAT(I1,2)=RDAT(I1,2)-360. !-180..180 - ELSE - RDAT(I1,1)=REAL(CV1-CV2) - RDAT(I1,2)=AIMAG(CV1-CV2) - END IF - END DO -C -C Find extrema -C - R0=-1. !FIND MAX - DO I1=0,STHJ(STH_NIFR_J)-1 - I=STHI(STH_PLN_I)*I1+OPOL !DATA POINTER - IF (ODAT(0,I).NE.0) THEN - IF (ACT(1:1).EQ.'A') THEN - R0=MAX(R0,RDAT(I1,1)) - ELSE - R0=MAX(R0,ABS(RDAT(I1,1))) - R0=MAX(R0,ABS(RDAT(I1,2))) - END IF - END IF - END DO - IF (R0.GE.10000.) THEN !SET SCALE - R0=10. - ELSE - R0=1. - END IF - IF (ACT(1:1).EQ.'A') THEN !HEADING - CALL WNCTXT(F_TP,'!/!26C\!AS Amplitude (!E5.0 W.U.)', - 1 POLNM,R0) - ELSE - CALL WNCTXT(F_TP,'!/!29C\!AS Cos (!E5.0 W.U.)', - 1 POLNM, R0) - END IF - TEXT(-1)=' ' - DO I=0,STHTEL-1 - TEXT(-1)(I*5+6:I*5+6)=TELS(I+1:I+1) - END DO - TEXT(-1)(74:74)='.' - CALL WNCTXT(F_TP,'!#$AS',LEN(TEXT(0)),TEXT(-1)) - DO I=0,STHTEL !SET NO DATA - TEXT(I)=' ' - DO I2=0,STHTEL-1 - IF (I.NE.I2) TEXT(I)(5*I2+6:5*I2+6)='.' - END DO - IF (I.NE.STHTEL) THEN - TEXT(I)(74:74)=TELS(I+1:I+1) - ELSE - TEXT(I)(74:74)='.' - END IF - IF (I.NE.0) THEN - TEXT(I)(1:1)=TELS(I:I) - END IF - END DO -C - DO I2=0,STHJ(STH_NIFR_J)-1 - I=STHI(STH_PLN_I)*I2+OPOL !DATA POINTER - IF (ODAT(0,I).NE.0) THEN !DATA PRESENT - IF (ACT(1:1).EQ.'A') THEN !AMPL/PHASE - R1=RDAT(I2,1)/R0 - R2=RDAT(I2,2) !DO NOT SCALE PHASE - ELSE !COS/SIN - R1=RDAT(I2,1)/R0 - R2=RDAT(I2,2)/R0 - END IF - CALL WNCTXS(TEXT(MOD(IFRT(I2),256))(5*(IFRT(I2)/256)+3: - 1 5*(IFRT(I2)/256)+7), - 1 '!5$E6.0',R1) - CALL WNCTXS(TEXT(IFRT(I2)/256+1)(5*MOD(IFRT(I2),256)+3: - 1 5*MOD(IFRT(I2),256)+7), - 1 '!5$E6.0',R2) - END IF - END DO - DO I=0,STHTEL !SHOW DATA - CALL WNCTXT(F_TP,'!#$AS',LEN(TEXT(0)),TEXT(I)) - END DO - CALL WNCTXT(F_TP,'!#$AS',LEN(TEXT(0)),TEXT(-1)) !BOTTOM - IF (ACT(1:1).EQ.'A') THEN !HEADING - CALL WNCTXT(F_TP,'!26C\!AS Phase (deg)!/',POLNM) - ELSE - CALL WNCTXT(F_TP,'!29C\!AS Sin (!E5.0 W.U.)!/', - 1 POLNM,R0) - END IF -! *** W - ELSE IF (ACT(1:1).EQ.'W') THEN !WEIGHT - R1=0. !FIND MAX - DO I1=0,STHJ(STH_NIFR_J)-1 - I=STHI(STH_PLN_I)*I1+OPOL !DATA POINTER - IF (ODAT(0,I).NE.0) THEN - I2=ODAT(0,I) !WEIGHT/FLAGS - R1=MAX(R1,FLOAT(IAND(I2,'000000ff'X))* - 1 (1.-STHE(STH_WFAC_E))) - END IF - END DO - R0=1 !SET SCALE - IF (R1.GT.0) THEN !CAN DO - DO WHILE (R1.GE.1000.*R0) - R0=R0*10. - END DO - DO WHILE (R1.LT.100.*R0) - R0=R0/10. - END DO - END IF - CALL WNCTXT(F_TP,'!/!26C\!AS Data weight (*!E12.4)', - 1 POLNM,R0) - TEXT(-1)=' ' - DO I=0,STHTEL-1 - TEXT(-1)(I*5+6:I*5+6)=TELS(I+1:I+1) - END DO - TEXT(-1)(74:74)='.' - CALL WNCTXT(F_TP,'!#$AS',LEN(TEXT(0)),TEXT(-1)) - DO I=0,STHTEL !SET NO DATA - TEXT(I)=' ' - DO I2=0,STHTEL-1 - IF (I.NE.I2) TEXT(I)(5*I2+6:5*I2+6)='.' - END DO - IF (I.NE.STHTEL) THEN - TEXT(I)(74:74)=TELS(I+1:I+1) - ELSE - TEXT(I)(74:74)='.' - END IF - IF (I.NE.0) THEN - TEXT(I)(1:1)=TELS(I:I) - END IF - END DO - DO I2=0,STHJ(STH_NIFR_J)-1 - I=STHI(STH_PLN_I)*I2+OPOL !DATA POINTER -!!! IF (ODAT(0,I).NE.0) THEN !DATA PRESENT - I3=ODAT(0,I) !WEIGHT/FLAGS - R1=IAND(I3,'000000ff'X)*(1.-STHE(STH_WFAC_E))/R0 !WEIGHT - IF (IAND(FL_ALL,I3).NE.0) R1=-R1 !INDICATE FLAGGING - I3=IAND('000000ff'X,ISHFT(I3,-8)) !FLAGS - CALL WNCTXS(TEXT(MOD(IFRT(I2),256))(5*(IFRT(I2)/256)+3: - 1 5*(IFRT(I2)/256)+7), - 1 '!5$E6.0',R1) - IF (I3.NE.0) THEN - CALL WNCTXS(TEXT(IFRT(I2)/256+1)(5*MOD(IFRT(I2),256)+3: - 1 5*MOD(IFRT(I2),256)+7), - 1 ' !2$XJ',I3) - END IF -!!! END IF - END DO - DO I=0,STHTEL !SHOW DATA - CALL WNCTXT(F_TP,'!#$AS',LEN(TEXT(0)),TEXT(I)) - END DO - CALL WNCTXT(F_TP,'!#$AS',LEN(TEXT(0)),TEXT(-1)) !BOTTOM - CALL WNCTXT(F_TP,'!32C!AS Data flags!/', - 1 POLNM) !HEADINGS -! *** T - ELSE IF (ACT(1:1).EQ.'T') THEN !TELESCOPE GAIN/PHASE - CALL NCATL1(FCAIN,STH,HA,HA,IFRS,PCGAN,PCPHA,F_TP) !GET AND SHOW -! *** S - ELSE IF (ACT(1:1).EQ.'S') THEN !SHOW HEADER DETAILS - CALL NSCXSL(F_TP,FCAIN,SCHP) -! *** I - ELSE IF (ACT(1:1).EQ.'I') THEN !SHOW TELESCOPE HEADERS - DO I=1,4 !ALL POINTERS - J0=SCHJ(IFRCP(1,I)) !GET POINTER - IF (J0.NE.0) THEN !AVAILABLE - IF (WNFRD(FCAIN,4*STHJ(STH_NIFR_J)*LB_X, - 1 IFRCOR,J0)) THEN !READ IFR DATA - CALL WNCTXT(F_TP,'!/!AS',IFRCC(I)) !DESCRIPTION - CALL WNCTXT(F_TP,'Ifr XX XY'// - 1 ' YX YY') !HEADER - IF (IFRCP(2,I).EQ.1) THEN !MULTIPLICATIVE - CALL WNCTXT(F_TP,' % deg %'// - 1 ' deg % deg % deg') - DO I1=0,4*STHJ(STH_NIFR_J)-1 !MAKE % and deg - IFRCOR(1,I1)=100*(EXP(IFRCOR(1,I1))-1) - IFRCOR(2,I1)=DEG*IFRCOR(2,I1) - END DO - ELSE !ADDITIVE - CALL WNCTXT(F_TP,' cos sin cos'// - 1 ' sin cos sin cos sin') - END IF -C - DO I1=0,STHTEL-1 !ALL TELESCOPES - DO I2=0,STHTEL-1 - IF (IFRS(I1,I2)) THEN !PRESENT - CALL WNCTXT(F_TP,'!Q1!1$XJ!1$XJ !8$8E8.2', - 1 I1,I2,IFRCOR(1,4*IFRSX(I1,I2))) !SHOW VALUES - END IF - END DO - END DO -C - CALL WNCTXT(F_TP,' ') - END IF !IF CAN READ - ELSE !IF NOT AVAILABLE - CALL WNCTXT(F_TP,'!/!AS NOT available',IFRCC(I)) !DESCRIPTION - CALL WNCTXT(F_TP,' ') - END IF !IF AVAILABLE - END DO !NEXT POINTER -! *** E - ELSE IF (ACT(1:1).EQ.'E') THEN !EDIT HEADER DETAILS - IF (MODE.EQ.'R') THEN !CHANGE TO UPDATE MODE - MODE='U' !MAKE UPDATE - CALL WNFCL(FCAIN) !CLOSE FILE - IF (.NOT.WNDNOC(' ',' ','SCN',MODE,' ',IFILE)) THEN !CHANGE DATES - CALL WNCTXT(F_TP,'Node is not writable') - GOTO 100 - END IF - IF (.NOT.WNFOP(FCAIN,IFILE,MODE)) THEN !OPEN SCN FILE - CALL WNCTXT(F_TP,'Cannot write to file attached to node') - GOTO 100 - END IF - END IF - CALL NSCESL(F_TP,FCAIN,SCHP) - ELSE !HA - WRITE (UNIT=F1000,FMT=1002,ERR=403) LEN(ACT) - 1002 FORMAT('(BN,F',I4.4,'.0)') - READ(UNIT=ACT,FMT=F1000,ERR=403) HA - HA=HA/360. !MAKE FRACTIONS - NEWHA=.TRUE. - END IF - GOTO 401 !NEXT ACTION -C - 402 CONTINUE - CALL WNCTXT(F_T,'Polarisation !AS not available', ACT) - GOTO 401 !NEXT ACTION -C - 403 CONTINUE - CALL WNCTXT(F_T,'Format error in HA or unknown option') - GOTO 401 !NEXT ACTION -C -C - END diff --git a/src/nscan/nflput.for b/src/nscan/nflput.for deleted file mode 100644 index 4a5e7c636707e9d126a0a64cf0b1186e6af748d3..0000000000000000000000000000000000000000 --- a/src/nscan/nflput.for +++ /dev/null @@ -1,716 +0,0 @@ -C+ NFLPUT.FOR -C JEN 931111 -C -CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC -C - SUBROUTINE NFLPUT (OPER,USERFLAG,DFAR, - 1 SHOW_CNT,TRACE) -C -C PUT flags from the internal flag-list (FLF) into the Scan headers -C and/or the uv-data inside (a sub-cube of) the specified hypercube. -C -C Result: -C -C CALL NFLPUT (OPER_C(*):I,USERFLAG_J:I,DFAR_J:IO, -C SHOW_CNT_L:I,TRACE_L:I) -C -C PIN references: -C -C PUT_RANGE -C -C Include files: -C - INCLUDE 'WNG_DEF' - INCLUDE 'NFL_DEF' - INCLUDE 'CBITS_DEF' - INCLUDE 'STH_O_DEF' !SET HEADER - INCLUDE 'SCH_O_DEF' !SCAN HEADER - INCLUDE 'FLH_O_DEF' !DELETE FILE HEADER - INCLUDE 'FLF_O_DEF' !ENTRY HEADER -C -C Parameters: -C - INTEGER XX,XY,YX,YY !POL. POINTERS - PARAMETER (XX=0, XY=1, YX=2, YY=3) -C - INTEGER NPUTR !# IN PUT RANGE (chan,ha,ifr,pol) - PARAMETER (NPUTR=4) - INTEGER MXRANG !MAX. RANGE VALUE - PARAMETER (MXRANG=65536*16) -C -C Arguments: -C (NB: NODIN, FCAIN and SETS are in common block) -C - CHARACTER OPER*(*) !SELECTED OPERATION -C - INTEGER USERFLAG !FLAGBYTE (FOR USER OVERRIDE) - INTEGER DFAR !FLAG FILE AREA CONTROL PAR -C - LOGICAL SHOW_CNT !SHOW FLAG-COUNT AFTER OPS - LOGICAL TRACE !TRACE/DEBUG FLAGGING OPERATION -C -C Function references: -C - LOGICAL WNDPAR !GET DWARF PARAMETER - LOGICAL WNFRD !READ DATA - LOGICAL WNFWR !WRITE DATA - CHARACTER*32 WNTTSG !SET NAME - LOGICAL WNDSTQ !GET SETS - INTEGER WNCAJ !GET INTEGER FROM TEXT - LOGICAL NSCSTG !GET A SET - LOGICAL NSCSCH,NSCSCW !READ/WRITE SCAN HEADER - LOGICAL NSCSIF !READ INTERFEROMETER TABLE - LOGICAL NSCIFS !IFR SELECTION - LOGICAL NSCPLS !POL SELECTION - LOGICAL NSCHAS !HA SELECTION - LOGICAL NFLFL0,NFLFL1,NFLFL2 !FLAG FILE HANDLING - LOGICAL NFLFL5,NFLFL6 - LOGICAL NFLFL7,NFLFL8,NFLFL9 - LOGICAL NFLFLS,NFLFLR - LOGICAL NFLCNT !FLAG COUNTING - LOGICAL NFLCUB !UV-DATA HYPER/SUB-CUBE -C -C Data declarations: -C -C----------------------------------------------------------------------- -C -C "Static variables" -C -C Look-up table to find existence and offset for polarisations -C depending on the number of polarisations present in the data -C - INTEGER PPOL(XX:YY,1:4,0:1) !POL. SELECT XX,XY,YX,YY FOR - ! NPOL=1:4: -C OLD: DATA PPOL/1,0,0,0, 1,0,0,8, 0,0,0,0, 1,2,4,8, !BITS - DATA PPOL/XX_P,0,0,0, XX_P,0,0,YY_P, 0,0,0,0, - 1 XX_P,XY_P,YX_P,YY_P, !BITS - 1 0,0,0,0, 0,0,0,1, 0,0,0,0, 0,1,2,3/ !OFFSETS -C -C----------------------------------------------------------------------- -C -C Variables with user-input, defaults and direct derivatives -C - INTEGER I6,I7,I8,I9 !LOOP VARIABLES - INTEGER NOPER !CURRENT OPERATION NR (E.G. N_PUT) - REAL HA(0:1) !EXTRA HA-RANGE - CHARACTER*8 PUTR(NPUTR) !PUT RANGE DEFINED BY USER - INTEGER JPUTR(0:1,NPUTR) !PUT RANGE (LOW,HIGH) - LOGICAL TYPIFR !ENTRY TYPE IS IFR-TYPE - INTEGER IFRMIN,IFRMAX !MIN, MAX IFR NR (PUT) - INTEGER IPOLMIN,IPOLMAX !MIN, MAX POL NR (PUT) - INTEGER RTW,RTE !WEST, EAST TEL NR (PUT) - INTEGER RTW1,RTW2 !WEST TEL NRS (PUT) - INTEGER RTE1,RTE2 !EAST TEL NRS (PUT) - INTEGER RTWMIN,RTWMAX !MIN, MAX WEST TEL NR (PUT) - INTEGER RTEMIN,RTEMAX !MIN, MAX EAST TEL NR (PUT) - INTEGER ICHMIN,ICHMAX !MIN, MAX FREQU CHANN NR (PUT) - REAL HAMIN,HAMAX !MIN, MAX HA (PUT) - INTEGER BAS,BASMIN,BASMAX !BASELINE LENGTH (PUT, M) - INTEGER NENT !ENTRY COUNTER -C -C Flow control -C - INTEGER SELFLAG !SELECTED FLAG(S) TO BE PUT - INTEGER FLAG !FLAGBYTE FROM LIST ENTRY - INTEGER FLAGH !FLAGBYTE FOR SCAN HEADER - INTEGER FLAGD !FLAGBYTE FOR UV-DATUM -C - LOGICAL SETFLAG !FLAG/UNFLAG - LOGICAL SETFH - LOGICAL SETFD -C - LOGICAL MODFH !MODIFY FLAG(S) IN HEADER - LOGICAL MODFD !MODIFY FLAG(S) IN UV-DATUM -C - LOGICAL WRSCH !REWRITE (MODIFIED) SCAN HEADER - LOGICAL WRSCN !REWRITE (MODIFIED) SCAN DATA -C -C----------------------------------------------------------------------- -C -C Storage areas, buffer arrays -C - CHARACTER*80 TXT80 !TEXT BUFFER -C - REAL SELHA(0:1) !SELECTED HA-RANGE (NSCHAS) - LOGICAL SELPOL(0:3) !SELECTED POLS - BYTE SELIFR(0:STHTEL-1,0:STHTEL-1) !SELECTED IFRS PER TEL PAIR - LOGICAL SELIFR1(0:STHIFR-1) !SELECTED IFRS PER IFR -C - INTEGER IFRNR(0:STHTEL-1,0:STHTEL-1) !IFR NR LOOKUP TABLE -C - INTEGER FLACC(0:STHIFR-1,0:3) !FLAG COUNTS - INTEGER MASK(0:STHIFR-1,0:3) !FLAGBYTES USED -C - INTEGER SNAM(0:7) !SET NAME - INTEGER STHP !SET HEADER POINTER - BYTE STH(0:STH__L-1) !SET HEADER - INTEGER*2 STHI(0:STH__L/LB_I-1) - INTEGER STHJ(0:STH__L/LB_J-1) - REAL STHE(0:STH__L/LB_E-1) - DOUBLE PRECISION STHD(0:STH__L/LB_D-1) - EQUIVALENCE (STH,STHJ,STHI,STHE,STHD) - BYTE SCH(0:SCH__L-1) !SCAN HEADER - INTEGER*2 SCHI(0:SCH__L/LB_I-1) - INTEGER SCHJ(0:SCH__L/LB_J-1) - REAL SCHE(0:SCH__L/LB_E-1) - EQUIVALENCE (SCH,SCHJ,SCHI,SCHE) -C - INTEGER*2 IFRT(0:STHIFR-1) !INTERFEROMETER TABLE - INTEGER IFRA(0:1,0:STHIFR-1) !RTWEST(0), RTEAST(1) - REAL BASEL(0:STHIFR-1) !BASELINE TABLE (M) - REAL ANG(0:2,STHIFR-1) !DIPOLE ANGLE INFORMATION -C - INTEGER CHCUR !CURRENT CHANNEL NR - REAL HACUR !CURRENT HA -C - INTEGER*2 LDAT(0:2,0:4*STHIFR-1) !DATA -C - BYTE FLH(0:FLH__L-1) !FLAG FILE HEADER - INTEGER FLHJ(0:FLH__L/LB_J-1) - REAL FLHE(0:FLH__L/LB_E-1) - EQUIVALENCE (FLH,FLHJ,FLHE) - BYTE FLF(0:FLF__L-1,2) !FLAG FILE ENTRIES (RANGE) - INTEGER*2 FLFI(0:FLF__L/LB_I-1,2) - INTEGER FLFJ(0:FLF__L/LB_J-1,2) - REAL FLFE(0:FLF__L/LB_E-1,2) - EQUIVALENCE (FLF,FLFI,FLFJ,FLFE) -C- -C****************************************************************************** -C***************************************************************************** -C***************************************************************************** -C -C Initialise: -C - SETFLAG = .TRUE. !ALWAYS -C -C Make sure that there is a flag-list to be PUT: -C - IF (DFAR.EQ.0) THEN - CALL WNCTXT(F_TP, - 1 'No entries in list (use GET/LOAD/READ)') - GOTO 700 !ESCAPE - ELSE - IF (.NOT.NFLFLS(DFAR,FLH)) GOTO 700 !GET FLAG-LIST HEADER (FLH) - END IF -C -C Only specified flag types are GOT. The default is all flag-types, -C unless the flag-types are explicitly given (USERFLAG>0). -C The user may locally override the flag-types. -C - CALL WNCTXT (F_TP,'Only PUT flags of the following type(s):') - SELFLAG=FL_ALL !DEFAULT FLAG TYPE(S): ALL TYPES - IF (USERFLAG.NE.0) SELFLAG=USERFLAG !OVERRIDE BY USER-DEFINED FLAG TYPE(S) - CALL WNDDA3 ('SELECT_FLAG',SELFLAG) !ASK THE USER - IF (SELFLAG.EQ.0) THEN - CALL WNCTXT (F_TP,'No flag type(s) to be PUT') - GOTO 700 !NONE: ESCAPE - END IF -C -C Get put-range (i.e expand-range) JPUTR, in NPUTR dimensions. -C This allows the user to `convolve' the flags in the flag-list -C with a range in any of the 4 expansion directions. -C Succession of dimension-indices: chan(1), HA(2), ifr(3), pol(4) -C For each expansion dimension I, a `left' (JPUTR(0,I)) and `right' -C (JPUTR(1,I)) expansion renge is given. -C - DO I=1,NPUTR !FOR ALL EXPANSION DIMENSIONS - JPUTR(0,I)=0 !DEFAULT: NO EXPANSION TO THE `LEFT' - JPUTR(1,I)=0 ! NOR TO THE `RIGHT' - END DO -C -C NB: The only meaning-full expansions are in the dimensions: -C - channel (it may be desirable to expand the flagging of a bad -C interferometer in one channel to all channels, in order to -C have the same uv-coverage for all cannels. -C Since the old expansion keyword (PUT_RANGE) was not easy to understand, -C it has been replaced with separate keuwords for each expansion dimension. -C - I4 = 1 !DIMENSION IS CHANNELS - IF (.NOT.WNDPAR('PUT_EXPAND_CH',JPUTR(1,I4),LB_J, - 1 J0,A_B(-A_OB),JPUTR(1,I4),1)) GOTO 700 !ESCAPE - IF (J0.EQ.0) GOTO 700 !EMPTY STRING: ESCAPE - IF (J0.LT.0) THEN !WILDCARD (*): PUT ALL - JPUTR(0,I4)=-MXRANG - JPUTR(1,I4)=+MXRANG - ELSE IF (JPUTR(1,I4).GE.0) THEN !VALID NR OF CHANNELS - JPUTR(0,I4)=-JPUTR(1,I4) !SYMMETRIC LEFT/RIGHT - ELSE !NEGATIVE NR (?) - END IF -C - CALL WNCTXT (F_TP, - 1 'NFLPUT: expansion (channels):' - 1 //' !SJ+ich <-> ich+!SJ' - 1 ,JPUTR(0,I4),JPUTR(1,I4)) -C -C Select sub-cube of the uv-data hypercube (specified before): -C - IF (.NOT.NFLCUB('SELECT','HYPERCUBE',0, - 1 SELHA,SELPOL,SELIFR)) GOTO 700 - IF (.NOT.NFLCUB('SPECIFY','SUBCUBE',0, - 1 SELHA,SELPOL,SELIFR)) GOTO 700 -C -C Adjust the selected HA-range (SELHA) according to the range of HA's -C of all the entries in the flag-list, enlarged with a possible expansion -C PUT-range in the HA-direction (JPUTR). -C This HA-range is stored in the flag-list header (FLH)). -C NB: This can only decrease the selected HA-range, to save processing time. -C It will NOT extend the selected range beyond the (sub-cube of the) -C specified data hypercube. -C - HAMIN=-179.99/360 !MINIMUM START HA (CIRCLES) - HAMAX=+179.99/360 !MAXIMUM STOP HA (CIRCLES) - IF (FLHJ(FLH_HA_J).EQ.-1) THEN !ALL HA's AVAILABLE - CONTINUE - ELSE - HAMIN = FLHE(FLH_RHA_E+0)+ - 1 (JPUTR(0,2)-0.5)*STHE(STH_HAI_E) - HAMAX = FLHE(FLH_RHA_E+1)+ - 1 (JPUTR(1,2)+0.5)*STHE(STH_HAI_E) - END IF - SELHA(0) = MAX(HAMIN,SELHA(0)) !MIN SELECTED HA (CIRCLES) - SELHA(1) = MIN(HAMAX,SELHA(1)) !MAX SELECTED HA (CIRCLES) -C -C***************************************************************************** -C***************************************************************************** -C***************************************************************************** -C ACT ON HYPERCUBE -C - 300 CONTINUE -C -C Reset the flag-count buffers: -C - JS = NFLCNT ('RESET',' ',0,0,0,0,0) -C -C Flow control: -C - SETFLAG = .TRUE. !GLOBAL SET/CLEAR SWITCH -C -C Read Set(s) of Sectors: -C - DO WHILE (NSCSTG(FCAIN,SETS,STH,STHP,SNAM)) !ALL SECTORS - IF (.NOT.NSCSIF(FCAIN,STH,IFRT,IFRA,ANG)) THEN !READ IFR TABLE - CALL WNCTXT(F_TP,'Error reading interferometer table') - GOTO 30 !NEXT SECTOR - END IF -C -C Adjust the polarisation selection, to ignore polarisations that may -C not be present in this SCN Sector, using info from the Sector Header: -C - IF (.NOT.NFLCUB('ADJUST','SELPOL',STHI(STH_PLN_I), - 1 SELHA,SELPOL,SELIFR)) GOTO 30 !PROBLEM, NEXT SECTOR -C -C Make a quick-lookup table (IFRNR) for ifr-numbers. -C Make a quicker ifr-selection table (SELIFR1). -C - DO I1=0,STHJ(STH_NIFR_J)-1 - RTW = IFRA(0,I1) !WEST TEL NR - RTE = IFRA(1,I1) !EAST TEL NR - IFRNR(RTW,RTE) = I1 !IFR NR - SELIFR1(I1) = SELIFR(RTW,RTE) - END DO -C -! Check if the channel (CHCUR) of the current Sector is needed (i.e -C whether it is in the channel range of any of the flag-list entries. -! (enlarged with the user-defined put-range). -C This channel-range is stored in the flag-list header. -C - CHCUR=STHI(STH_CHAN_I) !FREQU CHANNEL NR OF THE CURRENT SECTOR - ICHMIN = FLHJ(FLH_RCHAN_J+0)+JPUTR(0,1) !MIN CHANNEL IN LIST - ICHMAX = FLHJ(FLH_RCHAN_J+1)+JPUTR(1,1) !MAX CHANNEL IN LIST - IF ((FLHJ(FLH_CHAN_J).NE.-1) .AND. - 1 (CHCUR.LT.ICHMIN .OR. CHCUR.GT.ICHMAX)) THEN - GOTO 30 !CHANNEL OUT OF RANGE, SKIP SECTOR - END IF -C -C Get baseline lengths (for baseline-type flag-list entries, if any): -C - CALL NSCMBL(STHE(STH_RTP_E),STHJ(STH_NIFR_J),IFRT, - 1 SELIFR,BASEL) !GET BASELINES -C -C -C -C****************************************************************************** -C ACT ON HA-SCANS: -C - 400 CONTINUE -C - DO I=0,STHJ(STH_SCN_J)-1 !ALL SCANS - HACUR=STHE(STH_HAB_E)+I*STHE(STH_HAI_E) !HA OF SCAN - IF (HACUR.GE.(SELHA(0)-STHE(STH_HAI_E)/2+1E-5) .AND. - 1 HACUR.LE.(SELHA(1)+STHE(STH_HAI_E)/2-1E-5)) THEN !SELECTED -C - IF (.NOT.NSCSCH(FCAIN,STH,IFRT,I,0,0,SCH)) THEN !READ HEADER - CALL WNCTXT(F_TP,'Error reading scan header !UJ',I) - GOTO 30 - END IF - WRSCH = .FALSE. !NO REWRITE SCAN HEADER -C - IF (.NOT.WNFRD(FCAIN,STHJ(STH_SCNL_J)-SCH__L, - 1 LDAT,STHJ(STH_SCNP_J)+ - 1 I*STHJ(STH_SCNL_J)+SCH__L)) THEN !READ SCAN DATA - CALL WNCTXT(F_TP,'Error reading scan !UJ',I) - GOTO 700 - END IF - WRSCN = .FALSE. !NO REWRITE SCAN DATA -C -C Flag-count accumulator for newly PUT uv-data. To save time, all new -C flags (i.e. from all flag-list entries) PUT to the uv-data in this -C Scan are accumulated by means of licical OR-operations, and counted -C before going to the next Scan. -C - DO I1=0,STHIFR-1 - DO I3=0,3 - FLACC(I1,I3) = 0 !FLAG-COUNT - MASK(I1,I3) = 0 - END DO - END DO -C -C***************************************************************************** -C***************************************************************************** -! Go through entries of the flag-list. -C - JS=NFLFLR(DFAR) !MAKE SURE BEGIN LIST - NENT = 0 !COUNTER - DO WHILE(NFLFL2(DFAR,FLF(0,1),FLF(0,2))) !READ ALL ENTRIES - NENT = NENT+1 -C -C Check whether the entry's flag contains any of the selected flag-types: -C - FLAG = IAND(FL_ALL,FLFJ(FLF_FLAG_J,1)) !COPY ENTRY FLAG - IF (IAND(FLAG,SELFLAG).EQ.0) GOTO 80 !SELECTED FLAG TYPES ONLY - FLAGH = FLAG !HEADER FLAG (if required) - FLAGD = FLAG !DATA FLAG (if required) -C -C Check whether the entry's channel range (extended with the user-defined -C PUT-range) covers the current channel: -C - ICHMIN = FLFJ(FLF_CHAN_J,1)+JPUTR(0,1) !MIN CHANNEL NR - ICHMAX = FLFJ(FLF_CHAN_J,2)+JPUTR(1,1) !MAX CHANNEL NR - IF (FLFJ(FLF_CHAN_J,1).NE.-1) THEN !NOT ALL CHANNELS - IF (CHCUR.LT.ICHMIN) GOTO 80 !OUT OF RANGE - IF (CHCUR.GT.ICHMAX) GOTO 80 !OUT OF RANGE - END IF -C -C Check whether the entry's HA-range (extended with the user-defined -C PUT-range) covers the current HA: -C - HAMIN = FLFE(FLF_HA_E,1)+ - 1 (JPUTR(0,2)-0.5)*STHE(STH_HAI_E) !MIN HA - HAMAX = FLFE(FLF_HA_E,2)+ - 1 (JPUTR(1,2)+0.5)*STHE(STH_HAI_E) !MAX HA - IF (FLFE(FLF_HA_E,1).NE.-1) THEN !NOT ALL HA's - IF (HACUR.LT.HAMIN) GOTO 80 !OUT OF RANGE - IF (HACUR.GT.HAMAX) GOTO 80 !OUT OF RANGE - END IF -C -C Debugging message (if required): -C - IF (TRACE) THEN - CALL WNCTXT (F_T,' HA=!8$EAF6.2:' - 1 //' ENTRY NR !UJ' - 1 ,HACUR,NENT) - END IF -C -C****************************************************************************** -C****************************************************************************** -C ACT ON SCAN HEADER (if required): -C -C If the entry specifies all ifrs (*) and all pols (*), then put flag(s) -C in the Scan header: -C - IF ((FLFI(FLF_IFR_I,1).EQ.-1) .AND. - 1 (FLFI(FLF_POL_I,1).EQ.-1)) THEN !ALL POLS AND IFRS - MODFH = .TRUE. -C -C MODIFY SCAN HEADER FLAGS (IF REQUIRED): -C - IF (MODFH) THEN - SETFH = .TRUE. !ALWAYS FOR PUT.... - IF (SETFH) THEN !SET FLAG - SCHJ(SCH_BITS_J)= - 1 IOR(SCHJ(SCH_BITS_J),FLAGH) - ELSE !CLEAR FLAG(S) (relevant for PUT?) - SCHJ(SCH_BITS_J)= - 1 IAND(SCHJ(SCH_BITS_J),NOT(FLAGH)) - END IF - WRSCH = .TRUE. !WRITE BACK THE MODIFIED SCAN HEADER -C -C COUNT THE PUT FLAGS (i.e. those from the flag-list only, and not the ones -C that were already set in the Scan header!): -C - JS = NFLCNT ('ACC','HEAD',FLAGH,SELFLAG, - 1 IFRA,CHCUR,HACUR) - END IF -C -C NB: It would not be correct to escape from the loop here and to go to the -C next Scan, since there might be other entries in the flag-list that -C set other flags in the Scan header (and the uv-data!!!??). -C This issue requires a little thought..... -C -C -C -C -C****************************************************************************** -C****************************************************************************** -C ELSE, ACT ON UV-DATA: -C - ELSE -C -! To save time, determine the range of ifrs (IFRMIN-IFRMAX) and pols -! (IPOLMIN-IPOLMAX) of the uv-data in which flags are to be set according -! to the current flag-list entry. -! NB: The entry can be of `ifr-type' (TYPIFR=.TRUE.) or `baseline-type' -! (TYPIFR=.FALSE.). In the latter case, its `ifr-range' indicates a range -! of baseline lengths (m) for which flags have to be set. -C - TYPIFR = .TRUE. !IFR-TYPE ENTRY - IF (IAND(FLFJ(FLF_FLAG_J,1),'01000000'X).NE.0) - 1 TYPIFR = .FALSE. !BASEL-TYPE ENTRY -C - IFRMIN = 0 !MIN IFR NR - IFRMAX = STHIFR-1 !MAX - BASMIN = 0 !MIN BASLENGTH (M) - BASMAX = 10000 !MAX - IF (FLFI(FLF_IFR_I,1).EQ.-1) THEN !ALL IFRS/BAS - CONTINUE - ELSE - IF (TYPIFR) THEN !IFR-TYPE ENTRY - RTW = MOD(FLFI(FLF_IFR_I,1),256) !WEST TEL - RTE = FLFI(FLF_IFR_I,1)/256 !EAST TEL - IFRMIN = MAX(IFRMIN,IFRNR(RTW,RTE)+JPUTR(0,3)) - RTW = MOD(FLFI(FLF_IFR_I,2),256) !WEST TEL - RTE = FLFI(FLF_IFR_I,2)/256 !EAST TEL - IFRMAX = MIN(IFRMAX,IFRNR(RTW,RTE)+JPUTR(1,3)) - ELSE !BASEL-TYPE ENTRY - BASMIN = MAX(BASMIN, - 1 FLFI(FLF_IFR_I,1)+JPUTR(0,3)) - BASMAX = MIN(BASMAX, - 1 FLFI(FLF_IFR_I,2)+JPUTR(1,3)) - END IF ! - END IF -C - IPOLMIN = 0 !MIN POL NR - IPOLMAX = 3 !MAX - IF (FLFI(FLF_POL_I,1).EQ.-1) THEN !ALL POLS - CONTINUE - ELSE - IPOLMIN = MAX(0,FLFI(FLF_POL_I,1)+JPUTR(0,4)) - IPOLMAX = MIN(3,FLFI(FLF_POL_I,2)+JPUTR(1,4)) - END IF -C - IF (TRACE) THEN - CALL WNCTXT (F_T,' ' - 1 //' IFR12=!SJ:!SJ POL12=!SJ:!SJ' - 1 //' TYPIFR=!LJ' - 1 ,IFRMIN,IFRMAX,IPOLMIN,IPOLMAX,TYPIFR) - END IF -C -C GO THROUGH THE RELEVANT UV-DATA FOR THIS FLAG-LIST ENTRY: -C - DO I1=IFRMIN,IFRMAX !IFRS - IF (SELIFR1(I1)) THEN !SELECTED IFR - MODFD = .FALSE. - IF (TYPIFR) THEN !IFR-TYPE ENTRY - MODFD = .TRUE. !ALWAYS - ELSE !BASEL-TYPE ENTRY - BAS = NINT(BASEL(I1)) !BASELINE LENGTH (M) - IF (BAS.GE.BASMIN .AND. - 1 BAS.LE.BASMAX) MODFD=.TRUE. !BAS IN RANGE - END IF -C - IF (MODFD) THEN !MODIFY FLAG - I2=STHI(STH_PLN_I)*I1 !DATA POINTER - DO I3=IPOLMIN,IPOLMAX !POLS - IF (SELPOL(I3)) THEN !SELECTED POL -C - I4=I2+PPOL(I3,STHI(STH_PLN_I),1) !OFFSET - I5=LDAT(0,I4) !WEIGHT/FLAGS - I5=IAND('0000ffff'X,I5) !WEIGHT/FLAGS - IF (I5.NE.0) THEN !DATA PRESENT (WEIGHT<>0) -C - SETFD = .TRUE. !ALWAYS FOR PUT..... - IF (SETFD) THEN !SET FLAG - I5=IOR(I5,FLAGD) - ELSE !CLEAR FLAG (relevant?) - I5=IAND(I5,NOT(FLAGD)) - END IF - IF (IAND(I5,'00008000'X).NE.0) THEN - I5=IOR(I5,'ffff0000'X) - END IF - LDAT(0,I4)=I5 !MODIFIED DATA FLAGBYTE - WRSCN=.TRUE. !REWRITE SCAN DATA (below) -C - FLACC(I1,I3) = IOR(FLAGD,FLACC(I1,I3)) - MASK(I1,I3) = IOR(FLAGD,MASK(I1,I3)) !? -C - END IF !DATA PRESENT - END IF !SELPOL - END DO !POLS (I3) - END IF !MODFD -C - END IF !SELIFR1 - END DO !IFRS (I1) -C - END IF !HEADER OR DATA - 80 CONTINUE !IF OUT OF HA/CHAN RANGE - END DO !FLAG-LIST ENTRIES -C -C REWRITE SCAN DATA (IF REQUIRED): -C - IF (WRSCN) THEN !REWRITE SCAN - IF (.NOT.WNFWR(FCAIN,STHJ(STH_SCNL_J)-SCH__L, - 1 LDAT,STHJ(STH_SCNP_J)+I*STHJ(STH_SCNL_J)+ - 1 SCH__L)) THEN !WRITE DATA - CALL WNCTXT(F_TP,'Error writing scan !UJ',I) - GOTO 30 !NEXT SET - END IF - END IF -C -C WRITE BACK THE SCAN HEADER (If required): -C - IF (WRSCH) THEN - IF (.NOT.NSCSCW(FCAIN,STH,IFRT,I,0,0,SCH)) THEN - CALL WNCTXT(F_TP,'Error writing scan header !UJ',I) - GOTO 30 - END IF - END IF -C -C ADD THE NEWLY PUT DATA-FLAGS TO THE ACCUMULATOR-BUFFER: -C - JS = NFLCNT ('ACC','DATA',FLACC,MASK,IFRA,CHCUR,HACUR) -C -C NEXT SCAN -C - END IF !SELHA - END DO !NEXT SCAN -C -C**************************************************************************** -C**************************************************************************** -C -C NEXT SECTOR (if any): -C - 30 CONTINUE - END DO !NEXT SECTOR -C -C************************************************************************** -C************************************************************************** -C END OF (OR ESCAPE FROM) OPERATION: -C - 700 CONTINUE -C -C Display a summary of flags, if required: -C - SHOW_CNT = .TRUE. !Temporary - IF (SHOW_CNT) THEN - JS = NFLCNT ('SHOW','FTYP',0,SELFLAG,0,0,0) - CALL WNCTXT (F_T,'NB: Tested and counted are ONLY' - 1 //' those flags that were PUT to the data/headers') - CALL WNCTXT (F_T,'by the last operation.' - 1 //' Use INSPECT for a closer look.') - CALL WNCTXT (F_T,' ') - END IF -C - GOTO 800 !BACK TO OPS_FLIST -C -C************************************************************************** -C************************************************************************** -C READY -C - 800 CONTINUE - RETURN !BACK TO FLAG_OPTION - END -C -C -C%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -C%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -C%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -C%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -C -C Pieces of controversial code, kept stored here pending a discussion -C with CMV about the precise meaning of PUTting ifr-type entries, -C i.e. if TYPIFR = .TRUE. -C -C Calculation of IFRMIN,IFRMAX: -C -C RTW1 = MOD(FLFI(FLF_IFR_I,1),256) !WEST TEL -C RTW2 = MOD(FLFI(FLF_IFR_I,2),256) !WEST TEL -C RTE1 = FLFI(FLF_IFR_I,1)/256 !EAST TEL -C RTE2 = FLFI(FLF_IFR_I,2)/256 !EAST TEL -C RTWMIN = MIN(RTW1,RTW2)+JPUTR(0,3) -C RTWMAX = MAX(RTW1,RTW2)+JPUTR(1,3) -C RTEMIN = RTE1+JPUTR(0,3) -C RTEMAX = RTE2+JPUTR(1,3) -C IFRMIN = STHJ(STH_NIFR_J)-1 ! -C IFRMAX = 0 ! -C DO I1 = 0,STHJ(STH_NIFR_J)-1 -C RTW = IFRA(0,I1) !WEST TEL -C RTE = IFRA(1,I1) !EAST TEL -C IF (RTW.GE.RTWMIN .AND. -C 1 RTW.LE.RTWMAX .AND. -C 1 RTE.GE.RTEMIN .AND. -C 1 RTE.LE.RTEMAX) THEN -C IFRMIN = MIN(IFRMIN,I1) !MIN IFR NR -C IFRMAX = MAX(IFRMAX,I1) !MAX IFR NR -C END IF -C END DO -C -C----------------------------------------------------------------------------- -C inside ifr-loop (I1) -C RTW = IFRA(0,I1) !WEST TEL -C RTE = IFRA(1,I1) !EAST TEL -C IF (RTW.GE.RTWMIN .AND. -C 1 RTW.LE.RTWMAX .AND. -C 1 RTE.GE.RTEMIN .AND. -C 1 RTE.LE.RTEMAX) MODFD=.TRUE. -C -C----------------------------------------------------------------------------- -C Old PUT-RANGE code, kept in case we would want to revive it (unlikely). -C -C Get put-range (JPUTR), in NPUTR dimensions. -C Succession of dimension-indices: chan(1), HA(2), ifr(3), pol(4) -C -CC IF (.NOT.WNDPAR('PUT_RANGE',PUTR,LEN(PUTR(1))*NPUTR, -CC 1 J0,'.,.,.,.')) GOTO 700 !ESCAPE -CC IF (J0.EQ.0) GOTO 700 !EMPTY STRING: ESCAPE -CC IF (J0.LT.0) THEN !WILDCARD (*): PUT ALL -CC DO I=1,NPUTR -CC PUTR(I)='.' !PUT-RANGE IS 1 ?? -C NB: This use is inconsistent with the usual meaning of the wildcard (*)!!! -CC END DO -CC END IF -C -CC DO I=1,NPUTR -CC IF (PUTR(I).EQ.'.') THEN -CC JPUTR(0,I)=0 -CC JPUTR(1,I)=0 -CC ELSE IF (PUTR(I).EQ.'*') THEN -CC JPUTR(0,I)=-MXRANG -CC JPUTR(1,I)=+MXRANG -CC ELSE -CC I1=0 !POINTER -CC J=WNCAJ(PUTR(I),LEN(PUTR(I)),I1) !GET VALUE -CC IF (J.LE.0) THEN -CC JPUTR(0,I)=0 -CC JPUTR(1,I)=-1 -CC ELSE IF (PUTR(I)(I1+1:).EQ.' ' .OR. -CC 1 PUTR(I)(I1+1:I1+1).EQ.'C' .OR. -CC 1 PUTR(I)(I1+1:I1+1).EQ.'c') THEN -CC JPUTR(0,I)=-(J/2) -CC JPUTR(1,I)=(J-1)/2 -CC ELSE IF (PUTR(I)(I1+1:I1+1).EQ.'L' .OR. -CC 1 PUTR(I)(I1+1:I1+1).EQ.'l') THEN -CC JPUTR(0,I)=-J+1 -CC JPUTR(1,I)=0 -CC ELSE IF (PUTR(I)(I1+1:I1+1).EQ.'R' .OR. -CC 1 PUTR(I)(I1+1:I1+1).EQ.'r') THEN -CC JPUTR(0,I)=0 -CC JPUTR(1,I)=J-1 -CC ELSE -CC CALL WNCTXT(F_TP,'PUT_RANGE format error: !AS', -CC 1 PUTR(I)) -CC GOTO 700 -CC END IF -CC END IF -C -C------------------------------------------------------------------------ - diff --git a/src/nscan/nflst0.for b/src/nscan/nflst0.for deleted file mode 100644 index f7ad7cb3f99a47ba1ab3c5b7bd13c64a57d244c0..0000000000000000000000000000000000000000 --- a/src/nscan/nflst0.for +++ /dev/null @@ -1,241 +0,0 @@ -C+ NFLST0.FOR -C JEN940418 -C -C Revisions: - -CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC -C - SUBROUTINE NFLST0 (ACTION,NAME,NVAL,IVAL,RVAL) -C -C Store legend information for display of statistics: -C -C Result: -C -C CALL NFLST0 (ACTION_C(*):I,NAME_C(*):I, -C NVAL_J:I,IVAL(*)_J:I,RVAL(*)_R:I) -C -C CALL NFLST0 ('INIT',' ',0,0,0) -C -C CALL NFLST0 ('SET','IFRTABLE',nifrtable,ifra,0.) -C CALL NFLST0 ('SET','BASEL',nifr,0,basel) -C CALL NFLST0 ('SET','DIPOS',nifr,0,ang) -C CALL NFLST0 ('ADD','HACIR',1,0,HACIR) -C CALL NFLST0 ('ADD','HADEG',1,0,HACIR) -C CALL NFLST0 ('ADD','CHAN',1,ICHAN,0) -C -C CALL NFLST0 ('SECTOR',<g.o.f.c.s>,0,0,0) -C -C CALL NFLST0 ('GET','IFRTABLE',nifrtable,ifrtable,0.) -C CALL NFLST0 ('GET','BASEL',nifr,0,basel) -C CALL NFLST0 ('GET','DIPOS',nifr?,0,ang) -C CALL NFLST0 ('GET','HARANGE',2,0,HADEG) !min,max -C CALL NFLST0 ('GET','CHRANGE',2,ICHAN,0) !min,max -C -C CALL NFLST0 ('SHOW','RANGES',ncslin,0,0) ! show HA-range etc -C NB: The printed strings is enclosed in hashes (#). -C NB: ncslin indicates the position of the closing hash (#). -C -C PIN references: -C -C Include files: -C - INCLUDE 'WNG_DEF' - INCLUDE 'NFL_DEF' - INCLUDE 'CBITS_DEF' - INCLUDE 'STH_O_DEF' !SET HEADER -C -C Parameters: -C - INTEGER XX,XY,YX,YY !POL. POINTERS - PARAMETER (XX=0, XY=1, YX=2, YY=3) -C - INTEGER IHAMIN,IHAMAX !HA-BIN NRS (1 degr wide) - PARAMETER (IHAMIN=-180, IHAMAX=180) -C - INTEGER ICHMIN,ICHMAX !CHANNEL NRS - PARAMETER (ICHMIN=0, ICHMAX=256) - - CHARACTER*79 SEPAR !Separator string (see SHOW) - PARAMETER (SEPAR= - 1 '########################################'// - 1 '#######################################') -C -C Arguments: -C - CHARACTER ACTION*(*) !ACTION TO BE PERFORMED - CHARACTER NAME*(*) !CLOSER SPECIFICATION OF ACTION - INTEGER NVAL !NR OF VALUES IN IVAL,RVAL - INTEGER IVAL(*) !INPUT VALUE(S) - REAL RVAL(*) !INPUT VALUE(S) - CHARACTER*80 ARGSTR -C -C Function references: -C -C Data declarations: -C - CHARACTER*2 POLNAME(0:3) !POL NAMES (XX, XY ETC) - DATA POLNAME /'XX','XY','YX','YY'/ ! -C - CHARACTER*1 TELNAME(0:STHTEL-1) !TEL NAMES (0,1,2,A, ETC) - DATA TELNAME /'0','1','2','3','4','5','6', - 1 '7','8','9','A','B','C','D'/ -C -C Variables: -C - INTEGER N - LOGICAL SELPOL(-1:3) !POL SELECTION (SHOW) - CHARACTER*80 TXT80 !GENERAL TEXT BUFFER -C - INTEGER IFRTABLE(2*STHIFR) !IFR TABLE - INTEGER NIFRTABLE !NR OF INTEGERES IN IFRTABLE - INTEGER NBASEL !NR OF REALS IN BASEL - REAL BASEL(STHIFR) !BASELINE LENGTHS (M) - INTEGER NANG !NR OF REALS IN ANG - REAL ANG(STHIFR) !DIPOLE POSITION ANGLES (?) - REAL HARAN(0:1) !HA-RANGE OF TESTED SCANS - INTEGER CHRAN(0:1) !CHANNEL-RANGE OF TESTED SECTORS -C -C Common: -C - COMMON /NFLST0COMMON/ NIFRTABLE,IFRTABLE, - 1 NBASEL,BASEL, - 1 NANG,ANG, - 1 HARAN,CHRAN -C- -C****************************************************************************** -C - IF (ACTION(:4).EQ.'INIT') THEN - NIFRTABLE = 0 - NBASEL = 0 - NANG = 0 - HARAN(0) = +181 !DEGR - HARAN(1) = -181 - CHRAN(0) = ICHMAX+1 - CHRAN(1) = ICHMIN-1 -C -C****************************************************************************** -C - ELSE IF (ACTION(:3).EQ.'SET') THEN -C - IF (NAME(:4).EQ.'IFRT') THEN - IF (NVAL.LE.0.OR.NVAL.GT.2*STHIFR) THEN - ARGSTR='NFLST0 SET: ' - 1 //' NVAL out of range: !UJ (!UJ) '//NAME - CALL WNCTXT (F_TP,ARGSTR,,NVAL,2*STHIFR) - ELSE - DO I=1,NVAL - IFRTABLE(I) = IVAL(I) !SAVE IN COMMON - END DO - NIFRTABLE = NVAL - END IF -C - ELSE IF (NAME(:5).EQ.'BASEL') THEN - DO I=1,NVAL - BASEL(I) = RVAL(I) - END DO - NBASEL = NVAL -C - ELSE IF (NAME(:5).EQ.'DIPOS') THEN - DO I=1,NVAL - ANG(I) = RVAL(I) - END DO - NANG = NVAL -C - ELSE - ARGSTR='NFLST0 ('//ACTION(:3)//'):'//' Name not recognised: '//NAME - CALL WNCTXT (F_TP,ARGSTR) - END IF -C -C****************************************************************************** -C - ELSE IF (ACTION(:3).EQ.'ADD') THEN -C - IF (NAME(:5).EQ.'HADEG') THEN - HARAN(0) = MIN(HARAN(0),RVAL(1)) !HA-RANGE (DEGR) - HARAN(1) = MAX(HARAN(1),RVAL(1)) !HA-RANGE -C - ELSE IF (NAME(:5).EQ.'HACIR') THEN - HARAN(0) = MIN(HARAN(0),RVAL(1)*360) !HA-RANGE (DEGR) - HARAN(1) = MAX(HARAN(1),RVAL(1)*360) !HA-RANGE -C - ELSE IF (NAME(:4).EQ.'CHAN') THEN - CHRAN(0) = MIN(CHRAN(0),IVAL(1)) !CHAN-RANGE (NR) - CHRAN(1) = MAX(CHRAN(1),IVAL(1)) !CHAN-RANGE -C - ELSE - ARGSTR='NFLST0 ('//ACTION(:3)//'):'//' Name not recognised: '//NAME - CALL WNCTXT (F_TP,ARGSTR) - END IF -C -C****************************************************************************** -C - ELSE IF (ACTION(:6).EQ.'SECTOR') THEN -C -C****************************************************************************** -C - ELSE IF (ACTION(:3).EQ.'GET') THEN -C - IF (NAME(:4).EQ.'IFRT') THEN - IF (NVAL.LE.0.OR.NIFRTABLE.NE.NVAL) THEN - ARGSTR='NFLST0 GET: ' - 1 //' NVAL out of range: !UJ (!UJ) '//NAME - CALL WNCTXT (F_TP,ARGSTR,NVAL,NIFRTABLE) - ELSE - DO I=1,NIFRTABLE - IVAL(I) = IFRTABLE(I) ! - END DO - END IF -C - ELSE IF (NAME(:5).EQ.'BASEL') THEN - DO I=1,NBASEL - RVAL(I) = BASEL(I) - END DO -C - ELSE IF (NAME(:5).EQ.'DIPOS') THEN - DO I=1,NANG - RVAL(I) = ANG(I) - END DO -C - ELSE - ARGSTR='NFLST0 ('//ACTION(:3)//'):'// - 1 ' Name not recognised: '//NAME - CALL WNCTXT (F_TP,ARGSTR) - END IF -C -C****************************************************************************** -C - ELSE IF (ACTION(:4).EQ.'SHOW') THEN -C - IF (NAME(:5).EQ.'RANGE') THEN - CALL WNCTXT (F_TP,'!AS' - 1 //' HA-range= !F6.2:!F6.2 degr ' - 1 //' channels= !UJ:!UJ ' - 1 //' !#C!AS' - 1 ,'#',HARAN(0),HARAN(1),CHRAN(0),CHRAN(1) - 1 ,NVAL,'#') -C - ELSE - ARGSTR='NFLST0 ('//ACTION(:3)//'):'// - 1 ' Name not recognised: '//NAME - CALL WNCTXT (F_TP,ARGSTR) - END IF -C -C****************************************************************************** -C - ELSE - CALL WNCTXT (F_TP,'NFLST0 Action '//ACTION(:3) - 1 //': not recognised') - END IF !ACTION -C -C****************************************************************************** -C - 900 CONTINUE - RETURN - END - - - - - - - diff --git a/src/nscan/nflst1.for b/src/nscan/nflst1.for deleted file mode 100644 index 3713f4124dec7c3e8db0df36295505d441634244..0000000000000000000000000000000000000000 --- a/src/nscan/nflst1.for +++ /dev/null @@ -1,990 +0,0 @@ -C+ NFLST1.FOR -C JEN 930922 -C -C Revisions: -C CMV 940517 Define DWARF symbols MEAN,RMS etc -C HjV 940728 Use real values (0.) in MAX functions -C CMV 940926 Re-installed above two changes -C JPH 951017 Put RMS behind RMSxx -C CMV 960122 More explanation in header of GROUPS option -C -C------------------------------------------------------------------------ -C PLEASE INDICATE **ALL** CHANGES MADE TO A FILE IN THE REVISION HISTORY -C------------------------------------------------------------------------ -C -CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC -C - REAL FUNCTION NFLST1 (ACTION,NAME,TEXTIO,NVALS,VAL,WGT) -C -C Deal with statistics (of arrays) for NFLAG (but can be used more -C generally too). -C A general program to deal with accumulating and making available -C statistics of values (it unburdens the source code a bit). -C -C Result: -C -C NFLST1_R:O = NFLST1 (ACTION_C(*):I, NAME_C(*):I,TEXTIO_C(*):IO, -C NVALS_J:IO,VAL_R(1:*):IO,WGT_R(1:*):IO) -C -C The statistics are ACCumulated for named `groups' of NVALS `slots' each. -C (NB: The internal name for NVALS is NVAL) -C Each slot consists of a small number (7) of accumulation buffers, -C in which wtot, sum, sum of squares, minval, maxval etc are accumulated. -C -C CALL NFLST1 ('INIT',' ',' ',0,0.,0.) de-assign all groups -C NB: This is compulsory at the beginning of the program. -C CALL NFLST1 ('DEL', name,' ',0,0.,0.) de-assign named group -C CALL NFLST1 ('DEASS', name,' ',0,0.,0.) de-assign named group -C -C CALL NFLST1 ('ASSIGN',name,'UNIT=..',nslots,0.,0.) new group (nslots) -C NB: A group of slots will be assigned automatically if necessary. -C -C CALL NFLST1 ('RESET',name,' ',0,0.,0.) reset accumulator slots to 0 -C NB: A group of slots will be assigned automatically if necessary. -C CALL NFLST1 ('RESET','#ALLGROUPS',' ',0,0.,0.) reset all groups -C -C The action 'ACC' accumulates given values into the relevant slots: -C If a group with the specified 'name' does not exist yet, a new group -C of nval slots will be assigned automatically. -C If nval=nslots, the values given in the arrays val(nval) and wgt(nval) -C will be accumulated separately into the nval slots of the -C specified group. -C If nslots=1 and nval>1, the given values will all be accumulated -C into the one slot of the specified group. -C If nval<0, only one given value (val(1),wgt(1)) will be accumulated -C in the specified slot nr abs(nval) of the group. -C -C CALL NFLST1 ('ACC', name,' ',nvals,val,wgt) accumulate value(s) -C -C The action 'CALC' (calculate) returns statistical results: -C If nval=1, only the overall result of all slots of the group -C will be returned in scalar values (e.g. mean and wtot), -C and as the function value. -C If nval<0, only the result of the ABS(nval)th slot of group -C will be returned in scalar values (e.g. mean and wtot). -C If nval=nslots, the individual results the slots of the group -C will be returned in arrays (e.g. mean(nval), wtot(nval)), -C and the overall result as the function value. -C -C mean = NFLST1 ('CALC',name,'MEAN' ,nval,mean,wtot) return mean -C rms = NFLST1 ('CALC',name,'RMS' ,nval,rms,wtot) rms -C rmsms = NFLST1 ('CALC',name,'RMSMS' ,nval,rmsms,wtot) rmsms -C rmsms = NFLST1 ('CALC',name,'RMSVAR',nval,rmsms,wtot) rmsvar -C dcoff = NFLST1 ('CALC',name,'DCOFF' ,nval,rmsms,wtot) dc offset -C minval = NFLST1 ('CALC',name,'MIN' ,nval,minval,wtot) miniumum -C maxval = NFLST1 ('CALC',name,'MAX' ,nval,maxval,wtot) maximum -C -C CALL NFLST1 ('APPRAISE',name,textout,ival,0,wtot) return appraisal -C NB: Appraisal-text, e.g. smooth, or flat, or spike(s) etc -C CALL NFLST1 ('EXPLAIN','RMSVAR',textout,0,0,0) explain RMSVAR etc -C -C CALL NFLST1 ('SET',name,'UNIT=textin',0,0,0) set `unit'-text - -C CALL NFLST1 ('GET',' ','NGROUPS',ngroups,0,0) get nr of defined group -C CALL NFLST1 ('GET',' ','FREESL',nfree,0,0) get nr of free slots -C CALL NFLST1 ('GET',' ','FREEGR',nfree,0,0) get nr of free groups -C CALL NFLST1 ('GET',name,'LENGTH',nslots,0,0) get nr of slots of group -C CALL NFLST1 ('GET',name,'FIRST',slot1,0,0) get first slot of group -C CALL NFLST1 ('GET',name,'LAST',slot2,0,0) get last slot of group -C CALL NFLST1 ('GET_UNIT,name,textout,0,0,0) get unit-text of group -C CALL NFLST1 ('GET',textout,'NAME',igroup,0,0) get name of group (igroup) -C CALL NFLST1 ('GET','#ISLOT',' ',islot,maxval,wtot) (for instance) -C NB: Directly addressing slots by slot nr is dangerous, -C because slots are moved (compacted) when a group is deleted. -C -C The action 'SHOW' displays statistical results in a standard way. -C Each call produces a single result (mean,rms,min,max etc), on one line. -C If nval=1, the overall result over all slots of the group is shown. -C Otherwise, the result of the ABS(nval)th slot of group is shown. -C NB: The possibility nval<0 is included for consistency with -C the use of nval in the actions ACC and CALC (see above). -C -C CALL NFLST1 ('SHOW',name,textin,ival,0.,0.) print result of named group -C CALL NFLST1 ('SHOW','#GROUPDEFS',' ',0,0.,0.) print group definitions -C CALL NFLST1 ('SHOW','#HEADER',' ',0,0.,0.) print header line -C CALL NFLST1 ('SHOW','#SEPAR',' ',0,0.,0.) print separator line (####) -C CALL NFLST1 ('SHOW','#TEXT',textin,0.,0.) print text line -C CALL NFLST1 ('SHOW','#SINGLES',' ',0,0.,0.) results of 1-slot groups -C -C -C NB: If the first character of the argument `name' is a hash (#), it has -C special meaning for the program. -C -C PIN references: -C -C Include files: -C - INCLUDE 'WNG_DEF' -C -C Parameters: -C - INTEGER MXNGRP !Max nr of accumulation `groups' - PARAMETER (MXNGRP=100) - INTEGER NCSNAM !NR OF CHARCTERS PER GRP-NAME - PARAMETER (NCSNAM=12) - INTEGER NCSTXT !NR OF CHARCTERS PER GRP `UNIT' TXT - PARAMETER (NCSTXT=10) -C - INTEGER MXNSLOT !total nr of slots in accu array - PARAMETER (MXNSLOT=MXNGRP*40) !Average nr of slots per group -C - INTEGER MXNSTPAR !# of statistics pars per `slot' - PARAMETER (MXNSTPAR=7) - INTEGER AC_WSUM,AC_WSS,AC_WTOT,AC_MIN,AC_MAX - INTEGER AC_LAST,AC_WSSV - PARAMETER (AC_WSUM=1,AC_WSS=2) - PARAMETER (AC_WTOT=3,AC_MIN=4, AC_MAX=5) - PARAMETER (AC_LAST=6,AC_WSSV=7) -C -C Codes for the statistics pars accumulated per slot: -C AC_WSUM = Weighted sum -C AC_WSS = Weighted square sum -C AC_WTOT = Total number of samples -C AC_MIN = Minimum value -C AC_MAX = Maximum value -C AC_LAST = Last value (for comparison) -C AC_WSSV = Weighted sum square variation; i.e. (val-lastval)**2 -C - INTEGER CALC_MEAN,CALC_RMS,CALC_RMSMS - INTEGER CALC_MIN,CALC_MAX,CALC_WTOT - INTEGER CALC_RMSVAR,CALC_DCOFF - PARAMETER (CALC_MEAN=1, CALC_RMS=2, CALC_RMSMS=3) - PARAMETER (CALC_MIN=4, CALC_MAX=5, CALC_WTOT=6) - PARAMETER (CALC_RMSVAR=7, CALC_DCOFF=8) -C - CHARACTER*(NCSNAM) C_UNDEF,C_UNDEF_UNIT - PARAMETER (C_UNDEF='<undefined>') - PARAMETER (C_UNDEF_UNIT=' <unit>') - INTEGER J_UNDEF - PARAMETER (J_UNDEF=-9798) - REAL R_UNDEF - PARAMETER (R_UNDEF=-9876.12345) -C - REAL VERYLARGE - PARAMETER (VERYLARGE=1.E38) -C - INTEGER NCSLIN !NR OF CHARS PER LINE - PARAMETER (NCSLIN=79) - CHARACTER*79 SEPAR - PARAMETER (SEPAR= - 1 '########################################'// - 1 '#######################################' ) -C -C Arguments: -C - CHARACTER*(*) ACTION !ACTION TO BE PERFORMED - CHARACTER*(*) NAME !FURTHER SPECIFICATION - CHARACTER*(*) TEXTIO !I/O TEXT STRING - INTEGER NVALS !NR OF INPUT/OUTPUT VALUES - REAL VAL(*) !INPUT/OUTPUT VALUE(S) - REAL WGT(*) !INPUT/OUTPUT WEIGHT(S) -C -C Data declarations: -C - CHARACTER*80 TXT80 !TEXT BUFFER - CHARACTER*10 DWARFBUF !BUFFER FOR WNDPAR - CHARACTER*(NCSNAM) ACT,NAM !LOCAL BUFFERS - CHARACTER*(NCSNAM) GRPNAME(0:MXNGRP) !NAMES OF ACCUM. GRPS - CHARACTER*(NCSTXT) UNITXT(0:MXNGRP) !'UNIT' OF ACCUMULATED QTY - INTEGER NONBLANK !NON-BLANK PART OF GRPNAME -C - INTEGER NVAL !local version of NVALS - REAL WEIGHT,VALIN,WVALIN !AUX VARIABLES - REAL MEAN,MEANSQ,RMS,RMSMS,WTOT,MINVAL,MAXVAL !STATISTICS RESULTS - REAL MSVAR,RMSVAR !IDEM - REAL OV_MEAN,OV_MEANSQ,OV_WTOT,OV_MINVAL,OV_MAXVAL !OVERALL VALUES - REAL OV_MSVAR !IDEM -C - INTEGER CALC !CALC-CODE - INTEGER IVAL,IVAL1,IVAL2 !VALUE NR -C - INTEGER DOGRP(0:MXNGRP) !GROUPS TO BE DONE - INTEGER IDOGRP,NDOGRP - INTEGER IGRP !GROUP NR - INTEGER IGRPFREE !NEXT FREE GROUP -C - INTEGER ISLOT,ISLOT1,ISLOT2,NSLOTS !SLOT NRS - INTEGER ISLOT12(2,0:MXNGRP) !START/STOP SLOTNRS PER GRP - INTEGER ISLOTFREE !NEXT FREE SLOT IN ACCU -C - REAL ACCU (MXNSTPAR,0:MXNSLOT) !LARGE ACCUMULATOR ARRAY -C - LOGICAL INITIALISE,INITIALISED ! - LOGICAL RECOGNISED !TRUE IF NAME RECOGNISED - LOGICAL NEWGROUP !ASSIGN A NEW GROUP - LOGICAL RESET !RESET SLOT(S) - LOGICAL SHOW_GROUPS !Show defined groups (trace) - INTEGER ITRACE !TRACE SWITCH (0-4) - LOGICAL SELECTED - CHARACTER*80 ARGSTR -C -C Common: -C - COMMON /NFLST1COMMON/ INITIALISED, - 1 ISLOT12,ISLOTFREE, - 1 GRPNAME,IGRPFREE,UNITXT, - 1 ACCU -C- -C****************************************************************************** -C****************************************************************************** -C - ITRACE = 0 !TRACE SWITCH (0=NONE) - SHOW_GROUPS = .FALSE. -C -C Init: -C - NFLST1 = 0 !FUNCTION VALUE - ACT = ACTION !TRANSFER TO LOCAL BUFFER - NVAL = NVALS !transfer to local variable - CALL WNCAUC(ACT) !Convert to upper-case - NEWGROUP = .FALSE. !IF TRUE, CREATE NEW GROUP - INITIALISE = .NOT.INITIALISED !INITIALISE AT LEAST ONCE - RESET = .FALSE. !IF TRUE: RESET SLOT(S) -C -C Check NAME-FIELD: -C - NAM = NAME !TRANSFER TO LOCAL BUFFER - CALL WNCAUC(NAM) !Convert to upper-case - NDOGRP = 0 !NR OF GROUPS TO BE DONE - RECOGNISED = .FALSE. !NAME NOT YET RECOGNISED -C - IF (NAM(:1).EQ.'#') THEN !SPECIAL NAME - IF (NAM(:6).EQ.'#ISLOT') THEN !SLOT NR SPECIFIED EXPLOBICITLY - RECOGNISED = .TRUE. - ISLOT1 = NVAL !INPUT VALUE - ISLOT2 = NVAL !INPUT VALUE -C - ELSE IF (NAM(:6).EQ.'#ALLGR') THEN !DO ALL DEFINED GROUPS - RECOGNISED = .TRUE. - DO IGRP=1,MXNGRP - IF (GRPNAME(IGRP).NE.C_UNDEF) THEN - NDOGRP = NDOGRP + 1 - DOGRP(NDOGRP) = IGRP - END IF - END DO -C - ELSE IF (NAM(:7).EQ.'#SINGLE') THEN !ALL SINGLE-SLOT GROUPS - RECOGNISED = .TRUE. - NVAL = 1 !local version of NVALS - DO IGRP=1,MXNGRP - IF (GRPNAME(IGRP).NE.C_UNDEF) THEN - NSLOTS = ISLOT12(2,IGRP)-ISLOT12(1,IGRP)+1 - IF (NSLOTS.EQ.1) THEN - NDOGRP = NDOGRP + 1 - DOGRP(NDOGRP) = IGRP - END IF - END IF - END DO -C - ELSE IF (NAM(:2).EQ.'##') THEN !ALL GROUPS WITH ##SUB-STRING - RECOGNISED = .TRUE. - NAM = NAM(3:) !STRIP OFF ## - NONBLANK = 0 - DO I=1,NCSNAM - IF (NAM(I:I).NE.' ') NONBLANK = I !NR OF NON-BLANK CHARS - END DO - DO IGRP=1,MXNGRP - IF (INDEX(GRPNAME(IGRP),NAM(:NONBLANK)).GT.0) THEN - NDOGRP = NDOGRP + 1 - DOGRP(NDOGRP) = IGRP - END IF - END DO -C - ELSE IF (NAM(:6).EQ.'#ISLOT') THEN !SLOT NR ADDRESSED DIRECTLY - CALL WNCTXT (F_TP,'NFLST1: #ISLOT not implemented') - GOTO 900 -C - ELSE - CONTINUE !........? - END IF -C - ELSE - DO IGRP = 1,MXNGRP - IF (GRPNAME(IGRP).EQ.NAM) THEN !INPUT NAME FOUND IN GROUP LIST - RECOGNISED = .TRUE. - NDOGRP = 1 - DOGRP(NDOGRP) = IGRP - GOTO 10 !OK, ESCAPE - END IF - END DO - 10 CONTINUE - END IF -C -C Take appropratie action if name is not recognised: -C - IF (.NOT.RECOGNISED) THEN !NAME NOT RECOGNISED - IF (ACT(:3).EQ.'ACC') THEN - NEWGROUP = .TRUE. !ASSIGN A NEW GROUP - ELSE IF (ACT(:3).EQ.'ASS') THEN - NEWGROUP = .TRUE. !ASSIGN A NEW GROUP - ELSE IF (ACT(:4).EQ.'INIT') THEN !INITIALISE ALL GRPS - INITIALISE = .TRUE. - ELSE - CONTINUE !........? - END IF -C -C or if name is recognised: -C - ELSE !NAME RECOGNISED - IF (ACT(:5).EQ.'RESET') THEN - RESET = .TRUE. - ELSE - CONTINUE !........? - END IF - END IF !(RECOGNISED) -C -C Initialise, if necessary: -C - IF (INITIALISE) THEN - DO IGRP=1,MXNGRP - GRPNAME(IGRP) = C_UNDEF !GRP DE-ASSIGNED - UNITXT(IGRP) = C_UNDEF_UNIT !UNIT OF ACCUM. QTY - ISLOT12(1,IGRP) = 0 !FIRST SLOT - ISLOT12(2,IGRP) = 0 !LAST SLOT - END DO - ISLOTFREE = 1 !FIRST FREE SLOT - IGRPFREE = 1 !FIRST FREE GROUP - INITIALISED = .TRUE. - IF (ITRACE.GT.3) THEN !TRACING - CALL WNCTXT (F_TP,'NFLST1 (!UJ): '//ACT(:3) - 1 //' [!UJ] initialised ' - 1 //NAM,ITRACE,NVAL) - SHOW_GROUPS = .TRUE. - END IF - END IF -C -C Assign a new group (if required): -C - IF (NEWGROUP) THEN - IF (NVAL.LE.0) THEN - CALL WNCTXT (F_TP,'NFLST1 (newgroup): '//ACT(:3) - 1 //' Invalid NVAL=!SJ for !AS',NVAL,NAME) - ELSE IF (IGRPFREE.GE.MXNGRP) THEN !GROUP TABLE FULL - CALL WNCTXT (F_TP,'NFLST1 (newgroup): '//ACT(:3) - 1 //' Group table full (!UJ,!UJ), name=!AS' - 1 ,IGRPFREE,MXNGRP,NAME) - ELSE IF (ISLOTFREE+NVAL-1.GT.MXNSLOT) THEN !NOT ENOUGH SLOTS LEFT - CALL WNCTXT (F_TP,'NFLST1 (newgroup): '//ACT(:3) - 1 //' !UJ+!UJ>!UJ: max slots exceeded, !AS' - 1 ,ISLOTFREE-1,NVAL,MXNSLOT,NAME) - ELSE - IGRP = IGRPFREE !NEXT FREE GROUP NR - GRPNAME(IGRP) = NAME !ASSIGN NAME TO GROUP - UNITXT(IGRP) = C_UNDEF_UNIT - I = INDEX(TEXTIO,'UNIT=') !Search for optional = - IF (I.GT.0) UNITXT(IGRP) = TEXTIO(I+5:) !Unit text given - ISLOT12(1,IGRP) = ISLOTFREE !FIRST SLOT IN ACCU - ISLOT12(2,IGRP) = ISLOT12(1,IGRP)+NVAL-1 !LAST SLOT IN ACCU - IGRPFREE = IGRPFREE + 1 ! - ISLOTFREE = ISLOT12(2,IGRP)+1 !NEXT FREE SLOT - NDOGRP = NDOGRP+1 - DOGRP(NDOGRP) = IGRP - RESET = .TRUE. !RESET SLOTS - IF (ITRACE.GT.3) THEN !TRACING - ISLOT1 = ISLOT12(1,IGRP) !FIRST SLOT IN GROUP - ISLOT2 = ISLOT12(2,IGRP) !LAST SLOT IN GROUP - CALL WNCTXT (F_TP,'NFLST1 (!UJ): '//ACT(:3) - 1 //' [!UJ] new group: !UJ, slot nrs !UJ-!UJ ' - 1 //NAM,ITRACE,NVAL,IGRP,ISLOT1,ISLOT2) - IF (ITRACE.GT.4) SHOW_GROUPS = .TRUE. - END IF - END IF - END IF -C -C Reset slots to initial values, if required: -C - IF (RESET) THEN - DO IDOGRP=1,NDOGRP - IGRP = DOGRP(IDOGRP) !GROUP NR - ISLOT1 = ISLOT12(1,IGRP) !FIRST SLOT - ISLOT2 = ISLOT12(2,IGRP) !LAST SLOT - NSLOTS = ISLOT2-ISLOT1+1 !NR OF SLOTS - DO ISLOT=ISLOT1,ISLOT2 !ALL VALUES - DO I=1,MXNSTPAR - ACCU(I,ISLOT) = 0 !RESET TO ZERO - END DO - ACCU(AC_MIN,ISLOT) = VERYLARGE !RESET - ACCU(AC_MAX,ISLOT) = -VERYLARGE !RESET - END DO - IF (ITRACE.GT.3) THEN !TRACING - CALL WNCTXT (F_TP,'NFLST1 (!UJ): '//ACT(:3) - 1 //' [!UJ] reset group: !UJ, slot nrs !UJ-!UJ ' - 1 //NAM,ITRACE,NVAL,IGRP,ISLOT1,ISLOT2) - END IF - END DO - END IF -C -C Default settings (saves code lower down): -C - IF (NDOGRP.GT.0) THEN - IDOGRP = NDOGRP !LAST GROUP - IGRP = DOGRP(IDOGRP) !GROUP NR - ISLOT1 = ISLOT12(1,IGRP) !FIRST SLOT - ISLOT2 = ISLOT12(2,IGRP) !LAST SLOT - NSLOTS = ISLOT2-ISLOT1+1 !NR OF SLOTS - END IF -C -C****************************************************************************** -C****************************************************************************** -C****************************************************************************** -C****************************************************************************** -C -!*** ACCumulate the given value(s) (VAL), with the given weight(s) (WGT): -C - IF (ACT(:3).EQ.'ACC') THEN -C - DO IDOGRP=1,NDOGRP - IGRP = DOGRP(IDOGRP) !GROUP NR - ISLOT1 = ISLOT12(1,IGRP) !FIRST SLOT - ISLOT2 = ISLOT12(2,IGRP) !LAST SLOT - NSLOTS = ISLOT2-ISLOT1+1 !NR OF SLOTS - IVAL1 = 1 !FIRST I/O VALUE - IVAL2 = NVAL !LAST I/O VALUE - IF ((NVAL.GT.0).AND.(NVAL.EQ.NSLOTS)) THEN !ALL SLOTS OF GROUP - IVAL1 = 1 ! - IVAL2 = 1 + NSLOTS - 1 - ELSE IF ((NVAL.LT.0).AND.(ABS(NVAL).LE.NSLOTS)) THEN - ISLOT1 = ISLOT1 + ABS(NVAL) - 1 !SPECIFIED SLOT NR ONLY - ISLOT2 = ISLOT1 - ELSE IF ((NSLOTS.EQ.1).AND.(NVAL.GT.NSLOTS)) THEN - IVAL1 = 1 ! - IVAL2 = NVAL !ALL INTO ONE SLOT - ELSE - CALL WNCTXT (F_TP,'NFLST1: '//ACT(:3) - 1 //' acc: inadmissible nval=!SJ ' - 1 //' (nslots=!UJ) ' - 1 //NAM - 1 ,NVAL,NSLOTS) - GOTO 900 - END IF -C - I = 0 !COUNTER - DO IVAL=IVAL1,IVAL2 !INPUT VALUE(S) - IF (WGT(IVAL).GT.0.) THEN !VALID INPUT VALUE - ISLOT=MIN(ISLOT1+IVAL-1,ISLOT2) !SLOT NR - WEIGHT = WGT(IVAL) - VALIN = VAL(IVAL) - WVALIN = WEIGHT*VALIN - ACCU(AC_MIN,ISLOT) = - 1 MIN(ACCU(AC_MIN,ISLOT),VALIN) !MINIMUM VALUE - ACCU(AC_MAX,ISLOT) = - 1 MAX(ACCU(AC_MAX,ISLOT),VALIN) !MAXIMUM VALUE - ACCU(AC_WSUM,ISLOT) = - 1 ACCU(AC_WSUM,ISLOT) + WVALIN !WEIGHTED SUM - ACCU(AC_WSS,ISLOT) = - 1 ACCU(AC_WSS,ISLOT) + WVALIN*VALIN !WGT SUM SQU - IF (ACCU(AC_WTOT,ISLOT).GT.0) THEN !EXCLUDE FIRST TIME - ACCU(AC_WSSV,ISLOT) = ACCU(AC_WSSV,ISLOT) + - 1 WEIGHT*((VALIN-ACCU(AC_LAST,ISLOT))**2) !VARIATION - END IF - ACCU(AC_WTOT,ISLOT) = - 1 ACCU(AC_WTOT,ISLOT) + WEIGHT !TOTAL WEIGHT - ACCU(AC_LAST,ISLOT) = VALIN !KEEP LAST VALUE -C - I = I+1 !INCREMENT COUNTER - IF (ITRACE.GT.1) THEN !TRACING - CALL WNCTXT (F_TP,'NFLST1 (!UJ): '//ACT(:3) - 1 //' [!UJ] acc: slot !4$UJ (!4$UJ) wgt=!8$F8.2 ' - 1 //NAM,IGRP,NVAL,ISLOT,IVAL,WGT(IVAL)) - END IF - END IF - END DO !NEXT IVAL -C - IF (ITRACE.EQ.1) THEN !TRACING - CALL WNCTXT (F_TP,'NFLST1 (!UJ): '//ACT(:3) - 1 //' [!UJ] acc: slot nrs !UJ-!UJ ' - 1 //' (nonzero=!UJ) ' - 1 //NAM,ITRACE,NVAL,ISLOT1,ISLOT2,I) - END IF -C - END DO !NEXT IDOGRP -C -C INITialise: Release (de-assign) all GRPs -C - ELSE IF (ACT(:4).EQ.'INIT') THEN !INITIALISE ALL GRPS - CONTINUE !DONE ALREADY -C -!*** DELete (de-assign) an existing GRP: -C - ELSE IF (ACT(:3).EQ.'DEL') THEN - IGRP = DOGRP(NDOGRP) - NSLOTS = ISLOT12(2,IGRP)-ISLOT12(1,IGRP)+1 !NR OF DEASS. SLOTS - DO IGRP = DOGRP(NDOGRP),IGRPFREE-1 !GROUPS TO BE MOVED - ISLOT1 = ISLOT12(1,IGRP) - ISLOT2 = ISLOT12(2,IGRP) - DO ISLOT = ISLOT1,ISLOT2 !SLOT NR - I1 = ISLOT-NSLOTS !DESTINATION SLOT NR - DO I=1,MXNSTPAR ! - ACCU(I,I1) = ACCU(I,ISLOT) !MOVE SLOT CONTENTS - END DO - END DO - ISLOT12(1,IGRP-1) = ISLOT1-NSLOTS !MOVE GROUP DOWN - ISLOT12(2,IGRP-1) = ISLOT2-NSLOTS !MOVE GROUP DOWN - GRPNAME(IGRP-1) = GRPNAME(IGRP) !MOVE GROUP DOWN - UNITXT(IGRP-1) = UNITXT(IGRP) !MOVE GROUP DOWN - END DO - IGRPFREE = IGRPFREE - 1 !FIRST FREE GROUP - GRPNAME(IGRPFREE) = C_UNDEF - UNITXT(IGRPFREE) = C_UNDEF_UNIT - ISLOT12(1,IGRPFREE) = 0 ! - ISLOT12(2,IGRPFREE) = 0 ! - ISLOTFREE = ISLOTFREE - NSLOTS !FIRST FREE SLOT -C - IF (ITRACE.GT.3) THEN !TRACING - CALL WNCTXT (F_TP,'NFLST1 (!UJ): '//ACT(:3) - 1 //' [!UJ] delete group: ' - 1 //NAM,ITRACE,NVAL) - IF (ITRACE.GT.4) SHOW_GROUPS = .TRUE. - END IF -C -!*** RESET the accumulator buffer(s) of a specified GRP to initial values: -C - ELSE IF (ACT(:5).EQ.'RESET') THEN - CONTINUE !DONE ABOVE ALREADY -C -!*** ASSIGN: Assign an accumulator GRP with the givem name: -C - ELSE IF (ACT(:3).EQ.'ASS') THEN - CONTINUE !DONE ABOVE ALREADY -C -C*************************************************************************** -C GET some specified quantities: -C - ELSE IF (ACT(:3).EQ.'GET') THEN -C - IF (TEXTIO(:4).EQ.'LENG') THEN - NVALS = NSLOTS !Return nr of slots -C - ELSE IF (TEXTIO(:5).EQ.'FIRST') THEN - NVALS = ISLOT1 !Return first slot nr -C - ELSE IF (TEXTIO(:4).EQ.'LAST') THEN - NVALS = ISLOT2 !Return last slot nr -C - ELSE IF (TEXTIO(:4).EQ.'NGRO') THEN - NVALS = IGRPFREE-1 !Return nr of defined grps -C - ELSE IF (TEXTIO(:6).EQ.'FREEGR') THEN - NVALS = MXNGRP - IGRPFREE + 1 !Return nr of free groups -C - ELSE IF (TEXTIO(:6).EQ.'FREESL') THEN - NVALS = MXNSLOT - ISLOTFREE + 1 !Return nr of free slots -C - ELSE IF (TEXTIO(:4).EQ.'NAME') THEN - IGRP = NVAL !Input group nr - IF (IGRP.GT.0.AND.IGRP.LT.IGRPFREE) THEN - NAME = GRPNAME(IGRP) !Return group name (NAME) - ELSE - CALL WNCTXT (F_TP,'NFLST1: (GET NAME): ' - 1 //' IGRP=!UJ, out of range',IGRP) - END IF -C - ELSE IF (ACT(:8).EQ.'GET_UNIT') THEN - IGRP = DOGRP(NDOGRP) - TEXTIO = UNITXT(IGRP) !Retrun unit-text -C - ELSE - ARGSTR='NFLST1 ('//ACT(:3)//'): '//' not recognised '//TEXTIO - CALL WNCTXT (F_TP,ARGSTR) - GOTO 900 - END IF -C -C*************************************************************************** -!*** SET some values: -C - ELSE IF (ACT(:3).EQ.'SET') THEN !....... - I = INDEX(TEXTIO,'UNIT=') - IF (I.GT.0) THEN - DO IDOGRP=1,NDOGRP - IGRP = DOGRP(IDOGRP) - UNITXT(IGRP) = TEXTIO(I+5:) !`UNIT' OF GRP QTY - END DO - END IF -C -C****************************************************************************** -C -C****************************************************************************** -!return statistical result(s): -C - ELSE IF (ACT(:7).EQ.'EXPLAIN') THEN - IF (NAM(:4).EQ.'MEAN') THEN - CALL WNCTXS (TXT80,' mean: average value') - ELSEIF (NAM(:5).EQ.'RMSMS') THEN - CALL WNCTXS (TXT80,' rmsms: rms w.r.t. the mean') - ELSEIF (NAM(:6).EQ.'RMSVAR') THEN - CALL WNCTXS (TXT80,' rmsvar: rms variation ' - 1 //' (of successive values)') - ELSEIF (NAM(:3).EQ.'RMS') THEN - CALL WNCTXS (TXT80,' rms: rms value') - ELSEIF (NAM(:5).EQ.'DCOFF') THEN - CALL WNCTXS (TXT80,' dcoff: dc offset indicator' - 1 //' (=mean/max(rmsms,rmsvar))') - ELSEIF (NAM(:3).EQ.'MIN') THEN - CALL WNCTXS (TXT80,' min: minimum value') - ELSEIF (NAM(:3).EQ.'MAX') THEN - CALL WNCTXS (TXT80,' max: maximum value') - ELSEIF (NAM(:4).EQ.'WTOT') THEN - CALL WNCTXS (TXT80,' wtot: total weight ' - 1 //' (often: nr of values)') - ELSE - ARGSTR='Explain: name not recognised '//NAME - CALL WNCTXT (F_TP,ARGSTR) - GOTO 900 - END IF -C - CALL WNCTXT (F_TP,'# !AS !#C!AS',TXT80,NCSLIN,'#') - CALL WNCTXS (TEXTIO,'# !AS !#C!AS',TXT80,NCSLIN,'#') -C -C************************************************************************* -C CALCULATE STATISTICAL QUANTITIES: -C - ELSE IF (ACT(:4).EQ.'CALC') THEN - IF (NDOGRP.EQ.1) THEN - IGRP = DOGRP(NDOGRP) !GROUP NR - ISLOT1 = ISLOT12(1,IGRP) !FIRST SLOT - ISLOT2 = ISLOT12(2,IGRP) !LAST SLOT - NSLOTS = ISLOT2-ISLOT1+1 !NR OF SLOTS - IF (NVAL.EQ.1) THEN !OVER ALL SLOTS OF GROUP - IVAL1 = 1 ! - IVAL2 = 1 !SINGLE OUTPUT VALUE - ELSE IF (NVAL.EQ.NSLOTS) THEN !INDIVIDUALLY, ARRAYS - IVAL1 = 1 - IVAL2 = NVAL !OUTPUT ARRAY - ELSE IF ((NVAL.LT.0).AND.(ABS(NVAL).LE.NSLOTS)) THEN ! - ISLOT1 = ISLOT1 + ABS(NVAL)-1 !SPECIFIC SLOT OF GROUP - ISLOT2 = ISLOT1 - IVAL1 = 1 - IVAL2 = 1 !SINGLE OUTPUT VALUE - ELSE - CALL WNCTXT (F_TP,'NFLST1 (!UJ): '//ACT(:3) - 1 //' acc: inadmissible nval=!SJ ' - 1 //' (nslots=!UJ) ' - 1 //NAM,NVAL,NSLOTS) - GOTO 900 !........? - END IF - ELSE - ARGSTR='NFLST1 ('//ACT(:3)//'): '//' NDOGRP<>1 '//TEXTIO - CALL WNCTXT (F_TP,ARGSTR) - GOTO 900 !........!! - END IF -C - CALC = 0 - IF (TEXTIO(:4).EQ.'MEAN') CALC = CALC_MEAN - IF (TEXTIO(:3).EQ.'RMS') CALC = CALC_RMS - IF (TEXTIO(:5).EQ.'RMSMS') CALC = CALC_RMSMS - IF (TEXTIO(:6).EQ.'RMSVAR') CALC = CALC_RMSVAR - IF (TEXTIO(:3).EQ.'MIN') CALC = CALC_MIN - IF (TEXTIO(:3).EQ.'MAX') CALC = CALC_MAX - IF (TEXTIO(:5).EQ.'DCOFF') CALC = CALC_DCOFF - IF (TEXTIO(:4).EQ.'WTOT') CALC = CALC_WTOT - IF (CALC.EQ.0) THEN - ARGSTR='NFLST1 ('//ACT(:3)//'): ' //' not recognised '//TEXTIO - CALL WNCTXT (F_TP,ARGSTR) - GOTO 900 - END IF -C - OV_MEAN = 0 !OVERALL MEAN - OV_WTOT = 0 !OVERALL WTOT - OV_MEANSQ = 0 - OV_MSVAR = 0 - OV_MINVAL = VERYLARGE - OV_MAXVAL = -VERYLARGE -C - DO ISLOT=ISLOT1,ISLOT2 !SLOT NRS - WTOT = ACCU(AC_WTOT,ISLOT) - I = MIN(ISLOT-ISLOT1+1,IVAL2) !I/O ADDRESS IN VAL/WGT - WGT(I) = WTOT !return total weight - VAL(I) = 0 !default value (?) - IF (WTOT.GT.0) THEN !wtot>0 - MEAN = ACCU(AC_WSUM,ISLOT)/WTOT !mean - MEANSQ = ACCU(AC_WSS,ISLOT)/WTOT !mean square - RMS = SQRT(MAX(0.,MEANSQ)) !rms - RMSMS = SQRT(MAX(0.,MEANSQ-MEAN**2)) !rmsms - MSVAR = ACCU(AC_WSSV,ISLOT)/WTOT !mean square variation - RMSVAR = SQRT(MAX(0.,MSVAR)) !rms variation - MINVAL = ACCU(AC_MIN,ISLOT) !maximum value - MAXVAL = ACCU(AC_MAX,ISLOT) !maximum value - IF (CALC.EQ.CALC_MEAN) THEN - VAL(I) = MEAN !return mean - ELSE IF (CALC.EQ.CALC_RMS) THEN - VAL(I) = RMS !return rms - ELSE IF (CALC.EQ.CALC_RMSMS) THEN - VAL(I) = RMSMS !return rmsms - ELSE IF (CALC.EQ.CALC_RMSVAR) THEN - VAL(I) = RMSVAR !return rmsvar - ELSE IF (CALC.EQ.CALC_MIN) THEN - VAL(I) = MINVAL !return minval - ELSE IF (CALC.EQ.CALC_MAX) THEN - VAL(I) = MAXVAL !return maxval - ELSE IF (CALC.EQ.CALC_WTOT) THEN - VAL(I) = WTOT !return wtot - ELSE IF (CALC.EQ.CALC_DCOFF) THEN - R0 = MAX(RMSVAR,RMSMS) - IF (R0.GT.0) VAL(I) = 100*(MEAN/R0) !`dc offset' indicator - IF (R0.LE.0) WGT(I) = -1 !something wrong..... - END IF - OV_MINVAL = MIN(OV_MINVAL,MINVAL) !overall - OV_MAXVAL = MAX(OV_MAXVAL,MAXVAL) !overall - OV_WTOT = OV_WTOT + WTOT !overall wtot - OV_MEAN = OV_MEAN + MEAN*WTOT !overall - OV_MEANSQ = OV_MEANSQ + MEANSQ*WTOT !overall - OV_MSVAR = OV_MSVAR + MSVAR*WTOT !overall - END IF - END DO -C - NFLST1 = OV_WTOT !Function value (?) - WTOT = OV_WTOT - IF (WTOT.GT.0) THEN - MEAN = OV_MEAN/WTOT - MEANSQ = OV_MEANSQ/WTOT - RMSMS = SQRT(MAX(0.,MEANSQ-MEAN**2)) - RMS = SQRT(MAX(0.,MEANSQ)) - MSVAR = OV_MSVAR/WTOT - RMSVAR = SQRT(MAX(0.,MSVAR)) - MINVAL = OV_MINVAL - MAXVAL = OV_MAXVAL - IF (CALC.EQ.CALC_MEAN) THEN - NFLST1 = MEAN !return mean - DWARFBUF='MEAN' - ELSE IF (CALC.EQ.CALC_RMS) THEN - NFLST1 = RMS !return rms - DWARFBUF='RMS' - ELSE IF (CALC.EQ.CALC_RMSMS) THEN - NFLST1 = RMSMS !return rmsms - DWARFBUF='RMSMS' - ELSE IF (CALC.EQ.CALC_RMSVAR) THEN - NFLST1 = RMSVAR !return rmsvar - DWARFBUF='RMSVAR' - ELSE IF (CALC.EQ.CALC_MIN) THEN - NFLST1 = MINVAL !return minval - DWARFBUF='MINVAL' - ELSE IF (CALC.EQ.CALC_MAX) THEN - NFLST1 = MAXVAL !return maxval - DWARFBUF='MAXVAL' - ELSE IF (CALC.EQ.CALC_WTOT) THEN - NFLST1 = WTOT !return wtot - DWARFBUF='WTOT' - ELSE IF (CALC.EQ.CALC_DCOFF) THEN - R0 = MAX(RMSVAR,RMSMS) - IF (R0.GT.0) NFLST1 = 100*(MEAN/R0) !`dc offset' indicator - IF (R0.LE.0) NFLST1 = -1 !something wrong..... - DWARFBUF='DCOFF' - END IF - CALL WNCTXS(TXT80,'!E',NFLST1) !and save as symbol - CALL WNDPAG(DWARFBUF,TXT80) - CALL WNCTXT(F_T, - 1 'You may use !AS in respons to prompts '// - 1 '(e.g. CLIPLEVEL=3*!AS)',DWARFBUF,DWARFBUF) - END IF - IF (IVAL2.EQ.1) THEN - VAL(1) = NFLST1 ! single output value - WGT(1) = WTOT ! single output value - END IF -C -C Appraise the nature of the statistics and put it in a string: -C - ELSE IF (ACT(:7).EQ.'APPRAIS') THEN - DO ISLOT=ISLOT1,ISLOT2 !SLOT NRS - WTOT = ACCU(AC_WTOT,ISLOT) - IF (WTOT.GT.0) THEN !wtot>0 - MEAN = ACCU(AC_WSUM,ISLOT)/WTOT !mean - MEANSQ = ACCU(AC_WSS,ISLOT)/WTOT !mean square - RMSMS = SQRT(MAX(0.,MEANSQ-MEAN**2)) !rmsms - MSVAR = ACCU(AC_WSSV,ISLOT)/WTOT !mean square variation - RMSVAR = SQRT(MAX(0.,MSVAR)) !rms variation - MINVAL = ACCU(AC_MIN,ISLOT) !maximum value - MAXVAL = ACCU(AC_MAX,ISLOT) !maximum value - OV_MINVAL = MIN(OV_MINVAL,MINVAL) !overall - OV_MAXVAL = MAX(OV_MAXVAL,MAXVAL) !overall - OV_WTOT = OV_WTOT + WTOT !overall wtot - OV_MEAN = OV_MEAN + MEAN*WTOT !overall - OV_MEANSQ = OV_MEANSQ + MEANSQ*WTOT !overall - OV_MSVAR = OV_MSVAR + MSVAR*WTOT !overall - END IF - END DO - NFLST1 = OV_WTOT !Function value - TEXTIO = ' ' !appraisal text - IF (OV_WTOT.GT.0) THEN - MEAN = OV_MEAN/OV_WTOT - MEANSQ = OV_MEANSQ/OV_WTOT - RMSMS = SQRT(MAX(0.,OV_MEANSQ-OV_MEAN**2)) - RMS = SQRT(MAX(0.,OV_MEANSQ)) - MSVAR = OV_MSVAR/OV_WTOT - RMSVAR = SQRT(MAX(0.,OV_MSVAR/OV_WTOT)) - MINVAL = OV_MINVAL - MAXVAL = OV_MAXVAL - ELSE - TEXTIO = ' wtot=0' - END IF -C -C****************************************************************************** -C****************************************************************************** -C SHOW -C - ELSE IF (ACT(:4).EQ.'SHOW') THEN - J1 = 7 !NR OF CHARS PER FIELD - J2 = 14 !START CHAR IN TXT80 - J3 = J2+7*J1 + 2 !START CHAR IN TXT80 -C -C--------------------------------------------------------------------------- - IF (NAM(:1).EQ.'#') THEN !SPECIAL NAME-STRING -C - IF (NAM(:7).EQ.'#GROUPS') THEN - CALL WNCTXT(F_TP,'Statistical data is collected '// - 1 'into so-called accumulation groups') - CALL WNCTXT(F_TP,'This option gives a list of the '// - 1 'currently defined accumulation groups') - CALL WNCTXT(F_TP,'It is mainly useful for '// - 1 'debugging purposes.') - CALL WNCTXT (F_TP, - 1 ' Defined accumulation groups: ' - 1 //' (max groups=!UJ, max slots=!UJ) ' - 1 ,MXNGRP,MXNSLOT) - DO IGRP=1,MXNGRP - IF (GRPNAME(IGRP).NE.C_UNDEF) THEN - ISLOT1 = ISLOT12(1,IGRP) - ISLOT2 = ISLOT12(2,IGRP) - NSLOTS = ISLOT2-ISLOT1+1 - I=0 - DO ISLOT=ISLOT1,ISLOT2 - IF (ACCU(AC_WTOT,ISLOT).GT.0) I=I+1 !ACTIVE SLOTS - END DO - CALL WNCTXT (F_TP,' group !2$UJ:' - 1 //' !4$UJ slots (!4$UJ-!4$UJ) ' - 1 //' acc=!4$UJ name='//GRPNAME(IGRP) - 1 //' '//UNITXT(IGRP) - 1 ,IGRP,NSLOTS,ISLOT1,ISLOT2,I) - END IF - END DO - GOTO 900 -C - ELSE IF (NAM(:4).EQ.'#HEA') THEN !PRINT HEADER STRING - TXT80 = '# <name>' - TXT80(J2+0*J1:) = ' wtot' - TXT80(J2+1*J1:) = ' mean' - TXT80(J2+2*J1:) = ' rms' - TXT80(J2+3*J1:) = ' rmsms' - TXT80(J2+4*J1:) = ' rmsvar' - TXT80(J2+5*J1:) = ' minval' - TXT80(J2+6*J1:) = ' maxval' - TXT80(J3:) = C_UNDEF_UNIT - TXT80(NCSLIN:) = '#' !CLOSING HASH (#) - CALL WNCTXT (F_TP,'!AS',TXT80) !PRINT LINE - GOTO 900 !ESCAPE -C - ELSE IF (NAM(:4).EQ.'#SEP') THEN !PRINT SEPARATOR - CALL WNCTXT (F_TP,'!AS',SEPAR) !SEPARATOR - GOTO 900 !ESCAPE -C - ELSE IF (NAM(:5).EQ.'#TEXT') THEN !PRINT GIVEN TEXT LINE - CALL WNCTXS (TXT80,'# !AS: ',TEXTIO) ! - TXT80(NCSLIN:) = '#' !CLOSING HASH (#) - CALL WNCTXT (F_TP,'!AS',TXT80) !PRINT LINE - GOTO 900 !ESCAPE -C - ELSE - GOTO 900 !ERROR, ESCAPE - END IF -C - END IF -C------------------------------------------------------------------------ -C - DO IDOGRP = 1,NDOGRP !Groups to be done - IGRP = DOGRP(IDOGRP) !Group nr - ISLOT1 = ISLOT12(1,IGRP) - ISLOT2 = ISLOT12(2,IGRP) - NSLOTS = ISLOT12(2,IGRP)-ISLOT12(1,IGRP)+1 -C - CALL WNCTXS (TXT80,'# !AS: ',GRPNAME(IGRP)) - IF (NVAL.EQ.1) THEN !Show overall values - CONTINUE - ELSE IF ((NVAL.NE.0).AND.(ABS(NVAL).LE.NSLOTS)) THEN !single slot - ISLOT1 = ISLOT1 + ABS(NVAL) - 1 !Specified slot nr - ISLOT2 = ISLOT1 - ELSE - CALL WNCTXT (F_TP,'NFLST1 (SHOW): ' - 1 //'NVAL=!SJ, out of range: !AS ' - 1 ,NVAL,GRPNAME(IGRP)) - GOTO 900 - END IF -C - WTOT = 0 - MEAN = 0 - MEANSQ = 0 - MSVAR = 0 - MINVAL = VERYLARGE - MAXVAL = -VERYLARGE - DO ISLOT=ISLOT1,ISLOT2 !All specified slots - IF (ACCU(AC_WTOT,ISLOT).GT.0) THEN !wtot>0 - WTOT = WTOT + ACCU(AC_WTOT,ISLOT) !wtot - MEAN = MEAN + ACCU(AC_WSUM,ISLOT) !mean - MEANSQ = MEANSQ + ACCU(AC_WSS,ISLOT) !mean square - MINVAL = MIN(MINVAL,ACCU(AC_MIN,ISLOT)) !minimum value - MAXVAL = MAX(MAXVAL,ACCU(AC_MAX,ISLOT)) !maximum value - MSVAR = MSVAR + ACCU(AC_WSSV,ISLOT) !mean sq variation - END IF - END DO !ISLOT - IF (WTOT.GT.0) THEN - MEAN = MEAN/WTOT !mean - MEANSQ = MEANSQ/WTOT !mean square - MSVAR = MSVAR/WTOT !mean sq variation - RMSMS = SQRT(MAX(0.,MEANSQ-MEAN**2)) !rmsms - RMS = SQRT(MAX(0.,MEANSQ)) !rms - RMSVAR = SQRT(MAX(0.,MSVAR)) !rms variation - CALL WNCTXS (TXT80(J2+0*J1:),'!#$F#.0',J1,J1,WTOT) - CALL WNCTXS (TXT80(J2+1*J1:),'!#$F#.0',J1,J1,MEAN) - CALL WNCTXS (TXT80(J2+2*J1:),'!#$F#.0',J1,J1,RMS) - CALL WNCTXS (TXT80(J2+3*J1:),'!#$F#.0',J1,J1,RMSMS) - CALL WNCTXS (TXT80(J2+4*J1:),'!#$F#.0',J1,J1,RMSVAR) - CALL WNCTXS (TXT80(J2+5*J1:),'!#$F#.0',J1,J1,MINVAL) - CALL WNCTXS (TXT80(J2+6*J1:),'!#$F#.0',J1,J1,MAXVAL) - CALL WNCTXS (TXT80(J3+1:),UNITXT(IGRP)) !`unit' text - ELSE - CALL WNCTXS (TXT80(J2+0*J1:), - 1 ' No values accumulated (wtot=0)') - END IF - TXT80(NCSLIN:) = '#' !CLOSING HASH (#) - CALL WNCTXT (F_TP,'!AS',TXT80) !PRINT LINE - END DO !IGRP -C -C**************************************************************************** -C - ELSE ! - ARGSTR='NFLST1: '//' Action not recognised: '//ACTION - CALL WNCTXT (F_TP,ARGSTR) - GOTO 900 !EXIT - END IF !OF ACTIONS -C -C**************************************************************************** - 900 CONTINUE -C - IF (SHOW_GROUPS) THEN - CALL WNCTXT (F_TP,'NFLST1 (defined groups): ' - 1 //' IGRPFREE=!UJ ISLOTFREE=!UJ' - 1 ,IGRPFREE,ISLOTFREE) - DO IGRP=1,MXNGRP - IF (GRPNAME(IGRP).NE.C_UNDEF) THEN - ISLOT1 = ISLOT12(1,IGRP) - ISLOT2 = ISLOT12(2,IGRP) - CALL WNCTXT (F_TP,' !2$UJ: slots !4$UJ-!4$UJ ' - 1 //GRPNAME(IGRP)//' '//UNITXT(IGRP) - 1 ,IGRP,ISLOT1,ISLOT2) - END IF - END DO - CALL WNCTXT (F_TP,' ') - END IF -C - RETURN - END - - - - - - - - - - - - diff --git a/src/nscan/nflst3.for b/src/nscan/nflst3.for deleted file mode 100644 index 79f3527f92974f013f7c63f5c4114ca260b288ad..0000000000000000000000000000000000000000 --- a/src/nscan/nflst3.for +++ /dev/null @@ -1,415 +0,0 @@ -C+ NFLST3.FOR -C JEN940419 -C -C Revisions: - -CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC -C - SUBROUTINE NFLST3 (ACTION,NAME,OPTIONAL) -C -C Display statistics of accumulation group etc: -C -C Result: -C -C CALL NFLST3 (ACTION_C(*):I,NAME_C(*):I,OPTIONAL_C(*):I) -C -C CALL NFLST3 ('GROUP',<groupname>,' ') -C CALL NFLST3 ('LISTS',<polarisations>,' ') -C CALL NFLST3 ('DCOFF',<polarisations>,' ') -C -C PIN references: -C -C Include files: -C - INCLUDE 'WNG_DEF' - INCLUDE 'NFL_DEF' - INCLUDE 'CBITS_DEF' - INCLUDE 'STH_O_DEF' -C -C Parameters: -C - INTEGER MAXQ !MAX NR OF PRINTED FIELDS - PARAMETER (MAXQ=20) - - INTEGER XX,XY,YX,YY !POL. POINTERS - PARAMETER (XX=0, XY=1, YX=2, YY=3) -C - INTEGER NCSLIN !Nr of chars per line - PARAMETER (NCSLIN=79) - CHARACTER*79 SEPAR !Separator string (see SHOW) - PARAMETER (SEPAR= - 1 '########################################'// - 1 '#######################################') -C -C Arguments: -C - CHARACTER ACTION*(*) !ACTION TO BE PERFORMED - CHARACTER NAME*(*) !CLOSER SPECIFICATION OF ACTION - CHARACTER OPTIONAL*(*) !CLOSER SPECIFICATION OF ACTION - CHARACTER*80 ARGSTR -C -C Function references: -C - REAL NFLST1 !STATISTICS ACCUM -C -C Data declarations: -C - CHARACTER*2 POLNAME(0:3) !POL NAMES (XX, XY ETC) - DATA POLNAME /'XX','XY','YX','YY'/ ! -C - CHARACTER*1 TELNAME(0:STHTEL-1) !TEL NAMES (0,1,2,A, ETC) - DATA TELNAME /'0','1','2','3','4','5','6', - 1 '7','8','9','A','B','C','D'/ -C -C Variables: -C - INTEGER N,NW0 - INTEGER IPR,NPR !HEADER REPEAT COUNTER - INTEGER IVAL,NVAL ! - INTEGER RTW,RTE !WEST,EAST TELESCOPE NR - REAL MEAN,RMS,RMSVAR,RMSMS,MINVAL,MAXVAL,WTOT,DCOFF - LOGICAL SELPOL(-1:3) !POL SELECTION (SHOW) - LOGICAL PRINTLINE !SWITCH - LOGICAL IFRGROUP !GROUP OF IFRS -C - INTEGER IQ,NQ !NR OF STATISTICAL QTY's - CHARACTER*16 QNAM(0:20) !QTY NAMES (FOR NFLST1) - CHARACTER*16 QHED(0:20) !QTY NAMES (FOR HEADERS) - REAL QVAL(0:20) !QTY VALUES - INTEGER QPOS(0:20) !QTY start columns - INTEGER QWID(0:20) !QTY field size (chars) - INTEGER QDEC(0:20) !QTY nr of decimals - CHARACTER*24 GROUP(0:20) !GROUP NAMES (NFLST3) -C - INTEGER IFRA(0:1,0:STHIFR-1) !TELESCOPE TABLE (W,E) - REAL BASEL(0:STHIFR-1) !BASELINES (M) - INTEGER IFRSUCC(STHIFR) !IFR SUCCESSION - REAL HARAN(0:1) !HA-RANGE OF TESTED SCANS - INTEGER CHRAN(0:1) !CHANNEL-RANGE OF TESTED SECTORS -C - CHARACTER*80 TXT80 !GENERAL TEXT BUFFER - CHARACTER*80 HEADER !HEADER TEXT - CHARACTER*80 APPRAISAL !APPRAISAL TEXT (FROM NFLST1) - CHARACTER*24 WTOT_GROUP !NAME OF GROUP TO BE TESTED FOR WTOT - CHARACTER*24 APPRAISAL_GROUP !NAME OF GROUP TO BE APPRAISED - -C -C Common: -C -C- -C****************************************************************************** -C****************************************************************************** -C INITIALISE: -C - NPR = 25 !HEADER REPEAT COUNTER - IFRGROUP = .FALSE. !Assume no ifrs - DO I=1,STHIFR - IFRSUCC(I) = I !required succession of ifrs - END DO -C - NQ = 1 !7 QUANTITIES (QTY) PRINTED - QPOS(0) = 1 !DEFAULT START COLUMN - QWID(0) = 0 !DEFAULT - DO IQ=1,NQ !FOR ALL PRINTED QTY's - GROUP(IQ) = NAME !GROUP NAME FOR NFLST1 - QWID(IQ) = 12 !DEFAULT FIELD WIDTH (CHARS) - QDEC(IQ) = 4 !DEFAULT NR OF DECIMALS - END DO -C - APPRAISAL_GROUP = NAME - WTOT_GROUP = NAME -C -C****************************************************************************** -C****************************************************************************** -C CHECK ACTION: -C - IF (ACTION(:5).EQ.'GROUP') THEN - R0 = NFLST1('GET',NAME,'LENGTH',NVAL,0.,0.) !nr of slots in group - ARGSTR=ACTION(:3)//' NFLST3: NVAL=!UJ '//NAME - CALL WNCTXT (F_TP,ARGSTR,NVAL) - IF (NVAL.LE.0) THEN - ARGSTR=' NFLST3: '//ACTION(:3)//' slots = !UJ (<=0) '//NAME - CALL WNCTXT (F_TP,ARGSTR,NVAL) - GOTO 900 !escape - ELSE IF (NVAL.EQ.STHIFR) THEN - IFRGROUP = .TRUE. !ifrs - END IF -C -C------------------------------------------------------------------------ -C - ELSE IF (ACTION(:5).EQ.'DCOFF') THEN - IFRGROUP = .TRUE. !ifrs -C -C------------------------------------------------------------------------ -C - ELSE IF (ACTION(:5).EQ.'LISTS') THEN - IFRGROUP = .TRUE. !ifrs -C -C------------------------------------------------------------------------ -C - ELSE - ARGSTR=' NFLST3: Action not recognised: '//ACTION - CALL WNCTXT (F_TP,ARGSTR) - GOTO 900 !escape - END IF -C -C------------------------------------------------------------------------ -C - CALL NFLST0 ('GET','IFRTABLE',2*STHIFR,IFRA,0.) - CALL NFLST0 ('GET','BASEL',STHIFR,0,BASEL) -C -C****************************************************************************** -C****************************************************************************** -C DEFINE LAYOUT AND MAKE HEADER TEXT: -C - IF (ACTION(:5).EQ.'GROUP') THEN - CALL WNCTXT (F_TP,'!AS',SEPAR) !SEPARATOR - CALL WNCTXT (F_TP, - 1 '# Statistics of group: !AS !#C!AS' - 1 ,NAME,NCSLIN,'#') - CALL NFLST0 ('SHOW','RANGES',NCSLIN,0,0.) !HA-RANGE ETC -C - APPRAISAL_GROUP = NAME - WTOT_GROUP = NAME - DO IQ=1,MAXQ !FOR ALL PRINTED QTY's - GROUP(IQ) = NAME !GROUP NAME FOR NFLST1 - QWID(IQ) = 7 !DEFAULT FIELD WIDTH (CHARS) - QDEC(IQ) = 0 !DEFAULT NR OF DECIMALS - END DO -C - NQ = 0 - QPOS(0) = 12 !START COLUMN (1st QTY) -C - NQ = NQ+1 - QNAM(NQ) = 'WTOT' - NQ = NQ+1 - QNAM(NQ) = 'MEAN' - NQ = NQ+1 - QNAM(NQ) = 'RMS' -CCCC NQ = NQ+1 -CCCC QNAM(NQ) = 'RMSMS' - NQ = NQ+1 - QNAM(NQ) = 'RMSVAR' - NQ = NQ+1 - QNAM(NQ) = 'MINVAL' - NQ = NQ+1 - QNAM(NQ) = 'MAXVAL' - NQ = NQ+1 - QNAM(NQ) = 'DCOFF' -C - HEADER = '#' - IF (IFRGROUP) THEN - HEADER = '# ifr (m)' - END IF -C - DO IQ=1,NQ !FOR ALL QTY - QPOS(IQ) = QPOS(IQ-1) + QWID(IQ-1) !START COLUMN PER QTY - QHED(IQ) = QNAM(IQ) !QTY NAME FOR NFLST1 - CALL WNCALC (QHED(IQ)) !CONVERT TO LOWER CASE - CALL WNCTXS (HEADER(QPOS(IQ):),'!#$AS' - 1 ,QWID(IQ),QHED(IQ)) - END DO - HEADER(QPOS(NQ)+QWID(NQ)+2:) = '...' !closing text -C -C------------------------------------------------------------------------- -C - ELSE IF (ACTION(:5).EQ.'LISTS') THEN - CALL WNCTXT (F_TP,'!AS',SEPAR) !SEPARATOR - CALL WNCTXT (F_TP, - 1 '# Amplitude and Phase summary: !#C!AS' - 1 ,NCSLIN,'#') - CALL WNCTXT (F_TP, - 1 '# **** XX only (experimental) **** !#C!AS' - 1 ,NCSLIN,'#') - CALL NFLST0 ('SHOW','RANGES',NCSLIN,0,0.) !HA-RANGE ETC -C - DO IQ=1,MAXQ !FOR ALL PRINTED QTY's - GROUP(IQ) = NAME !GROUP NAME FOR NFLST1 - QWID(IQ) = 6 !DEFAULT FIELD WIDTH (CHARS) - QDEC(IQ) = 0 !DEFAULT NR OF DECIMALS - END DO -C - WTOT_GROUP = 'DAT_A_XX' - R0 = NFLST1('GET',WTOT_GROUP,'LENGTH',NVAL,0.,0.) !nr of slots/group - APPRAISAL_GROUP = 'DAT_A_XX' -C - NQ = 0 !7 QUANTITIES (QTY) PRINTED - QPOS(0) = 12 !START COLUMN (1st QTY) -C -C Ampl: -C - NQ = NQ + 1 - GROUP(NQ) = 'DAT_A_XX' - QNAM(NQ) = 'WTOT' - QHED(NQ) = 'npts' -C - NQ = NQ + 1 - QNAM(NQ) = 'RMSMS' - GROUP(NQ) = 'DAT_A_XX' - QHED(NQ) = 'rmsms' - QWID(NQ) = QWID(NQ) + 3 !HORIZONTAL SEPARATION -C - NQ = NQ + 1 - QNAM(NQ) = 'MINVAL' - GROUP(NQ) = 'DAT_A_XX' - QHED(NQ) = 'min' -C - NQ = NQ + 1 - QNAM(NQ) = 'MAXVAL' - GROUP(NQ) = 'DAT_A_XX' - QHED(NQ) = 'max' -C - NQ = NQ + 1 - QNAM(NQ) = 'RMSVAR' - GROUP(NQ) = 'DAT_A_XX' - QHED(NQ) = 'm.e.' -C -C Phase: -C - NQ = NQ + 1 - QNAM(NQ) = 'RMSMS' - GROUP(NQ) = 'DAT_P_XX' - QHED(NQ) = 'rmsms' - QWID(NQ) = QWID(NQ) + 3 !HORIZONTAL SEPARATION -C - NQ = NQ + 1 - QNAM(NQ) = 'MINVAL' - GROUP(NQ) = 'DAT_P_XX' - QHED(NQ) = 'min' -C - NQ = NQ + 1 - QNAM(NQ) = 'MAXVAL' - GROUP(NQ) = 'DAT_P_XX' - QHED(NQ) = 'max' -C - NQ = NQ + 1 - QNAM(NQ) = 'RMSVAR' - GROUP(NQ) = 'DAT_P_XX' - QHED(NQ) = 'm.e.' -C -C - HEADER = '# ifr (m)' - DO IQ=1,NQ !FOR ALL QTY - QPOS(IQ) = QPOS(IQ-1) + QWID(IQ-1) !START COLUMN PER QTY - CALL WNCTXS (HEADER(QPOS(IQ):),'!#$AS' - 1 ,QWID(IQ),QHED(IQ)) - END DO - HEADER(QPOS(NQ)+QWID(NQ)+2:) = ' ' !closing text -C - TXT80 = ' ' - TXT80(QPOS(2)+4:) = 'Amplitude (W.U)' - TXT80(QPOS(6)+4:) = 'Phase (degr)' - CALL WNCTXT (F_TP,'# !AS !#C!AS',TXT80,NCSLIN,'#') -C -C------------------------------------------------------------------------- -C - ELSE IF (ACTION(:5).EQ.'DCOFF') THEN - CALL WNCTXT (F_TP,'!AS',SEPAR) !SEPARATOR - CALL WNCTXT (F_TP, - 1 '# DC-offset: !#C!AS' - 1 ,NCSLIN,'#') - CALL NFLST0 ('SHOW','RANGES',NCSLIN,0,0.) !HA-RANGE ETC -C - DO IQ=1,MAXQ !FOR ALL PRINTED QTY's - GROUP(IQ) = NAME !GROUP NAME FOR NFLST1 - QWID(IQ) = 7 !DEFAULT FIELD WIDTH (CHARS) - QDEC(IQ) = 0 !DEFAULT NR OF DECIMALS - END DO -C - WTOT_GROUP = 'DAT_C_XX' - R0 = NFLST1('GET',WTOT_GROUP,'LENGTH',NVAL,0.,0.) !nr of slots/group - APPRAISAL_GROUP = 'DAT_C_XX' -C - NQ = 0 -C - HEADER = '#' - DO IQ=1,NQ !FOR ALL QTY - QPOS(IQ) = QPOS(IQ-1) + QWID(IQ-1) !START COLUMN PER QTY - CALL WNCTXS (HEADER(QPOS(IQ):),'!#$AS' - 1 ,QWID(IQ),QHED(IQ)) - END DO -C - HEADER(QPOS(NQ)+QWID(NQ)+2:) = '...' !closing text -C -C------------------------------------------------------------------------- -C - ELSE - END IF -C -C------------------------------------------------------------------------- -C GENERAL FINISH: -C - HEADER(NCSLIN:) = '#' !closing hash -C -C****************************************************************************** -C****************************************************************************** -C PRINT DATA ITSELF: -C - IPR = 0 !HEADER REPEAT COUNTER - NW0 = 0 - DO I=1,NVAL - IVAL = I ! - TXT80 = '#' !OPENING HASH (#) -C - IF (IFRGROUP) THEN !IFRS - IVAL = IFRSUCC(I) !ifr succession - RTW = IFRA(0,IVAL-1) !WEST TEL - RTE = IFRA(1,IVAL-1) !EAST TEL - CALL WNCTXS (TXT80, - 1 '# !AS!AS (!4$UJ): ' - 1 ,TELNAME(RTW),TELNAME(RTE) - 1 ,NINT(BASEL(IVAL-1))) - END IF -C - WTOT = 1 !Default: print - IF (WTOT_GROUP.NE.' ') THEN - WTOT = NFLST1('CALC',WTOT_GROUP,'WTOT',-IVAL,0.,0.) - END IF -C - IF (WTOT.GT.0) THEN - DO IQ=1,NQ - QVAL(IQ) = - 1 NFLST1 ('CALC',GROUP(IQ),QNAM(IQ),-IVAL,0.,0.) - CALL WNCTXS (TXT80(QPOS(IQ):),'!#$F#.#' - 1 ,QWID(IQ),QWID(IQ),QDEC(IQ),QVAL(IQ)) - END DO -C - IF (APPRAISAL_GROUP.NE.' ') THEN - R0 = NFLST1('APPRAISE',APPRAISAL_GROUP, - 1 APPRAISAL,IVAL,0.,0.) !get appraisal text - TXT80(QPOS(NQ)+QWID(NQ)+2:) = APPRAISAL !closing text - END IF -C - IF (IPR.EQ.0) CALL WNCTXT (F_TP,HEADER) !repeat header - IPR = MOD(IPR+1,NPR) !increment counter - CALL WNCTXT (F_TP,'!AS !#C!AS',TXT80,NCSLIN,'#') !print line -C - ELSE - NW0 = NW0+1 !Skipped, increment counter - END IF - END DO -C -C Finish off: -C - IF (NW0.GT.0) THEN - CALL WNCTXT (F_TP, - 1 '# Nr of empty slots (wtot=0, not shown): ' - 1 //' !UJ out of !UJ total !#C!AS' - 1 ,NW0,NVAL,NCSLIN,'#') - END IF -C - CALL WNCTXT (F_TP,'!AS',SEPAR) !SEPARATOR -C -CCC DO IQ=1,NQ -CCC R0 = NFLST1 ('EXPLAIN',QNAM(IQ),TXT80,0,0.,0.) !Explain quantities -CCC END DO -C -C****************************************************************************** -C - 900 CONTINUE -C -C****************************************************************************** - RETURN - END - - diff --git a/src/nscan/nflswi.for b/src/nscan/nflswi.for deleted file mode 100644 index 40422afbdd334048fd6269639f2078986ae4f94f..0000000000000000000000000000000000000000 --- a/src/nscan/nflswi.for +++ /dev/null @@ -1,132 +0,0 @@ -C+ NFLSWI.FOR -C JEN 940215 -C -C Revisions: -C -CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC -C - LOGICAL FUNCTION NFLSWI (ACTION,NAME,ILVAL) -C -C Routine for transfer of `flagging-mode' switches between -C sub-routines. -C -C Result: -C -C JS = NFLSWI (ACTION_C(*):I,NAME_C(*):I,ILVAL_J:IO) -C NB: ILVAL may also be a logical TRUE/FALSE ..... -C -C JS = NFLSWI ('SET','<name>',<ILVAL>) -C JS = NFLSWI ('GET','<name>',<ILVAL>) -C JS = NFLSWI ('SHOW','<name>',0) -C JS = NFLSWI ('SHOW','ALL',0) -C -C PIN references: -C -C Include files: -C - INCLUDE 'WNG_DEF' - INCLUDE 'NFL_DEF' -C -C Parameters: -C - INTEGER MAXSWI !MAX NR OF STORED SWITCHES - PARAMETER (MAXSWI=5) -C -C Arguments: -C - CHARACTER ACTION*(*) !ACTION TO BE PERFORMED - CHARACTER NAME*(*) !EXTRA INFORMATION - INTEGER ILVAL !INTEGER (or logical) I/O VALUE -C -C Function references: -C - LOGICAL WNDPAR !GET DWARF PARAMETER -C -C Data declarations: -C - INTEGER INDEX !INDEX IN STORAGE ARRAY - INTEGER SWITCH(-1:MAXSWI) !STORAGE ARRAY - CHARACTER*12 SWINAME(MAXSWI) !SWITCH NAMES -C - CHARACTER*80 TXT80 !TEXT BUFFER - CHARACTER*80 ARGSTR -C -C Commons: -C - COMMON /NFLSWITCH/ SWITCH -C- -C****************************************************************************** -C****************************************************************************** -C - NFLSWI = .TRUE. !ASSUME OK -CCCC CALL WNCTXT (F_T,'NFLSWI: '//ACTION(:5)//NAME) -C -C*************************************************************************** -C - DO INDEX=-1,MAXSWI - SWINAME(INDEX) = 'undefined' - END DO - SWINAME(1) = 'USERFLAG' - SWINAME(2) = 'CORRDAT' - SWINAME(3) = 'TRACE' - SWINAME(4) = 'SHOW_CNT' - SWINAME(5) = 'ESTIM_DFLT' -C - INDEX = 0 !STORAGE INDEX - IF (NAME(:7).EQ.'ALL') THEN - INDEX = -1 !SPECIAL INDEX - ELSE - DO I=1,MAXSWI - DO I1=LEN(NAME),5,-1 - IF (NAME(:I1).EQ.SWINAME(I)(:I1)) THEN - INDEX = I !FOUND - GOTO 10 !ESCAPE - END IF - END DO - END DO - ARGSTR='NFLSWI: '//ACTION(:5)//'Name not recognised: '//NAME - CALL WNCTXT (F_T,ARGSTR) - NFLSWI = .FALSE. - GOTO 900 !ESCAPE - END IF - 10 CONTINUE -C -C=========================================================================== -C - IF (ACTION(:3).EQ.'SET') THEN - IF (INDEX.GT.0) THEN - SWITCH(INDEX) = ILVAL - END IF - - ELSE IF (ACTION(:3).EQ.'GET') THEN - IF (INDEX.GT.0) THEN - ILVAL = SWITCH(INDEX) - END IF -C - ELSE IF (ACTION(:4).EQ.'SHOW') THEN - IF (INDEX.GT.0) THEN - I1=INDEX - I2=INDEX - ELSE IF (INDEX.EQ.-1) THEN !SHOW ALL - I1=1 - I2=MAXSWI - END IF - DO I=I1,I2 - CALL WNCTXS (TXT80,' '//SWINAME(I)//'= ' - 1 //'= !SJ ' - 1 ,SWITCH(I)) - END DO -C - ELSE - END IF -C -C=========================================================================== - 900 CONTINUE - RETURN - END - - - - - - diff --git a/src/nscan/ngen.for b/src/nscan/ngen.for deleted file mode 100644 index e646fb7b4a1f167aa53a09344d9797bea83b438f..0000000000000000000000000000000000000000 --- a/src/nscan/ngen.for +++ /dev/null @@ -1,40 +0,0 @@ -C+ NGEM.FOR -C JPH 931108 -C -C Revisions: -C HjV 931214 Change test logical functions -C - SUBROUTINE NGEN -C -C Dummy program to allow setting NGEN parameters through DWEXE /NORUN/SAVE -C -C Result: -C -C -C Include files: -C - INCLUDE 'WNG_DEF' -C -C Parameters: -C -C -C Arguments: -C -C -C Function references: -C - LOGICAL WNDINI - LOGICAL WNDDAB -C -C Data declarations: -C -C- -C -C PRELIMINARIES -C - IF (.NOT.WNDINI(PRGNAM)) CALL WNGEX !Exit if no DWARF start - CALL WNDLON(I) - IF (.NOT.WNDDAB()) CALL WNGEX !Open database - CALL WNGEX - RETURN - END diff --git a/src/nscan/ngen.pef b/src/nscan/ngen.pef deleted file mode 100644 index 99671c2480adaf9f3a574ae5dc35c249436791a8..0000000000000000000000000000000000000000 --- a/src/nscan/ngen.pef +++ /dev/null @@ -1,659 +0,0 @@ -!+ NGEN.PEF -! WNB 910828 -! -! Revisions: -! WNB 910909 Add DATAB, INFIX -! WNB 910913 Add loops and (de-)apply -! WNB 921211 Make PEF -! HjV 921221 Default for keyword LOG is now YES iso. SPOOL -! JEN 930308 LOOPS keyword moved to NSETS.PEF -! JEN 930316 Drastic improvement of all HELP texts -! WNB 930510 Add DISPLAY -! WNB 930607 Add UFLAG -! WNB 930616 Add SHFT in de-apply -! HjV 940120 Change some text -! WNB 940215 Add MEMORY -! CMV 940223 DATAB not used if set to "*" -! CMV 940224 Add MODELB -! WNB 940305 Add X_ versions of all keywords; some text change -! Remove Modify from MODELB -! JPH 940816 Use tabs and empty lines for better formmatting and to -! enable automatic merging/splitting of lines. Insert -! comment lines before KEYWORDs for same purpose. -! JPH 940906 Formatting and text improvements (but what is really -! needed is a good Document on the DWARF interface...) -! JPH 940920 Remove () from prompts -! JPH 941205 Help texts; prtompt formatting -! JPH 941212 Fix lengths for character parameters with many options -! CMV 950127 Add SHFT and MOD again -! HjV 950713 Change (DE_)APPLY so it has the same options as -! X_(DE_)APPLY -! JPH 960808 Fix APPLY OPTIONS= duplication. Add some dummy prompts. -! JPH 970125 Typo -! -! -! Get logging type -! Ref: WNDLOG -! -!! Clarify X keywords. Can they be made completely -!! invisible? -KEYWORD=X_LOG - DATA_TYP=C - IO=MODIFY - LENGTH=8 - CHECKS=ABBREV_OPTIONS - SWITCHES=NULL_VALUES,WILD_CARDS - SEARCH=L,P - OPTIONS=SPOOL,YES,NO,CATEN - DEFAULTS="# /NOASK" -! -KEYWORD=LOG - DATA_TYP=C - IO=I - LENGTH=8 - CHECKS=ABBREV_OPTIONS - SWITCHES=NULL_VALUES,WILD_CARDS - SEARCH=L,G:NGEN,P - PROMPT="log-file disposition" - OPTIONS=NO,YES, SPOOL,CATEN - DEFAULTS=YES /NOASK - HELP=" -For each run of a NEWSTAR program, logging information may be put into a -LOG-file, for subsequent inspection (and clogging up your room). LOG-files are -named with the first three letters of the program name (e.g. NCA), followed by -yymmddhhmmssA.LOG in the current working directory. E.g. NCA940305163412A.LOG -The most recent LOG-file for a program has an alias name equal to the program, -and the extension .LOG (e.g. NCALIB.LOG). -. -The LOG-file contains the values for all the parameter (keywords) that were -used for this particualr program run, including the 'hidden' ones. It will also -contain information about the program run itself, and any results. -. -Specify what to do with the logging output: - NO: Make no LOG-file (not recommended) - YES: Make a LOG-file (preferred option, no line-printer output) - SPOOL: Print the LOG-file on the printer at the end of the program run - CATEN: Add the new info to the existing LOG-file for this program -. -. -This keyword is part of NGEN, i.e. it is a NEWSTAR 'environment keyword', which -is available to all NEWSTAR programs. The switch /NOASK indicates that it is -'hidden', i.e. the user is not prompted for it, but the default value is used. -Its value may be modified (for a given $stream) in several ways: - Permanently for all programs and streams during current login: - change the default value: dws[pecify] 'NGEN$0' - Permanently for all programs in certain stream during current login: - change the default value: dws[pecify] NGEN['$stream'] - Permanently for certain program in all streams during current login: - change the default value: dws[pecify] 'program$0' - Permanently for certain program in certain stream during current login: - change the default value: dws[pecify] program['$stream'] Note: -use automatic saving in LOGOUT to pass on values beyond current login - Incidentally for a certain incarnation of program[$stream]: - run as: dwe program['$stream']/LOG=value - Incidentally for all hidden values: - run a NEWSTAR program as: dwe program['$stream']/ASK" -! -! Get RUN type -! Ref: WNDRUN -! -KEYWORD=X_RUN - DATA_TYP=L - IO=MODIFY - SWITCHES=NULL_VALUES,WILD_CARDS - SEARCH=L,P - DEFAULTS="# /NOASK" -! -KEYWORD=RUN - DATA_TYP=L - IO=MODIFY - SWITCHES=NULL_VALUES,WILD_CARDS - SEARCH=L,G:NGEN,P - PROMPT="Exectute program after parameter setup (YES/NO)?" - DEFAULTS=YES /NOASK - HELP=" -Specify the run mode of the NEWSTAR program: - YES: The NEWSTAR program will run normally - NO: The NEWSTAR program will prompt the user for all parameters -(keywords), but will then terminate. This mode should be used in conjunction -with the '/save' option, in which all the specified keyword values will be -saved in a .SAV file for later use (e.g. batch processing). -. -The /save option is invoked by starting the program in the following way: - dwe 'program'[$'stream']/save (e.g. dwe ncalib$3/save). The saved -keyword values are used by running the program again: - dwe 'program'[$'stream'] (e.g. dwe ncalib$3) -. -NB: An alternative approach is to use the '/norun' option: - dwe 'program'[$'stream']/norun (e.g. dwe ncalib'$3'/norun) -. -This keyword is part of NGEN, i.e. it is a NEWSTAR 'environment keyword', which -is available to all NEWSTAR programs. The switch /NOASK indicates that it is -'hidden', i.e. the user is not prompted for it, but the default value is used. -. -Its value may be modified (for a given $stream) in several ways: - Permanently for all programs and streams during current login: - change the default value: dws[pecify] 'NGEN$0' - Permanently for all programs in certain stream during current login: - change the default value: dws[pecify] NGEN['$stream'] - Permanently for certain program in all streams during current login: - change the default value: dws[pecify] 'program$0' - Permanently for certain program in certain stream during current login: - change the default value: dws[pecify] program['$stream'] -. -Note: use automatic saving in LOGOUT to pass on values beyond current login - Incidentally for a certain incarnation of program[$stream]: - run as: dwe program['$stream']/ASK=value - Incidentally for all hidden values: - run a NEWSTAR program as: dwe program['$stream']/ASK" -! -! Get database -! Ref: WNDDAB -! -KEYWORD=X_DATAB - DATA_TYP=C - IO=MODIFY - LENGTH=80 - SWITCHES=NULL_VALUES,WILD_CARDS - SEARCH=L,P - DEFAULTS="# /NOASK" -! -KEYWORD=DATAB - DATA_TYP=C - IO=MODIFY - LENGTH=80 - SWITCHES=NULL_VALUES,WILD_CARDS - SEARCH=L,G:NGEN,P - PROMPT="default directory name" - DEFAULTS=""" /NOASK" - HELP=" -Directory names can be very long. In order to avoid having to type them fully -each time, the user may store it in the keyword DATAB (the name has historic -roots). From then on, node names (in the same $stream) are automatically -preceded by the contents of DATAB. -. -NB: On Unix systems, the value of DATAB has to end with a slash (eg ./) -. -If you set DATAB to "*", the DATAB keyword will be ignored completely (it will -not be changed if you use a directory name in the specification of a set etc.) -. -NB: In general, however, it is recommended to keep all files of a reduction -project in a single directory. In that case, no explicit directory name will be -needed in any case, if you run from this directory. -. -Example: if node name is preceded by a directory name: - ../../wnb/wsrt/data/myproject/mynode the value of DATAB (for the -current $stream) will be: - ../../wnb/wsrt/data/myproject/ Subsequently, typing 'othernode' will -produce the node name: - ../../wnb/wsrt/data/myproject/othernode NB: IF THE NEWSTAR PROGRAM -CANNOT FIND A FILE (NODE), WHILE IT IS CLEARLY PRESENT IN THE CURRENT -DIRECTORY, CHECK THE VALUE OF DATAB!! -. -This keyword is part of NGEN, i.e. it is a NEWSTAR 'environment keyword', which -is available to all NEWSTAR programs. The switch /NOASK indicates that it is -'hidden', i.e. the user is not prompted for it, but the default value is used. -. -Its value may be modified (for a given $stream) in several ways: - Permanently for all programs and streams during current login: - change the default value: dws[pecify] 'NGEN$0' - Permanently for all programs in certain stream during current login: - change the default value: dws[pecify] NGEN['$stream'] - Permanently for certain program in all streams during current login: - change the default value: dws[pecify] 'program$0' - Permanently for certain program in certain stream during current login: - change the default value: dws[pecify] program['$stream'] -. -Note: use automatic saving in LOGOUT to pass on values beyond current login - Incidentally for a certain incarnation of program[$stream]: - run as: dwe program['$stream']/DATAB='"value"' - Incidentally for all hidden values: - run a NEWSTAR program as: dwe program['$stream']/ASK" -! -! Get directory for model-files -! Ref: WNDDAB -! -KEYWORD=X_MODELB - DATA_TYP=C - IO=MODIFY - LENGTH=80 - SWITCHES=NULL_VALUES,WILD_CARDS - SEARCH=L,P - DEFAULTS="# /NOASK" -! -KEYWORD=MODELB - DATA_TYP=C - IO=I - LENGTH=80 - SWITCHES=NULL_VALUES,WILD_CARDS - SEARCH=L,G:NGEN,P - PROMPT="default directory for model files" - DEFAULTS=""" /NOASK" - HELP=" -For calibrator sources one usually want to use a generic model, and it is good -practice to collect such models in a single directory. -. -Newstar programs look for a calibrator model first in your 'preferred' -directory, then in the directory defined by MODELB, and finally in the -directory defined by the Unix environmant variable MODELB. The latter points to -the standard WSRT calibrator models that are part of Newstar. - -NOTE: On Unix systems, the value of MODELB has to end with a slash (eg ./) -. -This keyword is part of NGEN, i.e. it is a NEWSTAR 'environment keyword', which -is available to all NEWSTAR programs. The switch /NOASK indicates that it is -'hidden', i.e. the user is not prompted for it, but the default value is used. -. -Its value may be modified (for a given $stream) in several ways: - Permanently for all programs and streams during current login: - change the default value: dws[pecify] 'NGEN$0' - Permanently for all programs in certain stream during current login: - change the default value: dws[pecify] NGEN['$stream'] - Permanently for certain program in all streams during current login: - change the default value: dws[pecify] 'program$0' - Permanently for certain program in certain stream during current login: - change the default value: dws[pecify] program['$stream'] -. -Note: use automatic saving in LOGOUT to pass on values beyond current login - Incidentally for a certain incarnation of program[$stream]: - run as: dwe program['$stream']/MODELB='"value"' - Incidentally for all hidden values: - run a NEWSTAR program as: dwe program['$stream']/ASK" -! -! Get infix -! Ref: WNDDAB -! -KEYWORD=X_INFIX - DATA_TYP=C - IO=MODIFY - LENGTH=80 - SWITCHES=NULL_VALUES,WILD_CARDS - SEARCH=L,P - DEFAULTS="# /NOASK" -! -KEYWORD=INFIX - DATA_TYP=C - IO=MODIFY - LENGTH=80 - SWITCHES=NULL_VALUES,WILD_CARDS - SEARCH=L,G:NGEN,P - DEFAULTS=""" /NOASK" - PROMPT="node name shorthand" - HELP=" -NEWSTAR file names can be very long. In order to avoid having to type them -fully each time, the user may store (part of) the node name in the keyword -INFIX. From then on, the user may specify node names in a short-hand notation -which contains a hash (#) character. The latter is automatically replaced by -the contents of INFIX, to produce the full file name. -. -Example: if part of the full node name is enclosed in brackets: - mynode.21(cm.yesterday.s.x.c.d.file.d)d the value of INFIX (for the -current $stream) will be: - cm.yesterday.s.x.c.d.file.d Subsequently, typing '92#e' will produce -the node name: - mynode.92cm.yesterday.s.x.c.d.file.de -. -This keyword is part of NGEN, i.e. it is a NEWSTAR 'environment keyword', which -is available to all NEWSTAR programs. The switch /NOASK indicates that it is -'hidden', i.e. the user is not prompted for it, but the default value is used. -. -Its value may be modified (for a given $stream) in several ways: - Permanently for all programs and streams during current login: - change the default value: dws[pecify] 'NGEN$0' - Permanently for all programs in certain stream during current login: - change the default value: dws[pecify] NGEN['$stream'] - Permanently for certain program in all streams during current login: - change the default value: dws[pecify] 'program$0' - Permanently for certain program in certain stream during current login: - change the default value: dws[pecify] program['$stream'] -. -Note: use automatic saving in LOGOUT to pass on values beyond current login - Incidentally for a certain incarnation of program[$stream]: - run as: dwe program['$stream']/INFIX=value - Incidentally for all hidden values: - run a NEWSTAR program as: dwe program['$stream']/ASK " -!! Get rid of thye whole INFIX/DATAB business? -!! Put the whole NGEN story for all parameters in a -!! document and refer to it only. -! -! Get corrections to apply -! Ref: WNDDAB -! -KEYWORD=X_APPLY - DATA_TYP=C - IO=MODIFY - LENGTH=8 - NVALUES=16 - CHECKS=ABBREV_OPTIONS - SWITCHES=NULL_VALUES,WILD_CARDS - SEARCH=L,P - DEFAULT="# /NOASK" - PROMPT="|" - OPTIONS=- - ALL;NORED,NOALG,NOOTH;NOEXT,NOREF,NOIREF,NOFAR;NOCLK,NOPOL;NOIFR,NOMIFR;|- -NONE; RED, ALG, OTH; EXT, REF, IREF, FAR; CLK, POL; IFR, MIFR| -! -KEYWORD=APPLY - DATA_TYP=C - IO=I - LENGTH=8 - NVALUES=16 - CHECKS=ABBREV_OPTIONS - SWITCHES=NULL_VALUES,WILD_CARDS - SEARCH=L,G:NGEN,P - PROMPT="Specify visibility corrections" - OPTIONS=- - ALL;NORED,NOALG,NOOTH;NOEXT,NOREF,NOIREF,NOFAR;NOCLK,NOPOL;NOIFR,NOMIFR;|- -NONE; RED, ALG, OTH; EXT, REF, IREF, FAR; CLK, POL; IFR, MIFR| - DEFAULT=* /NOASK - HELP=" -In general, the uv data in a .SCN file are not physically modified. Instead, -correction parameters are stored in the sector and scan headers of the .SCN -file, to be applied 'on-the-fly' to the visibilities as they are read into -memory to be processed. -. -You may specify here the corrections to be applied by specifying a combination -of possible options (separated by commas). The prefix 'NO' indicates that a -correction must not be applied and would most likely be used in combination of -ALL. -. - ALL or * apply all available corrections - NONE or "" apply no corrections - [NO]RED redundancy corrections (telescope gain,phase) - [NO]ALG align corrections (telescope gain,phase) - [NO]OTH other telesc. gain/phase corrns (i.e. from calibrator) - [NO]EXT extinction correction (elevation-dependent gain) - [NO]REF refraction correction (elevation-dependent phase) - [NO]IREF ionospheric refracion - [NO]CLK clock correction - [NO]POL polarisation corrections (dipole angle, ellipticity) - [NO]FAR Faraday rotation - [NO]MIFR multiplicative interferometer errors -. -NOTES: - 1. If two options are mutually exclusive, the one specified last prevails, -e.g. - NONE,CLK,POL selects only the CLK and POL corrections; - CLK,POL,NONE selects no corrections at all. -. - 2. If a certain correction is to be disabled permanently, the safest way is -to zero it in the .SCN file itself, using NCALIB option SET ZERO. -. -. -This keyword is part of NGEN, i.e. it is a NEWSTAR 'environment keyword', which -is available to all NEWSTAR programs. The switch /NOASK indicates that it is -'hidden', i.e. the user is not prompted for it, but the default value is used. -. -Its value may be modified (for a given $stream) in several ways: - Permanently for all programs and streams during current login: - change the default value: dws[pecify] 'NGEN$0 - Permanently for all programs in certain stream during current login: - change the default value: dws[pecify] NGEN['$stream'] - Permanently for certain program in all streams during current login: - change the default value: dws[pecify] 'program$0' - Permanently for certain program in certain stream during current login: - change the default value: dws[pecify] program['$stream'] -. -Note: use automatic saving in LOGOUT to pass on values beyond current login - Incidentally for a certain incarnation of program[$stream]: - run as: dwe program['$stream']/APPLY=value (or: - ='(val1,val2,...)') - Incidentally for all hidden values: - run a NEWSTAR program as: dwe program['$stream']/ASK " -! -! Get corrections to de-apply -! Ref: WNDDAB -! -KEYWORD=X_DE_APPLY - DATA_TYP=C - IO=MODIFY - LENGTH=8 - NVALUES=16 - CHECKS=ABBREV_OPTIONS - SWITCHES=NULL_VALUES,WILD_CARDS - SEARCH=L,P - DEFAULT="# /NOASK" - PROMPT="|" - OPTIONS=- - ALL; NOOTH; NOEXT,NOREF, NOIREF,NOFAR; NOCLK, NOPOL; NOIFR, NOMIFR;|- -NONE; OTH; EXT, REF, IREF, FAR; CLK, POL; IFR, MIFR;|- -SHFT, NOSHFT, MOD, NOMOD| -! -! -KEYWORD=DE_APPLY - DATA_TYP=C - IO=I - LENGTH=8 - NVALUES=16 - CHECKS=ABBREV_OPTIONS - SWITCHES=NULL_VALUES,WILD_CARDS - SEARCH=L,G:NGEN,P - DEFAULT=NONE /NOASK - PROMPT="Specify visibility de-corrections" - OPTIONS=- - ALL; NOOTH; NOEXT, NOREF, NOIREF, NOFAR; NOCLK, NOPOL; NOIFR, NOMIFR;|- -NONE; OTH; EXT, REF, IREF, FAR; CLK, POL; IFR, MIFR;|- -SHFT, NOSHFT, MOD, NOMOD| - HELP=" -In general, the visibilties in a .SCN file are not physically modified. -Instead, correction parameters are stored in the sector and scan headers of the -.SCN file, to be applied 'on-the-fly' to the visibilities as they are read into -memory to be processed. -. -It is also possible, however, to make corrections more permanent by applying -them to the visibilities as stored in the .SCN file. The pertinent correction -parameters are reset to 0 in this process and their values transferred into a -second set of correction parameters, the "applied" corrections. Thus, for each -correction parameter <xxx> there is an 'applied' counterpart A<xxx>. -. -Just like it is possible to apply corrections on-the-fly, it is also possible -to 'de-apply' the 'applied' corrections on-the-fly. You may specify here -which 'applied' corrections you want to de-apply in this way. -. -The prefix 'NO' indicates that a correction must not be applied and would most -likely be used in combination of ALL. -. - ALL or * apply all available corrections - NONE or "" apply no corrections - [NO]RED redundancy corrections (telescope gain,phase) - [NO]ALG align corrections (telescope gain,phase) - [NO]OTH other telesc. gain/phase corrns (i.e. from calibrator) - [NO]EXT extinction correction (elevation-dependent gain) - [NO]REF refraction correction (elevation-dependent phase) - [NO]IREF ionospheric refracion - [NO]CLK clock correction - [NO]POL polarisation corrections (dipole angle, ellipticity) - [NO]FAR Faraday rotation - [NO]MIFR multiplicative interferometer errors - [NO]SHFT shift of centre of observations - [NO]MOD subtract model -. -NOTES: - 1. If two options are mutually exclusive, the one specified last prevails, -e.g. - NONE,CLK,POL selects only the CLK and POL corrections; - CLK,POL,NONE selects no corrections at all. -. - 2. The only DE_APPLY correction type that is ever different from zero so far -is MODEL. This type controls the subtraction of a source model strored -internally in .SCN-file sector. -. -. -This keyword is part of NGEN, i.e. it is a NEWSTAR 'environment keyword', which -is available to all NEWSTAR programs. The switch /NOASK indicates that it is -'hidden', i.e. the user is not prompted for it, but the default value is used. -. -Its value may be modified (for a given $stream) in several ways: - Permanently for all programs and streams during current login: - change the default value: dws[pecify] 'NGEN$0' - Permanently for all programs in certain stream during current login: - change the default value: dws[pecify] NGEN['$stream'] - Permanently for certain program in all streams during current login: - change the default value: dws[pecify] 'program$0' - Permanently for certain program in certain stream during current login: - change the default value: dws[pecify] program['$stream'] -. -Note: use automatic saving in LOGOUT to pass on values beyond current login - Incidentally for a certain incarnation of program[$stream]: - run as: dwe program['$stream']/DE_AP=value (or: - '(val1,val2,...)') - Incidentally for all hidden values: - run a NEWSTAR program as: dwe program['$stream']/ASK" -! -! Get un-flag to use -! Ref: WNDDAB -! -KEYWORD=X_UFLAG - DATA_TYP=C - IO=MODIFY - LENGTH=8 - NVALUES=16 - CHECKS=ABBREV_OPTIONS - SWITCHES=NULL_VALUES,WILD_CARDS - SEARCH=L,P - DEFAULT="# /NOASK" - PROMPT="|" - OPTIONS=NONE, ALL; MAN, OLD, CLIP, NOIS, ADD, SHAD; U1, U2, U3 -! -KEYWORD=UFLAG - DATA_TYP=C - IO=I - LENGTH=8 - NVALUES=16 - CHECKS=ABBREV_OPTIONS - SWITCHES=NULL_VALUES,WILD_CARDS - SEARCH=L,G:NGEN,P - PROMPT="Specify which flags you want to ignore |" - OPTIONS=- -NONE, ALL; MAN, OLD, CLIP, NOIS, ADD, SHAD; U1, U2, U3| - DEFAULT=NONE /NOASK - HELP=" -Scan headers and data in a .SCN file can be flagged as invalid. There are 8 -different flags distinguishing 8 different types of reasons for the flagging. -Flags can be set in a variety of ways, mostly through various options in NFLAG, -or by manual flagging in NGIDS. -. -By default, data points that have any one of the 8 flags set will be discarded. -You are given here the option to ignore specific types of flag, i.e. accept -data as valid even they have flags of these types set. You may give any -combination of options, separated by commas. -. - NONE or "" ignore none of the flags, i.e. discard all flagged data - ALL or * ignore all flags, i.e. accept all data - MAN ignore MANUAL flags - CLIP ignore CLIP flags - NOIS ignore NOISE flags - SHAD ignore SHADOW flags - ADD ignore ADDITIVE flags - U1 ignore USER1 flags - U2 ignore USER2 flags - U3 ignore USER3 flags NOTES: - 1. If two options are mutually exclusive, the one specified last prevails, -e.g. - NONE,CLIP,MAN ignores the CLIP and MAN flags; - CLIP,MAN,NONE iognores none of the flags. -. -. -This keyword is part of NGEN, i.e. it is a NEWSTAR 'environment keyword', which -is available to all NEWSTAR programs. The switch /NOASK indicates that it is -'hidden', i.e. the user is not prompted for it, but the default value is used. -. -Its value may be modified (for a given $stream) in several ways: - Permanently for all programs and streams during current login: - change the default value: dws[pecify] 'NGEN$0' - Permanently for all programs in certain stream during current login: - change the default value: dws[pecify] NGEN['$stream'] - Permanently for certain program in all streams during current login: - change the default value: dws[pecify] 'program$0' - Permanently for certain program in certain stream during current login: - change the default value: dws[pecify] program['$stream'] .Note: -use automatic saving in LOGOUT to pass on values beyond current login - Incidentally for a certain incarnation of program[$stream]: - run as: dwe program['$stream']/UFL=value (or: - '(val1,val2,...)') - Incidentally for all hidden values: - run a NEWSTAR program as: dwe program['$stream']/ASK" -! -! -! Confirm node deletion -! Ref: WNDNOD -! -KEYWORD=DELETE_NODE - DATA_TYP=L - IO=I - SWITCHES=NULL_VALUES,WILD_CARDS - SEARCH=L,G:NGEN,P - PROMPT="Delete node (YES/NO)?" - DEFAULTS=NO /ASK - HELP=" -Specify the deletion of a node (YES) or not (NO)" -! -! Get memory chunks -! Ref: WNDDAB -! -KEYWORD=X_MEMORY - DATA_TYP=J - IO=MODIFY - SWITCHES=NULL_VALUES,WILD_CARDS - SEARCH=L,P - DEFAULT="# /NOASK" -! -KEYWORD=MEMORY - DATA_TYP=J - IO=I - SWITCHES=NULL_VALUES,WILD_CARDS - SEARCH=L,G:NGEN,P - DEFAULT=100000 /NOASK - PROMPT="Specify memory units" - HELP=" -Specify the amount of memory to be used per buffer for some applications. These -applications could run faster in some instances by increasing (if a lot of -physical memory present) or lowering (if a lot of swapping) this Value. -. -. -This keyword is part of NGEN, i.e. it is a NEWSTAR 'environment keyword', which -is available to all NEWSTAR programs. The switch /NOASK indicates that it is -'hidden', i.e. the user is not prompted for it, but the default value is used. -Its value may be modified (for a given $stream) in several ways: - Permanently for all programs and streams during current login: - change the default value: dws[pecify] 'NGEN$0' - Permanently for all programs in certain stream during current login: - change the default value: dws[pecify] NGEN['$stream'] - Permanently for certain program in all streams during current login: - change the default value: dws[pecify] 'program$0' - Permanently for certain program in certain stream during current login: - change the default value: dws[pecify] program['$stream'] Note: -use automatic saving in LOGOUT to pass on values beyond current login - Incidentally for a certain incarnation of program[$stream]: - run as: dwe program['$stream']/MEM=value - Incidentally for all hidden values: - run a NEWSTAR program as: dwe program['$stream']/ASK" -! -! Get output display -! Ref: WNDDIS -! -KEYWORD=DISPLAY - DATA_TYP=C - IO=I - LENGTH=24 - SWITCHES=NULL_VALUES,WILD_CARDS - SEARCH=L,P - PROMPT="Output Display" - DEFAULTS=* /NOASK - HELP=" -Specify the X-Display on which to produce output. E.g. if you are working from -a workstation or Xterminal called e.g. rzmwx5 on another machine (maybe a fast -processor, say rzmvfp); you can get the NGIDS display on your local machine by -giving as answer: rzmwx5:0.0 -. -If you specify a wildcard (*) or an empty answer, the display will be taken -from the environment variable DISPLAY; if this environment variable does not -exist, the default :0.0 will be assumed. -. -If your display machine is your working machine, give :0.0 (the default). -. -Note: Before being able to use your local display you should enable it by -typing while logged in on your local machine (rzmwx5) either: - xhost + or: - xhost +rzmfvp" -!- diff --git a/src/nscan/ngen.psc b/src/nscan/ngen.psc deleted file mode 100644 index 3625c2f7fb70726c0cf24e0524c54f0e77c188a7..0000000000000000000000000000000000000000 --- a/src/nscan/ngen.psc +++ /dev/null @@ -1,10 +0,0 @@ -!+ NGEN.PSC -! WNB 910828 -! -! Revisions: -! WNB 910909 Add DATAB, INFIX -! WNB 910913 Add loops and (de-)apply -! WNB 921211 Make PSC -! -INCLUDE=NGEN_PEF -!- diff --git a/src/nscan/nleiden.for b/src/nscan/nleiden.for deleted file mode 100644 index 0da97e716d52f3073b29a963d1bf2499f6d0d603..0000000000000000000000000000000000000000 --- a/src/nscan/nleiden.for +++ /dev/null @@ -1,328 +0,0 @@ -C+ NLEIDEN.FOR -C HjV 950116 -C -C Revisions: -C HjV 951113 Test if specified label not deleted in MEDIAD -C Add ARC-option -C CMV 000701 Be more relaxed in considering something deleted (for CDRoms) -C - SUBROUTINE NLEIDEN(TYP) -C -C Load LEIDEN data into SCN file -C -C Result: -C -C CALL NLEIDEN(TYP_J:I) will load LEIDEN data in SCN file if TYP is 0, -C or list LEIDEN data if TYP is 1, -C or list and update Scissor if TYP is 2. -C -C Include files: -C - INCLUDE 'WNG_DEF' - INCLUDE 'CBITS_DEF' - INCLUDE 'FDL_O_DEF' !FD BLOCK - INCLUDE 'FDL_T_DEF' - INCLUDE 'IHL_O_DEF' !IH BLOCK - INCLUDE 'IHL_T_DEF' - INCLUDE 'GFH_O_DEF' !GENERAL FILE HEADER - INCLUDE 'SGH_O_DEF' !SUB-GROUP HEADER - INCLUDE 'STH_O_DEF' !SET HEADER - INCLUDE 'NSC_DEF' -C -C Parameters: -C -C -C Arguments: -C - INTEGER TYP !Can be 0,1 or 2 -C -C Function references: -C - LOGICAL WNFOP,WNFOPF !OPEN FILE - LOGICAL WNFRD !READ DATA - LOGICAL WNFWR !WRITE DATA - INTEGER WNFEOF !FILE POSITION - DOUBLE PRECISION WNGDNF !NORM. ANGLE - INTEGER WNCALN !STRING LENGTH - LOGICAL WNDLNG,WNDLNF !LINK SUB-GROUP - LOGICAL NLEIRD !READ DATA - LOGICAL NLEIWD !WRITE DATA - CHARACTER*80 WNFTVL !GET VOLUME HEADER - INTEGER WNFSCI !CALL DATABASE - INTEGER WNFSCC !CLOSE DATABASE -C -C Data declarations: -C - LOGICAL OUT !WRITE SCN FILE? - CHARACTER*6 LTXT !LABEL NAME - CHARACTER*(IHL_FIELD_N) FNAM !FIELD NAME - DOUBLE PRECISION MJDHA0 !MJD AT HA=0 - REAL FWGT !MAX. WEIGHT -C - BYTE FDL(0:FDLHDL-1) !FD - INTEGER*2 FDLI(0:FDLHDL/2-1) - INTEGER FDLJ(0:FDLHDL/4-1) - REAL*4 FDLE(0:FDLHDL/4-1) - REAL*8 FDLD(0:FDLHDL/8-1) - EQUIVALENCE (FDL,FDLI,FDLJ,FDLE,FDLD) - BYTE IHL(0:IHLHDL-1) !IH - INTEGER*2 IHLI(0:IHLHDL/2-1) - INTEGER IHLJ(0:IHLHDL/4-1) - REAL*4 IHLE(0:IHLHDL/4-1) - REAL*8 IHLD(0:IHLHDL/8-1) - EQUIVALENCE (IHL,IHLI,IHLJ,IHLE,IHLD) -C - BYTE STH(0:STHHDL-1) !SET HEADER - INTEGER*2 STHI(0:STHHDL/2-1) - INTEGER STHJ(0:STHHDL/4-1) - REAL STHE(0:STHHDL/4-1) - REAL*8 STHD(0:STHHDL/8-1) - EQUIVALENCE (STH,STHI,STHJ,STHE,STHD) -C -C Some buffers passed to lower level routines. -C - INTEGER*2 DBUF(2,0:MXDATN-1) !INPUT BUFFER - INTEGER*2 TMPBUF(3,0:MXDATX-1) !OUTPUT BUFFER -C - INTEGER FCAT !TMP FILE DESCRIPTOR - INTEGER NCHT !# OF CHANNELS DONE - INTEGER BINT !BASIC INTEGRATION TIME - REAL OHAB !START HA SCANS - INTEGER ONS(6) !INTEGRATION DATA - INTEGER NPOL !# OF POLARISATIONS FOUND - INTEGER POLS(0:3) !INDICATE POLS TO DO - INTEGER NIFR !INTERFEROMETER COUNT - INTEGER IFRT(9,0:MXNIFR-1) !INTERFEROMETER DESCRIPTION - INTEGER F_XX !OUTPUT FOR FORMATS - CHARACTER*80 VOLUME !VOLUME HEADER - INTEGER*2 FVERS !Tape-format version - INTEGER OBSDATE !Obs. date (yyddd) - REAL*8 OBSSTART !Obs. start-time in SEC. - REAL*8 OBSEND !Obs. end-time in SEC. - INTEGER*2 OLSYS !Online program nr. - CHARACTER*3 PRNAME !Initals project scientist - INTEGER NBL !# block within dataset - INTEGER*2 BYPBL !# bytes per block - INTEGER*2 FBNDS,FBNDE !start/end freq.band - INTEGER*2 DIPOLE !DIPOLE number - CHARACTER*1024 WARC !BUFFER FOR ARCHIVE - CHARACTER*16 FIELD !Field name -C- -C -C INIT -C - OUT=(TYP.EQ.0) !ONLY SCN FILE IF TYP=0 - IF (OUT) THEN - F_XX=F_TP !BOTH SCREEN AND LOG - ELSE - F_XX=F_T !ONLY SCREEN - END IF - IF (.NOT.WNFOP(FCAT,'NSCAN.TMP','WT')) THEN !OPEN TMP FILE - CALL WNCTXT(F_TP,'Cannot open TMP file (!XJ)',E_C) - GOTO 900 - END IF - VOLUME=' ' !DEFAULT NO VOLUME - IF (UNIT.NE.'D') VOLUME=WNFTVL(IMCA) !GET VOLUME HEADER -C - J1=0 !JOB COUNT - 30 CONTINUE - J1=J1+1 !NEXT JOB - IF (J1.GT.NJOB) GOTO 900 !READY - J=0 !START LABEL INPUT - IF (OUT) THEN - IF (.NOT.WNDLNG(GFH_LINKG_1,0,SGH_GROUPN_1,FCAOUT,SGPH(0), - 1 SGNR(0))) THEN - CALL WNCTXT(F_TP,'!/Cannot create sub-group') - GOTO 800 !NEXT JOB - END IF !SUB-GROUP LINKED - CALL WNCTXT(F_P,'!_') !NEW PAGE - CALL WNCTXT(F_TP,'!/Job !UJ\: Group !UJ',J1,SGNR(0)) - ELSE - CALL WNCTXT(F_TP, - 1 'Label Seq.nr Fieldname Pro- '// - 1 'Duration Obs.-time RA Dec ') - CALL WNCTXT(F_TP, - 1 ' ject '// - 1 ' hhmm yyddd hhmm deg deg ') - END IF -C -C DO A LABEL -C - 10 CONTINUE - J=J+1 !COUNT INPUT LABEL - IF (NLAB(J1).LT.0) THEN !ALL LABELS ON TAPE - J0=J !NEXT INPUT LABEL - ELSE IF (J.LE.NLAB(J1)) THEN - J0=ILAB(J,J1) !NEXT INPUT LABEL - ELSE - GOTO 800 !READY WITH JOB - END IF -C -C Check MEDIAD, If label does not exist (probably deleted), skip and go to next -C - IF (UNIT.NE.'D' .AND. UNIT.NE.'1') THEN - CALL WNCTXS(WARC, - 1 'SELECT=MEDIAD VOLUME=!AS LABEL=!UJ ', - 1 VOLUME(5:10),J0) - J2=WNFSCI(WARC) - IF (MOD(J2,100).NE.0) THEN - CALL WNFSCS(WARC) - CALL WNCTXT(F_TP,'Label !UJ can not be used, '// - 1 'it is probably deleted in archive MEDIAD',J0) - GOTO 10 !NEXT LABEL - END IF - IF (J.EQ.1) THEN - J2=WNFSCC() - IF (MOD(J2,100).NE.0) THEN - CALL WNFSCS(WARC) - CALL WNCTXT(F_TP,'Could not close archive MEDIAD, error !SJ',J2) - GOTO 10 !NEXT LABEL - END IF - END IF - END IF -C -C OPEN INPUT -C - IF (UNIT.EQ.'D') THEN !DISK INPUT - CALL WNCTXS(LTXT,'!6$ZJ',J0) !MAKE LABEL NAME - IF (.NOT.WNFOP(IMCA,IFILE(1:WNCALN(IFILE))//'.'//LTXT,'R')) THEN - IF (NLAB(J1).GT.0) - 1 CALL WNCTXT(F_XX,'Cannot find file !AS\.!AS',IFILE,LTXT) - GOTO 800 !STOP JOB - END IF - ELSE !TAPE INPUT - IF (.NOT.WNFOPF(IMCA,' ','R',0,0,0,J0)) THEN - CALL WNCTXT(F_XX,'Cannot find label !UJ',J0) - GOTO 800 !NEXT JOB - END IF - END IF - IF (OUT) THEN - IF (.NOT.WNDLNG(SGPH(0)+SGH_LINKG_1,0,SGH_GROUPN_1,FCAOUT, - 1 SGPH(1),SGNR(1))) THEN !LINK SUB-GROUP - CALL WNCTXT(F_TP,'!/Cannot create sub-group') - GOTO 700 !NEXT LABEL - END IF - CALL WNCTXT(F_TP,'!4CLabel !3$UJ: Sub-group !UJ\.!UJ', - 1 J0,SGNR(0),SGNR(1)) - END IF -C -C READ FD-BLOCK -C - J2=0 !DATA POINTER - 20 CONTINUE - IF (.NOT.WNFRD(IMCA,FDLHDL,FDL,J2)) THEN !READ FD BLOCK - CALL WNCTXT(F_XX,'Read error FD at !XJ',J2) - GOTO 700 !NEXT LABEL - END IF - IBMSW=.FALSE. !ASSUME NON-IBM - DECSW=.FALSE. !ASSUME LOCAL - IF (FDL(FDL_CBT_1).NE.ICHAR('F') .OR. - 1 FDL(FDL_CBT_1+1).NE.ICHAR('D')) THEN - IBMSW=.TRUE. !ASSUME IBM - CALL WNTTIL(FDLHDL,FDL,FDL_T) !TRANSLATE - IF (FDL(FDL_CBT_1).NE.ICHAR('F') .OR. - 1 FDL(FDL_CBT_1+1).NE.ICHAR('D')) THEN - 23 CONTINUE - CALL WNCTXT(F_XX,'Cannot find FD block') - GOTO 700 !NEXT LABEL - END IF - ELSE IF (FDLI(FDL_CBI_I).NE.32767) THEN - DECSW=.TRUE. !ASSUME FROM DEC - CALL WNTTDL(FDLHDL,FDL,FDL_T) !TRANSLATE - IF (FDLI(FDL_CBI_I).NE.32767) GOTO 23 -C -C DECStation/Alpha has the same swapping sequence as VAX D/G, -C but uses IEEE floating point format. The test on FDL_CBI is -C therefore not sufficient. Since raw data is assumed to be in -C IBM (type -1) or VAX D (type 1) format, the following test is -C safe and sufficient. -C - ELSE IF (PRGDAT.EQ.6) THEN - DECSW=.TRUE. !ASSUME FROM DEC - CALL WNTTDL(FDLHDL,FDL,FDL_T) !TRANSLATE - IF (FDLI(FDL_CBI_I).NE.32767) GOTO 23 - END IF -C -C GET POLARISATIONS TO DO -C - DO I=0,3 !SET POL. TO DO - POLS(I)=1 !SET WANTED - END DO - NPOL=4 !CNT POL - ONS(1)=-1 -C -C MAKE SET HEADER TEMPLATE -C - CALL WNGMVZ(STHHDL,STH(0)) !CLEAR - STHI(STH_LEN_I)=STHHDL !LENGTH - STHI(STH_VER_I)=STHHDV !VERSION - STHJ(STH_NIFR_J)=FDLI(FDL_NRINTF_I) !# OF INTERF. - STHI(STH_CHAN_I)=FDLI(FDL_FREQBND_I) !FREQUENCY BAND -C STHI(STH_BEC_I)=IAND('0000ffff'X,OHWJ(OHW_CONFNR_J)) !BACKEND CODE - IF (OUT) THEN - IF (.NOT.WNDLNF(SGPH(1)+SGH_LINKG_1,0,SGH_GROUPN_1,FCAOUT, - 1 SGPH(2),SGNR(2))) THEN !FIND/CREATE SUB-GROUP - CALL WNCTXT(F_TP,'!/Cannot link sub-group') - GOTO 700 !NEXT LABEL - END IF - END IF - FVERS=FDLI(FDL_FVERS_I) !Tape version format - NBL=FDLJ(FDL_NBL_J) !# OF BLOCKS WITHIN DATASET - BYPBL=FDLI(FDL_BYPBL_I) !# BYTES PER BLOCK - FBNDS=FDLI(FDL_FREQBND_I) !First freq.band - FBNDE=FDLI(FDL_FREQBND_I)+FDLI(FDL_TOTFREQ_I)-1 !Last freq.band -C -C MAKE TMP FILE -C - NCHT=0 !COUNT SELECTED - NIFR=0 !NO IFR SEEN - I3=STHI(STH_CHAN_I) !FREQ.BAND - FWGT=0 !MAX. WEIGHT -C -C READ INTERFEROMETERS -C - IF (.NOT.NLEIRD(IMCA,FCAT,FDLI(FDL_NRINTF_I),FDLJ(FDL_OFFINTF_J), - 1 BINT,INTOFF(J1),ONS,OHAB,MJDHA0,NIFR,IFRT, - 1 STH,STHI,STHJ,STHE,STHD, - 1 OBSDATE,OBSSTART,OBSEND,OLSYS,PRNAME,FIELD, - 1 FWGT,DIPOLE,DBUF,TMPBUF)) GOTO 700 - IF (OUT) THEN - IF (NIFR.GT.0) THEN !SOME TO WRITE - STHE(STH_WFAC_E)=1.-FWGT - IF (.NOT.NLEIWD(FCAT,ONS,OHAB,NIFR,IFRT,POLS, - 1 BINT,STH(0),MJDHA0,J1,I3, - 1 FWGT,TMPBUF)) GOTO 700 - END IF - ELSE - CALL NLEILU (TYP,VOLUME(5:10),J0,FVERS, - 1 OBSDATE,OBSSTART,OBSEND,OLSYS,PRNAME,FIELD, - 1 NBL,BYPBL,FBNDS,FBNDE,DIPOLE, - 1 STH,STHI,STHJ,STHE,STHD) - END IF -C -C FINISH LABEL -C - 700 CONTINUE - CALL WNFCL(IMCA) !CLOSE LABEL - GOTO 10 !NEXT LABEL -C -C FINISH JOB -C - 800 CONTINUE - GOTO 30 !NEXT JOB -C -C READY -C - 900 CALL WNFCL(IMCA) !CLOSE INPUT - CALL WNFDMO(IMCA) !DISMOUNT INPUT - CALL WNFCL(FCAT) !CLOSE/DELETE TMP FILE - IF (OUT) THEN - CALL NSCPFH(F_TP,FCAOUT) !SHOW FILE HEADER - CALL NSCPFL(F_TP,FCAOUT,NODOUT,.FALSE.) !SHOW LAYOUT - CALL WNFCL(FCAOUT) !CLOSE OUTPUT - END IF -C - RETURN !READY -C -C - END diff --git a/src/nscan/nleilu.for b/src/nscan/nleilu.for deleted file mode 100644 index 62a50f505d32219c3fe1ce4cacb46e0a66f775f5..0000000000000000000000000000000000000000 --- a/src/nscan/nleilu.for +++ /dev/null @@ -1,518 +0,0 @@ -C+ NLEILU.FOR -C HjV 951101 -C -C Revisions: -C WNB 951212 Correct MAX(real,integer) routine -C HjV 960111 Change CONTLINE in OBSMODE -C -C - SUBROUTINE NLEILU(TYP,VOLUME,LABEL,FVERS, - 1 OBSDATE,OBSSTART,OBSEND,OLSYS,PRNAME,FIELD, - 1 NBL,BYPBL,FBNDS,FBNDE,DIPOLE, - 1 STH,STHI,STHJ,STHE,STHD) -C -C List header and optionally update the archive -C -C Result: -C -C CALL NLEILU(TYP_J:I, VOLUME_C(6)I, LABEL_J:I, FVERS_I:I, -C OBSDATE_J:I, OBSSTART_D:I, OBSEND_D:I, -C OLSYS_I:I, PRNAME_C(3):I, FIELD_C(16):I, -C FBNDS_I:I, FBNDE_I:I, DIPOLE_I:I, -C NBL_J:I, BYPBL_I:I, ...) -C List Leiden data from headers if TYP is 1, -C or list and update Scissor if TYP is 2. -C VOLUME is the name of the volume or blank -C LABEL is the label on the input tape -C FVERS is the tape-format version -C OBSDATE is Observation date (yyddd) -C OBSSTART is Observation start-time in sec. -C OBSEND is Observation end-time in sec. -C OLSYS is online computer program nr. -C PRNAME is initials of project scientist -C FIELD is fieldname -C NBL is number of blocks within the dataset -C BYPBL is number of bytes per block -C FBNDS is start freq.-band -C FBNDE is end freq.-band -C DIPOLE is the dipole position -C -C Include files: -C - INCLUDE 'WNG_DEF' - INCLUDE 'NSC_DEF' !FOR OPTION AND SRTRCL - INCLUDE 'STH_O_DEF' !SET HEADER -C -C Arguments: -C - INTEGER TYP ! 1:LIST 2:LIST AND ARCHIVE - CHARACTER*6 VOLUME !VOLUME LABEL IF ANY - INTEGER LABEL !LABEL NUMBER - INTEGER*2 FVERS !Tape-format version - INTEGER OBSDATE !Obs. date (yyddd) - REAL*8 OBSSTART !Obs. start-time in SEC. - REAL*8 OBSEND !Obs. end-time in SEC. - INTEGER*2 OLSYS !Online program nr. - CHARACTER*3 PRNAME !Initals project scientist - CHARACTER*16 FIELD !Field name - INTEGER NBL !# block within dataset - INTEGER*2 BYPBL !# bytes per block - INTEGER*2 FBNDS,FBNDE !start/end freq.band - INTEGER*2 DIPOLE !DIPOLE number -C - BYTE STH(0:STHHDL-1) !SET HEADER - INTEGER*2 STHI(0:STHHDL/2-1) - INTEGER STHJ(0:STHHDL/4-1) - REAL STHE(0:STHHDL/4-1) - REAL*8 STHD(0:STHHDL/8-1) -C -C Function references: -C - LOGICAL WNFRD !READ FROM FCA - LOGICAL WNFOPF !OPEN LABEL - INTEGER WNCALN !LENGTH OF STRING - INTEGER WNFSCI !CALL DATABASE -C -C Data declarations: -C - INTEGER*2 NULL - DATA NULL/0/ - INTEGER*2 ONLINE !ONLINE SYSTEMNR. - INTEGER DURATION !DURATION OF OBS. IN SEC. - INTEGER UTD,UTM,UTY !UT START-TIME DAY,MONTH,YEAR - INTEGER UTDAY - DOUBLE PRECISION RA1,DEC1 !RA AND DEC OF OBS. - REAL POS9A,POS9B,POS9C,POS9D !POSITION TEL. 9 - REAL*8 UTSTART,UTEND !UT-time - CHARACTER*2 DIPC !DIPOLE SETTING - CHARACTER*4 BECODE !BACKEND NAME - CHARACTER*32 POLC !POLARISATIONS - CHARACTER*9 OBSMODE !OBSERVATION MODE - CHARACTER*32 ARUSE !ARRAY USE - BYTE RWBUF(SRTRCL) !I/O BUFFER FOR CHECK - INTEGER*2 OBSHR,OBSMIN !OBS.-TIME - INTEGER OBSY,OBSM,OBSD !OBS.-TIME - CHARACTER*12 SOURCE - INTEGER PROJECT !PROJECTNR. - INTEGER LTXT !LENGTH STRING TO USE - INTEGER PTXT !STRING POINTER - CHARACTER*1024 WARC_OBS !BUFFER FOR ARCHIVE - CHARACTER*1024 WARC !BUFFER FOR ARCHIVE - INTEGER WAVEL !WAVELENGTH IN CM - -C - INTEGER DAYS(12) !DAYS PER MONTH - DATA DAYS/31,28,31,30,31,30,31,31,30,31,30,31/ - - CHARACTER*10 CDIG !DIGITS - DATA CDIG/'0123456789'/ - - INTEGER LEIRCL ! MOET IN FDL.DSC - DATA LEIRCL/3840/ -C -C - DURATION=(STHE(STH_HAI_E)*STHJ(STH_SCN_J))*DCRTSC - OBSHR=INT(OBSSTART/3600.) - OBSMIN=INT((OBSSTART-(OBSHR*3600.))/60.) -C EXTRACT SOME INFO FROM THE FIELDNAME - PROJECT=5 - OBSMODE=' ' - IF (FIELD(1:1).EQ.'W') THEN !WESTERBORK OBS. - LTXT=INDEX(FIELD,'.') - IF (LTXT.EQ.0) LTXT=INDEX(FIELD,'<') - IF (LTXT.EQ.0) LTXT=INDEX(FIELD,',') - IF (LTXT.GT.0) THEN !OK, A DOT, COMMA or < IN FIELDNAME - IF (FIELD(1:1).EQ.'C') THEN !21cm cont - OBSMODE='Continuum' - ELSE IF (FIELD(1:1).EQ.'H') THEN !21cm line - OBSMODE='Line' - ELSE IF (FIELD(1:1).EQ.'R') THEN !6cm line - OBSMODE='Line' - ELSE IF (FIELD(1:1).EQ.'S') THEN !6cm cont - OBSMODE='Continuum' - ELSE IF (FIELD(1:1).EQ.'T') THEN !50cm cont - OBSMODE='Continuum' - END IF - PROJECT=0 !RESULT - PTXT=0 - DO WHILE (PTXT+1.LE.LTXT) - J2=INDEX(CDIG,FIELD(PTXT+1:PTXT+1)) - IF (J2.GT.0) THEN - PROJECT=PROJECT*10+J2-1 !ADD DIGIT - END IF - PTXT=PTXT+1 !NEXT DIGIT - END DO - SOURCE=FIELD(LTXT+1:LEN(FIELD)) - ELSE !NO DOT IN FIELDNAME - SOURCE=FIELD(1:LEN(FIELD)) - ENDIF - ELSE !NOT WESTERBORK OBS. - SOURCE=FIELD(1:LEN(FIELD)) - END IF -C -C Oplossen probleemgevallen - IF (FIELD(1:6).EQ.'WH.CYG') PROJECT=13 - IF (FIELD(1:5).EQ.'WS85,') THEN - PROJECT=85 - SOURCE=FIELD(6:LEN(FIELD)) - OBSMODE='Continuum' - END IF - IF (FIELD(1:4).EQ.'WS86') THEN - PROJECT=86 - SOURCE=FIELD(5:LEN(FIELD)) - OBSMODE='Continuum' - END IF - IF (FIELD(1:4).EQ.'WHX.') THEN - PROJECT=5 - SOURCE=FIELD(5:LEN(FIELD)) - OBSMODE='Line' - END IF - IF (FIELD(1:4).EQ.'WX6\') THEN - PROJECT=6 - SOURCE=FIELD(5:LEN(FIELD)) - END IF - IF (FIELD(1:3).EQ.'W5\') THEN - PROJECT=5 - SOURCE=FIELD(4:LEN(FIELD)) - END IF - IF (FIELD(1:4).EQ.'W13\') THEN - PROJECT=13 - SOURCE=FIELD(5:LEN(FIELD)) - END IF - IF (FIELD(1:4).EQ.'W31\') THEN - PROJECT=31 - SOURCE=FIELD(5:LEN(FIELD)) - END IF - IF (FIELD(1:5).EQ.'W100\') THEN - PROJECT=100 - SOURCE=FIELD(6:LEN(FIELD)) - END IF - IF (FIELD(1:5).EQ.'W101\') THEN - PROJECT=101 - SOURCE=FIELD(6:LEN(FIELD)) - END IF - IF (FIELD(1:5).EQ.'W7CYG') THEN - PROJECT=7 - SOURCE=FIELD(3:LEN(FIELD)) - END IF - IF (FIELD(1:5).EQ.'W4HER') THEN - PROJECT=4 - SOURCE=FIELD(3:LEN(FIELD)) - END IF - IF (FIELD(1:4).EQ.'W5 N') THEN - PROJECT=5 - SOURCE=FIELD(4:LEN(FIELD)) - END IF - IF (FIELD(1:4).EQ.'W16 ') THEN - PROJECT=16 - SOURCE=FIELD(5:LEN(FIELD)) - END IF - IF (FIELD(1:4).EQ.'W17 ') THEN - PROJECT=17 - SOURCE=FIELD(5:LEN(FIELD)) - END IF - IF (FIELD(1:4).EQ.'W69 ') THEN - PROJECT=69 - SOURCE=FIELD(5:LEN(FIELD)) - END IF - IF (FIELD(1:5).EQ.'W204C') THEN - PROJECT=20 - SOURCE=FIELD(4:LEN(FIELD)) - END IF - IF (FIELD(1:5).EQ.'W20 4') THEN - PROJECT=20 - SOURCE=FIELD(5:LEN(FIELD)) - END IF - IF (FIELD(1:5).EQ.'WH14N') THEN - PROJECT=14 - SOURCE=FIELD(5:LEN(FIELD)) - OBSMODE='Line' - END IF - IF (FIELD(1:8).EQ.'WH161NGC') THEN - PROJECT=161 - SOURCE=FIELD(6:LEN(FIELD)) - END IF - IF (FIELD(1:5).EQ.'WS124') THEN - PROJECT=124 - SOURCE=FIELD(6:LEN(FIELD)) - END IF - IF (FIELD(1:4).EQ.'WS11') THEN - PROJECT=11 - SOURCE=FIELD(5:LEN(FIELD)) - END IF - IF (FIELD(1:6).EQ.'WS155_') THEN - PROJECT=155 - SOURCE=FIELD(7:LEN(FIELD)) - OBSMODE='Continuum' - END IF - IF (FIELD(1:4).EQ.'WS3C') THEN - PROJECT=5 - SOURCE=FIELD(3:LEN(FIELD)) - OBSMODE='Continuum' - END IF - IF (FIELD(1:6).EQ.'WC182P') THEN - PROJECT=182 - SOURCE=FIELD(6:LEN(FIELD)) - OBSMODE='Continuum' - END IF -C -C - CALL WNCTXT(F_TP, - 1 '!4$UJ: !9$SJ !-12$AS !4$UJ !2$ZJ!2$ZJ '// - 1 '!2$ZI!3$ZI !2$ZI!2$ZI '// - 1 '!10$DPF15.5 !10$DAF15.5', - 1 LABEL,STHJ(STH_VNR_J), - 1 SOURCE,PROJECT, - 1 (DURATION/3600),MOD(DURATION/60,60), - 1 STHI(STH_OBS_I+1),STHI(STH_OBS_I), - 1 OBSHR,OBSMIN, - 1 STHD(STH_RA_D),STHD(STH_DEC_D)) -C -C TYP will be 2 if the WARC option had been choosen. -C There are two suboptions now: CHECK or ARCHIVE. -C -C With CHECK we scan the whole observation on tape to catch parity -C errors, with ARCHIVE the Observation, Obspos and Mediad views in Scissor -C are informed of the label through WNFSCI. -C - IF (TYP.EQ.2.AND.OPTION(4:4).EQ.'C') THEN !Read all blocks - J=NBL !Number of blocks - J1=BYPBL !Blocksize - IF (J1.NE.LEIRCL) THEN - CALL WNCTXT(F_TP,'Invalid blocksize for label !UJ',LABEL) - END IF -C -C For tapes, reopen (some units are slow in rewinding) -C - IF (UNIT.EQ.'D') THEN !No check for Disks - ELSE IF (.NOT.WNFOPF(IMCA,' ','R',0,0,0,LABEL)) THEN - CALL WNCTXT(F_TP,'Cannot re-open label !UJ',LABEL) - ELSE - I1=0 !No bad records yet - DO J2=0,J-1 - IF (.NOT.WNFRD(IMCA,SRTRCL,RWBUF,J2*J1)) THEN !Error - I1=I1+1 - IF (I1.LT.3) THEN - CALL WNCTXT(F_TP, - 1 'Cannot read record !UJ for label !UJ',J2,LABEL) - END IF - END IF - END DO - IF (I1.GE.3) THEN - CALL WNCTXT(F_TP, - 1 'Cannot read !UJ records for label !UJ',I1,LABEL) - ELSE IF (I1.EQ.0) THEN - CALL WNCTXT(F_TP, - 1 'Total of !UJ records checked for label !UJ',J,LABEL) - END IF - END IF -C - ELSE IF (TYP.EQ.2.AND.OPTION(4:4).EQ.'A') THEN !Inform Scissor -C - IF (OBSDATE.LT.77000) THEN - BECODE='ANA' !BE CODE - ELSE - IF (PRNAME.EQ.'DLB' .OR. PRNAME.EQ.'DCC') THEN - BECODE='DLB' !BE CODE - ELSE - BECODE='ANA' !BE CODE - END IF - END IF -C - RA1=STHD(STH_RA_D)*360.D0 - IF (RA1.LT.0) RA1=RA1+360.D0 !BETWEEN 0..360 - DEC1=STHD(STH_DEC_D)*360.D0 -C - IF (OBSMODE.EQ.' ') THEN - OBSMODE='Continuum' - IF ((STHE(STH_RTP_E) .EQ.STHE(STH_RTP_E+5)) .AND. - 1 (STHE(STH_RTP_E+1).EQ.STHE(STH_RTP_E+6)) .AND. - 1 (STHE(STH_RTP_E+2).EQ.STHE(STH_RTP_E+7)) .AND. - 1 (STHE(STH_RTP_E+3).EQ.STHE(STH_RTP_E+8)) .AND. - 1 (STHE(STH_RTP_E+4).EQ.STHE(STH_RTP_E+9))) OBSMODE='Line' - END IF -C - IF (MOD(INT(DIPOLE/4),2).EQ.0) THEN - DIPC(1:1)='+' - ELSE - DIPC(1:1)='X' - END IF - IF (MOD(DIPOLE,2).EQ.0) THEN - DIPC(2:2)='+' - ELSE - DIPC(2:2)='X' - END IF -C -C Some observations have obs-date: x-y-1936 (yes, 1936) -C These observations should have year 1973, so I will change it here - OBSY=INT(OBSDATE/1000) !YEAR - OBSD=OBSDATE-(OBSY*1000) !DAYNR - OBSY=OBSY+1900 - IF (OBSY.EQ.1936) OBSY=1973 - CALL WNGU2S (-1,OBSY,UTDAY,UTSTART,OBSD,OBSSTART/86400.) - CALL WNGU2S (-1,OBSY,UTDAY,UTEND,OBSD,OBSEND/86400.) -C - OBSY=INT(OBSDATE/1000) !YEAR - OBSD=OBSDATE-(OBSY*1000) !DAYNR - OBSY=OBSY+1900 - IF (OBSY.EQ.1936) OBSY=1973 - OBSM=1 - IF (MOD(OBSY,4).EQ.0) DAYS(2)=DAYS(2)+1 - DO WHILE (OBSD.GT.DAYS(OBSM)) - OBSD=OBSD-DAYS(OBSM) - OBSM=OBSM+1 - END DO - IF (MOD(OBSY,4).EQ.0) DAYS(2)=DAYS(2)-1 - IF (OBSM.GT.12) THEN - OBSM=OBSM-12 - OBSY=OBSY+1 - END IF - IF (OBSD.EQ.0) OBSD=1 -C - UTY=1900+STHI(STH_OBS_I+1) - UTD=STHI(STH_OBS_I) - UTM=1 - IF (UTY.EQ.1936) UTY=1973 - IF (MOD(STHI(STH_OBS_I+1),4).EQ.0) DAYS(2)=DAYS(2)+1 - DO WHILE (UTD.GT.DAYS(UTM)) - UTD=UTD-DAYS(UTM) - UTM=UTM+1 - END DO - IF (MOD(STHI(STH_OBS_I+1),4).EQ.0) DAYS(2)=DAYS(2)-1 - IF (UTM.GT.12) THEN - UTM=UTM-12 - UTY=UTY+1 - END IF - IF (UTD.EQ.0) UTD=1 -C - IF (STHJ(STH_NIFR_J).EQ.80) THEN - ARUSE='X0123456789AB.._Y0123456789AB.. ' - ELSE - ARUSE='X0123456789ABCD_Y0123456789ABCD ' - ENDIF -C - IF (STHD(STH_FRQ_D).GE.200 .AND. STHD(STH_FRQ_D).LE.400) THEN - WAVEL=92 - ELSE IF (STHD(STH_FRQ_D).GE.500 .AND. STHD(STH_FRQ_D).LE.800) THEN - WAVEL=50 - ELSE IF (STHD(STH_FRQ_D).GE.1200 .AND. STHD(STH_FRQ_D).LE.1500) THEN - WAVEL=21 - ELSE IF (STHD(STH_FRQ_D).GE.1600 .AND. STHD(STH_FRQ_D).LE.1800) THEN - WAVEL=18 - ELSE IF (STHD(STH_FRQ_D).GE.4600 .AND. STHD(STH_FRQ_D).LE.5100) THEN - WAVEL=6 - ELSE - WAVEL=0 - END IF -C -C Zet Online-version op 0 -C Het aanpassen van WSRTOBS file definition stuit op system probleem. - OLSYS=0 -C -C - CALL WNCTXS(WARC_OBS, - 1 'PUT=OBSERVATION '// - 1 'SEQNUMBER=!SJ PROJECT=!UJ '// - 1 'EPOCHE=!E SOURCE=!AS', - 1 STHJ(STH_VNR_J),PROJECT, - 1 STHE(STH_EPO_E),SOURCE) -C - CALL WNCTXS(WARC_OBS(WNCALN(WARC_OBS)+1:), - 1 ' SETS_START=!UI SETS_END=!UI '// - 1 'TAPE_VERSION=!SI ONLINE_VERSION=!SI '// - 1 'OBS_DATE=!2$ZJ/!2$ZJ/!4$ZJ OBS_TIME=!UJ '// - 1 'UT_DATE=!2$ZJ/!2$ZJ/!4$ZJ '// - 1 'UT_START=!UJ UT_END=!UJ '// - 1 'HA_START=!D HA_END=!D ', - 1 FBNDS,FBNDE, - 1 FVERS,OLSYS, - 1 OBSD,OBSM,OBSY,INT(OBSSTART), - 1 UTD,UTM,UTY, - 1 INT(86400*UTSTART),INT(86400*UTEND), - 1 STHE(STH_HAB_E)*360.D0, - 1 (STHE(STH_HAB_E)+STHE(STH_HAI_E)*STHJ(STH_SCN_J))*360.D0) -C - CALL WNCTXS(WARC_OBS(WNCALN(WARC_OBS)+1:), - 1 ' NR_SETS=!UI NR_POLARISATION=!UI '// - 1 'NR_INTERFEROM=!UJ '// - 1 'NR_FREQ=!UI NR_FEQ=!UI NR_CORRCHAN=!UI '// - 1 'POSA_9=!E POSB_9=!E POSC_9=!E POSD_9=!E '// - 1 'ARRAY_USE=!AS ', - 1 FBNDE-FBNDS+1,STHI(STH_PLN_I), - 1 STHJ(STH_NIFR_J),NULL, - 1 NULL,NULL, - 1 STHE(STH_RTP_E+10)-STHE(STH_RTP_E+9), - 1 STHE(STH_RTP_E+11)-STHE(STH_RTP_E+9), - 1 MAX(0.,STHE(STH_RTP_E+12)-STHE(STH_RTP_E+9)), - 1 MAX(0.,STHE(STH_RTP_E+13)-STHE(STH_RTP_E+9)), - 1 ARUSE) -C - CALL WNCTXS(WARC_OBS(WNCALN(WARC_OBS)+1:), - 1 ' FREQUENCY=!D '// - 1 'BANDWIDTH=!E '// - 1 'BACKEND.DESCRIPTION=!AS '// - 1 'OBSMODE.DESCRIPTION=!AS '// - 1 'DIPOLE.SYMBOLIC=!AS ', - 1 STHD(STH_FRQ_D), - 1 STHE(STH_BAND_E), - 1 BECODE,OBSMODE,DIPC) -C -C Create entry in PROJECTOR if project not exist - CALL WNCTXS(WARC,'SELECT=PROJECTOR PROJECT=!UJ',PROJECT) - J0=WNFSCI(WARC) - IF (J0.LT.0) THEN - CALL WNFSCS(WARC) - CALL WNCTXT(F_TP,'Error !SJ , will NOT continue this label', - 1 J0) - RETURN - END IF - IF (MOD(J0,100).NE.0) THEN !PROJECT DOES NOT EXIST - CALL WNFSCS(WARC) - CALL WNCTXT(F_TP,'Creating project !UJ in PROJECTOR',project) - CALL WNCTXS(WARC, - 1 'PUT=PROJECTOR PROJECT=!UJ PROPOSALNR=!UJ '// - 1 'SUBJECT=Observations from LEIDEN archive '// - 1 'CATEGORY=Unknown WAVELENGTH=!UJ ALIAS=Leiden data', - 1 PROJECT,PROJECT,WAVEL) - J0=WNFSCI(WARC) - IF (MOD(J0,100).NE.0) THEN - CALL WNFSCS(WARC) - CALL WNCTXT(F_TP,'Error !UJ updating archive: !AS', - 1 J0,WARC(1:WNCALN(WARC))) - END IF - END IF -C -C Update OBSERVATION - J0=WNFSCI(WARC_OBS) - IF (MOD(J0,100).NE.0) THEN - CALL WNFSCS(WARC_OBS) - CALL WNCTXT(F_TP,'Error !SJ updating archive: !AS', - 1 J0,WARC_OBS(1:WNCALN(WARC_OBS))) - END IF -C -C Update MEDIAD - CALL WNCTXS(WARC, - 1 'PUT=MEDIAD VOLUME=!AS LABEL=!UJ SEQNUMBER=!SJ PROJECT=!UJ', - 1 VOLUME,LABEL,STHJ(STH_VNR_J),PROJECT) - J0=WNFSCI(WARC) - IF (MOD(J0,100).NE.0) THEN - CALL WNFSCS(WARC) - CALL WNCTXT(F_TP,'Error !SJ updating archive: !AS', - 1 J0,WARC(1:WNCALN(WARC))) - END IF -C -C Update OBSPOS - CALL WNCTXS(WARC, - 1 'PUT=OBSPOS SEQNUMBER=!SJ '// - 1 'RA=!D DEC=!D EQUINOX=B1950 SYSTEM=FK5 OH_NO=0', - 1 STHJ(STH_VNR_J),RA1,DEC1) - J0=WNFSCI(WARC) - IF (MOD(J0,100).NE.0) THEN - CALL WNFSCS(WARC) - CALL WNCTXT(F_TP,'Error !SJ updating archive: !AS', - 1 J0,WARC(1:WNCALN(WARC))) - END IF - END IF -C - RETURN - END diff --git a/src/nscan/nleird.for b/src/nscan/nleird.for deleted file mode 100644 index 4d1d7da83727b4315bbb99e5bddb486d83bb1242..0000000000000000000000000000000000000000 --- a/src/nscan/nleird.for +++ /dev/null @@ -1,373 +0,0 @@ -C+ NLEIRD.FOR -C HjV 950116 -C -C Revisions: -C HjV 951113 Add stuff for ARC-option -C -C - LOGICAL FUNCTION NLEIRD(INFCA,FCAT,NRINTF,OFFINTF, - 1 BINT,HABOFF,ONS,OHAB,MJDHA0,NIFR,IFRT, - 1 STH,STHI,STHJ,STHE,STHD, - 1 OBSDATE,OBSSTART,OBSEND,OLSYS,PRNAME,FIELD, - 1 FWGT,DIPOLE,DBUF,TMPBUF) -C -C Read LEIDEN data into TMP file -C -C Result: -C -C NLEIRD_J = NLEIRD( INFCA_J:I, FCAT_J:I, -C BINT_J:I, HABOFF_E:I, ONS_J(6):IO, OHAB_E:IO, -C MJDHA0_D:O,NIFR_J:IO, IFRT_J(9,0:*):IO, STHI_I(0:*):IO, -C STHJ_J(0:*):IO, STHE_E(0:*):IO, STHD_D(0:*):IO, -C OBSDATE_J:O, OBSSTART_D:O, OBSEND_D:O, -C OLSYS_I:O, PRNAME_C(3):O, FIELD_C(16):O, -C FWGT_E:IO, DIPOLE_I:O, -C DBUF_I(2,0:*):I, TMPBUF_I(3:0:*)) -C Read LEIDEN data from tape/disk to TMP file. -C INFCA indicates the file to read, -C FCAT is the TMP file; -C NRINTF is nr. of interferometers, -C OFFINTF is array with offsets for each interf., -C BINT is the basic integration time (10 s). -C HABOFF gives the start of integration. -C MJDHA0 is the MJD for HA=0 -C ONS gives the integration data, OHAB the -C start HA of the output. If ONS(1)<0 the -C start of a new channel is indicated. -C NIFR is the number of inetrferometers found, -C IFRT describes the interferometers. -C STH is the template set header -C OBSDATE is Observation date (yyddd) -C OBSSTART is Observation start-time in sec. -C OBSEND is Observation end-time in sec. -C OLSYS is online computer program nr. -C PRNAME is initials of project scientist -C FIELD is field name -C FWGT the max. value of all integration times -C DIPOLE is the dipole position -C DBUF is an input buffer, -C TMPBUF is used for writing. -C -C -C Include files: -C - INCLUDE 'WNG_DEF' - INCLUDE 'NSC_DEF' - INCLUDE 'IHL_O_DEF' !IH BLOCK - INCLUDE 'IHL_T_DEF' - INCLUDE 'STH_O_DEF' !SET HEADER -C -C Parameters: -C -C -C Entry points: -C -C -C Arguments: -C - INTEGER INFCA !INPUT FILE DESCRIPTOR - INTEGER FCAT !TMP OUTPUT FILE DESCRIPTOR - INTEGER*2 NRINTF !# OF INTERF. - INTEGER OFFINTF(0:159) !OFFSET FOR EACH INTERF. - INTEGER BINT !BASIC INTEGRATION IN SEC - REAL HABOFF !INTEGRATION START OFFSET - INTEGER ONS(6) !INTEGRATION DATA - REAL OHAB !START HA - DOUBLE PRECISION MJDHA0 !MJD AT HA0 - INTEGER NIFR !# OF IFRS FOUND - INTEGER IFRT(9,0:*) !IFR DESCRIPTION - BYTE STH(0:*) !SET HEADER - INTEGER*2 STHI(0:*) - INTEGER STHJ(0:*) - REAL STHE(0:*) - REAL*8 STHD(0:*) - INTEGER OBSDATE !Obs. date (yyddd) - REAL*8 OBSSTART !Obs. start-time in SEC. - REAL*8 OBSEND !Obs. end-time in SEC. - INTEGER*2 OLSYS !Online program nr. - CHARACTER*3 PRNAME !Initals project scientist - CHARACTER*16 FIELD !Field name - REAL FWGT !MAX. INT. TIMES - INTEGER*2 DIPOLE - INTEGER*2 DBUF(2,0:MXDATN-1) !INPUT BUFFER - INTEGER*2 TMPBUF(3,0:MXDATX-1) !OUTPUT BUFFER FOR WRITING -C -C Function references: -C - LOGICAL WNFRD !READ DATA - LOGICAL WNFWR !WRITE DATA -C -C Data declarations: -C - REAL SUMC,SUMS !INTEGRATE - INTEGER N !# OF INTEGRATED POINTS - INTEGER NS(-6:6) !INTEGRATION DATA - REAL HAB !START HA - INTEGER WTEL !WEST TELESCOPE - INTEGER OTEL !EAST TELESCOPE - INTEGER IPOL !POLARISATION NR. (0-3) - INTEGER SHR,SMIN,SSEC - INTEGER SYY,UTDAY,STDAY - REAL*8 UT,ST,JD - REAL*4 RTPARR(0:9,0:3) !ARRAY WITH BASELINE (M) -C - INTEGER*2 DBH_T(2,2) !TRANSLATE DATA - DATA DBH_T/2,0,0,1/ -C - BYTE IHL(0:IHLHDL-1) !IH - INTEGER*2 IHLI(0:IHLHDL/2-1) - INTEGER IHLJ(0:IHLHDL/4-1) - REAL*4 IHLE(0:IHLHDL/4-1) - REAL*8 IHLD(0:IHLHDL/8-1) - EQUIVALENCE (IHL,IHLI,IHLJ,IHLE,IHLD) -C- -C -C INIT -C -C -C READ IFRS -C - NLEIRD=.TRUE. !ASSUME OK - DO I=0,STHJ(STH_NIFR_J)-1 !ALL INTERFEROMETERS - J=OFFINTF(I) !DISK POINTER IH - IF (.NOT.WNFRD(INFCA,IHLHDL,IHL,J)) THEN !READ IH BLOCK - CALL WNCTXT(F_TP,'!/Read error IH block #!UJ (INTF. #!UJ) (!XJ)', - 1 J,I,E_C) - GOTO 10 !NEXT - END IF - IF (IBMSW) CALL WNTTIL(IHLHDL,IHL,IHL_T) !TRANSLATE - IF (DECSW) CALL WNTTDL(IHLHDL,IHL,IHL_T) -C -C FILL SET HEADER WHEN FIRST IH READ -C - IF (I.EQ.0) THEN -C SAVE SOME STUFF FOR NLEILU - DIPOLE=IHL(IHL_CHINFO_B+1) - OBSDATE=IHLJ(IHL_SDAY_J) - OBSSTART=IHLD(IHL_STIM_D) - OBSEND=IHLD(IHL_ETIM_D) - OLSYS=IHL(IHL_OLSYS_B) - CALL WNGMV(3,IHL(IHL_PRNAME_1),PRNAME) !PROJECT SCIENTIST - CALL WNGMV(16,IHL(IHL_FIELD_1),FIELD) !FIELD NAME -C - STHJ(STH_DIPC_J)=0 !DIPOLE SETTING - I1=IHL(IHL_CHINFO_B+1) - DO I2=0,STHTEL-1 - IF (I2.LT.10) THEN !WEST TEL. - STHJ(STH_DIPC_J)=STHJ(STH_DIPC_J)+ISHFT(I1/4,2*I2) - ELSE !EAST TEL - STHJ(STH_DIPC_J)=STHJ(STH_DIPC_J)+ISHFT(MOD(I1,4),2*I2) - END IF - END DO - STHI(STH_PLN_I)=4 !# OF POLARISATIONS - CALL WNGMV(STH_FIELD_N,IHL(IHL_FIELD_1),STH(STH_FIELD_1)) !FIELD NAME - STHD(STH_RA_D)=IHLD(IHL_RA1_D)/360. !OBS. RA - STHD(STH_DEC_D)=IHLD(IHL_DEC1_D)/360. !Obs. DEC - STHD(STH_RAE_D)=IHLD(IHL_RA1_D)/360. !RA EPOCH - STHD(STH_DECE_D)=IHLD(IHL_DEC1_D)/360. !DEC EPOCH - STHE(STH_BAND_E)=IHLD(IHL_BAND_D) !BANDWIDTH - STHE(STH_EPO_E)=1950. !EPOCH - STHD(STH_UTST_D)=1.002737909265 !CONVERSION UT/ST DAY LENGTH - SYY=INT(IHLJ(IHL_SDAY_J)/1000) !YEAR - STDAY=IHLJ(IHL_SDAY_J)-(SYY*1000) !DAYNR - SYY=SYY+1900 - ST=IHLD(IHL_STIM_D)/86400. !TIME in fractions - CALL WNGU2S (-1,SYY,UTDAY,UT,STDAY,ST) !ST to UT - STHI(STH_OBS_I+1)=SYY-1900 !YEAR - STHI(STH_OBS_I)=UTDAY !DAY - STHD(STH_MJD_D)=INT(STHI(STH_OBS_I+1)*365.25+0.1)+ - 1 STHI(STH_OBS_I)+24150. !MJD AT 0HR UT - STHE(STH_OEP_E)=(STHD(STH_MJD_D)-24150.)/365.25+1900. !OBS. DATE IN JUL. - STHD(STH_FRQ_D)=IHLD(IHL_FREQ_D) !APP. FREQUENCY - STHD(STH_FRQE_D)=STHD(STH_FRQ_D) !LSR. FREQUENCY - STHD(STH_FRQC_D)=STHD(STH_FRQ_D) !REF. FREQUENCY - STHJ(STH_SCN_J)=IHLI(IHL_NDATP_I) !# OF SCANS - STHE(STH_HAB_E)=IHLE(IHL_HAB_E)/360. !START HA - STHE(STH_HAI_E)=IHLE(IHL_DHA_E)/360. !HA-INCR. - CALL WNGJUL (1,SYY,UTDAY,UT,JD) !UT to JD - MJDHA0=JD-2415020D0-0.5D0 !MJD MIDDLE OBS. - D0=IHLD(IHL_STIM_D)/360.D0/24D0 !START TIME - IF (D0.GT.MOD(MJDHA0,1D0)) !PREVIOUS DAY - 1 MJDHA0=MJDHA0-1D0 - MJDHA0=MJDHA0-MOD(MJDHA0,1D0)+D0 !MJD START TIME - MJDHA0=MJDHA0-(STHE(STH_HAB_E)-5D0/3600D0/24D0) !MJD AT HA0 - UT=UT*86400. !UT IN SEC. - SHR=INT(UT/(60.*60.)) - SMIN=INT((UT-(SHR*(60.*60.)))/60.) - SSEC=UT-(SHR*(60.*60.))-(SMIN*60.) - IF (SYY.EQ.1936) SYY=1973 - IF (SYY.LT.1980) THEN - STHJ(STH_VNR_J)=-(((SYY-1970)*1000000)+ - 1 (STHI(STH_OBS_I)*24*60)+(SHR*60)+SMIN) - ELSE -C For observation from 1980 until max. 1984 we will split the seq.number -C The numbers will put in the free sections for the 1970-1979 area. -C (E.g 1971 only uses -1000000 to -1530000, -C so part of 1981 will use -1600000 to -1999999 from the 1971 part -C and -6600000 to -6999999 from the 1976-part) - I2=SYY-1980 - I3=(STHI(STH_OBS_I)*24*60)+(SHR*60)+SMIN - IF (I3.LT.250000) THEN - STHJ(STH_VNR_J)=-(((SYY-1980)*1000000)+600000+I3) - ELSE - STHJ(STH_VNR_J)=-(((SYY-1980)*1000000)+5350000+I3) - END IF - END IF - END IF - IPOL=MOD(I,4) - OTEL=INT(I/40)+10 - WTEL=INT((I-INT(I/40*40))/4) - HABOFF=(IHLE(IHL_HAB_E)/IHLE(IHL_DHA_E))*240. !HA-START IN SEC - BINT=IHLE(IHL_DHA_E)*240. !INTEGRATION TIME IN SEC -C -C DETERMINE STEPS -C - NS(-3)=0 !START INTEGRATION OFFSET - NS(0)=1 !INPUT INTEGRATION POINTS - NS(-1)=IHLI(IHL_NDATP_I) !INPUT DATA POINTS - NS(1)=1 !OUTPUT INTEGRATION POINTS - NS(-2)=NS(-1)*NS(0) - NS(3)=NS(-2) - IF (NS(-2)-NS(-3).LT.NS(1)) THEN !INTEGRATION TOO LONG - CALL WNCTXT(F_TP,'Dwell time (!UJ s) less than '// - 1 'integration time (!UJ s)', - 2 (NS(-2)-NS(-3))*BINT,NS(1)*BINT) - GOTO 900 - END IF - NS(2)=NS(-1)/(NS(-2)/NS(0)) !# OF SUBSETS - NS(4)=(NS(-2)-NS(-3))/NS(1) !# OUTPUT DWELL POINTS - NS(5)=NS(2)*NS(4) !# OUTPUT DATAPOINTS - NS(6)=0 !TMP DISK POINTER - HAB=IHLE(IHL_HAB_E) !START HA -C -C READ/CHECK DATA -C - IF (.NOT.WNFRD(INFCA,NS(-1)*4,DBUF,J+160)) THEN !READ DB BLOCK - CALL WNCTXT(F_TP,'!/Read error DB block INTF. #!UJ (!XJ)', - 1 I,E_C) - GOTO 10 !NEXT - END IF - DBH_T(2,1)=NS(-1)*2 !# OF POINTS TO CONVERT - IF (IBMSW) CALL WNTTIL(NS(-1)*4,DBUF,DBH_T) !TRANSLATE - IF (DECSW) CALL WNTTDL(NS(-1)*4,DBUF,DBH_T) - IF (ONS(1).LT.0) THEN !NEW CHANNEL - DO I1=1,6 - ONS(I1)=NS(I1) !SAVE DATE - END DO - OHAB=HAB - ELSE - DO I1=1,5 - IF (ONS(I1).NE.NS(I1)) THEN !FORMAT ERROR - IF (I1.EQ.3 .AND. NS(2).EQ.1) THEN !ACCEPT WRONG OBS. LENGTH - ELSE -CC 20 CALL WNCTXT(F_TP, -CC 1 '!/Format error DB block #!UJ, interferometer !1$XJ!1$XJ', -CC 1 J,WTEL,OTEL) - GOTO 10 !NEXT - END IF - END IF - END DO -C Check for correct HAB; a margin of .1 sec is accepted to account for precision -C effects on different machines; the corresponding rotation of 1.15E-6 circles -C is acceptable (Email WNB to JPH, 931214) -C IF (ABS(OHAB-HAB).GE.0.1E0/24./3600.) GOTO 20 - END IF -C -C MAKE entry for this polarisation and ifr in temporary IFR TABLE -C - DO I1=0,NIFR-1 !CHECK PRESENCE - IF (IFRT(1,I1).EQ.WTEL .AND. - 1 IFRT(2,I1).EQ.OTEL) THEN !FOUND - IFRT(3+IPOL,I1)=ONS(6)/NS(5)/6 !TMP LINE # - GOTO 30 - END IF - END DO - IFRT(1,NIFR)=WTEL !WEST TEL. - IFRT(2,NIFR)=OTEL !EAST TEL. - IF (IFRT(1,NIFR).GT.IFRT(2,NIFR)) GOTO 10 !FORGET INVERTED IFR - IF (IFRT(2,NIFR).GE.STHTEL) GOTO 10 !FORGET DUMMY INTERFEROMETERS - DO I2=3,6 !SET NO POL. - IFRT(I2,NIFR)=-1 - END DO - IFRT(3+IPOL,NIFR)=ONS(6)/NS(5)/6 !TMP LINE # - IFRT(7,NIFR)=NINT(IHLE(IHL_DRT_E)) !BASELINE - NIFR=NIFR+1 !COUNT # IFRS - RTPARR(WTEL,OTEL-10)=IHLE(IHL_DRT_E) !BASELINE - 30 CONTINUE -C -C MAKE OUTPUT BUFFER -C - R0=R0/4./NS(1) !FIT SCALE - DO I1=0,NS(2)-1 !SUBSETS - J1=I1*NS(-2)+NS(-3) !INPUT DATA PTR - J2=I1*NS(4) !OUTPUT BUF PTR - DO I2=0,NS(4)-1 !OUTPUT POINTS PER DWELL - N=0 - SUMC=0.0 - SUMS=0.0 -C - DO I3=0,NS(1)-1 !# OF 10 SEC OUTPUT INTEGRAT. - J3=J1/NS(0) !DATA POINT - IF (DBUF(1,J3).NE.IUND .AND. DBUF(2,J3).NE.IUND) THEN - SUMC=SUMC+DBUF(1,J3) !ADD - SUMS=SUMS+DBUF(2,J3) - N=N+1 - END IF - J1=J1+1 !NEXT 10 SEC - END DO - IF (N.EQ.NS(1)) THEN !OK POINT - TMPBUF(2,J2)=NINT(SUMC/N) !OUTPUT DATA - TMPBUF(3,J2)=NINT(SUMS/N) - TMPBUF(1,J2)=1 !ZERO WEIGHT - FWGT=1. !MAX. WEIGTH - ELSE - DO I3=1,3 - TMPBUF(I3,J2)=0 !ZERO WEIGHT - END DO - END IF - J2=J2+1 !NEXT OUTPUT PTR - END DO - END DO - IF (.NOT.WNFWR(FCAT,NS(5)*6,TMPBUF,ONS(6))) THEN !WRITE TO TMP - CALL WNCTXT(F_TP, - 1 '!/Write error TMP file, IH block #!UJ (Intf. #!UJ) (!XJ)', - 1 J,I,E_C) - GOTO 10 !NEXT - END IF - ONS(6)=ONS(6)+NS(5)*6 !NEXT OUTPUT PTR - 10 CONTINUE - END DO -C -C CALCULATE TELESCOPE POSITIONS, -C USING THE BASELINE-LENGTH SAVED IN RTPARR -C - STHE(STH_RTP_E)=0.0 !ASSUME TEL 0 AT POSITION 0 - DO I1=0,3 !EAST TEL. A - B - STHE(STH_RTP_E+I1+10)=RTPARR(0,I1) - DO I2=1,9 !WEST TEL. 0 - 9 - IF (RTPARR(I2,I1).NE.0.0) THEN !PRESENT - IF (STHE(STH_RTP_E+I2).EQ.0.0) THEN !EMPTY - STHE(STH_RTP_E+I2)=RTPARR(0,I1)-RTPARR(I2,I1) - ELSE !TEST IF ALMOST SAME POS. - IF ((ABS(STHE(STH_RTP_E+I2)-(RTPARR(0,I1)-RTPARR(I2,I1)))) - 1 .GT.1.) THEN - CALL WNCTXT(F_TP, - 1 '!/Telescope position !UJ differs from previous one', - 2 I2) - END IF - END IF - END IF - END DO - END DO -C - RETURN !READY -C -C ERROR FINISH -C - 900 CONTINUE - NLEIRD=.FALSE. -C - RETURN -C -C - END diff --git a/src/nscan/nleiwd.for b/src/nscan/nleiwd.for deleted file mode 100644 index 8dd0769252c892e214909cc273fad06a19ccfa53..0000000000000000000000000000000000000000 --- a/src/nscan/nleiwd.for +++ /dev/null @@ -1,280 +0,0 @@ -C+ NLEIWD.FOR -C HjV 950116 -C -C Revisions: -C - LOGICAL FUNCTION NLEIWD(FCAT,ONS,OHAB,NIFR,IFRT,POLS,BINT,STHM, - 1 MJDHA0,CJOB,BAND,FWGT,TMPBUF) -C -C Unload TMP file into SCN files -C -C Result: -C -C NLEIWD_J = NLEIWD( FCAT_J:I, -C ONS_J(6):I, OHAB_E:I, -C NIFR_J:I, IFRT_J(9,0:*):I, POLS_J(0:3):I, -C BINT_J:I, STHM_B(0:*):I, MJDHA0_D:I, CJOB_J:I, -C BAND_J:I, FWGT_E:I, TMPBUF_I(3,0:*):I) -C Read LEIDEN data from TMP file to FCAOUT. -C FCAT is the TMP file. -C ONS gives the integration data, OHAB the -C start HA of the output. -C ONS: 1 # of 10 sec per output point -C 2 # of subsets -C 3 time between radials in 10 sec units -C 4 # of points per subset -C 5 total output points per ifr -C 6 length of TMP file -C IFRT: 1 West telescope -C 2 East telescope -C 3 TMP line # XX -C 4 XY -C 5 YX -C 6 YY -C 7 baseline in m -C NIFR is the number of interferometers found, -C IFRT describes the interferometers. -C POLS indicates (if >0) polarisation to do. -C BINT is the basic time increment in s. -C STHM is a template set header. -C MJDHA0 is the MJD for HA=0 -C CJOB current job -C BAND the current band -C FWGT factor to limit weight < 256 -C TMPBUF is an input buffer -C -C Include files: -C - INCLUDE 'WNG_DEF' - INCLUDE 'NSC_DEF' - INCLUDE 'GFH_O_DEF' !GENERAL FILE HEADER - INCLUDE 'SCH_O_DEF' !SCAN HEADER - INCLUDE 'STH_O_DEF' !SET HEADER - INCLUDE 'SGH_O_DEF' !SUB-GROUP HEADER -C -C Parameters: -C -C -C Arguments: -C - INTEGER FCAT !TMP FILE DESCRIPTOR - INTEGER ONS(6) !INTEGRATION DATA - REAL OHAB !START HA - INTEGER NIFR !# OF IFRS FOUND - INTEGER IFRT(9,0:*) !IFR DESCRIPTION - INTEGER POLS(0:3) !POLARISATION TABLE - INTEGER BINT !BASIC TIME INCREMENT - BYTE STHM(0:*) !TEMPLATE SET HEADER - DOUBLE PRECISION MJDHA0 !MJD AT HA0 - INTEGER CJOB !CURRENT JOB - INTEGER BAND !CURRENT BAND NUMBER - REAL FWGT !FACTOR TO LIMIT WGTS TO < 256 - INTEGER*2 TMPBUF(0:2,0:MXDATX-1) !SORT BUFFER -C -C Function references: -C - REAL WNGENF !NORMALISE ANGLE - LOGICAL WNFRD !READ DATA - LOGICAL WNFWR !WRITE DATA - INTEGER WNFEOF !CURRENT EOF POINTER - LOGICAL WNDLNK !LINK A SET - LOGICAL WNDLNG,WNDLNF !LINK A SUB-GROUP -C -C Data declarations: -C - INTEGER TMPF,TMPL !1ST AND LAST POINT/LINE IN TMP - INTEGER TMPS !# OF POINTS/LINE IN TMP BUF - INTEGER*2 ODBUF(0:2,0:4*MXNIFR-1) !OUTPUT DATA BUF - INTEGER IFRTS(9,0:MXNIFR-1) !SORTED IFR DATA - BYTE IFRTP(0:MXNIFR-1) !POL. IFR PRESENCE - REAL MX !FOR MAX. CALCULATION - INTEGER IFRP !POINTER TO IFR TABLE - INTEGER*2 IFRS(0:MXNIFR-1) !COMPRESSED IFR TABLE -C - BYTE STH(0:STHHDL-1) !SET HEADER - INTEGER*2 STHI(0:STHHDL/2-1) - INTEGER STHJ(0:STHHDL/4-1) - REAL STHE(0:STHHDL/4-1) - REAL*8 STHD(0:STHHDL/8-1) - EQUIVALENCE (STH,STHI,STHJ,STHE,STHD) -C - BYTE SCH(0:SCHHDL-1) !SCAN HEADER - INTEGER*2 SCHI(0:SCHHDL/2-1) - INTEGER SCHJ(0:SCHHDL/4-1) - REAL SCHE(0:SCHHDL/4-1) - REAL*8 SCHD(0:SCHHDL/8-1) - EQUIVALENCE (SCH,SCHI,SCHJ,SCHE,SCHD) - INTEGER NL1 -C- -C -C INIT -C - NLEIWD=.TRUE. !ASSUME OK - DO I=0,NIFR-1 !COPY IFRT - DO I1=1,9 - IFRTS(I1,I)=IFRT(I1,I) - END DO - END DO - DO I=0,NIFR-2 !SORT IFR ON BASELINE - DO I1=0,NIFR-2-I - IF (IFRTS(7,I1).GT.IFRTS(7,I1+1)) THEN !MOVE ENTRY - DO I2=1,9 - J=IFRTS(I2,I1) - IFRTS(I2,I1)=IFRTS(I2,I1+1) - IFRTS(I2,I1+1)=J - END DO - END IF - END DO - END DO - DO I=0,NIFR-1 !MAKE IFR OUTPUT TABLE - IFRS(I)=IFRTS(1,I)+256*IFRTS(2,I) - END DO - IFRP=WNFEOF(FCAOUT) !POINTER TO IFR TABLE - IF (.NOT.WNFWR(FCAOUT,NIFR*LB_I,IFRS(0),IFRP)) GOTO 10 !WRITE IT - DO I=0,3 !MAKE POL. PRESENCE - DO I1=0,NIFR-1 - IF (POLS(I).GT.0 .AND. IFRTS(3+I,I1).NE.-1) THEN !PRESENT - IFRTP(I1)=1 - ELSE !NOT PRESENT - IFRTP(I1)=0 - END IF - END DO - IF (.NOT.WNFWR(FCAOUT,NIFR,IFRTP(0),IFRP+NIFR*(I+LB_I))) - 1 GOTO 10 !WRITE TABLE - END DO -C -C Fill final fields in Sector header, link subgroup -C - NL1=ONS(6)/ONS(5)/6 !# OF LINES IN TMP - TMPL=0 !LAST+1 POINT IN TMP - DO I=0,ONS(2)-1 !ALL SUBSETS - CALL WNGMV(STHHDL,STHM(0),STH(0)) !MAKE SET HEADER - STHI(STH_CHAN_I)=BAND !SET BAND - IF (.NOT.WNDLNF(SGPH(2)+SGH_LINKG_1,BAND,SGH_GROUPN_1,FCAOUT, - 1 SGPH(3),SGNR(3))) GOTO 31 !LINK SUB-GROUP CHANNEL - CALL WNCTXT(F_TP,'!7C\Ch. !3$UJ: !UJ\.!UJ\.!UJ\.!UJ'// - 1 '!32C\F= !10$D15.5 B= !10$E15.5', - 1 BAND,SGNR(0),SGNR(1),SGNR(2),SGNR(3), - 1 STHD(STH_FRQE_D),STHE(STH_BAND_E)) !SHOW BAND - STHE(STH_HAV_E)=STHE(STH_HAI_E) !AVER. HA - R0=WNGENF(STHE(STH_HAB_E)) !START HA - STHD(STH_MJD_D)=MJDHA0+R0/STHD(STH_UTST_D) !START MJD - STHJ(STH_SCN_J)=ONS(4) !# OF SCANS/SUBSET - STHJ(STH_NIFR_J)=NIFR !# OF IFRS - STHJ(STH_IFRP_J)=IFRP !POINTER TO IFR TABLE - STHJ(STH_SCNL_J)=SCHHDL+6*NIFR*STHI(STH_PLN_I) !LENGTH SCAN - CALL NSCCLP(FCAOUT,STH(0),STHE(STH_PHI_E)) !GET PREC. ROT. ANGLE - STHE(STH_PHI_E)=STHE(STH_PHI_E)/PI2 !MAKE CIRCLES - J=WNFEOF(FCAOUT) !POINTER TO SET HEADER - IF (.NOT.WNFWR(FCAOUT,STHHDL,STH(0),J)) - 1 GOTO 10 !WRITE SET HEADER - IF (.NOT.WNDLNK(GFH_LINK_1,J, - 1 STH_SETN_1,FCAOUT)) GOTO 10 !LINK THE SET - IF (.NOT.WNDLNG(SGPH(3)+SGH_LINKG_1,J, - 1 SGH_GROUPN_1,FCAOUT,SGPH(4), - 1 SGNR(4))) THEN !LINK SUB-GROUP - 31 CONTINUE - CALL WNCTXT(F_TP,'!/Cannot link sub-group') - GOTO 900 !STOP - END IF - IF (.NOT.WNFRD(FCAOUT,STHHDL,STH(0),J)) - 1 GOTO 10 !REREAD SET HEADER - STHJ(STH_SCNP_J)=WNFEOF(FCAOUT) !POINTER TO DATA - IF (.NOT.WNFWR(FCAOUT,STHHDL,STH(0),J)) - 1 GOTO 10 !REWRITE SET HEADER -C -C Read scans from temp. file and sort them -C -C The temp. file contains a line for each interferometer. -C -C Each line has a series of output integrations: -C J loops over NS(2) subsets of NS(4) integrations -C I5 loops over NS(4) integrations within the subset. -C -C The total number of integrations is NS(5)=NS(2)*NS(4) -C -C Buffer TMPBUF holds for each interferometer (I2) a number of TMPS -C integrations, which is at most the full file (NS(6) bytes) or the -C remaining data not yet read (NS(4)*NS(2)-TMPF integrations). -C The number of the first integration is TMPF, the number of the next -C integration to read is TMPL. -C -C - J5=0 !SCAN COUNT IN SUBSET - J=I*ONS(4) !OFFSET SUBSET IN LINE - DO I5=0,ONS(4)-1 !OUTPUT SCANS -C -C Refresh buffer if needed -C - IF (J+I5.GE.TMPL) THEN !SCAN NOT IN TMP BUF - TMPF=J+I5 !FIRST POINT IN TMP BUF - TMPS=MIN(MIN(MXDATX,ONS(6)/6)/NL1, - 1 ONS(2)*ONS(4)-TMPF) !POINTS PER LINE - TMPL=TMPS+TMPF !FIRST POINT NOT IN TMP - DO I2=0,NL1-1 !READ ALL LINES - IF (.NOT.WNFRD(FCAT,6*TMPS,TMPBUF(0,I2*TMPS), - 1 6*(TMPF+I2*ONS(5)) )) THEN - CALL WNCTXT(F_TP,'!/Error reading TMP file') - GOTO 900 !STOP - END IF - END DO - END IF -C -C Fill in interferometers for this output scan -C - J3=0 !OUTPUT POINTER - MX=-1E30 !FIND MAX. - CALL WNGMVZ(SCHHDL,SCH(0)) !EMPTY SCAN HEADER - DO I2=0,NIFR-1 !OUTPUT A SCAN - DO I3=0,3 !ALL POLARISATIONS - IF (POLS(I3).GT.0) THEN !THIS POLARIZATION - IF (IFRTS(3+I3,I2).NE.-1) THEN !DATA SEEN - J4=IFRTS(3+I3,I2)*TMPS+J+I5-TMPF !INPUT DATA POINTER - DO I4=0,2 - ODBUF(I4,J3)=TMPBUF(I4,J4) - END DO - IF (ODBUF(0,J3).NE.0) THEN !DATA PRESENT - ODBUF(0,J3)=NINT(ODBUF(0,J3)*FWGT) !MAKE < 256 - IF (ODBUF(0,J3).LE.0) ODBUF(0,J3)=1 !VERY SMALL WEIGHT - MX=MAX(MX,ABS(FLOAT(ODBUF(1,J3)))) - MX=MAX(MX,ABS(FLOAT(ODBUF(2,J3)))) - END IF - ELSE !NO DATA - DO I4=0,2 - ODBUF(I4,J3)=0 - END DO - END IF - J3=J3+1 !CNT OUTPUT POINT - END IF - END DO - END DO - SCHE(SCH_MAX_E)=MX !SAVE MAX. - SCHE(SCH_HA_E)=STHE(STH_HAB_E)+J5*STHE(STH_HAI_E) !SET HA -C -C Write to disk -C - J4=WNFEOF(FCAOUT) !DISK OUTPUT PTR - IF (.NOT.WNFWR(FCAOUT,SCHHDL,SCH(0),J4)) GOTO 10 !OUTPUT SCAN HD. - IF (.NOT.WNFWR(FCAOUT,6*J3,ODBUF(0,0),J4+SCHHDL)) THEN !WRITE SCAN - 10 CONTINUE - CALL WNCTXT(F_TP,'!/Error writing output SCN file') - GOTO 900 !STOP - END IF - J5=J5+1 !COUNT SCAN - END DO !END SCANS - 30 CONTINUE - END DO !END SUBSET -C -C READY -C - RETURN !READY -C -C ERROR FINISH -C - 900 CONTINUE - NLEIWD=.FALSE. -C - RETURN -C -C - END diff --git a/src/nscan/nmo.dsc b/src/nscan/nmo.dsc deleted file mode 100644 index e954660827ac4a9881f22edfb473b53d2fba76e4..0000000000000000000000000000000000000000 --- a/src/nscan/nmo.dsc +++ /dev/null @@ -1,102 +0,0 @@ -!+ NMO.DSC -! WNB 900327 -! -! Revisions: -! -%REVISION=WNB=931008="Add beam mask" -%REVISION=WNB=931005="Add mask names" -%REVISION=JPH=930825="Comments" -%REVISION=WNB=930803="Remove .INCLUDE; use NSTAR.DSF" -%REVISION=WNB=930602="Add BEMLIM" -%REVISION=WNB=911007="Add instrum. polarisation" -%REVISION=WNB=910731="Add source find info" -%REVISION=WNB=900327="Original version" -! -! Layout of overall include file (NMO.DEF) -! -%COMMENT="NMO.DEF is an INCLUDE file for the NMODEL program" -%COMMENT=" " -! -%VERSION=1 -%SYSTEM=1 -%USER=WNB -%%DATE -%%NAME -! -! Get number of telescopes -! -%INCLUDE=NSTAR_DSF -! -%LOCAL=MDH=64 !Length MDH (see MDH.DSC) -%LOCAL=MXNSET=64 !Max. sets(maps) that can be done -%LOCAL=MXNAR=16 !Max. # of simultaneous areas -!- -.DEFINE - .PARAMETER - MXNSET J /MXNSET/ !MAX. # OF SETS/MAPS - MXNAR J /MXNAR/ !MAX. # OF SUB-AREAS - BEMLIM D /0.01/ !LOWEST BEAM VALUE USED - NMO M*: /USE,MERGE,ADD,SAVE,,,,,BAND,TIME,IPOL,BEAM/ !ACTION TYPES - NMO NF*:(NMO_USE+NMO_MER+NMO_ADD+NMO_SAV, \ - NMO_BAN+NMO_TIM+NMO_IPO+NMO_BEA) \ - /USAGE,SMEAR/ !MANIPULATE - .DATA -! -! Local variables: -! - .COMMON - ACTION C24 !PROGRAM ACTION - ACT=ACTION C3 - OPTION C24 !PROGRAM OPTION - OPT=OPTION C3 - FCAOUT J !OUTPUT FCB - FILOUT C160 !FILE NAME - NODOUT C80 !NODE NAME - FCAIN J !INPUT FCB - FILIN C160 !FILE NAME - NODIN C80 !NODE NAME -! -! The model headers are identical to those in the SCN file. They point to source -! lists that are allocated dynamically in core. The conventions for the use of -! the second index (the model "type", cf. NMOUP0) are: -! -1 "general header" -! 0 standard (=clean?) -! 1 extended sources -! 2 spectral index -! ... -! 7 use as scratch buffer (NMOMSG) - GMDH B(0:MDH-1,-1:7) !MODEL HEADERS - GMDHJ=GMDH J(0:MDH/LB_J-1,-1:7) - GMDHE=GMDH E(0:MDH/LB_E-1,-1:7) - GMDHD=GMDH D(0:MDH/LB_D-1,-1:7) -! - GDES=GMDH B(0:MDH-1) !GENERAL SOURCE DESCRIPTOR - GDESJ=GMDH J(0:MDH/LB_J-1) - GDESE=GMDH E(0:MDH/LB_E-1) - GDESD=GMDH D(0:MDH/LB_D-1) -! - NSRCM J /0/ !# OF LINES IN GDES - SORRAN E(0:1) /0,0/ !OFFSET FOR DISTANCE SORT - SORTYP J !SORT INCR.(-1)/DECR(1) - SOROFF J !OFFSET FOR SORT - MODACT J !ACTION ON SCAN: - ! 1= use, 2= merge, 4= add, - ! 8= save, 256= band, 512= time - ! 1024= instr.pol. - MAPLIM E !RELATIVE LIMIT OF SOURCE FIND - MAXSRN J !MAX. # OF SOURCES TO FIND - IDEN J !START ID FOR SOURCES FOUND - NAREA J !# OF AREAS FOUND - SETS J(0:7,0:MXNSET) !SETS/MAPS TO DO - FAREA J(0:3) !FULL MAP AREA - TAREA J(0:3,0:1) !TOTAL AREA (0=NORM, 1=EDGE) - PAREA J(0:3,MXNAR,0:1) !PARTIAL AREAS - SIFRS B(0:NSTAR_TEL-1,0:NSTAR_TEL-1) !SELECTED INTERFEROMETERS - SPOL J !SELECTED POLARISATIONS - NSRC J(0:2) !SOURCES TO USE - HARAN E(2) !HA RANGE - CORAP J !CORRECTIONS TO APPLY - CORDAP J !CORRECTIONS TO DE-APPLY - INPOL E(0:9,0:2,0:6) !INSTRUM. POL. - INPOLF E(0:6) /(7)0/ !FREQUENCY LIMITS -.END diff --git a/src/nscan/nmo.grp b/src/nscan/nmo.grp deleted file mode 100644 index d24ab803b6c5571db0c938819fa73a15b414b0ad..0000000000000000000000000000000000000000 --- a/src/nscan/nmo.grp +++ /dev/null @@ -1,156 +0,0 @@ -!+ NMO.GRP -! WNB 900327 -! -! Revisions: -! WNB 910809 Add PRM, HMT, HMF -! WNB 910809 Add WRI -! WNB 910814 Add BEM -! WNB 910909 Add ADC, DAY -! WNB 911230 Add NMOANC -! WNB 920107 Add NMOAM2 -! WNB 920113 Add PTI -! WNB 920626 Add NMOACD -! WNB 921202 Add NMOMUJ -! WNB 921208 Add NMORDA -! WNB 921211 Change PEF/PSC -! WNB 921217 Add NMOFNA -! WNB 930514 Add NMOFMD; make NMODEL.FSC -! WNB 930623 Remove NMOUPD6,7,8 -! WNB 930819 Change NMOMUM into NMOMU4 -! WNB 930825 Add NMOCIX,CXI -! WNB 930826 Add NMOCIY,CXX; BMD.DSC, NMOBMR,BMF,BMV -! WNB 930928 Split off NMOBMV -! WNB 931008 Remove NMOCV1 -! WNB 931011 Add NMOPRS -! HjV 940217 Add/change missing entry-points/functions -! HjV 940303 Add NMODAV, NMODAW -! CMV 940428 Add NMONAM and NMONM1 -! WNB 950628 Add MDU.DSC; remove PRX,S,P,E -! AXC 010628 linux port -! -! Model handling -! -! Group definition: -! -NMO.GRP -! -! PIN files -! -NMODEL.PEF !General include file -NMODEL.PSC -! -! Structure files -! -MDH.DSC ! Model header -MDL.DSC ! Model line -MDU.DSC ! Model update area -BMD.DSC ! Beam values -! -! Fortran definition files: -! -NMO.DSC ! Program common/parameters -! -! Programs: -! -NMODEL.FSC ! Main routine -NMOADD.FOR !NMOADD Add a source - !NMOAED Edit a source - !NMOADL Delete sources - !NMOANC Delete non-clean low-level - !NMOACD Delete clean low-level - !NMOAMG Merge sources - !NMOAM1 Merge sources - !NMOAM2 Merge sources - !NMOAFB Edit B field - !NMOAFJ Edit J field - !NMOAFE Edit E field - !NMOADC Calibrate source list - !NMOAAD Delete sources in area -NMOBEM.FOR !NMOBEM Correct model for beam - !NMOBED De-correct model for beam -NMOBMF.FOR !NMOBMF Get range and beam for instrument -NMOBMR.FOR !NMOBMR Read beam values from user -NMOBMV.FOR !NMOBMV Get beam value for l,m,freq -NMOCVS.FOR !NMOCVS Convert source list format -NMOCIX.FOR !NMOCIX Convert Stokes to XYX - !NMOCIY Convert Stokes to XYX and average -NMOCXI.FOR !NMOCXI Convert XYX to Stokes - !NMOCXX Convert XYX to wanted -NMOCVT.FOR !NMOCVT Convert source list format -NMOCVX.FOR !NMOCVX Convert VAX to local format -NMODAT.FOR !NMODAT Get program data - !NMODAW Get program data for handle - !NMODAV As NMODAV and test 'unknown-flux' bit - !NMODAX External call for handle options - !NMODAY Call for possible output -NMOEXT.FOR !NMOEXF From external to internal format - !NMOEXT From internal to external format -NMOFMD.FOR !NMOFMD Get manually sources in map -NMOFND.FOR !NMOFND Find pos. sources in map - !NMOFNA Find pos/neg sources -NMOGSH.FOR !NMOGSH Copy general source header -NMOHED.FOR !NMOHCD Clear data part header - !NMOHMD Move data part header - !NMOHZD Clear data and # of sources - !NMOHMF Move from a general header to a local - !NMOHMT Move from local to general header -NMOINI.FOR !NMOINI Init program -NMOMSC.FOR !NMOMSC Calculate model in scan - !NMOMSL Calculate model with scan offsets -NMOMSG.FOR !NMOMSG Get model from scan file -NMOMSS.FOR !NMOMSS Set model data in scan file -NMOMST.FOR !NMOMST Get set related constants -NMOMU4.FOR !NMOMU4 Calculate model fringes for 4 pol. -NMOMUC.FOR !NMOMUC Calculate model fringes - !NMOMU1 Calculate model fringes one source - !NMOMUA Calculate additive model fringes -NMOMUI.FOR !NMOMUI Get model action for scan save - !NMOMUJ Specify model action for scan save -NMOMUP.FOR !NMOMUP Prepare model list for scan handling -NMOMUV.FOR !NMOMUV Get UV coordinates for model calculation -NMONAM.FOR !NMONAM Find proper name for model component - !NMONM1 Initialise name-list -NMONVS.FOR !NMONVS Make newest version of model file -NMOOFR.FSC !NMOOFR Convert from old format -NMOOTO.FOR !NMOOTO Convert to old format -NMOPRT.FOR !NMOPRT Print source list - !NMOPRR Print source list in RA/DEC format - !NMOPTT Print totals from source list - !NMOPTI Print totals from local list - !NMOPRU Print source list with updates - !NMOPRM Print sources from specified model -NMORDS.FOR !NMORDS Read source list from node - !NMORDD Determine difference between lists - !NMORDX Read source list - !NMORDM Add source lists - !NMORDA Add source lists - !NMORDC Copy source list - !NMORDZ Empty source list - !NMORDH Get some header data -NMOSLI.FOR !NMOSLI Get general source list - !NMOSLG Get a source list - !NMOSLD Delete a source list -NMOSRT.FOR !NMOSRT Sort model -NMOSR0.FOR !NMOSR0 Sort compare intensity - !NMOSR1 l,m - !NMOSR2 J field - !NMOSR3 E field - !NMOSR4 B field - !NMOSR5 distance - !NMOSR6 l,m - !NMOSR7 m,l - !NMOSR8 polarisation -NMOUPD.FOR !NMOUPD Update source flux/position -NMOUP0.FOR !NMOUP0 Init. update LSQ - !NMOUP1 Make update equations - !NMOUP2 Solve update - !NMOUP3 Show results - !NMOUP9 Clear LSQ data update -NMOWRI.FOR !NMOWRI Write source file -NMOWRS.FOR !NMOWRS Write source file - !NMOWRX Write external source file -! -! Executables -! -NMODEL.EXE ! Scan handling -!- diff --git a/src/nscan/nmoadd.for b/src/nscan/nmoadd.for deleted file mode 100644 index edd1147676529afbdd0c1a5ac4c21b50e1aaaa4a..0000000000000000000000000000000000000000 --- a/src/nscan/nmoadd.for +++ /dev/null @@ -1,565 +0,0 @@ -C+ NMOADD.FOR -C WNB 900827 -C -C Revisions: -C WNB 910909 Add NMOADC -C WNB 911230 Add NMOANC -C WNB 920107 Add NMOAM2 -C WNB 920109 Change NMOANC definition -C WNB 920626 Add NMOACD -C WNB 920818 Add NMOAAD -C WNB 931005 Change L_, text -C CMV 941118 Correct bug in NMOADC if SOURCE_LIST given -C JEN 960403 Add NMOAMR: merge sources within radius -C JEN 960404 remove bug: merge did not affect Q,U,V -C - SUBROUTINE NMOADD -C -C Add a source to model -C -C Result: -C -C CALL NMOADD will add a source to the general list -C CALL NMOAED will edit a source -C CALL NMOADL will delete sources -C CALL NMOANC will delete low-level non-clean components -C CALL NMOACD will delete low-level clean components -C CALL NMOAAD will delete sources in area -C CALL NMOAMG will merge sources -C CALL NMOAMR will merge sources within given area -C CALL NMOAM1( IDX_J:I) will merge sources in header # IDX -C CALL NMOAM2( IDX_J:I, NST_J:I, NND_:I) -C will merge sources in header # IDX between -C NST and NND -C CALL NMOAFB( OFF_J:I) will edit B field at offset OFF -C CALL NMOAFJ( OFF_J:I) will edit J field at offset OFF -C CALL NMOAFE( OFF_J:I) will edit E field at offset OFF -C CALL NMOADC wIll calibrate sources -C -C PIN references -C -C SOURCE -C SOURCE_NUMBER -C SOURCE_LIST -C SOURCE_RANGE -C SOURCE_FACTORS -C DELETE_LEVEL -C MERGE_RADIUS -C -C Include files: -C - INCLUDE 'WNG_DEF' - INCLUDE 'NMO_DEF' - INCLUDE 'MDH_O_DEF' !MODEL HEADER - INCLUDE 'MDL_O_DEF' !MODEL LINE -C -C Entries: -C -C -C Parameters: -C - INTEGER MXSRCL !LENGTH SOURCE LIST - PARAMETER (MXSRCL=128) -C -C Arguments: -C - INTEGER IDX !HEADER INDEX - INTEGER OFF !MODEL LIST OFFSET - INTEGER NST,NND !START/END SOURCES -C -C Function references: -C - LOGICAL WNDPAR !GET USER DATA - LOGICAL NMOSLI !GET GENERAL SOURCE LIST -C -C Data declarations: -C - BYTE MDL(0:MDLHDL-1) !MODEL LINE - INTEGER MDLJ(0:MDLHDL/4-1) - REAL MDLE(0:MDLHDL/4-1) - EQUIVALENCE (MDL,MDLJ,MDLE) - LOGICAL LEDI !EDIT (OR ADD) - INTEGER SRCL(0:MXSRCL) !SOURCE LIST TO DO - INTEGER FTYP !TYPE - INTEGER LIDX !LOCAL HEADER INDEX - REAL SFAC(0:3) !CALIBRATION FACTORS - REAL MERAD(0:1) !MERGE RADII (dl,dm) - REAL MERADFLT(0:1) !MERAD default - REAL DEC0,FRQ0 !Used in merge - REAL MAXDL,MAXDM !Used in merge -C- - LEDI=.FALSE. !SET ADD - GOTO 10 -C -C EDIT -C - ENTRY NMOAED -C - LEDI=.TRUE. - GOTO 10 -C -C INIT -C - 10 CONTINUE - IF (GDESJ(MDH_NSRC_J).GE.GDESJ(MDH_MODL_J)) THEN !ENOUGH SPACE? - IF (.NOT.NMOSLI(GDESJ(MDH_MODL_J)+100)) THEN !NO ADD - CALL WNCTXT(F_TP,'Error getting source area') - CALL WNCTXT(F_TP,'Source not added/edited') -C - RETURN - END IF - END IF -C -C ADD SOURCES -C - CALL WNGMVZ(MDLHDL,MDL) !EMPTY LINE - MDLE(MDL_ID_J)=GDESJ(MDH_NSRC_J)+1 !NEW ID - IF (LEDI) THEN !EDIT - IF (.NOT.WNDPAR('SOURCE_NUMBER',J,LB_J, - 1 J0,'""')) THEN !GET SOURCE TO EDIT - IF (E_C.EQ.DWC_ENDOFLOOP) RETURN !READY - GOTO 10 !RETRY - ELSE IF (E_C.EQ.DWC_NULLVALUE) THEN !"" - RETURN - ELSE IF (E_C.EQ.DWC_WILDCARD) THEN - RETURN - END IF - IF (J.LT.0 .OR. J.GT.GDESJ(MDH_NSRC_J)) GOTO 10 !NO SUCH SOURCE - CALL WNGMV(MDLHDL,A_B(GDESJ(MDH_MODP_J)+ - 1 (J-1)*MDLHDL-A_OB),MDL) !GET MODEL - CALL NMOEXT(MDL) !EXTERNAL FORMAT - MDLE(MDL_ID_J)=MDLJ(MDL_ID_J) !TRANSLATE ID - END IF - IF (.NOT.WNDPAR('SOURCE',MDLE,MDLHDL,J0,A_B(-A_OB), - 1 MDLE,13)) THEN !GET SOURCE - IF (E_C.EQ.DWC_ENDOFLOOP) RETURN !READY - GOTO 10 !RETRY - ELSE IF (E_C.EQ.DWC_NULLVALUE) THEN !"" - RETURN - ELSE IF (E_C.EQ.DWC_WILDCARD) THEN - RETURN - END IF - IF (MDLE(MDL_I_E).EQ.0) THEN - IF (LEDI) THEN !EDIT - ELSE !ADD - RETURN !READY - END IF - END IF - MDLJ(MDL_ID_J)=NINT(MOD(MDLE(MDL_ID_J),100000.)) !ID - IF (MDLJ(MDL_ID_J).EQ.0) THEN - IF (LEDI) THEN !EDIT - MDLJ(MDL_ID_J)=J !NEW ID - ELSE !ADD - MDLJ(MDL_ID_J)=GDESJ(MDH_NSRC_J)+1 !NEW ID - END IF - END IF - CALL NMOEXF(MDL) !CONVERT FORMAT - IF (LEDI) THEN !EDIT - CALL WNGMV(MDLHDL,MDL,A_B(GDESJ(MDH_MODP_J)+MDLHDL*(J-1)- - 1 A_OB)) !SAVE SOURCE - ELSE !ADD - CALL WNGMV(MDLHDL,MDL,A_B(GDESJ(MDH_MODP_J)+MDLHDL* - 1 GDESJ(MDH_NSRC_J)-A_OB)) !SAVE SOURCE - GDESJ(MDH_NSRC_J)=GDESJ(MDH_NSRC_J)+1 !COUNT - END IF -C - GOTO 10 !SEE IF MORE -C -C DELETE -C - ENTRY NMOADL -C - 20 CONTINUE - SRCL(0)=0 !ASSUME LIST - IF (.NOT.WNDPAR('SOURCE_LIST',SRCL(1),MXSRCL*LB_J,J0, - 1 '*')) THEN !GET TO DELETE - IF (E_C.EQ.DWC_ENDOFLOOP) RETURN !READY - GOTO 20 !RETRY - ELSE IF (E_C.EQ.DWC_NULLVALUE) THEN !"" - RETURN - ELSE IF (E_C.EQ.DWC_WILDCARD) THEN - IF (.NOT.WNDPAR('SOURCE_RANGE',SRCL(1),2*LB_J,J0, - 1 '""')) THEN !GET TO DELETE - IF (E_C.EQ.DWC_ENDOFLOOP) RETURN !READY - GOTO 20 !RETRY - ELSE IF (E_C.EQ.DWC_NULLVALUE) THEN !"" - RETURN - ELSE IF (E_C.EQ.DWC_WILDCARD) THEN - SRCL(1)=1 !RANGE - SRCL(2)=GDESJ(MDH_NSRC_J) - END IF - IF (J0.EQ.1) SRCL(2)=SRCL(1) !LIMIT RANGE - SRCL(0)=-1 !INDICATE RANGE - END IF - IF (SRCL(0).GE.0) THEN !LIST - DO I=1,J0 !DELETE SOURCES - J=SRCL(I) !TO DO - IF (J.GT.0 .AND. J.LE.GDESJ(MDH_NSRC_J)) THEN !CAN DO - CALL WNGMVZ(MDLHDL,A_B(GDESJ(MDH_MODP_J)+ - 1 (J-1)*MDLHDL-A_OB)) !DELETE - END IF - END DO - ELSE !RANGE - DO J=SRCL(1),SRCL(2) !DELETE SOURCES - IF (J.GT.0 .AND. J.LE.GDESJ(MDH_NSRC_J)) THEN !CAN DO - CALL WNGMVZ(MDLHDL,A_B(GDESJ(MDH_MODP_J)+ - 1 (J-1)*MDLHDL-A_OB)) !DELETE - END IF - END DO - END IF - GOTO 20 !MORE? -C -C DELETE LOW LEVEL NON-CLEAN -C - ENTRY NMOANC -C - 60 CONTINUE - IF (.NOT.WNDPAR('DELETE_LEVEL',SFAC(0),LB_E,J0, - 1 '0.')) THEN !GET DELETE VALUE - IF (E_C.EQ.DWC_ENDOFLOOP) RETURN !READY - GOTO 60 !RETRY - ELSE IF (E_C.EQ.DWC_NULLVALUE) THEN !"" - RETURN - ELSE IF (E_C.EQ.DWC_WILDCARD) THEN - GOTO 60 !RETRY - END IF - DO J=1,GDESJ(MDH_NSRC_J) !ALL SOURCES - CALL WNGMV(MDLHDL,A_B(GDESJ(MDH_MODP_J)+ - 1 (J-1)*MDLHDL-A_OB),MDL) !GET SOURCE - J1=MDL(MDL_TP_B) !CLEAN TYPE - IF (IAND(MDLCLN_M,J1).EQ.0 .AND. MDLE(MDL_I_E).LT.SFAC(0)) THEN !DELETE - CALL WNGMVZ(MDLHDL,A_B(GDESJ(MDH_MODP_J)+ - 1 (J-1)*MDLHDL-A_OB)) !DELETE - END IF - END DO -C - RETURN -C -C DELETE LOW LEVEL CLEAN -C - ENTRY NMOACD -C - 70 CONTINUE - IF (.NOT.WNDPAR('DELETE_LEVEL',SFAC(0),LB_E,J0, - 1 '0.')) THEN !GET DELETE VALUE - IF (E_C.EQ.DWC_ENDOFLOOP) RETURN !READY - GOTO 70 !RETRY - ELSE IF (E_C.EQ.DWC_NULLVALUE) THEN !"" - RETURN - ELSE IF (E_C.EQ.DWC_WILDCARD) THEN - GOTO 70 !RETRY - END IF - DO J=1,GDESJ(MDH_NSRC_J) !ALL SOURCES - CALL WNGMV(MDLHDL,A_B(GDESJ(MDH_MODP_J)+ - 1 (J-1)*MDLHDL-A_OB),MDL) !GET SOURCE - J1=MDL(MDL_TP_B) !CLEAN TYPE - IF (IAND(MDLCLN_M,J1).NE.0 .AND. MDLE(MDL_I_E).LT.SFAC(0)) THEN !DELETE - CALL WNGMVZ(MDLHDL,A_B(GDESJ(MDH_MODP_J)+ - 1 (J-1)*MDLHDL-A_OB)) !DELETE - END IF - END DO -C - RETURN -C -C DELETE SOURCES IN AREA -C - ENTRY NMOAAD -C - 80 CONTINUE - IF (.NOT.WNDPAR('DELETE_AREA',SFAC(0),4*LB_E,J0, - 1 '0.,0.,0.,0.')) THEN !GET DELETE AREA - IF (E_C.EQ.DWC_ENDOFLOOP) RETURN !READY - GOTO 80 !RETRY - ELSE IF (E_C.EQ.DWC_NULLVALUE) THEN !"" - RETURN - ELSE IF (E_C.EQ.DWC_WILDCARD) THEN - GOTO 80 !RETRY - END IF - DO J=1,GDESJ(MDH_NSRC_J) !ALL SOURCES - CALL WNGMV(MDLHDL,A_B(GDESJ(MDH_MODP_J)+ - 1 (J-1)*MDLHDL-A_OB),MDL) !GET SOURCE - CALL NMOEXT(MDL) !EXTERNAL FORMAT - IF ((MDLE(MDL_L_E).GT.SFAC(0)-0.5*SFAC(2) .AND. - 1 MDLE(MDL_L_E).LT.SFAC(0)+0.5*SFAC(2)) .AND. - 1 (MDLE(MDL_M_E).GT.SFAC(1)-0.5*SFAC(3) .AND. - 1 MDLE(MDL_M_E).LT.SFAC(1)+0.5*SFAC(3))) THEN ! DELETE - CALL WNGMVZ(MDLHDL,A_B(GDESJ(MDH_MODP_J)+ - 1 (J-1)*MDLHDL-A_OB)) !DELETE - END IF - END DO -C - RETURN -C -C CALIBRATE -C - ENTRY NMOADC -C - SFAC(0)=1. !ASSUME NO FACTORS - SFAC(1)=0 - SFAC(2)=0 - 50 CONTINUE - SRCL(0)=0 !ASSUME LIST - IF (.NOT.WNDPAR('SOURCE_LIST',SRCL(1),MXSRCL*LB_J,J0, - 1 '*')) THEN !GET TO CALIBRATE - IF (E_C.EQ.DWC_ENDOFLOOP) RETURN !READY - GOTO 50 !RETRY - ELSE IF (E_C.EQ.DWC_NULLVALUE) THEN !"" - RETURN - ELSE IF (E_C.EQ.DWC_WILDCARD) THEN - IF (.NOT.WNDPAR('SOURCE_RANGE',SRCL(1),2*LB_J,J0, - 1 '""')) THEN !GET TO CALIBRATE - IF (E_C.EQ.DWC_ENDOFLOOP) RETURN !READY - GOTO 50 !RETRY - ELSE IF (E_C.EQ.DWC_NULLVALUE) THEN !"" - RETURN - ELSE IF (E_C.EQ.DWC_WILDCARD) THEN - SRCL(1)=1 !RANGE - SRCL(2)=GDESJ(MDH_NSRC_J) - END IF - IF (J0.EQ.1) SRCL(2)=SRCL(1) !LIMIT RANGE - SRCL(0)=-1 !INDICATE RANGE - END IF - 51 CONTINUE - IF (.NOT.WNDPAR('SOURCE_FACTORS',SFAC,3*LB_E,J1, - 1 A_B(-A_OB),SFAC,3)) GOTO 50 !GET FACTORS - IF (E_C.EQ.DWC_NULLVALUE) RETURN !READY - IF (E_C.EQ.DWC_WILDCARD) GOTO 51 !MUST SPECIFY - IF (SRCL(0).GE.0) THEN !LIST - DO I=1,J0 !CALIBRATE SOURCES - J=SRCL(I) !TO DO - IF (J.GT.0 .AND. J.LE.GDESJ(MDH_NSRC_J)) THEN !CAN DO - CALL WNGMV(MDLHDL,A_B(GDESJ(MDH_MODP_J)+ - 1 (J-1)*MDLHDL-A_OB),MDL) !GET MODEL LINE - CALL NMOEXT(MDL) !MAKE EXTERNAL FORMAT - MDLE(MDL_I_E)=SFAC(0)*MDLE(MDL_I_E) !CALIBRATE AMPLITUDE - MDLE(MDL_L_E)=SFAC(1)+MDLE(MDL_L_E) !CALIB. L - MDLE(MDL_M_E)=SFAC(2)+MDLE(MDL_M_E) !CALIB. M - CALL NMOEXF(MDL) !MAKE INTERNAL FORMAT - CALL WNGMV(MDLHDL,MDL,A_B(GDESJ(MDH_MODP_J)+ - 1 (J-1)*MDLHDL-A_OB)) !SET MODEL LINE - END IF - END DO - ELSE !RANGE - DO J=SRCL(1),SRCL(2) !CALIBRATE SOURCES - IF (J.GT.0 .AND. J.LE.GDESJ(MDH_NSRC_J)) THEN !CAN DO - CALL WNGMV(MDLHDL,A_B(GDESJ(MDH_MODP_J)+ - 1 (J-1)*MDLHDL-A_OB),MDL) !GET MODEL LINE - CALL NMOEXT(MDL) !MAKE EXTERNAL FORMAT - MDLE(MDL_I_E)=SFAC(0)*MDLE(MDL_I_E) !CALIBRATE AMPLITUDE - MDLE(MDL_L_E)=SFAC(1)+MDLE(MDL_L_E) !CALIB. L - MDLE(MDL_M_E)=SFAC(2)+MDLE(MDL_M_E) !CALIB. M - CALL NMOEXF(MDL) !MAKE INTERNAL FORMAT - CALL WNGMV(MDLHDL,MDL,A_B(GDESJ(MDH_MODP_J)+ - 1 (J-1)*MDLHDL-A_OB)) !SET MODEL LINE - END IF - END DO - END IF - GOTO 50 !MORE? -C -C MERGE -C - ENTRY NMOAMG -C - LIDX=-1 !GENERAL INDEX - DO I=0,1 - MERAD(I) = 0 !merge radii - END DO - GOTO 40 -C -C - ENTRY NMOAM1(IDX) -C - LIDX=IDX !HEADER INDEX - DO I=0,1 - MERAD(I) = 0 !merge radii - END DO - GOTO 40 -C - ENTRY NMOAM2(IDX,NST,NND) -C - LIDX=IDX - I3=NST !1ST SOURCE - I4=NND !LAST SOURCE - DO I=0,1 - MERAD(I) = 0 !merge radii - END DO - GOTO 41 -C - ENTRY NMOAMR -C - LIDX=-1 !GENERAL INDEX -C - DEC0 = GMDHD(MDH_DEC_D,-1) ! DEC, circles - FRQ0 = GMDHD(MDH_FRQ_D,-1) ! Freq, MHz - IF (FRQ0.NE.0) THEN - MERADFLT(0)= - 1 2*1.5/(3000.*PI2*FRQ0/CL/(1.E-6))*DEG*3600. - IF (DEC0.NE.0) THEN - MERADFLT(1)=MERADFLT(0)/ABS(SIN(DEC0*DPI2)) !GUESS - ELSE - MERADFLT(1) = MERADFLT(0) ! round - ENDIF - ELSE - MERADFLT(0) = 0 !no default? - MERADFLT(1) = 0 !no default? - ENDIF - DO I=0,1 - MERAD(I) = MERADFLT(I) !arcsec - END DO - IF (.NOT.WNDPAR('MERGE_RADIUS',MERAD,2*LB_E,J0, - 1 A_B(-A_OB),MERAD,2)) THEN - RETURN !READY - ELSE IF (J0.EQ.0) THEN - RETURN !READY - ELSE IF (J0.LT.0) THEN !ASSUME DEFAULT - MERAD(0) = MERADFLT(0) - MERAD(1) = MERADFLT(1) - END IF - DO I=0,1 - MERAD(I) = MERAD(I)*DPI2/(3600.*360.) !radians - END DO - GOTO 40 -C -C - 40 CONTINUE - I3=1 !FIRST SOURCE - I4=GMDHJ(MDH_NSRC_J,LIDX) !LAST SOURCE - 41 CONTINUE - I3=MAX(0,I3-1) !LIMIT - I4=MIN(I4-1,GMDHJ(MDH_NSRC_J,LIDX)-1) - DO I=I3,I4 !ALL SOURCES - J=(GMDHJ(MDH_MODP_J,LIDX)+I*MDLHDL-A_OB) !SOURCE - J1=J/LB_E - I2=A_B(J+MDL_BITS_B) !BITS - IF (A_E(J1+MDL_I_E).NE.0 .AND. !NOT DELETED - 1 IAND(I2,1).EQ.0) THEN !NOT EXTENDED - MAXDL = MERAD(0) !MAX DELTA L - MAXDM = MERAD(1) !MAX DELTA M - J4 = MDL(MDL_TP_B) !CLEAN TYPE - IF (IAND(MDLCLN_M,J4).NE.0) THEN !CLEAN COMPONENT - MAXDL = 0 !MERGE ONLY IF COINCIDES EXACTLY - MAXDM = 0 - ENDIF - DO I1=I+1,I4 - J2=(GMDHJ(MDH_MODP_J,LIDX)+I1*MDLHDL-A_OB) !SOURCE - J3=J2/LB_E - I2=A_B(J2+MDL_BITS_B) !BITS - IF (IAND(I2,1).EQ.0 .AND. !NOT EXTENDED - 1 A_B(J2+MDL_TP_B).EQ.A_B(J+MDL_TP_B) .AND. !SAME CLEAN - 1 A_E(J3+MDL_I_E).NE.0 .AND. !NOT DELETED - 1 ABS(A_E(J3+MDL_L_E)-A_E(J1+MDL_L_E)) - 1 .LE.MAXDL .AND. !CLOSE ENOUGH IN L - 1 ABS(A_E(J3+MDL_M_E)-A_E(J1+MDL_M_E)) - 1 .LE.MAXDM .AND. !CLOSE ENOUGH IN M - 1 A_E(J3+MDL_SI_E).EQ.A_E(J1+MDL_SI_E) .AND. !SAME S.I. - 1 A_E(J3+MDL_RM_E).EQ.A_E(J1+MDL_RM_E)) THEN !SAME R.M. -C - R0=A_E(J1+MDL_I_E)+A_E(J3+MDL_I_E) !NEW I - A_E(J1+MDL_Q_E)=(A_E(J1+MDL_Q_E)*A_E(J1+MDL_I_E)+ - 1 A_E(J3+MDL_Q_E)*A_E(J3+MDL_I_E))/R0 !NEW Q - A_E(J1+MDL_U_E)=(A_E(J1+MDL_U_E)*A_E(J1+MDL_I_E)+ - 1 A_E(J3+MDL_U_E)*A_E(J3+MDL_I_E))/R0 !NEW U - A_E(J1+MDL_V_E)=(A_E(J1+MDL_V_E)*A_E(J1+MDL_I_E)+ - 1 A_E(J3+MDL_V_E)*A_E(J3+MDL_I_E))/R0 !NEW V - A_E(J1+MDL_I_E)=R0 !MERGE I - IF (A_E(J1+MDL_I_E).LT.A_E(J3+MDL_I_E)) THEN - A_E(J1+MDL_L_E) = A_E(J3+MDL_L_E) ! USE L OF LARGEST - A_E(J1+MDL_M_E) = A_E(J3+MDL_M_E) ! USE M OF LARGEST - ENDIF - A_E(J3+MDL_I_E)=0 !SET DELETE - END IF - END DO - END IF - END DO -C - RETURN -C -C FIELD EDIT -C - ENTRY NMOAFB(OFF) -C - FTYP=-1 !BYTE - GOTO 30 -C - ENTRY NMOAFJ(OFF) -C - FTYP=0 !J - GOTO 30 -C - ENTRY NMOAFE(OFF) -C - FTYP=1 !E - GOTO 30 -C - 30 CONTINUE - IF (.NOT.WNDPAR('EDIT_VALUE',R0,LB_E,J0,'""')) THEN !GET VALUE TO SET - IF (E_C.EQ.DWC_ENDOFLOOP) RETURN !READY - GOTO 30 !RETRY - ELSE IF (E_C.EQ.DWC_NULLVALUE) THEN !"" - RETURN - ELSE IF (E_C.EQ.DWC_WILDCARD) THEN - GOTO 30 - END IF - SRCL(0)=0 !ASSUME LIST - IF (.NOT.WNDPAR('SOURCE_LIST',SRCL(1),MXSRCL*LB_J,J0, - 1 '*')) THEN !GET TO SET - IF (E_C.EQ.DWC_ENDOFLOOP) RETURN !READY - GOTO 30 !RETRY - ELSE IF (E_C.EQ.DWC_NULLVALUE) THEN !"" - RETURN - ELSE IF (E_C.EQ.DWC_WILDCARD) THEN - IF (.NOT.WNDPAR('SOURCE_RANGE',SRCL(1),2*LB_J,J0, - 1 '""')) THEN !GET TO SET - IF (E_C.EQ.DWC_ENDOFLOOP) RETURN !READY - GOTO 30 !RETRY - ELSE IF (E_C.EQ.DWC_NULLVALUE) THEN !"" - RETURN - ELSE IF (E_C.EQ.DWC_WILDCARD) THEN - SRCL(1)=1 !RANGE - SRCL(2)=GDESJ(MDH_NSRC_J) - END IF - IF (J0.EQ.1) SRCL(2)=GDESJ(MDH_NSRC_J) !LIMIT RANGE - SRCL(0)=-1 !INDICATE RANGE - END IF - IF (SRCL(0).GE.0) THEN !LIST - DO I=1,J0 !SET SOURCES - J=SRCL(I) !TO DO - IF (J.GT.0 .AND. J.LE.GDESJ(MDH_NSRC_J)) THEN !CAN DO - CALL WNGMV(MDLHDL,A_B(GDESJ(MDH_MODP_J)+ - 1 (J-1)*MDLHDL-A_OB),MDL) !GET SOURCE - CALL NMOEXT(MDL) !MAKE EXTERNAL FORMAT - IF (FTYP.LT.0) THEN !B - MDL(OFF)=MOD(NINT(R0),128) - ELSE IF (FTYP.EQ.0) THEN !J - MDLJ(OFF)=NINT(R0) - ELSE - MDLE(OFF)=R0 - END IF - CALL NMOEXF(MDL) !MAKE INTERNAL FORMAT - CALL WNGMV(MDLHDL,MDL,A_B(GDESJ(MDH_MODP_J)+ - 1 (J-1)*MDLHDL-A_OB)) !SET SOURCE - END IF - END DO - ELSE !RANGE - DO J=SRCL(1),SRCL(2) !EDIT SOURCES - IF (J.GT.0 .AND. J.LE.GDESJ(MDH_NSRC_J)) THEN !CAN DO - CALL WNGMV(MDLHDL,A_B(GDESJ(MDH_MODP_J)+ - 1 (J-1)*MDLHDL-A_OB),MDL) !GET SOURCE - CALL NMOEXT(MDL) !MAKE EXTERNAL FORMAT - IF (FTYP.LT.0) THEN !B - MDL(OFF)=MOD(NINT(R0),128) - ELSE IF (FTYP.EQ.0) THEN !J - MDLJ(OFF)=NINT(R0) - ELSE - MDLE(OFF)=R0 - END IF - CALL NMOEXF(MDL) !MAKE INTERNAL FORMAT - CALL WNGMV(MDLHDL,MDL,A_B(GDESJ(MDH_MODP_J)+ - 1 (J-1)*MDLHDL-A_OB)) !SET SOURCE - END IF - END DO - END IF - GOTO 30 !MORE? -C -C - END diff --git a/src/nscan/nmobem.for b/src/nscan/nmobem.for deleted file mode 100644 index 9a72f1b25c417f0652fe53ac65c2c1aa4fe52d79..0000000000000000000000000000000000000000 --- a/src/nscan/nmobem.for +++ /dev/null @@ -1,128 +0,0 @@ -C+ NMOBEM.FOR -C WNB 910814 -C -C Revisions: -C WNB 910909 Correct factor -C WNB 911115 Change minimum value -C WNB 920602 Use BEMLIM -C WNB 930826 New beam factors -C WNB 930928 Multiple instruments -C WNB 931006 Text -C WNB 931008 Limit (de-)beaming to non (de-)beam -C - SUBROUTINE NMOBEM -C -C (De-)beam source list -C -C Result: -C -C CALL NMOBEM Correct source list for beam -C CALL NMOBED De-correct source list for beam -C -C Include files: -C - INCLUDE 'WNG_DEF' - INCLUDE 'NMO_DEF' - INCLUDE 'MDH_O_DEF' !MODEL HEADER - INCLUDE 'MDL_O_DEF' !MODEL LINE -C -C Parameters: -C -C -C Arguments: -C -C -C Function references: -C - LOGICAL WNFOP !OPEN FILE - LOGICAL NMOBMR !READ BEAM DATA - LOGICAL NMOBMF !GET BEAM RANGE - DOUBLE PRECISION NMOBMV !BEAM VALUES -C -C Data declarations: -C - LOGICAL DEB !SWITCH BEAM/DEBEAM - BYTE MDL(0:MDLHDL-1) !SOURCE LINE - INTEGER MDLJ(0:MDLHDL/4-1) - REAL MDLE(0:MDLHDL/4-1) - EQUIVALENCE (MDL,MDLJ,MDLE) - INTEGER RANGE(0:1) !SHOW RANGE - DATA RANGE/0,1000000/ -C- -C -C INIT -C - DEB=.FALSE. !BEAM - GOTO 10 -C -C NMOBED -C - ENTRY NMOBED -C - DEB=.TRUE. !DE-BEAM - GOTO 10 -C - 10 CONTINUE - IF (.NOT.NMOBMR()) GOTO 900 !GET DATA -C -C INIT SOURCE LIST -C - CALL NMOHZD(GDES) !CLEAR HEADER DATA - CALL NMORDS(FCAOUT) !READ SOURCES - CALL NMORDM(7,-1) !AND ADD THEM - CALL NMOPTT(F_TP,RANGE) !SHOW DATA -C -C GET REFERENCE DATA -C - IF (GDESJ(MDH_TYP_J).LE.0) THEN - CALL WNCTXT(F_TP,'!/Cannot (de-)beam local type source list') - GOTO 900 - END IF - IF (.NOT.NMOBMF(IAND(MDHINS_M,GDESJ(MDH_BITS_J)), - 1 GDESD(MDH_FRQ_D))) THEN !GET BEAM RANGE - CALL WNCTXT(F_TP,'!/Cannot (de-)beam: no beam data available') - GOTO 900 - END IF -C -C CONVERT -C - DO I=0,GDESJ(MDH_NSRC_J)-1 - J=GDESJ(MDH_MODP_J)+I*MDLHDL-A_OB - CALL WNGMV(MDLHDL,A_B(J),MDL) !GET MODEL - I1=MDL(MDL_TP_B) !TYPE - IF ((DEB .AND. IAND(I1,MDLBEM_M).NE.0) .OR. - 1 (.NOT.DEB .AND. IAND(I1,MDLBEM_M).EQ.0)) THEN !DO - D1=NMOBMV(GDESD(MDH_FRQ_D),MDLE(MDL_L_E),MDLE(MDL_M_E), - 1 BEMLIM,DEB) !GET VALUE - MDLE(MDL_I_E)=D1*MDLE(MDL_I_E) !DO - END IF - IF (DEB) THEN - I1=IAND(I1,NOT(MDLBEM_M)) !SET DE-BEAM - ELSE - I1=IOR(I1,MDLBEM_M) !SET BEAM - END IF - MDL(MDL_TP_B)=I1 - CALL WNGMV(MDLHDL,MDL,A_B(J)) !SET MODEL - END DO -C -C REWRITE DATA -C - IF (.NOT.WNFOP(FCAOUT,FILOUT,'U')) THEN - CALL WNCTXT(F_TP,'Cannot output data') - GOTO 901 - END IF - CALL NMOWRS(FCAOUT,GDES) !WRITE DATA BACK - CALL NMOPTT(F_TP,RANGE) !SHOW DATA -C - RETURN -C -C ERRORS -C - 900 CONTINUE - CALL WNFCL(FCAOUT) - 901 CONTINUE -C - RETURN -C -C - END diff --git a/src/nscan/nmobmf.for b/src/nscan/nmobmf.for deleted file mode 100644 index c4ace16c372eb4f1598b46d262ae101c9307b16b..0000000000000000000000000000000000000000 --- a/src/nscan/nmobmf.for +++ /dev/null @@ -1,59 +0,0 @@ -C+ NMOBMF.FOR -C WNB 930826 -C -C Revisions: -C WNB 930928 Split off NMOBMV; cater for multiple instruments -C CMV 930917 Various corrections, changed direction of change -C CMV 930921 Changed direction back -C WNB 930928 Cater for multiple instruments -C WNB 931008 Remove BEMLIM etc. -C - LOGICAL FUNCTION NMOBMF(INST,FRQ) -C -C Get correct beam definition -C -C Result: -C -C NMOBMF_L = NMOBMF( INST_J:I, FRQ_D:I) -C Get (de-)beam factors for specified -C frequency range and INSTrument -C -C Include files: -C - INCLUDE 'WNG_DEF' - INCLUDE 'BMD_DEF' -C -C Parameters: -C -C -C Arguments: -C - INTEGER INST !INSTRUMENT - DOUBLE PRECISION FRQ !FREQUENCY -C -C Function references: -C - LOGICAL NMOBMR !READ VALUES -C -C Data declarations: -C -C- -C -C INIT -C - NMOBMF=.FALSE. !ASSUME ERROR - IF (.NOT.NMOBMR()) RETURN !READ DATA IF NECESSARY - IF (INST.LT.0 .OR. INST.GE.BEMNIN) RETURN !UNKNOWN INSTRUMENT - BEMCIN=INST !CURRENT INSTRUMENT - BEMCFP=0 !CURRENT FACTOR POINTER - DO I=0,BEMCOD(3,INST)-1 !GET FACTOR - BEMCFP=I*BEMCOD(2,INST) !FACTOR POINTER - IF (BEMFQ(I,INST).GE.FRQ) GOTO 20 !READY - END DO - 20 CONTINUE -C - NMOBMF=.TRUE. !FOUND - RETURN -C -C - END diff --git a/src/nscan/nmobmr.for b/src/nscan/nmobmr.for deleted file mode 100644 index 038ffc654b3cf197ebf3004cfe91f04e3b3aacd6..0000000000000000000000000000000000000000 --- a/src/nscan/nmobmr.for +++ /dev/null @@ -1,102 +0,0 @@ -C+ NMOBMR.FOR -C WNB 930826 -C -C Revisions: -C WNB 930928 Change to cater for multiple instruments and beams -C CMV 930917 Various corrections -C - LOGICAL FUNCTION NMOBMR() -C -C Get (de-)beam factors -C -C Result: -C -C NMOBMR_L = NMOBMR () Get beam factors from user -C -C PIN references -C -C BEAM_SCALE -C BEAM_DESCR -C BEAM-FREQ_* -C BEAM_FACTOR_* -C -C Include files: -C - INCLUDE 'WNG_DEF' - INCLUDE 'BMD_DEF' -C -C Parameters: -C -C -C Arguments: -C -C -C Function references: -C - LOGICAL WNDPAR !GET USER DATA -C -C Data declarations: -C - CHARACTER*1 BCD !INSTRUM. CODE -C- -C -C INIT -C - NMOBMR=.TRUE. !ASSUME OK - IF (BEMNIN.GE.0) RETURN !ALREADY THERE -C -C GET VALUES -C -C BEAM SCALE -C - 10 CONTINUE - IF (.NOT.WNDPAR('BEAM_SCALE',BEMSC,LB_E,J0,'1.')) THEN - BEMSC=1. !SET DEFAULT - END IF - IF (J0.NE.1) BEMSC=1. !DEFAULT -C -C BEAM DESCRIPTORS -C - IF (.NOT.WNDPAR('BEAM_DESCR',BEMCOD,BEMNDV*BEMMIN*LB_J,J0)) THEN - 11 CONTINUE - BEMNIN=-1 !SET NOTHING READ - NMOBMR=.FALSE. !RETURN ERROR -C - RETURN - END IF - IF (J0.LE.0) GOTO 10 !MUST SPECIFY - IF (MOD(J0,BEMNDV).NE.0) GOTO 11 !INCORRECT # OF CODES - BEMNIN=J0/BEMNDV !# OF INSTRUMENTS DEFINED - DO I=0,BEMNIN-1 !CHECK DESCRIPTOR - IF (BEMCOD(0,I).LT.0 .OR. - 1 BEMCOD(0,I).GE.BEMMIN) GOTO 11 !ILLEGAL FREQ_/FACTOR_ - IF (BEMCOD(1,I).LT.0 .OR. - 1 BEMCOD(1,I).GT.BEMMTP) GOTO 11 !ILLEGAL TYPE - IF (BEMCOD(2,I).LT.1 .OR. - 1 BEMCOD(2,I).GT.BEMMFC) GOTO 11 !ILL. # FACTORS/FREQ - IF (BEMCOD(3,I).LT.1 .OR. - 1 BEMCOD(3,I).GT.BEMMFQ) GOTO 11 !ILL. # FREQ. RANGES - END DO -C -C FREQUENCY RANGES AND FACTORS -C - DO I=0,BEMNIN-1 !ALL DEFINED INSTRUMENTS - CALL WNCTXS(BCD,'!UJ',BEMCOD(0,I)) !INSTRUM. CODE - IF (.NOT.WNDPAR('BEAM_FREQ_'//BCD,BEMFQ(0,I), - 1 BEMMFQ*LB_E,J0)) THEN !GET FREQ. RANGES - GOTO 11 - END IF - IF (J0.LE.0) GOTO 10 !MUST SPECIFY - IF (J0.NE.BEMCOD(3,I)) GOTO 11 !ILLEGAL # OF RANGES - IF (.NOT.WNDPAR('BEAM_FACTOR_'//BCD,BEMFC(0,I), - 1 BEMMFQ*BEMMFC*LB_E,J0)) THEN !GET FACTORS - GOTO 11 - END IF - IF (J0.LE.0) GOTO 10 !MUST SPECIFY - IF (J0.NE.BEMCOD(2,I)*BEMCOD(3,I)) GOTO 11 !ILLEGAL # OF FACTORS - END DO -C - RETURN -C -C - END diff --git a/src/nscan/nmobmv.for b/src/nscan/nmobmv.for deleted file mode 100644 index c80f084319123774271d2f93bb5b6eb98c759eea..0000000000000000000000000000000000000000 --- a/src/nscan/nmobmv.for +++ /dev/null @@ -1,66 +0,0 @@ -C+ NMOBMV.FOR -C WNB 930826 -C -C Revisions: -C CMV 930917 Various corrections, changed direction of change -C CMV 930921 Changed direction back -C WNB 930928 Split off from NMOBMF -C - DOUBLE PRECISION FUNCTION NMOBMV(FRQ,L,M,BEMLIM,DEB) -C -C Get beam value -C -C Result: -C -C NMOBMV_D = NMOBMV( FRQ_D:I, L_E:I, M_E:I, -C BEMLIM_D:I, DEB_L:I) -C Get value for frequency and l,m using -C the NMOBMF obtained data, lower limit BEMLIM -C and if DEBeam. -C -C Include files: -C - INCLUDE 'WNG_DEF' - INCLUDE 'BMD_DEF' -C -C Parameters: -C -C -C Arguments: -C - DOUBLE PRECISION FRQ !FREQUENCY (MHZ) - REAL L !L (RADIANS) - REAL M !M (RADIANS) - DOUBLE PRECISION BEMLIM !LOWEST LIMIT - LOGICAL DEB !DEBEAM -C -C Function references: -C -C -C Data declarations: -C -C- - R1=BEMSC*FRQ !SCALING - R0=(L**2+M**2)*(R1**2) !ANGLE ON SKY (RADIANS) - IF (BEMCOD(1,BEMCIN).EQ.0) THEN !COS^6 - D0=COS(BEMFC(BEMCFP,BEMCIN)*SQRT(R0))**6 !BEAM VALUE - ELSE - R0=R0*((DEG*60/1000)**2) !MAKE ARCMIN.GHZ - D0=BEMFC(BEMCFP+BEMCOD(3,BEMCIN)-1,BEMCIN)*R0 !LAST FACTOR - DO I=BEMCOD(3,BEMCIN)-2,0,-1 !MAKE SUM - D0=(D0+BEMFC(BEMCFP+I,BEMCIN))*R0 - END DO - D0=D0+1D0 !1+AI.X^2I - IF (BEMCOD(1,BEMCIN).EQ.1 .AND. - 1 ABS(D0).GE.1D-6) THEN !1/(1+AI.X^2I) - D0=1D0/D0 - END IF - END IF - IF (D0.LT.BEMLIM) D0=BEMLIM - IF (.NOT.DEB .AND. ABS(D0).GE.1D-6) D0=1/D0 !DEBEAM - NMOBMV=D0 !RETURN VALUE -C - RETURN -C -C - END diff --git a/src/nscan/nmocix.for b/src/nscan/nmocix.for deleted file mode 100644 index ed7ef882c603daf8aff50ade6e42014cd775b44c..0000000000000000000000000000000000000000 --- a/src/nscan/nmocix.for +++ /dev/null @@ -1,133 +0,0 @@ -C+ NMOCIX.FOR -C WNB 900825 -C -C Revisions: -C WNB 930826 Add CIY; remove CXI, remove WGT -C WNB 930831 Correct model addition -C WNB 930901 Correct Q/U interchange; WSRT sign U -C WNB 931029 Convex does not accept complex parameter -C CMV 940303 Change sign of V -C - SUBROUTINE NMOCIX(STHJ,SCHE,ANG,CDAT,CMOD) -C -C Convert Stokes Model to data XYX -C -C Result: -C -C CALL NMOCIX( STHJ_J(0:*):I, SCHE_E(0:*):I, ANG_E(0:2,0:*):I, -C CDAT_X(0:*,0:3):O, CMOD_X(0:3,0:*):I) -C Convert Stokes model data to proper XYX data, -C using the STH set and SCH scan header. -C CDAT are the XYX data, CMOD the Stokes data. -C ANG contains: -C 0: the parallactic angle of W X-dipole (circles) -C 1: sin(E X-dipole - W X-dipole) -C 2: cos(...) -C CALL NMOCIY( STHJ_J(0:*):I, SCHE_E(0:*):I, ANG_E(0:2,0:*):I, -C CDAT_X(0:*,0:3):O, CMOD_X(0:3,0:*):I, NRINT_J:I) -C Convert Stokes model data to XYX, averaging -C with existing XYX data with weight NRINT if -C NRINT>=0. I.e. out=(N*old+new)/(N+1) -C If NRINT<0: out=(N*old+new)/N, e.g. if N==1: -C out=old-new! -C -C Include files: -C - INCLUDE 'WNG_DEF' - INCLUDE 'STH_O_DEF' !SET HEADER - INCLUDE 'SCH_O_DEF' !SCAN HEADER -C -C Parameters: -C -C -C Arguments: -C - INTEGER STHJ(0:*) !SET HEADER - REAL SCHE(0:*) !SCAN HEADER - REAL ANG(0:2,0:*) !DIPOLE ANGLES - COMPLEX CDAT(0:STHIFR-1,0:3) !DATA - COMPLEX CMOD(0:3,0:*) !MODEL - INTEGER NRINT !NUMBER OF INTEGRATIONS -C -C Function references: -C -C -C Data declarations: -C - REAL SX,CX !SIN,COS(2.CHI+B) - REAL SBS,CBS,SBR !SIGN OF SIN,COS(BETA) - COMPLEX CXI !I -C- -C -C NMOCIX -C - J0=0 !NO INTEGRATION - GOTO 100 -C -C NMOCIY -C - ENTRY NMOCIY(STHJ,SCHE,ANG,CDAT,CMOD,NRINT) -C - J0=NRINT !INTEGRATION COUNT - GOTO 100 -C -C INIT -C - 100 CONTINUE - CXI=CMPLX(0,1) - J1=J0 !NO AVERAGE - IF (J0.GE.0) J1=J0+1 !AVERAGE -C -C ALL DATA -C - DO I=0,STHJ(STH_NIFR_J)-1 !ALL DATA POINTS -C -C INIT -C - SBS=1 !ASSUME POS. SIGN - CBS=1 - SBR=1 - IF (STHJ(STH_INST_J).EQ.0) THEN !WSRT - IF (ANG(1,I).LE.0) SBS=-1 !REVERSE SIGN - IF (ANG(2,I).LT.0) CBS=-1 - SBR=-SBS - END IF - R0=(2*(SCHE(SCH_PANG_E)+ANG(0,I)))*PI2 !2*CHI - R1=COS(R0) !COS - R0=SIN(R0) !SIN - SX=R0*ANG(2,I)+R1*ANG(1,I) !SIN(2*CHI+BETA) - CX=R1*ANG(2,I)-R0*ANG(1,I) !COS - R0=MAX(ABS(ANG(1,I)),ABS(ANG(2,I))) !NORMALISATION -C -C CONVERT STOKES TO XYX -C - CDAT(I,0)=(CDAT(I,0)*J0+ - 1 CBS/R0*( CMOD(0,I)*ANG(2,I) - 1 +CMOD(1,I)*CX - 1 +CMOD(2,I)*SX - 1 -CMOD(3,I)*ANG(1,I)*CXI))/J1 !XX -C - CDAT(I,1)=(CDAT(I,1)*J0+ - 1 SBR/R0*(-CMOD(0,I)*ANG(1,I) - 1 -CMOD(1,I)*SX - 1 +CMOD(2,I)*CX - 1 -CMOD(3,I)*ANG(2,I)*CXI))/J1 !XY -C - CDAT(I,2)=(CDAT(I,2)*J0+ - 1 SBS/R0*( CMOD(0,I)*ANG(1,I) - 1 -CMOD(1,I)*SX - 1 +CMOD(2,I)*CX - 1 +CMOD(3,I)*ANG(2,I)*CXI))/J1 !YX -C - CDAT(I,3)=(CDAT(I,3)*J0+ - 1 CBS/R0*( CMOD(0,I)*ANG(2,I) - 1 -CMOD(1,I)*CX - 1 -CMOD(2,I)*SX - 1 -CMOD(3,I)*ANG(1,I)*CXI))/J1 !YY -C - END DO -C - RETURN -C -C - END diff --git a/src/nscan/nmocvs.for b/src/nscan/nmocvs.for deleted file mode 100644 index 42d82726d30bc77e91b4d3903c46a3becde9990d..0000000000000000000000000000000000000000 --- a/src/nscan/nmocvs.for +++ /dev/null @@ -1,178 +0,0 @@ -C+ NMOCVS.FOR -C WNB 900827 -C -C Revisions: -C WNB 911014 Change sign rotation -C WNB 920118 Change precision rotation -C WNB 920626 Change sign Rot. measure -C HjV 930423 Change name of some keywords -C WNB 930928 Add instrument -C WNB 931005 Change RM conversion; copy instrument -C WNB 931008 Cater for EDIT; remove CV1; add BEAMing -C WNB 931119 Change CVT definition; add REDIT, FEDIT -C - LOGICAL FUNCTION NMOCVS(SDES,ODES,PHI,CVT) -C -C Read a source model -C -C Result: -C -C NMOCVS_L = NMOCVS( SDES_B(0:*):I, ODES_B(0:*):I, PHI_E:I, CVT_I:I) -C Convert the source list described by SDES to -C ODES format. CVT indicates convert (0) -C or edit(1), REDIT(2), FEDIT(3). -C Phi is the field rotation for -C apparent <-> epoch; only used for edit. -C -C Include files: -C - INCLUDE 'WNG_DEF' - INCLUDE 'NMO_DEF' - INCLUDE 'MDH_O_DEF' !MODEL HEADER - INCLUDE 'MDL_O_DEF' !MODEL LINE - INCLUDE 'STH_O_DEF' !SET HEADER -C -C Parameters: -C -C -C Arguments: -C - BYTE SDES(0:*) !LIST TO CONVERT - BYTE ODES(0:*) !CONVERSION TYPE - REAL PHI !ROTATION ANGLE - INTEGER CVT !CONVERT/EDIT INDICATOR -C -C Function references: -C - INTEGER WNGGJ !GET J VALUE - REAL WNGGE !GET E VALUE - DOUBLE PRECISION WNGGD !GET D VALUE - LOGICAL NMOBMF !GET BEAM RANGE - DOUBLE PRECISION NMOBMV !BEAM VALUES -C -C Data declarations: -C - DOUBLE PRECISION RA1,DEC1 !CONVERTED RA,DEC - REAL R2,R3 -C- -C -C INIT -C - NMOCVS=.TRUE. !ASSUME OK -C -C CONVERT -C - IF (WNGGJ(SDES(MDH_TYP_1)).EQ.0) THEN !LIST=LOCAL - CALL WNGMV(MDH_FRQ_1-MDH_TYP_1+LB_D, - 1 ODES(MDH_TYP_1),SDES(MDH_TYP_1)) !COPY TYPE AND .. - CALL WNGMV(LB_J,ODES(MDH_BITS_1),SDES(MDH_BITS_1)) - ELSE IF (WNGGJ(ODES(MDH_TYP_1)).EQ.0) THEN !SET LOCAL - CALL WNGMVZ(MDH_FRQ_1-MDH_TYP_1+LB_D, - 1 SDES(MDH_TYP_1)) !COPY TYPE AND .. - CALL WNGMVZ(LB_J,SDES(MDH_BITS_1)) - ELSE IF (WNGGJ(SDES(MDH_TYP_1)).EQ. - 1 WNGGJ(ODES(MDH_TYP_1))) THEN !CONVERT - IF (CVT.NE.1) THEN !CONVERSION WANTED - IF (CVT.NE.2) THEN !CONVERT, FEDIT - J0=WNGGJ(SDES(MDH_MODP_1))-A_OB !OFFSET LIST - DO I=0,WNGGJ(SDES(MDH_NSRC_1))-1 !ALL SOURCES - J1=J0/LB_E !E OFFSET - I4=A_B(J0+MDL_TP_B) !TYPE - IF (IAND(I4,MDLBEM_M).EQ.0) THEN !SHOULD BEAM FIRST - IF (.NOT.NMOBMF(IAND(MDHINS_M, - 1 WNGGJ(SDES(MDH_BITS_1))), - 1 SDES(MDH_FRQ_1))) THEN !GET BEAM RANGE - CALL WNCTXT(F_TP,'!/No beam data available') - GOTO 900 - END IF - D0=NMOBMV(SDES(MDH_FRQ_1),A_B(J0+MDL_L_1), - 1 A_B(J0+MDL_M_1),BEMLIM,.FALSE.) !GET FACTOR - A_E(J1+MDL_I_E)=D0*A_E(J1+MDL_I_E) !CORRECT INTENSITY - END IF - J0=J0+MDL__L !NEXT SOURCE - END DO - END IF - J0=WNGGJ(SDES(MDH_MODP_1))-A_OB !OFFSET LIST - DO I=0,WNGGJ(SDES(MDH_NSRC_1))-1 !ALL SOURCES - J1=J0/LB_E !E OFFSET - I4=A_B(J0+MDL_TP_B) !TYPE - IF (CVT.EQ.3 .AND. IAND(I4,MDLBEM_M).EQ.0) THEN !SHOULD DE-BEAM - IF (.NOT.NMOBMF(IAND(MDHINS_M, - 1 WNGGJ(ODES(MDH_BITS_1))), - 1 ODES(MDH_FRQ_1))) THEN !GET BEAM RANGE - CALL WNCTXT(F_TP,'!/No beam data available') - GOTO 900 - END IF - D0=NMOBMV(ODES(MDH_FRQ_1),A_B(J0+MDL_L_1), - 1 A_B(J0+MDL_M_1),BEMLIM,.TRUE.) !GET FACTOR - A_E(J1+MDL_I_E)=D0*A_E(J1+MDL_I_E) !CORRECT INTENSITY - END IF - CALL WNMCLM(SDES(MDH_RA_1),SDES(MDH_DEC_1), !MAKE RA,DEC - 1 A_B(J0+MDL_L_1),A_B(J0+MDL_M_1), - 1 RA1,DEC1) - CALL WNMCRD(ODES(MDH_RA_1),ODES(MDH_DEC_1), !MAKE L,M - 1 A_B(J0+MDL_L_1),A_B(J0+MDL_M_1), - 1 RA1,DEC1) - IF (CVT.EQ.0 .AND. IAND(I4,MDLBEM_M).EQ.0) THEN !SHOULD DE-BEAM - IF (.NOT.NMOBMF(IAND(MDHINS_M, - 1 WNGGJ(ODES(MDH_BITS_1))), - 1 ODES(MDH_FRQ_1))) THEN !GET BEAM RANGE - CALL WNCTXT(F_TP,'!/No beam data available') - GOTO 900 - END IF - D0=NMOBMV(ODES(MDH_FRQ_1),A_B(J0+MDL_L_1), - 1 A_B(J0+MDL_M_1),BEMLIM,.TRUE.) !GET FACTOR - A_E(J1+MDL_I_E)=D0*A_E(J1+MDL_I_E) !CORRECT INTENSITY - END IF - D0=WNGGD(SDES(MDH_FRQ_1)) !FRQ - D1=WNGGD(ODES(MDH_FRQ_1)) - IF (D0*D1.NE.0) THEN - R0=D1/D0 !CONVERT FOR SPECTR. - J1=J0/LB_E ! INDEX - A_E(J1+MDL_I_E)=A_E(J1+MDL_I_E)* - 1 (R0**A_E(J1+MDL_SI_E)) - R0=2*A_E(J1+MDL_RM_E)*(((DCL*1E-6/D0)**2)- - 1 ((DCL*1E-6/D1)**2)) !CONVERT FOR ROT. M. - R1=SIN(R0) - R0=COS(R0) - R2=A_E(J1+MDL_Q_E)*R0-A_E(J1+MDL_U_E)*R1 - A_E(J1+MDL_U_E)=+A_E(J1+MDL_Q_E)*R1+A_E(J1+MDL_U_E)*R0 - A_E(J1+MDL_Q_E)=R2 - END IF - J0=J0+MDL__L !NEXT SOURCE - END DO - END IF - CALL WNGMV(MDH_FRQ_1-MDH_TYP_1+LB_D, - 1 ODES(MDH_TYP_1),SDES(MDH_TYP_1)) !COPY TYPE AND .. - CALL WNGMV(LB_J,ODES(MDH_BITS_1),SDES(MDH_BITS_1)) - ELSE IF (CVT.NE.1) THEN - CALL WNCTXT(F_TP,'Cannot convert for different types, '// - 1 'use CONVERT first') - GOTO 900 - ELSE !USE REFERENCE DATA - R0=-PHI*PI2 !ROTATION - R1=SIN(R0) !ROTATIONS - R0=COS(R0) - J0=WNGGJ(SDES(MDH_MODP_1))-A_OB !OFFSET LIST - DO I=0,WNGGJ(SDES(MDH_NSRC_1))-1 !ALL SOURCES - R2=R0*WNGGE(A_B(J0+MDL_L_1))+R1*WNGGE(A_B(J0+MDL_M_1)) !ROTATE - R3=-R1*WNGGE(A_B(J0+MDL_L_1))+R0*WNGGE(A_B(J0+MDL_M_1)) - CALL WNGMV(LB_E,R2,A_B(J0+MDL_L_1)) !SET - CALL WNGMV(LB_E,R3,A_B(J0+MDL_M_1)) - J0=J0+MDL__L !NEXT SOURCE - END DO - CALL NMOHMD(ODES,SDES) !COPY HEAD DATA - END IF -C - RETURN -C -C ERRORS -C - 900 CONTINUE - CALL WNCTXT(F_TP,'!/Error converting source list') - NMOCVS=.FALSE. !INDICATE ERROR -C - RETURN -C -C - END diff --git a/src/nscan/nmocvt.for b/src/nscan/nmocvt.for deleted file mode 100644 index bac5195720908b905048dcb7009a525826237312..0000000000000000000000000000000000000000 --- a/src/nscan/nmocvt.for +++ /dev/null @@ -1,230 +0,0 @@ -C+ NMOCVT.FOR -C WNB 900827 -C -C Revisions: -C WNB 911209 Correct reference data ask -C WNB 911227 Typo reference data -C WNB 921104 Add J2000 -C HjV 930423 Change some text and keywords -C WNB 930928 Add instrument -C WNB 931005 Add better prompt -C WNB 931008 Cater for EDIT; change CV1 call to CVS -C WNB 931011 Make sure frequency given -C WNB 931110 Change NMOCVS call, CVT definition -C CMV 931220 Pass FCA of input file to WNDXLP and WNDSTA/Q -C - SUBROUTINE NMOCVT(CVT) -C -C Convert source list to other epoch -C -C Result: -C -C CALL NMOCVT( CVT_I:I) -C Convert a source list to other epoch -C CVT indicates convert (0) or edit (1), -C REDIT (2), FEDIT (3) -C -C PIN references -C -C CONVERT_TO -C REFERENCE_DATA -C -C Include files: -C - INCLUDE 'WNG_DEF' - INCLUDE 'NMO_DEF' - INCLUDE 'MDH_O_DEF' !MODEL HEADER - INCLUDE 'STH_O_DEF' !SET HEADER -C -C Parameters: -C -C -C Arguments: -C - INTEGER CVT !CONVERT/EDIT INDICATOR -C -C Function references: -C - LOGICAL WNDPAR !GET USER DATA - LOGICAL WNDNOD !GET A NODE - LOGICAL WNFOP !OPEN FILE - LOGICAL WNDSTA !GET SET DEFINITIOSN - LOGICAL NSCSTG !GET A SET HEADER - LOGICAL NMOCVS !CONVERT LIST -C -C Data declarations: -C - BYTE MDH(0:MDH__L-1) !SOURCE HEADER - INTEGER MDHJ(0:MDH__L/LB_J-1) - REAL MDHE(0:MDH__L/LB_E-1) - DOUBLE PRECISION MDHD(0:MDH__L/LB_D-1) - EQUIVALENCE (MDH,MDHJ,MDHE,MDHD) - BYTE LMDH(0:MDH__L-1) !SOURCE HEADER - INTEGER LMDHJ(0:MDH__L/LB_J-1) - REAL LMDHE(0:MDH__L/LB_E-1) - DOUBLE PRECISION LMDHD(0:MDH__L/LB_D-1) - EQUIVALENCE (LMDH,LMDHJ,LMDHE,LMDHD) - INTEGER SFCA !TO READ SCN - CHARACTER*80 SNOD - CHARACTER*160 SFIL - INTEGER SNAM(0:7) - INTEGER STHP - BYTE STH(0:STH__L-1) !SET HEADER - INTEGER STHJ(0:STH__L/LB_J-1) - REAL STHE(0:STH__L/LB_E-1) - DOUBLE PRECISION STHD(0:STH__L/LB_D-1) - EQUIVALENCE (STH,STHJ,STHE,STHD) - INTEGER RANGE(0:1) - DATA RANGE/0,1000000/ - DOUBLE PRECISION RA(5) !REFERENCE DATA - REAL PHI - CHARACTER*24 STR -C- -C -C GET CONVERSION FORMAT -C - 10 CONTINUE - IF (.NOT.WNDPAR('CONVERT_TO',STR,LEN(STR),J0,'""')) GOTO 900 - IF (J0.EQ.0) GOTO 900 - IF (J0.LT.0) GOTO 10 !MUST SET - CALL WNGMVZ(MDH__L,MDH) !MAKE GOAL - IF (STR.EQ.'B1950') THEN !SET TYPE - MDHJ(MDH_TYP_J)=2 - MDHE(MDH_EPOCH_E)=1950. - ELSE IF (STR.EQ.'J2000') THEN !SET TYPE - MDHJ(MDH_TYP_J)=2 - MDHE(MDH_EPOCH_E)=2000. - ELSE IF (STR.EQ.'APPARENT') THEN - MDHJ(MDH_TYP_J)=1 - ELSE - MDHJ(MDH_TYP_J)=0 - END IF -C -C INIT SOURCE LIST -C - CALL NMOHZD(GDES) !CLEAR HEADER DATA - CALL NMORDS(FCAOUT) !READ SOURCES - CALL NMORDM(7,-1) !AND ADD THEM - CALL NMOPTT(F_TP,RANGE) !SHOW DATA -C -C GET REFERENCE DATA -C - DO I=1,5 - RA(I)=0 !EMPTY REFERENCE DATA - END DO - IF (MDHJ(MDH_TYP_J).EQ.0) THEN !READY - ELSE - IF (.NOT.WNDNOD('REF_SCN_NODE',' ','SCN','R',SNOD,SFIL)) - 1 GOTO 901 !CANNOT DO - IF (E_C.EQ.DWC_NULLVALUE) GOTO 901 !"" - IF (E_C.EQ.DWC_WILDCARD) THEN !ASK SEPARATE - 11 CONTINUE - IF (MDHJ(MDH_TYP_J)*GDESJ(MDH_TYP_J).NE.0 .AND. - 1 MDHJ(MDH_TYP_J).NE.GDESJ(MDH_TYP_J) .AND. - 1 CVT.EQ.0) THEN - CALL WNCTXT(F_TP,'To convert apparent <-> epoch a '// - 1 'reference scan is needed.') - CALL WNCTXT(F_TP,'Use EDIT to change without conversion') - GOTO 10 !RETRY - END IF - RA(1)=360.*GDESD(MDH_RA_D) !MAKE PROMPT - RA(2)=360.*GDESD(MDH_DEC_D) - RA(3)=GDESD(MDH_FRQ_D) - RA(4)=0 - RA(5)=IAND(GDESJ(MDH_BITS_J),MDHINS_M) !INSTRUMENT - IF (.NOT.WNDPAR('REFERENCE_DATA',RA,5*LB_D,J0, - 1 A_B(-A_OB),RA,5)) GOTO 901 !STOP - IF (J0.NE.5) GOTO 901 - IF ((RA(1).EQ.RA(2) .AND. RA(1).EQ.0) .OR. - 1 RA(3).LE.0) GOTO 11 - MDHD(MDH_RA_D)=RA(1)/360 !MAKE FRACTIONS - MDHD(MDH_DEC_D)=RA(2)/360 - MDHD(MDH_FRQ_D)=RA(3) - PHI=RA(4)/360 - MDHJ(MDH_BITS_J)=NINT(RA(5)) !INSTRUMENT - ELSE !GET SCAN DATA - IF (.NOT.WNFOP(SFCA,SFIL,'R')) THEN - CALL WNCTXT(F_TP,'Cannot find SCN file') - GOTO 901 - END IF - IF (.NOT.WNDSTA('REF_SCN_SET',MXNSET,SETS,SFCA)) GOTO 902 - IF (.NOT.NSCSTG(SFCA,SETS,STH,STHP,SNAM)) THEN - CALL WNCTXT(F_TP,'Cannot find SCN sector') - GOTO 902 - END IF - CALL WNFCL(SFCA) !CLOSE SCAN - IF (MDHJ(MDH_TYP_J).EQ.1) THEN !APPARENT - MDHD(MDH_RA_D)=STHD(STH_RA_D) - MDHD(MDH_DEC_D)=STHD(STH_DEC_D) - MDHD(MDH_FRQ_D)=STHD(STH_FRQ_D) - PHI=STHE(STH_PHI_E) - MDHJ(MDH_BITS_J)=STHJ(STH_INST_J) !INSTRUMENT - LMDHD(MDH_RA_D)=STHD(STH_RAE_D) !FOR POSSIBLE INTERIM - LMDHD(MDH_DEC_D)=STHD(STH_DECE_D) - LMDHD(MDH_FRQ_D)=STHD(STH_FRQE_D) - ELSE !1950 - MDHD(MDH_RA_D)=STHD(STH_RAE_D) - MDHD(MDH_DEC_D)=STHD(STH_DECE_D) - MDHD(MDH_FRQ_D)=STHD(STH_FRQE_D) - PHI=-STHE(STH_PHI_E) - MDHJ(MDH_BITS_J)=STHJ(STH_INST_J) !INSTRUMENT - LMDHD(MDH_RA_D)=STHD(STH_RA_D) !FOR POSSIBLE INTERIM - LMDHD(MDH_DEC_D)=STHD(STH_DEC_D) - LMDHD(MDH_FRQ_D)=STHD(STH_FRQ_D) - END IF - END IF - END IF -C -C CONVERT -C - IF (MDHJ(MDH_TYP_J)*GDESJ(MDH_TYP_J).NE.0 .AND. - 1 MDHJ(MDH_TYP_J).NE.GDESJ(MDH_TYP_J) .AND. - 1 CVT.EQ.0) THEN !APPARENT <-> EPOCH - D0=MDHD(MDH_RA_D) !SET SHIFT ONLY - MDHD(MDH_RA_D)=LMDHD(MDH_RA_D) - LMDHD(MDH_RA_D)=D0 - D0=MDHD(MDH_DEC_D) - MDHD(MDH_DEC_D)=LMDHD(MDH_DEC_D) - LMDHD(MDH_DEC_D)=D0 - D0=MDHD(MDH_FRQ_D) - MDHD(MDH_FRQ_D)=LMDHD(MDH_FRQ_D) - LMDHD(MDH_FRQ_D)=D0 - LMDHJ(MDH_TYP_J)=MDHJ(MDH_TYP_J) - MDHJ(MDH_TYP_J)=GDESJ(MDH_TYP_J) - IF (.NOT.NMOCVS(GDES,MDH,PHI,CVT)) THEN !CONVERT DATA - 20 CONTINUE - CALL WNCTXT(F_TP,'Error in conversion') - GOTO 901 - END IF - MDHD(MDH_RA_D)=LMDHD(MDH_RA_D) !SET ROTATION - MDHD(MDH_DEC_D)=LMDHD(MDH_DEC_D) - MDHD(MDH_FRQ_D)=LMDHD(MDH_FRQ_D) - MDHJ(MDH_TYP_J)=LMDHJ(MDH_TYP_J) - IF (.NOT.NMOCVS(GDES,MDH,PHI,1)) GOTO 20 !CONVERT DATA - ELSE !NO ROTATION CONVERSION - IF (.NOT.NMOCVS(GDES,MDH,PHI,CVT)) GOTO 20 !CONVERT DATA - END IF -C -C REWRITE DATA -C - IF (.NOT.WNFOP(FCAOUT,FILOUT,'U')) THEN - CALL WNCTXT(F_TP,'Cannot output data') - GOTO 901 - END IF - CALL NMOWRS(FCAOUT,GDES) !WRITE DATA BACK -C - RETURN -C -C ERRORS -C - 902 CONTINUE - CALL WNFCL(SFCA) - GOTO 901 - 900 CONTINUE - CALL WNFCL(FCAOUT) - 901 CONTINUE -C - RETURN -C -C - END diff --git a/src/nscan/nmocvx.for b/src/nscan/nmocvx.for deleted file mode 100644 index a7b37c554d20aea94c29c21d12393f35ca22f073..0000000000000000000000000000000000000000 --- a/src/nscan/nmocvx.for +++ /dev/null @@ -1,103 +0,0 @@ -C+ NMOCVX.FOR -C WNB 900905 -C -C Revisions: -C - SUBROUTINE NMOCVX -C -C Convert MDL file from VAX to local format -C -C Result: -C -C CALL NMOCVX will convert a MDL file from VAX to local format -C -C PIN references: -C -C -C Include files: -C - INCLUDE 'WNG_DEF' - INCLUDE 'NMO_DEF' - INCLUDE 'GFH_O_DEF' !GENERAL FILE HEADER - INCLUDE 'GFH_T_DEF' - INCLUDE 'MDH_O_DEF' !MODEL HEADER - INCLUDE 'MDH_T_DEF' - INCLUDE 'MDL_O_DEF' !MODEL - INCLUDE 'MDL_T_DEF' -C -C Parameters: -C -C -C Arguments: -C -C -C Function references: -C - LOGICAL WNFRD !READ DATA - LOGICAL WNFWR !WRITE DATA -C -C Data declarations: -C - INTEGER CVT !CONVERSION TYPE - BYTE GFH(0:GFHHDL-1) !GENERAL FILE HEADER - INTEGER GFHJ(0:GFHHDL/4-1) - EQUIVALENCE (GFH,GFHJ) - BYTE MDH(0:MDHHDL-1) !MODEL HEADER - INTEGER MDHJ(0:MDHHDL/4-1) - EQUIVALENCE (MDH,MDHJ) - BYTE MDL(0:MDLHDL-1) !MODEL LINE -C- -C -C INIT -C -C -C GENERAL FILE HEADER -C - IF (.NOT.WNFRD(FCAOUT,GFHHDL,GFH,0)) THEN !READ GENERAL FILE HEADER - 10 CONTINUE - CALL WNCTXT(F_TP,'!/I/O error on MDL file') - GOTO 900 !READY - END IF - IF (GFH(GFH_DATTP_B).EQ.0) GFH(GFH_DATTP_B)=1 !ASSUME VAX INPUT - CVT=GFH(GFH_DATTP_B) !CONVERSION TYPE - IF (GFH(GFH_DATTP_B).EQ.PRGDAT) THEN - CALL WNCTXT(F_TP,'!/Data already converted') - GOTO 800 - END IF - CALL WNTTTL(GFHHDL,GFH,GFH_T,CVT) !CONVERT - GFH(GFH_DATTP_B)=PRGDAT !SET CURRENT DATA TYPE - IF (.NOT.WNFWR(FCAOUT,GFHHDL,GFH,0)) GOTO 10 !REWRITE HEADER -C -C MODEL HEADER -C - IF (.NOT.WNFRD(FCAOUT,MDHHDL,MDH, - 1 GFHJ(GFH_LINK_J))) GOTO 10 !READ HEADER - CALL WNTTTL(MDHHDL,MDH,MDH_T,CVT) !CONVERT IT - IF (.NOT.WNFWR(FCAOUT,MDHHDL,MDH, - 1 GFHJ(GFH_LINK_J))) GOTO 10 !WRITE IT -C -C SOURCES -C - DO I=0,MDHJ(MDH_NSRC_J)-1 !ALL SOURCES - IF (.NOT.WNFRD(FCAOUT,MDLHDL,MDL, - 1 MDHJ(MDH_MODP_J)+I*MDLHDL)) GOTO 10 !READ - CALL WNTTTL(MDLHDL,MDL,MDL_T,CVT) !TRANSLATE - IF (.NOT.WNFWR(FCAOUT,MDLHDL,MDL, - 1 MDHJ(MDH_MODP_J)+I*MDLHDL)) GOTO 10 !WRITE - END DO -C -C READY -C - 800 CONTINUE - CALL WNFCL(FCAOUT) !CLOSE FILE -C - RETURN -C -C ERROR -C - 900 CONTINUE - CALL WNFCL(FCAOUT) !CLOSE FILE - RETURN !READY -C -C - END diff --git a/src/nscan/nmocxi.for b/src/nscan/nmocxi.for deleted file mode 100644 index 10a1688323e225b0dfc6e9696d295e8b2b3a46d4..0000000000000000000000000000000000000000 --- a/src/nscan/nmocxi.for +++ /dev/null @@ -1,246 +0,0 @@ -C+ NMOCXI.FOR -C WNB 930825 -C -C Revisions: -C WNB 930827 Use SMOD properly -C WNB 930901 Correct Q,U interchange; WSRT sign U -C CMV 930910 Change sign V -C CMV 930913 Calculate/shuffle weights as well as data -C WNB 931029 Convex does not accept complex parameter -C - SUBROUTINE NMOCXI(STHJ,SCHE,ANG,WGT,OWGT,CDAT,CMOD) -C -C Convert data XYX to Stokes Model -C -C Result: -C -C CALL NMOCXI( STHJ_J(0:*):I, SCHE_E(0:*):I, ANG_E(0:2,0:*):I, -C WGT_E(0:*,0:3), OWGT_J(0:*), -C CDAT_X(0:*,0:3):I, CMOD_X(0:3,0:*):O) -C Convert data XYX to proper Stokes data, -C using the STH set and SCH scan header. -C CDAT are the XYX data, CMOD the Stokes data, -C and WGT the data weight. -C ANG contains: -C 0: the parallactic angle of W X-dipole (circles) -C 1: sin(E X-dipole - W X-dipole) -C 2: cos(...) -C If a Stokes cannot be made, the corresponding -C item will be set to 0 and the OWGT. -C CALL NMOCXX( STHJ_J(0:*):I, SCHE_E(0:*):I, ANG_E(0:2,0:*):I, -C WGT_E(0:*,0:3):IO, OWGT_J(0:*,0:3):O, -C CDAT_X(0:*,0:3):I, OCDAT_X(0:*,0:3):O, -C NPOL_J:I, TYPE_J(0:NPOL-1):I) -C Convert XYX to Stokes or XYX for NPOL (<=4) -C codes TYPE (see CBITS). Data will be in -C CDAT. OWGT is 1 if all requested pol's are -C there, else 0. WGT(*,ipol) will have the -C weight corresponding to CDAT(*,ipol) at -C output (0 if ipol could not be calculated). -C CDAT maybe OCDAT. -C -C Include files: -C - INCLUDE 'WNG_DEF' - INCLUDE 'CBITS_DEF' - INCLUDE 'STH_O_DEF' !SET HEADER - INCLUDE 'SCH_O_DEF' !SCAN HEADER -C -C Parameters: -C -C -C Arguments: -C - INTEGER STHJ(0:*) !SET HEADER - REAL SCHE(0:*) !SCAN HEADER - REAL ANG(0:2,0:*) !DIPOLE ANGLES - REAL WGT(0:STHIFR-1,0:3) !WEIGHT - INTEGER OWGT(0:STHIFR-1) !OUTPUT WEIGHT SET TO ZERO IF NO SUCCESS - COMPLEX CDAT(0:STHIFR-1,0:3) !DATA - COMPLEX OCDAT(0:STHIFR-1,0:3) !OUTPUT DATA - COMPLEX CMOD(0:3,0:*) !MODEL - INTEGER NPOL !# OF OUTPUT DESCRIPTORS (<= 4) - INTEGER TYP(0:*) !DESCRIPTORS -C -C Function references: -C -C -C Data declarations: -C - LOGICAL SMOD !SET MODEL/DATA - INTEGER LN !# TO DO - INTEGER LC(0:3) !LOCAL COUNT - COMPLEX LDAT(0:3) !LOCAL DATA - REAL LWGT(0:3) !LOCAL WEIGHTS - INTEGER DTYP(0:3) !DEFAULT TYPES - DATA DTYP/I_M,Q_M,U_M,V_M/ - INTEGER LT(0:3) !LOCAL TYPES - REAL SX,CX !SIN,COS(2.CHI+B) - REAL SBS,CBS,SBR !SIGN OF SIN,COS(BETA) - REAL MAT(0:3,0:3) !CONVERSION MATRIX - INTEGER CM(0:3) !COUNT OF DATA POINTS - COMPLEX CXI !I -C- -C -C NMOCXI -C - LN=4 !# TO DO - DO I=0,LN-1 !SET TYPES - LT(I)=DTYP(I) - END DO - SMOD=.TRUE. !MAKE MODEL - GOTO 100 -C -C NMOCXX -C - ENTRY NMOCXX(STHJ,SCHE,ANG,WGT,OWGT,CDAT,OCDAT,NPOL,TYP) -C - LN=MIN(4,NPOL) !# TO DO - DO I=0,LN-1 !SET TYPES - LT(I)=TYP(I) - END DO - SMOD=.FALSE. !MAKE DATA - GOTO 100 -C -C INIT -C - 100 CONTINUE - CXI=CMPLX(0,1) -C -C ALL DATA -C - DO I=0,STHJ(STH_NIFR_J)-1 !ALL DATA POINTS -C -C INIT -C - SBS=1 !ASSUME POS. SIGN - CBS=1 - SBR=1 - IF (STHJ(STH_INST_J).EQ.0) THEN !WSRT - IF (ANG(1,I).LE.0) SBS=-1 !REVERSE SIGN - IF (ANG(2,I).LT.0) CBS=-1 - SBR=-SBS - END IF - R0=(2*(SCHE(SCH_PANG_E)+ANG(0,I)))*PI2 !2*CHI - R1=COS(R0) !COS - R0=SIN(R0) - SX=R0*ANG(2,I)+R1*ANG(1,I) !SIN(2*CHI+BETA) - CX=R1*ANG(2,I)-R0*ANG(1,I) !COS - R0=2*(ABS(ANG(1,I))+ABS(ANG(2,I))) !NORMALISATION - MAT(0,0)=+ANG(2,I)*CBS !MATRIX I - MAT(1,0)=-ANG(1,I)*SBR - MAT(2,0)=+ANG(1,I)*SBS - MAT(3,0)=+ANG(2,I)*CBS - MAT(0,1)=+CX*CBS !MATRIX Q - MAT(1,1)=-SX*SBR - MAT(2,1)=-SX*SBS - MAT(3,1)=-CX*CBS - MAT(0,2)=+SX*CBS !MATRIX U - MAT(1,2)=+CX*SBR - MAT(2,2)=+CX*SBS - MAT(3,2)=-SX*CBS - MAT(0,3)=+ANG(1,I)*CBS !MATRIX V - MAT(1,3)=+ANG(2,I)*SBR - MAT(2,3)=-ANG(2,I)*SBS - MAT(3,3)=+ANG(1,I)*CBS - DO I1=0,3 !COUNT HOW MANY - CM(I1)=0 !SET 0 - DO I2=0,3 - IF (ABS(MAT(I2,I1)).LT.1E-6) MAT(I2,I1)=0 !MAKE SURE - IF (MAT(I2,I1).NE.0) CM(I1)=CM(I1)+1 !CNT HOW MANY TO USE - END DO - END DO -C -C MAKE STOKES -C - DO I1=0,LN-1 !ALL REQUESTS - LC(I1)=0 !COUNT POINTS FOUND - LDAT(I1)=0 !OUTPUT DATA - LWGT(I1)=0 !OUTPUT WEIGHT -C -C XYX -C - IF (IAND(LT(I1),STOKES_P).EQ.0) THEN !NOT STOKES - IF (IAND(LT(I1),XX_P).NE.0) THEN !XX ASKED - I2=0 - ELSE IF (IAND(LT(I1),XY_P).NE.0) THEN - I2=1 - ELSE IF (IAND(LT(I1),YX_P).NE.0) THEN - I2=2 - ELSE IF (IAND(LT(I1),YY_P).NE.0) THEN - I2=3 - ELSE - I2=-1 - END IF - IF (I2.GE.0) THEN !TO DO - IF (WGT(I,I2).GT.0) THEN !SELECTED - LC(I1)=LC(I1)+1 !COUNT - LDAT(I1)=LDAT(I1)+CDAT(I,I2) !MAKE - LWGT(I1)=LWGT(I1)+WGT(I,I2) !MAKE - END IF - END IF -C -C STOKES -C - ELSE !STOKES - IF (IAND(LT(I1),SI_P).NE.0) THEN !I ASKED - I2=0 - ELSE IF (IAND(LT(I1),SQ_P).NE.0) THEN - I2=1 - ELSE IF (IAND(LT(I1),SU_P).NE.0) THEN - I2=2 - ELSE IF (IAND(LT(I1),SV_P).NE.0) THEN - I2=3 - ELSE - I2=-1 - END IF - IF (I2.GE.0) THEN !SOME ASKED - DO I3=0,3 !SCAN MATRIX - IF (MAT(I3,I2).NE.0) THEN !SHOULD TAKE THIS ONE - IF (WGT(I,I3).GT.0) THEN !PRESENT - LC(I1)=LC(I1)+1 !COUNT - LDAT(I1)=LDAT(I1)+MAT(I3,I2)*CDAT(I,I3) !AND DATA - LWGT(I1)=LWGT(I1)+WGT(I,I3) !MAKE - END IF - END IF - END DO - END IF - IF (LC(I1).LT.CM(I2)) THEN !NOT ENOUGH - IF (IAND(LT(I1),LINE_P).EQ.0) LC(I1)=0 !ACCEPT ONLY LINE I - END IF - IF (LC(I1).GT.0) THEN !NORMALISE - LDAT(I1)=LDAT(I1)/R0*REAL(CM(I2))/REAL(LC(I1)) - LWGT(I1)=LWGT(I1)/REAL(LC(I1)) - END IF -C CMV930909 Changed sign - IF (I2.EQ.3) LDAT(I1)=CXI*LDAT(I1) !MAKE V - END IF !STOKES - IF (IAND(LT(I1),IMAG_P).NE.0) LDAT(I1)=CXI*LDAT(I1) !IMAGINARY - END DO !ALL REQUESTS - DO I1=LN,3 !DELETE REST - LC(I1)=-1 - END DO - DO I1=0,3 !OUTPUT ALL - IF (LC(I1).GT.0) THEN - IF (SMOD) THEN - CMOD(I1,I)=LDAT(I1) - ELSE - OCDAT(I,I1)=LDAT(I1) - WGT(I,I1)=LWGT(I1) - END IF - ELSE - IF (SMOD) THEN - CMOD(I1,I)=0 - ELSE - OCDAT(I,I1)=0 - WGT(I,I1)=0 - END IF - IF (LC(I1).EQ.0) OWGT(I)=0 !DELETE POINT - END IF - END DO - END DO !INTERFEROMETERS -C - RETURN -C -C - END diff --git a/src/nscan/nmodat.for b/src/nscan/nmodat.for deleted file mode 100644 index 0b4d7c38c08c7c7f77ffb0b7c79d2d6925cf3d76..0000000000000000000000000000000000000000 --- a/src/nscan/nmodat.for +++ /dev/null @@ -1,888 +0,0 @@ -C+ NMODAT.FOR -C WNB 900327 -C -C Revisions: -C WNB 910814 Add (de-)beam -C WNB 910909 Add CAL option -C WNB 910909 Add NMODAY -C WNB 911230 ADD NMOANC -C WNB 920626 Add NMOACD -C WNB 920818 Add NMOAAD -C WNB 921104 Full HA range -C WNB 921217 Add AFIND -C HjV 930423 Change name of some keywords -C WNB 930514 Add manual find -C WNB 930615 Make correct MDL_NODE keywords -C WNB 930825 New pol. selection -C WNB 930826 New HA selection -C HjV 930914 NSCIFS is now a function iso. a subroutine -C WNB 931008 Add EDIT ACTION; chnage CC to CCBM -C WNB 931011 Add SUPDATE -C WNB 931119 Add REDIT, FEDIT action -C CMV 931220 Pass FCA of input file to WNDXLP and WNDSTA/Q -C CMV 940224 Add option INTERN, new entry NMODAW -C CMV 940225 Split off some options from MODEL_OPTION -C CMV 940228 Add option to edit and test the "unknown-flux" bit -C HjV 940303 Tekst typo's -C CMV 940328 Changed WNGGD call to WNGMV (did not work on HP) -C CMV 940415 Add SHOW option to MODEL_MODIFY -C CMV 940817 Prohibit INTERNAL for NMODAV (used for REDUN) -C WNB 940821 Add Polarisation updates -C WNB 950629 Add UPDATE_MODE,_CLUSTER -C WNB 950630 Add more update options -C WNB 950706 Add looped updates -C HjV 951002 Change test in update-part (Change LLOPT3 in LLOPT4) -C CMV 960122 Print reminder if INTERNAL is on -C JPH 960130 Truncate .<number> in default MDL name -C JEN 960403 Add option RMERGE, to merge nearby sources -C JPH 960614 Zero DLDM -C WNB 990729 Add X00-X03 as update modes -C CMV 000928 Remove prefixed * in name of model file -C CMV 031231 FLUX_KNOWN from byte to logical -C - SUBROUTINE NMODAT -C -C Get NMODEL program parameters -C -C Result: -C -C CALL NMODAT -C Will ask and set all program parameters -C CALL NMODAW( NGSRC_J:O, STH_B(0:*):I) -C Will ask and set all program parameters -C for handle, and return # of sources in general list -C The default model-file for the read option is -C derived the sector header STH -C CALL NMODAV( NGSRC_J:O, STH_B(0:*):I, FLUX_KNOWN_L:I) -C Idem, and test if the 'unknown-flux' bit is cleared -C Do not allow the use of INTERNAL -C CALL NMODAX( NGSRC_J:O) -C Idem, but without a default model file -C CALL NMODAY -C Will ask for a (possible) output node -C -C PIN references: -C -C ACTION -C FIND_TYPE -C UPDATE_TYPE -C UPDATE_MODE -C UPDATE_CLUSTER -C MODEL_OPTION -C OUTPUT_MDL_NODE -C INPUT_MDL_NODE -C MDL_NODE -C WMP_NODE -C WMP_SETS -C AREA -C ID_START -C MAP_LIMIT -C MAX_NUMBER -C -C Include files: -C - INCLUDE 'WNG_DEF' - INCLUDE 'NMO_DEF' - INCLUDE 'CBITS_DEF' - INCLUDE 'MPH_O_DEF' !MAP HEADER - INCLUDE 'MDH_O_DEF' !MODEL HEADER - INCLUDE 'MDL_O_DEF' !MODEL LINE - INCLUDE 'STH_O_DEF' !SECTOR HEADER - INCLUDE 'DLDM_DEF' ! beam offset for beam measurement -C NOTE: DLDM is cleared for all entry points just to make sure -C that a lingering offset will not confuse NMOBMV. This is -C probably not necessary for the secondary entry points because -C these are called in a context in which a .SCN file is read and -C DLDM set by NSCSTG -C -C Parameters: -C -C -C Arguments: -C - INTEGER NGSRC !# OF SOURCES IN GENERAL LIST - BYTE STH(0:STH__L-1) !Sector header - LOGICAL FN !Return .TRUE. if flux known -C -C Entry points: -C -C -C Function references: -C - INTEGER WNCALN !SIGNIFICANT LENGTH OF STRING - LOGICAL WNDPAR !GET DWARF PARAMETER - LOGICAL WNDNOD !GET NODE NAME - LOGICAL WNFOP !OPEN FILE - LOGICAL WNDSTA !GET WMP_SETS/SCN_SETS TO DO - LOGICAL NMASTG !GET A MAP - LOGICAL NMOSLI !GET GENERAL SOURCE LIST - LOGICAL NSCPLS !GET POL. SELECTION - LOGICAL NSCHAS !SELECT HA - LOGICAL NSCIFS !Select/deselect interferometers - LOGICAL NSCSTG !Get a set - DOUBLE PRECISION WNGGD !Get double precision from byte array -C -C Data declarations: -C - LOGICAL DO_UNF !Test unknown flux bit at exit - LOGICAL BACK_MOD !Return-flag for show menu - LOGICAL INTERNAL_OK !Allow use of INTERNAL option - CHARACTER FIELDMDL*128 !Name of modelfile for FIELD option - CHARACTER LLOPT*24 !Local option - CHARACTER*4 LLOPT4 - EQUIVALENCE (LLOPT,LLOPT4) - INTEGER TMPCAP,TMPCDAP !TEMP CORRECTIONS FOR INTERN OPTION - INTEGER RANGE(0:1) !SOURCE RANGE - INTEGER SNAM(0:7) !SET NAME - INTEGER MXARE(0:3) !MAX. SEARCH AREA - DATA MXARE/0,0,0,0/ - INTEGER MPHP !MAP POINTER - INTEGER STHP !SET POINTER - BYTE LBT - BYTE LSTH(0:STH__L-1) !SET HEADER - DOUBLE PRECISION LSTHD(0:STH__L/LB_D-1) - EQUIVALENCE (LSTH,LSTHD) - BYTE MPH(0:MPHHDL-1) !MAP HEADER - INTEGER MPHJ(0:MPHHDL/4-1) - EQUIVALENCE (MPH,MPHJ) -C- -C -C GET ACTION -C - 100 CONTINUE - DLDM(0)=0 ! reset beam - DLDM(1)=0 ! offset - IF (.NOT.WNDPAR('ACTION',ACTION,LEN(ACTION),J0,ACTION)) THEN - ACTION='QUIT' !ASSUME END - ELSE IF (J0.LE.0) THEN - ACTION='QUIT' !ASSUME END - END IF -C -C FROM/TO OLD -C - IF (ACT.EQ.'FRO') THEN - 110 CONTINUE - IF (.NOT.WNDPAR('OLD_FILE',FILIN,LEN(FILIN),J0,'""')) THEN - IF (E_C.EQ.DWC_ENDOFLOOP) GOTO 100 !RETRY ACTION - GOTO 110 !REASK - ELSE IF (J0.EQ.0) THEN !RETRY ACTION - GOTO 100 - ELSE IF (J0.LT.0) THEN !MUST SPECIFY - GOTO 110 - END IF - 111 CONTINUE - IF (.NOT.WNDNOD('OUTPUT_MDL_NODE',' ','MDL', - 1 'W',NODOUT,FILOUT)) THEN - IF (E_C.EQ.DWC_ENDOFLOOP) GOTO 100 !RETRY ACTION - GOTO 111 !REPEAT - ELSE IF (E_C.EQ.DWC_NULLVALUE) THEN - GOTO 100 !RETRY ACTION - ELSE IF (E_C.EQ.DWC_WILDCARD) THEN - GOTO 111 !MUST SPECIFY - END IF - IF (.NOT.WNFOP(FCAOUT,FILOUT,'U')) THEN - CALL WNCTXT(F_TP,'!/Cannot open !AS (!XJ)',NODOUT,E_C) - GOTO 111 !RETRY - END IF - ELSE IF (ACT.EQ.'TO_') THEN !TO OLD - 112 CONTINUE - IF (.NOT.WNDNOD('INPUT_MDL_NODE',' ','MDL', - 1 'R',NODOUT,FILOUT)) THEN - IF (E_C.EQ.DWC_ENDOFLOOP) GOTO 100 !RETRY ACTION - GOTO 112 !REPEAT - ELSE IF (E_C.EQ.DWC_NULLVALUE) THEN - GOTO 100 !RETRY ACTION - ELSE IF (E_C.EQ.DWC_WILDCARD) THEN - GOTO 112 !MUST SPECIFY - END IF - IF (.NOT.WNFOP(FCAOUT,FILOUT,'R')) THEN - CALL WNCTXT(F_TP,'!/Cannot open !AS (!XJ)',NODOUT,E_C) - GOTO 112 !RETRY - END IF - 113 CONTINUE - IF (.NOT.WNDPAR('OLD_FILE',FILIN,LEN(FILIN),J0,'""')) THEN - IF (E_C.EQ.DWC_ENDOFLOOP) GOTO 100 !RETRY ACTION - GOTO 113 !REASK - ELSE IF (J0.EQ.0) THEN !RETRY ACTION - GOTO 100 - ELSE IF (J0.LT.0) THEN !MUST SPECIFY - GOTO 113 - END IF -C -C CONVERT/BEAM/DE-BEAM -C - ELSE IF (ACT.EQ.'CON' .OR. ACT.EQ.'BEA' .OR. ACT.EQ.'DEB' .OR. - 1 ACT.EQ.'EDI' .OR. ACT.EQ.'FED' .OR. - 1 ACT.EQ.'RED') THEN - 120 CONTINUE - IF (.NOT.WNDNOD('MDL_NODE',' ','MDL','R',NODOUT,FILOUT)) THEN - IF (E_C.EQ.DWC_ENDOFLOOP) GOTO 100 !RETRY ACTION - GOTO 120 !REPEAT - ELSE IF (E_C.EQ.DWC_NULLVALUE) THEN - GOTO 100 !RETRY ACTION - ELSE IF (E_C.EQ.DWC_WILDCARD) THEN - GOTO 120 !MUST SPECIFY - END IF - IF (.NOT.WNFOP(FCAOUT,FILOUT,'R')) THEN - CALL WNCTXT(F_TP,'!/Cannot open !AS (!XJ)',NODOUT,E_C) - GOTO 120 !RETRY - END IF -C -C NEW VERSION -C - ELSE IF (ACT.EQ.'NVS') THEN - 130 CONTINUE - IF (.NOT.WNDNOD('MDL_NODE',' ','MDL','R',NODOUT,FILOUT)) THEN - IF (E_C.EQ.DWC_ENDOFLOOP) GOTO 100 !RETRY ACTION - GOTO 130 !REPEAT - ELSE IF (E_C.EQ.DWC_NULLVALUE) THEN - GOTO 100 !RETRY ACTION - ELSE IF (E_C.EQ.DWC_WILDCARD) THEN - GOTO 130 !MUST SPECIFY - END IF - IF (.NOT.WNFOP(FCAOUT,FILOUT,'U')) THEN - CALL WNCTXT(F_TP,'!/Cannot open !AS (!XJ)',NODOUT,E_C) - GOTO 130 !RETRY - END IF -C -C CONVERT VAX FORMAT -C - ELSE IF (ACT.EQ.'CVX') THEN - 131 CONTINUE - IF (.NOT.WNDNOD('MDL_NODE',' ','MDL','R',NODOUT,FILOUT)) THEN - IF (E_C.EQ.DWC_ENDOFLOOP) GOTO 100 !RETRY ACTION - GOTO 131 !REPEAT - ELSE IF (E_C.EQ.DWC_NULLVALUE) THEN - GOTO 100 !RETRY ACTION - ELSE IF (E_C.EQ.DWC_WILDCARD) THEN - GOTO 131 !MUST SPECIFY - END IF - IF (.NOT.WNFOP(FCAOUT,FILOUT,'U')) THEN - CALL WNCTXT(F_TP,'!/Cannot open !AS (!XJ)',NODOUT,E_C) - GOTO 131 !RETRY - END IF -C -C SCAN FILE -C -C GET -C - ELSE IF (ACT.EQ.'GET') THEN !GET FROM SCAN FILE - 132 CONTINUE - IF (.NOT.WNDNOD('SCN_NODE',' ','SCN','R',NODIN,FILIN)) THEN - IF (E_C.EQ.DWC_ENDOFLOOP) GOTO 100 !RETRY ACTION - GOTO 132 !REPEAT - ELSE IF (E_C.EQ.DWC_NULLVALUE) THEN - GOTO 100 !RETRY ACTION - ELSE IF (E_C.EQ.DWC_WILDCARD) THEN - GOTO 132 !MUST SPECIFY - END IF - IF (.NOT.WNFOP(FCAIN,FILIN,'R')) THEN - CALL WNCTXT(F_TP,'!/Cannot open !AS (!XJ)',NODIN,E_C) - GOTO 132 !RETRY - END IF - IF (.NOT.WNDSTA('SCN_SETS',MXNSET,SETS,FCAIN)) THEN !GET SETS - CALL WNFCL(FCAIN) - GOTO 132 - END IF -C -C SAVE -C - ELSE IF (ACT.EQ.'SAV') THEN !SAVE MODEL IN SCAN FILE - 133 CONTINUE - IF (.NOT.WNDNOD('SCN_NODE',' ','SCN','R',NODIN,FILIN)) THEN - IF (E_C.EQ.DWC_ENDOFLOOP) GOTO 100 !RETRY ACTION - GOTO 133 !REPEAT - ELSE IF (E_C.EQ.DWC_NULLVALUE) THEN - GOTO 100 !RETRY ACTION - ELSE IF (E_C.EQ.DWC_WILDCARD) THEN - GOTO 133 !MUST SPECIFY - END IF - IF (.NOT.WNFOP(FCAIN,FILIN,'U')) THEN - CALL WNCTXT(F_TP,'!/Cannot open !AS (!XJ)',NODIN,E_C) - GOTO 133 !RETRY - END IF - IF (.NOT.WNDSTA('SCN_SETS',MXNSET,SETS,FCAIN)) THEN !GET SETS - CALL WNFCL(FCAIN) - GOTO 133 - END IF -C -C UPDATE -C - ELSE IF (ACT.EQ.'UPD') THEN !UPDATE MODEL WITH SCAN FILE - IF (.NOT.WNDPAR('UPDATE_TYPE',OPTION,LEN(OPTION),J0,'ILM')) THEN - OPTION='QUIT' - ELSE IF (J0.LE.0) THEN - OPTION='QUIT' - END IF - IF (OPT.EQ.'QUI') GOTO 100 !RETRY ACTION - IF (.NOT.WNDPAR('UPDATE_MODE',LLOPT,LEN(LLOPT),J0,'SEP')) THEN - OPTION='QUIT' - ELSE IF (J0.LE.0) THEN - OPTION='QUIT' - END IF - IF (LLOPT4.EQ.'QUIT') OPTION='QUIT' - IF (OPT.EQ.'QUI') GOTO 100 !RETRY ACTION - IF (LLOPT4.EQ.'SEPA') THEN - OPTION(4:5)='SS' - ELSE IF (LLOPT4.EQ.'CLUS') THEN - OPTION(4:5)='XS' - ELSE IF (LLOPT4.EQ.'COMB') THEN - OPTION(4:5)='YS' - ELSE IF (LLOPT4.EQ.'CONS') THEN - OPTION(4:5)='ZS' - ELSE IF (LLOPT4.EQ.'LCLU') THEN - OPTION(4:5)='XL' - ELSE IF (LLOPT4.EQ.'LCOM') THEN - OPTION(4:5)='YL' - ELSE IF (LLOPT4.EQ.'LCON') THEN - OPTION(4:5)='ZL' - ELSE - OPTION='QUIT' - GOTO 100 - END IF - 141 CONTINUE - IF (.NOT.WNDNOD('SCN_NODE',' ','SCN','U',NODIN,FILIN)) THEN - IF (E_C.EQ.DWC_ENDOFLOOP) GOTO 100 !RETRY UNIT - GOTO 141 !REPEAT - ELSE IF (E_C.EQ.DWC_NULLVALUE) THEN - GOTO 100 !RETRY OPTION - ELSE IF (E_C.EQ.DWC_WILDCARD) THEN - GOTO 141 !MUST SPECIFY - END IF - IF (.NOT.WNFOP(FCAIN,FILIN,'U')) THEN !OPEN OUTPUT SCAN FILE - GOTO 141 !RETRY - END IF -C - IF (.NOT.WNDSTA('SCN_SETS',MXNSET,SETS,FCAIN)) THEN !NO SETS - 142 CONTINUE - CALL WNFCL(FCAIN) - GOTO 141 - END IF - IF (SETS(0,0).EQ.0) GOTO 142 !NONE SPECIFIED -C - IF (.NOT.NSCPLS(2,SPOL)) GOTO 141 !SELECT POL. -C - 143 CONTINUE - IF (.NOT.NSCHAS(1,HARAN)) GOTO 142 !GET HA RANGE -C - IF (.NOT.NSCIFS(2,SIFRS)) GOTO 142 !SELECT INTERFEROMETERS -C - CALL NSCSAD(CORAP,CORDAP) !GET CORRECTIONS TO (DE-)APPLY - IF (OPTION(4:4).NE.'S') THEN - IF (.NOT.NSCSTG(FCAIN,SETS,LSTH,STHP,SNAM)) THEN !FIND A SET - GOTO 142 - END IF - CALL WNDSTR(FCAIN,SETS) !RESET SET SEARCH - SORRAN(0)=2*1.5/(3000.*PI2*LSTHD(STH_FRQ_D)/CL/(1.E-6)) - 1 *DEG*3600. - SORRAN(1)=SORRAN(0)/ABS(SIN(LSTHD(STH_DEC_D)*DPI2)) !GUESS - IF (.NOT.WNDPAR('UPDATE_CLUSTER',SORRAN,2*LB_E,J0, - 1 A_B(-A_OB),SORRAN,2)) THEN - GOTO 143 !READY - ELSE IF (J0.EQ.0) THEN - GOTO 143 !READY - ELSE IF (J0.LT.0) THEN !ASSUME DEFAULT - SORRAN(0)=2*1.5/(3000.*PI2*LSTHD(STH_FRQ_D)/CL/(1.E-6)) - 1 *DEG*3600. - SORRAN(1)=SORRAN(0)/ABS(SIN(LSTHD(STH_DEC_D)*DPI2)) !GUESS - END IF - IF (SORRAN(0).LE.0.1) THEN - SORRAN(0)=2*1.5/(3000.*PI2*LSTHD(STH_FRQ_D)/CL/(1.E-6)) - 1 *DEG*3600. - END IF - IF (SORRAN(1).LE.0.1) THEN - SORRAN(1)=SORRAN(0)/ABS(SIN(LSTHD(STH_DEC_D)*DPI2)) !GUESS - END IF - DO I=0,1 - SORRAN(I)=SORRAN(I)/3600./DEG/2 !MAKE RADIANS HALF AXES - END DO - END IF -C -C MAP FIND -C - ELSE IF (ACT.EQ.'FIN') THEN !FIND SOURCES IN MAP - IF (.NOT.WNDPAR('FIND_TYPE',OPTION,LEN(OPTION),J0,'POS')) THEN - OPTION='QUIT' - ELSE IF (J0.LE.0) THEN - OPTION='QUIT' - END IF - IF (OPT.EQ.'QUI') GOTO 100 !RETRY ACTION - 134 CONTINUE - IF (.NOT.WNDNOD('WMP_NODE',' ','WMP','R',NODIN,FILIN)) THEN !NODE - IF (E_C.EQ.DWC_ENDOFLOOP) GOTO 100 !RETRY ACTION - GOTO 134 !REPEAT - ELSE IF (E_C.EQ.DWC_NULLVALUE) THEN - GOTO 100 !RETRY ACTION - ELSE IF (E_C.EQ.DWC_WILDCARD) THEN - GOTO 134 !MUST SPECIFY - END IF - IF (.NOT.WNFOP(FCAIN,FILIN,'R')) THEN - CALL WNCTXT(F_TP,'!/Cannot open !AS (!XJ)',NODIN,E_C) - GOTO 134 !RETRY - END IF - IF (.NOT.WNDSTA('WMP_SETS',MXNSET,SETS,FCAIN)) GOTO 134 !GET MAPS TO SEARCH - IF (.NOT.NMASTG(FCAIN,SETS,MPH,MPHP,SNAM)) GOTO 134 !GET A MAP - CALL WNDSTR(FCAIN,SETS) !RESET MAP SEARCH - DO I=0,3 !DEFAULT AREA - TAREA(I,0)=0 - FAREA(I)=0 - END DO - FAREA(2)=MPHJ(MPH_NRA_J) !LENGTH LINE - FAREA(3)=MPHJ(MPH_NDEC_J) - TAREA(2,0)=FAREA(2) !DEFAULT=FULL - TAREA(3,0)=FAREA(3) - MXARE(2)=FAREA(2) !MAX=FULL - MXARE(3)=FAREA(3) - IF (OPT.NE.'MAN') THEN !NOT MANUAL - CALL NMADAR(MXNAR,NAREA,FAREA,4,MXARE,TAREA(0,0),PAREA(0,1,0), - 1 TAREA(0,1),PAREA(0,1,1)) !GET AREAS - ELSE - CALL NMADAR(1,NAREA,FAREA,4,MXARE,TAREA(0,0),PAREA(0,1,0), - 1 TAREA(0,1),PAREA(0,1,1)) !GET AREAS - END IF - IF (NAREA.LE.0) GOTO 134 !NO AREA GIVEN - 135 CONTINUE - IF (OPT.NE.'MAN') THEN !NOT MANUAL - IF (.NOT.WNDPAR('MAP_LIMIT',MAPLIM,LB_E,J0,'0.1')) THEN !FLUX LIMIT - IF (E_C.EQ.DWC_ENDOFLOOP) GOTO 134 !RETRY ACTION - GOTO 135 !REPEAT - END IF - IF (J0.EQ.0) GOTO 134 - IF (J0.LT.0) MAPLIM=0.1 - IF (.NOT.WNDPAR('MAX_NUMBER',MAXSRN,LB_J,J0,'20')) THEN !MAX.# SOURCES - IF (E_C.EQ.DWC_ENDOFLOOP) GOTO 134 !RETRY ACTION - GOTO 135 !REPEAT - END IF - ELSE - MAXSRN=100 !TO START WITH - END IF - IF (J0.EQ.0) GOTO 134 - IF (J0.LT.0) MAXSRN=20 - IF (.NOT.WNDPAR('ID_START',IDEN,LB_J,J0,'1000')) THEN !ID START - IF (E_C.EQ.DWC_ENDOFLOOP) GOTO 134 !RETRY ACTION - GOTO 135 !REPEAT - END IF - IF (J0.EQ.0) GOTO 134 - IF (J0.LT.0) IDEN=1000 - END IF -C - RETURN !RETURN -C -C GET ALL HANDLE OPTIONS -C - ENTRY NMODAV(NGSRC,STH,FN) -C - DO_UNF=.TRUE. !Do test - INTERNAL_OK=.FALSE. !Do not allow - GOTO 17 -C - ENTRY NMODAW(NGSRC,STH) -C - DO_UNF=.FALSE. !Do not test - INTERNAL_OK=.TRUE. !Allow - GOTO 17 -C -C Construct default name -C - 17 CONTINUE - CALL WNGMTS(STH_FIELD_N,STH(STH_FIELD_1),FIELDMDL) !GET FIELD NAME - IF (FIELDMDL(1:1).EQ.'*') FIELDMDL=FIELDMDL(2:) !STRIP LEADING * - I1=INDEX(FIELDMDL,'.')-1 - IF (I1.LT.0) I1=WNCALN(FIELDMDL) -C D0=WNGGD(STH(STH_FRQ_1)) - CALL WNGMV(LB_D,STH(STH_FRQ_1),D0) - IF (D0.GT.290.AND.D0.LT.385) THEN - FIELDMDL=FIELDMDL(1:I1)//'_92cm' - ELSE IF (D0.GT.600.AND.D0.LT.620) THEN - FIELDMDL=FIELDMDL(1:I1)//'_49cm' - ELSE IF (D0.GT.1250.AND.D0.LT.1500) THEN - FIELDMDL=FIELDMDL(1:I1)//'_21cm' - ELSE IF (D0.GT.4000.AND.D0.LT.6000) THEN - FIELDMDL=FIELDMDL(1:I1)//'_6cm' - ELSE - FIELDMDL=' ' !Unknown - END IF -C - GOTO 12 -C - ENTRY NMODAX(NGSRC) -C - FIELDMDL=' ' !No default - DO_UNF=.FALSE. !Do not test - INTERNAL_OK=.TRUE. !Allow -C - 12 CONTINUE - DLDM(0)=0 ! (probably unnecessary) - DLDM(1)=0 - IF (.NOT.NMOSLI(1024)) GOTO 800 !MAKE SURE THERE IS A LIST - ACTION='HANDLE' !MAKE SURE THERE IS ACTION - CALL WNCTXT(F_TP,'There are !UJ sources in the list', - 1 GDESJ(MDH_NSRC_J)) - 10 CONTINUE - IF (.NOT.WNDPAR('MODEL_OPTION',OPTION,LEN(OPTION),J0,'QUIT')) THEN - OPTION='QUIT' - ELSE IF (J0.LE.0) THEN - OPTION='QUIT' - END IF - IF (OPT.EQ.'QUI') GOTO 800 !READY -C -C WRITE -C - 11 CONTINUE - IF (OPT.EQ.'WRI') THEN - IF (.NOT.WNDNOD('OUTPUT_MDL_NODE',' ','MDL', - 1 'W',NODOUT,FILOUT)) THEN - IF (E_C.EQ.DWC_ENDOFLOOP) GOTO 10 !RETRY OPTION - GOTO 11 !REPEAT - ELSE IF (E_C.EQ.DWC_NULLVALUE) THEN - GOTO 10 !RETRY OPTION - ELSE IF (E_C.EQ.DWC_WILDCARD) THEN - GOTO 11 !MUST SPECIFY - END IF - IF (.NOT.WNFOP(FCAOUT,FILOUT,'U')) THEN - CALL WNCTXT(F_TP,'!/Cannot open !AS (!XJ)',NODOUT,E_C) - GOTO 11 !RETRY - END IF - CALL NMOWRS(FCAOUT,GDES) !WRITE -C -C READ -C - ELSE IF (OPT.EQ.'REA') THEN - IF (.NOT.WNDNOD('INPUT_MDL_NODE',FIELDMDL,'MDL', - 1 'R',NODOUT,FILOUT)) THEN - IF (E_C.EQ.DWC_ENDOFLOOP) GOTO 10 !RETRY OPTION - GOTO 11 !REPEAT - ELSE IF (E_C.EQ.DWC_NULLVALUE) THEN - GOTO 10 !RETRY OPTION - ELSE IF (E_C.EQ.DWC_WILDCARD) THEN - GOTO 11 !MUST SPECIFY - END IF - IF (.NOT.WNFOP(FCAOUT,FILOUT,'R')) THEN - CALL WNCTXT(F_TP,'!/Cannot open !AS (!XJ)',NODOUT,E_C) - FIELDMDL=' ' !Forget if not found - GOTO 11 !RETRY - END IF - CALL NMORDS(FCAOUT) !READ - CALL NMORDM(7,-1) !AND ADD TO GENERAL AREA - CALL WNCTXT(F_TP,'There are !UJ sources in the list now', - 1 GDESJ(MDH_NSRC_J)) -C -C CLEAR -C - ELSE IF (OPT.EQ.'CLE') THEN - 19 CONTINUE - LBT=.FALSE. - IF (.NOT.WNDPAR('CLEAR_REF',LBT,LB_B,J0,'NO')) THEN - GOTO 19 !RETRY - END IF - IF (LBT) THEN - CALL NMOHZD(GDES) - ELSE - GDESJ(MDH_NSRC_J)=0 - END IF -C -C ADD -C - ELSE IF (OPT.EQ.'ADD') THEN - CALL NMOADD -C -C INTERN -C - ELSE IF (OPT.EQ.'INT') THEN - IF (INTERNAL_OK) THEN - CALL WNDDAP(TMPCAP,TMPCDAP) !Get current settings - IF (IAND(TMPCDAP,CAP_MOD).NE.0) THEN !Make test if model is on - CALL WNCTXT(F_TP,'REMINDER: Internal model is selected') - END IF - TMPCDAP=IOR(TMPCDAP,CAP_MOD) !Make sure model is on - CALL WNDDAP_SET(TMPCAP,TMPCDAP) !Store new settings - CALL WNCTXT(F_TP+F_P1,'DE_APPLY += MODEL') - ELSE - CALL WNCTXT(F_TP,'The use of the INTERNAL option is '// - 1 'NOT allowed in this context.') - END IF -C -C SHOW -C - ELSE IF (OPT.EQ.'SHO') THEN - OPTION='SHOW' - BACK_MOD=.FALSE. - 188 CONTINUE - IF (.NOT.WNDPAR('MODEL_SHOW',OPTION, - 1 LEN(OPTION),J0,OPTION)) THEN - IF (BACK_MOD) THEN - GOTO 18 !BACK TO MODEL_MODIFY - ELSE - GOTO 10 !BACK TO MODEL_OPTION - END IF - ELSE IF (J0.LE.0.OR.OPT.EQ.'QUI') THEN - IF (BACK_MOD) THEN - GOTO 18 !BACK TO MODEL_MODIFY - ELSE - GOTO 10 !BACK TO MODEL_OPTION - END IF - END IF -C - IF (.NOT.WNDPAR('SOURCE_RANGE',RANGE,2*L_J/L_B,J0,'*')) THEN - GOTO 188 !RETRY - END IF - IF (J0.EQ.0) THEN - GOTO 188 !"" - ELSE IF (J0.EQ.-1) THEN - RANGE(0)=1 !DEFAULT RANGE - RANGE(1)=1000000 - ELSE IF (J0.EQ.1) THEN - RANGE(1)=1000000 - END IF - J=F_TP !ASSUME BOTH - IF (OPT.EQ.'LIS' .OR. OPT.EQ.'RLI') J=F_P - IF (OPT.EQ.'TOT') THEN !TOTAL - CALL NMOPTT(J,RANGE) - ELSE IF (OPT(1:1).EQ.'R') THEN !RA/DEC - CALL NMOPRR(J,RANGE) - ELSE - CALL NMOPRT(J,RANGE) - END IF - GOTO 188 !Back to MODEL_SHOW -C -C MODIFY -C - ELSE IF (OPT.EQ.'MOD') THEN - 18 CONTINUE - IF (.NOT.WNDPAR('MODEL_MODIFY',OPTION, - 1 LEN(OPTION),J0,'QUIT')) THEN - GOTO 10 !RETRY - ELSE IF (J0.LE.0) THEN - GOTO 18 !RETRY - END IF - IF (OPT.EQ.'QUI') GOTO 10 !RETURN TO MODEL_OPTION -C -C SHOW -C - IF (OPT.EQ.'SHO') THEN - OPTION='SHOW' - BACK_MOD=.TRUE. - GOTO 188 -C -C FLUX_KNOWN -C - ELSE IF (OPT.EQ.'FLU') THEN - IF (IAND(GDESJ(MDH_BITS_J),MDHUNF_M).EQ.0) THEN !BIT OFF - GDESJ(MDH_BITS_J)= - 1 IOR(GDESJ(MDH_BITS_J),MDHUNF_M) !SET BIT - CALL WNCTXT(F_TP,'The Unknown-Flux bit is now on') - ELSE !BIT ON - GDESJ(MDH_BITS_J)= - 1 IAND(GDESJ(MDH_BITS_J),.NOT.MDHUNF_M) !RESET BIT - CALL WNCTXT(F_TP,'The Unknown-Flux bit is now off') - END IF -C -C EDIT -C - ELSE IF (OPT.EQ.'EDI') THEN - CALL NMOAED - ELSE IF (OPT.EQ.'FED') THEN !EDIT FIELD - IF (.NOT.WNDPAR('EDIT_FIELD',OPTION,LEN(OPTION),J0, - 1 '""')) THEN !EDIT FIELD - GOTO 18 !RETRY OPTION - ELSE IF (J0.LE.0) THEN - GOTO 18 - END IF - IF (OPT.EQ.'I') THEN - CALL NMOAFE(MDL_I_E) - ELSE IF (OPT.EQ.'L') THEN - CALL NMOAFE(MDL_L_E) - ELSE IF (OPT.EQ.'M') THEN - CALL NMOAFE(MDL_M_E) - ELSE IF (OPT.EQ.'Q') THEN - CALL NMOAFE(MDL_Q_E) - ELSE IF (OPT.EQ.'U') THEN - CALL NMOAFE(MDL_U_E) - ELSE IF (OPT.EQ.'V') THEN - CALL NMOAFE(MDL_V_E) - ELSE IF (OPT.EQ.'ID') THEN - CALL NMOAFJ(MDL_ID_J) - ELSE IF (OPT.EQ.'SI') THEN - CALL NMOAFE(MDL_SI_E) - ELSE IF (OPT.EQ.'RM') THEN - CALL NMOAFE(MDL_RM_E) - ELSE IF (OPT.EQ.'LA') THEN - CALL NMOAFE(MDL_EXT_E) - ELSE IF (OPT.EQ.'SA') THEN - CALL NMOAFE(MDL_EXT_E+1) - ELSE IF (OPT.EQ.'PA') THEN - CALL NMOAFE(MDL_EXT_E+2) - ELSE IF (OPT.EQ.'BIT') THEN - CALL NMOAFB(MDL_BITS_B) - ELSE IF (OPT.EQ.'TYP') THEN - CALL NMOAFB(MDL_TP1_B) - ELSE IF (OPT.EQ.'CCB') THEN - CALL NMOAFB(MDL_TP_B) - ELSE IF (OPT.EQ.'TP2') THEN - CALL NMOAFB(MDL_TP2_B) - END IF -C -C SORT -C - ELSE IF (OPT.EQ.'SOR') THEN !SORT I - CALL NMOSRT(0,GDESJ) - ELSE IF (OPT.EQ.'FSO') THEN !SORT FIELD - IF (.NOT.WNDPAR('SORT_TYPE',OPTION,LEN(OPTION),J0, - 1 'DECREASING')) THEN !SORT TYPE - GOTO 18 !RETRY OPTION - ELSE IF (J0.LE.0) THEN - GOTO 18 - END IF - IF (OPT.EQ.'DEC') THEN !DECREASING - SORTYP=-1 - ELSE - SORTYP=+1 - END IF - IF (.NOT.WNDPAR('SORT_FIELD',OPTION,LEN(OPTION),J0, - 1 '""')) THEN !SORT FIELD - GOTO 18 !RETRY OPTION - ELSE IF (J0.LE.0) THEN - GOTO 18 - END IF - IF (OPT.EQ.'I') THEN - SOROFF=MDL_I_E - CALL NMOSRT(3,GDESJ) - ELSE IF (OPT.EQ.'L') THEN - SOROFF=MDL_L_E - CALL NMOSRT(3,GDESJ) - ELSE IF (OPT.EQ.'M') THEN - SOROFF=MDL_M_E - CALL NMOSRT(3,GDESJ) - ELSE IF (OPT.EQ.'Q') THEN - SOROFF=MDL_Q_E - CALL NMOSRT(3,GDESJ) - ELSE IF (OPT.EQ.'U') THEN - SOROFF=MDL_U_E - CALL NMOSRT(3,GDESJ) - ELSE IF (OPT.EQ.'V') THEN - SOROFF=MDL_V_E - CALL NMOSRT(3,GDESJ) - ELSE IF (OPT.EQ.'SI') THEN - SOROFF=MDL_SI_E - CALL NMOSRT(3,GDESJ) - ELSE IF (OPT.EQ.'RM') THEN - SOROFF=MDL_RM_E - CALL NMOSRT(3,GDESJ) - ELSE IF (OPT.EQ.'LA') THEN - SOROFF=MDL_EXT_E - CALL NMOSRT(3,GDESJ) - ELSE IF (OPT.EQ.'SA') THEN - SOROFF=MDL_EXT_E+1 - CALL NMOSRT(3,GDESJ) - ELSE IF (OPT.EQ.'PA') THEN - SOROFF=MDL_EXT_E+2 - CALL NMOSRT(3,GDESJ) - ELSE IF (OPT.EQ.'BIT') THEN - SOROFF=MDL_BITS_B - CALL NMOSRT(4,GDESJ) - ELSE IF (OPT.EQ.'TYP') THEN - SOROFF=MDL_TP1_B - CALL NMOSRT(4,GDESJ) - ELSE IF (OPT.EQ.'CCB') THEN - SOROFF=MDL_TP_B - CALL NMOSRT(4,GDESJ) - ELSE IF (OPT.EQ.'TP2') THEN - SOROFF=MDL_TP2_B - CALL NMOSRT(4,GDESJ) - ELSE IF (OPT.EQ.'ID') THEN - SOROFF=MDL_ID_J - CALL NMOSRT(2,GDESJ) - ELSE IF (OPT.EQ.'LM') THEN - CALL NMOSRT(6,GDESJ) - ELSE IF (OPT.EQ.'ML') THEN - CALL NMOSRT(7,GDESJ) - ELSE IF (OPT.EQ.'POL') THEN - CALL NMOSRT(8,GDESJ) - ELSE IF (OPT.EQ.'DIS') THEN - SORRAN(0)=0 !START - SORRAN(1)=0 - IF (.NOT.WNDPAR('SORT_CENTRE',SORRAN,2*L_E/L_B,J0, - 1 A_B(-A_OB),SORRAN,2)) THEN !GET CENTRE - GOTO 18 !RETRY OPTION - END IF - IF (J0.LE.0) GOTO 18 !RETRY OPTION - SORRAN(0)=SORRAN(0)/3600./DEG !MAKE RADIANS - SORRAN(1)=SORRAN(1)/3600./DEG - CALL NMOSRT(5,GDESJ) - END IF !UNKNOWN -C -C MERGE -C - ELSE IF (OPT.EQ.'MER') THEN - CALL NMOAMG ! exact coincidence - ELSE IF (OPT.EQ.'RME') THEN - CALL NMOAMR ! within given radius -C -C DELETE -C - ELSE IF (OPT.EQ.'DEL') THEN - CALL NMOADL - ELSE IF (OPT.EQ.'DNC') THEN - CALL NMOANC - ELSE IF (OPT.EQ.'DCL') THEN - CALL NMOACD - ELSE IF (OPT.EQ.'DAR') THEN - CALL NMOAAD -C -C CALIBRATE -C - ELSE IF (OPT.EQ.'CAL') THEN - CALL NMOADC - END IF -C - GOTO 18 -C - END IF -C -C MORE -C - GOTO 10 !NEXT OPTION -C -C READY WITH DAX -C - 800 CONTINUE - CALL WNCTXT(F_TP,'!/!UJ sources in list!/', - 1 GDESJ(MDH_NSRC_J)) - NGSRC=GDESJ(MDH_NSRC_J) !# OF SOURCES IN LIST -C - IF (DO_UNF) THEN - IF (IAND(GDESJ(MDH_BITS_J),MDHUNF_M).NE.0) THEN !BIT OFF - FN=.FALSE. - CALL WNCTXT(F_TP,'Fluxes are considered unknown') - ELSE - FN=.TRUE. - ENDIF - END IF -C - RETURN !READY -C -C NMODAY -C - ENTRY NMODAY -C - DLDM(0)=0 ! (probably unecessary) - DLDM(1)=0 - 20 CONTINUE - CALL WNFCL(FCAOUT) !MAKE SURE NONE OPEN - IF (.NOT.WNDNOD('OUTPUT_MDL_NODE',' ','MDL','W',NODOUT,FILOUT)) THEN - IF (E_C.EQ.DWC_ENDOFLOOP) RETURN !NOT WANTED - GOTO 20 !REPEAT - ELSE IF (E_C.EQ.DWC_NULLVALUE) THEN - RETURN !NOT WANTED - ELSE IF (E_C.EQ.DWC_WILDCARD) THEN - RETURN !NOT WANTED - END IF - IF (.NOT.WNFOP(FCAOUT,FILOUT,'U')) THEN - CALL WNCTXT(F_TP,'!/Cannot open !AS (!XJ)',NODOUT,E_C) - GOTO 20 !RETRY - END IF -C - RETURN -C -C - END diff --git a/src/nscan/nmodel.fsc b/src/nscan/nmodel.fsc deleted file mode 100644 index 493a615eb007014d1c077d634d0d08f093720ec5..0000000000000000000000000000000000000000 --- a/src/nscan/nmodel.fsc +++ /dev/null @@ -1,221 +0,0 @@ -C+ NMODEL.FSC -C WNB 900327 -C -C Revisions: -C WNB 910814 Add (de-)beam -C WNB 910828 Add RUN -C HjV 920520 HP does not allow extended source lines -C WNB 921104 Add J2000 -C WNB 921217 Add AFIND -C WNB 930514 Make FSC, add manual find -C WNB 930623 Prepare for Spectral Update -C WNB 931008 Add EDIT -C WNB 931119 Add REDIT, FEDIT -C CMV 940225 Default model file for SAVE and update(use NMODAW) -C WNB 940821 Add polarisation updates -C WNB 950626 Add X and Y updates -C WNB 950630 More update options -C WNB 950706 Add loops -C CMV 960122 Warning if /NORUN ignored -C WNB 990729 Add X00-X03 update types -C - SUBROUTINE NMODEL -C -C Main routine to handle source lists -C -C Result: -C -C -C Include files: -C - INCLUDE 'WNG_DEF' - INCLUDE 'NMO_DEF' - INCLUDE 'MDU_O_DEF' - INCLUDE 'STH_O_DEF' -C -C Parameters: -C -C -C Arguments: -C -C -C Function references: -C - LOGICAL WNDRUN - LOGICAL NSCSTG -C -C Data declarations: -C - INTEGER LEXT !UPDATE TYPE - INTEGER STHP !SET POINTER - INTEGER SETNAM(0:7) !SET NAME - BYTE STH(0:STH__L-1) !SET HEADER -C- -C -C PRELIMINARIES -C - CALL NMOINI !INIT PROGRAM - IF (.NOT.WNDRUN()) - 1 CALL WNCTXT(F_TP,'Ignored option /NORUN') -C -C DISTRIBUTE -C - 12 CONTINUE - ACTION='HANDLE' !ASSUME HANDLE - 10 CONTINUE - CALL NMODAT !GET USER DATA - IF (ACT.EQ.'QUI') THEN - CALL WNGEX !READY - ELSE IF (ACT.EQ.'HAN') THEN !HANDLE - CALL NMODAX(J) - ELSE IF (ACT.EQ.'HEL') THEN !HELP - CALL WNCTXT(F_TP,' ') - CALL WNCTXT(F_TP, - 1 'Model lists come in three flavours:') - CALL WNCTXT(F_TP, - 1 '- local: no known reference RA/DEC') - CALL WNCTXT(F_TP, - 1 '- apparent: known reference RA/DEC') - CALL WNCTXT(F_TP, - 1 '- epoch: known reference RA/DEC for B1950/J2000') - CALL WNCTXT(F_TP, - 1 'The l and m specified in the list are offsets w.r.t. the') - CALL WNCTXT(F_TP, - 1 'known or unknown reference coordinates, and in essence offsets') - CALL WNCTXT(F_TP, - 1 'on a plane perpendicular to the radius at the '// - 1 'reference position.') - CALL WNCTXT(F_TP, - 1 'Conversion between types can be done, and a SCN file is then') - CALL WNCTXT(F_TP, - 1 'necessary to obtain some data.') - CALL WNCTXT(F_TP, - 1 'Conversion between reference coordinates can also be done.') - CALL WNCTXT(F_TP,' ') -C -C FROM/TO OLD -C - ELSE IF (ACT.EQ.'FRO') THEN - CALL NMOOFR - ELSE IF (ACT.EQ.'TO_') THEN - CALL NMOOTO -C -C CONVERT EPOCH -C - ELSE IF (ACT.EQ.'CON') THEN - CALL NMOCVT(0) - ELSE IF (ACT.EQ.'EDI') THEN - CALL NMOCVT(1) - ELSE IF (ACT.EQ.'RED') THEN - CALL NMOCVT(2) - ELSE IF (ACT.EQ.'FED') THEN - CALL NMOCVT(3) -C -C (DE-)BEAM -C - ELSE IF (ACT.EQ.'BEA') THEN - CALL NMOBEM - ELSE IF (ACT.EQ.'DEB') THEN - CALL NMOBED -C -C SAVE MODEL -C - ELSE IF (ACT.EQ.'SAV') THEN - JS=NSCSTG(FCAIN,SETS,STH,STHP,SETNAM) !FIND A SET - CALL WNDSTR(FCAIN,SETS) !RESET SET SEARCH - CALL NMODAW(J,STH) !GET MODEL - IF (J.LE.0) GOTO 11 !NO MODEL - CALL NMOMUI !SET MODEL USAGE - CALL NMOMSC(FCAIN,SETS) !SAVE MODEL - CALL WNFCL(FCAIN) !CLOSE SCAN FILE -C -C GET MODEL -C - ELSE IF (ACT.EQ.'GET') THEN - CALL NMOMSG(SETS) !GET MODEL - CALL WNFCL(FCAIN) !CLOSE SCAN FILE -C -C FIND SOURCES -C - ELSE IF (ACT.EQ.'FIN') THEN - IF (OPT.EQ.'POS') THEN - CALL NMOFND !FIND SOURCES - CALL NMODAX(J) !HANDLE - ELSE IF (OPT.EQ.'ABS') THEN - CALL NMOFNA !FIND SOURCES - CALL NMODAX(J) !HANDLE - ELSE IF (OPT.EQ.'MAN') THEN -#ifdef wn_vx__ - CALL WNCTXT(F_T,'No manual find possible on this machine') -#else - CALL NMOFMD !FIND SOURCES MANUALLY - CALL NMODAX(J) !HANDLE -#endif - END IF -C -C UPDATE MODEL -C - ELSE IF (ACT.EQ.'UPD') THEN -C - IF (OPT.EQ.'SIL') THEN - LEXT=MDU_T_SILM !SPECTRAL UPDATE - ELSE IF (OPT.EQ.'EXT') THEN - LEXT=MDU_T_EXT !EXTENDED UPDATE - ELSE IF (OPT.EQ.'QUV') THEN - LEXT=MDU_T_QUV !POLARISATION UPDATE - ELSE IF (OPT.EQ.'LM') THEN - LEXT=MDU_T_LM !POSITION UPDATE - ELSE IF (OPT.EQ.'I') THEN - LEXT=MDU_T_I !INTENSITY UPDATE - ELSE IF (OPT.EQ.'PES') THEN - LEXT=MDU_T_PEST !POLARISATION ESTIMATE - ELSE IF (OPT.EQ.'X00') THEN - LEXT=MDU_T_X00 !EXTRA TYPES - ELSE IF (OPT.EQ.'X01') THEN - LEXT=MDU_T_X01 !EXTRA TYPES - ELSE IF (OPT.EQ.'X02') THEN - LEXT=MDU_T_X02 !EXTRA TYPES - ELSE IF (OPT.EQ.'X03') THEN - LEXT=MDU_T_X03 !EXTRA TYPES - ELSE - LEXT=MDU_T_ILM - END IF - IF (OPTION(4:4).EQ.'X') THEN - LEXT=LEXT+MDU_M_CLUST - ELSE IF (OPTION(4:4).EQ.'Y') THEN - LEXT=LEXT+MDU_M_COMBI+MDU_M_CLUST - ELSE IF (OPTION(4:4).EQ.'Z') THEN - LEXT=LEXT+MDU_M_CONSTR+MDU_M_CLUST - END IF - IF (OPTION(5:5).EQ.'L') LEXT=LEXT+MDU_M_LOOP - JS=NSCSTG(FCAIN,SETS,STH,STHP,SETNAM) !FIND A SET - CALL WNDSTR(FCAIN,SETS) !RESET SET SEARCH - CALL NMODAW(NSRC(0),STH) !GET MODEL - IF (NSRC(0).LE.0) GOTO 11 !NO SOURCES PRESENT - CALL NMOMUI !MODEL USAGE - CALL NMODAY !GET A POSSIBLE OUTPUT NODE - CALL NMOUPD(LEXT) !UPDATE SOURCES - IF (FCAOUT.EQ.0) THEN !WANTED HANDLE - CALL NMODAX(J) !HANDLE - ELSE - CALL NMOWRS(FCAOUT,GDES) !WRITE UPDATE - CALL WNGEX !AND STOP - END IF -C -C NEW VERSION -C - ELSE IF (ACT.EQ.'NVS') THEN - CALL NMONVS -C -C CONVERT VAX FORMAT -C - ELSE IF (ACT.EQ.'CVX') THEN - CALL NMOCVX - END IF -C - 11 CONTINUE - ACTION='QUIT' !ASSUME READY - GOTO 10 !MORE -C -C - END diff --git a/src/nscan/nmodel.pef b/src/nscan/nmodel.pef deleted file mode 100644 index cc4aac91e63cbe1885ee1861492b7e03cad71b5e..0000000000000000000000000000000000000000 --- a/src/nscan/nmodel.pef +++ /dev/null @@ -1,1135 +0,0 @@ -!+ NMODEL.PEF -! WNB 900327 -! -! Revisions: -! WNB 910820 Add extinction, refraction, Faraday -! WNB 910827 Add CALIB -! WNB 910828 Add RUN -! WNB 910909 Add DATAB and INFIX -! WNB 910909 Add OUTPUT_NODE -! WNB 910913 New (de-)apply and loops -! WNB 911007 Add instr. pol. -! WNB 911230 Add DNCLOW -! WNB 920626 Add DCLOW, change Rotation measure description -! WNB 920818 Add DAREA -! WNB 921104 Text select ifrs; HA range; J2000 -! WNB 921211 Make PEF -! JEN 930312 Remove keyword(s) MODEL_NODE -> NCOMM.PEF -! WNB 930826 Add BEAM_SIZE -! WNB 930928 Change BEAM_SIZE to BEAM_SCALE; remove BEAM_FACTORS; -! add: BEAM_DESCR, BEAM_FACTOR_*, BEAM_FREQ_* -! WNB 931008 Add BEAM to MODEL_ACTION; move CONVERT_TO to nmodel.psc -! change CC to CCBM -! CMV 940224 Add option INTERN and change text of MODEL_OPTION -! CMV 940225 Split off some options from MODEL_OPTION -! CMV 940228 Add option FLUX_KNOWN to MODEL_MODIFY -! CMV 940415 Add option SHOW to MODEL_MODIFY -! CMV 940428 Add keyword NAMES_FILE -! JPH 940923 Comment out all INPOL keywords, disable MODEL_ACTION -! INPOL. Improve help texts. -! JPH 941205 Help texts. Prompt formatting. -! JPH 941222 / in OPTIONS --> , -! JPH 950409 Help texts. -! JEN 960410 add option RMERGE and keyword MERGE_RADIUS -! JPH 960410 Typo -! JPH 960610 Expand text for MODEL_ACTION -! JPH 961111 Correct BEAM_SCALE help text (1.25 --> 0.8) -! JPH 961112 More help texts -! -! -! Get general action -! Ref: NMODAT -! -KEYWORD=MODEL_OPTION - DATA_TYPE=C - IO=I - LENGTH=24 - CHECKS=ABBREV_OPTIONS - SWITCH=LOOP,NULL_VALUES,WILD_CARDS - SEARCH=L,P - PROMPT="Model-list action|" - OPTIONS=READ,WRITE, INTERN; CLEAR,ADD,MODIFY, SHOW; QUIT - HELP=" -Specify the action to be taken on the internal model list: -. - Transfers between the internal list and an external file: -. - READ Read the components from a .MDL file on disk into the - program's model list. The default filename is the name of - the calibrator belonging to the most recently read sector, - derived from the fieldname and the frequency. .MDL files are - first searched for in the current directory or the directory - defined by parameter DATAB. If this fails, the file is looked - for in the directory defined by parameter MODELB and finally by - that defined by the Unix environment variable MODELB. -. - NOTE that reading is INCREMENTAL, so if you read the same - .MDL file twice, you will get every component doubled... -. - WRITE Write the program's model list to a .MDL file. -. - INTERN This does not affect the list, but selects - the model stored in the scan-file(s). Selecting INTERN is - equivalent to setting DE_APPLY=MODEL. - You may use this internal model in combination with - components in the program's model list. -!! To be sorted out... -. - Modification and display of the internal list: -. - CLEAR Empty the program's model list and optionally its reference - coordinates. -. - ADD Manual input of sources to add the list -. - MODIFY Enter a submenu with options to modify the model list: - - by deleting sources from the list; - - by editing entries manually; - - by sorting (for subsequent display) the list: you will be - prompted for a definition of the sort order; - - by calibrating. -!! What?? How?? -. - SHOW Show the program's model list, you will be prompted for details. -. -. - QUIT Exit from model-handling. " -! -! Clear reference position when clearing model -! Ref: NMODAT -! -KEYWORD=CLEAR_REF - DATA_TYP=L - IO=I - NVALUES=1 - SWITCHES=NULL_VALUES,WILD_CARDS - SEARCH=L,P - PROMPT="Clear reference coordinates (Yes/No)?" - HELP=" -If you answer YES to this prompt, the reference coordinates of the model will -be reset. Otherwise, only the number of components will be set to zero. " -! -! Get show action -! Ref: NMODAT -! -KEYWORD=MODEL_SHOW - DATA_TYPE=C - IO=I - LENGTH=24 - CHECKS=ABBREV_OPTIONS - SWITCH=LOOP,NULL_VALUES,WILD_CARDS - SEARCH=L,P - PROMPT="Model listing mode" - OPTIONS=SHOW,LIST, RSHOW,RLIST, TOTAL; QUIT - HELP=" -Specify what type of listing you want, and where it should be shown: -. - LIST Show the program's model list in the log file. - SHOW Idem, but both on the terminal and in the log file. -. - RLIST Show the program's model list in RA/DEC coordinates in the log file. - RSHOW Idem, but both on the terminal and in the log file. -. - TOTAL Show the statistics of the program's model list. -. - QUIT Back to MODEL_OPTION. -. -" -! -! Get modify action -! Ref: NMODAT -! -KEYWORD=MODEL_MODIFY - DATA_TYPE=C - IO=I - LENGTH=24 - CHECKS=ABBREV_OPTIONS - SWITCH=LOOP,NULL_VALUES,WILD_CARDS - SEARCH=L,P - PROMPT="Model-handling action" - OPTIONS=- -MERGE, RMERGE, SORT, FSORT; CALIB, EDIT, FEDIT, FLUX_KNOWN;| - -DEL, DNCLOW, DCLOW, DAREA; SHOW, QUIT - HELP=" -Specify what you want to do with the model list in core: -. - Consolidating/rearranging the list: -. - MERGE Combine (point-) sources at the same position. - Must have the same spectral index and rotation measure. - Stokes Q,U,V are properly taken into account. - CLEAN components are NOT combined with non-CLEAN comp. - Extended sources are ignored. - RMERGE As MERGE, but within specified radius (which may be 0). - The (l,m) position of the strongest source is taken. - CLEAN components are combined if at the same position. -!! Discard duplicates or add fluxes? See MODEL_ACTION MERGE -!! below - SORT Sort source list in decreasing amplitude. (This will be done - automatically when you write the list back to a .MDL file.) - FSORT Sort on a specified field in source list (for subsequent - display) -. - Modifying sources in the list: -. - CALIB Calibrate the source list to a new amplitude and/or position - EDIT Edit source list (an amplitude of zero will delete the source) - FEDIT Edit a field in a range of sources - FLUX_KNOWN Toggle the 'unknown-flux' bit. When this bit is off, NCALIB - will by default refrain from attempting a Selfcan gain - solution. -. - Deleting sources in the list: -. - DEL Delete sources - DNCLOW Delete non-clean sources with low amplitudes - DCLOW Delete clean components with low amplitudes - DAREA Delete sources in specified area -. - Miscellaneous: -. - SHOW Show the list. (You will be prompted for details) -. - QUIT Quit model-handling. " -! -! -! Get radii for merging of components (RMERGE) -! Ref: NMOADD -! -KEYWORD=MERGE_RADIUS - DATA_TYP=R - IO=I - NVALUES=2 - SWITCH=LOOP,VECTOR,WILD_CARDS,NULL_VALUES - SEARCH=L,P - PROMPT="Coincidence radii dl,dm (arcsec)" - HELP=" -Point sources that are within (dl,dm) arcsec of each other are combined. The -suggested default values are approximately half the synthesised beam radius in -l and m directions." -! -! Get model-scan action -! Ref: NMOMUI -! -KEYWORD=MODEL_ACTION - DATA_TYPE=C - IO=I - LENGTH=24 - NVALUES=5 - CHECKS=ABBREV_OPTIONS - SWITCH=LOOP,VECTOR,NULL_VALUES,WILD_CARDS - SEARCH=L,P - PROMPT="specify model disposition and format in the order shown,|- -using ,, to skip over items|" - OPTIONS=- -MERGE, INCREMENT, NEW, TEMPORARY; [ADD];| - -BAND,NOBAND, TIME,NOTIME, NOINPOL, BEAM,NOBEAM| -! (INPOL disabled) - HELP=" -NOTE: - The defaults proposed have been chosen to minimise the time needed for -the lengthy (re)calculations of model visibilities. The price you pay for this -is a near-doubling of the size of the sectors in your .SCN file in which you -store a model. Your priorities may be different, but before choosing -non-default options make sure you understand the consequences. -. - In principle, the model list now in memory will be used to calculate -the model sources' visibilities in your observation(s). -. - To avoid this lengthy calculation where possible, the program will try -to use model visibilities stored earlier in the .SCN file. To this end, it will -read the model list from the .SCN file and combine it with the list in core, -then (re)calculate the visibilities only for those components that are not -represented correctly in the .SCN file. Having done that, the program may or -may not save the combined model and its visibilities back into the .SCN file. -. - You must select ONE of the following options for the combination and -subsequent storage: -. - MERGE Merge the model in the .SCN file with the one in core discarding - duplicates, i.e. components with identical position, extent and - flux; store the combined model in the .SCN file. - This option is suitable in the most common situations, viz.: - - the list in core is an extension containing the list in the - .SCN file as a subset; or - - the list in core is an incremental update, i.e. a list of - aditional components. -. - INCREMENT As MERGE, but retain the resultant model IN CORE ONLY without - changing the .SCN file -. - NEW Overwrite the model in the SCN file with the model in core. -. - TEMPORARY Use the model in core, ignoring the one in the SCN file. -. - ADD As MERGE, but without discarding any components, i.e. fluxes - of coincident sources are added. - This option will produce the same effect as MERGE in the case - that the list in core is an incremental update. Its use is - recommended for special applications only. -. - Separately from the above, you may define which effects must be -accounted for in the visibility calculations. The four items below must be -specified in the order shown. You may select the default by skipping the item, -typing only the delimiter comma; for example ',,,,BEAM' will select the -defaults for the first four items. -. - BAND/NOBAND To correct or not correct the radial extent of your model - components for the smearing due to your finite observing - bandwidth -. - TIME/NOTIME To correct or not correct the tangential extent of your model - model components for the smearing due to the finite - integration time of your observation -. - INPOL/NOINPOL To correct or not correct the polarisation components - Q,U,V of your model for the effect of position-dependent - primary-beam polarisation. - (NOTE: The iNPOL option is currently disabled.) -. - BEAM/NOBEAM To correct or not correct your model fluxes for the - position-dependent gain of the primary beam. -. -NOTE that specifying options different from those used earlier in calculating -the model visibilities that are noe now in the .SCN file will result in a -partial or complete recalculation of the visibilities." -! -! Get sort type -! Ref: NMODAT -! -KEYWORD=SORT_TYPE - DATA_TYP=C - IO=I - LENGTH=24 - CHECKS=ABBREV_OPTIONS - SWITCH=LOOP,NULL_VALUES,WILD_CARDS - SEARCH=L,P - OPTIONS=INCREASING,DECREASING -! PROMPT="action" - HELP=" Specify the polarity of the sort" -! -! Get field on which to sort -! Ref: NMODAT -! -KEYWORD=SORT_FIELD - DATA_TYP=C - IO=I - LENGTH=24 - CHECKS=ABBREV_OPTIONS - SWITCH=LOOP,NULL_VALUES,WILD_CARDS - SEARCH=L,P - PROMPT="Sort criterion" - OPTIONS=- -L,M, LM,ML, DIST; I,SI, POL,RM, Q,U,V; LA,SA,PA;| - -ID,BITS,TYP,CCBM,TP2 - HELP=" -Specify sourfce attribute on which to sort: -. - Source coordinates: -. - L, M l or m, arbitrary order for the other - LM, ML l and then m, or m and then l - DIST distance to a specified reference point -. - Properties of the source: -. - I ampitude - SI spectral index - POL polarised intensity - RM intrinsic rotation measure - Q, U, V Stokes parameters in % of I - LA, SA, PA long axis short axis, position angle of elliptic-Gaussian - extended-source model -. - Administrative attributes in the model list: -. - ID identification - BITS bits mask (if source is extended, has polarisation) -! \whichref{}{} - TYP source type (0 is the standard) -! \whichref{}{} - CCBM clean component (1) and beam-corrected (8) -! \whichref{}{} - TP2 reserved " -! -! Get centre for distance SORT -! Ref: NMODAT -! -KEYWORD=SORT_CENTRE - DATA_TYP=R - IO=I - NVALUES=2 - SWITCH=LOOP,VECTOR,WILD_CARDS,NULL_VALUES - SEARCH=L,P - PROMPT="Reference coordinates l,m|- -for distance sort (arcsec)" - HELP=" -Specify the reference coordinates for the distance sort that you selected." -! -! Get field to edit -! Ref: NMODAT -! -KEYWORD=EDIT_FIELD - DATA_TYP=C - IO=I - LENGTH=24 - CHECKS=ABBREV_OPTIONS - SWITCH=LOOP,NULL_VALUES,WILD_CARDS - SEARCH=L,P - PROMPT="Source attribute to edit|" - OPTIONS=- -L,M; I,SI, RM, Q,U,V; LA,SA,PA; ID,BITS,TYP,CCBM,TP2 - HELP=" Specify the source attribute that you want to edit: -. - Source coordinates: -. - L, M coordinates relative to reference (arcsec) -. - Properties of the source: -. - I ampitude - SI spectral index - RM intrinsic rotation measure - Q, U, V Stokes parameters in % of I - LA, SA, PA long axis short axis, position angle of elliptic-Gaussian - extended-source model -. - Administrative attributes in the model list: -. - ID identification - BITS bits mask (if source is extended, has polarisation) -! \whichref{}{} - TYP source type (0 is the standard) -! \whichref{}{} - CCBM clean component (1) and beam-corrected (8) -! \whichref{}{} - TP2 reserved " -! -! Get edit value -! Ref: NMODAT -! -KEYWORD=EDIT_VALUE - DATA_TYP=R - IO=I - SWITCH=LOOP,WILD_CARDS,NULL_VALUES - SEARCH=L,P - PROMPT="New value" - HELP=" -Specify the value to set in specified edit field." -! -! -! Get source number -! Ref: NMODAT -! -KEYWORD=SOURCE_NUMBER - DATA_TYPE=J - IO=I - SWITCH=LOOP,NULL_VALUES,WILD_CARDS - SEARCH=L,P - PROMPT="Source number" - HELP=" -Specify the number of the source to be acted upon." -! -! Get source list -! Ref: NMODAT -! -KEYWORD=SOURCE_LIST - DATA_TYPE=J - IO=I - NVALUES=128 - SWITCH=LOOP,NULL_VALUES,WILD_CARDS - SEARCH=L,P - PROMPT="Source number list" - HELP=" -Specify a list of individual source numbers to be acted upon. If you want to -spaecfy a range, reply '*' here and wait for the next prompt" -! -! Get source range -! Ref: NMODAT -! -KEYWORD=SOURCE_RANGE - DATA_TYPE=J - IO=I - NVALUES=2 - SWITCH=LOOP,NULL_VALUES,WILD_CARDS - SEARCH=L,P - PROMPT="Source number range" - HELP=" -Specify the first and last source number to process. * indicates 'all'. If you -want all sources from some number <N> upward, reply -. - '<N>-<some very large number>'. -!! Does * work? -" -! -! Get source parameters -! Ref: NMOADD -! -KEYWORD=SOURCE - DATA_TYPE=R - IO=I - NVALUES=13 - SWITCH=LOOP,VECTOR,NULL_VALUES,WILD_CARDS - SEARCH=L,P - PROMPT="I,l,m,id,Q,U,V,lax,sax,pa,si,rm,rs" - HELP=" -Specify the source parameters in order shown. -. - I intensity (W.U.) - l, m coordinates w.r.t. reference (arcsec) - id identification number (see below) - Q Stokes Q relative to I (%) - U Stokes U relative to I (%) - V Stokes V relative to I (%) - lax long-axis full halfwidth (arcsec, =0 for a point source) - sax short-axis full halfwidth (arcsec, =0 for a point source) - pa position angle of long axis (degrees, North through East) - si spectral index - rm intrinsic rotation measure ( rad/m**2 at 1 Ghz) - rs reserved -. -You may omit values that you want to leave alone, but not the commas that -delimit them. Trailing values and commas may be omitted. -. - Example: - ,,3 will set m to 3 and leave all other parameters unchanged. -. -The identification number is of the form -. - <sequence number>-<mask byte> - " -! -! Get calibration parameters -! Ref: NMOADD -! -KEYWORD=SOURCE_FACTORS - DATA_TYPE=R - IO=I - NVALUES=3 - SWITCH=VECTOR,NULL_VALUES,WILD_CARDS - SEARCH=L,P - PROMPT="Amlitude ratio Anew/Aold, | shift dl,dm (arcsec)" - HELP=" -Specify the calibration parameters in te order shown: - An/Ao new/old amplitude - dl new-old l in arcsec - dm new-old m in arcsec " -! -! Get delete level -! Ref: NMOADD -! -KEYWORD=DELETE_LEVEL - DATA_TYPE=R - IO=I - SWITCH=LOOP,NULL_VALUES,WILD_CARDS - CHECKS=MINIMUM - MINIMUM=0. - SEARCH=L,P - PROMPT="Lower flux limit" - HELP=" -Source whose absolute flux is below the value specified here will be deleted -from the model list." -! -! Get delete area -! Ref: NMOADD -! -KEYWORD=DELETE_AREA - DATA_TYPE=R - IO=I - NVALUES=4 - SWITCH=VECTOR,NULL_VALUES,WILD_CARDS - SEARCH=L,P - PROMPT="Area l,m, dl,dm (arcsec)" - HELP=" -Specify the area in which all sources should be deleted: -. - l,m area centre (0,0 = map centre) - dl,dm area size " -! -! Beam size -! Ref: NMOBMR -! -KEYWORD=BEAM_SCALE - DATA_TYP=R - IO=I - SWITCH=NULL_VALUES,WILD_CARDS - SEARCH=L,P - DEFAULT=1. /NOASK - PROMPT="Scale factor for primary-beam width" - HELP=" -Specify a scaling factor for the primary beam calculations. If, e.g. a beam has -been defined (by BEAM_FACTOR) for a 25 m dish, it can be used for a 20 m dish -by specifying here 20./25. (or 0.8) " -! -! Beam descriptor -! Ref: NMOBMR -! -KEYWORD=BEAM_DESCR - DATA_TYP=J - IO=I - NVALUES=32 - SWITCH=NULL_VALUES,WILD_CARDS - SEARCH=L,P - DEFAULT=0,0,1,6,1,1,4,4 /NOASK - PROMPT="Beam descriptors" - HELP=" -Describe the primary beam for an instrument other than the WSRT or the ATCA. -Here you specify the formula to be used; later you will be asked for values for -the coefficients. -. -Each instrument (up to 8) is decribed by four numbers, with (in order) the -following meaning: -. - - the value of the * in BEAM_FREQ_* and BEAM_FACTOR_* to use -. - - the type of formula: - 0= cos(factor*freq(MHz)*angle(degree))**6; - 1= 1/(1+fac1*(freq(GHz)*angle(arcmin))**2+fac2*...); - 2= 1+fac1*(freq(GHz)*angel(arcmin))**2+fac2*...) -. - - the number of factors per frequency range in BEAM_FACTOR_* -. - - the number of frequency ranges specified in BEAM_FREQ_* -. -Instruments are: first WSRT, second ATCA " -! -! Beam frequency ranges -! Ref: NMOBMR -! -KEYWORD=BEAM_FREQ_0 - DATA_TYP=R - IO=I - NVALUES=8 - SWITCH=NULL_VALUES,WILD_CARDS - SEARCH=L,P - DEFAULT=500,1000,2000,4000,8000,100000 /NOASK - PROMPT="Beam feed frequencies" - HELP=" -Specify in increasing order the frequency bands to be used in calculating the -primary beam. For each value there should be a corresponding set of values in -BEAM_FACTOR_0 (the number of values in BEAM_DESCR).These factors will be used -up to the corresponding frequency specified." -! -KEYWORD=BEAM_FREQ_1 - DATA_TYP=R - IO=I - NVALUES=8 - SWITCH=NULL_VALUES,WILD_CARDS - SEARCH=L,P - DEFAULT=2000,4000,8000,100000 /NOASK - PROMPT="Beam feed frequencies" - HELP=" -Specify in increasing order the frequency bands to be used in calculating the -primary beam. For each value there should be a corresponding set of values in -BEAM_FACTOR_1 (the number of values in BEAM_DESCR).These factors will be used -up to the specified corresponding frequency (MHz)." -! -! Beam factors -! Ref: NMOBMR -! -KEYWORD=BEAM_FACTOR_0 - DATA_TYP=R - IO=I - NVALUES=64 - SWITCH=NULL_VALUES,WILD_CARDS - SEARCH=L,P - DEFAULT=.0629,.065,.065,.065,.065,.065 /NOASK - PROMPT="Beam feed factors" - HELP=" -Specify per frequency band specified in BEAM_FREQ_0 the factors to be used in -the primary beam calculation formula (see BEAM_DESCR). This is for WSRT cos**6" -! -KEYWORD=BEAM_FACTOR_1 - DATA_TYP=R - IO=I - NVALUES=64 - SWITCH=NULL_VALUES,WILD_CARDS - SEARCH=L,P - DEFAULT=8.99E-4,2.15E-6,-2.23E-09,1.56E-12,- - 1.02E-3,9.48E-7,-3.68E-10,4.88E-13,- - 1.08E-3,1.31E-6,-1.17E-09,1.07E-12,- - 1.04E-3,8.36E-7,-4.68E-10,5.50E-13 /NOASK - PROMPT="Beam feed factors" - HELP=" -Specify per frequency band specified in BEAM_FREQ_1 the factors to be used in -the primary beam calculation formula (see BEAM_DESCR). This is for ATCA -1/(1+ai.x**2i)" -! -! Instrumental polarisation -! Ref: NMOMUI -! -!!KEYWORD=INPOLQ_100 -!! DATA_TYP=R -!! IO=I -!! NVALUES=10 -!! SWITCH=VECTOR -!! SEARCH=L,P -!! DEFAULT=-.003137,.0024037,.01159,.0038832,.02139,- -!! .0027887,.17698,.82302,-.21744,-.78256 /NOASK -!! PROMPT="Instrumental pol." -!! HELP=" -!!Specify the instrumental polarisation. INPOL* asks for Q, U and iV. The value -!!following the _ gives the maximum frequency (MHz) for which the values hold. -!!The formula is used: -!! A0+A1(a1 sin p +b1 cos p)+A2(a2 sin 2p + b2 cos 2p), with: -!! Ai=Ci sin(Di.f.r)**2 -!!The first 6 values give the Ci,Di pairs, the remaining 4 the ai,bi pairs. -!!p is the position angle from North through East; r the distance from the -!!beam centre in degrees, f the frequency in MHz" -!!! -!!! Instrumental polarisation -!!! Ref: NMOMUI -!!! -!!KEYWORD=INPOLU_100 -!! DATA_TYP=R -!! IO=I -!! NVALUES=10 -!! SWITCH=VECTOR -!! SEARCH=L,P -!! DEFAULT=-.00551,.0031416,.007398,.0039954,.04873,- -!! .0030153,.034983,.65017,.83562,-.16438 /NOASK -!! PROMPT="Instrumental pol." -!! HELP=" -!!Specify the instrumental polarisation. INPOL* asks for Q, U and iV. The value -!!following the _ gives the maximum frequency (MHz) for which the values hold. -!!The formula is used: -!! A0+A1(a1 sin p +b1 cos p)+A2(a2 sin 2p + b2 cos 2p), with: -!! Ai=Ci sin(Di.f.r)**2 -!!The first 6 values give the Ci,Di pairs, the remaining 4 the ai,bi pairs. -!!p is the position angle from North through East; r the distance from the -!!beam centre in degrees, f the frequency in MHz" -!!! -!!! Instrumental polarisation -!!! Ref: NMOMUI -!!! -!!KEYWORD=INPOLV_100 -!! DATA_TYP=R -!! IO=I -!! NVALUES=10 -!! SWITCH=VECTOR -!! SEARCH=L,P -!! DEFAULT=-.0003801,.0038425,.00269,.0022771,.01992,- -!! .0029009,.27194,-.72806,.77598,-.22402 /NOASK -!! PROMPT="Instrumental pol." -!! HELP=" -!!Specify the instrumental polarisation. INPOL* asks for Q, U and iV. The value -!!following the _ gives the maximum frequency (MHz) for which the values hold. -!!The formula is used: -!! A0+A1(a1 sin p +b1 cos p)+A2(a2 sin 2p + b2 cos 2p), with: -!! Ai=Ci sin(Di.f.r)**2 -!!The first 6 values give the Ci,Di pairs, the remaining 4 the ai,bi pairs. -!!p is the position angle from North through East; r the distance from the -!!beam centre in degrees, f the frequency in MHz" -!!! -!!! Instrumental polarisation -!!! Ref: NMOMUI -!!! -!!KEYWORD=INPOLQ_400 -!! DATA_TYP=R -!! IO=I -!! NVALUES=10 -!! SWITCH=VECTOR -!! SEARCH=L,P -!! DEFAULT=-.003137,.0024037,.01159,.0038832,.02139,- -!! .0027887,.17698,.82302,-.21744,-.78256 /NOASK -!! PROMPT="Instrumental pol." -!! HELP=" -!!Specify the instrumental polarisation. INPOL* asks for Q, U and iV. The value -!!following the _ gives the maximum frequency (MHz) for which the values hold. -!!The formula is used: -!! A0+A1(a1 sin p +b1 cos p)+A2(a2 sin 2p + b2 cos 2p), with: -!! Ai=Ci sin(Di.f.r)**2 -!!The first 6 values give the Ci,Di pairs, the remaining 4 the ai,bi pairs. -!!p is the position angle from North through East; r the distance from the -!!beam centre in degrees, f the frequency in MHz" -!!! -!!! Instrumental polarisation -!!! Ref: NMOMUI -!!! -!!KEYWORD=INPOLU_400 -!! DATA_TYP=R -!! IO=I -!! NVALUES=10 -!! SWITCH=VECTOR -!! SEARCH=L,P -!! DEFAULT=-.00551,.0031416,.007398,.0039954,.04873,- -!! .0030153,.034983,.65017,.83562,-.16438 /NOASK -!! PROMPT="Instrumental pol." -!! HELP=" -!!Specify the instrumental polarisation. INPOL* asks for Q, U and iV. The value -!!following the _ gives the maximum frequency (MHz) for which the values hold. -!!The formula is used: -!! A0+A1(a1 sin p +b1 cos p)+A2(a2 sin 2p + b2 cos 2p), with: -!! Ai=Ci sin(Di.f.r)**2 -!!The first 6 values give the Ci,Di pairs, the remaining 4 the ai,bi pairs. -!!p is the position angle from North through East; r the distance from the -!!beam centre in degrees, f the frequency in MHz" -!!! -!!! Instrumental polarisation -!!! Ref: NMOMUI -!!! -!!KEYWORD=INPOLV_400 -!! DATA_TYP=R -!! IO=I -!! NVALUES=10 -!! SWITCH=VECTOR -!! SEARCH=L,P -!! DEFAULT=-.0003801,.0038425,.00269,.0022771,.01992,- -!! .0029009,.27194,-.72806,.77598,-.22402 /NOASK -!! PROMPT="Instrumental pol." -!! HELP=" -!!Specify the instrumental polarisation. INPOL* asks for Q, U and iV. The value -!!following the _ gives the maximum frequency (MHz) for which the values hold. -!!The formula is used: -!! A0+A1(a1 sin p +b1 cos p)+A2(a2 sin 2p + b2 cos 2p), with: -!! Ai=Ci sin(Di.f.r)**2 -!!The first 6 values give the Ci,Di pairs, the remaining 4 the ai,bi pairs. -!!p is the position angle from North through East; r the distance from the -!!beam centre in degrees, f the frequency in MHz" -!!! -!!! Instrumental polarisation -!!! Ref: NMOMUI -!!! -!!KEYWORD=INPOLQ_1000 -!! DATA_TYP=R -!! IO=I -!! NVALUES=10 -!! SWITCH=VECTOR -!! SEARCH=L,P -!! DEFAULT=-.003137,.0024037,.01159,.0038832,.02139,- -!! .0027887,.17698,.82302,-.21744,-.78256 /NOASK -!! PROMPT="Instrumental pol." -!! HELP=" -!!Specify the instrumental polarisation. INPOL* asks for Q, U and iV. The value -!!following the _ gives the maximum frequency (MHz) for which the values hold. -!!The formula is used: -!! A0+A1(a1 sin p +b1 cos p)+A2(a2 sin 2p + b2 cos 2p), with: -!! Ai=Ci sin(Di.f.r)**2 -!!The first 6 values give the Ci,Di pairs, the remaining 4 the ai,bi pairs. -!!p is the position angle from North through East; r the distance from the -!!beam centre in degrees, f the frequency in MHz" -!!! -!!! Instrumental polarisation -!!! Ref: NMOMUI -!!! -!!KEYWORD=INPOLU_1000 -!! DATA_TYP=R -!! IO=I -!! NVALUES=10 -!! SWITCH=VECTOR -!! SEARCH=L,P -!! DEFAULT=-.00551,.0031416,.007398,.0039954,.04873,- -!! .0030153,.034983,.65017,.83562,-.16438 /NOASK -!! PROMPT="Instrumental pol." -!! HELP=" -!!Specify the instrumental polarisation. INPOL* asks for Q, U and iV. The value -!!following the _ gives the maximum frequency (MHz) for which the values hold. -!!The formula is used: -!! A0+A1(a1 sin p +b1 cos p)+A2(a2 sin 2p + b2 cos 2p), with: -!! Ai=Ci sin(Di.f.r)**2 -!!The first 6 values give the Ci,Di pairs, the remaining 4 the ai,bi pairs. -!!p is the position angle from North through East; r the distance from the -!!beam centre in degrees, f the frequency in MHz" -!!! -!!! Instrumental polarisation -!!! Ref: NMOMUI -!!! -!!KEYWORD=INPOLV_1000 -!! DATA_TYP=R -!! IO=I -!! NVALUES=10 -!! SWITCH=VECTOR -!! SEARCH=L,P -!! DEFAULT=-.0003801,.0038425,.00269,.0022771,.01992,- -!! .0029009,.27194,-.72806,.77598,-.22402 /NOASK -!! PROMPT="Instrumental pol." -!! HELP=" -!!Specify the instrumental polarisation. INPOL* asks for Q, U and iV. The value -!!following the _ gives the maximum frequency (MHz) for which the values hold. -!!The formula is used: -!! A0+A1(a1 sin p +b1 cos p)+A2(a2 sin 2p + b2 cos 2p), with: -!! Ai=Ci sin(Di.f.r)**2 -!!The first 6 values give the Ci,Di pairs, the remaining 4 the ai,bi pairs. -!!p is the position angle from North through East; r the distance from the -!!beam centre in degrees, f the frequency in MHz" -!!! -!!! Instrumental polarisation -!!! Ref: NMOMUI -!!! -!!KEYWORD=INPOLQ_2000 -!! DATA_TYP=R -!! IO=I -!! NVALUES=10 -!! SWITCH=VECTOR -!! SEARCH=L,P -!! DEFAULT=-.003137,.0024037,.01159,.0038832,.02139,- -!! .0027887,.17698,.82302,-.21744,-.78256 /NOASK -!! PROMPT="Instrumental pol." -!! HELP=" -!!Specify the instrumental polarisation. INPOL* asks for Q, U and iV. The value -!!following the _ gives the maximum frequency (MHz) for which the values hold. -!!The formula is used: -!! A0+A1(a1 sin p +b1 cos p)+A2(a2 sin 2p + b2 cos 2p), with: -!! Ai=Ci sin(Di.f.r)**2 -!!The first 6 values give the Ci,Di pairs, the remaining 4 the ai,bi pairs. -!!p is the position angle from North through East; r the distance from the -!!beam centre in degrees, f the frequency in MHz" -!!! -!!! Instrumental polarisation -!!! Ref: NMOMUI -!!! -!!KEYWORD=INPOLU_2000 -!! DATA_TYP=R -!! IO=I -!! NVALUES=10 -!! SWITCH=VECTOR -!! SEARCH=L,P -!! DEFAULT=-.00551,.0031416,.007398,.0039954,.04873,- -!! .0030153,.034983,.65017,.83562,-.16438 /NOASK -!! PROMPT="Instrumental pol." -!! HELP=" -!!Specify the instrumental polarisation. INPOL* asks for Q, U and iV. The value -!!following the _ gives the maximum frequency (MHz) for which the values hold. -!!The formula is used: -!! A0+A1(a1 sin p +b1 cos p)+A2(a2 sin 2p + b2 cos 2p), with: -!! Ai=Ci sin(Di.f.r)**2 -!!The first 6 values give the Ci,Di pairs, the remaining 4 the ai,bi pairs. -!!p is the position angle from North through East; r the distance from the -!!beam centre in degrees, f the frequency in MHz" -!!! -!!! Instrumental polarisation -!!! Ref: NMOMUI -!!! -!!KEYWORD=INPOLV_2000 -!! DATA_TYP=R -!! IO=I -!! NVALUES=10 -!! SWITCH=VECTOR -!! SEARCH=L,P -!! DEFAULT=-.0003801,.0038425,.00269,.0022771,.01992,- -!! .0029009,.27194,-.72806,.77598,-.22402 /NOASK -!! PROMPT="Instrumental pol." -!! HELP=" -!!Specify the instrumental polarisation. INPOL* asks for Q, U and iV. The value -!!following the _ gives the maximum frequency (MHz) for which the values hold. -!!The formula is used: -!! A0+A1(a1 sin p +b1 cos p)+A2(a2 sin 2p + b2 cos 2p), with: -!! Ai=Ci sin(Di.f.r)**2 -!!The first 6 values give the Ci,Di pairs, the remaining 4 the ai,bi pairs. -!!p is the position angle from North through East; r the distance from the -!!beam centre in degrees, f the frequency in MHz" -!!! -!!! Instrumental polarisation -!!! Ref: NMOMUI -!!! -!!KEYWORD=INPOLQ_4000 -!! DATA_TYP=R -!! IO=I -!! NVALUES=10 -!! SWITCH=VECTOR -!! SEARCH=L,P -!! DEFAULT=-.003137,.0024037,.01159,.0038832,.02139,- -!! .0027887,.17698,.82302,-.21744,-.78256 /NOASK -!! PROMPT="Instrumental pol." -!! HELP=" -!!Specify the instrumental polarisation. INPOL* asks for Q, U and iV. The value -!!following the _ gives the maximum frequency (MHz) for which the values hold. -!!The formula is used: -!! A0+A1(a1 sin p +b1 cos p)+A2(a2 sin 2p + b2 cos 2p), with: -!! Ai=Ci sin(Di.f.r)**2 -!!The first 6 values give the Ci,Di pairs, the remaining 4 the ai,bi pairs. -!!p is the position angle from North through East; r the distance from the -!!beam centre in degrees, f the frequency in MHz" -!!! -!!! Instrumental polarisation -!!! Ref: NMOMUI -!!! -!!KEYWORD=INPOLU_4000 -!! DATA_TYP=R -!! IO=I -!! NVALUES=10 -!! SWITCH=VECTOR -!! SEARCH=L,P -!! DEFAULT=-.00551,.0031416,.007398,.0039954,.04873,- -!! .0030153,.034983,.65017,.83562,-.16438 /NOASK -!! PROMPT="Instrumental pol." -!! HELP=" -!!Specify the instrumental polarisation. INPOL* asks for Q, U and iV. The value -!!following the _ gives the maximum frequency (MHz) for which the values hold. -!!The formula is used: -!! A0+A1(a1 sin p +b1 cos p)+A2(a2 sin 2p + b2 cos 2p), with: -!! Ai=Ci sin(Di.f.r)**2 -!!The first 6 values give the Ci,Di pairs, the remaining 4 the ai,bi pairs. -!!p is the position angle from North through East; r the distance from the -!!beam centre in degrees, f the frequency in MHz" -!!! -!!! Instrumental polarisation -!!! Ref: NMOMUI -!!! -!!KEYWORD=INPOLV_4000 -!! DATA_TYP=R -!! IO=I -!! NVALUES=10 -!! SWITCH=VECTOR -!! SEARCH=L,P -!! DEFAULT=-.0003801,.0038425,.00269,.0022771,.01992,- -!! .0029009,.27194,-.72806,.77598,-.22402 /NOASK -!! PROMPT="Instrumental pol." -!! HELP=" -!!Specify the instrumental polarisation. INPOL* asks for Q, U and iV. The value -!!following the _ gives the maximum frequency (MHz) for which the values hold. -!!The formula is used: -!! A0+A1(a1 sin p +b1 cos p)+A2(a2 sin 2p + b2 cos 2p), with: -!! Ai=Ci sin(Di.f.r)**2 -!!The first 6 values give the Ci,Di pairs, the remaining 4 the ai,bi pairs. -!!p is the position angle from North through East; r the distance from the -!!beam centre in degrees, f the frequency in MHz" -!!! -!!! Instrumental polarisation -!!! Ref: NMOMUI -!!! -!!KEYWORD=INPOLQ_10000 -!! DATA_TYP=R -!! IO=I -!! NVALUES=10 -!! SWITCH=VECTOR -!! SEARCH=L,P -!! DEFAULT=-.003137,.0024037,.01159,.0038832,.02139,- -!! .0027887,.17698,.82302,-.21744,-.78256 /NOASK -!! PROMPT="Instrumental pol." -!! HELP=" -!!Specify the instrumental polarisation. INPOL* asks for Q, U and iV. The value -!!following the _ gives the maximum frequency (MHz) for which the values hold. -!!The formula is used: -!! A0+A1(a1 sin p +b1 cos p)+A2(a2 sin 2p + b2 cos 2p), with: -!! Ai=Ci sin(Di.f.r)**2 -!!The first 6 values give the Ci,Di pairs, the remaining 4 the ai,bi pairs. -!!p is the position angle from North through East; r the distance from the -!!beam centre in degrees, f the frequency in MHz" -!!! -!!! Instrumental polarisation -!!! Ref: NMOMUI -!!! -!!KEYWORD=INPOLU_10000 -!! DATA_TYP=R -!! IO=I -!! NVALUES=10 -!! SWITCH=VECTOR -!! SEARCH=L,P -!! DEFAULT=-.00551,.0031416,.007398,.0039954,.04873,- -!! .0030153,.034983,.65017,.83562,-.16438 /NOASK -!! PROMPT="Instrumental pol." -!! HELP=" -!!Specify the instrumental polarisation. INPOL* asks for Q, U and iV. The value -!!following the _ gives the maximum frequency (MHz) for which the values hold. -!!The formula is used: -!! A0+A1(a1 sin p +b1 cos p)+A2(a2 sin 2p + b2 cos 2p), with: -!! Ai=Ci sin(Di.f.r)**2 -!!The first 6 values give the Ci,Di pairs, the remaining 4 the ai,bi pairs. -!!p is the position angle from North through East; r the distance from the -!!beam centre in degrees, f the frequency in MHz" -!!! -!!! Instrumental polarisation -!!! Ref: NMOMUI -!!! -!!KEYWORD=INPOLV_10000 -!! DATA_TYP=R -!! IO=I -!! NVALUES=10 -!! SWITCH=VECTOR -!! SEARCH=L,P -!! DEFAULT=-.0003801,.0038425,.00269,.0022771,.01992,- -!! .0029009,.27194,-.72806,.77598,-.22402 /NOASK -!! PROMPT="Instrumental pol." -!! HELP=" -!!Specify the instrumental polarisation. INPOL* asks for Q, U and iV. The value -!!following the _ gives the maximum frequency (MHz) for which the values hold. -!!The formula is used: -!! A0+A1(a1 sin p +b1 cos p)+A2(a2 sin 2p + b2 cos 2p), with: -!! Ai=Ci sin(Di.f.r)**2 -!!The first 6 values give the Ci,Di pairs, the remaining 4 the ai,bi pairs. -!!p is the position angle from North through East; r the distance from the -!!beam centre in degrees, f the frequency in MHz" -!!! -!!! Instrumental polarisation -!!! Ref: NMOMUI -!!! -!!KEYWORD=INPOLQ_100000 -!! DATA_TYP=R -!! IO=I -!! NVALUES=10 -!! SWITCH=VECTOR -!! SEARCH=L,P -!! DEFAULT=-.003137,.0024037,.01159,.0038832,.02139,- -!! .0027887,.17698,.82302,-.21744,-.78256 /NOASK -!! PROMPT="Instrumental pol." -!! HELP=" -!!Specify the instrumental polarisation. INPOL* asks for Q, U and iV. The value -!!following the _ gives the maximum frequency (MHz) for which the values hold. -!!The formula is used: -!! A0+A1(a1 sin p +b1 cos p)+A2(a2 sin 2p + b2 cos 2p), with: -!! Ai=Ci sin(Di.f.r)**2 -!!The first 6 values give the Ci,Di pairs, the remaining 4 the ai,bi pairs. -!!p is the position angle from North through East; r the distance from the -!!beam centre in degrees, f the frequency in MHz" -!!! -!!! Instrumental polarisation -!!! Ref: NMOMUI -!!! -!!KEYWORD=INPOLU_100000 -!! DATA_TYP=R -!! IO=I -!! NVALUES=10 -!! SWITCH=VECTOR -!! SEARCH=L,P -!! DEFAULT=-.00551,.0031416,.007398,.0039954,.04873,- -!! .0030153,.034983,.65017,.83562,-.16438 /NOASK -!! PROMPT="Instrumental pol." -!! HELP=" -!!Specify the instrumental polarisation. INPOL* asks for Q, U and iV. The value -!!following the _ gives the maximum frequency (MHz) for which the values hold. -!!The formula is used: -!! A0+A1(a1 sin p +b1 cos p)+A2(a2 sin 2p + b2 cos 2p), with: -!! Ai=Ci sin(Di.f.r)**2 -!!The first 6 values give the Ci,Di pairs, the remaining 4 the ai,bi pairs. -!!p is the position angle from North through East; r the distance from the -!!beam centre in degrees, f the frequency in MHz" -!!! -!!! Instrumental polarisation -!!! Ref: NMOMUI -!!! -!!KEYWORD=INPOLV_100000 -!! DATA_TYP=R -!! IO=I -!! NVALUES=10 -!! SWITCH=VECTOR -!! SEARCH=L,P -!! DEFAULT=-.0003801,.0038425,.00269,.0022771,.01992,- -!! .0029009,.27194,-.72806,.77598,-.22402 /NOASK -!! PROMPT="Instrumental pol." -!! HELP=" -!!Specify the instrumental polarisation. INPOL* asks for Q, U and iV. The value -!!following the _ gives the maximum frequency (MHz) for which the values hold. -!!The formula is used: -!! A0+A1(a1 sin p +b1 cos p)+A2(a2 sin 2p + b2 cos 2p), with: -!! Ai=Ci sin(Di.f.r)**2 -!!The first 6 values give the Ci,Di pairs, the remaining 4 the ai,bi pairs. -!!p is the position angle from North through East; r the distance from the -!!beam centre in degrees, f the frequency in MHz" -! -! Get file with names of sources -! Ref: NMONAM - used by NMAP -! -KEYWORD=NAMES_FILE - DATA_TYP=C - IO=I - LENGTH=80 - SWITCHES=LOOP,NULL_VALUES,WILD_CARDS - SEARCH=L,P - PROMPT="File with source names" - HELP=" -Specify the full name of the input disk-file. The file should contain lines -with Ra, Dec and Name, separated by white space. Comments may be added starting -with an exclamation mark. A NULL answer (two double quotes) will ignore the -name-list: no file will be opened." -!- diff --git a/src/nscan/nmodel.psc b/src/nscan/nmodel.psc deleted file mode 100644 index 676f7f6921b9d9cfed18220b66380c23e7334167..0000000000000000000000000000000000000000 --- a/src/nscan/nmodel.psc +++ /dev/null @@ -1,448 +0,0 @@ -!+ NMODEL.PSC -! WNB 900327 -! -! Revisions: -! WNB 910820 Add extinction, refraction, Faraday -! WNB 910827 Add CALIB -! WNB 910828 Add RUN -! WNB 910909 Add DATAB and INFIX -! WNB 910909 Add OUTPUT_NODE -! WNB 910913 New (de-)apply and loops -! WNB 911007 Add instr. pol. -! WNB 911230 Add DNCLOW -! WNB 920626 Add DCLOW, change Rotation measure description -! WNB 920818 Add DAREA -! WNB 921104 Text select ifrs; HA range; J2000 -! WNB 921211 Make PSC -! WNB 921217 Add AFIND -! JEN 930308 INCLUDE=NSETS_PEF, remove keywords MAPS, SCAN_SETS -! JEN 930312 INCLUDE=NCOMM_PEF -! JEN 930312 Remove keyword(s) SCAN_NODE, MAP_NODE -! JEN 930312 Remove keyword(s) SELECT_IFRS, POLARISATION, HA_RANGE -! HjV 930426 Change name keywords REFERENCE_SCAN, -! REFERENCE_SET, OUTPUT_NODE -! WNB 930514 Add manual find, FIND_TYPE -! WNB 930517 Add GIDS_SOURCES (was removed in change of 930426) -! WNB 930928 Continuation lines; extend REFERENCE_DATA -! WNB 931008 Add EDIT to ACTION; text; moved CONVERT_TO from .pef -! WNB 931011 Add SUPDATE -! WNB 931119 Add REDIT, FEDIT to action -! WNB 940821 Add UPDATE_TYPE -! JPH 940913 Remove () on prompts -! JPH 941206 Help texts; prompt formatting -! JPH 941222 / in OPTIONS --> , -! CMV 950110 Remove _ in option string -! WNB 950626 Add grouped update options -! WNB 950630 Add Update options -! WNB 950706 Add LCOMBINE, LCLUSTER, LCONSTRAINT -! JPH 950929 Merge private shadow-version; cosmetic changes -! JPH 961112 Help texts -! WNB 990729 Add X0-X3 as model updates -! -! -! Get overall action -! Ref: NMODAT -! -KEYWORD=ACTION - DATA_TYP=C - IO=I - LENGTH=24 - CHECKS=ABBREV_OPTIONS - SWITCH=LOOP,NULL_VALUES,WILD_CARDS - SEARCH=L,P - PROMPT="Action" - OPTIONS=- -HELP, HANDLE; SAVE, GET; FIND, UPDATE; |- -CONVERT, EDIT, REDIT, FEDIT ,BEAM,DEBEAM; FROM_OLD, TO_OLD, NVS, CVXL; QUIT| - HELP=" Specify action to perform: -. - General: -. - HELP show some explanation on model lists - HANDLE select general model-handling branch -. - Model construction: -. - FIND find sources in map (.WMP file) - UPDATE update sources by comparison with visibilities (.SCN file) -. - Transfer of model to/from .SCN file: -. - SAVE save model data in .SCN file - GET get model from .SCN file -. - Wholescale conversions of model list: -. - CONVERT Convert model list from epoch to epoch or coordinate to - coordinate with conversion of l,m coordinates and intensities - if necessary - EDIT Change model-list overall parameters without conversion of - coordinates and intensity (except possible field rotation if - converting from apparant <-> epoch) - REDIT Change reference coordinates and frequency. Intensities will - be corrected for spectral index only. - FEDIT As REDIT, but intensities will also be corrected for the - effect of different beams at different frequencies -!! Primary or synthesised? - BEAM Correct sources for attenuation by primary beam - DEBEAM Apply primary-beam attenuation to sources -. - Utilities: -. - FROM_OLD convert old format source list (use B1950 or Apparent by - preference) - TO_OLD convert to old format source list - NVS make new version of model file if necessary - CVXL convert formats between machines -. - QUIT finish" -! -! Get find type -! Ref: NMODAT -! -KEYWORD=FIND_TYPE - DATA_TYP=C - IO=I - LENGTH=24 - CHECKS=ABBREV_OPTIONS - SWITCH=LOOP,NULL_VALUES,WILD_CARDS - SEARCH=L,P - PROMPT="Finding mode" - OPTIONS=POS,ABS, MANUAL; QUIT - HELP=" -Specify how to select candidate sources: -. - POS Select sources with highest positive brightness - ABS Select sources with highest absolute brightness - MANUAL Select sources manually with the cursor on a GIDS screen. - Sources are selected by pushing MB1; MB3 will finish; - MB2 will not calculate position, but put grid point as clean - source" -!! This should come as an explanation from the code -! -! Get update type -! Ref: NMODAT -! -KEYWORD=UPDATE_TYPE - DATA_TYP=C - IO=I - LENGTH=24 - CHECKS=ABBREV_OPTIONS - SWITCH=LOOP,NULL_VALUES,WILD_CARDS - SEARCH=L,P - PROMPT="Update mode" - OPTIONS=I, LM, ILM, SILM; EXTEND; QUV, PESTIMATE;|- -X00, X01, X02, X03 ; QUIT - HELP=" -Specify the parameters to be redetermined per source in the update process. -. - Position and flux: - I Intensity only - LM Position only - ILM Intensity and position - SILM Intensity, spectral index and position (requires a multichannel - observation with <bandwidth per channel>/<frequency> greater - than ..) -! ?? -. - Source size: - EXTEND Intensity and size parameters for elliptic-Gaussian model - (major/minor axes, position angle) -. - Source polarisation: - QUV Stokes Q/I, U/I, V/I - PESTIM Estimate the total linear polarisation, and store it as Stokes - Q. NOTE that this improper use of the model list is not - recorded, so you it is your responsibility to interpret this - kluge correctly. -. - Specially programmed updates -- ask AGdB about details - X00 Type extra 0 - X01 Type extra 1 - X02 Type extra 2 - X03 Type extra 3 -. -NOTES: - 1. All sources in the model are taken into account in determining the -residual visibilities on which the update fit is performed. However, no updates -are attempted for sources of type other than 0 nor for CLEAN components. - - If you want to protect one or more sources from being updated, you can -do so by temporarily changing their type (OPTION=MODIFY, MODIFY_OPTION=FEDIT, -see the Help text there). -! \whichref{}{} -. - 2. It is recommended that you use a set of interferometers that gives a -uniform baseline coverage, e.g. by selecting fixed-movable (FM) interferometers -only. " -! -! Get update mode -! Ref: NMODAT -! -KEYWORD=UPDATE_MODE - DATA_TYP=C - IO=I - LENGTH=24 - CHECKS=ABBREV_OPTIONS - SWITCH=LOOP,NULL_VALUES,WILD_CARDS - SEARCH=L,P - PROMPT="Update type" - OPTIONS=SEPARATE; CLUSTER, LCLUSTER; COMBINED, LCOMBINED;|- -CONSTRAINED, LCONSTRAINED; QUIT - HELP=" -Specify how the update process should proceed: -. - SEPARATE each source to be updated is looked at separately, - and they are fiddled to cater for close sources -. - CLUSTER sources are clustered to bypass closeness problems -. - COMBINED all sources solved in one go, with sub-clustering -. - CONSTRAINED use constraints and clustering. The standard - constraint used is to fix all variables for all - but the lowest intensity source -. - L<type> Loop up to 20 cycles till convergence: - Note that the loop option does not always - work, and is very slow. Preferably use for a - small number of well separated sources/clusters. " -! -! Get update cluster size area -! Ref: NMODAT -! -KEYWORD=UPDATE_CLUSTER - DATA_TYP=R - IO=I - NVALUES=2 - SWITCHES=LOOP,VECTOR,NULL_VALUES,WILD_CARD - SEARCH=L,P - PROMPT="Update cluster size in arcsec (l,m)" - HELP=" -Specify the cluster size for update in arcsec in the l and m direction. " -! -! Confirm manual search -! Ref: NMOFMD -! -KEYWORD=GIDS_SOURCES - DATA_TYP=L - IO=I - SWITCH=NULL_VALUES,WILD_CARDS - SEARCH=L,P - PROMPT="Select sources on GIDS display (Yes/No)?"" - HELP=" -Specify if you want to point at sources on the GIDS display for the current map" -! -! Get file -! Ref: NMODAT -! -KEYWORD=OLD_FILE - DATA_TYP=C - IO=I - LENGTH=80 - SWITCHES=LOOP,NULL_VALUES,WILD_CARDS - SEARCH=L,P - PROMPT="old model filename" - HELP=" -Specify the filename (includinhg extension) the an old-format RMODEL file to be -read or written. " -! -! Get calibrator list -! Ref: RMOCAL -! -KEYWORD=CALIBRATORS - DATA_TYP=J - IO=I - NVALUES=128 - SWITCH=LOOP,WILD_CARDS,NULL_VALUES - SEARCH=L,P - PROMPT="List of sources or *" - HELP=" -Specify up to 128 numbers of sources in the model list that you want to use as -calibrators." -! -! Get source conversion action -! Ref: NMOCVT -! -KEYWORD=CONVERT_TO - DATA_TYP=C - IO=I - LENGTH=24 - CHECKS=ABBREV_OPTIONS - SWITCH=LOOP,NULL_VALUES,WILD_CARDS - SEARCH=L,P - OPTIONS=B1950,J2000,APPARENT,LOCAL - PROMPT="Target coordinate system" - HELP=" -Specify the coordinate system for the output model-list. -. -If you are CONVERTing, the output model list's coordinates and intensities will -reflect the new type, frequency, instrument and central coordinates. -. -If you are EDITing, the new data will be copied only, but the coordinates will -be rotated to the new Pole if you are converting between apparent and epoch. -!! ??? -" -! -! Get coordinate reference scan node -! Ref: NMOCVS -! -KEYWORD=REF_SCN_NODE - DATA_TYP=C - IO=I - LENGTH=80 - SWITCHES=LOOP,NULL_VALUES,WILD_CARDS - SEARCH=L,P - PROMPT="File name" - HELP=" -Specify the node name with the model overall coordinates to use. -. -Instead of a file name you may reply with a '*'. You will then be prompted for -'manual' inpout of data, unless you are CONVRTing between apparent and epoch -coordinates. -!! ??? -!!. -!!Note that the node name can be preceded with dev:[dir..] (or /dev/dir... if -!!Unix). The specified dev and/or directories will become the default -!!database for all node related names. Atstart of program the default is the -!!current directory. The database specified should be an existing directory. -!!. -!!By placing part of the node name in parentheses (), the string defined -!!in such a way can in subsequent node questions be referenced with a #. -!!Hence the following inputs will translate as: -!!. -!! ngc1204.21cm.long ngc1204.21cm.long -!! [dwl.ger.ngc1204]ngc1204.90cm.short [dwl.ger.ngc1204]ngc1204.90cm.short -!! (ngc1204.21cm.)long [dwl.ger.ngc1204]ngc1204.21cm.long -!! a.#long [dwl.ger.ngc1204]a.ngc1204.21cm.long -!! Is this of any use? If so, why specifically here? -" -! -! Get coordinate reference set -! Ref: NMOCVS -! -KEYWORD=REF_SCN_SET - DATA_TYP=C - IO=I - LENGTH=32 - NVALUES=64 - SWITCHES=LOOP,NULL_VALUES,WILD_CARDS - SEARCH=L,P - PROMPT="ONE sector for reference coordinates: grp.obs.fld.chn.seq" - HELP=" -Specify ONE .SCN-file sector from which the reference coordinates (RA, DEC, -frequency) are to be taken. -. -grp.obs.fld.chn.seq = group.obs.field.channel.sequence_number " -! -! Get reference data -! Ref: NMOCVT -! -KEYWORD=REFERENCE_DATA - DATA_TYP=D - IO=I - NVALUES=5 - SWITCH=LOOP,VECTOR,WILD_CARDS,NULL_VALUES - SEARCH=L,P - PROMPT="RA, DEC, Freq, rot.,instr." - HELP=" -Specify -. - RA, DEC (decimal degrees) - precession rotation angle (degrees) - spectral-index reference frequency (MHz) - instrument code (0=WSRT; 1=ATCA) -. -for the new reference source list position. " -!! Order in prompt and help differ -! -! Get reference frequency -! Ref: NMOOFR -! -KEYWORD=REFERENCE_FREQ - DATA_TYP=D - IO=I - SWITCH=LOOP,WILD_CARDS,NULL_VALUES - SEARCH=L,P - PROMPT="Reference frequency (MHz)" - HELP=" -Specify the spectral index reference frequency (MHz)." -! -! -! Get area -! Ref: NMADAR -! -KEYWORD=AREA - DATA_TYP=J - IO=I - NVALUES=4 - SWITCHES=LOOP,VECTOR,NULL_VALUES,WILD_CARD - SEARCH=L,P - PROMPT="Map area: l,m, dl,dm" - HELP=" -Specify the map area to be selected: -. - l, m position in grid spacings of centre of area - 0,0 is the map centre, increaing toward the upper right (i.e. - with DEcreasing RA and INcreasing DEC) -. - dl, dm horizontal and vertical area sizes " -! -! Get source amplitude limit -! Ref: NMODAT -! -KEYWORD=MAP_LIMIT - DATA_TYPE=R - IO=I - SWITCH=LOOP,NULL_VALUE,WILD_CARD - CHECKS=MINIMUM,MAXIMUM - MINIMUM=0. - MAXIMUM=1. - SEARCH=L,P - PROMPT="Lower relative intensity limit" - HELP=" -Specify the lowest limit with respect to the maximum in the map that will be -considered a valid source" -! -! Get sources to add -! Ref: NMODAT -! -KEYWORD=MAX_NUMBER - DATA_TYPE=J - IO=I - SWITCH=LOOP,NULL_VALUE,WILD_CARD - CHECKS=MINIMUM,MAXIMUM - MINIMUM=1 - MAXIMUM=200 - SEARCH=L,P - PROMPT="Maximum number of sources to add" - HELP=" -Specify the maximum number of sources that will be found. " -! -! Get source ID -! Ref: NMODAT -! -KEYWORD=ID_START - DATA_TYPE=J - IO=I - SWITCH=LOOP,NULL_VALUE,WILD_CARD - CHECKS=MINIMUM - MINIMUM=1 - SEARCH=L,P - PROMPT="Start identification number" - HELP=" -Specify the start of the ID number to be used in the source list." -!- -INCLUDE=NGEN_PEF -!- -INCLUDE=SCNNODE_PEF ! -INCLUDE=SCNSETS_PEF ! -INCLUDE=SELECT_PEF -!- -INCLUDE=WMPNODE_PEF ! -INCLUDE=WMPSETS_PEF -!- -INCLUDE=MDLNODE_PEF -!- -INCLUDE=NMODEL_PEF -!- diff --git a/src/nscan/nmoext.for b/src/nscan/nmoext.for deleted file mode 100644 index db6ce1081610279de6125ffa0d2b5bbe93491066..0000000000000000000000000000000000000000 --- a/src/nscan/nmoext.for +++ /dev/null @@ -1,103 +0,0 @@ -C+ NMOEXT.FOR -C WNB 900827 -C -C Revisions: -C WNB 920403 Correct for symmetric extended sources -C - SUBROUTINE NMOEXF(IMDLE) -C -C Convert from/to external format -C -C Result: -C -C CALL NMOEXF( IMDLE_E(0:*)) convert IMDLE source to internal format -C CALL NMOEXT( IMDLE_E(0:*)) convert IMDLE source to external format -C -C -C Include files: -C - INCLUDE 'WNG_DEF' - INCLUDE 'MDL_O_DEF' !MODEL LINE -C -C Entries: -C -C -C Parameters: -C -C -C Arguments: -C - REAL IMDLE(0:*) !MODEL LINE -C -C Function references: -C - INTEGER WNGARA !GET ADDRESS -C -C Data declarations: -C - BYTE TP !TYPE - REAL R2,R3 -C- -C -C EXF -C - IF (IMDLE(MDL_Q_E).EQ.0 .AND. IMDLE(MDL_U_E).EQ.0 .AND. - 1 IMDLE(MDL_V_E).EQ.0) THEN - TP=2 !SET NO POL. - ELSE - TP=0 !SET POL. - END IF - IF (ABS(IMDLE(MDL_EXT_E))+ABS(IMDLE(MDL_EXT_E+1)).GT.0) THEN !EXTENDED - R0=COS(IMDLE(MDL_EXT_E+2)/DEG) !P.A. - R1=-SIN(IMDLE(MDL_EXT_E+2)/DEG) - R2=(.5*IMDLE(MDL_EXT_E)/3600./DEG)**2 - R3=(.5*IMDLE(MDL_EXT_E+1)/3600./DEG)**2 - IMDLE(MDL_EXT_E+0)=R2*R1*R1+R3*R0*R0 !INTERNAL FORMAT - IMDLE(MDL_EXT_E+1)=R2*R0*R0+R3*R1*R1 - IMDLE(MDL_EXT_E+2)=2*(R2-R3)*R0*R1 - TP=TP+1 !SET EXTENDED - ELSE - IMDLE(MDL_EXT_E+2)=0 !P.A. - END IF - IMDLE(MDL_L_E)=IMDLE(MDL_L_E)/3600./DEG !MAKE RADIANS - IMDLE(MDL_M_E)=IMDLE(MDL_M_E)/3600./DEG - IMDLE(MDL_Q_E)=IMDLE(MDL_Q_E)/100. !MAKE FRACTION - IMDLE(MDL_U_E)=IMDLE(MDL_U_E)/100. - IMDLE(MDL_V_E)=IMDLE(MDL_V_E)/100. - A_B(WNGARA(IMDLE(0))+MDL_BITS_B-A_OB)=TP !SET TYPE -C - RETURN -C -C EXT -C - ENTRY NMOEXT(IMDLE) -C - IF (IMDLE(MDL_EXT_E+2).EQ.0 .AND. !EXTENDED - 1 (ABS(IMDLE(MDL_EXT_E+1))+ - 1 ABS(IMDLE(MDL_EXT_E)).EQ.0)) THEN - R0=0 - R1=0 - R2=0 - ELSE - IF (IMDLE(MDL_EXT_E+2).EQ.0 .AND. - 1 (IMDLE(MDL_EXT_E+1)-IMDLE(MDL_EXT_E)).EQ.0) THEN !SYMM. - R0=0 - ELSE - R0=.5*DEG*ATAN2(-IMDLE(MDL_EXT_E+2), - 1 IMDLE(MDL_EXT_E+1)-IMDLE(MDL_EXT_E)) !P.A. - END IF - R1=SQRT(IMDLE(MDL_EXT_E+2)**2+ - 1 (IMDLE(MDL_EXT_E)-IMDLE(MDL_EXT_E+1))**2) - R2=IMDLE(MDL_EXT_E)+IMDLE(MDL_EXT_E+1) - END IF - IMDLE(MDL_EXT_E+0)=2*SQRT(ABS((R2+R1)/2))*3600.*DEG !DL - IMDLE(MDL_EXT_E+1)=2*SQRT(ABS((R2-R1)/2))*3600.*DEG !DM - IMDLE(MDL_EXT_E+2)=R0 !P.A. - IMDLE(MDL_L_E)=IMDLE(MDL_L_E)*3600.*DEG !MAKE ARCSEC - IMDLE(MDL_M_E)=IMDLE(MDL_M_E)*3600.*DEG - IMDLE(MDL_Q_E)=IMDLE(MDL_Q_E)*100. !MAKE % - IMDLE(MDL_U_E)=IMDLE(MDL_U_E)*100. - IMDLE(MDL_V_E)=IMDLE(MDL_V_E)*100. -C -C - END diff --git a/src/nscan/nmofmd.for b/src/nscan/nmofmd.for deleted file mode 100644 index 805a6e0aadddbe15018cd03882f6886566f16916..0000000000000000000000000000000000000000 --- a/src/nscan/nmofmd.for +++ /dev/null @@ -1,286 +0,0 @@ -C+ NMOFMD.FOR -C WNB 930514 -C -C Revisions: -C WNB 930517 Add GIDS_SOURCES -C WNB 931006 Text -C WNB 950611 New LSQ routines -C - SUBROUTINE NMOFMD -C -C Find sources on map -C -C Result: -C CALL NMOFMD Find sources on map (pos. only) -C -C -C PIN references: -C -C GIDS_SOURCES -C -C Include files: -C - INCLUDE 'WNG_DEF' - INCLUDE 'NMO_DEF' - INCLUDE 'LSQ_O_DEF' - INCLUDE 'MPH_O_DEF' !MAP HEADER - INCLUDE 'MDH_O_DEF' !MODEL HEADER - INCLUDE 'MDL_O_DEF' !MODEL LINE -C -C Parameters: -C -C -C Arguments: -C -C -C Function references: -C - LOGICAL WNDPAR !GET USER DATA - LOGICAL WNFRD !READ DATA - LOGICAL WNMLGA !GET LSQ AREA - LOGICAL WNMLTN !SOLVE LSQ - CHARACTER*32 WNTTSG !GET SET NAME - LOGICAL NMOSLI,NMOSLG !GET SOURCE LIST - LOGICAL NMASTG !GET A MAP - LOGICAL NGIDOP,NGIDCL !OPEN/CLOSE GIDS - LOGICAL NGIDPT !GET SCREEN POINT - LOGICAL NGIDLM !LOAD (PART OF) MAP -C -C Data declarations: -C - INTEGER LSQ !LEAST SQUARES AREA - INTEGER GID !GIDS ID - INTEGER BUT !BUTTON PRESSED - BYTE GS1 !GIDS_SOURCES WANTED - LOGICAL GS4 - REAL RBF(0:1),RB(0:1) !SCREEN X,Y - REAL RS(6) !LSQ COEFFICIENTS - REAL SOL(6),MU,SD !LSQ SOLUTION - INTEGER LIDX !SOURCE LIST ID - INTEGER MDLP,MDLPJ,MDLPE !POINTER TO MODEL - INTEGER MDLLE,MDLLJ !LENGTH MODEL LINE - REAL RANGE(2) !DATA RANGE - REAL LINE(0:4095,5) !MAP LINES - REAL RM(-1:1,-1:1) !DATA ARRAY - INTEGER SNAM(0:7) !MAP NAME - INTEGER MPHP !MAP HEADER POINTER - BYTE MPH(0:MPHHDL-1) !MAP HEADER - INTEGER*2 MPHI(0:MPHHDL/2-1) - INTEGER MPHJ(0:MPHHDL/4-1) - REAL MPHE(0:MPHHDL/4-1) - DOUBLE PRECISION MPHD(0:MPHHDL/8-1) - EQUIVALENCE (MPH,MPHI,MPHJ,MPHE,MPHD) -C- -C -C INIT -C - IF (.NOT.NMOSLI(1024)) THEN !MAKE SURE THERE IS A LIST - 900 CONTINUE - CALL WNCTXT(F_TP,'Cannot create source list') - CALL WNGEX !STOP - END IF - LIDX=7 !SET SOURCES IN LIST 7 - IF (.NOT.WNMLGA(LSQ,LSQ_T_REAL,6)) THEN !GET LSQ AREA - CALL WNCTXT(F_TP,'ERROR: no work area space') - GOTO 102 - END IF - IF (.NOT.NGIDOP(GID)) THEN - CALL WNCTXT(F_TP,'Cannot open GIDS display') - GOTO 101 - END IF - CALL WNCTXT(F_T,'!/Use MB1 to fit source; MB2 to put '// - 1 'clean component; MB3 to stop!/') -C -C DO ALL MAPS -C - 100 CONTINUE - IF (.NOT.NMASTG(FCAIN,SETS,MPH,MPHP,SNAM)) THEN !NO MORE MAPS - 101 CONTINUE - JS=NGIDCL(GID) !CLOSE DISPLAY - CALL WNMLFA(LSQ) !FREE LSQ ARAE - 102 CONTINUE - CALL WNFCL(FCAIN) !CLOSE MAP FILE - RETURN !READY - END IF - CALL NMOHZD(GMDH(0,LIDX)) !CLEAR HEADER - IF (MPHI(MPH_EPT_I).EQ.1) THEN !1950/2000 COORDINATES - GMDHJ(MDH_TYP_J,LIDX)=2 !EPOCH TYPE - GMDHE(MDH_EPOCH_E,LIDX)=MPHE(MPH_EPO_E) !EPOCH - ELSE - GMDHJ(MDH_TYP_J,LIDX)=1 !EPOCH TYPE - GMDHE(MDH_EPOCH_E,LIDX)=0. !EPOCH - END IF - GMDHJ(MDH_BITS_J,LIDX)=MPHJ(MPH_INST_J) !INSTRUMENT - GMDHD(MDH_RA_D,LIDX)=MPHD(MPH_RA_D) !RA - GMDHD(MDH_DEC_D,LIDX)=MPHD(MPH_DEC_D) !DEC - GMDHD(MDH_FRQ_D,LIDX)=MPHD(MPH_FRQ_D) !FREQ. - IF (.NOT.NMOSLG(2*MAXSRN,GMDH(0,LIDX))) GOTO 900 !MAKE SURE SPACE - MDLP=GMDHJ(MDH_MODP_J,LIDX)-A_OB !MODEL POINTERS - MDLPJ=(GMDHJ(MDH_MODP_J,LIDX)-A_OB)/LB_J - MDLPE=(GMDHJ(MDH_MODP_J,LIDX)-A_OB)/LB_E - MDLLE=MDLHDL/LB_E !LENGTH MODEL ENTRY - MDLLJ=MDLHDL/LB_J -C -C START READ -C - IF (MPH(MPH_TYP_1).NE.ICHAR('M').OR. - 1 MPH(MPH_TYP_1+1).NE.ICHAR('A').OR. - 1 MPH(MPH_TYP_1+2).NE.ICHAR('P').OR. - 1 MPH(MPH_TYP_1+3).NE.ICHAR(' ')) THEN - CALL WNCTXT(F_TP,'Cannot find sources in UV-plane maps') - GOTO 101 - END IF - RANGE(1)=MPHE(MPH_MIN_E) !SET DATA RANGE - RANGE(2)=MPHE(MPH_MAX_E) - IF (.NOT.NGIDLM(GID,FCAIN,MPHJ,1,TAREA(0,0),TAREA(0,1),RANGE, - 1 NODIN,WNTTSG(SNAM,0))) THEN !LOAD MAP - CALL WNCTXT(F_TP,'Error loading map in GIDS') - GOTO 101 - END IF - CALL WNCTXT(F_TP,'Current map: !AS',WNTTSG(SNAM,0)) - RB(0)=-1 !START IN CENTRE - RB(1)=-1 - IF (.NOT.WNDPAR('GIDS_SOURCES',GS1,LB_B,J0,'YES')) GOTO 40 !ASK - IF (J0.EQ.0) GOTO 40 !ASSUME NO - IF (J0.LT.0) GOTO 20 !ASSUME YES - GS4=GS1 - IF (.NOT.GS4) GOTO 40 !NO - 20 CONTINUE - DO WHILE (NGIDPT(GID,1,TAREA(0,1),RB,RBF,BUT)) !MORE TO DO - J2=NINT(RBF(0)) !GRID POINT - J3=NINT(RBF(1)) - IF (BUT.NE.2) THEN !NOT CLEAN - IF (J2-2.LT.-MPHJ(MPH_NRA_J)/2 .OR. - 1 J2+2.GT.MPHJ(MPH_NRA_J)/2-1 .OR. - 1 J3-2.LT.-MPHJ(MPH_NDEC_J)/2 .OR. - 1 J3+2.GT.MPHJ(MPH_NDEC_J)/2-1) THEN - CALL WNCTXT(F_T,'too close to edge of map') - GOTO 33 !NEXT POINT - END IF - END IF - J0=MPHJ(MPH_MDP_J)+LB_E*(MPHJ(MPH_NRA_J)*MPHJ(MPH_NDEC_J)/2) !LINE 0 - J1=LB_E*MPHJ(MPH_NRA_J) !LENGTH LINE - IF (BUT.NE.2) THEN !NOT CLEAN - DO I=J3-2,J3+2 !READ LINES - IF (.NOT.WNFRD(FCAIN,J1,LINE(0,I-J3+3), - 1 J0+I*J1)) THEN !READ LINES - 910 CONTINUE - CALL WNCTXT(F_TP,'I/O error map reading') - CALL WNGEX !STOP - END IF - END DO - ELSE !CLEAN - IF (.NOT.WNFRD(FCAIN,J1,LINE(0,3), - 1 J0+J3*J1)) GOTO 910 !READ LINE - END IF -C -C DO ALL POINTS -C - IF (BUT.NE.2) THEN !NOT CLEAN - R0=-1E30 !FIND MAX. - DO I0=2,4 !CENTRE LINES - DO I1=J2-1+MPHJ(MPH_NRA_J)/2,J2+1+MPHJ(MPH_NRA_J)/2 !CENTRE POINTS - IF (ABS(LINE(I1,I0)).GT.R0) THEN - I=I1 - I2=I0 - R0=ABS(LINE(I1,I0)) - END IF - END DO - END DO - J2=I-MPHJ(MPH_NRA_J)/2 !NEW CENTRE POINT - J3=J3+I2-3 - DO I0=-1,1 !GET DATA MATRIX - DO I1=-1,1 - RM(I0,I1)=LINE(I0+I,I1+I2) - END DO - END DO - CALL WNMLIA(LSQ,LSQ_I_ALL) !ZERO LSQ - DO I1=-1,1 !SET DATA - DO I3=-1,1 - RS(1)=1 !GENERAL ELLIPSOID - RS(2)=I1 - RS(3)=I3 - RS(4)=I1*I1 - RS(5)=I3*I3 - RS(6)=I1*I3 - R1=RM(I1,I3) !DATA - CALL WNMLMN(LSQ,LSQ_C_REAL,RS,1.-.5*(ABS(I3)+ABS(I1))+ - 1 .25*ABS(I1*I3),R1) !MAKE EQUATIONS - END DO - END DO - IF (.NOT.WNMLTN(LSQ)) GOTO 30 !CANNOT SOLVE - CALL WNMLSN(LSQ,SOL,MU,SD) !GET SOLUTION - R1=SOL(6)*SOL(6)-4*SOL(4)*SOL(5) !FIND MAX - IF (R1.EQ.0) GOTO 30 !FORGET - R0=(2*SOL(3)*SOL(4)-SOL(2)*SOL(6))/R1 - R1=(2*SOL(2)*SOL(5)-SOL(3)*SOL(6))/R1 - IF (ABS(R0).GT.1 .OR. ABS(R1).GT.1) GOTO 30 !FORGET - SOL(1)=SOL(1)+SOL(2)*R0+SOL(3)*R1+SOL(4)*R0*R0+ - 1 SOL(5)*R1*R1+SOL(6)*R0*R1 !AMPLITUDE - SOL(2)=R1 !DX - SOL(3)=R0 !DY - ELSE !CLEAN - SOL(1)=LINE(J2+MPHJ(MPH_NRA_J)/2,3) - SOL(2)=0 - SOL(3)=0 - END IF - I1=GMDHJ(MDH_NSRC_J,LIDX)+1 !FILL SOURCE - CALL WNGMVZ(MDLHDL,A_E(MDLPE+(I1-1)*MDLLE)) !CLEAR SOURCE - A_E(MDLPE+MDL_I_E+(I1-1)*MDLLE)=SOL(1) !FILL SOURCE AMPL - A_E(MDLPE+MDL_L_E+(I1-1)*MDLLE)= - 1 ((J2+SOL(2))*MPHD(MPH_SRA_D)+ - 1 MPHD(MPH_SHR_D))*(360.*3600.) !SET L - A_E(MDLPE+MDL_M_E+(I1-1)*MDLLE)= - 1 ((J3+SOL(3))*MPHD(MPH_SDEC_D)+ - 1 MPHD(MPH_SHD_D))*(360.*3600.) !SET M - A_J(MDLPJ+MDL_ID_J+(I1-1)*MDLLJ)=IDEN !SET ID - IF (MPHI(MPH_CD_I+7).GT.0) THEN !SET BEAM - I4=MDLBEM_M - ELSE - I4=0 - END IF - IF (BUT.EQ.2) THEN !CLEAN - A_B(MDLP+MDL_TP_B+(I1-1)*MDLHDL)=MDLCLN_M+I4 !SET CLEAN - ELSE - A_B(MDLP+MDL_TP_B+(I1-1)*MDLHDL)=I4 !SET TYPE - END IF - IF (BUT.EQ.2) THEN !CLEAN - CALL WNCTXT(F_TP,'Screen= !4$SJ, !4$SJ Ampl= !9$E10.2'// - 1 ' Position= !10$E10.2, !10$E10.2 ID= !5$SW\C', - 1 NINT(RBF(0)),NINT(RBF(1)), - 1 SOL(1),A_E(MDLPE+MDL_L_E+(I1-1)*MDLLE), - 1 A_E(MDLPE+MDL_M_E+(I1-1)*MDLLE),IDEN) - ELSE - CALL WNCTXT(F_TP,'Screen= !4$SJ, !4$SJ Ampl= !9$E10.2'// - 1 ' Position= !10$E10.2, !10$E10.2 ID= !5$SW', - 1 NINT(RBF(0)),NINT(RBF(1)), - 1 SOL(1),A_E(MDLPE+MDL_L_E+(I1-1)*MDLLE), - 1 A_E(MDLPE+MDL_M_E+(I1-1)*MDLLE),IDEN) - END IF - CALL NMOEXF(A_J(MDLPJ+(I1-1)*MDLLJ)) !MAKE CORRECT FORMAT - IDEN=MAX(1000,MOD(IDEN+1,10000)) - GMDHJ(MDH_NSRC_J,LIDX)= - 1 GMDHJ(MDH_NSRC_J,LIDX)+1 !COUNT - GOTO 33 !CONTINUE - 30 CONTINUE - CALL WNCTXT(F_TP,'Screen= !4$SJ, !4$SJ Cannot solve', - 1 NINT(RBF(0)),NINT(RBF(1))) - 33 CONTINUE - IF (GMDHJ(MDH_NSRC_J,LIDX).GE.MAXSRN) THEN - MAXSRN=MAXSRN+100 !DO MORE - IF (.NOT.NMOSLG(2*MAXSRN,GMDH(0,LIDX))) GOTO 900 !MAKE SURE SPACE - END IF - END DO !NEXT SCREEN POINT - IF (.NOT.WNDPAR('GIDS_SOURCES',GS1,LB_B,J0,'NO')) GOTO 40 !ASK MORE - IF (J0.LE.0) GOTO 40 !ASSUME NO - GS4=GS1 - IF (GS4) GOTO 20 !WANT MORE -C -C FINISH MAP -C - 40 CONTINUE - CALL NMORDM(LIDX,-1) !ADD SOURCES TO GENERAL AREA - GOTO 100 !MORE MAPS -C -C - END diff --git a/src/nscan/nmofnd.for b/src/nscan/nmofnd.for deleted file mode 100644 index 25ae250046dae364308000e592d4b3d62c816246..0000000000000000000000000000000000000000 --- a/src/nscan/nmofnd.for +++ /dev/null @@ -1,255 +0,0 @@ -C+ NMOFND.FOR -C WNB 910731 -C -C Revisions: -C WNB 911106 Correct dl, dm -C WNB 921104 Cater for J2000 -C WNB 921217 Add NMOFNA -C WNB 930928 Add instrument -C WNB 931006 Indicate (de-)beam -C WNB 931110 Make ABS work -C WNB 950611 Use WNML for LSQ -C - SUBROUTINE NMOFND -C -C Find sources on map -C -C Result: -C CALL NMOFND Find sources on map (pos. only) -C CALL NMOFNA Find pos/neg sources -C -C -C Include files: -C - INCLUDE 'WNG_DEF' - INCLUDE 'NMO_DEF' - INCLUDE 'LSQ_O_DEF' - INCLUDE 'MPH_O_DEF' !MAP HEADER - INCLUDE 'MDH_O_DEF' !MODEL HEADER - INCLUDE 'MDL_O_DEF' !MODEL LINE -C -C Parameters: -C -C -C Arguments: -C -C -C Function references: -C - LOGICAL WNFRD !READ DATA - LOGICAL WNMLGA !GET LSQ AREA - LOGICAL WNMLTN !SOLVE LSQ - LOGICAL NMOSLI,NMOSLG !GET SOURCE LIST - LOGICAL NMASTG !GET A MAP -C -C Data declarations: -C - LOGICAL AFIND !INDICATE AFIND - INTEGER LSQ !LEAST SQUARES AREA - REAL RS(6) !LSQ COEFFICIENTS - REAL SOL(6),MU,SD !LSQ SOLUTION - INTEGER LIDX !SOURCE LIST ID - INTEGER MDLP,MDLPJ,MDLPE !POINTER TO MODEL - INTEGER MDLLE,MDLLJ !LENGTH MODEL LINE - REAL LINE(0:4095,3) !MAP LINES - INTEGER LINID(3) !BUFFER POINTERS - DATA LINID/1,2,3/ - REAL RM(-1:1,-1:1) !DATA ARRAY - INTEGER SNAM(0:7) !MAP NAME - INTEGER MPHP !MAP HEADER POINTER - BYTE MPH(0:MPHHDL-1) !MAP HEADER - INTEGER*2 MPHI(0:MPHHDL/2-1) - INTEGER MPHJ(0:MPHHDL/4-1) - REAL MPHE(0:MPHHDL/4-1) - DOUBLE PRECISION MPHD(0:MPHHDL/8-1) - EQUIVALENCE (MPH,MPHI,MPHJ,MPHE,MPHD) -C- -C -C NMOFND -C - AFIND=.FALSE. - GOTO 10 -C -C NMOFNA -C - ENTRY NMOFNA -C - AFIND=.TRUE. - GOTO 10 -C -C INIT -C - 10 CONTINUE - IF (.NOT.NMOSLI(1024)) THEN !MAKE SURE THERE IS A LIST - 900 CONTINUE - CALL WNCTXT(F_TP,'Cannot create source list') - CALL WNGEX !STOP - END IF - LIDX=7 !SET SOURCES IN LIST 7 - IF (.NOT.WNMLGA(LSQ,LSQ_T_REAL,6)) THEN !GET LSQ AREA - CALL WNCTXT(F_TP,'ERROR: no work area space available') - CALL WNGEX !STOP - END IF -C -C DO ALL MAPS -C - 100 CONTINUE - IF (.NOT.NMASTG(FCAIN,SETS,MPH,MPHP,SNAM)) THEN !NO MORE MAPS - CALL WNMLFA(LSQ) !FREE LSQ ARAE - CALL WNFCL(FCAIN) !CLOSE MAP FILE - RETURN !READY - END IF - CALL NMOHZD(GMDH(0,LIDX)) !CLEAR HEADER - IF (MPHI(MPH_EPT_I).EQ.1) THEN !1950/2000 COORDINATES - GMDHJ(MDH_TYP_J,LIDX)=2 !EPOCH TYPE - GMDHE(MDH_EPOCH_E,LIDX)=MPHE(MPH_EPO_E) !EPOCH - ELSE - GMDHJ(MDH_TYP_J,LIDX)=1 !EPOCH TYPE - GMDHE(MDH_EPOCH_E,LIDX)=0. !EPOCH - END IF - GMDHJ(MDH_BITS_J,LIDX)=MPHJ(MPH_INST_J) !INSTRUMENT - GMDHD(MDH_RA_D,LIDX)=MPHD(MPH_RA_D) !RA - GMDHD(MDH_DEC_D,LIDX)=MPHD(MPH_DEC_D) !DEC - GMDHD(MDH_FRQ_D,LIDX)=MPHD(MPH_FRQ_D) !FREQ. - IF (.NOT.NMOSLG(2*MAXSRN,GMDH(0,LIDX))) GOTO 900 !MAKE SURE SPACE - MDLP=GMDHJ(MDH_MODP_J,LIDX)-A_OB !MODEL POINTERS - MDLPJ=(GMDHJ(MDH_MODP_J,LIDX)-A_OB)/LB_J - MDLPE=(GMDHJ(MDH_MODP_J,LIDX)-A_OB)/LB_E - MDLLE=MDLHDL/LB_E !LENGTH MODEL ENTRY - MDLLJ=MDLHDL/LB_J -C -C START READ -C - J0=MPHJ(MPH_MDP_J) !DISK POINTER - J1=LB_E*MPHJ(MPH_NRA_J) !LENGTH LINE - IF (.NOT.WNFRD(FCAIN,J1,LINE(0,LINID(2)),J0)) THEN !READ LINE 1 - 910 CONTINUE - CALL WNCTXT(F_TP,'I/O error map reading') - CALL WNGEX !STOP - END IF - J0=J0+J1 !DISK POINTER - IF (.NOT.WNFRD(FCAIN,J1,LINE(0,LINID(3)),J0)) GOTO 910 !READ LINE 2 - J0=J0+J1 !DISK POINTER -C -C DO ALL LINES -C - DO I=-MPHJ(MPH_NDEC_J)/2+1,MPHJ(MPH_NDEC_J)/2-2 - I1=LINID(1) !SHIFT BUFFERS - DO I2=1,2 - LINID(I2)=LINID(I2+1) - END DO - LINID(3)=I1 - IF (.NOT.WNFRD(FCAIN,J1,LINE(0,LINID(3)),J0)) GOTO 910 !READ LINE - J0=J0+J1 !DISK POINTER - IF (I.LT.TAREA(2,1)) GOTO 33 !SKIP LINE - IF (I.GT.TAREA(3,1)) GOTO 40 !READY -C -C DO ALL POINTS -C - DO I1=MAX(-MPHJ(MPH_NRA_J)/2+1,TAREA(0,1)), - 1 MIN(MPHJ(MPH_NRA_J)/2-2,TAREA(1,1)) - J=I1+MPHJ(MPH_NRA_J)/2 !OFFSET - R0=LINE(J,LINID(2)) !POINT - I0=1 !SIGN - IF (AFIND) THEN - IF (R0.LT.0) I0=-1 !SIGN - R0=ABS(R0) !POINT - END IF - IF (R0.LT.ABS(0.8*MAPLIM*MPHE(MPH_MAX_E))) GOTO 30 !FORGET - IF (GMDHJ(MDH_NSRC_J,LIDX).GE.MAXSRN) THEN !MAYBE NOT - IF (R0.LT.ABS(0.8*A_E(MDLPE+MDL_I_E+ - 1 (GMDHJ(MDH_NSRC_J,LIDX)-1)*MDLLE))) - 1 GOTO 30 !FORGET - END IF - DO I2=-1,1 !GET DATA MATRIX - DO I3=-1,1 - RM(I2,I3)=LINE(J+I2,LINID(2+I3)) - IF (RM(I2,I3).EQ.-1E6) GOTO 30 !FORGET - RM(I2,I3)=I0*RM(I2,I3) !MAKE ABS - END DO - END DO - IF (RM(0,0).LE.RM(-1,0) .OR. RM(0,0).LE.RM(1,0) .OR. - 1 RM(0,0).LE.RM(0,-1) .OR. - 1 RM(0,0).LE.RM(0,1)) GOTO 30 !FORGET - CALL WNMLIA(LSQ,LSQ_I_ALL) !ZERO LSQ - DO I2=-1,1 !SET DATA - DO I3=-1,1 - RS(1)=1 !GENERAL ELLIPSOID - RS(2)=I2 - RS(3)=I3 - RS(4)=I2*I2 - RS(5)=I3*I3 - RS(6)=I2*I3 - R1=RM(I2,I3) !DATA - CALL WNMLMN(LSQ,LSQ_C_REAL,RS,1.-.5*(ABS(I3)+ABS(I2))+ - 1 .25*ABS(I2*I3),R1) !MAKE EQUATIONS - END DO - END DO - IF (.NOT.WNMLTN(LSQ)) GOTO 30 !CANNOT SOLVE - CALL WNMLSN(LSQ,SOL,MU,SD) !GET SOLUTION - R1=SOL(6)*SOL(6)-4*SOL(4)*SOL(5) !FIND MAX - IF (R1.EQ.0) GOTO 30 !FORGET - R0=(2*SOL(3)*SOL(4)-SOL(2)*SOL(6))/R1 - R1=(2*SOL(2)*SOL(5)-SOL(3)*SOL(6))/R1 - IF (ABS(R0).GT.1 .OR. ABS(R1).GT.1) GOTO 30 !FORGET - SOL(1)=SOL(1)+SOL(2)*R0+SOL(3)*R1+SOL(4)*R0*R0+ - 1 SOL(5)*R1*R1+SOL(6)*R0*R1 !AMPLITUDE - SOL(2)=R1 !DX - SOL(3)=R0 !DY - IF (AFIND) THEN - R0=ABS(SOL(1)) - SOL(1)=I0*SOL(1) !CORRECT SIGN - ELSE - R0=SOL(1) - END IF - IF (R0.LT.ABS(0.8*MAPLIM*MPHE(MPH_MAX_E))) GOTO 30 !FORGET - DO I2=1,MIN(MAXSRN-1,GMDHJ(MDH_NSRC_J,LIDX)) !SET SRC - IF (R0.GT.ABS(A_E(MDLPE+MDL_I_E+(I2-1)*MDLLE))) THEN !INSERT - DO I3=GMDHJ(MDH_NSRC_J,LIDX),I2,-1 - CALL WNGMV(MDLHDL, - 1 A_E(MDLPE+(I3-1)*MDLLE), - 1 A_E(MDLPE+(I3)*MDLLE)) !MOVE SOURCE - END DO - 32 CALL WNGMVZ(MDLHDL,A_E(MDLPE+(I2-1)*MDLLE)) !CLEAR SOURCE - A_E(MDLPE+MDL_I_E+(I2-1)*MDLLE)=SOL(1) !FILL SOURCE AMPL - A_E(MDLPE+MDL_L_E+(I2-1)*MDLLE)= - 1 ((I1+SOL(2))*MPHD(MPH_SRA_D)+ - 1 MPHD(MPH_SHR_D))*(360.*3600.) !SET L - A_E(MDLPE+MDL_M_E+(I2-1)*MDLLE)= - 1 ((I+SOL(3))*MPHD(MPH_SDEC_D)+ - 1 MPHD(MPH_SHD_D))*(360.*3600.) !SET M - A_J(MDLPJ+MDL_ID_J+(I2-1)*MDLLJ)=IDEN !SET ID - IF (MPHI(MPH_CD_I+7).GT.0) THEN !SET BEAM - I4=MDLBEM_M - ELSE - I4=0 - END IF - A_B(MDLP+MDL_TP_B+(I2-1)*MDLHDL)=I4 !SET (DE-)BEAM - CALL NMOEXF(A_J(MDLPJ+(I2-1)*MDLLJ)) !MAKE CORRECT FORMAT - IDEN=MAX(1000,MOD(IDEN+1,10000)) - GMDHJ(MDH_NSRC_J,LIDX)= - 1 MIN(MAXSRN,GMDHJ(MDH_NSRC_J,LIDX)+1) !COUNT - GOTO 31 - END IF - END DO - I2=MIN(MAXSRN,GMDHJ(MDH_NSRC_J,LIDX)+1) !FILL SOURCE - GOTO 32 - 31 CONTINUE - DO I2=-1,1 !SET POINTS DONE - DO I3=-1,1 - LINE(J+I2,LINID(2+I3))=-1E6 - END DO - END DO - 30 CONTINUE - END DO !NEXT POINT - 33 CONTINUE - END DO !NEXT LINE -C -C FINISH MAP -C - 40 CONTINUE - CALL NMORDM(LIDX,-1) !ADD SOURCES TO GENERAL AREA - GOTO 100 !MORE MAPS -C -C - END diff --git a/src/nscan/nmogsh.for b/src/nscan/nmogsh.for deleted file mode 100644 index a80b36da32a82880a1ee4837b426063e058db49b..0000000000000000000000000000000000000000 --- a/src/nscan/nmogsh.for +++ /dev/null @@ -1,45 +0,0 @@ -C+ NMOGSH.FOR -C WNB 910623 -C -C Revisions: -C - SUBROUTINE NMOGSH(ODESJ) -C -C Get general header data -C -C Result: -C -C CALL NMOGSH( ODESJ_J(0:*):O) -C will copy general header to ODESJ -C -C Include files: -C - INCLUDE 'WNG_DEF' - INCLUDE 'NMO_DEF' - INCLUDE 'MDH_O_DEF' !MODEL HEADER -C -C Entries: -C -C -C Parameters: -C -C -C Arguments: -C - INTEGER ODESJ(0:*) !OUTPUT HEADER -C -C Function references: -C -C -C Data declarations: -C -C- -C -C COPY HEADER -C - CALL WNGMV(MDHHDL,GDESJ,ODESJ) -C - RETURN -C -C - END diff --git a/src/nscan/nmohed.for b/src/nscan/nmohed.for deleted file mode 100644 index b12654f8ac79f0009d39d2815f8db8c0ea7d003d..0000000000000000000000000000000000000000 --- a/src/nscan/nmohed.for +++ /dev/null @@ -1,96 +0,0 @@ -C+ NMOHED.FOR -C WNB 900827 -C -C Revisions: -C WNB 910809 Add HMT, HMF -C JPH 940224 Typo in comment -C -C - SUBROUTINE NMOHCD(IDESJ) -C -C Act on model header data -C -C Result: -C -C CALL NMOHCD( IDESJ_J(0:*):IO) -C will clear data part of header -C CALL NMOHZD( IDESJ_J(0:*):IO) -C will clear data part of header and # of sources -C CALL NMOHMD( IDESJ_J(0:*):I, ODESJ_J(0:*):O) -C will move data part from I to O -C CALL NMOHMF( IDX_J:I, ODESJ_J(0:*):O) -C will move header from general header IDX to ODESJ -C CALL NMOHMT( IDESJ_J(0:*):I, ODX_J:O) -C will move header from IDESJ to general header ODX -C -C PIN references -C -C -C Include files: -C - INCLUDE 'WNG_DEF' - INCLUDE 'MDH_O_DEF' !MODEL HEADER - INCLUDE 'NMO_DEF' -C -C Entries: -C -C -C Parameters: -C -C -C Arguments: -C - INTEGER IDESJ(0:*) !INPUT HEADER - INTEGER ODESJ(0:*) !OUTPUT HEADER - INTEGER IDX !INPUT GENERAL HEADER - INTEGER ODX !OUTPUT GENERAL HEADER -C -C Function references: -C -C -C Data declarations: -C -C- -C -C CLEAR DATA -C - CALL WNGMVZ(MDHHDL-MDH_TYP_1,IDESJ(MDH_TYP_J)) -C - RETURN -C -C ZERO DATA -C - ENTRY NMOHZD(IDESJ) -C - CALL WNGMVZ(MDHHDL-MDH_TYP_1,IDESJ(MDH_TYP_J)) - IDESJ(MDH_NSRC_J)=0 !NO SOURCES -C - RETURN -C -C MOVE DATA -C - ENTRY NMOHMD(IDESJ,ODESJ) -C - CALL WNGMV(MDHHDL-MDH_TYP_1,IDESJ(MDH_TYP_J), - 1 ODESJ(MDH_TYP_J)) -C - RETURN -C -C MOVE FROM GENERAL -C - ENTRY NMOHMF(IDX,ODESJ) -C - CALL WNGMV(MDHHDL,GMDH(0,IDX),ODESJ) -C - RETURN -C -C MOVE TO GENERAL -C - ENTRY NMOHMT(IDESJ,ODX) -C - CALL WNGMV(MDHHDL,IDESJ,GMDH(0,ODX)) -C - RETURN -C -C - END diff --git a/src/nscan/nmoini.for b/src/nscan/nmoini.for deleted file mode 100644 index ef48333f383f03acba555dbb5c8ad1c298158601..0000000000000000000000000000000000000000 --- a/src/nscan/nmoini.for +++ /dev/null @@ -1,57 +0,0 @@ -c+ NMOINI.FOR -C WNB 900327 -C -C Revisions: -C - SUBROUTINE NMOINI -C -C Initialize NMODEL program -C -C Result: -C -C CALL NMOINI will set header lines, logging, DWARF interface -C -C Include files: -C - INCLUDE 'WNG_DEF' -C -C Parameters: -C -C -C Arguments: -C -C -C Function references: -C - LOGICAL WNDINI !INIT DWARF - LOGICAL WNDDAB !OPEN DATABASE - LOGICAL NMOSLI !GET SOURCE LIST -C -C Data declarations: -C -C- -C -C SET HEADER LINES -C - CALL WNCFHD(F_P,1,'!40C\Program to handle Model (MDL) files') -C -C START DWARF -C - IF (.NOT.WNDINI(PRGNAM)) CALL WNGEX !EXIT IF NO DWARF START -C -C LOGGING -C - CALL WNDLOG(LOGCD) !PROPER LOGGING -C -C DATABASE -C - IF (.NOT.WNDDAB()) CALL WNGEX !OPEN DATABASE -C -C SOURCE LIST -C - IF (.NOT.NMOSLI(1024)) CALL WNGEX !GET SOURCE LIST -C - RETURN !READY -C -C - END diff --git a/src/nscan/nmomsc.for b/src/nscan/nmomsc.for deleted file mode 100644 index eb7b09989d289f957406c23d900879bc22aa70f8..0000000000000000000000000000000000000000 --- a/src/nscan/nmomsc.for +++ /dev/null @@ -1,298 +0,0 @@ -C+ NMOMSC.FOR -C WNB 900903 -C -C Revisions: -C WNB 910403 Add NMOMSL -C WNB 910903 Add safety for interrupts -C WNB 910923 Correct typo in safety -C WNB 920116 No conversion from scan model to input model type -C HjV 930311 Change some text -C WNB 930606 Use LB_ iso L_ -C WNB 930628 Line too long -C WNB 930819 Always 4 Stokes written -C WNB 931005 Remove call to CV1; text -C WNB 931008 Add MINST -C - LOGICAL FUNCTION NMOMSC(FCA,SETSX) -C -C Calculate model for scan files -C -C Result: -C -C NMOMSC_L = NMOMSC( FCA_J:I, SETSX_J(0:7,0:*):IO) -C Calculate and save the model data in the -C FCA scan file at all SETS SETSX for model -C type TP1=0. -C The routine assumes that NMOMUI has set -C the correct data action type, and a -C model (even if empty) is in GDES, after -C a call to NMODAX. -C NMOMSL_L = NMOMSC( FCA_J:I, SETSX_J(0:7,0:*):IO, OFFSET_J(0:7):I) -C As NMOMSC, but OFFSET specifies set offsets -C to use. -C -C Include files: -C - INCLUDE 'WNG_DEF' - INCLUDE 'NMO_DEF' - INCLUDE 'MDH_O_DEF' !MODEL HEADER - INCLUDE 'MDL_O_DEF' !MODEL LINE - INCLUDE 'STH_O_DEF' !SET HEADER - INCLUDE 'SCH_O_DEF' !SCAN HEADER -C -C Parameters: -C -C -C Entry points: -C - LOGICAL NMOMSL -C -C Arguments: -C - INTEGER FCA !FILE DESCRIPTOR - INTEGER SETSX(0:*) !SETS TO DO - INTEGER OFFSET(0:7) !SET OFFSETS -C -C Function references: -C - LOGICAL WNFWR !WRITE FILE - LOGICAL WNFRD !READ FILE - INTEGER WNFEOF !EOF FILE - CHARACTER*32 WNTTSG !SET NAME - LOGICAL NSCSTL !GET A SET - LOGICAL NMORDX !READ SOURCE FROM SCAN - LOGICAL NMORDM !MERGE SOURCES - LOGICAL NMORDD !DIFFER SOURCE LISTS - LOGICAL NMORDC !COPY SOURCE LISTS - LOGICAL NMOWRX !WRITE SOURCE MODEL - LOGICAL NMOMUP !SPLIT DATA INTO TYPES -C -C Data declarations: -C - INTEGER IMODP !INPUT MODEL POINTER - INTEGER OMODP,XMODP !OUTPUT MODEL POINTER - INTEGER XMDD !OUTPUT MODEL DATA POINTER - INTEGER STHP !POINTER TO SET HEADER - INTEGER SNAM(0:7) !SET NAME - INTEGER NPOL !# OF POLARISATIONS - INTEGER LOCACT !ACTION - INTEGER PE1,PE2,PE3 !POINTERS - REAL UV0(0:3) !U,V DATA - REAL TF(0:1) !BAND/TIME SMEARING - INTEGER MINST !INSTRUMENT - DOUBLE PRECISION FRQ0 !BASIC FREQUENCY - REAL LM0(0:1) !L,M OFFSET - INTEGER*2 IFR(0:STHIFR-1) !IFR LIST - COMPLEX CMOD(0:3,0:STHIFR-1) !MODEL - INTEGER CHSET(0:7) !SET OFFSETS - BYTE STH(0:STH__L-1) !SET HEADER - INTEGER*2 STHI(0:STH__L/LB_I-1) - INTEGER STHJ(0:STH__L/LB_J-1) - REAL STHE(0:STH__L/LB_E-1) - DOUBLE PRECISION STHD(0:STH__L/LB_D-1) - EQUIVALENCE (STH,STHI,STHJ,STHE,STHD) - BYTE SCH(0:SCH__L-1) !SCAN HEADER - INTEGER SCHJ(0:SCH__L/LB_J-1) - REAL SCHE(0:SCH__L/LB_E-1) - EQUIVALENCE (SCH,SCHJ,SCHE) -C- -C -C INIT -C - NMOMSC=.TRUE. !ASSUME OK - DO I=0,7 !ZERO OFFSETS - CHSET(I)=0 - END DO - GOTO 20 -C -C NMOMSL -C - ENTRY NMOMSL(FCA,SETSX,OFFSET) -C -C INIT -C - NMOMSL=.TRUE. !ASSUME OK - DO I=0,7 !SET OFFSETS - CHSET(I)=OFFSET(I) - END DO - GOTO 20 -C -C GENERAL INIT -C - 20 CONTINUE - SNAM(0)=0 !INIT. SET NAME - DO I=1,7 - SNAM(I)=-1 - END DO - IF (.NOT.NMOMUP()) THEN - 10 CONTINUE - CALL WNCTXT(F_TP,'!/Error reading model from set !AS', - 1 WNTTSG(SNAM,0)) - MODACT=IAND(MODACT,NOT(NMO_USAGE)) !CANNOT SPLIT TYPES - NMOMSC=.FALSE. !ERROR -C - RETURN - END IF - IMODP=-1 !START INPUT MODEL - OMODP=0 !START OUTPUT MODEL - LOCACT=MODACT !ACTION -C -C CHECK IF TO SAVE -C - IF (IAND(MODACT,NMO_SAV).EQ.0) THEN !NO SAVE WANTED - CALL NMOHZD(GMDH(0,6)) !MAKE SURE TYPE KNOWN - CALL NMOHMD(GMDH(0,0),GMDH(0,6)) - RETURN - END IF -C -C CHECK IF NO USE -C - IF (IAND(MODACT,NMO_USE).EQ.0) THEN !NO USE - IF (.NOT.NMORDC(0,6)) GOTO 10 !SET NEW - END IF -C -C DO ALL SETS -C - DO WHILE (NSCSTL(FCA,SETSX,STH,STHP,SNAM,CHSET)) !DO ALL SETS - NPOL=STHI(STH_PLN_I) !# OF POLARISATIONS - IF (IAND(MODACT,NMO_USE).NE.0) THEN !USE OLD DATA -C -C READ MODEL -C - IF (IMODP.NE.STHJ(STH_MDL_J)) THEN !NEED NEW MODEL - LOCACT=MODACT !SET ACTION - IF (.NOT.NMORDX(FCA,STHJ(STH_MDL_J),7)) GOTO 10 !READ SCAN MODEL - CALL NMOSRT(1,GMDH(0,7)) !SORT L,M - IMODP=STHJ(STH_MDL_J) !NEW POINTER - OMODP=0 !NEW OUT MODEL -C -C CHECK TYPE -C - J=GMDHJ(MDH_ACT_J,7) !PRESERVE ACTION - IF (GMDHJ(MDH_TYP_J,0).NE.GMDHJ(MDH_TYP_J,7)) THEN !CONVERT - IF (GMDHJ(MDH_TYP_J,0).EQ.0) THEN !COPY TYPE - CALL NMOHMD(GMDH(0,7),GMDH(0,0)) - ELSE IF (GMDHJ(MDH_TYP_J,7).EQ.0) THEN - CALL NMOHMD(GMDH(0,0),GMDH(0,7)) - END IF !DO NOT CONVERT TYPE - END IF - GMDHJ(MDH_ACT_J,7)=J !RESTORE ACTION - CALL NMOHZD(GMDH(0,6)) !NO SOURCES YET - CALL NMOHMD(GMDH(0,0),GMDH(0,6)) !SET TYPE - IF (GMDHJ(MDH_TYP_J,0).NE.GMDHJ(MDH_TYP_J,7) .OR. - 1 IAND(NMO_SMEAR,GMDHJ(MDH_ACT_J,7)).NE. - 1 IAND(NMO_SMEAR,MODACT)) THEN !DIFF. SMEARING - LOCACT=IAND(NOT(NMO_USE+NMO_ADD),LOCACT) !SET NO USE, NEW - IF (.NOT.NMORDC(0,6)) GOTO 10 !COPY NEW - IF (IAND(MODACT,NMO_ADD).NE.0) THEN !ADD OPTION - IF (.NOT.NMORDM(7,6)) GOTO 10 !MAKE NEW - END IF - CALL NMOAM1(6) !MERGE SOURCE PARAM. - CALL NMOSRT(1,GMDH(0,6)) !SORT LIST - END IF - IF (IAND(LOCACT,NMO_USE).NE.0) THEN !STILL USE -C -C ADD OPTION -C - IF (IAND(MODACT,NMO_ADD).NE.0) THEN !ADD OPTION - IF (.NOT.NMORDC(0,6)) GOTO 10 !SET NEW SOURCES - IF (.NOT.NMORDM(7,6)) GOTO 10 !ADD OLD - CALL NMOAM1(6) !MERGE PARAMETERS - CALL NMOSRT(1,GMDH(0,6)) !AND SORT -C -C MERGE OPTION -C - ELSE !MERGE OPTION - IF (GMDHJ(MDH_NSRC_J,7).LE.0) THEN !NO OLD DATA - IF (.NOT.NMORDC(0,6)) GOTO 10 !ALL NEW - ELSE - IF (.NOT.NMORDD(7,0,6)) GOTO 10 !SPLIT DATA - END IF - IF (GMDHJ(MDH_NSRC_J,6).GE. - 1 GMDHJ(MDH_NSRC_J,0)) THEN !BETTER TO DO ALL NEW - LOCACT=IAND(NOT(NMO_USE+NMO_MER+NMO_ADD),LOCACT) !SET NO USE - IF (.NOT.NMORDC(0,6)) GOTO 10 !SET ALL NEW - END IF - END IF !END ADD/MERGE - END IF !END STILL USE - END IF !END NEW MODEL - END IF !END USE OLD -C -C SAVE MODEL -C - IF (OMODP.EQ.0) THEN !NEW MODEL - IF (IAND(LOCACT,NMO_USE+NMO_MER).EQ.NMO_USE+NMO_MER) THEN !MERGE - IF (GMDHJ(MDH_NSRC_J,6).GT.0) THEN !NEW MODEL - XMODP=WNFEOF(FCA) !WHERE TO WRITE - IF (.NOT.NMOWRX(FCA,GMDH(0,0),XMODP)) GOTO 101 !WRITE - ELSE - XMODP=STHJ(STH_MDL_J) !LEAVE OLD - END IF - ELSE - XMODP=WNFEOF(FCA) !WHERE TO WRITE - IF (.NOT.NMOWRX(FCA,GMDH(0,6),XMODP)) GOTO 101 !WRITE - END IF - OMODP=XMODP !SET WRITTEN - END IF -C -C SAVE DATA -C - STHJ(STH_MDL_J)=0 !ASSUME ERROR - IF (.NOT.WNFWR(FCA,STH__L,STH,STHP)) GOTO 101 !REWRITE SET HEADER - IF (.NOT.WNFRD(FCA,LB_I*STHJ(STH_NIFR_J),IFR, - 1 STHJ(STH_IFRP_J))) GOTO 10 !READ IFRS - IF (STHJ(STH_MDD_J).EQ.0) THEN !NO DATA WRITTEN YET - XMDD=WNFEOF(FCA) !WHERE TO WRITE - LOCACT=IAND(LOCACT,NOT(NMO_USE)) !CANNOT USE - ELSE - XMDD=STHJ(STH_MDD_J) !OLD POINTER - END IF - CALL NMOMST(GMDHJ(MDH_TYP_J,6),GMDHD(MDH_RA_D,6), - 1 GMDHD(MDH_DEC_D,6),STH,LM0,FRQ0, - 1 TF,MINST) !GET SOME DATA - J0=XMDD !WRITE POINTER - J1=STHJ(STH_SCNP_J) !READ POINTER - DO I=0,STHJ(STH_SCN_J)-1 !ALL SCANS - IF (.NOT.WNFRD(FCA,SCH__L,SCH,J1)) GOTO 10 !READ SCAN HEADER - J1=J1+STHJ(STH_SCNL_J) !NEXT READ - CALL NMOMUV(GMDHJ(MDH_TYP_J,6),GMDHD(MDH_RA_D,6), - 1 GMDHD(MDH_DEC_D,6),STH,SCH,UV0) !GET DATA - IF (IAND(LOCACT,NMO_USE).NE.0) THEN !USE SCAN DATA - IF (.NOT.WNFRD(FCA,4*STHJ(STH_NIFR_J)*LB_X, - 1 CMOD,J0)) GOTO 10 !READ SCAN MODEL DATA - IF (IAND(LOCACT,NMO_ADD).NE.0) THEN !ADD - CALL NMOMUA(0,UV0,LM0,FRQ0,STHE(STH_RTP_E), - 1 NPOL,STHJ(STH_NIFR_J),IFR,TF,MINST,CMOD) - ELSE !MERGE - CALL NMOMUA(6,UV0,LM0,FRQ0,STHE(STH_RTP_E), - 1 NPOL,STHJ(STH_NIFR_J),IFR,TF,MINST,CMOD) - END IF - ELSE !NO USE SCAN DATA - CALL NMOMUC(6,UV0,LM0,FRQ0,STHE(STH_RTP_E), - 1 NPOL,STHJ(STH_NIFR_J),IFR,TF,MINST,CMOD) - END IF - IF (.NOT.WNFWR(FCA,4*STHJ(STH_NIFR_J)*LB_X, - 1 CMOD,J0)) GOTO 101 !WRITE SCAN MODEL DATA - J0=J0+4*STHJ(STH_NIFR_J)*LB_X - END DO !NEXT SCAN -C -C NEXT SET -C - 100 CONTINUE - STHJ(STH_MDL_J)=OMODP !EVERYTHING OK - STHJ(STH_MDD_J)=XMDD - IF (.NOT.WNFWR(FCA,STH__L,STH,STHP)) THEN !REWRITE SET HEADER - 101 CONTINUE - CALL WNCTXT(F_TP,'!/Error writing source data '// - 1 'to Sector header !AS', - 1 WNTTSG(SNAM,0)) - NMOMSC=.FALSE. -C - RETURN - END IF - END DO !END SETS -C - RETURN -C -C - END diff --git a/src/nscan/nmomsg.for b/src/nscan/nmomsg.for deleted file mode 100644 index 2a818bf2da8a780eaffb50b59537d77516462774..0000000000000000000000000000000000000000 --- a/src/nscan/nmomsg.for +++ /dev/null @@ -1,69 +0,0 @@ -C+ NMOMSG.FOR -C WNB 900903 -C -C Revisions: -C - SUBROUTINE NMOMSG(SETSX) -C -C Get model from scan file -C -C Result: -C -C CALL NMOMSG( SETSX_J(0:*):I) will get a model from scan file -C -C PIN references -C -C -C Include files: -C - INCLUDE 'WNG_DEF' - INCLUDE 'NMO_DEF' - INCLUDE 'MDH_O_DEF' !MODEL HEADER - INCLUDE 'MDL_O_DEF' !SOURCE LINE - INCLUDE 'STH_O_DEF' !SET HEADER -C -C Entries: -C -C -C Parameters: -C -C -C Arguments: -C - INTEGER SETSX(0:*) !SETS TO DO -C -C Function references: -C - LOGICAL NMORDX !READ MODEL - LOGICAL NMORDM !AND SET IN GENERAL - LOGICAL NSCSTG !GET A SET -C -C Data declarations: -C - INTEGER STHP !SET HEADER POINTER - INTEGER SNAM(0:7) !SET NAME - BYTE STH(0:STHHDL-1) !SET HEADER - INTEGER STHJ(0:STHHDL/4-1) - EQUIVALENCE (STH,STHJ) -C- -C -C FIND A SET -C - DO WHILE (NSCSTG(FCAIN,SETSX,STH,STHP,SNAM)) - IF (STHJ(STH_MDL_J).NE.0) THEN !THIS ONE - IF (NMORDX(FCAIN,STHJ(STH_MDL_J),7)) THEN !FOUND - IF (NMORDM(7,-1)) GOTO 800 !READY - END IF - END IF - END DO - CALL WNCTXT(F_TP,'!/No model found') -C -C READY -C - 800 CONTINUE - CALL WNFCL(FCAIN) !CLOSE FILE -C - RETURN -C -C - END diff --git a/src/nscan/nmomss.for b/src/nscan/nmomss.for deleted file mode 100644 index 6ce434678825365b0f351d4f0f8bed9465f53597..0000000000000000000000000000000000000000 --- a/src/nscan/nmomss.for +++ /dev/null @@ -1,50 +0,0 @@ -C+ NMOMSS.FOR -C WNB 900903 -C -C Revisions: -C - SUBROUTINE NMOMSS(SETSX) -C -C Save model data in scan file -C -C Result: -C -C CALL NMOMSS( SETSX_J(0:*):I) saves model data in scan file -C -C PIN references -C -C -C Include files: -C - INCLUDE 'WNG_DEF' - INCLUDE 'NMO_DEF' - INCLUDE 'MDH_O_DEF' !MODEL HEADER - INCLUDE 'MDL_O_DEF' !SOURCE LINE - INCLUDE 'STH_O_DEF' !SET HEADER -C -C Entries: -C -C -C Parameters: -C -C -C Arguments: -C - INTEGER SETSX(0:*) !SETS TO DO -C -C Function references: -C -C -C Data declarations: -C -C- -C -C READY -C - 800 CONTINUE - CALL WNFCL(FCAOUT) !CLOSE FILE -C - RETURN -C -C - END diff --git a/src/nscan/nmomst.for b/src/nscan/nmomst.for deleted file mode 100644 index 1d4674304ac284dbf14f15aee14e8455b9dd57c5..0000000000000000000000000000000000000000 --- a/src/nscan/nmomst.for +++ /dev/null @@ -1,76 +0,0 @@ -C+ NMOMST.FOR -C WNB 900903 -C -C Revisions: -C WNB 931008 Add MINST -C CMV 940111 Use A_OB in stead of A_OJ -C - SUBROUTINE NMOMST(BTP,RA,DEC,STHD,LM0,FRQ0,TF,MINST) -C -C Calculate set dependent data for model calculation -C -C Result: -C -C CALL NMOMST( BTP_J:I, RA_D:I, DEC_D:I, STHD_D(0:*):I, -C LM0_E(0:1):O, FRQ0_D:O, TF_E(0:1):O, MINST_J:O) -C Calculate for BTP (0=unknown, 1=apparent, -C 2=B1950) the LM0 l,m offset, FRQ0 the -C frequency to use, TF the smearing parameters, -C using the set header STHD and the RA, DEC -C of map; MINST the instrument -C -C PIN references -C -C -C Include files: -C - INCLUDE 'WNG_DEF' - INCLUDE 'STH_O_DEF' !SET HEADER -C -C Parameters: -C -C -C Arguments: -C - INTEGER BTP !COORD. TYPE - DOUBLE PRECISION RA !RA TO USE - DOUBLE PRECISION DEC !DEC TO USE - DOUBLE PRECISION STHD(0:*) !SET HEADER - REAL LM0(0:1) !L,M OFFSET - DOUBLE PRECISION FRQ0 !FREQUENCY - REAL TF(0:1) !SMEARING PARAM. - INTEGER MINST !INSTRUMENT -C -C Function references: -C - INTEGER WNGARA !ADDRESS -C -C Data declarations: -C -C- - IF (BTP.EQ.2) THEN !B1950 - FRQ0=STHD(STH_FRQE_D) !CORRECT FREQUENCY - CALL WNMCRD(RA,DEC, - 1 LM0(0),LM0(1), - 1 STHD(STH_RAE_D),STHD(STH_DECE_D)) !CORRECT L,M - ELSE - FRQ0=STHD(STH_FRQ_D) !CORRECT FREQUENCY - IF (BTP.EQ.1) THEN !APPARENT - CALL WNMCRD(RA,DEC, - 1 LM0(0),LM0(1), - 1 STHD(STH_RA_D),STHD(STH_DEC_D)) !CORRECT L,M - ELSE - LM0(0)=0 !NO OFFSET - LM0(1)=0 - END IF - END IF - J=(WNGARA(STHD(0))-A_OB)/LB_E !OFFSET - TF(0)=A_E(J+STH_HAV_E) !TIME SMEAR - TF(1)=A_E(J+STH_BAND_E) !BAND SMEAR - J=(WNGARA(STHD(0))-A_OB)/LB_J !OFFSET - MINST=A_J(J+STH_INST_J) !INSTRUMENT -C - RETURN -C -C - END diff --git a/src/nscan/nmomu4.for b/src/nscan/nmomu4.for deleted file mode 100644 index e4ff4154e503fc405773c681aff74b2ef51c82bb..0000000000000000000000000000000000000000 --- a/src/nscan/nmomu4.for +++ /dev/null @@ -1,112 +0,0 @@ -C+ NMOMU4.FOR -C WNB 900903 -C -C Revisions: -C WNB 910319 Add NMOMU4 -C WNB 930819 Remove NMOMUM, rename to NMOMU4, remove L_ -C WNB 931006 Text -C WNB 931008 Add MINST -C - SUBROUTINE NMOMU4(STP,FCA,SCN,STHJ,UV0,LM0,FRQ0,RTP,NPOL, - 1 NIFR,IFR,TF,MINST,CMOD) -C -C Calculate model fringes -C -C Result: -C -C CALL NMOMU4( STP_J:I, FCA_J:I, SCN_J:I, STHJ_J(0:*):I, -C UV0_E(0:3):I, LM0_E(0:1):I, FRQ0_D:I, -C RTP_E(0:*), NPOL_J:I, NIFR_J:I, IFR_I(0:*):I, -C TF_E(0:1):I, MINST_J:I, CMOD_X(0:3,0:*):O) -C Calculate model fringes in CMOD for all -C specified NIFR's as detailed in interferometer -C list IFR for a model with type STP for scan -C number SCN with set header STHJ. Always 4 -C polarisations produced. -C RTP are the telescope positions (m), -C LM0 the l,m offsets (rad), -C FRQ0 the the frequency of the model (MHz), -C TF the integration time (fractions) and -C the bandwidth (MHz), MINST instrument -C and UV0 the UV coordinates for a baseline -C of 1 m (resp. cos(t), -sin(t).sin(dec), -C cos(t).sin(dec), -sin(t)) in wavelengths*2*pi. -C -C Include files: -C - INCLUDE 'WNG_DEF' - INCLUDE 'NMO_DEF' - INCLUDE 'STH_O_DEF' !SET HEADER -C -C Parameters: -C -C -C Arguments: -C - INTEGER STP !SOURCE TYPE - INTEGER FCA !SCAN FILE POINTER - INTEGER SCN !# OF SCAN - INTEGER STHJ(0:*) !SET HEADER - REAL UV0(0:3) !UV COORDINATES - REAL LM0(0:1) !LM OFFSETS - DOUBLE PRECISION FRQ0 !FREQUENCY - REAL RTP(0:*) !TEL. POSITIONS - INTEGER NPOL !# POL. - INTEGER NIFR !# OF INTERFEROMETERS - INTEGER*2 IFR(0:*) !INTERFEROMETERS - REAL TF(0:1) !INTEGR. TIME, BANDWIDTH - INTEGER MINST !INSTRUMENT - COMPLEX CMOD(0:3,0:*) !CALCULATED MODEL (I,Q,U,V) -C -C Function references: -C - LOGICAL WNFRD !READ FILE -C -C Data declarations: -C -C- -C -C MUST CALCULATE -C - IF (STP.EQ.1) THEN - CALL NMOMUC(1,UV0,LM0,FRQ0,RTP,NPOL,NIFR,IFR, - 1 TF,MINST,CMOD) !CALCULATE - ELSE IF (STP.GT.1 .OR. STP.LT.0) THEN - CALL NMOMUC(1,UV0,LM0,FRQ0,RTP,NPOL,NIFR,IFR, - 1 TF,MINST,CMOD) !CALCULATE - ELSE IF(IAND(MODACT,NMO_SAV).NE.0) THEN !ALL SAVED - IF (STHJ(STH_MDD_J).NE.0) THEN - IF (.NOT.WNFRD(FCA,4*LB_X*NIFR,CMOD, - 1 STHJ(STH_MDD_J)+SCN*4*LB_X*NIFR)) THEN !READ - 10 CONTINUE - CALL WNCTXT(F_TP,'!/Error reading model data!/') - CALL WNGEX !ERROR OUT - END IF - ELSE - GOTO 10 !ERROR - END IF - ELSE IF(IAND(MODACT,NMO_USE).NE.0) THEN !USE SOME - IF (STHJ(STH_MDD_J).NE.0) THEN - IF (.NOT.WNFRD(FCA,4*LB_X*NIFR,CMOD, - 1 STHJ(STH_MDD_J)+SCN*4*LB_X*NIFR)) THEN !READ - GOTO 10 - END IF - ELSE - CALL WNGMVZ(4*LB_X*NIFR,CMOD) !CLEAR MODEL - END IF - IF (IAND(MODACT,NMO_MER).NE.0) THEN !MERGE - CALL NMOMUA(6,UV0,LM0,FRQ0,RTP,NPOL,NIFR,IFR, - 1 TF,MINST,CMOD) !REST - ELSE !ADD - CALL NMOMUA(0,UV0,LM0,FRQ0,RTP,NPOL,NIFR,IFR, - 1 TF,MINST,CMOD) !REST - END IF - ELSE !NO USE - CALL NMOMUC(0,UV0,LM0,FRQ0,RTP,NPOL,NIFR,IFR, - 1 TF,MINST,CMOD) !CALCULATE ALL - END IF -C - RETURN -C -C - END diff --git a/src/nscan/nmomuc.for b/src/nscan/nmomuc.for deleted file mode 100644 index 975f8f883887eb3513a3c97fb944423899e71c1d..0000000000000000000000000000000000000000 --- a/src/nscan/nmomuc.for +++ /dev/null @@ -1,275 +0,0 @@ -C+ NMOMUC.FOR -C WNB 900903 -C -C Revisions: -C WNB 910802 Add MU1 -C WNB 911007 Add instrumental polarisation -C WNB 920626 Change sign of Rot. measure -C WNB 930127 Change sign spectral index -C WNB 930819 Always calculate 4 polarisations; remove L_ -C WNB 931006 Text -C WNB 931008 Add BEAMing -C WNB 931019 Change where I beamed -C - SUBROUTINE NMOMUC(IDX,UV0,LM0,FRQ0,RTP,NPOL,NIFR,IFR,TF, - 1 MINST,CMOD) -C -C Calculate model -C -C Result: -C -C CALL NMOMUC( IDX_J:I, UV0_E(0:3):I, LM0_E(0:1):I, FRQ0_D:I, -C RTP_E(0:*), NPOL_J:I, NIFR_J:I, IFR_I(0:*):I, -C TF_E(0:1):I, MINST_J:I, CMOD_X(0:3,0:*):O) -C Calculate model fringes in CMOD for all -C specified NIFR's as detailed in interferometer -C list IFR for a model in the GMDH list with -C index IDX, and 4 polarisations. -C RTP are the telescope positions (m), -C LM0 the l,m offsets (rad), -C FRQ0 the the frequency of the model (MHz), -C TF the integration time (fractions) and -C the bandwidth (MHz). -C and UV0 the UV coordinates for a baseline -C of 1 m (resp. cos(t), -sin(t).sin(dec), -C cos(t).sin(dec), -sin(t)) in wavelengths*2*pi. -C MINST the instrument -C CALL NMOMUA( ...) -C Add model to CMOD -C CALL NMOMU1( ..., NMDL_J:I) -C Calculate for source number NMDL only -C -C Include files: -C - INCLUDE 'WNG_DEF' - INCLUDE 'NMO_DEF' - INCLUDE 'MDH_O_DEF' !MODEL HEADER - INCLUDE 'MDL_O_DEF' !MODEL LINE - INCLUDE 'STH_O_DEF' !SET HEADER -C -C Parameters: -C -C -C Arguments: -C - INTEGER IDX !MODEL LIST INDEX - REAL UV0(0:3) !UV COORDINATES - REAL LM0(0:1) !LM OFFSETS - DOUBLE PRECISION FRQ0 !FREQUENCY - REAL RTP(0:*) !TEL. POSITIONS - INTEGER NPOL !# OF POL. (NOT USED ANYMORE) - INTEGER NIFR !# OF INTERFEROMETERS - INTEGER*2 IFR(0:*) !INTERFEROMETERS - REAL TF(0:1) !INTEGR. TIME, BANDWIDTH - INTEGER MINST !INSTRUMENT - COMPLEX CMOD(0:3,0:*) !CALCULATED MODEL (I,Q,U,V) - INTEGER NMDL !SOURCE TO CALCULATE -C -C Function references: -C - LOGICAL NMOBMF !GET BEAM RANGE - DOUBLE PRECISION NMOBMV !GET BEAM VALUE -C -C Data declarations: -C - INTEGER SRC1,SRC2 !SOURCES TO DO - INTEGER IFL(0:STHIFR-1),IFH(0:STHIFR-1) !LOW/HIGH TEL. - INTEGER PB,PJ,PE !ARRAY POINTERS SOURCE - INTEGER TBIT,TCC !MODEL TYPES - REAL SRCAM !AMPLITUDE - REAL RL1(0:STHTEL-1),RL2(0:STHTEL-1), !SAVE TEL. DATA - 1 RL3(0:STHTEL-1),RL4(0:STHTEL-1),RL5(0:STHTEL-1), - 1 RL6(0:STHTEL-1),RL7(0:STHTEL-1),RL8(0:STHTEL-1) - REAL RP1(0:2) !INSTRUM. POL - INTEGER F0 !INPOL FREQ. - COMPLEX CX(0:STHTEL-1) !SIMPLE MODEL - REAL R2,R3,R4 -C- -C -C CLEAR SOURCES -C - CALL WNGMVZ(4*NIFR*LB_X,CMOD) !CLEAR MODEL - GOTO 10 -C -C ADD SOURCES -C - ENTRY NMOMUA(IDX,UV0,LM0,FRQ0,RTP,NPOL,NIFR,IFR,TF, - 1 MINST,CMOD) -C - GOTO 10 -C -C ONE SOURCE ONLY -C - ENTRY NMOMU1(IDX,UV0,LM0,FRQ0,RTP,NPOL,NIFR,IFR,TF, - 1 MINST,CMOD,NMDL) -C - CALL WNGMVZ(4*NIFR*LB_X,CMOD) !CLEAR MODEL - SRC1=NMDL !START SOURCE - SRC2=NMDL !END SOURCE - GOTO 11 -C -C SET SOURCE RANGE -C - 10 CONTINUE - SRC1=0 - SRC2=GMDHJ(MDH_NSRC_J,IDX)-1 - 11 CONTINUE -C -C GET IFR POINTERS -C - DO I=0,NIFR-1 - IFL(I)=MOD(IFR(I),256) !LOW TEL. (WEST) - IFH(I)=IFR(I)/256 !HIGH TEL. (EAST) - END DO -C -C INSTRUM. POL. FREQUENCY -C - IF (IAND(MODACT,NMO_IPO).NE.0) THEN !ASKED INPOL - DO I1=0,6 !FIND FREQUENCY - IF (FRQ0.LT.INPOLF(I1)) THEN - F0=I1 !FOUND - GOTO 20 - END IF - END DO - F0=6 - 20 CONTINUE - END IF -C -C ALL SOURCES -C - DO I=SRC1,SRC2 - PB=GMDHJ(MDH_MODP_J,IDX)+I*MDL__L-A_OB !ARRAY PTR SOURCE - PJ=PB/LB_J - PE=PB/LB_E - TBIT=A_B(PB+MDL_BITS_B) !BITS - TCC=A_B(PB+MDL_TP_B) !CLEAN TYPE - SRCAM=A_E(PE+MDL_I_E) !AMPLITUDE -C -C DO BEAMING -C - IF (IAND(MODACT,NMO_BEA).NE.0) THEN !BEAMING REQUESTED - IF (IAND(TCC,MDLBEM_M).EQ.0) THEN !BEAM FIRST - IF (NMOBMF(IAND(MDHINS_M,GMDHJ(MDH_BITS_J,IDX)), - 1 GMDHD(MDH_FRQ_D,IDX))) THEN !CAN DO - R0=NMOBMV(GMDHD(MDH_FRQ_D,IDX),A_E(PE+MDL_L_E), - 1 A_E(PE+MDL_M_E),BEMLIM,.FALSE.) !GET FACTOR - SRCAM=R0*SRCAM !BEAM INTENSITY - END IF - END IF - IF (NMOBMF(MINST,FRQ0)) THEN !CAN CORRECT - R0=NMOBMV(FRQ0,A_E(PE+MDL_L_E), - 1 A_E(PE+MDL_M_E),BEMLIM,.TRUE.) !GET FACTOR - SRCAM=R0*SRCAM !DE-BEAM INTENSITY - END IF - END IF !BEAMING -C -C GET TELESCOPE DATA -C - R0=UV0(0)*(A_E(PE+MDL_L_E)-LM0(0))+ - 1 UV0(1)*(A_E(PE+MDL_M_E)-LM0(1)) !SRC PHASE - IF (IAND(MDLCLN_M,TCC).EQ.0) THEN !NOT CLEAN COMPONENT - IF (IAND(MODACT,NMO_BAN).NE.0) R2=R0*(TF(1)/2/FRQ0) !BANDWIDTH SMEAR - IF (IAND(MODACT,NMO_TIM).NE.0) R1=PI*TF(0)* - 1 (UV0(3)*(A_E(PE+MDL_L_E)-LM0(0))- - 1 UV0(2)*(A_E(PE+MDL_M_E)-LM0(1))) !TIME SMEARING - END IF - DO I1=0,STHTEL-1 !ALL TELESCOPES - R3=RTP(I1)*R0 !TRUE PHASE - CX(I1)=CMPLX(COS(R3),SIN(R3)) !SIMPLE MODEL - IF (IAND(MDLCLN_M,TCC).EQ.0) THEN !NOT CLEAN COMPONENT - IF (IAND(MODACT,NMO_TIM).NE.0) THEN !TIME SMEARING - R3=RTP(I1)*R1 - RL1(I1)=SIN(R3) !SAVE DATA - RL2(I1)=COS(R3) - RL5(I1)=R3 - END IF - IF (IAND(MODACT,NMO_BAN).NE.0) THEN !BAND SMEARING - R3=RTP(I1)*R2 - RL3(I1)=SIN(R3) - RL4(I1)=COS(R3) - RL6(I1)=R3 - END IF - IF (IAND(1,TBIT).NE.0) THEN !EXTENDED - RL7(I1)=RTP(I1)*UV0(0) !U - RL8(I1)=RTP(I1)*UV0(1) !V - END IF - END IF !END CLEAN - END DO !END TEL -C -C INSTRUM. POL. -C - IF (IAND(MODACT,NMO_IPO).NE.0) THEN !INSTRUM. POL - R0=SQRT((A_E(PE+MDL_L_E)-LM0(0))**2+ - 1 (A_E(PE+MDL_M_E)-LM0(1))**2)*DEG*FRQ0 !RADIUS - R1=ATAN2(-A_E(PE+MDL_L_E)+LM0(0), - 1 A_E(PE+MDL_M_E)-LM0(1)) !ANGLE - DO I1=0,2 !Q,U,V - RP1(I1)=INPOL(0,I1,F0)*SIN(INPOL(1,I1,F0)*R0)**2+ - 1 (INPOL(2,I1,F0)*SIN(INPOL(3,I1,F0)*R0)**2)* - 1 (INPOL(6,I1,F0)*SIN(R1)+INPOL(7,I1,F0)*COS(R1))+ - 1 (INPOL(0,I1,F0)*SIN(INPOL(5,I1,F0)*R0)**2)* - 1 (INPOL(8,I1,F0)*SIN(2*R1)+INPOL(9,I1,F0)*COS(2*R1)) - END DO - END IF -C -C ALL BASELINES -C - DO I1=0,NIFR-1 - J2=IFH(I1) !TEL. POINTER (EAST) - J1=IFL(I1) ! (WEST) - R4=SRCAM !AMPLITUDE - IF (IAND(MDLCLN_M,TCC).EQ.0) THEN !NOT CLEAN COMPONENT - IF (IAND(MODACT,NMO_TIM).NE.0) THEN !TIME SMEARING - R0=RL5(J1)-RL5(J2) - IF (R0.NE.0) THEN - R4=R4*(RL1(J2)*RL2(J1)-RL2(J2)*RL1(J1))/R0 - END IF - END IF - IF (IAND(MODACT,NMO_BAN).NE.0) THEN !BAND SMEARING - R1=RL6(J1)-RL6(J2) - IF (R1.NE.0) R4=R4*(RL3(J2)*RL4(J1)-RL4(J2)*RL3(J1))/R1 - END IF - IF (IAND(1,TBIT).NE.0) THEN !EXTENDED - R0=RL7(J2)-RL7(J1) !U - R1=RL8(J2)-RL8(J1) !V - R4=R4*EXP(-A_E(PE+MDL_EXT_E+0)*R0*R0- - 1 A_E(PE+MDL_EXT_E+1)*R1*R1- - 1 A_E(PE+MDL_EXT_E+2)*R0*R1) - END IF - END IF !END CLEAN COMP. - IF (A_E(PE+MDL_SI_E).NE.0) THEN !SPECTR. INDEX - IF (GMDHD(MDH_FRQ_D,IDX).NE.0) - 1 R4=R4*((FRQ0/GMDHD(MDH_FRQ_D,IDX))** - 1 A_E(PE+MDL_SI_E)) - END IF - CMOD(0,I1)=R4*(CX(J2)*CONJG(CX(J1)))+CMOD(0,I1) !MODEL I - IF (A_E(PE+MDL_RM_E).NE.0) THEN !ROT. MEASURE - R2=2*A_E(PE+MDL_RM_E)*(((DCL*1E-6/GMDHD(MDH_FRQ_D,IDX))**2)- - 1 ((DCL*1E-6/FRQ0)**2)) - R0=A_E(PE+MDL_Q_E)*COS(R2)-A_E(PE+MDL_U_E)*SIN(R2) !Q - R1=+A_E(PE+MDL_Q_E)*SIN(R2)+A_E(PE+MDL_U_E)*COS(R2) !U - ELSE - R0=A_E(PE+MDL_Q_E) !Q - R1=A_E(PE+MDL_U_E) !U - END IF - R2=A_E(PE+MDL_V_E) !V - CMOD(1,I1)=R0*R4*(CX(J2)*CONJG(CX(J1)))+CMOD(1,I1) !MODEL Q - IF (IAND(MODACT,NMO_IPO).NE.0) THEN !INPOL - CMOD(1,I1)=RP1(0)*R4*(CX(J2)*CONJG(CX(J1)))+CMOD(1,I1) !MODEL Q - END IF - CMOD(2,I1)=R1*R4*(CX(J2)*CONJG(CX(J1)))+CMOD(2,I1) !MODEL U - CMOD(3,I1)=R2*R4*(CX(J2)*CONJG(CX(J1)))+CMOD(3,I1) !MODEL V - IF (IAND(MODACT,NMO_IPO).NE.0) THEN !INPOL - CMOD(2,I1)=RP1(1)*R4*(CX(J2)*CONJG(CX(J1)))+CMOD(2,I1) !U - CMOD(3,I1)=RP1(2)*R4*(CX(J2)*CONJG(CX(J1)))+CMOD(3,I1) !V - END IF - END DO !END IFR -C -C NEXT SOURCE -C - END DO !END SOURCES -C - RETURN -C -C - END diff --git a/src/nscan/nmomui.for b/src/nscan/nmomui.for deleted file mode 100644 index 782ccf9b67ed82ddd603322606fa89e675a15ce2..0000000000000000000000000000000000000000 --- a/src/nscan/nmomui.for +++ /dev/null @@ -1,141 +0,0 @@ -C+ NMOMUI.FOR -C WNB 900903 -C -C Revisions: -C WNB 911007 Add instrum. pol. -C WNB 911023 Suppress instrum. pol. question -C WNB 921202 Add NMOMUJ -C CMV 930917 Disable INSPOL (not yet properly implemented) -C WNB 931006 Text -C WNB 931008 Add BEAM -C CMV 931102 Changed default to NOBEAM -C CMV 931122 INPOL enabled for a while ***** Need to set back -C CMV 000210 Changed default back to BEAM (request AGB) -C - SUBROUTINE NMOMUI -C -C Get model action for scan files -C -C Result: -C -C CALL NMOMUI will get the action wanted on model/scan files -C CALL NMOMUJ( UACT_J:I) UACT specifies action -C -C PIN references -C -C MODEL_ACTION -C INPOL*_* -C -C Include files: -C - INCLUDE 'WNG_DEF' - INCLUDE 'NMO_DEF' -C -C Entries: -C -C -C Parameters: -C -C -C Arguments: -C - INTEGER UACT !ACTION -C -C Function references: -C - LOGICAL WNDPAR !GET USER DATA -C -C Data declarations: -C - CHARACTER*24 STR(5) !REPLY - CHARACTER*1 INPC(0:2) !FOR INSTRUM. POL. - DATA INPC/'Q','U','V'/ - CHARACTER*6 INPF(0:6) - DATA INPF/'100','400','1000','2000','4000','10000','100000'/ - REAL LOCF(0:6) - DATA LOCF/100,400,1000,2000,4000,10000,1000000/ -C- - 10 CONTINUE - MODACT=NMO_USE+NMO_MER+NMO_SAV+NMO_BAN+NMO_TIM !DEFAULT: -C USE,MERGE,SAVE,BAND,TIME - IF (.NOT.WNDPAR('MODEL_ACTION',STR,5*LEN(STR(1)),J0, - 1 'MERGE,BAND,TIME,NOINPOL,BEAM')) THEN - GOTO 10 !MUST SPECIFY - END IF - IF (J0.EQ.-1) THEN !* - STR(1)='MERGE' - STR(2)='BAND' - STR(3)='TIME' - STR(4)='NOINPOL' - STR(5)='BEAM' - ELSE IF (J0.LT.4) THEN - GOTO 10 !MUST SPECIFY - END IF - IF (STR(1)(1:3).EQ.'MER') THEN !SCAN SAVE TYPE - MODACT=IOR(NMO_USE+NMO_MER+NMO_SAV, - 1 IAND(NOT(NMO_USAGE),MODACT)) - ELSE IF (STR(1)(1:3).EQ.'ADD') THEN - MODACT=IOR(NMO_USE+NMO_ADD+NMO_SAV, - 1 IAND(NOT(NMO_USAGE),MODACT)) - ELSE IF (STR(1)(1:3).EQ.'NEW') THEN - MODACT=IOR(NMO_SAV,IAND(NOT(NMO_USAGE),MODACT)) - ELSE IF (STR(1)(1:3).EQ.'TEM') THEN - MODACT=IOR(0,IAND(NOT(NMO_USAGE),MODACT)) - ELSE IF (STR(1)(1:3).EQ.'INC') THEN - MODACT=IOR(NMO_USE,IAND(NOT(NMO_USAGE),MODACT)) - ELSE - GOTO 10 - END IF - IF (STR(2)(1:3).EQ.'BAN') THEN !BAND SMEARING - MODACT=IOR(NMO_BAN,IAND(NOT(NMO_BAN),MODACT)) - ELSE IF (STR(2)(1:3).EQ.'NOB') THEN - MODACT=IOR(0,IAND(NOT(NMO_BAN),MODACT)) - END IF - IF (STR(3)(1:3).EQ.'TIM') THEN !TIME SMEARING - MODACT=IOR(NMO_TIM,IAND(NOT(NMO_TIM),MODACT)) - ELSE IF (STR(3)(1:3).EQ.'NOT') THEN - MODACT=IOR(0,IAND(NOT(NMO_TIM),MODACT)) - END IF - IF (STR(4)(1:3).EQ.'INP') THEN !INSTRUM. POL. -C CALL WNCTXT(F_TP,'Not yet implemented...') -C MODACT=IOR(0,IAND(NOT(NMO_IPO),MODACT)) !NOINP - CALL WNCTXT(F_TP,'Good luck, there you go...') - MODACT=IOR(NMO_IPO,IAND(NOT(NMO_IPO),MODACT)) !INPOL - ELSE IF (STR(4)(1:3).EQ.'NOI') THEN - MODACT=IOR(0,IAND(NOT(NMO_IPO),MODACT)) - END IF - IF (STR(5)(1:3).EQ.'BEA') THEN !BEAM CORRECTION - MODACT=IOR(NMO_BEA,IAND(NOT(NMO_BEA),MODACT)) - ELSE IF (STR(5)(1:3).EQ.'NOB') THEN - MODACT=IOR(0,IAND(NOT(NMO_BEA),MODACT)) - END IF - GOTO 100 -C -C NMOMUJ -C - ENTRY NMOMUJ(UACT) -C - MODACT=UACT !SET ACTION WANTED - GOTO 100 -C -C INSTRUMENTAL POLARISATION -C - 100 CONTINUE - IF (IAND(MODACT,NMO_IPO).NE.0 .AND. INPOLF(0).EQ.0) THEN !STILL TO DO - DO I=0,2 !Q,U,V - DO I1=0,6 !FREQUENCIES - 20 CONTINUE - IF (.NOT.WNDPAR('INPOL'//INPC(I)//'_'//INPF(I1),INPOL(0,I,I1), - 1 10*LB_E,J0)) THEN - GOTO 20 - END IF - IF (J0.NE.10) GOTO 20 !MUST SPECIFY EXACTLY - INPOLF(I1)=LOCF(I1) !SET FREQUENCY - END DO - END DO - END IF -C - RETURN -C -C - END diff --git a/src/nscan/nmomup.for b/src/nscan/nmomup.for deleted file mode 100644 index 67a5e2bb4b0f3c7e4d9f6f3fbad9ce660833a270..0000000000000000000000000000000000000000 --- a/src/nscan/nmomup.for +++ /dev/null @@ -1,93 +0,0 @@ -C+ NMOMUP.FOR -C WNB 900903 -C -C Revisions: -C WNB 920320 SUN cannot handle empty argument functions -C - LOGICAL FUNCTION NMOMUP() -C -C Prepare model for scan insertion -C -C Result: -C -C NMOMUP_L = NMOMUP() will prepare model for scan insertion -C -C PIN references -C -C -C Include files: -C - INCLUDE 'WNG_DEF' - INCLUDE 'NMO_DEF' - INCLUDE 'MDH_O_DEF' !MODEL HEADER - INCLUDE 'MDL_O_DEF' !MODEL LINE -C -C Entries: -C -C -C Parameters: -C -C -C Arguments: -C -C -C Function references: -C - LOGICAL NMOSLG !GET MODEL AREA -C -C Data declarations: -C -C- -C -C INIT -C - NMOMUP=.TRUE. !ASSUME OK -C -C GET AREAS -C - CALL NMOHZD(GMDH(0,0)) !CLEAR TYPE 0 - CALL NMOHMD(GDES,GMDH(0,0)) !SET DATA - CALL NMOHZD(GMDH(0,1)) !CLEAR TYPE 1 - CALL NMOHMD(GDES,GMDH(0,1)) !SET DATA - CALL NMOHZD(GMDH(0,2)) !CLEAR OTHER TYPES - CALL NMOHMD(GDES,GMDH(0,2)) !SET DATA - IF (GDESJ(MDH_NSRC_J).GT.0) THEN !SPLIT SOURCES - IF (.NOT.NMOSLG(GDESJ(MDH_NSRC_J),GMDH(0,0))) GOTO 900 !GET SPACE - IF (.NOT.NMOSLG(GDESJ(MDH_NSRC_J),GMDH(0,1))) GOTO 900 - IF (.NOT.NMOSLG(GDESJ(MDH_NSRC_J),GMDH(0,2))) GOTO 900 -C -C SET SOURCES IN SEPARATE LISTS -C - CALL NMOAMG !MERGE SOURCE LIST - CALL NMOSRT(1,GDES) !SORT LIST ON L,M - J0=GDESJ(MDH_MODP_J)-A_OB !ARRAY OFFSET - DO I=0,GDESJ(MDH_NSRC_J)-1 !ALL SOURCES - IF (A_B(J0+MDL_TP1_B).EQ.0) THEN !TYPE 0 - CALL WNGMV(MDLHDL,A_B(J0),A_B(GMDHJ(MDH_MODP_J,0)+ - 1 GMDHJ(MDH_NSRC_J,0)*MDLHDL-A_OB)) !SET SOURCE - GMDHJ(MDH_NSRC_J,0)=GMDHJ(MDH_NSRC_J,0)+1 !COUNT SOURCE - ELSE IF (A_B(J0+MDL_TP1_B).EQ.1) THEN !TYPE 1 - CALL WNGMV(MDLHDL,A_B(J0),A_B(GMDHJ(MDH_MODP_J,1)+ - 1 GMDHJ(MDH_NSRC_J,1)*MDLHDL-A_OB)) !SET SOURCE - GMDHJ(MDH_NSRC_J,1)=GMDHJ(MDH_NSRC_J,1)+1 !COUNT SOURCE - ELSE !OTHER TYPES - CALL WNGMV(MDLHDL,A_B(J0),A_B(GMDHJ(MDH_MODP_J,2)+ - 1 GMDHJ(MDH_NSRC_J,2)*MDLHDL-A_OB)) !SET SOURCE - GMDHJ(MDH_NSRC_J,2)=GMDHJ(MDH_NSRC_J,2)+1 !COUNT SOURCE - END IF - J0=J0+MDLHDL !NEXT SOURCE - END DO - END IF -C - RETURN -C -C ERRORS -C - 900 CONTINUE - CALL WNCTXT(F_TP,'Cannot obtain model lists') - NMOMUP=.FALSE. -C - RETURN -C -C - END diff --git a/src/nscan/nmomuv.for b/src/nscan/nmomuv.for deleted file mode 100644 index 0a6109e57746a87aca325edaf067e3ab1e63de79..0000000000000000000000000000000000000000 --- a/src/nscan/nmomuv.for +++ /dev/null @@ -1,111 +0,0 @@ -C+ NMOMUV.FOR -C WNB 900903 -C -C Revisions: -C WNB 910805 Typo -C WNB 911021 Change rotation signs -C WNB 911023 Change rotation signs back -C WNB 920118 Change precision rotation -C - SUBROUTINE NMOMUV(BTP,RA,DEC,STHD,SCHE,UV0) -C -C Calculate UV data for model calculation -C -C Result: -C -C CALL NMOMUV( BTP_J:I, RA_D:I, DEC_D:I, STHD_D(0:*):I, -C SCHE_E(0:*):I, UV0_E(0:3):O) -C Calculate for BTP (0=unknown, 1=apparent, -C 2=B1950) the UV for 1m baseline, -C using the set header STHD, -C the scan header SCHE and -C the reference RA, DEC of map. -C UV(0:1) = vector components in radians per m -C UV(2:3) = components of perpendicular vector -C in radians per m -C -C PIN references -C -C -C Include files: -C - INCLUDE 'WNG_DEF' - INCLUDE 'STH_O_DEF' !SET HEADER - INCLUDE 'SCH_O_DEF' !SCAN HEADER -C -C Parameters: -C -C -C Arguments: -C - INTEGER BTP !COORD. TYPE - REAL*8 RA !RA TO USE - REAL*8 DEC !DEC TO USE - REAL*8 STHD(0:*) !SET HEADER - REAL SCHE(0:*) !SCAN HEADER - REAL UV0(0:3) !UV DATA -C -C Function references: -C - INTEGER WNGARA !ADDRESS -C -C Data declarations: -C - REAL R2,R3,R4 -C- - R0=COS(PI2*SCHE(SCH_HA_E)) !COS(HA) - R1=SIN(PI2*SCHE(SCH_HA_E)) !SIN(HA) - R2=SIN(DPI2*STHD(STH_DEC_D)) !SIN(DEC) - R3=DPI2*STHD(STH_FRQ_D)*1D6/DCL !SCALE -C -C First calculate the two vectors in the equatorial plane -C for observed HA in SCH, DEC in STH -C - UV0(0)=R3*R0 !U - UV0(1)=-R3*R1*R2 !V - UV0(2)=R3*R0*R2 !SMEARING - UV0(3)=-R3*R1 -C -C If epoch requested, rotate in the equatorial plane over (precession?) angle -C PHI from STH -C - J=(WNGARA(STHD(0))-A_OB)/LB_E !STHE OFFSET - IF (BTP.EQ.2) THEN !B1950 or J2000 - R0=COS(PI2*A_E(J+STH_PHI_E)) !COS(PHI) - R1=SIN(PI2*A_E(J+STH_PHI_E)) !SIN(PHI) - R3=UV0(0)*R0+UV0(1)*R1 ! ROTATE, save - UV0(1)=-UV0(0)*R1+UV0(1)*R0 - UV0(0)=R3 ! copy in place - R3=UV0(2)*R0+UV0(3)*R1 ! ROTATE, save - UV0(3)=-UV0(2)*R1+UV0(3)*R0 - UV0(2)=R3 ! copy in place - END IF -C -C If either apparent or epoch, rotate from epoch/apparent to map reference\ -C in 3 steps: -C - Deproject by division through sin DEC (epoch/apparent); -C - Rotate in equatorial plane from epoch/apparent to reference HA -C - Project by multiplying with sin DEC (reference) -C - IF (BTP.NE.0) THEN - R3=SIN(DPI2*DEC) - IF (BTP.EQ.2) THEN - R0=COS(DPI2*(STHD(STH_RAE_D)-RA)) !COS(RA0-RA) - R1=SIN(DPI2*(STHD(STH_RAE_D)-RA)) !SIN - R2=SIN(DPI2*STHD(STH_DECE_D)) !SIN(DEC) - ELSE - R0=COS(DPI2*(STHD(STH_RA_D)-RA)) !COS(RA0-RA) - R1=SIN(DPI2*(STHD(STH_RA_D)-RA)) !SIN - END IF - R4=R0*UV0(0)+R1/R2*UV0(1) ! ROTATE, save - UV0(1)=-R1*R3*UV0(0)+R0*R3/R2*UV0(1) - UV0(0)=R4 ! copy in place - R4=R0*UV0(2)+R1/R2*UV0(3) ! ROTATE, save - UV0(3)=-R1*R3*UV0(3)+R0*R3/R2*UV0(3) - UV0(2)=R4 ! copy in place - END IF -C - RETURN -C -C - END diff --git a/src/nscan/nmonam.for b/src/nscan/nmonam.for deleted file mode 100644 index a30ce5f39ee88e6b26765130ba2551f74d933414..0000000000000000000000000000000000000000 --- a/src/nscan/nmonam.for +++ /dev/null @@ -1,175 +0,0 @@ -C+ NMONAM.FOR -C CMV 940428 -C -C Revisions: -C CMV 940428 Created -C CMV 940503 Made logical function -C CMV 940622 Correct accuracy of comparison, add DO_SHOW -C - LOGICAL FUNCTION NMONAM(IMDL,GDES,STR,DO_SHOW) -C -C Find proper name for model component -C -C Result: -C -C FOUND_L = NMONAM( IMDL(0:*)_B:I, GDES(0:*)_B:I, STR_C*(*):O, -C DO_SHOW_L:I) -C Return in STR an identification for the component in IMDL -C using the header information in GDES. Identification is -C either the ID value in MDL or the name derived from a -C file with coordinates and proper names. Returns .TRUE. -C if proper name found for source. If DO_SHOW is True, the -C match is reported on the screen. -C -C CALL NMONM1() -C Initialise the file with proper names, return .TRUE. if -C name list loaded. -C -C -C Include files: -C - INCLUDE 'WNG_DEF' - INCLUDE 'MDH_O_DEF' !MODEL HEADER - INCLUDE 'MDL_O_DEF' !MODEL LINE -C -C Entries: -C - LOGICAL NMONM1 !INITIALISE NAMELIST -C -C Parameters: -C - INTEGER MAXNAM !NUMBER OF NAMES IN LIST - PARAMETER(MAXNAM=50) -C -C Arguments: -C - BYTE IMDL(0:*) !MODEL COMPONENT - BYTE GDES(0:*) !MODEL HEADER - CHARACTER STR*(*) !OUTPUT STRING - LOGICAL DO_SHOW !SHOW MATCH -C -C Function references: -C - INTEGER WNGARA !GET ADDRESS - LOGICAL WNDPAR !GET NAME OF INPUT FILE - LOGICAL WNCAFF !FORMAT LINE - LOGICAL WNCACD !GET REAL*8 NUMBER - DOUBLE PRECISION WNGDND !NORMALISE ANGLES -C -C Data declarations: -C - INTEGER NLIST !NUMBER IN LIST - DATA NLIST/0/ !NONE YET - REAL*8 XX_L(MAXNAM),YY_L(MAXNAM) !COORDINATE LIST - CHARACTER*10 ID_L(MAXNAM) !NAME LIST - SAVE NLIST,XX_L,YY_L,ID_L -C - INTEGER LUN !UNIT FOR INPUT FILE - CHARACTER*80 LINE,FLINE !TEMP STRINGS - BYTE MDL(0:MDLHDL-1) !SOURCE ENTRY - INTEGER MDLJ(0:MDLHDL/4-1) - REAL MDLE(0:MDLHDL/4-1) - EQUIVALENCE (MDL,MDLJ,MDLE) -C- -C -C INIT -C - NMONAM=.FALSE. !NOT YET FOUND - CALL WNGMV(MDLHDL,IMDL,MDL) !GET SOURCE - J=WNGARA(GDES) !ADDRESS HEADER - J1=(J-A_OB)/LB_J ! AS J - J2=(J-A_OB)/LB_D ! AD D -C - IF (A_J(J1+MDH_TYP_J).LE.0) THEN !LOCAL MODE - CALL NMOEXT(MDL) !MAKE CORRECT FORMAT - D0=MDLE(MDL_L_E) - D1=MDLE(MDL_M_E) - ELSE - CALL WNMCLM(A_D(J2+MDH_RA_D),A_D(J2+MDH_DEC_D), - 1 MDLE(MDL_L_E),MDLE(MDL_M_E),D0,D1) !MAKE RA/DEC - CALL NMOEXT(MDL) !MAKE CORRECT FORMAT - END IF -C - CALL WNCTXS(STR,'!UJ',MDLJ(MDL_ID_J)) !DEFAULT ID - D0=WNGDND(D0*360)*3600. !MAKE ARCSEC - D1=WNGDND(D1*360)*3600. -C - DO I=1,NLIST !TRY ALL NAMES - IF (ABS(D0-XX_L(I)).LT.1 .AND. - 1 ABS(D1-YY_L(I)).LT.1.) THEN !MATCH 1 arcsec - STR=ID_L(I) !FOUND NAME - IF (DO_SHOW) - 1 CALL WNCTXT(F_T,'!UJ = !AS',MDLJ(MDL_ID_J),STR) !SHOW - NMONAM=.TRUE. !SET FOUND - END IF - END DO -C - RETURN -C - ENTRY NMONM1() -C - NMONM1=.FALSE. !NO LIST YET - NLIST=0 -C -C Get name of list file and open -C - 90 CONTINUE - IF (.NOT.WNDPAR('NAMES_FILE',LINE,LEN(LINE),J0, - 1 'SOURCE.TXT')) THEN - IF (E_C.EQ.DWC_ENDOFLOOP) GOTO 900 !READY - CALL WNCTXT(F_TP,'No proper file specified') - GOTO 90 - END IF - IF (J0.LE.0) GOTO 900 !READY -C - LUN=0 - CALL WNGLUN(LUN) !GET LUN TO USE - IF (LUN.EQ.0) THEN - CALL WNCTXT(F_TP,'Cannot get unit for file') - GOTO 900 - END IF - OPEN (UNIT=LUN,FILE=LINE,STATUS='OLD',ERR=83) !OPEN INPUT -C -C READ DATA -C - NLIST = 0 !Entry counter - DO WHILE (NLIST.LT.MAXNAM) - READ (UNIT=LUN,FMT=1000,END=87,ERR=83) LINE - 1000 FORMAT(A) - I=1 !DATA POINTER - IF (WNCAFF(LINE,I,FLINE)) THEN !NOT COMMENT-LINE (!) - I=1 - CALL WNCASB(FLINE,I) !SKIP BLANK - IF (WNCACD(FLINE,I,10,XX_L(NLIST+1))) THEN !GET RA - CALL WNCASB(FLINE,I) - IF (WNCACD(FLINE,I,10,YY_L(NLIST+1))) THEN !GET DEC - CALL WNCASB(FLINE,I) - ID_L(NLIST+1)=FLINE(I:) !GET NAME - NLIST=NLIST+1 !COUNT ENTRY - NMONM1=.TRUE. !GOT SOMETHING - END IF - END IF - END IF - END DO - 87 CONTINUE - CLOSE(UNIT=LUN) - CALL WNGLUF(LUN) -C - DO I=1,NLIST - XX_L(I)=WNGDND(XX_L(I))*3600. !MAKE ARCSEC - YY_L(I)=WNGDND(YY_L(I))*3600. - END DO -C - RETURN -C -C ERROR RETURN -C - 83 CONTINUE - CALL WNCTXT(F_TP,'Cannot open/read file') - IF (LUN.NE.0) THEN - CLOSE(UNIT=LUN) - CALL WNGLUF(LUN) - END IF - 900 CONTINUE -C - END diff --git a/src/nscan/nmonvs.for b/src/nscan/nmonvs.for deleted file mode 100644 index 7896dfb0640252f439238b5d52aba17a78aa1e5d..0000000000000000000000000000000000000000 --- a/src/nscan/nmonvs.for +++ /dev/null @@ -1,67 +0,0 @@ -C+ NMONVS.FOR -C WNB 900905 -C -C Revisions: -C - SUBROUTINE NMONVS -C -C Convert MDL file to newest version -C -C Result: -C -C CALL NMONVS will convert a MDL file to newest version -C -C PIN references: -C -C -C Include files: -C - INCLUDE 'WNG_DEF' - INCLUDE 'NMO_DEF' - INCLUDE 'GFH_O_DEF' !GENERAL FILE HEADER - INCLUDE 'MDH_O_DEF' !MODEL HEADER - INCLUDE 'MDL_O_DEF' !MODEL -C -C Parameters: -C -C -C Arguments: -C -C -C Function references: -C - LOGICAL WNFRD !READ DATA - LOGICAL WNFWR !WRITE DATA -C -C Data declarations: -C - BYTE GFH(0:GFHHDL-1) !GENERAL FILE HEADER - INTEGER GFHJ(0:GFHHDL/4-1) - EQUIVALENCE (GFH,GFHJ) - BYTE MDH(0:MDHHDL-1) !MODEL HEADER - INTEGER MDHJ(0:MDHHDL/4-1) - EQUIVALENCE (MDH,MDHJ) - BYTE MDL(0:MDLHDL-1) !MODEL LINE -C- -C -C INIT -C -C -C GENERAL FILE HEADER -C -C -C READY -C - 800 CONTINUE - CALL WNFCL(FCAOUT) !CLOSE FILE -C - RETURN -C -C ERROR -C - 900 CONTINUE - CALL WNFCL(FCAOUT) !CLOSE FILE - RETURN !READY -C -C - END diff --git a/src/nscan/nmoofr.fsc b/src/nscan/nmoofr.fsc deleted file mode 100644 index 3dc8f170511be1f50d378b626715c0b4777e4b4e..0000000000000000000000000000000000000000 --- a/src/nscan/nmoofr.fsc +++ /dev/null @@ -1,173 +0,0 @@ -C+ NMOOFR.FOR -C WNB 900827 -C -C Revisions: -C WNB 931006 Text -C AXC 010628 Linux port -C - SUBROUTINE NMOOFR -C -C Convert source list from old format -C -C Result: -C -C CALL NMOOFR -C Convert an old source list format -C -C PIN references -C -C -C Include files: -C - INCLUDE 'WNG_DEF' - INCLUDE 'NMO_DEF' - INCLUDE 'GFH_O_DEF' !GENERAL FILE HEADER - INCLUDE 'MDH_O_DEF' !MODEL HEADER - INCLUDE 'MDL_O_DEF' !MODEL LINE -C -C Entries: -C -C -C Parameters: -C -C -C Arguments: -C -C -C Function references: -C - LOGICAL WNDPAR !GET USER DATA - LOGICAL NMOSLI !GET SOURCE AREA -C -C Data declarations: -C - BYTE MDL(0:MDLHDL-1) !SOURCE LIST - INTEGER MDLJ(0:MDLHDL/4-1) - REAL MDLE(0:MDLHDL/4-1) - EQUIVALENCE (MDL,MDLJ,MDLE) - CHARACTER*100 LINE - INTEGER TYPSRC !SOURCE TYPE -C- -C -C INIT -C - CALL NMOHZD(GDES) !CLEAR HEADER DATA -C -C READ FILE -C - CALL WNGLUN(J1) !UNIT # -#ifdef wn_li__ - OPEN (UNIT=J1,ERR=900,FILE=FILIN,STATUS='OLD') !OPEN MODEL FILE -#else - OPEN (UNIT=J1,ERR=900,FILE=FILIN,READONLY,STATUS='OLD') !OPEN MODEL FILE -#endif - 30 READ (UNIT=J1,FMT=1000,ERR=910,END=20) J,LINE !READ A LINE -C 1000 FORMAT(Q,A) - 1000 FORMAT(A) - IF (LINE(:1).EQ.'!') GOTO 30 !COMMENT - IF (LINE(:5).NE.'TYPE=') THEN - 37 CALL WNCTXT(F_TP,'Wrongly structured input file') - 33 CLOSE (UNIT=J1,ERR=32) !CLOSE AND RELEASE NODE - 32 CONTINUE - GOTO 900 !RETRY - END IF - BACKSPACE(UNIT=J1) !REREAD - READ(UNIT=J1,FMT=1010,ERR=910) LINE,J - 1010 FORMAT(A5,I4) !READ TYPE - IF (J.GT.1) THEN - READ(UNIT=J1,FMT=1011,ERR=910) LINE,GDESD(MDH_RA_D) - 1011 FORMAT(A4,E15.2) !READ OFFSETS - IF (LINE(:4).NE.'RA0=') THEN - GDESD(MDH_RA_D)=0 - GOTO 37 - END IF - GDESD(MDH_RA_D)=GDESD(MDH_RA_D)/3600./360. - READ(UNIT=J1,FMT=1011,ERR=910) LINE,GDESD(MDH_DEC_D) - IF (LINE(:4).NE.'DEC=') THEN - GDESD(MDH_DEC_D)=0 - GOTO 37 - END IF - GDESD(MDH_DEC_D)=GDESD(MDH_DEC_D)/3600./360. - END IF - TYPSRC=J !SET TYPE - IF (TYPSRC.EQ.2) THEN !SAVE TYPE - GDESJ(MDH_TYP_J)=2 !1950 - GDESE(MDH_EPOCH_E)=1950. - ELSE IF (TYPSRC.EQ.3) THEN - GDESJ(MDH_TYP_J)=1 !APPARENT - ELSE - GDESJ(MDH_TYP_J)=0 !UNKNOWN - END IF - IF (TYPSRC.GT.1) THEN - 38 CONTINUE - IF (.NOT.WNDPAR('REFERENCE_FREQ',D0,L_D/L_B,J0,'0')) GOTO 910 - IF (J0.LE.0) GOTO 910 !STOP - IF (D0.LE.0) GOTO 38 !RETRY - GDESD(MDH_FRQ_D)=D0 !SET - END IF -C -C READ SOURCES -C - 31 READ(UNIT=J1,FMT=1000,ERR=910,END=20) J,LINE - IF (LINE(:1).EQ.'!') GOTO 31 !COMMENT - BACKSPACE (UNIT=J1) !REREAD - 34 CONTINUE - IF (GDESJ(MDH_NSRC_J).GE.GDESJ(MDH_MODL_J)) THEN - IF (.NOT.NMOSLI(2*GDESJ(MDH_NSRC_J))) GOTO 900 !GET MORE SPACE - END IF - CALL WNGMVZ(MDLHDL,MDL) !CLEAR SOURCE - READ (UNIT=J1,FMT=1020,ERR=35,END=20) MDLE(MDL_I_E), - 1 MDLE(MDL_L_E),MDLE(MDL_M_E), - 1 MDLE(MDL_EXT_E+0),MDLE(MDL_EXT_E+1), - 1 MDLE(MDL_EXT_E+2), - 1 MDL(MDL_TP1_B),MDLJ(MDL_ID_J), - 1 LINE(1:1) !READ SOURCE - 1020 FORMAT(1X,F10.3,2(1X,F12.2),2(1X,F9.2),1X,F6.1,I4,I6,T77,A1) - IF (LINE(1:1).NE.'/') GOTO 35 !ERROR - 36 CONTINUE - CALL NMOEXF(MDL) !CONVERT TO INTERNAL FORMAT - IF (MDLJ(MDL_ID_J).GE.3000) MDL(MDL_TP_B)=MDLCLN_M !SET CLEAN COMPONENT - IF (TYPSRC.EQ.2 .OR. TYPSRC.EQ.3) THEN !CONVERT COORDINATES - CALL WNMCRD(GDESD(MDH_RA_D),GDESD(MDH_DEC_D), - 1 MDLE(MDL_L_E),MDLE(MDL_M_E), - 1 GDESD(MDH_RA_D)+MDLE(MDL_L_E)/PI2, - 1 GDESD(MDH_DEC_D)+MDLE(MDL_M_E)/PI2) - END IF - CALL WNGMV(MDLHDL,MDL,A_B(GDESJ(MDH_MODP_J)+MDLHDL* - 1 GDESJ(MDH_NSRC_J)-A_OB)) !SAVE SOURCE - IF (MDLE(MDL_I_E).NE.0) GDESJ(MDH_NSRC_J)= - 1 GDESJ(MDH_NSRC_J)+1 !COUNT SOURCE - GOTO 34 !MORE -C - 35 BACKSPACE(UNIT=J1) - READ(UNIT=J1,FMT=1000,ERR=910,END=20) J,LINE - IF (LINE(:1).EQ.'!') GOTO 31 !COMMENT - BACKSPACE(UNIT=J1) - CALL WNGMVZ(MDLHDL,MDL) !CLEAR SOURCE - READ (UNIT=J1,FMT=*,ERR=910) MDLE(MDL_I_E), - 1 MDLE(MDL_L_E),MDLE(MDL_M_E), - 1 MDLE(MDL_EXT_E+0),MDLE(MDL_EXT_E+1), - 1 MDLE(MDL_EXT_E+2), - 1 MDL(MDL_TP_B),MDLJ(MDL_ID_J) - GOTO 36 -C -C END OF FILE -C - 20 CLOSE (UNIT=J1,ERR=21) !CLOSE FILE - 21 CONTINUE - CALL NMOWRS(FCAOUT,GDES) !WRITE FILE -C - RETURN -C -C ERRORS -C - 900 CALL WNCTXT(F_TP,'Cannot open file !AS',FILIN) -C - 910 CALL WNCTXT(F_TP,'Read error') - CLOSE(UNIT=J1,ERR=911) - 911 CALL WNFCL(FCAOUT) -C - RETURN -C -C - END diff --git a/src/nscan/nmooto.for b/src/nscan/nmooto.for deleted file mode 100644 index 33dcf87ec6eff789fc15e3e3aebba04f7f8e2cea..0000000000000000000000000000000000000000 --- a/src/nscan/nmooto.for +++ /dev/null @@ -1,148 +0,0 @@ -C+ NMOOTO.FOR -C WNB 900827 -C -C Revisions: -C HjV 920520 HP does not allow extended source lines -C WNB 931006 Text -C - SUBROUTINE NMOOTO -C -C Convert source list to old format -C -C Result: -C -C CALL NMOOTO -C Convert a source list to old format -C -C PIN references -C -C -C Include files: -C - INCLUDE 'WNG_DEF' - INCLUDE 'NMO_DEF' - INCLUDE 'MDH_O_DEF' !MODEL HEADER - INCLUDE 'MDL_O_DEF' !MODEL LINE -C -C Entries: -C -C -C Parameters: -C -C -C Arguments: -C -C -C Function references: -C - REAL*8 WNGDNF !ANGLE CONSTRAINT -C -C Data declarations: -C - BYTE MDH(0:MDHHDL-1) !SOURCE HEADER - INTEGER MDHJ(0:MDHHDL/4-1) - REAL MDHE(0:MDHHDL/4-1) - REAL*8 MDHD(0:MDHHDL/8-1) - EQUIVALENCE (MDH,MDHJ,MDHE,MDHD) - BYTE MDL(0:MDLHDL-1) !SOURCE LINE - INTEGER MDLJ(0:MDLHDL/4-1) - REAL MDLE(0:MDLHDL/4-1) - EQUIVALENCE (MDL,MDLJ,MDLE) - INTEGER TYPSRC !TYPE OF SOURCE -C- -C -C INIT -C - CALL NMOHZD(GDES) !CLEAR HEADER - CALL NMORDS(FCAOUT) !READ SOURCES - CALL NMORDM(7,-1) !AND ADD TO GENERAL -C -C WRITE OLD FORMAT -C - CALL WNGLUN(J1) !UNIT # - OPEN (UNIT=J1,ERR=900,FILE=FILIN,STATUS='NEW') !OPEN MODEL FILE - 40 CONTINUE - WRITE (UNIT=J1,FMT=1000,ERR=910) '!' - 1000 FORMAT(A) - WRITE (UNIT=J1,FMT=1000,ERR=910) '!' - WRITE (UNIT=J1,FMT=1000,ERR=910) '! Note: If editing this file'// - 1 ' by hand, make sure each line ends with a /' - WRITE (UNIT=J1,FMT=1000,ERR=910) '! On 850208 definition'// - 1 ' of p.a. from N thru E, full halfwidth sizes' - WRITE (UNIT=J1,FMT=1000,ERR=910) '!' - IF (GDESJ(MDH_TYP_J).EQ.2) THEN !1950 - TYPSRC=2 - ELSE IF (GDESJ(MDH_TYP_J).EQ.3) THEN !APPARENT - TYPSRC=3 - ELSE - TYPSRC=1 - END IF - WRITE (UNIT=J1,FMT=1010,ERR=910) 'TYPE=',TYPSRC - 1010 FORMAT(A5,I3) !TYPE - IF (TYPSRC.GT.1) THEN - WRITE (UNIT=J1,FMT=1011,ERR=910) 'RA0=',GDESD(MDH_RA_D)*3600*360 - 1011 FORMAT(A4,F15.2) - WRITE (UNIT=J1,FMT=1011,ERR=910) 'DEC=', - 1 GDESD(MDH_DEC_D)*3600*360 - END IF - WRITE (UNIT=J1,FMT=1000,ERR=910) '!' - WRITE (UNIT=J1,FMT=1000,ERR=910) '! AMPL L'// - 1 ' M LONG SHORT'// - 2 ' P.A. TP ID' - WRITE (UNIT=J1,FMT=1000,ERR=910) '! (WU) "'// - 1 ' " " " '// - 2 ' deg' - WRITE (UNIT=J1,FMT=1000,ERR=910) '!' -C -C WRITE SOURCES -C - 30 CONTINUE - DO I=0,GDESJ(MDH_NSRC_J)-1 !ALL SOURCES - CALL WNGMV(MDLHDL,A_B(GDESJ(MDH_MODP_J)+I*MDLHDL-A_OB),MDL) !GET LINE - IF (MDLE(MDL_I_E).NE.0) THEN - IF (TYPSRC.GT.1) THEN !CONVERT - CALL WNMCLM(GDESD(MDH_RA_D),GDESD(MDH_DEC_D), - 1 MDLE(MDL_L_E),MDLE(MDL_M_E),D0,D1) - MDLE(MDL_L_E)=WNGDNF(D0-GDESD(MDH_RA_D))*DPI2 - MDLE(MDL_M_E)=WNGDNF(D1-GDESD(MDH_DEC_D))*DPI2 - END IF - CALL NMOEXT(MDL) !EXTERNAL FORMAT - I1=MDL(MDL_TP_B) - IF (IAND(MDLCLN_M,I1).EQ.1) THEN !CLEAN COMPONENT - IF (MDLJ(MDL_ID_J).LT.3000) - 1 MDLJ(MDL_ID_J)=MDLJ(MDL_ID_J)+3000 !SET CLEAN - END IF - WRITE (UNIT=J1,FMT=1020,ERR=910) - 1 MDLE(MDL_I_E),MDLE(MDL_L_E), - 1 MDLE(MDL_M_E),MDLE(MDL_EXT_E), - 1 MDLE(MDL_EXT_E+1),MDLE(MDL_EXT_E+2), - 1 MDL(MDL_TP1_B),MDLJ(MDL_ID_J),'/' - 1020 FORMAT(1X,F10.3,2(1X,F12.2),2(1X,F9.2),1X,F6.1,I4,I6,T77,A1) - END IF - END DO -C -C END OF FILE -C - 20 CONTINUE - CLOSE (UNIT=J1,ERR=21) !CLOSE FILE - 21 CONTINUE - CALL WNGLUF(J1) !RELEASE LUN -C - RETURN -C -C ERRORS -C - 900 CONTINUE - CALL WNCTXT(F_TP,'Cannot open file !AS',FILIN) - GOTO 911 -C - 910 CONTINUE - CALL WNCTXT(F_TP,'Write error') - CLOSE (UNIT=J1,ERR=911) - 911 CONTINUE - CALL WNGLUF(J1) -C - RETURN -C -C - END diff --git a/src/nscan/nmoprt.for b/src/nscan/nmoprt.for deleted file mode 100644 index f9949100a5b0cf787c4dd06a6e4892196206ebee..0000000000000000000000000000000000000000 --- a/src/nscan/nmoprt.for +++ /dev/null @@ -1,381 +0,0 @@ -C+ NMOPRT.FOR -C WNB 900827 -C -C Revisions: -C WNB 910806 Add NMOPRU, PRX -C WNB 910809 Add NMOPRM -C WNB 911230 Better print for updates -C WNB 920113 Add PTI -C HjV 920520 HP does not allow extended source lines -C WNB 920810 Typo in NMOPRR test if ra/dec -C WNB 930928 Add instrument -C WNB 931011 Add PRS -C WNB 940821 Add PRP, PRE -C WNB 950623 Rearrange for new update set up -C WNB 950629 Remove PRX,PRS,PRP,PRE -C WNB 950630 Add update option -C WNB 950705 Printout extended update -C WNB 950706 Cater for loop printout -C JPH 960612 Show RA and DEC also in decimal format -C - SUBROUTINE NMOPRT(TP,RG) -C -C Print a source model -C -C Result: -C -C CALL NMOPRT( TP_J:I, RG_J(0:1):I) -C Print the general source list on TP from -C RG(0) till RG(1) -C CALL NMOPTT( TP_J:I, RG_J(0:1):I) -C Print totals only -C CALL NMOPTI( TP_J:I, RG_J(0:1):I, IX_J:I) -C Print totals only for sources in IX -C CALL NMOPRR( TP_J:I, RG_J(0:1):I) -C Print in RA/DEC format -C CALL NMOPRU( TP_J:I, RG_J(0:1):I) -C Print the source list and the updates -C CALL NMOPRM( TP_J:I, RG_J(0:1):I, IMDL_B(0:*):I) -C Print the model line given in IMDL -C -C Include files: -C - INCLUDE 'WNG_DEF' - INCLUDE 'NMO_DEF' - INCLUDE 'MDU_O_DEF' !UPDATE AREA - INCLUDE 'MDH_O_DEF' !MODEL HEADER - INCLUDE 'MDL_O_DEF' !MODEL LINE -C -C Entries: -C -C -C Parameters: -C -C -C Arguments: -C - INTEGER TP !OUTPUT DEVICES - INTEGER RG(0:1) !RANGE TO DO - INTEGER IX !SOURCE LIST INDEX - BYTE IMDL(0:*) !MODEL TO PRINT -C -C Function references: -C -C -C Data declarations: -C - BYTE MDL(0:MDLHDL-1) !SOURCE ENTRY - INTEGER MDLJ(0:MDLHDL/LB_J-1) - REAL MDLE(0:MDLHDL/LB_E-1) - EQUIVALENCE (MDL,MDLJ,MDLE) - BYTE MDL1(0:MDLHDL-1) !SOURCE ENTRY - INTEGER MDL1J(0:MDLHDL/LB_J-1) - REAL MDL1E(0:MDLHDL/LB_E-1) - EQUIVALENCE (MDL1,MDL1J,MDL1E) - BYTE MDL2(0:MDLHDL-1) !SOURCE ENTRY - INTEGER MDL2J(0:MDLHDL/LB_J-1) - REAL MDL2E(0:MDLHDL/LB_E-1) - EQUIVALENCE (MDL2,MDL2J,MDL2E) - INTEGER LIX !LOCAL SOURCE LIST INDEX - LOGICAL LRA !PRINT RA/DEC FORMAT - LOGICAL LTOT !TOTAL ONLY - LOGICAL LUPD !PRINT UPDATES - LOGICAL LMDL !GIVEN MODEL - REAL RMAX,RMIN,RTOT !STATISTICS - INTEGER RCNT,RDEL - INTEGER JP,SP0,SP1 !UPDATE POINTER - CHARACTER*8 CHINST(0:MDHNIN-1) !INSTRUMENTS - DATA CHINST /'WSRT','ATCA','Unknown','Unknown', - 1 'Unknown','Unknown','Unknown','Unknown'/ -C- -C -C INIT -C - LRA=.FALSE. !NORMAL FORMAT - LTOT=.FALSE. - GOTO 10 -C -C NMOPTT -C - ENTRY NMOPTT(TP,RG) -C - LRA=.FALSE. !NORMAL FORMAT - LTOT=.TRUE. !TOTAL ONLY - GOTO 10 -C -C NMOPTI -C - ENTRY NMOPTI(TP,RG,IX) -C - LRA=.FALSE. !NORMAL FORMAT - LTOT=.TRUE. !TOTAL ONLY - LIX=IX !LIST INDEX - LUPD=.FALSE. !NOT UPDATE - LMDL=.FALSE. !NOT LOCAL MODEL - GOTO 13 -C -C NMOPRR -C - ENTRY NMOPRR(TP,RG) -C - IF (GDESJ(MDH_TYP_J).LE.0) THEN - CALL WNCTXT(TP,'!/Cannot show RA/DEC for local mode list!/') - RETURN - END IF - LRA=.TRUE. !RA/DEC FORMAT - LTOT=.FALSE. !NOT TOTAL ONLY - GOTO 10 -C -C NMOPRU -C - ENTRY NMOPRU(TP,RG) -C - LRA=.FALSE. !NORMAL FORMAT - LTOT=.FALSE. !NO TOTAL ONLY - LUPD=.TRUE. !PRINT UPDATES - GOTO 11 -C -C NMOPRM -C - ENTRY NMOPRM(TP,RG,IMDL) -C - LRA=.FALSE. !NORMAL FORMAT - LTOT=.FALSE. !NO TOTAL ONLY - LUPD=.FALSE. !NO UPDATE - LMDL=.TRUE. !GIVEN MODEL - GOTO 12 -C -C HEADINGS -C - 10 CONTINUE - LUPD=.FALSE. !NO UPDATES - 11 CONTINUE - LMDL=.FALSE. !NO GIVEN MODEL - 12 CONTINUE - LIX=-1 !GENERAL INDEX - 13 CONTINUE - IF (.NOT.LTOT .AND. .NOT.LMDL) THEN - IF (.NOT.LRA) THEN - CALL WNCFHD(TP,5,' # I l m '// - 1 'ID Q U V long short '// - 1 ' PA S.I. R.M. - ') - CALL WNCFHD(TP,6,' W.U. arcsec arcsec '// - 1 ' % % % arcsec arcsec'// - 1 ' deg r/m2 ') - CALL WNCFHD(TP,7,' ') - CALL WNCTXT(TP,'!/ # I l m '// - 1 'ID Q U V long short '// - 1 ' PA S.I. R.M. - ') - CALL WNCTXT(TP,' W.U. arcsec arcsec '// - 1 ' % % % arcsec arcsec'// - 1 ' deg r/m2 ') - ELSE - CALL WNCFHD(TP,5,' # I RA DEC '// - 1 ' ID '// - 1 ' Q U V long short PA'// - 1 ' S.I. R.M. - ') - CALL WNCFHD(TP,6,' W.U. '// - 1 ' '// - 1 ' % % % arcsec arcsec deg'// - 1 ' r/m2 ') - CALL WNCFHD(TP,7,' ') - CALL WNCTXT(TP,'!/ # I RA DEC '// - 1 ' ID '// - 1 ' Q U V long short PA'// - 1 ' S.I. R.M. - ') - CALL WNCTXT(TP,' W.U. '// - 1 ' '// - 1 ' % % % arcsec arcsec deg'// - 1 ' r/m2 ') - END IF - END IF -C -C SHOW TYPE -C - IF (.NOT.LMDL) THEN - IF (GMDHJ(MDH_TYP_J,LIX).EQ.0) THEN - CALL WNCTXT(TP,'!/Source list in local mode for !AS!/', - 1 CHINST(IAND(MDHINS_M,GMDHJ(MDH_BITS_J,LIX)))) - ELSE IF (GMDHJ(MDH_TYP_J,LIX).EQ.2) THEN - CALL WNCTXT(TP,'!/Sources at epoch !E9.0 at !32C!DHF8, !DDF7, '// - 1 '!D12.3 MHz for !AS', - 1 GMDHE(MDH_EPOCH_E,LIX), GMDHD(MDH_RA_D,LIX), - 1 GMDHD(MDH_DEC_D,LIX), GMDHD(MDH_FRQ_D,LIX), - 1 CHINST(IAND(MDHINS_M, GMDHJ(MDH_BITS_J,LIX)))) - CALL WNCTXT(TP,'!31C!10$DPF10.5, !10$DAF10.5!/', - 1 GMDHD(MDH_RA_D,LIX), GMDHD(MDH_DEC_D,LIX)) - ELSE - CALL WNCTXT(TP,'!/Apparent sources at !32C!DHF8, !DDF7, '// - 1 '!D12.3 MHz for !AS', - 1 GMDHD(MDH_RA_D,LIX), - 1 GMDHD(MDH_DEC_D,LIX),GMDHD(MDH_FRQ_D,LIX), - 1 CHINST(IAND(MDHINS_M,GMDHJ(MDH_BITS_J,LIX)))) - CALL WNCTXT(TP,'!31C!10$DPF10.5, !10$DAF10.5!/', - 1 GMDHD(MDH_RA_D,LIX), GMDHD(MDH_DEC_D,LIX)) - END IF - END IF -C -C LIST SOURCES -C - RCNT=0 !COUNT SOURCES - RDEL=0 - RMAX=-1E20 - RMIN=1E20 - RTOT=0 - IF (LMDL) THEN !GIVEN MODEL - J=RG(1) - ELSE - J=GMDHJ(MDH_NSRC_J,LIX) - END IF - DO I=MAX(1,RG(0))-1,MIN(RG(1),J)-1 - IF (LMDL) THEN !GIVEN MODEL - CALL WNGMV(MDLHDL,IMDL,MDL) !GET SOURCE - ELSE - CALL WNGMV(MDLHDL,A_B(GMDHJ(MDH_MODP_J,LIX)+I*MDLHDL-A_OB), - 1 MDL) !GET SOURCE - END IF - IF (MDLE(MDL_I_E).EQ.0) THEN - RDEL=RDEL+1 !COUNT - IF (.NOT.LTOT) THEN - CALL WNCTXT(TP,'!5$UJ!10$E10.3', - 1 I+1,0.) - END IF - ELSE - RTOT=RTOT+MDLE(MDL_I_E) !STATISTICS - RMAX=MAX(RMAX,ABS(MDLE(MDL_I_E))) - RMIN=MIN(RMIN,ABS(MDLE(MDL_I_E))) - RCNT=RCNT+1 - IF (.NOT.LTOT) THEN - IF (.NOT.LRA) THEN - CALL NMOEXT(MDL) !MAKE CORRECT FORMAT - IF (LUPD) THEN - JP=MDLJ(MDL_RS_E) !SAVE UPDATE BUFFER - MDLE(MDL_RS_E)=0 - END IF - CALL WNCTXT(TP,'!5$UJ!10$E10.3!9$E12.2!9$E12.2'// - 1 '!6$UJ\-!1$XB!1$XB'// - 1 '!6$E9.1!6$E9.1!6$E9.2'// - 1 '!7$E8.2!7$E8.2!5$E6.0'// - 1 '!6$E9.2!9$E9.2!9$E9.2', - 1 I+1,MDLE(MDL_I_E),MDLE(MDL_L_E),MDLE(MDL_M_E), - 1 MDLJ(MDL_ID_J),MDL(MDL_TP_B),MDL(MDL_TP1_B), - 1 MDLE(MDL_Q_E),MDLE(MDL_U_E),MDLE(MDL_V_E), - 1 MDLE(MDL_EXT_E),MDLE(MDL_EXT_E+1), - 1 MDLE(MDL_EXT_E+2), - 1 MDLE(MDL_SI_E),MDLE(MDL_RM_E),0.) - IF (LUPD) THEN - MDLJ(MDL_RS_E)=JP !RESTORE UPDATE BUFFER - END IF - IF (LUPD .AND. JP.NE.0) THEN !SHOW UPDATES - J0=A_J(JP+MDU_OFF_J) !OFFSET THIS ONE - DO WHILE(A_J(JP+MDU_RAR_J).NE.0) - JP=A_J(JP+MDU_RAR_J) !FIND CORRECT CALCULATION AREA - END DO - SP0=A_J(JP+MDU_SOL_J)+J0*A_J(JP+MDU_NUN_J) !SOLUTION - SP1=SP0+A_J(JP+MDU_NUN_J)*A_J(JP+MDU_NSRC_J) - R0=MDLE(MDL_I_E) !SAVE I - IF (IAND(A_J(JP+MDU_TYPE_J),MDU_T_ILM).NE.0) THEN !NORMAL - CALL WNCTXT(TP,'!9C!10$E10.3!9$E12.2!9$E12.2', - 1 A_E(SP0+0),A_E(SP0+1),A_E(SP0+2)) - IF (IAND(A_J(JP+MDU_TYPE_J),MDU_M_LOOP).EQ.0) THEN - CALL WNCTXT(TP,'!9C!10$E10.3!9$E12.2!9$E12.2', - 1 A_E(SP1+0),A_E(SP1+1),A_E(SP1+2)) - END IF - ELSE IF (IAND(A_J(JP+MDU_TYPE_J),MDU_T_I).NE.0) THEN !I - CALL WNCTXT(TP,'!9C!10$E10.3', - 1 A_E(SP0+0)) - IF (IAND(A_J(JP+MDU_TYPE_J),MDU_M_LOOP).EQ.0) THEN - CALL WNCTXT(TP,'!9C!10$E10.3', - 1 A_E(SP1+0)) - END IF - ELSE IF (IAND(A_J(JP+MDU_TYPE_J),MDU_T_LM).NE.0) THEN !LM - CALL WNCTXT(TP,'!19C!9$E12.2!9$E12.2', - 1 A_E(SP0+0),A_E(SP0+1)) - IF (IAND(A_J(JP+MDU_TYPE_J),MDU_M_LOOP).EQ.0) THEN - CALL WNCTXT(TP,'!19C!9$E12.2!9$E12.2', - 1 A_E(SP1+0),A_E(SP1+1)) - END IF - ELSE IF (IAND(A_J(JP+MDU_TYPE_J),MDU_T_SILM).NE.0) THEN !SI - CALL WNCTXT(TP,'!9C!10$E10.3!9$E12.2!9$E12.2!83C!6$E9.2', - 1 A_E(SP0+0),A_E(SP0+1),A_E(SP0+2),A_E(SP0+3)) - IF (IAND(A_J(JP+MDU_TYPE_J),MDU_M_LOOP).EQ.0) THEN - CALL WNCTXT(TP,'!9C!10$E10.3!9$E12.2!9$E12.2!83C!6$E9.2', - 1 A_E(SP1+0),A_E(SP1+1),A_E(SP1+2),A_E(SP1+3)) - END IF - ELSE IF (IAND(A_J(JP+MDU_TYPE_J),MDU_T_EXT).NE.0) THEN - CALL WNGMVZ(MDLHDL,MDL1) !PREPARE PRINT - CALL WNGMVZ(MDLHDL,MDL2) - DO I1=0,2 - MDL1E(MDL_EXT_E+I1)=A_E(SP0+I1) - MDL2E(MDL_EXT_E+I1)=A_E(SP1+I1) - END DO - CALL NMOEXT(MDL1) - CALL NMOEXT(MDL2) - CALL WNCTXT(TP,'!64C!7$E8.2!7$E8.2!5$E6.0', - 1 MDL1E(MDL_EXT_E+0),MDL1E(MDL_EXT_E+1), - 1 MDL1E(MDL_EXT_E+2)) - IF (IAND(A_J(JP+MDU_TYPE_J),MDU_M_LOOP).EQ.0) THEN - CALL WNCTXT(TP,'!64C!7$E8.2!7$E8.2!5$E6.0', - 1 MDL2E(MDL_EXT_E+0),MDL2E(MDL_EXT_E+1), - 1 MDL2E(MDL_EXT_E+2)) - END IF - ELSE IF (IAND(A_J(JP+MDU_TYPE_J),MDU_T_QUV).NE.0) THEN !POL - IF (R0.NE.0) THEN - CALL WNCTXT(TP,'!45C!6$E9.1!6$E9.1!6$E9.2', - 1 100*A_E(SP0+0)/R0, - 1 100*A_E(SP0+1)/R0, - 1 100*A_E(SP0+2)/R0) - IF (IAND(A_J(JP+MDU_TYPE_J),MDU_M_LOOP).EQ.0) THEN - CALL WNCTXT(TP,'!45C!6$E9.1!6$E9.1!6$E9.2', - 1 100*A_E(SP1+0)/R0, - 1 100*A_E(SP1+1)/R0, - 1 100*A_E(SP1+2)/R0) - END IF - END IF - ELSE !EXTENSION !!! - END IF - END IF - ELSE - CALL WNMCLM(GMDHD(MDH_RA_D,LIX),GMDHD(MDH_DEC_D,LIX), - 1 MDLE(MDL_L_E),MDLE(MDL_M_E),D0,D1) !MAKE RA/DEC - CALL NMOEXT(MDL) !MAKE CORRECT FORMAT - CALL WNCTXT(TP,'!5$UJ!10$E10.3!13$DHF8!13$DDF8'// - 1 '!6$UJ\-!1$XB!1$XB'// - 1 '!6$E9.1!6$E9.1!6$E9.2'// - 1 '!7$E8.2!7$E8.2!5$E6.0'// - 1 '!6$E9.2!9$E9.2!9$E9.2', - 1 I+1,MDLE(MDL_I_E),D0,D1, - 1 MDLJ(MDL_ID_J),MDL(MDL_TP_B),MDL(MDL_TP1_B), - 1 MDLE(MDL_Q_E),MDLE(MDL_U_E),MDLE(MDL_V_E), - 1 MDLE(MDL_EXT_E),MDLE(MDL_EXT_E+1), - 1 MDLE(MDL_EXT_E+2), - 1 MDLE(MDL_SI_E),MDLE(MDL_RM_E),0.) - END IF - END IF - END IF - END DO -C -C SHOW TOTAL -C - IF (.NOT.LMDL) THEN - IF (RCNT.EQ.0) THEN - RMAX=0. - RMIN=0. - END IF - CALL WNCTXT(TP,'!/!UJ sources (!UJ deleted) with !E10.3 W.U.'// - 1 ' (Max= !E10.3, Min= !E10.3)!/', - 1 RCNT+RDEL,RDEL,RTOT,RMAX,RMIN) - END IF -C -C FINISH -C - IF (.NOT.LTOT .AND. .NOT.LMDL) THEN !RESET HEADINGS - CALL WNCFHD(TP,-5,' ') - CALL WNCFHD(TP,-6,' ') - CALL WNCFHD(TP,-7,' ') - END IF -C - RETURN -C -C - END diff --git a/src/nscan/nmords.for b/src/nscan/nmords.for deleted file mode 100644 index cf988392ce4b3177f998794c0ccb621f37634a9a..0000000000000000000000000000000000000000 --- a/src/nscan/nmords.for +++ /dev/null @@ -1,372 +0,0 @@ -C+ NMORDS.FOR -C WNB 900827 -C -C Revisions: -C WNB 910806 RDD typo new count -C WNB 920317 Typo in RDZ and change RDC for looping in NMOMSC -C HjV 920520 HP does not allow extended source lines -C WNB 920609 Copy header data for RDD -C WNB 920825 Typo in RDD comparisons -C WNB 921208 Add RDA -C WNB 931005 Change L_ -C WNB 931008 Change NMOCVS call -C WNB 931119 Change NMOCVS call -C WNB 940301 Correct test for equal Q,U,V in RDD -C - LOGICAL FUNCTION NMORDS(FCA) -C -C Read a source model -C -C Result: -C -C NMORDS_L = NMORDS( FCA_J:I) -C Read the source list from FCA and add it to -C the general list. -C NMORDX_L = NMORDX( FCA_J:I, DAD_J:I, IDX_J:I) -C Read a source list from FCA at DAD into -C header # IDX. -C NMORDM_L = NMORDM( IDXI_J:I, IDXO_J:I) -C Add sources in header # IDXI to IDXO, empty IDXI -C NMORDA_L = NMORDA( IDXI_J:I, IDXO_J:I, NIN_J:I) -C Add sources in header # IDXI to IDXO, -C starting at number NIN -C NMORDC_L = NMORDC( IDXI_J:I, IDXO_J:I) -C Copy sources from header # IDXI to IDXO -C NMORDZ_L = NMORDZ( IDXI_J:I) -C Zero source list in header # IDXI -C NMORDD_L = NMORDD( OX_J:I, NX_J:I, DX_J:I) -C Determine the difference in header DX between -C NX-OX source list headers. -C NMORDH_L = NMORDH( IDXI_J:I, STP_J:O, SRA_D:O, SDEC_D:O, SFRQ_D:O) -C Get some header information from header # IDXI -C -C Include files: -C - INCLUDE 'WNG_DEF' - INCLUDE 'NMO_DEF' - INCLUDE 'GFH_O_DEF' !GENERAL FILE HEADER - INCLUDE 'MDH_O_DEF' !MODEL HEADER - INCLUDE 'MDL_O_DEF' !MODEL LINE -C -C Entries: -C - LOGICAL NMORDX,NMORDM,NMORDC,NMORDZ - LOGICAL NMORDD,NMORDH,NMORDA -C -C Parameters: -C -C -C Arguments: -C - INTEGER FCA !FILE TO WRITE TO - INTEGER DAD !DISK ADDRESS - INTEGER IDX,IDXI,IDXO !HEADER INDICES - INTEGER OX,NX,DX !HEADER INDICES - INTEGER NIN !START NUMBER SOURCE - INTEGER STP !SOURCE TYPE - REAL*8 SRA,SDEC,SFRQ !SOURCE DATA VALUES -C -C Function references: -C - LOGICAL WNFRD !READ FILE - LOGICAL NMOCVS !CONVERT SOURCE LIST - LOGICAL NMOSLG !GET SOURCE LIST -C -C Data declarations: -C - INTEGER GFHJ(0:GFHHDL/4-1) !GENERAL FILE HEADER - LOGICAL RDS !TYPE - INTEGER DPTR !DISK POINTER - INTEGER LIDX !HEADER # - INTEGER PE1,PE2,PE3 !MODEL POINTERS -C- - RDS=.TRUE. !INDICATE RDS - DPTR=GFHHDL !DISK POINTER - LIDX=7 !WHERE TO READ - GOTO 10 -C -C NMORDX -C - ENTRY NMORDX(FCA,DAD,IDX) -C - RDS=.FALSE. !TYPE - DPTR=DAD !DISK POINTER - LIDX=IDX !WHERE TO PUT - GOTO 10 -C -C INIT -C - 10 CONTINUE - NMORDS=.TRUE. !ASSUME OK - CALL NMOHZD(GMDH(0,LIDX)) !CLEAR HEADER -C -C READ SOURCES -C - IF (RDS) THEN - IF (.NOT.WNFRD(FCA,GFHHDL,GFHJ,0)) GOTO 900 !READ FILE HEADER - IF (GFHJ(GFH_LINK_J).EQ.GFH_LINK_1) DPTR=0 !NO MODEL PRESENT - END IF - IF (DPTR.NE.0) THEN !PRESENT - IF (.NOT.WNFRD(FCA,MDHHDL,GMDH(0,LIDX),DPTR)) GOTO 900 !READ HEADER - IF (GMDHJ(MDH_MODL_J,LIDX).NE.MDHHDV) THEN !WRONG VERSION - CALL WNCTXT(F_TP,'!/Wrong source model version,'// - 1 ' use NVS first') - GOTO 900 - END IF - J1=GMDHJ(MDH_MODP_J,LIDX) !DISK POINTER - GMDHJ(MDH_MODP_J,LIDX)=0 !SET NOT IN CORE - GMDHJ(MDH_MODL_J,LIDX)=0 - IF (.NOT.NMOSLG(GMDHJ(MDH_NSRC_J,LIDX),GMDH(0,LIDX))) GOTO 901 !SPACE - J0=GMDHJ(MDH_MODP_J,LIDX)-A_OB !OUTPUT POINTER - IF (.NOT.WNFRD(FCA,GMDHJ(MDH_NSRC_J,LIDX)*MDLHDL, - 1 A_B(J0),J1)) GOTO 900 !READ SOURCES - END IF -C - IF (RDS) CALL WNFCL(FCA) !CLOSE FILE -C - RETURN -C -C NMORDM -C - ENTRY NMORDM(IDXI,IDXO) -C - NMORDM=.TRUE. !ASSUME OK - RDS=.FALSE. !NOT RDS - LIDX=IDXI !FOR ERROR - IF (GMDHJ(MDH_TYP_J,IDXO).EQ.0) THEN !GENERAL=LOCAL TYPE - CALL NMOHMD(GMDH(0,IDXI),GMDH(0,IDXO)) !COPY HEADER DATA - ELSE IF (GMDHJ(MDH_TYP_J,IDXI).EQ.0) THEN !LEAVE TYPE (READ=LOCAL) - ELSE - IF (.NOT.NMOCVS(GMDH(0,IDXI),GMDH(0,IDXO), - 1 0.,0)) GOTO 901 !CONVERT TYPE - END IF - IF (.NOT.NMOSLG(GMDHJ(MDH_NSRC_J,IDXO)+ - 1 GMDHJ(MDH_NSRC_J,IDXI),GMDH(0,IDXO))) GOTO 901 !SPACE - J0=GMDHJ(MDH_MODP_J,IDXI)-A_OB !INPUT POINTER - J1=GMDHJ(MDH_MODP_J,IDXO)+GMDHJ(MDH_NSRC_J,IDXO)*MDLHDL- - 1 A_OB !OUTPUT POINTER - CALL WNGMV(GMDHJ(MDH_NSRC_J,IDXI)*MDLHDL,A_B(J0),A_B(J1)) !MOVE SOURCES - GMDHJ(MDH_NSRC_J,IDXO)=GMDHJ(MDH_NSRC_J,IDXO)+ - 1 GMDHJ(MDH_NSRC_J,IDXI) !COUNT SOURCE -C - CALL NMOSLD(GMDH(0,IDXI)) !DELETE HEADER -C - RETURN -C -C NMORDA -C - ENTRY NMORDA(IDXI,IDXO,NIN) -C - NMORDA=.TRUE. !ASSUME OK - RDS=.FALSE. !NOT RDS - LIDX=IDXI !FOR ERROR - IF (GMDHJ(MDH_TYP_J,IDXO).EQ.0) THEN !GENERAL=LOCAL TYPE - CALL NMOHMD(GMDH(0,IDXI),GMDH(0,IDXO)) !COPY HEADER DATA - ELSE IF (GMDHJ(MDH_TYP_J,IDXI).EQ.0) THEN !LEAVE TYPE (READ=LOCAL) - ELSE - IF (.NOT.NMOCVS(GMDH(0,IDXI),GMDH(0,IDXO), - 1 0.,0)) GOTO 901 !CONVERT TYPE - END IF - IF (.NOT.NMOSLG(GMDHJ(MDH_NSRC_J,IDXO)+1-NIN+ - 1 GMDHJ(MDH_NSRC_J,IDXI),GMDH(0,IDXO))) GOTO 901 !SPACE - J0=GMDHJ(MDH_MODP_J,IDXI)+(NIN-1)*MDLHDL-A_OB !INPUT POINTER - J1=GMDHJ(MDH_MODP_J,IDXO)+GMDHJ(MDH_NSRC_J,IDXO)*MDLHDL- - 1 A_OB !OUTPUT POINTER - CALL WNGMV((GMDHJ(MDH_NSRC_J,IDXI)-NIN+1)*MDLHDL, - 1 A_B(J0),A_B(J1)) !MOVE SOURCES - GMDHJ(MDH_NSRC_J,IDXO)=GMDHJ(MDH_NSRC_J,IDXO)+1-NIN+ - 1 GMDHJ(MDH_NSRC_J,IDXI) !COUNT SOURCE -C - RETURN -C -C NMORDC -C - ENTRY NMORDC(IDXI,IDXO) -C - NMORDC=.TRUE. !ASSUME OK - RDS=.FALSE. !FOR ERROR - LIDX=IDXO !FOR ERROR - CALL NMOHZD(GMDH(0,IDXO)) !ZERO OUTPUT - CALL NMOHMD(GMDH(0,IDXI),GMDH(0,IDXO)) !FILL HEADER - IF (.NOT.NMOSLG(GMDHJ(MDH_NSRC_J,IDXI),GMDH(0,IDXO))) GOTO 901 !SPACE - J0=GMDHJ(MDH_MODP_J,IDXI)-A_OB !INPUT POINTER - J1=GMDHJ(MDH_MODP_J,IDXO)-A_OB !OUTPUT POINTER - CALL WNGMV(GMDHJ(MDH_NSRC_J,IDXI)*MDLHDL,A_B(J0),A_B(J1)) !MOVE SOURCES - GMDHJ(MDH_NSRC_J,IDXO)=GMDHJ(MDH_NSRC_J,IDXI) !COUNT SOURCE -C - RETURN -C -C NMORDZ -C - ENTRY NMORDZ(IDXI) -C - NMORDZ=.TRUE. !ASSUME OK - CALL NMOHZD(GMDH(0,IDXI)) !ZERO OUTPUT -C - RETURN -C -C NMORDD -C - ENTRY NMORDD(OX,NX,DX) -C -C INIT -C - NMORDD=.TRUE. !ASSUME OK - RDS=.FALSE. !NOT RDS - LIDX=DX !FOR ERROR - CALL NMOHZD(GMDH(0,DX)) !ZERO OUTPUT - IF (.NOT.NMOSLG(GMDHJ(MDH_NSRC_J,OX)+ - 1 GMDHJ(MDH_NSRC_J,NX),GMDH(0,DX))) GOTO 900 !GET SPACE - CALL NMOHMD(GMDH(0,NX),GMDH(0,DX)) !FILL HEADER -C -C MERGE LISTS -C - J1=1 !NEW DATA - J2=1 !OLD DATA - PE1=(GMDHJ(MDH_MODP_J,NX)-A_OB)/LB_E !NEW DATA - PE2=(GMDHJ(MDH_MODP_J,OX)-A_OB)/LB_E !OLD DATA - PE3=(GMDHJ(MDH_MODP_J,DX)-A_OB)/LB_E !DIFFERENCE DATA - 33 CONTINUE - IF (J1.GT.GMDHJ(MDH_NSRC_J,NX)) THEN !END OF NEW LIST - 32 CONTINUE - IF (J2.GT.GMDHJ(MDH_NSRC_J,OX)) THEN !END OF OLD LIST - ELSE !DELETE FROM OLD LIST - CALL WNGMV(MDLHDL,A_E(PE2),A_E(PE3)) !SET OLD DATA - A_E(PE3+MDL_I_E)=-A_E(PE3+MDL_I_E) !-AMPL - GMDHJ(MDH_NSRC_J,DX)=GMDHJ(MDH_NSRC_J,DX)+1 !COUNT - PE3=PE3+MDLHDL/LB_E !POINTER - J2=J2+1 !NEXT OLD - PE2=PE2+MDLHDL/LB_E - GOTO 32 - END IF - ELSE IF (J2.GT.GMDHJ(MDH_NSRC_J,OX)) THEN !SET NEW DATA - CALL WNGMV(MDLHDL,A_E(PE1),A_E(PE3)) !SET NEW DATA - GMDHJ(MDH_NSRC_J,DX)=GMDHJ(MDH_NSRC_J,DX)+1 !COUNT - PE3=PE3+MDLHDL/LB_E !POINTER - J1=J1+1 !NEXT NEW - PE1=PE1+MDLHDL/LB_E - GOTO 33 - ELSE !OLD AND NEW PRESENT - IF (ABS(A_E(PE1+MDL_L_E)-A_E(PE2+MDL_L_E)) - 1 .LT.1E-8 .AND. !SAME L - 1 ABS(A_E(PE1+MDL_M_E)-A_E(PE2+MDL_M_E)) - 1 .LT.1E-8) THEN !SAME M - IF (ABS(A_E(PE1+MDL_SI_E)-A_E(PE2+MDL_SI_E)) - 1 .LT.1E-3 .AND. !SAME SI - 1 ABS(A_E(PE1+MDL_RM_E)-A_E(PE2+MDL_RM_E)) - 1 .LT.1E-3 .AND. !SAME RM - 1 A_B(PE1*LB_E+MDL_TP_B).EQ. - 1 A_B(PE2*LB_E+MDL_TP_B) .AND. !SAME CLEAN - 1 ABS(A_E(PE1+MDL_EXT_E+0)-A_E(PE2+MDL_EXT_E+0)) - 1 .LT.1E-8 .AND. !SAME EXTENT - 1 ABS(A_E(PE1+MDL_EXT_E+1)-A_E(PE2+MDL_EXT_E+1)) - 1 .LT.1E-8 .AND. - 1 ABS(A_E(PE1+MDL_EXT_E+2)-A_E(PE2+MDL_EXT_E+2)) - 1 .LT.1E-8) THEN - IF (ABS(A_E(PE1+MDL_I_E)-A_E(PE2+MDL_I_E)) - 1 .LT.1E-4) THEN !SAME AMPL. - IF (ABS(A_E(PE1+MDL_Q_E)-A_E(PE2+MDL_Q_E)) - 1 .LT.1E-4 .AND. !SAME Q - 1 ABS(A_E(PE1+MDL_U_E)-A_E(PE2+MDL_U_E)) - 1 .LT.1E-4 .AND. !SAME U - 1 ABS(A_E(PE1+MDL_V_E)-A_E(PE2+MDL_V_E)) - 1 .LT.1E-4) THEN !SAME V - 34 CONTINUE - J1=J1+1 !SKIP NEW - PE1=PE1+MDLHDL/LB_E - J2=J2+1 !SKIP OLD - PE2=PE2+MDLHDL/LB_E - GOTO 33 !NEXT SRC - ELSE !SET NEW AND OLD - 35 CONTINUE - CALL WNGMV(MDLHDL,A_E(PE1),A_E(PE3)) !SAVE NEW - J1=J1+1 - PE1=PE1+MDLHDL/LB_E - GMDHJ(MDH_NSRC_J,DX)=GMDHJ(MDH_NSRC_J,DX)+1 !COUNT - PE3=PE3+MDLHDL/LB_E - CALL WNGMV(MDLHDL,A_E(PE2),A_E(PE3)) !SAVE OLD - A_E(PE3+MDL_I_E)=-A_E(PE3+MDL_I_E) !AMPL. - J2=J2+1 - PE2=PE2+MDLHDL/LB_E - GMDHJ(MDH_NSRC_J,DX)=GMDHJ(MDH_NSRC_J,DX)+1 !COUNT - PE3=PE3+MDLHDL/LB_E - GOTO 33 !NEXT SOURCE - END IF - ELSE !DIFFERENT AMPL - CALL WNGMV(MDLHDL,A_E(PE2),A_E(PE3)) !COMBINE OLD/NEW - A_E(PE3+MDL_I_E)=A_E(PE1+MDL_I_E)- - 1 A_E(PE2+MDL_I_E) !NEW AMPL - A_E(PE3+MDL_Q_E)=(A_E(PE1+MDL_Q_E)*A_E(PE1+MDL_I_E)- - 1 A_E(PE2+MDL_Q_E)*A_E(PE2+MDL_I_E))/ - 1 A_E(PE3+MDL_I_E) !NEW Q - A_E(PE3+MDL_U_E)=(A_E(PE1+MDL_U_E)*A_E(PE1+MDL_I_E)- - 1 A_E(PE2+MDL_U_E)*A_E(PE2+MDL_I_E))/ - 1 A_E(PE3+MDL_I_E) !NEW U - A_E(PE3+MDL_V_E)=(A_E(PE1+MDL_V_E)*A_E(PE1+MDL_I_E)- - 1 A_E(PE2+MDL_V_E)*A_E(PE2+MDL_I_E))/ - 1 A_E(PE3+MDL_I_E) !NEW V - GMDHJ(MDH_NSRC_J,DX)=GMDHJ(MDH_NSRC_J,DX)+1 !COUNT - PE3=PE3+MDLHDL/LB_E - GOTO 34 !NEXT SRC - END IF - ELSE !DIFFERENT SOURCES - GOTO 35 !SAVE NEW AND OLD - END IF - ELSE !DIFFERENT POS. - IF (ABS(A_E(PE1+MDL_M_E)-A_E(PE2+MDL_M_E)).LT. - 1 1E-8) THEN !SAME M - IF (A_E(PE1+MDL_L_E).GT.A_E(PE2+MDL_L_E)) THEN !NEW - 36 CONTINUE - CALL WNGMV(MDLHDL,A_E(PE1),A_E(PE3)) - GMDHJ(MDH_NSRC_J,DX)=GMDHJ(MDH_NSRC_J,DX)+1 !CNT SRC - PE3=PE3+MDLHDL/LB_E - J1=J1+1 !SKIP NEW - PE1=PE1+MDLHDL/LB_E - GOTO 33 !NEXT SRC - ELSE !OLD FIRST - 37 CONTINUE - CALL WNGMV(MDLHDL,A_E(PE2),A_E(PE3)) - GMDHJ(MDH_NSRC_J,DX)=GMDHJ(MDH_NSRC_J,DX)+1 !CNT SRC - A_E(PE3+MDL_I_E)=-A_E(PE3+MDL_I_E) !DELETE AMPL - PE3=PE3+MDLHDL/LB_E - J2=J2+1 !SKIP OLD - PE2=PE2+MDLHDL/LB_E - GOTO 33 !NEXT SOURCE - END IF - ELSE IF (A_E(PE1+MDL_M_E).GT.A_E(PE2+MDL_M_E)) THEN !NEW - GOTO 36 - ELSE - GOTO 37 !OLD FIRST - END IF - END IF !END POSITION - END IF !END NEW LIST -C - RETURN -C -C ERRORS -C - 900 CONTINUE - CALL WNCTXT(F_TP,'!/Error reading source file') - 901 CONTINUE - CALL WNCTXT(F_TP,'!/Source file not read') - NMORDS=.FALSE. !INDICATE ERROR - IF (RDS) CALL WNFCL(FCA) !CLOSE FILE - CALL NMOSLD(GMDH(0,LIDX)) !DELETE HEADER -C - RETURN -C -C NMORDH -C - ENTRY NMORDH(IDXI,STP,SRA,SDEC,SFRQ) -C - NMORDH=.TRUE. !ASSUME OK - STP=GMDHJ(MDH_TYP_J,IDXI) !TYPE - SRA=GMDHD(MDH_RA_D,IDXI) !RA - SDEC=GMDHD(MDH_DEC_D,IDXI) !DEC - SFRQ=GMDHD(MDH_FRQ_D,IDXI) !FREQ. -C - RETURN -C -C - END - diff --git a/src/nscan/nmosli.for b/src/nscan/nmosli.for deleted file mode 100644 index c058b244fd955e54a58c06f3b07eff0708cfae23..0000000000000000000000000000000000000000 --- a/src/nscan/nmosli.for +++ /dev/null @@ -1,115 +0,0 @@ -c+ NMOSLI.FOR -C WNB 900327 -C -C Revisions: -C - LOGICAL FUNCTION NMOSLI(NGSRC) -C -C Get general source list -C -C Result: -C -C NMOSLI_L = NMOSLI( NGSRC_J:I) get a general source list of at least -C NGSRC sources -C NMOSLG_L = NMOSLG( NGSRC_J:I, SDESJ_J(0:*):IO) get a source list with -C NGSRC entries, using SDESJ -C NMOSLD_L = NMOSLD( DSDESJ_J(0:*):IO) delete source list of DSDESJ -C -C Include files: -C - INCLUDE 'WNG_DEF' - INCLUDE 'NMO_DEF' - INCLUDE 'MDH_O_DEF' !MODEL HEADER - INCLUDE 'MDL_O_DEF' !MODEL LINE -C -C Parameters: -C -C -C Arguments: -C - INTEGER NGSRC !# OF SOURCES IN LIST - INTEGER SDESJ(0:*),DSDESJ(0:*) !SOURCE LIST HEADER -C -C Entry points: -C - LOGICAL NMOSLG !OBTAIN A SOURCELIST - LOGICAL NMOSLD !DELETE A SOURCE LIST -C -C Function references: -C - LOGICAL WNGGVM !GET VIRTUAL MEMORY -C -C Data declarations: -C -C- -C -C INIT SOURCE LIST -C - NMOSLI=.TRUE. !ASSUME OK - IF (NSRCM.LE.0) THEN !EMPTY GENERAL HEADER - CALL WNGMVZ(8*MDHHDL,GMDH(0,0)) !EMPTY HEADERS - END IF - IF (NGSRC.GT.NSRCM) THEN !GET AN AREA - IF(.NOT.WNGGVM(NGSRC*MDLHDL,J)) THEN !GET SOURCE AREA - 10 CONTINUE - CALL WNCTXT(F_TP,'!Cannot obtain source area') - NMOSLI=.FALSE. - RETURN - END IF - J2=GDESJ(MDH_MODP_J)-A_OB !ARRAY OFFSET OLD AREA - J1=J-A_OB !ARRAY OFFSET NEW AREA - CALL WNGMV(GDESJ(MDH_NSRC_J)*MDLHDL,A_B(J2),A_B(J1)) !MOVE SOURCES - IF (GDESJ(MDH_MODL_J).GT.0) !FREE OLD AREA - 1 CALL WNGFVM(GDESJ(MDH_MODL_J)*MDLHDL,GDESJ(MDH_MODP_J)) - GDESJ(MDH_MODL_J)=NGSRC !NEW LENGTH - GDESJ(MDH_MODP_J)=J !NEW MODEL AREA - NSRCM=NGSRC !CURRENT LENGTH - END IF -C - RETURN !READY -C -C GET A SOURCE LIST -C - ENTRY NMOSLG(NGSRC,SDESJ) -C - NMOSLG=.TRUE. !ASSUME OK - IF (NSRCM.LE.0) THEN !EMPTY GENERAL HEADER - CALL WNGMVZ(8*MDHHDL,GMDH(0,0)) !EMPTY HEADERS - IF(.NOT.WNGGVM(MDLHDL,J)) THEN !GET A SOURCE AREA - GOTO 10 - END IF - GDESJ(MDH_MODL_J)=1 !SET SOMETHING THERE - GDESJ(MDH_MODP_J)=J - NSRCM=1 - END IF - IF (NGSRC.GT.SDESJ(MDH_MODL_J)) THEN !GET AN AREA - IF(.NOT.WNGGVM(NGSRC*MDLHDL,J)) THEN !GET SOURCE AREA - GOTO 10 - END IF - J2=SDESJ(MDH_MODP_J)-A_OB !ARRAY OFFSET OLD AREA - J1=J-A_OB !ARRAY OFFSET NEW AREA - CALL WNGMV(MIN(SDESJ(MDH_MODL_J),SDESJ(MDH_NSRC_J))* - 1 MDLHDL,A_B(J2),A_B(J1)) - IF (SDESJ(MDH_MODL_J).GT.0) !FREE OLD - 1 CALL WNGFVM(SDESJ(MDH_MODL_J)*MDLHDL,SDESJ(MDH_MODP_J)) - SDESJ(MDH_MODL_J)=NGSRC !NEW LENGTH - SDESJ(MDH_MODP_J)=J !NEW AREA - END IF -C - RETURN !READY -C -C DELETE SOURCE LIST -C - ENTRY NMOSLD(DSDESJ) -C - NMOSLD=.TRUE. !ASSUME OK - IF (DSDESJ(MDH_MODL_J).GT.0) !FREE - 1 CALL WNGFVM(DSDESJ(MDH_MODL_J)*MDLHDL,DSDESJ(MDH_MODP_J)) - DSDESJ(MDH_MODL_J)=0 !NEW LENGTH - DSDESJ(MDH_MODP_J)=0 !NEW AREA - DSDESJ(MDH_NSRC_J)=0 !NO SOURCES -C - RETURN -C -C - END diff --git a/src/nscan/nmosr0.for b/src/nscan/nmosr0.for deleted file mode 100644 index dd88e42866882d4f7bea4d3ff98d321645cd97ad..0000000000000000000000000000000000000000 --- a/src/nscan/nmosr0.for +++ /dev/null @@ -1,218 +0,0 @@ -C+ NMOSR0.FOR -C WNB 900327 -C -C Revisions: -C - INTEGER FUNCTION NMOSR0(LST1,LST2) -C -C Sort the source list elements -C -C Result: -C -C ORDER_J = NMOSR0( LST1_E(*), LST2_E(*)) Sort the source list, -C decreasing intensity -C ORDER_J = NMOSR1( LST1_E(*), LST2_E(*)) Sort the source list, -C decreasing l,m -C ORDER_J = NMOSR2( LSTJ1_J(*), LSTJ2_J(*)) Sort the source list, -C J field -C ORDER_J = NMOSR3( LST1_E(*), LST2_E(*)) Sort the source list, -C E field -C ORDER_J = NMOSR4( LSTB1_B(*), LSTB2_B(*)) Sort the source list, -C B field -C ORDER_J = NMOSR5( LST1_E(*), LST2_E(*)) Sort the source list, -C distance -C ORDER_J = NMOSR6( LST1_E(*), LST2_E(*)) Sort the source list, -C lm -C ORDER_J = NMOSR7( LST1_E(*), LST2_E(*)) Sort the source list, -C ml -C ORDER_J = NMOSR8( LST1_E(*), LST2_E(*)) Sort the source list, -C polarised intensity -C -C Include files: -C - INCLUDE 'WNG_DEF' - INCLUDE 'NMO_DEF' - INCLUDE 'MDL_O_DEF' !MODEL LINE -C -C Parameters: -C -C -C Arguments: -C - REAL LST1(0:*) !ELEMENT 1 - REAL LST2(0:*) !ELEMENT 2 - INTEGER LSTJ1(0:*) !ELEMENT 1 - INTEGER LSTJ2(0:*) !ELEMENT 2 - BYTE LSTB1(0:*) !ELEMENT 1 - BYTE LSTB2(0:*) !ELEMENT 2 -C -C Function references: -C -C -C Entry points: -C - INTEGER NMOSR1 !SORT DECR. L,M - INTEGER NMOSR2 !SORT J FIELD - INTEGER NMOSR3 !SORT E FIELD - INTEGER NMOSR4 !SORT B FIELD - INTEGER NMOSR5 !SORT DISTANCE - INTEGER NMOSR6 !SORT LM - INTEGER NMOSR7 !SORT ML - INTEGER NMOSR8 !SORT POL. -C -C Data declarations: -C -C- -C -C SORT DECREASING INTENSITY -C - IF (LST1(MDL_I_E).EQ.LST2(MDL_I_E)) THEN !EQUAL - NMOSR0=0 - ELSE IF (LST1(MDL_I_E).GT.LST2(MDL_I_E)) THEN - NMOSR0=-1 - ELSE - NMOSR0=+1 - END IF -C - RETURN -C -C DECREASING L,M -C - ENTRY NMOSR1(LST1,LST2) -C - IF (LST1(MDL_M_E).EQ.LST2(MDL_M_E)) THEN !EQUAL M - IF (LST1(MDL_L_E).EQ.LST2(MDL_L_E)) THEN !EQUAL L - NMOSR1=0 - ELSE IF (LST1(MDL_L_E).GT.LST2(MDL_L_E)) THEN - NMOSR1=-1 - ELSE - NMOSR1=+1 - END IF - ELSE IF (LST1(MDL_M_E).GT.LST2(MDL_M_E)) THEN - NMOSR1=-1 - ELSE - NMOSR1=+1 - END IF -C - RETURN -C -C J FIELD -C - ENTRY NMOSR2(LSTJ1,LSTJ2) -C - IF (LSTJ1(SOROFF).EQ.LSTJ2(SOROFF)) THEN !EQUAL - NMOSR2=0 - ELSE IF (LSTJ1(SOROFF).GT.LSTJ2(SOROFF)) THEN - NMOSR2=SORTYP - ELSE - NMOSR2=-SORTYP - END IF -C - RETURN -C -C E FIELD -C - ENTRY NMOSR3(LST1,LST2) -C - IF (LST1(SOROFF).EQ.LST2(SOROFF)) THEN !EQUAL - NMOSR3=0 - ELSE IF (LST1(SOROFF).GT.LST2(SOROFF)) THEN - NMOSR3=SORTYP - ELSE - NMOSR3=-SORTYP - END IF -C - RETURN -C -C B FIELD -C - ENTRY NMOSR4(LSTB1,LSTB2) -C - IF (LSTB1(SOROFF).EQ.LSTB2(SOROFF)) THEN !EQUAL - NMOSR4=0 - ELSE IF (LSTB1(SOROFF).GT.LSTB2(SOROFF)) THEN - NMOSR4=SORTYP - ELSE - NMOSR4=-SORTYP - END IF -C - RETURN -C -C DISTANCE -C - ENTRY NMOSR5(LST1,LST2) -C - R0=SQRT((LST1(MDL_M_E)-SORRAN(1))**2+ - 1 (LST1(MDL_L_E)-SORRAN(0))**2) !DISTANCE - R1=SQRT((LST2(MDL_M_E)-SORRAN(1))**2+ - 1 (LST2(MDL_L_E)-SORRAN(0))**2) - IF (R0.EQ.R1) THEN !EQUAL DISTANCE - NMOSR5=0 - ELSE IF (R0.GT.R1) THEN - NMOSR5=SORTYP - ELSE - NMOSR5=-SORTYP - END IF -C - RETURN -C -C L,M -C - ENTRY NMOSR6(LST1,LST2) -C - IF (LST1(MDL_M_E).EQ.LST2(MDL_M_E)) THEN !EQUAL M - IF (LST1(MDL_L_E).EQ.LST2(MDL_L_E)) THEN !EQUAL L - NMOSR6=0 - ELSE IF (LST1(MDL_L_E).GT.LST2(MDL_L_E)) THEN - NMOSR6=SORTYP - ELSE - NMOSR6=-SORTYP - END IF - ELSE IF (LST1(MDL_M_E).GT.LST2(MDL_M_E)) THEN - NMOSR6=SORTYP - ELSE - NMOSR6=-SORTYP - END IF -C - RETURN -C -C M,L -C - ENTRY NMOSR7(LST1,LST2) -C - IF (LST1(MDL_L_E).EQ.LST2(MDL_L_E)) THEN !EQUAL L - IF (LST1(MDL_M_E).EQ.LST2(MDL_M_E)) THEN !EQUAL M - NMOSR7=0 - ELSE IF (LST1(MDL_M_E).GT.LST2(MDL_M_E)) THEN - NMOSR7=SORTYP - ELSE - NMOSR7=-SORTYP - END IF - ELSE IF (LST1(MDL_L_E).GT.LST2(MDL_L_E)) THEN - NMOSR7=SORTYP - ELSE - NMOSR7=-SORTYP - END IF -C - RETURN -C -C POLARISATION -C - ENTRY NMOSR8(LST1,LST2) -C - R0=SQRT(LST1(MDL_Q_E)**2+LST1(MDL_U_E)**2+ - 1 LST1(MDL_V_E)**2)*LST1(MDL_I_E) !POL. - R1=SQRT(LST2(MDL_Q_E)**2+LST2(MDL_U_E)**2+ - 1 LST2(MDL_V_E)**2)*LST2(MDL_I_E) - IF (R0.EQ.R1) THEN !EQUAL POL. - NMOSR8=0 - ELSE IF (R0.GT.R1) THEN - NMOSR8=SORTYP - ELSE - NMOSR8=-SORTYP - END IF -C - RETURN -C -C - END diff --git a/src/nscan/nmosrt.for b/src/nscan/nmosrt.for deleted file mode 100644 index 465a7c27277b1ca1e2263c2ffd205c948d3bdc82..0000000000000000000000000000000000000000 --- a/src/nscan/nmosrt.for +++ /dev/null @@ -1,137 +0,0 @@ -C+ NMOSRT.FOR -C WNB 900327 -C -C Revisions: -C - SUBROUTINE NMOSRT(TP,SDESJ) -C -C Sort a source list -C -C Result: -C -C CALL NMOSRT( TP_J:I, SDESJ_J(0:*):I) -C Sort the source list described by SDESJ. -C It will be adjusted for deleted entries. -C TP=-1 Deleted entreis only -C TP=0: Decreasing intensity -C TP=1: Decreasing l,m -C TP=2: J field -C TP=3: E field -C TP=4: B field -C TP=5: distance -C TP=6: l,m -C TP=7: m,l -C TP=8: polarisation -C else: Decreasing intensity -C -C -C -C Include files: -C - INCLUDE 'WNG_DEF' - INCLUDE 'MDH_O_DEF' !MODEL HEADER - INCLUDE 'MDL_O_DEF' !MODEL LINE -C -C Parameters: -C -C -C Arguments: -C - INTEGER TP !SORTING TYPE - INTEGER SDESJ(0:*) !SOURCE LIST HEADER -C -C Function references: -C - EXTERNAL NMOSR0,NMOSR1,NMOSR2,NMOSR3, !SORT ROUTINES - 1 NMOSR4,NMOSR5,NMOSR6,NMOSR7,NMOSR8 -C -C Data declarations: -C -C- -C -C DELETE SOURCES WITH I=0 -C - DO I=SDESJ(MDH_NSRC_J)-1,0,-1 !DELETE SOURCES WITH I=0 - J1=(SDESJ(MDH_MODP_J)+I*MDLHDL-A_OB)/(L_E/L_B) !ARRAY POINTER - IF (A_E(J1+MDL_I_E).EQ.0) THEN - DO I1=I+1,SDESJ(MDH_NSRC_J)-1 - J2=(SDESJ(MDH_MODP_J)+I1*MDLHDL-A_OB) !ARRAY POINTER - CALL WNGMV(MDLHDL,A_B(J2),A_B(J2-MDLHDL)) !DO DELETE - END DO - SDESJ(MDH_NSRC_J)=SDESJ(MDH_NSRC_J)-1 - END IF - END DO -C - IF (SDESJ(MDH_NSRC_J).LT.1) RETURN !READY -C -C -C NO SORT -C - IF (TP.EQ.-1) THEN -C -C SORT ON DECREASING INTENSITY -C - ELSE IF (TP.EQ.0) THEN - CALL WNGSRT(A_B(SDESJ(MDH_MODP_J)-A_OB), - 1 SDESJ(MDH_NSRC_J),MDLHDL,NMOSR0) !DO SORT -C -C SORT ON DECREASING L,M -C - ELSE IF (TP.EQ.1) THEN - CALL WNGSRT(A_B(SDESJ(MDH_MODP_J)-A_OB), - 1 SDESJ(MDH_NSRC_J),MDLHDL,NMOSR1) !DO SORT -C -C SORT ON J FIELD -C - ELSE IF (TP.EQ.2) THEN - CALL WNGSRT(A_B(SDESJ(MDH_MODP_J)-A_OB), - 1 SDESJ(MDH_NSRC_J),MDLHDL,NMOSR2) !DO SORT -C -C SORT ON E FIELD -C - ELSE IF (TP.EQ.3) THEN - CALL WNGSRT(A_B(SDESJ(MDH_MODP_J)-A_OB), - 1 SDESJ(MDH_NSRC_J),MDLHDL,NMOSR3) !DO SORT -C -C SORT ON B FIELD -C - ELSE IF (TP.EQ.4) THEN - CALL WNGSRT(A_B(SDESJ(MDH_MODP_J)-A_OB), - 1 SDESJ(MDH_NSRC_J),MDLHDL,NMOSR4) !DO SORT -C -C SORT ON DISTANCE -C - ELSE IF (TP.EQ.5) THEN - CALL WNGSRT(A_B(SDESJ(MDH_MODP_J)-A_OB), - 1 SDESJ(MDH_NSRC_J),MDLHDL,NMOSR5) !DO SORT -C -C SORT ON L,M -C - ELSE IF (TP.EQ.6) THEN - CALL WNGSRT(A_B(SDESJ(MDH_MODP_J)-A_OB), - 1 SDESJ(MDH_NSRC_J),MDLHDL,NMOSR6) !DO SORT -C -C SORT ON M,L -C - ELSE IF (TP.EQ.7) THEN - CALL WNGSRT(A_B(SDESJ(MDH_MODP_J)-A_OB), - 1 SDESJ(MDH_NSRC_J),MDLHDL,NMOSR7) !DO SORT -C -C SORT ON POLARISATION -C - ELSE IF (TP.EQ.8) THEN - CALL WNGSRT(A_B(SDESJ(MDH_MODP_J)-A_OB), - 1 SDESJ(MDH_NSRC_J),MDLHDL,NMOSR8) !DO SORT -C -C SORT ON DECREASING INTENSITY -C - ELSE - CALL WNGSRT(A_B(SDESJ(MDH_MODP_J)-A_OB), - 1 SDESJ(MDH_NSRC_J),MDLHDL,NMOSR0) !DO SORT -C - END IF -C - RETURN -C -C - END diff --git a/src/nscan/nmoup0.for b/src/nscan/nmoup0.for deleted file mode 100644 index dc89be71e3fe29dec7bb41d2584e494d2f5cbb9c..0000000000000000000000000000000000000000 --- a/src/nscan/nmoup0.for +++ /dev/null @@ -1,784 +0,0 @@ -C+ NMOUP0.FOR -C WNB 910801 -C -C Revisions: -C WNB 911004 Typo in source selection -C WNB 911230 Logical error in source update -C WNB 920320 SUN cannot handle empty argument list -C HjV 920520 HP does not allow extended source lines -C WNB 930623 Prepare for Spectral Update; remove UP7,UP8,UP9 -C WNB 930708 Correct m.e. print -C WNB 930819 Remove NMOMUM reference -C WNB 930825 Use polarisation codes -C WNB 931006 Text -C WNB 931008 Add MINST; limit proximity -C WNB 931011 Limit proximity (compiler sdw error); add SI; MBAS -C WNB 940821 Add polarisation update and estimate -C WNB 950611 Use new LSQ routines -C WNB 950622 Create options to do more sources together -C WNB 950630 More options -C WNB 950705 Average extended, large clusters -C WNB 950706 Add FIT -C JEN 960415 Corrected bug in QUV-update -C - LOGICAL FUNCTION NMOUP0(LEXT) -C -C Update source parameters help routines -C -C Result: -C -C NMOUP0_L = NMOUP0( LEXT_J:I) Create and init the LSQ areas -C LEXT is type (see MDU) -C NMOUP9_L = NMOUP9( LEXT_J:I) Reset and delete LSQ areas -C NMOUP1_L = NMOUP1( LEXT_J:I, UV0_E(0:3):I, LM0_E(0:1):I, FRQ0_D:I, -C RTP_E(0:*), NIFR_J:I, IFR_I(0:*):I. -C TF_E(0:1):I, MINST_J:I, SCPOL_J:I, BASEL_E(0:*):I, -C MBAS_E:IO, WGT_E(0:*,0:3):I, DAT_E(0:1,0:3,0:*):I, -C STH_B(*):I, SCH_B(*):I, ANG_E(*):I) -C Generate LSQ equations. See NMOMU4 for -C parameters -C NMOUP2_L = NMOUP2( LEXT_J:I, DX0_E:I, DY0_E:I, LSQA_J(1:4):I, FIT_E:O) -C Solve flux and position, -C using DX0 and DY0 as halfwidth in L and M -C to correct close sources and make averages. -C FIT indicates the non-linear loop FIT if -C MDU_M_LOOP set. -C NMOUP3_L = NMOUP3( LEXT_J:I) Show result -C -C -C Include files: -C - INCLUDE 'WNG_DEF' - INCLUDE 'CBITS_DEF' - INCLUDE 'LSQ_O_DEF' - INCLUDE 'MDH_O_DEF' !MODEL HEADER - INCLUDE 'MDL_O_DEF' !MODEL LINE - INCLUDE 'MDU_O_DEF' !UPDATE AREA - INCLUDE 'STH_O_DEF' !SET HEADER - INCLUDE 'NMO_DEF' -C -C Entry points: -C - LOGICAL NMOUP1,NMOUP2,NMOUP3,NMOUP9 -C -C Parameters: -C -C -C Arguments: -C - INTEGER LEXT !TYPE (0,1,2...) - REAL UV0(0:3) !UV COORDINATES - REAL LM0(0:1) !LM OFFSETS - DOUBLE PRECISION FRQ0 !FREQUENCY - REAL RTP(0:*) !TEL. POSITIONS - INTEGER NIFR !# OF INTERFEROMETERS - INTEGER*2 IFR(0:*) !INTERFEROMETERS - REAL TF(0:1) !INTEGR. TIME, BANDWIDTH - INTEGER MINST !INSTRUMENT - INTEGER SCPOL !SELECT POL. - REAL BASEL(0:STHIFR-1) !BASELINES - REAL MBAS !MAX. BASELINE - REAL WGT(0:STHIFR-1,0:3) !WEIGHTS - REAL DAT(0:1,0:STHIFR-1,0:3) !DATA - INTEGER*2 STHI(0:*) !SET HEADER - BYTE SCH(0:*) !SCAN HEADER - REAL ANG(0:2,0:*) !DIPOLE POSITIONS - REAL DX0 !WIDTH L - REAL DY0 !WIDTH M - INTEGER LSQA(4) !AVERAGES LSQ AREA - REAL FIT !FIT FOR NON-LINEAR -C -C Function references: -C - LOGICAL WNGGVA !GET AREA - LOGICAL WNMLGA !GET LSQ AREA - INTEGER WNMLGR !GET ROW POINTER -C -C Data declarations: -C - REAL MYDAT(0:1) !DATA POINT - INTEGER DCNT !DATA COUNT - INTEGER DWGT(0:STHIFR-1) !DATA TO IQUV CONVERSION SUCCESS - COMPLEX CDMOD(0:3,0:STHIFR-1) !DATA TO IQUV CONVERSION - REAL DMOD(0:1,0:3,0:STHIFR-1) - EQUIVALENCE (CDMOD,DMOD) - REAL MU,SD !SOLUTION - REAL UW,UW0 !WEIGHTS - REAL WPROX !CLOSE SOURCES - INTEGER RG(0:1) !PRINT RANGE - INTEGER JP !POINTER UPDATE AREA - INTEGER MP !POINTER MODEL DATA - INTEGER SP0,SP1 !OFFSET SOL/ME - INTEGER JR0,JR1 !OFFSET IN SOURCE CALCULATION LIST -C- -C -C UP0 -C - NMOUP0=.TRUE. !ASSUME OK - J0=MDL__L/LB_J !LENGTH IN J OF MODEL LINE - J3=(GDESJ(MDH_MODP_J)-A_OB) !MODEL POINTER - J2=J3/LB_J - IF (IAND(LEXT,MDU_T_SILM).NE.0) THEN !# UNKNOWNS - I3=4 - ELSE IF (IAND(LEXT,MDU_T_PEST).NE.0) THEN - I3=1 - ELSE IF (IAND(LEXT,MDU_T_LM).NE.0) THEN - I3=2 - ELSE IF (IAND(LEXT,MDU_T_I).NE.0) THEN - I3=1 - ELSE - I3=3 - END IF - DO I=0,GDESJ(MDH_NSRC_J)-1 !ALL SOURCES - J1=J3+I*MDL__L !MODEL POINTER - J=J2+I*J0 - I4=A_B(J1+MDL_TP_B) - IF (A_B(J1+MDL_TP1_B).EQ.0 .AND. !TYPE ZERO - 1 A_E(J+MDL_I_E).NE.0 .AND. !NOT DELETED - 1 IAND(I4,MDLCLN_M).EQ.0) !NOT CLEAN - 1 THEN !SELECT - IF (.NOT.WNGGVA(MDU__L,A_J(J+MDL_RS_E))) THEN - NMOUP0=.FALSE. !CANNOT OBTAIN AREA - RETURN - END IF - A_J(J+MDL_RS_E)=(A_J(J+MDL_RS_E)-A_OB)/LB_J !MAKE A_J OFFSET - CALL WNGMVZ(MDU__L,A_J(A_J(J+MDL_RS_E))) !CLEAR AREA - A_J(A_J(J+MDL_RS_E)+MDU_NUN_J)=I3 !# PARAMETERS - A_J(A_J(J+MDL_RS_E)+MDU_TYPE_J)=LEXT !TYPE - ELSE !NO SELECT - A_J(J+MDL_RS_E)=0 !SET NO SELECT - END IF - END DO -C -C ALL SEPARATE -C - IF (IAND(LEXT,MDU_M_CLUST).EQ.0) THEN - DO I=0,GDESJ(MDH_NSRC_J)-1 !ALL SOURCES - J=J2+I*J0 - JP=A_J(J+MDL_RS_E) !UPDATE AREA POINTER - IF (JP.NE.0) THEN !SELECTED - A_J(JP+MDU_NSRC_J)=1 !# OF SOURCES FOR THIS ONE - END IF - END DO -C -C CLUSTERED -C - ELSE - DO I=0,GDESJ(MDH_NSRC_J)-1 - J=J2+I*J0 - JP=A_J(J+MDL_RS_E) - IF (JP.NE.0) THEN - IF (A_J(JP+MDU_RAR_J).EQ.0) THEN - I0=JP - A_J(JP+MDU_OFF_J)=A_J(I0+MDU_NSRC_J) - IF (IAND(A_J(JP+MDU_TYPE_J),MDU_M_CONSTR).NE.0) THEN - A_J(JP+MDU_OFFS_J)=A_J(I0+MDU_NSRC_J) - END IF - A_J(I0+MDU_NSRC_J)=A_J(I0+MDU_NSRC_J)+1 - DO I1=I+1,GDESJ(MDH_NSRC_J)-1 - J3=J2+I1*J0 - JP=A_J(J3+MDL_RS_E) - IF (JP.NE.0) THEN - IF (((A_E(J3+MDL_L_E)-A_E(J+MDL_L_E)) - 1 /SORRAN(0))**2+ - 1 ((A_E(J3+MDL_M_E)-A_E(J+MDL_M_E)) - 1 /SORRAN(1))**2.LT.1) THEN - IF (A_J(JP+MDU_RAR_J).EQ.0) THEN - A_J(JP+MDU_RAR_J)=I0 - A_J(JP+MDU_OFF_J)=A_J(I0+MDU_NSRC_J) - IF (IAND(A_J(JP+MDU_TYPE_J), - 1 MDU_M_CONSTR).NE.0) THEN - A_J(JP+MDU_OFFS_J)=A_J(I0+MDU_NSRC_J) - END IF - A_J(I0+MDU_NSRC_J)=A_J(I0+MDU_NSRC_J)+1 - END IF - END IF - END IF - END DO - END IF - END IF - END DO -C -C COMBINED -C - IF (IAND(LEXT,MDU_M_COMBI)) THEN - I0=0 !NONE YET - DO I=0,GDESJ(MDH_NSRC_J)-1 !ALL SOURCES - J=J2+I*J0 - JP=A_J(J+MDL_RS_E) !UPDATE AREA POINTER - IF (JP.NE.0) THEN !SELECTED - IF (I0.EQ.0) THEN !FIRST - I0=JP - ELSE - IF (A_J(JP+MDU_RAR_J).EQ.0) THEN !NEW ONE - A_J(JP+MDU_RAR_J)=I0 !REFERENCE AREA - A_J(JP+MDU_OFF_J)=A_J(I0+MDU_NSRC_J) !OFFSET - A_J(JP+MDU_OFFS_J)=A_J(I0+MDU_NSRC_J) !SOL OFFSET - A_J(I0+MDU_NSRC_J)=A_J(I0+MDU_NSRC_J)+ - 1 A_J(JP+MDU_NSRC_J) !TOTAL # SOURCES - A_J(JP+MDU_NSRC_J)=0 - ELSE - I1=A_J(JP+MDU_RAR_J) !OLD REFERENCE - A_J(JP+MDU_RAR_J)=I0 !REFERENCE AREA - A_J(JP+MDU_OFF_J)=A_J(JP+MDU_OFF_J)+ - 1 A_J(I1+MDU_OFF_J) !NEW OFFSET - A_J(JP+MDU_OFFS_J)=A_J(I1+MDU_OFFS_J) !SOL OFFSET - END IF - END IF - END IF - END DO - END IF - END IF -C -C GET AREAS -C - DO I=0,GDESJ(MDH_NSRC_J)-1 !ALL SOURCES - J=J2+I*J0 - JP=A_J(J+MDL_RS_E) !UPDATE AREA POINTER - IF (JP.NE.0) THEN !SELECTED - IF (.NOT.WNGGVA(4*STHIFR*LB_X, - 1 A_J(JP+MDU_MOD_J))) THEN !GET MODEL DATA - NMOUP0=.FALSE. !CANNOT OBTAIN AREA - RETURN - END IF - A_J(JP+MDU_MOD_J)=(A_J(JP+MDU_MOD_J)-A_OB)/LB_X - IF (A_J(JP+MDU_NSRC_J).GT.0) THEN !THIS ONE - I0=A_J(JP+MDU_NSRC_J)*A_J(JP+MDU_NUN_J) - IF (IAND(A_J(JP+MDU_TYPE_J),MDU_M_CONSTR).EQ.0 .OR. - 1 A_J(JP+MDU_NSRC_J).EQ.1) THEN - IF (.NOT.WNMLGA(A_J(JP+MDU_LAR_J), - 1 LSQ_T_REAL,I0)) THEN !GET LSQ AREA - NMOUP0=.FALSE. !CANNOT OBTAIN AREA - RETURN - END IF - ELSE !CONSTRAINTS - IF (.NOT.WNMLGA(A_J(JP+MDU_LAR_J), - 1 LSQ_T_REAL+LSQ_T_CONSTRAINT,I0,1, - 1 A_J(JP+MDU_NUN_J)*(A_J(JP+MDU_NSRC_J)-1))) THEN - NMOUP0=.FALSE. !CANNOT OBTAIN AREA - RETURN - END IF - END IF - IF (IAND(A_J(JP+MDU_TYPE_J),MDU_M_LOOP).NE.0) THEN - A_J(JP+MDU_LEN_J)=5*I0*LB_E !SOLUTION LENGTH - ELSE - A_J(JP+MDU_LEN_J)=4*I0*LB_E !SOLUTION LENGTH - END IF - IF (.NOT.WNGGVA(A_J(JP+MDU_LEN_J), - 1 A_J(JP+MDU_CEQ_J))) THEN !GET SOL, ME, EQUATIONS - NMOUP0=.FALSE. !CANNOT OBTAIN AREA - RETURN - END IF - A_J(JP+MDU_CEQ_J)= - 1 (A_J(JP+MDU_CEQ_J)-A_OB)/LB_E !MAKE A_E OFFSET - A_J(JP+MDU_SOL_J)= - 1 A_J(JP+MDU_CEQ_J)+2*I0 !MAKE SOL OFFSET - CALL WNGMVZ(A_J(JP+MDU_LEN_J),A_E(A_J(JP+MDU_CEQ_J))) - END IF - END IF - END DO -C - RETURN -C -C UP9 -C - ENTRY NMOUP9(LEXT) -C - NMOUP9=.TRUE. !ASSUME OK - J0=MDL__L/LB_J !LENGTH IN J OF MODEL LINE - J3=(GDESJ(MDH_MODP_J)-A_OB) !MODEL POINTER - J2=J3/LB_J - DO I=0,GDESJ(MDH_NSRC_J)-1 !ALL SOURCES - J=J2+I*J0 - JP=A_J(J+MDL_RS_E) !UPDATE AREA - IF (JP.NE.0) THEN !SELECTED - IF (A_J(JP+MDU_LAR_J).NE.0) THEN !LSQ AREA - CALL WNMLFA(A_J(JP+MDU_LAR_J)) !FREE LSQ - END IF - IF (A_J(JP+MDU_CEQ_J).NE.0) THEN !SOLUTION AREAS - A_J(JP+MDU_CEQ_J)=A_J(JP+MDU_CEQ_J)*LB_E+A_OB - CALL WNGFVA(A_J(JP+MDU_LEN_J), - 1 A_J(JP+MDU_CEQ_J)) - END IF - IF (A_J(JP+MDU_MOD_J).NE.0) THEN !MODEL AREAS - A_J(JP+MDU_MOD_J)=A_J(JP+MDU_MOD_J)*LB_X+A_OB - CALL WNGFVA(4*STHIFR*LB_X, - 1 A_J(JP+MDU_MOD_J)) - END IF - A_J(J+MDL_RS_E)=JP*LB_J+A_OB - CALL WNGFVA(MDU__L,A_J(J+MDL_RS_E)) !FREE AREA - END IF - END DO -C - RETURN -C -C UP1 -C - ENTRY NMOUP1(LEXT,UV0,LM0,FRQ0,RTP,NIFR,IFR, - 1 TF,MINST,SCPOL,BASEL,MBAS,WGT,DAT, - 1 STHI,SCH,ANG) -C - NMOUP1=.TRUE. !ASSUME OK - J0=MDL__L/LB_J !LENGTH IN J OF MODEL LINE - J3=(GDESJ(MDH_MODP_J)-A_OB) !MODEL POINTER - J2=J3/LB_J - UW0=UV0(0)*UV0(0)+UV0(1)*UV0(1) !WEIGHT -C -C MAKE CORRECT DATA FOR POL UPDATE -C - IF (IAND(LEXT,MDU_T_QUV).NE.0) THEN !POL UPDATE - IF (STHI(STH_PLN_I).EQ.2) THEN - DO I1=0,NIFR-1 !MAKE SURE Q DONE IF ONLY XX,YY - DO I2=P_XY,P_YX,P_YX-P_XY - WGT(I1,I2)=1. - DAT(0,I1,I2)=0. - DAT(1,I1,I2)=0. - END DO - END DO - END IF - CALL NMOCXI(STHI,SCH,ANG,WGT,DWGT,DAT,CDMOD) !DATA TO IQUV - END IF -C -C GET MODEL DATA -C - DO I=0,GDESJ(MDH_NSRC_J)-1 !ALL SOURCES - J=J2+I*J0 - JP=A_J(J+MDL_RS_E) - IF (JP.NE.0) THEN !SELECTED - CALL NMOMU1(-1,UV0,LM0,FRQ0,RTP,4, - 1 NIFR,IFR,TF,MINST, - 1 A_X(A_J(JP+MDU_MOD_J)),I) !GET MODEL - END IF - END DO -C -C MAKE CONDITION EQUATIONS -C - DO I1=0,NIFR-1 !ALL BASELINES - IF (BASEL(I1).GT.0) THEN !SELECTED - UW=UW0*BASEL(I1)*BASEL(I1) !WEIGHT - DO I=0,GDESJ(MDH_NSRC_J)-1 !ALL SOURCES - J=J2+I*J0 - JP=A_J(J+MDL_RS_E) - IF (JP.NE.0) THEN !SELECTED - JR0=A_J(JP+MDU_OFFS_J)*A_J(JP+MDU_NUN_J) !COND. EQU. OFFSET - MP=A_J(JP+MDU_MOD_J) !MODEL OFFSET - DO WHILE(A_J(JP+MDU_RAR_J).NE.0) - JP=A_J(JP+MDU_RAR_J) !FIND CORRECT CALCULATION AREA - END DO - JR0=JR0+A_J(JP+MDU_CEQ_J) !OFFSET COND.EQ. IN LIST - JR1=JR0+A_J(JP+MDU_NSRC_J)*A_J(JP+MDU_NUN_J) !OFFSET 2ND - IF (IAND(LEXT,MDU_T_ILM+MDU_T_SILM+MDU_T_EXT).NE.0) THEN - IF (IAND(LEXT,MDU_T_ILM).NE.0 .OR. - 1 IAND(LEXT,MDU_T_SILM).NE.0) THEN !NORMAL; SI - A_E(JR0+0)=A_E(JR0+0)+ - 1 REAL(A_X(MP+4*I1)) !COSINE COEFF. - A_E(JR0+1)=A_E(JR0+1)- - 1 BASEL(I1)*UV0(0)*AIMAG(A_X(MP+4*I1)) - A_E(JR0+2)=A_E(JR0+2)- - 1 BASEL(I1)*UV0(1)*AIMAG(A_X(MP+4*I1)) - A_E(JR1+0)=A_E(JR1+0)+ - 1 AIMAG(A_X(MP+4*I1)) !SINE COEFF. - A_E(JR1+1)=A_E(JR1+1)+ - 1 BASEL(I1)*UV0(0)*REAL(A_X(MP+4*I1)) - A_E(JR1+2)=A_E(JR1+2)+ - 1 BASEL(I1)*UV0(1)*REAL(A_X(MP+4*I1)) - IF (IAND(LEXT,MDU_T_SILM).NE.0) THEN - IF (GDESJ(MDH_TYP_J).NE.0) THEN !FREQ. GIVEN - A_E(JR0+3)=A_E(JR0+3)+REAL(A_X(MP+4*I1))* - 1 LOG(FRQ0/GDESD(MDH_FRQ_D)) - A_E(JR1+3)=A_E(JR1+3)+AIMAG(A_X(MP+4*I1))* - 1 LOG(FRQ0/GDESD(MDH_FRQ_D)) - ELSE - A_E(JR0+3)=A_E(JR0+3)+REAL(A_X(MP+4*I1)) - A_E(JR1+3)=A_E(JR1+0)+AIMAG(A_X(MP+4*I1)) - END IF - END IF - ELSE !EXTEND - A_E(JR0+0)=A_E(JR0+0)-REAL(A_X(MP+4*I1))* - 1 ((BASEL(I1)*UV0(0))**2) !COSINE - A_E(JR0+1)=A_E(JR0+1)-REAL(A_X(MP+4*I1))* - 1 ((BASEL(I1)*UV0(1))**2) - A_E(JR0+2)=A_E(JR0+2)-REAL(A_X(MP+4*I1))* - 1 UV0(0)*UV0(1)*((BASEL(I1))**2) - A_E(JR1+0)=A_E(JR1+0)-AIMAG(A_X(MP+4*I1))* - 1 ((BASEL(I1)*UV0(0))**2) !SINE - A_E(JR1+1)=A_E(JR1+1)-AIMAG(A_X(MP+4*I1))* - 1 ((BASEL(I1)*UV0(1))**2) - A_E(JR1+2)=A_E(JR1+2)- - 1 AIMAG(A_X(MP+4*I1))*UV0(0)*UV0(1)* - 1 ((BASEL(I1))**2) - END IF - ELSE IF (IAND(LEXT,MDU_T_I).NE.0) THEN !I - A_E(JR0+0)=A_E(JR0+0)+ - 1 REAL(A_X(MP+4*I1)) !COSINE COEFF. - A_E(JR1+0)=A_E(JR1+0)+ - 1 AIMAG(A_X(MP+4*I1)) !SINE COEFF. - ELSE IF (IAND(LEXT,MDU_T_LM).NE.0) THEN !LM - A_E(JR0+0)=A_E(JR0+0)- - 1 BASEL(I1)*UV0(0)*AIMAG(A_X(MP+4*I1)) - A_E(JR0+1)=A_E(JR0+1)- - 1 BASEL(I1)*UV0(1)*AIMAG(A_X(MP+4*I1)) - A_E(JR1+0)=A_E(JR1+0)+ - 1 BASEL(I1)*UV0(0)*REAL(A_X(MP+4*I1)) - A_E(JR1+1)=A_E(JR1+1)+ - 1 BASEL(I1)*UV0(1)*REAL(A_X(MP+4*I1)) - ELSE IF (IAND(LEXT,MDU_T_QUV).NE.0) THEN !POL - DO I2=0,2 !Q,U,V - A_E(JR0+I2)=A_E(JR0+I2)+REAL(A_X(MP+4*I1)) !I - A_E(JR1+I2)=A_E(JR1+I2)+AIMAG(A_X(MP+4*I1)) - END DO - ELSE !POL ESTIMATE !!! - END IF - END IF !SELECTED COMPONENT - END DO !MODELS -C -C DATA -C - MYDAT(0)=0 !NO DATA - MYDAT(1)=0 - DCNT=0 - IF (IAND(LEXT,MDU_T_ILM+MDU_T_EXT+MDU_T_SILM+ - 1 MDU_T_LM+MDU_T_I).NE.0) THEN - IF (IAND(SCPOL,XX_P).NE.0 .AND. - 1 WGT(I1,0).GT.0) THEN !USE XX - MYDAT(0)=MYDAT(0)+DAT(0,I1,0) - MYDAT(1)=MYDAT(1)+DAT(1,I1,0) - DCNT=DCNT+1 - END IF - IF (IAND(SCPOL,YY_P).NE.0 .AND. - 1 WGT(I1,3).GT.0) THEN !USE YY - MYDAT(0)=MYDAT(0)+DAT(0,I1,3) - MYDAT(1)=MYDAT(1)+DAT(1,I1,3) - DCNT=DCNT+1 - END IF - IF (DCNT.GT.0) THEN - MYDAT(0)=MYDAT(0)/DCNT - MYDAT(1)=MYDAT(1)/DCNT - END IF - END IF -C -C MAKE EQUATIONS -C - DO I=0,GDESJ(MDH_NSRC_J)-1 !ALL SOURCES - J=J2+I*J0 - JP=A_J(J+MDL_RS_E) - IF (JP.NE.0) THEN - IF (A_J(JP+MDU_LAR_J).NE.0) THEN !SOLVE THIS ONE - I0=A_J(JP+MDU_NSRC_J)*A_J(JP+MDU_NUN_J) - JR0=A_J(JP+MDU_CEQ_J) !OFFSET COND.EQ. IN LIST - JR1=JR0+I0 !OFFSET 2ND - SP0=A_J(JP+MDU_SOL_J) !SOL. OFFSET - SP1=SP0+I0 !2ND - IF (IAND(LEXT,MDU_T_ILM+MDU_T_SILM+MDU_T_EXT+ - 1 MDU_T_LM+MDU_T_I).NE.0) THEN - IF (DCNT.GT.0) THEN - CALL WNMLMN(A_J(JP+MDU_LAR_J),LSQ_C_REAL, - 1 A_E(JR0),UW,MYDAT(0)) !COSINE - CALL WNMLMN(A_J(JP+MDU_LAR_J),LSQ_C_REAL, - 1 A_E(JR1),UW,MYDAT(1)) !SINE - END IF - ELSE IF (IAND(LEXT,MDU_T_QUV).NE.0) THEN !POL - DO I2=0,2 !Q,U,V - DO I4=0,I0-1 - A_E(SP0+I4)=0 - A_E(SP1+I4)=0 - END DO - DO I4=0,A_J(JP+MDU_NSRC_J)-1 - A_E(SP0+I4*A_J(JP+MDU_NUN_J)+I2)= - 1 A_E(JR0+I4*A_J(JP+MDU_NUN_J)+I2) - A_E(SP1+I4*A_J(JP+MDU_NUN_J)+I2)= - 1 A_E(JR1+I4*A_J(JP+MDU_NUN_J)+I2) - END DO -C JEN: Changed I2 (=0-2) to I2+1 (=1-3): because Q=1, U=2, V=3 - CALL WNMLMN(A_J(JP+MDU_LAR_J),LSQ_C_REAL, - 1 A_E(SP0),UW,DMOD(0,I2+1,I1)) !COS - CALL WNMLMN(A_J(JP+MDU_LAR_J),LSQ_C_REAL, - 1 A_E(SP1),UW,DMOD(1,I2+1,I1)) !SIN - END DO - ELSE !POL ESTIMATE !! - END IF - CALL WNGMVZ(2*LB_E*I0,A_E(A_J(JP+MDU_CEQ_J))) - END IF !SOLVE - END IF !SELECTED - END DO !SOURCES - END IF !SELECTED - MBAS=MAX(MBAS,BASEL(I1)) - END DO !IFR LOOP -C - RETURN -C -C UP2 -C - ENTRY NMOUP2(LEXT,DX0,DY0,LSQA,FIT) -C - NMOUP2=.TRUE. !ASSUME OK - FIT=-1 !START FIT - J0=MDL__L/LB_J !LENGTH IN J OF MODEL LINE - J3=(GDESJ(MDH_MODP_J)-A_OB) !MODEL POINTER - J2=J3/LB_J -C -C SET CONSTRAINTS -C - IF (IAND(LEXT,MDU_M_CONSTR).NE.0) THEN - DO I=0,GDESJ(MDH_NSRC_J)-1 !ALL SOURCES - J=J2+I*J0 - JP=A_J(J+MDL_RS_E) !AREA POINTER - IF (JP.NE.0) THEN !SELECTED - IF (A_J(JP+MDU_LAR_J).NE.0) THEN !TO SOLVE - IF (A_J(JP+MDU_NSRC_J).GT.1) THEN - I0=A_J(JP+MDU_NUN_J)*A_J(JP+MDU_NSRC_J) !# UNKNOWNS - DO I2=0,I0-A_J(JP+MDU_NUN_J)-1 !CONSTRAINTS - DO I3=0,I0-1 !TOTAL # UNKNOWNS - I4=WNMLGR(A_J(JP+MDU_LAR_J),I3) !ROW POINTER - A_D(I4+I0+I2)=0 !EMPTY - END DO - END DO - DO I2=0,A_J(JP+MDU_NUN_J)-1 - DO I3=0,A_J(JP+MDU_NSRC_J)-2 - I4=WNMLGR(A_J(JP+MDU_LAR_J), - 1 I3*A_J(JP+MDU_NUN_J)+I2) !ROW - A_D(I4+I0+I3*A_J(JP+MDU_NUN_J)+I2)=1 !SET - END DO - END DO - END IF - END IF - END IF - END DO - END IF -C -C SOLVE -C - DO I=0,GDESJ(MDH_NSRC_J)-1 !ALL SOURCES - J=J2+I*J0 - JP=A_J(J+MDL_RS_E) !AREA POINTER - IF (JP.NE.0) THEN !SELECTED - IF (A_J(JP+MDU_LAR_J).NE.0) THEN !TO SOLVE - I0=A_J(JP+MDU_NUN_J)*A_J(JP+MDU_NSRC_J) !# OF UNKNOWNS - SP0=A_J(JP+MDU_SOL_J) - SP1=SP0+I0 - IF (IAND(LEXT,MDU_M_LOOP+MDU_M_ELOOP).NE.MDU_M_LOOP) THEN - CALL WNMLTR(A_J(JP+MDU_LAR_J),I1) !SOLVE - IF (IAND(LEXT,MDU_M_ELOOP).EQ.0) THEN - CALL WNMLSN(A_J(JP+MDU_LAR_J), - 1 A_E(SP0),MU,SD) !SOLVE - END IF - CALL WNMLME(A_J(JP+MDU_LAR_J), - 1 A_E(SP1)) !ERRORS - ELSE - DO I1=0,I0-1 !RESTORE SOL - A_E(SP0+I1)=A_E(SP1+I0+I1) - A_E(SP1+I1)=1 - END DO - CALL WNMLNR(A_J(JP+MDU_LAR_J),I1,A_E(SP0),MU,SD) !SOLVE - FIT=MAX(FIT,SD) !FITTING PRECISION - DO I1=0,I0-1 !RESTORE SOLUTION - R0=A_E(SP1+I0+I1) !OLD SOLUTION - A_E(SP1+I0+I1)=A_E(SP0+I1) !NEW SOLUTION - A_E(SP0+I1)=A_E(SP0+I1)-R0 !DIFFERENCE SOLUTION - END DO - END IF - END IF - END IF - END DO -C -C GET SOLUTIONS -C - IF (IAND(LEXT,MDU_M_CONSTR).EQ.0) THEN - DO I=0,GDESJ(MDH_NSRC_J)-1 !ALL SOURCES - J=J2+I*J0 - JP=A_J(J+MDL_RS_E) !AREA POINTER - IF (JP.NE.0) THEN !SELECTED - J1=A_J(JP+MDU_OFF_J) !OFFSET THIS ONE - I1=A_J(JP+MDU_OFFS_J) !SOLUTION OFFSET - DO WHILE(A_J(JP+MDU_RAR_J).NE.0) - JP=A_J(JP+MDU_RAR_J) !FIND CORRECT CALCULATION AREA - END DO - I0=A_J(JP+MDU_NUN_J)*A_J(JP+MDU_NSRC_J) - SP0=A_J(JP+MDU_SOL_J)+J1*A_J(JP+MDU_NUN_J) !SOLUTION POINTERS - SP1=SP0+I0 - I1=A_J(JP+MDU_SOL_J)+I1*A_J(JP+MDU_NUN_J) !SOLUTION POINTERS - DO I2=0,A_J(JP+MDU_NUN_J)-1 - A_E(SP0+I2)=A_E(I1+I2) !SET ALL SOLUTIONS - A_E(SP1+I2)=A_E(I1+I0+I2) - END DO - END IF - END DO - END IF -C -C CONVERT SOLUTIONS -C - DO I=0,GDESJ(MDH_NSRC_J)-1 !ALL SOURCES - J=J2+I*J0 - JP=A_J(J+MDL_RS_E) !AREA POINTER - IF (JP.NE.0) THEN !SELECTED - J1=A_J(JP+MDU_OFF_J) !OFFSET THIS ONE - DO WHILE(A_J(JP+MDU_RAR_J).NE.0) - JP=A_J(JP+MDU_RAR_J) !FIND CORRECT CALCULATION AREA - END DO - I0=A_J(JP+MDU_NUN_J)*A_J(JP+MDU_NSRC_J) - SP0=A_J(JP+MDU_SOL_J)+J1*A_J(JP+MDU_NUN_J) !SOLUTION POINTERS - SP1=SP0+I0 - IF (IAND(LEXT,MDU_T_ILM+MDU_T_SILM+MDU_T_I).NE.0) THEN !NORMAL - A_E(SP0)=A_E(SP0)*A_E(J+MDL_I_E) !CORRECT AMPLITUDE - A_E(SP1)=A_E(SP1)*ABS(A_E(J+MDL_I_E)) - ELSE IF (IAND(LEXT,MDU_T_EXT).NE.0) THEN !EXTENDED - DO I2=0,2 - A_E(SP0+I2)=A_E(SP0+I2)/3600./DEG/3600./DEG - A_E(SP1+I2)=A_E(SP1+I2)/3600./DEG/3600./DEG - END DO - ELSE IF (IAND(LEXT,MDU_T_QUV).NE.0) THEN !POL - DO I2=0,2 - A_E(SP0+I2)=A_E(SP0+I2)*A_E(J+MDL_I_E) - A_E(SP1+I2)=A_E(SP1+I2)*ABS(A_E(J+MDL_I_E)) - END DO - END IF -C -C CLOSE SOURCES -C - IF (IAND(LEXT,MDU_M_CLUST).EQ.0) THEN - WPROX=0 !DOWN WEIGHT FOR CLOSE SOURCES - DO I1=0,GDESJ(MDH_NSRC_J)-1 !ALL SOURCES - I0=J2+I1*J0 !MODEL POINTER - IF (A_J(I0+MDL_RS_E).NE.0) THEN !SELECTED - R0=-ABS(A_E(I0+MDL_L_E)-A_E(J+MDL_L_E))/DX0 !BEAM OFFS - R1=-ABS(A_E(I0+MDL_M_E)-A_E(J+MDL_M_E))/DY0 - IF (R0.GT.-10 .AND. R1.GT.-10) - 1 WPROX=WPROX+EXP(R0)*EXP(R1) - END IF - END DO - DO I2=0,2 !DOWN WEIGHT - A_E(SP0+I2)=A_E(SP0+I2)/WPROX - A_E(SP1+I2)=A_E(SP1+I2)/WPROX - END DO - END IF - END IF - END DO -C -C APPLY CORRECTIONS -C - DO I=0,GDESJ(MDH_NSRC_J)-1 !ALL SOURCES - J1=J3+I*MDL__L !MODEL POINTER - J=J2+I*J0 - JP=A_J(J+MDL_RS_E) !AREA POINTER - IF (JP.NE.0) THEN !SELECTED - I0=A_J(JP+MDU_OFF_J) !OFFSET THIS ONE - DO WHILE(A_J(JP+MDU_RAR_J).NE.0) - JP=A_J(JP+MDU_RAR_J) !FIND CORRECT CALCULATION AREA - END DO - SP0=A_J(JP+MDU_SOL_J)+I0*A_J(JP+MDU_NUN_J) !SOLUTION POINTERS - SP1=SP0+A_J(JP+MDU_NUN_J)*A_J(JP+MDU_NSRC_J) - IF (IAND(LEXT,MDU_T_ILM+MDU_T_SILM).NE.0) THEN !NORMAL - R0=A_E(J+MDL_I_E) !OLD AMPL. - A_E(J+MDL_I_E)=A_E(J+MDL_I_E)+A_E(SP0) !AMPL. - IF (A_E(J+MDL_I_E).NE.0 .AND. A_E(SP1).NE.0) THEN !AVERAGE - R1=(R0/A_E(SP1))**2 !WEIGHT - R0=R0/A_E(J+MDL_I_E) - CALL WNMLMN(LSQA(1),LSQ_C_REAL, - 1 1E0,R1,R0) - END IF - A_E(J+MDL_L_E)=A_E(J+MDL_L_E)+A_E(SP0+1)/3600./DEG !L - IF (A_E(SP1+1).NE.0) THEN !AVERAGE L - CALL WNMLMN(LSQA(2),LSQ_C_REAL, - 1 1E0,1./(A_E(SP1+1)**2),-A_E(SP0+1)) - END IF - A_E(J+MDL_M_E)=A_E(J+MDL_M_E)+A_E(SP0+2)/3600./DEG !M - IF (A_E(SP1+2).NE.0) THEN !AVERAGE M - CALL WNMLMN(LSQA(3),LSQ_C_REAL, - 1 1E0,1./(A_E(SP1+2)**2),-A_E(SP0+2)) - END IF - IF (IAND(LEXT,MDU_T_SILM).NE.0) THEN !SI - A_E(J+MDL_SI_E)=A_E(J+MDL_SI_E)+A_E(SP0+3) !SI - IF (A_E(SP1+3).NE.0) THEN !AVERAGE SI - CALL WNMLMN(LSQA(4),LSQ_C_REAL, - 1 1E0,1./(A_E(SP1+3)**2),-A_E(SP0+3)) - END IF - END IF - ELSE IF (IAND(LEXT,MDU_T_I).NE.0) THEN !I - R0=A_E(J+MDL_I_E) !OLD AMPL. - A_E(J+MDL_I_E)=A_E(J+MDL_I_E)+A_E(SP0) !AMPL. - IF (A_E(J+MDL_I_E).NE.0 .AND. A_E(SP1).NE.0) THEN !AVERAGE - R1=(R0/A_E(SP1))**2 !WEIGHT - R0=R0/A_E(J+MDL_I_E) - CALL WNMLMN(LSQA(1),LSQ_C_REAL, - 1 1E0,R1,R0) - END IF - ELSE IF (IAND(LEXT,MDU_T_LM).NE.0) THEN !LM - A_E(J+MDL_L_E)=A_E(J+MDL_L_E)+A_E(SP0+0)/3600./DEG !L - IF (A_E(SP1+0).NE.0) THEN !AVERAGE L - CALL WNMLMN(LSQA(1),LSQ_C_REAL, - 1 1E0,1./(A_E(SP1+0)**2),-A_E(SP0+0)) - END IF - A_E(J+MDL_M_E)=A_E(J+MDL_M_E)+A_E(SP0+1)/3600./DEG !M - IF (A_E(SP1+1).NE.0) THEN !AVERAGE M - CALL WNMLMN(LSQA(2),LSQ_C_REAL, - 1 1E0,1./(A_E(SP1+1)**2),-A_E(SP0+1)) - END IF - ELSE IF (IAND(LEXT,MDU_T_EXT).NE.0) THEN !EXTENDED - DO I1=0,2 - A_E(J+MDL_EXT_E+I1)=A_E(J+MDL_EXT_E+I1)+A_E(SP0+I1) - END DO - DO I1=0,2 !AVERAGES - IF (A_E(SP1+I1).NE.0) THEN - CALL WNMLMN(LSQA(I1+1),LSQ_C_REAL, - 1 1E0,1./(A_E(SP1+I1)**2),-A_E(SP0+I1)) - END IF - END DO - I2=A_B(J1+MDL_BITS_B) !BITS - I2=IOR(I2,1) !SET EXTENDED - A_B(J1+MDL_BITS_B)=I2 - ELSE IF (IAND(LEXT,MDU_T_QUV).NE.0) THEN !POL - DO I1=0,2 - R0=A_E(J+MDL_Q_E+I1) !OLD AMPL. - A_E(J+MDL_Q_E+I1)=A_E(J+MDL_Q_E+I1)+ - 1 A_E(SP0+I1)/A_E(J+MDL_I_E) - IF (A_E(J+MDL_Q_E+I1).NE.0 .AND. - 1 A_E(SP1+I1).NE.0) THEN !AVER - R1=(R0/A_E(SP1+I1))**2 !WEIGHT - R0=R0/A_E(J+MDL_Q_E+I1) - CALL WNMLMN(LSQA(I1+1),LSQ_C_REAL, - 1 1E0,R1,R0) - END IF - END DO - ELSE !POL ESTIMATE !! - END IF - END IF - END DO -C - RETURN -C -C UP3 -C - ENTRY NMOUP3(LEXT) -C - NMOUP3=.TRUE. !ASSUME OK - RG(0)=1 !PRINT RANGE - RG(1)=GDESJ(MDH_NSRC_J) - J0=MDL__L/LB_J !LENGTH IN J OF MODEL LINE - J3=(GDESJ(MDH_MODP_J)-A_OB) !MODEL POINTER - J2=J3/LB_J - IF (IAND(LEXT,MDU_M_ELOOP).NE.0) THEN !RESET M.E. IN SOL. - DO I=0,GDESJ(MDH_NSRC_J)-1 !ALL SOURCES - J=J2+I*J0 - JP=A_J(J+MDL_RS_E) !AREA POINTER - IF (JP.NE.0) THEN !SELECTED - IF (A_J(JP+MDU_LAR_J).NE.0) THEN !TO SOLVE - I0=A_J(JP+MDU_NUN_J)*A_J(JP+MDU_NSRC_J) !# OF UNKNOWNS - SP0=A_J(JP+MDU_SOL_J) - SP1=SP0+I0 - DO I1=0,I0-1 !COPY M.E. - A_E(SP0+I1)=A_E(SP1+I1) - END DO - END IF - END IF - END DO - END IF - CALL NMOPRU(F_P,RG) !PRINT -C - RETURN -C -C - END - - - - diff --git a/src/nscan/nmoupd.for b/src/nscan/nmoupd.for deleted file mode 100644 index 97b567e47e73c6a51b28d999db3e07d2d046710d..0000000000000000000000000000000000000000 --- a/src/nscan/nmoupd.for +++ /dev/null @@ -1,311 +0,0 @@ -C+ NMOUPD.FOR -C WNB 910801 -C -C Revisions: -C WNB 910909 Add average print -C WNB 930423 Correct negative DEC error -C HjV 930518 Change some text -C WNB 930623 Prepare for Spectral Update -C WNB 930825 Add dipole position -C WNB 930826 New model data calculation -C WNB 931008 Add MINST -C WNB 931011 Add SI; MBAS -C WNB 940821 Add polarisation -C WNB 950611 New LSQ routines -C WNB 950626 Add grouped types -C WNB 950630 More options -C WNB 950706 Add loops -C WNB 990729 Add X00-X03 options (but assume them all to be ILM) -C - SUBROUTINE NMOUPD(LEXT) -C -C Update source flux and positions -C -C Result: -C -C CALL NMOUPD( LEXT_I:IO) Update a source list flux and positions, using -C a set of scan files. LEXT types (see MDU) -C -C -C Include files: -C - INCLUDE 'WNG_DEF' - INCLUDE 'NMO_DEF' - INCLUDE 'LSQ_O_DEF' - INCLUDE 'MDU_O_DEF' - INCLUDE 'STH_O_DEF' !SET HEADER - INCLUDE 'SCH_O_DEF' !SCAN HEADER -C -C Parameters: -C -C -C Arguments: -C - INTEGER LEXT -C -C Function references: -C - CHARACTER*32 WNTTSG !SHOW SET NAME - LOGICAL WNMLGA !GET LSQ AREA - LOGICAL NMORDH !MODEL HEADER DATA - LOGICAL NMOMSC !GET MODEL DATA FOR SCAN FILE - LOGICAL NMOUP0 !GET LSQ AREA FOR UPDATE - LOGICAL NSCSTG !GET A SET - LOGICAL NSCSCR !GET A SCAN - LOGICAL NSCSIF !READ INTERFEROMETERS -C -C Data declarations: -C - INTEGER CSTNAM(0:7) !CHECK SET NAME - DATA CSTNAM/8*-1/ - INTEGER LSQA(1:4) !LSQ AREAS FOR AVERAGES - INTEGER*2 IFRT(0:STHIFR-1) !INTERFEROMETER TABLE - INTEGER IFRA(0:1,0:STHIFR-1) - REAL ANG(0:2,0:STHIFR-1) - REAL BASEL(0:STHIFR-1) !BASELINE TABLE - REAL MBAS !MAX. BASELINE - REAL WGT(0:STHIFR-1,0:3) !DATA WEIGHTS XX,XY,YX,YY - REAL DAT(0:1,0:STHIFR-1,0:3) !DATA XX,XY,YX,YY - COMPLEX CDAT(0:STHIFR-1,0:3) - EQUIVALENCE (DAT,CDAT) - COMPLEX CMOD(0:3,0:STHIFR-1) !MODEL - REAL HA !HA OF SCAN - INTEGER NPOL !# OF POL. - INTEGER STP !SOURCE TYPE - DOUBLE PRECISION SRA,SDEC,SFRQ !SOURCE RA, DEC, FREQ - REAL UV0(0:3) !BASIC UV COORDINATES - REAL LM0(0:1) !BASIC SOURCE DISPLACEMENT - DOUBLE PRECISION FRQ0 !BASIC FREQUENCY - REAL TF(0:1) !INTEGR. TIME, BANDWIDTH - INTEGER MINST !INSTRUMENT - REAL DX0,DY0 !HALFWIDTH BEAM - REAL SOL(4),MU,SD !SOLVE AVERAGES - INTEGER SNAM(0:7) !SET NAME - INTEGER STHP !SET HEADER POINTER - REAL FIT !LOOP FIT - INTEGER LCNT !LCNT - BYTE STH(0:STH__L-1) !SET HEADER - INTEGER*2 STHI(0:STH__L/LB_I-1) - INTEGER STHJ(0:STH__L/LB_J-1) - REAL STHE(0:STH__L/LB_E-1) - DOUBLE PRECISION STHD(0:STH__L/LB_D-1) - EQUIVALENCE (STH,STHI,STHJ,STHE,STHD) - BYTE SCH(0:SCH__L-1) !SCAN HEADER - INTEGER*2 SCHI(0:SCH__L/LB_I-1) - INTEGER SCHJ(0:SCH__L/LB_J-1) - REAL SCHE(0:SCH__L/LB_E-1) - EQUIVALENCE (SCH,SCHI,SCHJ,SCHE) -C- -C -C INIT -C - IF (IAND(LEXT,MDU_T_X00).NE.0) THEN - LEXT=IOR(LEXT,MDU_T_ILM) - CALL WNCTXT(F_TP,'X00 not implemented yet. ILM assumed') - ELSE IF (IAND(LEXT,MDU_T_X01).NE.0) THEN - LEXT=IOR(LEXT,MDU_T_ILM) - CALL WNCTXT(F_TP,'X01 not implemented yet. ILM assumed') - ELSE IF (IAND(LEXT,MDU_T_X02).NE.0) THEN - LEXT=IOR(LEXT,MDU_T_ILM) - CALL WNCTXT(F_TP,'X02 not implemented yet. ILM assumed') - ELSE IF (IAND(LEXT,MDU_T_X03).NE.0) THEN !ASSUME THAT X == ILM - LEXT=IOR(LEXT,MDU_T_ILM) - CALL WNCTXT(F_TP,'X03 not implemented yet. ILM assumed') - END IF - IF (IAND(LEXT,MDU_T_SILM).NE.0) THEN - I3=4 !# UNKNOWNS - ELSE IF (IAND(LEXT,MDU_T_PEST).NE.0) THEN - I3=1 - ELSE IF (IAND(LEXT,MDU_T_LM).NE.0) THEN - I3=2 - ELSE IF (IAND(LEXT,MDU_T_I).NE.0) THEN - I3=1 - ELSE - I3=3 - END IF - LCNT=MXLCNT !MAX LOOP COUNT - CALL WNCTXT(F_TP,' ') !CR - CALL NMOSRT(0,GDESJ) !SORT ON INTENSITY - IF (.NOT.NMOUP0(LEXT)) THEN !GET LSQ AREA, INIT. - 30 CONTINUE - CALL WNCTXT(F_TP,'No memory for update process') - GOTO 901 - END IF - DO I=1,I3 !GET AVERAGE LSQ - IF (.NOT.WNMLGA(LSQA(I),LSQ_T_REAL,1)) GOTO 30 - END DO -C -C EXECUTE LOOP -C - 40 CONTINUE - IF (.NOT.NMOMSC(FCAIN,SETS)) THEN !CALCULATE MODEL DATA - CALL WNCTXT(F_TP,'Error in model calculation') - GOTO 900 - END IF - DO I=0,7 !TEST SET - CSTNAM(I)=-1 - END DO - MBAS=0 !MAX. BASELINE - DO I=1,I3 !INIT AVERAGE LSQ - CALL WNMLIA(LSQA(I),LSQ_I_ALL) - END DO -C -C DO SETS -C - DO WHILE (NSCSTG(FCAIN,SETS,STH,STHP,SNAM)) !NEXT SET -C -C GET IFR TABLES -C - IF (.NOT.NSCSIF(FCAIN,STH,IFRT,IFRA,ANG)) THEN !READ IFR TABLE - CALL WNCTXT(F_TP,'!/Error reading IFR table !AS', - 1 WNTTSG(SNAM,0)) - GOTO 10 !TRY NEXT SET - END IF - CALL NSCMBL(STHE(STH_RTP_E),STHJ(STH_NIFR_J),IFRT, - 1 SIFRS,BASEL) !MAKE BASEL. - DO I1=0,STHJ(STH_NIFR_J)-1 !BASELINES FOR ARCSEC - BASEL(I1)=BASEL(I1)/3600./DEG - END DO -C -C SHOW CURRENT SET -C - DO I1=0,3 - IF (CSTNAM(I1).NE.SNAM(I1)) THEN - DO I2=0,3 - CSTNAM(I2)=SNAM(I2) - END DO - CALL WNCTXT(F_TP,'Sector: !AS',WNTTSG(CSTNAM,0)) - END IF - END DO -C -C SOURCE MODEL -C - NPOL=STHI(STH_PLN_I) !# OF POL. - IF (.NOT.NMORDH(6,STP,SRA,SDEC,SFRQ)) GOTO 10 !MODEL PARAMETERS - CALL NMOMST(STP,SRA,SDEC,STH,LM0,FRQ0,TF,MINST) !GET SOME DATA -C -C DO SCANS -C - DO I=0,STHJ(STH_SCN_J)-1 !ALL SCANS -C -C INIT -C - HA=STHE(STH_HAB_E)+I*STHE(STH_HAI_E) !HA OF SCAN - IF (HA.LT.HARAN(1) .OR. HA.GT.HARAN(2)) GOTO 20 !FORGET -C -C GET DATA -C - IF (.NOT.NSCSCR(FCAIN,STH,IFRT,I,CORAP,CORDAP, - 1 SCH,WGT,DAT)) THEN !READ SCAN DATA - CALL WNCTXT(F_TP,'!6$EAF6.2 Error reading scan data',HA) - GOTO 10 !TRY NEXT SET - END IF -C -C GET SOURCE MODEL -C - CALL NMOMUV(STP,SRA,SDEC,STH,SCH,UV0) !GET UV DATA - CALL NMOMU4(0,FCAIN,I,STH,UV0,LM0,FRQ0, - 1 STHE(STH_RTP_E),NPOL,STHJ(STH_NIFR_J), - 1 IFRT,TF,MINST,CMOD) !GET MODEL - CALL NMOMUA(1,UV0,LM0,FRQ0,STHE(STH_RTP_E),4, - 1 STHJ(STH_NIFR_J),IFRT,TF,MINST,CMOD) !ADD TYPES 1 - CALL NMOCIY(STHJ,SCHE,ANG,CDAT,CMOD,-1) !CORRECT DATA -C -C MAKE EQUATIONS -C - CALL NMOUP1(LEXT,UV0,LM0,FRQ0,STHE(STH_RTP_E), - 1 STHJ(STH_NIFR_J),IFRT,TF,MINST, - 1 SPOL,BASEL,MBAS,WGT,DAT, - 1 STH,SCH,ANG) !MAKE EQUATIONS -C -C NEXT SCAN -C - 20 CONTINUE - END DO -C -C NEXT SET -C - 10 CONTINUE - END DO !END SETS -C -C SOLVE -C - IF (MBAS.LE.0) THEN !MAKE GUESS FOR BEAM - DX0=1.5/(3000.*PI2*STHD(STH_FRQ_D)/CL/(1.E-6)) !BEAM RADIANS - ELSE - DX0=1.5/(MBAS*3600.*DEG*PI2*STHD(STH_FRQ_D)/CL/(1.E-6)) !BEAM RADIANS - END IF - DY0=DX0/ABS(SIN(STHD(STH_DEC_D))*DPI2) - CALL NMOUP2(LEXT,DX0,DY0,LSQA,FIT) !SOLVE EQUATIONS -C -C SHOW RESULTS -C - CALL NMOUP3(LEXT) !SHOW RESULTS -C -C SHOW AVERAGES -C - DO I=1,I3 !GET AVERAGES - CALL WNMLTR(LSQA(I),I0) !CAN SOLVE - CALL WNMLSN(LSQA(I),SOL(I),MU,SD) - END DO - IF (IAND(LEXT,MDU_M_LOOP+MDU_M_ELOOP).EQ.MDU_M_LOOP) THEN - CALL WNCTXT(F_TP,'Loop !UJ produced goodness !E12.4', - 1 MXLCNT-LCNT,FIT) - END IF - IF (IAND(LEXT,MDU_T_ILM+MDU_T_SILM).NE.0) THEN !SHOW AVERAGES - CALL WNCTXT(F_TP,'Average weighted amplitude '// - 1 'gain (A(old)/A(new)):!60C!E10.3', - 1 SOL(1)) - CALL WNCTXT(F_TP,'Average weighted l,m shift '// - 1 '(arcsec, old-new):!60C!2E10.3', - 1 SOL(2)) - IF (IAND(LEXT,MDU_T_SILM).NE.0) THEN - CALL WNCTXT(F_TP,'Average weighted SI update '// - 1 '(old-new):!60C!E10.3', - 1 SOL(4)) - END IF - ELSE IF (IAND(LEXT,MDU_T_I).NE.0) THEN - CALL WNCTXT(F_TP,'Average weighted amplitude '// - 1 'gain (A(old)/A(new)):!60C!E10.3', - 1 SOL(1)) - ELSE IF (IAND(LEXT,MDU_T_LM).NE.0) THEN - CALL WNCTXT(F_TP,'Average weighted l,m shift '// - 1 '(arcsec, old-new):!60C!2E10.3', - 1 SOL(1)) - ELSE IF (IAND(LEXT,MDU_T_EXT).NE.0) THEN !EXTENDED -C CALL WNCTXT(F_TP,'Average weighted updates '// -C 1 '(old-new):!60C!3E10.3', -C 1 SOL(1)) - ELSE IF (IAND(LEXT,MDU_T_QUV).NE.0) THEN !POL - CALL WNCTXT(F_TP,'Average weighted QUV '// - 1 'gain (A(old)/A(new)):!60C!3E10.3', - 1 SOL(1)) - ELSE !ESTIMATE - CALL WNCTXT(F_TP,'***Estimate not yet implemented***') - END IF -C -C LOOP -C - IF (IAND(LEXT,MDU_M_LOOP+MDU_M_ELOOP).EQ.MDU_M_LOOP) THEN - IF ((FIT.GT.0 .OR. FIT.LT.-.001) .AND. LCNT.GT.0) THEN - LCNT=LCNT-1 - ELSE - LEXT=LEXT+MDU_M_ELOOP - END IF - GOTO 40 !LOOP - END IF -C -C READY -C - 900 CONTINUE - CALL NMOUP9(LEXT) !DELETE LSQ AREA - DO I=1,I3 !FREE LSQ AVERAGE - CALL WNMLFA(LSQA(I)) - END DO - 901 CONTINUE - CALL WNFCL(FCAIN) !CLOSE INPUT -C - RETURN -C -C - END diff --git a/src/nscan/nmowri.for b/src/nscan/nmowri.for deleted file mode 100644 index cb862aa0886a1b53f317d11ff66b1cc9758cb565..0000000000000000000000000000000000000000 --- a/src/nscan/nmowri.for +++ /dev/null @@ -1,44 +0,0 @@ -C+ NMOWRI.FOR -C WNB 910809 -C -C Revisions: -C - LOGICAL FUNCTION NMOWRI(FCA,IDX) -C -C Write a source model -C -C Result: -C -C NMOWRI_L = NMOWRI( FCA_J:I, IDX_J:I) -C Write the source list in area IDX -C to a node. The list will be sorted and merged. -C -C Include files: -C - INCLUDE 'WNG_DEF' - INCLUDE 'NMO_DEF' -C -C Entries: -C -C -C Parameters: -C -C -C Arguments: -C - INTEGER FCA !FILE TO WRITE TO - INTEGER IDX !MODEL INDEX -C -C Function references: -C - LOGICAL NMOWRS !WRITE SOURCE FILE -C -C Data declarations: -C -C- - NMOWRI=NMOWRS(FCA,GMDH(0,IDX)) !WRITE THE SOURCE FILE -C - RETURN -C -C - END diff --git a/src/nscan/nmowrs.for b/src/nscan/nmowrs.for deleted file mode 100644 index d3a374fdf5712466a6e2c8b988c811ad9a2cf246..0000000000000000000000000000000000000000 --- a/src/nscan/nmowrs.for +++ /dev/null @@ -1,108 +0,0 @@ -C+ NMOWRS.FOR -C WNB 900327 -C -C Revisions: -C - LOGICAL FUNCTION NMOWRS(FCA,SDESJ) -C -C Write a source model -C -C Result: -C -C NMOWRS_L = NMOWRS( FCA_J:I, SDESJ_J(0:*):I) -C Write the source list described by SDESJ -C to a node. The list will be sorted and merged. -C NMOWRX_L = NMOWRX( FCA_J:I, SDESJ_J(0:*):I, DAD_J:I) -C Write the source list to file FCA at DAD. -C -C PIN references -C -C -C Include files: -C - INCLUDE 'WNG_DEF' - INCLUDE 'NMO_DEF' - INCLUDE 'GFH_O_DEF' !GENERAL FILE HEADER - INCLUDE 'MDH_O_DEF' !MODEL HEADER - INCLUDE 'MDL_O_DEF' !MODEL LINE -C -C Entries: -C - LOGICAL NMOWRX -C -C Parameters: -C -C -C Arguments: -C - INTEGER FCA !FILE TO WRITE TO - INTEGER SDESJ(0:*) !MODEL DESCRIPTION - INTEGER DAD !DISK ADDRESS -C -C Function references: -C - LOGICAL WNFWR !WRITE TO FILE - LOGICAL WNDLNK !LINK ENTITY -C -C Data declarations: -C - BYTE MDH(0:MDHHDL-1) !SOURCE HEADER - INTEGER MDHJ(0:MDHHDL/4-1) - EQUIVALENCE (MDH,MDHJ) - INTEGER DPTR !DISK POINTER - LOGICAL WRS !TYPE -C- -C -C WRS -C - DPTR=GFHHDL !SET WHERE TO WRITE - WRS=.TRUE. !SET TYPE - GOTO 10 -C -C WRX -C - ENTRY NMOWRX(FCA,SDESJ,DAD) -C - DPTR=DAD !SET WHERE TO WRITE - WRS=.FALSE. !SET TYPE - GOTO 10 -C -C INIT -C - 10 CONTINUE - NMOWRS=.TRUE. !ASSUME OK - CALL NMOSRT(0,SDESJ) !SORT MODEL FILE - CALL WNGMV(MDHHDL,SDESJ,MDH) !SET HEADER - MDHJ(MDH_MODL_J)=MDHHDV !SET VERSION - MDHJ(MDH_MODP_J)=DPTR+MDHHDL !DISK POINTER - MDHJ(MDH_ACT_J)=MODACT !SAVE ACTION - IF (.NOT.WNFWR(FCA,MDHHDL,MDH,DPTR)) GOTO 900 !SAVE HEADER - IF (WRS) THEN - IF (.NOT.WNDLNK(GFH_LINK_1,GFHHDL,MDH_MID_1,FCA)) !LINK MODEL HEADER - 1 GOTO 900 - END IF -C -C WRITE SOURCES -C - J1=MDHJ(MDH_MODP_J) !OUTPUT POINTER - J0=SDESJ(MDH_MODP_J)-A_OB !INPUT ARRAY POINTER - DO I=0,MDHJ(MDH_NSRC_J)-1 !ALL SOURCES - IF (.NOT.WNFWR(FCA,MDLHDL,A_B(J0),J1)) GOTO 900 !WRITE SOURCE - J0=J0+MDLHDL !NEXT INPUT - J1=J1+MDLHDL !NEXT OUTPUT - END DO -C - IF (WRS) CALL WNFCL(FCA) !CLOSE FILE -C - RETURN -C -C ERRORS -C - 900 CALL WNCTXT(F_TP,'!/Error writing source file') - NMOWRS=.FALSE. !INDICATE ERROR - IF (WRS) CALL WNFCL(FCA) !CLOSE FILE -C - RETURN -C -C - END diff --git a/src/nscan/nsc.dsc b/src/nscan/nsc.dsc deleted file mode 100644 index 09c44469a538a929db6f8c29103f2015ce19e05e..0000000000000000000000000000000000000000 --- a/src/nscan/nsc.dsc +++ /dev/null @@ -1,82 +0,0 @@ -!+ NSC.DSC -! WNB 900130 -! -! Revisions: -! -%REVISION=CMV=940930="Add MXDATN" -%REVISION=WNB=930803="Remove .INCLUDE" -%REVISION=WNB=920813="Add MXNMOS" -%REVISION=WNB=900130="Original version" -! -! Layout of overall include file (NSC.DEF) -! -%COMMENT="NSC.DEF is an INCLUDE file for the NSCAN program" -%COMMENT=" " -! -%VERSION=1 -%SYSTEM=1 -%USER=WNB -%%DATE -%%NAME -! -%LOCAL=MXNLAB=256 !LABELS per job -%LOCAL=MXNJOB=16 !MAX. # OF JOBS -%LOCAL=MXNCHN=512 !MAX. # OF CHANNELS -%LOCAL=MXNPTC=512 !MAX. # OF POINTING CENTRES -%LOCAL=MXNSET=64 !MAX. # OF SETS -%LOCAL=MXNTEL=16 !MAX. # OF TELESCOPES -%LOCAL=MXNIFR=120 !MAX. # OF INTERFEROMETERS -%LOCAL=MXNMOS=120 !MAX. # OF MOSAICK FIELDS -%LOCAL=MXDATN=5000 !MAX. # OF INPUT DATA POINTS -%LOCAL=MXDATX=24576 !MAX. # OF OUTPUT DATA POINTS -!- -.DEFINE - .PARAMETER - MXNLAB J /MXNLAB/ !MAX. LABELS PER JOB - MXNJOB J /MXNJOB/ !MAX. # OF JOBS - MXNCHN J /MXNCHN/ !MAX. # OF CHANNELS - MXNPTC J /MXNPTC/ !MAX. # OF POINTING CENTRES - MXNSET J /MXNSET/ !MAX. # OF SETS - MXNTEL J /MXNTEL/ !MAX. # OF TELESCOPES - MXNIFR J /MXNIFR/ !MAX. # OF INTERFEROMETERS - MXNMOS J /MXNMOS/ !MAX. # OF MOSAICK FIELDS - MXDATN J /MXDATN/ !MAX. # OF INPUT DATA POINTS - MXDATX J /MXDATX/ !MAX. # OF OUTPUT DATA POINTS - SRTRCL J /128/ !RECORD LENGTH OF WSRT TAPE - .DATA -! -! Local variables: -! - .COMMON - OPTION C24 !PROGRAM OPTION - OPT=OPTION C3 - UNIT C4 !INPUT UNIT - OUNIT C4 !OUTPUT UNIT - IFILE C80 !INPUT FILE NAME - OFILE C80 !OUTPUT FILE NAME - NJOB J !# OF JOBS TO DO - NLAB J(MXNJOB) !# OF LABELS TO DO - ILAB J(MXNLAB,MXNJOB) !LABELS TO DO - NODE C80(MXNJOB) !OUTPUT NODES - OLAB J !1ST OUTPUT LABEL - IMCA J !INPUT MCA/FCA - OMCA J !OUTPUT MCA/FCA - NPTC J(MXNJOB) !POINTING CENTRES PER JOB - IPTC J(MXNPTC,MXNJOB) !POINTING SETS SELECTED - NCHAN J(MXNJOB) !CHANNELS PER JOB - CHAN J(MXNCHN,MXNJOB) !CHANNELS SELECTED - POL J(MXNJOB) !POLARISATIONS TO DO - INTOFF E(MXNJOB) !INTEGRATION START OFFSET - SETS J(0:7,0:MXNSET) !SETS TO DO - OINT J !OUTPUT INTEGRATION TIME (SEC) - CVUTST D !UT/ST CONVERSION FACTOR - FCAOUT J !OUTPUT FCA - NODOUT C80 !OUTPUT NODE - FCAIN J !INPUT FCA - NODIN C80 !INPUT NODE - IBMSW J !IBM INPUT - DECSW J !DEC INPUT - SGPH J(0:7) !SUB-GROUP POINTER - SGNR J(0:7) !SUB-GROUP NUMBER - IFSETS J !INT.TIME FOR IF-SETS -.END diff --git a/src/nscan/nsc.grp b/src/nscan/nsc.grp deleted file mode 100644 index 71f028b6a16cd435fb9247032c37c5be8d2b6c09..0000000000000000000000000000000000000000 --- a/src/nscan/nsc.grp +++ /dev/null @@ -1,232 +0,0 @@ -!+ NSC.GRP -! WNB 900118 -! -! Revisions: -! WNB 910814 Add NSCSCT -! WNB 910820 Add NSCSCW -! WNB 910826 Delete NSCSTA -! WNB 910828 Add NGEN.PIN -! WNB 910910 Add NSCCOP -! WNB 911031 Add NSCWE0, 1 -! WNB 920127 Add DO_NSERIES -! WNB 920826 Add NSCSCM -! WNB 920827 Add NSCSCI -! WNB 921007 Add NCOPY.COM -! WNB 921212 Add PEF; change PIN to PSC -! WNB 921221 Add NSCWE2 -! WNB 921231 Remove DO_NSERIES -! HjV 930309 Add NSETS.PEF -! HjV 930426 Add NCOMM.PEF, NCOMM.PSC -! HjV 930528 Add SCN.DSC -! WNB 930606 Delete NCOMM.PSC -! WNB 930610 Add NSCDF0,9,1,2 -! WNB 930615 Add NSCDF5,6,7,8,S -! WNB 930616 Add DLF.DSC, DLH.DSC -! WNB 930617 Create NSCDF5.FOR -! HjV 930618 Add CBITS.DSC -! WNB 930619 Remove NSCDEL, NSCPRT, NSCDF*, DLH.DSC, DLF.DSC -! WNB 930803 Add NSTAR.DSF -! WNB 930819 Add NSCNOP -! WNB 930824 Add NSCIF1, NSCTLS, TL1 -! WNB 930825 Add NSCPLS,PL1,PL2,NSCHAS,HA1 -! WNB 930901 Add NSCRIF -! HjV 930914 Add NSCSCW (Split from NSCSCR) -! CMV 931115 Changed ncopy.sun to ncopy.csh -! CMV 931116 Add NSHOW.PEF for SHOW keywords -! WNB 931126 Change order NSHOW.PEF -! JPH 931206 Add NGEN.FOR -! WNB 940216 Add QUB.DSC, NSCQ* -! HjV 940217 Add/change missing entry-points/functions -! WNB 940227 Add NSCSIA -! CMV 940425 Add IFH.DSC, NSCLIF and NSCGIF -! HjV 940607 Add RFH.DSC, RSH.DSC and RSC.DSC -! HjV 940726 Add missing entry-point NSCGF1 and NSCGF2 -! WNB 940729 Add NSCQC0, NSCQW0 -! WNB 940801 Add NSCQW1, NSCQC1, NSCQC2, NSCQS4 -! WNB 940803 Add NSCQFN, NSCQFR, NSCQSR, NSCQR0 -! WNB 940811 Add NSCSWI, NSCSCX -! WNB 940812 Add NSCQE0/1, NSCQWA/M/F -! CMV 940821 Add SCNSETS.PEF -! HjV 940928 Remove NSCHA1 -! JPH 941005 NSCSTD -! JPH 941017 Add SCNNODE.PEF BSETS.PEF, SELECT.PEF, UNIT.PEF -! Remove NCOMM.PEF, NSETS.PEF -! CMV 940930 Add NSCGGN -! HjV 950130 Add NLEIDEN.FOR, NLEIRD.FOR,NLEIWD.FOR, FDL.DSC, IHL.DSC -! WNB 950704 Add NSCSCY -! HjV 951120 Add NLEILU -! JPH 960613 Add DLDM -! -! Scan handling -! -! Group definition: -! -NSC.GRP -! -! Command files -! -NCOPY.CSH ! Copy data from other machine - NCOPY.COM -! -! PIN files -! -NGEN.PEF ! General include file -!!NCOMM.PEF ! old: all NODE and selection keywords -!!NSETS.PEF ! old: all SETS keywords -SCNNODE.PEF ! SCN_NODE keywords -SCNSETS.PEF ! SCN_SETS keywords -SELECT.PEF ! selection within SETS -UNIT.PEF ! tape-unit keywords -NSHOW.PEF ! Parameters for SHOW option (NSCAN/NFLAG) -! -NGEN.PSC ! General parameters -NSCAN.PSC ! Parameters for NSCAN -! -! Structure files -! -NSTAR.DSF ! Defines overall # of telescopes etc. -! -CBITS.DSC ! Symbolic names for mask bits -QUB.DSC ! Sacn Qube infrastructure -! -FDW.DSC ! FD block -FDX.DSC ! FD extension block -IHW.DSC ! IH block -OHW.DSC ! OH block -SCW.DSC ! SC block -SHW.DSC ! SH block -SCH.DSC ! Scan header block -STH.DSC ! Set header block -DLDM.DSC ! Copy of STH_DLDM in a common block -IFH.DSC ! IF-data header block -RFH.DSC ! R-series file header -RSH.DSC ! R-series set header -RSC.DSC ! R-series scan and data header -FDL.DSC ! LEIDEN FD block -IHL.DSC ! LEIDEN IH block -! -! Fortran definition files: -! -NSC.DSC ! Program common/parameters -SCN.DSC ! Hierarchy of SGH levels -! -! Programs: -! -NSCAN.FOR ! Main routine -NGEN.FOR ! Dummy program to allow setting -! NGEN parameters -NLEIDEN.FOR !NLEIDEN Load LEIDEN data in SCN file -NLEILU.FOR !NLEILU List LEIDEN data on tape -NLEIRD.FOR !NLEIRD Read LEIDEN data into TMP file -NLEIWD.FOR !NLEIWD Write LEIDEN data to SCN file -NSCCLP.FOR !NSCCLP Calculate prec. rotation angle -NSCCOP.FOR !NSCCOP Copy scan sets -NSCCVX.FOR !NSCCVX Convert from VAX to local format -NSCCV1.FOR !NSCCV1 Conversion help routine -NSCDAT.FOR !NSCDAT Get program data -NSCDMP.FOR !NSCDMP Dump tape to disk -NSCGIF.FOR !NSCGIF Get IF/Total power data - !NSCGF1 Return begin HA, HA incr. and # of TP points - !NSCGF2 Print header information -NSCGGN.FOR !NSCGGN Get Gain correction for TPon/off values -NSCHAS.FOR !NSCHAS Select HA_RANGE -NSCIFS.FOR !NSCIFS Select interferometers - !NSCIF1 Select interferometers per instrument -NSCINI.FOR !NSCINI Initialise program -NSCLLI.FOR !NSCLLI List WSRT data on tape -NSCLOD.FOR !NSCLOD Load WSRT data in SCN file -NSCLRD.FOR !NSCLRD Read WSRT data into TMP file -NSCLWD.FOR !NSCLWD Write WSRT data to SCN file -NSCLIF.FOR !NSCLIF Read/write WSRT IF-sets to SCN file -NSCMBL.FOR !NSCMBL Make baselines -NSCNOP.FOR !NSCNOP Make new option values in scan -NSCNVS.FOR !NSCNVS Make newest version -NSCOFR.FOR !NSCOFR From OLD format -NSCOTO.FOR !NSCOTO To OLD format -NSCPFH.FOR !NSCPFH Print general file header -NSCPFL.FOR !NSCPFL Print file layout -NSCPLS.FOR !NSCPLS Select XYX polarisations to use - !NSCPL1 Same, use instrument - !NSCPL2 Select Stokes or XYX pol. to use -NSCPSH.FOR !NSCPSH Print set header -NSCPSL.FOR !NSCPSL Print scan header -NSCPUV.FOR !NSCPUV Print FITS tape -NSCQC0.FOR !NSCQC0 Compare Qube entries - !NSCQC1 Compare Qube field entries - !NSCQC2 Compare Qube freq entries -NSCQE0.FOR !NSCQE0 Sort and write ifr errors - !NSCQE1 Clear ifr error table -NSCQFN.FOR !NSCQFN Get next field - !NSCQFR Reset field search -NSCQOP.FOR !NSCQOP Open Qube infrastructure - !NSCQCL Close Qube infrastructure -NSCQR0.FOR !NSCQR0 Find an IFR scan -NSCQS0.FOR !NSCQS0 Sort Qube on Frequency - !NSCQS1 Sort Qube on HA - !NSCQS2 Sort Qube on J fields - !NSCQS3 Sort Qube on E fields - !NSCQS4 Sort Qube on D fields -NSCQSR.FOR !NSCQSR Read a Qube 'scan' -NSCQW0.FOR !NSCQW0 Write Qube list part (sorted) - !NSCQW1 Merge QUBE parts -NSCQWA.FOR !NSCQWA Write additive ifr errors in Qube - !NSCQWM Write multiplicative ifr errors in Qube -NSCQWF.FOR !NSCQWF Force possible ifr errors from buffer -NSCREG.FOR !NSCREG Re-group sets in sub-groups -NSCRIF.FOR !NSCRIF Read interferometer table information -NSCSAD.FOR !NSCSAD Get corrections to (de-)apply - !NSCSAZ Get correction to put to zero -NSCSCR.FOR !NSCSCR Read scan data and header - !NSCSCH Read scan header only - !NSCSCT Read scan telescope corrections - !NSCSCX Read scan corrections - !NSCSCY Read scan correctiosn - !NSCSCM Read scan model data - !NSCSCI Get interferometer corrections - !NSCSCF Read data and flags -NSCSCW.FOR !NSCSCW Write scan header only - !NSCSDW Write scan number SCN to FCA - !NSCSFW Write scan number SCN to FCA using FLW -NSCSIF.FOR !NSCSIF Read interferometer table info - !NSCSIA Calculate some table info - ! (old, use NSCRIF) -NSCSTG.FOR !NSCSTG Get next set specified - !NSCSTH Get next set, no version check - !NSCSTL Get next set with loop info - !NSCSTD Same, delete index link to set -NSCSWC.FOR !NSCSWC Write correction in scan header - !NSCSWU Write corrections and m.e.'s -NSCSWI.FOR !NSCSWI Write interferometer corrections -NSCTLS.FOR !NSCTLS Select telescopes - !NSCTL1 Same, use instrument -NSCUMF.FOR !NSCUMF Make FITS line - !NSCUMS Make FITS line from string data - !NSCUMB Make FITS binary data -NSCUVF.FOR !NSCUVF Write UVFITS tape/disk -NSCUV0.FOR !NSCUV0 Write UVFITS header -NSCUV1.FOR !NSCUV1 Write UVFITS AN header -NSCUV2.FOR !NSCUV2 Write UVFITS FQ header -NSCUV3.FOR !NSCUV3 Write UVFITS SU header -NSCUV4.FOR !NSCUV4 Write UVFITS SN header -NSCUV5.FOR !NSCUV5 Write UVFITS BP header -NSCUWB.FOR !NSCUWB Write FITS line from buffer - !NSCUWS Write FITS line from string - !NSCUWL Write FITS data from buffer - !NSCUWF Fill FITS record -NSCWE0.FOR !NSCWE0 Correct mosaic WSRT tape error in HA - !NSCWE1 Correct constant HA error - !NSCWE2 Flop sign phase -NSCXES.FOR !NSCXES General edit area -NSCXFH.FOR !NSCXFH Show file header area complete - !NSCEFH Edit file header -NSCXSH.FOR !NSCXSH Show set header area complete - !NSCESH Edit set header -NSCXSL.FOR !NSCXSL Show scan header area complete - !NSCESL Edit scan header -NSCXXS.FOR !NSCXXS General show area -! -! Executables -! -NSCAN.EXE ! Scan handling -NGEN.EXE -!- diff --git a/src/nscan/nscan.for b/src/nscan/nscan.for deleted file mode 100644 index f598070cc8fb3988e452d023317194f1006cd91e..0000000000000000000000000000000000000000 --- a/src/nscan/nscan.for +++ /dev/null @@ -1,107 +0,0 @@ -C+ NSCAN.FOR -C WNB 900130 -C -C Revisions: -C WNB 910828 Add RUN -C WNB 911031 Add WERR -C WNB 921221 Add AERR -C WNB 930608 Add FLAG -C WNB 930619 Remove SHOW and FLAG -C WNB 930707 Add COPY -C WNB 930819 Add NOPT -C HjV 930922 Add SHOW again -C CMV 931220 Replace copy by message about NCOPY -C CMV 940223 New option LIST -C CMV 941012 New option WARC -C JPH 941207 All options return to NSCDAT, only exit is through QUIT -C JPH 941207 Close FCAIN, FCAOUT before NSCDAT (write-protect -C problem) -C HjV 950116 Add LEIDEN, change LOADIF in IFLOAD -C HjV 951113 Change option WARC into ARC. Result is in LARC/WARC -C - SUBROUTINE NSCAN -C -C Main routine to handle Scan files -C -C Result: -C -C -C Include files: -C - INCLUDE 'WNG_DEF' - INCLUDE 'NSC_DEF' -C -C Parameters: -C -C -C Arguments: -C -C -C Function references: -C - LOGICAL WNDRUN !TEST RUN -C -C Data declarations: -C -C- -C -C PRELIMINARIES -C - CALL NSCINI !INIT PROGRAM -C -C DISTRIBUTE -C - 10 CONTINUE - CALL WNFCL(FCAIN) - CALL WNFCL(FCAOUT) - CALL NSCDAT !GET USER DATA - IF (.NOT.WNDRUN()) CALL WNGEX !NO RUN - IF (OPT.EQ.'QUI') THEN !READY - CALL WNGEX !FINISH - ELSE IF (OPT.EQ.'DUM') THEN !DUMP - CALL NSCDMP - ELSE IF (OPT.EQ.'LOA') THEN !LOAD - CALL NSCLOD(0) - ELSE IF (OPT.EQ.'IFL') THEN !IFLOAD - CALL NSCLOD(0) - ELSE IF (OPT.EQ.'WIS') THEN !WIST (LIST WSRT-tape) - CALL NSCLOD(1) - ELSE IF (OPT.EQ.'WAR') THEN !WARC (ARC WSRT-tape) - CALL NSCLOD(2) - ELSE IF (OPT.EQ.'LEI') THEN !LEIDEN - CALL NLEIDEN(0) - ELSE IF (OPT.EQ.'LIS') THEN !LIST (LIST LEIDEN-tape) - CALL NLEIDEN(1) - ELSE IF (OPT.EQ.'LAR') THEN !LARC (ARC LEIDEN-tape) - CALL NLEIDEN(2) - ELSE IF (OPT.EQ.'SHO') THEN !SHOW DATA - CALL NFLPRT - ELSE IF (OPT.EQ.'FRO') THEN !COPY FROM OLD - CALL NSCOFR - ELSE IF (OPT.EQ.'TO_') THEN !COPY TO OLD - CALL NSCOTO - ELSE IF (OPT.EQ.'REG') THEN !REGROUP DATA - CALL NSCREG - ELSE IF (OPT.EQ.'UVF') THEN !WRITE UVFITS - CALL NSCUVF - ELSE IF (OPT.EQ.'PFI') THEN !PRINT UVFITS - CALL NSCPUV - ELSE IF (OPT.EQ.'CVX') THEN !CONVERT VAX TO LOCAL - CALL NSCCVX - ELSE IF (OPT.EQ.'NVS') THEN !MAKE NEWEST VERSION - CALL NSCNVS - ELSE IF (OPT.EQ.'NOP') THEN !MAKE NEWEST OPTIONS - CALL NSCNOP - ELSE IF (OPT.EQ.'WE0') THEN !CORRECT MOSAIC TAPE ERROR - CALL NSCWE0 - ELSE IF (OPT.EQ.'WE1') THEN !CORRECT MOSAIC TAPE ERROR - CALL NSCWE1 - ELSE IF (OPT.EQ.'AER') THEN !CORRECT SIGN PHASE - CALL NSCWE2 - ELSE IF (OPT.EQ.'VFI') THEN !RECALC VELOCITIES - CALL NSCWE3 - END IF -C - GOTO 10 !BACK TO OPTIONS= PROMPT -C - END diff --git a/src/nscan/nscan.psc b/src/nscan/nscan.psc deleted file mode 100644 index a5096af11f1d7dd1e83d9b4a6b7792b89422e337..0000000000000000000000000000000000000000 --- a/src/nscan/nscan.psc +++ /dev/null @@ -1,593 +0,0 @@ -!+ NSCAN.PSC -! WNB 900131 -! -! Revisions: -! WNB 910820 Add extinction, refraction, Faraday -! WNB 910828 Add RUN -! WNB 910909 Add DATAB and INFIX -! WNB 910910 Add MODEL data an COPY -! WNB 910912 Add to (de)apply model and ifr -! WNB 910913 New (de-)apply and loops -! WNB 910918 Text magtapes -! WNB 911007 Include instrum. pol. -! WNB 911014 Add CLIP flag option -! WNB 911031 Add WERR option -! WNB 911230 NMODEL -! WNB 920504 Add NOISE flag <0 (temporary solution) -! WNB 920626 Add DCLOW, change Rotation measure description -! WNB 920828 Explanation NVS -! WNB 920828 Add SET_PATTERN -! WNB 920831 Add Stokes conversion to NVS -! WNB 921022 Text magtapes -! WNB 921104 Text Select IFRS; HA range; J2000 -! WNB 921211 Make PSC -! WNB 921221 Add AERR, parall. angle to NVS -! JEN 930308 add INCLUDE=NSETS_PEF, remove keyword SETS -! JEN 930311 change SET_ACTION into SECTOR_ACTION -! JEN 930311 Drastic improvement af all HELP-texts -! JEN 930312 INCLUDE=NCOMM_PEF -! JEN 930312 Remove keyword(s) INPUT_SCAN, OUTPUT_SCAN, INOUT_SCAN -! JEN 930312 Remove keyword(s) SELECT_IFRS, POLARISATION, HA_RANGE -! JEN 930312 Remove keyword(s) INPUT_UNIT, OUTPUT_UNIT -! HjV 930426 Change name keyword SET_PATTERN -! WNB 930608 Add USER_FLAG, some DELETE_TYPE (FLAG, UNFLAG, UFLAG) -! change "delete" in "flag". -! Add NAME and FLAGS option to SECTOR_ACTION -! WNB 930609 Add FLAG_OPTION; restructure with FLAG_TYPE -! WNB 930610 Add SHOW, CORR, X/Y... FLAG_OPTIONS/_TYPES and more -! WNB 930615 Add GET, FORCE flag options/types -! WNB 930615 Change FLAG_OPTION in _MODE -! WNB 930615 Add CLEAR, LOAD, UNLOAD to FLAG_MODE; PUT_RANGE -! WNB 930617 Text PUT_RANGE; add FLAG_LIMIT; add READ/WRITE options -! WNB 930617 Change FLAG_TYPE to operations, add FLAG_OPTION -! WNB 930617 Split OPERATIONS: too many keywords! -! WNB 930619 Remove SHOW and FLAG options and related keywords -! WNB 930707 Text COPY option -! WNB 930819 Add NOPT -! WNB 930825 Remove UVFITS_POLAR -! HjV 930922 Add SHOW for keyword OPTION and add keywords -! FILE_ACTION, SECTOR_ACTION, SCAN_ACTION and EDIT -! CMV 931116 Split off SHOW keywords to NSHOW.PEF -! CMV 931220 Effectively remove COPY option (option still there) -! CMV 940223 Add LIST option -! CMV 940422 Add LOADIF option and IFSETS prompt -! HjV 940519 Add OLD_DATTYP -! JPH 940913 Remove () on prompts -! JPH 941005 Reorganise .pef files -! JPH 941019 OPTIONS formatting -! JPH 941206 UNITS_PEF -! JPH 950118 Add WARC (CMV 941107) -! CMV 950123 Add suboptions for WARC -! HjV 950130 Change LOADIF in IFLOAD, Add LEIDEN -! HjV 950612 Add MDLNODE_PEF -! JPH 950821 Text mods -! JPH 960404 Merge WARC-->ARC, TAPE_TYPE (HjV 951113) -! JPH 961112 Add help text -! CMV 970206 Add BITPIX for UVFITS -! -! Get overall action -! Ref: NSCDAT -! -KEYWORD=OPTION - DATA_TYP=C - IO=I - LENGTH=24 - CHECKS=ABBREV_OPTIONS - SWITCHES=LOOP,NULL_VALUES,WILD_CARDS - SEARCH=L,P - PROMPT="Action" - OPTIONS=- -QUIT; LOAD,IFLOAD,LEIDEN,LIST,ARC,DUMP; UVFITS,PFITS; | - -SHOW; [CVX,NVS,NOPT; REGROUP; FROM_OLD,WERR,AERR,VFIX] - HELP=" -Specify the action to be performed by the program NSCAN: -. - Operations on WSRT 'circle' observation files (on classical, DAT or Exabyte - tape, magnetic or optical disk): -. - LOAD transfer observed visibilities into a .SCN file. - IFLOAD same, but also transfer the 'IF' data (total powers etc). The - extra data will enlarge the .SCN file by some 30%; you need - them only if you suspect that the on-line gain calibration has - been incorrect. - LEIDEN transfer observed visibilities from standard LEIDEN file into a - .SCN file - LIST show contents of selected labels - ARC as list, but update the Scissor database if at NFRA - DUMP copy selected label(s) byte for byte into a disk file -. - Conversion to and listing of data in FITS format -. - UVFITS convert .SCN file to UVFITS tape/disk file for use in AIPS - PFITS print AIPS-like FITS info (but also other) from UVFITS file - header -. - Display and editing of .SCN files: -. - SHOW show/edit data and header information in .SCN file. (This - option is duplicated in NFLAG.) -. - Utilities: -. - QUIT leave the program NSCAN -. - CVX convert a .SCN file from other machine's number format - NVS convert a .SCN file to newest version. Needs only to be run if - programs report that the data has the wrong version - - calculates parallactic angle for ATNF - NOPT update contents of sector/scan headers and polarisation format - of visibility data: - - convert input data in Stokes parameter format to XX format - - calculate UT start - - calculate precession rotation angle if not filled - - recalculate MJD for observations aborted at Wbork - REGROUP create a second index for each of one or more sets of sector.! -. - One-time fixes: -. - FROM_OLD convert old (R-series) uv-data file into NEWSTAR .SCN file - WERR correct one-time mosaic WSRT tape errors (1991 data only) - AERR change sign of phases - VFIX recalculate velocities" -! -! Get ARC / LIST suboption -! Ref: NSCDAT -! -! -KEYWORD=TYPE_TAPE - DATA_TYP=C - IO=I - LENGTH=6 - CHECKS=ABBREV_OPTIONS - SWITCHES=LOOP,NULL_VALUES,WILD_CARDS - SEARCH=L,P - PROMPT="Which type tape" - OPTIONS=WSRT,LEIDEN - HELP=" -Specify the type of the tape. -. -Currently we support two types: WSRT and LEIDEN." -! -! Get WARC suboption -! Ref. NSCDAT -! -! -KEYWORD=ARC_OPTION - DATA_TYP=C - IO=I - LENGTH=24 - CHECKS=ABBREV_OPTIONS - SWITCHES=LOOP,NULL_VALUES,WILD_CARDS - SEARCH=L,P - PROMPT="ARC Action" - OPTIONS=CHECK,ARCHIVE - HELP=" -Checking in a WSRT tape has two phases. In the first phase, the ARC option -CHECK is used to verify the general integrity of the tape. The tape is listed -and all blocks are read. In the second phase labels are copied to the archive -medium (with the DUMP option) and the Scissor database is updated through ARC -option ARCHIVE." -! -! Get WERR action -! Ref: NSCDAT -! -KEYWORD=WERR_OPTION - DATA_TYP=C - IO=I - LENGTH=24 - CHECKS=ABBREV_OPTIONS - SWITCHES=LOOP,NULL_VALUES,WILD_CARDS - SEARCH=L,P - PROMPT="WERR action" - OPTIONS=WE0,WE1; QUIT - HELP=" -Specify correction to be performed: -. - WE0: correct Hour angles for tape error in splitted mosaic tapes before - online version 62 - WE1: correct all Hour angles with a constant offset - QUIT: no more" -! -! -! Get input file -! Ref: NSCDAT -! -KEYWORD=INPUT_FILE - DATA_TYP=C - IO=I - LENGTH=80 - SWITCHES=LOOP,NULL_VALUES,WILD_CARDS - SEARCH=L,P - PROMPT="input filename" - HELP=" -Specify the input disk-file name. -. -For the NSCAN LOAD-from-disk option, or for the NSCAN PFITS option, don't -specify a file extension: it will be made by the program on the basis of the -tape label number. -. -In the case of other NSCAN options, give the full file name." -!! WNDPOH -! -! Get integration time -! Ref: NSCDAT -! -KEYWORD=INTEGRATION_TIME - DATA_TYP=J - IO=I - SWITCHES=LOOP,NULL_VALUES,WILD_CARDS - CHECK=MAXIMUM,MINIMUM - MAXIMUM=3600 - MINIMUM=10 - SEARCH=L,P - PROMPT="integration time (sec)" - DEFAULT=120 - HELP=" -Specify the desired integration time per output scan in seconds. - -120 sec is a good default; a lower value should be selected if visibilities -vary rapidly as a consequence of the source distribution in the observed field, -atmospheric conditions or interference. -. -For standard observations, the number must be a multiple of the basic -integration time used for the observation (which is some multiple of 10 sec). -. -In WSRT mosaic observations, slewing occurs in the last 10 sec of the dwell -time on each subfield. The integration time you specify must therefore at most -be <dwell time> minus 10 sec. You may also use a submultiple of this value -without losing data. -. - Example: - If the dwell time is 90 sec, there is 80 sec of valid data. HA_INT = 80, - 40, 20 or 10 will use it all. However, HA_INT = 30 or 60 will result in the - loss of the last 20 sec. -. - The volume of your data in the .SCN depends primarily on the -integration time. For each integration interval a 'scan' is created which -consists of -. - <nr of polarisations> * <nr of interferometers> * 12 + 1024 bytes -. -Model visibilities which may be added later will occupy another -. - 4 * <nr of interferometers> * 12 bytes . NOTE: - The WSRT runs on Universal Time; the quantum of integration time is -therefore 10 UT seconds, and a full 12-sidereal-hour observation contains -somewhat less than 12*360 of these quanta. You can mostly ignore this subtlety, -but the difference may be of practical importance in some situations. " -! -! Get output file -! Ref: NSCDAT -! -KEYWORD=OUTPUT_FILE - DATA_TYP=C - IO=I - LENGTH=80 - SWITCHES=LOOP,NULL_VALUES,WILD_CARDS - SEARCH=L,P - PROMPT="output filename" - HELP=" -Specify the full name for the output disk file. -. -For the NSCAN DUMP option, don't specify a file extension: it will be made by -the program on the basis of the label number. -. -For the other NSCAN options, specify a full file-name." -!! WNDPOH -! -! Get input labels -! Ref: NSCDAT -! -KEYWORD=INPUT_LABELS - DATA_TYP=J - IO=I - NVALUES=256 - SWITCHES=LOOP,NULL_VALUES,WILD_CARDS - SEARCH=L,P - PROMPT="input tape labels" - HELP=" -Specify the tape labels to be read. -. - '*' selects all labels -. - '<begin> TO <end>> BY <step>' selects labels <begin>, <begin>+<step>, ... - up to <end>. The 'BY <step>' part may be omitted. - BEWARE: The notation <begin>-<end>:<step> will be interpreted as an - expression and give incorrect results -. -Each of the selected labels will be stored in the .SCN file as a separate -'observation' (obs) in the current 'group' grp. (Remember that .SCN file -'sectors' are identified by indices grp.obs.fld.chn.seq). -. -Example: - If the current group nr is <g>, the selected input labels will be -stored sequentially in the .SCN file as observations <g>.0, <g>.1, <g>.2 " -! -! Get output label -! Ref: NSCDAT -! -KEYWORD=OUTPUT_LABEL - DATA_TYP=J - IO=I - SWITCHES=LOOP,NULL_VALUES,WILD_CARDS - SEARCH=L,P - PROMPT="output tape label" - HELP=" Specify the first output tape label. -* or 0 indicates the end of the tape (i.e. append the new labels at the end)." -! -! Get pointing sets to do -! Ref: NSCDAT -! -KEYWORD=POINTING_SETS - DATA_TYP=J - IO=I - NVALUES=512 - SWITCHES=LOOP,NULL_VALUES,WILD_CARDS - SEARCH=L,P - PROMPT="Mosaic field sequence number(s)" - HELP=" Select the SEQUENCE numbers of the fields (= mosaic 'pointing -centres') to be selected. (see Note below). -. -NOTE that WSRT mosaic fields are numbered starting at 1 -. - '*' selects all fields -. - '<begin> TO <end>> BY <step>' selects fields <begin>, <begin>+<step>, ... - up to <end>. The 'BY <step>' part may be omitted. - BEWARE: The notation <begin>-<end>:<step> will be interpreted as an - expression and give incorrect results -. -Each of the selected fields will be stored in the .SCN file as a separate -'field' (fld) under the current 'group' and 'observation' grp.obs. (Remember -that .SCN file 'sectors' are identified by indices grp.obs.fld.chn.seq). -. -NOTE: - The numbers you specify refer to the SEQUENCE (starting with 0) in -which the mosaic fields aqppear on the tape. Normally, an observation starts -with field 0 and the sequence numbers equal the field numbers. However, if your -observation starts 'somehere in the middle', this is no longer the case and you -must be careful in selecting your fields. Example: -. - Your observation starts at field 19. To select fields 19 through 24, -specify POINTING_SETS= 0 TO 5. " -! -! Get channels to do -! Ref: NSCDAT -! -KEYWORD=CHANNELS - DATA_TYP=J - IO=I - NVALUES=512 - SWITCHES=LOOP,NULL_VALUES,WILD_CARDS - SEARCH=L,P - PROMPT="frequency channel number(s)" - HELP=" -Select the frequency channels/bands to be included. NOTE that the WSRT -continuum channel (i.e. the sum of all channels) always has number 0 -. - '*' selects all channels -. - '<begin> TO <end>> BY <step>' selects channels <begin>, <begin>+<step>, ... - up to <end>. The 'BY <step>' part may be omitted. - BEWARE: The notation <begin>-<end>:<step> will be interpreted as an - expression and give incorrect results -. -Each of the selected channels will be stored in the .SCN file as a separate -'channel' (chn) under the current 'group', 'observation' and 'field' -grp.obs.fld. (Remember that .SCN file 'sectors' are identified by indices -grp.obs.fld.chn.seq). " -! -! Ask wether IF datasets (total powers etc) should be loaded -! Ref: NSCDAT -! -KEYWORD=IFSETS - DATA_TYP=J - IO=I - SWITCHES=LOOP,NULL_VALUES,WILD_CARDS - CHECK=MAXIMUM,MINIMUM - MAXIMUM=3600 - MINIMUM=0 - SEARCH=L,P - PROMPT="integration time for total-power data" - HELP=" -Specify the desired integration time for IF sets with Total Power data." -! -! Get IAT-UTC -! Ref: NSCUVF -! -KEYWORD=IAT_UTC - DATA_TYP=R - IO=I - NVALUES=20 - SWITCHES=VECTOR - SEARCH=L,P - DEFAULTS=48257,26,900000,27,900000,27,900000,27,900000,27, - - 900000,27,900000,27,900000,27,900000,27,900000,27 /NOASK - PROMPT="MJD, leap seconds,..." - HELP=" -Specify the IAT-UTC values as pair(s) of numbers: -. - MJD at which the leap seconds occur - The total number of leap seconds as from that date. -. -The first value is for 1 Jan 1991. Values before that are known by the program." -! -! Get BITPIX -! Ref: NSCUVF -! -KEYWORD=BITPIX - DATA_TYP=J - IO=I - NVALUES=1 - SWITCHES=NULL_VALUES - SEARCH=L,P - DEFAULT=16 - PROMPT="Precision for writing UVFITS output" - HELP=" -Specify the precision for writing UVFITS data. -. - 16 2 bytes integers - 32 4 bytes integers - -32 IEEE Floating point values (not yet supported)" -! -! -! Get mosaic RA -! Ref: NSCWE0 -! -KEYWORD=WERR_RA - DATA_TYP=D - IO=I - SWITCHES=LOOP,NULL_VALUES,WILD_CARDS - UNITS=DEG,RAD,CIR,HMS - SEARCH=L,P - PROMPT="RA of mosaic centre" - HELP=" -Specify the Right Ascension of the centre of the mosaic area" -! -! Get mosaic HA -! Ref: NSCWE0 -! -KEYWORD=WERR_HA - DATA_TYP=D - IO=I - SWITCHES=LOOP,NULL_VALUES,WILD_CARDS - UNITS=DEG,RAD,CIR,HMS - SEARCH=L,P - PROMPT="Hour-angle correction (deg)" -!! DEFAULT=0 /NOASK (suggestion by JPH) - HELP=" -Specify the angle to be added to all hour angles in the .SCN file -. -NOTE: This is a special feature to be used only to correct errors made in the -on-line observation. " -! -! Get ref velocity -! Ref: NSCWE3 -! -KEYWORD=WERR_VEL - DATA_TYP=D - IO=I - SWITCHES=LOOP,NULL_VALUES,WILD_CARDS - UNITS=DEG,RAD,CIR,HMS - SEARCH=L,P - PROMPT="Reference velocity (m/sec)" - HELP=" -Specify the reference velocity to recalc set velocities for -. -NOTE: This is a special feature to be used only to correct errors made in the -conversion to SCN file from an MS. " -! -! Get data offset -! Ref: NSCDAT -! -KEYWORD=HAB_OFFSET - DATA_TYP=R - IO=I - SWITCHES=LOOP,NULL_VALUES,WILD_CARDS - SEARCH=L,P - PROMPT="Start-offset (sec)" -!! DEFAULT="0 /NOASK" suggestion JPH - HELP=" -Specify the time-offset from the start of an observation, at which the -integration for the output scans should start. Example: an offset of n will -throw away the first n (rounded up to a multiple of 10) seconds of data. -. -NOTE: This feature was useful in early mosaic experiments in which the slewing -between fields occurred in the first integration interval(s) on the new field. -It is now standard practice to slew during the final integration interval on -the old source. " -! -! Get set pattern -! Ref: NSCREG -! -KEYWORD=SCN_SET_PATTERN - DATA_TYP=C - IO=I - LENGTH=32 - NVALUES=1 - SWITCHES=LOOP,NULL_VALUES,WILD_CARDS - SEARCH=L,P - PROMPT="new index pattern (grp.obs.fld.chn.seq)" - HELP=" -Specify a new index pattern (group.observation.field.channel.sequence_number) -into which to change the index pattern of the input Set of uv-data Sectors. -. -Each index in the pattern that contains an * is copied from the input Set. -Other fields are used as is (true for the first four fields, i.e. -grp.obs.fld.chn.) -. -Example: To change the indices of the Set - 0.*.15283.* to - 0.*.0 .* -. -give the first selection as the input Set, and the second as the pattern." -! -! -! Get old R-series data type -! Ref: NSCDAT -! -KEYWORD=OLD_DATTYP - DATA_TYP=J - IO=I - SWITCHES=LOOP,NULL_VALUES,WILD_CARDS - SEARCH=L,P - PROMPT="Old R-series data format" - HELP=" -Specify the old R-series data type: -. - 0= local - 1= VAX, D_FORMAT - 2= VAX, G_FORMAT - 3= ALLIANT - 4= CONVEX - 5= IEEE - 6= DEC station - 7= SUN station - 8= HP station" -! -! Get polarisation -! Ref: NSCPL2 - called only by NCSDAT (JPH 941005) -! -KEYWORD=SELECT_IQXY - DATA_TYP=C - LENGTH=4 - IO=I - CHECKS=ABBREV_OPTIONS - SWITCHES=LOOP,NULL_VALUES,WILD_CARDS - SEARCH=L,P - PROMPT="output polarisations (ONE 'value') |" - OPTIONS= I,Q,U,V, IQ,UV, IQUV, X,XXY,YYX,Y, XY,YX, XYX - HELP=" -Specify the polarisation(s) to be written: -. - I: I only - Q: Q only - U: U only - V: V only -. - IQ: I and Q - UV: U and V - IQUV: I, Q, U and V -. - X: XX only - XXY: XY only - YYX: YX only - Y: YY only -. - XY: XX and YY - YX: XY and YX - XYX: all four: XX,XY,YX,YY" -! -!- -INCLUDE=NSHOW_PEF -!- -INCLUDE=NGEN_PEF -!- -INCLUDE=UNIT_PEF ! -INCLUDE=SCNNODE_PEF ! -INCLUDE=SCNSETS_PEF ! -INCLUDE=SELECT_PEF ! -!- -INCLUDE=MDLNODE_PEF ! -INCLUDE=NMODEL_PEF -!- diff --git a/src/nscan/nscclp.for b/src/nscan/nscclp.for deleted file mode 100644 index 0866aa71f3b62d1ffc7fec3b85a9c54a4e9eb0bd..0000000000000000000000000000000000000000 --- a/src/nscan/nscclp.for +++ /dev/null @@ -1,173 +0,0 @@ -C+ NSCCLP.FOR -C WNB 900825 -C -C Revisions: -C WNB 920813 Clean up -C JEN 960412 Changed input RA,DEC from 1950 to apparent -C - SUBROUTINE NSCCLP(FCA,STHJ,PHI) -C -C Get precession rotation angle -C -C Result: -C -C CALL NSCCLP( FCA_J:I, STHJ_J(0:*):I, PHI_E:O) -C Get PHI, the rotation angle due to -C precession and nutation, in radians. -C -C Include files: -C - INCLUDE 'WNG_DEF' - INCLUDE 'STH_O_DEF' !SCAN SET HEADER - INCLUDE 'OHW_O_DEF' !OH BLOCK - INCLUDE 'SCW_O_DEF' -C -C Parameters: -C -C -C Arguments: -C - INTEGER FCA !FILE ID - INTEGER STHJ(0:*) !SCAN SET HEADER - REAL PHI !ROTATION ANGLE -C -C Function references: -C - LOGICAL WNFRD !READ DISK -C -C Data declarations: -C - BYTE OHW(0:OHWHDL-1) !OH - INTEGER OHWJ(0:OHWHDL/4-1) - REAL*8 OHWD(0:OHWHDL/8-1) - EQUIVALENCE (OHW,OHWJ,OHWD) - BYTE SCW(0:SCWHDL-1) !SC - INTEGER SCWJ(0:SCWHDL/4-1) - REAL SCWE(0:SCWHDL/4-1) - REAL*8 SCWD(0:SCWHDL/8-1) - EQUIVALENCE (SCW,SCWJ,SCWE,SCWD) - REAL*8 EXY(3),XY(3) !APPARENT POS. VECTOR - REAL*8 XYZ(3),XYZD(3) !DIF. POS. VECTOR - REAL*8 RA0,DEC0 !APPARENT POS. - REAL*8 RA,DEC !CALCULATED 1950 POS. - REAL*8 ROT(3,3) !ROTATION MATRIX -C- - IF (STHJ(STH_OHP_J).NE.0 .AND. STHJ(STH_SCP_J).NE.0) THEN !CAN DO - JS=WNFRD(FCA,STHJ(STH_NOH_J),OHW,STHJ(STH_OHP_J)) !READ OH - IF (JS) JS=WNFRD(FCA,STHJ(STH_NSC_J),SCW,STHJ(STH_SCP_J)) !READ SC - IF (.NOT.JS) THEN - CALL WNCTXT(F_TP,'!/Error reading OH and/or SC') - GOTO 10 - END IF -! -! Get the apparent position vector of the field centre (RA0, DEC0): -! - RA0 = DPI2*OHWD(OHW_RA0_D) ! 1950 RA (RADIANS) - DEC0 = DPI2*OHWD(OHW_DEC0_D) ! 1950 DEC (RADIANS) -! - EXY(1)=COS(DEC0)*COS(RA0) !GET POS. VECTOR 1950 - EXY(2)=COS(DEC0)*SIN(RA0) - EXY(3)=SIN(DEC0) -! -! GET DIF. POS. VECTOR towards the north: -! Note from JEN: This is a position vector for DEC = 90-DEC0 degr... -! This is a strange choice, because it will coincide with EXY for -! DEC0=45 degr, and be to the south for DEC0>45 degr. -! It would be better to use the pole itself, as appears to be done -! in the AIPS++ routine (also written by WNB), although that might -! cause problems for DEC<-45 degr. -! In any case there is no evidence of using an offset of 1 degree -! to the north, as WNB says he uses.... -! - XYZ(2)=-SIN(DEC0)*SIN(RA0) - XYZ(1)=-SIN(DEC0)*COS(RA0) - XYZ(3)=COS(DEC0) -! -! Rotate the various position vectors to their current (MJD) positions: -! - DO I=1,3 !MAKE ROT. MATRIX - DO I1=1,3 - ROT(I1,I)=0 - DO I2=1,3 - ROT(I1,I)=ROT(I1,I)+SCWD(SCW_NUTA_D-4+3*I+I2)* - 1 SCWD(SCW_PREC_D-4+3*I2+I1) - END DO - END DO - END DO -! - DO I=1,3 !ROTATE VECTORS - XY(I)=0 !field centre - XYZD(I)=0 !dif position - DO I1=1,3 - XY(I)=XY(I)+EXY(I1)*ROT(I1,I) - XYZD(I)=XYZD(I)+XYZ(I1)*ROT(I1,I) - END DO - END DO -! -! Calculate the 1950 RA and DEC of the field centre: -! - IF (XY(2).EQ.0) THEN !RA DATE - IF (XY(1).GE.0) THEN - RA=0 - ELSE - RA=DPI - END IF - ELSE - RA=ATAN2(XY(2),XY(1)) !RA DATE - END IF - DEC=ASIN(XY(3)) !DEC DATE -! -! Calculate the field rotation angle PHI: -! Note from JEN: Should be PHI = ATAN(PHI)? Does not make a large -! difference, even at high DEC. -! - IF (XYZD(3).EQ.0) THEN - GOTO 10 - ELSE IF (SIN(RA).EQ.0) THEN - PHI=(XYZD(2)*COS(DEC)+XYZD(3)* - 1 SIN(DEC)*SIN(RA))/ - 2 (XYZD(3)*COS(RA)) - ELSE IF (COS(RA).EQ.0) THEN - PHI=(XYZD(1)*COS(DEC)+XYZD(3)* - 1 SIN(DEC)*COS(RA))/ - 2 (-XYZD(3)*SIN(RA)) - ELSE - PHI=((XYZD(1)*COS(DEC)+XYZD(3)* - 1 SIN(DEC)*COS(RA))/ - 2 (-XYZD(3)*SIN(RA))+ - 3 (XYZD(2)*COS(DEC)+XYZD(3)* - 4 SIN(DEC)*SIN(RA))/ - 5 (XYZD(3)*COS(RA)))/2 - END IF -! -! If not possible to calculate PHI, return PHI=0 (?) -! - ELSE - 10 PHI=0 !CANNOT DO - END IF -! -! - PHI=-PHI !FLOP SIGN -C -! Some diagnostic output (JEN): -! -cc CALL WNCTXT (F_TP, -cc 1 'NSCCLP: apparent pos RA0=!DA10.5 DEC0=!DA10.5 degr' -cc 1 ,RA0, DEC0) -cc CALL WNCTXT (F_TP, -cc 1 ' calculated 1950 pos RA =!DA10.5 DEC =!DA10.5 degr' -cc 1 ,RA, DEC) -cc CALL WNCTXT (F_TP, -cc 1 ' PHI=!EA10.5 degr ATAN(PHI)=!EA10.5 ' -cc 1 ,PHI, ATAN(PHI)) -! - RETURN -C -C - END - - - - - - diff --git a/src/nscan/nsccop.for b/src/nscan/nsccop.for deleted file mode 100644 index 2aeebbe7716bf0470ffb756c8b1a9515c78fc4de..0000000000000000000000000000000000000000 --- a/src/nscan/nsccop.for +++ /dev/null @@ -1,328 +0,0 @@ -C+ NSCCOP.FOR -C WNB 910911 -C -C Revisions: -C HjV 920520 HP does not allow extended source lines -C HjV 930311 Change some text -C WNB 930607 New weights -C WNB 930707 Get inputs; make simpler -C WNB 930826 New HA range -C CMV 931220 Pass FCA of input file to WNDXLP and WNDSTA/Q -C CMV 940926 Close old file before asking new one -C - SUBROUTINE NSCCOP -C -C Copy SCN sets -C -C Result: -C -C CALL NSCCOP Copies selected sets -C -C Pin references: -C -C INPUT_SCN_NODE -C OUTPUT_SCN_NODE -C SCN_SETS -C -C Include files: -C - INCLUDE 'WNG_DEF' - INCLUDE 'GFH_O_DEF' !FILE HEADER - INCLUDE 'SGH_O_DEF' !SUB-GROUP HEADER - INCLUDE 'STH_O_DEF' !SET HEADER - INCLUDE 'SCH_O_DEF' !SCAN HEADER - INCLUDE 'NSC_DEF' - INCLUDE 'OHW_O_DEF' !WSRT BLOCKS - INCLUDE 'FDW_O_DEF' - INCLUDE 'FDX_O_DEF' - INCLUDE 'SCW_O_DEF' - INCLUDE 'SHW_O_DEF' -C -C Parameters: -C - INTEGER MXNCHK !CHECK TABLE LENGTH - PARAMETER (MXNCHK=512) -C -C Arguments: -C -C -C Function references: -C - INTEGER WNFEOF !FILE LENGTH - LOGICAL WNFOP !OPEN FILE - LOGICAL WNFWR !WRITE DISK - LOGICAL WNFRD !READ DISK - LOGICAL WNDLNF,WNDLNG,WNDLNK !LINK MAPS - LOGICAL WNDNOD !GET NODE - LOGICAL WNDPAR !GET USER DATA - LOGICAL WNDSTA !GET USER SETS - CHARACTER*32 WNTTSG !MAP NAME - LOGICAL NSCSTG !GET SET - LOGICAL NSCHAS !GET HA RANGE -C -C Data declarations: -C - REAL HARAN(0:1) - LOGICAL LFIRST !FIRST LINK? - INTEGER IPOL !# OF POL. - INTEGER OUTP !DATA OUTPUT POINTER - INTEGER SNAM(0:7) !SET NAME - INTEGER STHP(0:1) !SET HEADER POINTER - INTEGER CHKT(0:1,0:MXNCHK-1) !CHECK PRESENCE OH ETC - INTEGER NCHK - INTEGER*2 IFR(0:STHIFR-1) !IFR TABLE - BYTE OHW(0:OHWHDL-1) !OH - BYTE FDW(0:FDWHDL+FDXHDL-1) !FD+FDX - BYTE SCW(0:SCWHDL-1) !SC - BYTE SHW(0:SHWHDL-1) !SH - INTEGER*2 ODAT(0:2,0:4*STHIFR-1) !OUTPUT DATA - EQUIVALENCE (IFR,OHW,FDW,SCW,SHW,ODAT) - BYTE STH(0:STHHDL-1,0:1) !SET HEADER - INTEGER*2 STHI(0:STHHDL/2-1,0:1) - INTEGER STHJ(0:STHHDL/4-1,0:1) - REAL STHE(0:STHHDL/4-1,0:1) - DOUBLE PRECISION STHD(0:STHHDL/8-1,0:1) - EQUIVALENCE (STH,STHI,STHJ,STHE,STHD) - BYTE SCH(0:SCHHDL-1,0:1) !SCAN HEADER - INTEGER*2 SCHI(0:SCHHDL/2-1,0:1) - INTEGER SCHJ(0:SCHHDL/4-1,0:1) - REAL SCHE(0:SCHHDL/4-1,0:1) - DOUBLE PRECISION SCHD(0:SCHHDL/8-1,0:1) - EQUIVALENCE (SCH,SCHI,SCHJ,SCHE,SCHD) -C- -C -C INIT -C - LFIRST=.TRUE. !FIRST LINK - NCHK=0 - SETS(0,0)=0 !NO SETS - HARAN(0)=-179.99/360. !HA RANGE - HARAN(1)=+179.99/360. - 10 CONTINUE - IF (.NOT.WNDNOD('INPUT_SCN_NODE','""','SCN', - 1 'R',NODIN,IFILE)) THEN - IF (E_C.EQ.DWC_ENDOFLOOP) GOTO 900 !READY - GOTO 10 !REPEAT - ELSE IF (E_C.EQ.DWC_NULLVALUE) THEN - GOTO 900 !READY - ELSE IF (E_C.EQ.DWC_WILDCARD) THEN - GOTO 10 !MUST SPECIFY - END IF - IF (.NOT.WNFOP(FCAIN,IFILE,'R')) GOTO 10 !OPEN INPUT FILE - 12 CONTINUE - IF (.NOT.WNDSTA('SCN_SETS',MXNSET,SETS,FCAIN)) THEN !SETS TO USE - 11 CONTINUE - CALL WNFCL(FCAIN) - GOTO 10 !RETRY FILE - END IF - IF (SETS(0,0).LE.0) GOTO 11 !NONE SPECIFIED - IF (.NOT.NSCHAS(0,HARAN)) GOTO 12 !GET HA RANGE - 14 CONTINUE - CALL WNFCL(FCAOUT) - IF (.NOT.WNDNOD('OUTPUT_SCN_NODE','""','SCN','U', - 1 NODOUT,OFILE)) THEN - IF (E_C.EQ.DWC_ENDOFLOOP) GOTO 11 !RETRY INPUT - GOTO 14 !REPEAT - END IF - IF (E_C.EQ.DWC_NULLVALUE) GOTO 11 - IF (E_C.EQ.DWC_WILDCARD) GOTO 14 !MUST SPECIFY - IF (.NOT.WNFOP(FCAOUT,OFILE,'U')) GOTO 14 !CANNOT OPEN -C -C GET SETS -C - DO WHILE(NSCSTG(FCAIN,SETS(0,0),STH(0,0), - 1 STHP(0),SNAM)) !GET A SET - IPOL=STHI(STH_PLN_I,0) !# OF POL. -C -C CHECK IF ANYTHING WANTED -C - IF (HARAN(0).GT.STHE(STH_HAB_E,0)+(STHJ(STH_SCN_J,0)-1)* - 1 STHE(STH_HAI_E,0) .OR. - 1 HARAN(1).LT.STHE(STH_HAB_E,0)) GOTO 100 !FORGET SET -C -C PREPARE SET HEADER -C - CALL WNGMV(STHHDL,STH(0,0),STH(0,1)) !COPY SET HEADER - STHP(1)=WNFEOF(FCAOUT) !WHERE TO WRITE - IF (.NOT.WNFWR(FCAOUT,STHHDL,STH(0,1),STHP(1))) THEN - 40 CONTINUE - CALL WNCTXT(F_TP,'Error copying Sector !AS', - 1 WNTTSG(SNAM,0)) - CALL WNGEX !STOP - END IF - OUTP=WNFEOF(FCAOUT) !POINTER TO DATA - STHJ(STH_SCNP_J,1)=OUTP -C -C ALL SCANS -C - J0=0 !COUNT SCANS - DO I=0,STHJ(STH_SCN_J,0)-1 - IF (.NOT.WNFRD(FCAIN,SCHHDL,SCH(0,0), - 1 STHJ(STH_SCNP_J,0)+ - 1 I*STHJ(STH_SCNL_J,0))) THEN !READ SCAN HEADER - 41 CONTINUE - CALL WNCTXT(F_TP,'Error reading data Sector !AS', - 1 WNTTSG(SNAM,0)) - GOTO 100 !FORGET SET - END IF - IF (SCHE(SCH_HA_E,0).LT.HARAN(0) .OR. - 1 SCHE(SCH_HA_E,0).GT.HARAN(1)) GOTO 30 !FORGET SCAN - IF (.NOT.WNFRD(FCAIN,STHJ(STH_SCNL_J,0)-SCHHDL,ODAT, - 1 STHJ(STH_SCNP_J,0)+SCHHDL+ - 1 I*STHJ(STH_SCNL_J,0))) GOTO 41 !READ DATA - J0=J0+1 !COUNT SCANS - SCHJ(SCH_IFRAC_J,0)=0 !NO IFR CORRECTIONS - SCHJ(SCH_IFRMC_J,0)=0 - SCHJ(SCH_AIFRAC_J,0)=0 - SCHJ(SCH_AIFRMC_J,0)=0 - IF (.NOT.WNFWR(FCAOUT,SCHHDL,SCH(0,0),OUTP)) GOTO 40 !HEADER - OUTP=OUTP+SCHHDL - IF (.NOT.WNFWR(FCAOUT,STHJ(STH_SCNL_J,0)-SCHHDL, - 1 ODAT,OUTP)) GOTO 40 !DATA - OUTP=OUTP+STHJ(STH_SCNL_J,0)-SCHHDL -C -C NEXT SCAN -C - 30 CONTINUE - END DO -C -C MAKE SET HEADER -C - IF (J0.LE.0) GOTO 100 !NO DATA, SKIP SET - STHE(STH_HAB_E,1)=MAX(STHE(STH_HAB_E,0),HARAN(0)) - STHJ(STH_SCN_J,1)=J0 - DO I=0,1 !NO MODEL COPIED - STHJ(STH_MDL_J+I,1)=0 - STHJ(STH_MDD_J+I,1)=0 - END DO - IF (STHJ(STH_IFRP_J,0).NE.0) THEN !COPY IFR TABLE - DO I=0,MIN(MXNCHK,NCHK)-1 - IF (STHJ(STH_IFRP_J,0).EQ.CHKT(0,I)) THEN - STHJ(STH_IFRP_J,1)=CHKT(1,I) - GOTO 60 - END IF - END DO - IF (.NOT.WNFRD(FCAIN,LB_I*STHJ(STH_NIFR_J,0),IFR, - 1 STHJ(STH_IFRP_J,0))) GOTO 40 - STHJ(STH_IFRP_J,1)=WNFEOF(FCAOUT) - IF (.NOT.WNFWR(FCAOUT,LB_I*STHJ(STH_NIFR_J,0),IFR, - 1 STHJ(STH_IFRP_J,1))) GOTO 40 - DO I=0,1 - CHKT(I,MOD(NCHK,MXNCHK))=STHJ(STH_IFRP_J,I) - END DO - NCHK=NCHK+1 - END IF - 60 CONTINUE - IF (STHJ(STH_FDP_J,0).NE.0) THEN !COPY FD - DO I=0,MIN(MXNCHK,NCHK)-1 - IF (STHJ(STH_FDP_J,0).EQ.CHKT(0,I)) THEN - STHJ(STH_FDP_J,1)=CHKT(1,I) - GOTO 61 - END IF - END DO - IF (.NOT.WNFRD(FCAIN,STHJ(STH_NFD_J,0),FDW, - 1 STHJ(STH_FDP_J,0))) GOTO 40 - STHJ(STH_FDP_J,1)=WNFEOF(FCAOUT) - IF (.NOT.WNFWR(FCAOUT,STHJ(STH_NFD_J,1),FDW, - 1 STHJ(STH_FDP_J,1))) GOTO 40 - DO I=0,1 - CHKT(I,MOD(NCHK,MXNCHK))=STHJ(STH_FDP_J,I) - END DO - NCHK=NCHK+1 - END IF - 61 CONTINUE - IF (STHJ(STH_OHP_J,0).NE.0) THEN !COPY OH - DO I=0,MIN(MXNCHK,NCHK)-1 - IF (STHJ(STH_OHP_J,0).EQ.CHKT(0,I)) THEN - STHJ(STH_OHP_J,1)=CHKT(1,I) - GOTO 62 - END IF - END DO - IF (.NOT.WNFRD(FCAIN,STHJ(STH_NOH_J,0),OHW, - 1 STHJ(STH_OHP_J,0))) GOTO 40 - STHJ(STH_OHP_J,1)=WNFEOF(FCAOUT) - IF (.NOT.WNFWR(FCAOUT,STHJ(STH_NOH_J,1),OHW, - 1 STHJ(STH_OHP_J,1))) GOTO 40 - DO I=0,1 - CHKT(I,MOD(NCHK,MXNCHK))=STHJ(STH_OHP_J,I) - END DO - NCHK=NCHK+1 - END IF - 62 CONTINUE - IF (STHJ(STH_SCP_J,0).NE.0) THEN !COPY SC - DO I=0,MIN(MXNCHK,NCHK)-1 - IF (STHJ(STH_SCP_J,0).EQ.CHKT(0,I)) THEN - STHJ(STH_SCP_J,1)=CHKT(1,I) - GOTO 63 - END IF - END DO - IF (.NOT.WNFRD(FCAIN,STHJ(STH_NSC_J,0),SCW, - 1 STHJ(STH_SCP_J,0))) GOTO 40 - STHJ(STH_SCP_J,1)=WNFEOF(FCAOUT) - IF (.NOT.WNFWR(FCAOUT,STHJ(STH_NSC_J,1),SCW, - 1 STHJ(STH_SCP_J,1))) GOTO 40 - DO I=0,1 - CHKT(I,MOD(NCHK,MXNCHK))=STHJ(STH_SCP_J,I) - END DO - NCHK=NCHK+1 - END IF - 63 CONTINUE - IF (STHJ(STH_SHP_J,0).NE.0) THEN !COPY SH - DO I=0,MIN(MXNCHK,NCHK)-1 - IF (STHJ(STH_SHP_J,0).EQ.CHKT(0,I)) THEN - STHJ(STH_SHP_J,1)=CHKT(1,I) - GOTO 64 - END IF - END DO - IF (.NOT.WNFRD(FCAIN,STHJ(STH_NSH_J,0),SHW, - 1 STHJ(STH_SHP_J,0))) GOTO 40 - STHJ(STH_SHP_J,1)=WNFEOF(FCAOUT) - IF (.NOT.WNFWR(FCAOUT,STHJ(STH_NSH_J,1),SHW, - 1 STHJ(STH_SHP_J,1))) GOTO 40 - DO I=0,1 - CHKT(I,MOD(NCHK,MXNCHK))=STHJ(STH_SHP_J,I) - END DO - NCHK=NCHK+1 - END IF - 64 CONTINUE - IF (.NOT.WNFWR(FCAOUT,STHHDL,STH(0,1),STHP(1))) GOTO 40 !NEW HEADER -C -C LINK SET -C - IF (LFIRST) THEN !MAKE NEW JOB - IF (.NOT.WNDLNG(GFH_LINKG_1,0,SGH_GROUPN_1, - 1 FCAOUT,SGPH(0),SGNR(0))) THEN - 50 CONTINUE - CALL WNCTXT(F_TP,'Error creating sub-group') - CALL WNGEX !STOP - END IF - LFIRST=.FALSE. - END IF - DO I1=1,3 - IF (.NOT.WNDLNF(SGPH(I1-1)+SGH_LINKG_1,SNAM(I1),SGH_GROUPN_1, - 1 FCAOUT,SGPH(I1),SGNR(I1))) GOTO 50 - END DO - I1=4 - IF (.NOT.WNDLNK(GFH_LINK_1,STHP(1),STH_SETN_1, - 1 FCAOUT)) GOTO 50 - IF (.NOT.WNDLNG(SGPH(I1-1)+SGH_LINKG_1,STHP(1),SGH_GROUPN_1, - 1 FCAOUT,SGPH(I1),SGNR(I1))) GOTO 50 - IF (.NOT.WNFRD(FCAOUT,STHHDL,STH(0,1),STHP(1))) GOTO 50 !HEADER - SGNR(5)=-1 !END NAME - CALL WNCTXT(F_T,'Scan !AS copied',WNTTSG(SGNR,0)) -C -C NEXT SET -C - 100 CONTINUE - END DO -C -C READY -C - 900 CONTINUE - CALL WNFCL(FCAOUT) !CLOSE FILES - CALL WNFCL(FCAIN) -C - RETURN -C -C - END diff --git a/src/nscan/nsccv1.for b/src/nscan/nsccv1.for deleted file mode 100644 index da8a3e9c5548e4999c2ccdf9459e02cb69cad3a6..0000000000000000000000000000000000000000 --- a/src/nscan/nsccv1.for +++ /dev/null @@ -1,79 +0,0 @@ -C+ NSCCV1.FOR -C WNB 900822 -C -C Revisions: -C JPH 921130 DO-loop variable -C - SUBROUTINE NSCCV1(FCA,CVT,DLEN,PDAT,DAT,MXNCHK,NCHK,CHK,TRANS) -C -C Convert block to local format if necessary -C -C Result: -C -C CALL NSCCV1( FCA_J:I, CVT_J:I, DLEN_J:I, PDAT_J:I, DAT_B(DLEN), -C MXNCHK_J:I, NCHK_J:IO, -C CHK_J(0:*):IO, TRANS_I(0:*):I) -C Convert data block of DLEN bytes -C at PDAT in file FCA, using buffer -C DAT, from VAX to local format. -C To convert only once, a check is -C made against a list CHK with a -C maximum of MXNCHK entries, and -C NCHK current entreis -C -C Include files: -C - INCLUDE 'WNG_DEF' -C -C Parameters: -C -C -C Arguments: -C - INTEGER FCA !FILE POINTER - INTEGER CVT !CONVERSION INPUT TYPE - INTEGER DLEN !LENGTH DATA BLOCK - INTEGER PDAT !DATA BLOCK POINTER - BYTE DAT(0:*) !DATA BUFFER - INTEGER MXNCHK !MAX. LENGTH CHECK LIST - INTEGER NCHK !# IN CHECK LIST - INTEGER CHK(0:*) !CHECK LIST - INTEGER*2 TRANS(0:*) !TRANSLATION TABLE -C -C Function references: -C - LOGICAL WNFRD !READ DATA - LOGICAL WNFWR !WRITE DATA -C -C Data declarations: -C -C- -C -C TEST IF ALREADY DONE -C - DO I=0,NCHK-1 - IF (PDAT.EQ.CHK(I)) RETURN !ALREADY DONE, READY - END DO -C -C READ -C - CHK(NCHK)=PDAT !ADD NEW CHECK - NCHK=NCHK+1 - IF (NCHK.GE.MXNCHK) THEN !DELETE ONE - DO I=1,NCHK-1 - CHK(I-1)=CHK(I) - END DO - NCHK=NCHK-1 - END IF - IF (.NOT.WNFRD(FCA,DLEN,DAT,PDAT)) THEN !READ BLOCK OF DATA - 10 CONTINUE - CALL WNCTXT(F_TP,'Error converting data, continuing') - RETURN - END IF - CALL WNTTTL(DLEN,DAT,TRANS,CVT) !TRANSLATE - IF (.NOT.WNFWR(FCA,DLEN,DAT,PDAT)) GOTO 10 !WRITE BACK -C - RETURN -C -C - END diff --git a/src/nscan/nsccvx.for b/src/nscan/nsccvx.for deleted file mode 100644 index 2e02c2258bd1118ff549e03ab3fdd95218ca0fb6..0000000000000000000000000000000000000000 --- a/src/nscan/nsccvx.for +++ /dev/null @@ -1,325 +0,0 @@ -C+ NSCCVX.FOR -C WNB 900822 -C -C Revisions: -C WNB 921201 Text only -C WNB 930127 Correct MDD conversion -C WNB 930803 Change IFR_T to LIFR_T -C WNB 930819 Always 4 polarisations -C CMV 940518 Add IFH block -C CMV 960624 Increase buffer, more diagnostics -C - SUBROUTINE NSCCVX -C -C Convert SCN file from VAX to local format -C -C Result: -C -C CALL NSCCVX will convert a SCN file from VAX to local format -C -C -C Include files: -C - INCLUDE 'WNG_DEF' - INCLUDE 'NSC_DEF' - INCLUDE 'GFH_O_DEF' !GENERAL FILE HEADER - INCLUDE 'GFH_T_DEF' - INCLUDE 'SGH_O_DEF' !SUB-GROUP HEADER - INCLUDE 'SGH_T_DEF' - INCLUDE 'STH_O_DEF' !SET HEADER - INCLUDE 'STH_T_DEF' - INCLUDE 'SCH_O_DEF' !SCAN HEADER - INCLUDE 'SCH_T_DEF' - INCLUDE 'MDH_O_DEF' !MODEL HEADER - INCLUDE 'MDH_T_DEF' - INCLUDE 'MDL_O_DEF' !MODEL LINE - INCLUDE 'MDL_T_DEF' - INCLUDE 'IFH_O_DEF' !IF HEADER - INCLUDE 'IFH_T_DEF' - INCLUDE 'FDW_O_DEF' !TAPE BLOCKS - INCLUDE 'FDW_T_DEF' - INCLUDE 'FDX_O_DEF' - INCLUDE 'FDX_T_DEF' - INCLUDE 'OHW_O_DEF' - INCLUDE 'OHW_T_DEF' - INCLUDE 'SCW_O_DEF' - INCLUDE 'SCW_T_DEF' - INCLUDE 'SHW_O_DEF' - INCLUDE 'SHW_T_DEF' -C -C Parameters: -C - INTEGER MXNCHK !MAX. # IN CHECK LIST - PARAMETER (MXNCHK=20480) -C -C Arguments: -C -C -C Function references: -C - LOGICAL WNFRD !READ DATA - LOGICAL WNFWR !WRITE DATA -C -C Data declarations: -C - INTEGER CHK(0:MXNCHK-1) !CHECK LIST - INTEGER NCHK !# IN LIST - INTEGER CVT !CONVERSION TYPE - INTEGER*2 LIFR_T(0:1,0:1) !IFR TRANSLATION - DATA LIFR_T/2,0,0,1/ - INTEGER*2 DBH_T(0:1,0:1) !DATA TRANSLATION - DATA DBH_T/2,0,0,1/ - INTEGER*2 MDD_T(0:1,0:1) !MODEL DATA - DATA MDD_T/14,0,0,1/ - BYTE GFH(0:GFHHDL-1) !GENERAL FILE HEADER - BYTE SGH(0:SGHHDL-1) !SUB-GROUP HEADER - INTEGER SGHJ(0:SGHHDL/4-1) - EQUIVALENCE (SGH,SGHJ) - BYTE STH(0:STHHDL-1) !SET HEADER - INTEGER*2 STHI(0:STHHDL/2-1) - INTEGER STHJ(0:STHHDL/4-1) - EQUIVALENCE (STH,STHI,STHJ) - BYTE SCH(0:SCHHDL-1) !SCAN HEADER - INTEGER SCHJ(0:SCHHDL/4-1) - EQUIVALENCE (SCH,SCHJ) - BYTE MDH(0:MDHHDL-1) !MODEL HEADER - INTEGER MDHJ(0:MDHHDL/4-1) - EQUIVALENCE (MDH,MDHJ) - BYTE IFH(0:IFHHDL-1) !MODEL HEADER - INTEGER IFHJ(0:IFHHDL/4-1) - EQUIVALENCE (IFH,IFHJ) - BYTE FDW(0:FDWHDL-1) !TAPE BLOCKS - BYTE FDX(0:FDXHDL-1) - BYTE OHW(0:OHWHDL-1) - BYTE SCW(0:SCWHDL-1) - BYTE SHW(0:SHWHDL-1) - BYTE MDL(0:MDLHDL-1) - INTEGER*2 IFR(0:STHIFR-1) - INTEGER*2 DBUF(0:2,0:3,0:2*STHIFR-1) !DATA BUFFER - EQUIVALENCE (FDW,FDX,OHW,SCW,SHW,MDL,IFH,IFR,DBUF) -C- -C -C INIT -C - NCHK=0 !ZERO CHECK LIST -C -C GENERAL FILE HEADER -C - IF (.NOT.WNFRD(FCAOUT,GFHHDL,GFH,0)) THEN !READ GENERAL FILE HEADER - 10 CONTINUE - CALL WNCTXT(F_TP,'!/I/O error on SCN file') - GOTO 900 !READY - END IF - IF (GFH(GFH_DATTP_B).EQ.0) GFH(GFH_DATTP_B)=1 !ASSUME VAX INPUT - IF (GFH(GFH_DATTP_B).EQ.PRGDAT) THEN - CALL WNCTXT(F_TP,'!/Data already converted') - GOTO 800 - END IF - CVT=GFH(GFH_DATTP_B) !INPUT TYPE - CALL WNTTTL(GFHHDL,GFH,GFH_T,CVT) !CONVERT - GFH(GFH_DATTP_B)=PRGDAT !SET CURRENT DATA TYPE - IF (.NOT.WNFWR(FCAOUT,GFHHDL,GFH,0)) THEN - CALL WNCTXT(F_TP,'Write header') - GOTO 10 !REWRITE HEADER - END IF -C -C GROUP HEADERS -C - J=1 !LEVEL 1 - J1=GFH_LINKG_1 !CURRENT GROUP - J2=GFH_LINKG_1 !CURRENT LINK HEAD - 22 CONTINUE - IF (.NOT.WNFRD(FCAOUT,SGHHDL,SGH,J1)) then - CALL WNCTXT(F_TP,'Read group header !UJ',j1) - GOTO 10 !READ CURRENT - END IF - 20 CONTINUE - IF (SGHJ(SGH_LINK_J).EQ.J2) THEN !END OF LIST - J=J-1 !DECREASE LEVEL - IF (J.EQ.0) GOTO 21 !READY - J1=SGHJ(SGH_HEADH_J)-SGH_LINKG_1+SGH_LINK_1 !LOWER HEADER ADDR. - IF (.NOT.WNFRD(FCAOUT,SGHHDL,SGH,J1)) then - CALL WNCTXT(F_TP,'Read subgroup !UJ !UJ',J,j1) - GOTO 10 !READ IT - END IF - J2=SGHJ(SGH_HEADH_J) !NEW LINK HEAD - GOTO 20 !CONTINUE - END IF - J1=SGHJ(SGH_LINK_J) !NEXT ENTRY - IF (.NOT.WNFRD(FCAOUT,SGHHDL,SGH,J1)) then - CALL WNCTXT(F_TP,'Read subgroup !UJ',J1) - GOTO 10 !READ IT - END IF - CALL WNTTTL(SGHHDL,SGH,SGH_T,CVT) !CONVERT IT - IF (.NOT.WNFWR(FCAOUT,SGHHDL,SGH,J1)) GOTO 10 !WRITE IT - IF (SGHJ(SGH_DATAP_J).EQ.0) THEN !MORE LEVELS - IF (SGHJ(SGH_LINKG_J).EQ.J1+SGH_LINKG_1) GOTO 20 !NO NEXT LEVEL - J=J+1 !NEXT LEVEL - IF (J.GT.8) then - CALL WNCTXT(F_TP,'Too many levels !UJ !UJ',j,j1) - GOTO 10 !TOO MANY LEVELS - END IF - J2=J1+SGH_LINKG_1 !NEW HEADER PTR - J1=J2 !NEXT CURRENT - GOTO 22 !CONTINUE - END IF - GOTO 20 !MORE - 21 CONTINUE -C -C DO SETS -C - IF (.NOT.WNFRD(FCAOUT,2*LB_J,STH, - 1 GFH_LINK_1)) then - CALL WNCTXT(F_TP,'Read set header start') - GOTO 10 !READ SET HEADER START - END IF -30 CONTINUE - J=STHJ(STH_LINK_J) !NEXT IN LIST - IF (J.EQ.GFH_LINK_1) GOTO 800 !ALL DONE - IF (.NOT.WNFRD(FCAOUT,STHHDL,STH,J)) then - CALL WNCTXT(F_TP,'Read set header !UJ',j) - GOTO 10 !READ SET HEADER - END IF - CALL WNTTTL(STHHDL,STH,STH_T,CVT) !CONVERT IT - IF (.NOT.WNFWR(FCAOUT,STHHDL,STH,J)) then - CALL WNCTXT(F_TP,'Write set header !UJ',j) - GOTO 10 !WRITE SET HEADER - END IF -C -C POINTED BLOCKS -C - LIFR_T(1,0)=LB_I*STHJ(STH_NIFR_J) !LENGTH TRANSLATION - IF (STHJ(STH_IFRP_J).NE.0) - 1 CALL NSCCV1(FCAOUT,CVT, - 1 LB_I*STHJ(STH_NIFR_J), - 1 STHJ(STH_IFRP_J),IFR, - 1 MXNCHK,NCHK,CHK,LIFR_T) !IFR'S - IF (STHJ(STH_FDP_J).NE.0) - 1 CALL NSCCV1(FCAOUT,CVT,FDWHDL, - 1 STHJ(STH_FDP_J),FDW, - 1 MXNCHK,NCHK,CHK,FDW_T) !FD - IF (STHJ(STH_FDP_J).NE.0) - 1 CALL NSCCV1(FCAOUT,CVT,STHJ(STH_NFD_J)-FDWHDL, - 1 STHJ(STH_FDP_J)+FDWHDL,FDX, - 1 MXNCHK,NCHK,CHK,FDX_T) !FDX - IF (STHJ(STH_OHP_J).NE.0) - 1 CALL NSCCV1(FCAOUT,CVT,STHJ(STH_NOH_J), - 1 STHJ(STH_OHP_J),OHW, - 1 MXNCHK,NCHK,CHK,OHW_T) !OH - IF (STHJ(STH_SCP_J).NE.0) - 1 CALL NSCCV1(FCAOUT,CVT,STHJ(STH_NSC_J), - 1 STHJ(STH_SCP_J),SCW, - 1 MXNCHK,NCHK,CHK,SCW_T) !SC - IF (STHJ(STH_SHP_J).NE.0) - 1 CALL NSCCV1(FCAOUT,CVT,STHJ(STH_NSH_J), - 1 STHJ(STH_SHP_J),SHW, - 1 MXNCHK,NCHK,CHK,SHW_T) !SH -C - IF (STHJ(STH_IFHP_J).NE.0) THEN !IF DATA - I=NCHK !SAVE CURRENT CHECK - CALL NSCCV1(FCAOUT,CVT,IFHHDL, - 1 STHJ(STH_IFHP_J),IFH, - 1 MXNCHK,NCHK,CHK,IFH_T) !IFH - IF (NCHK.NE.I) THEN !WAS NEW BLOCK, DO DATA - J=STHJ(STH_IFHP_J)+IFHHDL !DATA POINTER - I1=4*STHTEL*LB_I !DATA LENGTH - DBH_T(1,0)=I1 !TRANSLATION LENGTH - DO I=1,IFHJ(IFH_NTP_J)+IFHJ(IFH_NIF_J) - IF (.NOT.WNFRD(FCAOUT,I1,DBUF,J)) then - CALL WNCTXT(F_TP,'Read data !UJ',J) - GOTO 10 !READ DATA - END IF - CALL WNTTTL(I1,DBUF,DBH_T,CVT) !CONVERT - IF (.NOT.WNFWR(FCAOUT,I1,DBUF,J)) then - CALL WNCTXT(F_TP,'Write data !UJ',J) - GOTO 10 !WRITE DATA - END IF - J=J+I1 !NEXT SCAN - END DO - END IF - END IF -C - IF (STHJ(STH_MDL_J).NE.0) THEN !MODEL 1 - MDHJ(MDH_NSRC_J)=0 !MAKE SURE SINGLE - CALL NSCCV1(FCAOUT,CVT,MDHHDL,STHJ(STH_MDL_J),MDH, - 1 MXNCHK,NCHK,CHK,MDH_T) !MODEL 1 - J=MDHJ(MDH_MODP_J) !MODEL POINTER - DO I=0,MDHJ(MDH_NSRC_J)-1 !ALL SOURCES - IF (.NOT.WNFRD(FCAOUT,MDLHDL,MDL,J)) then - CALL WNCTXT(F_TP,'Read !UJ !UJ',i,j) - GOTO 10 !READ SOURCE - END IF - CALL WNTTTL(MDLHDL,MDL,MDL_T,CVT) !TRANSLATE - IF (.NOT.WNFWR(FCAOUT,MDLHDL,MDL,J)) then - CALL WNCTXT(F_TP,'Write !UJ !UJ',i,j) - GOTO 10 !REWRITE SOURCE - END IF - J=J+MDLHDL !NEXT PTR - END DO - END IF - IF (STHJ(STH_MDL_J+1).NE.0) THEN !MODEL 2 - MDHJ(MDH_NSRC_J)=0 !MAKE SURE SINGLE - CALL NSCCV1(FCAOUT,CVT,MDHHDL,STHJ(STH_MDL_J+1),MDH, - 1 MXNCHK,NCHK,CHK,MDH_T) !MODEL 1 - J=MDHJ(MDH_MODP_J) !MODEL POINTER - DO I=0,MDHJ(MDH_NSRC_J)-1 !ALL SOURCES - IF (.NOT.WNFRD(FCAOUT,MDLHDL,MDL,J)) GOTO 10 !READ SOURCE - CALL WNTTTL(MDLHDL,MDL,MDL_T,CVT) !TRANSLATE - IF (.NOT.WNFWR(FCAOUT,MDLHDL,MDL,J)) GOTO 10 !REWRITE SOURCE - J=J+MDLHDL !NEXT PTR - END DO - END IF - I1=4*STHJ(STH_NIFR_J) !MODEL DATA LENGTH - MDD_T(1,0)=I1 !TRANSLATION LENGTH - I1=I1*LB_X !BYTE LENGTH - J=STHJ(STH_MDD_J) !DATA POINTERS - J0=STHJ(STH_MDD_J+1) - IF (STHJ(STH_MDD_J).NE.0 .OR. STHJ(STH_MDD_J+1).NE.0) THEN !MODEL DATA - DO I=0,STHJ(STH_SCN_J)-1 !ALL SCANS - IF (STHJ(STH_MDD_J).NE.0) THEN !MODEL 1 DATA - IF (.NOT.WNFRD(FCAOUT,I1,DBUF,J)) GOTO 10 !READ SOURCE SCAN - CALL WNTTTL(I1,DBUF,MDD_T,CVT) !TRANSLATE - IF (.NOT.WNFWR(FCAOUT,I1,DBUF,J)) GOTO 10 !REWRITE - END IF - IF (STHJ(STH_MDD_J+1).NE.0) THEN !MODEL 2 DATA - IF (.NOT.WNFRD(FCAOUT,I1,DBUF,J0)) GOTO 10 !READ SOURCE SCAN - CALL WNTTTL(I1,DBUF,MDD_T,CVT) !TRANSLATE - IF (.NOT.WNFWR(FCAOUT,I1,DBUF,J0)) GOTO 10 !REWRITE - END IF - J=J+4*STHJ(STH_NIFR_J)*LB_X !NEXT DATA POINTERS - J0=J0+4*STHJ(STH_NIFR_J)*LB_X - END DO - END IF -C -C SCANS -C - J=STHJ(STH_SCNP_J) !POINTER TO SCAN - I1=6*STHI(STH_PLN_I)*STHJ(STH_NIFR_J) !DATA LENGTH - DBH_T(1,0)=I1 !TRANSLATION LENGTH - DO I=1,STHJ(STH_SCN_J) !ALL SCANS - IF (.NOT.WNFRD(FCAOUT,SCHHDL,SCH,J)) GOTO 10 !SCAN HEAD - CALL WNTTTL(SCHHDL,SCH,SCH_T,CVT) !CONVERT - IF (.NOT.WNFWR(FCAOUT,SCHHDL,SCH,J)) GOTO 10 !SCAN HEAD - J=J+SCHHDL !UPDATE POINTER - IF (.NOT.WNFRD(FCAOUT,I1,DBUF,J)) GOTO 10 !READ DATA - CALL WNTTTL(I1,DBUF,DBH_T,CVT) !CONVERT - IF (.NOT.WNFWR(FCAOUT,I1,DBUF,J)) GOTO 10 !WRITE DATA - J=J+I1 !UPDATE POINTER - END DO !NEXT SCAN - GOTO 30 !NEXT SET -C -C READY -C - 800 CONTINUE - CALL WNFCL(FCAOUT) !CLOSE FILE -C - RETURN -C -C ERROR -C - 900 CONTINUE - CALL WNFCL(FCAOUT) !CLOSE FILE - RETURN !READY -C -C - END diff --git a/src/nscan/nscdat.for b/src/nscan/nscdat.for deleted file mode 100644 index f509d2d7ec527c85c4ce772673e170e33f2a0db8..0000000000000000000000000000000000000000 --- a/src/nscan/nscdat.for +++ /dev/null @@ -1,770 +0,0 @@ -C+ NSCDAT.FOR -C WNB 900130 -C -C Revisions: -C WNB 910826 Retain parameters -C WNB 911031 Add WERR -C HjV 920520 HP does not allow extended source lines -C WNB 920814 More buffers in output file for LOAD -C WNB 921221 Add AERR -C JPH 930416 L_x/L_B --> LB_x. - Headings -C HJV/JPH 930524 Keywords xxx_SCAN --> xxx_SCN_NODE, SETS --> SCN_SETS -C HjV 930607 Change keyword INOUT_SCN_NODE to SCN_NODE -C WNB 930819 Add NOPT -C JPH 931007 Correct default label for DUMP and UVFITS disk output -C CMV 931220 Pass FCA of input file to WNDXLP and WNDSTA/Q -C CMV 940223 New option LIST -C CMV 940422 Add LOADIF option and IFSETS prompt -C HjV 940519 Add OLD_DATTYP -C CMV 940808 Add call to WNFMLI to list tape definitions -C HjV 941107 Add OUTPUT_VOLUME -C JPH 950109 Correct backtrack targets, ADD WNFCLS. -C Consistently interpret #/cntrl-D as backtrack request. -C (It was treated as a null reply in a few cases.) -C JPH 950118 WARC option (CMV 941012) -C CMV 950123 Add suboptions for WARC -C HjV 950116 Add LEIDEN, change LOADIF in IFLOAD -C HjV 951113 Change WARC into ARC. Add another subsection for ARC. -C CMV 970206 Add BITPIX for UVFITS -C - SUBROUTINE NSCDAT -C -C Get NSCAN program parameters -C -C Result: -C -C CALL NSCDAT will ask and set all program parameters -C -C PIN references: -C -C OPTION -C WERR_OPTION -C INPUT_UNIT -C OUTPUT_UNIT -C INPUT_FILE -C OUTPUT_FILE -C OUTPUT_VOLUME -C INPUT_LABELS -C OUTPUT_LABEL -C INTEGRATION TIME -C CHANNELS -C POINTING SETS -C OUTPUT_SCN_NODE -C INPUT_SCN_NODE -C SCN_NODE -C SCN_SETS -C POLARISATION -C UVFITS_POLAR -C HAB_OFFSET -C -C Include files: -C - INCLUDE 'WNG_DEF' - INCLUDE 'CBITS_DEF' - INCLUDE 'NSC_DEF' -C -C Parameters: -C -C -C Arguments: -C -C -C Function references: -C - LOGICAL WNDPAR !GET DWARF PARAMETER - LOGICAL WNDNOD !GET NODE NAME - LOGICAL WNFMOU !MOUNT TAPE - LOGICAL WNFOP,WNFOPF !OPEN FILE - CHARACTER*80 WNFTVL !GET VOLUME HEADER - LOGICAL WNDSTQ !GET SETS TO DO - LOGICAL NSCPLS,NSCPL2 !GET POL. TO DO/USE -C -C Data declarations: -C - INTEGER POLCD !DEFAULT POLARISATION - CHARACTER*80 VOLHD !VOLUME HEADER - CHARACTER*160 FILOUT !OUTPUT FILE NAME - CHARACTER*6 ARCWHO !WHAT KIND OF TAPE: WSRT OR LEIDEN -C- -c %*(L_J/L_B)%*LB_J% %*(L_E/L_B)%*LB_E% %,L_J/L_B%,LB_J% %,L_E/L_B%,LB_E% -C -C SET DEFAULTS -C - UNIT='""' - IFILE='""' - OUNIT='""' - NODIN=' ' - OINT=120 - NODOUT=' ' - NLAB(1)=0 - NPTC(1)=0 - NCHAN(1)=0 - POLCD=XYX_M - INTOFF(1)=0 - OFILE='""' - OLAB=0 - SETS(0,0)=0 -C -C GET OPTION -C - 100 CONTINUE - IF (.NOT.WNDPAR('OPTION',OPTION,LEN(OPTION),J0,'QUIT')) THEN - OPTION='QUIT' !ASSUME END - ELSE IF (J0.LE.0) THEN - OPTION='QUIT' !ASSUME END - END IF - -C **************************************************************************** -C LOAD/LIST WSRT -C **************************************************************************** - IF (OPT.EQ.'LOA'.OR.OPT.EQ.'IFL'.OR.OPT.EQ.'LEI'.OR. - 1 OPT.EQ.'LIS'.OR.OPT.EQ.'ARC') THEN !LOAD/LIST WSRT/LEIDEN -C - IF (OPT.EQ.'ARC' .OR. OPT.EQ.'LIS') THEN !GET SUBOPTION - 8 CONTINUE - IF (.NOT.WNDPAR('TYPE_TAPE',ARCWHO,LEN(ARCWHO), - 1 J0,'WSRT')) THEN - IF (E_C.EQ.DWC_ENDOFLOOP) GOTO 100 !RETRY OPTION - GOTO 8 !REPEAT - ELSE IF (J0.EQ.0) THEN - GOTO 100 !RETRY OPTION - ELSE IF (J0.LT.0) THEN - GOTO 8 !MUST SPECIFY - END IF - IF (OPT.EQ.'LIS') OPTION=ARCWHO(1:1)//'IST' - END IF - - IF (OPT.EQ.'ARC') THEN !GET SUBOPTION - 9 CONTINUE - IF (.NOT.WNDPAR('ARC_OPTION',OPTION,LEN(OPTION), - 1 J0,'ARCHIVE')) THEN - IF (E_C.EQ.DWC_ENDOFLOOP) GOTO 100 !RETRY OPTION - GOTO 9 !REPEAT - ELSE IF (J0.EQ.0) THEN - GOTO 100 !RETRY OPTION - ELSE IF (J0.LT.0) THEN - GOTO 9 !MUST SPECIFY - END IF - OPTION=ARCWHO(1:1)//'AR'//OPTION(1:1) - ENDIF -C - 10 CONTINUE - IF (.NOT.WNDPAR('INPUT_UNIT',UNIT,LEN(UNIT),J0,UNIT)) THEN !GET UNIT - IF (E_C.EQ.DWC_ENDOFLOOP) GOTO 100 !RETRY OPTION - GOTO 10 !REPEAT - ELSE IF (E_C.EQ.DWC_WILDCARD) THEN !LIST TAPEUNITS AND RETRY - CALL WNFMLI() - GOTO 10 - ELSE IF (J0.EQ.0) THEN - GOTO 100 !RETRY OPTION - ELSE IF (J0.LT.0) THEN - GOTO 10 !MUST SPECIFY - END IF - IF (UNIT.EQ.'D') THEN !DISK INPUT - 11 CONTINUE - IF (.NOT.WNDPAR('INPUT_FILE',IFILE,LEN(IFILE),J0,IFILE)) THEN - IF (E_C.EQ.DWC_ENDOFLOOP) GOTO 10 !RETRY UNIT - GOTO 11 !REPEAT - ELSE IF (J0.EQ.0) THEN - GOTO 10 !RETRY UNIT - ELSE IF (J0.LT.0) THEN - GOTO 11 !MUST SPECIFY - END IF - ELSE !TAPE INPUT - IF (.NOT.WNFMOU(IMCA,UNIT,'R')) THEN !MOUNT TAPE - CALL WNCTXT(F_TP,'Cannot mount tape on unit !AS (!XJ)' - 1 ,UNIT,E_C) - GOTO 10 !RETRY UNIT - END IF - VOLHD=WNFTVL(IMCA) !GET VOLUME HEADER - IF (VOLHD(1:4).EQ.'VOL1') THEN - CALL WNCTXT(F_TP,'!/Volume !AS mounted on unit !AS!/', - 1 VOLHD(5:10),UNIT) - ELSE - CALL WNCTXT(F_TP,'!/Unlabeled tape mounted on unit !AS!/', - 1 UNIT) - END IF - END IF - IF (OPT.EQ.'LOA'.OR.OPT.EQ.'IFL'.OR.OPT.EQ.'LEI') THEN - IF (OPT.EQ.'LOA'.OR.OPT.EQ.'IFL') THEN - 19 CONTINUE - IF (.NOT.WNDPAR('INTEGRATION_TIME',OINT,LB_J,J0, - 1 A_B(-A_OB),OINT,1)) THEN - IF (E_C.EQ.DWC_ENDOFLOOP) GOTO 10 !RETRY UNIT - GOTO 19 !REPEAT - ELSE IF (J0.EQ.0) THEN - GOTO 10 !RETRY UNIT - ELSE IF (J0.LT.0) THEN - GOTO 19 !MUST SPECIFY - END IF - OINT=MAX(10,OINT) -C - 18 CONTINUE - IFSETS=0 !DEFAULT: NONE - IF (OPTION(1:6).EQ.'IFLOAD') THEN - IF (.NOT.WNDPAR('IFSETS',IFSETS,LB_J,J0,'60')) THEN - IF (E_C.EQ.DWC_ENDOFLOOP) GOTO 10 !RETRY UNIT - GOTO 18 !REPEAT - ELSE IF (J0.EQ.0) THEN - GOTO 10 !RETRY UNIT - ELSE IF (J0.LT.0) THEN - IFSETS=18 !MUST SPECIFY - END IF - END IF - END IF -C - 30 CONTINUE - CALL WNFCL(FCAOUT) - IF (.NOT.WNDNOD('OUTPUT_SCN_NODE',NODOUT,'SCN', - 1 'U',NODOUT,FILOUT)) THEN - IF (E_C.EQ.DWC_ENDOFLOOP) GOTO 10!RETRY UNIT - GOTO 30 !REPEAT - ELSE IF (E_C.EQ.DWC_NULLVALUE) THEN - GOTO 10 !RETRY UNIT - ELSE IF (E_C.EQ.DWC_WILDCARD) THEN - GOTO 30 !MUST SPECIFY - END IF - IF (.NOT.WNFOPF(FCAOUT,FILOUT,'U',10,0,0,0)) THEN !OUTPUT SCAN FILE - GOTO 30 !RETRY - END IF - END IF -C -C GET JOBS -C - NJOB=0 !# OF JOBS - 15 CONTINUE - IF (NJOB.GE.MXNJOB) GOTO 900 !NO MORE - NJOB=NJOB+1 - 16 CONTINUE - IF (OPT.EQ.'LOA'.OR.OPT.EQ.'IFL'.OR.OPT.EQ.'LEI') - 1 CALL WNCTXT(F_TP, - 1 '!/Specify parameters for job !UJ\:!/',NJOB) - 14 CONTINUE - IF (NJOB.EQ.1) THEN !DEFAULTS - IF (NLAB(NJOB).LE.0) THEN - JS=WNDPAR('INPUT_LABELS',ILAB(1,NJOB), - 1 MXNLAB*LB_J,NLAB(NJOB),'*') - ELSE - JS=WNDPAR('INPUT_LABELS',ILAB(1,NJOB), - 1 MXNLAB*LB_J,NLAB(NJOB), - 1 A_B(-A_OB),ILAB(1,NJOB),NLAB(NJOB)) - END IF - ELSE - IF (NLAB(NJOB).LE.0) THEN - JS=WNDPAR('INPUT_LABELS',ILAB(1,NJOB), - 1 MXNLAB*LB_J,NLAB(NJOB),'""') - ELSE - JS=WNDPAR('INPUT_LABELS',ILAB(1,NJOB), - 1 MXNLAB*LB_J,NLAB(NJOB), - 1 A_B(-A_OB),ILAB(1,NJOB),NLAB(NJOB)) - END IF - END IF - IF (.NOT.JS) THEN - IF (E_C.EQ.DWC_ENDOFLOOP) THEN !READY -!! NJOB=NJOB-1 !NO MORE JOBS -!! GOTO 900 - GOTO 10 - END IF - GOTO 14 !RETRY - END IF - IF (NLAB(NJOB).EQ.0) THEN !READY - NJOB=NJOB-1 - GOTO 900 - END IF - IF (NJOB.LT.MXNJOB) NLAB(NJOB+1)=0 !DEFAULT FOR NEXT - IF (OPT.EQ.'LEI') THEN - POL(NJOB)=XYX_M !XX, XY, YX, YY - GOTO 900 !ONLY ONE JOB - END IF - 191 CONTINUE - IF (OPT.EQ.'WAR' .OR. OPT.EQ.'LAR' .OR. OPT.EQ.'LIS') THEN - IPTC(1,NJOB)=1 - NPTC(NJOB)=1 - ELSEIF (OPT.EQ.'WIS') THEN - JS=WNDPAR('POINTING_SETS',IPTC(1,NJOB),MXNPTC*LB_J, - 1 NPTC(NJOB),'1') !JUST ONE FOR THE LIST - ELSE IF (NPTC(NJOB).EQ.0) THEN - JS=WNDPAR('POINTING_SETS',IPTC(1,NJOB),MXNPTC*LB_J, - 1 NPTC(NJOB),'*') !GET CHANNELS TO DO - ELSE - JS=WNDPAR('POINTING_SETS',IPTC(1,NJOB),MXNPTC*LB_J, - 1 NPTC(NJOB),A_B(-A_OB), - 1 IPTC(1,NJOB),NPTC(NJOB)) - END IF - IF (.NOT.JS) THEN - IF (E_C.EQ.DWC_ENDOFLOOP) GOTO 16 !RETRY JOB - GOTO 191 !ERROR - END IF - IF (NPTC(NJOB).EQ.0) GOTO 16 !RETRY JOB - IF (NJOB.LT.MXNJOB) NPTC(NJOB+1)=0 !DEFAULT FOR NEXT - 17 CONTINUE - IF (OPT.EQ.'LOA'.OR.OPT.EQ.'IFL') THEN - IF (NCHAN(NJOB).LE.0) THEN - JS=WNDPAR('CHANNELS',CHAN(1,NJOB),MXNCHN*LB_J, - 1 NCHAN(NJOB),'*') !GET CHANNELS TO DO - ELSE - JS=WNDPAR('CHANNELS',CHAN(1,NJOB),MXNCHN*LB_J, - 1 NCHAN(NJOB),A_B(-A_OB), - 1 CHAN(1,NJOB),NCHAN(NJOB)) - END IF - IF (.NOT.JS) THEN - IF (E_C.EQ.DWC_ENDOFLOOP) GOTO 16 !RETRY JOB - GOTO 17 !ERROR - END IF - IF (NCHAN(NJOB).EQ.0) GOTO 16 !RETRY JOB - IF (NJOB.LT.MXNJOB) NCHAN(NJOB+1)=0 !DEFAULT FOR NEXT -C - IF (.NOT.NSCPLS(0,POLCD)) GOTO 16 !GET POLARISATIONS - POLCD=IOR(POLCD,X_M) !MAKE SURE ALWAYS XX - IF (IAND(POLCD,YX_M).NE.0) POLCD=XYX_M !MAKE SURE NO ISOLATED XY,YX - POL(NJOB)=POLCD !SAVE -C - 181 CONTINUE - IF (.NOT.WNDPAR('HAB_OFFSET',INTOFF(NJOB),LB_E,J0, - 1 A_B(-A_OB),INTOFF(NJOB),1)) THEN - IF (E_C.EQ.DWC_ENDOFLOOP) GOTO 16 !RETRY JOB - GOTO 181 !ERROR - END IF - IF (J0.EQ.0) GOTO 16 !RETRY JOB - IF (J0.LT.0) INTOFF(NJOB)=0 !SET NO OFFSET -C - INTOFF(NJOB)=MAX(0.,INTOFF(NJOB)) - IF (NJOB.LT.MXNJOB) INTOFF(NJOB+1)=INTOFF(NJOB) - GOTO 15 !MORE JOBS - ELSE - POL(NJOB)=0 !LOAD NOTHING FOR LIST - GOTO 900 !ONLY ONE JOB - END IF - -C **************************************************************************** -C DUMP WSRT -C **************************************************************************** - ELSE IF (OPT.EQ.'DUM') THEN - 20 CONTINUE - IF (.NOT.WNDPAR('INPUT_UNIT',UNIT,LEN(UNIT),J0,UNIT)) THEN !GET UNIT - IF (E_C.EQ.DWC_ENDOFLOOP) GOTO 100 !RETRY OPTION - GOTO 20 !REPEAT - ELSE IF (E_C.EQ.DWC_WILDCARD) THEN !LIST TAPEUNITS AND RETRY - CALL WNFMLI() - GOTO 20 - ELSE IF (J0.EQ.0) THEN - GOTO 100 !RETRY OPTION - ELSE IF (J0.LT.0) THEN - GOTO 20 !MUST SPECIFY - END IF - IF (UNIT.EQ.'D') THEN !DISK INPUT - 21 CONTINUE - IF (.NOT.WNDPAR('INPUT_FILE',IFILE,LEN(IFILE),J0,IFILE)) THEN - IF (E_C.EQ.DWC_ENDOFLOOP) GOTO 20 !RETRY UNIT - GOTO 21 !REPEAT - ELSE IF (J0.EQ.0) THEN - GOTO 20 !RETRY UNIT - ELSE IF (J0.LT.0) THEN - GOTO 21 !MUST SPECIFY - END IF - ELSE !TAPE INPUT - IF (.NOT.WNFMOU(IMCA,UNIT,'R')) THEN !MOUNT TAPE - CALL WNCTXT(F_TP,'Cannot mount tape on unit !AS (!XJ)', - 1 UNIT,E_C) - GOTO 20 !RETRY UNIT - END IF - VOLHD=WNFTVL(IMCA) !GET VOLUME HEADER - IF (VOLHD(1:4).EQ.'VOL1') THEN - CALL WNCTXT(F_TP,'!/Volume !AS mounted on unit !AS!/', - 1 VOLHD(5:10),UNIT) - ELSE - CALL WNCTXT(F_TP,'!/Unlabeled tape mounted on unit !AS!/', - 1 UNIT) - END IF - END IF - 22 CONTINUE - IF (.NOT.WNDPAR('OUTPUT_UNIT',OUNIT,LEN(OUNIT),J0,OUNIT)) THEN !OUTPUT - IF (E_C.EQ.DWC_ENDOFLOOP) THEN !RETRY OPTION - CALL WNFDMO(IMCA) !DISMOUNT - GOTO 20 !RETRY INPUT_UNIT - END IF - GOTO 22 !REPEAT - ELSE IF (E_C.EQ.DWC_WILDCARD) THEN !LIST TAPEUNITS AND RETRY - CALL WNFMLI() - GOTO 22 - ELSE IF (J0.EQ.0) THEN - CALL WNFDMO(IMCA) !DISMOUNT INPUT - GOTO 100 !RETRY OPTION - ELSE IF (J0.LT.0) THEN - GOTO 22 !MUST SPECIFY - END IF - IF (OUNIT.EQ.'D') THEN !DISK OUTPUT - 23 CONTINUE - IF (.NOT.WNDPAR('OUTPUT_FILE',OFILE,LEN(OFILE),J0,OFILE)) THEN - IF (E_C.EQ.DWC_ENDOFLOOP) GOTO 20 !RETRY UNIT - GOTO 23 !REPEAT - ELSE IF (J0.EQ.0) THEN - GOTO 22 !RETRY UNIT - ELSE IF (J0.LT.0) THEN - GOTO 23 !MUST SPECIFY - END IF - ELSE !TAPE OUTPUT - IF (.NOT.WNFMOU(OMCA,OUNIT,'W')) THEN !MOUNT TAPE - CALL WNCTXT(F_TP,'Cannot mount tape on unit !AS (!XJ)', - 1 OUNIT,E_C) - GOTO 22 !RETRY UNIT - END IF - VOLHD=WNFTVL(OMCA) !GET VOLUME HEADER - IF (VOLHD(1:4).EQ.'VOL1') THEN - CALL WNCTXT(F_TP,'!/Volume !AS mounted on unit !AS!/', - 1 VOLHD(5:10),OUNIT) - OFILE=VOLHD(5:10) - ELSE - CALL WNCTXT(F_TP,'!/Unlabeled tape mounted on unit !AS!/', - 1 OUNIT) - 27 CONTINUE - IF (.NOT.WNDPAR('OUTPUT_VOLUME',OFILE,LEN(OFILE),J0,'""')) THEN - IF (E_C.EQ.DWC_ENDOFLOOP) GOTO 22 !RETRY UNIT - GOTO 27 !REPEAT - ELSE IF (J0.EQ.0) THEN - GOTO 22 !RETRY UNIT - ELSE IF (J0.LT.0) THEN - GOTO 27 !MUST SPECIFY - END IF - END IF - END IF - 24 CONTINUE - IF (NLAB(1).LE.0) THEN - JS=WNDPAR('INPUT_LABELS',ILAB(1,1),MXNLAB*LB_J, - 1 NLAB(1),'*') - ELSE - JS=WNDPAR('INPUT_LABELS',ILAB(1,1),MXNLAB*LB_J, - 1 NLAB(1),A_B(-A_OB), - 1 ILAB(1,1),NLAB(1)) - END IF - IF (.NOT.JS) THEN - IF (E_C.EQ.DWC_ENDOFLOOP) THEN !NONE -!! NLAB(1)=0 !NONE SPECIFIED -!! ELSE -!! GOTO 24 !RETRY - GOTO 20 - END IF - END IF - 25 CONTINUE - IF (OUNIT.EQ.'D' .AND. OLAB.EQ.0) !Correct default for disk label - 1 OLAB=1 ! is 1 - IF (.NOT.WNDPAR('OUTPUT_LABEL',OLAB,LB_J,J0, - 1 A_B(-A_OB),OLAB,1)) THEN - IF (E_C.EQ.DWC_ENDOFLOOP) THEN !RETRY OPTION -!! J0=0 !NOT SPECIFIED -!! ELSE -!! GOTO 25 !RETRY - GOTO 20 - END IF - END IF - IF (J0.LE.0) OLAB=0 !START AT EOT - IF (OUNIT.EQ.'D' .AND. OLAB.EQ.0) !Correct default for disk label - 1 OLAB=1 ! is 1 - -C **************************************************************************** -C FROM OLD -C **************************************************************************** - ELSE IF (OPT.EQ.'FRO') THEN - 40 CONTINUE - IF (.NOT.WNDPAR('INPUT_FILE',IFILE,LEN(IFILE),J0,IFILE)) THEN - IF (E_C.EQ.DWC_ENDOFLOOP) GOTO 100 !RETRY OPTION - GOTO 40 !REPEAT - ELSE IF (J0.EQ.0) THEN - GOTO 100 !RETRY OPTION - ELSE IF (J0.LT.0) THEN - GOTO 40 !MUST SPECIFY - END IF - IF (.NOT.WNDPAR('OLD_DATTYP',DECSW,LB_J,J0,'0')) THEN - IF (E_C.EQ.DWC_ENDOFLOOP) GOTO 100 !RETRY OPTION - GOTO 90 !RETRY - END IF - IF (J0.EQ.0) GOTO 100 !RETRY OPTION - IF (J0.LT.0) GOTO 40 !MUST SPECIFY - 41 CONTINUE - CALL WNFCL(FCAOUT) - IF (.NOT.WNDNOD('OUTPUT_SCN_NODE',NODOUT,'SCN', - 1 'U',NODOUT,FILOUT)) THEN - IF (E_C.EQ.DWC_ENDOFLOOP) GOTO 40 !RETRY FILE - GOTO 41 !REPEAT - ELSE IF (E_C.EQ.DWC_NULLVALUE) THEN - GOTO 40 !RETRY FILE - ELSE IF (E_C.EQ.DWC_WILDCARD) THEN - GOTO 41 !MUST SPECIFY - END IF - IF (.NOT.WNFOP(FCAOUT,FILOUT,'U')) THEN !OPEN OUTPUT SCAN FILE - GOTO 41 !RETRY - END IF - -C **************************************************************************** -C TO OLD -C **************************************************************************** - ELSE IF (OPT.EQ.'TO_') THEN - 50 CONTINUE - IF (.NOT.WNDPAR('OUTPUT_FILE',OFILE,LEN(OFILE),J0,OFILE)) THEN - IF (E_C.EQ.DWC_ENDOFLOOP) GOTO 100 !RETRY OPTION - GOTO 50 !REPEAT - ELSE IF (J0.EQ.0) THEN - GOTO 100 !RETRY OPTION - ELSE IF (J0.LT.0) THEN - GOTO 50 !MUST SPECIFY - END IF - 51 CONTINUE - CALL WNFCL(FCAOUT) - IF (.NOT.WNDNOD('INPUT_SCN_NODE',NODIN,'SCN','R',NODIN,IFILE)) THEN - IF (E_C.EQ.DWC_ENDOFLOOP) GOTO 50 !RETRY FILE - GOTO 51 !REPEAT - ELSE IF (E_C.EQ.DWC_NULLVALUE) THEN - GOTO 50 !RETRY FILE - ELSE IF (E_C.EQ.DWC_WILDCARD) THEN - GOTO 51 !MUST SPECIFY - END IF - IF (.NOT.WNFOP(FCAIN,IFILE,'R')) THEN !OPEN INPUT SCAN FILE - GOTO 51 !RETRY - END IF - 52 CONTINUE - IF (.NOT.WNDSTQ('SCN_SETS',MXNSET,SETS)) THEN !SETS TO COPY - CALL WNFCL(FCAIN) - GOTO 50 !RETRY FILE - END IF - IF (SETS(0,0).EQ.0) GOTO 52 !NO SETS SPECIFIED - -C **************************************************************************** -C CONVERT VAX TO LOCAL -C **************************************************************************** -C - ELSE IF (OPT.EQ.'CVX') THEN - 60 CONTINUE - 61 CONTINUE - CALL WNFCL(FCAOUT) - IF (.NOT.WNDNOD('SCN_NODE',NODOUT,'SCN', - 1 'R',NODOUT,FILOUT)) THEN - IF (E_C.EQ.DWC_ENDOFLOOP) GOTO 100 !RETRY OPTION - GOTO 61 !REPEAT - ELSE IF (E_C.EQ.DWC_NULLVALUE) THEN - GOTO 100 !RETRY OPTION - ELSE IF (E_C.EQ.DWC_WILDCARD) THEN - GOTO 61 !MUST SPECIFY - END IF - IF (.NOT.WNFOP(FCAOUT,FILOUT,'U')) THEN !OPEN OUTPUT SCAN FILE - GOTO 61 !RETRY - END IF -C **************************************************************************** -C CONVERT TO NEWEST VERSION; OPTION -C **************************************************************************** - ELSE IF (OPT.EQ.'NVS' .OR. OPT.EQ.'NOP') THEN - 70 CONTINUE - 71 CONTINUE - CALL WNFCL(FCAOUT) - IF (.NOT.WNDNOD('SCN_NODE',NODOUT,'SCN', - 1 'R',NODOUT,FILOUT)) THEN - IF (E_C.EQ.DWC_ENDOFLOOP) GOTO 100 !RETRY OPTION - GOTO 71 !REPEAT - ELSE IF (E_C.EQ.DWC_NULLVALUE) THEN - GOTO 100 !RETRY OPTION - ELSE IF (E_C.EQ.DWC_WILDCARD) THEN - GOTO 71 !MUST SPECIFY - END IF - IF (.NOT.WNFOP(FCAOUT,FILOUT,'U')) THEN !OPEN OUTPUT SCAN FILE - GOTO 71 !RETRY - END IF -C **************************************************************************** -C CONVERT MOSAIC TAPE ERROR -C **************************************************************************** - ELSE IF (OPT.EQ.'WER' .OR. OPT.EQ.'AER' - 1 .OR. OPT.EQ.'VFI') THEN - 72 CONTINUE - IF (OPT.EQ.'WER') THEN - IF (.NOT.WNDPAR('WERR_OPTION',OPTION, - 1 LEN(OPTION),J0,'QUIT')) THEN - OPTION='QUIT' !ASSUME END - ELSE IF (J0.LE.0) THEN - OPTION='QUIT' !ASSUME END - END IF - IF (OPT.EQ.'QUI') GOTO 100 !RETRY OPTION - END IF - 73 CONTINUE - CALL WNFCL(FCAOUT) - IF (.NOT.WNDNOD('SCN_NODE',NODOUT,'SCN', - 1 'R',NODOUT,FILOUT)) THEN - IF (E_C.EQ.DWC_ENDOFLOOP) GOTO 100 !RETRY OPTION - GOTO 73 !REPEAT - ELSE IF (E_C.EQ.DWC_NULLVALUE) THEN - GOTO 100 !RETRY OPTION - ELSE IF (E_C.EQ.DWC_WILDCARD) THEN - GOTO 73 !MUST SPECIFY - END IF - IF (.NOT.WNFOP(FCAOUT,FILOUT,'U')) THEN !OPEN OUTPUT SCAN FILE - GOTO 73 !RETRY - END IF - 74 CONTINUE - IF (.NOT.WNDSTQ('SCN_SETS',MXNSET,SETS,FCAOUT)) THEN !SETS TO CORRECT - CALL WNFCL(FCAOUT) - GOTO 73 !RETRY FILE - END IF - IF (SETS(0,0).EQ.0) GOTO 74 !NO SETS SPECIFIED - -C **************************************************************************** -C WRITE UVFITS -C **************************************************************************** - ELSE IF (OPT.EQ.'UVF') THEN - 82 CONTINUE - IF (.NOT.WNDPAR('OUTPUT_UNIT',OUNIT,LEN(OUNIT),J0,OUNIT)) THEN !OUTPUT - IF (E_C.EQ.DWC_ENDOFLOOP) THEN !RETRY OPTION - GOTO 100 !RETRY OPTION - END IF - GOTO 82 !REPEAT - ELSE IF (E_C.EQ.DWC_WILDCARD) THEN !LIST TAPEUNITS AND RETRY - CALL WNFMLI() - GOTO 82 - ELSE IF (J0.EQ.0) THEN - GOTO 100 !RETRY OPTION - ELSE IF (J0.LT.0) THEN - GOTO 82 !MUST SPECIFY - END IF - IF (OUNIT.EQ.'D') THEN !DISK OUTPUT - 83 CONTINUE - IF (.NOT.WNDPAR('OUTPUT_FILE',OFILE,LEN(OFILE),J0,OFILE)) THEN - IF (E_C.EQ.DWC_ENDOFLOOP) GOTO 82 !RETRY UNIT - GOTO 83 !REPEAT - ELSE IF (J0.EQ.0) THEN - GOTO 82 !RETRY UNIT - ELSE IF (J0.LT.0) THEN - GOTO 83 !MUST SPECIFY - END IF - ELSE !TAPE OUTPUT - IF (.NOT.WNFMOU(OMCA,OUNIT,'W')) THEN !MOUNT TAPE - CALL WNCTXT(F_TP,'Cannot mount tape on unit !AS (!XJ)', - 1 OUNIT,E_C) - GOTO 82 !RETRY UNIT - END IF - VOLHD=WNFTVL(OMCA) !GET VOLUME HEADER - IF (VOLHD(1:4).EQ.'VOL1') THEN - CALL WNCTXT(F_TP,'!/Volume !AS mounted on unit !AS!/', - 1 VOLHD(5:10),OUNIT) - ELSE - CALL WNCTXT(F_TP,'!/Unlabeled tape mounted on unit !AS!/', - 1 OUNIT) - END IF - END IF - 85 CONTINUE - IF (OUNIT.EQ.'D' .AND. OLAB.EQ.0) !Correct default for disk label - 1 OLAB=1 ! is 1 - IF (.NOT.WNDPAR('OUTPUT_LABEL',OLAB,LB_J,J0, - 1 A_B(-A_OB),OLAB,1)) THEN - IF (E_C.EQ.DWC_ENDOFLOOP) THEN !RETRY OPTION -!! J0=0 !NOT SPECIFIED - goto 82 - ELSE - GOTO 85 !RETRY - END IF - END IF - IF (J0.LE.0) THEN - IF (OUNIT.EQ.'D') THEN - OLAB=1 !START AT 1 - ELSE - OLAB=0 !START AT EOT - END IF - END IF - 81 CONTINUE - CALL WNFCL(FCAIN) - IF (.NOT.WNDNOD('INPUT_SCN_NODE',NODIN,'SCN','R',NODIN,IFILE)) THEN - IF (E_C.EQ.DWC_ENDOFLOOP) GOTO 82 !RETRY OUTPUT - GOTO 81 !REPEAT - ELSE IF (E_C.EQ.DWC_NULLVALUE) THEN - GOTO 82 !RETRY OUTPUT - ELSE IF (E_C.EQ.DWC_WILDCARD) THEN - GOTO 81 !MUST SPECIFY - END IF - IF (.NOT.WNFOP(FCAIN,IFILE,'R')) THEN !OPEN INPUT SCAN FILE - GOTO 81 !RETRY - END IF - 84 CONTINUE - IF (.NOT.WNDSTQ('SCN_SETS',MXNSET,SETS,FCAIN)) THEN !SETS TO COPY -!! GOTO 82 !RETRY OUTPUT - goto 81 - END IF -!! IF (SETS(0,0).EQ.0) GOTO 81 !NO SETS SPECIFIED - IF (IAND(POLCD,XYX_M).EQ.XYX_M) POLCD=IQUV_M - IF (.NOT.NSCPL2(0,POLCD)) GOTO 81 !GET POL. TO DO - POL(1)=POLCD !SAVE - 88 CONTINUE - OINT=16 !DEFAULT - IF (.NOT.WNDPAR('BITPIX',OINT,LB_J,J0, - 1 A_B(-A_OB),OINT,1)) THEN - IF (E_C.EQ.DWC_ENDOFLOOP) GOTO 84 !RETRY UNIT - GOTO 88 !REPEAT - ELSE IF (J0.EQ.0) THEN - GOTO 84 !RETRY SCNSETS - ELSE IF (J0.LT.0) THEN - GOTO 88 !MUST SPECIFY - END IF - IF (OINT.LT.0) THEN !SHOULD BE -32,16,32 - OINT=-32 - ELSE IF (OINT.LT.16) THEN - OINT=16 - ELSE IF (OINT.GT.16) THEN - OINT=32 - END IF - -C **************************************************************************** -C PRINT FITS -C **************************************************************************** - ELSE IF (OPT.EQ.'PFI') THEN - 90 CONTINUE - IF (.NOT.WNDPAR('INPUT_UNIT',UNIT,LEN(UNIT),J0,UNIT)) THEN !GET UNIT - IF (E_C.EQ.DWC_ENDOFLOOP) GOTO 100 !RETRY OPTION - GOTO 90 !REPEAT - ELSE IF (E_C.EQ.DWC_WILDCARD) THEN !LIST TAPEUNITS AND RETRY - CALL WNFMLI() - GOTO 90 - ELSE IF (J0.EQ.0) THEN - GOTO 100 !RETRY OPTION - ELSE IF (J0.LT.0) THEN - GOTO 90 !MUST SPECIFY - END IF - IF (UNIT.EQ.'D') THEN !DISK INPUT - 91 CONTINUE - IF (.NOT.WNDPAR('INPUT_FILE',IFILE,LEN(IFILE),J0,IFILE)) THEN - IF (E_C.EQ.DWC_ENDOFLOOP) GOTO 90 !RETRY UNIT - GOTO 91 !REPEAT - ELSE IF (J0.EQ.0) THEN - GOTO 90 !RETRY UNIT - ELSE IF (J0.LT.0) THEN - GOTO 91 !MUST SPECIFY - END IF - ELSE !TAPE INPUT - IF (.NOT.WNFMOU(IMCA,UNIT,'R')) THEN !MOUNT TAPE - CALL WNCTXT(F_TP,'Cannot mount tape on unit !AS (!XJ)' - 1 ,UNIT,E_C) - GOTO 90 !RETRY UNIT - END IF - VOLHD=WNFTVL(IMCA) !GET VOLUME HEADER - IF (VOLHD(1:4).EQ.'VOL1') THEN - CALL WNCTXT(F_TP,'!/Volume !AS mounted on unit !AS!/', - 1 VOLHD(5:10),UNIT) - ELSE - CALL WNCTXT(F_TP,'!/Unlabeled tape mounted on unit !AS!/', - 1 UNIT) - END IF - END IF - 92 CONTINUE - IF (NLAB(1).LE.0) THEN - JS=WNDPAR('INPUT_LABELS',ILAB(1,1), - 1 MXNLAB*LB_J,NLAB(1),'*') - ELSE - JS=WNDPAR('INPUT_LABELS',ILAB(1,1), - 1 MXNLAB*LB_J,NLAB(1), - 1 A_B(-A_OB),ILAB(1,1),NLAB(1)) - END IF - IF (.NOT.JS) THEN - IF (E_C.EQ.DWC_ENDOFLOOP) GOTO 91 !RETRY - GOTO 91 !RETRY - END IF - IF (NLAB(1).EQ.0) GOTO 91 !RETRY - END IF -C - 900 CONTINUE - RETURN !READY -C -C - END diff --git a/src/nscan/nscdmp.for b/src/nscan/nscdmp.for deleted file mode 100644 index a93b6984d1d6c88da607414914d85f1e37e54423..0000000000000000000000000000000000000000 --- a/src/nscan/nscdmp.for +++ /dev/null @@ -1,321 +0,0 @@ -C+ NSCDMP.FOR -C WNB 900219 -C -C Revisions: -C HjV 920520 HP does not allow extended source lines -C HjV 941107 Add (when tape) label to MEDIAD -C If volume does not exist, also add it. -C Therefore extract several fields: -C FD-26 (record length in bytes) -C FD-28 (# of records per block) -C FD-100 (# of blocks) -C OH-40 (Sequence-number) -C HjV 941125 Typo, WNCALN declared twice -C CMV 950120 Always stop if not completely copied, -C Defensize rounding for size -C CMV 950125 Inform MEDIAD if label partially copied -C HjV 970407 Give error-message in case WNFRD return an error -C -C - SUBROUTINE NSCDMP -C -C Dump WSRT tape to disk or vice versa -C -C Result: -C -C CALL NSCDMP will dump a WSRT tape to/from disk -C -C Include files: -C - INCLUDE 'WNG_DEF' - INCLUDE 'NSC_DEF' - INCLUDE 'FDW_O_DEF' - INCLUDE 'FDW_T_DEF' - INCLUDE 'OHW_O_DEF' - INCLUDE 'OHW_T_DEF' -C -C Parameters: -C -C -C Arguments: -C -C -C Function references: -C - LOGICAL WNDPAR !Get DWARF parameter - LOGICAL WNFOP,WNFOPF !OPEN FILE - LOGICAL WNFRD !READ DATA - LOGICAL WNFWR !WRITE DATA - REAL WNFTLN !TAPE LENGTH WRITTEN - INTEGER WNFTLB !CURRENT TAPE LABEL - INTEGER WNCALN !STRING LENGTH - INTEGER WNFSCI !Talk to Scissor qed deqmon - INTEGER WNFSCS !GET RETURN STRING - LOGICAL WNGMED !Handle medium administration -C -C Data declarations: -C - CHARACTER*6 VOLUME !OUTPUT VOLUME - CHARACTER*6 LTXT !LABEL NAME - BYTE RWBUF(SRTRCL) !I/O BUFFER - BYTE TBUF(SRTRCL) !I/O BUFFER - CHARACTER*1 TBUFC(SRTRCL) !I/O BUFFER - INTEGER TBUFJ(SRTRCL/4) !I/O BUFFER - INTEGER*2 TBUFI(SRTRCL/2) !I/O BUFFER - LOGICAL FDDONE,OHDONE !SWITCH TO SEE IF FD/OH DONE - LOGICAL OUTOPEN !SWITCH TO SEE IF OMCA OPEN - INTEGER*2 LRCRD !RECORD LENGTH IN BYTES (FD-26) - INTEGER*2 PHBLL !# RECODS PER BLOCK (FD-28) - INTEGER NBL !# OF DATA-BLOCKS (FD-100) - INTEGER VOLGNR !SEQUENCENR. OF OBS. (OH-40) - REAL MBYT !LENGTH IN MBYTES - REAL FREE !Free space in Mbytes - REAL NEEDS !Needed space in Mbytes - BYTE LG1 - LOGICAL LG4 - CHARACTER*128 SCIBUF !I/O BUFFER FOR SCI-ROUTINES - CHARACTER*1024 COMMAND !Command to send - - EQUIVALENCE (TBUF,TBUFC,TBUFI,TBUFJ) -C- -C -C INIT -C - J=0 !START LABEL INPUT - J1=OLAB-1 !START LABEL OUTPUT -C -C DO A LABEL -C - 10 CONTINUE - J1=J1+1 !NEXT OUTPUT LABEL - J=J+1 !COUNT INPUT LABEL - IF (NLAB(1).LT.0) THEN !ALL LABELS ON TAPE - J0=J !NEXT INPUT LABEL - ELSE IF (J.LE.NLAB(1)) THEN - J0=ILAB(J,1) !NEXT INPUT LABEL - ELSE - GOTO 900 !READY - END IF -C -C OPEN INPUT -C - IF (UNIT.EQ.'D') THEN !DISK INPUT - CALL WNCTXS(LTXT,'!6$ZJ',J0) !MAKE LABEL NAME - IF (.NOT.WNFOP(IMCA,IFILE(1:WNCALN(IFILE))//'.'//LTXT,'R')) THEN - IF (NLAB(1).GT.0) - 1 CALL WNCTXT(F_TP,'Cannot find file !AS\.!AS',IFILE,LTXT) - GOTO 900 !STOP - END IF - ELSE !TAPE INPUT - IF (.NOT.WNFOPF(IMCA,' ','R',0,0,0,J0)) THEN - CALL WNCTXT(F_TP,'Cannot find label !UJ',J0) - GOTO 900 - END IF - END IF -C -C COPY DATA, OPEN INPUT ONCE EVERYTHING HAS BEEN CHECKED -C - OUTOPEN=.FALSE. - FDDONE=.FALSE. - OHDONE=.FALSE. - VOLGNR=-1 - J2=0 !DATA POINTER -C -C READ -C - 20 CONTINUE - IF (.NOT.WNFRD(IMCA,SRTRCL,RWBUF,J2)) THEN !EOD - IF (E_C .NE. '00000870'X .AND. E_C .NE. '00000000'X) THEN - CALL WNCTXT(F_TP,'ERROR: ') - CALL WNCTXT(F_TP,'ERROR: Program halted with error !XJ',E_C) - CALL WNCTXT(F_TP,'ERROR: ') - ENDIF - CALL WNFCL(IMCA) !CLOSE INPUT -C -C Output not open, so nothing written, generate error -C - IF (.NOT.OUTOPEN) THEN - CALL WNCTXT(F_TP,'Nothing copied from input...') - GOTO 900 - END IF -C -C Flush last buffer to get proper output size -C - IF (OUNIT.NE.'D') J1=WNFTLB(OMCA) !CURRENT OUTPUT LABEL - CALL WNCTXT(F_TP,'Label !UJ copied to label !UJ',J0,J1) - 21 CONTINUE - CALL WNFPUR(OMCA) !WRITE REMAINING BYTES - IF (OUNIT.NE.'D') THEN - MBYT=WNFTLN(OMCA,3) !LENGTH IN MBYTES - CALL WNCTXT(F_TP,'!F8.3 Mbytes written',MBYT+0.00005) - IF (MBYT.EQ.0) THEN !NOTHING WRITTEN AT ALL... - CALL WNCTXT(F_TP, - 1 'Aborting dump, possibly open error on label') - GOTO 900 - ENDIF - END IF -C -C Now close the output and inform Scissor if necessary -C - CALL WNFCL(OMCA) !CLOSE OUTPUT - IF (OUNIT.NE.'D') THEN !SEND TO SCISERV - IF (.NOT.WNGMED(OFILE(1:6),J1,MBYT,VOLGNR)) THEN - CALL WNCTXT(F_TP, - 1 'The dump will be aborted since the administration '// - 1 'is incorrect') - CALL WNCTXT(F_TP, - 1 'Please inform the Scissor manager before continuing') - GOTO 900 - ENDIF - END IF - GOTO 10 !NEXT LABEL - END IF -C -C EXTRACT INFO -C - IF (.NOT.FDDONE) THEN !TEST FORMAT - DO J3=1,SRTRCL - TBUF(J3)=RWBUF(J3) - END DO - IBMSW=.FALSE. !ASSUME NON-IBM - DECSW=.FALSE. !ASSUME LOCAL - IF (TBUFC(3).NE.'F' .OR. TBUFC(4).NE.'D') THEN - IBMSW=.TRUE. !ASSUME IBM - CALL WNTTIL(SRTRCL,TBUF,FDW_T) !TRANSLATE - IF (TBUFC(3).NE.'F' .OR. TBUFC(4).NE.'D') THEN - 23 CONTINUE - CALL WNCTXT(F_TP,'Not a WSRT tape, could not find FD') - GOTO 901 !RETURN - END IF - ELSE IF (TBUFI(1).NE.32767) THEN - DECSW=.TRUE. !ASSUME FROM DEC - CALL WNTTDL(SRTRCL,TBUF,FDW_T) !TRANSLATE - IF (TBUFI(1).NE.32767) GOTO 23 -C -C DECStation/Alpha has the same swapping sequence as VAX D/G, -C but uses IEEE floating point format. The test on BUFi2(1) is -C therefore not sufficient. Since raw data is assumed to be in -C IBM (type -1) or VAX D (type 1) format, the following test is -C safe and sufficient. -C - ELSE IF (PRGDAT.EQ.6) THEN - DECSW=.TRUE. !ASSUME FROM DEC - CALL WNTTDL(SRTRCL,TBUF,FDW_T) !TRANSLATE - IF (TBUFI(1).NE.32767) GOTO 23 - END IF - FDDONE=.TRUE. - LRCRD=TBUFI(FDW_LRCRD_I+1) - PHBLL=TBUFI(FDW_PHBLL_I+1) - NBL=TBUFJ(FDW_NBL_J+1) -C -C CALCULATE IF THIS LABEL FITS ON OUTPUT VOLUME -C - IF (OUNIT.NE.'D') THEN !TAPE OUTPUT - VOLUME=OFILE(1:6) -C -C Check if label already exist (only if not append) -C - IF (J1.NE.0) THEN - CALL WNCTXS (COMMAND, - 1 'SELECT=MEDIAD LABEL=!UJ VOLUME=!AS', - 2 J1,VOLUME) - J3=WNFSCI(COMMAND) !Send command - IF (MOD(J3,100).EQ.0) THEN !Label already exist - CALL WNCTXT(F_TP,'Label !UJ already exist on volume !AS', - 1 J1,VOLUME) - 80 CONTINUE - IF (.NOT.WNDPAR('OVERWRITE',LG1,1,J3,'Y')) GOTO 80 - LG4=LG1 - IF (J3.EQ.1 .AND. LG4) THEN !YES - CALL WNCTXS (COMMAND, - 1 'DELETE=MEDIAD LABEL=!UJ VOLUME=!AS', - 2 J1,VOLUME) - J3=WNFSCI(COMMAND) !Send command - ENDIF - IF ((MOD(J3,100).NE.0).OR.(.NOT.LG4)) THEN !Failed or NO - GOTO 901 - ENDIF - J3=WNFSCS(SCIBUF) - CALL WNCTXT(F_TP,'!AS',SCIBUF(1:WNCALN(SCIBUF))) - ENDIF - ENDIF -C - J3=WNFSCI('CHECK=VOLUMES VOLUME='//VOLUME) - IF (MOD(J3,100).NE.0) THEN - CALL WNCTXT(F_TP,'Could not get free space for volume !AS', - 1 VOLUME) - ELSE - J3=WNFSCS(SCIBUF) - READ (SCIBUF,*) FREE - NEEDS=1.+((NBL*PHBLL*LRCRD)/1024.**2.) - IF (FREE.LE.NEEDS) THEN !Does not fit - CALL WNCTXT(F_TP,'Not enough free space on volume !AS', - 1 VOLUME) - CALL WNCTXT(F_TP,'Available !F9.3 Mb, need about: !F9.3 Mb', - 1 FREE,NEEDS) - GOTO 901 - END IF - END IF - END IF - ELSE - IF (.NOT.OHDONE) THEN !GET SEQUENCE NR. - DO J3=1,SRTRCL - TBUF(J3)=RWBUF(J3) - END DO -C -C READ OH -C - IF (IBMSW) CALL WNTTIL(SRTRCL,TBUF,OHW_T) !TRANSLATE - IF (DECSW) CALL WNTTDL(SRTRCL,TBUF,OHW_T) - IF (TBUFI(1).NE.32767 .OR. - 1 TBUFC(3).NE.'O' .OR. TBUFC(4).NE.'H') THEN - GOTO 200 !MORE - END IF - OHDONE=.TRUE. - VOLGNR=TBUFJ(OHW_VOLGNR_J+1) - END IF - END IF -C -C OPEN OUTPUT IF NOT YET DONE -C - IF (.NOT.OUTOPEN) THEN - IF (OUNIT.EQ.'D') THEN !DISK OUTPUT - CALL WNCTXS(LTXT,'!6$ZJ',J1) !MAKE LABEL NAME - IF (.NOT.WNFOP(OMCA, - 1 OFILE(1:WNCALN(OFILE))//'.'//LTXT,'W')) THEN - CALL WNCTXT(F_TP,'Cannot open file !AS\.!AS',OFILE,LTXT) - GOTO 900 !STOP - END IF - ELSE !TAPE OUTPUT - IF (.NOT.WNFOPF(OMCA,' ','W',0,0,0,J1)) THEN - CALL WNCTXT(F_TP,'Cannot write to label !UJ',J1) - GOTO 900 - END IF - END IF - OUTOPEN=.TRUE. - END IF -C -C WRITE -C - 200 IF (.NOT.WNFWR(OMCA,SRTRCL,RWBUF,J2)) THEN !COPY DATA - IF (OUNIT.NE.'D') J1=WNFTLB(OMCA) !CURRENT OUTPUT LABEL - CALL WNCTXT(F_TP,'Write error on output') - CALL WNCTXT(F_TP,'Label !UJ not fully copied'// - 1 ' to label !UJ',J0,J1) - VOLGNR=0 !DUMMY SEQNUMBER - GOTO 21 !STOP - END IF - J2=J2+SRTRCL !NEXT POINTER - GOTO 20 !MORE -C -C READY -C - 901 CALL WNFCL(IMCA) !CLOSE INPUT - CALL WNFCL(OMCA) !CLOSE OUTPUT - 900 CALL WNFDMO(IMCA) !DISMOUNT INPUT - CALL WNFDMO(OMCA) !DISMOUNT OUTPUT -C - RETURN !READY -C -C - END diff --git a/src/nscan/nscggn.for b/src/nscan/nscggn.for deleted file mode 100644 index ce82208fb8524729777a143626f4ddad1c81c133..0000000000000000000000000000000000000000 --- a/src/nscan/nscggn.for +++ /dev/null @@ -1,208 +0,0 @@ -C+ NSCGGN.FOR -C CMV 940930 -C -C Revisions: -C CMV 940930 Created -C -C - SUBROUTINE NSCGGN(GNOUT,TSYS,GNCAL,IFH,STH,TPIN) -C -C Return telescope gain etc. based on TPon/TPoff values -C -C Result: -C -C CALL NSCGGN(GNOUT_E(0:STHTEL-1,0:1):O, -C TSYS_E(0:STHTEL-1,0:1):O, -C GNCAL_E(0:STHTEL-1,0:1):O, -C IFH_B(*):I,STH_B(*), -C TPIN_I(2,0:1,0:STHTEL-1):I) -C -C Returns, for each telescope and for each dipole, -C the gain (in GNOUT), the system temperature (in TSYS) -C and the correction method used (in GNCAL). -C The calculation is based on constants defined in -C this routine and on the information in the IF-header -C (IFH) and the total power data (in TPIN), for the -C configuration described by STH. -C -C The IF-header is described in IFH.DSC, the TPIN array -C should contain TPon and TPoff -C -C -C Include files: -C - INCLUDE 'WNG_DEF' - INCLUDE 'STH_O_DEF' !SECTOR HEADER - INCLUDE 'IFH_O_DEF' !IF-SET HEADER -C -C Parameters: -C - REAL RAWSCALE !Scale for raw corr.fractions - PARAMETER(RAWSCALE=23104.) -C - REAL TCDCB,TCDLB !Fraction TPon for DCB and DLB - PARAMETER(TCDCB=1./8.) - PARAMETER(TCDLB=1./16.) -C - REAL EFF92,EFF49,EFF21,EFF18,EFF06,EFF03 !Aperture efficiencies - PARAMETER(EFF92=0.59) - PARAMETER(EFF49=0.59) - PARAMETER(EFF21=0.54) - PARAMETER(EFF18=0.54) - PARAMETER(EFF06=0.48) - PARAMETER(EFF03=0.48) -C - REAL DIPP,DIPC !Dipole factor parallel/crossed - PARAMETER(DIPP=1.0) - PARAMETER(DIPC=1.414214) -C - REAL BOLZMAN !Bolzmann constant - PARAMETER(BOLZMAN=1.3805E-23) - REAL APERTURE !Effective aperture - PARAMETER(APERTURE=491E0) !PI*12.5**2 -C - REAL MINDCB,MAXDCB,MINDLB,MAXDLB !Allowed range for TPoff -C** PARAMETER(MINDCB=600.) - PARAMETER(MINDCB=100.) -C** PARAMETER(MAXDCB=25000.) - PARAMETER(MAXDCB=30000.) - PARAMETER(MINDLB=100.) - PARAMETER(MAXDLB=12000.) -C - REAL MINNOISE,MAXNOISE !Range for noise factors - PARAMETER(MINNOISE=0.013333333) - PARAMETER(MAXNOISE=2.0) -C -C Arguments: -C - REAL GNOUT(0:STHTEL-1,0:1) !Gain factors (output) - REAL TSYS(0:STHTEL-1,0:1) !System temperatures (output) - REAL GNCAL(0:STHTEL-1,0:1) !Correction method used (output) - INTEGER*2 IFH(0:*) !IF-header - REAL STH(0:*) !Sector header - INTEGER*2 TPIN(2,0:1,0:STHTEL-1) !TPon/off -C -C Function references: -C - INTEGER WNGARA !FIND ADDRESS - INTEGER WNMEJC !CEIL - INTEGER WNMEJF !FLOOR -C -C Data declarations: -C - REAL TPON,TPOFF !TEMP. FOR TP-values - REAL SCALE,GAMMA !SCALE AND OFFSET FOR GAIN - REAL LIM(2) !LIMITS FOR TPON/OFF -C- -C -C INIT -C -C - SCALE=4E28*BOLZMAN/APERTURE !NOMINAL SCALE -C -C Settings dependent on frequency -C - J=(WNGARA(STH(0))-A_OB)/LB_D !ADDRESS HEADER - IF (A_D(J+STH_FRQ_D).LT.500.D0) THEN ! 92 cm - SCALE=SCALE/EFF92 - ELSE IF (A_D(J+STH_FRQ_D).LT.1000.D0) THEN ! 49 cm - SCALE=SCALE/EFF49 - ELSE IF (A_D(J+STH_FRQ_D).LT.1500.D0) THEN ! 21 cm - SCALE=SCALE/EFF21 - ELSE IF (A_D(J+STH_FRQ_D).LT.3000.D0) THEN ! 18 cm - SCALE=SCALE/EFF18 - ELSE IF (A_D(J+STH_FRQ_D).LT.6000.D0) THEN ! 6 cm - SCALE=SCALE/EFF06 - ELSE ! 3 cm - SCALE=SCALE/EFF03 - END IF -C -C Settings dependent on dipoles (assume crossed or parallel) -C - J=(WNGARA(STH(0))-A_OB)/LB_J !ADDRESS HEADER - I1=A_J(J+STH_DIPC_J) !GET DIPOLE CODE - IF (I1/'0ff00000'X .EQ. IAND(I1,'0ff'X)) THEN !PARALLEL - SCALE=SCALE*DIPP - ELSE !CROSSED - SCALE=SCALE*DIPC - END IF -C -C Settings dependent on backend -C - J=(WNGARA(STH(0))-A_OB)/LB_I !ADDRESS HEADER - IF (A_I(J+STH_BEC_I).GE.64.OR. - 1 A_I(J+STH_BEC_I).LT.80) THEN !DCB - LIM(1)=MINDCB - LIM(2)=MAXDCB - GAMMA=TCDCB - ELSE !DLB/DXB - LIM(1)=MINDLB - LIM(2)=MAXDLB - GAMMA=TCDLB - END IF -C -C CALCULATE BASED ON VALUES FOUND -C -C -C Method 0: Just scaled correlation coefficients -C Method 1: Use Noise source temp Gain=(TPon-TPoff)/NoiseI -C Method 2: Use fixed receiver gain Gain=GainI -C Method 3: No Gain correction, Tsys is fixed system temp. -C -C For method 1 and 2: Tsys=TPoff/Gain -C -C -C Change method using WSRT criteria: -C Method 1 -> 2 if (TPon - TPoff)/TPon < 1/75 or >= 2 -C Method 2 -> 3 if TPoff < 600 or >= 25000 (DCB) -C TPoff < 100 or >= 15000 (else) -C - J1=(WNGARA(IFH(0))-A_OB)/LB_I !ADDRESS HEADER - J2=(WNGARA(IFH(0))-A_OB)/LB_E !ADDRESS HEADER -C - DO I5=0,1 !X,Y - DO I4=0,STHTEL-1 !IF's -C - TPOFF=TPIN(1,I5,I4) - TPON =TPIN(2,I5,I4) - GNCAL(I4,I5)=A_I(J1+IFH_GNCAL_I+2*I4+I5) !Take method from IFH -C -C IF (TPON .LT.LIM(1).OR.TPON .GE.LIM(2).OR. -C 1 TPOFF.LT.LIM(1).OR.TPOFF.GE.LIM(2)) THEN -C GNCAL(I4,I5)=3.0 !Bad TP, use method 3 -C END IF -C - IF (NINT(GNCAL(I4,I5)).EQ.1) THEN - R0=(TPON-TPOFF)/TPOFF !FACTOR -C IF (R0.LT.MINNOISE .OR. R0.GE.MAXNOISE) THEN -C GNCAL(I4,I5)=2.0 !NOISE SOURCE DIED -C ELSE - TSYS(I4,I5)=A_E(J2+IFH_TNOISEI_E+2*I4+I5)* - 1 (1./R0+GAMMA) !TSYS - GNOUT(I4,I5)=SCALE*TSYS(I4,I5) !GAIN CORRECTION -C END IF - END IF -C - IF (NINT(GNCAL(I4,I5)).EQ.2) THEN - TSYS(I4,I5)=TPOFF/A_E(J2+IFH_RGAINI_E+2*I4+I5) !FIXED GAIN - GNOUT(I4,I5)=SCALE*TSYS(I4,I5) !GAIN CORRECTION -C - ELSE IF (NINT(GNCAL(I4,I5)).EQ.3) THEN - TSYS(I4,I5)=A_E(J2+IFH_TSYSI_E+2*I4+I5) !FIXED TSYS - GNOUT(I4,I5)=SCALE*TSYS(I4,I5) !GAIN CORRECTION -C - ELSE IF (NINT(GNCAL(I4,I5)).EQ.0) THEN - TSYS(I4,I5)=A_E(J2+IFH_TSYSI_E+2*I4+I5) !FIXED TSYS - GNOUT(I4,I5)=RAWSCALE !JUST SCALE - END IF -C -C*** GNOUT(I4,I5)=SQRT(GNOUT(I4,I5)) !FACTOR FOR IFR'S - GNOUT(I4,I5)=TPOFF/TSYS(I4,I5) -C - END DO - END DO -C - RETURN -C -C - END diff --git a/src/nscan/nscgif.for b/src/nscan/nscgif.for deleted file mode 100644 index b7ed312328ef670a1b73cfb8c61c212f8dd96698..0000000000000000000000000000000000000000 --- a/src/nscan/nscgif.for +++ /dev/null @@ -1,291 +0,0 @@ -C+ NSCGIF.FOR -C CMV 940425 -C -C Revisions: -C CMV 940425 Created -C CMV 940426 Add entry NSCGF1 -C CMV 940429 GNCAL gives strategy as used by Newstar per scan -C CMV 940429 Add entry NSCGF2 -C CMV 940513 Correct gain-method criteria -C CMV 940628 Option to add X and Y -C CMV 940930 Split off calculations to NSCGGN -C -C - LOGICAL FUNCTION NSCGIF(MODE,INFCA,STHJ,HA1,HA2,DAT) -C -C Read IF/Total Power data from a SCN file -C -C Result: -C -C NSCGIF_L = NSCGIF( MODE_C*(*):I, -C INFCA_J:I, STHJ_J:I, HA1_E:I, HA2_E:I, -C DAT_E(0:STHTEL-1,0:1):O ) -C -C MODE is a character string selecting the type -C of data to return, at present this can be: -C TPoff Total power, Noise source off -C TPon Total power, Noise source on -C Gain IF-Gain, calculated from TP's -C according to GNCAL etc. -C Tsys System temperature, idem -C Isys System temperature, add X and Y -C GNCAL Gain correction strategy -C TSYSI Constant system temperatures -C TNOISEI Constant noise source temperatures -C RGAINI Constant receiver gain -C -C INFCA is the SCN file to be read -C SCHJ is the sector header -C HA1,HA2 form the hour angle range to return -C (data will be averaged over the range) -C DAT will return the data -C -C NSCGF1_L = NSCGF1( INFCA_J:I, STHJ(0:*)_J:I, -C HAB_E:O, HAI_E:O, NTP_J:O) -C Return begin HA, HA increment and number of TP -C points from IFH header -C -C NSCGF2_L = NSCGF2( INFCA_J, STHJ(0:*)_J:I, OUT ) -C Print header information formatted on OUT (F_P, F_TP) -C -C -C Include files: -C - INCLUDE 'WNG_DEF' - INCLUDE 'NSC_DEF' - INCLUDE 'SHW_O_DEF' !SH BLOCK - INCLUDE 'SHW_T_DEF' - INCLUDE 'IHW_O_DEF' !IH BLOCK - INCLUDE 'IHW_T_DEF' - INCLUDE 'STH_O_DEF' !SET HEADER - INCLUDE 'IFH_O_DEF' !IF-SET HEADER -C -C Entry points: -C - LOGICAL NSCGF1 !RETURN HAB,HAI,NTP - LOGICAL NSCGF2 !Print header -C -C Parameters: -C -C -C Arguments: -C - CHARACTER MODE*(*) !Data type to return - INTEGER INFCA !INPUT FILE DESCRIPTOR - INTEGER STHJ(0:*) !SET HEADER - REAL HA1,HA2 !Hour angle range - REAL DAT(0:STHTEL-1,0:1) !Return data - INTEGER INFCA1 !INPUT FILE DESCRIPTOR - INTEGER STHJ1(0:*) !SET HEADER - REAL HAB,HAI !Hour angle start/increment - INTEGER NTP !Number of points - INTEGER INFCA2 !INPUT FILE DESCRIPTOR - INTEGER STHJ2(0:*) !SET HEADER - INTEGER OUT !Output text files -C -C Function references: -C - LOGICAL WNFRD !READ DATA - INTEGER WNGARA !FIND ADDRESS - INTEGER WNMEJC !CEIL - INTEGER WNMEJF !FLOOR -C -C Data declarations: -C - CHARACTER*10 LMODE !Local copy of mode - LOGICAL DO_DATA !Need to read data? - INTEGER NN !# OF INTEGRATED POINTS - INTEGER GNC !Actual correction method - INTEGER*2 DBUF(2,0:1,0:STHTEL-1) !INPUT BUFFER - REAL GNOUT(0:STHTEL-1,0:1) !Gain factors - REAL TSYS(0:STHTEL-1,0:1) !System temperatures - REAL GNCAL(0:STHTEL-1,0:1) !Correction method used -C - INTEGER IFHP !POINTER TO PREVIOUS IFH - DATA IFHP/0/ !NOTHING READ YET - SAVE IFHP -C - BYTE IFH(0:IFHHDL-1) !IF-SET HEADER - INTEGER*2 IFHI(0:IFHHDL/2-1) - INTEGER IFHJ(0:IFHHDL/4-1) - REAL IFHE(0:IFHHDL/4-1) - REAL*8 IFHD(0:IFHHDL/8-1) - EQUIVALENCE (IFH,IFHI,IFHJ,IFHE,IFHD) - SAVE IFH !KEEP THE CURRENT HEADER -C- -C -C INIT -C - NSCGIF=.TRUE. !ASSUME OK - LMODE=MODE !LOCAL COPY OF MODE - CALL WNCAUC(LMODE) !MAKE UPPER CASE -C - DO I1=0,STHTEL-1 !CLEAR DATA - DAT(I1,0)=0 - DAT(I1,1)=0 - END DO -C - IF (IFHP.NE.STHJ(STH_IFHP_J)) THEN !NEW IF-SET - IFHP=STHJ(STH_IFHP_J) - IF (.NOT.WNFRD(INFCA,IFHHDL,IFH,IFHP)) GOTO 900 !READ IT - END IF -C -C Check mode for the constant parameters -C - DO_DATA=.FALSE. - IF (LMODE(1:5).EQ.'TSYSI') THEN !CONSTANT TSYS - DO I1=0,1 !X,Y - DO I2=0,STHTEL-1 !IF's - DAT(I2,I1)=IFHE(IFH_TSYSI_E+2*I2+I1) - END DO - END DO - ELSE IF (LMODE(1:7).EQ.'TNOISEI' .OR. - 1 LMODE(1:6).EQ.'TNOISI') THEN !CONSTANT TNOIS - DO I1=0,1 !X,Y - DO I2=0,STHTEL-1 !IF's - DAT(I2,I1)=IFHE(IFH_TNOISEI_E+2*I2+I1) - END DO - END DO - ELSE IF (LMODE(1:6).EQ.'RGAINI') THEN !CONSTANT GAIN - DO I1=0,1 !X,Y - DO I2=0,STHTEL-1 !IF's - DAT(I2,I1)=1.0/IFHE(IFH_RGAINI_E+2*I2+I1) - END DO - END DO - ELSE IF (LMODE(1:5).EQ.'TPOFF' .OR. - 1 LMODE(1:4).EQ.'TPON' .OR. - 1 LMODE(1:4).EQ.'GAIN' .OR. - 1 LMODE(1:5).EQ.'GNCAL' .OR. - 1 LMODE(1:4).EQ.'TSYS' .OR. - 1 LMODE(1:4).EQ.'ISYS' ) THEN !NEED DATA FOR THESE - DO_DATA=.TRUE. - ELSE - CALL WNCTXT(F_TP,'Invalid data-type !AS in NSCGIF',LMODE) - NSCGIF=.FALSE. - END IF -C -C Find Hour-angle range -C - IF (DO_DATA) THEN - I1=WNMEJF((HA1-IFHE(IFH_HAB_E))/IFHE(IFH_HAI_E)) !FIRST POINT TO READ - I2=WNMEJC((HA2-IFHE(IFH_HAB_E))/IFHE(IFH_HAI_E)) !LAST POINT TO READ - IF (HA2.LE.HA1) I2=I1 !NO INVERSE RANGE -C -C Average the TP data for the hour angles in the range -C - I3=STHTEL*4*LB_I !LENGTH POINT - NN=0 !NUMBER OF POINTS - DO I=I1,I2 - IF (I.GE.0.AND.I.LT.IFHJ(IFH_NTP_J)) THEN !IN RANGE - IF (.NOT.WNFRD(INFCA,I3,DBUF, - 1 IFHP+IFHHDL+I*I3)) GOTO 900 !READ POINT - CALL NSCGGN(GNOUT,TSYS,GNCAL,IFH,STHJ,DBUF) !CALCULATE - NN=NN+1 !Count point - DO I5=0,1 !X,Y - DO I4=0,STHTEL-1 !IF's - IF (LMODE(1:5).EQ.'TPOFF') THEN - DAT(I4,I5)=DAT(I4,I5)+DBUF(1,I5,I4) - ELSE IF (LMODE(1:4).EQ.'TPON') THEN - DAT(I4,I5)=DAT(I4,I5)+DBUF(2,I5,I4) - ELSE IF (LMODE(1:4).EQ.'GAIN') THEN - DAT(I4,I5)=DAT(I4,I5)+GNOUT(I4,I5) - ELSE IF (LMODE(1:4).EQ.'TSYS' .OR. - 1 LMODE(1:4).EQ.'ISYS') THEN - DAT(I4,I5)=DAT(I4,I5)+TSYS(I4,I5) - ELSE IF (LMODE(1:5).EQ.'GNCAL') THEN - DAT(I4,I5)=MAX(DAT(I4,I5),GNCAL(I4,I5)) ! WORST CASE - END IF - END DO - END DO - END IF - END DO -C - IF (NN.GT.1) THEN !GOT SOME POINTS - IF (LMODE(1:5).NE.'GNCAL') THEN !GNCAL: Show worst case - DO I5=0,1 !X,Y - DO I4=0,STHTEL-1 !IF's - DAT(I4,I5)=DAT(I4,I5)/NN !Else: Average - END DO - END DO - END IF - IF (LMODE(1:4).EQ.'ISYS' ) THEN !Add X,Y for ISYS - DO I2=0,STHTEL-1 - R0=DAT(I2,0)+DAT(I2,1) - DAT(I2,0)=R0 - DAT(I2,1)=R0 - END DO - END IF - END IF - END IF -C - RETURN !READY -C -C Entry NSCGF1: Just return HAB, HAE, NTP -C - ENTRY NSCGF1(INFCA1,STHJ1,HAB,HAI,NTP) -C - NSCGF1=.TRUE. !ASSUME OK -C - IF (IFHP.NE.STHJ1(STH_IFHP_J)) THEN !NEW IF-SET - IFHP=STHJ1(STH_IFHP_J) - IF (.NOT.WNFRD(INFCA1,IFHHDL,IFH,IFHP)) GOTO 900 !READ IT - END IF -C - HAB=IFHE(IFH_HAB_E) - HAI=IFHE(IFH_HAI_E) - NTP=IFHJ(IFH_NTP_J) -C - RETURN -C -C Entry NSCGF2: Print header -C - ENTRY NSCGF2(INFCA2,STHJ2,OUT) -C - NSCGF2=.TRUE. !ASSUME OK -C - IF (IFHP.NE.STHJ2(STH_IFHP_J)) THEN !NEW IF-SET - IFHP=STHJ2(STH_IFHP_J) - IF (.NOT.WNFRD(INFCA2,IFHHDL,IFH,IFHP)) GOTO 900 !READ IT - END IF -C - CALL WNCTXT(OUT,' ') - CALL WNCTXT(OUT,'IF-Header for Channel !UI',IFHI(IFH_CHAN_I)) - CALL WNCTXT(OUT,'Total-power integration time used '// - 1 'during observations: !UJ sec',IFHJ(IFH_TPINT_J)) - CALL WNCTXT(OUT,'Ha-range: !E10.4 to !E10.4, increment !E10.4 ', - 1 360*IFHE(IFH_HAB_E), - 1 360*(IFHE(IFH_HAB_E)+(IFHJ(IFH_NTP_J)-1)* - 1 IFHE(IFH_HAI_E)), - 1 360*IFHE(IFH_HAI_E)) - CALL WNCTXT(OUT,'Gain correction method: !UI, TP-points: !UJ', - 1 IFHI(IFH_GNCAL_I),IFHJ(IFH_NTP_J)) - CALL WNCTXT(OUT,' ') - CALL WNCTXT(OUT,'Tel Pol GNCAL Tsys Gain Tnoise') - DO I=0,STHTEL-1 - CALL WNCTXT(OUT, - 1 ' !1$XJ X !5$UI !10$E10.3 !10$E10.3 !10$E10.3',I, - 1 IFHI(IFH_GNCAL_I+2*I), - 1 IFHE(IFH_TSYSI_E+2*I), - 1 IFHE(IFH_RGAINI_E+2*I), - 1 IFHE(IFH_TNOISEI_E+2*I)) - CALL WNCTXT(OUT, - 1 ' Y !5$UI !10$E10.3 !10$E10.3 !10$E10.3', - 1 IFHI(IFH_GNCAL_I+2*I+1), - 1 IFHE(IFH_TSYSI_E+2*I+1), - 1 IFHE(IFH_RGAINI_E+2*I+1), - 1 IFHE(IFH_TNOISEI_E+2*I+1)) - END DO - CALL WNCTXT(OUT,' ') -C - RETURN -C -C ERROR FINISH -C - 900 CONTINUE - CALL WNCTXT(F_TP,'Error reading IF data') - NSCGIF=.FALSE. -C - RETURN -C -C - END diff --git a/src/nscan/nschas.for b/src/nscan/nschas.for deleted file mode 100644 index f81ecc86daaec75040e7691b4328f91d4b8ef0e2..0000000000000000000000000000000000000000 --- a/src/nscan/nschas.for +++ /dev/null @@ -1,108 +0,0 @@ -C+ NSCHAS.FOR -C WNB 930825 -C -C Revisions: -C JPH 940902 Remove NSCHA1 (incorrect and not used) -C CMV 950206 Change action for * (use default, not +/- 180) -C -C - LOGICAL FUNCTION NSCHAS(TYP,HA) -C -C Select HA range to use/to do -C -C NOTE (JPH 940902) -C If user specified a range with end < start, end is set to start. Since -C this is likely to be some kind of error, would it not be better to treat it -C as such? (But some users may now be relying on this as a "feature".) -C -C -C Result: -C NSCHAS_L = NSCHAS ( TYP_J:I, HA_E(0:1):IO) -C Get HA range (in circles) -C 0 = use HA to prompt -C 1 = use * to prompt -C -C Pin references: -C -C HA_RANGE -C -C Include files: -C - INCLUDE 'WNG_DEF' - INCLUDE 'CBITS_DEF' - INCLUDE 'STH_O_DEF' !SET HEADER -C -C Parameters: -C -C -C Arguments: -C - INTEGER TYP !SELECTION TYPE - REAL HA(0:1) !HA RANGE -C -C Function references: -C - REAL WNGENF !NORM. ANGLE - LOGICAL WNDPAR !GET USER DATA -C -C Data declarations: -C - REAL LHA(0:1) !LOCAL HA -C- -C - -C -C NSCHAS -C - NSCHAS=.TRUE. !ASSUME OK - IF (TYP.EQ.0) THEN !USE HA TO PROMPT - LHA(0)=WNGENF(HA(0))*360. - LHA(1)=WNGENF(HA(1))*360. - LHA(1)=MAX(LHA(1),LHA(0)) !CORRECT RANGE - ELSE - LHA(0)=-179.99 - LHA(1)=+179.99 - END IF -C -C GET USER DATA -C - 11 CONTINUE - A_J(0)=1 ! inhibit reset of dynamic - ! prompt texts - IF (LHA(0).LT.-179.9 .OR. LHA(1).GT.179.9) THEN - JS=WNDPAR('HA_RANGE',HA,2*LB_E,J0,'*') - ELSE - JS=WNDPAR('HA_RANGE',HA,2*LB_E,J0,A_B(-A_OB),LHA,2) - END IF - IF (.NOT.JS) THEN - IF (E_C.EQ.DWC_ENDOFLOOP) THEN - NSCHAS=.FALSE. !SHOW END - GOTO 20 !READY - END IF - GOTO 11 !REPEAT - ELSE IF (J0.EQ.0) THEN - NSCHAS=.FALSE. !SHOW END - GOTO 20 !READY - ELSE IF (J0.LT.0) THEN !ASSUME DEFAULT - IF (LHA(0).LT.-179.9 .OR. LHA(1).GT.179.9) THEN - HA(0)=-179.99 - HA(1)=+179.99 - ELSE - HA(0)=LHA(0) - HA(1)=LHA(1) - END IF - END IF -C -C ANALYSE -C - HA(0)=WNGENF(HA(0)/360.) !LIMIT RANGE - HA(1)=WNGENF(HA(1)/360.) !LIMIT RANGE - HA(1)=MAX(HA(0),HA(1)) -C - 20 CONTINUE - CALL WNDPOHC -C - RETURN -C -C - END diff --git a/src/nscan/nscifs.for b/src/nscan/nscifs.for deleted file mode 100644 index c2f17e32354905914b6a7e0d832434a1f96e1ee0..0000000000000000000000000000000000000000 --- a/src/nscan/nscifs.for +++ /dev/null @@ -1,271 +0,0 @@ -C+ NSCIFS.FOR -C WNB 900417 -C -C Revisions: -C GvD 920429 Declare WNDPAR as logical iso. integer -C HjV 920520 HP does not allow extended source lines -C WNB 920827 Add option 4 -C WNB 921104 Add T,U for AT -C WNB 930824 Add IF1, make function, add 200 code -C CMV 940822 Make -* switch off auto-correlations as well -C JPH 940902 Format as WNCXPL does -C JPH 940909 Call WNDPOHC -C JPH 960307 Comment on use of IFRS -C HjV 970403 Logging of selected IFRs also in logfile -C -C - LOGICAL FUNCTION NSCIFS(TYP,IFRS) -C -C Select/de-select interferometers -C -C Result: -C NSCIFS_L = NSCIFS ( TYP_J:I, IFRS_B(0:*,0:*):IO) -C Include (.true.) or exclude (.false.) -C interferometers in IFRS. TYP can be: -C 0 use as given (show first) -C 1 pre-select all -C 2 pre-select all cross correlations -C 3 pre-select fixed-movable only -C 4 pre-select none -C TYP can be TYP+100 to suppress asking. -C TYP can be TYP+200 to suppress asking and -C initial message -C Assume WSRT telescopes. .FALSE. if -C input error or # given (check E_C) -C NSCIF1_L = NSCIF1 ( TYP_J:I, IFRS_B(0:*,0:*):IO, STHJ_J(0:*):I) -C As IFS, but check for instrument used -C -C NOTE: -C This routine sets both the upper and lower triangle of the IFRS even -C though only one of the two would suffice. Routines using IFRS may read it -C either way. Any code outside this routine that modifies IFRS must modify both -C triangles! -C -C -C Pin references: -C -C SELECT_IFRS -C -C Include files: -C - INCLUDE 'WNG_DEF' - INCLUDE 'STH_O_DEF' !SET HEADER -C -C Entry points: -C - LOGICAL NSCIF1 -C -C Parameters: -C - INTEGER MAXDEF !MAXIMUM ENTRIES PIN ENTRY - PARAMETER (MAXDEF=40) -C -C Arguments: -C - INTEGER TYP !SELECTION TYPE - BYTE IFRS(0:STHTEL-1,0:STHTEL-1) !SELECTION IFR TABLE - INTEGER STHJ(0:*) !SET HEADER -C -C Function references: -C - LOGICAL WNDPAR !GET USER DATA -C -C Data declarations: -C - CHARACTER*(STHTEL+8) TEL !TELESCOPE NAMES - DATA TEL/'0123456789ABCD*FMYZPTU'/ - INTEGER IS(STHTEL+8) !START VALUES - DATA IS/0,1,2,3,4,5,6,7,8,9,10,11,12,13, - 1 00,0,10,10,12,1,08,0/ - INTEGER IE(STHTEL+8) !END VALUES - DATA IE/0,1,2,3,4,5,6,7,8,9,10,11,12,13, - 1 13,9,13,11,13,0,13,7/ -C 0 1 2 3 4 5 6 7 8 9 A B C D -C * F M Y Z P T U - LOGICAL LP !PRINT INDICATOR - LOGICAL ADD !INCLUDE/EXCLUDE - INTEGER INSTR !INSTRUMENT (0=WSRT, 1=ATCA) - CHARACTER*4 RD(MAXDEF) !INPUT - CHARACTER*(STHTEL) IFTXT !LIST -C- -C -C NSCIFS -C - INSTR=0 !ASSUME WSRT - GOTO 100 -C -C NSCIF1 -C - ENTRY NSCIF1(TYP,IFRS,STHJ) -C - INSTR=STHJ(STH_INST_J) !GET INSTRUMENT - GOTO 100 -C -C INIT -C - 100 CONTINUE - A_J(0)=1 ! inhibit reset of dynamic - ! prompts texts - NSCIFS=.TRUE. !ASSUME OK - LP=.FALSE. !ASSUME NO PRINT - IF (MOD(TYP,100).EQ.1) THEN !PRE-SELECT ALL - IF (TYP.LT.200) - 1 CALL WNCTXT(F_TP, - 1 '!4C\All auto/cross interferometers pre-selected') - DO I1=0,STHTEL-1 - DO I2=0,STHTEL-1 - IF (INSTR.EQ.1 .AND. (I1.LT.8 .OR. I2.LT.8)) THEN - IFRS(I1,I2)=.FALSE. - ELSE - IFRS(I1,I2)=.TRUE. - END IF - END DO - END DO - ELSE IF (MOD(TYP,100).EQ.2) THEN !ALL CROSS - IF (TYP.LT.200) - 1 CALL WNCTXT(F_TP, - 1 '!4C\All cross interferometers pre-selected') - DO I1=0,STHTEL-1 - DO I2=0,STHTEL-1 - IF (I1.EQ.I2 .OR. - 1 (INSTR.EQ.1 .AND. (I1.LT.8 .OR. I2.LT.8))) THEN - IFRS(I1,I2)=.FALSE. - ELSE - IFRS(I1,I2)=.TRUE. - END IF - END DO - END DO - ELSE IF (MOD(TYP,100).EQ.3) THEN !FIXED-MOVABLE - IF (INSTR.EQ.1 .AND. TYP.LT.200) THEN - CALL WNCTXT(F_TP, - 1 '!4C\All cross interferometers pre-selected') - ELSE IF (TYP.LT.200) THEN - CALL WNCTXT(F_TP, - 1 '!4C\All fixed/movable interferometers pre-selected') - END IF - DO I1=0,STHTEL-1 - DO I2=0,STHTEL-1 - IF ((I1.LE.9 .AND. I2.GE.10) .OR. - 1 (I1.GE.10 .AND. I2.LE.9) .OR. - 1 (INSTR.EQ.1 .AND. I1.GE.8 .AND. I2.GE.8)) THEN - IFRS(I1,I2)=.TRUE. - ELSE - IFRS(I1,I2)=.FALSE. - END IF - END DO - END DO - ELSE IF (MOD(TYP,100).EQ.4) THEN !NONE - IF (TYP.LT.200) - 1 CALL WNCTXT(F_TP, - 1 '!4C\No interferometers pre-selected') - DO I1=0,STHTEL-1 - DO I2=0,STHTEL-1 - IFRS(I1,I2)=.FALSE. - END DO - END DO - ELSE !START WITH GIVEN - LP=.TRUE. !PRINT FIRST - END IF -C -C GET USER DATA -C - 10 CONTINUE - IF (LP) THEN !PRINT IFRS - CALL WNCTXT(F_TP,'!/!4C !AS',TEL(1:STHTEL)) !HEADING - DO I1=1,STHTEL !ALL LINES - IFTXT=' ' - DO I2=I1,STHTEL - IF (IFRS(I1-1,I2-1)) THEN !SELECT - IFTXT(I2:I2)='+' - ELSE !DESELECT - IFTXT(I2:I2)='.' - END IF - END DO - CALL WNCTXT(F_TP,'!4C!AS !#$AS',TEL(I1:I1),STHTEL,IFTXT) - END DO - END IF -C - 11 CONTINUE - IF (TYP.GE.100) GOTO 20 !READY - IF (.NOT.WNDPAR('SELECT_IFRS',RD,MAXDEF*4,J0,'""')) THEN !GET INFO - IF (E_C.EQ.DWC_ENDOFLOOP) THEN - NSCIFS=.FALSE. !SHOW END - GOTO 20 !READY - END IF - GOTO 11 !REPEAT - ELSE IF (J0.EQ.0) THEN - GOTO 20 !READY - ELSE IF (J0.LT.0) THEN !ASSUME +* - IF (INSTR.EQ.1) THEN !ATCA - RD(1)='+T' - ELSE - RD(1)='+*' - END IF - J0=1 - END IF -C - DO I=1,J0 - ADD=.TRUE. !ASSUME INCLUDE - I1=1 !CHARACTER PTR - 31 CONTINUE - IF (I1.GT.4) GOTO 30 !EMPTY - IF (RD(I)(I1:I1).EQ.' ') THEN - I1=I1+1 !SKIP SPACE - GOTO 31 - ELSE IF (RD(I)(I1:I1).EQ.'+') THEN - I1=I1+1 !SKIP + - GOTO 31 - ELSE IF (RD(I)(I1:I1).EQ.'-') THEN - I1=I1+1 - ADD=.NOT.ADD !EXCLUDE - GOTO 31 - ELSE - I2=INDEX(TEL,RD(I)(I1:I1)) !GET TELESCOPE - IF (I2.EQ.0) GOTO 30 !UNKNOWN - I1=I1+1 - IF (I1.GT.4) GOTO 30 - IF (RD(I)(I1:I1).EQ.'#') THEN !AUTO CORRELATIONS - DO I4=IS(I2),IE(I2) - IFRS(I4,I4)=ADD - END DO - ELSE - IF (RD(I)(I1:I1).EQ.' ') THEN - IF (INSTR.EQ.1 .AND. ADD) THEN !ATCA + - I3=STHTEL+7 !ASSUME T - ELSE - I3=STHTEL+1 !ASSUME * - END IF - ELSE - I3=INDEX(TEL,RD(I)(I1:I1)) - IF (I3.EQ.0) GOTO 30 !UNKNOWN - END IF - DO I4=IS(I2),IE(I2) !DO FOR SPECIFIED TEL. - DO I5=IS(I3),IE(I3) - IF (I4.NE.I5) THEN !ONLY CROSS - IFRS(I4,I5)=ADD !ALL TELESCOPES - IFRS(I5,I4)=ADD - END IF - END DO - END DO -C - IF (.NOT.ADD.AND. - 1 I2.EQ.STHTEL+1.AND.I3.EQ.STHTEL+1) THEN ! -* also AutoCor. - DO I4=IS(I2),IE(I2) - IFRS(I4,I4)=ADD - END DO - END IF -C - END IF - END IF - 30 CONTINUE - END DO - LP=.TRUE. - GOTO 10 !MORE -C - 20 CONTINUE - CALL WNDPOHC -C - RETURN -C -C - END diff --git a/src/nscan/nscini.for b/src/nscan/nscini.for deleted file mode 100644 index 0fe9acf9a57b420e66f166c8669f86fbbe0c8b0f..0000000000000000000000000000000000000000 --- a/src/nscan/nscini.for +++ /dev/null @@ -1,53 +0,0 @@ -c+ NSCINI.FOR -C WNB 900130 -C -C Revisions: -C - SUBROUTINE NSCINI -C -C Initialize NSCAN program -C -C Result: -C -C CALL NSCINI will set header lines, logging, DWARF interface -C -C Include files: -C - INCLUDE 'WNG_DEF' - INCLUDE 'NSC_DEF' -C -C Parameters: -C -C -C Arguments: -C -C -C Function references: -C - LOGICAL WNDINI !INIT DWARF - LOGICAL WNDDAB !OPEN DATABASE -C -C Data declarations: -C -C- -C -C SET HEADER LINES -C - CALL WNCFHD(F_P,1,'!40C\Program to handle SCN files') -C -C START DWARF -C - IF (.NOT.WNDINI(PRGNAM)) CALL WNGEX !EXIT IF NO DWARF START -C -C LOGGING -C - CALL WNDLOG(LOGCD) !PROPER LOGGING -C -C DATABASE -C - IF (.NOT.WNDDAB()) CALL WNGEX !OPEN DATABASE -C - RETURN !READY -C -C - END diff --git a/src/nscan/nsclif.for b/src/nscan/nsclif.for deleted file mode 100644 index 440144ec1d4da07a4555312bce1ca3cfccfc5bc8..0000000000000000000000000000000000000000 --- a/src/nscan/nsclif.for +++ /dev/null @@ -1,285 +0,0 @@ -C+ NSCLIF.FOR -C CMV 940425 -C -C Revisions: -C CMV 940425 Created -C CMV 940513 Correct size of IF-block -C HjV 940524 Change some argument calls -C CMV 940930 Pass data higher up through TPBUF -C HjV 950508 Correct check TP-data (did overwrite array) -C -C - LOGICAL FUNCTION NSCLIF(INFCA,SHP,IFHJ,IFHE,STHJ, - 1 VS,FVERS,BECODE,SFREQ,BINT, - 1 TPBUF,DBUF,OBUF) -C -C Read WSRT IF-sets from tape into SCN file. A pointer to the IF header -C is returned in STHJ. We do NOT split mosaic data here. -C -C Result: -C -C NSCLIF_L = NSCLIF( INFCA_J:I, SHP_J:I, -C IFHJ_J(0:*):IO, IFHE_E(0:*):IO, STHJ_J(0:*):O, -C VS_J:I,FVERS_J:I, BECODE_C(4):I, SFREQ_J:I, BINT_J:I, -C TPBUF_I(2,0:1,0:STHTEL-1,0:*):O, -C DBUF_I(2,0:*):I, OBUF(2,0:1,0:STHTEL-1,0:*)) -C INFCA indicates the file to read, SHP the -C record number of the SH block. IFHJ and IFHE -C are pointers to the IF-header. STHJ is a -C pointer to the (template) set header. -C VS the software version (e.g.42). -C FVERS the tape version. -C BECODE the Back-End code (e.g. DLB). -C SFREQ is spacing frequency points. -C BINT is the basic integration time (10 s). -C TPBUF contains total power data -C DBUF and OBUF are input and output buffers -C Data is written to disk if IFSETS>0 -C otherwise it is only returned in TPBUF -C -C Include files: -C - INCLUDE 'WNG_DEF' - INCLUDE 'NSC_DEF' - INCLUDE 'SHW_O_DEF' !SH BLOCK - INCLUDE 'SHW_T_DEF' - INCLUDE 'IHW_O_DEF' !IH BLOCK - INCLUDE 'IHW_T_DEF' - INCLUDE 'STH_O_DEF' !SET HEADER - INCLUDE 'IFH_O_DEF' !IF-SET HEADER -C -C Parameters: -C -C -C Arguments: -C - INTEGER INFCA !INPUT FILE DESCRIPTOR - INTEGER SHP !RECORD # SH BLOCK - INTEGER IFHJ(0:*) !IF-Header - REAL IFHE(0:*) !IF-Header - INTEGER STHJ(0:*) !SET HEADER - INTEGER VS !TAPE SOFTWARE VERSION - INTEGER FVERS !TAPE FORMAT VERSION - CHARACTER*4 BECODE !BACKEND CODE - INTEGER SFREQ !SFREQ FROM OH - INTEGER BINT !BASIC INTEGRATION IN SEC -C - INTEGER*2 TPBUF(2,0:1,0:STHTEL-1,0:MXDATN-1) !BUFFER FOR IF-DATA - ! Noise on/off,X/Y,Tel,Scn - INTEGER*2 DBUF(2,0:MXDATN-1) !INPUT BUFFER - INTEGER*2 OBUF(2,0:1,0:STHTEL-1,0:MXDATN-1) !OUTPUT BUFFER -C -C Function references: -C - LOGICAL WNFRD !READ DATA - LOGICAL WNFWR !WRITE DATA - INTEGER WNFEOF !FILE POSITION -C -C Data declarations: -C - BYTE SHW(0:SHWHDL-1) !SH RECORD - INTEGER*2 SHWI(0:SHWHDL/2-1) - INTEGER SHWJ(0:SHWHDL/4-1) - REAL SHWE(0:SHWHDL/4-1) - EQUIVALENCE (SHW,SHWI,SHWJ,SHWE) - BYTE IHW(0:IHWHDL-1) !IH RECORD - INTEGER*2 IHWI(0:IHWHDL/2-1) - INTEGER IHWJ(0:IHWHDL/4-1) - REAL IHWE(0:IHWHDL/4-1) - EQUIVALENCE (IHW,IHWI,IHWJ,IHWE) - REAL SUMP,SUMR !INTEGRATE - INTEGER N !# OF INTEGRATED POINTS - INTEGER IPTS !Number of basic int.times per input point - INTEGER OPTS !Number of basic int.times per output point - INTEGER NPTS !Number of output points - REAL HAB !START HA - INTEGER*2 DBH_T(2,2) !TRANSLATE DATA - DATA DBH_T/2,0,0,1/ -C- -C -C INIT -C - NSCLIF=.TRUE. !ASSUME OK - DBH_T(2,1)=2*MXDATN !ENOUGH TRANSLATION - IFHJ(IFH_TPINT_J)=0 !SET UNKNOWN - IFHJ(IFH_NTP_J)=0 !SET UNKNOWN - IFHJ(IFH_NIF_J)=0 !DO NOT LOAD FOR NOW - CALL WNGMVZ(MXDATN*STHTEL*4*LB_I,OBUF) !CLEAR OUTPUT BUFFERS - CALL WNGMVZ(MXDATN*STHTEL*4*LB_I,TPBUF) -C -C READ SH -C - IF (.NOT.WNFRD(INFCA,SHWHDL,SHW,SHP*SRTRCL)) THEN !READ SH BLOCK - CALL WNCTXT(F_TP,'!/Read error SH block #!UJ (!XJ)', - 1 SHP,E_C) - GOTO 900 !FINISH - END IF - IF (IBMSW) CALL WNTTIL(SHWHDL,SHW,SHW_T) !TRANSLATE - IF (DECSW) CALL WNTTDL(SHWHDL,SHW,SHW_T) - IF (SHWI(SHW_CBI_I).NE.32767 .OR. - 1 SHW(SHW_CBT_1).NE.ICHAR('S') .OR. - 1 SHW(SHW_CBT_1+1).NE.ICHAR('H')) THEN - CALL WNCTXT(F_TP,'!/Cannot find SH block #!UJ',SHP) - GOTO 900 - END IF -C -C REPAIR SH (skip BFREQ and BANDNR correction, we do not use them here) -C - IF (FVERS.LT.3) SHWI(SHW_STIM_I)=SHWI(SHW_STIM_I)*6 - IF (FVERS.LT.6) SHWI(SHW_BANDNR_I)=SHWI(SHW_BANDNR_I)/4 -C -C We do not write the SH since the Polarisation sets also have one. -C -C READ IFRS -C - DO I=0,SHWI(SHW_NENT_I)-1 !ALL INTERFEROMETERS - I1=SHW_IFR_1+I*SHWI(SHW_LENT_I) !TABLE ENTRY - I2=I1/LB_I !AS I2 - I4=I1/LB_J !AS I4 - J=SHWJ(I4+IFR_NIH_J)*SRTRCL !DISK POINTER IH - IF (.NOT.WNFRD(INFCA,IHWHDL,IHW,J)) THEN !READ IH BLOCK - CALL WNCTXT(F_TP,'!/Read error IH block #!UJ (!XJ)', - 1 J/SRTRCL,E_C) - GOTO 10 !NEXT - END IF - IF (IBMSW) CALL WNTTIL(IHWHDL,IHW,IHW_T) !TRANSLATE - IF (DECSW) CALL WNTTDL(IHWHDL,IHW,IHW_T) - IF (IHWI(IHW_CBI_I).NE.32767 .OR. - 1 IHW(IHW_CBT_1).NE.ICHAR('I') .OR. - 1 IHW(IHW_CBT_1+1).NE.ICHAR('H')) THEN - CALL WNCTXT(F_TP,'!/Cannot find IH block #!UJ',J/SRTRCL) - GOTO 10 - END IF -C -C REPAIR IH -C - IF (FVERS.LT.3) IHWI(IHW_STIM_I)=IHWI(IHW_STIM_I)*6 - IF (VS.LT.53) THEN - IHWE(IHW_INTT_E)=IHWI(IHW_INCT_I) - END IF - IF (VS.LT.60) THEN - IHWI(IHW_DWELT_I)=IHWI(IHW_INCT_I) - IHWI(IHW_DRADT_I)=IHWI(IHW_INCT_I) - END IF - IF (FVERS.LT.2) THEN !UPDATE IFR CODE - I1=NINT(MOD(IHWI(IHW_INFNR_I),40)/2.) !FIXED - I2=NINT(IHWI(IHW_INFNR_I)/40.)+9+MOD(IHWI(IHW_INFNR_I),2) !MOVABLE - IHWI(IHW_INFNR_I)=256*I1+I2 - END IF -C -C Something undocumented: INFNR has bit 0x4000 on... -C - IHWI(IHW_INFNR_I)=MOD(IHWI(IHW_INFNR_I),16384) !Clear "sign-bit" -C -C We only read Total Power data (WTEL=28, OTEL=0..27) for the while. -C - I5=MOD(IHWI(IHW_INFNR_I),256) !GET IF NUMBER - IF (IHWI(IHW_INFNR_I)/256.NE.28 .OR. - 1 I5.LT.0.OR.I5.GT.(2*STHTEL-1)) GOTO 10 !SKIP IF NOT TP DATA -C -C Check integeration time -C - IPTS=IHWI(IHW_INCT_I)/BINT !BINT's per input point - IF (IFSETS.GT.0) THEN - OPTS=IFSETS/BINT !BINT's per output point - NPTS=IHWI(IHW_NDATP_I)*IPTS/OPTS !Number of output points - ELSE - OPTS=IPTS - NPTS=IHWI(IHW_NDATP_I) - END IF - HAB=IHWE(IHW_HAB_E)+ - 1 CVUTST*(OPTS-IPTS)/2.*BINT/24./3600. !START HA -C - IF (IFHJ(IFH_TPINT_J).EQ.0) THEN !NOT YET KNOWN - IFHJ(IFH_TPINT_J)=IHWI(IHW_INCT_I) !SAVE INCREMENT TIME - IFHE(IFH_HAB_E)=HAB !SAVE START HOUR ANGLE - IFHE(IFH_IFHAB_E)=IHWE(IHW_HAB_E) !IDEM, ORIGINAL - IFHE(IFH_HAI_E)=OPTS*BINT*CVUTST/3600./24. !INCREMENT - IFHJ(IFH_NTP_J)=NPTS !SAVE # OF OUTPUT POINTS - ELSE IF (ABS(HAB-IFHE(IFH_HAB_E)).GE. - 1 0.1E0/24./3600.) THEN !NOT SAME HA - CALL WNCTXT(F_TP, - 1 'Inconsistent IF set, ifrs have different hour angles') - GOTO 10 - END IF -C -C Read data -C - I1=MOD(IHWI(IHW_INFNR_I),2) !X or Y - I2=MOD(IHWI(IHW_INFNR_I),256)/2 !Telescope - I3=IHWI(IHW_NDATP_I)*4 - IF (.NOT.WNFRD(INFCA,I3,DBUF, - 1 J+SRTRCL*IHWJ(IHW_LIH_J))) THEN !READ DB BLOCK - CALL WNCTXT(F_TP,'!/Read error DB block #!UJ (!XJ)', - 1 J/SRTRCL,E_C) - GOTO 10 !NEXT - END IF - IF (IBMSW) CALL WNTTIL(I3,DBUF,DBH_T) !TRANSLATE - IF (DECSW) CALL WNTTDL(I3,DBUF,DBH_T) -C -C Copy into output buffer -C - DO I3=0,IHWI(IHW_NDATP_I) - TPBUF(1,I1,I2,I3)=DBUF(1,I3) - TPBUF(2,I1,I2,I3)=DBUF(2,I3) - END DO -C -C Average into write array ODAT(On/Off,Dipole,Tel,Ha) -C - IF (IFSETS.GT.0) THEN - J1=0 !Input pointer - DO I3=0,NPTS-1 !All output points - SUMP=0 !INTEGRATE - SUMR=0 - N=0 - DO I4=0,OPTS-1 !# OF 10 SEC OUTPUT INTEGRAT. - J3=J1/IPTS !DATA POINT - IF (DBUF(1,J3).NE.IUND .AND. DBUF(2,J3).NE.IUND) THEN - SUMP=SUMP+DBUF(1,J3) !ADD - SUMR=SUMR+DBUF(2,J3) - N=N+1 - END IF - J1=J1+1 !NEXT 10 SEC - END DO - IF (N.EQ.OPTS) THEN !OK POINT - OBUF(1,I1,I2,I3)=NINT(SUMP/N) !OUTPUT DATA - OBUF(2,I1,I2,I3)=NINT(SUMR/N) - END IF - END DO - END IF -C -C Next telescope -C - 10 CONTINUE - END DO -C -C Write IFH and data to the scan-file, return pointer in STHJ -C - IF (IFSETS.GT.0) THEN - J=WNFEOF(FCAOUT) !WRITE AT END OF FILE - I1=4*STHTEL*IFHJ(IFH_NTP_J)*LB_I !LENGTH OF DATA - IF (.NOT.WNFWR(FCAOUT,IFHHDL,IFHJ,J)) THEN !WRITE HEADER - CALL WNCTXT(F_TP,'Error writing IFH to scan file') - GOTO 900 - END IF - IF (.NOT.WNFWR(FCAOUT,I1,OBUF,J+IFHHDL)) THEN !WRITE DATA - CALL WNCTXT(F_TP,'Error writing IF data to scan file') - GOTO 900 - END IF -C - STHJ(STH_IFHP_J)=J !SAVE POINTER - STHJ(STH_IFHL_J)=IFHHDL+I1 !SAVE LENGTH -C - END IF -C - RETURN !READY -C -C ERROR FINISH -C - 900 CONTINUE - NSCLIF=.FALSE. -C - RETURN -C -C - END diff --git a/src/nscan/nsclli.for b/src/nscan/nsclli.for deleted file mode 100644 index 51cc24a09f1a9a90fc5d3b3cde16d00a58138e08..0000000000000000000000000000000000000000 --- a/src/nscan/nsclli.for +++ /dev/null @@ -1,388 +0,0 @@ -C+ NSCLLI.FOR -C CMV 941012 -C -C Revisions: -C CMV 941012 Split off from NSCLOD -C CMV 941111 Also update MEDIAD -C CMV 950123 Option to scan the tape on parity errors -C CMV 950202 Pass calculated size to MEDIAD for ARCHIVE option -C CMV 950412 Add PUT= command to change status to RCV -C CMV 950509 Also pass OH-nr, pass position separately -C HjV 960111 Change CONTLINE in OBSMODE -C CMV 960311 Account for multiple IF sets -C HjV 961107 Use original Online Version nr. iso. modified -C If SFREQ negative, make it zero -C Change MOSTYP in UNDEFINED iso. UNKNOWN -C -C - SUBROUTINE NSCLLI(TYP,VOLUME,LABEL,OH_NO,FVERS,ORG_OLSYS, - 1 FDW,FDWI,FDWJ, - 1 STH,STHI,STHJ,STHE,STHD, - 1 OHW,OHWI,OHWJ,OHWE,OHWD, - 1 SCW,SCWI,SCWJ,SCWE,SCWD) -C -C List header and optionally update the archive -C -C Result: -C -C CALL NSCLOD(TYP_J:I, VOLUME_C(80):I,LABEL_J:I, ...) -C List WSRT data from headers if TYP is 1, -C or list and update Scissor if TYP is 2. -C VOLUME is the name of the volume or blank -C LABEL is the label on the input tape -C FVERS is the tape-format version -C ORG_OLSYS is original Online Version nr. -C -C Include files: -C - INCLUDE 'WNG_DEF' - INCLUDE 'NSC_DEF' !FOR OPTION AND SRTRCL - INCLUDE 'STH_O_DEF' !SET HEADER - INCLUDE 'FDW_O_DEF' !FD BLOCK - INCLUDE 'OHW_O_DEF' !OH BLOCK - INCLUDE 'SCW_O_DEF' !SC BLOCK -C -C Needed for DWELT,DRADT -C - INCLUDE 'SHW_O_DEF' !SH BLOCK - INCLUDE 'SHW_T_DEF' - INCLUDE 'IHW_O_DEF' !IH BLOCK - INCLUDE 'IHW_T_DEF' -C -C Arguments: -C - INTEGER TYP ! 1:LIST 2:LIST AND ARCHIVE - CHARACTER VOLUME*(*) !VOLUME LABEL IF ANY - INTEGER LABEL !LABEL NUMBER - INTEGER OH_NO !OH-Number - INTEGER FVERS !VERSION OF TAPE-FORMAT - INTEGER ORG_OLSYS !Original Online Version nr. -C - BYTE STH(0:STHHDL-1) !SET HEADER - INTEGER*2 STHI(0:STHHDL/2-1) - INTEGER STHJ(0:STHHDL/4-1) - REAL STHE(0:STHHDL/4-1) - REAL*8 STHD(0:STHHDL/8-1) - BYTE FDW(0:FDWHDL-1) !FD - INTEGER*2 FDWI(0:FDWHDL/2-1) - INTEGER FDWJ(0:FDWHDL/4-1) - BYTE OHW(0:OHWHDL-1) !OH - INTEGER*2 OHWI(0:OHWHDL/2-1) - INTEGER OHWJ(0:OHWHDL/4-1) - REAL OHWE(0:OHWHDL/4-1) - REAL*8 OHWD(0:OHWHDL/8-1) - BYTE SCW(0:SCWHDL-1) !SC - INTEGER*2 SCWI(0:SCWHDL/2-1) - INTEGER SCWJ(0:SCWHDL/4-1) - REAL*4 SCWE(0:SCWHDL/4-1) - REAL*8 SCWD(0:SCWHDL/8-1) -C -C Function references: -C - LOGICAL WNFRD !READ FROM FCA - LOGICAL WNFOPF !OPEN LABEL - INTEGER WNCALN !LENGTH OF STRING - INTEGER WNFSCI !CALL DATABASE -C -C Data declarations: -C - INTEGER DURATION !DURATION OF OBS. IN SEC. - INTEGER WSETS(0:1) !FIRST, LAST SET - INTEGER UTD,UTM !UT START-TIME DAY,MONTH - INTEGER OBSTIME !START-TIME OF OBS. - INTEGER EPO !EPOCHE OF OBS. - INTEGER DWELT,DRADT !TIMING OF MOSAIC - INTEGER SFREQ !DELTA FREQ. - DOUBLE PRECISION RA1,DEC1 !RA AND DEC OF OBS. - REAL POS9 !POSITION TEL. 9 - CHARACTER*4 BECODE !BACKEND NAME - CHARACTER*2 DIPC !DIPOLE SETTING - CHARACTER*32 POLC !POLARISATIONS - CHARACTER*10 OBSMODE !OBSERVATION MODE - CHARACTER*32 ARUSE !ARRAY USE - CHARACTER*10 MOSTYP !MOSAIC TYPE - CHARACTER*1024 WARC !BUFFER FOR ARCHIVE - BYTE RWBUF(SRTRCL) !I/O BUFFER FOR CHECK - INTEGER IPROJ !PROJECT NUMBER -C - INTEGER DAYS(12) !DAYS PER MONTH - DATA DAYS/31,28,31,30,31,30,31,31,30,31,30,31/ -C - BYTE SHW(0:SHWHDL-1) !SH RECORD - INTEGER*2 SHWI(0:SHWHDL/2-1) - INTEGER SHWJ(0:SHWHDL/4-1) - REAL SHWE(0:SHWHDL/4-1) - EQUIVALENCE (SHW,SHWI,SHWJ,SHWE) - BYTE IHW(0:IHWHDL-1) !IH RECORD - INTEGER*2 IHWI(0:IHWHDL/2-1) - INTEGER IHWJ(0:IHWHDL/4-1) - REAL IHWE(0:IHWHDL/4-1) - EQUIVALENCE (IHW,IHWI,IHWJ,IHWE) -C - DURATION=(OHWD(OHW_HAEND_D)-OHWD(OHW_HAST_D))*DCRTSC -C - IPROJ=OHWI(OHW_PROJECT_I) - IF (OHWI(OHW_ALLOC_I).EQ.971) THEN - IPROJ=IPROJ+3000 ! 97A - ELSE IF (OHWI(OHW_ALLOC_I).EQ.972) THEN - IPROJ=IPROJ+4000 ! 97B - ELSE IF (OHWI(OHW_ALLOC_I).EQ.981) THEN - IPROJ=IPROJ+5000 ! 98A - ELSE IF (OHWI(OHW_ALLOC_I).EQ.982) THEN - IPROJ=IPROJ+6000 ! 98B - ELSE IF (OHWI(OHW_ALLOC_I).EQ.991) THEN - IPROJ=IPROJ+7000 ! 99A - ELSE IF (OHWI(OHW_ALLOC_I).EQ.992) THEN - IPROJ=IPROJ+8000 ! 99B - ENDIF -C - CALL WNCTXT(F_TP, - 1 '!4$UJ: !7$UJ !-12$AD !6$UI '// - 1 '!2$ZJ!2$ZJ !2$AF !2$AF '// - 1 '!2$ZI!2$ZI!2$ZI !2$ZI!2$ZI '// - 1 '!10$DPF15.5 !10$DAF15.5', - 1 LABEL, - 1 OHWJ(OHW_VOLGNR_J), - 1 OHW(OHW_FIELD_1),OHW_FIELD_N, - 1 IPROJ, - 1 (DURATION/3600),MOD(DURATION/60,60), - 1 OHW(OHW_TYPE_1),OHW_TYPE_N, - 1 OHW(OHW_SPEFU_1),OHW_SPEFU_N, - 1 OHWI(OHW_DATE_I+1),OHWI(OHW_DATE_I+2), - 1 OHWI(OHW_DATE_I+3), - 1 OHWI(OHW_DATE_I+4),OHWI(OHW_DATE_I+5), - 1 OHWD(OHW_RA1_D),OHWD(OHW_DEC1_D)) -C -C TYP will be 2 if the WARC option had been choosen. -C There are two suboptions now: CHECK or ARCHIVE. -C -C With CHECK we scan the whole observation on tape to catch parity -C errors, with ARCHIVE the Observation and Mediad views in Scissor -C are informed of the label through WNFSCI. -C - IF (TYP.EQ.2.AND.OPTION(4:4).EQ.'C') THEN !Read all blocks - J=FDWJ(FDW_NBL_J)*FDWI(FDW_PHBLL_I) !Number of blocks - J1=FDWI(FDW_LRCRD_I) !Blocksize - IF (J1.NE.SRTRCL) THEN - CALL WNCTXT(F_TP,'Invalid blocksize for label !UJ',LABEL) - END IF -C -C For tapes, reopen (some units are slow in rewinding) -C - IF (UNIT.EQ.'D') THEN !No check for Disks - ELSE IF (.NOT.WNFOPF(IMCA,' ','R',0,0,0,LABEL)) THEN - CALL WNCTXT(F_TP,'Cannot re-open label !UJ',LABEL) - ELSE - I1=0 !No bad records yet - DO J2=0,J-1 - IF (.NOT.WNFRD(IMCA,SRTRCL,RWBUF,J2*J1)) THEN !Error - I1=I1+1 - IF (I1.LT.3) THEN - CALL WNCTXT(F_TP, - 1 'Cannot read record !UJ for label !UJ',J2,LABEL) - END IF - END IF - END DO - IF (I1.GE.3) THEN - CALL WNCTXT(F_TP, - 1 'Cannot read !UJ records for label !UJ',I1,LABEL) - ELSE IF (I1.EQ.0) THEN - CALL WNCTXT(F_TP, - 1 'Total of !UJ records (!UJ bytes) checked for label !UJ', - 1 J,J*SRTRCL,LABEL) - END IF - END IF -C - ELSE IF (TYP.EQ.2.AND.OPTION(4:4).EQ.'A') THEN !Inform Scissor -C - IF (MOD(OHWI(OHW_PRFLG_I),2).EQ.1) THEN - OBSMODE='LINE' - ELSE - OBSMODE='CONTINUUM' - END IF -C - EPO=OHWI(OHW_DATE_I) - IF (EPO.LT.1900) EPO=EPO+1900 -C - RA1=OHWD(OHW_RA1_D)*360.D0 - IF (RA1.LT.0) RA1=RA1+360.D0 !BETWEEN 0..360 - DEC1=OHWD(OHW_DEC1_D)*360.D0 -C - CALL WNGMTS(OHW_BECODE_N,OHW(OHW_BECODE_1),BECODE) !BE CODE -C - IF (MOD(INT(OHWI(OHW_POLC_I)/4),2).EQ.0) THEN - DIPC(1:1)='+' - ELSE - DIPC(1:1)='X' - END IF - IF (MOD(OHWI(OHW_POLC_I),2).EQ.0) THEN - DIPC(2:2)='+' - ELSE - DIPC(2:2)='X' - END IF -C - OBSTIME=OHWI(OHW_DATE_I+4)*3600+OHWI(OHW_DATE_I+5)*60 -C - UTD=OHWI(OHW_SDAY_I) - UTM=1 - IF (MOD(OHWI(OHW_DATE_I+1),4).EQ.0) DAYS(2)=DAYS(2)+1 - DO WHILE (UTD.GT.DAYS(UTM)) - UTD=UTD-DAYS(UTM) - UTM=UTM+1 - END DO - IF (MOD(OHWI(OHW_DATE_I+1),4).EQ.0) DAYS(2)=DAYS(2)-1 -C - ARUSE='X0123456789ABCD_Y0123456789ABCD ' - DO I1=0,1 !X, Y - DO I2=0,13 !0...D - IF ((OHWI(OHW_TELWD_I+I1).AND.2**I2).EQ.0) - 1 ARUSE(I2+I1*16+2:I2+I1*16+2)='.' - END DO - END DO -C - POS9= -1.*OHWJ(OHW_POST_J+9)*2.**(-16) -C - IF (OHWI(OHW_SET_I+SET_BANDNR_I).EQ.0.AND. - 1 OHWI(OHW_SET_I+SET_BANDNR_I+ - 1 OHWI(OHW_LENT_I)/LB_I).GT.1) THEN !SELECT FIRST SET - I=1 - ELSE - I=0 - END IF - WSETS(0)=OHWI(OHW_SET_I+SET_BANDNR_I+ - 1 I*OHWI(OHW_LENT_I)/LB_I) !FIRST SET - WSETS(1)=OHWI(OHW_SET_I+SET_BANDNR_I+ - 1 (OHWI(OHW_NRSTS_I)-1)*OHWI(OHW_LENT_I)/LB_I) !LAST SET -C - J=0 !INIT POL.STRING - POLC=' ' - DO WHILE (I.LT.OHWI(OHW_NRSTS_I).AND. - 1 OHWI(OHW_SET_I+SET_BANDNR_I+ - 1 I*OHWI(OHW_LENT_I)/LB_I).EQ.WSETS(0)) - IF (J.GT.0) POLC(J:)=',' - CALL WNGMTS(2,OHW(OHW_SET_1+SET_DATYP_1+ - 1 I*OHWI(OHW_LENT_I)),POLC(J+1:)) - J=J+3 - I=I+1 - END DO - IF (POLC.EQ.'IF,IF,IF,IF,IF,IF,IF,IF,IF,XX,YY') THEN - CALL WNCTXT(F_T,'Both DXB/DCB IF-sets present') - POLC='IF9,XX,YY' - ENDIF -C - IF (OHWI(OHW_MSPAT_I).EQ.0.OR.FVERS.LT.6) THEN - MOSTYP='UNDEFINED' - DWELT=0 - DRADT=0 - ELSE - IF (FVERS.EQ.6.OR. - 1 (OHWI(OHW_OLSYS_I).GE.62.AND. - 1 OHWI(OHW_MSPAT_I).LE.0) ) THEN - MOSTYP='UNSPLITTED' - ELSE - MOSTYP='SPLITTED' - END IF -C - I1=OHWI(OHW_OLSYS_I) - I2=OHWI(OHW_SFREQ_I) - CALL NSCLR2(IMCA,OHWJ(OHW_SET_J+SET_NSH_J+ - 1 WSETS(0)*OHWI(OHW_LENT_I)/LB_J), - 1 I1,FVERS,BECODE,I2,DWELT,DRADT) -C - END IF -C -C Test if SFREQ (DELTA_FREQ) not negative. -C If so, set to zero - SFREQ=OHWI(OHW_SFREQ_I)*0.1 - IF (SFREQ.LT.0) SFREQ=0 -C - CALL WNCTXS(WARC, - 1 'CHECK=OBSERVATION '// - 1 'SEQNUMBER=!UJ PROJECT=!UI SOURCE=!AD '// - 1 'EPOCHE=!UJ ', - 1 OHWJ(OHW_VOLGNR_J),OHWI(OHW_PROJECT_I), - 1 OHW(OHW_FIELD_1),OHW_FIELD_N, - 1 EPO) -C - CALL WNCTXS(WARC(WNCALN(WARC)+1:), - 1 ' SETS_START=!UJ SETS_END=!UJ '// - 1 'TAPE_VERSION=!UJ ONLINE_VERSION=!UJ '// - 1 'OBS_DATE=!2$ZI/!2$ZI/!4$ZJ OBS_TIME=!UJ '// - 1 'UT_DATE=!2$ZJ/!2$ZJ/!4$ZJ '// - 1 'UT_START=!UJ UT_END=!UJ '// - 1 'HA_START=!D HA_END=!D ', - 1 WSETS(0),WSETS(1), - 1 FVERS,ORG_OLSYS, - 1 OHWI(OHW_DATE_I+3),OHWI(OHW_DATE_I+2), - 1 1900+OHWI(OHW_DATE_I+1),OBSTIME, - 1 UTD,UTM,1900+OHWI(OHW_DATE_I+1), - 1 10*OHWI(OHW_STIM_I),10*OHWI(OHW_ETIM_I), - 1 OHWD(OHW_HAST_D)*360.D0,OHWD(OHW_HAEND_D)*360.D0) -C - CALL WNCTXS(WARC(WNCALN(WARC)+1:), - 1 ' NR_SETS=!UI NR_POLARISATION=!UI '// - 1 'NR_INTERFEROM=!UI NR_FREQ=!UI NR_FEQ=!UI '// - 1 'NR_CORRCHAN=!UI '// - 1 'POSA_9=!E POSB_9=!E POSC_9=!E POSD_9=!E '// - 1 'ARRAY_USE=!AS ', - 1 OHWI(OHW_NRSTS_I),OHWI(OHW_NRPOL_I), - 1 OHWI(OHW_NRINT_I),OHWI(OHW_NRFRQ_I), - 1 OHWI(OHW_NFREQ_I),OHWI(OHW_NTOT_I), - 1 POS9-(-1.*OHWJ(OHW_POST_J+10)*2.**(-16)), - 1 POS9-(-1.*OHWJ(OHW_POST_J+11)*2.**(-16)), - 1 POS9-(-1.*OHWJ(OHW_POST_J+12)*2.**(-16)), - 1 POS9-(-1.*OHWJ(OHW_POST_J+13)*2.**(-16)), - 1 ARUSE) -C - CALL WNCTXS(WARC(WNCALN(WARC)+1:), - 1 ' OBSMODE.DESCRIPTION=!AS '// - 1 'OBS_TYPE.DESCRIPTION=!AD '// - 1 'FREQUENCY=!D '// - 1 'BANDWIDTH=!E DELTA_FREQ=!UJ '// - 1 'VCODE=!UI VELOCITY=!E '// - 1 'BACKEND.DESCRIPTION=!AD '// - 1 'CORR_CONFIG=!UJ CORR_INTEGRAT=!UI CORR_MODE=!UI ', - 1 OBSMODE,OHW(OHW_TYPE_1),OHW_TYPE_N, - 1 OHWD(OHW_FREQ_D), - 1 OHWE(OHW_BAND_E),SFREQ, - 1 OHWI(OHW_VELC_I),OHWE(OHW_VLCTY_E), - 1 OHW(OHW_BECODE_1),OHW_BECODE_N, - 1 OHWJ(OHW_CONFNR_J),OHWI(OHW_BSINT_I), - 1 OHWI(OHW_MODE_I)) -C - CALL WNCTXS(WARC(WNCALN(WARC)+1:), - 1 ' DIPOLE.SYMBOLIC=!AS '// - 1 'POLARISA.DESCRIPTION=!AS '// - 1 'TAPER_CODE=!UJ '// - 1 'MOSAICK.DESCRIPTION=!AS '// - 1 'DWELT=!UJ DRADT=!UJ NR_SIMOBS=!UI ', - 1 DIPC,POLC,1+OHWI(OHW_TAPER_I), - 1 MOSTYP,DWELT,DRADT,FDWI(FDW_NOBS_I)) -C - J0=WNFSCI(WARC) - IF (MOD(J0,100).NE.0) THEN - CALL WNFSCS(WARC) - CALL WNCTXT(F_TP,'Error !UJ updating archive: !AS', - 1 J0,WARC(1:WNCALN(WARC))) - ELSE - CALL WNFSCS(WARC) - CALL WNCTXT(F_TP,'Scissor: !AS',WARC(1:WNCALN(WARC))) - CALL WNCTXS(WARC, - 1 'PUT=OBSERVATION SEQNUMBER=!UJ STATUS=RCV', - 1 OHWJ(OHW_VOLGNR_J)) - J0=WNFSCI(WARC) - CALL WNCTXS(WARC, - 1 'PUT=OBSPOS SEQNUMBER=!UJ OH_NO=!UJ '// - 1 'RA=!D DEC=!D EQUINOX=B1950 SYSTEM=FK5', - 1 OHWJ(OHW_VOLGNR_J),OH_NO,RA1,DEC1) - J0=WNFSCI(WARC) - IF (VOLUME(1:4).EQ.'VOL1') THEN - R0=FDWJ(FDW_NBL_J)*FDWI(FDW_PHBLL_I)* - 1 FDWI(FDW_LRCRD_I)/1024./1024. - CALL WNGMED(VOLUME(5:10),LABEL,R0,OHWJ(OHW_VOLGNR_J)) - END IF - END IF - END IF -C - RETURN - END diff --git a/src/nscan/nsclod.for b/src/nscan/nsclod.for deleted file mode 100644 index 5796e5d192607dc46fc6067b0be406845f1bcd8f..0000000000000000000000000000000000000000 --- a/src/nscan/nsclod.for +++ /dev/null @@ -1,932 +0,0 @@ -C+ NSCLOD.FOR -C WNB 900219 -C -C Revisions: -C WNB 910307 Add velocity information -C WNB 910513 Correct for System 52 tape error -C WNB 910513 Correct for LINOBS error if IQUV on tape -C HjV 920520 HP does not allow extended source lines -C WNB 920813 Set correct types NM OM GM in OH -C WNB 920814 Add splitted OH -C WNB 920815 Some more split changes -C WNB 920816 Some more split changes -C WNB 920817 Some more split changes -C WNB 920818 Add Tsys in weights -C WNB 920820 Typo Tsys: made wrong phi -C WNB 920828 Correct MJD calculation for aborted obs. in Wbork -C WNB 920828 Update velocity and frequency calculations for line -C WNB 930604 Change TSYS definition for new weight/flag, add MTSYS -C WNB 930618 Correct FWGT -C WNB 930621 FWGT always UF correction -C WNB 930803 New OFFSET definition for RECORDS -C WNB 930819 Add DIPC in STH -C WNB 930825 Add pol. codes -C HjV 930907 Minor change for SUN/RUG use -C WNB 931130 Add ACORM -C CMV 931220 Changed parameters of call to NSCPFL -C CMV 940223 Force conversion for VAX D-format to DECStation -C CMV 940223 Option to make only a listing -C CMV 940303 Correct date in listing -C CMV 940317 Correct sequence number in listing -C HjV 940407 Correct for 'older' tape-versions (i.e. <6) -C CMV 940418 Print tapeversion as SJ, check Leiden tapes -C CMV 940420 Select IF sets if requested -C CMV 940516 LIST duration in stead of FD# -C CMV 940518 No format messages in LOG during list -C CMV 940518 Check on BSINT (should be 10) -C CMV 940817 Correct OH setnr.s to bandnr.s (version <6) -C CMV 940829 Message if too many channels in dataset -C CMV 940929 Put gain-corrections into (deapply) OTHR -C CMV 941012 Split list options off in NSCLLI -C JPH 941213 No error message for wildcard disk labels -C CMV 950123 Also pass FWDJ to NSCLLI, no longer pass IMCA -C CMV 950509 Also pass OH-number to NSCLLI -C HjV 950703 Change text when someone loads a Leiden tape -C CMV 951128 Unique temp-file name -C CMV 960122 Message if no labels found on disk-file (bug by JPH) -C HjV 960618 Change length to read for OH -C HjV 961107 Give original Online Version nr. as argument to NSCLLI -C - SUBROUTINE NSCLOD(TYP) -C -C Load WSRT data into SCN file -C -C Result: -C -C CALL NSCLOD(TYP_J:I) will load WSRT data in SCN file if TYP is 0, -C or list WSRT data if TYP is 1, -C or list and update Scissor if TYP is 2. -C -C Include files: -C - INCLUDE 'WNG_DEF' - INCLUDE 'CBITS_DEF' - INCLUDE 'FDW_O_DEF' !FD BLOCK - INCLUDE 'FDW_T_DEF' - INCLUDE 'FDX_O_DEF' !FDX BLOCK - INCLUDE 'FDX_T_DEF' - INCLUDE 'OHW_O_DEF' !OH BLOCK - INCLUDE 'OHW_T_DEF' - INCLUDE 'SCW_O_DEF' !SC BLOCK - INCLUDE 'SCW_T_DEF' - INCLUDE 'GFH_O_DEF' !GENERAL FILE HEADER - INCLUDE 'SGH_O_DEF' !SUB-GROUP HEADER - INCLUDE 'STH_O_DEF' !SET HEADER - INCLUDE 'IFH_O_DEF' !IF-SET HEADER - INCLUDE 'NSC_DEF' -C -C Parameters: -C -C -C Arguments: -C - INTEGER TYP !Can be 0,1 or 2 -C -C Function references: -C - LOGICAL WNFOP,WNFOPF !OPEN FILE - LOGICAL WNFRD !READ DATA - LOGICAL WNFWR !WRITE DATA - INTEGER WNFEOF !FILE POSITION - DOUBLE PRECISION WNGDNF !NORM. ANGLE - INTEGER WNCALN !STRING LENGTH - LOGICAL WNDLNG,WNDLNF !LINK SUB-GROUP - LOGICAL NSCLRD !READ DATA - LOGICAL NSCLWD !WRITE DATA - LOGICAL NSCLIF !READ/WRITE IF SET - CHARACTER*80 WNFTVL !GET VOLUME HEADER - CHARACTER*20 WNFFNM !GET TEMP-NAME -C -C Data declarations: -C - LOGICAL OUT !WRITE SCN FILE? - CHARACTER*6 LTXT !LABEL NAME - CHARACTER*(OHW_FIELD_N) FNAM !FIELD NAME - INTEGER FDP(0:1),OHP(0:1),SCP(0:1) !DATA LENGTH, POINTER - INTEGER OHP1(-1:MXNMOS-1) !SPLITTED OH/SC POINTERS - LOGICAL FSC !FIRST SC INDICATOR - DOUBLE PRECISION MJDHA0 !MJD AT HA=0 - DOUBLE PRECISION RACMOS !RA MOZAIC CENTRE - DOUBLE PRECISION FRCMOS !FREQ. MOZAIC CENTRE - LOGICAL SPLIT !GM OR NM - LOGICAL FSPLIT !FIRST CHANNEL - INTEGER DWELT !DWELL TIME - LOGICAL THIS_CHAN !LOAD THIS CHANNEL - INTEGER I6 - REAL TSYS(0:1,0:STHTEL-1) !1/TSYS - REAL MTSYS !MAX(1/TSYS) - REAL FWGT !MAX. WEIGHT - CHARACTER*4 BECODE !BE CODE - INTEGER IXX,IYX,IXY,IYY !CHAR CODES IN INTs - INTEGER POLCD(0:3) !POL. CODE - DATA POLCD/XX_P,XY_P,YX_P,YY_P/ -C - BYTE FDW(0:FDWHDL-1) !FD - INTEGER*2 FDWI(0:FDWHDL/2-1) - INTEGER FDWJ(0:FDWHDL/4-1) - EQUIVALENCE (FDW,FDWI,FDWJ) - BYTE FDX(0:FDXHDL-1) !FDX - INTEGER*2 FDXI(0:FDXHDL/2-1) - INTEGER FDXJ(0:FDXHDL/4-1) - EQUIVALENCE (FDX,FDXI,FDXJ) - BYTE OHW(0:OHWHDL-1) !OH - INTEGER*2 OHWI(0:OHWHDL/2-1) - INTEGER OHWJ(0:OHWHDL/4-1) - REAL OHWE(0:OHWHDL/4-1) - REAL*8 OHWD(0:OHWHDL/8-1) - EQUIVALENCE (OHW,OHWI,OHWJ,OHWE,OHWD) - BYTE SCW(0:SCWHDL-1) !SC - INTEGER*2 SCWI(0:SCWHDL/2-1) - INTEGER SCWJ(0:SCWHDL/4-1) - REAL*4 SCWE(0:SCWHDL/4-1) - REAL*8 SCWD(0:SCWHDL/8-1) - EQUIVALENCE (SCW,SCWI,SCWJ,SCWE,SCWD) - BYTE OHW1(0:OHWHDL-1) !OH SPLITTED - INTEGER*2 OHW1I(0:OHWHDL/2-1) - INTEGER OHW1J(0:OHWHDL/4-1) - REAL OHW1E(0:OHWHDL/4-1) - REAL*8 OHW1D(0:OHWHDL/8-1) - EQUIVALENCE (OHW1,OHW1I,OHW1J,OHW1E,OHW1D) -C - BYTE STH(0:STHHDL-1) !SET HEADER - INTEGER*2 STHI(0:STHHDL/2-1) - INTEGER STHJ(0:STHHDL/4-1) - REAL STHE(0:STHHDL/4-1) - REAL*8 STHD(0:STHHDL/8-1) - EQUIVALENCE (STH,STHI,STHJ,STHE,STHD) - BYTE IFH(0:IFHHDL-1) !IF-SET HEADER - INTEGER*2 IFHI(0:IFHHDL/2-1) - INTEGER IFHJ(0:IFHHDL/4-1) - REAL IFHE(0:IFHHDL/4-1) - REAL*8 IFHD(0:IFHHDL/8-1) - EQUIVALENCE (IFH,IFHI,IFHJ,IFHE,IFHD) -C -C Some buffers passed to lower level routines. -C Use of OBUF: nsclif INTEGER*2 OBUF(2,0:1,0:STHTEL-1,0:*) -C nscl?d REAL*4 OBUF( 0:1,0:STHTEL-1,0:*) -C - INTEGER*2 TPBUF(2,0:1,0:STHTEL-1,0:MXDATN-1) !BUFFER FOR IF-DATA - INTEGER*2 OBUF(2,0:1,0:STHTEL-1,0:MXDATN-1) !OUTPUT BUFFER - INTEGER*2 DBUF(2,0:MXDATN-1) !INPUT BUFFER - INTEGER*2 TMPBUF(3,0:MXDATX-1) !OUTPUT BUFFER -C - INTEGER FCAT !TMP FILE DESCRIPTOR - INTEGER NCHT !# OF CHANNELS DONE - INTEGER FVERS !TAPE VERSION - INTEGER ORG_VS !ORIGINAL ONLINE SYSTEM VERSION - INTEGER VS !ONLINE SYSTEM VERSION - INTEGER BINT !BASIC INTEGRATION TIME - INTEGER SFREQ !SFREQ FROM OH - REAL OHAB !START HA SCANS - INTEGER ONS(6) !INTEGRATION DATA - INTEGER NPOL !# OF POLARISATIONS FOUND - INTEGER POLS(0:3) !INDICATE POLS TO DO - INTEGER NIFR !INTERFEROMETER COUNT - INTEGER IFRT(9,0:MXNIFR-1) !INTERFEROMETER DESCRIPTION - INTEGER F_XX !OUTPUT FOR FORMATS - CHARACTER*80 VOLUME !VOLUME HEADER -C- -C -C INIT -C - IXX=ICHAR('X')*256+ICHAR('X') - IXY=ICHAR('X')*256+ICHAR('Y') - IYX=ICHAR('Y')*256+ICHAR('X') - IYY=ICHAR('Y')*256+ICHAR('Y') -C - OUT=(TYP.EQ.0) !ONLY SCN FILE IF TYP=0 - IF (OUT) THEN - F_XX=F_TP !BOTH SCREEN AND LOG - ELSE - F_XX=F_T !ONLY SCREEN - END IF - IF (.NOT.WNFOP(FCAT,WNFFNM('NSC','TMP'),'WT')) THEN !OPEN TMP FILE - CALL WNCTXT(F_TP,'Cannot open TMP file (!XJ)',E_C) - GOTO 900 - END IF - VOLUME=' ' !DEFAULT NO VOLUME - IF (UNIT.NE.'D') VOLUME=WNFTVL(IMCA) !GET VOLUME HEADER -C - J1=0 !JOB COUNT - 30 CONTINUE - J1=J1+1 !NEXT JOB - IF (J1.GT.NJOB) GOTO 900 !READY - J=0 !START LABEL INPUT - IF (OUT) THEN - IF (.NOT.WNDLNG(GFH_LINKG_1,0,SGH_GROUPN_1,FCAOUT,SGPH(0), - 1 SGNR(0))) THEN - CALL WNCTXT(F_TP,'!/Cannot create sub-group') - GOTO 800 !NEXT JOB - END IF !SUB-GROUP LINKED - CALL WNCTXT(F_P,'!_') !NEW PAGE - CALL WNCTXT(F_TP,'!/Job !UJ\: Group !UJ',J1,SGNR(0)) - ELSE - CALL WNCTXT(F_TP, - 1 'Label Seq.nr Fieldname Project '// - 1 'hhmm TP SP yymmdd hhmm RA Dec ') - END IF -C -C DO A LABEL -C - 10 CONTINUE - J=J+1 !COUNT INPUT LABEL - IF (NLAB(J1).LT.0) THEN !ALL LABELS ON TAPE - J0=J !NEXT INPUT LABEL - ELSE IF (J.LE.NLAB(J1)) THEN - J0=ILAB(J,J1) !NEXT INPUT LABEL - ELSE - GOTO 800 !READY WITH JOB - END IF -C -C OPEN INPUT -C - IF (UNIT.EQ.'D') THEN !DISK INPUT - CALL WNCTXS(LTXT,'!6$ZJ',J0) !MAKE LABEL NAME - IF (.NOT.WNFOP(IMCA,IFILE(1:WNCALN(IFILE))//'.'//LTXT,'R')) THEN - IF (NLAB(J1).GT.0) THEN - CALL WNCTXT(F_XX,'Cannot find file !AS\.!AS',IFILE,LTXT) - ELSE - CALL WNCTXT(F_XX,'No labels found for file !AS',IFILE) - END IF - GOTO 800 !STOP JOB - END IF - ELSE !TAPE INPUT - IF (.NOT.WNFOPF(IMCA,' ','R',0,0,0,J0)) THEN - CALL WNCTXT(F_XX,'Cannot find label !UJ',J0) - GOTO 800 !NEXT JOB - END IF - END IF - IF (OUT) THEN - IF (.NOT.WNDLNG(SGPH(0)+SGH_LINKG_1,0,SGH_GROUPN_1,FCAOUT, - 1 SGPH(1),SGNR(1))) THEN !LINK SUB-GROUP - CALL WNCTXT(F_TP,'!/Cannot create sub-group') - GOTO 700 !NEXT LABEL - END IF - CALL WNCTXT(F_TP,'!4CLabel !3$UJ: Sub-group !UJ\.!UJ', - 1 J0,SGNR(0),SGNR(1)) - END IF -C -C OPEN OUTPUT -C -C -C READ FD -C - J2=0 !DATA POINTER - 20 CONTINUE - IF (.NOT.WNFRD(IMCA,FDWHDL,FDW,J2)) THEN !READ FD BLOCK - CALL WNCTXT(F_XX,'Read error FD at !XJ',J2) - GOTO 700 !NEXT LABEL - END IF - IBMSW=.FALSE. !ASSUME NON-IBM - DECSW=.FALSE. !ASSUME LOCAL - IF (FDW(FDW_CBT_1).NE.ICHAR('F') .OR. - 1 FDW(FDW_CBT_1+1).NE.ICHAR('D')) THEN - IBMSW=.TRUE. !ASSUME IBM - CALL WNTTIL(FDWHDL,FDW,FDW_T) !TRANSLATE - IF (FDW(FDW_CBT_1).NE.ICHAR('F') .OR. - 1 FDW(FDW_CBT_1+1).NE.ICHAR('D')) THEN - 23 CONTINUE - CALL WNCTXT(F_XX,'Cannot find FD block') - GOTO 700 !NEXT LABEL - END IF - ELSE IF (FDWI(FDW_CBI_I).NE.32767) THEN - DECSW=.TRUE. !ASSUME FROM DEC - CALL WNTTDL(FDWHDL,FDW,FDW_T) !TRANSLATE - IF (FDWI(FDW_CBI_I).NE.32767) GOTO 23 -C -C DECStation/Alpha has the same swapping sequence as VAX D/G, -C but uses IEEE floating point format. The test on FDW_CBI is -C therefore not sufficient. Since raw data is assumed to be in -C IBM (type -1) or VAX D (type 1) format, the following test is -C safe and sufficient. -C - ELSE IF (PRGDAT.EQ.6) THEN - DECSW=.TRUE. !ASSUME FROM DEC - CALL WNTTDL(FDWHDL,FDW,FDW_T) !TRANSLATE - IF (FDWI(FDW_CBI_I).NE.32767) GOTO 23 - END IF -C -C REPAIR FD -C - FVERS=FDWI(FDW_FVERS_I) - IF (FVERS.EQ.-1) THEN - CALL WNCTXT(F_XX,'Leiden tape... please use option LEIDEN') - GOTO 700 - END IF - IF (FVERS.LT.3) FDWI(FDW_STIM_I)=FDWI(FDW_STIM_I)*6 - IF (FVERS.LT.5) - 1 CALL WNCTXT(F_P,'FVERS !SJ: all times are ST',FVERS) - IF (FVERS.LT.7) FDWJ(FDW_MOH_J)=1 -C - IF (FDWI(FDW_LRCRD_I).NE.SRTRCL) THEN - CALL WNCTXT(F_XX, - 1 'WARNING: Recordlength of input tape seems incorrect '// - 1 '(!UJ set to !UJ)',FDWI(FDW_LRCRD_I),SRTRCL) - FDWI(FDW_LRCRD_I)=SRTRCL - END IF -C -C READ FDX -C - J2=J2+FDWI(FDW_LRCRD_I) !POINT TO FDX - I=(FDWJ(FDW_LFD_J)-1)*FDWI(FDW_LRCRD_I) !LENGTH FDX - IF (I.GT.FDXHDL) CALL WNCTXT(F_XX,'FDX block length (!UJ) '// - 1 'differs from expected (!UJ)',I,FDXHDL) - I=MIN(I,FDXHDL) - IF (.NOT.WNFRD(IMCA,I,FDX,J2)) THEN !READ FDX - CALL WNCTXT(F_XX,'Read error FDX at !XJ',J2) - GOTO 700 !NEXT LABEL - END IF - IF (IBMSW) CALL WNTTIL(I,FDX,FDX_T) !TRANSLATE - IF (DECSW) CALL WNTTDL(I,FDX,FDX_T) - FDP(0)=I+FDWI(FDW_LRCRD_I) !TOTAL LENGTH FD - IF (OUT) FDP(1)=WNFEOF(FCAOUT) !POSITION TO WRITE - FDWJ(FDW_LFD_J)=FDP(0) !SAVE LENGTH - IF (OUT) THEN - IF (.NOT.WNFWR(FCAOUT,FDWHDL,FDW(0),FDP(1))) THEN !WRITE FD - 22 CONTINUE - CALL WNCTXT(F_XX,'!/Error writing to SCN file (!XJ)',E_C) - GOTO 900 !STOP - END IF - IF (.NOT.WNFWR(FCAOUT,FDP(0)-FDWHDL, - 1 FDX(0),FDP(1)+FDWHDL)) GOTO 22 - END IF -C -C READ OH -C - J3=0 !OH COUNT - J2=FDWI(FDW_LRCRD_I)*FDWJ(FDW_NOH_J) !OH POINTER - FSC=.TRUE. !INDICATE FIRST SC - 50 CONTINUE - J3=J3+1 !COUNT OH - I=FDWI(FDW_LOH_I)*FDWI(FDW_LRCRD_I) !LENGTH OH - IF (I.GT.OHWHDL) THEN - CALL WNCTXT(F_XX,'OH block length (!UJ) '// - 1 'larger than expected (!UJ)',I,OHWHDL) - CALL WNCTXT(F_XX,'(probably there are '// - 1 'too many channels in the dataset)') - END IF - I=MIN(I,OHWHDL) - IF (.NOT.WNFRD(IMCA,I,OHW,J2)) THEN !READ OH - CALL WNCTXT(F_XX,'Read error OH at !XJ',J2) - GOTO 700 !NEXT LABEL - END IF - IF (IBMSW) CALL WNTTIL(I,OHW,OHW_T) !TRANSLATE - IF (DECSW) CALL WNTTDL(I,OHW,OHW_T) - IF (OHWI(OHW_CBI_I).NE.32767 .OR. - 1 OHW(OHW_CBT_1).NE.ICHAR('O') .OR. - 1 OHW(OHW_CBT_1+1).NE.ICHAR('H')) THEN - CALL WNCTXT(F_XX,'Cannot find OH block') - GOTO 600 !NEXT OH - END IF - OHP(0)=I !TOTAL LENGTH OH - IF (OUT) OHP(1)=WNFEOF(FCAOUT) !POSITION TO WRITE - OHWJ(OHW_LOH_J)=OHP(0) !SAVE LENGTH -C -C Test number of sets. -C - IF (OHWI(OHW_NRSTS_I).GT.OHWSET) THEN - CALL WNCTXT(F_XX, - 1 'Indeed too many channels in the dataset '// - 1 '(!UI > > !UJ)',OHWI(OHW_NRSTS_I),OHWSET) - CALL WNCTXT(F_XX,'Using only first !UJ sets',OHWSET) - OHWI(OHW_NRSTS_I)=OHWSET !TRUNCATE SETS - END IF -C -C REPAIR OH -C - IF (FVERS.LT.3) OHWI(OHW_OLSYS_I)=20 - ORG_VS=OHWI(OHW_OLSYS_I) !ONLINE SYSTEM - VS=OHWI(OHW_OLSYS_I) !ONLINE SYSTEM - IF (VS.EQ.52) OHWI(OHW_BSINT_I)=NINT(OHWI(OHW_BSINT_I)/10.) !SYSTEM 52 - IF (VS.LT.43.AND.OHWI(OHW_STOPAR_I).NE.0) OHWI(OHW_STOPAR_I)=0 - IF (OHWI(OHW_STOPAR_I).NE.0 .AND. OHWI(OHW_MSPAT_I).EQ.0) - 1 OHWI(OHW_MPOSN_I)=0 !MAKE SURE LINOBS ERROR CORRECT - IF (FVERS.EQ.1) OHWI(OHW_VELC_I)=MOD(ABS(OHWI(OHW_MODE_I)),2) - IF (FVERS.LT.2) OHWJ(OHW_VOLGNR_J)=OHWJ(OHW_VOLGNR_J)+ - 1 OHWI(OHW_DATE_I+1)*100000 - IF (OHWJ(OHW_VOLGNR_J)/10000000.EQ.19) - 1 OHWJ(OHW_VOLGNR_J)=OHWJ(OHW_VOLGNR_J)-190000000 !ERROR OLSYS 57 - IF (FVERS.LT.3) THEN - OHWI(OHW_STIM_I)=OHWI(OHW_STIM_I)*6 - CALL WNCTXT(F_P, - 1 'FVERS !UJ: FREQ is fringe stopping freq, not middle of band', - 2 FVERS) - END IF -C - IF (FVERS.LT.6) THEN - OHWD(OHW_FREQ0_D)=0 - IF (OHW(OHW_BECODE_1).NE.ICHAR('D')) THEN - CALL WNCTXT(F_XX,'Assuming DLB was used') - CALL WNGMFS(OHW_BECODE_N,'DLB ',OHW(OHW_BECODE_1)) - END IF - DO I=0,OHWI(OHW_NRSTS_I)-1 !ALL INPUT SETS - I1=(OHW_SET_1+I*OHWI(OHW_LENT_I))/LB_I !OFFSET TABLE - OHWI(I1+SET_BANDNR_I)=(OHWI(I1+SET_BANDNR_I)-1)/4 - END DO - CALL WNCTXT(F_XX,'Band-numbers corrected') - END IF -C - IF (OHWI(OHW_ETIM_I).LT.0) THEN !FVERS < 7 NO ETIM - OHWI(OHW_ETIM_I)=OHWI(OHW_STIM_I)+ - 1 (OHWD(OHW_HAEND_D)-OHWD(OHW_HAST_D))*DCRTSC/10+1 - END IF - SFREQ=OHWI(OHW_SFREQ_I) - CALL WNGMTS(OHW_BECODE_N,OHW(OHW_BECODE_1),BECODE) !BE CODE -C -C Check Basic integration time (errors found for FVERS 1, 1979) -C - IF (OHWI(OHW_BSINT_I).GT.10) THEN - CALL WNCTXT(F_XX, - 1 'Basic int.time is !UI, changed to 10 sec', - 1 OHWI(OHW_BSINT_I)) - OHWI(OHW_BSINT_I)=10 - END IF -C -C Check telescope positions (errors found for FVERS 1, 1979) -C - IF (OHWJ(OHW_POST_J).EQ.OHWJ(OHW_POST_J+9)) THEN - CALL WNCTXT(F_XX,'Error in position of RT0, corrected') - OHWJ(OHW_POST_J)=OHWJ(OHW_POST_J+1)+ - 1 (OHWJ(OHW_POST_J+1)-OHWJ(OHW_POST_J+2)) !ASSUME 0-1 = 1-2 - END IF -C -C SET PROPER SPLIT/UNSPLIT -C - IF (FDWI(FDW_FVERS_I).EQ.6 .AND. - 1 (OHWI(OHW_OLSYS_I).EQ.60 .OR. - 1 OHWI(OHW_OLSYS_I).EQ.61)) THEN !UNSPLIT OLD FORMAT - OHWI(OHW_MSPAT_I)=-ABS(OHWI(OHW_MSPAT_I)) !INDICATE OM - OHWI(OHW_MSNP_I)=FDXI(807) !PATTERN LENGTH - ELSE IF (FDWI(FDW_FVERS_I).EQ.7 .AND. - 1 OHWI(OHW_OLSYS_I).LT.62) THEN !INDICATE GM - OHWI(OHW_MSNP_I)=FDXI(807) !PATTERN LENGTH - ELSE IF (OHWI(OHW_OLSYS_I).LT.60) THEN - OHWI(OHW_MSPAT_I)=0 !SET NM - OHWI(OHW_MSNP_I)=1 !NUMBER IN PATTERN - OHWI(OHW_MPOSN_I)=0 !PATTERN START - END IF - OHWI(OHW_MSNP_I)=MAX(1,MIN(MXNMOS,OHWI(OHW_MSNP_I))) !LIMIT -C -C FINAL OH CHANGES -C - IF (FDWI(FDW_FVERS_I).LT.7) VS=MIN(VS,58) !CATER FOR ERROR - OHWI(OHW_OLSYS_I)=VS - BINT=OHWI(OHW_BSINT_I) !BASIC INTEGRATION TIME (10 SEC) - IF (BINT.GT.10) THEN - CALL WNCTXT(F_XX, - 1 'Basic int.time is !UJ, changed to 10 sec',BINT) - BINT=10 - END IF -C -C READ SC -C - IF (FSC) THEN !FIRST SC - J2=FDWJ(FDW_NSC_J)*FDWI(FDW_LRCRD_I) !SC POINTER - FSC=.FALSE. !NON-FIRST SC - ELSE - J2=SCWJ(SCW_NSCN_J)*FDWI(FDW_LRCRD_I) !POINTER NEXT SC - END IF - I=FDWI(FDW_LSC_I)*FDWI(FDW_LRCRD_I) !LENGTH SC - IF (I.GT.SCWHDL) CALL WNCTXT(F_XX,'SC block length (!UJ) '// - 1 'differs from expected (!UJ)',I,SCWHDL) - I=MIN(I,SCWHDL) - IF (.NOT.WNFRD(IMCA,I,SCW,J2)) THEN !READ SC - CALL WNCTXT(F_XX,'Read error SC at !XJ',J2) - GOTO 700 !NEXT LABEL - END IF - IF (IBMSW) CALL WNTTIL(I,SCW,SCW_T) !TRANSLATE - IF (DECSW) CALL WNTTDL(I,SCW,SCW_T) - IF (SCWI(SCW_CBI_I).NE.32767 .OR. - 1 SCW(SCW_CBT_1).NE.ICHAR('S') .OR. - 1 SCW(SCW_CBT_1+1).NE.ICHAR('C')) THEN - CALL WNCTXT(F_XX,'Cannot find SC block') - GOTO 600 !NEXT OH - END IF -C -C REPAIR SC -C - IF (VS.LT.26) SCWD(SCW_FRO_D)=0 !ASSUME 0 - IF (VS.LT.43) THEN - SCWI(SCW_SYNF_I)=1 !ASSUME 1 - SCWE(SCW_CEXT_E)=1 !ASSUME NO EXTINCTION - SCWE(SCW_GLAT_E)=52.7317357/360. !Lattitude in circles - END IF - IF (FVERS.LT.3) THEN - SCWI(SCW_STIM_I)=SCWI(SCW_STIM_I)*6 - SCWE(SCW_C2X2_E)=0.0 !NO V.VLECK CORR. KNOWN - SCWE(SCW_C2X3_E)=0.0 - SCWE(SCW_C2X4_E)=0.0 - SCWE(SCW_C4X3_E)=0.0 - SCWE(SCW_C4X4_E)=0.0 - SCWE(SCW_JDCP_E)=0.0 !NO CLOCK CORR. STORED - SCWE(SCW_CLOCK_E)=0.0 - SCWE(SCW_CLCOFF_E)=0.0 - SCWE(SCW_DCLOCK_E)=0.0 - SCWI(SCW_YEAR_I)=0 - SCWI(SCW_MONTH_I)=0 - SCWI(SCW_DAY_I)=0 - END IF - IF (FVERS.LT.5) SCWD(SCW_CUTST_D)=0.0 !ST instead of UT - SCP(0)=I !TOTAL LENGTH SC - SCP(1)=OHP(1)+OHP(0) !POSITION TO WRITE - SCWJ(SCW_LSC_J)=SCP(0) !SAVE LENGTH - MTSYS=0 !MAX. TSYS - DO I=0,STHTEL-1 !GET TSYS ALL TEL. - DO I1=0,1 !X, Y - TSYS(I1,I)=1./MAX(15.,MIN(300., - 1 SCWE(SCW_TSYSI_E+2*I+I1))) !LIMITED 1/TSYS - MTSYS=MAX(MTSYS,TSYS(I1,I)) !MAX. 1/TSYS - END DO - END DO - DO I=0,STHTEL-1 !LIMIT 1/TSYS TO 256 - DO I1=0,1 !X, Y - TSYS(I1,I)=256.*TSYS(I1,I)/MTSYS - END DO - END DO - CVUTST=SCWD(SCW_CUTST_D)+1D0 !UT TO ST CONVERSION -C -C CHECK IF OH WANTED -C - SPLIT=OHWI(OHW_MSPAT_I).GE.0 !SPLITTED DATA - IF (NPTC(J1).LT.0) THEN !DO ALL OH'S (*) - ELSE IF (OHWI(OHW_MSPAT_I).LE.0) THEN !DO IF OM OR NM TYPE - ELSE - DO I=1,NPTC(J1) - IF (IPTC(I,J1).EQ.J3) GOTO 51 !THIS ONE - END DO - GOTO 600 !TRY NEXT OH - END IF -C -C WRITE SC/OH -C - 51 CONTINUE - IF (SPLIT) THEN !NM OR GM - IF (OUT) THEN - IF (.NOT.WNFWR(FCAOUT,OHP(0),OHW(0),OHP(1))) GOTO 22 !WRITE OH - END IF - RACMOS=0 !NO CENTRE RA NEEDED - FRCMOS=0 !NO CENTRE FREQ. NEEDED - ELSE !OM - DO I1=1,OHWI(OHW_MSNP_I) !ALL FIELD CENTRA - IF (NPTC(J1).LT.0) THEN !ALL - ELSE - DO I=1,NPTC(J1) !TEST - IF (IPTC(I,J1).EQ.I1) GOTO 60 !THIS ONE ASKED - END DO - GOTO 61 !TRY NEXT - END IF -C -C MAKE OH/SC FOR OM TYPE -C - 60 CONTINUE - CALL WNGMV(OHWHDL,OHW,OHW1) !COPY INITIAL OH - I2=MOD((I1-1)+OHW1I(OHW_MPOSN_I),OHW1I(OHW_MSNP_I)) !TABLE # - OHW1D(OHW_RA0_D)=SCWJ((SCW_MOZP_1+I2*SCW_MOZP_N)/LB_J+ - 1 MOZP_RA1_J)/D2T32 !RA APPARENT - OHW1D(OHW_DEC0_D)=SCWJ((SCW_MOZP_1+I2*SCW_MOZP_N)/LB_J+ - 1 MOZP_DEC1_J)/D2T32 !DEC APPARENT - OHW1D(OHW_RA1_D)=SCWJ((SCW_MOZP_1+I2*SCW_MOZP_N)/LB_J+ - 1 MOZP_RA0_J)/D2T32 !RA EPOCH - OHW1D(OHW_DEC1_D)=SCWJ((SCW_MOZP_1+I2*SCW_MOZP_N)/LB_J+ - 1 MOZP_DEC0_J)/D2T32 !DEC EPOCH - IF (VS.GE.62) THEN !CAN DO FREQUENCY - OHW1D(OHW_FREQ_D)=SCWD((SCW_MOZP_1+I2*SCW_MOZP_N)/LB_D+ - 1 MOZP_FREQ1_D) - ELSE - CALL WNCTXT(F_XX,'FREQ not corrected for mosaic position') - END IF - OHW1D(OHW_HAST_D)=OHWD(OHW_HAST_D)+OHWD(OHW_RA0_D)- - 1 OHW1D(OHW_RA0_D) !UPDATE HA START - OHW1D(OHW_HAST_D)=WNGDNF(OHW1D(OHW_HAST_D)) !NORM. - OHW1D(OHW_HAEND_D)=OHWD(OHW_HAEND_D)+OHWD(OHW_RA0_D)- - 1 OHW1D(OHW_RA0_D) !UPDATE HA END - OHW1D(OHW_HAEND_D)=WNGDNF(OHW1D(OHW_HAEND_D)) !NORM. - RACMOS=OHWD(OHW_RA0_D) !RA CENTRE MOSAIC APP. - FRCMOS=OHWD(OHW_FREQ_D) !FREQ. CENTRE MOSAIC - CALL WNGMTS(OHW_FIELD_N,OHW(OHW_FIELD_1),FNAM) !FIELD NAME - DO I3=OHW_FIELD_N,1,-1 !CHECK . - IF (FNAM(I3:I3).EQ.'.') THEN !FOUND - CALL WNCTXS(FNAM(I3+1:),'!UJ',I2) - GOTO 62 - END IF - END DO - I3= MIN(WNCALN(FNAM),OHW_FIELD_N-4) !NAME - CALL WNCTXS(FNAM(I3+1:),'.!UJ',I2) - 62 CONTINUE - CALL WNGMFS(OHW_FIELD_N,FNAM,OHW1(OHW_FIELD_1)) !SET NAME - IF (OUT) THEN - OHP1(-1)=OHP(0) - OHP1(I1-1)=WNFEOF(FCAOUT) !WHERE TO WRITE - IF (.NOT.WNFWR(FCAOUT,OHP(0),OHW1(0), - 1 OHP1(I1-1))) GOTO 22 !WRITE OH - IF (.NOT.WNDLNF(SGPH(1)+SGH_LINKG_1,I2,SGH_GROUPN_1,FCAOUT, - 1 SGPH(2),SGNR(2))) THEN !FIND/CREATE SUB-GROUP - CALL WNCTXT(F_TP,'!/Cannot link sub-group') - GOTO 600 !NEXT OH - END IF - CALL WNCTXT(F_TP,'!6C\OH !4$UJ: !UJ\.!UJ\.!UJ'// - 1 '!32C\RA= !10$DPF15.5 Dec= !10$DAF15.5', - 1 I1,SGNR(0),SGNR(1),SGNR(2), - 1 OHW1D(OHW_RA1_D),OHW1D(OHW_DEC1_D)) - ELSE - CALL NSCLLI(TYP,VOLUME,J0,I1,FVERS,ORG_VS, - 1 FDW,FDWI,FDWJ, - 1 STH,STHI,STHJ,STHE,STHD, - 1 OHW1,OHW1I,OHW1J,OHW1E,OHW1D, - 1 SCW, SCWI, SCWJ, SCWE, SCWD) - END IF - 61 CONTINUE - END DO - IF (OUT) SCP(1)=WNFEOF(FCAOUT) !FORGET OH - OHP(1)=0 - END IF - IF (OUT) THEN - IF (.NOT.WNFWR(FCAOUT,SCP(0),SCW(0),SCP(1))) GOTO 22 !WRITE SC - END IF -C -C GET POLARISATIONS TO DO -C - DO I=0,3 !SET POL. TO DO - IF (IAND(POLCD(I),POL(J1)).NE.0) THEN - POLS(I)=0 !SET WANTED - ELSE - POLS(I)=-1 !SET NOT - END IF - END DO - DO I=0,OHWI(OHW_NRSTS_I)-1 !CHECK POL. - I1=OHW_SET_1+SET_DATYP_1+I*OHWI(OHW_LENT_I) !OFFSET TABLE ENTRY - I2=I1/LB_I - IF (OHWI(I2).EQ.IXX) THEN - IF (POLS(0).GE.0) POLS(0)=1 !SET PRESENT - ELSE IF (OHWI(I2).EQ.IXY) THEN - IF (POLS(1).GE.0) POLS(1)=1 !SET PRESENT - ELSE IF (OHWI(I2).EQ.IYX) THEN - IF (POLS(2).GE.0) POLS(2)=1 !SET PRESENT - ELSE IF (OHWI(I2).EQ.IYY) THEN - IF (POLS(3).GE.0) POLS(3)=1 !SET PRESENT - END IF - END DO - NPOL=0 !CNT POL - DO I=0,3 - IF (POLS(I).GT.0) NPOL=NPOL+1 - END DO -C -C MAKE SET HEADER TEMPLATE -C - CALL WNGMVZ(STHHDL,STH(0)) !CLEAR - STHI(STH_LEN_I)=STHHDL !LENGTH - STHI(STH_VER_I)=STHHDV !VERSION - STHI(STH_BEC_I)=IAND('0000ffff'X,OHWJ(OHW_CONFNR_J)) !BACKEND CODE - STHJ(STH_DIPC_J)=0 !DIPOLE SETTING - I1=OHWI(OHW_POLC_I) - DO I=0,STHTEL-1 - IF (I.LT.10) THEN !WEST TEL. - STHJ(STH_DIPC_J)=STHJ(STH_DIPC_J)+ISHFT(I1/4,2*I) - ELSE !EAST TEL - STHJ(STH_DIPC_J)=STHJ(STH_DIPC_J)+ISHFT(MOD(I1,4),2*I) - END IF - END DO - STHI(STH_PTS_I)=OHWI(OHW_MPOSN_I) !POINTING SET # - STHJ(STH_VNR_J)=OHWJ(OHW_VOLGNR_J) !VOLG NUMBER - STHI(STH_PLN_I)=NPOL !# OF POLARISATIONS - CALL WNGMV(STH_FIELD_N,OHW(OHW_FIELD_1),STH(STH_FIELD_1)) !FIELD NAME - STHD(STH_RA_D)=OHWD(OHW_RA0_D) !APP. RA - STHD(STH_DEC_D)=OHWD(OHW_DEC0_D) !APP. DEC - STHD(STH_RAE_D)=OHWD(OHW_RA1_D) !RA EPOCH - STHD(STH_DECE_D)=OHWD(OHW_DEC1_D) !DEC EPOCH - STHE(STH_OEP_E)=OHWD(OHW_JUCEN_D)*100.+1900. !OBS. DATE IN JUL. YEARS - STHE(STH_EPO_E)=1900.+OHWI(OHW_DATE_I) !EPOCH - STHI(STH_OBS_I)=OHWI(OHW_SDAY_I) !DAY - STHI(STH_OBS_I+1)=OHWI(OHW_DATE_I+1) !YEAR - DO I=0,STHTEL-1 !TEL. POSITIONS - STHE(STH_RTP_E+I)=(OHWJ(OHW_POST_J+I)-OHWJ(OHW_POST_J))/65536. - END DO - STHJ(STH_VELC_J)=OHWI(OHW_VELC_I)+1 !VELOCITY CODE - STHE(STH_VELR_E)=1000.*OHWE(OHW_VLCTY_E) !REF. VEL. - STHD(STH_FRQC_D)=OHWD(OHW_FREQ_D) !REF. FREQUENCY - STHD(STH_FRQ0_D)=OHWD(OHW_FREQ0_D) !REST FREQ. - STHD(STH_FRQV_D)=STHD(STH_FRQC_D) !CHANNEL FREQ. FOR NOW - IF (OHWI(OHW_FREQC_I).LT.10 .OR. - 1 STHJ(STH_VELC_J).GT.4 .OR. - 1 BECODE(1:2).EQ.'DC') THEN !CONTINUUM OR UNKNOWN - STHJ(STH_VELC_J)=0 !SET CONTINUUM - STHE(STH_VELR_E)=0 !REF. VELOCITY - END IF - STHE(STH_VEL_E)=STHE(STH_VELR_E) !VEL. FOR NOW - STHJ(STH_NFD_J)=FDP(0) !FD BLOCK - STHJ(STH_FDP_J)=FDP(1) - STHJ(STH_NOH_J)=OHP(0) !OH BLOCK - STHJ(STH_OHP_J)=OHP(1) - STHJ(STH_NSC_J)=SCP(0) !SC BLOCK - STHJ(STH_SCP_J)=SCP(1) - CALL NSCCLP(FCAOUT,STH(0),STHE(STH_PHI_E)) !GET PREC. ROTATION ANGLE - STHE(STH_PHI_E)=STHE(STH_PHI_E)/PI2 !MAKE CIRCLES - STHD(STH_UTST_D)=1.+SCWD(SCW_CUTST_D) !UT/ST DAY - IF (SCWI(SCW_GCODE_I).EQ.0) STHJ(STH_ACORM_J)=1 !SET AMPL. CORR. METHOD - MJDHA0=OHWD(OHW_JDAY_D)+40000D0-0.5D0 !MJD MIDDLE OBS. - D0=OHWI(OHW_STIM_I)/360.D0/24D0 !START TIME - IF (D0.GT.MOD(MJDHA0,1D0)) !PREVIOUS DAY - 1 MJDHA0=MJDHA0-1D0 - MJDHA0=MJDHA0-MOD(MJDHA0,1D0)+D0 !MJD START TIME - MJDHA0=MJDHA0-(OHWD(OHW_HAST_D)-5D0/3600D0/24D0) !MJD AT HA0 - IF (SPLIT) THEN !GM, NM - I=STHI(STH_PTS_I) !POINTING SET # - IF (OUT) THEN - IF (.NOT.WNDLNF(SGPH(1)+SGH_LINKG_1,I,SGH_GROUPN_1,FCAOUT, - 1 SGPH(2),SGNR(2))) THEN !FIND/CREATE SUB-GROUP - CALL WNCTXT(F_TP,'!/Cannot link sub-group') - GOTO 600 !NEXT OH - END IF - CALL WNCTXT(F_TP,'!6C\OH !4$UJ: !UJ\.!UJ\.!UJ'// - 1 '!32C\RA= !10$DPF15.5 Dec= !10$DAF15.5', - 1 J3,SGNR(0),SGNR(1),SGNR(2), - 1 STHD(STH_RAE_D),STHD(STH_DECE_D)) - ELSE - CALL NSCLLI(TYP,VOLUME,J0,J3,FVERS,ORG_VS, - 1 FDW,FDWI,FDWJ, - 1 STH,STHI,STHJ,STHE,STHD, - 1 OHW,OHWI,OHWJ,OHWE,OHWD, - 1 SCW,SCWI,SCWJ,SCWE,SCWD) - END IF - END IF -C -C MAKE TMP FILE -C - NCHT=0 !COUNT SELECTED - I3=-1 !TEST CHANNEL - NIFR=0 !NO IFR SEEN - FWGT=0 !MAX. WEIGHT - FSPLIT=.TRUE. !FIRST SPLIT CHANNEL - DO I=0,OHWI(OHW_NRSTS_I)-1 !ALL INPUT SETS - I1=OHW_SET_1+I*OHWI(OHW_LENT_I) !OFFSET TABLE - I2=I1/LB_I - I4=I1/LB_J -C -C Select Channel -C - THIS_CHAN=.TRUE. !ASSUME WANTED - IF (NCHAN(J1).LT.0) THEN !ALL CHANNELS SELECTED - ELSE - DO I5=1,NCHAN(J1) !SEE IF TO DO - IF (OHWI(I2+SET_BANDNR_I).EQ.CHAN(I5,J1)) GOTO 41 !SELECTED CHAN. - END DO - THIS_CHAN=.FALSE. !NOT WANTED - END IF - 41 CONTINUE -C -C Select IF (DCB: one per band, select requested bands only, -C DLB/DXB: only one, so select always) -C - IF (OUT.AND.OHWI(I2+SET_DATYP_1/LB_I).EQ. - 1 ICHAR('I')*256+ICHAR('F') - 1 .AND. (BECODE(1:3).NE.'DCB'.OR.THIS_CHAN)) THEN -C -C Anything left from previous polarisation set? -C - IF (NIFR.GT.0) THEN !SOME TO WRITE - IF (FWGT.NE.0) THEN - STHE(STH_WFAC_E)=1.-FWGT/255.*4.*OINT* - 1 MTSYS*MTSYS/2.56/2.56 - FWGT=255./FWGT !TO MAKE < 256 - ELSE - STHE(STH_WFAC_E)=1.-FWGT - END IF - IF (.NOT.NSCLWD(FCAT,ONS,OHAB,NIFR,IFRT,POLS, - 1 BINT,STH(0),MJDHA0,SPLIT,J1, - 1 OHWI(OHW_MSNP_I),OHP1,I3,DWELT,FSPLIT, - 1 RACMOS,FRCMOS,FWGT,OBUF,TMPBUF)) GOTO 600 - END IF - I3=-1 !NO CHANNELS YET - ONS(1)=-1 !NEW CHANNEL - NIFR=0 !NO IFRS YET - FWGT=0 !NO WEIGHT YET -C -C Copy fixed information from the OH/SC-block -C - IFHI(IFH_CHAN_I)=OHWI(I2+SET_BANDNR_I) !BAND NUMBER - IFHI(IFH_GCODE_I)=SCWI(SCW_GCODE_I) !PRINCIPAL CORRECTION - DO I5=0,2*STHTEL-1 !VALUES FOR DLB/DBC-0 - IFHI(IFH_GNCAL_I+I5)=SCW(SCW_GNCAL_1+I5) - IFHE(IFH_TSYSI_E+I5)=SCWE(SCW_TSYSI_E+I5) - IFHE(IFH_RGAINI_E+I5)=SCWE(SCW_RGAINI_E+I5) - IFHE(IFH_TNOISEI_E+I5)=SCWE(SCW_TNOISI_E+I5) - END DO - IF (BECODE(1:3).EQ.'DCB'.AND. - 1 IFHI(IFH_CHAN_I).GE.1.AND. - 1 IFHI(IFH_CHAN_I).LE.8) THEN !DCB 1..8 - I6=SCW_BCOR_1+(IFHI(IFH_CHAN_I)-1)*BCORHDL !OFFSET TABLE - DO I5=0,2*STHTEL-1 - IFHI(IFH_GNCAL_I+I5)=SCWI(I6/LB_I+BCOR_GNCL_I+I5) - IFHE(IFH_TSYSI_E+I5)=SCWE(I6/LB_E+BCOR_TSYS_E+I5) - IFHE(IFH_RGAINI_E+I5)=SCWE(I6/LB_E+BCOR_GAIN_E+I5) - IFHE(IFH_TNOISEI_E+I5)=SCWE(I6/LB_E+BCOR_NOIS_E+I5) - END DO - END IF -C -C Read and possibly write IF data, if written: save pointer in SCH -C - IF (.NOT.NSCLIF(IMCA,OHWJ(I4+SET_NSH_J),IFHJ,IFHE,STHJ, - 1 VS,FVERS,BECODE,SFREQ,BINT, - 1 TPBUF,DBUF,OBUF)) GOTO 600 !READ AND WRITE IF SET - IF (IFSETS.GT.0) - 1 CALL WNCTXT(F_TP,'!7C\Ch. !3$UI: IF data written', - 1 IFHI(IFH_CHAN_I)) - END IF -C -C If channel not selected: do not load polarisation sets -C - IF (.NOT.THIS_CHAN) GOTO 40 -C -C Select Polarisation -C - IF ((OHWI(I2+SET_DATYP_1/LB_I).EQ.IXX .AND. POLS(0).GT.0) .OR. - 1 (OHWI(I2+SET_DATYP_1/LB_I).EQ.IXY .AND. POLS(1).GT.0) .OR. - 1 (OHWI(I2+SET_DATYP_1/LB_I).EQ.IYX .AND. POLS(2).GT.0) .OR. - 1 (OHWI(I2+SET_DATYP_1/LB_I).EQ.IYY .AND. POLS(3).GT.0)) THEN - IF (I3.EQ.OHWI(I2+SET_BANDNR_I)) THEN !MORE POL. - IF (.NOT.NSCLRD(IMCA,OHWJ(I4+SET_NSH_J),FCAT, - 1 VS,FVERS,BECODE,SFREQ,BINT,INTOFF(J1),ONS, - 1 OHAB,NIFR,IFRT,STHJ,STHE,STHD,DWELT,SPLIT, - 1 TSYS,FWGT,IFHJ,IFHE,TPBUF,OBUF, - 1 DBUF,TMPBUF)) GOTO 600 !READ A CHAN. - ELSE !NEW CHANNEL - IF (NIFR.GT.0) THEN !SOME TO WRITE - IF (FWGT.NE.0) THEN - STHE(STH_WFAC_E)=1.-FWGT/255.*4.*OINT* - 1 MTSYS*MTSYS/2.56/2.56 - FWGT=255./FWGT !TO MAKE < 256 - ELSE - STHE(STH_WFAC_E)=1.-FWGT - END IF - IF (.NOT.NSCLWD(FCAT,ONS,OHAB,NIFR,IFRT,POLS, - 1 BINT,STH(0),MJDHA0,SPLIT,J1, - 1 OHWI(OHW_MSNP_I),OHP1,I3,DWELT,FSPLIT, - 1 RACMOS,FRCMOS,FWGT,OBUF,TMPBUF)) GOTO 600 - END IF - I3=OHWI(I2+SET_BANDNR_I) !NEW TEST VALUE - ONS(1)=-1 !NEW CHANNEL - NIFR=0 !NO IFRS YET - FWGT=0 !NO WEIGHT YET - IF (.NOT.NSCLRD(IMCA,OHWJ(I4+SET_NSH_J),FCAT, - 1 VS,FVERS,BECODE,SFREQ,BINT,INTOFF(J1),ONS, - 1 OHAB,NIFR,IFRT,STHJ,STHE,STHD,DWELT,SPLIT, - 1 TSYS,FWGT,IFHJ,IFHE,TPBUF,OBUF, - 1 DBUF,TMPBUF)) GOTO 600 !READ A CHAN. - END IF - END IF - 40 CONTINUE - END DO - IF (NIFR.GT.0) THEN !SOME TO WRITE - IF (FWGT.NE.0) THEN - STHE(STH_WFAC_E)=1.-FWGT/255.*4.*OINT* - 1 MTSYS*MTSYS/2.56/2.56 - FWGT=255./FWGT !TO MAKE < 256 - ELSE - STHE(STH_WFAC_E)=1.-FWGT - END IF - IF (.NOT.NSCLWD(FCAT,ONS,OHAB,NIFR,IFRT,POLS, - 1 BINT,STH(0),MJDHA0,SPLIT,J1, - 1 OHWI(OHW_MSNP_I),OHP1,I3,DWELT,FSPLIT, - 1 RACMOS,FRCMOS,FWGT,OBUF,TMPBUF)) GOTO 600 - END IF -C -C FINISH OH -C - 600 CONTINUE - IF (VS.GE.59 .AND. OHWJ(OHW_NOHN_J).GT.0) THEN !MORE OH - J2=OHWJ(OHW_NOHN_J)*FDWI(FDW_LRCRD_I) !POINTER NEXT OH - IF (NPTC(J1).LT.0) THEN !DO ALL OH'S - GOTO 50 - ELSE - DO I=1,NPTC(J1) - IF (IPTC(I,J1).GT.J3) GOTO 50 !STILL MORE TO DO - END DO - END IF - END IF -C -C FINISH LABEL -C - 700 CONTINUE - CALL WNFCL(IMCA) !CLOSE LABEL - GOTO 10 !NEXT LABEL -C -C FINISH JOB -C - 800 CONTINUE - GOTO 30 !NEXT JOB -C -C READY -C - 900 CALL WNFCL(IMCA) !CLOSE INPUT - CALL WNFDMO(IMCA) !DISMOUNT INPUT - CALL WNFCL(FCAT) !CLOSE/DELETE TMP FILE - IF (OUT) THEN - CALL NSCPFH(F_TP,FCAOUT) !SHOW FILE HEADER - CALL NSCPFL(F_TP,FCAOUT,NODOUT,.FALSE.) !SHOW LAYOUT - CALL WNFCL(FCAOUT) !CLOSE OUTPUT - END IF -C - RETURN !READY -C -C - END diff --git a/src/nscan/nsclrd.for b/src/nscan/nsclrd.for deleted file mode 100644 index e42c5814e5fcc69f0c2474cb0e30995b5dabb529..0000000000000000000000000000000000000000 --- a/src/nscan/nsclrd.for +++ /dev/null @@ -1,512 +0,0 @@ -C+ NSCLRD.FOR -C WNB 900226 -C -C Revisions: -C WNB 910513 System 52 error -C WNB 910930 Cater for variable integration time in non-mozaick -C HjV 920520 HP does not allow extended source lines -C WNB 920815 Add DWELT argument -C WNB 920816 Add SPLIT argument -C WNB 920818 Add Tsys weights -C WNB 920828 Update velocity and frequency for line -C WNB 930604 Change weight/flagging, add FWGT -C WNB 930618 Correction weight scales for OF -C WNB 930621 Correct weight for UF -C WNB 930803 New OFFSET definitions for RECORD -C JPH 931213 Report which ifr in case of Format error; comments -C HjV 940407 Correct for 'older' tape-versions (= <6) -C CMV 940418 Correct test on DCB bandwidth -C CMV 940518 Correct frequency -C CMV 940815 Correct bandwidth (SFREQ*0.0001, not 0.00001) -C CMV 940830 Save WSRT applied gain corrections -C CMV 941121 Add entry NSCLR2 to get DWELT and DRADT -C CMV 950307 Correct AOTH correction if telescopes deleted -C HjV 950424 Check if IF is present -C CMV 960910 Also use band 8 for DCB if FVERS<46.... -C -C - LOGICAL FUNCTION NSCLRD(INFCA,SHP,FCAT,VS,FVERS,BECODE,SFREQ, - 1 BINT,HABOFF,ONS,OHAB,NIFR,IFRT,STHJ, - 1 STHE,STHD,DWELT,SPLIT,TSYS,FWGT, - 1 IFHJ,IFHE,TPBUF,OBUF,DBUF,TMPBUF) -C -C Read WSRT data into TMP file -C -C Result: -C -C NSCLRD_J = NSCLRD( INFCA_J:I, SHP_J:I, FCAT_J:I, VS_J:I, -C FVERS_J:I, BECODE_C(4):I, SFREQ_J:I, -C BINT_J:I, HABOFF_E:I, ONS_J(6):IO, OHAB_E:IO, -C NIFR_J:IO, IFRT_J(9,0:*):IO, -C STHJ_J(0:*):IO, STHE_E(0:*):IO, STHD_D(0:*):IO, -C DWELT_J:O, SPLIT_L:I, TSYS_E(0:1,0:*):I, FWGT_E:IO, -C IFHJ_J(0:*):I,IFHE_E(0:*):I, -C TPBUF_I(2,0:1,0:STHTEL-1,0:*):I, -C OBUF_E(0:1,0:STHTEL-1,0:*):O, -C DBUF_I(2,0:*):I, TMPBUF_I(3:0:*)) -C Read WSRT data from tape/disk to TMP file. -C INFCA indicates the file to read, SHP the -C record number of the SH block. FCAT is the -C TMP file; VS the software version (e.g.42). -C FVERS the tape version. -C BECODE the Back-End code (e.g. DLB). -C SFREQ is spacing frequency points. -C BINT is the basic integration time (10 s). -C HABOFF gives the start of integration. -C ONS gives the integration data, OHAB the -C start HA of the output. If ONS(1)<0 the -C start of a new channel is indicated. -C NIFR is the number of inetrferometers found, -C IFRT describes the interferometers. -C STH is the template set header -C DWELT is returned from IH -C SPLIT indicates normal(GM or NM type) -C TSYS are the X,Y 1/Tsys weights for telescopes. -C FWGT the max. value of all integration times -C IFHJ and IFHE are the IF-header for TPBUF -C TPBUF contains total power data -C DBUF is an input buffer, TMBUF is used for -C writing, OBUF returns the AOTH corrections. -C -C NSCLR2_J = NSCLR2( INFCA_J:I, SHP_J:I, -C VS_J:I, FVERS_J:I, BECODE_C(4):I, SFREQ_J:I, -C DWELT2_J:O, DRADT2_J:O) -C -C Just read SH and IH to get DWELT and DRADT -C -C -C Include files: -C - INCLUDE 'WNG_DEF' - INCLUDE 'NSC_DEF' - INCLUDE 'SHW_O_DEF' !SH BLOCK - INCLUDE 'SHW_T_DEF' - INCLUDE 'IHW_O_DEF' !IH BLOCK - INCLUDE 'IHW_T_DEF' - INCLUDE 'STH_O_DEF' !SET HEADER - INCLUDE 'IFH_O_DEF' !IF-SET HEADER -C -C Parameters: -C -C -C Entry points: -C - LOGICAL NSCLR2 !GET DWELT AND DRADT -C -C Arguments: -C - INTEGER INFCA !INPUT FILE DESCRIPTOR - INTEGER SHP !RECORD # SH BLOCK - INTEGER FCAT !TMP OUTPUT FILE DESCRIPTOR - INTEGER VS !TAPE SOFTWARE VERSION - INTEGER FVERS !TAPE FORMAT VERSION - CHARACTER*4 BECODE !BACKEND CODE - INTEGER SFREQ !SFREQ FROM OH - INTEGER BINT !BASIC INTEGRATION IN SEC - REAL HABOFF !INTEGRATION START OFFSET - INTEGER ONS(6) !INTEGRATION DATA - REAL OHAB !START HA - INTEGER NIFR !# OF IFRS FOUND - INTEGER IFRT(9,0:*) !IFR DESCRIPTION - INTEGER STHJ(0:*) !SET HEADER - REAL STHE(0:*) - REAL*8 STHD(0:*) - INTEGER DWELT !DWELL TIME - LOGICAL SPLIT - REAL TSYS(0:1,0:*) !1/TSYS - REAL FWGT !MAX. INT. TIMES - INTEGER IFHJ(0:*) !IF-Header - REAL IFHE(0:*) !IF-Header - INTEGER*2 TPBUF(2,0:1,0:STHTEL-1,0:MXDATN-1) !BUFFER FOR IF-DATA - INTEGER*2 DBUF(2,0:MXDATN-1) !INPUT BUFFER - REAL*4 OBUF(0:1,0:STHTEL-1,0:MXDATN-1) !OUTPUT BUFFER FOR AOTH - INTEGER*2 TMPBUF(3,0:MXDATX-1) !OUTPUT BUFFER FOR WRITING -C - INTEGER DWELT2 !OUTPUT FOR NSCLR2 - INTEGER DRADT2 -C -C Function references: -C - LOGICAL WNFRD !READ DATA - LOGICAL WNFWR !WRITE DATA - INTEGER WNFEOF !FILE POSITION -C -C Data declarations: -C - LOGICAL MOS_ONLY !JUST GET DWELT/DRADT (NSCLR2) - REAL SUMC,SUMS !INTEGRATE - INTEGER N !# OF INTEGRATED POINTS - REAL GBUF(0:1,0:STHTEL-1,4) !INTEGRATE GAINS - REAL SFAC !DATA SCALE - INTEGER NS(-6:6) !INTEGRATION DATA - REAL HAB !START HA - REAL WFAC !WEIGHT FACTOR - INTEGER WEXP !WEIGHT EXPONENTXXX -C - INTEGER*2 DBH_T(2,2) !TRANSLATE DATA - DATA DBH_T/2,0,0,1/ - INTEGER BFJ - REAL BFR - EQUIVALENCE (BFR,BFJ) - INTEGER*2 BF_T1(2,2) - DATA BF_T1(1,1),BF_T1(2,1)/3,1/ - DATA BF_T1(1,2),BF_T1(2,2)/0,1/ - INTEGER*2 BF_T2(2,2) - DATA BF_T2(1,1),BF_T2(2,1)/4,1/ - DATA BF_T2(1,2),BF_T2(2,2)/0,1/ -C - BYTE SHW(0:SHWHDL-1) !SH RECORD - INTEGER*2 SHWI(0:SHWHDL/2-1) - INTEGER SHWJ(0:SHWHDL/4-1) - REAL SHWE(0:SHWHDL/4-1) - EQUIVALENCE (SHW,SHWI,SHWJ,SHWE) - BYTE IHW(0:IHWHDL-1) !IH RECORD - INTEGER*2 IHWI(0:IHWHDL/2-1) - INTEGER IHWJ(0:IHWHDL/4-1) - REAL IHWE(0:IHWHDL/4-1) - EQUIVALENCE (IHW,IHWI,IHWJ,IHWE) -C- -C -C INIT -C - MOS_ONLY=.FALSE. - GOTO 100 -C - ENTRY NSCLR2(INFCA, SHP, VS, FVERS, BECODE, SFREQ, - 1 DWELT2, DRADT2) -C - MOS_ONLY=.TRUE. -C - 100 CONTINUE -C - NSCLRD=.TRUE. !ASSUME OK - DBH_T(2,1)=2*MXDATN !ENOUGH TRANSLATION - IF (.NOT.WNFRD(INFCA,SHWHDL,SHW,SHP*SRTRCL)) THEN !READ SH BLOCK - CALL WNCTXT(F_TP,'!/Read error SH block #!UJ (!XJ)', - 1 SHP,E_C) - GOTO 900 !FINISH - END IF - IF (IBMSW) CALL WNTTIL(SHWHDL,SHW,SHW_T) !TRANSLATE - IF (DECSW) CALL WNTTDL(SHWHDL,SHW,SHW_T) - IF (SHWI(SHW_CBI_I).NE.32767 .OR. - 1 SHW(SHW_CBT_1).NE.ICHAR('S') .OR. - 1 SHW(SHW_CBT_1+1).NE.ICHAR('H')) THEN - CALL WNCTXT(F_TP,'!/Cannot find SH block #!UJ',SHP) - GOTO 900 - END IF - SHWJ(SHW_LSH_J)=SHWHDL !LENGTH SH -C -C REPAIR SH -C - IF (FVERS.LT.2) THEN !REPAIR BFREQ - BFJ=SHWJ(SHW_BFREQ_J) - IF (IBMSW) CALL WNTTLI(LB_J,BFJ,BF_T1) - IF (DECSW) CALL WNTTLD(LB_J,BFJ,BF_T1) - IF (IBMSW) CALL WNTTIL(LB_J,BFR,BF_T2) - IF (DECSW) CALL WNTTDL(LB_J,BFR,BF_T2) - SHWJ(SHW_BFREQ_J)=NINT(BFR*65536.) - END IF - IF (FVERS.LT.3) SHWI(SHW_STIM_I)=SHWI(SHW_STIM_I)*6 - IF (FVERS.LT.6) SHWI(SHW_BANDNR_I)=(SHWI(SHW_BANDNR_I)-1)/4 - IF (VS.LT.46) THEN !FIND WIDTH - IF (BECODE(1:3).EQ.'DCB') THEN - I1=SHWI(SHW_BANDNR_I)-1 - IF (I1.GE.0.AND.I1.LE.7) THEN !VALID BAND - IF (IAND(SFREQ,2**I1)) THEN !TEST BAND USED - IF (IAND(SFREQ,2**(I1+8))) THEN !TEST BANDWIDTH - SHWE(SHW_WIDTH_E)=5.0 - ELSE - SHWE(SHW_WIDTH_E)=10.0 - END IF - ELSE !NOT USED??? - CALL WNCTXT(F_P,'Band !SJ seems not in use???',I1+1) - SHWE(SHW_WIDTH_E)=10.0 !ASSUME 10 - END IF - ELSE !CONTINUUM, SET TO 10 - SHWE(SHW_WIDTH_E)=10.0 - END IF - ELSE - SHWE(SHW_WIDTH_E)=SFREQ*0.0001 !SFREQ IS IN 0.1 KHZ - END IF - END IF -C -C SAVE SH AND FILL IN STH -C - IF (.NOT.MOS_ONLY) THEN - STHJ(STH_NSH_J)=SHWHDL !SAVE SH BLOCK - STHJ(STH_SHP_J)=WNFEOF(FCAOUT) - IF (.NOT.WNFWR(FCAOUT,SHWHDL,SHW,STHJ(STH_SHP_J))) THEN !SAVE SH - CALL WNCTXT(F_TP,'!/Write error SCN file (!XJ)',E_C) - GOTO 900 - END IF - STHD(STH_FRQ_D)=SHWJ(SHW_BFREQ_J)/65536. !FREQUENCY - STHD(STH_FRQE_D)=SHWJ(SHW_BFREQ_J)/65536. !FREQUENCY EPOCH - STHE(STH_BAND_E)=SHWE(SHW_WIDTH_E) !BANDWIDTH - STHD(STH_FRQV_D)=STHD(STH_FRQ_D) !REAL FREQUENCY LINE - IF (STHJ(STH_VELC_J).LE.0) THEN !CONTINUUM - STHE(STH_VEL_E)=0 !VELOCITY - ELSE !LINE - IF (STHD(STH_FRQV_D).LE.0) - 1 STHD(STH_FRQV_D)=STHD(STH_FRQ_D) !MAKE ONE - IF (STHD(STH_FRQC_D).LE.0) - 1 STHD(STH_FRQC_D)=STHD(STH_FRQ_D) !MAKE ONE - IF (STHJ(STH_VELC_J).EQ.1 .OR. - 1 STHJ(STH_VELC_J).EQ.2) THEN !RADIO - STHE(STH_VEL_E)=STHE(STH_VELR_E)*STHD(STH_FRQV_D)/ - 1 STHD(STH_FRQC_D)+ - 1 CL*(STHD(STH_FRQC_D)-STHD(STH_FRQV_D))/ - 1 STHD(STH_FRQC_D) - ELSE !OPTICAL - STHE(STH_VEL_E)=STHE(STH_VELR_E)*STHD(STH_FRQC_D)/ - 1 STHD(STH_FRQV_D)+ - 1 CL*(STHD(STH_FRQC_D)-STHD(STH_FRQV_D))/ - 1 STHD(STH_FRQV_D) - END IF - END IF - END IF - -C -C READ IFRS -C - DO I=0,SHWI(SHW_NENT_I)-1 !ALL INTERFEROMETERS - I1=SHW_IFR_1+I*SHWI(SHW_LENT_I) !TABLE ENTRY - I2=I1/LB_I !AS I2 - I4=I1/LB_J !AS I4 - J=SHWJ(I4+IFR_NIH_J)*SRTRCL !DISK POINTER IH - IF (.NOT.WNFRD(INFCA,IHWHDL,IHW,J)) THEN !READ IH BLOCK - CALL WNCTXT(F_TP,'!/Read error IH block #!UJ (!XJ)', - 1 J/SRTRCL,E_C) - GOTO 10 !NEXT - END IF - IF (IBMSW) CALL WNTTIL(IHWHDL,IHW,IHW_T) !TRANSLATE - IF (DECSW) CALL WNTTDL(IHWHDL,IHW,IHW_T) - IF (IHWI(IHW_CBI_I).NE.32767 .OR. - 1 IHW(IHW_CBT_1).NE.ICHAR('I') .OR. - 1 IHW(IHW_CBT_1+1).NE.ICHAR('H')) THEN - CALL WNCTXT(F_TP,'!/Cannot find IH block #!UJ',J/SRTRCL) - GOTO 10 - END IF -C -C REPAIR IH -C - IF (FVERS.LT.3) IHWI(IHW_STIM_I)=IHWI(IHW_STIM_I)*6 - IF (VS.LT.53) THEN - IHWE(IHW_INTT_E)=IHWI(IHW_INCT_I) - END IF - IF (VS.LT.60) THEN - IHWI(IHW_DWELT_I)=IHWI(IHW_INCT_I) - IHWI(IHW_DRADT_I)=IHWI(IHW_INCT_I) - END IF - IF (FVERS.LT.2) THEN !UPDATE IFR CODE - I1=NINT(MOD(IHWI(IHW_INFNR_I),40)/2.) !FIXED - I2=NINT(IHWI(IHW_INFNR_I)/40.)+9+MOD(IHWI(IHW_INFNR_I),2) !MOVABLE - IHWI(IHW_INFNR_I)=256*I1+I2 - END IF -C -C IF MOS_ONLY, GET VALUES HERE AND EXIT -C - IF (MOS_ONLY) THEN - DWELT2=IHWI(IHW_DWELT_I) - DRADT2=IHWI(IHW_DRADT_I) - RETURN !DIRTY WAY TO JUMP OUT OF LOOP - END IF -C -C DETERMINE STEPS -C - DWELT=IHWI(IHW_DWELT_I) !DWELL TIME - IF (VS.EQ.52) THEN !FORMAT ERROR SYSTEM 52 - IHWI(IHW_INCT_I)=NINT(IHWE(IHW_DHA_E)/CVUTST* - 1 240.*360.) !UT STEP IN SECONDS - END IF - IF (VS.EQ.42) THEN !TAPE FORMAT ERROR SYSTEM 42 - SFAC=1. - ELSE - SFAC=2.E0**FLOAT(IHWI(IHW_NEXP_I))*FLOAT(IHWI(IHW_FSCAL_I)) !SCALE - END IF - NS(-3)=NINT(HABOFF/BINT) !START INTEGRATION OFFSET - NS(0)=IHWI(IHW_INCT_I)/BINT !INPUT INTEGRATION POINTS - NS(-1)=IHWI(IHW_NDATP_I) !INPUT DATA POINTS - NS(1)=OINT/BINT !OUTPUT INTEGRATION POINTS - IF (VS.GE.59 .OR. .NOT.SPLIT) THEN !MOSAIC - NS(-2)=DWELT/BINT !DWELL TIME - NS(3)=IHWI(IHW_DRADT_I)/BINT !TIME BETWEEN RADIALS - IF (NS(-2).EQ.NS(0)) THEN !NO MOSAIC - NS(-2)=IHWI(IHW_NDATP_I)*NS(0) - NS(3)=NS(-2) - END IF - ELSE !NO MOSAIC - NS(-2)=IHWI(IHW_NDATP_I)*NS(0) - NS(3)=NS(-2) - END IF - IF (NS(-2)-NS(-3).LT.NS(1)) THEN !INTEGRATION TOO LONG - CALL WNCTXT(F_TP,'Dwell time (!UJ s) less than '// - 1 'integration time (!UJ s)', - 2 (NS(-2)-NS(-3))*BINT,NS(1)*BINT) - GOTO 900 - END IF - NS(2)=NS(-1)/(NS(-2)/NS(0)) !# OF SUBSETS - NS(4)=(NS(-2)-NS(-3))/NS(1) !# OUTPUT DWELL POINTS - NS(5)=NS(2)*NS(4) !# OUTPUT DATAPOINTS - NS(6)=0 !TMP DISK POINTER - HAB=IHWE(IHW_HAB_E)+CVUTST*((NS(1)-NS(0))/2.+NS(-3))* - 1 BINT/24./3600. !START HA -C -C READ/CHECK DATA -C - IF (.NOT.WNFRD(INFCA,NS(-1)*4,DBUF, - 1 J+SRTRCL*IHWJ(IHW_LIH_J))) THEN !READ DB BLOCK - CALL WNCTXT(F_TP,'!/Read error DB block #!UJ (!XJ)', - 1 J/SRTRCL,E_C) - GOTO 10 !NEXT - END IF - IF (IBMSW) CALL WNTTIL(NS(-1)*4,DBUF,DBH_T) !TRANSLATE - IF (DECSW) CALL WNTTDL(NS(-1)*4,DBUF,DBH_T) - IF (ONS(1).LT.0) THEN !NEW CHANNEL - CALL WNGMVZ(2*STHTEL*MXDATN,OBUF) !CLEAR AOTH BUFFER - DO I1=1,6 - ONS(I1)=NS(I1) !SAVE DATE - END DO - OHAB=HAB - ELSE - DO I1=1,5 - IF (ONS(I1).NE.NS(I1)) THEN !FORMAT ERROR - IF (I1.EQ.3 .AND. NS(2).EQ.1) THEN !ACCEPT WRONG OBS. LENGTH - ELSE - 20 CALL WNCTXT(F_TP, - 1 '!/Format error DB block #!UJ, interferometer !1$XI!1$XI', - 1 J/SRTRCL,IHWI(IHW_WTEL_I),IHWI(IHW_OTEL_I)) - GOTO 10 !NEXT - END IF - END IF - END DO -C Check for correct HAB; a margin of .1 sec is accepted to account for precision -C effects on different machines; the corresponding rotation of 1.15E-6 circles -C is acceptable (Email WNB to JPH, 931214) - IF (ABS(OHAB-HAB).GE.0.1E0/24./3600.) GOTO 20 - END IF -C -C MAKE entry for this polarisation and ifr in temporary IFR TABLE -C - DO I1=0,NIFR-1 !CHECK PRESENCE - IF (IFRT(1,I1).EQ.IHWI(IHW_WTEL_I) .AND. - 1 IFRT(2,I1).EQ.IHWI(IHW_OTEL_I)) THEN !FOUND - I2=MOD(IHWI(IHW_INFNR_I)/256,2)*2+ - 1 MOD(IHWI(IHW_INFNR_I),2) !POL. # - IFRT(3+I2,I1)=ONS(6)/NS(5)/6 !TMP LINE # - GOTO 30 - END IF - END DO - IFRT(1,NIFR)=IHWI(IHW_WTEL_I) !WEST TEL. - IFRT(2,NIFR)=IHWI(IHW_OTEL_I) !EAST TEL. - IF (IFRT(1,NIFR).GT.IFRT(2,NIFR)) GOTO 10 !FORGET INVERTED IFR - IF (IFRT(2,NIFR).GE.STHTEL) GOTO 10 !FORGET DUMMY INTERFEROMETERS - DO I2=3,6 !SET NO POL. - IFRT(I2,NIFR)=-1 - END DO - I2=MOD(IHWI(IHW_INFNR_I)/256,2)*2+MOD(IHWI(IHW_INFNR_I)*1,2) !POL. # - IFRT(3+I2,NIFR)=ONS(6)/NS(5)/6 !TMP LINE # - IFRT(7,NIFR)=NINT(IHWE(IHW_DRT_E)) !BASELINE - NIFR=NIFR+1 !COUNT # IFRS - 30 CONTINUE -C -C MAKE OUTPUT BUFFER -C - R0=TSYS(MOD(IHWI(IHW_INFNR_I)/256,2), - 1 IHWI(IHW_WTEL_I))* - 1 TSYS(MOD(IHWI(IHW_INFNR_I)*1,2), - 1 IHWI(IHW_OTEL_I)) !TSYS WEIGHT - R0=R0/4./NS(1) !FIT SCALE - DO I1=0,NS(2)-1 !SUBSETS - J1=I1*NS(-2)+NS(-3) !INPUT DATA PTR - J2=I1*NS(4) !OUTPUT BUF PTR - DO I2=0,NS(4)-1 !OUTPUT POINTS PER DWELL - SUMC=0 !INTEGRATE - SUMS=0 - N=0 -C - IF (NIFR.EQ.1 .AND. IFHJ(IFH_TPINT_J).NE.0) THEN !FIND GAINCORRECTIONS - DO I5=0,STHTEL-1 - DO I4=0,1 - GBUF(I4,I5,1)=0 - END DO - END DO - END IF -C - DO I3=0,NS(1)-1 !# OF 10 SEC OUTPUT INTEGRAT. - J3=J1/NS(0) !DATA POINT - IF (DBUF(1,J3).NE.IUND .AND. DBUF(2,J3).NE.IUND) THEN - SUMC=SUMC+SFAC*DBUF(1,J3) !ADD - SUMS=SUMS+SFAC*DBUF(2,J3) - N=N+1 - END IF -C -C For first ifr, average gaincorrections -C - IF (NIFR.EQ.1 .AND. IFHJ(IFH_TPINT_J).NE.0) THEN - J3=J3*IHWI(IHW_INCT_I)/IFHJ(IFH_TPINT_J) !TPBUF offset - CALL NSCGGN(GBUF(0,0,2),GBUF(0,0,3),GBUF(0,0,4), - 1 IFHJ,STHJ,TPBUF(1,0,0,J3)) - DO I5=0,STHTEL-1 - DO I4=0,1 - GBUF(I4,I5,1)=GBUF(I4,I5,1)+GBUF(I4,I5,2) - END DO - END DO - END IF -C - J1=J1+1 !NEXT 10 SEC - END DO -C -C Save AOTH data regardless of this point being ok for this ifr -C - IF (NIFR.EQ.1 .AND. IFHJ(IFH_TPINT_J).NE.0) THEN !STORE AOTH correction - DO I5=0,STHTEL-1 - DO I4=0,1 - OBUF(I4,I5,J2)=LOG(ABS(NS(1)/GBUF(I4,I5,1))) - END DO - END DO - END IF -C - IF (N.EQ.NS(1)) THEN !OK POINT - TMPBUF(2,J2)=NINT(SUMC/N) !OUTPUT DATA - TMPBUF(3,J2)=NINT(SUMS/N) - R1=MIN(MAX(N,NS(0))*R0,127.*256.) !TIME+TSYS WEIGTH - FWGT=MAX(FWGT,R1) !SAVE MAX. - TMPBUF(1,J2)=NINT(R1) !TIME+TSYS WEIGHT - ELSE - DO I3=1,3 - TMPBUF(I3,J2)=0 !ZERO WEIGHT - END DO - END IF - J2=J2+1 !NEXT OUTPUT PTR - END DO - END DO - IF (.NOT.WNFWR(FCAT,NS(5)*6,TMPBUF,ONS(6))) THEN !WRITE TO TMP - CALL WNCTXT(F_TP, - 1 '!/Write error TMP file, IH block #!UJ (!XJ)', - 1 J/SRTRCL,E_C) - GOTO 10 !NEXT - END IF - ONS(6)=ONS(6)+NS(5)*6 !NEXT OUTPUT PTR - 10 CONTINUE - END DO -C - RETURN !READY -C -C ERROR FINISH -C - 900 CONTINUE - NSCLRD=.FALSE. -C - RETURN -C -C - END - - - - - - - - - diff --git a/src/nscan/nsclwd.for b/src/nscan/nsclwd.for deleted file mode 100644 index ed8af006730b3c5688486a03206d8e023c4a0810..0000000000000000000000000000000000000000 --- a/src/nscan/nsclwd.for +++ /dev/null @@ -1,426 +0,0 @@ -C+ NSCLWD.FOR -C WNB 900304 -C -C Revisions: -C HjV 920520 HP does not allow extended source lines -C WNB 920808 Correct description -C WNB 920814 Moved some from NSCLOD -C WNB 920814 Add splitting -C WNB 920815 More splitting -C WNB 920817 More splitting -C WNB 920828 Update for line velocity and frequency -C WNB 920829 Change logics for speed in splitting -C WNB 920901 Increase buffer -C WNB 930604 New weight system, add FWGT -C WNB 930625 Cater for weight UF -C HjV 960618 Change length to read for OH -C - LOGICAL FUNCTION NSCLWD(FCAT,ONS,OHAB,NIFR,IFRT,POLS,BINT,STHM, - 1 MJDHA0,SPLIT,CJOB,MSNP,OHP,BAND, - 1 DWELT,FSPLIT,RACMOS,FRCMOS,FWGT, - 1 OBUF,TMPBUF) -C -C Unload TMP file into SCN files -C -C Result: -C -C NSCLWD_J = NSCLWD( FCAT_J:I, -C ONS_J(6):I, OHAB_E:I, -C NIFR_J:I, IFRT_J(9,0:*):I, POLS_J(0:3):I, -C BINT_J:I, STHM_B(0:*):I, MJDHA0_D:I, -C SPLIT_L:I, CJOB_J:I, MSNP_I:I, OHP_J(*):I, -C BAND_J:I, DWELT_J:I, FSPLIT_L:IO, -C RACMOS_D:I, FRCMOS_D:I, FWGT_E:I, -C OBUF_E(0:1,0:STHTEL-1,0:*):I,TMPBUF_I(3,0:*):I) -C Read WSRT data from TMP file to FCAOUT. -C FCAT is the TMP file. -C ONS gives the integration data, OHAB the -C start HA of the output. -C ONS: 1 # of 10 sec per output point -C 2 # of subsets -C 3 time between radials in 10 sec units -C 4 # of points per subset -C 5 total output points per ifr -C 6 length of TMP file -C IFRT: 1 West telescope -C 2 East telescope -C 3 TMP line # XX -C 4 XY -C 5 YX -C 6 YY -C 7 baseline in m -C NIFR is the number of interferometers found, -C IFRT describes the interferometers. -C POLS indicates (if >0) polarisation to do. -C BINT is the basic time increment in s. -C STHM is a template set header. -C MJDHA0 is the MJD for HA=0 -C SPLIT .true. if normal (GM or NM) -C CJOB current job -C MSNP number of mosaic fields in pattern -C OHP gives pointer to proper OH blocks -C BAND the current band -C DWELT the current dwell time -C FSPLIT if first channel of OM type -C RACMOS RA of mosaic centre -C FRCMOS freq. of mosaic centre -C FWGT factor to limit weight < 256 -C OBUF has AOTH corrections, -C TMPBUF is an input buffer -C -C Include files: -C - INCLUDE 'WNG_DEF' - INCLUDE 'NSC_DEF' - INCLUDE 'GFH_O_DEF' !GENERAL FILE HEADER - INCLUDE 'OHW_O_DEF' !OH BLOCK - INCLUDE 'SCH_O_DEF' !SCAN HEADER - INCLUDE 'STH_O_DEF' !SET HEADER - INCLUDE 'SGH_O_DEF' !SUB-GROUP HEADER -C -C Parameters: -C -C -C Arguments: -C - INTEGER FCAT !TMP FILE DESCRIPTOR - INTEGER ONS(6) !INTEGRATION DATA - REAL OHAB !START HA - INTEGER NIFR !# OF IFRS FOUND - INTEGER IFRT(9,0:*) !IFR DESCRIPTION - INTEGER POLS(0:3) !POLARISATION TABLE - INTEGER BINT !BASIC TIME INCREMENT - BYTE STHM(0:*) !TEMPLATE SET HEADER - DOUBLE PRECISION MJDHA0 !MJD AT HA0 - LOGICAL SPLIT !INDICATE GM OR NM - INTEGER CJOB !CURRENT JOB - INTEGER*2 MSNP !# OF PATTERN POSITIONS - INTEGER OHP(-1:MXNMOS-1) !OH BLOCK POINTERS - INTEGER BAND !CURRENT BAND NUMBER - INTEGER DWELT !DWELL TIME - LOGICAL FSPLIT !FIRST CHANNEL IF OM TYPE - DOUBLE PRECISION RACMOS !RA CENTRE MOSAIC - DOUBLE PRECISION FRCMOS !FREQ. CENTRE MOSAIC - REAL FWGT !FACTOR TO LIMIT WGTS TO < 256 - REAL*4 OBUF(0:1,0:STHTEL-1,0:MXDATN-1) !OUTPUT BUFFER FOR AOTH - INTEGER*2 TMPBUF(0:2,0:MXDATX-1) !SORT BUFFER -C -C Function references: -C - REAL WNGENF !NORMALISE ANGLE - LOGICAL WNFRD !READ DATA - LOGICAL WNFWR !WRITE DATA - INTEGER WNFEOF !CURRENT EOF POINTER - LOGICAL WNDLNK !LINK A SET - LOGICAL WNDLNG,WNDLNF !LINK A SUB-GROUP -C -C Data declarations: -C - INTEGER TMPF,TMPL !1ST AND LAST POINT/LINE IN TMP - INTEGER TMPS !# OF POINTS/LINE IN TMP BUF - INTEGER*2 ODBUF(0:2,0:4*MXNIFR-1) !OUTPUT DATA BUF - INTEGER IFRTS(9,0:MXNIFR-1) !SORTED IFR DATA - BYTE IFRTP(0:MXNIFR-1) !POL. IFR PRESENCE - REAL MX !FOR MAX. CALCULATION - INTEGER IFRP !POINTER TO IFR TABLE - INTEGER*2 IFRS(0:MXNIFR-1) !COMPRESSED IFR TABLE - INTEGER CFLD !CURRENT MOSAIC FIELD - BYTE DOFLD(MXNMOS) !FIELDS SELECTED - BYTE STH(0:STHHDL-1) !SET HEADER - INTEGER*2 STHI(0:STHHDL/2-1) - INTEGER STHJ(0:STHHDL/4-1) - REAL STHE(0:STHHDL/4-1) - REAL*8 STHD(0:STHHDL/8-1) - EQUIVALENCE (STH,STHI,STHJ,STHE,STHD) - BYTE SCH(0:SCHHDL-1) !SCAN HEADER - INTEGER*2 SCHI(0:SCHHDL/2-1) - INTEGER SCHJ(0:SCHHDL/4-1) - REAL SCHE(0:SCHHDL/4-1) - REAL*8 SCHD(0:SCHHDL/8-1) - EQUIVALENCE (SCH,SCHI,SCHJ,SCHE,SCHD) - BYTE OHW(0:OHWHDL-1) !OH BLOCK - INTEGER*2 OHWI(0:OHWHDL/2-1) - INTEGER OHWJ(0:OHWHDL/4-1) - REAL OHWE(0:OHWHDL/4-1) - REAL*8 OHWD(0:OHWHDL/8-1) - EQUIVALENCE (OHW,OHWI,OHWJ,OHWE,OHWD) - INTEGER NL1 -C- -C -C INIT -C - NSCLWD=.TRUE. !ASSUME OK - DO I=0,NIFR-1 !COPY IFRT - DO I1=1,9 - IFRTS(I1,I)=IFRT(I1,I) - END DO - END DO - DO I=0,NIFR-2 !SORT IFR ON BASELINE - DO I1=0,NIFR-2-I - IF (IFRTS(7,I1).GT.IFRTS(7,I1+1)) THEN !MOVE ENTRY - DO I2=1,9 - J=IFRTS(I2,I1) - IFRTS(I2,I1)=IFRTS(I2,I1+1) - IFRTS(I2,I1+1)=J - END DO - END IF - END DO - END DO - DO I=0,NIFR-1 !MAKE IFR OUTPUT TABLE - IFRS(I)=IFRTS(1,I)+256*IFRTS(2,I) - END DO - IFRP=WNFEOF(FCAOUT) !POINTER TO IFR TABLE - IF (.NOT.WNFWR(FCAOUT,NIFR*LB_I,IFRS(0),IFRP)) GOTO 10 !WRITE IT - DO I=0,3 !MAKE POL. PRESENCE - DO I1=0,NIFR-1 - IF (POLS(I).GT.0 .AND. IFRTS(3+I,I1).NE.-1) THEN !PRESENT - IFRTP(I1)=1 - ELSE !NOT PRESENT - IFRTP(I1)=0 - END IF - END DO - IF (.NOT.WNFWR(FCAOUT,NIFR,IFRTP(0),IFRP+NIFR*(I+LB_I))) - 1 GOTO 10 !WRITE TABLE - END DO -C -C SPLIT DATA -C - IF (.NOT.SPLIT) THEN !OM - DO CFLD=1,MSNP !TRY ALL FIELDS - DOFLD(CFLD)=.FALSE. !ASSUME NOT TO DO - IF (NPTC(CJOB).LT.0) THEN !DO ALL FIELDS - ELSE - DO I=1,NPTC(CJOB) - IF(IPTC(I,CJOB).EQ.CFLD) GOTO 21 !DO THIS FIELD - END DO - GOTO 20 !TRY NEXT FIELD - END IF - 21 CONTINUE - STHJ(STH_OHP_J)=OHP(CFLD-1) !READ PROPER OH - IF (.NOT.WNFRD(FCAOUT,OHP(-1),OHW,OHP(CFLD-1))) GOTO 10 -C -C SPLIT OH FINAL DATA -C - IF (FSPLIT) THEN !FIRST CHANNEL - I3=OHWI(OHW_ETIM_I)-OHWI(OHW_STIM_I) !LENGTH OBS. - IF (I3.LT.0) I3=I3+8640 !24 HRS - I4=OHWI(OHW_MSNP_I)*DWELT/BINT !DRADT - I5=(CFLD-1)*DWELT/BINT !START OFFSET THIS FIELD - IF (I5.GT.I3) GOTO 20 !FIELD NOT PRESENT - OHWI(OHW_STIM_I)=OHWI(OHW_STIM_I)+I5 !START TIME - IF (OHWI(OHW_STIM_I).GE.8640) THEN !NEXT DAY - OHWI(OHW_STIM_I)=OHWI(OHW_STIM_I)-8640 !NORM. - OHWI(OHW_SDAY_I)=OHWI(OHW_SDAY_I)+1 !NEXT DAY - END IF - DO WHILE (I5.LE.I3) !FIND END TIME - IF (I5+DWELT/BINT.LE.I3) THEN !FULL DWELL - OHWI(OHW_ETIM_I)=OHWI(OHW_STIM_I)+I5+DWELT/BINT !MAYBE END - ELSE - OHWI(OHW_ETIM_I)=OHWI(OHW_STIM_I)+I3 !END - END IF - I5=I5+I4 !NEXT OF THIS FIELD - END DO - IF (OHWI(OHW_ETIM_I).GE.8640) !NORM - 1 OHWI(OHW_ETIM_I)=OHWI(OHW_ETIM_I)-8640 - IF (.NOT.WNFWR(FCAOUT,OHP(-1),OHW,OHP(CFLD-1))) GOTO 10 !REWRITE - END IF - DOFLD(CFLD)=.TRUE. !DO THIS FIELD - 20 CONTINUE - END DO !NEXT FIELD - FSPLIT=.FALSE. !INDICATE CHANNEL DONE - END IF -C -C Fill final fields in Sector header, link subgroup -C - NL1=ONS(6)/ONS(5)/6 !# OF LINES IN TMP - TMPL=0 !LAST+1 POINT IN TMP - DO I=0,ONS(2)-1 !ALL SUBSETS - IF (.NOT.SPLIT) THEN !OM TYPE - CFLD=MOD(I,MSNP)+1 !CURRENT FIELD - IF (.NOT.DOFLD(CFLD)) GOTO 30 !SKIP SUBSET - IF (.NOT.WNFRD(FCAOUT,OHP(-1),OHW,OHP(CFLD-1))) GOTO 10 !GET OH - I2=MOD((CFLD-1)+OHWI(OHW_MPOSN_I),OHWI(OHW_MSNP_I)) !TABLE # - IF (.NOT.WNDLNF(SGPH(1)+SGH_LINKG_1,I2,SGH_GROUPN_1,FCAOUT, - 1 SGPH(2),SGNR(2))) GOTO 31 !FIND SUB-GROUP FIELD - END IF - CALL WNGMV(STHHDL,STHM(0),STH(0)) !MAKE SET HEADER - STHI(STH_CHAN_I)=BAND !SET BAND - IF (.NOT.SPLIT) THEN !OM TYPE: MAKE STH - STHJ(STH_OHP_J)=OHP(CFLD-1) !PROPER OH PTR - STHI(STH_PTS_I)=MOD(OHWI(OHW_MPOSN_I)+CFLD-1, - 1 OHWI(OHW_MSNP_I)) !MOZAIC FIELD NUMBER - CALL WNGMV(STH_FIELD_N,OHW(OHW_FIELD_1),STH(STH_FIELD_1)) !NAME - STHD(STH_RA_D)=OHWD(OHW_RA0_D) !RA, DEC APP. - STHD(STH_DEC_D)=OHWD(OHW_DEC0_D) - STHD(STH_RAE_D)=OHWD(OHW_RA1_D) !RA, DEC EPOCH - STHD(STH_DECE_D)=OHWD(OHW_DEC1_D) - END IF - IF (.NOT.WNDLNF(SGPH(2)+SGH_LINKG_1,BAND,SGH_GROUPN_1,FCAOUT, - 1 SGPH(3),SGNR(3))) GOTO 31 !LINK SUB-GROUP CHANNEL - IF (I/MSNP.EQ.0) !SHOW BAND - 1 CALL WNCTXT(F_TP,'!7C\Ch. !3$UJ: !UJ\.!UJ\.!UJ\.!UJ'// - 1 '!32C\F= !10$D15.5 B= !10$E15.5', - 1 BAND,SGNR(0),SGNR(1),SGNR(2),SGNR(3), - 1 STHD(STH_FRQE_D),STHE(STH_BAND_E)) - STHE(STH_HAI_E)=ONS(1)*BINT*CVUTST/3600./24. !INCR. HA - STHE(STH_HAV_E)=STHE(STH_HAI_E) !AVER. HA - IF (SPLIT) THEN !NM OR GM TYPE - STHE(STH_HAB_E)=OHAB+I*ONS(3)*BINT*CVUTST/3600./24. !FIRST HA - R0=WNGENF(STHE(STH_HAB_E)) !START HA - STHD(STH_MJD_D)=MJDHA0+R0/STHD(STH_UTST_D) !START MJD - ELSE !OM - STHE(STH_HAB_E)=OHAB+RACMOS-STHD(STH_RA_D)+ - 1 I*(ONS(3)/OHWI(OHW_MSNP_I))*BINT*CVUTST/3600./24. - STHE(STH_HAB_E)=WNGENF(STHE(STH_HAB_E)) !NORMALISE - STHD(STH_FRQ_D)=STHD(STH_FRQ_D)-FRCMOS+OHWD(OHW_FREQ_D) !FREQ. - STHD(STH_FRQE_D)=STHD(STH_FRQE_D)-FRCMOS+OHWD(OHW_FREQ_D) !FREQ. - R0=STHD(STH_RA_D)-RACMOS+STHE(STH_HAB_E) !START TIME - R0=WNGENF(R0) !START TIME - STHD(STH_MJD_D)=MJDHA0+R0/STHD(STH_UTST_D) !START MJD - STHD(STH_FRQV_D)=STHD(STH_FRQ_D) !REAL FREQUENCY LINE - IF (STHJ(STH_VELC_J).LE.0) THEN !CONTINUUM - STHE(STH_VEL_E)=0 !VELOCITY - ELSE !LINE - IF (STHD(STH_FRQV_D).LE.0) STHD(STH_FRQV_D)=STHD(STH_FRQ_D) - IF (STHD(STH_FRQC_D).LE.0) STHD(STH_FRQC_D)=STHD(STH_FRQ_D) - IF (STHJ(STH_VELC_J).EQ.1 .OR. - 1 STHJ(STH_VELC_J).EQ.2) THEN !RADIO - STHE(STH_VEL_E)=STHE(STH_VELR_E)*STHD(STH_FRQV_D)/ - 1 STHD(STH_FRQC_D)+ - 1 CL*(STHD(STH_FRQC_D)-STHD(STH_FRQV_D))/ - 1 STHD(STH_FRQC_D) - ELSE !OPTICAL - STHE(STH_VEL_E)=STHE(STH_VELR_E)*STHD(STH_FRQC_D)/ - 1 STHD(STH_FRQV_D)+ - 1 CL*(STHD(STH_FRQC_D)-STHD(STH_FRQV_D))/ - 1 STHD(STH_FRQV_D) - END IF - END IF - END IF - STHJ(STH_SCN_J)=ONS(4) !# OF SCANS/SUBSET - STHJ(STH_NIFR_J)=NIFR !# OF IFRS - STHJ(STH_IFRP_J)=IFRP !POINTER TO IFR TABLE - STHJ(STH_SCNL_J)=SCHHDL+6*NIFR*STHI(STH_PLN_I) !LENGTH SCAN - CALL NSCCLP(FCAOUT,STH(0),STHE(STH_PHI_E)) !GET PREC. ROT. ANGLE - STHE(STH_PHI_E)=STHE(STH_PHI_E)/PI2 !MAKE CIRCLES - J=WNFEOF(FCAOUT) !POINTER TO SET HEADER - IF (.NOT.WNFWR(FCAOUT,STHHDL,STH(0),J)) - 1 GOTO 10 !WRITE SET HEADER - IF (.NOT.WNDLNK(GFH_LINK_1,J, - 1 STH_SETN_1,FCAOUT)) GOTO 10 !LINK THE SET - IF (.NOT.WNDLNG(SGPH(3)+SGH_LINKG_1,J, - 1 SGH_GROUPN_1,FCAOUT,SGPH(4), - 1 SGNR(4))) THEN !LINK SUB-GROUP - 31 CONTINUE - CALL WNCTXT(F_TP,'!/Cannot link sub-group') - GOTO 900 !STOP - END IF - IF (.NOT.WNFRD(FCAOUT,STHHDL,STH(0),J)) - 1 GOTO 10 !REREAD SET HEADER - STHJ(STH_SCNP_J)=WNFEOF(FCAOUT) !POINTER TO DATA - IF (.NOT.WNFWR(FCAOUT,STHHDL,STH(0),J)) - 1 GOTO 10 !REWRITE SET HEADER -C -C Read scans from temp. file and sort them -C -C The temp. file contains a line for each interferometer. -C -C Each line has a series of output integrations: -C J loops over NS(2) subsets of NS(4) integrations -C I5 loops over NS(4) integrations within the subset. -C -C The total number of integrations is NS(5)=NS(2)*NS(4) -C -C Buffer TMPBUF holds for each interferometer (I2) a number of TMPS -C integrations, which is at most the full file (NS(6) bytes) or the -C remaining data not yet read (NS(4)*NS(2)-TMPF integrations). -C The number of the first integration is TMPF, the number of the next -C integration to read is TMPL. -C -C - J5=0 !SCAN COUNT IN SUBSET - J=I*ONS(4) !OFFSET SUBSET IN LINE - DO I5=0,ONS(4)-1 !OUTPUT SCANS -C -C Refresh buffer if needed -C - IF (J+I5.GE.TMPL) THEN !SCAN NOT IN TMP BUF - TMPF=J+I5 !FIRST POINT IN TMP BUF - TMPS=MIN(MIN(MXDATX,ONS(6)/6)/NL1, - 1 ONS(2)*ONS(4)-TMPF) !POINTS PER LINE - TMPL=TMPS+TMPF !FIRST POINT NOT IN TMP - DO I2=0,NL1-1 !READ ALL LINES - IF (.NOT.WNFRD(FCAT,6*TMPS,TMPBUF(0,I2*TMPS), - 1 6*(TMPF+I2*ONS(5)) )) THEN - CALL WNCTXT(F_TP,'!/Error reading TMP file') - GOTO 900 !STOP - END IF - END DO - END IF -C -C Fill in interferometers for this output scan -C - J3=0 !OUTPUT POINTER - MX=-1E30 !FIND MAX. - CALL WNGMVZ(SCHHDL,SCH(0)) !EMPTY SCAN HEADER - DO I2=0,NIFR-1 !OUTPUT A SCAN - DO I3=0,3 !ALL POLARISATIONS - IF (POLS(I3).GT.0) THEN !THIS POLARIZATION - IF (IFRTS(3+I3,I2).NE.-1) THEN !DATA SEEN - J4=IFRTS(3+I3,I2)*TMPS+J+I5-TMPF !INPUT DATA POINTER - DO I4=0,2 - ODBUF(I4,J3)=TMPBUF(I4,J4) - END DO - IF (ODBUF(0,J3).NE.0) THEN !DATA PRESENT - ODBUF(0,J3)=NINT(ODBUF(0,J3)*FWGT) !MAKE < 256 - IF (ODBUF(0,J3).LE.0) ODBUF(0,J3)=1 !VERY SMALL WEIGHT - MX=MAX(MX,ABS(FLOAT(ODBUF(1,J3)))) - MX=MAX(MX,ABS(FLOAT(ODBUF(2,J3)))) - END IF - ELSE !NO DATA - DO I4=0,2 - ODBUF(I4,J3)=0 - END DO - END IF - J3=J3+1 !CNT OUTPUT POINT - END IF - END DO - END DO - SCHE(SCH_MAX_E)=MX !SAVE MAX. - SCHE(SCH_HA_E)=STHE(STH_HAB_E)+J5*STHE(STH_HAI_E) !SET HA -C -C Store AOTH corrections for this scan -C - DO I2=0,STHTEL-1 - DO I4=0,1 - SCHE(SCH_AOTHC_E+2*(I4+2*I2))=OBUF(I4,I2,J+I5) - END DO - END DO -C -C Write to disk -C - J4=WNFEOF(FCAOUT) !DISK OUTPUT PTR - IF (.NOT.WNFWR(FCAOUT,SCHHDL,SCH(0),J4)) GOTO 10 !OUTPUT SCAN HD. - IF (.NOT.WNFWR(FCAOUT,6*J3,ODBUF(0,0),J4+SCHHDL)) THEN !WRITE SCAN - 10 CONTINUE - CALL WNCTXT(F_TP,'!/Error writing output SCN file') - GOTO 900 !STOP - END IF - J5=J5+1 !COUNT SCAN - END DO !END SCANS - 30 CONTINUE - END DO !END SUBSET -C -C READY -C - RETURN !READY -C -C ERROR FINISH -C - 900 CONTINUE - NSCLWD=.FALSE. -C - RETURN -C -C - END diff --git a/src/nscan/nscmbl.for b/src/nscan/nscmbl.for deleted file mode 100644 index 86e9428d465437640a2edea82ee892f19e06d911..0000000000000000000000000000000000000000 --- a/src/nscan/nscmbl.for +++ /dev/null @@ -1,63 +0,0 @@ -C+ NSCMBL.FOR -C WNB 900306 -C -C Revisions: -C - SUBROUTINE NSCMBL(RTP,NIFR,IFRT,IFS,BASEL) -C -C Make baselines -C -C Result: -C -C CALL NSCMBL( RTP_E(0:*):I, NIFR_J:I, IFRT_I(0:NIFR-1):I, -C IFS_B(0:*,0:*), BASEL_E(0:*) -C Make a baseline table BASEL using the telescope -C positions RTP, and the interferometer table -C IFRT of length NIFR. IFS is a selection table. -C The BASEL will be negative for unselected -C interferometers. -C -C Include files: -C - INCLUDE 'WNG_DEF' - INCLUDE 'STH_O_DEF' !SET HEADER -C -C Parameters: -C -C -C Arguments: -C - REAL RTP(0:*) !TEL. POSITIONS - INTEGER NIFR !# OF INTERFEROMETERS - INTEGER*2 IFRT(0:*) !INTERFEROMETER TABLE - BYTE IFS(0:STHTEL-1,0:STHTEL-1) !SELECTION TABLE - REAL BASEL(0:*) !BASELINE TABLE -C -C Function references: -C -C -C Data declarations: -C -C- - DO I=0,NIFR-1 !MAKE TABLE - J=IFRT(I) !IFR - DO I1=0,NIFR-1 - IF (I1.NE.I .AND. J.EQ.IFRT(I1)) J=-1 - END DO - IF (J.GE.0) THEN - I1=J/256 !E TEL - I2=MOD(J,256) !W TEL - IF (IFS(I1,I2)) THEN - BASEL(I)=RTP(I1)-RTP(I2) - ELSE - BASEL(I)=-1 - END IF - ELSE - BASEL(I)=-1 - END IF - END DO -C - RETURN -C -C - END diff --git a/src/nscan/nscnop.for b/src/nscan/nscnop.for deleted file mode 100644 index 00849d425d0d72de45f35e0cb4d9093893824906..0000000000000000000000000000000000000000 --- a/src/nscan/nscnop.for +++ /dev/null @@ -1,292 +0,0 @@ -C+ NSCNOP.FOR -C WNB 930819 -C -C Revisions: -C -C JEN 960415: Remove condition from NSCCLP call (temporary?) -C - SUBROUTINE NSCNOP -C -C Calculate some new options data in SCN -C -C Result: -C -C CALL NSCNOP will convert a SCN file to contain all proper (new) -C data. Use NSCNVS to make new version -C Data calculated: -C Convert from Stokes -C Rotation angle phi -C Start UT -C Correct MJD if observation stopped -C Parallactic angle -C -C Include files: -C - INCLUDE 'WNG_DEF' - INCLUDE 'NSC_DEF' - INCLUDE 'STH_O_DEF' !SET HEADER - INCLUDE 'SCH_O_DEF' !SCAN HEADER - INCLUDE 'OHW_O_DEF' - INCLUDE 'SCW_O_DEF' -C -C Parameters: -C -C -C Arguments: -C -C -C Function references: -C - LOGICAL WNFRD !READ DATA - LOGICAL WNFWR !WRITE DATA - CHARACTER*32 WNTTSG !PRINT SET NAME - LOGICAL NSCSTH !GET A SET WITH NO VERSION CHECK - LOGICAL NSCSCH !READ SCAN HEADER - LOGICAL NSCSCW !WRITE SCAN HEADER -C -C Data declarations: -C - INTEGER SET(0:7,0:1) !ALL SETS - INTEGER STHP !SET HEADER POINTER - INTEGER SNAM(0:7) !SET NAME - INTEGER TNAM(0:7) !TEST NAME - LOGICAL PNAM !PRINT ASKED - INTEGER*2 IFR(0:STHIFR-1) !IFR LIST - INTEGER SAVE_OHP !Last OH block with Stokes - INTEGER ZWEIGHT(0:1) !Count zeroeth weights - INTEGER*2 LDAT(0:2,0:4*STHIFR-1) !DATA BUFFER - REAL WGT(0:3) !WEIGHT - COMPLEX CDAT(0:3),NDAT(0:3) !DATA - BYTE STH(0:STHHDL-1) !SET HEADER - INTEGER*2 STHI(0:STHHDL/2-1) - INTEGER STHJ(0:STHHDL/4-1) - REAL STHE(0:STHHDL/4-1) - DOUBLE PRECISION STHD(0:STHHDL/8-1) - EQUIVALENCE (STH,STHI,STHJ,STHE,STHD) - BYTE SCH(0:SCHHDL-1) !SCAN HEADER - INTEGER SCHJ(0:SCHHDL/LB_J-1) - REAL SCHE(0:SCHHDL/4-1) - EQUIVALENCE (SCH,SCHJ,SCHE) - BYTE OHW(0:OHWHDL-1) !OH BLOCK - INTEGER*2 OHWI(0:OHWHDL/2-1) - INTEGER OHWJ(0:OHWHDL/4-1) - REAL OHWE(0:OHWHDL/4-1) - DOUBLE PRECISION OHWD(0:OHWHDL/8-1) - EQUIVALENCE (OHW,OHWI,OHWJ,OHWE,OHWD) - BYTE SCW(0:SCWHDL-1) !SC BLOCK - INTEGER*2 SCWI(0:SCWHDL/2-1) - INTEGER SCWJ(0:SCWHDL/4-1) - REAL SCWE(0:SCWHDL/4-1) - DOUBLE PRECISION SCWD(0:SCWHDL/8-1) - EQUIVALENCE (SCW,SCWI,SCWJ,SCWE,SCWD) -C- -C -C INIT -C - DO I=0,7 !SET SET *.*.*.*.*.*.* - DO I1=0,1 - SET(I,I1)=0 - END DO - END DO - SET(0,0)=1 !1 LINE - DO I=0,7 - SET(I,1)=-1 !* - TNAM(I)=-1 !TEST PRINT NAME - END DO - SAVE_OHP=-1 !Impossible pointer -C -C DO ALL SETS -C - DO WHILE (NSCSTH(FCAOUT,SET,STH,STHP,SNAM)) !GET SET - PNAM=.FALSE. !ASSUME NO PRINT - DO I=0,3 - IF (TNAM(I).NE.SNAM(I)) PNAM=.TRUE. !PRINT - END DO - DO I=0,3 - TNAM(I)=SNAM(I) !NEW TEST SET - END DO -C -C GET OH, SC AND IFR -C - IF (STHJ(STH_OHP_J).NE.0) THEN - IF (.NOT.WNFRD(FCAOUT,STHJ(STH_NOH_J),OHW, - 1 STHJ(STH_OHP_J))) GOTO 10 !READ OH - END IF - IF (STHJ(STH_SCP_J).NE.0) THEN - IF (.NOT.WNFRD(FCAOUT,STHJ(STH_NSC_J),SCW, - 1 STHJ(STH_SCP_J))) GOTO 10 !READ SC - END IF - IF (.NOT.WNFRD(FCAOUT,LB_I*STHJ(STH_NIFR_J),IFR, - 1 STHJ(STH_IFRP_J))) GOTO 10 !READ IFRS -C -C MAKE PHI -C NB: Temporarily always called (JEN): -C -CC IF (STHE(STH_PHI_E).EQ.0 .AND. -CC 1 STHJ(STH_NOH_J).GT.216 .AND. -CC 1 STHJ(STH_NSC_J).GT.460) THEN - CALL NSCCLP(FCAOUT,STH(0),STHE(STH_PHI_E)) !MAKE PHI - STHE(STH_PHI_E)=STHE(STH_PHI_E)/PI2 !MAKE CIRCLES - IF (PNAM) CALL WNCTXT(F_TP, - 1 'Sector(s) !AS precession rotation calculated', - 1 WNTTSG(TNAM,0)) -CC END IF -C -C MAKE UTST -C - IF (STHD(STH_UTST_D).EQ.0) THEN !NO UT YET - IF (STHJ(STH_SCP_J).NE.0 .AND. - 1 STHJ(STH_NSC_J).GT.SCW_CUTST_1) THEN !CAN DO - STHD(STH_UTST_D)=1.+SCWD(SCW_CUTST_D) !UT/ST DAY LENGTH - IF (PNAM) CALL WNCTXT(F_TP, - 1 'Sector(s) !AS UT to ST conversion calculated', - 1 WNTTSG(TNAM,0)) - END IF - END IF -C -C MAKE CORRECT MJD -C - IF (STHJ(STH_OHP_J).NE.0 .AND. - 1 STHJ(STH_NOH_J).GT.OHW_LST_1) THEN - D1=OHWD(OHW_JDAY_D)+40000D0-0.5D0 !MJD MIDDLE OBS. - D0=OHWI(OHW_STIM_I)/360.D0/24D0 !START TIME - IF (D0.GT.MOD(D1,1D0)) D1=D1-1D0 !PREVIOUS DAY - D1=D1-MOD(D1,1D0)+D0 !MJD START TIME - D1=D1-(OHWD(OHW_HAST_D)-5D0/3600D0/24D0) !MJD AT HA0 - STHD(STH_MJD_D)=D1+STHE(STH_HAB_E)/ - 1 STHD(STH_UTST_D) !MJD AT START - IF (PNAM) CALL WNCTXT(F_TP, - 1 'Sector(s) !AS MJD calculated', - 1 WNTTSG(TNAM,0)) - END IF -C -C CALCULATE FROM STOKES PARAMETERS -C -C Conversion is done if: - OH Block available -C - OH Block contains STOPAR field -C - STOPAR fiels is 1 -C - All four polarizations present -C Conversion assumes vectors (I,Q,U,V) and converts to XX,XY,YX,YY -C according to parallel dipole equations (no problem since NMAP uses -C same equations and OH block dipole flag is never checked). -C -C Since the STOPAR field is set to 0 after a sector has been processed -C and since multiple sectors share the same OH block, we remember the -C last OH pointer for which conversion needed to be done. -C -C Also output number of zero weigths -C - IF (STHJ(STH_OHP_J).NE.0 .AND. - 1 STHJ(STH_NOH_J).GT.OHW_STOPAR_1) THEN - IF ((OHWI(OHW_STOPAR_I).EQ.1 .OR. !DATA IN STOKES - 1 STH_OHP_J.EQ.SAVE_OHP) .AND. !or old OH block - 1 STHI(STH_PLN_I).EQ.4) THEN !AND ALL POL. -C - SAVE_OHP=STH_OHP_J !Remember pointer - ZWEIGHT(0)=0 - ZWEIGHT(1)=0 -C - DO I=0,STHJ(STH_SCN_J)-1 !ALL SCANS - IF (.NOT.WNFRD(FCAOUT,STHJ(STH_SCNL_J)-SCHHDL, - 1 LDAT,STHJ(STH_SCNP_J)+ - 1 STHJ(STH_SCNL_J)*I+SCHHDL)) GOTO 10 !READ SCAN - DO I1=0,STHJ(STH_NIFR_J)-1 !ALL IFRS - DO I2=0,3 !ALL POL. - WGT(I2)=LDAT(0,4*I1+I2) !WEIGHT - CDAT(I2)=CMPLX(LDAT(1,4*I1+I2),LDAT(2,4*I1+I2)) !DATA - IF (WGT(I2).LT.0 .OR. - 1 WGT(I2).GT.255) THEN - ZWEIGHT(0)=ZWEIGHT(0)+1 - WGT(0)=0. !SET DELETED - END IF - END DO - IF (WGT(0).LE.0) THEN !NO DATA - DO I2=0,3 - WGT(I2)=0. - NDAT(I2)=CMPLX(0.,0.) - END DO - ELSE !MAKE XY - NDAT(0)=CDAT(0)-CDAT(1) - NDAT(1)=-CDAT(2)+CDAT(3)*CMPLX(0.,1.) - NDAT(2)=CDAT(2)+CDAT(3)*CMPLX(0.,1.) - NDAT(3)=CDAT(0)+CDAT(1) - END IF - DO I2=0,3 !CHECK RANGE - IF (ABS(REAL(NDAT(I2))).GE.32767. .OR. - 1 ABS(AIMAG(NDAT(I2))).GE.32767.) THEN !TOO LARGE - ZWEIGHT(1)=ZWEIGHT(1)+1 - WGT(I2)=0. - END IF - END DO - DO I2=0,3 - IF (WGT(0).LE.0.) THEN !DELETED - LDAT(0,4*I1+I2)=0 - LDAT(1,4*I1+I2)=0 - LDAT(2,4*I1+I2)=0 - ELSE !NEW DATA - LDAT(0,4*I1+I2)=WGT(I2) - LDAT(1,4*I1+I2)=NINT(REAL(NDAT(I2))) - LDAT(2,4*I1+I2)=NINT(AIMAG(NDAT(I2))) - END IF - END DO - END DO - IF (.NOT.WNFWR(FCAOUT,STHJ(STH_SCNL_J)-SCHHDL, - 1 LDAT,STHJ(STH_SCNP_J)+ - 1 STHJ(STH_SCNL_J)*I+SCHHDL)) GOTO 10 !WRITE DATA - END DO -C - OHWI(OHW_STOPAR_I)=0 !SET NOT STOKES - IF (.NOT.WNFWR(FCAOUT,STHJ(STH_NOH_J),OHW, - 1 STHJ(STH_OHP_J))) GOTO 10 !WRITE OH -C - IF (ZWEIGHT(0).GT.0) CALL WNCTXT(F_TP, - 1 'Zeroeth !SJ points because weight <0 or >255', - 1 ZWEIGHT(0)) - IF (ZWEIGHT(1).GT.0) CALL WNCTXT(F_TP, - 1 'Zeroeth !SJ points because data out of range', - 1 ZWEIGHT(1)) - IF (PNAM) CALL WNCTXT(F_TP, - 1 'Sector(s) !AS Stokes input converted to XY', - 1 WNTTSG(TNAM,0)) -C - END IF - END IF -C -C CALCULATE PARALLACTIC ANGLE -C - IF (STHJ(STH_INST_J).EQ.1) THEN !ATNF - DO I=0,STHJ(STH_SCN_J)-1 !ALL SCANS - IF (.NOT.NSCSCH(FCAOUT,STH,0,I,0,0,SCH)) GOTO 10 !READ SCAN HEAD - SCHE(SCH_PANG_E)= - 1 ATAN2(DBLE(CLATA*SIN(PI2*SCHE(SCH_HA_E))), - 1 COS(PI2*STHD(STH_DEC_D))*SLATA- - 1 CLATA*SIN(PI2*STHD(STH_DEC_D))* - 1 COS(PI2*SCHE(SCH_HA_E)))/PI2 !PARAL. ANGLE - IF (.NOT.NSCSCW(FCAOUT,STH,0,I,0,0,SCH)) GOTO 10 !WRITE HEADER - END DO - END IF -C -C WRITE NEW HEADER -C - IF (.NOT.WNFWR(FCAOUT,STHHDL,STH(0),STHP)) THEN !REWRITE SET HEADER - 10 CONTINUE - CALL WNCTXT(F_TP,'!/Error rewriting Sector(s)') - GOTO 900 - END IF - END DO -C -C READY -C - 800 CONTINUE - CALL WNFCL(FCAOUT) !CLOSE FILE -C - RETURN -C -C ERROR -C - 900 CONTINUE - CALL WNFCL(FCAOUT) !CLOSE FILE - RETURN !READY -C -C - END diff --git a/src/nscan/nscnvs.for b/src/nscan/nscnvs.for deleted file mode 100644 index d91209287603bda045e4bdb4734e9b37ca5de19f..0000000000000000000000000000000000000000 --- a/src/nscan/nscnvs.for +++ /dev/null @@ -1,268 +0,0 @@ -C+ NSCNVS.FOR -C WNB 900907 -C -C Revisions: -C WNB 920825 Scale phi -C WNB 920828 Correct MJD for aborted obs. in Wbork -C WNB 920831 Make XX..YY data from Stokes Linobs output -C WNB 921221 Add Parallactic angle -C HjV 930311 Change some text -C WNB 930607 New weights: STH version 2 to 3 -C HJV 930618 Symbolic names for mask bits in CBITS_O_DEF -C CMV 930730 Corrected Stokes dipole conversion -C WNB 930817 Change to CBITS_DEF -C WNB 930819 Dipole codes; version 3 to 4 -C WNB 930819 Split off NSCNOP with non-version part -C WNB 931008 Add MINST -C - SUBROUTINE NSCNVS -C -C Convert SCN file to newest format -C -C Result: -C -C CALL NSCNVS will convert a SCN file to newest version -C -C Include files: -C - INCLUDE 'WNG_DEF' - INCLUDE 'NSC_DEF' - INCLUDE 'CBITS_DEF' - INCLUDE 'GFH_O_DEF' !GENERAL FILE HEADER - INCLUDE 'SGH_O_DEF' !SUB-GROUP HEADER - INCLUDE 'STH_O_DEF' !SET HEADER - INCLUDE 'SCH_O_DEF' !SCAN HEADER - INCLUDE 'MDH_O_DEF' !MODEL HEADER - INCLUDE 'FDW_O_DEF' !TAPE BLOCKS - INCLUDE 'FDX_O_DEF' - INCLUDE 'OHW_O_DEF' - INCLUDE 'SCW_O_DEF' - INCLUDE 'SHW_O_DEF' -C -C Parameters: -C -C -C Arguments: -C -C -C Function references: -C - LOGICAL WNFRD !READ DATA - LOGICAL WNFWR !WRITE DATA - INTEGER WNFEOF !GET FILE POINTER - CHARACTER*32 WNTTSG !PRINT SET NAME - LOGICAL NSCSTH !GET A SET WITH NO VERSION CHECK - LOGICAL NSCSCH !READ SCAN HEADER - LOGICAL NSCSCW !WRITE SCAN HEADER - LOGICAL NMORDX !READ MODEL FROM SCAN FILE -C -C Data declarations: -C - INTEGER SET(0:7,0:1) !ALL SETS - INTEGER STHP !SET HEADER POINTER - INTEGER SNAM(0:7) !SET NAME - INTEGER TNAM(0:7) !TEST NAME - LOGICAL PNAM !PRINT ASKED - REAL UV0(0:3) !U,V DATA - REAL TF(0:1) !BAND/TIME SMEARING - INTEGER MINST !INSTRUMENT - DOUBLE PRECISION FRQ0 !BASIC FREQUENCY - REAL LM0(0:1) !L,M OFFSET - INTEGER*2 IFR(0:STHIFR-1) !IFR LIST - COMPLEX CMOD(0:3,0:STHIFR-1) !MODEL - INTEGER*2 LDAT(0:2,0:4*STHIFR-1) !DATA BUFFER - BYTE STH(0:STH__L-1) !SET HEADER - INTEGER*2 STHI(0:STH__L/LB_I-1) - INTEGER STHJ(0:STH__L/LB_J-1) - REAL STHE(0:STH__L/LB_E-1) - DOUBLE PRECISION STHD(0:STH__L/LB_D-1) - EQUIVALENCE (STH,STHI,STHJ,STHE,STHD) - BYTE SCH(0:SCH__L-1) !SCAN HEADER - INTEGER SCHJ(0:SCH__L/LB_J-1) - REAL SCHE(0:SCH__L/LB_E-1) - EQUIVALENCE (SCH,SCHJ,SCHE) - BYTE OHW(0:OHW__L-1) !OH BLOCK - INTEGER*2 OHWI(0:OHW__L/LB_I-1) - INTEGER OHWJ(0:OHW__L/LB_J-1) - REAL OHWE(0:OHW__L/LB_E-1) - DOUBLE PRECISION OHWD(0:OHW__L/LB_D-1) - EQUIVALENCE (OHW,OHWI,OHWJ,OHWE,OHWD) - BYTE SCW(0:SCW__L-1) !SC BLOCK - INTEGER*2 SCWI(0:SCW__L/LB_I-1) - INTEGER SCWJ(0:SCW__L/LB_J-1) - REAL SCWE(0:SCW__L/LB_E-1) - DOUBLE PRECISION SCWD(0:SCW__L/LB_D-1) - EQUIVALENCE (SCW,SCWI,SCWJ,SCWE,SCWD) - BYTE SGH(0:SGH__L-1) !SUB-GROUP HEADER - INTEGER*2 SGHI(0:SGH__L/LB_I-1) - INTEGER SGHJ(0:SGH__L/LB_J-1) - REAL SGHE(0:SGH__L/LB_E-1) - EQUIVALENCE (SGH,SGHI,SGHJ,SGHE) - BYTE MDH(0:MDH__L-1) !MODEL HEADER - INTEGER MDHJ(0:MDH__L/LB_J-1) - REAL MDHE(0:MDH__L/LB_E-1) - DOUBLE PRECISION MDHD(0:MDH__L/LB_D-1) - EQUIVALENCE (MDH,MDHJ,MDHE,MDHD) -C- -C -C INIT -C - DO I=0,7 !SET SET *.*.*.*.*.*.* - DO I1=0,1 - SET(I,I1)=0 - END DO - END DO - SET(0,0)=1 !1 LINE - DO I=0,7 - SET(I,1)=-1 !* - TNAM(I)=-1 !TEST PRINT NAME - END DO -C -C DO ALL SETS -C - DO WHILE (NSCSTH(FCAOUT,SET,STH,STHP,SNAM)) !GET SET - PNAM=.FALSE. !ASSUME NO PRINT - DO I=0,3 - IF (TNAM(I).NE.SNAM(I)) PNAM=.TRUE. !PRINT - END DO - DO I=0,3 - TNAM(I)=SNAM(I) !NEW TEST SET - END DO -C -C GET OH, SC AND IFR -C - IF (STHJ(STH_OHP_J).NE.0) THEN - IF (.NOT.WNFRD(FCAOUT,STHJ(STH_NOH_J),OHW, - 1 STHJ(STH_OHP_J))) GOTO 10 !READ OH - END IF - IF (STHJ(STH_SCP_J).NE.0) THEN - IF (.NOT.WNFRD(FCAOUT,STHJ(STH_NSC_J),SCW, - 1 STHJ(STH_SCP_J))) GOTO 10 !READ SC - END IF - IF (.NOT.WNFRD(FCAOUT,LB_I*STHJ(STH_NIFR_J),IFR, - 1 STHJ(STH_IFRP_J))) GOTO 10 !READ IFRS -C -C MAKE FROM VERSION 1 -C - IF (STHI(STH_VER_I).EQ.1) THEN !STILL VERSION 1 - J=WNFEOF(FCAOUT) !NEW SET HEADER POINTER - STHI(STH_LEN_I)=STH__L !NEW LENGTH - STHI(STH_VER_I)=MIN(2,STHHDV) !NEW VERSION (2) - CALL WNGMV(68,STH(340),STHE(STH_REDNS_E)) !SHIFT DATA - CALL WNGMVZ(STH__L-STH_POLC_1,STHE(STH_POLC_E)) !CLEAR REMAINDER - J1=STHJ(STH_LINK_J+0) !NEXT SET POINTER - J2=STHJ(STH_LINK_J+1) !PREVIOUS SET POINTER - STHP=J !NEW HEADER POINTER - IF (.NOT.WNFWR(FCAOUT,STH__L,STH(0),STHP)) GOTO 10 !REWRITE HEADER - IF (.NOT.WNFWR(FCAOUT,LB_J,STHP,J2)) GOTO 10 !LINK NEW - IF (.NOT.WNFWR(FCAOUT,LB_J,STHP,J1+4)) GOTO 10 - IF (.NOT.WNFRD(FCAOUT,SGH__L,SGH(0),SET(3,0))) GOTO 10 !READ SGH - SGHJ(SGH_DATAP_J)=STHP !SET DATA POINTER - IF (.NOT.WNFWR(FCAOUT,SGH__L,SGH(0),SET(3,0))) GOTO 10 !WRITE SGH - IF (PNAM) CALL WNCTXT(F_TP, - 1 'Sector(s) !AS converted from version 1', - 1 WNTTSG(TNAM,0)) - END IF !VERSION 1 -C -C MAKE FROM VERSION 2 -C - IF (STHI(STH_VER_I).EQ.2) THEN !STILL VERSION 2 - STHI(STH_VER_I)=MIN(3,STHHDV) !NEW VERSION - DO I=0,STHJ(STH_SCN_J)-1 !ALL SCANS - IF (.NOT.NSCSCH(FCAOUT,STH,0,I,0,0,SCH)) GOTO 10 !READ SCAN HEAD - IF (.NOT.WNFRD(FCAOUT,STHJ(STH_SCNL_J)-SCH__L, - 1 LDAT,STHJ(STH_SCNP_J)+ - 1 STHJ(STH_SCNL_J)*I+SCH__L)) GOTO 10 !READ SCAN - IF (IAND(SCHJ(SCH_BITS_J),1).EQ.0) THEN !NOT DELETED - SCHJ(SCH_BITS_J)=0 - ELSE - SCHJ(SCH_BITS_J)=FL_OLD !DELETED - END IF - IF (.NOT.NSCSCW(FCAOUT,STH,0,I,0,0,SCH)) GOTO 10 !WRITE HEADER - DO I1=0,STHJ(STH_NIFR_J)-1 !ALL IFRS - DO I2=0,STHI(STH_PLN_I)-1 !ALL POL. - I3=ABS(LDAT(0,4*I1+I2)) !OLD WEIGHT/FLAG - IF (LDAT(0,4*I1+I2).LT.0) THEN !FLAGGED DATA - LDAT(0,4*I1+I2)=MIN(I3,255)+FL_OLD !SET NEW WEIGHT/FLAG - ELSE - LDAT(0,4*I1+I2)=MIN(I3,255) !SET NEW WEIGHT - END IF - END DO - END DO - IF (.NOT.WNFWR(FCAOUT,STHJ(STH_SCNL_J)-SCH__L, - 1 LDAT,STHJ(STH_SCNP_J)+ - 1 STHJ(STH_SCNL_J)*I+SCH__L)) GOTO 10 !WRITE DATA - END DO - IF (PNAM) CALL WNCTXT(F_TP, - 1 'Sector(s) !AS converted from version 2', - 1 WNTTSG(TNAM,0)) - END IF !VERSION 2 -C -C MAKE FROM VERSION 3 -C - IF (STHI(STH_VER_I).EQ.3) THEN !STILL VERSION 3 - STHI(STH_VER_I)=MIN(4,STHHDV) !NEW VERSION - IF (STHJ(STH_OHP_J).NE.0 .AND. - 1 STHJ(STH_NOH_J).GT.OHW_POLC_1) THEN - STHJ(STH_DIPC_J)=0 !SET DIPOLE CODE - I1=OHWI(OHW_POLC_I) - DO I=0,STHTEL-1 - IF (I.LT.10) THEN !WEST TEL. - STHJ(STH_DIPC_J)=STHJ(STH_DIPC_J)+ISHFT(I1/4,2*I) - ELSE !EAST TEL - STHJ(STH_DIPC_J)=STHJ(STH_DIPC_J)+ISHFT(MOD(I1,4),2*I) - END IF - END DO - ELSE - STHJ(STH_DIPC_J)='0aaaaaaa'X !ASSUME PARALLEL - END IF - IF (STHI(STH_PLN_I).NE.4 .AND. - 1 STHJ(STH_MDL_J).NE.0 .AND. - 1 STHJ(STH_MDD_J).NE.0) THEN !MODEL PRESENT - IF (NMORDX(FCAOUT,STHJ(STH_MDL_J),6)) THEN !READ MODEL - IF (.NOT.WNFRD(FCAOUT,MDH__L,MDH,STHJ(STH_MDL_J))) - 1 GOTO 10 !READ MODEL HEADER - CALL NMOMUJ(IOR(8,IAND(NOT(255),MDHJ(MDH_ACT_J)))) !SET ACTION - CALL NMOMST(MDHJ(MDH_TYP_J),MDHD(MDH_RA_D), - 1 MDHD(MDH_DEC_D),STH,LM0,FRQ0,TF,MINST) !GET SOME DATA - DO I=0,STHJ(STH_SCN_J)-1 !ALL SCANS - IF (.NOT.NSCSCH(FCAOUT,STH,0,I,0,0,SCH)) GOTO 10 !READ HEAD - CALL NMOMUV(MDHJ(MDH_TYP_J),MDHD(MDH_RA_D), - 1 MDHD(MDH_DEC_D),STH,SCH,UV0) !GET DATA - CALL NMOMUC(6,UV0,LM0,FRQ0,STHE(STH_RTP_E), - 1 4,STHJ(STH_NIFR_J),IFR,TF,MINST,CMOD) !GET MODEL - IF (.NOT.WNFWR(FCAOUT,4*STHJ(STH_NIFR_J)*LB_X, - 1 CMOD,STHJ(STH_MDD_J)+4*STHJ(STH_NIFR_J)*LB_X)) - 1 GOTO 10 !SAVE MODEL - END DO !SCANS - END IF !MODEL READ - END IF !MODEL PRESENT - IF (PNAM) CALL WNCTXT(F_TP, - 1 'Sector(s) !AS converted from version 3', - 1 WNTTSG(TNAM,0)) - END IF !VERSION 3 -C -C WRITE NEW HEADER -C - IF (.NOT.WNFWR(FCAOUT,STH__L,STH(0),STHP)) THEN !REWRITE SET HEADER - 10 CONTINUE - CALL WNCTXT(F_TP,'!/Error rewriting Sector(s)') - GOTO 900 - END IF - END DO -C -C READY -C - 800 CONTINUE - CALL WNFCL(FCAOUT) !CLOSE FILE -C - RETURN -C -C ERROR -C - 900 CONTINUE - CALL WNFCL(FCAOUT) !CLOSE FILE - RETURN !READY -C -C - END diff --git a/src/nscan/nscofr.for b/src/nscan/nscofr.for deleted file mode 100644 index 064356458deabf28be110bc2a7e8f251c44407d9..0000000000000000000000000000000000000000 --- a/src/nscan/nscofr.for +++ /dev/null @@ -1,497 +0,0 @@ -C+ NSCOFR.FOR -C WNB 900403 -C -C Revisions: -C WNB 910730 Correct gain corrections -C WNB 911007 Typo in gain corrections -C WNB 920811 Typo in interferometer table -C WNB 930127 Add all FRQ* -C HjV 930311 Change some text -C WNB 930608 New weights/BITS -C HJV 930618 Symbolic names for mask bits in CBITS_O_DEF -C WNB 930803 CBITS_DEF -C WNB 930819 Add STH_DIPC -C WNB 931001 Typo in dipole code -C HjV 940602 Make available for VAX R-series files -C - SUBROUTINE NSCOFR -C -C Load WSRT data from old SCN file -C -C Result: -C -C CALL NSCOFR will load WSRT data in SCN file from old SCN file -C -C Include files: -C - INCLUDE 'WNG_DEF' - INCLUDE 'NSC_DEF' - INCLUDE 'CBITS_DEF' - INCLUDE 'GFH_O_DEF' !GENERAL FILE HEADER - INCLUDE 'SGH_O_DEF' !SUB-GROUP HEADER - INCLUDE 'STH_O_DEF' !SET HEADER - INCLUDE 'SCH_O_DEF' !SCAN HEADER - INCLUDE 'OHW_O_DEF' !OH BLOCK - INCLUDE 'OHW_T_DEF' - INCLUDE 'SCW_O_DEF' !SC BLOCK - INCLUDE 'SCW_T_DEF' - INCLUDE 'SHW_O_DEF' !SC BLOCK - INCLUDE 'SHW_T_DEF' - INCLUDE 'RFH_O_DEF' !R-SERIES FILE HEADER - INCLUDE 'RFH_T_DEF' - INCLUDE 'RSH_O_DEF' !R-SERIES SET HEADER - INCLUDE 'RSH_T_DEF' - INCLUDE 'RSC_O_DEF' !R-SERIES SCAN AND DATA HEADER - INCLUDE 'RSC_T_DEF' -C -C Parameters: -C -C -C Arguments: -C -C -C Function references: -C - LOGICAL WNFOP,WNFOPF !OPEN FILE - LOGICAL WNFRD !READ DATA - LOGICAL WNFWR !WRITE DATA - INTEGER WNFEOF !FILE POSITION - INTEGER WNCALN !STRING LENGTH - LOGICAL WNDLNK !LINK SET - LOGICAL WNDLNG,WNDLNF !LINK GROUP - CHARACTER*32 WNTTSG !MAKE SUB-GROUP STRING -C -C Data declarations: -C - BYTE STH(0:STHHDL-1) !SET HEADER - INTEGER*2 STHI(0:STHHDL/2-1) - INTEGER STHJ(0:STHHDL/4-1) - REAL STHE(0:STHHDL/4-1) - REAL*8 STHD(0:STHHDL/8-1) - EQUIVALENCE (STH,STHI,STHJ,STHE,STHD) - BYTE SCH(0:SCHHDL-1) !SCAN HEADER - INTEGER*2 SCHI(0:SCHHDL/2-1) - INTEGER SCHJ(0:SCHHDL/4-1) - REAL SCHE(0:SCHHDL/4-1) - REAL*8 SCHD(0:SCHHDL/8-1) - EQUIVALENCE (SCH,SCHI,SCHJ,SCHE,SCHD) - BYTE OFH(0:192-1) !OLD FILE HEADER - CHARACTER*192 OFHC - INTEGER*2 OFHI(0:192/2-1) - INTEGER OFHJ(0:192/4-1) - REAL OFHE(0:192/4-1) - REAL*8 OFHD(0:192/8-1) - EQUIVALENCE (OFH,OFHC,OFHI,OFHJ,OFHE,OFHD) - BYTE OSH(0:400-1) !OLD SET HEADER - INTEGER*2 OSHI(0:400/2-1) - INTEGER OSHJ(0:400/4-1) - REAL OSHE(0:400/4-1) - REAL*8 OSHD(0:400/8-1) - EQUIVALENCE (OSH,OSHI,OSHJ,OSHE,OSHD) - BYTE OSC(0:1600-1,0:3) !OLD SCAN HEADER - INTEGER*2 OSCI(0:1600/2-1,0:3) - INTEGER OSCJ(0:1600/4-1,0:3) - REAL OSCE(0:1600/4-1,0:3) - REAL*8 OSCD(0:1600/8-1,0:3) - EQUIVALENCE (OSC,OSCI,OSCJ,OSCE,OSCD) - BYTE OHW(0:OHWHDL-1) !OH BLOCK - INTEGER*2 OHWI(0:OHWHDL/2-1) - INTEGER OHWJ(0:OHWHDL/4-1) - REAL OHWE(0:OHWHDL/4-1) - DOUBLE PRECISION OHWD(0:OHWHDL/8-1) - EQUIVALENCE (OHW,OHWI,OHWJ,OHWE,OHWD) - BYTE SCW(0:SCWHDL-1) !SC BLOCK - INTEGER*2 SCWI(0:SCWHDL/2-1) - INTEGER SCWJ(0:SCWHDL/4-1) - REAL SCWE(0:SCWHDL/4-1) - DOUBLE PRECISION SCWD(0:SCWHDL/8-1) - EQUIVALENCE (SCW,SCWI,SCWJ,SCWE,SCWD) - INTEGER*2 ODAT(0:2,0:800) !DATA ARRAY - INTEGER*2 IFRT(0:MXNIFR-1,0:3) !IFR TABLE - INTEGER IFRD(9,0:MXNIFR-1) !IFR DESCRIPTOR - INTEGER POLS(0:3) !POL. TRANSLATION - INTEGER COH(3),CSC(3),CSH(3) !OH/SC/SH POINTERS - CHARACTER*32 SETSTR !GROUP NAME - BYTE DUMMY(30000) !READ OH/SC - INTEGER DUMMYJ(0:(30000-4)/4) - EQUIVALENCE (DUMMY(1),DUMMYJ(0)) - INTEGER*2 DBH_T(0:1,0:1) !DATA TRANSLATION - DATA DBH_T/4,0,0,1/ -C- -C -C INIT -C - COH(1)=0 !CLEAR POINTERS - CSC(1)=0 - CSH(1)=0 - IF (.NOT.WNFOP(IMCA,IFILE,'R')) THEN - 10 CONTINUE - CALL WNCTXT(F_TP,'!/I/O error input file') - GOTO 800 - END IF - IF (.NOT.WNFRD(IMCA,192,OFH,0)) GOTO 10 !READ FILE HEADER - IF (DECSW.NE.0) CALL WNTTTL(QFH__L,OFH,QFH_T,DECSW) - IF (OFHC(1:4).NE.'.SCN') THEN - CALL WNCTXT(F_TP,'!/Input file not old SCN file') - GOTO 800 - END IF - J0=40 !POINT TO SET LIST - IF (.NOT.WNDLNG(GFH_LINKG_1,0,SGH_GROUPN_1,FCAOUT, - 1 SGPH(0),SGNR(0))) THEN !MAKE JOB GROUP - 11 CONTINUE - CALL WNCTXT(F_TP,'!/Cannot create sub-group') - GOTO 800 - END IF - IF (.NOT.WNDLNG(SGPH(0)+SGH_LINKG_1,0,SGH_GROUPN_1,FCAOUT, - 1 SGPH(1),SGNR(1))) GOTO 11 !MAKE LABEL GROUP - IF (.NOT.WNDLNG(SGPH(1)+SGH_LINKG_1,0,SGH_GROUPN_1,FCAOUT, - 1 SGPH(2),SGNR(2))) GOTO 11 !MAKE POINTING GROUP -C -C READ A SET -C - 100 CONTINUE - IF (.NOT.WNFRD(IMCA,4,J0,J0)) GOTO 10 !NEXT SET PTR - IF (DECSW.NE.0) THEN - DBH_T(0,0)=3 - DBH_T(1,0)=1 - CALL WNTTTL(4,J0,DBH_T,DECSW) - END IF - IF (J0.EQ.40) GOTO 800 !READY - IF (.NOT.WNFRD(IMCA,400,OSH,J0)) GOTO 10 !READ SET HEADER - IF (DECSW.NE.0) CALL WNTTTL(QSH__L,OSH,QSH_T,DECSW) - I=OSHI(8) !CHANNEL - IF (.NOT.WNDLNF(SGPH(2)+SGH_LINKG_1,I,SGH_GROUPN_1,FCAOUT, - 1 SGPH(3),SGNR(3))) GOTO 11 !MAKE CHANNEL GROUP - SGNR(4)=0 !CORRECT TILL END - SGNR(5)=-1 - SETSTR=WNTTSG(SGNR(0),0) !GROUP NAME - CALL WNCTXT(F_TP,'Sector !UI being copied to !AS', - 1 OSHI(70),SETSTR) - CALL WNGMVZ(STHHDL,STH(0)) !CLEAR STH - STHI(STH_LEN_I)=STHHDL !LENGTH - STHI(STH_VER_I)=STHHDV !VERSION - STHI(STH_BEC_I)=OSHI(7) !BACKEND CODE - STHJ(STH_DIPC_J)=0 !DIPOLE CODE - I1=OSHI(6) - DO I=0,STHTEL-1 - IF (I.LT.10) THEN !WEST TEL. - STHJ(STH_DIPC_J)=STHJ(STH_DIPC_J)+ISHFT(I1/4,2*I) - ELSE !EAST TEL - STHJ(STH_DIPC_J)=STHJ(STH_DIPC_J)+ISHFT(MOD(I1,4),2*I) - END IF - END DO - - STHJ(STH_VNR_J)=OSHJ(5) !VOLG NUMBER - STHI(STH_PLN_I)=OSHI(9) !# OF POLARISATIONS - CALL WNGMV(STH_FIELD_N,OFH(120),STH(STH_FIELD_1)) !FIELD NAME - STHD(STH_RA_D)=OSHE(9) !APP. RA - STHD(STH_DEC_D)=OSHE(10) !APP. DEC - STHD(STH_RAE_D)=OFHD(17) !RA EPOCH - STHD(STH_DECE_D)=OFHD(18) !DEC EPOCH - STHE(STH_OEP_E)=OSHE(6) !OBS. DATE IN JUL. YEARS - STHE(STH_EPO_E)=OFHE(33) !EPOCH - STHI(STH_OBS_I)=OSHI(38) !DAY - STHI(STH_OBS_I+1)=OSHI(39) !YEAR - DO I=0,STHTEL-1 !TEL. POSITIONS - STHE(STH_RTP_E+I)=(OSHE(21+I)) - END DO - STHE(STH_HAI_E)=OSHE(17) - STHE(STH_HAV_E)=OSHE(20) - STHE(STH_HAB_E)=OSHE(16) - STHJ(STH_SCN_J)=OSHI(72) - DO I1=0,STHI(STH_PLN_I)-1 !ALL POL. - IF (I1.EQ.0) THEN !SET XX - STHE(STH_REDNS_E+1)=OSHE(62+I1) !RED. PHASE NOISE - STHE(STH_ALGNS_E+1)=OSHE(66+I1) !ALIGN PHASE NOISE - STHE(STH_ALGNS_E+0)=OSHE(70+I1) !ALIGN GAIN NOISE - STHE(STH_REDNS_E+0)=OSHE(74+I1) !RED. GAIN NOISE - ELSE IF ((I1.EQ.1 .AND. STHI(STH_PLN_I).EQ.2) .OR. - 1 (I1.EQ.3 .AND. STHI(STH_PLN_I).EQ.4)) THEN !SET YY - STHE(STH_REDNS_E+3)=OSHE(62+I1) !RED. PHASE NOISE - STHE(STH_ALGNS_E+3)=OSHE(66+I1) !ALIGN PHASE NOISE - STHE(STH_ALGNS_E+2)=OSHE(70+I1) !ALIGN GAIN NOISE - STHE(STH_REDNS_E+2)=OSHE(74+I1) !RED. GAIN NOISE - END IF - END DO -C -C GET IFRS -C - DO I=0,STHI(STH_PLN_I)-1 - I1=2*OSHI(104+I) - IF (.NOT.WNFRD(IMCA,I1,IFRT(0,I), - 1 OSHJ(54+I))) GOTO 10 !READ IFR - IF (DECSW.NE.0) THEN - DBH_T(0,0)=2 - DBH_T(1,0)=I1 - CALL WNTTTL(I1,IFRT(0,I),DBH_T,DECSW) - END IF - END DO - J=0 !NO IFRS FOUND - DO I=0,STHI(STH_PLN_I)-1 !ALL POL. - IF (OSHI(100+I).EQ.ICHAR('X')*256+ICHAR('X')) THEN !FIND POINTER - POLS(I)=0 - ELSE IF (OSHI(100+I).EQ.ICHAR('X')*256+ICHAR('Y')) THEN - POLS(I)=1 - ELSE IF (OSHI(100+I).EQ.ICHAR('Y')*256+ICHAR('Y')) THEN - POLS(I)=2 - ELSE - POLS(I)=3 - END IF - DO I1=0,OSHI(104+I)-1 !ALL IFRS PER POL. - DO I2=0,J-1 !CHECK PRESENCE - IF (IFRD(1,I2).EQ.MOD(IFRT(I1,I),256) .AND. - 1 IFRD(2,I2).EQ.IFRT(I1,I)/256) THEN !FOUND - I3=POLS(I) !POINTER - IFRD(3+I3,I2)=1000*I+I1 !DATA POINTER - GOTO 20 - END IF - END DO - IFRD(1,J)=MOD(IFRT(I1,I),256) !NEW ENTRY - IFRD(2,J)=IFRT(I1,I)/256 - DO I3=3,6 !SET NO POL - IFRD(I3,J)=-1 - END DO - IFRD(7,J)=STHE(STH_RTP_E+IFRD(2,J))- - 1 STHE(STH_RTP_E+IFRD(1,J)) !BASELINE - I3=POLS(I) !POINTER - IFRD(3+I3,J)=1000*I+I1 !DATA POINTER - J=J+1 !COUNT IFR - 20 CONTINUE - END DO - END DO - DO I=0,J-2 !SORT ON BASELINE - DO I1=0,J-2-I - IF (IFRD(7,I1).GT.IFRD(7,I1+1)) THEN !MOVE ENTRY - DO I2=1,9 - I3=IFRD(I2,I1) - IFRD(I2,I1)=IFRD(I2,I1+1) - IFRD(I2,I1+1)=I3 - END DO - END IF - END DO - END DO - STHJ(STH_NIFR_J)=J !# OF IFRS - STHJ(STH_IFRP_J)=WNFEOF(FCAOUT) !IFR TABLE POINTER - DO I=0,J-1 !MAKE IFR TABLE - IFRT(I,0)=IFRD(1,I)+IFRD(2,I)*256 - END DO - IF (.NOT.WNFWR(FCAOUT,2*STHJ(STH_NIFR_J),IFRT(0,0), - 1 STHJ(STH_IFRP_J))) GOTO 12 !WRITE IFR TABLE - DO I=0,3 !DETAILED TABLES - DO I1=0,J-1 - IF (IFRD(3+I,I1).NE.-1) THEN !PRESENT - IFRT(I1,0)=1 - ELSE !NOT PRESENT - IFRT(I1,0)=0 - END IF - END DO - IF (.NOT.WNFWR(FCAOUT,2*J,IFRT(0,0),STHJ(STH_IFRP_J)+ - 1 2*J*(1+I))) GOTO 12 !WRITE DETAILS - END DO -C -C GET OH/SC/SH -C - IF (OSHJ(13).NE.0) THEN !SET OH - IF (OSHJ(13).NE.COH(1)) THEN !WRITE OH - IF (.NOT.WNFRD(IMCA,12,DUMMY,OSHJ(13))) THEN - GOTO 10 !READ OH ERROR - END IF - IF (DECSW.NE.0) THEN - DBH_T(0,0)=3 - DBH_T(1,0)=1 - CALL WNTTTL(4,DUMMYJ(2),DBH_T,DECSW) - END IF - IF (.NOT.WNFRD(IMCA,DUMMYJ(2),DUMMY,OSHJ(13))) THEN - GOTO 10 !READ OH ERROR - END IF - IF (DECSW.NE.0) CALL WNTTTL(OHWHDL,DUMMY,OHW_T,DECSW) - STHJ(STH_OHP_J)=WNFEOF(FCAOUT) !SET OH POINTER - STHJ(STH_NOH_J)=DUMMYJ(2) - IF (.NOT.WNFWR(FCAOUT,STHJ(STH_NOH_J),DUMMY, - 1 STHJ(STH_OHP_J))) THEN - GOTO 12 !WRITE OH - END IF - COH(1)=OSHJ(13) !SAVE CHECK POINTERS - COH(2)=STHJ(STH_OHP_J) - COH(3)=STHJ(STH_NOH_J) - ELSE - STHJ(STH_OHP_J)=COH(2) !SET OH POINTER - STHJ(STH_NOH_J)=COH(3) !SET OH LENGTH - END IF - END IF - IF (OSHJ(14).NE.0) THEN !SET SC - IF (OSHJ(14).NE.CSC(1)) THEN !WRITE SC - IF (.NOT.WNFRD(IMCA,12,DUMMY,OSHJ(14))) THEN - GOTO 10 !READ SC ERROR - END IF - IF (DECSW.NE.0) THEN - DBH_T(0,0)=3 - DBH_T(1,0)=1 - CALL WNTTTL(4,DUMMYJ(2),DBH_T,DECSW) - END IF - IF (.NOT.WNFRD(IMCA,DUMMYJ(2),DUMMY,OSHJ(14))) THEN - GOTO 10 !READ SC ERROR - END IF - IF (DECSW.NE.0) CALL WNTTTL(SCWHDL,DUMMY,SCW_T,DECSW) - STHJ(STH_SCP_J)=WNFEOF(FCAOUT) !SET SC POINTER - STHJ(STH_NSC_J)=DUMMYJ(2) - IF (.NOT.WNFWR(FCAOUT,STHJ(STH_NSC_J),DUMMY, - 1 STHJ(STH_SCP_J))) THEN - GOTO 12 !WRITE SC - END IF - CSC(1)=OSHJ(14) !SAVE CHECK POINTERS - CSC(2)=STHJ(STH_SCP_J) - CSC(3)=STHJ(STH_NSC_J) - ELSE - STHJ(STH_SCP_J)=CSC(2) !SET SC POINTER - STHJ(STH_NSC_J)=CSC(3) !SET SC LENGTH - END IF - END IF - IF (OSHJ(15).NE.0) THEN !SET SH - IF (OSHJ(15).NE.CSH(1)) THEN !WRITE SH - IF (.NOT.WNFRD(IMCA,12,DUMMY,OSHJ(15))) THEN - GOTO 10 !READ SH ERROR - END IF - IF (DECSW.NE.0) THEN - DBH_T(0,0)=3 - DBH_T(1,0)=1 - CALL WNTTTL(4,DUMMYJ(2),DBH_T,DECSW) - END IF - IF (.NOT.WNFRD(IMCA,DUMMYJ(2),DUMMY,OSHJ(15))) THEN - GOTO 10 !READ SH ERROR - END IF - IF (DECSW.NE.0) CALL WNTTTL(SHWHDL,DUMMY,SHW_T,DECSW) - STHJ(STH_SHP_J)=WNFEOF(FCAOUT) !SET SH POINTER - STHJ(STH_NSH_J)=DUMMYJ(2) - IF (.NOT.WNFWR(FCAOUT,STHJ(STH_NSH_J),DUMMY, - 1 STHJ(STH_SHP_J))) THEN - GOTO 12 !WRITE SH - END IF - CSH(1)=OSHJ(15) !SAVE CHECK POINTERS - CSH(2)=STHJ(STH_SHP_J) - CSH(3)=STHJ(STH_NSH_J) - ELSE - STHJ(STH_SHP_J)=CSH(2) !SET SH POINTER - STHJ(STH_NSH_J)=CSH(3) !SET SH LENGTH - END IF - END IF - STHJ(STH_SCNP_J)=WNFEOF(FCAOUT)+STHHDL !PTR TO DATA - STHJ(STH_SCNL_J)=SCHHDL+6*STHJ(STH_NIFR_J)* - 1 STHI(STH_PLN_I) !LENGTH SCAN - STHI(STH_CHAN_I)=OSHI(8) !CHANNEL # - STHD(STH_FRQ_D)=OSHE(11) !FREQUENCY - STHD(STH_FRQE_D)=OSHE(11) - STHD(STH_FRQV_D)=OSHE(11) - STHD(STH_FRQC_D)=OFHD(19) - STHE(STH_BAND_E)=OSHE(12) !BANDWIDTH - CALL NSCCLP(FCAOUT,STH(0),STHE(STH_PHI_E)) !PREC. ROTATION ANGLE - STHE(STH_PHI_E)=STHE(STH_PHI_E)/PI2 !MAKE FRACTIONS - IF (STHJ(STH_OHP_J).NE.0 .AND. STHJ(STH_SCP_J).NE.0) THEN !CAN DO - IF (.NOT.WNFRD(FCAOUT,STHJ(STH_NOH_J),OHW, - 1 STHJ(STH_OHP_J))) GOTO 10 !READ OH - IF (.NOT.WNFRD(FCAOUT,STHJ(STH_NSC_J),SCW, - 1 STHJ(STH_SCP_J))) GOTO 10 !READ SC - STHD(STH_UTST_D)=1.+SCWD(SCW_CUTST_D) !UT/ST DAY LENGTH - D0=STHE(STH_HAB_E)-OHWD(OHW_HAST_D) !HA SINCE START - IF (D0.LT.0) D0=D0+1 - D1=OHWD(OHW_HAEND_D)-OHWD(OHW_HAST_D) !LENGTH OBS. - IF (D1.LT.0) D1=D1+1 - D1=D1/2. !TO START OF OBS. - STHD(STH_MJD_D)=OHWD(OHW_JDAY_D)+40000D0-0.5D0- !MAKE MJD - 1 (D1-D0)/STHD(STH_UTST_D) - END IF - IF (.NOT.WNFWR(FCAOUT,STHHDL,STH(0),STHJ(STH_SCNP_J)-STHHDL)) - 1 THEN !WRITE SET HEADER - 12 CONTINUE - CALL WNCTXT(F_TP,'!/Write error') - GOTO 800 - END IF -C -C COPY DATA -C - DO I=0,STHJ(STH_SCN_J)-1 !ALL SCANS - DO I1=0,STHI(STH_PLN_I)-1 !ALL POL. - I2=440+4*OSHI(104+I1) - IF (.NOT.WNFRD(IMCA,I2,OSC(0,I1), - 1 OSHJ(58+I1)+I*OSHI(71))) GOTO 10 !READ SCAN - IF (DECSW.NE.0) CALL WNTTTL(QSCHDL,OSC(0,I1),QSC_T,DECSW) - END DO - CALL WNGMVZ(SCHHDL,SCH(0)) !EMPTY SCAN HEADER - SCHE(SCH_HA_E)=OSCE(1,0) !HA - SCHE(SCH_MAX_E)=OSCE(6,0) !MAX COS/SIN - IF (OSC(38,0).EQ.0) THEN !NOT DELETED - SCHJ(SCH_BITS_J)=0 - ELSE - SCHJ(SCH_BITS_J)=FL_OLD !DELETE SCAN - END IF - SCHE(SCH_EXT_E)=OSCE(12,0) !EXTINCTION - SCHE(SCH_REFR_E)=OSCE(13,0) !REFRACTION - DO I1=0,STHI(STH_PLN_I)-1 !ALL POL. - SCHE(SCH_MAX_E)=MAX(SCHE(SCH_MAX_E),OSCE(6,I1)) !TOTAL MAX. - IF (I1.EQ.0) THEN !SET XX - SCHE(SCH_REDNS_E+1)=OSCE(3,I1) !RED. PHASE NOISE - SCHE(SCH_ALGNS_E+1)=OSCE(4,I1) !ALIGN PHASE NOISE - SCHE(SCH_ALGNS_E+0)=OSCE(5,I1) !ALIGN GAIN NOISE - SCHE(SCH_REDNS_E+0)=OSCE(7,I1) !RED. GAIN NOISE - DO I2=0,STHTEL-1 !CORRECTIONS - I3=2*I2 !OFFSET - SCHE(SCH_REDC_E+I3+0)=OSCE(72+I2,I1) !RED. GAIN - SCHE(SCH_REDC_E+I3+1)=OSCE(28+I2,I1) !RED. PHASE - SCHE(SCH_ALGC_E+I3+0)=OSCE(58+I2,I1)-OSCE(72+I2,I1) !ALIGN GAIN - SCHE(SCH_ALGC_E+I3+1)=OSCE(14+I2,I1)-OSCE(28+I2,I1) !ALIGN PHASE - END DO - ELSE IF ((I1.EQ.1 .AND. STHI(STH_PLN_I).EQ.2) .OR. - 1 (I1.EQ.3 .AND. STHI(STH_PLN_I).EQ.4)) THEN !SET YY - SCHE(SCH_REDNS_E+3)=OSCE(3,I1) !RED. PHASE NOISE - SCHE(SCH_ALGNS_E+3)=OSCE(4,I1) !ALIGN PHASE NOISE - SCHE(SCH_ALGNS_E+2)=OSCE(5,I1) !ALIGN GAIN NOISE - SCHE(SCH_REDNS_E+2)=OSCE(7,I1) !RED. GAIN NOISE - DO I2=0,STHTEL-1 !CORRECTIONS - I3=2*STHTEL+2*I2 !OFFSET - SCHE(SCH_REDC_E+I3+2)=OSCE(72+I2,I1) !RED. GAIN - SCHE(SCH_REDC_E+I3+3)=OSCE(28+I2,I1) !RED. PHASE - SCHE(SCH_ALGC_E+I3+2)=OSCE(58+I2,I1)-OSCE(72+I2,I1) !ALIGN GAIN - SCHE(SCH_ALGC_E+I3+3)=OSCE(14+I2,I1)-OSCE(28+I2,I1) !ALIGN PHASE - END DO - END IF - END DO - J1=WNFEOF(FCAOUT) !OUTPUT POINTER - DO I2=0,STHI(STH_PLN_I)-1 !ALL POLS - DO I1=0,STHJ(STH_NIFR_J)-1 !ALL IFRS - I3=I1*STHI(STH_PLN_I) !POL. OFFSET - I4=IFRD(3+POLS(I2),I1) !DATA POINTER - IF (I4.NE.-1) THEN - I5=MOD(I4,1000) !BUF. POINTER - I4=I4/1000 !POL. POINTER - ODAT(1,I2+I3)=OSCI(220+2*I5,I4) !COS - ODAT(2,I2+I3)=OSCI(220+2*I5+1,I4) !SIN - IF (ODAT(1,I2+I3).EQ.-32768) THEN - ODAT(0,I2+I3)=0 !WEIGHT - ELSE - ODAT(0,I2+I3)=1 !WEIGHT - END IF - ELSE !NOT PRESENT - ODAT(0,I2+I3)=0 - ODAT(1,I2+I3)=0 - ODAT(2,I2+I3)=0 - END IF - END DO - END DO - IF (.NOT.WNFWR(FCAOUT,SCHHDL,SCH(0),J1)) GOTO 12 !WRITE HEADER - IF (.NOT.WNFWR(FCAOUT,6*STHJ(STH_NIFR_J)*STHI(STH_PLN_I), - 1 ODAT,J1+SCHHDL)) GOTO 12 !DATA - END DO - IF (.NOT.WNDLNK(GFH_LINK_1,STHJ(STH_SCNP_J)-STHHDL, - 1 STH_SETN_1,FCAOUT)) GOTO 12 !LINK SET - IF (.NOT.WNDLNG(SGPH(3)+SGH_LINKG_1,STHJ(STH_SCNP_J)-STHHDL, - 1 SGH_GROUPN_1,FCAOUT, - 1 SGPH(4),SGNR(4))) GOTO 11 !MAKE DATA GROUP - GOTO 100 !NEXT SET -C - 800 CONTINUE - CALL WNFCL(IMCA) !CLOSE INPUT - CALL WNFCL(FCAOUT) !CLOSE OUTPUT - RETURN !READY -C -C - END diff --git a/src/nscan/nscoto.for b/src/nscan/nscoto.for deleted file mode 100644 index 72f356edaf38c29b8832c578d2444eb74adfcf6e..0000000000000000000000000000000000000000 --- a/src/nscan/nscoto.for +++ /dev/null @@ -1,366 +0,0 @@ -C+ NSCOTO.FOR -C WNB 900808 -C -C Revisions: -C WNB 910730 Correct gain corrections -C HjV 920520 HP does not allow extended source lines -C WNB 930127 Backup FRQC -C HjV 930311 Change some text -C WNB 930607 New weight version 3 -C HJV 930618 Symbolic names for mask bits in CBITS_O_DEF -C WNB 930803 CBITS_DEF -C WNB 930819 Add STH_DIPC -C WNB 931001 Typo dipole code -C - SUBROUTINE NSCOTO -C -C Load WSRT data into old SCN file -C -C Result: -C -C CALL NSCOTO will load WSRT data in old SCN file from SCN file -C -C Include files: -C - INCLUDE 'WNG_DEF' - INCLUDE 'NSC_DEF' - INCLUDE 'CBITS_DEF' - INCLUDE 'GFH_O_DEF' !GENERAL FILE HEADER - INCLUDE 'SGH_O_DEF' !SUB-GROUP HEADER - INCLUDE 'STH_O_DEF' !SET HEADER - INCLUDE 'SCH_O_DEF' !SCAN HEADER -C -C Parameters: -C -C -C Arguments: -C -C -C Function references: -C - LOGICAL WNFOP !OPEN FILE - LOGICAL WNFRD !READ DATA - LOGICAL WNFWR !WRITE DATA - INTEGER WNFEOF !FILE POSITION - INTEGER WNCALN !STRING LENGTH - CHARACTER*32 WNTTSG !TRANSLATE SET NAME - LOGICAL NSCSTG !GET A SET -C -C Data declarations: -C - INTEGER UFL !CURRENT UNFLAG - BYTE GFH(0:GFHHDL-1) !SET HEADER - INTEGER*2 GFHI(0:GFHHDL/2-1) - INTEGER GFHJ(0:GFHHDL/4-1) - REAL GFHE(0:GFHHDL/4-1) - REAL*8 GFHD(0:GFHHDL/8-1) - EQUIVALENCE (GFH,GFHI,GFHJ,GFHE,GFHD) - BYTE STH(0:STHHDL-1) !SET HEADER - INTEGER*2 STHI(0:STHHDL/2-1) - INTEGER STHJ(0:STHHDL/4-1) - REAL STHE(0:STHHDL/4-1) - REAL*8 STHD(0:STHHDL/8-1) - EQUIVALENCE (STH,STHI,STHJ,STHE,STHD) - BYTE SCH(0:SCHHDL-1) !SCAN HEADER - INTEGER*2 SCHI(0:SCHHDL/2-1) - INTEGER SCHJ(0:SCHHDL/4-1) - REAL SCHE(0:SCHHDL/4-1) - REAL*8 SCHD(0:SCHHDL/8-1) - EQUIVALENCE (SCH,SCHI,SCHJ,SCHE,SCHD) - BYTE OFH(0:192-1) !OLD FILE HEADER - CHARACTER*192 OFHC - INTEGER*2 OFHI(0:192/2-1) - INTEGER OFHJ(0:192/4-1) - REAL OFHE(0:192/4-1) - REAL*8 OFHD(0:192/8-1) - EQUIVALENCE (OFH,OFHC,OFHI,OFHJ,OFHE,OFHD) - BYTE OSH(0:400-1) !OLD SET HEADER - INTEGER*2 OSHI(0:400/2-1) - INTEGER OSHJ(0:400/4-1) - REAL OSHE(0:400/4-1) - REAL*8 OSHD(0:400/8-1) - EQUIVALENCE (OSH,OSHI,OSHJ,OSHE,OSHD) - BYTE OSC(0:1600-1,0:3) !OLD SCAN HEADER - INTEGER*2 OSCI(0:1600/2-1,0:3) - INTEGER OSCJ(0:1600/4-1,0:3) - REAL OSCE(0:1600/4-1,0:3) - REAL*8 OSCD(0:1600/8-1,0:3) - EQUIVALENCE (OSC,OSCI,OSCJ,OSCE,OSCD) - INTEGER*2 ODAT(0:2,0:800) !DATA ARRAY - INTEGER*2 IFRT(0:MXNIFR-1,0:3) !IFR TABLE - INTEGER IFRD(9,0:MXNIFR-1) !IFR DESCRIPTOR - INTEGER POLS(0:3) !POL. TRANSLATION - INTEGER COH(2),CSC(2),CSH(2),CIFR(2) !OH/SC/SH POINTERS - INTEGER STHP !SET HEADER PTR - INTEGER SETNAM(0:7) !SET NAME - CHARACTER*32 SETSTR !SET STRING NAME - CHARACTER*8 POLC !POL.CODE - INTEGER NAUTC !# OF AUTOCORRELATIONS INPUT - INTEGER ONIFR !# OF OUTPUT IFRS - BYTE DUMMY(30000) !TO READ OH/SH - INTEGER*2 DUMMYI(15000) - EQUIVALENCE (DUMMY,DUMMYI) -C- -C -C INIT -C - COH(1)=0 !INIT POINTERS - CSC(1)=0 - CSH(1)=0 - CIFR(1)=0 - CALL WNDDUF(UFL) !GET CURRENT UN-FLAG - UFL=IAND(FL_ALL,NOT(UFL)) !MAKE SELECTOR - IF (.NOT.WNFOP(OMCA,OFILE,'W')) THEN - 10 CONTINUE - CALL WNCTXT(F_TP,'!/I/O error output file') - GOTO 800 - END IF - IF (.NOT.WNFRD(FCAIN,GFHHDL,GFH,0)) THEN !READ FILE HEADER - 11 CONTINUE - CALL WNCTXT(F_TP,'!/I/O error input file') - GOTO 800 - END IF - IF (.NOT.NSCSTG(FCAIN,SETS,STH(0),STHP,SETNAM)) THEN !GET FIRST SET - CALL WNCTXT(F_TP,'!/Cannot find a Sector') - GOTO 800 - END IF -C -C MAKE FILE HEADER -C - CALL WNGMVZ(192,OFH(0)) !CLEAR HEADER - CALL WNGMV(4,GFH(GFH_ID_1),OFH(0)) !ID - OFHI(2)=192 !LENGTH - CALL WNGMV(32,GFH(GFH_CDAT_1),OFH(6)) !CREATION/UPDATE DATES/TIMES - OFHI(19)=GFHJ(GFH_RCNT_J) !REV. COUNT - OFHJ(10)=40 !SET LINK LIST - OFHJ(11)=40 - OFHJ(12)=48 !IFR ERRORS LIST - OFHJ(13)=48 - OFHI(28)=0 !# OF SETS - OFHI(29)=14 !# OF TELESCOPES - OFHI(30)=2 !VERSION - CALL WNGMFS(30,'0123456789ABCD',OFH(62)) !TEL. NAMES - OFHI(46)=4 !# OF BYTES PER DATA POINT - OFHI(47)=1 !DATA CODE - CALL WNGMV(12,STH(STH_FIELD_1),OFH(120)) !FIELD NAME - CALL WNGMV(4,STH(STH_EPO_1),OFH(132)) !EPOCH - CALL WNGMV(16,STH(STH_RAE_1),OFH(136)) !RA/DEC - CALL WNGMV(8,STH(STH_FRQC_1),OFH(152)) !FREQ - OFHI(80)=10 !BASIC INTEGR. TIME - IF (.NOT.WNFWR(OMCA,192,OFH,0)) THEN !WRITE FILE HEADER - GOTO 10 - END IF - GOTO 101 !DO SET -C -C READ A SET -C - 100 CONTINUE - IF (.NOT.NSCSTG(FCAIN,SETS,STH(0),STHP,SETNAM)) THEN !GET NEXT SET - GOTO 800 - END IF - 101 CONTINUE - SETSTR=WNTTSG(SETNAM,0) !GET SET NAME - CALL WNGMVZ(400,OSH(0)) !CLEAR SET HEADER - OSHI(4)=400 !LENGTH - OSHI(5)=2 !VERSION - OSHI(6)=ISHFT(IAND(STHJ(STH_DIPC_J),'03'X),2)+ !WEST TEL - 1 IAND('03'X,ISHFT(STHJ(STH_DIPC_J),-20)) !EAST DIP. CODE - OSHI(7)=STHI(STH_BEC_I) !BACKEND CODE - OSHI(8)=STHI(STH_CHAN_I) !CHANNEL - OSHI(9)=STHI(STH_PLN_I) !# OF POL. - OSHJ(5)=STHJ(STH_VNR_J) !VOLG NR. - OSHE(6)=STHE(STH_OEP_E) !OBS. DATE - OSHE(9)=STHD(STH_RA_D) !RA - OSHE(10)=STHD(STH_DEC_D) !DEC - OSHE(11)=STHD(STH_FRQ_D) !FREQ - OSHE(12)=STHE(STH_BAND_E) !BANDWIDTH - IF (STHJ(STH_OHP_J).NE.0) THEN !SET OH - IF (STHJ(STH_OHP_J).NE.COH(1)) THEN !WRITE OH - IF (.NOT.WNFRD(FCAIN,STHJ(STH_NOH_J), - 1 DUMMY,STHJ(STH_OHP_J))) THEN - GOTO 10 !READ OH ERROR - END IF - OSHJ(13)=WNFEOF(OMCA) !SET OH POINTER - IF (.NOT.WNFWR(OMCA,STHJ(STH_NOH_J),DUMMY,OSHJ(13))) THEN - GOTO 11 !WRITE OH - END IF - COH(1)=STHJ(STH_OHP_J) !SAVE CHECK POINTERS - COH(2)=OSHJ(13) - ELSE - OSHJ(13)=COH(2) !SET OH POINTER - END IF - END IF - IF (STHJ(STH_SCP_J).NE.0) THEN !SET SC - IF (STHJ(STH_SCP_J).NE.CSC(1)) THEN !WRITE SC - IF (.NOT.WNFRD(FCAIN,STHJ(STH_NSC_J), - 1 DUMMY,STHJ(STH_SCP_J))) THEN - GOTO 10 !READ SC ERROR - END IF - OSHJ(14)=WNFEOF(OMCA) !SET SC POINTER - IF (.NOT.WNFWR(OMCA,STHJ(STH_NSC_J),DUMMY,OSHJ(14))) THEN - GOTO 11 !WRITE SC - END IF - CSC(1)=STHJ(STH_SCP_J) !SAVE CHECK POINTERS - CSC(2)=OSHJ(14) - ELSE - OSHJ(14)=CSC(2) !SET OH POINTER - END IF - END IF - IF (STHJ(STH_SHP_J).NE.0) THEN !SET SH - IF (STHJ(STH_SHP_J).NE.CSH(1)) THEN !WRITE SH - IF (.NOT.WNFRD(FCAIN,STHJ(STH_NSH_J), - 1 DUMMY,STHJ(STH_SHP_J))) THEN - GOTO 10 !READ SH ERROR - END IF - OSHJ(15)=WNFEOF(OMCA) !SET SH POINTER - IF (.NOT.WNFWR(OMCA,STHJ(STH_NSH_J),DUMMY,OSHJ(15))) THEN - GOTO 11 !WRITE SH - END IF - CSH(1)=STHJ(STH_SHP_J) !SAVE CHECK POINTERS - CSH(2)=OSHJ(15) - ELSE - OSHJ(15)=CSH(2) !SET OH POINTER - END IF - END IF - OSHE(16)=STHE(STH_HAB_E) !START HA - OSHE(17)=STHE(STH_HAI_E) !INCR. HA - OSHE(18)=OSHE(17)*360.*240. !TIME INCR. - CALL WNGMV(4,STH(STH_OBS_1),OSH(76)) !DAY/YEAR - OSHE(20)=STHE(STH_HAV_E) !HA AVERAGE - CALL WNGMV(56,STH(STH_RTP_1),OSH(84)) !TEL. POS. - OSHI(70)=OFHI(28) !SET # - OFHI(28)=OSHI(70)+1 - OSHI(72)=STHJ(STH_SCN_J) !# OF SCANS - IF (STHI(STH_PLN_I).EQ.1) THEN !POL. CODES - POLC='XX' - ELSE IF (STHI(STH_PLN_I).EQ.2) THEN - POLC='XXYY' - ELSE IF (STHI(STH_PLN_I).EQ.4) THEN - POLC='XXXYYXYY' - END IF - CALL WNGMFS(8,POLC,OSH(200)) !POL.CODES - IF (STHJ(STH_IFRP_J).NE.0) THEN !SET IFR - IF (STHJ(STH_IFRP_J).NE.CIFR(1)) THEN !WRITE IFR - IF (.NOT.WNFRD(FCAIN,2*STHJ(STH_NIFR_J), - 1 DUMMY,STHJ(STH_IFRP_J))) THEN - GOTO 10 !READ IFR ERROR - END IF - NAUTC=0 !ASSUME NO AUTOCORRELATION - I=0 !GO THROUGH LIST - DO WHILE (I.LT.STHJ(STH_NIFR_J) .AND. DUMMYI(I+1)/256.EQ. - 1 MOD(DUMMYI(I+1),256)) !FIND AUTOCORRELATIONS - NAUTC=NAUTC+1 !FOUND - I=I+1 !FIND MORE - END DO - ONIFR=STHJ(STH_NIFR_J)-NAUTC !OUTPUT IFRS - OSHJ(54)=WNFEOF(OMCA) !SET IFR POINTER - IF (.NOT.WNFWR(OMCA,2*ONIFR,DUMMYI(NAUTC+1),OSHJ(54))) THEN - GOTO 11 !WRITE IFR - END IF - CIFR(1)=STHJ(STH_IFRP_J) !SAVE CHECK POINTERS - CIFR(2)=OSHJ(54) - ELSE - OSHJ(54)=CIFR(2) !SET IFR POINTER - END IF - END IF - OSHI(71)=(440+4*ONIFR) - 1 *STHI(STH_PLN_I) !DATA LENGTH - J0=WNFEOF(OMCA) !PTR SET HEADER - DO I=0,STHI(STH_PLN_I)-1 !SET POL. DATA - OSHI(104+I)=ONIFR !# IFR - OSHJ(54+I)=OSHJ(54) !PTR IFR TABLE - OSHJ(58+I)=J0+400+I*(440+4*ONIFR) !PTR TO DATA - END DO - J1=OFHJ(11) !LINK SET: LAST SET - OFHJ(11)=J0 !NEW LAST - OSHJ(0)=40 !NEW LINK - IF (OFHJ(10).EQ.40) OFHJ(10)=J0 !NEW LINK HEAD - OSHJ(1)=J1 - IF (.NOT.WNFWR(OMCA,400,OSH(0),J0)) GOTO 10 !WRITE SET HEADER - IF (.NOT.WNFWR(OMCA,4,J0,J1)) GOTO 10 !SET IN CHAIN - IF (.NOT.WNFWR(OMCA,192,OFH(0),0)) GOTO 10 !WRITE FILE HEADER - CALL WNCTXT(F_TP,'!AS being copied to Sector !UI', - 1 SETSTR,OSHI(70)) -C -C COPY DATA -C - J0=J0+400 !OUTPUT POINTER - DO I=0,STHJ(STH_SCN_J)-1 !ALL SCANS - IF (.NOT.WNFRD(FCAIN,SCHHDL,SCH(0), - 1 STHJ(STH_SCNP_J)+I*STHJ(STH_SCNL_J))) GOTO 11 !READ SCH - IF (.NOT.WNFRD(FCAIN,6*STHI(STH_PLN_I)*STHJ(STH_NIFR_J), - 1 ODAT(0,0),STHJ(STH_SCNP_J)+I*STHJ(STH_SCNL_J)+ - 1 SCHHDL)) GOTO 11 !READ DATA - DO I1=0,STHI(STH_PLN_I)-1 !ALL POL. - CALL WNGMVZ(440,OSC(0,I1)) !EMPTY SCAN HEADER - OSCI(0,I1)=2 !VERSION - OSCI(1,I1)=440 !LENGTH - OSCE(1,I1)=SCHE(SCH_HA_E) !HA - OSCE(2,I1)=SCHE(SCH_SCAL_E) !SCALE - IF (IAND(SCHJ(SCH_BITS_J),FL_ALL).EQ.0) THEN !NOT DELETED - OSC(38,I1)=0 - ELSE - OSC(38,I1)=1 !DELETE SCAN - END IF - OSCE(12,I1)=SCHE(SCH_EXT_E) !EXTINCTION - OSCE(13,I1)=SCHE(SCH_REFR_E) !REFRACTION - IF (I1.EQ.0) THEN !SET XX - OSCE(3,I1)=SCHE(SCH_REDNS_E+1) !RED. PHASE NOISE - OSCE(4,I1)=SCHE(SCH_ALGNS_E+1) !ALIGN PHASE NOISE - OSCE(5,I1)=SCHE(SCH_ALGNS_E+0) !ALIGN GAIN NOISE - OSCE(7,I1)=SCHE(SCH_REDNS_E+0) !RED. GAIN NOISE - DO I2=0,STHTEL-1 !CORRECTIONS - I3=2*I2 !OFFSET - OSCE(72+I2,I1)=SCHE(SCH_REDC_E+I3+0) !RED. GAIN - OSCE(28+I2,I1)=SCHE(SCH_REDC_E+I3+1) !RED. PHASE - OSCE(58+I2,I1)=SCHE(SCH_REDC_E+I3+0)+ !SRT GAIN - 1 SCHE(SCH_ALGC_E+I3+0)+ - 1 SCHE(SCH_OTHC_E+I3+0) - OSCE(14+I2,I1)=SCHE(SCH_REDC_E+I3+1)+ !SRT PHASE - 1 SCHE(SCH_ALGC_E+I3+1)+ - 1 SCHE(SCH_OTHC_E+I3+1) - END DO - ELSE IF ((I1.EQ.1 .AND. STHI(STH_PLN_I).EQ.2) .OR. - 1 (I1.EQ.3 .AND. STHI(STH_PLN_I).EQ.4)) THEN !SET YY - OSCE(3,I1)=SCHE(SCH_REDNS_E+3) !RED. PHASE NOISE - OSCE(4,I1)=SCHE(SCH_ALGNS_E+3) !ALIGN PHASE NOISE - OSCE(5,I1)=SCHE(SCH_ALGNS_E+2) !ALIGN GAIN NOISE - OSCE(7,I1)=SCHE(SCH_REDNS_E+2) !RED. GAIN NOISE - DO I2=0,STHTEL-1 !CORRECTIONS - I3=2*STHTEL+2*I2 !OFFSET - OSCE(72+I2,I1)=SCHE(SCH_REDC_E+I3+0) !RED. GAIN - OSCE(28+I2,I1)=SCHE(SCH_REDC_E+I3+1) !RED. PHASE - OSCE(58+I2,I1)=SCHE(SCH_REDC_E+I3+0)+ !SRT GAIN - 1 SCHE(SCH_ALGC_E+I3+0)+ - 1 SCHE(SCH_OTHC_E+I3+0) - OSCE(14+I2,I1)=SCHE(SCH_REDC_E+I3+1)+ !SRT PHASE - 1 SCHE(SCH_ALGC_E+I3+1)+ - 1 SCHE(SCH_OTHC_E+I3+1) - END DO - END IF - OSCE(6,I1)=SCHE(SCH_MAX_E) !MAX. COS/SIN - DO I2=NAUTC,ONIFR-1 !ALL DATA - I3=I2-NAUTC !OUTPUT POINTER - I4=ODAT(0,I1+I2*STHI(STH_PLN_I)) !WEIGHT/FLAG - IF (IAND(UFL,I4).EQ.0) THEN !NOT FLAGGED DATA - OSCI(220+2*I3,I1)=ODAT(1,I1+I2*STHI(STH_PLN_I)) !COS - OSCI(220+2*I3+1,I1)=ODAT(2,I1+I2*STHI(STH_PLN_I)) !SIN - ELSE - OSCI(220+2*I3,I1)=-32768 - OSCI(220+2*I3+1,I1)=-32768 - END IF - END DO - IF (.NOT.WNFWR(OMCA,440+4*ONIFR,OSC(0,I1), - 1 J0)) GOTO 10 !WRITE DATA - J0=J0+440+4*ONIFR !OUTPUT PTR - END DO - END DO - GOTO 100 !NEXT SET -C - 800 CONTINUE - CALL WNFCL(OMCA) !CLOSE OUTPUT - CALL WNFCL(FCAIN) !CLOSE INPUT - RETURN !READY -C -C - END diff --git a/src/nscan/nscpfh.for b/src/nscan/nscpfh.for deleted file mode 100644 index 46dea03ed6d9d7ad4c4512ac445160f617c5a68c..0000000000000000000000000000000000000000 --- a/src/nscan/nscpfh.for +++ /dev/null @@ -1,63 +0,0 @@ -C+ NSCPFH.FOR -C WNB 900810 -C -C Revisions: -C HjV 930311 Change some text -C CMV 930921 Do not display GFH version (confuses with set header version) -C - SUBROUTINE NSCPFH(PTYPE,INFCA) -C -C Show SCN file header -C -C Result: -C -C CALL NSCPFH ( PTYPE_J:I, INFCA_J:I) -C Show on output PTYPE the file header -C of file INFCA. -C -C Include files: -C - INCLUDE 'WNG_DEF' - INCLUDE 'GFH_O_DEF' !GENERAL FILE HEADER -C -C Parameters: -C -C -C Arguments: -C - INTEGER PTYPE !PRINT TYPE (f_p, f_t ETC) - INTEGER INFCA !FILE DESCRIPTOR -C -C Function references: -C - LOGICAL WNFRD !READ DATA -C -C Data declarations: -C - BYTE GFH(0:GFHHDL-1) !FILE HEADER -C- -C -C GET HEADER -C - IF (.NOT.WNFRD(INFCA,GFHHDL,GFH,0)) THEN - CALL WNCTXT(PTYPE,'Read error on input node') - RETURN - END IF -C -C SHOW HEADER -C - CALL WNCTXT(PTYPE,'!/File description of node !AD\:!/', - 1 GFH(GFH_NAME_1),GFH_NAME_N) - CALL WNCTXT(PTYPE,'Created: !AD !AD Revision(!UJ): !AD !AD', - 1 GFH(GFH_CDAT_1),GFH_CDAT_N, - 1 GFH(GFH_CTIM_1),GFH_CTIM_N, - 1 GFH(GFH_RCNT_1), - 1 GFH(GFH_RDAT_1),GFH_RDAT_N, - 1 GFH(GFH_RTIM_1),GFH_RTIM_N) - CALL WNCTXT(PTYPE,'File contains !UJ datasectors in !UJ groups!/', - 1 GFH(GFH_NLINK_1),GFH(GFH_NLINKG_1)) -C - RETURN -C -C - END diff --git a/src/nscan/nscpfl.for b/src/nscan/nscpfl.for deleted file mode 100644 index eb066968b3a16eb6b286b508698036e55645b04f..0000000000000000000000000000000000000000 --- a/src/nscan/nscpfl.for +++ /dev/null @@ -1,334 +0,0 @@ -C+ NSCPFL.FOR -C WNB 900810 -C -C Revisions: -C HjV 930311 Change some text -C CMV 931220 Add overview option (basically taken -C from NCOOVV but without the pointers) -C WNB 931222 Correct overview heading -C CMV 940314 Add OVERVIEW for overview-level -C CMV 940317 Rather not ask OVERVIEW if LAYOUT requested -C CMV 940427 Correct bug in Group overview (why did nobody notice?) -C CMV 940601 Change format for printing CPOL -C JPH 940824 Improve text of layout list. -C Remove OVERVIEW default. (Now in NCOMM.PEF) -C CMV 950122 Mention layout values are maxima. -C JPH 960126 Add ALTOBS -C JPH 960518 Widen field for abs. sector number from 3 to 5 -C JPH 960612 Bug fixes: Right-justify SETNAM and shift right by 2 pos C JPH 960614 Format fine-tuning to maximise space for Field -C - SUBROUTINE NSCPFL(PTYPE,INFCA,NODIN,OVV) -C -C Show SCN file layout -C -C Result: -C -C CALL NSCPFL ( PTYPE_J:I, INFCA_J:I, NODIN_C(*):I, OVV_L:I) -C Show on output PTYPE the file layout -C of file INFCA (if OVV is .false.) or -C give an overview (if OVV is .true.) -C -C Include files: -C - INCLUDE 'WNG_DEF' - INCLUDE 'STH_O_DEF' !SET HEADER - INCLUDE 'GFH_O_DEF' !GENERAL FILE HEADER - INCLUDE 'SGH_O_DEF' !SUB-GROUP HEADER - INCLUDE 'OHW_O_DEF' !OH BLOCK -C -C Parameters: -C -C -C Arguments: -C - INTEGER PTYPE !PRINT TYPE (f_p, f_t ETC) - INTEGER INFCA !FILE DESCRIPTOR - CHARACTER NODIN*(*) !NODE NAME - LOGICAL OVV !OVERVIEW (else LAYOUT)? -C -C Function references: -C - LOGICAL WNDPAR !Get input - LOGICAL WNFRD !READ DATA - INTEGER WNFEOF !GET FILE POINTER - INTEGER WNCALN !Length of string - LOGICAL NSCSTG !GET DATASET - CHARACTER*32 WNTTSG !MAKE SET NAME -C -C Data declarations: -C - CHARACTER*10 LVL !OVERVIEW level - INTEGER SET(0:7,0:1) !ALL SETS - INTEGER SNAM(0:7) !SET NAME - INTEGER STHP !SET POINTER - INTEGER PSNAM(0:7) !previous sector name - CHARACTER*19 CSNAM !ASCII sector name - REAL HAE !end HA - INTEGER CCHN,CFLD,CSEC,CPOL !Channel, field, sector and pol. count - INTEGER FCHN,FFLD,FSEC !Count for first one only - CHARACTER*80 LINE !Buffer for Group Overview - CHARACTER*12 CATEG,OBSDATE !Items from OH block - INTEGER*2 PROJECT ! idem -C - BYTE GFH(0:GFHHDL-1) !FILE HEADER - BYTE SGH(0:SGHHDL-1,0:7) !SUB-GROUP HEADER - INTEGER SGHJ(0:SGHHDL/4-1,0:7) - EQUIVALENCE(SGH,SGHJ) -C - BYTE STH(0:STHHDL-1) !SET HEADER - INTEGER*2 STHI(0:STHHDL/2-1) - INTEGER STHJ(0:STHHDL/4-1) - REAL STHE(0:STHHDL/4-1) - DOUBLE PRECISION STHD(0:STHHDL/8-1) - EQUIVALENCE (STH,STHI,STHJ,STHE,STHD) - BYTE OHW(0:OHWHDL-1) !OH - INTEGER*2 OHWI(0:OHWHDL/2-1) - INTEGER OHWJ(0:OHWHDL/4-1) - REAL OHWE(0:OHWHDL/4-1) - REAL*8 OHWD(0:OHWHDL/8-1) - EQUIVALENCE (OHW,OHWI,OHWJ,OHWE,OHWD) -C- -C -C For overview, ask level; default to Observations/Groups -C - IF (OVV) THEN - IF (.NOT.WNDPAR('OVERVIEW',LVL,LEN(LVL),J)) THEN - LVL='O' - ELSE IF (E_C.EQ.DWC_NULLVALUE.OR. - 1 E_C.EQ.DWC_WILDCARD) THEN - LVL='O' - END IF - END IF -C -C INIT -C - DO I=0,7 !SET SET *.*.*.*.*.*.* - DO I1=0,1 - SET(I,I1)=0 - END DO - SET(I,1)=-1 !1 LINE - END DO - SET(0,0)=1 !1 LINE -C -C SHOW NAME AND SIZE -C - IF (NODIN.EQ.' ') THEN - IF (.NOT.WNFRD(INFCA,GFHHDL,GFH,0)) THEN - CALL WNCTXT(PTYPE, - 1 '!/File description of SCN node (!UJ bytes):!/', - 1 WNFEOF(INFCA)) - ELSE - CALL WNCTXT(PTYPE, - 1 '!/File description of SCN node !AD\ (!UJ bytes):!/', - 1 GFH(GFH_NAME_1),GFH_NAME_N,WNFEOF(INFCA)) - END IF - ELSE - CALL WNCTXT(PTYPE, - 1 '!/File layout of SCN node !AS (!UJ bytes):!/', - 1 NODIN,WNFEOF(INFCA)) - END IF -C -C SHOW LAYOUT -C - IF (.NOT.OVV) THEN - DO WHILE(NSCSTG(INFCA,SET,STH,STHP,SNAM)) - DO I=0,7 !CLEAR LEVEL COUNT - SGHJ(SGH_HEADH_J-SGH_LINKG_J,I)=0 - END DO - I=SET(1,0)-1 !CURRENT LEVEL - IF (.NOT.WNFRD(INFCA,SGHHDL-SGH_LINKG_1,SGH(0,I), - 1 SET(3,0)+SGH_LINKG_1)) THEN !READ TOP - 10 CONTINUE - CALL WNCTXT(PTYPE,'Error reading file') - RETURN - END IF - DO WHILE(I.GT.0) !READ LEVELS - I=I-1 - IF (.NOT.WNFRD(INFCA,SGHHDL-SGH_LINKG_1,SGH(0,I), - 1 SGHJ(SGH_HEADH_J-SGH_LINKG_J,I+1))) GOTO 10 - END DO - SNAM(2)=-1 !ONLY grp and obs LEVELS - CALL WNCTXT(PTYPE,'!AS!12C: !4$UJ fields * !4$UJ '// - 1 'channels * !4$UJ sectors for !AD', - 1 WNTTSG(SNAM(0),0), - 1 SGHJ(SGH_LINKGN_J-SGH_LINKG_J,1), - 1 SGHJ(SGH_LINKGN_J-SGH_LINKG_J,2), - 1 SGHJ(SGH_LINKGN_J-SGH_LINKG_J,3), - 1 STH(STH_FIELD_1),STH_FIELD_N) - IF (.NOT.WNFRD(INFCA,SGHHDL,SGH(0,0),SET(3,0))) GOTO 10 - !READ CURRENT - DO WHILE (SET(1,0).GT.2) !DECREASE LEVEL - SET(1,0)=SET(1,0)-1 !DECREASE LEVEL - SET(3,0)=SGHJ(SGH_HEADH_J,0)-SGH_LINKG_1+SGH_LINK_1 !LOWER HEADER - IF (.NOT.WNFRD(INFCA,SGHHDL,SGH(0,0),SET(3,0))) GOTO 10 !CURRENT - SET(4,0)=SGHJ(SGH_HEADH_J,0) !NEW LOWER HEAD - END DO - END DO - CALL WNCTXT(PTYPE,'NOTE: Values are maxima, '// - 1 '65 channels means highest channel is 64') - CALL WNCTXT(PTYPE,' ') - ELSE -C -C Else print summary of contents -C Heading first -C - IF (LVL(1:1).EQ.'O') THEN ! OBS overview - CALL WNCTXT (F_TP, !print heading - 1 'grp.obs Obs SP/TP'// !SNAM, TYPE - 1 ' !-12$AS'// !field - 1 ' !-7$AS'// !volgnr - 1 ' !6$AS'// !Project - 1 ' !11$AS'// !Date - 1 ' Chn Fld Sect Pol!/', - 1 'Field','Volgnr','Proj.','Date/Time') -C - ELSE ! sector overview - CALL WNCTXT (F_TP, !print heading - 1 'grp.obs.fld.chn.sec!5$AS'// !SNAM, SETN - 1 ' !-11$AS'// !field - 1 ' !7$AS'// !volgnr - 1 ' !7$AS!7$AS'// !FREQ, BAND - 1 ' !5$AS!5$AS'// !HAB, HAE - 1 '!4$AS'// !SCN - 1 ' !-4$AS'// !NIFR,PLN - 1 '!/', - 1 '(#)', - 1 'Field', - 1 'Volgnr', - 1 'FREQ', 'BAND', - 1 'HAB','HAE', - 1 'SCN', - 1 'IF P') - END IF -C - DO I=0,7 !No sets printed yet - PSNAM(I)=-999 - END DO -C -C Loop over all sectors -C - DO WHILE (NSCSTG(INFCA,SET,STH,STHP,SNAM))!all sets - HAE= STHE(STH_HAB_E) + (STHJ(STH_SCN_J)-1)*STHE(STH_HAI_E) - IF (LVL(1:1).NE.'O') THEN -C -C Field/channel/sector list: lots of output -C - CSNAM=WNTTSG(SNAM,3) !get "." set name - DO I=0,7 - IF (SNAM(I).NE.PSNAM(I)) GOTO 20 !compare against previous - END DO - 20 CONTINUE - IF (I.GT.0) CSNAM(1:4*I)=' ' !blank out components that have -C ! not changed -C - IF (SNAM(0).NE.PSNAM(0) .OR. ! new group - 1 ( LVL(1:1).EQ.'A' .AND. - 1 (SNAM(1).NE.PSNAM(1) )).OR.! ALTOBS with new obs - 1 ( LVL(1:1).EQ.'F' .AND. ! FIELD level with new field - 1 (SNAM(1).NE.PSNAM(1).OR. - 1 SNAM(2).NE.PSNAM(2) )).OR. - 1 ( LVL(1:1).EQ.'C' .AND. ! CHANNEL level with new channel - 1 (SNAM(3).NE.PSNAM(3).OR. - 1 SNAM(2).NE.PSNAM(2).OR. - 1 SNAM(1).NE.PSNAM(1) )).OR. - 1 LVL(1:1).EQ.'S') THEN ! SECTOR level - CALL WNCTXT (F_TP, - 1 '!19$AS!5$UJ5'// !SNAM, SETN - 1 ' !-11$AD'// !field - 1 ' !7$UJ7'// !volgnr - 1 ' !7$D7.2!7$E7.3'// !FREQ, BAND - 1 ' !5$EAF5.1!5$EAF5.1'// !HAB, HAE - 1 '!4$UJ4'// !SCN - 1 ' !2$UJ2 !1$UI1', !NIFR,PLN - 1 CSNAM,STHJ(STH_SETN_J), - 1 STH(STH_FIELD_1),STH_FIELD_N, - 1 STHJ(STH_VNR_J), - 1 STHD(STH_FRQ_D),STHE(STH_BAND_E), - 1 STHE(STH_HAB_E),HAE, - 1 STHJ(STH_SCN_J), - 1 STHJ(STH_NIFR_J),STHI(STH_PLN_I)) - END IF -C -C Group list: only after all channels/pointing centra counted -C - ELSE - IF (SNAM(0).NE.PSNAM(0).OR.SNAM(1).NE.PSNAM(1)) THEN - IF (PSNAM(0).NE.-999) CALL WNCTXT(F_TP, - 1 '!AS !4$UJ4 !4$UJ4 !4$UJ4 !3$UJ3', - 1 LINE(:57),CCHN,CFLD,CSEC,CPOL) -C -C Prepare for next observation -C - CSNAM=WNTTSG(SNAM,3) !get "." set name - CCHN=1 !Only this channel so far - CFLD=1 !Only this field so far - CSEC=1 !Only this sector so far - CPOL=STHI(STH_PLN_I) !Number of pol.s - FCHN=SNAM(3) !Count for first sector - FFLD=SNAM(2) ! only - FSEC=SNAM(4) - CATEG='??? ??/??' !Reset type - PROJECT= -1 !Reset project - OBSDATE='??????/????' !Observation date - IF (STHJ(STH_OHP_J).NE.0) THEN !Read New OH if any - IF (WNFRD(INFCA,STHJ(STH_NOH_J),OHW, - 1 STHJ(STH_OHP_J))) THEN - PROJECT=OHWI(OHW_PROJECT_I) - IF (OHW(OHW_CATEG_1).EQ.ICHAR('I')) THEN - CALL WNCTXS(CATEG,'Cal !AF/!AF', - 1 OHW(OHW_SPEFU_1),OHW_SPEFU_N, !Special functions - 1 OHW(OHW_TYPE_1), OHW_TYPE_N) !Obs. type-code - ELSE - CALL WNCTXS(CATEG,'Src !AF/!AF', - 1 OHW(OHW_SPEFU_1),OHW_SPEFU_N, !Special functions - 1 OHW(OHW_TYPE_1), OHW_TYPE_N) !Obs. type-code - END IF - CALL WNCTXS(OBSDATE, - 1 '!2$ZI!2$ZI!2$ZI/!2$ZI!2$ZI', - 1 OHWI(OHW_DATE_I+1),OHWI(OHW_DATE_I+2), - 1 OHWI(OHW_DATE_I+3), - 1 OHWI(OHW_DATE_I+4),OHWI(OHW_DATE_I+5)) - END IF - END IF - CALL WNCTXS(LINE, - 1 '!7$AS !9$AS'// !SNAM, TYPE - 1 ' !-12$AD'// !field - 1 ' !7$UJ'// !volgnr - 1 ' !6$UI'// !Project - 1 ' !11$AS', !Date - 1 CSNAM(1:7),CATEG(1:9), - 1 STH(STH_FIELD_1),STH_FIELD_N, - 1 STHJ(STH_VNR_J),PROJECT,OBSDATE(1:11)) -C -C If same observation: just count -C - ELSE - IF (SNAM(3).EQ.FCHN.AND.SNAM(4).EQ.FSEC.AND. - 1 SNAM(2).NE.FFLD) CFLD=CFLD+1 - IF (SNAM(3).NE.FCHN.AND.SNAM(4).EQ.FSEC.AND. - 1 SNAM(2).EQ.FFLD) CCHN=CCHN+1 - IF (SNAM(3).EQ.FCHN.AND.SNAM(4).NE.FSEC.AND. - 1 SNAM(2).EQ.FFLD) CSEC=CSEC+1 - END IF - END IF -C - DO I=0,7 - PSNAM(I)=SNAM(I) - END DO - END DO -C -C Print last group -C - IF (LVL(1:1).EQ.'O') THEN - IF (PSNAM(0).NE.-999) CALL WNCTXT(F_TP, - 1 '!AS !4$UJ4 !4$UJ4 !4$UJ4 !3$UJ3', - 1 LINE(:57),CCHN,CFLD,CSEC,CPOL) - END IF - CALL WNCTXT(PTYPE,' ') -C - END IF -C - RETURN -C -C - END diff --git a/src/nscan/nscpls.for b/src/nscan/nscpls.for deleted file mode 100644 index bdf70db06ba73decdfc75158eacfda57bb658549..0000000000000000000000000000000000000000 --- a/src/nscan/nscpls.for +++ /dev/null @@ -1,192 +0,0 @@ -C+ NSCPLS.FOR -C WNB 930825 -C -C Revisions: -C JPH 940909 Clear dynamic prompts -C -C - LOGICAL FUNCTION NSCPLS(TYP,SPOL) -C -C Select polarisations to use/to do -C -C Result: -C NSCPLS_L = NSCPLS ( TYP_J:I, SPOL_J:O) -C Get which polarisations to use by setting -C in SPOL bits 0,1,2,3 for XX,XY,YX,YY -C TYP: -C 0 = use SPOL to prompt -C 1 = use XYX to prompt -C 2 = use XY to prompt -C 3 = use YX -C 11= use IQUV to prompt -C 12= use IQ to prompt -C 13= use UV -C NSCPL1_L = NSCPL1 ( TYP_J:I, SPOL_J:O, STHJ_J(0:*):I) -C As PLS -C NSCPL2_L = NSCPL2 ( TYP_J:I, SPOL_J:O) -C Asks XYX or Stokes -C -C Pin references: -C -C SELECT_XYX -C SELECT_IQXY -C -C Include files: -C - INCLUDE 'WNG_DEF' - INCLUDE 'CBITS_DEF' - INCLUDE 'STH_O_DEF' !SET HEADER -C -C Entry points: -C - LOGICAL NSCPL1, NSCPL2 -C -C Parameters: -C -C -C Arguments: -C - INTEGER TYP !SELECTION TYPE - INTEGER SPOL !SELECTION POL. WORD - INTEGER STHJ(0:*) !SET HEADER -C -C Function references: -C - LOGICAL WNDPAR !GET USER DATA -C -C Data declarations: -C - LOGICAL PL2 !PL2 ENTRY - CHARACTER*4 POLC,POLD !POL. CODE -C- -C -C NSCPLS -C - PL2=.FALSE. !NOT PL2 - GOTO 100 -C -C NSCPL1 -C - ENTRY NSCPL1(TYP,SPOL,STHJ) -C - PL2=.FALSE. !NOT PL2 - GOTO 100 -C -C NSCPL2 -C - ENTRY NSCPL2(TYP,SPOL) -C - PL2=.TRUE. !PL2 - GOTO 100 -C -C INIT -C - 100 CONTINUE - NSCPLS=.TRUE. !ASSUME OK - IF (TYP.EQ.0) THEN !USE SPOL TO PROMPT - IF (.NOT.PL2) SPOL=IAND(SPOL,NOT(STOKES_P)) !NO STOKES ALLOWED - IF (IAND(SPOL,IQUV_M).EQ.IQUV_M) THEN - POLD='IQUV' - ELSE IF (IAND(SPOL,IQ_M).EQ.IQ_M) THEN - POLD='IQ' - ELSE IF (IAND(SPOL,UV_M).EQ.UV_M) THEN - POLD='UV' - ELSE IF (IAND(SPOL,Q_M).EQ.Q_M) THEN - POLD='Q' - ELSE IF (IAND(SPOL,U_M).EQ.U_M) THEN - POLD='U' - ELSE IF (IAND(SPOL,V_M).EQ.V_M) THEN - POLD='V' - ELSE IF (IAND(SPOL,STOKES_P).EQ.STOKES_P) THEN - POLD='I' - ELSE IF (IAND(SPOL,XYX_M).EQ.XYX_M) THEN - POLD='XYX' - ELSE IF (IAND(SPOL,XY_M).EQ.XY_M) THEN - POLD='XY' - ELSE IF (IAND(SPOL,YX_M).EQ.YX_M) THEN - POLD='YX' - ELSE IF (IAND(SPOL,Y_M).EQ.Y_M) THEN - POLD='Y' - ELSE IF (IAND(SPOL,YYX_M).EQ.YYX_M) THEN - POLD='YYX' - ELSE IF (IAND(SPOL,XXY_M).EQ.XXY_M) THEN - POLD='YYX' - ELSE - POLD='X' - END IF - ELSE IF (PL2 .AND. TYP.EQ.12) THEN - POLD='IQ' - ELSE IF (TYP.EQ.2 .OR. TYP.EQ.12) THEN - POLD='XY' - ELSE IF (PL2 .AND. TYP.EQ.13) THEN - POLD='UV' - ELSE IF (TYP.EQ.3 .OR. TYP.EQ.13) THEN - POLD='YX' - ELSE IF (PL2) THEN - POLD='IQUV' - ELSE - POLD='XYX' !USE XYX - END IF -C -C GET USER DATA -C - 11 CONTINUE - A_J(0)=1 ! inhibit clearing of - ! dynamic prompt - IF (PL2) THEN - JS=WNDPAR('SELECT_IQXY',POLC,LEN(POLC),J0,POLD) !GET INFO - ELSE - JS=WNDPAR('SELECT_XYX',POLC,LEN(POLC),J0,POLD) !GET INFO - END IF - IF (.NOT.JS) THEN - IF (E_C.EQ.DWC_ENDOFLOOP) THEN - NSCPLS=.FALSE. !SHOW END - GOTO 20 !READY - END IF - GOTO 11 !REPEAT - ELSE IF (J0.EQ.0) THEN - NSCPLS=.FALSE. !SHOW END - GOTO 20 !READY - ELSE IF (J0.LT.0) THEN !ASSUME DEFAULT - POLC=POLD - END IF -C -C ANALYSE -C - IF (POLC.EQ.'XYX') THEN !SET CODE - SPOL=XYX_M !ALL FOUR - ELSE IF (POLC.EQ.'XY') THEN - SPOL=XY_M !XX,YY - ELSE IF (POLC.EQ.'YX') THEN - SPOL=YX_M !XY,YX - ELSE IF (POLC.EQ.'Y') THEN - SPOL=Y_M !YY - ELSE IF (POLC.EQ.'YYX') THEN - SPOL=YYX_M !YX - ELSE IF (POLC.EQ.'XXY') THEN - SPOL=XXY_M !XY - ELSE IF (POLC.EQ.'IQUV') THEN - SPOL=IQUV_M - ELSE IF (POLC.EQ.'IQ') THEN - SPOL=IQ_M - ELSE IF (POLC.EQ.'UV') THEN - SPOL=UV_M - ELSE IF (POLC.EQ.'I') THEN - SPOL=I_M - ELSE IF (POLC.EQ.'Q') THEN - SPOL=Q_M - ELSE IF (POLC.EQ.'U') THEN - SPOL=U_M - ELSE IF (POLC.EQ.'V') THEN - SPOL=V_M - ELSE - SPOL=X_M !XX - END IF -C - 20 CONTINUE - CALL WNDPOHC ! clear dynamic prompt -C - RETURN -C -C - END diff --git a/src/nscan/nscpsh.for b/src/nscan/nscpsh.for deleted file mode 100644 index 63022d6e3183c14ff56b6e48be3b1b283ec8db30..0000000000000000000000000000000000000000 --- a/src/nscan/nscpsh.for +++ /dev/null @@ -1,103 +0,0 @@ -C+ NSCPSH.FOR -C WNB 900810 -C -C Revisions: -C WNB 920609 Typo in MJD printout -C WNB 921102 Cater for full HA range -C HjV 930311 Change some text -C WNB 930819 Show dipole code; remove L_ -C CMV 930821 Show set header version number -C CMV 940107 Change width of FREQ field -C CMV 940209 Pass and print Category code -C - SUBROUTINE NSCPSH(PTYPE,STH,SNAM,CATEG) -C -C Show SCN set header -C -C Result: -C -C CALL NSCPSH ( PTYPE_J:I, STH_B(0:*):I, SNAM_J(0:7):I, CATEG_C*(*):I) -C Show on output PTYPE the set header -C STH with name SNAM. CATEG is a -C character string printed as the -C catagory of the observation. -C -C Include files: -C - INCLUDE 'WNG_DEF' - INCLUDE 'STH_O_DEF' !SET HEADER -C -C Parameters: -C -C -C Arguments: -C - INTEGER PTYPE !PRINT TYPE (F_P, F_T ETC) - BYTE STH(0:*) !SET HEADER - INTEGER SNAM(0:*) !SET NAME - CHARACTER CATEG*(*) !Category -C -C Function references: -C - INTEGER WNGGJ !GET J VALUE - REAL WNGGE !GET E VALUE - CHARACTER*32 WNTTSG !GET SET NAME -C -C Data declarations: -C -C- -C -C SHOW HEADER -C - CALL WNCTXT(PTYPE,'!/Sector !AS(#!UJ) - !AD - '// - 1 'Channel !UI - !UJ scans - '// - 1 '!UI pols - Version !UI!/', - 1 WNTTSG(SNAM,0),STH(STH_SETN_1), - 1 STH(STH_FIELD_1),STH_FIELD_N, - 1 STH(STH_CHAN_1),STH(STH_SCN_1), - 1 STH(STH_PLN_1),STH(STH_VER_1)) - CALL WNCTXT(PTYPE,'RA (date)!12C!9$DPF9.4 deg'// - 1 '!29C\HA(start)!41C!7$EAF7.2 deg'// - 1 '!56CObs. yy.day!71C!3$UI\.!3$ZI', - 1 STH(STH_RA_1),STH(STH_HAB_1), - 1 STH(STH_OBS_1+LB_I),STH(STH_OBS_1)) - CALL WNCTXT(PTYPE,'DEC(date)!12C!9$DAF9.4 deg'// - 1 '!29C\HA(end)!41C!7$EAF7.2 deg'// - 1 '!56CDipoles!66C!8$XJ', - 1 STH(STH_DEC_1),WNGGE(STH(STH_HAB_1))+ - 1 (WNGGJ(STH(STH_SCN_1))-1)* - 1 WNGGE(STH(STH_HAI_1)), - 1 STH(STH_DIPC_1)) - CALL WNCTXT(PTYPE,'RA (!E6.0)!12C!9$DPF9.4 deg'// - 1 '!29C\HA(step)!42C!6$EAF6.2 deg'// - 1 '!56CEpoch!70C!7$E7.2', - 1 STH(STH_EPO_1),STH(STH_RAE_1), - 1 STH(STH_HAI_1),STH(STH_OEP_1)) - CALL WNCTXT(PTYPE,'DEC(!E6.0)!12C!9$DAF9.4 deg'// - 1 '!29C\HA(average)!42C!6$EAF6.2 deg'// - 1 '!56CVolgnummer!66C!8$UJ', - 1 STH(STH_EPO_1),STH(STH_DECE_1),STH(STH_HAV_1), - 1 STH(STH_VNR_1)) - CALL WNCTXT(PTYPE,'Frequency!11C!10$D10.4 MHz'// - 1 '!29C\# of ifrs!42C!3$UJ'// - 1 '!56CBackend!70C!4$UI', - 1 STH(STH_FRQ_1),STH(STH_NIFR_1),STH(STH_BEC_1)) - CALL WNCTXT(PTYPE,'Bandwidth!12C!9$E9.4 MHz'// - 1 '!29C\Prec. rot.!42C!6$EAF6.2 deg'// - 1 '!56CPointing Set!70C!4$UI', - 1 STH(STH_BAND_1),STH(STH_PHI_1),STH(STH_PTS_1)) - CALL WNCTXT(PTYPE,'Category!12C!AS'// - 1 '!56C\MJD(start)!69C!11$D12.5', - 1 CATEG,STH(STH_MJD_1)) - CALL WNCTXT(PTYPE,'!/Telescope positions 9, A, B, C, D = '// - 1 '!5E5.0', - 1 STH(STH_RTP_1+9*LB_E)) - CALL WNCTXT(PTYPE,'REDUN M.E. !8$4E8.1', - 1 STH(STH_REDNS_1)) - CALL WNCTXT(PTYPE,'ALIGN M.E. !8$4E8.1!/', - 1 STH(STH_ALGNS_1)) -C - RETURN -C -C - END diff --git a/src/nscan/nscpsl.for b/src/nscan/nscpsl.for deleted file mode 100644 index bd2dd3303333cedfb7ea187162f411ac394e986e..0000000000000000000000000000000000000000 --- a/src/nscan/nscpsl.for +++ /dev/null @@ -1,73 +0,0 @@ -C+ NSCPSL.FOR -C WNB 900810 -C -C Revisions: -C JPH 960624 Widen Maximum field fro 8 to 10 -C CMV 000928 Add arguments and line for identification -C - SUBROUTINE NSCPSL(PTYPE,SCH,SNAM,STH,ISCN) -C -C Show SCN header -C -C Result: -C -C CALL NSCPSL ( PTYPE_J:I, SCH_B(0:*):I), -C SNAM_J(0:7):I, STH_B(0:*):I, ISCN_J:I) -C Show on output PTYPE the scan header -C SCH using setname SNAM, set header -C STH en index ISCN for identification. -C ISCN should be 0 for the first scan -C in a set. -C -C Include files: -C - INCLUDE 'WNG_DEF' - INCLUDE 'SCH_O_DEF' !SCAN HEADER - INCLUDE 'STH_O_DEF' !SET HEADER -C -C Parameters: -C -C -C Arguments: -C - INTEGER PTYPE !PRINT TYPE (F_P, F_T ETC) - BYTE SCH(0:*) !SCAN HEADER - BYTE STH(0:*) !SET HEADER - INTEGER SNAM(0:7) !SET NAME - INTEGER ISCN !SCAN NUMBER IN SET -C -C Function references: -C - INTEGER WNGGJ !GET J VALUE - REAL WNGGE !GET E VALUE - CHARACTER*32 WNTTSG !SET NAME -C -C Data declarations: -C -C- -C -C SHOW HEADER -C - CALL WNCTXT(PTYPE, - 1 '!/Sector !AS(#!UJ) - scan !UJ of !UJ', - 1 WNTTSG(SNAM,0),STH(STH_SETN_1), - 1 ISCN+1,STH(STH_SCN_1)) - CALL WNCTXT(PTYPE,'HA!12C!9$EAF9.4 deg'// - 1 '!29C\Maximum!38C!10$E10.2 W.U.'// - 1 '!56CBits!66C!8$XJ', - 1 SCH(SCH_HA_1),SCH(SCH_MAX_1),SCH(SCH_BITS_1)) - CALL WNCTXT(PTYPE,'Extinction!13C!9$E9.5 '// - 1 '!29C\Refraction!43C!8$E8.5 '// - 1 '!56CFaraday!68C!7$EAR7.1 deg', - 1 1.+WNGGE(SCH(SCH_EXT_1)), - 1 1.+WNGGE(SCH(SCH_REFR_1)), - 1 SCH(SCH_FARAD_1)) - CALL WNCTXT(PTYPE,'Red. noise: !13C!9$4E9.2', - 1 SCH(SCH_REDNS_1)) - CALL WNCTXT(PTYPE,'Align noise: !13C!9$4E9.2!/', - 1 SCH(SCH_ALGNS_1)) -C - RETURN -C -C - END diff --git a/src/nscan/nscpuv.for b/src/nscan/nscpuv.for deleted file mode 100644 index 56a82c18502ca390550d2f843b61a276c190b853..0000000000000000000000000000000000000000 --- a/src/nscan/nscpuv.for +++ /dev/null @@ -1,347 +0,0 @@ -C+ NSCPUV.FOR -C WNB 910226 -C -C Revisions: -C JPH 941213 No error message for wildcard disk labels -C CMV 950130 Print summary listing if more than one label -C - SUBROUTINE NSCPUV -C -C Formatted print UVFITS -C -C Result: -C -C CALL NSCPUV will print a formatted FITS file -C -C Include files: -C - INCLUDE 'WNG_DEF' - INCLUDE 'NSC_DEF' -C -C Parameters: -C - INTEGER LL,LLD2,LR !RECORD AND CARD IMAGE LENGTHS - PARAMETER (LL=80,LLD2=LL/2,LR=2880) -C -C Arguments: -C -C -C Function references: -C - LOGICAL WNFOP,WNFOPF !OPEN FILE - LOGICAL WNFRD !READ FILE - INTEGER WNCALN !STRING LENGTH - LOGICAL WNCASA !TEST IF ALPHABETIC - INTEGER WNCAJ !GET INTEGER FROM STRING -C -C Data declarations: -C - INTEGER CLAB !INDEX FOR LABEL - CHARACTER*160 INFILE !FILE NAME - INTEGER BTP !BITPIX - LOGICAL EXTS !EXTENSION SEEN - INTEGER EXTC !EXTENSION COUNT - INTEGER EXTN !FIELD WIDTH - INTEGER EXTR !# OF ENTRIES - INTEGER EP(0:30) !BUFFER POINTER/AXIS LENGTH - CHARACTER CN(0:30)*8 !AXIS NAMES - DOUBLE PRECISION CR(1:3,0:30) !REFERENCE POSITION - CHARACTER*300 EXTTP !OUTPUT CODE - INTEGER*2 EXTCD(0:1,0:30) !TRANSLATE EXTENSION - CHARACTER*256 EXTF !EXTENSION FORMAT - INTEGER*2 TRBUF(0:3) !TRANSL. BUF - DATA TRBUF/2,LLD2,0,0/ - CHARACTER*(LL) BUFTC - BYTE BUFTCB(LL) - EQUIVALENCE (BUFTC,BUFTCB) - DATA BUFTCB /LL*0/ - BYTE BUF(0:LR-1) - CHARACTER*(LR) BUFC - INTEGER*2 BUFI(0:LR/2-1) - INTEGER BUFJ(0:LR/4-1) - REAL BUFE(0:LR/4-1) - REAL BUFD(0:LR/8-1) - EQUIVALENCE(BUF,BUFC,BUFI,BUFJ,BUFE,BUFD) -C- -C -C PRELIMINARIES -C -C - CLAB=1 !Nothing done yet - IF (NLAB(1).NE.1) THEN - CALL WNCTXT(F_TP,' Lbl Object '// - 1 'BtP Axes Comment') - END IF -C - 100 CONTINUE !Loop over labels - IF (NLAB(1).LE.0) THEN !Wildcard - J0=CLAB !All labels - ELSE IF (CLAB.LE.NLAB(1)) THEN - J0=ILAB(CLAB,1) - ELSE - GOTO 900 - END IF - CLAB=CLAB+1 !Count this one -C - IF (UNIT.EQ.'D') THEN !DISK - CALL WNCTXS(INFILE,'!AS\.!6$ZJ',IFILE,J0) - IF (.NOT.WNFOP(IMCA,INFILE(1:WNCALN(INFILE)),'R')) THEN - IF (NLAB(1).GT.0) - 1 CALL WNCTXT(F_TP,'Cannot find file !AS',INFILE) - GOTO 900 !ERROR END - END IF - ELSE !TAPE - IF (.NOT.WNFOPF(IMCA,' ','R',0,0,0,J0)) THEN - CALL WNCTXT(F_TP,'Cannot find label !UJ',J0) - GOTO 900 - END IF - END IF -C -C Long listing if single label -C - IF (NLAB(1).EQ.1) THEN - CALL WNCFHD(F_P,3,'!40C\Listing of !AS, label !UJ',IFILE,J0) - CALL WNCFHD(F_P,4,' ') - CALL WNCFHD(F_P,5,' ') - CALL WNCTXT(F_P,'!^') - J=0 !DATA POINTER - EXTS=.FALSE. !NO EXTENSION SEEN -C -C DO DATA -C - DO WHILE(WNFRD(IMCA,LL,BUF,J)) !READ LINE - J=J+LL - 10 CONTINUE - IF (BUFC(8:8).EQ.'=' .OR. BUFC(1:4).EQ.'END ' .OR. - 1 BUFC(1:4).EQ.'HIST' .OR. BUFC(1:4).EQ.'COMM') THEN !TEXT - CALL WNCTXT(F_P,'!4$XJ/!4$XJ !AL80', - 1 MOD(J-LL,LR),(J-LL)/LR,BUF) - IF (BUFC(1:8).EQ.'XTENSION') THEN !EXTENSION LINES - EXTS=.TRUE. !SET SEEN - EXTC=0 !EMPTY FORMAT - EP(0)=0 !OFFSET - EXTTP=' ' !CONVERSION - END IF - IF (EXTS) THEN !EXTENSION SEEN - IF (BUFC(1:5).EQ.'TFORM') THEN !FORMAT - I1=12 !POINTER - I1=I1-1 - I=WNCAJ(BUFC(1:LL),LL,I1) !REPEAT FACTOR - I1=I1+1 - IF (I.GT.0) THEN !SHOULD DO - EXTCD(1,EXTC)=I !SET TRANSLATION - IF (BUFC(I1:I1).EQ.'A') THEN - EXTCD(0,EXTC)=9 - EP(EXTC+1)=EP(EXTC)+I*1 - I1=WNCALN(EXTTP)+2 - CALL WNCTXS(EXTTP(I1:),'!!\!UJ$AL!UJ',I,I) - ELSE IF (BUFC(I1:I1).EQ.'I') THEN - EXTCD(0,EXTC)=2 - EP(EXTC+1)=EP(EXTC)+I*2 - I1=WNCALN(EXTTP)+2 - CALL WNCTXS(EXTTP(I1:),'!!\!UJ\SI',I) - ELSE IF (BUFC(I1:I1).EQ.'J') THEN - EXTCD(0,EXTC)=3 - EP(EXTC+1)=EP(EXTC)+I*4 - I1=WNCALN(EXTTP)+2 - CALL WNCTXS(EXTTP(I1:),'!!\!UJ\SJ',I) - ELSE IF (BUFC(I1:I1).EQ.'E') THEN - EXTCD(0,EXTC)=4 - EP(EXTC+1)=EP(EXTC)+I*4 - I1=WNCALN(EXTTP)+2 - CALL WNCTXS(EXTTP(I1:),'!!\!UJ\E',I) - ELSE IF (BUFC(I1:I1).EQ.'D') THEN - EXTCD(0,EXTC)=5 - EP(EXTC+1)=EP(EXTC)+I*8 - I1=WNCALN(EXTTP)+2 - CALL WNCTXS(EXTTP(I1:),'!!\!UJ\D',I) - END IF - EXTC=EXTC+1 - EXTCD(0,EXTC)=0 - EXTCD(1,EXTC)=0 - END IF - END IF - IF (BUFC(1:6).EQ.'NAXIS1') THEN !FIELD WIDTH - I1=12 - CALL WNCASB(BUFC,I1) - CALL WNCACJ(BUFC,I1,10,EXTN) - END IF - IF (BUFC(1:6).EQ.'NAXIS2') THEN !# OF ENTRIES - I1=12 - CALL WNCASB(BUFC,I1) - CALL WNCACJ(BUFC,I1,10,EXTR) - END IF - END IF - ELSE IF (BUFC(1:LL).EQ.BUFTC) THEN !0 LINE - CALL WNCTXT(F_P,'!4$XJ/!4$XJ lines with zeroes', - 1 MOD(J-LL,LR),(J-LL)/LR) - DO WHILE (WNFRD(IMCA,LL,BUF,J)) - J=J+LL - IF (BUFC(1:LL).NE.BUFTC) GOTO 10 - END DO - ELSE IF (.NOT.EXTS) THEN !DATA - J1=0 !CNT LINES - CALL WNTTTL(LL,BUFI,TRBUF,5) !MAKE FORMAT - CALL WNCTXT(F_P,'!132$11Q1!4$XJ/!4$XJ !6$#SI', - 1 MOD(J-LL,LR),(J-LL)/LR,LL/2,BUFI) - J1=J1+1 - 20 CONTINUE - DO WHILE (WNFRD(IMCA,LL,BUF,J)) - J=J+LL - IF (BUFC.EQ.BUFTC) GOTO 10 - IF (BUFC(8:8).EQ.'=' .OR. BUFC(1:4).EQ.'END ' .OR. - 1 BUFC(1:4).EQ.'HIST' .OR. BUFC(1:4).EQ.'COMM') GOTO 10 !TEXT - IF (J1.LT.10) THEN - CALL WNTTTL(LL,BUFI,TRBUF,5) !MAKE FORMAT - CALL WNCTXT(F_P,'!132$11Q1!4$XJ/!4$XJ !6$#SI', - 1 MOD(J-LL,LR),(J-LL)/LR,LL/2,BUFI) - ELSE IF (J1.EQ.10) THEN - CALL WNCTXT(F_P,'!4$XJ/!4$XJ ....', - 1 MOD(J-LL,LR),(J-LL)/LR) - END IF - J1=J1+1 - END DO - ELSE !EXTENSION - J1=J-LL !REPOSITION - DO I=1,MIN(2,EXTR) !2 FIELDS - IF (.NOT.WNFRD(IMCA,EXTN,BUF(0),J1)) GOTO 900 - J1=J1+EXTN - CALL WNTTTL(EXTN,BUF,EXTCD,5) !CORRECT FORMAT - CALL WNCTXT(F_P,'!132$11Q!4$XJ/!4$XJ'//EXTTP, - 1 MOD(J-LL,LR),(J-LL)/LR, - 1 BUF(EP(0)),BUF(EP(1)),BUF(EP(2)),BUF(EP(3)), - 1 BUF(EP(4)),BUF(EP(5)),BUF(EP(6)),BUF(EP(7)), - 1 BUF(EP(8)),BUF(EP(9)),BUF(EP(10)),BUF(EP(11)), - 1 BUF(EP(12)),BUF(EP(13)),BUF(EP(14)),BUF(EP(15)), - 1 BUF(EP(16)),BUF(EP(17)),BUF(EP(18)),BUF(EP(19))) - END DO - EXTS=.FALSE. - J1=10 - GOTO 20 !CONTINUE - END IF !END TEXT READ - END DO !END READ -C -C More than one label: shortlist -C - ELSE - J=0 !DATA POINTER - EXTS=.FALSE. !NO EXTENSION SEEN - EXTC=0 - EXTF='Unknown' - EXTTP=' ' - DO I=1,30 - EP(I)=0 - CN(I)='Unknown' - CR(1,I)=0 - CR(2,I)=0 - CR(3,I)=0 - END DO -C - DO WHILE(WNFRD(IMCA,LL,BUF,J)) !READ LINE - J=J+LL -C - IF ((BUFC(1:8).EQ.'COMMENT '.OR. - 1 BUFC(1:8).EQ.'HISTORY ').AND.EXTTP.EQ.' ') THEN - I=11 !CHECK IF FILLED - DO WHILE (I.LT.80.AND. .NOT.WNCASA(BUFC,I)) - I=I+1 - END DO - IF (I.LT.80) EXTTP=BUFC(10:) !FIRST COMMENT -C - ELSE IF (BUFC(8:8).EQ.'=') THEN !TEXT -C - IF (BUFC(1:8).EQ.'XTENSION') THEN !EXTENSION LINES -C - IF (EXTC.EQ.0) THEN !NOT YET PRINTED - CALL WNCTXT(F_TP, - 1 '!/!Q1!4$UJ !20$AS !3$UJ !3$UJ !AS', - 1 J0,EXTF,BTP,EP(0),EXTTP) - DO I=1,EP(0) - CALL WNCTXT(F_TP, - 1 ' Axis !3$UJ: !-8$AS !4$UJ pts !D = !D (!D)', - 1 I,CN(I),EP(I),CR(1,I),CR(2,I),CR(3,I)) - END DO - END IF -C - EXTS=.TRUE. !SET SEEN - EXTC=EXTC+1 !AND COUNT - EXTF=BUFC(11:21) !SAVE TYPE - ELSE IF (EXTS) THEN !FIND EXTN. NAME - IF (BUFC(1:7).EQ.'EXTNAME') THEN - CALL WNCTXT(F_TP, - 1 ' Extension !3$UJ - !AS (!AS)', - 1 EXTC,BUFC(11:21),EXTF) - ENDIF - EXTS=.FALSE. !SET PRINTED -C - ELSE IF (BUFC(1:6).EQ.'BITPIX') THEN !BITS/PIXEL - I1=10 - CALL WNCACJ(BUFC,I1,10,BTP) - ELSE IF (BUFC(1:6).EQ.'NAXIS ') THEN !NUMBER OF AXES - I1=10 - CALL WNCACJ(BUFC,I1,10,EP(0)) - ELSE IF (BUFC(1:5).EQ.'NAXIS') THEN !AXIS LENGTH - I1=6 - CALL WNCACJ(BUFC,I1,10,I2) - IF (I2.GT.0.AND.I2.LE.30) THEN !AT MOST 30 AXES - I1=10 - CALL WNCACJ(BUFC,I1,10,EP(I2)) - END IF - ELSE IF (BUFC(1:5).EQ.'CTYPE') THEN !AXIS NAME - I1=6 - CALL WNCACJ(BUFC,I1,10,I2) - IF (I2.GT.0.AND.I2.LE.30) THEN - CN(I2)=BUFC(12:19) - END IF - ELSE IF (BUFC(1:5).EQ.'CRPIX') THEN !REFERENCE PIXEL - I1=6 - CALL WNCACJ(BUFC,I1,10,I2) - IF (I2.GT.0.AND.I2.LE.30) THEN - I1=10 - CALL WNCACD(BUFC,I1,10,CR(1,I2)) - END IF - ELSE IF (BUFC(1:5).EQ.'CRVAL') THEN !REFERENCE VALUE - I1=6 - CALL WNCACJ(BUFC,I1,10,I2) - IF (I2.GT.0.AND.I2.LE.30) THEN - I1=10 - CALL WNCACD(BUFC,I1,10,CR(2,I2)) - END IF - ELSE IF (BUFC(1:5).EQ.'CDELT') THEN !SPACING - I1=6 - CALL WNCACJ(BUFC,I1,10,I2) - IF (I2.GT.0.AND.I2.LE.30) THEN - I1=10 - CALL WNCACD(BUFC,I1,10,CR(3,I2)) - END IF - - ELSE IF (BUFC(1:6).EQ.'OBJECT') THEN !OBJECT NAME - EXTF=BUFC(11:31) - END IF - END IF - END DO !END READ -C - IF (EXTC.EQ.0) THEN !NOT YET PRINTED - CALL WNCTXT(F_TP, - 1 '!/!Q1!4$UJ !20$AS !3$UJ !3$UJ !AS', - 1 J0,EXTF,BTP,EP(0),EXTTP) - DO I=1,EP(0) - CALL WNCTXT(F_TP, - 1 ' Axis !3$UJ: !-8$AS !4$UJ pts !D = !D (!D)', - 1 I,CN(I),EP(I),CR(1,I),CR(2,I),CR(3,I)) - END DO - END IF -C - END IF - GOTO 100 -C -C END -C - 900 CONTINUE - CALL WNFCL(IMCA) - CALL WNCFHD(F_P,-3,' ') -C - RETURN -C -C - END diff --git a/src/nscan/nscqc0.for b/src/nscan/nscqc0.for deleted file mode 100644 index 724d7fadb7d8127a0992e84de98c5707fe2a2b80..0000000000000000000000000000000000000000 --- a/src/nscan/nscqc0.for +++ /dev/null @@ -1,86 +0,0 @@ -C+ NSCQC0.FOR -C WNB 940729 -C -C Revisions: -C - INTEGER FUNCTION NSCQC0(LB1,LB2) -C -C Compare the Qube list elements -C -C Result: -C -C ORDER_J = NSCQC0( LB1_B(*):I, LB2_B(*):I) Compare Qube lines -C ORDER_J = NSCQC1( LB1_B(*):I, LB2_B(*):I) Compare Qube Field lines -C ORDER_J = NSCQC2( LB1_B(*):I, LB2_B(*):I) Compare Qube freq lines -C -C Include files: -C - INCLUDE 'WNG_DEF' - INCLUDE 'QUB_O_DEF' !QUBE LINE -C -C Parameters: -C -C -C Arguments: -C - INTEGER LB1(0:*) !ELEMENT 1 - INTEGER LB2(0:*) !ELEMENT 2 -C -C Entry points: -C - INTEGER NSCQC1,NSCQC2 -C -C Function references: -C - INTEGER NSCQS0 !COMPARE FREQUENCY - INTEGER NSCQS1 !COMPARE HA - INTEGER NSCQS2 !COMPARE J FIELDS - INTEGER NSCQS3 !COMPARE E - INTEGER NSCQS4 !COMPARE D -C -C Data declarations: -C -C- -C -C NSCQC0 -C - NSCQC0=NSCQS4(LB1,LB2) !COMPARE - IF (NSCQC0.EQ.0) THEN - NSCQC0=NSCQS3(LB1,LB2) - IF (NSCQC0.EQ.0) THEN - NSCQC0=NSCQS2(LB1,LB2) - IF (NSCQC0.EQ.0) THEN - NSCQC0=NSCQS1(LB1,LB2) - IF (NSCQC0.EQ.0) THEN - NSCQC0=NSCQS0(LB1,LB2) - END IF - END IF - END IF - END IF -C - RETURN -C -C NSCQC1 -C - ENTRY NSCQC1(LB1,LB2) -C - NSCQC1=NSCQS4(LB1,LB2) !COMPARE - IF (NSCQC1.EQ.0) THEN - NSCQC1=NSCQS3(LB1,LB2) - IF (NSCQC1.EQ.0) THEN - NSCQC1=NSCQS2(LB1,LB2) - END IF - END IF -C - RETURN -C -C NSCQC2 -C - ENTRY NSCQC2(LB1,LB2) -C - NSCQC2=NSCQS0(LB1,LB2) !COMPARE -C - RETURN -C -C - END diff --git a/src/nscan/nscqe0.for b/src/nscan/nscqe0.for deleted file mode 100644 index 025cbf40a28bf847c5e7e192f4eaab2d8e9dbcb8..0000000000000000000000000000000000000000 --- a/src/nscan/nscqe0.for +++ /dev/null @@ -1,151 +0,0 @@ -C+ NSCQE0.FOR -C WNB 940812 -C -C Revisions: -C WNB 940830 Typo -C - LOGICAL FUNCTION NSCQE0(QUA,FCA,AX1,DOFF) -C -C Write actual interferometer errors -C -C Result: -C -C NSCQE0_L = NSCQE0( QUA_J:I, FCA_J:I, AX1_J:I, DOFF_J:I) -C Write Qube scan interferometer errors at main -C position AX1, diskoffset DOFF. -C NSCQE1_L = NSCQE1( QUA_J:I, FCA_J:I, AX1_J:I, DOFF_J:I) -C Zero Qube error data at diskoffset DOFF -C -C Include files: -C - INCLUDE 'WNG_DEF' - INCLUDE 'CBITS_DEF' !BIT DEFINITIONS - INCLUDE 'QUB_O_DEF' !QUBE DEFINITION - INCLUDE 'STH_O_DEF' !SCAN SET HEADER -C -C Parameters: -C -C -C Arguments: -C - INTEGER QUA !QUBE CONTROL AREA - INTEGER FCA !FILE - INTEGER AX1 !AXIS TO DO - INTEGER DOFF !DISK OFFSET -C -C Entry points: -C - LOGICAL NSCQE1 -C -C Function references: -C - LOGICAL WNFRD !READ DATA - LOGICAL WNFWR !WRITE DATA - LOGICAL NSCQR0 !FIND SET HEADER - LOGICAL NSCSWI !WRITE IFR ERRORS -C -C Data declarations: -C - INTEGER L4DPL !DATA POINT LENGTH - INTEGER LAX3 !LENGTH LAST AXIS - INTEGER SCNT !SORT # OF LINES - INTEGER NPASS !# OF PASSES - INTEGER BLINE !BEGIN CURRENT PASS - INTEGER LLINE !LENGTH CURRENT PASS - INTEGER BOFF !LINE OFFSET - INTEGER SCNP !START SCAN POINTER - COMPLEX LMIFR(0:3,0:STHIFR-1) !LOCAL ERROR DATA -C- -C -C INIT -C - NSCQE0=.TRUE. !ASSUME OK - IF (IAND(A_J(QUA+QUA_ORDER_J),QUB_OUT).EQ.0) GOTO 800 !CANNOT DO - IF (AX1.LT.0) RETURN !NOTHING TO DO - L4DPL=4*LB_X !LENGTH DATAPOINT - LAX3=A_J(QUA+QUA_NDAT_J) !LAST AXIS LENGTH - SCNT=A_J(QUA+QUA_SCNT_J)/((LB_X)/LB_E) !SORT LINES - IF (IAND(A_J(QUA+QUA_ORDER_J),QUB_I).NE.0) THEN !GIVE NORMAL SCAN - RETURN !NOTHING TO DO - ELSE IF (IAND(A_J(QUA+QUA_ORDER_J),QUB_F).NE.0) THEN !GIVE FREQ SCAN - I1=AX1 !TIME POINT - I0=LAX3-1 !FREQ POINT - ELSE IF (IAND(A_J(QUA+QUA_ORDER_J),QUB_T).NE.0) THEN !GIVE HA SCAN - I0=AX1 !FREQ POINT - I1=LAX3-1 !HA POINT - ELSE !UNKNOWN - GOTO 800 - END IF - IF (I0.LT.0 .OR. I0.GE.A_J(QUA+QUA_IFRQ_J) .OR. - 1 I1.LT.0 .OR. - 1 I1.GE.A_J(QUA+QUA_IHA_J)) GOTO 800 !ILLEGAL -C -C WRITE TIF/FIT/ITF/IFT -C - NPASS=(LAX3+SCNT-1)/SCNT !# OF PASSES - DO I=0,NPASS-1 !ALL PASSES - BLINE=I*SCNT !OFFSET IN LINE - LLINE=MIN(LAX3-BLINE,SCNT) !# OF CURRENT LINES - DO I3=0,A_J(QUA+QUA_IIFR_J)-1 !ALL LINES IN PASS - IF (.NOT.WNFRD(A_J(QUA+QUA_IFCA_J), !READ PART LINE - 1 L4DPL*LLINE, - 1 A_B(A_J(QUA+QUA_SBPT_J)+ - 1 L4DPL*LLINE*I3), - 1 DOFF+L4DPL*LAX3*I3)) THEN - 10 CONTINUE - CALL WNCTXT(F_TP,'Error writing Qube scan F=!UJ, T=!UJ', - 1 I0,I1) - GOTO 800 - END IF - END DO - DO I3=BLINE,BLINE+LLINE-1 !ALL IFR LINES - BOFF=I3-BLINE !OFFSET LINE - DO I4=0,A_J(QUA+QUA_IIFR_J)-1 !TRANSPOSE DATA - CALL WNGMV(L4DPL, - 1 A_B(A_J(QUA+QUA_SBPT_J)+L4DPL*LLINE*I4+ - 1 L4DPL*BOFF), - 1 LMIFR(0,I4)) - END DO - IF (IAND(A_J(QUA+QUA_ORDER_J),QUB_F).NE.0) THEN !ITF/TIF - I4=I3 !FREQ - I5=AX1 !TIME - ELSE - I4=AX1 - I5=I3 - END IF - IF (.NOT.NSCQR0(QUA,FCA,I4,I5,SCNP)) GOTO 10 !GET STH - IF (.NOT.NSCSWI(FCA,A_B(A_J(QUA+QUA_CSTH_J)), - 1 I5-SCNP, - 1 A_I(A_J(QUA+QUA_PIFR_J)), - 1 LMIFR,A_J(QUA+QUA_TCOR_J), - 1 A_J(QUA+QUA_CAP_J), - 1 A_J(QUA+QUA_CDAP_J),0)) GOTO 10 !WRITE ERRORS - END DO !END PASS - END DO !ALL PASSES -C - RETURN -C -C ERROR -C - 800 CONTINUE - NSCQE0=.FALSE. !INDICATE ERROR -C - RETURN - -C -C NSCQE1 -C - ENTRY NSCQE1(QUA,FCA,AX1,DOFF) -C - CALL WNGMVZ(4*LB_X*STHIFR,LMIFR) !MAKE ZERO BUFFER - DO I=0,A_J(QUA+QUA_NDAT_J)-1 - IF (.NOT.WNFWR(A_J(QUA+QUA_IFCA_J), - 1 4*LB_X*A_J(QUA+QUA_IIFR_J), - 1 LMIFR, - 1 DOFF+4*LB_X*A_J(QUA+QUA_IIFR_J)*I)) GOTO 10 - END DO -C - RETURN -C -C - END diff --git a/src/nscan/nscqfn.for b/src/nscan/nscqfn.for deleted file mode 100644 index a9c1ab1f92221db5c95d5e198570831fbb102dcd..0000000000000000000000000000000000000000 --- a/src/nscan/nscqfn.for +++ /dev/null @@ -1,238 +0,0 @@ -C+ NSCQFN.FOR -C WNB 940803 -C -C Revisions: -C - LOGICAL FUNCTION NSCQFN(QUA,FCA,ORDER,STHU,INFO,PINFO) -C -C Get next Qube field -C -C Result: -C -C NSCQFN_L = NSCQFN( QUA_J:I, FCA_J:I, ORDER_J:I, -C STHU_B(0:*):O, -C INFO_J(QINFO__L:QINFO__H):O, -C PINFO_J(QINFO_L:QINFO_H):O) -C Get next Qube field, to be read in ORDER -C specified. -C STH is a sector header for general info -C QUA is the control area pointer, INFO -C the field #, (max) # of freq, ha, ifr; -C PINFO ptrs (0,f,ha,i) to tables. -C NSCQFR_L = NSCQFR( QUA_J:I, FCA_J:I) -C Reset field search -C -C Include files: -C - INCLUDE 'WNG_DEF' - INCLUDE 'SSH_O_DEF' !SET FIELD DEFINITIONS - INCLUDE 'CBITS_DEF' !BIT DEFINITIONS - INCLUDE 'QUB_O_DEF' !QUBE DEFINITION - INCLUDE 'STH_O_DEF' !SCAN SET HEADER -C -C Parameters: -C -C -C Arguments: -C - INTEGER QUA !QUBE CONTROL AREA - INTEGER FCA !FILE - INTEGER ORDER !ORDER - BYTE STHU(0:*) !A USER GIVEN SET HEADER - INTEGER INFO(QINFO__L:QINFO__H) !QUBE INFORMATION - INTEGER PINFO(QINFO__L:QINFO__H) !QUBE TABLES -C -C Entry points: -C - LOGICAL NSCQFR -C -C Function references: -C - LOGICAL WNFRD !READ DATA - LOGICAL WNGGVA !GET MEMORY - INTEGER NSCQC1,NSCQC2 !COMPARISONS - LOGICAL NSCSIF !GET IFR TABLE - LOGICAL NSCQWF !FORCE ERRORS OUT - LOGICAL NMORDH !GET SOME MODEL DATA -C -C Data declarations: -C - INTEGER QUAD,QUAE !QUA OFFSETS - INTEGER LIFRJ(IFJ__L:IFJ__H-1,0:STHIFR-1) !IFR INFO - REAL LIFRE(IFE__L:IFE__H,0:STHIFR-1) - BYTE QUB(0:QUB__L-1,0:1) !FIELD LINE - INTEGER QUBJ(0:QUB__L/LB_J-1,0:1) - REAL QUBE(0:QUB__L/LB_E-1,0:1) - DOUBLE PRECISION QUBD(0:QUB__L/LB_D-1,0:1) - EQUIVALENCE (QUB,QUBJ,QUBE,QUBD) - BYTE STH(0:STH__L-1) !SET HEADER -C- -C -C INIT -C - NSCQFN=.TRUE. !ASSUME OK - IF (.NOT.NSCQWF(QUA,FCA)) GOTO 20 !FORCE POSSIBLE ERRORS OUT - QUAD=QUA*LB_J/LB_D !A_D OFFSET - QUAE=QUA*LB_J/LB_E !A_E OFFSET - A_J(QUA+QUA_ORDER_J)=ORDER !SAVE ORDER - A_J(QUA+QUA_CMAP_J)=-1 !NO SORTED DATA - A_J(QUA+QUA_CIMAP_J)=-1 !NO OUTPUT DATA - IF (A_J(QUA+QUA_CFNR_J).EQ.0) - 1 A_J(QUA+QUA_CFPTR_J)=0 !START AT BEGIN - A_J(QUA+QUA_CFNR_J)=A_J(QUA+QUA_CFNR_J)+1 !COUNT FIELD - IF (A_J(QUA+QUA_CFNR_J).GT.A_J(QUA+QUA_NFLD_J) .OR. - 1 A_J(QUA+QUA_CFPTR_J).GE.A_J(QUA+QUA_CNT_J)) THEN !NO MORE - 10 CONTINUE - A_J(QUA+QUA_CFNR_J)=0 !RESET FIELD - NSCQFN=.FALSE. - INFO(QINFO_FLD) =0 !DUMMY INFO - INFO(QINFO_F) =0 - INFO(QINFO_T) =0 - INFO(QINFO_I) =0 - PINFO(QINFO_FLD) =0 !DUMMY INFO - PINFO(QINFO_F) =0 - PINFO(QINFO_T) =0 - PINFO(QINFO_I) =0 -C - RETURN - END IF - IF (A_J(QUA+QUA_PWGT_J).NE.0) !CLEAR BUFFERS - 1 CALL WNGFVA(4*LB_E*A_J(QUA+QUA_NDAT_J), - 1 LB_E*A_J(QUA+QUA_PWGT_J)+A_OB) - A_J(QUA+QUA_PWGT_J)=0 - IF (A_J(QUA+QUA_PDAT_J).NE.0) - 1 CALL WNGFVA(4*LB_X*A_J(QUA+QUA_NDAT_J), - 1 LB_X*A_J(QUA+QUA_PDAT_J)+A_OB) - A_J(QUA+QUA_PDAT_J)=0 - IF (A_J(QUA+QUA_PMOD_J).NE.0) - 1 CALL WNGFVA(4*LB_X*A_J(QUA+QUA_NDAT_J), - 1 LB_X*A_J(QUA+QUA_PMOD_J)+A_OB) - A_J(QUA+QUA_PMOD_J)=0 - IF (A_J(QUA+QUA_POUT_J).NE.0) - 1 CALL WNGFVA(4*LB_X*A_J(QUA+QUA_NDAT_J), - 1 LB_X*A_J(QUA+QUA_POUT_J)+A_OB) - A_J(QUA+QUA_POUT_J)=0 - IF (IAND(ORDER,QUB_I).NE.0) THEN !IFR ORDER - A_J(QUA+QUA_NDAT_J)=A_J(QUA+QUA_NIFR_J) !CORRECT LENGTH - ELSE IF (IAND(ORDER,QUB_F).NE.0) THEN !FREQ ORDER - A_J(QUA+QUA_NDAT_J)=A_J(QUA+QUA_NFRQ_J) !CORRECT LENGTH - ELSE !HA ORDER - A_J(QUA+QUA_NDAT_J)=A_J(QUA+QUA_NHA_J) !CORRECT LENGTH - END IF - JS=WNGGVA(4*LB_E*A_J(QUA+QUA_NDAT_J),J) !GET DATA BUFFERS - IF (JS) A_J(QUA+QUA_PWGT_J)=(J-A_OB)/LB_E - IF (JS) JS=WNGGVA(4*LB_X*A_J(QUA+QUA_NDAT_J),J) - IF (JS) A_J(QUA+QUA_PDAT_J)=(J-A_OB)/LB_X - IF (JS) JS=WNGGVA(4*LB_X*A_J(QUA+QUA_NDAT_J),J) - IF (JS) A_J(QUA+QUA_PMOD_J)=(J-A_OB)/LB_X - IF (JS) JS=WNGGVA(4*LB_X*A_J(QUA+QUA_NDAT_J),J) - IF (JS) A_J(QUA+QUA_POUT_J)=(J-A_OB)/LB_X - IF (.NOT.JS) THEN - CALL WNCTXT(F_TP,'No data buffers for Qube') - GOTO 10 - END IF - A_J(QUA+QUA_CCNT_J)=0 !CURRENT ITF/IFT CNT - A_J(QUA+QUA_CICNT_J)=0 !CURRENT ITF/IFT CNT - CALL WNGMVZ(LB_J*MAX(A_J(QUA+QUA_NFRQ_J), !OFFSET TABLES CLEAR - 1 A_J(QUA+QUA_NHA_J)),A_J(A_J(QUA+QUA_CPMAP_J))) - CALL WNGMVZ(LB_J*MAX(A_J(QUA+QUA_NFRQ_J), - 1 A_J(QUA+QUA_NHA_J)),A_J(A_J(QUA+QUA_CIPMAP_J))) -C -C DESCRIBE FIELD -C - A_J(QUA+QUA_IFRQ_J)=0 !INIT FIELD DESCRIPTION - A_J(QUA+QUA_IHA_J)=0 - A_J(QUA+QUA_IIFR_J)=0 - A_J(QUA+QUA_IBLK_J)=0 - I=A_J(QUA+QUA_CFPTR_J) !START NEXT FIELD LINES - IF (.NOT.WNFRD(A_J(QUA+QUA_FCA_J),QUB__L, - 1 QUB(0,0),I*QUB__L)) THEN - 20 CONTINUE - CALL WNCTXT(F_TP,'Error reading Qube description') - GOTO 10 - END IF -C -C PREPARE MODEL CALCULATION -C - IF (.NOT.WNFRD(FCA,STH__L,STHU,QUBJ(QUB_STHP_J,0))) GOTO 20 !USER STH - IF (IAND(A_J(QUA+QUA_ORDER_J),QUB_M).NE.0) THEN !MODEL DATA ASKED - IF (.NOT.NMORDH(6,A_J(QUA+QUA_STP_J), - 1 A_D(QUAD+QUA_SRA_D),A_D(QUAD+QUA_SDEC_D), - 1 A_D(QUAD+QUA_SFRQ_D))) THEN - 21 CONTINUE - CALL WNCTXT(F_TP,'Error reading model data') - GOTO 10 - END IF - CALL NMOMST(A_J(QUA+QUA_STP_J), - 1 A_D(QUAD+QUA_SRA_D),A_D(QUAD+QUA_SDEC_D), - 1 STHU,A_E(QUAE+QUA_LM0_E), - 1 A_D(QUAD+QUA_FRQ0_D),A_E(QUAE+QUA_TF_E), - 1 A_J(QUA+QUA_MINST_J)) !SOME MODEL CALC. DATA - END IF - I2=0 !HA CNT - I3=0 !HA BLOCK CNT - DO WHILE (I.LT.A_J(QUA+QUA_CNT_J)) - IF (.NOT.WNFRD(A_J(QUA+QUA_FCA_J),QUB__L, - 1 QUB(0,1),I*QUB__L)) GOTO 20 - IF (NSCQC1(QUB(0,0),QUB(0,1)).EQ.0) THEN !SAME FIELD - A_J(QUA+QUA_IIFR_J)= - 1 MAX(A_J(QUA+QUA_IIFR_J),QUBJ(QUB_NIFR_J,1)) - IF (.NOT.WNFRD(FCA,STH__L,STH,QUBJ(QUB_STHP_J,1))) GOTO 20 - IF (.NOT.NSCSIF(FCA,STH,A_I(A_J(QUA+QUA_PIFR_J)), - 1 LIFRJ, - 1 A_E(A_J(QUA+QUA_PANG_J)))) GOTO 20 !GET IFR TABLES - IF (NSCQC2(QUB(0,0),QUB(0,1)).EQ.0) THEN !SAME FREQUENCY - DO I4=0,QUBJ(QUB_SCN_J,1)-1 !FILL HA TABLE - A_E(A_J(QUA+QUA_PHA_J)+I2+I4)= - 1 QUBE(QUB_HAB_E,1)+I4*QUBE(QUB_HAI_E,1) - END DO - I1=2*(A_J(QUA+QUA_IFRQ_J)*A_J(QUA+QUA_NBLK_J)+I3) - I2=I2+QUBJ(QUB_SCN_J,1) !COUNT HA - A_J(A_J(QUA+QUA_IBPT_J)+I1+0)=I2 !SAVE BLK - A_J(A_J(QUA+QUA_IBPT_J)+I1+1)=QUBJ(QUB_STHP_J,1) - I3=I3+1 !COUNT BLOCKS - I=I+1 !COUNT LINES - ELSE - A_J(QUA+QUA_IHA_J)=MAX(A_J(QUA+QUA_IHA_J),I2) - A_J(QUA+QUA_IBLK_J)=MAX(A_J(QUA+QUA_IBLK_J),I3) - A_D(A_J(QUA+QUA_PFRQ_J)+A_J(QUA+QUA_IFRQ_J))= - 1 QUBD(QUB_FRQ_D,0) !MAKE FREQ TABLE - A_J(QUA+QUA_IFRQ_J)=A_J(QUA+QUA_IFRQ_J)+1 !COUNT FREQ - I2=0 - I3=0 - CALL WNGMV(QUB__L,QUB(0,1),QUB(0,0)) - END IF - ELSE - A_J(QUA+QUA_CFPTR_J)=I !NEXT LINE POINTER - GOTO 200 !READY WITH FIELD - END IF - END DO - 200 CONTINUE - A_J(QUA+QUA_IHA_J)=MAX(A_J(QUA+QUA_IHA_J),I2) - A_J(QUA+QUA_IBLK_J)=MAX(A_J(QUA+QUA_IBLK_J),I3) - A_D(A_J(QUA+QUA_PFRQ_J)+A_J(QUA+QUA_IFRQ_J))= - 1 QUBD(QUB_FRQ_D,0) !MAKE FREQ TABLE - A_J(QUA+QUA_IFRQ_J)=A_J(QUA+QUA_IFRQ_J)+1 - INFO(QINFO_FLD) =A_J(QUA+QUA_CFNR_J) !RETURN INFO - INFO(QINFO_F) =A_J(QUA+QUA_IFRQ_J) - INFO(QINFO_T) =A_J(QUA+QUA_IHA_J) - INFO(QINFO_I) =A_J(QUA+QUA_IIFR_J) - PINFO(QINFO_FLD) =0 !RETURN PTRS - PINFO(QINFO_F) =A_J(QUA+QUA_PFRQ_J) - PINFO(QINFO_T) =A_J(QUA+QUA_PHA_J) - PINFO(QINFO_I) =A_J(QUA+QUA_PIFR_J) -C - RETURN - -C -C NSCQFR -C - ENTRY NSCQFR(QUA,FCA) -C - NSCQFR=.TRUE. !ASSUME OK - A_J(QUA+QUA_CFNR_J)=0 !RESET FIELD -C - RETURN -C -C - END diff --git a/src/nscan/nscqop.for b/src/nscan/nscqop.for deleted file mode 100644 index 8bc88a3b474216affef5e094abd731c2ee92f29c..0000000000000000000000000000000000000000 --- a/src/nscan/nscqop.for +++ /dev/null @@ -1,285 +0,0 @@ -C+ NSCQOP.FOR -C WNB 940216 -C -C Revisions: -C WNB 940728 General update -C WNB 940812 Add error output -C - LOGICAL FUNCTION NSCQOP(QUA,FCA,SETS,LPOFF,INFO) -C -C Create a Qube list from the user specified sets -C -C Result: -C -C NSCQOP_L = NSCQOP( QUA_J:O, FCA_J:I, SETS_J(0:*,0:*):I, LPOFF_J(0:*):I, -C INFO_J(QINFO__L:QINFO__H):O) -C Create a Qube information set from SETS for -C the current LPOFF loop in file FCA -C QUA is the control area pointer, INFO -C the (max) # of fields, freq, ha, ifr -C NSCQCL_L = NSCQCL( QUA_J:I, FCA_J:I, SETS_J(0:*,0:*):I) -C Remove structure and tmp files -C -C Include files: -C - INCLUDE 'WNG_DEF' - INCLUDE 'SSH_O_DEF' !SET FIELD DEFINITIONS - INCLUDE 'CBITS_DEF' !BIT DEFINITIONS - INCLUDE 'QUB_O_DEF' !QUBE DEFINITION - INCLUDE 'STH_O_DEF' !SCAN SET HEADER -C -C Parameters: -C -C -C Arguments: -C - INTEGER QUA !QUBE CONTROL AREA - INTEGER FCA !FILE - INTEGER SETS(0:SOF__N-1,0:*) !INPUT SETS - INTEGER LPOFF(0:*) !SET LOOP OFFSET - INTEGER INFO(QINFO__L:QINFO__H) !QUBE INFORMATION -C -C Entry points: -C - LOGICAL NSCQCL -C -C Function references: -C - LOGICAL WNGGVA !GET VIRTUAL MEMORY - LOGICAL WNGSRT !SORTING - CHARACTER*20 WNFFNM !GET FILENAME - LOGICAL WNFOP !OPEN FILE - LOGICAL NSCSTL !GET NEXT SET - LOGICAL NSCQW0 !WRITE QUBE PART - LOGICAL NSCQW1 !MERGE QUBE PARTS -C -C Data declarations: -C - INTEGER SNAM(0:SOF__N-1) !SET NAME - CHARACTER*20 LFNM !LOCAL FILE NAME - BYTE QUB(0:QUB__L-1) !QUBE LINE - INTEGER*4 QUBJ(0:QUB__L/LB_J-1) - REAL QUBE(0:QUB__L/LB_E-1) - DOUBLE PRECISION QUBD(0:QUB__L/LB_D-1) - EQUIVALENCE (QUB,QUBJ,QUBE,QUBD) - BYTE STH(0:STH__L-1) !SCAN SET HEADER - INTEGER*2 STHI(0:STH__L/LB_I-1) - INTEGER*4 STHJ(0:STH__L/LB_J-1) - REAL STHE(0:STH__L/LB_E-1) - DOUBLE PRECISION STHD(0:STH__L/LB_D-1) - EQUIVALENCE (STH,STHI,STHJ,STHE,STHD) -C- -C -C INIT -C - NSCQOP=.TRUE. !ASSUME OK - IF (.NOT.WNGGVA(QUA__L,QUA)) GOTO 10 !QUBE CONTROL AREA - QUA=(QUA-A_OB)/LB_J !AREA POINTER - CALL WNGMVZ(QUA__L,A_J(QUA)) - LFNM=WNFFNM('000','TMP') - IF (.NOT.WNFOP(A_J(QUA+QUA_FCA_J),LFNM,'WT')) THEN - 20 CONTINUE - CALL WNCTXT(F_TP,'Cannot open temporary Qube file') - GOTO 800 - END IF - CALL WNDDAM(A_J(QUA+QUA_MEMSZ_J)) !GET MEMORY CHUNKS - A_J(QUA+QUA_NLINE_J)= - 1 MAX(128,A_J(QUA+QUA_MEMSZ_J)/QUB__L) !# OF LINES PER BUFFER - IF (.NOT.WNGGVA(A_J(QUA+QUA_NLINE_J)*QUB__L, - 1 A_J(QUA+QUA_BPT_J))) THEN - 10 CONTINUE - CALL WNCTXT(F_TP,'No memory for Qube tables') - A_J(QUA+QUA_BPT_J)=0 - A_J(QUA+QUA_IBPT_J)=0 - GOTO 800 - END IF - A_J(QUA+QUA_BPT_J)=A_J(QUA+QUA_BPT_J)-A_OB - CALL WNDSTR(FCA,SETS) !RESET SET SEARCH STATUS -C -C CREATE QUBE LIST -C - DO WHILE (NSCSTL(FCA,SETS,STH,QUBJ(QUB_STHP_J), - 1 SNAM,LPOFF)) !ALL SETS - QUBD(QUB_RA_D)=STHD(STH_RA_D) !COPY SOME DATA - QUBD(QUB_DEC_D)=STHD(STH_DEC_D) - QUBD(QUB_FRQ_D)=STHD(STH_FRQ_D) - QUBE(QUB_BAND_E)=STHE(STH_BAND_E) - QUBE(QUB_HAB_E)=STHE(STH_HAB_E) - QUBE(QUB_HAI_E)=STHE(STH_HAI_E) - QUBJ(QUB_SCN_J)=STHJ(STH_SCN_J) - QUBJ(QUB_NIFR_J)=STHJ(STH_NIFR_J) - QUBJ(QUB_NPOL_J)=STHI(STH_PLN_I) - QUBJ(QUB_INST_J)=STHJ(STH_INST_J) - CALL WNGMV(QUB__L,QUB, - 1 A_B(A_J(QUA+QUA_BPT_J)+ - 1 MOD(A_J(QUA+QUA_CNT_J), - 1 A_J(QUA+QUA_NLINE_J))*QUB__L)) !SAVE LINE - A_J(QUA+QUA_CNT_J)=A_J(QUA+QUA_CNT_J)+1 !COUNT -C -C SAVE IN FILE -C - IF (MOD(A_J(QUA+QUA_CNT_J), - 1 A_J(QUA+QUA_NLINE_J)).EQ.0) THEN !BUFFER FULL - IF (.NOT.NSCQW0(QUA,A_J(QUA+QUA_FCA_J),A_J(QUA+QUA_NLINE_J), - 1 A_B(A_J(QUA+QUA_BPT_J)))) THEN - CALL WNCTXT(F_TP,'Error writing/sorting Qube lines') - GOTO 800 - END IF - END IF -C -C NEXT SET -C - END DO - -C -C SAVE LAST PART -C - IF (MOD(A_J(QUA+QUA_CNT_J), - 1 A_J(QUA+QUA_NLINE_J)).NE.0) THEN !STILL IN BUFFER - IF (.NOT.NSCQW0(QUA,A_J(QUA+QUA_FCA_J),MOD(A_J(QUA+QUA_CNT_J), - 1 A_J(QUA+QUA_NLINE_J)), - 1 A_B(A_J(QUA+QUA_BPT_J)))) THEN - CALL WNCTXT(F_TP,'Error writing/sorting Qube lines') - GOTO 800 - END IF - END IF -C -C MERGE PARTS -C - IF (.NOT.NSCQW1(QUA,A_J(QUA+QUA_FCA_J),A_J(QUA+QUA_CNT_J), - 1 A_B(A_J(QUA+QUA_BPT_J)))) GOTO 800 -C -C GET TABLE AREAS -C - IF (A_J(QUA+QUA_BPT_J).NE.0) - 1 CALL WNGFVA(A_J(QUA+QUA_NLINE_J)*QUB__L, - 1 A_J(QUA+QUA_BPT_J)+A_OB) !FREE BUFFER SPACE - A_J(QUA+QUA_BPT_J)=0 - A_J(QUA+QUA_NLINE_J)=0 - IF (.NOT.WNGGVA(2*LB_J*A_J(QUA+QUA_NFRQ_J)* - 1 A_J(QUA+QUA_NBLK_J),J)) GOTO 10 - A_J(QUA+QUA_IBPT_J)=(J-A_OB)/LB_J !FIELD DESCRIPTOR AREA - IF (.NOT.WNGGVA(LB_I*A_J(QUA+QUA_NIFR_J),J)) GOTO 10 - A_J(QUA+QUA_PIFR_J)=(J-A_OB)/LB_I - IF (.NOT.WNGGVA(LB_E*(IFE__H-IFE__L+1)* - 1 A_J(QUA+QUA_NIFR_J),J)) GOTO 10 - A_J(QUA+QUA_PANG_J)=(J-A_OB)/LB_E - IF (.NOT.WNGGVA(LB_D*A_J(QUA+QUA_NFRQ_J),J)) GOTO 10 - A_J(QUA+QUA_PFRQ_J)=(J-A_OB)/LB_D - IF (.NOT.WNGGVA(LB_E*A_J(QUA+QUA_NHA_J),J)) GOTO 10 - A_J(QUA+QUA_PHA_J)=(J-A_OB)/LB_E - A_J(QUA+QUA_SCNT_J)=MAX(10,A_J(QUA+QUA_MEMSZ_J)/ - 1 (4*LB_E*STHIFR)) !SORT BUF LENGTH - IF (.NOT.WNGGVA(4*LB_E*STHIFR* - 1 A_J(QUA+QUA_SCNT_J), - 1 A_J(QUA+QUA_SBPT_J))) GOTO 10 !SORT BUFFER - A_J(QUA+QUA_SBPT_J)=A_J(QUA+QUA_SBPT_J)-A_OB !BYTE OFFSET - IF (.NOT.WNGGVA(LB_J*MAX(A_J(QUA+QUA_NHA_J), - 1 A_J(QUA+QUA_NFRQ_J)), - 1 A_J(QUA+QUA_CPMAP_J))) GOTO 10 !ITF/IFT PTR TABLE - A_J(QUA+QUA_CPMAP_J)=(A_J(QUA+QUA_CPMAP_J)-A_OB)/LB_J - IF (.NOT.WNGGVA(LB_J*MAX(A_J(QUA+QUA_NHA_J), - 1 A_J(QUA+QUA_NFRQ_J)), - 1 A_J(QUA+QUA_CIPMAP_J))) GOTO 10 - A_J(QUA+QUA_CIPMAP_J)=(A_J(QUA+QUA_CIPMAP_J)-A_OB)/LB_J - IF (.NOT.WNGGVA(STH__L,A_J(QUA+QUA_CSTH_J))) GOTO 10 !CURRENT SECTOR - A_J(QUA+QUA_CSTH_J)=A_J(QUA+QUA_CSTH_J)-A_OB -C -C GET SORTED DATA FILE -C - LFNM=WNFFNM('001','TMP') - IF (.NOT.WNFOP(A_J(QUA+QUA_SFCA_J),LFNM,'WT')) - 1 GOTO 20 !GET SORTED DAT FILE -C -C GET OUTPUT DATA FILE -C - LFNM=WNFFNM('002','TMP') - IF (.NOT.WNFOP(A_J(QUA+QUA_IFCA_J),LFNM,'WT')) - 1 GOTO 20 !GET SORTED DAT FILE -C -C RETURN INFO -C - INFO(QINFO_FLD) =A_J(QUA+QUA_NFLD_J) !RETURN INFO - INFO(QINFO_F) =A_J(QUA+QUA_NFRQ_J) - INFO(QINFO_T) =A_J(QUA+QUA_NHA_J) - INFO(QINFO_I) =A_J(QUA+QUA_NIFR_J) -C - RETURN -C -C ERRORS -C - 800 CONTINUE - NSCQOP=.FALSE. !ERROR - INFO(QINFO_FLD)=0 !GIVE CORRECT INFO - INFO(QINFO_F) =0 - INFO(QINFO_T) =0 - INFO(QINFO_I) =0 - GOTO 801 -C -C NSCQCL -C - ENTRY NSCQCL(QUA,FCA,SETS) -C - NSCQCL=.TRUE. !ASSUME OK - CALL NSCQWF(QUA,FCA) !FORCE ERRORS OUT - GOTO 801 -C - 801 CONTINUE - IF (QUA.NE.0) THEN - IF (A_J(QUA+QUA_BPT_J).NE.0) - 1 CALL WNGFVA(A_J(QUA+QUA_NLINE_J)*QUB__L, - 1 A_J(QUA+QUA_BPT_J)+A_OB) !FREE BUFFER SPACE - IF (A_J(QUA+QUA_SBPT_J).NE.0) - 1 CALL WNGFVA(4*LB_E*STHIFR* - 1 A_J(QUA+QUA_SCNT_J), - 1 A_J(QUA+QUA_SBPT_J)+A_OB) !FREE SORT BUF - IF (A_J(QUA+QUA_CPMAP_J).NE.0) - 1 CALL WNGFVA(LB_J*MAX(A_J(QUA+QUA_NFRQ_J), - 1 A_J(QUA+QUA_NHA_J)), - 1 LB_J*A_J(QUA+QUA_CPMAP_J)+A_OB) !ITF/IFT TABLE - IF (A_J(QUA+QUA_CIPMAP_J).NE.0) - 1 CALL WNGFVA(LB_J*MAX(A_J(QUA+QUA_NFRQ_J), - 1 A_J(QUA+QUA_NHA_J)), - 1 LB_J*A_J(QUA+QUA_CIPMAP_J)+A_OB) !ITF/IFT TABLE - IF (A_J(QUA+QUA_CSTH_J).NE.0) - 1 CALL WNGFVA(STH__L,A_J(QUA+QUA_CSTH_J)+A_OB) !CURRENT SECTOR - IF (A_J(QUA+QUA_IBPT_J).NE.0) - 1 CALL WNGFVA(2*LB_J*A_J(QUA+QUA_NFRQ_J)* - 1 A_J(QUA+QUA_NBLK_J), - 1 A_J(QUA+QUA_IBPT_J)*LB_J+A_OB) !FREE FIELD DESCRIPTOR - IF (A_J(QUA+QUA_PIFR_J).NE.0) - 1 CALL WNGFVA(LB_I*A_J(QUA+QUA_NIFR_J), - 1 A_J(QUA+QUA_PIFR_J)*LB_I+A_OB) !FREE TABLES - IF (A_J(QUA+QUA_PANG_J).NE.0) - 1 CALL WNGFVA(LB_E*(IFE__H-IFE__L+1)*A_J(QUA+QUA_NIFR_J), - 1 A_J(QUA+QUA_PANG_J)*LB_E+A_OB) - IF (A_J(QUA+QUA_PFRQ_J).NE.0) - 1 CALL WNGFVA(LB_D*A_J(QUA+QUA_NFRQ_J), - 1 A_J(QUA+QUA_PFRQ_J)*LB_D+A_OB) - IF (A_J(QUA+QUA_PHA_J).NE.0) - 1 CALL WNGFVA(LB_E*A_J(QUA+QUA_NHA_J), - 1 A_J(QUA+QUA_PHA_J)*LB_E+A_OB) - IF (A_J(QUA+QUA_PWGT_J).NE.0) !FREE DATA AREAS - 1 CALL WNGFVA(4*LB_E*A_J(QUA+QUA_NDAT_J), - 1 A_J(QUA+QUA_PWGT_J)*LB_E+A_OB) - IF (A_J(QUA+QUA_PDAT_J).NE.0) - 1 CALL WNGFVA(4*LB_X*A_J(QUA+QUA_NDAT_J), - 1 A_J(QUA+QUA_PDAT_J)*LB_X+A_OB) - IF (A_J(QUA+QUA_PMOD_J).NE.0) - 1 CALL WNGFVA(4*LB_X*A_J(QUA+QUA_NDAT_J), - 1 A_J(QUA+QUA_PMOD_J)*LB_X+A_OB) - IF (A_J(QUA+QUA_POUT_J).NE.0) - 1 CALL WNGFVA(4*LB_X*A_J(QUA+QUA_NDAT_J), - 1 A_J(QUA+QUA_POUT_J)*LB_X+A_OB) - CALL WNFCL(A_J(QUA+QUA_FCA_J)) !CLOSE TMP FILE - CALL WNFCL(A_J(QUA+QUA_SFCA_J)) !CLOSE SORTED FILE - CALL WNFCL(A_J(QUA+QUA_IFCA_J)) !CLOSE OUTPUT FILE - CALL WNGFVA(QUA__L,QUA*LB_J+A_OB) !FREE CONTROL AREA - QUA=0 - END IF - CALL WNDSTR(FCA,SETS) !RESET SET SEARCH -C - RETURN -C -C - END diff --git a/src/nscan/nscqr0.for b/src/nscan/nscqr0.for deleted file mode 100644 index 631db2901a018b980601451138a81aebc9c56547..0000000000000000000000000000000000000000 --- a/src/nscan/nscqr0.for +++ /dev/null @@ -1,74 +0,0 @@ -C+ NSCQR0.FOR -C WNB 940805 -C -C Revisions: -C - LOGICAL FUNCTION NSCQR0(QUA,FCA,AX1,AX2,SCNP) -C -C Get some scan read data -C -C Result: -C -C NSCQR0_L = NSCQR0( QUA_J:I, FCA_J:I, AX1_J:I, AX2_J:I, -C SCNP_J:O) -C Read the STH set header at frequency AX1, Ha AX2. -C SCNP gives the start number of ha in sub-scan -C -C Include files: -C - INCLUDE 'WNG_DEF' - INCLUDE 'CBITS_DEF' !BIT DEFINITIONS - INCLUDE 'QUB_O_DEF' !QUBE DEFINITION - INCLUDE 'STH_O_DEF' !SCAN SET HEADER -C -C Parameters: -C -C -C Arguments: -C - INTEGER QUA !QUBE CONTROL AREA - INTEGER FCA !FILE - INTEGER AX1,AX2 !AXES TO READ - INTEGER SCNP !HA # OF FIRST SCAN IN SUB-SCAN -C -C Function references: -C - LOGICAL WNFRD !READ DATA -C -C Data declarations: -C - INTEGER STHP !SET HEADER POINTER -C- -C -C INIT -C - NSCQR0=.TRUE. !ASSUME OK -C -C FIND IFR SCAN -C - I=0 !FIND SCAN STH - DO WHILE (A_J(A_J(QUA+QUA_IBPT_J)+ - 1 2*(A_J(QUA+QUA_NBLK_J)*AX1+I)).LE.AX2) - I=I+1 - END DO - IF (I.EQ.0) THEN !START SCAN NUMBER - SCNP=0 - ELSE - SCNP=A_J(A_J(QUA+QUA_IBPT_J)+ - 1 2*(A_J(QUA+QUA_NBLK_J)*AX1+I-1)) - END IF - STHP=A_J(A_J(QUA+QUA_IBPT_J)+ - 1 2*(A_J(QUA+QUA_NBLK_J)*AX1+I)+1) !STH POINTER - IF (STHP.NE.A_J(QUA+QUA_CSTHP_J)) THEN - NSCQR0=WNFRD(FCA,STH__L,A_B(A_J(QUA+QUA_CSTH_J)),STHP) - IF (NSCQR0) THEN - A_J(QUA+QUA_CSTHP_J)=STHP !NEW CURRENT - ELSE - A_J(QUA+QUA_CSTHP_J)=0 - END IF - END IF -C - RETURN -C -C - END diff --git a/src/nscan/nscqs0.for b/src/nscan/nscqs0.for deleted file mode 100644 index c4fdb1fc8ecdfb4d9214eb1c84de2e1ed3f0ada1..0000000000000000000000000000000000000000 --- a/src/nscan/nscqs0.for +++ /dev/null @@ -1,147 +0,0 @@ -C+ NSCQS0.FOR -C WNB 940216 -C -C Revisions: -C - INTEGER FUNCTION NSCQS0(LD1,LD2) -C -C Sort the Qube list elements -C -C Result: -C -C ORDER_J = NSCQS0( LD1_D(*), LD2_D(*)) Increasing frequency -C ORDER_J = NSCQS1( LE1_E(*), LE2_E(*)) Increasing ha -C ORDER_J = NSCQS2( LJ1_J(*), LJ2_J(*)) Increasing J-fields -C ORDER_J = NSCQS3( LE1_E(*), LE2_E(*)) Increasing E-fields -C ORDER_J = NSCQS4( LD1_D(*), LD2_D(*)) Increasing D-fields -C -C Include files: -C - INCLUDE 'WNG_DEF' - INCLUDE 'QUB_O_DEF' !QUBE LINE -C -C Parameters: -C -C -C Arguments: -C - INTEGER LJ1(0:*) !ELEMENT 1 - INTEGER LJ2(0:*) !ELEMENT 2 - REAL LE1(0:*) !ELEMENT 1 - REAL LE2(0:*) !ELEMENT 2 - DOUBLE PRECISION LD1(0:*) !ELEMENT 1 - DOUBLE PRECISION LD2(0:*) !ELEMENT 2 -C -C Function references: -C - DOUBLE PRECISION WNGDNF !NORM ANGLE -C -C Entry points: -C - INTEGER NSCQS1,NSCQS2,NSCQS3,NSCQS4 !SORT -C -C Data declarations: -C -C- -C -C SORT INCREASING FREQUENCY -C - IF (ABS(LD1(QUB_FRQ_D)-LD2(QUB_FRQ_D)).LT.1D-8) THEN !EQUAL - NSCQS0=0 - ELSE IF (LD1(QUB_FRQ_D).LT.LD2(QUB_FRQ_D)) THEN - NSCQS0=-1 - ELSE - NSCQS0=+1 - END IF -C - RETURN -C -C HA -C - ENTRY NSCQS1(LE1,LE2) -C - IF (LE1(QUB_HAB_E).EQ.LE2(QUB_HAB_E)) THEN !HA START - NSCQS1=0 - ELSE IF (LE1(QUB_HAB_E).EQ.LE2(QUB_HAB_E)) THEN !HA START - NSCQS1=-1 - ELSE - NSCQS1=+1 - END IF -C - RETURN -C -C J-FIELDS -C - ENTRY NSCQS2(LJ1,LJ2) -C -C - IF (LJ1(QUB_INST_J).EQ.LJ2(QUB_INST_J)) THEN !EQUAL INSTRUMENT - IF (LJ1(QUB_NPOL_J).EQ.LJ2(QUB_NPOL_J)) THEN !EQUAL NPOL - IF (LJ1(QUB_NIFR_J).EQ.LJ2(QUB_NIFR_J)) THEN !EQUAL NIFR - IF (LJ1(QUB_SCN_J).EQ.LJ2(QUB_SCN_J)) THEN !EQUAL NSCAN - NSCQS2=0 - ELSE IF (LJ1(QUB_SCN_J).LT.LJ2(QUB_SCN_J)) THEN - NSCQS2=-1 - ELSE - NSCQS2=+1 - END IF - ELSE IF (LJ1(QUB_NIFR_J).LT.LJ2(QUB_NIFR_J)) THEN !NIFR - NSCQS2=-1 - ELSE - NSCQS2=+1 - END IF - ELSE IF (LJ1(QUB_NPOL_J).LT.LJ2(QUB_NPOL_J)) THEN !NPOL - NSCQS2=-1 - ELSE - NSCQS2=+1 - END IF - ELSE IF (LJ1(QUB_INST_J).LT.LJ2(QUB_INST_J)) THEN !INSTRUMENT - NSCQS2=-1 - ELSE - NSCQS2=+1 - END IF -C - RETURN -C -C E FIELDS -C - ENTRY NSCQS3(LE1,LE2) -C - IF (ABS(LE1(QUB_HAI_E)-LE2(QUB_HAI_E)).LT.1E-6) THEN !HA INCREMENT - IF (ABS(LE1(QUB_BAND_E)-LE2(QUB_BAND_E)).LT.1E-6) THEN !BAND - NSCQS3=0 - ELSE IF (LE1(QUB_BAND_E).LT.LE2(QUB_BAND_E)) THEN !BAND - NSCQS3=-1 - ELSE - NSCQS3=+1 - END IF - ELSE IF (LE1(QUB_HAI_E).LT.LE2(QUB_HAI_E)) THEN !HA INCREMENT - NSCQS3=-1 - ELSE - NSCQS3=+1 - END IF -C - RETURN -C -C D FIELDS -C - ENTRY NSCQS4(LD1,LD2) -C - IF (ABS(WNGDNF(LD1(QUB_RA_D)-LD2(QUB_RA_D))).LT.1E-6) THEN !RA - IF (ABS(LD1(QUB_DEC_D)-LD2(QUB_DEC_D)).LT.1E-6) THEN !DEC - NSCQS4=0 - ELSE IF (LD1(QUB_DEC_D).LT.LD2(QUB_DEC_D)) THEN !DEC - NSCQS4=-1 - ELSE - NSCQS4=+1 - END IF - ELSE IF (LD1(QUB_RA_D).LT.LD2(QUB_RA_D)) THEN !RA - NSCQS4=-1 - ELSE - NSCQS4=+1 - END IF -C - RETURN -C -C - END diff --git a/src/nscan/nscqsr.for b/src/nscan/nscqsr.for deleted file mode 100644 index 917d8e83e2741af8a2bd6b50f543a0ddb3ccb028..0000000000000000000000000000000000000000 --- a/src/nscan/nscqsr.for +++ /dev/null @@ -1,340 +0,0 @@ -C+ NSCQSR.FOR -C WNB 940803 -C -C Revisions: -C WNB 940812 Add POUT -C - LOGICAL FUNCTION NSCQSR(QUA,FCA,AX1,AX2, - 1 CAP,CDAP,PWGT,PDAT,PMOD,POUT) -C -C Get Qube scan -C -C Result: -C -C NSCQSR_L = NSCQSR( QUA_J:I, FCA_J:I, AX1_J:I, AX2_J:I, -C CAP_J:I, CDAP_J:I, -C PWGT_J:O, PDAT_J:O, PMOD_J:O, POUT_J:O) -C Read a Qube scan at positions AX1, AX2, using -C the apply/de-apply bits in CAP/CDAP. -C The PWGT and PDAT describe the (ptr to) data -C PMOD the ptr to the model data, POUT to ifr errors -C -C Include files: -C - INCLUDE 'WNG_DEF' - INCLUDE 'CBITS_DEF' !BIT DEFINITIONS - INCLUDE 'QUB_O_DEF' !QUBE DEFINITION - INCLUDE 'STH_O_DEF' !SCAN SET HEADER - INCLUDE 'SCH_O_DEF' !SCAN HEADER -C -C Parameters: -C -C -C Arguments: -C - INTEGER QUA !QUBE CONTROL AREA - INTEGER FCA !FILE - INTEGER AX1,AX2 !AXES TO READ - INTEGER CAP,CDAP !APPLY/DE-APPLY BITS - INTEGER PWGT !DATA WEIGHT PTR (E(0:3,*)) - INTEGER PDAT !DATA PTR (X(0:3,*)) - INTEGER PMOD !MODEL PTR (X(0:3,*)) - INTEGER POUT !OUTPUT PTR (X(0:3,*)) -C -C Function references: -C - LOGICAL WNFRD !READ DATA - LOGICAL WNFWR !WRITE DATA - LOGICAL NSCSCR !READ A SCAN - LOGICAL NSCQR0 !FIND SET HEADER -C -C Data declarations: -C - INTEGER QUAD,QUAE !DATA POINTERS - LOGICAL SORT !SORT FIRST - INTEGER SCNP !START SCAN POINTER - INTEGER LAX1,LAX2,LAX3 !LENGTH AXIS 1,2,3 - INTEGER LPAX2 !LOOP AXIS 2 - INTEGER OFFAX2 !DISK OFFSET AXIS 2 - INTEGER L4DPL !LENGTH ONE DATA POINT - INTEGER L4DO,L4MO !DATA, MODEL POINT OFFSET - INTEGER SCNT !SORT LINES PER PASS - INTEGER NPASS !# OF TRANSPOSE PASSES - INTEGER BLINE !START LINE FOR SORT - INTEGER LLINE !SORT PASS LENGTH - INTEGER BOFF !PASS LINE OFFSET - REAL UV0(0:3) !1M UV COORD - REAL LWGT(0:STHIFR-1,0:3) !LOCAL WEIGHT - COMPLEX LCDAT(0:STHIFR-1,0:3) !LOCAL DATA - COMPLEX CQMOD(0:3,0:STHIFR-1) !LOCAL Q MODEL - COMPLEX CXMOD(0:STHIFR-1,0:3) !LOCAL XY MODEL - BYTE SCH(0:SCH__L-1) !SCAN HEADER - INTEGER SCHJ(0:SCH__L/LB_J-1) - EQUIVALENCE (SCH,SCHJ) -C- -C -C INIT -C - NSCQSR=.TRUE. !ASSUME OK - PWGT=A_J(QUA+QUA_PWGT_J) !RETURN POINTERS - PDAT=A_J(QUA+QUA_PDAT_J) - PMOD=A_J(QUA+QUA_PMOD_J) - POUT=A_J(QUA+QUA_POUT_J) - QUAD=QUA*LB_J/LB_D !REAL POINTERS - QUAE=QUA*LB_J/LB_E - L4DO=4*LB_E !OFFSET DATA POINT - L4MO=4*(LB_E+LB_X) !TOTAL DATA POINT LENGTH - L4DPL=L4MO - SCNT=A_J(QUA+QUA_SCNT_J)/((LB_E+LB_X)/LB_E) !SORT LINES - IF (IAND(A_J(QUA+QUA_ORDER_J),QUB_M).NE.0) THEN - L4DPL=L4DPL+4*LB_X - SCNT=A_J(QUA+QUA_SCNT_J)/((LB_E+LB_X+LB_X)/LB_E) !SORT LINES - END IF - LAX3=A_J(QUA+QUA_NDAT_J) !LAST AXIS LENGTH - IF (IAND(A_J(QUA+QUA_ORDER_J),QUB_I).NE.0) THEN !GIVE NORMAL SCAN - IF (IAND(A_J(QUA+QUA_ORDER_J),QUB_FTI).NE.0) THEN !FTI - I0=AX1 !FREQ POINT - I1=AX2 !TIME POINT - ELSE !TFI - I0=AX2 - I1=AX1 - END IF - I2=LAX3-1 !IFR POINTS - ELSE IF (IAND(A_J(QUA+QUA_ORDER_J),QUB_F).NE.0) THEN !GIVE FREQ SCAN - IF (IAND(A_J(QUA+QUA_ORDER_J),QUB_TIF).NE.0) THEN !TIF - I1=AX1 !TIME POINT - I2=AX2 !IFR POINT - ELSE !ITF - I1=AX2 - I2=AX1 - LAX1=A_J(QUA+QUA_IIFR_J) - LAX2=A_J(QUA+QUA_IHA_J) - END IF - I0=LAX3-1 !FREQ POINT - ELSE IF (IAND(A_J(QUA+QUA_ORDER_J),QUB_T).NE.0) THEN !GIVE HA SCAN - IF (IAND(A_J(QUA+QUA_ORDER_J),QUB_FIT).NE.0) THEN !FIT - I0=AX1 !FREQ POINT - I2=AX2 !IFR POINT - ELSE !IFT - I0=AX2 - I2=AX1 - LAX1=A_J(QUA+QUA_IIFR_J) - LAX2=A_J(QUA+QUA_IFRQ_J) - END IF - I1=LAX3-1 !HA POINT - ELSE !UNKNOWN - NSCQSR=.FALSE. -C - RETURN - END IF - IF (I0.LT.0 .OR. I0.GE.A_J(QUA+QUA_IFRQ_J) .OR. - 1 I1.LT.0 .OR. - 1 I1.GE.A_J(QUA+QUA_IHA_J) .OR. - 1 I2.LT.0 .OR. - 1 I2.GE.A_J(QUA+QUA_IIFR_J)) GOTO 800 !ILLEGAL -C -C READ TFI/FTI SCAN -C - IF (IAND(A_J(QUA+QUA_ORDER_J),QUB_I).NE.0) THEN !GIVE NORMAL SCAN - IF (.NOT.NSCQR0(QUA,FCA,I0,I1,SCNP)) THEN !READ SET HEADER - 10 CONTINUE - A_J(QUA+QUA_CMAP_J)=-1 !SET NOTHING READ - CALL WNCTXT(F_TP,'Error reading Qube scan F=!UJ, T=!UJ', - 1 I0,I1) - GOTO 800 - END IF - IF (.NOT.NSCSCR(FCA,A_B(A_J(QUA+QUA_CSTH_J)), - 1 A_I(A_J(QUA+QUA_PIFR_J)), - 1 I1-SCNP,CAP,CDAP,SCH, - 1 LWGT,LCDAT)) GOTO 10 - IF (IAND(A_J(QUA+QUA_ORDER_J),QUB_M).NE.0) THEN !MODEL ASKED - CALL NMOMUV(A_J(QUA+QUA_STP_J), - 1 A_D(QUAD+QUA_SRA_D),A_D(QUAD+QUA_SDEC_D), - 1 A_B(A_J(QUA+QUA_CSTH_J)),SCH,UV0) !MAKE UV - CALL NMOMU4(0,FCA,I1-SCNP, - 1 A_B(A_J(QUA+QUA_CSTH_J)),UV0, - 1 A_E(QUAE+QUA_LM0_E), - 1 A_D(QUAD+QUA_FRQ0_D), - 1 A_B(A_J(QUA+QUA_CSTH_J)+STH_RTP_1), - 1 4,A_J(QUA+QUA_IIFR_J), - 1 A_I(A_J(QUA+QUA_PIFR_J)), - 1 A_E(QUAE+QUA_TF_E),A_J(QUA+QUA_MINST_J), - 1 CQMOD) !MAKE QUV MODEL - CALL NMOCIX(A_B(A_J(QUA+QUA_CSTH_J)), - 1 SCH, - 1 A_E(A_J(QUA+QUA_PANG_J)), - 1 CXMOD,CQMOD) !MAKE XYX MODEL - END IF - DO I=0,LAX3-1 - DO I3=0,3 - A_E(PWGT+4*I+I3)=LWGT(I,I3) - A_X(PDAT+4*I+I3)=LCDAT(I,I3) - END DO - END DO - IF (IAND(A_J(QUA+QUA_ORDER_J),QUB_M).NE.0) THEN !MODEL ASKED - DO I=0,LAX3-1 - DO I3=0,3 - A_X(PMOD+4*I+I3)=CXMOD(I,I3) - END DO - END DO - END IF -C -C READ TIF/FIT/ITF/IFT -C - ELSE - SORT=.FALSE. !ASSUME NO SORT - IF (IAND(A_J(QUA+QUA_ORDER_J), - 1 QUB_TIF+QUB_FIT).NE.0) THEN !TIF/FIT - IF (A_J(QUA+QUA_CMAP_J).NE.AX1) THEN !SORT FIRST - SORT=.TRUE. - A_J(QUA+QUA_CMAP_J)=-1 !SET NONE READ - LPAX2=AX1 !CURRENT MAIN AXIS - OFFAX2=0 !CURRENT DISK OFFSET - END IF - ELSE !ITF/IFT - IF (A_J(A_J(QUA+QUA_CPMAP_J)+AX2).LE.0) THEN !SORT FIRST - SORT=.TRUE. - LPAX2=AX2 - OFFAX2=A_J(QUA+QUA_CCNT_J) !FILE OFFSET - END IF - END IF - IF (SORT) THEN !SORT DATA - NPASS=(LAX3+SCNT-1)/SCNT !# OF TRANSPOSE PASSES - DO I=0,NPASS-1 !ALL PASSES - BLINE=I*SCNT !START LINE - LLINE=MIN(LAX3-BLINE,SCNT) !LENGTH LINE - DO I3=BLINE,BLINE+LLINE-1 !LINES - BOFF=I3-BLINE !LINE OFFSET - IF (IAND(A_J(QUA+QUA_ORDER_J),QUB_F).NE.0) THEN !ITF/TIF - I4=I3 !ORDER - I5=LPAX2 - ELSE !IFT/FIT - I4=LPAX2 - I5=I3 - END IF - IF (.NOT.NSCQR0(QUA,FCA,I4,I5, - 1 SCNP)) GOTO 10 !GET STH - IF (.NOT.NSCSCR(FCA,A_B(A_J(QUA+QUA_CSTH_J)), - 1 A_I(A_J(QUA+QUA_PIFR_J)), - 1 I5-SCNP,CAP,CDAP,SCH, - 1 A_B(A_J(QUA+QUA_SBPT_J)+ - 1 L4DPL*STHIFR*BOFF), - 1 A_B(A_J(QUA+QUA_SBPT_J)+ - 1 L4DPL*STHIFR*BOFF+ - 1 L4DO*STHIFR))) GOTO 10 !SCAN - IF (IAND(A_J(QUA+QUA_ORDER_J),QUB_M).NE.0) THEN !MODEL ASKED - CALL NMOMUV(A_J(QUA+QUA_STP_J), - 1 A_D(QUAD+QUA_SRA_D),A_D(QUAD+QUA_SDEC_D), - 1 A_B(A_J(QUA+QUA_CSTH_J)),SCH,UV0) !MAKE UV - CALL NMOMU4(0,FCA,I5-SCNP, - 1 A_B(A_J(QUA+QUA_CSTH_J)),UV0, - 1 A_E(QUAE+QUA_LM0_E), - 1 A_D(QUAD+QUA_FRQ0_D), - 1 A_B(A_J(QUA+QUA_CSTH_J)+STH_RTP_1), - 1 4,A_J(QUA+QUA_IIFR_J), - 1 A_I(A_J(QUA+QUA_PIFR_J)), - 1 A_E(QUAE+QUA_TF_E),A_J(QUA+QUA_MINST_J), - 1 CQMOD) !MAKE QUV MODEL - CALL NMOCIX(A_B(A_J(QUA+QUA_CSTH_J)), - 1 SCH, - 1 A_E(A_J(QUA+QUA_PANG_J)), - 1 A_B(A_J(QUA+QUA_SBPT_J)+ - 1 L4DPL*STHIFR*BOFF+ - 1 L4MO*STHIFR), - 1 CQMOD) !MAKE XYX MODEL - END IF - END DO - DO I4=0,A_J(QUA+QUA_IIFR_J)-1 !WRITE TRANSPOSED DATA - DO BOFF=0,LLINE-1 !LINES - DO I5=0,3 - A_E(PWGT+4*BOFF+I5)= - 1 A_E(A_J(QUA+QUA_SBPT_J)/LB_E+ - 1 L4DPL*STHIFR*BOFF/LB_E+I5*STHIFR+I4) - A_X(PDAT+4*BOFF+I5)= - 1 A_X(A_J(QUA+QUA_SBPT_J)/LB_X+ - 1 L4DO*STHIFR/LB_X+ - 1 L4DPL*STHIFR*BOFF/LB_X+I5*STHIFR+I4) - END DO - END DO - IF (.NOT.WNFWR(A_J(QUA+QUA_SFCA_J), !WEIGHT - 1 4*LB_E*LLINE, - 1 A_E(PWGT), - 1 L4DPL*OFFAX2*LAX3*LAX1+ - 1 L4DPL*LAX3*I4+4*LB_E*I)) GOTO 10 - IF (.NOT.WNFWR(A_J(QUA+QUA_SFCA_J), !DATA - 1 4*LB_X*LLINE, - 1 A_X(PDAT), - 1 L4DPL*OFFAX2*LAX3*LAX1+ - 1 L4DPL*LAX3*I4+4*LB_X*I+ - 1 L4DO*LAX3)) GOTO 10 - IF (IAND(A_J(QUA+QUA_ORDER_J),QUB_M).NE.0) THEN !MODEL ASKED - DO BOFF=0,LLINE-1 !LINES - DO I5=0,3 - A_X(PMOD+4*BOFF+I5)= - 1 A_X(A_J(QUA+QUA_SBPT_J)/LB_X+ - 1 L4MO*STHIFR/LB_X+ - 1 L4DPL*STHIFR*BOFF/LB_X+I5*STHIFR+I4) - END DO - END DO - IF (.NOT.WNFWR(A_J(QUA+QUA_SFCA_J), !MODEL - 1 4*LB_X*LLINE, - 1 A_X(PMOD), - 1 L4DPL*OFFAX2*LAX3*LAX1+ - 1 L4DPL*LAX3*I4+4*LB_X*I+ - 1 L4MO*LAX3)) GOTO 10 - END IF - END DO - END DO !PASSES - IF (IAND(A_J(QUA+QUA_ORDER_J), - 1 QUB_TIF+QUB_FIT).NE.0) THEN !TIF/FIT - A_J(QUA+QUA_CMAP_J)=AX1 !SET SORTED - ELSE !ITF/IFT - A_J(A_J(QUA+QUA_CPMAP_J)+AX2)=OFFAX2+1 !SET READ - A_J(QUA+QUA_CCNT_J)=A_J(QUA+QUA_CCNT_J)+1 !NEW OFFSET - END IF - END IF - IF (IAND(A_J(QUA+QUA_ORDER_J), - 1 QUB_TIF+QUB_FIT).NE.0) THEN !TIF/FIT - IF (A_J(QUA+QUA_CMAP_J.NE.AX1)) GOTO 10 !ERROR - OFFAX2=0 !DISK OFFSET - ELSE !ITF/IFT - OFFAX2=A_J(A_J(QUA+QUA_CPMAP_J)+AX2)-1 !DISK OFFSET - IF (OFFAX2.LT.0) GOTO 10 !ERROR - END IF - IF (.NOT.WNFRD(A_J(QUA+QUA_SFCA_J), - 1 4*LB_E*LAX3, - 1 A_E(PWGT), - 1 L4DPL*OFFAX2*LAX3*LAX1+ - 1 L4DPL*LAX3*I2)) GOTO 10 !READ WEIGHT - IF (.NOT.WNFRD(A_J(QUA+QUA_SFCA_J), - 1 4*LB_X*LAX3, - 1 A_X(PDAT), - 1 L4DPL*OFFAX2*LAX3*LAX1+ - 1 L4DPL*LAX3*I2+ - 1 L4DO*LAX3)) GOTO 10 !READ DATA - IF (IAND(A_J(QUA+QUA_ORDER_J),QUB_M).NE.0) THEN !MODEL ASKED - IF (.NOT.WNFRD(A_J(QUA+QUA_SFCA_J), - 1 4*LB_X*LAX3, - 1 A_X(PMOD), - 1 L4DPL*OFFAX2*LAX3*LAX1+ - 1 L4DPL*LAX3*I2+ - 1 L4MO*LAX3)) GOTO 10 !READ MODEL - END IF - END IF -C - RETURN -C -C ERROR -C - 800 CONTINUE - DO I=0,LAX3 - DO I3=0,3 - A_E(PWGT+4*I+I3)=0 !SET NO POINTS - END DO - END DO - NSCQSR=.FALSE. !INDICATE ERROR -C - RETURN -C -C - END diff --git a/src/nscan/nscqw0.for b/src/nscan/nscqw0.for deleted file mode 100644 index 5c1704eae90baecde35e3d7a5e9c447453dece3e..0000000000000000000000000000000000000000 --- a/src/nscan/nscqw0.for +++ /dev/null @@ -1,252 +0,0 @@ -C+ NSCQW0.FOR -C WNB 940729 -C -C Revisions: -C - LOGICAL FUNCTION NSCQW0(QUA,FCA,NLINE,QUB) -C -C Write Qube list elements -C -C Result: -C -C ERROR_L = NSCQW0(QUA_J:I, FCA_J:I, NLINE_J:I, QUB_B(*):IO) -C Write NLINE Qube lines -C ERROR_L = NSCQW1(QUA_J:I, FCA_J:I, NLINE_J:I, QUB_B(*):IO) -C Merge complete Qube line set -C -C Include files: -C - INCLUDE 'WNG_DEF' - INCLUDE 'QUB_O_DEF' !QUBE LINE -C -C Parameters: -C -C -C Arguments: -C - INTEGER QUA !QUBE CONTROL AREA - INTEGER FCA !OUTPUT FILE - INTEGER NLINE !# OF LINES TO WRITE - BYTE QUB(0:*) !QUBE BUFFER -C -C Entry points: -C - LOGICAL NSCQW1 -C -C Function references: -C - LOGICAL WNGSRT !SORT - LOGICAL WNGGVA !GET MEMORY - INTEGER WNGGJ !MAKE J - LOGICAL WNFWR !WRITE - LOGICAL WNFRD !READ - INTEGER WNFEOF !FILE POSITION - EXTERNAL NSCQC0 !COMPARISON - INTEGER NSCQC0 - INTEGER NSCQC1,NSCQC2 !COMPARISON -C -C Data declarations: -C - LOGICAL NEW(0:1) !FOR MERGING -C- -C -C NSCQW0 -C - NSCQW0=.TRUE. !ASSUME OK - IF (.NOT.WNGSRT(QUB,NLINE,QUB__L,NSCQC0)) THEN - 100 CONTINUE - NSCQW0=.FALSE. - RETURN - END IF - IF (.NOT.WNFWR(FCA,NLINE*QUB__L,QUB,-1)) GOTO 100 -C - RETURN -C -C NSCQW1 -C - ENTRY NSCQW1(QUA,FCA,NLINE,QUB) -C -C PREPARE -C - NSCQW1=.TRUE. !ASSUME OK - I0=(NLINE+A_J(QUA+QUA_NLINE_J)-1)/A_J(QUA+QUA_NLINE_J)+1 !# OF PARTS - IF (.NOT.WNGGVA(2*LB_J*I0,J0)) GOTO 100 !GET BUFFER - J0=(J0-A_OB)/LB_J - J1=WNFEOF(FCA) !OUTPUT POINTER - J2=0 !OUTPUT CNT - DO I=0,I0-1 !FILL BUFFER - A_J(J0+0*I0+I)=MAX(0,MIN(A_J(QUA+QUA_NLINE_J), - 1 NLINE-I*A_J(QUA+QUA_NLINE_J))) !LENGTH PART - A_J(J0+1*I0+I)=I*A_J(QUA+QUA_NLINE_J)*QUB__L !PART DISK POINTER - END DO -C -C MERGE -C - DO I=0,I0-2 !DO MERGE CYCLES - NEW(0)=.TRUE. !NEED NEW VALUES - NEW(1)=.TRUE. - J2=0 !OUTPUT CNT - DO WHILE(NEW(0) .OR. NEW(1)) - IF (NEW(0) .AND. A_J(J0+0*I0+I).GT.0) THEN !MORE AVAILABLE - IF (.NOT.WNFRD(FCA,QUB__L,QUB(0),A_J(J0+1*I0+I))) GOTO 100 - NEW(0)=.FALSE. - A_J(J0+0*I0+I)=A_J(J0+0*I0+I)-1 !COUNT - A_J(J0+1*I0+I)=A_J(J0+1*I0+I)+QUB__L - IF (NEW(1) .AND. A_J(J0+0*I0+I+1).GT.0) THEN !MORE AVAILABLE - IF (.NOT.WNFRD(FCA,QUB__L,QUB(QUB__L),A_J(J0+1*I0+I+1))) - 1 GOTO 100 - NEW(1)=.FALSE. - A_J(J0+0*I0+I+1)=A_J(J0+0*I0+I+1)-1 !COUNT - A_J(J0+1*I0+I+1)=A_J(J0+1*I0+I+1)+QUB__L - I1=NSCQC0(QUB(0),QUB(QUB__L)) !COMPARE - IF (I1.LE.0) THEN - IF (.NOT.WNFWR(FCA,QUB__L,QUB(0),J1+J2*QUB__L)) GOTO 100 - J2=J2+1 !COUNT - NEW(0)=.TRUE. - IF (I1.EQ.0) NEW(1)=.TRUE. !SKIP DOUBLE - ELSE - IF (.NOT.WNFWR(FCA,QUB__L,QUB(QUB__L),J1+J2*QUB__L)) GOTO 100 - J2=J2+1 !COUNT - NEW(1)=.TRUE. - END IF - ELSE !COPY FIRST BUFFER - NEW(1)=.FALSE. - IF (.NOT.NEW(0)) THEN - IF (.NOT.WNFWR(FCA,QUB__L,QUB(0),J1+J2*QUB__L)) GOTO 100 - J2=J2+1 !COUNT - NEW(0)=.TRUE. - END IF - DO WHILE (NEW(0) .AND. A_J(J0+0*I0+I).GT.0) !MORE AVAILABLE - IF (.NOT.WNFRD(FCA,QUB__L,QUB(0),A_J(J0+1*I0+I))) - 1 GOTO 100 - A_J(J0+0*I0+I)=A_J(J0+0*I0+I)-1 !COUNT - A_J(J0+1*I0+I)=A_J(J0+1*I0+I)+QUB__L - IF (.NOT.WNFWR(FCA,QUB__L,QUB(0),J1+J2*QUB__L)) GOTO 100 - J2=J2+1 !COUNT - END DO - NEW(0)=.FALSE. - END IF - ELSE !COPY SECOND BUFFER - NEW(0)=.FALSE. - IF (.NOT.NEW(1)) THEN - IF (.NOT.WNFWR(FCA,QUB__L,QUB(QUB__L),J1+J2*QUB__L)) GOTO 100 - J2=J2+1 !COUNT - NEW(1)=.TRUE. - END IF - DO WHILE (NEW(1) .AND. A_J(J0+0*I0+I+1).GT.0) !MORE AVAILABLE - IF (.NOT.WNFRD(FCA,QUB__L,QUB(QUB__L),A_J(J0+1*I0+I+1))) - 1 GOTO 100 - A_J(J0+0*I0+I+1)=A_J(J0+0*I0+I+1)-1 !COUNT - A_J(J0+1*I0+I+1)=A_J(J0+1*I0+I+1)+QUB__L - IF (.NOT.WNFWR(FCA,QUB__L,QUB(QUB__L),J1+J2*QUB__L)) GOTO 100 - J2=J2+1 !COUNT - END DO - NEW(1)=.FALSE. - END IF - END DO !END MERGE CYCLE - DO I1=0,J2-1 !COPY DATA - IF (.NOT.WNFRD(FCA,QUB__L,QUB(0),J1+I1*QUB__L)) GOTO 100 - IF (.NOT.WNFWR(FCA,QUB__L,QUB(0),I1*QUB__L)) GOTO 100 - END DO - A_J(J0+0*I0)=J2 !NEW COUNT - A_J(J0+1*I0)=0 !NEW INPUT PTR - END DO !NEXT MERGE CYCLE -C -C GET RID OF DUPLICATES -C - A_J(QUA+QUA_CNT_J)=J2 - J2=0 !OUTPUT CNT - I=0 !INPUT CNT - NEW(0)=.TRUE. - NEW(1)=.TRUE. - DO WHILE (I.LT.A_J(QUA+QUA_CNT_J) - 1 .OR. (.NOT.NEW(0) .AND. .NOT.(NEW(1)))) - IF (NEW(0)) THEN - IF (.NOT.WNFRD(FCA,QUB__L,QUB(0),I*QUB__L)) GOTO 100 - I=I+1 !CNT - NEW(0)=.FALSE. - ELSE IF (NEW(1)) THEN - IF (.NOT.WNFRD(FCA,QUB__L,QUB(QUB__L),I*QUB__L)) GOTO 100 - I=I+1 !CNT - NEW(1)=.FALSE. - ELSE - I1=NSCQC0(QUB(0),QUB(QUB__L)) !COMPARE - IF (I1.EQ.0) THEN - NEW(1)=.TRUE. !SKIP - ELSE IF (I1.LT.0) THEN - IF (.NOT.WNFWR(FCA,QUB__L,QUB(0),J2*QUB__L)) GOTO 100 !WRITE - NEW(0)=.TRUE. - J2=J2+1 !COUNT - ELSE - IF (.NOT.WNFWR(FCA,QUB__L,QUB(QUB__L),J2*QUB__L)) GOTO 100 !WRITE - NEW(1)=.TRUE. - J2=J2+1 !COUNT - END IF - END IF - END DO - IF (.NOT.NEW(0)) THEN !WRITE LAST - IF (.NOT.WNFWR(FCA,QUB__L,QUB(0),J2*QUB__L)) GOTO 100 !WRITE - J2=J2+1 - END IF - IF (.NOT.NEW(1)) THEN !WRITE LAST - IF (.NOT.WNFWR(FCA,QUB__L,QUB(QUB__L),J2*QUB__L)) GOTO 100 !WRITE - J2=J2+1 - END IF -C -C FINALISE -C - A_J(QUA+QUA_CNT_J)=J2 - A_J(QUA+QUA_NFLD_J)=0 !INIT QUBE DESCRIPTION - A_J(QUA+QUA_NFRQ_J)=0 - A_J(QUA+QUA_NHA_J)=0 - A_J(QUA+QUA_NIFR_J)=0 - A_J(QUA+QUA_NBLK_J)=0 - J3=0 !CURRENT FIELD START POINTER - I=0 !LINE CNT - DO WHILE (I.LT.A_J(QUA+QUA_CNT_J)) - IF (.NOT.WNFRD(FCA,QUB__L,QUB(0),J3)) GOTO 100 - I=I+1 !CNT LINE - J1=J3+QUB__L !INPUT PTR - I1=1 !FREQ. CNT - I2=WNGGJ(QUB(QUB_SCN_1)) !HA CNT - I3=1 !HA BLK COUNT - A_J(QUA+QUA_NFLD_J)=A_J(QUA+QUA_NFLD_J)+1 !FIELD ID - DO WHILE (I.LT.A_J(QUA+QUA_CNT_J)) !CHECK LINES - IF (.NOT.WNFRD(FCA,QUB__L,QUB(QUB__L),J1)) GOTO 100 - IF (NSCQC1(QUB(0),QUB(QUB__L)).EQ.0) THEN !SAME FIELD - IF (NSCQC2(QUB(0),QUB(QUB__L)).EQ.0) THEN !SAME FREQ - I2=I2+WNGGJ(QUB(QUB__L+QUB_SCN_1)) !ADD HA LENGTH - I3=I3+1 - ELSE - A_J(QUA+QUA_NHA_J)=MAX(A_J(QUA+QUA_NHA_J),I2) !MAX. HA SIZE - A_J(QUA+QUA_NBLK_J)=MAX(A_J(QUA+QUA_NBLK_J),I3) !MAX. HA BLK - I2=WNGGJ(QUB__L+QUB_SCN_1) !NEW HA SIZE - I3=1 - END IF - CALL WNGMV(LB_J,A_J(QUA+QUA_NFLD_J), - 1 QUB(QUB__L+QUB_FID_1)) !SET FIELD ID - CALL WNGMVZ(LB_J,QUB(QUB__L+QUB_NFRQ_1)) - IF (.NOT.WNFWR(FCA,QUB__L,QUB(QUB__L),J1)) GOTO 100 !REWRITE - I=I+1 !COUNT - I1=I1+1 - J1=J1+QUB__L - ELSE - GOTO 200 !TRY MORE - END IF - END DO - 200 CONTINUE - CALL WNGMV(LB_J,A_J(QUA+QUA_NFLD_J),QUB(QUB_FID_1)) !SET FIELD ID - CALL WNGMV(LB_J,I1,QUB(QUB_NFRQ_1)) !SET # OF FREQUENCIES - IF (.NOT.WNFWR(FCA,QUB__L,QUB(0),J3)) GOTO 100 !REWRITE - J3=J1 !NEXT FIELD START - A_J(QUA+QUA_NFRQ_J)=MAX(A_J(QUA+QUA_NFRQ_J),I1) !SET MAX. SIZES - A_J(QUA+QUA_NHA_J)=MAX(A_J(QUA+QUA_NHA_J),I2) - A_J(QUA+QUA_NBLK_J)=MAX(A_J(QUA+QUA_NBLK_J),I3) - A_J(QUA+QUA_NIFR_J)=MAX(A_J(QUA+QUA_NIFR_J),WNGGJ(QUB(QUB_NIFR_1))) - END DO -C - CALL WNGFVA(2*LB_J*I0,J0*LB_J+A_OB) !FREE MEMORY - RETURN -C -C - END diff --git a/src/nscan/nscqwa.for b/src/nscan/nscqwa.for deleted file mode 100644 index 6d79f96033f07eefbc3909e8ec4f4ce93659f0e4..0000000000000000000000000000000000000000 --- a/src/nscan/nscqwa.for +++ /dev/null @@ -1,190 +0,0 @@ -C+ NSCQWA.FOR -C WNB 940812 -C -C Revisions: -C - LOGICAL FUNCTION NSCQWA(QUA,FCA,AX1,AX2,CAP,CDAP) -C -C Write interferometer errors for Qube -C -C Result: -C -C NSCQWA_L = NSCQWA( QUA_J:I, FCA_J:I, AX1_J:I, AX2_J:I, -C CAP_J:I, CDAP_J:I) -C Write additive interferometer errors for Qube scn -C at positions AX1, AX2, using -C the apply/de-apply bits in CAP/CDAP. -C The data used should have been put in A_X(POUT) -C (see NSCQSR) -C NSCQWM_L = NSCQWM( QUA_J:I, FCA_J:I, AX1_J:I, AX2_J:I, -C CAP_J:I, CDAP_J:I) -C Write multiplicative ifr errors -C -C Include files: -C - INCLUDE 'WNG_DEF' - INCLUDE 'CBITS_DEF' !BIT DEFINITIONS - INCLUDE 'QUB_O_DEF' !QUBE DEFINITION - INCLUDE 'STH_O_DEF' !SCAN SET HEADER -C -C Parameters: -C -C -C Arguments: -C - INTEGER QUA !QUBE CONTROL AREA - INTEGER FCA !FILE - INTEGER AX1,AX2 !AXES TO READ - INTEGER CAP,CDAP !APPLY/DE-APPLY BITS -C -C Entry points: -C - LOGICAL NSCQWM -C -C Function references: -C - LOGICAL WNFWR !WRITE DATA - LOGICAL NSCSWI !WRITE SCAN IFR ERRORS - LOGICAL NSCQR0 !FIND SET HEADER - LOGICAL NSCQE0,NSCQE1 !WRITE ERRORS FOR BLOCK - LOGICAL NSCQWF !WRITE FORCED ERROR -C -C Data declarations: -C - INTEGER CTYP !TYPE OF ERROR - INTEGER SCNP !START SCAN POINTER - INTEGER LAX1,LAX2,LAX3 !LENGTH AXIS 1,2,3 - INTEGER OFFAX2 !DISK OFFSET AXIS 2 - INTEGER L4DPL !LENGTH ONE DATA POINT -C- -C -C NSCQWA -C - CTYP=CAP_AIFR - GOTO 100 -C -C NSCQWM -C - ENTRY NSCQWM(QUA,FCA,AX1,AX2,CAP,CDAP) -C - CTYP=CAP_MIFR - GOTO 100 -C -C INIT -C - 100 CONTINUE - IF (IAND(A_J(QUA+QUA_ORDER_J),QUB_OUT).EQ.0) GOTO 800 !CANNOT OUTPUT - NSCQWA=.TRUE. !ASSUME OK - L4DPL=4*(LB_X) !TOTAL DATA POINT LENGTH - LAX3=A_J(QUA+QUA_NDAT_J) !LENGTH 3RD AXIS - IF (IAND(A_J(QUA+QUA_ORDER_J),QUB_I).NE.0) THEN !GIVE NORMAL SCAN - IF (IAND(A_J(QUA+QUA_ORDER_J),QUB_FTI).NE.0) THEN !FTI - I0=AX1 !FREQ POINT - I1=AX2 !TIME POINT - ELSE !TFI - I0=AX2 - I1=AX1 - END IF - I2=LAX3-1 !IFR POINTS - ELSE IF (IAND(A_J(QUA+QUA_ORDER_J),QUB_F).NE.0) THEN !GIVE FREQ SCAN - IF (IAND(A_J(QUA+QUA_ORDER_J),QUB_TIF).NE.0) THEN !TIF - I1=AX1 !TIME POINT - I2=AX2 !IFR POINT - ELSE !ITF - I1=AX2 - I2=AX1 - LAX1=A_J(QUA+QUA_IIFR_J) - LAX2=A_J(QUA+QUA_IHA_J) - END IF - I0=LAX3-1 !FREQ POINT - ELSE IF (IAND(A_J(QUA+QUA_ORDER_J),QUB_T).NE.0) THEN !GIVE HA SCAN - IF (IAND(A_J(QUA+QUA_ORDER_J),QUB_FIT).NE.0) THEN !FIT - I0=AX1 !FREQ POINT - I2=AX2 !IFR POINT - ELSE !IFT - I0=AX2 - I2=AX1 - LAX1=A_J(QUA+QUA_IIFR_J) - LAX2=A_J(QUA+QUA_IFRQ_J) - END IF - I1=LAX3-1 !HA POINT - ELSE !UNKNOWN - GOTO 800 - END IF - IF (I0.LT.0 .OR. I0.GE.A_J(QUA+QUA_IFRQ_J) .OR. - 1 I1.LT.0 .OR. - 1 I1.GE.A_J(QUA+QUA_IHA_J) .OR. - 1 I2.LT.0 .OR. - 1 I2.GE.A_J(QUA+QUA_IIFR_J)) GOTO 800 !ILLEGAL -C -C WRITE FOR TFI/FTI SCAN -C - IF (IAND(A_J(QUA+QUA_ORDER_J),QUB_I).NE.0) THEN !GIVE NORMAL SCAN - IF (.NOT.NSCQR0(QUA,FCA,I0,I1,SCNP)) THEN !READ SET HEADER - 10 CONTINUE - CALL WNCTXT(F_TP,'Error writing Qube scan data '// - 1 'F=!UJ, T=!UJ', - 1 I0,I1) - GOTO 800 - END IF - IF (.NOT.NSCSWI(FCA,A_B(A_J(QUA+QUA_CSTH_J)), - 1 I1-SCNP, - 1 A_I(A_J(QUA+QUA_PIFR_J)), - 1 A_X(A_J(QUA+QUA_POUT_J)), - 1 CTYP,CAP,CDAP,0)) GOTO 10 !WRITE IFR ERRORS -C -C WRITE TIF/FIT/ITF/IFT -C - ELSE - IF (IAND(A_J(QUA+QUA_ORDER_J), - 1 QUB_TIF+QUB_FIT).NE.0) THEN !TIF/FIT - IF (A_J(QUA+QUA_CIMAP_J).NE.AX1 .OR. - 1 A_J(QUA+QUA_CAP_J).NE.CAP .OR. - 1 A_J(QUA+QUA_CDAP_J).NE.CDAP .OR. - 1 A_J(QUA+QUA_TCOR_J).NE.CTYP) THEN !EMPTY FIRST - IF (.NOT.NSCQE0(QUA,FCA, - 1 A_J(QUA+QUA_CIMAP_J), - 1 0)) GOTO 10 !WRITE EXISTING ERRORS - IF (.NOT.NSCQE1(QUA,FCA, - 1 A_J(QUA+QUA_CIMAP_J), - 1 0)) GOTO 10 !EMPTY CURRENT - A_J(QUA+QUA_CIMAP_J)=AX1 !SET CURRENT - END IF - OFFAX2=0 !CURRENT DISK OFFSET - ELSE !ITF/IFT - IF (A_J(QUA+QUA_CAP_J).NE.CAP .OR. - 1 A_J(QUA+QUA_CDAP_J).NE.CDAP .OR. - 1 A_J(QUA+QUA_TCOR_J).NE.CTYP) THEN !WRITE FIRST - IF (.NOT.NSCQWF(QUA,FCA)) GOTO 10 - END IF - IF (A_J(A_J(QUA+QUA_CIPMAP_J)+AX2).LE.0) THEN !EMPTY FIRST - IF (.NOT.NSCQE1(QUA,FCA, - 1 -1, - 1 A_J(QUA+QUA_CICNT_J))) GOTO 10 !EMPTY FIRST - A_J(QUA+QUA_CICNT_J)=A_J(QUA+QUA_CICNT_J)+1 !COUNT BLOCKS - A_J(A_J(QUA+QUA_CIPMAP_J)+AX2)= - 1 A_J(QUA+QUA_CICNT_J) !SAVE POINTER - END IF - OFFAX2=A_J(QUA+QUA_CICNT_J)-1 !FILE OFFSET - END IF - IF (.NOT.WNFWR(A_J(QUA+QUA_IFCA_J), - 1 L4DPL*LAX3, - 1 A_X(A_J(QUA+QUA_POUT_J)), - 1 L4DPL*OFFAX2*LAX3*LAX1+ - 1 L4DPL*LAX3*I2)) GOTO 10 !WRITE ERRORS - END IF - A_J(QUA+QUA_CAP_J)=CAP !SAVE CURRENT TYPES - A_J(QUA+QUA_CDAP_J)=CDAP - A_J(QUA+QUA_TCOR_J)=CTYP -C - RETURN -C -C ERROR -C - 800 CONTINUE - NSCQWA=.FALSE. !INDICATE ERROR -C - RETURN -C -C - END diff --git a/src/nscan/nscqwf.for b/src/nscan/nscqwf.for deleted file mode 100644 index 257ce1eeb7f1c6e2dfcf6c8c8acaaad87eeb306a..0000000000000000000000000000000000000000 --- a/src/nscan/nscqwf.for +++ /dev/null @@ -1,67 +0,0 @@ -C+ NSCQWF.FOR -C WNB 940812 -C -C Revisions: -C - LOGICAL FUNCTION NSCQWF(QUA,FCA) -C -C Write actual interferometer errors -C -C Result: -C -C NSCQWF_L = NSCQWF_L( QUA_J:I, FCA_J:I) -C Write Qube scan interferometer errors -C -C Include files: -C - INCLUDE 'WNG_DEF' - INCLUDE 'CBITS_DEF' !BIT DEFINITIONS - INCLUDE 'QUB_O_DEF' !QUBE DEFINITION - INCLUDE 'STH_O_DEF' !SCAN SET HEADER -C -C Parameters: -C -C -C Arguments: -C - INTEGER QUA !QUBE CONTROL AREA - INTEGER FCA !FILE -C -C Function references: -C - LOGICAL NSCQE0 !WRITE A BLOCK -C -C Data declarations: -C -C- -C -C INIT -C - NSCQWF=.TRUE. !ASSUME OK - IF (IAND(A_J(QUA+QUA_ORDER_J),QUB_OUT).EQ.0) - 1 RETURN !CANNOT DO - IF (IAND(A_J(QUA+QUA_ORDER_J),QUB_I).NE.0) THEN !GIVE NORMAL SCAN - RETURN !NOTHING TO DO - END IF -C -C WRITE DAVED ERRORS -C - IF (IAND(A_J(QUA+QUA_ORDER_J), - 1 QUB_TIF+QUB_FIT).NE.0) THEN !TIF/FIT - IF (A_J(QUA+QUA_CIMAP_J).LT.0) RETURN !NOTHING TO DO - IF (.NOT.NSCQE0(QUA,FCA,A_J(QUA+QUA_CIMAP_J),0)) THEN - 10 NSCQWF=.FALSE. - RETURN - END IF - ELSE IF (IAND(A_J(QUA+QUA_ORDER_J), - 1 QUB_ITF+QUB_IFT).NE.0) THEN !ITF/IFT - DO I=0,A_J(QUA+QUA_CICNT_J)-1 !DO ALL BLOCKS - IF (.NOT.NSCQE0(QUA,FCA,I, - 1 A_J(A_J(QUA+QUA_CIPMAP_J)+I)-1)) GOTO 10 - END DO - END IF -C - RETURN -C -C - END diff --git a/src/nscan/nscreg.for b/src/nscan/nscreg.for deleted file mode 100644 index efa032454008a9ad6c9e28cbf16ad17fb4508bd1..0000000000000000000000000000000000000000 --- a/src/nscan/nscreg.for +++ /dev/null @@ -1,146 +0,0 @@ -C+ NSCREG.FOR -C WNB 900820 -C -C Revisions: -C WNB 920828 Change completely for different meaning -C JPH 930610 Comments. Labels 202-204 at the end, rearrange code to -C clarify loop structure. Meaningful variable names. -C WNB 930803 Change to SCN_DEF -C JPH 930827 Report new old and new indices -C CMV 931220 Pass FCA of input file to WNDXLP and WNDSTA/Q -C - SUBROUTINE NSCREG -C -C Create new job with new SGH hierarchy for data in SCN file -C -C Result: -C -C CALL NSCREG will create new groups -C -C PIN references: -C -C INPUT_SCAN -C SETS -C SET_PATTERN -C -C Include files: -C - INCLUDE 'WNG_DEF' - INCLUDE 'NSC_DEF' - INCLUDE 'STH_O_DEF' !SET HEADER - INCLUDE 'GFH_O_DEF' !GENERAL FILE HEADER - INCLUDE 'SGH_O_DEF' !SUB-GROUP HEADER - INCLUDE 'SCN_DEF' !subgroup levels -C -C Parameters: -C -C -C Arguments: -C -C -C Function references: -C - LOGICAL WNDNOD !GET NODE NAME - LOGICAL WNFOP !OPEN FILE - LOGICAL WNDSTA !GET SETS TO DO - LOGICAL NSCSTG !GET A SET - LOGICAL WNDLNG,WNDLNF !LINK SUB-GROUP - CHARACTER*32 WNTTSG !SUB-GROUP NAME -C -C Data declarations: -C - INTEGER STHP !SUB-GROUP POINTER - INTEGER SNAM(0:7),SNAMN(0:7) !SET NAME - INTEGER SETNEW(0:7,0:1) !SET PATTERN - INTEGER LVL !subgroup level - BYTE STH(0:STHHDL-1) !SET HEADER - INTEGER STHJ(0:STHHDL/4-1) - INTEGER*2 STHI(0:STHHDL/2-1) - REAL STHE(0:STHHDL/4-1) - EQUIVALENCE (STH,STHJ,STHI,STHE) -C- -C****************************************************************************** -C Get user's parameters -C****************************************************************************** -C -C GET NODE -C - 100 CONTINUE - IF (.NOT.WNDNOD('INPUT_SCN_NODE',' ', - 1 'SCN','R',NODIN,IFILE)) THEN !NODE - IF (E_C.EQ.DWC_ENDOFLOOP) RETURN !READY WITH REGROUP - CALL WNCTXT(F_TP,'Node does not exist') - GOTO 100 - ELSE IF (E_C.EQ.DWC_NULLVALUE) THEN - RETURN !END - ELSE IF (E_C.EQ.DWC_WILDCARD) THEN - GOTO 100 !MUST SPECIFY - ELSE - IF (.NOT.WNFOP(FCAIN,IFILE,'U')) THEN !OPEN SCN FILE - CALL WNCTXT(F_TP,'Cannot open file attached to node') - GOTO 100 - END IF -C -C GET SETS specification -C - DO LVL=0,7 - SNAMN(LVL)=-1 - ENDDO - 200 CONTINUE - IF (.NOT.WNDSTA('SCN_SETS',MXNSET,SETS,FCAIN)) - 1 GOTO 204 !GET SETS TO DO - IF (SETS(0,0).EQ.0) GOTO 204 !NONE - IF (.NOT.WNDSTA('SCN_SET_PATTERN',1,SETNEW,FCAIN)) - 1 GOTO 204 !GET SETS TO MAKE - IF (SETNEW(0,0).EQ.0) GOTO 204 !NONE - -C****************************************************************************** -C DO SETS -C****************************************************************************** -C - DO WHILE (NSCSTG(FCAIN,SETS,STH, !loop over sectors - 1 STHP,SNAM)) - CALL WNDSTI(FCAIN,SNAM) !MAKE PROPER NAME - DO LVL=SCN_GRP,SCN_CHN !MAKE OUTPUT NAME - IF (SETNEW(LVL,1).LT.0) THEN !COPY FIELD - SNAMN(LVL)=SNAM(LVL) - ELSE - SNAMN(LVL)=SETNEW(LVL,1) - END IF - END DO - DO LVL=SCN_GRP,SCN_CHN !CHECK FOR LOOP - IF (SNAMN(LVL).NE.SNAM(LVL)) GOTO 203!CAN DO - END DO - GOTO 201 !CANNOT DO - 203 CONTINUE - IF (.NOT.WNDLNF(0+GFH_LINKG_1, - 1 SNAMN(SCN_GRP), - 1 SGH_GROUPN_1,FCAIN,SGPH(0), - 1 SGNR(0))) GOTO 202 !find/create group - DO LVL=SCN_OBS,SCN_CHN !find/create - IF (.NOT.WNDLNF ! observn, field, channel - 1 (SGPH(LVL-1)+SGH_LINKG_1, - 1 SNAMN(LVL), - 1 SGH_GROUPN_1,FCAIN,SGPH(LVL), - 1 SGNR(LVL))) GOTO 202 - ENDDO - IF (.NOT.WNDLNG !link STH at first free sector - 1 (SGPH(SCN_CHN)+SGH_LINKG_1,STHP,! number - 1 SGH_GROUPN_1,FCAIN,SGPH(SCN_SCT), - 1 SGNR(SCN_SCT))) GOTO 202 - SNAMN(SCN_SCT)=SGNR(SCN_SCT) - CALL WNCTXT(F_TP,'Creating new index !AS for sector !AS', - 1 WNTTSG(SNAMN,0),WNTTSG(SNAM,0) ) - 201 CONTINUE - ENDDO !end sectors loop - ENDIF - GOTO 200 !prompt for more sectors -C -C EXITS -C - 202 CONTINUE !all errors here - CALL WNCTXT(F_TP,'!/Cannot create sub-group') - 204 CONTINUE !all exits here - CALL WNFCL(FCAIN) !CLOSE DATASET - GOTO 100 !FINISH - END diff --git a/src/nscan/nscrif.for b/src/nscan/nscrif.for deleted file mode 100644 index 77c9e8b2cc0ac00db4378639d35c4a98e267097b..0000000000000000000000000000000000000000 --- a/src/nscan/nscrif.for +++ /dev/null @@ -1,88 +0,0 @@ -C+ NSCRIF.FOR -C WNB 930901 -C -C Revisions: -C - LOGICAL FUNCTION NSCRIF(FCA,STHJ,IFRJ,IFRE) -C -C Read interferometer information for a set -C -C Result: -C -C NSCRIF_L = NSCRIF( FCA_J:I, STHJ_J(0:*):I, -C IFRJ_J(0:2,0:*):O, IFRE_E(0:2,0:*):O) -C Read the interferometer table belonging to -C set with set header STH from file FCA into -C the interferometer tables IFRJ and IFRE. -C IFRJ: -C 0 (IFJ_WT): W telescope -C 1 (IFJ_WT): E telescope -C 2 (IFJ_IFR): Interferometer (256*E+W) -C IFRE: -C 0 (IFE_ANG): W X-dipole angle (N->E, circles) -C 1 (IFE_SB): sin(E X-dipole - W X-dipole) -C 2 (IFE_CB): cos(same) -C -C Include files: -C - INCLUDE 'WNG_DEF' - INCLUDE 'CBITS_DEF' - INCLUDE 'STH_O_DEF' !SET HEADER -C -C Parameters: -C -C -C Arguments: -C - INTEGER FCA !FILE CONTROL AREA - INTEGER STHJ(0:*) !CURRENT SET HEADER - INTEGER IFRJ(IFJ_WT:IFJ_IFR,0:*) !INTERFEROMETER TABLE - INTEGER IFRE(IFE_ANG:IFE_CB,0:*) -C -C Function references: -C - LOGICAL WNFRD !READ DATA -C -C Data declarations: -C - INTEGER*2 IFRT(0:STHIFR-1) !LOCAL INTERFEROMETER TABLE -C- -C -C INIT -C - NSCRIF=.TRUE. !ASSUME OK -C -C READ -C - IF (.NOT.WNFRD(FCA,LB_I*STHJ(STH_NIFR_J),IFRT, !READ TABLE - 1 STHJ(STH_IFRP_J))) THEN - NSCRIF=.FALSE. !ERROR READING TABLE - GOTO 800 - END IF -C -C MAKE IFRJ -C - DO I=0,STHJ(STH_NIFR_J)-1 !MAKE ARRAY - IFRJ(IFJ_WT,I)=MOD(IFRT(I),256) !WEST TEL. - IFRJ(IFJ_ET,I)=IFRT(I)/256 !EAST TEL. - END DO -C -C MAKE IFRE -C - DO I=0,STHJ(STH_NIFR_J)-1 - IFRE(IFE_ANG,I)=IAND(3,ISHFT(STHJ(STH_DIPC_J), - 1 -2*IFRJ(IFJ_WT,I)))/8. !ANGLE W TELESCOPE - R0=IAND(3,ISHFT(STHJ(STH_DIPC_J), - 1 -2*IFRJ(IFJ_ET,I)))/8.-IFRE(IFE_ANG,I) !DIFF. E TEL. - IFRE(IFE_SB,I)=SIN(R0*PI2) !ITS SINE - IFRE(IFE_CB,I)=COS(R0*PI2) !AND COSINE - END DO -C -C READY -C - 800 CONTINUE -C - RETURN -C -C - END diff --git a/src/nscan/nscsad.for b/src/nscan/nscsad.for deleted file mode 100644 index 11d079f1328f96a85dc2438715246f7ce4945d56..0000000000000000000000000000000000000000 --- a/src/nscan/nscsad.for +++ /dev/null @@ -1,128 +0,0 @@ -C+ NSCSAD.FOR -C WNB 910208 -C -C Revisions: -C WNB 910820 Add extinction, refraction Faraday -C WNB 910913 Different (de-)application get -C GvD 920429 Declare WNDPAR as logical iso. integer -C WNB 921201 Add gain/phase for zero -C WNB 921217 Typo PHAS'e' -C HjV 921217 WNDPAR returns NOPHASE; so use again PHASE -C WNB 930602 Add CLK -C JPH 930615 Symbolic names for mask bits in CBITS_O_DEF -C WNB 930803 CBITS_DEF -C CMV 940429 Use CAP_* bits throughout, extra argument in NSCSAZ -C AXC 040130 APZ byte array to logical array -C - SUBROUTINE NSCSAD(CAP,CDAP) -C -C Get the corrections to Apply and/or De-apply on data -C -C Result: -C CALL NSCSAD ( CAP_J:O, CDAP_J:O) -C Fill CAP and CDAP with bits (as defined by CBITS.DSC) indicating which -C corrections should be (de-)applied to the data - -C -C CALL NSCSAZ ( CAP_J:O, APZ(0:1)_L:O) -C Fill CAP with bits (as defined by CBITS.DSC) indicating which -C corrections should be zeroed. APSOL indicates which of gain and -C phase should be zeroed. -C -C -C Pin references: -C -C ZERO -C -C Include files: -C - INCLUDE 'WNG_DEF' - INCLUDE 'CBITS_DEF' -C -C Parameters: -C - INTEGER TXTL !LENGTH INPUT DATA - PARAMETER (TXTL=16) - INTEGER MAXDEF !# OF INPUTS - PARAMETER (MAXDEF=13) - INTEGER MXNAPP !KNOWN APPLIED - PARAMETER (MXNAPP=11) -C -C Arguments: -C - INTEGER CAP !APPLY CORRECTIONS - INTEGER CDAP !DE-APPLY CORRECTIONS - LOGICAL APZ(0:1) !ZERO GAIN/PHASE -C -C Function references: -C - LOGICAL WNDPAR !GET USER DATA -C -C Data declarations: -C - CHARACTER*(TXTL) TXT(MAXDEF) !INPUT DATA - CHARACTER*5 TAPP(MXNAPP) !APPLIED - DATA TAPP/'RED', 'ALG', 'OTH', - 1 'EXT', 'REF', 'IREF', 'FAR', 'CLK', - 1 'IFR', 'MIFR','SHIFT'/ - INTEGER SAPP(MXNAPP) - DATA SAPP/ - 1 CAP_RED, CAP_ALG, CAP_OTH, - 1 CAP_XTN, CAP_REF, CAP_IRE, CAP_FAR, CAP_CLK, - 1 CAP_AIFR, CAP_MIFR, CAP_SHF/ -C- -C -C GET APPLY/DE-APPLY -C - CALL WNDDAP(CAP,CDAP) !GET CURRENT VALUES -C - RETURN -C -C GET ZERO -C - ENTRY NSCSAZ(CAP,APZ) -C - 40 CONTINUE - CAP=0 !ZERO NOTHING - APZ(0)=.TRUE. !ZERO GAIN AND PHASE - APZ(1)=.TRUE. - IF (.NOT.WNDPAR('ZERO',TXT,MAXDEF*TXTL,J0,'NONE')) THEN !GET INFO - IF (E_C.EQ.DWC_ENDOFLOOP) GOTO 41 !READY - GOTO 40 !REPEAT - END IF -C - IF (J0.EQ.0) THEN - CAP=0 !ASSUME NONE - ELSE IF (J0.LT.0) THEN !ALL - CAP=CAP_ALLMSK - ELSE - CAP=0 - DO I=1,J0 !ALL INPUTS - IF (TXT(I).EQ.'NONE') THEN - CAP=0 - ELSE IF (TXT(I).EQ.'ALL') THEN - CAP=CAP_ALLMSK - ELSE IF (TXT(I).EQ.'NOGAIN') THEN - APZ(0)=.FALSE. - ELSE IF (TXT(I).EQ.'NOPHASE') THEN - APZ(1)=.FALSE. - ELSE - DO I1=1,MXNAPP - IF (TXT(I).EQ.TAPP(I1)) THEN !FOUND - CAP=IOR(CAP,SAPP(I1)) !SET - APZ(0)=.TRUE. !SET GAIN/PHASE - APZ(1)=.TRUE. - ELSE IF (TXT(I).EQ.'NO'//TAPP(I1)) THEN - CAP=IAND(CAP,.NOT.SAPP(I1)) - END IF - END DO - END IF - END DO - END IF -C - 41 CONTINUE -C - RETURN -C -C - END diff --git a/src/nscan/nscscr.for b/src/nscan/nscscr.for deleted file mode 100644 index 9a6b253eb014ea18319077f2132a1af74f23275c..0000000000000000000000000000000000000000 --- a/src/nscan/nscscr.for +++ /dev/null @@ -1,971 +0,0 @@ -C+ NSCSCR.FOR -C WNB 900306 -C -C Revisions: -C WNB 910813 Add NSCSCT -C WNB 910820 Add NSCSCW -C WNB 910820 Add extinction, refraction, Faraday -C WNB 910920 Add Model, ifr, mifr -C WNB 911118 Typo Faraday rotation correction, and change sign -C WNB 920515 Add use of scale factor -C WNB 920826 Add NSCSCM -C WNB 920827 Add NSCSCI -C WNB 930602/22 Add latitude choice -C WNB 930608/22 Add new weight/flag -C WNB 930614/22 Add Shift, clock correction, ionosph. refraction -C WNB 930623 Interim(?) shift of de-applied model. The proper -C place for this function is in NGCALC, but no baseline -C info present as yet. -C WNB 930630 Slight change of logics at end for VMS compiler bug -C WNB 930803 CBITS_DEF -C WNB 930819 Always 4 polarisations in model, AIFR and MIFR -C JPH 930901 Move NSCSCW to a file of its own -C JPH 931110 Fix clock correction: sin(HA) --> cos(HA), missing *PI2 -C WNB 931130 Add ACORM=0 option -C Note: assumed single band Tsys and Aeff=500 m^2 for now -C CMV 931215 Add entry NSCSCF to get flags and data -C CMV 931216 Corrected stupid typo -C CMV 940218 Changed argument sequence in NSCSCF -C WNB 940227 Correct Faraday rotation and model for all -C dipole positions -C Note: polarisation corrections (i.e. dipole angle/ -C ellipticity) still for non-crossed only -C CMV 940224 Implement differential shifts -C JEN 940413 Removed bug from NSCSCM (FMOD->XMOD) -C CMV 940422 Removed bug in Farad. corr (init of LWGT and OWGT) -C CMV 940429 Use bitmasks everywhere -C WNB 940811 Change order (de-)apply AIFR -C WNB 940811 Add NSCSCX -C HjV 950511 Test also if AOTHUSED is set -C WNB 950704 Add NSCSCY -C JPH 960124 Correct description of NSCSCF -C - LOGICAL FUNCTION NSCSCR(FCA,STH,IFRT,SCN,CAP,CDAP,SCH,WGT,CDAT) -C -C Read data for a scan -C -C Result: -C -C NSCSCR_L = NSCSCR( FCA_J:I, STH_B(0:*):I, IFRT_I(0:*):I, SCN_J:I, -C CAP_J:I, CDAP_J:I, SCH_B(0:*):O, -C WGT_E(0:*,0:3):O, CDAT_X(0:*,0:3)) -C Read scan number SCN from FCA, using the -C set header STH with interferometers IFRT. -C CAP indicates the corrections to be applied, -C CDAP the corrections to be de-applied, with -C (see NSCSAD): -C -C CAP_RED bit 0 (1) : redundancy -C CAP_ALG 1 (2) : align -C CAP_OTH 2 (4) : others -C CAP_XTN 3 (8) : extinction -C CAP_REF 4 (16) : refraction -C CAP_IRE 5 (32) : ionosph. refracton -C CAP_CLK 6 (64) : clock correction -C CAP_POL 8 (256): polarisation -C CAP_FAR 9 (512): Faraday rotation -C CAP_SHF 10 (1024): shift -C CAP_MOD 12 (4096): model -C CAP_AIF 13 (8192): ifr corrections -C CAP_MIF 14 (16384): mult. ifr corrections -C -C The scan header SCH, the data -C weight WGT and the complex data CDAT are -C returned for all four polarisations. -C If unknown scan .FALSE. returned. -C If data is flagged, CDAT set to zero -C NSCSCF_L = NSCSCF( FCA_J:I, STH_B(0:*):I, IFRT_I(0:*):I, SCN_J:I, -C CAP_J:I, CDAP_J:I, SCH_B(0:*):O, -C WGT_E(0:*,0:3), CDAT_X(0:*,0:3), FLG_J(0:*,0:3):O) -C As NSCSCR, but FLG returns the flag/weight -C words, WGT and CDAT the (converted) weights -C and data regardless of flag settings. -C -C NSCSCH_L = NSCSCH( FCA_J:I, STH_B(0:*):I, IFRT_I(0:*):I, SCN_J:I, -C CAP_J:I, CDAP_J:I, SCH_B(0:*):O) -C Read the scan header only. IFRT, CAP and -C CDAP are not used. -C NSCSCT_L = NSCSCT( FCA_J:I, STH_B(0:*):I, IFRT_I(0:*):I, SCN_J:I, -C CAP_J:I, CDAP_J:I, SCH_B(0:*):O, -C TCOR_X(0:*,0:1):O, TMU_E:O) -C Read scan header and give telescope -C corrections in TCOR, and the m.e. in TMU -C (<0 for deleted scan). -C NSCSCX_L = NSCSCX( FCA_J:I, STH_B(0:*):I, IFRT_I(0:*):I, SCN_J:I, -C CAP_J:I, CDAP_J:I, SCH_B(0:*):O, -C TCOR_X(0:*,0:1):O, IMCOR_X(0:3,*,0:1):O, -C FACOR_E(2,2):O, PLCOR_X(0:*,0:1)) -C Read scan header and give telescope -C corrections in TCOR, multiplicative -C ifr errors in IMCOR, Faraday corrections in -C FACOR, pol corrections in PLCOR -C (<0 for deleted scan). -C NSCSCY_L = NSCSCY( FCA_J:I, STH_B(0:*):I, IFRT_I(0:*):I, SCN_J:I, -C CAP_J:I, CDAP_J:I, SCH_B(0:*):O, -C TCOR_X(0:*,0:1):O, IMCOR_X(0:3,*,0:1):O, -C FACOR_E(2,2):O, PLCOR_X(0:*,0:1). IACOR_X(0:3,*,0:1):O) -C Read scan header and give telescope -C corrections in TCOR, multiplicative -C ifr errors in IMCOR, Faraday corrections in -C FACOR, pol corrections in PLCOR, additive -C ifr corrections in IACOR -C (<0 for deleted scan). -C NSCSCM_L = NSCSCM( FCA_J:I, STH_B(0:*):I, IFRT_I(0:*):I, SCN_J:I, -C CAP_J:I, CDAP_J:I, SCH_B(0:*):O, -C WGT_E(0:*,0:3):O, CDAT_X(0:*,0:3)) -C Read scan header, and give saved model -C back in CDAT. -C NSCSCI_L = NSCSCI( FCA_J:I, STH_B(0:*):I, IFRT_I(0:*):I, SCN_J:I, -C CAP_J:I, CDAP_J:I, SCH_B(0:*):O, -C WGT_E(0:*,0:3):O, CDAT_X(0:*,0:3)) -C Return all applied/de-applied corrections in -C CDAT. Basically assuming (I,Q,U,V)=(1,0,0,0). -C -C Include files: -C - INCLUDE 'WNG_DEF' - INCLUDE 'CBITS_DEF' - INCLUDE 'SCW_O_DEF' !SC BLOCK - INCLUDE 'STH_O_DEF' !SET HEADER - INCLUDE 'SCH_O_DEF' !SCAN HEADER -C -C Entry points: -C - LOGICAL NSCSCF !READ DATA AND FLAGS - LOGICAL NSCSCH !READ SCAN HEADER - LOGICAL NSCSCW !WRITE SCAN HEADER - LOGICAL NSCSCT !READ SCAN HEADER, TELESCOPE ERRORS - LOGICAL NSCSCX !READ SCAN HEADER, ERRORS - LOGICAL NSCSCY !READ SCAN HEADER, ERRORS - LOGICAL NSCSCM !READ SCAN MODEL - LOGICAL NSCSCI !READ IFR BASED CORRECTIONS -C -C Parameters: -C - REAL THDR !2*SCALE HEIGHT/RADIUS EARTH - PARAMETER (THDR=8./6378.16) - REAL RDH !RADIUS EARTH/SCALE HEIGHT - PARAMETER (RDH=2./THDR) -C -C Arguments: -C - INTEGER FCA !FILE CONTROL AREA - BYTE STH(0:*) !CURRENT SET HEADER - INTEGER*2 IFRT(0:*) !INTERFEROMETER TABLE - INTEGER SCN !SCAN TO DO - INTEGER CAP !APPLY CORRECTIONS - INTEGER CDAP !DE-APPLY CORRECTIONS - BYTE SCH(0:*) !SCAN HEADER - REAL WGT(0:STHIFR-1,0:3) !DATA WEIGHT IFR XX,XY,YX,YY - INTEGER FLG(0:STHIFR-1,0:3) !DATA WEIGHT/FLAGS IFR XX,XY,YX,YY - COMPLEX CDAT(0:STHIFR-1,0:3) !DATA C,S IFR XX,XY,YX,YY - COMPLEX TCOR(0:STHTEL-1,0:1) !TEL. CORR. TEL X,Y - COMPLEX IMCOR(0:3,0:STHIFR-1,0:1) !MUL IFR CORR POL, IFR, APPLY/DE-AP - COMPLEX IACOR(0:3,0:STHIFR-1,0:1) !ADD IFR CORR POL, IFR, APPLY/DE-AP - REAL FACOR(2,2) !FARADAY ROTATION - COMPLEX PLCOR(0:STHTEL-1,0:1) !POL CORR TEL, X/Y - REAL TMU !CORR. M.E. (OR <0) -C -C Function references: -C - LOGICAL WNFRD !READ DATA - LOGICAL WNFWR !WRITE DATA - INTEGER WNGARA !ADDRESS OF VARIABLE - LOGICAL NSCSIA !CALCULATE DIPOLE ANGLE INFO -C -C Data declarations: -C - INTEGER STHP,STHPI,STHPJ,STHPE,STHPD !SET HEADER POINTER - INTEGER SCHP,SCHPJ,SCHPE !SCAN HEADER POINTER - INTEGER LCAP,LCDAP !LOCAL APPLY, DE-APPLY - INTEGER TW(0:STHIFR-1) !TELESCOPE INFO - INTEGER TE(0:STHIFR-1) - INTEGER IFRA(0:1,0:STHIFR-1) !ALTERNATE INTERFEROMETER SELECTOR - REAL ANG(0:2,0:STHIFR-1) !DIPOLE ANGLE INFO - REAL LWGT(0:STHIFR-1,0:3) !LOCAL COPY DATA WEIGHT IFR XX,XY,YX,YY - INTEGER OWGT(0:STHIFR-1) !STOKES CONVERSION SUCCESS - INTEGER NIFR !FOR COMPILER BUG - REAL SLAT,CLAT !SIN, COS OF LAT. - INTEGER UFL !UN-FLAG DATA - REAL RE,RR,RE1,RR1 !EXTINCTION, REFRACTION - REAL RC,RC1 !CLOCK CORRECTION - REAL RI,RI1 !IONOSPH. REFRACTION - REAL RS,RS1 !FIELD SHIFT - REAL UV0(0:3) !UV FOR 1M BASELINE - COMPLEX CI !DATA POINT I - COMPLEX CQR - REAL ROT(2,2) !ROTATION MATRIX - COMPLEX XMOD(0:3,0:STHIFR-1) !MODEL - COMPLEX FMOD(0:3,0:STHIFR-1) !MODEL FOR FARADAY ROTATION - COMPLEX XPOL(0:STHTEL-1,0:1) !POL. - COMPLEX XMIFR(0:3,0:STHIFR-1,0:1) !MIFR CORRECTIONS APPLY,DE-APPLY - COMPLEX XAIFR(0:3,0:STHIFR-1,0:1) !AIFR CORRECTIONS APPLY,DE-APPLY - COMPLEX CTCOR(0:STHTEL-1,0:1) !TEL. CORR. TEL X,Y - COMPLEX SHCOR(0:STHTEL-1) !TEL. SHIFT CORRECTIONS - REAL XTMU !M.E. TEL. CORR. - INTEGER*2 LDAT(0:2,0:4*STHIFR-1) !DATA BUFFER - COMPLEX FDAT(0:STHIFR-1,0:3) !DATA C,S IFR XX,XY,YX,YY FARADAY - INTEGER PLC(4,0:3) !POLARISATION OFFSETS INPUT - DATA PLC/0,0,0,0,-1,-1,-1,1,-1,-1,-1,2,-1,1,1,3/ - INTEGER CPLC(0:3,0:1) !X,Y IDENTIFIERS - DATA CPLC/0,0,1,1,0,1,0,1/ - LOGICAL DODAT !SWITCH HEADER OR DATA - LOGICAL DOFLG !SWITCH RETURN FLAGS OR NOT - LOGICAL DOCOR !SWITCH CORRECTIONS OR NOT - LOGICAL DOXCOR,DOYCOR !SWITCH EXTENDED CORRECTIONS OR NOT - LOGICAL DOMOD !SWITCH MODEL - LOGICAL DOIFR !SWITCH IFR CORRECTIONS - REAL SCWE(0:2*STHTEL-1) !TSYS FROM SC BLOCK - REAL R2 -C- -C -C INIT NSCSCR -C - NSCSCR=.TRUE. !ASSUME OK - DODAT=.TRUE. !READ DATA - DOFLG=.FALSE. !NO FLAGS RETURNED - DOCOR=.FALSE. !NO CORRECTIONS - DOXCOR=.FALSE. !NO EXTENDED COR - DOMOD=.FALSE. - DOIFR=.FALSE. - LCAP=CAP !APPLY - LCDAP=CDAP !DE-APPLY - GOTO 10 -C -C NSCSCF -C - ENTRY NSCSCF(FCA,STH,IFRT,SCN,CAP,CDAP,SCH,WGT,CDAT,FLG) -C - NSCSCF=.TRUE. !ASSUME OK - DODAT=.TRUE. !READ DATA - DOFLG=.TRUE. !FLAGS RETURNED - DOCOR=.FALSE. !NO CORRECTIONS - DOXCOR=.FALSE. !NO EXTENDED COR - DOMOD=.FALSE. - DOIFR=.FALSE. - LCAP=CAP !APPLY - LCDAP=CDAP !DE-APPLY - GOTO 10 -C -C NSCSCH -C - ENTRY NSCSCH(FCA,STH,IFRT,SCN,CAP,CDAP,SCH) -C - NSCSCH=.TRUE. !ASSUME OK - DODAT=.FALSE. - DOFLG=.FALSE. !NO FLAGS RETURNED - DOCOR=.FALSE. - DOXCOR=.FALSE. !NO EXTENDED COR - DOMOD=.FALSE. - DOIFR=.FALSE. - LCAP=0 !APPLY - LCDAP=0 !DE-APPLY - GOTO 10 -C -C NSCSCT -C - ENTRY NSCSCT(FCA,STH,IFRT,SCN,CAP,CDAP,SCH,TCOR,TMU) -C - NSCSCT=.TRUE. !ASSUME OK - DODAT=.FALSE. - DOFLG=.FALSE. !NO FLAGS RETURNED - DOCOR=.TRUE. - DOXCOR=.FALSE. !NO EXTENDED COR - DOMOD=.FALSE. - DOIFR=.FALSE. - LCAP=IAND(CAP,CAP_RED+CAP_ALG+CAP_OTH) !APPLY - LCDAP=IAND(CDAP,CAP_OTH) !DE-APPLY - GOTO 10 -C -C NSCSCX -C - ENTRY NSCSCX(FCA,STH,IFRT,SCN,CAP,CDAP,SCH,TCOR, - 1 IMCOR,FACOR,PLCOR) -C - NSCSCT=.TRUE. !ASSUME OK - DODAT=.FALSE. - DOFLG=.FALSE. !NO FLAGS RETURNED - DOCOR=.TRUE. - DOXCOR=.TRUE. !EXTENDED CORR - DOYCOR=.FALSE. - DOMOD=.FALSE. - DOIFR=.FALSE. - LCAP=CAP !APPLY - LCDAP=CDAP !DE-APPLY - GOTO 10 -C -C NSCSCY -C - ENTRY NSCSCY(FCA,STH,IFRT,SCN,CAP,CDAP,SCH,TCOR, - 1 IMCOR,FACOR,PLCOR,IACOR) -C - NSCSCT=.TRUE. !ASSUME OK - DODAT=.FALSE. - DOFLG=.FALSE. !NO FLAGS RETURNED - DOCOR=.TRUE. - DOXCOR=.TRUE. !EXTENDED CORR - DOYCOR=.TRUE. - DOMOD=.FALSE. - DOIFR=.FALSE. - LCAP=CAP !APPLY - LCDAP=CDAP !DE-APPLY - GOTO 10 -C -C NSCSCM -C - ENTRY NSCSCM(FCA,STH,IFRT,SCN,CAP,CDAP,SCH,WGT,CDAT) -C - NSCSCM=.TRUE. !ASSUME OK - DODAT=.FALSE. - DOFLG=.FALSE. !NO FLAGS RETURNED - DOCOR=.FALSE. - DOXCOR=.FALSE. !NO EXTENDED COR - DOMOD=.TRUE. - DOIFR=.FALSE. - LCAP=0 !APPLY - LCDAP=CAP_MOD !DE-APPLY - GOTO 10 -C -C NSCSCI -C - ENTRY NSCSCI(FCA,STH,IFRT,SCN,CAP,CDAP,SCH,WGT,CDAT) -C - NSCSCI=.TRUE. !ASSUME OK - DODAT=.FALSE. - DOFLG=.FALSE. !NO FLAGS RETURNED - DOCOR=.FALSE. - DOXCOR=.FALSE. !NO EXTENDED COR - DOMOD=.FALSE. - DOIFR=.TRUE. - LCAP=CAP !APPLY - LCDAP=CDAP !DE-APPLY - GOTO 10 -C -C INIT -C - 10 CONTINUE - STHP=WNGARA(STH(0)) !ADDRESS SET HEADER - STHPI=(STHP-A_OB)/LB_I - STHPJ=(STHP-A_OB)/LB_J - STHPE=(STHP-A_OB)/LB_E - STHPD=(STHP-A_OB)/LB_D - NIFR=A_J(STHPJ+STH_NIFR_J) - SCHP=WNGARA(SCH(0)) !ADDRESS SCAN HEADER - SCHPJ=(SCHP-A_OB)/LB_J - SCHPE=(SCHP-A_OB)/LB_E - IF (SCN.LT.0 .OR. SCN.GE.A_J(STHPJ+STH_SCN_J)) GOTO 900 !UNKNOWN SCAN - IF (A_J(STHPJ+STH_INST_J).EQ.1) THEN !AT - SLAT=SLATA !SIN(LAT) - CLAT=CLATA - ELSE !WSRT - SLAT=SLATW - CLAT=CLATW - END IF - CALL WNDDUF(UFL) !GET BITS TO UNFLAG - UFL=IAND(FL_ALL,NOT(UFL)) !SELECT THE BITS - I=A_J(STHPJ+STH_SCNL_J) !LENGTH SCAN - J=A_J(STHPJ+STH_SCNP_J)+SCN*I !POINTER TO SCAN -C -C READ A SCAN -C - IF (.NOT.WNFRD(FCA,SCHHDL,SCH,J)) GOTO 900 !READ SCAN HEADER - IF (IAND(A_J(SCHPJ+SCH_BITS_J),UFL).NE.0 .AND. - 1 .NOT.DOFLG .AND. .NOT.DOMOD) GOTO 910 !SCAN DELETED -C -C READ DATA -C - I0=A_I(STHPI+STH_PLN_I) !# OF POL. IN INPUT - IF (DODAT) THEN - IF (.NOT.WNFRD(FCA,I-SCHHDL,LDAT,J+SCHHDL)) GOTO 900 !READ SCAN DATA - J0=0 !COUNT DATA POINTS - DO I=0,3 !ALL POLARISATIONS - I1=PLC(I0,I) !OFFSET IN INPUT LINE - IF (I1.LT.0) THEN !NOT PRESENT - DO I3=0,NIFR-1 - IF (DOFLG) FLG(I3,I)=0 - WGT(I3,I)=0 - CDAT(I3,I)=0 - END DO - ELSE - DO I3=0,NIFR-1 !ALL IFRS - I4=I0*I3+I1 !POINT TO INPUT - I5=LDAT(0,I4) !FLAGS/WEIGHT - IF (DOFLG) FLG(I3,I)=I5 !SAVE FLAGS/WEIGHT - WGT(I3,I)=IAND(I5,'000000ff'X)* - 1 (1.-A_E(STHPE+STH_WFAC_E)) !WEIGHT - IF (.NOT.DOFLG.AND.IAND(I5,UFL).NE.0) THEN !DELETED - WGT(I3,I)=0 - CDAT(I3,I)=0 - ELSE - CDAT(I3,I)=(A_E(SCHPE+SCH_SCAL_E)+1.)* - 1 CMPLX(LDAT(1,I4),LDAT(2,I4)) !COS, SIN - IF (ABS(CDAT(I3,I)).EQ.0) THEN !DELETE 0 DATA - WGT(I3,I)=0 - ELSE - J0=J0+1 !COUNT DATA - END IF - END IF - END DO !END IFRS - END IF - END DO !END POL. -C - IF (J0.LE.0) GOTO 910 !NO DATA IN SCAN - END IF -C - IF (DOIFR) THEN !SET DUMMY DATA - DO I=0,NIFR-1 !ALL IFRS - CDAT(I,0)=CMPLX(1.,0.) - CDAT(I,1)=CMPLX(0.,0.) - CDAT(I,2)=CMPLX(0.,0.) - CDAT(I,3)=CMPLX(1.,0.) - DO I1=0,3 - WGT(I,I1)=1 - END DO - END DO - END IF -C -C GET TELESCOPE DATA -C - IF (DODAT .OR. DOIFR) THEN - DO I=0,NIFR-1 !ALL IFRS - TW(I)=MOD(IFRT(I),256) !TELESCOPES - TE(I)=IFRT(I)/256 - END DO - END IF -C -C CORRECT ACORM=0 DATA -C - IF (DODAT) THEN !DATA ASKED - IF (A_J(STHPJ+STH_ACORM_J).EQ.1) THEN !ACORM=0 - IF (A_J(STHPJ+STH_SCP_J).NE.0 .AND. - 1 A_J(STHPJ+STH_NSC_J).GE.SCW_RGAINI_1) THEN !SC PRESENT - IF (.NOT.WNFRD(FCA,2*STHTEL*LB_E,SCWE, - 1 A_J(STHPJ+STH_SCP_J)+SCW_TSYSI_1)) GOTO 900 !READ SC - ELSE - DO I=0,2*STHTEL-1 !SET DEFAULT 40K - SCWE(I)=40. - END DO - END IF - DO I=0,NIFR-1 !ALL IFRS - DO I1=0,3 !ALL POLS - IF (WGT(I,I1).NE.0) THEN !DATA PRESENT - R0=200.*BKJY/500.* !K/AEFF (W.U.) - 1 SQRT(SCWE(2*TW(I)+I1/2)*SCWE(2*TE(I)+MOD(I1,2))) !W.U. - IF (ABS(REAL(CDAT(I,I1))).LE.32767 .AND. - 1 ABS(AIMAG(CDAT(I,I1))).LE.32767) THEN - R1=REAL(CDAT(I,I1)) - R1=R0*R1/(32768.-ABS(R1)) - R2=AIMAG(CDAT(I,I1)) - R2=R0*R2/(32768.-ABS(R2)) - CDAT(I,I1)=CMPLX(R1,R2) - ELSE - CDAT(I,I1)=0 - WGT(I,I1)=0 - END IF - END IF !DATA PRESENT - END DO !POL - END DO !IFRS - END IF !ACORM=0 - END IF !DATA ASKED -C -C GET DATA CORRECTIONS -C - IF (IAND(IOR(LCAP,LCDAP), - 1 CAP_TELMSK+CAP_POLMSK+CAP_IFRMSK).NE.0) THEN !CORRECTIONS ASKED - JS=NSCSIA(0,STH,IFRT,IFRA,ANG) !GET DIPOLE ANGLES -C -C EXTINCTION/REFRACTION CONSTANTS -C - IF (IAND(IOR(LCAP,LCDAP),CAP_XTN+CAP_REF).NE.0) THEN - R0=SIN(A_D(STHPD+STH_DEC_D)*DPI2)*SLAT+ - 1 COS(A_D(STHPD+STH_DEC_D)*DPI2)*CLAT* - 1 COS(A_E(SCHPE+SCH_HA_E)*PI2) !COS(Z) - R1=SQRT(R0*R0+THDR) !ATMOSPHERE THICKNESS - RE=A_E(SCHPE+SCH_EXT_E)*RDH*(R1-R0) !EXTINCTION CORRECTION - RE=.5*LOG(1+RE) - RE1=A_E(SCHPE+SCH_AEXT_E)*RDH*(R1-R0) !EXTINCTION DE-CORRECTION - RE1=.5*LOG(1+RE1) - RR=A_D(STHPD+STH_FRQ_D)*A_E(SCHPE+SCH_REFR_E)* - 1 COS(A_D(STHPD+STH_DEC_D)*DPI2)* - 1 SIN(A_E(SCHPE+SCH_HA_E)*PI2)* - 1 (1-R0/R1)/(CL*1E-6) !REFRACTION PER METER - RR1=A_D(STHPD+STH_FRQ_D)*A_E(SCHPE+SCH_AREFR_E)* - 1 COS(A_D(STHPD+STH_DEC_D)*DPI2)* - 1 SIN(A_E(SCHPE+SCH_HA_E)*PI2)* - 1 (1-R0/R1)/(CL*1E-6) !DE-REFRACTION PER METER - END IF -C -C IONOSPHERIC REFRACTION -C - IF (IAND(IOR(LCAP,LCDAP),CAP_IRE).NE.0) THEN - RI=PI2*A_E(SCHPE+SCH_IREF_E)/1000 !IONOSPH. REFRACTION PER M - RI1=PI2*A_E(SCHPE+SCH_AIREF_E)/1000 !IONOSPH. DE-REFRACTION PER M - END IF -C -C CLOCK CORRECTION -C - IF (IAND(IOR(LCAP,LCDAP),CAP_CLK).NE.0) THEN - RC=-A_E(SCHPE+SCH_CLKC_E)/240/DEG* !sec --> geom. radians - 1 A_D(STHPD+STH_FRQ_D)/(CL*1E-6)* ! --> lambda or circles - 1 PI2* ! --> electric radians - 1 COS(A_D(STHPD+STH_DEC_D)*DPI2)* - 1 COS(A_E(SCHPE+SCH_HA_E)*PI2) !CLOCK CORR. IN rad/M - RC1=-A_E(SCHPE+SCH_ACLKC_E)/240/DEG* - 1 PI2*A_D(STHPD+STH_FRQ_D)/(CL*1E-6)* - 1 COS(A_D(STHPD+STH_DEC_D)*DPI2)* - 1 COS(A_E(SCHPE+SCH_HA_E)*PI2) !CLOCK DE-CORR. - END IF -C -C SHIFT -C - IF (IAND(IOR(LCAP,LCDAP),CAP_SHF).NE.0) THEN - CALL NMOMUV(0,0D0,0D0,STH,SCH,UV0) !GET UV COORDINATES - DO I=0,1 - UV0(2+I)=-1./(3600.*DEG)*UV0(I)* - 1 (A_E(STHPE+STH_SHFT_E+I)+ - 1 A_E(STHPE+STH_DSHFT_E+I)* - 1 (A_E(SCHPE+SCH_HA_E)-A_E(STHPE+STH_HAB_E))) - END DO - RS1=UV0(2)+UV0(3) !SHIFT PER M - DO I=0,1 - UV0(2+I)=-1./(3600.*DEG)* - 1 A_E(STHPE+STH_ASHFT_E+I)*UV0(I) - END DO - RS=UV0(2)+UV0(3) !SHIFT PER M - END IF -C -C FARADAY DATA -C - IF ((IAND(IOR(LCAP,LCDAP),CAP_FAR).NE.0) .AND. - 1 (A_E(SCHPE+SCH_FARAD_E).NE.0 .OR. - 1 A_E(SCHPE+SCH_AFARAD_E).NE.0)) THEN !DO - ROT(1,1)=COS(2*(A_E(SCHPE+SCH_FARAD_E)- - 1 A_E(SCHPE+SCH_AFARAD_E))) !ROTATION MATRIX - ROT(1,2)=-SIN(2*(A_E(SCHPE+SCH_FARAD_E)- - 1 A_E(SCHPE+SCH_AFARAD_E))) - ROT(2,1)=-ROT(1,2) - ROT(2,2)=ROT(1,1) - END IF -C -C POLARISATION DATA -C - IF (IAND(LCAP,CAP_POL).NE.0) THEN !CORRECTION ASKED - DO I=0,1 !XY/YX - DO I1=0,STHTEL-1 !ALL TEL. - I3=2*STHTEL*I+2*I1 - XPOL(I1,I)=CMPLX(A_E(STHPE+STH_POLC_E+I3), - 1 -A_E(STHPE+STH_POLC_E+I3+1)) - END DO - END DO - END IF -C -C GET MODEL DATA -C - IF ((DODAT.OR.DOMOD) .AND. IAND(LCDAP,CAP_MOD).NE.0 .AND. - 1 A_J(STHPJ+STH_MDD_J).NE.0) THEN !WANTED AND PRESENT - J0=A_J(STHPJ+STH_MDD_J)+SCN*4*LB_X*NIFR !POINTER - IF (.NOT.WNFRD(FCA,4*NIFR*LB_X, - 1 XMOD,J0)) GOTO 900 !READ MODEL DATA - END IF -C -C GET MIFR DATA -C - DO I1=0,1 !APPLY/DE-APPLY - J0=0 !ASSUME NOT - IF (I1.EQ.0 .AND. IAND(LCAP,CAP_MIF).NE.0 .AND. - 1 A_J(SCHPJ+SCH_IFRMC_J).NE.0) THEN !WANTED AND PRESENT - J0=A_J(SCHPJ+SCH_IFRMC_J) !POINTER - ELSE IF (I1.EQ.1 .AND. IAND(LCDAP,CAP_MIF).NE.0 .AND. - 1 A_J(SCHPJ+SCH_AIFRMC_J).NE.0) THEN !WANTED AND PRESENT - J0=A_J(SCHPJ+SCH_AIFRMC_J) !POINTER - END IF - IF (J0.NE.0) THEN !DO - IF (.NOT.WNFRD(FCA,4*NIFR*LB_X, - 1 XMIFR(0,0,I1),J0)) GOTO 900 !READ MIFR DATA - END IF - END DO -C -C GET AIFR DATA -C - DO I1=0,1 !APPLY/DE-APPLY - J0=0 !ASSUME NOT - IF (I1.EQ.0 .AND. IAND(LCAP,CAP_AIF).NE.0 .AND. - 1 A_J(SCHPJ+SCH_IFRAC_J).NE.0) THEN !WANTED AND PRESENT - J0=A_J(SCHPJ+SCH_IFRAC_J) !POINTER - ELSE IF (I1.EQ.1 .AND. IAND(LCDAP,CAP_AIF).NE.0 .AND. - 1 A_J(SCHPJ+SCH_AIFRAC_J).NE.0) THEN !WANTED AND PRESENT - J0=A_J(SCHPJ+SCH_AIFRAC_J) !POINTER - END IF - IF (J0.NE.0) THEN !DO - IF (.NOT.WNFRD(FCA,4*NIFR*LB_X, - 1 XAIFR(0,0,I1),J0)) GOTO 900 !READ AIFR DATA - END IF - END DO -C -C TEL. CORRECTIONS -C - XTMU=0 !M.E. - IF (IAND(IOR(LCAP,LCDAP),CAP_TELMSK).NE.0) THEN !WANTED - DO I=0,1 !X,Y - DO I1=0,STHTEL-1 !TEL. - I3=2*STHTEL*I+2*I1 !CORR. POINTER - R0=0 !GAIN - R1=0 !PHASE - IF (IAND(LCAP,CAP_RED).NE.0) THEN !REDUNDANCY ASKED - R0=R0+A_E(SCHPE+SCH_REDC_E+I3+0) !GAIN - R1=R1+A_E(SCHPE+SCH_REDC_E+I3+1) !PHASE - END IF - IF (IAND(LCAP,CAP_ALG).NE.0) THEN !ALIGN ASKED - R0=R0+A_E(SCHPE+SCH_ALGC_E+I3+0) !GAIN - R1=R1+A_E(SCHPE+SCH_ALGC_E+I3+1) !PHASE - END IF - IF (IAND(LCAP,CAP_OTH).NE.0) THEN !OTHERS ASKED - R0=R0+A_E(SCHPE+SCH_OTHC_E+I3+0) !GAIN - R1=R1+A_E(SCHPE+SCH_OTHC_E+I3+1) !PHASE - END IF - IF (IAND(LCAP,CAP_XTN).NE.0) THEN !EXTINCTION ASKED - R0=R0+RE !GAIN - END IF - IF (IAND(LCAP,CAP_REF).NE.0) THEN !REFRACTION ASKED - R1=R1-RR*A_E(STHPE+STH_RTP_E+I1) !PHASE - END IF - IF (IAND(LCAP,CAP_IRE).NE.0) THEN !IONOSPH. REFR. ASKED - R1=R1-RI*A_E(STHPE+STH_RTP_E+I1) !PHASE - END IF - IF (IAND(LCAP,CAP_CLK).NE.0) THEN !CLOCK CORR. ASKED - R1=R1-RC*A_E(STHPE+STH_RTP_E+I1) !PHASE - END IF - IF (IAND(LCAP,CAP_SHF).NE.0) THEN !ASHIFT ASKED - R1=R1-RS*A_E(STHPE+STH_RTP_E+I1) !PHASE - END IF - IF (IAND(LCDAP,CAP_OTH).NE.0 .OR. - 1 A_J(SCHPJ+SCH_AOTHUSED_J).EQ.1) THEN !OTHERS DE-APPLY - R0=R0-A_E(SCHPE+SCH_AOTHC_E+I3+0) !GAIN - R1=R1-A_E(SCHPE+SCH_AOTHC_E+I3+1) !PHASE - END IF - IF (IAND(LCDAP,CAP_XTN).NE.0) THEN !EXTINCTION DE-APPLY - R0=R0-RE1 !GAIN - END IF - IF (IAND(LCDAP,CAP_REF).NE.0) THEN !REFRACTION DE-APPLY - R1=R1+RR1*A_E(STHPE+STH_RTP_E+I1) - END IF - IF (IAND(LCDAP,CAP_IRE).NE.0) THEN !IONOSPH. REFR. DE-APPLY - R1=R1+RI1*A_E(STHPE+STH_RTP_E+I1) !PHASE - END IF - IF (IAND(LCDAP,CAP_CLK).NE.0) THEN !CLOCK CORR. DE-APPLY - R1=R1+RC1*A_E(STHPE+STH_RTP_E+I1) !PHASE - END IF - IF (IAND(LCDAP,CAP_SHF).NE.0) THEN !SHIFT DE-APPLY - R1=R1+RS1*A_E(STHPE+STH_RTP_E+I1) !PHASE - SHCOR(I1)=CMPLX(0.,RS1*A_E(STHPE+STH_RTP_E+I1)) !FOR MODEL - END IF - CTCOR(I1,I)=CMPLX(R0,R1) !SET GAIN/PHASE ERROR - END DO -C -C M.E. -C - IF (DOCOR .AND. .NOT.DOXCOR) THEN !M.E. WANTED - IF (IAND(LCAP,CAP_RED).NE.0) THEN - XTMU=XTMU+(A_E(SCHPE+SCH_REDNS_E+2*I+0)**2+ - 1 A_E(SCHPE+SCH_REDNS_E+2*I+1)**2)/2. !TOTAL M.E. - END IF - IF (IAND(LCAP,CAP_ALG).NE.0) THEN - XTMU=XTMU+(A_E(SCHPE+SCH_ALGNS_E+2*I+0)**2+ - 1 A_E(SCHPE+SCH_ALGNS_E+2*I+1)**2)/2. !TOTAL M.E. - END IF - IF (IAND(LCAP,CAP_OTH).NE.0) THEN - XTMU=XTMU+(A_E(SCHPE+SCH_OTHNS_E+2*I+0)**2+ - 1 A_E(SCHPE+SCH_OTHNS_E+2*I+1)**2)/2. !TOTAL M.E. - END IF - END IF - END DO - XTMU=SQRT(XTMU) !SET M.E. - END IF -C -C END GET CORRECTION DATA -C - END IF -C -C SAVE CORRECTIONS -C - IF (IAND(IOR(LCAP,LCDAP), - 1 CAP_TELMSK+CAP_POLMSK+CAP_IFRMSK).NE.0 .AND. - 1 DOCOR) THEN !CORRECTIONS ASKED - DO I=0,1 !X,Y - DO I1=0,STHTEL-1 !TEL - TCOR(I1,I)=CTCOR(I1,I) !RETURN CORRECTIONS - END DO - END DO - IF (.NOT.DOXCOR) TMU=XTMU !SET MEAN ERROR - ELSE IF (DOCOR .AND. .NOT.DOXCOR) THEN !RETURN ZERO - GOTO 910 !CLEAR - ELSE IF (DOCOR) THEN - DO I=0,1 !X,Y - DO I1=0,STHTEL-1 !TEL - TCOR(I1,I)=0 !RETURN CORRECTIONS - END DO - END DO - END IF -C - IF (DOCOR .AND. DOXCOR) THEN !EXTRA CORRECTIONS - IF (IAND(LCAP,CAP_MIF).NE.0 .AND. - 1 A_J(SCHPJ+SCH_IFRMC_J).NE.0) THEN !WANTED AND PRESENT - DO I=0,NIFR-1 - DO I1=0,3 - IMCOR(I1,I,0)=XMIFR(I1,I,0) - END DO - END DO - ELSE - DO I=0,NIFR-1 - DO I1=0,3 - IMCOR(I1,I,0)=0 - END DO - END DO - END IF - IF (IAND(LCDAP,CAP_MIF).NE.0 .AND. - 1 A_J(SCHPJ+SCH_AIFRMC_J).NE.0) THEN !WANTED AND PRESENT - DO I=0,NIFR-1 - DO I1=0,3 - IMCOR(I1,I,1)=XMIFR(I1,I,1) - END DO - END DO - ELSE - DO I=0,NIFR-1 - DO I1=0,3 - IMCOR(I1,I,1)=0 - END DO - END DO - END IF - IF ((IAND(IOR(LCAP,LCDAP),CAP_FAR).NE.0) .AND. - 1 (A_E(SCHPE+SCH_FARAD_E).NE.0 .OR. - 1 A_E(SCHPE+SCH_AFARAD_E).NE.0)) THEN !DO - CALL WNGMV(4*LB_E,ROT,FACOR) - ELSE - FACOR(1,1)=1 - FACOR(1,2)=0 - FACOR(2,1)=0 - FACOR(2,2)=1 - END IF - IF (IAND(LCAP,CAP_POL).NE.0) THEN !CORRECTION ASKED - DO I=0,STHTEL-1 - DO I1=0,1 - PLCOR(I,I1)=XPOL(I,I1) - END DO - END DO - ELSE - DO I=0,STHTEL-1 - DO I1=0,1 - PLCOR(I,I1)=0 - END DO - END DO - END IF - IF (DOYCOR) THEN !AIFR ASKED - IF (IAND(LCAP,CAP_AIF).NE.0 .AND. - 1 A_J(SCHPJ+SCH_IFRAC_J).NE.0) THEN !WANTED AND PRESENT - DO I=0,NIFR-1 - DO I1=0,3 - IACOR(I1,I,0)=XAIFR(I1,I,0) - END DO - END DO - ELSE - DO I=0,NIFR-1 - DO I1=0,3 - IACOR(I1,I,0)=0 - END DO - END DO - END IF - IF (IAND(LCDAP,CAP_AIF).NE.0 .AND. - 1 A_J(SCHPJ+SCH_AIFRAC_J).NE.0) THEN !WANTED AND PRESENT - DO I=0,NIFR-1 - DO I1=0,3 - IACOR(I1,I,1)=XAIFR(I1,I,1) - END DO - END DO - ELSE - DO I=0,NIFR-1 - DO I1=0,3 - IACOR(I1,I,1)=0 - END DO - END DO - END IF - END IF - GOTO 920 - END IF -C - IF (DOMOD .AND. IAND(LCDAP,CAP_MOD).NE.0 .AND. - 1 A_J(STHPJ+STH_MDD_J).NE.0) THEN !WANTED AND PRESENT - CALL NMOCIX(STH,SCH,ANG,FDAT,XMOD) !CONVERT STOKES TO XYX - DO I=0,NIFR-1 !ALL IFRS - DO I1=0,3 - CDAT(I,I1)=-FDAT(I,I1) !SET MODEL AS XYX - END DO - END DO - ELSE IF (DOMOD) THEN !RETURN ZERO - GOTO 910 - END IF -C -C CORRECT DATA -C - IF (IAND(IOR(LCAP,LCDAP), - 1 CAP_TELMSK+CAP_POLMSK+CAP_IFRMSK).NE.0 .AND. - 1 (DODAT .OR. DOIFR)) THEN !DATA ASKED -C -C APPLY AIFR -C - IF (IAND(LCAP,CAP_AIF).NE.0 .AND. - 1 A_J(SCHPJ+SCH_IFRAC_J).NE.0) THEN !WANTED AND PRESENT - DO I=0,NIFR-1 !ALL IFRS - DO I1=0,3 !ALL POL. - IF (WGT(I,I1).NE.0) - 1 CDAT(I,I1)=CDAT(I,I1)-XAIFR(I1,I,0) - END DO - END DO - END IF -C -C CORRECT TEL. FACTORS -C - IF (IAND(IOR(LCAP,LCDAP),CAP_TELMSK).NE.0) THEN !WANTED - DO I=0,3 !ALL POL. - I1=CPLC(I,0) !X ID - I2=CPLC(I,1) !Y ID - DO I3=0,NIFR-1 !ALL IFRS - IF (WGT(I3,I).GT.0) THEN !DO - CI=CTCOR(TW(I3),I1)+CONJG(CTCOR(TE(I3),I2)) !TEL. CORRECTION - CDAT(I3,I)=CDAT(I3,I)*EXP(-CI) !CORRECT DATA POINT - END IF - END DO !IFRS - END DO !POL. - END IF -C -C CORRECT IFR. FACTORS -C - IF (IAND(LCAP,CAP_MIF).NE.0 .AND. - 1 A_J(SCHPJ+SCH_IFRMC_J).NE.0) THEN !WANTED AND PRESENT - DO I=0,3 !ALL POL. - DO I3=0,NIFR-1 !ALL IFRS - IF (WGT(I3,I).GT.0) THEN !DO - CI=XMIFR(I,I3,0) !IFR APPLY - CDAT(I3,I)=CDAT(I3,I)*EXP(-CI) !CORRECT DATA POINT - END IF - END DO !IFRS - END DO !POL. - END IF - IF (IAND(LCDAP,CAP_MIF).NE.0 .AND. - 1 A_J(SCHPJ+SCH_AIFRMC_J).NE.0) THEN !WANTED AND PRESENT - DO I=0,3 !ALL POL. - DO I3=0,NIFR-1 !ALL IFRS - IF (WGT(I3,I).GT.0) THEN !DO - CI=-XMIFR(I,I3,1) !IFR DE-APPLY - CDAT(I3,I)=CDAT(I3,I)*EXP(-CI) !CORRECT DATA POINT - END IF - END DO !IFRS - END DO !POL. - END IF -C -C DE-APPLY AIFR -C - IF (IAND(LCDAP,CAP_AIF).NE.0 .AND. - 1 A_J(SCHPJ+SCH_AIFRAC_J).NE.0) THEN !WANTED AND PRESENT - DO I=0,NIFR-1 !ALL IFRS - DO I1=0,3 !ALL POL. - IF (WGT(I,I1).NE.0) - 1 CDAT(I,I1)=CDAT(I,I1)+XAIFR(I1,I,1) - END DO - END DO - END IF -C -C POLARISATION CORRECTION -C - IF (IAND(LCAP,CAP_POL).NE.0) THEN !CORRECTION ASKED - DO I=1,2 !XY/YX - DO I3=0,NIFR-1 !ALL IFRS - IF (WGT(I3,I).GT.0 .AND. WGT(I3,0).GT.0 .AND. - 1 WGT(I3,3).GT.0) THEN !DO IF XX,YY,XY/YX - CI=(CDAT(I3,0)+CDAT(I3,3))/2. !I - CDAT(I3,I)=CDAT(I3,I)-CI*PI2* !CORRECT FOR POL. - 1 (XPOL(TW(I3),I-1)-CONJG(XPOL(TE(I3),2-I))) - END IF - END DO !IFRS - END DO !POL - END IF -C -C FARADAY ROTATION -C - IF ((IAND(IOR(LCAP,LCDAP),CAP_FAR).NE.0) .AND. - 1 (A_E(SCHPE+SCH_FARAD_E).NE.0 .OR. - 1 A_E(SCHPE+SCH_AFARAD_E).NE.0)) THEN !DO - CALL WNGMV(4*LB_E*STHIFR,WGT,LWGT) !MAKE LOCAL COPY WEIGHTS - DO I3=0,NIFR-1 !INITIALISE OWGT - OWGT(I3)=1 - END DO - CALL NMOCXI(STH,SCH,ANG,LWGT,OWGT,CDAT,FMOD) !MAKE STOKES - DO I3=0,NIFR-1 !ALL IFRS - IF (OWGT(I3).NE.0) THEN !Q,U PRESENT - CQR=FMOD(1,I3)*ROT(1,1)+FMOD(2,I3)*ROT(1,2) !ROTATE - FMOD(2,I3)=FMOD(1,I3)*ROT(2,1)+FMOD(2,I3)*ROT(2,2) - FMOD(1,I3)=CQR - END IF - END DO - CALL NMOCIX(STH,SCH,ANG,FDAT,FMOD) !CONVERT STOKES BACK - DO I3=0,NIFR-1 !RESET DATA - IF (OWGT(I3).NE.0) THEN !Q, U WERE MADE - DO I1=0,3 - CDAT(I3,I1)=FDAT(I3,I1) !SET ROTATED DATA - END DO - END IF - END DO - END IF -C -C MODEL -C - IF (DODAT .AND. IAND(LCDAP,CAP_MOD).NE.0 .AND. - 1 A_J(STHPJ+STH_MDD_J).NE.0) THEN !WANTED AND PRESENT - CALL NMOCIX(STH,SCH,ANG,FDAT,XMOD) !CONVERT STOKES TO XYX - DO I=0,NIFR-1 !ALL IFRS - IF (IAND(LCDAP,CAP_SHF).NE.0) THEN !SHIFT DE-APPLY - CI=SHCOR(TW(I))+CONJG(SHCOR(TE(I))) !SHIFT CORRECTION - CI=EXP(-CI) !FACTOR - DO I1=0,3 !SHIFT MODEL DATA - FDAT(I,I1)=FDAT(I,I1)*CI - END DO - END IF - DO I1=0,3 !SUBTRACT MODEL - IF (WGT(I,I1).NE.0) - 1 CDAT(I,I1)=CDAT(I,I1)-FDAT(I,I1) - END DO - END DO - END IF -C -C END CORRECTIONS -C - END IF -C - RETURN -C -C ERROR -C - 900 CONTINUE - NSCSCR=.FALSE. - 910 CONTINUE - IF (DODAT .OR. DOMOD) THEN !CLEAR DATA - DO I=0,3 !ALL POLARISATIONS - DO I3=0,NIFR-1 !ALL IFRS - IF (DODAT) WGT(I3,I)=0 !ZERO WEIGHT - CDAT(I3,I)=0 - END DO - END DO - END IF - IF (DOCOR) THEN !CLEAR CORRECTION - DO I=0,1 !POL. - DO I2=0,STHTEL-1 !TEL. - TCOR(I2,I)=0 - END DO - END DO - IF (.NOT.DOXCOR) TMU=-1 !SET DELETED - END IF - 920 CONTINUE -C - RETURN -C -C - END diff --git a/src/nscan/nscscw.for b/src/nscan/nscscw.for deleted file mode 100644 index 6b523ca0417231bf3eab4231e05d283a9f2cc512..0000000000000000000000000000000000000000 --- a/src/nscan/nscscw.for +++ /dev/null @@ -1,210 +0,0 @@ -C+ NSCSCW.FOR -C WNB 900306 -C -C Revisions: -C JPH 930901 Original split off from NSCSCR -C JPH 931006 Fix dimension of DAT (was W:C) -C JPH 940107 NSCSFW -C JPH 940218 FLW I*2 --> I*4 -C JPH 960124 Correct description: FLW_I --> FLW_J -C JPH 960604 Idem: SCH is input only for NSCSCW -C JPH 960617 Fix error in calculation of MAXD -C CMV 031125 Correction of bug in scaling -C - LOGICAL FUNCTION NSCSCW(FCA,STH0,IFRT,SCN,CAP,CDAP,SCHE) -C -C NSCSCW_L = NSCSCW( FCA_J:I, STH0_B(0:*):I, 0, SCN_J:I, -C 0, 0, SCH_B(0:*):I) -C Write the scan header only. The 0 arguments must be present but -C are not used -C -C NSCSDW_L = NSCSDW ( FCA_J:I, STH0_B(0:*):I, IFRT_I(0:*):I, SCN_J:I, -C 0, 0, SCH_B(0:*):IO, -C WGT_E(0:*,0:3):I, CDAT_X(0:*,0:3):I) -C Write scan number SCN to FCA, using the -C set header STH with interferometers IFRT. The scan header SCH, the data -C weight WGT and the complex data CDAT are given for all four polarisations. -C NSCSDW converts them to WCS triplets for the number of polarisations actually C present; the FLAGS are all nulled. The SCH field SCH_MAX is set. -C If SCN is outside range, nothing is done and .FALSE. returned. -C -C NSCSFW_L = NSCSFW ( FCA_J:I, STH0_B(0:*):I, IFRT_I(0:*):I, SCN_J:I, -C 0, 0, SCH_B(0:*):IO, -C WGT_E(0:*,0:3):I, CDAT_X(0:*,0:3):I,FLW_J(0:*,0:3):I ) -C As NSCSDW, but instead of using WGT copy FLW directly to flags/weight -C word in SCN file. WGT is used only in selecting points for calculating the -C maximum visibility value. -C -C -C Include files: -C - INCLUDE 'WNG_DEF' - INCLUDE 'STH_O_DEF' !SET HEADER - INCLUDE 'SCH_O_DEF' !SCAN HEADER -C -C Entry points: -C - LOGICAL NSCSDW, NSCSFW -C -C Parameters: -C - INTEGER X,Y,XX,XY,YX,YY,W,C,S - PARAMETER ( X=0,Y=1, - 1 XX=0,XY=1,YX=2,YY=3, - 1 W=0,C=1,S=2) -C -C Arguments: -C - INTEGER FCA !FILE CONTROL AREA - BYTE STH0(0:*) !CURRENT SET HEADER - INTEGER*2 IFRT(0:*) !INTERFEROMETER TABLE - INTEGER SCN !SCAN TO DO - INTEGER CAP !APPLY CORRECTIONS (not used) - INTEGER CDAP !DE-APPLY CORRECTIONS (not used) - REAL SCHE(0:*) !SCAN HEADER - REAL WGT(0:STHIFR-1,XX:YY) !WEIGHTS - REAL RDAT(C:S,0:STHIFR-1,XX:YY)!DATA - INTEGER FLW(0:STHIFR-1,XX:YY) !flags/weights (could be I*2!) -C NOTE: -C As long as only SCH E fields need to be addressed, we can use SCHE as a call -C argument. When other data types are also addressed, we should make a local -C copy as for STH. -C -C Function references: -C - LOGICAL WNFWR !WRITE DATA -C -C Data declarations: -C - INTEGER*2 DAT(W:S,0:4*STHIFR-1) !visibility write BUFFER: - !triplets of weight/flags, -C !loop indices: - INTEGER IPL !polarisation - INTEGER IFR !interferometer - INTEGER IPOL !polsn number in RDAT -C - INTEGER SCNP !scan pointer - INTEGER IOFS, INX !offset, index in STH, SCH -C - REAL MAXD - - BYTE STH(0:STHHDL-1) !SET HEADER - INTEGER STHJ(0:STHHDL/LB_J-1) - INTEGER*2 STHI(0:STHHDL/LB_I-1) - REAL STHE(0:STHHDL/LB_E-1) - REAL*8 STHD(0:STHHDL/LB_D-1) - EQUIVALENCE (STH,STHJ,STHI,STHE,STHD) - INTEGER NIFR - INTEGER PLN - INTEGER SCNL -C -CC BYTE SCH(0:SCHHDL-1) !SCAN HEADER -CC INTEGER SCHJ(0:SCHHDL/LB_J-1) -CC INTEGER*2 SCHI(0:SCHHDL/LB_J-1) -CC REAL SCHE(0:SCHHDL/LB_J-1) -CC EQUIVALENCE (SCH,SCHJ,SCHI,SCHE) -C - LOGICAL E_SCW, E_SDW, E_SFW !entry-point flags -C- -C -C NSCSCW -C - E_SCW=.TRUE. - E_SDW=.FALSE. - E_SFW=.FALSE. - GOTO 10 -C -C - ENTRY NSCSDW(FCA,STH0,IFRT,SCN,CAP,CDAP,SCHE,WGT,RDAT) -C - E_SCW=.FALSE. - E_SDW=.TRUE. - E_SFW=.FALSE. - GOTO 10 -C - ENTRY NSCSFW(FCA,STH0,IFRT,SCN,CAP,CDAP,SCHE,WGT,RDAT,FLW) -C - E_SCW=.FALSE. - E_SDW=.FALSE. - E_SFW=.TRUE. - GOTO 10 -C -C Common code -C -10 CONTINUE - NSCSCW=.TRUE. - CALL WNGMV (STHHDL,STH0,STH) !local copy of STH for simple - !addressing - IF (SCN.GE.0 .AND. - 1 SCN.LT.STHJ(STH_SCN_J)) THEN - SCNL=STHJ(STH_SCNL_J) !scan length - SCNP=STHJ(STH_SCNP_J)+SCN*SCNL !file addr. of scan - NSCSCW=WNFWR(FCA,SCHHDL,SCHE,SCNP) - ELSE - NSCSCW=.FALSE. !SCN outside range - ENDIF - IF (E_SCW) GOTO 990 !done for NSCSCW -C -C Write data - NSCSDW/NSCSFW only (code adapted from NSCSCR) -C - MAXD=-1E30 -C -C Make output scan data for PLN polsns from 4-polsn input -C - PLN=STHI(STH_PLN_I) !# of pol. in output - NIFR=STHJ(STH_NIFR_J) -C -C Get maximum and check the scale parameter to prevent out of range integers -C - DO IPL=0,PLN-1 !all output polsns - IPOL=IPL !XX[,XY,YX,YY] - IF (PLN.EQ.2) IPOL=3*IPL !XX,YY - DO IFR=0,NIFR-1 !all IFRs - IF (WGT(IFR,IPOL).NE.0) THEN - MAXD=MAX(MAXD,ABS(RDAT(C,IFR,IPOL))) - MAXD=MAX(MAXD,ABS(RDAT(S,IFR,IPOL))) - END IF - ENDDO !IFR - ENDDO !IPL - IF (MAXD/(SCHE(SCH_SCAL_E)+1.).GT.32760) THEN - SCHE(SCH_SCAL_E)=MAXD/32760.-1. - END IF - IF (MAXD.GT.0) THEN - SCHE(SCH_MAX_E)=MAXD - ELSE - CALL WNCTXT(F_TP,' Empty scan !UJ.',SCN); - END IF -C -C Copy weights and scaled data -C - DO IPL=0,PLN-1 !all output polsns - IPOL=IPL !XX[,XY,YX,YY] - IF (PLN.EQ.2) IPOL=3*IPL !XX,YY - DO IFR=0,NIFR-1 !all IFRs - IF (E_SDW) DAT(W,IFR*PLN+IPL)= !take WGT and scale - 1 WGT(IFR,IPOL)/(1.-STHE(STH_WFAC_E)) - IF (E_SFW) DAT(W,IFR*PLN+IPL)= !take FLW - 1 FLW(IFR,IPOL) - DAT(C,IFR*PLN+IPL)=RDAT(C,IFR,IPOL) - 1 /(SCHE(SCH_SCAL_E)+1.) - DAT(S,IFR*PLN+IPL)=RDAT(S,IFR,IPOL) - 1 /(SCHE(SCH_SCAL_E)+1.) - ENDDO !IFR - ENDDO !IPL -C -C Rewrite SCH, write data -C - IF (.NOT.WNFWR(FCA,SCHHDL,SCHE,SCNP)) GOTO 800 - IF (.NOT.WNFWR(FCA,PLN*3*LB_I*NIFR, - 1 DAT,SCNP+SCHHDL)) GOTO 800 - GOTO 990 !both writes succeeded - 800 CONTINUE - NSCSCW=.FALSE. - GOTO 990 -C -C Common exit. Return status is set before any branch to here is made -C -990 CONTINUE - RETURN -C -C - END diff --git a/src/nscan/nscsif.for b/src/nscan/nscsif.for deleted file mode 100644 index 0afcc362d04c1f126e06d0a22675f098ce3deb78..0000000000000000000000000000000000000000 --- a/src/nscan/nscsif.for +++ /dev/null @@ -1,100 +0,0 @@ -C+ NSCSIF.FOR -C WNB 910208 -C -C Revisions: -C WNB 930825 Add ANG -C WNB 940227 Add NSCSIA -C - LOGICAL FUNCTION NSCSIF(FCA,STHJ,IFRT,IFRA,ANG) -C -C Read interferometers for a set -C -C Result: -C -C NSCSIF_L = NSCSIF( FCA_J:I, STHJ_B(0:*):I, IFRT_I(0:*):O, -C IFRA_J(0:1,0:*):O, ANG_E(0:2,0:*):O) -C Read the interferometer table belonging to -C set with set header STH from file FCA into -C the interferometer table (west+256*east) IFRT. -C In addition fill IFRA array with west(0) and -C east(1), and ANG will be filled with -C parallactic angle X-dipole W telescope in -C circles(0); the sine of the E telescope X dipole -C offset from W X-dipole (1); and its cosine (2) -C NSCSIA_L = NSCSIA( FCA_J:I, STHJ_B(0:*):I, IFRT_I(0:*):I, -C IFRA_J(0:1,0:*):O, ANG_E(0:2,0:*):O) -C Using IFRT as input, calculate IFRA and ANG -C as above. FCA not used -C -C Include files: -C - INCLUDE 'WNG_DEF' - INCLUDE 'STH_O_DEF' !SET HEADER -C -C Parameters: -C -C -C Entry points: -C - LOGICAL NSCSIA -C -C Arguments: -C - INTEGER FCA !FILE CONTROL AREA - INTEGER STHJ(0:*) !CURRENT SET HEADER - INTEGER*2 IFRT(0:*) !INTERFEROMETER TABLE - INTEGER IFRA(0:1,0:*) !INTERFEROMETER ARRAY - REAL ANG(0:2,0:*) !DIPOLE ANGLES -C -C Function references: -C - LOGICAL WNFRD !READ DATA -C -C Data declarations: -C -C- -C -C INIT -C - NSCSIF=.TRUE. !ASSUME OK -C -C READ -C - IF (.NOT.WNFRD(FCA,2*STHJ(STH_NIFR_J),IFRT, !READ TABLE - 1 STHJ(STH_IFRP_J))) THEN - NSCSIF=.FALSE. !ERROR READING TABLE -C - RETURN - END IF - GOTO 10 -C -C NSCSIA -C - ENTRY NSCSIA(FCA,STHJ,IFRT,IFRA,ANG) -C - NSCSIA=.TRUE. - GOTO 10 -C -C MAKE IFRA -C - 10 CONTINUE - DO I=0,STHJ(STH_NIFR_J)-1 !MAKE ARRAY - IFRA(0,I)=MOD(IFRT(I),256) !WEST TEL. - IFRA(1,I)=IFRT(I)/256 !EAST TEL. - END DO -C -C MAKE ANG -C - DO I=0,STHJ(STH_NIFR_J)-1 - ANG(0,I)=IAND(3,ISHFT(STHJ(STH_DIPC_J), - 1 -2*IFRA(0,I)))/8. !ANGLE W TELESCOPE - ANG(2,I)=IAND(3,ISHFT(STHJ(STH_DIPC_J), - 1 -2*IFRA(1,I)))/8.-ANG(0,I) !DIFFERENCE E TELESCOPE - ANG(1,I)=SIN(ANG(2,I)*PI2) !ITS SINE - ANG(2,I)=COS(ANG(2,I)*PI2) !AND COSINE - END DO -C - RETURN -C -C - END diff --git a/src/nscan/nscstg.for b/src/nscan/nscstg.for deleted file mode 100644 index 3c8b82146c2eebdc220c35e0e4163c72fe4088d8..0000000000000000000000000000000000000000 --- a/src/nscan/nscstg.for +++ /dev/null @@ -1,124 +0,0 @@ -C+ NSCSTG.FOR -C WNB 900306 -C -C Revisions: -C WNB 910301 Add looping type specification -C WNB 910307 Add NSCSTL -C WNB 910327 Use general routine WNDSTG -C JPH 941005 NSCSTD. Comments -C JPH 960610 Store DLDM in ad-hoc common block -C -C - LOGICAL FUNCTION NSCSTG(FCA,SETS,STHE,STHP,SNAM) -C -C Get next set -C -C Result: -C -C NSCSTG_L = NSCSTG( FCA_J:I, SETS_J(0:7,0:*):IO, STHE_E(0:*):O, -C STHP_J:O, SNAM_J(0:7):O) -C Get next set in file FCA, using the -C specification in SETS (see WNDSTA). -C NSCSTG will be .false. if no more sets. -C STHE will be the header of the set, STHP the -C diskpointer. SNAM is the full name of the -C group, coded. A check is made for the right -C version. -C -C NSCSTH_L = NSCSTH( FCA_J:I, SETS_J(0:7,0:*):IO, STHE_E(0:*):O, -C STHP_J:O, SNAM_J(0:7):O) -C Same, but no check for version -C -C NSCSTL_L = NSCSTL( FCA_J:I, SETS_J(0:7,0:*):IO, STHE_E(0:*):O, -C STHP_J:O, SNAM_J(0:7):O, -C OFFSET_J(0:7):I) -C As NSCSTG, but the check in the set list SETS -C is done with offsets OFFSET. OFFSET is an array -C to be maintained by WNDXLI/WNDXLN -C -C NSCSTD_L = NSCSTD( FCA_J:I, SETS_J(0:7,0:*):IO, STHE_E(0:*):O, -C STHP_J:O, SNAM_J(0:7):O, -C OFFSET_J(0:7):I) -C Delete link to the set header, no version check -C -C Include files: -C - INCLUDE 'WNG_DEF' - INCLUDE 'STH_O_DEF' !SET HEADER - INCLUDE 'DLDM_DEF' -C -C Parameters: -C -C -C Entry points: -C - LOGICAL NSCSTH ! NO VERSION CHECK - LOGICAL NSCSTL ! OFFSET FOR LOOPS - LOGICAL NSCSTD ! delete data linkage -C -C Arguments: -C - INTEGER FCA !FILE TO SEARCH - INTEGER SETS(0:7,0:*) !SETS TO DO - REAL STHE(0:*) ! sector header - INTEGER STHP !POINTER TO SET HEADER - INTEGER SNAM(0:7) !FULL SET NAME - INTEGER OFFSET(0:7) !CHECK OFFSET FOR LOOPS -C -C Function references: -C - LOGICAL WNFRD !READ DISK - LOGICAL WNDSTG !FUNCTIONS THAT DO THE WORK - LOGICAL WNDSTH,WNDSTL,WNDSTD -C -C Data declarations: -C -C- - NSCSTG=WNDSTG(FCA,SETS,STHHDV,STHP,SNAM) !GET SET - GOTO 10 -C -C NSCSTH -C - ENTRY NSCSTH(FCA,SETS,STHE,STHP,SNAM) -C - NSCSTH=WNDSTH(FCA,SETS,STHHDV,STHP,SNAM) !GET SET - GOTO 10 -C -C NSCSTL -C - ENTRY NSCSTL(FCA,SETS,STHE,STHP,SNAM,OFFSET) -C - NSCSTL=WNDSTL(FCA,SETS,STHHDV,STHP,SNAM,OFFSET) !GET SET - GOTO 10 -C -C Read SET HEADER -C - 10 CONTINUE - IF (NSCSTG) THEN !ONE FOUND - IF (.NOT.WNFRD(FCA,STHHDL,STHE(0),STHP)) GOTO 900 !READ SET HEADER - END IF - DLDM(0)=STHE(STH_DLDM_E) - DLDM(1)=STHE(STH_DLDM_E+1) -C - RETURN -C -C ERROR -C - 900 CONTINUE - DO I=1,7 - SETS(I,0)=0 !RESET SEARCH - END DO - NSCSTG=.FALSE. !NO MORE -C - RETURN -C -C -C NSCSTD -C - ENTRY NSCSTD(FCA,SETS,STHE,STHP,SNAM,OFFSET) -C - NSCSTD=WNDSTD(FCA,SETS,STHHDV,STHP,SNAM,OFFSET) ! GET SET, delete link - RETURN -C -C - END diff --git a/src/nscan/nscswc.for b/src/nscan/nscswc.for deleted file mode 100644 index 9a422f344c5c2bbc6432531c03d24ee5bd0ee934..0000000000000000000000000000000000000000 --- a/src/nscan/nscswc.for +++ /dev/null @@ -1,315 +0,0 @@ -C+ NSCSWC.FOR -C WNB 910208 -C -C Revisions: -C WNB 910820 Add extinction, refraction, Faraday -C WNB 921216 Do not copy noise for deleted scan -C JPH 930614 Legibilise. Contract some small loops -C WNB 930708 Correct Parameter format -C WNB 930803 CBITS_DEF -C CMV 940331 Select telescopes to copy corrections for -C WNB 940811 Remove AIFR/MIFR zero -C CMV 950220 Change handling of AOTH corrections -C HjV 950511 Set AOTHUSED -C CMV 031231 Changed GPS,XYS from BYTE to LOGICAL -C - LOGICAL FUNCTION NSCSWC(FCA,STHJ,SCN,COR,TCOR, - 1 GPS,XYS,TELS,CAP,CDAP,ZAP) -C -C Write scan correction data -C -C Result: -C -C NSCSWC_L = NSCSWC( FCA_J:I, STHJ_B(0:*):I, , SCN_J:I, -C COR(0:*,G:P,X:Y):I, TCOR_J:I, -C GPS_L(G:P):I, XYS_L(X:Y):I, TELS_B(0:*), -C CAP_J:I, CDAP_J:I, ZAP_J:I) -C The file FCA with set header STH and scan number SCN will have -C corrections submitted in COR added to its SCH table indicated by the mask -C TCOR, - whose value may be CAP_RED, _ALG or _OTH. -C GPS(G/P) and XYS(X/Y) are logical byte masks showing which parts of -C COR are valid. -C The bits in CAP, CDAP indicate how the corresponding corrections -C currently in the target table must be treated: -C CAP indicates that the current correction -C must be retained, ZAP that it must be set to 0; if both are true, the -C implication is that the correction must be absorbed into the correction -C identified by TCOR. -C** Old situation: -C** CDAP indicates that the existing "applied" correction must be -C** subtracted from the current one. (NOTE: it would seem to me that the applied -C** correction should then be cleared, but this does not happen.) -C** New situation -C CDAP indicates that an existing "applied" correction has been deapplied -C from the data on which the present correction was based. It is assumed that -C the user will also deapply this correction in any further use. -C -C -C NSCSWU_L = NSCSWU( FCA_J:I, STHJ_B(0:*):I, , SCN_J:I, -C COR(0:*,G:P,X:Y):I, TCOR_J:I, -C GPS_L(G:P):I, XYS_L(X:Y):I, TELS_B(0:*), -C CAP_J:I, CDAP_J:I, ZAP_J:I, ME_E(G:P,X:Y):I) -C As NSCSWC, but also write the scan noise. -C -C Include files: -C - INCLUDE 'WNG_DEF' - INCLUDE 'CBITS_DEF' - INCLUDE 'STH_O_DEF' !SET HEADER - INCLUDE 'SCH_O_DEF' !SCAN HEADER -C -C Entry points: -C - LOGICAL NSCSWU !WRITE MEAN ERRORS -C -C Parameters: -C - INTEGER G,P - PARAMETER (G=0, P=1) !gain/phase index - INTEGER X,Y - PARAMETER (X=0, Y=1) !X/Y index - INTEGER RED,ALG,OTH - PARAMETER (RED=1, ALG=2, OTH=3) !corrn table index -C -C Arguments: -C - INTEGER FCA !FILE CONTROL AREA - INTEGER STHJ(0:*) !CURRENT SET HEADER - INTEGER SCN !SCAN TO DO - REAL COR(0:STHTEL-1,G:P,X:Y) !CORRECTIONS G,P X,Y - INTEGER TCOR !TYPE CORRECTION - LOGICAL GPS(G:P) !GAIN/PHASE PRESENT - LOGICAL XYS(X:Y) !X/Y PRESENT - BYTE TELS(0:*) !TELESCOPES SELECTED - INTEGER CAP !APPLY CORRECTIONS - INTEGER CDAP !DE-APPLY CORRECTIONS - INTEGER ZAP !ZERO CORRECTIONS - REAL ME(G:P,X:Y) !GAIN/PHASE X/Y NOISES -C -C Function references: -C - LOGICAL WNFRD !READ DATA - LOGICAL WNFWR !WRITE DATA - INTEGER WNGARA !ADDRESS OF VARIABLE - REAL WNGENR !ANGLE -180,180 -C -C Data declarations: -C - LOGICAL DOME !SWITCH FOR M.E. - INTEGER SCNP !SCH file address - INTEGER RPTR, WPTR !read and write pointers to - ! correction arrays in SCH - INTEGER INDX !index into these arrays - INTEGER IXY, IGP !X/Y, gain/phase loop indices - INTEGER ITEL !telescope loop index - REAL GN, PH !gain. phase accumulators - INTEGER BIT !correction mask bit - INTEGER CTYP !corection type index - LOGICAL WARN_CDAP - DATA WARN_CDAP/.FALSE./ - SAVE WARN_CDAP - BYTE SCH(0:SCHHDL-1) !SCAN HEADER - INTEGER SCHJ(0:SCHHDL/4-1) - REAL SCHE(0:SCHHDL/4-1) - EQUIVALENCE (SCH,SCHJ,SCHE) -C- -C -C INIT -C - NSCSWC=.TRUE. !ASSUME OK - DOME=.FALSE. !NO M.E. WRITE - GOTO 10 -C -C NSCSWU -C - ENTRY NSCSWU(FCA,STHJ,SCN,COR,TCOR, - 1 GPS,XYS,TELS,CAP,CDAP,ZAP,ME) -C -C INIT -C - NSCSWU=.TRUE. !ASSUME OK - DOME=.TRUE. !WRITE M.E. - GOTO 10 -C -C READ SCAN HEADER -C - 10 CONTINUE - IF (SCN.LT.0 .OR. - 1 SCN.GE.STHJ(STH_SCN_J)) GOTO 900!UNKNOWN SCAN - SCNP=STHJ(STH_SCNP_J)+SCN*STHJ(STH_SCNL_J)!SCAN POINTER - IF (.NOT.WNFRD(FCA,SCHHDL,SCH,SCNP)) - 1 GOTO 900 !READ SCAN HEADER -C -C SET CORRECTIONS -C -C select table to be updated -C - WPTR=SCH_REDC_E !ASSUME REDUNDANCY - IF (IAND(TCOR,CAP_RED).NE.0) THEN !FIND CORRECT TYPE - ELSE IF (IAND(TCOR,CAP_ALG).NE.0) THEN - WPTR=SCH_ALGC_E - ELSE IF (IAND(TCOR,CAP_OTH).NE.0) THEN - WPTR=SCH_OTHC_E - END IF -C -C assemble corrections. GN and PH contributions are accumulated -C unconditionally; whether or not the end result will be used depends on the -C settings in GPS. (It is assumed that COR contains no values that might cause -C arithmetic exceptions.) -C - DO IXY=X,Y !X,Y - IF (XYS(IXY)) THEN !does COR contain this polsn? - DO ITEL=0,STHTEL-1 - IF (TELS(ITEL)) THEN - INDX=2*ITEL+2*STHTEL*IXY !offset in SCH corrns array - GN=COR(ITEL,G,IXY) !start with new gain and phase - PH=COR(ITEL,P,IXY) ! corrections in accum. - IF (IAND(CDAP,CAP_OTH).NE.0) - 1 THEN ! CDAP: -C data were read in with old corrns deapplied. -C Ignore this for the present corrections, but issue a warning -C -C GN=GN-SCHE(SCH_AOTHC_E+INDX+G) ! subtract -C PH=PH-SCHE(SCH_AOTHC_E+INDX+P) ! the old ones - IF (.NOT.WARN_CDAP) THEN - CALL WNCTXT(F_TP,'!AS!/!AS', - 1 '*** Current corrections derived with /DE_APPY=OTH ***', - 1 '*** Programs will use /DE_APPLY=OTH in any '// - 2 'further processing ***') - WARN_CDAP=.TRUE. - END IF - SCHJ(SCH_AOTHUSED_J)=1 !AOTH DE-APPLIED - ELSE - SCHJ(SCH_AOTHUSED_J)=0 - END IF -C - BIT=1 !mask bit for CAP, ZAP - RPTR=SCH_REDC_E !start at REDC table - DO CTYP=RED,OTH !loop: REDC, ALGC, OTHC tables - IF (IAND(ZAP,BIT).NE.0) THEN! -C -C if both CAP and ZAP are specified for this correction, the interpretation is -C that the current correction must be transferred from the table to the data -C if only ZAP is specified, it is simply destroyed -C - IF (IAND(CAP,BIT).NE.0) THEN ! ZAP CAP: - GN=GN+SCHE(RPTR+INDX+G) ! add - PH=PH+SCHE(RPTR+INDX+P) ! current - END IF - IF (GPS(G)) THEN ! ZAP (CAP - !CAP) - SCHE(RPTR+INDX+G)=0 ! clear current gain, - IF (CTYP.EQ.OTH) - 1 SCHE(SCH_EXT_E)=0 ! extinction - END IF - IF (GPS(P)) THEN - SCHE(RPTR+INDX+P)=0 ! phase - IF (CTYP.EQ.OTH) THEN - SCHE(SCH_REFR_E)=0 ! troposph. refraction - SCHE(SCH_IREF_E)=0 ! ionosph. refraction - SCHE(SCH_CLKC_E)=0 ! and clock - ENDIF - END IF - ELSE - IF (IAND(CAP,BIT).NE.0) THEN ! !ZAP CAP: nop - ELSE ! !ZAP !CAP: - GN=GN-SCHE(RPTR+INDX+G) ! subract current - PH=PH-SCHE(RPTR+INDX+P) - END IF - END IF -C - BIT=2*BIT !set bitmask and pointer - RPTR=RPTR+SCH_ALGC_E-SCH_REDC_E !for next correction type - END DO !end CTYP loop -C - IF (GPS(G)) SCHE(WPTR+INDX+G)= - 1 SCHE(WPTR+INDX+G)+GN !add accum. to current - IF (GPS(P)) SCHE(WPTR+INDX+P)= - 1 WNGENR(SCHE(WPTR+INDX+P)+PH)!(modulo 2*pi) - END IF - END DO !end of tel. loop - END IF - END DO !end of XY loop -C -C ZERO M.E. (xxxNS tables) where ZAP requested -C - BIT=1 !ZAP test BIT - WPTR=SCH_REDNS_E !point WPTR at RED table - DO CTYP=RED,OTH !RED, ALG, OTH - IF (IAND(ZAP,BIT).NE.0) THEN !ZERO THIS CORRECTION? - DO IXY=X,Y - DO IGP=G,P - IF (GPS(IGP)) THEN !if this component - IF (XYS(IXY)) ! is specified, - 1 SCHE(WPTR+2*IXY+IGP)=0 ! zero it - END IF - ENDDO - END DO - END IF - BIT=2*BIT !NEXT CORRECTION bit - WPTR=WPTR+SCH_ALGNS_E-SCH_REDNS_E !next table - END DO -C -C zero atmosphere and clock parameters -C - IF (IAND(ZAP,CAP_XTNC).NE.0) THEN !zero EXTINCTION? - SCHE(SCH_EXT_E)=0 - END IF - IF (IAND(ZAP,CAP_REFR).NE.0) THEN !zero REFRACTION? - SCHE(SCH_REFR_E)=0 - END IF - IF (IAND(ZAP,CAP_FAR).NE.0) THEN !zero FARADAY? - SCHE(SCH_FARAD_E)=0 - END IF - IF (IAND(ZAP,CAP_IREF).NE.0) THEN !zero REFRACTION? - SCHE(SCH_IREF_E)=0 - END IF - IF (IAND(ZAP,CAP_CLK).NE.0) THEN !zero CLOCK CORRECTION? - SCHE(SCH_CLKC_E)=0 - END IF -C -C SET M.E. (xxxNS tables) -C - IF (DOME) THEN !M.E. ASKED -C -C point WPTR at target ME table -C - WPTR=SCH_REDNS_E !ASSUME REDUNDANCY - IF (IAND(TCOR,CAP_RED).NE.0) THEN !FIND CORRECT TYPE - ELSE IF (IAND(TCOR,CAP_ALG).NE.0) THEN - WPTR=SCH_ALGNS_E - ELSE IF (IAND(TCOR,CAP_OTH).NE.0) THEN - WPTR=SCH_OTHNS_E - END IF -C - DO IXY=X,Y !X,Y - IF (XYS(IXY)) THEN !PRESENT - DO IGP=G,P !gain, phase - IF (GPS(IGP)) THEN - IF (IAND(SCHJ(SCH_BITS_J), - 1 FL_ALL) !scan not deleted - 1 .EQ.0 .OR. - 1 ABS(ME(IGP,IXY)).GT. ! or new ME > old - 1 ABS(SCHE(WPTR+2*IXY+IGP))) - 1 SCHE(WPTR+2*IXY+IGP)=ME(IGP,IXY) - END IF - ENDDO !end G,P loop - END IF - END DO !end X,Y loop - END IF !END DOME -C -C REWRITE SCAN HEADER -C - IF (.NOT.WNFWR(FCA,SCHHDL,SCH,SCNP)) GOTO 900 !WRITE SCAN HEADER -C - RETURN -C -C ERROR -C - 900 CONTINUE - NSCSWC=.FALSE. -C - RETURN -C -C - END diff --git a/src/nscan/nscswi.for b/src/nscan/nscswi.for deleted file mode 100755 index 4794dca07da8c69e3cdb0caf9fa0befac56c2aa7..0000000000000000000000000000000000000000 --- a/src/nscan/nscswi.for +++ /dev/null @@ -1,188 +0,0 @@ -C+ NSCSWI.FOR -C WNB 940810 -C -C Revisions: -C WNB 950628 Read IFR corrections only once -C WNB 950704 Add AIFR pre-correction -C - LOGICAL FUNCTION NSCSWI(FCA,STHJ,SCN,IFRT,COR,TCOR, - 1 CAP,CDAP,ZAP) -C -C Write interferometer correction data -C -C Result: -C -C NSCSWI_L = NSCSWI( FCA_J:I, STHJ_B(0:*):I, SCN_J:I, IFRT_I(*):I, -C COR_X(0:3,0:*):I, TCOR_J:I, -C CAP_J:I, CDAP_J:I, ZAP_J:I) -C The file FCA with set header STH and scan number SCN will have -C corrections submitted in COR added to its SCH table indicated by the mask -C TCOR, - whose value may be CAP_AIFR or _MIFR. -C If the TCOR bit in ZAP is set, the corrections will be zeroed -C unconditionally. -C The bits in CAP/CDAP indicate which corrections were used in -C determining the COR, and will be used to 'de-correct' the input COR. -C For TCOR CAP_AIFR the COR are COS/SIN; for _MIFR (log(gain),phase) -C -C Include files: -C - INCLUDE 'WNG_DEF' - INCLUDE 'CBITS_DEF' - INCLUDE 'STH_O_DEF' !SET HEADER - INCLUDE 'SCH_O_DEF' !SCAN HEADER -C -C Parameters: -C -C -C Arguments: -C - INTEGER FCA !FILE CONTROL AREA - INTEGER STHJ(0:*) !CURRENT SET HEADER - INTEGER SCN !SCAN # TO DO - INTEGER*2 IFRT(0:*) !INTERFEROMETER TABLE - COMPLEX COR(0:3,0:*) !CORRECTIONS - INTEGER TCOR !TYPE CORRECTION - INTEGER CAP !APPLIED CORRECTIONS - INTEGER CDAP !DE-APPLIED CORRECTIONS - INTEGER ZAP !ZERO CORRECTIONS -C -C Function references: -C - LOGICAL WNFRD !READ DATA - LOGICAL WNFWR !WRITE DATA - INTEGER WNFEOF !GET END OF FILE - LOGICAL NSCSCY !READ EXTENDED CORRECTIONS -C -C Data declarations: -C - LOGICAL DOMIFR !SWAP MIFR/AIFR - INTEGER POFF !POINTER MIFR/AIFR OFFSET - INTEGER SCNP !CURRENT SCAN DISK PTR - COMPLEX LCOR(0:3,0:STHIFR-1) !LOCAL CORRECTION BLOCK - COMPLEX TLCOR(0:STHTEL-1,0:1) !TEL. CORRECTIONS - COMPLEX IMCOR(0:3,0:STHIFR-1,0:1) !(DE-)APPLY MIFR CORR - COMPLEX IACOR(0:3,0:STHIFR-1,0:1) !(DE-)APPLY AIFR CORR - REAL FACOR(2,2) !FARADAY ROTATION - COMPLEX PLCOR(0:STHTEL-1,0:1) !POL. CORRECTION - COMPLEX CI - INTEGER CPLC(0:3,0:1) !X,Y IDENTIFIERS - DATA CPLC/0,0,1,1,0,1,0,1/ - BYTE SCH(0:SCH__L-1) !SCAN HEADER - INTEGER SCHJ(0:SCH__L/LB_J-1) - REAL SCHE(0:SCH__L/LB_E-1) - EQUIVALENCE (SCH,SCHJ,SCHE) -C- -C -C INIT -C - NSCSWI=.TRUE. !ASSUME OK - IF (IAND(TCOR,CAP_MIFR).NE.0) THEN !MIFR - DOMIFR=.TRUE. - POFF=SCH_IFRMC_J !HEADER OFFSET - ELSE IF (IAND(TCOR,CAP_AIFR).NE.0) THEN !AIFR - DOMIFR=.FALSE. - POFF=SCH_IFRAC_J - ELSE -C - RETURN !NOTHING TO DO - END IF - CALL WNGMVZ(4*LB_X*STHIFR,LCOR) !ASSUME NO CORRECTIONS -C -C READ SCAN HEADER AND CORRECTIONS -C - IF (.NOT.NSCSCY(FCA,STHJ,IFRT,SCN,CAP,CDAP,SCH,TLCOR, - 1 IMCOR,FACOR,PLCOR,IACOR)) GOTO 900 !SCAN/CORRECTIONS - SCNP=STHJ(STH_SCNP_J)+SCN*STHJ(STH_SCNL_J) !GET SCN HEADER POINTER -C -C ZERO CORRECTIONS -C - IF (IAND(TCOR,ZAP).NE.0) THEN !ZERO ASKED - IF (SCHJ(POFF).NE.0) GOTO 100 !CORRECTIONS PRESENT: REWRITE - GOTO 800 !READY - END IF -C -C ADD TO OLD -C - IF (DOMIFR) THEN - IF (IAND(TCOR,CAP).NE.0) THEN !OLD WAS APPLIED - CALL WNGMV(4*LB_X*STHJ(STH_NIFR_J),IMCOR(0,0,0),LCOR(0,0)) !GET - END IF - ELSE - IF (IAND(TCOR,CAP).NE.0) THEN !OLD WAS APPLIED - CALL WNGMV(4*LB_X*STHJ(STH_NIFR_J),IACOR(0,0,0),LCOR(0,0)) !GET - END IF - END IF -C -C DETERMINE CORRECTIONS -C -C APPLY OLD CORRECTIONS -C - IF (.NOT.DOMIFR) THEN !RE-CORRECT AIFR -C -C NOTE: FARADAY ROTATION AND POLARISATION CORRECTIONS NOT IMPLEMENTED -C CORRECTLY. HENCE ITERATION NECESSARY. -C - IF (IAND(CDAP,CAP_AIF).NE.0) THEN !WANTED AND PRESENT - DO I=0,STHJ(STH_NIFR_J)-1 !ALL IFRS - DO I1=0,3 !ALL POL. - COR(I1,I)=COR(I1,I)-IACOR(I1,I,1) - END DO - END DO - END IF - IF (IAND(CAP,CAP_MIF).NE.0) THEN !WANTED AND PRESENT - DO I=0,3 !ALL POL. - DO I3=0,STHJ(STH_NIFR_J)-1 !ALL IFRS - CI=IMCOR(I,I3,0) !IFR APPLY - COR(I,I3)=COR(I,I3)*EXP(+CI) !CORRECT DATA POINT - END DO !IFRS - END DO !POL. - END IF - IF (IAND(CDAP,CAP_MIF).NE.0) THEN !WANTED AND PRESENT - DO I=0,3 !ALL POL. - DO I3=0,STHJ(STH_NIFR_J)-1 !ALL IFRS - CI=-IMCOR(I,I3,1) !IFR DE-APPLY - COR(I,I3)=COR(I,I3)*EXP(+CI) !CORRECT DATA POINT - END DO !IFRS - END DO !POL. - END IF - IF (IAND(IOR(CAP,CDAP),CAP_TELMSK).NE.0) THEN !WANTED - DO I=0,3 !ALL POL. - I1=CPLC(I,0) !X ID - I2=CPLC(I,1) !Y ID - DO I3=0,STHJ(STH_NIFR_J)-1 !ALL IFRS - CI=TLCOR(MOD(IFRT(I3),256),I1)+ - 1 CONJG(TLCOR(IFRT(I3)/256,I2)) !CORRECTION - COR(I,I3)=COR(I,I3)*EXP(+CI) !CORRECT DATA POINT - END DO !IFRS - END DO !POL. - END IF - END IF - DO I=0,STHJ(STH_NIFR_J)-1 - DO I1=0,3 - LCOR(I1,I)=LCOR(I1,I)+COR(I1,I) - END DO - END DO -C -C WRITE CORRECTIONS -C - 100 CONTINUE - IF (SCHJ(POFF).EQ.0) SCHJ(POFF)=WNFEOF(FCA) !WHERE TO WRITE - IF (.NOT.WNFWR(FCA,4*LB_X*STHJ(STH_NIFR_J),LCOR, - 1 SCHJ(POFF))) GOTO 900 !WRITE CORRECTIONS -C -C REWRITE SCAN HEADER -C - 800 CONTINUE - IF (.NOT.WNFWR(FCA,SCH__L,SCH,SCNP)) GOTO 900 !RE-WRITE SCAN HEADER -C - RETURN -C -C ERROR -C - 900 CONTINUE - NSCSWI=.FALSE. -C - RETURN -C -C - END diff --git a/src/nscan/nsctls.for b/src/nscan/nsctls.for deleted file mode 100644 index cdee55109097764bde91d525d7988c6e435b12bd..0000000000000000000000000000000000000000 --- a/src/nscan/nsctls.for +++ /dev/null @@ -1,182 +0,0 @@ -C+ NSCTLS.FOR -C WNB 930824 -C -C Revisions: -C JPH 940902 Adapt to WNCXPL format, use WNCXPL where possible -C Call WNDPOHC -C -C - LOGICAL FUNCTION NSCTLS(TYP,TELS) -C -C Select/de-select telescopes -C -C Result: -C NSCTLS_L = NSCTLS ( TYP_J:I, TELS_B(0:*):IO) -C Include (.true.) or exclude (.false.) -C telescopes in TELS. TYP can be: -C 0 use as given (show first) -C 1 pre-select all -C 4 pre-select none -C TYP can be TYP+100 to suppress asking. -C TYP can be TYP+200 to suppress asking and -C initial message -C Assume WSRT telescopes. .FALSE. if -C input error or # given (check E_C) -C NSCTL1_L = NSCTL1 ( TYP_J:I, TELS_B(0:*)*:IO, STHJ_J(0:*):I) -C As TLS, but check for instrument used -C -C Pin references: -C -C SELECT_TELS -C -C Include files: -C - INCLUDE 'WNG_DEF' - INCLUDE 'STH_O_DEF' !SET HEADER -C -C Entry points: -C - LOGICAL NSCTL1 -C -C Parameters: -C - INTEGER MAXDEF !MAXIMUM ENTRIES PIN ENTRY - PARAMETER (MAXDEF=20) -C -C Arguments: -C - INTEGER TYP !SELECTION TYPE - BYTE TELS(0:STHTEL-1) !SELECTION TEL TABLE - INTEGER STHJ(0:*) !SET HEADER -C -C Function references: -C - LOGICAL WNDPAR !GET USER DATA -C -C Data declarations: -C - CHARACTER*(STHTEL+8) TEL !TELESCOPE NAMES - DATA TEL/'0123456789ABCD*FMYZPTU'/ - INTEGER IS(STHTEL+8) !START VALUES - DATA IS/0,1,2,3,4,5,6,7,8,9,10,11,12,13, - 1 00,0,10,10,12,1,08,0/ - INTEGER IE(STHTEL+8) !END VALUES - DATA IE/0,1,2,3,4,5,6,7,8,9,10,11,12,13, - 1 13,9,13,11,13,0,13,7/ -C 0 1 2 3 4 5 6 7 8 9 A B C D -C * F M Y Z P T U - LOGICAL LP !PRINT INDICATOR - LOGICAL ADD !INCLUDE/EXCLUDE - INTEGER INSTR !INSTRUMENT (0=WSRT, 1=ATCA) - CHARACTER*4 RD(MAXDEF) !INPUT - CHARACTER*(STHTEL) IFTXT !LIST -C- -C -C NSCTLS -C - INSTR=0 !ASSUME WSRT - GOTO 100 -C -C NSCTL1 -C - ENTRY NSCTL1(TYP,TELS,STHJ) -C - INSTR=STHJ(STH_INST_J) !GET INSTRUMENT - GOTO 100 -C -C INIT -C - 100 CONTINUE - A_J(0)=1 ! inhibit reset of dynamic - ! prompt strings - NSCTLS=.TRUE. !ASSUME OK - LP=.FALSE. !ASSUME NO PRINT - IF (MOD(TYP,100).EQ.1) THEN !PRE-SELECT ALL - IF (TYP.LT.200) - 1 CALL WNCTXT(F_TP,'!4C\All telescopes pre-selected') - DO I1=0,STHTEL-1 - IF (INSTR.EQ.1 .AND. I1.LT.8) THEN - TELS(I1)=.FALSE. - ELSE - TELS(I1)=.TRUE. - END IF - END DO - ELSE IF (MOD(TYP,100).EQ.4) THEN !NONE - IF (TYP.LT.200) - 1 CALL WNCTXT(F_TP,'!4C\No telescopes pre-selected') - DO I1=0,STHTEL-1 - TELS(I1)=.FALSE. - END DO - ELSE !START WITH GIVEN - LP=.TRUE. !PRINT FIRST - END IF -C -C GET USER DATA -C - 10 CONTINUE - IF (LP) THEN !PRINT TELS - IFTXT=' ' - DO I2=1,STHTEL - IF (TELS(I2-1)) THEN !SELECT - IFTXT(I2:I2)=TEL(I2:I2) - ELSE !DESELECT - IFTXT(I2:I2)='.' - END IF - END DO - CALL WNCTXT(F_T,'!4C\Telescopes selected: !#$AS',STHTEL,IFTXT) - END IF -C - 11 CONTINUE - IF (TYP.GE.100) GOTO 20 !READY - IF (.NOT.WNDPAR('SELECT_TELS',RD,MAXDEF*4,J0,'""')) THEN !GET INFO - IF (E_C.EQ.DWC_ENDOFLOOP) THEN - NSCTLS=.FALSE. !SHOW END - GOTO 20 !READY - END IF - GOTO 11 !REPEAT - ELSE IF (J0.EQ.0) THEN - GOTO 20 !READY - ELSE IF (J0.LT.0) THEN !ASSUME +* - IF (INSTR.EQ.1) THEN !ATCA - RD(1)='+T' - ELSE - RD(1)='+*' - END IF - J0=1 - END IF -C - DO I=1,J0 - ADD=.TRUE. !ASSUME INCLUDE - I1=1 !CHARACTER PTR - 31 CONTINUE - IF (I1.GT.4) GOTO 30 !EMPTY - IF (RD(I)(I1:I1).EQ.' ') THEN - I1=I1+1 !SKIP SPACE - GOTO 31 - ELSE IF (RD(I)(I1:I1).EQ.'+') THEN - I1=I1+1 !SKIP + - GOTO 31 - ELSE IF (RD(I)(I1:I1).EQ.'-') THEN - I1=I1+1 - ADD=.NOT.ADD !EXCLUDE - GOTO 31 - ELSE - I2=INDEX(TEL,RD(I)(I1:I1)) !GET TELESCOPE - IF (I2.EQ.0) GOTO 30 !UNKNOWN - I1=I1+1 - DO I4=IS(I2),IE(I2) !DO FOR SPECIFIED TEL. - TELS(I4)=ADD - END DO - END IF - 30 CONTINUE - END DO - LP=.TRUE. - GOTO 10 !MORE -C - 20 CONTINUE - CALL WNDPOHC -C - RETURN -C -C - END diff --git a/src/nscan/nscumf.for b/src/nscan/nscumf.for deleted file mode 100644 index f34fe216a582f3abf0b41e31e6c64b255d1f468c..0000000000000000000000000000000000000000 --- a/src/nscan/nscumf.for +++ /dev/null @@ -1,160 +0,0 @@ -C+ NSCUMF.FOR -C WNB 910220 -C -C Revisions: -C - LOGICAL FUNCTION NSCUMF(FCAOUT,TP,NAM,BUF,CMT) -C -C Make FITS line -C -C Result: -C -C NSCUMF_L = NSCUMF_L( FCAOUT_J:I, TP_J:I, NAM_C*:I, -C BUF(0:*)_B:I, CMT_C*:I) -C Make a FITS line from data in BUF according -C to type TP and comment in CMT -C NSCUMS_L = NSCUMS_L( FCAOUT_J:I, TP_J:I, NAM_C*:I, -C SBUF_C*:I, CMT_C*:I) -C Use string in SBUF -C NSCUMB_L = NSCUMB_L( FCAOUT_J:I, TP_J:I, IBUF_B(0:*):I, NVAL_J:I) -C Make IEEE binary data of NVAL of type TP -C in buffer IBUF, and write to output. -C -C Include files: -C - INCLUDE 'WNG_DEF' -C -C Parameters: -C - INTEGER LRCLEN !RECORD LENGTH FITS (CHANGE ALSO NSCUWB) - PARAMETER (LRCLEN=2880) - INTEGER CDILEN !CARD IMAGE LENGTH - PARAMETER (CDILEN=80) - INTEGER NCDI !# OF CARD IMAGES/RECORD - PARAMETER (NCDI=LRCLEN/CDILEN) - INTEGER V_Z,V_L,V_I,V_J,V_C,V_E,V_D,V_T, - 1 V_XI,V_XJ !CODES FOR FITS CARD LINES - PARAMETER (V_Z=0,V_L=1,V_I=2,V_J=3,V_C=4,V_E=5,V_D=6, - 1 V_T=7,V_XI=8,V_XJ=9) -C -C Arguments: -C - INTEGER FCAOUT !FILE POINTER - INTEGER TP !DATA TYPE - CHARACTER*(*) NAM !FIELD NAME - BYTE BUF(0:*) !BUFFER WITH INFO - CHARACTER*(*) SBUF !STRING WITH INFO - CHARACTER*(*) CMT !COMMENTS - BYTE IBUF(0:*) !DATA BUFFER - INTEGER NVAL !# OF VALUES -C -C Entry points: -C - LOGICAL NSCUMS !STRING INPUT - LOGICAL NSCUMB !BINARY OUTPUT -C -C Function references: -C - LOGICAL NSCUWB !WRITE FITS LINE - LOGICAL NSCUWL !WRITE FITS DATA - LOGICAL WNGGJ !GET LOGICAL DATA -C -C Data declarations: -C - INTEGER*2 TRBUF(0:3) !TRANSLATION BUFFER - DATA TRBUF/0,0,0,0/ - BYTE LBUF(0:CDILEN-1) !LOCAL BUFFER - CHARACTER*(CDILEN) LBUFS - EQUIVALENCE (LBUF,LBUFS) -C- -C -C NSCUMF -C - IF (TP.EQ.V_Z) THEN !NO VALUE - CALL WNCTXS(LBUFS,'!-8$AS!9C/!AS',NAM,CMT) - ELSE IF (TP.EQ.V_L) THEN !LOGICAL - IF (WNGGJ(BUF)) THEN - CALL WNCTXS(LBUFS,'!-8$AS!9C\= !20$AS /!AS',NAM,'T',CMT) - ELSE - CALL WNCTXS(LBUFS,'!-8$AS!9C\= !20$AS /!AS',NAM,'F',CMT) - END IF - ELSE IF (TP.EQ.V_I) THEN !I - CALL WNCTXS(LBUFS,'!-8$AS!9C\= !20$SI /!AS',NAM,BUF,CMT) - ELSE IF (TP.EQ.V_J) THEN !J - CALL WNCTXS(LBUFS,'!-8$AS!9C\= !20$SJ /!AS',NAM,BUF,CMT) - ELSE IF (TP.EQ.V_E) THEN !E - CALL WNCTXS(LBUFS,'!-8$AS!9C\= !20$E12 /!AS',NAM,BUF,CMT) - ELSE IF (TP.EQ.V_D) THEN !D - CALL WNCTXS(LBUFS,'!-8$AS!9C\= !20$D12 /!AS',NAM,BUF,CMT) - ELSE IF (TP.EQ.V_T) THEN !DATE - CALL WNCTXS(LBUFS,'!-8$AS!9C\= ''!2$ZI/!2$ZI/!2$ZI'''// - 1 '!31C /!AS',NAM,BUF(0),BUF(2),BUF(4),CMT) - ELSE IF (TP.EQ.V_XI) THEN !XI - CALL WNCTXS(LBUFS,'!-8$AS!9C\= ''!-8$XI''!31C /!AS',NAM,BUF,CMT) - ELSE IF (TP.EQ.V_XJ) THEN !XJ - CALL WNCTXS(LBUFS,'!-8$AS!9C\= ''!-8$XJ''!31C /!AS',NAM,BUF,CMT) - ELSE !UNKNOWN - NSCUMF=.FALSE. - RETURN - END IF -C -C WRITE -C - NSCUMF=NSCUWB(FCAOUT,LBUF) -C - RETURN -C -C NSCUMS -C - ENTRY NSCUMS(FCAOUT,TP,NAM,SBUF,CMT) -C - IF (TP.EQ.V_C) THEN !CHARACTER - IF (LEN(SBUF).LE.8) THEN - CALL WNCTXS(LBUFS,'!-8$AS!9C\= ''!-8$AS!20C''!31C /!AS', - 1 NAM,SBUF,CMT) - ELSE - CALL WNCTXS(LBUFS,'!-8$AS!9C\= ''!-16$AS!28C''!31C /!AS', - 1 NAM,SBUF,CMT) - END IF - NSCUMS=NSCUWB(FCAOUT,LBUF) - ELSE - NSCUMS=.FALSE. - END IF -C - RETURN -C -C NSCUMB -C - ENTRY NSCUMB(FCAOUT,TP,IBUF,NVAL) -C - IF (TP.EQ.V_C) THEN !BYTE - J=NVAL*(L_B/L_B) !BUF. LENGTH - J0=9 !TRANSLATION TYPE - ELSE IF (TP.EQ.V_I) THEN !I - J=NVAL*(L_I/L_B) !BUF. LENGTH - J0=2 !TRANSLATION TYPE - ELSE IF (TP.EQ.V_J) THEN !J - J=NVAL*(L_J/L_B) !BUF. LENGTH - J0=3 !TRANSLATION TYPE - ELSE IF (TP.EQ.V_E) THEN !E - J=NVAL*(L_E/L_B) !BUF. LENGTH - J0=4 !TRANSLATION TYPE - ELSE IF (TP.EQ.V_D) THEN !D - J=NVAL*(L_D/L_B) !BUF. LENGTH - J0=5 !TRANSLATION TYPE - ELSE !UNKNOWN - NSCUMB=.FALSE. - RETURN - END IF - TRBUF(0)=J0 !SET TRANSL. BUF - TRBUF(1)=NVAL !NUMBER - CALL WNTTLT(J,IBUF,TRBUF,5) !MAKE IEEE FORMAT -C -C WRITE -C - NSCUMB=NSCUWL(FCAOUT,IBUF,J) -C - RETURN -C -C - END diff --git a/src/nscan/nscuv0.for b/src/nscan/nscuv0.for deleted file mode 100644 index f18e5063ae3cb1fe4d28a99e4183fb98053b7e2e..0000000000000000000000000000000000000000 --- a/src/nscan/nscuv0.for +++ /dev/null @@ -1,355 +0,0 @@ -C+ NSCUV0.FOR -C WNB 910220 -C -C Revisions: -C WNB 930819 Add Dipole code to INSTRUME; remove L_ -C CMV 940418 Correct labling of polarisations -C CMV 961011 Write RR,LL instead of XX,YY (confused AIPS) -C CMV 970130 Allow different BITPIXes -C - LOGICAL FUNCTION NSCUV0(OMCA,NPOL,POLT,IATOFF,NSCN,NFRQ, - 1 FRQTB,STPTB,STH,OHW,SCW,BTP) -C -C Write UVFITS header -C -C Result: -C -C NSCUV0_L = NSCUV0_L( OMCA_J:I, NPOL_J:I, POLT_J(1:*):I, -C IATOFF_D:I, NSCN_J:I, NFRQ_J:I, -C FRQTB_D:I, STPTB_D:I, -C STH_B(0:*):I, OHW_B(0:*):I, SCW_B(0:*):I, -C BTP_J:I) -C will write the UVFITS header. -C OMCA is the output file, NPOL the -C number of polarisation channels. -C POLT has the polarisation codes in sequence. -C IATOFF is IAT-UTC in fractions of day -C STH, OHW and SCW are the Set header, the OH -C block and the SC block. -C NSCN is the number of scans in field. -C NFRQ the number of simultaneous frequencies -C FRQTB the first frequency -C STPTB the step in frequency -C BTP is the BIXPIX value (-32,16,32) -C -C Include files: -C - INCLUDE 'WNG_DEF' - INCLUDE 'STH_O_DEF' !SET HEADER - INCLUDE 'OHW_O_DEF' !OH BLOCK - INCLUDE 'SCW_O_DEF' !SC BLOCK - INCLUDE 'CBITS_DEF' !DEFINITIONS -C -C Parameters: -C - INTEGER LRCLEN !RECORD LENGTH FITS (CHANGE ALSO NSCUWB) - PARAMETER (LRCLEN=2880) - INTEGER CDILEN !CARD IMAGE LENGTH - PARAMETER (CDILEN=80) - INTEGER NCDI !# OF CARD IMAGES/RECORD - PARAMETER (NCDI=LRCLEN/CDILEN) - INTEGER DBLEN !DATA BUFFER LENGTH - PARAMETER (DBLEN=512) !BYTES END IF - INTEGER V_Z,V_L,V_I,V_J,V_C,V_E,V_D,V_T, - 1 V_XI,V_XJ !CODES FOR FITS CARD LINES - PARAMETER (V_Z=0,V_L=1,V_I=2,V_J=3,V_C=4,V_E=5,V_D=6, - 1 V_T=7,V_XI=8,V_XJ=9) -C -C Arguments: -C - INTEGER OMCA !FILE POINTER - INTEGER NPOL !# OF POL. TO DO - INTEGER POLT(1:*) !POLARISATION CODES - DOUBLE PRECISION IATOFF !IAT-UTC - INTEGER NSCN !# OF SCANS IN FIELD - INTEGER NFRQ !# OF FREQ. CHANNELS - DOUBLE PRECISION FRQTB !FIRST FREQUENCY - DOUBLE PRECISION STPTB !STEP IN FREQ. - BYTE STH(0:*) !SET HEADER - BYTE OHW(0:*) !OH BLOCK - BYTE SCW(0:*) !SC BLOCK - INTEGER BTP !BITPIX -C -C Function references: -C - DOUBLE PRECISION WNGDFD,WNGDND !ANGLE CONVERSION - LOGICAL NSCUWF !FILL FITS LINE - LOGICAL NSCUMF,NSCUMS !MAKE FITS LINE - INTEGER WNCALN !STRING LENGTH - INTEGER*2 WNGGI !GET VALUES FROM PARAMETER - INTEGER WNGGJ - REAL WNGGE - DOUBLE PRECISION WNGGD -C -C Data declarations: -C - INTEGER*2 DATB(0:2) !DATE BUFFER - CHARACTER*12 TXT !HELP AREA - DOUBLE PRECISION BSC !DATA SCALE -C- -C -C INIT -C - NSCUV0=.TRUE. !ASSUME OK -C -C WRITE STANDARD HEADER -C - IF (.NOT.NSCUMF(OMCA,V_L,'SIMPLE',.TRUE., - 1 'Simple type')) GOTO 910 - - BSC=1D0/200.D0 !FIXED FOR NOW - IF (BTP.EQ.-32) THEN - IF (.NOT.NSCUMF(OMCA,V_J,'BITPIX',-32, - 1 'FLOATING POINT')) GOTO 910 - ELSE IF (BTP.EQ.32) THEN - IF (.NOT.NSCUMF(OMCA,V_J,'BITPIX',32, - 1 'INTEGER*4')) GOTO 910 - ELSE !ASSUME 16 - IF (.NOT.NSCUMF(OMCA,V_J,'BITPIX',16, - 1 'INTEGER*2')) GOTO 910 - END IF -C - IF (.NOT.NSCUMF(OMCA,V_J,'NAXIS',6, - 1 ' ')) GOTO 910 - IF (.NOT.NSCUMF(OMCA,V_J,'NAXIS1',0, - 1 'Just groups')) GOTO 910 - IF (.NOT.NSCUMF(OMCA,V_J,'NAXIS2',3, - 1 'Real, Imag, Weight')) GOTO 910 - IF (.NOT.NSCUMF(OMCA,V_J,'NAXIS3',NPOL, - 1 'XX,YY,XY,YX')) GOTO 910 - IF (.NOT.NSCUMF(OMCA,V_J,'NAXIS4',NFRQ, - 1 'Bands')) GOTO 910 - IF (.NOT.NSCUMF(OMCA,V_J,'NAXIS5',1, - 1 'Right Ascension')) GOTO 910 - IF (.NOT.NSCUMF(OMCA,V_J,'NAXIS6',1, - 1 'Declination')) GOTO 910 -C - IF (.NOT.NSCUMF(OMCA,V_L,'EXTEND',.TRUE., - 1 'Extension tables')) GOTO 910 - IF (.NOT.NSCUMF(OMCA,V_L,'BLOCKED',.TRUE., - 1 'Tape maybe blocked')) GOTO 910 -C - CALL WNGMTS(12,STH(STH_FIELD_1),TXT) - IF (.NOT.NSCUMS(OMCA,V_C,'OBJECT',TXT, - 1 'Field name')) GOTO 910 - IF (.NOT.NSCUMS(OMCA,V_C,'TELESCOP','WSRT', - 1 'Telescope')) GOTO 910 - CALL WNGMTS(4,OHW(OHW_BECODE_1),TXT) - CALL WNCTXS(TXT(5:),'- !3$XJ',STH(STH_DIPC_1)) - IF (.NOT.NSCUMS(OMCA,V_C,'INSTRUME',TXT(1:8), - 1 'Backend code, dipole pos.')) GOTO 910 - IF (.NOT.NSCUMS(OMCA,V_C,'ORIGIN','NFRA', - 1 'Place')) GOTO 910 - CALL WNCTXS(TXT,'!8$UI',OHW(OHW_PROJECT_1)) - IF (.NOT.NSCUMS(OMCA,V_C,'OBSERVER',TXT(1:8), - 1 'Project')) GOTO 910 - DATB(2)=WNGGI(OHW(OHW_DATE_1+1*LB_I)) !DATE - DATB(1)=WNGGI(OHW(OHW_DATE_1+2*LB_I)) - DATB(0)=WNGGI(OHW(OHW_DATE_1+3*LB_I)) - IF (.NOT.NSCUMF(OMCA,V_T,'DATE-OBS',DATB, - 1 'Date of observation')) GOTO 910 - IF (.NOT.NSCUMS(OMCA,V_C,'DATE','30/01/97', - 1 'Program date')) GOTO 910 - IF (.NOT.NSCUMF(OMCA,V_J,'BLANK',-32768, - 1 'Skipped data value')) GOTO 910 -C - IF (.NOT.NSCUMF(OMCA,V_D,'BSCALE',BSC, - 1 'Data scale')) GOTO 910 - IF (.NOT.NSCUMF(OMCA,V_D,'BZERO',0D0, - 1 'Value= tape*bscale +bzero')) GOTO 910 - IF (.NOT.NSCUMS(OMCA,V_C,'BUNIT','JY', - 1 'Visibility units')) GOTO 910 - IF (.NOT.NSCUMF(OMCA,V_E,'EPOCH',STH(STH_EPO_1), - 1 'Epoch')) GOTO 910 -C - IF (.NOT.NSCUMS(OMCA,V_C,'CTYPE2','COMPLEX', - 1 '1,2,3 = real,imag,weight')) GOTO 910 - IF (.NOT.NSCUMF(OMCA,V_E,'CRVAL2',1E0, - 1 ' ')) GOTO 910 - IF (.NOT.NSCUMF(OMCA,V_E,'CDELT2',1E0, - 1 ' ')) GOTO 910 - IF (.NOT.NSCUMF(OMCA,V_E,'CRPIX2',1E0, - 1 ' ')) GOTO 910 - IF (.NOT.NSCUMF(OMCA,V_E,'CROTA2',0E0, - 1 ' ')) GOTO 910 - IF (.NOT.NSCUMS(OMCA,V_C,'CTYPE3','STOKES', - 1 '-5,-6,-7,-8 = XX,YY,XY,YX')) GOTO 910 -C -C Polarisation -C - IF (IAND(POLT(1),STOKES_P).EQ.0) THEN !XX... - I2=-1 - IF (IAND(POLT(1),XX_P).NE.0) THEN - I1=-1 !was -5 - IF (NPOL.GT.1) THEN - IF (IAND(POLT(2),XY_P).NE.0) THEN - I2=-2 - ELSE IF (IAND(POLT(2),YX_P).NE.0) THEN - I2=-3 - END IF - END IF - ELSE IF (IAND(POLT(1),YY_P).NE.0) THEN - I1=-2 !was -6 - IF (NPOL.GT.1) THEN - IF (IAND(POLT(2),YX_P).NE.0) I2=-2 - END IF - ELSE IF (IAND(POLT(1),XY_P).NE.0) THEN - I1=-3 !was -7 - ELSE IF (IAND(POLT(1),YX_P).NE.0) THEN - I1=-4 !was -8 - END IF - ELSE !STOKES - I2=1 - IF (IAND(POLT(1),SI_P).NE.0) THEN - I1=1 - IF (NPOL.GT.1) THEN - IF (IAND(POLT(2),SU_P).NE.0) THEN - I2=2 - ELSE IF (IAND(POLT(2),SV_P).NE.0) THEN - I2=3 - END IF - END IF - ELSE IF (IAND(POLT(1),SQ_P).NE.0) THEN - I1=2 - IF (NPOL.GT.1) THEN - IF (IAND(POLT(2),SV_P).NE.0) I2=2 - END IF - ELSE IF (IAND(POLT(1),SU_P).NE.0) THEN - I1=3 - ELSE IF (IAND(POLT(1),SV_P).NE.0) THEN - I1=4 - END IF - END IF - IF (.NOT.NSCUMF(OMCA,V_E,'CRVAL3',FLOAT(I1), - 1 ' ')) GOTO 910 - IF (.NOT.NSCUMF(OMCA,V_E,'CDELT3',FLOAT(I2), - 1 ' ')) GOTO 910 - IF (.NOT.NSCUMF(OMCA,V_E,'CRPIX3',1E0, - 1 ' ')) GOTO 910 - IF (.NOT.NSCUMF(OMCA,V_E,'CROTA3',0E0, - 1 ' ')) GOTO 910 -C - IF (.NOT.NSCUMS(OMCA,V_C,'CTYPE4','FREQ', - 1 'Frequency in Hz')) GOTO 910 - IF (.NOT.NSCUMF(OMCA,V_D,'CRVAL4', - 1 (FRQTB+((NFRQ-1)/2)*STPTB)*1D6, - 1 ' ')) GOTO 910 - IF (.NOT.NSCUMF(OMCA,V_D,'CDELT4',STPTB*1D6, - 1 ' ')) GOTO 910 - IF (.NOT.NSCUMF(OMCA,V_E,'CRPIX4',FLOAT(((NFRQ+1)/2)), - 1 ' ')) GOTO 910 - IF (.NOT.NSCUMF(OMCA,V_E,'CROTA4',0E0, - 1 ' ')) GOTO 910 - IF (.NOT.NSCUMS(OMCA,V_C,'CTYPE5','RA---NCP', - 1 'RA in degrees')) GOTO 910 - IF (.NOT.NSCUMF(OMCA,V_D,'CRVAL5',WNGDFD(STH(STH_RAE_1)), - 1 ' ')) GOTO 910 - IF (.NOT.NSCUMF(OMCA,V_E,'CDELT5',0E0, - 1 ' ')) GOTO 910 - IF (.NOT.NSCUMF(OMCA,V_E,'CRPIX5',1E0, - 1 ' ')) GOTO 910 - IF (.NOT.NSCUMF(OMCA,V_E,'CROTA5',0E0, - 1 ' ')) GOTO 910 - IF (.NOT.NSCUMS(OMCA,V_C,'CTYPE6','DEC--NCP', - 1 'DEC in degrees')) GOTO 910 - IF (.NOT.NSCUMF(OMCA,V_D,'CRVAL6',WNGDND(WNGDFD(STH(STH_DECE_1))), - 1 ' ')) GOTO 910 - IF (.NOT.NSCUMF(OMCA,V_E,'CDELT6',0E0, - 1 ' ')) GOTO 910 - IF (.NOT.NSCUMF(OMCA,V_E,'CRPIX6',1E0, - 1 ' ')) GOTO 910 - IF (.NOT.NSCUMF(OMCA,V_E,'CROTA6',0E0, - 1 ' ')) GOTO 910 -C - IF (.NOT.NSCUMF(OMCA,V_L,'GROUPS',.TRUE., - 1 'AIPS groups')) GOTO 910 - IF (.NOT.NSCUMF(OMCA,V_J,'GCOUNT',WNGGJ(STH(STH_NIFR_1))*NSCN, - 1 '# of visibility groups')) GOTO 910 - IF (.NOT.NSCUMF(OMCA,V_J,'PCOUNT',6, - 1 '# of random parameters')) GOTO 910 - IF (.NOT.NSCUMS(OMCA,V_C,'PTYPE1','UU', - 1 'U in sec')) GOTO 910 - IF (.NOT.NSCUMF(OMCA,V_D,'PSCAL1',1/DCL/10D0, - 1 ' ')) GOTO 910 - IF (.NOT.NSCUMF(OMCA,V_D,'PZERO1',0D0, - 1 ' ')) GOTO 910 - IF (.NOT.NSCUMS(OMCA,V_C,'PTYPE2','VV', - 1 'V in sec')) GOTO 910 - IF (.NOT.NSCUMF(OMCA,V_D,'PSCAL2',1/DCL/10D0, - 1 ' ')) GOTO 910 - IF (.NOT.NSCUMF(OMCA,V_D,'PZERO2',0D0, - 1 ' ')) GOTO 910 - IF (.NOT.NSCUMS(OMCA,V_C,'PTYPE3','WW', - 1 'W in sec')) GOTO 910 - IF (.NOT.NSCUMF(OMCA,V_D,'PSCAL3',1/DCL/10D0, - 1 ' ')) GOTO 910 - IF (.NOT.NSCUMF(OMCA,V_D,'PZERO3',0D0, - 1 ' ')) GOTO 910 - IF (.NOT.NSCUMS(OMCA,V_C,'PTYPE4','BASELINE', - 1 '256*west + east')) GOTO 910 - IF (.NOT.NSCUMF(OMCA,V_D,'PSCAL4',1D0, - 1 ' ')) GOTO 910 - IF (.NOT.NSCUMF(OMCA,V_D,'PZERO4',0D0, - 1 ' ')) GOTO 910 - IF (.NOT.NSCUMS(OMCA,V_C,'PTYPE5','DATE', - 1 'Time in JD since 01/01/80')) GOTO 910 - IF (.NOT.NSCUMF(OMCA,V_D,'PSCAL5',1D0, - 1 ' ')) GOTO 910 - IF (.NOT.NSCUMF(OMCA,V_D,'PZERO5',2.4442395D+6, - 1 ' ')) GOTO 910 - IF (.NOT.NSCUMS(OMCA,V_C,'PTYPE6','DATE', - 1 'Time in JD in 10s')) GOTO 910 - IF (.NOT.NSCUMF(OMCA,V_D,'PSCAL6',1D0/24D0/360D0, - 1 ' ')) GOTO 910 - IF (.NOT.NSCUMF(OMCA,V_D,'PZERO6',IATOFF, - 1 ' ')) GOTO 910 -CC IF (.NOT.NSCUMS(OMCA,V_C,'PTYPE7','FREQSEL', -CC 1 'FQ frequency id')) GOTO 910 -CC IF (.NOT.NSCUMF(OMCA,V_D,'PSCAL7',1D0, -CC 1 ' ')) GOTO 910 -CC IF (.NOT.NSCUMF(OMCA,V_D,'PZERO7',0D0, -CC 1 ' ')) GOTO 910 -C - IF (.NOT.NSCUMF(OMCA,V_Z,'HISTORY',J, - 1 '------------------------')) GOTO 910 - CALL WNCTXS(TXT,'!UJ',STH(STH_VNR_1)) - IF (.NOT.NSCUMF(OMCA,V_Z,'HISTORY',J, - 1 'SEQUENCE # = '//TXT)) GOTO 910 - CALL WNCTXS(TXT,'!EAF12.1',STH(STH_PHI_1)) - IF (.NOT.NSCUMF(OMCA,V_Z,'HISTORY',J, - 1 'ROTATION BY '// - 1 TXT(1:WNCALN(TXT))//' DEG')) GOTO 910 - DO I=1,WNGGI(SCW(SCW_NRPNCH_1)) !WSRT COMMENTS - CALL WNGMTS(80,SCW(SCW_PNCHI_1+(I-1)*80),TXT) - IF (.NOT.NSCUMF(OMCA,V_Z,'HISTORY',J, - 1 'WSRT: '//TXT)) GOTO 910 - END DO - IF (.NOT.NSCUMF(OMCA,V_Z,'HISTORY',J, - 1 'WEIGHT: TIME/Tsys '// - 1 'NORMALISED PER SCAN')) GOTO 910 - IF (WNGGI(OHW(OHW_MSPAT_1)).NE.0) THEN - CALL WNCTXS(TXT,'!UI',OHW(OHW_MSPAT_1)) - IF (.NOT.NSCUMF(OMCA,V_Z,'HISTORY',J, - 1 'MOSAIC PATTERN '//TXT)) GOTO 910 - CALL WNCTXS(TXT,'!UI',OHW(OHW_MPOSN_1)) - IF (.NOT.NSCUMF(OMCA,V_Z,'HISTORY',J, - 1 'MOSAIC POINTING '//TXT)) GOTO 910 - END IF - IF (.NOT.NSCUMF(OMCA,V_Z,'END',J, - 1 ' ')) GOTO 910 - IF (.NOT.NSCUWF(OMCA)) GOTO 910 !FILL RECORD -C -C END -C - GOTO 900 -C -C ERROR -C - 910 CONTINUE - NSCUV0=.FALSE. - 900 CONTINUE -C - RETURN !READY -C -C - END diff --git a/src/nscan/nscuv1.for b/src/nscan/nscuv1.for deleted file mode 100644 index e2b668b2d16926f0d67d76a098bbe7ce9ebd8942..0000000000000000000000000000000000000000 --- a/src/nscan/nscuv1.for +++ /dev/null @@ -1,238 +0,0 @@ -C+ NSCUV1.FOR -C WNB 910220 -C -C Revisions: -C CMV 970130 Minor changes in formats -C - LOGICAL FUNCTION NSCUV1(OMCA,NPOL,NFRQ,FRQTB,STPTB,STH,OHW,SCW, - 1 IATOFF,DATB,UT1UTC,GSTIAT) -C -C Write UVFITS Antenna table header -C -C Result: -C -C NSCUV1_L = NSCUV1_L( OMCA_J:I, NPOL_J:I, NFRQ_J:I, -C FRQTB_D:I, STPTB_D:I, STH_B(0:*):I, -C OHW_B(0:*):I, SCW_B(0:*):I, -C IATOFF_D:I, DATB_I(0:2):I, UT1UTC_D:I, -C GSTIAT_D:I) -C will write the UVFITS AN header. -C OMCA is the output file, NPOL and NFRQ the -C number of polarisation and frequency channels. -C STH, OHW and SCW are the Set header, the OH -C block and the SC block. -C IATOFF: jump seconds IAT-UTC in days -C DATB: reference date as y,m,d -C UT1UTC: UT1-UTC in days -C GSTIAT: GST at IAT=0 in days -C NFRQ: # of frequency points -C FRQTB: first frequency -C STPTB: step in frequency -C -C PIN references: -C -C -C Include files: -C - INCLUDE 'WNG_DEF' - INCLUDE 'STH_O_DEF' !SET HEADER - INCLUDE 'OHW_O_DEF' !OH BLOCK - INCLUDE 'SCW_O_DEF' !SC BLOCK -C -C Parameters: -C - INTEGER LRCLEN !RECORD LENGTH FITS (CHANGE ALSO NSCUWB) - PARAMETER (LRCLEN=2880) - INTEGER CDILEN !CARD IMAGE LENGTH - PARAMETER (CDILEN=80) - INTEGER NCDI !# OF CARD IMAGES/RECORD - PARAMETER (NCDI=LRCLEN/CDILEN) - INTEGER DBLEN !DATA BUFFER LENGTH - PARAMETER (DBLEN=512) !BYTES END IF - INTEGER V_Z,V_L,V_I,V_J,V_C,V_E,V_D,V_T, - 1 V_XI,V_XJ !CODES FOR FITS CARD LINES - PARAMETER (V_Z=0,V_L=1,V_I=2,V_J=3,V_C=4,V_E=5,V_D=6, - 1 V_T=7,V_XI=8,V_XJ=9) -C -C Arguments: -C - INTEGER OMCA !FILE POINTER - INTEGER NPOL !# OF POL. TO DO - INTEGER NFRQ !# OF FREQ. TO DO - DOUBLE PRECISION FRQTB !FIRST FREQUENCY - DOUBLE PRECISION STPTB !STEP IN FREQUENCY - BYTE STH(0:*) !SET HEADER - BYTE OHW(0:*) !OH BLOCK - BYTE SCW(0:*) !SC BLOCK - DOUBLE PRECISION IATOFF !LEAP SECONDS (DAYS) - INTEGER*2 DATB(0:2) !Y,M,D - DOUBLE PRECISION UT1UTC !UT1-UTC (DAYS) - DOUBLE PRECISION GSTIAT !GST FOR IAT=0 (DAYS) -C -C Function references: -C - DOUBLE PRECISION WNGGD !GET VALUE - LOGICAL NSCUWF !FILL FITS LINE - LOGICAL NSCUMF,NSCUMS !MAKE FITS LINE -C -C Data declarations: -C -C- -C -C INIT -C - NSCUV1=.TRUE. !ASSUME OK -C -C ANTENNA TABLE (AN) -C - IF (.NOT.NSCUMS(OMCA,V_C,'XTENSION','A3DTABLE', - 1 'Extension type')) GOTO 910 - IF (.NOT.NSCUMF(OMCA,V_J,'BITPIX',8, - 1 'Binary data')) GOTO 910 - IF (.NOT.NSCUMF(OMCA,V_J,'NAXIS',2, - 1 'Matrix')) GOTO 910 - IF (.NOT.NSCUMF(OMCA,V_J,'NAXIS1',74, - 1 'Table width')) GOTO 910 - IF (.NOT.NSCUMF(OMCA,V_J,'NAXIS2',STHTEL, - 1 'Table length')) GOTO 910 - IF (.NOT.NSCUMF(OMCA,V_J,'PCOUNT',0, - 1 '# random parameters')) GOTO 910 - IF (.NOT.NSCUMF(OMCA,V_J,'GCOUNT',1, - 1 '# of groups')) GOTO 910 -C - IF (.NOT.NSCUMS(OMCA,V_C,'EXTNAME','AIPS AN', - 1 'Type')) GOTO 910 - IF (.NOT.NSCUMF(OMCA,V_J,'EXTVER',1, - 1 'Version')) GOTO 910 - IF (.NOT.NSCUMF(OMCA,V_J,'EXTLEVEL',1, - 1 'Hierarchy')) GOTO 910 - IF (.NOT.NSCUMS(OMCA,V_C,'AUTHOR','NSCAN', - 1 'Produced by')) GOTO 910 - IF (.NOT.NSCUMS(OMCA,V_C,'REFERENC','NFRA-1', - 1 'Local contact')) GOTO 910 -C - IF (.NOT.NSCUMF(OMCA,V_J,'TFIELDS',12, - 1 'Fields per row')) GOTO 910 - IF (.NOT.NSCUMS(OMCA,V_C,'TFORM1','8A', - 1 'Fortran format')) GOTO 910 - IF (.NOT.NSCUMS(OMCA,V_C,'TTYPE1','ANNAME', - 1 'Antenne name')) GOTO 910 - IF (.NOT.NSCUMS(OMCA,V_C,'TUNIT1',' ', - 1 'No units')) GOTO 910 - IF (.NOT.NSCUMS(OMCA,V_C,'TFORM2','3D', - 1 'Fortran format')) GOTO 910 - IF (.NOT.NSCUMS(OMCA,V_C,'TTYPE2','STABXYZ', - 1 'Antenna positions')) GOTO 910 - IF (.NOT.NSCUMS(OMCA,V_C,'TUNIT2','METERS', - 1 'Units')) GOTO 910 - IF (.NOT.NSCUMS(OMCA,V_C,'TFORM3','0D', - 1 'Fortran format')) GOTO 910 - IF (.NOT.NSCUMS(OMCA,V_C,'TTYPE3','ORBPARM', - 1 'Orbital parameters')) GOTO 910 - IF (.NOT.NSCUMS(OMCA,V_C,'TUNIT3',' ', - 1 'No units')) GOTO 910 - IF (.NOT.NSCUMS(OMCA,V_C,'TFORM4','1I', - 1 'Fortran format')) GOTO 910 - IF (.NOT.NSCUMS(OMCA,V_C,'TTYPE4','NOSTA', - 1 'Station number (1...)')) GOTO 910 - IF (.NOT.NSCUMS(OMCA,V_C,'TUNIT4',' ', - 1 'No units')) GOTO 910 - IF (.NOT.NSCUMS(OMCA,V_C,'TFORM5','1I', - 1 'Fortran format')) GOTO 910 - IF (.NOT.NSCUMS(OMCA,V_C,'TTYPE5','MNTSTA', - 1 'Antenna mount:')) GOTO 910 - IF (.NOT.NSCUMS(OMCA,V_C,'TUNIT5',' ', - 1 'Units: 1=equatorial')) GOTO 910 - IF (.NOT.NSCUMS(OMCA,V_C,'TFORM6','1E', - 1 'Fortran format')) GOTO 910 - IF (.NOT.NSCUMS(OMCA,V_C,'TTYPE6','STAXOF', - 1 'Antenna axis ofdfset')) GOTO 910 - IF (.NOT.NSCUMS(OMCA,V_C,'TUNIT6','METERS', - 1 'Units')) GOTO 910 - IF (.NOT.NSCUMS(OMCA,V_C,'TFORM7','1A', - 1 'Fortran format')) GOTO 910 - IF (.NOT.NSCUMS(OMCA,V_C,'TTYPE7','POLTYA', - 1 'Pol. type first dipole')) GOTO 910 - IF (.NOT.NSCUMS(OMCA,V_C,'TUNIT7',' ', - 1 'Units: ''X''=X')) GOTO 910 - IF (.NOT.NSCUMS(OMCA,V_C,'TFORM8','1E', - 1 'Fortran format')) GOTO 910 - IF (.NOT.NSCUMS(OMCA,V_C,'TTYPE8','POLAA', - 1 'P.a. first dipole')) GOTO 910 - IF (.NOT.NSCUMS(OMCA,V_C,'TUNIT8','DEGREES', - 1 'Units')) GOTO 910 - IF (.NOT.NSCUMS(OMCA,V_C,'TFORM9','3E', - 1 'Fortran format')) GOTO 910 - IF (.NOT.NSCUMS(OMCA,V_C,'TTYPE9','POLCALA', - 1 'Pol. cal. param. (see POLTYPE)')) GOTO 910 - IF (.NOT.NSCUMS(OMCA,V_C,'TUNIT9',' ', - 1 'No units')) GOTO 910 - IF (.NOT.NSCUMS(OMCA,V_C,'TFORM10','1A', - 1 'Fortran format')) GOTO 910 - IF (.NOT.NSCUMS(OMCA,V_C,'TTYPE10','POLTYB', - 1 'Second dipole')) GOTO 910 - IF (.NOT.NSCUMS(OMCA,V_C,'TUNIT10',' ', - 1 'No units')) GOTO 910 - IF (.NOT.NSCUMS(OMCA,V_C,'TFORM11','1E', - 1 'Fortran format')) GOTO 910 - IF (.NOT.NSCUMS(OMCA,V_C,'TTYPE11','POLAB', - 1 'Second dipole')) GOTO 910 - IF (.NOT.NSCUMS(OMCA,V_C,'TUNIT11','DEGREES', - 1 'Units')) GOTO 910 - IF (.NOT.NSCUMS(OMCA,V_C,'TFORM12','3E', - 1 'Fortran format')) GOTO 910 - IF (.NOT.NSCUMS(OMCA,V_C,'TTYPE12','POLCALB', - 1 'Second dipole')) GOTO 910 - IF (.NOT.NSCUMS(OMCA,V_C,'TUNIT12',' ', - 1 'No units')) GOTO 910 -C - IF (.NOT.NSCUMF(OMCA,V_D,'ARRAYX',3828440.6381D0, - 1 'X position array (earth centred')) GOTO 910 - IF (.NOT.NSCUMF(OMCA,V_D,'ARRAYY',445226.0299D0, - 1 'Y position array (Mk3 system)')) GOTO 910 - IF (.NOT.NSCUMF(OMCA,V_D,'ARRAYZ',5064923.0797D0, - 1 'Z position array (meters)')) GOTO 910 - IF (.NOT.NSCUMF(OMCA,V_D,'GSTIA0',360D0*GSTIAT, - 1 'GST at IAT=0 on RDATE')) GOTO 910 - IF (.NOT.NSCUMF(OMCA,V_D,'DEGPDY',360D0*WNGGD(STH(STH_UTST_1)), - 1 'Earth rotation rate(deg/day)')) GOTO 910 - IF (.NOT.NSCUMF(OMCA,V_D,'FREQ', - 1 (FRQTB+((NFRQ-1)/2)*STPTB)*1D6, - 1 'Reference frequency (Hz)')) GOTO 910 - IF (.NOT.NSCUMF(OMCA,V_T,'RDATE',DATB, - 1 'Reference date')) GOTO 910 - IF (.NOT.NSCUMF(OMCA,V_D,'POLARX',0D0, - 1 'North pole X on RDATE (meters)')) GOTO 910 - IF (.NOT.NSCUMF(OMCA,V_D,'POLARY',0D0, - 1 'North pole Y on RDATE')) GOTO 910 - IF (.NOT.NSCUMF(OMCA,V_D,'IATUTC',IATOFF*24D0*3600D0, - 1 'IAT-UTC on RDATE (s)')) GOTO 910 - IF (.NOT.NSCUMF(OMCA,V_D,'UT1UTC',UT1UTC*24D0*3600D0, - 1 'UT1-UTC on RDATE (s)')) GOTO 910 - IF (.NOT.NSCUMS(OMCA,V_C,'ARRNAM','WSRT', - 1 'Telescope')) GOTO 910 - IF (.NOT.NSCUMF(OMCA,V_J,'NUMORB',0, - 1 '# telescopes in orbit')) GOTO 910 - IF (.NOT.NSCUMF(OMCA,V_J,'NOPCAL',3, - 1 '# pol. cal. parameters')) GOTO 910 - IF (.NOT.NSCUMS(OMCA,V_C,'POLTYPE','X-Y LIN', - 1 'Type of polarisation')) GOTO 910 -C - IF (.NOT.NSCUMF(OMCA,V_Z,'END',J, - 1 ' ')) GOTO 910 - IF (.NOT.NSCUWF(OMCA)) GOTO 910 !FILL RECORD -C -C END -C - GOTO 900 -C -C ERROR -C - 910 CONTINUE - NSCUV1=.FALSE. - 900 CONTINUE -C - RETURN !READY -C -C - END diff --git a/src/nscan/nscuv2.for b/src/nscan/nscuv2.for deleted file mode 100644 index dccc42c1e875b9ee9734f5d8eafcb1c650feb292..0000000000000000000000000000000000000000 --- a/src/nscan/nscuv2.for +++ /dev/null @@ -1,148 +0,0 @@ -C+ NSCUV2.FOR -C WNB 910220 -C -C Revisions: -C - LOGICAL FUNCTION NSCUV2(OMCA,NPOL,NFRQ,STH,OHW,SCW) -C -C Write UVFITS Frequency table header -C -C Result: -C -C NSCUV2_L = NSCUV2_L( OMCA_J:I, NPOL_J:I, NFRQ_J:I, STH_B(0:*):I, -C OHW_B(0:*):I, SCW_B(0:*):I) -C will write the UVFITS FQ header. -C OMCA is the output file, NPOL and NFRQ the -C number of polarisation and frequency channels. -C STH, OHW and SCW are the Set header, the OH -C block and the SC block. -C -C PIN references: -C -C -C Include files: -C - INCLUDE 'WNG_DEF' - INCLUDE 'STH_O_DEF' !SET HEADER - INCLUDE 'OHW_O_DEF' !OH BLOCK - INCLUDE 'SCW_O_DEF' !SC BLOCK -C -C Parameters: -C - INTEGER LRCLEN !RECORD LENGTH FITS (CHANGE ALSO NSCUWB) - PARAMETER (LRCLEN=2880) - INTEGER CDILEN !CARD IMAGE LENGTH - PARAMETER (CDILEN=80) - INTEGER NCDI !# OF CARD IMAGES/RECORD - PARAMETER (NCDI=LRCLEN/CDILEN) - INTEGER DBLEN !DATA BUFFER LENGTH - PARAMETER (DBLEN=512) !BYTES END IF - INTEGER V_Z,V_L,V_I,V_J,V_C,V_E,V_D,V_T, - 1 V_XI,V_XJ !CODES FOR FITS CARD LINES - PARAMETER (V_Z=0,V_L=1,V_I=2,V_J=3,V_C=4,V_E=5,V_D=6, - 1 V_T=7,V_XI=8,V_XJ=9) -C -C Arguments: -C - INTEGER OMCA !FILE POINTER - INTEGER NPOL !# OF POL. TO DO - INTEGER NFRQ !# OF FREQ. TO DO - BYTE STH(0:*) !SET HEADER - BYTE OHW(0:*) !OH BLOCK - BYTE SCW(0:*) !SC BLOCK -C -C Function references: -C - LOGICAL NSCUWF !FILL FITS LINE - LOGICAL NSCUMF,NSCUMS !MAKE FITS LINE -C -C Data declarations: -C -C- -C -C INIT -C - NSCUV2=.TRUE. !ASSUME OK -C -C FREQUENCY TABLE (FQ) -C - IF (.NOT.NSCUMS(OMCA,V_C,'XTENSION','A3DTABLE', - 1 'Extension type')) GOTO 910 - IF (.NOT.NSCUMF(OMCA,V_J,'BITPIX',8, - 1 'Binary data')) GOTO 910 - IF (.NOT.NSCUMF(OMCA,V_J,'NAXIS',2, - 1 'Matrix')) GOTO 910 - IF (.NOT.NSCUMF(OMCA,V_J,'NAXIS1',20, - 1 'Table width')) GOTO 910 - IF (.NOT.NSCUMF(OMCA,V_J,'NAXIS2',NFRQ, - 1 'Table length')) GOTO 910 - IF (.NOT.NSCUMF(OMCA,V_J,'PCOUNT',0, - 1 '# random parameters')) GOTO 910 - IF (.NOT.NSCUMF(OMCA,V_J,'GCOUNT',1, - 1 '# of groups')) GOTO 910 -C - IF (.NOT.NSCUMS(OMCA,V_C,'EXTNAME','AIPS FQ', - 1 'Type')) GOTO 910 - IF (.NOT.NSCUMF(OMCA,V_J,'EXTVER',1, - 1 'Version')) GOTO 910 - IF (.NOT.NSCUMF(OMCA,V_J,'EXTLEVEL',1, - 1 'Hierarchy')) GOTO 910 - IF (.NOT.NSCUMS(OMCA,V_C,'AUTHOR','WNB', - 1 'Produced by')) GOTO 910 - IF (.NOT.NSCUMS(OMCA,V_C,'REFERENC','NFRA-1', - 1 'Local contact')) GOTO 910 -C - IF (.NOT.NSCUMF(OMCA,V_J,'TFIELDS',5, - 1 'Fields per row')) GOTO 910 - IF (.NOT.NSCUMS(OMCA,V_C,'TFORM1','1I', - 1 'Fortran format')) GOTO 910 - IF (.NOT.NSCUMS(OMCA,V_C,'TTYPE1','FRQSEL', - 1 'Number in FQID')) GOTO 910 - IF (.NOT.NSCUMS(OMCA,V_C,'TUNIT1',' ', - 1 'No units')) GOTO 910 - IF (.NOT.NSCUMS(OMCA,V_C,'TFORM2','1D', - 1 'Fortran format')) GOTO 910 - IF (.NOT.NSCUMS(OMCA,V_C,'TTYPE2','IF FREQ', - 1 'Offset from ref. frequency')) GOTO 910 - IF (.NOT.NSCUMS(OMCA,V_C,'TUNIT2','HZ', - 1 'Units')) GOTO 910 - IF (.NOT.NSCUMS(OMCA,V_C,'TFORM3','1E', - 1 'Fortran format')) GOTO 910 - IF (.NOT.NSCUMS(OMCA,V_C,'TTYPE3','CH WIDTH', - 1 'Channel bandwidth')) GOTO 910 - IF (.NOT.NSCUMS(OMCA,V_C,'TUNIT3','HZ', - 1 'Units')) GOTO 910 - IF (.NOT.NSCUMS(OMCA,V_C,'TFORM4','1E', - 1 'Fortran format')) GOTO 910 - IF (.NOT.NSCUMS(OMCA,V_C,'TTYPE4','TOTAL BANDWIDTH', - 1 'IF bandwidth')) GOTO 910 - IF (.NOT.NSCUMS(OMCA,V_C,'TUNIT4','HZ', - 1 'Units')) GOTO 910 - IF (.NOT.NSCUMS(OMCA,V_C,'TFORM5','1I', - 1 'Fortran format')) GOTO 910 - IF (.NOT.NSCUMS(OMCA,V_C,'TTYPE5','SIDEBAND', - 1 'Sideband type')) GOTO 910 - IF (.NOT.NSCUMS(OMCA,V_C,'TUNIT5',' ', - 1 'Units: +1 or -1')) GOTO 910 -C - IF (.NOT.NSCUMF(OMCA,V_J,'NO_IF',1, - 1 '# of IFs')) GOTO 910 -C - IF (.NOT.NSCUMF(OMCA,V_Z,'END',J, - 1 ' ')) GOTO 910 - IF (.NOT.NSCUWF(OMCA)) GOTO 910 !FILL RECORD -C -C END -C - GOTO 900 -C -C ERROR -C - 910 CONTINUE - NSCUV2=.FALSE. - 900 CONTINUE -C - RETURN !READY -C -C - END diff --git a/src/nscan/nscuv3.for b/src/nscan/nscuv3.for deleted file mode 100644 index b7496c4d8c15e64fb1d25559b0c1fa6ecd6f6c8d..0000000000000000000000000000000000000000 --- a/src/nscan/nscuv3.for +++ /dev/null @@ -1,236 +0,0 @@ -C+ NSCUV3.FOR -C WNB 910220 -C -C Revisions: -C - LOGICAL FUNCTION NSCUV3(OMCA,NPOL,NFRQ,STH,OHW,SCW) -C -C Write UVFITS Source table header -C -C Result: -C -C NSCUV3_L = NSCUV3_L( OMCA_J:I, NPOL_J:I, NFRQ_J:I, STH_B(0:*):I, -C OHW_B(0:*):I, SCW_B(0:*):I) -C will write the UVFITS SU header. -C OMCA is the output file, NPOL and NFRQ the -C number of polarisation and frequency channels. -C STH, OHW and SCW are the Set header, the OH -C block and the SC block. -C -C PIN references: -C -C -C Include files: -C - INCLUDE 'WNG_DEF' - INCLUDE 'STH_O_DEF' !SET HEADER - INCLUDE 'OHW_O_DEF' !OH BLOCK - INCLUDE 'SCW_O_DEF' !SC BLOCK -C -C Parameters: -C - INTEGER LRCLEN !RECORD LENGTH FITS (CHANGE ALSO NSCUWB) - PARAMETER (LRCLEN=2880) - INTEGER CDILEN !CARD IMAGE LENGTH - PARAMETER (CDILEN=80) - INTEGER NCDI !# OF CARD IMAGES/RECORD - PARAMETER (NCDI=LRCLEN/CDILEN) - INTEGER DBLEN !DATA BUFFER LENGTH - PARAMETER (DBLEN=512) !BYTES END IF - INTEGER V_Z,V_L,V_I,V_J,V_C,V_E,V_D,V_T, - 1 V_XI,V_XJ !CODES FOR FITS CARD LINES - PARAMETER (V_Z=0,V_L=1,V_I=2,V_J=3,V_C=4,V_E=5,V_D=6, - 1 V_T=7,V_XI=8,V_XJ=9) -C -C Arguments: -C - INTEGER OMCA !FILE POINTER - INTEGER NPOL !# OF POL. TO DO - INTEGER NFRQ !# OF FREQ. TO DO - BYTE STH(0:*) !SET HEADER - BYTE OHW(0:*) !OH BLOCK - BYTE SCW(0:*) !SC BLOCK -C -C Function references: -C - LOGICAL NSCUWF !FILL FITS LINE - LOGICAL NSCUMF,NSCUMS !MAKE FITS LINE -C -C Data declarations: -C -C- -C -C INIT -C - NSCUV3=.TRUE. !ASSUME OK -C -C SOURCE TABLE (SU) -C - IF (.NOT.NSCUMS(OMCA,V_C,'XTENSION','A3DTABLE', - 1 'Extension type')) GOTO 910 - IF (.NOT.NSCUMF(OMCA,V_J,'BITPIX',8, - 1 'Binary data')) GOTO 910 - IF (.NOT.NSCUMF(OMCA,V_J,'NAXIS',2, - 1 'Matrix')) GOTO 910 - IF (.NOT.NSCUMF(OMCA,V_J,'NAXIS1',128, - 1 'Table width')) GOTO 910 - IF (.NOT.NSCUMF(OMCA,V_J,'NAXIS2',1, - 1 'Table length')) GOTO 910 - IF (.NOT.NSCUMF(OMCA,V_J,'PCOUNT',0, - 1 '# random parameters')) GOTO 910 - IF (.NOT.NSCUMF(OMCA,V_J,'GCOUNT',1, - 1 '# of groups')) GOTO 910 -C - IF (.NOT.NSCUMS(OMCA,V_C,'EXTNAME','AIPS SU', - 1 'Type')) GOTO 910 - IF (.NOT.NSCUMF(OMCA,V_J,'EXTVER',1, - 1 'Version')) GOTO 910 - IF (.NOT.NSCUMF(OMCA,V_J,'EXTLEVEL',1, - 1 'Hierarchy')) GOTO 910 - IF (.NOT.NSCUMS(OMCA,V_C,'AUTHOR','WNB', - 1 'Produced by')) GOTO 910 - IF (.NOT.NSCUMS(OMCA,V_C,'REFERENC','NFRA-1', - 1 'Local contact')) GOTO 910 -C - IF (.NOT.NSCUMF(OMCA,V_J,'TFIELDS',19, - 1 'Fields per row')) GOTO 910 - IF (.NOT.NSCUMS(OMCA,V_C,'TFORM1','1I', - 1 'Fortran format')) GOTO 910 - IF (.NOT.NSCUMS(OMCA,V_C,'TTYPE1','ID. NO.', - 1 'Name field')) GOTO 910 - IF (.NOT.NSCUMS(OMCA,V_C,'TUNIT1',' ', - 1 'Units field')) GOTO 910 - IF (.NOT.NSCUMS(OMCA,V_C,'TFORM2','16A', - 1 'Fortran format')) GOTO 910 - IF (.NOT.NSCUMS(OMCA,V_C,'TTYPE2','SOURCE', - 1 'Name field')) GOTO 910 - IF (.NOT.NSCUMS(OMCA,V_C,'TUNIT2',' ', - 1 'Units field')) GOTO 910 - IF (.NOT.NSCUMS(OMCA,V_C,'TFORM3','1I', - 1 'Fortran format')) GOTO 910 - IF (.NOT.NSCUMS(OMCA,V_C,'TTYPE3','QUAL', - 1 'Name field')) GOTO 910 - IF (.NOT.NSCUMS(OMCA,V_C,'TUNIT3',' ', - 1 'Units field')) GOTO 910 - IF (.NOT.NSCUMS(OMCA,V_C,'TFORM4','4A', - 1 'Fortran format')) GOTO 910 - IF (.NOT.NSCUMS(OMCA,V_C,'TTYPE4','CALCODE', - 1 'Name field')) GOTO 910 - IF (.NOT.NSCUMS(OMCA,V_C,'TUNIT4',' ', - 1 'Units field')) GOTO 910 - IF (.NOT.NSCUMS(OMCA,V_C,'TFORM5','1E', - 1 'Fortran format')) GOTO 910 - IF (.NOT.NSCUMS(OMCA,V_C,'TTYPE5','IFLUX', - 1 'Name field')) GOTO 910 - IF (.NOT.NSCUMS(OMCA,V_C,'TUNIT5','JY', - 1 'Units field')) GOTO 910 - IF (.NOT.NSCUMS(OMCA,V_C,'TFORM6','1E', - 1 'Fortran format')) GOTO 910 - IF (.NOT.NSCUMS(OMCA,V_C,'TTYPE6','QFLUX', - 1 'Name field')) GOTO 910 - IF (.NOT.NSCUMS(OMCA,V_C,'TUNIT6','JY', - 1 'Units field')) GOTO 910 - IF (.NOT.NSCUMS(OMCA,V_C,'TFORM7','1E', - 1 'Fortran format')) GOTO 910 - IF (.NOT.NSCUMS(OMCA,V_C,'TTYPE7','UFLUX', - 1 'Name field')) GOTO 910 - IF (.NOT.NSCUMS(OMCA,V_C,'TUNIT7','JY', - 1 'Units field')) GOTO 910 - IF (.NOT.NSCUMS(OMCA,V_C,'TFORM8','1E', - 1 'Fortran format')) GOTO 910 - IF (.NOT.NSCUMS(OMCA,V_C,'TTYPE8','VFLUX', - 1 'Name field')) GOTO 910 - IF (.NOT.NSCUMS(OMCA,V_C,'TUNIT8','JY', - 1 'Units field')) GOTO 910 - IF (.NOT.NSCUMS(OMCA,V_C,'TFORM9','1D', - 1 'Fortran format')) GOTO 910 - IF (.NOT.NSCUMS(OMCA,V_C,'TTYPE9','FRQOFF', - 1 'Name field')) GOTO 910 - IF (.NOT.NSCUMS(OMCA,V_C,'TUNIT9','HZ', - 1 'Units field')) GOTO 910 - IF (.NOT.NSCUMS(OMCA,V_C,'TFORM10','1D', - 1 'Fortran format')) GOTO 910 - IF (.NOT.NSCUMS(OMCA,V_C,'TTYPE10','BANDWIDTH', - 1 'Name field')) GOTO 910 - IF (.NOT.NSCUMS(OMCA,V_C,'TUNIT10','HZ', - 1 'Units field')) GOTO 910 - IF (.NOT.NSCUMS(OMCA,V_C,'TFORM11','1D', - 1 'Fortran format')) GOTO 910 - IF (.NOT.NSCUMS(OMCA,V_C,'TTYPE11','RAEPO', - 1 'Name field')) GOTO 910 - IF (.NOT.NSCUMS(OMCA,V_C,'TUNIT11','DEGREES', - 1 'Units field')) GOTO 910 - IF (.NOT.NSCUMS(OMCA,V_C,'TFORM12','1D', - 1 'Fortran format')) GOTO 910 - IF (.NOT.NSCUMS(OMCA,V_C,'TTYPE12','DECEPO', - 1 'Name field')) GOTO 910 - IF (.NOT.NSCUMS(OMCA,V_C,'TUNIT12','DEGREES', - 1 'Units field')) GOTO 910 - IF (.NOT.NSCUMS(OMCA,V_C,'TFORM13','1D', - 1 'Fortran format')) GOTO 910 - IF (.NOT.NSCUMS(OMCA,V_C,'TTYPE13','EPOCH', - 1 'Name field')) GOTO 910 - IF (.NOT.NSCUMS(OMCA,V_C,'TUNIT13','YEARS', - 1 'Units field')) GOTO 910 - IF (.NOT.NSCUMS(OMCA,V_C,'TFORM14','1D', - 1 'Fortran format')) GOTO 910 - IF (.NOT.NSCUMS(OMCA,V_C,'TTYPE14','RAAPP', - 1 'Name field')) GOTO 910 - IF (.NOT.NSCUMS(OMCA,V_C,'TUNIT14','DEGREES', - 1 'Units field')) GOTO 910 - IF (.NOT.NSCUMS(OMCA,V_C,'TFORM15','1D', - 1 'Fortran format')) GOTO 910 - IF (.NOT.NSCUMS(OMCA,V_C,'TTYPE15','DECAPP', - 1 'Name field')) GOTO 910 - IF (.NOT.NSCUMS(OMCA,V_C,'TUNIT15','DEGREES', - 1 'Units field')) GOTO 910 - IF (.NOT.NSCUMS(OMCA,V_C,'TFORM16','1D', - 1 'Fortran format')) GOTO 910 - IF (.NOT.NSCUMS(OMCA,V_C,'TTYPE16','LSRVEL', - 1 'Name field')) GOTO 910 - IF (.NOT.NSCUMS(OMCA,V_C,'TUNIT16','M/SEC', - 1 'Units field')) GOTO 910 - IF (.NOT.NSCUMS(OMCA,V_C,'TFORM17','1D', - 1 'Fortran format')) GOTO 910 - IF (.NOT.NSCUMS(OMCA,V_C,'TTYPE17','RESTFREQ', - 1 'Name field')) GOTO 910 - IF (.NOT.NSCUMS(OMCA,V_C,'TUNIT17','HZ', - 1 'Units field')) GOTO 910 - IF (.NOT.NSCUMS(OMCA,V_C,'TFORM18','1D', - 1 'Fortran format')) GOTO 910 - IF (.NOT.NSCUMS(OMCA,V_C,'TTYPE18','PMRA', - 1 'Name field')) GOTO 910 - IF (.NOT.NSCUMS(OMCA,V_C,'TUNIT18','DEG/DAY', - 1 'Units field')) GOTO 910 - IF (.NOT.NSCUMS(OMCA,V_C,'TFORM19','1D', - 1 'Fortran format')) GOTO 910 - IF (.NOT.NSCUMS(OMCA,V_C,'TTYPE19','PMDEC', - 1 'Name field')) GOTO 910 - IF (.NOT.NSCUMS(OMCA,V_C,'TUNIT19','DEG/DAY', - 1 'Units field')) GOTO 910 -C - IF (.NOT.NSCUMF(OMCA,V_J,'NO_IF',1, - 1 '# of IF pairs')) GOTO 910 - IF (.NOT.NSCUMS(OMCA,V_C,'VELTYPE','TOPOCENT', - 1 'Velocity reference')) GOTO 910 - IF (.NOT.NSCUMS(OMCA,V_C,'VELDEF','RADIO', - 1 'Type of velocity')) GOTO 910 -C - IF (.NOT.NSCUMF(OMCA,V_Z,'END',J, - 1 ' ')) GOTO 910 - IF (.NOT.NSCUWF(OMCA)) GOTO 910 !FILL RECORD -C -C END -C - GOTO 900 -C -C ERROR -C - 910 CONTINUE - NSCUV3=.FALSE. - 900 CONTINUE -C - RETURN !READY -C -C - END diff --git a/src/nscan/nscuv4.for b/src/nscan/nscuv4.for deleted file mode 100644 index c77147140d07a594b449c9f8df9f850f1a4c0f5f..0000000000000000000000000000000000000000 --- a/src/nscan/nscuv4.for +++ /dev/null @@ -1,242 +0,0 @@ -C+ NSCUV4.FOR -C WNB 910220 -C -C Revisions: -C - LOGICAL FUNCTION NSCUV4(OMCA,NPOL,NFRQ,STH,OHW,SCW) -C -C Write UVFITS Gain table header -C -C Result: -C -C NSCUV4_L = NSCUV4_L( OMCA_J:I, NPOL_J:I, NFRQ_J:I, STH_B(0:*):I, -C OHW_B(0:*):I, SCW_B(0:*):I) -C will write the UVFITS SN header. -C OMCA is the output file, NPOL and NFRQ the -C number of polarisation and frequency channels. -C STH, OHW and SCW are the Set header, the OH -C block and the SC block. -C -C PIN references: -C -C -C Include files: -C - INCLUDE 'WNG_DEF' - INCLUDE 'STH_O_DEF' !SET HEADER - INCLUDE 'OHW_O_DEF' !OH BLOCK - INCLUDE 'SCW_O_DEF' !SC BLOCK -C -C Parameters: -C - INTEGER LRCLEN !RECORD LENGTH FITS (CHANGE ALSO NSCUWB) - PARAMETER (LRCLEN=2880) - INTEGER CDILEN !CARD IMAGE LENGTH - PARAMETER (CDILEN=80) - INTEGER NCDI !# OF CARD IMAGES/RECORD - PARAMETER (NCDI=LRCLEN/CDILEN) - INTEGER DBLEN !DATA BUFFER LENGTH - PARAMETER (DBLEN=512) !BYTES END IF - INTEGER V_Z,V_L,V_I,V_J,V_C,V_E,V_D,V_T, - 1 V_XI,V_XJ !CODES FOR FITS CARD LINES - PARAMETER (V_Z=0,V_L=1,V_I=2,V_J=3,V_C=4,V_E=5,V_D=6, - 1 V_T=7,V_XI=8,V_XJ=9) -C -C Arguments: -C - INTEGER OMCA !FILE POINTER - INTEGER NPOL !# OF POL. TO DO - INTEGER NFRQ !# OF FREQ. TO DO - BYTE STH(0:*) !SET HEADER - BYTE OHW(0:*) !OH BLOCK - BYTE SCW(0:*) !SC BLOCK -C -C Function references: -C - LOGICAL NSCUWF !FILL FITS LINE - LOGICAL NSCUMF,NSCUMS !MAKE FITS LINE -C -C Data declarations: -C -C- -C -C INIT -C - NSCUV4=.TRUE. !ASSUME OK -C -C GAIN TABLE (SN) -C - IF (.NOT.NSCUMS(OMCA,V_C,'XTENSION','A3DTABLE', - 1 'Extension type')) GOTO 910 - IF (.NOT.NSCUMF(OMCA,V_J,'BITPIX',8, - 1 'Binary data')) GOTO 910 - IF (.NOT.NSCUMF(OMCA,V_J,'NAXIS',2, - 1 'Matrix')) GOTO 910 - IF (.NOT.NSCUMF(OMCA,V_J,'NAXIS1',64, - 1 'Table width')) GOTO 910 - IF (.NOT.NSCUMF(OMCA,V_J,'NAXIS2',STHTEL, - 1 'Table length')) GOTO 910 - IF (.NOT.NSCUMF(OMCA,V_J,'PCOUNT',0, - 1 '# random parameters')) GOTO 910 - IF (.NOT.NSCUMF(OMCA,V_J,'GCOUNT',1, - 1 '# of groups')) GOTO 910 -C - IF (.NOT.NSCUMS(OMCA,V_C,'EXTNAME','AIPS SN', - 1 'Type')) GOTO 910 - IF (.NOT.NSCUMF(OMCA,V_J,'EXTVER',1, - 1 'Version')) GOTO 910 - IF (.NOT.NSCUMF(OMCA,V_J,'EXTLEVEL',1, - 1 'Hierarchy')) GOTO 910 - IF (.NOT.NSCUMS(OMCA,V_C,'AUTHOR','WNB', - 1 'Produced by')) GOTO 910 - IF (.NOT.NSCUMS(OMCA,V_C,'REFERENC','NFRA-1', - 1 'Local contact')) GOTO 910 -C - IF (.NOT.NSCUMF(OMCA,V_J,'TFIELDS',18, - 1 'Fields per row')) GOTO 910 - IF (.NOT.NSCUMS(OMCA,V_C,'TFORM1','1D', - 1 'Fortran format')) GOTO 910 - IF (.NOT.NSCUMS(OMCA,V_C,'TTYPE1','TIME', - 1 'Name field')) GOTO 910 - IF (.NOT.NSCUMS(OMCA,V_C,'TUNIT1','DAYS', - 1 'Units field')) GOTO 910 - IF (.NOT.NSCUMS(OMCA,V_C,'TFORM2','1E', - 1 'Fortran format')) GOTO 910 - IF (.NOT.NSCUMS(OMCA,V_C,'TTYPE2','TIME INTERVAL', - 1 'Name field')) GOTO 910 - IF (.NOT.NSCUMS(OMCA,V_C,'TUNIT2','DAYS', - 1 'Units field')) GOTO 910 - IF (.NOT.NSCUMS(OMCA,V_C,'TFORM3','1I', - 1 'Fortran format')) GOTO 910 - IF (.NOT.NSCUMS(OMCA,V_C,'TTYPE3','SOURCE ID', - 1 'Name field')) GOTO 910 - IF (.NOT.NSCUMS(OMCA,V_C,'TUNIT3',' ', - 1 'Units field')) GOTO 910 - IF (.NOT.NSCUMS(OMCA,V_C,'TFORM4','1I', - 1 'Fortran format')) GOTO 910 - IF (.NOT.NSCUMS(OMCA,V_C,'TTYPE4','ANTENNA NO.', - 1 'Name field')) GOTO 910 - IF (.NOT.NSCUMS(OMCA,V_C,'TUNIT4',' ', - 1 'Units field')) GOTO 910 - IF (.NOT.NSCUMS(OMCA,V_C,'TFORM5','1I', - 1 'Fortran format')) GOTO 910 - IF (.NOT.NSCUMS(OMCA,V_C,'TTYPE5','SUBARRAY', - 1 'Name field')) GOTO 910 - IF (.NOT.NSCUMS(OMCA,V_C,'TUNIT5',' ', - 1 'Units field')) GOTO 910 - IF (.NOT.NSCUMS(OMCA,V_C,'TFORM6','1I', - 1 'Fortran format')) GOTO 910 - IF (.NOT.NSCUMS(OMCA,V_C,'TTYPE6','NODE NO.', - 1 'Name field')) GOTO 910 - IF (.NOT.NSCUMS(OMCA,V_C,'TUNIT6',' ', - 1 'Units field')) GOTO 910 - IF (.NOT.NSCUMS(OMCA,V_C,'TFORM7','1E', - 1 'Fortran format')) GOTO 910 - IF (.NOT.NSCUMS(OMCA,V_C,'TTYPE7','REAL1', - 1 'Name field')) GOTO 910 - IF (.NOT.NSCUMS(OMCA,V_C,'TUNIT7',' ', - 1 'Units field')) GOTO 910 - IF (.NOT.NSCUMS(OMCA,V_C,'TFORM8','1E', - 1 'Fortran format')) GOTO 910 - IF (.NOT.NSCUMS(OMCA,V_C,'TTYPE8','IMAG1', - 1 'Name field')) GOTO 910 - IF (.NOT.NSCUMS(OMCA,V_C,'TUNIT8',' ', - 1 'Units field')) GOTO 910 - IF (.NOT.NSCUMS(OMCA,V_C,'TFORM9','1E', - 1 'Fortran format')) GOTO 910 - IF (.NOT.NSCUMS(OMCA,V_C,'TTYPE9','DELAY 1', - 1 'Name field')) GOTO 910 - IF (.NOT.NSCUMS(OMCA,V_C,'TUNIT9','SECONDS', - 1 'Units field')) GOTO 910 - IF (.NOT.NSCUMS(OMCA,V_C,'TFORM10','1E', - 1 'Fortran format')) GOTO 910 - IF (.NOT.NSCUMS(OMCA,V_C,'TTYPE10','RATE 1', - 1 'Name field')) GOTO 910 - IF (.NOT.NSCUMS(OMCA,V_C,'TUNIT10','SEC/SEC', - 1 'Units field')) GOTO 910 - IF (.NOT.NSCUMS(OMCA,V_C,'TFORM11','1E', - 1 'Fortran format')) GOTO 910 - IF (.NOT.NSCUMS(OMCA,V_C,'TTYPE11','WEIGHT 1', - 1 'Name field')) GOTO 910 - IF (.NOT.NSCUMS(OMCA,V_C,'TUNIT11',' ', - 1 'Units field')) GOTO 910 - IF (.NOT.NSCUMS(OMCA,V_C,'TFORM12','1I', - 1 'Fortran format')) GOTO 910 - IF (.NOT.NSCUMS(OMCA,V_C,'TTYPE12','REFANT 1', - 1 'Name field')) GOTO 910 - IF (.NOT.NSCUMS(OMCA,V_C,'TUNIT12',' ', - 1 'Units field')) GOTO 910 - IF (.NOT.NSCUMS(OMCA,V_C,'TFORM13','1E', - 1 'Fortran format')) GOTO 910 - IF (.NOT.NSCUMS(OMCA,V_C,'TTYPE13','REAL 2', - 1 'Name field')) GOTO 910 - IF (.NOT.NSCUMS(OMCA,V_C,'TUNIT13',' ', - 1 'Units field')) GOTO 910 - IF (.NOT.NSCUMS(OMCA,V_C,'TFORM14','1E', - 1 'Fortran format')) GOTO 910 - IF (.NOT.NSCUMS(OMCA,V_C,'TTYPE14','IMAG 2', - 1 'Name field')) GOTO 910 - IF (.NOT.NSCUMS(OMCA,V_C,'TUNIT14',' ', - 1 'Units field')) GOTO 910 - IF (.NOT.NSCUMS(OMCA,V_C,'TFORM15','1E', - 1 'Fortran format')) GOTO 910 - IF (.NOT.NSCUMS(OMCA,V_C,'TTYPE15','DELAY 2', - 1 'Name field')) GOTO 910 - IF (.NOT.NSCUMS(OMCA,V_C,'TUNIT15','SECONDS', - 1 'Units field')) GOTO 910 - IF (.NOT.NSCUMS(OMCA,V_C,'TFORM16','1E', - 1 'Fortran format')) GOTO 910 - IF (.NOT.NSCUMS(OMCA,V_C,'TTYPE16','RATE 2', - 1 'Name field')) GOTO 910 - IF (.NOT.NSCUMS(OMCA,V_C,'TUNIT16','SEC/SEC', - 1 'Units field')) GOTO 910 - IF (.NOT.NSCUMS(OMCA,V_C,'TFORM17','1E', - 1 'Fortran format')) GOTO 910 - IF (.NOT.NSCUMS(OMCA,V_C,'TTYPE17','WEIGHT 2', - 1 'Name field')) GOTO 910 - IF (.NOT.NSCUMS(OMCA,V_C,'TUNIT17',' ', - 1 'Units field')) GOTO 910 - IF (.NOT.NSCUMS(OMCA,V_C,'TFORM18','1I', - 1 'Fortran format')) GOTO 910 - IF (.NOT.NSCUMS(OMCA,V_C,'TTYPE18','REFANT 2', - 1 'Name field')) GOTO 910 - IF (.NOT.NSCUMS(OMCA,V_C,'TUNIT18',' ', - 1 'Units field')) GOTO 910 -C - IF (.NOT.NSCUMF(OMCA,V_J,'NO_ANT',STHTEL, - 1 '# of antennas')) GOTO 910 - IF (.NOT.NSCUMF(OMCA,V_J,'NO_POL',2, - 1 '# of polarisations')) GOTO 910 - IF (.NOT.NSCUMF(OMCA,V_J,'NO_IF',1, - 1 '# of IF pairs')) GOTO 910 - IF (.NOT.NSCUMF(OMCA,V_J,'NO_NODES',0, - 1 '# of nodes')) GOTO 910 - IF (.NOT.NSCUMF(OMCA,V_E,'MGMOD',0E0, - 1 'Mean gain modulus')) GOTO 910 - IF (.NOT.NSCUMF(OMCA,V_L,'APPLIED',.TRUE., - 1 'If table applied to data')) GOTO 910 - IF (.NOT.NSCUMF(OMCA,V_J,'TYPE',2, - 1 'Type of table (gain)')) GOTO 910 - IF (.NOT.NSCUMF(OMCA,V_E,'RA_OFF1',0E0, - 1 'RA offset node 1')) GOTO 910 - IF (.NOT.NSCUMF(OMCA,V_E,'DEC_OFF1',0E0, - 1 'DEC offset node 1')) GOTO 910 -C - IF (.NOT.NSCUMF(OMCA,V_Z,'END',J, - 1 ' ')) GOTO 910 - IF (.NOT.NSCUWF(OMCA)) GOTO 910 !FILL RECORD -C -C END -C - GOTO 900 -C -C ERROR -C - 910 CONTINUE - NSCUV4=.FALSE. - 900 CONTINUE -C - RETURN !READY -C -C - END diff --git a/src/nscan/nscuv5.for b/src/nscan/nscuv5.for deleted file mode 100644 index 6b68a4c53fab1c29fbd58a827d348cd4e0fecf6c..0000000000000000000000000000000000000000 --- a/src/nscan/nscuv5.for +++ /dev/null @@ -1,206 +0,0 @@ -C+ NSCUV5.FOR -C WNB 910220 -C -C Revisions: -C - LOGICAL FUNCTION NSCUV5(OMCA,NPOL,NFRQ,STH,OHW,SCW) -C -C Write UVFITS Bandpass table header -C -C Result: -C -C NSCUV5_L = NSCUV5_L( OMCA_J:I, NPOL_J:I, NFRQ_J:I, STH_B(0:*):I, -C OHW_B(0:*):I, SCW_B(0:*):I) -C will write the UVFITS BP header. -C OMCA is the output file, NPOL and NFRQ the -C number of polarisation and frequency channels. -C STH, OHW and SCW are the Set header, the OH -C block and the SC block. -C -C PIN references: -C -C -C Include files: -C - INCLUDE 'WNG_DEF' - INCLUDE 'STH_O_DEF' !SET HEADER - INCLUDE 'OHW_O_DEF' !OH BLOCK - INCLUDE 'SCW_O_DEF' !SC BLOCK -C -C Parameters: -C - INTEGER LRCLEN !RECORD LENGTH FITS (CHANGE ALSO NSCUWB) - PARAMETER (LRCLEN=2880) - INTEGER CDILEN !CARD IMAGE LENGTH - PARAMETER (CDILEN=80) - INTEGER NCDI !# OF CARD IMAGES/RECORD - PARAMETER (NCDI=LRCLEN/CDILEN) - INTEGER DBLEN !DATA BUFFER LENGTH - PARAMETER (DBLEN=512) !BYTES END IF - INTEGER V_Z,V_L,V_I,V_J,V_C,V_E,V_D,V_T, - 1 V_XI,V_XJ !CODES FOR FITS CARD LINES - PARAMETER (V_Z=0,V_L=1,V_I=2,V_J=3,V_C=4,V_E=5,V_D=6, - 1 V_T=7,V_XI=8,V_XJ=9) -C -C Arguments: -C - INTEGER OMCA !FILE POINTER - INTEGER NPOL !# OF POL. TO DO - INTEGER NFRQ !# OF FREQ. TO DO - BYTE STH(0:*) !SET HEADER - BYTE OHW(0:*) !OH BLOCK - BYTE SCW(0:*) !SC BLOCK -C -C Function references: -C - LOGICAL NSCUWF !FILL FITS LINE - LOGICAL NSCUMF,NSCUMS !MAKE FITS LINE -C -C Data declarations: -C -C- -C -C INIT -C - NSCUV5=.TRUE. !ASSUME OK -C -C BANDPASS TABLE (BP) -C - IF (.NOT.NSCUMS(OMCA,V_C,'XTENSION','A3DTABLE', - 1 'Extension type')) GOTO 910 - IF (.NOT.NSCUMF(OMCA,V_J,'BITPIX',8, - 1 'Binary data')) GOTO 910 - IF (.NOT.NSCUMF(OMCA,V_J,'NAXIS',2, - 1 'Matrix')) GOTO 910 - IF (.NOT.NSCUMF(OMCA,V_J,'NAXIS1',50, - 1 'Table width')) GOTO 910 - IF (.NOT.NSCUMF(OMCA,V_J,'NAXIS2',STHTEL, - 1 'Table length')) GOTO 910 - IF (.NOT.NSCUMF(OMCA,V_J,'PCOUNT',0, - 1 '# random parameters')) GOTO 910 - IF (.NOT.NSCUMF(OMCA,V_J,'GCOUNT',1, - 1 '# of groups')) GOTO 910 -C - IF (.NOT.NSCUMS(OMCA,V_C,'EXTNAME','AIPS BP', - 1 'Type')) GOTO 910 - IF (.NOT.NSCUMF(OMCA,V_J,'EXTVER',1, - 1 'Version')) GOTO 910 - IF (.NOT.NSCUMF(OMCA,V_J,'EXTLEVEL',1, - 1 'Hierarchy')) GOTO 910 - IF (.NOT.NSCUMS(OMCA,V_C,'AUTHOR','WNB', - 1 'Produced by')) GOTO 910 - IF (.NOT.NSCUMS(OMCA,V_C,'REFERENC','NFRA-1', - 1 'Local contact')) GOTO 910 -C - IF (.NOT.NSCUMF(OMCA,V_J,'TFIELDS',13, - 1 'Fields per row')) GOTO 910 - IF (.NOT.NSCUMS(OMCA,V_C,'TFORM1','1D', - 1 'Fortran format')) GOTO 910 - IF (.NOT.NSCUMS(OMCA,V_C,'TTYPE1','TIME', - 1 'Name field')) GOTO 910 - IF (.NOT.NSCUMS(OMCA,V_C,'TUNIT1','DAYS', - 1 'Units field')) GOTO 910 - IF (.NOT.NSCUMS(OMCA,V_C,'TFORM2','1E', - 1 'Fortran format')) GOTO 910 - IF (.NOT.NSCUMS(OMCA,V_C,'TTYPE2','INTERVAL', - 1 'Name field')) GOTO 910 - IF (.NOT.NSCUMS(OMCA,V_C,'TUNIT2','DAYS', - 1 'Units field')) GOTO 910 - IF (.NOT.NSCUMS(OMCA,V_C,'TFORM3','1I', - 1 'Fortran format')) GOTO 910 - IF (.NOT.NSCUMS(OMCA,V_C,'TTYPE3','SOURCE ID', - 1 'Name field')) GOTO 910 - IF (.NOT.NSCUMS(OMCA,V_C,'TUNIT3',' ', - 1 'Units field')) GOTO 910 - IF (.NOT.NSCUMS(OMCA,V_C,'TFORM4','1I', - 1 'Fortran format')) GOTO 910 - IF (.NOT.NSCUMS(OMCA,V_C,'TTYPE4','SUBARRAY', - 1 'Name field')) GOTO 910 - IF (.NOT.NSCUMS(OMCA,V_C,'TUNIT4',' ', - 1 'Units field')) GOTO 910 - IF (.NOT.NSCUMS(OMCA,V_C,'TFORM5','1I', - 1 'Fortran format')) GOTO 910 - IF (.NOT.NSCUMS(OMCA,V_C,'TTYPE5','ANTENNA', - 1 'Name field')) GOTO 910 - IF (.NOT.NSCUMS(OMCA,V_C,'TUNIT5',' ', - 1 'Units field')) GOTO 910 - IF (.NOT.NSCUMS(OMCA,V_C,'TFORM6','1E', - 1 'Fortran format')) GOTO 910 - IF (.NOT.NSCUMS(OMCA,V_C,'TTYPE6','BANDWIDTH', - 1 'Name field')) GOTO 910 - IF (.NOT.NSCUMS(OMCA,V_C,'TUNIT6','HZ', - 1 'Units field')) GOTO 910 - IF (.NOT.NSCUMS(OMCA,V_C,'TFORM7','1D', - 1 'Fortran format')) GOTO 910 - IF (.NOT.NSCUMS(OMCA,V_C,'TTYPE7','IF FREQ', - 1 'Name field')) GOTO 910 - IF (.NOT.NSCUMS(OMCA,V_C,'TUNIT7','HZ', - 1 'Units field')) GOTO 910 - IF (.NOT.NSCUMS(OMCA,V_C,'TFORM8','1I', - 1 'Fortran format')) GOTO 910 - IF (.NOT.NSCUMS(OMCA,V_C,'TTYPE8','REFANT 1', - 1 'Name field')) GOTO 910 - IF (.NOT.NSCUMS(OMCA,V_C,'TUNIT8',' ', - 1 'Units field')) GOTO 910 - IF (.NOT.NSCUMS(OMCA,V_C,'TFORM9','1E', - 1 'Fortran format')) GOTO 910 - IF (.NOT.NSCUMS(OMCA,V_C,'TTYPE9','REAL 1', - 1 'Name field')) GOTO 910 - IF (.NOT.NSCUMS(OMCA,V_C,'TUNIT9',' ', - 1 'Units field')) GOTO 910 - IF (.NOT.NSCUMS(OMCA,V_C,'TFORM10','1E', - 1 'Fortran format')) GOTO 910 - IF (.NOT.NSCUMS(OMCA,V_C,'TTYPE10','IMAG 1', - 1 'Name field')) GOTO 910 - IF (.NOT.NSCUMS(OMCA,V_C,'TUNIT10',' ', - 1 'Units field')) GOTO 910 - IF (.NOT.NSCUMS(OMCA,V_C,'TFORM11','1I', - 1 'Fortran format')) GOTO 910 - IF (.NOT.NSCUMS(OMCA,V_C,'TTYPE11','REFANT 2', - 1 'Name field')) GOTO 910 - IF (.NOT.NSCUMS(OMCA,V_C,'TUNIT11',' ', - 1 'Units field')) GOTO 910 - IF (.NOT.NSCUMS(OMCA,V_C,'TFORM12','1E', - 1 'Fortran format')) GOTO 910 - IF (.NOT.NSCUMS(OMCA,V_C,'TTYPE12','REAL 2', - 1 'Name field')) GOTO 910 - IF (.NOT.NSCUMS(OMCA,V_C,'TUNIT12',' ', - 1 'Units field')) GOTO 910 - IF (.NOT.NSCUMS(OMCA,V_C,'TFORM13','1E', - 1 'Fortran format')) GOTO 910 - IF (.NOT.NSCUMS(OMCA,V_C,'TTYPE13','IMAG 2', - 1 'Name field')) GOTO 910 - IF (.NOT.NSCUMS(OMCA,V_C,'TUNIT13',' ', - 1 'Units field')) GOTO 910 -C - IF (.NOT.NSCUMF(OMCA,V_J,'NO_ANT',STHTEL, - 1 '# of antennas')) GOTO 910 - IF (.NOT.NSCUMF(OMCA,V_J,'NO_POL',2, - 1 '# of polarisations')) GOTO 910 - IF (.NOT.NSCUMF(OMCA,V_J,'NO_IF',1, - 1 '# of IF pairs')) GOTO 910 - IF (.NOT.NSCUMF(OMCA,V_J,'NO_CHAN',1, - 1 '# of channels')) GOTO 910 - IF (.NOT.NSCUMF(OMCA,V_J,'STRT_CHN',1, - 1 'Start channel')) GOTO 910 - IF (.NOT.NSCUMF(OMCA,V_J,'ISORTORD',1, - 1 'Sort order')) GOTO 910 -C - IF (.NOT.NSCUMF(OMCA,V_Z,'END',J, - 1 ' ')) GOTO 910 - IF (.NOT.NSCUWF(OMCA)) GOTO 910 !FILL RECORD -C -C END -C - GOTO 900 -C -C ERROR -C - 910 CONTINUE - NSCUV5=.FALSE. - 900 CONTINUE -C - RETURN !READY -C -C - END diff --git a/src/nscan/nscuvf.for b/src/nscan/nscuvf.for deleted file mode 100644 index c9db112eee53b582d93c63a8505e0bf2f876ed2c..0000000000000000000000000000000000000000 --- a/src/nscan/nscuvf.for +++ /dev/null @@ -1,799 +0,0 @@ -C+ NSCUVF.FOR -C WNB 910220 -C -C Revisions: -C WNB 910913 Add model subtraction and selection of corrections -C WNB 910918 Calculation of dUTST -C WNB 920109 Correct buffer management -C HjV 920520 HP does not allow extended source lines -C HjV 930311 Change some text -C WNB 930825 Add dipole position; polarisation codes -C WNB 930826 Add new Stokes calculation -C CMV 930910 Allow single polarisation -C CMV 930913 Ignore APDAT, set weights zero for individual pol's -C CMV 940418 Correct selection of Polarisations -C CMV 970130 Prevent creation of multiple output files -C - SUBROUTINE NSCUVF -C -C Convert SCN file to AIPS UVFITS format -C -C Result: -C -C CALL NSCUVF will convert a SCN file to UVFITS AIPS format -C -C PIN references: -C -C IAT_UTC -C -C Include files: -C - INCLUDE 'WNG_DEF' - INCLUDE 'CBITS_DEF' - INCLUDE 'OHW_O_DEF' !OH BLOCK - INCLUDE 'SCW_O_DEF' !SC BLOCK - INCLUDE 'STH_O_DEF' !SET HEADER - INCLUDE 'SCH_O_DEF' !SCAN HEADER - INCLUDE 'NSC_DEF' -C -C Parameters: -C - INTEGER LRCLEN !RECORD LENGTH FITS (CHANGE ALSO NSCUWB) - PARAMETER (LRCLEN=2880) - INTEGER CDILEN !CARD IMAGE LENGTH - PARAMETER (CDILEN=80) - INTEGER NCDI !# OF CARD IMAGES/RECORD - PARAMETER (NCDI=LRCLEN/CDILEN) - INTEGER V_Z,V_L,V_I,V_J,V_C,V_E,V_D,V_T, - 1 V_XI,V_XJ !CODES FOR FITS CARD LINES - PARAMETER (V_Z=0,V_L=1,V_I=2,V_J=3,V_C=4,V_E=5,V_D=6, - 1 V_T=7,V_XI=8,V_XJ=9) - INTEGER MXNFRQ !MAX # OF SIMULTANEOUS CHANNELS - PARAMETER (MXNFRQ=1024) - INTEGER MXNSCT !MAX # OF SECTORS PER FREQUENCY - PARAMETER (MXNSCT=50) - INTEGER DBLEN !DATA BUFFER LENGTH - PARAMETER (DBLEN=2*(4*3*MXNFRQ+6)) !BYTES -C -C Arguments: -C -C -C Function references: -C - LOGICAL WNFOPF !OPEN FILE (EXTENDED) - LOGICAL WNFRD !READ DATA - LOGICAL WNFWR !WRITE DATA - INTEGER WNFTLB !CURRENT TAPE LABEL - LOGICAL WNGGVM !GET MEMORY - CHARACTER*32 WNTTSG !SET NAME - DOUBLE PRECISION WNGDFD,WNGDND !ANGLE CONVERSION - DOUBLE PRECISION WNGDPF - INTEGER WNCALN !STRING LENGTH - LOGICAL WNDPAR !GET PARAMETER - LOGICAL NSCSTG !GET SETS - LOGICAL NSCUWF !FILL FITS LINE - LOGICAL NSCUMF,NSCUMS,NSCUMB !MAKE FITS LINE - LOGICAL NSCSIF !READ INTERFEROMETERS - LOGICAL NSCSCR !READ SCAN DATA - LOGICAL NSCUV0 !WRITE UVFITS HEADER - LOGICAL NSCUV1 !WRITE UVFITS AN HEADER -CC LOGICAL NSCUV2 !WRITE UVFITS FQ HEADER -CC LOGICAL NSCUV3 !WRITE UVFITS SU HEADER -CC LOGICAL NSCUV4 !WRITE UVFITS SN HEADER -CC LOGICAL NSCUV5 !WRITE UVFITS BP HEADER -C -C Data declarations: -C - CHARACTER*160 ONFILE !FILE NAME - INTEGER NPOL !# OF POL. INPUT - INTEGER ONPOL !# OF POL. TO DO - INTEGER POLT(0:3) !POL. TRANSLATION TABLE - CHARACTER*15 CPOL !POLARISATION STRING - INTEGER LCPOL !LENGTH OF CPOL - INTEGER CAP,CDAP !CORRECTIONS TO (DE-)APPLY - INTEGER NIFR !# OF IFRS - INTEGER NSCN !# OF SCANS - INTEGER NSCT !# OF SECTORS - INTEGER LSCN,LSCT !LOOP SCANS, SECTORS - LOGICAL FORCN !INDICATE NEW FIELD - LOGICAL FORSCT !INDICATE NEW SECTOR - INTEGER SAVNAM(0:7) !SAVE NAME - INTEGER APDAT(0:STHIFR-1) !CHECK STOKES - CHARACTER*(STHTEL) TELNAM !TEL. NAMES - DATA TELNAM/'0123456789ABCD'/ - INTEGER*2 DATB(0:2) !DATE BUFFER - INTEGER NFRQ !# OF FREQ. TO DO - INTEGER*2 IFRT(0:STHIFR-1) !IFR TABLES - INTEGER IFRA(0:1,0:STHIFR-1) - REAL ANG(0:2,0:STHIFR-1) - REAL BASEL(0:STHIFR-1) !BASELINE TABLE - INTEGER WGTPT !DATA WEIGHT POINTER - INTEGER DATPT !DATA POINTER - CHARACTER*12 TXT !DATA HELP - DOUBLE PRECISION IATOFF !IAT-UTC IN DAYS - DOUBLE PRECISION GSTIAT !GST AT IAT 0HR IN DAYS - DOUBLE PRECISION UT1UTC !UT1-UTC IN DAYS - REAL IATJS(0:1,0:50) !LEAP SECONDS - DATA ((IATJS(I,J),I=0,1),J=0,16) - 1 /-1000000,10,41498,11,41683,12,42048,13,42413,14, - 1 42778,15,43144,16,43509,17,43874,18,44239,19, - 1 44786,20,45151,21,45516,22,46247,23,47161,24, - 1 47892,25,48257,26/ - DATA (IATJS(0,J),J=17,50) /34*1000000/ - DATA (IATJS(1,J),J=17,50) /34*27/ - BYTE BUF(0:DBLEN-1) !DATA HELP BUFFER - CHARACTER*(DBLEN) BUFC - INTEGER*2 BUFI(0:DBLEN/2-1) - INTEGER BUFJ(0:DBLEN/4-1) - REAL BUFE(0:DBLEN/4-1) - DOUBLE PRECISION BUFD(0:DBLEN/8-1) - EQUIVALENCE (BUF,BUFC,BUFI,BUFJ,BUFE,BUFD) - INTEGER STHP !SET HEADER POINTER - INTEGER SETNAM(0:7) !NAME OF SET - BYTE STH(0:STHHDL-1) !SET HEADER - INTEGER*2 STHI(0:STHHDL/2-1) - INTEGER STHJ(0:STHHDL/4-1) - REAL STHE(0:STHHDL/4-1) - DOUBLE PRECISION STHD(0:STHHDL/8-1) - EQUIVALENCE (STH,STHI,STHJ,STHE,STHD) - BYTE SCH(0:SCHHDL-1) !SCAN HEADER - INTEGER*2 SCHI(0:SCHHDL/2-1) - INTEGER SCHJ(0:SCHHDL/4-1) - REAL SCHE(0:SCHHDL/4-1) - EQUIVALENCE (SCH,SCHI,SCHJ,SCHE) - BYTE OHW(0:OHWHDL-1) !OH BLOCK - INTEGER*2 OHWI(0:OHWHDL/2-1) - INTEGER OHWJ(0:OHWHDL/4-1) - REAL OHWE(0:OHWHDL/4-1) - DOUBLE PRECISION OHWD(0:OHWHDL/8-1) - EQUIVALENCE (OHW,OHWI,OHWJ,OHWE,OHWD) - BYTE SCW(0:SCWHDL-1) !SC BLOCK - INTEGER*2 SCWI(0:SCWHDL/2-1) - INTEGER SCWJ(0:SCWHDL/4-1) - REAL SCWE(0:SCWHDL/4-1) - DOUBLE PRECISION SCWD(0:SCWHDL/8-1) - EQUIVALENCE (SCW,SCWI,SCWJ,SCWE,SCWD) - INTEGER TSTB(MXNSCT,MXNFRQ) !SET POINTER TABLE - DOUBLE PRECISION DFRQTB !FREQUENCY - DOUBLE PRECISION DBNDTB !BAND - DOUBLE PRECISION BNDTST !STEP IN FREQUENCY - REAL HABTST(MXNSCT) !HAB TEST - REAL HAITST(MXNSCT) !HAI TEST - INTEGER NSCTST(MXNSCT) !N POINTS TEST - INTEGER I6,I7 -C- -C -C INIT -C - CALL WNDDAP(CAP,CDAP) !GET CORRECTION BITS -C -C Select polarisations. -C -C Standard FITS sequence is either I,Q,U,V or XX,YY,XY,YX -C -C Since the polarisation is defined in the FITS header with -C CRVAL and CDELT, the combinations XX,XY,YX and I,U,V cannot be -C properly described, so we also produce YY and Q respectively. -C - ONPOL=0 !ASSUME NO OUTPUT - CPOL=' ' - LCPOL=1 -C - IF (IAND(POL(1),STOKES_P).EQ.0) THEN !XX... -C - IF (IAND(POL(1),XX_P).AND.IAND(POL(1),XY_P).AND. - 1 IAND(POL(1),YX_P)) POL(1)=IOR(POL(1),YY_P) !SHOULD DO YY -C - IF (IAND(POL(1),XX_P).NE.0) THEN - POLT(ONPOL)=IAND(POL(1),I_M) !DO XX - ONPOL=ONPOL+1 - CPOL(LCPOL:)='XX,' - LCPOL=LCPOL+3 - END IF - IF (IAND(POL(1),YY_P).NE.0) THEN - POLT(ONPOL)=IAND(POL(1),V_M) !DO YY - ONPOL=ONPOL+1 - CPOL(LCPOL:)='YY,' - LCPOL=LCPOL+3 - END IF - IF (IAND(POL(1),XY_P).NE.0) THEN - POLT(ONPOL)=IAND(POL(1),Q_M) !DO XY - ONPOL=ONPOL+1 - CPOL(LCPOL:)='XY,' - LCPOL=LCPOL+3 - END IF - IF (IAND(POL(1),YX_P).NE.0) THEN - POLT(ONPOL)=IAND(POL(1),U_M) !DO YX - ONPOL=ONPOL+1 - CPOL(LCPOL:)='YX,' - LCPOL=LCPOL+3 - END IF - ELSE !IQUV -C - IF (IAND(POL(1),SI_P).AND.IAND(POL(1),SU_P).AND. - 1 IAND(POL(1),SV_P)) POL(1)=IOR(POL(1),SQ_P) !SHOULD DO Q -C - IF (IAND(POL(1),SI_P).NE.0) THEN - POLT(ONPOL)=IAND(POL(1),I_M)+LINE_P !DO L - ONPOL=ONPOL+1 - CPOL(LCPOL:)='I,' - LCPOL=LCPOL+2 - END IF - IF (IAND(POL(1),SQ_P).NE.0) THEN - POLT(ONPOL)=IAND(POL(1),Q_M) !DO Q - ONPOL=ONPOL+1 - CPOL(LCPOL:)='Q,' - LCPOL=LCPOL+2 - END IF - IF (IAND(POL(1),SU_P).NE.0) THEN - POLT(ONPOL)=IAND(POL(1),U_M) !DO U - ONPOL=ONPOL+1 - CPOL(LCPOL:)='U,' - LCPOL=LCPOL+2 - END IF - IF (IAND(POL(1),SV_P).NE.0) THEN - POLT(ONPOL)=IAND(POL(1),V_M) !DO V - ONPOL=ONPOL+1 - CPOL(LCPOL:)='V,' - LCPOL=LCPOL+2 - END IF - END IF - IF (LCPOL.GT.0) CPOL(LCPOL-1:)=' ' !STRIP TRAILING COMMA -C -C This routine writes into a single output file data for -C * a single bandwidth (implied by UVFITS) -C * a single pointing position -C * the same interferometer table -C * the same number of polarizations -C -C Data are written sorted in a number of groups, where each group -C contains all frequency/polarization points for a fixed (u,v,w) point. -C -C -C GATHER FIELD DATA -C - IF (.NOT.NSCSTG(FCAIN,SETS,STH,STHP,SETNAM)) THEN !GET FIRST SET - STHP=0 !SET NO MORE - CALL WNCTXT(F_TP,'No input data') - END IF -C -C WE HAVE THE FIRST SECTOR FOR A NEW OUTPUT FILE -C - 200 CONTINUE - IF (STHP.EQ.0) GOTO 900 !ALL FINISHED - IF (.NOT.WNFRD(FCAIN,STHHDL,STH,STHP)) THEN !READ HEADER - CALL WNCTXT(F_TP,'Error reading sector header') - GOTO 900 - END IF - DO I=0,7 !SAVE NAME - SAVNAM(I)=SETNAM(I) - END DO - NPOL=STHI(STH_PLN_I) !# OF POLARISATIONS - NIFR=STHJ(STH_NIFR_J) !# OF IFRS - DO I=1,MXNFRQ !CLEAR SET LIST - DO I1=1,MXNSCT - TSTB(I1,I)=0 - END DO - END DO - NFRQ=1 !# OF FREQUENCIES - NSCT=1 !# OF SECTORS - NSCN=STHJ(STH_SCN_J) !# OF SCANS - TSTB(NSCT,NFRQ)=STHP !SET HEADER POINTER - DFRQTB=STHD(STH_FRQ_D) - DBNDTB=STHE(STH_BAND_E) - BNDTST=STHE(STH_BAND_E) !FREQ. STEP INITIAL - HABTST(NSCT)=STHE(STH_HAB_E) !START HA SECTORS - HAITST(NSCT)=STHE(STH_HAI_E) !INCREM. HA TEST - NSCTST(NSCT)=STHJ(STH_SCN_J) !LENGTH SECTORS TEST - IF (STHJ(STH_OHP_J).NE.0) THEN !READ OH BLOCK - IF (.NOT.WNFRD(FCAIN,STHJ(STH_NOH_J),OHW,STHJ(STH_OHP_J))) THEN - 10 CONTINUE - CALL WNCTXT(F_TP,'Error reading OH/SC block') - GOTO 900 - END IF - ELSE - CALL WNGMVZ(OHWHDL,OHW) - END IF - IF (STHJ(STH_SCP_J).NE.0) THEN !READ SC BLOCK - IF (.NOT.WNFRD(FCAIN,STHJ(STH_NSC_J), - 1 SCW,STHJ(STH_SCP_J))) GOTO 10 - ELSE - CALL WNGMVZ(SCWHDL,SCW) - END IF -C -C CHECK IF NEXT SET IN INPUT FILE FITS INTO THIS OUTPUT FILE -C - 210 CONTINUE - FORCN=.FALSE. !ASSUME CAN HANDLE - IF (.NOT.NSCSTG(FCAIN,SETS,STH,STHP,SETNAM)) THEN !GET NEXT SET - STHP=0 !SET NO MORE - FORCN=.TRUE. !NEW - END IF -C -C IF NEW GRP,OBS OF FLD ASSUME DIFFERENT POINTING POSITION -C - IF (.NOT.FORCN) THEN - DO I=0,2 !TEST FIELD - IF (SAVNAM(I).NE.SETNAM(I)) THEN - CALL WNCTXT(F_TP, - 1 '!AS - New grp/obs/fld --> new label', - 1 WNTTSG(SETNAM,0)) - FORCN=.TRUE. !NEW FIELD - END IF - END DO - END IF -C -C IF DIFFERENT NUMBER OF POLS/IFRS: CANNOT HANDLE IN ONE FILE -C - IF (.NOT.FORCN) THEN - IF (NPOL.NE.STHI(STH_PLN_I)) FORCN=.TRUE. !NEW LABEL - IF (NIFR.NE.STHJ(STH_NIFR_J)) FORCN=.TRUE. - IF (FORCN) THEN - CALL WNCTXT(F_TP, - 1 '!AS - Different nifr/npol --> new label', - 1 WNTTSG(SETNAM,0)) - END IF - END IF -C -C IF DIFFERENT BANDWIDTH: CANNOT HANDLE IN ONE FILE -C - IF (.NOT.FORCN) THEN - IF (ABS(DBLE(STHE(STH_BAND_E))-DBNDTB).GT.1D-6) THEN - FORCN=.TRUE. !NOT CORRECT BANDWIDTH - CALL WNCTXT(F_TP, - 1 '!AS - Different bandwidth --> new label', - 1 WNTTSG(SETNAM,0)) - END IF - END IF - -C -C IF DIFFERENT CHANNEL AND DIFFERENT SEPARATION: CANNOT HANDLE IN ONE FILE -C - IF (.NOT.FORCN) THEN - IF (SAVNAM(3).EQ.SETNAM(3)) THEN !SAME CHANNEL - ELSE - IF (NFRQ.GE.MXNFRQ) THEN !CANNOT FIT MORE CHAN. - CALL WNCTXT(F_TP, - 1 '!AS - Too many channels --> new label', - 1 WNTTSG(SETNAM,0)) - FORCN=.TRUE. - ELSE - IF (NFRQ.EQ.1) BNDTST=STHD(STH_FRQ_D)-DFRQTB !FREQ. STEP - IF (ABS(STHD(STH_FRQ_D)-DFRQTB-NFRQ*BNDTST).GT.1D-6) - 1 FORCN=.TRUE. !NOT CORRECT FREQ. STEP - IF (.NOT.FORCN) THEN - NFRQ=NFRQ+1 !NEXT CHANNEL - SAVNAM(3)=SETNAM(3) !SAVE NEW VALUE - ELSE - CALL WNCTXT(F_TP, - 1 '!AS - Channel (!D MHz) does not fit --> new label', - 1 WNTTSG(SETNAM,0),STHD(STH_FRQ_D)) - END IF - END IF - END IF - END IF -C -C OK, IT FITS IN THE SAME FILE. NOW CHECK IF IT'S A NEW SECTOR -C WE MAY HAVE FOUND THIS HA-RANGE FOR ANOTHER FREQUENCY -C - IF (.NOT.FORCN) THEN !COUNT THE SET DATA - FORSCT=.TRUE. !ASSUME NEW SECTOR - DO I=1,NSCT !TEST SECTOR - IF (FORSCT) THEN - IF (ABS(STHE(STH_HAB_E)-HABTST(I)).LT.1E-5 .AND. - 1 ABS(STHE(STH_HAI_E)-HAITST(I)).LT.1E-6 .AND. - 1 STHJ(STH_SCN_J).EQ.NSCTST(I)) THEN !FOUND SECTOR - TSTB(I,NFRQ)=STHP !WHERE TO FIND - FORSCT=.FALSE. !NO NEW SECTOR - END IF - END IF - END DO - IF (FORSCT) THEN !NEW SECTOR - IF (NSCT.GE.MXNSCT) THEN !FORGET THIS SECTOR - ELSE !ADD NEW SECTOR - NSCT=NSCT+1 - HABTST(NSCT)=STHE(STH_HAB_E) !START HA SECTOR - HAITST(NSCT)=STHE(STH_HAI_E) !INCREM. HA TEST - NSCTST(NSCT)=STHJ(STH_SCN_J) !LENGTH SECTOR TEST - TSTB(NSCT,NFRQ)=STHP !WHERE TO FIND - NSCN=NSCN+STHJ(STH_SCN_J) !COUNT SCANS - END IF - END IF - GOTO 210 !TRY MORE SETS - END IF -C -C OUTPUT DATA -C -C -C OPEN OUTPUT -C - IF (OUNIT.EQ.'D') THEN !DISK OUTPUT - IF (OLAB.LE.0) OLAB=1 - CALL WNCTXS(ONFILE,'!AS\.!6$ZJ',OFILE,OLAB) !FILE NAME - IF (.NOT.WNFOPF(OMCA,ONFILE(1:WNCALN(ONFILE)),'W', - 1 0,0,LRCLEN,0)) THEN - CALL WNCTXT(F_TP,'Cannot open file !AS',ONFILE) - GOTO 900 !READY - END IF - ELSE !TAPE OUTPUT - CALL WNCTXS(ONFILE,'label !6$ZJ',OLAB) !FILE NAME - IF (.NOT.WNFOPF(OMCA,' ','W',0,LRCLEN,CDILEN,OLAB)) THEN - CALL WNCTXT(F_TP,'Cannot write to label !UJ',OLAB) - GOTO 900 - END IF - OLAB=WNFTLB(OMCA) !CURRENT LABEL - END IF - OLAB=OLAB+1 !COUNT LABEL - SAVNAM(3)=-1 !LIMIT FIELD NAME - CALL WNCTXT(F_TP,'!AS: !UJ chn, '// - 1 '!UJ pol (!AS), !UJ ifrs, '// - 1 '!UJ scn (in !UJ sct) to !AS', - 1 WNTTSG(SAVNAM,0),NFRQ,ONPOL,CPOL,NIFR, - 1 NSCN,NSCT,ONFILE) -C -C WRITE OUTPUT -C -C WRITE HEADER -C -C STANDARD -C - J=0 !A SET HEADER POINTER - DO I=1,NFRQ !FIND ONE - DO I1=1,NSCT - IF (J.EQ.0) THEN - J=TSTB(I1,I) - END IF - END DO - END DO - IF (J.LE.0) GOTO 400 !NO SET: FINISH - IF (.NOT.WNFRD(FCAIN,STHHDL,STH,J)) THEN !READ SET HEADER - 430 CONTINUE - CALL WNCTXT(F_TP,'Logic error') - GOTO 900 - END IF - IF (.NOT.WNDPAR('IAT_UTC',IATJS(0,16),20*LB_E,J0)) GOTO 430 !GET LEAP S. - I=0 - DO WHILE (STHD(STH_MJD_D).GE.IATJS(0,I)) !GET LEAP SECONDS - IATOFF=IATJS(1,I) - I=I+1 - END DO - IATOFF=IATOFF/3600D0/24D0 !MAKE FRACTION OF DAY - DATB(2)=OHWI(OHW_DATE_I+1) !YEAR - DATB(1)=OHWI(OHW_DATE_I+2) !MONTH - DATB(0)=OHWI(OHW_DATE_I+3) !DAY - J=OHWI(OHW_ETIM_I)-OHWI(OHW_STIM_I) !LENGTH OBS. IN 10S - IF (J.LT.0) J=J+24*360 !ADD ONE DAY - R0=(J/2.+1.*OHWI(OHW_STIM_I))/24./360. !MIDDLE OBS. FRACT. DAY - IF (R0.GE.1.) DATB(0)=DATB(0)+1 !NEW REFERENCE DAY - GSTIAT=OHWD(OHW_LST_D)+SCWE(SCW_WLON_E) !GST AT MID OBS. - GSTIAT=GSTIAT-(MOD(OHWD(OHW_JDAY_D)-.5D0,1D0)+IATOFF)* - 1 (1D0+SCWD(SCW_CUTST_D)) !GST AT 0HR IAT - GSTIAT=WNGDPF(GSTIAT) !0-1. - UT1UTC=(SCWE(SCW_CLOCK_E)-SCWE(SCW_CLCOFF_E))/ - 1 (1D0+SCWD(SCW_CUTST_D))- - 1 (SCWE(SCW_POLE_E)-SCWE(SCW_POLEOFF_E))* - 1 TAN(SCWE(SCW_GLAT_E)*PI2) - UT1UTC=UT1UTC+(SCWE(SCW_DCLOCK_E)-SCWE(SCW_DPLE_E)* - 1 TAN(SCWE(SCW_GLAT_E)*PI2)/ - 1 (1D0+SCWD(SCW_CUTST_D)))* - 1 (AINT(OHWD(OHW_JDAY_D))-SCWE(SCW_JDCP_E)) - IF (.NOT.NSCUV0(OMCA,ONPOL,POLT,IATOFF,NSCN,NFRQ,DFRQTB,BNDTST, - 1 STH,OHW,SCW,OINT)) GOTO 910 !WRITE HEAD -C -C GET IFR TABLES -C - IF (.NOT.NSCSIF(FCAIN,STH,IFRT,IFRA,ANG)) THEN !READ IFR TABLE - CALL WNCTXT(F_TP,'Error reading interferometer data') - GOTO 900 - END IF - DO I=0,STHJ(STH_NIFR_J)-1 !MAKE BASELINES M - BASEL(I)=STHE(STH_RTP_E+IFRA(1,I))-STHE(STH_RTP_E+IFRA(0,I)) - BASEL(I)=BASEL(I)*10. !IN 10CM UNITS - END DO - R1=-SIN(DPI2*STHD(STH_DEC_D)) !GET U,V SCALE - R0=1. -C -C WRITE DATA -C - IF (.NOT.WNGGVM(LB_E*2*STHIFR*4*NFRQ,DATPT)) THEN !GET BUFFERS - 412 CONTINUE - CALL WNCTXT(F_TP,'No memory for buffers') - GOTO 400 - END IF - IF (.NOT.WNGGVM(LB_E*STHIFR*4*NFRQ,WGTPT)) THEN - CALL WNGFVM(LB_E*2*STHIFR*4*NFRQ,DATPT) - GOTO 412 - END IF - DATPT=(DATPT-A_OB)/LB_E !ARRAY POINTER - WGTPT=(WGTPT-A_OB)/LB_E -C -C LOOP THROUGH SCANS -C - DO LSCT=1,NSCT !ALL SECTORS - DO LSCN=0,NSCTST(LSCT)-1 !ALL SCANS - DO I=1,NFRQ !ALL FREQUENCIES - IF (TSTB(LSCT,I).NE.0) THEN !READ SET HEADER - IF (.NOT.WNFRD(FCAIN,STHHDL,STH,TSTB(LSCT,I))) GOTO 430 !READ HEAD - IF (.NOT.NSCSCR(FCAIN,STH,IFRT,LSCN,CAP,CDAP,SCH, - 1 A_E(WGTPT+(I-1)*STHIFR*4), - 1 A_E(DATPT+(I-1)*STHIFR*4*2))) THEN !READ DATA - CALL WNCTXT(F_TP,'Error reading scan') - GOTO 900 - END IF - D0=STHD(STH_MJD_D)-44239+ - 1 LSCN*STHE(STH_HAI_E)/STHD(STH_UTST_D) !MJD - 80.01.01 - DO I0=0,STHJ(STH_NIFR_J)-1 !SET ALL PRESENT - APDAT(I0)=1 - END DO - CALL NMOCXX(STH,SCH,ANG,A_E(WGTPT+(I-1)*STHIFR*4), - 1 APDAT,A_E(DATPT+(I-1)*STHIFR*4*2), - 1 A_E(DATPT+(I-1)*STHIFR*4*2),ONPOL,POLT) !MAKE STOKES -C CMV930913 NMOCXX changes weights to reflect weight for selected pol. -C DO I0=0,STHJ(STH_NIFR_J)-1 !SET ALL PRESENT -C DO I1=0,3 !ZERO WEIGHTS -C IF (APDAT(I0,I1).EQ.0) THEN -C CMV930910 Index changed -C A_E(WGTPT+STHIFR*4*(I-1)+I1*STHIFR+I0)=0 -C ELSE IF (A_E(WGTPT+STHIFR*4*(I-1)+ -C 1 I1*STHIFR+I0).LE.0) THEN -C A_E(WGTPT+STHIFR*4*(I-1)+I1*STHIFR+I0)=1 -C END IF -C END DO -C END DO - END IF - END DO -C -C Fill buffer and write out -C - DO I0=0,STHJ(STH_NIFR_J)-1 !ALL INTERFEROMETERS - IF (OINT.EQ.16) THEN - BUFI(0)=-NINT(R0*BASEL(I0)*COS(DPI2* - 1 (HABTST(LSCT)+LSCN*HAITST(LSCT)))) !U - BUFI(1)=NINT(R1*BASEL(I0)*SIN(DPI2* - 1 (HABTST(LSCT)+LSCN*HAITST(LSCT)))) !V - BUFI(2)=0 !W - BUFI(3)=256*(IFRA(0,I0)+1)+IFRA(1,I0)+1 !BASELINE - BUFI(4)=AINT(D0) !DATE - BUFI(5)=NINT((D0-BUFI(4))*24.*360.) !TIME IN 10S - DO I=1,NFRQ !ALL FREQUENCIES - IF (TSTB(LSCT,I).EQ.0) THEN !NOT PRESENT - DO I2=0,ONPOL-1 !# OF POL. - I5=3*(I2+ONPOL*(I-1)) !DATA POINTER - BUFI(6+I5)=0 !NOT PRESENT - BUFI(7+I5)=0 - BUFI(8+I5)=0 - END DO - ELSE - DO I2=0,ONPOL-1 !# OF POLARISATIONS - I5=3*(I2+ONPOL*(I-1)) !OUTPUT POINTER - I6=DATPT+2*(STHIFR*4*(I-1)+I2*STHIFR+I0) !DATA POINTER - I7=WGTPT+1*(STHIFR*4*(I-1)+I2*STHIFR+I0) !WEIGHT POINTER - BUFI(6+I5)=NINT(A_E(I6+0)) !REAL - BUFI(7+I5)=NINT(A_E(I6+1)) !IMAG - BUFI(8+I5)=NINT(A_E(I7)) !WEIGHT - END DO - END IF - END DO !END FREQ - IF (.NOT.NSCUMB(OMCA,V_I,BUFI(0),6+3*ONPOL*NFRQ)) GOTO 910 !WRITE DATA -C - ELSE - BUFJ(0)=-NINT(R0*BASEL(I0)*COS(DPI2* - 1 (HABTST(LSCT)+LSCN*HAITST(LSCT)))) !U - BUFJ(1)=NINT(R1*BASEL(I0)*SIN(DPI2* - 1 (HABTST(LSCT)+LSCN*HAITST(LSCT)))) !V - BUFJ(2)=0 !W - BUFJ(3)=256*(IFRA(0,I0)+1)+IFRA(1,I0)+1 !BASELINE - BUFJ(4)=AINT(D0) !DATE - BUFJ(5)=NINT((D0-BUFJ(4))*24.*360.) !TIME IN 10S - DO I=1,NFRQ !ALL FREQUENCIES - IF (TSTB(LSCT,I).EQ.0) THEN !NOT PRESENT - DO I2=0,ONPOL-1 !# OF POL. - I5=3*(I2+ONPOL*(I-1)) !DATA POINTER - BUFJ(6+I5)=0 !NOT PRESENT - BUFJ(7+I5)=0 - BUFJ(8+I5)=0 - END DO - ELSE - DO I2=0,ONPOL-1 !# OF POLARISATIONS - I5=3*(I2+ONPOL*(I-1)) !OUTPUT POINTER - I6=DATPT+2*(STHIFR*4*(I-1)+I2*STHIFR+I0) !DATA POINTER - I7=WGTPT+1*(STHIFR*4*(I-1)+I2*STHIFR+I0) !WEIGHT POINTER - BUFJ(6+I5)=NINT(A_E(I6+0)) !REAL - BUFJ(7+I5)=NINT(A_E(I6+1)) !IMAG - BUFJ(8+I5)=NINT(A_E(I7)) !WEIGHT - END DO - END IF - END DO !END FREQ - IF (.NOT.NSCUMB(OMCA,V_J,BUFJ(0),6+3*ONPOL*NFRQ)) GOTO 910 !WRITE DATA - END IF - END DO !END IFRS -C - END DO !NEXT SCAN - END DO !NEXT SECTOR -C -C FINISH DATA -C - CALL WNGFVM(LB_E*2*STHIFR*4*NFRQ,LB_E*DATPT+A_OB) !FREE BUFFERS - CALL WNGFVM(LB_E*STHIFR*4*NFRQ,LB_E*WGTPT+A_OB) - 400 CONTINUE - IF (.NOT.NSCUWF(OMCA)) GOTO 910 !FILL OUT -C -C ANTENNA TABLE -C - IF (.NOT.NSCUV1(OMCA,ONPOL,NFRQ,DFRQTB,BNDTST,STH,OHW,SCW, - 1 IATOFF,DATB,UT1UTC,GSTIAT)) GOTO 910 !WRITE AN HEADER -C -C MAKE ANTENNA TABLE -C - DO I=0,STHTEL-1 !ALL TELESCOPES - BUFC(1:8)='WSRT' !ANNAME - BUFC(5:5)=TELNAM(I+1:I+1) - IF (.NOT.NSCUMB(OMCA,V_C,BUF,8)) GOTO 910 - BUFD(0)=0D0 !STABXYZ - BUFD(1)=OHWJ(OHW_POST_J+I)/(2D0**16) - BUFD(2)=0D0 - IF (.NOT.NSCUMB(OMCA,V_D,BUF,3)) GOTO 910 - BUFI(0)=I+1 !NOSTA - BUFI(1)=1 !MNTSTA - IF (.NOT.NSCUMB(OMCA,V_I,BUF,2)) GOTO 910 - BUFE(0)=4.95 !STAXOF - IF (.NOT.NSCUMB(OMCA,V_E,BUF,1)) GOTO 910 - BUF(0)=ICHAR('X') !POLTYA - IF (.NOT.NSCUMB(OMCA,V_C,BUF,1)) GOTO 910 - BUFE(0)=90E0 !POLAA - BUFE(1)=0E0 !POLCALA - BUFE(2)=0E0 - BUFE(3)=0E0 - IF (.NOT.NSCUMB(OMCA,V_E,BUF,4)) GOTO 910 - BUF(0)=ICHAR('Y') !POLTYB - IF (.NOT.NSCUMB(OMCA,V_C,BUF,1)) GOTO 910 - BUFE(0)=180E0 !POLAB - BUFE(1)=0E0 !POLCALB - BUFE(2)=0E0 - BUFE(3)=0E0 - IF (.NOT.NSCUMB(OMCA,V_E,BUF,4)) GOTO 910 - END DO !TEL. - IF (.NOT.NSCUWF(OMCA)) GOTO 910 !FILL RECORD -C -C FREQUENCY TABLE -C -CC IF (.NOT.NSCUV2(OMCA,ONPOL,NFRQ,STH,OHW,SCW)) GOTO 910 !WRITE FQ HEADER -C -C MAKE FREQUENCY TABLE -C -CC DO I=0,NFRQ-1 !ALL FREQUENCIES -CC BUFI(0)=I+1 !FRQSEL -CC IF (.NOT.NSCUMB(OMCA,V_I,BUF,1)) GOTO 910 -CC BUFD(0)=(DFRQTB(I+1)-OHWD(OHW_FREQ_D))*1D6 !FREQUENCY -CC IF (.NOT.NSCUMB(OMCA,V_D,BUF,1)) GOTO 910 -CC BUFE(0)=DBNDTB(I+1)*1E6 !CH WIDTH -CC BUFE(1)=OHWE(OHW_BAND_E)*1E6 !TOTAL BANDWIDTH -CC IF (.NOT.NSCUMB(OMCA,V_E,BUF,2)) GOTO 910 -CC IF (DFRQTB(I+1).GT.1000) THEN -CC BUFI(0)=-1 !SIDEBAND -CC ELSE -CC BUFI(0)=+1 !SIDEBAND -CC END IF -CC IF (.NOT.NSCUMB(OMCA,V_I,BUF,1)) GOTO 910 -CC END DO -CC IF (.NOT.NSCUWF(OMCA)) GOTO 910 !FILL RECORD -C -C SOURCE TABLE -C -CC IF (.NOT.NSCUV3(OMCA,ONPOL,NFRQ,STH,OHW,SCW)) GOTO 910 !WRITE SU HEADER -C -C MAKE SOURCE TABLE -C -CC DO I=0,0 !ALL FIELDS -CC BUFI(0)=I+1 !ID. NO. -CC IF (.NOT.NSCUMB(OMCA,V_I,BUF,1)) GOTO 910 -CC CALL WNGMTS(12,STH(STH_FIELD_1),BUFC(1:16)) !SOURCE -CC IF (.NOT.NSCUMB(OMCA,V_C,BUF,16)) GOTO 910 -CC BUFI(0)=0 !QUAL -CC IF (.NOT.NSCUMB(OMCA,V_I,BUF,1)) GOTO 910 -CC BUFC(1:4)=' ' !CALCODE -CC IF (.NOT.NSCUMB(OMCA,V_C,BUF,4)) GOTO 910 -CC BUFE(0)=0E0 !IFLUX -CC BUFE(1)=0E0 !QFLUX -CC BUFE(2)=0E0 !UFLUX -CC BUFE(3)=0E0 !VFLUX -CC IF (.NOT.NSCUMB(OMCA,V_E,BUF,4)) GOTO 910 -CC BUFD(0)=0D0 !FREQOFF -CC BUFD(1)=STHE(STH_BAND_E)*1D6 !BANDWIDTH -CC BUFD(2)=WNGDFD(STHD(STH_RAE_D)) !RAEPO -CC BUFD(3)=WNGDND(WNGDFD(STHD(STH_DECE_D))) !DECEPO -CC BUFD(4)=STHE(STH_EPO_E) !EPOCH -CC BUFD(5)=WNGDFD(STHD(STH_RA_D)) !RAAPP -CC BUFD(6)=WNGDND(WNGDFD(STHD(STH_DEC_D))) !DECAPP -CC BUFD(7)=0D0 !LSRVEL -CC BUFD(8)=STHD(STH_FRQ_D)*1D6 !RESTFREQ -CC BUFD(9)=0D0 !PMRA -CC BUFD(10)=0D0 !PMDEC -CC IF (.NOT.NSCUMB(OMCA,V_D,BUF,11)) GOTO 910 -CC END DO -CC IF (.NOT.NSCUWF(OMCA)) GOTO 910 !FILL RECORD -C -C GAIN TABLE -C -CC IF (.NOT.NSCUV4(OMCA,ONPOL,NFRQ,STH,OHW,SCW)) GOTO 910 !WRITE SN HEADER -C -C MAKE GAIN TABLE -C -CC DO I=0,STHTEL-1 !ALL TEL. -CC BUFD(0)=0D0 !TIME -CC IF (.NOT.NSCUMB(OMCA,V_D,BUF,1)) GOTO 910 -CC BUFE(0)=1E0 !TIME INTERVAL -CC IF (.NOT.NSCUMB(OMCA,V_E,BUF,1)) GOTO 910 -CC BUFI(0)=1 !SOURCE ID -CC BUFI(1)=I+1 !ANTENNA NO. -CC BUFI(2)=0 !SUBARRAY -CC BUFI(3)=0 !NODE NO -CC IF (.NOT.NSCUMB(OMCA,V_I,BUF,4)) GOTO 910 -CC BUFE(0)=1E0 !REAL1 -CC BUFE(1)=0E0 !IMAG1 -CC BUFE(2)=0E0 !DELAY 1 -CC BUFE(3)=0E0 !RATE 1 -CC BUFE(4)=1E0 !WEIGHT 1 -CC IF (.NOT.NSCUMB(OMCA,V_E,BUF,5)) GOTO 910 -CC BUFI(0)=10 !REFANT 1 -CC IF (.NOT.NSCUMB(OMCA,V_I,BUF,1)) GOTO 910 -CC BUFE(0)=1E0 !REAL2 -CC BUFE(1)=0E0 !IMAG2 -CC BUFE(2)=0E0 !DELAY 2 -CC BUFE(3)=0E0 !RATE 2 -CC BUFE(4)=1E0 !WEIGHT 2 -CC IF (.NOT.NSCUMB(OMCA,V_E,BUF,5)) GOTO 910 -CC BUFI(0)=10 !REFANT 2 -CC IF (.NOT.NSCUMB(OMCA,V_I,BUF,1)) GOTO 910 -CC END DO -CC IF (.NOT.NSCUWF(OMCA)) GOTO 910 !FILL RECORD -C -C BANDPASS TABLE -C -CC IF (.NOT.NSCUV5(OMCA,ONPOL,NFRQ,STH,OHW,SCW)) GOTO 910 !WRITE BP HEADER -C -C MAKE BANDPASS TABLE -C -CC DO I=0,STHTEL-1 !ALL TEL. -CC BUFD(0)=0D0 !TIME -CC IF (.NOT.NSCUMB(OMCA,V_D,BUF,1)) GOTO 910 -CC BUFE(0)=1E0 !INTERVAL -CC IF (.NOT.NSCUMB(OMCA,V_E,BUF,1)) GOTO 910 -CC BUFI(0)=1 !SOURCE ID -CC BUFI(1)=0 !SUBARRAY -CC BUFI(2)=I+1 !ANTENNA NO. -CC IF (.NOT.NSCUMB(OMCA,V_I,BUF,3)) GOTO 910 -CC BUFE(0)=STHE(STH_BAND_E)*1E6 !BANDWIDTH -CC IF (.NOT.NSCUMB(OMCA,V_E,BUF,1)) GOTO 910 -CC BUFD(0)=STHD(STH_FRQ_D)*1D6 !IF FREQ -CC IF (.NOT.NSCUMB(OMCA,V_D,BUF,1)) GOTO 910 -CC BUFI(0)=10 !REFANT 1 -CC IF (.NOT.NSCUMB(OMCA,V_I,BUF,1)) GOTO 910 -CC BUFE(0)=1E0 !REAL1 -CC BUFE(1)=0E0 !IMAG1 -CC IF (.NOT.NSCUMB(OMCA,V_E,BUF,2)) GOTO 910 -CC BUFI(0)=10 !REFANT 2 -CC IF (.NOT.NSCUMB(OMCA,V_I,BUF,1)) GOTO 910 -CC BUFE(0)=1E0 !REAL2 -CC BUFE(1)=0E0 !IMAG2 -CC IF (.NOT.NSCUMB(OMCA,V_E,BUF,2)) GOTO 910 -CC END DO -CC IF (.NOT.NSCUWF(OMCA)) GOTO 910 !FILL RECORD -C -C END -C - CALL WNFCL(OMCA) !CLOSE OUTPUT - GOTO 200 !MORE FIELDS -C -C ERROR -C - 910 CONTINUE - CALL WNCTXT(F_TP,'Error writing FITS line') - 900 CONTINUE - CALL WNFCL(FCAIN) !CLOSE INPUT FILE - CALL WNFDMO(OMCA) !DISMOUNT/CLOSE OUTPUT -C - RETURN !READY -C -C - END diff --git a/src/nscan/nscuwb.for b/src/nscan/nscuwb.for deleted file mode 100644 index 6f9465a7d093176e776ba643284968de928542b3..0000000000000000000000000000000000000000 --- a/src/nscan/nscuwb.for +++ /dev/null @@ -1,100 +0,0 @@ -C+ NSCUWB.FOR -C WNB 910220 -C -C Revisions: -C - LOGICAL FUNCTION NSCUWB(FCAOUT,BUF) -C -C Write a fits card image and other info -C -C Result: -C -C NSCUWB_L = NSCUWB_L( FCAOUT_J:I, BUF(0:79)_B:I) -C write buffer BUF to line in FCAOUT -C NSCUWS_L = NSCUWS_L( FCAOUT_J:I, SBUF_C*:I) -C write the string in SBUF to line in FCAOUT -C NSCUWF_L = NSCUWF_L( FCAOUT_J:I) -C fill out FITS record on FCAOUT -C NSCUWL_L = NSCUWL_L( FCAOUT_J:I, BUF(0:*)_B:I, NBUF_J:I) -C write NBUF bytes to FCAOUT -C -C Include files: -C - INCLUDE 'WNG_DEF' -C -C Parameters: -C - INTEGER LRCLEN !RECORD LENGTH FITS (CHANGE ALSO NSCUWB) - PARAMETER (LRCLEN=2880) - INTEGER CDILEN !CARD IMAGE LENGTH - PARAMETER (CDILEN=80) - INTEGER NCDI !# OF CARD IMAGES/RECORD - PARAMETER (NCDI=LRCLEN/CDILEN) -C -C Arguments: -C - INTEGER FCAOUT !FILE POINTER - BYTE BUF(0:*) !BUFFER TO WRITE - CHARACTER*(*) SBUF !STRING TO WRITE - INTEGER NBUF !BUFFER LENGTH -C -C Entry points: -C - LOGICAL NSCUWS,NSCUWF,NSCUWL -C -C Function references: -C - LOGICAL WNFWRS !WRITE SEQUENTIAL DATA - INTEGER WNFEOF !FILE POINTER -C -C Data declarations: -C - BYTE LBUF(0:CDILEN-1) !LOCAL BUFFER -C- -C -C NSCUWB -C - NSCUWB=.TRUE. !ASSUME OK - IF (.NOT.WNFWRS(FCAOUT,CDILEN,BUF(0))) THEN !WRITE IMAGE - 10 CONTINUE - NSCUWB=.FALSE. - END IF -C - RETURN -C -C NSCUWS -C - ENTRY NSCUWS(FCAOUT,SBUF) -C - NSCUWS=.TRUE. !ASSUME OK - CALL WNGMFS(CDILEN,SBUF,LBUF(0)) !MAKE BUFFER - IF (.NOT.WNFWRS(FCAOUT,CDILEN,LBUF(0))) GOTO 10 !WRITE IMAGE -C - RETURN -C -C NSCUWL -C - ENTRY NSCUWL(FCAOUT,BUF,NBUF) -C - NSCUWL=.TRUE. !ASSUME OK - IF (.NOT.WNFWRS(FCAOUT,NBUF,BUF(0))) GOTO 10 !WRITE IMAGE -C - RETURN -C -C NSCUWF -C - ENTRY NSCUWF(FCAOUT) -C - NSCUWF=.TRUE. !ASSUME OK - J=WNFEOF(FCAOUT) !CURRENT POINTER - J=(((J+LRCLEN-1)/LRCLEN)*LRCLEN)-J !BYTES TO WRITE - CALL WNGMVZ(CDILEN,LBUF(0)) !ZERO BUFFER - DO I=1,J/CDILEN !WRITE FILLERS - IF (.NOT.WNFWRS(FCAOUT,CDILEN,LBUF(0))) GOTO 10 !WRITE IMAGE - END DO - IF (.NOT.WNFWRS(FCAOUT,MOD(J,CDILEN),LBUF(0))) GOTO 10 !WRITE LAST PART -C - RETURN -C -C - END diff --git a/src/nscan/nscwe0.for b/src/nscan/nscwe0.for deleted file mode 100644 index 745a35d47408a18dfab60abd3f75310611c8debf..0000000000000000000000000000000000000000 --- a/src/nscan/nscwe0.for +++ /dev/null @@ -1,229 +0,0 @@ -C+ NSCWE0.FOR -C WNB 911031 -C -C Revisions: -C WNB 921221 Add WE2 -C HjV 930311 Change some text -C CMV 010213 Add WE3 for velocities -C - SUBROUTINE NSCWE0 -C -C Correct SCN file for mosaic WSRT tape HA error -C -C Result: -C -C CALL NSCWE0 will correct a SCN file for mosaic HA error -C CALL NSCWE1 will correct a SCN file for HA offsets -C CALL NSCWE2 will flop data phases -C CALL NSCWE3 will recalc velocities -C -C PIN: -C -C WERR_RA -C WERR_HA -C -C Include files: -C - INCLUDE 'WNG_DEF' - INCLUDE 'NSC_DEF' - INCLUDE 'STH_O_DEF' !SET HEADER - INCLUDE 'STH_T_DEF' - INCLUDE 'SCH_O_DEF' !SCAN HEADER - INCLUDE 'SCH_T_DEF' -C -C Parameters: -C -C -C Arguments: -C -C -C Function references: -C - LOGICAL WNFWR !WRITE DATA - LOGICAL WNFRD !READ DATA - CHARACTER*32 WNTTSG !SET NAME - LOGICAL WNDPAR !GET USER DATA - LOGICAL NSCSTG !GET A SET - LOGICAL NSCSCH !GET SCAN HEADER - LOGICAL NSCSCW !WRITE SCAN HEADER -C -C Data declarations: -C - INTEGER TYP !0..3 - DOUBLE PRECISION RAOFF !RIGHT ASCENSION OF MOSAIC AREA CENTRE - DOUBLE PRECISION HAOFF !HOUR ANGLE CORRECTION TO BE ADDED - DOUBLE PRECISION REFVEL !REFERENCE VELOCITY - INTEGER STHP !SET HEADER POINTER - INTEGER SNAM(0:7) !SET NAME - INTEGER*2 LDAT(0:2,0:4*STHIFR-1) !DATA BUFFER - BYTE STH(0:STHHDL-1) !SET HEADER - INTEGER*2 STHI(0:STHHDL/2-1) - INTEGER STHJ(0:STHHDL/4-1) - REAL STHE(0:STHHDL/4-1) - DOUBLE PRECISION STHD(0:STHHDL/8-1) - EQUIVALENCE (STH,STHI,STHJ,STHE,STHD) - BYTE SCH(0:SCHHDL-1) !SCAN HEADER - INTEGER*2 SCHI(0:SCHHDL/2-1) - INTEGER SCHJ(0:SCHHDL/4-1) - REAL SCHE(0:SCHHDL/4-1) - DOUBLE PRECISION SCHD(0:SCHHDL/8-1) - EQUIVALENCE (SCH,SCHI,SCHJ,SCHE,SCHD) -C- -C -C WE0 -C - TYP=0 - IF (.NOT.WNDPAR('WERR_RA',RAOFF,LB_D,J0,'""')) GOTO 800 !GET DATA - IF (J0.NE.1) GOTO 800 - RAOFF=RAOFF/360 !MAKE CIRCLES - GOTO 10 -C -C WE1 -C - ENTRY NSCWE1 -C - TYP=1 - IF (.NOT.WNDPAR('WERR_HA',HAOFF,LB_D,J0,'""')) GOTO 800 !GET DATA - IF (J0.NE.1) GOTO 800 - HAOFF=HAOFF/360 !MAKE CIRCLES - GOTO 10 -C -C WE2 -C - ENTRY NSCWE2 -C - TYP=2 - GOTO 10 -C -C WE3 -C - ENTRY NSCWE3 -C - TYP=3 - IF (.NOT.WNDPAR('WERR_VEL',REFVEL,LB_D,J0,'""')) GOTO 800 !GET DATA - IF (J0.NE.1) GOTO 800 - GOTO 10 -C -C INIT -C - 10 CONTINUE -C -C DO ALL SETS -C - DO WHILE (NSCSTG(FCAOUT,SETS,STH,STHP,SNAM)) !GET SET -C -C ALL SCANS -C - IF (TYP.NE.3) THEN - DO I=0,STHJ(STH_SCN_J)-1 !ALL SCANS - IF (.NOT.NSCSCH(FCAOUT,STH,0,I,0,0,SCH)) THEN !READ SCAN HEADER - 30 CONTINUE - CALL WNCTXT(F_TP,'Error updating scan !UJ of Sector !AS', - 1 I,WNTTSG(SNAM,0)) - GOTO 20 !NEXT SET - END IF - IF (TYP.EQ.0) THEN !MOSAIC ERROR - SCHE(SCH_HA_E)=SCHE(SCH_HA_E)+RAOFF-STHD(STH_RA_D) - IF (.NOT.NSCSCW(FCAOUT,STH,0,I,0,0,SCH)) GOTO 30 !WRITE HEADER - - ELSE IF (TYP.EQ.1) THEN !HA ERROR - SCHE(SCH_HA_E)=SCHE(SCH_HA_E)+HAOFF - IF (.NOT.NSCSCW(FCAOUT,STH,0,I,0,0,SCH)) GOTO 30 !WRITE HEADER - - ELSE IF (TYP.EQ.2) THEN !SWAP PHASES - IF (.NOT.WNFRD(FCAOUT,STHJ(STH_SCNL_J)-SCHHDL, - 1 LDAT,STHJ(STH_SCNP_J)+ - 1 STHJ(STH_SCNL_J)*I+SCHHDL)) GOTO 30 !READ DATA - DO I1=0,STHJ(STH_NIFR_J)-1 !ALL IFRS - DO I2=0,STHI(STH_PLN_I)-1 !ALL POL. - LDAT(2,STHI(STH_PLN_I)*I1+I2)= - 1 -LDAT(2,STHI(STH_PLN_I)*I1+I2) - END DO - END DO - IF (.NOT.WNFWR(FCAOUT,STHJ(STH_SCNL_J)-SCHHDL, - 1 LDAT,STHJ(STH_SCNP_J)+ - 1 STHJ(STH_SCNL_J)*I+SCHHDL)) GOTO 30 !WRITE DATA - END IF -C -C NEXT SCAN -C - END DO - ENDIF -C -C CORRECTIONS TO SECTOR HEADER -C - IF (TYP.EQ.0) THEN !MOSAIC ERROR - STHE(STH_HAB_E)=STHE(STH_HAB_E)+RAOFF-STHD(STH_RA_D) - - ELSE IF (TYP.EQ.1) THEN !HA ERROR - STHE(STH_HAB_E)=STHE(STH_HAB_E)+HAOFF - - ELSE IF (TYP.EQ.3) THEN !RECALC VELOCITY -C -C SWAP FRQC AND FRQ0 IF NEEDED -C - IF (REFVEL.GT.0 .AND. - 1 STHD(STH_FRQC_D).GT.STHD(STH_FRQ0_D)) THEN - D0=STHD(STH_FRQC_D) - STHD(STH_FRQC_D)=STHD(STH_FRQ0_D) - STHD(STH_FRQ0_D)=D0 - CALL WNCTXT(F_TP,'!AS FRQ0/FRQC swapped', - 1 WNTTSG(SNAM,0)) - END IF -C -C FILL IN VELC IF NEEDED -C - IF (STHJ(STH_VELC_J).LE.0) THEN - STHJ(STH_VELC_J)=3 !BARY, OPTICAL - END IF -C -C FILL IN VELR ACCORDING TO USER INPUT -C - STHE(STH_VELR_E)=REFVEL -C -C CALCULATE VEL FROM CHANNEL FREQUENCY, CENTRE FREQUENCY AND VELOCITY -C - R0=STHE(STH_VEL_E) !FOR LISTING - IF (STHJ(STH_VELC_J).EQ.1 .OR. - 1 STHJ(STH_VELC_J).EQ.2) THEN !RADIO - STHE(STH_VEL_E)=STHE(STH_VELR_E)*STHD(STH_FRQV_D)/ - 1 STHD(STH_FRQC_D)+ - 1 CL*(STHD(STH_FRQC_D)-STHD(STH_FRQV_D))/ - 1 STHD(STH_FRQC_D) - ELSE !OPTICAL - STHE(STH_VEL_E)=STHE(STH_VELR_E)*STHD(STH_FRQC_D)/ - 1 STHD(STH_FRQV_D)+ - 1 CL*(STHD(STH_FRQC_D)-STHD(STH_FRQV_D))/ - 1 STHD(STH_FRQV_D) - END IF - CALL WNCTXT(F_TP, - 1 '!AS FRQ=!10$D15.5 VEL=!20$E20.5 (!20$E20.5)', - 1 WNTTSG(SNAM,0),STHD(STH_FRQV_D), - 1 STHE(STH_VEL_E),R0) - END IF - - IF (.NOT.WNFWR(FCAOUT,STHHDL,STH,STHP)) THEN !REWRITE SET HEADER - CALL WNCTXT(F_TP,'Error updating Sector !AS', - 1 WNTTSG(SNAM,0)) - END IF -C -C NEXT SET -C - 20 CONTINUE - END DO -C -C READY -C - 800 CONTINUE - CALL WNFCL(FCAOUT) !CLOSE FILE -C - RETURN -C -C ERROR -C - 900 CONTINUE - CALL WNFCL(FCAOUT) !CLOSE FILE - RETURN !READY -C -C - END diff --git a/src/nscan/nscxes.for b/src/nscan/nscxes.for deleted file mode 100644 index 9f704e1b39e41e87ae871c01e3325eccc5c99517..0000000000000000000000000000000000000000 --- a/src/nscan/nscxes.for +++ /dev/null @@ -1,282 +0,0 @@ -C+ NSCXES.FOR -C WNB 910211 -C -C Revisions: -C WNB 931214 Correct for string data; add P:, S: -C WNB 931215 Add specified formats -C - SUBROUTINE NSCXES(PTYPE,DAT,EDL,EDC,EDJ,PLIST, - 1 PNXT,PEPTR,PHP,PSZ) -C -C Edit an area in detail -C -C Result: -C -C CALL NSCXES ( PTYPE_J:I, DAT_B(*):I, EDL_J:I, EDC_C*(4,*):I, -C EDJ_J(4,*):I, PLIST_C*(*):I, PNXT_J:O, -C PEPTR_J:O, PHP_J:O, PSZ_J(0:1)_O) -C Edit the area DAT and show on PTYPE -C with EDL edit lines given in -C EDC and EDJ. -C PLIST contains a list (last ' ') of -C known P:/S: values. -C PNXT will return 0 if ready, number -C in list if P:/S: recognised; then -C PEPTR points to line in ED; PHP to -C disk address. PSZ returns the P: () -C and / values. -C -C Include files: -C - INCLUDE 'WNG_DEF' -C -C PIN references: -C -C EDIT -C -C Parameters: -C - INTEGER LENFLD !LENGTH INPUT FIELD - PARAMETER (LENFLD=80) - INTEGER MXNFLD !MAX. # OF INPUT FIELDS - PARAMETER (MXNFLD=16) -C -C Arguments: -C - INTEGER PTYPE !PRINT TYPE (f_p, f_t ETC) - BYTE DAT(0:*) !DATA AREA - INTEGER EDL !LENGTH EDIT ARRAYS - CHARACTER*(*) EDC(4,*) !EDIT DATA - INTEGER EDJ(4,*) !EDIT DATA - CHARACTER*(*) PLIST(*) !LIST OF P:NAMES - INTEGER PNXT !RETURN VALUE - INTEGER PEPTR !WHERE FOUND IN EDIT LIST - INTEGER PHP !WHERE ON DISK - INTEGER PSZ(0:1) !OFFSET AND NUMBER OF P: -C -C Function references: -C - LOGICAL WNDPAR !GET USER DATA - INTEGER WNCAFU !MINI-MAX FIT - LOGICAL WNCACJ !GET J FROM STRING - LOGICAL WNCAFN !GET FIELD - LOGICAL WNCASC !TEST CHARACTER - INTEGER WNCALN !STRING LENGTH - INTEGER WNGGJ !GET J -C -C Data declarations: -C - CHARACTER*(LENFLD) TXT(MXNFLD) !INPUT DATA - CHARACTER*16 TXT1 !FORMAT - CHARACTER*16 LPED !LOCAL EDIT - CHARACTER*16 LPFORM !LOCAL P: NAME - CHARACTER*10 LEDC(4) !LOCAL COPY EDIT INFO - INTEGER LEDJ(4) - INTEGER LIDX !LOCAL INDEX - CHARACTER*8 LNAM,LPNAM !LOCAL NAME - INTEGER LSIZ !LOCAL SIZE - INTEGER LFLD !OFFSET IF NO NAME - LOGICAL LOVER !OVERWRITE PROTECTION - LOGICAL LREL !RELATIVE ADDRESS -C- -C -C GET EDIT INFO -C - 10 CONTINUE - PNXT=0 !ASSUME LAST IN P: TREE - IF (.NOT.WNDPAR('EDIT',TXT,MXNFLD*LENFLD,J0,'""')) THEN - IF (E_C.EQ.DWC_ENDOFLOOP) RETURN !READ - GOTO 10 !RETRY - ELSE IF (J0.EQ.0) THEN !NO MORE - RETURN - ELSE IF (J0.LT.0) THEN !DO SHOW - CALL WNCTXT(PTYPE,' ') - CALL NSCXXS(PTYPE,DAT,EDL,EDC,EDJ) - GOTO 10 !MUST SPECIFY - END IF - CALL WNCAUC(TXT(1)) !MAKE UC -C -C SET LOCAL FORMATS -C - I=INDEX(TXT(1),':') !FIND : - IF (I.GT.0) THEN !LOCAL FORMAT GIVEN - LPED=TXT(1)(I+1:) - TXT(1)(I:)=' ' - IF (LPED.EQ.' ') LPED='-' !ASK QUESTION - ELSE - LPED=' ' - END IF - IF (LPED(1:1).EQ.':') THEN !P: ASKED - LPFORM=LPED - LPED=' ' - ELSE - LPFORM=' ' - END IF - IF (LPED.NE.' ' .AND. LPED.NE.'-') THEN - IF (INDEX(LPED,'$').LE.0) THEN !NO FIELDWIDTH - LPED='26$'//LPED - END IF - END IF - I=1 !ANALYSE NAME - CALL WNCASB(TXT(1),I) !SKIP BLANK - JS=WNCAFN(TXT(1),I,LNAM) - IF (.NOT.JS) THEN !NO NAME - IF (WNCASC(TXT(1),I,'.')) THEN !RELATIVE ADDRESS - LREL=.TRUE. - ELSE - LREL=.FALSE. - END IF - CALL WNCASB(TXT(1),I) - IF (.NOT.WNCACJ(TXT(1),I,10,LFLD)) THEN !NO VALUE - IF (LPFORM.EQ.' ') THEN - CALL WNCTXT(PTYPE,'Known names:') - DO I=1,EDL - CALL WNCTXT(PTYPE,'!_!8$4AS; !5$4UJ', - 1 EDC(1,I),EDJ(1,I)) !SHOW NAMES - END DO - GOTO 10 - END IF - END IF - END IF - CALL WNCASB(TXT(1),I) - IF (WNCASC(TXT(1),I,'(')) THEN !INDEX - JS=WNCACJ(TXT(1),I,10,LIDX) !GET INDEX - ELSE - LIDX=0 - END IF - LIDX=MAX(0,LIDX) - CALL WNCASB(TXT(1),I) - JS=WNCASC(TXT(1),I,')') !POSSIBLE ) - IF (WNCASC(TXT(1),I,'/')) THEN !SIZE - CALL WNCASB(TXT(1),I) - IF (WNCASC(TXT(1),I,'*')) THEN !S: SPECIAL - LSIZ=-1 - LIDX=0 - ELSE - JS=WNCACJ(TXT(1),I,10,LSIZ) - END IF - ELSE - LSIZ=0 - END IF - LOVER=(WNCASC(TXT(1),I,'=') .AND. WNCASC(TXT(1),I,'=')) !UNPROTECT - IF (LPFORM(1:1).EQ.':') THEN - I=2 !ANALYSE NAME P: - CALL WNCASB(LPFORM,I) !SKIP BLANK - IF (.NOT.WNCAFN(LPFORM,I,LPNAM)) THEN !NO NAME - I1=0 - DO WHILE (PLIST(I1+1).NE.' ') - I1=I1+1 - END DO - CALL WNCTXT(PTYPE,'!80$8Q\Known P: types: !#AS',I1,PLIST) - GOTO 10 !NEXT QUESTION - END IF - CALL WNCASB(LPFORM,I) - IF (WNCASC(LPFORM,I,'(')) THEN !INDEX - JS=WNCACJ(LPFORM,I,10,PSZ(0)) !GET INDEX - ELSE - PSZ(0)=0 - END IF - PSZ(0)=MAX(0,PSZ(0)) - CALL WNCASB(LPFORM,I) - JS=WNCASC(LPFORM,I,')') !POSSIBLE ) - IF (WNCASC(LPFORM,I,'/')) THEN !SIZE - JS=WNCACJ(LPFORM,I,10,PSZ(1)) - ELSE - PSZ(1)=0 - END IF - ELSE - LPNAM=' ' - PSZ(0)=0 - PSZ(1)=0 - END IF -C -C FIND FIELD -C - DO I=1,EDL - IF (EDC(1,I).EQ.LNAM) THEN - PEPTR=I - DO I1=1,4 - LEDJ(I1)=EDJ(I1,I) !COPY EDIT INFO - LEDC(I1)=EDC(I1,I) - END DO - IF (LPED.NE.' ') THEN - IF (LPED.EQ.'-') THEN !FORMAT ASKED - CALL WNCTXT(PTYPE,'Edit data: !4AS; !4UJ', - 1 LEDC,LEDJ) - GOTO 10 !CONTINUE - END IF - LEDC(2)=LPED !SET LOCAL FORMAT - END IF - LIDX=MIN(LIDX,LEDJ(2)-1) !LIMIT OFFSET - LEDJ(1)=LEDJ(1)+LIDX*LEDJ(4) !PROPER OFFSET - LEDJ(2)=LEDJ(2)-LIDX !MAX. NUMBER - IF (LSIZ.GT.0) LEDJ(2)=MIN(LEDJ(2),LSIZ) !LIMIT SIZE - IF (LPNAM.NE.' ') THEN - LEDC(4)='P:'//LPNAM !SET NAME - PEPTR=-PEPTR !INDICATE USER GIVEN - END IF - GOTO 20 !FOUND - END IF - END DO - IF (LNAM.NE.' ') THEN - CALL WNCTXT(PTYPE,'Unknown fieldname') - GOTO 10 !RETRY - END IF - IF (LPNAM.EQ.' ') THEN - CALL WNCTXT(PTYPE,'Must have :: format for numeric address') - GOTO 10 - ELSE - LEDC(4)='P:'//LPNAM !MAKE SURE FILLED - END IF -C -C EDIT -C - 20 CONTINUE - IF (J0.EQ.1) THEN !READY - IF (LEDC(4)(1:2).EQ.'P:') THEN !POINTER FIELD - PNXT=WNCAFU(LEDC(4)(3:),PLIST) !FIND P: AREA - IF (PNXT.GT.0) THEN !FOUND P: - IF (LNAM.EQ.' ') THEN !NUMERIC ADDRESS - PHP=LFLD - IF (LREL) PNXT=PNXT+1000 - ELSE IF (WNCALN(PLIST(PNXT)).EQ.1) THEN - PHP=LEDJ(1) !SET OFFSET - PNXT=PNXT+1000 - ELSE - PHP=WNGGJ(DAT(LEDJ(1))) !DISK POINTER - END IF - RETURN - END IF - ELSE IF (LEDC(4)(1:2).EQ.'S:') THEN !SUB-STRUCTURE - PNXT=WNCAFU(LEDC(4),PLIST) !FIND S: AREA - IF (PNXT.GT.0) THEN - PHP=LEDJ(1) !OFFSET - PSZ(0)=LSIZ !GET SPECIAL * - IF (PSZ(0).NE.-1) PNXT=PNXT+1000 !OFFSET - RETURN - END IF - END IF - ELSE IF ((IAND(LEDJ(3),1).NE.0 .AND. .NOT.LOVER) .OR. - 1 LEDC(4)(1:2).EQ.'P:' .OR. - 1 LEDC(4)(1:2).EQ.'S:') THEN - CALL WNCTXT(PTYPE,'Edit of field !AS not allowed', - 1 LEDC(1)) - ELSE - DO J3=0,MIN(J0-2,LEDJ(2)-1) !DO ALL FIELDS - TXT1='!'//LEDC(2) !FORMAT - IF (INDEX(LEDC(2),'AL').GT.0) !AL - 1 CALL WNCTXS(TXT1(2:),'AL!UJ',LEDJ(4)) - CALL WNCTXI(TXT(J3+2),TXT1, - 1 DAT(LEDJ(1)+J3*LEDJ(4))) !GET VALUE - END DO - END IF -C -C SHOW RESULT -C - 30 CONTINUE - CALL NSCXXS(PTYPE,DAT,1,LEDC,LEDJ) !SHOW LINE ITEM -C - GOTO 10 !TRY AGAIN -C -C - END diff --git a/src/nscan/nscxfh.for b/src/nscan/nscxfh.for deleted file mode 100644 index e9f0651fdaed7420e9205ff53e8f61e80b7510dc..0000000000000000000000000000000000000000 --- a/src/nscan/nscxfh.for +++ /dev/null @@ -1,229 +0,0 @@ -C+ NSCXFH.FOR -C WNB 910211 -C -C Revisions: -C WNB 931216 New EDIT facility -C - SUBROUTINE NSCXFH(PTYPE,INFCA) -C -C Show SCN file header -C -C Result: -C -C CALL NSCXFH ( PTYPE_J:I, INFCA_J:I) -C Show on output PTYPE the file header -C of file INFCA. -C CALL NSCEFH ( PTYPE_J:I, INFCA_J:I) -C Edit file header -C -C Include files: -C - INCLUDE 'WNG_DEF' - INCLUDE 'GFH_O_DEF' !GENERAL FILE HEADER - INCLUDE 'SGH_O_DEF' - INCLUDE 'GFH_E_DEF' !EDIT INFORMATION - INCLUDE 'SGH_E_DEF' -C -C Parameters: -C - INTEGER MXDEP !MAX. NESTING DEPTH - PARAMETER (MXDEP=8) - INTEGER D_GEDL !GENERAL DATA - PARAMETER (D_GEDL=1) - INTEGER D_GMAX !MAX. # OF DATA POINTS - PARAMETER (D_GMAX=100) -C -C Arguments: -C - INTEGER PTYPE !PRINT TYPE (f_p, f_t ETC) - INTEGER INFCA !FILE DESCRIPTOR -C -C Function references: -C - LOGICAL WNFRD !READ DATA - LOGICAL WNFWR !WRITE DATA - INTEGER WNGGJ !GET J -C -C Data declarations: -C - CHARACTER*8 PLIST(13) !KNOWN P: AREAS - DATA PLIST/ 'GFH','SGH','STH', - 1 'B','I','J','E','D','X','Y', - 1 'MPH','NGF', - 1 ' '/ - INTEGER PLEN(0:1,13) !P: LENGTH - DATA PLEN/ -1,GFHHDL, - 1 -1,SGHHDL, - 1 -1,4, - 1 -1,LB_B,-1,LB_I,-1,LB_J,-1,LB_E, - 1 -1,LB_D,-1,LB_X,-1,LB_Y, - 1 -1,4, - 1 -1,4, - 1 0,0/ - INTEGER DEP !CURRENT DEPTH - INTEGER DEPAR(4,MXDEP) !SAVE DEPTH - INTEGER CHP,CHDL !CURRENT HEADER LENGTH, PTR - INTEGER CTYP,CEDP !CURRENT HEADER TYPE #, PTR INTO EDIT - INTEGER CHPT !NEXT HEADER POINTER - INTEGER PSZ(0:1) !P: OFFSET AND SIZE - BYTE STH(0:4-1) !DUMMY STH HEADER - BYTE GFH(0:GFHHDL-1) !FILE HEADER - BYTE SGH(0:SGHHDL-1) - BYTE D_G(0:D_GMAX*LB_Y-1) - EQUIVALENCE (STH,GFH,SGH,D_G) - CHARACTER*8 D_G_EC(4,7) !DATA TABLES - DATA D_G_EC/ 'B','SB',' ',' ', - 1 'I','SI',' ',' ', - 1 'J','SJ',' ',' ', - 1 'E','E12.6',' ',' ', - 1 'D','D12.8',' ',' ', - 1 'X','26$EC12.6',' ',' ', - 1 'Y','26$DC12.8',' ',' '/ - INTEGER D_G_EJ(4,7) - DATA D_G_EJ/ 0,1,0,LB_B, - 1 0,1,0,LB_I, - 1 0,1,0,LB_J, - 1 0,1,0,LB_E, - 1 0,1,0,LB_D, - 1 0,1,0,LB_X, - 1 0,1,0,LB_Y/ -C- -C -C GET HEADER -C - IF (.NOT.WNFRD(INFCA,GFHHDL,GFH,0)) THEN - CALL WNCTXT(PTYPE,'Read error on input node') - RETURN - END IF -C -C SHOW HEADER -C - CALL WNCTXT(PTYPE,'!/File description of node !AD\:!/', - 1 GFH(GFH_NAME_1),GFH_NAME_N) - CALL NSCXXS(PTYPE,GFH,GFHEDL,GFH_EC,GFH_EJ) !ACTUAL SHOW -C - RETURN -C -C NSCEXS -C - ENTRY NSCEFH(PTYPE,INFCA) -C -C INIT -C - DEP=0 !CURRENT DEPTH - CHP=0 !HEADER POINTER - CTYP=1 !CURRENT TYPE (GFH) - CEDP=-1 !CURRENT POINTER IN EDIT LIST - CHDL=GFHHDL !CURRENT LENGTH -C -C ACTION -C - 10 CONTINUE - DO WHILE (CTYP.GT.0) !SOMETHING TO DO - IF (CHDL.LE.0) THEN !GET NEW HEADER - IF (PLEN(0,CTYP).GE.0 .AND. CEDP.GT.0) THEN - CHDL=WNGGJ(STH(PLEN(0,CTYP))) !LENGTH FROM FILE - ELSE - CHDL=PLEN(1,CTYP) !DEFAULT LENGTH - END IF - CHDL=MIN(CHDL,PLEN(1,CTYP)) !MAKE SURE NO PROBLEMS - IF (CHDL.LE.0) GOTO 20 !NOT PRESENT; RESTART CURRENT - END IF -C -C GET HEADER -C - IF (CHP.EQ.0 .AND. - 1 (CTYP.LT.1 .OR. - 1 (CTYP.GT.1 .AND. CTYP.LT.4) .OR. - 1 (CTYP.GT.10))) GOTO 20 !NOT PRESENT - IF (CHP.GT.0 .AND. CHP.LT.GFHHDL .AND. - 1 (CTYP.LT.4 .OR. CTYP.GT.10)) THEN !MUST BE GFH - CTYP=1 - CHDL=PLEN(1,CTYP) - CHP=0 - CEDP=-1 - END IF - CALL WNGMVZ(PLEN(1,CTYP),STH) !CLEAR BEFORE READ - IF (.NOT.WNFRD(INFCA,CHDL,STH,CHP)) THEN - CALL WNCTXT(PTYPE,'Read error on input node') - RETURN - END IF -C -C EDIT HEADER -C - IF (CTYP.NE.3 .AND. CTYP.NE.11 .AND. CTYP.NE.12) - 1 CALL WNCTXT(PTYPE,'*** Editing !AS ***',PLIST(CTYP)) - IF (DEP.GE.MXDEP) THEN !SHIFT ONE - DO I=1,MXDEP-1 - DO I1=1,4 - DEPAR(I1,I)=DEPAR(I1,I+1) - END DO - END DO - DEP=MXDEP-1 - END IF - DEP=DEP+1 !SAVE PREVIOUS - DEPAR(1,DEP)=CHP - DEPAR(2,DEP)=CTYP - DEPAR(3,DEP)=CEDP - DEPAR(4,DEP)=CHDL - IF (CTYP.EQ.1) THEN - CALL NSCXES(PTYPE,STH,SGHEDL,GFH_EC,GFH_EJ,PLIST, - 1 CTYP,CEDP,CHPT,PSZ) - ELSE IF (CTYP.EQ.2) THEN - CALL NSCXES(PTYPE,STH,SGHEDL,SGH_EC,SGH_EJ,PLIST, - 1 CTYP,CEDP,CHPT,PSZ) - ELSE IF (CTYP.EQ.3) THEN - CALL NSCESH(PTYPE,INFCA,CHP,0) !DO STH - CTYP=0 !END CONTINUE - ELSE IF (CTYP.GE.4 .AND. CTYP.LE.10) THEN - CALL NSCXES(PTYPE,STH,D_GEDL, - 1 D_G_EC(1,CTYP-3),D_G_EJ(1,CTYP-3),PLIST, - 1 CTYP,CEDP,CHPT,PSZ) - ELSE IF (CTYP.EQ.11) THEN - CALL NMAEMH(PTYPE,INFCA,CHP,0) !DO MPH - CTYP=0 !END CONTINUE - ELSE IF (CTYP.EQ.12) THEN - CALL NGCEMH(PTYPE,INFCA,CHP,0) !DO NGF - CTYP=0 !END CONTINUE - END IF - IF (CTYP.GE.1000) THEN !RELATIVE ADDRESS - CTYP=MOD(CTYP,1000) !GET CORRECT TYPE - CHPT=CHP+CHPT !CATER FOR OFFSET GIVEN - END IF - IF (CTYP.GE.4 .AND. CTYP.LE.10) THEN - CHPT=CHPT+PSZ(0)*D_G_EJ(4,CTYP-3) !CATER FOR GIVEN OFFSET - D_G_EJ(2,CTYP-3)=MAX(1,MIN(PSZ(1),D_GMAX)) !MAX. NUMBER TO DO - END IF -C -C REWRITE HEADER -C - IF (.NOT.WNFWR(INFCA,CHDL,STH,CHP)) THEN - 30 CONTINUE - CALL WNCTXT(PTYPE,'Write error on input node') - RETURN - END IF - CHP=CHPT !NEXT HEADER POINTER - IF (CTYP.GE.4 .AND. CTYP.LE.10) THEN - CHDL=D_G_EJ(2,CTYP-3)*D_G_EJ(4,CTYP-3) !NEW LENGTH - ELSE - CHDL=0 !NEXT HEADER LENGTH - END IF - END DO -C -C RETURN PREVIOUS LEVEL -C - DEP=DEP-1 - 20 CONTINUE - IF (DEP.GT.0) THEN !CAN DO MORE - CHP=DEPAR(1,DEP) - CTYP=DEPAR(2,DEP) - CEDP=DEPAR(3,DEP) - CHDL=DEPAR(4,DEP) - DEP=DEP-1 - GOTO 10 - END IF -C - RETURN -C -C - END diff --git a/src/nscan/nscxsh.for b/src/nscan/nscxsh.for deleted file mode 100644 index b962043ff4a645d17c06762b2b0d5bb298e7629c..0000000000000000000000000000000000000000 --- a/src/nscan/nscxsh.for +++ /dev/null @@ -1,391 +0,0 @@ -C+ NSCXSH.FOR -C WNB 910211 -C -C Revisions: -C HjV 930311 Change some text -C WNB 931214 Cater for P: -C CMV 940525 Add IFH structure -C - SUBROUTINE NSCXSH(PTYPE,INFCA,STHP,SNAM) -C -C Show set header -C -C Result: -C -C CALL NSCXSH ( PTYPE_J:I, INFCA_J:I, STHP_J:I, SNAM_J(*):I) -C Show on output PTYPE the set at STHP -C of file INFCA. -C CALL NSCESH ( PTYPE_J:I, INFCA_J:I, STHP_J:I, SNAM_J(*):I) -C Edit set header -C -C Include files: -C - INCLUDE 'WNG_DEF' - INCLUDE 'STH_O_DEF' !SET HEADER - INCLUDE 'FDW_O_DEF' - INCLUDE 'FDX_O_DEF' - INCLUDE 'OHW_O_DEF' - INCLUDE 'SCW_O_DEF' - INCLUDE 'SHW_O_DEF' - INCLUDE 'GFH_O_DEF' - INCLUDE 'MDH_O_DEF' - INCLUDE 'SGH_O_DEF' - INCLUDE 'MDL_O_DEF' - INCLUDE 'SCH_O_DEF' - INCLUDE 'IFH_O_DEF' - INCLUDE 'STH_E_DEF' !EDIT INFORMATION - INCLUDE 'FDW_E_DEF' - INCLUDE 'FDX_E_DEF' - INCLUDE 'OHW_E_DEF' - INCLUDE 'SCW_E_DEF' - INCLUDE 'SHW_E_DEF' - INCLUDE 'GFH_E_DEF' - INCLUDE 'MDH_E_DEF' - INCLUDE 'SGH_E_DEF' - INCLUDE 'MDL_E_DEF' - INCLUDE 'SCH_E_DEF' - INCLUDE 'IFH_E_DEF' -C -C Parameters: -C - INTEGER MXDEP !MAX. NESTING DEPTH - PARAMETER (MXDEP=8) - INTEGER IFRTEDL !LENGTH IFR EDIT - PARAMETER (IFRTEDL=1) - INTEGER MDDEDL !MODEL DATA - PARAMETER (MDDEDL=1) - INTEGER IFRCEDL !IFR CORRECTIONS - PARAMETER (IFRCEDL=1) - INTEGER D_GEDL !GENERAL DATA - PARAMETER (D_GEDL=1) -C -C Arguments: -C - INTEGER PTYPE !PRINT TYPE (f_p, f_t ETC) - INTEGER INFCA !FILE DESCRIPTOR - INTEGER STHP !SET HEADER POINTER - INTEGER SNAM(*) !SET NAME -C -C Function references: -C - LOGICAL WNFRD !READ DATA - LOGICAL WNFWR !WRITE DATA - INTEGER WNGGJ !GET J - CHARACTER*32 WNTTSG !SHOW SET NUMBER -C -C Data declarations: -C - CHARACTER*8 PLIST(28) !KNOWN P: AREAS - DATA PLIST/ 'STH','FDW','OHW','SCW','SHW','FDX', - 1 'GFH','IFRT','MDH','MDD','SGH','MDL', - 1 'SCH','IFRC', - 1 'B','I','J','E','D','X','Y', - 1 'S:SET','S:SRC','S:BCOR','S:MOZP','S:IFR', - 1 'IFH', - 1 ' '/ - INTEGER PLEN(0:1,28) !P: LENGTH - DATA PLEN/ -1,STHHDL, - 1 STH_NFD_1,FDWHDL, - 1 STH_NOH_1,OHWHDL, - 1 STH_NSC_1,SCWHDL, - 1 STH_NSH_1,SHWHDL, - 1 STH_NFD_1,FDXHDL, - 1 -1,GFHHDL, - 1 -1,-1, - 1 -1,MDHHDL, - 1 -1,-1, - 1 -1,SGHHDL, - 1 -1,MDLHDL, - 1 -1,SCHHDL, - 1 -1,-1, - 1 -1,LB_B,-1,LB_I,-1,LB_J,-1,LB_E, - 1 -1,LB_D,-1,LB_X,-1,LB_Y, - 1 -1,SETHDL,-1,SRCHDL,-1,BCORHDL,-1,MOZPHDL,-1,IFRHDL, - 1 -1,IFHHDL, - 1 0,0/ - INTEGER DEP !CURRENT DEPTH - INTEGER DEPAR(4,MXDEP) !SAVE DEPTH - INTEGER CHP,CHDL !CURRENT HEADER LENGTH, PTR - INTEGER CTYP,CEDP !CURRENT HEADER TYPE #, PTR INTO EDIT - INTEGER CHPT !NEXT HEADER POINTER - INTEGER PSZ(0:1) !P: OFFSET AND SIZE - INTEGER TSCNL,TSCNN !LENGTH ONE SCAN, # OF SCANS - BYTE STH(0:STHHDL-1) !SET HEADER - BYTE FDW(0:FDWHDL-1) - BYTE FDX(0:FDXHDL-1) - BYTE OHW(0:OHWHDL-1) - BYTE SCW(0:SCWHDL-1) - BYTE SHW(0:SHWHDL-1) - BYTE GFH(0:GFHHDL-1) - INTEGER*2 IFRT(0:STHIFR-1) - BYTE MDH(0:MDHHDL-1) - COMPLEX MDD(0:3,0:STHIFR-1) - BYTE SGH(0:SGHHDL-1) - BYTE SCH(0:SCHHDL-1) - BYTE MDL(0:MDLHDL-1) - COMPLEX IFRC(0:3,0:STHIFR-1) - BYTE IFH(0:IFHHDL-1) - EQUIVALENCE (STH,FDW,FDX,OHW,SCW,SHW,GFH,IFRT,MDH,MDD, - 1 SGH,SCH,MDL,IFRC,IFH) - CHARACTER*8 IFRT_EC(4) !IFR TABLE - DATA IFRT_EC/'IFR','XI',' ',' '/ - INTEGER IFRT_EJ(4) - DATA IFRT_EJ/0,-1,0,LB_I/ - CHARACTER*10 MDD_EC(4) !MODEL DATA TABLE - DATA MDD_EC/'MDD','26$EC12.2',' ',' '/ - INTEGER MDD_EJ(4) - DATA MDD_EJ/0,-1,0,LB_X/ - CHARACTER*8 IFRC_EC(4) !IFR CORRECTIONS TABLE - DATA IFRC_EC/'IFRC','26$EC12.4',' ',' '/ - INTEGER IFRC_EJ(4) - DATA IFRC_EJ/0,-1,0,LB_X/ - CHARACTER*8 D_G_EC(4,7) !DATA TABLES - DATA D_G_EC/ 'B','SB',' ',' ', - 1 'I','SI',' ',' ', - 1 'J','SJ',' ',' ', - 1 'E','E12.6',' ',' ', - 1 'D','D12.8',' ',' ', - 1 'X','26$EC12.6',' ',' ', - 1 'Y','26$DC12.8',' ',' '/ - INTEGER D_G_EJ(4,7) - DATA D_G_EJ/ 0,1,0,LB_B, - 1 0,1,0,LB_I, - 1 0,1,0,LB_J, - 1 0,1,0,LB_E, - 1 0,1,0,LB_D, - 1 0,1,0,LB_X, - 1 0,1,0,LB_Y/ -C- -C -C GET HEADER -C - IF (.NOT.WNFRD(INFCA,STHHDL,STH,STHP)) THEN - CALL WNCTXT(PTYPE,'Read error on input node') - RETURN - END IF -C -C SHOW HEADER -C - CALL WNCTXT(PTYPE,'!/Sector header description !AS\:!/', - 1 WNTTSG(SNAM,0)) - CALL NSCXXS(PTYPE,STH,STHEDL,STH_EC,STH_EJ) !ACTUAL SHOW -C - RETURN -C -C NSCESH -C - ENTRY NSCESH(PTYPE,INFCA,STHP,SNAM) -C -C INIT -C - DEP=0 !CURRENT DEPTH - CHP=STHP !HEADER POINTER - CTYP=1 !CURRENT TYPE (STH) - CEDP=-1 !CURRENT POINTER IN EDIT LIST - CHDL=STHHDL !CURRENT LENGTH -C -C ACTION -C - 10 CONTINUE - DO WHILE (CTYP.GT.0) !SOMETHING TO DO - IF (CHDL.LE.0) THEN !GET NEW HEADER - IF (PLEN(0,CTYP).GE.0 .AND. CEDP.GT.0) THEN - CHDL=WNGGJ(STH(PLEN(0,CTYP))) !LENGTH FROM FILE - ELSE - CHDL=PLEN(1,CTYP) !DEFAULT LENGTH - END IF - CHDL=MIN(CHDL,PLEN(1,CTYP)) !MAKE SURE NO PROBLEMS - IF (CHDL.LE.0) GOTO 20 !NOT PRESENT; RESTART CURRENT - END IF -C -C GET HEADER -C - IF (CHP.EQ.0 .AND. - 1 (CTYP.LT.7 .OR. - 1 (CTYP.GT.7 .AND. CTYP.LT.15) .OR. - 1 (CTYP.GT.21))) GOTO 20 !NOT PRESENT - IF (CHP.GT.0 .AND. CHP.LT.GFHHDL .AND. - 1 (CTYP.LT.15 .OR. CTYP.GT.21)) THEN !MUST BE GFH - CTYP=7 - CHDL=PLEN(1,CTYP) - CHP=0 - CEDP=-1 - END IF - CALL WNGMVZ(PLEN(1,CTYP),STH) !CLEAR BEFORE READ - IF (.NOT.WNFRD(INFCA,CHDL,STH,CHP)) THEN - CALL WNCTXT(PTYPE,'Read error on input node') - RETURN - END IF - IF (CTYP.EQ.1) THEN !FILL IFR TABLE - IFRT_EJ(2)=WNGGJ(STH(STH_NIFR_1)) !# OF ENTRIES - PLEN(1,8)=IFRT_EJ(2)*LB_I !LENGTH TABLE - MDD_EJ(2)=4*IFRT_EJ(2) - PLEN(1,10)=MDD_EJ(2)*LB_X - IFRC_EJ(2)=4*IFRT_EJ(2) - PLEN(1,14)=IFRC_EJ(2)*LB_X - TSCNL=WNGGJ(STH(STH_SCNL_1)) !LENGTH ONE SCAN - TSCNN=WNGGJ(STH(STH_SCN_1)) !NUMBER OF SCANS - END IF -C -C EDIT HEADER -C - CALL WNCTXT(PTYPE,'*** Editing !AS ***',PLIST(CTYP)) - IF (DEP.GE.MXDEP) THEN !SHIFT ONE - DO I=1,MXDEP-1 - DO I1=1,4 - DEPAR(I1,I)=DEPAR(I1,I+1) - END DO - END DO - DEP=MXDEP-1 - END IF - DEP=DEP+1 !SAVE PREVIOUS - DEPAR(1,DEP)=CHP - DEPAR(2,DEP)=CTYP - DEPAR(3,DEP)=CEDP - DEPAR(4,DEP)=CHDL - IF (CTYP.EQ.1) THEN - CALL NSCXES(PTYPE,STH,STHEDL,STH_EC,STH_EJ,PLIST, - 1 CTYP,CEDP,CHPT,PSZ) - ELSE IF (CTYP.EQ.2) THEN - CALL NSCXES(PTYPE,STH,FDWEDL,FDW_EC,FDW_EJ,PLIST, - 1 CTYP,CEDP,CHPT,PSZ) - CTYP=6 !DO ALSO FDX - CEDP=-1 - CHPT=CHP+FDWHDL - ELSE IF (CTYP.EQ.3) THEN - CALL NSCXES(PTYPE,STH,OHWEDL,OHW_EC,OHW_EJ,PLIST, - 1 CTYP,CEDP,CHPT,PSZ) - ELSE IF (CTYP.EQ.4) THEN - CALL NSCXES(PTYPE,STH,SCWEDL,SCW_EC,SCW_EJ,PLIST, - 1 CTYP,CEDP,CHPT,PSZ) - ELSE IF (CTYP.EQ.5) THEN - CALL NSCXES(PTYPE,STH,SHWEDL,SHW_EC,SHW_EJ,PLIST, - 1 CTYP,CEDP,CHPT,PSZ) - ELSE IF (CTYP.EQ.6) THEN - CALL NSCXES(PTYPE,STH,FDXEDL,FDX_EC,FDX_EJ,PLIST, - 1 CTYP,CEDP,CHPT,PSZ) - ELSE IF (CTYP.EQ.7) THEN - CALL NSCXES(PTYPE,STH,GFHEDL,GFH_EC,GFH_EJ,PLIST, - 1 CTYP,CEDP,CHPT,PSZ) - ELSE IF (CTYP.EQ.8) THEN - CALL NSCXES(PTYPE,STH,IFRTEDL,IFRT_EC,IFRT_EJ,PLIST, - 1 CTYP,CEDP,CHPT,PSZ) - ELSE IF (CTYP.EQ.9) THEN - CALL NSCXES(PTYPE,STH,MDHEDL,MDH_EC,MDH_EJ,PLIST, - 1 CTYP,CEDP,CHPT,PSZ) - ELSE IF (CTYP.EQ.10) THEN - CALL NSCXES(PTYPE,STH,MDDEDL,MDD_EC,MDD_EJ,PLIST, - 1 CTYP,CEDP,CHPT,PSZ) - ELSE IF (CTYP.EQ.11) THEN - CALL NSCXES(PTYPE,STH,SGHEDL,SGH_EC,SGH_EJ,PLIST, - 1 CTYP,CEDP,CHPT,PSZ) - ELSE IF (CTYP.EQ.12) THEN - CALL NSCXES(PTYPE,STH,MDLEDL,MDL_EC,MDL_EJ,PLIST, - 1 CTYP,CEDP,CHPT,PSZ) - ELSE IF (CTYP.EQ.13) THEN - CALL NSCXES(PTYPE,STH,SCHEDL,SCH_EC,SCH_EJ,PLIST, - 1 CTYP,CEDP,CHPT,PSZ) - ELSE IF (CTYP.EQ.14) THEN - CALL NSCXES(PTYPE,STH,IFRCEDL,IFRC_EC,IFRC_EJ,PLIST, - 1 CTYP,CEDP,CHPT,PSZ) - ELSE IF (CTYP.GE.15 .AND. CTYP.LE.21) THEN - CALL NSCXES(PTYPE,STH,D_GEDL, - 1 D_G_EC(1,CTYP-14),D_G_EJ(1,CTYP-14),PLIST, - 1 CTYP,CEDP,CHPT,PSZ) - ELSE IF (CTYP.EQ.22) THEN - CALL NSCXES(PTYPE,STH,SETEDL,SET_EC,SET_EJ,PLIST, - 1 CTYP,CEDP,CHPT,PSZ) - ELSE IF (CTYP.EQ.23) THEN - CALL NSCXES(PTYPE,STH,SRCEDL,SRC_EC,SRC_EJ,PLIST, - 1 CTYP,CEDP,CHPT,PSZ) - ELSE IF (CTYP.EQ.24) THEN - CALL NSCXES(PTYPE,STH,BCOREDL,BCOR_EC,BCOR_EJ,PLIST, - 1 CTYP,CEDP,CHPT,PSZ) - ELSE IF (CTYP.EQ.25) THEN - CALL NSCXES(PTYPE,STH,MOZPEDL,MOZP_EC,MOZP_EJ,PLIST, - 1 CTYP,CEDP,CHPT,PSZ) - ELSE IF (CTYP.EQ.26) THEN - CALL NSCXES(PTYPE,STH,IFREDL,IFR_EC,IFR_EJ,PLIST, - 1 CTYP,CEDP,CHPT,PSZ) - ELSE IF (CTYP.EQ.27) THEN - CALL NSCXES(PTYPE,STH,IFHEDL,IFH_EC,IFH_EJ,PLIST, - 1 CTYP,CEDP,CHPT,PSZ) - END IF - IF (CTYP.GE.1000) THEN !RELATIVE ADDRESS - CTYP=MOD(CTYP,1000) !GET CORRECT TYPE - CHPT=CHP+CHPT !CATER FOR OFFSET GIVEN - END IF - IF (CTYP.GE.15 .AND. CTYP.LE.21) THEN - CHPT=CHPT+PSZ(0)*D_G_EJ(4,CTYP-14) !CATER FOR GIVEN OFFSET - D_G_EJ(2,CTYP-14)=MAX(1,MIN(PSZ(1),SCWHDL/LB_Y)) !MAX. NUMBER TO DO - END IF - IF (CTYP.EQ.12 .AND. CHPT.NE.0) THEN !MODEL - CHPT=CHPT+MDLHDL*MAX(0,MIN(PSZ(0),WNGGJ(MDH(MDH_MODL_1)))) - END IF - IF (CTYP.EQ.13 .AND. CHPT.NE.0) THEN !SCAN - CHPT=CHPT+TSCNL*MAX(0,MIN(PSZ(0),TSCNN)) - END IF - IF (CTYP.GE.22 .AND. CTYP.LE.26 .AND. - 1 PSZ(0).EQ.-1) THEN !SHOW ALL - IF (CTYP.EQ.22) THEN - DO I=0,OHW_EJ(2,CEDP)-1 !ALL SUB-STRUCTURES - CALL NSCXXS(PTYPE,STH(CHPT+I*OHW_EJ(4,CEDP)), - 1 SETEDL,SET_EC,SET_EJ) !ACTUAL SHOW - END DO - ELSE IF (CTYP.EQ.23) THEN - DO I=0,SCW_EJ(2,CEDP)-1 !ALL SUB-STRUCTURES - CALL NSCXXS(PTYPE,STH(CHPT+I*SCW_EJ(4,CEDP)), - 1 SRCEDL,SRC_EC,SRC_EJ) !ACTUAL SHOW - END DO - ELSE IF (CTYP.EQ.24) THEN - DO I=0,SCW_EJ(2,CEDP)-1 !ALL SUB-STRUCTURES - CALL NSCXXS(PTYPE,STH(CHPT+I*SCW_EJ(4,CEDP)), - 1 BCOREDL,BCOR_EC,BCOR_EJ) !ACTUAL SHOW - END DO - ELSE IF (CTYP.EQ.25) THEN - DO I=0,SCW_EJ(2,CEDP)-1 !ALL SUB-STRUCTURES - CALL NSCXXS(PTYPE,STH(CHPT+I*SCW_EJ(4,CEDP)), - 1 MOZPEDL,MOZP_EC,MOZP_EJ) !ACTUAL SHOW - END DO - ELSE IF (CTYP.EQ.26) THEN - DO I=0,SHW_EJ(2,CEDP)-1 !ALL SUB-STRUCTURES - CALL NSCXXS(PTYPE,STH(CHPT+I*SHW_EJ(4,CEDP)), - 1 IFREDL,IFR_EC,IFR_EJ) !ACTUAL SHOW - END DO - END IF - CTYP=0 !READY - DEP=DEP+1 - END IF -C -C REWRITE HEADER -C - IF (.NOT.WNFWR(INFCA,CHDL,STH,CHP)) THEN - 30 CONTINUE - CALL WNCTXT(PTYPE,'Write error on input node') - RETURN - END IF - CHP=CHPT !NEXT HEADER POINTER - IF (CTYP.GE.15 .AND. CTYP.LE.21) THEN - CHDL=D_G_EJ(2,CTYP-14)*D_G_EJ(4,CTYP-14) !NEW LENGTH - ELSE - CHDL=0 !NEXT HEADER LENGTH - END IF - END DO -C -C RETURN PREVIOUS LEVEL -C - DEP=DEP-1 - 20 CONTINUE - IF (DEP.GT.0) THEN !CAN DO MORE - CHP=DEPAR(1,DEP) - CTYP=DEPAR(2,DEP) - CEDP=DEPAR(3,DEP) - CHDL=DEPAR(4,DEP) - DEP=DEP-1 - GOTO 10 - END IF -C - RETURN -C -C - END diff --git a/src/nscan/nscxsl.for b/src/nscan/nscxsl.for deleted file mode 100644 index fd714b9b68d739115ac06a6a0ff328ffe55d9d70..0000000000000000000000000000000000000000 --- a/src/nscan/nscxsl.for +++ /dev/null @@ -1,215 +0,0 @@ -C+ NSCXSL.FOR -C WNB 910211 -C -C Revisions: -C WNB 931216 New EDIT format -C JPH 961112 Correct comment (set --> scan) -C - SUBROUTINE NSCXSL(PTYPE,INFCA,SCHP) -C -C Show scan header -C -C Result: -C -C CALL NSCXSL ( PTYPE_J:I, INFCA_J:I, SCHP_J:I) -C Show on output PTYPE the scan at SCHP -C of file INFCA. -C CALL NSCESL ( PTYPE_J:I, INFCA_J:I, SCHP_J:I) -C Edit data -C -C Include files: -C - INCLUDE 'WNG_DEF' - INCLUDE 'SCH_O_DEF' !SCAN HEADER - INCLUDE 'GFH_O_DEF' - INCLUDE 'SCH_E_DEF' !EDIT INFORMATION -C -C Parameters: -C - INTEGER MXDEP !MAX. NESTING DEPTH - PARAMETER (MXDEP=8) - INTEGER D_GEDL !GENERAL DATA - PARAMETER (D_GEDL=1) - INTEGER D_GMAX !MAX. # OF DATA POINTS - PARAMETER (D_GMAX=100) -C -C Arguments: -C - INTEGER PTYPE !PRINT TYPE (f_p, f_t ETC) - INTEGER INFCA !FILE DESCRIPTOR - INTEGER SCHP !SET HEADER POINTER -C -C Function references: -C - LOGICAL WNFRD !READ DATA - LOGICAL WNFWR !WRITE DATA - INTEGER WNGGJ !GET J -C -C Data declarations: -C - CHARACTER*8 PLIST(10) !KNOWN P: AREAS - DATA PLIST/ 'SCH','STH', - 1 'B','I','J','E','D','X','Y', - 1 ' '/ - INTEGER PLEN(0:1,10) !P: LENGTH - DATA PLEN/ -1,SCHHDL, - 1 -1,4, - 1 -1,LB_B,-1,LB_I,-1,LB_J,-1,LB_E, - 1 -1,LB_D,-1,LB_X,-1,LB_Y, - 1 0,0/ - INTEGER DEP !CURRENT DEPTH - INTEGER DEPAR(4,MXDEP) !SAVE DEPTH - INTEGER CHP,CHDL !CURRENT HEADER LENGTH, PTR - INTEGER CTYP,CEDP !CURRENT HEADER TYPE #, PTR INTO EDIT - INTEGER CHPT !NEXT HEADER POINTER - INTEGER PSZ(0:1) !P: OFFSET AND SIZE - BYTE STH(0:4-1) !DUMMY STH HEADER - BYTE SCH(0:SCHHDL-1) !SCAN HEADER - BYTE D_G(0:D_GMAX*LB_Y-1) - EQUIVALENCE (STH,SCH,D_G) - CHARACTER*8 D_G_EC(4,7) !DATA TABLES - DATA D_G_EC/ 'B','SB',' ',' ', - 1 'I','SI',' ',' ', - 1 'J','SJ',' ',' ', - 1 'E','E12.6',' ',' ', - 1 'D','D12.8',' ',' ', - 1 'X','26$EC12.6',' ',' ', - 1 'Y','26$DC12.8',' ',' '/ - INTEGER D_G_EJ(4,7) - DATA D_G_EJ/ 0,1,0,LB_B, - 1 0,1,0,LB_I, - 1 0,1,0,LB_J, - 1 0,1,0,LB_E, - 1 0,1,0,LB_D, - 1 0,1,0,LB_X, - 1 0,1,0,LB_Y/ -C- -C -C GET HEADER -C - IF (.NOT.WNFRD(INFCA,SCHHDL,SCH,SCHP)) THEN - CALL WNCTXT(PTYPE,'Read error on input node') - RETURN - END IF -C -C SHOW HEADER -C - CALL WNCTXT(PTYPE,'!/Scan header description!/') - CALL NSCXXS(PTYPE,SCH,SCHEDL,SCH_EC,SCH_EJ) !ACTUAL SHOW -C - RETURN -C -C NSCESL -C - ENTRY NSCESL(PTYPE,INFCA,SCHP) -C -C INIT -C - DEP=0 !CURRENT DEPTH - CHP=SCHP !HEADER POINTER - CTYP=1 !CURRENT TYPE (GFH) - CEDP=-1 !CURRENT POINTER IN EDIT LIST - CHDL=SCHHDL !CURRENT LENGTH -C -C ACTION -C - 10 CONTINUE - DO WHILE (CTYP.GT.0) !SOMETHING TO DO - IF (CHDL.LE.0) THEN !GET NEW HEADER - IF (PLEN(0,CTYP).GE.0 .AND. CEDP.GT.0) THEN - CHDL=WNGGJ(STH(PLEN(0,CTYP))) !LENGTH FROM FILE - ELSE - CHDL=PLEN(1,CTYP) !DEFAULT LENGTH - END IF - CHDL=MIN(CHDL,PLEN(1,CTYP)) !MAKE SURE NO PROBLEMS - IF (CHDL.LE.0) GOTO 20 !NOT PRESENT; RESTART CURRENT - END IF -C -C GET HEADER -C - IF (CHP.EQ.0 .AND. - 1 (CTYP.LT.1 .OR. - 1 (CTYP.GT.1 .AND. CTYP.LT.3) .OR. - 1 (CTYP.GT.9))) GOTO 20 !NOT PRESENT - IF (CHP.GT.0 .AND. CHP.LT.GFHHDL .AND. - 1 (CTYP.LT.3 .OR. CTYP.GT.9)) THEN !MUST BE GFH - CTYP=1 - CHDL=PLEN(1,CTYP) - CHP=0 - CEDP=-1 - END IF - CALL WNGMVZ(PLEN(1,CTYP),STH) !CLEAR BEFORE READ - IF (.NOT.WNFRD(INFCA,CHDL,STH,CHP)) THEN - CALL WNCTXT(PTYPE,'Read error on input node') - RETURN - END IF -C -C EDIT HEADER -C - IF (CTYP.NE.2) - 1 CALL WNCTXT(PTYPE,'*** Editing !AS ***',PLIST(CTYP)) - IF (DEP.GE.MXDEP) THEN !SHIFT ONE - DO I=1,MXDEP-1 - DO I1=1,4 - DEPAR(I1,I)=DEPAR(I1,I+1) - END DO - END DO - DEP=MXDEP-1 - END IF - DEP=DEP+1 !SAVE PREVIOUS - DEPAR(1,DEP)=CHP - DEPAR(2,DEP)=CTYP - DEPAR(3,DEP)=CEDP - DEPAR(4,DEP)=CHDL - IF (CTYP.EQ.1) THEN - CALL NSCXES(PTYPE,STH,SCHEDL,SCH_EC,SCH_EJ,PLIST, - 1 CTYP,CEDP,CHPT,PSZ) - ELSE IF (CTYP.EQ.2) THEN - CALL NSCESH(PTYPE,INFCA,CHP,0) !DO STH - CTYP=0 !END CONTINUE - ELSE IF (CTYP.GE.3 .AND. CTYP.LE.9) THEN - CALL NSCXES(PTYPE,STH,D_GEDL, - 1 D_G_EC(1,CTYP-2),D_G_EJ(1,CTYP-2),PLIST, - 1 CTYP,CEDP,CHPT,PSZ) - END IF - IF (CTYP.GE.1000) THEN !RELATIVE ADDRESS - CTYP=MOD(CTYP,1000) !GET CORRECT TYPE - CHPT=CHP+CHPT !CATER FOR OFFSET GIVEN - END IF - IF (CTYP.GE.3 .AND. CTYP.LE.9) THEN - CHPT=CHPT+PSZ(0)*D_G_EJ(4,CTYP-2) !CATER FOR GIVEN OFFSET - D_G_EJ(2,CTYP-2)=MAX(1,MIN(PSZ(1),D_GMAX)) !MAX. NUMBER TO DO - END IF -C -C REWRITE HEADER -C - IF (.NOT.WNFWR(INFCA,CHDL,STH,CHP)) THEN - 30 CONTINUE - CALL WNCTXT(PTYPE,'Write error on input node') - RETURN - END IF - CHP=CHPT !NEXT HEADER POINTER - IF (CTYP.GE.3 .AND. CTYP.LE.9) THEN - CHDL=D_G_EJ(2,CTYP-2)*D_G_EJ(4,CTYP-2) !NEW LENGTH - ELSE - CHDL=0 !NEXT HEADER LENGTH - END IF - END DO -C -C RETURN PREVIOUS LEVEL -C - DEP=DEP-1 - 20 CONTINUE - IF (DEP.GT.0) THEN !CAN DO MORE - CHP=DEPAR(1,DEP) - CTYP=DEPAR(2,DEP) - CEDP=DEPAR(3,DEP) - CHDL=DEPAR(4,DEP) - DEP=DEP-1 - GOTO 10 - END IF -C - RETURN -C -C - END diff --git a/src/nscan/nscxxs.for b/src/nscan/nscxxs.for deleted file mode 100644 index fb8af81f36f625900a8a43bc1a59c5d0f80e3332..0000000000000000000000000000000000000000 --- a/src/nscan/nscxxs.for +++ /dev/null @@ -1,181 +0,0 @@ -C+ NSCXXS.FOR -C WNB 910211 -C -C Revisions: -C CMV 931119 Print character fields correctly -C WNB 931126 Print character fields correctly -C WNB 931215 Some formating; prepare P: and S:; limit width -C JPH 941010 TXTU 8 --> 12 chars, units for scalars 5 __> 8 chars. -C Comments -C - SUBROUTINE NSCXXS(PTYPE,DAT,EDL,EDC,EDJ) -C -C Show an area in detail -C -C This routine takes the edit descriptors in EDC, EDJ and uses them to -C format the data in DAT. -C -C EDC comes directly from <xxx>_E_DEF which in turn is a direct copy of -C the edit parameter arguments in <> in <xxx>.DSC. WNTINC does not interpret -C these parameters except for forcing them into a uniform character length -C defined by the output statements in routine WNTFIO (about line 840); this -C length was raised from 10 to 12 chars on 941010 to allow somewhat more -C informative unit strings. -C -C This routine does some formatting of its own, such as: -C -C - Limit field name to 8 characters -C -C - Limit the units field for single variables to 8 characters -C -C - Limit the width <w> in such formats as E<w>.<d> to 10. (If you want -C a wider field, use the $ field width directive, e.g. 17$E<w>.<d>.) -C -C -C Result: -C -C CALL NSCXXS ( PTYPE_J:I, DAT_B(*):I, EDL_J:I, EDC_C*(4,*):I, -C EDJ_J(4,*):I) -C Show on output PTYPE the area DAT -C with EDL edit lines given in -C EDC and EDJ. -C -C Include files: -C - INCLUDE 'WNG_DEF' -C -C Parameters: -C - INTEGER SLEN !START TEXT LENGTH - PARAMETER (SLEN=8) - CHARACTER*(SLEN) STXT !START TEXT FORMAT - PARAMETER (STXT='!80$8Q1\') -C -C Arguments: -C - INTEGER PTYPE !PRINT TYPE (f_p, f_t ETC) - BYTE DAT(0:*) !DATA AREA - INTEGER EDL !LENGTH EDIT ARRAYS - CHARACTER*(*) EDC(4,*) !EDIT DATA - INTEGER EDJ(4,*) !EDIT DATA -C -C Function references: -C - INTEGER WNCALN !STRING LENGTH -C -C Data declarations: -C - CHARACTER*256 TXT !A TEXT LINE - CHARACTER*16 TXT1 !FORMAT - CHARACTER*12 TXTU !UNITS - CHARACTER*80 ARGSTR -C- - TXT=STXT !NO TEXT YET - J=SLEN !TEXT POINTER - J1=0 !TEXT LENGTH - DO I=1,EDL !ALL LINES - J1=((J1+25)/26)*26 !CORRECT POINTER - IF (EDC(4,I)(1:2).EQ.'P:') THEN !MAKE UNITS - TXTU=':P' - ELSE IF (EDC(4,I)(1:2).EQ.'S:') THEN - TXTU=':S' - ELSE - TXTU=EDC(3,I) !UNITS - END IF - IF (EDJ(2,I).LE.0) THEN !NOTHING - ELSE IF (EDJ(2,I).EQ.1 .OR. TXTU.EQ.':S') THEN! scalar - IF (J1.GT.52) THEN ! SHOULD START NEW LINE - CALL WNCTXT(PTYPE,TXT) ! flush - TXT=STXT ! and reset buffer - J=SLEN ! TEXT POINTER - J1=0 ! TEXT LENGTH - END IF - TXT(J+1:)=EDC(1,I) ! FIELDNAME - J=J+8 ! POINTER - J1=J1+8 ! LENGTH - IF (TXTU.EQ.':S') THEN ! SUB-STRUCTURE - CALL WNCTXS(TXT(J+1:),'!4$UJ !7$AS', - 1 EDJ(2,I),EDC(4,I)) - J=J+13 ! POINTER TXT - J1=J1+13 ! POINTER LINE - ELSE - I1=INDEX(EDC(2,I),'$') - IF (I1.LE.0) THEN ! NO LENGTH GIVEN - TXT1='!12$'//EDC(2,I) ! default length - IF (EDC(2,I)(1:2).EQ.'AL') THEN - CALL WNCTXS(TXT1(7:9),'!UJ',EDJ(4,I)) - END IF - CALL WNCTXS(TXT(J+1:),TXT1,DAT(EDJ(1,I))) !CONVERT - J=J+13 !POINTER TXT - J1=J1+13 !POINTER LINE - ELSE !LENGTH GIVEN - TXT1='!'//EDC(2,I) !FORMAT - IF (EDC(2,I)(I1+1:I1+2).EQ.'AL') THEN - CALL WNCTXS(TXT1(I1+4:I1+6),'!UJ',EDJ(4,I)) - END IF - CALL WNCTXS(TXT(J+1:),TXT1,DAT(EDJ(1,I))) !CONVERT - I1=WNCALN(TXT) !NEW POINTER - J1=J1+(I1-J)+1 !POINTER LINE - J=I1+1 !POINTER TXT - END IF - END IF - TXT(J+1:)=TXTU !UNITS - J=J+8 - J1=J1+8 - ELSE ! array - IF (J1.GT.0) THEN - CALL WNCTXT(PTYPE,TXT) ! flush - TXT=STXT ! and reset buffer - J=SLEN !TEXT POINTER - J1=0 !TEXT LENGTH - END IF - I1=INDEX(EDC(2,I),'$') !LENGTH GIVEN? - IF (I1.LE.0) THEN !NO LENGTH GIVEN - IF (EDC(2,I)(1:2).EQ.'AL') THEN !AL - CALL WNCTXT(PTYPE,TXT(:J)//'!-7$AS!13$#'// - 1 EDC(2,I)(1:2)//'# !AS', - 1 EDC(1,I),EDJ(2,I),EDJ(4,I),DAT(EDJ(1,I)), - 1 TXTU) - ELSE - I1=WNCALN(EDC(2,I)) !FORMAT LENGTH - ARGSTR=TXT(:J)//'!-7$AS!13$#'//EDC(2,I)(1:I1)//' !AS' - CALL WNCTXT(PTYPE,ARGSTR, - 1 EDC(1,I),EDJ(2,I),DAT(EDJ(1,I)), - 1 TXTU) - END IF - TXT=STXT !NO TEXT YET - J=SLEN !TEXT POINTER - J1=0 !TEXT LENGTH - ELSE !LENGTH GIVEN - IF (EDC(2,I)(I1+1:I1+2).EQ.'AL') THEN !AL - ARGSTR=TXT(:J)//'!-7$AS!'// - 1 EDC(2,I)(1:I1)//'#'// - 1 EDC(2,I)(I1+1:I1+2)//'# !AS' - CALL WNCTXT(PTYPE,ARGSTR, - 1 EDC(1,I),EDJ(2,I),EDJ(4,I),DAT(EDJ(1,I)), - 1 TXTU) - ELSE - I2=WNCALN(EDC(2,I)) !FORMAT LENGTH - ARGSTR=TXT(:J)//'!-7$AS!'// - 1 EDC(2,I)(1:I1)//'#'// - 1 EDC(2,I)(I1+1:I2)//' !AS' - CALL WNCTXT(PTYPE,ARGSTR, - 1 EDC(1,I),EDJ(2,I),DAT(EDJ(1,I)), - 1 TXTU) - END IF - TXT=STXT !NO TEXT YET - J=SLEN !TEXT POINTER - J1=0 !TEXT LENGTH - END IF - END IF - END DO -C - IF (J1.GT.0) THEN !LAST LINE - CALL WNCTXT(PTYPE,TXT) - CALL WNCTXT(PTYPE,' ') - END IF -C - RETURN -C -C - END diff --git a/src/nscan/nshow.pef b/src/nscan/nshow.pef deleted file mode 100644 index 6d3e48ba31c563541b01cc0bf0e99d6301730b04..0000000000000000000000000000000000000000 --- a/src/nscan/nshow.pef +++ /dev/null @@ -1,238 +0,0 @@ -!+ NSHOW.PEF -! CMV 931116 -! -! Revisions: -! CMV 931116 Split off from NSCAN/NFLAG.PSC -! CMV 931116 Set SECTOR_ACTION to NOLOOP -! WNB 931126 Changed name to PEF -! WNB 931216 Changed text for EDIT; add MAP_ACTION, SET_ACTION -! CMV 931220 Add option OVERVIEW to FILE_ACTION -! CMV 940228 Add options COR, UNCOR to show corrected data -! CMV 940425 Add option TP and GN to show total power data -! CMV 940425 Add option IFH to SECTOR_ACTION -! CMV 940506 Add IFR option for SCAN_ACTION -! CMV 940530 Add JOB option for MAP_ACTION -! JPH 941109 Move SET_ACTION to NGCALC.PSC -! JPH 941115 Help texts -! JPH 941117 Remove control-H that was inserted behind < to prevent -! xmosaic from thinking < starts a command. (This is now -! handled by doc_cook.) -! JPH 950821 Add TEL to SCAN_ACTION prompt -! Text corrections -! JPH 960513 Newlines at start of HELP texts -! -! -! Top level file is assumed to INCLUDE <xxx>_NODE and <xxx>_SETS -! -!- -! -! Get file action -! Ref: NFLPRT -! -KEYWORD=FILE_ACTION - DATA_TYP=C - IO=I - LENGTH=24 - CHECKS=ABBREV_OPTIONS - SWITCHES=LOOP,NULL_VALUES,WILD_CARDS - SEARCH=L,P - PROMPT="file-header action" - OPTIONS=LAYOUT,OVERVIEW; SHOW,EDIT; CONT,QUIT | - HELP=" -Specify interaction with the file header: -. - Summarise contents of the file: - LAYOUT show counts of groups, fields and channels in the file - OVERVIEW give overview of all sector headers -. - Details of the file header: - SHOW: display the file header in full - EDIT: edit fields in the file header -. - Navigation: - CONT go down one level, to interact with Sector headers - QUIT exit from SHOW/EDIT option" -! -! Get set action -! Ref: NFLPRT -! -KEYWORD=SECTOR_ACTION - DATA_TYP=C - IO=I - LENGTH=24 - CHECKS=ABBREV_OPTIONS - SWITCHES=NULL_VALUES,WILD_CARDS - SEARCH=L,P - PROMPT="Sector-header action |" - OPTIONS=SHOW,EDIT; NAME,IFRS,IFH,FLAGS; NEXT,CONT,QUIT - HELP=" -Specify interaction with this sector header: -. - Show details of the sector header: - SHOW show entire sector header - EDIT edit fields (values) in the Sector header by name -. - Show details associated with the current sector: - NAME index 'name' of the current Sector (if #nr specified) - IFRS the interferometer table - IFH: header of 'IF' data (Total Powers etc) - FLAGS: show the nr of flags per interferometer that are set in the - current Sector -. - Navigation: - NEXT: proceed to the header for the next sector selected - CONT: descend into the scans of this sector - QUIT: return to the file-header level" -! -! Get Scan action -! Ref: NFLPRT -! -KEYWORD=SCAN_ACTION - DATA_TYP=C - IO=I - LENGTH=24 - SWITCHES=LOOP,NULL_VALUES,WILD_CARDS - SEARCH=L,P - PROMPT="Scan action, one of |- -(header:) Show, Edit, Ifr; |- -(navigate:) nn.nn, >/<, >n/<n, Quit; |- -(data select:) XX,XY,YX,YY, TP,GN; COR/UNCOR; |- -(data display:) Data, A_phi, Weight; |- -(miscell:) Tel" - HELP=" -Specify interaction with the scan's header or data: -. - Details of the scan header and associated tables: -. - SHOW Show entire header for selected scan - EDIT Edit fields in the scan header - IFR Show table of interferometer corrections -. - Navigation. The hour angle/scan you select remains in force until you select - a new one or QUIT. Initial selection is the first scan in this sector. For a - non-existent hour-angle, the nearest existing one is selected instead. -. - nn.nn Select scan at hour angle nearest to this value - >, < Select the next (>) or preceding (<) scan - >n, <n Select the n-th next (>) or preceding (<) scan - Q[uit] Return to sector-header level -. -Mode switches. The values you select remain in force until you change them or -QUIT. -. - Data-stream selection; the initial setting is XX. - XX/XY/YX/YY - Select polarisation - TP Select Total Power mode (noise source on/off) - GN Select Gain correction mode -. - Correction mode. Visibility data will be displayed accordingly. Initial - setting is UNCOR. -. - UNCOR Display 'raw' data - COR Display the data corrected as specified by the APPLY - and DE_APPLY parameters. These parameters are normally set - automatically for you. (This may result in the program - requesting additional information.) -! {\em see the parameter description for \textref{APPLY}{ngen.apply} and -! \textref{DE_APPLY}{ngen.de.apply} } -. -Data display for the selected scan and polarisation: -. - D[ata] Complex visibilities (real and imaginary parts) - A[mpl] Visibilities represented as amplitude and phase - W[eight] Weights and flags associated with the visibilities -. -Miscellaneous functions:\. - T[el] Calculate and show an estimate (based on a point source model) - for the telescope gains/phases. In those rare cases where NCALIB - REDUN fails to correctly resolve 180-deg phase ambiguities, you - may use the phases displayed here as initial values for the - corrections, through the NCALIB SET MANUAL option. -! {\em see the NCALIB \textref{SET MANUAL}{ncalib.set} parameter description} -" -! -! Get map action -! Ref: NMAPRT -! -KEYWORD=MAP_ACTION - DATA_TYP=C - IO=I - LENGTH=24 - CHECKS=ABBREV_OPTIONS - SWITCHES=LOOP,NULL_VALUES,WILD_CARDS - SEARCH=L,P - OPTIONS=NEXT,JOB,SHOW,EDIT,CONT,QUIT - PROMPT="image-header action" - HELP=" -Specify interaction with image header: -. - Show details of the image header: - SHOW Display the entire image header - EDIT Edit fields in the image header -. - Show details associated with the current image: - JOB Job summary sheet (if available) -. - Navigation: - NEXT Proceed to the header for the next image selected - CONT Pescend into the scans of this image - QUIT Return to the file-header level" -! -! Get edit action -! Ref: NSCXES -! -KEYWORD=EDIT - DATA_TYP=C - IO=I - LENGTH=80 - NVALUES=16 - SWITCHES=LOOP,NULL_VALUES,WILD_CARDS - SEARCH=L,P - PROMPT="Edit: name [offset][/length][:format] , val [,...]" - HELP=" -The preceding sequence of parameter values that you provided defines one header -or data structure being processed. The EDIT parameter now allows you show -and/or edit the values of individual (goups of) fields in this structure. All -fields may be modified, except for the pointers that define the structure of -the file. -. -NOTE: Although EDITing may be used to patch up a file, it is really intended -only for debugging/testing purposes! - Newstar programs provide a number of manual-input operations that cover -all situations expected in normal practice. In the rare cases that a file is -systematically corrupted in a curable way (e.g. because of an error in the WSRT -on-line program), the preferred course is to have an ad-hoc extension made to a -Newstar program to process the damaged file(s). -. -The following operations are available: -. - * show values of all fields in the structure - : show format information for all fields in the structure - <name> show value(s) of field <name> in the structure - <name>: show format information for field <name> in the structure - <name>,<value>,.. write <valye> in filed <name> in the structure -. - Instead of <name> you may specify a hex number (absolute address in the file) - or a hex number preceded by a '.' (address in the file relative to the origin - of the current structure) - -. -Values are assumed to be in format of printout. Radix can be changed by -prefixing with %X, %B, %O or %D. Angles are in degrees, but can be given as -hh:[mm[:ss[.ttt]]] or dd.mm.[ss.ttt] -. -'name' can be followed by (offset) to start at position offset in multi-valued -list; and/or /number to limit number of values in same -. -A full name specification can be followed with either: - :format to change printing and reading format. (format can be - e.g. {USX}{BIJ} {ED}[n[.m]] {EC|DC}[n[.m]] - ::type[(off)][/n] where type specifies a header type (e.g. STH) to format - the indicated disk area as this type - Single letter types are dummy header types for simple - formats - :: gives all known header types -! {\em see the \textref{SHOW/EDIT}{show_edit} manual for a more elaborate -! \ description} -" diff --git a/src/nscan/nstar.dsf b/src/nscan/nstar.dsf deleted file mode 100644 index f2d278b7782ee79c36f374da1ae57162661a1b69..0000000000000000000000000000000000000000 --- a/src/nscan/nstar.dsf +++ /dev/null @@ -1,16 +0,0 @@ -!+ NSTAR.DSF -! WNB 930803 -! -! Revisions: -! WNB 931015 Some text changes only -! WNB 930803 Original version -! -! Define general Newstar program parameters -! -! NSTAR.DSF defines the general environment for all -! NSTAR .DSC files -! Use as: %INCLUDE=NSTAR_DSF -! -%LOCAL=NSTAR_TEL=14 !# OF TELESCOPES -%LOCAL=NSTAR_IFR=NSTAR_TEL*(NSTAR_TEL+1)/2 !# OF INTERFEROMETERS -!- diff --git a/src/nscan/ohw.dsc b/src/nscan/ohw.dsc deleted file mode 100644 index 641e2e5ac99321db5faf51a1fcef64eda80422d4..0000000000000000000000000000000000000000 --- a/src/nscan/ohw.dsc +++ /dev/null @@ -1,178 +0,0 @@ -!+ OHW.DSC -! WNB 900118 -! -! Revisions: -! -%REVISION=JPH=970220="Add PATPO, PATFD" -%REVISION=CMV=960228="Increased max. number of SETS" -%REVISION=CMV=940829="Change max. number of SETS" -%REVISION=CMV=940414="Add historical notes" -%REVISION=WNB=931215="Add some edit formats" -%REVISION=WNB=930803="Change .RECORD" -%REVISION=WNB=920813="Add MSNP" -%REVISION=WNB=911022="Add SPEFU" -%REVISION=WNB=900118="Tape vs 7, system 59" -! -! -! Define WSRT OH block -! -! -%COMMENT="OHW.DSC defines the WSRT OH block" -! -%VERSION=7 !VERSION -%SYSTEM=59 -%USER=WNB -%%DATE -%%NAME -!- -%LOCAL=MAXSET=5000 !Maximum number of sets -.PARAMETER - OHWSET J /MAXSET/ -! -.STRUCTURE=SET !Set definitions - BFREQ J !Set observing frequency (2**(-16).Mhz) (*) - ! FVERS<2: single float (E) - DATYP C2 !Data type (IF, XX, XY, YX, or YY) - BANDNR I !Band number - NSH J !First record number of current set -.END !End SET definition -.BEGIN=OHW - ! (*) means use with care, not repaired - CBI I !Unequal data block flag (32767) - CBT C2 !Type identificator: Observation Header (OH) - NOH J !Record number of this record - LOH J !Number of OH records in this group with - !information (*) - ! FVERS<5: erroneous (always 54) - NOHN J !First OH record number of next group (last:-32768) - SDAY I !Local U.T. day number - ! FVERS<5: ST - STIM I !Start U.T. time in units of 10 sec. - ! FVERS<5: ST - ! FVERS<3: units of minutes - ETIM I !End U.T. time in units of 10 sec. - ! ols<43: -32768 - - I !Empty (Delete character) - NSC I !First record number of SC group - PROJECT I !Project number - FIELD C12 !Fieldname - VOLGNR J !Observation number (yynnnnn) - ! FVERS<2: no year (yy) in number - ! ols=57: yyyy in stead of yy (00327..00586 - STUURC I !Online peripherals control bits (*) - ! FVERS<3: line (1) or cont (0) - TYPE C2 !Observation type - DATE I(6) !Epoche and civil start time of the observation - PRFLG I !Online program flags (*) - ! FVERS<3: reserved - OLSYS I !Online program system nr. - ! FVERS<3: reserved - JDAY D <D12.2> !Time of the middle of the observation in julian days - BECEN D <D12.7> !Time of the middle of the obs. in bessel centuries - JUCEN D <D12.7> !Time of the middle of the obs. in julian centuries - FREQC I !Observing frequency code - CATEG C2 !Astronomical type of observation - ALLOC I !Program committee allocation code - REQUEST C4 !Date of reception request from by tel. group - STATBG J(0:1) !Status BG corrections - STATBE J(0:1) !Status BE corrections - STATSE J(0:1) !Status SE corrections - POPER I !Period on pointing grid point - !(Units 10 sec) (*) - ! FVERS<5: NOBSN - DXBIT B(0:1) !DXB control bit - APCS B(0:1) !DXB recycling instel code - RA1 D <DAF12.7> !Right ascension fieldcentre of epoche - DEC1 D <DAF12.7> !Declination fieldcentre of epoche - MODE I !Digital correlator mode - POLC I !Dipole position code - BAND E <E12.6> !Total bandwidth (DLB). Sum of all bands (DCB) - NTOT I !Total number of channels (*) - ! FVERS=(>?)6: 4096 for DCB - NFREQ I !Total number of frequency points or bands - SFREQ I !Spacing of the frequency points in - !units of 0.1 Khz (Only DLB) - !DCB --> CDCBD - Bitcode - !Bit 0 - 7: Describing used bands (Band: 1 - 8) - !Bit 8 -15: Describing used bandwith (1 = 5 Mhz, - !0 = 10 Mhz) - NRPOL I !Number of polarization channels - NRINT I !Number of interferometers (*) - ! FVERS>=6: number of standard ifrs - TELWD I(0:1) !Receiver in use/not in use code - BSINT I !Basic intergration time of the backend (U.T.) - ! FVERS<5: S.T. - ! ols=52: 0.1 U.T. sec - CONFNR J !System configuration number - BECODE C4 !DLB ,DCB ,DXB . - ! FVERS<6: reserved (always DLB) - RA0 D <DAF12.7> !Apparent right ascension field centre at middleof obs. - DEC0 D <DAF12.7> !Apparent declination field centre at middle of obs. - FREQ D <D12.6> !Obs. freq. of middle of band for middle of - !observation (DLB) or primary fringe stopping - !Frequency (DCB). - HAST D <DAF12.7> !Hour angle middle of first 10 sec U.T. period - HAEND D <DAF12.7> !Hour angle middle of last 10 sec U.T. period - LST D <DAF12.7> !Local sidereal time of middle of the observation - ! PARALLAX...RDEC2 lots of changes FVERS<4 (*) - PARALAX E <EAF12.7> !Paralax for apparent observations (Epoche= 9) - !in circles - RRA1 E <E12.8> !Pointing offset or linear rate in R.A. - !(Circles per juliaans day or degrees/U.T.day) - RDEC1 E <E12.8> !Pointing offset or linear rate in DECL. - !(Circles per juliaans day or degrees/U.T.day) - RRA2 E !Pointing offset or quadratic rate in R.A. - !(Circles per juliaans day or degrees/U.T.day**2) - RDEC2 E !Pointing offset or quadratic rate in DECL. - !(Circles per juliaans day or degrees/U.T.day**2) - VLCTY E !Velocity (Km/sec) in system given by velc - !(DCB - empty) - VELC I !Velocity reference system code (DCB - empty) - ! INX...FDEC3 lots of changes FVERS<4 - INX I !Telescope bits for pointing offset - DRA E <EAF12.7> !Pointing offset in RA (Circles) - DDEC E <EAF12.7> !Pointing offset in DEC (Circles) - NPC I !Period on the centre (Units of 10 sec.) - NPS1 I !Period on source 1 (Units of 10 sec.) - FDRA1 E <EAF12.7> !Offset in RA for source 1 - FDEC1 E <EAF12.7> !Offset in DEC for source 1 - NPS2 I !Period on source 2 (Units of 10 sec.) - - -(0:1) ! - - FDRA2 E <EAF12.7> !Offset in RA for source 2 - FDEC2 E <EAF12.7> !Offset in DEC for source 2 - NPS3 I !Period on source 3 (Units of 10 sec.) - - -(0:1) ! - - FDRA3 E <EAF12.7> !Offset in RA for source 3 - FDEC3 E <EAF12.7> !Offset in DEC for source 3 - - -(0:1) ! - - SPEFU C2 !Special observation type code - ! ols<61: reserved - ! VOLGNR 9100750..9101671: archive in EBCEDIC - POST J(0:13) !Position telescopes in 2**(-16) M - TAPER I !Code of weighting function used for the - !Fourier transform to frequency (DCB - empty). - DEVC0 B(0:1) !Device code bits (*) - ! ols<43: reserved - FREQ0 D <D12.6> !Rest freq. for line observations (Line) or - !observing freq. (DCB), 0 if FREQC<10 - ! FVERS<6: reserved - STOPAR I !Data in channel-fluxes (0) or in stokes- - !parameters (1). (Dwingeloo use) - ! ols<43: reserved - MSPAT I !Mosaicking pattern number (=0: no mosaicking) - ! ols<60: reserved - MPOSN I !Position in mosaicking pattern (0,1,...,N-1) - ! ols<60: reserved - MSNP I !Number of pos. in mosaick pattern (else 1) - ! ols<62: reserved - - -(0:17) ! - to be filled in - - PATPO I <XI> !Mask of telescopes that scan in position - PATFD I <XI> !Mask of telesc. that scan in fringe-stop - ! and delay position - - -(0:267) ! - - NRSTS I !Total number of sets - NRFRQ I !Total number of frequency points - LENT I !Number of bytes per entry in the following table - SET S:SET(0:MAXSET) !Set definitions -.END !END DEFINITION -!- diff --git a/src/nscan/qub.dsc b/src/nscan/qub.dsc deleted file mode 100644 index 99846383179e3494cf8cd5fc69c95afbea3b24e8..0000000000000000000000000000000000000000 --- a/src/nscan/qub.dsc +++ /dev/null @@ -1,101 +0,0 @@ -!+ QUB.DSC -! WNB 940215 -! -! Revisions: -! WNB 940728 General update -! -%REVISION=WNB=940812="Add some for ifr error writing" -%REVISION=WNB=940728="General update" -%REVISION=WNB=940215="Original definition" -! -! Define Qube interface -! -%COMMENT="QUB.DSC defines a line in the Qube description file" -%COMMENT=" and the Qube descriprion area QUA" -! -%VERSION=1 !VERSION -%SYSTEM=1 -%USER=WNB -%%DATE -%%NAME -! -%ALIGN -!- -.PARAMETER -! -! A Qube definition record -! -.STRUCTURE=QUB - RA D <DAF12.7> !RA - DEC D <DAF12.7> !DEC - FRQ D <D12.6> !FREQ - BAND E <E12.6> !BANDWIDTH - HAB E <EAF12.7> !HA BEGIN - HAI E <EAF12.7> !HA INCREMENT - SCN J !# OF SCANS - NIFR J !# OF IFRS - NPOL J !# OF POLARISATIONS - STHP J !SET HEADER POINTER - INST J !INSTRUMENT - FID J !FIELD ID - NFRQ J !# OF FREQUENCIES IN FIELD - NSCN J !# OF SCANS IN FIELD/FREQ - .ALIGN=LB_D -.END !END DEFINITION -! -! Qube handling definition block -! -.STRUCTURE=QUA - CNT J !COUNT OF QUBE LINES - MEMSZ J !MEMORY CHUNK SIZE - NLINE J !# OF LINES PER BUFFER - BPT J !BUFFER POINTER - NFLD J !# OF FIELDS - NFRQ J !MAX # OF FREQUENCIES - NHA J !MAX # OF HA - NIFR J !MAX # OF IFRS - NBLK J !MAX # OF HA BLOCKS - NDAT J !MAX # OF DATA POINTS PER 'SCAN' - IFRQ J !CURRENT # OF FREQUENCIES - IHA J !CURRENT # OF HA - IIFR J !CURRENT # OF IFR - IBLK J !CURRENT # OF HA BLOCKS - IBPT J !CURRENT FIELD DESCRIPTOR BLK PTR - FCA J !FILE WITH QUBE DEFINITION - SFCA J !FILE WITH SORTED DATA - IFCA J !FILE WITH OUTPUT DATA - CFNR J !CURRENT FIELD NUMBER - CFPTR J !CURRENT FIELD LINE PTR - ORDER J !CURRENT ORDER - SCNT J !# OF LINES IN SORT BUFFER - SBPT J !PTR SORT BUFFER - CMAP J !CURRENT SORTED PLANE - CIMAP J !CURRENT OUTPUT PLANE - CPMAP J !PTR TO SORTED DATASET TABLE - CIPMAP J !PTR TO OUTPUT DATASET TABLE - CCNT J !CURRENT FILLING SORTED DATASET - CICNT J !CURRENT FILLING OUTPUT DATASET - CSTHP J !CURRENT STH PTR - CSTH J !PTR TO CURRENT STH (B) - PIFR J !PTR TO IFR TABLE (I) - PFRQ J !PTR TO FRQ TABLE (D) - PHA J !PTR TO HA TABLE (E) - PANG J !PTR TO ANGLE IFR TABLE - PWGT J !PTR TO WEIGHT ARRAY (E(0:3,*)) - PDAT J !PTR TO DATA ARRAY (X(0:3,*)) - PMOD J !PTR TO MODEL ARRAY (X(0:3,*)) - POUT J !PTR TO ERROR ARRAY (X(0:3,*)) - CAP J !OUTPUT APPLY BITS - CDAP J !OUTPUT DE-APPLY BITS - TCOR J !OUTPUT TYPE - SRA D !MODEL CALC DATA - SDEC D - SFRQ D - FRQ0 D - LM0 E(0:1) - TF E(0:1) - STP J - MINST J -.ALIGN=LB_D -.END -!- diff --git a/src/nscan/rfh.dsc b/src/nscan/rfh.dsc deleted file mode 100644 index 9ce74e4c0624febf11a33c5ae35dfd8cee7d5919..0000000000000000000000000000000000000000 --- a/src/nscan/rfh.dsc +++ /dev/null @@ -1,52 +0,0 @@ -!+ QFHHD.DSC -! WNB 880314 -! -! Revisions: -! HjV 940519 Changed for use in Newstar -! -%REVISION=WNB=880314="Original version" -%REVISION=HJV=940519="Changed for use in Newstar" -! -! Define layout of R-series SCAN-file-header. -! -%COMMENT="QFHHD.DSC defines the R-series SCAN file header" -%COMMENT=" " -! -! -%VERSION=2 !VERSION -%SYSTEM=2 -%USER=WNB -%%DATE -%%NAME -! -%LOCAL=QQFHL=192 !REQUIRED LENGTH -%LOCAL=QFNM=120 !OFFSET TO FIELD NAME REQUIRED -! -.PARAMETER -.BEGIN=QFH - ID C4 !IDENTIFICATION (E.G. '.SMP') - LEN I2 !LENGTH HEADER - CRD C11 !CREATION DATE (DD-MMM-YYYY) - CRT C5 !CREATION TIME (HH:MM) - RVD C11 !REVISION DATE (DD-MMM-YYYY) - RVT C5 !REVISION TIME (HH:MM) - RVN I2 !REVISION COUNT -!- - SLH I4(0:1) !SET LIST LINK HEADER - ILH I4(0:1) !INTERFEROMETER ERROR LINK LIST - STN I2 !NUMBER OF SETS - TLN I2 !NUMBER OF TELESCOPES - VER I2 !VERSION OF FILE HEADER (<>48!) - TNM C30 !TELESC. NAMES (E.G. 01..9ABCD) - DLN I2 !NUMBER OF BYTES PER DATA ENTRY - DCD I2 !DATA CODE: - R1 -(0:23) !RESERVED - NAM C12 !FIELDNAME - EPO R4 !EPOCH (E.G. 1950.0) - SFHRA R8 !RIGHT ASCENSION (CIRCLES) - DEC R8 !DECLINATION (CIRCLES) - FRQ R8 !FREQUENCY (MHZ) - INT I2 !BASIC INTEGRATION TIME (SEC) - R2 -(0:29) !RESERVED -.END -!- diff --git a/src/nscan/rpf.dsc b/src/nscan/rpf.dsc deleted file mode 100644 index d89b08075f316066e172e00b680eac59bcbaa4e0..0000000000000000000000000000000000000000 --- a/src/nscan/rpf.dsc +++ /dev/null @@ -1,239 +0,0 @@ -!+ RPF.DSC -! WNB 920428 -! -! Revisions: -! -%REVISION=WNB=930803="Remove .INCLUDE" -%REVISION=HM=920319="Added sc_srcno" -%REVISION=WNB=920428="Original version" -! -! rpn 7/11/88 added IF table and IF common -! rpn 8/11/88 inserted AN table and extended antenna common -! to include polarisation -! rpn 9/11/88 major change in treatment of if's. For multi-IF -! data, rpfits should be called once per IF (i.e. -! several times per integration), with a formal -! parameter if_no varying from 1 to n_if. -! A new group will be written for each IF. -! PTI data will continue to be written with -! NSTOK = 2. -! rpn 9/11/88 added su and fg tables -! rpn 8/2/89 dates changed from AEST to UT -! rpn 10/2/89 changed INTEGER*4 declaration to INTEGER for -! AIPS. -! rpn 17/2/89 Put in INDEX common -! rpn 24/5/89 Put in VERSION string -! rpn 27/7/89 Put in if_sampl, ant_mount, changed names of -! pressure etc to ant_... -! rpn 10/10/89 put in su_found, if_found, etc. -! rpn 11/10/89 put in MT commons -! rpn 8/11/89 put in longer strings for first 4 variables in -! /NAMES/ -! rpn 8/11/89 put in su_rad, su_decd -! rpn 20/3/90 put in su_num, if_num, and changed ant_no to -! ant_num. Added sc common. Put in write_wt, -! if_ref. -! rpn 22/3/90 put in CU common -! hm 11/5/90 removed tabs and changed real*4 to real -! also cut lines down to 72 characters -! hm 2/7/90 removed unused variables and changed real*8 -! to double precision. -! hm 14/11/91 Added if_sumul and if_chain arrays to IF table -! - to handle sumiltaneous frequencies. -! hm 11/3/92 Increased max_su from 16 to 500 to allow -! for mosaicing of up to 500 sources per scan. -! Allow for separate phase and pointing centres -! by adding new arrays for pointing centres - -! su_pra, su_pdec, su_prad, su_pdecd -! hm 19/3/92 Added sc_srcno -! -! Layout of RPFITS common block (RPF.DEF) -! -%COMMENT="RPF.DEF is an INCLUDE file for the "rpfitsin" program" -%COMMENT=" " -! -%VERSION=1 -%SYSTEM=1 -%USER=WNB -%%DATE -%%NAME -! -%LOCAL=ANT_MAX=6 -%LOCAL=MAX_CARD=256 -%LOCAL=MAX_IF=8 -%LOCAL=POL_MAX=8 -%LOCAL=MAX_SU=500 -%LOCAL=MAX_FG=32 -%LOCAL=MAX_NX=256 -%LOCAL=MAX_MT=256 -%LOCAL=MAX_SC=16 -%LOCAL=MAX_CU=32 -!- -.DEFINE - .PARAMETER - ANT_MAX J /ANT_MAX/ - MAX_CARD J /MAX_CARD/ - MAX_IF J /MAX_IF/ - POL_MAX J /POL_MAX/ - MAX_SU J /MAX_SU/ - MAX_FG J /MAX_FG/ - MAX_NX J /MAX_NX/ - MAX_MT J /MAX_MT/ - MAX_SC J /MAX_SC/ - MAX_CU J /MAX_CU/ - .DATA -! -! Local variables: -! - .COMMON -! -! PARAM -! - NSTOK J - NFREQ J - NCOUNT J - INTIME J - RA D - DEC D - FREQ D - DFREQ D - NSCAN J - COORD C8 - WRITE_WT L -! -! NAMES -! - OBJECT C16 - INSTRUMENT C16 - CAL C16 - RP_OBSERVER C16 - DATOBS C8 - DATWRIT C8 - FILE C80 - DATSYS C8 - VERSION C8 -! -! SPECT -! - IVELREF J - RFREQ D - VEL1 D -! -! ANTEN -! - NANT J - X D(ANT_MAX) - Y D(ANT_MAX) - Z D(ANT_MAX) - STA C8(ANT_MAX) - X_ARRAY D - Y_ARRAY D - Z_ARRAY D - ANT_NUM J(ANT_MAX) - AXIS_OFFSET D(ANT_MAX) - ANT_MOUNT J(ANT_MAX) - FEED_TYPE C2(2,ANT_MAX) - FEED_PA D(2,ANT_MAX) - FEED_CAL D(ANT_MAX,MAX_IF,POL_MAX) - AN_FOUND L -! -! CARDS -! - NCARD J - CARD C80(MAX_CARD) -! -! EPHEM -! - RP_DEFEAT J - RP_UTCMTAI D - RP_C D(12) - RP_DJMREFP D - RP_DJMREFT D -! -! IF -! - N_IF J - IF_FREQ D(MAX_IF) - IF_INVERT J(MAX_IF) - IF_BW D(MAX_IF) - IF_NFREQ J(MAX_IF) - IF_NSTOK J(MAX_IF) - IF_CSTOK C2(4,MAX_IF) - IF_SAMPL J(MAX_IF) - IF_FOUND L - IF_NUM J(MAX_IF) - IF_REF D(MAX_IF) - IF_SIMUL J(MAX_IF) - IF_CHAIN J(MAX_IF) -! -! SU -! - N_SU J - SU_NAME C16(MAX_SU) - SU_RA D(MAX_SU) - SU_DEC D(MAX_SU) - SU_CAL C4(MAX_SU) - SU_FOUND L - SU_RAD D(MAX_SU) - SU_DECD D(MAX_SU) - SU_NUM J(MAX_SU) - SU_PRA D(MAX_SU) - SU_PDEC D(MAX_SU) - SU_PRAD D(MAX_SU) - SU_PDECD D(MAX_SU) -! -! FG -! - N_FG J - FG_ANT J(2,MAX_FG) - FG_UT D(2,MAX_FG) - FG_IF J(2,MAX_FG) - FG_CHAN J(2,MAX_FG) - FG_STOK J(2,MAX_FG) - FG_REASON C24(MAX_FG) - FG_FOUND L -! -! NX -! - N_NX J - NX_REC J(MAX_NX) - NX_DATE C8(MAX_NX) - NX_UT D(MAX_NX) - NX_SOURCE C16(MAX_NX) - NX_FOUND L -! -! MT -! - N_MT J - MT_ANT J(MAX_MT) - MT_UT D(MAX_MT) - MT_PRESS D(MAX_MT) - MT_TEMP D(MAX_MT) - MT_HUMID D(MAX_MT) - MT_FOUND L -! -!INDEX -! - RP_IOSTAT J -! -! SC -! - SC_UT E - SC_ANT J - SC_IF J - SC_Q J - SC_CAL E(MAX_SC,MAX_IF,ANT_MAX) - SC_SRCNO J -! -!CU -! - N_CU J - CU_UT D(MAX_CU) - CU_ANT J(MAX_CU) - CU_IF J(MAX_CU) - CU_CAL1 D(MAX_CU) - CU_CAL2 D(MAX_CU) - CU_CH1 J(MAX_CU) - CU_CH2 J(MAX_CU) - CU_FOUND L -.END diff --git a/src/nscan/rsc.dsc b/src/nscan/rsc.dsc deleted file mode 100644 index 003f8e3d1e4b6c3df7d4ab55ef2fc8e5c50f452e..0000000000000000000000000000000000000000 --- a/src/nscan/rsc.dsc +++ /dev/null @@ -1,57 +0,0 @@ -!+ QSCHD.DSC -! WNB 880314 -! -! Revisions: -! HjV 940519 Changed for use in Newstar -! -%REVISION=WNB=880314="Original version" -%REVISION=HJV=940519="Changed for use in Newstar" -! -! Define layout of R-series SCAN-header and Scan-data. -! -%COMMENT="QFHHD.DSC defines the R-series SCAN header and SCAN data" -%COMMENT=" " -! -! -%VERSION=2 !VERSION -%SYSTEM=2 -%USER=WNB -%%DATE -%%NAME -! -! -%LOCAL=QSCHL=440 !REQUIRED LENGTH -%LOCAL=QFNM=120 !OFFSET TO FIELD NAME REQUIRED -! -.PARAMETER -.BEGIN=QSC -! -! - VER I2 !VERSION - LEN I2 !LENGTH HEADER - HA R4 !HA SCAN (CIRCLES) - CSM R4 !COS/SIN SCALE MULTIPLIER - RNP R4 !REDUNDANCY PHASE NOISE (W.U.) - ALP R4 !ALIGN PHASE NOISE (W.U.) - ALG R4 !ALIGN GAIN NOISE (W.U.) - MAX R4 !MAXIMUM COS/SIN - RNG R4 !REDUNDANCY GAIN ERROR (W.U.) - RIP I4 !PTR TO REDUNDANT IFR LIST - RIN I2 !# OF REDUNDANT SPACINGS - DEL - !DELETE THIS SCAN - DI1 -(0:8) !DELETE IFRS PART 1 - EXT R4 !EXTINCTION FACTOR - REF R4 !REFRACTION (MU-1) - WRP R4(0:13) !SRT PHASE ERROR TEL (CIR) - RDP R4(0:13) !SRT RED. PHASE ERROR (CIR) - CLP R4(16) !SRT CELESTIAL PHASE (CIR) - WRG R4(0:13) !SRT GAIN ERROR TEL (LOG) - RDG R4(0:13) !SRT RED. GAIN ERROR (LOG) - CLG R4(16) !SRT CELESTIAL GAIN (LOG) - FRP -(0:13) !WSRT PHASE FREEDOM - FRG -(0:13) !WSRT GAIN FREEDOM - DI2 -(0:2) !DELETE IFR PART 2 - R2 -(0:0) !RESERVED - DAT I2(2,0:90) !SCAN DATA COS,SIN -.END -!- diff --git a/src/nscan/rsh.dsc b/src/nscan/rsh.dsc deleted file mode 100644 index c13429b12a57e51d4350939cc1acf41d1acf6ffb..0000000000000000000000000000000000000000 --- a/src/nscan/rsh.dsc +++ /dev/null @@ -1,70 +0,0 @@ -!+ QSHHD.DSC -! WNB 880314 -! -! Revisions: -! HjV 940519 Changed for use in Newstar -! -%REVISION=WNB=880314="Original version" -%REVISION=HJV=940519="Changed for use in Newstar" -! -! Define layout of R-series SCAN-set-header. -! -%COMMENT="QFHHD.DSC defines the R-series SCAN set header" -%COMMENT=" " -! -! -%VERSION=2 !VERSION -%SYSTEM=2 -%USER=WNB -%%DATE -%%NAME -! -%LOCAL=QQSHL=400 !REQUIRED LENGTH -%LOCAL=QFNM=120 !OFFSET TO FIELD NAME REQUIRED -! -.PARAMETER -.BEGIN=QSH -! -! - SLH I4(0:1) !SET HEADER LINK LIST - LEN I2 !LENGTH HEADER - VER I2 !VERSION - DIP I2 !DIPOLE POS OR 0 (9=+X, 10=++) - BEC I2 !BACKEND CONF. CODE - BDN I2 !BAND NUMBER (CHANNEL) - PLN I2 !# OF POLARISATIONS - VNR I4 !OBS. # (=VOLG+CYCLUS*66536) - EPO R4 !OBS. EPOCH (E.G. 1985.73) - UTB R4 !START TIME (CIRCLES) - UTE R4 !END TIME (CIRCLES) - RA R4 !OBS. RA (CIRCLES) - DEC R4 !OBS. DEC (CIRCLES) - FRQ R4 !OBS. FREQUENCY (MHZ) - BDW R4 !BANDWIDTH (MHZ) - OHP I4 !PTR TO OH INFO OR 0 - SCP I4 !PTR TO SC INFO - SHP I4 !PTR TO SH INFO - HAB R4 !FIRST HA (CIRCLES) - HAI R4 !HA INCREMENT SCANS (CIRCLES) - INT R4 !TIME INCREMENT SCANS (SEC) - ODY I2 !OBS. DAY SINCE 0 JAN - OYR I2 !OBS. YEAR OR 0 (E.G. 1985) - HAV R4 !AVERAGING HA (CIRCLES) - RTP R4(0:13) !WSRT POSITIONS IN METERS - STN I2 !SET NUMBER - FSL I2 !FULL POL. SCAN LENGTH - SCN I2 !# OF SCANS - R1 -(0:53) !RESERVED - PLC C2(4) !POLARISATION CODE (E.G. XX) - IFN I2(4) !# OF IFRS PER SCAN - IFP I4(4) !PTR TO INTERFEROMETER TABLE - SAP I4(4) !PTR TO SCAN AREA - RNP R4(4) !REDUNDANCY PHASE NOISE (WU) - ALP R4(4) !ALIGN PHASE NOISE (W.U.) - ALG R4(4) !ALIGN GAIN NOISE (W.U.) - RNG R4(4) !REDUNDANCY GAIN NOISE (W.U.) - MDL I4(4) !SAVED MODEL LIST - MDS I4(4) !SAVED MODEL DATA - R2 -(0:55) !RESERVED -.END -!- diff --git a/src/nscan/sch.dsc b/src/nscan/sch.dsc deleted file mode 100644 index 3a9715322112cb262301e7f47fdee1756fc14b75..0000000000000000000000000000000000000000 --- a/src/nscan/sch.dsc +++ /dev/null @@ -1,94 +0,0 @@ -!+ SCH.DSC -! WNB 900304 -! -! Revisions: -! -%REVISION=JPH=961112="Complete JPH 941007" -%REVISION=HjV=950511="Add AOTHUSED: -%REVISION=JPH=941010="add pseudo units for various fields; P(deg) --> P(rad)" -%REVISION=JPH=941007="split tables in X and Y parts, format for 6 per line" -%REVISION=WNB=931215="Add some edit formats" -%REVISION=WNB=930803="Use NSTAR.DSF" -%REVISION=JPH=930616="Apply/deapply and FL_ bit masks to cbits.dsc; comments" -%REVISION=WNB=930604="Add FL_, change BITS contents" -%REVISION=WNB=930602="Add IREF, AIREF, CLKC, ACLKC; SCH_M_IREF, CLK" -%REVISION=WNB=930602="Delete DOB, DEGEN" -%REVISION=JPH=930128="Add apply/deapply mask bits" -%REVISION=WNB=921217="Add PANG" -%REVISION=WNB=900304="Original version SCH" -! -! Define Scan Header block -! -%COMMENT="SCH.DSC defines the scan header block" -%COMMENT=" " -%COMMENT="REDNS, ALGNS, OTHNS must be in this order and adjacent" -%COMMENT=" " -! -%VERSION=1 !VERSION -%SYSTEM=1 -%USER=WNB -%%DATE -%%NAME -! -! Get global # of telescopes -! -%INCLUDE=NSTAR_DSF -! -!- -.PARAMETER - SCHTEL J /NSTAR_TEL/ ! # OF TELESCOPES -! -.BEGIN=SCH - HA E <EAF12.7,,"deg">! APP. HA (CIRCLES) - MAX E <E12.3,,"W.U."> ! COS/SIN MAX (W.U.) - SCAL E <E12.6> ! COS/SIN SCALE MULTIPLIER - 1 - REDNS E(0:1) <+,," "> - REDNSX=REDNS E(0:1) <E12.3,,"W.U."> !REDUNDANCY NOISE (W.U., G/P) - REDNSY E(0:1) <E12.3,,"W.U."> !REDUNDANCY NOISE (W.U., G/P) - ALGNS E(0:1) <+,," "> - ALGNSX=ALGNS E(0:1) <E12.3,,"W.U."> !ALIGN NOISE (W.U., G/P) - ALGNSY E(0:1) <E12.3,,"W.U."> !ALIGN NOISE (W.U., G/P) - OTHNS E(0:1) <+,," "> - OTHNSX=OTHNS E(0:1) <E12.3,,"W.U."> !OTHER NOISE (W.U., G/P) - OTHNSY E(0:1) <E12.3,,"W.U."> !OTHER NOISE (W.U. G/P) - BITS J <XJ> !GENERAL BITS (8-15: flag bits) - CLKC E <E12.6,,"s"> !CLOCK CORRECTION (sec) - ACLKC E <E12.6,,"s"> !APPL. CLOCK CORRECTION (sec) - IREF E <EAF12.2,,"deg/km"> - !IONOS. REFRACT. (CIRCLES/km) - EXT E <E12.5,,"factr-1"> ! EXTINCTION FACTOR -1 - REFR E <E12.5,,"mu-1"> ! REFRACTION (MU-1) - FARAD E <EAR12.2,,"deg"> !FARADAY ROTATION (RADIANS) - REDC E(0:1,0:NSTAR_TEL-1) <+,," "> - REDCX=REDC E(0:1,0:NSTAR_TEL-1) <11$E10.4,,"ln G, P(rad)"> - ! X REDUNDANCY CORRECTION - REDCY E(0:1,0:NSTAR_TEL-1) <11$E10.4,,"ln G, P(rad)"> - ! Y REDUNDANCY CORRECTION - ALGC E(0:1,0:NSTAR_TEL-1) <+,," "> - ALGCX=ALGC E(0:1,0:NSTAR_TEL-1) <11$E10.4,,"ln G, P(rad)"> - ! X ALIGN CORRECTION (LOG) - ALGCY E(0:1,0:NSTAR_TEL-1) <11$E10.4,,"ln G, P(rad)"> - ! Y ALIGN CORRECTION (LOG) - OTHC E(0:1,0:NSTAR_TEL-1) <+,," "> - OTHCX=OTHC E(0:1,0:NSTAR_TEL-1) <11$E10.4,,"ln G, P(rad)"> - ! X OTHER CORRECTION (LOG) - OTHCY E(0:1,0:NSTAR_TEL-1) <11$E10.4,,"ln G, P(rad)"> - ! Y OTHER CORRECTION (LOG) - IFRAC J <XJ,1,,P:IFRC> !POINTER TO ADD IFR CORRECTIONS - IFRMC J <XJ,1,,P:IFRC> !POINTER TO MUL. IFR CORRNS - AEXT E <E12.5> !APPLIED EXTINCTION FACTOR -1 - AREFR E <E12.5> !APPLIED REFRACTION (MU-1) - AFARAD E <E12.2> !APPLIED FARADAY rotation - AOTHC E(0:1,0:NSTAR_TEL-1) <+,," "> - AOTHCX=AOTHC E(0:1,0:NSTAR_TEL-1) <11$E10.4,,"ln G, P(rad)"> - ! X APPLIED OTHER CORRECTION - AOTHCY E(0:1,0:NSTAR_TEL-1) <11$E10.4,,"ln G, P(rad)"> - ! Y APPLIED OTHER CORRECTION - AIFRAC J <XJ,1,,P:IFRC> !PTR TO APPL. ADD IFR CORRN - AIFRMC J <XJ,1,,P:IFRC> !PTR TO APPL. MUL IFR CORRN - PANG E <EAF12.2,,"deg"> !PARALL. ANGLE (CIRCLES) - AIREF E <EAF12.2,,"deg/km"> - !APPLIED IONOSPH.. REFRCTN - AOTHUSED J !1 = AOTH DE-APPLIED -.END !END DEFINITION -!- diff --git a/src/nscan/scn.dsc b/src/nscan/scn.dsc deleted file mode 100644 index 4f9ce487ee8c112f54b2a8f59f90373e262380d4..0000000000000000000000000000000000000000 --- a/src/nscan/scn.dsc +++ /dev/null @@ -1,26 +0,0 @@ -!+ SCN.DSC -! JPH 930420 -! -! Revisions: -! -%REVISION=JPH=930420="Original version" -! -! Hierarchy of SGH levels -! -%COMMENT="SCN.DEF is an INCLUDE file for programs that manipulate (SCN-)SGH blocks" -%COMMENT=" " -! -%VERSION=1 -%SYSTEM=1 -%USER=JPH -%%DATE -%%NAME -!- -.PARAMETER - SCN A:(0) /GRP,OBS,FLD,CHN,SCT/ !Describes SGH level for SCN files: - !GRouP SGH level - !OBServation SGH level - !FieLD SGH level - !CHaNnel SGH level - !SeCTor SGH level -! diff --git a/src/nscan/scnnode.pef b/src/nscan/scnnode.pef deleted file mode 100644 index e29a9e26e61ac35093d940a57b548e2abf44900e..0000000000000000000000000000000000000000 --- a/src/nscan/scnnode.pef +++ /dev/null @@ -1,74 +0,0 @@ -!+SCNNODE.PEF: SCN_NODE keywords -! JPH 941005 Split from NCOMM.PEF -! JPH 941208 Prompt and help texts -! JPH 950124 Help texts -! -! Revisions: -! -! Ref: -! -KEYWORD=SCN_NODE - DATA_TYP=C - IO=I - LENGTH=80 - SWITCHES=LOOP,NULL_VALUES,WILD_CARDS - SEARCH=L,P - PROMPT=".SCN file name" - HELP=" Specify the file name (no extension). -. -You may enter - - [<directory>/]** -. -to get a list of .SCN files in your current or another directory; then enter -. - #<n> -. -to select the <n>'th file from that list. -"! -!---------------------------------------------------------------------------- -! Ref: -! -KEYWORD=INPUT_SCN_NODE - DATA_TYP=C - IO=I - LENGTH=80 - SWITCHES=LOOP,NULL_VALUES,WILD_CARDS - SEARCH=L,P - PROMPT="Input .SCN file name" - HELP=" Specify the file name (no extension). -. -You may enter - - [<directory>/]** -. -to get a list of .SCN files in your current or another directory; then enter -. - #<n> -. -to select the <n>'th file from that list. -" -! -!-------------------------------------------------------------------------- -! Ref: -! -KEYWORD=OUTPUT_SCN_NODE - DATA_TYP=C - IO=I - LENGTH=80 - SWITCHES=LOOP,NULL_VALUES,WILD_CARDS - SEARCH=L,P - PROMPT="Output .SCN file name" - HELP=" Specify the file name (no extension). -. -You may enter - - [<directory>/]** -. -to get a list of .SCN files in your current or another directory; then enter -. - #<n> -. -to select the <n>'th file from that list. - -" diff --git a/src/nscan/scnsets.pef b/src/nscan/scnsets.pef deleted file mode 100644 index 3f70224c2821c00f1f97d19f770bca5d34c9a53c..0000000000000000000000000000000000000000 --- a/src/nscan/scnsets.pef +++ /dev/null @@ -1,351 +0,0 @@ -!+ SCNSETS.PEF: .SCN file Sets specification. -! JPH 940812 -! -! Revisions: -! WNB 930630 Add NGF sub-fields -! CMV 930712 Correct typo -! CMV 931210 Changed LOOPS to SCN/WMP/MDL/NGF_LOOPS -! CMV 931220 Add info about L and O answers to ???_LOOPS/SETS -! JPH 940722 Clarify SCN_LOOPS help text -! JPH 940812 Split from nsets.pef -! 3-character index names -! impove HELP texts -! JPH 940920 Improve LOOPS prompt and help -! Remove () from prompts -! JPH 941005 OVERVIEW -! JPH 941129 Add <grp...> to LOOPS prompt -! JPH 951006 Revise help texts -! JPH 960126 Add ALTOBS -! -! -! Ref: WNDSTA -! -KEYWORD=SCN_SETS - DATA_TYP=C - IO=I - LENGTH=32 - NVALUES=64 - SWITCHES=LOOP,NULL_VALUES,WILD_CARDS - SEARCH=L,P - PROMPT="Sectors to process: grp.obs.fld.chn.seq " - HELP=" Quick reminders: =============== - - L gives you a quick summary of the groups in your .SCN file - - O gives you access to more detailed overviews in various levels of detail - - #<n> is a synonym for the grp.obs.fld.chn.seq index that is sometimes - convenient to use. # ('absolute') sector numbers are shown in most - displays that show sector indices. - - @ or > will prompt you for each of the 5 indices separately. Use this - option if you are not yet comfortable with the sector-indexing system. - - If you have requested looping (SCN_LOOPS parameter), the sectors you - specify will be processed in the first loop cycle, and the indices - incremented for each following cycle. - - If you have second thoughts about looping, reply # or ctrl-D to backtrack. -. -Sector selection: ================ - You may select SETS of sectors for processing by [ranges of] values for -the five indices. A range has the form <start>-[<end>][:<step>]. A wildcard '*' -means 'all'; *s and trailing dots may be omitted. - Example - . 3-7:2 . 4-:2 . 1-7 (blanks inserted for clarity only) - meaning - all grp (missing grp index is replaced by a '*') - for each grp: obs=3 to 7 in steps of 2 (i.e. 3, 5 and 7) - for each obs: all even fld starting at 4 - for each fld: chn=1 to 7; - for each chn: all seq (omitted trailing seq index replaced by a '*') -. - -Multiple SETS may be specified, separated by comma's: <Set1>,<Set2>,... The -associated SCN_LOOPS keyword allows even more looping over index values. -. -Other keywords allow the user to select hour-angle range, polarisation and -interferometers within each SECTOR. -. -Explanation of sector indices: ============================= - A .SCN file contains visibilities and associated data for one or more -objects. The basic unit of data is the SECTOR, which is a collection of SCANS -contiguous in hour angle for one sky position and one frequency. Sectors are -addressed through a SECTOR INDEX which is a string of five integers separated -by dots: - grp.obs.fld.chn.seq -. - The GROUP (grp) and OBSERVATION (obs) are basically administrative units for - organising the data, e.g. per object. grp and obs number alocations have - been determined by NSCAN when you read the data in. -. - Mosaic observations contain multiple FIELDs (fld), numbered from 0 to n-1 in - the sequence in which they were observed at the WSRT. A non-mosaic - observation contains only field 0. -. - Line and broadband continuum observations generally have several frequency - CHANNELS (chn), also known as 'bands'. The channles are numbered from 1 to - N. Channel 0 is by definition the 'continuum' channel, i.e. the sum of all - 'line' channels. -. - In mosaic observations, the sector SEQUENCE (seq) number distinguishes the - successive hour-angle 'sectors'. Other situations are conceivable where - multiple sectors with the same grp.obs.fld.chn exist; it is then your - responsibility to know what they represent. -. -Index values start at zero. (Remember that for the CHN index this is the -continuum channel.) -. -" -! -! Get loop parameters -! Ref: WNDSTA (via WNDXLP) -! -KEYWORD=SCN_LOOPS - DATA_TYP=C - IO=I - LENGTH=32 - NVALUES=16 - SWITCHES=NULL_VALUES,WILD_CARDS - SEARCH=L,P - DEFAULT=""" /ASK" - PROMPT="Loop specifications: |- -nr of cycles, index increment (grp.obs.fld.chn.seq) per cycle |" - HELP=" Quick reminders: =============== - - L gives you a quick summary of the groups in your .SCN file - - O gives you access to more detailed overviews in various levels of detail - - #<n> is a synonym for the grp.obs.fld.chn.seq index that is sometimes - convenient to use. # ('absolute') sector numbers are shown in most - displays that show sector indices. - - A loop is specified by the number of cycles and the index increment per - cycle. Loops may be nested. -. -The loop concept in full: ======================== - A loop specifies repeated execution of your operation. It is defined by -the number of cycles and the increment per cycle for the sector indices: -. - <n_cycle>, <grp_incr>.<obs_incr>.<fld_incr>.<chn_incr>.<seq_incr> -. -Later you will define, through the SCN_SETS parameter, the sector set to be -processed in the first cycle. - Example: - SCN_LOOPS= 3, 0.0.2.1.0 - SCN_SETS= 2.*.0-2.3.0, 2.*.1. - requests your operation to be executed three times, with sector sets - 2.*.0-2.3.0 (SCN_SETS value) - 2.*.2-4.4.0 (SCN_SETS + 1*increment) - 2.*.4-6.5.0 (SCN_SETS + 2*increment) -. -In the increment value, 0s and trailing dots may be omitted. Negative -increments are permitted. -. -Loops may be nested by giving more than one cycles-increment pair; in this case -the rightmost loop is executed inside the loop to its left. - Example: - SCN_LOOPS= 2,.1, 2,..1 - SCN_SETS= 0.0.0.*.0 - results in your operation being performed on the following sequence of - sectors: - 0.0.0.*.0 - 0.0.1.*.0 - 0.1.0.*.0 - 0.1.1.*.0 -. -Some fine points: ================ - Loops are a useful shorthand for specifying complicated repetitions of -the same operation on different sector sets. As the examples above demonstrate, -using SCN_LOOPS can save a lot of typing, in particular if the number of cycles -is large. - - Note that each cycle of a loop starts the requested operation anew. To -understand what this means, consider two ways to process all fields of a -16-field mosaic observation: - - SCN_LOOPS=<no input> SCN_LOOPS=16,..1 - SCN_SETS=grp.obs.* SCN_SETS=grp.obs.0 - -The left specification requests a single pass thorugh the operation using all -fields as input. The right specification requests 16 passes successively using -fields 0,1,2,... as input. -" -! -! Get level for overview -! Ref: NSCPFL -! -KEYWORD=OVERVIEW - DATA_TYP=C - IO=I - LENGTH=10 - OPTIONS=OBS, ALTOBS, FLD, CHN, SCT - DEFAULT=OBS - SWITCHES=LOOP,NULL_VALUES,WILD_CARDS - CHECKS=ABBREV_OPTIONS - SEARCH=L,P - PROMPT="Detail level for overview" - HELP=" Specify the level for the overview. -. -To get a quick overview of the entire file, use -. - OBS Shows a summary per observation (2nd index) listing the type of - observation, the fieldname, the sequence number ('Volgnummer'), - project number and UT date and time and the breakdown in - numbers of fields, channels and sectors and polarisations -. -To get more other details (frequency, bandwidth, HA range, number of scans and -number of interferometers), use -. - ALTOBS for one line per observation - FLD for one line per field in all observations - CHN for one line per channel in all fields in all observations - SCT for one line per sector in all channels in all fields in all - observations -. -NOTE: Depending on what is in your file, the volume of output in the latter -three modes may be quite large. If you are not interested in the difference -(e.g. in hour angle) between sectors, do not use SCT; if you are not interested -in the differences (e.g. in frequency) between channels, do not use CHN. -. -There is presently no mechanism to select only specific groups or observations -for display. -" -! -! Ref: WNDSTA_X -! -KEYWORD=SCN_GROUPS - DATA_TYP=C - IO=I - LENGTH=32 - SWITCHES=LOOP,NULL_VALUES,WILD_CARDS - SEARCH=L,P - PROMPT=" 1st index: grp = groups" - HELP=" Give the 'group' index-range (grp) of a sector-set specification - (grp.obs.fld.chn.seq) -. -An example of multiple groups in a .SCN file is one group for an observation -and another one for the associated calibrator observation(2). -. -Possible answers ([]=optional): -. - 0 take first (or only) group - n1 take group nr n1 (n1=0,1,2,3,....) - n1-n2[:n3] loop over groups n1 through n2 [step n3] - * loop over all available groups (wildcard) - n1-[*][:n3] loop over all available groups, - starting with n1 [step n3] -. -NB: The associated SCN_LOOPS keyword allows even more looping over index -values." -! -! Ref: WNDSTA_X -! -KEYWORD=SCN_OBSS - DATA_TYP=C - IO=I - LENGTH=32 - SWITCHES=LOOP,NULL_VALUES,WILD_CARDS - SEARCH=L,P - PROMPT=" 2nd index: observations" - HELP=" Give the 'observation' index-range (obs) of a sector-Set -specification - (grp.obs.fld.chn.seq) -. -Example of multiple observations in one ..SCN file group are: - the parts of an interrupted 12h observation; - observations of the same object, with different array configurations. -. -Possible answers ([]=optional): -. - 0 take first (or only) observation - n1 take group nr n1 (n1=0,1,2,3,....) - n1-n2[:n3] loop over groups n1 through n2 [step n3] - * loop over all available observations (wildcard) - n1-[*][:n3] loop over all available observations, - starting with n1 [step n3] -. -NB: The associated SCN_LOOPS keyword allows even more looping over index -values." -! -! Ref: WNDSTA_X -! -KEYWORD=SCN_FIELDS - DATA_TYP=C - IO=I - LENGTH=32 - SWITCHES=LOOP,NULL_VALUES,WILD_CARDS - SEARCH=L,P - PROMPT=" 3rd index: fields" - HELP=" Give the 'field' index-range (fld) of a sector-Set specification - (grp.obs.fld.chn.seq) -. -The standard use of multiple fields in a .SCN file observation is for the -different pointing centres (fields) in a mosaic observation. -. -Possible answers ([]=optional): -. - 0 take first (or only) field - n1 take field nr n1 (n1=0,1,2,3,....) - n1-n2[:n3] loop over fields n1 through n2 [step n3] - * loop over all fields in the observation (wildcard) - n1-[*][:n3] loop over all fields in the observation, - starting with n1 [step n3] -. -NB: The associated SCN_LOOPS keyword allows even more looping over index -values." -! -! Ref: WNDSTA_X -! -KEYWORD=SCN_CHANNELS - DATA_TYP=C - IO=I - LENGTH=32 - SWITCHES=LOOP,NULL_VALUES,WILD_CARDS - SEARCH=L,P - PROMPT=" 4th index: channels" - HELP=" Give the 'channel' index-range (chn) of a sector-Set -specification - (grp.obs.fld.chn.seq). -. -The standard use of multiple channels in a .SCN file field is for the different -frequency channels or bands in an observation. Note that the index for the -first channel is 1; channel 0 is by definition the 'continuum' channel, i.e. -the sum of all the observed 'line' channels. -. -Possible answers ([]=optional): -. - 0 take the continuum channel - n1 take channel nr n1 (n1=0,1,2,3,....) - n1-n2[:n3] loop over channels n1 through n2 [step n3] - * loop over all channels for the field (wildcard) - n1-[*] loop over all channels for the field, - starting with n1 [step n3] -. -NB: The associated SCN_LOOPS keyword allows even more looping over index -values." -! -! Ref: WNDSTA_X -! -KEYWORD=SCN_SECTORS - DATA_TYP=C - IO=I - LENGTH=32 - SWITCHES=LOOP,NULL_VALUES,WILD_CARDS - SEARCH=L,P - PROMPT=" 5th index: sectors" - HELP=" Give the 'sequence number' index-range (seq) of a sector-Set -specification - (grp.obs.fld.chn.seq). -. -A standard use of multiple sectors for one .SCN file field and one frequency is -for the different hour-angle 'slices' in a mosaic observation. -. -Possible answers ([]=optional): -. - 0 take the first sector - n1 take sector nr n1 (n1=0,1,2,3,....) - n1-n2[:n3] loop over sectors n1 through n2 [step n3] - * loop over all - (wildcard) - n1-[*] loop over all sectors for the field and channel, - starting with n1 [step n3] -. -NOTES: - In a mosaic observation, the HOUR_ANGLE range parameter can be used to -select sectors. This is simpler but cruder: The same range applies to all -SCN_SETS and SCN_LOOPS specified. -. - The associated SCN_LOOPS keyword allows even more looping over index -values." diff --git a/src/nscan/scw.dsc b/src/nscan/scw.dsc deleted file mode 100644 index 9ac3024c127d65d9220f1f0c7c5a48883e987c73..0000000000000000000000000000000000000000 --- a/src/nscan/scw.dsc +++ /dev/null @@ -1,234 +0,0 @@ -!+ SCW.DSC -! WNB 900118 -! -! Revisions: -! -%REVISION=CMV=940414="Add historical notes" -%REVISION=WNB=931215="Add some edit formats" -%REVISION=WNB=930803="Change .RECORD" -%REVISION=WNB=911022="Add mosaicking RA/DEC" -%REVISION=WNB=900118="Tape vs 7, system 59" -! -! -! Define WSRT SC block -! -! -%COMMENT="SCW.DSC defines the WSRT SC block" -! -%VERSION=7 !VERSION -%SYSTEM=59 -%USER=WNB -%%DATE -%%NAME -!- -.PARAMETER -.STRUCTURE=SRC !Subtracted sources - SRAI D <DAF12.7> !Right ascension subtracted source nr. I - SDECI D <DAF12.7> !Declination subtracted source nr. I - SFXXI E <E12.3> !Intensity XX subtracted source nr. I - SFXYI E <E12.3> ! " XY " " " - SFYXI E <E12.3> ! " YX " " " - SFYYI E <E12.3> ! " YY " " " -.END -.STRUCTURE=BCOR !Band corrections - PZ I(32) !Phase correction band 1 - DOFS I(32) !Delay offset band 1 - - -(0:127) ! - - TSYS E(32) !System temperatures band 1 - GAIN E(32) !Receiver gainfactors band 1 - NOIS E(32) !Noise source temperatures band 1 - GNCL I(32) !Amplitude correction methods band 1 - - -(0:255) ! - -.END -.STRUCTURE=MOZP !Mozaicking positions - RA0 J !RA epoch position - DEC0 J !DEC epoch position - RA1 J !RA apparent - DEC1 J !DEC apparent - SDEC J !sin(DEC1) - CDEC J !cos(DEC1) - MVNPA J(0:2) !Apparent position vector - MDVNPA J(0:2) !Differential apparent position vector - FREQ1 D <D12.6> !Apparent band centre frequency (MHz) - ! ols<62: reserved - - -(0:7) -.END -.BEGIN=SCW - ! (*) means use with care, not repaired - CBI I !Unequal data block flag (32767) - CBT C2 !Type identificator: System Calibration (SC) - NSC J !Record number of this record - LSC J !Number of SC records - NSCN J !First SC record of next SC group (=-32768 for last) - SDAY I !Local U.T. day number - ! FVERS<5: ST - STIM I !Start U.T. time in units of 10 sec. - ! FVERS<5: ST - ! FVERS<3: units of minutes - ETIM I !End U.T. time in units of 10 sec. (*) - ! ols<43: -32768 - - I !Empty (Delete character) - CFE J !Code front end - CIF J !Code if part - CBE J !Code backend - CPC J !Code pheripheral computers - CMC J !Code main computer - LRED I !Reduction level (Dwingeloo red. code) - - -(0:25) !Reserved for Dwingeloo reduction - VOLUME C6 !The volume name of the input - LABEL C4 !The label or dataset name of the input - - -(0:5) ! - - FSYN E !Frequency synthesizer (Mhz) - LO2L E !Frequency local oscillator 2 for DLB (Mhz) (*) - ! FVERS<6: LO2 - LO2C E !Frequency local oscillator 2 for DCB (Mhz) (*) - ! FVERS<6: LO3 - VIDE0 E !If to video mixing frequency (Mhz) - FF0 E !Fringe stopping frequency offset (Mhz) - AFRATE E !Artificial fringe rate (Mhz) (*) - ! FVERS<6: reserved - DOFSIJ I(0:27) !Delay offsets in nano sec for if lines - !OX, OY,... to DX, DY. (*) - ! <04/09/80: in cm - PREC D(3,3) <D12.9> !Precession matrix - NUTA D(3,3) <D12.9> !Nutation matrix - ABER D(3) <D12.9> !Aberration vector - VNPA D(3) <D12.9> !Apparent position vector - DVNPA D(3) <D12.9> !Differential apparent position vector (Circle/U.T.day) - ! FVERS<5: in S.T. - EQNOX D <D12.9> !Equation of equinoxes - DEQNOX D <D12.9> !Differential equation of equinoxes (Circle/U.T.day) - ! FVERS<5: in S.T. - EPS D <D12.9> !True obliquity - DEPS D <D12.9> !Nutation in obliquity - DPSI D <D12.9> !Nutation in length - - -(0:3) ! - - GLAT E <EAF12.7> !Geocentric latitude (Circles) - ! ols<43: different field (never used) - WLAT E <EAF12.7> !Geographic latitude of the delay switching point - WLON E <EAF12.7> !Geographic longtitude used for the siderial clock point - CENTRE E <E12.4> !Position of the delay switching point - !W.R.T. old coordinate system (= 3000) - PHI E <EAF12.7> !Rotation angle - FREQ D <D12.6> !Fringe stopping frequency for middle observation - ONCLM E <E12.6> !Total online clock correction for app coord moment - CSHAD E(3) !Telescope 'shadowing' coefficients - BL1 J !Code broadband long term (phase) - BL2 J !Code broadband long term (amplitude) - - -(0:7) ! - - BGS J !Code broadband short term - BGT J !Code telescope coefficients - - -(0:7) ! - - BET J !Code if corrections - BED J !Code delay corrections - - -(0:7) ! - - SEV J !Code video corrections - BF J !Code field dependent corrections - - -(0:7) ! - - ! GCODE...DPLE: FVERS<3: reserved - GCODE I !Main amplitude correction method (1-3) - - -(0:1) ! - - GNCAL B(0:27) !Final ampl. correction method per IF -DLB- (Per byte) - TSYSI E(0:27) <E12.2> !System temperatures (K) - RGAINI E(0:27) <E12.4> !Receiver gain factors per IF - TNOISI E(0:27) <E12.2> !Noise source temperature (K) 0X,0Y,...DY - JDCP E !Julian day for last known bih data - YEAR I !Civil year of JDCP - MONTH I !Civil month of JDCP - DAY I !Civil day of JDCP - - -(0:1) ! - - CLCOFF E !Fixed clock offset - CLOCK E !Total online clock correction for JDCP moment - DCLOCK E !Differential clock correction - CUTST D <D12.9> !(Length u.t.day / length s.t.day) -1 - ! FVERS<5: reserved - - -(0:11) ! - - POLEOFF E !Fixed declination of the baseline pole - POLE E !Total baseline pole correction for JDCP moment - DPLE E !Differential baseline pole correction - LO3C E(8) !DCB local oscillators band 1 to 8 (Mhz) (*) - ! FVERS<6: FB0..7 - LO3G E !Average DCB local oscillator used for fringe (Mhz) (*) - ! FVERS<6: reserved - FCODE I !Code IF switches - DELTA E(0:27) !Real part dipole corr. factors (0X,0Y,...DY) in % (*) - ! ols<43: reserved - ! ols>46: different units - THETA E(0:27) !Imaginary part dipole corr. factors (0X,0Y,...DY) in % (*) - ! ols<43: reserved - ! ols>46: different units - FENRS I(0:27) !Front end nrs (0X,0Y,1X,...,DY) (*) - ! ols<57: reserved - - -(0:3) !- - FROFS E !RF frequency step size (System 49) - SYNF I !Synthesizer multiplication factor - ! ols<43: reserved - LODEL I(0:27) !Delay values of the lo-cables (Nsec) - FRO D !Observing freq. for IF phase zero values (Mhz) - ! ols<26: reserved - CCOR E !Offline clock correction (Dwingeloo use) - DPOLM E !Total baseline pole corr. for app. coord moment - CFREQ E !Offline frequency correction - CQI I(0:13) !Position corrections per tel. in Q direction - !(10**(-4) M) - CNI I(0:13) !Position corrections per tel. in N direction - !(10**(-4) M) - CPI I(0:13) !Position corrections per tel. in P direction - !(10**(-4) M) - AD0 E !Average telescope axis difference (M) - CPSI I(0:13) !Polar axis correction per tel. (2**(-24) circles) - CPWI I(0:13) !Polar axis correction per tel. (2**(-24) circles) - PZIJ I(0:27) !If phase zero corrections for primary fringe - !(2**(-16) circles) - ! C?X? FVERS<3: incorrect values - C2X2 E(4) !4 coefficients for v. Vleck corr. 2x2 mode - C2X3 E(4) ! " " " " 2x3 " - C2X4 E(4) ! " " " " 2x4 " - C4X3 E(4) ! " " " " 4x3 " - C4X4 E(4) ! " " " " 4x4 " - CFGJI E(112) !Coefficients for video band gain corrections - CFFJI E(112) !Coefficients for video band phase corrections - TEMP I !Outside temperature (Degrees celcius) - BAR I !Air pressure (Mb) - HUM I !Humidity degree - - -(0:1) ! - - CMU1 E !Refraction coefficient dry air - H1 E !Scale height dry air - CMU2 E !Refraction index water vapour - H2 E !Scale height water vapour - CEXT E !Extinction coefficient - ! ols<43: reserved - RHA E(24) !Hour angle table (Circles) - CFRA E(24) !24 rotation angles (Circles) - CRIF E(24) !Refraction corrections (Circles) - - -(0:279) ! - - CMON C64 !Monitoring information - - -(0:19) ! - - NRPNCH I !Nr. of information fields in PNCHI (Max =4) - NRSUBT I !Nr. of subtracted sources (Max. is 9) - - -(0:7) ! - - PNCHI C320 !General information fields - SRC S:SRC(9) !Subtracted sources - - C4 !Gain/phase table name - TMP J !Table number (Code) - - -(0:3) ! - - ! - LENTMP I !Nr. of records on disk necessary for this table. - !0 or 11 means 160 interf. (Only standard) - !27 means 420 interf. (Standard and non-standard) - - -(0:1) ! - - PH0 E(0:159) ! 160 phase zero values, per interferometer - !in radians (0XAX - 9YDY) - GN0 E(0:159) ! 160 gain factors, per interferometer - !(0XAX - 9YDY) - PH10 E(0:259) ! 260 phase zero values, per interferometer - !in radians (0X0X - DYDY) (Non-standard) - GN10 E(0:259) ! 260 gain factors, per interferometer - !(0X0X - DYDY) (Non-standard) - - -(0:463) ! - - BCOR S:BCOR(8) !Band corrections - ! FVERS<6: reserved/not on tape - MOZP S:MOZP(120) !Mozaicking positions - ! FVERS<7: reserved/not on tape -.END -!- diff --git a/src/nscan/select.pef b/src/nscan/select.pef deleted file mode 100644 index dd296265924e035792ce4119e11efc6f43b1e64f..0000000000000000000000000000000000000000 --- a/src/nscan/select.pef +++ /dev/null @@ -1,141 +0,0 @@ -!+NSELECT.PEF: Visibility-selection parameters -! -! JPH 941005 - split off from NCOMM.PEF -! -! Revisions: -! -! -! ============================================================================== -! Keywords for data-selection inside the HA-scan -! ============================================================================== -! -! Get polarisation -! Ref: NSCPLS -! -KEYWORD=SELECT_XYX - DATA_TYP=C - LENGTH=4 - IO=I - CHECKS=ABBREV_OPTIONS - SWITCHES=LOOP,NULL_VALUES,WILD_CARDS - OPTIONS=XYX,XY,Y,X,YX,YYX,XXY - SEARCH=L,P - PROMPT="polarisations" - HELP=" Select the polarisation(s) to be used: -. - XYX all four combinations (XX,YX,YX,YY) - XY XX and YY - X XX only - Y YY only - YX XY and YX - YYX YX - XXY XY" -! -! Get HA range -! Ref: NSCHAS -! -KEYWORD=HA_RANGE - DATA_TYP=R - IO=I - NVALUES=2 - SWITCHES=VECTOR,NULL_VALUES,WILD_CARDS - CHECKS=MAXIMUM,MINIMUM,NON_DESCENDING - MINIMUM=-180.,-180. - MAXIMUM=+180.,+180. - UNITS=DEG,RAD,CIR,HMS - SEARCH=L,P - PROMPT="HA range" - HELP=" Specify the hour-angle range to be selected" -! -! Get Interferometer selection -! Ref: NSCIFS -! -KEYWORD=SELECT_IFRS - DATA_TYP=C - IO=I - LENGTH=4 - NVALUES=40 - SWITCHES=LOOP,NULL_VALUES,WILD_CARD - SEARCH=L,P - PROMPT="Changes to the interferometer selection|" - HELP=" Specify how you want to change the interferometer selection. -. -Interferometers are defined as combinations of two telescopes; an -interferometer may thus contain 1, 2 or 4 polarisations. -. -A combination of two different telescopes is called a CROSS[-correlating] -interferometer, a telescope combined with itself an AUTO[-correlating] -interferometer. At present, WSRT data contain only cross-interferometer data, -so selection/elimination of auto-interferometers is irrelevant. -. -The following codes are used to identify (groups of) telescopes: -. - P show the present selection table -. - For the WSRT: - 0,1,2,3,4,5,6,7,8,9,A,B,C,D: - individual WSRT telescopes (case-insensitive) - * all telescopes or all cross interferometers - F all fixed telescopes = 0 through 9 - M all movable telescopes = A through D - Y telescopes A and B - Z telescopes C and D - # autocorrelation -. - Additional codes for the Australian Telecope Compact Array (ATCA): - T ATCA telescopes (8-D) - U the ATCA complement (0-7). -. -An interferometer specification without a prefix or prefixed with a + sign is -SELECTED, a specification with a minus sign prefixed is ELIMINATED. Selection -and elimination are incremental. Up to 40 select/eliminate specifications may -be given, separated by comma's; they will be honored in the order in which you -give them. Prompting will continue until you stop replying. -. -The standard operation is on the cross-correlations. A telescope name followed -with a # indicates the auto-correlations. -. -Examples: - -3F eliminate combinations of 3 with other fixed telescopes - FM,-9A select all fixed-movable combinations (the WSRT's 40 'standard' - interferometers) except 9A - -#,33 eliminate all auto-interferometers, then re-select 33 -" -! -! Get Telescope selection -! Ref: NSCTLS -! -KEYWORD=SELECT_TELS - DATA_TYP=C - IO=I - LENGTH=4 - NVALUES=20 - SWITCHES=LOOP,NULL_VALUES,WILD_CARD - SEARCH=L,P - PROMPT="Changes to the telescope selection|" - HELP=" Specify how you want to change the telescope selection. -. -The following codes are used to identify (groups of) telescopes: -. - P show the present selection table -. - For the WSRT: - 0,1,2,3,4,5,6,7,8,9,A,B,C,D: - individual WSRT telescopes (case-insensitive) - * all telesopes - F all fixed telescopes = 0 through 9 - M all movable telescopes = A through D - Y telescopes A and B - Z telescopes C and D -. - Additional codes for the Australian Telecope Compact Array (ATCA): - T ATCA telescopes (8-D) - U the ATCA complement (0-7). -. -A telesope specification without a prefix or prefixed with a + sign is -SELECTED, a specification with a minus sign prefixed is ELIMINATED. Selection -and elimination are incremental. Up to 20 select/eliminate specifications may -be given, separated by comma's; they will be honored in the order in which you -give them. Prompting will continue until you stop replying. -. -Examples: -*,3,+3,-8,*,-F,-U,T" diff --git a/src/nscan/shw.dsc b/src/nscan/shw.dsc deleted file mode 100644 index a4f69e8cd16a566011b7d833f76bbe333174431e..0000000000000000000000000000000000000000 --- a/src/nscan/shw.dsc +++ /dev/null @@ -1,67 +0,0 @@ -!+ SHW.DSC -! WNB 900118 -! -! Revisions: -! -%REVISION=CMV=940414="Add historical notes" -%REVISION=WNB=931215="Add some edit formats" -%REVISION=WNB=930803="Change .RECORD" -%REVISION=WNB=900118="Tape vs 7, system 59" -! -! Define WSRT SH block -! -! -! -%VERSION=7 !VERSION -%SYSTEM=59 -%USER=WNB -%LOCAL=IFRLEN=12 !Length IFR subblock -%%DATE -%%NAME -%COMMENT="SHW.DSC defines the WSRT SH block" -!- -.PARAMETER -.STRUCTURE=IFR !IFR table - INFNR I !Interferometer number - ! FVERS<2: different codes - WTEL I !West telescope indicator - OTEL I !East telescope indicator - RBAS I !Baseline rounded to nearest meter - NIH J !Record # of IH block -.END !End IFR table -.BEGIN=SHW - ! (*) means use with care, not repaired - CBI I !Unequal data block flag (32767) - CBT C2 !Identification: Set Header (SH) - NSH J !Record number of this record - LSH J !Number of SH records with information - ! FVERS<5: always 5 - MHLNK J !First record number of the next SH group - SDAY I !Local U.T. day number - ! FVERS<5: ST - STIM I !Start U.T. time in units of 10 sec - ! FVERS<5: ST - ! FVERS<3: units of minutes - BANDNR I !Frequentie bandnr. - ! FVERS<6: set nr - - I !Empty (Delete character) (Internal use Dw'loo:SETNR) - BFREQ J !Set frequency (2**(-16) Mhz) - ! FVERS<2: single float (E) - SFREQ I !Spacing in frequency (DLB), bandwidth (DCB) (Mhz) - DATYP C2 !Data type (IF, XX, XY, YX, or YY) - POLC I !Dipole position code - NRINT I !Number of interferometers in the set (40,88 or 160) - PTS J !Total number of observed points in the set - WIDTH E <E12.6> !Bandwidth (Mhz) - ! ols<46: reserved - CORC0 B(0:1) !Correctioncode: - ! Bit 0 = 1 : IF phase correction applied - ! Bit 1 = 1 : IF gain correction applied - ! Zero : IF correction not applied - ! ols<43: reserved - - -(0:109) ! - - NENT I !Number of entries in the index table (40,88 or 160) - LENT I !Entry length in bytes - IFR S:IFR(0:159) !IFR table -.END !END DEFINITION -!- diff --git a/src/nscan/sth.dsc b/src/nscan/sth.dsc deleted file mode 100644 index 86f0d1922606c16d3874f86486dafdac132fd07b..0000000000000000000000000000000000000000 --- a/src/nscan/sth.dsc +++ /dev/null @@ -1,131 +0,0 @@ -!+ STH.DSC -! WNB 900304 -! -! Revisions: -! -%REVISION=JPH=960605="Add DL, DM; RA edits PF i.s.o. AF" -%REVISION=JPH=941013="Split tables in X/Y parts; add many units" -%REVISION=CMV=940420="Add IFP (no NVS necessary)" -%REVISION=CMV=940224="Add STH_DSHFT (no NVS necessary)" -%REVISION=WNB=931215="Add some edit formats" -%REVISION=WNB=931130="Add ACORM" -%REVISION=WNB=931015="Use SSH" -%REVISION=WNB=930820="Add P: edit code" -%REVISION=WNB=930819="Version 4: Add DIPC, new model data format" -%REVISION=WNB=930803="Use NSTAR.DSF" -%REVISION=WNB=920616="Add SHFT, ASHFT" -%REVISION=WNB=920604="Change version/system to 3 for flagging, add FEXP" -%REVISION=JPH=930224="Put comment in correct place" -%REVISION=WNB=920828="Add VELR" -%REVISION=WNB=920515="Add INST" -%REVISION=WNB=910219="Make polarisation corrections correct length" -%REVISION=WNB=900304="Original version SSH" -! -! Define Set Header block -! -%COMMENT="STH.DSC defines the set header block" -%COMMENT=" " -%COMMENT="REDNS, ALGNS, OTHNS must be in this order and adjacent" -%COMMENT=" " -! -%VERSION=4 !VERSION -%SYSTEM=4 -%USER=WNB -%%DATE -%%NAME -! -! Get number of telescopes -! -%INCLUDE=NSTAR_DSF -!- -.PARAMETER - STHTEL J /NSTAR_TEL/ !# OF TELESCOPES - STHIFR J /NSTAR_TEL*(NSTAR_TEL+1)/2/ !MAX. # OF INTERFEROMETERS -.BEGIN=STH -%INCLUDE=SSH_DSF ! STANDARD AREA - BEC I ! BACKEND CONFIGURATION - PTS I ! POINTING SET # - VNR J ! OBS # (=VOLG+CYCLUS*65536) - CHAN I ! BAND NUMBER - PLN I ! # OF POLARISATIONS - FIELD C12 ! FIELDNAME - RA D <DPF12.7,,"deg">! OBS RA (CIRCLES) - DEC D <DAF12.7,,"deg">! OBS DEC - RAE D <DPF12.7,,"deg">! EPOCH RA - DECE D <DAF12.7,,"deg">! EPOCH DEC - HAB E <EAF12.7,,"deg">! FIRST HA APP. - HAI E <EAF12.7,,"deg">! HA INCREMENT - SCN J <,1> ! # OF SCANS - OEP E <E12.2> ! OBS. EPOCH (E.G. 1980.12) - EPO E <E12.1> ! EPOCH (E.G. 2000.0) - - E - FRQ D <D12.6,,"MHz"> ! APP. FREQUENCY - FRQE D <D12.6,,"MHz"> !LSR FREQUENCY - BAND E <E12.6,,"MHz"> !BANDWIDTH (MHZ) - HAV E <EAF12.7,,"deg"> !AVERAGING HA (CIRCLES) - OBS I(0:1) !OBS. DAY/YEAR - RTP E(0:NSTAR_TEL-1) <E12.4,,"m"> ! TEL. POSITIONS - NIFR J <,1> !# OF IFRS - IFRP J <XJ,1,,P:IFRT> !POINTER TO IFR LIST - NFD J <,1> !FD BLOCK - FDP J <XJ,1,,P:FDW> - NOH J <,1> !LENGTH OH - OHP J <XJ,1,,P:OHW> !POINTER TO OH - NSC J <,1> !SC BLOCK - SCP J <XJ,1,,P:SCW> - NSH J <,1> !SH BLOCK - SHP J <XJ,1,,P:SHW> - SCNP J <XJ,1,,P:SCH> !POINTER TO SCAN AREA - SCNL J <,1> !LENGTH OF SCAN - REDNS E(0:1) <E12.4,,"W.U."> ! X REDUNDANCY NOISE (G/P) - REDNSY E(0:1) <E12.4,,"W.U."> ! Y REDUNDANCY NOISE (G/P) - ALGNS E(0:1) <E12.4,,"W.U."> ! X ALIGN NOISE - ALGNSY E(0:1) <E12.4,,"W.U."> ! Y ALIGN NOISE - OTHNS E(0:1) <E12.4,,"W.U."> ! X OTHER NOISE - OTHNSY E(0:1) <E12.4,,"W.U."> ! Y OTHER NOISE - MDL J(0:1) <XJ,1,,P:MDH> !POINTER TO MODEL LISTS - MDD J(0:1) <XJ,1,,P:MDD> !POINTER TO MODEL DATA - PHI E <EAF12.1,,"deg">! PRECESSION ROT. ANGLE - POLC E(0:1,0:NSTAR_TEL-1) <11$E10.4,,"pos/ell: rad"> - ! X POL. CORRECTIONS - POLCY E(0:1,0:NSTAR_TEL-1) <11$E10.4,,"pos/ell: rad"> - ! Y POL. CORRECTIONS - ! (G/P=orient./ellipt., radians) - FRQ0 D <D12.6,,"MHz"> ! REST FREQUENCY FOR LINE - FRQV D <D12.6,,"MHz"> ! REAL FREQUENCY FOR LINE - FRQC D <D12.6,,"MHz"> ! CENTRE FREQUENCY FOR LINE - VEL E <E12.4,,"m/s"> !VELOCITY FOR LINE (M/S) - VELC J !VELOCITY CODE: - ! 0= CONTINUUM - ! 1=HELIOCENTRIC RADIO - ! 2= LSR RADIO - ! 3= HELIOCENTRIC OPTICAL - ! 4= LSR OPTICAL - MJD D <D12.5> !START MJD (DAYS) - UTST D <D12.5> !CONVERSION UT/ST DAY LENGTH - INST J !INSTRUMENT: - ! 0= WSRT - ! 1= ATCA - VELR E <E12.4,,"m/s"> !VELOCITY AT REF. FREQ. (FRQC) - WFAC E <E12.4,,"1-factr"> - ! 1-FACTOR TO ABS. SCH WEIGHTS - SHFT E(0:1) <E12.4,,"arcsec"> ! DE-APPLY L-M SHIFT IN ARCSEC - ASHFT E(0:1) <E12.4,,"arcsec"> ! APPLY SHIFT (NOWHERE SET) - DIPC J <XJ> !DIPOLE CODE: TEL # * 4 * CODE: - ! 0 = 0 DEG (VERT) X DIPOLE - ! 1,2,3 = 45, 90, 135 DEG - ! STANDARD PARALLEL: 2 ......... - ! STANDARD CROSS: 2 .... 1111 - ACORM J !AMPL. CORRECTION METHOD: - ! 0 = STANDARD - ! 1 = CORRELATION COEFF. GIVEN - DSHFT E(0:1) <E12.4,,"arcsec/day"> - ! DE-APPLY SHIFT rate - ! (L,M IN ARCSEC PER DAY) - IFHP J <XJ,1,,P:IFH> !POINTER TO Tot.Power/IF area - IFHL J <,1> !LENGTH OF Tot.Power/IF-DATA - DLDM E(0:1) <EAR12.4,,"deg">! offsets of source in interfer- - ! ometric beam measurements - - -(12) !RESERVED -.END -!- diff --git a/src/nscan/unit.pef b/src/nscan/unit.pef deleted file mode 100644 index ace90d6efeec47ceff55d07513607eb265725db7..0000000000000000000000000000000000000000 --- a/src/nscan/unit.pef +++ /dev/null @@ -1,182 +0,0 @@ -!+UNIT.PEF: tape UNIT parameters -! -! JPH 941005 Split from ncomm.pef -! -! Revisions: -! HjV 941107 Add OUTPUT_VOLUME, VOLUME_TYPE, OVERWRITE -! JPH 941215 Help texts, prompt formatting -! -! -! Get input unit -! Ref: NSCDAT -! -KEYWORD=UNIT - DATA_TYP=C - IO=I - LENGTH=1 - CHECKS=ABBREV_OPTIONS - SWITCHES=LOOP,NULL_VALUES,WILD_CARDS - SEARCH=L,P - OPTIONS=0,1,2,3,4,5,6,7,8,9,D - PROMPT="'tape' unit: number or 'D' for 'disk' |" - HELP=" Specify the input unit for your data: -. - 0,..9 Tape/optical disk/DAT unit - D Disk -. -The correspondence between the unit numbers and the devices on your host -machine is defined by the environment variables MAG<n>. The list below shows -the values with which NEWSTAR is distributed, but your local installation may -be different, so you do well to check with your local site manager -. - classic 0.5-inch magtape: - 0 1600 bpi - 1 6250 bpi - 2 800 bpi -. - optical disk, formatted as a magtape: - 4 - 5 -. - DAT, ExaByte or similar tape: - 6 - 7 - 8 - 9 -. -You may enter '*' to get a list of unit numbers available for you, but this -will not tell you to what physical devices these correspond." -! -! Get input unit -! Ref: NSCDAT -! -KEYWORD=INPUT_UNIT - DATA_TYP=C - IO=I - LENGTH=1 - CHECKS=ABBREV_OPTIONS - SWITCHES=LOOP,NULL_VALUES,WILD_CARDS - SEARCH=L,P - OPTIONS=0,1,2,3,4,5,6,7,8,9,D - PROMPT="input 'tape' unit: number or 'D' for 'disk' |" - HELP=" Specify the input unit for your data: -. - 0,..9 Tape/optical disk/DAT unit - D Disk -. -The correspondence between the unit numbers and the devices on your host -machine is defined by the environment variables MAG<n>. The list below shows -the values with which NEWSTAR is distributed, but your local installation may -be different, so you do wello to check with your local site manager -. - classic 0.5-inch magtape: - 0 1600 bpi - 1 6250 bpi - 2 800 bpi -. - optical disk, formatted as a magtape: - 4 - 5 -. - DAT, ExaByte or similar tape: - 6 - 7 - 8 - 9 -. -You may enter '*' to get a list of unit numbers available for you, but this -will not tell you to what physical devices these correspond." -! -! Get output unit -! Ref: NSCDAT -! -KEYWORD=OUTPUT_UNIT - DATA_TYP=C - IO=I - LENGTH=1 - CHECKS=ABBREV_OPTIONS - SWITCHES=LOOP,NULL_VALUES,WILD_CARDS - SEARCH=L,P - PROMPT="output 'tape' unit: number or 'D' for 'disk' |" - OPTIONS=0,1,2,3,4,5,6,7,8,9,D - HELP=" -Specify the input unit for your data: -. - 0,..9 Tape/optical disk/DAT unit - D Disk -. -The correspondence between the unit numbers and the devices on your host -machine is defined by the environment variables MAG<n>. The list below shows -the values with which NEWSTAR is distributed, but your local installation may -be different, so you do wello to check with your local site manager -. - classic 0.5-inch magtape: - 0 1600 bpi - 1 6250 bpi - 2 800 bpi -. - optical disk, formatted as a magtape: - 4 - 5 -. - DAT, ExaByte or similar tape: - 6 - 7 - 8 - 9 -. -You may enter '*' to get a list of unit numbers available for you, but this -will not tell you to what physical devices these correspond. -" -! -! Get output volume -! Ref: NSCDAT -! -KEYWORD=OUTPUT_VOLUME - DATA_TYP=C - IO=I - LENGTH=6 - SWITCHES=LOOP,NULL_VALUES - SEARCH=L,P - PROMPT="Output volume name" - HELP=" -Specify the full name for the output volume. -. -This name is used for the administration in MEDIAD" -! -! Get output file -! Ref: WNGMED -! -KEYWORD=VOLUME_TYPE - DATA_TYP=C - IO=I - LENGTH=4 - SWITCHES=LOOP,NULL_VALUES - SEARCH=L,P - PROMPT="Abbreviated medium type" - HELP=" -Specify the type for the output volume. -. -This name is used for the administration in MEDIAD -. - DOD - DEC Optical Disk - DAT - Digital Audio Tape - 800 - 9-track tape, 800 bpi - 1600 - 9-track tape, 1600 bpi - 6250 - 9-track tape, 6250 bpi" -! -! Overwrite cuurent label -! Ref: NSCDMP -! -KEYWORD=OVERWRITE - DATA_TYP=L - IO=I - SWITCHES=NULL_VALUES,WILD_CARDS - SEARCH=L,G:NGEN,P - PROMPT="Overwrite (YES/NO)" - DEFAULTS=YES /ASK - HELP=" -Specify if one wants to overwrite the current label (YES) or not (NO). -. -BEWARE: All subsequent labels will also be overwritten. -" diff --git a/src/sys/batch_ask.c b/src/sys/batch_ask.c deleted file mode 100644 index 2f9abdd1ecd174708d4bbb01bc09e2426f384e67..0000000000000000000000000000000000000000 --- a/src/sys/batch_ask.c +++ /dev/null @@ -1,62 +0,0 @@ -/* batch_ask.c */ - -/* Transfer inputs list for Newstar program, prompting for user's input if parameter value is /ASK. - The list consist of lines of the form - - <blanks><parameter name><blanks>=<blanks><parameter value><comments> - -Invocation: - $n_exe/batch_ask.exe <input file> - -Lines are read from $argv[1] and parameter values copied to stdout. When a parameter value /ASK is found, the parameter is prompted for on stderr and a value copied from stdin to stdout. - -History: - JPH 951020 Adapt from include. - JPH 960815 Disable control-C -*/ - -#include <stdio.h> -#include <fcntl.h> -#include <string.h> -#include <errno.h> -#include <signal.h> - -int main (argc, argv) - char** argv; - int argc; -{ - FILE *in, *go; - char l[4096], m[8]; - char *lp, *fp, *sp; - int i; - - signal (SIGINT,SIG_IGN); - in= fopen(argv[1], "r"); - if (errno) { - printf("ERROR Can't open %s\n", argv[1]); return errno; - } - go = fopen(argv[2], "ru"); - if (errno) { - printf("ERROR Can't open %s\n", argv[2]); return errno; - } -/* setbuf (stdout, 0); - setbuf (go, 0); */ - - while (fgets (l, 4096, in)) { /* parameter line */ - for (sp=l; *sp !='='; sp++); /* skip over '=' and */ - for (sp++; *sp ==' '; sp++); /* following blanks */ - if (! strncmp(sp, "/ASK", 4)) { /* value is '/ASK' ? */ - *sp = ''; - *(sp+1) = 0; - fputs (sp, stderr); /* output alert (program has provided - fflush (stderr); the prompt) */ - fgets (sp, 4096, stdin); /* get reply from stdin - }else{ -/* fputs (l, stderr); */ - } - fgets (m, 8, go); /* wait for sync signal */ - fputs (sp, stdout); /* reply to program */ - fflush (stdout); - } - return errno; -} diff --git a/src/sys/batch_log.c b/src/sys/batch_log.c deleted file mode 100644 index 55cc94868a28532889bcfeef5d4c9206b421a0df..0000000000000000000000000000000000000000 --- a/src/sys/batch_log.c +++ /dev/null @@ -1,45 +0,0 @@ -/* batch_log.exe - log prompts and replies from program run - - stdin is piped in from the program - stdout is redirected to the log file - all input is copied to stderr -*/ - -#include <stdio.h> -#include <fcntl.h> -#include <string.h> -#include <errno.h> - -int main() -{ - char *sp, text[512], *n_psctest; - int prompt =0; - - while (fgets (text, 512, stdin)) { /* loop over input lines */ - if (*text ==''){ - prompt= 1; - for (sp=text; *sp && *sp !=' '; sp++); - *sp= 0; - fputs (text+1, stdout); - *sp= ' '; - *text= ' '; - } - if (prompt ){ - for (sp=text; *sp; sp++); /* skip to end of input */ - if (*--sp =='\n' && *--sp =='~'){ /* last chars '~\n' ? */ - *sp= 0; /* truncate before '~\n' */ - prompt= 2; - } } - fputs (text, stderr); - if (prompt ==2){ - fgets (text, 512, stdin); - if (text[0] ==' ' && text[1] =='#' ){ - fputs (text, stderr); /* echo EOF */ - } - fputs (" = ", stdout); - fputs (text, stdout); - prompt= 0; - } } - return errno; -} - diff --git a/src/sys/batch_sync.c b/src/sys/batch_sync.c deleted file mode 100644 index fbe467cca5df16ad5af65caba56fa138042026ac..0000000000000000000000000000000000000000 --- a/src/sys/batch_sync.c +++ /dev/null @@ -1,53 +0,0 @@ -/* batch_sync.c - - Reads output piped to stdin from Newstar program and echoes it on stdout -(pipe to log) and stderr (terminal). - Newstar program affixes '~\n' to prompts. When this line ending is -found, this program sends a 'go' signal to the named-pipe file whoise name is in -environment variable N_PSCTEST. This pipe is read by batch_ask, which responds -by supplying one line of input to the Newstar program for each 'go' in the pipe. - -History: - JPH 9510.. - JPH 960815 Disable control-C - JPH 961018 Comments. Fix discarding of reply echo -*/ - -#include <stdio.h> -#include <fcntl.h> -#include <string.h> -#include <errno.h> -#include <signal.h> - -int main() -{ - char *sp, text[512], *n_psctest; - FILE *go; - int pr; - - signal (SIGINT,SIG_IGN); - n_psctest= getenv ("N_PSCTEST"); /* get name of pipe */ - go= fopen (n_psctest, "wu"); /* open it for unbuffered write */ - if (errno) { - printf("ERROR Can't open pipe '%s': ", n_psctest); perror(""); - return errno; - } - - while (fgets (text, 512, stdin)) { /* loop over input lines */ - pr= 0; - for (sp=text; *sp; sp++); /* skip to end of input */ - if (*--sp =='\n' && *--sp =='~'){ /* last chars '~\n' ? */ - fputs ("go\n", go); /* yes, pipe to batch_ask */ - fflush (go); - *sp= 0; /* truncate before '~\n' */ - pr= 1; /* set 'prompt' flag' */ - } - fputs (text, stdout); /* log output */ - fflush (stdout); - fputs (text, stderr); /* terminal output */ - fflush (stderr); - if (pr) fgets (text, 512, stdin); /* discard reply echo */ - } - return errno; -} - diff --git a/src/sys/bin.grp b/src/sys/bin.grp deleted file mode 100644 index 2cdc1ddaa2158f8bbf55f2bad7b1b0f42b929d21..0000000000000000000000000000000000000000 --- a/src/sys/bin.grp +++ /dev/null @@ -1,77 +0,0 @@ -!+BIN.GRP -! CMV 931201 -! -! Revisions: -! CMV 931201 Split off binaries from sys.grp -! HjV 940223 Add XMOSAIC.XDA -! WNB 940620 Add TAR.XVX, GCOMPRESS.XVX, PERL.XVX,.XCV, .XDW, .XSW -! JPH 940720 Remove PERL.*, GIDS.XAL, GIPLIB.AAL -! CMV 941102 Remove docaid.xvx and bugaid.xvx -! HjV 950828 Add GIPLIB.ADA and GIDS.XDA -! HjV 951221 Add IONOST.XSW -! HjV 960618 Add GIDS.XSO and GIPLIB.ASO -! HjV 970220 Add IONOST.XHP -! AxC 000330 Add ms2scn.xso and ms2scn.xhp -! -! -! This groupfile -! -BIN.GRP -! -! Executables and object libraries distributed with Newstar -! -MS2SCN.XHP -B ! MS 2 SCN conversion -MS2SCN.XSO -B -! -GAWK.XVX -B ! AWK for VMS (140288) -GENAID.XVX -B -! -XMOSAIC.XHP -B ! XMOSAIC Hypertext browser - XMOSAIC.XSW -B - XMOSAIC.XDW -B - XMOSAIC.XDA -B -! -GIDS.XCV -B ! GIDS executable - GIDS.XDA -B - GIDS.XDW -B - GIDS.XHP -B - GIDS.XSW -B - GIDS.XSO -B - GIDS.XLI -B -!! GIDS.XAL -B -! -!! PERL.XCV -B ! PERL executive -!! PERL.XDW -B -!! PERL.XSW -B -!! PERL.XVX -B -! -GCOMPRESS.XVX -B ! COMPRESS for VMS -! -TAR.XVX -B ! TAR for VMS -! -! -GIPLIB.ACV -B ! Gids library - GIPLIB.ADA -B - GIPLIB.ADW -B - GIPLIB.AHP -B - GIPLIB.ASW -B - GIPLIB.ASO -B - GIPLIB.ALI -B -!! GIPLIB.AAL -B -! -IONOST.XSW -B ! Spoelstra's ionosphere program -IONOST.XHP -B -!- - - - - - - - - - - - - - diff --git a/src/sys/bup.csh b/src/sys/bup.csh deleted file mode 100755 index d553b27c93559dfa0fd8f1dfba4bca1fa80ae46c..0000000000000000000000000000000000000000 --- a/src/sys/bup.csh +++ /dev/null @@ -1,34 +0,0 @@ -#! /bin/csh -f -#+ bup.csh -# -# HjV 931228 Created -# -# This is a script to update the Newstar programs in the background -# -# -# Uncomment the following line for testing purposes... -#set echo - echo " Use one of the following options:" - set Oms=("nup b -u all" \ - "nup b -u all -t:dsc" \ - "nup b -u all -t:^dsc/^exe/^pef/^psc/^pin" \ - "nup b -u all -t:exe/pef/psc/pin" \ - "Enter command yourself" ) - @ ii = 1 - while ($ii <= $#Oms) - echo $ii"." $Oms[$ii] - @ ii = $ii + 1 - end - @ Opt = $#Oms - echo -n "Which option (1-[$#Oms]): " - set ans=($<); if ("$ans" != "") set Opt="$ans" - - if ($Opt != $#Oms) then - set Com = "$Oms[$Opt]" - else - set Com="nup b -u all" - echo -n "Enter update command [$Com]: " - set ans=($<); if ("$ans" != "") set Com="$ans" - endif - ( ( $Com ) | & nsmail "$n_site-$n_arch done: $Com" coolen@astron.nl )& - echo "Started command: $Com" diff --git a/src/sys/c2aid.pls b/src/sys/c2aid.pls deleted file mode 100755 index 134f907d7a30734f29aa6f7d5319a457aefd4607..0000000000000000000000000000000000000000 --- a/src/sys/c2aid.pls +++ /dev/null @@ -1,1054 +0,0 @@ -#+ C2AID.PLS -# WNB 940310 -# -# Revisions: -# WNB 940531 Isolate eq, ne -# WNB 940621 Some VMS adjustments -# WNB 940624 Delete some .tmp -# WNB 940627 Update wc for VMS -# WNB 940630 chmod for VMS typo -# -# Import the newstar environment to local Perl variables with same name, -# set a local cwd, and set VMS true if necessary -# &ENV_IMPORT() -# Export name: -# &ENV_EXPORT(name,value) -# Various: -# &fnp(expr) Parse filename, no globbing -# &fn(expr) Parse filename, possible glob. -# &fl(expr) Expand file names -# &fp(type,file) Get file:type -# &ft(type,file) Do -type test on file -# -# &vn(string) $# in variable -# -# &Pipe(file,...) Returns contents of last file -# &doalias(name,key,...) Execute an alias -# &dollar(name,in,out) $name command -# -# &stdop select STDIN, STDOUT -# &stdcl de-select STDIN STDOUT -# &stdmk make STDIN STDOUT -# &stdcmk unmake STDIN STDOUT -# -# &system(string) do system routine -# -# &alias(name,value) alias -# &ar(type,in,out) -# &awk(type,program,in,out) awk creator -# &cat(type,file) cat -# &cd(dir) Change to dir, set PWD and cwd -# &chmod(type,file) chmod -# &cmp(in) cmp files -# &compress(in,out) -# &cp(type,infile,outfile) Copy infile to out -# &date Return as Unix date -# &diff(type,in1,in2,out) diff -# &docom(out,in1,...) do VMS commands -# &docsh(name,in,out) do csh -# &doexe(name,in,out) do program -# &domainname -# &echo(type,text) Text to screen with nl -# &elm(type,in,in) -# &exit -# &find(type,out) -# &ftp(type,in,out) ftp -# &grep(type,pat,in,out) grep -# &ln(type,in) -# &log(text) Text to screen and Log -# &ls(type,in,out) -# &mem(in) -# &more(in,out) more -# &mv(type,infile,outfile) Move infile to out -# &nm(in,out) -# &peq(left,right) =~ -# &eq(left,right) eq (char ==) -# &pr(type,in,out) -# &ranlib(in) -# &rm(type,file) Remove file (type i or f) -# &rsh(host,com,in,out) -# &sed(prog,in,out) -# &set(out) set show option -# &sort(type,in,out) sort -# &source(file) -# &strip(in) -# &stty(type) -# &tail(+/-n,in) tail/head -# &tar(type,in,out) -# &tee(type,file) tee -# &touch(type,file) Create file if non-existant -# &tr(type,pat-in,pat-out,in,out) tr function -# &unalias(name) unalias -# &uncompress(in,out) -# &wc(type,in) wc: type l or c -# &what(type,in,out) -# &whoami Get name -# -# General aids: -# Obtain the newstar environment from Logicals in VMS and set $VMS to indicate -# VMS environment; and obtain cwd in $n_cwd -# &VMS_IMPORT() -# -# -#- - -sub ENV_IMPORT { - - local(@aa); - local(@list)=('ARR','ARD','AS','CC','FC','NSTAR_DIR','RS'); # special codes -# -# Determine if VMS -# - &VMS_IMPORT; -# -# Find all n_ ENVironment -# - @aa=grep(/^n_/i,keys(%ENV)); # get all n_ environment - for (@aa) { eval ("\$$_='$ENV{$_}'");} # import environment variable - $n_arch=~tr/A-Z/a-z/; # make sure lc -# -# Some specials -# - for (@list) { - if ($ENV{$_}) {eval ("\$$_=\$ENV{'$_'}");} - } -# -# Set current directory etc -# - $HOST=$ENV{'HOST'}; $USER=$ENV{'USER'}; - $cwd=$ENV{'PWD'}; -} - -sub ENV_EXPORT { local($name,$val)=@_; -# -# Set ENVironment -# - $ENV{$name}="$val"; # export environment variable - &system("define/nolog/job $name \"$ENV{$name}\"") if $VMS; # make logical -} - -sub fnp { local($name)=@_; - - local(@res); - - if ($VMS) { - for (split(' ',$name)) { s/\?/%/g; - if (/\//) { - s!^/([\w\*\%]+)/?!$1\:!; # unit - s!\]/!\]!g; # isolated ]/ - s!([\w\*\%]+)(\.DIR)?/!\[\.$1\]!g; # make [] from / - s/\.?\]\[\.?/\./g; # remove ][ - while (s/(\.[\w\*\%]+)\.([\w\*\%]+)$/$1_$2/) {} # make .a.b into .a_b - s/\.\]/\]/g; s/\[\./\[/g;} # no .] or [. - push(@res,$_);} - join(' ',@res);} - else { $name;} -} - -sub fn { local($name)=@_; - - local(@res); - - for (split(' ',$name)) { - if (!defined($noglob) && /[\*\?]/) { push(@res,&fl($_));} - else {push(@res,$_) if $_;} - } - join(' ',@res); -} - -sub fl { local($name)=@_; - - local(@aa,*TMP,@l1); - - unlink ("fla$$.tmp") while (-e "fla$$.tmp"); - if ($VMS) { - open(TMP,">flb$$.tmp"); close(TMP); # to suppress message - $name=~s/\?/\%/g; - $name=&fnp($name); - &system("directory/nohead/notrail/version=1/col=1/out=fla$$.tmp ". - "$name,${cwd}flb$$.tmp"); - unlink("flb$$.tmp");} - else { - `echo $name > fla$$.tmp`;} - open (TMP,"fla$$.tmp"); - while (<TMP>) { - chop; @l1=split(' ',$_); - for (@l1) { - if (!/[\%\*\?]/) {if (-e $_) { s/;\d*$//; push(@aa,$_);}} - } - } - close(TMP); unlink "fla$$.tmp" while (-e "fla$$.tmp"); - @aa; -} - -sub fp { local($type,$name)=@_; - - local($i,$j); - - if ($VMS) { - $name=&fnp($name); - $i=rindex($name,']'); $j=rindex($name,':'); $i=($i>=$j)?$i:$j; - if ($type eq 't') { - if ($i == length($name)-1) {$name=~s/\.(\w+)\]$/\]$1/; - $i=rindex($name,']'); $j=rindex($name,':'); $i=($i>=$j)?$i:$j;} - } - elsif ($type eq 'h') {$i++ if $i>=$[; - if ($i == length($name)) {$name=~s/\.(\w+)\]$/\]$1/; - $i=rindex($name,']'); $j=rindex($name,':'); $i=($i>=$j)?$i+1:$j+1;} - } - } - else { $i=rindex($name,'/');} - if ($type eq 't') { ($i>=$[) ? substr($name,$i+1) : $name;} - elsif ($type eq 'h') { ($i>=$[) ? substr($name,$[,$i) : $name;} - elsif ($type eq 'e') { - $j=rindex($name,'.'); ($j>$i) ? substr($name,$j+1) : "";} - elsif ($type eq 'r') { - $j=rindex($name,'.'); ($j>$i) ? substr($name,$[,$j) : $name;} - else {print "Unknown file part type -$type\n"; exit;} -} - -sub ft { local($type,$name)=@_; - - if ($VMS) { - ($name=&fnp($name))=~s/\.\]$/\]/; - $name=~s/([\[\.])(\w+)\]$/$1$2\.\-\]$2\.DIR/;} - $type='NO' unless $name; - if ($type eq 'd') { - if ($VMS && $name!~/\.DIR$/) { $name.='.DIR';} - -d $name;} - elsif ($type eq 'e') {-e $name;} - elsif ($type eq 'o') { - if ($VMS) {-w $name;} else {-o $name;} - } - elsif ($type eq 'z') {-z $name;} - elsif ($type eq 'x') {-x $name;} - elsif ($type eq 'M') {-M $name;} - elsif ($type eq 'NO') {0;} - else {print "Unknown file test type -$type\n"; exit;} -} - -sub vn { local($str)=@_; - - scalar(split(' ',$str));} - -sub Pipe { local(@file)=@_; - - local(*TMP,$t,$f); - - $f=$file[0]; - if ($f && open(TMP,$f)) { - while (<TMP>) {chop; - if ($_) { - if ($t) { $t=join(' ',$t,$_);} - else { $t=$_;} - } - } - close (TMP); unlink ($f) while -e $f;} - "$t"; -} - -sub doalias { local($name,@D_aterm)=@_; - - local(@D_term); - - unless ($C2_alias{$name}) { - print "Fatal: unknown command(alias) $name\n"; exit;} - eval($C2_alias{$name}); -} - -sub doalias_x { local(@val)=@_; - - for (@val) { - if (/^\!\*$/) { push(@D_term,@D_aterm);} - elsif (/\!\:(\d+)/) { push(@D_term,$`.$D_aterm[$1-1].$');} - else { push(@D_term,$_);} - } -} - -sub D_input { local($n)=@_; - - local(@res,$t); - - if ($n eq 'out') { - if ( @D_term && $D_term[0]=~/^>(.*)$/) { shift(@D_term); - push(@res,$1.shift(@D_term));} - } - elsif ($n eq 'in') { - while( @D_term && $D_term[0]!~/^>/) { - if ($D_term[0] eq '<<') { shift(@D_term); shift(@D_term); - push(@res,$t,"'"."&C2_t${C2_tcnt}_".&fp('r',&fp('t',$C2_in))."'");} - elsif ($D_term[0] eq '<') { shift(@D_term); - push(@res,$t,"'".shift(@D_term)."'");} - else { push(@res,$t,"'".shift(@D_term)."'");} - $t=".' '.";} - } - elsif ($n eq 'int') { - if( @D_term && $D_term[0]!~/^[<>]/) { - push(@res,"'".shift(@D_term)."'");} - } - elsif ($n eq 'inw') { - while( @D_term && $D_term[0]!~/^[<>]/) { - push(@res,$t,"'".shift(@D_term)."'"); $t=".' '.";} - } - elsif ($n eq 'inf') { - while( @D_term && $D_term[0]!~/^[<>]/) { - push(@res,$t,"'".shift(@D_term)."'"); $t=".' '.";} - } - elsif ($n eq 'sw') { - while (@D_term && $D_term[0]=~/^[\-\+][^\-]/) { - push(@res,$t,"'".shift(@D_term)."'"); $t=".' '.";} - } - if ($#res>0) {eval("@res");} - elsif (@res) {"@res";} - else {@res="''";} -} - -sub dollar { local($name,$in,$out)=@_; - - local(@in); - - unless (eval("defined \$$name")) { - print "Fatal: Unknown command variable \$$name\n"; exit;} - $name=eval("\$$name"); - unless ($VMS) { - if ($out) {$out=">$out";} - if ($name eq 'rsh' || $name eq 'remsh') { local(@in)=split(' ',$in); - local($f)=shift(@in); - $status=system("$name $f '@in' $out")/256;} - else { - $status=&system("$name $in $out");} - } - elsif ( $name=~/fortran/i) { - @in=split(' ',$in); $in=''; - for ($i=0; $i<=$#in; $i++) { - if ($in[$i]=~/\-o/) { $out=('/OBJECT='.&fnp($in[$i+1])); $i++;} - elsif ($in[$i]=~/^\//) { $out.=$in[$i];} - else { $in.=(' '.&fnp($in[$i])); - $out.=('/LIST='.&fp('t',&fp('r',$in[$i])).'.l');} - } - if (-e 'N_SRC:[SYS]N_LINKS.COM') { - $status=&docom('','@N_SRC:[SYS]N_LINKS.COM',"$name$out $in");} - else { $status=&system("$name$out $in");} - } - elsif ( $name=~/^ar/i) { - $status=&ar((split(' ',$name))[1],$in,$out);} -} - -sub stdop { - - if ($in) { open(S_IN,&fnp($in)); $S_in='S_IN';} - else { $S_in='STDIN';} - if ($out) { $out=~s/^([>]?[\&]?)([\!]?)/>\1/; $S_type="$1$2"; - open(S_OUT,&fnp($out)); $S_old=select(S_OUT);} - else { $S_type='';} -} - -sub stdcl { - - if ($in) { close(S_IN);} - if ($out) { close(S_OUT); select($S_old); $out=$S_type.$out;} -} - -sub stdmk { local($l1)=@_; - - $STDMK_OUT=''; $STDMK_TMP=''; - if ($in) { $in='<'.&fnp($in);} - if ($out) { $out=&fnp($out); - if ($VMS && $l1 != 1) { - if ($out=~s/>//) { $STDMK_OUT=$out; - $out=$STDMK_TMP="st$$.tmp";} - $out='/OUT='.$out;} - else { $out='>'.$out;} - } -} - -sub stdcmk { local(*TMPI,*TMPO); - - if ($VMS && $STDMK_OUT) { - open (TMPI,$STDMK_TMP); open (TMPO,">>$STDMK_OUT"); - while (<TMPI>) { print TMPO $_;} - close(TMPI); close(TMPO);} -} - -sub system { local($str)=@_; - - unless ($VMS) { system("(cd $cwd; $str )")/256;} - else { system("$str");} -} - -sub alias { local($name,$val,$out)=@_; - - local($in); - - unless ($val) { &stdop; - if ($C2_alias{$name}) { print $C2_alias{$name}."\n";} - else { print "\n";} - &stdcl;} - else { $C2_alias{$name}=$val;} -} - -sub ar { local($type,$f,$out)=@_; - - local($in,@in,$lib,$t,$t1); - - &stdmk; - unless ($VMS) { $status=&system("ar $f $out");} - else { @in=split(' ',&fnp($f)); $lib=shift(@in); - if ($type=~/v/) { $t.='/LOG';} - if (&fp('e',$lib)=~/tlb/i) {$t1='/TEXT';} - if ($type=~/r/) { - unless (-e $lib) { &system("LIB/CREATE$t1 $lib");} - $t="LIB/REPLACE$t$t1 $lib ".join(',',@in);} - elsif ($type=~/d/) { - for ($i=0; $i<=$#in; $i++) { $in[$i]=&fp('t',&fp('r',$in[$i]));} - $t="LIB$t1$t/DELETE=(".join(',',@in).") $lib";} - else { - $t="LIB/LIST/FULL$t1 $lib";} - if ($out) { $status=&docom($out,$t);} - else { $status=&system($t);} - } -} - -sub awk { local($type,$prog,$in,$out)=@_; - - local($l1,*TMP); - - if (&ft('e',$in)) { - &stdmk(1); - if ($VMS) { - if ($type=~/F(.)/) { $l1="\"-F$1\"";} - if (length($prog)>100) { open(TMP,">g$$.tmp"); - print TMP $prog."\n"; close(TMP); - $status=&system("gawk $l1 -f g$$.tmp -- $in $out"); - unlink ("g$$.tmp") while (-e "g$$.tmp");} - else { $prog=~s/"/""/g; - $status=&system("gawk $l1 -- \"$prog\" $in $out");} - } - else { $status=&system("awk $type '$prog' $in $out");} - } - else { &echo('','',$out);} -} - -sub cat { local($type,$in,$out)=@_; - - &stdop; - while(<$S_in>) {print $_;} - &stdcl;} - -sub cd { ($cwd)=@_; - - $cwd=&fnp($cwd);chdir($cwd);$ENV{'PWD'}=$cwd;$PWD=$cwd;} - -sub chdir { &cd(@_);} - -sub chmod { local($type,$file)=@_; - - local(*l1,$l2,$l3); - - $file=&fnp($file); - if ($type=~/^[0-7]/) {$l1="0$type";} - else { - if ($type=~/([\+\-\=])/) {$l3="\\$1";} - @l1=split(/$l3/,$type); - $l1=0;$l2=0; - if ($l1[0]=~/u/) {$l1=$l1|0100;} - if ($l1[0]=~/g/) {$l1=$l1|010;} - if ($l1[0]=~/o/) {$l1=$l1|01;} - if ($l1[0]=~/a/) {$l1=$l1|0111;} - if ($l1[1]=~/r/) {$l2=$l2|04;} - if ($l1[1]=~/w/) {$l2=$l2|02;} - if ($l1[1]=~/x/) {$l2=$l2|01;} - $l1=$l1*$l2; - unless ($l3 eq '=') { - $l2=(stat($file))[2]; - if ($l3 eq '-') {$l1=$l2&(32767-$l1);} - else {$l1=$l2|$l1;} - } - } - chmod($l1,$file); -} - -sub cmp { local($f,$out)=@_; - - local($in); - local(*TMP,*TMPI,$l1,$t,$c); - local($in1,$in2)=split(' ',$f); - - open(TMP,$in1); open(TMPI,$in2); - &stdop; - while (<TMP>) {$l1=$_; $c++; - if (<TMPI>) { if ($_ ne $l1) {$t=1;$c++;last;}} - } - if (<TMPI>) {$t=1;} - close (TMP); close(TMPI); - if ($t) { print "$in1 $in2 differ: line $c";} - &stdcl;} - -sub compress { local($f,$out)=@_; - - local($in); - - &stdmk; - unless ($VMS) { $status=&system("compress $in $out");} -} - -sub cp { local($type,$file)=@_; - - local(@in,$out); - - @in=split(' ',$file); $out=&fnp(pop(@in)); - if ($VMS && $out=~/\w+$/ && $out!~/\.\w+$/) { - &ln('-s',"$out. $out"); $out.='.';} - for (@in) { $_=&fnp($_); - if ($_ && $_ ne $out) { - unless ($VMS) { $status=&system("cp $type $_ $out");} - else { $status=&system ("copy $_ $out");} - } - } -} - -sub date { local($out)=@_; - - local(@t)=localtime; - local($in,$t); - - &stdop; - $t=sprintf("%3s %3s %02d %02d:%02d:%02d LST %4d ", - (Sun,Mon,Tue,Wed,Thu,Fri,Sat)[$t[6]], - (Jan,Feb,Mar,Apr,May,Jun,Jul,Aug,Sep,Oct,Nov,Dec)[$t[4]], - $t[3], - @t[2,1,0], - $t[5]+1900); - if ($out) { print "$t\n";} - &stdcl; "$t";} - -sub diff { local($type,$f,$out)=@_; - - local($in1,$in2)=split(' ',$f); - local($in,$l1); - - if ($type=~/b/) { - if ($VMS) {$l1='/IGNORE=(TRAIL,SPACE)';} - else {$l1='-b';} - } - &stdmk; - if ($VMS) { $in1=&fnp($in1); $in2=&fnp($in2); - $status=&system("differ$l1$out $in1 $in2"); &stdcmk;} - else { $status=&system("diff $l1 $in1 $in2 $out");} -} - -sub docom { local($out,$in1,$in2,$in3)=@_; - - local(*TMP); - - open (TMP,">com$$.tmp"); - print TMP "\$ set default $cwd\n"; - if ($in1) { print TMP "\$ $in1\n";} - if ($in2) { print TMP "\$ $in2\n";} - if ($in3) { print TMP "\$ $in3\n";} - print TMP "\$ PURGE *$$.TMP*"; - close(TMP); - $status=&system("\@com$$.tmp$out"); - unlink ("com$$.tmp") while (-e "com$$.tmp");} - -sub docsh { local($name,$f,$out)=@_; - - local($l2)=&fp('r',$name); - local($in,@f); - - $name=&fnp($name); - unless (&ft('e',$l2.'.pls') && &ft('M',$l2.'.pls') < - &ft('M',"$n_src/sys/csh2p.pls") && - &ft('e',$name) && - &ft('M',$l2.'.pls') < &ft('M',$name)) { - if (&ft('e',$name)) { $status=&system("perl ". - &fnp("$n_src/sys/csh2p.pls").' -sub '.$name);} - unless (&ft('e',$l2.'.pls') && &ft('M',$l2.'.pls') < - &ft('M',"$n_src/sys/csh2p.pls") && - &ft('e',$name) && - &ft('M',$l2.'.pls') < &ft('M',$name)) { - print "Fatal: Cannot find/compile $name"; exit;} - } - &stdmk; - if ($VMS) { - for (split(' ',$f)) { - if (/^[\-\+]/) { push(@f,$_);} - else { push(@f,&fnp($_));} - } - $f=join(' ',@f); $name=&fnp($name); - $status=&docom($out,"perl $name $f"); &stdcmk;} - else { $status=&system("perl $name $f $out");} -} - -sub doexe { local($name,$f,$out)=@_; - - local($in,@f); - - &stdmk; - if ($VMS) { - for (split(' ',$f)) { - if (/^[\-\+]/ || $_ eq '/list') { push(@f,$_);} - else { push(@f,&fnp($_));} - } - $f=join(' ',@f); - if (-e 'N_SRC:[SYS]N_LINKS.COM') { - $status=&docom($out,'@N_SRC:[SYS]N_LINKS.COM', - 'tmp_exe=="$'.&fnp($name).' "',"tmp_exe $f");} - else { - $status=&docom($out,'tmp_exe=="$'.&fnp($name).' "',"tmp_exe $f");} - $status=1; ## for now - &stdcmk;} - else { - $f=~s/\^/\\\^/g; - $status=&system("$name $f $out");} -} - -sub domainname { local($out)=@_; - - local($in,*TMP); - - unless ($VMS) { &stdmk; $status=&system("domainname $out");} - else { open(TMP,">".&fnp($out)); - print TMP "$ENV{'DOMAINNAME'}\n"; close (TMP);} -} - -sub echo { local ($type,$txt,$out)=@_; - - local($in); - - $txt="$txt\n" unless $type eq '-n'; - &stdop; print "$txt"; &stdcl;} - -sub elm { local($type,$sub,$in)=@_; - - local(@in)=split(' ',$sub); - - unless ($in) { $in=pop(@in); $sub=join(' ',@in);} - $in=~s/^([^<])/<\1/; - unless ($VMS) { $status=&system("mail $type $sub $in");} -} - -sub exit { local($code)=@_; - - "$code"; ##die "Ending $0 with code '$code'" unless $C2_depth; -} - -sub find { local($type,$out)=@_; - - local($in); - - &stdmk; - unless ($VMS) { $status=&system("find $type $out");} -} - -sub ftp { local($type,$f,$out)=@_; - - local(@in,$in,*TMP,$l1); - - @in=split(' ',$f); - unless ($VMS) { - &stdmk; if ($in[1]) {$in[1]=~s/^([^<])/<\1/;} - $status=&system("ftp $type $in[0] $in[1] $out");} - else { $in[1]=&fnp($in[1]); - if ($type=~/\-v/) {$l1.='/VERBOSE';} - open (TMP,">>$in[1]"); print TMP "quit\n"; close(TMP); - $status=&system("ftp/passw=xyx/user=xyz$l1/take_file=$in[1] $in[0]");} -} - -sub grep { local($type,$pi,$in,$out)=@_; - - $type=~s/\-//g; - &stdop; - while (<$S_in>) { - if ((grep(/$pi/,$_) && $type!~/v/) || - (!grep(/$pi/,$_) && $type=~/v/)) { print $_;} - } - &stdcl;} - -sub head { local($type,$in,$out)=@_; - - local($t); - - $type=~s/(\d)[a-z]$/\1/; $type=-10 unless $type<0; - &stdop; - while (<$S_in>) { $t++; - if ($t <= -$type) { print;} - } - &stdcl;} - -sub ln { local($type,$in)=@_; - - local(@in)=split(' ',$in); - local(*TMP,*TMPI); - - unless ($VMS) { - if ($type=~/\-s/) { symlink($in[0],$in[1]);} - else { link($in[0],$in[1]);} - } - else { - unless ($in[0]=~/[\[:\]]/) { $in[0]=$cwd.$in[0];} - $in[1]=&fp('t',$in[1]); - if (! -e 'N_SRC:[SYS]N_LINKS.COM') { # Create link list - open(TMP,'>N_SRC:[SYS]N_LINKS.COM'); - print TMP '$ !01 N_LINKS.COM created on '."$HOST at $C_Date\n"; - close(TMP);} - if (open(TMP,">l$$.tmp") && open(TMPI,'N_SRC:[SYS]N_LINKS.COM')) { - while(<TMPI>) { - unless (/$in[1]/i) { print TMP $_;} # Copy - } - print TMP '$ ASSIGN/NOLOG "'.$in[0].'" '.$in[1]." ! $C_Date\n"; - close(TMP); close(TMPI); - &system("SORT l$$.tmp N_SRC:[SYS]N_LINKS.COM"); - unlink ("l$$.tmp") while (-e "l$$.tmp"); - &system("PURGE N_SRC:[SYS]N_LINKS.COM"); - } - } -} - -sub log { local($txt)=@_; - - local(*TMP); - - print "$txt\n"; - if ($Logfile) { - open (TMP,&fnp(">>$Logfile")); - print TMP "$txt\n"; close(TMP);} -} - -sub ls { local($type,$f,$out)=@_; - - local($in); - - &stdmk; - unless ($VMS) { $status=&system("ls $type $f $out");} -} - -sub mem { local($in)=@_; - - unless ($VMS) { $status=&system("emacs $in");} -} - -sub mkdir { local($in)=@_; - - mkdir(&fnp($in),0755);} - -sub more { local($type,$f,$out)=@_; - - local($l1)=(''); - local($in); - - &stdmk; - if ($VMS) { - if ($out) { $l1=$out;} - else {$l1="/PAGE";} - $status=&system("type$l1 $f"); &stdcmk;} - else { $status=&system("more $f $out");} -} - -sub mv { local($type,$infile,$outfile)=@_; - - local(@in); - - @in=split(' ',$infile); - unless ($outfile) { $outfile=pop(@in);} - for (@in) { - if ($_) { - if ($_ ne $outfile) { - if ($VMS) { $_=&fnp($_); $outfile=&fnp($outfile); - $status=&system ("copy $_ $outfile"); - unlink($_) while -e $_;} - else { $status=&system ("mv $_ $outfile");} - } - } - } -} - -sub nm { local($f,$out)=@_; - - local($in); - - &stdmk; - unless ($VMS) { $status=&system("nm $f $out");} -} - -sub peq { local($left,$right)=@_; - - if ($VMS) { - unless ($right=~/^\[/ || $right=~/[^:]\[/) { - ($right=&fnp($right))=~s/\%/\?/g;; - $right=~s/([\[\]])/\\$1/g;} - $right=~s/\.DIR//; - $left=&fnp($left);} - $right=~s/([\/\+\@\$\.])/\\$1/g; $right=~s/\*/\.\*/g; - $right=~s/\?/\./g; - if ($VMS) { $left=~/^$right$/i;} - else { $left=~/^$right$/;} -} - -sub eq { local($left,$right)=@_; - - if ($VMS) { ($right=&fnp($right))=~tr/A-Z/a-z/; - ($left=&fnp($left))=~tr/A-Z/a-z/;} - $left eq $right;} - -sub pr { local($type,$f,$out)=@_; - - local($in); - - &stdmk; - unless($VMS) { $status=&system("pr $type $f $out");} - else { $status=&system("TYPE$out ".&fnp((split(' ',$f))[1]));} -} - -sub ranlib { local($in)=@_; - - unless ($VMS) { $status=&system("ranlib $in");} -} - -sub remsh { local($host,$com,$in,$out)=@_; - - &stdmk; - unless ($VMS) { $status=system("remsh $host '$com' $in $out")/256;} -} - -sub rm { local($type,$file)=@_; - - for (split(' ',$file)) { - if($_) { $_=&fnp($_) if $VMS; - if ($type eq '-i') { - print ("\`$_\'? "); - if (<STDIN> =~ /^y/i) {unlink($_) while -e $_;} - } - else {unlink($_) while -e $_;} - } - } -} - -sub rsh { local($host,$com,$in,$out)=@_; - - &stdmk; - unless ($VMS) { $status=system("rsh $host '$com' $in $out")/256;} -} - -sub sed { local($sw,$prog,$in,$out)=@_; - - local($l1); - - &stdop; - while (<$S_in>) {chop; $l1=$_; - eval("\$l1=~$prog"); print "$l1\n";} - &stdcl;} - -sub set { local($val,$out)=@_; - - local($in,$i); - - if ($val) { local(@t)=split(' ',$val); - if ($t[0]=~s/\=$//) { splice(@t,0,1,$t[0],'=');} - if ($t[2] eq '(') { eval("\$$t[0]=''"); - for ($i=3; $i<$#t; $i++) { - eval("\$$t[0]=join(' ',\$$t[0],\"$t[$i]\")");} - eval("\$$t[0]=join(' ',split(' ',\$$t[0]))");} - else { - for ($i=0; $i<$#t; $i+=3) { - eval("\$$t[$i]=\"$t[$i+2]\"");} - } - } - else { &stdop; - for $i (keys(%_main)) { - if ($i=~/^\w+$/) { - eval("if (defined(\$$i)) {print \"$i\t\$$i\n\";}");} - } - &stdcl;} -} - -sub sort { local($type,$f,$out)=@_; - - local($l1,@in); - - if ($type=~/\-o/){ - @in=split(' ',$f); $out=shift(@in); $f=$in[0];} - if ($VMS) { - if ($type=~/-u/) {$l1='/NODUP';} - $f=&fnp($f); $out=&fnp($out); - $status=&system("sort$l1 $f $out");} - else { - if ($type=~/-u/) {$l1='-u';} - $status=&system("sort $l1 -o $out $f");} -} - -sub source { local($l1)=@_; - - local($l2)=&fp('r',$l1); - local($l3)=&fp('t',$l2); - - $l1=&fnp($l1); - unless (&ft('e',$l2.'.pls') && &ft('M',$l2.'.pls') < - &ft('M',"$n_src/sys/csh2p.pls") && - &ft('e',$l1) && - &ft('M',$l2.'.pls') < &ft('M',$l1)) { - if (&ft('e',$l1)) { $status=&system("perl ". - &fnp("$n_src/sys/csh2p.pls").' -sub '.$l1);} - unless (&ft('e',$l2.'.pls') && &ft('M',$l2.'.pls') < - &ft('M',"$n_src/sys/csh2p.pls") && - &ft('e',$l1) && - &ft('M',$l2.'.pls') < &ft('M',$l1)) { - print "Fatal: Cannot find/compile $l1"; exit;} - } - if (eval("defined &${l3}__pls") && $C2_INC{$l3} eq $l1) { - eval("&${l3}__pls");} - else { unshift(@INC,&fp('h',$l1)); - if ($VMS) { &system("COPY $l2.pls $PWD_IN");} - if (eval("defined &${l3}__pls")) { do "$l3.pls";} - else {require "$l3.pls";} - shift(@INC); - unless (eval("defined &${l3}__pls")) { - print "Fatal: Cannot load $l3.pls\n"; exit;} - $C2_INC{$l3}=$l1;} -} - -sub strip { local($in)=@_; - - unless ($VMS) { $status=&system("strip $in");} -} - -sub stty { local($type)=@_; - - unless ($VMS) { $status=&system("stty $type");} -} - -sub tail { local($type,$in,$out)=@_; - - local(@t,$t); - - $type=~s/(\d)[a-z]$/\1/; $type=-10 unless $type; - &stdop; - while (<$S_in>) { $t++; - if ($type>=0) { - unless ($t < $type) { print;} - } - else { - if ($#t+1 >= -$type) { shift(@t);} - push(@t,$_);} - } - unless ($type>=0) { print @t;} - &stdcl;} - -sub tar { local($type,$f,$out)=@_; - - local($in); &stdmk; - - unless ($VMS) { $status=&system("tar $f $out");} -} - -sub tee { local($type,$out,$in)=@_; - - local(@t); - - $out='>'.$out if $out; &stdop; - while (<$S_in>) { print STDOUT $_; print $_;} - &stdcl;} - -sub touch { local($type,$file)=@_; - - local(*TMP); - - for (split(' ',$file)) { - if ($_) { $_=&fnp($_) if $VMS; - unless (-e $_) { - unless ($VMS && /\.ppd$/) { open(TMP,">$_"); close(TMP);} - } - else { open(TMP,">>$_"); close(TMP);} - } - } -} - -sub tr { local($type,$pi,$po,$in,$out)=@_; - - $type=~s/\-//g; &stdop; - if ($VMS && $pi=~s/\\\-//) { $pi.='-';} - while (<$S_in>) { - eval("tr/$pi/$po/$type"); - print $_;} - &stdcl;} - -sub unalias { local($name)=@_; - - delete $C2_alias{$name};} - -sub uncompress { local($f,$out)=@_; - - local($in); &stdmk; - - unless ($VMS) { $status=&system("uncompress $f $out");} -} - -sub wc { local($type,$in,$out)=@_; - - local($t); - - &stdop; - while (<$S_in>) { - if ($type eq '-c') {$t+=length($_);} - else {$t++;} - } - print "$t\n"; - &stdcl;} - -sub what { local($type,$f,$out)=@_; - - local($in); &stdmk; - - unless ($VMS) { $status=&system("what $type $f $out");} -} - -sub whoami { local($out)=@_; local($in); - - local($t)=("$ENV{'USER'}\n"); - - &stdop; print "$t"; &stdcl;} - -sub VMS_IMPORT { - - local(*ATMP,@aa); -# -# Check if VMS and read all logicals into %ENV -# - if (! $VMS) { - if ("$ENV{'SHELL'}") { # VMS version has no SHELL - $VMS=0;} # assume no VMS - else { $VMS=1; - open(ATMP,">a$$.tmp"); # get command file - print ATMP "\$ define/nolog/job n_cwd 'f\$env(\"default\")'\n"; - print ATMP "\$ define/nolog/job n_host 'f\$getsyi(\"nodename\")'\n"; - close(ATMP); - $status=&system("\@a$$.tmp"); - $status=&system("show log/proc/job/out=a$$.tmp ". - "n_*,ARR,ARD,NSTAR_DIR,CC,FC,AS,RSH,". - "DOMAINNAME"); # read n_ log. in tmp file - open (ATMP,"a$$.tmp"); # convert lines to %ENV - while (<ATMP>) { - chop; - @aa=split(/=/,$_); - if ($aa[1]) { - grep(s/^\s*\"//,@aa); grep(s/\"\s*$//,@aa); - if ($aa[0]=~/^n_/i) {$aa[0] =~ tr/A-Z/a-z/;} - else {$aa[0] =~ tr/a-z/A-Z/;} - $ENV{$aa[0]}="$aa[1]"; - } - } - close(ATMP); - while (unlink("a$$.tmp")){} # unlink all versions - $ENV{'PWD'}=$ENV{'n_cwd'}; # set PWD - $PWD_IN=$ENV{'PWD'}; # initial PWD - $ENV{'HOST'}=$ENV{'n_host'}; # set HOST - $ENV{'HOST'}=~tr/A-Z/a-z/; # make sure lc - delete $ENV{'n_cwd'}; delete $ENV{'n_host'}; - } - } -} - -# -# Indicate correct compilation -# -1; diff --git a/src/sys/compile.csh b/src/sys/compile.csh deleted file mode 100755 index aeec3c699076a7cc027fd2904dfe2af027a990ca..0000000000000000000000000000000000000000 --- a/src/sys/compile.csh +++ /dev/null @@ -1,1380 +0,0 @@ -#!/bin/csh -##set echo -#+ -# -# compile.csh -# CMV 930525 Created -# CMV 931104 Added update of hypertext for psc/pef/pin -# CMV 931104 Added Dec WS patch -# CMV 931116 .x?? and .a?? may now be compressed (not for .?vx) -# CMV 931123 Make n_ulib current dir when searching for local objects -# CMV 931201 Use different name for temporary main routine and delete -# CMV 931223 Different handling of libraries -# CMV 940221 Include version numbers in executables -# CMV 940228 Work around module multiply.o in test for multiply defined -# HjV 940314 Use environment ARR (=ar crv or ar crlv) -# CMV 940323 Better tests for moving files in $n_exe -# HjV 940516 Typo -# WNB 940531 Make vx dependencies -# WNB 940624 Bypass .cun, .fun on VAX -# CMV 940705 Add types .pls, .tbl, .cap, .fig (all ignore) -# CMV 940705 Copy .exe/.ppd to various NFRA machines -# CMV 940719 Handle new documentation stuff (depending on n_doc/n_hlp) -# HjV 940803 Make sure we have rsh -# CMV 940804 Correct copy command for NFRA HP's -# CMV 940805 Add "getarg" for VAX -# CMV 940812 Change docaid to genaid -# HjV 940902 Move 'old' .exe/.ppd to .old on various NFRA machines -# HjV 941020 Better test for .exe/.ppd update on various NFRA machines -# CMV 941102 Bitmaps have extension .bbm in source tree -# HjV 941122 Fix problem with Ptolemeus (RUG) -# CMV 950116 Option not to keep old executables and ppd-files -# JPH 950124 Remove comment-only lines in .pin file before compiling -# (bldppd does not eliminate them from HELP texts) -# HjV 950130 Also copy .exe files (build from .c files) to other NFRA HP's -# HjV 950424 Add rzmws4 -# HjV 960423 Bitmaps have now extension .xbm in source tree -# HjV 960618 Add some stuff for Solaris; rzmws6 removed, add daw16 -# JPH 960726 Add possibility of selecting $n_lib/.o files through an -# object list -# HjV 970424 Remove rzmws4 -# HjV 970728 Remove rzmws7 -# HjV 970728 Remove rzmws5 -# JPH 981113 Bug fix in setting of L_Obj -# AXC 040127 Removes IGETARG iso GETARG exception for HP -# WNB 070831 Replace termcap ncurses -# WNB 090303 Change 'tail +<num>' into 'tail -n +<num>' -# -# compile.csh Process all files specified in Input_file -# -# compile will be called by both update and shadow and assumes -# that initcompile.csh has been sourced by one of these. -# -# compile will use at least some of the following: -# -# General setup and things defined in initcompile.csh: -# -# n_root n_src ... The Newstar directory structure -# FC FFLAGS ... The variables defined in $n_arch.def -# C_Date, C_Time Current date and time -# -# Parameters and aliases passed by update or shadow: -# -# Input_file List of fully defined files to be compiled -# _Objectlib Name of object library for storage -# _Textlib Name of text library for storage -# _.... Various options set in switches.csh -# -# log "String" Alias to write string to screen and/or log-file -# -# -# The files in Input_file should not contain any wildcards. -# -# Objectlib is required for work in the Master system and optional -# in a shadow system. Object modules will be made in $n_work. For the -# master system, they will at some stage be moved into the library. -# For the shadow system, they are moved into $n_ulib -# -# Text_lib is optional. If it is defined, source modules will be moved -# into a text library. -# -# -# For a list of valid options, refer to switches.csh. -# -# The following variables are modified by compile (using set): -# -# Errors Total number of errors -# -# All error-files, listings, object-files etc are made in $n_work -# -# Object_file An object module produced by some compiler -# Common treatment includes checks for errors, -# inclusion in object libraries etc. -# List_file Some listing output, may be printed (-Print) -# or deleted (-NList). -# Error_file Any error output, may be shown (-Errors) -# -# To move to an archive, just call with Input_file set to the archivename. -# -# -#- -# - -unset Abort_flag -onintr Abort_exit - -# -# Check some rather important settings -# -if (! $?n_root || ! $?Input_file || ! $?FC || ! $?_Debug ) then - echo " " - echo "$0 invoked in an illegitimate way, use either shadow or update" - echo " " - exit -endif - -if (! $?RSH ) then # Make sure we have rsh - setenv RSH \rsh - if ($n_arch == hp) setenv RSH \remsh -endif - -set Local_HP="" # Local HP's - -set Home=$cwd; -if (! $?Errors) @ Errors = 0 - -# -# Process all files in Input_file -# -while ( "$Input_file" != "") - - set File=$Input_file[1] - set Input_file[1]="" - set Type=ignore - log " " - -# -# If not selected, easy job -# - if (! $_Select) then - log "---- File $File not selected..." -# -# We want to handle only files of type name.ext -# - else if ( $File:t !~ *.* ) then - log "----- Warning: Invalid filename, ignored $File" -# -# Exe files are a bit special in that they do not yet exist -# - else if ($File:e == exe) then - set Type=exe -# -# Object libraries and text libraries are also a bit special -# - else if ($File:e == olb || $File:e == tlb) then - set Flag=$n_work/${File:t}.list - if (-e $Flag && ! -z $Flag) then - log "Updating archive $File..." - if (! $?ARR) setenv ARR "ar crv" -# -# Make sure we pass at most 500 characters to the archive command -# - set c_nline = `cat $Flag | wc -l` # Count lines - @ c_iline = 0 - set Object_file="" - while ($c_iline < $c_nline) # Lines left? - @ c_iline = $c_iline + 1 - set Object_file=($Object_file `tail -n +$c_iline $Flag | head -1`) - if (`echo $Object_file | wc -c ` > 500) then - log `$ARR $File $Object_file` - 'rm' -f $Object_file - set Object_file="" - endif - end - if ("$Object_file" != "") then - log `$ARR $File $Object_file` - 'rm' -f $Object_file - set Object_file="" - endif - - 'rm' -f $Flag - ranlib $File - endif -# -# Error if file does not exist -# - else if (! -e $File) then - log "***** Error: $File does not exist..." - @ Errors = $Errors + 1 -# -# Skip softlinks unless -Softlink set -# - else if (! $_Softlink && "`ls -F $File `" =~ *@ ) then - log "Ignoring softlink $File" - else -# -# Give the file a full path specification -# - set noglob - if ($File:h != $File) cd $File:h - set File=$cwd/$File:t - cd $Home - unset noglob - set Type=$File:e - endif - - if ($Type != ignore) then - set Tail=$File:t # Name+Extension without directory - set Name=$Tail:r # Name only - - set Object_file = $n_work/$Name.o - set List_file = $n_work/$Name.lis - set Error_file = $n_work/$Name.err - -# if (-e $Object_file) 'rm' -f $Object_file # Uncomment when .fvx etc gone? - if (-e $List_file) then - 'rm' -f $List_file - endif - if (-e $Error_file) then - 'rm' -f $Error_file - endif - log "----- Working on $File " - endif - -# -# Next file if any of the above errors occured -# - if ($Type == ignore) then - -# -# GRP Group files: no special action -# IDX Index file/database -# TEX Tex files: translate using ndoc full -# CAP Figure captions: idem -# TBL Tables: idem -# FIG Figures: idem -# - else if ("$Type" == "grp" || "$Type" == "idx" || \ - "$Type" == "kwa" || "$Type" == "tex" || \ - "$Type" == "cap" || "$Type" == "tbl" || \ - "$Type" == "fig" ) then - if ("$Tail" == "version.idx") then - set tmp=(`head -1 $File`) - if ($#tmp > 2) then - if ("$tmp[3]" != "") set C_Version=$tmp[3] - endif - echo "%%%%% Version: $C_Version" - else - log "No action on $Tail" - endif -# -# GIF GFS PS Images -# - else if ("$Type" == "gif" || "$Type" == "gfs" || \ - "$Type" == "xbm" || "$Type" == "ps") then - if ($_Update) then - if ($File =~ *icons/$Tail) then - if (! -d $n_hlp/icons) mkdir $n_hlp/icons - if ("$Type" == "xbm") then - cp $File $n_hlp/icons/$Name.xbm - else - cp $File $n_hlp/icons/$Tail - endif - else - cp $File $n_hlp/$Tail - endif - echo "Moved into "\$n_hlp - endif -# -# TXT HLP HTML Help text etc -# - else if ("$Type" == "txt" || "$Type" == "hlp" || "$Type" == "html") then - - if ("$Type" == "hlp") then # xmosaic doesnot know .hlp - set Flag=$Name.txt - else - set Flag=$Tail - endif - - if ($_Update) then - if ("$Tail" == "homepage.html") then # encode site name - sed -e s/N_SITE/$n_site/ $File >$n_hlp/$Flag - else - cp $File $n_hlp/$Flag - endif - echo "Moved into "\$n_hlp - endif -# -# HUN Library with html files -# - else if ("$Type" == "hun") then - if ($n_site != nfra) then - if (! ("$n_site" == "rug" && "$n_arch" == "sw")) then - rm -fR $n_hlp - mkdir $n_hlp - cp $File $n_hlp/$Name.hlb.Z - cd $n_hlp - uncompress $Name.hlb - if (! -e $Name.hlb) mv $Name.hlb.Z $Name.hlb - tar xvf $Name.hlb | grep -v "^x" - rm $Name.hlb - echo "Library unpacked." - endif - endif -# -# SCN Scanfiles -# WMP Mapfiles -# MDL Modelfiles -# - else if ("$Type" == "scn" || "$Type" == "wmp" || "$Type" == "mdl" || \ - "$Type" == "ngf" || "$Type" == "flf" ) then - chmod a+r $File - log "Datafile: $Tail" -# -# SSC Combined command files/shell scripts: split out -# - else if ("$Type" == "ssc") then - foreach out ( sun com ) - log "Creating $Name.$out from $Tail" - if ("$n_arch" == "vx") then - set Flag="wn_vax__" - else - set Flag="wn_un__" - endif - if ($out == com) set Flag="wn_vax__" - set Flag="($Flag)|(wn_${n_arch}__)|(wn_${n_site}__)" - if (-e ${File:r}.$out) then - 'rm' -f ${File:r}.$out - endif - cat $File | awk '\ -BEGIN { FS = " "; lvl=1; on[1]=1; } \ -/^.*# *ifdef/ { \ - lvl++; \ - if ($2 ~ /'$Flag'/) {on[lvl]=1;} else {on[lvl]=0;} \ - next } \ -/^.*# *ifndef/ { \ - lvl++; \ - if ($2 ~ /'$Flag'/) {on[lvl]=0;} else {on[lvl]=1;} \ - next } \ -/^.*# *else/ { on[lvl]=1-on[lvl]; next } \ -/^.*# *endif/ { lvl--; next } \ - { ok=1; for (i=1; i<=lvl; i++) { if (on[i]==0) ok=0; }; \ - if ("'$out'" == "com" && lvl == 1) printf "$\!"; \ - if (ok != 0) print }' >${File:r}.$out - - if (! -e ${File:r}.$out) then - @ Error = $Error + 1 - log "Error creating ${File:r}.$out..." - else - chmod a+x ${File:r}.$out - endif - end -# -# CSH PLS Shell scripts: make them executable -# - else if ("$Type" == "csh" || "$Type" == "pls") then - if ( -o $File) then - log "chmod a+x $Tail" - chmod a+x $File - else - log "Ignore: not owner of $File" - endif -# -# COM Command files: no special action -# - else if ("$Type" == "com") then - log "No action on $Tail" - -# -# INC Include files (c) -# DEF Include files (fortran) -# - else if ("$Type" == "inc" || "$Type" == "def" || "$Type" == "dsf") then - - if ("$Type" == "def" || "$Type" == "dsf") then - set Flag=`echo $Tail | tr '[a-z].' '[A-Z]_'` - else - set Flag=${Name}_$Type - endif - - if (-e $n_uinc/$Flag ) then - 'rm' -f $n_uinc/$Flag - endif - -# cp $File $n_uinc/$Flag - awk -f $n_src/sys/data_splitter.kwa $File >& $n_uinc/$Flag - - if (! -e $n_uinc/$Flag ) then - log "***** Error: Could not copy $Tail into $n_uinc" - @ Errors = $Errors + 1 - else - log "Copied $Tail into $n_uinc" - endif - -# -# A?? Special object libraries: copy to $n_lib and uncompress -# - else if ("$Type" =~ a?? ) then - if ("$Type" != "a$n_arch") then - log "Ignoring archive $Tail for $n_arch" - else - cp $File $n_lib/$Name.olb - mv $n_lib/$Name.olb $n_lib/$Name.olb.Z - if (-e $n_lib/$Name.olb.Z) then - log `uncompress $n_lib/$Name.olb` - if (-e $n_lib/$Name.olb.Z) then - mv $n_lib/$Name.olb.Z $n_lib/$Name.olb - endif - endif - if (-e $n_lib/$Name.olb) then - ranlib $n_lib/$Name.olb - log "Installed library "\$n_lib/$Name.olb - else - log "***** Error: could not copy $Tail into "\$n_lib - @ Errors = $Errors + 1 - endif - endif - -# -# X?? Special executable: copy to $n_exe (no use to have them in $n_uexe) -# - else if ("$Type" =~ x??) then - if ("$Type" != "x$n_arch") then - log "Ignoring executable $Tail for $n_arch" - else - cp $File $n_exe/$Name.exe - mv $n_exe/$Name.exe $n_exe/$Name.exe.Z - if (-e $n_exe/$Name.exe.Z) then - log `uncompress $n_exe/$Name.exe` - if (-e $n_exe/$Name.exe.Z) then - mv $n_exe/$Name.exe.Z $n_exe/$Name.exe - endif - endif - if (-e $n_exe/$Name.exe) then - chmod a+x $n_exe/$Name.exe - log "Installed executable "\$n_exe"/$Name.exe (chmod a+x)" -# -# NFRA has local executables on several HP machines -# - if ($n_site == "nfra" && $n_arch == "hp") then - cp $n_exe/$Name.exe $n_root/exe/hp - echo "Copied to master exe-directory" - foreach tmphost ( $Local_HP ) - if ($HOST != $tmphost) then - set Remok=`$RSH $tmphost echo \$n_exe` - if ($Remok != "" && $Remok != $n_root/exe/hp) then - $RSH $tmphost ' mv '\$n_exe/$Name.exe \$n_exe/$Name.exe.old' ; \ - cp '$n_root/exe/hp/$Name.exe \$n_exe' ' - echo "Copied to "\$n_exe" on $tmphost" - else - if ($Remok == "") then - echo "$tmphost heeft probleem: is waarschijnlijk down" - else - echo "$tmphost heeft probleem: n_exe is $Remok (Bestaat execute.exe wel ??)" - endif - endif - endif - end - endif - else - log "***** Error: could not copy $Tail into "\$n_exe - @ Errors = $Errors + 1 - endif - endif - -# -# PEF PIN-Include files: make a link in $n_uinc and check it -# - else if ("$Type" == "pef") then - - if (-e $n_uinc/$Tail ) then - 'rm' -f $n_uinc/$Tail - endif - cp $File $n_uinc - if (! -e $n_uinc/$Tail ) then - log "***** Error: Could not link $Tail into "\$n_uinc - @ Errors = $Errors + 1 - else - log "Copied $Tail into "\$n_uinc - if ($_Update && -o $n_hlp && -o $n_src) $n_exe/genaid.exe keys $File - endif -# -# PIN files: compile to ppd -# -# It would be better to update dwarf to include pef-files and make listings -# and other things in current dir, for the while we work around -# - else if ("$Type" == "pin" || "$Type" == "psc") then -# -# Check if we have a compiler -# - if (! -e $n_uexe/sys_bldppd.exe && ! -e $n_exe/sys_bldppd.exe) then - log "***** Error: ppd-compiler (sys_bldppd) does not exist" - @ Errors = $Errors + 1 - - else -# -# Do all the work in $n_work -# - cd $n_work -# -# Does the file contain include commands? -# - onintr ppd_done # To remove temp. copy - set Flag=`grep '^INCLUDE=' $File` - if ("$Flag" != "") then - $n_exe/genaid.exe psc $File >$Name.tmp - else - cp $File $Name.tmp # Make temp copy in $n_uinc - endif - sed -e '/^\!/d' < $Name.tmp >! $Name.pin - rm $Name.tmp - - if (! -e global.ppd) touch global.ppd - if (! -e gen.ppd) touch gen.ppd - if (! -e ngen.ppd) touch ngen.ppd - - log "sys_bldppd.exe $Name /list" - if (-e $n_uexe/sys_bldppd.exe) then - $n_uexe/sys_bldppd.exe $Name /list >! $Error_file - @ Flag = $status - else - $n_exe/sys_bldppd.exe $Name /list >! $Error_file - @ Flag = $status - endif - -ppd_done: # Interrupt handler - 'rm' -f $Name.pin # Remove temp. copy - - if (-e $Name.lis && $n_work/$Name.lis != $List_file) mv $Name.lis $List_file - if (-z global.ppd) then - 'rm' -f global.ppd - endif - if (-z gen.ppd) then - 'rm' -f gen.ppd - endif - if (-z ngen.ppd) then - 'rm' -f ngen.ppd - endif - if (-e ppd.ref) then - 'rm' -f ppd.ref - endif - - onintr Abort_exit # Original interrupt handler - -# if ( ($Flag != 9 && $Flag != 97 && $Flag != 1) || \ - if ( \ - ! -e $Name.ppd || ! -e $List_file) then - if (-e $Name.ppd) then - 'rm' -f $Name.ppd - endif - echo "***** Error producing ppd-file: $Flag" >> $Error_file - @ Errors = $Errors + 1 - else - cat $Error_file >>$List_file - 'rm' -f $Error_file - - if ($n_uexe != $n_work && -e $n_uexe/$Name.ppd) then - mv $n_uexe/$Name.ppd $n_uexe/$Name.ppd.old - if (! $_Keep) then - 'rm' -f $n_uexe/$Name.ppd.old - endif - endif - - if ($n_uexe == $n_exe || $_Update) then - if ($n_exe != $n_work) then - if (-e $n_exe/$Name.ppd) then - mv $n_exe/$Name.ppd $n_exe/$Name.ppd.old - if (! $_Keep) then - 'rm' -f $n_exe/$Name.ppd.old - endif - endif - mv $n_work/$Name.ppd $n_exe - endif - if (-e $n_exe/$Name.ppd) then - log "----- "\$n_exe"/$Name.ppd properly installed" -# -# NFRA has local executables on several HP machines -# - if ($n_site == "nfra" && $n_arch == "hp") then - cp $n_exe/$Name.ppd $n_root/exe/hp - echo "Copied to master exe-directory" - foreach tmphost ( $Local_HP ) - if ($HOST != $tmphost) then - set Remok=`$RSH $tmphost echo \$n_exe` - if ($Remok != "" && $Remok != $n_root/exe/hp) then - $RSH $tmphost ' mv '\$n_exe/$Name.ppd \$n_exe/$Name.ppd.old' ; \ - cp '$n_root/exe/hp/$Name.ppd \$n_exe' ' - echo "Copied to "\$n_exe" on $tmphost" - else - if ($Remok == "") then - echo "$tmphost heeft probleem: is waarschijnlijk down" - else - echo "$tmphost heeft probleem: n_exe is $Remok (Bestaat execute.exe wel ??)" - endif - endif - endif - end - endif - - if (-o $n_hlp && -o $n_src) then - $n_exe/genaid.exe keys $File - else - log "***** Error: could not update documentation" - endif - else - log "***** Error: could not move ppd file to "\$n_exe - @ Errors = $Errors + 1 - endif - else - if ($n_uexe != $n_work) mv $Name.ppd $n_uexe - if (! -e $n_uexe/$Name.ppd ) then - log "***** Error: could not move ppd file to "\$n_uexe - @ Errors = $Errors + 1 - endif - endif - endif - endif -# -# -# DSC files: use WNTINC -# - else if ("$Type" == "dsc") then -# -# Do all the work in $n_uinc -# - cd $n_uinc - - if (! -e $n_uexe/wntinc.exe && ! -e $n_exe/wntinc.exe) then - log "***** Error: dsc-compiler (wntinc) does not exist" - @ Errors = $Errors + 1 - - else -# -# Remove tricky links and all possible output files -# - set Flag=`echo $Name | tr '[a-z]' '[A-Z]'` - if (-e ${Flag}_DEF) then - 'rm' -f ${Flag}_DEF - endif - if (-e ${Flag}_O_DEF) then - 'rm' -f ${Flag}_O_DEF - endif - if (-e ${Flag}_T_DEF) then - 'rm' -f ${Flag}_T_DEF - endif - if (-e ${Flag}_E_DEF) then - 'rm' -f ${Flag}_E_DEF - endif - if (-e ${Name}_inc) then - 'rm' -f ${Name}_inc - endif - if (-e ${Name}_o_inc) then - 'rm' -f ${Name}_o_inc - endif - if (-e ${Name}_t_inc) then - 'rm' -f ${Name}_t_inc - endif - if (-e ${Name}_e_inc) then - 'rm' -f ${Name}_e_inc - endif - - if (-e ${Name}.def) then - 'rm' -f ${Name}.def - endif - if (-e ${Name}.inc) then - 'rm' -f ${Name}.inc - endif - if (-e ${Name}_o.inc) then - 'rm' -f ${Name}_o.inc - endif - if (-e ${Name}_t.inc) then - 'rm' -f ${Name}_t.inc - endif - if (-e ${Name}_e.inc) then - 'rm' -f ${Name}_e.inc - endif - if (-e ${Name}_bd.for) then - 'rm' -f ${Name}_bd.for - endif - if (-e ${Name}_o.def) then - 'rm' -f ${Name}_o.def - endif - if (-e ${Name}_t.def) then - 'rm' -f ${Name}_t.def - endif - if (-e ${Name}_e.def) then - 'rm' -f ${Name}_e.def - endif -# -# Invoke WNTINC to compile new output files in $n_uinc -# - onintr dsc_done # To remove temp. copy - cp $File $Tail # Temporary copy - log "wntinc.exe $Name ($cwd $Tail)" - if (-e $n_uexe/wntinc.exe) then - $n_uexe/wntinc.exe $Name - @ Flag = $status - else - $n_exe/wntinc.exe $Name - @ Flag = $status - endif -dsc_done: # Interrupt handler - 'rm' -f $Tail # Remove temp. copy - if (-e $Name.lis) then # Move logfile - mv $Name.lis $List_file - endif - onintr Abort_exit # Original interrupt handler - if ( $Flag != 1 ) then - if (-e $List_file) mv $List_file $Error_file - echo "***** Errors compiling $Name.dsc ($Flag)" >>$Error_file - @ Errors = $Errors + 1 - endif -# -# Link fortran includes to uppercase with underscore -# - set Flag=`echo $Name | tr '[a-z]' '[A-Z]'` - if (-e ${Name}.def) then - mv ${Name}.def ${Name}.def.tmp - awk -f $n_src/sys/data_splitter.kwa ${Name}.def.tmp |\ - sed -e 's%^ &% 1%' > ${Name}.def - ln -s ${Name}.def ${Flag}_DEF - endif - if (-e ${Name}_o.def) then - mv ${Name}_o.def ${Name}_o.def.tmp - awk -f $n_src/sys/data_splitter.kwa ${Name}_o.def.tmp|\ - sed -e 's%^ &% 1%' >& ${Name}_o.def - ln -s ${Name}_o.def ${Flag}_O_DEF - endif - if (-e ${Name}_t.def) then - mv ${Name}_t.def ${Name}_t.def.tmp - awk -f $n_src/sys/data_splitter.kwa ${Name}_t.def.tmp|\ - sed -e 's%^ &% 1%' >& ${Name}_t.def - ln -s ${Name}_t.def ${Flag}_T_DEF - endif - if (-e ${Name}_e.def) then - mv ${Name}_e.def ${Name}_e.def.tmp - awk -f $n_src/sys/data_splitter.kwa ${Name}_e.def.tmp|\ - sed -e 's%^ &% 1%' >& ${Name}_e.def - ln -s ${Name}_e.def ${Flag}_E_DEF - endif - if (-e ${Name}.inc) then - mv ${Name}.inc ${Name}.inc.tmp - awk -f $n_src/sys/data_splitter.kwa ${Name}.inc.tmp >& ${Name}.inc - ln -s ${Name}.inc ${Name}_inc - endif - if (-e ${Name}_o.inc) then - mv ${Name}_o.inc ${Name}_o.inc.tmp - awk -f $n_src/sys/data_splitter.kwa ${Name}_o.inc.tmp >& ${Name}_o.inc - ln -s ${Name}_o.inc ${Name}_o_inc - endif - if (-e ${Name}_t.inc) then - mv ${Name}_t.inc ${Name}_t.inc.tmp - awk -f $n_src/sys/data_splitter.kwa ${Name}_t.inc.tmp >& ${Name}_t.inc - ln -s ${Name}_t.inc ${Name}_t_inc - endif - if (-e ${Name}_e.inc) then - mv ${Name}_e.inc ${Name}_e.inc.tmp - awk -f $n_src/sys/data_splitter.kwa ${Name}_e.inc.tmp >& ${Name}_e.inc - ln -s ${Name}_e.inc ${Name}_e_inc - endif - -# -# If these files are needed for building WNTINC, copy them back -# into the source tree -# -# if ($n_usrc == $n_src) then -# set Flag=`grep -i $Name $n_src/wng/wnt_boot.grp` -# if ("$Flag" != "") then -# log "copy back into "\$n_src/wng" (kip/ei): ${Name}*.??? " -# cp ${Name}*.??? $n_src/wng -# endif -# endif - endif -# -# Prepare for compilation of _bd.for if it exists -# - if (-e ${Name}_bd.for) set Input_file[1]=$n_uinc/${Name}_bd.for - -# -# -# Macro: compile it -# - else if ("$Type" == "m??") then - log "Ignoring macro files on $n_arch" - set Type="ignore" - else if ("$Type" == "s") then - if (-e $Object_file) then - 'rm' -f $Object_file - endif - awk '{printf("%4.4d %s\n",NR,$0)}' $File > $List_file # Make listing - cd $n_uinc # See includes - log "$AS -o $Object_file $ASFLAGS $Tail" - $AS -o $Object_file $ASFLAGS $File >&! $Error_file - if ( $status || ! -e $Object_file ) then - echo "Compilation errors..." >>$Error_file - @ Errors = $Errors + 1 - else - 'rm' -f $Error_file - endif -# -# C source (utility programs): compile to executable -# - else if ("$Type" == c ) then - if (-e $Object_file) then - 'rm' -f $Object_file - endif - set Flag="" - if ($_Debug) set Flag=($Flag $CFLAGS_D) - if ($_Optimise) set Flag=($Flag $CFLAGS_O) - set L_Lib="" - if ($?LD_USER) then # Add user supplied libraries - set L_Lib=( $L_Lib $LD_USER ) - endif -# - log "$CC -o $Name.exe $Flag -I$n_inc -I$n_uinc $Tail" - $CC -o $n_uexe/$Name.exe $Flag -I$n_inc -I$n_uinc $L_Lib $File >&! $Error_file - if ( $status || ! -e $n_uexe/$Name.exe ) then - echo "Compilation errors..." >>$Error_file - @ Errors = $Errors + 1 - else - if ($_Update) then - mv $n_uexe/$Name.exe $n_exe/$Name.exe - log "----- "\$n_exe"/$Name.exe properly installed" -# -# NFRA has local executables on several HP machines -# - if ($n_site == "nfra" && $n_arch == "hp") then - cp $n_exe/$Name.exe $n_root/exe/hp - echo "Copied to master exe-directory" - foreach tmphost ( $Local_HP ) - if ($HOST != $tmphost) then - set Remok=`$RSH $tmphost echo \$n_exe` - if ($Remok != "" && $Remok != $n_root/exe/hp) then - $RSH $tmphost ' mv '\$n_exe/$Name.exe \$n_exe/$Name.exe.old' ; \ - cp '$n_root/exe/hp/$Name.exe \$n_exe' ' - echo "Copied to "\$n_exe" on $tmphost" - else - if ($Remok == "") then - echo "$tmphost heeft probleem: is waarschijnlijk down" - else - echo "$tmphost heeft probleem: n_exe is $Remok (Bestaat execute.exe wel ??)" - endif - endif - endif - end - endif - endif - 'rm' -f $Error_file - endif - if (-e $Object_file) then - 'rm' -f $Object_file - endif -# -# C source: compile it (NB: .com and .csh already matched earlier!) -# - else if ("$Type" =~ c?? ) then - if ("$Type" != "cee" && "$Type" != "cun" && "$Type" != "c$n_arch" || \ - ("$Type" == "cun" && "$n_arch" == "vx")) then - log "Ignoring $Tail for $n_arch" - set Type="ignore" - else - if (-e $n_work/$Name.c) then - 'rm' -f $n_work/$Name.c - endif - cp $File $n_work/$Name.c - set File=$n_work/$Name.c - log "Linked $Tail to "\$n_work/$Name.c - - if (-e $Object_file) then - 'rm' -f $Object_file - endif - if ("$n_arch" == "vx") then - set Flag=( $CFLAGS -Dwn_vax__ -Dwn_${n_arch}__ -Dwn_${n_site}__ ) - else - set Flag=( $CFLAGS -Dwn_un__ -Dwn_${n_arch}__ -Dwn_${n_site}__ ) - if ("$n_arch" == "so") then - set Flag=( $Flag -Dwn_sw__ ) - endif - endif - if (-e $n_lib/pgplot.olb ) set Flag=( $Flag -Dwn_pgplot__ ) - if (-e $n_lib/giplib.olb || \ - -e $n_lib/libgdi.olb) set Flag=( $Flag -Dwn_gipsy__ ) - if ($_Debug) set Flag=($Flag $CFLAGS_D) - if ($_Optimise) set Flag=($Flag $CFLAGS_O) - - awk '{printf("%4.4d %s\n",NR,$0)}' $File > $List_file # Make listing - log "$CC -o $Object_file $Flag -I$n_inc -I$n_uinc $Tail" - $CC -o $Object_file $Flag -I$n_inc -I$n_uinc $File >&! $Error_file - if ( $status || ! -e $Object_file ) then - echo "Compilation errors..." >>$Error_file - @ Errors = $Errors + 1 - else - 'rm' -f $Error_file - if (-e $n_work/$Name.c && ! $_Debug) then - 'rm' -f $n_work/$Name.c - log "Removed temporary file "\$n_work/$Name.c - endif - endif - endif - -# -# -# Fortran source: precompile and compile -# - else if ("$Type" =~ f?? ) then - - if ("$Type" != "for" && "$Type" != "fsc" && \ - "$Type" != "fun" && "$Type" != "f$n_arch" || \ - ("$Type" == "fun" && "$n_arch" == "vx")) then - log "Ignoring $Tail on $n_arch" - set Type="ignore" - else -# -# Does the file contain precompiler commands? If so, process them -# - set Flag=`grep '^.*#endif' $File` - if ("$Flag" != "") then - log "Precompiling $Tail -> "\$n_work/$Name.f - if ("$n_arch" == "vx") then - set Flag="(wn_vax__)|(wn_${n_arch}__)|(wn_${n_site}__)" - else - set Flag="(wn_un__)|(wn_${n_arch}__)|(wn_${n_site}__)" - endif - if (-e $n_lib/pgplot.olb ) set Flag="$Flag|(wn_pgplot__)" - if (-e $n_lib/giplib.olb || \ - -e $n_lib/libgdi.olb) set Flag="$Flag|(wn_gipsy__)" - - if (-e $n_work/$Name.f) then - 'rm' -f $n_work/$Name.f - endif -# cat $File | awk '\ - cat $File | sed -e 's%# *%#%' | awk '\ -BEGIN { FS = " "; lvl=1; on[1]=1; } \ -/^.*# *ifdef/ { \ - print "c" $0; lvl++; \ - if ($2 ~ /'$Flag'/) {on[lvl]=1;} else {on[lvl]=0;} \ - next } \ -/^.*# *ifndef/ { \ - print "c" $0; lvl++; \ - if ($2 ~ /'$Flag'/) {on[lvl]=0;} else {on[lvl]=1;} \ - next } \ -/^.*# *else/ { print "c" $0; on[lvl]=1-on[lvl]; next } \ -/^.*# *endif/ { print "c" $0; lvl--; next } \ - { ok=1; for (i=1; i<=lvl; i++) { if (on[i]==0) ok=0; }; \ - if (ok == 0) {printf "c:";} print }' >$n_work/$Name.f.1st - - set File=$n_work/$Name.f - awk -f $n_src/sys/data_splitter.kwa $File.1st | \ - sed -e 's%PARAMETER (%PARAMETER ( %' >& $File - rm $File.1st - - else - if (-e $n_work/$Name.f ) then - 'rm' -f $n_work/$Name.f - endif -# cp $File $n_work/$Name.f - awk -f $n_src/sys/data_splitter.kwa $File | \ - sed -e 's%PARAMETER (%PARAMETER ( %' \ - -e 's%^ &% 1%'>& $n_work/$Name.f - set File=$n_work/$Name.f - log "Linked $Tail to $n_work/$Name.f" - endif - - if (! -e $File ) then - log "Could not produce file $File" - @ Errors = $Errors + 1 - else - if (-e $Object_file) then - 'rm' -f $Object_file - endif - set Flag=( $FFLAGS ) - if ($_Debug) set Flag=($Flag $FFLAGS_D) - if ($_Optimise) set Flag=($Flag $FFLAGS_O) - if ($_Xref) set Flag=($Flag $FFLAGS_X) - - cd $n_uinc - log "$FC -o $Object_file $Flag $File" -# -# DEC Looks for include files in the directory where the source file is -# - if ("$n_arch" == "dw" || "$n_arch" == "da" || \ - "$n_arch" == "vx") then - cp $File $n_uinc - $FC -o $Object_file $Flag $File:t >&! $Error_file - if (-e $n_uinc/$Name.l) mv $n_uinc/$Name.l $List_file - 'rm' -f $n_uinc/$File:t - else - awk '{printf("%4.4d %s\n",NR,$0)}' $File > $List_file # Make listing - $FC -o $Object_file $Flag $File >&! $Error_file - endif - if ( $status || ! -e $Object_file ) then - echo "Compilation errors..." >>$Error_file - @ Errors = $Errors + 1 - else - 'rm' -f $Error_file - if (-e $n_work/$Name.f && ! $_Debug) then - 'rm' -f $n_work/$Name.f - log "Removed temporary file "\$n_work/$Name.f - endif - endif - endif - endif - -# -# -# Executable: make dummy file, compile and link -# - else if ("$Type" == "exe") then - -# -# Work in $n_ulib for local objects (length of string too long if we -# have to include the full path -# - if ($?n_ulib) then - cd $n_ulib - endif - - set List_file=$n_work/$Name.map -# -# Set up initialisation routines (better make dummy routine for hp) -# - if ($n_arch == vx) then - set Getarg="CALL LIB$GET_FOREIGN(CLSTR)" - set Tstarg=".TRUE." - else - set Getarg="CALL GETARG(1,CLSTR)" - set Tstarg="IARGC().GT.0" - endif - if ($_Alternate) then - set Flag="1" - else - set Flag="" - endif - if (! $?C_Date) set C_Date="today" - if (! $?C_Time) set C_Time="" - if (! $?C_Version) set C_Version=$C_Date - set NAME=`echo $Name | tr '[a-z]' '[A-Z]'` -# -# Create a dummy fortran file -# - cat << _EOD_ > $n_work/main_${Name}$$.f - PROGRAM ${Name}_EXE - CHARACTER*80 CLSTR !COMMAND LINE ARGUMENT - CHARACTER*25 VRS !Version passed to WNGIN - CHARACTER*80 WHAT !Version found by what - IF ($Tstarg) THEN - $Getarg - ELSE - CLSTR=' ' - END IF - WHAT='@(#)%NST%$NAME $C_Version $C_Date/$C_Time' - VRS='$C_Version ' !Set version number - VRS(8:)='$C_Date/$C_Time' !Append date/time - CALL WNGIN$Flag('$NAME',VRS,$Dattyp) - CALL $Name(CLSTR) !CALL PROGRAM - CALL WNGEX !FINISH OFF - END -_EOD_ - unset Getarg -# -# Compile the dummy file -# - set L_Lib="" - set L_Obj="" - - set nonomatch - - touch main_.o # Make sure at least one is present - set Flag=( main_*.o ) # Remove any old main object files - if (-e $Flag[1] ) then # At least one exists - 'rm' -f main_*.o # Delete them all - endif - - if ($?n_ulib) then # Add any object files (shadow) - set L_Obj=( *.o ) - if (-e $Name.objlist) then # We did a cd to $n_ulib, mind you - set L_Obj = `sed -e 's: .*::' < $Name.objlist` - (ls $L_Obj >! $Name.tmp) >& /dev/null # discard 'Not found' errors - set L_Obj = `cat $Name.tmp` - rm $Name.tmp - endif - if ("$L_Obj" != "") then - if ("$L_Obj[1]" == '*.o') set L_Obj="" - endif - if ("$L_Obj[1]" != "") then - echo "Local objects:" - ls -l $L_Obj -## echo "$L_Obj" | tr ' ' '\012' | sed -e 's:^: :' - endif - endif - unset nonomatch - - if ($?LD_USER) then # Add user supplied libraries - set L_Lib=( $L_Lib $LD_USER ) - endif - - if (-e $n_lib/wnglib.olb) set L_Lib=( $L_Lib $n_lib/wnglib.olb ) - if (-e $n_lib/nstlib.olb) set L_Lib=( $L_Lib $n_lib/nstlib.olb ) - - if (-e $n_lib/libgdi.olb) set L_Lib=( $L_Lib $n_lib/libgdi.olb ) - if (-e $n_lib/giplib.olb) set L_Lib=( $L_Lib $n_lib/giplib.olb ) - - -## set L_Lib=( $L_Lib -lm -ltermcap ) -## set L_Lib=( $L_Lib -L/usr/lib -lm -lncursesw ) - - if (-e $n_lib/wnglib.olb) set L_Lib=( $L_Lib $n_lib/wnglib.olb ) - if (-e $n_lib/nstlib.olb) set L_Lib=( $L_Lib $n_lib/nstlib.olb ) - - - if ($?LD_X11) then # Special path to X11 libs - set L_Lib=( $L_Lib $LD_X11 ) - else - set L_Lib=( $L_Lib -lX11 ) - endif - - if (-e $n_lib/dwarflib.olb) set L_Lib=( $L_Lib $n_lib/dwarflib.olb ) - if (-e $n_lib/wnglib.olb) set L_Lib=( $L_Lib $n_lib/wnglib.olb ) - if (-e $n_lib/giplib.olb) set L_Lib=( $L_Lib $n_lib/giplib.olb ) - - if ($?LD_USER) then # Add user supplied libraries - set L_Lib=( $L_Lib $LD_USER ) - endif - -## set L_Lib=( $L_Lib -lm -ltermcap ) - if ($?LD_USER) then # Add user supplied libraries - set L_Lib=( $L_Lib $LD_USER -lm ) - else - ## set L_Lib=( $L_Lib -lncursesw -lm ) - set L_Lib=( $L_Lib -lm -lncursesw ) - endif - - set Flag=( $FFLAGS_L ) - if ($_Optimise) set Flag=( $Flag $FFLAGS_O ) - if ($_Debug) set Flag=( $Flag $FFLAGS_D ) - if ($_Xref) set Flag=( $Flag $FFLAGS_X ) - - if (-e $n_work/$Name.exe) then - 'rm' -f $n_work/$Name.exe - endif - - log "$FC -o $Name.exe $Flag main_${Name}$$.f " - log " Libraries: $L_Lib " - -### -#echo L_Lib $L_Lib - $FC -o $n_work/$Name.exe $Flag $n_work/main_${Name}$$.f $L_Obj \ - $L_Lib >&! $List_file - - 'rm' -f $n_work/main_${Name}$$.f - if (-e main_${Name}$$.o ) then - 'rm' -f main_${Name}$$.o - endif -# -# Check result of compilation -# - if ($status || ! -e $n_work/$Name.exe || ! -e $List_file) then - if (-e $List_file) mv $List_file $Error_file - if (-e $n_work/$Name.exe) then - 'rm' -f $n_work/$Name.exe - endif - log "**** Error: could not build $Name.f" - echo "**** Error during compilation ****" >>$Error_file - @ Errors = $Errors + 1 - else - set Flag=`grep ndefine $List_file` - if ("$Flag" == "") set Flag=`grep nresolv $List_file` - if ("$Flag" == "") set Flag=`grep nsatisf $List_file` - if ("$Flag" == "") set Flag=`grep duplicate $List_file` - if ("$Flag" == "") set Flag=`grep "multiply " $List_file` - if ("$Flag" == "" && ! -x $n_work/$Name.exe) set Flag="Not executable" - if ("$Flag" != "") then - log "**** Error: $Flag" - mv $List_file $Error_file - if (-e $n_work/$Name.exe) then - 'rm' -f $n_work/$Name.exe - endif - @ Errors = $Errors + 1 - else -# -# If correct, move the executable to $n_uexe -# - if ($n_uexe != $n_work && -e $n_uexe/$Name.exe) then - mv $n_uexe/$Name.exe $n_uexe/$Name.exe.old - if (! $_Keep) then - 'rm' -f $n_uexe/$Name.exe.old - endif - endif -# -# For update: strip debugging info for speed and space, keep old exe -# - if ($n_uexe == $n_exe || $_Update) then - strip $n_work/$Name.exe - if ($n_exe != $n_work) then - if (-e $n_exe/$Name.exe) then - mv $n_exe/$Name.exe $n_exe/$Name.exe.old - if (! $_Keep) then - 'rm' -f $n_exe/$Name.exe.old - endif - endif - mv $n_work/$Name.exe $n_exe - endif - if (-e $n_exe/$Name.exe) then - log "----- "\$n_exe"/$Name.exe properly installed" -# -# NFRA has local executables on several HP machines -# - if ($n_site == "nfra" && $n_arch == "hp") then - cp $n_exe/$Name.exe $n_root/exe/hp - echo "Copied to master exe-directory" - foreach tmphost ( $Local_HP ) - if ($HOST != $tmphost) then - set Remok=`$RSH $tmphost echo \$n_exe` - if ($Remok != "" && $Remok != $n_root/exe/hp) then - $RSH $tmphost ' mv '\$n_exe/$Name.exe \$n_exe/$Name.exe.old' ; \ - cp '$n_root/exe/hp/$Name.exe \$n_exe' ' - echo "Copied to "\$n_exe" on $tmphost" - else - if ($Remok == "") then - echo "$tmphost heeft probleem: is waarschijnlijk down" - else - echo "$tmphost heeft probleem: n_exe is $Remok (Bestaat execute.exe wel ??)" - endif - endif - endif - end - endif -# -# Update version number in the database entry -# - cp $n_src/sys/database.idx $n_work/database.old - grep -v $Name.exe $n_work/database.old >$n_src/sys/database.idx - echo $Name.exe $C_Version $C_Time $C_Date >>$n_src/sys/database.idx - else - log "***** Error: could not move $Name.exe to "\$n_exe - @ Errors = $Errors + 1 - endif -# -# We do not keep old executables in $n_uexe -# - else - if ($n_uexe != $n_work && -e $n_uexe/$Name.exe) then - mv $n_uexe/$Name.exe $n_uexe/$Name.exe.old - 'rm' -f $n_uexe/$Name.exe.old - endif - if ($n_uexe != $n_work) mv $n_work/$Name.exe $n_uexe - if (-e $n_uexe/$Name.exe) then - log "----- "\$n_uexe"/$Name.exe properly installed" - else - log "***** Error: could not move $Name.exe to "\$n_uexe - @ Errors = $Errors + 1 - endif - endif - - endif - endif -# -# -# No recognised filetype, issue a warning -# - else - log "**** Unrecognised filetype: $Tail, ignored" - endif - -# -# We may have changed directory for compilation -# - cd $Home -# -# Handle object files -# - if ($Type != ignore) then - if (-e $Object_file) then - if (-e $Error_file || -e $List_file) then - echo " " >>$List_file - echo "Symbol table of module ${Object_file}:" >>$List_file - nm $Object_file >>$List_file - endif -# -# Error occured, remove object file -# - if (-e $Error_file) then - 'rm' -f $Object_file -# -# Objectlib defined: put object file on list for library -# - else if ("$_Objectlib" != "") then - echo $Object_file >>$n_work/${_Objectlib:t}.list - else - if ($n_ulib != $n_work) mv $Object_file $n_ulib/$Object_file:t - if (! -e $n_ulib/$Object_file:t ) then - log "***** Error: could not move $Object_file into "\$n_ulib - @ Errors = $Errors + 1 - endif - endif - endif - -# -# If Textlibrary should be used, and no errors detected: push on the list -# - if ("$_Textlib" != "") then - if (! -e $Error_file || -z $Error_file) then - log "Put $Name in textlibrary." - echo $File >>$n_work/${_Textlib:t}.list - endif - endif - -# -# Handle error files -# - unset Flag # Force keep List_file in case of errors - if (-e $Error_file) then - if (! -z $Error_file ) then - echo - if ($_Errors) head -25 $Error_file - echo " " >>$List_file - echo "***** Error messages: " >>$List_file - cat $Error_file >>$List_file - log "***** Errors appended to $List_file" - set Flag - endif - 'rm' -f $Error_file - endif -# -# Handle list files -# - if (-e $List_file) then - mv $List_file $n_work/$Name.tmp - if (-e $n_work/$Name.tmp) \ - pr -f -l60 -h $File $n_work/$Name.tmp > $List_file - if ($_Print && -e $n_src/sys/wngfex.csh) then - $n_src/sys/wngfex.csh sp $List_file $File - log "----- Listing in $List_file printed" - else if ("$List_file:e" == "map") then - log "----- Mapfile in $List_file" - else if ($_List || $?Flag) then - log "----- Listing in $List_file" - else - 'rm' -f $List_file - endif - endif - unset Flag - endif - -# -# Ready for the next file... -# Input_file[1] may have been overwritten to cause a freshly produced file -# to be processed (pin from psc etc.) -# - if ($Input_file[1] == "" && $#Input_file > 1) shift Input_file -end - -goto Normal_exit - -Abort_exit: - set Abort_flag - -Normal_exit: - -cd $Home - -if ($?Name) then - if (-e $n_work/$Name.tmp ) then - 'rm' -f $n_work/$Name.tmp; - endif - if (-e $n_work/main_${Name}$$.f ) then - 'rm' -f $n_work/main_${Name}$$.f; - endif - if (-e $n_ulib/main_${Name}$$.o ) then - 'rm' -f $n_ulib/main_${Name}$$.o - endif -endif - -# -# Remove all local definitions (not necessary, but doesnot really harm) -# -unset Type Tail Name Object_file List_file Error_file -unset Getarg Flag L_Lib L_Obj - -exit diff --git a/src/sys/csh2p.pls b/src/sys/csh2p.pls deleted file mode 100755 index 59d2fbecfd1523d503f64e8fc7b15c22a38efcfa..0000000000000000000000000000000000000000 --- a/src/sys/csh2p.pls +++ /dev/null @@ -1,1053 +0,0 @@ -#+ CSH2P.PLS -# WNB 940318 -# -# Revisions: -# WNB 940531 Isolate eq, ne -# WNB 940613 Correct elm switches -# -# perl csh2p.pls file -# will translate csh script file to a perl script with name.pls -#- -# -# Intro -# -if ($ENV{'SHELL'}) { unshift(@INC,$ENV{'n_src'}.'/sys');} -else { unshift(@INC,'N_SRC:[SYS]');} -unless (require 'c2aid.pls') { # some general routines - print 'Fatal: Errors in loading c2aid.pls'; exit;} -&ENV_IMPORT; # get environment -# -# Compilation constants -# -$C2_npos=2; # spaces per indent level -$C2_ncom=56; # position of comment -$C2_nlen=78; # length line -$C2_nind=24; # minimum indent for continuation -$C2_nstr=44; # maximum string bit length -$OUT_code=';'; # statement end character -%C2_cmode=( 's', 'M_sw', # command arguments modes - 'i', 'M_in', - 'o', 'M_out', - 't', 'M_int', - 'w', 'M_inw', - 'f', 'M_inf'); -%C2_cmd=( 'ar', 'two', # commands with s(witch),i(n),o(ut) etc - 'awk', 'stio', - 'cat', 'sio', - 'cd', 'i', - 'chdir', 'i', - 'chmod', 'ti', - 'cmp', 'wo', - 'compress', 'wo', - 'cp', 'sw', - 'date', 'o', - 'diff', 'swo', - 'domainname', 'o', - 'echo', 'swo', - 'elm', 'swi', - 'exit', 't', - 'find', 'io', - 'ftp', 'sio', - 'grep', 'stio', - 'head', 'sio', - 'ln', 'si', - 'ls', 'sio', - 'mem', 'i', - 'mkdir', 'i', - 'more', 'sio', - 'mv', 'si', - 'nm', 'io', - 'pr', 'sio', - 'ranlib', 'i', - 'remsh', 'tiio', - 'rm', 'si', - 'rsh', 'tiio', - 'sed', 'stio', - 'sort', 'sio', - 'strip', 'i', - 'tail', 'sio', - 'tar', 'tio', - 'stty', 't', - 'tee', 'sii', - 'touch', 'si', - 'tr', 'sttio', - 'uncompress', 'io', - 'wc', 'sio', - 'what', 'sio', - 'whoami', 'o'); -# -# Check for secondary file -# -unless ($ARGV[0]=~/^\-/) { $C2_mrout=1;} # set main routine -# -# Do all files -# -ALL: -while ($C2_in=&fn(shift(@ARGV))) { # input files - local($C2_cnt); # line count - local($C2_ifd); # if depth - local($C2_incid); # post increment depth if - local($C2_ford); # for/while depth - local($C2_incfd); # post increment depth for/while - local($C2_labd,%C2_labdp); # label depth - local($C2_nocom); # no comment seen indicator - local($C2_tcnt); # << text count - local($C2_acnt)='1000'; # metacharacters count -# -# Open files -# - $C2_in="$C2_in.csh" unless &fp('e',$C2_in); - $C2_innam=&fp('t',&fp('r',$C2_in)); - open(C2_IN,$C2_in) || print "Fatal: Cannot open input file $C2_in\n", - next ALL; - $C2_out=&fp('r',$C2_in).'.pls'; # output file - open(C2_OUT,">$C2_out") || print "Fatal: Cannot open output file $C2_out", - close(C2_IN),next ALL; -# -# Preamble -# - print C2_OUT "#+ $C2_out\n# created by $ENV{'USER'} on $ENV{'HOST'} at ". - &date."\n#-\n"; -# -# Do all lines -# -FILE: - while (&R_line) { - &P_line(&DO_line('',@C2_line)); - } -# -# Finish input file -# - print C2_OUT "#\n#+ Postamble\n#\n"; - print C2_OUT "#\n# Finish main routine\n#\n"; - $C2_ifd--; &P_line(''); $C2_ifd++; - print C2_OUT "#\n# Call main routine\n#\n"; - print C2_OUT "eval('&${C2_innam}__pls');\n1;\n"; - print C2_OUT "#-\n"; - close(C2_IN); close(C2_OUT); - if ($C2_ifd) { print "Error: Unclosed if statement found\n";} - if ($C2_ford) { print "Error: Unclosed for/while statement found\n";} - if ($C2_labd) { print "Error: Unclosed subroutine statement found\n";} - print "$C2_out produced from $C2_in\n"; -# -# Next file -# -} -# -# Clear apostrophe and other meta counts -# -sub C_acnt { - - undef %C2_acnt; $C2_acnt='1000';} # counts -# -# Strip command line of superfluous characters -# -sub P_strip { - - local(@line)=@_; - - for ($i=1; $i<=$#line; $i++) { # strip superfluous char - if ($line[$i] eq ';' && ($line[$i-1]=~/\}$/ || - $line[$i-1]=~/\{$/ || $line[$i-1]=~/;$/)) { - splice(@line,$i,1); $i--; next;} - if ($line[$i] eq ',' && $line[$i-1]=~/,$/) { - splice(@line,$i,1); $i--; next;} - if ($line[$i] eq ')' && $line[$i-1] eq ',') { - splice(@line,$i-1,1); $i--; next;} - } - @line; -} -# -# Print resulting line (@line) -# -sub P_line { - - local(@line)=@_; # line parts - local($t)=(&C2_indent); # indentation - local($tl)=length($t); # length indent - local($com); # current comment - local($len)=($C2_ncom); # current line length - local($p,$pl,$i,$j); # current part and length - - for ($i=$C2_labd;$i>0;$i--) { # check label subroutines - if ($C2_ifd+$C2_ford<$C2_labdp{$i}) { # end label subroutine - $C2_ifd++; &P_line('&exit(\'\');}'); $C2_labd--; $C2_ifd--; - $t=&C2_indent;} - } - @line=&P_strip(@line); # strip superfluous characters - $p=$t; # line part indent - while (@line) { - if (@C2_com) { ($com=shift(@C2_com))=~s/^#//; $len=$C2_ncom;} # more comment - else {$com=''; $len=$C2_nlen;} - $p.=shift(@line).' '; # first part - $pl=length($p)+1; - while (@line) { - if ((($i=length($j=shift(@line))+1)+$pl)<$len) { - $p.="$j "; $pl+=$i;} - else {unshift(@line,$j); last;} - } - if ($com) { $j=(($i=$C2_ncom-$pl)>1 ? ' ' x $i : ' ' )."#$com";} - else {$j='';} - print C2_OUT "$p$j\n" unless "$p$j"=~/^\s*$/; # print part - $p=' ' x ((($i=$tl+2*$C2_npos)>$C2_nind) ? $i : $C2_nind); #reset - } - while (@C2_com) { ($com=shift(@C2_com))=~s/^#//; # more comment - print C2_OUT (' ' x $C2_ncom)."#$com\n";} -} -# -# Calculate current indentation -# -sub C2_indent { # output indentation - - (' ' x ($C2_ifd+$C2_ford+$C2_labd),$C2_ifd+=$C2_incid, - $C2_ford+=$C2_incfd,$C2_incid=$C2_incfd=0)[0];} -# -# line = Replace \char with proper code (line) -# -sub G_non { - - local($line)=@_; - - while ($line=~s/\\(.)/\@\@n$C2_acnt/) { # isolate \char - $C2_acnt{"n$C2_acnt"}=$1; $C2_acnt++;} - $line;} -# -# line = Replace line with proper code (line) -# -sub G_word { # isolate line - - local($line)=@_; - - $line=~s/^(.*)$/\@\@w$C2_acnt/; - $C2_acnt{"w$C2_acnt"}=$1; $C2_acnt++; - $line;} -# -# line = Replace `` strings with proper code (line) -# -sub G_pipe { # isolate `` strings - - local($line)=@_; - - while ($line=~s/`([^`]*)`/\@\@p$C2_acnt/) { # isolate ` - $C2_acnt{"p$C2_acnt"}=($C2_acnt++,&G_apo($1));} # isolate '," - $line;} -# -# line = Replace '' and "" strings with proper code (line) -# -sub G_apo { # Get apostrophes - - local($line)=@_; - - while ($line=~/(['"])/) { - if ($1 eq '"') { - if ($line=~s/"([^"]*)"/\@\@d$C2_acnt/) { - $C2_acnt{"d$C2_acnt"}=$1; $C2_acnt++;} - else {$line=~s/"/'"'/;} - } - else { - if ($line=~s/'([^']*)'/\@\@s$C2_acnt/) { - $C2_acnt{"s$C2_acnt"}=$1; $C2_acnt++;} - else {$line=~s/'/"'"/;} - } - } - $line; -} # end G_apo -# -# @line=replace () string with proper special code (@line) -# -sub G_paren { # get () - - local(@line)=@_; - local($i,$cnt,$pb)=(0,0,0); - local(@pm); - - for ($i=0;$i<=$#line;$i++) { - if ($line[$i] eq '(') { - $pb=$i unless $cnt; $cnt++;} - elsif ($line[$i] eq ')') { - unless ($cnt) {$cnt++; last;} - $cnt--; - unless ($cnt) { @pm=splice(@line,$pb,$i-$pb+1,"\@\@e$C2_acnt"); - shift(@pm); pop(@pm); $C2_acnt{"e$C2_acnt"}=join(' ',@pm); - $C2_acnt++; $i=$pb;} - } - } - print "Unmatched () in line $C2_cnt:\n@line\n" if $cnt; - @line;} -# -# line=replace ${} or [] string with proper code (line) -# -sub G_sparen { - - local($t)=@_; - local($i,$cnt,$pb,$l,$ps)=(0,0,0,0,0); - local($pm)=(''); - - while ($t=~/\$\{/) { $l=length($t); $pb=index($t,'${'); $cnt=1; - for ($i=$pb+2; $i<=$l; $i++) { - if (substr($t,$i,1) eq '{') { $cnt++;} - elsif (substr($t,$i,1) eq '}') { $cnt--; - unless ($cnt) { $pm=substr($t,$pb+2,$i-$pb-2); - substr($t,$pb,$i-$pb+1)="\@\@c$C2_acnt"; - $C2_acnt{"c$C2_acnt"}=$pm; $C2_acnt++; last;} - } - } - if ($cnt) { print "Unmatched \${} in line $C2_cnt: $t\n"; last;} - } - while ($t=~/\$\w+\[/) { $ps=length($`); $l=length($t); - $pb=$ps+index($&,'['); $cnt=1; - for ($i=$pb+1; $i<=$l; $i++) { - if (substr($t,$i,1) eq '[') { $cnt++;} - elsif (substr($t,$i,1) eq ']') { $cnt--; - unless ($cnt) { $pm=substr($t,$pb+1,$i-$pb-1); - substr($t,$pb,$i-$pb+1)="\@\@q$C2_acnt"; - $C2_acnt{"q$C2_acnt"}=$pm; $C2_acnt++; last;} - } - } - if ($cnt) { print "Unmatched [] in line $C2_cnt: $t\n"; last;} - } - $t; -} -# -# line=replace $name[]:l string with proper code (line) -# -sub G_vname { - - local($t)=@_; - - while ($t=~s/\$[\w<]\w*(\@\@q\d\d\d\d)?(:[a-z])?/\@\@c$C2_acnt/) { - $C2_acnt{"c$C2_acnt"}=substr($&,1); $C2_acnt++;} - $t; -} -# -# string=Obtain a special isolated '"`() string(name) -# -sub G_obtain { - - local($name)=@_; - - delete $C2_acnt{$name};} # get string -# -# string=Get a special isolated '"`() string with '"`()(name) -# -sub G_get { - - local($name)=@_; - local($str,$i); - - $str=delete $C2_acnt{$name}; # get string - if (($i=substr($name,0,1)) eq 'p') { # ` - $str="`$str`";} - elsif ($i eq 's') { - $str="'$str'" unless $str eq '"';} - elsif ($i eq 'd') { - $str="\"$str\"" unless $str eq "'";} - elsif ($i eq 'e') { $str="( $str )";} - elsif ($i eq 'n') { $str="\\$str";} - elsif ($i eq 'w') {} - elsif ($i eq 'c') { $str="\${$str}";} - elsif ($i eq 'q') { $str="[$str]";} - else {$str='';}; - $str;} -# -# line= restore all special '"`() strings with symbols (line) -# -sub G_all { - - local($line)=@_; - local($i); - - while($line=~/\@\@([a-z]\d\d\d\d)/) { - $i=&G_get($1); $line=~s/\@\@([a-z]\d\d\d\d)/$i/;} - $line;} -# -# @line= split into words (line) -# -sub L_word { - - local($line)=@_; - local(@line,@res); - - $line=&G_non($line); # remove all \char - @line=split(' ',$line); # split on blank space - @res=(); # built new - for (@line) { # split ; ( ) < << | || |& - push(@res,split(/([;\(\)]|\$<|<=|<<?|\|[\&\|]?)/));} - @line=(); - for (@res) { # split >... & && - push(@line,split(/(>[=>]?\&?\!?|[^\|]+\&\&?)/));} - @line; -} -# -# file= Make next STDOUT file name (file) -# -sub N_file { - - local($file)=@_; - local(@t); - - if ($file) {@t=reverse(split(//,$file)); $t[0]++; - join('',reverse(@t));} - else {'p$$.tmp00';} -} -# -# Error=Read a line into @C2_line and @C2_com -# -sub R_line { - - local($eod); # << seen - local($line,$i); - - &C_acnt; # reset '"`() cnts - @C2_line=@C2_com=(); # no output -L1: - while (<C2_IN>) { # read lines - chop;$C2_cnt++; @C2_com=(); # count input line; no comments - if (/^\s*#/) {print C2_OUT "$_\n"; next L1;} # full comment line - if (/^\s*$/) {next L1;} # empty line - unless ($C2_nocom) { $C2_nocom=1; # skipped all initial comments - print C2_OUT "#+\n# Preamble\n#\n"; - &P_line(scalar(@C2_com=" check for environment", - 'unless (defined $VMS) {')); $C2_ifd++; - &P_line(scalar(@C2_com=" aid routines unix", - 'if ($ENV{"SHELL"}) {')); $C2_ifd++; - &P_line('unshift(@INC,$ENV{\'n_src\'}.\'/sys\');}'); $C2_ifd--; - &P_line(scalar(@C2_com=" aid routines VMS", - 'else {')); $C2_ifd++; - &P_line('unshift(@INC,\'N_SRC:[SYS]\');}'); $C2_ifd--; - &P_line('unless (require \'c2aid.pls\') {'); $C2_ifd++; - &P_line('print "Fatal: Cannot load c2aid.pls properly"; exit;}'); - $C2_ifd--; - &P_line(scalar(@C2_com=" get environment", - '&ENV_IMPORT;')); - &P_line(scalar(@C2_com=" get command arguments", - '$argv=join(\' \',@ARGV);}'));$C2_ifd--; - if ($C2_mrout) { # main routine - @C2_com=" renew main routine"; - &P_line('if (&ft("e",&fp("r","$0").".csh") &&', - '(&ft("M","$0") > &ft("M","$n_src/sys/csh2p.pls") ||', - '&ft("M","$0") > &ft("M",&fp("r","$0").".csh"))) {'); - $C2_ifd++; - &P_line('$status=&system("perl ".&fnp("$n_src/sys/csh2p.pls")." ".', - '&fp("r","$0"));}'); $C2_ifd--; - } - print C2_OUT "#\n# Start translated script\n#-\n"; - &P_line("sub ${C2_innam}__pls {"); - $C2_labd++; $C2_labdp{$C2_labd}=$C2_ifd+$C2_ford;} - s/\s+$//; # remove trailing blanks - if (($i=chop) eq "\\") { # continuation line - $line.=$_;} # restore state and add line - else { $line.="$_$i"; last L1;} - } - $line=&G_apo(&G_pipe($line)); # isolate '"` - if ($line=~/([^\\\$\{]#)/) { # split off comments - push(@C2_com,&G_all(substr($line,$i=index($line,$1)+1))); - $line=substr($line,0,$i);} - push(@C2_line,&L_word($line)); # make line into words - for ($i=0;$i<=$#C2_line;$i++) { # find if << data - if ($C2_line[$i] eq '<<') { - if (defined $C2_line[$i+1]) { - if ($C2_line[$i+1]=~/^[a-z_A-Z]\w*$/) { - $C2_line[$i+1]=&G_word($C2_line[$i+1]);} # make recognisable - if ($C2_line[$i+1]=~/^\@\@([psdw]\d\d\d\d)$/) { # correct << - $eod=&G_get($1); $C2_tcnt++; # string to recognise - $C2_line[$i+1]=$C2_tcnt; - &P_line("sub C2_t${C2_tcnt}_$C2_innam {"); - $C2_ifd++; # make a subroutine - &P_line('local(*TMP);'); - &P_line('open(TMP,">txt$$.tmp");'); - while ($eod) { # << seen - if ($_=<C2_IN>) { - $C2_cnt++; chop; - if (/^$eod\s*$/) {$eod=''; # end seen - &P_line('close(TMP);'); - &P_line('"txt$$.tmp";}');$C2_ifd--;} # show result - else { - if ($eod=~/^'/) { - &P_line('print TMP ',&MS_word(&G_apo("'$_'")), - '."\n"',$OUT_code);} - elsif ($eod=~/^"/) { - &P_line('print TMP ',&MS_word($_,1),'."\n"', - $OUT_code);} - else { - &P_line('print TMP ',&MS_word(&G_non(&G_pipe($_)),1), - '."\n"',$OUT_code);} - } - } - else { die "unclosed << data at end of file $C2_in";} - } - last;} - } - } - } - scalar(@C2_line=&G_paren(@C2_line)); # result -} -# -# @line= Compile a line (STDOUT,@line) -# -sub DO_line { - - local($DOP_file,@line)=@_; # default STDOUT, input line - local($ps,$pe,$i); - local(@res); # result - - for ($i=0;$i<=$#line;$i++) { # remove empty words - unless ($line[$i] ne '') {splice(@line,$i,1); $i--;} - } - for (@line) { - if ($_ eq ';') { - if ($pe > $ps) { push(@res,&DO_pipe($DOP_file,@line[$ps..$pe-1]));} - $ps=$pe+1;} - $pe++; - } - if ($pe > $ps) { push(@res,&DO_pipe($DOP_file,@line[$ps..$pe-1]));} # result - @res; -} -# -# @line= Compile a pipe (STDOUT,@line) -# -sub DO_pipe { - - local($DOP_file,@line)=@_; # default STDOUT, input pipe - local($IP_file,$OP_file); # in/out redirecting - local($ps,$pe); - local(@res); # result - - $OP_file=$DOP_file; # default STDOUT - if ($C2_goto) { $C2_gotos=1; $C2_goto=0;} # special goto/label handling - else {$C2_gotos=0;} - for (@line) { - if ($_ eq '|' || $_ eq '|&') { - $OP_file=&N_file($OP_file); # next STDOUT - if ($_ eq '|&') {$OP_File="&$OP_file";} - push(@res,&DO_stmt($IP_file,$OP_file,@line[$ps..$pe-1]), - $OUT_code); # get result - $OP_file=~s/^&//; # remove & - $IP_file=$OP_file; # next STDIN - $ps=$pe+1;} - $pe++; - } - if ($pe > $ps) { - push(@res,&DO_stmt($IP_file,$DOP_file,@line[$ps..$pe-1]),$OUT_code);} - @res; -} -# -# @line= Compile a stmt (STDIN,STDOUT,@line) -# -sub DO_stmt { - - local($IP_file,$OP_file,@line)=@_; # default STDIN, STDOUT, stmt - local(@res,$line); # result - local($IN_alias); - local(@t,@q,$i); - -# -# Set correct input/output order -# - if ($#line >= 3 && $line[$#line-1]=~/^</) { - if ($line[$#line-3]=~/^>/) { - local($l1,$l2,$l3,$l4)=(pop(@line),pop(@line),pop(@line),pop(@line)); - push(@line,$l2,$l1,$l4,$l3);} - } -# -# Remove '' around command -# - if ($line[0]=~/^\@\@(s\d\d\d\d)$/) {$line[0]=&G_obtain($1);} -# -# Check for dynamic terms (alias) -# - $line=shift(@line); # command - for(@line) { - if (/\![\*\:]/) { local($t); - push(@res,'&doalias_x('); - while( @line && $line[0]!~/^>/) { - push(@res,$t,&MS_word(shift(@line),1)); $t=',';} - for ($i=0; $i<=$#res; $i++) {$res[$i]=~s/"\$/"\\\$/g;} - if ($IP_file) { push(@res,',',"'<'",',',"\"$IP_file\"");} - if ($OP_file) { push(@res,',',"'>'",',',"\"$OP_file\"");} - push(@res,')',$OUT_code); $IN_alias=1; last;} - } -# -# %set -# - if ($line eq 'set') { local(@t,$i,$val,$name,$t); - for (@line) { push(@t,split(/(=)/));} # isolate = - @line=split(' ',join(' ',@t)); - if ($#line>2 && $line[2] eq '=') { splice(@line,2,2,"@line[2,3]");} - if ($IN_alias) { push(@res,'&set(',&M_inw,',',&M_out,')');} - elsif (! @line) {push(@res,"&set('',".&M_out.")");} # show only - else { - for ($i=0;$i<=$#line;$i++) { # do all settings - if ($line[$i]=~/^\$/) { push(@res,"&set($line[$i])");} - else { $val=''; $name=$line[$i]; - unless ($i < $#line && $line[$i+1] eq '=') {} # empty set - elsif ($i == $#line-1) { $i++;} # no word given - else { $val=$line[$i+2]; $i+=2;} - $t=''; - unless ($val) {push(@res,"\$$name=''");} - elsif ($val=~/^\@\@(e\d\d\d\d)$/) { # list - push(@res,"\$$name="); - for (split(' ',&G_obtain($1))) { - if ($t) { push(@res,$t,&MS_word($_));} - else { push(@res,&MS_word($_)); $t=".' '.";} - } - } - else { - if ($name =~ /^(\w+)\[(.+)\]$/) { local($l1,$l2)=($1,$2); local(@l2); - @l2=&MS_word($l2); - push(@res,"\@$l1=split(' ',\$$l1);", - "splice(\@$l1,",@l2,'-1,1,',&MS_word($val),');', - "\$$l1=join(' ',\@$1);");} - else {push(@res,"\$$name=",&MS_word($val));} - } - } - } - } - @line=(); - } -# -# %setenv -# - elsif ($line eq 'setenv') { local(@l1); - push(@res,"\$$line[0]=",@l1=&MS_word($line[1]),"$OUT_code"); - push(@res,"&ENV_EXPORT(",shift(@line),',',@l1,')'); shift(@line);} -# -# %unset -# - elsif ($line eq 'unset') { - while ($i=shift(@line)) { - if ($i=~/^\$/) { - push(@res,"eval(\"undef \\\$$i\")",$OUT_code);} - else { push(@res,"undef \$$i",$OUT_code);} - } - } -# -# %@ -# - elsif ($line eq '@') { - $i=shift(@line); shift(@line); - push(@res,"\$$i=",&M_exp(join(' ',splice(@line,0))));} -# -# %if -# - elsif ($line eq 'if') { - push(@res,'if (',&M_exp(&G_obtain(substr(shift(@line),2,5))),') {'); - if ($line[0] eq 'then') { shift(@line); $C2_incid++;} - else { - push(@res,&DO_stmt($IP_file,$OP_file,@line),$OUT_code,'}'); - @line=();} - } -# -# %else -# - elsif ($line eq 'else') { - $C2_ifd--; &P_line('}'); $C2_incid++; - if ($line[0] eq 'if') { shift(@line); - push(@res,'elsif (',&M_exp(&G_obtain(substr(shift(@line),2,5))),') {'); - shift(@line);} - else { push(@res,'else {');} - } -# -# %endif -# - elsif ($line eq 'endif') { - $C2_ifd--; push(@res,'}');} -# -# %while -# - elsif ($line eq 'while') { $C2_incfd++; - push(@res,'while (',&M_exp(&G_obtain(substr(shift(@line),2,5))),') {');} -# -# %foreach -# - elsif ($line eq 'foreach') { $C2_incfd++; - $i=shift(@line); - push(@res,"for \$${i}__x (split(' ',join(' '"); - @line=split(' ',&G_obtain(substr(shift(@line),2,5))); - while (@line) { push(@res,',',&MS_word(shift(@line)));} - push(@res,'))) {',"\$$i=\$${i}__x");} -# -# % break -# - elsif ($line eq 'break') { - push(@res,'last');} -# -# % continue -# - elsif ($line eq 'continue') { - push(@res,'next');} -# -# %end -# - elsif ($line eq 'end') { $C2_ford--; - push(@res,'}');} -# -# %label -# - elsif ($line=~s/:$//) { - unless ($C2_gotos) { - push(@res,"&${line}_$C2_innam",$OUT_code); &P_line(@res); @res=();} - push(@res,'sub ',"${line}_$C2_innam",'{'); &P_line(@res); @res=(); - $C2_labd++; $C2_labdp{$C2_labd}=$C2_ifd+$C2_ford; - push(@res,&DO_stmt($IP_file,$OP_file,@line)); - } -# -# %goto -# - elsif ($line eq 'goto') { $C2_goto++; # set seen - push(@res,'&'.shift(@line)."_$C2_innam");} -# -# %onintr -# - elsif ($line eq 'onintr') { - push(@res,"\$SIG{'INT'}=",shift(@line)."_$C2_innam");} -# -# %alias -# - elsif ($line eq 'alias') { - local($l1)=(shift(@line)); # name - local(@l2)=&M_inw; # value - local($l2)=eval("@l2"); - local($l3)=(&M_out); # output - local(@C2_line); # to compile - $l2=~s/\\([\!])/\1/g; # remove \ from ! - unless ($l2) { push(@res,"&alias(","'$l1','',","$l3)");} - else { local(@t); - push(@C2_line,&L_word(&G_apo(&G_pipe($l2)))); # make proper line - @t=&P_strip(&DO_line($OP_file,@C2_line)); # compiled line - push(@res,"&alias(","'$l1',"); # and save - for (@t) { - s/'/\\'/g; push(@res,"'$_'.");} - push(@res,"'',","$l3)");} - $C2_alias{$l1}=1; # set seen - } -# -# %unalias -# - elsif ($line eq 'unalias') { - local($l1)=(shift(@line)); # name - push(@res,"&unalias('$l1')");} -# -# %shift -# - elsif ($line eq 'shift') { local($l1)=(shift(@line)); - $l1='argv' unless $l1; - push(@res,"\@$l1=split(' ',\$$l1)",$OUT_code); - push(@res,"shift(\@$l1)",$OUT_code); - push(@res,"\$$l1=join(' ',\@$l1)");} -# -# %source -# - elsif ($line eq 'source') { - push(@res,'&source(',&MS_word(shift(@line)),')');} -# -# %commands -# - elsif ($C2_cmd{$line} || $line=~s/^\/usr\/bin\/tr$/tr/) { - local(@t)=split(//,$C2_cmd{$line}); push(@res,"&$line("); - for (@t) { push(@res,eval("&$C2_cmode{$_}"),',');} - push(@res,')');} -# -# %alias seen -# - elsif ($C2_alias{$line}) { - push(@res,"&doalias('$line'"); - while(@line) { - push(@res,',',&MS_word(shift(@line)));} - push(@res,')'); - } -# -# %.csh -# - elsif ($line=~/\.csh$/) { - push(@res,'&docsh(',&MS_word($line),',',&M_in,',',&M_out,')');} -# -# %.exe -# - elsif ($line=~/\.exe$/) { - push(@res,'&doexe(',&MS_word($line),',',&M_in,',',&M_out,')');} -# -# %$ -# - elsif ($line=~s/^\$//) { - push(@res,"&dollar(\"$line\"",',',&M_in,',',&M_out,')');} -# -# %() -# - elsif ($line=~/\@\@(e\d\d\d\d)$/) { local($l1)=(&G_obtain($1)); - local(@l3)=(&G_paren(&L_word($l1))); - push(@res,&DO_line($OP_file,@l3));} -# -# %alias assumed -# - elsif ($line) { - push(@res,"&doalias('$line'"); - while(@line) { - push(@res,',',&MS_word(shift(@line)));} - push(@res,')'); - } -# -# %Unknown -# - if (@line) { push(@C2_com,"### @line"); - print "Error: line $C2_cnt containes uncompiled part:\n", - "@line\n";} - @res; -} -# -# Make proper parts of a statement -# -# Make output file name from @line -# -sub M_out { - - local(@res); - - if (&M_hist('out')) {} - elsif ( @line && $line[0]=~/^>(.*)$/) { shift(@line); - $1=~s/\!$//; - push(@res,"'$1'.",&MS_word(shift(@line)));} - if (@res) {@res;} - else {@res="\"$OP_file\"";} -} -# -# Make input file names from @line -# -sub M_in { - - local(@res,$t); - - if (&M_hist('in')) { } - else { - while( @line && $line[0]!~/^>/) { - if ($line[0] eq '<<') { shift(@line); shift(@line); - push(@res,$t,"&C2_t${C2_tcnt}_$C2_innam");} - elsif ($line[0] eq '<') { shift(@line); - push(@res,$t,&MS_word(shift(@line)));} - else { push(@res,$t,&MS_word(shift(@line)));} - $t=".' '.";} - } - if (@res) {@res;} - else {@res="\"$IP_file\"";} -} -# -# Make input term from @line -# -sub M_int { - - local(@res); - - if (&M_hist('int')) { } - elsif( @line && $line[0]!~/^[<>]/) { - push(@res,&MS_word(shift(@line)));} - if (@res) {@res;} - else {"''";} -} -# -# Make input word list from @line -# -sub M_inw { - - local(@res,$t); - - if (&M_hist('inw')) { } - else { - while( @line && $line[0]!~/^[<>]/) { - push(@res,$t,&MS_word(shift(@line))); $t=".' '.";} - } - if (@res) {@res;} - else {"''";} -} -# -# Make switch list from @line -# -sub M_sw { - - local(@res); - - if (&M_hist('sw')) { @res;} - else { - while ($line[0]=~/^[\-\+]/) {push(@res,shift(@line));} - if (@res) { '"'.join(' ',@res).'"';} - else {"''";} - } -} -# -# Make field from @line -# -sub M_inf { - - local(@res); - - if (&M_hist('inf')) { @res;} - else { - if (@line && $line[0]!~/^[<>]/) { push(@res,shift(@line));} - if (@res) { '"'.join(' ',@res).'"';} - else {"''";} - } -} -# -# Make a history reference -# -sub M_hist { - - local($n,$t)=@_; - - if ($IN_alias) { push(@res,"&D_input('$n')"); 1;} - else {0;} -} -# -# Make a single term -# -sub MS_term { - - local($t,$nog)=@_; - local($l1,$l2,@l3,@res,$lval); - - $t=~s/\${?([1-9])}?/\$argv\[\1\]/g; # cater for $n - $t=&G_sparen($t); # isolate ${}, [] - if ($t =~ /^\$<$/) { # $< - push(@res,'($_=scalar(<STDIN>),','chop,','$_)');} - elsif ($t =~ /^\$0$/) { # $0 - push(@res,'$0');} - elsif ($t =~ /^\$\$$/) { # $$ - push(@res,'$$');} - elsif ($t =~ /^\$\*$/) { # $* - push(@res,'join(" ",@argv)');} - elsif ($t =~ /^\$#(\w+)$/) { # $# - $lval='d'; push(@res,"&vn(\$$1)");} - elsif ($t =~ /^\$\?(\w+)$/) { # $? - push(@res,"defined(\$$1)");} - elsif ($t =~ /^\$(\w+)$/) { # $name - push(@res,"\$$1");} - elsif ($t =~ /^0\d+$/) { # 0d.. - $lval='d'; push(@res,"\"$t\"");} - elsif ($t =~ /^[\-\+]?\d+$/) { # +-d... - $lval='d'; push(@res,"$t");} - elsif ($t =~ /^\$(\w+)(\@\@q\d\d\d\d)?:([a-z])$/) { # $...:l - push(@res,"&fp('$3',",&MS_term("\$$1$2",$nog),')');} - elsif ($t =~ /^\@\@(c\d\d\d\d)$/) { # ${name...} - push(@res,&MS_term('$'.&G_obtain($1),$nog));} - elsif ($t =~ /^\$(\w+)\@\@(q\d\d\d\d)$/) { # $name[] - ($l1,$l2)=($1,&G_obtain($2)); - @l3=split(/(\-)/,$l2); - push(@res,"(split(' ',\$$l1))","[",&MS_term($l3[0],$nog),'-1'); - if ($l3[1] eq '-') { push(@res,'..'); - if ($l3[2]) { push(@res,&MS_term($l3[2],$nog).'-1');} - else { push(@res,"&vn(\$$l1)-1");} - } - push(@res,']');} - elsif ($t =~ /^\@\@(p\d\d\d\d)$/) { # `` - $OUT_code=','; # indicate - $l1=&G_obtain($1); # get code - @l3=&G_paren(&L_word($l1)); # break up in words, () - push(@res,'&Pipe("'.&N_file($OP_file).'",', - &DO_line(&N_file($OP_file),@l3)); - pop(@res); push(@res,')'); # finish code - $OUT_code=';';} # reset - else { # other - push(@res,&MS_word($t,$nog));} - $dval='' unless $lval; @res; -} -# -# Make a single word -# -sub MS_word { - - local($t,$nog)=@_; - local($l1,$l2,$q,@res); - - $t=&G_sparen($t); # isolate ${}, [] - if ($t=~/\$</) { $nog=1;} # no globbing - $t=&G_vname($t); # isolate variable names - $t=~s/"/\\"/g; # make sure no single " - while ($t=~/\@\@(n\d\d\d\d)/) { # restore \ - if ($nog || $C2_acnt{$1} eq '$') { - $t=~s/\@\@(n\d\d\d\d)/\\$C2_acnt{\1}/;} # restore \ - else { - $t=~s/\@\@(n\d\d\d\d)/$C2_acnt{\1}/g;} # restore \ char - } - if ($t=~/\@\@([sdp]\d\d\d\d)/) { $nog=1;} # no globbing - while ($t=~/\@\@([a-z]\d\d\d\d)/) { # scan string - ($l1,$l2,$t)=($1,$&,$'); # save remainder - if ($`) { $`=~s/\\$/\\\\/; push(@res,"$q\"$`\""); $q='.';} - if ($l1=~/^d/) { push(@res,$q,&MS_word(&G_obtain($l1),$nog));} - elsif ($l1=~/^s/) { local($t)=&G_obtain($l1); - while (length($t)>$C2_nstr) { - push(@res,"$q'".substr($t,0,$C2_nstr)."'"); - $t=substr($t,$C2_nstr); $q='.';} - push(@res,"$q'".substr($t,0,$C2_nstr)."'"); - } - elsif ($l1=~/^c/) { push(@res,$q,&MS_term($l2,$nog));} - elsif ($l1=~/^p/) { push(@res,$q,&MS_term($l2,$nog));} - if (@res) {$q='.';} - } - if ($t) { $t=~s/\\$/\\\\/; - while (length($t)>$C2_nstr) { - push(@res,"$q\"".substr($t,0,$C2_nstr).'"'); - $t=substr($t,$C2_nstr); $q='.';} - push(@res,"$q\"".substr($t,0,$C2_nstr).'"'); - } - push(@res,"''") unless @res; - if (@res && !$nog && "@res"=~/[^\\]?\$|[\*\?]/) { - unshift(@res,'&fn('); push(@res,')');} - @res; -} -# -# Make an expression -# -sub M_exp { - - local($t)=@_; - local($dval)='d'; - local($l1,$l2,@l3,@l4,@l5,@res); - - @l3=(&G_paren(&L_word($t))); # make separate items - for (@l3) { # split | || & && > >> >= - # < <= << ! !~ != == =~ % - push(@l4,split(/(\|\|?)|(\&\&?)|(<[<=]?)|(>[>=]?)/));} - @l3=@l4; @l4=(); - for (@l3) { - push(@l4,split(/(\![\~=]?)|(=[=\~])|([%])/));} - @l4=split(' ',join(' ',@l4)); - while (@l4) { - if ($l4[0] eq '{') { local(@l3,$i); shift(@l4); - if (pop(@l4) ne '}') { - print "Expression syntax error in $C2_cnt:\n\t$t\n";} - else { push(@res,'$status=system(',&MS_term("@l4",1),')/256');} - @l4=();} - elsif ($l4[0] eq '!') { shift(@l4); push(@res,'!');} # ! - elsif ($l4[0] eq '~') { shift(@l4); push(@res,'~');} # ~ - elsif ($l4[0]=~/^\-([a-z])$/) { shift(@l4); # -l - push(@res,"&ft('$1',",&MS_term(shift(@l4),1),')');} - else { - if (($l1=shift(@l4)) eq '&&' || $l1 eq '||') { push(@res,$l1);} - else { - if ($l1=~/^\@\@(e\d\d\d\d)$/) { # first term - @l5=('(',&M_exp(&G_obtain($1)),')');} - else { @l5=(&MS_term($l1,1));} - unless (@l4) { push(@res,@l5);} - elsif (($l2=shift(@l4)) eq '&&' || $l2 eq '||') { - push(@res,@l5); unshift(@l4,$l2);} - else { - if (!@l4) { - print "Expression syntax error in $C2_cnt:\n\t$t\n";} - else { - if (($l1=shift(@l4))=~/^\@\@(e\d\d\d\d)$/) { - @l3=('(',&M_exp(&G_obtain($1)),')');} - else { @l3=(&MS_term($l1,1));} - if ($l2 eq '==' && !$dval) { - push(@res,'&eq(',@l5,',',@l3,')');} - elsif ($l2 eq '!=' && !$dval) { - push(@res,'!&eq(',@l5,',',@l3,')');} - elsif ($l2 eq '=~') {push(@res,'&peq(',@l5,',',@l3,')');} - elsif ($l2 eq '!~') {push(@res,'!&peq(',@l5,',',@l3,')');} - else { push(@res,@l5,$l2,@l3);} - } - } - } - } - } - @res; -} -1; # require correct code diff --git a/src/sys/data_splitter.kwa b/src/sys/data_splitter.kwa deleted file mode 100644 index 035024983490c0f86b7c82c3a8fd6b034b72f855..0000000000000000000000000000000000000000 --- a/src/sys/data_splitter.kwa +++ /dev/null @@ -1,46 +0,0 @@ -BEGIN { - loop = 0; - start = 0; - concat = 0; - save = 0; -} - -{ - noprint = 0; - if ($1 == "BLOCK" && $2 == "DATA") { - start = 1; - } - -# if(save == 1) { -# printf ("start: %i concat: %i $1: %s\n", start,concat,$1); -# save=0; -# } - - if (start == 1 && concat == 1 && $1 == "&") { - buffer[loop++] = $0; - noprint = 1; - } else { - concat = 0; - } - - if (start == 1 && $1 == "DATA") { -# if ($2 == "POLNAM") { -# save = 1; -# } - buffer[loop++] = $0; - concat = 1; - } else if (start == 1 && $1 == "END" ) { - for (i=0; i<=loop; i++) { - printf ("%s\n",buffer[i]); - } - start=0; - printf ("%s\n",$0); - } else { - if ( noprint == 0) { - printf ("%s\n",$0); - } - } -} - -END { -} diff --git a/src/sys/database.idx b/src/sys/database.idx deleted file mode 100644 index 6f95ac7ceda539fda5794748f52a3fffe75e7c4e..0000000000000000000000000000000000000000 --- a/src/sys/database.idx +++ /dev/null @@ -1,1395 +0,0 @@ -+batch/srt.grp 434 34780 940509 -+batch/profile.par 6480 447250 940623 -+batch/init_batch.csh 2475 187294 940721 -+batch/wsrt_check.csh 2633 204532 940623 -+batch/full_check.csh 3119 251036 940509 -+batch/load_data.csh 2501 201265 940721 -+batch/make_map.csh 1161 89348 940721 -+batch/make_mos.csh 1886 144795 940721 -+batch/self_cal.csh 1133 90156 940509 -+batch/eval_cal.csh 1094 86421 940509 -+data/cal.grp 492 30937 960422 -+data/readme.txt 4102 357669 010522 -+data/1127-145_21cm.mdl -b 856 17983 951205 -+data/3c286_21cm.mdl -b 744 13044 930922 -+data/3c295_21cm.mdl -b 968 26845 951205 -+data/3c147_21cm.mdl -b 1136 21634 930922 -+data/3c48_49cm.mdl -b 1920 40188 930922 -+data/3c147_49cm.mdl -b 1248 29078 930922 -+data/3c286_49cm.mdl -b 1976 40607 930922 -+data/3c295_92cm.mdl -b 7576 198634 951205 -+data/3c48_6cm.mdl -b 688 12163 031230 -+data/3c147_6cm.mdl -b 912 12744 930922 -+data/3c286_6cm.mdl -b 856 14289 031229 -+data/3c345_92cm.mdl -b 6848 194775 951205 -+data/3c48_92cm.mdl -b 7576 205217 951205 -+data/3c147_92cm.mdl -b 7576 202842 951205 -+data/3c286_92cm.mdl -b 7576 201440 951205 -+data/3c48_21cm.mdl -b 912 16748 930922 -+doc/doc.grp 10559 953251 960520 -+doc/anchors.idx 513 44094 010522 -+doc/latex2html.pls 402 32089 940720 -+doc/newstar.hun -b 3763490 441428727 970613 -+doc/nnews.hlp 42477 3360672 000929 -+doc/fig/basic_functions.cap 343 31839 951205 -+doc/fig/basic_functions.fig 6514 302022 951205 -+doc/fig/clean_vs_find.cap 879 79239 951205 -+doc/fig/clean_vs_find.fig 4531 212724 951205 -+doc/fig/doc_sources_and_hyper.fig 5188 259680 960513 -+doc/fig/doc_sources_and_hyper.cap 884 81333 960513 -+doc/fig/doc_sources_and_print.fig 4323 215708 960502 -+doc/fig/doc_sources_and_print.cap 653 60848 960502 -+doc/fig/dwarf_interface.fig 4926 234949 951205 -+doc/fig/dwarf_interface.cap 715 66223 951205 -+doc/fig/error_model.fig 13300 631418 951205 -+doc/fig/error_model.cap 566 52021 951205 -+doc/fig/general_index.fig 3583 161103 951205 -+doc/fig/model_update.cap 837 78023 951205 -+doc/fig/model_update.fig 5777 278783 951205 -+doc/fig/mosaic_sectors.cap 497 45864 951205 -+doc/fig/mosaic_sectors.fig 2567 116280 951205 -+doc/fig/natnf_interface.cap 157 14607 951205 -+doc/fig/dummy_figure.fig 215 11781 951205 -+doc/fig/ncalib_3c48.fig 301 19635 951205 -+doc/fig/ncalib_3c48.cap 2192 191159 951205 -+doc/fig/ncalib_interface.cap 160 14866 951205 -+doc/fig/ncopy_interface.cap 157 14679 951205 -+doc/fig/ngf_scn_indices.fig 2455 122833 951205 -+doc/fig/ncalib_matrix.cap 1219 112440 951205 -+doc/fig/ncalib_scan.fig 301 19635 951205 -+doc/fig/ncalib_scan.cap 2451 223173 951205 -+doc/fig/ncalib_vispace.fig 301 19933 951205 -+doc/fig/ncalib_vispace.cap 1287 120997 951205 -+doc/fig/nclean_interface.fig 8651 443860 951205 -+doc/fig/nclean_interface.cap 160 14898 951205 -+doc/fig/newstar_overview.fig 8515 393345 951205 -+doc/fig/newstar_overview.cap 489 45562 951205 -+doc/fig/nflag_interface.cap 154 14215 950220 -+doc/fig/nflag_flag.fig 8821 419635 951205 -+doc/fig/nflag_flag.cap 829 77137 951205 -+doc/fig/nflag_gids.fig 3111 144189 951205 -+doc/fig/nflag_gids.cap 474 42752 951205 -+doc/fig/nflag_inspect.fig 2850 144258 951205 -+doc/fig/nflag_inspect.cap 394 36281 951205 -+doc/fig/nflag_mode.fig 8821 419635 951205 -+doc/fig/nflag_operate.fig 9125 436574 951205 -+doc/fig/nflag_operate.cap 291 27002 951205 -+doc/fig/nflag_statist.fig 2196 113691 951205 -+doc/fig/nflag_statist.cap 332 31199 951205 -+doc/fig/ngcalc_display.fig 9254 437125 951205 -+doc/fig/ngcalc_extract.fig 5583 266054 951205 -+doc/fig/ngcalc_interface.cap 728 67922 951205 -+doc/fig/ngcalc_interface.fig 9973 488621 951205 -+doc/fig/ngids_interface.cap 157 14599 951205 -+doc/fig/ngf_scn_indices.cap 407 37150 951205 -+doc/fig/nhyper_overview.fig 3784 181704 951205 -+doc/fig/nmap_handle.fig 1553 78514 951205 -+doc/fig/nmap_handle.cap 150 14018 951205 -+doc/fig/nmap_interface.cap 1342 122318 950220 -+doc/fig/nmap_interface.fig 6534 329805 951205 -+doc/fig/nmap_make.fig 7058 364941 951205 -+doc/fig/nmap_make.cap 412 37349 951205 -+doc/fig/nmap_make_q.fig 8444 429426 951205 -+doc/fig/nmap_make_q.cap 397 36314 951205 -+doc/fig/nmodel_convert.fig 3238 170467 951205 -+doc/fig/nmodel_convert.cap 363 32818 951205 -+doc/fig/nmodel_handle.fig 15203 759888 951205 -+doc/fig/nmodel_handle.cap 442 39664 951205 -+doc/fig/nmodel_interface.fig 10998 551741 951205 -+doc/fig/nmodel_interface.cap 302 28351 951205 -+doc/fig/nplot_interface.cap 157 14695 951205 -+doc/fig/nscan_interface.cap 157 14591 951205 -+doc/fig/scn_contents.fig 1146 54958 951205 -+doc/fig/scn_contents.cap 900 80712 951205 -+doc/fig/scn_hierarchy.cap 248 23191 951205 -+doc/fig/scn_hierarchy.fig 6048 275951 951205 -+doc/fig/scn_indices.cap 601 54446 951205 -+doc/fig/scn_indices.fig 1406 70421 951205 -+doc/fig/scn_sector.fig 2137 96292 951205 -+doc/fig/scn_sector.cap 790 71897 951205 -+doc/fig/scn_sets.cap 1070 94334 951205 -+doc/fig/scn_wmp_indices.fig 2728 136510 951205 -+doc/fig/wsrt_layout.fig 68399 2970926 951205 -+doc/fig/wsrt_layout.cap 2079 174476 951205 -+doc/html/homepage.html 1934 164839 010522 -+doc/html/nfra_config_management.html 27233 2155379 010522 -+doc/html/elsewhere_inst_maint.html 15240 1331549 010522 -+doc/latex/hb_cook_preamble.sty 2629 241625 951205 -+doc/latex/hb_print_preamble.sty 3473 315801 951205 -+doc/latex/hb_symbols.sty 1699 147933 940707 -+doc/latex/html.sty 5514 479725 940721 -+doc/latex/bibliography.tex 2007 159169 940707 -+doc/latex/common_descr.tex 12796 1080775 940707 -+doc/latex/doc_guide.tex 30594 2653157 960513 -+doc/latex/doc_release9511.tex 3310 302576 960130 -+doc/latex/file_indexing.tex 10377 918046 960422 -+doc/latex/files_descr.tex 22584 1858109 940928 -+doc/latex/files_handle.tex 22634 1859722 950220 -+doc/latex/introduction.tex 24576 2235287 951205 -+doc/latex/hb_contents.tex 9961 873743 960502 -+doc/latex/lsq.tex 51971 4605571 951205 -+doc/latex/mdl_descr.tex 9717 811496 950714 -+doc/latex/models_descr.tex 9753 884881 951205 -+doc/latex/mongo_graphics.tex 2046 171867 940928 -+doc/latex/ncalib_descr.tex 10160 859771 951205 -+doc/latex/ncalib_polar.tex 49535 3652272 951205 -+doc/latex/ncalib_redun.tex 13459 1145731 960813 -+doc/latex/nclean_descr.tex 11711 1068775 951205 -+doc/latex/ncopy_descr.tex 3596 318289 940821 -+doc/latex/nflag_descr.tex 30129 2615806 951205 -+doc/latex/ngcalc_descr.tex 8743 766466 960520 -+doc/latex/ngids_descr.tex 3167 277193 951205 -+doc/latex/make_model.tex 9736 897581 950220 -+doc/latex/nmap_descr.tex 10943 925122 951205 -+doc/latex/nmap_example.tex 270 21698 940707 -+doc/latex/nmodel_descr.tex 379 34208 951205 -+doc/latex/nplot_descr.tex 7083 568160 960502 -+doc/latex/nscan_descr.tex 4894 387666 941019 -+doc/latex/people.tex 2858 212744 010522 -+doc/latex/plate_measure.tex 12354 1111822 940928 -+doc/latex/rcp_batch_processing.tex 1952 157202 950220 -+doc/latex/rcp_circ_polarisation.tex 1664 137822 950220 -+doc/latex/rcp_continuum_21cm.tex 2466 192059 950220 -+doc/latex/rcp_dynamic_range.tex 120 9904 940707 -+doc/latex/rcp_external_calibrators.tex 129 11038 940707 -+doc/latex/rcp_line_21cm.tex 18997 1652139 940928 -+doc/latex/rcp_linear_polarisation.tex 12632 1104984 960502 -+doc/latex/rcp_mosaic_21cm.tex 8739 758024 950220 -+doc/latex/rcp_mosaic_92cm.tex 118 9485 940707 -+doc/latex/rcp_old_data.tex 122 9404 940707 -+doc/latex/rcp_pulsar_imaging.tex 117 9746 940707 -+doc/latex/rcp_read_data.tex 1079 85755 950220 -+doc/latex/rcp_simulated_data.tex 120 9915 940707 -+doc/latex/rcp_spectral_dr.tex 127 10576 940707 -+doc/latex/rcp_uvfits_output.tex 134 11156 940707 -+doc/latex/rcp_variability.tex 111 9229 940707 -+doc/latex/rcp_very_old_data.tex 126 9939 940707 -+doc/latex/record_replay.tex 5921 522227 960422 -+doc/latex/scn_file.tex 15271 1357420 960520 -+doc/latex/scn_summary.tef 1519 139427 950222 -+doc/latex/selected_papers.tex 1294 101082 940928 -+doc/latex/show_edit.tex 25554 1863676 941019 -+doc/latex/wmp_descr.tex 7201 590874 950714 -+doc/latex/wsrt_fact_sheet.tex 3611 319798 940928 -+doc/intfc/dwarf_private_intfc.tex 259 24472 950220 -+doc/intfc/dwarf_private_keys.tef 6531 596224 970613 -+doc/intfc/flfnode_public_intfc.tex 1407 131264 950220 -+doc/intfc/flfnode_public_keys.tef 1 10 000922 -+doc/intfc/global_private_intfc.tex 259 24457 950220 -+doc/intfc/global_private_keys.tef 2062 186789 970613 -+doc/intfc/mdlnode_public_intfc.tex 1404 131188 950714 -+doc/intfc/mdlnode_public_keys.tef 1603 142966 970613 -+doc/intfc/natnf_private_intfc.tex 1031 96460 950220 -+doc/intfc/natnf_private_keys.tef 202 18980 000922 -+doc/intfc/ncalib_private_intfc.tex 1037 96933 941115 -+doc/intfc/ncalib_private_keys.tef 203 19062 000922 -+doc/intfc/nclean_private_intfc.tex 1037 96989 951205 -+doc/intfc/nclean_private_keys.tef 15523 1403633 970613 -+doc/intfc/ncopy_private_intfc.tex 1030 96549 941115 -+doc/intfc/ncopy_private_keys.tef 2954 264322 970613 -+doc/latex/ncopy_progrmr.tex 8742 769342 950222 -+doc/intfc/nfilt_private_intfc.tex 1030 96444 950220 -+doc/intfc/nfilt_private_keys.tef 202 18986 000922 -+doc/intfc/nflag_private_intfc.tex 1032 96382 950220 -+doc/intfc/nflag_private_keys.tef 202 18965 000922 -+doc/intfc/ngcalc_private_intfc.tex 1027 96563 941115 -+doc/intfc/ngcalc_private_keys.tef 19807 1707635 970613 -+doc/intfc/ngen_private_intfc.tex 1023 95710 941115 -+doc/intfc/ngen_public_intfc.tex 1383 129175 950714 -+doc/intfc/ngen_public_keys.tef 1 10 000922 -+doc/intfc/ngfsets_public_intfc.tex 1404 131349 950714 -+doc/intfc/ngfsets_public_keys.tef 14052 1202532 970613 -+doc/intfc/ngids_private_intfc.tex 1031 96446 950220 -+doc/intfc/ngids_private_keys.tef 10791 962538 970613 -+doc/intfc/nmap_private_intfc.tex 1990 183993 951205 -+doc/intfc/nmap_private_keys.tef 40137 3565861 970613 -+doc/intfc/nmap_public_intfc.tex 1731 157240 960502 -+doc/intfc/nmap_public_keys.tef 6646 598288 970613 -+doc/intfc/nmodel_private_intfc.tex 1037 97087 941115 -+doc/intfc/nmodel_private_keys.tef 203 19084 000922 -+doc/intfc/nmodel_public_intfc.tex 1307 120988 950220 -+doc/intfc/nmodel_public_keys.tef 1 10 000922 -+doc/intfc/nplot_private_intfc.tex 1030 96577 941115 -+doc/intfc/nplot_private_keys.tef 26442 2322019 970613 -+doc/intfc/nscan_private_intfc.tex 1030 96395 941115 -+doc/intfc/nscan_private_keys.tef 202 18976 000922 -+doc/intfc/nshow_public_intfc.tex 1390 130056 950714 -+doc/intfc/nshow_public_keys.tef 1 10 000922 -+doc/intfc/plotter_public_intfc.tex 1404 131439 951205 -+doc/intfc/plotter_public_keys.tef 1778 146691 970613 -+doc/intfc/scnnode_public_intfc.tex 1406 131301 950714 -+doc/intfc/scnnode_public_keys.tef 1 10 000922 -+doc/intfc/scnsets_public_intfc.tex 1404 131412 950714 -+doc/intfc/scnsets_public_keys.tef 1 10 000922 -+doc/intfc/select_public_intfc.tex 1397 130559 950714 -+doc/intfc/select_public_keys.tef 1 10 000922 -+doc/intfc/unit_public_intfc.tex 1383 129343 950714 -+doc/intfc/unit_public_keys.tef 5799 505419 970613 -+doc/intfc/wmpnode_public_intfc.tex 1404 131349 950714 -+doc/intfc/wmpnode_public_keys.tef 1549 141183 970613 -+doc/intfc/wmpsets_public_intfc.tex 1404 131524 950714 -+doc/intfc/wmpsets_public_keys.tef 13642 1170265 970613 -+doc/txt/batch.txt 11619 950605 010522 -+doc/txt/bug_reports.txt 16521 1383213 940707 -+doc/txt/calibr_models.txt 2449 211947 010522 -+doc/txt/control_c.txt 1067 72644 960626 -+doc/txt/copyright.txt 8172 616783 010522 -+doc/txt/debug_efficiently.txt 1662 149283 950220 -+doc/txt/doc_organisation.txt 29351 2245502 940707 -+doc/txt/dwcalc.txt 7993 674911 940928 -+doc/txt/memos.txt 5247 434119 940707 -+doc/txt/models_and_maps.txt 3563 288965 940707 -+doc/txt/more_on_batch.txt 5006 403852 940707 -+doc/txt/ncalib_vzero.txt 3242 258417 960422 -+doc/txt/ngcalc_lightcurve.txt 4138 355848 960422 -+doc/txt/obscure_bugs.txt 937 80789 941110 -+doc/txt/ppd_buffer.txt 1551 117207 941110 -+doc/txt/psc_guide.txt 12960 1074961 950220 -+doc/txt/psctest.txt 2062 176369 950309 -+doc/txt/qube.txt 8116 669756 940821 -+doc/txt/remote_tape.txt 2511 210290 010522 -+doc/txt/spefu_type_categ.txt 2140 147797 940928 -+doc/txt/wndpoh.txt 7058 622145 941115 -+doc/txt/wntinc.txt 17709 1463535 950220 -+doc/txt/xmosaic_restart.txt 1605 136139 950220 -+doc/bin/agb.gif -b 14854 1756584 940707 -+doc/bin/alpha_32_64.ps -b 32342 2443574 940707 -+doc/bin/alpha_portability.ps -b 56949 4124965 940707 -+doc/bin/cmv.gif -b 9089 1061127 940719 -+doc/bin/hjv.gif -b 22018 2603431 940707 -+doc/bin/jen.gif -b 13450 1581985 940707 -+doc/bin/jph.gif -b 18651 2163771 940707 -+doc/bin/newstar.gif -b 3187 409822 940707 -+doc/bin/scn_sets.ps -b 1247 101577 950220 -+doc/bin/wnb.gif -b 8669 956529 940613 -+doc/bin/wsrt.gif -b 205443 22891764 940707 -+doc/icons/anchor.xbm -b 293 19937 960423 -+doc/icons/blank.xbm -b 49 3084 960423 -+doc/icons/contents.xbm -b 744 48630 960423 -+doc/icons/contents_motif.gif -b 217 25948 960423 -+doc/icons/cross-ref.xbm -b 302 21411 960423 -+doc/icons/cross_ref_motif.gif -b 70 5888 960423 -+doc/icons/foot.xbm -b 287 19279 960423 -+doc/icons/foot_motif.gif -b 79 7449 960423 -+doc/icons/icons.fig -b 1377 62767 940712 -+doc/icons/icons.html -b 337 24375 940712 -+doc/icons/index.xbm -b 571 37471 960423 -+doc/icons/index_motif.gif -b 172 20898 960423 -+doc/icons/invis_anchor.xbm -b 97 8786 960423 -+doc/icons/latex2html.xbm -b 1041 72145 960423 -+doc/icons/next.xbm -b 287 19858 960423 -+doc/icons/next_group_motif.gif -b 251 31094 960423 -+doc/icons/next_group_motif_gr.gif -b 251 31393 960423 -+doc/icons/next_motif.gif -b 164 19224 960423 -+doc/icons/next_motif_gr.gif -b 164 19523 960423 -+doc/icons/next_page.xbm -b 829 54157 960423 -+doc/icons/previous.xbm -b 299 21332 960423 -+doc/icons/previous_group_motif.gif -b 295 36283 960423 -+doc/icons/previous_group_motif_gr.gif -b 295 36582 960423 -+doc/icons/previous_motif.gif -b 212 25360 960423 -+doc/icons/previous_motif_gr.gif -b 212 25659 960423 -+doc/icons/previous_page.xbm -b 1169 75743 960423 -+doc/icons/up.xbm -b 281 19365 960423 -+doc/icons/up_motif.gif -b 137 15881 960423 -+doc/icons/up_motif_gr.gif -b 137 16180 960423 -+dwarf/abp.grp 835 54499 940202 -+dwarf/abpx_ncalib.for 4717 331335 940202 ! @wng.def @dwc.def -+dwarf/abpx_nclean.for 4759 330686 940202 ! @wng.def @dwc.def -+dwarf/abpx_nflag.for 4023 292757 940202 ! @wng.def @dwc.def -+dwarf/abpx_nmap.for 5645 384154 940202 ! @wng.def @dwc.def -+dwarf/abpx_nmodel.for 6431 428755 940202 ! @wng.def @dwc.def -+dwarf/abpx_nplot.for 4137 299586 940202 ! @wng.def @dwc.def -+dwarf/abpx_nscan.for 4014 292077 940202 ! @wng.def @dwc.def -+dwarf/cpl.grp 1904 126626 010629 -+dwarf/cpl_2.def 6240 409345 940901 -+dwarf/cplblock.for 1707 107160 010709 ! -+dwarf/bldppd_2.def 5140 330749 940203 -+dwarf/bldppdblock.for 641 40812 010709 ! -+dwarf/bpdbuild.for 12846 810821 940901 ! @wng.def @dwc.def @bldppd_2.def -+dwarf/bpdcompile.for 3964 256517 010709 ! @wng.def @dwc.def @bldppd_2.def -+dwarf/bpdhelp.for 3321 216581 940202 ! @wng.def @dwc.def @bldppd_2.def -+dwarf/bpdindex.for 11293 737480 940203 ! @wng.def @dwc.def @bldppd_2.def @ppdrec_4.def -+dwarf/bpdinit.for 2541 166930 010709 ! @wng.def @dwc.def -+dwarf/bpdparm.for 8683 583398 940202 ! @wng.def @dwc.def @bldppd_2.def @ppdrec_4.def -+dwarf/bpdref.fsc 6344 416977 010629 ! @wng.def @dwc.def @bldppd_2.def -+dwarf/bpdstore.for 1863 123431 940901 ! @wng.def @dwc.def -+dwarf/bpdefcheck.for 2860 190644 940202 ! @wng.def @dwc.def -+dwarf/bpdwrite.for 4287 281016 010709 ! @wng.def @dwc.def @ppdrec_4.def -+dwarf/cpldyn.for 3334 223231 940202 ! @wng.def @dwc.def -+dwarf/cplerr.for 7415 495934 940202 ! @wng.def @dwc.def @cpl_2.def -+dwarf/cpllist.for 4390 293145 940217 ! @wng.def @dwc.def -+dwarf/cplobj.fsc 6339 426096 031205 ! @wng.def @dwc.def @cpl_2.def -+dwarf/cplread.for 3640 242570 010427 ! @wng.def @dwc.def -+dwarf/cplsrc.fsc 16548 1130407 010629 ! @wng.def @dwc.def @cpl_2.def -+dwarf/cplwrk.for 5184 354474 940202 ! @wng.def @dwc.def @cpl_2.def -+dwarf/dwc.grp 4671 300072 940217 -+dwarf/dwc.def 18596 1511171 010709 -+dwarf/dwcblock.for 387 26243 010709 ! -+dwarf/dwarf_4.def 3680 255272 940203 -+dwarf/dwarfblock.for 1612 102090 010709 ! -+dwarf/cli_1.def 3178 201913 940203 -+dwarf/cliblock.for 831 51280 940202 ! -+dwarf/parm_6.def 13548 878653 940203 -+dwarf/parmblock.for 2868 180190 010709 ! -+dwarf/abprun.for 14421 962331 010709 ! @wng.def @dwc.def -+dwarf/cli.for 18572 1351627 010426 ! @wng.def @dwc.def -+dwarf/clibuf.for 14878 998406 940209 ! @wng.def @dwc.def @cli_1.def -+dwarf/clistr.for 5409 372887 940202 ! @wng.def @dwc.def -+dwarf/dwcask.for 1795 112751 940202 ! @wng.def @dwc.def @dwarf_4.def -+dwarf/dwcbell.for 1817 114509 940202 ! @wng.def @dwc.def @dwarf_4.def -+dwarf/dwcctl.for 12436 823176 010709 ! @wng.def @dwc.def @dwarf_4.def -+dwarf/dwcexpcal.for 2419 165404 940202 ! @wng.def @dwc.def -+dwarf/dwcexpr.for 32260 2142830 010709 ! @wng.def @dwc.def -+dwarf/dwcextendsz.for 1907 123782 940202 ! @wng.def @dwc.def @dwarf_4.def -+dwarf/dwchelp.for 3626 264135 940202 ! @wng.def @dwc.def -+dwarf/dwcibmode.for 2348 150904 940202 ! @wng.def @dwc.def @dwarf_4.def -+dwarf/dwcident.for 2704 179807 940202 ! @wng.def @dwc.def @dwarf_4.def -+dwarf/dwcinput.for 4501 310471 010709 ! @wng.def @dwc.def -+dwarf/dwciobfsz.for 1865 119370 940202 ! @wng.def @dwc.def @dwarf_4.def -+dwarf/dwclevel.for 1925 123132 940202 ! @wng.def @dwc.def @dwarf_4.def -+dwarf/dwclogfatal.for 1882 120247 940202 ! @wng.def @dwc.def @dwarf_4.def -+dwarf/dwcloglevel.for 1929 123302 940202 ! @wng.def @dwc.def @dwarf_4.def -+dwarf/dwcmsgdev.for 2312 148753 940202 ! @wng.def @dwc.def @dwarf_4.def -+dwarf/dwcnexact.mvx 4903 323671 940203 -+dwarf/dwcnode.for 10865 727920 010709 ! @wng.def @dwc.def @dwarf_4.def -+dwarf/dwcprcmode.for 1991 135816 940202 ! @wng.def @dwc.def -+dwarf/dwcprog.for 3712 256014 940202 ! @wng.def @dwc.def -+dwarf/dwcsave.for 1845 117432 940202 ! @wng.def @dwc.def @dwarf_4.def -+dwarf/dwcstr.for 7157 495442 031229 ! @wng.def @dwc.def -+dwarf/dwcstream.for 5034 343131 940202 ! @wng.def @dwc.def @dwarf_4.def -+dwarf/dwcsym.for 8476 578112 010709 ! @wng.def @dwc.def -+dwarf/dwcsymlist.for 4380 290732 940202 ! @wng.def @dwc.def -+dwarf/dwcsysin.fsc 2997 207254 940202 ! @wng.def @dwc.def @($lnmdef) @($ssdef) -+dwarf/dwcsysout.for 1877 127573 940202 ! @wng.def @dwc.def -+dwarf/dwctest.for 1826 116223 940202 ! @wng.def @dwc.def @dwarf_4.def -+dwarf/dwctstsym.for 2038 138216 940202 ! @wng.def @dwc.def -+dwarf/dwcwaitpr.fvx 3157 216424 940202 ! @wng.def @dwc.def -+dwarf/progend.for 2697 194563 940202 ! @wng.def @dwc.def -+dwarf/progstart.for 2841 198870 940301 ! @wng.def @dwc.def -+dwarf/putparm.for 9046 640190 940901 ! @wng.def @dwc.def -+dwarf/ppctl.for 4597 307572 940202 ! @wng.def @dwc.def -+dwarf/getparm.for 14087 1043863 940202 ! @wng.def @dwc.def -+dwarf/gparg.for 5926 408383 940202 ! @wng.def @dwc.def -+dwarf/gpask.for 4411 289337 940202 ! @wng.def @dwc.def @parm_6.def -+dwarf/gpctl.for 7388 502173 940202 ! @wng.def @dwc.def @parm_6.def -+dwarf/gpdef.for 9708 668541 940202 ! @wng.def @dwc.def @parm_6.def -+dwarf/gpini.for 8834 588744 940411 ! @wng.def @dwc.def @parm_6.def -+dwarf/gpinp.for 12563 851953 010709 ! @wng.def @dwc.def -+dwarf/gploop.for 3047 205043 940202 ! @wng.def @dwc.def @parm_6.def -+dwarf/gpsav.for 4272 279545 010709 ! @wng.def @dwc.def @parm_6.def -+dwarf/gpval.for 13738 943802 940202 ! @wng.def @dwc.def @parm_6.def -+dwarf/pvblk.for 17541 1195809 940202 ! @wng.def @dwc.def -+dwarf/pvdef.for 10060 688212 940202 ! @wng.def @dwc.def -+dwarf/pvset.for 29631 1996362 940202 ! @wng.def @dwc.def -+dwarf/pvval.for 10774 720391 940202 ! @wng.def @dwc.def -+dwarf/udfunit.for 7512 441591 010412 ! @wng.def @dwc.def -+dwarf/gen.grp 3757 243610 010629 -+dwarf/blbcompare.for 3531 214305 940203 ! @wng.def @dwc.def -+dwarf/filnam.fun 3621 257508 940315 ! @wng.def @dwc.def -+dwarf/filnam.fvx 2460 175288 940202 ! @wng.def @dwc.def -+dwarf/genbrdcast.for 951 62714 940202 ! @wng.def @dwc.def -+dwarf/gencall.mvx 1947 145707 940202 -+dwarf/genclrblx.for 6198 388459 940202 ! @wng.def @dwc.def -+dwarf/gencvt.for 4943 304951 940203 ! @wng.def @dwc.def -+dwarf/generrno.chp 1191 77856 940202 ! -+dwarf/genexecl.cun 748 51173 940202 ! -+dwarf/genexecl.fvx 1089 70284 940202 ! @wng.def @dwc.def -+dwarf/genforios.fun 1295 88391 940202 ! @wng.def @dwc.def -+dwarf/genforios.fvx 2456 170186 940202 ! @wng.def @dwc.def -+dwarf/gengetfor.fsc 2632 177118 940214 ! @wng.def @dwc.def -+dwarf/gengetmsg.for 20393 1457191 940202 ! @wng.def @dwc.def -+dwarf/gengetpar.cun 5467 389220 031205 ! -+dwarf/gengetpar.fvx 2291 157739 940202 ! @wng.def @dwc.def -+dwarf/geninput.fun 5098 362960 961106 ! @wng.def @dwc.def -+dwarf/geninput.fvx 3435 235468 940202 ! @wng.def @dwc.def @($ssdef) @($libdef) @($rmsdef) -+dwarf/genisaterm.fsc 973 61125 940202 ! @wng.def @dwc.def -+dwarf/genisatty.cun 686 43430 940202 ! -+dwarf/genmixfnm.mvx 4500 318675 940203 -+dwarf/genmosaic.cun 6231 458201 940928 ! -+dwarf/genmovblx.for 7009 445675 940202 ! @wng.def @dwc.def -+dwarf/genoutput.for 1042 67832 960626 ! @wng.def @dwc.def -+dwarf/gensize.cun 857 56098 940202 ! -+dwarf/gensize.fvx 587 36107 940202 ! @wng.def @dwc.def -+dwarf/gensymbol.fun 11543 838915 010508 ! @wng.def @dwc.def -+dwarf/gensymbol.fvx 10779 740433 940202 ! @wng.def @dwc.def @($libclidef) @($libdef) -+dwarf/gensymbolc.cun 12529 932573 010508 ! -+dwarf/gensystem.cun 674 43028 940202 ! -+dwarf/gensystem.fvx 1486 96201 940202 ! @wng.def @dwc.def -+dwarf/gentermsw.fun 1535 102274 940202 ! @wng.def @dwc.def -+dwarf/gentermsw.fvx 1465 95529 940202 ! @wng.def @dwc.def @($dvidef) @($dcdef) -+dwarf/msg.for 2824 216520 940202 ! @wng.def @dwc.def -+dwarf/ppdfile.fsc 6208 419694 031205 ! @wng.def @dwc.def @ppdstat_2.def @ppdrec_4.def -+dwarf/prtuse.fsc 2558 164697 010629 ! @wng.def -+dwarf/strcheck.for 2731 185498 940202 ! @wng.def @dwc.def -+dwarf/strcollaps.for 1843 118606 940202 ! @wng.def @dwc.def -+dwarf/strcopy.for 4176 300720 940202 ! @wng.def @dwc.def -+dwarf/strlength.for 1260 85053 940203 ! @wng.def @dwc.def -+dwarf/strmatch.for 10317 710155 010709 ! @wng.def @dwc.def -+dwarf/strread.for 2252 142654 960813 ! @wng.def @dwc.def -+dwarf/strskip.for 3005 207619 940203 ! @wng.def @dwc.def -+dwarf/strupcase.for 2727 185910 940202 ! @wng.def @dwc.def -+dwarf/lnk.grp 1434 94024 940202 -+dwarf/link.for 14701 1011816 010709 ! @wng.def @dwc.def -+dwarf/linkc.cun 9061 635976 940202 ! -+dwarf/linkf.for 2756 181913 940202 ! @wng.def @dwc.def -+dwarf/linkhton.for 5909 367687 940203 ! @wng.def @dwc.def -+dwarf/linkhtonj.cun 2282 147919 940202 ! -+dwarf/linkhtonj.fvx 1845 118678 940203 ! @wng.def @dwc.def -+dwarf/linkrcvmsg.for 1284 86439 940202 ! @wng.def @dwc.def -+dwarf/linkrcvparm.for 4528 309529 940202 ! @wng.def @dwc.def -+dwarf/gencerror.cun 1253 84967 940202 ! -+dwarf/ppd.grp 2502 167782 940217 -+dwarf/ppdrec_4.def 14900 954141 010709 -+dwarf/ppdrecblock.for 1734 110728 010709 ! -+dwarf/ppdstat_2.def 4091 271394 940203 -+dwarf/ppdstatblock.for 998 64439 010709 ! -+dwarf/ppdamas.for 4339 291172 010427 ! @wng.def @dwc.def @ppdrec_4.def -+dwarf/ppdcheck.for 18002 1174499 940203 ! @wng.def @dwc.def -+dwarf/ppdcmas.for 4368 284657 940202 ! @wng.def @dwc.def @ppdrec_4.def -+dwarf/ppddtype.for 7375 498929 010427 ! @wng.def @dwc.def @ppdrec_4.def -+dwarf/ppddvstr.for 5302 371461 940202 ! @wng.def @dwc.def @ppdrec_4.def -+dwarf/ppdfao.for 2231 144991 940202 ! @wng.def @dwc.def -+dwarf/ppdhelp.fsc 19135 1252516 010709 ! @wng.def @dwc.def -+dwarf/ppdhstr.for 5018 351419 941031 ! @wng.def @dwc.def @ppdrec_4.def -+dwarf/ppdindex.for 6171 418761 940203 ! @wng.def @dwc.def @ppdstat_2.def @ppdrec_4.def -+dwarf/ppdinit.for 4196 286474 031205 ! @wng.def @dwc.def -+dwarf/ppdiocd.for 3177 212725 940202 ! @wng.def @dwc.def @ppdrec_4.def -+dwarf/ppdleng.for 1276 89712 940202 ! @wng.def @dwc.def @ppdrec_4.def -+dwarf/ppdlist.for 3392 220791 010709 ! @wng.def @dwc.def -+dwarf/ppdmin.for 13730 940625 940202 ! @wng.def @dwc.def @ppdrec_4.def -+dwarf/ppdnsets.for 2499 170440 940202 ! @wng.def @dwc.def @ppdrec_4.def -+dwarf/ppdnval.for 8459 581404 940202 ! @wng.def @dwc.def @ppdrec_4.def -+dwarf/ppdopstr.for 9168 632236 010709 ! @wng.def @dwc.def @ppdrec_4.def -+dwarf/ppdparm.for 6263 437528 940202 ! @wng.def @dwc.def @ppdstat_2.def @ppdrec_4.def -+dwarf/ppdprompt.for 3847 258672 950126 ! @wng.def @dwc.def -+dwarf/ppdprstr.for 5876 415701 031229 ! @wng.def @dwc.def @ppdrec_4.def -+dwarf/ppdread.for 6106 438398 940202 ! @wng.def @dwc.def -+dwarf/ppdsstr.for 9416 635666 940202 ! @wng.def @dwc.def @ppdrec_4.def -+dwarf/ppdstat.for 5857 395910 940202 ! @wng.def @dwc.def @ppdstat_2.def @ppdrec_4.def -+dwarf/ppdunam.for 6426 444793 940202 ! @wng.def @dwc.def @ppdrec_4.def -+dwarf/ppdustr.for 5400 376628 940202 ! @wng.def @dwc.def @ppdrec_4.def -+dwarf/cplvallist.for 4277 277450 010427 ! @wng.def @dwc.def -+dwarf/src.grp 1957 129169 940311 -+dwarf/dwarf.pin 6275 488974 940202 ! -+dwarf/global.pin 2148 154977 940202 ! -+dwarf/dwe.dsc 1343 83844 940311 ! -+dwarf/calculate.hlp 8746 700596 940202 -+dwarf/dwarfini.hlp 160 10706 940202 -+dwarf/dwarfnews.hlp 4115 361791 940202 -+dwarf/dwarf_alias.ssc 2716 199401 930922 -+dwarf/dwarfcshrc.ssc 1496 101651 940311 -+dwarf/dwarfcshrc_atnf.ssc 1549 118660 940218 -+dwarf/dwarfcshrc_nfra.ssc 1498 110836 930922 -+dwarf/dwarfcshrc_raiub.ssc 421 33278 930922 -+dwarf/dwarfcshrc_rug.ssc 1125 85804 930922 -+dwarf/dwarfcshrc_wsrt.ssc 441 35561 930922 -+dwarf/dwarfcshrc_kosma.ssc 755 57493 930922 -+dwarf/dwarfcshrc_arecb.ssc 814 61052 930922 -+dwarf/dwarflogin.ssc 1902 124255 930922 -+dwarf/dwarflogout.ssc 370 26427 930922 -+dwarf/sys_bldppd.for 3514 221362 010709 ! @wng.def @dwc.def -+dwarf/calculate.for 16518 1077134 940202 ! @wng.def @dwc.def -+dwarf/clear.for 5846 393705 940202 ! @wng.def @dwc.def -+dwarf/execute.fsc 11131 733010 940311 ! @wng.def @dwc.def @dwe.def -+dwarf/initdw.for 2280 147503 010423 ! @wng.def @dwc.def -+dwarf/let.for 4378 298920 940202 ! @wng.def @dwc.def -+dwarf/prtppd.for 2225 143932 940202 ! @wng.def @dwc.def -+dwarf/restore.for 9991 687729 940315 ! @wng.def @dwc.def -+dwarf/save.for 7043 489371 940721 ! @wng.def @dwc.def -+dwarf/specify.for 5516 358680 940202 ! @wng.def @dwc.def -+dwarf/spclear.for 2180 144835 940202 ! @wng.def @dwc.def -+dwarf/spcopy.for 2440 159468 940202 ! @wng.def @dwc.def -+dwarf/spdefcheck.for 6875 467384 940202 ! @wng.def @dwc.def -+dwarf/splist.for 6246 429164 010709 ! @wng.def @dwc.def -+dwarf/spmenu.for 5251 365699 940202 ! @wng.def @dwc.def -+dwarf/spnomenu.for 4853 336347 940202 ! @wng.def @dwc.def -+dwarf/view.for 13234 868916 010427 ! @wng.def @dwc.def -+dwarf/vpdefcheck.for 3974 266320 940202 ! @wng.def @dwc.def -+ncopy/nco.grp 586 41936 940214 -+ncopy/ncopy.psc 3672 253157 970509 ! @scnnode.pef @scnsets_pef:scn.sets,overview ! @scnsets_pef:scn_groups,scn_obss,scn_fields,scn_channels,scn.sectors @select_pef:ha_range,select.ifrs @ngen_pef:x_log,log,x_run,run,x_infix,infix,x.datab,datab ! @ngen_pef:x.memory,memory ! @ngen_pef:x_apply,apply,x_de_apply,de_apply,x.modelb,modelb -+ncopy/nco.dsc 1687 102623 010709 ! @nstar.dsf -+ncopy/ncopy.for 1113 63752 010709 ! @wng.def @nco.def -+ncopy/ncocpb.for 4697 289043 010709 ! @wng.def -+ncopy/ncocpy.for 27663 1591594 010709 ! @wng.def @fdw_o.def @fdx_o.def @ohw_o.def @scw_o.def @shw_o.def @gfh_o.def @sgh_o.def @mdh_o.def @mdl_o.def @ifh_o.def @sth_o.def @sch_o.def @nco.def @scn.def -+ncopy/ncodat.for 8447 480953 010709 ! @wng.def @nco.def -+ncopy/ncoini.for 996 58817 010709 ! @wng.def @nsc.def -+ncopy/ncoovv.for 6150 316017 010709 ! @wng.def @nco.def @gfh_o.def @sgh_o.def @sth_o.def @sch_o.def -+nmap/ncl.grp 1680 123386 930922 -+nmap/nclean.psc 17262 1279809 000225 ! @nmap.pef ! for data clean @ngen.pef @wmpnode.pef ! @wmpsets.pef ! @mdlnode.pef ! @nmodel.pef ! @scnnode_pef:scn.node ! @scnsets.pef ! @select.pef -+nmap/ncl.dsc 2422 146698 950516 ! -+nmap/nclean.for 3231 192608 960513 ! @wng.def @ncl.def @mph_o.def -+nmap/nclbcl.for 2743 163834 931007 ! @wng.def @mph_o.def @mdh_o.def @mdl_o.def @ncl.def -+nmap/nclbea.for 2923 183657 931117 ! @wng.def @mph_o.def @mdh_o.def @ncl.def -+nmap/nclbrd.for 2144 129476 930922 ! @wng.def @mph_o.def @ncl.def -+nmap/nclbwr.for 4335 272347 940803 ! @wng.def @gfh_o.def @sgh_o.def @mph_o.def @ncl.def -+nmap/nclccl.for 2851 176884 940803 ! @wng.def @mph_o.def @mdh_o.def @mdl_o.def @ncl.def -+nmap/nclcdt.for 6255 392713 950714 ! @wng.def @mph_o.def @mdh_o.def @ncl.def -+nmap/nclcmp.for 4165 265569 931007 ! @wng.def @mph_o.def @mdh_o.def @ncl.def -+nmap/nclcrd.for 3034 187277 950516 ! @wng.def @mph_o.def @ncl.def -+nmap/nclcwr.for 2623 168843 930922 ! @wng.def @gfh_o.def @sgh_o.def @mph_o.def @ncl.def -+nmap/ncldat.for 14370 849376 950714 ! @wng.def @lsq_o.def @ncl.def @mph_o.def -+nmap/nclfun.for 2528 151634 930922 ! @wng.def -+nmap/nclhim.for 3916 251884 950714 ! @wng.def @mph_o.def @ncl.def -+nmap/nclhis.for 3919 268164 940803 ! @wng.def @mph_o.def @ncl.def -+nmap/nclini.for 690 46122 930922 ! @wng.def @ncl.def -+nmap/nclucl.for 9031 569916 950714 ! @wng.def @mph_o.def @ncl.def -+nmap/ncluc1.for 6409 415701 940803 ! @wng.def @mph_o.def @mdh_o.def @mdl_o.def @ncl.def -+nmap/ncluv.for 8006 521214 940803 ! @wng.def @mph_o.def @mdh_o.def @ncl.def -+nmap/ncluvt.for 6656 433857 940803 ! @wng.def @mph_o.def @ncl.def -+nmap/nma.grp 2702 193846 950821 -+nmap/mdlnode.pef 1283 97146 950220 ! -+nmap/wmpnode.pef 1394 101059 950220 ! -+nmap/wmpsets.pef 10161 805820 950220 ! -+nmap/nmap.pef 6821 526049 950220 ! -+nmap/nmap.psc 39626 2900997 040110 ! @ngen.pef ! @nshow.pef ! @nmodel.pef ! @mdlnode.pef ! @scnnode.pef ! @scnsets.pef ! @select.pef ! @nmap.pef ! @wmpnode.pef ! @wmpsets.pef ! @unit.pef -+nmap/mph.dsc 3272 181951 940623 ! @ssh.dsf !standard area -+nmap/smp.dsc 2673 152995 931007 ! -+nmap/nma.dsc 7113 409530 040110 ! -+nmap/nmap.for 2491 150906 960422 ! @wng.def @nma.def -+nmap/nmacvf.for 4030 226133 930922 ! @wng.def -+nmap/nmacvl.for 13967 849396 930922 ! @wng.def @gfh_o.def @sgh_o.def @mph_o.def @nma.def -+nmap/nmacvx.for 2591 157576 930922 ! @wng.def @nma.def -+nmap/nmadar.for 5208 313170 930922 ! @wng.def -+nmap/nmadat.for 49196 2851053 960422 ! @wng.def @cbits.def @sth_o.def @mph_o.def @nma.def -+nmap/nmadft.for 2409 139751 930922 ! @wng.def @sth_o.def @nma.def -+nmap/nmafid.for 25601 1510444 951213 ! @wng.def @gfh_o.def @sgh_o.def @mph_o.def @nma.def -+nmap/nmafld.for 8716 533351 010709 ! @wng.def @gfh_o.def @sgh_o.def @mph_o.def @smp_o.def @smp_t.def @nma.def -+nmap/nmafmc.for 11255 696906 940623 ! @wng.def @gfh_o.def @sgh_o.def @mph_o.def @nma.def -+nmap/nmaini.for 689 46117 930922 ! @wng.def @nma.def -+nmap/nmajsl.for 14526 872509 010709 ! @wng.def @nma.def @sth_o.def @mph_o.def @ohw_o.def -+nmap/nmamak.for 5401 324274 940623 ! @wng.def @gfh_o.def @sgh_o.def @nma.def -+nmap/nmamkp.for 4514 262874 950821 ! @wng.def @sth_o.def @nma.def -+nmap/nmanvs.for 1524 93786 930922 ! @wng.def @nma.def @mph_o.def -+nmap/nmaofr.for 6331 401353 940524 ! @wng.def @nma.def @gfh_o.def @sgh_o.def @mph_o.def @smp_o.def @smp_t.def -+nmap/nmaoto.for 5703 361982 010709 ! @wng.def @nma.def @gfh_o.def @mph_o.def @smp_o.def -+nmap/nmapfl.for 6210 393698 931221 ! @wng.def @mph_o.def @gfh_o.def @sgh_o.def -+nmap/nmapmh.for 3784 241852 940524 ! @wng.def @mph_o.def -+nmap/nmaprt.for 8339 496162 940613 ! @wng.def @nma.def @mph_o.def -+nmap/nmarfh.for 17920 1054649 040110 ! @wng.def @mph_o.def -+nmap/nmarfs.for 836 50741 940930 ! @wng.def @mph_o.def -+nmap/nmarft.for 8694 517879 970509 ! @wng.def @gfh_o.def @sgh_o.def @nma.def @mph_o.def -+nmap/nmascn.for 10405 648494 960422 ! @wng.def @cbits.def @sth_o.def @sch_o.def @nma.def -+nmap/nmasoi.for 3482 212484 950821 ! @wng.def @nma.def -+nmap/nmason.for 1456 91132 950821 ! @wng.def @nma.def -+nmap/nmasor.for 10403 623310 950821 ! @wng.def @sth_o.def @nma.def -+nmap/nmasot.for 2217 140205 950821 ! @wng.def @sth_o.def @nma.def -+nmap/nmasst.for 5263 324955 950502 ! @wng.def @sth_o.def @nma.def -+nmap/nmastg.for 1996 130022 930922 ! @wng.def @mph_o.def -+nmap/nmatrp.for 10915 665212 940613 ! @wng.def @gfh_o.def @sgh_o.def @mph_o.def @nma.def -+nmap/nmauni.for 3290 196637 930922 ! @wng.def @nma.def -+nmap/nmaunu.for 897 56561 930922 ! @wng.def @nma.def -+nmap/nmaunx.for 878 55045 930922 ! @wng.def @nma.def -+nmap/nmawfh.for 12988 754367 970509 ! @wng.def @mph_o.def -+nmap/nmawft.for 8713 529691 970509 ! @wng.def @nma.def @mph_o.def -+nmap/nmaxcv.for 4021 245882 940524 ! @wng.def @nma.def @gfh_o.def @gfh_t.def @sgh_o.def @sgh_t.def @mph_o.def @mph_t.def -+nmap/nmaxmh.for 5150 303821 931220 ! @wng.def @mph_o.def @gfh_o.def @sgh_o.def @mph_e.def @gfh_e.def @sgh_e.def -+nplot/ngc.grp 1636 118374 950111 -+nplot/ngcalc.psc 16886 1290247 950714 ! @plotter.pef @ngen.pef @ngfsets.pef @scnnode_pef:scn.node ! @scnsets.pef ! @select_pef:select_tels,select_ifrs,ha.range @mdlnode.pef @nmodel.pef @nshow_pef:file.action,edit -+nplot/ngfsets.pef 10459 839211 941019 ! -+nplot/plotter.pef 1454 108303 960520 ! -+nplot/ngf.dsc 2095 114996 940821 ! @ssh.dsf !standard area -+nplot/ngc.dsc 2842 172784 010425 ! @nstar.dsf -+nplot/ngcalc.for 1501 91854 940821 ! @wng.def @ngc.def -+nplot/ngcbas.for 9088 556861 941031 ! @wng.def @gfh_o.def @sgh_o.def @ngf_o.def @ngc.def -+nplot/ngccal.for 13542 819206 950714 ! @wng.def @lsq_o.def @gfh_o.def @sgh_o.def @ngf_o.def @ngc.def -+nplot/ngccob.for 12289 759248 941031 ! @wng.def @gfh_o.def @sgh_o.def @ngf_o.def @ngc.def -+nplot/ngccop.for 5477 336440 940901 ! @wng.def @gfh_o.def @sgh_o.def @ngf_o.def @ngc.def -+nplot/ngcdat.for 3753 229437 940901 ! @wng.def @gfh_o.def @sgh_o.def @sth_o.def @ngc.def -+nplot/ngcexc.for 9790 561078 940721 ! @wng.def @ngc.def -+nplot/ngcexn.for 4814 285521 930922 ! @wng.def -+nplot/ngcexp.for 9018 515990 010709 ! @wng.def @ngc.def -+nplot/ngcext.for 11739 713713 940901 ! @wng.def @cbits.def @ngf_o.def @gfh_o.def @sgh_o.def @sth_o.def @sch_o.def @ngc.def -+nplot/ngcini.for 694 46402 930922 ! @wng.def @ngc.def -+nplot/ngcmon.for 5303 320718 940901 ! @wng.def @ngf_o.def @ngc.def -+nplot/ngcnvs.for 1455 89562 930922 ! @wng.def @ngc.def @ngf_o.def -+nplot/ngcpbr.for 1775 110128 940901 ! @wng.def @ngc.def @ngf_o.def -+nplot/ngcpfl.for 6175 389256 940821 ! @wng.def @ngf_o.def @gfh_o.def @sgh_o.def -+nplot/ngcplt.for 14696 889212 000225 ! @wng.def @ngf_o.def @ngc.def -+nplot/ngcpmh.for 1846 115265 930922 ! @wng.def @ngf_o.def -+nplot/ngcprt.for 5322 313025 950714 ! @wng.def @ngc.def @ngf_o.def -+nplot/ngcsph.for 1821 115269 940901 ! @wng.def @ngc.def @ngf_o.def -+nplot/ngcstg.for 1997 129806 930922 ! @wng.def @ngf_o.def -+nplot/ngctrp.for 9094 561541 940901 ! @wng.def @gfh_o.def @sgh_o.def @ngf_o.def @ngc.def -+nplot/ngcxcv.for 3545 218129 930922 ! @wng.def @ngc.def @gfh_o.def @gfh_t.def @sgh_o.def @sgh_t.def @ngf_o.def @ngf_t.def -+nplot/ngcxmh.for 5151 303763 931220 ! @wng.def @ngf_o.def @gfh_o.def @sgh_o.def @ngf_e.def @gfh_e.def @sgh_e.def -+nplot/ngi.grp 1560 112965 940301 -+nplot/ngids.psc 11130 852417 970529 ! @nmodel.pef @ngen.pef @scnnode.pef ! @scnsets.pef ! @select.pef @wmpnode.pef ! @wmpsets.pef -+nplot/ngi.dsc 3104 185089 940901 ! @nstar.dsf !# of telescopes etc -+nplot/ngids.fsc 1353 92120 960513 ! @wng.def @ngi.def -+nplot/ngidat.for 18884 1191018 000922 ! @wng.def @cbits.def @mph_o.def @sth_o.def @flh_o.def @ngi.def -+nplot/ngidmp.for 2786 179486 940930 ! @wng.def @mph_o.def @ngi.def -+nplot/ngidif.for 3926 254131 940623 ! @wng.def @cbits.def @sth_o.def @ngi.def -+nplot/ngidch.for 4362 285721 000922 ! @wng.def @cbits.def @sth_o.def @ngi.def -+nplot/ngidop.for 1917 121771 940218 ! @wng.def -+nplot/ngicdt.for 4631 295569 940623 ! @wng.def @ngi.def @cbits.def @sth_o.def @sch_o.def -+nplot/ngidlm.for 5093 307267 940930 ! @wng.def @mph_o.def -+nplot/ngidpt.for 2496 153259 931221 ! @wng.def -+nplot/ngigdi.cun 51070 2850455 031229 ! -+nplot/ngiini.for 699 47008 931217 ! @wng.def @npl.def -+nplot/ngilod.for 5379 335060 940126 ! @wng.def @cbits.def @ngi.def @mph_o.def @sth_o.def -+nplot/ngirec.for 3351 227723 931217 ! @wng.def @ngi.def -+nplot/ngiset.for 13491 851513 940901 ! @wng.def @cbits.def @flf_o.def @sth_o.def @ngi.def -+nplot/ngipnt.for 8899 506192 010709 ! @wng.def @ngi.def @cbits.def @mph_o.def @sth_o.def @flf_o.def -+nplot/npl.grp 1452 104735 960626 -+nplot/nplot.psc 27211 1944377 970605 ! @plotter.pef ! @ngen.pef @scnnode.pef ! @scnsets.pef ! @select.pef @wmpnode.pef ! @wmpsets.pef @mdlnode.pef ! @nmodel.pef -+nplot/plotter.pef 1454 108303 960520 ! -+nplot/npl.dsc 4832 289697 000225 ! -+nplot/nplot.for 2004 128697 970728 ! @wng.def @npl.def -+nplot/nplbap.for 8055 434406 940613 ! @wng.def @npl.def -+nplot/nplclo.for 821 52674 940901 ! @wng.def @wqg.def @npl.def -+nplot/nplcon.for 1715 100989 980707 ! @wng.def @npl.def -+nplot/npldat.for 35895 2054320 970605 ! @wng.def @cbits.def @sth_o.def @mph_o.def @npl.def -+nplot/npldch.for 2986 183898 960813 ! @wng.def @sth_o.def @npl.def -+nplot/npldha.for 4326 252077 940411 ! @wng.def @sth_o.def @npl.def -+nplot/npldif.for 4183 244448 970509 ! @wng.def @sth_o.def @npl.def -+nplot/nplini.for 731 49379 940203 ! @wng.def @npl.def -+nplot/npllod.for 3104 197659 970728 ! @wng.def @cbits.def @sth_o.def @npl.def -+nplot/nplmap.fsc 46987 2624390 970728 ! @wng.def @mph_o.def @mdh_o.def @mdl_o.def @sth_o.def @npl.def -+nplot/nplone.for 1087 64950 940203 ! @wng.def @npl.def -+nplot/nplopn.for 11056 628089 970509 ! @wng.def @npl.def @wnd.def -+nplot/nplpbe.for 6205 361642 970509 ! @wng.def @npl.def -+nplot/nplplt.for 7311 414573 010709 ! @wng.def @sth_o.def @npl.def -+nplot/nplres.for 26749 1368612 970728 ! @wng.def @cbits.def @sth_o.def @sch_o.def @npl.def -+nplot/nplsst.for 2964 207257 970509 ! @wng.def @npl.def @sth_o.def -+nplot/npltel.for 12931 786816 040110 ! @wng.def @cbits.def @sth_o.def @sch_o.def @npl.def -+nplot/npltwo.for 3061 173877 940203 ! @wng.def @npl.def -+nscan/nat.grp 1245 88386 930922 -+nscan/natnf.psc 4026 269852 960422 ! @ngen.pef @scnnode.pef ! @scnsets.pef ! @select.pef ! @unit.pef -+nscan/rpf.dsc 4919 311147 930922 ! -+nscan/nat.dsc 2291 139458 930922 ! -+nscan/natnf.for 603 38301 930922 ! @wng.def @nat.def -+nscan/natdat.for 7225 430532 950111 ! @wng.def @nat.def -+nscan/natini.for 693 46473 930922 ! @wng.def @nat.def -+nscan/natlod.for 5551 326670 931221 ! @wng.def @nat.def @rpf.def @gfh_o.def @sgh_o.def -+nscan/natlrd.for 5621 337898 930922 ! @wng.def @nat.def @rpf.def -+nscan/natlwd.for 14621 848582 930922 ! @wng.def @nat.def @rpf.def @gfh_o.def @sgh_o.def @sth_o.def @sch_o.def -+nscan/natrgp.for 2359 161301 930922 ! @wng.def @rpf.def -+nscan/natrif.for 6136 345171 930922 ! @wng.def @rpf.def -+nscan/natrpf.for 18823 1188830 010410 ! @wng.def @rpf.def -+nscan/natrrt.for 2060 126229 930922 ! @wng.def @rpf.def -+nscan/natxcj.for 811 52741 930922 ! @wng.def -+nscan/natxib.for 1491 94059 930922 ! @wng.def @rpf.def -+nscan/natxsf.for 1075 71020 930922 ! @wng.def -+nscan/natxst.for 2201 140662 930922 ! @wng.def @rpf.def -+nscan/nca.grp 3707 283475 010629 -+nscan/ncalib.psc 43150 3250123 040110 ! @ngen.pef @scnnode.pef ! @scnsets.pef ! @select.pef @mdlnode.pef ! @nmodel.pef -+nscan/nca.dsc 3584 220514 031231 ! @nstar.dsf -+nscan/ncalib.for 8764 567745 000225 ! @wng.def @sth_o.def @nca.def -+nscan/ncaccp.for 4191 245037 930922 ! @wng.def @nca.def @sth_o.def -+nscan/ncacic.for 8273 518583 960422 ! @wng.def @nca.def @lsq_o.def @sth_o.def @sch_o.def -+nscan/ncaclc.for 6700 433733 950714 ! @wng.def @nca.def @lsq_o.def @sth_o.def @sch_o.def -+nscan/ncadat.for 40655 2503143 040110 ! @wng.def @cbits.def @sth_o.def @nca.def -+nscan/ncaini.for 694 46487 930922 ! @wng.def @nca.def -+nscan/ncapol.for 16813 1017460 970509 ! @wng.def @cbits.def @lsq_o.def @sth_o.def @sch_o.def @nca.def -+nscan/ncapvz.for 12015 728597 000225 ! @wng.def @cbits.def @nca.def @lsq_o.def @sth_o.def @sch_o.def -+nscan/ncaraw.for 1417 87456 930922 ! @wng.def @sth_o.def -+nscan/ncarcs.for 15933 898194 980707 ! @wng.def @lsq_o.def @sth_o.def -+nscan/ncared.for 69449 3434566 031230 ! @wng.def @cbits.def @nca.def @lsq_o.def @sth_o.def @sch_o.def -+nscan/ncargr.for 2644 159531 031231 ! @wng.def @sth_o.def -+nscan/ncargs.for 15621 891448 980707 ! @wng.def @lsq_o.def @sth_o.def -+nscan/ncarmd.for 3072 182592 010410 ! @wng.def @sth_o.def -+nscan/ncarps.for 17925 1021978 980707 ! @wng.def @lsq_o.def @sth_o.def -+nscan/ncarrt.for 1948 111711 930922 ! @wng.def -+nscan/ncarwr.for 2737 171878 930922 ! @wng.def @cbits.def @sth_o.def @sch_o.def -+nscan/ncastz.fsc 41309 2038837 040110 ! @wng.def @cbits.def @sth_o.def @sch_o.def @nca.def -+nscan/ncatel.for 7111 417979 000225 ! @wng.def @nca.def @cbits.def @sth_o.def @sch_o.def -+nscan/nfi.grp 476 33633 940812 -+nscan/nfilt.psc 2015 159557 960422 ! @ngen.pef @scnnode.pef @scnsets.pef @select.pef @mdlnode.pef @nmodel.pef -+nscan/nfi.dsc 1094 66975 950714 ! @nstar.dsf -+nscan/nfilt.for 806 50124 950714 ! @wng.def @nfi.def -+nscan/nfidat.for 3792 215785 950714 ! @wng.def @cbits.def @ssh_o.def @sth_o.def @nfi.def -+nscan/nfiini.for 694 46358 940812 ! @wng.def @nfi.def -+nscan/nfiuvl.for 4587 277068 950714 ! @wng.def @cbits.def @lsq_o.def @sth_o.def @nfi.def -+nscan/nfl.grp 1575 113309 941019 -+nscan/nflag.psc 47611 3606006 960422 ! @ngen.pef @nshow.pef @flfnode.pef ! @scnnode.pef ! @scnsets.pef ! @select.pef @nmodel.pef ! @mdlnode.pef -+nscan/flfnode.pef 1366 98307 950126 ! -+nscan/flh.dsc 1017 69563 931012 ! -+nscan/flf.dsc 471 31118 931012 ! -+nscan/nfl.dsc 689 43276 930922 ! -+nscan/nflag.for 767 49508 960130 ! @wng.def @nfl.def -+nscan/nflcnt.for 33285 1730248 010420 ! @wng.def @nfl.def @cbits.def @sth_o.def -+nscan/nflcub.for 14776 845213 010420 ! @wng.def @nfl.def @cbits.def @sth_o.def @sch_o.def -+nscan/nfldat.for 630 41968 930922 ! @wng.def @nfl.def -+nscan/nflflg.for 23547 1342572 031205 ! @wng.def @nfl.def @cbits.def @sth_o.def @sch_o.def -+nscan/nflfl0.for 7547 462127 930922 ! @wng.def @cbits.def @gfh_o.def @flh_o.def @flf_o.def -+nscan/nflfl5.for 15880 954490 940203 ! @wng.def @gfh_o.def @flh_o.def @flf_o.def @sth_o.def @ssh_o.def -+nscan/nflget.for 21731 1213639 940418 ! @wng.def @nfl.def @cbits.def @sth_o.def @sch_o.def @flh_o.def @flf_o.def -+nscan/nflini.for 671 45033 930922 ! @wng.def -+nscan/nflist.for 17562 973914 940203 ! @wng.def @nfl.def @cbits.def @sth_o.def @sch_o.def @flh_o.def @flf_o.def -+nscan/nflops.for 84955 4928456 031229 ! @wng.def @nfl.def @cbits.def @sth_o.def @sch_o.def -+nscan/nflprt.for 28468 1697844 000929 ! @wng.def @cbits.def @sth_o.def @sch_o.def @ohw_o.def @nfl.def -+nscan/nflput.for 28421 1629928 031229 ! @wng.def @nfl.def @cbits.def @sth_o.def @sch_o.def @flh_o.def @flf_o.def -+nscan/nflst0.for 7187 390449 010420 ! @wng.def @nfl.def @cbits.def @sth_o.def -+nscan/nflst1.for 41161 2382876 031205 ! @wng.def -+nscan/nflst3.for 13429 721444 010420 ! @wng.def @nfl.def @cbits.def @sth_o.def -+nscan/nflswi.for 3004 172858 010420 ! @wng.def @nfl.def -+nscan/nmo.grp 4959 363884 010629 -+nscan/nmodel.pef 40289 2910390 970529 ! -+nscan/nmodel.psc 14288 1022239 000225 ! @ngen.pef @scnnode.pef ! @scnsets.pef ! @select.pef @wmpnode.pef ! @wmpsets.pef @mdlnode.pef @nmodel.pef -+nscan/mdh.dsc 1332 93922 960626 ! -+nscan/mdl.dsc 1100 75006 950530 ! -+nscan/mdu.dsc 1386 96457 000225 ! -+nscan/bmd.dsc 1120 67633 931007 ! -+nscan/nmo.dsc 2904 185419 931012 ! @nstar.dsf -+nscan/nmodel.fsc 5323 336934 000225 ! @wng.def @nmo.def @mdu_o.def @sth_o.def -+nscan/nmoadd.for 15745 916057 960422 ! @wng.def @nmo.def @mdh_o.def @mdl_o.def -+nscan/nmobem.for 2520 159124 931012 ! @wng.def @nmo.def @mdh_o.def @mdl_o.def -+nscan/nmobmf.for 1150 79310 931012 ! @wng.def @bmd.def -+nscan/nmobmr.for 2125 130262 931007 ! @wng.def @bmd.def -+nscan/nmobmv.for 1395 87916 931007 ! @wng.def @bmd.def -+nscan/nmocvs.for 5360 331780 931215 ! @wng.def @nmo.def @mdh_o.def @mdl_o.def @sth_o.def -+nscan/nmocix.for 2899 177762 940304 ! @wng.def @sth_o.def @sch_o.def -+nscan/nmocxi.for 6123 357076 931110 ! @wng.def @cbits.def @sth_o.def @sch_o.def -+nscan/nmocvt.for 6109 382255 931221 ! @wng.def @nmo.def @mdh_o.def @sth_o.def -+nscan/nmocvx.for 2074 132001 930922 ! @wng.def @nmo.def @gfh_o.def @gfh_t.def @mdh_o.def @mdh_t.def @mdl_o.def @mdl_t.def -+nscan/nmodat.for 24678 1488885 031231 ! @wng.def @nmo.def @cbits.def @mph_o.def @mdh_o.def @mdl_o.def @sth_o.def @dldm.def -+nscan/nmoext.for 2373 148318 930922 ! @wng.def @mdl_o.def -+nscan/nmofmd.for 8229 485551 010410 ! @wng.def @nmo.def @lsq_o.def @mph_o.def @mdh_o.def @mdl_o.def -+nscan/nmofnd.for 6827 400596 950714 ! @wng.def @nmo.def @lsq_o.def @mph_o.def @mdh_o.def @mdl_o.def -+nscan/nmogsh.for 498 33702 930922 ! @wng.def @nmo.def @mdh_o.def -+nscan/nmohed.for 1511 101110 940803 ! @wng.def @mdh_o.def @nmo.def -+nscan/nmoini.for 785 52182 930922 ! @wng.def -+nscan/nmomsc.for 8371 507233 931012 ! @wng.def @nmo.def @mdh_o.def @mdl_o.def @sth_o.def @sch_o.def -+nscan/nmomsg.for 1115 71003 930922 ! @wng.def @nmo.def @mdh_o.def @mdl_o.def @sth_o.def -+nscan/nmomss.for 593 39848 930922 ! @wng.def @nmo.def @mdh_o.def @mdl_o.def @sth_o.def -+nscan/nmomst.for 1676 107662 940201 ! @wng.def @sth_o.def -+nscan/nmomu4.for 2972 190411 931012 ! @wng.def @nmo.def @sth_o.def -+nscan/nmomuc.for 7732 461055 931020 ! @wng.def @nmo.def @mdh_o.def @mdl_o.def @sth_o.def -+nscan/nmomui.for 3466 215993 000225 ! @wng.def @nmo.def -+nscan/nmomup.for 2097 133081 930922 ! @wng.def @nmo.def @mdh_o.def @mdl_o.def -+nscan/nmomuv.for 2834 187563 950220 ! @wng.def @sth_o.def @sch_o.def -+nscan/nmonam.for 4419 272466 940623 ! @wng.def @mdh_o.def @mdl_o.def -+nscan/nmonvs.for 940 60531 930922 ! @wng.def @nmo.def @gfh_o.def @mdh_o.def @mdl_o.def -+nscan/nmoofr.fsc 4177 255012 031205 ! @wng.def @nmo.def @gfh_o.def @mdh_o.def @mdl_o.def -+nscan/nmooto.for 3473 210934 010410 ! @wng.def @nmo.def @mdh_o.def @mdl_o.def -+nscan/nmoprt.for 10759 621285 960626 ! @wng.def @nmo.def @mdu_o.def @mdh_o.def @mdl_o.def -+nscan/nmords.for 10646 649372 940301 ! @wng.def @nmo.def @gfh_o.def @mdh_o.def @mdl_o.def -+nscan/nmosli.for 2769 175292 930922 ! @wng.def @nmo.def @mdh_o.def @mdl_o.def -+nscan/nmosrt.for 2792 177723 930922 ! @wng.def @mdh_o.def @mdl_o.def -+nscan/nmosr0.for 4113 256163 930922 ! @wng.def @nmo.def @mdl_o.def -+nscan/nmoupd.for 8167 510925 000225 ! @wng.def @nmo.def @lsq_o.def @mdu_o.def @sth_o.def @sch_o.def -+nscan/nmoup0.for 23379 1359292 000225 ! @wng.def @cbits.def @lsq_o.def @mdh_o.def @mdl_o.def @mdu_o.def @sth_o.def @nmo.def -+nscan/nmowri.for 595 40812 930922 ! @wng.def @nmo.def -+nscan/nmowrs.for 2145 134864 930922 ! @wng.def @nmo.def @gfh_o.def @mdh_o.def @mdl_o.def -+nscan/nsc.grp 7916 568009 960626 -+nscan/ncopy.csh 3340 251625 930922 ! -+nscan/ncopy.com 6112 381003 930922 ! -+nscan/ngen.pef 28501 2219167 970509 ! -+nscan/scnnode.pef 1391 99984 950126 ! -+nscan/scnsets.pef 12431 1005822 960130 ! -+nscan/select.pef 4259 339736 950126 ! -+nscan/unit.pef 4164 319479 950111 ! -+nscan/nshow.pef 9053 694125 960520 ! -+nscan/ngen.psc 154 9626 940311 ! @ngen.pef -+nscan/nscan.psc 19495 1406572 040110 ! @nshow.pef @ngen.pef @unit.pef ! @scnnode.pef ! @scnsets.pef ! @select.pef ! @mdlnode.pef ! @nmodel.pef -+nscan/nstar.dsf 368 26658 931020 ! -+nscan/cbits.dsc 3546 229801 940812 ! -+nscan/qub.dsc 2468 146410 940821 ! -+nscan/fdw.dsc 2252 164570 940418 ! -+nscan/fdx.dsc 1045 75302 931220 ! -+nscan/ihw.dsc 2722 196233 940418 ! -+nscan/ohw.dsc 6808 497395 970509 ! -+nscan/scw.dsc 8471 603787 940509 ! -+nscan/shw.dsc 2001 141662 940418 ! -+nscan/sch.dsc 3455 212078 970509 ! @nstar.dsf -+nscan/sth.dsc 4441 267375 960626 ! @nstar.dsf @ssh.dsf ! standard area -+nscan/dldm.dsc 417 31438 970509 ! -+nscan/ifh.dsc 1069 68386 950111 ! @nstar.dsf -+nscan/rfh.dsc 1231 75420 940613 ! -+nscan/rsh.dsc 1746 103364 940613 ! -+nscan/rsc.dsc 1367 83469 940613 ! -+nscan/fdl.dsc 854 58938 950502 ! -+nscan/ihl.dsc 1296 94359 950502 ! -+nscan/nsc.dsc 2353 141235 950111 ! -+nscan/scn.dsc 461 31685 930922 ! -+nscan/nscan.for 2490 156924 040110 ! @wng.def @nsc.def -+nscan/ngen.for 534 38147 931214 ! @wng.def -+nscan/nleiden.for 9407 578763 010410 ! @wng.def @cbits.def @fdl_o.def @fdl_t.def @ihl_o.def @ihl_t.def @gfh_o.def @sgh_o.def @sth_o.def @nsc.def -+nscan/nleilu.for 14649 899143 960130 ! @wng.def @nsc.def @sth_o.def -+nscan/nleird.for 11688 714313 951205 ! @wng.def @nsc.def @ihl_o.def @ihl_t.def @sth_o.def -+nscan/nleiwd.for 8470 521725 950502 ! @wng.def @nsc.def @gfh_o.def @sch_o.def @sth_o.def @sgh_o.def -+nscan/nscclp.for 4268 269946 960422 ! @wng.def @sth_o.def @ohw_o.def @scw_o.def -+nscan/nsccop.for 8723 523639 940928 ! @wng.def @gfh_o.def @sgh_o.def @sth_o.def @sch_o.def @nsc.def @ohw_o.def @fdw_o.def @fdx_o.def @scw_o.def @shw_o.def -+nscan/nsccvx.for 9268 568518 960626 ! @wng.def @nsc.def @gfh_o.def @gfh_t.def @sgh_o.def @sgh_t.def @sth_o.def @sth_t.def @sch_o.def @sch_t.def @mdh_o.def @mdh_t.def @mdl_o.def @mdl_t.def @ifh_o.def @ifh_t.def @fdw_o.def @fdw_t.def @fdx_o.def @fdx_t.def @ohw_o.def @ohw_t.def @scw_o.def @scw_t.def @shw_o.def @shw_t.def -+nscan/nsccv1.for 1638 106380 930922 ! @wng.def -+nscan/nscdat.for 23294 1331532 040110 ! @wng.def @cbits.def @nsc.def -+nscan/nscdmp.for 9251 568158 970509 ! @wng.def @nsc.def @fdw_o.def @fdw_t.def @ohw_o.def @ohw_t.def -+nscan/nscgif.for 8020 499166 950111 ! @wng.def @nsc.def @shw_o.def @shw_t.def @ihw_o.def @ihw_t.def @sth_o.def @ifh_o.def -+nscan/nscggn.for 5649 361379 040110 ! @wng.def @sth_o.def @ifh_o.def -+nscan/nschas.for 2063 129322 950220 ! @wng.def @cbits.def @sth_o.def -+nscan/nscifs.for 6460 391342 970509 ! @wng.def @sth_o.def -+nscan/nscini.for 690 46217 930922 ! @wng.def @nsc.def -+nscan/nsclli.for 11408 705886 000225 ! @wng.def @nsc.def @sth_o.def @fdw_o.def @ohw_o.def @scw_o.def @shw_o.def @shw_t.def @ihw_o.def @ihw_t.def -+nscan/nsclod.for 29670 1856155 010410 ! @wng.def @cbits.def @fdw_o.def @fdw_t.def @fdx_o.def @fdx_t.def @ohw_o.def @ohw_t.def @scw_o.def @scw_t.def @gfh_o.def @sgh_o.def @sth_o.def @ifh_o.def @nsc.def -+nscan/nsclrd.for 15324 948423 010410 ! @wng.def @nsc.def @shw_o.def @shw_t.def @ihw_o.def @ihw_t.def @sth_o.def @ifh_o.def -+nscan/nsclwd.for 14011 866246 960626 ! @wng.def @nsc.def @gfh_o.def @ohw_o.def @sch_o.def @sth_o.def @sgh_o.def -+nscan/nsclif.for 8255 530544 010410 ! @wng.def @nsc.def @shw_o.def @shw_t.def @ihw_o.def @ihw_t.def @sth_o.def @ifh_o.def -+nscan/nscmbl.for 1179 74248 000922 ! @wng.def @sth_o.def -+nscan/nscnop.for 7959 493207 960422 ! @wng.def @nsc.def @sth_o.def @sch_o.def @ohw_o.def @scw_o.def -+nscan/nscnvs.for 8086 495564 931012 ! @wng.def @nsc.def @cbits.def @gfh_o.def @sgh_o.def @sth_o.def @sch_o.def @mdh_o.def @fdw_o.def @fdx_o.def @ohw_o.def @scw_o.def @shw_o.def -+nscan/nscofr.for 15512 914723 010410 ! @wng.def @nsc.def @cbits.def @gfh_o.def @sgh_o.def @sth_o.def @sch_o.def @ohw_o.def @ohw_t.def @scw_o.def @scw_t.def @shw_o.def @shw_t.def @rfh_o.def @rfh_t.def @rsh_o.def @rsh_t.def @rsc_o.def @rsc_t.def -+nscan/nscoto.for 11334 667030 931007 ! @wng.def @nsc.def @cbits.def @gfh_o.def @sgh_o.def @sth_o.def @sch_o.def -+nscan/nscpfh.for 1218 82669 931123 ! @wng.def @gfh_o.def -+nscan/nscpfl.for 9652 600532 010410 ! @wng.def @sth_o.def @gfh_o.def @sgh_o.def @ohw_o.def -+nscan/nscpls.for 3752 229876 940928 ! @wng.def @cbits.def @sth_o.def -+nscan/nscpsh.for 2810 180783 940215 ! @wng.def @sth_o.def -+nscan/nscpsl.for 1632 105341 000929 ! @wng.def @sch_o.def @sth_o.def -+nscan/nscpuv.for 9522 522662 010410 ! @wng.def @nsc.def -+nscan/nscqc0.for 1477 88772 940821 ! @wng.def @qub_o.def -+nscan/nscqe0.for 3636 221793 940901 ! @wng.def @cbits.def @qub_o.def @sth_o.def -+nscan/nscqfn.for 7251 456444 940901 ! @wng.def @ssh_o.def @cbits.def @qub_o.def @sth_o.def -+nscan/nscqop.for 8626 543338 940821 ! @wng.def @ssh_o.def @cbits.def @qub_o.def @sth_o.def -+nscan/nscqr0.for 1406 88976 940821 ! @wng.def @cbits.def @qub_o.def @sth_o.def -+nscan/nscqs0.for 2858 175200 940821 ! @wng.def @qub_o.def -+nscan/nscqsr.for 9361 553671 940821 ! @wng.def @cbits.def @qub_o.def @sth_o.def @sch_o.def -+nscan/nscqw0.for 7969 444351 940821 ! @wng.def @qub_o.def -+nscan/nscqwa.for 4721 288887 940901 ! @wng.def @cbits.def @qub_o.def @sth_o.def -+nscan/nscqwf.for 1279 81715 940901 ! @wng.def @cbits.def @qub_o.def @sth_o.def -+nscan/nscreg.for 3937 247338 931221 ! @wng.def @nsc.def @sth_o.def @gfh_o.def @sgh_o.def @scn.def -+nscan/nscrif.for 1798 115371 930922 ! @wng.def @cbits.def @sth_o.def -+nscan/nscsad.for 2820 181325 940509 ! @wng.def @cbits.def -+nscan/nscscr.for 28124 1664944 960130 ! @wng.def @cbits.def @scw_o.def @sth_o.def @sch_o.def -+nscan/nscscw.for 5477 373813 040107 ! @wng.def @sth_o.def @sch_o.def -+nscan/nscsif.for 2080 134975 940228 ! @wng.def @sth_o.def -+nscan/nscstg.for 2694 179178 960626 ! @wng.def @sth_o.def @dldm.def -+nscan/nscswc.for 9017 614426 031231 ! @wng.def @cbits.def @sth_o.def @sch_o.def -+nscan/nscswi.for 5030 312988 950714 ! @wng.def @cbits.def @sth_o.def @sch_o.def -+nscan/nsctls.for 3876 231935 940928 ! @wng.def @sth_o.def -+nscan/nscumf.for 3923 234670 930922 ! @wng.def -+nscan/nscuvf.for 24326 1448462 970529 ! @wng.def @cbits.def @ohw_o.def @scw_o.def @sth_o.def @sch_o.def @nsc.def -+nscan/nscuv0.for 10863 642718 970529 ! @wng.def @sth_o.def @ohw_o.def @scw_o.def @cbits.def -+nscan/nscuv1.for 7472 471585 970529 ! @wng.def @sth_o.def @ohw_o.def @scw_o.def -+nscan/nscuv2.for 3869 242329 930922 ! @wng.def @sth_o.def @ohw_o.def @scw_o.def -+nscan/nscuv3.for 7172 446659 930922 ! @wng.def @sth_o.def @ohw_o.def @scw_o.def -+nscan/nscuv4.for 7408 460071 930922 ! @wng.def @sth_o.def @ohw_o.def @scw_o.def -+nscan/nscuv5.for 6012 374212 930922 ! @wng.def @sth_o.def @ohw_o.def @scw_o.def -+nscan/nscuwb.for 2034 130034 930922 ! @wng.def -+nscan/nscwe0.for 5170 315642 040110 ! @wng.def @nsc.def @sth_o.def @sth_t.def @sch_o.def @sch_t.def -+nscan/nscxes.for 6947 401287 931220 ! @wng.def -+nscan/nscxfh.for 5360 313770 010629 ! @wng.def @gfh_o.def @sgh_o.def @gfh_e.def @sgh_e.def -+nscan/nscxsh.for 10572 628463 940509 ! @wng.def @sth_o.def @fdw_o.def @fdx_o.def @ohw_o.def @scw_o.def @shw_o.def @gfh_o.def @mdh_o.def @sgh_o.def @mdl_o.def @sch_o.def @ifh_o.def @sth_e.def @fdw_e.def @fdx_e.def @ohw_e.def @scw_e.def @shw_e.def @gfh_e.def @mdh_e.def @sgh_e.def @mdl_e.def @sch_e.def @ifh_e.def -+nscan/nscxsl.for 4959 292011 970509 ! @wng.def @sch_o.def @gfh_o.def @sch_e.def -+nscan/nscxxs.for 5103 309392 010420 ! @wng.def -+sys/bin.grp 1342 85063 010423 -+sys/ms2scn.xhp -b 10638633 819849484 000330 -+sys/ms2scn.xso -b 6568100 502731096 000330 -+sys/gawk.xvx -b 140288 13838385 930922 -+sys/genaid.xvx -b 99840 8750096 940721 -+sys/xmosaic.xhp -b 1456166 166160209 940516 -+sys/xmosaic.xsw -b 2612309 297454190 940516 -+sys/xmosaic.xdw -b 1684420 185011768 940613 -+sys/xmosaic.xda -b 1732372 107018389 940223 -+sys/gids.xcv -b 483328 32422764 931215 -+sys/gids.xda -b 346114 21382770 951205 -+sys/gids.xdw -b 622592 36934481 931118 -+sys/gids.xhp -b 184320 13892464 931022 -+sys/gids.xsw -b 385024 29542727 931022 -+sys/gids.xso -b 525868 43289256 960626 -+sys/gids.xli -b 779228 80947254 010423 -+sys/gcompress.xvx -b 10752 937015 940623 -+sys/tar.xvx -b 15360 1273807 940623 -+sys/giplib.acv -b 1758436 80700151 931215 -+sys/giplib.ada -b 263108 10415098 951205 -+sys/giplib.adw -b 2696080 129522818 931118 -+sys/giplib.ahp -b 1704484 89242444 931022 -+sys/giplib.asw -b 1386952 85938247 931022 -+sys/giplib.aso -b 1962736 108114800 960626 -+sys/giplib.ali -b 2062780 141416156 010423 -+sys/ionost.xsw -b 1310720 80575845 960130 -+sys/ionost.xhp -b 761856 51152560 970509 -+sys/sys.grp 5244 388151 040119 -+sys/batch_ask.c 1671 128906 961017 -+sys/batch_log.c 1042 75148 951205 -+sys/batch_sync.c 1568 123038 970509 -+sys/bup.csh 887 65483 010522 -+sys/compile.csh 43326 3056052 040119 -+sys/csh2p.pls 28769 2041554 940623 -+sys/c2aid.pls 25328 1817439 940721 -+sys/database.idx 93631 6242105 040119 -+sys/document.csh 15793 1207993 960502 -+sys/document.pls 45054 2636747 940623 -+sys/doc_cook.csh 10050 782181 010522 -+sys/doc_keys.csh 10412 750292 960626 -+sys/doc_preprocess.csh 6264 453959 960513 -+sys/doc_print.csh 7171 553897 960502 -+sys/doc_script.csh 1284 96964 950117 -+sys/doc_script.c 9978 671867 940707 -+sys/doc_test.csh 8704 628269 960513 -+sys/dwrecord.csh 5178 398367 970509 -+sys/include.c 1394 101908 940928 -+sys/genaid.c 63233 4352816 040110 -+sys/initcompile.csh 3928 306050 000309 -+sys/init_wsrt.csh 7597 611051 940721 -+sys/lock.idx 2359 195131 001215 -+sys/newerfile.c 622 47782 951205 -+sys/shadow.csh 38996 2724242 000309 -+sys/shadow.pls 56014 3325081 940623 -+sys/switches.csh 9448 709425 031205 -+sys/update.csh 86292 6083462 040119 -+sys/update.pls 126270 7478579 940623 -+sys/version.idx 21 1724 000929 -+sys/scissor.csh 38481 2781596 010522 -+sys/tmsdoc.csh 3011 222324 010522 -+sys/scissor.c 9130 692075 010522 -+sys/ionos.c 12187 843697 960422 -+sys/ionost.pin 5369 402889 950502 -+sys/filpo.kwa 1160 79977 951205 -+sys/obslog.pls 13763 917956 980707 -+sys/i_li.csh 656 51594 031229 -+sys/i_al.csh 454 33854 930922 -+sys/i_cv.csh 474 35224 930922 -+sys/i_da.csh 476 35794 940222 -+sys/i_dw.csh 476 35794 930922 -+sys/i_hp.csh 714 54429 940203 -+sys/i_so.csh 447 33757 960626 -+sys/i_sw.csh 454 34314 931110 -+sys/i_vx.csh 691 50708 940623 -+sys/wngfex.com 2619 149833 940623 -+sys/wngfex.csh 5435 363636 970509 -+sys/n_links.com 16186 1134058 940721 -+sys/xmosaic_restart.csh 4197 321574 000225 -+sys/signal_and_sync.c 1666 133630 941115 -+sys/newstar_init.csh 8895 690183 010522 -+sys/newstar_init.com 6353 473326 010522 -+sys/newstar_env.csh 2095 164369 010625 -+sys/newstar_env.com 1198 81884 940623 -+sys/newstar_nfra.csh 4495 349735 030901 -+sys/wngfex_nfra.com 1025 64863 930922 -+sys/wngfex_nfra.csh 2708 184604 970509 -+sys/i_hpnfra.csh 213 16451 980707 -+sys/i_sonfra.csh 140 10877 960626 -+sys/i_linfra.csh 95 7220 010326 -+sys/newstar_estec.csh 1075 85520 951213 -+sys/wngfex_estec.csh 826 59407 950111 -+sys/newstar_rug.csh 1762 140466 010522 -+sys/wngfex_rug.csh 964 68211 960422 -+sys/i_hprug.csh 173 13056 970509 -+sys/i_sorug.csh 222 17387 040110 -+sys/i_swrug.csh 256 19881 941031 -+sys/newstar_rul.csh 1823 141832 951213 -+sys/wngfex_rul.csh 826 63590 950714 -+sys/i_hprul.csh 140 10835 940317 -+sys/i_swrul.csh 158 11799 950714 -+sys/newstar_ruu.csh 1744 137825 960726 -+sys/wngfex_ruu.csh 1017 72805 960626 -+sys/newstar_sron.csh 1230 98449 951213 -+sys/wngfex_sron.csh 1002 71314 961017 -+sys/i_hpsron.csh 107 8186 950111 -+sys/newstar_uva.csh 1327 105928 010522 -+sys/wngfex_uva.csh 993 70352 940418 -+sys/newstar_wenss.csh 2785 221283 010522 -+sys/wngfex_wenss.csh 2358 162184 950714 -+sys/i_hpwenss.csh 150 11169 950530 -+sys/newstar_wsrt.csh 1505 120726 010522 -+sys/wngfex_wsrt.csh 942 66794 970509 -+sys/i_hpwsrt.csh 107 8232 960422 -+sys/newstar_airub.csh 1241 99212 951215 -+sys/wngfex_airub.csh 779 55952 951215 -+sys/newstar_arecb.csh 1186 93041 951213 -+sys/wngfex_arecb.csh 833 60067 931014 -+sys/i_swarecb.csh 108 8431 940314 -+sys/newstar_atnf.csh 2101 164047 960813 -+sys/newstar_atnf.com 1689 119001 940623 -+sys/wngfex_atnf.com 593 40247 940623 -+sys/wngfex_atnf.csh 883 63368 930922 -+sys/i_atnf.csh 75 5377 950123 -+sys/i_soatnf.csh 140 10838 960626 -+sys/newstar_bao.csh 1227 95444 951213 -+sys/wngfex_bao.csh 779 55694 940623 -+sys/newstar_calt.csh 1145 92126 951213 -+sys/wngfex_calt.csh 830 59637 950502 -+sys/newstar_irabo.csh 927 72693 951213 -+sys/wngfex_irabo.csh 790 60698 951205 -+sys/newstar_kosma.csh 1214 95099 951213 -+sys/wngfex_kosma.com 883 56871 930922 -+sys/wngfex_kosma.csh 969 69376 930922 -+sys/i_hpkosma.csh 108 8274 931014 -+sys/newstar_lick.csh 1278 102716 010522 -+sys/wngfex_lick.csh 1002 71619 960813 -+sys/i_swlick.csh 155 11936 970509 -+sys/newstar_raiub.csh 2563 193250 980707 -+sys/wngfex_raiub.csh 1223 87147 980707 -+sys/i_swraiub.csh 161 12966 931021 -+sys/i_soraiub.csh 153 12065 980707 -+sys/newstar_ucb.csh 1405 112348 951213 -+sys/wngfex_ucb.csh 636 50640 940914 -+sys/i_swucb.csh 76 5683 941019 -+sys/newstar_ucsb.csh 1481 115563 960130 -+sys/wngfex_ucsb.csh 555 44115 931216 -+sys/i_swucsb.csh 206 14970 950120 -+sys/data_splitter.kwa 0 0 000000 -+wng/wnc.grp 3913 282016 010629 -+wng/wnc.dsc 1326 82531 930922 ! -+wng/twnc.for 1081 65076 031205 ! @wng.def -+wng/wncaj.for 2293 140447 930922 ! @wng.def -+wng/wncaln.for 2334 144465 010402 ! @wng.def -+wng/wncacd.for 4674 273445 010402 ! @wng.def -+wng/wncacu.for 1638 103799 930922 ! @wng.def -+wng/wncacx.for 1860 117002 930922 ! @wng.def -+wng/wncata.for 4753 293841 930922 ! @wng.def -+wng/wncat0.for 9215 520668 930922 ! @wng.def -+wng/wncauc.for 810 54375 930922 ! @wng.def -+wng/wncaup.for 838 57230 931202 ! @wng.def -+wng/wncalo.for 775 53311 931202 ! @wng.def -+wng/wnccae.for 3923 235332 930922 ! @wng.def -+wng/wnccst.for 1080 68061 930922 ! @wng.def -+wng/wnccvs.for 4205 260797 940203 ! @wng.def -+wng/wnccvs_x.for 4140 260836 930922 ! @wng.def -+wng/wnccxs.for 1497 97354 960813 ! @wng.def -+wng/wncexh.for 394 28062 930922 ! @wng.def -+wng/wncfad.for 1512 94448 930922 ! @wng.def -+wng/wncfcl.fsc 2733 167764 940201 ! @wng.def @wnc.def -+wng/wncfhd.fvx 1365 93401 930922 ! @wng.def @wnc.def -+wng/wncfhd.cun 3604 244829 031205 ! -+wng/wncfhd.fal 1755 116353 930922 ! @wng.def @wnc.def -+wng/wncfhd_x.for 1407 81903 930922 ! @wng.def @wnc.def -+wng/wncfop.fsc 3283 198512 010629 ! @wng.def @wnc.def -+wng/wncfsv.for 2544 154848 940217 ! @wng.def @wnc.def -+wng/wncout.for 4661 268813 010223 ! @wng.def @wnc.def -+wng/wncsad.for 1014 65306 930922 ! @wng.def -+wng/wncsys.fsc 1128 75749 940721 ! @wng.def -+wng/wnctim.for 1809 114894 930922 ! @wng.def -+wng/wnctrp.fsc 1253 86756 930922 ! @wng.def @($ssdef) -+wng/wnctxt.fvx 1225 83434 930922 ! @wng.def -+wng/wnctxt.cun 6238 420673 031205 ! -+wng/wnctxt.fal 2239 142086 930922 ! @wng.def -+wng/wnctxt_x.for 20434 1269543 010410 ! @wng.def -+wng/wnctxi_x.for 15263 947391 010410 ! @wng.def -+wng/wnd.grp 3370 246070 031205 -+wng/gfh.dsc 1272 89461 931220 ! -+wng/sgh.dsc 895 55344 931220 ! -+wng/ssh.dsf 373 24986 931020 ! -+wng/ssh.dsc 1382 98118 931020 ! @ssh.dsf -+wng/wnd.dsc 1093 68896 940228 ! -+wng/wnddab.for 9772 568085 010410 ! @wng.def @wnd.def @cbits.def -+wng/wnddap.for 1344 91606 940216 ! @wng.def @wnd.def -+wng/wnddis.fsc 4265 267619 020524 ! @wng.def -+wng/wndfil.for 4908 298398 010410 ! @wng.def @wnd.def -+wng/wndini.for 653 43708 940928 ! @wng.def -+wng/wndlnf.for 2627 184078 941019 ! @wng.def @gfh_o.def @sgh_o.def -+wng/wndlng.for 3054 208306 930922 ! @wng.def @gfh_o.def @sgh_o.def -+wng/wndlnk.for 2397 168829 930922 ! @wng.def -+wng/wndlog.for 1924 121255 940311 ! @wng.def @wnc.def -+wng/wndnod.for 10536 658500 040110 ! @wng.def @wnd.def @gfh_o.def -+wng/wndpap.for 1425 89593 940509 ! @wng.def -+wng/wndpar.fvx 1293 78463 930922 ! @wng.def @wxh.def -+wng/wndpar.cun 5691 411803 031205 ! @wng.inc @wxh.inc -+wng/wndpar.fal 1619 97580 930922 ! @wng.def @wxh.def -+wng/wndpoh.for 1373 103681 010410 ! @wng.def -+wng/wndrun.for 420 28948 930922 ! @wng.def @wnd.def -+wng/wndsta.for 13700 886542 031229 ! @wng.def @ssh_o.def -+wng/wndsta_x.for 9504 663618 931216 ! @wng.def @ssh_o.def -+wng/wndstg.for 8162 514919 941019 ! @wng.def @ssh_o.def @gfh_o.def @sgh_o.def -+wng/wndsti.for 1496 99071 931020 ! @wng.def @ssh_o.def -+wng/wndstr.for 1120 75567 931020 ! @wng.def @ssh_o.def -+wng/wndtci.for 2039 124081 930922 ! @wng.def -+wng/wndxlp.for 4168 273124 940928 ! @wng.def @wnd.def -+wng/wnf.grp 2795 205038 941110 -+wng/fcq.dsc 475 30458 930922 ! -+wng/mca.dsc 1424 84375 930922 ! -+wng/fca.dsc 3002 181027 930922 ! -+wng/fbc.dsc 590 37174 930922 ! -+wng/fel.dsc 545 34645 930922 ! -+wng/twnf.for 1537 99795 010227 ! @wng.def -+wng/wnfexh.for 495 33977 930922 ! @wng.def @fcq.def -+wng/wnfcl.for 1914 116086 010411 ! @wng.def @mca_o.def @fca_o.def @fbc_o.def @fel_o.def -+wng/wnfcl_x.fvx 4456 268820 930922 ! @wng.def @($ssdef) @($iodef) @fca_o.def @mca_o.def @($fibdef) -+wng/wnfcl_x.cun 3383 233218 010412 ! @fca_o.inc @mca_o.inc @wng.inc -+wng/wnfdmo.for 1019 61358 010227 ! @wng.def @mca_o.def -+wng/wnfdmo_x.fvx 1348 85445 930922 ! @wng.def @($iodef) @($dmtdef) @($ssdef) @mca_o.def -+wng/wnfdmo_x.cun 1001 62032 010412 ! @mca_o.inc -+wng/wnfeof.for 2997 182146 950111 ! @wng.def @mca_o.def @fca_o.def -+wng/wnffnm.for 1485 96207 930922 ! @wng.def -+wng/wnfini.for 522 36207 930922 ! @wng.def @fcq.def -+wng/wnfio.for 4318 269950 930922 ! @wng.def @mca_o.def @fca_o.def @fbc_o.def @fel_o.def -+wng/wnfio_x.fvx 24294 1491422 931007 ! @wng.def @($ssdef) @fca_o.def @mca_o.def @fel.o.def @fbc_o.def @fel_o.def @($iodef) @($fibdef) -+wng/wnfio_x.cun 18975 1289475 010412 ! @fca_o.inc @mca_o.inc @fel_o.inc @fbc_o.inc -+wng/wnfmou.for 3063 195630 940812 ! @wng.def @mca_o.def -+wng/wnfmou_x.fvx 5340 337128 940812 ! @wng.def @($dvidef) @($lnmdef) @($mntdef) @($mtdef) @($iodef) @($ssdef) @($devdef) @mca_o.def -+wng/wnfmou_x.cun 3681 253589 010412 ! @mca_o.inc -+wng/wnfop.for 10383 636128 950111 ! @wng.def @mca_o.def @fca_o.def @fcq.def @fbc_o.def @fel_o.def -+wng/wnfop_x.fvx 9169 547563 930922 ! @wng.def @($fibdef) @($fabdef) @($namdef) @($rabdef) @($ssdef) @($iodef) @fca_o.def @mca_o.def @($atrdef) -+wng/wnfop_x.cun 5497 362769 010412 ! @fca_o.inc @mca_o.inc -+wng/wnfsci.fsc 2106 151496 941110 ! @wng.def -+wng/wnfsci_x.cun 7203 536024 010522 ! -+wng/wnftfc.for 2010 118160 930922 ! @wng.def @fcq.def -+wng/wnftrw.fvx 2191 137907 930922 ! @wng.def @($iodef) @mca_o.def -+wng/wnftrw.cun 19045 1282796 000404 ! @mca_o.inc -+wng/wnftvl.for 857 55993 931202 ! @wng.def @mca_o.def @fca_o.def -+wng/wnfth1.for 829 53825 931202 ! @wng.def @mca_o.def @fca_o.def -+wng/wnfth2.for 829 53832 931202 ! @wng.def @mca_o.def @fca_o.def -+wng/wng.grp 9327 609971 970613 -+wng/login_mask.sun 392 32792 930922 -+wng/cshrc_mask.sun 285 25257 930922 -+wng/login_mask.com 1014 63329 930922 ! -+wng/logout_mask.sun 29 2427 930922 -+wng/logout_mask.com 1052 63394 930922 ! -+wng/wnglogin.sun 563 41581 930922 -+wng/wnxlogin.com 5071 314573 930922 ! -+wng/wngcshrc_nfra.ssc 3295 233764 930922 -+wng/wngcshrc_atnf.ssc 1962 142670 940218 -+wng/wngcshrc_rug.ssc 1677 118422 930922 -+wng/wngcshrc_raiub.ssc 1161 86109 930922 -+wng/wngcshrc_wsrt.ssc 1111 82386 930922 -+wng/wngcshrc_kosma.ssc 1336 95810 930922 -+wng/wngcshrc_arecb.ssc 1416 101229 930922 -+wng/wngcshrc.ssc 1880 135687 931220 -+wng/wnxcshrc.ssc 3934 288063 940216 -+wng/nxec.ssc 51325 3234198 940124 -+wng/ncomp.ssc 31348 2075487 930922 -+wng/ndel.ssc 13185 856981 940214 -+wng/nlink.ssc 7920 517584 940203 -+wng/nget.ssc 2989 204784 930922 -+wng/nnet.ssc 4183 266756 930922 -+wng/nhelp.ssc 24363 1821264 930922 -+wng/nxanal.sun 3109 218229 930922 -+wng/nxpin.ssc 6372 412889 930922 -+wng/nxfor.ssc 9764 609086 930922 -+wng/nxup.ssc 3665 237641 930922 -+wng/nxldef.com 12921 842770 930922 ! -+wng/nxldef.sun 17323 1257739 930922 -+wng/nxmain.ssc 20337 1372633 940124 -+wng/nbuild.ssc 20321 1371346 940124 -+wng/ntarz.ssc 11944 823506 010522 -+wng/nupd.ssc 12108 822170 010522 -+wng/nredo.ssc 6972 466628 940124 -+wng/nxclup.ssc 8611 556053 940124 -+wng/wngfex.ssc 14127 887004 930922 -+wng/dwexe.com 4803 281310 930922 ! -+wng/edtini.com 7 576 940216 ! -+wng/wng.dsc 4032 233930 940217 ! -+wng/wxh.dsc 467 29546 930922 ! -+wng/twng.for 66 4055 930922 ! @wng.def -+wng/wngang.for 3675 233376 940203 ! @wng.def -+wng/wngarg.fvx 1684 110981 930922 ! @wng.def -+wng/wngarg.cun 659 40578 940201 ! -+wng/wngarg.mal 2310 179617 930922 -+wng/wngarg_x.mvx 662 45019 930922 -+wng/wngari.for 1655 107807 930922 ! @wng.def -+wng/wngarl.fvx 1556 100643 930922 ! @wng.def -+wng/wngarl.fun 2669 172741 930922 ! @wng.def -+wng/wngasa.fsc 1753 115003 930922 ! @wng.def -+wng/wngcc.for 1103 71073 961017 ! @wng.def @wxh.def -+wng/wngcst.fvx 1645 102607 930922 ! @wng.def @($libdtdef) -+wng/wngcst.cun 2756 201585 960626 ! -+wng/wngex.for 895 61485 961017 ! @wng.def @wxh.def -+wng/wnggva.for 1410 89607 930922 ! @wng.def -+wng/wnggvl.for 990 62223 930922 ! @wng.def -+wng/wnggvm.fvx 1027 68206 930922 ! @wng.def -+wng/wnggvm.cun 1642 113907 010429 ! -+wng/wngin.for 1313 83651 031205 ! @wng.def -+wng/wnglun.fsc 1684 110121 930922 ! @wng.def -+wng/wngmed.fsc 3096 215648 970509 ! @wng.def -+wng/wngmv.for 2493 160825 930922 ! @wng.def -+wng/wngsdi.cun 15275 1026607 010420 ! -+wng/wngsdl.fsc 908 59071 940509 ! @wng.def -+wng/wngseg.fsc 790 54251 930922 ! @wng.def -+wng/wngses.fsc 859 56595 020506 ! @wng.def -+wng/wngseu.fsc 668 45502 010221 ! @wng.def -+wng/wngsgh.fsc 1036 69761 940304 ! @wng.def -+wng/wngsgu.fsc 1105 71887 940307 ! @wng.def -+wng/wngslp.cun 278 19000 970509 ! -+wng/wngsqi.fvx 1226 83314 930922 ! @wng.def -+wng/wngsrt.fvx 1770 112675 930922 ! @wng.def -+wng/wngsrt.fun 860 58727 930922 ! @wng.def -+wng/wngssp.fsc 1240 79329 940721 ! @wng.def -+wng/wngswb.for 1507 92007 930922 ! @wng.def -+wng/wngsws.fvx 541 35927 931104 ! @wng.def -+wng/wngsws.cun 1576 100417 931110 ! -+wng/wngsxh.fsc 3045 194637 010629 ! @wng.def @wxh.def @/usr/include/fortran/signal.h -+wng/wngsyt.fsc 1740 111005 941019 ! @wng.def -+wng/wngu2s.for 8124 497382 950502 ! -+wng/wnm.grp 4223 313299 950714 -+wng/lsq.dsc 2102 127738 950503 ! -+wng/twnm.for 9655 544306 950530 ! @wng.def @sth_o.def @lsq_o.def -+wng/wnmaap.for 1755 109338 930922 ! @wng.def -+wng/wnmccv.for 4794 283597 970530 ! @wng.def -+wng/wnmejc.for 1856 114454 930922 ! @wng.def -+wng/wnmfcs.for 1426 86459 930922 ! @wng.def -+wng/wnmfmx.for 821 51575 930922 ! @wng.def -+wng/wnmftc.for 1414 79142 930922 ! @wng.def -+wng/wnmhib.for 4715 291362 940803 ! @wng.def -+wng/wnmhis.for 14801 858068 940803 ! @wng.def -+wng/wnmign.for 5036 305762 930922 ! @wng.def -+wng/wnmimc.for 6194 363365 930922 ! @wng.def -+wng/wnmisn.for 3942 228500 930922 ! @wng.def -+wng/wnmitn.for 838 52508 930922 ! @wng.def -+wng/wnmitr.for 2909 163553 930922 ! @wng.def -+wng/wnmlga.for 3230 206180 950530 ! @wng.def @lsq_o.def -+wng/wnmlgc.for 1443 91437 950530 ! @wng.def @lsq_o.def -+wng/wnmlgr.for 2369 153747 950714 ! @wng.def @lsq_o.def -+wng/wnmlia.for 2556 165378 950530 ! @wng.def @lsq_o.def -+wng/wnmlin.for 7745 437537 950714 ! @wng.def @lsq_o.def -+wng/wnmlmn.for 8445 492090 950714 ! @wng.def @lsq_o.def -+wng/wnmlsn.for 4442 261071 950530 ! @wng.def @lsq_o.def -+wng/wnmltn.for 6818 413031 950714 ! @wng.def @lsq_o.def -+wng/wnmrnd.mvx 761 49144 930922 -+wng/wnmrnd.cun 849 54741 930922 ! -+wng/wnp.grp 5606 415223 010629 -+wng/wqd.dsc 2305 138055 930922 ! -+wng/wqf.dsc 635 38278 930922 ! -+wng/wqi.dsc 1205 70427 930922 ! -+wng/wq_el0.dsc 2495 149249 950714 ! -+wng/wq_ep0.dsc 2494 149411 950714 ! -+wng/wq_el1.dsc 2495 149308 950714 ! -+wng/wq_ep1.dsc 2494 149470 950714 ! -+wng/wq_el2.dsc 2497 149445 950714 ! -+wng/wq_ep2.dsc 2496 149607 950714 ! -+wng/wq_el3.dsc 2708 165412 950714 ! -+wng/wq_ep3.dsc 2707 165590 950714 ! -+wng/wq_el4.dsc 2647 161059 950714 ! -+wng/wq_ep4.dsc 2646 161223 950714 ! -+wng/wq_pl0.dsc 2495 149843 950714 ! -+wng/wq_pp0.dsc 2494 150005 950714 ! -+wng/wq_pl1.dsc 2495 149902 950714 ! -+wng/wq_pp1.dsc 2495 150112 950714 ! -+wng/wq_pl2.dsc 2497 150039 950714 ! -+wng/wq_pp2.dsc 2496 150201 950714 ! -+wng/wq_pl3.dsc 2708 166050 950714 ! -+wng/wq_pp3.dsc 2707 166228 950714 ! -+wng/wq_pl4.dsc 2647 161689 950714 ! -+wng/wq_pp4.dsc 2646 161867 950714 ! -+wng/wq_qmp.dsc 2502 152427 930922 ! -+wng/wq_qms.dsc 2494 151680 930922 ! -+wng/wq_reg.dsc 2512 151522 930922 ! -+wng/wq_xwi.dsc 2557 155393 931202 ! -+wng/wq_fna.dsc 6717 334010 930922 ! -+wng/wq_fnb.dsc 911 55044 930922 ! -+wng/wpg_xlogo64.inc 3293 201705 930922 -+wng/wqg.dsc 3578 219989 940901 ! -+wng/twnp.for 3945 221186 010410 ! @wng.def -+wng/wpg_grexec.for 568 33304 930922 ! @wng.def -+wng/wpg_xwdriv.cun 49418 3266082 970728 ! @wpg_xlogo64.inc -+wng/wnpcal.for 9206 491524 010412 ! @wng.def -+wng/wnpcax.for 2284 131997 010410 ! @wng.def -+wng/wnpcid.for 751 47823 930922 ! @wng.def @wqg.def @wqd_o.def -+wng/wnpclr.for 797 50385 930922 ! @wng.def @wqg.def @wqd_o.def -+wng/wnpdac.for 1628 100842 930922 ! @wng.def @wqg.def @wqd_o.def -+wng/wnpdex.for 642 44923 930922 ! @wng.def @wqd_o.def -+wng/wnpdop.for 2628 161938 930922 ! @wng.def @wqg.def @wqd_o.def -+wng/wnpdxr.for 619 43301 930922 ! @wng.def -+wng/wnpexh.for 350 24908 930922 ! @wng.def -+wng/wnpex0.for 2481 159282 010410 ! @wng.def @wqg.def @wqd_o.def -+wng/wnpex1.for 3821 227336 930922 ! @wng.def @wqg.def @wqd_o.def -+wng/wnpex2.for 6169 366534 930922 ! @wng.def @wqg.def @wqd_o.def -+wng/wnpind.for 1464 99198 930922 ! @wng.def @wqg.def @wqd_o.def -+wng/wnpmsg.for 1153 72004 930922 ! @wng.def @wqg.def @wqd_o.def -+wng/wnpopc.for 8156 502413 950714 ! @wng.def @wqg.def @wqd_o.def @wq_qms.def @wq_qmp.def @wq_reg.def @wq_el4.def @wq_ep4.def @wq_pl4.def @wq_pp4.def @wq_el3.def @wq_ep3.def @wq_pl3.def @wq_pp3.def @wq_el2.def @wq_ep2.def @wq_pl2.def @wq_pp2.def @wq_el1.def @wq_ep1.def @wq_pl1.def @wq_pp1.def @wq_el0.def @wq_ep0.def @wq_pl0.def @wq_pp0.def @wq_xwi.def @wqf_o.def @wq_fna.def @wq_fnb.def -+wng/wnpplm.for 3803 222297 930922 ! @wng.def @wqg.def @wqd_o.def -+wng/wnppln.for 3239 197530 930922 ! @wng.def @wqg.def @wqd_o.def -+wng/wnprtn.for 6215 359873 930922 ! @wng.def @wqg.def @wqd_o.def -+wng/wnprtn_x.for 1265 81059 930922 ! @wng.def @wqg.def @wqd_o.def -+wng/wnprtn_y.for 957 62316 930922 ! @wng.def @wqg.def -+wng/wnpset.for 9807 587790 930922 ! @wng.def @wqg.def @wqd_o.def -+wng/wnpsev.for 5728 328338 930922 ! @wng.def @wqg.def @wqd_o.def -+wng/wnptwo.for 24608 1455975 950111 ! @wng.def @wqg.def @wqi_o.def -+wng/wnptxt.for 6604 388602 010410 ! @wng.def @wqg.def @wqd_o.def @wqf_o.def -+wng/wnqel4.fsc 13805 839058 010629 ! @wng.def @wqd_o.def -+wng/wnqqms.for 12594 728700 010410 ! @wng.def @wqd_o.def -+wng/wnqreg.for 9150 522180 010410 ! @wng.def @wqd_o.def -+wng/wnqxwi.fsc 8989 518228 010410 ! @wng.def @wqg.def @wqd_o.def -+wng/wnt.grp 2166 167531 940901 -+wng/wntinc.txt 16062 1365961 930922 -+wng/wnt.dsc 5460 372711 931220 ! -+wng/wntinc.for 9453 589028 010410 ! @wng.def @wnt_o.def @wnt.def -+wng/wntiaf.for 17652 1062457 930922 ! @wng.def @wnt_o.def @wnt.def -+wng/wntian.for 8111 498912 930922 ! @wng.def @wnt_o.def @wnt.def -+wng/wntiap.for 5502 328752 930922 ! @wng.def @wnt_o.def @wnt.def -+wng/wntia0.for 3244 198824 930922 ! @wng.def @wnt_o.def @wnt.def -+wng/wntia1.for 1290 84075 930922 ! @wng.def @wnt_o.def @wnt.def -+wng/wntibp.for 2077 135379 930922 ! @wng.def @wnt_o.def -+wng/wntiol.for 6374 382540 010410 ! @wng.def @wnt_o.def @wnt.def -+wng/wntios.for 39015 2209136 031229 ! @wng.def @wnt_o.def @wnt.def -+wng/wntio0.for 1460 88541 930922 ! @wng.def @wnt_o.def -+wng/wntio1.for 840 55178 930922 ! @wng.def @wnt_o.def -+wng/wntio2.for 8883 524807 010410 ! @wng.def @wnt_o.def @wnt.def -+wng/wntio5.for 1750 107651 930922 ! @wng.def @wnt_o.def @wnt.def -+wng/wntio6.for 2181 133231 010402 ! @wng.def @wnt_o.def -+wng/wntirl.for 1544 99308 010227 ! @wng.def -+wng/wntiv0.for 2127 129153 930922 ! @wng.def @wnt_o.def -+wng/wntiv9.for 1261 79926 930922 ! @wng.def @wnt_o.def -+wng/wntivg.for 5305 315658 930922 ! @wng.def @wnt_o.def @wnt.def -+wng/wntivp.for 1736 108207 930922 ! @wng.def @wnt_o.def @wnt.def -+wng/wntivs.for 1379 88202 930922 ! @wng.def @wnt_o.def @wnt.def -+wng/wnttil.for 21054 1163163 940901 ! @wng.def -+wng/wnttsg.for 1351 84504 930922 ! @wng.def -+wng/wnt_boot.grp 1110 83719 940216 -+wng/wnt.def -nc 11039 642477 970828 -+wng/wnt.inc -nc 4800 284491 970828 -+wng/wnt_e.def -nc 8556 476521 970828 -+wng/wnt_e.inc -nc 5103 255974 970828 -+wng/wnt_o.def -nc 13121 791940 970828 -+wng/wnt_o.inc -nc 10336 579326 970828 -+wng/wnt_t.def -nc 3025 170495 970828 -+wng/wnt_t.inc -nc 2575 136489 970828 -+wng/wnc.def -nc 2449 121121 010412 -+wng/wnc.inc -nc 2418 123169 970828 -+wng/wnd.def -nc 2270 113054 970828 -+wng/wnd.inc -nc 2257 115379 970828 -+wng/wng.def -nc 9975 539855 970828 -+wng/wng.inc -nc 7574 419288 970828 -+wng/wxh.def -nc 1471 69512 970828 -+wng/wxh.inc -nc 1555 75272 970828 -+wng/fbc_e.def -nc 2011 109477 000922 -+wng/fbc_o.def -nc 2124 113202 000922 -+wng/fbc_t.def -nc 1317 71961 000922 -+wng/fbc_e.inc -nc 1496 78373 000922 -+wng/fbc_o.inc -nc 1976 97073 000922 -+wng/fbc_t.inc -nc 1288 69935 000922 -+wng/fca_e.def -nc 7866 415888 000922 -+wng/fca_o.def -nc 8424 491391 000922 -+wng/fca_t.def -nc 1507 83051 000922 -+wng/fca_e.inc -nc 3770 168664 000922 -+wng/fca_o.inc -nc 6069 320972 000922 -+wng/fca_t.inc -nc 1450 78649 000922 -+wng/fcq.def -nc 1363 65233 000922 -+wng/fcq.def -nc 1363 65233 000922 -+wng/fcq.inc -nc 1440 70649 000922 -+wng/fcq.inc -nc 1440 70649 000922 -+wng/fel_e.def -nc 1853 101843 000922 -+wng/fel_o.def -nc 1979 104524 000922 -+wng/fel_t.def -nc 1317 72126 000922 -+wng/fel_e.inc -nc 1436 76245 000922 -+wng/fel_o.inc -nc 1892 92474 000922 -+wng/fel_t.inc -nc 1288 70028 000922 -+wng/mca_e.def -nc 3389 182478 000922 -+wng/mca_o.def -nc 4578 256868 000922 -+wng/mca_t.def -nc 1475 80855 000922 -+wng/mca_e.inc -nc 2049 100723 000922 -+wng/mca_o.inc -nc 3684 187480 000922 -+wng/mca_t.inc -nc 1404 75189 000922 -+wng/fcq_bd.for -nc 1037 52248 010402 ! -+wng/fcq_bd.for -nc 1037 52248 010402 ! -+wng/wnc_bd.for -nc 2268 116329 010402 ! -+wng/wxh_bd.for -nc 1147 56976 010402 ! -calculate.exe 6.27 1524 1120618 -clear.exe 6.27 1524 1120618 -execute.exe 6.27 1524 1120618 -initdw.exe 6.27 1524 1120618 -let.exe 6.27 1524 1120618 -sys_prtppd.exe 6.27 1524 1120618 -prtunits.exe 6.27 1524 1120618 -restore.exe 6.27 1524 1120618 -save.exe 6.27 1524 1120618 -specify.exe 6.27 1524 1120618 -view.exe 6.27 1524 1120618 -ncopy.exe 6.27 1524 1120618 -nclean.exe 6.27 1524 1120618 -nmap.exe 6.27 1524 1120618 -ngcalc.exe 6.27 1524 1120618 -ngids.exe 6.27 1524 1120618 -nplot.exe 6.27 1524 1120618 -natnf.exe 6.27 1524 1120618 -ncalib.exe 6.27 1524 1120618 -nfilt.exe 6.27 1524 1120618 -nflag.exe 6.27 1524 1120618 -nmodel.exe 6.27 1524 1120618 -nscan.exe 6.27 1524 1120618 -ngen.exe 6.27 1524 1120618 -twnc.exe 6.27 1524 1120618 -twnf.exe 6.27 1524 1120618 -twng.exe 6.27 1524 1120618 -twnm.exe 6.27 1524 1120618 -twnp.exe 6.27 1524 1120618 -wntinc.exe 6.27 1524 1120618 -sys_bldppd.exe 6.27 1524 1120618 diff --git a/src/sys/doc_cook.csh b/src/sys/doc_cook.csh deleted file mode 100755 index f9da641cb828f4a42669f9d99b0461cb0086dcd3..0000000000000000000000000000000000000000 --- a/src/sys/doc_cook.csh +++ /dev/null @@ -1,287 +0,0 @@ -# doc_cook.csh - sourced by document.csh -# -# JPH 940322 Split off from document.csh -# JPH 940707 (Transfer to master system) -# JPH 940712 <program>_<KEWORD>.html in <program> subdirectory -# CMV 940720 Change newstar_home_page to homepage -# JPH 940720 Typos. - Reactivate trailing blank lines in .html -# file.# Fix typo in file selection -# Use symbol l2hdir to locate all latex2html components -# JPH 940725 Correct insertion of navigation line at end of document -# JPH 940810 Keyword help files recognised by __ i.s.o. -# uppercase. Cope with split lines and with -# \textrefs including text in braces within their -# first argument -# JPH 940816 \keyref -# JPH 940818 split off doc_preprocess.csh; Name --> File -# JPH 940914 remove old .html file -# Make insertion of % at \begin/\end{figure} more specific -# JPH 940916 Shift common code ro doc_preprocess; accept .cap files -# JPH 941028 No \keyref. - Handle blanks between \textref arguments -# Retain leading dots in labels and references -# JPH 941104 Fix internal references. - Translate verbatim into -# rawhtml + <PRE> -# JPH 941115 Shift \label in figure environment to top, merge code -# with that for shifting section labels -# JPH 941117 Insert control-H behind < so xmosaic will not think it -# sees a command. -# Fix bug in directory insertion for label-less \textrefs -# (\. --> \.*) -# JPH 941121 Move \textref argt delimiting to doc_preprocess -# JPH 950208 Reject .psc-type files -# JPH 950222 Fix processing of ../<file> references (were -# interpreted as .<label>) -# HjV 950613 Use latex2html stuff from $n_l2h iso. ~jph -# JPH 950823 Replace interdocument referencing code by simpler code -# that relies on l2h mechanism -# Use improved \xxxref parsing by doc_preprocess -# JPH 950927 Srcref --> [Ss]rcref. - Figure labels above FIGURE -# JPH 951004 Remove old .xbm files from target directory -# JPH 951013 Reject all but .tex files -# JPH 951127 Reject untranslatable files (lsq.tex) -# JPH 960131 Bug fix: missing end on foreach -# JPH 960206 Correct processing of non-translatable files -# \fig command: .ps reference --> /fig/.ps -# JPH 960326 -e option -# JPH 960415 Bug fix: Do not insert control-Z in rawhtml sections -# JPH 960507 Bug fix: Do not remove .xbm files (951004), use a better -# method to clear out obsolete ones; also check that all -# required files exist -# Pipe 'yes' into l2h for 'rm' confirmation -# JPH 960513 Remove $Tmp.* -# -# -# List of files that cannot be processed -# - set donotcook = " lsq " - -# Check write access to target help directory tree - -##set echo - touch >&/dev/null $n_hlp/$$.tmp - if ($status) then - echo "FATAL No write access to target directory $n_hlp" - exit -1 - endif - rm -f >&/dev/null $n_hlp/$$.tmp - - if (x$Files[1] =~ x-[Ee]*) then - set echo - shift Files - endif - - if ("$Files" == "") then - echo -n "Enter the name of LaTeX file(s) [All]: " - set Files=( $< ) - set Files=( $Files ) - endif - if ( "$Files" =~ [Aa][Ll][Ll] ) then - cd $n_doc/latex - set here=$cwd - set Files = "*.tex" - endif -# -# Process all files requested, eliminating stray _tmp.tex files -# - foreach File ( $Files ) - if ($File =~ *_tmp.*) continue - if ($File:e != tex) continue - echo -n " ndoc cook $File" - set File=$File:t; set ext = $File:e; set name=$File:r - if (! -e $File) then - echo " - not found" - continue - else if ($ext =~ p??) then - echo " - bad command: Use 'ndoc Key' for .psc-type file" - continue - endif - set Name = $File:r -# -# Check for files that cannot be translated -# - if ("$donotcook" =~ *' '$Name' '* ) then - echo ' - not translatable: using $n_hlp/'"$Name.ps" - rm -f >&/dev/null $n_hlp/src/doc/bin/$Name.ps - ln -s $n_hlp/$Name.ps $n_hlp/src/doc/bin/$Name.ps - continue - endif -# -# Use existing .html file if it is newer than the source. Environment variable -# n_force may be set to bypass this test -# - $n_exe/newerfile.exe $n_hlp/$Name/$Name.html $File - if (! $?n_force && $status == 1) then - echo " - output.html file is up-to-date" - continue - endif - echo "" -# -# Preprocessing common to Cook and Print: Input $File, output $Tmp.0 -# - source $n_src/sys/doc_preprocess.csh -##goto 1 -# -# Create first part of temporary .tex file -# - cat << END >! $Tmp.tex - \documentstyle{article} \begin{document} - \input {$n_l2h/html.sty} - \input {$n_doc/latex/hb_cook_preamble.sty} - \input {$n_doc/latex/hb_symbols.sty} -END -# -# Complete preprocessing -# [remove "."s from references because latex2html does the same for labels -# (This is not necessary if l2h leaves nonalphanumeric characters in labels; -# This mod (consisting of removing all the lines with 's/\W//g') has been -# made in the jph version and proposed to the provider of l2h, 940526.) ] -# The result is appended to the temporary .tex file -# - sed < $Tmp.0 \ -# Complete references. @[4-7]@ delimits '{' + file name, @3@: marks the label \ -# or file extension. We must process the latter before the labels \ -# \ -# srcref including file extension \ - -e 's:@7@{\([^@]*\)@3@:@7@{../src/\1:g' \ -# all other . in references delimit labels \ - -e 's/@3@\./@3@\#./g' \ -# txtref, ascref, psref \ - -e 's:@4@{\([^@][^@]*\)@3@:@4@{../\1/\1.html@3@:g' \ - -e 's:@5@{\([^@]*\)@3@:@5@{../src/doc/txt/\1.txt@3@:g' \ - -e 's:@6@{\([^@]*\)@3@:@6@{../src/doc/bin/\1.ps@3@:g' \ -# add {} around text arguments \ - -e 's:@1@\([^@]*\):{\1}:g' \ - -e 's:@[0-9]@::g' \ -# \ -# Protect '<' signs by adding a non-printing character, \ -# so xmosaic will not mistake them for commands \ - -e '/\\begin{rawhtml}/,/\\end{rawhtml}/\!s:<:<:g' \ - # \ -# Interchange \label with the section heading to which it refers, so xmosaic \ -# will jump to the proper place. \ -# Place label in figure environment at the beginning \ -# Append dummy lines at end to insure that when \ -# the user follows a link, the target will always be displayed at the top of \ -# the screen. \ -# \ - | nawk -F' ' # dummy record separator to avoid overflows \ - 'BEGIN{ lbl=0; n=0;} \ - /\\label/{ lbl=1; print $0; next } \ - { if (lbl ){ \ - for (i=1; i<=n; i++) print s[i]; n=0; lbl=0; \ - } } \ - /\\begin{figure}/{ s[1]=$0; n=1; next } \ - /\\section/{ s[1]=$0; n=1; next} \ - /\\subsection/{ s[1]=$0; n=1; next} \ - /\\subsubsection/{ s[1]=$0; n=1; next} \ - { if (n){ \ - if (! NF){ \ - next; \ - }else{ \ - n++; s[n]=$0; \ - if (n >5) lbl=1; \ - next; \ - } \ - }else{ \ - print $0; \ - } } \ - END { \ - print "\\begin{rawhtml}"; \ - for (i=0; i<20; i++){ print "<P>.\n"; } \ - print "</BODY> </HTML>\\end{rawhtml} "; \ - }' \ -#\ -# Insert FIGURE anchors, captions, to avoid l2h limitations \ - | sed \ - -e 's:^[^%]*\\fig *{\([^}]*\)}:\\begin{rawhtml}<A HREF="../fig/\1.ps"><STRONG>FIGURE</STRONG></A>\\end{rawhtml}:' \ - -e 's:^[^%]*\\ps *{\([^}]*\)}:\\begin{rawhtml}<A HREF="../fig/\1.ps"><STRONG>FIGURE</STRONG></A>\\end{rawhtml}:' \ - -e 's:^ *\\begin *{ *figure:%&:' -e 's:^ *\\end *{ *figure:%&:' \ - -e 's:\\caption[ \[\]]*:\\ :' \ -# .contents label \ - -e '/\\tableofcontents/i\\ -\\label{.contents}' \ -# Boldface document and section titles \ - -e 's:\\chapter *{:{\\Large\\bf :' \ - -e 's:\\[sub]*section[ {]*:&\\bf :' \ -# Verbatim environment --> rawhtml. This is because l2h uses a large font for \ -# this environment and we want to use <PRE> instead. \ - -e 's: *\\begin *{verbatim}:\\begin{rawhtml} <PRE>:' \ - -e 's:\\end{verbatim}:</PRE> \\end{rawhtml}:' \ - >> $Tmp.tex - echo "\end{document}" >> $Tmp.tex -# -# Convert to .html file, filtering clutter from message output -# latex2html has some hangups about directories, so we run it from $n_hlp, -# using the input file name to insure that we get proper output names. -# -# NOTE: Be careful with changing latex2html command-line options since these may -# have unwanted side effects. For instance, changing to "-info 0" resulted in -# \subsubsections being shown as \subsections in the Contents list -# - cp $Tmp.tex $n_hlp/$name.tex - pushd $n_hlp >&/dev/null - rm -f >&/dev/null $name/$name.html ## $name/*.xbm - - echo "yes" # just in case 'rm' confirmation needed \ - | $n_l2h/latex2html -reuse -allbitmaps -info "" -dir $n_hlp \ - -split 0 -link 0 -address "newstar@astron.nl" \ - -init_file $n_doc/latex2html.pls \ - $name.tex \ - |& sed \ - -e '/^This is /d' -e '/^Computer/d' -e '/^OPENING /d' \ - -e '/% --- Checking /d' \ - -e '/^No string /d' -e '/^ *Cannot create/d' -e '/^ *$/d' \ - -e '/^ *All rights /d' -e '/ NO WARRANTY/d' -e '/Copyright/d' \ - -e '/^Aladdin Ghostscript/d' -e '/^Distributed /d'\ - -e '/ cropping /d' -e '/^Done/d' -e '/^Reusing /d' \ - -e '/\.\.\./d' -e '/^GS>GS>/d' -e '/^LaTeX/d' \ - -e '/^\*\*\* No address/d' - if ($status) then - echo "FATAL" - cat $n_hlp/$name/*_images.log - endif - rm -f >&/dev/null $name.tex -# -# Replace escape commas in the .html file. -# -1: - cd $n_hlp/$name - sed < $name.html \ - -e 's:,,\([A-Za-z]\):\\\1:g' \ - >! $name.tmp - rm -f $name.html; mv $name.tmp $name.html -# -# Clean up: Find all references to icons and the like, move them to a temporary # directrory and delete what is left: These must be obsolete -# -##set echo - mkdir >&/dev/null .tmp - rm -f >&/dev/null .tmp/* - cat images.pl $name.html \ - | awk -F'"' \ - '{ for (i=1; i<=NF; i++){ \ - if ($i ~ /SRC=/ ){ \ - i++; print $i; \ - } } }' \ - | sort -u \ - | tee $Tmp.all \ - | sed \ - -e '/\.\./d' \ - >! $Tmp.x - if (! -z $Tmp.x ) then - mv `cat $Tmp.x` .tmp - rm -f >&/dev/null *.xbm - mv .tmp/* . - endif -# -# Check availability of all required icons etc. -# - foreach file ( `cat $Tmp.all` ) - set file0 = $n_hlp/$name/$file - if (! -e $file0) echo \ - " Missing file $file" - end - rm -f $Tmp.* - popd >&/dev/null - rm -f >&/dev/null $Tmp.*; rm -f $name.ps - - end # file loop diff --git a/src/sys/doc_keys.csh b/src/sys/doc_keys.csh deleted file mode 100755 index 24fc0bba89c94700f62caaa5fc28fdaa206ea394..0000000000000000000000000000000000000000 --- a/src/sys/doc_keys.csh +++ /dev/null @@ -1,352 +0,0 @@ -#! docKeys.csh - sourced from document.csh -goto 000 - -History: - JPH 941028 Overhaul to make single .html file per program, do all - input parsing with awk - JPH 941031 Simplify code (no splitting into temp. files per - keyword). .tex file completely TeX-compatible, copy - output to latex directory so it is available for - printing - JPH 941103 .pef prompts "may vary per application". - Independent output --> \input to <pgm>_..._intfc.tex - Re-introduce file-splitting to get parameters in alphab. - order (but avoiding nawk or the open-file overflow in - awk). - JPH 941104 Skip if no keywords. - Use vb and pg flags entirely - systematically to avoid unwanted directives - JPH 941110 Check for long lines. \title - JPH 941116 Allow comment lines in the middle of a HELP text. As a - consequence, many small changes in the awk logic to make - the process robust against minor deviations in the .psc - format. - Remove leading and trailing quotes - Prefix _ with \ in first \textref argument - HjV 951213 Remove leading quote in PROMPT-line - JPH 960104 Handle in-line comments in 'KEYWORD=' line - JPH 960206 Remove blanks from public-parameter references - JPH 960329 Split lines longer than 80 chars - JPH 960513 sort -u references to public parameters - Change reference to DWARF user interface - JPH 960612 Add a word in document-text literal - -000: -##set echo - if (x$Files[1] =~ x-*) then - set ev = $Files[1] - shift Files - if (x$ev =~ *e*) set echo - if (x$ev =~ *v*) set verbose - endif - if ("$Files" == "") then - echo -n "Enter the name of PIN/PSC/PEF file(s) [All]: " - set Files=( $< ) - set Files=( $Files ) - endif -# -# Process ALL -# - if ("$Files" == "" || "$Files" =~ [Aa][Ll][Ll]) then - set here = `pwd` - foreach Dir ($NSTAR_DIR) - echo "Directory $Dir" - cd $n_src/$Dir - echo "" | $0 k *.p?? # (answer "" to update question) - end - cd $here - exit - endif -# -# Process files in the current directory -## Initialise -# - foreach file ( $Files ) - echo -n " ndoc keys $file " - set ext = $file:e - set pgm = $file:r; set pgm = $pgm:t - set tmp = $pgm.tmp - set klines = `grep -n '^KEYWORD=' $file | sed -e 's/:.*//' ` - if (! -e $file) then - echo " - not found" - continue - else if ($#klines == 0) then - echo " - being skipped: no keywords" - continue - else - echo "" - set ll = \ - `awk '{if (l<length) l=length; next} END {print l}' < $file ` - if ($ll > 80) then - set file1 = $tmp - expand < $file \ - | nawk ' \ - BEGIN{ lw= 80;} \ - /^ *$/{ print $0; next;} \ - { l=length; if (substr($0,l,1) ==" ") l--; \ - for (nb=0; nb<l;){ \ - b=nb; e=b+lw; if (e>l) e=l; e0=e; \ - if (l-b <=lw){ \ - print substr($0,b+1,e-b); next; \ - }else{ \ - for (; e>b && substr($0,e,1) !=" "; e--); \ - nb= e; \ - for (; e>b && substr($0,e,1) ==" "; e--); \ - if (e==b){ \ - if (ll){ \ - for (e=e0; e <=l && substr($0,e,1) !=" "; e++); \ - nb=e; e--; \ - }else{ \ - e=e0; nb=e0; \ - } } } \ - print substr($0,b+1,e-b); \ - } }' \ - >! $file1 - else - set file1 = $file - endif - endif - - set PGM = \ -`echo $pgm | sed -e 'y:abcdefghijklmnopqrstuvwxyz:ABCDEFGHIJKLMNOPQRSTUVWXYZ:' ` - - if ($ext == psc || $ext == pin) then - unset pef - set type = "private" - set Type = "Private" - set out = ${pgm}_private_keys - else - set pef - set type = "public" - set Type = "Public" - set out = ${pgm}_public_keys - endif - set tmp = $pgm.tmp - rm >&/dev/null $tmp.* - set ref = $tmp.ref - -# create awk script to process keyword files. -# (Note that each \\ is reduced to \ as awk reads the script! ) -# The following variables are used: -# d char data-type -# dor logical input line is blank -# end logical end of keyword definition (i.e. start of new keyword or -# help for current one) -# help logical input is HELP -# key logical input is KEYWORD -# h logical processing HELP text -# l number LENGTH value -# m number MIN_NVALUES value -# n number NVALUES value -# p char prompt text -# pg logical in-samepage-mode flag (\spbegin written) -# vb logical in-verbatim-mode flag (\svbegin\begin{verbatim} written} - - cat <<END >! $tmp.awk - BEGIN{ - d=""; p=""; - ref= "$tmp" ".ref"; - printf ("\\\\begin{itemize}\\n") > ref; - } - {key=0; end=0; help=0; } - /^\!/{ if (! h){ next; } } - /^INCLUDE=/{ - for (i=1; i<=length(\$2); i++ ){ - if (substr(\$2,i,1) =="_") break; - } - nm=substr(\$2,1,i-1); \ -# nsh textref in two lines so sed can convert the filename alone to lowercase \ - printf ("\\\\item \\\\textref{%s}\\n{@%s_public_intfc} public keywords\\n", nm, nm) > ref; - next; - } - /KEYWORD=/{ - key=1; - if (substr(\$1,1,1) =="!" ){ key=0;} - end=1; h=0; - if (vb ){ vb=0; printf ("\\\\end{verbatim}\\\\svend\\n"); } - if (pg ){ pg=0; printf ("\\\\spend\\n"); } - } - /HELP=/{ if (substr (\$1,1,1) !="!" ){ help=1; end=1; } } - /PROMPT=/{ - p=substr(\$2,2,length(\$2)-1); - if (pef) p= p " ({\\\\em may vary per application})"; next; - } - /DATA_.*=/{ - x=substr(\$2,1,1); - if (x=="C" ){ d= "Character"; - }else if (x=="D" ){ d= "DoublePrecision"; - }else if (x=="R" ){ d= "Real"; - }else if (x=="I" ){ d= "Integer"; - }else if (x=="J" ){ d= "Integer"; - }else if (x=="L" ){ d= "Yes/No"; - }else { d= "?"; - }; next; - } - /LENGTH=/{ l=\$2; next; } - /NVALUE/{ n=\$2; next; } - /MIN_NVAL/{ m =\$2; next; } - - { if ( end){ - end=0; - if (p !="" || d!="" ){ - printf ("\\\\spbegin\\n"); pg=1; - } - if (p !="" ){ - printf ("{\\\\em Prompt:} %s\\\\\\\\ \\n", p); p=""; - } - if (d !="" ){ - printf ("{\\\\em Expected input:} %s", d); d=""; - if (l !=0 ){ printf (" *%d", l); } - if (n ==m ){ - pl= ""; if (n>1) pl= "s"; - printf (": %d value%s\\n", n, pl); - }else if (m !=0 ){ - printf (": %d to %d values\\n", m, n); - } } - if (pg ){ pg=0; printf ("\\\\spend\\n"); } - } } - { if (key ){ - key=0; - printf ("\\n\\n\\\\subsection{ Parameter %s}\\n", \$2); - printf ("\\\\label{@.%s}\\n\\n", \$2); - p=""; d=""; l=0; m=1; n=1; - next; - } } - { if (help ){ - printf( "\\\\spbegin\\n\\\\svbegin\\\\begin{verbatim}\\n"); - pg=1; vb=1; help=0; h=1; next; - } } - - {if (! h) next; } - { dot=0; } - /^\\./{ dot=1; } - /^ *\$/{ dot=1; } - { if (dot ){ - if (vb ){ vb=0; printf ("\\\\end{verbatim}\\\\svend\\n"); } - if (pg ){ pg=0; printf ("\\\\spend\\n"); } - next; - }else{ - if (! pg ){ pg=1; printf ("\\\\spbegin\\n"); } - if (! vb ){ - vb=1; printf ("\\\\svbegin\\\\begin{verbatim}\\n"); - } } } - /^\\!/{ - if (vb ){ vb=0; printf ("\\\\end{verbatim}\\\\svend\\n"); } - if (\$0 ~ /\\\\/){ - print substr(\$0,2,length-1); - next; - }else{ - next; - } } - { if (h ){ printf ("%s\\n", \$0); next; } } - END{ - if (vb ){ printf ("\\\\end{verbatim}\\\\svend\\n"); vb=0; } - if (pg ){ printf ("\\\\spend \\n"); pg=0; } - printf ("\\\\item \\\\textref{DWARF}{introduction.user.interface} user interface\\n") > ref; \ - } -END -# -## Initialise the .tef file - set date = `date` - cat <<END >! $tmp.1 -% $out.tef -% created from $file on $date -% -% ********** DO NOT EDIT THIS FILE, but its source! ********** -% -END - if ($type == private) cat <<END >! $tmp.1 - -%\section{ References to public interfaces} -%\label{.public} - -\input $ref.1 -END -## cat <<END >! $tmp.1 -## -##\section{ Descriptions of the individual parameters} -##\label{.descriptions} - -##END -# -## Sort keyword sections in alphabetical order. (A workaround is used i.s.o. -## csplit because repeat count on /regexp/ does not work.) -## sed: Remove in-line comments -## Remove leading characters in first HELP line -## expand: Expand tabs so they are shown correctly in \verbatim mode -## awk: Convert .psc/.pef file into tex output -## sed: escape those characters that would confuse TeX -## suppress empty verbatim sections -## (A multiple-sed pipe is use because a single sed could not be made to -## execute the combined commands correctly.) -# - csplit -s -f $tmp. $file1 $klines - foreach f ( $tmp.[0-9][0-9] ) -## set nm = `grep '^KEYWORD=' $f | sed -e 's:.*=::' -e 's:\!.*$::' ` - set nm = \ - `sed -n <$f -e '/^KEYWORD=/\\!d' -e 's:\\!.*$::' -e 's:.*=::p' ` - mv $f $tmp.$nm - end - cat $tmp.[A-Z]* \ - | expand \ - | sed \ - -e 's:\(..*\)\!:\1:' \ - -e '/HELP=/{ \ - i\\ -HELP=\ - s:HELP= *" *::; \ - }' \ - -e '{ s:" *$::; s:^" *::; /^ *$/d; }' \ - -e 's: *$::' -e '$a\\ -! ' \ - | nawk -F'=' -f $tmp.awk pef=$?pef \ - | sed \ - -e '/\\label/s:_:.:g' \ - -e '/\\begin{verbatim}/{ \ - N; /\\begin{verbatim}.*\\end{verbatim}/d; \ - }' \ - -e '/\\begin{verbatim}/,/\\end{verbatim}/\!{ \ - s:\([^\]\)_:\1\\_:g; \ - s:<:$<$:g; \ - s:>:$>$:g; \ - s:\#:\\\#:g; \ - }' \ - | sed \ - -e '/\\spbegin/{ \ - N; /\\spbegin.*\\spend/d; \ - }' \ - -e '/@/y:ABCDEFGHIJKLMNOPQRSTUVWXYZ:abcdefghijklmnopqrstuvwxyz:' \ - -e '/\\textref/s:\([A-Z][^\]\)_\([A-Z]\):\1\\_\2:g' \ - -e 's:@::'g \ - >> $tmp.1 -# -## Convert referenced file names to lower case (for this reason \textref lines -## were written in ntwo parts above -## Combine textref lines 2 to 1, sort them and add top and bottom lines -# - sed < $ref \ - -e '/@/y:ABCDEFGHIJKLMNOPQRSTUVWXYZ:abcdefghijklmnopqrstuvwxyz:' \ - | sed \ - -e '/DWARF/b' \ - -e '/\\item/\!b' \ - -e 'N' -e 's:\n{@:{:' \ - | sort -u \ - | sed \ - -e '1i\\ -{\\em See also:}' \ - -e '$a\\ -\\end{itemize}' \ - >! $ref.1 -# -## Convert to .html -# - $n_exe/include.exe $tmp.1 $tmp - mv $tmp $n_doc/intfc/$out.tef - pushd >&/dev/null $n_doc/intfc - setenv n_force - echo "no" | $n_src/sys/document.csh cook ${pgm}_${type}_intfc.tex - popd >&/dev/null -# -# Clean up -# - rm $tmp* - end # file loop diff --git a/src/sys/doc_preprocess.csh b/src/sys/doc_preprocess.csh deleted file mode 100755 index ae792f4c03f6b7382b96d3b6328c0f43c841fae6..0000000000000000000000000000000000000000 --- a/src/sys/doc_preprocess.csh +++ /dev/null @@ -1,136 +0,0 @@ -#! /bin/csh -f -goto 000 - -doc_preprocess.csh - common .tex-file preprocessing for doc_print.csh and doc_cook.csh, to be sourced by both - -Input: File holds the file to be processed -Output: Name = file name - Tmp = name for temp. files - All \input commands are executed recursively - All figures referred to are processed (.fig --> .ps) - Short lines are merged, long lines then split into 80-char lines - File $Tmp.0 is the preprocessed file - \captions are italicised and given a dummy index argument - \xxxref first arguments are preprocessed to the format - - @0@<command>@1@{<text>}@<n>@{<file>@3@.<label or extension>} - - with n=4 for \textref, =5 for \ascref and =6 for \psref - - -History: - JPH 940818 Creation - Improve/correct line concatenation algorithm - JPH 940829 Again ... - JPH 940914 \caption processing - JPH 940916 eliminate fig names with a '>' - $File includes extension, $Tmp setup - JPH 941104 Eliminate comment lines to avoid awk overflow downstream - JPH 941111 Exclude verbatim sections from line-merging - JPH 941116 Define Name - JPH 941121 Delimit \textref arguments - JPH 941123 Prefix .cap-file \inputs with '../fig/' - Process \htmladdnormallink arguments - JPH 941130 Handle \textrefs with indented continuation line - JPH 950214 typo - JPH 950823 Revise inter-document reference processing - JPH 950928 newline after \label (required for Cook figure - processing) - JPH 951016 set Ext - JPH 951127 \n after \label only in figure environment - JPH 960220 Add leading '}' to chars that force a line break - JPH 9604.. Revised line-merging algorithm - JPH 960426 Retain leading % of comments so line break in too long - paragraphs are preserved. - Use tab record separator for awk. - JPH 960429 \\ terminator forces line break - Fix typo in psref processing - Fix recognition of % in first position - JPH 960513 Suppress line-merging in verbatim sections - -000: -# -# Execute all \input and \include recursively so we have all \textref and -# \keyref explicitly present for editing. -# awk: Concatenate paragraphs to single lines to insure that LaTeX commands -# are contiguous with their arguments. -# - set Name = $File:r - set Ext = $File:e - set Tmp = ${Name}_tmp - rm >&/dev/null $Tmp.* - sed -e '/^\.c+/,/^\.c-/d' < $File \ - -e 's:\\input *{\([^.].*\.cap *}\):\\input{../fig/\1:' \ - >! $Tmp.00 - $n_exe/include.exe $Tmp.00 $Tmp.01 - - expand < $Tmp.01 \ - | awk -F' ' # dummy separator to avoid 'too many fields' error \ - '/^[ ]*$/{printf ("\n\n"); next;} # empty-ln placeholder \ - /\\begin *{ *verbatim *}/{verb=1} # exclude verbatim \ - {if (verb ){ print $0; next; }} # sections from \ - /\\end *{ *verbatim *}/{verb=0; next; } # line-merging \ - /^[ \\]/{printf ("\n");} # 'newline' flag chars \ - /[^\\]*%/{printf ("\n");} # unescaped % char \ - /^\./{printf ("\n");} # '.' command \ - {printf ("%s "), $0;} \ - /[^\\]*%/{printf ("\n");} # unescaped % char \ - /\\\\ *$/{printf ("\n");} # '\\' line terminator \ - END{printf ("\n");} # terminate last line \ - ' \ - | sed \ - -e '/^$/d' # remove dummy lines \ - -e 's:::' # and placeholders \ -# Format \xxxref commands into the form \ -# @1@<command>{<text with \_}{@nn@file with directory, extension and _@3@} \ -\ - | sed \ - -e 's:\([^\]%\).*:\1:g' \ - -e 's:^%.*:%:' \ - -e '/\\newcommand/b' \ - -e 's:\\caption *{:\\caption[.]{:' \ - -e 's:\\it *\\it:\\it:' \ - -e 's:\\caption$:\\caption[.]:' \ -# Mark reference commands my @0@ \ -# Mark start of file argument by @4@ for \textref, \ -# @5@ for \ascref, @6@ for \psref @7@ for \srcref \ -# add continuation lines until we have no incomplete first arguments (this \ -# should be unnecessary because line-merging takes care of this; we may try to \ -# remove the '/[^@]...' lines when they cause trouble \ - -e ':1' \ - -e 's:\(\\[Tt]extref *{[^}]*{[^}]*}[^}]*} *\):@0@\1@4@:g' \ - -e 's:\(\\[Tt]extref *{[^}]*} *\):@0@\1@4@:g' \ - -e 's:\(\\[Aa]scref *{[^}]*{[^}]*}[^}]*} *\):@0@\1@5@:g' \ - -e 's:\(\\[Aa]scref *{[^}]*} *\):@0@\1@5@:g' \ - -e 's:\(\\[Pp]sref *{[^}]*{[^}]*}[^}]*} *\):@0@\1@6@:g' \ - -e 's:\(\\[Pp]sref *{[^}]*} *\):@0@\1@6@:g' \ - -e 's:\(\\[Ss]rcref *{[^}]*{[^}]*}[^}]*} *\):@0@\1@7@:g' \ - -e 's:\(\\[Ss]rcref *{[^}]*} *\):@0@\1@7@:g' \ - -e '/[^@]\\[Tt]extref/\!b 2' -e 'N' -e 's:\n: :' -e 'b 1' \ - -e '/[^@]\\[Aa]scref/\!b 2' -e 'N' -e 's:\n: :' -e 'b 1' \ - -e '/[^@]\\[Pp]sref/\!b 2' -e 'N' -e 's:\n: :' -e 'b 1' \ - -e '/[^@]\\[Ss]rcref/\!b 2' -e 'N' -e 's:\n: :' -e 'b 1' \ - -e ':2' \ -# Split command and text argument \ - -e 's:@0@[^{]*:&@1@:g' \ -# Place file argument in @nn@ @3@; \ -# add continuation lines until we have no incomplete file arguments \ - -e ':3' \ - -e 's:@\([4-9]\)@\([^.}]*\)\([\.}]\):@\1\1@\2@3@\3:g' \ - -e '/@[4-9]@/\!b 4' -e 'N' -e 's:\n: :' -e 'b 3' \ - -e ':4' \ -# Clean up; process labels \ - -e 's:@\([4-9]\)\1@:@\1@:g' \ -# Replace _ by \_ in text and file arguments \ - -e ':5' \ - -e 's:\(@[04-9]@[^@]*[^\]\)_:\1\\_:g' \ - -e 't 5' \ - >! $Tmp.0 -# -# Produce .ps files for figures. The code does not discriminate against \fig -# in a verbatim environment. Where this causes a problem, the "standard" -# trick of inserting an <ESC> behind the \ must be used, cf. doc_guide.tex. -# - set figs = \ -`grep '^[^%]*\\fig[ {]' < $Tmp.0 | sed -e '/>/d' -e 's:}.*:.fig:' -e 's:.*{::'` - $n_src/sys/document.csh Figures $figs diff --git a/src/sys/doc_print.csh b/src/sys/doc_print.csh deleted file mode 100755 index 46c15a243f0039010539fbb9ab42840e1e42eca0..0000000000000000000000000000000000000000 --- a/src/sys/doc_print.csh +++ /dev/null @@ -1,232 +0,0 @@ -#! /bin/csh -f -goto 000 - -doc_print.csh - to be sourced by document.csh - -History: - JPH 940628 Fix detection of \fig commands - JPH 940719 Remove <ESC> characters AFTER all include.exe runs - JPH 940810 Cope with split lines and with \textrefs including text - in braces with their first argument - JPH 940816 \keyref - Split off doc_preprocess.csh - Suppress warings in LaTeX dry run - Some more common code to doc_preprocess; make it accept - .cap input - JPH 940919 Rename $Tmp.log/.tex in case of error - JPH 941116 Correct name of outpuf file. (Was <xxx>.tex.ps.) - JPH 941121 Use @+/@- \textref argt delimiters set by doc_preprocess - Remove lingering \keyref processing - JPH 911123 Suppress rawhtml sections - JPH 941124 2nd version of $Tmp.pre outside conditional - JPH 941128 Correct \chapter processing - JPH 941129 Label list in reference section - JPH 941130 Correct label-list code for case there are no labels - JPH 941207 n_noref environment variable for private us - JPH 950208 reject .psc-type files - JPH 950215 fix processing of ../ references (were mistaken for - label references) - JPH 950221 temporarily comment out [subeqn] - HjV 950613 Use latex2html stuff from $n_l2h iso. ~jph - JPH 950822 Check for existing output file - JPH 950823 Replace interdocument referencing code by simpler code - that relies on l2h mechanism - Use improved \xxxref parsing by doc_preprocess - JPH 951013 Reject all but .tex files - JPH 951016 Accept non-.tex files but output in current directory - Message if $n_hlp, write-protected - Force figure positioning to [hbt] - Make -v default --> always call dvips - Suppress verbose dvips output - Format output messages in columns - JPH 951106 Change order of input-file tests - JPH 960102 Use $\backslash$ to generate backslash - JPH 960206 $Tmp --> $Tmp.all so it will be included in final - deletion - JPH 960208 .fps --> /fig/.ps - JPH 960326 -e option - JPH 960426 Fix option processing -000: -# Process inout, initialise -##set echo - if ($?n_noref) then - cat <<END - - Environment variable n_noref set: - No interdocument refererences will be created - -END - endif - set Print = 2 - @ sts = 0 - if (x$Files[1] =~ x-*) then - if (x$Files[1] =~ x-[Pp]) set Print=1 - if (x$Files[1] =~ x-[Vv]) set Print=2 - if (x$Files[1] =~ x-[Ss]) set Print=3 - if (x$Files[1] =~ x-[Ee]) set echo -## set Files[1]=""; if ($#Files > 1) - shift Files - endif - - if ("$Files" == "") then - echo -n "Enter the name of the LaTeX file to print: " - set Files=( $< ) # Read from stdin - endif - - foreach File ($Files) - if ($File =~ *_tmp*) continue - - echo $File \ - | awk '{ printf (" ndoc print %-24s", $1) }' - if (! -e $File) then - echo " - not found" - continue #break - endif - if ($File:e =~ p??) then - echo " - Bad command: Use 'ndoc Key' for .psc-type file" - continue #break - endif -# -# Use existing .ps file if it is newer than the source. Environment variable -# n_force may be set to bypass this test -# - set Name = $File:r - set Target = $Name.ps - set target = $Target - set local - if ($File:e != tex) then - echo -n "Not .tex: " - else if (-w $n_hlp) then - set Target = $n_hlp/$Target - set target = '$n_hlp/'$target - unset local - else - echo -n '$n_hlp read-only: ' - endif - if ($?local) then - echo -n "local output." - endif - $n_exe/newerfile.exe $Target $File - if (! $?n_force && $sts == 1) then - echo "- output is up-to-date" - goto display - endif - echo "" -# -# Preprocessing common to Cook and Print: $File --> $Tmp.0 -# -##set echo - source $n_src/sys/doc_preprocess.csh -# -# Process reference commands parsed by doc_preprocess -# - sed < $Tmp.0 \ -# srcref \ - -e 's+@7@{\([^@]*\)@3@+@7@{\\$n\\_src/\1+g' \ -# internal textref \ - -e 's:@0@[^@]*@1@{\([^@]*\)}@4@{@3@\([^}]*}\):\1 (sec. \\ref{\2):g'\ -# textref with optional label, ascref, psref \ - -e 's:@4@{\([^@]*\)@3@:@4@{\\$n\\_hlp/\1.ps@3@:g' \ - -e 's/@3@\./:./g' \ - -e 's:@5@{\([^@]*\)@3@:@5@{\\$n\\_doc/txt/\1.txt:g' \ - -e 's:@6@{\([^@]*\)@3@:@6@{\\$n\\_hlp/\1.ps:g' \ -# replace all xxxref by html command to avoid problems with # sign \ - -e 's:@0@[^@]*@1@\([^@]*\)@[4-9]@:\\htmladdnormallink{\1}:g' \ - -e 's:@[0-9]@::g' \ - -e '/\\begin *{ *rawhtml *}/,/\\end *{ *rawhtml *}/d' \ - >! $Tmp.text - set Inp = $Tmp.input -# -# Create a general preamble with \inputs where the dry run differs from the -# later wet run -# - cat << END >! $Tmp.rack -%% \documentstyle[subeqn]{article} - \documentstyle{article} - \newcommand{\iinput}[1]{ \input{#1} } - \input $n_doc/latex/hb_print_preamble.sty - \input $n_doc/latex/hb_symbols.sty - \input $n_l2h/html.sty - \iinput{epsf.sty} - \newcommand{\fig}[1]{ - \centering - \leavevmode - \epsfbox{$n_hlp/fig/#1.ps} - } - \begin{document} -END - if (! $?n_noref && $Ext != cap) then - cat << END >> $Tmp.rack - {\it Printout of NEWSTAR document chapter - \today } - \\\\ \\\\ -END - endif - cat << END >> $Tmp.rack -\input $Tmp.text -\end{document} -END -# -# Execute all \input and remove the ",," escape sequences that may still be -# there -# Standardise figure placement to [hbt] and caption entry to [] -# - $n_exe/include.exe $Tmp.rack $Tmp.all - sed < $Tmp.all \ - -e 's:,,\([A-Za-z]\):$\\backslash$\1:g' \ - -e '/\\tableofcontents/i\\ -\\addtocontents{toc}{ \\setlength{\\parskip}{2pt}}' \ - -e '/\\tableofcontents/a\\ -\\vspace{1cm}' \ - -e 's:\\begin *{ *figure *} *.[hbtp]*.:\\begin{figure}:' \ - -e 's:\\begin{figure}:&[hbt]:' \ - -e 's:\\caption\[\.\]:\\caption[]:' \ - >! $Tmp.tex - -# -# Run LaTeX twice. The first time we ignore all errors. The second time -# - we pick up relevant messages from the message stream -# - we look for the error prompt with exit reply: '? X' in the log file -# If either are found we report as much as we can pick up -# - echo X | (latex $Tmp.tex) >&/dev/null - echo X \ - | (latex $Tmp.tex) \ - | sed -n \ - -e "/^LaTeX Warning: Label/d" \ - -e "s/^LaTeX Warning: /WARN /p" \ - -e '/^\!/p' \ - -e "s/^No file/ERR No file /w $Tmp.err" - grep '^? X$' < $Tmp.log >&/dev/null - if (! $status || ! -z $Tmp.err) then - cat $Tmp.err - set lnr = `sed < $Tmp.log -n -e 's:^l\.\([0-9][0-9]*\).*:\1:p' ` - if ($lnr != "") then - echo "ERROR line ${lnr}:" - awk < $Tmp.tex '\ - {d=NR-lnr; if (d<3 && d>-3) {print NR " " $0};} {next}' lnr=$lnr - endif - cp $Tmp.log $File.log - cp $Tmp.tex $File.tmp - echo " see $File.log and $File.tmp for details" - @ sts = 1 - continue - endif - - rm >&/dev/null $Target - dvips -o $Target $Tmp.dvi \ - |& sed -e '/Copyright/d' -e '/TeX output/d' \ - -e '/<texc.pro>/d' -e '/\.ps/d' - rm $Tmp.* -display: - if (-e $Target) then - if ($Print == 2) then - echo 'Starting ghostview' - ghostview -a4 -nocenter -magstep -1 $Target - else if ($Print == 1) then - echo "Being submitted to printer" - $n_src/sys/wngfex.csh PS $Target - endif - endif - end # file loop - - exit ($sts) diff --git a/src/sys/doc_script.c b/src/sys/doc_script.c deleted file mode 100644 index 935a08c18bc4cd94fad2d99e1b6981cc77528a7e..0000000000000000000000000000000000000000 --- a/src/sys/doc_script.c +++ /dev/null @@ -1,319 +0,0 @@ -/* -docScript.c - program to convert the output of a ndoc Script session to a -LaTeX script file that can be included in a LaTeX document - -NOTE: The treatment of ^D and ^H characters is Sun-specific - - -History: - JPH 940607 Created by extraction from CMV's docaid.c -*/ -#include <stdio.h> -#include <signal.h> -#include <string.h> -#include <stdlib.h> -#include <time.h> -#include <sys/types.h> -#include <sys/stat.h> - -#define MAX_STRING 256 /* Length of general strings */ -#define MAX_BUF 5000 /* Length of help buffer */ - -char line[MAX_STRING]; /* Character buffer */ -char buf[MAX_BUF]; /* Multi purpose buffer */ - -static char *s_line[]={"line","long"}; - - -/*****************************************************************************/ - -char* getaline (ln, len, f) - char *ln; int len; FILE *f; -{ - char *p; char* st; - - if ( (st=fgets (ln, len, f))!=NULL ){ -/* -Clean up input line: -Remove \b (=^H) and the preceding character, terminate at \n or \r (=^M) -Do not remove trailing blanks because they are significant in determining where -the user reply is (see further down)! -*/ - for (p=ln; *p!='\n' && *p!='\r' && *p!='\0'; p++) { - if (*p=='\b'){ - p--; strcpy(p,p+2); p--; - } else if (*p=='\t') { - *p=' '; - } - } - *p='\0'; - } - return st; -} - - -/*****************************************************************************/ - -/* - Transform a line of characters to a string that can be printed by - LaTeX. This is achieved by escaping all LaTeX special characters - and by removing any Control key characters -*/ - -char *to_latex(line) - char *line; -{ - static char la_buf[2*MAX_STRING]; - char *p,*q; - - for (p=line, q=la_buf; *p!='\0'; p++) { - if (*p=='%' || *p=='_' || *p=='$' || *p=='#' || - *p=='~' || *p=='&' || *p=='{' || *p=='}' || *p=='\\') { - *(q++)='\\'; *(q++)=(*p); - } else if (*p==',' && *(p+1)!=' ') { - *(q++)=','; *(q++)=' '; - } else if (*p=='>' || *p=='<') { /* Should be in math mode */ - *(q++)='$'; *(q++)=(*p); *(q++)='$'; - } else if (*p==0x07 || *p==0x0a) { - } else if (*p=='^' || (*p>0 && *p<=0x12) ) { - strcpy(q,"$\\wedge$"); q+=8; - if (*p!='^') { - *(q++)=('@'+(*p)); - } - }else if (*p<0x20 || *p==0x7f) { - *(q++)='?'; - } else { - *(q++)=(*p); - } - } - - *q='\0'; - return(la_buf); -} -/*****************************************************************************/ - -int main(argc,argv) - int argc; - char **argv; -{ - int started=0, nline_per_par=0, scan_key=0, iline=0, forcereply=0, ll; - char *p,*q,*w2; - FILE *fp; - char *prompt,*deflt,*user,*cmt; - static char *s_line[]={"line","long"}; - int type=0; enum{ UNIXPR=1, PROGPR, PROGSTART }; - int verbatim=0, page=0; - - fp=fopen(argv[1],"r"); - if (fp==NULL) { - fprintf(stderr,"\nError: cannot open %s...\n",argv[1]); - return 1; - } - - while (getaline(line,MAX_STRING,fp) !=NULL) { - -/* Find pointer to second word, if any */ - for (w2=line; *w2!=' ' && *w2!='\t' && *w2!='\0'; w2++); - while (*w2==' ' || *w2=='\t') w2++; - if (*w2=='\0') continue; - -/* Wait for first line with "scr> " prompt */ - if (!started) started=(!strncmp(line,"scr> ",5)); - -/* -Check the input: messages from "script" are ignored, - "program started message" on separate line - operating-system prompts all start with "> " - DWARF prompts split in components - -A Newstar prompt has the following syntax: - - <bell>KEYWORD (<prompt>) = <default>: <user_response> \n - -Prompts and defaults can extend over multiple lines. - In the output, we restrict the length of the prompt to 5 options. - -User_response may be continued on the next line, in which - case an underscore (_) is used as a continuation prompt. - This is not handled yet. -*/ - if (!started || - !strncmp(line,"Script started",14) || /* Script messages */ - !strncmp(line,"script done",11) || - !strcmp(line,"exit") ) { - } else if (*line==0x07 && line[1]>='A' && line[1]<='Z') { - type=PROGPR; - } else if (!strncmp(line,"scr> ",5)) { - type=UNIXPR; -/* } else if (!strncmp(w2,"is started at",13)) { - type=PROGSTART; */ - } else { -/* -Program message output. It can not be formatted by means of a new LaTeX command like we do for all other components, because the expansion of such a command would have to contain a verbatim environment and this is not allowed. (See LaTeX Book, "Reference Manual" Appendix, section "Verbatim".) -*/ - type= 0; - if (!verbatim){ - if (*line !=0){ - printf("\n\\svbegin\\begin{verbatim}"); verbatim=1; - }; - } - if (verbatim){ - printf ("\n%s",line); - } - } -/* -Terminate verbatim section if necessary -*/ - switch (type){ - case PROGPR: - case UNIXPR: - break; - } - switch (type){ - case PROGPR: - case UNIXPR: - if (verbatim){ - verbatim=0; printf("\n\\end{verbatim}\\svend"); - } - if (page){ - page=0; printf("\n\\spend %%.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-."); - } - if (!page){ - page=1; printf ("\n%%\n\\spbegin %%.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+.+."); - } - } - switch (type){ -/* -Program prompt sequence -*/ - case PROGPR: - iline=0; /* Reset margin */ - - strcpy(buf,line+1); - prompt=deflt=user=cmt=NULL; forcereply=0; - for (p=buf; user==NULL; ) { - if (*p=='\0') { - if (getaline(line,MAX_STRING,fp)==NULL) { /* continuation line */ - if (prompt==NULL) prompt="(????)"; - if (deflt==NULL) deflt="= :"; - if (user==NULL) user="??"; - } else { - for (q=line; *q==' ' || *q=='\t'; q++); - strcpy(p,q); - } - } -/* Locate prompt */ - if (*p!='\0' && prompt==NULL) { - while (*p!=' ' && *p!='\0') p++; - if (*p==' ') { - *p='\0'; prompt=p+1; ll=0; p++; - } - } -/* Locate default */ - if (*p!='\0' && deflt==NULL) { - while (*p!='=' && *p!='\0') { - if (*p==',') { - ll++; if (ll>4) *p='\0'; - } - p++; - } - if (*p=='=') { *(p-1)='\0'; deflt=p; } - } -/* Locate user's reply. The simple logic of the previous sections is compounded -here by the possibility of the user reply starting on a new line (in which case -the previous line ends in a naked ':' */ - if (forcereply) { - user=p++; forcereply=0; - } else if ( *p!='\0' && user==NULL) { - while (*p!=':' && *p!='\0') p++; - if (*p++==':') { - if (*p=='\0') { - *++p='\0'; forcereply=1; - } else { - *p++='\0'; - user=p; - } - } - } - if (user !=NULL) { - while (*user==' ' || *user=='\t') user++; - for (cmt=user; *cmt!='!' && *cmt!='\0'; cmt++); - if (*cmt=='!') { *cmt='\0'; cmt++; } - } - - } /* end for */ -/* - In order not to overburden LaTeX memory, insert blank line if - paragraphs get too long. Just before a prompt seems a suitable place -*/ - if (nline_per_par>50) { printf("\n"); nline_per_par=0; } - printf("\n\\skeyword{%s}",to_latex(buf)); - if (ll>4) printf("\n\\sprompt{%s...)}",to_latex(prompt)); - else printf("\n\\sprompt{%s}",to_latex(prompt)); - printf("\n\\sdefault{%s}",to_latex(deflt)); - if (*user=='\0'){ - printf("\n\\suser{\\scr}"); - } else if (*user==0x04 || *user=='#'){ - printf("\n\\suser{\\seof}"); - } else { - printf("\n\\suser{%s}",to_latex(user)); - } - if (*cmt!='\0'){ - printf("\n\\sinline{%s}",to_latex(cmt)); - } - break; -/* -UNIX command -*/ - case UNIXPR: - iline=0; /* Reset margin */ - -/* separate comment */ - - for (p=w2; *p!='#' && *p!='\0'; p++); - q=p; if (p!=w2) q--; - while (q!=w2 && (*q==' ' || *q=='\t' || *q==';')) q--; - /* Only a comment */ - if (q==w2) { - if (*p=='#') printf("\n\\scomment{%s}",to_latex(p+1,0)); - /* "exit" and ^D are skipped */ - } else if (strncmp(w2,"exit",4) && *w2!=0x04) { - if (*p=='#') { - *q='\0'; - printf("\n\\scmd{%s}", to_latex(w2,1)); - printf("\n\\sinline{%s}", to_latex(p+1,0)); - } else { - printf("\n\\scmd{%s}", to_latex(w2,1)); - } - nline_per_par++; - }; - break; -/* -Program start message -*/ - case PROGSTART: - printf("\n\\s%s{%s}",s_line[iline],to_latex(line,1)); - ll=strlen(line); - if (ll>80) { /* Long line, indicate and strip */ - line[72]='>'; line[73]='\0'; - } else if (ll>73) { /* Long line: change margin */ - iline=1; - } - if (ll==0) { - printf("\n\\sskip"); - } else { - printf("\n\\s%s{%s}",s_line[iline],line /*to_latex(line)*/); - nline_per_par++; - } - } /* end of switch */ - - } /* end of input-line loop */ - - if (verbatim) printf ("\n\\end{verbatim}}\\svend"); - if (page){ - printf ("\n\\spend %%.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.\n"); - } - printf ("\n"); - fclose(fp); - return 0; -}; diff --git a/src/sys/doc_script.csh b/src/sys/doc_script.csh deleted file mode 100755 index 4a634dc576822fea7f5732696c167a6701608b30..0000000000000000000000000000000000000000 --- a/src/sys/doc_script.csh +++ /dev/null @@ -1,49 +0,0 @@ -# docScript.csh - sourced from document.csh - - set Print=0 - if ($Files[1] =~ -*) then - if ($Files[1] =~ -[Pp]) set Print=1 - if ($Files[1] =~ -[Vv]) set Print=2 - set Files[1]=""; if ($#Files > 1) shift Files - endif - - set File=$Files[1]; - if ("$File" == "") then - echo -n "Enter the name for the output LaTeX file: " - set File=( $< ) # Read from stdin - endif - if ("$File:e" != "") set File=$File:r - if (-e $File.tex) then - echo "FATAL: File $File.tex already exists" - exit 1 - endif -# -# Start script utility, this will leave you in a subshell -# - cat << END -A subshell will be started for logging your terminal dialogue -You must initialise this subshell by typing - '\$go' -After that, proceed with the session that you want to record. - ***** DO NOT TYPE AHEAD! ***** -Then terminate your session with - 'exit' -END - cat << END >! docScript.tmp - source $n_src/sys/newstar_${n_site}.csh - dwspecify dwarf /nomenu << END1 - bell=on" -END1 - unalias nscript - set prompt = "scr> " -END - setenv go 'source docScript.tmp' - script $File.tmp - unsetenv n_script go - $n_exe/doc_script.exe $File.tmp >! $File.tex - echo "Output in $File.tex" - -# rm $File.tmp - exit - - diff --git a/src/sys/doc_test.csh b/src/sys/doc_test.csh deleted file mode 100755 index 503c16ea6d67b743e59b581a86522fd1770c1567..0000000000000000000000000000000000000000 --- a/src/sys/doc_test.csh +++ /dev/null @@ -1,344 +0,0 @@ -# doc_test.csh - test documentation subsystem integrity -# sourced by ndoc test - -# NOTE: if/then constructs are used where an in-line if would seem to suffice. -# This proved to be necessary to make the alias for echo work - - - -# JPH 951102 -# JPH 951108 Add source copying -# JPH 951113 Bug fixes -# JPH 960103 Fix checking of $n_hlp/.ps files -# JPH 960206 $n_hlp/.fps --> $n_hlp/fig/.ps -# JPH 960208 Bug fix. Copy doc/html/*.html -# JPH 960325 Proper handling of .html files. -# Add icons directory -# Cross-references -# JPH 960425 .bbm --> .xbm; nmap/mph.dsc. -# Copy section: Expand wildcard in target directory for -# also deleting obsolete copies of selected files -# JPH 960429 Expand wildcard in source directory to preserve wanted -# files in target directories (e.g. .ps files) -# JPH 960430 Remove people.html from copy list -# .xbm --> .bbm -# log file -# JPH 960507 rm $n_hlp/*.tex - - -##set echo - set log = $n_doc/doc_test.log - echo -n "ndoc test" >! $log - date >> $log - echo "" >> $log - alias echo 'echo \!* | tee -a '$log - -# Clean up .tex files from $n_hlp - - rm -f >&/dev/null $n_hlp/*.tex - -# Copy source files to $n_hlp. Copy i.s.o. soft link is used because the WWW -# server will ignore links for security reasons. -# Define files selection: format is -# <quote> <source subdirectory of $n_src> <target subdirectory of $n_hlp> -# <file spec> <file spec> ... <quote> - - echo "" - echo 'UPDATE OF $n_hlp-TREE COPIES OF FILES FROM $n_src TREE' - echo "" - set list = ( \ - "doc/txt src/doc/txt *.txt" \ - "doc/bin src/doc/bin *.ps *.gif" \ - "doc/icons icons *.gif *.html *.xbm *.remove" \ - "doc/html . homepage.html" \ - "doc/html elsewhere_inst_maint elsewhere_inst_maint.html" \ - "doc/html nfra_config_management nfra_config_management.html" \ - "nmap src/nmap mph.dsc" \ - "nscan src/nscan fdw.dsc ohw.dsc scw.dsc shw.dsc ihw.dsc sch.dsc sth.dsc" \ - "wng src/wng gfh.dsc" \ - ) - -# copy selected files directory by directory - - while ($#list) - set noglob - set l = ( $list[1] ) - shift list - set dir = $l[1] # source directory - shift l - set ddir = $l[1] # target directory - shift l - echo ' $n_src/'"${dir} to "'$n_hlp/'"${ddir}:" # directory - echo " $l" # files - unset noglob - pushd $n_src/$dir >&/dev/null - set l = ( $l ) # expand wildcards - set lr = `'echo' $l | sed -e 's:\.[^ ]*:.ps:g' ` - cd >&/dev/null $n_hlp - rm -f $l $lr # remove misplaced copies - mkdir -p >&/dev/null $ddir - cd >&/dev/null $ddir - rm -f $l # remove old files - cd $n_src/$dir - cp $l $n_hlp/$ddir - popd >&/dev/null - end - - echo "" - echo "DOCUMENTATION-SYSTEM INTEGRITY CHECK" - set nonomatch - -# Compare .fig with .cap files: Sould be one-to-one - - echo "" - echo ' $n_doc/fig: .fig files with missing .cap files' - cd $n_doc/fig - foreach f (*.fig) - set f = $f:r - if (! -e $f.cap) then - echo " $f.fig" - endif - end - - echo "" - echo ' $n_doc/fig: .cap files with missing .fig files' - foreach f (*.cap) - set f = $f:r - if (! -e $f.fig) then - echo " $f.cap" - endif - end - - cd $n_hlp - -# Compare fig/.ps files with .fig sources: Sould be one-to-one - - cd fig - echo "" - echo ' $n_hlp/fig: .ps files with missing .fig sources' - foreach f (*.ps) - set f = $f:r - if (! -e $n_doc/fig/$f.fig) then - echo " fig/$f.ps removed" - rm $f.ps - endif - end - cd .. - -# Compare l2h subdirectories with .tex files and .html: Sould be one-to-one - - echo "" - echo \ -' $n_hlp: Subdirectories with missing or multiple .tex or .html sources' - set d = (` find . -name '*' -type d -prune -print | sed -e 's:^\./::' `) - foreach f ($d) - if ($f == src || $f == fig || $f == icons) continue - pushd $n_doc >&/dev/null - set ff = \ -`'echo' */$f.tex html/$f.htm? | sed -e "s:\*/$f.tex::" -e "s:html/$f.htm?::" ` - popd >&/dev/null - if ($#f == 0) then - echo " $f/: removed" - rm -r $f - else if ($#ff > 1) then - echo " ${f}/: multiple sources" - while ("$ff" != "") - echo " $ff[1]" - shift ff - end - endif - end - - set ff = ( *.ps ) - if ($ff[1] == '*'.ps) then - echo \ -' ERROR: All $n_hlp/*.ps files lost; do ndoc all to recover' - else - -# Compare .ps files with fig/.ps files. If both exist, the .ps file is assumed -# to be obsolete - - echo "" - echo ' $n_hlp: obsolete .ps versions of $n_hlp/fig/.ps files' - foreach f ( $ff ) - if (-e fig/$f) then - echo " $f: removed" - rm $f - endif - end - endif - -# Check .ps files. Legal ones are derived from .tex source or copies of a .ps -# for which no source exists. If it corresponds to a .cap source, it is -# obsolete. If it has multiple sources or no source at all, it is reported. - - echo "" - echo ' $n_hlp: .ps files with missing or multiple .tex, .ps sources' - set ff = ( *.ps ) - foreach f ($ff) - set f = $f:r - if (-e $n_doc/fig/$f.cap) then - echo " $f.ps: .cap input - removed" - rm -f $f.ps - else - pushd $n_doc >&/dev/null - set ft = \ - `'echo' */$f.tex bin/$f.p? | sed -e "s:\*/$f.tex::" -e "s:bin/$f.p?::"` - popd >&/dev/null - if ($#ft == 0) then - echo " $f.ps: no source" - else if ($#ft > 1) then - echo " $f.ps: multiple sources" - while ("$ft" != "") - echo " $ft[1]" - shift ft - end - endif - endif - end - -# Compare actual source files with doc.grp - - cd $n_doc - set tmp = doc_test.tmp - ls -Fd1 * */* \ - | sed -e '\:/$:d' \ - -e '/\*$/d' -e '\:/$:d' \ - -e '\:^mlink/:d' -e '/_tmp/d' \ - -e '\:bin/.*\.ps:b 1' \ - -e '\:bin/:d' \ - -e ':1' \ - -e 's:[^@]$:& h:' -e 's:@$: a:' \ - >! $tmp.l - sed < doc.grp \ - -e 's:\!.*$::' -e 's:-.*$::' -e 's:[ ]*$::' -e '/^$/d' \ - -e 's:[0-9a-z_]*\.grp:& g:p' \ - -e 's:^bin/[0-9a-z_]*\.ps$:& g:p' \ - -e 's:^fig/[0-9a-z_]*\.cap$:& g:p' \ - -e 's:^fig/[0-9a-z_]*\.fig$:& g:p' \ - -e 's:^html/[0-9a-z_]*\.html$:& g:p' \ - -e 's:^icons/[0-9a-z_]*\.gif$:& g:p' \ - -e 's:^icons/[0-9a-z_]*\.html$:& g:p' \ - -e 's:^intfc/[0-9a-z_]*\.tex$:& g:p' \ - -e 's:^latex/[0-9a-z_]*\.tex$:& g:p' \ - -e 's:^txt/[0-9a-z_]*\.txt$:& g:p' \ - >> $tmp.l - - sort -u $tmp.l \ - | sed -n \ - -e '$a\\ -~'\ - -e '/\.cap /p' \ - -e '/\.fig /p' \ - -e '/\.gif /p' \ - -e '/\.grp /p' \ - -e '/\.html /p' \ - -e '\:bin/.*\.ps :p' \ - -e '/\.tex /p' \ - -e '/\.txt /p' \ - -e '/\.xbm /p' \ - | sort -u \ - | awk \ - 'BEGIN{ print " "; \ - print " Comparison of actual files with doc.grp"; \ - print " h = hardcopy file not listed in doc.grp"; \ - print " a = soft link to master not listed in doc.grp"; \ - print " g = nonexistent file listed in doc.grp"; \ - print " File paths are shown relative to \$n_doc"; print " "; \ - } \ - { if ( $1!=p){ \ - if (n ==1 ){ \ - if (q =="g"){ \ - printf(" %1s %-s\n", q,p); \ - }else{ \ - printf(" %1s %-s\n", q,p); \ - } } \ - n=1; p=$1; q= $2; \ - }else{ \ - n++; \ - } }' \ - | tee -a $log \ - | grep . - -# Cross-references in $n_hlp/*/*.html -##set echo - echo "" - echo "DOCUMENT CROSS REFERENCES" - echo - set tmp = $n_doc/doc_cross.tmp - cd $n_doc - -# List all documents and make awk script to find references to them - - 'echo' -n "" >! $tmp.0 - 'echo' -n "" >! $tmp.1 - 'echo' -n "" >! $tmp.5 - set list = ( \ - "latex ???*.tex" \ - "intfc ???*.tex" \ - "txt ???*.txt" \ - "fig *.cap" \ - "bin ???*.gif ???*.ps" \ - "html ???*.html" \ - ) - while ( $#list ) - set noglob - set l = ( $list[1] ) - shift list - set d = $l[1] - shift l - cd $d - unset noglob - foreach f ($l) - set n = $f:r - 'echo' "/@$n@@/"'{print @, "'$n'" }' >> $tmp.0 - 'echo' "~- $n" >> $tmp.1 - 'echo' "s/ $n"'$'"/ $f/" >> $tmp.5 - end - cd .. - end - -# Process all .html files, collect pairs <file> <reference> -# (awk refuses to recognise dots, so we convert them to @'s with sed) - - pushd $n_hlp >&/dev/null - foreach f ( ./???*.html ???*/*.html ) - set f = `'echo' $f | sed -e 's:/: :'` - pushd $f[1] >&/dev/null - sed -e 's: @: "'$f[2]' ":' < $tmp.0 >! $tmp.awk - sed -e 's:\.:@@:g' -e 's:/:@:g' < $f[2] \ - | nawk -f $tmp.awk \ - >> $tmp.1 - popd >&/dev/null - end - popd >&/dev/null - -# Format and sort, by file and by reference - - cat << END >> $log - -File: Referred to by file: - -END -##set echo - - sort -u < $tmp.1 \ - | sed -f $tmp.5 \ - | sort -b +1 -2 \ - | awk \ - '{ if ($1 ==$2) next; \ - f=$2; if (f==fp){ f="" }else{ fp=f}; \ - x=0; if ($1 =="~-" && $2 ==s2 ) x=1; s2= $2; \ - if (x ==0 ){ \ - printf (" %-32s %-24s\n", f,$1); \ - }else{ \ - next; \ - }; \ - }' \ - | sed -e 's:~-::' \ - >> $log - - 'echo' "" - 'echo' "This overview saved in $log" - - rm -f $tmp.* diff --git a/src/sys/document.csh b/src/sys/document.csh deleted file mode 100755 index a07fa4056281274acf7336adbecdbae2d7333c60..0000000000000000000000000000000000000000 --- a/src/sys/document.csh +++ /dev/null @@ -1,478 +0,0 @@ -#! /bin/csh -f -#+ document.csh -# -# CMV 930713 Created -# CMV 931111 Original memo file not autmatically deleted -# CMV 931116 Changed for httpd 1.0 -# CMV 931206 Use nview (httpd/htbin) for extracted documentation -# JPH 940516 Split off docCook.csh, docPrint.csh, docKeys.csh -# Overview option -# JPH march 94-940704 Grand revision -# CMV 940712 Minor modifications to fit in master system -# JPH 940715 Respect user's settings for Xmosaic window size -# CMV 940719 Respect also users who just want to have the defaults (most), -# start xmosaic such that ?? can find it, -# use former docaid routine to translate keyword files. -# CMV 940720 Make new archive at exit -# JPH 940815 Use doc_keys.csh i.s.o. genaid.exe for easier experimenting -# JPH 940818 Fig option: delete $n_hlp/...ps before making new one -# JPH 940915 'All' option -# Make dummy for non-existent .fig file -# JPH 940919 Better error reporting ndoc print/cook -# JPH 941123 fig command: Look for .ps if .fig not found -# Add $n_doc/intfc to 'All' processing -# CMV 941213 Skip xrdb if not in path -# JPH 950213 Make 'figure not found' a WARNING i.s.o. an ERROR. - Typo in ALL -# Suppress 'Update' question in ndoc all -# Split processing of large file collections (gave Word too long) -# JPH 950221 Insert ad-hoc path for fig2dev -# HjV 950613 Use latex2html stuff from $n_l2h iso. ~jph -# JPH 950822 Find command -# Figure command: Check for existing newer output -# Remove overview command -# JPH 950905 Revise code for All: Simplify, work around 'Word too long' -# JPH 950918 Temporary fix for xfig/fig2dev 3.1 -# JPH 950927 .ps --> .fps in test for up-to-date output -# JPH 951006 Remove tex setup: Rely on host environment. -# JPH 951101 Format ndoc Fig messages for clarity -# Add Test command -# JPH 951106 Fix error in sed extraction of figure scale -# JPH 951120 Use ~/ for creating xrdb.tmp files. -# Use xmosaic_restart i.s.o. genaid.exe to start the browser. -# JPH 960102 Remove FULL option (is now ALL), Update help text -# JPH 960129 Bug fix in ALL -# JPH 960206 Figures: $n_hlp/.fps --> $n_hlp/fig/.ps -# JPH 960208 Fix omission in 960206 -# JPH 960430 Remove old code, fix some messages. - Make doc_all.log -# -# -# This script coordinates all actions for documentation maintenance -# -# It does not contain full checking on the environment etc. -# -#--------------------------------------------------------------------- -# -# Uncomment the following line for testing purposes... -##set echo -onintr Abort_exit - -# -# Initialise name and date -# -set Myname=`awk -F: '{ if ($1 == "'$USER'") print $5 }' /etc/passwd` -if ("$Myname" == "") set Myname=`whoami` - -set dt = (`date`) -if ("$dt[3]" =~ [1-9]) set dt[3] = "0$dt[3]" # day -set mc=( Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec) -foreach mm ( 01 02 03 04 05 06 07 08 09 10 11 12) - if ("$dt[2]" == "$mc[$mm]") break # month -end -@ yy = $dt[$#dt] - 1900 # year -set mh=( `echo $dt[4] | tr -s ":" " "` ) # hh mm ss -set C_Date="$yy$mm$dt[3]" # date: yymmdd -set C_Time="${mh[1]}:$mh[2]" # time: hh:mm -unset dt mc mm yy mh - -if (! $?EDITOR) setenv EDITOR emacs - -# -# Initialise TeX and the like just in case... -# -#. if (-e /usr/local/lib/tex/texsetup) then -## if (! $?TEXFONTS ) -#. source /usr/local/lib/tex/texsetup -## setenv TEXINPUT "$n_src/doc/cook" -#. alias tex "setenv TEXFONTS /usr/local/lib/tex/fonts; \tex" -#. alias latex "setenv TEXFONTS /usr/local/lib/tex/fonts; \latex" -#. alias dvips "setenv TEXFONTS /usr/local/lib/pk/pk300; /usr/local/lib/dvitps -B/usr/local/lib/tex/TeXPS/dvitps-cap -P/usr/local/lib/tex/TeXPS/pro \!* " -# source /aips++/aipsinit.csh # fonts for ghostview -## alias xdvi "setenv TEXFONTS /usr/local/lib/pk/pk300; /usr/local/lib/tex/xdvi" -#. endif -# -# Get command, or enter menu mode if none given. -# - -set ask_archive=0 # Do not ask archive by default - -set Files="" -if ("$1" != "") then - set Mode="Command" - set Command="$1" - set noglob; if ($#argv > 1) set Files=( $argv[2-] ); unset noglob -else - set Mode="Menu" - set Command="" -endif - -# -# If in Menu mode, repeatedly ask commands, else just one command -# -while ( "$Mode" != "Quit") - - if ( "$Mode" == "Menu" ) then - echo "General commands are: help, find, script, hyper, quit" - echo "Translation commands are: all, keys, cook, print, figures" - echo "To check system integrity: test - echo -n "Enter a command: " - set Command=($<) - set Files="" - set Command=( $Command ) - if ($#Command > 1) then - set noglob; set Files=( $Command[2-] ); unset noglob - set Command=$Command[1] - endif - - else if ( "$Mode" == "Update" ) then - set Command=$lupdate[$iupdate] - set Files="all" - echo "***** $Command all *****" - - @ iupdate = $iupdate + 1 - if ($iupdate > $#lupdate) set Mode="Quit" - - else - set Mode="Quit" - endif - - if ("$Command" == "" || $Command =~ [Qq]*) then - set Mode="Quit" -# -# %All command, regenerate entire documentation system in NoUpdate mode -# - else if ($Command =~ [Aa][Ll][Ll]) then - echo -n 'Keys all .p?? files? '; set x = $< - if ($x =~ [Yy]*) set allp - echo -n 'PostScript for all .tex documents? '; set x = $< - if ($x =~ [Yy]*) set allpd - echo -n 'HTML for all .tex documents? '; set x = $< - if ($x =~ [Yy]*) set allcd - echo -n 'System consistency check? '; set x = $< - if ($x =~ [Yy]*) set allch - - setenv n_force # signal doc_cook, doc_print to bypass test for existing - # output - pushd $n_src >&/dev/null - set log = $n_doc/doc_all.log - echo -n "" >! $log - if ($?allp) then - echo 'Hypertext on-line help: ndoc keys $n_src/*/*.p??' |& tee -a $log - $0 keys all |& tee -a $log - echo "" |& tee -a $log - echo "" |& tee -a $log - endif - rm -f $n_doc/[il]*/*_tmp.tex - if ($?allpd) then - echo 'PostScript documents: ndoc print -s $n_doc/*/*.tex' |& tee -a $log - cd $n_doc/latex - $0 print -s [a-m]*.tex |& tee -a $log - $0 print -s [n-p]*.tex |& tee -a $log - $0 print -s [q-z]*.tex |& tee -a $log - rm >&/dev/null *.ps - cd $n_doc/intfc - $0 print -s [a-m]*.tex |& tee -a $log - $0 print -s n*.tex |& tee -a $log - $0 print -s [o-z]*.tex |& tee -a $log - echo "" |& tee -a $log - rm >&/dev/null *.ps - endif - if ($?allcd) then - echo 'Hypertext documents: ndoc cook $n_doc/latex/*.tex' |& tee -a $log - cd $n_doc/latex - $0 cook [a-m]*.tex |& tee -a $log - $0 cook [n-p]*.tex |& tee -a $log - $0 cook [q-z]*.tex |& tee -a $log - echo "" |& tee -a $log - if (! $?allp) then - cd $n_doc/intfc - $0 cook [a-m]*.tex |& tee -a $log - $0 cook n*.tex |& tee -a $log - $0 cook [p-z]*.tex |& tee -a $log - echo "" |& tee -a $log - endif - endif - popd >&/dev/null - if ($?allch) then - source $n_src/sys/doc_test.csh - cat $n_doc/doc_test.log >> $log - endif - echo 'Log file: $n_doc/doc_all.log' -# -# %Test command: Check source/output integrity, copy miscellaneous texts -# - else if ($Command =~ [Tt]*) then - source $n_src/sys/doc_test.csh -# -# %Help command: -# - else if ("$Command" =~ [Hh][Ee]* ) then - more <<_EOD_ -#+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++# - - Document.csh is used for maintenance of the Newstar documentation. - -Document can be called in one of the following ways: - - document - - Enter a menu mode where all options listed below can be - chosen. Additional arguments will be prompted for. - - document all - - (Re)Create part of or the entire $n_hlp tree from document sources - You will be prompted for the parts of the tree to be processed - - document cook [File...|all] - - Convert one or more LaTeX files into html files. The literal - 'all' corresponds to \$n_src/doc/latex/* - - document figures [File] - - Convert xfig figures to encapsulated postscript (this option - is called automatically for figures included in latex files) - - document find <string> - - Find and optionally print documents containg <string>. The search is - case-insensitive. It is not necessary to put <string> in quotes. - - document hyper [File] - - Starts the WWW hypertext browser with the specified file. - The default browser is the local host's netscape; - $n_exe/xmosaic.exe may be used as an alternative. - The default File is the Newstar Home page. - - document keys [File...|all] - - Convert one or more PIN/PSC/PEF files to LaTeX and html files. - The files should be given with their extension, wildcards are - allowed. The literal 'all' corresponds to all files *.p?? in - directories $NSTAR_DIR. - The resulting LaTeX files will be in \$n_src/doc/intfc, the - html files will be in \$n_hlp - - NB: In principle this could be done through the compile script. - - document print [-p|v|s] [File] - - Print or view an existing LaTeX file with a title page - and a table of contents. - The -P switch causes an existing latex file to be printed (default) - The -V switch causes an existing latex file to be viewed with xdvi - The -S ("syntax") switch processes the file without display - - document script [-p|v] [File] - - Start a script session and convert the terminal output - to a proper LaTeX file. The file can (and probably should) - be edited by hand and then be moved into \$n_src/doc/latex - The -P switch causes an existing latex file to be printed - The -V switch causes an existing latex file to be viewed with xdvi - - document test - - Check the correspondence between source files and ouput files: - - - Delete outputs for which no corresponding inout exists (these are - assumed to be leftover files) - - Report remaining inconsistencies. - - Report differences between the source input collection and their - listing in doc.grp - - Copy source files referenced by documents to the \$n_hlp tree -#-------------------------------------------------------------------------# - -_EOD_ - - else if ("$Command" =~ [Ff]) then - echo "Ambiguous command: Can be Find, Figures or Full" - else if ("$Command" =~ [Ff][Ii]) then - echo "Ambiguous command: Can be Find or Full" -# -# %Find command -# - else if ("$Command" =~ [Ff][Ii][Nn]*) then - source $n_src/sys/doc_find.csh - -# %Figures command -# - else if ("$Command" =~ [Ff][Ii][Gg]*) then - pushd >&/dev/null $n_doc/fig - foreach File ($Files) - set File = $File:r - set Target = $File.ps - set target = $Target - if (-w $n_hlp) then - set Target = $n_hlp/$Target - set target = '$n_hlp/'$target - endif - if (! -e $File.fig) then - set ext = tmp - set scale = "1.00" - sed < dummy_figure.fig \ - -e "s:##:$File.ps:" \ - >! $File.$ext - echo " Making dummy for $File.ps" - else -# -# Check if newer .ps file already exists -# - $n_exe/newerfile.exe $n_hlp/fig/$File.ps $n_doc/fig/$File.fig - if (! $?n_force && $status == 1) then - echo $File.fig \ -| awk '{ printf (" %-32s output .ps file is up-to-date\n", $1) }' - continue - endif -# -# Find the scale definition and convert .fig to .ps (Note that a double \ is -# needed to escape the !) -# - set ext = fig - set scale = \ -`sed -n -e "/$File.fig/\\!b" -e 's:%.*$::' -e 's:^.* ::' -e 's:[0-9][0-9]$:.&:p' < $n_doc/fig/$File.fig ` - if ($scale =~ '.'*) set scale = "0$scale" - if ($scale == "") set scale = "1.00" - echo $File.fig $scale \ - | awk '{printf (" %-32s scale %-s\n", $1, $2); }' - endif - - $n_l2h/fig2dev -L ps -m $scale $File.$ext $File.tmp -## /local/bin/fig2dev -L ps -m $scale $File.$ext $File.tmp - -# Define a margin around the figure for display by ghostview by redefining -# the BoundaryBox. (Miraculously, this naive trick works!) -# - rm >&/dev/null $n_hlp/fig/$File.ps - awk < $File.tmp ' \ - /%%BoundingBox:/{ \ - printf("%s %d %d %d %d\n", $1, $2-10, $3-10, $4+10, $5+10);\ - next;} \ - {print $0} ' \ - >! $n_hlp/fig/$File.ps - rm >&/dev/null $File.tmp - end - popd >&/dev/null -# -# %Script command: -# - else if ("$Command" =~ [Ss]* ) then - source $n_src/sys/doc_script.csh -# -# %Print command: -# - else if ("$Command" =~ [Pp]* ) then - source $n_src/sys/doc_print.csh -# -# %Hyper command -# -# xmosaic spews out a lot of error messages related to some definition table -# but these seem to do no harm, so we dismiss them -# We use xrdb to temporarily set xmosaic X resources and afterwards to restore -# the initial condition. The xmosaic width is dictated by the width of -# 80-char terminal output in scripts. If a user already defined her own -# size settings, we respect those. -# -# It is the responsibility of the user to define the size if he wants it to -# be different from normal. Catch prior and next is a different matter, -# it does not hurt if it is set (in fact most people will want it). -# CMV 940719 -# - else if ("$Command" =~ [Hh][Yy]* ) then - if (! $?DISPLAY) then - echo "Cannot start Mosaic, DISPLAY not defined" - else - set File = $Files[1]; - if ("$File" == "") set File = $n_hlp/homepage.html -# xrdb -query \ -# | tee xrdb.tmp.0 \ -# | awk -F':' \ -# 'BEGIN{ h=0; w=0;} \ -# /Mosaic\*defaultHeight/{ h=1; print $0;} \ -# /Mosaic\*defaultWidth/{ w=1; print $0;} \ -# {next;} \ -# END{ \ -# if (! w){ print "Mosaic*defaultWidth: 870"} \ -# if (! h){ print "Mosaic*defaultHeight: 1000"}; \ -# }' \ -# >! xrdb.tmp.1 - unset no_xrdb - if (-x /usr/local/bin/xrdb) then - alias xrdb /usr/local/bin/xrdb - else if (-x /usr/local/bin/X11/xrdb) then - alias xrdb /usr/local/bin/X11/xrdb - else if (-x /usr/bin/X11/xrdb) then - alias xrdb /usr/bin/X11/xrdb - else if (-x /usr/bin/xrdb) then - alias xrdb /usr/bin/xrdb - else - set no_xrdb - endif - if (! $?no_xrdb) then - xrdb -query > ~/xrdb.tmp.0 - cat << END >> ~/xrdb.tmp.1 - Mosaic*catchPriorAndNext: True - Mosaic*postScriptViewerCommand: ghostview -magstep +1 -nocenter -END - xrdb -merge ~/xrdb.tmp.1 >&/dev/null - endif - -## $n_exe/genaid.exe hyper $File - $n_src/sys/xmosaic_restart.csh - - if (! $?no_xrdb) then - xrdb -load ~/xrdb.tmp.0 >&/dev/null - 'rm' -f ~/xrdb.tmp.? - endif - endif -# -# %Keys command -# -# All the same, I want those \ref's and the formatting in docaid worked fine. -# CMV 940719 -# -# - else if ("$Command" =~ [Kk]* ) then - if ("$Files" == "") then - echo -n "Enter the name of PIN/PSC/PEF file(s) [All]: " - set Files=( $< ) - set Files=( $Files ) - endif - source $n_src/sys/doc_keys.csh - set ask_archive=1 -# -# %Cook command -# - else if ("$Command" =~ [Cc]* ) then - source $n_src/sys/doc_cook.csh - set ask_archive=1 -# -# Invalid command -# - else # Other command - echo "" - echo "Error: Invalid or ambiguous command $Command" - echo "" - endif # End of if (Command == ...) - -end # End of while (Menu mode) - - -if (-o $n_root && $ask_archive) then - echo -n "Update archive for export? [n] " - set do_it=($<) - if ("$do_it" =~ [Yy]*) then - set here=$cwd - cd $n_hlp - tar cvf $n_doc/newstar.hun * | grep -v '^a' - compress $n_doc/newstar.hun - if (-e $n_doc/newstar.hun.Z) mv $n_doc/newstar.hun.Z $n_doc/newstar.hun - echo "You need to do an nup check d to insure itegrity of the database" - cd $here - endif -endif - - -Abort_exit: - diff --git a/src/sys/document.pls b/src/sys/document.pls deleted file mode 100755 index a31cd165018c6795beaf4a7d587c7d8268d5b1e7..0000000000000000000000000000000000000000 --- a/src/sys/document.pls +++ /dev/null @@ -1,998 +0,0 @@ -#+ document.pls -# created by wbrouw on norma at Tue Jun 21 13:21:46 LST 1994 -#- -#! /bin/csh -f -#+ document.csh -# -# CMV 930713 Created -# CMV 931111 Original memo file not autmatically deleted -# CMV 931116 Changed for httpd 1.0 -# CMV 931206 Use nview (httpd/htbin) for extracted documentation -# CMV 940506 Make summary <PRE> formatted -# CMV 940530 Preserve BELL in script -# -# This script coordinates all actions for documentation maintenance -# -# It does not contain full checking on the environment etc. -# -#--------------------------------------------------------------------- -# -# Uncomment the following line for testing purposes... -#set echo -#+ -# Preamble -# -unless (defined $VMS) { # check for environment - if ($ENV{"SHELL"}) { # aid routines unix - unshift(@INC,$ENV{'n_src'}.'/sys');} - else { # aid routines VMS - unshift(@INC,'N_SRC:[SYS]');} - unless (require 'c2aid.pls') { - print "Fatal: Cannot load c2aid.pls properly"; exit;} - &ENV_IMPORT; # get environment - $argv=join(' ',@ARGV);} # get command arguments -if (&ft("e",&fp("r","$0").".csh") && # renew main routine - (&ft("M","$0") > &ft("M","$n_src/sys/csh2p.pls") || - &ft("M","$0") > &ft("M",&fp("r","$0").".csh"))) { - $status=&system("perl ".&fnp("$n_src/sys/csh2p.pls")." ". - &fp("r","$0"));} -# -# Start translated script -#- -sub document__pls { - $SIG{'INT'}= Abort_exit_document ; -# -# Initialise name and date -# - $Myname= &Pipe("p$$.tmp00", &awk( "-F:" , '{ if ($1 == "' . $USER - .'") print $5 }' , "/etc/passwd" , "p$$.tmp00" ) ) - ; - if ( &eq( $Myname , '' ) ) { $Myname= &Pipe("p$$.tmp00", &whoami( - "p$$.tmp00" ) ) ; } - $dt= &Pipe("p$$.tmp00", &date( "p$$.tmp00" ) ) ; - if ( &peq( (split(' ',$dt)) [ 3 -1 ] , "[1-9]" ) # day - ) { @dt=split(' ',$dt); splice(@dt, "3" -1,1, - (split(' ',$dt)) [ 3 -1 ] ); $dt=join(' ',@dt); } - $mc= "Jan" .' '. "Feb" .' '. "Mar" .' '. "Apr" .' '. "May" .' '. "Jun" - .' '. "Jul" .' '. "Aug" .' '. "Sep" .' '. "Oct" - .' '. "Nov" .' '. "Dec" ; - for $mm__x (split(' ',join(' ' , "01" , "02" , "03" , "04" , "05" , "06" - , "07" , "08" , "09" , "10" , "11" , "12" ))) { - $mm=$mm__x ; - if ( &eq( (split(' ',$dt)) [ 2 -1 ] , # month - (split(' ',$mc)) [ $mm -1 ] ) ) { last ; } - } - $yy= (split(' ',$dt)) [ &vn($dt) -1 ] - 1900 ; # year - $mh= &Pipe("p$$.tmp00", &echo( '' , &fn( # hh mm ss - (split(' ',$dt)) [ 4 -1 ] ) , "p$$.tmp01" ) , &tr( - "-s" , ":" , " " , "p$$.tmp01" , "p$$.tmp00" ) ) - ; - $C_Date= $yy . $mm . (split(' ',$dt)) [ 3 -1 ] ; # date: yymmdd - $C_Time= (split(' ',$mh)) [ 1 -1 ] .":" . # time: hh:mm - (split(' ',$mh)) [ 2 -1 ] ; - undef $dt ; undef $mc ; undef $mm ; undef $yy ; undef $mh ; - if ( ! defined($EDITOR) ) { $EDITOR= "emacs" ; &ENV_EXPORT( EDITOR , - "emacs" ) ; } -# -# Initialise TeX just in case... -# - if ( &ft('e', "/usr/local/lib/tex/texsetup" ) ) { - if ( ! defined($TEXFONTS) ) { &source( "/usr/local/lib/tex/texsetup" ) - ; } - $TEXINPUT= $n_src ."/doc/cook" ; &ENV_EXPORT( TEXINPUT , $n_src - ."/doc/cook" ) ; - &alias( 'tex', '$TEXFONTS='. '"/usr/local/lib/tex/fonts"'. ';'. - '&ENV_EXPORT('. 'TEXFONTS'. ','. - '"/usr/local/lib/tex/fonts"'. ')'. ';'. - '&doalias(\'ex\''. ')'. ';'. '', "") ; - &alias( 'latex', '$TEXFONTS='. '"/usr/local/lib/tex/fonts"'. ';'. - '&ENV_EXPORT('. 'TEXFONTS'. ','. - '"/usr/local/lib/tex/fonts"'. ')'. ';'. - '&doalias(\'atex\''. ')'. ';'. '', "") ; - &alias( 'dvips', '$TEXFONTS='. '"/usr/local/lib/pk/pk300"'. ';'. - '&ENV_EXPORT('. 'TEXFONTS'. ','. - '"/usr/local/lib/pk/pk300"'. ')'. ';'. - '&doalias_x('. ''. - '"-B/usr/local/lib/tex/TeXPS/dvitps-cap"'. ','. - '"-P/usr/local/lib/tex/TeXPS/pro"'. ','. '"!*"'. - ')'. ';'. '&doalias(\'/usr/local/lib/dvitps\''. - ')'. ';'. '', "") ; - &alias( 'xdvi', '$TEXFONTS='. '"/usr/local/lib/pk/pk300"'. ';'. - '&ENV_EXPORT('. 'TEXFONTS'. ','. - '"/usr/local/lib/pk/pk300"'. ')'. ';'. - '&doalias(\'/usr/local/lib/tex/xdvi\''. ')'. ';'. - '', "") ; - } -# -# Get command, or enter menu mode if none given. -# - $Files= '' ; - if ( !&eq( (split(' ',$argv)) [ 1 -1 ] , '' ) ) { - $Mode= "Command" ; - $Command= (split(' ',$argv)) [ 1 -1 ] ; - $noglob='' ; if ( &vn($argv) > 1 ) { $Files= &fn( (split(' ',$argv)) [ - 2 -1 .. &vn($argv)-1 ] ) ; } undef $noglob ; - } - else { - $Mode= "Menu" ; - $Command= '' ; - } -# -# If in Menu mode, repeatedly ask commands, else just one command -# - while ( !&eq( $Mode , "Quit" ) ) { - if ( &eq( $Mode , "Menu" ) ) { - &echo( '' , "General commands are: help, script, pri" - ."nt, hyper, quit" , "" ) ; - &echo( '' , "Translation commands are: full, keys, cook," - ." memo, extract" , "" ) ; - &echo( "-n" , "Enter a command: " , "" ) ; - $Command= ($_=scalar(<STDIN>), chop, $_) ; - $Files= '' ; - $Command= &fn( $Command ) ; - if ( &vn($Command) > 1 ) { - $noglob='' ; $Files= &fn( (split(' ',$Command)) [ 2 -1 .. - &vn($Command)-1 ] ) ; undef $noglob ; - $Command= &fn( (split(' ',$Command)) [ 1 -1 ] ) ; - } - } - elsif ( &eq( $Mode , "Update" ) ) { - $lupdate= "keys" .' '. "cook" ; - $Command= &fn( (split(' ',$lupdate)) [ $iupdate -1 ] ) ; - $Files= "all" ; - &echo( '' , "***** " . $Command ." all *****" , "" ) ; - $iupdate= $iupdate + 1 ; - if ( $iupdate > &vn($lupdate) ) { $Mode= "Quit" ; } - } - else { - $Mode= "Quit" ; - } - if ( &eq( $Command , '' ) || &peq( $Command , "[Qq]*" ) ) { - $Mode= "Quit" ; -# -# %Full command, scan a list of commands -# - } - elsif ( &peq( $Command , "[Ff][Uu][Ll]*" ) ) { - $Mode= "Update" ; - $iupdate= "1" ; -# -# %Help command: -# - } - elsif ( &peq( $Command , "[Hh][Ee]*" ) ) { - sub C2_t1_document { - local(*TMP); - open(TMP,">txt$$.tmp"); - print TMP "#+++++++++++++++++++++++++++++++++++++++++++" - ."++++++++++++++++++++++++++++++#" ."\n" ; - print TMP '' ."\n" ; - print TMP " Document.csh is used for maintenance of th" - ."e Newstar documentation." ."\n" ; - print TMP " " ."\n" ; - print TMP " Document can be called in one of the follow" - ."ing ways:" ."\n" ; - print TMP '' ."\n" ; - print TMP '' ."\n" ; - print TMP " document " ."\n" ; - print TMP '' ."\n" ; - print TMP " Enter a menu mode where all options " - ."listed below can be " ."\n" ; - print TMP " chosen. Additional arguments will be" - ." prompted for." ."\n" ; - print TMP '' ."\n" ; - print TMP " document script [-p|v] [File]" ."\n" ; - print TMP '' ."\n" ; - print TMP " Start a script session and convert t" - ."he terminal output " ."\n" ; - print TMP " to a proper LaTeX file. The file can" - ." (and probably should)" ."\n" ; - print TMP " be edited by hand and then be moved " - ."into \$n_src/doc/cook" ."\n" ; - print TMP " The -P switch causes an existing lat" - ."ex file to be printed" ."\n" ; - print TMP " The -V switch causes an existing lat" - ."ex file to be viewed with xdvi" ."\n" ; - print TMP '' ."\n" ; - print TMP " document print [-p|v] [File]" ."\n" ; - print TMP '' ."\n" ; - print TMP " Print or view an existing LaTeX file" - ." with a title page " ."\n" ; - print TMP " and a table of contents." ."\n" ; - print TMP " The -P switch causes an existing lat" - ."ex file to be printed (default)" ."\n" ; - print TMP " The -V switch causes an existing lat" - ."ex file to be viewed with xdvi" ."\n" ; - print TMP '' ."\n" ; - print TMP " document hyper [File]" ."\n" ; - print TMP '' ."\n" ; - print TMP " Starts the xmosaic hypertext browser" - ." with the specified file." ."\n" ; - print TMP " The default is the Newstar Home page" ."." - ."\n" ; - print TMP '' ."\n" ; - print TMP " document full" ."\n" ; - print TMP '' ."\n" ; - print TMP " Updates the html database: equivalen" ."t to " - ."\n" ; - print TMP " keys all; cook all; " ."\n" ; - print TMP '' ."\n" ; - print TMP " document keys [File...|all]" ."\n" ; - print TMP '' ."\n" ; - print TMP " Convert one or more PIN/PSC/PEF file" - ."s to LaTeX and html files." ."\n" ; - print TMP " The files should be given with their" - ." extension, wildcards are" ."\n" ; - print TMP " allowed. The literal 'all' correspon" - ."ds to all files *.p?? in" ."\n" ; - print TMP " directories " . $NSTAR_DIR ."." ."\n" ; - print TMP " The resulting LaTeX files will be in" - ." \$n_src/doc/keys, the" ."\n" ; - print TMP " html files will be in \$n_hlp" ."\n" ; - print TMP " " ."\n" ; - print TMP " NB: In principle this could be done " - ."through the compile script." ."\n" ; - print TMP '' ."\n" ; - print TMP " document cook [File...|all]" ."\n" ; - print TMP '' ."\n" ; - print TMP " Convert one or more LaTeX files into" - ." html files. The literal " ."\n" ; - print TMP " 'all' corresponds to \$n_src/doc/coo" ."k/*" - ."\n" ; - print TMP '' ."\n" ; - print TMP " document memo [<number>|new] [File]" ."\n" ; - print TMP '' ."\n" ; - print TMP " Edit an existing memo (if <number> g" - ."iven) or create a Newstar Memo " ."\n" ; - print TMP " header (literal 'new' given)." ."\n" ; - print TMP " External files may be connected to t" - ."he header." ."\n" ; - print TMP " Links to other Memo's/cookbook-files" - ."/documentation " ."\n" ; - print TMP " can be made in the header as well." ."\n" ; - print TMP '' ."\n" ; - print TMP " document extract [File...]" ."\n" ; - print TMP '' ."\n" ; - print TMP " Extract documentation (between C+/C-" - .") from one or more files " ."\n" ; - print TMP " into html files. Empty output files " - ."are deleted. The files are" ."\n" ; - print TMP " moved into directory \$n_root/server" - ."/newstar/extract" ."\n" ; - print TMP '' ."\n" ; - print TMP "#-------------------------------------------" - ."------------------------------#" ."\n" ; - print TMP '' ."\n" ; - close(TMP); - "txt$$.tmp";} - &more( '' , &C2_t1_document , "" ) ; -# -# -# %Script command: -# - } - elsif ( &peq( $Command , "[Ss]*" ) ) { - $Print='' ; - if ( &peq( (split(' ',$Files)) [ 1 -1 ] , "-*" ) ) { - if ( &peq( (split(' ',$Files)) [ 1 -1 ] , "-[Pp]" ) ) { $Print= "1" - ; } - if ( &peq( (split(' ',$Files)) [ 1 -1 ] , "-[Vv]" ) ) { $Print= "2" - ; } - @Files=split(' ',$Files); splice(@Files, "1" -1,1, '' ); - $Files=join(' ',@Files); if ( &vn($Files) > 1 ) { - @Files=split(' ',$Files) ; shift(@Files) ; - $Files=join(' ',@Files) ; } - } - $File= &fn( (split(' ',$Files)) [ 1 -1 ] ) ; - if ( &eq( $File , '' ) ) { - &echo( "-n" , "Enter the name for the output LaTeX file: " , "" ) - ; - $File= ($_=scalar(<STDIN>), chop, $_) ; # Read from stdin - } - if ( !&eq( &fp('e', $File ) , '' ) ) { $File= &fn( &fp('r', $File - ) ) ; } - if ( ! $Print ) { -# -# Choice to append in case of split terminal session, -# make sure file exists by touch-ing it (not really necessary) -# - if ( &ft('e', $File .".tex" ) ) { - &echo( "-n" , "Append to existing LaTeX file (y,n)? [y] " , "" - ) ; - $ans= ($_=scalar(<STDIN>), chop, $_) ; - if ( &peq( $ans , "[Nn]*" ) ) { &rm( "-f" , &fn( $File .".tex" - ) ) ; } - } - &touch( '' , &fn( $File .".tex" ) ) ; -# -# Start script utility, this will leave you in a subshell -# - &echo( '' , " " , "" ) ; - &echo( '' , " Initialise Newstar by typing " ."\$go" , - "" ) ; - &echo( '' , " Execute all necessary commands, type exit" - ." when done..." , "" ) ; - &echo( '' , " " , "" ) ; - $go= "source " . $n_src ."/sys/newstar_" . $n_site .".csh" ; - &ENV_EXPORT( go , "source " . $n_src - ."/sys/newstar_" . $n_site .".csh" ) ; - $savbell= &Pipe("p$$.tmp00", &doexe( &fn( $n_exe ."/view.exe" ) , - &fn( "dwarf\$0_bell" ) .' '. "/general" , - "p$$.tmp00" ) ) ; &ENV_EXPORT( savbell , - &Pipe("p$$.tmp00", &doexe( &fn( $n_exe - ."/view.exe" ) , &fn( "dwarf\$0_bell" ) .' '. - "/general" , "p$$.tmp00" ) ) ) ; - $n_script= '' ; &ENV_EXPORT( n_script , '' ) ; - &doalias('script' , &fn( $File .".tmp" ) ) ; - sub C2_t2_document { - local(*TMP); - open(TMP,">txt$$.tmp"); - print TMP "bell=" . $savbell ."\n" ; - close(TMP); - "txt$$.tmp";} - &doexe( &fn( $n_exe ."/specify.exe" ) , "dwarf" .' '. "/nomenu" - .' '. &C2_t2_document , "" ) ; - &doalias('unsetenv' , "n_script" , "savbell" , "go" ) ; -# -# Transform the terminal output to something more decent -# - &echo( '' , " " , "" ) ; - &echo( '' , "Converting script output to LaTeX..." , "" ) ; - &doexe( &fn( $n_exe ."/docaid.exe" ) , "script" .' '. &fn( $File - .".tmp" ) , '>'. &fn( $File .".tex" ) ) ; - &echo( '' , "LaTeX commands are in " . $File .".tex" , "" ) ; -# -# Ask for printout -# - &echo( "-n" , "Make printout (y,p), view (v) or stop (s,n)?" - ." [n] " , "" ) ; - $ans= ($_=scalar(<STDIN>), chop, $_) ; - if ( &peq( $ans , "[Yy]*" ) || &peq( $ans , "[Pp]*" ) ) { - $Print= "1" ; } - if ( &peq( $ans , "[Vv]*" ) ) { $Print= "2" ; } - } -# -# Make printout -# - if ( $Print ) { - $Tmpfile= &fn( &fp('t', $File ) ."_tmp" ) ; - sub C2_t3_document { - local(*TMP); - open(TMP,">txt$$.tmp"); - print TMP "\\documentstyle{book}" ."\n" ; - print TMP "\\input{" . $n_src ."/doc/cook/cb_preamble}" ."\n" ; - print TMP "\\input{" . $n_src ."/doc/cook/cb_symbols}" ."\n" ; - print TMP "\\begin{document}" ."\n" ; - print TMP "\\title{NEWSTAR Cookbook - Sample script}" ."\n" ; - print TMP "\\author{" . $Myname ."}" ."\n" ; - print TMP "\\maketitle" ."\n" ; - print TMP "\\include{" . $File ."}" ."\n" ; - print TMP "\\end{document}" ."\n" ; - print TMP "\\end" ."\n" ; - close(TMP); - "txt$$.tmp";} - &cat( '' , &C2_t3_document , ''. &fn( $Tmpfile .".tex" ) ) ; - &doalias('latex' , &fn( $Tmpfile ) ) ; - if ( &ft('e', $Tmpfile .".dvi" ) ) { - if ( &eq( $Print , 2 ) ) { - &mv( '' , &fn( $Tmpfile .".dvi" ) .' '. &fn( &fp('t', $File - ) .".dvi" ) ) ; - &doalias('xdvi' , &fn( &fp('t', $File ) ) ) ; - } - else { - &doalias('dvips' , &fn( $Tmpfile ) , ">" , &fn( $Tmpfile - .".ps" ) ) ; - if ( &ft('e', $Tmpfile .".ps" ) ) { &mv( '' , &fn( $Tmpfile - .".ps" ) .' '. &fn( &fp('t', $File ) .".ps" ) ) ; - } - if ( &ft('e', &fp('t', $File ) .".ps" ) ) { - &echo( '' , "Postscript is in " . &fp('t', $File ) - .".ps, trying to print now" , "" ) ; - &docsh( &fn( $n_src ."/sys/wngfex.csh" ) , "PS" .' '. &fn( - &fp('t', $File ) .".ps" ) , "" ) ; - } - else { - &echo( '' , "Could not produce postscript output..." , "" ) - ; - } - } - } - &rm( "-f" , &fn( $Tmpfile .".*" ) ) ; - } -# -# -# %Print command: -# - } - elsif ( &peq( $Command , "[Pp]*" ) ) { - $Print= "1" ; - if ( &peq( (split(' ',$Files)) [ 1 -1 ] , "-*" ) ) { - if ( &peq( (split(' ',$Files)) [ 1 -1 ] , "-[Pp]" ) ) { $Print= "1" - ; } - if ( &peq( (split(' ',$Files)) [ 1 -1 ] , "-[Vv]" ) ) { $Print= "2" - ; } - @Files=split(' ',$Files); splice(@Files, "1" -1,1, '' ); - $Files=join(' ',@Files); if ( &vn($Files) > 1 ) { - @Files=split(' ',$Files) ; shift(@Files) ; - $Files=join(' ',@Files) ; } - } - $File= &fn( (split(' ',$Files)) [ 1 -1 ] ) ; - if ( &eq( $File , '' ) ) { - &echo( "-n" , "Enter the name of the LaTeX file to print: " , "" - ) ; - $File= ($_=scalar(<STDIN>), chop, $_) ; # Read from stdin - } - if ( !&eq( &fp('e', $File ) , '' ) ) { $File= &fn( &fp('r', $File - ) ) ; } - $Tmpfile= &fn( &fp('t', $File ) ."_tmp" ) ; - &rm( "-f" , &fn( $Tmpfile .".*" ) ) ; ### > /dev/null - sub C2_t4_document { - local(*TMP); - open(TMP,">txt$$.tmp"); - print TMP "\\documentstyle{book}" ."\n" ; - print TMP "\\input{" . $n_src ."/doc/cook/cb_preamble}" ."\n" ; - print TMP "\\input{" . $n_src ."/doc/cook/cb_symbols}" ."\n" ; - print TMP "\\begin{document}" ."\n" ; - print TMP "\\title{NEWSTAR Cookbook (partial printout)}" ."\n" ; - print TMP "\\author{Printed by " . $Myname ."}" ."\n" ; - print TMP "\\maketitle" ."\n" ; - print TMP "\\tableofcontents" ."\n" ; - print TMP "\\include{" . $File ."}" ."\n" ; - print TMP "\\end{document}" ."\n" ; - print TMP "\\end" ."\n" ; - close(TMP); - "txt$$.tmp";} - &cat( '' , &C2_t4_document , ''. &fn( $Tmpfile .".tex" ) ) ; - &doalias('latex' , &fn( $Tmpfile ) ) ; - &doalias('latex' , &fn( $Tmpfile ) ) ; - if ( &ft('e', $Tmpfile .".dvi" ) ) { - if ( &eq( $Print , 2 ) ) { - &mv( '' , &fn( $Tmpfile .".dvi" ) .' '. &fn( &fp('t', $File ) - .".dvi" ) ) ; - &doalias('xdvi' , &fn( &fp('t', $File ) ) ) ; - } - else { - &doalias('dvips' , &fn( $Tmpfile ) , ">" , &fn( $Tmpfile .".ps" - ) ) ; - if ( &ft('e', $Tmpfile .".ps" ) ) { &mv( '' , &fn( $Tmpfile - .".ps" ) .' '. &fn( &fp('t', $File ) .".ps" ) ) ; - } - if ( &ft('e', &fp('t', $File ) .".ps" ) ) { - &echo( '' , "Postscript is in " . $File - .".ps, trying to print now" , "" ) ; - &docsh( &fn( $n_src ."/sys/wngfex.csh" ) , "PS" .' '. &fn( - &fp('t', $File ) .".ps" ) , "" ) ; - } - else { - &echo( '' , "Could not produce postscript output..." , "" ) ; - } - } - } - &rm( "-f" , &fn( $Tmpfile .".*" ) ) ; -# -# %Hyper command -# - } - elsif ( &peq( $Command , "[Hh][Yy]*" ) ) { - $File= &fn( (split(' ',$Files)) [ 1 -1 ] ) ; - if ( &eq( $File , '' ) ) { $File= &fn( $n_hlp ."/newstar.html" ) - ; } - &doexe( &fn( $n_exe ."/docaid.exe" ) , "hyper" .' '. &fn( $File ) - , "" ) ; -# -# -# %Keys command -# - } - elsif ( &peq( $Command , "[Kk]*" ) ) { - if ( &eq( $Files , '' ) ) { - &echo( "-n" , "Enter the name of PIN/PSC/PEF file(s) [All]:" ." " - , "" ) ; - $Files= ($_=scalar(<STDIN>), chop, $_) ; - $Files= &fn( $Files ) ; - } - if ( &eq( $Files , '' ) || &peq( $Files , "[Aa][Ll][Ll]" ) ) { - $Files= &fn( $NSTAR_DIR ) ; } - for $File__x (split(' ',join(' ' , &fn( $Files ) ))) { - $File=$File__x ; - if ( &ft('d', $n_src ."/" . $File ) ) { $File= &fn( $n_src ."/" . - $File ) ; } - if ( &ft('d', $File ) ) { - $nonomatch='' ; - $Flag= $File ; - $File= &fn( $File ."/*.p??" ) ; - if ( &eq( $File , $Flag .'/*.p??' ) ) { $File= '' ; } - undef $nonomatch ; - } - if ( !&eq( $File , '' ) ) { &doexe( &fn( $n_exe ."/docaid.exe" - ) , "keys" .' '. &fn( $File ) , "" ) ; } - } - &echo( '' , "Update the index " ."\$" . - "n_src/doc/progkeys.tex by hand if necessary" , "" - ) ; -# -# -# %Cook command -# - } - elsif ( &peq( $Command , "[Cc]*" ) ) { - if ( &eq( $Files , '' ) ) { - &echo( "-n" , "Enter the name of LaTeX file(s) [All]: " , "" ) ; - $Files= ($_=scalar(<STDIN>), chop, $_) ; - $Files= &fn( $Files ) ; - } - $Reflist= &fn( $n_src ."/doc/cook/reflist.txt" ) ; - undef $Idx ; - if ( &eq( $Files , '' ) || &peq( $Files , "[Aa][Ll][Ll]" ) ) { - $Files= &fn( $n_src ."/doc/cook/*.tex" ) ; - &echo( '' , "Processing all files in " . $n_src ."/doc/cook..." , - "" ) ; - if ( &ft('e', $Reflist ) ) { &rm( "-f" , &fn( $Reflist ) ) ; } - $Idx= &fn( $n_hlp ."/index_cook.html" ) ; - } - if ( ! &ft('e', $Reflist ) ) { - &echo( '' , "Files are in directory " . $n_src ."/doc/cook" , ''. - &fn( $Reflist ) ) ; - &echo( '' , " " , '>'. &fn( $Reflist ) ) ; - } - if ( defined($Idx) ) { - sub C2_t5_document { - local(*TMP); - open(TMP,">txt$$.tmp"); - print TMP "<TITLE>Newstar Documentation: Cookbook Index" - ."</TITLE>" ."\n" ; - print TMP "<UL>" ."\n" ; - close(TMP); - "txt$$.tmp";} - &cat( '' , &C2_t5_document , ''. &fn( $Idx ) ) ; - } - for $File__x (split(' ',join(' ' , &fn( $Files ) ))) { - $File=$File__x ; - &doexe( &fn( $n_exe ."/docaid.exe" ) , "html" .' '. &fn( $File ) - , '>'. &fn( $Reflist ) ) ; - if ( defined($Idx) && !&peq( $File , "*/cb_*" ) && !&peq( $File , - "*_keys.tex" ) && !&peq( $File , "*_comm.tex" ) && - !&peq( $File , "*_short.tex" ) ) { - $Ref= &fn( &fp('t', $File ) ) ; - $Ref= &fn( &fp('r', $Ref ) ) ; - if ( &peq( $File , "*/fig_*.tex" ) || &peq( $File , "*/tab_*.tex" - ) || &peq( $File , "*/eqn_*.tex" ) ) { - &echo( '' , "<LI> <A HREF=" . $Ref .".gif><EM>" . $Ref - ."</EM></A>" , '>'. &fn( $Idx ) ) ; - } - else { - &echo( '' , "<LI> <A HREF=" . $Ref .".html>" . &fp('t', $File - ) ."</A>" , '>'. &fn( $Idx ) ) ; - } - } - } - if ( defined($Idx) ) { - &echo( '' , "</UL>" , '>'. &fn( $Idx ) ) ; - } -# -# -# %Memo command -# - } - elsif ( &peq( $Command , "[Mm]*" ) ) { - $server_dir= &fn( $n_root ."/server/newstar/memo" ) ; - if ( ! &ft('d', $server_dir ) ) { - &echo( '' , " " , "" ) ; - &echo( '' , "You do not have a memo server directory here" - ."...." , "" ) ; - &echo( '' , "This directory should be named " . $server_dir , "" - ) ; - &echo( '' , " " , "" ) ; - } - else { - if ( &eq( $Files , '' ) ) { - &echo( "-n" , "Enter the number of the memo [new]: " , "" ) ; - $Files= ($_=scalar(<STDIN>), chop, $_) ; - if ( &eq( $Files , '' ) ) { $Files= "new" ; } - } - $subj= "<DT><STRONG>Subject:</STRONG>" ; -# -# Edit existing memo -# - if ( !&eq( (split(' ',$Files)) [ 1 -1 ] , "new" ) ) { - $memo_id= &Pipe("p$$.tmp00", &echo( '' , &fn( - (split(' ',$Files)) [ 1 -1 ] ) , "p$$.tmp01" ) , - &awk( '' , '{printf "%4.4d",$1}' , "p$$.tmp01" , - "p$$.tmp00" ) ) ; - $memo_file= &fn( $server_dir ."/n" . $memo_id .".mem" ) ; - if ( ! &ft('e', $memo_file ) ) { - &echo( '' , "No memo " . $memo_id ." (missing file " . - $memo_file .")" , "" ) ; - $memo_file= '' ; - } - else { - $File= &Pipe("p$$.tmp00", &grep( '' , '<STRONG>Document:' , - &fn( $memo_file ) , "p$$.tmp01" ) , &awk( '' , - '{printf $2}' , "p$$.tmp01" , "p$$.tmp00" ) ) ; - } -# -# Create new memo in the system -# - } - else { - $ii= 1 ; - while ( &ft('e', $server_dir ."/n" . &Pipe("p$$.tmp00", &echo( - '' , &fn( $ii ) , "p$$.tmp01" ) , &awk( '' , - '{printf "%4.4d",$1}' , "p$$.tmp01" , "p$$.tmp00" ) - ) .".mem" ) ) { - $ii= $ii + 1 ; - } - $memo_id= &Pipe("p$$.tmp00", &echo( '' , &fn( $ii ) , - "p$$.tmp01" ) , &awk( '' , '{printf "%4.4d",$1}' , - "p$$.tmp01" , "p$$.tmp00" ) ) ; - $memo_file= &fn( $server_dir ."/n" . $memo_id .".mem" ) ; -# -# Get pertinent information -# - &echo( '' , "Creating Newstar memo with id-number " . $memo_id - , "" ) ; - $File= '' ; - if ( &vn($Files) > 1 ) { - if ( !&eq( (split(' ',$Files)) [ 2 -1 ] , '' ) ) { - $File= &fn( (split(' ',$Files)) [ 2 -1 ] ) ; - if ( ! &ft('e', $File ) && !&peq( $File , "[Nn][Oo][Nn][Ee]" - ) ) { $File= '' ; } - } - } - while ( &eq( $File , '' ) ) { - &echo( "-n" , "Associated text file [" . $File ."]: " , "" ) - ; - $ans= ($_=scalar(<STDIN>), chop, $_) ; - if ( !&eq( $ans , '' ) ) { - $File= &fn( $ans ) ; - if ( ! &ft('e', $File ) && !&peq( $File , "[Nn][Oo][Nn][Ee]" - ) ) { $File= '' ; } - } - } - $Subject= "Unknown" ; - $Author= $Myname ; - $Status= "Info" ; - $Action= "None" ; - $To= "Newstar Memo Series" ; - &echo( "-n" , "Enter subject [" . $Subject ."]: " , "" ) ; - $ans= ($_=scalar(<STDIN>), chop, $_) ; if ( !&eq( $ans , '' ) - ) { $Subject= &fn( $ans ) ; } - &echo( "-n" , "Enter author [" . $Author ."]: " , "" ) ; - $ans= ($_=scalar(<STDIN>), chop, $_) ; if ( !&eq( $ans , '' ) - ) { $Author= &fn( $ans ) ; } - &echo( "-n" , "Enter status (Proposal/Change/Info) [" . $Status - ."]: " , "" ) ; - $ans= ($_=scalar(<STDIN>), chop, $_) ; if ( !&eq( $ans , '' ) - ) { $Status= &fn( $ans ) ; } - &echo( "-n" , "Enter action (Read/Decide/...) [" . $Action - ."]: " , "" ) ; - $ans= ($_=scalar(<STDIN>), chop, $_) ; if ( !&eq( $ans , '' ) - ) { $Action= &fn( $ans ) ; } - &echo( "-n" , "Relevant to [" . $To ."]: " , "" ) ; - $ans= ($_=scalar(<STDIN>), chop, $_) ; if ( !&eq( $ans , '' ) - ) { $To= &fn( $ans ) ; } - &echo( "-n" , "Update on memo's [None]: " , "" ) ; - $Other1= ($_=scalar(<STDIN>), chop, $_) ; - &echo( "-n" , "Replaces memo's [None]: " , "" ) ; - $Other2= ($_=scalar(<STDIN>), chop, $_) ; - &echo( "-n" , "Associated memo's [None]: " , "" ) ; - $Other= ($_=scalar(<STDIN>), chop, $_) ; - &echo( "-n" , "Associated bug-reports [None]: " , "" ) ; - $Bugs= ($_=scalar(<STDIN>), chop, $_) ; -# -# Move file into the system -# - if ( &peq( $File , "[Nn][Oo][Nn][Ee]" ) ) { - $File= "none" ; - if ( ! &ft('e', $server_dir ."/none" ) ) { - sub C2_t6_document { - local(*TMP); - open(TMP,">txt$$.tmp"); - print TMP "<Title>No associated document</Title>" ."\n" ; - print TMP '' ."\n" ; - print TMP "<EM>This memo has no associated file.</EM>" - ."\n" ; - print TMP "<P>" ."\n" ; - print TMP '' ."\n" ; - print TMP "The text of the memo is in the memo header (" - ."Summary)." ."\n" ; - print TMP "Click \"Back\" to read it." ."\n" ; - close(TMP); - "txt$$.tmp";} - &cat( '' , &C2_t6_document , ''. &fn( $server_dir ."/none" - ) ) ; - } - } - else { - &cp( "-i" , &fn( $File ) .' '. &fn( $server_dir ) ) ; - &echo( "-n" , "Remove: " , "" ) ; &rm( "-i" , &fn( $File ) - ) ; - $File= &fn( &fp('t', $File ) ) ; - } -# -# Create header only if file moved into system -# - if ( &ft('e', $server_dir ."/" . $File ) ) { -# -# Create the Memo header and move any file into the system -# - sub C2_t7_document { - local(*TMP); - open(TMP,">txt$$.tmp"); - print TMP "<TITLE>Newstar Memo # " . $memo_id ."</TITLE>" - ."\n" ; - print TMP '' ."\n" ; - print TMP "<H1>Newstar Memo # " . $memo_id ." </H1>" ."\n" ; - print TMP '' ."\n" ; - print TMP "<DT><STRONG>Document:</STRONG> " . $File - ."\n" ; - print TMP "<DT><STRONG>Subject:</STRONG> " . - $Subject ."\n" ; - print TMP "<DT><STRONG>Author:</STRONG> " . - $Author ."\n" ; - print TMP "<DT><STRONG>Date:</STRONG> " . - $C_Date ."\n" ; - print TMP "<P>" ."\n" ; - print TMP "<DT><STRONG>Status:</STRONG> " . - $Status ."\n" ; - print TMP "<DT><STRONG>Action:</STRONG> " . - $Action ."\n" ; - print TMP "<P>" ."\n" ; - print TMP "<DT><STRONG>To:</STRONG> " . $To - ."\n" ; - print TMP "<P>" ."\n" ; - print TMP "<H2>Text of the Memo: <A HREF=" . $File .">" . - $File ."</A></H2>" ."\n" ; - print TMP "<P>" ."\n" ; - print TMP '' ."\n" ; - close(TMP); - "txt$$.tmp";} - &cat( '' , &C2_t7_document , ''. &fn( $memo_file ) ) ; - if ( !&eq( $Other1 , '' ) ) { - &echo( '' , " " , '>'. &fn( $memo_file ) ) ; - &echo( '' , "<H3>Update on memo's</H3>" , '>'. &fn( - $memo_file ) ) ; - &echo( '' , " " , '>'. &fn( $memo_file ) ) ; - for $file__x (split(' ',join(' ' , &fn( $Other1 ) ))) { - $file=$file__x ; - $file= "n" . &Pipe("p$$.tmp00", &echo( '' , &fn( $file ) - , "p$$.tmp01" ) , &awk( '' , '{printf "%4.4d",$1}' - , "p$$.tmp01" , "p$$.tmp00" ) ) .".mem" ; - &echo( '' , "<DT><TT><A HREF=" . $file .">" . $file - ."</A></TT> " , '>'. &fn( $memo_file ) ) ; - if ( &ft('e', $server_dir ."/" . $file ) ) { - &grep( '' , &fn( $subj ) , &fn( $server_dir ."/" . - $file ) , "p$$.tmp00" ) ; &sed( '' , "s^" . $subj - ."^-^" , "p$$.tmp00" , '>'. &fn( $memo_file ) ) ; - } - &echo( '' , " " , '>'. &fn( $server_dir ."/" . $file ) ) - ; - &echo( '' , "<P><STRONG>Updated in <A HREF=" . &fp('t', - $memo_file ) .">Memo " . $memo_id ."</A></STRONG>" - , '>'. &fn( $server_dir ."/" . $file ) ) ; - &echo( '' , " " , '>'. &fn( $server_dir ."/" . $file ) ) - ; - } - } - if ( !&eq( $Other2 , '' ) ) { - &echo( '' , " " , '>'. &fn( $memo_file ) ) ; - &echo( '' , "<H3>Replaces memo's</H3>" , '>'. &fn( - $memo_file ) ) ; - &echo( '' , " " , '>'. &fn( $memo_file ) ) ; - for $file__x (split(' ',join(' ' , &fn( $Other2 ) ))) { - $file=$file__x ; - $file= "n" . &Pipe("p$$.tmp00", &echo( '' , &fn( $file ) - , "p$$.tmp01" ) , &awk( '' , '{printf "%4.4d",$1}' - , "p$$.tmp01" , "p$$.tmp00" ) ) .".mem" ; - &echo( '' , "<DT><TT><A HREF=" . $file .">" . $file - ."</A></TT> " , '>'. &fn( $memo_file ) ) ; - if ( &ft('e', $server_dir ."/" . $file ) ) { - &grep( '' , &fn( $subj ) , &fn( $server_dir ."/" . - $file ) , "p$$.tmp00" ) ; &sed( '' , "s^" . $subj - ."^-^" , "p$$.tmp00" , '>'. &fn( $memo_file ) ) ; - } - &echo( '' , " " , '>'. &fn( $server_dir ."/" . $file ) ) - ; - &echo( '' , "<P><STRONG>Replaced by <A HREF=" . &fp('t', - $memo_file ) .">Memo " . $memo_id ."</A></STRONG>" - , '>'. &fn( $server_dir ."/" . $file ) ) ; - &echo( '' , " " , '>'. &fn( $server_dir ."/" . $file ) ) - ; - } - } - &echo( '' , " " , '>'. &fn( $memo_file ) ) ; - &echo( '' , "<H3>Associated Memo's</H3>" , '>'. &fn( - $memo_file ) ) ; - &echo( '' , " " , '>'. &fn( $memo_file ) ) ; - for $file__x (split(' ',join(' ' , &fn( $Other ) ))) { - $file=$file__x ; - $file= "n" . &Pipe("p$$.tmp00", &echo( '' , &fn( $file ) , - "p$$.tmp01" ) , &awk( '' , '{printf "%4.4d",$1}' , - "p$$.tmp01" , "p$$.tmp00" ) ) .".mem" ; - &echo( '' , "<DT><TT><A HREF=" . $file .">" . $file - ."</A></TT> " , '>'. &fn( $memo_file ) ) ; - if ( &ft('e', $server_dir ."/" . $file ) ) { - &grep( '' , &fn( $subj ) , &fn( $server_dir ."/" . $file - ) , "p$$.tmp00" ) ; &sed( '' , "s^" . $subj ."^-^" - , "p$$.tmp00" , '>'. &fn( $memo_file ) ) ; - } - } - &echo( '' , "<DT><TT><A HREF=n????.mem> </A></TT> " , '>'. - &fn( $memo_file ) ) ; - &echo( '' , " " , '>'. &fn( $memo_file ) ) ; - &echo( '' , "<H3>Associated bug-reports</H3>" , '>'. &fn( - $memo_file ) ) ; - &echo( '' , " " , '>'. &fn( $memo_file ) ) ; - for $file__x (split(' ',join(' ' , &fn( $Bugs ) ))) { - $file=$file__x ; - $file= "n" . &Pipe("p$$.tmp00", &echo( '' , &fn( $file ) , - "p$$.tmp01" ) , &awk( '' , '{printf "%4.4d",$1}' , - "p$$.tmp01" , "p$$.tmp00" ) ) .".prj" ; - &echo( '' , "<DT><TT><A HREF=../bug/" . $file .">" . $file - ."</A></TT> " , '>'. &fn( $memo_file ) ) ; - if ( &ft('e', $n_root ."/server/bug/" . $file ) ) { - &grep( '' , &fn( $subj ) , &fn( $n_root ."/server/bug/" - . $file ) , "p$$.tmp00" ) ; &sed( '' , "s^" . - $subj ."^-^" , "p$$.tmp00" , '>'. &fn( $memo_file - ) ) ; - } - } - &echo( '' , "<DT><TT><A HREF=../bug/n????.prj> </A></TT> " , - '>'. &fn( $memo_file ) ) ; - sub C2_t8_document { - local(*TMP); - open(TMP,">txt$$.tmp"); - print TMP "<H3>-------------------</H3>" ."\n" ; - print TMP '' ."\n" ; - print TMP "<P>" ."\n" ; - print TMP "<H2>Summary</H2>" ."\n" ; - print TMP "<PRE>" ."\n" ; - print TMP "<EM>To be filled in...</EM>" ."\n" ; - print TMP "</PRE>" ."\n" ; - close(TMP); - "txt$$.tmp";} - &cat( '' , &C2_t8_document , '>'. &fn( $memo_file ) ) ; - &chmod( "a+r" , &fn( $memo_file ) ) ; # All may read - &chmod( "g+w" , &fn( $memo_file ) ) ; # Group members may write - } - else { - $memo_file= '' ; - } # If file moved into system - } # If new memo -# -# Edit the memo file and associated text -# - if ( !&eq( $memo_file , '' ) ) { - if ( !&eq( $File , '' ) ) { $File= &fn( $server_dir ."/" . - $File ) ; } - &dollar("EDITOR" , &fn( $memo_file ) .' '. &fn( $File ) , "" ) - ; - } -# -# Update the index -# - $Idx= &fn( $server_dir ."/memo.idx" ) ; - &echo( '' , "Building index: " . $Idx , "" ) ; - sub C2_t9_document { - local(*TMP); - open(TMP,">txt$$.tmp"); - print TMP "<TITLE>Newstar Memo System: Master Index</TI" ."TLE>" - ."\n" ; - print TMP "<H1>Index of all Newstar Memo's</H1>" ."\n" ; - print TMP '' ."\n" ; - print TMP "<FORM ACTION=\"/htbin/nsmemo\" METHOD=GET>" ."\n" ; - print TMP "<HR>" ."\n" ; - print TMP "To search for all memos containing some stri" - ."ng in their header, <BR>" ."\n" ; - print TMP "enter the text (or -memonumber) here" ."\n" ; - print TMP "and hit return <INPUT TYPE=\"Text\" NAME=\"i" - ."sindex\">" ."\n" ; - print TMP "<HR>" ."\n" ; - print TMP "</FORM><P>" ."\n" ; - print TMP " " ."\n" ; - close(TMP); - "txt$$.tmp";} - &cat( '' , &C2_t9_document , ''. &fn( $Idx ) ) ; - for $File__x (split(' ',join(' ' , &fn( $server_dir ."/n*.mem" ) - ))) { $File=$File__x ; - &echo( '' , "<DT><TT><A HREF=" . &fp('t', $File ) .">" . - &fp('t', $File ) ."</A></TT>" , '>'. &fn( $Idx ) ) - ; - &grep( '' , &fn( $subj ) , &fn( $File ) , "p$$.tmp00" ) ; - &sed( '' , "s^" . $subj ."^-^" , "p$$.tmp00" , - '>'. &fn( $Idx ) ) ; - } - } # if server directory -# -# %Extract command -# - } - elsif ( &peq( $Command , "[Ee]*" ) ) { - $server_dir= &fn( $n_root ."/server/newstar/extract" ) ; - if ( ! &ft('d', $server_dir ) ) { - &echo( '' , " " , "" ) ; - &echo( '' , "You do not have a directory for extracted so" - ."urces here..." , "" ) ; - &echo( '' , "This directory should be named " . $server_dir , "" - ) ; - &echo( '' , " " , "" ) ; - } - else { - if ( &eq( $Files , '' ) ) { - &echo( "-n" , "Enter the name of the source file(s): " , "" ) ; - $Files= ($_=scalar(<STDIN>), chop, $_) ; - $Files= &fn( $Files ) ; - } - if ( !&eq( $Files , '' ) ) { - if ( &peq( $Files , "[Aa][Ll][Ll]" ) ) { $Files= &fn( $n_src - ."/sys/*.csh" ) .' '. &fn( $n_src ."/sys/*.c" ) ; - } - for $File__x (split(' ',join(' ' , &fn( $Files ) ))) { - $File=$File__x ; - $Outfile= &fn( $server_dir ."/" . &fp('t', $File ) ) ; - &doexe( &fn( $n_exe ."/docaid.exe" ) , "extract" .' '. &fn( - $File ) , ''. &fn( $Outfile ) ) ; - if ( ! &ft('e', $Outfile ) || &ft('z', $Outfile ) ) { - if ( &ft('e', $Outfile ) ) { - &rm( "-f" , &fn( $Outfile ) ) ; - } - &echo( '' , "No extractable documentation in " . $File , "" - ) ; - } - else { - &echo( '' , "Extracted documentation from " . $File , "" ) - ; - } - } - } -# -# Update the index -# - $Idx= &fn( $server_dir ."/../index_doc.html" ) ; - &echo( '' , "Building index: " . $Idx , "" ) ; - sub C2_t10_document { - local(*TMP); - open(TMP,">txt$$.tmp"); - print TMP "<TITLE>Index of extracted documentation</TIT" ."LE>" - ."\n" ; - print TMP "<UL>" ."\n" ; - close(TMP); - "txt$$.tmp";} - &cat( '' , &C2_t10_document , ''. &fn( $Idx ) ) ; - for $File__x (split(' ',join(' ' , &fn( $server_dir ."/*" ) ))) { - $File=$File__x ; - &echo( '' , "<LI> <A HREF=/htbin/nview/extract/" . &fp('t', - $File ) .">" . &fp('t', $File ) ."</A>" , '>'. &fn( - $Idx ) ) ; - } - &echo( '' , "</UL>" , '>'. &fn( $Idx ) ) ; - } # if directory exists -# -# -# Invalid command -# - } # Other command - else { - &echo( '' , '' , "" ) ; - &echo( '' , "Error: Invalid or ambiguous command " . $Command , "" - ) ; - &echo( '' , '' , "" ) ; - } # End of if (Command == ...) - } # End of while (Menu mode) - &Abort_exit_document ; - sub Abort_exit_document { - ; -# -#+ Postamble -# -# -# Finish main routine -# - &exit('');} - &exit('');} -# -# Call main routine -# -eval('&document__pls'); -1; -#- diff --git a/src/sys/dwrecord.csh b/src/sys/dwrecord.csh deleted file mode 100755 index a2fb9a3a558224b4a61732e68068097ba3abab59..0000000000000000000000000000000000000000 --- a/src/sys/dwrecord.csh +++ /dev/null @@ -1,192 +0,0 @@ -#! /bin/csh -f -if (! $?dwrec) then # this is a kluge that seems to work around the - setenv dwrec 1 # csh version in some HP systems that refuses to read - csh -f $0 $argv # a .csh files to its end - exit -endif -goto 000 - -dwrecord.csh - record/replay program run - -options (first argument): - r replay with parameter script $1.$ext - m run and record program interactively - n (re)number existing $1.$ext - -arguments - $1 program name with extension - - The parameter script <program>.pst contains lines of the form - - <keyword>=<value list>. - -The lines are indented to show where the program reverts to a previous keyword. - Hidden keywords (those that the .psc/.psf file defines with /NOASK) are marked with two leading exclamation marks. - - dwrecord pipes the script to the program and catches the output in a file <program>_psc.log. For the -m option, the question marks are first filtered out. - - You may manually insert a number of shell commands at the start of the script to initialise, e.g. by cleaning out files that might be in the way. Terminate the script with 'exit'. psc_test will execute the script lines and filter them out before piping the parameter values to the program. -- - JPH 951113 Adapt from private script 'pst' - JPH 9606.. Remove synchronous post-processing to capture errors - JPH 960719 Compress whitespace around ! - Remove logging - Remove backtrack - and help-request logic. - Better line numbering - JPH 960807 Copy user's DWARF symbols to temp. symbol file; use uppercase - name because DWARF does not know lower-case names - JPH 960815 Inhibit interrupts during pipe execution - Log $tmp.log --> $1.log - JPH 961017 Bell off i.s.o. on (batch_sync uses line terminator for prompt - recognition.) - JPH 961018 Try $n_uexe for batch_<xxx> - JPH 961107 onintr - : Otherwise crashes on NPLOT - Bell ON for record, OFF for replay - JPH 961212 Workaround for faulty HP csh - Refine code for selecting $n_uexe/batch_<xxx>.exe - JPH 9612.. Kluge for HP csh bug - JPH 961218 Add exit to kluge - JPH 970204 On control-C exit do kill -INT $$ - - -000: -##set echo - if ($n_arch == hp) alias makenode 'mkfifo node' - if ($n_arch == sw) alias makenode 'mknod node p' - - pushd >&/dev/null $n_exe - if ($?n_uexe) then - set uexe = $n_uexe - else - set uexe = $n_exe/jph - endif - if (-e $uexe) then - foreach f (batch_*.exe) - set $f:r = $n_exe/$f - if (-e $uexe/$f) set $f:r = $uexe/$f - end - endif - popd >&/dev/null - - cp $DWARF_SYMBOLS DWRSYMBOLS.TMP - setenv DWARF_SYMBOLS DWRSYMBOLS.TMP - - onintr cleanup - if ("$argv[1]" =~ [mncr]) then - set mode = $argv[1] - shift argv - endif - set ext = $argv[1]:e - if ($ext =="") then - echo \ -"FATAL: argument must have a file extension: <program>.<extension>" - exit -1 - endif - set pr = $argv[1]:r - set PR = \ -`echo $pr | sed -e 'y/abcdefghijklmnopqrstuvwxyz/ABCDEFGHIJKLMNOPQRSTUVWXYZ/' ` - set log = $pr.$ext.log - set tmp = $pr.$ext.tmp - rm -f >&/dev/null $tmp.* -##set echo; set verbose - if ($mode == m) then - -# temporarily set dwarf bell on - - $n_exe/specify.exe dwarf/nomenu << END >! /dev/null - bell = on - -END - -# make new .$ext file - - if (-e $pr.$ext) then - echo -n " $pr.$ext exists. Delete? " - set x = $< - if ($x !~ [Yy]*) exit - endif - echo -n "" >! $pr.$ext - -# execute program run - - setenv N_PSCTEST /dev/null - onintr - - $n_exe/execute.exe $pr | $batch_log >! $tmp. - endif - - if ($mode =~ [cm]) then - -## convert log file to record file, making level indents - - sed < $tmp. \ - -e 's:[A-Za-z0-9_$]* *\! *?:/ASK:' \ - | awk -F'=' \ - 'BEGIN{ n=0; \ -bl=" ";} \ - /\!\!/{ print $0; next; } \ - { echo $0; f=0; for (i=1; i<=np; i++ ){ \ - if (i <=np && pl[i] == $1){ np=i; f=1; } \ - } \ - if (! f ){ np++; pl[np]= $1; } \ - printf("%s%s\n", substr (bl,1,2*(np-1)), $0); \ - }' \ - >> $pr.$ext - endif - - if ($mode =~ [mn]) then - -# Renumber record file: Remove old numbers first - - sed < $pr.$ext \ - -e 's: *\![ \!]*[0-9 ]*$: \!:' \ - >! $tmp. - nawk -F'\!' < $tmp. \ - '{ sep= " "; if (NF==1 ) sep = "\!"; \ - printf ("%s %s %d\n", $0, sep, NR); \ - }' \ - >! $pr.$ext - exit - endif - - if ($mode == r) then - -# temporarily set dwarf bell off - - $n_exe/specify.exe dwarf/nomenu << END |& grep -v 'being taken from' - bell = off - -END - -## Remove csh script and empty lines, remove blanks around commas and excl. -## marks - - expand < $pr.$ext \ - | sed \ - -e '/.*\!\!/d' \ - -e '/^ *$/d' \ - -e 's: *, *:,:g' \ - -e 's: *\! *: ! :g' \ - >! $tmp. - -# Execute program with input from $tmp. -# Collect output in _psc.log file, with a branch to awk for immediate -# inspection. When awk finds an error report it exits, which will stop the -# entire pipeline. -# -##set echo - onintr - - rm node >&/dev/null - makenode - setenv N_PSCTEST node - $batch_ask $tmp. $N_PSCTEST \ - | $n_exe/execute.exe $pr \ - | $batch_sync \ - >! $pr.$ext.log - onintr cleanup - endif -# -# Clean up -# - rm $tmp.* -cleanup: - rm >&/dev/null node $DWARF_SYMBOLS -## onintr -## kill -INT $$ diff --git a/src/sys/filpo.kwa b/src/sys/filpo.kwa deleted file mode 100644 index 8ca70bae3b3922b12235c25ece6e7b94c52bc5d3..0000000000000000000000000000000000000000 --- a/src/sys/filpo.kwa +++ /dev/null @@ -1,35 +0,0 @@ -BEGIN { Output=0; Table=0; Filpo=0; Freq=0; Date=""; Time="00:00:00"; - Seqno=0; Last=0; Freqerr=0; Clock=0; Pole=0; - Mon="JAN FEB MAR APR MAY JUN JUL AUG SEP OCT NOV DEC"; } - -/^----/ { Output=0; } -/^Baseline/ { Filpo=$7; } -/^Frequency/ { Freq=$3; Date=$7; } -/^Freq. point/ { Seqno=$7; Last=$9; } -/^Freq. error/ { Freqerr=$5; } -/^Clock error/ { Clock=$5; } -/^Pole error/ { Pole=$4; } -/^RT/ { - - if (Filpo==Req && Filpo>94) { - Table=490000+Filpo; - - DD=substr(Date,1,2); YY=substr(Date,6,2); - for (MM=1; MM<=12 && substr(Mon,4*(MM-1)+1,3)!=substr(Date,3,3); MM++); - Date=sprintf("%s/%2.2d%/19%s",DD,MM,YY); - - printf("PUT=BASELINEHDR TABLE=%4.4d FILPO=%d OPERATOR=WSRT DATE=%s TIME=%s FREQ=%f FREQERR=%f CLOCK=%f POLE=%f ",Table,Filpo,Date,Time,Freq,Freqerr,Clock,Pole); - if (Seqno>0 && Last>0) printf("SEQNO=%s%5.5d LAST=%s%5.5d",YY,Seqno,YY,Last); - printf("\n"); - printf("SELECT=BASELINEHDR TABLE=%4.4d\n",Table); - Output=1; Filpo=0; - } - -} - -/^[0-9A-D] / { - if (Output) - printf("PUT=BASELINE TABLE=%4.4d RT=%s POSITION=%s Q=%s N=%s P=%s\n",Table,$1,$2,$3/10.,$4/10.,$5/10.); - -} - diff --git a/src/sys/genaid.c b/src/sys/genaid.c deleted file mode 100644 index 9c7ce124ca21c331b712b9fc160c23ddc705e800..0000000000000000000000000000000000000000 --- a/src/sys/genaid.c +++ /dev/null @@ -1,2262 +0,0 @@ -/*+ - - genaid.c - general aid for program maintenance - - Revision: - WNB 931115 Make useful for VAX (include changes) - WNB 931115 Changed code=-1 anachroism - VAX: CC/debug/list/opt/def="wn_vx__/name=as_is" - CMV 940214 Filter unwanted *.x?? and *.a?? for compare - CMV 940216 If local more recent than remote: no retrieve - HjV 940516 Small changes for Convex use - CMV 940516 No negative checksums, please - CMV 940617 Moved extract and mosaic option from docaid to genaid - CMV 940617 Add option size to display just the size of a file - WNB 940620 Change case of logicals for VAX - WNB 940621 Make sure fstat sees n_src for VAX; count bytes - CMV 940719 Add KEYS, SIZE and HYPER commands - CMV 940721 Correct \ref to keywords - CMV 940812 Double underscores in names of keyword help - CMV 941102 Single underscores again, allow -i option in import command - CMV 941103 Add options to read volume label and init tape - CMV 941111 Change text for keys option (was confusing in update) - CMV 000929 Solved millenium bug - - Syntax: - - $n_exe/genaid.exe expand [-t:types] {name of groupfile} - - writes switches and full pathnames to the standard output; - if the name starts with +, $n_src will be prefixed, otherwise - the path to the groupfile is taken (may be empty if working - in the current directory). - - $n_exe/genaid.exe files [-t:types] {name of groupfile} - - writes just the filenames with respect to $n_src, or with - respect to the groupfile directory if not rooted in $n_src. - - $n_exe/genaid.exe select file1 file2 - - as files, but also writes the date - - $n_exe/genaid.exe fstat [-c] [-t:types] [+{prefix}] - {filename}|@{name of groupfile} ... or - ... @ {name of groupfile} ... - - calculates checksum, get size and date, write groupfile - entry for the file; if file roots in $n_src, $n_src is - replaced by a plus sign. - files prefixed by @ (no space in between) will be expanded - as groupfiles, if the @ has a space behind it, all remaining - files will be treated as groupfiles. - - $n_exe/genaid.exe mstat [-c] [-t:types] filename - - stdin will be copied to stdout and any lines starting with - the name of the file will be replaced by a like as produced - by fstat; only useful for master database updates. - - $n_exe/genaid.exe check [-c] [-t:types] {name of groupfile} ... - - expands the groupfile(s), calculates checksums etc for - resulting files, compare with the values specified in the - groupfile and write a groupfile entry if they differ. - - $n_exe/genaid.exe import [-c|i] [-t:types] {name of groupfile} ... - - idem, write get commands for ftp to stdout, report files - that are already correct to stderr. - - with the -i, no checks are made and no subdirectory appears in - the ftp get command. - - NB: both check and import ignore the file sys/database.idx - - $n_exe/genaid.exe compare file1 file2 - - compare two groupfiles (typically master indices) and copy - the lines for files that appear in both with different - size/checksum/date or appear in file1 only. - - $n_exe/genaid.exe group file... - - read an old-style groupfile and output new style data - - $n_exe/genaid.exe split file - - split contents of a new-style groupfile over one or more old stylers - - $n_exe/genaid.exe psc psc_file >pin_file - - expand includes in psc files, write pin file to stdout - - $n_exe/genaid.exe extract {name of file}... - - Extract documentation from one or more files (presumably source - code etc.) into text-files. Such text-files can be converted to - html files with the html option. - - $n_exe/genaid.exe hyper {name of homepage} - - Start xmosaic such that DWARF can communicate with it - - $n_exe/genaid.exe size {name of file} - - Show the size of the file - - $n_exe/genaid.exe keys {name of psc/pin/pef file} ... - - Convert pin file to html version - - $n_exe/genaid.exe label Unit (not on VAXes) - - Return volume label of Unit, if any - - $n_exe/genaid.exe init Unit Label (not on VAXes) - - Put volume label on Unit - - Original program created early 1993 for SCASIS reduction programs, - including parts from addwhat.c what.c and fstat.c (1991). - - This version created for Newstar maintenance (groupfiles, no SCCS-like - version strings, checksums etc.) in June 1993. - - Marco de Vos, NFRA Dwingeloo. - -*-*/ - -#include <stdio.h> -#include <string.h> -#include <stdlib.h> -#include <time.h> - -#ifdef wn_vx__ - -void *malloc(); -void free(); -#include <types.h> -#include <stat.h> -int vfork(); -void delete(); -#define fork vfork -#define unlink delete - -#else - -#include <fcntl.h> -#include <malloc.h> -#include <sys/types.h> -#include <sys/stat.h> -#include <signal.h> - -#endif - -/* List of valid options and their indices */ - -#define _EXPAND 1 -#define _FILES 2 -#define _SELECT 3 -#define _FSTAT 4 -#define _CHECK 5 -#define _IMPORT 6 -#define _COMPARE 7 -#define _MSTAT 8 -#define _GROUP 9 -#define _PSC 10 -#define _SPLIT 11 -#define _EXTRACT 12 -#define _HYPER 13 -#define _SIZE 14 -#define _KEYS 15 -#define _LABEL 16 -#define _INIT 17 - -char *options[]={"expand","files","select","fstat","check","import", - "compare","mstat","group","psc","split", - "extract","hyper","size","keys","label","init",NULL}; - -/* Define environment names and internal things */ -/* Note: the following should also be lc for VAX to bypass vax_style */ -#define ROOT "n_src" /* Root of directory tree */ -#define ROOT_UC "N_SRC" - -#define MAX_STRING 512 /* Maximum length of strings */ -#define MAX_BUF 5000 /* Length of help buffer */ - -#ifdef wn_vx__ -#define DOCDIR "N_HLP" /* Directory for hypertext */ -#else -#define DOCDIR "n_hlp" /* Directory for hypertext */ -#endif - -/* Root directory of source tree, read from environment */ - -char x_root[MAX_STRING]; /* Root of directory tree */ -int x_root_len; /* strlen(x_root) */ -int vax_style; /* True if VMS directories */ -char d_root[MAX_STRING]; /* Directory for hypertext */ -int d_root_len; /* strlen(d_root) */ - -#ifdef wn_vx__ -char vms_root[MAX_STRING]; /* Root of directory tree */ -int vms_root_len; /* strlen(vms_root) */ -#endif - -/* General string variables */ - -char line[MAX_STRING]; /* Character buffer */ -char buf[MAX_STRING]; /* Another one */ -unsigned char bbuf[MAX_BUF]; /* Buffer for reading files */ - - -/* Directory specification of groupfile */ - -char grpdir[MAX_STRING]; - - -/* Filepointer for groupfile */ - -FILE *grp=NULL; /* Initialised: none */ - -/* Values from groupfile entry */ - -char orgname[MAX_STRING]; /* Original groupfile entry */ -char fullname[MAX_STRING]; /* Full name of the file */ -char filename[MAX_STRING]; /* Name w.r.t. x_root */ -char switches[MAX_STRING]; /* Contents of switches */ -long grpdate,grpsize,grpchsum; /* Date, size and checksum */ - - -/* String with types to be selected */ - -char types[MAX_STRING]="."; /* Initialised: select all */ - -/* Prefix for groupfile output */ - -char prefix[MAX_STRING]=""; /* Initialised: none */ - -/* Flag for testing files in current dir */ - -int test_cwd=0; /* Initialised: no */ -int test_include=0; /* Initialised: no */ - -/* Values calculated from actual file */ - -long date,size,chsum; /* Date, size and checksum */ - - -/* File types within Newstar */ - -static char *ftyp[]={"SCN", "WMP","MDL", "NGF", "FLF", NULL}; -static char *fnam[]={"Scan","Map","Model","NGCALC","Flag",NULL}; - - -/* Function declarations */ - -int check_command(); -int get_root(); -char *swap_path(); -char *my_lower(); -char *my_upper(); -char *str_date(); - -int open_group(); -int next_group(); -int get_types(); -int check_type(); -int stat_out(); -int check_out(); -int import_out(); -int do_compare(); -int doc_extract(); -int start_mosaic(); -int show_size(); - -int convert_pin(); -int flush_latex(); -int flush_html(); -int flush_include(); -char *decode_data_type(); -char *to_latex(); -char *to_html(); -char *to_anchor(); - -void get_label(); -void put_label(); - - -main(argc,argv) - -int argc; -char **argv; - -{ - int code,iarg,is_group; - char *file; - - get_root(); - - if (argc<2) { - fprintf(stderr,"Syntax: %s command ...\n",argv[0]); - code = (-1); - } else { - code=check_command(argv[1],options); - } - - for (iarg=2; argc>iarg && *argv[iarg]=='-'; iarg++) { - if (*(argv[iarg]+1)=='t' || *(argv[iarg]+1)=='T') - get_types(argv[iarg]); - else if (*(argv[iarg]+1)=='c' || *(argv[iarg]+1)=='C') - test_cwd=1; - else if (*(argv[iarg]+1)=='i' || *(argv[iarg]+1)=='I') - test_include=1; - else fprintf(stderr,"Invalid switch %s, ignored\n",argv[iarg]); - } - - if (code==_FSTAT) { - - if (argc>iarg && *argv[iarg]=='+') strcpy(prefix,argv[iarg++]); - if (iarg<argc) { - is_group=0; - for (; iarg<argc; iarg++) { - if (*argv[iarg]=='@') { - if (*(argv[iarg]+1)=='\0') { - is_group=1; /* @ files ... -> rest all groupfiles */ - } else if (open_group(argv[iarg]+1)) { - while (group_next()) - if (check_type(fullname)) stat_out(fullname); - } - } else if (is_group) { - if (open_group(argv[iarg])) { - while (group_next()) - if (check_type(fullname)) stat_out(fullname); - } - } else { - if (check_type(argv[iarg])) stat_out(argv[iarg]); - } - } - } else { - while (scanf(" %s",line)==1) - if (check_type(line)) stat_out(line); - } - - - } else if (code==_MSTAT) { - mstat_out(argv[iarg]); - - } else if (code==_CHECK) { - while (iarg<argc) { - if (open_group(argv[iarg++])) { - while (group_next()) - if (check_type(fullname)) check_out(); - } - } - - } else if (code==_IMPORT) { - while (iarg<argc) { - if (open_group(argv[iarg++])) { - while (group_next()) - if (check_type(fullname)) import_out(); - } - } - - } else if (code==_EXPAND) { - while (iarg<argc) { - if (open_group(argv[iarg++])) { - while (group_next()) - if (check_type(fullname)) printf("%s %s \n",switches,fullname); - } - } - - } else if (code==_FILES) { - while (iarg<argc) { - if (open_group(argv[iarg++])) { - while (group_next()) - if (check_type(fullname)) printf("%s\n",filename); - } - } - - } else if (code==_SELECT) { - while (iarg<argc) { - if (open_group(argv[iarg++])) { - while (group_next()) - if (check_type(fullname)) printf("%s %ld\n",filename,grpdate); - } - } - - } else if (code==_COMPARE) { - do_compare(argv[iarg],argv[iarg+1]); - - } else if (code==_GROUP) { - while (iarg<argc) old_to_new(argv[iarg++]); - - } else if (code==_PSC) { - if (iarg<argc) expand_psc(argv[iarg]); - else fprintf(stderr,"Should give input psc-file\n"); - - } else if (code==_SPLIT) { - if (iarg+1<argc) new_to_old(argv[iarg],argv[iarg+1]); - else fprintf(stderr,"Should give input file and postfix\n"); - - } else if (code==_EXTRACT) { - while (iarg<argc) doc_extract(argv[iarg++]); - - } else if (code==_HYPER) { - if (iarg<argc) start_xmosaic(argv[iarg++]); - else start_xmosaic(""); - - } else if (code==_SIZE) { - if (iarg<argc) show_size(argv[iarg]); - else fprintf(stderr,"Should give input filename\n"); - - } else if (code==_KEYS) { - while (iarg<argc) convert_pin(argv[iarg++]); - - } else if (code==_LABEL) { -#ifdef wn_vx__ - fprintf(stderr,"Use MOUNT/FOR instead\n"); -#else - if (iarg<argc) get_label(argv[iarg]); - else fprintf(stderr,"Should give name of tapedevice\n"); -#endif - - } else if (code==_INIT) { -#ifdef wn_vx__ - fprintf(stderr,"Use INITIALISE instead\n"); -#else - if (iarg+1<argc) put_label(argv[iarg],argv[iarg+1]); - else fprintf(stderr,"Should give name of tapedevice and label\n"); -#endif - - } else { - - fprintf(stderr,"Invalid option; valid options are: \n"); - for (iarg=0; options[iarg]!=NULL; iarg++) - fprintf(stderr,"%s ",options[iarg]); - fprintf(stderr,"\n"); - exit(-1); - - } - - exit(0); -} - - -check_command(option,options) - -char *option,**options; - -{ - int ii; - - my_lower(option); - for (ii=0; options[ii]!=NULL && strcmp(option,options[ii]); ii++); - if (options[ii]==NULL) return(0); else return(ii+1); -} - - - -/****** Directory stuff ******************************/ - -get_root() - -{ - char *p; - - p=getenv(ROOT); - if (p==NULL) { - fprintf(stderr,"Getting upset: environment not setup...\n"); - exit(-1); - } - - x_root_len=strlen(p); - if (x_root_len>=MAX_STRING) { - fprintf(stderr,"%s translates to %s.\n",ROOT,p); - fprintf(stderr,"Too many characters in root directory...\n"); - exit(-1); - } - strcpy(x_root,p); - -#ifdef wn_vx__ - - p=getenv(ROOT_UC); - if (p==NULL) { - fprintf(stderr,"Getting upset: environment not setup...\n"); - exit(-1); - } - - vms_root_len=strlen(p) - 1; - if (vms_root_len>=MAX_STRING) { - fprintf(stderr,"%s translates to %s.\n","N_SRC",p); - fprintf(stderr,"Too many characters in VMS root directory...\n"); - exit(-1); - } - strcpy(vms_root,p); my_lower(vms_root); -#endif - - vax_style=(x_root[x_root_len-1]==']' || x_root[x_root_len-1]==':'); - - if (!vax_style && x_root[x_root_len-1]!='/') { - x_root[x_root_len++]='/'; x_root[x_root_len]='\0'; - } - - p=getenv(DOCDIR); - if (p==NULL) { - fprintf(stderr,"Getting upset: no hypertext directory...\n"); - exit(-1); - } - - d_root_len=strlen(p); - if (d_root_len>=MAX_STRING) { - fprintf(stderr,"%s translates to %s.\n",DOCDIR,p); - fprintf(stderr,"Too many characters in doc. directory...\n"); - exit(-1); - } - - strcpy(d_root,p); - - if (!vax_style && d_root[d_root_len-1]!='/') { - d_root[d_root_len++]='/'; d_root[d_root_len]='\0'; - } - -} - -/* - Translates pathspecifications from groupfiles to VMS style paths. - Prefixes should end with ] or :, if any directory stuff follows - the ] it is replaced by a ., any slashes are replaced by . : -*/ - -char *swap_path(string) - -char *string; - -{ - int dirspec=0,ii; - - if (vax_style) { /* Make VAX-style path */ - if (*string=='/') *string='['; - for (ii=strlen(string); ii>=0; ii--) { - if (string[ii]=='/') { - if (dirspec) { string[ii]='.'; } - else { string[ii]=']'; dirspec=1; } - } else if (string[ii]==']' && dirspec) { - string[ii]='.'; - } else if (string[ii]==':' && dirspec) { /* Need opening [ */ - strcpy(line,string+ii+1); /* So make space */ - strcpy(string+ii+2,line); - string[ii+1]=='['; /* and fill in */ - } - } - } -} - - -char *my_lower(string) - -char *string; - -{ - char *p; - for (p=string; *p!='\0'; p++) if (*p>='A' && *p<='Z') *p=(*p)-'A'+'a'; - return(string); -} - - -char *my_upper(string) - -char *string; - -{ - char *p; - for (p=string; *p!='\0'; p++) if (*p>='a' && *p<='z') *p=(*p)-'a'+'A'; - return(string); -} - - -char *str_date(sec_in) - -long sec_in; - -{ - static char date_str[10]=""; - - long secnds; - struct tm *tmb; - - if (sec_in==0L) time(&secnds); else secnds=sec_in; - tmb=localtime(&secnds); - sprintf(date_str,"%02d/%02d/%02d", - tmb->tm_mday,tmb->tm_mon+1,tmb->tm_year); - return(date_str); -} - - -/*+* - - Expand groupfiles - -*-*/ - -open_group(grpfile) - -char *grpfile; - -{ - int ii; - if (grp!=NULL) fclose(grp); - - grp=fopen(grpfile,"r"); - if (grp==NULL) { - fprintf(stderr,"Error: cannot open groupfile \"%s\".\n",grpfile); - return(0); - } - - strcpy(grpdir,grpfile); - for (ii=strlen(grpdir); - ii>=0 && grpdir[ii]!='/' && grpdir[ii]!=']' && grpdir[ii]!=':'; - ii--); - grpdir[ii+1]='\0'; - - return(1); -} - - -group_next() - -{ - int found=0,field; - char *p,*q; - - if (grp!=NULL) { - while (!found && fgets(line,MAX_STRING-1,grp)!=NULL) { - for (p=line; *p==' ' || *p=='\t'; p++); - for (q=p; *q!='!' && *q!='\n' && *q!='\0'; q++); - if (p!=q) found=1; /* We've got an entry */ - } - } - - if (!found) { - fclose(grp); grp=NULL; /* Must be end of file */ - - } else { - if (*q=='\0') *(q+1)='\0'; /* Already at end of line */ - *q='\0'; /* Strip comment and \n */ - my_lower(p); /* Lower case */ - - for (q=p; *q!=' ' && *q!='\t' && *q!='\0'; q++); - if (*q=='\0') q=NULL; else *q='\0'; /* Mark end of filename */ - - strcpy(orgname,p); - if (*p=='+') { - strcpy(fullname,x_root); strcat(fullname,p+1); - strcpy(filename,p+1); - } else { - strcpy(fullname,grpdir); strcat(fullname,p); - if ( strncmp(fullname,x_root,x_root_len) ) { - strcpy(filename,fullname); - } else { - strcpy(filename,fullname+x_root_len); - } - } - swap_path(filename); swap_path(fullname); - - switches[0]='\0'; - grpdate=grpsize=grpchsum=0L; - - /* Scan all remaining fields */ - - field=0; - - while (q!=NULL) { - for (p=q+1; *p==' ' || *p=='\t'; p++); - for (q=p; *q!=' ' && *q!='\t' && *q!='\0'; q++); - if (*q=='\0') q=NULL; else *q='\0'; - if (q!=p) { - if (*p=='-' || *p=='+') strcat(switches,p); - else if (field==0) { grpsize=atol(p); field++; } - else if (field==1) { grpchsum=atol(p); field++; } - else if (field==2) { grpdate=atol(p); field++; } - } - } - } - - return(found); -} - - -/* - Return val if switch not present - Return 1 if switch present and last occurence as -X - Return 0 if switch present and last occurence as -NX -*/ - -check_switch(sw,val) - -char sw; -int val; - -{ - char *p,sw2; - - if (sw>='a' && sw<='z') sw2=sw-'a'+'A'; else sw2='\n'; - - for (p=switches; *p!='\0'; p++) { - if (*p=='-' && (*(p+1)==sw || *(p+1)==sw2)) val=1; - else if (*p=='-' && (*(p+1)=='n' || *(p+1)=='N') - && (*(p+1)==sw || *(p+1)==sw2)) val=0; - } - - return(val); -} - - -/*+* - - Get string from switch (-t:....) which contains the types that - should be selected. The string has a list of valid types separated - by slashes, with wildcard . and optional "end mark" $. - If an item starts with a ^ it has to be ignored. - - Examples: f matches .f, .fsc, .for - f$ f.. matches .fsc, .for, but not .f - ^exe ignores .exe - -*-*/ - -get_types(argv) - -char *argv; - -{ - char *p; - for (p=argv; *p!='\0' && *p!=':'; p++); - if (*p!=':') strcpy(types,"."); else strcpy(types,my_lower(p+1)); -} - -check_type(file) - -char *file; - -{ - int ii,result,all_negate=1; - char *p,*q; - - for (ii=strlen(file); /* Find the extension */ - ii>0 && file[ii]!='.' && file[ii]!=']' && - file[ii]!='/'; ii--); - if (file[ii]!='.') return(0); /* Invalid or no extension */ - - for (p=types; *p!='\0'; p++) { - if (*p=='^') { result=0; p++; } else { result=1; all_negate=0; } - if (*p!='/' && *p!='\0') { /* Catch /^/ error */ - for (q=file+ii+1; - *p!='/' && *p!='\0' && *q!='\0' && ( (*p)==(*q) || *p=='.'); - q++,p++); - if (*p=='\0' || *p=='/' || (*q=='\0' && *p=='$') ) return(result); - while (*p!='\0' && *p!='/') p++; /* No match, get to next type */ - } - } - - return(all_negate); -} - -/*+ - - Utility program for Newstar: returns filename, checksum, size and date - for files given on the commandline or read from standard input. - - If the first argument starts with a dash, it is used as a prefix - for filenames. - - Output format (size in kbyte, checksum simple bytesum with overflow): - -filename____________ size____ chsum___ yymmdd - - -*-*/ - -static char *includes[128]={NULL}; -static int nname=0; - - -stat_out(file) - -char *file; - -{ - int ii,jj,ext; - FILE *fp; - char *p,*q; - - - get_stat(file); - - /* If the file roots in $n_src, replace n_src by a + */ - -#ifdef wn_vx__ - if ( !strncmp(file,vms_root,vms_root_len) ) { - for (ii=strlen(file); /* Find the ] */ - ii>0 && file[ii]!=']'; ii--); - if (file[ii]==']') file[ii]='/'; /* replace ] with / */ - printf("+%-20s %s",file+vms_root_len,switches); } -#else - if ( !strncmp(file,x_root,x_root_len) ) - printf("+%-20s %s",file+x_root_len,switches); -#endif - else printf("%s%-20s %s",prefix,file,switches); - - printf(" %8ld %8ld %6.6ld",size,chsum,date); - - - if (test_include) { - - nname=0; - - ii=0; - if (test_cwd) { - for (ii=strlen(file); - ii>=0 && file[ii]!='/' && file[ii]!=']' && file[ii]!=':'; ii--); - ii++; - } - - for (jj=strlen(file); jj>=0 && file[jj]!='.'; jj--); - jj++; - - if (file[jj]=='f') ext=1; /* Fortran source */ - else if (file[jj]=='c') ext=2; /* C source */ - else if (file[jj]=='p') ext=3; /* pin/pef/psc */ - else if (!strncmp(file+jj,"dsf",3) || - !strncmp(file+jj,"dsc",3)) ext=4; /* WNB includes */ - else ext=0; - - if (ext) { - - printf(" ! "); - fp=fopen(file+ii,"r"); - if (fp!=NULL) { - while (fgets(line,MAX_STRING-1,fp)!=NULL) { - - if (ext==1) { - for (p=line; *p==' ' || *p=='\t'; p++); - if ( (*p=='i' || *p=='I') && - (*(p+3)=='L' || *(p+3)=='l') ) { - my_lower(line); - if (!strncmp(p,"include",7)) { - for (p+=7; *p!='\'' && *p!='\0'; p++); - if (*p=='\'') { - for (q=p+1; *q!='\'' && *q!='\0'; q++); - if (*q=='\'') { - *q='\0'; - while (q!=p && *q!='_') q--; - if (*q=='_') *q='.'; - add_include(p+1); - } else { - fprintf(stderr,"Error: %s",line); - } - } else { - fprintf(stderr,"Error: %s",line); - } - } - } - - } else if (ext==2) { - for (p=line; *p==' ' || *p=='\t'; p++); - if (*p=='#') { - for (p++; *p==' ' || *p=='\t'; p++); - if (!strncmp(p,"include",7)) { - for (p+=7; *p!='\"' && *p!='<' && *p!='\0'; p++); - if (*p=='\"') { - for (q=p+1; *q!='\"' && *q!='\0'; q++); - if (*q=='\"') { - *q='\0'; - while (q!=p && *q!='_') q--; - if (*q=='_') *q='.'; - add_include(p+1); - } else { - fprintf(stderr,"Error: %s",line); - } - } else if (*p!='<') { - fprintf(stderr,"Error: %s",line); - } - } - } - - } else if (ext==3) { - for (p=line; *p==' ' || *p=='\t'; p++); - if ( (*p=='i' || *p=='I') && - (*(p+3)=='L' || *(p+3)=='l') ) { - my_lower(line); - if (!strncmp(p,"include=",8)) { - for (p+=8; *p==' ' || *p=='\t'; p++); - if (*p!='\0') { - for (q=p; *q!='\n' && *q!='\0'; q++); - *q='\0'; - while (q!=p && *q!='_') q--; - if (*q=='_') *q='.'; - add_include(p); - } else { - fprintf(stderr,"Error: %s",line); - } - } - } - } else if (ext==4) { - for (p=line; *p==' ' || *p=='\t'; p++); - if (*p=='%') { - my_lower(line); - if (!strncmp(p,"%include=",9)) { - for (p+=9; *p==' ' || *p=='\t'; p++); - if (*p!='\0') { - for (q=p; *q!='\n' && *q!='\0'; q++); - *q='\0'; - while (q!=p && *q!='_') q--; - if (*q=='_') *q='.'; - add_include(p); - } else { - fprintf(stderr,"Error: %s",line); - } - } - } - } - } - fclose(fp); - - for (ii=0; ii<nname; ii++) { - printf("@%s ",includes[ii]); - free(includes[ii]); - } - } - } - } - - printf("\n"); -} - - -add_include(name) - -char *name; - -{ - int ii; - for (ii=0; ii<nname && strcmp(includes[ii],name); ii++); - if (ii==nname) { - if (nname==128) { - fprintf(stderr,"Too many includes...\n"); exit(-1); - } - includes[nname]=(char *)malloc(strlen(name)+1); - strcpy(includes[nname],name); - nname++; - } -} - - -mstat_out(file) - -char *file; - -{ - int ll; - - get_stat(file); - - /* If the file roots in $n_src, replace n_src by a + */ - - if ( !strncmp(file,x_root,x_root_len) ) { - file[0]='+'; strcpy(file+1,file+x_root_len); - } - - /* copy stdin to stdout and replace matching lines */ - - ll=strlen(file); - - while (fgets(line,MAX_STRING,stdin)!=NULL) { - if (strncmp(line,file,ll)) printf("%s",line); - else printf("%-20s %8ld %8ld %6.6ld %s",file,size,chsum,date,switches); - } -} - - -check_out() - -{ - long adate,agrpdate; - - if (strcmp(filename,"sys/database.idx") && - strcmp(filename,"sys/lock.idx") ) { - - get_stat(fullname); - adate=date; if (date<800000) adate=1000000+date; - agrpdate=grpdate; if (grpdate<800000) agrpdate=1000000+grpdate; - - if ( (grpsize >0L && size != grpsize) || - (grpchsum>0L && chsum != grpchsum) || - (grpdate >0L && adate < agrpdate) || - (size == 0L && chsum == 0L && date == 0L) ) { - - /* If the file roots in $n_src, replace n_src by a + */ - if ( !strncmp(fullname,x_root,x_root_len) ) - printf("+%-20s",fullname+x_root_len); - else printf("%-20s",fullname); - - printf(" %8ld %8ld %6.6ld %s ! %8ld %8ld %6.6ld\n", - grpsize,grpchsum,grpdate,switches,size,chsum,date); - } - } -} - - -import_out() - -{ - int ii; - - if (strcmp(filename,"sys/database.idx")) { - - for (ii=strlen(filename); /* Strip filename */ - ii>=0 && filename[ii]!='/' && filename[ii]!=']' && filename[ii]!=':'; - ii--); - ii++; - - if (!check_switch('r',1)) { - fprintf(stderr,"File %s needs not be retrieved.\n",filename+ii); - } else { - get_stat(fullname); - - if (test_include) { - if (check_switch('b',0)) printf("binary\n"); else printf("ascii\n"); - printf("get %s\n",filename+ii); - - } else if ( (grpsize >0L && size != grpsize) || - (grpchsum>0L && chsum != grpchsum) || - (grpdate >0L && date < grpdate) || size==0L) { - - if (check_switch('b',0)) printf("binary\n"); else printf("ascii\n"); - printf("get %s %s\n",filename,filename+ii); - - } else { - fprintf(stderr,"File %s seems to be correct already.\n",filename+ii); - } - } - } -} - - - -get_stat(file) - -char *file; - -{ - int ii,rr; - long ltime,vmscnt; - FILE *fp; - - struct stat fst; - struct tm *tmb; - - chsum=size=date=vmscnt=0L; - - /* If file should be tested in cwd, strip the filename */ - - ii=0; - if (test_cwd) { - for (ii=strlen(file); - ii>=0 && file[ii]!='/' && file[ii]!=']' && file[ii]!=':'; ii--); - ii++; - } - - /* Get checksum from byte count */ - - fp=fopen(file+ii,"r"); - if (fp!=NULL) { - while ( (rr=fread(bbuf,sizeof(char),512,fp)) > 0 ) { - vmscnt+=rr; - while (--rr>=0) chsum+=(long)bbuf[rr]; - } - if (chsum<0L) chsum= -1*chsum; /* In case of overflow */ - fclose(fp); - } - - /* Stat the file and get size and revision date */ - - if (!stat(file+ii,&fst)) { - size=fst.st_size; ltime=fst.st_mtime; - tmb=localtime(<ime); - date=(long)(tmb->tm_mday+100*(tmb->tm_mon+1))+ - 10000L*(long)(tmb->tm_year%100); -#ifdef wn_vx__ - size=vmscnt; -#endif - } -} - -/* - Return 0 if executable or library for architecture not in wanted -*/ - -static int requested(line,wanted) - -char *line,*wanted; - -{ - char *p,*q; - - if (wanted==NULL) return(1); - - for (p=line; *p!='.' && *p!='!' && *p!='\0'; p++); - if (*p!='.' || (*(p+1)!='x' && *(p+1)!='a') ) { - return(1); /* Not exe, not lib */ - } else { - q=wanted; - p+=2; - while (*q!='\0') { - if (*q == *p && *(q+1) == *(p+1)) return(1); /* We want it */ - while (*q!='\0' && *q!=' ' && *q!=',' && *q!='/') q++; - while ( *q==' ' || *q==',' || *q=='/') q++; - } - } - - return(0); /* We do not want it, or we would have returned earlier */ -} - - - -/*+* - - Compare two groupfiles (typically master indices) - -*-*/ - -do_compare(file1,file2) - -char *file1,*file2; - -{ - FILE *fp; - int found=0,field; - char *p,*q,*wanted; - - if (!open_group(file1)) exit(-1); - -#ifdef wn_vx__ - wanted=getenv("N_INSTALL"); -#else - wanted=getenv("n_install"); -#endif - fp=fopen(file2,"r"); - if (fp==NULL) { - fprintf(stderr,"Cannot open second input groupfile (%s)...\n",file2); - fprintf(stderr,"First input file copied to stdout.\n"); - printf("! Blind copy of %s\n",file1); - while (fgets(line,MAX_STRING-1,grp)!=NULL) - if (requested(line,wanted)) printf("%s",line); - fclose(grp); grp=NULL; - - } else { - printf("! Groupfile for update based on database comparison.\n"); - printf("! Local: %s\n! Remote: %s\n! \n",file2,file1); - while (group_next()) { - - if (check_type(orgname) && requested(orgname,wanted)) { - rewind(fp); found=0; date=size=chsum=0L; - - while (!found && fgets(line,MAX_STRING-1,fp)!=NULL) { - for (p=line; *p==' ' || *p=='\t'; p++); - for (q=p; *q!='!' && *q!='\n' && *q!='\0' && - *q!=' ' && *q!='\t'; q++); - if (p!=q) { - *q='\0'; my_lower(p); /* Mark end of filename */ - found=(!strcmp(p,orgname)); /* We've got found the entry */ - } - } - - if (found) { - field=0; /* Scan all remaining fields */ - while (q!=NULL) { - for (p=q+1; *p==' ' || *p=='\t'; p++); - for (q=p; *q!=' ' && *q!='\t' && *q!='\0'; q++); - if (*q=='\0') q=NULL; else *q='\0'; - if (q!=p && *p!='-' && *p!='+') { - if (field==0) { size=atol(p); field++; } - else if (field==1) { chsum=atol(p); field++; } - else if (field==2) { date=atol(p); field++; } - } - } - } - -/* - Select if - not found (and existing on remote node: grpsize!=0) - - older than file at remote node (or no date defined) and - uneqal size or unequal checksum -*/ - - if ( (!found && grpsize!=0L) || - ( (date<=0L || grpdate<=0L || date<=grpdate) && - ( (grpsize != 0L && size != grpsize) || - (grpchsum != 0L && chsum !=grpchsum) ) ) ) { - printf("%-20s %8ld %8ld %6.6ld %s ! %8ld %8ld %6.6ld\n", - orgname,grpsize,grpchsum,grpdate,switches,size,chsum,date); - } - } - } - } -} - - - -/* - Expand psc file -*/ - -expand_psc(file) - -char *file; - -{ - FILE *fp,*fp2; - char *p,*q,list[MAX_STRING]; - int ii,do_key; - - fp=fopen(file,"r"); - if (fp==NULL) { - fprintf(stderr,"Cannot open input %s\n",file); return(0); - } - -/* - Expect INCLUDE= and KEYWORD= lines at start of line -*/ - while (fgets(line,MAX_STRING,fp)!=NULL) { - for (p=line; *p==' ' || *p=='\t'; p++); - strncpy(buf,p,8); buf[8]='\0'; my_lower(buf); -/* - Normal line, just copy -*/ - if (strncmp(buf,"include=",8)) { - printf("%s",line); -/* - Include keyword found, open included file and copy relevant keywords -*/ - } else { - - printf("!>>>>> %s",line); -/* - Split off comments -*/ - for (p+=8; *p==' ' || *p=='\t'; p++); - for (q=p; *q!=' ' && *q!='\t' && *q!='!' && - *q!='\n' && *q!='\0'; q++); - *q='\0'; - my_lower(p); -/* - Separate filename and keyword list (INCLUDE=xxx_PEF:Key,Key) -*/ - for (ii=strlen(p); ii>0 && p[ii]!=':'; ii--); - if (ii!=0) { - p[ii]='\0'; - strcpy(list,p+ii+1); - } - - if (strcmp(p+strlen(p)-4,"_pef")) { - fprintf(stderr,"Invalid include: %s\n",p); - } else { - p[strlen(p)-4]='.'; - strcpy(buf,p); -#ifdef wn_vx__ - sprintf(buf,"%s%s",getenv("N_UINC"),p); -#else - sprintf(buf,"%s/%s",getenv("n_uinc"),p); -#endif - fp2=fopen(buf,"r"); - if (fp2==NULL) { -#ifdef wn_vx__ - sprintf(buf,"%s%s",getenv("N_INC"),p); -#else - sprintf(buf,"%s/%s",getenv("n_inc"),p); -#endif - fp2=fopen(buf,"r"); - } - if (fp2==NULL) { - fprintf(stderr,"Cannot find include file: %s\n",p); -/* - Read include file, copy all keywords -*/ - } else if (ii==0) { - while (fgets(line,MAX_STRING,fp2)!=NULL) printf("%s",line); - fclose(fp2); -/* - Read include file, copy keywords in list only -*/ - } else { - do_key=0; - while (fgets(line,MAX_STRING,fp2)!=NULL) { - for (p=line; *p==' ' || *p=='\t'; p++); - strncpy(buf,p,8); buf[8]='\0'; my_lower(buf); -/* - Found keyword -*/ - if (!strncmp(buf,"keyword=",8)) { -/* - Strip comments -*/ - for (p+=8; *p==' ' || *p=='\t'; p++); - strcpy(buf,p); - for (q=buf; *q!=' ' && *q!='\t' && *q!='!' && - *q!='\n' && *q!='\0'; q++); - *q='\0'; - my_lower(buf); -/* - Check if in list -*/ - q=list; - do_key=0; - while (!do_key && *q!='\0') { - for (ii=0; q[ii]!='\0' && q[ii]!=','; ii++); - do_key=(ii==strlen(buf) && !strncmp(buf,q,ii)); - q+=ii; if (*q==',') q++; - } - } -/* - If keyword in list, copy all lines (until next keyword) -*/ - if (do_key) printf("%s",line); - } - - fclose(fp2); - } - } - } - } - - fclose(fp); -} - -/* - Two options that will become obsolete soon -*/ - -old_to_new(file) - -char *file; - -{ - FILE *fp; - char *p,*q,*r,*flag; - int ii,sp; - - fp=fopen(file,"r"); - if (fp==NULL) { - fprintf(stderr,"Cannot open input %s\n",file); return(0); - } - -/* - Split of prefix which determines the directory -*/ - my_lower(file); - for (ii=strlen(file); ii>0 && file[ii]!='/'; ii--); - if (file[ii]=='/') ii++; - for (p=file+ii; *p>='a' && *p<='z'; p++); *p='\0'; - - while (fgets(line,MAX_STRING-1,fp)!=NULL) { - for (p=line; *p==' ' || *p=='\t'; p++); - for (q=p; *q!='$' && *q!='#' && *q!='!' && *q!='\n' && *q!='\0'; q++); - if (p!=q) { /* We've got an entry */ - for (r=p; *r!='.' && r<q; r++); - if (*r=='.' && (*(r+1)=='a' || *(r+1)=='A' || - *(r+1)=='X' || *(r+1)=='x') ) flag="-B"; else flag=""; - for (sp=0,q=p; *q!='!' && *q!='\n' && *q!='\0'; q++) { - if (*q=='-') sp=1; - else if (*q==' ' || *q=='\t' || *q=='!') sp=0; - if (sp && *q!='!' && *q!='\n' && *q!='\0') *q=' '; - } - if (*q=='!') { - *q='\0'; printf("+%s/%s %s !%s\n",file+ii,p,flag,q+1); - } else { - *q='\0'; printf("+%s/%s %s\n",file+ii,p,flag); - } - } else if (*p=='!') { /* Comment */ - printf("%s",p); - } else { /* Command */ - if (!strncmp(p,"$$nc$ ncomp ",12)) { - while (*q!='\n' && *q!='\0') q++; *q='\0'; - printf("+%s/%s -NR \n",p+12); - } else { - printf("!!! %s",p); - } - } - } - - fclose(fp); -} - - -/* No advanced things! */ - -new_to_old(file,post) - -char *file,*post; - -{ - FILE *fp,*fp2; - char *p,*q,*r; - char cmt[MAX_STRING][25],savfile[MAX_STRING]; - int ncmt=0,icmt; - - fp=fopen(file,"r"); - if (fp==NULL) { - fprintf(stderr,"Cannot open input %s\n",file); return(0); - } - fp2=NULL; - savfile[0]='\0'; - - while (fgets(line,MAX_STRING-1,fp)!=NULL) { - for (p=line; *p==' ' || *p=='\t'; p++); - for (q=p; *q!='!' && *q!='\n' && *q!='\0'; q++); - if (p!=q) { /* We've got an entry */ - for (r=p; *r!='.' && *r!='\0'; r++); /* Find extension */ - for (q=p; *q!='/' && *q!=' ' && *q!='\0' && *q!='\n'; q++); - if (*p!='+' && !strncmp(r,".EXE",4)) { - fprintf(fp2,"%s",p); - } else if (*p!='+' || *q!='/') { - fprintf(stderr,"Illegal entry: %s",p); - } else { - *q='\0'; - sprintf(filename,"%s%s.grp",p+1,post); - if (strcmp(filename,savfile)) { /* New file */ - strcpy(savfile,filename); - if (fp2!=NULL) fclose(fp2); - fp2=fopen(filename,"r"); - if (fp2==NULL) { - fp2=fopen(filename,"w"); - fprintf(fp2,"!%s created from %s\n",filename,file); - for (icmt=0; icmt<ncmt; icmt++) fprintf(fp2,"%s",cmt[icmt]); - } - if (fp2!=NULL) { - fclose(fp2); - fp2=fopen(filename,"a"); - } - if (fp2==NULL) { - fprintf(stderr,"Cannot open output file %s\n",filename); - fclose(fp); - return(0); - } - } - for (p=q+1; *p!='\t' && *p!=' ' && *p!='\n' && *p!='\0'; p++); - if (*p==' ' || *p=='\t') { - *p='\0'; fprintf(fp2,"%s ! %s",q+1,p+1); - } else { - fprintf(fp2,"%s",q+1); - } - } - } else if (*q=='!') { - if (fp2!=NULL) fprintf(fp2,"%s",q); - else if (ncmt<25) strcpy(cmt[ncmt++],q); - } - } - - fclose(fp); - if (fp2!=NULL) fclose(fp2); - -} - -/* - Extract documentation from source files. - -Taken from pager.c, without all editing options apart from: - - {+} Switch output on (if -d on commandline) - {-} Switch output off (if -d on commandline) - -The closing brace is optional in all commands. Commands are case -insensitive, and only the first character after the brace is necessary. -You may include commands in Fortran of C-type comments. -In ordinary text files, enclose a command in braces: {+} {-} -In Fortran source files, start a command with C*, eg C*+, C*-. -Also allowed are: C+, C- -In C source files, include the command between slash-star and star-slash. -The closing slash-star is optional for docaid, but not for the compiler! -In Unix C-shell scripts, start the command with a #* -In DCL command files, start the command with a !* - -If a line starts with minus-star-slash, this is handled as a {-} command. -If a line starts with #- or #+, this is handles as a {+} or {-} command. - -Lines are detabbed with a tabstep of 8 spaces. - -*/ - -#define TABSTEP 8 - -doc_extract(file) - -char *file; - -{ - FILE *fp; - int doc,nskip,iskip,ii; - char precmd,*p; - - fp=fopen(file,"r"); - if (fp==NULL) { - fprintf(stderr,"\nError: cannot open %s...\n",file); - return(0); - } - -/* - Prescan to see if there is any documentation at all -*/ - doc=0; - while (!doc && fgets(line,130,fp)!=NULL) { - - if ( (line[0]=='{' && line[1]=='+' ) || - ( (line[0]=='C' || line[0]=='c' || line[0]=='/' || - line[0]=='#' || line[0]=='!') - && line[1]=='*' && line[2]=='+') || - (line[0]=='$' && line[1]=='!' && - line[2]=='*' && line[3]=='+') || - ( (line[0]=='C' || line[0]=='c' || - line[0]=='#' || line[0]=='!') && line[1]=='+') ) doc=1; - } - -/* - Rewind and do the real work -*/ - if (doc) { - - rewind(fp); - - printf(">>>>> %-50.50s >>>>>\n\n",file); - - doc=0; precmd=' '; nskip=999; - - while (fgets(line,130,fp)!=NULL) { - - p=NULL; - if (line[0]=='{') { - precmd='{'; p=line+1; - } else if ( (line[0]=='C' || line[0]=='c' || line[0]=='/' || - line[0]=='#' || line[0]=='!') - && line[1]=='*') { - precmd=line[0]; p=line+2; - } else if (line[0]=='$' && line[1]=='!' && line[2]=='*') { - precmd='!'; p=line+3; - } else if ((line[0]=='C' || line[0]=='c' || - line[0]=='#' || line[0]=='!') && - (line[1]=='+' || line[1]=='-')) { - precmd=line[0]; p=line+1; - } else if (line[0]=='*' && line[1]=='-' && - line[2]=='*' && line[3]=='/') { - precmd='/'; p=line+1; - } else if (line[0]=='-' && line[1]=='*' && line[2]=='/') { - precmd='/'; p=line; - } - - if (p!=NULL && *p=='+') { - doc=1; - } else if (p!=NULL && *p=='-') { - doc=0; - } else if (doc) { -/* - Expand all tabs in the line -*/ - - strcpy(buf,line); - for (ii=0,p=buf; *p!='\0'; p++) { - if (*p == '\t') { - line[ii++]=' '; - while ( (ii%TABSTEP)!=0 ) line[ii++]=' '; - } else { - line[ii++]=(*p); - } - } - line[ii]='\0'; - -/* - If we have a block starting with the command prefix, remove that prefix. - Also remove the Fortran comment statements -*/ - if (line[0]==precmd || - ( (line[0]=='C' || line[0]=='c') && - (line[1]==' ' || line[1]=='\t') ) ) { - line[0]=' '; - for (iskip=0; - iskip<nskip && (line[iskip]==' ' || line[iskip]=='\t'); - iskip++); - if (nskip==999) nskip=iskip; - } else { - iskip=0; - } - printf("%s",line+iskip); - } - } - - printf("\n<<<<< %-50.50s <<<<<\n",file); - } - - fclose(fp); -} - - -start_xmosaic(home_page) - -char *home_page; - -{ -#ifdef wn_vx__ - printf("Cannot use xmosaic on the VAX\n"); - return(-1); -#else - static char page[MAX_STRING],*args[]={"xmosaic",page,NULL}; - - int pid=0,ii,start_new,l1,l2; - FILE *fp; - - strcpy(page,home_page); - strcpy(buf,getenv("DISPLAY")); - -/* - Construct the name of the xmosaic interface file -*/ - strcpy(line,"/tmp/xm-"); - for (ii=0; ii<100 && buf[ii]!='\0'; ii++) - if (buf[ii]==':') line[8+ii]='.'; else line[8+ii]=buf[ii]; - line[8+ii]='\0'; - - pid=fork(); - if (pid==0) { /* We are the child process now */ - freopen("/dev/null","w",stderr); - sprintf(buf,"%s/xmosaic.exe",getenv("n_exe")); - if (execv(buf,args)==(-1)) { - printf("Error starting xmosaic...\n"); - unlink(line); - exit(-1); - } - } else { -/* - Save pid in file for future calls -*/ - fp=fopen(line,"w"); - if (fp!=NULL) { - fprintf(fp,"%d\n",pid); - fclose(fp); - } - } - - return(pid); -#endif -} - - - -show_size(file) - -char *file; - -{ - struct stat fst; - - /* Stat the file and get size */ - - if (!stat(file,&fst)) printf("%ld\n",fst.st_size); - else printf("-1\n"); -} - - -/* - This is the routine to convert a pin-file to something - readable and printable. - - It used to be in docaid, but I put it here when JPH revised - the documentations-system. Only hypertext files are being - written now. - -*/ - - -static char *valkey[]={"include", - "keyword","prompt","options","defaults","help", - "data_type","length","units","switches", - "nvalues","min_nvalues","max_nvalues", - "checks","minimum","maximum", - "io","max_nsets","attributes","search",NULL}; - -static char name[32]="",key[32]=""; /* Name of the keyword */ -static char prompt[MAX_STRING+1]=""; /* Prompt string */ -static char deflt[MAX_STRING+1]=""; /* Default values */ -static char units[MAX_STRING+1]=""; /* Units for input */ -static char switcher[MAX_STRING+1]=""; /* Allowed switches */ -static char help[MAX_BUF]=""; /* Help text */ -static int input_len=0; /* Length of input */ -static char data_type=' '; /* Expected input */ -static int nval,min_nval,max_nval; /* Number of values */ -static double val_min,val_max; /* Range */ - -static FILE *ppp,*kindex,*html; -static char pppname[MAX_STRING]=""; -static char PPPname[MAX_STRING]=""; -static int do_pef=0; - - -convert_pin(file) - -char *file; - -{ - int ii,jj,found; - - char *p,*q; - -/* - Open the input file, get the filename in ppdname and PPDname (uppercase) -*/ - ppp=fopen(file,"r"); - if (ppp==NULL) { - fprintf(stderr,"Error: cannot open file \"%s\".\n",file); - return(0); - } - - for (ii=strlen(file); ii>=0 && file[ii]!='.'; ii--); - do_pef=(!strncmp(file+ii,".pef",4)); - - for (jj=strlen(file); jj>=0 && file[jj]!='/' && file[jj]!=']' && - file[jj]!=':'; jj--); - if (jj!=0) jj++; - strncpy(pppname,file+jj,(ii-jj)); pppname[ii-jj]='\0'; - strcpy(PPPname,pppname); my_upper(PPPname); - - fprintf(stderr,"Translating %s (%s) to html document.\n",file,PPPname); - -/* - Open and initialise the html index file -*/ - sprintf(line,"%s%s",d_root,pppname); - mkdir(line,0777); - - if (do_pef) { - sprintf(line,"%s%s_comm",d_root,pppname); - mkdir(line,0777); - sprintf(line,"%s%s_comm/%s_comm.html",d_root,pppname,pppname); - } else { - sprintf(line,"%s%s_keys",d_root,pppname); - mkdir(line,0777); - sprintf(line,"%s%s_keys/%s_keys.html",d_root,pppname,pppname); - } - kindex=fopen(line,"w"); - if (kindex==NULL) { - fprintf(stderr,"\nError: cannot open output file %s\n",line); - fclose(ppp); return(-1); - } - - if (do_pef) { - fprintf(kindex, - "<TITLE>Index of general keywords from %s</TITLE>\n",PPPname); - fprintf(kindex, - "<H1>Description of general keywords (%s)</H1>\n\n<UL>\n",PPPname); - } else { - fprintf(kindex, - "<TITLE>Index of private keywords for %s </TITLE>\n",PPPname); - fprintf(kindex, - "<H1>Description of keywords for program %s</H1>\n\n<UL>\n",PPPname); - } - - -/* - Scan the input file to find the next keyword. - If a KEYWORD= entry is found and we have something in our - buffers, flush them. -*/ - - found=0; - - while (fgets(line,MAX_STRING,ppp)!=NULL) { - for (p=line; *p==' ' || *p=='\t'; p++); /* Start of line */ - for (q=p; *q!='!' && *q!='\n' && *q!='\0'; q++); /* End of line */ - if (q!=p) { - while (*(q-1)==' ' || *(q-1)=='\t') q--; /* Skip trailing spaces */ - *q='\0'; /* Strip comment */ - for (q=p; *q!='=' && *q!='\0'; q++); /* Find keyword */ - if (*q!='=') { - fprintf(stderr,"Isolated line: %s\n",p); - } else { /* Match keyword */ - *q='\0'; q++; - my_lower(p); jj=strlen(p); - for (ii=0; valkey[ii]!=NULL && strncmp(p,valkey[ii],jj); ii++); - if (valkey[ii]==NULL) { - fprintf(stderr,"Invalid keyword: %s\n",p); - } else { - ii--; - if (ii==-1) { /* INCLUDE= */ - if (found>0) flush_html(); /* Pending output*/ - flush_include(q,found); - found=(-1); - - } else if (ii==0) { /* KEYWORD= */ - if (found>0) { /* Pending output*/ - flush_html(); - found=0; - } else if (found<0) { /* Space after include */ - fprintf(kindex,"<P>"); - } - - found=1; /* Found key */ - strcpy(name,q); - prompt[0]=help[0]=units[0]=deflt[0]=switcher[0]='\0'; - data_type='?'; input_len=0; - nval=min_nval=max_nval=(-1); - val_min=(-12345.00); val_max=(-12345.0); - - } else if (ii==1) { /* PROMPT= */ - get_continuation(prompt,q,0); - - } else if (ii==2) { /* OPTIONS= */ - get_continuation(prompt,q,0); - - } else if (ii==3) { /* DEFAULT= */ - get_continuation(deflt,q,0); - - } else if (ii==4) { /* HELP= */ - get_continuation(help,q,1); - - } else if (ii==5) { /* DATA_TYPE= */ - data_type=(*q); - - } else if (ii==6) { /* LENGTH= */ - input_len=atoi(q); - - } else if (ii==7) { /* UNITS= */ - get_continuation(units,q,0); - - } else if (ii==8) { /* SWITCHES= */ - get_continuation(switcher,q,0); - - } else if (ii==9) { /* NVALUES= */ - nval=atoi(q); - - } else if (ii==10) { /* MIN_NVALUE= */ - min_nval=atoi(q); - - } else if (ii==11) { /* MAX_NVALUE= */ - max_nval=atoi(q); - - } else if (ii==12) { /* CHECKS= */ - - } else if (ii==13) { /* MINIMUM= */ - val_min=atof(q); - - } else if (ii==14) { /* MAXIMUM= */ - val_max=atof(q); - - } - } - } - } - } - - if (found>0) flush_html(kindex); - - fclose(ppp); - -/* - Finish and close HTML file -*/ - fprintf(kindex,"</UL>\n\n"); - fprintf(kindex,"\n <H3> More information: </H3> <UL>\n"); - fprintf(kindex, - "<LI><A HREF=\"../homepage.html\">NEWSTAR Documentation Home page</A>\n"); - fprintf(kindex, - "<LI><A HREF=\"../hb_contents/hb_contents.html\">The NEWSTAR Cookbook</A>\n"); - if (!do_pef) { - fprintf(kindex, - "<LI>Description of <A HREF=\"../%s_descr/%s_descr.html\">program %s</A>\n", - pppname,pppname,PPPname); - } - - fprintf(kindex,"</UL>\n"); - fclose(kindex); - -} - -char *decode_data_type(data_type) - -char data_type; - -{ - static char tmp[2]="?"; - - if (data_type>='a' && data_type<='z') data_type+=('A'-'a'); - - if (data_type=='C') return("Character"); - else if (data_type=='R') return("Real number"); - else if (data_type=='D') return("Double precision number"); - else if (data_type=='J') return("Integer number"); - else if (data_type=='L') return("Logical"); - - tmp[0]=data_type; - return(tmp); -} - - -get_continuation(string,first,long_string) - -char *string,*first; -int long_string; - -{ - char *p,*q,*nl="\n"; - int max,cnt,done; - - if (long_string) max=MAX_BUF; else max=MAX_STRING; - - if (*string!='\0') strcat(string," "); - - if (*first=='\0') { - fgets(line,MAX_STRING,ppp); - first=line; - } - - if (*first=='"') { - if (strlen(string)+strlen(first)<max) { - strcat(string,first+1); cnt=strlen(string); - } - - done=0; - for (q=first+1; !done && *q!='\0'; q++) { - if (*q=='"') { - for (p=q+1; *p==' ' || *p=='\t'; p++); - done=(*p=='\0' || *p=='\n'); - } - } - *q='\0'; - - while (!done) { - fgets(line,MAX_STRING,ppp); - for (q=line; !done && *q!='\0' && *q!='\n'; q++) { - if (*q=='"') { - for (p=q+1; *p==' ' || *p=='\t'; p++); - done=(*p=='\0' || *p=='\n'); - } - } - - if (!done) while (*(q-1)==' ' || *(q-1)=='\t') q--; - *q='\0'; - - if (cnt+strlen(line)<max) { - if (cnt>0) { strcpy(string+cnt,nl); cnt++; } - strcpy(string+cnt,line); - cnt+=strlen(line); - } - } - if (string[cnt-1]=='"') string[cnt-1]='\0'; - - } else { - if (strlen(string)+strlen(first)<max) { - strcat(string,first); cnt=strlen(string); - } - for (q=string; *q!='\0' && *q!='!'; q++); *q='\0'; - while (*(q-1)=='-') { - *(q-1)='\0'; - fgets(line,MAX_STRING,ppp); - for (q=line; *q!='\0' && *q!='\n' && *q!='!'; q++); *q='\0'; - if (cnt+strlen(line)<max) { - strcat(string,line); cnt=strlen(string); - } - } - } - string[cnt]='\0'; -} - - -flush_html() - -{ - int first,ii,jj; - char *p,*q,*r,file[MAX_STRING],tmp[4]; - - strcpy(key,name); my_lower(key); - sprintf(file,"%s/%s/%s__%s.html",d_root,pppname,pppname,key); - - fprintf(kindex,"<LI> <A HREF=\"../%s/%s__%s.html\">\n %s</A>\n", - pppname,pppname,key,to_html(name)); - fprintf(kindex," %s\n",to_html(prompt)); - - html=fopen(file,"w"); - if (html==NULL) { - fprintf(stderr,"Cannot open %s\n",file); - return(0); - } - - fprintf(html,"<TITLE>Description of %s (%s)</TITLE>\n",name,PPPname); - if (do_pef) - fprintf(html,"<H1>Description of general keyword %s</H1>\n",name); - else fprintf(html,"<H1>Program %s: private keyword %s</H1> \n",PPPname,name); - - fprintf(html,"\n<DT><EM>Prompt:</EM> %s\n",to_html(prompt)); - - if (*deflt!='\0') { - fprintf(html,"<DT><EM>Default:</EM> %s",to_html(deflt)); - if (*units!='\0') fprintf(html," %s",to_html(units)); - fprintf(html,".\n"); - } - - fprintf(html,"<DT><EM>Expected input:</EM> %s",decode_data_type(data_type)); - if (data_type=='C') fprintf(html,"(%d)",input_len); - if (*units!='\0') fprintf(html," in %s",to_html(units)); - if (nval>0) fprintf(html,", %d values",nval); - else if (nval==1) fprintf(html,", single value"); - if (min_nval>0) fprintf(html,", min: %d",min_nval); - if (max_nval>0) fprintf(html,", max: %d",max_nval); - if (val_min!=-12345.0) fprintf(html,"; min.value: %f",val_min); - if (val_max!=-12345.0) fprintf(html,"; max.value: %f",val_max); - fprintf(html,".<P>\n"); - - first=0; - strcpy(buf,help); - for (p=q=buf; *q!='\0'; q++) { - if (*q=='\n') { - if (*(q+1) == '.' && *(q+2) == '\n') { - *q='\0'; fprintf(html,"%s <P>\n",to_html(p)); - q+=2; - } else if (*(q+1) == '\n') { - *q='\0'; fprintf(html,"%s <P>\n",to_html(p)); - q++; - } else { - *q='\0'; fprintf(html,"%s \n",to_html(p)); - } - p=q+1; first=1; - for (r=p; *r==' ' || *r=='\t'; r++); - while (*r!='\0' && *r!='\n' && *r!='\t' && *r!=' ') r++; - if (*r=='\t') { /* We find <whitespace>XXXX<tab>text */ - *r='\0'; - fprintf(html,"<DT><STRONG>%s</STRONG> ",to_html(p)); - p=r+1; while (*p=='\t') p++; - q=p-1; - first=0; - } - } else if (first && *q=='-') { - fprintf(html,"\n<DT>"); first=0; - } else if (!strncmp(q,"\\ref{",5)) { - *q='\0'; fprintf(html,"%s \n",to_html(p)); - for (r=q+5; *r!='}' && *r!='\0'; r++); - if (*r!='\0') { - *r='\0'; - fprintf(html,"%s\n",to_anchor(q+5,1)); - q=r; - } - p=q+1; first=0; - } else if (*q!=' ' && *q!='\t') { - first=0; - } - } - - if (*p!='\0') fprintf(html,"%s <P>\n",to_html(p)); - - fprintf(html,"\n <H3> More information: </H3> <UL>\n"); - if (do_pef) { - fprintf(html, - "<LI><A HREF=\"../%s/%s_comm.html\">List of general keywords</A> for %s\n", - pppname,pppname,PPPname); - } else { - fprintf(html, - "<LI><A HREF=\"../%s/%s_keys.html\">List of keywords</A> for %s\n", - pppname,pppname,PPPname); - } - /* If keyword has to do with filetype, looks like ....WMP_.... */ - - for (jj=strlen(name); jj>3 && name[jj]!='_'; jj--); - if (name[jj]=='_') { - for (ii=0; ftyp[ii]!=NULL && strncmp(name+jj-3,ftyp[ii],3); ii++); - if (ftyp[ii]!=NULL) { - strncpy(tmp,ftyp[ii],3); tmp[3]='\0'; my_lower(tmp); - fprintf(html, - "<LI>Description of the <A HREF=\"../%s_descr/%s_descr.html\">%s file format</A>\n", - tmp,tmp,ftyp[ii],fnam[ii]); - } - } - - fprintf(html, - "<LI><A HREF=\"../homepage.html\">NEWSTAR Documentation Home page</A>\n"); - if (!do_pef) { - fprintf(html, - "<LI>Description of <A HREF=\"../%s_descr/%s_descr.html\">program %s</A>\n", - pppname,pppname,PPPname); - } - fprintf(html, - "<LI>The <A HREF=\"../common_descr/common_descr.html\">DWARF User Interface</A>\n"); - - fprintf(html,"</UL>\n"); - - fclose(html); -} - - -flush_include(name,found) - -char *name; - -{ - int ii,jj,done; - char tmp[MAX_STRING]; - -/* - Separate filename and keyword list (INCLUDE=xxx_PEF:Key,Key) -*/ - for (ii=strlen(name); ii>0 && name[ii]!=':'; ii--); - if (ii!=0) name[ii]='\0'; - - if (strcmp(name+strlen(name)-4,"_PEF")) { - fprintf(stderr,"Invalid include: %s\n",name); return(0); - } else { - name[strlen(name)-4]='\0'; - } - strcpy(tmp,name); my_lower(tmp); - - if (found>0) fprintf(kindex,"<P>\n"); /* Space behind keyword only */ - if (ii!=0) { - fprintf(kindex, - "\n<UL><LI>General keywords from <A HREF=\"../%s_comm/%s_comm.html\">%s</A><UL>\n", - tmp,tmp,name); - - for (jj=ii+1,done=0; !done; ii=jj++) { - while (name[jj]!=',' && name[jj]!='\0') jj++; - if (name[jj]==',') name[jj]='\0'; else done=1; - sprintf(tmp,"%s__%s",name,name+ii+1); my_lower(tmp); - fprintf(kindex,"<LI><A HREF=\"../%s/%s.html\">%s</A>\n", - tmp,tmp,name+ii+1); - } - - fprintf(kindex,"<P></UL></UL>\n\n"); - } else { - fprintf(kindex, - "\n<UL><LI>See also <A HREF=\"../%s_comm/%s_comm.html\">%s</A> </UL>\n\n", - tmp,tmp,name); - } -} - - -char *to_html(line) - -char *line; - -{ - static char h_buf[5*MAX_STRING]; - - char *p,*q; - - for (p=line,q=h_buf; *p!='\0'; p++) { - - if (*p=='&') { - strcpy(q,"&"); q+=5; - } else if (*p=='>') { - strcpy(q,">"); q+=4; - } else if (*p=='<') { - strcpy(q,"<"); q+=4; - } else if (*p==',' && *(p+1)!=' ') { - strcpy(q,", "); q+=2; - } else { - *(q++)=(*p); - } - - } - - *q='\0'; - return(h_buf); -} - -/* - Tranform latex reference to a html anchor - - LaTeX references look like: - - entity.attribute[.internal] - - eg: nscan.descr.tapes, gen.problems, scn.descr.sectors, ch.files - - The first two words translate to the filename by replacing the - dot with an underscore and appending the extension .html. - The last word, if present, translates to an internal anchor name. - - CMV 940812: If reference to keyword (n*.*) use double underscore -*/ - -char *to_anchor(label,do_close) - -char *label; -int do_close; - -{ - int ndot,l1; - char *p,*q; - - static char a_buf[MAX_STRING]=""; - - for (p=label; *p!=' ' && *p!='\t' && *p!='\0'; p++); - - for (ndot=l1=0,q=NULL,p=label; ndot<2 && *p!='\0'; p++) { - if (*p=='.') { - if (!ndot) *p='_'; else { *p='\0'; q=p+1; } - ndot++; - } else if (!ndot) { - l1++; /* Count up to first dot */ - } - } - - if (ndot) { - label[l1]='\0'; - if (q==NULL) { - if (*label=='n') { - sprintf(a_buf,"<A HREF=\"../%s/%s__%s.html\">",label,label,label+l1+1); - } else { - sprintf(a_buf,"<A HREF=\"../%s/%s_%s.html\">",label,label,label+l1+1); - } - } else { - sprintf(a_buf,"<A HREF=\"../%s/%s_%s.html#%s\">",label,label,label+l1+1,q); - } - } else { - if (q==NULL) { - sprintf(a_buf,"<A HREF=\"%s.html\">",label); - } else { - sprintf(a_buf,"<A HREF=\"%s.html#%s\">",label,q); - } - } - if (do_close) strcat(a_buf,"<STRONG>here</STRONG></A>"); - return(a_buf); -} - - - -void get_label(unit) - -char *unit; - -{ - int ld; - - ld=open(unit,O_RDONLY); - if (read(ld,buf,80)==80 && !strncmp(buf,"VOL1",4)) { - printf("%-10.10s\n",buf+4); - } else { - printf("Unlabeled\n"); - } - close(ld); -} - - -void put_label(unit,label) - -char *unit,*label; - -{ - int ld; - - ld=open(unit,O_WRONLY+O_CREAT,0666); - sprintf(buf,"VOL1%-10.10s%80c",label,' '); - if (write(ld,buf,80)==80) { - printf("Init: %-10.10s\n",buf+4); - } else { - printf("Init: Unlabeled\n"); - } - close(ld); -} - diff --git a/src/sys/gids.xli b/src/sys/gids.xli deleted file mode 100755 index 06b5da8ecb7b8bac7f741308836a40d6c37445e4..0000000000000000000000000000000000000000 Binary files a/src/sys/gids.xli and /dev/null differ diff --git a/src/sys/giplib.ali b/src/sys/giplib.ali deleted file mode 100644 index a4b23295310aa4c69a13cf91bba2a4be0c9bfdf4..0000000000000000000000000000000000000000 Binary files a/src/sys/giplib.ali and /dev/null differ diff --git a/src/sys/i_al.csh b/src/sys/i_al.csh deleted file mode 100755 index c59760eb62a6cf86382e0b1fd28312c7a0f31dad..0000000000000000000000000000000000000000 --- a/src/sys/i_al.csh +++ /dev/null @@ -1,34 +0,0 @@ -# -# Machine specific rules for Alliant (CMV 930524) -# -# -# Fortran compiler commands -# -set FC=fortran -set FFLAGS="-c -e -w" -set FFLAGS_D="-g" -set FFLAGS_O="-O -OM -alt" -set FFLAGS_X="-xref" -# -# C compiler commands -# -set CC=cc -set CFLAGS="-c -ce -w" -set CFLAGS_D="-g" -set CFLAGS_O="-O" -# -# Assembler commands -# -set AS=as -set ASFLAGS= -# -# Linking (invoked through $FC) -# -set FFLAGS_L="-g -M" -set LD_X11=-lX11 -# -# Data type on this machine -# -set Dattyp=7 - - diff --git a/src/sys/i_atnf.csh b/src/sys/i_atnf.csh deleted file mode 100755 index 6217a33d3431277bb26ff70e6a1ea42b9dd786d2..0000000000000000000000000000000000000000 --- a/src/sys/i_atnf.csh +++ /dev/null @@ -1,5 +0,0 @@ -# -# At ATNF, do not keep old executables -# -set _KEEP = 0 -#set _DEBUG = 0 diff --git a/src/sys/i_cv.csh b/src/sys/i_cv.csh deleted file mode 100755 index b19ae719516aa6830859fcddd1475b4aea5568e0..0000000000000000000000000000000000000000 --- a/src/sys/i_cv.csh +++ /dev/null @@ -1,32 +0,0 @@ -# -# Machine specific rules for Convex (CMV 930524) -# -# -# Fortran compiler commands -# -set FC=fc -set FFLAGS="-c -na -nw -vfc -sa -LST" -set FFLAGS_D="-g" -set FFLAGS_O="-O3" -set FFLAGS_X="-xr" -# -# C compiler commands -# -set CC=cc -set CFLAGS="-c -na -nw" -set CFLAGS_D="-g" -set CFLAGS_O="-O" -# -# Assembler commands -# -set AS=as -set ASFLAGS= -# -# Linking (invoked through $FC) -# -set FFLAGS_L="-g -sa -vfc -O3 -na -nw -M" -set LD_X11=-lX11 -# -# Data type on this machine -# -set Dattyp=5 diff --git a/src/sys/i_da.csh b/src/sys/i_da.csh deleted file mode 100755 index 4f287a32f992e61288facbb2b985e41d98d95fbd..0000000000000000000000000000000000000000 --- a/src/sys/i_da.csh +++ /dev/null @@ -1,33 +0,0 @@ -# -# Machine specific rules for DEC Workstation (CMV 930524) -# -# -# Fortran compiler commands -# -set FC=f77 -set FFLAGS="-c -V -w -assume back" -set FFLAGS_D="-g" -set FFLAGS_O="-O1" -set FFLAGS_X="-xref" -# -# C compiler commands -# -set CC=cc -set CFLAGS="-c -w" -set CFLAGS_D="-g" -set CFLAGS_O="-O1" -# -# Assembler commands -# -set AS=as -set ASFLAGS= -# -# Linking (invoked through $FC) -# -set FFLAGS_L="-g -assume back -Wl,-M" -set LD_X11=-lX11 -# -# Data type on this machine -# -set Dattyp=6 - diff --git a/src/sys/i_dw.csh b/src/sys/i_dw.csh deleted file mode 100755 index 4f287a32f992e61288facbb2b985e41d98d95fbd..0000000000000000000000000000000000000000 --- a/src/sys/i_dw.csh +++ /dev/null @@ -1,33 +0,0 @@ -# -# Machine specific rules for DEC Workstation (CMV 930524) -# -# -# Fortran compiler commands -# -set FC=f77 -set FFLAGS="-c -V -w -assume back" -set FFLAGS_D="-g" -set FFLAGS_O="-O1" -set FFLAGS_X="-xref" -# -# C compiler commands -# -set CC=cc -set CFLAGS="-c -w" -set CFLAGS_D="-g" -set CFLAGS_O="-O1" -# -# Assembler commands -# -set AS=as -set ASFLAGS= -# -# Linking (invoked through $FC) -# -set FFLAGS_L="-g -assume back -Wl,-M" -set LD_X11=-lX11 -# -# Data type on this machine -# -set Dattyp=6 - diff --git a/src/sys/i_hp.csh b/src/sys/i_hp.csh deleted file mode 100755 index a3843eadb9470e73c5866c120e9db9794324cea1..0000000000000000000000000000000000000000 --- a/src/sys/i_hp.csh +++ /dev/null @@ -1,50 +0,0 @@ -# -# Machine specific rules for HP Workstation (CMV 930524) -# -# All possible settings should be in this file, so you can -# use it as a template for any other Unix machine. -# - -# -# Fortran compiler commands -# -#set FC=f77 -#set FFLAGS="-c -g +e +es +ppu -Nl50" -#set FFLAGS_D="-g" -#set FFLAGS_O="-O" -#set FFLAGS_X="" -set FC=g77 -set FFLAGS="-c -w -Wall -I$n_inc -fno-automatic -finit-local-zero -fugly-logint -fno-backslash -fdollar-ok -fno-second-underscore" -set FFLAGS_D=-g -set FFLAGS_O= -set FFLAGS_X= -# -# C compiler commands -# -#set CC=cc -#set CFLAGS="-c -w" -#set CFLAGS_D="-g" -#set CFLAGS_O="-O" -#if (-d /usr/include/X11R5) then -# set CFLAGS=( $CFLAGS -I/usr/include/X11R5 -I$n_inc) -#else -# set CFLAGS=( $CFLAGS -I/usr/include/X11R4 -I$n_inc) -#endif -set CC=gcc -set CFLAGS="-c -w -I$n_inc" -set CFLAGS_D=-g -set CFLAGS_O= -# -# Assembler commands -# -set AS=as -set ASFLAGS= -# -# Linking (invoked through $FC) -# -#set FFLAGS_L="-g +e +es +ppu" -set FFLAGS_L=" -fugly-logint -fno-backslash -fdollar-ok -fno-second-underscore" -set LD_X11="-L/usr/lib/X11 -lX11"# -# Data type on this machine -# -set Dattyp=8 diff --git a/src/sys/i_hpkosma.csh b/src/sys/i_hpkosma.csh deleted file mode 100755 index ed0305940471ad5be4ca36d28474f0066f4b3961..0000000000000000000000000000000000000000 --- a/src/sys/i_hpkosma.csh +++ /dev/null @@ -1,5 +0,0 @@ -# -# Machine specific rules for HP Workstations at KOSMA (HjV 931014) -# -set LD_X11=/usr/lib/X11R4/libX11.a - diff --git a/src/sys/i_hpnfra.csh b/src/sys/i_hpnfra.csh deleted file mode 100755 index e5404c538525451dfaa2a7728f786ef3031c0b44..0000000000000000000000000000000000000000 --- a/src/sys/i_hpnfra.csh +++ /dev/null @@ -1,8 +0,0 @@ -# -# Machine specific rules for HP Workstations at NFRA (CMV 930929) -# 29-aug-97 HjV libX11.sl iso. libX11.a because of building on daw18 -# -set LD_X11=/usr/lib/X11R5/libX11.sl -set ARR="ar crlv" -set ARD="ar dlv" - diff --git a/src/sys/i_hprug.csh b/src/sys/i_hprug.csh deleted file mode 100755 index d1e0f45c94c705f740c65d3357d017d27ba2eed6..0000000000000000000000000000000000000000 --- a/src/sys/i_hprug.csh +++ /dev/null @@ -1,7 +0,0 @@ -# -# Machine specific rules for HP Workstations at RUG (CMV 930929) -# 961212 HjV Add FC (for HP-system 10) -# -set FC=/opt/fortran/bin/f77 -set LD_X11=/usr/lib/X11R5/libX11.a - diff --git a/src/sys/i_hprul.csh b/src/sys/i_hprul.csh deleted file mode 100755 index 2268a025f2efa4bc2c136d289ac16d25c0e1b7f9..0000000000000000000000000000000000000000 --- a/src/sys/i_hprul.csh +++ /dev/null @@ -1,6 +0,0 @@ -# -# Machine specific rules for HP Workstations at RUL (HjV 940317) -# -set LD_X11=/usr/lib/X11R4/libX11.a -set ARR="ar crlv" -set ARD="ar dlv" diff --git a/src/sys/i_hpsron.csh b/src/sys/i_hpsron.csh deleted file mode 100755 index 4e801f2458f64f9f8923e53fc107b240ce73192f..0000000000000000000000000000000000000000 --- a/src/sys/i_hpsron.csh +++ /dev/null @@ -1,5 +0,0 @@ -# -# Machine specific rules for HP Workstations at SRON (CMV 950105) -# -set LD_X11=/usr/lib/X11R5/libX11.a - diff --git a/src/sys/i_hpwenss.csh b/src/sys/i_hpwenss.csh deleted file mode 100755 index 02b28ecbd1415b4639a8248875d9156dbd95b950..0000000000000000000000000000000000000000 --- a/src/sys/i_hpwenss.csh +++ /dev/null @@ -1,6 +0,0 @@ -# -# Machine specific rules for HP Workstations at WENSS (CMV 930929) -# Just copy of I_HPNFRA.CSH (HjV 950529) -# -set LD_X11=/usr/lib/X11R5/libX11.a - diff --git a/src/sys/i_hpwsrt.csh b/src/sys/i_hpwsrt.csh deleted file mode 100755 index 409b1fe8a78104c8ea83d460f41093c3a32e7ded..0000000000000000000000000000000000000000 --- a/src/sys/i_hpwsrt.csh +++ /dev/null @@ -1,5 +0,0 @@ -# -# Machine specific rules for HP Workstations at WSRT (HjV 960201) -# -set LD_X11=/usr/lib/X11R5/libX11.a - diff --git a/src/sys/i_li.csh b/src/sys/i_li.csh deleted file mode 100755 index b165c79548f32423a602fe6eb446e457b348e166..0000000000000000000000000000000000000000 --- a/src/sys/i_li.csh +++ /dev/null @@ -1,47 +0,0 @@ -# -# Machine specific rules for Linux AxC 010130) -# - -# -# Fortran compiler commands -# -set FC=g77 -set FFLAGS="-c -w -Wall -I$n_inc -fno-automatic -finit-local-zero -fugly-logint -fno-backslash -fdollar-ok -fno-second-underscore" -set FFLAGS_D=-g -set FFLAGS_O= -set FFLAGS_X= -# -# C compiler commands -# -set CC=gcc -set CFLAGS="-c -w -I$n_inc" -set CFLAGS_D=-g -set CFLAGS_O= -# -# Assembler commands -# -set AS=as -set ASFLAGS= -# -# Linking (invoked through $FC) -# -set FFLAGS_L=" -fugly-logint -fno-backslash -fdollar-ok -fno-second-underscore" -#set LD_X11=/usr/X11/lib/libX11.a -set LD_X11="-L/usr/X11/lib -lX11" -# -# Data type on this machine -# -set Dattyp=6 - - - - - - - - - - - - - diff --git a/src/sys/i_liger.csh b/src/sys/i_liger.csh deleted file mode 100644 index 1eede10af2af61cae9c4261f47726d9d945a4fc1..0000000000000000000000000000000000000000 --- a/src/sys/i_liger.csh +++ /dev/null @@ -1,13 +0,0 @@ -# -# Machine specific rules for Linux at NFRA (AxC 010130) -# -set CC="gcc-3.3" -set FFLAGS="-c -w -Wall -I$n_inc -fno-automatic -finit-local-zero -fugly-logint -fno-backslash -fdollar-ok -fno-second-underscore -m32" -set CFLAGS="-c -w -I$n_inc -m32" -set LD_X11="-L/usr/lib -lX11" -#set LD_USER="-L/usr/lib -lncursesw" -set FFLAGS_L="-m32 -fugly-logint -fno-backslash -fdollar-ok -fno-second-underscore -L/usr/lib64/gcc-lib/x86_64-suse-linux/3.3.3-hammer/32" - - - - diff --git a/src/sys/i_liger208.csh b/src/sys/i_liger208.csh deleted file mode 100644 index 1eede10af2af61cae9c4261f47726d9d945a4fc1..0000000000000000000000000000000000000000 --- a/src/sys/i_liger208.csh +++ /dev/null @@ -1,13 +0,0 @@ -# -# Machine specific rules for Linux at NFRA (AxC 010130) -# -set CC="gcc-3.3" -set FFLAGS="-c -w -Wall -I$n_inc -fno-automatic -finit-local-zero -fugly-logint -fno-backslash -fdollar-ok -fno-second-underscore -m32" -set CFLAGS="-c -w -I$n_inc -m32" -set LD_X11="-L/usr/lib -lX11" -#set LD_USER="-L/usr/lib -lncursesw" -set FFLAGS_L="-m32 -fugly-logint -fno-backslash -fdollar-ok -fno-second-underscore -L/usr/lib64/gcc-lib/x86_64-suse-linux/3.3.3-hammer/32" - - - - diff --git a/src/sys/i_linfra.csh b/src/sys/i_linfra.csh deleted file mode 100755 index 9a5ed4621b9f48b0856041557ba22afe487d890f..0000000000000000000000000000000000000000 --- a/src/sys/i_linfra.csh +++ /dev/null @@ -1,8 +0,0 @@ -# -# Machine specific rules for Linux at NFRA (AxC 010130) -# -set LD_X11="-L/usr/X11R6/lib -lX11" -#set LD_USER="-L/usr/lib -lncursesw" - - - diff --git a/src/sys/i_liroberto236.csh b/src/sys/i_liroberto236.csh deleted file mode 100644 index 1eede10af2af61cae9c4261f47726d9d945a4fc1..0000000000000000000000000000000000000000 --- a/src/sys/i_liroberto236.csh +++ /dev/null @@ -1,13 +0,0 @@ -# -# Machine specific rules for Linux at NFRA (AxC 010130) -# -set CC="gcc-3.3" -set FFLAGS="-c -w -Wall -I$n_inc -fno-automatic -finit-local-zero -fugly-logint -fno-backslash -fdollar-ok -fno-second-underscore -m32" -set CFLAGS="-c -w -I$n_inc -m32" -set LD_X11="-L/usr/lib -lX11" -#set LD_USER="-L/usr/lib -lncursesw" -set FFLAGS_L="-m32 -fugly-logint -fno-backslash -fdollar-ok -fno-second-underscore -L/usr/lib64/gcc-lib/x86_64-suse-linux/3.3.3-hammer/32" - - - - diff --git a/src/sys/i_liroberto275.csh b/src/sys/i_liroberto275.csh deleted file mode 100644 index 1eede10af2af61cae9c4261f47726d9d945a4fc1..0000000000000000000000000000000000000000 --- a/src/sys/i_liroberto275.csh +++ /dev/null @@ -1,13 +0,0 @@ -# -# Machine specific rules for Linux at NFRA (AxC 010130) -# -set CC="gcc-3.3" -set FFLAGS="-c -w -Wall -I$n_inc -fno-automatic -finit-local-zero -fugly-logint -fno-backslash -fdollar-ok -fno-second-underscore -m32" -set CFLAGS="-c -w -I$n_inc -m32" -set LD_X11="-L/usr/lib -lX11" -#set LD_USER="-L/usr/lib -lncursesw" -set FFLAGS_L="-m32 -fugly-logint -fno-backslash -fdollar-ok -fno-second-underscore -L/usr/lib64/gcc-lib/x86_64-suse-linux/3.3.3-hammer/32" - - - - diff --git a/src/sys/i_liroberto285.csh b/src/sys/i_liroberto285.csh deleted file mode 100644 index 1eede10af2af61cae9c4261f47726d9d945a4fc1..0000000000000000000000000000000000000000 --- a/src/sys/i_liroberto285.csh +++ /dev/null @@ -1,13 +0,0 @@ -# -# Machine specific rules for Linux at NFRA (AxC 010130) -# -set CC="gcc-3.3" -set FFLAGS="-c -w -Wall -I$n_inc -fno-automatic -finit-local-zero -fugly-logint -fno-backslash -fdollar-ok -fno-second-underscore -m32" -set CFLAGS="-c -w -I$n_inc -m32" -set LD_X11="-L/usr/lib -lX11" -#set LD_USER="-L/usr/lib -lncursesw" -set FFLAGS_L="-m32 -fugly-logint -fno-backslash -fdollar-ok -fno-second-underscore -L/usr/lib64/gcc-lib/x86_64-suse-linux/3.3.3-hammer/32" - - - - diff --git a/src/sys/i_lirul.csh b/src/sys/i_lirul.csh deleted file mode 100755 index 2bb72d52b54f6502ffca801e0f33e378dcf3a1f1..0000000000000000000000000000000000000000 --- a/src/sys/i_lirul.csh +++ /dev/null @@ -1,7 +0,0 @@ -# -# Machine specific rules for Linux at Leiden (AxC 11032004) -# -set LD_USER=-L/usr/lib -set LD_X11=/usr/X11R6/lib/libX11.a - - diff --git a/src/sys/i_liwnbl.csh b/src/sys/i_liwnbl.csh deleted file mode 100644 index 9a5ed4621b9f48b0856041557ba22afe487d890f..0000000000000000000000000000000000000000 --- a/src/sys/i_liwnbl.csh +++ /dev/null @@ -1,8 +0,0 @@ -# -# Machine specific rules for Linux at NFRA (AxC 010130) -# -set LD_X11="-L/usr/X11R6/lib -lX11" -#set LD_USER="-L/usr/lib -lncursesw" - - - diff --git a/src/sys/i_liwnbt.csh b/src/sys/i_liwnbt.csh deleted file mode 100644 index 9a5ed4621b9f48b0856041557ba22afe487d890f..0000000000000000000000000000000000000000 --- a/src/sys/i_liwnbt.csh +++ /dev/null @@ -1,8 +0,0 @@ -# -# Machine specific rules for Linux at NFRA (AxC 010130) -# -set LD_X11="-L/usr/X11R6/lib -lX11" -#set LD_USER="-L/usr/lib -lncursesw" - - - diff --git a/src/sys/i_liwnbt208.csh b/src/sys/i_liwnbt208.csh deleted file mode 100644 index ed7cf6bff124ee812fdb5386c5544c6a59ad1c4d..0000000000000000000000000000000000000000 --- a/src/sys/i_liwnbt208.csh +++ /dev/null @@ -1,12 +0,0 @@ -# -# Machine specific rules for Linux at NFRA (AxC 010130) -# -set CC="gcc-3.3" -set FFLAGS="-c -w -Wall -I$n_inc -fno-automatic -finit-local-zero -fugly-logint -fno-backslash -fdollar-ok -fno-second-underscore -m32" -set CFLAGS="-c -w -I$n_inc -m32" -set FFLAGS_L="-m32 -fugly-logint -fno-backslash -fdollar-ok -fno-second-underscore -L/usr/lib64/gcc-lib/x86_64-suse-linux/3.3.3-hammer/32" -set LD_X11="-L/usr/lib -lX11" -#set LD_USER="-L/usr/lib -lncursesw" - - - diff --git a/src/sys/i_liwsrt.csh b/src/sys/i_liwsrt.csh deleted file mode 100755 index 6abea96ed15badade486bbb16586fac4e991357d..0000000000000000000000000000000000000000 --- a/src/sys/i_liwsrt.csh +++ /dev/null @@ -1,7 +0,0 @@ -# -# Machine specific rules for Linux at NFRA (AxC 010130) -# -set LD_USER=-L/usr/lib/termcap - - - diff --git a/src/sys/i_so.csh b/src/sys/i_so.csh deleted file mode 100755 index 1b62f55c36a2baebc0817160852f39a10122a73a..0000000000000000000000000000000000000000 --- a/src/sys/i_so.csh +++ /dev/null @@ -1,34 +0,0 @@ -# -# Machine specific rules for Sun Solaris (HjV 960618) -# - -# -# Fortran compiler commands -# -set FC=f77 -set FFLAGS="-c -w -xl -Nl50 " -set FFLAGS_D=-g -set FFLAGS_O= -set FFLAGS_X= -# -# C compiler commands -# -set CC=gcc -set CFLAGS="-c -w" -set CFLAGS_D=-g -set CFLAGS_O= -# -# Assembler commands -# -set AS=as -set ASFLAGS= -# -# Linking (invoked through $FC) -# -set FFLAGS_L="-g -xl -Qoption ld -m" -set LD_X11=-lX11 -# -# Data type on this machine -# -set Dattyp=7 - diff --git a/src/sys/i_soatnf.csh b/src/sys/i_soatnf.csh deleted file mode 100755 index 7887b20b1ef57c84f571ec9de91e498a994756e2..0000000000000000000000000000000000000000 --- a/src/sys/i_soatnf.csh +++ /dev/null @@ -1,6 +0,0 @@ -# -# Machine specific rules for Sun Solaris at ATNF (WNB 960610) -# -set LD_USER="-lsocket -lnsl" -set LD_USER="$LD_USER -L/usr/ucblib -lucb" - diff --git a/src/sys/i_sonfra.csh b/src/sys/i_sonfra.csh deleted file mode 100755 index b9ef4ed8c4c1e2a45e97eac3629d58769908f1bf..0000000000000000000000000000000000000000 --- a/src/sys/i_sonfra.csh +++ /dev/null @@ -1,6 +0,0 @@ -# -# Machine specific rules for Sun Solaris at NFRA (HjV 960618) -# -set LD_USER="-lsocket -lnsl" -set LD_USER="$LD_USER -L/usr/ucblib -lucb" - diff --git a/src/sys/i_soraiub.csh b/src/sys/i_soraiub.csh deleted file mode 100755 index 8116ab83275a213829995230928b604375fdb144..0000000000000000000000000000000000000000 --- a/src/sys/i_soraiub.csh +++ /dev/null @@ -1,7 +0,0 @@ -# -# Machine specific rules for Sun Solaris at RAIUB (Helge Rottmann 971029) -# -set LD_USER="-lsocket -lnsl" -set LD_USER="$LD_USER -L/usr/ucblib -lucb" - - diff --git a/src/sys/i_sorug.csh b/src/sys/i_sorug.csh deleted file mode 100755 index 605aa86bcf672071136440dba2c8c8c7e6961638..0000000000000000000000000000000000000000 --- a/src/sys/i_sorug.csh +++ /dev/null @@ -1,8 +0,0 @@ -# -# Machine specific rules for Sun Solaris at RUG (HjV 961212) -# -set FC=/opt/SUNWspro/bin/f77 -#set LD_X11=/usr/lib/X11/libX11.a -set LD_USER="-lsocket -lnsl" -set LD_USER="$LD_USER -L/usr/ucblib -lucb -L/usr/lib -ldl -lw" - diff --git a/src/sys/i_sw.csh b/src/sys/i_sw.csh deleted file mode 100755 index 4d6d4a8461f6ca5619debede46c6c5310b3757d4..0000000000000000000000000000000000000000 --- a/src/sys/i_sw.csh +++ /dev/null @@ -1,34 +0,0 @@ -# -# Machine specific rules for Sun Workstation (CMV 930524) -# - -# -# Fortran compiler commands -# -set FC=f77 -set FFLAGS="-c -w -xl -Nl50 " -set FFLAGS_D=-g -set FFLAGS_O= -set FFLAGS_X= -# -# C compiler commands -# -set CC=cc -set CFLAGS="-c -ce -w" -set CFLAGS_D=-g -set CFLAGS_O= -# -# Assembler commands -# -set AS=as -set ASFLAGS= -# -# Linking (invoked through $FC) -# -set FFLAGS_L="-g -xl -Qoption ld -M" -set LD_X11=-lX11 -# -# Data type on this machine -# -set Dattyp=7 - diff --git a/src/sys/i_swarecb.csh b/src/sys/i_swarecb.csh deleted file mode 100755 index caa5b8034781af7a4f4eefe3a06549e8510f43ba..0000000000000000000000000000000000000000 --- a/src/sys/i_swarecb.csh +++ /dev/null @@ -1,5 +0,0 @@ -# -# Machine specific rules for Sun Workstations at ARECB (HjV 940314) -# -set ARR="ar crlv" -set ARD="ar dlv" diff --git a/src/sys/i_swatnf.csh b/src/sys/i_swatnf.csh deleted file mode 100755 index 92035eee9e0c0f27e49d9d76bc97fefe92057de8..0000000000000000000000000000000000000000 --- a/src/sys/i_swatnf.csh +++ /dev/null @@ -1,5 +0,0 @@ -# -# Machine specific rules for Sun Workstations at ATNF (WNB 960610) -# -set LD_USER="-lsocket -lnsl" - diff --git a/src/sys/i_swlick.csh b/src/sys/i_swlick.csh deleted file mode 100755 index b562ab3b7b4b1598afcca0f48073f1afc200078b..0000000000000000000000000000000000000000 --- a/src/sys/i_swlick.csh +++ /dev/null @@ -1,5 +0,0 @@ -# -# Machine specific rules for SUN Workstations at LICK (HjV 960620) -# -set LD_X11=/opt/X11/lib/libX11.a -set CFLAGS=($CFLAGS -I/usr/local/XV11R5/include ) diff --git a/src/sys/i_swraiub.csh b/src/sys/i_swraiub.csh deleted file mode 100755 index 1e68437a7cc10e07e85f2e3d4d1bd22dfbcabaf0..0000000000000000000000000000000000000000 --- a/src/sys/i_swraiub.csh +++ /dev/null @@ -1,5 +0,0 @@ -# -# Machine specific rules for SUN Workstations at RAIUB (HjV 931020) -# -set LD_X11=/usr/openwin/lib/libX11.a -set CFLAGS=($CFLAGS -I/usr/openwin/share/include ) diff --git a/src/sys/i_swrug.csh b/src/sys/i_swrug.csh deleted file mode 100755 index c641d7cd2067cd54102c0d52d0d0e256b482f6c5..0000000000000000000000000000000000000000 --- a/src/sys/i_swrug.csh +++ /dev/null @@ -1,12 +0,0 @@ -# -# Machine specific rules for Sun Workstations at RUG (CMV 931006) -# -set FC=/usr/lang/SC1.0/f77 -set FFLAGS="-c -w -xl -Nl50" -set FFLAGS_L="-g -xl -Qoption ld -M -Bstatic" -set LD_X11=/usr/openwin/lib/libX11.a -# -# Data type on this machine -# -set Dattyp=7 - diff --git a/src/sys/i_swrul.csh b/src/sys/i_swrul.csh deleted file mode 100755 index 3c6d05678a837ea9c13e69c5746de2b5e8364afe..0000000000000000000000000000000000000000 --- a/src/sys/i_swrul.csh +++ /dev/null @@ -1,8 +0,0 @@ -# -# Machine specific rules for Sun Workstations at RUL (HjV 950628) -# -# Revision: -# -set FFLAGS="-c -w -xl -Nl50 -Nn2000" -set ARR="ar crlv" -set ARD="ar dlv" diff --git a/src/sys/i_swucb.csh b/src/sys/i_swucb.csh deleted file mode 100755 index 2a975ddbdae82893a16a17b49f43c29d2fd917e8..0000000000000000000000000000000000000000 --- a/src/sys/i_swucb.csh +++ /dev/null @@ -1,4 +0,0 @@ -set FFLAGS_L="-g -xl " -set LD_X11=-lX11 -set LD_USER="-lucb -lnsl -lsocket" - diff --git a/src/sys/i_swucsb.csh b/src/sys/i_swucsb.csh deleted file mode 100755 index 111fe8b9d85d3d53d1e50036f0d746e540dd7774..0000000000000000000000000000000000000000 --- a/src/sys/i_swucsb.csh +++ /dev/null @@ -1,10 +0,0 @@ -# -# Machine specific rules for Sun Workstations at UCSB (HjV 931220) -# -# Revision: -# HjV 950120 Add FC -# -set FC=/usr/lang/SC0.0/f77 -set FFLAGS="-c -w -xl -Nl50 -Nn2000" -set ARR="ar crlv" -set ARD="ar dlv" diff --git a/src/sys/i_vx.csh b/src/sys/i_vx.csh deleted file mode 100755 index b6f8c3b50320d2354d1861cdcc56d5d21e293858..0000000000000000000000000000000000000000 --- a/src/sys/i_vx.csh +++ /dev/null @@ -1,35 +0,0 @@ -# -# Machine specific rules for VMS machines (WNB 940315) -# - -# -# Fortran compiler commands -# -set FC=fortran -set FFLAGS="/F77/EXTEND/I4/SHOW=(NODICT,NOINCL,MAP,NOPREP,NOSIN)" -set FFLAGS_D="/DEBUG/WARN=NOGEN" -set FFLAGS_O="/OPTIM" -set FFLAGS_X="/CROSS/FULL" -set FFLAGS_L="/F77/EXTEND/I4/SHOW=(NODICT,NOINCL,MAP,NOPREP,NOSIN)/DEBUG/OPTIM" -# -# C compiler commands -# -set CC=CC -set CFLAGS='/LIST/OPTIM/DEF="wn_vx__/name=as_is"' -set CFLAGS_D="/DEBUG" -set CFLAGS_O="/OPTIM" -# -# Assembler commands -# -set AS=MACRO -set ASFLAGS= -# -# Linking (invoked through $FC) -# -set FFLAGS_L="/F77/EXTEND/I4/SHOW=(NODICT,NOINCL,MAP,NOPREP,NOSIN)/DEBUG/OPTIM" -set LD_X11= -# -# Data type on this machine -# -set Dattyp=1 - diff --git a/src/sys/include.c b/src/sys/include.c deleted file mode 100644 index e21aee279382e6b648bd7ca1c48f7c4b6089ae2f..0000000000000000000000000000000000000000 --- a/src/sys/include.c +++ /dev/null @@ -1,63 +0,0 @@ -/* include.c */ - -/* Recursive execution of \include and \input directives in LaTeX files - The input and output files are given as invocation arguments - -History: - JPH 940... - JPH 940818 Correct comments - JPH 940915 Append \n to included files -*/ - -#include <stdio.h> -#include <fcntl.h> -#include <string.h> -#include <errno.h> - -int copy (in, out) - FILE *in, *out; -{ - FILE*nin; - char l[4096]; - char *lp, *fp, *sp; - - l[0]='%'; l[1]=' '; - while (fgets (l+2, 4096, in)) { - for (sp=l+2; *sp ==' ' || *sp ==' '; sp++); - lp= sp; - if (! strncmp(sp, "\\input", 6)) lp+= 6; - if (! strncmp(sp, "\\include", 8)) lp+= 8; - if (lp ==sp) { - fputs (l+2, out); - } else { - fputs (l, out); - for (;*lp ==' ' || *lp =='{'; ++lp); fp= lp++; - for (lp++ ;*lp !='}' && *lp !='\n' && *lp !=' '; lp++); *lp= 0; - nin = fopen (fp, "r"); - if (errno) { - printf("ERROR Can't open %s\n", fp); return errno; - } - copy (nin, out); - if (errno) {return errno;} - } - } - fputs ("\n", out); /* be sure to terminate last line */ - return errno; -} - -int main (argc, argv) - char** argv; - int argc; -{ - FILE *in, *out; - - in= fopen(argv[1], "r"); - if (errno) { - printf("ERROR Can't open %s\n", argv[1]); return errno; - }; - out= fopen(argv[2], "w"); - if (errno) { - printf("ERROR Can't open %s\n", argv[2]); return errno; - }; - return copy (in, out); -} diff --git a/src/sys/init_wsrt.csh b/src/sys/init_wsrt.csh deleted file mode 100755 index 2cde6a344eba86ea955767cc4b6187ed1d6dbcd9..0000000000000000000000000000000000000000 --- a/src/sys/init_wsrt.csh +++ /dev/null @@ -1,187 +0,0 @@ -#!/bin/csh -############################################################## -# .wsrt file for all users of the WSRT offline software # -############################################################## - - if (! $?FILBEC) echo "Setting the WSRT environment ....." -# -# All 'alias' names in alfabetical order. -# - alias ampha '/users/srt/bin/ampha.exe' - alias buslink '/users/srt/bin/buslink.exe' - alias buslinkt '/users/srt/onp/buslink/test/buslinkt' - alias cadis '/users/srt/bin/cadis.exe' -# alias cadist '/users/srt/bin/cadist.exe' - alias catap '/users/srt/bin/catap.exe' - alias cfreq '/users/srt/bin/cfreq.exe' - alias check '/users/srt/bin/check.exe' - alias check_cat '/users/srt/bin/check_cat.exe' - alias cemon '/users/srt/bin/cemon.exe' - alias cocon '/users/srt/bin/cocon.exe' - alias cotap '/users/srt/bin/cotap.exe' - alias decom '/users/srt/bin/decom.exe' - alias decomt '/users/srt/ofp/decom/test/decomt' - alias delca '/users/srt/bin/delca.exe' - alias delfi '/users/srt/bin/delfi.exe' - alias delof '/users/srt/bin/delof.exe' - alias dipol '/users/srt/bin/dipol.exe' - alias dista '/users/srt/bin/dista.exe' - alias distodat '/users/srt/bin/distodat.exe' - alias dumpt '/users/srt/bin/dumpt.exe' - alias f77dir 'cat *.f | grep "*+"' - alias femon '/users/srt/bin/femon.exe' - alias findjm '/users/srt/bin/findjm.exe' - alias firte '/users/srt/bin/firte.exe' - alias fixpa '/users/srt/bin/fixpa.exe' - alias fn1000 'kermit -l /dev/hp1000_a -b 9600 -f ' - alias gt1000 'kermit -l /dev/hp1000_a -b 9600 -g ' - alias hp1000 'kermit -l /dev/hp1000_a -b 9600 -c' - alias holog '/users/srt/bin/holog.exe' - alias info 'mosaic /users/srt/mosdoc/info.html' - alias licom '/users/srt/bin/licom.exe' - alias linkstat '/users/srt/bin/linkstat.exe' - alias linktask '/users/srt/bin/linktask.exe' - alias lists '/users/srt/bin/lists.exe' - alias lpv '/users/srt/bin/lpv' - alias makecal '/users/srt/bin/makecal.exe' - alias marec '/users/srt/bin/marec.exe' - alias model '/users/srt/bin/model.exe' - alias mofil '/users/srt/bin/mofil.exe' - alias mosaic '/disk3/Mosaic/Mosaic-2.0/src/Mosaic' - alias mospa '/users/srt/bin/mospa.exe' - alias offline '/users/srt/bin/offline' - alias parasol '/users/srt/bin/parasol.exe' - alias plotf '/users/srt/bin/plotf.exe' - alias plotj '/users/srt/bin/plotj.exe' - alias pluvo '/users/srt/bin/pluvo.exe' - alias priad '/users/srt/bin/priad.exe' - alias prtap '/users/srt/bin/prtap.exe' - alias quality '/users/srt/bin/quality.exe' - alias repoi '/users/srt/bin/repoi.exe' - alias savex '/users/srt/bin/savex.exe' - alias setup '/users/srt/bin/setup.exe' - alias spect '/users/srt/bin/spect.exe' - alias stfma '/users/srt/bin/stfma.exe' - alias stfmat '/users/srt/bin/stfmat.exe' - alias stmet '/users/srt/bin/stmet.exe' - alias sumas '/users/srt/bin/sumas.exe' - alias sutim '/users/srt/bin/sutim' - alias tools '/users/srt/bin/tools.exe' - alias tpdis '/users/srt/bin/tpdis.exe' - alias tsyst '/users/srt/bin/tsyst.exe' - alias uvdata '/users/srt/bin/uvdata.exe' - alias vsyst '/users/srt/bin/vsyst.exe' - alias zofri '/users/srt/bin/zofri.exe' - alias nst 'cd /users/srt/nst' - alias logA '/users/srt/bin/logA.exe' - alias onp 'cd /users/srt/onp' - alias ofp 'cd /users/srt/ofp' - alias view '/users/srt/ofp/viewsched/vw' - alias wp '/usr/wp/bin/wp' - alias xfig 'xfig -e ps' -# -# Environment variables for standard programs in alfabetical order. -# -setenv ADM /disk3/obs/adm -setenv AMPHA /users/srt/bin/ampha.exe -setenv CATAP /users/srt/bin/catap.exe -setenv CADIS /users/srt/bin/cadis.exe -setenv CEMON /users/srt/bin/cemon.exe -setenv CFREQ /users/srt/bin/cfreq.exe -setenv COCON /users/srt/bin/cocon.exe -setenv COTAP /users/srt/bin/cotap.exe -setenv DECOM /users/srt/bin/decom.exe -setenv DELCA /users/srt/bin/delca.exe -setenv DELFI /users/srt/bin/delfi.exe -setenv DELOF /users/srt/bin/delof.exe -setenv DISTA /users/srt/bin/dista.exe -setenv DISTODAT /users/srt/bin/distodat.exe -setenv DUMPT /users/srt/bin/dumpt.exe -setenv FINDJM /users/srt/bin/findjm.exe -setenv FIRTE /users/srt/bin/firte.exe -setenv FIXPA /users/srt/bin/fixpa.exe -setenv LICOM /users/srt/bin/licom.exe -setenv LISTS /users/srt/bin/lists.exe -setenv LPV /users/srt/bin/lpv -setenv MAREC /users/srt/bin/marec.exe -setenv MAKECAL /users/srt/bin/makecal.exe -setenv MOLOG /users/srt/ofp/molog/molog -setenv MOPLT /users/srt/ofp/moplt/moplt -setenv MOSOL /users/srt/ofp/mosys/mosol -setenv PARASOL /users/srt/bin/parasol.exe -setenv PLOTF /users/srt/bin/plotf.exe -setenv PLOTJ /users/srt/bin/plotj.exe -setenv PLUVO /users/srt/bin/pluvo.exe -setenv PRIAD /users/srt/bin/priad.exe -setenv PRTAP /users/srt/bin/prtap.exe -setenv REPOI /users/srt/bin/repoi.exe -setenv LKTASK /users/srt/bin/linktask.exe -setenv STFMA /users/srt/bin/stfma.exe -setenv STFMAT /users/srt/bin/stfmat.exe -setenv STMET /users/srt/bin/stmet.exe -setenv SUMAS /users/srt/bin/sumas.exe -setenv SUTIM /users/srt/bin/sutim -setenv TOOLS /users/srt/bin/tools.exe -setenv TPDIS /users/srt/bin/tpdis.exe -setenv TSYST /users/srt/bin/tsyst.exe -setenv UVDATA /users/srt/bin/uvdata.exe -setenv VSYST /users/srt/bin/vsyst.exe -setenv ZOFRI /users/srt/bin/zofri.exe -setenv SPECT /users/srt/bin/spect.exe -setenv QUALITY /users/srt/bin/quality.exe -# -# Environment variables for standard data files in alfabetical order. -# -setenv MON /disk3/mon -setenv FILBEC $ADM/filbec.txt -setenv FILCAL $ADM/filcal.txt -setenv FILCLC $ADM/filclc.txt -setenv FILCAT $ADM/catalog.d -setenv FILE01 $ADM/obsad.d -setenv FILE06 /disk3/obs/data/filuv01.d -setenv FILE07 /disk3/obs/data/filuv02.d -setenv FILE08 /disk3/obs/data/filuv03.d -setenv FILE15 /disk3/obs/data/filuv04.d -setenv FILE16 /disk3/obs/data/filuv05.d -setenv FILEX $ADM/srtpar.d -setenv FILHPD $ADM/filhpd.d -setenv FILLSI $MON/lsidata.d -setenv FILMET $ADM/filmet.d -setenv FILEWN $ADM/filewn.d -setenv FILNAM $ADM/filnam.d -setenv FILPRP $ADM/filprp.d -setenv FILREQ $ADM/filreq.d -setenv FILVLB $ADM/filvlb.d -setenv FLCATK /users/srt/ofp/catap/FLCATK -setenv FLCATL /users/srt/ofp/catap/FLCATL -setenv FLCEMO $MON/flcemo.d -setenv FLDIST /users/srt/ofp/dista/FLDIST -setenv FLMOCA /disk3/obs/vlbi/flmoca.d -setenv FLMOLO /disk3/obs/vlbi/flmolo.d -setenv FLPOIN /disk3/obs/pointing/flpoin.d -setenv FLPOSI $MON/flposi.d -setenv flsuma /users/srt/flsuma -setenv FLTEST $MON/fltest.d -setenv FUNTAB $MON/FUNTAB -setenv LNKCTL /users/srt/onp/buslink.d -setenv SCAN01 /disk3/obs/data/scan01.d -setenv SCAN02 /disk3/obs/data/scan02.d -setenv SCTP01 /disk3/obs/data/sctp01.d -setenv LOG /disk3/obs/log -setenv SRT /users/srt -setenv XTP /users/srt/xtp -setenv XTPO /users/srt/xtp/offline -setenv STATCS /disk3/obs/data/statcs.d -setenv WNG /users/srt/nst/wng -setenv WSTASK /users/srt/onp/wstasks.d -setenv VLBI /disk3/obs/vlbi -# -# Additional SYSTEM environment variables. -# - setenv GS_LIB /disk3/csl/ghostscript -# setenv LPATH /lib:/usr/lib:/users/srt/lib -# -# End of .wsrt - - - diff --git a/src/sys/initcompile.csh b/src/sys/initcompile.csh deleted file mode 100755 index 574a2e446a2eb049dc882dbd1b00b2c6ddd10168..0000000000000000000000000000000000000000 --- a/src/sys/initcompile.csh +++ /dev/null @@ -1,136 +0,0 @@ -#!/bin/csh -#set echo -#+ -# initcompile.csh -# CMV 930528 Created -# CMV 931105 Added Myname -# CMV 931223 Remove _Objectlist _Textlist -# CMV 940218 Get version number -# CMV 950116 Search for i_${n_site}.csh as well -# WNB 950224 Added elm alias -# HjV 950828 Better test for elm alias -# -# This script is invoked both by shadow.csh and update.csh to -# ensure the environment is set up and to make common initialisations. -# -# $Files should contain the list of files (with intersparsed switches). -# -#- - -# -# See if environment is defined -# -if (! $?n_root || ! $?n_src || ! $?n_inc || ! $?n_lib || ! $?n_exe || \ - ! $?n_import || ! $?n_arch || ! $?n_site || ! $?n_hlp ) then - echo " " - echo "Getting upset: environment not setup" - echo "First initialise Newstar and then try again" - echo " " - exit -endif - -if (! -d $n_src) then - echo " " - echo "You do not have a proper Master source tree...." - echo "Your Master source tree should root at $n_src" - echo "This compiler script seems to be $0" - echo "Please verify your setup file (newstar_$n_site.csh)" - exit -endif - -# -# Make sure elm known -# -set a=(`which elm`) -if ($#a != 1) then - alias elm \/usr/ucb/mail -else - if (! -e $a[1]) alias elm \/usr/ucb/mail -endif -unset a -# -# Make sure pine known at nfra and wsrt -# -if (("$n_site" == nfra ) || ("$n_site" == wsrt )) then - alias nsmail "pine -I ^X,y -subject " -endif - -# -# Read the local compiler settings from various files -# -if (-e $n_src/sys/i_$n_arch.csh) source $n_src/sys/i_$n_arch.csh -if (-e $n_src/sys/i_$n_site.csh) source $n_src/sys/i_$n_site.csh -if (-e $n_src/sys/i_$n_arch$n_site.csh) source $n_src/sys/i_$n_arch$n_site.csh -if ($?n_usrc) then - if ($n_usrc != $n_src) then - if (-e $n_usrc/sys/i_$n_arch.csh) source $n_usrc/sys/i_$n_arch.csh - if (-e $n_usrc/sys/i_$n_site.csh) source $n_usrc/sys/i_$n_site.csh - if (-e $n_usrc/sys/i_$n_arch$n_site.csh) source $n_usrc/sys/i_$n_arch$n_site.csh - endif -endif -if (-e i_$n_arch.csh) source i_$n_arch.csh - -# -# Construct the date/time strings, get current version, define logfile -# -set Myname=`awk -F: '{ if ($1 == "'$USER'") print $5 }' /etc/passwd` -if ("$Myname" == "") set Myname=`whoami` - -set dt = (`date`) -if ("$dt[3]" =~ [1-9]) set dt[3] = "0$dt[3]" # day -set mc=( Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec) -foreach mm ( 01 02 03 04 05 06 07 08 09 10 11 12) - if ("$dt[2]" == "$mc[$mm]") break # month -end -@ yy = $dt[$#dt] - 1900 # year -set mh=( `echo $dt[4] | tr -s ":" " "` ) # hh mm ss -set C_Date="$yy$mm$dt[3]" # date: yymmdd -set C_Time="$mh[1]$mh[2]" # time: hhmm -unset dt mc mm yy mh - -set C_Version=$C_Date -if (-e $n_src/sys/version.idx) then - set tmp=(`head -1 $n_src/sys/version.idx`) - if ($#tmp > 2) then - if ("$tmp[3]" != "") set C_Version=$tmp[3] - endif -endif - -set Logfile=$n_src/upd${C_Date}${n_arch}.log -@ ii = 0 -while (-e $Logfile) - @ ii = $ii + 1 - set Logfile=$n_src/upd${C_Date}${n_arch}$ii.log -end -unset ii - -if ("`alias log`" == "") alias log echo - -# -# Default some things to the current directory -# -if (! $?n_uexe) set n_uexe=$cwd -if (! $?n_ulib) set n_ulib=$cwd -if (! $?n_work) set n_work=$cwd -if (! $?n_usrc) set n_usrc=__undefined__ - -# -# For proper linking, it is quite essential that all files in $n_inc -# have been properly linked into $n_uinc. If there are no files there, -# just move to the master system $n_inc. -# -if (! $?n_uinc) set n_uinc=$n_inc -if ($n_uinc != $n_inc) then - if (! -d $n_uinc || ! -e $n_uinc/WNG_DEF) then - log "%%%%%% Warning; no WNG_DEF in "\$n_uinc - endif -endif - -# -# Set temporary file, tell what we are doing -# -set Name=$0; -set Name=$Name:t -set Tmpfile=$n_work/${Name:r}$$.tmp -log "Running $Name for $n_site ($n_arch) on $HOST at $C_Date/$C_Time" -unset Name diff --git a/src/sys/ionos.c b/src/sys/ionos.c deleted file mode 100644 index d6fb28382ddcce4ec0f0d98f007d3f6bf1dce440..0000000000000000000000000000000000000000 --- a/src/sys/ionos.c +++ /dev/null @@ -1,526 +0,0 @@ -/* - ionos.c - Simple program for entry of f0f2 values - - Syntax: ionos.exe [input_file] | scissor.exe - - Input file can be either according to the Meudon standard - or a simple list with values per hour. The file has to start - with a header-line "f0f2 station_name dd/mm/yyyy hh:mm:ss", e.g. - - f0f2 havelte 27/02/1995 00:07:00 - - and should further contain values in 0.1 MHz separated by commas - or whitespace. Two commas indicate a missing value for that hour. - Additional header lines start a new series of values. - - For entry of ypf2 values, use simple list files with header lines - containing ypf2 instead of f0f2. - - If no input file is given, standard input is read with appropriate - prompting to stderr. - - Output is in the form of Scissor commands to stdout. - - - Syntax: scissor.exe select=f0f2 date=dd/mm/yyyy | ionos.exe -w - - The program will create an output file f2MONyy.01 suitable for - processing by program ionost.exe - - - Revision: - 950821 CMV Initial version - 960130 CMV Changed averaging in make_ionos_file (first days, then hrs) -*/ - -#include <stdio.h> -#include <stdlib.h> -#include <string.h> - -#define MEUDON_FLAG "UFOFH " -#define MEUDON_YR "199" /* Stupid notation... */ - -#define MAXSTRING 1024 - -static char line[MAXSTRING]; - -#define find_space(p) { while (*p!='\0' && *p!='\n' && *p!=' ' && *p!='\t') p++; } -#define find_cspace(p) { while (*p!='\0' && *p!='\n' && *p!=' ' && *p!='\t' && *p!=',') p++; } -#define skip_space(p) { while (*p==' ' || *p=='\t' || *p=='\n') p++; } - - -/* - Some general routines for dates -*/ -static int dpm[]={ 0, 31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31}; -static char *nom[]={"???","jan","feb","mar","apr","may","jun","jul","aug","sep","oct","nov","dec"}; - - -static char *mon(mm) - -int mm; - -{ - if (mm<0 || mm>12) mm=0; - return(nom[mm]); -} - - -static int days(mm,yy) - -int mm,yy; - -{ - if (mm<0 || mm>12) { - return(0); - } else if (mm==2 && yy%4 == 0 && yy%100 !=0) { - return(dpm[mm]+1); - } else { - return(dpm[mm]); - } -} - -static void next_day(p) char *p; - -{ - int dy,mm,yy; - - dy=atoi(p); - mm=atoi(p+3); - yy=atoi(p+6); - dy++; - if (dy>days(mm,yy)) mm++; - if (mm>12) yy++; - sprintf(p,"%2.2d/%2.2d/%4.4d",dy,mm,yy); -} - - - -main(argc,argv) - -int argc; -char **argv; - -{ - - - if (argc>1 && *argv[1]=='-' && argv[1][1]=='w') { - - write_ionos_file(argv[2],argv[3]); - - } else if (argc>1 && is_meudon_type(argv[1])) { - - read_meudon_type(argv[1]); - - } else if (argc>1 && is_list_file(argv[1])) { - - read_list(argv[1]); - - } else { - - read_list(NULL); - - } - -} - - -int is_meudon_type(file) - -char *file; - -{ - int found=0; - FILE *fp; - - fp=fopen(file,"r"); - if (fp!=NULL) { - - while (!found && fgets(line,MAXSTRING,fp)!=NULL) { - char *p=line; - skip_space(p); - found=(!strncasecmp(p,MEUDON_FLAG,strlen(MEUDON_FLAG))); - } - - fclose(fp); - - } - - return(found); -} - - -/* - Definition of states -*/ -#define _FIND_ID 0 -#define _FIND_STATION 1 -#define _FIND_DATE 2 -#define _FIND_TIME 3 -#define _GET_VALUES 4 -#define _FOUND_END 5 - - -int read_meudon_type(file) - -char *file; - -{ - char station[MAXSTRING]; - char date[12]; - char time[12]; - - int state=_FIND_ID; - int count=0; - - FILE *fp; - - fp=fopen(file,"r"); - if (fp==NULL) { - fprintf(stderr,"Cannot open Meudon-format file %s\n",file); - return(count); - } - - /* - Read lines until done of end-of-file found - */ - while (state!=_FOUND_END && fgets(line,MAXSTRING,fp)!=NULL) { - char *p=line; - - skip_space(p); - - /* - Handle the words on each line - */ - while (state!=_FOUND_END && *p!='\0') { - - - if (state==_FIND_ID) { - if (!strncasecmp(p,MEUDON_FLAG,strlen(MEUDON_FLAG))) - state=_FIND_STATION; - - } else if (state==_FIND_STATION) { - char *q=station; - state=_FIND_DATE; - strcpy(station,p); - find_space(q); - *q='\0'; - - } else if (state==_FIND_DATE) { - state=_FIND_TIME; - sprintf(date,"%c%c/%c%c/%s%c",p[3],p[4],p[1],p[2],MEUDON_YR,*p); - - } else if (state==_FIND_TIME) { - if (*p!='/') { - state=_FOUND_END; - fprintf(stderr,"Invalid Meudon-format file..."); - } else { - state=_GET_VALUES; - sprintf(time,"%c%c:%c%c:00",p[1],p[2],p[3],p[4]); - } - - } else if (state==_GET_VALUES) { - if (*p<'0' || *p>'9') { - state=_FIND_ID; - } else { - if (*p<time[1]) time[0]++; - time[1]=(*p); - if (time[0]>'2') { time[0]='0'; next_day(date); } - if (p[1]>='0' && p[1]<='9' && - p[2]>='0' && p[2]<='9' && - p[3]>='0' && p[3]<='9') - printf("PUT=F0F2 STATION=%s DATE=%s TIME=%s F0F2=%c%c%c\n", - station,date,time,p[1],p[2],p[3]); - count++; - } - } - - find_space(p); skip_space(p); - - } - - } - - fclose(fp); - fprintf(stderr,"Total of %d values written for %s.\n",count,station); - return(count); -} - - -int is_list_file(file) - -char *file; - -{ - int found=0; - FILE *fp; - - fp=fopen(file,"r"); - if (fp!=NULL && fgets(line,MAXSTRING,fp)!=NULL) { - found=(!strncasecmp(line,"f0f2 ",5) || - !strncasecmp(line,"ypf2 ",5)); - fclose(fp); - } - - return(found); -} - - -/* - Definition of states -*/ -#define _READ_HEADER 0 -#define _PARSE_HEADER 1 -#define _READ_VALUES 2 -#define _PARSE_VALUES 3 -#define _DONE_FILE 4 - -int read_list(file) - -char *file; - -{ - char station[MAXSTRING]; - char date[12]; - char time[12]; - char *view=NULL; - - int state=_READ_HEADER; - int count=0; - - char *word; - FILE *fp; - - if (file!=NULL) { - fp=fopen(file,"r"); - if (fp==NULL) { - fprintf(stderr,"Cannot open f0f2 list %s.\n",file); - return(count); - } - } else { - fp=stdin; - } - - - while (state!=_DONE_FILE) { - - if (state==_READ_HEADER) { - - if (fp==stdin) - fprintf(stderr,"Enter station, date (dd/mm/yyyy), time (hh:mm): "); - if (fgets(line,MAXSTRING,fp)==NULL) { - fprintf(stderr,"Cannot read header line\n"); - state=_DONE_FILE; - } else if (fp!=stdin && strncasecmp(line,"f0f2 ",5) && - strncasecmp(line,"ypf2 ",5)) { - fprintf(stderr,"Invalid header line\n"); - } else { - state=_PARSE_HEADER; - } - - - } else if (state==_READ_VALUES) { - - if (fp==stdin) - fprintf(stderr,"Enter f0f2 values (MHz, comma separated): "); - if (fgets(line,MAXSTRING,fp)==NULL) { - state=_DONE_FILE; - } else if (!strncasecmp(line,"f0f2 ",5)) { - fprintf(stderr,"New header line!\n"); - state=_PARSE_HEADER; - } else { - word=line; - state=_PARSE_VALUES; - } - - } else if (state==_PARSE_HEADER) { - - char *p=line; - skip_space(p); - - if (!strncmp(p,"ypf2",4)) { - view="YPF2"; - find_space(p); skip_space(p); - } else { - view="F0F2"; - if (!strncmp(p,"f0f2",4)) { find_space(p); skip_space(p); }; - } - - if (*p=='\0') { - fprintf(stderr,"Missing station and date on header line\n"); - state=_READ_HEADER; - } else { - char *q=station; - strcpy(station,p); - find_cspace(q); - *q='\0'; - find_cspace(p); - if (*p==',') p++; - skip_space(p); - } - - if (state!=_PARSE_HEADER || *p=='\0' || p[2]!='/' || p[5]!='/') { - if (state==_PARSE_HEADER) - fprintf(stderr,"Missing or invalid date on header line\n"); - state=_READ_HEADER; - } else { - strncpy(date,p,10); - date[10]='\0'; - find_cspace(p); - if (*p==',') p++; - skip_space(p); - } - - if (state!=_PARSE_HEADER || *p=='\0' || p[2]!=':') { - if (state==_PARSE_HEADER) - fprintf(stderr,"Missing or invalid time on header line\n"); - state=_READ_HEADER; - } else { - strncpy(time,p,5); - time[5]='\0'; - strcat(time,":00"); - state=_READ_VALUES; - } - - } else if (state==_PARSE_VALUES) { - skip_space(word); - - if (*word=='\0') { /* End of current line */ - state=_READ_VALUES; - } else { - if (*word!=',') { /* Not an empty field */ - double val; - val=atof(word); - printf("PUT=%s STATION=%s DATE=%s TIME=%s F0F2=%f\n", - view,station,date,time,val*10.); - count++; - - /* - Words may be separated by a comma or by whitespace. - The comma may be surrounded by whitespace. - */ - find_cspace(word); - if (*word==',') { - word++; - } else { - skip_space(word); - if (*word==',') word++; - } - } else { - word++; /* Just skip the comma */ - } - - /* - Prepare for next value - */ - if (time[1]++ == '9') { time[1]='0'; time[0]++; } - if (time[0]>'2') { time[0]='0'; next_day(date); } - - - } - - } - } - - if (fp!=stdin) fclose(fp); - fprintf(stderr,"Total of %d values written.\n",count); - return(count); - -} - -#define NDAY 33 -#define NHR 24 - -int write_ionos_file(yy,mm) - -char *yy,*mm; - -{ - FILE *fp; - short xday[NDAY]; - short f0f2[NHR][NDAY]; - short ypf2[NHR][NDAY]; - int nf0f2[NHR][NDAY]; - int nypf2[NHR][NDAY]; - - int year,month,iday,nday,ihr; - - for (iday=0; iday<NDAY; iday++) { - xday[iday]=0; - for (ihr=0; ihr<NHR; ihr++) { - f0f2[ihr][iday]=ypf2[ihr][iday]=nf0f2[ihr][iday]=nypf2[ihr][iday]=0; - } - } - - year=atoi(yy); - month=atoi(mm); - if (year<1900 || year>3000) { - fprintf(stderr,"Invalid year %d.\n",year); - return(0); - } else if (month<1 || month>12) { - fprintf(stderr,"Invalid month %d.\n",month); - return(0); - } - - sprintf(line,"f2%s%2.2d.01",mon(month),year%100); - fp=fopen(line,"wb"); - if (fp==NULL) { - fprintf(stderr,"Error: cannot open f0f2-file %s.\n",line); - return(0); - } - - nday=days(month,year); - for (iday=0; iday<=nday; iday++) xday[iday]=iday; - - while (fgets(line,MAXSTRING,stdin)!=NULL) { - char *p; - - p=strstr(line,"DATE="); - if (p!=NULL && atoi(p+8)==month && atoi(p+11)==year) { - iday=atoi(p+5); - p=strstr(line,"TIME="); - if (p!=NULL) { - ihr=atoi(p+5); - - p=strstr(line,"F0F2="); - if (p!=NULL) { - f0f2[ihr][iday]= - ( (f0f2[ihr][iday]*nf0f2[ihr][iday]) + atoi(p+5) ) / - (nf0f2[ihr][iday]+1) ; - nf0f2[ihr][iday]++; - } - - p=strstr(line,"YPF2="); - if (p!=NULL) { - ypf2[ihr][iday]= - ( (ypf2[ihr][iday]*nypf2[ihr][iday]) + atoi(p+5) ) / - (nypf2[ihr][iday]+1) ; - nypf2[ihr][iday]++; - } - } - } - } - - for (iday=1; iday<=nday; iday++) { - for (ihr=0; ihr<NHR; ihr++) { - if (f0f2[ihr][iday]==0) { - if (iday>1 && f0f2[ihr][iday-1]!=0) { - f0f2[ihr][iday]=f0f2[ihr][iday-1]; - } else if (iday<nday && f0f2[ihr][iday+1]!=0) { - f0f2[ihr][iday]=f0f2[ihr][iday+1]; - } else if (ihr>0 && ihr<NHR-1 && - f0f2[ihr-1][iday]!=0 && f0f2[ihr+1][iday]!=0) { - f0f2[ihr][iday]=(f0f2[ihr-1][iday]+f0f2[ihr-1][iday])/2; - } - } - if (ypf2[ihr][iday]==0) ypf2[ihr][iday]=100; - } - } - - fwrite(xday,sizeof(short),NDAY,fp); - fwrite(f0f2,sizeof(short),NDAY*NHR,fp); - fwrite(ypf2,sizeof(short),NDAY*NHR,fp); - fwrite(xday,sizeof(short),1,fp); - fwrite(xday,sizeof(short),1,fp); - fclose(fp); -} diff --git a/src/sys/ionost.pin b/src/sys/ionost.pin deleted file mode 100644 index 9a93c2855806a273488ecee72cf5aa53a26d1703..0000000000000000000000000000000000000000 --- a/src/sys/ionost.pin +++ /dev/null @@ -1,215 +0,0 @@ -! -! 16 March 1990 IONOST.PIN -! ****** VAX 3400 ****** -! -!............................................................ -! -KEYWORD=SOURCE_NAME - DATA_TYPE=C - LENGTH=12 - IO=I - SEARCH=LOCAL,GLOBAL,PROGRAM - HELP=" - Specify the source name for which the ionosphere corrections have - to be calculated" -KEYWORD=DAY_NUMBER - DATA_TYPE=J - IO=I - DEFAULTS="0 /ASK" - SEARCH=LOCAL,GLOBAL,PROGRAM - HELP=" - day number for which the calculations have to be done. The format is - as YYMMDD, where YY is the year - 1900, MM the month number in the - year and DD the daynumber in the month. Several dates may be specified: - Specify after the last day wanted a "0" (= zero) - then the program - will exit after the last calculations needed." -KEYWORD=LONGITUDE_OBS - DATA_TYPE=D - IO=I - DEFAULTS="6.6041694 /NOASK" - SEARCH=LOCAL,GLOBAL,PROGRAM - HELP=" - Geographic longitude observatory (in degrees)" -KEYWORD=LATITUDE_OBS - DATA_TYPE=D - IO=I - DEFAULTS="52.9169152 /NOASK" - SEARCH=LOCAL,GLOBAL,PROGRAM - HELP=" - Geographic latitude observatory (in degrees)" -KEYWORD=LONGITUDE_STAT - DATA_TYPE=D - IO=I - DEFAULTS="5.18 /NOASK" - SEARCH=LOCAL,GLOBAL,PROGRAM - HELP=" - Geographic longitude ionosphere station (in degrees)" -KEYWORD=LATITUDE_STAT - DATA_TYPE=D - IO=I - DEFAULTS="52.10 /NOASK" - SEARCH=LOCAL,GLOBAL,PROGRAM - HELP=" - Geographic latitude ionosphere station (in degrees)" -KEYWORD=FREQUENCY - DATA_TYPE=D - IO=I - SEARCH=LOCAL,GLOBAL,PROGRAM - HELP=" - Observing frequency in MHz" -KEYWORD=RIGHT_ASCENSION - DATA_TYPE=D - IO=I - SEARCH=LOCAL,GLOBAL,PROGRAM - HELP=" - Right Ascension of source for which ionosphere corrections have - to calculated: the value should be given in degrees" -KEYWORD=DECLINATION - DATA_TYPE=D - IO=I - SEARCH=LOCAL,GLOBAL,PROGRAM - HELP=" - Declination of source for which ionosphere corrections have - to calculated: the value should be given in degrees" -KEYWORD=CORRECTIONS - DATA_TYP=C - LENGTH=5 - NVALUES=2 - SWITCH=LOOP - CHECKS=ABBREV_OPTION - OPTION=VLBI,RIF,FAR,DELAY - SEARCH=L,G,P - DEFAULTS="RIF,FAR /NOASK" - PROMPT="(Corrections to be calculated)" - HELP=" - Corrections which should be calculated: - VLBI: VLBI refraction corrections are calculated - RIF: corrections for ionospheic refraction are calculated - FAR: corrections for Faraday rotation are calculated - DELAY: corrections for path length errors are calculated" -KEYWORD=FARADAY_INPUT - DATA_TYP=C - IO=I - LENGTH=3 - SWITCH=LOOP - CHECKS=ABBREV_OPTIONS - SEARCH=L,G,P - DEFAULTS="NO /NOASK" - OPTIONS=YES,NO - PROMPT="(Is Faraday rotation input required?)" - HELP=" - Faraday input flag: = NO no input data for Faraday rotation are used - = YES input data for Faraday rotation are used" -KEYWORD=CHANGE_F0F2_INP - DATA_TYP=C - IO=I - LENGTH=3 - SWITCH=LOOP - CHECKS=ABBREV_OPTIONS - SEARCH=L,G,P - DEFAULTS="NO /NOASK" - OPTIONS=YES,NO - PROMPT="(Should foF2 input data be changed?)" - HELP=" - change f0F2 input data by used input Faraday rotation data flag: - = NO no change by using ionospheric Faraday rotation - input - = YES change by using ionospheric Faraday rotation - input" -KEYWORD=SRCE_ALTAZ_FIXED - DATA_TYP=C - IO=I - LENGTH=3 - SWITCH=LOOP - CHECKS=ABBREV_OPTIONS - SEARCH=L,G,P - DEFAULTS="NO /NOASK" - OPTIONS=YES,NO - PROMPT="(Is source fixed in altazimuth coordinates?)" - HELP=" - source position flag: = NO source not fixed in altazimuth coordinates - = YES source fixed in altazimtuh coordinates" -KEYWORD=GEOMETRY - DATA_TYP=C - LENGTH=8 - NVALUES=2 - SWITCH=LOOP - CHECKS=ABBREV_OPTION - OPTION=FIXED,VARIABLE,DEFAULT - SEARCH=L,G,P - DEFAULTS="FIXED,DEFAULT /NOASK" - PROMPT="(Geometry selection)" - HELP=" - The following options for geometry selection are valid: - FIXED: fixed ionosphere geometry is taken - VARIABLE: variable ionosphere geometry is taken - DEFAULT: default ionosphere is taken" -KEYWORD=F2_BOTTOM_HEIGHT - DATA_TYPE=D - IO=I - DEFAULTS="6440.0 /ASK" - SEARCH=LOCAL,GLOBAL,PROGRAM - HELP=" - Altitude of the bottomside of the F2-layer (in km)" -KEYWORD=F2_P1_HEIGHT - DATA_TYPE=D - IO=I - DEFAULTS="6470.0 /ASK" - SEARCH=LOCAL,GLOBAL,PROGRAM - HELP=" - Altitude of the P1 height of the F2-layer (in km) [see ITR-162]" -KEYWORD=F2_MAX_HEIGHT - DATA_TYPE=D - IO=I - DEFAULTS="6770.0 /ASK" - SEARCH=LOCAL,GLOBAL,PROGRAM - HELP=" - Altitude of the maximum electron density in the F2-layer (in km)" -KEYWORD=F2_P2_HEIGHT - DATA_TYPE=D - IO=I - DEFAULTS="7035.0 /ASK" - SEARCH=LOCAL,GLOBAL,PROGRAM - HELP=" - Altitude of the P2 height of the F2-layer (in km) [see ITR-162]" -KEYWORD=F2_TOP_HEIGHT - DATA_TYPE=D - IO=I - DEFAULTS="7570.0 /ASK" - SEARCH=LOCAL,GLOBAL,PROGRAM - HELP=" - Altitude of the topside of the F2-layer (in km)" -KEYWORD=UT_TIME - DATA_TYPE=I - IO=I - DEFAULTS="-32767 /ASK" - SEARCH=LOCAL,GLOBAL,PROGRAM - HELP=" - Universal Time of observations Faraday rotation [in hours and - fractions of hours - i.e. hh.hhh]. If no more values are given: - specify <CR>." -KEYWORD=OBSERVED_FAR_ROT - DATA_TYPE=D - IO=I - SEARCH=LOCAL,GLOBAL,PROGRAM - HELP=" - Observed Faraday rotation values at moments UT_TIME (in degrees)" -KEYWORD=NR_180_DEG_STEPS - DATA_TYPE=I - IO=I - SEARCH=LOCAL,GLOBAL,PROGRAM - HELP=" - Number of 180 degree steps in Faraday rotation data at UT_TIME" -KEYWORD=NEXT_DAY - DATA_TYP=C - IO=I - LENGTH=3 - SWITCH=LOOP - CHECKS=ABBREV_OPTIONS - SEARCH=L,G,P - DEFAULTS="NO /NOASK" - OPTIONS=YES,NO - PROMPT="(Next day flag)" - HELP=" - next day flag: = NO data not for next day - = YES data for next day." diff --git a/src/sys/lock.idx b/src/sys/lock.idx deleted file mode 100644 index 45856395f327e2892e096b638aee28499940226e..0000000000000000000000000000000000000000 --- a/src/sys/lock.idx +++ /dev/null @@ -1,54 +0,0 @@ -+nplot/ngc.dsc locked User=jph Date=950818/1144 -+nplot/ngcalc.for locked User=jph Date=950818/1144 -+nplot/ngcbas.for locked User=jph Date=950818/1144 -+nplot/ngccop.for locked User=jph Date=950818/1145 -+nplot/ngcdat.for locked User=jph Date=950818/1145 -+nplot/ngcexc.for locked User=jph Date=950818/1145 -+nplot/ngcexn.for locked User=jph Date=950818/1145 -+nplot/ngcexp.for locked User=jph Date=950818/1145 -+nplot/ngcext.for locked User=jph Date=950818/1145 -+nplot/ngcini.for locked User=jph Date=950818/1145 -+nplot/ngcmon.for locked User=jph Date=950818/1145 -+nplot/ngcnvs.for locked User=jph Date=950818/1145 -+nplot/ngcpbr.for locked User=jph Date=950818/1145 -+nplot/ngcpfl.for locked User=jph Date=950818/1146 -+nplot/ngcpmh.for locked User=jph Date=950818/1146 -+nplot/ngcsph.for locked User=jph Date=950818/1146 -+nplot/ngctrp.for locked User=jph Date=950818/1146 -+nplot/ngcxcv.for locked User=jph Date=950818/1146 -+nplot/ngfsets.pef locked User=jph Date=950818/1146 -+doc/latex/scn_summary.tef locked User=jph Date=950918/1043 -+sys/doc_script.c locked User=jph Date=951123/1131 -+sys/doc_script.csh locked User=jph Date=951123/1131 -+nplot/ngcalc.psc locked User=jph Date=960102/1226 -+nplot/ngccob.for locked User=jph Date=960102/1226 -+nplot/ngcprt.for locked User=jph Date=960503/1413 -+doc/latex/ncalib_polar.tex locked User=jph Date=970404/1143 -+doc/latex/hb_cook_preamble.sty locked User=jph Date=970404/1149 -+sys/doc_print.csh locked User=jph Date=970404/1216 -+sys/doc_cook.csh locked User=jph Date=970404/1216 -+sys/doc_preprocess.csh locked User=jph Date=970429/1504 -+wng/wnm.grp locked User=wnb Date=970529/1327 -+nplot/nplot.for locked User=jph Date=970819/1426 -+nplot/npllod.for locked User=jph Date=970819/1426 -+nplot/nplmap.fsc locked User=jph Date=970819/1426 -+nplot/nplplt.for locked User=jph Date=970819/1426 -+nplot/nplres.for locked User=jph Date=970819/1426 -+wng/wndpar.cun locked User=jph Date=970819/1518 -+nscan/nscuvf.for locked User=devoscm Date=970925/0620 -+sys/batch_ask.c locked User=jph Date=971027/1631 -+nscan/nscdat.for locked User=devoscm Date=991102/1234 -+sys/i_sorug.csh imported User=devoscm Date=1001004/1946 -+sys/genaid.c imported User=coolen Date=1001006/1438 -+nscan/nscgif.for locked User=devoscm Date=1001101/1202 -+wng/wndnod.for imported User=devoscm Date=1001107/1000 -+nscan/nscggn.for imported User=devoscm Date=1001215/0947 -+ncopy/ncocpy.for locked User=devoscm Date=1041102/2121 -+nscan/nscscw.for locked User=devoscm Date=1041102/2124 -+nmap/nmatrp.for locked User=newstar Date=1041104/2010 -+nmap/nmacvx.for locked User=newstar Date=1041104/2030 -+nmap/nmasor.for locked User=newstar Date=1041104/2110 -+nmap/nmajsl.for locked User=newstar Date=1041104/2117 -+nmap/nmascn.for locked User=newstar Date=1041104/2120 -+nmap/nclean.psc locked User=newstar Date=1050117/1107 -+nmap/nmap.psc locked User=newstar Date=1050117/1119 diff --git a/src/sys/n_links.com b/src/sys/n_links.com deleted file mode 100644 index bde6176925b222e1c0a0401eec0ba7f9ef3456a7..0000000000000000000000000000000000000000 --- a/src/sys/n_links.com +++ /dev/null @@ -1,258 +0,0 @@ -$ !01 N_LINKS.COM created on robin at 940601 -$ ASSIGN/NOLOG "N_ROOT:[LIB.INC]BLDPPD_2_DEF." BLDPPD_2_DEF ! 940622 -$ ASSIGN/NOLOG "N_ROOT:[LIB.INC]CLI_1_DEF." CLI_1_DEF ! 940622 -$ ASSIGN/NOLOG "N_ROOT:[LIB.INC]CPL_2_DEF." CPL_2_DEF ! 940622 -$ ASSIGN/NOLOG "N_ROOT:[LIB.INC]DWARF_4_DEF." DWARF_4_DEF ! 940622 -$ ASSIGN/NOLOG "N_ROOT:[LIB.INC]DWC_DEF." DWC_DEF ! 940622 -$ ASSIGN/NOLOG "N_ROOT:[LIB.INC]FBC_E_DEF." FBC_E_DEF ! 940622 -$ ASSIGN/NOLOG "N_ROOT:[LIB.INC]FBC_O_DEF." FBC_O_DEF ! 940622 -$ ASSIGN/NOLOG "N_ROOT:[LIB.INC]FBC_T_DEF." FBC_T_DEF ! 940622 -$ ASSIGN/NOLOG "N_ROOT:[LIB.INC]FCA_E_DEF." FCA_E_DEF ! 940622 -$ ASSIGN/NOLOG "N_ROOT:[LIB.INC]FCA_O_DEF." FCA_O_DEF ! 940622 -$ ASSIGN/NOLOG "N_ROOT:[LIB.INC]FCA_T_DEF." FCA_T_DEF ! 940622 -$ ASSIGN/NOLOG "N_ROOT:[LIB.INC]FCQ_DEF." FCQ_DEF ! 940622 -$ ASSIGN/NOLOG "N_ROOT:[LIB.INC]FEL_E_DEF." FEL_E_DEF ! 940622 -$ ASSIGN/NOLOG "N_ROOT:[LIB.INC]FEL_O_DEF." FEL_O_DEF ! 940622 -$ ASSIGN/NOLOG "N_ROOT:[LIB.INC]FEL_T_DEF." FEL_T_DEF ! 940622 -$ ASSIGN/NOLOG "N_ROOT:[LIB.INC]MCA_E_DEF." MCA_E_DEF ! 940622 -$ ASSIGN/NOLOG "N_ROOT:[LIB.INC]MCA_O_DEF." MCA_O_DEF ! 940622 -$ ASSIGN/NOLOG "N_ROOT:[LIB.INC]MCA_T_DEF." MCA_T_DEF ! 940622 -$ ASSIGN/NOLOG "N_ROOT:[LIB.INC]NSTAR_DSF." NSTAR_DSF ! 940622 -$ ASSIGN/NOLOG "N_ROOT:[LIB.INC]PARM_6_DEF." PARM_6_DEF ! 940622 -$ ASSIGN/NOLOG "N_ROOT:[LIB.INC]PPDREC_4_DEF." PPDREC_4_DEF ! 940622 -$ ASSIGN/NOLOG "N_ROOT:[LIB.INC]PPDSTAT_2_DEF." PPDSTAT_2_DEF ! 940622 -$ ASSIGN/NOLOG "N_ROOT:[LIB.INC]SSH_DSF." SSH_DSF ! 940622 -$ ASSIGN/NOLOG "N_ROOT:[LIB.INC]WNC_DEF." WNC_DEF ! 940622 -$ ASSIGN/NOLOG "N_ROOT:[LIB.INC]WND_DEF." WND_DEF ! 940622 -$ ASSIGN/NOLOG "N_ROOT:[LIB.INC]WNG_DEF." WNG_DEF ! 940622 -$ ASSIGN/NOLOG "N_ROOT:[LIB.INC]WNT_DEF." WNT_DEF ! 940622 -$ ASSIGN/NOLOG "N_ROOT:[LIB.INC]WNT_E_DEF." WNT_E_DEF ! 940622 -$ ASSIGN/NOLOG "N_ROOT:[LIB.INC]WNT_O_DEF." WNT_O_DEF ! 940622 -$ ASSIGN/NOLOG "N_ROOT:[LIB.INC]WNT_T_DEF." WNT_T_DEF ! 940622 -$ ASSIGN/NOLOG "N_ROOT:[LIB.INC]WXH_DEF." WXH_DEF ! 940622 -$ ASSIGN/NOLOG "N_ROOT:[LIB.INC]bmd.def" BMD_DEF ! 940622 -$ ASSIGN/NOLOG "N_ROOT:[LIB.INC]bmd.inc" bmd_inc ! 940622 -$ ASSIGN/NOLOG "N_ROOT:[LIB.INC]cbits.def" CBITS_DEF ! 940622 -$ ASSIGN/NOLOG "N_ROOT:[LIB.INC]cbits.inc" cbits_inc ! 940622 -$ ASSIGN/NOLOG "N_ROOT:[LIB.INC]dwe.def" DWE_DEF ! 940622 -$ ASSIGN/NOLOG "N_ROOT:[LIB.INC]dwe.inc" dwe_inc ! 940622 -$ ASSIGN/NOLOG "N_ROOT:[LIB.INC]fbc_e_inc." fbc_e_inc ! 940622 -$ ASSIGN/NOLOG "N_ROOT:[LIB.INC]fbc_o_inc." fbc_o_inc ! 940622 -$ ASSIGN/NOLOG "N_ROOT:[LIB.INC]fbc_t_inc." fbc_t_inc ! 940622 -$ ASSIGN/NOLOG "N_ROOT:[LIB.INC]fca_e_inc." fca_e_inc ! 940622 -$ ASSIGN/NOLOG "N_ROOT:[LIB.INC]fca_o_inc." fca_o_inc ! 940622 -$ ASSIGN/NOLOG "N_ROOT:[LIB.INC]fca_t_inc." fca_t_inc ! 940622 -$ ASSIGN/NOLOG "N_ROOT:[LIB.INC]fcq_inc." fcq_inc ! 940622 -$ ASSIGN/NOLOG "N_ROOT:[LIB.INC]fdw_e.def" FDW_E_DEF ! 940622 -$ ASSIGN/NOLOG "N_ROOT:[LIB.INC]fdw_e.inc" fdw_e_inc ! 940622 -$ ASSIGN/NOLOG "N_ROOT:[LIB.INC]fdw_o.def" FDW_O_DEF ! 940622 -$ ASSIGN/NOLOG "N_ROOT:[LIB.INC]fdw_o.inc" fdw_o_inc ! 940622 -$ ASSIGN/NOLOG "N_ROOT:[LIB.INC]fdw_t.def" FDW_T_DEF ! 940622 -$ ASSIGN/NOLOG "N_ROOT:[LIB.INC]fdw_t.inc" fdw_t_inc ! 940622 -$ ASSIGN/NOLOG "N_ROOT:[LIB.INC]fdx_e.def" FDX_E_DEF ! 940622 -$ ASSIGN/NOLOG "N_ROOT:[LIB.INC]fdx_e.inc" fdx_e_inc ! 940622 -$ ASSIGN/NOLOG "N_ROOT:[LIB.INC]fdx_o.def" FDX_O_DEF ! 940622 -$ ASSIGN/NOLOG "N_ROOT:[LIB.INC]fdx_o.inc" fdx_o_inc ! 940622 -$ ASSIGN/NOLOG "N_ROOT:[LIB.INC]fdx_t.def" FDX_T_DEF ! 940622 -$ ASSIGN/NOLOG "N_ROOT:[LIB.INC]fdx_t.inc" fdx_t_inc ! 940622 -$ ASSIGN/NOLOG "N_ROOT:[LIB.INC]fel_e_inc." fel_e_inc ! 940622 -$ ASSIGN/NOLOG "N_ROOT:[LIB.INC]fel_o_inc." fel_o_inc ! 940622 -$ ASSIGN/NOLOG "N_ROOT:[LIB.INC]fel_t_inc." fel_t_inc ! 940622 -$ ASSIGN/NOLOG "N_ROOT:[LIB.INC]flf_e.def" FLF_E_DEF ! 940622 -$ ASSIGN/NOLOG "N_ROOT:[LIB.INC]flf_e.inc" flf_e_inc ! 940622 -$ ASSIGN/NOLOG "N_ROOT:[LIB.INC]flf_o.def" FLF_O_DEF ! 940622 -$ ASSIGN/NOLOG "N_ROOT:[LIB.INC]flf_o.inc" flf_o_inc ! 940622 -$ ASSIGN/NOLOG "N_ROOT:[LIB.INC]flf_t.def" FLF_T_DEF ! 940622 -$ ASSIGN/NOLOG "N_ROOT:[LIB.INC]flf_t.inc" flf_t_inc ! 940622 -$ ASSIGN/NOLOG "N_ROOT:[LIB.INC]flh_e.def" FLH_E_DEF ! 940622 -$ ASSIGN/NOLOG "N_ROOT:[LIB.INC]flh_e.inc" flh_e_inc ! 940622 -$ ASSIGN/NOLOG "N_ROOT:[LIB.INC]flh_o.def" FLH_O_DEF ! 940622 -$ ASSIGN/NOLOG "N_ROOT:[LIB.INC]flh_o.inc" flh_o_inc ! 940622 -$ ASSIGN/NOLOG "N_ROOT:[LIB.INC]flh_t.def" FLH_T_DEF ! 940622 -$ ASSIGN/NOLOG "N_ROOT:[LIB.INC]flh_t.inc" flh_t_inc ! 940622 -$ ASSIGN/NOLOG "N_ROOT:[LIB.INC]gfh_e.def" GFH_E_DEF ! 940622 -$ ASSIGN/NOLOG "N_ROOT:[LIB.INC]gfh_e.inc" gfh_e_inc ! 940622 -$ ASSIGN/NOLOG "N_ROOT:[LIB.INC]gfh_o.def" GFH_O_DEF ! 940622 -$ ASSIGN/NOLOG "N_ROOT:[LIB.INC]gfh_o.inc" gfh_o_inc ! 940622 -$ ASSIGN/NOLOG "N_ROOT:[LIB.INC]gfh_t.def" GFH_T_DEF ! 940622 -$ ASSIGN/NOLOG "N_ROOT:[LIB.INC]gfh_t.inc" gfh_t_inc ! 940622 -$ ASSIGN/NOLOG "N_ROOT:[LIB.INC]ifh_e.def" IFH_E_DEF ! 940622 -$ ASSIGN/NOLOG "N_ROOT:[LIB.INC]ifh_e.inc" ifh_e_inc ! 940622 -$ ASSIGN/NOLOG "N_ROOT:[LIB.INC]ifh_o.def" IFH_O_DEF ! 940622 -$ ASSIGN/NOLOG "N_ROOT:[LIB.INC]ifh_o.inc" ifh_o_inc ! 940622 -$ ASSIGN/NOLOG "N_ROOT:[LIB.INC]ifh_t.def" IFH_T_DEF ! 940622 -$ ASSIGN/NOLOG "N_ROOT:[LIB.INC]ifh_t.inc" ifh_t_inc ! 940622 -$ ASSIGN/NOLOG "N_ROOT:[LIB.INC]ihw_e.def" IHW_E_DEF ! 940622 -$ ASSIGN/NOLOG "N_ROOT:[LIB.INC]ihw_e.inc" ihw_e_inc ! 940622 -$ ASSIGN/NOLOG "N_ROOT:[LIB.INC]ihw_o.def" IHW_O_DEF ! 940622 -$ ASSIGN/NOLOG "N_ROOT:[LIB.INC]ihw_o.inc" ihw_o_inc ! 940622 -$ ASSIGN/NOLOG "N_ROOT:[LIB.INC]ihw_t.def" IHW_T_DEF ! 940622 -$ ASSIGN/NOLOG "N_ROOT:[LIB.INC]ihw_t.inc" ihw_t_inc ! 940622 -$ ASSIGN/NOLOG "N_ROOT:[LIB.INC]mca_e_inc." mca_e_inc ! 940622 -$ ASSIGN/NOLOG "N_ROOT:[LIB.INC]mca_o_inc." mca_o_inc ! 940622 -$ ASSIGN/NOLOG "N_ROOT:[LIB.INC]mca_t_inc." mca_t_inc ! 940622 -$ ASSIGN/NOLOG "N_ROOT:[LIB.INC]mdh_e.def" MDH_E_DEF ! 940622 -$ ASSIGN/NOLOG "N_ROOT:[LIB.INC]mdh_e.inc" mdh_e_inc ! 940622 -$ ASSIGN/NOLOG "N_ROOT:[LIB.INC]mdh_o.def" MDH_O_DEF ! 940622 -$ ASSIGN/NOLOG "N_ROOT:[LIB.INC]mdh_o.inc" mdh_o_inc ! 940622 -$ ASSIGN/NOLOG "N_ROOT:[LIB.INC]mdh_t.def" MDH_T_DEF ! 940622 -$ ASSIGN/NOLOG "N_ROOT:[LIB.INC]mdh_t.inc" mdh_t_inc ! 940622 -$ ASSIGN/NOLOG "N_ROOT:[LIB.INC]mdl_e.def" MDL_E_DEF ! 940622 -$ ASSIGN/NOLOG "N_ROOT:[LIB.INC]mdl_e.inc" mdl_e_inc ! 940622 -$ ASSIGN/NOLOG "N_ROOT:[LIB.INC]mdl_o.def" MDL_O_DEF ! 940622 -$ ASSIGN/NOLOG "N_ROOT:[LIB.INC]mdl_o.inc" mdl_o_inc ! 940622 -$ ASSIGN/NOLOG "N_ROOT:[LIB.INC]mdl_t.def" MDL_T_DEF ! 940622 -$ ASSIGN/NOLOG "N_ROOT:[LIB.INC]mdl_t.inc" mdl_t_inc ! 940622 -$ ASSIGN/NOLOG "N_ROOT:[LIB.INC]mph_e.def" MPH_E_DEF ! 940622 -$ ASSIGN/NOLOG "N_ROOT:[LIB.INC]mph_e.inc" mph_e_inc ! 940622 -$ ASSIGN/NOLOG "N_ROOT:[LIB.INC]mph_o.def" MPH_O_DEF ! 940622 -$ ASSIGN/NOLOG "N_ROOT:[LIB.INC]mph_o.inc" mph_o_inc ! 940622 -$ ASSIGN/NOLOG "N_ROOT:[LIB.INC]mph_t.def" MPH_T_DEF ! 940622 -$ ASSIGN/NOLOG "N_ROOT:[LIB.INC]mph_t.inc" mph_t_inc ! 940622 -$ ASSIGN/NOLOG "N_ROOT:[LIB.INC]nat.def" NAT_DEF ! 940622 -$ ASSIGN/NOLOG "N_ROOT:[LIB.INC]nat.inc" nat_inc ! 940622 -$ ASSIGN/NOLOG "N_ROOT:[LIB.INC]nca.def" NCA_DEF ! 940622 -$ ASSIGN/NOLOG "N_ROOT:[LIB.INC]nca.inc" nca_inc ! 940622 -$ ASSIGN/NOLOG "N_ROOT:[LIB.INC]ncl.def" NCL_DEF ! 940622 -$ ASSIGN/NOLOG "N_ROOT:[LIB.INC]ncl.inc" ncl_inc ! 940622 -$ ASSIGN/NOLOG "N_ROOT:[LIB.INC]nco.def" NCO_DEF ! 940622 -$ ASSIGN/NOLOG "N_ROOT:[LIB.INC]nco.inc" nco_inc ! 940622 -$ ASSIGN/NOLOG "N_ROOT:[LIB.INC]nfi.def" NFI_DEF ! 940622 -$ ASSIGN/NOLOG "N_ROOT:[LIB.INC]nfi.inc" nfi_inc ! 940622 -$ ASSIGN/NOLOG "N_ROOT:[LIB.INC]nfl.def" NFL_DEF ! 940622 -$ ASSIGN/NOLOG "N_ROOT:[LIB.INC]nfl.inc" nfl_inc ! 940622 -$ ASSIGN/NOLOG "N_ROOT:[LIB.INC]ngc.def" NGC_DEF ! 940622 -$ ASSIGN/NOLOG "N_ROOT:[LIB.INC]ngc.inc" ngc_inc ! 940622 -$ ASSIGN/NOLOG "N_ROOT:[LIB.INC]ngf_e.def" NGF_E_DEF ! 940622 -$ ASSIGN/NOLOG "N_ROOT:[LIB.INC]ngf_e.inc" ngf_e_inc ! 940622 -$ ASSIGN/NOLOG "N_ROOT:[LIB.INC]ngf_o.def" NGF_O_DEF ! 940622 -$ ASSIGN/NOLOG "N_ROOT:[LIB.INC]ngf_o.inc" ngf_o_inc ! 940622 -$ ASSIGN/NOLOG "N_ROOT:[LIB.INC]ngf_t.def" NGF_T_DEF ! 940622 -$ ASSIGN/NOLOG "N_ROOT:[LIB.INC]ngf_t.inc" ngf_t_inc ! 940622 -$ ASSIGN/NOLOG "N_ROOT:[LIB.INC]ngi.def" NGI_DEF ! 940622 -$ ASSIGN/NOLOG "N_ROOT:[LIB.INC]ngi.inc" ngi_inc ! 940622 -$ ASSIGN/NOLOG "N_ROOT:[LIB.INC]nma.def" NMA_DEF ! 940622 -$ ASSIGN/NOLOG "N_ROOT:[LIB.INC]nma.inc" nma_inc ! 940622 -$ ASSIGN/NOLOG "N_ROOT:[LIB.INC]nmo.def" NMO_DEF ! 940622 -$ ASSIGN/NOLOG "N_ROOT:[LIB.INC]nmo.inc" nmo_inc ! 940622 -$ ASSIGN/NOLOG "N_ROOT:[LIB.INC]npl.def" NPL_DEF ! 940622 -$ ASSIGN/NOLOG "N_ROOT:[LIB.INC]npl.inc" npl_inc ! 940622 -$ ASSIGN/NOLOG "N_ROOT:[LIB.INC]nsc.def" NSC_DEF ! 940622 -$ ASSIGN/NOLOG "N_ROOT:[LIB.INC]nsc.inc" nsc_inc ! 940622 -$ ASSIGN/NOLOG "N_ROOT:[LIB.INC]ohw_e.def" OHW_E_DEF ! 940622 -$ ASSIGN/NOLOG "N_ROOT:[LIB.INC]ohw_e.inc" ohw_e_inc ! 940622 -$ ASSIGN/NOLOG "N_ROOT:[LIB.INC]ohw_o.def" OHW_O_DEF ! 940622 -$ ASSIGN/NOLOG "N_ROOT:[LIB.INC]ohw_o.inc" ohw_o_inc ! 940622 -$ ASSIGN/NOLOG "N_ROOT:[LIB.INC]ohw_t.def" OHW_T_DEF ! 940622 -$ ASSIGN/NOLOG "N_ROOT:[LIB.INC]ohw_t.inc" ohw_t_inc ! 940622 -$ ASSIGN/NOLOG "N_ROOT:[LIB.INC]qub.def" QUB_DEF ! 940622 -$ ASSIGN/NOLOG "N_ROOT:[LIB.INC]qub.inc" qub_inc ! 940622 -$ ASSIGN/NOLOG "N_ROOT:[LIB.INC]qub_e.def" QUB_E_DEF ! 940622 -$ ASSIGN/NOLOG "N_ROOT:[LIB.INC]qub_e.inc" qub_e_inc ! 940622 -$ ASSIGN/NOLOG "N_ROOT:[LIB.INC]qub_o.def" QUB_O_DEF ! 940622 -$ ASSIGN/NOLOG "N_ROOT:[LIB.INC]qub_o.inc" qub_o_inc ! 940622 -$ ASSIGN/NOLOG "N_ROOT:[LIB.INC]qub_t.def" QUB_T_DEF ! 940622 -$ ASSIGN/NOLOG "N_ROOT:[LIB.INC]qub_t.inc" qub_t_inc ! 940622 -$ ASSIGN/NOLOG "N_ROOT:[LIB.INC]rpf.def" RPF_DEF ! 940622 -$ ASSIGN/NOLOG "N_ROOT:[LIB.INC]rpf.inc" rpf_inc ! 940622 -$ ASSIGN/NOLOG "N_ROOT:[LIB.INC]sch_e.def" SCH_E_DEF ! 940622 -$ ASSIGN/NOLOG "N_ROOT:[LIB.INC]sch_e.inc" sch_e_inc ! 940622 -$ ASSIGN/NOLOG "N_ROOT:[LIB.INC]sch_o.def" SCH_O_DEF ! 940622 -$ ASSIGN/NOLOG "N_ROOT:[LIB.INC]sch_o.inc" sch_o_inc ! 940622 -$ ASSIGN/NOLOG "N_ROOT:[LIB.INC]sch_t.def" SCH_T_DEF ! 940622 -$ ASSIGN/NOLOG "N_ROOT:[LIB.INC]sch_t.inc" sch_t_inc ! 940622 -$ ASSIGN/NOLOG "N_ROOT:[LIB.INC]scn.def" SCN_DEF ! 940622 -$ ASSIGN/NOLOG "N_ROOT:[LIB.INC]scn.inc" scn_inc ! 940622 -$ ASSIGN/NOLOG "N_ROOT:[LIB.INC]scw_e.def" SCW_E_DEF ! 940622 -$ ASSIGN/NOLOG "N_ROOT:[LIB.INC]scw_e.inc" scw_e_inc ! 940622 -$ ASSIGN/NOLOG "N_ROOT:[LIB.INC]scw_o.def" SCW_O_DEF ! 940622 -$ ASSIGN/NOLOG "N_ROOT:[LIB.INC]scw_o.inc" scw_o_inc ! 940622 -$ ASSIGN/NOLOG "N_ROOT:[LIB.INC]scw_t.def" SCW_T_DEF ! 940622 -$ ASSIGN/NOLOG "N_ROOT:[LIB.INC]scw_t.inc" scw_t_inc ! 940622 -$ ASSIGN/NOLOG "N_ROOT:[LIB.INC]sgh_e.def" SGH_E_DEF ! 940622 -$ ASSIGN/NOLOG "N_ROOT:[LIB.INC]sgh_e.inc" sgh_e_inc ! 940622 -$ ASSIGN/NOLOG "N_ROOT:[LIB.INC]sgh_o.def" SGH_O_DEF ! 940622 -$ ASSIGN/NOLOG "N_ROOT:[LIB.INC]sgh_o.inc" sgh_o_inc ! 940622 -$ ASSIGN/NOLOG "N_ROOT:[LIB.INC]sgh_t.def" SGH_T_DEF ! 940622 -$ ASSIGN/NOLOG "N_ROOT:[LIB.INC]sgh_t.inc" sgh_t_inc ! 940622 -$ ASSIGN/NOLOG "N_ROOT:[LIB.INC]shw_e.def" SHW_E_DEF ! 940622 -$ ASSIGN/NOLOG "N_ROOT:[LIB.INC]shw_e.inc" shw_e_inc ! 940622 -$ ASSIGN/NOLOG "N_ROOT:[LIB.INC]shw_o.def" SHW_O_DEF ! 940622 -$ ASSIGN/NOLOG "N_ROOT:[LIB.INC]shw_o.inc" shw_o_inc ! 940622 -$ ASSIGN/NOLOG "N_ROOT:[LIB.INC]shw_t.def" SHW_T_DEF ! 940622 -$ ASSIGN/NOLOG "N_ROOT:[LIB.INC]shw_t.inc" shw_t_inc ! 940622 -$ ASSIGN/NOLOG "N_ROOT:[LIB.INC]smp_e.def" SMP_E_DEF ! 940622 -$ ASSIGN/NOLOG "N_ROOT:[LIB.INC]smp_e.inc" smp_e_inc ! 940622 -$ ASSIGN/NOLOG "N_ROOT:[LIB.INC]smp_o.def" SMP_O_DEF ! 940622 -$ ASSIGN/NOLOG "N_ROOT:[LIB.INC]smp_o.inc" smp_o_inc ! 940622 -$ ASSIGN/NOLOG "N_ROOT:[LIB.INC]smp_t.def" SMP_T_DEF ! 940622 -$ ASSIGN/NOLOG "N_ROOT:[LIB.INC]smp_t.inc" smp_t_inc ! 940622 -$ ASSIGN/NOLOG "N_ROOT:[LIB.INC]ssh_e.def" SSH_E_DEF ! 940622 -$ ASSIGN/NOLOG "N_ROOT:[LIB.INC]ssh_e.inc" ssh_e_inc ! 940622 -$ ASSIGN/NOLOG "N_ROOT:[LIB.INC]ssh_o.def" SSH_O_DEF ! 940622 -$ ASSIGN/NOLOG "N_ROOT:[LIB.INC]ssh_o.inc" ssh_o_inc ! 940622 -$ ASSIGN/NOLOG "N_ROOT:[LIB.INC]ssh_t.def" SSH_T_DEF ! 940622 -$ ASSIGN/NOLOG "N_ROOT:[LIB.INC]ssh_t.inc" ssh_t_inc ! 940622 -$ ASSIGN/NOLOG "N_ROOT:[LIB.INC]sth_e.def" STH_E_DEF ! 940622 -$ ASSIGN/NOLOG "N_ROOT:[LIB.INC]sth_e.inc" sth_e_inc ! 940622 -$ ASSIGN/NOLOG "N_ROOT:[LIB.INC]sth_o.def" STH_O_DEF ! 940622 -$ ASSIGN/NOLOG "N_ROOT:[LIB.INC]sth_o.inc" sth_o_inc ! 940622 -$ ASSIGN/NOLOG "N_ROOT:[LIB.INC]sth_t.def" STH_T_DEF ! 940622 -$ ASSIGN/NOLOG "N_ROOT:[LIB.INC]sth_t.inc" sth_t_inc ! 940622 -$ ASSIGN/NOLOG "N_ROOT:[LIB.INC]wnc_inc." wnc_inc ! 940622 -$ ASSIGN/NOLOG "N_ROOT:[LIB.INC]wnd_inc." wnd_inc ! 940622 -$ ASSIGN/NOLOG "N_ROOT:[LIB.INC]wng_inc." wng_inc ! 940622 -$ ASSIGN/NOLOG "N_ROOT:[LIB.INC]wnt_e_inc." wnt_e_inc ! 940622 -$ ASSIGN/NOLOG "N_ROOT:[LIB.INC]wnt_inc." wnt_inc ! 940622 -$ ASSIGN/NOLOG "N_ROOT:[LIB.INC]wnt_o_inc." wnt_o_inc ! 940622 -$ ASSIGN/NOLOG "N_ROOT:[LIB.INC]wnt_t_inc." wnt_t_inc ! 940622 -$ ASSIGN/NOLOG "N_ROOT:[LIB.INC]wpg_xlogo64_inc." wpg_xlogo64_inc ! 940622 -$ ASSIGN/NOLOG "N_ROOT:[LIB.INC]wq_eal.def" WQ_EAL_DEF ! 940622 -$ ASSIGN/NOLOG "N_ROOT:[LIB.INC]wq_eal.inc" wq_eal_inc ! 940622 -$ ASSIGN/NOLOG "N_ROOT:[LIB.INC]wq_eap.def" WQ_EAP_DEF ! 940622 -$ ASSIGN/NOLOG "N_ROOT:[LIB.INC]wq_eap.inc" wq_eap_inc ! 940622 -$ ASSIGN/NOLOG "N_ROOT:[LIB.INC]wq_epp.def" WQ_EPP_DEF ! 940622 -$ ASSIGN/NOLOG "N_ROOT:[LIB.INC]wq_epp.inc" wq_epp_inc ! 940622 -$ ASSIGN/NOLOG "N_ROOT:[LIB.INC]wq_eps.def" WQ_EPS_DEF ! 940622 -$ ASSIGN/NOLOG "N_ROOT:[LIB.INC]wq_eps.inc" wq_eps_inc ! 940622 -$ ASSIGN/NOLOG "N_ROOT:[LIB.INC]wq_fna.def" WQ_FNA_DEF ! 940622 -$ ASSIGN/NOLOG "N_ROOT:[LIB.INC]wq_fna.inc" wq_fna_inc ! 940622 -$ ASSIGN/NOLOG "N_ROOT:[LIB.INC]wq_fnb.def" WQ_FNB_DEF ! 940622 -$ ASSIGN/NOLOG "N_ROOT:[LIB.INC]wq_fnb.inc" wq_fnb_inc ! 940622 -$ ASSIGN/NOLOG "N_ROOT:[LIB.INC]wq_pal.def" WQ_PAL_DEF ! 940622 -$ ASSIGN/NOLOG "N_ROOT:[LIB.INC]wq_pal.inc" wq_pal_inc ! 940622 -$ ASSIGN/NOLOG "N_ROOT:[LIB.INC]wq_pap.def" WQ_PAP_DEF ! 940622 -$ ASSIGN/NOLOG "N_ROOT:[LIB.INC]wq_pap.inc" wq_pap_inc ! 940622 -$ ASSIGN/NOLOG "N_ROOT:[LIB.INC]wq_psl.def" WQ_PSL_DEF ! 940622 -$ ASSIGN/NOLOG "N_ROOT:[LIB.INC]wq_psl.inc" wq_psl_inc ! 940622 -$ ASSIGN/NOLOG "N_ROOT:[LIB.INC]wq_psp.def" WQ_PSP_DEF ! 940622 -$ ASSIGN/NOLOG "N_ROOT:[LIB.INC]wq_psp.inc" wq_psp_inc ! 940622 -$ ASSIGN/NOLOG "N_ROOT:[LIB.INC]wq_qmp.def" WQ_QMP_DEF ! 940622 -$ ASSIGN/NOLOG "N_ROOT:[LIB.INC]wq_qmp.inc" wq_qmp_inc ! 940622 -$ ASSIGN/NOLOG "N_ROOT:[LIB.INC]wq_qms.def" WQ_QMS_DEF ! 940622 -$ ASSIGN/NOLOG "N_ROOT:[LIB.INC]wq_qms.inc" wq_qms_inc ! 940622 -$ ASSIGN/NOLOG "N_ROOT:[LIB.INC]wq_reg.def" WQ_REG_DEF ! 940622 -$ ASSIGN/NOLOG "N_ROOT:[LIB.INC]wq_reg.inc" wq_reg_inc ! 940622 -$ ASSIGN/NOLOG "N_ROOT:[LIB.INC]wq_xwi.def" WQ_XWI_DEF ! 940622 -$ ASSIGN/NOLOG "N_ROOT:[LIB.INC]wq_xwi.inc" wq_xwi_inc ! 940622 -$ ASSIGN/NOLOG "N_ROOT:[LIB.INC]wqd_e.def" WQD_E_DEF ! 940622 -$ ASSIGN/NOLOG "N_ROOT:[LIB.INC]wqd_e.inc" wqd_e_inc ! 940622 -$ ASSIGN/NOLOG "N_ROOT:[LIB.INC]wqd_o.def" WQD_O_DEF ! 940622 -$ ASSIGN/NOLOG "N_ROOT:[LIB.INC]wqd_o.inc" wqd_o_inc ! 940622 -$ ASSIGN/NOLOG "N_ROOT:[LIB.INC]wqd_t.def" WQD_T_DEF ! 940622 -$ ASSIGN/NOLOG "N_ROOT:[LIB.INC]wqd_t.inc" wqd_t_inc ! 940622 -$ ASSIGN/NOLOG "N_ROOT:[LIB.INC]wqf_e.def" WQF_E_DEF ! 940622 -$ ASSIGN/NOLOG "N_ROOT:[LIB.INC]wqf_e.inc" wqf_e_inc ! 940622 -$ ASSIGN/NOLOG "N_ROOT:[LIB.INC]wqf_o.def" WQF_O_DEF ! 940622 -$ ASSIGN/NOLOG "N_ROOT:[LIB.INC]wqf_o.inc" wqf_o_inc ! 940622 -$ ASSIGN/NOLOG "N_ROOT:[LIB.INC]wqf_t.def" WQF_T_DEF ! 940622 -$ ASSIGN/NOLOG "N_ROOT:[LIB.INC]wqf_t.inc" wqf_t_inc ! 940622 -$ ASSIGN/NOLOG "N_ROOT:[LIB.INC]wqg.def" WQG_DEF ! 940622 -$ ASSIGN/NOLOG "N_ROOT:[LIB.INC]wqg.inc" wqg_inc ! 940622 -$ ASSIGN/NOLOG "N_ROOT:[LIB.INC]wqi_e.def" WQI_E_DEF ! 940622 -$ ASSIGN/NOLOG "N_ROOT:[LIB.INC]wqi_e.inc" wqi_e_inc ! 940622 -$ ASSIGN/NOLOG "N_ROOT:[LIB.INC]wqi_o.def" WQI_O_DEF ! 940622 -$ ASSIGN/NOLOG "N_ROOT:[LIB.INC]wqi_o.inc" wqi_o_inc ! 940622 -$ ASSIGN/NOLOG "N_ROOT:[LIB.INC]wqi_t.def" WQI_T_DEF ! 940622 -$ ASSIGN/NOLOG "N_ROOT:[LIB.INC]wqi_t.inc" wqi_t_inc ! 940622 -$ ASSIGN/NOLOG "N_ROOT:[LIB.INC]wxh_inc." wxh_inc ! 940622 diff --git a/src/sys/newerfile.c b/src/sys/newerfile.c deleted file mode 100644 index e8343f9ffdba0d15e3ec391b1894068d0ee7ef2c..0000000000000000000000000000000000000000 --- a/src/sys/newerfile.c +++ /dev/null @@ -1,41 +0,0 @@ -/* newerfile.c - -Compare modification times of two files. - -Invocation - newerfile.exe <file1> <file2> - -Return status: - -1 Error on either file - 0 <file1> older than or as old as <file2> - 1 <file1> newer than <file2> - -History: - JPH 950822 Original - -*/ - -#include <stdio.h> -#include <sys/types.h> -#include <sys/stat.h> -#include <time.h> - - -main (argc, argv) - int argc; char *argv[]; -{ - struct stat buf; - time_t tm[2]; -/* char filename[64]; */ - int i; - - for (i=0; i<2; i++){ - *++argv; - if (stat (*argv, &buf) == (-1)) { - return -1; - } else { - tm[i] = buf.st_mtime; - } - } - return tm[0]>tm[1]; -} diff --git a/src/sys/newstar_airub.csh b/src/sys/newstar_airub.csh deleted file mode 100755 index d9d320bb3f88c712d847de00edd69e44ec62ddf8..0000000000000000000000000000000000000000 --- a/src/sys/newstar_airub.csh +++ /dev/null @@ -1,50 +0,0 @@ -# -# Local startup for Newstar (HjV 951214) -# Revision: -# -#+ -# Institute: University of Bochum, Astronomical Institute -# Address: Universitaetsstrase 150 -# NA 7 Nord -# 44780 Bochum -# Germany -# Contact person: Goetz Golla -# Email address: golla@astro.ruhr-uni-bochum.de -# FTP-node(s): alpha3.astro.ruhr-uni-bochum.de (DA - alpha3) -# Phone: +49 234 700 2335 -#- -# -# Define the name of this site -# -setenv n_site airub -setenv n_install da -setenv n_hosts alpha4 - -# -# Define the root of the Newstar directory tree -# -setenv n_root /opt/newstar -# -# Make sure we have the standard settings (HOSTTYPE etc) -# -source $n_root/src/sys/newstar_env.csh -# -# Any non-standard environment settings should be made here -# -# -# Now do the general setup -# -source $n_root/src/sys/newstar_init.csh -# -# Now we may wish to change anything we do not like -# -if ($HOST == alpha1 || $HOST == alpha3) then - setenv MAG6 "/dev/EXABYTE" - setenv MAG7 "/dev/nEXABYTE" - setenv MAG8 "/dev/DAT" - setenv MAG9 "/dev/nDAT" -endif - -# Define your www browser -# If you don't define it, xmosaic (part of newstar distibution) will be used -#setenv n_www xyz # where xyz is your favorite www browser diff --git a/src/sys/newstar_arecb.csh b/src/sys/newstar_arecb.csh deleted file mode 100755 index 84cfe8627c9d586fa6365bcc50a49a439935ed57..0000000000000000000000000000000000000000 --- a/src/sys/newstar_arecb.csh +++ /dev/null @@ -1,47 +0,0 @@ -# -# Local startup for Newstar (HjV 931007)) -# 951212 HjV Add n_www -# -#+ -# Institute: ARECIBO Obersatory -# Address: P.O. Box 995, Arecibo -# Puerto Rico 00613 USA -# Contact person: Tapasi Ghosh -# Email address: tghosh@naic.edu -# FTP-node(s): 192.65.176.64 (SW - nevis) -# 192.65.176.4 (SW - aosun) -# Phone: (1)-809-878-2612 -#- -# -# Define the name of this site, installed architectures and hosts -# -setenv n_site arecb -setenv n_install sw -setenv n_hosts nevis - -# -# Define the root of the Newstar directory tree -# -setenv n_root /usr/local/newstar -# -# Make sure we have the standard settings (HOSTTYPE etc) -# -source $n_root/src/sys/newstar_env.csh -# -# Any non-standard environment settings should be made here -# -# -# Now do the general setup -# -source $n_root/src/sys/newstar_init.csh -# -# Now we may wish to change anything we do not like -# -if ($HOSTTYPE =~ sun*) then - setenv MAG8 "/dev/nrst1" - setenv MAG9 "/dev/nrst0" -endif - -# Define your www browser -# If you don't define it, xmosaic (part of newstar distibution) will be used -#setenv n_www xyz # where xyz is your favorite www browser diff --git a/src/sys/newstar_atnf.com b/src/sys/newstar_atnf.com deleted file mode 100644 index b801467f9b3ab494fc894124e4d230ecc91b98a2..0000000000000000000000000000000000000000 --- a/src/sys/newstar_atnf.com +++ /dev/null @@ -1,60 +0,0 @@ -$! newstar_atnf.com -$! -$! Local startup for Newstar (HjV 931007) -$! Revision: -$! CMV 931201 Split off newstar_env.csh -$! HjV 940125 Change n_root -$! WNB 940621 Make COM -$! -$!+ -$! Institute: Australian Telescope National Facility -$! Address: P.O. Box 76 -$! Epping NSW2121 -$! Australia -$! Contact person: Wim Brouw -$! Email address: wbrouw@atnf.csiro.au -$! FTP-node(s): norma.atnf.csiro.au (DW) -$! venice.atnf.csiro.au (SW and many more) -$! ateles.atnf.csiro.au (CV) -$! robin.atnf.csiro.au (VX) -$! Phone: +(61)2.3724316 -$!- -$! -$! Define the name of this site -$! -$ DEFINE/NOLOG N_SITE atnf -$ DEFINE/NOLOG N_INSTALL "dw/sw/cv/vx" -$ DEFINE/NOLOG N_HOSTS "norma,venice,ateles,robin" -$! -$! Define the root of the Newstar directory tree -$! -$ DEFINE/NOLOG/TRANS=CONCEAL N_ROOT "UTIL0:[BOOK.WBROUW.WNB.NSTAR.]" -$! -$! Make sure we have the standard settings (HOSTTYPE etc) -$! -$ @n_root:[src.sys]newstar_env -$! -$! Any non-standard environment settings should be made here -$! -$! -$! Now do the general setup -$! -$ @N_ROOT:[SRC.SYS]NEWSTAR_INIT -$! -$! Now we may wish to change anything we do not like -$! -$ DEFINE/NOLOG "n_src" "/n_root/src" ! For genaid -$ DEFINE/NOLOG N_LIB "N_ROOT:[LIB]" -$ DEFINE/NOLOG N_EXE "N_ROOT:[EXE]" -$ DEFINE/NOLOG N_IMPORT "N_ROOT:[TEST]" -$ DEFINE/NOLOG N_HLP "N_ROOT:[EXE.HTML]" -$ IF F$TRNLNM("MAG0") .EQS. "" THEN - - ASSIGN/NOLOG/TRANS=CONCEAL ROBIN$MSA0: MAG0 -$ IF F$TRNLNM("MAG1") .EQS. "" THEN - - ASSIGN/NOLOG/TRANS=CONCEAL ROBIN$MUB0: MAG1 -$ IF F$TRNLNM("MAG9") .EQS. "" THEN - - ASSIGN/NOLOG/TRANS=CONCEAL ROBIN$MUC0: MAG9 -$! -$! Ready -$! -$ EXIT diff --git a/src/sys/newstar_atnf.csh b/src/sys/newstar_atnf.csh deleted file mode 100755 index 1c28f3cfe9385b6172db5eb70a674fb600fc974d..0000000000000000000000000000000000000000 --- a/src/sys/newstar_atnf.csh +++ /dev/null @@ -1,87 +0,0 @@ -# -# Local startup for Newstar (HjV 931007) -# Revision: -# CMV 931201 Split off newstar_env.csh -# HjV 940314 Change n_root -# HjV 940516 Typo -# WNB 940621 Some name changes -# WNB 940624 Error in n_exe definition -# WNB 950808 Change n_root for auto mount across network; -# add raptor, remove ateles (CV) -# WNB/HjV 951212 Add n_www -# WNB 960627 Make so -# -#+ -# Institute: Australian Telescope National Facility -# Address: P.O. Box 76 -# Epping NSW2121 -# Australia -# Contact person: Wim Brouw -# Email address: wbrouw@atnf.csiro.au -# FTP-node(s): norma.atnf.csiro.au (SO - norma) -# robin.atnf.csiro.au (VX - robin) -# raptor.atnf.csiro.au (SG - raptor) -# Phone: +(61)2.93724316 -#- -# -# Define the name of this site -# -setenv n_site atnf -setenv n_install so -##/cv/vx -setenv n_hosts norma -##,robin,raptor - -# -# Define the root of the Newstar directory tree -# -setenv n_root /nfs/code_norma/nstar -# -# Make sure we have the standard settings (HOSTTYPE etc) -# -source $n_root/src/sys/newstar_env.csh -# -# Any non-standard environment settings should be made here -# -if ($HOSTTYPE =~ dec* || $HOSTTYPE =~ *mips*) then - setenv n_exe /nfs/data_norma/nstar/sdw/dwarf -else - setenv n_exe /nfs/data_norma/nstar/sso/dwarf -endif -# -# Now do the general setup -# -source $n_root/src/sys/newstar_init.csh -# -# Now we may wish to change anything we do not like -# -setenv n_import $n_root/test - -# Define your www browser -# If you don't define it, xmosaic (part of newstar distibution) will be used -#setenv n_www xyz # where xyz is your favorite www browser - -# -# Mag tapes -# -if ($HOST == ateles) then - setenv MAG0 "/dev/rmt8" - setenv MAG1 "/dev/rmt16" - setenv MAG2 "/dev/rmt0" - setenv MAG3 "/dev/rmt9" - setenv MAG4 "/dev/rmt17" - setenv MAG5 "/dev/rmt1" -else if ($HOST == norma) then -else if ($?MACHINE_ARC) then - if ("$MACHINE_ARC" == "dec") then - else - if ($HOST == carina) then - setenv MAG9 "/dev/nrst0" - endif - endif -else - if ($HOST == carina) then - setenv MAG9 "/dev/nrst0" - endif -endif -# diff --git a/src/sys/newstar_bao.csh b/src/sys/newstar_bao.csh deleted file mode 100755 index 20f9477fe8bf3faaace30009ee3e1e400df11598..0000000000000000000000000000000000000000 --- a/src/sys/newstar_bao.csh +++ /dev/null @@ -1,51 +0,0 @@ -# -# Local startup for Newstar (HjV 940614) -# Revision: -# 951212 HjV Add n_www -# -#+ -# Institute: Beijing Astronomical Observatory -# Address: Beijing -# 100080 -# China -# Contact person: Peng Bo -# Email address: zhangxz@bepc2.ihep.ac.cn -# FTP-node(s): bao01.bao.ac.cn (VAX - ) -# ibepc2.ihep.ac.cn (VAX - ) -# (SW - sun8) -# Phone: 86-1 256 1265 -#- -# Should login via VAX and do: SET HOST SUN8 -# Yet (940623) it still does NOT work -# -# Define the name of this site -# -setenv n_site bao -setenv n_install sw -setenv n_hosts sun8 - -# -# Define the root of the Newstar directory tree -# -setenv n_root /home/newstar -# -# Make sure we have the standard settings (HOSTTYPE etc) -# -source $n_root/src/sys/newstar_env.csh -# -# Any non-standard environment settings should be made here -# -# -# Now do the general setup -# -source $n_root/src/sys/newstar_init.csh -# -# Now we may wish to change anything we do not like -# -if ($HOSTTYPE =~ sun*) then - setenv MAG9 "/dev/rst0" # -endif - -# Define your www browser -# If you don't define it, xmosaic (part of newstar distibution) will be used -#setenv n_www xyz # where xyz is your favorite www browser diff --git a/src/sys/newstar_calt.csh b/src/sys/newstar_calt.csh deleted file mode 100755 index 9c348df557c594bd298024a0e4a46600692da2bf..0000000000000000000000000000000000000000 --- a/src/sys/newstar_calt.csh +++ /dev/null @@ -1,49 +0,0 @@ -# -# Local startup for Newstar (HjV - 950314) -# Revision: -# 951212 HjV Add n_www -# -#+ -# Institute: California Institute for Technology -# Address: Caltech 105-24 -# PASADENA CA91125 -# USA -# Contact person: Gautam Vasisht -# Email address: gv@astro.caltech.edu -# FTP-node(s): phobos.caltech.edu -# Phone: 001-818-395-4987 -#- -# -# Define the name of this site -# -setenv n_site calt -setenv n_install sw -setenv n_hosts phobos - -# -# Define the root of the Newstar directory tree -# -setenv n_root /usr/local/newstar -# -# Make sure we have the standard settings (HOSTTYPE etc) -# -source $n_root/src/sys/newstar_env.csh -# -# Any non-standard environment settings should be made here -# -setenv n_exe $n_root/$n_arch/bin -# -# Now do the general setup -# -source $n_root/src/sys/newstar_init.csh -# -# Now we may wish to change anything we do not like -# -if ($HOSTTYPE =~ sun*) then - setenv MAG0 "/dev/nrst0" # Exabyte -endif - -# Define your www browser -# If you don't define it, xmosaic (part of newstar distibution) will be used -#setenv n_www xyz # where xyz is your favorite www browser - diff --git a/src/sys/newstar_env.com b/src/sys/newstar_env.com deleted file mode 100644 index b056be9e78c14bd73ebd4ff109488917ce72b2d3..0000000000000000000000000000000000000000 --- a/src/sys/newstar_env.com +++ /dev/null @@ -1,44 +0,0 @@ -$!+ -$! newstar_env.com - make sure general settings have been made -$! -$! Revisions: -$! WNB 940311 Make COM -$! 940314 HjV When HOST contains dots, take first part. -$! 940322 HjV Make contents HOST, HOSTTYPE lowercase -$! -$! This script sets HOSTTYPE, HOST and USER if they are not yet defined -$!- -$! -$! Init -$! -$ DEFINE="DEFINE" -$! -$! Define the name of the current host -$! -$ IF F$TRNLNM("N_HOST") .EQS. "" THEN - - DEFINE/NOLOG N_HOST "''F$EDIT(F$GETSYI("NODENAME"),"LOWERCASE")'" -$! remove part after dot -$! set to lowercase -$! -$! Define the hosttype (all these crazy paths taken from cshrc.csh@rug) -$! -$ IF F$TRNLNM("HOSTTYPE") .EQS. "" THEN - - DEFINE/NOLOG HOSTTYPE VAX -$ ARCH==F$TRNLNM("HOSTTYPE") ! Make sure we have an arch -$! -$! Set username -$! -$ IF F$TRNLNM("USER") .EQS. "" THEN - - DEFINE/NOLOG USER 'F$GETJPI("","USERNAME")' -$! -$! Make sure some domainname is given -$! -$ DEFINE/NOLOG DOMAINNAME "''F$TRNLNM("UCX$BIND_DOMAIN")'" -$ IF F$TRNLNM("DOMAINNAME") .EQS. "" THEN - - DEFINE/NOLOG DOMAINNAME "''F$TRNLNM("MULTINET_LOCALDOMAIN")'" -$ IF F$TRNLNM("DOMAINNAME") .EQS. "" THEN - - DEFINE/NOLOG DOMAINNAME "''F$TRNLNM("HOST")'" -$! -$! Ready -$! -$ EXIT diff --git a/src/sys/newstar_env.csh b/src/sys/newstar_env.csh deleted file mode 100755 index e721109aec475647ba958d70128feaf0d7fd0ac7..0000000000000000000000000000000000000000 --- a/src/sys/newstar_env.csh +++ /dev/null @@ -1,74 +0,0 @@ -#!/bin/csh -f -# -# 940314 HjV When HOST contains dots, take first part. -# 940322 HjV Make contents HOST, HOSTTYPE lowercase -# 960619 HjV Add test for Solaris -#+ -# newstar_env.csh - make sure general settings have been made -# -# This script sets HOSTTYPE, HOST and USER if they are not yet defined -#- -# -# Define the name of the current host -# -if (! $?HOST) then - if (-x /usr/local/bin/hostname) then - setenv HOST `/usr/local/bin/hostname` - else if (-x /usr/bin/hostname) then - setenv HOST `/usr/bin/hostname` - else if (-x /bin/hostname) then - setenv HOST `/bin/hostname` - else if (-x /usr/local/hostname) then - setenv HOST `/usr/local/hostname` - else if (-x /usr/ucb/hostname) then - setenv HOST `/usr/ucb/hostname` - else - setenv HOST unknown - endif -endif -# remove part after dot -setenv HOST `echo $HOST | awk '{split($1,name,"."); {print name[1]} }' ` -# set to lowercase -setenv HOST `echo $HOST | tr '[A-Z]' '[a-z]' ` -# -# Define the hosttype (all these crazy paths taken from cshrc.csh@rug) -# -if (! $?HOSTTYPE ) then - if ($?arch) then # Defined at the atnf - setenv HOSTTYPE $arch - else if (-x /usr/local/bin/arch) then - setenv HOSTTYPE `/usr/local/bin/arch` - else if (-x /usr/bin/arch) then - setenv HOSTTYPE `/usr/bin/arch` - else if (-x /bin/arch) then - setenv HOSTTYPE `/bin/arch` - else if (-x /usr/local/arch) then - setenv HOSTTYPE `/usr/local/arch` - else if (-x /usr/ucb/arch) then - setenv HOSTTYPE `/usr/ucb/arch` - else - setenv HOSTTYPE unknown # it's a pity - endif -endif -# Test if this is a Solaris -if ($HOSTTYPE == "sun4" ) then - set ver = `uname -r|awk -F. '{printf $1}'` - if ( $ver == "5" ) setenv HOSTTYPE solaris2 - unset ver -endif -# -if ($HOSTTYPE =~ *linux*) then - setenv HOSTTYPE linux -endif -alias arch echo $HOSTTYPE # Make sure we have an arch -# -# Set username -# -if (! $?USER) then - setenv USER `whoami` -endif -# -# Make sure some domainname is given -# -#set flag=( `which domainname` ) -#if (! -x "$flag") alias domainname echo $HOST diff --git a/src/sys/newstar_estec.csh b/src/sys/newstar_estec.csh deleted file mode 100755 index 72c6167ac86d3e76e3e0ebe498eaa7915cd58275..0000000000000000000000000000000000000000 --- a/src/sys/newstar_estec.csh +++ /dev/null @@ -1,46 +0,0 @@ -# -# Local startup for Newstar (HjV 941125) -# 951212 HjV Add n_www -# -#+ -# Institute: ESTEC -# Address: Keplerlaan 1 -# 2200 AG NOORDWIJK -# The Netherlands -# Contact person: Lorraine Hanlon -# Email address: lhanlon@astro.estec.esa.nl -# FTP-node(s): astro.estec.esa.nl (SW -# Phone: 01719 - 83833 -#- -# -# Define the name of this site -# -setenv n_site estec -setenv n_install sw -setenv n_hosts arthur - -# -# Define the root of the Newstar directory tree -# -setenv n_root /usr7/newstar -# -# Make sure we have the standard settings (HOSTTYPE etc) -# -source $n_root/src/sys/newstar_env.csh -# -# Any non-standard environment settings should be made here -# - -# -# Now do the general setup -# -source $n_root/src/sys/newstar_init.csh -# -# Now we may wish to change anything we do not like -# -setenv MAG8 "/dev/rst0" -setenv MAG9 "/dev/rst1" - -# Define your www browser -# If you don't define it, xmosaic (part of newstar distibution) will be used -#setenv n_www xyz # where xyz is your favorite www browser diff --git a/src/sys/newstar_ger.csh b/src/sys/newstar_ger.csh deleted file mode 100644 index 9f5dbaf081a7b4d50b1fdd1a56af6f668a78f7ab..0000000000000000000000000000000000000000 --- a/src/sys/newstar_ger.csh +++ /dev/null @@ -1,57 +0,0 @@ -# -# Local startup for Newstar (HjV 931007) -# -#+ -# Institute: Westerbork Synthese Radio TelescopeWNB Laptop -# Address: Schattenberg 1 -# 9433 TA Zwiggelte -# Netherlands -# Contact person: Arthur Coolen -# Email address: coolen@astron.nl -# FTP-node(s): -# Phone: 0521-595292 -# -# Revision: -# 091221 AxC Initialise -#- -# -# Define the name of this site -# -setenv n_site ger -setenv n_install li -setenv n_hosts dop208 -setenv n_ftp ftp.astron.nl - -# -# Define the root of the Newstar directory tree -# -setenv n_root /dop208_1/newstar -setenv n_hlp $n_root/hlp - -# -# Make sure we have the standard settings (HOSTTYPE etc) -# -source $n_root/src/sys/newstar_env.csh -# -# Any non-standard environment settings should be made here -# -# -# Now do the general setup -# -source $n_root/src/sys/newstar_init.csh - -# -# Now do the general setup -# -##source $n_src/sys/init_wsrt.csh - -# -# Now we may wish to change anything we do not like -# -##alias nsmail "pine -I ^X,y -subject " -setenv LPATH /lib:/usr/lib - -# Define your www browser -# If you don't define it, xmosaic (part of newstar distibution) will be used -setenv n_www firefox - diff --git a/src/sys/newstar_ger208.csh b/src/sys/newstar_ger208.csh deleted file mode 100644 index 71a8ac9b55e29f0a9590dbcdac02144d0ad07fb4..0000000000000000000000000000000000000000 --- a/src/sys/newstar_ger208.csh +++ /dev/null @@ -1,65 +0,0 @@ -# -# Local startup for Newstar (HjV 931007) -# -#+ -# Institute: Westerbork Synthese Radio TelescopeWNB Laptop -# Address: Schattenberg 1 -# 9433 TA Zwiggelte -# Netherlands -# Contact person: Arthur Coolen -# Email address: coolen@astron.nl -# FTP-node(s): -# Phone: 0521-595292 -# -# Revision: -# 091221 AxC Initialise -# 100103 WNB Make newstar_ger208.csh -# 100104 WNB Correct for absence 'standard' login -#- -# -# Define the name of this site -# -setenv n_site ger208 -setenv n_install li -setenv n_hosts dop208 -setenv n_ftp ftp.astron.nl - -# -# Define the root of the Newstar directory tree -# -# unset some variables if people started old system first -unsetenv n_root n_src n_exe n_lib n_hlp n_arch n_doc -unsetenv n_inc n_tst n_batch n_master n_remote -# set the standard NFRA HOSTTYPE -setenv HOSTTYPE linux -# O.K. set root now -setenv n_root /dop208_1/newstar -setenv n_hlp $n_root/hlp - -# -# Make sure we have the standard settings (HOSTTYPE etc) -# -source $n_root/src/sys/newstar_env.csh -# -# Any non-standard environment settings should be made here -# -# -# Now do the general setup -# -source $n_root/src/sys/newstar_init.csh - -# -# Now do the general setup -# -##source $n_src/sys/init_wsrt.csh - -# -# Now we may wish to change anything we do not like -# -##alias nsmail "pine -I ^X,y -subject " -setenv LPATH /lib:/usr/lib - -# Define your www browser -# If you don't define it, xmosaic (part of newstar distibution) will be used -setenv n_www firefox - diff --git a/src/sys/newstar_init.com b/src/sys/newstar_init.com deleted file mode 100644 index bfa98a07b3eff6d5163a6f19bc6dedc05fe01f5d..0000000000000000000000000000000000000000 --- a/src/sys/newstar_init.com +++ /dev/null @@ -1,195 +0,0 @@ -$!+ -$! newstar_init.com -$! CMV 930525 -$! -$! Revision -$! CMV 931115 Changed test for dw to *mips* -$! CMV 931201 Split off newstar_env.csh -$! CMV 940216 Add display of version.idx to nnews -$! CMV 940304 Change n_remote for anonymous ftp -$! WNB 940311 Make SSC -$! HjV 940315 Remove nbug (now in newstar_nfra.csh) -$! HjV 940321 Change n_remote rzmws10.nfra.nl to 192.87.1.160 -$! CMV 940329 Add $n_batch and alias nbatch -$! CMV 940414 Test if Symbol-file is corrupt -$! HjV 940516 Add N_ARCH check for CV and DA -$! HjV 940526 Add another N_ARCH check for DW (decstation) -$! CMV 940530 n_script: unset precmd (need proper prompt) -$! WNB 940621 Make .com -$! -$! General startup for newstar (CMV 930524) -$! -$! This script will in general be sourced from a site specific startup -$! file. Before invoking this script, at least the following should -$! have been set: -$! -$! $n_root path to the root of Newstar tree -$! $n_site name for this site -$! -$! Optionally, you may set -$! -$! $n_arch architecture (two letter codes) -$! $n_src root of source tree -$! $n_inc directory with (precompiled) include files -$! $n_hlp directory with local hypertext network -$! $n_lib directory with object libraries for $n_arch -$! $n_exe directory with executables for $n_arch -$! $n_tst directory with executables for $n_arch (testversions) -$! -$! To set up a programming environment, at least the following should -$! have been set as well: -$! -$! $n_uroot path to the root of the User tree -$! -$! This script assumes the following general settings have been made: -$! HOST HOSTTYPE -$! -$! The script newstar_env.com makes sure these exist -$! -$!- -$! -$! Init -$! -$ ECHO="WRITE SYS$OUTPUT" -$! -$! Checks -$! -$ IF F$TRNLNM("N_ROOT") .EQS. "" .OR. F$TRNLNM("N_SITE").EQS. "" -$ THEN -$ echo " " -$ echo "Cannot continue: n_root and n_site are not defined..." -$ echo "Contact your Newstar manager..." -$ echo " " -$ exit -$ ENDIF -$! -$! Find the architecture (if not already defined in site specific script) -$! -$ IF F$TRNLNM("N_ARCH") .EQS. "" THEN - - DEFINE/NOLOG N_ARCH VX -$! -$! Define the default tree (do not override any settings made by user -$! at the calling siter-dependent script, allowing e.g. $n_exe to -$! reside on different file-systems for different architectures). -$! -$! $n_work is defined at the end of this file -$! -$ A=F$TRNLNM("N_ROOT")-"]"+"SRC.]" -$ IF F$TRNLNM("N_SRC") .EQS. "" THEN - - DEFINE/NOLOG/TRANS=CONCEAL N_SRC 'A' -$ IF F$TRNLNM("N_INC") .EQS. "" THEN - - DEFINE/NOLOG N_INC N_ROOT:[LIB.INC] -$ IF F$TRNLNM("N_LIB") .EQS. "" THEN - - DEFINE/NOLOG N_LIB N_ROOT:[LIB.'F$TRNLNM("N_ARCH")'] -$ IF F$TRNLNM("N_EXE") .EQS. "" THEN - - DEFINE/NOLOG N_EXE N_ROOT:[EXE.'F$TRNLNM("N_ARCH")'] -$ IF F$TRNLNM("N_HLP") .EQS. "" THEN - - DEFINE/NOLOG N_HLP N_ROOT:[EXE.HTML] -$ IF F$TRNLNM("N_TST") .EQS. "" THEN - - DEFINE/NOLOG N_TST N_ROOT:[TST.'F$TRNLNM("N_ARCH")'] -$ IF F$TRNLNM("N_IMPORT") .EQS. "" THEN - - DEFINE/NOLOG N_IMPORT N_ROOT:[IMPORT] -$ IF F$TRNLNM("N_BATCH") .EQS. "" THEN - - DEFINE/NOLOG N_BATCH N_SRC:[BATCH] -$! -$! Define all necessary aliases for general Newstar use. -$! -$ IF F$SEARCH("N_EXE:EXECUTE.EXE") .EQS. "" -$ THEN -$ IF F$TRNLNM("DWARF_SYMBOLS") .EQS. "" -$ THEN -$ echo " " -$ echo "Newstar cannot yet run on this architecture..." -$ echo "(no file N_EXE:execute.exe exists)" -$ echo " " -$ ENDIF -$ DEFINE/NOLOG DWARF_SYMBOLS "None" -$ ELSE -$ nnews =="TYPE/PAGE N_SRC:[SYS]version.idx,N_SRC:[doc]nnews.hlp" -$ ncopy =="@N_SRC:[nscan]NCOPY.COM" -$ nbatch =="@N_BATCH:" -$ dwcalc*ulate =="$n_exe:calculate.exe" -$ dwc*lear =="$n_exe:clear.exe" -$ dwe*xecute =="$n_exe:execute.exe" -$ exe*cute =="$n_exe:execute.exe" -$ dwl*et =="$n_exe:let.exe" -$ dwr*estore =="$n_exe:restore.exe" -$ dwsa*ve =="$n_exe:save.exe" -$ dws*pecify =="$n_exe:specify.exe" -$ dwv*iew =="$n_exe:view.exe" -$ bldppd =="$n_exe:sys_bldppd.exe" -$ prtppd =="$n_exe:sys_prtppd.exe" -$ prtunits =="$n_exe:prtunits.exe" -$ wngfex =="@n_src:[sys]wngfex.com" -$ outd*warf == - - "DWSAVE SYS$LOGIN:LOGIN.SAV" -$ ENDIF -$! -$! Remove corrupt symbol-files -$! -$! -$! Initialise the DWARF parameter interface, if not already done -$! -$! -$! Define DWARF_SYMBOLS, create symbols file, purge old files -$! -$! -$! Set up Dwarf symbols for interactive session -$! -$ TMP="$N_EXE:INITDW " -$ TMP 'F$STRING(F$GETJPI("","PROC_INDEX"))'+"INTERACTIVE" -$ IF F$SEARCH("SYS$LOGIN:LOGIN.SAV").NES."" -$ THEN -$ DWRESTORE SYS$LOGIN:LOGIN.SAV -$ echo "Symbols restored from SYS$LOGIN:LOGIN.SAV" -$ ENDIF -$! -$! Add some general symbols -$! - Y*ES ==".TRUE." - N*O ==".FALSE." - PI =="3.141592653589793" - PIRAD =="3.141592653589793 RAD" -$! -$! Set path to model database, this may be overridden by NGEN -$! -$ DEFINE/NOLOG MODELB N_SRC:[DATA] -$! -$! To facilate the script utility, we may set a different prompt -$! -$! -$! Set up the programmers environment (n_usrc, n_uinc, ...) -$! -$! First decide wether we work in a user-system or in the Master -$! To work in a user system, the user should set $u_root -$! previously to invoking this script. This will set up -$! a programming environment with respect to this directory -$! -$! If the user is the owner of $n_root, the programming environment -$! will be set to the Master system. -$! -$! Regardless of the programming environment, the user may always -$! define $n_uexe as a user binary tree. By default, $n_uexe points -$! to the test directory of the Master executable tree. -$! -$ nup== "$N_EXE:perl N_SRC:[SYS]update.pls" -$ nsh== "$N_EXE:perl N_SRC:[SYS]shadow.pls" -$ ndoc== "$N_EXE:perl N_SRC:[SYS]document.pls" -$ nhyper== "''ndoc' hyper" -$ nscript== "''ndoc' script" -$ DEFINE/NOLOG NSTAR_DIR "nscan nmap nplot ncopy wng dwarf " -$ DEFINE/NOLOG n_master "newstar@astron.nl" -$ IF F$TRNLNM("N_WORK") .EQS. "" THEN - - DEFINE/NOLOG N_WORK N_ROOT:[WORK.'F$TRNLNM("N_ARCH")'] -$ DEFINE/NOLOG/TRANS=CONCEAL n_usrc 'F$TRNLNM("N_SRC")' -$ DEFINE/NOLOG n_uinc 'F$TRNLNM("n_inc")' -$ DEFINE/NOLOG n_ulib 'F$TRNLNM("n_lib")' -$ DEFINE/NOLOG n_remote "192.87.1.160 anonymous newstar/src" -$ DEFINE/NOLOG n_uexe 'F$TRNLNM("n_tst")' -$ nlink== "''nup' build -T:exe " -$ ncomp== "''nup' build " -$ spawn== "" -$! -$! Ready -$! -$ EXIT diff --git a/src/sys/newstar_init.csh b/src/sys/newstar_init.csh deleted file mode 100755 index bc9841fa10b83991524354611b0aaf3aa43c16cf..0000000000000000000000000000000000000000 --- a/src/sys/newstar_init.csh +++ /dev/null @@ -1,279 +0,0 @@ -#+ -# newstar_init.csh -# CMV 930525 -# -# Revision -# CMV 931115 Changed test for dw to *mips* -# CMV 931201 Split off newstar_env.csh -# CMV 940216 Add display of version.idx to nnews -# CMV 940304 Change n_remote for anonymous ftp -# HjV 940315 Remove nbug (now in newstar_nfra.csh) -# HjV 940321 Change n_remote rzmws10.nfra.nl to 192.87.1.160 -# CMV 940329 Add $n_batch and alias nbatch -# CMV 940414 Test if Symbol-file is corrupt -# HjV 940516 Add N_ARCH check for CV and DA -# HjV 940526 Add another N_ARCH check for DW (decstation) -# CMV 940530 n_script: unset precmd (need proper prompt) -# HjV 941017 Use ftp.nfra.nl iso. 192.87.1.160 for n_remote -# CMV 941110 Also define n_remote if not Master account -# HjV 950130 Use $HOME in directories iso. ~ or ~/ -# WNB 950224 Make sure non-existant dwarf symbol file replaced -# WNB 950808 Add n_arch check for SGi -# HjV 951212 Add n_www -# JPH 960315 Add dwrec|p|n -# HjV 960619 Add test for Solaris -# -# General startup for newstar (CMV 930524) -# -# This script will in general be sourced from a site specific startup -# file. Before invoking this script, at least the following should -# have been set: -# -# $n_root path to the root of Newstar tree -# $n_site name for this site -# -# Optionally, you may set -# -# $n_arch architecture (two letter codes) -# $n_src root of source tree -# $n_inc directory with (precompiled) include files -# $n_hlp directory with local hypertext network -# $n_lib directory with object libraries for $n_arch -# $n_exe directory with executables for $n_arch -# $n_tst directory with executables for $n_arch (testversions) -# $n_www your favorite WWW browser -# -# To set up a programming environment, at least the following should -# have been set as well: -# -# $n_uroot path to the root of the User tree -# -# This script assumes the following general settings have been made: -# HOST HOSTTYPE -# -# The script newstar_env.csh makes sure these exist -# -# -# -if (! $?n_root || ! $?n_site ) then - echo " " - echo "Cannot continue: n_root and n_site are not defined..." - echo "Contact your Newstar manager..." - echo " " - exit -endif - -# -# Find the architecture (if not already defined in site specific script) -# -if (! $?n_arch) then - if ($HOSTTYPE =~ sun*) then - setenv n_arch sw - else if ($HOSTTYPE =~ solaris*) then - setenv n_arch so - else if ($HOSTTYPE =~ hp*) then - setenv n_arch hp - else if ($HOSTTYPE == alliant) then - setenv n_arch al - else if ($HOSTTYPE =~ dec* || $HOSTTYPE =~ *mips*) then - setenv n_arch dw - else if ($HOSTTYPE =~ alpha) then - setenv n_arch da - else if ($HOSTTYPE =~ c2mp) then - setenv n_arch cv - else if ($HOSTTYPE =~ iris*) then - setenv n_arch sg - else if ($HOSTTYPE =~ linux*) then - setenv n_arch li - endif -endif - -# -# Define the default tree (do not override any settings made by user -# at the calling siter-dependent script, allowing e.g. $n_exe to -# reside on different file-systems for different architectures). -# -# $n_work is defined at the end of this file -# -if (! $?n_src) setenv n_src $n_root/src -if (! $?n_doc) setenv n_doc $n_src/doc -if (! $?n_inc) setenv n_inc $n_root/lib/inc -if (! $?n_lib) setenv n_lib $n_root/lib/$n_arch -if (! $?n_exe) setenv n_exe $n_root/exe/$n_arch -if (! $?n_hlp) setenv n_hlp $n_root/exe/html -if (! $?n_tst) setenv n_tst $n_root/tst/$n_arch -if (! $?n_import) setenv n_import $n_root/import -if (! $?n_batch) setenv n_batch $n_src/batch -if (! $?n_www) setenv n_www $n_exe/xmosaic.exe - -# -# Define all necessary aliases for general Newstar use. -# -if (! -e $n_exe/execute.exe ) then - if (! $?DWARF_SYMBOLS) then - echo " " - echo "Newstar cannot yet run on this architecture..." - echo "(no file "\$n_exe"/execute.exe exists)" - echo " " - endif - setenv DWARF_SYMBOLS None -else - alias nnews 'more $n_src/sys/version.idx $n_src/doc/nnews.hlp' - alias ncopy '$n_src/nscan/ncopy.csh' - alias nbatch '$n_batch/\!^.csh \!:2* ' - alias dwcalc '$n_exe/calculate.exe \!* ' - alias dwcalculate '$n_exe/calculate.exe \!* ' - alias dwc '$n_exe/clear.exe \!* ' - alias dwclear '$n_exe/clear.exe \!* ' - alias dwe '$n_exe/execute.exe \!* ' - alias dwexe '$n_exe/execute.exe \!* ' - alias exe '$n_exe/execute.exe \!* ' - alias dwl '$n_exe/let.exe \!* ' - alias dwlet '$n_exe/let.exe \!* ' - alias dwr '$n_exe/restore.exe \!* ' - alias dwrestore '$n_exe/restore.exe \!* ' - alias dwrec '$n_src/sys/dwrecord.csh m' - alias dwren '$n_src/sys/dwrecord.csh n' - alias dwrep '$n_src/sys/dwrecord.csh r' - alias dwsa '$n_exe/save.exe \!* ' - alias dwsave '$n_exe/save.exe \!* ' - alias dws '$n_exe/specify.exe \!* ' - alias dwspecify '$n_exe/specify.exe \!* ' - alias dwv '$n_exe/view.exe \!* ' - alias dwview '$n_exe/view.exe \!* ' - alias bldppd '$n_exe/sys_bldppd.exe \!* ' - alias prtppd '$n_exe/sys_prtppd.exe \!* ' - alias prtunits '$n_exe/prtunits.exe' - alias wngfex '$n_src/sys/wngfex.csh' - alias genaid '$n_exe/genaid.exe \!* ' - alias outdwarf \ - 'if ($?DWARF_SYMBOLS) "cp" $DWARF_SYMBOLS $HOME/SYMBOL_DIR/SAVSYMBOLS' - alias outd outdwarf -# -# Remove corrupt symbol-files -# - if ($?DWARF_SYMBOLS) then - if (-z $DWARF_SYMBOLS) then - "rm" -f $DWARF_SYMBOLS - unsetenv DWARF_SYMBOLS - endif - endif -# -# Make sure symbol file exist -# - if ($?DWARF_SYMBOLS) then - if (! -e $DWARF_SYMBOLS) then - unsetenv DWARF_SYMBOLS - endif - endif -# -# Initialise the DWARF parameter interface, if not already done -# - if (! $?DWARF_SYMBOLS) then -# -# Define DWARF_SYMBOLS, create symbols file, purge old files -# - setenv DWARF_SYMBOLS $HOME/SYMBOL_DIR/SYMBOL.$$ - - if (! -e $HOME/SYMBOL_DIR) then - "mkdir" $HOME/SYMBOL_DIR - echo "Created subdirectory $HOME/SYMBOL_DIR" - endif - - if (-e $DWARF_SYMBOLS) then - "rm" -f $DWARF_SYMBOLS - endif - - if (-e $HOME/SYMBOL_DIR/SAVSYMBOLS) then - "cp" $HOME/SYMBOL_DIR/SAVSYMBOLS $DWARF_SYMBOLS - echo "Symbols restored from $HOME/SYMBOL_DIR/SAVSYMBOLS" - else - "touch" $DWARF_SYMBOLS - endif - chmod 644 $DWARF_SYMBOLS - - "find" $HOME/SYMBOL_DIR/SYMBOL.* -atime +7 -exec "rm" "{}" ";" >& /dev/null -# -# Set up Dwarf symbols for interactive session -# - $n_exe/initdw.exe $$+INTERACTIVE -# -# Add some general symbols -# - $n_exe/let.exe /NOLOG <<_endlet_ -YES = .TRUE. -YE = .TRUE. -Y = .TRUE. -NO = .FALSE. -N = .FALSE. -PI = 3.141592653589793 -PIRAD = 3.141592653589793 RAD - -_endlet_ -# -# Set path to model database, this may be overridden by NGEN -# - setenv MODELB $n_src/data/ - setenv MODEL_PATH $n_src/data/ - - endif -# -# To facilate the script utility, we may set a different prompt -# - if ($?n_script) then - unalias precmd - set prompt="script> " - alias \# 'echo \!* >/dev/null' - dws dwarf /nomenu <<_EOD_ -bell=on -# -_EOD_ - endif - -endif - -# -# Set up the programmers environment (n_usrc, n_uinc, ...) -# -# First decide wether we work in a user-system or in the Master -# To work in a user system, the user should set $u_root -# previously to invoking this script. This will set up -# a programming environment with respect to this directory -# -# If the user is the owner of $n_root, the programming environment -# will be set to the Master system. -# -# Regardless of the programming environment, the user may always -# define $n_uexe as a user binary tree. By default, $n_uexe points -# to the test directory of the Master executable tree. -# -alias ndoc $n_src/sys/document.csh -alias nhyper ndoc hyper -alias nscript ndoc script - -alias nsh $n_src/sys/shadow.csh -alias nup $n_src/sys/update.csh -alias nlink nsh build -T:exe -alias ncomp nsh build -setenv NSTAR_DIR "nscan nmap nplot ncopy wng dwarf " -setenv n_master newstar@astron.nl -setenv n_remote "ftp.astron.nl anonymous newstar/src" - -alias nsmail "elm -s " - -if (-o $n_src) then - if (! $?n_work) setenv n_work $n_root/work/$n_arch - setenv n_usrc $n_src - setenv n_uinc $n_inc - setenv n_ulib $n_lib - setenv n_uexe $n_tst - alias nlink nup build -T:exe - alias ncomp nup build - alias spawn '( \!* |& nsmail "\!*" newstar@astron.nl >/dev/null ) &' -else if ($?n_uroot) then - if (! $?n_usrc) setenv n_usrc $n_uroot/src - if (! $?n_uinc) setenv n_uinc $n_uroot/lib/inc - if (! $?n_ulib) setenv n_ulib $n_uroot/lib/$n_arch - if (! $?n_uexe) setenv n_uexe $n_uroot/exe/$n_arch - if (! $?n_work) setenv n_work $n_uroot/work/$n_arch -endif diff --git a/src/sys/newstar_irabo.csh b/src/sys/newstar_irabo.csh deleted file mode 100755 index 9d588aace3da08a27a881ff0ba1a74cccb9245cd..0000000000000000000000000000000000000000 --- a/src/sys/newstar_irabo.csh +++ /dev/null @@ -1,41 +0,0 @@ -# -# Local startup for Newstar IRABO (HjV 950825) -# Revision: -# 951212 HjV Add n_www -# -#+ -# Institute: Instituto di Radioastronomica - C.N.R. -# Address: via Gobetti 101 -# I-40129 Bologna -# Italy -# Contact person: Danielle Dallacasa -# Email address: dallacasa@astbo1.bo.cnr.it -# FTP-node(s): terra.bo.cnr.it (Alpha - terra) -# Phone: -#- -# -# Define the name of this site -# -setenv n_site irabo -setenv n_install da -setenv n_hosts terra - -# -# Define the root of the Newstar directory tree -# -setenv n_root /soft/newstar -# -# Make sure we have the standard settings (HOSTTYPE etc) -# -source $n_root/src/sys/newstar_env.csh -# -# Any non-standard environment settings should be made here -# -# -# Now do the general setup -# -source $n_root/src/sys/newstar_init.csh -# -# Now we may wish to change anything we do not like -# -setenv MAG8 /dev/nrmt0 diff --git a/src/sys/newstar_kosma.csh b/src/sys/newstar_kosma.csh deleted file mode 100755 index 3e6306d4bb9561dece50bf73065263cfe6bd8d97..0000000000000000000000000000000000000000 --- a/src/sys/newstar_kosma.csh +++ /dev/null @@ -1,47 +0,0 @@ -# -# Local startup for Newstar (HjV 931007) -# 951212 HjV Add n_www -# -#+ -# Institute: I. Physikalisches Institut -# Koelner Observatorium fuer SubMillimeter-Astronomie -# Address: Zelpicher Strasse 77 -# 50937 Koeln -# Germany -# Contact person: Uwe Corneliussen -# Email address: corneli@ph1.uni-koeln.de -# FTP-node(s): 134.95.50.8 (HP - apollo) -# Phone: +49 221 470 3558 -#- -# -# Define the name of this site -# -setenv n_site kosma -setenv n_install hp -setenv n_hosts apollo - -# -# Define the root of the Newstar directory tree -# -setenv n_root /utildsk/newstar -# -# Make sure we have the standard settings (HOSTTYPE etc) -# -source $n_root/src/sys/newstar_env.csh -# -# Any non-standard environment settings should be made here -# -# -# Now do the general setup -# -source $n_root/src/sys/newstar_init.csh -# -# Now we may wish to change anything we do not like -# -if ($HOST =~ apollo*) then - setenv MAG8 "/dev/rmt/0m" -endif - -# Define your www browser -# If you don't define it, xmosaic (part of newstar distibution) will be used -#setenv n_www xyz # where xyz is your favorite www browser diff --git a/src/sys/newstar_lick.csh b/src/sys/newstar_lick.csh deleted file mode 100755 index dc7a8a8d952ab1ff87d79bd109355fd03ff8909d..0000000000000000000000000000000000000000 --- a/src/sys/newstar_lick.csh +++ /dev/null @@ -1,49 +0,0 @@ -# -# Local startup for Newstar (HjV 960611) -# -# Revision: -# -#+ -# Institute: Lick Observatory, University of California at St. Cruz -# Address: 1156 High Street -# 95064 California -# U.S.A. -# Contact person: Arpad Szomoru -# Email address: arpad@kanchhi.ucolick.org -# FTP-node(s): 128.114.23.54 (sw - kanchhi.ucolick.org) -# Phone: -#- -# -# Define the name of this site -# -setenv n_site lick -setenv n_install sw -setenv n_hosts kanchhi - -# -# Define the root of the Newstar directory tree -# -setenv n_root /i/arpad/newstar -# -# Make sure we have the standard settings (HOSTTYPE etc) -# -source $n_root/src/sys/newstar_env.csh -# -# Any non-standard environment settings should be made here -# -# -# Now do the general setup -# -source $n_root/src/sys/newstar_init.csh -# -# Now we may wish to change anything we do not like -# -setenv MAG8 "/dev/rst1" # 8mm tape drive -setenv MAG9 "/dev/sr0" # CD-ROM -# -# Define your www browser -# If you don't define it, xmosaic (part of newstar distibution) will be used -# If you change the next line, please report it to newstar@astron.nl -# else your changes will be lost with the next update. -#setenv n_www xyz # where xyz is your favorite www browser - diff --git a/src/sys/newstar_nfra.csh b/src/sys/newstar_nfra.csh deleted file mode 100755 index 5749156f5040c51cf1ae90457970447c8ea0b5f2..0000000000000000000000000000000000000000 --- a/src/sys/newstar_nfra.csh +++ /dev/null @@ -1,163 +0,0 @@ -# -# Local startup for Newstar (CMV 930922) -# Revision: -# 931007 HjV Add MAG*-settings -# 931020 CMV Add LD_LIBRARY_PATH (not everybody has this in .cshrc) -# 931110 HjV Change device name MAG8 and type newstar.news -# 931201 CMV Split off newstar_env.csh -# 940304 CMV Add n_ftp to invoke copying to the ftp area -# 940315 HjV Add nbug (was in newstar_init.csh before) -# 940419 CMV Add n_doabp setting -# 940620 CMV Separate filesystems for rzmws5,rzmws6,daw03 -# 940628 CMV Change directory for daw03, add rzmws7 -# 940708 HjV Add tape-unit MAG0 (1600 bpi) and -# MAG1 (6250 bpi) for rzmws0 -# 940720 CMV Changed location of n_hlp -# 941019 HjV Changed location of n_hlp -# 941027 CMV Added MAG3 for optical disk on daw03 -# 941102 CMV Added scissor commands -# 941109 CMV Add scmail command -# 950130 HjV Use $HOME in directories iso. ~ or ~/ -# 950424 HjV Add rzmws4 -# 950614 HjV Add n_l2h -# 950627 HjV Add dat-device on DAW16 -# 950830 ErDeul Modified LD_LIBRARY_PATH to add to existing -# 951012 HjV Add DAT-device for DAW13 -# 951212 HjV Add n_www -# 960618 HjV Add Solaris (so, duw01); rzmws6 removed, add daw16 -# 970829 HjV Remove ws4, ws5, ws7 stuff -# Add daw18 (only for compile/linking) -# -#+ -# Institute: Netherlands Foundation for Research in Astronomy -# Address: P.O. Box 2 -# 7990 AA Dwingeloo -# Netherlands -# Contact person: Arthur Coolen -# Email address: coolen@astron.nl -# FTP-node(s): 192.87.1.150 (Solaris 2.6 - dus0) -# Phone: 0521 - 595237 -#- -# -# Define the name of this site -# -setenv n_site nfra -setenv n_install li -setenv n_hosts dop64 -setenv n_ftp ftp.astron.nl -setenv n_doabp ok -setenv _Merge 0 - -# -# Define the root of the Newstar directory tree -# -unsetenv n_src n_exe # If people started old system first -setenv n_root /dop64_0/newstar -setenv n_hlp $n_root/hlp - -# -# Make sure we have the standard settings (HOSTTYPE etc) -# -source $n_root/src/sys/newstar_env.csh - -# -# Any non-standard environment settings should be made here -# -# Note that the /usr/lib path entry in the LD_LIBRARY_PATH is not required -# and will explicitly cuase problems with the SunOS 4.1.3 version and X11R6 -# binaries. -# COMMENT by E.R. Deul 07-09-95 -# -if ($HOSTTYPE =~ sol*) then - setenv n_l2h $n_root/latex2html - if ($?LD_LIBRARY_PATH) then - setenv LD_LIBRARY_PATH "$LD_LIBRARY_PATH":"/usr/openwin/lib" - else - setenv LD_LIBRARY_PATH "/usr/openwin/lib" - endif -endif -if ($HOST == daw16) then - if (-e /daw16_1/newstar/execute.exe) setenv n_exe /daw16_1/newstar -else if ($HOST == daw03) then - if (-e /usr/local/bin/newstar/execute.exe) \ - setenv n_exe /usr/local/bin/newstar -endif - -# -# Print newstar news (when available, and only once!) -# -if (! $?DWARF_SYMBOLS && -e $n_root/import/newstar.news) cat $n_root/import/newstar.news - -# -# Now do the general setup -# -source $n_root/src/sys/newstar_init.csh - -alias scissor $n_src/sys/scissor.csh -alias sctar scissor tar -alias scship scissor ship -alias scinit scissor init -alias scmail scissor mail -setenv QED1 //www.astron.nl:8083 # The scissor server - -# -# Now we may wish to change anything we do not like -# -alias nsmail "pine -I ^X,y -subject " -if ($HOST == rzmws0) then - setenv MAG0 "/dev/rst12" # 1600 bpi tape-unit - setenv MAG1 "/dev/rst28" # 6250 bpi tape-unit -endif -if ($HOSTTYPE =~ sun*) then - setenv MAG8 "/dev/rst1" # 1 Giga DAT DDS - setenv MAG9 "/dev/rst0" # Exabyte -else if ($HOST == daw08 || $HOST == daw16 || \ - $HOST == daw03 || $HOST == duw01 ) then - setenv MAG8 "/dev/rmt/0m" -else if ($HOST == daw13) then - setenv MAG8 "/dev/rmt/1m" - setenv MAG9 "/dev/rmt/3m" -else if ($HOST == duw00) then - setenv MAG8 "/dev/rmt/1" -endif - -setenv MAG7 disk:/cdrom/cdrom0 - -# Define your www browser -# If you don't define it, xmosaic (part of newstar distibution) will be used -setenv n_www netscape # where xyz is your favorite www browser -# -# Unit on daw03 and remote tape-units on the VAX (Optical Disks) -# -if ($HOST == daw03) then - setenv MAG7 disk:/cdrom - setenv MAG3 disk:/opt - alias odinit scinit 3 -endif - -# -# Print on the line printer (some people are used to this command) -# -alias pvax "wngfex sp \!* " - -# -# Not everybody has elm in his path -# -if ($n_arch == sw) then - if ($USER == jph) alias elm \mail -endif - -# -# Some tricky things for GIDS -# -if ($?DISPLAY) then - setenv DEFAULT_DISPLAY $HOME/.gids-$DISPLAY -endif - - - - - - - - diff --git a/src/sys/newstar_raiub.csh b/src/sys/newstar_raiub.csh deleted file mode 100755 index bce3b509f04aa732faa129478e8008203233faad..0000000000000000000000000000000000000000 --- a/src/sys/newstar_raiub.csh +++ /dev/null @@ -1,101 +0,0 @@ -# -# Local startup for Newstar (HjV 931007) -# 951212 HjV Add n_www -# 960802 HjV Add Alpha/OSF1 -# 971029 Helge Rottmann Add Solaris stuff -# -#+ -# Institute: Radioastronomisches Institut Universitaet Bonn -# Address: Auf dem Huegel 71 -# D-53121 Bonn -# Germany -# -# Sun-Workstation: -# Contact person: Helge Rottmann -# Email address: rottmann@astro.uni-bonn.de -# FTP-node(s): 131.220.96.29 (aux29) -# FTP-node(s): 131.220.96.26 (sun150) -# Phone: 09-49-228733393 -# -# Dec-Alpha/OSF1: -# Contact person: Peter Kalberla -# Email address: pkalberla@astro.uni-bonn.de -# FTP-node(s): 131.220.96.17 (soft1) -# Phone: 09-49-228733645 -#- -# -# Define the name of this site -# -setenv n_site raiub - switch ("`uname -a`") - case OSF1*alpha: - set MACHINE='alpha' - breaksw - case "SunOS*sun3*": - set MACHINE='sun3' - breaksw - case "SunOS*4.1*sun4*": - set MACHINE='sun4c' - breaksw - case "SunOS*5.*sun4*": - set MACHINE='ssol2' - breaksw - case "ULTRIX*RISC": - set MACHINE='risc' - breaksw - default: - set MACHINE='unknown' - breaksw - endsw -if ($MACHINE == "sun4c" ) then - setenv n_install sw - setenv n_hosts sun29 - setenv n_arch sw -else if ($MACHINE == "ssol2" ) then - setenv n_install so - setenv n_hosts sun150 - setenv n_arch so -else if ($MACHINE == "alpha") then - setenv n_install da - setenv n_hosts aibn17 - setenv n_arch da -endif -# -# Define the root of the Newstar directory tree -# -if ("$n_arch" == "sw" ) then - setenv n_root /aux29/dwingeloo/newstar -else if ("$n_arch" == "so" ) then - setenv n_root /net/sun29/aux29/dwingeloo/newstar -else if ("$n_arch" == "da" ) then - setenv n_root /soft1/newstar -endif -# -# Make sure we have the standard settings (HOSTTYPE etc) -# -source $n_root/src/sys/newstar_env.csh -# -# Any non-standard environment settings should be made here -# -# -# Now do the general setup -# -source $n_root/src/sys/newstar_init.csh -# -# Now we may wish to change anything we do not like -# -if ($HOST == "sun29") then - setenv MAG8 "/dev/nrst0" -else if ($HOST == "sun150") then - setenv MAG8 "/dev/nrst/0" -else if ("$HOST" == "aibn20") then - setenv MAG8 "/dev/nrmt0h" -else if ("$HOST" == "aibn23") then - setenv MAG9 "/dev/nrmt0h" -endif -# -# Define your www browser -# If you don't define it, xmosaic (part of newstar distibution) will be used -if ("$n_arch" == "da" ) then - setenv n_www netscape # where xyz is your favorite www browser -endif diff --git a/src/sys/newstar_roberto236.csh b/src/sys/newstar_roberto236.csh deleted file mode 100644 index 1d8ac1006078aaa8a1ac9f95218c83c2430b5a09..0000000000000000000000000000000000000000 --- a/src/sys/newstar_roberto236.csh +++ /dev/null @@ -1,66 +0,0 @@ -# -# Local startup for Newstar (HjV 931007) -# -#+ -# Institute: Westerbork Synthese Radio TelescopeWNB Laptop -# Address: Schattenberg 1 -# 9433 TA Zwiggelte -# Netherlands -# Contact person: Arthur Coolen -# Email address: coolen@astron.nl -# FTP-node(s): -# Phone: 0521-595292 -# -# Revision: -# 091221 AxC Initialise -# 100103 WNB Make newstar_ger208.csh -# 100104 WNB Correct for absence 'standard' login -# 110307 AxC Make newstar_roberto236.csh -#- -# -# Define the name of this site -# -setenv n_site roberto236 -setenv n_install li -setenv n_hosts dop236 -setenv n_ftp ftp.astron.nl - -# -# Define the root of the Newstar directory tree -# -# unset some variables if people started old system first -unsetenv n_root n_src n_exe n_lib n_hlp n_arch n_doc -unsetenv n_inc n_tst n_batch n_master n_remote -# set the standard NFRA HOSTTYPE -setenv HOSTTYPE linux -# O.K. set root now -setenv n_root /dop236_0/newstar -setenv n_hlp $n_root/hlp - -# -# Make sure we have the standard settings (HOSTTYPE etc) -# -source $n_root/src/sys/newstar_env.csh -# -# Any non-standard environment settings should be made here -# -# -# Now do the general setup -# -source $n_root/src/sys/newstar_init.csh - -# -# Now do the general setup -# -##source $n_src/sys/init_wsrt.csh - -# -# Now we may wish to change anything we do not like -# -##alias nsmail "pine -I ^X,y -subject " -setenv LPATH /lib:/usr/lib - -# Define your www browser -# If you don't define it, xmosaic (part of newstar distibution) will be used -setenv n_www firefox - diff --git a/src/sys/newstar_roberto275.csh b/src/sys/newstar_roberto275.csh deleted file mode 100644 index da667ed9958cd2a507f47ab6ec172d6f69d8bcd1..0000000000000000000000000000000000000000 --- a/src/sys/newstar_roberto275.csh +++ /dev/null @@ -1,66 +0,0 @@ -# -# Local startup for Newstar (HjV 931007) -# -#+ -# Institute: Westerbork Synthese Radio TelescopeWNB Laptop -# Address: Schattenberg 1 -# 9433 TA Zwiggelte -# Netherlands -# Contact person: Arthur Coolen -# Email address: coolen@astron.nl -# FTP-node(s): -# Phone: 0521-595292 -# -# Revision: -# 091221 AxC Initialise -# 100103 WNB Make newstar_ger208.csh -# 100104 WNB Correct for absence 'standard' login -# 110307 AxC Make newstar_roberto236.csh -#- -# -# Define the name of this site -# -setenv n_site roberto275 -setenv n_install li -setenv n_hosts dop275 -setenv n_ftp ftp.astron.nl - -# -# Define the root of the Newstar directory tree -# -# unset some variables if people started old system first -unsetenv n_root n_src n_exe n_lib n_hlp n_arch n_doc -unsetenv n_inc n_tst n_batch n_master n_remote -# set the standard NFRA HOSTTYPE -setenv HOSTTYPE linux -# O.K. set root now -setenv n_root /dop275_0/newstar -setenv n_hlp $n_root/hlp - -# -# Make sure we have the standard settings (HOSTTYPE etc) -# -source $n_root/src/sys/newstar_env.csh -# -# Any non-standard environment settings should be made here -# -# -# Now do the general setup -# -source $n_root/src/sys/newstar_init.csh - -# -# Now do the general setup -# -##source $n_src/sys/init_wsrt.csh - -# -# Now we may wish to change anything we do not like -# -##alias nsmail "pine -I ^X,y -subject " -setenv LPATH /lib:/usr/lib - -# Define your www browser -# If you don't define it, xmosaic (part of newstar distibution) will be used -setenv n_www firefox - diff --git a/src/sys/newstar_roberto285.csh b/src/sys/newstar_roberto285.csh deleted file mode 100644 index 7a91d34ed52c85327a13130e5954608eac704204..0000000000000000000000000000000000000000 --- a/src/sys/newstar_roberto285.csh +++ /dev/null @@ -1,66 +0,0 @@ -# -# Local startup for Newstar (HjV 931007) -# -#+ -# Institute: Westerbork Synthese Radio TelescopeWNB Laptop -# Address: Schattenberg 1 -# 9433 TA Zwiggelte -# Netherlands -# Contact person: Arthur Coolen -# Email address: coolen@astron.nl -# FTP-node(s): -# Phone: 0521-595292 -# -# Revision: -# 091221 AxC Initialise -# 100103 WNB Make newstar_ger208.csh -# 100104 WNB Correct for absence 'standard' login -# 110307 AxC Make newstar_roberto236.csh -#- -# -# Define the name of this site -# -setenv n_site roberto285 -setenv n_install li -setenv n_hosts dop285 -setenv n_ftp ftp.astron.nl - -# -# Define the root of the Newstar directory tree -# -# unset some variables if people started old system first -unsetenv n_root n_src n_exe n_lib n_hlp n_arch n_doc -unsetenv n_inc n_tst n_batch n_master n_remote -# set the standard NFRA HOSTTYPE -setenv HOSTTYPE linux -# O.K. set root now -setenv n_root /dop285_0/newstar -setenv n_hlp $n_root/hlp - -# -# Make sure we have the standard settings (HOSTTYPE etc) -# -source $n_root/src/sys/newstar_env.csh -# -# Any non-standard environment settings should be made here -# -# -# Now do the general setup -# -source $n_root/src/sys/newstar_init.csh - -# -# Now do the general setup -# -##source $n_src/sys/init_wsrt.csh - -# -# Now we may wish to change anything we do not like -# -##alias nsmail "pine -I ^X,y -subject " -setenv LPATH /lib:/usr/lib - -# Define your www browser -# If you don't define it, xmosaic (part of newstar distibution) will be used -setenv n_www firefox - diff --git a/src/sys/newstar_rug.csh b/src/sys/newstar_rug.csh deleted file mode 100755 index b0a3b0d91a6f894ee6a119513056154dfb8a95b1..0000000000000000000000000000000000000000 --- a/src/sys/newstar_rug.csh +++ /dev/null @@ -1,66 +0,0 @@ -# -# Local startup for Newstar (CMV 930525) -# Revision: -# 931007 HjV Add MAG*-settings -# 931201 CMV Split off newstar_env.csh -# 940209 CMV Add tapeunit on Huygens -# 940613 HjV Add tapeunit on Magellan -# 950130 HjV Use $HOME in directories iso. ~ or ~/ -# 951212 HjV Add n_www -# 961212 HjV Add Solaris -# 981119 HjV Update for brahe (HPUX-10.20) and jeans (Solaris 2.6) -# 000308 AxC Update for /Software/users/newstar -# -#+ -# Institute: Kapteyn Instituut Rijks Universiteit Groningen -# Address: Kapteyn Instituut -# Postbus 800 -# 9700 AV Groningen -# Netherlands -# Contact person: Wim Zwitser -# Email address: zwitser@astro.rug.nl -# FTP-node(s): 129.125.6.131 (HP - brahe) -# 129.125.6.228 (SO - jeans) -# Phone: 050 - 3634071 -#- -# -# Define the name of this site -# -setenv n_site rug -setenv n_install hp/so -setenv n_hosts brahe,jeans -setenv LD_LIBRARY_PATH "${LD_LIBRARY_PATH}:/usr/ucblib" - -# -# Define the root of the Newstar directory tree -# -setenv n_root /Software/users/newstar -# -# Make sure we have the standard settings (HOSTTYPE etc) -# -source $n_root/src/sys/newstar_env.csh -# -# Any non-standard environment settings should be made here -# -# -# Now do the general setup -# -source $n_root/src/sys/newstar_init.csh - -# -# Now we may wish to change anything we do not like -# - -#Cannot handle /Software (capital in path gets lowercased). -setenv MODELB ~newstar/data/ - -setenv MAG0 "/dev/rmt/0l" -setenv MAG1 "/dev/rmt/0m" - -alias scissor $n_src/sys/scissor.csh -setenv QED1 //www.astron.nl:8083 # The scissor server - - -# Define your www browser -# If you don't define it, xmosaic (part of newstar distibution) will be used -setenv n_www netscape # where xyz is your favorite www browser diff --git a/src/sys/newstar_rul.csh b/src/sys/newstar_rul.csh deleted file mode 100755 index b6a4ae86740c4b642ef5a57a35bc881bc16cdf23..0000000000000000000000000000000000000000 --- a/src/sys/newstar_rul.csh +++ /dev/null @@ -1,73 +0,0 @@ -# -# Local startup for Newstar Sterrenwacht Leiden (CMV 931214) -# Revision: -# 931214 CMV Created -# 940328 HjV Test for n_root -# 950130 HjV New contact person -# 950623 HjV Change for new situation (add SUN) -# 951212 HjV Add n_www -# 040304 AxC 1st linux 4 leiden try -# -#+ -# Institute: Sterrenwacht Leiden -# Address: Huygens Lab -# P.O. Box 9513 -# 2300 RA Leiden -# Netherlands -# Contact person: Jeroen Stil -# Email address: stil@Strw.LeidenUniv.nl -# FTP-node(s): vecht.strw.LeidenUniv.nl (SW - vecht) -# strw.strw.LeidenUniv.nl (SW - strw) -# dollard.strw.LeidenUniv.nl (HP - dollard) -# schelde.strw.LeidenUniv.nl (HP - schelde) -# drech.strw.LeidenUniv.nl (HP - drecht) -# Phone: 071 - 275883 -#- -# -# Define the name of this site -# -setenv n_site rul -setenv n_install li -setenv n_hosts dolder - -# -# Define the root of the Newstar directory tree -# -setenv n_root /software/newstar -# -# Make sure we have the standard settings (HOSTTYPE etc) -# -source $n_root/src/sys/newstar_env.csh -# -# Any non-standard environment settings should be made here -# -# -# Now do the general setup -# -source $n_root/src/sys/newstar_init.csh -# -# Now we may wish to change anything we do not like -# -##if ($HOSTTYPE =~ hp*) then -## if ($?TAPE) then -## setenv MAG8 $TAPE -## else -## setenv MAG8 /dev/rmt/1m -## endif -##endif - -if ($HOST == vecht) then - -else if ($HOST == schelde) then - setenv MAG8 /dev/rmt/0mn -else if ($HOST == strw) then - setenv MAG8 /dev/nrst0 -else if ($HOST == drecht) then - setenv MAG8 /dev/rmt/0mn -else if ($HOST == dollard) then - setenv MAG9 /dev/rmt/2m -endif - -# Define your www browser -# If you don't define it, xmosaic (part of newstar distibution) will be used -#setenv n_www xyz # where xyz is your favorite www browser diff --git a/src/sys/newstar_ruu.csh b/src/sys/newstar_ruu.csh deleted file mode 100755 index b1fe9b6b3e2d5846cad6af97e9569136c0fab352..0000000000000000000000000000000000000000 --- a/src/sys/newstar_ruu.csh +++ /dev/null @@ -1,66 +0,0 @@ -# -# Local startup for Newstar (HjV 931007) -# -# Revision: -# CMV 940419 Add n_doabp setting -# HjV 940518 Change test for alpha -# SJH 960605 Adapt things for new server ruunf3 -# -#+ -# Institute: Sterrenkundig Instituut Rijks Universiteit Utrecht -# Address: Princetonplein 5 -# postbus 80000 -# 3508 TA Utrecht -# Netherlands -# Contact person: Sake J. Hogeveen -# Email address: hogeveen@fys.ruu.nl -# FTP-node(s): 131.211.32.203 (da - ruunf3) -# Phone: 030 - 2535227 (or 030 - 2535200) -#- -# -# Define the name of this site -# -setenv n_site ruu -setenv n_install dw/da -setenv n_hosts ruunb6,ruunf3 -setenv n_doabp ok - -# -# Define the root of the Newstar directory tree -# -setenv n_root /strknd/ULTRIX/lib/newstar -# -# Make sure we have the standard settings (HOSTTYPE etc) -# -source $n_root/src/sys/newstar_env.csh -# -# Any non-standard environment settings should be made here -# -if ($HOSTTYPE == "alpha") then -# -# The file system at Natk & Sterrek Utrecht has been configured such -# that nfs mounted disks are accessed by their genuine name from -# every workstation in the cluster --- Sake J. Hogeveen, 29/08/94. -# -# setenv n_root /nfs/ruunb6/b6-usr2/ULTRIX/lib/newstar - setenv n_root /strknd/ULTRIX/lib/newstar -# setenv n_exe /nfs/ruunb6/b6-usr2/OSF1/lib/newstar - setenv n_exe /strknd/OSF1/lib/newstar -endif -# -# Now do the general setup -# -source $n_root/src/sys/newstar_init.csh -# -# Now we may wish to change anything we do not like -# -if ($HOST == ruune7) then - setenv MAG8 "/dev/nrmt0h" -endif -if ($HOST == ruunf3) then - setenv MAG7 "/dev/nrmt2h" # DAT 2 - setenv MAG8 "/dev/nrmt1h" # DAT 1 - setenv MAG9 "/dev/nrmt0h" # Exabyte -endif -# - diff --git a/src/sys/newstar_sron.csh b/src/sys/newstar_sron.csh deleted file mode 100755 index 3244eafc5c9627bdf4d015b6f8e885b8e9b801ff..0000000000000000000000000000000000000000 --- a/src/sys/newstar_sron.csh +++ /dev/null @@ -1,55 +0,0 @@ -# -# Local startup for Newstar -# -# Revision: -# CMV 950105 Created -# HjV 951212 Add n_www -# -#+ -# Institute: SRON Utrecht -# Address: Sorbonnelaan 2 -# Postbus 80000 -# 3584 CA Utrecht -# Netherlands -# Contact person: Chiel Galama -# Email address: m.galama@sron.ruu.nl -# FTP-node(s): saturn.sron.ruu.nl (hp) -# Phone: 030 - 535644 -#- -# -# Define the name of this site -# -setenv n_site sron -setenv n_install hp -setenv n_hosts saturn -#setenv n_doabp ok - -# -# Define the root of the Newstar directory tree -# -if (-e /users/newstar/src) then - setenv n_root /users/newstar -else - setenv n_root /nfs/saturn/users/newstar -endif -# -# Make sure we have the standard settings (HOSTTYPE etc) -# -setenv HOSTTYPE hp9000s700 -source $n_root/src/sys/newstar_env.csh -# -# Any non-standard environment settings should be made here -# -# -# Now do the general setup -# -source $n_root/src/sys/newstar_init.csh -# -# Now we may wish to change anything we do not like -# -setenv MAG8 "/dev/rmt/c201d3m" -# - -# Define your www browser -# If you don't define it, xmosaic (part of newstar distibution) will be used -#setenv n_www xyz # where xyz is your favorite www browser diff --git a/src/sys/newstar_ucb.csh b/src/sys/newstar_ucb.csh deleted file mode 100755 index 8befcb4f20f71bf36b8c8ccb9ea5fb2bb0e7cfd9..0000000000000000000000000000000000000000 --- a/src/sys/newstar_ucb.csh +++ /dev/null @@ -1,54 +0,0 @@ -# -# Local startup for Newstar UCB (HjV 931216) -# Revision: -# 940914 HjV Created -# 951212 HjV Add n_www -# -#+ -# Institute: University of California at Berkeley -# Address: Astronomy / Radio Astronomy -# 601 Campbell Hall -# University of California -# Berkeley, CA94720 -# USA -# Contact person: Dan Plonsey -# Email address: dplonsey@astro.berkeley.edu -# FTP-node(s): floris.berkeley.edu -# Phone: (510)642-3163 -#- -# -# Define the name of this site -# -setenv n_site ucb -setenv n_install sw -setenv n_hosts floris - -# -# Define the root of the Newstar directory tree -# -setenv n_root /hond/newstar -setenv OPENWINHOME /usr/openwin -setenv LD_LIBRARY_PATH /usr/ucblib:/opt/SUNWspro/lib:$OPENWINHOME/lib:/usr/local/lib -# -# Make sure we have the standard settings (HOSTTYPE etc) -# -source $n_root/src/sys/newstar_env.csh -# -# Any non-standard environment settings should be made here -# -# -# Now do the general setup -# -source $n_root/src/sys/newstar_init.csh -# -# Now we may wish to change anything we do not like -# -if ($HOSTTYPE =~ sun*) then - setenv MAG0 /dev/rmt/0 # exabyte - setenv MAG1 /dev/rmt/1 # exabyte - setenv MAG2 /dev/rmt/2 # 9 track -endif - -# Define your www browser -# If you don't define it, xmosaic (part of newstar distibution) will be used -#setenv n_www xyz # where xyz is your favorite www browser diff --git a/src/sys/newstar_ucsb.csh b/src/sys/newstar_ucsb.csh deleted file mode 100755 index 8b97f6b84b710e1dd015714c1b10a916992a4f14..0000000000000000000000000000000000000000 --- a/src/sys/newstar_ucsb.csh +++ /dev/null @@ -1,59 +0,0 @@ -# -# Local startup for Newstar UCSB (HjV 931216) -# Revision: -# 931216 HjV Created -# 951212 HjV Add n_www -# 960129 HjV Add LD_LIBRARY_PATH -# -#+ -# Institute: University of California at Santa Barbara -# Address: Physics Department -# University of California -# Santa Barbara, CA 93106-9530 -# USA -# Contact person: Robert Geller -# Email address: rhmg@chester.physics.ucsb.edu -# FTP-node(s): 128.111.8.130 (SW - chester.physics.ucsb.edu) -# Phone: (805)893-8875 -#- -# -# Define the name of this site -# -setenv n_site ucsb -setenv n_install sw -setenv n_hosts chester - -# -# Define the root of the Newstar directory tree -# -setenv n_root /home/chester4/rhmg/newstar -# -# Make sure we have the standard settings (HOSTTYPE etc) -# -source $n_root/src/sys/newstar_env.csh -# -# Any non-standard environment settings should be made here -# -if ($?LD_LIBRARY_PATH) then - setenv LD_LIBRARY_PATH "$LD_LIBRARY_PATH":"/usr/lang/SC0.0" - else - setenv LD_LIBRARY_PATH "/usr/lang/SC0.0" -endif -# -# Now do the general setup -# -source $n_root/src/sys/newstar_init.csh -# -# Now we may wish to change anything we do not like -# -if ($HOSTTYPE =~ sun*) then - if ($?TAPE) then - setenv MAG8 $TAPE - else - setenv MAG8 /dev/rst0 - endif -endif - -# Define your www browser -# If you don't define it, xmosaic (part of newstar distibution) will be used -#setenv n_www xyz # where xyz is your favorite www browser diff --git a/src/sys/newstar_uva.csh b/src/sys/newstar_uva.csh deleted file mode 100755 index 17d093c1706078768a5ee1c78594fb1c13b04f96..0000000000000000000000000000000000000000 --- a/src/sys/newstar_uva.csh +++ /dev/null @@ -1,53 +0,0 @@ -# -# Local startup for Newstar (CMV 930922) -# Revision: -# 940413 CMV Created for UvA -# 951212 HjV Add n_www -#+ -# Institute: Sterrenkundig Instituut "Anton Pannekoek" -# Address: Kruislaan 403 -# 1098 SJ Amsterdam -# Netherlands -# Contact person: Michiel Berger -# Email address: michielb@astro.uva.nl -# FTP-node(s): helios.astro.uva.nl (HP) -# Phone: 020 - 5257482 -#- -# -# Define the name of this site -# -setenv n_site uva -setenv n_install hp -setenv n_hosts helios - -# -# Define the root of the Newstar directory tree -# -setenv n_root /sirius/u/michielb/newstar -# -# Make sure we have the standard settings (HOSTTYPE etc) -# -source $n_root/src/sys/newstar_env.csh -# -# Any non-standard environment settings should be made here -# -# -# Now do the general setup -# -source $n_root/src/sys/newstar_init.csh -# -# Now we may wish to change anything we do not like -# -if ($HOST == helios) then - setenv MAG8 "/dev/rmt/c201d1m" -endif - -# Define your www browser -# If you don't define it, xmosaic (part of newstar distibution) will be used -#setenv n_www xyz # where xyz is your favorite www browser - -# -# Remote tape-units on the VAX (Optical Disks) -# -#setenv MAG4 //rzmvx4.astron.nl:1100/RZMVX4\$MUA0: -#setenv MAG5 //rzmvx4.astron.nl:1101/RZMVX4\$MUA1: diff --git a/src/sys/newstar_wenss.csh b/src/sys/newstar_wenss.csh deleted file mode 100755 index 5915524623c3ec6431ce481d8d77b325b3cff71b..0000000000000000000000000000000000000000 --- a/src/sys/newstar_wenss.csh +++ /dev/null @@ -1,106 +0,0 @@ -# -# Local startup for Newstar for WENSS (HjV 931223) -# Revision: -# 940419 CMV Add n_doabp setting -# 941109 CMV Add scissor commands -# 950130 HjV Use $HOME in directories iso. ~ or ~/ -# 950329 HjV Executable and libraries now local (on /user8) -# 950529 HjV Make WENSS a separate site -# 951012 HjV Add DAT-device for DAW13 -# 951212 HjV Add n_www -# -#+ -# Institute: Netherlands Foundation for Research in Astronomy -# Address: WENSS-project -# P.O. Box 2 -# 7990 AA Dwingeloo -# Netherlands -# Contact person: Yuan Tang -# Email address: tang@astron.nl -# FTP-node(s): 192.87.1.158 (HP - daw08) -# Phone: 05219 - 7244 Ext 249 -#- -# -# Define the name of this site -# -setenv n_site wenss -setenv n_install hp -setenv n_hosts daw08 -setenv n_doabp ok - -# -# Define the root of the Newstar directory tree -# -# unset some variables if people started old system first -unsetenv n_root n_src n_exe n_lib n_hlp n_arch n_doc -unsetenv n_inc n_tst n_batch n_master n_remote -# O.K. set root now -setenv n_root /user8/newstar -# -# Make sure we have the standard settings (HOSTTYPE etc) -# -source $n_root/src/sys/newstar_env.csh -# -# Any non-standard environment settings should be made here -# -if ($HOSTTYPE =~ sun*) setenv LD_LIBRARY_PATH "/usr/openwin/lib:/usr/lib" -# -# Print newstar news (when available, and only once!) -# -if (! $?DWARF_SYMBOLS && -e $n_root/import/newstar.news) cat $n_root/import/newstar.news -# -# Now do the general setup -# -source $n_root/src/sys/newstar_init.csh - -alias scissor $n_src/sys/scissor.csh -alias sctar scissor tar -alias scship scissor ship -alias scinit scissor init -alias scmail scissor mail -setenv QED1 //www.astron.nl:8083 # The scissor server - -# -# Now we may wish to change anything we do not like -# -if ($HOSTTYPE =~ sun*) then - setenv MAG8 "/dev/rst1" # 1 Giga DAT DDS - setenv MAG9 "/dev/rst0" # Exabyte -else if ($HOSTTYPE =~ hp*) then - if ($HOST == rzmws4 || $HOST == rzmws5 || $HOST == daw08) then - setenv MAG8 "/dev/rmt/0m" - else if ($HOST == rzmws6 || $HOST == rzmws7) then - setenv MAG8 "/dev/rmt/c201d3m" - else if ($HOST == daw13) then - setenv MAG8 "/dev/rmt/1m" - setenv MAG9 "/dev/rmt/3m" - endif -endif - -# Define your www browser -# If you don't define it, xmosaic (part of newstar distibution) will be used -setenv n_www netscape - - -# -# Print on the line printer (some people are used to this command) -# -alias pvax "wngfex sp \!* " - -# -# Not everybody has elm in his path -# -if ($n_arch == sw) then - if ($USER == jph) alias elm \mail -endif - -# -# Some tricky things for GIDS -# -if ($?DISPLAY) then - setenv DEFAULT_DISPLAY $HOME/.gids-$DISPLAY - if ($DISPLAY =~ rzmws5*) then # Cannot use gipsy gids - setenv gids_setup ~ger - endif -endif - diff --git a/src/sys/newstar_wnbl.csh b/src/sys/newstar_wnbl.csh deleted file mode 100644 index 496603bdffbc7d5bc45423225b2a8d5166293050..0000000000000000000000000000000000000000 --- a/src/sys/newstar_wnbl.csh +++ /dev/null @@ -1,56 +0,0 @@ -# -# Local startup for Newstar (HjV 931007) -# -#+ -# Institute: Westerbork Synthese Radio TelescopeWNB Laptop -# Address: Schattenberg 1 -# 9433 TA Zwiggelte -# Netherlands -# Contact person: Wim Brouw -# Email address: brouw@astron.nl -# FTP-node(s): -# Phone: 050 3634067 -# -# Revision: -# 070831 WNB Initialise -#- -# -# Define the name of this site -# -setenv n_site wnbl -setenv n_install li -setenv n_hosts debian - -# -# Define the root of the Newstar directory tree -# -setenv n_root /nstar -setenv n_hlp $n_root/hlp - -# -# Make sure we have the standard settings (HOSTTYPE etc) -# -source $n_root/src/sys/newstar_env.csh -# -# Any non-standard environment settings should be made here -# -# -# Now do the general setup -# -source $n_root/src/sys/newstar_init.csh - -# -# Now do the general setup -# -##source $n_src/sys/init_wsrt.csh - -# -# Now we may wish to change anything we do not like -# -##alias nsmail "pine -I ^X,y -subject " -setenv LPATH /lib:/usr/lib - -# Define your www browser -# If you don't define it, xmosaic (part of newstar distibution) will be used -setenv n_www firefox - diff --git a/src/sys/newstar_wnbt.csh b/src/sys/newstar_wnbt.csh deleted file mode 100644 index c3e3e9488065ba57cad5ef5843a3abbf2e0442cd..0000000000000000000000000000000000000000 --- a/src/sys/newstar_wnbt.csh +++ /dev/null @@ -1,57 +0,0 @@ -# -# Local startup for Newstar (HjV 931007) -# -#+ -# Institute: Westerbork Synthese Radio TelescopeWNB Laptop -# Address: Schattenberg 1 -# 9433 TA Zwiggelte -# Netherlands -# Contact person: Wim Brouw -# Email address: brouw@astron.nl -# FTP-node(s): -# Phone: 050 3634067 -# -# Revision: -# 070831 WNB Initialise -# 090303 WNB Initialise tmp version -#- -# -# Define the name of this site -# -setenv n_site wnbt -setenv n_install li -setenv n_hosts debian - -# -# Define the root of the Newstar directory tree -# -setenv n_root /nstar/tmp -setenv n_hlp $n_root/hlp - -# -# Make sure we have the standard settings (HOSTTYPE etc) -# -source $n_root/src/sys/newstar_env.csh -# -# Any non-standard environment settings should be made here -# -# -# Now do the general setup -# -source $n_root/src/sys/newstar_init.csh - -# -# Now do the general setup -# -##source $n_src/sys/init_wsrt.csh - -# -# Now we may wish to change anything we do not like -# -##alias nsmail "pine -I ^X,y -subject " -setenv LPATH /lib:/usr/lib - -# Define your www browser -# If you don't define it, xmosaic (part of newstar distibution) will be used -setenv n_www firefox - diff --git a/src/sys/newstar_wnbt208.csh b/src/sys/newstar_wnbt208.csh deleted file mode 100644 index aab6a0a14802a705ca9736d1be896c310d14ec4a..0000000000000000000000000000000000000000 --- a/src/sys/newstar_wnbt208.csh +++ /dev/null @@ -1,58 +0,0 @@ -# -# Local startup for Newstar (HjV 931007) -# -#+ -# Institute: Westerbork Synthese Radio TelescopeWNB Laptop -# Address: Schattenberg 1 -# 9433 TA Zwiggelte -# Netherlands -# Contact person: Arthur Coolen -# Email address: coolen@astron.nl -# FTP-node(s): -# Phone: 0521-595292 -# -# Revision: -# 091221 AxC Initialise -# 091221 WNB Start -#- -# -# Define the name of this site -# -setenv n_site wnbt208 -setenv n_install li -setenv n_hosts dop208 -setenv n_ftp ftp.astron.nl - -# -# Define the root of the Newstar directory tree -# -setenv n_root /dop208_1/wnb/nstar -setenv n_hlp $n_root/hlp - -# -# Make sure we have the standard settings (HOSTTYPE etc) -# -source $n_root/src/sys/newstar_env.csh -# -# Any non-standard environment settings should be made here -# -# -# Now do the general setup -# -source $n_root/src/sys/newstar_init.csh - -# -# Now do the general setup -# -##source $n_src/sys/init_wsrt.csh - -# -# Now we may wish to change anything we do not like -# -##alias nsmail "pine -I ^X,y -subject " -setenv LPATH /lib:/usr/lib - -# Define your www browser -# If you don't define it, xmosaic (part of newstar distibution) will be used -setenv n_www firefox - diff --git a/src/sys/newstar_wsrt.csh b/src/sys/newstar_wsrt.csh deleted file mode 100755 index b540fff2770a8f20e532ac2d7a1f2f82101ff99a..0000000000000000000000000000000000000000 --- a/src/sys/newstar_wsrt.csh +++ /dev/null @@ -1,66 +0,0 @@ -# -# Local startup for Newstar (HjV 931007) -# -#+ -# Institute: Westerbork Synthese Radio Telescope -# Address: Schattenberg 1 -# 9433 TA Zwiggelte -# Netherlands -# Contact person: Teun Grit -# Email address: grit@astron.nl -# FTP-node(s): 192.87.1.225 (HP - wsrt00) -# Phone: 05933 - 2421 -# -# Revision: -# 940711 CMV Initialise wsrt environment as well -# 941109 CMV Add scissor commands -# 951212 HjV Add n_www -# 960329 JPH n_www = netscape -#- -# -# Define the name of this site -# -setenv n_site wsrt -setenv n_install hp -setenv n_hosts waw01 - -# -# Define the root of the Newstar directory tree -# -setenv n_root /users/srt/nst -# -# Make sure we have the standard settings (HOSTTYPE etc) -# -source $n_root/src/sys/newstar_env.csh -# -# Any non-standard environment settings should be made here -# -# -# Now do the general setup -# -source $n_root/src/sys/newstar_init.csh - -alias scissor $n_src/sys/scissor.csh -alias sctar scissor tar -alias scship scissor ship -alias scinit scissor init -alias scmail scissor mail -setenv QED1 //www.astron.nl:8083 # The scissor server - -# -# Now do the general setup -# -source $n_src/sys/init_wsrt.csh - -# -# Now we may wish to change anything we do not like -# -alias nsmail "pine -I ^X,y -subject " -if ($HOST =~ wsrt*) then - setenv MAG8 "/dev/rmt/0m" -endif - -# Define your www browser -# If you don't define it, xmosaic (part of newstar distibution) will be used -setenv n_www netscape - diff --git a/src/sys/obslog.pls b/src/sys/obslog.pls deleted file mode 100755 index da8a093b37e822a141b2e268918889a30dfe4e97..0000000000000000000000000000000000000000 --- a/src/sys/obslog.pls +++ /dev/null @@ -1,477 +0,0 @@ -#!/local/bin/perl -I/local/lib/perl5 -# -# obslog.pls created by hjv -# -#+ obslog.pls -# -# This script will have one argument: MMMYYYYOBS -# The program will look for the file MMMYYYYOBS.TXT -# -# It will do the following steps: -# 1 - Read logbook from wsrt00 (MMMYYYYOBS.TXT) line for line -# every line should have at least 7 arguments: -# 1. sequencenr. -# 2. logdate (ddMmmyy) -# 3. logtime (hh:mm:ss) -# 4. name of person who added entry -# 5. category -# 6. subsystem -# 7. remarks -# N.B. For the following combination of (category,subsystem) -# 6 arguments are enough: -# (TRO,PH) - tropospherische fase fluctuaties -# (SUN,A.) or (SUN,C.) - zonnestoring -# read the values for every field and -# try to extract stuff from "remarks" and put the new values -# 2 - into the fields "HARANGE" and "DESCRIPTION" -# 3 - into the fields "CHANNELS" and "DESCRIPTION" -# 4 - into the fields "IFRS" and "DESCRIPTION" -# -# Output will be written in wsrtlog.MMMYYYYOBS -# -# HjV 970814 Created -# -# Preamble -# -# -unless (defined $VMS) { - $VMS=0; - if ($ENV{"SHELL"}) { # aid routines unix - unshift(@INC,$ENV{'n_src'}.'/sys'); - } - unless (require "c2aid.pls") { # general aid routines - print "Fatal: Cannot load c2aid.pls properly"; - exit; - } - &ENV_IMPORT; # get environment - $argv=join(" ",@ARGV); # get command arguments -} - -# -$nrargs=scalar(@ARGV); -if ($nrargs != 1) { - &echo("","One argument needed: "); - &echo("","\tmonth and year to process on format: MMMYYYY"); - &echo("","Program stop."); - exit; -} -($What=@ARGV[0]) =~ tr/a-z/A-Z/; - -# -# Initialise -# -$Logfile="tmp.log"; - -# -# Construct the date/time strings, define logfile -# -$Myname= &Pipe("p$$.tmp00", &awk( "-F:" , '{ if ($1 == "' . $USER - .'") print $5 }' , "/etc/passwd" , "p$$.tmp00" ) ) - ; -if ( &eq( $Myname , '' ) ) { $Myname= &Pipe("p$$.tmp00", &whoami( - "p$$.tmp00" ) ) ; } -$dt= &Pipe("p$$.tmp00", &date( "p$$.tmp00" ) ) ; -if ( &peq( (split(' ',$dt)) [ 3 -1 ] , "[1-9]" ) # day - ) { @dt=split(' ',$dt); splice(@dt, "3" -1,1, - (split(' ',$dt)) [ 3 -1 ] ); $dt=join(' ',@dt); } -$Umc= "JAN" .' '. "FEB" .' '. "MAR" .' '. "APR" .' '. "MAY" .' '. "JUN" - .' '. "JUL" .' '. "AUG" .' '. "SEP" .' '. "OCT" - .' '. "NOV" .' '. "DEC" ; -$lmc= "jan" .' '. "feb" .' '. "mar" .' '. "apr" .' '. "may" .' '. "jun" - .' '. "jul" .' '. "aug" .' '. "sep" .' '. "oct" - .' '. "nov" .' '. "dec" ; -$mc= "Jan" .' '. "Feb" .' '. "Mar" .' '. "Apr" .' '. "May" .' '. "Jun" - .' '. "Jul" .' '. "Aug" .' '. "Sep" .' '. "Oct" - .' '. "Nov" .' '. "Dec" ; -$days= "31" .' '. "28" .' '. "31" .' '. "30" .' '. "31" .' '. "30" - .' '. "31" .' '. "31" .' '. "30" .' '. "31" - .' '. "30" .' '. "31" ; -$mnr= "01" .' '. "02" .' '. "03" .' '. "04" .' '. "05" .' '. "06" .' '. - "07" .' '. "08" .' '. "09" .' '. "10" .' '. "11" .' '. "12" ; -@mnr = split(' ',$mnr); -@days = split(' ',$days); -for $mm__x (split(' ',join(' ' , "01" , "02" , "03" , "04" , "05" , "06" - , "07" , "08" , "09" , "10" , "11" , "12" ))) { - $mm=$mm__x ; - if ( &eq( (split(' ',$dt)) [ 2 -1 ] , # month - (split(' ',$mc)) [ $mm -1 ] ) ) { last ; } -} -$yy= (split(' ',$dt)) [ &vn($dt) -1 ] - 1900 ; # year -$mh= &Pipe("p$$.tmp00", &echo( '' , &fn( # hh mm ss - (split(' ',$dt)) [ 4 -1 ] ) , "p$$.tmp01" ) , &tr( - "-s" , ":" , " " , "p$$.tmp01" , "p$$.tmp00" ) ) - ; -$C_Date= $yy . $mm . (split(' ',$dt)) [ 3 -1 ] ; # date: yymmdd -$C_Time= (split(' ',$mh)) [ 1 -1 ] . # time: hhmm - (split(' ',$mh)) [ 2 -1 ] ; -undef $dt; -system("rm -f p*.tmp*"); # Remove temp. file -# -# -# -# Step 1 - Read "MMMYYYYOBS.TXT" line for line -# read the values for every field -# try to extract stuff from "REMARKS" and put the new values -# into the fields "CHANNELS", "IFRS", "HARANGE" and "DESCRIPTION" -$Infile="${What}.TXT"; -$Outfile="wsrtlog.${What}"; -open(IN,"$Infile") || die "Cannot open $Infile";; -open(OUT,">$Outfile") || die "Cannot open $Outfile";; -# Read the lines -$linenr=2; -$ha=$hb=$hc=$hd=$he=$hf=$ho=0; -$ca=$cb=$cc=$cd=$ce=$cf=$co=0; -$ia=$ib=$ic=$id=$ie=$ig=$ih=$ii=$ij=$ik=$io=0; -$lcom=$lerror=$linenr=0; -while ( $line = <IN>) { - $linenr++; # lines read - if (substr($line,0,1) eq "#") { $lcom++; next; } # comment line - @line=split(' ',$line); # delimited with space - $ifrs=$harng=$chan=$descr=""; - $seqnr=@line[0]; - $logdate=@line[1]; - $logtime=@line[2]; - $name=@line[3]; - $cat=@line[4]; - $ssy=@line[5]; - $error="Line $linenr has not enough arguments (minimal 7 needed):"; - if (($nr_arg=scalar(@line)) < 6) { - &echo ("","$error \n\t$line"); - $lerror++; - next; - } - elsif (($nr_arg=scalar(@line)) == 6) { - if ((($cat eq "TRO") && ($ssy eq "PH")) || - (($cat eq "SUN") && (($ssy eq "A.") || ($ssy eq "C.")))) { - goto SCHRIJF; - } else { - &echo ("","$error \n\t$line"); - $lerror++; - next; - } - } - for ($i=6;$i<=$nr_arg-1;$i++) { - $descr=$descr . " " . @line[$i]; - } - -AGAIN: { -# -# -# -# Step 2 - try to extract stuff from "remarks" and put the new values -# into the fields "HARANGE" and "DESCRIPTION" -# -# Select "< HA <" - if ($descr =~ /.*( [+~-]?[0-9]+[\.[0-9]*]?[ ]?[<>][ ]?HA[ ]?[<>][ ]?[+~-]?[0-9]+[\.[0-9]*]?).*/i) { - if ($harng eq "") { - $harng = $1; - } else { - $harng = $1 . "," . $harng; - } - @newdescr=split(/$harng/,$descr); - $descr=join(' ',@newdescr); - $ha++; - } -# Select "< HA" - elsif ($descr =~ /.*( [~]?[ ]?[+-]?[0-9]*[\.[0-9]*]?[<>][ ]?HA).*/i) { - if ($harng eq "") { - $harng = $1; - } else { - $harng = $1 . "," . $harng; - } - @newdescr=split(/$harng/,$descr); - $descr=join(' ',@newdescr); - $hb++; - } -# Select "at HA ," - elsif ($descr =~ /.*(at HA[ ]?[ ~+<>-]+[ ]?[-+]?[0-9]*[\.[0-9]*]?[, ]?[+-]?[0-9]*[\.[0-9]*]?).*/i) { - @newdescr=split(/$1/,$descr); - $descr=join(' ',@newdescr); - ($tmp=$1) =~ s/(at )(.*)/$2/i; # remove "at " - if ($harng eq "") { - $harng = $tmp; - } else { - $harng = $tmp . "," . $harng; - } - $he++; - } -# Select "HA <" - elsif ($descr =~ /.*(HA[ ]?[<>][ ]?[~]?[ ]?[-+]?[0-9]*[\.[0-9]*]?).*/i) { - $harng = $1; - @newdescr=split(/$harng/,$descr); - $descr=join(' ',@newdescr); - $hc++; - } -# Select "HA TO" - elsif ($descr =~ /.*(HA [~]?[ ]?[+-]?[0-9]*[\.[0-9]*]? TO [+-]?[0-9]*[\.[0-9]*]?).*/i) { - if ($harng eq "") { - $harng = $1; - } else { - $harng = $1 . "," . $harng; - } - @newdescr=split(/$harng/,$descr); - $descr=join(' ',@newdescr); - $hd++; - } -# Select "HA ," - elsif ($descr =~ /.*(HA[ ]?[ ~+-]+[ ]?[+-]?[0-9]*[\.[0-9]*]?)([\[,\]?\[ \]?\[+-\]?\[0-9\]*\[\.\[0-9\]*\]?]*).*/i) { - $tmp = $1 . $2; - if ($harng eq "") { - $harng = $tmp; - } else { - $harng = $tmp . "," . $harng; - } - @newdescr=split(/$tmp/,$descr); - $descr=join(' ',@newdescr); - $he++; - } - else { - $ho++; - } -# -# -# -# Step 2 - try to extract stuff from "remarks" and put the new values -# into the fields "CHANNELS" and "DESCRIPTION" -# Select Freq.channels - if ($descr =~ /.*(F[0-9][0-9][0-9]*-F[0-9][0-9][0-9]*).*/i) { - $chan = $1; - @newdescr=split(/$chan/,$descr); - $descr=join(' ',@newdescr); - $ca++; - redo AGAIN; - } - elsif ($descr =~ /.*(F[0-9]-F[0-9][0-9][0-9]*).*/i) { - $chan = $1; - @newdescr=split(/$chan/,$descr); - $descr=join(' ',@newdescr); - $cb++; - redo AGAIN; - } - elsif ($descr =~ /.*(F[0-9]-F[0-9]).*/i) { - $chan = $1; - @newdescr=split(/$chan/,$descr); - $descr=join(' ',@newdescr); - $cc++; - redo AGAIN; - } - elsif ($descr =~ /.*(F[0-9][0-9]* TO F[0-9][0-9]*).*/i) { - while ($descr =~ /.*(F[0-9][0-9]* TO F[0-9][0-9]*).*/i) { - if ($chan eq "") { - $chan = $1; - } else { - $chan = $1 . "," . $chan; - } - @newdescr=split(/$1/,$descr); - $descr=join(' ',@newdescr); - $cd++; - } - redo AGAIN; - } - elsif ($descr =~ /.*(F[0-9][0-9]+).*/i) { - while ($descr =~ /.*(F[0-9][0-9]+).*/i) { - if ($chan eq "") { - $chan = $1; - } else { - $chan = $1 . "," . $chan; - } - @newdescr=split(/$1/,$descr); - $descr=join(' ',@newdescr); - $ce++; - redo AGAIN; - } - } - elsif ($descr =~ /.*(F[0-9]).*/i) { - while ($descr =~ /.*(F[0-9]).*/i) { - if ($chan eq "") { - $chan = $1; - } else { - $chan = $1 . "," . $chan; - } - @newdescr=split(/$1/,$descr); - $descr=join(' ',@newdescr); - $cf++; - redo AGAIN; - } - } - else { - $co++; - } - $chan =~ tr/F//d; -# -# -# -# Step 4 - try to extract stuff from "remarks" and put the new values -# into the fields "IFRS" and "DESCRIPTION" -# -# Select Interferometers - if ($descr =~ /.*(RT[0-9][ ]?).*/i) { - if ($ifrs eq "") { - $ifrs = substr($1,2,1) . "***"; - } else { - $ifrs = substr($1,2,1) . "***" . "," . $ifrs; - } - @newdescr=split(/$1/,$descr); - $descr=join(' ',@newdescr); - $ia++; - redo AGAIN; - } - elsif ($descr =~ /.*(RT[A-D][ ]?).*/) { # only in capitals - if ($ifrs eq "") { - $ifrs = "**" . substr($1,2,1) . "*"; - } else { - $ifrs = "**" . substr($1,2,1) . "*," . $ifrs; - } - @newdescr=split(/$1/,$descr); - $descr=join(' ',@newdescr); - $ib++; - redo AGAIN; - } - elsif ($descr =~ /.*(RT[0-9][A-D]).*/) { # only in capitals - if ($ifrs eq "") { - $ifrs = substr($1,2,1) . "*" . substr($1,3,1) . "*"; - } else { - $ifrs = substr($1,2,1) . "*" . substr($1,3,1) . "*," . $ifrs; - } - @newdescr=split(/$1/,$descr); - $descr=join(' ',@newdescr); - $ic++; - redo AGAIN; - } - elsif ($descr =~ /.*(RT[s]? [0-9A-D,]+).*/) { # only in capitals - @ifrs = split(/ /,$1); - $ifrs = @ifrs[1]; - @newdescr=split(/$1/,$descr); - $descr=join(' ',@newdescr); - $ik++; - redo AGAIN; - } - elsif ($descr =~ /.*([0-9*][XY*][A-D*][XY*]).*/i) { - while ($descr =~ /.*([0-9*][XY*][A-D*][XY*][,]?).*/i) { - ($tmp=$1) =~ tr/*/%/; - $ifrs = $1 . $ifrs; - @newdescr=split(/$tmp/,$descr); - $descr=join(' ',@newdescr); - if (index($tmp,"%") > -1) { last; } - } - $id++; - if (index($tmp,"%") == -1) { redo AGAIN; } - } - elsif ($descr =~ /.*([0-9][XY][XY][,]?).*/i) { - if ($ifrs eq "") { - $ifrs = substr($1,0,2) . "**," . substr($1,0,1) .substr($1,2,1) . "**"; - } else { - $ifrs = substr($1,0,2) . "**," . substr($1,0,1) .substr($1,2,1) . "**" . $ifrs; - } - @newdescr=split(/$1/,$descr); - $descr=join(' ',@newdescr); - $ie++; - redo AGAIN; - } - elsif ($descr =~ /.*([A-D][XY][XY][,]?).*/i) { - if ($ifrs eq "") { - $ifrs = "**" . substr($1,0,2) . ",**" . substr($1,0,1) . substr($1,2,1); - } else { - $ifrs = "**" . substr($1,0,2) . ",**" . substr($1,0,1) . substr($1,2,1) . $ifrs; - } - @newdescr=split(/$1/,$descr); - $descr=join(' ',@newdescr); - $ig++; - redo AGAIN; - } - elsif ($descr =~ /.*([0-9][XY] TO [0-9][XY]).*/i) { - $ifrs = $1; - @newdescr=split(/$1/,$descr); - $descr=join(' ',@newdescr); - $ih++; - } - elsif ($descr =~ /.*([A-D][XY] TO [A-D][XY]).*/i) { - $ifrs = $1; - @newdescr=split(/$1/,$descr); - $descr=join(' ',@newdescr); - $ii++; - } - elsif ($descr =~ /.*([0-9|A-D][XY]).*/) { # only Capitals - while ($descr =~ /.*([0-9|A-D][XY][,]?).*/) { - if ($ifrs eq "") { - $ifrs = $1; - } else { - if (index($1,",") == -1) { - $ifrs = $1 . "," . $ifrs; - } else { - $ifrs = $1 . $ifrs; - } - } - @newdescr=split(/$1/,$descr); - $descr=join(' ',@newdescr); - } - $ij++; - } - else { - $io++; - } -} # end AGAIN -# -# -# -# -# Remove leading blanks from description -# Remove some dots -# replace the =-sign with the text " is " - $descr =~ s/^ \x2F (.*)/$1/; # remove " / " - $descr =~ s/^[ ]*(.*)/$1/; # remove blanks at begin line - $name =~ s/[\.]*//g; # remove dots - $cat =~ s/[\.]*//g; # remove dots - $ssy =~ s/[\.]*//g; # remove dots - $descr =~ s/=/ is /g; # replace = with " is " - -SCHRIJF: -# Date format in: dd/mm/yyyy - for ($mm=1;$mm<=12;$mm++) { - if ( substr($logdate,2,3) eq (split(' ',$mc)) [ $mm-1 ] ) { - $logdate=substr($logdate,0,2) . "/" . @mnr[$mm-1] . "/19" . substr($logdate,5,2); - last; - } - } -# Write into new file - print OUT "PUT=OBSLOG SEQNUMBER=${seqnr} LOGDATE=${logdate} LOGTIME=${logtime} name=${name} CATEGORY=${cat} SUBSYSTEM=${ssy} CHANNELS=${chan} INTERFEROMETERS=${ifrs} HA_RANGE=${harng} DESCRIPTION=${descr}\n"; -} -close IN; -close OUT; -# -# -# Some statistics -# -&echo ("","\nRead $linenr lines, of which $lcom comment-lines and $lerror with not enough arguments"); -&echo ("","\n\nHour-Angle "); -&echo ("","1. <HA< a -- $ha times"); -&echo ("","2. 0-9 HA -- $hb times"); -&echo ("","3. HA 0-9 -- $hc times"); -&echo ("","4. HA a-z to -- $hd times"); -&echo ("","5. HA a-z , -- $he times"); -&echo (""," Other -- $ho times"); -&echo ("","\n\nChannels "); -&echo ("","1. Fxx-Fxx -- $ca times"); -&echo ("","2. Fx-Fxx -- $cb times"); -&echo ("","3. Fx-Fx -- $cc times"); -&echo ("","4. Fx to Fx -- $cd times"); -&echo ("","5. Fxx -- $ce times"); -&echo ("","6. Fx -- $cf times"); -&echo (""," Other -- $co times"); -&echo ("","\n\nInterferometers "); -&echo ("","1. RTf -- $ia times"); -&echo ("","2. RTm -- $ib times"); -&echo ("","3. RTfm -- $ic times"); -&echo ("","4. fxmy -- $id times"); -&echo ("","5. fxy -- $ie times"); -&echo ("","6. mxy -- $ig times"); -&echo ("","7. f. to f. -- $ih times"); -&echo ("","8. m. to m. -- $ii times"); -&echo ("","9. f. of m. -- $ij times"); -&echo ("","10.RTs x,x,x -- $ik times"); -&echo (""," Other -- $io times"); -# -# Postamble -# -&ENV_EXPORT; # save environment -# diff --git a/src/sys/scissor.c b/src/sys/scissor.c deleted file mode 100644 index 8a9d04a6d3b89a7ee2f9809e6756d0e8a184bab9..0000000000000000000000000000000000000000 --- a/src/sys/scissor.c +++ /dev/null @@ -1,404 +0,0 @@ -/* - *$Prog$ - * - * $Id$ - * - * $Purpose: Standalone client to call upon scissor from Newstar - * - * $Usage: Command scissor has to be defined to run this program - * - * $Log$ - * - * Revision history: - * - * CMV 941103 Created from client.exa - * CMV 950123 Return exit status - * - * Environment: - * - * QED1 The url to qed (like //www.astron.nl:8083) - * USER Current user - * SCIPWD The password of this user on qed - * QEDDEBUG Print every line returned by qed? - * - * QEDDEBUG is only tested if a single command is sent, in interactive - * mode all output is printed. - * - * This client allows to override the settings for QED1, USER - * and SCIPWD by specifying altenative values on the commandline: - * //host:port user password - * - * If the first argument does not start with //, the arguments will - * be sent to qed (defined by QED1) as a single command. - * - * Otherwise this client will repeatedly ask for commands to be sent - * to the qed. The extra command "quit" closes the connection. - * - *$/Prog$ - */ - -static char _ID_[]="$Id$"; - -#include <stdlib.h> -#include <stdio.h> - -static void usage(name) - -char *name; - -{ - fprintf(stderr,"\nSyntax: %s [server username password]\n",name); - fprintf(stderr, " or: %s [command]\n",name); - fprintf(stderr, " where server is: //host:port\n"); - fprintf(stderr, " and command is a single command for qed\n\n"); - fprintf(stderr, "If no server, username and password are given,\n"); - fprintf(stderr, "they are taken from $QED1, $USER and $SCIPWD.\n"); - fprintf(stderr, "If no command is given, %s enters an interactive\n"); - fprintf(stderr, "mode, use quit or bye to exit.\n\n"); - exit(1); -} - - -main(argc,argv) - -int argc; -char **argv; - -{ - int ld,cmd,st,qeddebug; - char buf[1024],retbuf[1024]; - - /* - If the first argument starts with // it is an URL, - else it is a command. - */ - cmd=(argc>1 && argv[1][0]!='/' && argv[1][1]!='/'); - - /* - No switches are allowed, they all generate the help message - If an URL is given, user and passwd are required - */ - if (( cmd && argv[1][0]=='-') || - (!cmd && argc!=1 && argc!=4)) usage(argv[0]); - - /* - If QEDDEBUG is defined, debugging is turned on. - Interactive mode always has debugging on. - */ - qeddebug=(getenv("QEDDEBUG")!=NULL || !cmd); - - /* - Make a connection. - open_socket returns the socket to be used in further calls - if the connection could not be made, it returns -1 - */ - if ( (cmd || argc==1) && getenv("QED1")==NULL) { - fprintf(stderr,"No server specified, cannot connect...\n"); - usage(argv[0]); - } else if (cmd || argc==1) { - ld=open_socket(getenv("QED1")); - } else { - ld=open_socket(argv[1]); - } - - if (ld<=0) { - fprintf(stderr,"\nCould not connect to Scissor, aborting\n"); - exit(1); - } - - /* - The first command should be an authorisation - The syntax is hello=user:password - send_command returns the status code from the server. - Codes 100,200 etc are returned on successful commands - In this case, we expect 100 to be returned for validation - */ - if (cmd || argc==1) { - if (getenv("SCIPWD")==NULL) { - sprintf(buf,"HELLO=%s",getenv("USER")); - } else { - sprintf(buf,"HELLO=%s:%s",getenv("USER"),getenv("SCIPWD")); - } - } else { - sprintf(buf,"hello=%s:%s",argv[2],argv[3]); - } - - if (send_command(ld,buf,retbuf,1024,qeddebug)%100 !=0) { - fprintf(stderr,"\nInvalid password for Scissor...\n"); - exit(1); - } - - /* - If a single command was given, handle it - */ - if (cmd) { - for (cmd=1,buf[0]='\0'; cmd<argc; cmd++) { - strcat(buf,argv[cmd]); - strcat(buf," "); - } - st=send_command(ld,buf,retbuf,1024,qeddebug); - if (!qeddebug) printf("%s\n",retbuf); - - /* - Else read commands until the user gives a quit. - If a line with something on it is given, send the command. - */ - } else { - while (strncasecmp(buf,"quit",4) && strncasecmp(buf,"bye",3)) { - fputs("\nqed> ",stderr); - if (fgets(buf,1000,stdin)==NULL) { - strcpy(buf,"bye"); - fprintf(stderr,"%s\n",buf); - } - if (*buf!='\n' && strncasecmp(buf,"quit",4) && - strncasecmp(buf,"bye",3)) { - st=send_command(ld,buf,retbuf,1024,1); - } - } - } - - /* - Finally close the connection. This is not really necessary. - */ - close_socket(ld); - - exit((st!=200)); -} - -/************** CLIENT SUBROUTINES ARE BELOW *************************/ - -#include <sys/types.h> -#include <sys/socket.h> -#include <netinet/in.h> -#include <netdb.h> -#include <signal.h> -#include <errno.h> -extern int errno; - -#define LF 10 -#define CR 13 - -static unsigned int timeout=1200; /* Default timeout value */ - -static int put(); -static int get(); -static int getaline(); -static void getline_timed_out(); - -/* - Open_socket finds host and port from the url and establishes a connection -*/ - -int open_socket(url) - -char *url; - -{ - struct hostent *gethostbyname(); -/* extern char *malloc(); */ - - char *p,*buf; - int port,sock,st; - struct hostent *remote; - struct sockaddr_in srv; - - sock=socket(AF_INET,SOCK_STREAM,IPPROTO_TCP); - if (sock == -1) { - fprintf(stderr,"Cannot create socket\n"); - return(sock); - } - - buf=malloc(strlen(url)); - if (buf==NULL) { - fprintf(stderr,"Cannot allocate buffer\n"); - return(-1); - } - strcpy(buf,url+2); - - for (p=buf; *p!='\0' && *p!=':'; p++); - if (*p=='\0') { - fprintf(stderr,"No port number in url string, default to 8083\n"); - port=8083; - } else { - *p='\0'; - port=atoi(p+1); - } - - remote=gethostbyname(buf); - if (remote==NULL) { - fprintf(stderr,"Cannot get host by name\n"); - st= -1; - } else { - srv.sin_family=AF_INET; - srv.sin_addr.s_addr=htonl(INADDR_ANY); - srv.sin_port=htons(port); - srv.sin_addr= *((struct in_addr *) remote->h_addr); - - st=connect(sock,&srv,sizeof(srv)); - if (st== -1) fprintf(stderr,"Cannot connect to server\n"); - else st=sock; - } - - free(buf); - return(st); -} - - - -/* - Close_socket closes the connection -*/ - -int close_socket(socket) - -int socket; - -{ - if (socket>3) close(socket); - return(1); -} - - -/* - Send_command transfers the command string and waits for a respons - The respons is printed on stdout - The status code at the beginning of the response is returned - and retrieve an 8 characters return code. -*/ - -int send_command(socket,command,retbuf,len,qeddebug) - -int socket,len,qeddebug; -char *command,*retbuf; - -{ - char str[2048]; - int js; - - errno=EINTR; /* Default: error */ - -/* - Check if valid socket -*/ - if (socket<3) { - fprintf(stderr,"Invalid socket\n"); - return(-1); - } - -/* - Send the string to the socket -*/ - -/* - js=write(socket,command,strlen(command)); -*/ - strncpy(str,command,2040); str[2040]='\0'; - if (str[strlen(str)-1]!='\n') strcat(str,"\n"); - js=put(socket,str,strlen(str)); - - if (js!=strlen(str)) { - fprintf(stderr,"Cannot send command on socket\n"); - return(js); - } -/* - Wait for reply -*/ - while (js>0) { - *str='\0'; - js=getaline(str,2000,socket); - if (js<=0) { - fprintf(stderr,"Cannot read response from socket\n"); - return(-1); - } - if (qeddebug) printf("%s\n",str); - if (str[3]!='-') js=0; /* No more lines expected */ - } - -/* - Return status and last line -*/ - strncpy(retbuf,str+4,len); - retbuf[len-1]='\0'; - - errno=0; - js=atoi(str); - if (js<0) js= -1; /* Should set errno as well... */ - return( js ); -} - - -/* - The trick to catch the EINTR has been shamelessly taken from - the Gipsy routine mtiodev.c (KGB, Kapteyn Lab, Univ. of Groningen) -*/ - -static int put(socket,buf,size) - -int socket,size; -char *buf; - -{ - int left,done; - - for (left=size; left; left-=done,buf+=done) { - while ( (done=write(socket,buf,left)) == -1 && errno == EINTR); - if (done== -1) return(done); - } - return(size); -} - -static int get(socket,buf,size) - -int socket,size; -char *buf; - -{ - int left,done; - - for (left=size; left; left-=done,buf+=done) { - while ( (done=read(socket,buf,left)) == -1 && errno == EINTR); - if (done== -1) return(done); - } - return(size); -} - - -static int getaline(str,n,ld) - -char *str; -int n,ld; - -{ - int i=0, ret; - - signal(SIGALRM,getline_timed_out); - alarm(timeout); - - while (1) { - if ( (ret = read(ld,&str[i],1)) <= 0) { - /* Mmmmm, Solaris. */ - if ( (ret == -1) && (errno == EINTR)) continue; - str[i] = '\0'; - return(i); - } - - if (str[i] == CR) read(ld,&str[i],1); - - if ( (str[i] == LF) || (i == (n-1))) { - alarm(0); - signal(SIGALRM,SIG_IGN); - str[i] = '\0'; - return(i); - } - ++i; - } -} - -static void getline_timed_out() - -{ - fprintf(stderr,"timed out waiting for respons"); - exit(1); -} - - diff --git a/src/sys/scissor.csh b/src/sys/scissor.csh deleted file mode 100755 index 46df11c63def93f2715f1bcd7226c70f29d3bcf6..0000000000000000000000000000000000000000 --- a/src/sys/scissor.csh +++ /dev/null @@ -1,1306 +0,0 @@ -#!/bin/csh -f -#+scissor.csh -# -# Some general commands that have knowledge of Scissor -# -# CMV 941108 Created -# CMV 941111 Added checkin command -# CMV 941129 Added wsrtlog command -# CMV 941212 Added chop command -# CMV 950102 Added resize command -# CMV 950104 Added oldtab command, code by HjV -# CMV 950109 Add confirm command -# CMV 950123 Modify checkin command -# CMV 950124 Include "manual" for old tables -# CMV 950131 Add overwrite command, add interface to Mosaic -# CMV 950222 Typo in overwrite, improve interface to Mosaic -# CMV 950404 Add calendar command -# CMV 950410 Add f0f2 and ionos commands -# CMV 950525 Add FILE argument to confirm -# HjV 950720 Small changes on request Foley -# CMV 950725 Option to specify station for ionos calculation -# CMV 950728 Include option to import baseline packages (filpo) -# CMV 960404 Include option to acknowledge observations. -# CMV 960417 Changed mount command (mountcd -> mountopt) -# CMV 960423 Correct missing quote -# CMV 961105 Modify telescope calendar for use in MFFE commissioning -# HjV 970521 Use == iso = to get only one Owner in scissor-commands -# -# Syntax: scissor help will show all options -#set echo -# -# -# Define some specific users -# -set Head = foley,lems # Head of reduction group -set TelAstr = foley,spoelstr,devoscm # Telescope Astronomer - -set Tmpfile=/tmp/scissor.$$ -onintr abort_exit # to get rid of tmpfile -# -# If we want to get something more than help, we need a password -# -if (! $?SCIPWD) then - if ("$1" == "") then - set Tmp=$USER; setenv USER anonymous - setenv SCIPWD $Tmp - unset Tmp - echo "**** anonymous access to Scissor ****" - else if ("$1" !~ [Hh]*) then - echo -n "Enter password for Scissor user ${USER}: " - stty -echo; set Tmp=($<); stty echo; echo "*********" - setenv SCIPWD $Tmp - unset Tmp - endif -endif - -# -# Without arguments: standalone client -# -if ("$1" == "") then - $n_exe/scissor.exe - -# -# Help: show options -# -else if ("$1" =~ [Hh]*) then - more <<_EOD_ - -Valid options (if arguments are missing, you will be prompted for them): - - scissor - Start interactive client - scissor help - Generate this list - - scissor mail names... - Return list of eMail addresses - -Standard commands for archiving: - - scissor checkin in-unit - Checkin a WSRT INF Tape or CD-ROM - scissor archive in-unit out-unit [labels] - Archive a WSRT INF Tape or CD-ROM - -Tools for correcting archiving errors: - - scissor overwrite unit [label] - Remove labels from archive - scissor resize volume - Recalculate free space - scissor delvolume volume - Remove volume and labels from archive - -General tape/disk handling: - - scissor init unit name description - Mount, initialise new volumes - scissor reinit unit name description - Mount and force initialise - scissor ship volume recipient - Change volume owner and notify - -Commands for handling of ionospheric data: - - scissor f0f2 [filename] - Enter new f0f2 values - scissor ionos date RA Dec Freq Station - Calculate faraday rotation - - -Other commands for use by the reduction group: - - scissor wsrtlog yymmm user password - Get WSRT logbook information - - scissor red "String" seqno - Confirm observation in logbook - scissor ack "String" seqno ... - Acknowledge observations - - scissor filpo file index - Transfer baseline package - - scissor oldtab volume label tableno - Retrieve old calibration file - scissor oldtab calcode tableno - Retrieve old calibration file - -Other commands for use by the telescope astronomer: - - scissor calendar - Add calendar events - - -The Newstar start-up procedure may define aliases for some of the above. -_EOD_ - - -# -# Mail returns a list of eMail addresses -# -else if ("$1" == "mail" || "$1" == "email") then - set Name="$argv[2-]" - if ("$Name" == "") then - echo -n "Enter name(s): " - set Name=($<) - endif - - $n_exe/scissor.exe EMAIL=personal NAME=`echo $Name | tr ' ' ',' ` - -# -# -# Delvolume removes a full volume from the database -# -else if ("$1" == "delvolume") then - - setenv QEDDEBUG "" # We want to get all output - - set Name="$2" - set Ok=0 - while (! $Ok) - if ("$Name" == "") then - echo -n "Enter name of volume to calculate free space for: " - set Name=($<) - endif - end - - $n_exe/scissor.exe delete=mediad volume=$Name label=1 - echo "Labels removed" - - $n_exe/scissor.exe delete=volumes volume=$Name - echo "Volume removed" - - -# -# Resize recalculates the free space on the volume -# -else if ("$1" == "resize") then - - setenv QEDDEBUG "" # We want to get all output - - set Name="$2" - set Ok=0 - while (! $Ok) - if ("$Name" == "") then - echo -n "Enter name of volume to calculate free space for: " - set Name=($<) - endif - - echo "" - echo "Checking $Name in Scissor..." - if (-e $Tmpfile) rm -f $Tmpfile - $n_exe/scissor.exe select=volumes volume=$Name >& $Tmpfile - grep ^2 $Tmpfile - echo "" - if (`grep -c ^207 $Tmpfile` != 1) then - echo "No unique volume specified, try again" - set Name="" - else - set Ok=1 - set Oldfree= (`grep ^207 $Tmpfile | awk '{ for (ii=1; ii<NF && $ii!="FREE="; ii++); printf("%d\n",$(ii+1)); }' `) - set Size = (`grep ^207 $Tmpfile | awk '{ for (ii=1; ii<NF && $ii!="SIZE="; ii++); printf("%d\n",$(ii+1)); }' `) - endif - end - - - if (-e $Tmpfile) rm -f $Tmpfile - $n_exe/scissor.exe select=mediad volume=$Name |& grep ^207 | awk '{ for (ii=1; ii<NF && $ii!="SIZE="; ii++); print $(ii+1); size+=$(ii+1) } END {print size}' - set Used=(`$n_exe/scissor.exe select=mediad volume=$Name |& grep ^207 | awk '{ for (ii=1; ii<NF && $ii!="SIZE="; ii++); size+=$(ii+1) } END {printf("%d\n",size+0.5)}' `) - - @ Free = $Size - $Used - - unsetenv QEDDEBUG # No need for output - echo "According to Scissor `$n_exe/scissor.exe check=volumes volume=$Name`" - if ($Free == $Oldfree) then - echo "Free space correct, no need to change" - else - echo "Calculated: $Used used, $Size total, $Free free" - $n_exe/scissor.exe put=volumes volume=$Name free=$Free - echo "Now: `$n_exe/scissor.exe check=volumes volume=$Name`" - endif - -# -# -# Ship changes file ownership, checks existence etc. -# -else if ("$1" == "ship") then - - setenv QEDDEBUG "" # We want to get all output - - set Name="$2" - set Ok=0 - while (! $Ok) - if ("$Name" == "") then - echo -n "Enter name of volume to ship: " - set Name=($<) - endif - - echo "" - echo "Checking $Name in Scissor..." - if (-e $Tmpfile) rm -f $Tmpfile - $n_exe/scissor.exe select=volumes volume=$Name >& $Tmpfile - grep ^2 $Tmpfile - echo "" - if (`grep -c ^207 $Tmpfile` != 1) then - echo "No unique volume specified, try again" - set Name="" - else - set Ok=1 - endif - end - - set Owner="$3" - set Ok=0 - while (! $Ok) - if ("$Owner" == "") then - echo -n "Enter id of new owner: " - set Owner=($<) - endif - - echo "" - echo "Checking $Owner in Scissor..." - if (-e $Tmpfile) rm -f $Tmpfile - $n_exe/scissor.exe select=personal name==$Owner >& $Tmpfile - grep ^2 $Tmpfile - if (`grep -c ^207 $Tmpfile` != 1) then - echo "" - echo "No unique person specified, try again" - set Owner="" - else - set Ok=1 - endif - end - - if (-e $Tmpfile) rm -f $Tmpfile - - echo "" - echo "Changing owner and sending mail" - unsetenv QEDDEBUG # No need for output - $n_exe/scissor.exe put=volumes volume=$Name owner==$Owner ShipOut=Yes - -# -# -# Checkin scans a tape and checks for parity errors -# -else if ("$1" == "checkin") then - - echo "------------------------------------------------------------" - echo "Checkin/archiving procedure for WSRT tapes in Dwingeloo " - echo "------------------------------------------------------------" - echo "" - echo "Phase 1: List the tape, check for parity errors " - echo "" - echo "After this phase, the tape-volume is known to Scissor " - echo "During this phase, a range of correct labels is determined " - echo "This range is kept for use in the next phase (archiving) " - echo "------------------------------------------------------------" - echo "" - - $0 init-$$ "$2" I... Received - - set Mounted=( `cat $Tmpfile` ) - 'rm' -f $Tmpfile - set Unit = $Mounted[1] - set Input = $Mounted[2] - - if ("$Input" != "Unlabeled") then - echo "Checking unit $Unit with volume $Input" - source $n_src/sys/newstar_$n_site.csh - dws nscan.checkin/nomenu <<_EOD_ -OPTION=ARC -TYPE_TAPE=WSRT -ARC_OPTION=CHECK -INPUT_UNIT=$Unit -INPUT_LABELS=* -POINTING_SETS=1 -# -_EOD_ - if ($Input =~ C* ) then - dwe nscancd.checkin - cat NSCAN*.LOG >$Input.checkin - else - dwe nscan.checkin - cat NSCAN.LOG >$Input.checkin - endif - - egrep -i '(Invalid)|(Cannot read)' NSCAN.LOG - - echo "" - echo "Now specify the range of labels to archive" - echo "You can change this choice later at the archiving stage" - echo "Specify as you would do in NSCAN DUMP (Start TO End or *)" - echo "Enter labels to archive later: " - set Labels=($<) - set noglob - $n_exe/scissor.exe PUT=volumes volume=$Input description=Use $Labels - echo "------------ Selected labels for copy: $Labels --------------" \ - >> $Input.checkin - unset noglob - endif - - echo "" - echo "The next phase is to archive the data and inform Scissor" - echo -n "Do you want to do this now (y,n) [y]? " - set Tmp=($<) - if ("$Tmp" == "" || "$Tmp" =~ [Yy]*) then - set noglob - $0 archive "$Unit" "" $Labels - unset noglob - else - echo "***** Use command scissor archive later ******" - endif - - echo "Overview of INF tapes that need to be archived: " - setenv QEDDEBUG "" - $n_exe/scissor.exe select=volumes type=inf description=Use | grep ^20 -# -# -# Archive scans a tape and checks for parity errors -# -else if ("$1" == "archive") then - - echo "------------------------------------------------------------" - echo "Checkin/archiving procedure for WSRT tapes in Dwingeloo " - echo "------------------------------------------------------------" - echo "" - echo "Phase 2: Copy the tape and inform Scissor " - echo "" - echo "After this phase, the observations on the tape are known to " - echo "Scissor, the data is copied to the archive medium and the " - echo "contents of both the tape and the archive medium are known " - echo "to Scissor. You can specify the range of labels to copy. " - echo "------------------------------------------------------------" - echo "" - - echo "Checking the INPUT tape-unit" - $0 init-$$ "$2" "" invalid - set Mounted=( `cat $Tmpfile` ) - 'rm' -f $Tmpfile - set Unit = $Mounted[1] - set Input = $Mounted[2] - - if ("$Input" != "Unlabeled") then - - echo "Archiving from volume $Input on unit $Unit" - echo "Checking the OUTPUT tape-unit" - $0 init-$$ "$3" "" invalid - set Mounted=( `cat $Tmpfile` ) - 'rm' -f $Tmpfile - set OutUnit = $Mounted[1] - set Output = $Mounted[2] - else - set Output="Unlabeled" - endif - - if ("$Output" != "Unlabeled") then - echo "Archiving to volume $Output on unit $OutUnit" - echo "" - echo "You have to specify the labels to archive" - - set noglob - setenv QEDDEBUG "" - $n_exe/scissor.exe select=volumes volume=$Input | tr '=' '\012' |& \ - awk '/Use/ {for (i=2; i<NF; i++) printf("%s ",$i); }' >$Tmpfile - unsetenv QEDDEBUG - echo "Labels suggested from checking the tape: `cat $Tmpfile`" - - if ("$4" != "") then - set Labels=($argv[4-]) - else - set Labels=(`cat $Tmpfile`) - endif - 'rm' -f $Tmpfile - - echo -n "Enter range of labels to copy [$Labels]: " - set Tmp=($<) - if ("$Tmp" != "") set Labels=($Tmp) - - echo "Starting to pass observations on volume $Input to Scissor" - source $n_src/sys/newstar_$n_site.csh - dws nscan.checkin/nomenu <<_EOD_ -OPTION=ARC -TYPE_TAPE=WSRT -ARC_OPTION=ARCHIVE -INPUT_UNIT=$Unit -INPUT_LABELS=$Labels -POINTING_SETS=1 -# -_EOD_ - if ("$Input" =~ C*) then - dwe nscancd.checkin - cat NSCAN*.LOG >$Input.admin - else - dwe nscan.checkin - cat NSCAN.LOG >$Input.admin - endif - - echo "Starting to copy from $Input to $Output" - dws nscan.copy/nomenu <<_EOD_ -OPTION=DUMP -INPUT_UNIT=$Unit -INPUT_LABELS=$Labels -OUTPUT_UNIT=$OutUnit -OUTPUT_LABEL=0 -# -_EOD_ - - if ("$Input" =~ C*) then - dwe nscancd.copy - cat NSCAN*.LOG >$Input.copy - else -# setenv tmp $n_exe -# setenv n_exe /newstar/master/exe/hp - dwe nscan.copy - cat NSCAN.LOG >$Input.copy -# setenv n_exe $tmp - endif - - $n_exe/scissor.exe PUT=volumes volume=$Input description=Done $Labels - - endif -# -# -# Overwrite deletes labels from an archive medium -# -else if ("$1" == "overwrite") then - - echo "------------------------------------------------------------" - echo "Overwrite labels on WSRT archive medium " - echo "------------------------------------------------------------" - echo "" - - echo "Checking the archive unit" - $0 init-$$ "$2" "" invalid - set Mounted=( `cat $Tmpfile` ) - 'rm' -f $Tmpfile - set Unit = $Mounted[1] - set Input = $Mounted[2] - set Type = $Mounted[3] - set Device = $Mounted[4] - - if ("$Type" != "disk") then - echo "Can only remove files from Unix optical disk" - - else if ("$Input" != "Unlabeled") then - - echo "Removing from volume $Input on unit $Unit" - - echo "You have to specify the labels to overwrite" - if ("$3" != "") then - set Label=($argv[3]) - else - set Label=(abort) - endif - - echo -n "Enter the first label to overwrite [$Label]: " - set Tmp=($<) - if ("$Tmp" != "") set Label=($Tmp) - - if ("$Label" != "" && "$Label" !~ [Aa][Bb][Oo][Rr][Tt]) then - echo "Removing labels $Label and higher from Scissor" - $n_exe/scissor.exe DELETE=mediad volume=$Input label=$Label - - echo "Removing labels $Label and higher from $Device" - touch $Tmpfile - set Home=$cwd - cd $Device - ls file*.mt | awk '{print substr($1,5,6),$1}' |\ - awk '{if ($1>='$Label') printf("chmod a+w %s; rm -f %s\n",$2,$2);}'\ - >$Tmpfile - set echo - source $Tmpfile - unset echo - 'rm' -f $Tmpfile - endif - - endif -# -# -# Init checks for volume labels and initialises if necessary -# Re-init forces initialize -# For internal use: init-side initialise other side -# init-<digit(s)> write unit and name to scissor.<...> -# -else if ("$1" =~ *[Ii][Nn][Ii][Tt]* ) then - - set Unit="$2" - while ("$Unit" == "") - echo -n "Enter number of tapeunit [list of units]: " - set Unit=($<) - if ("$Unit" == "") printenv | grep MAG | sort - end - - if (`printenv MAG$Unit` == "") then - echo "No such unit $Unit known (MAG$Unit undefined)" - set Device="Unknown" - set Type="Unknown" - - else - - # - # Split device type and true name - # - set Device=(`printenv MAG$Unit | tr ':' ' ' `) - if ($#Device == 1) then - if ("$Device" =~ //*) then - set Type="rmtd" - else - set Type="tape" - endif - else - set Type=$Device[1] - set Device=$Device[2] - endif - - if ("$Type" == "rmtd") then - echo "Cannot initialise an rmtd device" - set Device="Unknown" - - else if ("$Type" == "tape") then - - if (! -w $Device || -f $Device) then - echo "Cannot mount MAG$Unit on $Device - set Device="Unknown" - else - set Name=(`$n_exe/genaid.exe label $Device`) - set Defnam="DDS" - set Side="" - endif - - else if ("$Type" == "disk") then - - if ($Device =~ *cd*) then - cdload - else - if (! -d $Device) mountopt - if ( "`df $Device | grep -v File`" !~ /opt* ) mountopt # Temporary... - endif - if (! -d $Device) then - echo "Cannot mount MAG$Unit on $Device - set Device="Unknown" - else - if (-e $Device/volume.mt) then - set Name=(`cat $Device/volume.mt | tr -d '[:cntrl:]'`) - else if (-e $Device/VOLUME.MT) then - set Name=(`cat $Device/VOLUME.MT | tr -d '[:cntrl:]'`) - else - set Name="Unlabeled" - endif - set Defnam="DO" - - set Side="" - if (-e $Device/SIDE_A) set Side="A" - if (-e $Device/SIDE_B) set Side="B" - endif - endif - - endif - - set Did_init=0 # Not initialised anything yet - - if ("$1" == "re-init") then # Force init - set Name="Unlabeled" - echo "Ignore existing label, force initialization" - endif - - if ("$Device" == "Unknown") then - set Name="Unlabeled" - else - if ("$Name" == "Unlabeled") then - set Name="$3" - while ("$Name" == "" || "$Name" == "Unlabeled") - echo -n "Enter a label for the volume in MAG${Unit} [new $Defnam]: " - set Name=($<) - if ("$Name" == "") set Name=${Defnam}...${Side} - if ("$Name" =~ *.*) then - if (-e $Tmpfile) rm -f $Tmpfile - $n_exe/scissor.exe check=volumes volume=$Name | tee $Tmpfile - if ($status == 1) then - echo "Sorry, Scissor could not figure out the next label" - echo "You will have to think of it yourself..." - else - set Name=(`grep next $Tmpfile`) - set Name=$Name[1] - echo "New label: $Name" - endif - if (-e $Tmpfile) rm -f $Tmpfile - endif - end - - set Tmp="$Name" - if ("$Type" == "tape") then - $n_exe/genaid.exe init $Device $Name - set Name=(`$n_exe/genaid.exe label $Device`) - else if ("$Type" == "disk") then - if (-e $Device/volume.mt) then - chmod a+w $Device/volume.mt - endif - echo $Name >$Device/volume.mt - chmod a-w $Device/volume.mt - set Name=(`cat $Device/volume.mt`) - endif - - if ("$Tmp" != "$Name") then - echo "Could not initialise volume $Tmp on MAG$Unit ($Name)" - set Name="Unlabeled" - else - echo "Volume $Name has been initialised, now informing Scissor..." - set Did_init=1 - endif - endif - - if ("$Name" != "Unlabeled") then - echo "" - echo "Volume on MAG3 is $Name" - $n_exe/scissor.exe check=volumes volume=$Name - if ($status == 1) then - if ("$4" == "") then - echo -n "Enter a description for $Name [none]: " - set Descr=($<) - else - set Descr="$4" - endif - - if ("$Descr" != "invalid") then - - if ("$Type" == "disk") set Medium=OPT - if ("$Type" == "disk" && "$Name" =~ C*) set Medium=CD - if ("$Type" == "tape") set Medium=DAT - if ("$Type" == "tape" && "$Name" =~ I*) set Medium=INF - - $n_exe/scissor.exe put=volumes volume=$Name medium.type=$Medium owner=$USER Description=$Descr - $n_exe/scissor.exe check=volumes volume=$Name - if ($status == 1) then - echo "Obscure error while informing Scissor..." - set Name="Unlabeled" - endif - - else - echo "$Name not known to Scissor" - set Name="Unlabeled" - endif - - endif - endif - - - if ($Did_init && "$Side" != "" && "$1" != init-side) then - umountopt - echo "Please remove the disk and put the other side in..." - echo "Press Enter when done." - set Tmp=($<) - mountopt - if (($Side == B && -e $Device/SIDE_B) || \ - ($Side == A && -e $Device/SIDE_A)) then - echo "This is not the other side of $Name" - echo "Try to initialise it later..." - else - set Name=(`echo $Name | tr 'AB' 'BA'`) - $0 init-side "$Unit" $Name - endif - endif - - endif - - # - # Save unit and name in tempfile of calling process - # - if ("$1" =~ init-[0-9]*) then - set Tmp=(`echo $1 | tr '-' ' ' `) - set Tmp=/tmp/scissor.$Tmp[2] - if (-e $Tmp) then - 'rm' -f $Tmp - endif - echo $Unit $Name $Type $Device >$Tmp - endif - -# -# -# wsrtlog gets logbook information from the WSRT -# -else if ("$1" == "wsrtlog") then - - set Names=(JAN FEB MAR APR MAY JUN JUL AUG SEP OCT NOV DEC) - - set Year = `date +%y` - set Month = `date +%m` - set This=$Names[${Month}]19${Year}OBS.TXT - - @ Month = $Month - 1 - if ("$Month" == 0) then - set Month = 12 - @ Year = $Year - 1 - endif - set Last=$Names[${Month}]19${Year}OBS.TXT - - if ("$2" == "") then - echo -n "Enter year and month to receive (yymmm) [current month]: " - set ym=($<) - else - set ym=($2) - endif - set ym=(`echo $ym | tr '[a-z]' '[A-Z]'`) - if ("$ym" == "") then - echo "Will import $This and $Last" - else - set This=`echo $ym | awk '{ printf("%s19%sOBS.TXT",substr($1,3,3),substr($1,1,2)); }' ` - set Last="" - echo "Will import $This" - endif - - if ("$3" == "") then - echo -n "Enter username on wsrt00: " - set wsrt_user=($<) - else - set wsrt_user=$3 - endif - - if ("$4" == "") then - echo -n "Enter password for ${wsrt_user}@wsrt00: " - stty -echo; set wsrt_pass=($<); stty echo; echo "*********" - else - set wsrt_pass=$4 - endif - - set Names=(JAN FEB MAR APR MAY JUN JUL AUG SEP OCT NOV DEC) - - # - # If we do not have a file, get one - # - echo "Retrieving logbook from wsrt00..." - if ("$Last" == "") then - set getLast="" - else - set getLast="get $Last" - endif - ftp -n wsrt00 <<_EOD_ -user $wsrt_user $wsrt_pass -cd /disk3/obs/log/obslogbook -get $This -$getLast -quit -_EOD_ - - set Files=($Last $This) - -# else -# set Files=($argv[4-]) -# endif - - # - # For each file: convert file to series of scissor commands and send them - # - setenv QEDDEBUG 1 - foreach File ($Files) - if (-e $File) then - - echo "Inserting file $File" - - perl $n_src/sys/obslog.pls $File:r - cat wsrtlog.$File:r | sed -e 's%<%\<%g' -e 's%>%\>%g' | $n_exe/scissor.exe >& $File:r.err - else - echo "Could not find file $File" - endif - end - - # - # Remove files retrieved from wsrt00 - # - if ("$4" == "") then - 'rm' -f $Files - endif - -# -# -# f0f2 will add f0f2 values to the database -# -else if ("$1" == "f0f2") then - $n_exe/ionos.exe $2 | $n_exe/scissor.exe - -# -# ionos will calculate faraday rotations for use with NCALIB -# -else if ("$1" == "ionos") then - - set Date="$2" - echo -n "Enter date (dd/mm/yyyy) [$Date]: " - set Tmp=($<) - if ("$Tmp" != "") set Date="$Tmp" - - set Ra="$3" - echo -n "Enter right ascension (deg) [$Ra]: " - set Tmp=($<) - if ("$Tmp" != "") set Ra="$Tmp" - - set Dec="$4" - echo -n "Enter declination (deg) [$Dec]: " - set Tmp=($<) - if ("$Tmp" != "") set Dec="$Tmp" - - set Freq="$5" - if ("$Freq" == "") set Freq="1000" - echo -n "Enter frequency (MHz) [$Freq]: " - set Tmp=($<) - if ("$Tmp" != "") set Freq="$Tmp" - - set Station="$6" - if ("$Station" == "") set Station="all" - echo -n "Enter station(s) to use [$Station]: " - set Tmp=($<) - if ("$Tmp" != "") set Station="$Tmp" - if ("$Station" =~ [Aa][Ll][Ll]*) set Station="" # Do not select on it - - set DMY=(`echo $Date | awk -F/ '{printf("%2.2d %2.2d %4.4d %2.2d",$1,$2,$3,$3-1900);}' `) - - echo "Retrieving f0f2 information from Scissor into f0f2-file..." - $n_exe/scissor.exe <<_EOD_ | $n_exe/ionos.exe -w $DMY[3] $DMY[2] -SELECT=F0F2 DATE=01/$DMY[2]/$DMY[3] - 31/$DMY[2]/$DMY[3] STATION=$Station -SELECT=YPF2 DATE=01/$DMY[2]/$DMY[3] - 31/$DMY[2]/$DMY[3] STATION=$Station -bye -_EOD_ - - echo "" - echo "Calculation Faraday rotation/Ionospheric refraction values" - source $n_src/sys/newstar_$n_site.csh - setenv n_f0f2 $cwd # f0f2 file made in current dir - - dws ionost.calc/nomenu <<_EOD_ -DAY_NUMBER=$DMY[4]$DMY[2]$DMY[1];0 -FREQUENCY=$Freq -SOURCE_NAME=scissor -RIGHT_ASCENSION=$Ra -DECLINATION=$Dec -# -_EOD_ - - if (-e ionos.rf) then - 'rm' -f ionos.rf - endif - - dwe ionost.calc - - 'rm' -f ION*.LOG - - if (! -e ionos.rf) then - echo "Error in IONOST: no file ionos.rf produced" - else - echo "Output of IONOST is in file ionos.rf" - -# -# Fix to handle blank fields. -# - cat ionos.rf | awk '{ \ -if ($1 ~ /U.T./ && $NF ~ /11.00/ ) hour=0 \ -if ($1 ~ /U.T./ && $NF ~ /23.00/ ) hour=12 \ -if ($1 ~ /hour/ && $2 ~/angle/){ \ - for (i=0; i < 12 ; i++) { \ - ha[hour+i] = substr($0,(26+8*i),8)} \ -} \ -if ($1 ~ /Faraday/ && $2 ~/rotation/){ \ - for (i=0; i < 12 ; i++) { \ - fr[hour+i] = substr($0,(26+8*i),8) \ - } \ -} \ -if ($1 ~ /delta/ && $2 ~/phase/){ \ - for (i=0; i < 12 ; i++) { \ - iref[hour+i] = substr($0,(26+8*i),8) \ - } \ -} \ -} \ -END { for (u=0; u < 24; u++) printf("%.2f %.2f %.2f \n",ha[u],fr[u],iref[u]);}' \ - | sed '/0.00 ........./d' | sort -n |\ - awk '{ print $1,$2 >"far"; print $1,$3>"ref"}' - - set out = NCA$DMY[3]$DMY[2]$DMY[1]_${Ra}_${Dec} - mv far $out.FAR - mv ref $out.REF - - if (0) then - set ha = ( `grep "hour angle" ionos.rf | awk -F: '{ print $2}'` ) - set fr = ( `grep "Faraday rot" ionos.rf | awk -F: '{ print $2}'` ) - set ir = ( `grep "delta phase" ionos.rf | awk -F: '{ print $2}'` ) - if ($#ha == 0 || $#ha != $#fr || $#ha != $#ir) then - echo "Error in information in ionos.rf..." - else - if (-e $out.FAR) then - 'rm' -f $out.FAR - endif - if (-e $out.IREF) then - 'rm' -f $out.IREF - endif - - @ ii = 0 - while ( $ii < $#ha ) - echo $ha[$ii] $fr[$ii] >>$out.FAR - echo $ha[$ii] $ir[$ii] >>$out.IREF - @ ii = $ii + 1 - end - endif - endif - - echo "Input for NCALIB is in $out.FAR and $out.IREF" - - echo "" - echo "Running NCALIB to store the corrections (FAR, IREF)." - echo "" - echo "Give input SCN-file, sectors and hour-angle range when asked" - echo "If you do not want ionospheric refraction, enter # the " - echo "second time that NCALIB asks you for a SCN-file." - dws ncalib.putfar /nomenu <<_EOD_ -OPTION=SET;SET -SET_OPTION=FAR;IREF -FARADAY_FILE=$out.FAR -IREFRACT_FILE=$out.IREF -# -_EOD_ - - dwe ncalib.putfar - - 'rm' -i ionos.rf $out.* f2*.01 - #endif - - endif -# -# -# red/ack will send a reply to the WSRT logbook -# -else if ("$1" == "red" || "$1" == "ack") then - if ("$2" == "") then - echo -n "Enter quality mark or comment: " - set Comment=($<) - else - set Comment=($2) - endif - set Comment=`echo $Comment | tr ',' ';' ` - set File="" - - if ("$Head" !~ *${USER}*) then - echo "Only user ${Head} can confirm observations" - set Cat=CMT - else if ("$1" == "red") then - set Cat=RED - else - set Cat=ACK - endif - - if ("$Cat" == "RED") then # || "$Cat" == "CMT") then - if ("$3" == "") then - echo -n "Enter a single sequence number to confirm or comment: " - set Seq=($<) - else - set Seq=($3) - endif - echo -n "Enter name of associated file [none]: " - set File=($<) - - else if ("$Cat" == "ACK") then - if ("$3" == "") then - echo "You may enter a comma-separated list or a range (first - last)" - echo -n "Enter sequence number(s) to confirm: " - set Seq=($<) - else - set Seq=($argv[3-]) - endif - set Seq=(`echo $Seq | tr ',' ' '`) - if ("$Seq" =~ *-*) then - set tmp=`echo $Seq | tr '-' ' '` - set Seq="" - set i = $tmp[1] - while ($i <= $tmp[2]) - set Seq=($Seq $i) - @ i = $i + 1 - end - endif - endif - - if ("$Cat" == "RED" || "$Cat" == "ACK") then - if ("$File" == "") then - foreach i ( $Seq ) - $n_exe/scissor.exe SELECT=OBSERVATION SEQNUMBER=$i >& /dev/null - if ($status == 0) then - $n_exe/scissor.exe PUT=OBSLOG SEQNUMBER=$i NAME=$USER CATEGORY=$Cat DESCRIPTION="$Comment" - else - echo "$i does not exist" - endif - end - else if (-e "$File") then - set Note=${Seq}_`date +%y%m%d_%H%M%S`.$File:e - ftp -n ftp.astron.nl <<_EOD_ -user anonymous $USER -cd /pub/incoming -put $File $Note -quit -_EOD_ - $n_exe/scissor.exe SELECT=OBSERVATION SEQNUMBER=$Seq >& /dev/null - if ($status == 0) then - $n_exe/scissor.exe PUT=OBSLOG SEQNUMBER=$Seq NAME=$USER CATEGORY=$Cat DESCRIPTION="$Comment" URL=$Note - endif - else - echo "File $File does not exist, no action taken" - endif - endif -# -# -# filpo adds a baseline package to Scissor -# -else if ("$1" == "filpo") then - - set Filpo="$2" - echo -n "Enter location of filpo file [$Filpo]: " - set Tmp=($<) - if ("$Tmp" != "") set Filpo="$Tmp" - - set Index=(`grep Baseline $Filpo | tail -1 | awk '{print $7}' `) - if ("$3" != "") set Index="$3" - echo -n "Enter index of package to store [$Index]: " - set Tmp=($<) - if ("$Tmp" != "") set Index="$Tmp" - - if ("$n_arch" == "hp") then - awk -v Req=$Index -f $n_src/sys/filpo.kwa $Filpo | $n_exe/scissor.exe - else - awk -f $n_src/sys/filpo.kwa Req=$Index $Filpo | $n_exe/scissor.exe - endif - -# -# -# calendar adds events to the calendar -# -else if ("$1" == "calendar") then - if ("$TelAstr" !~ *${USER}*) then - echo "Only users ${TelAstr} can add events to the calendar" - else - echo "----------------------------------------------" - echo "---- Add events to the telescope calendar ----" - echo "----------------------------------------------" - echo "" - echo "Enter dates as dd/mm/yyyy, year or year and month may be left out." - echo "Stop date may be given after start date: dd/mm/yyyy,dd/mm/yyyy" - echo "(year or year and month may be left out again)." - echo "Enter Stop as start date to quit entering events." - echo "" - - set Type="reduce" - set Stop="stop" - set Day = `date +%d` - set Mon = `date +%m` - set Yr = 19`date +%y` - - cal_loop: - echo -n "Enter start date (dd/mm/yyyy) [${Stop}]: " - set Start=($<) - if ("$Start" == "" ) set Start=$Stop - if ("$Start" =~ [Ss]*) goto cal_done - - if ("$Start" =~ *,*) then - set Stop =(`echo $Start | awk -F, '{print $2}' `) - set Start=(`echo $Start | awk -F, '{print $1}' `) - else - set Stop="" - endif - - set Tmp=(`echo $Start | tr '/' ' ' | tr '-' ' ' ` "" "") - if ($Tmp[1] != "") set Day=$Tmp[1] - if ($Tmp[2] != "") set Mon=$Tmp[2] - if ($Tmp[3] != "") set Yr=$Tmp[3] - if ($Yr < 100) @ Yr = 1900 + $Yr - set Start=(`echo $Day $Mon $Yr | awk '{printf("%2.2d/%2.2d/%4.4d",$1,$2,$3)}' `) - - if ("$Stop" == "") then - echo -n "Enter stop date (dd/mm/yyyy) [${Start}]: " - set Stop=($<) - if ("$Stop" == "") set Stop=$Start - endif - - set Tmp=(`echo $Stop | tr '-' ' ' | tr '/' ' ' ` "" "" ) - if ($Tmp[1] != "") set Day=$Tmp[1] - if ($Tmp[2] != "") set Mon=$Tmp[2] - if ($Tmp[3] != "") set Yr=$Tmp[3] - if ($Yr < 100) @ Yr = 1900 + $Yr - set Stop=(`echo $Day $Mon $Yr | awk '{printf("%2.2d/%2.2d/%4.4d",$1,$2,$3)}' `) - - set Done=0 - while (! $Done) - echo -n "Enter person to inform (Scissor name) [${Type}]: " - set Tmp=($<) - if ("$Tmp" != "") set Type=$Tmp - echo -n "Email: `$n_exe/scissor.exe EMAIL=personal NAME=$Type` OK? [y] " - set Tmp=($<) - if ("$Tmp" == "" || "$Tmp" =~ [Yy]*) set Done=1 - end - - echo -n "Enter comment [stop]: " - set Comment=($<) - if ("$Comment" == "") goto cal_done - echo -n "Telescopes involved [0..D]: " - set Tmp=($<) - set Comment=($Comment RT=$Tmp) - - echo "$Start - $Stop : $Comment ($Type)" - $n_exe/scissor.exe put=telcal type=$Type start=$Start stop=$Stop comment=$Comment - goto cal_loop - - cal_done: - echo -n "Issue a new calendar (y,n) [n]? " - set Tmp=($<) - if ("$Tmp" =~ [Yy]*) then - echo -n "Enter start date (dd/mm/yyyy): " - set Start=($<) - echo -n "Enter stop date (dd/mm/yyyy): " - set Stop=($<) - echo -n "Enter identification (e.g. 1995.1): " - set Note=($<) - echo -n "Enter name of file with notes: " - set File=($<) - ftp -n ftp.astron.nl <<_EOD_ -user anonymous $USER -cd /pub/incoming -put $File $Note -quit -_EOD_ - $n_exe/scissor.exe put=telcalh start=$Start stop=$Stop note=$Note - endif - - endif - -# -# -# oldtab will retrieve old tables from backup tape -# -else if ("$1" == "oldtab") then - -cat <<_EOD_ -Procedure for use of old reduction-tables with Newstar ------------------------------------------------------- - -All old reduction tables and an index are stored on a single DAT-tape. -To use these data, proceed as follows. - -1e. Make sure Newstar is initialised -2e. Put the DAT-tape in the unit refered to by MAG8 -3e. Enter "scissor oldtab <Calcode> <tableno>" to retrieve the - appropriate calibration file from the tape. The program wsrttab - will be retrieved as well. To list a particular table in the file, - enter "wsrttab.x$n_arch <Calcode> <tableno>" - -4e. Enter "scissor oldtab <volume> <label> <tableno>" to get the - calibration file for that particular observation. This only works - for calibration-groups before and including A267/B267, which have - been written to tape with corrections applied to them. The program - wsrttab will be retrieved as well. To list a particular table in the - file, enter "wsrttab.x$n_arch <Calcode> <tableno>" Use the Newstar - program NCALIB, option SET to remove the corrections from a SCN file. - -The program wsrttab is not a regular Newstar application. It is maintained -under the Newstar Export Master (on ftp.astron.nl) and compiled versions for -Sun and HP workstations are stored on the backup tape. - -The backup tape contains: - - 1e. Source code and executables for wsrttab - 2e. Index-file to search the calibration file for a particular label - 3e. All old reduction tables (bigfil.tab and <calcode>.tab) - - -The following calibration files give problems: - -A205G - Cannot be read -A234D - Cannot be read -A210H - 600000 tables cannot be read -A211V - 900000 tables cannot be read -A229F0 - 900000 tables cannot be read - - -Henk Vosmeijer & Marco de Vos, 950104. -_EOD_ - -#>>>>>> Start inclusion of /home/rzmws0/hjv/c/Findtab.csh >>>>>> -#! /bin/csh -f -# -# Script to extract a .tab-file from a backup DAT-tape and -# to print the contents of a table. -# -# Revision: -# 950204 HjV Created -# -# -# First test the arguments: -# 2 arguments: calcode table-type -# 3 arguments: volume label table-type -# -if ($#argv < 2 || $#argv > 3) then - echo "You should give:" - echo " 2 arguments: cal-code table-type" - echo " 3 arguments: volume label table-type" - echo " table-type should be a value between 0 and 9" - exit -endif -if ($#argv == 3) then - if ("$argv[1]" !~ [Dd][Aa]*) then - echo "You specified 3 arguments: Volumes should start with da or DA" - exit - endif - set volume=$argv[1] - set label=$argv[2] - @ ttype=$argv[3] -else # 2 arguments -# test if not mentioned three, but forgot one - if ("$argv[1]" =~ [Dd][Aa]*) then - echo "You specified a volume (which start with da or DA), but" - echo "you did not specify the third argument" - exit - endif - set calgrp=$argv[1] - @ ttype=$argv[2] -endif -# -# Test if Findtab.lis already exist in current directory -if (! -e Findtab.lis ) then - echo "Extracting Findtab.lis from MAG8 ($MAG8) ... " - echo " This will take some time (about 25 minutes), so" - echo " you better gone do something more usefull yet" - tar xvf $MAG8 Findtab.lis -endif -# -# Search for volume/label combination -if ($#argv == 3) then - set Match=(`grep -i ${volume} Findtab.lis | grep -i "\, ${label}" | tr ',' ' ' `) -@ nrMatch = $#Match / 12 - if ($nrMatch == 0) then - echo "Volume/label combination not found" - exit - endif -# - if ($nrMatch == 1) then - @ jj = 3 - endif -# - if ($nrMatch > 1) then - echo "Volume/label combination more than once found:" - echo -n "Reduction codes found:" - @ ii = 0 - while ( $ii < $nrMatch ) - @ jj = $ii * 12 + 3 - echo -n " $Match[$jj]" - @ ii = $ii + 1 - end - echo " " - @ ii = 0 - while ( $ii < $nrMatch ) - @ jj = $ii * 12 + 3 - echo -n "Use $Match[$jj]? (y/n) [Y} " - set Flag=($<) - if ($Flag =~ [Nn]* ) then - @ ii = $ii + 1 - else - @ ii = $nrMatch - endif - end - endif - set calgrp=$Match[$jj] -endif -# -#Test if tab-file and wsrttab-executable already exist in current directory -if (! -e $calgrp.tab || ! -e wsrttab.x$n_arch ) then - echo "Extracting $calgrp.tab and wsrttab.x$n_arch from MAG8 ($MAG8) ... " - echo " This will take some time (about 25 minutes), so" - echo " you better gone do something more usefull yet" - tar xvf $MAG8 $calgrp.tab wsrttab.x$n_arch -endif -@ xx = $ttype + $jj -wsrttab.x$n_arch $calgrp $Match[$xx] -#<<<<<< End inclusion of /home/rzmws0/hjv/c/Findtab.csh <<<<<< - -else - echo "Invalid command $1 - for help, enter: scissor help" -endif # Commands - -# -# If ctrl_c was pressed, we get here to remove any remaining temp-files -# -abort_exit: - -echo "" -if (-e $Tmpfile) rm -f $Tmpfile diff --git a/src/sys/shadow.csh b/src/sys/shadow.csh deleted file mode 100755 index 1ff9c0db02a8d5abb6f4df5a5e3c82b260acdef6..0000000000000000000000000000000000000000 --- a/src/sys/shadow.csh +++ /dev/null @@ -1,1105 +0,0 @@ -#!/bin/csh -f -#set echo -#+ -# -# shadow.csh -# CMV 930526 Created -# CMV 931018 Added link setup, mail for checkin -# CMV 931020 Changed call to switches -# CMV 931111 Improved locking -# CMV 931116 Add abbreviations for executables in checkin -# CMV 931124 Put and get command are now here, -# better error log, overwrite existing links -# CMV 931223 Change handling of libraries -# HjV 940412 Use $n_ulib iso. $n_lib for use private library -# CMV 940506 Allow multiple comment lines for checkin, -# check locks in advance -# JPH 940715 Link: replace identical copy of master file by a soft -# link (with message) -# JPH 940720 Bug fix -# JPH 940721 Remove soft link before trying to make new one -# Suppress standard "Linked" messages so the important -# ones will clearly stand out -# JPH 940726 Out: #rm $Target before recreating it as a copy -# Change cmp checks to use $status because certain -# differences were not detected the old way -# CMV 940805 Out: really remove existing links, check if -# true file exists, copy from import if file exists -# there; In: ask questions at the end of checking -# all files to save typing in case of locks, overwrite -# files in import owned by same User. -# CMV 940811 Out: lock for present out-checker also if not -# person who did the import -# CMV 940829 Keep copy of all imported files in $n_import/backup -# JPH 940916 Preserve file date in checkout copy -# CMV 941102 Copy to ftp-area at checkin, test grpfile in import/old -# CMV 941122 Checkin: Also test groupfile in $n_import/old for rm -# HjV 9601021 In UNLOCK-part: Add directory when making link to file -# Lock file with correct name (not with UNKNOWN) -# JPH 960327 Fix HjV 9601021 so it will work correctly with -# second-level subdirectories (as in the doc tree) -# JPH 960808 Exit with nonzero status on compilation failure -# HjV 970408 Fix problem with anounymous ftp: wrong passwd -# -# -# shadow.csh Interface to shadow system commands -# -# Use "shadow help" for information on usage -# -# -#- - -onintr Abort_exit -# -# Check environment, set defaults -# -source $n_src/sys/initcompile.csh - -# -# Decode switches, get command or set menu mode if none given -# -set noglob; set Command=( $argv ); unset noglob -set Options=""; source $n_src/sys/switches.csh - -set Files="" -if ("$Command" != "") then - set Mode="Command" - if ($#Command > 1) then - set noglob; set Files=( $Command[2-] ); unset noglob - set Command=$Command[1] - endif -else - set Mode="Menu" - set Command="" -endif - -while ( "$Mode" != "Quit") - - if ( "$Mode" == "Menu" ) then - echo "Valid commands are: help, build, link, get, put, quit" - echo " out=checkout, in=checkin, unlock." - echo -n "Enter a command: " - set Command=($<) - set Files="" - set noglob; set Command=( $Command ); unset noglob - set Options=""; source $n_src/sys/switches.csh - if ($#Command > 1) then - set noglob; set Files=( $Command[2-] ); unset noglob - set Command=$Command[1] - endif - else - set Mode="Quit" - endif - - if ("$Command" == "" || "$Command" =~ [Qq]*) then - set Mode="Quit" - - else if ("$Command" =~ [Hh]* ) then - cat <<_EOD_ -#++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++# - - shadow can be called in one of the following ways: - - - shadow - - Without options, enter menu mode, which - prompts you for commands and filenames - - shadow build [switches | file] - - Compile one or more files. All files have to be fully - specified (that is either full pathname or the path with - respect to current directory). - If no files are present, their names are read from the - standard input. - - You may specify groupfiles prefixed by an @-sign, in - which case the contents of the file will be processed. - - Switches are specified like -Debug,Alternate,List,Print and - may be abbreviated. For more information, give switch -Help - All switches on the command line are applied to all files. - Switches appearing within a groupfile are only applied to - the file after which they appear. - - shadow link [setup | dir ...] - - Create a shadow tree starting at the current directory. - You should have set $n_usrc already. - - If you do not specify a directory, and you are in $n_usrc, the - standard Newstar program subdirectories (not sys and doc etc) - will be shadowed. If you do not specify a directory and you are - in a subdirectory of $n_usrc, that directory will be shadowed. - If you do specify a directory, and that directory is a subdirectory - of $n_src, the specified directory will be shadowed. - - NOTYET If one or more groupfiles are given, only the files listed - NOTYET therein will be shadowed. - - If the argument setup is given, any missing shadow top-directories - are created and a shadow copy of the include files is made. - - - shadow checkout [switches | file] ... - shadow out [switches | file] ... - - Copy one or more files to the current directory, - leaving a lock in the locking database. - Groupfiles prefixed with an @-sign will be replaced - by their contents. If no files are present, their names - are read from the standard input. - If the file does not exist but is found in a textlibrary, - it will be extracted. - - shadow checkin [switches | file] ... - shadow in [switches | file] ... - - A groupfile will be created containing the specified files, - with filesize and revision date included. If files are spread - over multiple directories, they should either root in $n_src or - in $n_usrc. Otherwise you will be prompted for the directory - where the files should land in the master system. - Filenames appear in the groupfile with their respect to \$n_src. - If run from the Master, the groupfile is created in \$n_import - If run from a user system, the groupfile and all files - mentioned in it will be copied to \$n_import unless they were - locked by another user. Any existing locks are removed after - the copy, and new locks for the Newstar manager are made. - - - shadow unlock [switches | file] ... - - Unlock one or more files that have been previously checked out. - Unlocking means that the user's file is replaced by a link, and - that the lock is removed from the locking database. - | Future extensions might involve switches to check for differences. - - NB: unlocking is different from checking files in!!! - checkin involves making a groupfile and copying files - to $n_import. The files get a new lock for the Newstar - manager. Files are unlocked after the Newstar manager moved - the updated files into the master source tree. - - - shadow put [groupfile] ... - - put all files in the groupfiles in the corresponding tlb - - shadow get [groupfile] ... - - retrieve files from a tlb's corresponding to the groupfiles. - - -#-------------------------------------------------------------------------# - -_EOD_ - -# -# -# Build, Checkout, Checkin and Unlock all need a filelist -# - else if ("$Command" =~ [Bb]* || \ - "$Command" =~ [Cc]*[Oo][Uu][Tt] || \ - "$Command" =~ [Oo]* || \ - "$Command" =~ [Cc]*[Ii][Nn] || \ - "$Command" =~ [Ii]* || \ - "$Command" =~ [Uu]* ) then -# -# For checkin, we first need to do some checks and setup -# - if ("$Command" =~ [Cc]*[Ii][Nn] || \ - "$Command" =~ [Ii]*) then -# -# Find out in which directory files should end up: -# - set Lock_found=0 - if ($cwd == $n_usrc || $cwd == $n_src || $cwd == $n_import) then - set Target="" - else if ($cwd:h == $n_usrc || $cwd:h == $n_src) then - set Target="${cwd:t}/" - else - echo "You are not in a Master or user source tree." - echo "Specify the directory in the Master source tree" - echo "below which the files should finally end up." - echo -n "Enter name of subdirectory (eg nscan, doc): " - set Target=$< - set Target="$Target/" - endif - echo "" -# -# Create a temporary output file -# - cat <<_EOD_ >$Tmpfile.in -! -!${Target}File Size Chsum YYMMDD -! -_EOD_ - - endif -# -# -# If no files given, read from input -# - unset Read_files - if ("$Files" == "") set Read_files - -# -# Process all files from the commandline or read up to an empty line -# - while ("$Files" != "" || $?Read_files ) - - if ( "$Files" == "" && $?Read_files ) then - echo -n "Enter filename: " - set noglob # Don't expand wildcards right now - set Files=( $< ) # Read from stdin - set Files=( $Files ) # Split in multiple words - unset noglob - if ("$Files" == "") then - unset Read_files - set Files=( "" ) # Make sure Files[1] exists - endif - endif -# -# Though this test may seem a bit queer at first sight, it prevents -# us from "long word" errors if $Files contains more than some -# thousand characters. The other way to get around this is by using -# a foreach, but if so, we cannot push expanded groupfiles on $Files -# - while ( "$Files[1]" != "") -# -# Get the first word from $Files, make lowercase and remove from list -# - set noglob; - set Input_file=`echo $Files[1] | tr '[A-Z]' '[a-z]'` - set Files[1]=""; if ($#Files > 1) shift Files - unset noglob; -# -# If switches/options: process as local options (valid for next file only) -# - if ("$Input_file" =~ -* || "$Input_file" =~ +* ) then - set Options=( local $Input_file ); - source $n_src/sys/switches.csh - -# -# If the next file is a groupfile: expand it to it's contents -# - else if ("$Input_file" =~ @?* ) then -# -# Remove @-sign and add default extension, expand wildcards -# - set noglob; - set Input_file=`echo $Input_file | tr -d "@" ` - if ("$Input_file:e" == "") set Input_file="$Input_file.grp" - unset noglob - set Input_file=( $Input_file ) -# -# Expand wildcards and process all groupfiles. We enter into some -# ugly processing here, because I cannot rely on all architectures -# being able to handle arbitrary long environment variables (though -# both Sun and HP get pretty far!). Therefore I only expand the -# first groupfile, and put any remaining groupfiles back on the list. -# This should give no delay in the processing, but limits the number -# of items present in $Files at any given time. -# - set nonomatch - if (-e $Tmpfile) 'rm' -f $Tmpfile - foreach grpfile ( $Input_file ) - if (-e $grpfile ) then - if ( ! -e $Tmpfile) then - if ($grpfile:h == $grpfile) set grpfile=./$grpfile - echo " " - echo "======= Expanding groupfile $grpfile =======" - $n_exe/genaid.exe expand -t:$_Types $grpfile > $Tmpfile - else - set Files=( '@'$grpfile $Files ) - endif - else - echo "Error: cannot find groupfile $grpfile" - endif - end - unset nonomatch grpfile - if (-e $Tmpfile) then - if (! -z $Tmpfile) \ - set Files=( `cat $Tmpfile` $Files ) - 'rm' -f $Tmpfile - endif -# -# It's an ordinary file, pass to the compiler or other command: -# - else -# -# -# Compile the file(s) after wildcard expansion etc. -# -# Although I cannot really advise it, a user can give -Obj:mylib to -# move objects into his favourite private library. This is taken care of -# by the lines which refer to $_Objectlib and $_Objectlist. -# -# - if ("$Command" =~ [Bb]* ) then - - if ("$_Objectlib" != "") then - if ($_Objectlib !~ $n_ulib/*lib.olb) \ - set _Objectlib=$n_ulib/${_Objectlib}lib.olb - if (-e $n_work/${_Objectlib:t}.list) then - 'rm' -f $n_work/${_Objectlib:t}.list - endif - set Input_file=( $Input_file $_Objectlib ) - endif - - if ("$_Textlib" != "") then - if ($_Textlib !~ $n_ulib/*lib.olb) \ - set _Textlib=$n_ulib/${_Textlib}lib.olb - if (-e $n_work/${_Textlib:t}.list) then - 'rm' -f $n_work/${_Textlib:t}.list - endif - set Input_file=( $Input_file $_Textlib ) - endif - - source $n_src/sys/compile.csh - - if ($?Abort_flag) goto Abort_exit -# -# -# Checkout: copy the file(s) from the master tree to a user directory -# - else if ("$Command" =~ [Cc]*[Oo][Uu][Tt] ||\ - "$Command" =~ [Oo]* ) then - - if ( $_Select ) then - - foreach File ( $Input_file ) -# -# Locate the file in the master source tree -# - echo " " - unset Source Target - set nonomatch -# -# File was specified with respect to the top of the Master source tree, -# and we are in the top of our private tree. Checkin to the corresponding -# directory in our own tree. -# - if ($cwd == $n_usrc && -e $n_src/$File) then - set Source=$File - set Target=./$File -# -# Idem, but not at top of our own source tree, checkin to current directory -# - else if (-e $n_src/$File) then - set Source=$File - set Target=./$File:t -# -# File was specified with respect to subdirectory of Master source tree, -# and we are in the corresponding subdir of our private tree. Checkin -# to that directory. -# - else if ( $cwd:h == $n_usrc && -e $n_src/$cwd:t/$File) then - set Source=$cwd:t/$File - set Target=./$File -# -# Just a filename was given, and such a file exists in a subdirectory -# of the master. Since we are not in our private source tree (would have -# been catched earlier) we check in to current directory. -# - else if ( $File:t == $File && -e $n_src/*/$File) then - set Source=( $n_src/*/$File ) - set Source=`echo $Source[1] | sed -e "s%^$n_src/%%"` - if ($cwd == $n_usrc) then - set Target=$Source - else - set Target=./$File - endif -# -# One level deeper -# - else if ( $File:t == $File && -e $n_src/*/*/$File) then - set Source=( $n_src/*/*/$File ) - set Source=`echo $Source[1] | sed -e "s%^$n_src/%%"` - if ($cwd == $n_usrc) then - set Target=$Source - else - set Target=./$File - endif -# -# File was completely specified. If stripping n_src makes any difference, -# the file is in the Master source tree. If not, the file exists -# somewhere outside the tree, and we are not interested. -# -# If we are somewhere in our own private tree, checkin to the correct -# subdirectory of that tree. Otherwise, checkin to the current dir. -# - else if (-e $File ) then - set Source=`echo $File | sed -e "s%^$n_src/%%"` - if ("$Source" != "$File") then - if ($cwd == $n_usrc || $cwd:h == $n_usrc) then - set Target=$n_usrc/$Source - else - set Target=./$File:t - endif - else - unset Source - echo "Warning: File $File is not in the Master tree" - endif -# -# If anything else fails, try to locate it in a tlb, this only works -# if we are in a subdirectory of the Master. -# - else if ($cwd:h == $n_src && -e $n_src/${cwd:t}lib.tlb) then - ar xv $n_src/${cwd:h}lib.tlb $File:t - echo "$File:t extracted from tlb" -# -# Although it seems unlikely regarding our previous effords, -# we still may not be able to locate the file... -# - else - echo "Error: Cannot locate $File" - endif - - unset nonomatch -# -# If located, remove any existing links, copy and lock the file -# - if ($?Source) then - if (-e $n_import/$Source:t) then - echo "Taking $Source from "\$n_import - set Full_source=$n_import/$Source:t - else - set Full_source=$n_src/$Source - endif - - if (-e $Target) then - if ("`ls -F $Target`" =~ *@ ) then - 'rm' -f $Target - else - cmp $Full_source $Target - if ($status) then - echo "File $Target already exists..." - diff -b $Full_source:t $Target - echo -n "Remove "; 'rm' -i $Target - else - 'rm' -f $Target - endif - endif - endif -# -# If new file should be created, copy either from source tree or from import -# - if (! -e $Target) then - echo "checkout: $Source --> $Target" - cp -p $Full_source $Target - endif -# -# Check and set the lock -# Removing the old lock also replaces "imported" by "locked" if from import -# - if (-e $n_src/sys/lock.idx) then - set Lock=(` grep $Source $n_src/sys/lock.idx `) - if ("$Lock" != "" && "$Lock" !~ *User=$USER*) then - echo "Warning: $Lock" - endif - if ("$Lock" == "" || "$Lock" =~ *imported* || \ - "$Lock" =~ *User=$USER*) then - if ("$Lock" != "") then # Remove old lock - cp $n_src/sys/lock.idx $n_work/lock.old - grep -v $Source $n_work/lock.old \ - >$n_src/sys/lock.idx - endif - echo \ - "+$Source locked User=$USER Date=$C_Date/$C_Time" \ - | tee -a $n_src/sys/lock.idx - endif - unset Lock - endif - - endif # endif source found - - unset Target Source - end - else - echo "You should not checkout $Input_file on $n_arch" - endif -# -# -# Unlock files from usersystem -# - else if ("$Command" =~ [Uu]* ) then - - set Home=$cwd; - - foreach File ( $Input_file ) -# -# If we are somewhere in our private source tree, we can match the -# file with respect to the Master source tree, otherwise we just match -# the name. This removes locks to ALL matching files. In practice, there -# will be no files with identical names, and it is even less likely that -# a user will lock out multiple files with the same name, and if so -# it is not unreasonable to require him to work in a shadow tree... -# - if ($cwd == $n_usrc) then - if ($File:t == $File && -e $n_src/*/$File) then - set Full=( $n_src/*/$File ) - set Full=`echo $Full[1] | sed -e "s%^$n_src/%%"` - else if ($File:t == $File && -e $n_src/*/*/$File) then - set Full=( $n_src/*/*/$File ) - set Full=`echo $Full[1] | sed -e "s%^$n_src/%%"` - endif - endif - if ($File:h != $File) cd $File:h - set Full=$cwd/$File:t - cd $Home -# -# If in shadow tree, replace existing file with a link -# (if not already a link!), otherwise delete it. -# - if (-e $Full && $Full !~ $n_src/* ) then - - if ("`ls -F $Full`" !~ *@ ) then - - set nonomatch - if (-e $n_import/$Full:t) then - cmp $Full $n_import/$Full:t - if ($status) then - diff -b $Full $n_import/$Full:t - echo -n "Remove "; 'rm' -i $Full - else - 'rm' -f $Full - endif - else if (-e $n_src/*/$Full:t) then - cmp $Full $n_src/*/$Full:t - if ($status) then - diff -b $Full $n_src/*/$Full:t - echo -n "Remove "; 'rm' -i $Full - else - 'rm' -f $Full - endif - else - echo -n "Remove "; 'rm' -i $Full - endif - unset nonomatch - - if (-e $Full ) then - echo "***** Warning: $Full not deleted..." - else if ( "$Full" =~ $n_usrc/* ) then - set Master = \ - `echo $Full | sed -e "s:${n_uroot}:${n_root}:"` - ln -s $Master $Full -## HjV 9601021 was : ln -s $n_src/${cwd:t}/$File $Full - echo "File $File replaced by soft link" - else - echo "File $Full has been deleted" - endif - endif - endif -# -# Remove lock if file previously locked by this user -# -# Owner of Newstar master source tree can unlock any file -# - if (-e $n_src/sys/lock.idx) then - set File=`echo $Full | sed -e "s%^$n_usrc/%%"` - if ($File == $Full) set File=/$File:t - set Lock=(` grep $File $n_src/sys/lock.idx `) - if ("$Lock" != "") then - if ("$Lock" =~ *User=$USER* || -o $n_src ) then - cp $n_src/sys/lock.idx $n_work/lock.old - grep -v $File $n_work/lock.old >$n_src/sys/lock.idx - 'rm' -f $n_work/lock.old - echo "Removed: $Lock" - if (-e $n_import/$Full:t) echo \ - "$Lock[1] imported User=$USER Date=$C_Date/$C_Time" \ - | tee -a $n_src/sys/lock.idx - else - echo "Warning: $Lock" - endif - else - echo "$File:t was not locked" - endif - unset Lock - else - echo "No locking database" - endif - end - - unset Home -# -# -# Checkin: write filename to groupfile -# - else if ( "$Command" =~ [Cc]*[Ii][Nn] || \ - "$Command" =~ [Ii]* ) then - set Home=$cwd; - - foreach File ( $Input_file ) -# -# Give the file a full path and make it relative to current dir -# - if ($File:h != $File) cd $File:h - set Full=$cwd/$File:t - set File=`echo $Full | sed -e "s%^$Home/%%"` - cd $Home -# -# The file should exist and root in current dir -# - if ("$Full:e" == "exe") then - echo "Warning: $Full:t ignored, specify exe-files later" - else if (! -e $Full) then - echo "Error: $Full does not exist..." - else if ( $File == $Full && $File !~ $n_src/* ) then - echo "Error: File should root in current directory" - else -# -# It's there all right, make groupfile entry and check any locks -# - if (! -e $n_src/sys/lock.idx) then - set Lock="" - else - set Lock=(`grep +$Target$File $n_src/sys/lock.idx`) - endif -# -# If no lock or locked by this user, append to groupfile -# - if ("$Lock" == "" || "$Lock" =~ *User=$USER* ) then - $n_exe/genaid.exe fstat -t:$_Types +$Target $File \ - >>$Tmpfile.in - echo "$File ok" - else - set Lock_found=1 - echo "$Lock" - endif - endif - end - - endif # End of if (command) - - if ("$Save_switch" != "") set $Save_switch # Restore switches - - endif # End of if (groupfile) - end # End of while (Files left) - - end # End of while (Files left) -# -# For build, report the total number of errors -# - if ("$Command" =~ [Bb]* ) then - if ("$Errors" == 0) then - echo "Congratulations: no errors occurred" - else - echo "Total number of errors: $Errors " - endif -# -# For checkin, we may want to move all files to $n_import -# - else if ("$Command" =~ [Cc]*[Ii][Nn] || "$Command" =~ [Ii]* ) then -# -# If locks where found, doo nothing at all -# - if ($Lock_found) then - cat <<_EOD_ - -Found files that were locked by other users, so you cannot move your files -to \$n_import. Please contact your local Newstar manager... - -_EOD_ - else - -# -# Create a groupfile for export -# - set Flag=$USER - if ("$USER" == devoscm) set Flag=cmv - if ("$USER" == noordam) set Flag=jen - if ("$USER" == wbrouw) set Flag=wnb - if ("$USER" == newstar) set Flag=x - - set Outfile=upd${C_Date}${Flag}.grp - @ ii = 1 - while ( -e $Outfile || -e $n_import/$Outfile || -e $n_import/old/$Outfile) - if (! -e $n_import/$Outfile && ! -e $n_import/old/$Outfile) then - echo -n "Remove old groupfile "; 'rm' -i $Outfile - endif - if ( -e $Outfile || -e $n_import/$Outfile || -e $n_import/old/$Outfile) then - set Outfile=upd${C_Date}${Flag}$ii.grp - endif - @ ii = $ii + 1 - end - - echo "\!+ $Outfile" >$Outfile - cat <<_EOD_ >>$Outfile -! -! Export of updated files for Newstar ($C_Date $C_Time $n_arch) -! Groupfile created by $USER ($Myname) at $n_site (${HOST}) -! -_EOD_ - echo "" - echo "The comment will show up in nnews later, so please" - echo "include the names of programs that are affected" - echo -n "Enter a comment: " - set Flag=( $< ) - while ("$Flag" != "") - echo -n "If this is a bug solution, enter the bug-id here: " - set Bug=( $< ) - if ("$Bug" != "") set Flag=( $Flag " - bug $Bug " ) - echo "\! Subject: $Flag" >>$Outfile - echo -n "Enter more comments [no more]: " - set Flag=( $< ) - end -# -# Append temporary groupfile -# - cat $Tmpfile.in >>$Outfile - 'rm' -f $Tmpfile.in -# -# Append a list of executables -# - echo 'Possible shorthands: @all, @n[ewstar], @d[warf], @a[bp]' - echo -n "Enter any executables to be rebuilt (default extension .exe): " - set Flag=($<) - if ("$Flag" != "") then - echo "! " >>$Outfile - echo "! Executables " >>$Outfile - echo "! " >>$Outfile - - set Flag=( $Flag ) - foreach File ( $Flag ) - set File=$File:t - if ($File =~ @[Aa][Ll][Ll]) then - grep -h '^[^ ]*\.[Ee][Xx][Ee]' $n_src/*/*.grp >>$Outfile - else if ($File =~ @[Aa]*) then - grep -h '^[^ ]*\.[Ee][Xx][Ee]' $n_src/dwarf/abp.grp >>$Outfile - else if ($File =~ @[Dd]*) then - grep -h '^[^ ]*\.[Ee][Xx][Ee]' $n_src/dwarf/src.grp >>$Outfile - else if ($File =~ @[Nn]*) then - grep -h '^[Nn][^ ]*\.[Ee][Xx][Ee]' $n_src/n*/*.grp >>$Outfile - else - if ("$File:e" != "exe") set File=${File:r}.exe - echo "$File" >>$Outfile - endif - end - endif -# -# Edit the file? -# - echo "! End of groupfile $Outfile" >>$Outfile - echo "" - cat $Outfile - echo "" - echo -n "Do you want to edit the groupfile (y,n)? [n] " - set Flag=($<) - if ("$Flag" =~ [Yy]*) then - if ($?EDITOR) then - $EDITOR $Outfile - else - emacs $Outfile - endif - endif -# -# Decide wether or not to copy the files -# - echo "" - echo -n "Move files to "\$n_import" (y,n)? [y] " - set Flag=($<) - if ("$Flag" !~ [Nn]*) then -# -# Copy the files to n_import (sed returns the filename w.r.t. $cwd) -# Do not copy if the file resides below $n_src -# Make new locks indicating the thing is in import. -# Do not lock for Newstar (as was old practice) to allow repeated -# checkins by the same user. -# - $n_exe/genaid.exe files -t:^exe $Outfile > $Tmpfile - - set remote_import=( $n_remote ) - if (-e $Tmpfile.1) then - 'rm' -f $Tmpfile.1 - endif - echo "quote user anonymous" >$Tmpfile.1 - echo "quote pass $USER@`domainname`" >>$Tmpfile.1 - echo "ascii" >>$Tmpfile.1 - echo "cd $remote_import[3]" >>$Tmpfile.1 - echo "cd ../import" >>$Tmpfile.1 - echo "put $Outfile $Outfile:t" >>$Tmpfile.1 - - foreach file ( `cat $Tmpfile | sed -e "s%^$Target%%"` ) - if ($cwd != $n_src && $cwd:h != $n_src) then - echo "cp $file $n_import" - cp ./$file $n_import - chmod a+rw $n_import/$file:t - if ($file:e == csh) chmod a+x $n_import/$file:t - endif - echo "put ./$file $file:t" >>$Tmpfile.1 - echo "put ./$file backup/${file:t}.${Outfile:r}" >>$Tmpfile.1 - end - echo "bye" >>$Tmpfile.1 - ftp -n -v -i $remote_import[1] <$Tmpfile.1 - 'rm' -f $Tmpfile.1 - - if (-e $n_src/sys/lock.idx) then - foreach file ( `cat $Tmpfile` ) - set Lock=(`grep $file $n_src/sys/lock.idx`) - if ("$Lock" != "") then - cp $n_src/sys/lock.idx $n_work/lock.old - grep -v $file $n_work/lock.old >$n_src/sys/lock.idx - endif - echo \ - "+$file imported User=$USER Date=$C_Date/$C_Time" \ - | tee -a $n_src/sys/lock.idx - end - 'rm' -f $n_work/lock.old - endif - 'rm' -f $Tmpfile - - echo "cp $Outfile $n_import" - cp $Outfile $n_import - chmod a+rw $n_import/$Outfile:t -# -# Notify Newstar account -# - echo "Notification will be sent to $USER and $n_master" - cat $Outfile | nsmail "Checkin by $USER" $n_master $USER - endif - endif - unset Lock_found - endif -# -# -# %Link command: -# - else if ("$Command" =~ [Ll]* ) then - -# -# Setup suboption: create shadow directories, update links in n_uinc -# - if ("$Files[1]" =~ [Ss][Ee][Tt]* ) then - if ($?n_uroot) then - if (! -d $n_uroot) then - echo "Creating $n_uroot" - mkdir $n_uroot - endif - endif - if ($?n_usrc) then - if (! -d $n_usrc && $n_usrc != __undefined__) then - echo "Creating $n_usrc" - mkdir $n_usrc - endif - endif - if ($?n_uinc) then - if (! -d $n_uinc) then - set dir=$n_uinc - set dir=$dir:h - if (! -d $dir) then - echo "Creating $dir" - mkdir $dir - endif - echo "Creating $n_uinc" - mkdir $n_uinc - endif - endif - if ($?n_ulib) then - if (! -d $n_ulib) then - set dir=$n_ulib - set dir=$dir:h - if (! -d $dir) then - echo "Creating $dir" - mkdir $dir - endif - echo "Creating $n_ulib" - mkdir $n_ulib - endif - endif - if ($?n_uexe) then - if (! -d $n_uexe) then - set dir=$n_uexe - set dir=$dir:h - if (! -d $dir) then - echo "Creating $dir" - mkdir $dir - endif - echo "Creating $n_uexe" - mkdir $n_uexe - endif - endif - if ($?n_work) then - if (! -d $n_work) then - set dir=$n_work - set dir=$dir:h - if (! -d $dir) then - echo "Creating $dir" - mkdir $dir - endif - echo "Creating $n_work" - mkdir $n_work - endif - endif - - echo -n "Update links in "\$n_uinc" (y,n)? [y] " - set ans=($<) - if ($ans !~ [Nn]*) then - ln -s $n_inc/* $n_uinc - endif - - else if ($n_usrc == __undefined__) then - echo "You should have defined "\$n_usrc" before you can link\!" - echo "Please read "\$n_src/sys/newstar_init.csh" for information..." - else if ($cwd != $n_usrc && $cwd:h != $n_usrc ) then - echo "First change directory to "\$n_usrc" or a subdirectory thereof..." - else if ($cwd != $n_usrc && ! -d $n_src/$cwd:t ) then - echo "$cwd:t is not a (linkable) Newstar directory" - else - - if ("$Files" != "") then - set dir=( $Files ) - cd $n_usrc - echo "Now in $n_usrc" - else if ($cwd == $n_usrc) then - set dir=( $NSTAR_DIR ) - else - set dir=$cwd:t - endif - - echo "Making links for directories $dir to $cwd" -# -# Find all groupfiles (should be *.grp, but we still have nscanyymmdd.grp's) -# - foreach subdir ( $dir ) - - echo "======= Working on $n_src/$subdir ========" - foreach grpfile ( $n_src/$subdir/???.grp ) - - echo "======= Making links for groupfile $grpfile:t =======" - if (! -e $n_usrc/$subdir) then - mkdir $n_usrc/$subdir - echo "Made subdirectory $subdir" - endif -# -# Take all the efford of redirection and `cat` to avoid "long words" and -# errors due to pipes within ` ` (the latter should be no problem, but -# we should not press our luck to the edges...) -# - $n_exe/genaid.exe files -t:^exe $grpfile >$Tmpfile - foreach file ( `cat $Tmpfile` ) - - set file=`echo $file | sed -e s@$n_src/@@` - if (! -e $n_src/$file) then - echo "File $file does not exist in Master ...." - else -# -# Silently remove existing links, skip existing files since user -# should explicitly unlock them. -# - if (-e $n_usrc/$file) then - if ("`ls -F $n_usrc/$file`" =~ *@ ) then - 'rm' -f $n_usrc/$file - else - cmp $n_usrc/$file $n_src/$file >& /dev/null - if (! $status) then - 'rm' $n_usrc/$file - ln -s $n_src/$file $n_usrc/$file - echo \ - " ${file}: replaced identical copy by link" - else - echo \ - " ${file}: left variant copy" - endif - endif - endif - if ("$file:h" != "" && ! -d "$file:h") mkdir $file:h - if (! -e $n_usrc/$file) then - rm >&/dev/null $n_usrc/$file - # may be soft link to nonexistent file - ln -s $n_src/$file $n_usrc/$file -## echo "Linked $file" - endif - endif - end - - 'rm' -f $Tmpfile - end - end - endif -# -# -# %Put: Move files into text-library -# - else if ("$Command" =~ [Pp][Uu][Tt]) then -# -# Get names of groupfiles -# - if ("$Files" == "") then - echo -n "Enter name of groupfile(s): " - set noglob # Don't expand wildcards right now - set Files=( $< ) # Read from stdin - set Files=( $Files ) # Split in multiple words - unset noglob - endif -# -# Expand them and update text-libraries -# - foreach grpfile ( $Files ) - if ( "$grpfile:e" == "" ) set grpfile=$grpfile.grp - if (! -e $grpfile ) then - echo "Groupfile $grpfile does not exist..." - else - set archive=${grpfile:r}.tlb - echo "Updating text-library $archive" - $n_exe/genaid.exe files -t:^exe $grpfile >$Tmpfile - ar rv $archive `cat $Tmpfile` - 'rm' -f $Tmpfile - endif - end - unset archive grpfile -# -# %Get: Get files from text-library -# - else if ("$Command" =~ [Gg][Ee][Tt]) then -# -# Get names of groupfiles -# - if ("$Files" == "") then - echo -n "Enter name of groupfile(s): " - set noglob # Don't expand wildcards right now - set Files=( $< ) # Read from stdin - set Files=( $Files ) # Split in multiple words - unset noglob - endif -# -# Get each groupfile if necessary, expand and extract the files -# - foreach grpfile ( $Files ) - if ( "$grpfile:e" == "" ) set grpfile=$grpfile.grp - set archive=${grpfile:r}.tlb - if (! -e $archive ) then - echo "Text-library $archive does not exist..." - else - if (! -e $grpfile) then - ar xvo $archive $grpfile - endif - if (! -e $grpfile) then - echo "Groupfile $grpfile does not exist in library" - else - echo "Extracting from text-library $archive" - $n_exe/genaid.exe files -t:^exe $grpfile >$Tmpfile - ar xvo $archive `cat $Tmpfile` - 'rm' -f $Tmpfile - endif - endif - end - unset archive grpfile - - else # Other command - echo "" - echo "Error: Invalid or ambiguous command $Command" - echo "" - endif # End of if (Command == ...) - -end # End of while (Menu mode) - - -Abort_exit: - -if (-e $Tmpfile) 'rm' -f $Tmpfile -if ($?Errors) then - exit $Errors -endif diff --git a/src/sys/shadow.pls b/src/sys/shadow.pls deleted file mode 100755 index c10df5204e7702548f54d2ba7e5413ec0c16fea9..0000000000000000000000000000000000000000 --- a/src/sys/shadow.pls +++ /dev/null @@ -1,1284 +0,0 @@ -#+ shadow.pls -# created by wbrouw on norma at Tue Jun 21 13:26:58 LST 1994 -#- -#!/bin/csh -f -#set echo -#+ -# -# shadow.csh -# CMV 930526 Created -# CMV 931018 Added link setup, mail for checkin -# CMV 931020 Changed call to switches -# CMV 931111 Improved locking -# CMV 931116 Add abbreviations for executables in checkin -# CMV 931124 Put and get command are now here, -# better error log, overwrite existing links -# CMV 931223 Change handling of libraries -# HjV 940412 Use $n_ulib iso. $n_lib for use private library -# CMV 940506 Allow multiple comment lines for checkin, -# check locks in advance -# -# -# shadow.csh Interface to shadow system commands -# -# Use "shadow help" for information on usage -# -# -#- -#+ -# Preamble -# -unless (defined $VMS) { # check for environment - if ($ENV{"SHELL"}) { # aid routines unix - unshift(@INC,$ENV{'n_src'}.'/sys');} - else { # aid routines VMS - unshift(@INC,'N_SRC:[SYS]');} - unless (require 'c2aid.pls') { - print "Fatal: Cannot load c2aid.pls properly"; exit;} - &ENV_IMPORT; # get environment - $argv=join(' ',@ARGV);} # get command arguments -if (&ft("e",&fp("r","$0").".csh") && # renew main routine - (&ft("M","$0") > &ft("M","$n_src/sys/csh2p.pls") || - &ft("M","$0") > &ft("M",&fp("r","$0").".csh"))) { - $status=&system("perl ".&fnp("$n_src/sys/csh2p.pls")." ". - &fp("r","$0"));} -# -# Start translated script -#- -sub shadow__pls { - $SIG{'INT'}= Abort_exit_shadow ; -# -# Check environment, set defaults -# - &source( &fn( $n_src ."/sys/initcompile.csh" ) ) ; -# -# Decode switches, get command or set menu mode if none given -# - $noglob='' ; $Command= &fn( $argv ) ; undef $noglob ; - $Options= '' ; &source( &fn( $n_src ."/sys/switches.csh" ) ) ; - $Files= '' ; - if ( !&eq( $Command , '' ) ) { - $Mode= "Command" ; - if ( &vn($Command) > 1 ) { - $noglob='' ; $Files= &fn( (split(' ',$Command)) [ 2 -1 .. - &vn($Command)-1 ] ) ; undef $noglob ; - $Command= &fn( (split(' ',$Command)) [ 1 -1 ] ) ; - } - } - else { - $Mode= "Menu" ; - $Command= '' ; - } - while ( !&eq( $Mode , "Quit" ) ) { - if ( &eq( $Mode , "Menu" ) ) { - &echo( '' , "Valid commands are: help, build, link, get, " - ."put, quit" , "" ) ; - &echo( '' , " out=checkout, in=checkin" - .", unlock." , "" ) ; - &echo( "-n" , "Enter a command: " , "" ) ; - $Command= ($_=scalar(<STDIN>), chop, $_) ; - $Files= '' ; - $noglob='' ; $Command= &fn( $Command ) ; undef $noglob ; - $Options= '' ; &source( &fn( $n_src ."/sys/switches.csh" ) ) ; - if ( &vn($Command) > 1 ) { - $noglob='' ; $Files= &fn( (split(' ',$Command)) [ 2 -1 .. - &vn($Command)-1 ] ) ; undef $noglob ; - $Command= &fn( (split(' ',$Command)) [ 1 -1 ] ) ; - } - } - else { - $Mode= "Quit" ; - } - if ( &eq( $Command , '' ) || &peq( $Command , "[Qq]*" ) ) { - $Mode= "Quit" ; - } - elsif ( &peq( $Command , "[Hh]*" ) ) { - sub C2_t1_shadow { - local(*TMP); - open(TMP,">txt$$.tmp"); - print TMP "#+++++++++++++++++++++++++++++++++++++++++++" - ."+++++++++++++++++++++++++++++++++#" ."\n" ; - print TMP '' ."\n" ; - print TMP " shadow can be called in one of the followi" - ."ng ways:" ."\n" ; - print TMP '' ."\n" ; - print TMP '' ."\n" ; - print TMP " shadow" ."\n" ; - print TMP '' ."\n" ; - print TMP " Without options, enter menu mode, whic" ."h" - ."\n" ; - print TMP " prompts you for commands and filenames" ."\n" ; - print TMP '' ."\n" ; - print TMP " shadow build [switches | file] " ."\n" ; - print TMP '' ."\n" ; - print TMP " Compile one or more files. All files h" - ."ave to be fully " ."\n" ; - print TMP " specified (that is either full pathnam" - ."e or the path with" ."\n" ; - print TMP " respect to current directory)." ."\n" ; - print TMP " If no files are present, their names a" - ."re read from the " ."\n" ; - print TMP " standard input." ."\n" ; - print TMP '' ."\n" ; - print TMP " You may specify groupfiles prefixed by" - ." an @-sign, in " ."\n" ; - print TMP " which case the contents of the file wi" - ."ll be processed." ."\n" ; - print TMP '' ."\n" ; - print TMP " Switches are specified like -Debug,Alt" - ."ernate,List,Print and" ."\n" ; - print TMP " may be abbreviated. For more informati" - ."on, give switch -Help " ."\n" ; - print TMP " All switches on the command line are a" - ."pplied to all files. " ."\n" ; - print TMP " Switches appearing within a groupfile " - ."are only applied to " ."\n" ; - print TMP " the file after which they appear." ."\n" ; - print TMP '' ."\n" ; - print TMP " shadow link [setup | dir ...]" ."\n" ; - print TMP '' ."\n" ; - print TMP " Create a shadow tree starting at the c" - ."urrent directory." ."\n" ; - print TMP " You should have set " . $n_usrc ." already." - ."\n" ; - print TMP '' ."\n" ; - print TMP - " If you do not specify a directory, and you are in " - . $n_usrc .", the" ."\n" ; - print TMP " standard Newstar program subdirectorie" - ."s (not sys and doc etc)" ."\n" ; - print TMP " will be shadowed. If you do not specif" - ."y a directory and you are" ."\n" ; - print TMP " in a subdirectory of " . $n_usrc - .", that directory will be shadowed." ."\n" ; - print TMP " If you do specify a directory, and tha" - ."t directory is a subdirectory" ."\n" ; - print TMP " of " . $n_src - .", the specified directory will be shadowed." - ."\n" ; - print TMP '' ."\n" ; - print TMP " NOTYET If one or more groupfiles are gi" - ."ven, only the files listed" ."\n" ; - print TMP " NOTYET therein will be shadowed." ."\n" ; - print TMP '' ."\n" ; - print TMP " If the argument setup is given, any mi" - ."ssing shadow top-directories" ."\n" ; - print TMP " are created and a shadow copy of the i" - ."nclude files is made." ."\n" ; - print TMP '' ."\n" ; - print TMP '' ."\n" ; - print TMP " shadow checkout [switches | file] ..." ."\n" ; - print TMP " shadow out [switches | file] ..." ."\n" ; - print TMP '' ."\n" ; - print TMP " Copy one or more files to the current " - ."directory, " ."\n" ; - print TMP " leaving a lock in the locking database" ."." - ."\n" ; - print TMP " Groupfiles prefixed with an @-sign wil" - ."l be replaced" ."\n" ; - print TMP " by their contents. If no files are pre" - ."sent, their names " ."\n" ; - print TMP " are read from the standard input." ."\n" ; - print TMP " If the file does not exist but is foun" - ."d in a textlibrary, " ."\n" ; - print TMP " it will be extracted." ."\n" ; - print TMP '' ."\n" ; - print TMP " shadow checkin [switches | file] ..." ."\n" ; - print TMP " shadow in [switches | file] ..." ."\n" ; - print TMP '' ."\n" ; - print TMP " A groupfile will be created containing" - ." the specified files," ."\n" ; - print TMP " with filesize and revision date includ" - ."ed. If files are spread " ."\n" ; - print TMP - " over multiple directories, they should either root in " - . $n_src ." or " ."\n" ; - print TMP " in " . $n_usrc - .". Otherwise you will be prompted for the dir" - ."ectory " ."\n" ; - print TMP " where the files should land in the mas" - ."ter system." ."\n" ; - print TMP " Filenames appear in the groupfile with" - ." their respect to \$n_src." ."\n" ; - print TMP " If run from the Master, the groupfile " - ."is created in \$n_import" ."\n" ; - print TMP " If run from a user system, the groupfi" - ."le and all files " ."\n" ; - print TMP " mentioned in it will be copied to \$n_" - ."import unless they were" ."\n" ; - print TMP " locked by another user. Any existing l" - ."ocks are removed after" ."\n" ; - print TMP " the copy, and new locks for the Newsta" - ."r manager are made." ."\n" ; - print TMP '' ."\n" ; - print TMP '' ."\n" ; - print TMP " shadow unlock [switches | file] ..." ."\n" ; - print TMP '' ."\n" ; - print TMP " Unlock one or more files that have bee" - ."n previously checked out." ."\n" ; - print TMP " Unlocking means that the user's file i" - ."s replaced by a link, and " ."\n" ; - print TMP " that the lock is removed from the lock" - ."ing database." ."\n" ; - print TMP " | Future extensions might involve switch" - ."es to check for differences." ."\n" ; - print TMP '' ."\n" ; - print TMP " NB: unlocking is different from checki" - ."ng files in!!!" ."\n" ; - print TMP " checkin involves making a groupfil" - ."e and copying files" ."\n" ; - print TMP " to " . $n_import - .". The files get a new lock for the Newstar " - ."\n" ; - print TMP " manager. Files are unlocked after " - ."the Newstar manager moved " ."\n" ; - print TMP " the updated files into the master " - ."source tree." ."\n" ; - print TMP " " ."\n" ; - print TMP '' ."\n" ; - print TMP " shadow put [groupfile] ..." ."\n" ; - print TMP '' ."\n" ; - print TMP " put all files in the groupfiles in " - ."the corresponding tlb" ."\n" ; - print TMP '' ."\n" ; - print TMP " shadow get [groupfile] ..." ."\n" ; - print TMP " " ."\n" ; - print TMP " retrieve files from a tlb's corresp" - ."onding to the groupfiles." ."\n" ; - print TMP '' ."\n" ; - print TMP '' ."\n" ; - print TMP "#-------------------------------------------" - ."------------------------------#" ."\n" ; - print TMP '' ."\n" ; - close(TMP); - "txt$$.tmp";} - &cat( '' , &C2_t1_shadow , "" ) ; -# -# -# Build, Checkout, Checkin and Unlock all need a filelist -# - } - elsif ( &peq( $Command , "[Bb]*" ) || &peq( $Command , - "[Cc]*[Oo][Uu][Tt]" ) || &peq( $Command , "[Oo]*" - ) || &peq( $Command , "[Cc]*[Ii][Nn]" ) || &peq( - $Command , "[Ii]*" ) || &peq( $Command , "[Uu]*" - ) ) { -# -# For checkin, we first need to do some checks and setup -# - if ( &peq( $Command , "[Cc]*[Ii][Nn]" ) || &peq( $Command , - "[Ii]*" ) ) { -# -# Find out in which directory files should end up: -# - if ( &eq( $cwd , $n_usrc ) || &eq( $cwd , $n_src ) || &eq( $cwd , - $n_import ) ) { - $Target= '' ; - } - elsif ( &eq( &fp('h', $cwd ) , $n_usrc ) || &eq( &fp('h', $cwd ) , - $n_src ) ) { - $Target= &fp('t', $cwd ) ."/" ; - } - else { - &echo( '' , "You are not in a Master or user source tree." , "" - ) ; - &echo( '' , "Specify the directory in the Master source t" - ."ree" , "" ) ; - &echo( '' , "below which the files should finally end up." , "" - ) ; - &echo( "-n" , "Enter name of subdirectory (eg nscan, doc): " , - "" ) ; - $Target= ($_=scalar(<STDIN>), chop, $_) ; - $Target= $Target ."/" ; - } -# -# Create a groupfile for export -# - $Flag= &fn( $USER ) ; - if ( &eq( $USER , "devoscm" ) ) { $Flag= "cmv" ; } - if ( &eq( $USER , "noordam" ) ) { $Flag= "jen" ; } - if ( &eq( $USER , "newstar" ) ) { $Flag= "x" ; } - $Outfile= &fn( "upd" . $C_Date . $Flag .".grp" ) ; - $ii= 1 ; - while ( &ft('e', $Outfile ) || &ft('e', $n_import ."/" . $Outfile - ) ) { - if ( ! &ft('e', $n_import ."/" . $Outfile ) ) { - &echo( "-n" , "Remove old groupfile " , "" ) ; &rm( "-i" , - &fn( $Outfile ) ) ; - } - if ( &ft('e', $Outfile ) || &ft('e', $n_import ."/" . $Outfile ) - ) { - $Outfile= &fn( "upd" . $C_Date . $Flag . $ii .".grp" ) ; - } - $ii= $ii + 1 ; - } - &echo( '' , "\!+ " . $Outfile , ''. &fn( $Outfile ) ) ; - sub C2_t2_shadow { - local(*TMP); - open(TMP,">txt$$.tmp"); - print TMP "!" ."\n" ; - print TMP "! Export of updated files for Newstar (" . $C_Date - ." " . $C_Time ." " . $n_arch .")" ."\n" ; - print TMP "! Groupfile created by " . $USER ." (" . $Myname - .") at " . $n_site ." (" . $HOST .")" ."\n" ; - print TMP "!" ."\n" ; - close(TMP); - "txt$$.tmp";} - &cat( '' , &C2_t2_shadow , '>'. &fn( $Outfile ) ) ; - &echo( '' , "The comment may show up in nnews later, so p" - ."lease" , "" ) ; - &echo( '' , "include name of programs affected" , "" ) ; - &echo( "-n" , "Enter a comment: " , "" ) ; - $Flag= ($_=scalar(<STDIN>), chop, $_) ; - while ( !&eq( $Flag , '' ) ) { - &echo( "-n" , "If this is a bug solution, enter the bug-id " - ."here: " , "" ) ; - $Bug= ($_=scalar(<STDIN>), chop, $_) ; - if ( !&eq( $Bug , '' ) ) { $Flag= &fn( $Flag ) .' '. - " - bug " . $Bug ." " ; } - &echo( '' , "\! Subject: " . $Flag , '>'. &fn( $Outfile ) ) ; - &echo( "-n" , "Enter more comments [no more]: " , "" ) ; - $Flag= ($_=scalar(<STDIN>), chop, $_) ; - } - sub C2_t3_shadow { - local(*TMP); - open(TMP,">txt$$.tmp"); - print TMP "! " ."\n" ; - print TMP "!" . $Target - ."File Size Chsum YYM" - ."MDD" ."\n" ; - print TMP "! " ."\n" ; - close(TMP); - "txt$$.tmp";} - &cat( '' , &C2_t3_shadow , '>'. &fn( $Outfile ) ) ; - } -# -# -# If no files given, read from input -# - undef $Read_files ; - if ( &eq( $Files , '' ) ) { $Read_files='' ; } -# -# Process all files from the commandline or read up to an empty line -# - while ( !&eq( $Files , '' ) || defined($Read_files) ) { - if ( &eq( $Files , '' ) && defined($Read_files) ) { - &echo( "-n" , "Enter filename: " , "" ) ; - $noglob='' ; # Don't expand wildcards right now - $Files= ($_=scalar(<STDIN>), chop, $_) ; # Read from stdin - $Files= &fn( $Files ) ; # Split in multiple words - undef $noglob ; - if ( &eq( $Files , '' ) ) { - undef $Read_files ; - $Files= '' ; # Make sure Files[1] exists - } - } -# -# Though this test may seem a bit queer at first sight, it prevents -# us from "long word" errors if $Files contains more than some -# thousand characters. The other way to get around this is by using -# a foreach, but if so, we cannot push expanded groupfiles on $Files -# - while ( !&eq( (split(' ',$Files)) [ 1 -1 ] , '' ) ) { -# -# Get the first word from $Files, make lowercase and remove from list -# - $noglob='' ; - $Input_file= &Pipe("p$$.tmp00", &echo( '' , &fn( - (split(' ',$Files)) [ 1 -1 ] ) , "p$$.tmp01" ) , - &tr( '' , '[A-Z]' , '[a-z]' , "p$$.tmp01" , - "p$$.tmp00" ) ) ; - @Files=split(' ',$Files); splice(@Files, "1" -1,1, '' ); - $Files=join(' ',@Files); if ( &vn($Files) > 1 ) { - @Files=split(' ',$Files) ; shift(@Files) ; - $Files=join(' ',@Files) ; } - undef $noglob ; -# -# If switches/options: process as local options (valid for next file only) -# - if ( &peq( $Input_file , "-*" ) || &peq( $Input_file , "+*" ) - ) { - $Options= "local" .' '. &fn( $Input_file ) ; - &source( &fn( $n_src ."/sys/switches.csh" ) ) ; -# -# If the next file is a groupfile: expand it to it's contents -# - } - elsif ( &peq( $Input_file , "@?*" ) ) { -# -# Remove @-sign and add default extension, expand wildcards -# - $noglob='' ; - $Input_file= &Pipe("p$$.tmp00", &echo( '' , &fn( $Input_file - ) , "p$$.tmp01" ) , &tr( "-d" , "@" , '' , - "p$$.tmp01" , "p$$.tmp00" ) ) ; - if ( &eq( &fp('e', $Input_file ) , '' ) ) { $Input_file= - $Input_file .".grp" ; } - undef $noglob ; - $Input_file= &fn( $Input_file ) ; -# -# Expand wildcards and process all groupfiles. We enter into some -# ugly processing here, because I cannot rely on all architectures -# being able to handle arbitrary long environment variables (though -# both Sun and HP get pretty far!). Therefore I only expand the -# first groupfile, and put any remaining groupfiles back on the list. -# This should give no delay in the processing, but limits the number -# of items present in $Files at any given time. -# - $nonomatch='' ; - if ( &ft('e', $Tmpfile ) ) { &rm( "-f" , &fn( $Tmpfile ) ) ; - } - for $grpfile__x (split(' ',join(' ' , &fn( $Input_file ) ))) { - $grpfile=$grpfile__x ; - if ( &ft('e', $grpfile ) ) { - if ( ! &ft('e', $Tmpfile ) ) { - if ( &eq( &fp('h', $grpfile ) , $grpfile ) ) { $grpfile= - &fn( "./" . $grpfile ) ; } - &echo( '' , " " , "" ) ; - &echo( '' , "======= Expanding groupfile " . $grpfile - ." =======" , "" ) ; - &doexe( &fn( $n_exe ."/genaid.exe" ) , "expand" .' '. - &fn( "-t:" . $_Types ) .' '. &fn( $grpfile ) , ''. - &fn( $Tmpfile ) ) ; - } - else { - $Files= '@' . $grpfile .' '. &fn( $Files ) ; - } - } - else { - &echo( '' , "Error: cannot find groupfile " . $grpfile , - "" ) ; - } - } - undef $nonomatch ; undef $grpfile ; - if ( &ft('e', $Tmpfile ) ) { - if ( ! &ft('z', $Tmpfile ) ) { $Files= &Pipe("p$$.tmp00", - &cat( '' , &fn( $Tmpfile ) , "p$$.tmp00" ) ) - .' '. &fn( $Files ) ; } - &rm( "-f" , &fn( $Tmpfile ) ) ; - } -# -# It's an ordinary file, pass to the compiler or other command: -# - } - else { -# -# -# Compile the file(s) after wildcard expansion etc. -# -# Although I cannot really advise it, a user can give -Obj:mylib to -# move objects into his favourite private library. This is taken care of -# by the lines which refer to $_Objectlib and $_Objectlist. -# -# - if ( &peq( $Command , "[Bb]*" ) ) { - if ( !&eq( $_Objectlib , '' ) ) { - if ( !&peq( $_Objectlib , $n_ulib ."/*lib.olb" ) ) { - $_Objectlib= &fn( $n_ulib ."/" . $_Objectlib - ."lib.olb" ) ; } - if ( &ft('e', $n_work ."/" . &fp('t', $_Objectlib ) - .".list" ) ) { - &rm( "-f" , &fn( $n_work ."/" . &fp('t', $_Objectlib ) - .".list" ) ) ; - } - $Input_file= &fn( $Input_file ) .' '. &fn( $_Objectlib ) - ; - } - if ( !&eq( $_Textlib , '' ) ) { - if ( !&peq( $_Textlib , $n_ulib ."/*lib.olb" ) ) { - $_Textlib= &fn( $n_ulib ."/" . $_Textlib - ."lib.olb" ) ; } - if ( &ft('e', $n_work ."/" . &fp('t', $_Textlib ) .".list" - ) ) { - &rm( "-f" , &fn( $n_work ."/" . &fp('t', $_Textlib ) - .".list" ) ) ; - } - $Input_file= &fn( $Input_file ) .' '. &fn( $_Textlib ) ; - } - &source( &fn( $n_src ."/sys/compile.csh" ) ) ; - if ( defined($Abort_flag) ) { &Abort_exit_shadow ; } -# -# -# Checkout: copy the file(s) from the master tree to a user directory -# - } - elsif ( &peq( $Command , "[Cc]*[Oo][Uu][Tt]" ) || &peq( - $Command , "[Oo]*" ) ) { - if ( $_Select ) { - for $File__x (split(' ',join(' ' , &fn( $Input_file ) - ))) { $File=$File__x ; -# -# Locate the file in the master source tree -# - &echo( '' , " " , "" ) ; - undef $Source ; undef $Target ; -# -# If the file exists, give it an absolute path -# -# if (-e $File) then -# set Home=$cwd; -# if ($File:h != $File) cd $File:h -# set File=$cwd/$File:t -# cd $Home; -# unset Home -# endif -# - $nonomatch='' ; -# -# File was specified with respect to the top of the Master source tree, -# and we are in the top of our private tree. Checkin to the corresponding -# directory in our own tree. -# - if ( &eq( $cwd , $n_usrc ) && &ft('e', $n_src ."/" . - $File ) ) { - $Source= &fn( $File ) ; - $Target= &fn( "./" . $File ) ; -# -# Idem, but not at top of our own source tree, checkin to current directory -# - } - elsif ( &ft('e', $n_src ."/" . $File ) ) { - $Source= &fn( $File ) ; - $Target= &fn( "./" . &fp('t', $File ) ) ; -# -# File was specified with respect to subdirectory of Master source tree, -# and we are in the corresponding subdir of our private tree. Checkin -# to that directory. -# - } - elsif ( &eq( &fp('h', $cwd ) , $n_usrc ) && &ft('e', - $n_src ."/" . &fp('t', $cwd ) ."/" . $File ) ) { - $Source= &fn( &fp('t', $cwd ) ."/" . $File ) ; - $Target= &fn( "./" . $File ) ; -# -# Just a filename was given, and such a file exists in a subdirectory -# of the master. Since we are not in our private source tree (would have -# been catched earlier) we check in to current directory. -# - } - elsif ( &eq( &fp('t', $File ) , $File ) && &ft('e', - $n_src ."/*/" . $File ) ) { - $Source= &fn( $n_src ."/*/" . $File ) ; - $Source= &Pipe("p$$.tmp00", &echo( '' , &fn( - (split(' ',$Source)) [ 1 -1 ] ) , "p$$.tmp01" ) , - &sed( "-e" , "s%^" . $n_src ."/%%" , "p$$.tmp01" , - "p$$.tmp00" ) ) ; - $Target= &fn( "./" . $File ) ; -# -# File was completely specified. If stripping n_src makes any difference, -# the file is in the Master source tree. If not, the file exists -# somewhere outside the tree, and we are not interested. -# -# If we are somewhere in our own private tree, checkin to the correct -# subdirectory of that tree. Otherwise, checkin to the current dir. -# - } - elsif ( &ft('e', $File ) ) { - $Source= &Pipe("p$$.tmp00", &echo( '' , &fn( $File ) - , "p$$.tmp01" ) , &sed( "-e" , "s%^" . $n_src - ."/%%" , "p$$.tmp01" , "p$$.tmp00" ) ) ; - if ( !&eq( $Source , $File ) ) { - if ( &eq( $cwd , $n_usrc ) || &eq( &fp('h', $cwd ) , - $n_usrc ) ) { - $Target= &fn( $n_usrc ."/" . $Source ) ; - } - else { - $Target= &fn( "./" . &fp('t', $File ) ) ; - } - } - else { - undef $Source ; - &echo( '' , "Warning: File " . $File - ." is not in the Master tree" , "" ) ; - } -# -# If anything else fails, try to locate it in a tlb, this only works -# if we are in a subdirectory of the Master. -# - } - elsif ( &eq( &fp('h', $cwd ) , $n_src ) && &ft('e', - $n_src ."/" . &fp('t', $cwd ) ."lib.tlb" ) ) { - &ar( "xv" , &fn( $n_src ."/" . &fp('h', $cwd ) - ."lib.tlb" ) .' '. &fn( &fp('t', $File ) ) , "" ) - ; - &echo( '' , &fp('t', $File ) ." extracted from tlb" - , "" ) ; -# -# Although it seems unlikely regarding our previous effords, -# we still may not be able to locate the file... -# - } - else { - &echo( '' , "Error: Cannot locate " . $File , "" ) ; - } - undef $nonomatch ; -# -# If located, remove any existing links, copy and lock the file -# - if ( defined($Source) ) { - if ( &ft('e', $Target ) ) { - if ( &peq( &Pipe("p$$.tmp00", &ls( "-F" , &fn( - $Target ) , "p$$.tmp00" ) ) , "*@" ) ) { - &rm( "-f" , &fn( $Target ) ) ; - } - else { - $Flag= &Pipe("p$$.tmp00", &cmp( &fn( $n_src ."/" - . $Source ) .' '. &fn( $Target ) , "p$$.tmp00" - ) ) ; - if ( !&eq( $Flag , '' ) ) { - &echo( '' , "File " . $Target - ." already exists..." , "" ) ; - &diff( "-b" , &fn( $n_src ."/" . $Source ) - .' '. &fn( $Target ) , "" ) ; - &echo( "-n" , "Remove " , "" ) ; &rm( "-i" , - &fn( $Target ) ) ; - } - else { - &rm( "-f" , &fn( $Target ) ) ; - } - } - } - if ( ! &ft('e', $Target ) ) { - &echo( '' , 'checkout: $n_src/' . $Source ." --> " - . $Target , "" ) ; - &cp( '' , &fn( $n_src ."/" . $Source ) .' '. &fn( - $Target ) ) ; - } - if ( &ft('e', $n_src ."/sys/lock.idx" ) ) { - $Lock= &Pipe("p$$.tmp00", &grep( '' , &fn( $Source - ) , &fn( $n_src ."/sys/lock.idx" ) , - "p$$.tmp00" ) ) ; - if ( !&eq( $Lock , '' ) ) { - &echo( '' , "Warning: " . $Lock , "" ) ; - } - else { - &echo( '' , $Source ." locked User=" . $USER - ." Date=" . $C_Date ."/" . $C_Time , - "p$$.tmp00" ) ; &tee( "-a" , &fn( $n_src - ."/sys/lock.idx" ) , "p$$.tmp00" ) ; - } - undef $Lock ; - } - } - undef $Target ; undef $Source ; - } - } - else { - &echo( '' , "You should not checkout " . $Input_file - ." on " . $n_arch , "" ) ; - } -# -# -# Unlock files from usersystem -# - } - elsif ( &peq( $Command , "[Uu]*" ) ) { - $Home= &fn( $cwd ) ; - for $File__x (split(' ',join(' ' , &fn( $Input_file ) ))) { - $File=$File__x ; -# -# If we are somewhere in our private source tree, we can match the -# file with respect to the Master source tree, otherwise we just match -# the name. This removes locks to ALL matching files. In practice, there -# will be no files with identical names, and it is even less likely that -# a user will lock out multiple files with the same name, and if so -# it is not unreasonable to require him to work in a shadow tree... -# - if ( !&eq( &fp('h', $File ) , $File ) ) { &cd( &fn( - &fp('h', $File ) ) ) ; } - $Full= &fn( $cwd ."/" . &fp('t', $File ) ) ; - &cd( &fn( $Home ) ) ; -# -# If in shadow tree, replace existing file with a link -# (if not already a link!), otherwise delete it. -# - if ( &ft('e', $Full ) && !&peq( $Full , $n_src ."/*" ) ) { - if ( !&peq( &Pipe("p$$.tmp00", &ls( "-F" , &fn( $Full - ) , "p$$.tmp00" ) ) , "*@" ) ) { - $nonomatch='' ; - if ( &ft('e', $n_src ."/*/" . &fp('t', $Full ) ) ) { - $Flag= &Pipe("p$$.tmp00", &cmp( &fn( $Full ) .' '. - &fn( $n_src ."/*/" . &fp('t', $Full ) ) , - "p$$.tmp00" ) ) ; - if ( !&eq( $Flag , '' ) ) { - &diff( "-b" , &fn( $Full ) .' '. &fn( $n_src - ."/*/" . &fp('t', $Full ) ) , "" ) ; - &echo( "-n" , "Remove " , "" ) ; &rm( "-i" , - &fn( $Full ) ) ; - } - else { - &rm( "-f" , &fn( $Full ) ) ; - } - } - else { - &echo( "-n" , "Remove " , "" ) ; &rm( "-i" , &fn( - $Full ) ) ; - } - undef $nonomatch ; - if ( &ft('e', $Full ) ) { - &echo( '' , "***** Warning: " . $Full - ." not deleted..." , "" ) ; - } - elsif ( &peq( $Full , $n_usrc ."/*" ) ) { - &ln( "-s" , &fn( $n_src ."/" . $File ) .' '. &fn( - $Full ) ) ; - &echo( '' , "File " . $File - ." replaced by soft link" , "" ) ; - } - else { - &echo( '' , "File " . $Full ." has been deleted" , - "" ) ; - } - } - } -# -# Remove lock if file previously locked by this user -# -# Owner of Newstar master source tree can unlock any file -# - if ( &ft('e', $n_src ."/sys/lock.idx" ) ) { - $File= &Pipe("p$$.tmp00", &echo( '' , &fn( $Full ) , - "p$$.tmp01" ) , &sed( "-e" , "s%^" . $n_usrc - ."/%%" , "p$$.tmp01" , "p$$.tmp00" ) ) ; - if ( &eq( $File , $Full ) ) { $File= &fn( "/" . &fp('t', - $File ) ) ; } - $Lock= &Pipe("p$$.tmp00", &grep( '' , &fn( $File ) , - &fn( $n_src ."/sys/lock.idx" ) , "p$$.tmp00" ) ) ; - if ( !&eq( $Lock , '' ) ) { - if ( &peq( $Lock , "*User=" . $USER ."*" ) || - &ft('o', $n_src ) ) { - &cp( '' , &fn( $n_src ."/sys/lock.idx" ) .' '. &fn( - $n_work ."/lock.old" ) ) ; - &grep( "-v" , &fn( $File ) , &fn( $n_work - ."/lock.old" ) , ''. &fn( $n_src - ."/sys/lock.idx" ) ) ; - &echo( '' , "Removed: " . $Lock , "" ) ; - } - else { - &echo( '' , "Warning: " . $Lock , "" ) ; - } - } - else { - &echo( '' , &fp('t', $File ) ." was not locked" , "" - ) ; - } - undef $Lock ; - } - else { - &echo( '' , "No locking database" , "" ) ; - } - } - undef $Home ; -# -# -# Checkin: write filename to groupfile -# - } - elsif ( &peq( $Command , "[Cc]*[Ii][Nn]" ) || &peq( - $Command , "[Ii]*" ) ) { - $Home= &fn( $cwd ) ; - for $File__x (split(' ',join(' ' , &fn( $Input_file ) ))) { - $File=$File__x ; -# -# Give the file a full path and make it relative to current dir -# - if ( !&eq( &fp('h', $File ) , $File ) ) { &cd( &fn( - &fp('h', $File ) ) ) ; } - $Full= &fn( $cwd ."/" . &fp('t', $File ) ) ; - $File= &Pipe("p$$.tmp00", &echo( '' , &fn( $Full ) , - "p$$.tmp01" ) , &sed( "-e" , "s%^" . $Home ."/%%" - , "p$$.tmp01" , "p$$.tmp00" ) ) ; - &cd( &fn( $Home ) ) ; -# -# The file should exist and root in current dir -# - if ( &eq( &fp('e', $Full ) , "exe" ) ) { - &echo( '' , "Warning: " . &fp('t', $Full ) - ." ignored, specify exe-files later" , "" ) ; - } - elsif ( ! &ft('e', $Full ) ) { - &echo( '' , "Error: " . $Full ." does not exist..." , - "" ) ; - } - elsif ( &eq( $File , $Full ) && !&peq( $File , $n_src - ."/*" ) ) { - &echo( '' , - "Error: File should root in current directory" , "" - ) ; - } - else { -# -# It's there all right, put it in the groupfile -# - &echo( '' , "Calculating checksum for " . $File ." " , - "" ) ; - &doexe( &fn( $n_exe ."/genaid.exe" ) , "fstat" .' '. - &fn( "-t:" . $_Types ) .' '. &fn( "+" . $Target ) - .' '. &fn( $File ) , '>'. &fn( $Outfile ) ) ; - } - } - } # End of if (command) - if ( !&eq( $Save_switch , '' ) ) { # Restore switches - &set($Save_switch) ; } - } # End of if (groupfile) - } # End of while (Files left) - } # End of while (Files left) -# -# For build, report the total number of errors -# - if ( &peq( $Command , "[Bb]*" ) ) { - if ( &eq( $Errors , 0 ) ) { - &echo( '' , "Congratulations: no errors occurred" , "" ) ; - } - else { - &echo( '' , "Total number of errors: " . $Errors ." " , "" ) ; - } -# -# For checkin, we may want to move all files to $n_import -# - } - elsif ( &peq( $Command , "[Cc]*[Ii][Nn]" ) || &peq( $Command , - "[Ii]*" ) ) { -# -# Append a list of executables -# - &echo( '' , 'Possible shorthands: @all, @n[ewstar], @d[wa' - .'rf], @a[bp]' , "" ) ; - &echo( "-n" , "Enter any executables to be rebuilt (default" - ." extension .exe): " , "" ) ; - $Flag= ($_=scalar(<STDIN>), chop, $_) ; - if ( !&eq( $Flag , '' ) ) { - &echo( '' , "! " , '>'. &fn( $Outfile ) ) ; - &echo( '' , "! Executables " , '>'. &fn( $Outfile ) ) ; - &echo( '' , "! " , '>'. &fn( $Outfile ) ) ; - $Flag= &fn( $Flag ) ; - for $File__x (split(' ',join(' ' , &fn( $Flag ) ))) { - $File=$File__x ; - $File= &fn( &fp('t', $File ) ) ; - if ( &peq( $File , "@[Aa][Ll][Ll]" ) ) { - &grep( "-h" , '^[^ ]*\.[Ee][Xx][Ee]' , &fn( $n_src - ."/*/*.grp" ) , '>'. &fn( $Outfile ) ) ; - } - elsif ( &peq( $File , "@[Aa]*" ) ) { - &grep( "-h" , '^[^ ]*\.[Ee][Xx][Ee]' , &fn( $n_src - ."/dwarf/abp.grp" ) , '>'. &fn( $Outfile ) ) ; - } - elsif ( &peq( $File , "@[Dd]*" ) ) { - &grep( "-h" , '^[^ ]*\.[Ee][Xx][Ee]' , &fn( $n_src - ."/dwarf/sys.grp" ) , '>'. &fn( $Outfile ) ) ; - } - elsif ( &peq( $File , "@[Nn]*" ) ) { - &grep( "-h" , '^[Nn][^ ]*\.[Ee][Xx][Ee]' , &fn( $n_src - ."/n*/*.grp" ) , '>'. &fn( $Outfile ) ) ; - } - else { - if ( !&eq( &fp('e', $File ) , "exe" ) ) { $File= &fn( - &fp('r', $File ) .".exe" ) ; } - &echo( '' , $File , '>'. &fn( $Outfile ) ) ; - } - } - } -# -# Edit the file? -# - &echo( '' , "! End of groupfile " . $Outfile , '>'. &fn( - $Outfile ) ) ; - &echo( '' , '' , "" ) ; - &cat( '' , &fn( $Outfile ) , "" ) ; - &echo( '' , '' , "" ) ; - &echo( "-n" , "Do you want to edit the groupfile (y,n)? [n]" ." " - , "" ) ; - $Flag= ($_=scalar(<STDIN>), chop, $_) ; - if ( &peq( $Flag , "[Yy]*" ) ) { - if ( defined($EDITOR) ) { - &dollar("EDITOR" , &fn( $Outfile ) , "" ) ; - } - else { - &doalias('emacs' , &fn( $Outfile ) ) ; - } - } -# -# Decide wether or not to copy the files -# - &echo( '' , '' , "" ) ; - &echo( "-n" , "Move files to " ."\$n_import" . " (y,n)? [y] " , - "" ) ; - $Flag= ($_=scalar(<STDIN>), chop, $_) ; - if ( !&peq( $Flag , "[Nn]*" ) ) { - &doexe( &fn( $n_exe ."/genaid.exe" ) , "files" .' '. "-t:^exe" - .' '. &fn( $Outfile ) , ''. &fn( $Tmpfile ) ) ; -# -# Before we copy the files, first check if any of them had -# been locked by someone else. If so, ask Newstar manager to get the -# files himself, since installation may be not so trivial. -# - &echo( '' , '' , "" ) ; - &echo( '' , "Checking locks..." , "" ) ; - $Flag= "ok" ; - if ( &ft('e', $n_src ."/sys/lock.idx" ) ) { - for $file__x (split(' ',join(' ' , &Pipe("p$$.tmp00", &cat( '' - , &fn( $Tmpfile ) , "p$$.tmp00" ) ) ))) { - $file=$file__x ; - $Lock= &Pipe("p$$.tmp00", &grep( '' , &fn( $file ) , &fn( - $n_src ."/sys/lock.idx" ) , "p$$.tmp00" ) ) ; - if ( !&eq( $Lock , '' ) && !&peq( $Lock , "*User=" . - $USER ."*" ) ) { - &echo( '' , "Warning: " . $Lock , "" ) ; - $Flag= "lock" ; - } - undef $Lock ; - } - } - if ( &eq( $Flag , "lock" ) ) { - sub C2_t4_shadow { - local(*TMP); - open(TMP,">txt$$.tmp"); - print TMP '' ."\n" ; - print TMP "Found files that were locked by other users," - ." so you cannot move your files" ."\n" ; - print TMP "to \$n_import. Please contact your local New" - ."star manager..." ."\n" ; - print TMP '' ."\n" ; - close(TMP); - "txt$$.tmp";} - &cat( '' , &C2_t4_shadow , "" ) ; - } - else { -# -# Copy the files to n_import (sed returns the filename w.r.t. $cwd) -# - for $file__x (split(' ',join(' ' , &Pipe("p$$.tmp00", &cat( '' - , &fn( $Tmpfile ) , "p$$.tmp01" ) , &sed( "-e" , - "s%^" . $Target ."%%" , "p$$.tmp01" , "p$$.tmp00" ) - ) ))) { $file=$file__x ; - &echo( '' , "cp " . $file ." " . $n_import , "" ) ; - &cp( '' , &fn( "./" . $file ) .' '. &fn( $n_import ) ) ; - &chmod( "a+rw" , &fn( $n_import ."/" . &fp('t', $file ) ) ) - ; - if ( &eq( &fp('e', $file ) , "csh" ) ) { &chmod( "a+x" , - &fn( $n_import ."/" . &fp('t', $file ) ) ) ; } - } - &echo( '' , "cp " . $Outfile ." " . $n_import , "" ) ; - &cp( '' , &fn( $Outfile ) .' '. &fn( $n_import ) ) ; - &chmod( "a+rw" , &fn( $n_import ."/" . &fp('t', $Outfile ) ) - ) ; -# -# Notify Newstar account -# - &echo( '' , "Notification will be sent to " . $USER ." and " - . $n_master , "" ) ; - &cat( '' , &fn( $Outfile ) , "p$$.tmp00" ) ; &elm( "-s" , - "Checkin by " . $USER .' '. &fn( $n_master ) .' '. - &fn( $USER ) , "p$$.tmp00" ) ; -# -# Remove old locks, make lock for Newstar manager -# - &echo( '' , '' , "" ) ; - &echo( '' , "Making new locks..." , "" ) ; - if ( &ft('e', $n_src ."/sys/lock.idx" ) ) { - for $file__x (split(' ',join(' ' , &Pipe("p$$.tmp00", &cat( - '' , &fn( $Tmpfile ) , "p$$.tmp00" ) ) ))) { - $file=$file__x ; - $Lock= &Pipe("p$$.tmp00", &grep( '' , &fn( $file ) , - &fn( $n_src ."/sys/lock.idx" ) , "p$$.tmp00" ) ) ; - if ( !&eq( $Lock , '' ) ) { - &cp( '' , &fn( $n_src ."/sys/lock.idx" ) .' '. &fn( - $n_work ."/lock.old" ) ) ; - &grep( "-v" , &fn( $file ) , &fn( $n_work ."/lock.old" - ) , ''. &fn( $n_src ."/sys/lock.idx" ) ) ; - &echo( '' , "Removed: " . $Lock , "" ) ; - } - &echo( '' , $file ." locked User=Newstar Date=" . - $C_Date ."/" . $C_Time , "p$$.tmp00" ) ; &tee( "-a" - , &fn( $n_src ."/sys/lock.idx" ) , "p$$.tmp00" ) - ; - } - } - } - &rm( "-f" , &fn( $Tmpfile ) ) ; - } - } -# -# -# %Link command: -# - } - elsif ( &peq( $Command , "[Ll]*" ) ) { -# -# Setup suboption: create shadow directories, update links in n_uinc -# - if ( &peq( (split(' ',$Files)) [ 1 -1 ] , "[Ss][Ee][Tt]*" ) ) { - if ( defined($n_uroot) ) { - if ( ! &ft('d', $n_uroot ) ) { - &echo( '' , "Creating " . $n_uroot , "" ) ; - &mkdir( &fn( $n_uroot ) ) ; - } - } - if ( defined($n_usrc) ) { - if ( ! &ft('d', $n_usrc ) && !&eq( $n_usrc , "__undefined__" ) - ) { - &echo( '' , "Creating " . $n_usrc , "" ) ; - &mkdir( &fn( $n_usrc ) ) ; - } - } - if ( defined($n_uinc) ) { - if ( ! &ft('d', $n_uinc ) ) { - $dir= &fn( $n_uinc ) ; - $dir= &fn( &fp('h', $dir ) ) ; - if ( ! &ft('d', $dir ) ) { - &echo( '' , "Creating " . $dir , "" ) ; - &mkdir( &fn( $dir ) ) ; - } - &echo( '' , "Creating " . $n_uinc , "" ) ; - &mkdir( &fn( $n_uinc ) ) ; - } - } - if ( defined($n_ulib) ) { - if ( ! &ft('d', $n_ulib ) ) { - $dir= &fn( $n_ulib ) ; - $dir= &fn( &fp('h', $dir ) ) ; - if ( ! &ft('d', $dir ) ) { - &echo( '' , "Creating " . $dir , "" ) ; - &mkdir( &fn( $dir ) ) ; - } - &echo( '' , "Creating " . $n_ulib , "" ) ; - &mkdir( &fn( $n_ulib ) ) ; - } - } - if ( defined($n_uexe) ) { - if ( ! &ft('d', $n_uexe ) ) { - $dir= &fn( $n_uexe ) ; - $dir= &fn( &fp('h', $dir ) ) ; - if ( ! &ft('d', $dir ) ) { - &echo( '' , "Creating " . $dir , "" ) ; - &mkdir( &fn( $dir ) ) ; - } - &echo( '' , "Creating " . $n_uexe , "" ) ; - &mkdir( &fn( $n_uexe ) ) ; - } - } - if ( defined($n_work) ) { - if ( ! &ft('d', $n_work ) ) { - $dir= &fn( $n_work ) ; - $dir= &fn( &fp('h', $dir ) ) ; - if ( ! &ft('d', $dir ) ) { - &echo( '' , "Creating " . $dir , "" ) ; - &mkdir( &fn( $dir ) ) ; - } - &echo( '' , "Creating " . $n_work , "" ) ; - &mkdir( &fn( $n_work ) ) ; - } - } - &echo( "-n" , "Update links in " ."\$n_uinc" . " (y,n)? [y] " , - "" ) ; - $ans= ($_=scalar(<STDIN>), chop, $_) ; - if ( !&peq( $ans , "[Nn]*" ) ) { - &ln( "-s" , &fn( $n_inc ."/*" ) .' '. &fn( $n_uinc ) ) ; - } - } - elsif ( &eq( $n_usrc , "__undefined__" ) ) { - &echo( '' , "You should have defined " . $n_usrc - ." before you can link\!" , "" ) ; - &echo( '' , "Please read " . $n_src - ."/sys/newstar_init.csh for information..." , "" ) - ; - } - elsif ( !&eq( $cwd , $n_usrc ) && !&eq( &fp('h', $cwd ) , $n_usrc ) - ) { - &echo( '' , "First change directory to " ."\$n_usrc" . - " or a subdirectory thereof..." , "" ) ; - } - elsif ( !&eq( $cwd , $n_usrc ) && ! &ft('d', $n_src ."/" . &fp('t', - $cwd ) ) ) { - &echo( '' , &fp('t', $cwd ) - ." is not a (linkable) Newstar directory" , "" ) ; - } - else { - if ( !&eq( $Files , '' ) ) { - $dir= &fn( $Files ) ; - &cd( &fn( $n_usrc ) ) ; - &echo( '' , "Now in " . $n_usrc , "" ) ; - } - elsif ( &eq( $cwd , $n_usrc ) ) { - $dir= &fn( $NSTAR_DIR ) ; - } - else { - $dir= &fn( &fp('t', $cwd ) ) ; - } - &echo( '' , "Making links for directories " . $dir ." to " . $cwd - , "" ) ; -# -# Find all groupfiles (should be *.grp, but we still have nscanyymmdd.grp's) -# - for $subdir__x (split(' ',join(' ' , &fn( $dir ) ))) { - $subdir=$subdir__x ; - &echo( '' , "======= Working on " . $n_src ."/" . $subdir - ." ========" , "" ) ; - for $grpfile__x (split(' ',join(' ' , &fn( $n_src ."/" . $subdir - ."/???.grp" ) ))) { $grpfile=$grpfile__x ; - &echo( '' , "======= Making links for groupfile " . &fp('t', - $grpfile ) ." =======" , "" ) ; - if ( ! &ft('e', $n_usrc ."/" . $subdir ) ) { - &mkdir( &fn( $n_usrc ."/" . $subdir ) ) ; - &echo( '' , "Made subdirectory " . $subdir , "" ) ; - } -# -# Take all the efford of redirection and `cat` to avoid "long words" and -# errors due to pipes within ` ` (the latter should be no problem, but -# we should not press our luck to the edges...) -# - &doexe( &fn( $n_exe ."/genaid.exe" ) , "files" .' '. - "-t:^exe" .' '. &fn( $grpfile ) , ''. &fn( - $Tmpfile ) ) ; - for $file__x (split(' ',join(' ' , &Pipe("p$$.tmp00", &cat( '' - , &fn( $Tmpfile ) , "p$$.tmp00" ) ) ))) { - $file=$file__x ; - $file= &Pipe("p$$.tmp00", &echo( '' , &fn( $file ) , - "p$$.tmp01" ) , &sed( "-e" , &fn( "s@" . $n_src - ."/@@" ) , "p$$.tmp01" , "p$$.tmp00" ) ) ; - if ( ! &ft('e', $n_src ."/" . $file ) ) { - &echo( '' , "File " . $file - ." does not exist in Master ...." , "" ) ; - } - else { -# -# Silently remove existing links, skip existing files since user -# should explicitly unlock them. -# - if ( &ft('e', $n_usrc ."/" . $file ) ) { - if ( &peq( &Pipe("p$$.tmp00", &ls( "-F" , &fn( - $n_usrc ."/" . $file ) , "p$$.tmp00" ) ) , "*@" ) - ) { - &rm( "-f" , &fn( $n_usrc ."/" . $file ) ) ; - } - else { - &echo( '' , "File " . $file - ." exists, not overwritten" , "" ) ; - } - } - if ( !&eq( &fp('h', $file ) , '' ) && ! &ft('d', - &fp('h', $file ) ) ) { &mkdir( &fn( &fp('h', - $file ) ) ) ; } - if ( ! &ft('e', $n_usrc ."/" . $file ) ) { - &ln( "-s" , &fn( $n_src ."/" . $file ) .' '. &fn( - $n_usrc ."/" . $file ) ) ; - &echo( '' , "Linked " . $file , "" ) ; - } - } - } - &rm( "-f" , &fn( $Tmpfile ) ) ; - } - } - } -# -# -# %Put: Move files into text-library -# - } - elsif ( &peq( $Command , "[Pp][Uu][Tt]" ) ) { -# -# Get names of groupfiles -# - if ( &eq( $Files , '' ) ) { - &echo( "-n" , "Enter name of groupfile(s): " , "" ) ; - $noglob='' ; # Don't expand wildcards right now - $Files= ($_=scalar(<STDIN>), chop, $_) ; # Read from stdin - $Files= &fn( $Files ) ; # Split in multiple words - undef $noglob ; - } -# -# Expand them and update text-libraries -# - for $grpfile__x (split(' ',join(' ' , &fn( $Files ) ))) { - $grpfile=$grpfile__x ; - if ( &eq( &fp('e', $grpfile ) , '' ) ) { $grpfile= &fn( - $grpfile .".grp" ) ; } - if ( ! &ft('e', $grpfile ) ) { - &echo( '' , "Groupfile " . $grpfile ." does not exist..." , "" - ) ; - } - else { - $archive= &fn( &fp('r', $grpfile ) .".tlb" ) ; - &echo( '' , "Updating text-library " . $archive , "" ) ; - &doexe( &fn( $n_exe ."/genaid.exe" ) , "files" .' '. "-t:^exe" - .' '. &fn( $grpfile ) , ''. &fn( $Tmpfile ) ) ; - &ar( "rv" , &fn( $archive ) .' '. &Pipe("p$$.tmp00", &cat( '' - , &fn( $Tmpfile ) , "p$$.tmp00" ) ) , "" ) ; - &rm( "-f" , &fn( $Tmpfile ) ) ; - } - } - undef $archive ; undef $grpfile ; -# -# %Get: Get files from text-library -# - } - elsif ( &peq( $Command , "[Gg][Ee][Tt]" ) ) { -# -# Get names of groupfiles -# - if ( &eq( $Files , '' ) ) { - &echo( "-n" , "Enter name of groupfile(s): " , "" ) ; - $noglob='' ; # Don't expand wildcards right now - $Files= ($_=scalar(<STDIN>), chop, $_) ; # Read from stdin - $Files= &fn( $Files ) ; # Split in multiple words - undef $noglob ; - } -# -# Get each groupfile if necessary, expand and extract the files -# - for $grpfile__x (split(' ',join(' ' , &fn( $Files ) ))) { - $grpfile=$grpfile__x ; - if ( &eq( &fp('e', $grpfile ) , '' ) ) { $grpfile= &fn( - $grpfile .".grp" ) ; } - $archive= &fn( &fp('r', $grpfile ) .".tlb" ) ; - if ( ! &ft('e', $archive ) ) { - &echo( '' , "Text-library " . $archive ." does not exist..." , - "" ) ; - } - else { - if ( ! &ft('e', $grpfile ) ) { - &ar( "xvo" , &fn( $archive ) .' '. &fn( $grpfile ) , "" ) ; - } - if ( ! &ft('e', $grpfile ) ) { - &echo( '' , "Groupfile " . $grpfile - ." does not exist in library" , "" ) ; - } - else { - &echo( '' , "Extracting from text-library " . $archive , "" ) - ; - &doexe( &fn( $n_exe ."/genaid.exe" ) , "files" .' '. - "-t:^exe" .' '. &fn( $grpfile ) , ''. &fn( - $Tmpfile ) ) ; - &ar( "xvo" , &fn( $archive ) .' '. &Pipe("p$$.tmp00", &cat( - '' , &fn( $Tmpfile ) , "p$$.tmp00" ) ) , "" ) ; - &rm( "-f" , &fn( $Tmpfile ) ) ; - } - } - } - undef $archive ; undef $grpfile ; - } # Other command - else { - &echo( '' , '' , "" ) ; - &echo( '' , "Error: Invalid or ambiguous command " . $Command , "" - ) ; - &echo( '' , '' , "" ) ; - } # End of if (Command == ...) - } # End of while (Menu mode) - &Abort_exit_shadow ; - sub Abort_exit_shadow { - ; - if ( &ft('e', $Tmpfile ) ) { &rm( "-f" , &fn( $Tmpfile ) ) ; } -# -#+ Postamble -# -# -# Finish main routine -# - &exit('');} - &exit('');} -# -# Call main routine -# -eval('&shadow__pls'); -1; -#- diff --git a/src/sys/signal_and_sync.c b/src/sys/signal_and_sync.c deleted file mode 100644 index ba1548ddfc327038ad4f1d889cd89eb189cc813f..0000000000000000000000000000000000000000 --- a/src/sys/signal_and_sync.c +++ /dev/null @@ -1,63 +0,0 @@ -/* signal_and_sync.c - -optionally send a SIGUSR1 signal to a process; -then wait for that process to respond by accessing a file. - -invocation arguments: - 1. filename - 2. number of cycles to wait - 3. if present: pid to send signal to; if absent: do not signal - -exit status: - 0: success - <0: target pid not found - >0: timeout: file not accessed after waiting for the specified - nr of seconds - - This program has been designed with the purpose of synchonising a Newstar application with xmosaic when the latter is (re)started by the former through PPDHELP. - - The two-argument invocation is used to wait for xmosaic to acces the home page after it has been started. This is used as an indication that it is (almost) ready to accept a 'goto' signal. - - The three-argument invocation is used to send the signal and then check -that xmosaic does indeed access the 'goto' command file; if it fails to, the signal can then be resent. - - -History: - JPH 941109 -*/ - -#include <signal.h> -#include <stdio.h> -#include <sys/types.h> -#include <sys/stat.h> -#include <time.h> - - -main (argc, argv) - int argc; char *argv[]; -{ - struct stat buf; - char *f; - int d, n, p; long t, tbeg; - - argv++; f=*argv++; n= atoi (*argv++); - d=0; - while (d <n){ - if (stat (f, &buf) ==-1) { - perror(f); return -1; - } else { - t= buf.st_atime; - if (! d ){ - tbeg=t; - if (argc >3 ){ - p= atoi (*argv); - sleep (1); /* allow for time quantisation */ - if (kill (p, SIGUSR1)) return -1; /* process not found */ - } - }else{ - if (t != tbeg) return 0; /* success */ - } - d++; sleep (1); - } } - return d; /* timeout */ -} diff --git a/src/sys/switches.csh b/src/sys/switches.csh deleted file mode 100755 index b7ae49cae82b97f1892ceca7542cd0547a85dcc6..0000000000000000000000000000000000000000 --- a/src/sys/switches.csh +++ /dev/null @@ -1,288 +0,0 @@ -#+ -# Switches.csh -# CMV 930526 -# -# CMV 930609 Changed to set= only, buffer switches in SW_key/SW_val -# CMV 931020 Decode options from Command -# CMV 931102 Switch -[N]Check added for dependencies -# CMV 931201 Patch for GNU tr on Decstation at ruu -# CMV 940216 Add switch -Confirm for clear -# CMV 941006 Strange problem with tr on ruu, split in two calls -# CMV 941102 Add -Import (retrieve) and -Merge (build) switches -# CMV 950116 Add -Keep option for keeping old executables and ppd-files -# -# Decode the options listed in $Command or $Options into the various -# environment variables. Command is checked only if Options is empty. -# -# Switches appearing in groupfiles override the default ones. The -# defaults are temporarily saved in Save_switch. They can be restored -# by giving: set $Save_switch (and optionally: unset Save_switch). -# -# This script is sourced by the maintenance routines. -# -#- - -#+ -#..Default settings......Switch....Default...Action if set true........... -# -if (! $?_Alternate) set _Alternate = 0 # Link with alternate logging -# _Binary # Flags binary files for ftp -if (! $?_Debug) set _Debug = 1 # Compile with debugging -if (! $?_Confirm) set _Confirm = 1 # Confirm deletions -if (! $?_Check) set _Check = 1 # Check dependencies -if (! $?_Echo) set _Echo = 0 # Set echo on -if (! $?_Errors) set _Errors = 1 # Display error logs if any -# _Help # Give list of valid options -if (! $?_Ignore) set _Ignore = 1 # Ignore softlinks -if (! $?_Import) set _Import = 0 # Retrieve files from remote import -if (! $?_Keep) set _Keep = 1 # Default keep old exe-files -if (! $?_List) set _List = 0 # Make listfiles for compiles -if (! $?_Merge) set _Merge = 1 # Merge built files in source tree -if (! $?_Objectlib) set _Objectlib = "" # Library for object code -if (! $?_Optimise) set _Optimise = 1 # Compile with optimisation -if (! $?_Print) set _Print = 0 # Print any listfile made -if (! $?_Select) set _Select = 1 # Select file for compilation -# _Retrieve # Select file for ftp retrieval -if (! $?_Softlink) set _Softlink = 0 # Process softlinks -if (! $?_Textlib) set _Textlib = "" # Optional library for text files -if (! $?_Types) set _Types = "." # List of file-types to select -if (! $?_Update) set _Update = 0 # Update files in n_exe -if (! $?_Xref) set _Xref = 0 # Include cross-ref in listings -#- - -if (! $?Valid_options) then - set Valid_options=( _Debug _Optimise _Alternate _List _Print _Errors \ - _Xref _Ignore _Import _Keep _Check _Echo \ - _Softlink _Select _Types _Update _Merge \ - _Textlib _Objectlib ) -endif - -set Save_switch="" - -# -# If options is empty, scan Command and remove any options -# -if ($#Command == 0) set Command="" -if ("$Options[1]" == "" && "$Command[1]" != "") then - set noglob - @ ii = 1 - while ( $ii <= $#Command ) - if ("$Command[$ii]" =~ -* || "$Command[$ii]" =~ +* ) then - set Options=( $Options $Command[$ii] ); - set Command[$ii]="" - endif - @ ii = $ii + 1 - end - set Command=( $Command ) - unset ii - unset noglob -endif - -# -# Still no options, forget about it all -# -if ("$Options[1]" == "") exit - -# -# Local options: temporarily save the original ones -# -if ( "$Options[1]" == "local" ) then - if ( $#Options > 1 ) then - shift Options - else - exit - endif - alias switch 'set Save_switch=($Save_switch \!:1 = $\!:1); set \!:1 = \!:2' -else - alias switch 'set \!:1 = \!:2' -endif - -# -# Patch for GNU tr in ruu (GNU has no way to handle the dash) -# -if (-e /usr/bin/tr ) alias tr /usr/bin/tr - -set Options=( `echo $Options | tr -s '\-' ' ' | tr -s '+, ' ' '` ) - -foreach option ( $Options ) - - if ("$option" =~ [Hh]*) then - if ($option == $Options[1]) then - cat <<'_EOD_' -#+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++# - - The syntax for options is generally: -Alternat,NList-Select - A list of options should start with + or -, options can be - separated by plus (+), minus (-) comma (,) or space ( ). - The option name can be abbreviated to a single letter. - If an option is to be negated (No List), it should be prefixed - with an N. Options are case insensitive. - - Select is a special case for use in groupfiles: - special_file -S:hp # Compiled on hp only - - Types is a special case to limit the files to be selected by their - type (extension), extensions are separated by slashes, the dot is - a wildcard, $ sign marks end of string (used to make exact match in - stead of minimal match), starting with ^ causes that type to be ignored. - - shadow compile -T:inc/pef @*.grp # Compile include files only - shadow compile -T:f @*.grp # Compile all sorts of fortran files - shadow compile -T:c.. @*.grp # Compile *.c?? but not *.c - shadow checkout -T:^. # Checkout nothing at all - shadow checkout -T:. # Checkout any type (default) - - You may also give -T:none, which is the same as -T:^. and can be useful - if you want to move files in the master without compiling. - - If -H is given as the first switch, this information will be generated. - If -H is given somewhere else, only the current setting will be shown. -#----------------------------------------------------------------------------# -'_EOD_' - endif - - log "Current switch settings are: " - foreach opt ( $Valid_options ) - log ` set | grep "^$opt" ` - end - unset opt - if ("$Save_switch" != "") then - log " " - log "Saved global settings: $Save_switch" - endif - log " " - - else if ("$option" =~ [Nn][Tt][Ee][Xx]*) then - switch _Textlib "" - else if ("$option" =~ [Tt][Ee][Xx]*) then - set opt=`echo $option | tr ':' ' '` - if ($#opt < 2 ) set opt=( x . ) - switch _Textlib $opt[2] - - else if ("$option" =~ [Nn][Oo][Bb][Jj]*) then - switch _Objlib "" - else if ("$option" =~ [Oo][Bb][Jj]*) then - set opt=`echo $option | tr ':' ' '` - if ($#opt < 2 ) set opt=( x . ) - switch _Objectlib $opt[2] - - else if ("$option" =~ [Bb]* || "$option" =~ [Nn][Bb]*) then - # Ignore, only used for ftp - else if ("$option" =~ [Rr]* || "$option" =~ [Nn][Rr]*) then - # Ignore, only used for ftp - - else if ("$option" =~ [Dd]*) then - switch _Debug 1 - else if ("$option" =~ [Nn][Dd]*) then - switch _Debug 0 - - else if ("$option" =~ [Cc][Oo]*) then - switch _Confirm 1 - else if ("$option" =~ [Nn][Cc][Oo]*) then - switch _Confirm 0 - else if ("$option" =~ [Cc]*) then - switch _Check 1 - else if ("$option" =~ [Nn][Cc]*) then - switch _Check 0 - - else if ("$option" =~ [Oo]*) then - switch _Optimise 1 - else if ("$option" =~ [Nn][Oo]*) then - switch _Optimise 0 - - else if ("$option" =~ [Aa]*) then - switch _Alternate 1 - else if ("$option" =~ [Nn][Aa]*) then - switch _Alternate 0 - - else if ("$option" =~ [Kk]*) then - switch _Keep 1 - else if ("$option" =~ [Nn][Kk]*) then - switch _Keep 0 - - else if ("$option" =~ [Ll]*) then - switch _List 1 - else if ("$option" =~ [Nn][Ll]*) then - switch _List 0 - - else if ("$option" =~ [Mm]*) then - switch _Merge 1 - else if ("$option" =~ [Nn][Mm]*) then - switch _Merge 0 - - else if ("$option" =~ [Pp]*) then - switch _Print 1 - else if ("$option" =~ [Nn][Pp]*) then - switch _Print 0 - - else if ("$option" =~ [Ee][Rr]*) then - switch _Errors 1 - else if ("$option" =~ [Nn][Ee][Rr]*) then - switch _Errors 0 - - else if ("$option" =~ [Ee][Cc]*) then - switch _Echo 1 - else if ("$option" =~ [Nn][Ee][Cc]*) then - switch _Echo 0 - - else if ("$option" =~ [Pp]*) then - switch _Print 1 - else if ("$option" =~ [Nn][Pp]*) then - switch _Print 0 - - else if ("$option" =~ [Xx]*) then - switch _Xref 1 - else if ("$option" =~ [Nn][Xx]*) then - switch _Xref 0 - - else if ("$option" =~ [Ii][Gg]*) then - switch _Ignore 1 - else if ("$option" =~ [Nn][Ii][Gg]*) then - switch _Ignore 0 - - else if ("$option" =~ [Ii][Mm]*) then - switch _Import 1 - else if ("$option" =~ [Nn][Ii][Mm]*) then - switch _Import 0 - - else if ("$option" =~ [Ss]*:??) then - if ("$option" =~ [Ss]*:$n_arch || "$option" =~ [Ss]*:un) then - switch _Select 1 - else - switch _Select 0 - endif - - else if ("$option" =~ [Ss]*) then - switch _Softlink 1 - else if ("$option" =~ [Nn][Ss]*) then - switch _Softlink 0 - - else if ("$option" =~ [Tt]*:*) then - set opt=`echo $option | tr ':' ' '` # Split off argument - if ("$opt[2]" =~ [Nn][Oo][Nn][Ee]) set opt[2]="^." - switch _Types "$opt[2]" - unset opt - else if ("$option" =~ [Tt]*) then - switch _Types "." - - else if ("$option" =~ [Uu]*) then - switch _Update 1 - else if ("$option" =~ [Nn][Uu]*) then - switch _Update 0 - - else - echo "Invalid or ambiguous switch chosen: $option" - endif -end - -# -# Handle echo here -# -if ($_Echo) then - set echo -else - unset echo -endif - -unset Options option -unalias switch diff --git a/src/sys/sys.grp b/src/sys/sys.grp deleted file mode 100644 index d6cc8832964c3cc1c64c3d3957a32096d573d062..0000000000000000000000000000000000000000 --- a/src/sys/sys.grp +++ /dev/null @@ -1,219 +0,0 @@ -!+SYS.GRP -! CMV 930922 -! -! Revisions: -! CMV 930922 Created -! CMV 931201 Removed includepef.kwa (now in genaid) -! CMV 931201 Split off binaries to bin.grp -! HjV 940103 Add BUP.CSH, UCSB-, WENSS-, RUL-files -! HjV 940217 Add/change missing entry-points/functions -! HjV 940223 Add I_DA.CSH -! HjV 940314 Add I_SWARECB.CSH -! HjV 940317 Add I_HPRUL.CSH -! HjV 940415 Add *_UVA.CSH -! HjV 940516 Remove DWEXE.COM (now in WNG.GRP) -! WNB 940621 Add I_VX.CSH, CSH2P, C2AID, UPDATE, SHADOW, -! BUGREPORT, DOCUMENT.PLS -! NEWSTAR_INIT, _ATNF, _ENV.COM -! WNB 940624 Add N_LINKS.COM -! HjV 940624 Add *_BAO.CSH -! CMV 940711 Remove docaid.c, add init_wsrt.csh -! CMV 940717 Add JPH's stuff -! HjV 940901 Add DOC_PREPROCESS.CSH -! HjV 940914 Add *_UCB.CSH -! HjV 940922 Add FTPUPDATE.CSH -! CMV 940927 Add i_swucb.csh -! HjV 941019 Remove FTPUPDATE.CSH -! (We will update ftp.astron.nl in another way) -! CMV 941102 Remove BUGAID.*, BUGREPORT.* -! CMV 941103 Add SCISSOR.CSH, SCISSOR.C -! JPH 941111 XMOSAIC_RESTART.CSH, SIGNAL_AND_SYNC.C -! HjV 941215 Add *ESTEC.CSH -! CMV 950105 Add *SRON.CSH -! CMV 950116 Add I_ATNF.CSH -! HjV 950314 Add *CALT.CSH -! CMV 950411 Add IONOS.* and TMSDOC.CSH -! HjV 950529 Make WENSS a separate site -! HjV 950703 Add I_SWRUL.CSH -! CMV 950728 Add filpo.kwa -! HjV 950828 Add *IRABO.csh -! JPH 951101 Remove doc_overview.csh -! Add doc_test.csh, batch_ask.c batch_sync.c -! JPH 951114 Add batch_log.c -! HjV 951214 Add *AIRUB.csh -! HjV 960102 Change IONOS.PIN in IONOST.PIN -! Change IONOS.XSW in IONOST.XSW and move to BIN.GRP -! Add NEWERFILE.C -! HjV 960201 Add I_HPWSRT.CSH -! HjV 960422 Add DWRECORD.CSH -! HjV 960618 Add *LICK.CSH; Add I_SO*.CSH -! HjV 961212 Add i_SORUG.CSH -! HjV 971024 Add OBSLOG.PLS -! HjV 971029 Add i_SORAIUB.CSH -! AXC 010628 added data_splitter.awk, and other linux port stuff -! AXC 040213 Added linux files for w'bork -! -! This groupfile -! -SYS.GRP -! -! Maintenance routines for sources and documentation -! -BATCH_ASK.C ! Input pipe to program -BATCH_LOG.C ! Record program dialogue -BATCH_SYNC.C ! Output pipe, synchronise batch_ask prompting -BUP.CSH ! Background update -COMPILE.CSH ! Main routine for compilation -CSH2P.PLS ! C to PERL compiler (.csh to .pls) -C2AID.PLS ! Run-time aids for .pls -DATABASE.IDX ! Master database with all filenames -DOCUMENT.CSH ! Main routine for documentation (ndoc command) -DOCUMENT.PLS -DOC_COOK.CSH ! Latex input to HTML -DOC_KEYS.CSH ! Parameter document from .psc/.pef file -DOC_PREPROCESS.CSH ! Common processing for doc_cook, doc_print -DOC_PRINT.CSH ! Latex input to PostScript -DOC_SCRIPT.CSH -DOC_SCRIPT.C -DOC_TEST.CSH ! Check system integrity -DWRECORD.CSH ! Record/replay program run -INCLUDE.C ! Execute \input for Latex files -GENAID.C ! Standalone progam, aid for compilation -INITCOMPILE.CSH ! Common Initialisation for update/shadow.csh -INIT_WSRT.CSH ! Set up off-line environment WSRT -LOCK.IDX ! Locking database -NEWERFILE.C ! Compare modification times of two files -SHADOW.CSH ! Shadow system commands -SHADOW.PLS -SWITCHES.CSH ! Common switch handling for update/shadow.csh -UPDATE.CSH ! Master system commands -UPDATE.PLS -VERSION.IDX ! Release and revision number -! -! Tools for medium administration and database -! -SCISSOR.CSH ! Shell for init, ship, ionos, ... commands -TMSDOC.CSH ! Shell for management of TMS documents -SCISSOR.C ! Standalone database client -IONOS.C ! Standalone program to enter and read f0f2 values -IONOST.PIN ! Userinterface for Spoelstra's ionosphere program -FILPO.KWA ! Awk-script to parse WSRT filpo tables -OBSLOG.PLS ! Scripts to read WSRT-logbook -! -! Compilation commands and switches for different architectures -! -I_LI.CSH ! Linux -I_AL.CSH ! Alliant -I_CV.CSH ! Convex -I_DA.CSH ! DecAlpha -I_DW.CSH ! DecStation -I_HP.CSH ! HP Workstation -I_SO.CSH ! Sun Solaris -I_SW.CSH ! Sun Workstation -I_VX.CSH ! VMS -! -! System commands are all in WNGFEX -! -WNGFEX.COM -WNGFEX.CSH -N_LINKS.COM -! -! Xmosaic (re)start from Newstart programs -! -XMOSAIC_RESTART.CSH -SIGNAL_AND_SYNC.C ! Activate xmosaic with HTML-page request -! -! Site specific initialisation and system commands -! -NEWSTAR_INIT.CSH ! General initialisation -NEWSTAR_INIT.COM -NEWSTAR_ENV.CSH ! General environment (HOSTTYPE, ARCH etc) -NEWSTAR_ENV.COM -! -NEWSTAR_NFRA.CSH -WNGFEX_NFRA.COM -WNGFEX_NFRA.CSH -I_HPNFRA.CSH -I_SONFRA.CSH -I_LINFRA.CSH -I_LIWSRT.CSH -! -NEWSTAR_ESTEC.CSH -WNGFEX_ESTEC.CSH -! -NEWSTAR_RUG.CSH -WNGFEX_RUG.CSH -I_HPRUG.CSH -I_SORUG.CSH -I_SWRUG.CSH -! -NEWSTAR_RUL.CSH -WNGFEX_RUL.CSH -I_HPRUL.CSH -I_SWRUL.CSH -! -NEWSTAR_RUU.CSH -WNGFEX_RUU.CSH -! -NEWSTAR_SRON.CSH -WNGFEX_SRON.CSH -I_HPSRON.CSH -! -NEWSTAR_UVA.CSH -WNGFEX_UVA.CSH -! -NEWSTAR_WENSS.CSH -WNGFEX_WENSS.CSH -I_HPWENSS.CSH -! -NEWSTAR_WSRT.CSH -WNGFEX_WSRT.CSH -I_HPWSRT.CSH -! -NEWSTAR_AIRUB.CSH -WNGFEX_AIRUB.CSH -! -NEWSTAR_ARECB.CSH -WNGFEX_ARECB.CSH -I_SWARECB.CSH -! -NEWSTAR_ATNF.CSH -NEWSTAR_ATNF.COM -WNGFEX_ATNF.COM -WNGFEX_ATNF.CSH -I_ATNF.CSH -I_SOATNF.CSH -! -NEWSTAR_BAO.CSH -WNGFEX_BAO.CSH -! -NEWSTAR_CALT.CSH -WNGFEX_CALT.CSH -! -NEWSTAR_IRABO.CSH -WNGFEX_IRABO.CSH -! -NEWSTAR_KOSMA.CSH -WNGFEX_KOSMA.COM -WNGFEX_KOSMA.CSH -I_HPKOSMA.CSH -! -NEWSTAR_LICK.CSH -WNGFEX_LICK.CSH -I_SWLICK.CSH -! -NEWSTAR_RAIUB.CSH -WNGFEX_RAIUB.CSH -I_SWRAIUB.CSH -I_SORAIUB.CSH -! -NEWSTAR_UCB.CSH -WNGFEX_UCB.CSH -I_SWUCB.CSH -! -NEWSTAR_UCSB.CSH -WNGFEX_UCSB.CSH -I_SWUCSB.CSH -! -DATA_SPLITTER.KWA -!- diff --git a/src/sys/tmsdoc.csh b/src/sys/tmsdoc.csh deleted file mode 100755 index c1f7cd1c1d0036c2c787769c26e15be882facb18..0000000000000000000000000000000000000000 --- a/src/sys/tmsdoc.csh +++ /dev/null @@ -1,160 +0,0 @@ -#!/bin/csh -# -#$Prog$ -# -# $Id$ -# -# $Purpose: Register an update of a TMS related document -# -# $Usage: tmsdoc.csh memo|new|update|get [File] -# -# $Log$ -# -# -#$/Prog$ -# -#set echo - -if ("$1" == "") then - echo -n "Enter a command (memo, new, update, get): " - set Command=($<) -else - set Command=($1) -endif - -if ("$Command" == memo) then - - if ("$2" =~ [0-9]*) then - set Memo="Doc=$2" - shift - else - set Memo="" - endif - - if ("$2" == "") then - echo -n "Enter name of file: " - set File=($<) - else - set File=($1) - endif - - echo -n "From: " - set From=($<) - echo -n "To: " - set To=($<) - set To=(`echo $To | tr ',' ' '`) - echo -n "Cc: " - set Cc=($<) - set Cc=(`echo $Cc | tr ',' ' '`) - - echo -n "Subject: " - set Subject=($<) - echo -n "Action: " - set Action=($<) - echo -n "Before: " - set Before=($<) - - if ("$File" != "") then - ftp -n ftp.astron.nl <<_EOD_ -user anonymous ${USER}@`domainname` -cd pub/incoming -bina -put $File $File:t -bye -_EOD_ - set Flag=(`$n_exe/scissor.exe put=tmsmemo $Memo subject=$Subject Action=$Action Before=$Before Name=$From Extension=$File:e File=$File:t`) - else - set Flag=(`$n_exe/scissor.exe put=tmsmemo $Memo subject=$Subject Action=$Action Before=$Before Name=$From`) - endif - - echo $Flag - set Memo=$Flag[2] - foreach Name ($To) - $n_exe/scissor.exe put=tmsdocto doc=$Memo name=$Name Function=To - end - foreach Name ($Cc) - $n_exe/scissor.exe put=tmsdocto doc=$Memo name=$Name Function=Cc - end - -else if ("$Command" == new) then - if ("$2" == "") then - echo -n "Enter name of file(s): " - set File=($<) - else - set File=($argv[2-]) - endif - - echo -n "Auhor: " - set Author=($<) - echo -n "Subject: " - set Subject=($<) - - ftp -n ftp.astron.nl <<_EOD_ -user anonymous ${USER}@`domainname` -cd pub/incoming -bina -prompt -mput $File -bye -_EOD_ - - $n_exe/scissor.exe put=tmsdoc subject=$Subject Author=$Author File=$File - -else if ("$Command" == update) then - if ("$2" == "") then - echo -n "Enter number of document: " - set Doc=($<) - else - set Doc=($2) - endif - - if ("$3" == "") then - echo -n "Enter number of version: " - set Version=($<) - else - set Version=($3) - endif - - if ("$4" == "") then - echo -n "Enter name of file(s): " - set File=($<) - else - set File=($argv[4-]) - endif - - ftp -n ftp.astron.nl <<_EOD_ -user anonymous ${USER}@`domainname` -cd pub/incoming -bina -prompt -mput $File -bye -_EOD_ - - $n_exe/scissor.exe put=tmsdoc doc=$Doc File=$File - -else if ("$Command" == get) then - - if ("$1" == "") then - echo "Enter number of memo: " - set Memo=($<) - else - set Memo=($1) - endif - if ("$Memo" < 100) set Memo="0$Memo" - if ("$Memo" < 10) set Memo="0$Memo" - - setenv QEDDEBUG - $n_exe/scissor.exe select=tmsmemo doc=$Memo - - ftp -n ftp.astron.nl <<_EOD_ -user anonymous ${USER}@`domainname` -cd tms/tmsdoc/memo -bina -prompt -mget tms$Memo.* -bye -_EOD_ - -endif - diff --git a/src/sys/update.csh b/src/sys/update.csh deleted file mode 100755 index 6008f7a36e9d6107ba6bc3753689a60d35331ab1..0000000000000000000000000000000000000000 --- a/src/sys/update.csh +++ /dev/null @@ -1,2571 +0,0 @@ -#! /bin/csh -f -#+ update.csh -# -# CMV 930524 Created -# CMV 931013 Improved Clean option, added Save, added Group -# CMV 931018 Correct mailer in save option -# CMV 931018 Implemeted -List for retrieve -# CMV 931019 Added library checks -# CMV 931020 Changed call to switches -# CMV 931020 Build -D puts objects in $n_ulib -# CMV 931025 Better text in Save -# CMV 931102 Switch -[N]Check added for dependencies -# CMV 931104 Added automatic mailing for NFRA updates -# CMV 931107 Less output during backup (t in stead of tv) -# CMV 931111 Removed retrieve -l option, added diff command -# CMV 931116 Changed updating log for httpd 1.0 -# CMV 931124 Force editing of nnews after nup b -u at NFRA, -# no longer mail to NFRA after a retrieve, -# moved get and put to shadow.csh -# CMV 931202 Add locking for retrieve option -# CMV 931220 Create subdirectory for checkin -# CMV 931221 Multiple groupfile for new-to-old -# CMV 931221 No .old files in pack -# CMV 931223 Change handling of libraries -# CMV 931223 Some more prevention against "word too long" -# CMV 940214 Revision numbers and change in retrieve procedure -# CMV 940216 Check l spawns rebuild of library -# CMV 940216 New command: update (retrieve revision) -# CMV 940218 Include revision number in executable -# CMV 940304 Add argument all for Pack command -# HjV 940314 Use environment ARD (=ar dv or ar dlv) -# CMV 940323 remsh for HP's -# HjV 940328 FTP info about Newstar use to NFRA -# HjV 940331 PACK: not in background, causes diskquota problems -# CMV 940419 Made test on version in check exe more robust -# CMV 940420 Compile abp executables only if n_doabp set -# HjV 940503 Remove old version of newstar.use -# CMV 940506 Better format in log to revision history -# HjV 940516 CLEAR: Do not print message for other machines binaries -# CMV 950517 Option to delay notification to friends of Newstar -# HjV 940624 Do not get newstar.use when NFRA does the retrieve -# CMV 940705 Add notify command -# CMV 940718 Typo -# HjV 940802 More typo's -# CMV 940804 Notify does all releases or nothing -# CMV 940821 Move grp files to n_import/old after files have been updated -# CMV 940915 Change reference to $n_exe/html to $n_hlp -# HjV 940922 Copy files with ftp (i.s.o. rsh) to DAW10 -# HjV 941019 Copy source files and hlp-directory in .tar-files with -# ftp to DAW10. On DAW10 there will be a program which -# check the tar-files every hour. -# HjV 941031 Change for better updating -# CMV 941101 If any file from $n_src/sys retrieved, update right away -# CMV 941102 Add ranlib for nup check l -# CMV 941102 Implement retrieve -Import and build -NMerge -# CMV 941102 nup notify is now nup release -# CMV 941111 Proper handling of version numbers in case of nup -t:none -# HjV 941114 Mail message when something wrong with NSERVER -# HjV 950112 Build SYS_BLDPPD.EXE (if necessary) before handling PIN/PSC files -# HjV 950530 Check for (and set) PWD, not known on all systems -# HjV 960102 Change option FULL into ALL for document.csh -# HjV 960423 Bitmaps have now extension .xbm in source tree -# HjV 960522 Change files to exclude for PACK option (different for hlp) -# HjV 000309 Change elm -s into nsmail -# WNB 090303 Change 'tail +<num>' into 'tail -n +<num>' -# -# -# This is the update script for the Newstar programs -# -# Note for programmers: -# Search for %Blurp gets you to start of code for command Blurp etc. -# -# -# For maintenance of the master system, file information is -# taken from the following databases: -# -# $n_src/sys/version.idx Release and revision number -# $n_src/sys/database.idx Full filesystem database -# $n_src/sys/locks.idx Database with locked files -# $n_src[/*]*.grp Groupfiles with compilation instructions -# -#--------------------------------------------------------------------- -# -# -# -# Check wether we can use update. -# -if (! -o $n_src) then - echo "***** You can only run update as the Newstar manager..." - exit -endif - -if ($cwd != $n_src && $cwd !~ $n_src/* && $cwd != $n_import) then - echo "***** You are not allowed to run update from $cwd..." - echo "You should be either in "\$n_src" or one of it's subdirectories," - echo "or in directory "\$n_import", not in $cwd..." - if (-d $n_import) then - cd $n_import - echo "Now in $n_import" - else - exit - endif -endif - -onintr Abort_exit - -# -# Setup logging, initialise, check filesystem etc. -# -alias log 'echo \!* | tee -a $Logfile' -source $n_src/sys/initcompile.csh -if (! $?PWD ) then # Make sure we have PWD - setenv PWD `pwd` -endif - -# -# Decode switches, get command, or set menu mode if none given. -# -set noglob; set Command=( $argv ); unset noglob -set Options=""; source $n_src/sys/switches.csh - -set Files="" -if ("$Command" != "") then - set Mode="Command" - if ($#Command > 1) then - set noglob; set Files=( $Command[2-] ); unset noglob - set Command=$Command[1] - endif -else - set Mode="Menu" - set Command="" -endif - - -# -# -# Check the file system and try to make any missing directories -# -if (! -d $n_lib ) then - set n_tmp=$n_lib - if (! -d ${n_tmp:h} ) then - log ">>>>>>>> Creating root of library tree... ${n_tmp:h}" - mkdir ${n_tmp:h} - endif - log ">>>>>>>> Creating library directory for $n_arch... $n_lib" - mkdir $n_lib - if (! -d $n_lib ) then - log " " - log "Could not create library directory $n_lib..." - goto Abort_exit - endif -endif - -if (! -d $n_inc ) then - log ">>>>>>>> Creating include directory $n_inc" - mkdir $n_inc - if (! -d $n_inc ) then - log " " - log "Could not create include directory $n_inc..." - goto Abort_exit - endif -endif - -if (! -d $n_exe ) then - set n_tmp=$n_exe - if (! -d ${n_tmp:h} ) then - log ">>>>>>>> Creating root of binary tree... ${n_tmp:h}" - mkdir $n_tmp:h - endif - log ">>>>>>>> Creating binary directory for $n_arch... $n_exe" - mkdir $n_exe - if (! -d $n_exe ) then - log " " - log "Could not create binary directory $n_exe..." - goto Abort_exit - endif -endif - -if (! -d $n_hlp ) then - log ">>>>>>>> Creating hypertext directory $n_hlp" - mkdir $n_hlp - if (! -d $n_hlp ) then - log " " - log "Could not create include directory $n_hlp..." - goto Abort_exit - endif -endif - -if (! -d $n_tst ) then - set n_tmp=$n_tst - if (! -d ${n_tmp:h} ) then - log ">>>>>>>> Creating root of test binary tree... ${n_tmp:h}" - mkdir $n_tmp:h - endif - log ">>>>>>>> Creating test binary directory for $n_arch... $n_tst" - mkdir $n_tst - if (! -d $n_tst ) then - log " " - log "Could not create test binary directory $n_tst..." - goto Abort_exit - endif -endif - -if (! -d $n_work) then - set n_tmp=$n_work - if (! -d ${n_tmp:h} ) then - log ">>>>>>>> Creating root of work directory tree... ${n_tmp:h}" - mkdir ${n_tmp:h} - endif - log ">>>>>>>> Creating work directory for $n_arch... $n_work" - mkdir $n_work - if (! -d $n_work ) then - log " " - log "Could not create work directory $n_work..." - goto Abort_exit - endif -endif - -if (! -d $n_import) then - log ">>>>>>>> Creating directory for import... $n_import" - mkdir $n_import - chmod a+rwx $n_import - if (! -d $n_import ) then - log " " - log "Could not create import directory $n_import..." - goto Abort_exit - endif -endif - -# -# -# Remove any existing locks and create a new one -# -if (-e $n_work/update.lock ) then - echo "Cannot update on ${n_arch}: "`cat $n_work/update.lock` - echo -n "Remove "; 'rm' -i $n_work/update.lock - if (-e $n_work/update.lock) goto Abort_exit -endif -echo "Locked by $USER at $C_Date $C_Time" >$n_work/update.lock - -# -# Check wether the various precompilers exist -# -if (! -e $n_exe/genaid.exe ) then - log "Building utility program genaid ($n_exe/genaid.exe)" - $CC -o $n_exe/genaid.exe $n_src/sys/genaid.c - if (! -e $n_exe/genaid.exe) goto Abort_exit -endif - -if (! -e $n_exe/wntinc.exe ) then - log "Missing dsc-compiler ($n_exe/wntinc.exe)" - log "Run update build wntinc to build it first" -# if ("$Mode" != "Menu") goto Abort_exit -endif - -if (! -e $n_exe/sys_bldppd.exe ) then - log "Missing ppd-compiler ($n_exe/sys_bldppd.exe)" -# if ("$Mode" != "Menu") goto Abort_exit -endif - - -# -# -# If in Menu mode, repeatedly ask commands, else just one command -# -while ( "$Mode" != "Quit") - - if ( "$Mode" == "Menu" ) then - if ("$n_site" == nfra) then - echo "Commands are: update, build, cont, check, retrieve, clean, " - echo " diff, pack, group, release, save, help, quit" - else - echo \ - "Commands are: update, build, cont, check, retrieve, clean, help, quit" - endif - echo -n "Enter a command: " - set Command=($<) - set Files="" - set noglob; set Command=( $Command ); unset noglob - set Options=""; source $n_src/sys/switches.csh - if ($#Command > 1) then - set noglob; set Files=( $Command[2-] ); unset noglob - set Command=$Command[1] - endif - else if ( "$Mode" == "Update" ) then - set Command=$Upd_list[1] # Get next command - if ($#Upd_list > 1) then - shift Upd_list # Get rid of command - set Files=( $Upd_list[1] ) # And it's argument - if ($#Upd_list > 1) shift Upd_list # Get rid of argument - else - set Files="" - endif - else - set Mode="Quit" - endif - - if ("$Command" == "" || "$Command" =~ [Qq]*) then - set Mode="Quit" - -# -# %Help command: -# - else if ("$Command" =~ [Hh]* ) then - cat <<_EOD_ -#+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++# - - Update is used for maintenance of the Newstar master system. - You are only allowed to run update when you are the owner of \$n_root. - - Update can only be run from the root of the master source tree (\$n_src), - from one of it's subdirectories (\$n_src/*) or from the directory for - import of new files (\$n_import). Update leaves a full transaction log - in \$n_src, with name 'updyymmdd[i].log' (where yymmdd is the current - date and i is an integer 1,2,...). - - For program development and debugging, please use the "shadow" command, - in particular shadow build. - - Update can be called in one of the following ways: - - - nup - - Enter a menu mode where all options listed below can be - chosen. Additional arguments will be prompted for. - - nup update - - This will check your current implementation against the - master copy at NFRA, retrieve any new files, build them, - clean up your local copy and libraries and rebuild any - out-of-date executables. - - nup build [switches | groupfile | 'all' ] ... - - Accepts one or more groupfiles which should be either - in the current dir or in a subdirectory of the master source - tree (the extension .grp may be ommitted). Normally no switches - will be given (this is updating the master, so you should in - principle hardcode things in files i_$n_arch$n_site.csh). - - If you specify the -Update switch, executable files will end up - in \$n_exe, if you specify -NUpdate they land in \$n_tst. - - The groupfiles are scanned and all files contained therein - that are relevant to this architecture are compiled. - - Processing takes place in a pre-defined order of filetypes, - you may select some types only by using the -Types switch. - You may select to compile only a subset of the filetypes by - setting -Types:ask, which will cause the update to prompt - you (in advance) for the requested passes. - - If the groupfile was in \$n_import and no errors occurred then - all files in the groupfiles (except .exe) are copied into their - appropriate directory in the Master source tree. - Once successfully copied, each file is unlocked in the locking - database (lock.idx). The master database (database.idx) is - updated. - - If there are dependent files (that is: files that need to be - rebuilt because an include file has been updated), their names - are stored in \$n_work/depend.grp.This file is processed at the - end of each pass. This ensures that any dependencies introduced - by the dependent files are teated properly (eg. an update of - a DSF file causes some dependent DSC files to be rebuilt, and - these DSC files cause some Fortan and C sources to be rebuilt etc. - Checking of dependencies can be disabled with the -NCheck switch. - - The file depend.grp is kept in \$n_work for inspection - - The groupfile should explicitly mention the .exe files that - need to be rebuilt! - - nup continue [switches | groupfile | 'all' ] ... - - Resumes a build that has crashed somewhere. To rebuild some - files, please edit \$n_work/continue.idx - - Use this option with care. - - nup retrieve ['all' | groupfile [inet-address [user [directory]]] ] - - Default internet specifications are 'all' and the NFRA Master node. - - If the literal 'all' is specified, the Master database will - be retrieved from the remote node. If no local database - exists, it will be updated (this will take some time but is - the only safe way to proceed). The master database will be - checked against the local database. From this comparison, - a groupfile is constructed. - - If a groupfile is specified in stead of 'all', it will be - retrieved from the remote node if it does not already exist. - - All files in the (constructed or retrieved) groupfile - will be retrieved over the network. - To update the files, use the "nup build retrieved" command. - All files are received in \$n_import, which should be empty. - - nup clean [directory | 'all'] - - Verify the specified directory in the source tree against - the groupfiles in that directory. - If no directory is specified, check them all. - If the literal 'all' is specified, check against the - the master database (\$n_src/sys/database.idx). - Remove (with confirm) any files that exist but are not - mentioned in a groupfile, - Report any files that do not exist but are in a groupfile. - - nup check ['all' | fdhle ] - - Default for the argument is all - - If the argument is all or contains an f: - Verify the master source tree against the master database. - Checksums, sizes and dates are compared. A groupfile is - created in \$n_import with entries for defect and missing - files, this groupfile can be processed with "nup retrieve". - - If the argument is all or contains an h: - The command "ndoc all" is executed to make a fresh version - of all documentation. - - If the argument is all or contains a d or contains an h: - A new master database is created which reflects the current - situation. We need to do this after check h, because the - documentation archive newstar.hun will have been updated - - If the argument is all or contains an l: - The object libraries are checked for double entries and - out-of-date files. - - If the argument is all or contains an e: - The executables are checked and out-of-date files are rebuilt. - - nup system update - - This command is called by nup update. It checks wether any - system files from \$n_src/sys have been retrieved. If so, these - files are installed immediately, and update invokes itself - using the new system files. - -_EOD_ - - if ("$n_site" == "nfra") then - cat <<_EOD_ - - nup diff [groupfile] ... - - Compare files in \$n_import (listed in the groupfile) with the - versions in the master tree. - - nup save - - Start a full backup of the master system (in the background) - All files below \$n_root will be written to tape. A log is - kept in \$n_root/backups.txt. A roulating tape pool can be - used. The actual command for the backup can be specified by - the user. Default is the command previously used. - - - nup pack [name_of_directory... | 'all'] - - Put all files below the directories in a tar file (name - defaults to nstar_name.tgz, where name is the last item - in the directory specification or, if the directory roots in - \$n_src, \$n_exe or \$n_lib: nstar_yyy_name.tgz, where - yyy is either src, exe or lib. - - If the literal 'all' is given, archives will be made for the - source tree, \$n_inc, \$n_hlp and the executable trees for hp - and sw. - - - The following command is an interface between old and new style - groupfiles for update and retrieval: - - nup group groupfile(s) - - if a single input groupfile is specified and if it contains - lines starting with +, it is split out in a series of files - for the corresponding directories - - otherwise the groupfiles are transformed in a single groupfile - as expected by retrieve. -_EOD_ - endif - - echo \ -"#-------------------------------------------------------------------------#" - -# -# -# %Update command: -# - else if ("$Command" =~ [Uu]*) then -# -# First time, mode will not be Update -# - if ("$Mode" != "Update") then -# -# Is it a valid host? -# - set Hosts=(`echo $n_hosts | tr ',' ' ' `) - set Flag="" - foreach name ( $Hosts ) - if ("$name" == $HOST) set Flag=$name - end - if ("$Flag" == "") then - log "Invalid host $HOST, you should run on one of $n_hosts" -# -# Yes, we run a couple of commands, which one depends on the argument -# - else if ("$Files" == "" || "$Files" == "nosys") then - cd $n_import - echo "Now in $n_import" - set _Update=1 # For Build - set _Confirm=0 # For Clear - set Mode=Update # Process multiple commands - set Upd_list=( retrieve all ) - if ("$Files" != "nosys") then - set Upd_list=( $Upd_list \ - system update ) - endif - set Upd_list=( $Upd_list \ - build retrieved \ - clear all \ - check l \ - check e \ - update "" ) - else if ("$Files" == "rsh") then - cd $n_import - echo "Now in $n_import" - set _Update=1 # For Build - set _Confirm=0 # For Clear - set Mode=Update # Process multiple commands - set Upd_list=( build retrieved \ - check l \ - check e \ - quit "" ) - else - log "Invalid argument for Update command" - endif -# -# Not first time, we spawn a series of remote commands -# - else - if (! $?RSH ) then # Make sure we have rsh - setenv RSH \rsh - if ($n_arch == hp) setenv RSH \remsh - endif - - foreach name ( $Hosts ) - if ("$name" != $HOST) then - echo "Now trying to update on $HOST with command" - echo "$RSH $name " - echo "( source \$n_src/sys/newstar_$n_site.csh; nup update rsh)" - $RSH $name \ - '( source '$n_src/sys/newstar_$n_site.csh'; nup update rsh)' - endif - end - set Mode="Quit" - endif -# -# -# %System command: -# - else if ("$Command" =~ [Ss][Yy][Ss]*) then - - @ Errors = 0 # No errors yet - - if (-e $n_import/retrieved.grp) then # Groupfile should exist -# -# Rebuild any utility programs -# - log "Installing system files right away" - set nonomatch - set Input_file=( $n_import/*.c ) - if (-e $Input_file[1]) then - source $n_src/sys/compile.csh - endif - unset nonomatch -# -# Find list of shell-scripts, copy into system -# - grep +sys/.\*\.csh $n_import/retrieved.grp >$Tmpfile - set Input_file=( `$n_exe/genaid.exe files $Tmpfile` ) - 'rm' -f $Tmpfile - if ("$Input_file" != "") then - foreach wfile ($Input_file) - set Input_file=( $n_import/$wfile:t ) - source $n_src/sys/compile.csh - if (-e $n_src/$wfile) mv $n_src/$wfile $n_src/$wfile.old - mv $n_import/$wfile:t $n_src/$wfile - set Flag=(`cmp $n_import/$wfile:t $n_src/$wfile`) - if ("$Flag" != "") then - log "Error moving ${wfile:t}: $Flag" - @ Errors = $Errors + 1 - if (-e $n_src/$wfile.old) mv $n_src/$wfile.old $n_src/$wfile - else -# -# Update the Master database -# - cp $n_src/sys/database.idx $n_work/database.old - grep -v $wfile $n_work/database.old \ - >$n_src/sys/database.idx - $n_exe/genaid.exe fstat -c $n_src/$wfile \ - >>$n_src/sys/database.idx - log "${wfile:t} updated in master tree and database." - endif - end - -# -# If shell-scripts updated successfully, remove lock and restart -# - if ($Errors == 0) then - log "System files changed: restarting update..." - if ("$n_site" != nfra) then - echo "System files updated on $n_site ($n_arch) at ${C_Date}" |\ - nsmail "Newstar_update_on_$n_site/$n_arch" $n_master - endif - mv $n_work/update.lock $n_work/update.lock.$$ - $n_src/sys/update.csh $Files nosys - mv $n_work/update.lock.$$ $n_work/update.lock - set Mode="Quit" - endif - - endif - endif -# -# Send message if errors occurred -# - if ($Errors != 0 ) then - set Flag=(`cat $n_src/sys/version.idx`) - cat <<_EOD_ | tee -a $Logfile - -*************** Installation errors occured ********************** - -Errors during update of system-files. -The log-file will be mailed to $n_master. - -Please inform this account of additional information that might be -connected with the errors (recent change of operation system, disk -space problems etc). The Newstar group will contact you about the -problems as soon as possible. - -Your present installtion is intact and has not been updated. -You seem to have $Flag - -***************************************************************** - -_EOD_ - cat $Logfile | \ - nsmail "Newstar_crash_on_$n_site/$n_arch" $n_master - set Mode="Quit" - endif -# -# -# %Build command: -# - else if ("$Command" =~ [Bb]* || "$Command" =~ [Cc][Oo][Nn][Tt]*) then - - if ("$Command" =~ [Bb]*) then - set Cmd="build" - if (-e $n_work/continue.idx) then # Files already done - 'rm' -f $n_work/continue.idx - endif - if (-e $n_work/depend.grp) then # Remaining dependencies - 'rm' -f $n_work/depend.grp - endif - set nonomatch - set file=( $n_work/*.?lb.list ) # Files to be archived - if (-e $file[1]) then - 'rm' -f $n_work/*.?lb.list - endif - unset nonomatch - else - set Cmd="cont" - endif - if ($_Update) then - set Cmd="$Cmd -U " - else - set Cmd="$Cmd -NU " - setenv n_uexe $n_tst # Executables/ppd files in $n_tst - endif - - if (! -e $n_work/continue.idx) touch $n_work/continue.idx - if (! -e $n_work/depend.grp) touch $n_work/depend.grp -# -# Save the current version. We need to increase the version if we update -# from $n_import, and we need to do that only once. -# - set O_Version=$C_Version - if ($n_site == nfra) then - set N_Version=` echo $C_Version | awk -F. '{ printf "%s.%d",$1,$2+1 }' ` - else - set N_Version=` echo $C_Version | awk -F. '{ printf "%s.%d.%d",$1,$2,$3+1 }' ` - endif -# -# Get input files, check defaults, prepare for general log -# - if ("$Mode" == "Update") set _Types="^exe" - - if ("$Files" == "") then - echo -n "Enter name of groupfile(s) or all: " - set noglob # Don't expand wildcards right now - set Files=( $< ) # Read from stdin - set Files=( $Files ) # Split in multiple words - unset noglob - endif - - if ("$Files" == "" || "$Files" =~ [Aa][Ll][Ll] ) then - set Cmd="$Cmd -NC all" - set Files=$n_src'/*/???.grp' - set _Check=0 - else if ("$Files" =~ [Ww][Nn][Tt][Ii][Nn][Cc]) then - set Cmd="$Cmd -NC wntinc" - set Files=( $n_src/wng/wnt_boot \ - $n_src/wng/wng $n_src/wng/wnc \ - $n_src/wng/wnf $n_src/wng/wnt ) - set _Check=0 - else if ($_Check) then - set Cmd="$Cmd -C $Files" - else - set Cmd="$Cmd -NC $Files" - endif -# -# To process files just retrieved, move to $n_import -# - if ("$Files" == "retrieved" && $PWD != $n_import) then - cd $n_import - echo "Now in $n_import" - endif -# -# Expand wildcards, check existence of all files in advance. -# Only files in $n_src/* and $n_import are allowed. -# The current directory will be $n_src, $n_src/* or $n_import. -# - set Input_file="" - set noglob; set nonomatch - foreach File ( $Files ) - if (-d $File) then - unset noglob; set File=( $File/???.grp ); set noglob - else if ("$File:e" == "") then - set File=$File.grp - endif - set Input_file=($Input_file $File) - end - unset noglob - set Input_file=( $Input_file ) - set Files="" - foreach File ( $Input_file ) - if (-e $File) then - - if ( $File:h == $File ) then # Only name given - set File=$cwd/$File - if ($cwd == $n_import) then - log "%%%%%%% Updating $File:t from "\$n_import... - endif - else if ( $File !~ */*/$File:t && $cwd == $n_src ) then # wrt n_src - set File=$n_src/$File - endif - - if ( $File =~ $n_src/*/$File:t || \ - $File == $n_import/$File:t ) then - set Files=( $Files $File ) - else - log "Specify files in Master source tree or "\$n_import - log "$File ignored." - endif - - else - log "Cannot find groupfile $File, ignored." - endif - end - unset nonomatch -# -# Select the types to be processed and do global log -# - set typelist=( "grp/idx/kwa" \ - "tex/txt/hlp/html/xbm/gif/gfs/cap/tbl/fig/hun/ps"\$ \ - "scn/wmp/mdl/ngf/flf" \ - "csh/com/ssc/pls/c"\$ \ - "x$n_arch/a$n_arch" \ - "inc/dsf/pef/def" \ - "dsc" \ - "for/fsc/fun/f$n_arch/f"\$ \ - "cee/csc/cun/c$n_arch/s"\$ \ - "exe" "pin/psc" ) - if ("$_Types" != "." && "$_Types" != "") then - if ("$_Types" =~ \^[Ee][Xx][Ee]) then - set typelist[10]="" - set typelist=( $typelist ) - else if ("$_Types" !~ [Aa][Ss][Kk]) then - set typelist="$_Types" - else - echo "Selecting file-types to process: " - - set tmp=( "groupfiles" \ - "help files" \ - "data files" \ - "scripts" \ - "special binaries" \ - "include files" \ - "dsc definition files" \ - "fortran sources" \ - "c sources and macros" \ - "executables" "pin-files") - @ ii = 1 - while ( $ii <= $#typelist ) - echo -n "Do $tmp[$ii] ($typelist[$ii])? (y,n) [Y] " - set Flag=($<) - if ($Flag =~ [Nn]* ) set typelist[$ii]="" - @ ii = $ii + 1 - end - - unset tmp - set typelist=( $typelist ) - endif - echo "$C_Date $C_Time - $n_arch - $Cmd ($typelist) " >>$n_root/updates.log - else - echo "$C_Date $C_Time - $n_arch - $Cmd (all) " >>$n_root/updates.log - endif - - @ Errors = 0 - log "Logging information in $Logfile" - log "%%%%%%% Errors so far: $Errors ("`date`")" -# -# The check flag determines wether we want to do dependecy checking -# - if ($_Check) then - set Depend=$n_work/depend.grp - else - set Depend="" - log "%%%%%% No dependency checks" - endif - - foreach ftype ( $typelist ) - - if ( ("$ftype" =~ *exe* || \ - "$ftype" =~ *pin* || \ - "$ftype" =~ *psc* ) && $Errors != 0) then - log "======== Errors found, skip executables and ppd files =======" - else - - log " " - log "======== Pass for filetypes $ftype ========" - - - if ("$n_site" != nfra) then - if ("$ftype" =~ *pin* || "$ftype" =~ *psc* ) then -# -# Check if we have to rebuild SYS_BLDPPD.EXE -# - set Filestmp=(dwarf/sys_bldppd.exe) - foreach File ( $Filestmp ) - set v_exe=("" "") - set v_idx=("" "") - set File=`echo $File:t | tr '[A-Z]' '[a-z]'` - set Flag="${File}: No executable" - if (-e $n_exe/$File) then - set Flag =( `grep $File $n_src/sys/database.idx` "" "") - set v_idx=( `echo $Flag[2] | awk -F. '{ print $1,$2}' ` "" "" ) - set Flag =( `what $n_exe/$File | grep %NST% ` "" "" ) - set v_exe=( `echo $Flag[2] | awk -F. '{ print $1,$2}' ` "" "" ) - endif - set Input_file="" - if ("$v_exe" == " " || "$v_idx" == " ") then - set Input_file=($File) - else if ("$v_exe" == "" || "$v_idx" == "") then - set Input_file=($File) - else - if ("$v_exe[1]" < "$v_idx[1]" || \ - "$v_exe[2]" < "$v_idx[2]") then - set Input_file=($File) - endif - endif - if ("$Input_file" != "") then - if (`grep -c -i $Input_file $n_src/dwarf/src.grp` != 0) set _Alternate=1 - echo "Building new SYS_BLDPPD.EXE for handling pin/psc files" - source $n_src/sys/compile.csh - set _Alternate=0 - set Flag =( `what $n_exe/$File | grep %NST% ` '(updated)' ) - endif - echo $Flag | sed -e s/%NST%// >>$Tmpfile - end - endif # pin/psc - endif # not nfra - - - foreach grpfile ( $Files $Depend ) - - if ($grpfile == $n_work/depend.grp) then - echo "Checking dependencies..." - sort -u -o $n_work/depend.grp $n_work/depend.grp - endif - - set Newlib=${grpfile:h} - if ($Newlib == $grpfile) set Newlib=${cwd:h} - set Newlib=${Newlib:t} - if ("$Newlib" =~ n*) set Newlib=nst - - $n_exe/genaid.exe expand -t:$ftype $grpfile >$Tmpfile - if (! -z $Tmpfile ) then - log " " - log "=== Groupfile $grpfile " - endif - - set nline = `cat $Tmpfile | wc -l` # Count lines - @ iline = -9 # Means 1 after first increment by 10 - while ($iline < $nline) # Lines left? - @ iline = $iline + 10 # Next series of 10 - foreach wfile ( `tail -n +$iline $Tmpfile | head -10` ) - - if ("$wfile" =~ -* || "$wfile" =~ +* ) then - set Options=( local $wfile ); - source $n_src/sys/switches.csh - else - set Flag=`grep '^'$wfile'$' $n_work/continue.idx` - if ("$Flag" != "") then - log "Skipping $wfile (already done)" - else if ($wfile =~ abpx_*.exe && ! $?n_doabp ) then - log "Not compiling abp-executables" - else - set Input_file=$wfile - if ($grpfile == $n_import/$grpfile:t || \ - $grpfile == $n_work/depend.grp ) then - set Newlib=$wfile:h - set Newlib=$Newlib:t - if ("$Newlib" =~ n*) set Newlib=nst -# -# If we take a file from $n_import, we have to increase the version number -# - if ($cwd == $n_import && -e $n_import/$wfile:t) then - set Input_file=$n_import/$wfile:t - if ("$O_Version" == "$C_Version") set C_Version=$N_Version - endif - endif -# -# If this file is in different library, handle pending library operations -# - if ($n_lib/${Newlib}lib.olb != $_Objectlib ) then - log "Library: $_Objectlib:t -> ${Newlib}lib.olb" - if ("$_Objectlib" != "") \ - set Input_file=( $_Objectlib $Input_file ) - set _Objectlib=$n_lib/${Newlib}lib.olb - endif - if ($n_src/${Newlib}lib.olb != $_Textlib ) then - if ("$_Textlib" != "") then - set Input_file=( $n_src/$_Textlib $Input_file ) - set _Textlib=$n_src/${Newlib}lib.tlb - endif - endif -# -# Compile, check dependencies and restore original switches -# - source $n_src/sys/compile.csh - if ($?Abort_flag) goto Abort_exit - echo $wfile >>$n_work/continue.idx - - set wfile=$wfile:t - if ("$wfile:e" == "dsc") then - grep "@$wfile:r" $n_src/sys/database.idx >> $n_work/depend.grp - else - grep "@$wfile" $n_src/sys/database.idx >> $n_work/depend.grp - endif - - if ("$Save_switch" != "") set $Save_switch; - - endif - endif - end - end - - if (-e $Tmpfile) then - 'rm' -f $Tmpfile - endif - end - log "Error so far: $Errors ("`date`")" -# -# Handle any pending library actions -# - if ("$_Objectlib" != "") then - set Input_file=$_Objectlib - source $n_src/sys/compile.csh - endif - if ("$_Textlib" != "") then - set Input_file=$_Textlib - source $n_src/sys/compile.csh - endif - - endif # If exe and errors - end -# -# Check any pending dependencies -# - echo "Checking pending dependencies..." - sort -u -o $n_work/depend.grp $n_work/depend.grp - $n_exe/genaid.exe expand $grpfile >$Tmpfile - set nline = `cat $Tmpfile | wc -l` # Count lines - @ iline = -9 # Means 1 after first increment by 10 - while ($iline < $nline) # Lines left? - @ iline = $iline + 10 # Next series of 10 - foreach wfile ( `tail -n +$iline $Tmpfile | head -10` ) - if ("$wfile" !~ -* && "$wfile" !~ +* ) then - set Flag=`grep '^'$wfile'$' $n_work/continue.idx` - if ("$Flag" == "") echo "Error: remaining dependency $wfile" - endif - end - end - - log "Total number of errors: $Errors" - log "Logging information in $Logfile" - -# -# -# Compilation errors -# - if ($Errors != 0 ) then - log "Compilation errors...." - if ($cwd == $n_import && $_Update && $_Merge) then - log "Update cannot move files into \$n_src..." - endif -# -# Not in import, no need to modify source tree -# - else if ($cwd != $n_import) then - log "No compilation errors (compilation in source tree)." -# -# -NUpdate or -NMerge was used, do not update files in the master tree -# - else if (! $_Update) then - log "You used -NUpdate, the master source tree remains intact" - else if (! $_Merge) then - log "You used -NMerge, the master source tree remains intact" -# -# If it was an update, no errors occurred, and we were working in $n_import, -# then files can be moved in the master source tree. -# - else -# -# Remove references to groupfiles not in $n_import -# - set Flag="" - foreach grpfile ( $Files ) - if ( -e $n_import/$grpfile:t) set Flag=( $Flag $grpfile ) - end - set Files=( $Flag ) -# -# Move files in the master (if that is still necessary) -# - @ files_moved = 0 - foreach grpfile ( $Files ) - $n_exe/genaid.exe files -t:^exe $grpfile >$Tmpfile - set nline = `cat $Tmpfile | wc -l` # Count lines - @ iline = -9 # Means 1 after first increment by 10 - while ($iline < $nline) # Lines left? - @ iline = $iline + 10 # Next series of 10 - foreach file ( `tail -n +$iline $Tmpfile | head -10` ) -# -# If the file does no longer exist in $n_import is has been moved in -# $n_src earlier, so no need to worry. -# - if (-e $n_import/$file:t ) then - @ files_moved = $files_moved + 1 - if ("$file:h" != "" && ! -d "$n_src/$file:h") then - mkdir $n_src/$file:h - echo "Created subdirectory $file:h" - endif - set Flag=$file:t - if (-e $n_ulib/${Flag:r}.o) then - 'rm' -f $n_ulib/${Flag:r}.o - endif - if (-e $n_lib/${Flag:r}.o) then - 'rm' -f $n_lib/${Flag:r}.o - endif - if (-e $n_src/$file) then - mv $n_src/$file $n_src/$file.old - endif - cp $n_import/$file:t $n_src/$file - set Flag=(`cmp $n_import/$file:t $n_src/$file`) - if ("$Flag" != "") then - log "Error moving ${file:t}: $Flag" - @ Errors = $Errors + 1 - if (-e $n_src/$file.old) then - mv $n_src/$file.old $n_src/$file - endif - else -# -# Update database.idx: for NSTAR_DIR check dependencies, else just checksum -# - cp $n_src/sys/database.idx $n_work/database.old - grep -v $file $n_work/database.old \ - >$n_src/sys/database.idx - set dir=$file:h - if ("$NSTAR_DIR" =~ *$dir:t* ) then - $n_exe/genaid.exe fstat -i -c $n_src/$file \ - >>$n_src/sys/database.idx - else - $n_exe/genaid.exe fstat -c $n_src/$file \ - >>$n_src/sys/database.idx - endif - if (-e $n_src/sys/lock.idx) then - set Lock=(`grep $file $n_src/sys/lock.idx`) - if ("$Lock" =~ *imported*) then - cp $n_src/sys/lock.idx $n_work/lock.old - grep -v $file $n_work/lock.old >$n_src/sys/lock.idx - 'rm' -f $n_work/lock.old - endif - endif - 'rm' -f $n_import/$file:t - log "$file updated in master tree and database." - endif - endif - end - end - 'rm' -f $Tmpfile - end -# -# -# Errors moving files into the master, indicate with revision number -# - if ($Errors != 0 ) then - log "Errors moving files into the master..." - echo "*** Incomplete revision *** " >>$n_src/sys/version.idx -# -# We moved files into the master, so we have a new revision. -# - else if ($files_moved != 0 ) then - if ("$O_Version" == "$C_Version") set C_Version=$N_Version - mv $n_src/sys/version.idx $n_src/sys/version.idx.old - echo "Newstar Release $C_Version" >$n_src/sys/version.idx -# -# Flag a local revision -# - if ($n_site != nfra) then - if (`cat $Files | grep -c +sys/version.idx ` == 0) \ - echo "*** Local revision ***" >>$n_src/sys/version.idx -# -# -# If this is the NFRA master, update revision history and nnews.hlp -# - else - cat >>$n_root/updates.html <<_EOD_ - -<DT>$C_Date <STRONG>`cat $n_src/sys/version.idx`</STRONG> -_EOD_ - echo "1 NNews" >$Tmpfile - - -# -# Clear the file for commands to be handled by bugreport -# - if (-e ~/server/bugreport.in) then - 'rm' -f ~/server/bugreport.in - endif - - foreach grpfile ( $Files ) - set Flag="File $grpfile:t updated" - if (`grep -c "$Flag" $n_root/updates.log` == 0) then - echo "$C_Date $C_Time - $n_arch - $Flag" >>$n_root/updates.log -# -# Add it to the index of updates -# - echo \ -"<DT>$C_Date <A HREF=/nsbin/nview/import/$grpfile:t>$grpfile:t</A>" \ - >>$n_root/updates.html - - grep 'Subject:' $grpfile | sed -e 's/\!.*Subject:/<DD>/' \ - >>$n_root/updates.html -# -# Update nnews and add it to the grpfile -# - echo -n " $C_Date" >>$Tmpfile - grep Subject: $grpfile | sed -e 's/\!.*Subject://' >>$Tmpfile - echo "+doc/nnews.hlp" >>$grpfile -# -# Check wether it solved a bug, if so: make input file and save number -# - if (`grep -c -e '- bug ' $grpfile` == 1) then - set Bug=( `grep -e '- bug ' $grpfile` ) - if ("$Bug[$#Bug]" !~ [0-9]*) then - log "Invalid bug-id in $Bug" - else - cat >> ~/server/bugreport.in <<_EOD_ -Release $Bug[$#Bug] -Update revision $C_Version -import/$grpfile:t -n -_EOD_ - endif - endif - - endif # if (first update) - end # foreach grpfile () -# -# Wait for the server to release the bugs, if any -# - if (-e ~/server/bugreport.in) then - echo "quit" >> ~/server/bugreport.in - echo "y" >> ~/server/bugreport.in - echo "bugreport" > ~/server/server.cmd - log "Waiting for Export-Server to release bugs" - while (-e ~/server/server.cmd) - sleep 30 - end - 'rm' -f ~/server/bugreport.in - if (-e ~/server/server.err) then # something wrong ? - if (! -z ~/server/server.err) then # yes - log "Something went wrong with NSERVER" - cat ~/server/server.err | \ - nsmail "NSERVER error" $n_master - endif - 'rm' -f ~/server/server.err - endif - endif -# -# Append the remainder of nnews.hlp and put the new version in the system -# - tail -n +2l $n_src/doc/nnews.hlp >>$Tmpfile - mv $n_src/doc/nnews.hlp $n_src/doc/nnews.hlp.old - mv $Tmpfile $n_src/doc/nnews.hlp - 'rm' -f $Tmpfile -# -# We changed files in the master, so update the database -# - set Input_file=( $n_src/sys/version.idx $n_src/doc/nnews.hlp ) - source $n_src/sys/compile.csh - cp $n_src/sys/database.idx $n_work/database.old - grep -v +doc/nnews.hlp $n_work/database.old | \ - grep -v +sys/version.idx >$n_src/sys/database.idx - $n_exe/genaid.exe fstat \ - $n_src/sys/version.idx $n_src/doc/nnews.hlp \ - >>$n_src/sys/database.idx -# -# Compose a mail message about this fresh release. -# - set Flag="Newstar Release $C_Version" - cat <<_EOD_ >message.$C_Version - -From: The Newstar Master account -To: All Friends of Newstar - -Concern: $Flag - - - Dwingeloo, $C_Date - -Dear Friends of Newstar, - -A new Newstar revision has been installed in the Master system at NFRA: - -_EOD_ - cat $Files | grep Subject: | sed -e 's/\!.*Subject:/=== /' >>message.$C_Version - cat <<_EOD_ >>message.$C_Version - -To upgrade your installation, login as the Newstar manager, initialise -the Newstar environment (e.g. source ~newstar/src/sys/newstar_????.csh) -and enter: - - nup update - -and follow the instructions given by that command. - -Please direct any problems or questions to $n_master - - -Your sincerely, - -The Newstar Project Team. -_EOD_ - - -# Message made, so move groupfiles out of the way -# - mv $Files $n_import/old -# -# Give an oppurtunity to edit the message and the subjects -# (some people give those weird subjects in their groupfiles...) -# - emacs $n_src/doc/nnews.hlp message.$C_Version - -# -# We changed files in the master, so update the database -# - set Input_file=( $n_src/doc/nnews.hlp ) - source $n_src/sys/compile.csh - cp $n_src/sys/database.idx $n_work/database.old - grep -v +doc/nnews.hlp $n_work/database.old \ - >$n_src/sys/database.idx - $n_exe/genaid.exe fstat \ - $n_src/doc/nnews.hlp >>$n_src/sys/database.idx - - clear - cat <<_EOD_ | tee $Tmpfile - -Newstar Revision $C_Version has been succefully merged in the -NFRA-Master at $C_Date $C_Time. - -Warning: no notification has been sent to the Friends of Newstar -Warning: the ftp-area has not been updated - -You should give command nup release later to send out this release - -_EOD_ - cat $Tmpfile | \ - nsmail "Pending release $C_Version from $C_Date" $n_master - 'rm' -f $Tmpfile - - endif # if (nfra) - endif # if (files_moved) - endif # if (in import) -# -# -# Errors occurred, give a message (different for nfra and elsewhere) -# - if ($Errors != 0 ) then - if ("$n_site" == nfra) then - cat <<_EOD_ | tee -a $Logfile - -Errors during execution of $Cmd - -Libraries and \$n_inc have most probably been cluttered. -Either correct the errors and try same command again, -or reconstruct the libraries etc. (only the potentially damaged files): - cd \$n_src; nup build \$n_import/$grpfile:t - -_EOD_ - else - set Flag=(`cat $n_src/sys/version.idx`) - cat <<_EOD_ | tee -a $Logfile - -*************** Installation errors occured ********************** - -The log-file will be mailed to $n_master. - -Please inform this account of additional information that might be -connected with the errors (recent change of operation system, disk -space problems etc). The Newstar group will contact you about the -problems as soon as possible. - -Your present executables are still correct. -You seem to have $Flag - -***************************************************************** - -_EOD_ - cat $Logfile | \ - nsmail "Newstar_crash_on_$n_site/$n_arch" $n_master - set Mode="Quit" - endif -# -# No errors: inform NFRA if run on remote site -# - else if ("$n_site" != nfra) then - nsmail "Newstar_update_on_$n_site/$n_arch" $n_master <<_EOD_ - -Newstar has been updated on $n_site ($n_arch) at ${C_Date}: - - $Cmd - -The current version at $n_site is now: - -`cat $n_src/sys/version.idx` - -Yours truly, - -update.csh -_EOD_ - - endif -# -# -# %Release updates the Export-Master and informs the rest of the world -# - else if ("$Command" =~ [Rr][Ee][Ll]* ) then - if (! $?n_ftp || "$n_site" != nfra) then - log "Error: can only release things from NFRA Master" - else -# -# Enforce working in $n_import -# - if ($PWD != $n_import) then - cd $n_import - echo "--> Now in directory $n_import" - endif -# -# Make sure we have a proper database and documentation archive -# - mv $n_work/update.lock $n_work/update.lock.$$ - $n_src/sys/update.csh check h,d - mv $n_work/update.lock.$$ $n_work/update.lock -# -# Pack fresh archives -# - cd $n_work # Safe place to make archives - log "Making fresh archives..." - mv $n_work/update.lock $n_work/update.lock.$$ - $n_src/sys/update.csh pack server - mv $n_work/update.lock.$$ $n_work/update.lock -# -# Tell nserver what files to unpack -# - set Files=( nstar_hlp.tgz nstar_src.tgz ) - set Flag=( `echo $n_install | tr ',/:' ' ' ` ) - foreach aa ( $Flag ) - set Files=( $Files nstar_src_$aa.tgz ) - end - echo unpack $Files >~/server/server.cmd - log "Waiting for server to update Export-Master" - while (-e ~/server/server.cmd) - sleep 30 - end - if (-e ~/server/server.err) then # something wrong ? - if (! -z ~/server/server.err) then # yes - log "Something went wrong with NSERVER" - cat ~/server/server.err | \ - nsmail "NSERVER error" $n_master - endif - 'rm' -f ~/server/server.err - endif - cd $n_import # Back to import -# -# Now check if we have to let them know... -# - set nonomatch - set Flag=(message.*) - if (! -e $Flag[1]) then - echo "No outstanding releases..." - else -# -# Show messages for convenience -# - foreach File ( $Flag ) - echo "" - echo "Message file ${File}:" - echo "---------------------------------" - grep "===" $File - end - -# -# If more than one release pending, modify last one -# - if ($#Flag > 1 ) then - if (-e $Tmpfile) then - 'rm' -f $Tmpfile - endif - cat $Flag[$#Flag] | awk \ - '{ if (done==0 && $1 != "===") print $0; else if ($1 == "===") done=1; }' \ - >$Tmpfile - grep -h "===" $Flag >>$Tmpfile - cat $Flag[$#Flag] | awk \ - '{ if (done==1 && $1 != "===") print $0; else if ($1 == "===") done=1; }' \ - >>$Tmpfile - - emacs $Tmpfile - mv $Tmpfile $Flag[$#Flag] - endif -# -# Send mail, this relies on an elm alias friends_of_newstar !!!!! -# - echo "Sending out $Flag[$#Flag]" - nsmail "`cat $n_src/sys/version.idx`" friends_of_newstar <$Flag[$#Flag] -# -# Message sent, so move message-file(s) out of the way -# - mv $Flag $n_import/old - endif - unset nonomatch - - endif # Test if allowed to release -# -# -# %Retrieve files over the network -# - else if ("$Command" =~ [Rr][Ee][Tt]* ) then -# -# Enforce working in $n_import -# - if ($PWD != $n_import) then - cd $n_import - echo "--> Now in directory $n_import" - endif -# -# First argument: groupfile to retrieve -# - if ("$Files" != "") then - set grpfile=$Files[1] - set Files[1]=""; if ($#Files > 1) shift Files - else - set grpfile="all" - endif - - set do_check=1 - if ($grpfile =~ [Aa][Ll][Ll] || $grpfile =~ [Aa]) then - if ($grpfile =~ [Aa]) set do_check=0 - set grpfile=sys/database.idx - if (-e database.idx) then # Remove old version if any - 'rm' -f database.idx - endif - endif -# -# Remaining arguments: internet address -# - set tmp=( $n_remote ) - set iaddr=$tmp[1] - set iuser=$tmp[2] - set iroot=$tmp[3] - unset tmp - - set noglob - set Files=( $Files "" "" "" ) # Make sure they exist - if ("$Files[1]" != "") set iaddr=$Files[1] - if ("$Files[2]" != "") set iuser=$Files[2] - if ("$Files[3]" != "") set iroot=$Files[3] - unset noglob -# -# Get password (we do not put that in any file!) -# - set ipass="" - if (${iuser} == anonymous) then - set ipass="${USER}@`domainname`" - else - while ("${ipass}" == "") - echo -n "Enter password for ${iuser}: " - stty -echo; set ipass=($<); stty echo; echo "xyz1jkl" - end - endif - if ($n_site == nfra) then - set tmpcd=" " - set tmpgf=" " - else - set nuse=newstar_use_${C_Date}${C_Time}.$n_site - if ($n_site == wsrt && $iuser == newstar) then - set tmpcd="cd /home/rzmws0/hjv/newstar/use" - else - set tmpcd="cd /pub/incoming" - endif - set tmpgf="put newstar.use $nuse" - endif -# -# Move to $n_import and check wether the file is there, if not get it. -# - if (! -e $grpfile:t) then - ftp -n -v -i $iaddr <<_EOD_ -quote user $iuser -quote pass $ipass -ascii -cd $iroot -get $grpfile $grpfile:t -cd ../import -get $grpfile $grpfile:t -$tmpcd -$tmpgf -bye -_EOD_ - endif - - if (! -e $grpfile:t) then - log "Cannot retrieve $grpfile, try again..." - set Flag="error" - else -# -# Create new overview file of use of Newstar -# Save the current one to .old in case of -# - if ($n_site != nfra) then - if (-e $n_import/newstar.use.old) then - 'rm' -f $n_import/newstar.use.old - endif - mv $n_import/newstar.use $n_import/newstar.use.old - touch $n_import/newstar.use - chmod a+rw $n_import/newstar.use - endif -# -# Find differences between NFRA and local database -# - if ($grpfile == sys/database.idx ) then - if ($do_check) then - log "Creating fresh local database..." - if (-e $n_work/database.idx) then - 'rm' -f $n_work/database.idx - endif - grep '\.exe' $n_import/database.idx >$n_work/database.idx - - set nonomatch - foreach dir ( $n_src/* ) - if ( -d $dir ) then - log "Scanning $dir..." -# -# If in NSTAR_DIR, check dependencies, else just checksum -# - if ("$NSTAR_DIR" =~ *$dir:t* ) then - $n_exe/genaid.exe fstat -i -t:^exe @ $dir/*.grp \ - >>$n_work/database.idx - else - $n_exe/genaid.exe fstat -t:^exe @ $dir/*.grp \ - >>$n_work/database.idx - endif - endif - end - cp $n_work/database.idx $n_src/sys/database.idx - unset nonomatch - endif - - log "Comparing local database and database from $iaddr" - set tmp=$grpfile:t - set grpfile=retrieved.grp - $n_exe/genaid.exe compare -t:^exe $tmp $n_src/sys/database.idx >$Tmpfile - grep -v "lock.idx" $Tmpfile >$grpfile - 'rm' -f $Tmpfile - log "Differences are in $grpfile" - endif - set grpfile=$grpfile:t - set Flag="ok" - endif -# -# General log -# - echo "$C_Date $C_Time - $n_arch - retr $grpfile:t $iaddr $iroot $iuser " >>$n_root/updates.log -# -# -# At nfra: check locks, if anything is locked we should have a problem -# - if ("$Flag" == "ok" && $n_site == nfra) then - echo "" - echo "Checking locks..." - $n_exe/genaid.exe files -t:^exe $grpfile > $Tmpfile - if (-e $n_src/sys/lock.idx) then - set nline = `cat $Tmpfile | wc -l` # Count lines - @ iline = -9 # Means 1 after first increment by 10 - while ($iline < $nline) # Lines left? - @ iline = $iline + 10 # Next series of 10 - foreach file ( `tail -n +$iline $Tmpfile | head -10` ) - set Lock=(` grep $file $n_src/sys/lock.idx `) - if ("$file" != "+doc/nnews.hlp" && "$Lock" != "") then - echo "Warning: $Lock" - set Flag="lock" - endif - unset Lock - end - end - endif - - if ($Flag == "lock") then - cat <<_EOD_ - -Found files that were locked, cannot retrieve. -Please check and edit \$n_src/sys/lock.idx - -_EOD_ - else -# -# Remove old locks, make lock for Newstar manager -# - echo "" - echo "Making locks for files to be retrieved..." - if (-e $n_src/sys/lock.idx) then - set nline = `cat $Tmpfile | wc -l` # Count lines - @ iline = -9 # Means 1 after first increment by 10 - while ($iline < $nline) # Lines left? - @ iline = $iline + 10 # Next series of 10 - foreach file ( `tail -n +$iline $Tmpfile | head -10` ) - echo \ - "+$file locked User=Newstar Date=$C_Date/$C_Time" \ - | tee -a $n_src/sys/lock.idx - end - end - endif - endif - endif -# -# -# Confirm retrieval -# - if ("$Flag" == "ok") then - cat $grpfile | tee -a $Logfile - if ("$Mode" == "Update") then - set Flag="Yes" - else - echo -n "Retrieve these files (y,n)? [y] " - set Flag=($<) - endif - endif - - if ("$Flag" == "" || "$Flag" =~ [Yy]* ) then -# -# Try to get them three times, if all files received, quit as well -# - @ ii = 3 - while ( $ii > 0 ) -# -# Retrieve contents of groupfile, skip files have been retrieved correctly -# - cat <<_EOD_ >$Tmpfile -quote user $iuser -quote pass $ipass -cd $iroot -_EOD_ -# -# With -Import switch, search files in remote $n_import, else below remote $n_src -# - if ($_Import) then - echo "cd ../import" >>$Tmpfile - $n_exe/genaid.exe import -i -t:^exe $grpfile >>$Tmpfile - else - $n_exe/genaid.exe import -c -t:^exe $grpfile >>$Tmpfile - endif - echo bye >>$Tmpfile - - if ( "$ii" != "3") then - log "" - log "Trying again ...." - endif - ftp -n -v -i $iaddr <$Tmpfile | tee -a $Logfile - 'rm' -f $Tmpfile - - log "" - log "Checking retrieved files... " - $n_exe/genaid.exe check -c -t:^exe $grpfile >$Tmpfile - if ( -z $Tmpfile ) then - @ ii = -999 - log "All files received correctly." - else - @ ii = $ii - 1 - log "Not all files received correctly:" - cat $Tmpfile | tee -a $Logfile - endif - 'rm' -f $Tmpfile - end - - if ( $ii == 0) then - cat <<_EOD_ | tee -a $Logfile - -Not all files were retrieved after 3 tries... -You should try once more: nup retrieve $grpfile. -This will only retrieve the missing or defect files. - -_EOD_ - else - set Flag="ok" - endif - endif -# -# Tell the user how to proceed -# - if ("$Flag" == "ok") then - cat <<_EOD_ | tee -a $Logfile - -All files have been correctly retrieved. - -To install the files, please enter: - - nup build $grpfile -Update - -on the following hosts: $n_hosts - -_EOD_ - else - cat <<_EOD_ | tee -a $Logfile - -*************** Retrieve errors occured ********************** - -The log-file will be mailed to $n_master. - -Please inform this account of additional information that might be -connected with the errors (recent change of operation system, disk -space problems etc). The Newstar group will contact you about the -problems as soon as possible. - -***************************************************************** - -_EOD_ - cat $Logfile | \ - nsmail "Newstar_crash_on_$n_site/$n_arch" $n_master - set Mode="Quit" - endif -# -# -# %Clean: Make the directory structure consistent with the groupfiles -# - else if ("$Command" =~ [Cc][Ll]*) then -# -# Scan only relevant groupfiles in master source tree -# - set Home=$cwd - cd $n_src - echo "--> Now in directory "\$n_src -# -# Make sure empty temporary files exist -# - if (-e $Tmpfile.1) then - 'rm' -f $Tmpfile.1 - endif - touch $Tmpfile.1 - - if (-e $Tmpfile.2) then - 'rm' -f $Tmpfile.2 - endif - touch $Tmpfile.2 -# -# No argument: check all directories and files in $n_src itself -# - if ("$Files" == "" ) then - echo "$C_Date $C_Time - $n_arch - clean all " >>$n_root/updates.log - log "Scanning all groupfiles ..." - $n_exe/genaid.exe files -t:^exe */*.grp >$Tmpfile.1 - log "Scanning all files..." - find * -print >$Tmpfile.2 # Remember we are in $n_src -# -# Expand master database, find all files below $n_src -# - else if ($Files[1] =~ [Aa][Ll][Ll]) then - echo "$C_Date $C_Time - $n_arch - clean all (database) " >>$n_root/updates.log - log "Scanning all-files database..." - $n_exe/genaid.exe files -t:^exe $n_src/sys/database.idx >$Tmpfile.1 - log "Scanning all files..." - find * -print | grep -v 'upd.*\.log' >$Tmpfile.2 -# -# Expand all groupfiles in directories, find files in those directories -# - else - echo "$C_Date $C_Time - $n_arch - clean $Files " >>$n_root/updates.log - foreach dir ( $Files ) - if (! -e $dir && -e $n_src/$dir ) set dir=$n_src/$dir - if ( -d $dir ) then - log "Scanning groupfiles and files in $dir..." - $n_exe/genaid.exe files -t:^exe $dir/*.grp >>$Tmpfile.1 - find $dir -print >$Tmpfile.2 # Remember we are in $n_src - endif - end - endif -# -# Sort on filenames -# - log "Sorting contents of groupfiles" - sort -u $Tmpfile.1 >$Tmpfile.1.s - log "Sorting filelist" - sort -u $Tmpfile.2 >$Tmpfile.2.s -# -# Make the difference: -# -# > file means it exists but is not in a groupfile -# < file means it is in a groupfile but does not exist -# - log "Comparing..." - diff $Tmpfile.1.s $Tmpfile.2.s | \ - awk '{ if ($1 == ">" || $1 == "<") print $2}' >$Tmpfile - 'rm' -f $Tmpfile.1 $Tmpfile.1.s $Tmpfile.2 $Tmpfile.2.s -# -# Verify each file -# - set Flag=( `echo $n_install | tr ',/:' ' ' ` ) #get machines to do - set nline = `cat $Tmpfile | wc -l` # Count lines - @ iline = -9 # Means 1 after first increment by 10 - while ($iline < $nline) # Lines left? - @ iline = $iline + 10 # Next series of 10 - foreach file ( `tail -n +$iline $Tmpfile | head -10` ) - if (! -d $file) then - if (-e $file ) then - if ("$_Confirm" == 0) then - 'rm' -f $file - else if ("$file:e" == "" || "$file:e" == "log" || \ - "$file:e" == "tmp" || "$file:e" == "LOG" || \ - "$file:e" == "lis" || "$file:e" == "old" || \ - "$file:e" =~ ?? || "$file:e" =~ ?????* ||\ - "$file" =~ *~ ) then - 'rm' -f $file - else - echo -n "Remove "; 'rm' -i $file - endif - if (-e $file) then - log "$file not deleted" - else - log "$file deleted" - endif - else - if ("$file:e" =~ x?? || "$file:e" =~ a??) then - foreach aa ( $Flag ) - if ("$file:e" =~ ?$aa) then - echo "$file missing ..." - endif - end - else - echo "$file missing ..." - endif - endif - endif - end - end -# -# Back to original directory, clean up -# - 'rm' -f $Tmpfile - echo "--> Back in $Home" - cd $Home - unset Home nonomatch -# -# -# %Check the current implementation of Newstar against the database -# - else if ("$Command" =~ [Cc][Hh]*) then -# -# If no argument given: all -# - if ("$Files[1]" =~ [Aa][Ll][Ll] || "$Files[1]" == "") set Files="fhdle" -# -# General log -# - echo "$C_Date $C_Time - $n_arch - check $Files " >>$n_root/updates.log -# -# Verify all files... -# - if ($Files[1] =~ *f* && -e $n_src/sys/database.idx) then - log "Checking master source tree against database" - set grpfile=$n_import/get${C_Date}.grp - $n_exe/genaid.exe check -t:^exe $n_src/sys/database.idx >$grpfile - - log "" - if (-e $grpfile && ! -z $grpfile) then - log " Created "\$n_import"/get${C_Date}.grp " - cat $grpfile - log "" - log " Update implementation with: nup retrieve get${C_Date}" - else - if (-e $grpfile) then - 'rm' -f $grpfile - endif - log " As far as can be checked, you have a proper source tree" - log " Check for any revisions with: nup retrieve " - endif - log "" - endif -# -# First update the documentation (15 min.) -# - if ($Files[1] =~ *h* ) then - if ("$n_site" == nfra ) then - echo "Updating documentation (15 min.)" - $n_src/sys/document.csh all - set Files[1]="d$Files[1]" - endif - endif -# -# Scan all subdirectories of $n_src and build a new database -# - if ($Files[1] =~ *d* ) then - - if (-e $n_work/database.idx) then - 'rm' -f $n_work/database.idx - endif - grep '\.exe' $n_src/sys/database.idx >$n_work/database.idx - - set nonomatch - foreach dir ( $n_src/* ) - if ( -d $dir ) then - log "Scanning $dir..." -# -# If in NSTAR_DIR, check dependencies, else just checksum -# - if ("$NSTAR_DIR" =~ *$dir:t* ) then - $n_exe/genaid.exe fstat -i -t:^exe @ $dir/*.grp \ - >>$n_work/database.idx - else - $n_exe/genaid.exe fstat -t:^exe @ $dir/*.grp \ - >>$n_work/database.idx - endif - endif - end - cp $n_work/database.idx $n_src/sys/database.idx - unset nonomatch - log "Check current implementation with: nup retrieve " - endif -# -# Integrity check on the libraries -# - if ($Files[1] =~ *l* ) then - log "Checking libraries..." - set grpfile=$n_import/lib${C_Date}$n_arch.grp - if (-e $grpfile) then - 'rm' -f $grpfile - endif - - foreach dir ( dwarf nst wng ) - log " ${dir}lib.olb" - if (-e $Tmpfile) then - 'rm' -f $Tmpfile - endif - if (-e $Tmpfile.1) then - 'rm' -f $Tmpfile.1 - endif - if (-e $Tmpfile.2) then - 'rm' -f $Tmpfile.2 - endif -# -# For each entry: get name and date -# - ar tv $n_lib/${dir}lib.olb | awk '\ -/.*\.o/ { im=NF-4; id=NF-3; iy=NF-1; \ - if ($im == "Jan") mon=1; \ - if ($im == "Feb") mon=2; \ - if ($im == "Mar") mon=3; \ - if ($im == "Apr") mon=4; \ - if ($im == "May") mon=5; \ - if ($im == "Jun") mon=6; \ - if ($im == "Jul") mon=7; \ - if ($im == "Aug") mon=8; \ - if ($im == "Sep") mon=9; \ - if ($im == "Oct") mon=10; \ - if ($im == "Nov") mon=11; \ - if ($im == "Dec") mon=12; \ - printf("%2.2d%2.2d%2.2d %s\n",$iy,mon,$id,$NF); }' | sort >$Tmpfile -# -# Extract relevant part of database -# - if ($dir == nst) then - $n_exe/genaid.exe select \ - -t:s\$/cee/cun/c$n_arch/for/fun/fsc/f$n_arch/dsc \ - $n_src/sys/database.idx | \ - grep '^n.*/' >$Tmpfile.2 - else - $n_exe/genaid.exe select \ - -t:s\$/cee/cun/c$n_arch/for/fun/fsc/f$n_arch/dsc \ - $n_src/sys/database.idx | \ - grep "^${dir}/" >$Tmpfile.2 - endif -# -# Does any symbol occur twice? -# - set nline = `cat $Tmpfile | wc -l` # Count lines - @ iline = -9 # Means 1 after first increment by 10 - while ($iline < $nline) # Lines left? - @ iline = $iline + 10 # Next series of 10 - foreach file ( `tail -n +$iline $Tmpfile | head -10` ) -# -# Store the date field for the next file -# - if ("$file" !~ *.o) then - set fDate=$file - else -# -# Find the entry in the database selection (c/fortran file or dsc-file) -# - set Flag=( `grep '^.*/'$file:r'\.' $Tmpfile.2` ) - if ("$Flag" == "" && $file =~ *_bd.o) then - set dscfile=`echo $file | sed s/_bd.o/.dsc/` - set Flag=( `grep '^.*/'$dscfile $Tmpfile.2` ) - unset dscfile - endif -# -# If no corresponding file in the database, remove the entry... -# - if ("$Flag" == "") then - log "No source in database for $file" - echo $file >>$Tmpfile.1 -# -# If multiple entries: remove all entries and write to groupfile -# - else if (`grep -c " ${file:r}\.o" $Tmpfile` != 1) then - echo $file >>$Tmpfile.1 - log "Multiple entries for $file" - echo +$Flag[1] >>$grpfile -# -# Check the date of the source file in the database against the library -# - else -# -# If too old, log and write to groupfile -# - if ($Flag[2] > $fDate) then - echo $file >>$Tmpfile.1 - log "Out of date: $file ($fDate) $Flag[1] ($Flag[2])" - echo +$Flag[1] >>$grpfile - endif - endif - endif - end # foreach file - end -# -# For all files in the database: check wether the file is in the library -# - set nline = `cat $Tmpfile.2 | wc -l` # Count lines - @ iline = -9 # Means 1 after first increment by 10 - while ($iline < $nline) # Lines left? - @ iline = $iline + 10 # Next series of 10 - foreach file ( `tail -n +$iline $Tmpfile.2 | head -10` ) - if ("$file" =~ *.* && "$file:e" != "dsc") then - set Flag=$file:t - set Flag=${Flag:r}.o - if (`grep -c " $Flag"\$ $Tmpfile` == 0) then - log "$file is not in the archive..." - echo +$file >>$grpfile - endif - endif - end - end -# -# Now do all library operations -# - if (-e $Tmpfile.1 && ! -z $Tmpfile.1) then - set Flag=(`cat $Tmpfile.1`) - if (! $?ARD) setenv ARD "ar dv" - log `$ARD $n_lib/${dir}lib.olb $Flag ` - endif - ranlib $n_lib/${dir}lib.olb - - end # foreach dir -# -# Clean up -# - if (-e $Tmpfile) then - 'rm' -f $Tmpfile - endif - if (-e $Tmpfile.1) then - 'rm' -f $Tmpfile.1 - endif - if (-e $Tmpfile.2) then - 'rm' -f $Tmpfile.2 - endif -# -# Inform user on repairs -# - log "" - if (-e $grpfile && ! -z $grpfile) then - log " Created "\$n_import"/lib${C_Date}$n_arch.grp " - sort -u -o $grpfile $grpfile - log "" - log " Repair libraries with: nup build "\$n_import"/lib${C_Date}$n_arch" -# -# If Update mode: insert extra command to update the libraries -# - if ("$Mode" == "Update") then - set Upd_list=( build $grpfile $Upd_list ) - endif - - else - if (-e $grpfile) then - 'rm' -f $grpfile - endif - log " Libraries seem to be all right" - endif - endif -# -# Check version of executables with respect to database -# - if ($Files[1] =~ *e* ) then -# -# Reset error-count, initialise temp-list -# - @ Errors = 0 - if (-e $Tmpfile) then - 'rm' -f $Tmpfile - endif -# -# Rebuild utility programs always -# - set Input_file=( $n_src/sys/*.c ) -# -# Check any precompiled libraries -# - set Files=(`$n_exe/genaid.exe files -t:a$n_arch $n_src/*/*.grp`) - foreach File ( $Files ) - end -# -# Check any precompiled executables -# - set Files=(`$n_exe/genaid.exe files -t:x$n_arch $n_src/*/*.grp`) - foreach File ( $Files ) - end - - source $n_src/sys/compile.csh -# -# Get list of exe's from groupfiles, check version numbers -# Assume the list of exe's is less than 500... -# - set Files=(`$n_exe/genaid.exe files -t:exe $n_src/*/*.grp`) - foreach File ( $Files ) - if ($File !~ *abpx_* || $?n_doabp ) then - set v_exe=("" "") - set v_idx=("" "") - set File=`echo $File:t | tr '[A-Z]' '[a-z]'` - set Flag="${File}: No executable" - if (-e $n_exe/$File) then - set Flag =( `grep $File $n_src/sys/database.idx` "" "") - set v_idx=( `echo $Flag[2] | awk -F. '{ print $1,$2}' ` "" "" ) - set Flag =( `what $n_exe/$File | grep %NST% ` "" "" ) - set v_exe=( `echo $Flag[2] | awk -F. '{ print $1,$2}' ` "" "" ) - endif - set Input_file="" - if ("$v_exe" == " " || "$v_idx" == " ") then - set Input_file=($File) - else if ("$v_exe" == "" || "$v_idx" == "") then - set Input_file=($File) - else - if ("$v_exe[1]" < "$v_idx[1]" || \ - "$v_exe[2]" < "$v_idx[2]") then - set Input_file=($File) - endif - endif - if ("$Input_file" != "") then - if (`grep -c -i $Input_file $n_src/dwarf/src.grp` != 0) set _Alternate=1 - source $n_src/sys/compile.csh - set _Alternate=0 - set Flag =( `what $n_exe/$File | grep %NST% ` '(updated)' ) - endif - echo $Flag | sed -e s/%NST%// >>$Tmpfile - endif - end -# -# Errors occurred, give a message (different for nfra and elsewhere) -# - if ("$n_site" != nfra) then - if ($Errors != 0 ) then - set Flag=(`cat $n_src/sys/version.idx`) - cat <<_EOD_ | tee -a $Logfile - -*************** Installation errors occured ********************** - -The log-file will be mailed to $n_master. - -Please inform this account of additional information that might be -connected with the errors (recent change of operation system, disk -space problems etc). The Newstar group will contact you about the -problems as soon as possible. - -Your present executables should be still correct. -Your source tree seems to be $Flag for -Your executables seem to be: - -`cat $Tmpfile` - -***************************************************************** - -_EOD_ - cat $Logfile | \ - nsmail "Newstar_crash_on_$n_site/$n_arch" $n_master - set Mode="Quit" - else -# -# No errors: inform NFRA if run on remote site -# - nsmail "Newstar_update_on_$n_site/$n_arch" $n_master <<_EOD_ - -Newstar executables have been updated on $n_site ($n_arch) at $C_Date. - -The current version at $n_site is: - -`cat $n_src/sys/version.idx` - -The executables have version: - -`cat $Tmpfile` - -Yours truly, - -update.csh -_EOD_ - endif - endif - endif -# -# -# %Diff: compare files in $n_import with versions in master -# - else if ("$Command" =~ [Dd]*) then -# -# Enforce working in $n_import -# - if ($PWD != $n_import) then - cd $n_import - echo "--> Now in directory $n_import" - endif -# -# Get groupfile to diff -# - if ("$Files" == "") then - echo -n "Enter name of groupfile to diff: " - set noglob # Don't expand wildcards right now - set Files=( $< ) # Read from stdin - set Files=( $Files ) # Split in multiple words - unset noglob - endif -# -# Expand the groupfile(s) and compare the files -# - foreach grpfile ( $Files ) - if ("$grpfile:e" == "") set grpfile=$grpfile.grp - set dfile=$grpfile.dif - if (-e $dfile) then - 'rm' -f $dfile - endif - echo "Differences introduced by $grpfile" >$dfile - echo "Made at $C_Date/$C_Time on $n_site ($n_arch) " >>$dfile - - $n_exe/genaid.exe files -t:^exe $grpfile >$Tmpfile - - foreach file ( `cat $Tmpfile` ) - if (-e $n_import/$file:t) then - if (-e $n_src/$file) then - echo " " >>$dfile - echo "diff $n_import/$file:t $n_src/$file" >>$dfile - diff $n_import/$file:t $n_src/$file >>$dfile - else - echo " " >>$dfile - echo "New file: $file" >>$dfile - endif - endif - end - more $dfile - log "Differences are listed in $dfile" - end -# -# -# %Save is the backup command -# - else if ("$Command" =~ [Ss]* ) then - set Tapes=( "A" "B" "C") - - set Home=$cwd - cd $n_root - echo " --> Now in directory "\$n_root - - tail backups.txt # Show last backups - set Flag=`tail -1l backups.txt` # Get very last one - if ("$Flag" == "") set Flag="::" - set Tape=(`echo $Flag | awk -F: '{ print $2}'`) # Get last tape - set Unit=(`echo $Flag | awk -F: '{ print $3}'`) # Get previous command - if ("$Tape" == "") set Tape="Unknown" - if ("$Unit" == "") set Unit="$MAG8" - - @ ii = 1 - while ( $ii < $#Tapes && $Tapes[$ii] != $Tape ) - @ ii = $ii + 1 - end - if ( $Tapes[$ii] != $Tape ) then - echo "Unknown tape $Tape..." - set Tape="$Tapes[1]" - else if ( $ii == $#Tapes ) then - set Tape="$Tapes[1]" - else - @ ii = $ii + 1 - set Tape="$Tapes[$ii]" - endif - echo "Suggested tape for backup: ====== $Tape ======" - echo -n "Tape for backup [$Tape]: " - set ans=($<); if ("$ans" != "") set Tape="$ans" - - echo -n "Tapeunit for backup [$Unit]: " - set ans=($<); if ("$ans" != "") set Unit="$ans" - - echo "$C_Date $C_Time - $n_arch - save $Tape $Unit " >>$n_root/updates.log - echo "${C_Date}/${C_Time}/$n_arch($HOST):${Tape}:${Unit}" | tee -a backups.txt -# -# Backup in background, route output by mail -# - if ($n_arch == hp ) then - set Rew="mt -t $Unit rew" - else - set Rew="mt -f $Unit rew" - endif - - ( ( tar cf $Unit *; $Rew; tar tf $Unit ) |& \ - nsmail "Backup of Master tree" $USER@`domainname` )& - - cd $Home -# -# -# %Pack: Another archiving command -# - else if ("$Command" =~ [Pp][Aa][Cc][Kk] ) then - if ("$Files" == "") then - echo -n "Enter name of directory (e.g. src, hlp, exe, nscan, exe/sw): " - set Files=( $< ) - set Files=( $Files ) - endif - -# -# Server: make all archives and copy them to the Export-Master -# - set do_ftp=0 - if ("$Files" =~ [Ss][Ee][Rr][Vv][Ee][Rr]) then - set Files="all" - if (! $?n_ftp || "$n_site" != nfra) then - log "Error: can only copy to Export-Master from NFRA Master" - else - set do_ftp=1 - set ipass="" - while ("${ipass}" == "") - echo -n "Enter password for Newstar on ${n_ftp}: " - stty -echo; set ipass=($<); stty echo; echo "xyz1jkl" - end - endif - endif - -# -# If all files have been asked, check installed architectures from n_install -# - if ("$Files" =~ [Aa][Ll][Ll]) then - set Files=( src hlp lib/inc ) - set Flag=( `echo $n_install | tr ',/:' ' ' ` ) - foreach aa ( $Flag ) - set Files=( $Files lib/$aa exe/$aa ) - end - endif - - foreach dir ( $Files ) - unset Source - if (-d $n_root/$dir ) then - set Source=$n_root/$dir - set tarfile=nstar_$dir.tgz - else if (-d $n_src/$dir ) then - set Source=$n_src/$dir - set tarfile=nstar_src_$dir.tgz - else if (-d $dir ) then - log "Can only tar Newstar Master tree directories" - else - log "Error: directory $dir does not exist" - endif - if ($?Source) then - set tarfile=`echo $tarfile | tr '/' '_'` - if ($cwd =~ $n_src/*) then - set tarfile=$n_src/$tarfile - else - set tarfile=$cwd/$tarfile - endif - if ("$Mode" == "Menu") then - echo -n "Enter name of tarfile [$tarfile]: " - set tmp=($<) - if ("$tmp" != "") set tarfile=$tmp - unset tmp - endif - if (-e $tarfile || -e $tarfile) then - 'rm' $tarfile* - if (! -e $tarfile && ! -e $tarfile) then - log "Removed existing $tarfile" - endif - endif - log "Creating tar-file $tarfile" -# -# Tar the files and compress, exclude core, *.tar* *.x?? *.a?? and *.old -# - set Home=$cwd - cd $Source - echo "Ignore any no match messages..." - if ($dir == "hlp") then - ls core */core *\.tar* *\.tgz* *\.*\.tgz */*\.tar* *\.a?? */*\.a?? \ - *\.old */*\.old >$Tmpfile - - else - ls core */core *\.tar* */*\.tar* *\.*tgz* \.x?? *\.a?? */*\.x?? */*\.a?? \ - *\.old */*\.old >$Tmpfile - - endif - tar czfX $tarfile $Tmpfile * - 'rm' -f $Tmpfile - cd $Home -# -# Copy to export master, also copy updates.html here -# - if ($do_ftp) then - log "Copying $tarfile to the ftp area..." - set tmp=$tarfile:t - ftp -n -v -i $n_ftp <<_EOD_ -quote user newstar -quote pass $ipass -cd /ftp/newstar -binary -put $tarfile $tmp -cd /www/newstar -ascii -put $n_root/updates.html updates.html -bye -_EOD_ -# 'rm' $tarfile - - - - endif -# -# For the source tree, make separate archives for the binaries etc -# - if ("$Source" == "$n_src") then - cd $Source - set Flag=( `echo $n_install | tr ',/:' ' ' ` ) - foreach aa ( $Flag ) - log "Creating tar-file ${tarfile:r}_$aa.tgz" - tar czf ${tarfile:r}_$aa.tgz */*.x$aa */*.a$aa - if ($do_ftp) then - log "Copying ${tarfile:r}_$aa.tgz to the ftp area..." - set tmp=$tarfile:t - ftp -n -v -i $n_ftp <<_EOD_ -quote user newstar -quote pass $ipass -cd /ftp/newstar -binary -put ${tarfile:r}_$aa.tgz ${tmp:r}_$aa.tgz -bye -_EOD_ - 'rm' ${tarfile:r}_$aa.tgz - endif - end - endif - - endif - end - unset Home tarfile dir -# -# %Group Combine or spilt groupfiles -# - else if ("$Command" =~ [Gg]* ) then - - if ("$Files" == "") then - echo "Need to specify at least one groupfile" - else if (`grep -c '^+' $Files[1]` != 0) then - foreach File ($Files) - $n_exe/genaid.exe split $File ${C_Date}_c - end - ls -l *${C_Date}_c.grp - else -# -# Make unique name -# - set grpfile=upd${C_Date}.grp - @ ii = 0 - while (-e $grpfile) - @ ii = $ii + 1 - set grpfile=upd${C_Date}$ii.grp - end - unset ii - echo "\!+$grpfile combined groupfile made by $USER" >$grpfile -# -# Process all groupfiles -# - $n_exe/genaid.exe group $Files >>$grpfile - log "Output is in $grpfile" - endif - - - else # Other command - echo "" - echo "Error: Invalid or ambiguous command $Command" - echo "" - endif # End of if (Command == ...) - -end # End of while (Menu mode) - -Abort_exit: - -# -# Handle any pending library actions left after an abort -# -if ("$_Objectlib" != "") then - set Input_file=$_Objectlib - source $n_src/sys/compile.csh -endif - -if ("$_Textlib" != "") then - set Input_file=$_Textlib - source $n_src/sys/compile.csh -endif - -if (-e $n_work/update.lock) then - 'rm' -f $n_work/update.lock -endif - -if (-e $Tmpfile) then - 'rm' -f $Tmpfile -endif diff --git a/src/sys/update.pls b/src/sys/update.pls deleted file mode 100755 index 107c6232213b34d8288ef4aa6e9636b7a6139f57..0000000000000000000000000000000000000000 --- a/src/sys/update.pls +++ /dev/null @@ -1,2808 +0,0 @@ -#+ update.pls -# created by wbrouw on norma at Mon Jun 20 14:03:14 LST 1994 -#- -#! /bin/csh -f -#+ update.csh -# -# CMV 930524 Created -# CMV 931013 Improved Clean option, added Save, added Group -# CMV 931018 Correct mailer in save option -# CMV 931018 Implemeted -List for retrieve -# CMV 931019 Added library checks -# CMV 931020 Changed call to switches -# CMV 931020 Build -D puts objects in $n_ulib -# CMV 931025 Better text in Save -# CMV 931102 Switch -[N]Check added for dependencies -# CMV 931104 Added automatic mailing for NFRA updates -# CMV 931107 Less output during backup (t in stead of tv) -# CMV 931111 Removed retrieve -l option, added diff command -# CMV 931116 Changed updating log for httpd 1.0 -# CMV 931124 Force editing of nnews after nup b -u at NFRA, -# no longer mail to NFRA after a retrieve, -# moved get and put to shadow.csh -# CMV 931202 Add locking for retrieve option -# CMV 931220 Create subdirectory for checkin -# CMV 931221 Multiple groupfile for new-to-old -# CMV 931221 No .old files in pack -# CMV 931223 Change handling of libraries -# CMV 931223 Some more prevention against "word too long" -# CMV 940214 Revision numbers and change in retrieve procedure -# CMV 940216 Check l spawns rebuild of library -# CMV 940216 New command: update (retrieve revision) -# CMV 940218 Include revision number in executable -# CMV 940304 Add argument all for Pack command -# HjV 940314 Use environment ARD (=ar dv or ar dlv) -# CMV 940323 remsh for HP's -# HjV 940328 FTP info about Newstar use to NFRA -# HjV 940331 PACK: not in background, causes diskquota problems -# CMV 940419 Made test on version in check exe more robust -# CMV 940420 Compile abp executables only if n_doabp set -# HjV 940503 Remove old version of newstar.use -# CMV 940506 Better format in log to revision history -# HjV 940516 CLEAR: Do not print message for other machines binaries -# -# -# -# This is the update script for the Newstar programs -# -# Note for programmers: -# Search for %Blurp gets you to start of code for command Blurp etc. -# -# -# For maintenance of the master system, file information is -# taken from the following databases: -# -# $n_src/sys/version.idx Release and revision number -# $n_src/sys/database.idx Full filesystem database -# $n_src/sys/locks.idx Database with locked files -# $n_src[/*]*.grp Groupfiles with compilation instructions -# -#--------------------------------------------------------------------- -# -# -# -# Check wether we can use update. -# -#+ -# Preamble -# -unless (defined $VMS) { # check for environment - if ($ENV{"SHELL"}) { # aid routines unix - unshift(@INC,$ENV{'n_src'}.'/sys');} - else { # aid routines VMS - unshift(@INC,'N_SRC:[SYS]');} - unless (require 'c2aid.pls') { - print "Fatal: Cannot load c2aid.pls properly"; exit;} - &ENV_IMPORT; # get environment - $argv=join(' ',@ARGV);} # get command arguments -if (&ft("e",&fp("r","$0").".csh") && # renew main routine - (&ft("M","$0") > &ft("M","$n_src/sys/csh2p.pls") || - &ft("M","$0") > &ft("M",&fp("r","$0").".csh"))) { - $status=&system("perl ".&fnp("$n_src/sys/csh2p.pls")." ". - &fp("r","$0"));} -# -# Start translated script -#- -sub update__pls { - if ( ! &ft('o', $n_src ) ) { - &echo( '' , "***** You can only run update as the Newstar" - ." manager..." , "" ) ; - &exit( '' ) ; - } - if ( !&eq( $cwd , $n_src ) && !&peq( $cwd , $n_src ."/*" ) && !&eq( $cwd - , $n_import ) ) { - &echo( '' , "***** You are not allowed to run update from " . $cwd - ."..." , "" ) ; - &echo( '' , "You should be either in " ."\$n_src" . - " or one of it's subdirectories," , "" ) ; - &echo( '' , "or in directory " ."\$n_import" . ", not in " . $cwd - ."..." , "" ) ; - if ( &ft('d', $n_import ) ) { - &cd( &fn( $n_import ) ) ; - &echo( '' , "Now in " . $n_import , "" ) ; - } - else { - &exit( '' ) ; - } - } - $SIG{'INT'}= Abort_exit_update ; -# -# Setup logging, initialise, check filesystem etc. -# - &alias( 'log', '&doalias_x('. ''. '"!*"'. ','. '\'>\''. ','. - '"p$$.tmp00"'. ')'. ';'. '&echo('. - '&D_input(\'sw\')'. ','. '&D_input(\'inw\')'. ','. - '&D_input(\'out\')'. ')'. ';'. '&tee('. '"-a"'. - ','. ''. '&fn('. ''. '$Logfile'. ')'. ','. - '"p$$.tmp00"'. ')'. ';'. '', "") ; - &source( &fn( $n_src ."/sys/initcompile.csh" ) ) ; -# -# Decode switches, get command, or set menu mode if none given. -# - $noglob='' ; $Command= &fn( $argv ) ; undef $noglob ; - $Options= '' ; &source( &fn( $n_src ."/sys/switches.csh" ) ) ; - $Files= '' ; - if ( !&eq( $Command , '' ) ) { - $Mode= "Command" ; - if ( &vn($Command) > 1 ) { - $noglob='' ; $Files= &fn( (split(' ',$Command)) [ 2 -1 .. - &vn($Command)-1 ] ) ; undef $noglob ; - $Command= &fn( (split(' ',$Command)) [ 1 -1 ] ) ; - } - } - else { - $Mode= "Menu" ; - $Command= '' ; - } -# -# -# Check the file system and try to make any missing directories -# - if ( ! &ft('d', $n_lib ) ) { - $n_tmp= &fn( $n_lib ) ; - if ( ! &ft('d', &fp('h', $n_tmp ) ) ) { - &doalias('log' , ">>>>>>>> Creating root of library tree... " . - &fp('h', $n_tmp ) ) ; - &mkdir( &fn( &fp('h', $n_tmp ) ) ) ; - } - &doalias('log' , ">>>>>>>> Creating library directory for " . $n_arch - ."... " . $n_lib ) ; - &mkdir( &fn( $n_lib ) ) ; - if ( ! &ft('d', $n_lib ) ) { - &doalias('log' , " " ) ; - &doalias('log' , "Could not create library directory " . $n_lib - ."..." ) ; - &Abort_exit_update ; - } - } - if ( ! &ft('d', $n_inc ) ) { - &doalias('log' , ">>>>>>>> Creating include directory " . $n_inc ) ; - &mkdir( &fn( $n_inc ) ) ; - if ( ! &ft('d', $n_inc ) ) { - &doalias('log' , " " ) ; - &doalias('log' , "Could not create include directory " . $n_inc - ."..." ) ; - &Abort_exit_update ; - } - } - if ( ! &ft('d', $n_exe ) ) { - $n_tmp= &fn( $n_exe ) ; - if ( ! &ft('d', &fp('h', $n_tmp ) ) ) { - &doalias('log' , ">>>>>>>> Creating root of binary tree... " . - &fp('h', $n_tmp ) ) ; - &mkdir( &fn( &fp('h', $n_tmp ) ) ) ; - } - &doalias('log' , ">>>>>>>> Creating binary directory for " . $n_arch - ."... " . $n_exe ) ; - &mkdir( &fn( $n_exe ) ) ; - if ( ! &ft('d', $n_exe ) ) { - &doalias('log' , " " ) ; - &doalias('log' , "Could not create binary directory " . $n_exe - ."..." ) ; - &Abort_exit_update ; - } - } - if ( ! &ft('d', $n_hlp ) ) { - &doalias('log' , ">>>>>>>> Creating hypertext directory " . $n_hlp ) ; - &mkdir( &fn( $n_hlp ) ) ; - if ( ! &ft('d', $n_hlp ) ) { - &doalias('log' , " " ) ; - &doalias('log' , "Could not create include directory " . $n_hlp - ."..." ) ; - &Abort_exit_update ; - } - } - if ( ! &ft('d', $n_tst ) ) { - $n_tmp= &fn( $n_tst ) ; - if ( ! &ft('d', &fp('h', $n_tmp ) ) ) { - &doalias('log' , ">>>>>>>> Creating root of test binary tree... " . - &fp('h', $n_tmp ) ) ; - &mkdir( &fn( &fp('h', $n_tmp ) ) ) ; - } - &doalias('log' , ">>>>>>>> Creating test binary directory for " . - $n_arch ."... " . $n_tst ) ; - &mkdir( &fn( $n_tst ) ) ; - if ( ! &ft('d', $n_tst ) ) { - &doalias('log' , " " ) ; - &doalias('log' , "Could not create test binary directory " . $n_tst - ."..." ) ; - &Abort_exit_update ; - } - } - if ( ! &ft('d', $n_work ) ) { - $n_tmp= &fn( $n_work ) ; - if ( ! &ft('d', &fp('h', $n_tmp ) ) ) { - &doalias('log' , ">>>>>>>> Creating root of work directory tree... " - . &fp('h', $n_tmp ) ) ; - &mkdir( &fn( &fp('h', $n_tmp ) ) ) ; - } - &doalias('log' , ">>>>>>>> Creating work directory for " . $n_arch - ."... " . $n_work ) ; - &mkdir( &fn( $n_work ) ) ; - if ( ! &ft('d', $n_work ) ) { - &doalias('log' , " " ) ; - &doalias('log' , "Could not create work directory " . $n_work ."..." - ) ; - &Abort_exit_update ; - } - } - if ( ! &ft('d', $n_import ) ) { - &doalias('log' , ">>>>>>>> Creating directory for import... " . - $n_import ) ; - &mkdir( &fn( $n_import ) ) ; - &chmod( "a+rwx" , &fn( $n_import ) ) ; - if ( ! &ft('d', $n_import ) ) { - &doalias('log' , " " ) ; - &doalias('log' , "Could not create import directory " . $n_import - ."..." ) ; - &Abort_exit_update ; - } - } -# -# -# Remove any existing locks and create a new one -# - if ( &ft('e', $n_work ."/update.lock" ) ) { - &echo( '' , "Cannot update on " . $n_arch .": " . &Pipe("p$$.tmp00", - &cat( '' , &fn( $n_work ."/update.lock" ) , - "p$$.tmp00" ) ) , "" ) ; - &echo( "-n" , "Remove " , "" ) ; &rm( "-i" , &fn( $n_work - ."/update.lock" ) ) ; - if ( &ft('e', $n_work ."/update.lock" ) ) { &Abort_exit_update ; } - } - &echo( '' , "Locked by " . $USER ." at " . $C_Date ." " . $C_Time , ''. - &fn( $n_work ."/update.lock" ) ) ; -# -# Check wether the various precompilers exist -# - if ( ! &ft('e', $n_exe ."/genaid.exe" ) ) { - &doalias('log' , "Building utility program genaid (" . $n_exe - ."/genaid.exe)" ) ; - &dollar("CC" , "-o" .' '. &fn( $n_exe ."/genaid.exe" ) .' '. &fn( - $n_src ."/sys/genaid.c" ) , "" ) ; - if ( ! &ft('e', $n_exe ."/genaid.exe" ) ) { &Abort_exit_update ; } - } - if ( ! &ft('e', $n_exe ."/docaid.exe" ) ) { - &doalias('log' , "Building documentation program docaid (" . $n_exe - ."/docaid.exe)" ) ; - &dollar("CC" , "-o" .' '. &fn( $n_exe ."/docaid.exe" ) .' '. &fn( - $n_src ."/sys/docaid.c" ) , "" ) ; - if ( ! &ft('e', $n_exe ."/docaid.exe" ) ) { &Abort_exit_update ; } - } - if ( ! &ft('e', $n_exe ."/wntinc.exe" ) ) { - &doalias('log' , "Missing dsc-compiler (" . $n_exe ."/wntinc.exe)" ) ; - &doalias('log' , "Run update build wntinc to build it first" ) ; -# if ("$Mode" != "Menu") goto Abort_exit - } - if ( ! &ft('e', $n_exe ."/sys_bldppd.exe" ) ) { - &doalias('log' , "Missing ppd-compiler (" . $n_exe ."/sys_bldppd.exe)" - ) ; -# if ("$Mode" != "Menu") goto Abort_exit - } -# -# -# If in Menu mode, repeatedly ask commands, else just one command -# - while ( !&eq( $Mode , "Quit" ) ) { - if ( &eq( $Mode , "Menu" ) ) { - &echo( '' , "Commands are: update, build, cont, check, r" - ."etrieve, clean, " , "" ) ; - &echo( '' , " diff, pack, group, help, q" ."uit" , - "" ) ; - &echo( "-n" , "Enter a command: " , "" ) ; - $Command= ($_=scalar(<STDIN>), chop, $_) ; - $Files= '' ; - $noglob='' ; $Command= &fn( $Command ) ; undef $noglob ; - $Options= '' ; &source( &fn( $n_src ."/sys/switches.csh" ) ) ; - if ( &vn($Command) > 1 ) { - $noglob='' ; $Files= &fn( (split(' ',$Command)) [ 2 -1 .. - &vn($Command)-1 ] ) ; undef $noglob ; - $Command= &fn( (split(' ',$Command)) [ 1 -1 ] ) ; - } - } - elsif ( &eq( $Mode , "Update" ) ) { - $Command= &fn( (split(' ',$Upd_list)) [ 1 -1 ] # Get next command - ) ; - if ( &vn($Upd_list) > 1 ) { - @Upd_list=split(' ',$Upd_list) ; # Get rid of command - shift(@Upd_list) ; $Upd_list=join(' ',@Upd_list) ; - $Files= &fn( (split(' ',$Upd_list)) [ 1 -1 ] # And it's argument - ) ; - if ( &vn($Upd_list) > 1 ) { # Get rid of argument - @Upd_list=split(' ',$Upd_list) ; shift(@Upd_list) ; - $Upd_list=join(' ',@Upd_list) ; } - } - else { - $Files= '' ; - } - } - else { - $Mode= "Quit" ; - } - if ( &eq( $Command , '' ) || &peq( $Command , "[Qq]*" ) ) { - $Mode= "Quit" ; -# -# %Help command: -# - } - elsif ( &peq( $Command , "[Hh]*" ) ) { - sub C2_t1_update { - local(*TMP); - open(TMP,">txt$$.tmp"); - print TMP "#+++++++++++++++++++++++++++++++++++++++++++" - ."++++++++++++++++++++++++++++++#" ."\n" ; - print TMP '' ."\n" ; - print TMP " Update is used for maintenance of the Newst" - ."ar master system. " ."\n" ; - print TMP " You are only allowed to run update when you" - ." are the owner of \$n_root." ."\n" ; - print TMP " " ."\n" ; - print TMP " Update can only be run from the root of the" - ." master source tree (\$n_src), " ."\n" ; - print TMP " from one of it's subdirectories (\$n_src/*)" - ." or from the directory for" ."\n" ; - print TMP " import of new files (\$n_import). Update le" - ."aves a full transaction log" ."\n" ; - print TMP " in \$n_src, with name 'updyymmdd[i].log' (w" - ."here yymmdd is the current " ."\n" ; - print TMP " date and i is an integer 1,2,...)." ."\n" ; - print TMP '' ."\n" ; - print TMP " For program development and debugging, plea" - ."se use the \"shadow\" command," ."\n" ; - print TMP " in particular shadow build." ."\n" ; - print TMP '' ."\n" ; - print TMP " Update can be called in one of the followin" - ."g ways:" ."\n" ; - print TMP '' ."\n" ; - print TMP '' ."\n" ; - print TMP " nup " ."\n" ; - print TMP '' ."\n" ; - print TMP " Enter a menu mode where all options " - ."listed below can be " ."\n" ; - print TMP " chosen. Additional arguments will be" - ." prompted for." ."\n" ; - print TMP '' ."\n" ; - print TMP " nup update" ."\n" ; - print TMP '' ."\n" ; - print TMP " This will check your current impleme" - ."ntation against the" ."\n" ; - print TMP " master copy at NFRA, retrieve any ne" - ."w files, build them," ."\n" ; - print TMP " clean up your local copy and librari" - ."es and rebuild any" ."\n" ; - print TMP " out-of-date executables." ."\n" ; - print TMP '' ."\n" ; - print TMP " nup build [switches | groupfile | 'all" - ."' ] ..." ."\n" ; - print TMP '' ."\n" ; - print TMP " Accepts one or more groupfiles which" - ." should be either " ."\n" ; - print TMP " in the current dir or in a subdirect" - ."ory of the master source " ."\n" ; - print TMP " tree (the extension .grp may be ommi" - ."tted). Normally no switches " ."\n" ; - print TMP " will be given (this is updating the " - ."master, so you should in " ."\n" ; - print TMP " principle hardcode things in files i_" . - $n_arch . $n_site .".csh)." ."\n" ; - print TMP '' ."\n" ; - print TMP " If you specify the -Update switch, e" - ."xecutable files will end up " ."\n" ; - print TMP " in \$n_exe, if you specify -NUpdate " - ."they land in \$n_tst." ."\n" ; - print TMP '' ."\n" ; - print TMP " The groupfiles are scanned and all f" - ."iles contained therein" ."\n" ; - print TMP " that are relevant to this architectu" - ."re are compiled." ."\n" ; - print TMP '' ."\n" ; - print TMP " Processing takes place in a pre-defi" - ."ned order of filetypes," ."\n" ; - print TMP " you may select some types only by us" - ."ing the -Types switch." ."\n" ; - print TMP " You may select to compile only a sub" - ."set of the filetypes by" ."\n" ; - print TMP " setting -Types:ask, which will cause" - ." the update to prompt " ."\n" ; - print TMP " you (in advance) for the requested p" ."asses." - ."\n" ; - print TMP '' ."\n" ; - print TMP " If the groupfile was in \$n_import a" - ."nd no errors occurred then" ."\n" ; - print TMP " all files in the groupfiles (except " - .".exe) are copied into their " ."\n" ; - print TMP " appropriate directory in the Master " - ."source tree. " ."\n" ; - print TMP " Once successfully copied, each file " - ."is unlocked in the locking " ."\n" ; - print TMP " database (lock.idx). The master data" - ."base (database.idx) is" ."\n" ; - print TMP " updated." ."\n" ; - print TMP '' ."\n" ; - print TMP " If there are dependent files (that i" - ."s: files that need to be " ."\n" ; - print TMP " rebuilt because an include file has " - ."been updated), their names" ."\n" ; - print TMP " are stored in \$n_work/depend.grp.Th" - ."is file is processed at the" ."\n" ; - print TMP " end of each pass. This ensures that " - ."any dependencies introduced" ."\n" ; - print TMP " by the dependent files are teated pr" - ."operly (eg. an update of " ."\n" ; - print TMP " a DSF file causes some dependent DSC" - ." files to be rebuilt, and" ."\n" ; - print TMP " these DSC files cause some Fortan an" - ."d C sources to be rebuilt etc." ."\n" ; - print TMP " Checking of dependencies can be disa" - ."bled with the -NCheck switch." ."\n" ; - print TMP " " ."\n" ; - print TMP " The file depend.grp is kept in \$n_w" - ."ork for inspection" ."\n" ; - print TMP '' ."\n" ; - print TMP " The groupfile should explicitly ment" - ."ion the .exe files that " ."\n" ; - print TMP " need to be rebuilt! " ."\n" ; - print TMP '' ."\n" ; - print TMP " nup continue [switches | groupfile | 'a" - ."ll' ] ..." ."\n" ; - print TMP '' ."\n" ; - print TMP " Resumes a build that has crashed som" - ."ewhere. To rebuild some" ."\n" ; - print TMP " files, please edit \$n_work/continue" .".idx" - ."\n" ; - print TMP " " ."\n" ; - print TMP " Use this option with care." ."\n" ; - print TMP " " ."\n" ; - print TMP " nup retrieve ['all' | groupfile [inet-ad" - ."dress [user [directory]]] ]" ."\n" ; - print TMP '' ."\n" ; - print TMP " Default internet specifications are " - ."'all' and the NFRA Master node." ."\n" ; - print TMP '' ."\n" ; - print TMP " If the literal 'all' is specified, t" - ."he Master database will" ."\n" ; - print TMP " be retrieved from the remote node. I" - ."f no local database " ."\n" ; - print TMP " exists, it will be updated (this wil" - ."l take some time but is " ."\n" ; - print TMP " the only safe way to proceed). The m" - ."aster database will be " ."\n" ; - print TMP " checked against the local database. " - ."From this comparison," ."\n" ; - print TMP " a groupfile is constructed." ."\n" ; - print TMP '' ."\n" ; - print TMP " If a groupfile is specified in stead" - ." of 'all', it will be" ."\n" ; - print TMP " retrieved from the remote node if it" - ." does not already exist." ."\n" ; - print TMP '' ."\n" ; - print TMP " All files in the (constructed or ret" - ."rieved) groupfile " ."\n" ; - print TMP " will be retrieved over the network." ."\n" ; - print TMP " To update the files, use the \"nup b" - ."uild retrieved\" command." ."\n" ; - print TMP " All files are received in " . $n_import - .", which should be empty." ."\n" ; - print TMP '' ."\n" ; - print TMP '' ."\n" ; - print TMP " nup diff [groupfile] ..." ."\n" ; - print TMP '' ."\n" ; - print TMP " Compare files in " . $n_import - ." (listed in the groupfile) with the" ."\n" ; - print TMP " versions in the master tree." ."\n" ; - print TMP '' ."\n" ; - print TMP " nup clean [directory | 'all']" ."\n" ; - print TMP '' ."\n" ; - print TMP " Verify the specified directory in th" - ."e source tree against " ."\n" ; - print TMP " the groupfiles in that directory. " ."\n" ; - print TMP " If no directory is specified, check " - ."them all. " ."\n" ; - print TMP " If the literal 'all' is specified, c" - ."heck against the" ."\n" ; - print TMP " the master database (" . $n_src - ."/sys/database.idx)." ."\n" ; - print TMP " Remove (with confirm) any files that" - ." exist but are not " ."\n" ; - print TMP " mentioned in a groupfile," ."\n" ; - print TMP " Report any files that do not exist b" - ."ut are in a groupfile." ."\n" ; - print TMP '' ."\n" ; - print TMP " nup check ['all' | fdl ]" ."\n" ; - print TMP '' ."\n" ; - print TMP " Default for the argument is all" ."\n" ; - print TMP '' ."\n" ; - print TMP " If the argument is all or contains a" ."n f:" - ."\n" ; - print TMP " Verify the master source tree agai" - ."nst the master database." ."\n" ; - print TMP " Checksums, sizes and dates are com" - ."pared. A groupfile is " ."\n" ; - print TMP " created in " . $n_import - ." with entries for defect and missing " ."\n" ; - print TMP " files, this groupfile can be proce" - ."ssed with \"nup retrieve\"." ."\n" ; - print TMP '' ."\n" ; - print TMP " If the argument is all or contains a" ." d:" - ."\n" ; - print TMP " A new master database is created w" - ."hich reflects the current " ."\n" ; - print TMP " situation." ."\n" ; - print TMP '' ."\n" ; - print TMP " If the argument is all or contains a" ."n l:" - ."\n" ; - print TMP " The object libraries are checked f" - ."or double entries and" ."\n" ; - print TMP " out-of-date files." ."\n" ; - print TMP '' ."\n" ; - print TMP '' ."\n" ; - print TMP " nup save" ."\n" ; - print TMP '' ."\n" ; - print TMP " Start a full backup of the master sy" - ."stem (in the background) " ."\n" ; - print TMP " All files below \$n_root will be wri" - ."tten to tape. A log is" ."\n" ; - print TMP " kept in \$n_root/backups.txt. A roul" - ."ating tape pool can be " ."\n" ; - print TMP " used. The actual command for the bac" - ."kup can be specified by" ."\n" ; - print TMP " the user. Default is the command pre" - ."viously used." ."\n" ; - print TMP '' ."\n" ; - print TMP '' ."\n" ; - print TMP " nup pack [name_of_directory... | 'all']" ."\n" ; - print TMP " " ."\n" ; - print TMP " Put all files below the directories " - ."in a tar file (name " ."\n" ; - print TMP " defaults to nstar_name.tar.Z, where " - ."name is the last item " ."\n" ; - print TMP " in the directory specification or, i" - ."f the directory roots in" ."\n" ; - print TMP " " . $n_src .", " . $n_exe ." or " . $n_lib - .": nstar_yyy_name.tar.Z, where" ."\n" ; - print TMP " yyy is either src, exe or lib. " ."\n" ; - print TMP '' ."\n" ; - print TMP " If the literal 'all' is given, archi" - ."ves will be made for the" ."\n" ; - print TMP " source tree, " . $n_inc .", " . $n_hlp - ." and the executable trees for hp " ."\n" ; - print TMP " and sw." ."\n" ; - print TMP " " ."\n" ; - print TMP '' ."\n" ; - print TMP " The following command is an interface b" - ."etween old and new style" ."\n" ; - print TMP " groupfiles for update and retrieval:" ."\n" ; - print TMP '' ."\n" ; - print TMP " nup group groupfile(s)" ."\n" ; - print TMP '' ."\n" ; - print TMP " if a single input groupfile is spe" - ."cified and if it contains" ."\n" ; - print TMP " lines starting with +, it is split" - ." out in a series of files" ."\n" ; - print TMP " for the corresponding directories" ."\n" ; - print TMP " " ."\n" ; - print TMP " otherwise the groupfiles are trans" - ."formed in a single groupfile" ."\n" ; - print TMP " as expected by retrieve." ."\n" ; - print TMP " " ."\n" ; - print TMP "#-------------------------------------------" - ."------------------------------#" ."\n" ; - print TMP '' ."\n" ; - close(TMP); - "txt$$.tmp";} - &cat( '' , &C2_t1_update , "" ) ; -# -# -# %Update command: -# - } - elsif ( &peq( $Command , "[Uu]*" ) ) { -# -# First time, mode will not be Update -# - if ( !&eq( $Mode , "Update" ) ) { -# -# Is it a valid host? -# - $Hosts= &Pipe("p$$.tmp00", &echo( '' , &fn( $n_hosts ) , - "p$$.tmp01" ) , &tr( '' , ',' , ' ' , "p$$.tmp01" , - "p$$.tmp00" ) ) ; - $Flag= '' ; - for $name__x (split(' ',join(' ' , &fn( $Hosts ) ))) { - $name=$name__x ; - if ( &eq( $name , $HOST ) ) { $Flag= &fn( $name ) ; } - } - if ( &eq( $Flag , '' ) ) { - &doalias('log' , "Invalid host " . $HOST - .", you should run on one of " . $n_hosts ) ; -# -# Yes, we run a couple of commands, which one depends on the argument -# - } - elsif ( &eq( $Files , '' ) ) { - &cd( &fn( $n_import ) ) ; - &echo( '' , "Now in " . $n_import , "" ) ; - $_Update= "1" ; # For Build - $_Confirm='' ; # For Clear - $Mode= "Update" ; # Process multiple commands - $Upd_list= "retrieve" .' '. "all" .' '. "build" .' '. "retrieved" - .' '. "clear" .' '. "all" .' '. "check" .' '. "l" - .' '. "check" .' '. "e" .' '. "update" .' '. '' ; - } - elsif ( &eq( $Files , "rsh" ) ) { - &cd( &fn( $n_import ) ) ; - &echo( '' , "Now in " . $n_import , "" ) ; - $_Update= "1" ; # For Build - $_Confirm='' ; # For Clear - $Mode= "Update" ; # Process multiple commands - $Upd_list= "build" .' '. "retrieved" .' '. "check" .' '. "l" - .' '. "check" .' '. "e" .' '. "quit" .' '. '' ; - } - else { - &doalias('log' , "Invalid argument for Update command" ) ; - } -# -# Not first time, we spawn a series of remote commands -# - } - else { - if ( ! defined($RSH) ) { # Make sure we have rsh - $RSH= "rsh" ; &ENV_EXPORT( RSH , "rsh" ) ; - if ( &eq( $n_arch , "hp" ) ) { $RSH= "remsh" ; &ENV_EXPORT( RSH , - "remsh" ) ; } - } - for $name__x (split(' ',join(' ' , &fn( $Hosts ) ))) { - $name=$name__x ; - if ( !&eq( $name , $HOST ) ) { - &echo( '' , "Now trying to update on " . $HOST - ." with command" , "" ) ; - &echo( '' , $RSH ." " . $name ." " , "" ) ; - &echo( '' , "( source " . $n_src ."/sys/newstar_" . $n_site - .".csh; nup update rsh)" , "" ) ; - &dollar("RSH" , &fn( $name ) .' '. '( source ' . $n_src - ."/sys/newstar_" . $n_site .".csh" - .'; nup update rsh)' , "" ) ; - } - } - $Mode= "Quit" ; - } -# -# -# %Build command: -# - } - elsif ( &peq( $Command , "[Bb]*" ) || &peq( $Command , - "[Cc][Oo][Nn][Tt]*" ) ) { - if ( &peq( $Command , "[Bb]*" ) ) { - $Cmd= "build" ; - if ( &ft('e', $n_work ."/continue.idx" ) ) { # Files already done - &rm( "-f" , &fn( $n_work ."/continue.idx" ) ) ; - } - if ( &ft('e', $n_work ."/depend.grp" ) ) { # Remaining dependencies - &rm( "-f" , &fn( $n_work ."/depend.grp" ) ) ; - } - $nonomatch='' ; - $file= &fn( $n_work ."/*.?lb.list" ) ; # Files to be archived - if ( &ft('e', (split(' ',$file)) [ 1 -1 ] ) ) { - &rm( "-f" , &fn( $n_work ."/*.?lb.list" ) ) ; - } - undef $nonomatch ; - } - else { - $Cmd= "cont" ; - } - if ( $_Update ) { - $Cmd= $Cmd ." -U " ; - } - else { - $Cmd= $Cmd ." -NU " ; - $n_uexe= &fn( $n_tst ) ; &ENV_EXPORT( n_uexe # Executables/ppd files in $n_tst - , &fn( $n_tst ) ) ; - } - if ( ! &ft('e', $n_work ."/continue.idx" ) ) { &touch( '' , &fn( - $n_work ."/continue.idx" ) ) ; } - if ( ! &ft('e', $n_work ."/depend.grp" ) ) { &touch( '' , &fn( - $n_work ."/depend.grp" ) ) ; } -# -# Save the current version. We need to increase the version if we update -# from $n_import, and we need to do that only once. -# - $O_Version= &fn( $C_Version ) ; -# -# Get input files, check defaults, prepare for general log -# - if ( &eq( $Mode , "Update" ) ) { $_Types= "^exe" ; } - if ( &eq( $Files , '' ) ) { - &echo( "-n" , "Enter name of groupfile(s) or all: " , "" ) ; - $noglob='' ; # Don't expand wildcards right now - $Files= ($_=scalar(<STDIN>), chop, $_) ; # Read from stdin - $Files= &fn( $Files ) ; # Split in multiple words - undef $noglob ; - } - if ( &eq( $Files , '' ) || &peq( $Files , "[Aa][Ll][Ll]" ) ) { - $Cmd= $Cmd ." -NC all" ; - $Files= $n_src .'/*/???.grp' ; - $_Check='' ; - } - elsif ( &peq( $Files , "[Ww][Nn][Tt][Ii][Nn][Cc]" ) ) { - $Cmd= $Cmd ." -NC wntinc" ; - $Files= &fn( $n_src ."/wng/wnt_boot" ) .' '. &fn( $n_src - ."/wng/wng" ) .' '. &fn( $n_src ."/wng/wnc" ) - .' '. &fn( $n_src ."/wng/wnf" ) .' '. &fn( $n_src - ."/wng/wnt" ) ; - $_Check='' ; - } - elsif ( $_Check ) { - $Cmd= $Cmd ." -C " . $Files ; - } - else { - $Cmd= $Cmd ." -NC " . $Files ; - } -# -# To process files just retrieved, move to $n_import -# - if ( &eq( $Files , "retrieved" ) && !&eq( $PWD , $n_import ) ) { - &cd( &fn( $n_import ) ) ; - &echo( '' , "Now in " . $n_import , "" ) ; - } -# -# -# Expand wildcards, check existence of all files in advance. -# Only files in $n_src/* and $n_import are allowed. -# The current directory will be $n_src, $n_src/* or $n_import. -# - $Input_file= '' ; - $noglob='' ; $nonomatch='' ; - for $File__x (split(' ',join(' ' , &fn( $Files ) ))) { - $File=$File__x ; - if ( &ft('d', $File ) ) { - undef $noglob ; $File= &fn( $File ."/???.grp" ) ; $noglob='' ; - } - elsif ( &eq( &fp('e', $File ) , '' ) ) { - $File= &fn( $File .".grp" ) ; - } - $Input_file= &fn( $Input_file ) .' '. &fn( $File ) ; - } - undef $noglob ; - $Input_file= &fn( $Input_file ) ; - $Files= '' ; - for $File__x (split(' ',join(' ' , &fn( $Input_file ) ))) { - $File=$File__x ; - if ( &ft('e', $File ) ) { - if ( &eq( &fp('h', $File ) , $File ) ) { # Only name given - $File= &fn( $cwd ."/" . $File ) ; - if ( &eq( $cwd , $n_import ) ) { - &doalias('log' , "%%%%%%% Updating " . &fp('t', $File ) - ." from " ."\$n_import..." ) ; - } - } # wrt n_src - elsif ( !&peq( $File , "*/*/" . &fp('t', $File ) ) && &eq( $cwd , - $n_src ) ) { - $File= &fn( $n_src ."/" . $File ) ; - } - if ( &peq( $File , $n_src ."/*/" . &fp('t', $File ) ) || &eq( - $File , $n_import ."/" . &fp('t', $File ) ) ) { - $Files= &fn( $Files ) .' '. &fn( $File ) ; - } - else { - &doalias('log' , "Specify files in Master source tree or " - ."\$n_import" ) ; - &doalias('log' , $File ." ignored." ) ; - } - } - else { - &doalias('log' , "Cannot find groupfile " . $File .", ignored." - ) ; - } - } - undef $nonomatch ; -# -# Select the types to be processed and do global log -# - $typelist= "grp/idx/kwa" .' '. "tex/txt/hlp/html/gif/gfs" .' '. - "scn/wmp/mdl/ngf/flf" .' '. "csh/com/c" ."\$" - .' '. "x" . $n_arch ."/a" . $n_arch .' '. - "inc/dsf/pef/def" .' '. "dsc" .' '. - "f/for/fsc/fun/f" . $n_arch .' '. "cee/csc/cun/c" - . $n_arch ."/s" ."\$" .' '. "exe" .' '. "pin/psc" - ; - if ( !&eq( $_Types , "." ) && !&eq( $_Types , '' ) ) { - if ( &peq( $_Types , "^[Ee][Xx][Ee]" ) ) { - @typelist=split(' ',$typelist); splice(@typelist, "10" -1,1, '' - ); $typelist=join(' ',@typelist); - $typelist= &fn( $typelist ) ; - } - elsif ( !&peq( $_Types , "[Aa][Ss][Kk]" ) ) { - $typelist= $_Types ; - } - else { - &echo( '' , "Selecting file-types to process: " , "" ) ; - $tmp= "groupfiles" .' '. "help files" .' '. "data files" .' '. - "scripts" .' '. "special binaries" .' '. - "include files" .' '. "dsc definition files" .' '. - "fortran sources" .' '. "c sources and macros" - .' '. "executables" .' '. "pin-files" ; - $ii= 1 ; - while ( $ii <= &vn($typelist) ) { - &echo( "-n" , "Do " . (split(' ',$tmp)) [ $ii -1 ] ." (" . - (split(' ',$typelist)) [ $ii -1 ] .")? (y,n) [Y] " - , "" ) ; - $Flag= ($_=scalar(<STDIN>), chop, $_) ; - if ( &peq( $Flag , "[Nn]*" ) ) { - @typelist=split(' ',$typelist); splice(@typelist, - &fn( $ii ) -1,1, '' ); - $typelist=join(' ',@typelist); } - $ii= $ii + 1 ; - } - undef $tmp ; - $typelist= &fn( $typelist ) ; - } - &echo( '' , $C_Date ." " . $C_Time ." - " . $n_arch ." - " . - $Cmd ." (" . $typelist .") " , '>'. &fn( $n_root - ."/updates.log" ) ) ; - } - else { - &echo( '' , $C_Date ." " . $C_Time ." - " . $n_arch ." - " . - $Cmd ." (all) " , '>'. &fn( $n_root - ."/updates.log" ) ) ; - } - $Errors= 0 ; - &doalias('log' , "Logging information in " . $Logfile ) ; - &doalias('log' , "%%%%%%% Errors so far: " . $Errors ." (" . - &Pipe("p$$.tmp00", &date( "p$$.tmp00" ) ) . ")" ) ; -# -# The check flag determines wether we want to do dependecy checking -# - if ( $_Check ) { - $Depend= &fn( $n_work ."/depend.grp" ) ; - } - else { - $Depend= '' ; - &doalias('log' , "%%%%%% No dependency checks" ) ; - } - for $ftype__x (split(' ',join(' ' , &fn( $typelist ) ))) { - $ftype=$ftype__x ; - if ( &eq( $ftype , "exe" ) && !&eq( $Errors , 0 ) ) { - &doalias('log' , "======== Errors found, skip executables ====" - ."===" ) ; - } - else { - &doalias('log' , " " ) ; - &doalias('log' , "======== Pass for filetypes " . $ftype - ." ========" ) ; - for $grpfile__x (split(' ',join(' ' , &fn( $Files ) , &fn( - $Depend ) ))) { $grpfile=$grpfile__x ; - if ( &eq( $grpfile , $n_work ."/depend.grp" ) ) { - &echo( '' , "Checking dependencies..." , "" ) ; - &sort( "-u -o" , &fn( $n_work ."/depend.grp" ) .' '. &fn( - $n_work ."/depend.grp" ) , "" ) ; - } - $Newlib= &fn( &fp('h', $grpfile ) ) ; - if ( &eq( $Newlib , $grpfile ) ) { $Newlib= &fn( &fp('h', $cwd - ) ) ; } - $Newlib= &fn( &fp('t', $Newlib ) ) ; - if ( &peq( $Newlib , "n*" ) ) { $Newlib= "nst" ; } - &doexe( &fn( $n_exe ."/genaid.exe" ) , "expand" .' '. &fn( - "-t:" . $ftype ) .' '. &fn( $grpfile ) , ''. &fn( - $Tmpfile ) ) ; - if ( ! &ft('z', $Tmpfile ) ) { - &doalias('log' , " " ) ; - &doalias('log' , "=== Groupfile " . $grpfile ." " ) ; - } - $nline= &Pipe("p$$.tmp00", &cat( '' , # Count lines - &fn( $Tmpfile ) , "p$$.tmp01" ) , &wc( "-l" , - "p$$.tmp01" , "p$$.tmp00" ) ) ; - $iline= -9 ; # Means 1 after first increment by 10 - while ( $iline < $nline ) { # Lines left? - $iline= $iline + 10 ; # Next series of 10 - for $wfile__x (split(' ',join(' ' , &Pipe("p$$.tmp00", - &tail( "+$iline" , &fn( $Tmpfile ) , "p$$.tmp01" - ) , &head( "-10" , "p$$.tmp01" , "p$$.tmp00" ) ) - ))) { $wfile=$wfile__x ; - if ( &peq( $wfile , "-*" ) || &peq( $wfile , "+*" ) ) { - $Options= "local" .' '. &fn( $wfile ) ; - &source( &fn( $n_src ."/sys/switches.csh" ) ) ; - } - else { - $Flag= &Pipe("p$$.tmp00", &grep( '' , '^' . $wfile .'$' - , &fn( $n_work ."/continue.idx" ) , "p$$.tmp00" ) - ) ; - if ( !&eq( $Flag , '' ) ) { - &doalias('log' , "Skipping " . $wfile - ." (already done)" ) ; - } - elsif ( &peq( $wfile , "abpx_*.exe" ) && ! - defined($n_doabp) ) { - &doalias('log' , "Not compiling abp-executables" ) ; - } - else { - $Input_file= &fn( $wfile ) ; - if ( &eq( $grpfile , $n_import ."/" . &fp('t', - $grpfile ) ) || &eq( $grpfile , $n_work - ."/depend.grp" ) ) { - $Newlib= &fn( &fp('h', $wfile ) ) ; - $Newlib= &fn( &fp('t', $Newlib ) ) ; - if ( &peq( $Newlib , "n*" ) ) { $Newlib= "nst" ; } -# -# If we take a file from $n_import, we have to increase the version number -# - if ( &eq( $cwd , $n_import ) && &ft('e', $n_import - ."/" . &fp('t', $wfile ) ) ) { - $Input_file= &fn( $n_import ."/" . &fp('t', $wfile - ) ) ; - if ( &eq( $O_Version , $C_Version ) ) { - if ( &eq( $n_site , "nfra" ) ) { - $C_Version= &Pipe("p$$.tmp00", &echo( '' , - &fn( $C_Version ) , "p$$.tmp01" ) , &awk( - "-F." , '{ printf "%s.%d",$1,$2+1 }' , - "p$$.tmp01" , "p$$.tmp00" ) ) ; - } - else { - $C_Version= &Pipe("p$$.tmp00", &echo( '' , - &fn( $C_Version ) , "p$$.tmp01" ) , &awk( - "-F." , '{ printf "%s.%d.%d",$1,$2,$3+1 }' , - "p$$.tmp01" , "p$$.tmp00" ) ) ; - } - } - } - } -# -# If this file is in different library, handle pending library operations -# - if ( !&eq( $n_lib ."/" . $Newlib ."lib.olb" , - $_Objectlib ) ) { - &doalias('log' , "Library: " . &fp('t', $_Objectlib - ) ." -> " . $Newlib ."lib.olb" ) ; - if ( !&eq( $_Objectlib , '' ) ) { $Input_file= - &fn( $_Objectlib ) .' '. &fn( $Input_file ) ; } - $_Objectlib= &fn( $n_lib ."/" . $Newlib ."lib.olb" ) - ; - } - if ( !&eq( $n_src ."/" . $Newlib ."lib.olb" , - $_Textlib ) ) { - if ( !&eq( $_Textlib , '' ) ) { - $Input_file= &fn( $n_src ."/" . $_Textlib ) .' '. - &fn( $Input_file ) ; - $_Textlib= &fn( $n_src ."/" . $Newlib ."lib.tlb" ) - ; - } - } -# -# Compile, check dependencies and restore original switches -# - &source( &fn( $n_src ."/sys/compile.csh" ) ) ; - if ( defined($Abort_flag) ) { &Abort_exit_update ; } - &echo( '' , &fn( $wfile ) , '>'. &fn( $n_work - ."/continue.idx" ) ) ; - $wfile= &fn( &fp('t', $wfile ) ) ; - if ( &eq( &fp('e', $wfile ) , "dsc" ) ) { - &grep( '' , "@" . &fp('r', $wfile ) , &fn( $n_src - ."/sys/database.idx" ) , '>'. &fn( $n_work - ."/depend.grp" ) ) ; - } - else { - &grep( '' , "@" . $wfile , &fn( $n_src - ."/sys/database.idx" ) , '>'. &fn( $n_work - ."/depend.grp" ) ) ; - } - if ( !&eq( $Save_switch , '' ) ) { - &set($Save_switch) ; } - } - } - } - } - if ( &ft('e', $Tmpfile ) ) { - &rm( "-f" , &fn( $Tmpfile ) ) ; - } - } - &doalias('log' , "Error so far: " . $Errors ." (" . - &Pipe("p$$.tmp00", &date( "p$$.tmp00" ) ) . ")" ) ; -# -# Handle any pending library actions -# - if ( !&eq( $_Objectlib , '' ) ) { - $Input_file= &fn( $_Objectlib ) ; - &source( &fn( $n_src ."/sys/compile.csh" ) ) ; - } - if ( !&eq( $_Textlib , '' ) ) { - $Input_file= &fn( $_Textlib ) ; - &source( &fn( $n_src ."/sys/compile.csh" ) ) ; - } - } # If exe and errors - } -# -# Check any pending dependencies -# - &echo( '' , "Checking pending dependencies..." , "" ) ; - &sort( "-u -o" , &fn( $n_work ."/depend.grp" ) .' '. &fn( $n_work - ."/depend.grp" ) , "" ) ; - &doexe( &fn( $n_exe ."/genaid.exe" ) , "expand" .' '. &fn( - $grpfile ) , ''. &fn( $Tmpfile ) ) ; - $nline= &Pipe("p$$.tmp00", &cat( '' , &fn( # Count lines - $Tmpfile ) , "p$$.tmp01" ) , &wc( "-l" , - "p$$.tmp01" , "p$$.tmp00" ) ) ; - $iline= -9 ; # Means 1 after first increment by 10 - while ( $iline < $nline ) { # Lines left? - $iline= $iline + 10 ; # Next series of 10 - for $wfile__x (split(' ',join(' ' , &Pipe("p$$.tmp00", &tail( - "+$iline" , &fn( $Tmpfile ) , "p$$.tmp01" ) , - &head( "-10" , "p$$.tmp01" , "p$$.tmp00" ) ) ))) { - $wfile=$wfile__x ; - if ( !&peq( $wfile , "-*" ) && !&peq( $wfile , "+*" ) ) { - $Flag= &Pipe("p$$.tmp00", &grep( '' , '^' . $wfile .'$' , - &fn( $n_work ."/continue.idx" ) , "p$$.tmp00" ) ) - ; - if ( &eq( $Flag , '' ) ) { &echo( '' , - "Error: remaining dependency " . $wfile , "" ) ; } - } - } - } - &doalias('log' , "Total number of errors: " . $Errors ) ; - &doalias('log' , "Logging information in " . $Logfile ) ; -# -# -# Compilation errors -# - if ( !&eq( $Errors , 0 ) ) { - &doalias('log' , "Compilation errors: cannot move files into " . - $n_src ."..." ) ; -# -# -NUp was used, do not update files in the master tree -# - } - elsif ( ! $_Update ) { - &doalias('log' , "You used -NUpdate, the master source tree re" - ."mains intact" ) ; -# -# If it was an update, no errors occurred, and we were working in $n_import, -# then files can be moved in the master source tree. -# - } - elsif ( &eq( $cwd , $n_import ) ) { -# -# Remove references to groupfiles not in $n_import -# - $Flag= '' ; - for $grpfile__x (split(' ',join(' ' , &fn( $Files ) ))) { - $grpfile=$grpfile__x ; - if ( &ft('e', $n_import ."/" . &fp('t', $grpfile ) ) ) { $Flag= - &fn( $Flag ) .' '. &fn( $grpfile ) ; } - } - $Files= &fn( $Flag ) ; -# -# Move files in the master (if that is still necessary) -# - $files_moved= 0 ; - for $grpfile__x (split(' ',join(' ' , &fn( $Files ) ))) { - $grpfile=$grpfile__x ; - &doexe( &fn( $n_exe ."/genaid.exe" ) , "files" .' '. "-t:^exe" - .' '. &fn( $grpfile ) , ''. &fn( $Tmpfile ) ) ; - $nline= &Pipe("p$$.tmp00", &cat( '' , # Count lines - &fn( $Tmpfile ) , "p$$.tmp01" ) , &wc( "-l" , - "p$$.tmp01" , "p$$.tmp00" ) ) ; - $iline= -9 ; # Means 1 after first increment by 10 - while ( $iline < $nline ) { # Lines left? - $iline= $iline + 10 ; # Next series of 10 - for $file__x (split(' ',join(' ' , &Pipe("p$$.tmp00", &tail( - "+$iline" , &fn( $Tmpfile ) , "p$$.tmp01" ) , - &head( "-10" , "p$$.tmp01" , "p$$.tmp00" ) ) ))) { - $file=$file__x ; -# -# If the file does no longer exist in $n_import is has been moved in -# $n_src earlier, so no need to worry. -# - if ( &ft('e', $n_import ."/" . &fp('t', $file ) ) ) { - $files_moved= $files_moved + 1 ; - if ( !&eq( &fp('h', $file ) , '' ) && ! &ft('d', - $n_src ."/" . &fp('h', $file ) ) ) { - &mkdir( &fn( $n_src ."/" . &fp('h', $file ) ) ) ; - &echo( '' , "Created subdirectory " . &fp('h', $file ) - , "" ) ; - } - $Flag= &fn( &fp('t', $file ) ) ; - if ( &ft('e', $n_ulib ."/" . &fp('r', $Flag ) .".o" ) ) { - &rm( "-f" , &fn( $n_ulib ."/" . &fp('r', $Flag ) .".o" - ) ) ; - } - if ( &ft('e', $n_lib ."/" . &fp('r', $Flag ) .".o" ) ) { - &rm( "-f" , &fn( $n_lib ."/" . &fp('r', $Flag ) .".o" ) - ) ; - } - if ( &ft('e', $n_src ."/" . $file ) ) { - &mv( '' , &fn( $n_src ."/" . $file ) .' '. &fn( $n_src - ."/" . $file .".old" ) ) ; - } - &cp( '' , &fn( $n_import ."/" . &fp('t', $file ) ) .' '. - &fn( $n_src ."/" . $file ) ) ; - $Flag= &Pipe("p$$.tmp00", &cmp( &fn( $n_import ."/" . - &fp('t', $file ) ) .' '. &fn( $n_src ."/" . $file - ) , "p$$.tmp00" ) ) ; - if ( !&eq( $Flag , '' ) ) { - &doalias('log' , "Error moving " . &fp('t', $file ) - .": " . $Flag ) ; - $Errors= $Errors + 1 ; - if ( &ft('e', $n_src ."/" . $file .".old" ) ) { - &mv( '' , &fn( $n_src ."/" . $file .".old" ) .' '. - &fn( $n_src ."/" . $file ) ) ; - } - } - else { -# -# At nfra: also move the file to the ftp area -# - if ( &eq( $n_site , "nfra" ) && defined($n_ftp) ) { -# if ("$file:h" != "") then -# set Flag=(`rsh $n_ftp \ -# 'if ( -d ~ftp/newstar/'$file:h' ) echo ok' `) -# if ("$Flag" != "ok") then -# (rsh $n_ftp mkdir '~ftp/newstar/'$file:h )|\ -# tee -a $Logfile -# echo 'Created subdirectory ~ftp/newstar/'$file:h -# endif -# endif - &rsh( &fn( $n_ftp ) , "cp" .' '. &fn( $n_import ."/" - . &fp('t', $file ) ) .' '. '~ftp/newstar/src/' . - $file , "" , "p$$.tmp00" ) ; &tee( "-a" , &fn( - $Logfile ) , "p$$.tmp00" ) ; - } -# -# Update database.idx: for NSTAR_DIR check dependencies, else just checksum -# - &cp( '' , &fn( $n_src ."/sys/database.idx" ) .' '. &fn( - $n_work ."/database.old" ) ) ; - &grep( "-v" , &fn( $file ) , &fn( $n_work - ."/database.old" ) , ''. &fn( $n_src - ."/sys/database.idx" ) ) ; - $dir= &fn( &fp('h', $file ) ) ; - if ( &peq( $NSTAR_DIR , "*" . &fp('t', $dir ) ."*" ) - ) { - &doexe( &fn( $n_exe ."/genaid.exe" ) , "fstat" .' '. - "-i" .' '. "-c" .' '. &fn( $n_src ."/" . $file ) , - '>'. &fn( $n_src ."/sys/database.idx" ) ) ; - } - else { - &doexe( &fn( $n_exe ."/genaid.exe" ) , "fstat" .' '. - "-c" .' '. &fn( $n_src ."/" . $file ) , '>'. &fn( - $n_src ."/sys/database.idx" ) ) ; - } - &cp( '' , &fn( $n_src ."/sys/lock.idx" ) .' '. &fn( - $n_work ."/lock.old" ) ) ; - &grep( "-v" , &fn( $file ) , &fn( $n_work ."/lock.old" - ) , ''. &fn( $n_src ."/sys/lock.idx" ) ) ; - &rm( "-f" , &fn( $n_import ."/" . &fp('t', $file ) ) ) - ; - &doalias('log' , $file - ." updated in master tree and database." ) ; - } - } - } - } - &rm( "-f" , &fn( $Tmpfile ) ) ; - } -# -# -# Errors moving files into the master, indicate with revision number -# - if ( !&eq( $Errors , 0 ) ) { - &doalias('log' , "Errors moving files into the master..." ) ; - &echo( '' , "*** Incomplete revision *** " , '>'. &fn( $n_src - ."/sys/version.idx" ) ) ; -# -# We moved files into the master, so we have a new revision. -# - } - elsif ( !&eq( $files_moved , 0 ) ) { - &mv( '' , &fn( $n_src ."/sys/version.idx" ) .' '. &fn( $n_src - ."/sys/version.idx.old" ) ) ; - &echo( '' , "Newstar Release " . $C_Version , ''. &fn( $n_src - ."/sys/version.idx" ) ) ; -# -# Flag a local revision -# - if ( !&eq( $n_site , "nfra" ) ) { - if ( &eq( &Pipe("p$$.tmp00", &cat( '' , &fn( $Files ) , - "p$$.tmp01" ) , &grep( "-c +sys/version.idx" , '' , - "p$$.tmp01" , "p$$.tmp00" ) ) , 0 ) ) { &echo( '' , - "*** Local revision ***" , '>'. &fn( $n_src - ."/sys/version.idx" ) ) ; } -# -# -# If this is the NFRA master, update revision history and nnews.hlp -# - } - else { - sub C2_t2_update { - local(*TMP); - open(TMP,">txt$$.tmp"); - print TMP '' ."\n" ; - print TMP "<DT>" . $C_Date ." <STRONG>" . &Pipe("p$$.tmp00", - &cat( '' , &fn( $n_src ."/sys/version.idx" ) , - "p$$.tmp00" ) ) ."</STRONG>" ."\n" ; - close(TMP); - "txt$$.tmp";} - &cat( '' , &C2_t2_update , '>'. &fn( $n_root - ."/server/newstar/updates.html" ) ) ; - &echo( '' , "1 NNews" , ''. &fn( $Tmpfile ) ) ; - for $grpfile__x (split(' ',join(' ' , &fn( $Files ) ))) { - $grpfile=$grpfile__x ; - $Flag= "File " . &fp('t', $grpfile ) ." updated" ; - if ( &eq( &Pipe("p$$.tmp00", &grep( "-c" , $Flag , &fn( - $n_root ."/updates.log" ) , "p$$.tmp00" ) ) , 0 ) - ) { - &echo( '' , $C_Date ." " . $C_Time ." - " . $n_arch - ." - " . $Flag , '>'. &fn( $n_root ."/updates.log" - ) ) ; -# -# Add it to the index of updates -# - sub C2_t3_update { - local(*TMP); - open(TMP,">txt$$.tmp"); - print TMP "<DT>" . $C_Date - ." <A HREF=/htbin/nview/import/" . &fp('t', - $grpfile ) .">" . &fp('t', $grpfile ) ."</A>" ."\n" - ; - print TMP &Pipe("p$$.tmp00", &grep( '' , 'Subject:' , - &fn( $grpfile ) , "p$$.tmp01" ) , &sed( "-e" , - 's/\!.*Subject:/<DD>/' , "p$$.tmp01" , "p$$.tmp00" - ) ) ." " ."\n" ; - close(TMP); - "txt$$.tmp";} - &cat( '' , &C2_t3_update , '>'. &fn( $n_root - ."/server/newstar/updates.html" ) ) ; -# -# Update nnews and add it to the grpfile -# - &echo( "-n" , " " . $C_Date , '>'. &fn( $Tmpfile ) ) ; - &grep( '' , "Subject:" , &fn( $grpfile ) , "p$$.tmp00" ) - ; &sed( "-e" , 's/\!.*Subject://' , "p$$.tmp00" , - '>'. &fn( $Tmpfile ) ) ; - &echo( '' , "+doc/nnews.hlp" , '>'. &fn( $grpfile ) ) ; -# -# Check wether it solved a bug, if so: release it -# - if ( !&eq( &Pipe("p$$.tmp00", &grep( "-c -e" , '- bug ' , - &fn( $grpfile ) , "p$$.tmp00" ) ) , 0 ) ) { - $Bug= &Pipe("p$$.tmp00", &grep( "-e" , '- bug ' , &fn( - $grpfile ) , "p$$.tmp00" ) ) ; - sub C2_t4_update { - local(*TMP); - open(TMP,">txt$$.tmp"); - print TMP "Done with update" ."\n" ; - print TMP "import/" . &fp('t', $grpfile ) ."\n" ; - print TMP "n" ."\n" ; - print TMP "y" ."\n" ; - close(TMP); - "txt$$.tmp";} - &docsh( &fn( $n_src ."/sys/bugreport.csh" ) , "release" - .' '. &fn( (split(' ',$Bug)) [ &vn($Bug) -1 ] ) - .' '. &C2_t4_update , "" ) ; - } - } # if (first update) - } # foreach grpfile () -# -# Append the remainder of nnews.hlp and put the new version in the system -# - &tail( "+2l" , &fn( $n_src ."/doc/nnews.hlp" ) , '>'. &fn( - $Tmpfile ) ) ; - &mv( '' , &fn( $n_src ."/doc/nnews.hlp" ) .' '. &fn( $n_src - ."/doc/nnews.hlp.old" ) ) ; - &mv( '' , &fn( $Tmpfile ) .' '. &fn( $n_src - ."/doc/nnews.hlp" ) ) ; - &rm( "-f" , &fn( $Tmpfile ) ) ; -# -# Compose a mail message about this fresh release. -# - $Flag= "Newstar Release " . $C_Version ; - sub C2_t5_update { - local(*TMP); - open(TMP,">txt$$.tmp"); - print TMP '' ."\n" ; - print TMP "From: The Newstar Master account" ."\n" ; - print TMP "To: All Friends of Newstar" ."\n" ; - print TMP '' ."\n" ; - print TMP "Concern: " . $Flag ."\n" ; - print TMP '' ."\n" ; - print TMP '' ."\n" ; - print TMP - " Dwingeloo, " - . $C_Date ."\n" ; - print TMP '' ."\n" ; - print TMP "Dear Friends of Newstar," ."\n" ; - print TMP '' ."\n" ; - print TMP "A new Newstar revision has just been install" - ."ed in the Master system at NFRA:" ."\n" ; - print TMP '' ."\n" ; - print TMP &Pipe("p$$.tmp00", &cat( '' , &fn( $Files ) , - "p$$.tmp01" ) , &grep( '' , "Subject:" , - "p$$.tmp01" , "p$$.tmp02" ) , &tr( '' , '\!' , ' ' - , "p$$.tmp02" , "p$$.tmp00" ) ) ."\n" ; - print TMP '' ."\n" ; - print TMP "To upgrade your installation, login as the N" - ."ewstar manager, initialise" ."\n" ; - print TMP "the Newstar environment (e.g. source ~newsta" - ."r/src/sys/newstar_????.csh) " ."\n" ; - print TMP "and enter:" ."\n" ; - print TMP '' ."\n" ; - print TMP " nup update" ."\n" ; - print TMP '' ."\n" ; - print TMP "and follow the instructions given by that co" - ."mmand." ."\n" ; - print TMP '' ."\n" ; - print TMP "Please direct any problems or questions to " . - $n_master ."\n" ; - print TMP '' ."\n" ; - print TMP '' ."\n" ; - print TMP "Your sincerely," ."\n" ; - print TMP '' ."\n" ; - print TMP "The Newstar Project Team." ."\n" ; - print TMP '' ."\n" ; - print TMP '' ."\n" ; - print TMP "PS: Groupfiles involved in this update: " ."\n" ; - close(TMP); - "txt$$.tmp";} - &cat( '' , &C2_t5_update , ''. &fn( "message." . $C_Version ) - ) ; - for $grpfile__x (split(' ',join(' ' , &fn( $Files ) ))) { - $grpfile=$grpfile__x ; - &echo( '' , " " . &fp('t', $grpfile ) ." " , '>'. &fn( - "message." . $C_Version ) ) ; - } -# -# Give an oppurtunity to edit the message and the subjects -# (some people give those weird subjects in their groupfiles...) -# - &mem( &fn( $n_src ."/doc/nnews.hlp" ) .' '. &fn( "message." . - $C_Version ) ) ; -# -# This relies on an elm alias friends_of_newstar !!!!! -# - &elm( "-s" , $Flag .' '. "friends_of_newstar" , &fn( - "message." . $C_Version ) ) ; -# -# We changed files in the master, so update the database -# - $Input_file= &fn( $n_src ."/sys/version.idx" ) .' '. &fn( - $n_src ."/doc/nnews.hlp" ) ; - &source( &fn( $n_src ."/sys/compile.csh" ) ) ; - &cp( '' , &fn( $n_src ."/sys/database.idx" ) .' '. &fn( - $n_work ."/database.old" ) ) ; - &grep( "-v +doc/nnews.hlp" , &fn( $n_work ."/database.old" ) , - "" , "p$$.tmp00" ) ; &grep( "-v +sys/version.idx" , - '' , "p$$.tmp00" , ''. &fn( $n_src - ."/sys/database.idx" ) ) ; - &doexe( &fn( $n_exe ."/genaid.exe" ) , "fstat" .' '. &fn( - $n_src ."/sys/version.idx" ) .' '. &fn( $n_src - ."/doc/nnews.hlp" ) , '>'. &fn( $n_src - ."/sys/database.idx" ) ) ; -# -# Finally move database.idx, version.idx, nnews.hlp, lock.idx -# and the groupfiles to the ftp area -# - if ( defined($n_ftp) ) { - &rsh( &fn( $n_ftp ) , "cp" .' '. &fn( $n_src - ."/sys/database.idx" ) .' '. '~ftp/newstar/src/sys' - , "" , "p$$.tmp00" ) ; &tee( "-a" , &fn( $Logfile - ) , "p$$.tmp00" ) ; - &rsh( &fn( $n_ftp ) , "cp" .' '. &fn( $n_src - ."/sys/lock.idx" ) .' '. '~ftp/newstar/src/sys' , - "" , "p$$.tmp00" ) ; &tee( "-a" , &fn( $Logfile ) - , "p$$.tmp00" ) ; - &rsh( &fn( $n_ftp ) , "cp" .' '. &fn( $n_src - ."/sys/version.idx" ) .' '. '~ftp/newstar/src/sys' - , "" , "p$$.tmp00" ) ; &tee( "-a" , &fn( $Logfile - ) , "p$$.tmp00" ) ; - &rsh( &fn( $n_ftp ) , "cp" .' '. &fn( $n_src - ."/doc/nnews.hlp" ) .' '. '~ftp/newstar/src/doc' , - "" , "p$$.tmp00" ) ; &tee( "-a" , &fn( $Logfile ) - , "p$$.tmp00" ) ; - &rsh( &fn( $n_ftp ) , "cp" .' '. &fn( $Files ) .' '. - '~ftp/newstar/import' , "" , "p$$.tmp00" ) ; &tee( - "-a" , &fn( $Logfile ) , "p$$.tmp00" ) ; - } - } # if (nfra) - } # if (files_moved) - } # if (in import) -# -# -# Errors occurred, give a message (different for nfra and elsewhere) -# - if ( !&eq( $Errors , 0 ) ) { - if ( &eq( $n_site , "nfra" ) ) { - sub C2_t6_update { - local(*TMP); - open(TMP,">txt$$.tmp"); - print TMP '' ."\n" ; - print TMP "Errors during execution of " . $Cmd ."\n" ; - print TMP '' ."\n" ; - print TMP "Libraries and \$n_inc have most probably bee" - ."n cluttered. " ."\n" ; - print TMP - "Either correct the errors and try again: nup build " - . &fp('t', $grpfile ) .", " ."\n" ; - print TMP "or reconstruct the libraries etc. (only the " - ."potentially damaged files):" ."\n" ; - print TMP " cd \$n_src; nup build \$n_import/" . &fp('t', - $grpfile ) ."\n" ; - print TMP '' ."\n" ; - close(TMP); - "txt$$.tmp";} - &cat( '' , &C2_t6_update , "p$$.tmp00" ) ; &tee( "-a" , &fn( - $Logfile ) , "p$$.tmp00" ) ; - } - else { - $Flag= &Pipe("p$$.tmp00", &cat( '' , &fn( $n_src - ."/sys/version.idx" ) , "p$$.tmp00" ) ) ; - sub C2_t7_update { - local(*TMP); - open(TMP,">txt$$.tmp"); - print TMP '' ."\n" ; - print TMP "*************** Installation errors occured " - ."**********************" ."\n" ; - print TMP '' ."\n" ; - print TMP "The log-file will be mailed to " . $n_master ."." - ."\n" ; - print TMP '' ."\n" ; - print TMP "Please inform this account of additional inf" - ."ormation that might be" ."\n" ; - print TMP "connected with the errors (recent change of " - ."operation system, disk" ."\n" ; - print TMP "space problems etc). The Newstar group will " - ."contact you about the " ."\n" ; - print TMP "problems as soon as possible." ."\n" ; - print TMP '' ."\n" ; - print TMP "Your present executables are still correct. " ."\n" - ; - print TMP "You seem to have " . $Flag ."\n" ; - print TMP '' ."\n" ; - print TMP "********************************************" - ."*********************" ."\n" ; - print TMP '' ."\n" ; - close(TMP); - "txt$$.tmp";} - &cat( '' , &C2_t7_update , "p$$.tmp00" ) ; &tee( "-a" , &fn( - $Logfile ) , "p$$.tmp00" ) ; - &cat( '' , &fn( $Logfile ) , "p$$.tmp00" ) ; &elm( "-s" , - "Newstar_crash_on_" . $n_site ."/" . $n_arch .' '. - &fn( $n_master ) , "p$$.tmp00" ) ; - $Mode= "Quit" ; - } -# -# No errors: inform NFRA if run on remote site -# - } - elsif ( !&eq( $n_site , "nfra" ) ) { - sub C2_t8_update { - local(*TMP); - open(TMP,">txt$$.tmp"); - print TMP '' ."\n" ; - print TMP "Newstar has been updated on " . $n_site ." (" . - $n_arch .") at " . $C_Date .":" ."\n" ; - print TMP '' ."\n" ; - print TMP " " . $Cmd ."\n" ; - print TMP '' ."\n" ; - print TMP "The current version at " . $n_site ." is now:" ."\n" - ; - print TMP '' ."\n" ; - print TMP &Pipe("p$$.tmp00", &cat( '' , &fn( $n_src - ."/sys/version.idx" ) , "p$$.tmp00" ) ) ."\n" ; - print TMP '' ."\n" ; - print TMP "Yours truly," ."\n" ; - print TMP '' ."\n" ; - print TMP "update.csh" ."\n" ; - close(TMP); - "txt$$.tmp";} - &elm( "-s" , "Newstar_update_on_" . $n_site ."/" . $n_arch .' '. - &fn( $n_master ) , &C2_t8_update ) ; - } -# -# -# %Retrieve files over the network -# - } - elsif ( &peq( $Command , "[Rr]*" ) ) { -# -# Enforce working in $n_import -# - if ( !&eq( $PWD , $n_import ) ) { - &cd( &fn( $n_import ) ) ; - &echo( '' , "--> Now in directory " . $n_import , "" ) ; - } -# -# First argument: groupfile to retrieve -# - if ( !&eq( $Files , '' ) ) { - $grpfile= &fn( (split(' ',$Files)) [ 1 -1 ] ) ; - @Files=split(' ',$Files); splice(@Files, "1" -1,1, '' ); - $Files=join(' ',@Files); if ( &vn($Files) > 1 ) { - @Files=split(' ',$Files) ; shift(@Files) ; - $Files=join(' ',@Files) ; } - } - else { - $grpfile= "all" ; - } - $do_check= "1" ; - if ( &peq( $grpfile , "[Aa][Ll][Ll]" ) || &peq( $grpfile , "[Aa]" ) - ) { - if ( &peq( $grpfile , "[Aa]" ) ) { $do_check='' ; } - $grpfile= "sys/database.idx" ; - if ( &ft('e', "database.idx" ) ) { # Remove old version if any - &rm( "-f" , "database.idx" ) ; - } - } -# -# Remaining arguments: internet address -# - $tmp= &fn( $n_remote ) ; - $iaddr= &fn( (split(' ',$tmp)) [ 1 -1 ] ) ; - $iuser= &fn( (split(' ',$tmp)) [ 2 -1 ] ) ; - $iroot= &fn( (split(' ',$tmp)) [ 3 -1 ] ) ; - undef $tmp ; - $noglob='' ; - $Files= &fn( $Files ) .' '. '' .' '. '' # Make sure they exist - .' '. '' ; - if ( !&eq( (split(' ',$Files)) [ 1 -1 ] , '' ) ) { $iaddr= &fn( - (split(' ',$Files)) [ 1 -1 ] ) ; } - if ( !&eq( (split(' ',$Files)) [ 2 -1 ] , '' ) ) { $iuser= &fn( - (split(' ',$Files)) [ 2 -1 ] ) ; } - if ( !&eq( (split(' ',$Files)) [ 3 -1 ] , '' ) ) { $iroot= &fn( - (split(' ',$Files)) [ 3 -1 ] ) ; } - undef $noglob ; -# -# Get password (we do not put that in any file!) -# - $ipass= '' ; - if ( &eq( $iuser , "anonymous" ) ) { - $ipass= $USER ."@" . &Pipe("p$$.tmp00", &domainname( "p$$.tmp00" - ) ) ; - } - else { - while ( &eq( $ipass , '' ) ) { - &echo( "-n" , "Enter password for " . $iuser .": " , "" ) ; - &stty( "-echo" ) ; $ipass= ($_=scalar(<STDIN>), chop, $_) ; - &stty( "echo" ) ; &echo( '' , "xyz1jkl" , "" ) ; - } - } - $nuse= &fn( "newstar_use_" . $C_Date . $C_Time ."." . $n_site ) ; -# -# Move to $n_import and check wether the file is there, if not get it. -# - if ( ! &ft('e', &fp('t', $grpfile ) ) ) { - sub C2_t9_update { - local(*TMP); - open(TMP,">txt$$.tmp"); - print TMP "quote user " . $iuser ."\n" ; - print TMP "quote pass " . $ipass ."\n" ; - print TMP "ascii" ."\n" ; - print TMP "cd " . $iroot ."\n" ; - print TMP "get " . $grpfile ." " . &fp('t', $grpfile ) ."\n" ; - print TMP "cd ../import" ."\n" ; - print TMP "get " . $grpfile ." " . &fp('t', $grpfile ) ."\n" ; - print TMP "cd /pub/incoming" ."\n" ; - print TMP "put newstar.use " . $nuse ."\n" ; - print TMP "bye" ."\n" ; - close(TMP); - "txt$$.tmp";} - &ftp( "-n -v -i" , &fn( $iaddr ) .' '. &C2_t9_update , "" ) ; - } - if ( ! &ft('e', &fp('t', $grpfile ) ) ) { - &doalias('log' , "Cannot retrieve " . $grpfile .", try again..." ) - ; - $Flag= "error" ; - } - else { -# -# Create new overview file of use of Newstar -# Save the current one to .old in case of -# - if ( &ft('e', $n_import ."/newstar.use.old" ) ) { - &rm( "-f" , &fn( $n_import ."/newstar.use.old" ) ) ; - } - &mv( '' , &fn( $n_import ."/newstar.use" ) .' '. &fn( $n_import - ."/newstar.use.old" ) ) ; - &touch( '' , &fn( $n_import ."/newstar.use" ) ) ; - &chmod( "a+rw" , &fn( $n_import ."/newstar.use" ) ) ; -# -# Find differences between NFRA and local database -# - if ( &eq( $grpfile , "sys/database.idx" ) ) { - if ( $do_check ) { - &doalias('log' , "Creating fresh local database..." ) ; - if ( &ft('e', $n_work ."/database.idx" ) ) { - &rm( "-f" , &fn( $n_work ."/database.idx" ) ) ; - } - &grep( '' , '\.exe' , &fn( $n_import ."/database.idx" ) , ''. - &fn( $n_work ."/database.idx" ) ) ; - $nonomatch='' ; - for $dir__x (split(' ',join(' ' , &fn( $n_src ."/*" ) ))) { - $dir=$dir__x ; - if ( &ft('d', $dir ) ) { - &doalias('log' , "Scanning " . $dir ."..." ) ; -# -# If in NSTAR_DIR, check dependencies, else just checksum -# - if ( &peq( $NSTAR_DIR , "*" . &fp('t', $dir ) ."*" ) ) { - &doexe( &fn( $n_exe ."/genaid.exe" ) , "fstat" .' '. - "-i" .' '. "-t:^exe" .' '. "@" .' '. &fn( $dir - ."/*.grp" ) , '>'. &fn( $n_work ."/database.idx" ) - ) ; - } - else { - &doexe( &fn( $n_exe ."/genaid.exe" ) , "fstat" .' '. - "-t:^exe" .' '. "@" .' '. &fn( $dir ."/*.grp" ) , - '>'. &fn( $n_work ."/database.idx" ) ) ; - } - } - } - &cp( '' , &fn( $n_work ."/database.idx" ) .' '. &fn( $n_src - ."/sys/database.idx" ) ) ; - undef $nonomatch ; - } - &doalias('log' , "Comparing local database and database from " . - $iaddr ) ; - $tmp= &fn( &fp('t', $grpfile ) ) ; - $grpfile= "retrieved.grp" ; - &doexe( &fn( $n_exe ."/genaid.exe" ) , "compare" .' '. - "-t:^exe" .' '. &fn( $tmp ) .' '. &fn( $n_src - ."/sys/database.idx" ) , ''. &fn( $Tmpfile ) ) ; - &grep( "-v" , "lock.idx" , &fn( $Tmpfile ) , ''. &fn( - $grpfile ) ) ; - &rm( "-f" , &fn( $Tmpfile ) ) ; - &doalias('log' , "Differences are in " . $grpfile ) ; - } - $grpfile= &fn( &fp('t', $grpfile ) ) ; - $Flag= "ok" ; - } -# -# General log -# - &echo( '' , $C_Date ." " . $C_Time ." - " . $n_arch ." - retr " . - &fp('t', $grpfile ) ." " . $iaddr ." " . $iroot - ." " . $iuser ." " , '>'. &fn( $n_root - ."/updates.log" ) ) ; -# -# -# At nfra: check locks, if anything is locked we should have a problem -# - if ( &eq( $Flag , "ok" ) && &eq( $n_site , "nfra" ) ) { - &echo( '' , '' , "" ) ; - &echo( '' , "Checking locks..." , "" ) ; - &doexe( &fn( $n_exe ."/genaid.exe" ) , "files" .' '. "-t:^exe" - .' '. &fn( $grpfile ) , ''. &fn( $Tmpfile ) ) ; - if ( &ft('e', $n_src ."/sys/lock.idx" ) ) { - $nline= &Pipe("p$$.tmp00", &cat( '' , # Count lines - &fn( $Tmpfile ) , "p$$.tmp01" ) , &wc( "-l" , - "p$$.tmp01" , "p$$.tmp00" ) ) ; - $iline= -9 ; # Means 1 after first increment by 10 - while ( $iline < $nline ) { # Lines left? - $iline= $iline + 10 ; # Next series of 10 - for $file__x (split(' ',join(' ' , &Pipe("p$$.tmp00", &tail( - "+$iline" , &fn( $Tmpfile ) , "p$$.tmp01" ) , - &head( "-10" , "p$$.tmp01" , "p$$.tmp00" ) ) ))) { - $file=$file__x ; - $Lock= &Pipe("p$$.tmp00", &grep( '' , &fn( $file ) , &fn( - $n_src ."/sys/lock.idx" ) , "p$$.tmp00" ) ) ; - if ( !&eq( $file , "+doc/nnews.hlp" ) && !&eq( $Lock , - '' ) ) { - &echo( '' , "Warning: " . $Lock , "" ) ; - $Flag= "lock" ; - } - undef $Lock ; - } - } - } - if ( &eq( $Flag , "lock" ) ) { - sub C2_t10_update { - local(*TMP); - open(TMP,">txt$$.tmp"); - print TMP '' ."\n" ; - print TMP "Found files that were locked, cannot retriev" ."e." - ."\n" ; - print TMP "Please check and edit \$n_src/sys/lock.idx" ."\n" ; - print TMP '' ."\n" ; - close(TMP); - "txt$$.tmp";} - &cat( '' , &C2_t10_update , "" ) ; - } - else { -# -# Remove old locks, make lock for Newstar manager -# - &echo( '' , '' , "" ) ; - &echo( '' , "Making locks for files to be retrieved..." , "" ) - ; - if ( &ft('e', $n_src ."/sys/lock.idx" ) ) { - $nline= &Pipe("p$$.tmp00", &cat( '' , # Count lines - &fn( $Tmpfile ) , "p$$.tmp01" ) , &wc( "-l" , - "p$$.tmp01" , "p$$.tmp00" ) ) ; - $iline= -9 ; # Means 1 after first increment by 10 - while ( $iline < $nline ) { # Lines left? - $iline= $iline + 10 ; # Next series of 10 - for $file__x (split(' ',join(' ' , &Pipe("p$$.tmp00", &tail( - "+$iline" , &fn( $Tmpfile ) , "p$$.tmp01" ) , - &head( "-10" , "p$$.tmp01" , "p$$.tmp00" ) ) ))) { - $file=$file__x ; - &echo( '' , $file ." locked User=Newstar Date=" . - $C_Date ."/" . $C_Time , "p$$.tmp00" ) ; &tee( "-a" - , &fn( $n_src ."/sys/lock.idx" ) , "p$$.tmp00" ) - ; - } - } - } - } - } -# -# -# Confirm retrieval -# - if ( &eq( $Flag , "ok" ) ) { - &cat( '' , &fn( $grpfile ) , "p$$.tmp00" ) ; &tee( "-a" , &fn( - $Logfile ) , "p$$.tmp00" ) ; - if ( &eq( $Mode , "Update" ) ) { - $Flag= "Yes" ; - } - else { - &echo( "-n" , "Retrieve these files (y,n)? [y] " , "" ) ; - $Flag= ($_=scalar(<STDIN>), chop, $_) ; - } - } - if ( &eq( $Flag , '' ) || &peq( $Flag , "[Yy]*" ) ) { -# -# Try to get them three times, if all files received, quit as well -# - $ii= 3 ; - while ( $ii > 0 ) { -# -# Retrieve contents of groupfile, skip files have been retrieved correctly -# - sub C2_t11_update { - local(*TMP); - open(TMP,">txt$$.tmp"); - print TMP "quote user " . $iuser ."\n" ; - print TMP "quote pass " . $ipass ."\n" ; - print TMP "cd " . $iroot ."\n" ; - close(TMP); - "txt$$.tmp";} - &cat( '' , &C2_t11_update , ''. &fn( $Tmpfile ) ) ; - &doexe( &fn( $n_exe ."/genaid.exe" ) , "import" .' '. "-c" - .' '. "-t:^exe" .' '. &fn( $grpfile ) , '>'. &fn( - $Tmpfile ) ) ; - &echo( '' , "bye" , '>'. &fn( $Tmpfile ) ) ; - if ( !&eq( $ii , "3" ) ) { - &doalias('log' , '' ) ; - &doalias('log' , "Trying again ...." ) ; - } - &ftp( "-n -v -i" , &fn( $iaddr ) .' '. &fn( $Tmpfile ) , - "p$$.tmp00" ) ; &tee( "-a" , &fn( $Logfile ) , - "p$$.tmp00" ) ; - &rm( "-f" , &fn( $Tmpfile ) ) ; - &doalias('log' , '' ) ; - &doalias('log' , "Checking retrieved files... " ) ; - &doexe( &fn( $n_exe ."/genaid.exe" ) , "check" .' '. "-c" .' '. - "-t:^exe" .' '. &fn( $grpfile ) , ''. &fn( - $Tmpfile ) ) ; - if ( &ft('z', $Tmpfile ) ) { - $ii= -999 ; - &doalias('log' , "All files received correctly." ) ; - } - else { - $ii= $ii - 1 ; - &doalias('log' , "Not all files received correctly:" ) ; - &cat( '' , &fn( $Tmpfile ) , "p$$.tmp00" ) ; &tee( "-a" , - &fn( $Logfile ) , "p$$.tmp00" ) ; - } - &rm( "-f" , &fn( $Tmpfile ) ) ; - } - if ( &eq( $ii , 0 ) ) { - sub C2_t12_update { - local(*TMP); - open(TMP,">txt$$.tmp"); - print TMP '' ."\n" ; - print TMP "Not all files were retrieved after 3 tries.." ."." - ."\n" ; - print TMP "You should try once more: nup retrieve " . - $grpfile ."." ."\n" ; - print TMP "This will only retrieve the missing or defec" - ."t files." ."\n" ; - print TMP '' ."\n" ; - close(TMP); - "txt$$.tmp";} - &cat( '' , &C2_t12_update , "p$$.tmp00" ) ; &tee( "-a" , &fn( - $Logfile ) , "p$$.tmp00" ) ; - } - else { - $Flag= "ok" ; - } - } -# -# Tell the user how to proceed -# - if ( &eq( $Flag , "ok" ) ) { - sub C2_t13_update { - local(*TMP); - open(TMP,">txt$$.tmp"); - print TMP '' ."\n" ; - print TMP "All files have been correctly retrieved. " ."\n" ; - print TMP '' ."\n" ; - print TMP "To install the files, please enter:" ."\n" ; - print TMP '' ."\n" ; - print TMP " nup build " . $grpfile ." -Update " ."\n" ; - print TMP '' ."\n" ; - print TMP "on the following hosts: " . $n_hosts ."\n" ; - print TMP '' ."\n" ; - close(TMP); - "txt$$.tmp";} - &cat( '' , &C2_t13_update , "p$$.tmp00" ) ; &tee( "-a" , &fn( - $Logfile ) , "p$$.tmp00" ) ; - } - else { - sub C2_t14_update { - local(*TMP); - open(TMP,">txt$$.tmp"); - print TMP '' ."\n" ; - print TMP "*************** Retrieve errors occured ****" - ."******************" ."\n" ; - print TMP '' ."\n" ; - print TMP "The log-file will be mailed to " . $n_master ."." - ."\n" ; - print TMP '' ."\n" ; - print TMP "Please inform this account of additional inf" - ."ormation that might be" ."\n" ; - print TMP "connected with the errors (recent change of " - ."operation system, disk" ."\n" ; - print TMP "space problems etc). The Newstar group will " - ."contact you about the " ."\n" ; - print TMP "problems as soon as possible." ."\n" ; - print TMP '' ."\n" ; - print TMP "********************************************" - ."*********************" ."\n" ; - print TMP '' ."\n" ; - close(TMP); - "txt$$.tmp";} - &cat( '' , &C2_t14_update , "p$$.tmp00" ) ; &tee( "-a" , &fn( - $Logfile ) , "p$$.tmp00" ) ; - &cat( '' , &fn( $Logfile ) , "p$$.tmp00" ) ; &elm( "-s" , - "Newstar_crash_on_" . $n_site ."/" . $n_arch .' '. - &fn( $n_master ) , "p$$.tmp00" ) ; - $Mode= "Quit" ; - } -# -# -# %Clean: Make the directory structure consistent with the groupfiles -# - } - elsif ( &peq( $Command , "[Cc][Ll]*" ) ) { -# -# Scan only relevant groupfiles in master source tree -# - $Home= &fn( $cwd ) ; - &cd( &fn( $n_src ) ) ; - &echo( '' , "--> Now in directory " ."\$n_src" , "" ) ; -# -# Make sure empty temporary files exist -# - if ( &ft('e', $Tmpfile .".1" ) ) { - &rm( "-f" , &fn( $Tmpfile .".1" ) ) ; - } - &touch( '' , &fn( $Tmpfile .".1" ) ) ; - if ( &ft('e', $Tmpfile .".2" ) ) { - &rm( "-f" , &fn( $Tmpfile .".2" ) ) ; - } - &touch( '' , &fn( $Tmpfile .".2" ) ) ; -# -# No argument: check all directories and files in $n_src itself -# - if ( &eq( $Files , '' ) ) { - &echo( '' , $C_Date ." " . $C_Time ." - " . $n_arch - ." - clean all " , '>'. &fn( $n_root - ."/updates.log" ) ) ; - &doalias('log' , "Scanning all groupfiles ..." ) ; - &doexe( &fn( $n_exe ."/genaid.exe" ) , "files" .' '. "-t:^exe" - .' '. &fn( "*/*.grp" ) , ''. &fn( $Tmpfile .".1" ) - ) ; - &doalias('log' , "Scanning all files..." ) ; - &find( &fn( "*" ) .' '. "-print" , ''. &fn( # Remember we are in $n_src - $Tmpfile .".2" ) ) ; -# -# Expand master database, find all files below $n_src -# - } - elsif ( &peq( (split(' ',$Files)) [ 1 -1 ] , "[Aa][Ll][Ll]" ) ) { - &echo( '' , $C_Date ." " . $C_Time ." - " . $n_arch - ." - clean all (database) " , '>'. &fn( $n_root - ."/updates.log" ) ) ; - &doalias('log' , "Scanning all-files database..." ) ; - &doexe( &fn( $n_exe ."/genaid.exe" ) , "files" .' '. "-t:^exe" - .' '. &fn( $n_src ."/sys/database.idx" ) , ''. - &fn( $Tmpfile .".1" ) ) ; - &doalias('log' , "Scanning all files..." ) ; - &find( &fn( "*" ) .' '. "-print" , "p$$.tmp00" ) ; &grep( "-v" , - 'upd.*\.log' , "p$$.tmp00" , ''. &fn( $Tmpfile - .".2" ) ) ; -# -# Expand all groupfiles in directories, find files in those directories -# - } - else { - &echo( '' , $C_Date ." " . $C_Time ." - " . $n_arch ." - clean " - . $Files ." " , '>'. &fn( $n_root ."/updates.log" - ) ) ; - for $dir__x (split(' ',join(' ' , &fn( $Files ) ))) { $dir=$dir__x - ; - if ( ! &ft('e', $dir ) && &ft('e', $n_src ."/" . $dir ) ) { - $dir= &fn( $n_src ."/" . $dir ) ; } - if ( &ft('d', $dir ) ) { - &doalias('log' , "Scanning groupfiles and files in " . $dir - ."..." ) ; - &doexe( &fn( $n_exe ."/genaid.exe" ) , "files" .' '. - "-t:^exe" .' '. &fn( $dir ."/*.grp" ) , '>'. &fn( - $Tmpfile .".1" ) ) ; - &find( &fn( $dir ) .' '. "-print" , ''. # Remember we are in $n_src - &fn( $Tmpfile .".2" ) ) ; - } - } - } -# -# Sort on filenames -# - &doalias('log' , "Sorting contents of groupfiles" ) ; - &sort( "-u" , &fn( $Tmpfile .".1" ) , ''. &fn( $Tmpfile .".1.s" ) - ) ; - &doalias('log' , "Sorting filelist" ) ; - &sort( "-u" , &fn( $Tmpfile .".2" ) , ''. &fn( $Tmpfile .".2.s" ) - ) ; -# -# Make the difference: -# -# > file means it exists but is not in a groupfile -# < file means it is in a groupfile but does not exist -# - &doalias('log' , "Comparing..." ) ; - &diff( '' , &fn( $Tmpfile .".1.s" ) .' '. &fn( $Tmpfile .".2.s" ) - , "p$$.tmp00" ) ; &awk( '' , - '{ if ($1 == ">" || $1 == "<") print $2}' , - "p$$.tmp00" , ''. &fn( $Tmpfile ) ) ; - &rm( "-f" , &fn( $Tmpfile .".1" ) .' '. &fn( $Tmpfile .".1.s" ) - .' '. &fn( $Tmpfile .".2" ) .' '. &fn( $Tmpfile - .".2.s" ) ) ; -# -# Verify each file -# - $Flag= &Pipe("p$$.tmp00", &echo( '' , &fn( #get machines to do - $n_install ) , "p$$.tmp01" ) , &tr( '' , ',/:' , - ' ' , "p$$.tmp01" , "p$$.tmp00" ) ) ; - $nline= &Pipe("p$$.tmp00", &cat( '' , &fn( # Count lines - $Tmpfile ) , "p$$.tmp01" ) , &wc( "-l" , - "p$$.tmp01" , "p$$.tmp00" ) ) ; - $iline= -9 ; # Means 1 after first increment by 10 - while ( $iline < $nline ) { # Lines left? - $iline= $iline + 10 ; # Next series of 10 - for $file__x (split(' ',join(' ' , &Pipe("p$$.tmp00", &tail( - "+$iline" , &fn( $Tmpfile ) , "p$$.tmp01" ) , - &head( "-10" , "p$$.tmp01" , "p$$.tmp00" ) ) ))) { - $file=$file__x ; - if ( ! &ft('d', $file ) ) { - if ( &ft('e', $file ) ) { - if ( &eq( $_Confirm , 0 ) ) { - &rm( "-f" , &fn( $file ) ) ; - } - elsif ( &eq( &fp('e', $file ) , '' ) || &eq( &fp('e', - $file ) , "log" ) || &eq( &fp('e', $file ) , - "tmp" ) || &eq( &fp('e', $file ) , "LOG" ) || - &eq( &fp('e', $file ) , "lis" ) || &eq( - &fp('e', $file ) , "old" ) || &peq( &fp('e', - $file ) , "??" ) || &peq( &fp('e', $file ) , - "?????*" ) || &peq( $file , "*~" ) ) { - &rm( "-f" , &fn( $file ) ) ; - } - else { - &echo( "-n" , "Remove " , "" ) ; &rm( "-i" , &fn( $file - ) ) ; - } - if ( &ft('e', $file ) ) { - &doalias('log' , $file ." not deleted" ) ; - } - else { - &doalias('log' , $file ." deleted" ) ; -# if ("$file:e" =~ f?? || "$file:e" =~ c??) then -# set dir=$file:h -# if ("$dir" =~ n*) set dir=nst -# set file=$file:t -# if (! $?ARD) setenv ARD "ar dv" -# log `$ARD $n_lib/${dir}lib.olb ${file:r}.o` -# endif - } - } - else { - if ( &peq( &fp('e', $file ) , "x??" ) || &peq( &fp('e', - $file ) , "a??" ) ) { - for $aa__x (split(' ',join(' ' , &fn( $Flag ) ))) { - $aa=$aa__x ; - if ( &peq( &fp('e', $file ) , "?" . $aa ) ) { - &echo( '' , $file ." missing ..." , "" ) ; - } - } - } - else { - &echo( '' , $file ." missing ..." , "" ) ; - } - } - } - } - } -# -# Back to original directory, clean up -# - &rm( "-f" , &fn( $Tmpfile ) ) ; - &echo( '' , "--> Back in " . $Home , "" ) ; - &cd( &fn( $Home ) ) ; - undef $Home ; undef $nonomatch ; -# -# -# %Check the current implementation of Newstar against the database -# - } - elsif ( &peq( $Command , "[Cc][Hh]*" ) ) { -# -# If no argument given: all -# - if ( &peq( (split(' ',$Files)) [ 1 -1 ] , "[Aa][Ll][Ll]" ) || &eq( - (split(' ',$Files)) [ 1 -1 ] , '' ) ) { $Files= - "fdl" ; } -# -# General log -# - &echo( '' , $C_Date ." " . $C_Time ." - " . $n_arch ." - check " . - $Files ." " , '>'. &fn( $n_root ."/updates.log" ) - ) ; -# -# Verify all files... -# - if ( &peq( (split(' ',$Files)) [ 1 -1 ] , "*f*" ) && &ft('e', $n_src - ."/sys/database.idx" ) ) { - &doalias('log' , "Checking master source tree against database" ) - ; - $grpfile= &fn( $n_import ."/get" . $C_Date .".grp" ) ; - &doexe( &fn( $n_exe ."/genaid.exe" ) , "check" .' '. "-t:^exe" - .' '. &fn( $n_src ."/sys/database.idx" ) , ''. - &fn( $grpfile ) ) ; - &doalias('log' , '' ) ; - if ( &ft('e', $grpfile ) && ! &ft('z', $grpfile ) ) { - &doalias('log' , " Created " ."\$n_import" . "/get" . $C_Date - .".grp " ) ; - &cat( '' , &fn( $grpfile ) , "" ) ; - &doalias('log' , '' ) ; - &doalias('log' , " Update implementation with: nup retrieve get" - . $C_Date ) ; - } - else { - if ( &ft('e', $grpfile ) ) { - &rm( "-f" , &fn( $grpfile ) ) ; - } - &doalias('log' , " As far as can be checked, you have a proper" - ." source tree" ) ; - &doalias('log' , " Check for any revisions with: nup retrieve " - ) ; - } - &doalias('log' , '' ) ; - } -# -# Scan all subdirectories of $n_src and build a new database -# - if ( &peq( (split(' ',$Files)) [ 1 -1 ] , "*d*" ) ) { - if ( &ft('e', $n_work ."/database.idx" ) ) { - &rm( "-f" , &fn( $n_work ."/database.idx" ) ) ; - } - &grep( '' , '\.exe' , &fn( $n_src ."/sys/database.idx" ) , ''. - &fn( $n_work ."/database.idx" ) ) ; - $nonomatch='' ; - for $dir__x (split(' ',join(' ' , &fn( $n_src ."/*" ) ))) { - $dir=$dir__x ; - if ( &ft('d', $dir ) ) { - &doalias('log' , "Scanning " . $dir ."..." ) ; -# -# If in NSTAR_DIR, check dependencies, else just checksum -# - if ( &peq( $NSTAR_DIR , "*" . &fp('t', $dir ) ."*" ) ) { - &doexe( &fn( $n_exe ."/genaid.exe" ) , "fstat" .' '. "-i" - .' '. "-t:^exe" .' '. "@" .' '. &fn( $dir - ."/*.grp" ) , '>'. &fn( $n_work ."/database.idx" ) - ) ; - } - else { - &doexe( &fn( $n_exe ."/genaid.exe" ) , "fstat" .' '. - "-t:^exe" .' '. "@" .' '. &fn( $dir ."/*.grp" ) , - '>'. &fn( $n_work ."/database.idx" ) ) ; - } - } - } - &cp( '' , &fn( $n_work ."/database.idx" ) .' '. &fn( $n_src - ."/sys/database.idx" ) ) ; - undef $nonomatch ; - &doalias('log' , "Check current implementation with: nup retri" - ."eve " ) ; - } -# -# Integrity check on the libraries -# - if ( &peq( (split(' ',$Files)) [ 1 -1 ] , "*l*" ) ) { - &doalias('log' , "Checking libraries..." ) ; - $grpfile= &fn( $n_import ."/lib" . $C_Date . $n_arch .".grp" ) ; - if ( &ft('e', $grpfile ) ) { - &rm( "-f" , &fn( $grpfile ) ) ; - } - for $dir__x (split(' ',join(' ' , "dwarf" , "nst" , "wng" ))) { - $dir=$dir__x ; - &doalias('log' , " " . $dir ."lib.olb" ) ; - if ( &ft('e', $Tmpfile ) ) { - &rm( "-f" , &fn( $Tmpfile ) ) ; - } - if ( &ft('e', $Tmpfile .".1" ) ) { - &rm( "-f" , &fn( $Tmpfile .".1" ) ) ; - } - if ( &ft('e', $Tmpfile .".2" ) ) { - &rm( "-f" , &fn( $Tmpfile .".2" ) ) ; - } -# -# For each entry: get name and date -# - &ar( "tv" , &fn( $n_lib ."/" . $dir ."lib.olb" ) , "p$$.tmp00" - ) ; &awk( '' , - '/.*\.o/ { im=NF-4; id=NF-3; iy=NF-1; if ($' - .'im == "Jan") mon=1; if ($im == "' - .'Feb") mon=2; if ($im == "Mar") m' - .'on=3; if ($im == "Apr") mon=4; ' - .' if ($im == "May") mon=5; ' - .' if ($im == "Jun") mon=6; if ' - .'($im == "Jul") mon=7; if ($im ==' - .' "Aug") mon=8; if ($im == "Sep")' - .' mon=9; if ($im == "Oct") mon=10' - .'; if ($im == "Nov") mon=11; ' - .' if ($im == "Dec") mon=12; p' - .'rintf("%2.2d%2.2d%2.2d %s\n",($iy)%100,mon,' - .'$id,$NF); }' , "p$$.tmp00" , "p$$.tmp01" ) ; - &sort( '' , "p$$.tmp01" , ''. &fn( $Tmpfile ) ) ; -# -# Extract relevant part of database -# - if ( &eq( $dir , "nst" ) ) { - &doexe( &fn( $n_exe ."/genaid.exe" ) , "select" .' '. &fn( - "-t:s\$/cee/cun/c" . $n_arch ."/for/fun/fsc/f" . - $n_arch ."/dsc" ) .' '. &fn( $n_src - ."/sys/database.idx" ) , "p$$.tmp00" ) ; &grep( '' - , '^n.*/' , "p$$.tmp00" , ''. &fn( $Tmpfile .".2" - ) ) ; - } - else { - &doexe( &fn( $n_exe ."/genaid.exe" ) , "select" .' '. &fn( - "-t:s\$/cee/cun/c" . $n_arch ."/for/fun/fsc/f" . - $n_arch ."/dsc" ) .' '. &fn( $n_src - ."/sys/database.idx" ) , "p$$.tmp00" ) ; &grep( '' - , "^" . $dir ."/" , "p$$.tmp00" , ''. &fn( - $Tmpfile .".2" ) ) ; - } -# -# Does any symbol occur twice? -# - $nline= &Pipe("p$$.tmp00", &cat( '' , # Count lines - &fn( $Tmpfile ) , "p$$.tmp01" ) , &wc( "-l" , - "p$$.tmp01" , "p$$.tmp00" ) ) ; - $iline= -9 ; # Means 1 after first increment by 10 - while ( $iline < $nline ) { # Lines left? - $iline= $iline + 10 ; # Next series of 10 - for $file__x (split(' ',join(' ' , &Pipe("p$$.tmp00", &tail( - "+$iline" , &fn( $Tmpfile ) , "p$$.tmp01" ) , - &head( "-10" , "p$$.tmp01" , "p$$.tmp00" ) ) ))) { - $file=$file__x ; -# -# Store the date field for the next file -# - if ( !&peq( $file , "*.o" ) ) { - $fDate= &fn( $file ) ; - } - else { -# -# Find the entry in the database selection (c/fortran file or dsc-file) -# - $Flag= &Pipe("p$$.tmp00", &grep( '' , '^.*/' . &fp('r', - $file ) .'\.' , &fn( $Tmpfile .".2" ) , - "p$$.tmp00" ) ) ; - if ( &eq( $Flag , '' ) && &peq( $file , "*_bd.o" ) ) { - $dscfile= &Pipe("p$$.tmp00", &echo( '' , &fn( $file ) - , "p$$.tmp01" ) , &sed( '' , "s/_bd.o/.dsc/" , - "p$$.tmp01" , "p$$.tmp00" ) ) ; - $Flag= &Pipe("p$$.tmp00", &grep( '' , '^.*/' . $dscfile - , &fn( $Tmpfile .".2" ) , "p$$.tmp00" ) ) ; - undef $dscfile ; - } -# -# If no corresponding file in the database, remove the entry... -# - if ( &eq( $Flag , '' ) ) { - &doalias('log' , "No source in database for " . $file ) - ; - &echo( '' , &fn( $file ) , '>'. &fn( $Tmpfile .".1" ) - ) ; -# -# If multiple entries: remove all entries and write to groupfile -# - } - elsif ( !&eq( &Pipe("p$$.tmp00", &grep( "-c" , " " . - &fp('r', $file ) ."\.o" , &fn( $Tmpfile ) , - "p$$.tmp00" ) ) , 1 ) ) { - &echo( '' , &fn( $file ) , '>'. &fn( $Tmpfile .".1" ) - ) ; - &doalias('log' , "Multiple entries for " . $file ) ; - &echo( "+$Flag[1]" , '' , '>'. &fn( $grpfile ) ) ; -# -# Check the date of the source file in the database against the library -# - } - else { -# -# If too old, log and write to groupfile -# - if ( (split(' ',$Flag)) [ 2 -1 ] > $fDate ) { - &doalias('log' , "Out of date: " . $file ." (" . - $fDate .") " . (split(' ',$Flag)) [ 1 -1 ] ." (" . - (split(' ',$Flag)) [ 2 -1 ] .")" ) ; - &echo( "+$Flag[1]" , '' , '>'. &fn( $grpfile ) ) ; - } - } - } - } # foreach file - } -# -# For all files in the database: check wether the file is in the library -# - $nline= &Pipe("p$$.tmp00", &cat( '' , # Count lines - &fn( $Tmpfile .".2" ) , "p$$.tmp01" ) , &wc( "-l" - , "p$$.tmp01" , "p$$.tmp00" ) ) ; - $iline= -9 ; # Means 1 after first increment by 10 - while ( $iline < $nline ) { # Lines left? - $iline= $iline + 10 ; # Next series of 10 - for $file__x (split(' ',join(' ' , &Pipe("p$$.tmp00", &tail( - "+$iline" , &fn( $Tmpfile .".2" ) , "p$$.tmp01" ) - , &head( "-10" , "p$$.tmp01" , "p$$.tmp00" ) ) - ))) { $file=$file__x ; - if ( &peq( $file , "*.*" ) && !&eq( &fp('e', $file ) , - "dsc" ) ) { - $Flag= &fn( &fp('t', $file ) ) ; - $Flag= &fn( &fp('r', $Flag ) .".o" ) ; - if ( &eq( &Pipe("p$$.tmp00", &grep( "-c" , " " . $Flag - ."\$" , &fn( $Tmpfile ) , "p$$.tmp00" ) ) , 0 ) - ) { - &doalias('log' , $file ." is not in the archive..." ) ; - &echo( "+$file" , '' , '>'. &fn( $grpfile ) ) ; - } - } - } - } -# -# Now do all library operations -# - if ( &ft('e', $Tmpfile .".1" ) && ! &ft('z', $Tmpfile .".1" ) - ) { - $Flag= &Pipe("p$$.tmp00", &cat( '' , &fn( $Tmpfile .".1" ) , - "p$$.tmp00" ) ) ; - if ( ! defined($ARD) ) { $ARD= "ar dv" ; &ENV_EXPORT( ARD , - "ar dv" ) ; } - &doalias('log' , &Pipe("p$$.tmp00", &dollar("ARD" , &fn( - $n_lib ."/" . $dir ."lib.olb" ) .' '. &fn( $Flag ) - , "p$$.tmp00" ) ) ) ; - } - } # foreach dir -# -# Clean up -# - if ( &ft('e', $Tmpfile ) ) { - &rm( "-f" , &fn( $Tmpfile ) ) ; - } - if ( &ft('e', $Tmpfile .".1" ) ) { - &rm( "-f" , &fn( $Tmpfile .".1" ) ) ; - } - if ( &ft('e', $Tmpfile .".2" ) ) { - &rm( "-f" , &fn( $Tmpfile .".2" ) ) ; - } -# -# Inform user on repairs -# - &doalias('log' , '' ) ; - if ( &ft('e', $grpfile ) && ! &ft('z', $grpfile ) ) { - &doalias('log' , " Created " ."\$n_import" . "/lib" . $C_Date . - $n_arch .".grp " ) ; - &sort( "-u -o" , &fn( $grpfile ) .' '. &fn( $grpfile ) , "" ) - ; - &doalias('log' , '' ) ; - &doalias('log' , " Repair libraries with: nup build " - ."\$n_import" . "/lib" . $C_Date . $n_arch ) ; -# -# If Update mode: insert extra command to update the libraries -# - if ( &eq( $Mode , "Update" ) ) { - $Upd_list= "build" .' '. &fn( $grpfile ) .' '. &fn( $Upd_list - ) ; - } - } - else { - if ( &ft('e', $grpfile ) ) { - &rm( "-f" , &fn( $grpfile ) ) ; - } - &doalias('log' , " Libraries seem to be all right" ) ; - } - } -# -# Check version of executables with respect to database -# - if ( &peq( (split(' ',$Files)) [ 1 -1 ] , "*e*" ) ) { -# -# Reset error-count, initialise temp-list -# - $Errors= 0 ; - if ( &ft('e', $Tmpfile ) ) { - &rm( "-f" , &fn( $Tmpfile ) ) ; - } -# -# Rebuild utility programs always -# - $Input_file= &fn( $n_src ."/sys/*.c" ) ; - &source( &fn( $n_src ."/sys/compile.csh" ) ) ; -# -# Get list of exe's from groupfiles, check version numbers -# Assume the list of exe's is less than 500... -# - $Files= &Pipe("p$$.tmp00", &doexe( &fn( $n_exe ."/genaid.exe" ) , - "files" .' '. "-t:exe" .' '. &fn( $n_src - ."/*/*.grp" ) , "p$$.tmp00" ) ) ; - for $File__x (split(' ',join(' ' , &fn( $Files ) ))) { - $File=$File__x ; - if ( !&peq( $File , "abpx_*" ) || defined($n_doabp) ) { - $v_exe= '' .' '. '' ; - $v_idx= '' .' '. '' ; - $File= &Pipe("p$$.tmp00", &echo( '' , &fn( &fp('t', $File ) - ) , "p$$.tmp01" ) , &tr( '' , '[A-Z]' , '[a-z]' , - "p$$.tmp01" , "p$$.tmp00" ) ) ; - $Flag= $File .": No executable" ; - if ( &ft('e', $n_exe ."/" . $File ) ) { - $Flag= &Pipe("p$$.tmp00", &grep( '' , &fn( $File ) , &fn( - $n_src ."/sys/database.idx" ) , "p$$.tmp00" ) ) - .' '. '' .' '. '' ; - $v_idx= &Pipe("p$$.tmp00", &echo( '' , &fn( - (split(' ',$Flag)) [ 2 -1 ] ) , "p$$.tmp01" ) , - &awk( "-F." , '{ print $1,$2}' , "p$$.tmp01" , - "p$$.tmp00" ) ) .' '. '' .' '. '' ; - $Flag= &Pipe("p$$.tmp00", &what( '' , &fn( $n_exe ."/" . - $File ) , "p$$.tmp01" ) , &grep( '' , "%NST%" , - "p$$.tmp01" , "p$$.tmp00" ) ) .' '. '' .' '. '' ; - $v_exe= &Pipe("p$$.tmp00", &echo( '' , &fn( - (split(' ',$Flag)) [ 2 -1 ] ) , "p$$.tmp01" ) , - &awk( "-F." , '{ print $1,$2}' , "p$$.tmp01" , - "p$$.tmp00" ) ) .' '. '' .' '. '' ; - } - $Input_file= '' ; - if ( &eq( $v_exe , " " ) || &eq( $v_idx , " " ) ) { - $Input_file= &fn( $File ) ; - } - elsif ( &eq( $v_exe , '' ) || &eq( $v_idx , '' ) ) { - $Input_file= &fn( $File ) ; - } - else { - if ( (split(' ',$v_exe)) [ 1 -1 ] < (split(' ',$v_idx)) [ - 1 -1 ] || (split(' ',$v_exe)) [ 2 -1 ] < - (split(' ',$v_idx)) [ 2 -1 ] ) { - $Input_file= &fn( $File ) ; - } - } - if ( !&eq( $Input_file , '' ) ) { - if ( !&eq( &Pipe("p$$.tmp00", &grep( "-c" , &fn( $Input_file - ) , &fn( $n_src ."/dwarf/src.grp" ) , "p$$.tmp00" - ) ) , 0 ) ) { $_Alternate= "1" ; } - &source( &fn( $n_src ."/sys/compile.csh" ) ) ; - $_Alternate='' ; - $Flag= &Pipe("p$$.tmp00", &what( '' , &fn( $n_exe ."/" . - $File ) , "p$$.tmp01" ) , &grep( '' , "%NST%" , - "p$$.tmp01" , "p$$.tmp00" ) ) .' '. '(updated)' ; - } - &echo( '' , &fn( $Flag ) , "p$$.tmp00" ) ; &sed( "-e" , - "s/%NST%//" , "p$$.tmp00" , '>'. &fn( $Tmpfile ) ) - ; - } - } -# -# Errors occurred, give a message (different for nfra and elsewhere) -# - if ( !&eq( $n_site , "nfra" ) ) { - if ( !&eq( $Errors , 0 ) ) { - $Flag= &Pipe("p$$.tmp00", &cat( '' , &fn( $n_src - ."/sys/version.idx" ) , "p$$.tmp00" ) ) ; - sub C2_t15_update { - local(*TMP); - open(TMP,">txt$$.tmp"); - print TMP '' ."\n" ; - print TMP "*************** Installation errors occured " - ."**********************" ."\n" ; - print TMP '' ."\n" ; - print TMP "The log-file will be mailed to " . $n_master - ."." ."\n" ; - print TMP '' ."\n" ; - print TMP "Please inform this account of additional inf" - ."ormation that might be" ."\n" ; - print TMP "connected with the errors (recent change of " - ."operation system, disk" ."\n" ; - print TMP "space problems etc). The Newstar group will " - ."contact you about the " ."\n" ; - print TMP "problems as soon as possible." ."\n" ; - print TMP '' ."\n" ; - print TMP "Your present executables should be still cor" - ."rect. " ."\n" ; - print TMP "Your source tree seems to be " . $Flag ." for " - ."\n" ; - print TMP "Your executables seem to be:" ."\n" ; - print TMP '' ."\n" ; - print TMP &Pipe("p$$.tmp00", &cat( '' , &fn( $Tmpfile ) , - "p$$.tmp00" ) ) ."\n" ; - print TMP '' ."\n" ; - print TMP "********************************************" - ."*********************" ."\n" ; - print TMP '' ."\n" ; - close(TMP); - "txt$$.tmp";} - &cat( '' , &C2_t15_update , "p$$.tmp00" ) ; &tee( "-a" , &fn( - $Logfile ) , "p$$.tmp00" ) ; - &cat( '' , &fn( $Logfile ) , "p$$.tmp00" ) ; &elm( "-s" , - "Newstar_crash_on_" . $n_site ."/" . $n_arch .' '. - &fn( $n_master ) , "p$$.tmp00" ) ; - $Mode= "Quit" ; - } - else { -# -# No errors: inform NFRA if run on remote site -# - sub C2_t16_update { - local(*TMP); - open(TMP,">txt$$.tmp"); - print TMP '' ."\n" ; - print TMP "Newstar executables have been updated on " . - $n_site ." (" . $n_arch .") at " . $C_Date ."." - ."\n" ; - print TMP '' ."\n" ; - print TMP "The current version at " . $n_site ." is:" ."\n" - ; - print TMP '' ."\n" ; - print TMP &Pipe("p$$.tmp00", &cat( '' , &fn( $n_src - ."/sys/version.idx" ) , "p$$.tmp00" ) ) ."\n" ; - print TMP '' ."\n" ; - print TMP "The executables have version:" ."\n" ; - print TMP '' ."\n" ; - print TMP &Pipe("p$$.tmp00", &cat( '' , &fn( $Tmpfile ) , - "p$$.tmp00" ) ) ."\n" ; - print TMP '' ."\n" ; - print TMP "Yours truly," ."\n" ; - print TMP '' ."\n" ; - print TMP "update.csh" ."\n" ; - close(TMP); - "txt$$.tmp";} - &elm( "-s" , "Newstar_update_on_" . $n_site ."/" . $n_arch - .' '. &fn( $n_master ) , &C2_t16_update ) ; - } - } - } -# -# -# %Diff: compare files in $n_import with versions in master -# - } - elsif ( &peq( $Command , "[Dd]*" ) ) { -# -# Enforce working in $n_import -# - if ( !&eq( $PWD , $n_import ) ) { - &cd( &fn( $n_import ) ) ; - &echo( '' , "--> Now in directory " . $n_import , "" ) ; - } -# -# Get groupfile to diff -# - if ( &eq( $Files , '' ) ) { - &echo( "-n" , "Enter name of groupfile to diff: " , "" ) ; - $noglob='' ; # Don't expand wildcards right now - $Files= ($_=scalar(<STDIN>), chop, $_) ; # Read from stdin - $Files= &fn( $Files ) ; # Split in multiple words - undef $noglob ; - } -# -# Expand the groupfile(s) and compare the files -# - for $grpfile__x (split(' ',join(' ' , &fn( $Files ) ))) { - $grpfile=$grpfile__x ; - if ( &eq( &fp('e', $grpfile ) , '' ) ) { $grpfile= &fn( - $grpfile .".grp" ) ; } - $dfile= &fn( $grpfile .".dif" ) ; - if ( &ft('e', $dfile ) ) { - &rm( "-f" , &fn( $dfile ) ) ; - } - &echo( '' , "Differences introduced by " . $grpfile , ''. &fn( - $dfile ) ) ; - &echo( '' , "Made at " . $C_Date ."/" . $C_Time ." on " . $n_site - ." (" . $n_arch .") " , '>'. &fn( $dfile ) ) ; - &doexe( &fn( $n_exe ."/genaid.exe" ) , "files" .' '. "-t:^exe" - .' '. &fn( $grpfile ) , ''. &fn( $Tmpfile ) ) ; - for $file__x (split(' ',join(' ' , &Pipe("p$$.tmp00", &cat( '' , - &fn( $Tmpfile ) , "p$$.tmp00" ) ) ))) { - $file=$file__x ; - if ( &ft('e', $n_import ."/" . &fp('t', $file ) ) ) { - if ( &ft('e', $n_src ."/" . $file ) ) { - &echo( '' , " " , '>'. &fn( $dfile ) ) ; - &echo( '' , "diff " . $n_import ."/" . &fp('t', $file ) - ." " . $n_src ."/" . $file , '>'. &fn( $dfile ) ) - ; - &diff( '' , &fn( $n_import ."/" . &fp('t', $file ) ) .' '. - &fn( $n_src ."/" . $file ) , '>'. &fn( $dfile ) ) - ; - } - else { - &echo( '' , " " , '>'. &fn( $dfile ) ) ; - &echo( '' , "New file: " . $file , '>'. &fn( $dfile ) ) ; - } - } - } - &more( '' , &fn( $dfile ) , "" ) ; - &doalias('log' , "Differences are listed in " . $dfile ) ; - } -# -# -# %save is the backup command -# - } - elsif ( &peq( $Command , "[Ss]*" ) ) { - $Tapes= "A" .' '. "B" .' '. "C" ; - $Home= &fn( $cwd ) ; - &cd( &fn( $n_root ) ) ; - &echo( '' , " --> Now in directory " ."\$n_root" , "" ) ; - &tail( '' , "backups.txt" , "" ) ; # Show last backups - $Flag= &Pipe("p$$.tmp00", &tail( "-1l" , # Get very last one - "backups.txt" , "p$$.tmp00" ) ) ; - if ( &eq( $Flag , '' ) ) { $Flag= "::" ; } - $Tape= &Pipe("p$$.tmp00", &echo( '' , &fn( # Get last tape - $Flag ) , "p$$.tmp01" ) , &awk( "-F:" , - '{ print $2}' , "p$$.tmp01" , "p$$.tmp00" ) ) ; - $Unit= &Pipe("p$$.tmp00", &echo( '' , &fn( # Get previous command - $Flag ) , "p$$.tmp01" ) , &awk( "-F:" , - '{ print $3}' , "p$$.tmp01" , "p$$.tmp00" ) ) ; - if ( &eq( $Tape , '' ) ) { $Tape= "Unknown" ; } - if ( &eq( $Unit , '' ) ) { $Unit= $MAG8 ; } - $ii= 1 ; - while ( $ii < &vn($Tapes) && !&eq( (split(' ',$Tapes)) [ $ii -1 ] , - $Tape ) ) { - $ii= $ii + 1 ; - } - if ( !&eq( (split(' ',$Tapes)) [ $ii -1 ] , $Tape ) ) { - &echo( '' , "Unknown tape " . $Tape ."..." , "" ) ; - $Tape= (split(' ',$Tapes)) [ 1 -1 ] ; - } - elsif ( &eq( $ii , &vn($Tapes) ) ) { - $Tape= (split(' ',$Tapes)) [ 1 -1 ] ; - } - else { - $ii= $ii + 1 ; - $Tape= (split(' ',$Tapes)) [ $ii -1 ] ; - } - &echo( '' , "Suggested tape for backup: ====== " . $Tape - ." ======" , "" ) ; - &echo( "-n" , "Tape for backup [" . $Tape ."]: " , "" ) ; - $ans= ($_=scalar(<STDIN>), chop, $_) ; if ( !&eq( $ans , '' ) ) { - $Tape= $ans ; } - &echo( "-n" , "Tapeunit for backup [" . $Unit ."]: " , "" ) ; - $ans= ($_=scalar(<STDIN>), chop, $_) ; if ( !&eq( $ans , '' ) ) { - $Unit= $ans ; } - &echo( '' , $C_Date ." " . $C_Time ." - " . $n_arch ." - save " . - $Tape ." " . $Unit ." " , '>'. &fn( $n_root - ."/updates.log" ) ) ; - &echo( '' , $C_Date ."/" . $C_Time ."/" . $n_arch ."(" . $HOST - ."):" . $Tape .":" . $Unit , "p$$.tmp00" ) ; &tee( - "-a" , "backups.txt" , "p$$.tmp00" ) ; -# -# Backup in background, route output by mail -# - if ( &eq( $n_arch , "hp" ) ) { - $Rew= "mt -t " . $Unit ." rew" ; - } - else { - $Rew= "mt -f " . $Unit ." rew" ; - } - &tar( "cf" , &fn( $Unit ) .' '. &fn( "*" ) , ### & - "p$$.tmp00" ) ; &dollar("Rew" , "" , "p$$.tmp00" ) - ; &tar( "tf" , &fn( $Unit ) , "p$$.tmp00" ) ; - &elm( "-s" , "Backup of Master tree" .' '. $USER - ."@" . &Pipe("p$$.tmp00", &domainname( "p$$.tmp00" - ) ) , "p$$.tmp00" ) ; - &cd( &fn( $Home ) ) ; -# -# -# %Pack: Another archiving command -# - } - elsif ( &peq( $Command , "[Pp][Aa][Cc][Kk]" ) ) { - if ( &eq( $Files , '' ) ) { - &echo( "-n" , "Enter name of directory (e.g. src, exe, nsca" - ."n, exe/sw): " , "" ) ; - $Files= ($_=scalar(<STDIN>), chop, $_) ; - $Files= &fn( $Files ) ; - } - if ( &peq( $Files , "[Aa][Ll][Ll]" ) ) { - $Files= "src" .' '. "lib/inc" .' '. "lib/sw" .' '. "lib/hp" .' '. - "exe/sw" .' '. "exe/hp" .' '. "exe/html" ; - } - if ( defined($n_ftp) ) { &doalias('log' , - "Archives will be moved to the ftp-area" ) ; } - for $dir__x (split(' ',join(' ' , &fn( $Files ) ))) { $dir=$dir__x ; - undef $Source ; - if ( &ft('d', $n_root ."/" . $dir ) ) { - $Source= &fn( $n_root ."/" . $dir ) ; - $tarfile= &fn( "nstar_" . $dir .".tar" ) ; - } - elsif ( &ft('d', $n_src ."/" . $dir ) ) { - $Source= &fn( $n_src ."/" . $dir ) ; - $tarfile= &fn( "nstar_src_" . $dir .".tar" ) ; - } - elsif ( &ft('d', $dir ) ) { - &doalias('log' , "Can only tar Newstar Master tree directories" - ) ; - } - else { - &doalias('log' , "Error: directory " . $dir ." does not exist" ) - ; - } - if ( defined($Source) ) { - $tarfile= &Pipe("p$$.tmp00", &echo( '' , &fn( $tarfile ) , - "p$$.tmp01" ) , &tr( '' , '/' , '_' , "p$$.tmp01" , - "p$$.tmp00" ) ) ; - if ( &peq( $cwd , $n_src ."/*" ) ) { - $tarfile= &fn( $n_src ."/" . $tarfile ) ; - } - else { - $tarfile= &fn( $cwd ."/" . $tarfile ) ; - } - if ( &eq( $Mode , "Menu" ) ) { - &echo( "-n" , "Enter name of tarfile [" . $tarfile ."]: " , - "" ) ; - $tmp= ($_=scalar(<STDIN>), chop, $_) ; - if ( !&eq( $tmp , '' ) ) { $tarfile= &fn( $tmp ) ; } - undef $tmp ; - } - if ( &ft('e', $tarfile ) || &ft('e', $tarfile .".Z" ) ) { - &rm( '' , &fn( $tarfile ."*" ) ) ; - if ( ! &ft('e', $tarfile ) && ! &ft('e', $tarfile .".Z" ) ) { - &doalias('log' , "Removed existing " . $tarfile ) ; - } - } - &doalias('log' , "Creating tar-file " . $tarfile ) ; -# -# Tar the files and compress, exclude core, *.tar* *.x?? *.a?? and *.old -# - $Home= &fn( $cwd ) ; - &cd( &fn( $Source ) ) ; - &echo( '' , "Ignore any no match messages..." , "" ) ; - &ls( '' , "core" .' '. &fn( "*/core" ) .' '. &fn( "*.tar*" ) - .' '. &fn( "*/*.tar*" ) .' '. &fn( "*.x??" ) .' '. - &fn( "*.a??" ) .' '. &fn( "*/*.x??" ) .' '. &fn( - "*/*.a??" ) .' '. &fn( "*.old" ) .' '. &fn( - "*/*.old" ) , ''. &fn( $Tmpfile ) ) ; - &tar( "cfX" , &fn( $tarfile ) .' '. &fn( $Tmpfile ) .' '. &fn( - "*" ) , "" ) ; - &rm( "-f" , &fn( $Tmpfile ) ) ; - &cd( &fn( $Home ) ) ; - &echo( '' , "Compressing to " . $tarfile .".Z " , "" ) ; - if ( defined($n_ftp) ) { - &compress( &fn( $tarfile ) , "" ) ; &rsh( &fn( $n_ftp ) , - "mv" .' '. &fn( $tarfile ."*" ) .' '. - '~ftp/newstar' , "" , "" ) ; - } - else { - &compress( &fn( $tarfile ) , "" ) ; - } -# -# For the source tree, make separate archives for the binaries etc -# - if ( &eq( $Source , $n_src ) ) { - &cd( &fn( $Source ) ) ; - $Flag= &Pipe("p$$.tmp00", &echo( '' , &fn( $n_install ) , - "p$$.tmp01" ) , &tr( '' , ',/:' , ' ' , - "p$$.tmp01" , "p$$.tmp00" ) ) ; - for $aa__x (split(' ',join(' ' , &fn( $Flag ) ))) { $aa=$aa__x - ; - &doalias('log' , "Creating tar-file " . &fp('r', $tarfile ) - ."_" . $aa .".tar" ) ; - &tar( "cf" , &fn( &fp('r', $tarfile ) ."_" . $aa .".tar" ) - .' '. &fn( "*/*.x" . $aa ) .' '. &fn( "*/*.a" . $aa - ) , "" ) ; - if ( defined($n_ftp) ) { - &rsh( &fn( $n_ftp ) , "mv" .' '. &fn( &fp('r', $tarfile - ) ."_" . $aa .".tar" ) .' '. '~ftp/newstar' , "" , - "" ) ; - } - } - } - } - } - undef $Home ; undef $tarfile ; undef $dir ; -# -# %Group Combine or spilt groupfiles -# - } - elsif ( &peq( $Command , "[Gg]*" ) ) { - if ( &eq( $Files , '' ) ) { - &echo( '' , "Need to specify at least one groupfile" , "" ) ; - } - elsif ( !&eq( &Pipe("p$$.tmp00", &grep( "-c" , '^+' , &fn( - (split(' ',$Files)) [ 1 -1 ] ) , "p$$.tmp00" ) ) , - 0 ) ) { - for $File__x (split(' ',join(' ' , &fn( $Files ) ))) { - $File=$File__x ; - &doexe( &fn( $n_exe ."/genaid.exe" ) , "split" .' '. &fn( - $File ) .' '. &fn( $C_Date ."_c" ) , "" ) ; - } - &ls( "-l" , &fn( "*" . $C_Date ."_c.grp" ) , "" ) ; - } - else { -# -# Make unique name -# - $grpfile= &fn( "upd" . $C_Date .".grp" ) ; - $ii= 0 ; - while ( &ft('e', $grpfile ) ) { - $ii= $ii + 1 ; - $grpfile= &fn( "upd" . $C_Date . $ii .".grp" ) ; - } - undef $ii ; - &echo( '' , "\!+" . $grpfile ." combined groupfile made by " . - $USER , ''. &fn( $grpfile ) ) ; -# -# Process all groupfiles -# - &doexe( &fn( $n_exe ."/genaid.exe" ) , "group" .' '. &fn( $Files - ) , '>'. &fn( $grpfile ) ) ; - &doalias('log' , "Output is in " . $grpfile ) ; - } - } # Other command - else { - &echo( '' , '' , "" ) ; - &echo( '' , "Error: Invalid or ambiguous command " . $Command , "" - ) ; - &echo( '' , '' , "" ) ; - } # End of if (Command == ...) - } # End of while (Menu mode) - &Abort_exit_update ; - sub Abort_exit_update { - ; -# -# Handle any pending library actions left after an abort -# - if ( !&eq( $_Objectlib , '' ) ) { - $Input_file= &fn( $_Objectlib ) ; - &source( &fn( $n_src ."/sys/compile.csh" ) ) ; - } - if ( !&eq( $_Textlib , '' ) ) { - $Input_file= &fn( $_Textlib ) ; - &source( &fn( $n_src ."/sys/compile.csh" ) ) ; - } - if ( &ft('e', $n_work ."/update.lock" ) ) { - &rm( "-f" , &fn( $n_work ."/update.lock" ) ) ; - } - if ( &ft('e', $Tmpfile ) ) { - &rm( "-f" , &fn( $Tmpfile ) ) ; - } -# -#+ Postamble -# -# -# Finish main routine -# - &exit('');} - &exit('');} -# -# Call main routine -# -eval('&update__pls'); -1; -#- diff --git a/src/sys/version.idx b/src/sys/version.idx deleted file mode 100644 index 9a30586957c9c4e6ce7feec06992aa7224e0c3da..0000000000000000000000000000000000000000 --- a/src/sys/version.idx +++ /dev/null @@ -1 +0,0 @@ -Newstar Release 6.27 diff --git a/src/sys/wngfex.com b/src/sys/wngfex.com deleted file mode 100644 index 70c6dc353213396bd54c1d55cee2ad32314f8343..0000000000000000000000000000000000000000 --- a/src/sys/wngfex.com +++ /dev/null @@ -1,80 +0,0 @@ -$! WNGFEX.COM -$! WNB 920911 -$! -$! Revisions and documentation: see wngfex.csh -$! WNB 940531 Change N_SRC usage and make for non-nfra sites -$! -$ VER=F$VERIFY(0) -$ APPEND="APPEND" !MAKE SURE -$ COPY="COPY" -$ DELETE="DELETE" -$ RENAME="RENAME" -$ P1=F$EDIT(P1,"UPCASE") -$ P4=F$EDIT(P4,"UPCASE") -$ IF P3 .EQS. "" THEN P3="''P2'" -$ A=F$SEARCH(P2) !SEE IF PRESENT -$ IF A .EQS. "" THEN GOTO EXIT -$! -$ IF F$EXTRACT(0,2,P1) .EQS. "RE" THEN GOTO REN -$ IF F$EXTRACT(0,2,P1) .EQS. "CC" THEN GOTO CAT -$ IF F$EXTRACT(0,2,P1) .EQS. "LN" THEN GOTO LNK -$ IF F$EXTRACT(0,2,P1) .EQS. "LR" THEN GOTO LRM -$ IF F$EXTRACT(0,2,P1) .EQS. "RL" THEN GOTO REM -$! -$ IF F$EXTRACT(0,2,P1) .EQS. "SP" THEN GOTO SPL -$ IF F$EXTRACT(0,2,P1) .EQS. "QM" THEN GOTO QMS -$ IF F$EXTRACT(0,2,P1) .EQS. "PS" THEN GOTO PSP -$ IF F$EXTRACT(0,2,P1) .EQS. "A3" THEN GOTO PA3 -$ IF F$EXTRACT(0,2,P1) .EQS. "LA" THEN GOTO LAS -$! -$ EXIT: ON ERROR THEN EXIT -$ VER=F$VERIFY(VER) -$ EXIT -$! -$ REN: ON ERROR THEN GOTO EXIT -$ RENAME 'A' 'P3' -$ GOTO EXIT -$! -$ CAT: B=F$SEARCH(P3) !SEE IF OUTPUT PRESENT -$ ON ERROR THEN GOTO EXIT -$ IF B .NES. "" THEN APPEND 'A' 'B' -$ IF B .EQS. "" THEN COPY 'A' 'P3' -$ IF P4-"D" .NES. P4 THEN DELETE 'A' -$ GOTO EXIT -$! -$ LNK: ON ERROR THEN GOTO EXIT -$ RENAME 'A' 'P3' -$ GOTO EXIT -$! -$ LRM: ON ERROR THEN GOTO EXIT -$ RENAME 'A' 'P3' -$! -$ REM: ON ERROR THEN GOTO EXIT -$ IF "0123456789"-F$EXTRACT(0,1,P4) .EQS. "0123456789" THEN P4=5 !5 DAYS -$ DELETE/NOLOG/MODIF/BEFORE="TODAY-''P4'-00:00:00" - - *.TMP;*,*.LOG;*,*.PLT;* -$ GOTO EXIT -$! -$ SPL: B=F$EDIT(F$GETJPI("","USERNAME"),"TRIM") !USER NAME -$ C=F$PARSE(P3,,,"NAME","SYNTAX_ONLY") !FILE NAME -$ D=F$PARSE(P3,,,"TYPE","SYNTAX_ONLY") !FILE TYPE -$ ON ERROR THEN GOTO EXIT -$ @N_SRC:[sys]wngfex_'F$TRNLNM("N_SITE")'.com SP 'A' 'B'_'C''D' 'P4' -$ IF P4-"D" .NES. P4 THEN DELETE 'A' -$ GOTO EXIT -$! -$ QMS: ON ERROR THEN GOTO EXIT -$ @N_SRC:[sys]wngfex_'F$TRNLNM("N_SITE")'.com QM 'A' "" 'P4' -$ GOTO EXIT -$! -$ PSP: ON ERROR THEN GOTO EXIT -$ @N_SRC:[sys]wngfex_'F$TRNLNM("N_SITE")'.com PS 'A' "" 'P4' -$ GOTO EXIT -$! -$ PA3: ON ERROR THEN GOTO EXIT -$ @N_SRC:[sys]wngfex_'F$TRNLNM("N_SITE")'.com A3 'A' "" 'P4' -$ GOTO EXIT -$! -$ LAS: ON ERROR THEN GOTO EXIT -$ @N_SRC:[sys]wngfex_'F$TRNLNM("N_SITE")'.com LA 'A' "" 'P4' -$ GOTO EXIT diff --git a/src/sys/wngfex.csh b/src/sys/wngfex.csh deleted file mode 100755 index 779d990c5024dcc5678c1104c8fc8af5a95df3b0..0000000000000000000000000000000000000000 --- a/src/sys/wngfex.csh +++ /dev/null @@ -1,160 +0,0 @@ -#!/bin/csh -f -# wngfex.csh -# WNB 920911 -# -# Revisions: -# HjV 920914 Add type LA (print text on laser-printer) -# WNB 920917 New spooling command atnf -# WNB 920917 Delete setenv WNG_SITE and other typos ({}!!) -# HjV 920922 Get correct filename and replace loch by locr -# WNB 921006 Change to non-binary for PostScript -# WNB 921006 Error in RUG TXA4:: and 5:: -# WNB 921013 Change ATNF for PostScript error -# WNB 921021 Add A3 plotter -# WNB 921126 More lines for atnf printer -# WNB 921130 Change tr for HP -# HjV 921203 Add site RAIUB -# HjV 921215 Change for RUG -# WNB 921222 Add LN, RL, LR -# WNB 921222 Make it into WNGFEX.SSC; remove A3 etc from non-nfra -# HjV 930115 Finalize A3 plotter for UNIX -# print direct on PS-printer on NFRA for UNIX-machines -# HjV 930226 Add site WSRT, add HP for NFRA -# HjV 930414 Take correct PS-printer on NFRA-VAX -# Change command to print on NFRA-HP -# HjV 930630 Add site KOSMA, change VAX-NFRA queue CMPQ into CMPS -# CMV 930707 Split out site dependent parts in separate files -# CMV 931216 Switched off the 'purge' for logfiles -# HjV 940331 Add -f to 'rm' and 'mv' -# CMV 940418 Remove empty log-files -# JPH 970205 Insert a sleep 5 in EXIT to circumvent problems with -# jet5 printer (plot jobs getting lost, print jobs -# getting mixed up -# -# General file handling -# -# Use as: WNGFEX command name1 name2 action -# Type can be: -# SP spool file nam1 as nam2 -# QM spool nam1 as nam2 to QMS plotter -# PS spool nam1 as nam2 to PS plotter -# A3 spool nam1 as nam2 to A3-PS plotter -# LA spool nam1 as nam2 to LAser printer -# -# RE rename file nam1 into nam2 -# CC concatenate file nam1 onto nam2 -# LN make logical link nam2 to nam1 -# RL delete all .log, .tmp, .PLT or size == 0 -# older than action (or 5) days -# LR combine LN and RL -# -# Action is series of letters: -# D delete file after spooling and concatenation -# or an unsigned value for RL/LR -# -#echo "WNGFEX: $argv" -#set echo - -# -# Need at least command and file to act upon -# -if ($#argv < 2) goto EXIT # no file names - -# -# First argument: name of command ($loa) -# -set loa=`echo $argv[1] | tr '[A-Z]' '[a-z]' ` # type - -# -# Second argument: input file -# -set lob=$argv[2] # input name - -# -# Optional third argument: name for output file ($loc) -# -if ($#argv < 3) then # no output name - set loc=$lob # same -else - set loc=$argv[3] # output name -endif - -# -# Optional fourth argument: delete flags ($lod) -# -set lod="" -if ($#argv > 3) set lod=`echo $argv[4] | tr '[A-Z]' '[a-z]' ` # action - -# -# Construct name for temporary file -# -set loct=${USER}_${loc:t} -if (-e $loct) then - 'rm' -f $loct -endif - -if ($loa =~ re*) then # rename - if (! -e $lob) goto EXIT # file unknown - if (-z $lob) then - 'rm' -f $lob - else - 'mv' -f $lob $loc - endif -else if ($loa =~ cc*) then # concatenate - if (! -e $lob) goto EXIT # file unknown - if (-e $loc) then # append to known - @ statx = { cat $lob >> $loc } - else # copy to unknown - @ statx = { cat $lob > $loc } - endif - if (! $statx) then # ok - if ($lod =~ *d*) 'rm' -f $lob # delete - endif -else if ($loa =~ ln*) then # link - if (! -e $lob) goto EXIT # file unknown - if (-z $lob) then - 'rm' -f $lob - else - 'rm' -f $loc >& /dev/null # remove old link - ln -s $lob $loc # make link - endif -else if ($loa =~ lr*) then # link and remove - if (! -e $lob) goto EXIT # file unknown - if (-z $lob) then - 'rm' -f $lob - else - 'rm' -f $loc >& /dev/null # remove old link - ln -s $lob $loc # make link - endif -else if ($loa =~ rl*) then # remove tmp, log, PLT, size 0 - if ("$lod" == "" || "0123456789" !~ *$lod*) set lod=5 -# set loo='( -name *.[tT][mM][pP] -o -name *.[lL][oO][gG]' - set loo='( -name *.[tT][mM][pP] ' - set loo="$loo -o -name *.PLT -o -size 0 )" - set lop="-atime +$lod -exec rm -f {} ;" - set noglob; find . $loo $lop >& /dev/null; unset noglob -# -# Printing actions -# -else - if (! -e $lob) goto EXIT # file unknown - if (-e $n_src/sys/wngfex_$n_site.csh) then - @ statx = 0 - source $n_src/sys/wngfex_$n_site.csh - if (! $statx) then # ok - if ($lod =~ *d*) 'rm' -f $lob # delete - endif - else - echo "Error: cannot find wngfex_$n_site.csh - endif -endif - -EXIT: -if ($?loct) then - if (-e ${loct}) then - sleep 5 - 'rm' -f ${loct} - endif -endif - -exit diff --git a/src/sys/wngfex_airub.csh b/src/sys/wngfex_airub.csh deleted file mode 100755 index 5da928669cdfa74d53c958681e3d56f9f60d8430..0000000000000000000000000000000000000000 --- a/src/sys/wngfex_airub.csh +++ /dev/null @@ -1,27 +0,0 @@ -#! /bin/csh -#+wngfex_airub.csh -# -# File with system dependent commands for Newstar site AIRUB -# -# Called by wngfex.csh with the command in $loa, the name of the -# input file in $lob and the name of the spool-file in $loc. -# The name for a temporary spool file is in $loct. -# The status of the command, if available, should be returned in statx. -# - -if ($loa =~ sp*) then # spool - -else if ($loa =~ qm*) then # spool QMS - -else if ($loa =~ ps*) then # spool PS - ln -s $lob $loct - @ statx = { lpr $loct } - set statx=1 # make sure file kept - -else if ($loa =~ a3*) then # spool A3 - -else if ($loa =~ la*) then # spool LA - -endif -#- - diff --git a/src/sys/wngfex_arecb.csh b/src/sys/wngfex_arecb.csh deleted file mode 100755 index 6cd0cc39309a4ec47daf21f2f02ebecb720ea6d2..0000000000000000000000000000000000000000 --- a/src/sys/wngfex_arecb.csh +++ /dev/null @@ -1,28 +0,0 @@ -#! /bin/csh -#+wngfex_arecb.csh -# -# File with system dependent commands for Newstar site ARECB -# -# Called by wngfex.csh with the command in $loa, the name of the -# input file in $lob and the name of the spool-file in $loc. -# The name for a temporary spool file is in $loct. -# The status of the command, if available, should be returned in statx. -# - -if ($loa =~ sp*) then # spool - ln -s $lob $loct - @ statx = { enscript -p $loct } - -else if ($loa =~ qm*) then # spool QMS - -else if ($loa =~ ps*) then # spool PS - ln -s $lob $loct - @ statx = { lpr $loct } - set statx=1 # make sure file kept - -else if ($loa =~ a3*) then # spool A3 - -else if ($loa =~ la*) then # spool LA - -endif -#- diff --git a/src/sys/wngfex_atnf.com b/src/sys/wngfex_atnf.com deleted file mode 100644 index bea1c3110c4d49bd3f7d83e39bb5e3b296fc6d61..0000000000000000000000000000000000000000 --- a/src/sys/wngfex_atnf.com +++ /dev/null @@ -1,28 +0,0 @@ -$!+wngfex_atnf.com -$! -$! File with system dependent commands for Newstar site ATNF (VAX version) -$! -$! Called by wngfex.com with the command in P1, the name of the -$! input file in P2 and the name of the spool-file in P3. -$! If the file has to be deleted after spooling, P4 will be equal to "D" -$! -$ if (P1 .eqs. "SP") -$ then -$ COPY 'P2' 'P3' -$ LW132 'P3' -$ DELETE 'P3';* -$ endif -$! -$ if (P1 .eqs. "PS") THEN LASER 'P2' -$! -$ if (P1 .eqs. "LA") -$ then -$ IF P4-"D" .NES. P4 -$ THEN -$ PRINT/DELETE 'P2' -$ ELSE -$ PRINT 'P2' -$ ENDIF -$ endif -$! -$!- diff --git a/src/sys/wngfex_atnf.csh b/src/sys/wngfex_atnf.csh deleted file mode 100755 index 7aaace686716a989acce017953a88ee05ca82e02..0000000000000000000000000000000000000000 --- a/src/sys/wngfex_atnf.csh +++ /dev/null @@ -1,29 +0,0 @@ -#! /bin/csh -#+wngfex_atnf.csh -# -# File with system dependent commands for Newstar site ATNF -# -# Called by wngfex.csh with the command in $loa, the name of the -# input file in $lob and the name of the spool-file in $loc. -# The name for a temporary spool file is in $loct. -# The status of the command, if available, should be returned in statx. -# - -if ($loa =~ sp*) then # spool - awk 'NR > 1 || length($0) > 1 {print}' $lob >! $loct # delete ^L - @ statx = { lwl -s8 $loct } - -else if ($loa =~ qm*) then # spool QMS - -else if ($loa =~ ps*) then # spool PS - ln -s $lob $loct - @ statx = { laser $loct } - set statx=1 # make sure file kept - -else if ($loa =~ a3*) then # spool A3 - -else if ($loa =~ la*) then # spool LA - -endif -#- - diff --git a/src/sys/wngfex_bao.csh b/src/sys/wngfex_bao.csh deleted file mode 100755 index 05a2ae2933a6e688f112b32cb1a3aa15b18fb6aa..0000000000000000000000000000000000000000 --- a/src/sys/wngfex_bao.csh +++ /dev/null @@ -1,27 +0,0 @@ -#! /bin/csh -#+wngfex_bao.csh -# -# File with system dependent commands for Newstar site BAO -# -# Called by wngfex.csh with the command in $loa, the name of the -# input file in $lob and the name of the spool-file in $loc. -# The name for a temporary spool file is in $loct. -# The status of the command, if available, should be returned in statx. -# - -if ($loa =~ sp*) then # spool - -else if ($loa =~ qm*) then # spool QMS - -else if ($loa =~ ps*) then # spool PS - ln -s $lob $loct - @ statx = { lpr $loct } - set statx=1 # make sure file kept - -else if ($loa =~ a3*) then # spool A3 - -else if ($loa =~ la*) then # spool LA - -endif -#- - diff --git a/src/sys/wngfex_calt.csh b/src/sys/wngfex_calt.csh deleted file mode 100755 index 2b975324b2b512318b52a40dae1cf7b34240c3c3..0000000000000000000000000000000000000000 --- a/src/sys/wngfex_calt.csh +++ /dev/null @@ -1,29 +0,0 @@ -#! /bin/csh -#+wngfex_calt.csh -# -# File with system dependent commands for Newstar site CALT -# -# Called by wngfex.csh with the command in $loa, the name of the -# input file in $lob and the name of the spool-file in $loc. -# The name for a temporary spool file is in $loct. -# The status of the command, if available, should be returned in statx. -# -#- - -if ($loa =~ sp*) then # spool - ln -s $lob $loct - @ statx = { lpr -Pps1 $loct } - -else if ($loa =~ qm*) then # spool QMS - -else if ($loa =~ ps*) then # spool PS - ln -s $lob $loct - @ statx = { lpr $loct } - set statx=1 # make sure file kept - -else if ($loa =~ a3*) then # spool A3 - -else if ($loa =~ la*) then # spool LA - -endif - diff --git a/src/sys/wngfex_estec.csh b/src/sys/wngfex_estec.csh deleted file mode 100755 index 0a11fe23d8fd170bd923b894e8947d3d86574198..0000000000000000000000000000000000000000 --- a/src/sys/wngfex_estec.csh +++ /dev/null @@ -1,29 +0,0 @@ -#! /bin/csh -#+wngfex_estec.csh -# -# File with system dependent commands for Newstar site ESTEC -# -# Called by wngfex.csh with the command in $loa, the name of the -# input file in $lob and the name of the spool-file in $loc. -# The name for a temporary spool file is in $loct. -# The status of the command, if available, should be returned in statx. -# - -if ($loa =~ sp*) then # spool - ln -s $lob $loct - @ statx = { wpr $loct } - -else if ($loa =~ qm*) then # spool QMS - -else if ($loa =~ ps*) then # spool PS - ln -s $lob $loct - @ statx = { lpr $loct } - set statx=1 # make sure file kept - -else if ($loa =~ a3*) then # spool A3 - -else if ($loa =~ la*) then # spool LA - -endif -#- - diff --git a/src/sys/wngfex_irabo.csh b/src/sys/wngfex_irabo.csh deleted file mode 100755 index 58796db1f12d3e8a22a5a0059f6a1a8191a227dc..0000000000000000000000000000000000000000 --- a/src/sys/wngfex_irabo.csh +++ /dev/null @@ -1,32 +0,0 @@ -#! /bin/csh -#+wngfex_irabo.csh -# -# Revision: -# -# File with system dependent commands for Newstar site IRABO -# -# Called by wngfex.csh with the command in $loa, the name of the -# input file in $lob and the name of the spool-file in $loc. -# The name for a temporary spool file is in $loct. -# The status of the command, if available, should be returned in statx. -# - -if ($loa =~ sp*) then # spool - ln -s $lob $loct - @ statx = { lpr -Plpa0 $loct } - set statx=1 # make sure file kept - -else if ($loa =~ qm*) then # spool QMS - -else if ($loa =~ ps*) then # spool PS (A4) - ln -s $lob $loct - @ statx = { print $loct } - set statx=1 # make sure file kept - -else if ($loa =~ a3*) then # spool A3 - -else if ($loa =~ la*) then # spool LA - -endif -#- - diff --git a/src/sys/wngfex_kosma.com b/src/sys/wngfex_kosma.com deleted file mode 100644 index b52f4bd8c536bfa41a94b501914eebd02c569dbd..0000000000000000000000000000000000000000 --- a/src/sys/wngfex_kosma.com +++ /dev/null @@ -1,42 +0,0 @@ -$!+wngfex_kosma.com -$! -$! File with system dependent commands for Newstar site KOSMA (VAX version) -$! -$! Called by wngfex.com with the command in P1, the name of the -$! input file in P2 and the name of the spool-file in P3. -$! If the file has to be deleted after spooling, P4 will be equal to "D" -$! -$ if (P1 .eqs. "SP") -$ then -$ COPY 'P2' 'P3' -$ IF P4-"D" .NES. P4 -$ THEN -$ PRINT/QUEUE=MATRIX_LA100/DELETE 'P3' -$ ELSE -$ PRINT/QUEUE=MATRIX_LA100 'P3' -$ ENDIF -$ endif -$! -$ if (P1 .eqs. "PS") -$ then -$ IF P4-"D" .NES. P4 -$ THEN -$ PRINT/QUEUE=POSTSCRIPT/DELETE 'P2' -$ ELSE -$ PRINT/QUEUE=POSTSCRIPT 'P2' -$ ENDIF -$ endif -$! -$ if (P1 .eqs. "LA") -$ then -$ IF P4-"D" .NES. P4 -$ THEN -$ PRINT/QUEUE=LASERJET/DELETE 'A' -$ ELSE -$ PRINT/QUEUE=LASERJET 'A' -$ ENDIF -$ endif -$! -$!- - - diff --git a/src/sys/wngfex_kosma.csh b/src/sys/wngfex_kosma.csh deleted file mode 100755 index 34049a4fd0065bcc5f52c5b3558a1c6b0c50c0b6..0000000000000000000000000000000000000000 --- a/src/sys/wngfex_kosma.csh +++ /dev/null @@ -1,32 +0,0 @@ -#! /bin/csh -#+wngfex_kosma.csh -# -# File with system dependent commands for Newstar site KOSMA -# -# Called by wngfex.csh with the command in $loa, the name of the -# input file in $lob and the name of the spool-file in $loc. -# The name for a temporary spool file is in $loct. -# The status of the command, if available, should be returned in statx. -# - -if ($loa =~ sp*) then # spool - ln -s $lob $loct - @ statx = { lp -dla100 $loct } - -else if ($loa =~ qm*) then # spool QMS - -else if ($loa =~ ps*) then # spool PS - ln -s $lob $loct - @ statx = { lp -dpostscript $loct } - set statx=1 # make sure file kept - -else if ($loa =~ a3*) then # spool A3 - -else if ($loa =~ la*) then # spool LA - ln -s $lob $loct - @ statx = { lp -dlaserjet $loct } - set statx=1 # make sure file kept - -endif -#- - diff --git a/src/sys/wngfex_lick.csh b/src/sys/wngfex_lick.csh deleted file mode 100755 index 418528b957e8a14e1128241c17262ded69dee2b3..0000000000000000000000000000000000000000 --- a/src/sys/wngfex_lick.csh +++ /dev/null @@ -1,34 +0,0 @@ -#! /bin/csh -#+wngfex_lick.csh -# -# File with system dependent commands for Newstar site LICK -# -# Called by wngfex.csh with the command in $loa, the name of the -# input file in $lob and the name of the spool-file in $loc. -# The name for a temporary spool file is in $loct. -# The status of the command, if available, should be returned in statx. -# - -if ($loa =~ sp*) then # spool - ln -s $lob $loct - @ statx = { enscript -r $loct } - -else if ($loa =~ qm*) then # spool QMS - -else if ($loa =~ ps*) then # spool PS - ln -s $lob $loct - @ statx = { psnup $loct } - set statx=1 # make sure file kept - -else if ($loa =~ a3*) then # spool A3 - ln -s $lob $loct - @ statx = { psnup $loct } - set statx=1 # make sure file kept - -else if ($loa =~ la*) then # spool LA - ln -s $lob $loct - @ statx = { psnup $loct } - -endif -#- - diff --git a/src/sys/wngfex_nfra.com b/src/sys/wngfex_nfra.com deleted file mode 100644 index 932f259b73d96b44a95a9c27dfea76c0169b8b1a..0000000000000000000000000000000000000000 --- a/src/sys/wngfex_nfra.com +++ /dev/null @@ -1,48 +0,0 @@ -$!+wngfex_nfra.com -$! -$! File with system dependent commands for Newstar site NFRA (VAX version) -$! -$! Called by wngfex.com with the command in P1, the name of the -$! input file in P2 and the name of the spool-file in P3. -$! If the file has to be deleted after spooling, P4 will be equal to "D" -$! -$ if (P1 .eqs. "SP") then COPY 'P2' RZMVX5::LPA0:'P3' -$! -$ if (P1 .eqs. "QM") -$ then -$ IF P4-"D" .NES. P4 -$ THEN -$ PRINT/QUEUE=QMSQ/PASSALL/DELETE 'P2' -$ ELSE -$ PRINT/QUEUE=QMSQ/PASSALL 'P2' -$ ENDIF -$ endif -$! -$ if (p1 .eqs. "PS") -$ then -$ IF P4-"D" .NES. P4 -$ THEN -$ PRINT/QUEUE=CMPS/DELETE 'P2' -$ ELSE -$ PRINT/QUEUE=CMPS 'P2' -$ ENDIF -$ endif -$! -$ if (p1 .eqs. "A3") -$ then -$ IF P4-"D" .NES. P4 -$ THEN -$ PRINT/QUEUE=CMPS/DELETE 'P2' -$ ELSE -$ PRINT/QUEUE=CMPS 'P2' -$ ENDIF -$ endif -$! -$ if (P1 .eqs. "LA") -$ then -$ COPY 'P2' RZMVX4::TXA4:'P2' -$ IF P4-"D" .NES. P4 THEN DELETE 'P2' -$ endif -$! -$!- - diff --git a/src/sys/wngfex_nfra.csh b/src/sys/wngfex_nfra.csh deleted file mode 100755 index 924886392016f87217c00128058ee0bbc86e8ef0..0000000000000000000000000000000000000000 --- a/src/sys/wngfex_nfra.csh +++ /dev/null @@ -1,88 +0,0 @@ -#! /bin/csh -#+wngfex_nfra.csh -# -# File with system dependent commands for Newstar site NFRA -# Revision: -# 950130 HjV Use $HOME in directories iso. ~ or ~/ -# 950705 HjV Add A0-plotter -# 970121 HjV Use LPDEST (if set), else use PSPRINT -# Add Solaris -# -# Called by wngfex.csh with the command in $loa, the name of the -# input file in $lob and the name of the spool-file in $loc. -# The name for a temporary spool file is in $loct. -# The status of the command, if available, should be returned in statx. -# - -if ($loa =~ sp*) then # spool - @ statx = { ftp -n << _EOD_ } - open rzmvx5 - user printvax printvax_90a - put $lob lpa0:$loct # print - close - quit -_EOD_ - -else if ($loa =~ qm*) then # spool QMS -# @ statx = { ftp -n << _EOD_ } -# open rzmvx5 -# user printvax printvax_90a -# binary -# put $lob $loct # print -# close -# quit -#_EOD_ - -else if ($loa =~ ps* || $loa =~ a3*) then # spool PS / A3 - ln -s $lob $loct - if ("$n_arch" == "sw" || "$n_arch" == "so" ) then - if ($?LPDEST) then # did user set LPDEST - @ statx = { lp $loct } # yes - else - @ statx = { lpr -Ppsprint $loct } # no - endif -# @ statx = { lpr -Pqms860 $loct } - set statx=1 # make sure file kept - else if ("$n_arch" == "hp") then - if ($?LPDEST) then # did user set LPDEST - @ statx = { lp $loct } # yes - else - @ statx = { lpr -dpsprint $loct } # no - endif -# cp $loct $HOME/$loct -# remsh rzmws0 'lpr -Pqms860 $HOME/'$loct -# sleep 10 -# rm $HOME/$loct -# set statx=1 # make sure file kept -# else if ("$n_arch" == "al") then -# @ statx = { lpr -Ppmq $loct } -# set statx=1 # make sure file kept - else - set statx=1 # make sure file kept - endif - -else if ($loa =~ a0*) then # spool A0 - ln -s $lob $loct - if ("$n_arch" == "sw" || "$n_arch" == "so" ) then - @ statx = { lpr -Pjet650 $loct } - set statx=1 # make sure file kept - else if ("$n_arch" == "hp") then - @ statx = { lpr -djet650 $loct } - set statx=1 # make sure file kept - else - set statx=1 # make sure file kept - endif - -else if ($loa =~ la*) then # spool LA - ln -s $lob $loct - @ statx = { ftp -n << _EOD_ } - open rzmvx4 - user printvax printvax_90a - put $lob TXA4:$loct # print - close - quit -_EOD_ - -endif -#- - diff --git a/src/sys/wngfex_raiub.csh b/src/sys/wngfex_raiub.csh deleted file mode 100755 index f33e6ec866dd56ba4a86327737e88ebe7c6ae54b..0000000000000000000000000000000000000000 --- a/src/sys/wngfex_raiub.csh +++ /dev/null @@ -1,40 +0,0 @@ -#! /bin/csh -#+wngfex_raiub.csh -# 960802 HjV Add Alpha/OSF1 -# 971029 Helge Rottmann Add Solaris stuff -# -# File with system dependent commands for Newstar site RAIUB -# -# Called by wngfex.csh with the command in $loa, the name of the -# input file in $lob and the name of the spool-file in $loc. -# The name for a temporary spool file is in $loct. -# The status of the command, if available, should be returned in statx. -# - -if ($loa =~ sp*) then # spool - ln -s $lob $loct - if ("$n_arch" == "sw" ) then - @ statx = { lpr $loct } - else if ("$n_arch" == "da" ) then - @ statx = { lpr -Plp $loct } - endif - -else if ($loa =~ qm*) then # spool QMS - -else if ($loa =~ ps*) then # spool PS - ln -s $lob $loct - if ("$n_arch" == "sw" ) then - @ statx = { lpr -Pps2 $loct } - else if ("$n_arch" == "so" ) then - @ statx = { lp -d ps2 -o nobanner $loct } - else if ("$n_arch" == "da" ) then - @ statx = { lpr -Pps2 $loct } - endif - set statx=1 # make sure file kept - -else if ($loa =~ a3*) then # spool A3 - -else if ($loa =~ la*) then # spool LA - -endif -#- diff --git a/src/sys/wngfex_rug.csh b/src/sys/wngfex_rug.csh deleted file mode 100755 index 339deccfdab736e19df30ea4dd2ed83edd72d27c..0000000000000000000000000000000000000000 --- a/src/sys/wngfex_rug.csh +++ /dev/null @@ -1,32 +0,0 @@ -#! /bin/csh -#+wngfex_rug.csh -# -# File with system dependent commands for Newstar site RUG -# -# Called by wngfex.csh with the command in $loa, the name of the -# input file in $lob and the name of the spool-file in $loc. -# The name for a temporary spool file is in $loct. -# The status of the command, if available, should be returned in statx. -# - -if ($loa =~ sp*) then # spool - ln -s $lob $loct - @ statx = { land -Pps1 $loct } - -else if ($loa =~ qm*) then # spool QMS - -else if ($loa =~ ps*) then # spool PS - ln -s $lob $loct - @ statx = { lp -dps1 $loct } - set statx=1 # make sure file kept - -else if ($loa =~ a3*) then # spool A3 - -else if ($loa =~ la*) then # spool LA - ln -s $lob $loct - @ statx = { port -Pps1 $loct } - set statx=1 # make sure file kept - -endif -#- - diff --git a/src/sys/wngfex_rul.csh b/src/sys/wngfex_rul.csh deleted file mode 100755 index 01b94da395d0ee40bbfed5214f1f21efe5a56137..0000000000000000000000000000000000000000 --- a/src/sys/wngfex_rul.csh +++ /dev/null @@ -1,33 +0,0 @@ -#! /bin/csh -#+wngfex_rul.csh -# -# Revision: -# 950623 HjV Change for new situation -# -# File with system dependent commands for Newstar site Rul -# -# Called by wngfex.csh with the command in $loa, the name of the -# input file in $lob and the name of the spool-file in $loc. -# The name for a temporary spool file is in $loct. -# The status of the command, if available, should be returned in statx. -# - -if ($loa =~ sp*) then # spool - ln -s $lob $loct - @ statx = { print -l -w $loct } - set statx=1 # make sure file kept - -else if ($loa =~ qm*) then # spool QMS - -else if ($loa =~ ps*) then # spool PS (A4) - ln -s $lob $loct - @ statx = { print $loct } - set statx=1 # make sure file kept - -else if ($loa =~ a3*) then # spool A3 - -else if ($loa =~ la*) then # spool LA - -endif -#- - diff --git a/src/sys/wngfex_ruu.csh b/src/sys/wngfex_ruu.csh deleted file mode 100755 index afe5887f8742e4ae78807211d5f2e53c0cabf67c..0000000000000000000000000000000000000000 --- a/src/sys/wngfex_ruu.csh +++ /dev/null @@ -1,34 +0,0 @@ -#! /bin/csh -#+wngfex_ruu.csh -# -# File with system dependent commands for Newstar site RUU -# -# Called by wngfex.csh with the command in $loa, the name of the -# input file in $lob and the name of the spool-file in $loc. -# The name for a temporary spool file is in $loct. -# The status of the command, if available, should be returned in statx. -# - -if ($loa =~ sp*) then # spool - ln -s $lob $loct - @ statx = { apps -Pstkhp $loct } - -else if ($loa =~ qm*) then # spool QMS - -else if ($loa =~ ps*) then # spool PS - ln -s $lob $loct - @ statx = { lpr -Pstkhp $loct } - set statx=1 # make sure file kept - -else if ($loa =~ a3*) then # spool A3 - ln -s $lob $loct - @ statx = { lpr -Pps $loct } - set statx=1 # make sure file kept - -else if ($loa =~ la*) then # spool LA - ln -s $lob $loct - @ statx = { apps -Pstkhp $loct } - -endif -#- - diff --git a/src/sys/wngfex_sron.csh b/src/sys/wngfex_sron.csh deleted file mode 100755 index 9beaa060bdfedf58763952c93cebac19d2b70954..0000000000000000000000000000000000000000 --- a/src/sys/wngfex_sron.csh +++ /dev/null @@ -1,34 +0,0 @@ -#! /bin/csh -#+wngfex_sron.csh -# -# File with system dependent commands for Newstar site SRON -# -# Called by wngfex.csh with the command in $loa, the name of the -# input file in $lob and the name of the spool-file in $loc. -# The name for a temporary spool file is in $loct. -# The status of the command, if available, should be returned in statx. -# - -if ($loa =~ sp*) then # spool - ln -s $lob $loct - @ statx = { lp $loct } - -else if ($loa =~ qm*) then # spool QMS - -else if ($loa =~ ps*) then # spool PS - ln -s $lob $loct - @ statx = { lpr -onb -dpsk $loct } - set statx=1 # make sure file kept - -else if ($loa =~ a3*) then # spool A3 - ln -s $lob $loct - @ statx = { lp -Ppsm $loct } - set statx=1 # make sure file kept - -else if ($loa =~ la*) then # spool LA - ln -s $lob $loct - @ statx = { lp $loct } - -endif -#- - diff --git a/src/sys/wngfex_ucb.csh b/src/sys/wngfex_ucb.csh deleted file mode 100755 index 60604547d1e8d731a19d4cda04c440b8582e7c91..0000000000000000000000000000000000000000 --- a/src/sys/wngfex_ucb.csh +++ /dev/null @@ -1,24 +0,0 @@ -#! /bin/csh -#+wngfex_ucb.csh -# -# File with system dependent commands for Newstar site UCB -# -# Called by wngfex.csh with the command in $loa, the name of the -# input file in $lob and the name of the spool-file in $loc. -# The name for a temporary spool file is in $loct. -# The status of the command, if available, should be returned in statx. -# - -if ($loa =~ sp*) then # spool - ln -s $lob $loct - @ statx = { enscript -r $loct } - set statx=1 # make sure file kept -endif - -if ($loa =~ ps* || $loa =~ a3*) then # spool PS /A3 - ln -s $lob $loct - @ statx = { lp $loct } - set statx=1 # make sure file kept -endif -#- - diff --git a/src/sys/wngfex_ucsb.csh b/src/sys/wngfex_ucsb.csh deleted file mode 100755 index b1f2f96682d862708787fcd60a313bbbda538c0d..0000000000000000000000000000000000000000 --- a/src/sys/wngfex_ucsb.csh +++ /dev/null @@ -1,18 +0,0 @@ -#! /bin/csh -#+wngfex_ucsb.csh -# -# File with system dependent commands for Newstar site UCSB -# -# Called by wngfex.csh with the command in $loa, the name of the -# input file in $lob and the name of the spool-file in $loc. -# The name for a temporary spool file is in $loct. -# The status of the command, if available, should be returned in statx. -# - -if ($loa =~ sp* || $loa =~ la* || $loa =~ ps* || $loa =~ a3*) then # spool all - ln -s $lob $loct - @ statx = { lpr $loct } - set statx=1 # make sure file kept -endif -#- - diff --git a/src/sys/wngfex_uva.csh b/src/sys/wngfex_uva.csh deleted file mode 100755 index 252d215505562d1ece4e99b947d78954e9490b85..0000000000000000000000000000000000000000 --- a/src/sys/wngfex_uva.csh +++ /dev/null @@ -1,34 +0,0 @@ -#! /bin/csh -#+wngfex_uva.csh -# -# File with system dependent commands for Newstar site UvA -# -# Called by wngfex.csh with the command in $loa, the name of the -# input file in $lob and the name of the spool-file in $loc. -# The name for a temporary spool file is in $loct. -# The status of the command, if available, should be returned in statx. -# - -if ($loa =~ sp*) then # spool - ln -s $lob $loct - @ statx = { lpb132 $loct } - -else if ($loa =~ qm*) then # spool QMS - -else if ($loa =~ ps*) then # spool PS - ln -s $lob $loct - @ statx = { lpb $loct } - set statx=1 # make sure file kept - -else if ($loa =~ a3*) then # spool A3 - ln -s $lob $loct - @ statx = { lpb $loct } - set statx=1 # make sure file kept - -else if ($loa =~ la*) then # spool LA - ln -s $lob $loct - @ statx = { lpb132 $loct } - -endif -#- - diff --git a/src/sys/wngfex_wenss.csh b/src/sys/wngfex_wenss.csh deleted file mode 100755 index 152da772d71c00c1ed8fc9d9815f6ed30d8491d3..0000000000000000000000000000000000000000 --- a/src/sys/wngfex_wenss.csh +++ /dev/null @@ -1,78 +0,0 @@ -#! /bin/csh -#+wngfex_wenss.csh -# -# File with system dependent commands for Newstar site WENSS -# Revision: -# 950529 HjV Create (just copy of wngfex_nfra.csh) -# 950705 HjV Add A0-plotter -# -# Called by wngfex.csh with the command in $loa, the name of the -# input file in $lob and the name of the spool-file in $loc. -# The name for a temporary spool file is in $loct. -# The status of the command, if available, should be returned in statx. -# - -if ($loa =~ sp*) then # spool - @ statx = { ftp -n << _EOD_ } - open rzmvx5 - user printvax printvax_90a - put $lob lpa0:$loct # print - close - quit -_EOD_ - -else if ($loa =~ qm*) then # spool QMS -# @ statx = { ftp -n << _EOD_ } -# open rzmvx5 -# user printvax printvax_90a -# binary -# put $lob $loct # print -# close -# quit -#_EOD_ - -else if ($loa =~ ps* || $loa =~ a3*) then # spool PS / A3 - ln -s $lob $loct - if ("$n_arch" == "sw" ) then - @ statx = { lpr -Ppsprint $loct } -# @ statx = { lpr -Pqms860 $loct } - set statx=1 # make sure file kept - else if ("$n_arch" == "hp") then - @ statx = { lpr -dpsprint $loct } -# cp $loct $HOME/$loct -# remsh rzmws0 'lpr -Pqms860 $HOME/'$loct -# sleep 10 -# rm $HOME/$loct -# set statx=1 # make sure file kept - else if ("$n_arch" == "al") then - @ statx = { lpr -Ppmq $loct } - set statx=1 # make sure file kept - else - set statx=1 # make sure file kept - endif - -else if ($loa =~ a0*) then # spool A0 - ln -s $lob $loct - if ("$n_arch" == "sw" ) then - @ statx = { lpr -Pjet650 $loct } - set statx=1 # make sure file kept - else if ("$n_arch" == "hp") then - @ statx = { lpr -djet650 $loct } - set statx=1 # make sure file kept - else - set statx=1 # make sure file kept - endif - -else if ($loa =~ la*) then # spool LA - ln -s $lob $loct - @ statx = { ftp -n << _EOD_ } - open rzmvx4 - user printvax printvax_90a - put $lob TXA4:$loct # print - close - quit -_EOD_ - -endif -#- - diff --git a/src/sys/wngfex_wsrt.csh b/src/sys/wngfex_wsrt.csh deleted file mode 100755 index 8254ee9dd26f0b2e62849d3b521043a38080686e..0000000000000000000000000000000000000000 --- a/src/sys/wngfex_wsrt.csh +++ /dev/null @@ -1,31 +0,0 @@ -#! /bin/csh -#+wngfex_wsrt.csh -# -# File with system dependent commands for Newstar site WSRT -# -# Called by wngfex.csh with the command in $loa, the name of the -# input file in $lob and the name of the spool-file in $loc. -# The name for a temporary spool file is in $loct. -# The status of the command, if available, should be returned in statx. -# - -if ($loa =~ sp*) then # spool - ln -s $lob $loct - @ statx = { lp $loct } - -else if ($loa =~ qm*) then # spool QMS - -else if ($loa =~ ps*) then # spool PS - ln -s $lob $loct - @ statx = { lp $loct } - set statx=1 # make sure file kept - -else if ($loa =~ a3*) then # spool A3 - ln -s $lob $loct - @ statx = { lp -oA3 $loct } - set statx=1 # make sure file kept - -else if ($loa =~ la*) then # spool LA - -endif -#- diff --git a/src/sys/xmosaic_restart.csh b/src/sys/xmosaic_restart.csh deleted file mode 100755 index 502d3c4be5e6532f4b03a85a4298ddd4f2353fa1..0000000000000000000000000000000000000000 --- a/src/sys/xmosaic_restart.csh +++ /dev/null @@ -1,140 +0,0 @@ -#! /bin/csh -f -# -# xmosaic_restart.csh - (re)start www browser -# arguments: -# $1 program name (upper or lower case) -# $2 keyword (must be upper case) -# -# Revisions: -# HjV 950227 Typo in find target file -# JPH 951006 Change string for Parameter search. - Sleep 3 --> 1 -# JPH 951121 Replace automatic sync by user verification -# Add support for netscape, new env. symbol n_www -# HjV 960102 Change test for netscape in *netscape* -# JPH 970305 Remove redundant n_www definition. -# Check against recycled pid (which caused the procedure -# to hang in its attempt to remotely activate netscape) -# JPH 970819 Extend check on result of `ps $pid` test for a running -# $n_www (ps does not necessarily return an error status) -# JPH 980127 Set noglob for processing xm_$DISPLAY file (Solaris) -# JPH 990111 Bug fix: Preset variable y -# Display error messages from browser -# JPH 991117 ps --> ps -p for Solaris - -##set echo - if (! $?n_www) setenv n_www netscape - set target = () ##$n_hlp/homepage.html - - if ($#argv) then - set Argv = ( $argv ) - set argv = (`echo $argv | sed -e 'y:ABCDEFGHIJKLMNOPQRSTUVWXYZ_:abcdefghijklmnopqrstuvwxyz.:' `) -# -# Find the target file -# - set target = `grep -l 'Parameter '"$Argv[2]" $n_hlp/${argv[1]}_private_intfc/${argv[1]}_private_intfc.html` - if ($#target != 0) then - set typ = 'private' - else - set target = `grep -l 'Parameter '"$Argv[2]" $n_hlp/*_public_intfc/*_public_intfc.html` - if ($#target != 0) then - set typ = 'public' - else - echo "No hypertext entry for keyword $Argv[2]" - exit - endif - endif - set target = "${target}#.$argv[2]" - endif -##echo $target -# -# Check for a running $n_www browser started by us. The pid of the last -# instantiation from the current terminal is recorded in /tmp/xm-$DISPLAY. -# If the process has terminated since, the pid is now probably not in use. -# The rare cases that it is are intercepted by checking the process name. -# - set pid = () - while ($#pid == 0) - if (-e /tmp/xm-$DISPLAY) then - set pid = \ - `sed < /tmp/xm-$DISPLAY -e 's:.*+ *::' -e 's: .*$::'` - set noglob - set x = `cat /tmp/xm-$DISPLAY` - if ("$x" !~ *${n_www}* ) set pid = () - unset noglob - set y = "" - set p = ''; if ($n_arch == so) set pp = '-p' - if ($#pid) set y = `ps $pp $pid` - if ($status || "$y" !~ *${n_www}*) set pid = () - if ("$y" !~ *${n_www}* ) set pid = () - endif -# -# If none found, start one up with Newstar homepage -# -start: - if ($#pid == 0) then - echo " Starting $n_www" - if ("$n_www" =~ *netscape*) then - $n_www -ncol 48 $n_hlp/homepage.html > /dev/null & - else - $n_www $n_hlp/homepage.html > /dev/null & - endif - if ($#target) then - echo -n \ - " Hit any key when $n_www is displaying Newstar home page: " - set y = $< - endif - echo -n "" >! /tmp/xm-$DISPLAY - while (-z /tmp/xm-$DISPLAY) - sleep 1 - jobs -l >> /tmp/xm-$DISPLAY - end - endif - if (! $#target) then - echo " $n_www is running" - ps $pp $pid - exit - endif - end - - if ("$n_www" =~ *mosaic*) then -# -# Create command file -# - rm >&/dev/null /tmp/*.$pid - set tmp = /tmp/Mosaic.$pid - echo 'goto' >! $tmp - echo "file:://localhost$target" >> $tmp - ln -s $tmp /tmp/xmosaic.$pid -# -# Send a SIGUSR1 signal and wait 3 sec for the command file to be accessed. -# Keep trying until it is accepted -# - while (1) - $n_exe/signal_and_sync.exe $tmp 3 $pid - set sts = $status -echo "status from sinal_and_sync.exe: $sts" - if ($sts < 0) then - echo " failed to send signal to $n_www process $pid" - exit $sts - endif - if (! $sts) exit - end - - else if ("$n_www" =~ *netscape*) then - @ sts = 1 - while ($sts) - $n_www -remote "openURL file:$target" >&/dev/null - @ sts = $status -echo "status from remote netscape access: $sts" - if ($sts) then - echo " Something wrong, trying a new start" - goto start - $n_src/sys/document.csh hyper >&/dev/null -## echo -n \ -## " Hit any key when $n_www is displaying Newstar home page: " -## set y = $< - endif - end - else - echo " ERROR: Unknown WWW browser $n_www" - endif diff --git a/src/wng/cshrc_mask.sun b/src/wng/cshrc_mask.sun deleted file mode 100755 index 512cafc5c0b1b1e24953d7283526e174cdc1016e..0000000000000000000000000000000000000000 --- a/src/wng/cshrc_mask.sun +++ /dev/null @@ -1,12 +0,0 @@ -set history=100 -set prompt="> " -# -# Replace xxx with proper routing in following (eg ~dwarf) -# -source xxx/dwarfcshrc -# -# Replace xxx with proper routing in following (e.g. ~wnb) -# and yyy with proper site (eg nfra, atnf, rug) -# -source xxx/wng/wngcshrc_yyy.sun -source $WNG/wnxcshrc.sun diff --git a/src/wng/dwexe.com b/src/wng/dwexe.com deleted file mode 100644 index a09746f33ed7916d2892c3d06c883089714db631..0000000000000000000000000000000000000000 --- a/src/wng/dwexe.com +++ /dev/null @@ -1,191 +0,0 @@ -$ ! DWEXE.COM -$ ! WNB 910909 -$ ! -$ ! Revisions: -$ ! WNB 921006 More general -$ ! -$ ! Special DWARF exe command -$ ! @DWEXE [-<code>...] ... [<name>] [-<code>...] ... -$ ! -$ ! See Help (a ? in a parameter) for details. -$ ! -$ ! Local definitions (to be changed at non-NFRA sites) -$ ! *: must contain the correct data -$ ! #: must point to a valid directory -$ ! -$ ! -$ ! General definitions -$ ! -$ VER=F$VERIFY() !FOR ^Y -$ TELL="WRITE SYS$OUTPUT" !FOR EASE OF USE -$ SET NOON !DISCARD ERRORS -$ ON CONTROL_Y THEN GOTO EXEX !FINISH NEATLY -$ ! -$ ASSIGN="ASSIGN" !MAKE SURE PROPER USE -$ CONVERT="CONVERT" -$ COPY="COPY" -$ DELETE="DELETE" -$ DIR="DIRECTORY" -$ FORTRAN="FORTRAN" -$ LIBRARY="LIBRARY" -$ LINK="LINK" -$ MACRO="MACRO" -$ PURGE="PURGE" -$ SET="SET" -$ SHOW="SHOW" -$ SPAWN="SPAWN" -$ SUBMIT="SUBMIT" -$ ! -$ ! -$ CODES="ABDHILRSTV" !KNOWN CODES -$ L0=0 !DEFINE ALL CODES -$ LCD1: CD_'F$EXTRACT(L0,1,CODES)'="0" -$ L0=L0+1 -$ IF L0 .LT. F$LENGTH(CODES) THEN GOTO LCD1 -$ ! -$ FNAM="" !NO NAMES -$ ! -$ ! See if Help -$ ! -$ HLP: L0=P1+P2+P3+P4+P5+P6+P7+P8 -$ IF L0-"?" .NES. L0 THEN GOTO HLP1 -$ ! -$ ! Get codes -$ ! -$ COD: GOSUB GC0 !GET CODES -$ B_COD=A0 !SAVE GIVEN CODES -$ GOSUB GC1 !ANALYZE CODES -$ ! -$ ! Interpret codes -$ ! -$ IF CD_V .EQS. "2" THEN VER=F$VERIFY(1) !SET VERIFY -$ IF CD_V .NES. "2" THEN VER=F$VERIFY(0) -$ ! -$ ! Get file names -$ ! -$ FIL: IF FNAM .NES. "" THEN GOTO EXE !FILENAME PRESENT -$ TELL "" -$ TELL "No program name specified" -$ TELL "" -$ GOTO EXEX -$ ! -$ ! Execute -$ ! -$ EXE: -$ ! -$ ! Help -$ ! -$ IF (CD_H .EQS. "2") THEN GOTO HLP1 -$ ! -$ ! ast -$ ! -$ IF (CD_R .EQS. "1") THEN CD_S="2" !SAVE IF NORUN -$ A_COD="" -$ IF (CD_A .EQS. "1") THEN A_COD=A_COD+"/NOASK" -$ IF (CD_A .EQS. "2") THEN A_COD=A_COD+"/ASK" -$ IF (CD_S .EQS. "1") THEN A_COD=A_COD+"/NOSAVE" -$ IF (CD_S .EQS. "2") THEN A_COD=A_COD+"/SAVE" -$ IF (CD_T .EQS. "1") THEN A_COD=A_COD+"/NOTEST" -$ IF (CD_T .EQS. "2") THEN A_COD=A_COD+"/TEST" -$ ! -$ ! Stream -$ ! -$ IF (CD_B .NES. "0") THEN B_COD="$''CD_B'" -$ IF (CD_B .EQS. "0") THEN B_COD="" -$ ! -$ ! Specify -$ ! -$ IF (CD_L .EQS. "0" .AND. CD_R .EQS. "0" .AND. - - CD_D .EQS."0" .AND. CD_I .EQS. "0") THEN GOTO NOSPEC -$ CE_L="LOG" -$ IF (CD_L .EQS. "1") THEN CE_L=CE_L+"=YES" -$ IF (CD_L .EQS. "2") THEN CE_L=CE_L+"=SPOOL" -$ CE_R="RUN" -$ IF (CD_R .EQS. "1") THEN CE_R=CE_R+"=NO" -$ IF (CD_R .EQS. "2") THEN CE_R=CE_R+"=YES" -$ CE_D="DATAB" -$ IF (CD_D .EQS. "1") THEN CE_D=CE_D+"=""""" -$ CE_I="INFIX" -$ IF (CD_I .EQS. "1") THEN CE_I=CE_I+"=""""" -$ OPEN/WRITE/ERROR=NOSPEC FILE0 TMPDWX.TMP -$ WRITE/ERROR=NOSP1 FILE0 "''CE_L'" -$ WRITE/ERROR=NOSP1 FILE0 "''CE_R'" -$ WRITE/ERROR=NOSP1 FILE0 "''CE_D'" -$ WRITE/ERROR=NOSP1 FILE0 "''CE_I'" -$ NOSP1: CLOSE/ERROR=NOSPEC FILE0 -$ ASSIGN/NOLOG TMPDWX.TMP SYS$INPUT -$ ASSIGN/NOLOG NL: SYS$OUTPUT -$ SPECIFY 'FNAM''B_COD'/NOMENU -$ DEASSIGN SYS$INPUT -$ DEASSIGN SYS$OUTPUT -$ ! -$ ! Do program -$ ! -$ NOSPEC: -$ IF (F$SEARCH("TMPDWX.TMP") .NES. "") THEN DELETE TMPDWX.TMP;* -$ EXE 'FNAM''B_COD''A_COD'/INPUT=SYS$COMMAND -$ GOTO EXEX -$ ! -$ ! Routines -$ ! -$ ! Get codes and filenames -$ ! -$ GC0: A0="" !NONE -$ L1=0 !ARG. COUNT -$ L2=8 -$ GC02: L1=L1+1 -$ IF L1 .GT. L2 THEN RETURN !ALL DONE -$ IF F$EXTRACT(0,1,P'L1') .EQS. "-" THEN GOTO GC01 !CODE -$ IF P'L1' .EQS. "" THEN GOTO GC02 !EMPTY -$ IF FNAM .NES. "" THEN FNAM=FNAM+"," !SET FILE NAME -$ FNAM=FNAM+P'L1' -$ GOTO GC02 !CONTINUE -$ GC01: A0=A0+F$EXTRACT(1,-1,P'L1') !SET CODE -$ GOTO GC02 -$ ! -$ ! Analyze codes -$ ! -$ GC1: -$ GC10: IF A0 .EQS. "" THEN RETURN !READY -$ L1="Y" !NO N SEEN -$ GC14: L2=F$EXTRACT(0,1,A0) !CODE -$ A0=A0-L2 !DELETE CODE -$ L2=F$EDIT(L2,"UPCASE") -$ IF L2 .EQS. "N" THEN GOTO GC11 !NEGATE -$ IF CODES-L2 .EQS. CODES THEN GOTO GC10 !UNKNOWN CODE -$ CD_'L2'="1" !DELETE POSSIBLE CODE -$ IF L1 THEN CD_'L2'="2" !SET STANDARD CODE -$ IF .NOT.L1 THEN GOTO GC10 !CONTINUE -$ L0=F$EXTRACT(0,1,A0) !POSSIBLE DIGIT -$ IF "0123456789"-L0 .EQS. "0123456789" THEN GOTO GC13 !NO DIGIT -$ CD_'L2'=L0 !SET DIGIT -$ A0=A0-L0 !DELETE DIGIT FROM CODE -$ GC13: GOTO GC10 !CONTINUE -$ GC11: L1="N" !SET NEGATE -$ GOTO GC14 !GET CODE -$ ! -$ ! Exit (GOTO not GOSUB) -$ ! -$ EXEX: SET ON -$ L0=F$VERIFY(VER) !RESET VERIFY -$ EXIT -$ ! -$ ! Help -$ ! -$ HLP1: TELL "" -$ TELL "The DWEXE (or DWE) command has the format:" -$ TELL " DWEXE [-<code>...] ... [<name>] [-<code>...] ..." -$ TELL "The code can be:" -$ TELL "" -$ TELL "a na /ASK /NOASK" -$ TELL "h help" -$ TELL "s ns /SAVE /NOSAVE" -$ TELL "t nt /TEST /NOTEST" -$ TELL "l nl LOG=spool LOG=y" -$ TELL "r nr RUN=yes RUN=n and /SAVE" -$ TELL " nd DATAB=""""" -$ TELL " ni INFIX=""""" -$ TELL "v nv verify noverify" -$ TELL "b<digit> stream (e.g. b5)" -$ TELL "" -$ GOTO EXEX diff --git a/src/wng/edtini.com b/src/wng/edtini.com deleted file mode 100644 index f796bc589fe2ca08c7fe93644aaee776a3511316..0000000000000000000000000000000000000000 --- a/src/wng/edtini.com +++ /dev/null @@ -1,2 +0,0 @@ -dummy - diff --git a/src/wng/fbc.dsc b/src/wng/fbc.dsc deleted file mode 100644 index a6b4f3146a7d4e137a08a7681d966204203dde93..0000000000000000000000000000000000000000 --- a/src/wng/fbc.dsc +++ /dev/null @@ -1,30 +0,0 @@ -!+ FBC.DSC -! WNB 890725 -! -! Revisions: -! -%REVISION=WNB=930803="Rearrange text" -%REVISION=WNB=890724="Original version" -! -! Define FBC (File Buffer Control area) -! -%COMMENT="FBC.DSC defines the FBC (File Buffer Controlblock)" -! -%VERSION=1 !VERSION -%SYSTEM=1 -%USER=WNB -%%DATE -%%NAME -!- -.PARAMETER - FBC_M_WRITE J /1/ !REWRITE BUFFER - FBC_V_WRITE J /0/ -.BEGIN=FBC - BQA J(2) !ADDRESS LINK, MUST BE AT 0 - BQT J(2) !TIME LINK, MUST BE AT 8 - ADDR J !BUFFER ADDRESS - DISK J !START DISK ADDRESS IN BUF - DISKND J !END DISK ADDRESS+1 IN BUF - BITS J !BITS -.END !END DEFINITION -!- diff --git a/src/wng/fbc_e.def b/src/wng/fbc_e.def deleted file mode 100644 index fc4254662a164ede26b163a6a1268ce0dbd221da..0000000000000000000000000000000000000000 --- a/src/wng/fbc_e.def +++ /dev/null @@ -1,55 +0,0 @@ -C+ Created from fbc.dsc on 000922 at 11:09:16 at duw01 -C FBC_E.DEF -C WNB 000922 -C -C Revisions: -C -C WNB 930803 Rearrange text -C WNB 890724 Original version -C -C -C Result: -C -C FBC.DSC defines the FBC (File Buffer Controlblock) -C -C -C Specification of edit tables: -C -C The character (_EC) table contains: -C fieldname, pattern, units, special code -C The integer (_EJ) table contains: -C offset, #of values, edit (0=allowed), unit length -C -C -C FBC edit definitions: -C - INTEGER FBCEDL,FBC__EL - PARAMETER ( FBCEDL=6, ! Length table - 1 FBC__EL=6) - CHARACTER*12 FBC_EC(4,6) - INTEGER FBC_EJ(4,6) - DATA FBC_EC(1,1),FBC_EC(2,1),FBC_EC(3,1),FBC_EC(4,1) - 1 /'BQA','SJ',' ',' '/ - DATA FBC_EJ(1,1),FBC_EJ(2,1),FBC_EJ(3,1),FBC_EJ(4,1) - 1 /0,2,0,4/ - DATA FBC_EC(1,2),FBC_EC(2,2),FBC_EC(3,2),FBC_EC(4,2) - 1 /'BQT','SJ',' ',' '/ - DATA FBC_EJ(1,2),FBC_EJ(2,2),FBC_EJ(3,2),FBC_EJ(4,2) - 1 /8,2,0,4/ - DATA FBC_EC(1,3),FBC_EC(2,3),FBC_EC(3,3),FBC_EC(4,3) - 1 /'ADDR','SJ',' ',' '/ - DATA FBC_EJ(1,3),FBC_EJ(2,3),FBC_EJ(3,3),FBC_EJ(4,3) - 1 /16,1,0,4/ - DATA FBC_EC(1,4),FBC_EC(2,4),FBC_EC(3,4),FBC_EC(4,4) - 1 /'DISK','SJ',' ',' '/ - DATA FBC_EJ(1,4),FBC_EJ(2,4),FBC_EJ(3,4),FBC_EJ(4,4) - 1 /20,1,0,4/ - DATA FBC_EC(1,5),FBC_EC(2,5),FBC_EC(3,5),FBC_EC(4,5) - 1 /'DISKND','SJ',' ',' '/ - DATA FBC_EJ(1,5),FBC_EJ(2,5),FBC_EJ(3,5),FBC_EJ(4,5) - 1 /24,1,0,4/ - DATA FBC_EC(1,6),FBC_EC(2,6),FBC_EC(3,6),FBC_EC(4,6) - 1 /'BITS','SJ',' ',' '/ - DATA FBC_EJ(1,6),FBC_EJ(2,6),FBC_EJ(3,6),FBC_EJ(4,6) - 1 /28,1,0,4/ -C- diff --git a/src/wng/fbc_e.inc b/src/wng/fbc_e.inc deleted file mode 100644 index db06a169b5a46e40493dd95f70fb67b64ef16144..0000000000000000000000000000000000000000 --- a/src/wng/fbc_e.inc +++ /dev/null @@ -1,42 +0,0 @@ -/*+ Created from fbc.dsc on 000922 at 11:09:16 at duw01 -.. FBC_E.INC -.. WNB 000922 -.. -.. Revisions: -.. -.. WNB 930803 Rearrange text -.. WNB 890724 Original version -.. */ -/* -.. Result: -.. -.. FBC.DSC defines the FBC (File Buffer Controlblock) -.. */ -/* -.. Specification of edit tables: -.. -.. The character (_EC) table contains: -.. fieldname, pattern, units, special code -.. The integer (_EJ) table contains: -.. offset, #of values, edit (0=allowed), unit length -.. */ -/* -.. FBC edit definitions: -.. */ -#define FBCEDL 6 /* Length table */ -#define FBC__EL 6 /* Length table */ - static char fbc_ec [6][4][12] = { - "BQA","SJ"," "," ", - "BQT","SJ"," "," ", - "ADDR","SJ"," "," ", - "DISK","SJ"," "," ", - "DISKND","SJ"," "," ", - "BITS","SJ"," "," "}; - static int fbc_ej [6][4] = { - 0,2,0,4, - 8,2,0,4, - 16,1,0,4, - 20,1,0,4, - 24,1,0,4, - 28,1,0,4}; -/*- */ diff --git a/src/wng/fbc_o.def b/src/wng/fbc_o.def deleted file mode 100644 index 73f2ca0e1c872ea87178500e37cdd50b8a671fc6..0000000000000000000000000000000000000000 --- a/src/wng/fbc_o.def +++ /dev/null @@ -1,54 +0,0 @@ -C+ Created from fbc.dsc on 000922 at 11:09:15 at duw01 -C FBC_O.DEF -C WNB 000922 -C -C Revisions: -C -C WNB 930803 Rearrange text -C WNB 890724 Original version -C -C -C Given statements: -C -C -C Result: -C -C FBC.DSC defines the FBC (File Buffer Controlblock) -C -C -C Parameters: -C - INTEGER FBC_M_WRITE ! REWRITE BUFFER - PARAMETER (FBC_M_WRITE=1) - INTEGER FBC_V_WRITE - PARAMETER (FBC_V_WRITE=0) -C -C FBC structure definitions: -C - INTEGER FBCHDL,FBCHDV,FBCHDS - PARAMETER ( FBCHDL=32, ! Length - 1 FBCHDV=1, ! Version - 1 FBCHDS=1) ! System - INTEGER FBC__L,FBC__V,FBC__S - PARAMETER ( FBC__L=32, ! Length - 1 FBC__V=1, ! Version - 1 FBC__S=1) ! System -C -C FBC Offsets: -C - INTEGER FBC_BQA_1,FBC_BQA_J ! ADDRESS LINK, MUST BE AT 0 - PARAMETER (FBC_BQA_1=0,FBC_BQA_J=0) - INTEGER FBC_BQT_1,FBC_BQT_J ! TIME LINK, MUST BE AT 8 - PARAMETER (FBC_BQT_1=8,FBC_BQT_J=2) - INTEGER FBC_ADDR_1,FBC_ADDR_J ! BUFFER ADDRESS - PARAMETER (FBC_ADDR_1=16,FBC_ADDR_J=4) - INTEGER FBC_DISK_1,FBC_DISK_J ! START DISK ADDRESS IN BUF - PARAMETER (FBC_DISK_1=20,FBC_DISK_J=5) - INTEGER FBC_DISKND_1,FBC_DISKND_J ! END DISK ADDRESS+1 IN BUF - PARAMETER (FBC_DISKND_1=24,FBC_DISKND_J=6) - INTEGER FBC_BITS_1,FBC_BITS_J ! BITS - PARAMETER (FBC_BITS_1=28,FBC_BITS_J=7) -C -C Given statements: -C -C- diff --git a/src/wng/fbc_o.inc b/src/wng/fbc_o.inc deleted file mode 100644 index 85af8c4b39cf07d929cb116e4738c813bbb5b38f..0000000000000000000000000000000000000000 --- a/src/wng/fbc_o.inc +++ /dev/null @@ -1,46 +0,0 @@ -/*+ Created from fbc.dsc on 000922 at 11:09:15 at duw01 -.. FBC_O.INC -.. WNB 000922 -.. -.. Revisions: -.. -.. WNB 930803 Rearrange text -.. WNB 890724 Original version -.. */ -/* -.. Given statements: -.. */ -/* -.. Result: -.. -.. FBC.DSC defines the FBC (File Buffer Controlblock) -.. */ -/* -.. Parameters: -.. */ -#define FBC_M_WRITE 1 /* REWRITE BUFFER */ -#define FBC_V_WRITE 0 -/* -.. FBC structure definitions: -.. */ -#define FBCHDL 32 /* Length */ -#define FBCHDV 1 /* Version */ -#define FBCHDS 1 /* System */ -#define FBC__L 32 /* Length */ -#define FBC__V 1 /* Version */ -#define FBC__S 1 /* System */ -/* -.. FBC Offsets: -.. */ -struct fbc { - int bqa[2]; /* ADDRESS LINK, MUST BE AT 0 */ - int bqt[2]; /* TIME LINK, MUST BE AT 8 */ - int addr; /* BUFFER ADDRESS */ - int disk; /* START DISK ADDRESS IN BUF */ - int disknd; /* END DISK ADDRESS+1 IN BUF */ - int bits; /* BITS */ -}; /* END DEFINITION */ -/* -.. Given statements: -.. */ -/*- */ diff --git a/src/wng/fbc_t.def b/src/wng/fbc_t.def deleted file mode 100644 index 4557fc5f9ad26915108b5be1c9a11bfaaaa7b3a5..0000000000000000000000000000000000000000 --- a/src/wng/fbc_t.def +++ /dev/null @@ -1,35 +0,0 @@ -C+ Created from fbc.dsc on 000922 at 11:09:15 at duw01 -C FBC_T.DEF -C WNB 000922 -C -C Revisions: -C -C WNB 930803 Rearrange text -C WNB 890724 Original version -C -C -C Result: -C -C FBC.DSC defines the FBC (File Buffer Controlblock) -C -C -C Specification of translation tables: -C -C 0= end of table 1= character -C 2= 16 bits integer 3= 32 bits integer -C 4= 32 bits real 5= 64 bits real -C 6= repeat 7= end repeat -C 8= undefined 9= byte -C 10= external repeat 11= start union -C 12= start map 13= end union -C 14= 64 bits complex 15= 128 bits complex -C -C -C FBC translation definitions: -C - INTEGER*2 FBC_T(2,2) - EQUIVALENCE (FBC_T,FBC__T(1,1)) - DATA FBC_T(1,1),FBC_T(2,1) /3,8/ - DATA FBC_T(1,2),FBC_T(2,2) /0,1/ - INTEGER*2 FBC__T(2,2) -C- diff --git a/src/wng/fbc_t.inc b/src/wng/fbc_t.inc deleted file mode 100644 index 8a1506fee352e8145fa74da7711c89e1b7f7a190..0000000000000000000000000000000000000000 --- a/src/wng/fbc_t.inc +++ /dev/null @@ -1,35 +0,0 @@ -/*+ Created from fbc.dsc on 000922 at 11:09:15 at duw01 -.. FBC_T.INC -.. WNB 000922 -.. -.. Revisions: -.. -.. WNB 930803 Rearrange text -.. WNB 890724 Original version -.. */ -/* -.. Result: -.. -.. FBC.DSC defines the FBC (File Buffer Controlblock) -.. */ -/* -.. Specification of translation tables: -.. -.. 0= end of table 1= character -.. 2= 16 bits integer 3= 32 bits integer -.. 4= 32 bits real 5= 64 bits real -.. 6= repeat 7= end repeat -.. 8= undefined 9= byte -.. 10= external repeat 11= start union -.. 12= start map 13= end union -.. 14= 64 bits complex 15= 128 bits complex -.. */ - static struct { -/* -.. FBC translation definitions: -.. */ - short fbc_t [2][2] ; - } fbc__t = { - 3, 8, - 0, 1 }; -/*- */ diff --git a/src/wng/fca.dsc b/src/wng/fca.dsc deleted file mode 100644 index 5310f9b2f69cac2f066c8aa48ea40be4d88e9134..0000000000000000000000000000000000000000 --- a/src/wng/fca.dsc +++ /dev/null @@ -1,112 +0,0 @@ -!+ FCA.DSC -! WNB 850910 -! -! Revisions: -! -%REVISION=WNB=930811="Add some names; change FIB length; add FAT*" -%REVISION=WNB=930803="Use WNTINC options" -%REVISION=WNB=890724="Original version" -%REVISION=JPH=930415="FCA_x_WRT --> FCA_x_WRTAPE" -! -! Define FCA (File Control Area) -! -%COMMENT="FCA.DSC defines the FCA (File Control Area)" -! -%VERSION=1 !VERSION -%SYSTEM=1 -%USER=WNB -%%DATE -%%NAME -! -%ALIGN !ALIGN STRUCTURES -! -%GLOBAL=FIB__L=80 !FIB LENGTH (SYSTEM DEPENDENT) -%GLOBAL=ATR__L=12 !ATTRIBUTE CONTROL BLK LENGTH -%GLOBAL=RATR__L=32 !RECORD ATTRIBUTE LENGTH -%GLOBAL=FCA__FNL=80 !FILE NAME LENGTH -!- -.PARAMETER - FCA_M M: \ !MASKS FOR: - /ASSIGN,ACCESS,ACTIVE, \ !CHANNEL ASSIGNED, FILE ACCESSED - SEQUEN,TMP,MAGTAPE,,OLD,/ !READ/WRITE ACTIVE - !SEQUENTIAL FILE - !TEMP. FILE, MAGNETIC TAPE - !OLD FILE - FCA_V A:(0) \ !BITS FOR: - /ASSIGN,ACCESS,ACTIVE, \ !CHANNEL ASSIGNED, FILE ACCESSED - SEQUEN,TMP,MAGTAPE,,OLD,/ !READ/WRITE ACTIVE - !SEQUENTIAL FILE - !TEMP. FILE, MAGNETIC TAPE - !OLD FILE - FCA_M_WRTAPE J /64/ !MAGNETIC TAPE WRITE - FCA_V_WRTAPE J /6/ - FCA_M_WRITE J /256/ !WRITE ALLOWED - FCA_V_WRITE J /8/ -! -! The following are from $FATDEF, only available for Macro -! They are the FAT$W_* values -! -%LOCAL=EFBLKL=10 -%LOCAL=EFBLKH=8 -%LOCAL=HIBLKL=6 -%LOCAL=HIBLKH=4 -%LOCAL=FFBYTE=12 - FAT_EFBLKL_1 J /EFBLKL/ - FAT_EFBLKH_1 J /EFBLKH/ - FAT_HIBLKL_1 J /HIBLKL/ - FAT_HIBLKH_1 J /HIBLKH/ - FAT_FFBYTE_1 J /FFBYTE/ - FAT_EFBLKL_I J /EFBLKL/2/ - FAT_EFBLKH_I J /EFBLKH/2/ - FAT_HIBLKL_I J /HIBLKL/2/ - FAT_HIBLKH_I J /HIBLKH/2/ - FAT_FFBYTE_I J /FFBYTE/2/ -! -.BEGIN=FCA - LINK J !LINK, MUST BE AT 0 - TID J !ID. 0=FCA, 1=MCA, MUST BE AT 4 - SIZE J !SIZE OF BLOCK - CHAN J !ASSIGNED CHANNEL - IOSB J(2) !IO STATUS BLOCK - IOSBI=IOSB I(4) - BITS J !BITS - !THE ABOVE SHOULD BE SAME FOR FCA & MCA - FIBDES J(2) !FIB DESCRIPTOR - DID J(2) !DIRECTORY ID -.ALIGN=LB_J !MAKE SURE - ATRJ J(ATR__L/LB_J) !ATTRIBUTE CONTROL BLOCK - ATR=ATRJ B(ATR__L) - BQT J(2) !TIME ORDERED BUFFER QUEUE - BQA J(2) !ADDRESS ORDERED BUFFER QUEUE - BLEN J !BUFFER LENGTH - BCP J !BUFFER CONTROL AREA POINTER - FEA J(2) !ACTIVE FILE ELEMENT QUEUE - FEE J(2) !EMPTY FILE ELEMENT QUEUE - FEP J !ELEMENT AREA POINTER - FEL J !CURRENT ELEMENT POINTER - MCA J !PTR TO MCA - HIBLK J !LOWEST NOT ALLOCATED ADDRESS - EOF J !FIRST BYTE BEYOND EOF - RAD J !LAST READ ADDRESS - DAD J !DISK ADDRESS - BAD J !BUFFER ADDRESS - LEN J !LENGTH TO READ/WRITE - ACLEN J !ACTUAL LENGTH READ/WRITTEN - EF J !IO EF - EFA J !ACTIVITY EF - ERR J !FINAL IO ERROR - MAP J !MAG TAPE POINTER - MAB J !MAG TAPE BLOCK - MAW J !MAG TAPE WRITE POSITION - FNAML J !FILE NAME LENGTH -.ALIGN=LB_J !MAKE SURE - FIBJ J(FIB__L/LB_J) !FIB - FIBI=FIBJ I(FIB__L/LB_I) - FIB=FIBJ B(FIB__L) -.ALIGN=LB_J !MAKE SURE - FNAM C(FCA__FNL) !FILE NAME -.ALIGN=LB_J !MAKE SURE - RECATRJ J(RATR__L/LB_J) !RECORD ATTRIBUTES - RECATR=RECATRJ B(RATR__L) -.END !END DEFINITION -!- diff --git a/src/wng/fca_e.def b/src/wng/fca_e.def deleted file mode 100644 index c3ed9fab857efc8468e168fc343a81e21316b831..0000000000000000000000000000000000000000 --- a/src/wng/fca_e.def +++ /dev/null @@ -1,193 +0,0 @@ -C+ Created from fca.dsc on 000922 at 11:09:13 at duw01 -C FCA_E.DEF -C WNB 000922 -C -C Revisions: -C -C WNB 930811 Add some names; change FIB length; add FAT* -C WNB 930803 Use WNTINC options -C WNB 890724 Original version -C JPH 930415 FCA_x_WRT --> FCA_x_WRTAPE -C -C -C Result: -C -C FCA.DSC defines the FCA (File Control Area) -C -C -C Specification of edit tables: -C -C The character (_EC) table contains: -C fieldname, pattern, units, special code -C The integer (_EJ) table contains: -C offset, #of values, edit (0=allowed), unit length -C -C -C FCA edit definitions: -C - INTEGER FCAEDL,FCA__EL - PARAMETER ( FCAEDL=40, ! Length table - 1 FCA__EL=40) - CHARACTER*12 FCA_EC(4,40) - INTEGER FCA_EJ(4,40) - DATA FCA_EC(1,1),FCA_EC(2,1),FCA_EC(3,1),FCA_EC(4,1) - 1 /'LINK','SJ',' ',' '/ - DATA FCA_EJ(1,1),FCA_EJ(2,1),FCA_EJ(3,1),FCA_EJ(4,1) - 1 /0,1,0,4/ - DATA FCA_EC(1,2),FCA_EC(2,2),FCA_EC(3,2),FCA_EC(4,2) - 1 /'TID','SJ',' ',' '/ - DATA FCA_EJ(1,2),FCA_EJ(2,2),FCA_EJ(3,2),FCA_EJ(4,2) - 1 /4,1,0,4/ - DATA FCA_EC(1,3),FCA_EC(2,3),FCA_EC(3,3),FCA_EC(4,3) - 1 /'SIZE','SJ',' ',' '/ - DATA FCA_EJ(1,3),FCA_EJ(2,3),FCA_EJ(3,3),FCA_EJ(4,3) - 1 /8,1,0,4/ - DATA FCA_EC(1,4),FCA_EC(2,4),FCA_EC(3,4),FCA_EC(4,4) - 1 /'CHAN','SJ',' ',' '/ - DATA FCA_EJ(1,4),FCA_EJ(2,4),FCA_EJ(3,4),FCA_EJ(4,4) - 1 /12,1,0,4/ - DATA FCA_EC(1,5),FCA_EC(2,5),FCA_EC(3,5),FCA_EC(4,5) - 1 /'IOSB','SJ',' ',' '/ - DATA FCA_EJ(1,5),FCA_EJ(2,5),FCA_EJ(3,5),FCA_EJ(4,5) - 1 /16,2,0,4/ - DATA FCA_EC(1,6),FCA_EC(2,6),FCA_EC(3,6),FCA_EC(4,6) - 1 /'IOSBI','SI',' ',' '/ - DATA FCA_EJ(1,6),FCA_EJ(2,6),FCA_EJ(3,6),FCA_EJ(4,6) - 1 /16,4,0,2/ - DATA FCA_EC(1,7),FCA_EC(2,7),FCA_EC(3,7),FCA_EC(4,7) - 1 /'BITS','SJ',' ',' '/ - DATA FCA_EJ(1,7),FCA_EJ(2,7),FCA_EJ(3,7),FCA_EJ(4,7) - 1 /24,1,0,4/ - DATA FCA_EC(1,8),FCA_EC(2,8),FCA_EC(3,8),FCA_EC(4,8) - 1 /'FIBDES','SJ',' ',' '/ - DATA FCA_EJ(1,8),FCA_EJ(2,8),FCA_EJ(3,8),FCA_EJ(4,8) - 1 /28,2,0,4/ - DATA FCA_EC(1,9),FCA_EC(2,9),FCA_EC(3,9),FCA_EC(4,9) - 1 /'DID','SJ',' ',' '/ - DATA FCA_EJ(1,9),FCA_EJ(2,9),FCA_EJ(3,9),FCA_EJ(4,9) - 1 /36,2,0,4/ - DATA FCA_EC(1,10),FCA_EC(2,10),FCA_EC(3,10),FCA_EC(4,10) - 1 /'ATRJ','SJ',' ',' '/ - DATA FCA_EJ(1,10),FCA_EJ(2,10),FCA_EJ(3,10),FCA_EJ(4,10) - 1 /44,3,0,4/ - DATA FCA_EC(1,11),FCA_EC(2,11),FCA_EC(3,11),FCA_EC(4,11) - 1 /'ATR','UB',' ',' '/ - DATA FCA_EJ(1,11),FCA_EJ(2,11),FCA_EJ(3,11),FCA_EJ(4,11) - 1 /44,12,0,1/ - DATA FCA_EC(1,12),FCA_EC(2,12),FCA_EC(3,12),FCA_EC(4,12) - 1 /'BQT','SJ',' ',' '/ - DATA FCA_EJ(1,12),FCA_EJ(2,12),FCA_EJ(3,12),FCA_EJ(4,12) - 1 /56,2,0,4/ - DATA FCA_EC(1,13),FCA_EC(2,13),FCA_EC(3,13),FCA_EC(4,13) - 1 /'BQA','SJ',' ',' '/ - DATA FCA_EJ(1,13),FCA_EJ(2,13),FCA_EJ(3,13),FCA_EJ(4,13) - 1 /64,2,0,4/ - DATA FCA_EC(1,14),FCA_EC(2,14),FCA_EC(3,14),FCA_EC(4,14) - 1 /'BLEN','SJ',' ',' '/ - DATA FCA_EJ(1,14),FCA_EJ(2,14),FCA_EJ(3,14),FCA_EJ(4,14) - 1 /72,1,0,4/ - DATA FCA_EC(1,15),FCA_EC(2,15),FCA_EC(3,15),FCA_EC(4,15) - 1 /'BCP','SJ',' ',' '/ - DATA FCA_EJ(1,15),FCA_EJ(2,15),FCA_EJ(3,15),FCA_EJ(4,15) - 1 /76,1,0,4/ - DATA FCA_EC(1,16),FCA_EC(2,16),FCA_EC(3,16),FCA_EC(4,16) - 1 /'FEA','SJ',' ',' '/ - DATA FCA_EJ(1,16),FCA_EJ(2,16),FCA_EJ(3,16),FCA_EJ(4,16) - 1 /80,2,0,4/ - DATA FCA_EC(1,17),FCA_EC(2,17),FCA_EC(3,17),FCA_EC(4,17) - 1 /'FEE','SJ',' ',' '/ - DATA FCA_EJ(1,17),FCA_EJ(2,17),FCA_EJ(3,17),FCA_EJ(4,17) - 1 /88,2,0,4/ - DATA FCA_EC(1,18),FCA_EC(2,18),FCA_EC(3,18),FCA_EC(4,18) - 1 /'FEP','SJ',' ',' '/ - DATA FCA_EJ(1,18),FCA_EJ(2,18),FCA_EJ(3,18),FCA_EJ(4,18) - 1 /96,1,0,4/ - DATA FCA_EC(1,19),FCA_EC(2,19),FCA_EC(3,19),FCA_EC(4,19) - 1 /'FEL','SJ',' ',' '/ - DATA FCA_EJ(1,19),FCA_EJ(2,19),FCA_EJ(3,19),FCA_EJ(4,19) - 1 /100,1,0,4/ - DATA FCA_EC(1,20),FCA_EC(2,20),FCA_EC(3,20),FCA_EC(4,20) - 1 /'MCA','SJ',' ',' '/ - DATA FCA_EJ(1,20),FCA_EJ(2,20),FCA_EJ(3,20),FCA_EJ(4,20) - 1 /104,1,0,4/ - DATA FCA_EC(1,21),FCA_EC(2,21),FCA_EC(3,21),FCA_EC(4,21) - 1 /'HIBLK','SJ',' ',' '/ - DATA FCA_EJ(1,21),FCA_EJ(2,21),FCA_EJ(3,21),FCA_EJ(4,21) - 1 /108,1,0,4/ - DATA FCA_EC(1,22),FCA_EC(2,22),FCA_EC(3,22),FCA_EC(4,22) - 1 /'EOF','SJ',' ',' '/ - DATA FCA_EJ(1,22),FCA_EJ(2,22),FCA_EJ(3,22),FCA_EJ(4,22) - 1 /112,1,0,4/ - DATA FCA_EC(1,23),FCA_EC(2,23),FCA_EC(3,23),FCA_EC(4,23) - 1 /'RAD','SJ',' ',' '/ - DATA FCA_EJ(1,23),FCA_EJ(2,23),FCA_EJ(3,23),FCA_EJ(4,23) - 1 /116,1,0,4/ - DATA FCA_EC(1,24),FCA_EC(2,24),FCA_EC(3,24),FCA_EC(4,24) - 1 /'DAD','SJ',' ',' '/ - DATA FCA_EJ(1,24),FCA_EJ(2,24),FCA_EJ(3,24),FCA_EJ(4,24) - 1 /120,1,0,4/ - DATA FCA_EC(1,25),FCA_EC(2,25),FCA_EC(3,25),FCA_EC(4,25) - 1 /'BAD','SJ',' ',' '/ - DATA FCA_EJ(1,25),FCA_EJ(2,25),FCA_EJ(3,25),FCA_EJ(4,25) - 1 /124,1,0,4/ - DATA FCA_EC(1,26),FCA_EC(2,26),FCA_EC(3,26),FCA_EC(4,26) - 1 /'LEN','SJ',' ',' '/ - DATA FCA_EJ(1,26),FCA_EJ(2,26),FCA_EJ(3,26),FCA_EJ(4,26) - 1 /128,1,0,4/ - DATA FCA_EC(1,27),FCA_EC(2,27),FCA_EC(3,27),FCA_EC(4,27) - 1 /'ACLEN','SJ',' ',' '/ - DATA FCA_EJ(1,27),FCA_EJ(2,27),FCA_EJ(3,27),FCA_EJ(4,27) - 1 /132,1,0,4/ - DATA FCA_EC(1,28),FCA_EC(2,28),FCA_EC(3,28),FCA_EC(4,28) - 1 /'EF','SJ',' ',' '/ - DATA FCA_EJ(1,28),FCA_EJ(2,28),FCA_EJ(3,28),FCA_EJ(4,28) - 1 /136,1,0,4/ - DATA FCA_EC(1,29),FCA_EC(2,29),FCA_EC(3,29),FCA_EC(4,29) - 1 /'EFA','SJ',' ',' '/ - DATA FCA_EJ(1,29),FCA_EJ(2,29),FCA_EJ(3,29),FCA_EJ(4,29) - 1 /140,1,0,4/ - DATA FCA_EC(1,30),FCA_EC(2,30),FCA_EC(3,30),FCA_EC(4,30) - 1 /'ERR','SJ',' ',' '/ - DATA FCA_EJ(1,30),FCA_EJ(2,30),FCA_EJ(3,30),FCA_EJ(4,30) - 1 /144,1,0,4/ - DATA FCA_EC(1,31),FCA_EC(2,31),FCA_EC(3,31),FCA_EC(4,31) - 1 /'MAP','SJ',' ',' '/ - DATA FCA_EJ(1,31),FCA_EJ(2,31),FCA_EJ(3,31),FCA_EJ(4,31) - 1 /148,1,0,4/ - DATA FCA_EC(1,32),FCA_EC(2,32),FCA_EC(3,32),FCA_EC(4,32) - 1 /'MAB','SJ',' ',' '/ - DATA FCA_EJ(1,32),FCA_EJ(2,32),FCA_EJ(3,32),FCA_EJ(4,32) - 1 /152,1,0,4/ - DATA FCA_EC(1,33),FCA_EC(2,33),FCA_EC(3,33),FCA_EC(4,33) - 1 /'MAW','SJ',' ',' '/ - DATA FCA_EJ(1,33),FCA_EJ(2,33),FCA_EJ(3,33),FCA_EJ(4,33) - 1 /156,1,0,4/ - DATA FCA_EC(1,34),FCA_EC(2,34),FCA_EC(3,34),FCA_EC(4,34) - 1 /'FNAML','SJ',' ',' '/ - DATA FCA_EJ(1,34),FCA_EJ(2,34),FCA_EJ(3,34),FCA_EJ(4,34) - 1 /160,1,0,4/ - DATA FCA_EC(1,35),FCA_EC(2,35),FCA_EC(3,35),FCA_EC(4,35) - 1 /'FIBJ','SJ',' ',' '/ - DATA FCA_EJ(1,35),FCA_EJ(2,35),FCA_EJ(3,35),FCA_EJ(4,35) - 1 /164,20,0,4/ - DATA FCA_EC(1,36),FCA_EC(2,36),FCA_EC(3,36),FCA_EC(4,36) - 1 /'FIBI','SI',' ',' '/ - DATA FCA_EJ(1,36),FCA_EJ(2,36),FCA_EJ(3,36),FCA_EJ(4,36) - 1 /164,40,0,2/ - DATA FCA_EC(1,37),FCA_EC(2,37),FCA_EC(3,37),FCA_EC(4,37) - 1 /'FIB','UB',' ',' '/ - DATA FCA_EJ(1,37),FCA_EJ(2,37),FCA_EJ(3,37),FCA_EJ(4,37) - 1 /164,80,0,1/ - DATA FCA_EC(1,38),FCA_EC(2,38),FCA_EC(3,38),FCA_EC(4,38) - 1 /'FNAM','AL',' ',' '/ - DATA FCA_EJ(1,38),FCA_EJ(2,38),FCA_EJ(3,38),FCA_EJ(4,38) - 1 /244,1,0,80/ - DATA FCA_EC(1,39),FCA_EC(2,39),FCA_EC(3,39),FCA_EC(4,39) - 1 /'RECATRJ','SJ',' ',' '/ - DATA FCA_EJ(1,39),FCA_EJ(2,39),FCA_EJ(3,39),FCA_EJ(4,39) - 1 /324,8,0,4/ - DATA FCA_EC(1,40),FCA_EC(2,40),FCA_EC(3,40),FCA_EC(4,40) - 1 /'RECATR','UB',' ',' '/ - DATA FCA_EJ(1,40),FCA_EJ(2,40),FCA_EJ(3,40),FCA_EJ(4,40) - 1 /324,32,0,1/ -C- diff --git a/src/wng/fca_e.inc b/src/wng/fca_e.inc deleted file mode 100644 index 6b411026748050f273822bd3a690778e820df0b5..0000000000000000000000000000000000000000 --- a/src/wng/fca_e.inc +++ /dev/null @@ -1,112 +0,0 @@ -/*+ Created from fca.dsc on 000922 at 11:09:13 at duw01 -.. FCA_E.INC -.. WNB 000922 -.. -.. Revisions: -.. -.. WNB 930811 Add some names; change FIB length; add FAT* -.. WNB 930803 Use WNTINC options -.. WNB 890724 Original version -.. JPH 930415 FCA_x_WRT --> FCA_x_WRTAPE -.. */ -/* -.. Result: -.. -.. FCA.DSC defines the FCA (File Control Area) -.. */ -/* -.. Specification of edit tables: -.. -.. The character (_EC) table contains: -.. fieldname, pattern, units, special code -.. The integer (_EJ) table contains: -.. offset, #of values, edit (0=allowed), unit length -.. */ -/* -.. FCA edit definitions: -.. */ -#define FCAEDL 40 /* Length table */ -#define FCA__EL 40 /* Length table */ - static char fca_ec [40][4][12] = { - "LINK","SJ"," "," ", - "TID","SJ"," "," ", - "SIZE","SJ"," "," ", - "CHAN","SJ"," "," ", - "IOSB","SJ"," "," ", - "IOSBI","SI"," "," ", - "BITS","SJ"," "," ", - "FIBDES","SJ"," "," ", - "DID","SJ"," "," ", - "ATRJ","SJ"," "," ", - "ATR","UB"," "," ", - "BQT","SJ"," "," ", - "BQA","SJ"," "," ", - "BLEN","SJ"," "," ", - "BCP","SJ"," "," ", - "FEA","SJ"," "," ", - "FEE","SJ"," "," ", - "FEP","SJ"," "," ", - "FEL","SJ"," "," ", - "MCA","SJ"," "," ", - "HIBLK","SJ"," "," ", - "EOF","SJ"," "," ", - "RAD","SJ"," "," ", - "DAD","SJ"," "," ", - "BAD","SJ"," "," ", - "LEN","SJ"," "," ", - "ACLEN","SJ"," "," ", - "EF","SJ"," "," ", - "EFA","SJ"," "," ", - "ERR","SJ"," "," ", - "MAP","SJ"," "," ", - "MAB","SJ"," "," ", - "MAW","SJ"," "," ", - "FNAML","SJ"," "," ", - "FIBJ","SJ"," "," ", - "FIBI","SI"," "," ", - "FIB","UB"," "," ", - "FNAM","AL"," "," ", - "RECATRJ","SJ"," "," ", - "RECATR","UB"," "," "}; - static int fca_ej [40][4] = { - 0,1,0,4, - 4,1,0,4, - 8,1,0,4, - 12,1,0,4, - 16,2,0,4, - 16,4,0,2, - 24,1,0,4, - 28,2,0,4, - 36,2,0,4, - 44,3,0,4, - 44,12,0,1, - 56,2,0,4, - 64,2,0,4, - 72,1,0,4, - 76,1,0,4, - 80,2,0,4, - 88,2,0,4, - 96,1,0,4, - 100,1,0,4, - 104,1,0,4, - 108,1,0,4, - 112,1,0,4, - 116,1,0,4, - 120,1,0,4, - 124,1,0,4, - 128,1,0,4, - 132,1,0,4, - 136,1,0,4, - 140,1,0,4, - 144,1,0,4, - 148,1,0,4, - 152,1,0,4, - 156,1,0,4, - 160,1,0,4, - 164,20,0,4, - 164,40,0,2, - 164,80,0,1, - 244,1,0,80, - 324,8,0,4, - 324,32,0,1}; -/*- */ diff --git a/src/wng/fca_o.def b/src/wng/fca_o.def deleted file mode 100644 index d478592d3fd9a1717a702ee849f9137a53bb95f0..0000000000000000000000000000000000000000 --- a/src/wng/fca_o.def +++ /dev/null @@ -1,210 +0,0 @@ -C+ Created from fca.dsc on 000922 at 11:09:12 at duw01 -C FCA_O.DEF -C WNB 000922 -C -C Revisions: -C -C WNB 930811 Add some names; change FIB length; add FAT* -C WNB 930803 Use WNTINC options -C WNB 890724 Original version -C JPH 930415 FCA_x_WRT --> FCA_x_WRTAPE -C -C -C Given statements: -C -C -C Result: -C -C FCA.DSC defines the FCA (File Control Area) -C -C -C Parameters: -C - INTEGER FIB__L ! FIB LENGTH (SYSTEM DEPENDENT) - PARAMETER (FIB__L=80) - INTEGER ATR__L ! ATTRIBUTE CONTROL BLK LENGTH - PARAMETER (ATR__L=12) - INTEGER RATR__L ! RECORD ATTRIBUTE LENGTH - PARAMETER (RATR__L=32) - INTEGER FCA__FNL ! FILE NAME LENGTH - PARAMETER (FCA__FNL=80) - INTEGER FCA_M_ASS ! MASKS FOR: - ! CHANNEL ASSIGNED, FILE ACCESSED - ! READ/WRITE ACTIVE - ! SEQUENTIAL FILE - ! TEMP. FILE, MAGNETIC TAPE - ! OLD FILE - PARAMETER (FCA_M_ASS=1) - INTEGER FCA_M_ACC - PARAMETER (FCA_M_ACC=2) - INTEGER FCA_M_ACT - PARAMETER (FCA_M_ACT=4) - INTEGER FCA_M_SEQ - PARAMETER (FCA_M_SEQ=8) - INTEGER FCA_M_TMP - PARAMETER (FCA_M_TMP=16) - INTEGER FCA_M_MAG - PARAMETER (FCA_M_MAG=32) - INTEGER FCA_M_OLD - PARAMETER (FCA_M_OLD=128) - INTEGER FCA_M__N - PARAMETER (FCA_M__N=10) - INTEGER FCA_M__L - PARAMETER (FCA_M__L=1) - INTEGER FCA_M__H - PARAMETER (FCA_M__H=128) - INTEGER FCA_M__I - PARAMETER (FCA_M__I=2) - INTEGER FCA_V_ASS ! BITS FOR: - ! CHANNEL ASSIGNED, FILE ACCESSED - ! READ/WRITE ACTIVE - ! SEQUENTIAL FILE - ! TEMP. FILE, MAGNETIC TAPE - ! OLD FILE - PARAMETER (FCA_V_ASS=0) - INTEGER FCA_V_ACC - PARAMETER (FCA_V_ACC=1) - INTEGER FCA_V_ACT - PARAMETER (FCA_V_ACT=2) - INTEGER FCA_V_SEQ - PARAMETER (FCA_V_SEQ=3) - INTEGER FCA_V_TMP - PARAMETER (FCA_V_TMP=4) - INTEGER FCA_V_MAG - PARAMETER (FCA_V_MAG=5) - INTEGER FCA_V_OLD - PARAMETER (FCA_V_OLD=7) - INTEGER FCA_V__N - PARAMETER (FCA_V__N=10) - INTEGER FCA_V__L - PARAMETER (FCA_V__L=0) - INTEGER FCA_V__H - PARAMETER (FCA_V__H=7) - INTEGER FCA_V__I - PARAMETER (FCA_V__I=1) - INTEGER FCA_M_WRTAPE ! MAGNETIC TAPE WRITE - PARAMETER (FCA_M_WRTAPE=64) - INTEGER FCA_V_WRTAPE - PARAMETER (FCA_V_WRTAPE=6) - INTEGER FCA_M_WRITE ! WRITE ALLOWED - PARAMETER (FCA_M_WRITE=256) - INTEGER FCA_V_WRITE - PARAMETER (FCA_V_WRITE=8) - INTEGER FAT_EFBLKL_1 - PARAMETER (FAT_EFBLKL_1=10) - INTEGER FAT_EFBLKH_1 - PARAMETER (FAT_EFBLKH_1=8) - INTEGER FAT_HIBLKL_1 - PARAMETER (FAT_HIBLKL_1=6) - INTEGER FAT_HIBLKH_1 - PARAMETER (FAT_HIBLKH_1=4) - INTEGER FAT_FFBYTE_1 - PARAMETER (FAT_FFBYTE_1=12) - INTEGER FAT_EFBLKL_I - PARAMETER (FAT_EFBLKL_I=5) - INTEGER FAT_EFBLKH_I - PARAMETER (FAT_EFBLKH_I=4) - INTEGER FAT_HIBLKL_I - PARAMETER (FAT_HIBLKL_I=3) - INTEGER FAT_HIBLKH_I - PARAMETER (FAT_HIBLKH_I=2) - INTEGER FAT_FFBYTE_I - PARAMETER (FAT_FFBYTE_I=6) -C -C FCA structure definitions: -C - INTEGER FCAHDL,FCAHDV,FCAHDS - PARAMETER ( FCAHDL=356, ! Length - 1 FCAHDV=1, ! Version - 1 FCAHDS=1) ! System - INTEGER FCA__L,FCA__V,FCA__S - PARAMETER ( FCA__L=356, ! Length - 1 FCA__V=1, ! Version - 1 FCA__S=1) ! System -C -C FCA Offsets: -C - INTEGER FCA_LINK_1,FCA_LINK_J ! LINK, MUST BE AT 0 - PARAMETER (FCA_LINK_1=0,FCA_LINK_J=0) - INTEGER FCA_TID_1,FCA_TID_J ! ID. 0=FCA, 1=MCA, MUST BE AT 4 - PARAMETER (FCA_TID_1=4,FCA_TID_J=1) - INTEGER FCA_SIZE_1,FCA_SIZE_J ! SIZE OF BLOCK - PARAMETER (FCA_SIZE_1=8,FCA_SIZE_J=2) - INTEGER FCA_CHAN_1,FCA_CHAN_J ! ASSIGNED CHANNEL - PARAMETER (FCA_CHAN_1=12,FCA_CHAN_J=3) - INTEGER FCA_IOSB_1,FCA_IOSB_J ! IO STATUS BLOCK - PARAMETER (FCA_IOSB_1=16,FCA_IOSB_J=4) - INTEGER FCA_IOSBI_1,FCA_IOSBI_I - PARAMETER (FCA_IOSBI_1=16,FCA_IOSBI_I=8) - INTEGER FCA_BITS_1,FCA_BITS_J ! BITS - PARAMETER (FCA_BITS_1=24,FCA_BITS_J=6) ! THE ABOVE SHOULD BE SAME FOR FCA & MCA - INTEGER FCA_FIBDES_1,FCA_FIBDES_J ! FIB DESCRIPTOR - PARAMETER (FCA_FIBDES_1=28,FCA_FIBDES_J=7) - INTEGER FCA_DID_1,FCA_DID_J ! DIRECTORY ID - PARAMETER (FCA_DID_1=36,FCA_DID_J=9) - INTEGER FCA_ATRJ_1,FCA_ATRJ_J ! ATTRIBUTE CONTROL BLOCK - PARAMETER (FCA_ATRJ_1=44,FCA_ATRJ_J=11) - INTEGER FCA_ATR_1,FCA_ATR_B - PARAMETER (FCA_ATR_1=44,FCA_ATR_B=44) - INTEGER FCA_BQT_1,FCA_BQT_J ! TIME ORDERED BUFFER QUEUE - PARAMETER (FCA_BQT_1=56,FCA_BQT_J=14) - INTEGER FCA_BQA_1,FCA_BQA_J ! ADDRESS ORDERED BUFFER QUEUE - PARAMETER (FCA_BQA_1=64,FCA_BQA_J=16) - INTEGER FCA_BLEN_1,FCA_BLEN_J ! BUFFER LENGTH - PARAMETER (FCA_BLEN_1=72,FCA_BLEN_J=18) - INTEGER FCA_BCP_1,FCA_BCP_J ! BUFFER CONTROL AREA POINTER - PARAMETER (FCA_BCP_1=76,FCA_BCP_J=19) - INTEGER FCA_FEA_1,FCA_FEA_J ! ACTIVE FILE ELEMENT QUEUE - PARAMETER (FCA_FEA_1=80,FCA_FEA_J=20) - INTEGER FCA_FEE_1,FCA_FEE_J ! EMPTY FILE ELEMENT QUEUE - PARAMETER (FCA_FEE_1=88,FCA_FEE_J=22) - INTEGER FCA_FEP_1,FCA_FEP_J ! ELEMENT AREA POINTER - PARAMETER (FCA_FEP_1=96,FCA_FEP_J=24) - INTEGER FCA_FEL_1,FCA_FEL_J ! CURRENT ELEMENT POINTER - PARAMETER (FCA_FEL_1=100,FCA_FEL_J=25) - INTEGER FCA_MCA_1,FCA_MCA_J ! PTR TO MCA - PARAMETER (FCA_MCA_1=104,FCA_MCA_J=26) - INTEGER FCA_HIBLK_1,FCA_HIBLK_J ! LOWEST NOT ALLOCATED ADDRESS - PARAMETER (FCA_HIBLK_1=108,FCA_HIBLK_J=27) - INTEGER FCA_EOF_1,FCA_EOF_J ! FIRST BYTE BEYOND EOF - PARAMETER (FCA_EOF_1=112,FCA_EOF_J=28) - INTEGER FCA_RAD_1,FCA_RAD_J ! LAST READ ADDRESS - PARAMETER (FCA_RAD_1=116,FCA_RAD_J=29) - INTEGER FCA_DAD_1,FCA_DAD_J ! DISK ADDRESS - PARAMETER (FCA_DAD_1=120,FCA_DAD_J=30) - INTEGER FCA_BAD_1,FCA_BAD_J ! BUFFER ADDRESS - PARAMETER (FCA_BAD_1=124,FCA_BAD_J=31) - INTEGER FCA_LEN_1,FCA_LEN_J ! LENGTH TO READ/WRITE - PARAMETER (FCA_LEN_1=128,FCA_LEN_J=32) - INTEGER FCA_ACLEN_1,FCA_ACLEN_J ! ACTUAL LENGTH READ/WRITTEN - PARAMETER (FCA_ACLEN_1=132,FCA_ACLEN_J=33) - INTEGER FCA_EF_1,FCA_EF_J ! IO EF - PARAMETER (FCA_EF_1=136,FCA_EF_J=34) - INTEGER FCA_EFA_1,FCA_EFA_J ! ACTIVITY EF - PARAMETER (FCA_EFA_1=140,FCA_EFA_J=35) - INTEGER FCA_ERR_1,FCA_ERR_J ! FINAL IO ERROR - PARAMETER (FCA_ERR_1=144,FCA_ERR_J=36) - INTEGER FCA_MAP_1,FCA_MAP_J ! MAG TAPE POINTER - PARAMETER (FCA_MAP_1=148,FCA_MAP_J=37) - INTEGER FCA_MAB_1,FCA_MAB_J ! MAG TAPE BLOCK - PARAMETER (FCA_MAB_1=152,FCA_MAB_J=38) - INTEGER FCA_MAW_1,FCA_MAW_J ! MAG TAPE WRITE POSITION - PARAMETER (FCA_MAW_1=156,FCA_MAW_J=39) - INTEGER FCA_FNAML_1,FCA_FNAML_J ! FILE NAME LENGTH - PARAMETER (FCA_FNAML_1=160,FCA_FNAML_J=40) - INTEGER FCA_FIBJ_1,FCA_FIBJ_J ! FIB - PARAMETER (FCA_FIBJ_1=164,FCA_FIBJ_J=41) - INTEGER FCA_FIBI_1,FCA_FIBI_I - PARAMETER (FCA_FIBI_1=164,FCA_FIBI_I=82) - INTEGER FCA_FIB_1,FCA_FIB_B - PARAMETER (FCA_FIB_1=164,FCA_FIB_B=164) - INTEGER FCA_FNAM_1,FCA_FNAM_C,FCA_FNAM_N ! FILE NAME - PARAMETER (FCA_FNAM_1=244,FCA_FNAM_C=244,FCA_FNAM_N=80) - INTEGER FCA_RECATRJ_1,FCA_RECATRJ_J ! RECORD ATTRIBUTES - PARAMETER (FCA_RECATRJ_1=324,FCA_RECATRJ_J=81) - INTEGER FCA_RECATR_1,FCA_RECATR_B - PARAMETER (FCA_RECATR_1=324,FCA_RECATR_B=324) -C -C Given statements: -C -C- diff --git a/src/wng/fca_o.inc b/src/wng/fca_o.inc deleted file mode 100644 index 1e2b34dafd8b8a62b6df276dcdac61887dd5c2ad..0000000000000000000000000000000000000000 --- a/src/wng/fca_o.inc +++ /dev/null @@ -1,139 +0,0 @@ -/*+ Created from fca.dsc on 000922 at 11:09:12 at duw01 -.. FCA_O.INC -.. WNB 000922 -.. -.. Revisions: -.. -.. WNB 930811 Add some names; change FIB length; add FAT* -.. WNB 930803 Use WNTINC options -.. WNB 890724 Original version -.. JPH 930415 FCA_x_WRT --> FCA_x_WRTAPE -.. */ -/* -.. Given statements: -.. */ -/* -.. Result: -.. -.. FCA.DSC defines the FCA (File Control Area) -.. */ -/* -.. Parameters: -.. */ -#define FIB__L 80 /* FIB LENGTH (SYSTEM DEPENDENT) */ -#define ATR__L 12 /* ATTRIBUTE CONTROL BLK LENGTH */ -#define RATR__L 32 /* RECORD ATTRIBUTE LENGTH */ -#define FCA__FNL 80 /* FILE NAME LENGTH */ -#define FCA_M_ASS 1 /* MASKS FOR: */ - /* CHANNEL ASSIGNED, FILE ACCESSED */ - /* READ/WRITE ACTIVE */ - /* SEQUENTIAL FILE */ - /* TEMP. FILE, MAGNETIC TAPE */ - /* OLD FILE */ -#define FCA_M_ACC 2 -#define FCA_M_ACT 4 -#define FCA_M_SEQ 8 -#define FCA_M_TMP 16 -#define FCA_M_MAG 32 -#define FCA_M_OLD 128 -#define FCA_M__N 10 -#define FCA_M__L 1 -#define FCA_M__H 128 -#define FCA_M__I 2 -#define FCA_V_ASS 0 /* BITS FOR: */ - /* CHANNEL ASSIGNED, FILE ACCESSED */ - /* READ/WRITE ACTIVE */ - /* SEQUENTIAL FILE */ - /* TEMP. FILE, MAGNETIC TAPE */ - /* OLD FILE */ -#define FCA_V_ACC 1 -#define FCA_V_ACT 2 -#define FCA_V_SEQ 3 -#define FCA_V_TMP 4 -#define FCA_V_MAG 5 -#define FCA_V_OLD 7 -#define FCA_V__N 10 -#define FCA_V__L 0 -#define FCA_V__H 7 -#define FCA_V__I 1 -#define FCA_M_WRTAPE 64 /* MAGNETIC TAPE WRITE */ -#define FCA_V_WRTAPE 6 -#define FCA_M_WRITE 256 /* WRITE ALLOWED */ -#define FCA_V_WRITE 8 -#define FAT_EFBLKL_1 10 -#define FAT_EFBLKH_1 8 -#define FAT_HIBLKL_1 6 -#define FAT_HIBLKH_1 4 -#define FAT_FFBYTE_1 12 -#define FAT_EFBLKL_I 5 -#define FAT_EFBLKH_I 4 -#define FAT_HIBLKL_I 3 -#define FAT_HIBLKH_I 2 -#define FAT_FFBYTE_I 6 -/* -.. FCA structure definitions: -.. */ -#define FCAHDL 356 /* Length */ -#define FCAHDV 1 /* Version */ -#define FCAHDS 1 /* System */ -#define FCA__L 356 /* Length */ -#define FCA__V 1 /* Version */ -#define FCA__S 1 /* System */ -/* -.. FCA Offsets: -.. */ -struct fca { - int link; /* LINK, MUST BE AT 0 */ - int tid; /* ID. 0=FCA, 1=MCA, MUST BE AT 4 */ - int size; /* SIZE OF BLOCK */ - int chan; /* ASSIGNED CHANNEL */ - union { - int iosb[2]; /* IO STATUS BLOCK */ - short iosbi[4]; - } iosb; - int bits; /* BITS */ - /* THE ABOVE SHOULD BE SAME FOR FCA & MCA */ - int fibdes[2]; /* FIB DESCRIPTOR */ - int did[2]; /* DIRECTORY ID */ - union { - int atrj[3]; /* ATTRIBUTE CONTROL BLOCK */ - char atr[12]; - } atrj; - int bqt[2]; /* TIME ORDERED BUFFER QUEUE */ - int bqa[2]; /* ADDRESS ORDERED BUFFER QUEUE */ - int blen; /* BUFFER LENGTH */ - int bcp; /* BUFFER CONTROL AREA POINTER */ - int fea[2]; /* ACTIVE FILE ELEMENT QUEUE */ - int fee[2]; /* EMPTY FILE ELEMENT QUEUE */ - int fep; /* ELEMENT AREA POINTER */ - int fel; /* CURRENT ELEMENT POINTER */ - int mca; /* PTR TO MCA */ - int hiblk; /* LOWEST NOT ALLOCATED ADDRESS */ - int eof; /* FIRST BYTE BEYOND EOF */ - int rad; /* LAST READ ADDRESS */ - int dad; /* DISK ADDRESS */ - int bad; /* BUFFER ADDRESS */ - int len; /* LENGTH TO READ/WRITE */ - int aclen; /* ACTUAL LENGTH READ/WRITTEN */ - int ef; /* IO EF */ - int efa; /* ACTIVITY EF */ - int err; /* FINAL IO ERROR */ - int map; /* MAG TAPE POINTER */ - int mab; /* MAG TAPE BLOCK */ - int maw; /* MAG TAPE WRITE POSITION */ - int fnaml; /* FILE NAME LENGTH */ - union { - int fibj[20]; /* FIB */ - short fibi[40]; - char fib[80]; - } fibj; - char fnam[80]; /* FILE NAME */ - union { - int recatrj[8]; /* RECORD ATTRIBUTES */ - char recatr[32]; - } recatrj; -}; /* END DEFINITION */ -/* -.. Given statements: -.. */ -/*- */ diff --git a/src/wng/fca_t.def b/src/wng/fca_t.def deleted file mode 100644 index 5a74591c352541c36acc12fe21fd688bfa365c26..0000000000000000000000000000000000000000 --- a/src/wng/fca_t.def +++ /dev/null @@ -1,39 +0,0 @@ -C+ Created from fca.dsc on 000922 at 11:09:12 at duw01 -C FCA_T.DEF -C WNB 000922 -C -C Revisions: -C -C WNB 930811 Add some names; change FIB length; add FAT* -C WNB 930803 Use WNTINC options -C WNB 890724 Original version -C JPH 930415 FCA_x_WRT --> FCA_x_WRTAPE -C -C -C Result: -C -C FCA.DSC defines the FCA (File Control Area) -C -C -C Specification of translation tables: -C -C 0= end of table 1= character -C 2= 16 bits integer 3= 32 bits integer -C 4= 32 bits real 5= 64 bits real -C 6= repeat 7= end repeat -C 8= undefined 9= byte -C 10= external repeat 11= start union -C 12= start map 13= end union -C 14= 64 bits complex 15= 128 bits complex -C -C -C FCA translation definitions: -C - INTEGER*2 FCA_T(2,4) - EQUIVALENCE (FCA_T,FCA__T(1,1)) - DATA FCA_T(1,1),FCA_T(2,1) /3,61/ - DATA FCA_T(1,2),FCA_T(2,2) /1,80/ - DATA FCA_T(1,3),FCA_T(2,3) /3,8/ - DATA FCA_T(1,4),FCA_T(2,4) /0,1/ - INTEGER*2 FCA__T(2,4) -C- diff --git a/src/wng/fca_t.inc b/src/wng/fca_t.inc deleted file mode 100644 index 38be94c27982f1fa5c4cc26bfc8d7314d12cd49a..0000000000000000000000000000000000000000 --- a/src/wng/fca_t.inc +++ /dev/null @@ -1,39 +0,0 @@ -/*+ Created from fca.dsc on 000922 at 11:09:12 at duw01 -.. FCA_T.INC -.. WNB 000922 -.. -.. Revisions: -.. -.. WNB 930811 Add some names; change FIB length; add FAT* -.. WNB 930803 Use WNTINC options -.. WNB 890724 Original version -.. JPH 930415 FCA_x_WRT --> FCA_x_WRTAPE -.. */ -/* -.. Result: -.. -.. FCA.DSC defines the FCA (File Control Area) -.. */ -/* -.. Specification of translation tables: -.. -.. 0= end of table 1= character -.. 2= 16 bits integer 3= 32 bits integer -.. 4= 32 bits real 5= 64 bits real -.. 6= repeat 7= end repeat -.. 8= undefined 9= byte -.. 10= external repeat 11= start union -.. 12= start map 13= end union -.. 14= 64 bits complex 15= 128 bits complex -.. */ - static struct { -/* -.. FCA translation definitions: -.. */ - short fca_t [4][2] ; - } fca__t = { - 3, 61, - 1, 80, - 3, 8, - 0, 1 }; -/*- */ diff --git a/src/wng/fcq.def b/src/wng/fcq.def deleted file mode 100644 index e24ba1f3e1535f1d5b54cfbf9cfd76aaa9c6273f..0000000000000000000000000000000000000000 --- a/src/wng/fcq.def +++ /dev/null @@ -1,40 +0,0 @@ -C+ Created from fcq.dsc on 000922 at 11:09:06 at duw01 -C FCQ.DEF -C WNB 000922 -C -C Revisions: -C -C WNB 890724 Original version -C -C -C Given statements: -C -C -C Result: -C -C FCQ.DSC defines the FCA (File Control Area) queue and the -C FCA exit handler block. -C -C -C Parameters: -C -C -C Data declarations: -C -C -C FCQ common data: -C - INTEGER FCAQUE ! FCA QUEUE HEAD - INTEGER FCAEXH(1:6) ! EXIT HANDLER BLOCK -C -C FCQ common block: -C - COMMON /FCQ_COM/ FCAQUE,FCAEXH -C -C External initialisation: -C - EXTERNAL FCQ_BD -C -C Given statements: -C -C- diff --git a/src/wng/fcq.dsc b/src/wng/fcq.dsc deleted file mode 100644 index fd851f69d9e15e5d9822837e07dc830ed6e6a5a1..0000000000000000000000000000000000000000 --- a/src/wng/fcq.dsc +++ /dev/null @@ -1,26 +0,0 @@ -!+ FCQ.DSC -! WNB 850910 -! -! Revisions: -! -! -! Define FCA (File Control Area) queue -! -! -! -%LOCAL=XHL=6 !LENGTH EXIT HANDLER BLOCK -%VERSION=1 !VERSION -%SYSTEM=1 -%USER=WNB -%%DATE -%%NAME -%REVISION=WNB=890724="Original version" -%COMMENT="FCQ.DSC defines the FCA (File Control Area) queue and the" -%COMMENT=" FCA exit handler block." -!- -.DEFINE -.COMMON - FCAQUE J /0/ !FCA QUEUE HEAD - FCAEXH J(XHL) /(XHL)0/ !EXIT HANDLER BLOCK -.END !END DEFINITION -!- diff --git a/src/wng/fcq.inc b/src/wng/fcq.inc deleted file mode 100644 index f605a4abd125d6d28d998aa8b46f41b2ce96a4d9..0000000000000000000000000000000000000000 --- a/src/wng/fcq.inc +++ /dev/null @@ -1,42 +0,0 @@ -/*+ Created from fcq.dsc on 000922 at 11:09:06 at duw01 -.. FCQ.INC -.. WNB 000922 -.. -.. Revisions: -.. -.. WNB 890724 Original version -.. */ -/* -.. Given statements: -.. */ -/* -.. Result: -.. -.. FCQ.DSC defines the FCA (File Control Area) queue and the -.. FCA exit handler block. -.. */ -/* -.. Parameters: -.. */ -/* -.. Data declarations: -.. */ -/* -.. FCQ common data: -.. */ -struct fcq_com { - int fcaque; /* FCA QUEUE HEAD */ - int fcaexh[6]; /* EXIT HANDLER BLOCK */ -}; -/* -.. FCQ common block: -.. */ -extern struct fcq_com fcq_com_ ; -/* -.. External initialisation: -.. */ - extern fcq_bd_() ; -/* -.. Given statements: -.. */ -/*- */ diff --git a/src/wng/fcq_bd.for b/src/wng/fcq_bd.for deleted file mode 100644 index 594359e923ed77b8bdfeb30ffda1eefcf480eada..0000000000000000000000000000000000000000 --- a/src/wng/fcq_bd.for +++ /dev/null @@ -1,35 +0,0 @@ -C+ Created from fcq.dsc on 000922 at 11:09:06 at duw01 -C FCQ_BD.FOR -C WNB 000922 -C -C Revisions: -C -C WNB 890724 Original version -C - BLOCK DATA FCQ_BD -C -C Result: -C -C Initialisation of fcq.def -C -C FCQ.DSC defines the FCA (File Control Area) queue and the -C FCA exit handler block. -C -C -C Parameters: -C -C -C FCQ common data: -C - INTEGER FCAQUE ! FCA QUEUE HEAD - DATA FCAQUE /0/ - INTEGER FCAEXH(1:6) ! EXIT HANDLER BLOCK - DATA FCAEXH /6*0/ -C -C FCQ common block: -C - COMMON /FCQ_COM/ FCAQUE,FCAEXH -C -C - END -C- diff --git a/src/wng/fel.dsc b/src/wng/fel.dsc deleted file mode 100644 index 1f9a086ec97df78e20bded09e29e077711f5a4af..0000000000000000000000000000000000000000 --- a/src/wng/fel.dsc +++ /dev/null @@ -1,29 +0,0 @@ -!+ FEL.DSC -! WNB 890725 -! -! Revisions: -! -%REVISION=WNB=930803="Rearrange text" -%REVISION=WNB=890724="Original version" -! -! Define FEL (File ELement descriptor) -! -%COMMENT="FEL.DSC defines the FEL (File ELement description)" -! -! -%VERSION=1 !VERSION -%SYSTEM=1 -%USER=WNB -%%DATE -%%NAME -!- -.PARAMETER - FEL__NFEL J /16/ !# OF ELEMENTS WANTED -.BEGIN=FEL - LINK J(2) !LINK LIST, MUST BE AT 0 - BITS J !BITS (BIT0=1: READ, ELSE WRITE) - BUFAD J !USER BUF ADDRESS - BUFLEN J !USER BUF LENGTH - DKAD J !DISK ADDRESS -.END !END DEFINITION -!- diff --git a/src/wng/fel_e.def b/src/wng/fel_e.def deleted file mode 100644 index 93fb51e43f7dc4c3daf2ab5e71391f31b0e61c0c..0000000000000000000000000000000000000000 --- a/src/wng/fel_e.def +++ /dev/null @@ -1,51 +0,0 @@ -C+ Created from fel.dsc on 000922 at 11:09:18 at duw01 -C FEL_E.DEF -C WNB 000922 -C -C Revisions: -C -C WNB 930803 Rearrange text -C WNB 890724 Original version -C -C -C Result: -C -C FEL.DSC defines the FEL (File ELement description) -C -C -C Specification of edit tables: -C -C The character (_EC) table contains: -C fieldname, pattern, units, special code -C The integer (_EJ) table contains: -C offset, #of values, edit (0=allowed), unit length -C -C -C FEL edit definitions: -C - INTEGER FELEDL,FEL__EL - PARAMETER ( FELEDL=5, ! Length table - 1 FEL__EL=5) - CHARACTER*12 FEL_EC(4,5) - INTEGER FEL_EJ(4,5) - DATA FEL_EC(1,1),FEL_EC(2,1),FEL_EC(3,1),FEL_EC(4,1) - 1 /'LINK','SJ',' ',' '/ - DATA FEL_EJ(1,1),FEL_EJ(2,1),FEL_EJ(3,1),FEL_EJ(4,1) - 1 /0,2,0,4/ - DATA FEL_EC(1,2),FEL_EC(2,2),FEL_EC(3,2),FEL_EC(4,2) - 1 /'BITS','SJ',' ',' '/ - DATA FEL_EJ(1,2),FEL_EJ(2,2),FEL_EJ(3,2),FEL_EJ(4,2) - 1 /8,1,0,4/ - DATA FEL_EC(1,3),FEL_EC(2,3),FEL_EC(3,3),FEL_EC(4,3) - 1 /'BUFAD','SJ',' ',' '/ - DATA FEL_EJ(1,3),FEL_EJ(2,3),FEL_EJ(3,3),FEL_EJ(4,3) - 1 /12,1,0,4/ - DATA FEL_EC(1,4),FEL_EC(2,4),FEL_EC(3,4),FEL_EC(4,4) - 1 /'BUFLEN','SJ',' ',' '/ - DATA FEL_EJ(1,4),FEL_EJ(2,4),FEL_EJ(3,4),FEL_EJ(4,4) - 1 /16,1,0,4/ - DATA FEL_EC(1,5),FEL_EC(2,5),FEL_EC(3,5),FEL_EC(4,5) - 1 /'DKAD','SJ',' ',' '/ - DATA FEL_EJ(1,5),FEL_EJ(2,5),FEL_EJ(3,5),FEL_EJ(4,5) - 1 /20,1,0,4/ -C- diff --git a/src/wng/fel_e.inc b/src/wng/fel_e.inc deleted file mode 100644 index 4ac08ac7100e67156fdd7ab79b13dbd0b8e6fa65..0000000000000000000000000000000000000000 --- a/src/wng/fel_e.inc +++ /dev/null @@ -1,40 +0,0 @@ -/*+ Created from fel.dsc on 000922 at 11:09:18 at duw01 -.. FEL_E.INC -.. WNB 000922 -.. -.. Revisions: -.. -.. WNB 930803 Rearrange text -.. WNB 890724 Original version -.. */ -/* -.. Result: -.. -.. FEL.DSC defines the FEL (File ELement description) -.. */ -/* -.. Specification of edit tables: -.. -.. The character (_EC) table contains: -.. fieldname, pattern, units, special code -.. The integer (_EJ) table contains: -.. offset, #of values, edit (0=allowed), unit length -.. */ -/* -.. FEL edit definitions: -.. */ -#define FELEDL 5 /* Length table */ -#define FEL__EL 5 /* Length table */ - static char fel_ec [5][4][12] = { - "LINK","SJ"," "," ", - "BITS","SJ"," "," ", - "BUFAD","SJ"," "," ", - "BUFLEN","SJ"," "," ", - "DKAD","SJ"," "," "}; - static int fel_ej [5][4] = { - 0,2,0,4, - 8,1,0,4, - 12,1,0,4, - 16,1,0,4, - 20,1,0,4}; -/*- */ diff --git a/src/wng/fel_o.def b/src/wng/fel_o.def deleted file mode 100644 index a0ccc2b9b61c855cd0ed34fdfd7c624ed3d45bee..0000000000000000000000000000000000000000 --- a/src/wng/fel_o.def +++ /dev/null @@ -1,50 +0,0 @@ -C+ Created from fel.dsc on 000922 at 11:09:18 at duw01 -C FEL_O.DEF -C WNB 000922 -C -C Revisions: -C -C WNB 930803 Rearrange text -C WNB 890724 Original version -C -C -C Given statements: -C -C -C Result: -C -C FEL.DSC defines the FEL (File ELement description) -C -C -C Parameters: -C - INTEGER FEL__NFEL ! # OF ELEMENTS WANTED - PARAMETER (FEL__NFEL=16) -C -C FEL structure definitions: -C - INTEGER FELHDL,FELHDV,FELHDS - PARAMETER ( FELHDL=24, ! Length - 1 FELHDV=1, ! Version - 1 FELHDS=1) ! System - INTEGER FEL__L,FEL__V,FEL__S - PARAMETER ( FEL__L=24, ! Length - 1 FEL__V=1, ! Version - 1 FEL__S=1) ! System -C -C FEL Offsets: -C - INTEGER FEL_LINK_1,FEL_LINK_J ! LINK LIST, MUST BE AT 0 - PARAMETER (FEL_LINK_1=0,FEL_LINK_J=0) - INTEGER FEL_BITS_1,FEL_BITS_J ! BITS (BIT0=1: READ, ELSE WRITE) - PARAMETER (FEL_BITS_1=8,FEL_BITS_J=2) - INTEGER FEL_BUFAD_1,FEL_BUFAD_J ! USER BUF ADDRESS - PARAMETER (FEL_BUFAD_1=12,FEL_BUFAD_J=3) - INTEGER FEL_BUFLEN_1,FEL_BUFLEN_J ! USER BUF LENGTH - PARAMETER (FEL_BUFLEN_1=16,FEL_BUFLEN_J=4) - INTEGER FEL_DKAD_1,FEL_DKAD_J ! DISK ADDRESS - PARAMETER (FEL_DKAD_1=20,FEL_DKAD_J=5) -C -C Given statements: -C -C- diff --git a/src/wng/fel_o.inc b/src/wng/fel_o.inc deleted file mode 100644 index 3c5118011a8dc5048b29cd58e04f6b29b64e1b91..0000000000000000000000000000000000000000 --- a/src/wng/fel_o.inc +++ /dev/null @@ -1,44 +0,0 @@ -/*+ Created from fel.dsc on 000922 at 11:09:18 at duw01 -.. FEL_O.INC -.. WNB 000922 -.. -.. Revisions: -.. -.. WNB 930803 Rearrange text -.. WNB 890724 Original version -.. */ -/* -.. Given statements: -.. */ -/* -.. Result: -.. -.. FEL.DSC defines the FEL (File ELement description) -.. */ -/* -.. Parameters: -.. */ -#define FEL__NFEL 16 /* # OF ELEMENTS WANTED */ -/* -.. FEL structure definitions: -.. */ -#define FELHDL 24 /* Length */ -#define FELHDV 1 /* Version */ -#define FELHDS 1 /* System */ -#define FEL__L 24 /* Length */ -#define FEL__V 1 /* Version */ -#define FEL__S 1 /* System */ -/* -.. FEL Offsets: -.. */ -struct fel { - int link[2]; /* LINK LIST, MUST BE AT 0 */ - int bits; /* BITS (BIT0=1: READ, ELSE WRITE) */ - int bufad; /* USER BUF ADDRESS */ - int buflen; /* USER BUF LENGTH */ - int dkad; /* DISK ADDRESS */ -}; /* END DEFINITION */ -/* -.. Given statements: -.. */ -/*- */ diff --git a/src/wng/fel_t.def b/src/wng/fel_t.def deleted file mode 100644 index 4293ba3bbac8b65e03f108975bbc827d97c4d63c..0000000000000000000000000000000000000000 --- a/src/wng/fel_t.def +++ /dev/null @@ -1,35 +0,0 @@ -C+ Created from fel.dsc on 000922 at 11:09:18 at duw01 -C FEL_T.DEF -C WNB 000922 -C -C Revisions: -C -C WNB 930803 Rearrange text -C WNB 890724 Original version -C -C -C Result: -C -C FEL.DSC defines the FEL (File ELement description) -C -C -C Specification of translation tables: -C -C 0= end of table 1= character -C 2= 16 bits integer 3= 32 bits integer -C 4= 32 bits real 5= 64 bits real -C 6= repeat 7= end repeat -C 8= undefined 9= byte -C 10= external repeat 11= start union -C 12= start map 13= end union -C 14= 64 bits complex 15= 128 bits complex -C -C -C FEL translation definitions: -C - INTEGER*2 FEL_T(2,2) - EQUIVALENCE (FEL_T,FEL__T(1,1)) - DATA FEL_T(1,1),FEL_T(2,1) /3,6/ - DATA FEL_T(1,2),FEL_T(2,2) /0,1/ - INTEGER*2 FEL__T(2,2) -C- diff --git a/src/wng/fel_t.inc b/src/wng/fel_t.inc deleted file mode 100644 index d70096b3f3dc2ac109cae99e6fb2d56d65c6bddd..0000000000000000000000000000000000000000 --- a/src/wng/fel_t.inc +++ /dev/null @@ -1,35 +0,0 @@ -/*+ Created from fel.dsc on 000922 at 11:09:18 at duw01 -.. FEL_T.INC -.. WNB 000922 -.. -.. Revisions: -.. -.. WNB 930803 Rearrange text -.. WNB 890724 Original version -.. */ -/* -.. Result: -.. -.. FEL.DSC defines the FEL (File ELement description) -.. */ -/* -.. Specification of translation tables: -.. -.. 0= end of table 1= character -.. 2= 16 bits integer 3= 32 bits integer -.. 4= 32 bits real 5= 64 bits real -.. 6= repeat 7= end repeat -.. 8= undefined 9= byte -.. 10= external repeat 11= start union -.. 12= start map 13= end union -.. 14= 64 bits complex 15= 128 bits complex -.. */ - static struct { -/* -.. FEL translation definitions: -.. */ - short fel_t [2][2] ; - } fel__t = { - 3, 6, - 0, 1 }; -/*- */ diff --git a/src/wng/gfh.dsc b/src/wng/gfh.dsc deleted file mode 100644 index dd524909ce4abe536a75d3755e95651a01d60e33..0000000000000000000000000000000000000000 --- a/src/wng/gfh.dsc +++ /dev/null @@ -1,49 +0,0 @@ -!+ GFH.DSC -! WNB 900131 -! -! Revisions: -! -%REVISION=WNB=931215="Add some edit formats" -%REVISION=JPH=930903="Comments" -%REVISION=WNB=930803="Include gfh_eqv.def" -%REVISION=WNB=900131="Original version" -! -! Define general DWARF-redundancy file header -! -%COMMENT="GFH.DSC defines the general file header redundancy files" -%COMMENT=" " -! -%VERSION=1 !VERSION -%SYSTEM=1 -%USER=WNB -%%DATE -%%NAME -!- -.PARAMETER -.BEGIN=GFH - ID C4 <,1> !Type of block (e.g. .SCN) - LEN J <,1> !Length header - VER J <,1> !Version - CDAT C11 !Creation date (dd-mmm-yyyy) - CTIM C5 !Creation time (hh:mm) - RDAT C11 !Revision date - RTIM C5 !Revision time - RCNT J !Revison count - NAME C80 <,1> !Node name used - DATTP B <,1> !Data type (1,2=VAX, 3=Alliant, 4=Convex) - - -(0:22) !Reserved - LINK J(0:1) <XJ,1> !Link to data - ALHD=LINK J(0:1) <XJ,1> !absolute listhead - NLINK J <,1> !Count linkage - ALLEN=NLINK J <,1> !absolute-list length - LINKG J(0:1) <XJ,1,,P:SGH> !Secondary link - LHD=LINKG J(0:1) <XJ,1,,P:SGH> !(subgroup) listhead - NLINKG J <,1> - LLEN=NLINKG J <,1> !(subgroup) list length - IDMDL J <,1> !Model unique identification (not used) - ID1 J <,1> !Other id - ID2 J <,1> !Other id - USER - !Start user area -.OFFSET=512 !Reserve with binary zeroes -.END !END DEFINITION -!- diff --git a/src/wng/login_mask.com b/src/wng/login_mask.com deleted file mode 100644 index baddd66afb4a063ca34b7ebc850451a63128584d..0000000000000000000000000000000000000000 --- a/src/wng/login_mask.com +++ /dev/null @@ -1,39 +0,0 @@ -$ ! LOGIN_MASK.COM -$ ! WNB 920127 -$ ! -$ SET DEF SYS$LOGIN: -$ ! -$ ! The DWARF login file -$ ! -$ ! LOGICAL UNIT ASSIGNMENTS -$ ! -$ SET NOON -$ IF "''QDWARF'" .NES. "" THEN GOTO LA -$ QDWARF=="SYST1:" -$ SET PROTECTION=(S:RWED,O:RWED,G:RWE,W:RE)/DEFAULT -$ ! -$ ! SYSTEM CHOICE AND LOCAL ASSIGNMENTS -$ ! -$ ASGNEW: -$ @RUNDWARF:DWARFINI/OUT=NL: -$ PRI*NT=="PRINT" -$ H*ELP=="HELP/NOINSTR/NOPAGE" -$ SPEC DWARF/NOMEN -BELL=OFF -$ SPEC GLOBAL/NOMEN -DATABASE="USER5:[WNB.DWARFDATA]RED" -$ SET_APPLIC !SET PROPER LIBDWARF -$ ASSIGN/NOLOG [] EXEUSER !RUN DWARF FROM USER -$ XCOP=="@SYSDWARF:ATPRIV MNTDWARF:COPYIMAGE" !COPY TO EXEDWARF: -$ DTEST=="@USER5:[WNB]TEST" !TO TEST SYSTEM -$ DRUN=="@USER5:[WNB]RUN" !TO RUN SYSTEM -$ ! -$ ! WNB PART -$ ! -$ @USER5:[WNB.WNG]WNGCSHRC_<site> !WNG DEFINITION -$ LA: QWIM=="USER5:" -$ @USER5:[WNB.WNG]WNXLOGIN.COM WNB !EXTENDED DEFINITIONS -$ DWD*ATA=="SET DEF USER5:[WNB.DWARFDATA]" !TO GO TO DWARF DATA DIR. -$ IF "''F$TRNLNM("WR")'" .EQS. "" THEN ASSIGN [WNB.WR] WR -$ SET PROMPT="wb$ " -$ EXIT diff --git a/src/wng/login_mask.sun b/src/wng/login_mask.sun deleted file mode 100755 index 5a151418e8c43eaee374e71ededff8fe68719d46..0000000000000000000000000000000000000000 --- a/src/wng/login_mask.sun +++ /dev/null @@ -1,11 +0,0 @@ -set notify ignoreeof savehist=100 time=30 -set prompt="> " -set path = ( . ~/bin /usr/bin /usr/ucb /bin /usr/local /usr/alliant /etc) -set mail=(0 /usr/spool/mail/$USER) -alias ts 'set noglob;eval `tset -s -Q vt100`;set term=$TERM;unset noglob' -alias tsn 'set noglob;eval `tset -s -Q ?vt100`;set term=$TERM;unset noglob' -ts -# -source $WNG/wnglogin.sun -uptime -if ($term == vt100) echo -n "=[?1h" diff --git a/src/wng/logout_mask.com b/src/wng/logout_mask.com deleted file mode 100644 index 0c4a29457d9531620f7a542840498aaf9225562f..0000000000000000000000000000000000000000 --- a/src/wng/logout_mask.com +++ /dev/null @@ -1,41 +0,0 @@ -$ ! LOGOUT_MASK.COM -$ ! WNB 920127 -$ ! -$ SWIM !SET PROPER DIRECTORY -$ ! -$ ! Change WNB in next to your own -$ ! -$ P1="WNB" -$ IF P2 .EQS. "" THEN LOCA=F$VERIFY(0) -$ IF P2 .NES. "" THEN LOCA=F$VERIFY(1) -$ SET NOON -$ STMAIN !SET MAIN UIC -$ CREATE QQXXYYZZ.TMP !TO GET NO MESSAGES -A -$ COPY QQXXYYZZ.TMP QQXXYYZZ.LIS -$ COPY QQXXYYZZ.TMP QQXXYYZZ.MAP -$ COPY QQXXYYZZ.TMP QQXXYYZZ.OBJ -$ COPY QQXXYYZZ.TMP QQXXYYZZ.JOU -$ COPY QQXXYYZZ.TMP QQXXYYZZ.LOG -$ COPY QQXXYYZZ.TMP QQXXYYZZ.TMP -$ COPY QQXXYYZZ.TMP QQXXYYZZ.TMP -$ ! -$ ! PURGE ALL -$ ! -$ PURGE ['P1'...]*.* -$ ! -$ ! DELETE FILES (.OBJ 1 MONTH, .LIS and .MAP 2 DAYS, .LOG 1 WEEK, -$ ! ALL TMP and JOU) -$ ! -$ DELETE/BEFORE="TODAY-0030-00:00:00" ['P1'...]*.OBJ;* -$ DELETE/BEFORE="TODAY-0007-00:00:00" ['P1'...]*.LOG;* -$ DELETE/BEFORE="TODAY-0002-00:00:00" - - ['P1'...]*.LIS;*,['P1'...]*.MAP;* -$ DELETE ['P1'...]*.TMP;*,['P1'...]*.JOU;* -$ DELETE QQXXYYZZ.*;* -$ ! -$ EXIT: STDEF !BACK TO DEFAULT -$ SHOW QUOTA !SHOW DISK QUOTA -$ ! -$ SET ON !RESET ERROR HANDLING -$ EXIT ! 'F$VERIFY(LOCA)' diff --git a/src/wng/logout_mask.sun b/src/wng/logout_mask.sun deleted file mode 100755 index ab704ac50120d44795413ef1f5f9ec56a38d27d8..0000000000000000000000000000000000000000 --- a/src/wng/logout_mask.sun +++ /dev/null @@ -1,4 +0,0 @@ -clear; -uptime; -date; -sleep 0 diff --git a/src/wng/lsq.dsc b/src/wng/lsq.dsc deleted file mode 100644 index e204377d3b20f5aeeca9d17e83836a5021281bbd..0000000000000000000000000000000000000000 --- a/src/wng/lsq.dsc +++ /dev/null @@ -1,75 +0,0 @@ -!+ LSQ.DSC -! WNB 950328 -! -! Revisions: -! -%REVISION=WNB=950328="Original version" -! -! Define the LSQ control area -! -%COMMENT="LSQ.DSC defines the LSQ (Least SQuares) control area" -! -%VERSION=1 !VERSION -%SYSTEM=1 -%USER=WNB -%%DATE -%%NAME -! -%ALIGN !ALIGN STRUCTURES -!- -.PARAMETER - LSQ_T MF: \ !TYPE FOR: - /REAL,COMPLEX, \ !REAL,COMPLEX, - MULTIPLE, \ !MULTIPLE KNOWN SIDES (M) - CONSTRAINT, \ !CONSTRAINT EQUATIONS (N-NUN) - PREC, \ !PRECISION GIVEN - NOINIT/ !DO NOT INIT (LOCAL ONLY) - LSQ_I MF: \ !INIT TYPE: - /NORM,KNOWN, \ !NORMAL EQUATIONS, KNOWN PART, - NONLIN, \ !NON-LINEAR PART - PREC/ !PRECISION FACTOR - LSQ_I_SOL J/LSQ_I_NORM+LSQ_I_KNOWN/ !SOLUTION PART - LSQ_I_ALL J/LSQ_I_SOL+LSQ_I_NONLIN/ !CLEAR ALL - LSQ_C MF: \ !CONDITION EQUATION TYPE: - /REAL, \ !REAL COEFFICIENTS - COMPLEX, \ !COMPLEX COEFFICIENTS - CCOMPLEX, \ !2 (CONJUGATE) COMPLEX !COEFFICIENTS - DCOMPLEX, \ !2 SEPARATE COMPLEX COEFFICIENTS - NONORM, \ !DO NOT DO NORMAL EQUATIONS - NOKNOWN/ !DO NOT DO KNOWN PART - LSQ_U MF:(2*LSQ_T__H) \ !USAGE BITS - /INVERTED, \ !INVERTED MATRIX PRESENT - TRIANGLE, \ !TRIANGULARISED - NONLIN/ !NON-LINEAR SOLUTION - DPREC D/1.E-6/ !DEFAULT TEST PRECISION - NLFAC D/0.001/ !START NON-LINEAR FACTOR -! -.BEGIN=LSQ - SIZE J !TOTAL LENGTH ALLOCATED - BITS J !TYPE OF LSQ (E.G. COMPLEX) - DBL J !POINTER FOR DOUBLE PARTS - NUN J !# OF UNKNOWNS - M J !# OF KNOWNS - N J !SIZE OF MATRIX - R J !RANK OF NORMAL EQUATIONS - PIV J !A_J POINTER TO PIVOT TABLE (J(N)) - NORM J !A_D POINTER TO NORMAL EQUATIONS (D(N.(N+1)/2)) - KNOWN J !A_D POINTER TO KNOWN PART (D(N.M)) - ERROR J !A_D POINTER TO ERROR PART (D(4M)) - SOL J !A_D POINTER TO HIGH PRECISION SOLUTION (D(N)) - NAR J !SAVE AREA FOR NON-LINEAR - FACTOR D !PRECISION - NONLIN D !NON-LINEAR LEVENBERG FACTOR -.ALIGN=LB_D !ALIGN FOR WORKAREA -.END !END DEFINITION -! -.BEGIN=LERR - N D !NUMBER OF CONDITION EQUATIONS - W D !SUM WEIGHTS - LL D !SUM KNOWN TERMS SQUARED - CHI2 D !CHI SQUARED CALCULATED -.END -.PARAMETER - LERR__N J/LERR__L/LB_D/ !# OF ELEMENTS IN LERR -!- - diff --git a/src/wng/mca.dsc b/src/wng/mca.dsc deleted file mode 100644 index 975db32de71b5f9afaa8b5b4484c74780c90ecb2..0000000000000000000000000000000000000000 --- a/src/wng/mca.dsc +++ /dev/null @@ -1,57 +0,0 @@ -!+ MCA.DSC -! WNB 890724 -! -! Revisions: -! -%REVISION=WNB=930811="Add some names" -%REVISION=WNB=930803="Use WNTINC features" -%REVISION=WNB=890724="Original version" -! -! Define MCA (Magnetic tape Control Area) -! -%COMMENT="MCA.DSC defines the MCA (Magnetic tape Control Area)" -! -%VERSION=1 !VERSION -%SYSTEM=1 -%USER=WNB -%%DATE -%%NAME -! -%ALIGN !ALIGN STRUCTURES -!- -.PARAMETER - MCA_M M: \ !TAPE MASKS FOR: - /OUTPUT,UNLAB,BLKED,ALLOC, \ !OUTPUT, UNLABELED TAPE - ASSIGNED,MOUNTED/ !BLOCKED OPERATION - !ALLOCATED,ASSIGNED, - !MOUNTED BY PROGRAM - MCA_V A:(0) \ !TAPE MASK BITS FOR: - /OUTPUT,UNLAB,BLKED,ALLOC, \ !OUTPUT, UNLABELED TAPE - ASSIGNED,MOUNTED/ !BLOCKED OPERATION - !ALLOCATED,ASSIGNED, - !MOUNTED BY PROGRAM - MCA__IRG J /60/ !INTERREC. GAP IN .01 INCHES - MCA__TML J /150/ !TAPE MARK LENGTH IN .01 INCHES -! -.BEGIN=MCA - LINK J !LINK, MUST BE AT 0 - TID J !ID. 0=FCA, 1=MCA, MUST BE AT 4 - SIZE J !SIZE OF BLOCK - CHAN J !ASSIGNED CHANNEL - IOSB J(2) !IO STATUS BLOCK - BITS J !BITS - !THE ABOVE SHOULD BE SAME FOR FCA & MCA - DENS J !DENSITY (BPI) - UNDES J(2) !UNIT DESCRIPTOR -.ALIGN=LB_J !MAKE SURE - UNIT B(32) !UNIT NAME - FCA J !BELONGING FCA (OR 0) - MAGF J !FILE POSITION -.ALIGN=LB_J !MAKE SURE - VOL C80 !VOLUME LABEL -.ALIGN=LB_J !MAKE SURE - HD1 C80 !HDR1 LABEL -.ALIGN=LB_J !MAKE SURE - HD2 C80 !HDR2 LABEL -.END !END DEFINITION -!- diff --git a/src/wng/mca_e.def b/src/wng/mca_e.def deleted file mode 100644 index 823f86e4d7130db76d75127dc9472c471ef31b66..0000000000000000000000000000000000000000 --- a/src/wng/mca_e.def +++ /dev/null @@ -1,88 +0,0 @@ -C+ Created from mca.dsc on 000922 at 11:09:09 at duw01 -C MCA_E.DEF -C WNB 000922 -C -C Revisions: -C -C WNB 930811 Add some names -C WNB 930803 Use WNTINC features -C WNB 890724 Original version -C -C -C Result: -C -C MCA.DSC defines the MCA (Magnetic tape Control Area) -C -C -C Specification of edit tables: -C -C The character (_EC) table contains: -C fieldname, pattern, units, special code -C The integer (_EJ) table contains: -C offset, #of values, edit (0=allowed), unit length -C -C -C MCA edit definitions: -C - INTEGER MCAEDL,MCA__EL - PARAMETER ( MCAEDL=14, ! Length table - 1 MCA__EL=14) - CHARACTER*12 MCA_EC(4,14) - INTEGER MCA_EJ(4,14) - DATA MCA_EC(1,1),MCA_EC(2,1),MCA_EC(3,1),MCA_EC(4,1) - 1 /'LINK','SJ',' ',' '/ - DATA MCA_EJ(1,1),MCA_EJ(2,1),MCA_EJ(3,1),MCA_EJ(4,1) - 1 /0,1,0,4/ - DATA MCA_EC(1,2),MCA_EC(2,2),MCA_EC(3,2),MCA_EC(4,2) - 1 /'TID','SJ',' ',' '/ - DATA MCA_EJ(1,2),MCA_EJ(2,2),MCA_EJ(3,2),MCA_EJ(4,2) - 1 /4,1,0,4/ - DATA MCA_EC(1,3),MCA_EC(2,3),MCA_EC(3,3),MCA_EC(4,3) - 1 /'SIZE','SJ',' ',' '/ - DATA MCA_EJ(1,3),MCA_EJ(2,3),MCA_EJ(3,3),MCA_EJ(4,3) - 1 /8,1,0,4/ - DATA MCA_EC(1,4),MCA_EC(2,4),MCA_EC(3,4),MCA_EC(4,4) - 1 /'CHAN','SJ',' ',' '/ - DATA MCA_EJ(1,4),MCA_EJ(2,4),MCA_EJ(3,4),MCA_EJ(4,4) - 1 /12,1,0,4/ - DATA MCA_EC(1,5),MCA_EC(2,5),MCA_EC(3,5),MCA_EC(4,5) - 1 /'IOSB','SJ',' ',' '/ - DATA MCA_EJ(1,5),MCA_EJ(2,5),MCA_EJ(3,5),MCA_EJ(4,5) - 1 /16,2,0,4/ - DATA MCA_EC(1,6),MCA_EC(2,6),MCA_EC(3,6),MCA_EC(4,6) - 1 /'BITS','SJ',' ',' '/ - DATA MCA_EJ(1,6),MCA_EJ(2,6),MCA_EJ(3,6),MCA_EJ(4,6) - 1 /24,1,0,4/ - DATA MCA_EC(1,7),MCA_EC(2,7),MCA_EC(3,7),MCA_EC(4,7) - 1 /'DENS','SJ',' ',' '/ - DATA MCA_EJ(1,7),MCA_EJ(2,7),MCA_EJ(3,7),MCA_EJ(4,7) - 1 /28,1,0,4/ - DATA MCA_EC(1,8),MCA_EC(2,8),MCA_EC(3,8),MCA_EC(4,8) - 1 /'UNDES','SJ',' ',' '/ - DATA MCA_EJ(1,8),MCA_EJ(2,8),MCA_EJ(3,8),MCA_EJ(4,8) - 1 /32,2,0,4/ - DATA MCA_EC(1,9),MCA_EC(2,9),MCA_EC(3,9),MCA_EC(4,9) - 1 /'UNIT','UB',' ',' '/ - DATA MCA_EJ(1,9),MCA_EJ(2,9),MCA_EJ(3,9),MCA_EJ(4,9) - 1 /40,32,0,1/ - DATA MCA_EC(1,10),MCA_EC(2,10),MCA_EC(3,10),MCA_EC(4,10) - 1 /'FCA','SJ',' ',' '/ - DATA MCA_EJ(1,10),MCA_EJ(2,10),MCA_EJ(3,10),MCA_EJ(4,10) - 1 /72,1,0,4/ - DATA MCA_EC(1,11),MCA_EC(2,11),MCA_EC(3,11),MCA_EC(4,11) - 1 /'MAGF','SJ',' ',' '/ - DATA MCA_EJ(1,11),MCA_EJ(2,11),MCA_EJ(3,11),MCA_EJ(4,11) - 1 /76,1,0,4/ - DATA MCA_EC(1,12),MCA_EC(2,12),MCA_EC(3,12),MCA_EC(4,12) - 1 /'VOL','AL',' ',' '/ - DATA MCA_EJ(1,12),MCA_EJ(2,12),MCA_EJ(3,12),MCA_EJ(4,12) - 1 /80,1,0,80/ - DATA MCA_EC(1,13),MCA_EC(2,13),MCA_EC(3,13),MCA_EC(4,13) - 1 /'HD1','AL',' ',' '/ - DATA MCA_EJ(1,13),MCA_EJ(2,13),MCA_EJ(3,13),MCA_EJ(4,13) - 1 /160,1,0,80/ - DATA MCA_EC(1,14),MCA_EC(2,14),MCA_EC(3,14),MCA_EC(4,14) - 1 /'HD2','AL',' ',' '/ - DATA MCA_EJ(1,14),MCA_EJ(2,14),MCA_EJ(3,14),MCA_EJ(4,14) - 1 /240,1,0,80/ -C- diff --git a/src/wng/mca_e.inc b/src/wng/mca_e.inc deleted file mode 100644 index f116438e27dc12f374abb47638d7958496005045..0000000000000000000000000000000000000000 --- a/src/wng/mca_e.inc +++ /dev/null @@ -1,59 +0,0 @@ -/*+ Created from mca.dsc on 000922 at 11:09:09 at duw01 -.. MCA_E.INC -.. WNB 000922 -.. -.. Revisions: -.. -.. WNB 930811 Add some names -.. WNB 930803 Use WNTINC features -.. WNB 890724 Original version -.. */ -/* -.. Result: -.. -.. MCA.DSC defines the MCA (Magnetic tape Control Area) -.. */ -/* -.. Specification of edit tables: -.. -.. The character (_EC) table contains: -.. fieldname, pattern, units, special code -.. The integer (_EJ) table contains: -.. offset, #of values, edit (0=allowed), unit length -.. */ -/* -.. MCA edit definitions: -.. */ -#define MCAEDL 14 /* Length table */ -#define MCA__EL 14 /* Length table */ - static char mca_ec [14][4][12] = { - "LINK","SJ"," "," ", - "TID","SJ"," "," ", - "SIZE","SJ"," "," ", - "CHAN","SJ"," "," ", - "IOSB","SJ"," "," ", - "BITS","SJ"," "," ", - "DENS","SJ"," "," ", - "UNDES","SJ"," "," ", - "UNIT","UB"," "," ", - "FCA","SJ"," "," ", - "MAGF","SJ"," "," ", - "VOL","AL"," "," ", - "HD1","AL"," "," ", - "HD2","AL"," "," "}; - static int mca_ej [14][4] = { - 0,1,0,4, - 4,1,0,4, - 8,1,0,4, - 12,1,0,4, - 16,2,0,4, - 24,1,0,4, - 28,1,0,4, - 32,2,0,4, - 40,32,0,1, - 72,1,0,4, - 76,1,0,4, - 80,1,0,80, - 160,1,0,80, - 240,1,0,80}; -/*- */ diff --git a/src/wng/mca_o.def b/src/wng/mca_o.def deleted file mode 100644 index 71fc3050d79909f74de2d3959dc177dd794765ee..0000000000000000000000000000000000000000 --- a/src/wng/mca_o.def +++ /dev/null @@ -1,119 +0,0 @@ -C+ Created from mca.dsc on 000922 at 11:09:09 at duw01 -C MCA_O.DEF -C WNB 000922 -C -C Revisions: -C -C WNB 930811 Add some names -C WNB 930803 Use WNTINC features -C WNB 890724 Original version -C -C -C Given statements: -C -C -C Result: -C -C MCA.DSC defines the MCA (Magnetic tape Control Area) -C -C -C Parameters: -C - INTEGER MCA_M_OUT ! TAPE MASKS FOR: - ! OUTPUT, UNLABELED TAPE - ! BLOCKED OPERATION - ! ALLOCATED,ASSIGNED, - ! MOUNTED BY PROGRAM - PARAMETER (MCA_M_OUT=1) - INTEGER MCA_M_UNL - PARAMETER (MCA_M_UNL=2) - INTEGER MCA_M_BLK - PARAMETER (MCA_M_BLK=4) - INTEGER MCA_M_ALL - PARAMETER (MCA_M_ALL=8) - INTEGER MCA_M_ASS - PARAMETER (MCA_M_ASS=16) - INTEGER MCA_M_MOU - PARAMETER (MCA_M_MOU=32) - INTEGER MCA_M__N - PARAMETER (MCA_M__N=7) - INTEGER MCA_M__L - PARAMETER (MCA_M__L=1) - INTEGER MCA_M__H - PARAMETER (MCA_M__H=32) - INTEGER MCA_M__I - PARAMETER (MCA_M__I=2) - INTEGER MCA_V_OUT ! TAPE MASK BITS FOR: - ! OUTPUT, UNLABELED TAPE - ! BLOCKED OPERATION - ! ALLOCATED,ASSIGNED, - ! MOUNTED BY PROGRAM - PARAMETER (MCA_V_OUT=0) - INTEGER MCA_V_UNL - PARAMETER (MCA_V_UNL=1) - INTEGER MCA_V_BLK - PARAMETER (MCA_V_BLK=2) - INTEGER MCA_V_ALL - PARAMETER (MCA_V_ALL=3) - INTEGER MCA_V_ASS - PARAMETER (MCA_V_ASS=4) - INTEGER MCA_V_MOU - PARAMETER (MCA_V_MOU=5) - INTEGER MCA_V__N - PARAMETER (MCA_V__N=7) - INTEGER MCA_V__L - PARAMETER (MCA_V__L=0) - INTEGER MCA_V__H - PARAMETER (MCA_V__H=5) - INTEGER MCA_V__I - PARAMETER (MCA_V__I=1) - INTEGER MCA__IRG ! INTERREC. GAP IN .01 INCHES - PARAMETER (MCA__IRG=60) - INTEGER MCA__TML ! TAPE MARK LENGTH IN .01 INCHES - PARAMETER (MCA__TML=150) -C -C MCA structure definitions: -C - INTEGER MCAHDL,MCAHDV,MCAHDS - PARAMETER ( MCAHDL=320, ! Length - 1 MCAHDV=1, ! Version - 1 MCAHDS=1) ! System - INTEGER MCA__L,MCA__V,MCA__S - PARAMETER ( MCA__L=320, ! Length - 1 MCA__V=1, ! Version - 1 MCA__S=1) ! System -C -C MCA Offsets: -C - INTEGER MCA_LINK_1,MCA_LINK_J ! LINK, MUST BE AT 0 - PARAMETER (MCA_LINK_1=0,MCA_LINK_J=0) - INTEGER MCA_TID_1,MCA_TID_J ! ID. 0=FCA, 1=MCA, MUST BE AT 4 - PARAMETER (MCA_TID_1=4,MCA_TID_J=1) - INTEGER MCA_SIZE_1,MCA_SIZE_J ! SIZE OF BLOCK - PARAMETER (MCA_SIZE_1=8,MCA_SIZE_J=2) - INTEGER MCA_CHAN_1,MCA_CHAN_J ! ASSIGNED CHANNEL - PARAMETER (MCA_CHAN_1=12,MCA_CHAN_J=3) - INTEGER MCA_IOSB_1,MCA_IOSB_J ! IO STATUS BLOCK - PARAMETER (MCA_IOSB_1=16,MCA_IOSB_J=4) - INTEGER MCA_BITS_1,MCA_BITS_J ! BITS - PARAMETER (MCA_BITS_1=24,MCA_BITS_J=6) ! THE ABOVE SHOULD BE SAME FOR FCA & MCA - INTEGER MCA_DENS_1,MCA_DENS_J ! DENSITY (BPI) - PARAMETER (MCA_DENS_1=28,MCA_DENS_J=7) - INTEGER MCA_UNDES_1,MCA_UNDES_J ! UNIT DESCRIPTOR - PARAMETER (MCA_UNDES_1=32,MCA_UNDES_J=8) - INTEGER MCA_UNIT_1,MCA_UNIT_B ! UNIT NAME - PARAMETER (MCA_UNIT_1=40,MCA_UNIT_B=40) - INTEGER MCA_FCA_1,MCA_FCA_J ! BELONGING FCA (OR 0) - PARAMETER (MCA_FCA_1=72,MCA_FCA_J=18) - INTEGER MCA_MAGF_1,MCA_MAGF_J ! FILE POSITION - PARAMETER (MCA_MAGF_1=76,MCA_MAGF_J=19) - INTEGER MCA_VOL_1,MCA_VOL_C,MCA_VOL_N ! VOLUME LABEL - PARAMETER (MCA_VOL_1=80,MCA_VOL_C=80,MCA_VOL_N=80) - INTEGER MCA_HD1_1,MCA_HD1_C,MCA_HD1_N ! HDR1 LABEL - PARAMETER (MCA_HD1_1=160,MCA_HD1_C=160,MCA_HD1_N=80) - INTEGER MCA_HD2_1,MCA_HD2_C,MCA_HD2_N ! HDR2 LABEL - PARAMETER (MCA_HD2_1=240,MCA_HD2_C=240,MCA_HD2_N=80) -C -C Given statements: -C -C- diff --git a/src/wng/mca_o.inc b/src/wng/mca_o.inc deleted file mode 100644 index a62bc116ea102ba234df279f288cfa6957c777c2..0000000000000000000000000000000000000000 --- a/src/wng/mca_o.inc +++ /dev/null @@ -1,84 +0,0 @@ -/*+ Created from mca.dsc on 000922 at 11:09:09 at duw01 -.. MCA_O.INC -.. WNB 000922 -.. -.. Revisions: -.. -.. WNB 930811 Add some names -.. WNB 930803 Use WNTINC features -.. WNB 890724 Original version -.. */ -/* -.. Given statements: -.. */ -/* -.. Result: -.. -.. MCA.DSC defines the MCA (Magnetic tape Control Area) -.. */ -/* -.. Parameters: -.. */ -#define MCA_M_OUT 1 /* TAPE MASKS FOR: */ - /* OUTPUT, UNLABELED TAPE */ - /* BLOCKED OPERATION */ - /* ALLOCATED,ASSIGNED, */ - /* MOUNTED BY PROGRAM */ -#define MCA_M_UNL 2 -#define MCA_M_BLK 4 -#define MCA_M_ALL 8 -#define MCA_M_ASS 16 -#define MCA_M_MOU 32 -#define MCA_M__N 7 -#define MCA_M__L 1 -#define MCA_M__H 32 -#define MCA_M__I 2 -#define MCA_V_OUT 0 /* TAPE MASK BITS FOR: */ - /* OUTPUT, UNLABELED TAPE */ - /* BLOCKED OPERATION */ - /* ALLOCATED,ASSIGNED, */ - /* MOUNTED BY PROGRAM */ -#define MCA_V_UNL 1 -#define MCA_V_BLK 2 -#define MCA_V_ALL 3 -#define MCA_V_ASS 4 -#define MCA_V_MOU 5 -#define MCA_V__N 7 -#define MCA_V__L 0 -#define MCA_V__H 5 -#define MCA_V__I 1 -#define MCA__IRG 60 /* INTERREC. GAP IN .01 INCHES */ -#define MCA__TML 150 /* TAPE MARK LENGTH IN .01 INCHES */ -/* -.. MCA structure definitions: -.. */ -#define MCAHDL 320 /* Length */ -#define MCAHDV 1 /* Version */ -#define MCAHDS 1 /* System */ -#define MCA__L 320 /* Length */ -#define MCA__V 1 /* Version */ -#define MCA__S 1 /* System */ -/* -.. MCA Offsets: -.. */ -struct mca { - int link; /* LINK, MUST BE AT 0 */ - int tid; /* ID. 0=FCA, 1=MCA, MUST BE AT 4 */ - int size; /* SIZE OF BLOCK */ - int chan; /* ASSIGNED CHANNEL */ - int iosb[2]; /* IO STATUS BLOCK */ - int bits; /* BITS */ - /* THE ABOVE SHOULD BE SAME FOR FCA & MCA */ - int dens; /* DENSITY (BPI) */ - int undes[2]; /* UNIT DESCRIPTOR */ - char unit[32]; /* UNIT NAME */ - int fca; /* BELONGING FCA (OR 0) */ - int magf; /* FILE POSITION */ - char vol[80]; /* VOLUME LABEL */ - char hd1[80]; /* HDR1 LABEL */ - char hd2[80]; /* HDR2 LABEL */ -}; /* END DEFINITION */ -/* -.. Given statements: -.. */ -/*- */ diff --git a/src/wng/mca_t.def b/src/wng/mca_t.def deleted file mode 100644 index 711c6e848091047c78c3984969d74b733e8fbdb2..0000000000000000000000000000000000000000 --- a/src/wng/mca_t.def +++ /dev/null @@ -1,39 +0,0 @@ -C+ Created from mca.dsc on 000922 at 11:09:09 at duw01 -C MCA_T.DEF -C WNB 000922 -C -C Revisions: -C -C WNB 930811 Add some names -C WNB 930803 Use WNTINC features -C WNB 890724 Original version -C -C -C Result: -C -C MCA.DSC defines the MCA (Magnetic tape Control Area) -C -C -C Specification of translation tables: -C -C 0= end of table 1= character -C 2= 16 bits integer 3= 32 bits integer -C 4= 32 bits real 5= 64 bits real -C 6= repeat 7= end repeat -C 8= undefined 9= byte -C 10= external repeat 11= start union -C 12= start map 13= end union -C 14= 64 bits complex 15= 128 bits complex -C -C -C MCA translation definitions: -C - INTEGER*2 MCA_T(2,5) - EQUIVALENCE (MCA_T,MCA__T(1,1)) - DATA MCA_T(1,1),MCA_T(2,1) /3,10/ - DATA MCA_T(1,2),MCA_T(2,2) /9,32/ - DATA MCA_T(1,3),MCA_T(2,3) /3,2/ - DATA MCA_T(1,4),MCA_T(2,4) /1,240/ - DATA MCA_T(1,5),MCA_T(2,5) /0,1/ - INTEGER*2 MCA__T(2,5) -C- diff --git a/src/wng/mca_t.inc b/src/wng/mca_t.inc deleted file mode 100644 index df09a3f542b78f00b1b2fa290d56f023a3c4cdf6..0000000000000000000000000000000000000000 --- a/src/wng/mca_t.inc +++ /dev/null @@ -1,39 +0,0 @@ -/*+ Created from mca.dsc on 000922 at 11:09:09 at duw01 -.. MCA_T.INC -.. WNB 000922 -.. -.. Revisions: -.. -.. WNB 930811 Add some names -.. WNB 930803 Use WNTINC features -.. WNB 890724 Original version -.. */ -/* -.. Result: -.. -.. MCA.DSC defines the MCA (Magnetic tape Control Area) -.. */ -/* -.. Specification of translation tables: -.. -.. 0= end of table 1= character -.. 2= 16 bits integer 3= 32 bits integer -.. 4= 32 bits real 5= 64 bits real -.. 6= repeat 7= end repeat -.. 8= undefined 9= byte -.. 10= external repeat 11= start union -.. 12= start map 13= end union -.. 14= 64 bits complex 15= 128 bits complex -.. */ - static struct { -/* -.. MCA translation definitions: -.. */ - short mca_t [5][2] ; - } mca__t = { - 3, 10, - 9, 32, - 3, 2, - 1, 240, - 0, 1 }; -/*- */ diff --git a/src/wng/nbuild.com b/src/wng/nbuild.com deleted file mode 100755 index 98fe21cba304b883ed707426deb1deef99ea944f..0000000000000000000000000000000000000000 --- a/src/wng/nbuild.com +++ /dev/null @@ -1,395 +0,0 @@ -$!# nbuild.ssc -$!# WNB 921117 -$!# -$!# Revisions: -$!# WNB 921210 Change compilation of .def etc; delete c?? -$!# WNB 921222 Add SSC and nonomatch for HP -$!# WNB 921224 Make SSC -$!# WNB 930303 NSTAR_DIR added -$!# WNB 930305 Make sure of aliases -$!# WNB 930514 Correct aliases -$!# WNB 930803 Add .dsf -$!# WNB 940124 Leave _TLB -$!# -$!# Build Newstar from standard export tar tape -$!# -$!# Uses environment variables: -$!# WNG where to find wng-type sources -$!# WNG_TYPE machine (sw, dw, hp, al, cv etc) -$!# WNG_OLBEXE root of wng-type .olb, .ppd, .exe -$!# WNG_SITE site (nfra, atnf, rug ...) -$!# EXEDWARF_UNIX where to find/set DWARF .exe, .ppd -$!# LIBDWARF where to find DWARF .olb -$!# NSTAR_DIR N directories -$!# and also possible: -$!# WNG_EXE, WNG_OLB, WNG_TLB, WNG_ERR, WNG_LIS, WNG_LINK -$!# -$!# Intro -$!# -$ SET NOON !DISCARD ERRORS -$ ON CONTROL_Y THEN GOTO EXEX !FINISH NEATLY -$ VER=F$VERIFY() !FOR ^Y -$ PID=F$EXTRACT(4,4,F$GETJPI("","PID")) !FOR TMP FILES -$ DEP=1 !FOR INDIRECT -$ LDAT=F$EXTRAC(2,2,F$CVTIM(,,"YEAR"))+F$CVTIM(,,"MONTH")+ - - F$CVTIM(,,"DAY") !VERSION -$ TELL="WRITE SYS$OUTPUT" !FOR EASE OF USE -$ TLOG="WRITE LOG''PID'''DEP'" -$ ! -$ ASSIGN="ASSIGN" !MAKE SURE PROPER USE -$ BACKUP="BACKUP" -$ COPY="COPY" -$ DELETE="DELETE" -$ DIR="DIRECTORY" -$ PURGE="PURGE" -$ SET="SET" -$ SHOW="SHOW" -$ TELL " " -$ TELL "Building Newstar." -$ TELL " " -$ TELL "A log will be made in WNG_DIR:[WNG.-]NB''PID'''DEP'.LOG" -$ TELL "There should be about 100 Mbytes available," -$ TELL "and it will probably take a few hours." -$ TELL " " -$!# -$!# Check environment -$!# -$ IF F$TRNLNM("WNG") .EQS. "" .OR. F$TRNLNM("WNG_OLBEXE") .EQS. "" - - .OR. F$TRNLNM("WNG_DIR") .EQS. "" - - .OR. "''WNG_TYPE'" .EQS. "" .OR. "''WNG_SITE'" .EQS. "" - - .OR. "''NSTAR_DIR'" .EQS. "" - -$ THEN -$ TELL " Error: Must have logicals WNG, WNG_OLBEXE, WNG_DIR and globals" -$ TELL " WNG_TYPE, WNG_SITE, NSTAR_DIR defined" -$ TELL " You probably have not included the proper" -$ TELL " files in LOGIN.COM" -$ GOTO EXEX -$ ENDIF -$ IF F$TRNLNM("EXEDWARF") .EQS. "" .OR. - - F$TRNLNM("LIBDWARF") .EQS. "" .OR. - - F$TRNLNM("RUNDWARF") .EQS. "" -$ THEN -$ TELL " Error: Cannot do everything with EXEDWARF and/or" -$ TELL " LIBDWARF and/or RUNDWARF not defined" -$ TELL " You probably have not included the proper" -$ TELL " files in LOGIN.COM" -$ GOTO EXEX -$ ENDIF -$ IF "''NXEC'" .EQS. "" -$ THEN -$ TELL " Error: You have no symbol for NXEC etc." -$ TELL " You probably have not included the proper" -$ TELL " files in LOGIN.COM" -$ GOTO EXEX -$ ENDIF -$ IF "''WNG_EXE'" .EQS. "" THEN - - WNG_EXE=F$TRNLNM("WNG_OLBEXE") -$ IF "''WNG_OLB'" .EQS. "" THEN - - WNG_OLB=F$TRNLNM("WNG_OLBEXE") -$ WNG_TLB="" ! MAKE SURE -$ WNG_ERR="" -$ WNG_LIS="" -$ WNG_LINK="" -$ BLDDIR="''NSTAR_DIR'" ! Newstar directories -$ L0=0 ! MAKE DIRECTORIES -$ LP1: L1=F$ELEMENT(L0,",",BLDDIR) -$ IF L1 .NES. "," -$ THEN -$ IF F$PARSE("''WNG_EXE':[''L1']") .EQS. "" THEN - ! MAKE DIRECTORIES - CREATE/DIR 'WNG_EXE'['L1'] -$ IF F$PARSE("''WNG_OLB':[''L1']") .EQS. "" THEN - - CREATE/DIR 'WNG_OLB':['L1'] -$ L0=L0+1 -$ GOTO LP1 -$ ENDIF -$!# -$!# Get questions -$!# -$ OPEN/WRITE/ERROR=EXEX LOG'PID''DEP' WNG_DIR:[WNG.-]NB'PID''DEP'.LOG ! START LOG -$ TLOG "NU''PID'''DEP'.LOG" -$ TELL "Running NBUILD.COM at ''WNG_SITE'(''WNG_TYPE')" -$ TLOG "Running NBUILD.COM at ''WNG_SITE'(''WNG_TYPE')" -$ TELL "on ''F$GETSYI("NODENAME")' at ''F$TIME()'" -$ TLOG "on ''F$GETSYI("NODENAME")' at ''F$TIME()'" -$ TELL " " -$ TLOG " " -$ DOGDEF="Y" -$ IF F$SEARCH("WNG_DIR:[WNG]WNG.DEF") .NES. "" -$ THEN -$ READ/TIME=90/END=EXEX/ERROR=EXEX - - /PROMPT=".def files seem to exist. Get them anyway? (Y|N) [Y]: " - - SYS$COMMAND L0 -$ TLOG ".def files seem to exist. Get them anyway? (Y|N) [Y]: ''L0'" -$ IF "''L0'" .EQS. "n" .OR. "''L0'" .EQS. "N" THEN DOGDEF="N" -$ ENDIF -$ DOMDEF="Y" -$ IF F$TRNLNM("WNG_DEF") .NES. "" .AND. .NOT. DOGDEF -$ THEN -$ READ/TIME=90/END=EXEX/ERROR=EXEX - - /PROMPT=".def files seem compiled. Compile them anyway? (Y|N) [Y]: " - - SYS$COMMAND L0 -$ TLOG ".def files seem compiled. Compile them anyway? (Y|N) [Y]: ''L0'" -$ IF "''L0'" .EQS. "n" .OR. "''L0'" .EQS. "N" THEN DOMDEF="N" -$ ENDIF -$ DOGGRP="Y" -$ IF F$SEARCH("WNG_DIR:[WNG]WNG.GRP") .NES. "" -$ THEN -$ READ/TIME=90/END=EXEX/ERROR=EXEX - - /PROMPT=".grp files seem to exist. Get them anyway? (Y|N) [Y]: " - - SYS$COMMAND L0 -$ TLOG ".grp files seem to exist. Get them anyway? (Y|N) [Y]: ''L0'" -$ IF "''L0'" .EQS. "n" .OR. "''L0'" .EQS. "N" THEN DOGGRP="N" -$ ENDIF -$ DOCOMP="N" -$ IF F$SEARCH("WNG_OLBEXE:[WNG]WNLIB.OLB") .NES. "" -$ THEN -$ READ/TIME=90/END=EXEX/ERROR=EXEX - - /PROMPT="Some compilation at least done. Compile all? (Y|N) [N]: " - - SYS$COMMAND L0 -$ TLOG "Some compilation at least done. Compile all? (Y|N) [N]: ''L0'" -$ IF "''L0'" .EQS. "y" .OR. "''L0'" .EQS. "Y" THEN DOCOMP="Y" -$ ELSE -$ DOCOMP="Y" -$ ENDIF -$ DOLINK="Y" -$ READ/TIME=90/END=EXEX/ERROR=EXEX - - /PROMPT="Link all programs? (Y|N) [Y]: " - - SYS$COMMAND L0 -$ TLOG "Link all programs? (Y|N) [Y]: ''L0'" -$ IF "''L0'" .EQS. "n" .OR. "''L0'" .EQS. "N" THEN DOLINK="N" -$ TELL "You could clean up all unwanted files." -$ TELL "(0)For operation the following files should remain:" -$ TELL " EXEDWARF:*.exe and *.ppd; RUNDWARF:*.exe; WNG_DIR:[*]*.COM" -$ TELL "(1)For easy updating the following files should also remain:" -$ TELL " WNG_OLBEXE:[*]*.olb WNG_DIR:[*]*.tlb and *.def and *.inc" -$ TELL " and *.grp;" -$ TELL "(2)To check programs all source files could remain" -$ TELL "(3)To check all listing files can remain" -$ TELL "I can remove for you including and above a specified level:" -$ TELL "(probably better to run with 4 first time, and rerun" -$ TELL " nbuild later with all questions n and the proper level)" -$ READ/TIME=90/END=EXEX/ERROR=EXEX - - /PROMPT="Clean disk level (1|2|3|4) [3]: " - - SYS$COMMAND L0 -$ IF L0 .LT. 1 .OR. L0 .GT.4 THEN L0=3 -$ TLOG "Clean disk level (1|2|3|4) [3]: ''L0'" -$ DOCLUP=L0 -$!# -$!# Get and make .def .sun -$!# -$ GDEF: -$ SET DEF WNG_DIR:[WNG.-] ! BASE DIRECTORY -$ IF DOGDEF -$ THEN -$ TELL "Getting .def ..." -$ TLOG "Getting .def ..." -$ ASSIGN/NOLOG LOG'PID''DEP' SYS$OUTPUT -$ ASSIGN/NOLOG LOG'PID''DEP' SYS$ERROR -$ L0=0 ! MAKE DIRECTORIES -$ LP2: L1=F$ELEMENT(L0,",",BLDDIR) -$ IF L1 .NES. "," -$ THEN -$ SET DEF WNG_DIR:['L1'] -$ NGET -A *.DEF *.INC *.PEF,*.DSF,*.SSC,*.COM ! GET .DEF -$ L0=L0+1 -$ GOTO LP2 -$ ENDIF -$ DEASSIGN SYS$OUTPUT -$ DEASSIGN SYS$ERROR -$ ENDIF -$ MDEF: -$ SET DEF WNG_DIR:[WNG.-] ! BASE DIRECTORY -$ IF DOMDEF -$ THEN -$ TELL "Compiling .def ..." -$ TLOG "Compiling .def ..." -$ ASSIGN/NOLOG LOG'PID''DEP' SYS$OUTPUT -$ ASSIGN/NOLOG LOG'PID''DEP' SYS$ERROR -$ L0=0 ! MAKE DIRECTORIES -$ LP3: L1=F$ELEMENT(L0,",",BLDDIR) -$ IF L1 .NES. "," -$ THEN -$ SET DEF WNG_DIR:['L1'] -$ NCOMP -U *.DEF *.INC *.PEF,*.DSF,*.SSC,*.COM ! COMPILE .DEF -$ L0=L0+1 -$ GOTO LP3 -$ ENDIF -$ DEASSIGN SYS$OUTPUT -$ DEASSIGN SYS$ERROR -$ ENDIF -$!# -$!# Get groups -$!# -$ GGRP: -$ SET DEF WNG_DIR:[WNG.-] ! BASE DIRECTORY -$ IF DOGGRP -$ THEN -$ TELL "Getting .grp ..." -$ TLOG "Getting .grp ..." -$ ASSIGN/NOLOG LOG'PID''DEP' SYS$OUTPUT -$ ASSIGN/NOLOG LOG'PID''DEP' SYS$ERROR -$ L0=0 ! MAKE DIRECTORIES -$ LP4: L1=F$ELEMENT(L0,",",BLDDIR) -$ IF L1 .NES. "," -$ THEN -$ SET DEF WNG_DIR:['L1'] -$ NGET -NZA *.GRP ! GET .GRP -$ L0=L0+1 -$ GOTO LP4 -$ ENDIF -$ DEASSIGN SYS$OUTPUT -$ DEASSIGN SYS$ERROR -$ ENDIF -$!# -$!# Compile all -$!# -$ COMP: -$ SET DEF WNG_DIR:[WNG.-] ! BASE DIRECTORY -$ IF DOCOMP -$ THEN -$ TELL "Compiling Newstar system ..." -$ TLOG "Compiling Newstar system ..." -$ ASSIGN/NOLOG LOG'PID''DEP' SYS$OUTPUT -$ ASSIGN/NOLOG LOG'PID''DEP' SYS$ERROR -$ L0=0 ! MAKE DIRECTORIES -$ LP5: L1=F$ELEMENT(L0,",",BLDDIR) -$ IF L1 .NES. "," -$ THEN -$ SET DEF WNG_DIR:['L1'] -$ NCOMP *.GRP ! COMPILE -$ L0=L0+1 -$ GOTO LP5 -$ ENDIF -$ DEASSIGN SYS$OUTPUT -$ DEASSIGN SYS$ERROR -$ ENDIF -$!# -$!# Link all -$!# -$ LINK: -$ SET DEF WNG_DIR:[WNG.-] ! BASE DIRECTORY -$ IF DOLINK -$ THEN -$ TELL "Linking Newstar system ..." -$ TLOG "Linking Newstar system ..." -$ ASSIGN/NOLOG LOG'PID''DEP' SYS$OUTPUT -$ ASSIGN/NOLOG LOG'PID''DEP' SYS$ERROR -$ L0=0 ! MAKE DIRECTORIES -$ LP6: L1=F$ELEMENT(L0,",",BLDDIR) -$ IF L1 .NES. "," -$ THEN -$ SET DEF WNG_DIR:['L1'] -$ NLINK -U *.GRP ! LINK -$ NCOMP -U *.PIN -$ NCOMP -U *.DSC -$ NCOMP -U *.SSC -$ L0=L0+1 -$ GOTO LP6 -$ ENDIF -$ DEASSIGN SYS$OUTPUT -$ DEASSIGN SYS$ERROR -$ ENDIF -$!# -$!# Cleanup -$!# -$ CLUP: -$ SET DEF WNG_DIR:[WNG.-] ! BASE DIRECTORY -$ IF DOCLUP .LT. 4 -$ THEN -$ TELL "Deleting listing files ..." -$ TLOG "Deleting listing files ..." -$ ASSIGN/NOLOG LOG'PID''DEP' SYS$OUTPUT -$ ASSIGN/NOLOG LOG'PID''DEP' SYS$ERROR -$ L0=0 ! MAKE DIRECTORIES -$ LP7: L1=F$ELEMENT(L0,",",BLDDIR) -$ IF L1 .NES. "," -$ THEN -$ SET DEF WNG_DIR:['L1'] -$ IF F$SEARCH("*.LIS") .NES. "" THEN DELETE *.LIS;* -$ IF F$SEARCH("*.ERR") .NES. "" THEN DELETE *.ERR;* -$ IF F$SEARCH("*.OLD") .NES. "" THEN DELETE *.OLD;* -$ IF F$SEARCH("*.NEW") .NES. "" THEN DELETE *.NEW;* -$ IF F$SEARCH("*.LOG") .NES. "" THEN DELETE *.LOG;* -$ IF F$SEARCH("*.TMP") .NES. "" THEN DELETE *.TMP;* -$ IF F$SEARCH("*.OBJ") .NES. "" THEN DELETE *.OBJ;* -$ IF F$SEARCH("*.JOU") .NES. "" THEN DELETE *.JOU;* -$ IF F$SEARCH("''WNG_EXE':[''L1']*.MAP") .NES. "" THEN - - DELETE WNG_EXE:['L1']*.MAP;* -$ L0=L0+1 -$ GOTO LP7 -$ ENDIF -$ DEASSIGN SYS$OUTPUT -$ DEASSIGN SYS$ERROR -$ ENDIF -$ IF DOCLUP .LT. 3 -$ THEN -$ TELL "Deleting source files ..." -$ TLOG "Deleting source files ..." -$ ASSIGN/NOLOG LOG'PID''DEP' SYS$OUTPUT -$ ASSIGN/NOLOG LOG'PID''DEP' SYS$ERROR -$ L0=0 ! MAKE DIRECTORIES -$ LP8: L1=F$ELEMENT(L0,",",BLDDIR) -$ IF L1 .NES. "," -$ THEN -$ SET DEF WNG_DIR:['L1'] -$ IF F$SEARCH("*.F%%") .NES. "" THEN DELETE *.F%%;* -$ IF F$SEARCH("*.C%%") .NES. "" THEN DELETE/EXCLUDE=(*.COM) *.C%%;* -$ IF F$SEARCH("*.M%%") .NES. "" THEN DELETE *.M%%;* -$ IF F$SEARCH("*.PIN") .NES. "" THEN DELETE *.PIN;* -$ L0=L0+1 -$ GOTO LP8 -$ ENDIF -$ DEASSIGN SYS$OUTPUT -$ DEASSIGN SYS$ERROR -$ ENDIF -$ IF DOCLUP .LT. 3 -$ THEN -$ TELL "Deleting object/include files ..." -$ TLOG "Deleting object/include files ..." -$ ASSIGN/NOLOG LOG'PID''DEP' SYS$OUTPUT -$ ASSIGN/NOLOG LOG'PID''DEP' SYS$ERROR -$ L0=0 ! MAKE DIRECTORIES -$ LP9: L1=F$ELEMENT(L0,",",BLDDIR) -$ IF L1 .NES. "," -$ THEN -$ SET DEF WNG_DIR:['L1'] -$ IF F$SEARCH("*.DEF") .NES. "" THEN DELETE *.DEF;* -$ IF F$SEARCH("*.INC") .NES. "" THEN DELETE *.INC;* -$ IF F$SEARCH("*.DSC") .NES. "" THEN DELETE *.DSC;* -$ IF F$SEARCH("*.SSC") .NES. "" THEN DELETE *.SSC;* -$ IF F$SEARCH("''WNG_OLB':[''L1']*.OLB") .NES. "" THEN - - DELETE WNG_OLB:['L1']*.OLB;* -$ L0=L0+1 -$ GOTO LP9 -$ ENDIF -$ DEASSIGN SYS$OUTPUT -$ DEASSIGN SYS$ERROR -$ ENDIF -$!# -$!# Ready -$!# -$ END: -$ TELL " " -$ TLOG " " -$ TELL "Newstar built. Try if everything works by typing:" -$ TELL " indwarf (unless in LOGIN.COM)" -$ TELL " dws ngen/nomenu" -$ TELL " log=y" -$ TELL " (empty line)" -$ TELL "and:" -$ TELL " pvax WNG_DIR:[WNG.-]NB''PID'''DEP'.LOG" -$ TELL "If problem exist, rerun @WNG:NBUILD with all questions y" -$ TELL "To make a minimum backup to be able to rebuild the system," -$ TELL "run @WNG:NTARZ" -$ TELL "Good luck" -$ TELL " " -$ TLOG " " -$!# -$!# EXIT -$!# -$ EXEX: SET ON -$ CLOSE/ERROR=EXX1 LOG'PID''DEP !MAKE SURE -$ EXX1: -$ SET DEF WNG_DIR:[WNG.-] !BACK TO NORMAL -$ L0=F$VERIFY(VER) !RESET VERIFY -$ EXIT diff --git a/src/wng/nbuild.ssc b/src/wng/nbuild.ssc deleted file mode 100644 index b2437bb4452422a6472101165de7d392ce6417ec..0000000000000000000000000000000000000000 --- a/src/wng/nbuild.ssc +++ /dev/null @@ -1,674 +0,0 @@ -# nbuild.ssc -# WNB 921117 -# -# Revisions: -# WNB 921210 Change compilation of .def etc; delete c?? -# WNB 921222 Add SSC and nonomatch for HP -# WNB 921224 Make SSC -# WNB 930303 NSTAR_DIR added -# WNB 930305 Make sure of aliases -# WNB 930514 Correct aliases -# WNB 930803 Add .dsf -# WNB 940124 Leave _TLB -# -# Build Newstar from standard export tar tape -# -# Uses environment variables: -# WNG where to find wng-type sources -# WNG_TYPE machine (sw, dw, hp, al, cv etc) -# WNG_OLBEXE root of wng-type .olb, .ppd, .exe -# WNG_SITE site (nfra, atnf, rug ...) -# EXEDWARF_UNIX where to find/set DWARF .exe, .ppd -# LIBDWARF where to find DWARF .olb -# NSTAR_DIR N directories -# and also possible: -# WNG_EXE, WNG_OLB, WNG_TLB, WNG_ERR, WNG_LIS, WNG_LINK -# -# Intro -# -#ifdef wn_vax__ -$ SET NOON !DISCARD ERRORS -$ ON CONTROL_Y THEN GOTO EXEX !FINISH NEATLY -$ VER=F$VERIFY() !FOR ^Y -$ PID=F$EXTRACT(4,4,F$GETJPI("","PID")) !FOR TMP FILES -$ DEP=1 !FOR INDIRECT -$ LDAT=F$EXTRAC(2,2,F$CVTIM(,,"YEAR"))+F$CVTIM(,,"MONTH")+ - - F$CVTIM(,,"DAY") !VERSION -$ TELL="WRITE SYS$OUTPUT" !FOR EASE OF USE -$ TLOG="WRITE LOG''PID'''DEP'" -$ ! -$ ASSIGN="ASSIGN" !MAKE SURE PROPER USE -$ BACKUP="BACKUP" -$ COPY="COPY" -$ DELETE="DELETE" -$ DIR="DIRECTORY" -$ PURGE="PURGE" -$ SET="SET" -$ SHOW="SHOW" -$ TELL " " -$ TELL "Building Newstar." -$ TELL " " -$ TELL "A log will be made in WNG_DIR:[WNG.-]NB''PID'''DEP'.LOG" -$ TELL "There should be about 100 Mbytes available," -$ TELL "and it will probably take a few hours." -$ TELL " " -#else - onintr exex # finish neatly - if ($?echo) unset echo # no verify - if ($?verbose) unset verbose # no verbose - set pid=$$ ; @ dep=1 # for tmp files - echo " " - echo "Building Newstar." - echo " " - echo 'A log will be made in $WNG'"/../nb$pid$dep.log" - echo "There should be about 100 Mbytes available," - echo "and it will probably take a few hours." - echo " " -#endif -# -# Check environment -# -#ifdef wn_vax__ -$ IF F$TRNLNM("WNG") .EQS. "" .OR. F$TRNLNM("WNG_OLBEXE") .EQS. "" - - .OR. F$TRNLNM("WNG_DIR") .EQS. "" - - .OR. "''WNG_TYPE'" .EQS. "" .OR. "''WNG_SITE'" .EQS. "" - - .OR. "''NSTAR_DIR'" .EQS. "" - -$ THEN -$ TELL " Error: Must have logicals WNG, WNG_OLBEXE, WNG_DIR and globals" -$ TELL " WNG_TYPE, WNG_SITE, NSTAR_DIR defined" -$ TELL " You probably have not included the proper" -$ TELL " files in LOGIN.COM" -$ GOTO EXEX -$ ENDIF -$ IF F$TRNLNM("EXEDWARF") .EQS. "" .OR. - - F$TRNLNM("LIBDWARF") .EQS. "" .OR. - - F$TRNLNM("RUNDWARF") .EQS. "" -$ THEN -$ TELL " Error: Cannot do everything with EXEDWARF and/or" -$ TELL " LIBDWARF and/or RUNDWARF not defined" -$ TELL " You probably have not included the proper" -$ TELL " files in LOGIN.COM" -$ GOTO EXEX -$ ENDIF -$ IF "''NXEC'" .EQS. "" -$ THEN -$ TELL " Error: You have no symbol for NXEC etc." -$ TELL " You probably have not included the proper" -$ TELL " files in LOGIN.COM" -$ GOTO EXEX -$ ENDIF -$ IF "''WNG_EXE'" .EQS. "" THEN - - WNG_EXE=F$TRNLNM("WNG_OLBEXE") -$ IF "''WNG_OLB'" .EQS. "" THEN - - WNG_OLB=F$TRNLNM("WNG_OLBEXE") -$ WNG_TLB="" ! MAKE SURE -$ WNG_ERR="" -$ WNG_LIS="" -$ WNG_LINK="" -$ BLDDIR="''NSTAR_DIR'" ! Newstar directories -$ L0=0 ! MAKE DIRECTORIES -$ LP1: L1=F$ELEMENT(L0,",",BLDDIR) -$ IF L1 .NES. "," -$ THEN -$ IF F$PARSE("''WNG_EXE':[''L1']") .EQS. "" THEN - ! MAKE DIRECTORIES - CREATE/DIR 'WNG_EXE'['L1'] -$ IF F$PARSE("''WNG_OLB':[''L1']") .EQS. "" THEN - - CREATE/DIR 'WNG_OLB':['L1'] -$ L0=L0+1 -$ GOTO LP1 -$ ENDIF -#else - if (! $?WNG || ! $?WNG_TYPE || ! $?WNG_OLBEXE ||\ - ! $?WNG_SITE || ! $?NSTAR_DIR) then - echo " Error: Must have environment variables" - echo " WNG, WNG_TYPE, WNG_OLBEXE, WNG_SITE, NSTAR_DIR defined" - echo " You probably have not included the proper" - echo " files in .cshrc (see README)" - goto exex - endif - if (! $?EXEDWARF_UNIX || ! $?LIBDWARF) then - echo " Error: Cannot do everything with EXEDWARF_UNIX and/or" - echo " LIBDWARF not defined" - echo " You probably have not included the proper" - echo " files in .cshrc (see README)" - goto exex - endif - source $WNG/wngcshrc.sun # get aliases - if ("`alias nxec`" == "") then - echo " Error: You have no alias for nxec etc." - echo " You probably have not included the proper" - echo " files in .cshrc (see README)" - goto exex - endif -# -# Creating environment -# - cd $WNG - if (! $?WNG_EXE) setenv WNG_EXE $WNG_OLBEXE # make names - if (! $?WNG_OLB) setenv WNG_OLB $WNG_OLBEXE - set blddir=($NSTAR_DIR) # Newstar directories - foreach i ($blddir) - if (! -d $WNG_EXE/$i) mkdir $WNG_EXE/$i # make directories - if (! -d $WNG_OLB/$i) mkdir $WNG_OLB/$i - endif -## if ($?WNG_TLB) unsetenv WNG_TLB # make sure - if ($?WNG_ERR) unsetenv WNG_ERR - if ($?WNG_LIS) unsetenv WNG_LIS - if ($?WNG_LINK) unsetenv WNG_LINK -#endif -# -# Get questions -# -#ifdef wn_vax__ -$ OPEN/WRITE/ERROR=EXEX LOG'PID''DEP' WNG_DIR:[WNG.-]NB'PID''DEP'.LOG ! START LOG -$ TLOG "NU''PID'''DEP'.LOG" -$ TELL "Running NBUILD.COM at ''WNG_SITE'(''WNG_TYPE')" -$ TLOG "Running NBUILD.COM at ''WNG_SITE'(''WNG_TYPE')" -$ TELL "on ''F$GETSYI("NODENAME")' at ''F$TIME()'" -$ TLOG "on ''F$GETSYI("NODENAME")' at ''F$TIME()'" -$ TELL " " -$ TLOG " " -$ DOGDEF="Y" -$ IF F$SEARCH("WNG_DIR:[WNG]WNG.DEF") .NES. "" -$ THEN -$ READ/TIME=90/END=EXEX/ERROR=EXEX - - /PROMPT=".def files seem to exist. Get them anyway? (Y|N) [Y]: " - - SYS$COMMAND L0 -$ TLOG ".def files seem to exist. Get them anyway? (Y|N) [Y]: ''L0'" -$ IF "''L0'" .EQS. "n" .OR. "''L0'" .EQS. "N" THEN DOGDEF="N" -$ ENDIF -$ DOMDEF="Y" -$ IF F$TRNLNM("WNG_DEF") .NES. "" .AND. .NOT. DOGDEF -$ THEN -$ READ/TIME=90/END=EXEX/ERROR=EXEX - - /PROMPT=".def files seem compiled. Compile them anyway? (Y|N) [Y]: " - - SYS$COMMAND L0 -$ TLOG ".def files seem compiled. Compile them anyway? (Y|N) [Y]: ''L0'" -$ IF "''L0'" .EQS. "n" .OR. "''L0'" .EQS. "N" THEN DOMDEF="N" -$ ENDIF -$ DOGGRP="Y" -$ IF F$SEARCH("WNG_DIR:[WNG]WNG.GRP") .NES. "" -$ THEN -$ READ/TIME=90/END=EXEX/ERROR=EXEX - - /PROMPT=".grp files seem to exist. Get them anyway? (Y|N) [Y]: " - - SYS$COMMAND L0 -$ TLOG ".grp files seem to exist. Get them anyway? (Y|N) [Y]: ''L0'" -$ IF "''L0'" .EQS. "n" .OR. "''L0'" .EQS. "N" THEN DOGGRP="N" -$ ENDIF -$ DOCOMP="N" -$ IF F$SEARCH("WNG_OLBEXE:[WNG]WNLIB.OLB") .NES. "" -$ THEN -$ READ/TIME=90/END=EXEX/ERROR=EXEX - - /PROMPT="Some compilation at least done. Compile all? (Y|N) [N]: " - - SYS$COMMAND L0 -$ TLOG "Some compilation at least done. Compile all? (Y|N) [N]: ''L0'" -$ IF "''L0'" .EQS. "y" .OR. "''L0'" .EQS. "Y" THEN DOCOMP="Y" -$ ELSE -$ DOCOMP="Y" -$ ENDIF -$ DOLINK="Y" -$ READ/TIME=90/END=EXEX/ERROR=EXEX - - /PROMPT="Link all programs? (Y|N) [Y]: " - - SYS$COMMAND L0 -$ TLOG "Link all programs? (Y|N) [Y]: ''L0'" -$ IF "''L0'" .EQS. "n" .OR. "''L0'" .EQS. "N" THEN DOLINK="N" -$ TELL "You could clean up all unwanted files." -$ TELL "(0)For operation the following files should remain:" -$ TELL " EXEDWARF:*.exe and *.ppd; RUNDWARF:*.exe; WNG_DIR:[*]*.COM" -$ TELL "(1)For easy updating the following files should also remain:" -$ TELL " WNG_OLBEXE:[*]*.olb WNG_DIR:[*]*.tlb and *.def and *.inc" -$ TELL " and *.grp;" -$ TELL "(2)To check programs all source files could remain" -$ TELL "(3)To check all listing files can remain" -$ TELL "I can remove for you including and above a specified level:" -$ TELL "(probably better to run with 4 first time, and rerun" -$ TELL " nbuild later with all questions n and the proper level)" -$ READ/TIME=90/END=EXEX/ERROR=EXEX - - /PROMPT="Clean disk level (1|2|3|4) [3]: " - - SYS$COMMAND L0 -$ IF L0 .LT. 1 .OR. L0 .GT.4 THEN L0=3 -$ TLOG "Clean disk level (1|2|3|4) [3]: ''L0'" -$ DOCLUP=L0 -#else - echo "nb$pid$dep.log" >>! $WNG/../nb$pid$dep.log # start log - echo "Running NBUILD.SUN for $WNG_SITE($WNG_TYPE)" \ - | tee -a $WNG/../nb$pid$dep.log - echo "on `hostname` at `date`" | tee -a $WNG/../nb$pid$dep.log - echo " " | tee -a $WNG/../nb$pid$dep.log - set dogdef - if (-e wng.def) then - echo -n ".def files seem to exist. Get them anyway? (y|n) [y]: " \ - | tee -a $WNG/../nb$pid$dep.log - set l0=($<) - echo "$l0" >>! $WNG/../nb$pid$dep.log - if ("$l0" =~ [nN]*) unset dogdef # skip get - endif - set domdef - if (-e WNG_DEF) then - echo -n ".def files seem compiled. Compile them anyway? (y|n) [y]: " \ - | tee -a $WNG/../nb$pid$dep.log - set l0=($<) - echo "$l0" >>! $WNG/../nb$pid$dep.log - if ("$l0" =~ [nN]*) unset domdef # skip compile - endif - set doggrp - if (-e wng.grp) then - echo -n ".grp files seem to exist. Get them anyway? (y|n) [y]: " \ - | tee -a $WNG/../nb$pid$dep.log - set l0=($<) - echo "$l0" >>! $WNG/../nb$pid$dep.log - if ("$l0" =~ [nN]*) unset doggrp # skip compile - endif - set l0=("`ar t $WNG_OLBEXE/wng/wnlib.olb wngang.o`") - if ("$l0" == "wngang.o") then - echo -n "Some compilation at least done. Compile all? (y|n) [n]: " \ - | tee -a $WNG/../nb$pid$dep.log - set l0=($<) - echo "$l0" >>! $WNG/../nb$pid$dep.log - if ("$l0" =~ [yY]*) set docomp # do compile - else - set docomp - endif - set dolink - echo -n "Link all programs? (y|n) [y]: " \ - | tee -a $WNG/../nb$pid$dep.log - set l0=($<) - echo "$l0" >>! $WNG/../nb$pid$dep.log - if ("$l0" =~ [nN]*) unset dolink # skip link - echo "You could clean up all unwanted files." \ - | tee -a $WNG/../nb$pid$dep.log - echo "(0)For operation the following files should remain:" \ - | tee -a $WNG/../nb$pid$dep.log - echo ' $EXEDWARF_UNIX/*.exe and *.ppd; $WNG/../*/*.sun' \ - | tee -a $WNG/../nb$pid$dep.log - echo "(1)For easy updating the following files should also remain:" \ - | tee -a $WNG/../nb$pid$dep.log - echo ' $WNG_OLB/*/*.olb $WNG/../*/*.tlb and *.def and *.inc' \ - | tee -a $WNG/../nb$pid$dep.log - echo ' and *DEF and *.grp;' \ - | tee -a $WNG/../nb$pid$dep.log - echo ' upper case in $WNG/../dwarf (except *.LOG)' \ - | tee -a $WNG/../nb$pid$dep.log - echo "(2)To check programs all source files could remain" \ - | tee -a $WNG/../nb$pid$dep.log - echo "(3)To check all listing files can remain" \ - | tee -a $WNG/../nb$pid$dep.log - echo "I can remove for you including and above a specified level:" \ - | tee -a $WNG/../nb$pid$dep.log - echo "(probably better to run with 4 first time, and rerun" \ - | tee -a $WNG/../nb$pid$dep.log - echo " nbuild later with all questions n and the proper level)" \ - | tee -a $WNG/../nb$pid$dep.log - echo -n "Clean disk level (1|2|3|4) [3]: " \ - | tee -a $WNG/../nb$pid$dep.log - set l0=($<) - if ("$l0" !~ [1234]) set l0=3 - echo "$l0" >>! $WNG/../nb$pid$dep.log - set doclup=$l0 -#endif -# -# Get and make .def .sun -# -#ifdef wn_vax__ -$ GDEF: -$ SET DEF WNG_DIR:[WNG.-] ! BASE DIRECTORY -$ IF DOGDEF -$ THEN -$ TELL "Getting .def ..." -$ TLOG "Getting .def ..." -$ ASSIGN/NOLOG LOG'PID''DEP' SYS$OUTPUT -$ ASSIGN/NOLOG LOG'PID''DEP' SYS$ERROR -$ L0=0 ! MAKE DIRECTORIES -$ LP2: L1=F$ELEMENT(L0,",",BLDDIR) -$ IF L1 .NES. "," -$ THEN -$ SET DEF WNG_DIR:['L1'] -$ NGET -A *.DEF *.INC *.PEF,*.DSF,*.SSC,*.COM ! GET .DEF -$ L0=L0+1 -$ GOTO LP2 -$ ENDIF -$ DEASSIGN SYS$OUTPUT -$ DEASSIGN SYS$ERROR -$ ENDIF -$ MDEF: -$ SET DEF WNG_DIR:[WNG.-] ! BASE DIRECTORY -$ IF DOMDEF -$ THEN -$ TELL "Compiling .def ..." -$ TLOG "Compiling .def ..." -$ ASSIGN/NOLOG LOG'PID''DEP' SYS$OUTPUT -$ ASSIGN/NOLOG LOG'PID''DEP' SYS$ERROR -$ L0=0 ! MAKE DIRECTORIES -$ LP3: L1=F$ELEMENT(L0,",",BLDDIR) -$ IF L1 .NES. "," -$ THEN -$ SET DEF WNG_DIR:['L1'] -$ NCOMP -U *.DEF *.INC *.PEF,*.DSF,*.SSC,*.COM ! COMPILE .DEF -$ L0=L0+1 -$ GOTO LP3 -$ ENDIF -$ DEASSIGN SYS$OUTPUT -$ DEASSIGN SYS$ERROR -$ ENDIF -#else -GDEF: - cd $WNG # base directory - if ($?dogdef) then - echo "Getting .def ..." | tee -a $WNG/../nb$pid$dep.log - foreach i ($blddir) # get .def - cd ../$i # correct directory - nget -a '.*def' '.*pef' '.*dsf' '.*inc' '.*ssc' '.*sun' \ - >>&! $WNG/../nb$pid$dep.log - end - endif -MDEF: - cd $WNG # base directory - if ($?domdef) then - echo "Compiling .def ..." | tee -a $WNG/../nb$pid$dep.log - foreach i ($blddir) # compile .def - cd ../$i # correct directory - ncomp -u *.def *.inc *.pef *.dsf *.ssc *.sun \ - >>&! $WNG/../nb$pid$dep.log - end - endif -#endif -# -# Get groups -# -#ifdef wn_vax__ -$ GGRP: -$ SET DEF WNG_DIR:[WNG.-] ! BASE DIRECTORY -$ IF DOGGRP -$ THEN -$ TELL "Getting .grp ..." -$ TLOG "Getting .grp ..." -$ ASSIGN/NOLOG LOG'PID''DEP' SYS$OUTPUT -$ ASSIGN/NOLOG LOG'PID''DEP' SYS$ERROR -$ L0=0 ! MAKE DIRECTORIES -$ LP4: L1=F$ELEMENT(L0,",",BLDDIR) -$ IF L1 .NES. "," -$ THEN -$ SET DEF WNG_DIR:['L1'] -$ NGET -NZA *.GRP ! GET .GRP -$ L0=L0+1 -$ GOTO LP4 -$ ENDIF -$ DEASSIGN SYS$OUTPUT -$ DEASSIGN SYS$ERROR -$ ENDIF -#else -GGRP: - cd $WNG # base directory - if ($?doggrp) then - echo "Getting .grp ..." | tee -a $WNG/../nb$pid$dep.log - foreach i ($blddir) # get .grp - cd ../$i # correct directory - nget -nza '.*grp' >>&! $WNG/../nb$pid$dep.log # get .grp - end - endif -#endif -# -# Compile all -# -#ifdef wn_vax__ -$ COMP: -$ SET DEF WNG_DIR:[WNG.-] ! BASE DIRECTORY -$ IF DOCOMP -$ THEN -$ TELL "Compiling Newstar system ..." -$ TLOG "Compiling Newstar system ..." -$ ASSIGN/NOLOG LOG'PID''DEP' SYS$OUTPUT -$ ASSIGN/NOLOG LOG'PID''DEP' SYS$ERROR -$ L0=0 ! MAKE DIRECTORIES -$ LP5: L1=F$ELEMENT(L0,",",BLDDIR) -$ IF L1 .NES. "," -$ THEN -$ SET DEF WNG_DIR:['L1'] -$ NCOMP *.GRP ! COMPILE -$ L0=L0+1 -$ GOTO LP5 -$ ENDIF -$ DEASSIGN SYS$OUTPUT -$ DEASSIGN SYS$ERROR -$ ENDIF -#else -COMP: - cd $WNG # base directory - if ($?docomp) then - echo "Compiling Newstar system ..." | tee -a $WNG/../nb$pid$dep.log - foreach i ($blddir) # compile - cd ../$i # correct directory - ncomp *.grp >>&! $WNG/../nb$pid$dep.log # compile - end - endif -#endif -# -# Link all -# -#ifdef wn_vax__ -$ LINK: -$ SET DEF WNG_DIR:[WNG.-] ! BASE DIRECTORY -$ IF DOLINK -$ THEN -$ TELL "Linking Newstar system ..." -$ TLOG "Linking Newstar system ..." -$ ASSIGN/NOLOG LOG'PID''DEP' SYS$OUTPUT -$ ASSIGN/NOLOG LOG'PID''DEP' SYS$ERROR -$ L0=0 ! MAKE DIRECTORIES -$ LP6: L1=F$ELEMENT(L0,",",BLDDIR) -$ IF L1 .NES. "," -$ THEN -$ SET DEF WNG_DIR:['L1'] -$ NLINK -U *.GRP ! LINK -$ NCOMP -U *.PIN -$ NCOMP -U *.DSC -$ NCOMP -U *.SSC -$ L0=L0+1 -$ GOTO LP6 -$ ENDIF -$ DEASSIGN SYS$OUTPUT -$ DEASSIGN SYS$ERROR -$ ENDIF -#else -LINK: - cd $WNG # base directory - if ($?dolink) then - echo "Linking Newstar system ..." | tee -a $WNG/../nb$pid$dep.log - foreach i ($blddir) # link - cd ../$i # correct directory - nlink -u *.grp >>&! $WNG/../nb$pid$dep.log # link all programs - end - foreach i ($blddir) # compile .pin - cd ../$i # correct directory - ncomp -u *.pin >>&! $WNG/../nb$pid$dep.log # make ppd - end - foreach i ($blddir) # compile .*sc - cd ../$i # correct directory - ncomp -u *.dsc >>&! $WNG/../nb$pid$dep.log # compile .dsc - ncomp -u *.ssc >>&! $WNG/../nb$pid$dep.log # compile .ssc - end - endif -#endif -# -# Cleanup -# -#ifdef wn_vax__ -$ CLUP: -$ SET DEF WNG_DIR:[WNG.-] ! BASE DIRECTORY -$ IF DOCLUP .LT. 4 -$ THEN -$ TELL "Deleting listing files ..." -$ TLOG "Deleting listing files ..." -$ ASSIGN/NOLOG LOG'PID''DEP' SYS$OUTPUT -$ ASSIGN/NOLOG LOG'PID''DEP' SYS$ERROR -$ L0=0 ! MAKE DIRECTORIES -$ LP7: L1=F$ELEMENT(L0,",",BLDDIR) -$ IF L1 .NES. "," -$ THEN -$ SET DEF WNG_DIR:['L1'] -$ IF F$SEARCH("*.LIS") .NES. "" THEN DELETE *.LIS;* -$ IF F$SEARCH("*.ERR") .NES. "" THEN DELETE *.ERR;* -$ IF F$SEARCH("*.OLD") .NES. "" THEN DELETE *.OLD;* -$ IF F$SEARCH("*.NEW") .NES. "" THEN DELETE *.NEW;* -$ IF F$SEARCH("*.LOG") .NES. "" THEN DELETE *.LOG;* -$ IF F$SEARCH("*.TMP") .NES. "" THEN DELETE *.TMP;* -$ IF F$SEARCH("*.OBJ") .NES. "" THEN DELETE *.OBJ;* -$ IF F$SEARCH("*.JOU") .NES. "" THEN DELETE *.JOU;* -$ IF F$SEARCH("''WNG_EXE':[''L1']*.MAP") .NES. "" THEN - - DELETE WNG_EXE:['L1']*.MAP;* -$ L0=L0+1 -$ GOTO LP7 -$ ENDIF -$ DEASSIGN SYS$OUTPUT -$ DEASSIGN SYS$ERROR -$ ENDIF -$ IF DOCLUP .LT. 3 -$ THEN -$ TELL "Deleting source files ..." -$ TLOG "Deleting source files ..." -$ ASSIGN/NOLOG LOG'PID''DEP' SYS$OUTPUT -$ ASSIGN/NOLOG LOG'PID''DEP' SYS$ERROR -$ L0=0 ! MAKE DIRECTORIES -$ LP8: L1=F$ELEMENT(L0,",",BLDDIR) -$ IF L1 .NES. "," -$ THEN -$ SET DEF WNG_DIR:['L1'] -$ IF F$SEARCH("*.F%%") .NES. "" THEN DELETE *.F%%;* -$ IF F$SEARCH("*.C%%") .NES. "" THEN DELETE/EXCLUDE=(*.COM) *.C%%;* -$ IF F$SEARCH("*.M%%") .NES. "" THEN DELETE *.M%%;* -$ IF F$SEARCH("*.PIN") .NES. "" THEN DELETE *.PIN;* -$ L0=L0+1 -$ GOTO LP8 -$ ENDIF -$ DEASSIGN SYS$OUTPUT -$ DEASSIGN SYS$ERROR -$ ENDIF -$ IF DOCLUP .LT. 3 -$ THEN -$ TELL "Deleting object/include files ..." -$ TLOG "Deleting object/include files ..." -$ ASSIGN/NOLOG LOG'PID''DEP' SYS$OUTPUT -$ ASSIGN/NOLOG LOG'PID''DEP' SYS$ERROR -$ L0=0 ! MAKE DIRECTORIES -$ LP9: L1=F$ELEMENT(L0,",",BLDDIR) -$ IF L1 .NES. "," -$ THEN -$ SET DEF WNG_DIR:['L1'] -$ IF F$SEARCH("*.DEF") .NES. "" THEN DELETE *.DEF;* -$ IF F$SEARCH("*.INC") .NES. "" THEN DELETE *.INC;* -$ IF F$SEARCH("*.DSC") .NES. "" THEN DELETE *.DSC;* -$ IF F$SEARCH("*.SSC") .NES. "" THEN DELETE *.SSC;* -$ IF F$SEARCH("''WNG_OLB':[''L1']*.OLB") .NES. "" THEN - - DELETE WNG_OLB:['L1']*.OLB;* -$ L0=L0+1 -$ GOTO LP9 -$ ENDIF -$ DEASSIGN SYS$OUTPUT -$ DEASSIGN SYS$ERROR -$ ENDIF -#else -CLUP: - cd $WNG - if ($doclup < 4) then - echo "Removing listing files ..." | tee -a $WNG/../nb$pid$dep.log - foreach i ($blddir) # remove listings - cd ../$i - set nonomatch - 'rm' *.lis >& /dev/null - 'rm' *.err >& /dev/null - 'rm' *.old >& /dev/null - 'rm' *.new >& /dev/null - 'rm' *.log >& /dev/null - 'rm' *.LOG >& /dev/null - 'rm' *.tmp >& /dev/null - 'rm' *~ >& /dev/null - 'rm' *.o >& /dev/null - 'rm' $WNG_EXE/$i/*.map >& /dev/null - unset nonomatch - end - endif - if ($doclup < 3) then - echo "Removing source files ..." | tee -a $WNG/../nb$pid$dep.log - foreach i ($blddir) - cd ../$i - set nonomatch - 'rm' *.f?? >& /dev/null - 'rm' *.c[a-np-z]? >& /dev/null - 'rm' *.m?? >& /dev/null - 'rm' *.pin >& /dev/null - unset nonomatch - end - endif - if ($doclup < 2) then - echo "Removing object/include files ..." \ - | tee -a $WNG/../nb$pid$dep.log - foreach i ($blddir) - cd ../$i - 'rm' $WNG_OLB/$i/*.olb >& /dev/null - set nonomatch - 'rm' *.def >& /dev/null - 'rm' *.inc >& /dev/null - 'rm' *.dsc >& /dev/null - 'rm' *DEF >& /dev/null - 'rm' *.ssc >& /dev/null - 'rm' [A-Z0-9]* >& /dev/null - unset nonomatch - end - endif -#endif -# -# Ready -# -#ifdef wn_vax__ -$ END: -$ TELL " " -$ TLOG " " -$ TELL "Newstar built. Try if everything works by typing:" -$ TELL " indwarf (unless in LOGIN.COM)" -$ TELL " dws ngen/nomenu" -$ TELL " log=y" -$ TELL " (empty line)" -$ TELL "and:" -$ TELL " pvax WNG_DIR:[WNG.-]NB''PID'''DEP'.LOG" -$ TELL "If problem exist, rerun @WNG:NBUILD with all questions y" -$ TELL "To make a minimum backup to be able to rebuild the system," -$ TELL "run @WNG:NTARZ" -$ TELL "Good luck" -$ TELL " " -$ TLOG " " -#else -END: - echo " " | tee -a $WNG/../nb$pid$dep.log - echo "Newstar built. Try if everything works by typing:" \ - | tee -a $WNG/../nb$pid$dep.log - echo " indwarf (unless in .cshrc)" \ - | tee -a $WNG/../nb$pid$dep.log - echo " dws ngen/nomenu" | tee -a $WNG/../nb$pid$dep.log - echo " log=y" | tee -a $WNG/../nb$pid$dep.log - echo " (empty line)" \ - | tee -a $WNG/../nb$pid$dep.log - echo "and:" | tee -a $WNG/../nb$pid$dep.log - echo ' pvax $WNG'"/../nb$pid$dep.log" \ - | tee -a $WNG/../nb$pid$dep.log - echo 'If problem exist, rerun $WNG'"/nbuild.sun with all questions y" \ - | tee -a $WNG/../nb$pid$dep.log - echo "To make a minimum backup to be able to rebuild the system," \ - | tee -a $WNG/../nb$pid$dep.log - echo 'run $WNG'"/ntarz.sun" | tee -a $WNG/../nb$pid$dep.log - echo "Good luck" | tee -a $WNG/../nb$pid$dep.log - echo " " | tee -a $WNG/../nb$pid$dep.log -#endif -# -# EXIT -# -#ifdef wn_vax__ -$ EXEX: SET ON -$ CLOSE/ERROR=EXX1 LOG'PID''DEP !MAKE SURE -$ EXX1: -$ SET DEF WNG_DIR:[WNG.-] !BACK TO NORMAL -$ L0=F$VERIFY(VER) !RESET VERIFY -$ EXIT -#else -exex: - exit -#endif diff --git a/src/wng/nbuild.sun b/src/wng/nbuild.sun deleted file mode 100755 index 9ef175def6050381e8d095e197619dd13ffbd764..0000000000000000000000000000000000000000 --- a/src/wng/nbuild.sun +++ /dev/null @@ -1,304 +0,0 @@ -# nbuild.ssc -# WNB 921117 -# -# Revisions: -# WNB 921210 Change compilation of .def etc; delete c?? -# WNB 921222 Add SSC and nonomatch for HP -# WNB 921224 Make SSC -# WNB 930303 NSTAR_DIR added -# WNB 930305 Make sure of aliases -# WNB 930514 Correct aliases -# WNB 930803 Add .dsf -# WNB 940124 Leave _TLB -# -# Build Newstar from standard export tar tape -# -# Uses environment variables: -# WNG where to find wng-type sources -# WNG_TYPE machine (sw, dw, hp, al, cv etc) -# WNG_OLBEXE root of wng-type .olb, .ppd, .exe -# WNG_SITE site (nfra, atnf, rug ...) -# EXEDWARF_UNIX where to find/set DWARF .exe, .ppd -# LIBDWARF where to find DWARF .olb -# NSTAR_DIR N directories -# and also possible: -# WNG_EXE, WNG_OLB, WNG_TLB, WNG_ERR, WNG_LIS, WNG_LINK -# -# Intro -# - onintr exex # finish neatly - if ($?echo) unset echo # no verify - if ($?verbose) unset verbose # no verbose - set pid=$$ ; @ dep=1 # for tmp files - echo " " - echo "Building Newstar." - echo " " - echo 'A log will be made in $WNG'"/../nb$pid$dep.log" - echo "There should be about 100 Mbytes available," - echo "and it will probably take a few hours." - echo " " -# -# Check environment -# - if (! $?WNG || ! $?WNG_TYPE || ! $?WNG_OLBEXE ||\ - ! $?WNG_SITE || ! $?NSTAR_DIR) then - echo " Error: Must have environment variables" - echo " WNG, WNG_TYPE, WNG_OLBEXE, WNG_SITE, NSTAR_DIR defined" - echo " You probably have not included the proper" - echo " files in .cshrc (see README)" - goto exex - endif - if (! $?EXEDWARF_UNIX || ! $?LIBDWARF) then - echo " Error: Cannot do everything with EXEDWARF_UNIX and/or" - echo " LIBDWARF not defined" - echo " You probably have not included the proper" - echo " files in .cshrc (see README)" - goto exex - endif - source $WNG/wngcshrc.sun # get aliases - if ("`alias nxec`" == "") then - echo " Error: You have no alias for nxec etc." - echo " You probably have not included the proper" - echo " files in .cshrc (see README)" - goto exex - endif -# -# Creating environment -# - cd $WNG - if (! $?WNG_EXE) setenv WNG_EXE $WNG_OLBEXE # make names - if (! $?WNG_OLB) setenv WNG_OLB $WNG_OLBEXE - set blddir=($NSTAR_DIR) # Newstar directories - foreach i ($blddir) - if (! -d $WNG_EXE/$i) mkdir $WNG_EXE/$i # make directories - if (! -d $WNG_OLB/$i) mkdir $WNG_OLB/$i - endif -## if ($?WNG_TLB) unsetenv WNG_TLB # make sure - if ($?WNG_ERR) unsetenv WNG_ERR - if ($?WNG_LIS) unsetenv WNG_LIS - if ($?WNG_LINK) unsetenv WNG_LINK -# -# Get questions -# - echo "nb$pid$dep.log" >>! $WNG/../nb$pid$dep.log # start log - echo "Running NBUILD.SUN for $WNG_SITE($WNG_TYPE)" \ - | tee -a $WNG/../nb$pid$dep.log - echo "on `hostname` at `date`" | tee -a $WNG/../nb$pid$dep.log - echo " " | tee -a $WNG/../nb$pid$dep.log - set dogdef - if (-e wng.def) then - echo -n ".def files seem to exist. Get them anyway? (y|n) [y]: " \ - | tee -a $WNG/../nb$pid$dep.log - set l0=($<) - echo "$l0" >>! $WNG/../nb$pid$dep.log - if ("$l0" =~ [nN]*) unset dogdef # skip get - endif - set domdef - if (-e WNG_DEF) then - echo -n ".def files seem compiled. Compile them anyway? (y|n) [y]: " \ - | tee -a $WNG/../nb$pid$dep.log - set l0=($<) - echo "$l0" >>! $WNG/../nb$pid$dep.log - if ("$l0" =~ [nN]*) unset domdef # skip compile - endif - set doggrp - if (-e wng.grp) then - echo -n ".grp files seem to exist. Get them anyway? (y|n) [y]: " \ - | tee -a $WNG/../nb$pid$dep.log - set l0=($<) - echo "$l0" >>! $WNG/../nb$pid$dep.log - if ("$l0" =~ [nN]*) unset doggrp # skip compile - endif - set l0=("`ar t $WNG_OLBEXE/wng/wnlib.olb wngang.o`") - if ("$l0" == "wngang.o") then - echo -n "Some compilation at least done. Compile all? (y|n) [n]: " \ - | tee -a $WNG/../nb$pid$dep.log - set l0=($<) - echo "$l0" >>! $WNG/../nb$pid$dep.log - if ("$l0" =~ [yY]*) set docomp # do compile - else - set docomp - endif - set dolink - echo -n "Link all programs? (y|n) [y]: " \ - | tee -a $WNG/../nb$pid$dep.log - set l0=($<) - echo "$l0" >>! $WNG/../nb$pid$dep.log - if ("$l0" =~ [nN]*) unset dolink # skip link - echo "You could clean up all unwanted files." \ - | tee -a $WNG/../nb$pid$dep.log - echo "(0)For operation the following files should remain:" \ - | tee -a $WNG/../nb$pid$dep.log - echo ' $EXEDWARF_UNIX/*.exe and *.ppd; $WNG/../*/*.sun' \ - | tee -a $WNG/../nb$pid$dep.log - echo "(1)For easy updating the following files should also remain:" \ - | tee -a $WNG/../nb$pid$dep.log - echo ' $WNG_OLB/*/*.olb $WNG/../*/*.tlb and *.def and *.inc' \ - | tee -a $WNG/../nb$pid$dep.log - echo ' and *DEF and *.grp;' \ - | tee -a $WNG/../nb$pid$dep.log - echo ' upper case in $WNG/../dwarf (except *.LOG)' \ - | tee -a $WNG/../nb$pid$dep.log - echo "(2)To check programs all source files could remain" \ - | tee -a $WNG/../nb$pid$dep.log - echo "(3)To check all listing files can remain" \ - | tee -a $WNG/../nb$pid$dep.log - echo "I can remove for you including and above a specified level:" \ - | tee -a $WNG/../nb$pid$dep.log - echo "(probably better to run with 4 first time, and rerun" \ - | tee -a $WNG/../nb$pid$dep.log - echo " nbuild later with all questions n and the proper level)" \ - | tee -a $WNG/../nb$pid$dep.log - echo -n "Clean disk level (1|2|3|4) [3]: " \ - | tee -a $WNG/../nb$pid$dep.log - set l0=($<) - if ("$l0" !~ [1234]) set l0=3 - echo "$l0" >>! $WNG/../nb$pid$dep.log - set doclup=$l0 -# -# Get and make .def .sun -# -GDEF: - cd $WNG # base directory - if ($?dogdef) then - echo "Getting .def ..." | tee -a $WNG/../nb$pid$dep.log - foreach i ($blddir) # get .def - cd ../$i # correct directory - nget -a '.*def' '.*pef' '.*dsf' '.*inc' '.*ssc' '.*sun' \ - >>&! $WNG/../nb$pid$dep.log - end - endif -MDEF: - cd $WNG # base directory - if ($?domdef) then - echo "Compiling .def ..." | tee -a $WNG/../nb$pid$dep.log - foreach i ($blddir) # compile .def - cd ../$i # correct directory - ncomp -u *.def *.inc *.pef *.dsf *.ssc *.sun \ - >>&! $WNG/../nb$pid$dep.log - end - endif -# -# Get groups -# -GGRP: - cd $WNG # base directory - if ($?doggrp) then - echo "Getting .grp ..." | tee -a $WNG/../nb$pid$dep.log - foreach i ($blddir) # get .grp - cd ../$i # correct directory - nget -nza '.*grp' >>&! $WNG/../nb$pid$dep.log # get .grp - end - endif -# -# Compile all -# -COMP: - cd $WNG # base directory - if ($?docomp) then - echo "Compiling Newstar system ..." | tee -a $WNG/../nb$pid$dep.log - foreach i ($blddir) # compile - cd ../$i # correct directory - ncomp *.grp >>&! $WNG/../nb$pid$dep.log # compile - end - endif -# -# Link all -# -LINK: - cd $WNG # base directory - if ($?dolink) then - echo "Linking Newstar system ..." | tee -a $WNG/../nb$pid$dep.log - foreach i ($blddir) # link - cd ../$i # correct directory - nlink -u *.grp >>&! $WNG/../nb$pid$dep.log # link all programs - end - foreach i ($blddir) # compile .pin - cd ../$i # correct directory - ncomp -u *.pin >>&! $WNG/../nb$pid$dep.log # make ppd - end - foreach i ($blddir) # compile .*sc - cd ../$i # correct directory - ncomp -u *.dsc >>&! $WNG/../nb$pid$dep.log # compile .dsc - ncomp -u *.ssc >>&! $WNG/../nb$pid$dep.log # compile .ssc - end - endif -# -# Cleanup -# -CLUP: - cd $WNG - if ($doclup < 4) then - echo "Removing listing files ..." | tee -a $WNG/../nb$pid$dep.log - foreach i ($blddir) # remove listings - cd ../$i - set nonomatch - 'rm' *.lis >& /dev/null - 'rm' *.err >& /dev/null - 'rm' *.old >& /dev/null - 'rm' *.new >& /dev/null - 'rm' *.log >& /dev/null - 'rm' *.LOG >& /dev/null - 'rm' *.tmp >& /dev/null - 'rm' *~ >& /dev/null - 'rm' *.o >& /dev/null - 'rm' $WNG_EXE/$i/*.map >& /dev/null - unset nonomatch - end - endif - if ($doclup < 3) then - echo "Removing source files ..." | tee -a $WNG/../nb$pid$dep.log - foreach i ($blddir) - cd ../$i - set nonomatch - 'rm' *.f?? >& /dev/null - 'rm' *.c[a-np-z]? >& /dev/null - 'rm' *.m?? >& /dev/null - 'rm' *.pin >& /dev/null - unset nonomatch - end - endif - if ($doclup < 2) then - echo "Removing object/include files ..." \ - | tee -a $WNG/../nb$pid$dep.log - foreach i ($blddir) - cd ../$i - 'rm' $WNG_OLB/$i/*.olb >& /dev/null - set nonomatch - 'rm' *.def >& /dev/null - 'rm' *.inc >& /dev/null - 'rm' *.dsc >& /dev/null - 'rm' *DEF >& /dev/null - 'rm' *.ssc >& /dev/null - 'rm' [A-Z0-9]* >& /dev/null - unset nonomatch - end - endif -# -# Ready -# -END: - echo " " | tee -a $WNG/../nb$pid$dep.log - echo "Newstar built. Try if everything works by typing:" \ - | tee -a $WNG/../nb$pid$dep.log - echo " indwarf (unless in .cshrc)" \ - | tee -a $WNG/../nb$pid$dep.log - echo " dws ngen/nomenu" | tee -a $WNG/../nb$pid$dep.log - echo " log=y" | tee -a $WNG/../nb$pid$dep.log - echo " (empty line)" \ - | tee -a $WNG/../nb$pid$dep.log - echo "and:" | tee -a $WNG/../nb$pid$dep.log - echo ' pvax $WNG'"/../nb$pid$dep.log" \ - | tee -a $WNG/../nb$pid$dep.log - echo 'If problem exist, rerun $WNG'"/nbuild.sun with all questions y" \ - | tee -a $WNG/../nb$pid$dep.log - echo "To make a minimum backup to be able to rebuild the system," \ - | tee -a $WNG/../nb$pid$dep.log - echo 'run $WNG'"/ntarz.sun" | tee -a $WNG/../nb$pid$dep.log - echo "Good luck" | tee -a $WNG/../nb$pid$dep.log - echo " " | tee -a $WNG/../nb$pid$dep.log -# -# EXIT -# -exex: - exit diff --git a/src/wng/ncl.def b/src/wng/ncl.def deleted file mode 100644 index da5fc40f76d8331fe91888a779d7dab8b43363c2..0000000000000000000000000000000000000000 --- a/src/wng/ncl.def +++ /dev/null @@ -1,104 +0,0 @@ -C+ Created from ncl.dsc on 970828 at 16:52:59 at daw18 -C NCL.DEF -C WNB 970828 -C -C Revisions: -C -C HJV 950512 Add DATAFAC -C WNB 930803 Remove .INCLUDE -C WNB 921216 Add GRFAC -C WNB 910809 Original version -C -C -C Given statements: -C -C -C Result: -C -C NCL.DEF is an INCLUDE file for the NCLEAN program -C -C -C -C Parameters: -C - INTEGER MXNSET ! MAX. # OF MAP SETS - PARAMETER (MXNSET=16) - INTEGER MXNAR ! MAX. # OF AREAS - PARAMETER (MXNAR=32) - INTEGER MNBPAT ! MIN. BEAM PATCH SIZE - PARAMETER (MNBPAT=3) - INTEGER MXBPAT ! MAX. BEAM PATCH SIZE - PARAMETER (MXBPAT=128) -C -C Data declarations: -C -C -C NCL common data: -C - CHARACTER*24 OPTION ! PROGRAM OPTION - CHARACTER*3 OPT - EQUIVALENCE (OPT,OPTION) - INTEGER MEMSIZ ! SIZE OF DYNAMIC MEMORY TO USE - CHARACTER*80 NODMAP ! MAP NODE - CHARACTER*160 FILMAP ! MAP FILE - INTEGER FCAMAP ! MAP FCA - INTEGER MSETS(0:7,0:16) ! MAP SETS - CHARACTER*80 NODAP ! AP NODE - CHARACTER*160 FILAP ! AP FILE - INTEGER FCAAP ! AP FCA - INTEGER ASETS(0:7,0:16) ! AP SETS - LOGICAL APDCV ! APPLY DECONVOLUTION - INTEGER CMPLOG(1:2) ! LOG CODE COMPON_LOG: - REAL CLLIM ! CLEAN LIMIT - REAL CLFAC ! CLEAN LOOP FACTOR - INTEGER SRCLIM ! # OF SOURCES LIMIT - INTEGER TAREA(0:3,0:1) ! TOTAL AREA - INTEGER PAREA(0:3,1:32,0:1) ! PARTIAL AREAS - INTEGER NAREA ! NUMBER OF AREAS - REAL PRHAT ! PRUSSIAN HAT VALUE - LOGICAL RESMDL ! OUTPUT RESIDUAL MODEL SWITCH - LOGICAL RSTMDL ! RESTORED OUTPUT SWITCH - LOGICAL RONMDL ! ONLY RESTORE SWITCH - REAL MPDEP ! CYCLE DEPTH - REAL GRFAC ! GRATING FACTOR - REAL DATAFAC ! DATACLEAN FACTOR - REAL CURMAX ! CURRENT MAP MAX. - INTEGER CURMXP(1:2) ! POS. CURRENT MAX. - INTEGER MAPNAM(0:7) ! CURRENT MAP NAME - INTEGER APNAM(0:7) ! CURRENT AP NAME - INTEGER BEMPAT ! SIZE BEAM PATCH - INTEGER MAPPAT ! # OF POINTS IN MAP PATCH - REAL MAPLIM ! MAP DATA LIMIT IN PATCH - REAL CLBXLM ! MAX. CORRECTION OUTSIDE PATCH - INTEGER CURPMX ! CURRENT MAX. POINTER - REAL MINLIM ! MAP INPUT MAXIMUM - INTEGER CVBFU ! U CONVOLUTION FUNCTION ptr - INTEGER CVBFV ! V CONVOLUTION FUNCTION ptr - REAL RESDL ! RESTORE BEAM L - REAL RESDM ! RESTORE BEAM M - REAL RESDAN ! RESTORE BEAM SKEW ANGLE - INTEGER MPHAD ! MAP HISTOGRAM AREA ptr - INTEGER BMHAD ! BEAM HISTOGRAM AREA ptr - REAL MPHMXI ! MAX. IN MAP HISTOGRAM -C -C NCL common block: -C - COMMON /NCL_COM/ OPTION,MEMSIZ,NODMAP, - 1 FILMAP,FCAMAP,MSETS, - 1 NODAP,FILAP,FCAAP, - 1 ASETS,APDCV,CMPLOG, - 1 CLLIM,CLFAC,SRCLIM, - 1 TAREA,PAREA,NAREA, - 1 PRHAT,RESMDL,RSTMDL, - 1 RONMDL,MPDEP,GRFAC, - 1 DATAFAC,CURMAX,CURMXP, - 1 MAPNAM,APNAM,BEMPAT, - 1 MAPPAT,MAPLIM,CLBXLM, - 1 CURPMX,MINLIM,CVBFU, - 1 CVBFV,RESDL,RESDM, - 1 RESDAN,MPHAD,BMHAD, - 1 MPHMXI -C -C Given statements: -C -C- diff --git a/src/wng/ncl.inc b/src/wng/ncl.inc deleted file mode 100644 index 2e6480b804c03a2f6bd2786a11b9885ff61df0cb..0000000000000000000000000000000000000000 --- a/src/wng/ncl.inc +++ /dev/null @@ -1,89 +0,0 @@ -/*+ Created from ncl.dsc on 970828 at 16:52:59 at daw18 -.. NCL.INC -.. WNB 970828 -.. -.. Revisions: -.. -.. HJV 950512 Add DATAFAC -.. WNB 930803 Remove .INCLUDE -.. WNB 921216 Add GRFAC -.. WNB 910809 Original version -.. */ -/* -.. Given statements: -.. */ -/* -.. Result: -.. -.. NCL.DEF is an INCLUDE file for the NCLEAN program -.. -.. */ -/* -.. Parameters: -.. */ -#define MXNSET 16 /* MAX. # OF MAP SETS */ -#define MXNAR 32 /* MAX. # OF AREAS */ -#define MNBPAT 3 /* MIN. BEAM PATCH SIZE */ -#define MXBPAT 128 /* MAX. BEAM PATCH SIZE */ -/* -.. Data declarations: -.. */ -/* -.. NCL common data: -.. */ -struct ncl_com { - union { - char option[24]; /* PROGRAM OPTION */ - char opt[3]; - } option; - int memsiz; /* SIZE OF DYNAMIC MEMORY TO USE */ - char nodmap[80]; /* MAP NODE */ - char filmap[160]; /* MAP FILE */ - int fcamap; /* MAP FCA */ - int msets[17][8]; /* MAP SETS */ - char nodap[80]; /* AP NODE */ - char filap[160]; /* AP FILE */ - int fcaap; /* AP FCA */ - int asets[17][8]; /* AP SETS */ - unsigned int apdcv; /* APPLY DECONVOLUTION */ - int cmplog[2]; /* LOG CODE COMPON_LOG: */ - float cllim; /* CLEAN LIMIT */ - float clfac; /* CLEAN LOOP FACTOR */ - int srclim; /* # OF SOURCES LIMIT */ - int tarea[2][4]; /* TOTAL AREA */ - int parea[2][32][4]; /* PARTIAL AREAS */ - int narea; /* NUMBER OF AREAS */ - float prhat; /* PRUSSIAN HAT VALUE */ - unsigned int resmdl; /* OUTPUT RESIDUAL MODEL SWITCH */ - unsigned int rstmdl; /* RESTORED OUTPUT SWITCH */ - unsigned int ronmdl; /* ONLY RESTORE SWITCH */ - float mpdep; /* CYCLE DEPTH */ - float grfac; /* GRATING FACTOR */ - float datafac; /* DATACLEAN FACTOR */ - float curmax; /* CURRENT MAP MAX. */ - int curmxp[2]; /* POS. CURRENT MAX. */ - int mapnam[8]; /* CURRENT MAP NAME */ - int apnam[8]; /* CURRENT AP NAME */ - int bempat; /* SIZE BEAM PATCH */ - int mappat; /* # OF POINTS IN MAP PATCH */ - float maplim; /* MAP DATA LIMIT IN PATCH */ - float clbxlm; /* MAX. CORRECTION OUTSIDE PATCH */ - int curpmx; /* CURRENT MAX. POINTER */ - float minlim; /* MAP INPUT MAXIMUM */ - int cvbfu; /* U CONVOLUTION FUNCTION ptr */ - int cvbfv; /* V CONVOLUTION FUNCTION ptr */ - float resdl; /* RESTORE BEAM L */ - float resdm; /* RESTORE BEAM M */ - float resdan; /* RESTORE BEAM SKEW ANGLE */ - int mphad; /* MAP HISTOGRAM AREA ptr */ - int bmhad; /* BEAM HISTOGRAM AREA ptr */ - float mphmxi; /* MAX. IN MAP HISTOGRAM */ -}; -/* -.. NCL common block: -.. */ -extern struct ncl_com ncl_com_ ; -/* -.. Given statements: -.. */ -/*- */ diff --git a/src/wng/ncomp.com b/src/wng/ncomp.com deleted file mode 100755 index 21973f15a64a479335bf89f3766fe16975691df0..0000000000000000000000000000000000000000 --- a/src/wng/ncomp.com +++ /dev/null @@ -1,494 +0,0 @@ -$!# ncomp.ssc -$!# WNB 920908 -$!# -$!# Revisions: -$!# WNB 920917 Make shells executable -$!# WNB 920922 Add l switch to ar -$!# Add .fun type -$!# WNB 921002 Overhaul -$!# JPH 921009 Make $WNG_LINK work. - Remove all target files for .dsc -$!# and .for compilations -$!# WNB 921012 Some typo's -$!# WNB 921016 Wrong nxup called -$!# WNB 921019 Add copy option -$!# WNB 921021 Suppress listing message; error for .cee -$!# WNB 921104 Error in ppd update -$!# WNB 921113 Postpone ar -$!# Change rm for ppd -$!# Remove empty ngen.ppd, global.ppd -$!# WNB 921113 Use newest wntab -$!# WNB 921113 Correct back -$!# WNB 921122 .err output voor .pin; delete .uin -$!# WNB 921130 Change tr for HP -$!# WNB 921202 Include .pef -$!# WNB 921204 Cater for long HP tlbset -$!# WNB 921208 Change update and log -$!# WNB 921208 Change .def; include dwarf/.inc; create nxldef.sun -$!# WNB 921209 Add -a1, -a2, -a4, -a8 -$!# WNB 921211 Add .PSC -$!# WNB 921215 Typo -$!# WNB 921215 Add FSC, CSC -$!# WNB 921218 Add SSC; site wn_...__ -$!# HjV 921221 Delete -f chmod; typo goto ncERR; changed rm ?* -$!# WNB 921222 Include nonomatch; typo SSC; streamline psc ssc -$!# WNB 921230 Shorter expressions for Alliant; cater NXFOR.SSC -$!# WNB 921230 Make SSC; add some messages -$!# JPH 930224 Prefix ${cwd}/ to file name in ln -s commands -$!# WNB 930303 Change to SYS_BLD (VAX) -$!# Copy NXLDEF to shadow directory at NCDF. -$!# WNB 930308 Forgot to delete shadowtest error -$!# WNB 930330 Add .A.. and .X..; wn_gipsy__, wn_pgplot__ -$!# WNB 930402 Make logical link from .inc to .h locally only -$!# WNB 930413 Typo NCEXE label -$!# WNB 930517 Remove pgplot; put objects in WNG_OLB -$!# WNB 930802 Change WNTAB into WNTINC -$!# WNB 930803 Add .dsf -$!# -$!# Note: This file contains a series of sed commands. By -$!# transferring by mail some characters can be -$!# lost. Make especially sure about the []. -$!# All "empty" ones contain <space><tab>, i.e. -$!# [ ] -$!# -$!# Compile routines in nxec system. Use as: -$!# -$!# source $WNG/ncomp.sun (Unix) -$!# @WNG:NCOMP <file> (VAX) -$!# -$!# This file uses many local variables set in nxec, and the -$!# environment variables: -$!# WNG, EXEDWARF_UNIX, WNG_OLB, WNG_OLBEXE, WNG_LIS, WNG_ERR -$!# and command files nxup, wngfex, -$!# and programs wntinc, sys_bldppd -$!# -$!# Compile a file. -$!# -$ ON ERROR THEN GOTO ERR -$ IF F$SEARCH(P1) .EQS. "" THEN GOTO ERR !CANNOT DO -$ IF F$PARSE(P1,,,"DEVICE","SYNTAX_ONLY")+ - - F$PARSE(P1,,,"DIRECTORY","SYNTAX_ONLY") .NES. - - F$ENVIRONMENT("DEFAULT") !NOT IN CURRENT DIR. -$ THEN -$ COPY 'F$EXTRACT(0,F$LOCATE(";",P1),P1)' [] !COPY FILE -$ IF F$SEARCH("''FNM'''FTP'") .EQS. "" THEN GOTO ERR -$ MSGT=MSGT+ " copied" -$ ENDIF -$ PURGE/KEEP=2 'FNM''FTP' !PURGE AS YOU GO -$!# -$!# Change files (-An switch) -$!# -$ IF CD_A .NES. "-" .AND. CD_A .GT. 0 !SWITCH GIVEN -$ THEN -$ IF F$LENGTH(FTP) .EQ. 4 .AND. - - (F$EXTRACT(0,2,FTP) .EQS. ".F" .OR. - - FTP .EQS. ".DEF" .OR. (FTP .EQS. ".INC" .AND. - - CWDT .EQS. "[DWARF]")) !FORTRAN -$ THEN -$ IF F$SEARCH("''FNM'.TMP") .NES. "" THEN - - DELETE 'FNM'.TMP;* !MAKE SURE -$ CLOSE/ERROR=LB21 AF'PID''DEP' !OPEN INPUT -$ LB21: CLOSE/ERROR=LB20 AT'PID''DEP' !OPEN OUTPUT -$ LB20: OPEN/ERROR=ERR/READ AF'PID''DEP' 'FNM''FTP' -$ OPEN/ERROR=ERR/WRITE AT'PID''DEP' 'FNM'.TMP -$ LP20: READ/ERROR=ERR/END=LP21 AF'PID''DEP' L0 !READ LINE -$ IF F$EXTRACT(0,1,L0) .NES. " " .AND. - - F$EXTRACT(0,1,L0) .NES. " " THEN GOTO LP22 !NO -$ L1=F$EDIT(L0,"UNCOMMENT,UPCASE,COLLAPSE") !FOR EASY SEARCH -$ IF F$EXTRACT(0,8,L1) .NES. "INCLUDE'" THEN GOTO LP23 !NOT INCLUDE -$ IF 2*(CD_A/2)-CD_A .NE. 0 !LOOK FOR () -$ THEN -$ IF F$EXTRACT(8,1,L1) .EQS. "(" !FOUND -$ THEN -$ L2=F$LOCATE(")",L0) -$ L0=F$EDIT(F$EXTRACT(0,L2,L0),"UPCASE")+ - - F$EXTRACT(L2,-1,L0)-"("-")" !MAKE NEW -$ L1=F$EDIT(L0,"UNCOMMENT,UPCASE,COLLAPSE") !FOR EASY SEARCH -$ ENDIF -$ ENDIF -$ IF CD_A-(4*(CD_A/4)) .GT. 1 !CHANGE DEF -$ THEN -$ IF F$LOCATE(":",F$EXTRACT(8,-1,L1)) .LT. - - F$LOCATE("'",F$EXTRACT(8,-1,L1)) !FOUND -$ THEN -$ L2=F$LOCATE(":",L0)+1 -$ L3=F$LOCATE("'",L0)+1 -$ L4=F$LOCATE("'",F$EXTRACT(L2,-1,L0)) -$ L0=F$EDIT(F$EXTRACT(0,L3,L0),"UPCASE")+ - - F$EDIT(F$EXTRACT(L2,L4,L0),"UPCASE")+ - - F$EXTRACT(L2+L4,-1,L0) -$ L1=F$EDIT(L0,"UNCOMMENT,UPCASE,COLLAPSE") !FOR EASY SEARCH -$ ENDIF -$ IF F$LOCATE(".DEF'",F$EXTRACT(8,-1,L1)) .LT. - - F$LOCATE("'",F$EXTRACT(8,-1,L1)) !FOUND . -$ THEN -$ L2=F$LOCATE(".",L0) -$ L3=F$LOCATE("'",F$EXTRACT(L2,-1,L0)) -$ L0=F$EDIT(F$EXTRACT(0,L2,L0)+"_"+ - - F$EXTRACT(L2+1,L3,L0),"UPCASE")+ - - F$EXTRACT(L2+L3+1,-1,L0) -$ ENDIF -$ ENDIF -$ GOTO LP22 !READY INCLUDE -$ LP23: IF CD_A-(8*(CD_A/8)) .GT. 3 !CHANGE *4 *8 -$ THEN -$ IF F$EXTRACT(0,6,L1) .EQS. "REAL*4" .OR. - - F$EXTRACT(0,9,L1) .EQS. "INTEGER*4" -$ THEN -$ L2=F$LOCATE("*",L0) -$ L3=F$LOCATE("4",L0) -$ L0=F$EXTRACT(0,L2,L0)+F$EXTRACT(L3+1,-1,L0) -$ ENDIF -$ IF F$EXTRACT(0,6,L1) .EQS. "REAL*8" -$ THEN -$ L2=F$LOCATE("R",L0) -$ IF F$LOCATE("r",L0) .LT. L2 THEN L2=F$LOCATE("r",L0) -$ L3=F$LOCATE("8",L0) -$ L0=F$EXTRACT(0,L2,L0)+"DOUBLE PRECISION"+ - - F$EXTRACT(L3+1,-1,L0) -$ ENDIF -$ IF F$EXTRACT(0,9,L1) .EQS. "LOGICAL*1 -$ THEN -$ L2=F$LOCATE("L",L0) -$ IF F$LOCATE("l",L0) .LT. L2 THEN L2=F$LOCATE("l",L0) -$ L3=F$LOCATE("1",L0) -$ L0=F$EXTRACT(0,L2,L0)+"BYTE"+ - - F$EXTRACT(L3+1,-1,L0) -$ ENDIF -$ ENDIF -$ LP22: WRITE/ERROR=ERR AT'PID''DEP' L0 !COPY -$ GOTO LP20 !NEXT -$ LP21: CLOSE/ERROR=ERR AT'PID''DEP' !CLOSE OUTPUT -$ CLOSE/ERROR=ERR AF'PID''DEP' !CLOSE INPUT -$ COPY 'FNM'.TMP 'FNM''FTP' !NEW VERSION -$ DELETE 'FNM'.TMP;* -$ ENDIF -$ IF F$LENGTH(FTP) .EQ. 4 .AND. - - ((F$EXTRACT(0,2,FTP) .EQS. ".C" .AND. - - FTP .NES. ".COM") .OR. - - (FTP .EQS. ".INC" .AND. CWDT .NES. "[DWARF]")) .AND. - - CD_A-(4*(CD_A/4)) .GT. 1 !C -$ THEN -$ IF F$SEARCH("''FNM'.TMP") .NES. "" THEN - - DELETE 'FNM'.TMP;* !MAKE SURE -$ CLOSE/ERROR=LB31 AF'PID''DEP' !OPEN INPUT -$ LB31: CLOSE/ERROR=LB30 AT'PID''DEP' !OPEN OUTPUT -$ LB30: OPEN/ERROR=ERR/READ AF'PID''DEP' 'FNM''FTP' -$ OPEN/ERROR=ERR/WRITE AT'PID''DEP' 'FNM'.TMP -$ LP30: READ/ERROR=ERR/END=LP31 AF'PID''DEP' L0 !READ LINE -$ L1=F$EDIT(L0,"UNCOMMENT,COLLAPSE") !FOR EASY SEARCH -$ IF F$EXTRACT(0,9,L1) .EQS. "#include""" .AND. - - F$LOCATE(".inc""",L1) .LT. F$LENGTH(L1) !DO .INC -$ THEN -$ L2=F$LOCATE(".inc",L0) -$ L0=F$EXTRACT(0,L2,L0)+"_"+F$EXTRACT(L2+1,-1,L0) -$ ENDIF -$ WRITE/ERROR=ERR AT'PID''DEP' L0 !COPY -$ GOTO LP30 !NEXT -$ LP31: CLOSE/ERROR=ERR AT'PID''DEP' !CLOSE OUTPUT -$ CLOSE/ERROR=ERR AF'PID''DEP' !CLOSE INPUT -$ COPY 'FNM'.TMP 'FNM''FTP' !NEW VERSION -$ DELETE 'FNM'.TMP;* -$ ENDIF -$ ENDIF -$!# -$!# Compile -$!# -$ IF CD_C .NES. "-" !COMPILE -$ THEN -$ IF IQ_D .NES. "" THEN IQ_D=IQ_D+"+" !INCLUDE FILES -$ IF JQ_D .NES. "" THEN JQ_D=JQ_D+"+" !INCLUDE FILES -$ IF FTP .EQS. ".FSC" THEN GOSUB FSC !FSC -$ IF FTP .EQS. ".FOR" .OR. FTP .EQS. ".FVX" THEN GOSUB FOR !FORTRAN -$ IF FTP .EQS. ".CSC" THEN GOSUB CSC !CSC -$ IF FTP .EQS. ".MVX" THEN GOSUB MAC !MACRO -$ IF FTP .EQS. ".SSC" THEN GOSUB SSC !SSC -$ IF FTP .EQS. ".HLP" THEN GOSUB HLP !HELP -$ IF FTP .EQS. ".DSC" THEN GOSUB DSC !DSC -$ IF FTP .EQS. ".DEF" .OR. FTP .EQS. ".PEF" .OR. - - FTP .EQS. ".DSF" THEN GOSUB DEF ! DEF/PEF/DSF -$ IF FTP .EQS. ".INC" THEN GOSUB DEF !INC -$ IF FTP .EQS. ".PSC" THEN GOSUB PSC !PSC -$ IF FTP .EQS. ".PIN" THEN GOSUB PIN !PIN -$ IF FTP .EQS. ".AVX" THEN GOSUB ALB !SPECIAL OLB -$ IF FTP .EQS. ".XVX" THEN GOSUB XEX !SPECIAL EXE -$ ENDIF -$ GOSUB OTH !ALL OTHERS -$ GOTO ERR1 -$!# -$!# Others -$!# -$ OTH: IF CD_P .NES. "-" .AND. MSGT-"printed" .EQS. MSGT .AND. - - F$EXTRACT(1,1,FTP) .NES. "A" .AND. - - F$EXTRACT(1,1,FTP) .NES. "X" !PRINT -$ THEN -$ @WNG:WNGFEX "SP" 'FNM''FTP' 'FNM''FTP' -$ MSGT=MSGT+" printed" -$ ENDIF -$ IF CD_L .EQS. "0" !LIBRARY -$ THEN -$ IF F$EXTRACT(1,1,FTP) .EQS. "A" .OR. - - F$EXTRACT(1,1,FTP) .EQS. "X" -$ THEN -$ LIBRARY/TEXT 'WNG_TLB''L_D'_AX.TLB 'P1'/MODULE='FNM''FTP' !SET LIB. -$ MSGT=MSGT+" [''F$PARSE(L_D,,,"NAME","SYNTAX_ONLY")'_AX.TLB]" -$ ELSE -$ LIBRARY/TEXT 'WNG_TLB''L_D'.TLB 'P1'/MODULE='FNM''FTP' !SET IN LIB. -$ MSGT=MSGT+" [''F$PARSE(L_D,,,"NAME","SYNTAX_ONLY")'.TLB]" -$ ENDIF -$ ENDIF -$ RETURN -$!# -$!# Exit -$!# -$ ERR: B1="Not: " -$ CLOSE/ERROR=ERR6 NXFO'PID''DEP' -$ ERR6: CLOSE/ERROR=ERR5 NXPO'PID''DEP' -$ ERR5: CLOSE/ERROR=ERR4 AT'PID''DEP -$ ERR4: CLOSE/ERROR=ERR3 AF'PID''DEP -$ ERR3: CLOSE/ERROR=ERR2 NXL1'PID''DEP' -$ ERR2: CLOSE/ERROR=ERR1 NXL'PID''DEP' !MAKE SURE -$ ERR1: TELL B1+FNM+FTP+MSGT -$ UTELL B1+FNM+FTP+MSGT -$ EXIT: EXIT -$!# -$!# Fortran -$!# -$ FOR: FORTRAN/LIST='WNG_LIS''FNM'/OBJECT='FNM''FQ_D' 'JQ_D''FNM''FTP' -$ FOR1: IF $STATUS/%X1000 .EQ. %X38 THEN GOTO ERR !DCL WARNING -$ IF F$SEARCH("''FNM'.OBJ") .EQS. "" THEN GOTO ERR -$ MSGT=MSGT+" compiled" -$ IF CD_L .NES. "-" !TO LIB. -$ THEN -$ LIBRARY 'WNG_OLB''L_D'.OLB 'FNM'.OBJ -$ MSGT=MSGT+" [''F$PARSE(L_D,,,"NAME","SYNTAX_ONLY")'.OLB]" -$ ENDIF -$ IF CD_L .NES. "-" !DELETE -$ THEN -$ DELETE 'FNM'.OBJ;* -$ ELSE -$ PURGE 'FNM'.OBJ -$ ENDIF -$ PURGE 'WNG_LIS''FNM'.LIS -$ IF CD_P .NES. "-" !PRINT -$ THEN -$ @WNG:WNGFEX "SP" 'WNG_LIS''FNM'.LIS 'FNM''FTP' -$ MSGT=MSGT+" printed" -$ ENDIF -$ RETURN -$!# -$!# Macro -$!# -$ MAC: MACRO/LIST='WNG_LIS''FNM'/OBJECT='FNM''MQ_D' 'IQ_D''FNM''FTP' -$ GOTO FOR1 -$!# -$!# C -$!# -$!# -$!# Help -$!# -$ HLP: IF F$SEARCH("''WNG_TLB'''FNM'.HLB") .EQS. "" THEN - - LIBRARY/HELP/CREATE 'WNG_TLB''FNM'.HLB !CREATE HELP LIB -$ IF F$SEARCH("''WNG_TLB'''FNM'.HLB") .EQS. "" THEN GOTO ERR -$ IF CD_L .EQS. "0" -$ THEN -$ LIBRARY/HELP 'WNG_TLB''FNM'.HLB 'FNM''FTP' !SET IN LIBRARY -$ MSGT=MSGT+" [''FNM'.HLB]" -$ ENDIF -$ IF CD_U .NES. "-" .AND. F$TRNLNM("EXEDWARF") .NES. "" .AND. - - F$TRNLNM("LIBDWARF") .NES. "" !UPDATE -$ THEN -$ @WNG:NXUP "15" "''U_D'" "''P1'" "''FNM'" "" !UPDATE -$ MSGT=MSGT+" updated(''U_D')" -$ ENDIF -$ RETURN -$!# -$!# DSC -$!# -$ DSC: IF F$SEARCH("WNG:WNTINC.EXE") .EQS. "" THEN GOTO ERR !CANNOT DO -$ WNT="$WNG:WNTINC" !COMMAND TO DO -$ WNT 'FNM' -$ MSGT=MSGT+" compiled" -$ IF CD_P .NES. "-" !PRINT -$ THEN -$ @WNG:WNGFEX "SP" 'FNM'.LIS 'FNM'.LIS -$ MSGT=MSGT+" printed" -$ ENDIF -$ DIR/VERSION=1/NOHEAD/NOTRAIL/COL=1/OUT='FNM''PID'.TMP - - 'FNM'.DEF,'FNM'_BD.FOR,'FNM'.INC,'FNM'_%.* -$ DSC1: -$ L00="" !ADD YNZ -$ L01=0 -$ LP17: IF F$EXTRACT(L01,1,CODES) .EQS. "Y" -$ THEN -$ L00=L00+"0" -$ ELSE -$ IF F$EXTRACT(L01,1,CODES) .EQS. "Z" -$ THEN -$ L00=L00+"-" -$ ELSE -$ L00=L00+CD_'F$EXTRACT(L01,1,CODES)' -$ ENDIF -$ ENDIF -$ L01=L01+1 -$ IF L01 .LT. F$LENGTH(CODES) THEN GOTO LP17 -$ @WNG:NXEC X2 'PNAM' 'PCOD' 'DEP' "''L00'" "''FG_CX'" - - 'FNM''PID'.TMP !DO REST -$ IF F$SEARCH("''FNM'''PID'.TMP") .NES. "" THEN - - DELETE 'FNM''PID'.TMP;* -$ RETURN -$!# -$!# CSC -$!# -$ CSC: -$ L1="" -$ IF F$SEARCH("WNG_OLBEXE:[WNG]GIPLIB.OLB") .NES. "" THEN - - L1=L1+"/DEF="""wn_gipsy__""" -$ CC/LIST='WNG_LIS''FNM'/OBJECT='FNM''CQ_D'/DIAG='WNG_ERR''FNM'.ERR - - /DEF="wn_vx__"/DEF="wn_''WNG_SITE'__"'L1' - - 'FNM''FTP' !COMP. -$ GOTO FOR1 -$!# -$!# SSC -$!# -$ SSC: -$ IF F$SEARCH("''WNG_ERR'''FNM'.ERR") .NES. "" THEN - - DELETE 'WNG_ERR''FNM'.ERR;* -$ L01=F$SEARCH("WNG:NXFOR.COM") !SAVE COMMAND -$ OPEN/ERROR=ERR/WRITE NXFO'PID''DEP' 'FNM'.COM !CREATE OUTPUT -$ @'L01' 'FNM''FTP' NXFO'PID''DEP' 'WNG_ERR''FNM'.ERR VAX -$ CLOSE/ERROR=ERR NXFO'PID''DEP' -$ OPEN/ERROR=ERR/WRITE NXFO'PID''DEP' 'FNM'.SUN !CREATE OUTPUT -$ @'L01' 'FNM''FTP' NXFO'PID''DEP' 'WNG_ERR''FNM'.ERR UNIX -$ CLOSE/ERROR=ERR NXFO'PID''DEP' -$ IF F$SEARCH("''FNM'.COM") .NES. "" THEN PURGE/KEEP=2 'FNM'.COM -$ IF F$SEARCH("''FNM'.SUN") .NES. "" THEN PURGE 'FNM'.SUN -$ IF F$SEARCH("''WNG_ERR'''FNM'.ERR") .NES. "" THEN GOTO ERR !ERROR -$ MSGT=MSGT+" compiled" -$ DIR/VERSION=1/NOHEAD/NOTRAIL/COL=1/OUT='FNM''PID'.TMP - - 'FNM'.COM,'FNM'.SUN -$ GOTO DSC1 -$!# -$!# FSC -$!# -$ FSC: -$ IF F$SEARCH("''WNG_ERR'''FNM'.ERR") .NES. "" THEN - - DELETE 'WNG_ERR''FNM'.ERR;* -$ OPEN/ERROR=ERR/WRITE NXFO'PID''DEP' 'FNM'.FOR !CREATE OUTPUT -$ @WNG:NXFOR 'FNM''FTP' NXFO'PID''DEP' 'WNG_ERR''FNM'.ERR -$ CLOSE/ERROR=ERR NXFO'PID''DEP' -$ IF F$SEARCH("''FNM'.FOR") .NES. "" THEN PURGE 'FNM'.FOR -$ IF F$SEARCH("''WNG_ERR'''FNM'.ERR") .NES. "" THEN GOTO ERR !ERROR -$ FORTRAN/LIST='WNG_LIS''FNM'/OBJECT='FNM''FQ_D' 'JQ_D''FNM'.FOR !COMP. -$ GOTO FOR1 -$!# -$!# PSC -$!# -$ PSC: -$ IF F$SEARCH("''WNG_ERR'''FNM'.ERR") .NES. "" THEN - - DELETE 'WNG_ERR''FNM'.ERR;* -$ OPEN/ERROR=ERR/WRITE NXPO'PID''DEP' 'FNM'.PIN !CREATE OUTPUT -$ @WNG:NXPIN 'FNM''FTP' NXPO'PID''DEP' 'WNG_ERR''FNM'.ERR -$ CLOSE/ERROR=ERR NXPO'PID''DEP' -$ IF F$SEARCH("''FNM'.PIN") .NES. "" THEN PURGE 'FNM'.PIN -$ IF F$SEARCH("''WNG_ERR'''FNM'.ERR") .NES. "" THEN GOTO ERR !ERROR -$ MSGT=MSGT+" compiled" -$ DIR/VERSION=1/NOHEAD/NOTRAIL/COL=1/OUT='FNM''PID'.TMP - - 'FNM'.PIN -$ GOTO DSC1 -$!# -$!# PIN -$!# -$ PIN: L0="13" !UPDATE CODE -$ L1="PPD" !TYPE -$ L2="=(COMP)" !LIST TYPE -$ PIN2: L3="$RUNDWARF:SYS_BLD''L1'.EXE" !PROGRAM -$ ASSIGN/USER 'WNG_ERR''FNM'.ERR SYS$OUTPUT -$ L3 'FNM'/LIST'L2' !DO -$ IF F$SEARCH("''FNM'.LIS") .EQS. "" .OR. - - F$SEARCH("''FNM'.''L1'") .EQS. "" THEN GOTO ERR -$ MSGT=MSGT+" compiled" -$ PURGE 'FNM'.LIS,'FNM'.'L1' -$ COPY 'FNM'.LIS 'WNG_LIS''FNM'.LIS -$ PURGE 'WNG_LIS''FNM'.LIS -$ COPY 'FNM'.'L1' 'WNG_EXE' -$ PURGE 'WNG_EXE''FNM'.'L1' -$ IF CD_U .NES. "-" .AND. F$TRNLNM("EXEDWARF") .NES. "" !UPDATE -$ THEN -$ @WNG:NXUP "''L0'" "''U_D'" "''FNM'.''L1'" "''FNM'" "" -$ MSGT=MSGT+" updated(''U_D')" -$ ENDIF -$ IF CD_P .NES. "-" !PRINT -$ THEN -$ @WNG:WNGFEX "SP" 'WNG_LIS''FNM'.LIS 'FNM''FTP' -$ MSGT=MSGT+" printed" -$ ENDIF -$ RETURN -$!# -$!# def -$!# -$ DEF: -$ LOA="" !DO NOT -$ IF FTP .EQS. ".INC" .AND. CWDT .EQS. "[DWARF]" THEN - - LOA="''FNM'" !WHAT -$ IF FTP .EQS. ".INC" .AND. CWDT .NES. "[DWARF]" THEN - - LOA="''FNM'_''FTP'"-"." -$ IF FTP .EQS. ".DEF" .OR. FTP .EQS. ".PEF" .OR. FTP .EQS. ".DSF" THEN - - LOA="''FNM'_''FTP'"-"." -$ IF LOA .NES. "" -$ THEN -$ IF CD_U .NES. "-" !UPDATE -$ THEN -$ LOB="WNG_DIR:''CWDT'''FNM'''FTP'" !FILE NAME -$ ASSIGN/NOLOG "''LOB'" 'LOA' -$ IF F$SEARCH("WNG:NXLDEF.COM") .EQS. "" -$ THEN -$ OPEN/ERROR=ERR/WRITE NXL'PID''DEP' WNG:NXLDEF.COM -$ WRITE/ERROR=ERR NXL'PID''DEP' "$ !01 NXLDEF.COM" -$ WRITE/ERROR=ERR NXL'PID''DEP' "$ !02 WNB ''C_DATE'" -$ WRITE/ERROR=ERR NXL'PID''DEP' "$ !03" -$ WRITE/ERROR=ERR NXL'PID''DEP' "$ !04 Revisions: " -$ WRITE/ERROR=ERR NXL'PID''DEP' "$ !05 Automatic by NCOMP" -$ WRITE/ERROR=ERR NXL'PID''DEP' "$ !06" -$ WRITE/ERROR=ERR NXL'PID''DEP' - - "$ !07 Logical names for all include files" -$ WRITE/ERROR=ERR NXL'PID''DEP' "$ !08" -$ WRITE/ERROR=ERR NXL'PID''DEP' "$ ASSIGN/NOLOG QQ WNG_TLD !Test" -$ CLOSE/ERROR=ERR NXL'PID''DEP' -$ ENDIF -$ OPEN/ERROR=ERR/READ NXL'PID''DEP' WNG:NXLDEF.COM !INPUT -$ OPEN/ERROR=ERR/WRITE NXL1'PID''DEP' NXL'PID''DEP'.TMP !OUTPUT -$ LP19: READ/ERROR=ERR/END=LP18 NXL'PID''DEP' L0 !READ LINE -$ IF F$LOCATE(LOA,L0) .EQS. F$LENGTH(L0) THEN - - WRITE/ERROR=ERR NXL1'PID''DEP' L0 !COPY -$ GOTO LP19 -$ LP18: L0="$ ASSIGN/NOLOG "+""""+"''LOB'"+""""+" ''LOA' ! ''C_DATE'" -$ WRITE/ERROR=ERR NXL1'PID''DEP' L0 -$ CLOSE/ERROR=ERR NXL'PID''DEP' -$ CLOSE/ERROR=ERR NXL1'PID''DEP' -$ SORT NXL'PID''DEP'.TMP WNG:NXLDEF.COM -$ DELETE NXL'PID''DEP'.TMP;* -$ PURGE WNG:NXLDEF.COM -$ MSGT=MSGT+" updated(''U_D')" -$ ELSE -$ LOB="''FNM'''FTP'" !FILE NAME -$ ASSIGN/NOLOG "''LOB'" 'LOA' -$ ENDIF -$ ENDIF -$ RETURN -$!# -$!# Special olb -$!# -$ ALB: COPY 'FNM''FTP' 'WNG_OLB''FNM'.OLB !MAKE PROPER LIBRARY -$ PURGE 'WNG_OLB''FNM'.OLB -$ MSGT=MSGT+" compiled" -$ RETURN -$!# -$!# Special exe -$!# -$ XEX: COPY 'FNM''FTP' WNG:'FNM'.EXE !MAKE PROPER EXE -$ PURGE WNG:'FNM'.EXE -$ MSGT=MSGT+" compiled" -$ RETURN -$!# -$!# Exit -$!# diff --git a/src/wng/ncomp.ssc b/src/wng/ncomp.ssc deleted file mode 100644 index 8a1cd4565274eea4dbe1926055a5297d1011411d..0000000000000000000000000000000000000000 --- a/src/wng/ncomp.ssc +++ /dev/null @@ -1,1011 +0,0 @@ -# ncomp.ssc -# WNB 920908 -# -# Revisions: -# WNB 920917 Make shells executable -# WNB 920922 Add l switch to ar -# Add .fun type -# WNB 921002 Overhaul -# JPH 921009 Make $WNG_LINK work. - Remove all target files for .dsc -# and .for compilations -# WNB 921012 Some typo's -# WNB 921016 Wrong nxup called -# WNB 921019 Add copy option -# WNB 921021 Suppress listing message; error for .cee -# WNB 921104 Error in ppd update -# WNB 921113 Postpone ar -# Change rm for ppd -# Remove empty ngen.ppd, global.ppd -# WNB 921113 Use newest wntab -# WNB 921113 Correct back -# WNB 921122 .err output voor .pin; delete .uin -# WNB 921130 Change tr for HP -# WNB 921202 Include .pef -# WNB 921204 Cater for long HP tlbset -# WNB 921208 Change update and log -# WNB 921208 Change .def; include dwarf/.inc; create nxldef.sun -# WNB 921209 Add -a1, -a2, -a4, -a8 -# WNB 921211 Add .PSC -# WNB 921215 Typo -# WNB 921215 Add FSC, CSC -# WNB 921218 Add SSC; site wn_...__ -# HjV 921221 Delete -f chmod; typo goto ncERR; changed rm ?* -# WNB 921222 Include nonomatch; typo SSC; streamline psc ssc -# WNB 921230 Shorter expressions for Alliant; cater NXFOR.SSC -# WNB 921230 Make SSC; add some messages -# JPH 930224 Prefix ${cwd}/ to file name in ln -s commands -# WNB 930303 Change to SYS_BLD (VAX) -# Copy NXLDEF to shadow directory at NCDF. -# WNB 930308 Forgot to delete shadowtest error -# WNB 930330 Add .A.. and .X..; wn_gipsy__, wn_pgplot__ -# WNB 930402 Make logical link from .inc to .h locally only -# WNB 930413 Typo NCEXE label -# WNB 930517 Remove pgplot; put objects in WNG_OLB -# WNB 930802 Change WNTAB into WNTINC -# WNB 930803 Add .dsf -# -# Note: This file contains a series of sed commands. By -# transferring by mail some characters can be -# lost. Make especially sure about the []. -# All "empty" ones contain <space><tab>, i.e. -# [ ] -# -# Compile routines in nxec system. Use as: -# -# source $WNG/ncomp.sun (Unix) -# @WNG:NCOMP <file> (VAX) -# -# This file uses many local variables set in nxec, and the -# environment variables: -# WNG, EXEDWARF_UNIX, WNG_OLB, WNG_OLBEXE, WNG_LIS, WNG_ERR -# and command files nxup, wngfex, -# and programs wntinc, sys_bldppd -# -# Compile a file. -# -#ifdef wn_vax__ -$ ON ERROR THEN GOTO ERR -$ IF F$SEARCH(P1) .EQS. "" THEN GOTO ERR !CANNOT DO -$ IF F$PARSE(P1,,,"DEVICE","SYNTAX_ONLY")+ - - F$PARSE(P1,,,"DIRECTORY","SYNTAX_ONLY") .NES. - - F$ENVIRONMENT("DEFAULT") !NOT IN CURRENT DIR. -$ THEN -$ COPY 'F$EXTRACT(0,F$LOCATE(";",P1),P1)' [] !COPY FILE -$ IF F$SEARCH("''FNM'''FTP'") .EQS. "" THEN GOTO ERR -$ MSGT=MSGT+ " copied" -$ ENDIF -$ PURGE/KEEP=2 'FNM''FTP' !PURGE AS YOU GO -#else - set msgt="" ; set b1="Done: " # message text/ok - if (! -e ${lobh}.$lobe) goto NCERR # not present - if ("$lobh:t" != "$lobh") then # copy first - 'cp' ${lobh}.$lobe $lobh:t.$lobe - set msgt="$msgt copied [$lobh:h]" - set lobh=$lobh:t - endif -#endif -# -# Change files (-An switch) -# -#ifdef wn_vax__ -$ IF CD_A .NES. "-" .AND. CD_A .GT. 0 !SWITCH GIVEN -$ THEN -$ IF F$LENGTH(FTP) .EQ. 4 .AND. - - (F$EXTRACT(0,2,FTP) .EQS. ".F" .OR. - - FTP .EQS. ".DEF" .OR. (FTP .EQS. ".INC" .AND. - - CWDT .EQS. "[DWARF]")) !FORTRAN -$ THEN -$ IF F$SEARCH("''FNM'.TMP") .NES. "" THEN - - DELETE 'FNM'.TMP;* !MAKE SURE -$ CLOSE/ERROR=LB21 AF'PID''DEP' !OPEN INPUT -$ LB21: CLOSE/ERROR=LB20 AT'PID''DEP' !OPEN OUTPUT -$ LB20: OPEN/ERROR=ERR/READ AF'PID''DEP' 'FNM''FTP' -$ OPEN/ERROR=ERR/WRITE AT'PID''DEP' 'FNM'.TMP -$ LP20: READ/ERROR=ERR/END=LP21 AF'PID''DEP' L0 !READ LINE -$ IF F$EXTRACT(0,1,L0) .NES. " " .AND. - - F$EXTRACT(0,1,L0) .NES. " " THEN GOTO LP22 !NO -$ L1=F$EDIT(L0,"UNCOMMENT,UPCASE,COLLAPSE") !FOR EASY SEARCH -$ IF F$EXTRACT(0,8,L1) .NES. "INCLUDE'" THEN GOTO LP23 !NOT INCLUDE -$ IF 2*(CD_A/2)-CD_A .NE. 0 !LOOK FOR () -$ THEN -$ IF F$EXTRACT(8,1,L1) .EQS. "(" !FOUND -$ THEN -$ L2=F$LOCATE(")",L0) -$ L0=F$EDIT(F$EXTRACT(0,L2,L0),"UPCASE")+ - - F$EXTRACT(L2,-1,L0)-"("-")" !MAKE NEW -$ L1=F$EDIT(L0,"UNCOMMENT,UPCASE,COLLAPSE") !FOR EASY SEARCH -$ ENDIF -$ ENDIF -$ IF CD_A-(4*(CD_A/4)) .GT. 1 !CHANGE DEF -$ THEN -$ IF F$LOCATE(":",F$EXTRACT(8,-1,L1)) .LT. - - F$LOCATE("'",F$EXTRACT(8,-1,L1)) !FOUND -$ THEN -$ L2=F$LOCATE(":",L0)+1 -$ L3=F$LOCATE("'",L0)+1 -$ L4=F$LOCATE("'",F$EXTRACT(L2,-1,L0)) -$ L0=F$EDIT(F$EXTRACT(0,L3,L0),"UPCASE")+ - - F$EDIT(F$EXTRACT(L2,L4,L0),"UPCASE")+ - - F$EXTRACT(L2+L4,-1,L0) -$ L1=F$EDIT(L0,"UNCOMMENT,UPCASE,COLLAPSE") !FOR EASY SEARCH -$ ENDIF -$ IF F$LOCATE(".DEF'",F$EXTRACT(8,-1,L1)) .LT. - - F$LOCATE("'",F$EXTRACT(8,-1,L1)) !FOUND . -$ THEN -$ L2=F$LOCATE(".",L0) -$ L3=F$LOCATE("'",F$EXTRACT(L2,-1,L0)) -$ L0=F$EDIT(F$EXTRACT(0,L2,L0)+"_"+ - - F$EXTRACT(L2+1,L3,L0),"UPCASE")+ - - F$EXTRACT(L2+L3+1,-1,L0) -$ ENDIF -$ ENDIF -$ GOTO LP22 !READY INCLUDE -$ LP23: IF CD_A-(8*(CD_A/8)) .GT. 3 !CHANGE *4 *8 -$ THEN -$ IF F$EXTRACT(0,6,L1) .EQS. "REAL*4" .OR. - - F$EXTRACT(0,9,L1) .EQS. "INTEGER*4" -$ THEN -$ L2=F$LOCATE("*",L0) -$ L3=F$LOCATE("4",L0) -$ L0=F$EXTRACT(0,L2,L0)+F$EXTRACT(L3+1,-1,L0) -$ ENDIF -$ IF F$EXTRACT(0,6,L1) .EQS. "REAL*8" -$ THEN -$ L2=F$LOCATE("R",L0) -$ IF F$LOCATE("r",L0) .LT. L2 THEN L2=F$LOCATE("r",L0) -$ L3=F$LOCATE("8",L0) -$ L0=F$EXTRACT(0,L2,L0)+"DOUBLE PRECISION"+ - - F$EXTRACT(L3+1,-1,L0) -$ ENDIF -$ IF F$EXTRACT(0,9,L1) .EQS. "LOGICAL*1 -$ THEN -$ L2=F$LOCATE("L",L0) -$ IF F$LOCATE("l",L0) .LT. L2 THEN L2=F$LOCATE("l",L0) -$ L3=F$LOCATE("1",L0) -$ L0=F$EXTRACT(0,L2,L0)+"BYTE"+ - - F$EXTRACT(L3+1,-1,L0) -$ ENDIF -$ ENDIF -$ LP22: WRITE/ERROR=ERR AT'PID''DEP' L0 !COPY -$ GOTO LP20 !NEXT -$ LP21: CLOSE/ERROR=ERR AT'PID''DEP' !CLOSE OUTPUT -$ CLOSE/ERROR=ERR AF'PID''DEP' !CLOSE INPUT -$ COPY 'FNM'.TMP 'FNM''FTP' !NEW VERSION -$ DELETE 'FNM'.TMP;* -$ ENDIF -$ IF F$LENGTH(FTP) .EQ. 4 .AND. - - ((F$EXTRACT(0,2,FTP) .EQS. ".C" .AND. - - FTP .NES. ".COM") .OR. - - (FTP .EQS. ".INC" .AND. CWDT .NES. "[DWARF]")) .AND. - - CD_A-(4*(CD_A/4)) .GT. 1 !C -$ THEN -$ IF F$SEARCH("''FNM'.TMP") .NES. "" THEN - - DELETE 'FNM'.TMP;* !MAKE SURE -$ CLOSE/ERROR=LB31 AF'PID''DEP' !OPEN INPUT -$ LB31: CLOSE/ERROR=LB30 AT'PID''DEP' !OPEN OUTPUT -$ LB30: OPEN/ERROR=ERR/READ AF'PID''DEP' 'FNM''FTP' -$ OPEN/ERROR=ERR/WRITE AT'PID''DEP' 'FNM'.TMP -$ LP30: READ/ERROR=ERR/END=LP31 AF'PID''DEP' L0 !READ LINE -$ L1=F$EDIT(L0,"UNCOMMENT,COLLAPSE") !FOR EASY SEARCH -$ IF F$EXTRACT(0,9,L1) .EQS. "#include""" .AND. - - F$LOCATE(".inc""",L1) .LT. F$LENGTH(L1) !DO .INC -$ THEN -$ L2=F$LOCATE(".inc",L0) -$ L0=F$EXTRACT(0,L2,L0)+"_"+F$EXTRACT(L2+1,-1,L0) -$ ENDIF -$ WRITE/ERROR=ERR AT'PID''DEP' L0 !COPY -$ GOTO LP30 !NEXT -$ LP31: CLOSE/ERROR=ERR AT'PID''DEP' !CLOSE OUTPUT -$ CLOSE/ERROR=ERR AF'PID''DEP' !CLOSE INPUT -$ COPY 'FNM'.TMP 'FNM''FTP' !NEW VERSION -$ DELETE 'FNM'.TMP;* -$ ENDIF -$ ENDIF -#else - if ("$cd_a" != "-" && $cd_a > 0) then # switch given - if ("$lobe" =~ f?? || "$lobe" == "def" || \ - ("$lobe" == "inc" && "$cwd:t" == "dwarf")) then # Fortran - if (-e ${lobh}.tmp) then - 'rm' ${lobh}.tmp - endif - if ($cd_a % 2 == 1) then # get rid of () (A1) - set loa="/^[ ][ ]*[Ii][Nn][Cc][Ll][Uu][Dd][Ee]" - set loa="${loa}[ ]*'(/y:${Lowc}:${Upc}:" - set lob="s:^[ ][ ]*INCLUDE[ ]*'(" - set lob="${lob}\([A-Z][A-Z0-9_]*\))': INCLUDE '\1':" - set loc="s:^[ ][ ]*PROGRAM[ ]: SUBROUTINE :" - sed -e "$loa" -e "$lob" -e "$loc" \ - ${lobh}.$lobe > ${lobh}.tmp - 'mv' ${lobh}.tmp ${lobh}.$lobe - endif - if ($cd_a % 4 > 1) then # rid xxx: & . (A2) - set loa="/^[ ][ ]*[Ii][Nn][Cc][Ll][Uu][Dd][Ee]" - set loa="${loa}[ ]*'[A-Za-z][A-Za-z0-9_]*:/" - set loa="${loa}y:${Lowc}:${Upc}:" - set lob="s/^[ ][ ]*INCLUDE[ ]*'" - set lob="${lob}\([A-Z][A-Z0-9_]*\):/ INCLUDE '/" - set loc="/^[ ][ ]*[Ii][Nn][Cc][Ll][Uu][Dd][Ee]" - set loc="${loc}[ ]*'[A-Za-z][A-Za-z0-9_]*\./" - set loc="${loc}y:${Lowc}:${Upc}:" - set loca="/^[ ][ ]*INCLUDE[ ]*'" - set loca="${loca}[A-Z][A-Z0-9_]*\.[Dd][Ee][Ff]'/" - set loca="${loca}y:${Lowc}:${Upc}:" - set lod="s/^[ ][ ]*INCLUDE[ ]*'" - set lod="${lod}\([A-Z][A-Z0-9_]*\)\./ INCLUDE '\1_/" - sed -e "$loa" -e "$lob" -e "$loc" -e "$loca" -e "$lod" \ - ${lobh}.$lobe > ${lobh}.tmp - 'mv' ${lobh}.tmp ${lobh}.$lobe - endif - if ($cd_a % 8 > 3) then # make *4 *8 (A4) - set loa="s:^\([ ][ ]*[Rr][Ee][Aa][Ll]\)" - set loa="${loa}\*4:\1:" - set lob="s:^\([ ][ ]*\)[Rr][Ee][Aa][Ll]" - set lob="${lob}\*8:\1DOUBLE PRECISION:" - set loc="s:^\([ ][ ]*[Ii][Nn][Tt][Ee][Gg][Ee][Rr]\)" - set loc="${loc}\*4:\1:" - set lod="s:^\([ ][ ]*\)[Ll][Oo][Gg][Ii][Cc][Aa][Ll]" - set lod="${lod}\*1:\1BYTE:" - sed -e "$loa" -e "$lob" -e "$loc" -e "$lod" \ - ${lobh}.$lobe > ${lobh}.tmp - 'mv' ${lobh}.tmp ${lobh}.$lobe - endif - endif - if (("$lobe" =~ c?? && "$lobe" != "com") || \ - ("$lobe" == "inc" && "$cwd:t" != "dwarf")) then # C - if (-e ${lobh}.tmp) then - 'rm' ${lobh}.tmp - endif - if ($cd_a % 4 > 1) then # rid . (A2) - set loa="s/^\([ ]*\#include[ ][ ]*"'\"' - set loa="${loa}[a-z][a-z0-9_]*\)\.inc/" - set loa="${loa}\1_inc/" - sed -e "$loa" \ - ${lobh}.$lobe > ${lobh}.tmp - 'mv' ${lobh}.tmp ${lobh}.$lobe - endif - endif - endif -#endif -# -# Compile -# -#ifdef wn_vax__ -$ IF CD_C .NES. "-" !COMPILE -$ THEN -$ IF IQ_D .NES. "" THEN IQ_D=IQ_D+"+" !INCLUDE FILES -$ IF JQ_D .NES. "" THEN JQ_D=JQ_D+"+" !INCLUDE FILES -$ IF FTP .EQS. ".FSC" THEN GOSUB FSC !FSC -$ IF FTP .EQS. ".FOR" .OR. FTP .EQS. ".FVX" THEN GOSUB FOR !FORTRAN -$ IF FTP .EQS. ".CSC" THEN GOSUB CSC !CSC -$ IF FTP .EQS. ".MVX" THEN GOSUB MAC !MACRO -$ IF FTP .EQS. ".SSC" THEN GOSUB SSC !SSC -$ IF FTP .EQS. ".HLP" THEN GOSUB HLP !HELP -$ IF FTP .EQS. ".DSC" THEN GOSUB DSC !DSC -$ IF FTP .EQS. ".DEF" .OR. FTP .EQS. ".PEF" .OR. - - FTP .EQS. ".DSF" THEN GOSUB DEF ! DEF/PEF/DSF -$ IF FTP .EQS. ".INC" THEN GOSUB DEF !INC -$ IF FTP .EQS. ".PSC" THEN GOSUB PSC !PSC -$ IF FTP .EQS. ".PIN" THEN GOSUB PIN !PIN -$ IF FTP .EQS. ".AVX" THEN GOSUB ALB !SPECIAL OLB -$ IF FTP .EQS. ".XVX" THEN GOSUB XEX !SPECIAL EXE -$ ENDIF -$ GOSUB OTH !ALL OTHERS -$ GOTO ERR1 -#else - if ("$cd_c" == "-") goto NCG2 # no compile - if ($lobe == fsc || $lobe == fun) then - goto NCFS # FSC - else if ($lobe == for || $lobe == f$ext) then - goto NCF # Fortran - else if ($lobe == csc || $lobe == cun) then - goto NCCS # CSC - else if ($lobe == cee || $lobe == c$ext) then - goto NCC # C - else if ($lobe == m$ext) then - goto NCM # Macro - else if ($lobe == ssc) then - goto NCSS # SSC - else if ($lobe == hlp) then - goto NCH # Help - else if ($lobe == dsc) then - goto NCD # DSC - else if ($lobe == psc) then - goto NCPS # PSC - else if ($lobe == pin) then - goto NCP # PIN - else if ($lobe == def || $lobe == pef || $lobe == dsf) then - goto NCDF # def, pef, dsf - else if ($lobe == inc) then - goto NCDF # (dwarf) inc - else if ($lobe == a$ext) then - goto NCALB # special olb - else if ($lobe == x$ext) then - goto NCXEX # special exe - endif -NCG2: # others -#endif -# -# Others -# -#ifdef wn_vax__ -$ OTH: IF CD_P .NES. "-" .AND. MSGT-"printed" .EQS. MSGT .AND. - - F$EXTRACT(1,1,FTP) .NES. "A" .AND. - - F$EXTRACT(1,1,FTP) .NES. "X" !PRINT -$ THEN -$ @WNG:WNGFEX "SP" 'FNM''FTP' 'FNM''FTP' -$ MSGT=MSGT+" printed" -$ ENDIF -$ IF CD_L .EQS. "0" !LIBRARY -$ THEN -$ IF F$EXTRACT(1,1,FTP) .EQS. "A" .OR. - - F$EXTRACT(1,1,FTP) .EQS. "X" -$ THEN -$ LIBRARY/TEXT 'WNG_TLB''L_D'_AX.TLB 'P1'/MODULE='FNM''FTP' !SET LIB. -$ MSGT=MSGT+" [''F$PARSE(L_D,,,"NAME","SYNTAX_ONLY")'_AX.TLB]" -$ ELSE -$ LIBRARY/TEXT 'WNG_TLB''L_D'.TLB 'P1'/MODULE='FNM''FTP' !SET IN LIB. -$ MSGT=MSGT+" [''F$PARSE(L_D,,,"NAME","SYNTAX_ONLY")'.TLB]" -$ ENDIF -$ ENDIF -$ RETURN -#else -NCOTH: - set l00=(`echo "$msgt" | grep printed`) # see if printed - if ("$cd_p" != "-" && "$l00" == "" && "$lobe" !~ [ax]??) then - $WNG/wngfex.sun sp ${lobh}.$lobe ${lobh}.$lobe # print - set msgt="$msgt printed" - endif - if ("$cd_l" == "0") then # library - if ("$lobe" =~ [ax]??) then - if ($?taxset) then - if (`echo $taxset | wc -c` > 800) then # limit for HP - echo "Update ${l_d}_ax.tlb" | tee -a $c_upd - ar crl $WNG_TLB/${l_d}_ax.tlb $taxset - setenv taxset "${lobh}.$lobe" # save next for ar - else - setenv taxset "$taxset ${lobh}.$lobe" # save for ar - endif - else - setenv taxset "${lobh}.$lobe" # save for ar - endif - set l02=$WNG_TLB - set l00=$l02:h ; set l01=$l02:t - set l00=$l00:t/$l01 - set msgt="$msgt [$l00/${l_d}_ax.tlb]" - else - if ($?tlbset) then - if (`echo $tlbset | wc -c` > 800) then # limit for HP - echo "Update ${l_d}.tlb" | tee -a $c_upd - ar crl $WNG_TLB/${l_d}.tlb $tlbset - setenv tlbset "${lobh}.$lobe" # save next for ar - else - setenv tlbset "$tlbset ${lobh}.$lobe" # save for ar - endif - else - setenv tlbset "${lobh}.$lobe" # save for ar - endif - set l02=$WNG_TLB - set l00=$l02:h ; set l01=$l02:t - set l00=$l00:t/$l01 - set msgt="$msgt [$l00/${l_d}.tlb]" - endif - endif - if ($lobe == sun || $lobe == s$ext) then # command file - chmod +rx ${lobh}.$lobe # make executable - endif - goto NCEX # ready -#endif -# -# Exit -# -#ifdef wn_vax__ -$ ERR: B1="Not: " -$ CLOSE/ERROR=ERR6 NXFO'PID''DEP' -$ ERR6: CLOSE/ERROR=ERR5 NXPO'PID''DEP' -$ ERR5: CLOSE/ERROR=ERR4 AT'PID''DEP -$ ERR4: CLOSE/ERROR=ERR3 AF'PID''DEP -$ ERR3: CLOSE/ERROR=ERR2 NXL1'PID''DEP' -$ ERR2: CLOSE/ERROR=ERR1 NXL'PID''DEP' !MAKE SURE -$ ERR1: TELL B1+FNM+FTP+MSGT -$ UTELL B1+FNM+FTP+MSGT -$ EXIT: EXIT -#else -NCERR: - set b1="Not: " -NCEX: - echo "$b1 ${lobh}.$lobe $msgt" | tee -a $c_upd - goto RETURN # exit -#endif -# -# Fortran -# -#ifdef wn_vax__ -$ FOR: FORTRAN/LIST='WNG_LIS''FNM'/OBJECT='FNM''FQ_D' 'JQ_D''FNM''FTP' -$ FOR1: IF $STATUS/%X1000 .EQ. %X38 THEN GOTO ERR !DCL WARNING -$ IF F$SEARCH("''FNM'.OBJ") .EQS. "" THEN GOTO ERR -$ MSGT=MSGT+" compiled" -$ IF CD_L .NES. "-" !TO LIB. -$ THEN -$ LIBRARY 'WNG_OLB''L_D'.OLB 'FNM'.OBJ -$ MSGT=MSGT+" [''F$PARSE(L_D,,,"NAME","SYNTAX_ONLY")'.OLB]" -$ ENDIF -$ IF CD_L .NES. "-" !DELETE -$ THEN -$ DELETE 'FNM'.OBJ;* -$ ELSE -$ PURGE 'FNM'.OBJ -$ ENDIF -$ PURGE 'WNG_LIS''FNM'.LIS -$ IF CD_P .NES. "-" !PRINT -$ THEN -$ @WNG:WNGFEX "SP" 'WNG_LIS''FNM'.LIS 'FNM''FTP' -$ MSGT=MSGT+" printed" -$ ENDIF -$ RETURN -#else -NCF: - set lot=f # Fortran extension - 'rm' $WNG_LINK/${lobh}.$lot >& /dev/null # link - 'rm' ${lobh}.l >& /dev/null # listing - 'rm' $WNG_ERR/${lobh}.err >& /dev/null # error list - ln -s ${cwd}/${lobh}.$lobe $WNG_LINK/${lobh}.$lot # set link -NCF2: - 'rm' ${lobh}.o >& /dev/null # object - 'rm' $WNG_OLB/${lobh}.o >& /dev/null - awk '{print NR," ",$0}' ${lobh}.$lobe > ${lobh}.l # numbers - $fortran $fq_d $xfort $WNG_LINK/${lobh}.$lot >& \ - $WNG_ERR/${lobh}.err # compile - set statx=$status -NCF1: - if (-e $WNG_ERR/${lobh}.err) then - cat $WNG_ERR/${lobh}.err >>! ${lobh}.l - endif - if (-e ${lobh}.l ) then # format - pr -f -l60 -h ${lobh}.$lobe ${lobh}.l >! $WNG_LIS/${lobh}.lis - 'rm' ${lobh}.l - endif - if (! -e ${lobh}.o) then # error - 'rm' $WNG_LINK/${lobh}.$lot - if (-e $WNG_LIS/${lobh}.lis && "$cd_p" != "-") then - $WNG/wngfex.sun sp $WNG_LIS/${lobh}.lis $lobh:t.$lobe # print - set msgt="$msgt printed" - endif - goto NCERR - else - set msgt="$msgt compiled" - if ("$cd_l" != "-") then - set l02=$WNG_OLB - set l00=$l02:h ; set l01=$l02:t - set l00=$l00:t/$l01 - if ($?olbset) then - if (`echo $olbset | wc -c` > 800) then # limit for HP - echo "Update ${l_d}.olb" | tee -a $c_upd - ar crl $WNG_OLB/${l_d}.olb $olbset - 'rm' $olbset >& /dev/null - setenv olbset "${lobh}.o" # save next for ar - else - setenv olbset "$olbset ${lobh}.o" # save for ar - endif - else - setenv olbset "${lobh}.o" # save for ar - endif - set msgt="$msgt [$l00/${l_d}.olb]" - endif - echo "" >> $WNG_LIS/${lobh}.lis # add global names - nm ${lobh}.o >> $WNG_LIS/${lobh}.lis - if ("$cd_l" == "-") then # save object - 'mv' ${lobh}.o $WNG_OLB/${lobh}.o - endif - if ("$cd_p" != "-") then # print - $WNG/wngfex.sun sp $WNG_LIS/${lobh}.lis ${lobh}.$lobe - set msgt="$msgt printed" - endif - endif - goto NCOTH # ready -#endif -# -# Macro -# -#ifdef wn_vax__ -$ MAC: MACRO/LIST='WNG_LIS''FNM'/OBJECT='FNM''MQ_D' 'IQ_D''FNM''FTP' -$ GOTO FOR1 -#else -NCM: - set lot=s # Macro extension - 'rm' $WNG_LINK/${lobh}.$lot >& /dev/null # link - 'rm' ${lobh}.l >& /dev/null # listing - 'rm' $WNG_ERR/${lobh}.err >& /dev/null # error list - 'rm' ${lobh}.o >& /dev/null # object - 'rm' $WNG_OLB/${lobh}.o >& /dev/null - ln -s ${cwd}/${lobh}.$lobe $WNG_LINK/${lobh}.$lot # set link - awk '{print NR," ",$0}' ${lobh}.$lobe >! ${lobh}.l # numbers - $assem $mq_d $xassem -o ${lobh}.o \ - $WNG_LINK/${lobh}.$lot >&! \ - $WNG_ERR/${lobh}.err # compile - goto NCF1 # finish -#endif -# -# C -# -#ifdef wn_vax__ -#else -NCC: - set lota="" # for pre-processor -NCC1: - set lot=c # C extension - 'rm' $WNG_LINK/${lobh}.$lot >& /dev/null # link - 'rm' ${lobh}.l >& /dev/null # listing - 'rm' $WNG_ERR/${lobh}.err >& /dev/null # error list - 'rm' ${lobh}.o >& /dev/null # object - 'rm' $WNG_OLB/${lobh}.o >& /dev/null - ln -s ${cwd}/${lobh}.$lobe $WNG_LINK/${lobh}.$lot # set link - awk '{print NR," ",$0}' ${lobh}.$lobe >! ${lobh}.l # numbers - $cee $lota $cq_d $xcee $WNG_LINK/${lobh}.$lot >&! \ - $WNG_ERR/${lobh}.err # compile - set statx=$status - goto NCF1 # finish -#endif -# -# Help -# -#ifdef wn_vax__ -$ HLP: IF F$SEARCH("''WNG_TLB'''FNM'.HLB") .EQS. "" THEN - - LIBRARY/HELP/CREATE 'WNG_TLB''FNM'.HLB !CREATE HELP LIB -$ IF F$SEARCH("''WNG_TLB'''FNM'.HLB") .EQS. "" THEN GOTO ERR -$ IF CD_L .EQS. "0" -$ THEN -$ LIBRARY/HELP 'WNG_TLB''FNM'.HLB 'FNM''FTP' !SET IN LIBRARY -$ MSGT=MSGT+" [''FNM'.HLB]" -$ ENDIF -$ IF CD_U .NES. "-" .AND. F$TRNLNM("EXEDWARF") .NES. "" .AND. - - F$TRNLNM("LIBDWARF") .NES. "" !UPDATE -$ THEN -$ @WNG:NXUP "15" "''U_D'" "''P1'" "''FNM'" "" !UPDATE -$ MSGT=MSGT+" updated(''U_D')" -$ ENDIF -$ RETURN -#else -NCH: - goto NCOTH # not yet written### -#endif -# -# DSC -# -#ifdef wn_vax__ -$ DSC: IF F$SEARCH("WNG:WNTINC.EXE") .EQS. "" THEN GOTO ERR !CANNOT DO -$ WNT="$WNG:WNTINC" !COMMAND TO DO -$ WNT 'FNM' -$ MSGT=MSGT+" compiled" -$ IF CD_P .NES. "-" !PRINT -$ THEN -$ @WNG:WNGFEX "SP" 'FNM'.LIS 'FNM'.LIS -$ MSGT=MSGT+" printed" -$ ENDIF -$ DIR/VERSION=1/NOHEAD/NOTRAIL/COL=1/OUT='FNM''PID'.TMP - - 'FNM'.DEF,'FNM'_BD.FOR,'FNM'.INC,'FNM'_%.* -$ DSC1: -$ L00="" !ADD YNZ -$ L01=0 -$ LP17: IF F$EXTRACT(L01,1,CODES) .EQS. "Y" -$ THEN -$ L00=L00+"0" -$ ELSE -$ IF F$EXTRACT(L01,1,CODES) .EQS. "Z" -$ THEN -$ L00=L00+"-" -$ ELSE -$ L00=L00+CD_'F$EXTRACT(L01,1,CODES)' -$ ENDIF -$ ENDIF -$ L01=L01+1 -$ IF L01 .LT. F$LENGTH(CODES) THEN GOTO LP17 -$ @WNG:NXEC X2 'PNAM' 'PCOD' 'DEP' "''L00'" "''FG_CX'" - - 'FNM''PID'.TMP !DO REST -$ IF F$SEARCH("''FNM'''PID'.TMP") .NES. "" THEN - - DELETE 'FNM''PID'.TMP;* -$ RETURN -#else -NCD: - if (! -e $WNG_OLBEXE/wng/wntinc.exe) goto NCERR # cannot do - 'rm' ${lobh}.def >& /dev/null # .def - 'rm' ${lobh}.inc >& /dev/null # .inc - 'rm' ${lobh}_bd.for >& /dev/null # block data - set nonomatch; 'rm' ${lobh}_?.* >& /dev/null; unset nonomatch # offsets - $WNG_OLBEXE/wng/wntinc.exe ${lobh} # compile - @ statx = $status - if ($statx != 1) then # error - goto NCERR - else - set msgt="$msgt compiled" - if ("$cd_p" != "-") then # print - $WNG/wngfex.sun sp ${lobh}.lis ${lobh}.lis - set msgt="$msgt printed" - endif - endif - set findb="" # for repeat - if (-e ${lobh}.def) set findb=($findb ${lobh}.def) - if (-e ${lobh}_bd.for) set findb=($findb ${lobh}_bd.for) - if (-e ${lobh}.inc) set findb=($findb ${lobh}.inc) - if (-e ${lobh}_o.def) set findb=($findb `ls ${lobh}_?.*`) - goto NCOTH # ready -#endif -# -# CSC -# -#ifdef wn_vax__ -$ CSC: -$ L1="" -$ IF F$SEARCH("WNG_OLBEXE:[WNG]GIPLIB.OLB") .NES. "" THEN - - L1=L1+"/DEF="""wn_gipsy__""" -$ CC/LIST='WNG_LIS''FNM'/OBJECT='FNM''CQ_D'/DIAG='WNG_ERR''FNM'.ERR - - /DEF="wn_vx__"/DEF="wn_''WNG_SITE'__"'L1' - - 'FNM''FTP' !COMP. -$ GOTO FOR1 -#else -NCCS: - set lota="-Dwn_${ext}__ -Dwn_${WNG_SITE}__" # for pre-processor - if (-e $WNG_OLBEXE/wng/giplib.olb) \ - set lota="$lota -Dwn_gipsy__" - goto NCC1 -#endif -# -# SSC -# -#ifdef wn_vax__ -$ SSC: -$ IF F$SEARCH("''WNG_ERR'''FNM'.ERR") .NES. "" THEN - - DELETE 'WNG_ERR''FNM'.ERR;* -$ L01=F$SEARCH("WNG:NXFOR.COM") !SAVE COMMAND -$ OPEN/ERROR=ERR/WRITE NXFO'PID''DEP' 'FNM'.COM !CREATE OUTPUT -$ @'L01' 'FNM''FTP' NXFO'PID''DEP' 'WNG_ERR''FNM'.ERR VAX -$ CLOSE/ERROR=ERR NXFO'PID''DEP' -$ OPEN/ERROR=ERR/WRITE NXFO'PID''DEP' 'FNM'.SUN !CREATE OUTPUT -$ @'L01' 'FNM''FTP' NXFO'PID''DEP' 'WNG_ERR''FNM'.ERR UNIX -$ CLOSE/ERROR=ERR NXFO'PID''DEP' -$ IF F$SEARCH("''FNM'.COM") .NES. "" THEN PURGE/KEEP=2 'FNM'.COM -$ IF F$SEARCH("''FNM'.SUN") .NES. "" THEN PURGE 'FNM'.SUN -$ IF F$SEARCH("''WNG_ERR'''FNM'.ERR") .NES. "" THEN GOTO ERR !ERROR -$ MSGT=MSGT+" compiled" -$ DIR/VERSION=1/NOHEAD/NOTRAIL/COL=1/OUT='FNM''PID'.TMP - - 'FNM'.COM,'FNM'.SUN -$ GOTO DSC1 -#else -NCSS: - 'rm' $WNG_ERR/${lobh}.err >& /dev/null # error list - if (-e ${lobh}.sun) then - 'mv' ${lobh}.sun ${lobh}.sun.old # make place - endif - if (-e ${lobh}.com) then - 'mv' ${lobh}.com ${lobh}.com.old # make place - endif - if ("$lobh" == "nxfor") then # cater for itself - set lot="sun.old" - else - set lot="sun" - endif - awk '{print $0} END {print "endend"}' ${lobh}.$lobe \ - | csh -f $WNG/nxfor.$lot $WNG_ERR/${lobh}.err unix \ - >>! ${lobh}.sun - awk '{print $0} END {print "endend"}' ${lobh}.$lobe \ - | csh -f $WNG/nxfor.$lot $WNG_ERR/${lobh}.err vax \ - >>! ${lobh}.com - if (-e $WNG_ERR/${lobh}.err) then - if (-e ${lobh}.sun) then - 'rm' ${lobh}.sun # remove - endif - if (-e ${lobh}.com) then - 'rm' ${lobh}.com # remove - endif - goto NCERR - endif - set msgt="$msgt compiled" - set findb=(${lobh}.sun ${lobh}.com) # do sun - goto NCOTH # finish -#endif -# -# FSC -# -#ifdef wn_vax__ -$ FSC: -$ IF F$SEARCH("''WNG_ERR'''FNM'.ERR") .NES. "" THEN - - DELETE 'WNG_ERR''FNM'.ERR;* -$ OPEN/ERROR=ERR/WRITE NXFO'PID''DEP' 'FNM'.FOR !CREATE OUTPUT -$ @WNG:NXFOR 'FNM''FTP' NXFO'PID''DEP' 'WNG_ERR''FNM'.ERR -$ CLOSE/ERROR=ERR NXFO'PID''DEP' -$ IF F$SEARCH("''FNM'.FOR") .NES. "" THEN PURGE 'FNM'.FOR -$ IF F$SEARCH("''WNG_ERR'''FNM'.ERR") .NES. "" THEN GOTO ERR !ERROR -$ FORTRAN/LIST='WNG_LIS''FNM'/OBJECT='FNM''FQ_D' 'JQ_D''FNM'.FOR !COMP. -$ GOTO FOR1 -#else -NCFS: - set lot=f # Fortran extension - 'rm' $WNG_LINK/${lobh}.$lot >& /dev/null # link - 'rm' ${lobh}.l >& /dev/null # listing - 'rm' $WNG_ERR/${lobh}.err >& /dev/null # error list - awk '{print $0} END {print "endend"}' ${lobh}.$lobe \ - | csh -f $WNG/nxfor.sun $WNG_ERR/${lobh}.err \ - >>! $WNG_LINK/${lobh}.$lot - if (-e $WNG_ERR/${lobh}.err) then - if (-e $WNG_LINK/{lobh}.$lot) then - 'rm' $WNG_LINK/${lobh}.$lot # remove - endif - goto NCERR - endif - goto NCF2 # compile -#endif -# -# PSC -# -#ifdef wn_vax__ -$ PSC: -$ IF F$SEARCH("''WNG_ERR'''FNM'.ERR") .NES. "" THEN - - DELETE 'WNG_ERR''FNM'.ERR;* -$ OPEN/ERROR=ERR/WRITE NXPO'PID''DEP' 'FNM'.PIN !CREATE OUTPUT -$ @WNG:NXPIN 'FNM''FTP' NXPO'PID''DEP' 'WNG_ERR''FNM'.ERR -$ CLOSE/ERROR=ERR NXPO'PID''DEP' -$ IF F$SEARCH("''FNM'.PIN") .NES. "" THEN PURGE 'FNM'.PIN -$ IF F$SEARCH("''WNG_ERR'''FNM'.ERR") .NES. "" THEN GOTO ERR !ERROR -$ MSGT=MSGT+" compiled" -$ DIR/VERSION=1/NOHEAD/NOTRAIL/COL=1/OUT='FNM''PID'.TMP - - 'FNM'.PIN -$ GOTO DSC1 -#else -NCPS: - if (-e $WNG_ERR/${lobh}.err) then # catch errors - 'rm' $WNG_ERR/${lobh}.err - endif - if (-e ${lobh}.pin) then # make place - 'mv' ${lobh}.pin ${lobh}.pin.old - endif - awk '{print $0} END {print "endend"}' ${lobh}.$lobe \ - | csh -f $WNG/nxpin.sun $WNG_ERR/${lobh}.err >>! ${lobh}.pin - if (-e $WNG_ERR/${lobh}.err) then - if (-e ${lobh}.pin.old) then - 'mv' ${lobh}.pin.old ${lobh}.pin # restore - endif - goto NCERR - endif - if (-e ${lobh}.pin.old) then # do now pin - 'rm' ${lobh}.pin.old - endif - set msgt="$msgt compiled" - set findb=(${lobh}.pin) # do PIN - goto NCOTH -#endif -# -# PIN -# -#ifdef wn_vax__ -$ PIN: L0="13" !UPDATE CODE -$ L1="PPD" !TYPE -$ L2="=(COMP)" !LIST TYPE -$ PIN2: L3="$RUNDWARF:SYS_BLD''L1'.EXE" !PROGRAM -$ ASSIGN/USER 'WNG_ERR''FNM'.ERR SYS$OUTPUT -$ L3 'FNM'/LIST'L2' !DO -$ IF F$SEARCH("''FNM'.LIS") .EQS. "" .OR. - - F$SEARCH("''FNM'.''L1'") .EQS. "" THEN GOTO ERR -$ MSGT=MSGT+" compiled" -$ PURGE 'FNM'.LIS,'FNM'.'L1' -$ COPY 'FNM'.LIS 'WNG_LIS''FNM'.LIS -$ PURGE 'WNG_LIS''FNM'.LIS -$ COPY 'FNM'.'L1' 'WNG_EXE' -$ PURGE 'WNG_EXE''FNM'.'L1' -$ IF CD_U .NES. "-" .AND. F$TRNLNM("EXEDWARF") .NES. "" !UPDATE -$ THEN -$ @WNG:NXUP "''L0'" "''U_D'" "''FNM'.''L1'" "''FNM'" "" -$ MSGT=MSGT+" updated(''U_D')" -$ ENDIF -$ IF CD_P .NES. "-" !PRINT -$ THEN -$ @WNG:WNGFEX "SP" 'WNG_LIS''FNM'.LIS 'FNM''FTP' -$ MSGT=MSGT+" printed" -$ ENDIF -$ RETURN -#else -NCP: - set l00="13" # update code - set l01="ppd" # type -NCP1: - if (-e ${lobh}.$l01) then - 'mv' ${lobh}."$l01" ${lobh}."$l01".old # make place - endif - if (! $?EXEDWARF_UNIX) goto NCERR # cannot do dwarf - if ( -e $EXEDWARF_UNIX/sys_bld"$l01".exe) then - set lbld="sys_bld" - else if ( -e $EXEDWARF_UNIX/bld"$l01".exe) then - set lbld="bld" - else - goto NCERR # no dwarf build - endif - if (! -e global.ppd) then # make sure can do - touch global.ppd - endif - if (! -e ngen.ppd) then # make sure can do - touch ngen.ppd - endif - $EXEDWARF_UNIX/${lbld}"$l01".exe ${lobh}/list >! $WNG_ERR/$lobh.err - set statx=$status - if (-z global.ppd) then - 'rm' global.ppd - endif - if (-z ngen.ppd) then - 'rm' ngen.ppd - endif - if ( ! -e ${lobh}.$l01 || ! -e ${lobh}.lis) then # error - if (-e ${lobh}.$l01) then - 'rm' ${lobh}.$l01 - endif - if (-e ${lobh}.lis) then - 'mv' ${lobh}.lis $WNG_LIS >& /dev/null - endif - goto NCERR - else - 'mv' ${lobh}.$l01 $WNG_EXE >& /dev/null # set in lib. dir. - 'mv' ${lobh}.lis $WNG_LIS >& /dev/null - set msgt="$msgt compiled" - if ("$cd_u" != "-") then # update - csh -f $WNG/nxup.sun $l00 "$u_d" \ - "$WNG_EXE/${lobh}.$l01" "$lobh:t" - set msgt="$msgt updated($u_d)" - endif - if ("$cd_p" != "-") then # print - $WNG/wngfex.sun sp $WNG_LIS/${lobh}.lis ${lobh}.$lobe - set msgt="$msgt printed" - endif - endif - goto NCOTH # ready -#endif -# -# def -# -#ifdef wn_vax__ -$ DEF: -$ LOA="" !DO NOT -$ IF FTP .EQS. ".INC" .AND. CWDT .EQS. "[DWARF]" THEN - - LOA="''FNM'" !WHAT -$ IF FTP .EQS. ".INC" .AND. CWDT .NES. "[DWARF]" THEN - - LOA="''FNM'_''FTP'"-"." -$ IF FTP .EQS. ".DEF" .OR. FTP .EQS. ".PEF" .OR. FTP .EQS. ".DSF" THEN - - LOA="''FNM'_''FTP'"-"." -$ IF LOA .NES. "" -$ THEN -$ IF CD_U .NES. "-" !UPDATE -$ THEN -$ LOB="WNG_DIR:''CWDT'''FNM'''FTP'" !FILE NAME -$ ASSIGN/NOLOG "''LOB'" 'LOA' -$ IF F$SEARCH("WNG:NXLDEF.COM") .EQS. "" -$ THEN -$ OPEN/ERROR=ERR/WRITE NXL'PID''DEP' WNG:NXLDEF.COM -$ WRITE/ERROR=ERR NXL'PID''DEP' "$ !01 NXLDEF.COM" -$ WRITE/ERROR=ERR NXL'PID''DEP' "$ !02 WNB ''C_DATE'" -$ WRITE/ERROR=ERR NXL'PID''DEP' "$ !03" -$ WRITE/ERROR=ERR NXL'PID''DEP' "$ !04 Revisions: " -$ WRITE/ERROR=ERR NXL'PID''DEP' "$ !05 Automatic by NCOMP" -$ WRITE/ERROR=ERR NXL'PID''DEP' "$ !06" -$ WRITE/ERROR=ERR NXL'PID''DEP' - - "$ !07 Logical names for all include files" -$ WRITE/ERROR=ERR NXL'PID''DEP' "$ !08" -$ WRITE/ERROR=ERR NXL'PID''DEP' "$ ASSIGN/NOLOG QQ WNG_TLD !Test" -$ CLOSE/ERROR=ERR NXL'PID''DEP' -$ ENDIF -$ OPEN/ERROR=ERR/READ NXL'PID''DEP' WNG:NXLDEF.COM !INPUT -$ OPEN/ERROR=ERR/WRITE NXL1'PID''DEP' NXL'PID''DEP'.TMP !OUTPUT -$ LP19: READ/ERROR=ERR/END=LP18 NXL'PID''DEP' L0 !READ LINE -$ IF F$LOCATE(LOA,L0) .EQS. F$LENGTH(L0) THEN - - WRITE/ERROR=ERR NXL1'PID''DEP' L0 !COPY -$ GOTO LP19 -$ LP18: L0="$ ASSIGN/NOLOG "+""""+"''LOB'"+""""+" ''LOA' ! ''C_DATE'" -$ WRITE/ERROR=ERR NXL1'PID''DEP' L0 -$ CLOSE/ERROR=ERR NXL'PID''DEP' -$ CLOSE/ERROR=ERR NXL1'PID''DEP' -$ SORT NXL'PID''DEP'.TMP WNG:NXLDEF.COM -$ DELETE NXL'PID''DEP'.TMP;* -$ PURGE WNG:NXLDEF.COM -$ MSGT=MSGT+" updated(''U_D')" -$ ELSE -$ LOB="''FNM'''FTP'" !FILE NAME -$ ASSIGN/NOLOG "''LOB'" 'LOA' -$ ENDIF -$ ENDIF -$ RETURN -#else -NCDF: - if ($?c_shadow) then - set shadowtest - endif - set lot=`echo ${lobh}_$lobe | tr $Lowc $Upc` # make UC - set lotr=`echo ${lobh} | tr $Lowc $Upc` # make UC - foreach i ($c_dir) - unset loa - if ($lobe == inc && $cwd:t == dwarf) then - set loa="$lotr" - else if ($lobe == inc) then - set loa="${lobh}_$lobe" - rm -f ${lobh}.h >& /dev/null # set locally .h - ln -s ${lobh}.$lobe ${lobh}.h - else if ($lobe == def || $lobe == pef || $lobe == dsf) then - set loa="$lot" - endif - if ($?loa) then # to do - if ("$cd_u" != "-") then # update - set loa="../$i/$loa" # what - set lob="../$cwd:t/${lobh}.$lobe" # file name - if ($cwd:t == $i) then - if ($?shadowtest) then # in shadow system? - if (`ls -F $WNG/nxldef.sun` =~ *@) then # link to master? - 'mv' $WNG/nxldef.sun $WNG/nxldef.tmp # yes, - 'cp' $WNG/nxldef.tmp $WNG/nxldef.sun # make writable copy - 'rm' $WNG/nxldef.tmp - unset shadowtest # only once - endif - endif - if (! -e $WNG/nxldef.sun) then - cat > $WNG/nxldef.sun << EOF -#01 nxldef.sun -#02 WNB $c_date -#03 -#04 Revisions: -#05 Automatic by NCOMP -#06 -#07 Logical links for all include files -#08 -EOF - endif - 'cp' $WNG/nxldef.sun nxl$pid$dep.tmp - set loc=" rm -f $loa:t >& /dev/null; ln -s " - set loc="$loc"'$WNG/'"$lob $loa:t" - set loc='"'"$loc # $c_date"'"' - set lod='$0 !~ /'"$loa:t"'/ {print $0} END '"{print $loc}" - awk "$lod" nxl$pid$dep.tmp >! nxln$pid$dep.tmp - sort -bf +0.1 nxln$pid$dep.tmp > $WNG/nxldef.sun - chmod +rx $WNG/nxldef.sun - 'rm' nxl*$pid$dep.tmp >& /dev/null - endif - else - set lob="${lobh}.$lobe" # not update - endif - 'rm' $loa >& /dev/null - ln -s $lob $loa - endif - end - if ("$cd_u" != "-") then # update - set msgt="$msgt updated($u_d)" - endif - goto NCOTH # finish -#endif -# -# Special olb -# -#ifdef wn_vax__ -$ ALB: COPY 'FNM''FTP' 'WNG_OLB''FNM'.OLB !MAKE PROPER LIBRARY -$ PURGE 'WNG_OLB''FNM'.OLB -$ MSGT=MSGT+" compiled" -$ RETURN -#else -NCALB: - 'cp' ${lobh}.${lobe} $WNG_OLB/${lobh}.olb # make proper olb - set msgt="$msgt compiled" - goto NCOTH # ready -#endif -# -# Special exe -# -#ifdef wn_vax__ -$ XEX: COPY 'FNM''FTP' WNG:'FNM'.EXE !MAKE PROPER EXE -$ PURGE WNG:'FNM'.EXE -$ MSGT=MSGT+" compiled" -$ RETURN -#else -NCXEX: - 'cp' ${lobh}.${lobe} $WNG_OLBEXE/wng/${lobh}.exe # make proper exe - chmod +xr $WNG_OLBEXE/wng/${lobh}.exe - set msgt="$msgt compiled" - goto NCOTH # ready -#endif -# -# Exit -# -#ifdef wn_vax__ -#else -RETURN: -#endif diff --git a/src/wng/ncomp.sun b/src/wng/ncomp.sun deleted file mode 100755 index 53f8e75dcf30e0cdb820252413232d2eb53569ff..0000000000000000000000000000000000000000 --- a/src/wng/ncomp.sun +++ /dev/null @@ -1,579 +0,0 @@ -# ncomp.ssc -# WNB 920908 -# -# Revisions: -# WNB 920917 Make shells executable -# WNB 920922 Add l switch to ar -# Add .fun type -# WNB 921002 Overhaul -# JPH 921009 Make $WNG_LINK work. - Remove all target files for .dsc -# and .for compilations -# WNB 921012 Some typo's -# WNB 921016 Wrong nxup called -# WNB 921019 Add copy option -# WNB 921021 Suppress listing message; error for .cee -# WNB 921104 Error in ppd update -# WNB 921113 Postpone ar -# Change rm for ppd -# Remove empty ngen.ppd, global.ppd -# WNB 921113 Use newest wntab -# WNB 921113 Correct back -# WNB 921122 .err output voor .pin; delete .uin -# WNB 921130 Change tr for HP -# WNB 921202 Include .pef -# WNB 921204 Cater for long HP tlbset -# WNB 921208 Change update and log -# WNB 921208 Change .def; include dwarf/.inc; create nxldef.sun -# WNB 921209 Add -a1, -a2, -a4, -a8 -# WNB 921211 Add .PSC -# WNB 921215 Typo -# WNB 921215 Add FSC, CSC -# WNB 921218 Add SSC; site wn_...__ -# HjV 921221 Delete -f chmod; typo goto ncERR; changed rm ?* -# WNB 921222 Include nonomatch; typo SSC; streamline psc ssc -# WNB 921230 Shorter expressions for Alliant; cater NXFOR.SSC -# WNB 921230 Make SSC; add some messages -# JPH 930224 Prefix ${cwd}/ to file name in ln -s commands -# WNB 930303 Change to SYS_BLD (VAX) -# Copy NXLDEF to shadow directory at NCDF. -# WNB 930308 Forgot to delete shadowtest error -# WNB 930330 Add .A.. and .X..; wn_gipsy__, wn_pgplot__ -# WNB 930402 Make logical link from .inc to .h locally only -# WNB 930413 Typo NCEXE label -# WNB 930517 Remove pgplot; put objects in WNG_OLB -# WNB 930802 Change WNTAB into WNTINC -# WNB 930803 Add .dsf -# -# Note: This file contains a series of sed commands. By -# transferring by mail some characters can be -# lost. Make especially sure about the []. -# All "empty" ones contain <space><tab>, i.e. -# [ ] -# -# Compile routines in nxec system. Use as: -# -# source $WNG/ncomp.sun (Unix) -# @WNG:NCOMP <file> (VAX) -# -# This file uses many local variables set in nxec, and the -# environment variables: -# WNG, EXEDWARF_UNIX, WNG_OLB, WNG_OLBEXE, WNG_LIS, WNG_ERR -# and command files nxup, wngfex, -# and programs wntinc, sys_bldppd -# -# Compile a file. -# - set msgt="" ; set b1="Done: " # message text/ok - if (! -e ${lobh}.$lobe) goto NCERR # not present - if ("$lobh:t" != "$lobh") then # copy first - 'cp' ${lobh}.$lobe $lobh:t.$lobe - set msgt="$msgt copied [$lobh:h]" - set lobh=$lobh:t - endif -# -# Change files (-An switch) -# - if ("$cd_a" != "-" && $cd_a > 0) then # switch given - if ("$lobe" =~ f?? || "$lobe" == "def" || \ - ("$lobe" == "inc" && "$cwd:t" == "dwarf")) then # Fortran - if (-e ${lobh}.tmp) then - 'rm' ${lobh}.tmp - endif - if ($cd_a % 2 == 1) then # get rid of () (A1) - set loa="/^[ ][ ]*[Ii][Nn][Cc][Ll][Uu][Dd][Ee]" - set loa="${loa}[ ]*'(/y:${Lowc}:${Upc}:" - set lob="s:^[ ][ ]*INCLUDE[ ]*'(" - set lob="${lob}\([A-Z][A-Z0-9_]*\))': INCLUDE '\1':" - set loc="s:^[ ][ ]*PROGRAM[ ]: SUBROUTINE :" - sed -e "$loa" -e "$lob" -e "$loc" \ - ${lobh}.$lobe > ${lobh}.tmp - 'mv' ${lobh}.tmp ${lobh}.$lobe - endif - if ($cd_a % 4 > 1) then # rid xxx: & . (A2) - set loa="/^[ ][ ]*[Ii][Nn][Cc][Ll][Uu][Dd][Ee]" - set loa="${loa}[ ]*'[A-Za-z][A-Za-z0-9_]*:/" - set loa="${loa}y:${Lowc}:${Upc}:" - set lob="s/^[ ][ ]*INCLUDE[ ]*'" - set lob="${lob}\([A-Z][A-Z0-9_]*\):/ INCLUDE '/" - set loc="/^[ ][ ]*[Ii][Nn][Cc][Ll][Uu][Dd][Ee]" - set loc="${loc}[ ]*'[A-Za-z][A-Za-z0-9_]*\./" - set loc="${loc}y:${Lowc}:${Upc}:" - set loca="/^[ ][ ]*INCLUDE[ ]*'" - set loca="${loca}[A-Z][A-Z0-9_]*\.[Dd][Ee][Ff]'/" - set loca="${loca}y:${Lowc}:${Upc}:" - set lod="s/^[ ][ ]*INCLUDE[ ]*'" - set lod="${lod}\([A-Z][A-Z0-9_]*\)\./ INCLUDE '\1_/" - sed -e "$loa" -e "$lob" -e "$loc" -e "$loca" -e "$lod" \ - ${lobh}.$lobe > ${lobh}.tmp - 'mv' ${lobh}.tmp ${lobh}.$lobe - endif - if ($cd_a % 8 > 3) then # make *4 *8 (A4) - set loa="s:^\([ ][ ]*[Rr][Ee][Aa][Ll]\)" - set loa="${loa}\*4:\1:" - set lob="s:^\([ ][ ]*\)[Rr][Ee][Aa][Ll]" - set lob="${lob}\*8:\1DOUBLE PRECISION:" - set loc="s:^\([ ][ ]*[Ii][Nn][Tt][Ee][Gg][Ee][Rr]\)" - set loc="${loc}\*4:\1:" - set lod="s:^\([ ][ ]*\)[Ll][Oo][Gg][Ii][Cc][Aa][Ll]" - set lod="${lod}\*1:\1BYTE:" - sed -e "$loa" -e "$lob" -e "$loc" -e "$lod" \ - ${lobh}.$lobe > ${lobh}.tmp - 'mv' ${lobh}.tmp ${lobh}.$lobe - endif - endif - if (("$lobe" =~ c?? && "$lobe" != "com") || \ - ("$lobe" == "inc" && "$cwd:t" != "dwarf")) then # C - if (-e ${lobh}.tmp) then - 'rm' ${lobh}.tmp - endif - if ($cd_a % 4 > 1) then # rid . (A2) - set loa="s/^\([ ]*\#include[ ][ ]*"'\"' - set loa="${loa}[a-z][a-z0-9_]*\)\.inc/" - set loa="${loa}\1_inc/" - sed -e "$loa" \ - ${lobh}.$lobe > ${lobh}.tmp - 'mv' ${lobh}.tmp ${lobh}.$lobe - endif - endif - endif -# -# Compile -# - if ("$cd_c" == "-") goto NCG2 # no compile - if ($lobe == fsc || $lobe == fun) then - goto NCFS # FSC - else if ($lobe == for || $lobe == f$ext) then - goto NCF # Fortran - else if ($lobe == csc || $lobe == cun) then - goto NCCS # CSC - else if ($lobe == cee || $lobe == c$ext) then - goto NCC # C - else if ($lobe == m$ext) then - goto NCM # Macro - else if ($lobe == ssc) then - goto NCSS # SSC - else if ($lobe == hlp) then - goto NCH # Help - else if ($lobe == dsc) then - goto NCD # DSC - else if ($lobe == psc) then - goto NCPS # PSC - else if ($lobe == pin) then - goto NCP # PIN - else if ($lobe == def || $lobe == pef || $lobe == dsf) then - goto NCDF # def, pef, dsf - else if ($lobe == inc) then - goto NCDF # (dwarf) inc - else if ($lobe == a$ext) then - goto NCALB # special olb - else if ($lobe == x$ext) then - goto NCXEX # special exe - endif -NCG2: # others -# -# Others -# -NCOTH: - set l00=(`echo "$msgt" | grep printed`) # see if printed - if ("$cd_p" != "-" && "$l00" == "" && "$lobe" !~ [ax]??) then - $WNG/wngfex.sun sp ${lobh}.$lobe ${lobh}.$lobe # print - set msgt="$msgt printed" - endif - if ("$cd_l" == "0") then # library - if ("$lobe" =~ [ax]??) then - if ($?taxset) then - if (`echo $taxset | wc -c` > 800) then # limit for HP - echo "Update ${l_d}_ax.tlb" | tee -a $c_upd - ar crl $WNG_TLB/${l_d}_ax.tlb $taxset - setenv taxset "${lobh}.$lobe" # save next for ar - else - setenv taxset "$taxset ${lobh}.$lobe" # save for ar - endif - else - setenv taxset "${lobh}.$lobe" # save for ar - endif - set l02=$WNG_TLB - set l00=$l02:h ; set l01=$l02:t - set l00=$l00:t/$l01 - set msgt="$msgt [$l00/${l_d}_ax.tlb]" - else - if ($?tlbset) then - if (`echo $tlbset | wc -c` > 800) then # limit for HP - echo "Update ${l_d}.tlb" | tee -a $c_upd - ar crl $WNG_TLB/${l_d}.tlb $tlbset - setenv tlbset "${lobh}.$lobe" # save next for ar - else - setenv tlbset "$tlbset ${lobh}.$lobe" # save for ar - endif - else - setenv tlbset "${lobh}.$lobe" # save for ar - endif - set l02=$WNG_TLB - set l00=$l02:h ; set l01=$l02:t - set l00=$l00:t/$l01 - set msgt="$msgt [$l00/${l_d}.tlb]" - endif - endif - if ($lobe == sun || $lobe == s$ext) then # command file - chmod +rx ${lobh}.$lobe # make executable - endif - goto NCEX # ready -# -# Exit -# -NCERR: - set b1="Not: " -NCEX: - echo "$b1 ${lobh}.$lobe $msgt" | tee -a $c_upd - goto RETURN # exit -# -# Fortran -# -NCF: - set lot=f # Fortran extension - 'rm' $WNG_LINK/${lobh}.$lot >& /dev/null # link - 'rm' ${lobh}.l >& /dev/null # listing - 'rm' $WNG_ERR/${lobh}.err >& /dev/null # error list - ln -s ${cwd}/${lobh}.$lobe $WNG_LINK/${lobh}.$lot # set link -NCF2: - 'rm' ${lobh}.o >& /dev/null # object - 'rm' $WNG_OLB/${lobh}.o >& /dev/null - awk '{print NR," ",$0}' ${lobh}.$lobe > ${lobh}.l # numbers - $fortran $fq_d $xfort $WNG_LINK/${lobh}.$lot >& \ - $WNG_ERR/${lobh}.err # compile - set statx=$status -NCF1: - if (-e $WNG_ERR/${lobh}.err) then - cat $WNG_ERR/${lobh}.err >>! ${lobh}.l - endif - if (-e ${lobh}.l ) then # format - pr -f -l60 -h ${lobh}.$lobe ${lobh}.l >! $WNG_LIS/${lobh}.lis - 'rm' ${lobh}.l - endif - if (! -e ${lobh}.o) then # error - 'rm' $WNG_LINK/${lobh}.$lot - if (-e $WNG_LIS/${lobh}.lis && "$cd_p" != "-") then - $WNG/wngfex.sun sp $WNG_LIS/${lobh}.lis $lobh:t.$lobe # print - set msgt="$msgt printed" - endif - goto NCERR - else - set msgt="$msgt compiled" - if ("$cd_l" != "-") then - set l02=$WNG_OLB - set l00=$l02:h ; set l01=$l02:t - set l00=$l00:t/$l01 - if ($?olbset) then - if (`echo $olbset | wc -c` > 800) then # limit for HP - echo "Update ${l_d}.olb" | tee -a $c_upd - ar crl $WNG_OLB/${l_d}.olb $olbset - 'rm' $olbset >& /dev/null - setenv olbset "${lobh}.o" # save next for ar - else - setenv olbset "$olbset ${lobh}.o" # save for ar - endif - else - setenv olbset "${lobh}.o" # save for ar - endif - set msgt="$msgt [$l00/${l_d}.olb]" - endif - echo "" >> $WNG_LIS/${lobh}.lis # add global names - nm ${lobh}.o >> $WNG_LIS/${lobh}.lis - if ("$cd_l" == "-") then # save object - 'mv' ${lobh}.o $WNG_OLB/${lobh}.o - endif - if ("$cd_p" != "-") then # print - $WNG/wngfex.sun sp $WNG_LIS/${lobh}.lis ${lobh}.$lobe - set msgt="$msgt printed" - endif - endif - goto NCOTH # ready -# -# Macro -# -NCM: - set lot=s # Macro extension - 'rm' $WNG_LINK/${lobh}.$lot >& /dev/null # link - 'rm' ${lobh}.l >& /dev/null # listing - 'rm' $WNG_ERR/${lobh}.err >& /dev/null # error list - 'rm' ${lobh}.o >& /dev/null # object - 'rm' $WNG_OLB/${lobh}.o >& /dev/null - ln -s ${cwd}/${lobh}.$lobe $WNG_LINK/${lobh}.$lot # set link - awk '{print NR," ",$0}' ${lobh}.$lobe >! ${lobh}.l # numbers - $assem $mq_d $xassem -o ${lobh}.o \ - $WNG_LINK/${lobh}.$lot >&! \ - $WNG_ERR/${lobh}.err # compile - goto NCF1 # finish -# -# C -# -NCC: - set lota="" # for pre-processor -NCC1: - set lot=c # C extension - 'rm' $WNG_LINK/${lobh}.$lot >& /dev/null # link - 'rm' ${lobh}.l >& /dev/null # listing - 'rm' $WNG_ERR/${lobh}.err >& /dev/null # error list - 'rm' ${lobh}.o >& /dev/null # object - 'rm' $WNG_OLB/${lobh}.o >& /dev/null - ln -s ${cwd}/${lobh}.$lobe $WNG_LINK/${lobh}.$lot # set link - awk '{print NR," ",$0}' ${lobh}.$lobe >! ${lobh}.l # numbers - $cee $lota $cq_d $xcee $WNG_LINK/${lobh}.$lot >&! \ - $WNG_ERR/${lobh}.err # compile - set statx=$status - goto NCF1 # finish -# -# Help -# -NCH: - goto NCOTH # not yet written### -# -# DSC -# -NCD: - if (! -e $WNG_OLBEXE/wng/wntinc.exe) goto NCERR # cannot do - 'rm' ${lobh}.def >& /dev/null # .def - 'rm' ${lobh}.inc >& /dev/null # .inc - 'rm' ${lobh}_bd.for >& /dev/null # block data - set nonomatch; 'rm' ${lobh}_?.* >& /dev/null; unset nonomatch # offsets - $WNG_OLBEXE/wng/wntinc.exe ${lobh} # compile - @ statx = $status - if ($statx != 1) then # error - goto NCERR - else - set msgt="$msgt compiled" - if ("$cd_p" != "-") then # print - $WNG/wngfex.sun sp ${lobh}.lis ${lobh}.lis - set msgt="$msgt printed" - endif - endif - set findb="" # for repeat - if (-e ${lobh}.def) set findb=($findb ${lobh}.def) - if (-e ${lobh}_bd.for) set findb=($findb ${lobh}_bd.for) - if (-e ${lobh}.inc) set findb=($findb ${lobh}.inc) - if (-e ${lobh}_o.def) set findb=($findb `ls ${lobh}_?.*`) - goto NCOTH # ready -# -# CSC -# -NCCS: - set lota="-Dwn_${ext}__ -Dwn_${WNG_SITE}__" # for pre-processor - if (-e $WNG_OLBEXE/wng/giplib.olb) \ - set lota="$lota -Dwn_gipsy__" - goto NCC1 -# -# SSC -# -NCSS: - 'rm' $WNG_ERR/${lobh}.err >& /dev/null # error list - if (-e ${lobh}.sun) then - 'mv' ${lobh}.sun ${lobh}.sun.old # make place - endif - if (-e ${lobh}.com) then - 'mv' ${lobh}.com ${lobh}.com.old # make place - endif - if ("$lobh" == "nxfor") then # cater for itself - set lot="sun.old" - else - set lot="sun" - endif - awk '{print $0} END {print "endend"}' ${lobh}.$lobe \ - | csh -f $WNG/nxfor.$lot $WNG_ERR/${lobh}.err unix \ - >>! ${lobh}.sun - awk '{print $0} END {print "endend"}' ${lobh}.$lobe \ - | csh -f $WNG/nxfor.$lot $WNG_ERR/${lobh}.err vax \ - >>! ${lobh}.com - if (-e $WNG_ERR/${lobh}.err) then - if (-e ${lobh}.sun) then - 'rm' ${lobh}.sun # remove - endif - if (-e ${lobh}.com) then - 'rm' ${lobh}.com # remove - endif - goto NCERR - endif - set msgt="$msgt compiled" - set findb=(${lobh}.sun ${lobh}.com) # do sun - goto NCOTH # finish -# -# FSC -# -NCFS: - set lot=f # Fortran extension - 'rm' $WNG_LINK/${lobh}.$lot >& /dev/null # link - 'rm' ${lobh}.l >& /dev/null # listing - 'rm' $WNG_ERR/${lobh}.err >& /dev/null # error list - awk '{print $0} END {print "endend"}' ${lobh}.$lobe \ - | csh -f $WNG/nxfor.sun $WNG_ERR/${lobh}.err \ - >>! $WNG_LINK/${lobh}.$lot - if (-e $WNG_ERR/${lobh}.err) then - if (-e $WNG_LINK/{lobh}.$lot) then - 'rm' $WNG_LINK/${lobh}.$lot # remove - endif - goto NCERR - endif - goto NCF2 # compile -# -# PSC -# -NCPS: - if (-e $WNG_ERR/${lobh}.err) then # catch errors - 'rm' $WNG_ERR/${lobh}.err - endif - if (-e ${lobh}.pin) then # make place - 'mv' ${lobh}.pin ${lobh}.pin.old - endif - awk '{print $0} END {print "endend"}' ${lobh}.$lobe \ - | csh -f $WNG/nxpin.sun $WNG_ERR/${lobh}.err >>! ${lobh}.pin - if (-e $WNG_ERR/${lobh}.err) then - if (-e ${lobh}.pin.old) then - 'mv' ${lobh}.pin.old ${lobh}.pin # restore - endif - goto NCERR - endif - if (-e ${lobh}.pin.old) then # do now pin - 'rm' ${lobh}.pin.old - endif - set msgt="$msgt compiled" - set findb=(${lobh}.pin) # do PIN - goto NCOTH -# -# PIN -# -NCP: - set l00="13" # update code - set l01="ppd" # type -NCP1: - if (-e ${lobh}.$l01) then - 'mv' ${lobh}."$l01" ${lobh}."$l01".old # make place - endif - if (! $?EXEDWARF_UNIX) goto NCERR # cannot do dwarf - if ( -e $EXEDWARF_UNIX/sys_bld"$l01".exe) then - set lbld="sys_bld" - else if ( -e $EXEDWARF_UNIX/bld"$l01".exe) then - set lbld="bld" - else - goto NCERR # no dwarf build - endif - if (! -e global.ppd) then # make sure can do - touch global.ppd - endif - if (! -e ngen.ppd) then # make sure can do - touch ngen.ppd - endif - $EXEDWARF_UNIX/${lbld}"$l01".exe ${lobh}/list >! $WNG_ERR/$lobh.err - set statx=$status - if (-z global.ppd) then - 'rm' global.ppd - endif - if (-z ngen.ppd) then - 'rm' ngen.ppd - endif - if ( ! -e ${lobh}.$l01 || ! -e ${lobh}.lis) then # error - if (-e ${lobh}.$l01) then - 'rm' ${lobh}.$l01 - endif - if (-e ${lobh}.lis) then - 'mv' ${lobh}.lis $WNG_LIS >& /dev/null - endif - goto NCERR - else - 'mv' ${lobh}.$l01 $WNG_EXE >& /dev/null # set in lib. dir. - 'mv' ${lobh}.lis $WNG_LIS >& /dev/null - set msgt="$msgt compiled" - if ("$cd_u" != "-") then # update - csh -f $WNG/nxup.sun $l00 "$u_d" \ - "$WNG_EXE/${lobh}.$l01" "$lobh:t" - set msgt="$msgt updated($u_d)" - endif - if ("$cd_p" != "-") then # print - $WNG/wngfex.sun sp $WNG_LIS/${lobh}.lis ${lobh}.$lobe - set msgt="$msgt printed" - endif - endif - goto NCOTH # ready -# -# def -# -NCDF: - if ($?c_shadow) then - set shadowtest - endif - set lot=`echo ${lobh}_$lobe | tr $Lowc $Upc` # make UC - set lotr=`echo ${lobh} | tr $Lowc $Upc` # make UC - foreach i ($c_dir) - unset loa - if ($lobe == inc && $cwd:t == dwarf) then - set loa="$lotr" - else if ($lobe == inc) then - set loa="${lobh}_$lobe" - rm -f ${lobh}.h >& /dev/null # set locally .h - ln -s ${lobh}.$lobe ${lobh}.h - else if ($lobe == def || $lobe == pef || $lobe == dsf) then - set loa="$lot" - endif - if ($?loa) then # to do - if ("$cd_u" != "-") then # update - set loa="../$i/$loa" # what - set lob="../$cwd:t/${lobh}.$lobe" # file name - if ($cwd:t == $i) then - if ($?shadowtest) then # in shadow system? - if (`ls -F $WNG/nxldef.sun` =~ *@) then # link to master? - 'mv' $WNG/nxldef.sun $WNG/nxldef.tmp # yes, - 'cp' $WNG/nxldef.tmp $WNG/nxldef.sun # make writable copy - 'rm' $WNG/nxldef.tmp - unset shadowtest # only once - endif - endif - if (! -e $WNG/nxldef.sun) then - cat > $WNG/nxldef.sun << EOF -#01 nxldef.sun -#02 WNB $c_date -#03 -#04 Revisions: -#05 Automatic by NCOMP -#06 -#07 Logical links for all include files -#08 -EOF - endif - 'cp' $WNG/nxldef.sun nxl$pid$dep.tmp - set loc=" rm -f $loa:t >& /dev/null; ln -s " - set loc="$loc"'$WNG/'"$lob $loa:t" - set loc='"'"$loc # $c_date"'"' - set lod='$0 !~ /'"$loa:t"'/ {print $0} END '"{print $loc}" - awk "$lod" nxl$pid$dep.tmp >! nxln$pid$dep.tmp - sort -bf +0.1 nxln$pid$dep.tmp > $WNG/nxldef.sun - chmod +rx $WNG/nxldef.sun - 'rm' nxl*$pid$dep.tmp >& /dev/null - endif - else - set lob="${lobh}.$lobe" # not update - endif - 'rm' $loa >& /dev/null - ln -s $lob $loa - endif - end - if ("$cd_u" != "-") then # update - set msgt="$msgt updated($u_d)" - endif - goto NCOTH # finish -# -# Special olb -# -NCALB: - 'cp' ${lobh}.${lobe} $WNG_OLB/${lobh}.olb # make proper olb - set msgt="$msgt compiled" - goto NCOTH # ready -# -# Special exe -# -NCXEX: - 'cp' ${lobh}.${lobe} $WNG_OLBEXE/wng/${lobh}.exe # make proper exe - chmod +xr $WNG_OLBEXE/wng/${lobh}.exe - set msgt="$msgt compiled" - goto NCOTH # ready -# -# Exit -# -RETURN: diff --git a/src/wng/ndel.com b/src/wng/ndel.com deleted file mode 100755 index 157a639d68fc88ef13fb4878388e774dd6cb66de..0000000000000000000000000000000000000000 --- a/src/wng/ndel.com +++ /dev/null @@ -1,273 +0,0 @@ -$!# ndel.ssc -$!# WNB 920208 -$!# -$!# Revisions: -$!# WNB 920922 Add l switch to ar -$!# Add .fun type -$!# WNB 921002 Overhaul -$!# WNB 921012 Add question -$!# WNB 921016 Wrong nxup called -$!# WNB 921113 Postpone ar -$!# WNB 921122 Delete .uin -$!# WNB 921130 Change tr for HP -$!# WNB 921202 Include .pef -$!# WNB 921204 Limit tlbdel for HP -$!# WNB 921208 Limit update; log data -$!# WNB 921209 Include include files; -a0 switch -$!# WNB 921211 Add PSC -$!# WNB 921215 Typo -$!# WNB 921215 Add FSC, CSC, CUN -$!# WNB 921218 Add SSC -$!# HJV 921221 Delete -f in chmod -$!# WNB 921222 Typo SSC; streamline psc ssc -$!# WNB 921230 Add HP length; make SSC -$!# JPH 930225 Typo. - Use grep -v to remove line from nxldef -$!# WNB 930325 Cater for different fold -$!# WNB 930330 Add .a.. and .x.. -$!# WNB 930405 Suppress some error messages (VAX) -$!# WNB 930803 Add .dsf -$!# WNB 940210 Typo FSC handling (vx__ iso vax__) -$!# -$!# Delete routines in nxec system. Use as: -$!# -$!# source $WNG/ndel.sun (UNIX) -$!# @WNG:NDEL <file> (VAX) -$!# -$!# The command file uses a lot of local nxec variables, and -$!# environment variables: WNG, WNG_TLB, WNG_OLB, WNG_TYPE -$!# command files: nxup -$!# -$!# Delete a file. -$!# -$ ON ERROR THEN GOTO ERR -$ IF F$SEARCH("''FNM'''FTP'") .NES. "" THEN - - PURGE/KEEP=2 'FNM''FTP' !PURGE AS YOU GO -$ IF CD_A .EQS. "0" !CONFIRM -$ THEN -$ READ/TIME=90/END=EXIT/ERROR=EXIT - - /PROMPT="Delete ''FNM'''FTP'? (Y N) [N]: " - - SYS$COMMAND L0 -$ IF .NOT.L0 THEN GOTO ERR -$ ENDIF -$ MSGT=MSGT+" deleted" !INDICATE DONE -$ IF CD_C .NES. "-" !COMPILE -$ THEN -$ IF FTP .EQS. ".FSC" THEN GOSUB FSC !FSC -$ IF FTP .EQS. ".FOR" .OR. FTP .EQS. ".FVX" THEN GOSUB FOR !FORTRAN -$ IF FTP .EQS. ".MVX" THEN GOSUB MAC !MACRO -$ IF FTP .EQS. ".SSC" THEN GOSUB SSC !SSC -$ IF FTP .EQS. ".HLP" THEN GOSUB HLP !HELP -$ IF FTP .EQS. ".DSC" THEN GOSUB DSC !DSC -$ IF FTP .EQS. ".DEF" .OR. FTP .EQS. ".PEF" .OR. - - FTP .EQS. ".DSF" THEN GOSUB DEF ! DEF/PEF/DSF -$ IF FTP .EQS. ".INC" THEN GOSUB DEF !INC -$ IF FTP .EQS. ".PSC" THEN GOSUB PSC !PSC -$ IF FTP .EQS. ".PIN" THEN GOSUB PIN !PIN -$ IF FTP .EQS. ".AVX" THEN GOSUB ALB !SPECIAL OLB -$ IF FTP .EQS. ".XVX" THEN GOSUB XEX !SPECIAL EXE -$ IF FTP .EQS. ".EXE" THEN GOSUB EXF !EXE -$ ENDIF -$ GOSUB OTH !ALL OTHERS -$ GOTO ERR1 -$!# -$!# Others -$!# -$ OTH: IF F$SEARCH("''FNM'''FTP'") .NES. "" THEN DELETE 'FNM''FTP';* -$ IF CD_L .EQS. "0" !LIBRARY -$ THEN -$ IF F$EXTRACT(1,1,FTP) .EQS. "A" .OR. - - F$EXTRACT(1,1,FTP) .EQS. "X" -$ THEN -$ SET NOON -$ ASSIGN/USER NL: SYS$OUTPUT -$ ASSIGN/USER NL: SYS$ERROR -$ LIBRARY/TEXT/DEL='FNM''FTP' 'WNG_TLB''L_D'_AX.TLB !DELETE IN LIBRARY -$ SET ON -$ MSGT=MSGT+" [''F$PARSE(L_D,,,"NAME","SYNTAX_ONLY")'_AX.TLB]" -$ ELSE -$ SET NOON -$ ASSIGN/USER NL: SYS$OUTPUT -$ ASSIGN/USER NL: SYS$ERROR -$ LIBRARY/TEXT/DEL='FNM''FTP' 'WNG_TLB''L_D'.TLB !DELETE IN LIBRARY -$ SET ON -$ MSGT=MSGT+" [''F$PARSE(L_D,,,"NAME","SYNTAX_ONLY")'.TLB]" -$ ENDIF -$ ENDIF -$ RETURN -$!# -$!# Ready -$!# -$ ERR: B1="Not: " -$ ERR1: TELL B1+FNM+FTP+MSGT -$ UTELL B1+FNM+FTP+MSGT -$ EXIT: EXIT -$!# -$!# Fortran -$!# -$ FOR: -$ IF F$SEARCH("''FNM'.OBJ") .NES. "" THEN DELETE 'FNM'.OBJ;* -$ IF CD_L .NES. "-" -$ THEN -$ SET NOON -$ ASSIGN/USER NL: SYS$OUTPUT -$ ASSIGN/USER NL: SYS$ERROR -$ LIBRARY/DEL='FNM' 'WNG_OLB''L_D' -$ SET ON -$ MSGT=MSGT+" [''F$PARSE(L_D,,,"NAME","SYNTAX_ONLY")'.OLB]" -$ ENDIF -$ RETURN -$!# -$!# FSC -$!# -$ FSC: IF F$SEARCH("''FNM'.FOR") .NES. "" THEN DELETE 'FNM'.FOR;* -$ RETURN -$!# -$!# Macro -$!# -$ MAC: -$ GOTO FOR -$!# -$!# C -$!# -$!# -$!# SSC -$!# -$ SSC: -$ ASSIGN/USER NL: SYS$OUTPUT -$ ASSIGN/USER NL: SYS$ERROR -$ DIR/VERSION=1/NOHEAD/NOTRAIL/COL=1/OUT='FNM''PID'.TMP - - 'FNM'.COM,'FNM'.SUN -$ GOTO DSC1 -$!# -$!# Help -$!# -$ HLP: -$ IF CD_L .EQS. "0" .AND. F$SEARCH("''WNG_TLB'''FNM'.HLB") .NES. "" THEN - - DELETE 'WNG_TLB''FNM'.HLB;* -$ MSGT=MSGT+" [''FNM'.HLB]" -$ IF CD_U .NES. "-" .AND. F$TRNLNM("LIBDWARF") .NES. "" .AND. - - F$TRNLNM("EXEDWARF") .NES. "" !UPDATE -$ THEN -$ @WNG:NXUP "A15" "''U_D'" "''P1'" "''FNM'" "" -$ MSGT=MSGT+" updated(''U_D')" -$ ENDIF -$ RETURN -$!# -$!# DSC -$!# -$ DSC: -$ ASSIGN/USER NL: SYS$OUTPUT -$ ASSIGN/USER NL: SYS$ERROR -$ DIR/VERSION=1/NOHEAD/NOTRAIL/COL=1/OUT='FNM''PID'.TMP - - 'FNM'.DEF,'FNM'_BD.FOR,'FNM'.INC,'FNM'_%.* -$ DSC1: -$ L00="" !ADD YNZ -$ L01=0 -$ LP17: IF F$EXTRACT(L01,1,CODES) .EQS. "Y" -$ THEN -$ L00=L00+"0" -$ ELSE -$ IF F$EXTRACT(L01,1,CODES) .EQS. "Z" -$ THEN -$ L00=L00+"-" -$ ELSE -$ L00=L00+CD_'F$EXTRACT(L01,1,CODES)' -$ ENDIF -$ ENDIF -$ L01=L01+1 -$ IF L01 .LT. F$LENGTH(CODES) THEN GOTO LP17 -$ @WNG:NXEC X2 'PNAM' 'PCOD' 'DEP' "''L00'" "''FG_CX'" - - 'FNM''PID'.TMP !DO REST -$ IF F$SEARCH("''FNM'''PID'.TMP") .NES. "" THEN - - DELETE 'FNM''PID'.TMP;* -$ RETURN -$!# -$!# PSC -$!# -$ PSC: -$ ASSIGN/USER NL: SYS$OUTPUT -$ ASSIGN/USER NL: SYS$ERROR -$ DIR/VERSION=1/NOHEAD/NOTRAIL/COL=1/OUT='FNM''PID'.TMP - - 'FNM'.PIN -$ GOTO DSC1 -$!# -$!# PIN -$!# -$ PIN: L0="A13" !UPDATE CODE -$ L1="PPD" !TYPE -$ IF F$SEARCH("''FNM'.''L1'") .NES. "" THEN DELETE 'FNM'.'L1';* -$ IF F$SEARCH("''WNG_OLB'''FNM'.''L1'") .NES. "" THEN - - DELETE 'WNG_OLB''FNM'.'L1';* -$ IF CD_U .NES. "-" .AND. F$TRNLNM("EXEDWARF") .NES. "" !UPDATE -$ THEN -$ @WNG:NXUP "''L0'" "''U_D'" "''P1'" "''FNM'" "" -$ MSGT=MSGT+" updated(''U_D')" -$ ENDIF -$ RETURN -$!# -$!# Special EXE -$!# -$ XEX: -$ IF F$SEARCH("''FNM'.''FTP'") .NES. "" THEN DELETE 'FNM'.'FTP';* -$ IF F$SEARCH("WNG:''FNM'.EXE") .NES. "" THEN - - DELETE WNG:'FNM'.EXE;* -$ RETURN -$!# -$!# Special OLB -$!# -$ ALB: -$ IF F$SEARCH("''FNM'.''FTP'") .NES. "" THEN DELETE 'FNM'.'FTP';* -$ IF F$SEARCH("''WNG_OLB'''FNM'.OLB") .NES. "" THEN - - DELETE 'WNG_OLB''FNM'.OLB;* -$ RETURN -$!# -$!# def -$!# -$ DEF: -$ IF CD_U .NES. "-" !UPDATE -$ THEN -$ LOB="WNG_DIR:''CWDT'''FNM'''FTP'" !FILE NAME -$ LOA="" !DO NOT -$ IF FTP .EQS. ".INC" .AND. CWDT .EQS. "[DWARF]" THEN - - LOA="''FNM'" !WHAT -$ IF FTP .EQS. ".INC" .AND. CWDT .NES. "[DWARF]" THEN - - LOA="''FNM'_''FTP'"-"." -$ IF FTP .EQS. ".DEF" .OR. FTP .EQS. ".PEF" .OR. FTP .EQS. ".DSF" THEN - - LOA="''FNM'_''FTP'"-"." -$ IF LOA .NES. "" -$ THEN -$ IF F$TRNLNM("''LOA'") .NES. "" THEN DEASSIGN 'LOA' -$ IF F$SEARCH("WNG:NXLDEF.COM") .NES. "" -$ THEN -$ OPEN/ERROR=ERR/READ NXL'PID''DEP' WNG:NXLDEF.COM !INPUT -$ OPEN/ERROR=ERR/WRITE NXL1'PID''DEP' NXL'PID''DEP'.TMP !OUTPUT -$ LP19: READ/ERROR=ERR/END=LP18 NXL'PID''DEP' L0 !READ LINE -$ IF F$LOCATE(LOA,L0) .EQS. F$LENGTH(L0) THEN - - WRITE/ERROR=ERR NXL1'PID''DEP' L0 !COPY -$ GOTO LP19 -$ LP18: CLOSE/ERROR=ERR NXL'PID''DEP' -$ CLOSE/ERROR=ERR NXL1'PID''DEP' -$ SORT NXL'PID''DEP'.TMP WNG:NXLDEF.COM -$ DELETE NXL'PID''DEP'.TMP;* -$ PURGE WNG:NXLDEF.COM -$ ENDIF -$ MSGT=MSGT+" updated(''U_D')" -$ ENDIF -$ ENDIF -$ RETURN -$!# -$!# EXE files -$!# -$ EXF: -$ IF F$SEARCH("''WNG_EXE'''FNM'''FTP'") .NES. "" THEN - - DELETE 'WNG_EXE''FNM''FTP';* -$ IF CD_U .NES. "-" .AND. F$TRNLNM("EXEDWARF") .NES. "" !UPDATE -$ THEN -$ @WNG:NXUP "A4" "''U_D'" "''P1'" "''FNM'" "" -$ MSGT=MSGT+" updated(''U_D')" -$ ENDIF -$ RETURN -$!# -$!# Exit -$!# -$! diff --git a/src/wng/ndel.ssc b/src/wng/ndel.ssc deleted file mode 100644 index dff8f9fda3f82a9ebcb0cc8ce0dc49ef00b90b91..0000000000000000000000000000000000000000 --- a/src/wng/ndel.ssc +++ /dev/null @@ -1,520 +0,0 @@ -# ndel.ssc -# WNB 920208 -# -# Revisions: -# WNB 920922 Add l switch to ar -# Add .fun type -# WNB 921002 Overhaul -# WNB 921012 Add question -# WNB 921016 Wrong nxup called -# WNB 921113 Postpone ar -# WNB 921122 Delete .uin -# WNB 921130 Change tr for HP -# WNB 921202 Include .pef -# WNB 921204 Limit tlbdel for HP -# WNB 921208 Limit update; log data -# WNB 921209 Include include files; -a0 switch -# WNB 921211 Add PSC -# WNB 921215 Typo -# WNB 921215 Add FSC, CSC, CUN -# WNB 921218 Add SSC -# HJV 921221 Delete -f in chmod -# WNB 921222 Typo SSC; streamline psc ssc -# WNB 921230 Add HP length; make SSC -# JPH 930225 Typo. - Use grep -v to remove line from nxldef -# WNB 930325 Cater for different fold -# WNB 930330 Add .a.. and .x.. -# WNB 930405 Suppress some error messages (VAX) -# WNB 930803 Add .dsf -# WNB 940210 Typo FSC handling (vx__ iso vax__) -# -# Delete routines in nxec system. Use as: -# -# source $WNG/ndel.sun (UNIX) -# @WNG:NDEL <file> (VAX) -# -# The command file uses a lot of local nxec variables, and -# environment variables: WNG, WNG_TLB, WNG_OLB, WNG_TYPE -# command files: nxup -# -# Delete a file. -# -#ifdef wn_vax__ -$ ON ERROR THEN GOTO ERR -$ IF F$SEARCH("''FNM'''FTP'") .NES. "" THEN - - PURGE/KEEP=2 'FNM''FTP' !PURGE AS YOU GO -$ IF CD_A .EQS. "0" !CONFIRM -$ THEN -$ READ/TIME=90/END=EXIT/ERROR=EXIT - - /PROMPT="Delete ''FNM'''FTP'? (Y N) [N]: " - - SYS$COMMAND L0 -$ IF .NOT.L0 THEN GOTO ERR -$ ENDIF -$ MSGT=MSGT+" deleted" !INDICATE DONE -$ IF CD_C .NES. "-" !COMPILE -$ THEN -$ IF FTP .EQS. ".FSC" THEN GOSUB FSC !FSC -$ IF FTP .EQS. ".FOR" .OR. FTP .EQS. ".FVX" THEN GOSUB FOR !FORTRAN -$ IF FTP .EQS. ".MVX" THEN GOSUB MAC !MACRO -$ IF FTP .EQS. ".SSC" THEN GOSUB SSC !SSC -$ IF FTP .EQS. ".HLP" THEN GOSUB HLP !HELP -$ IF FTP .EQS. ".DSC" THEN GOSUB DSC !DSC -$ IF FTP .EQS. ".DEF" .OR. FTP .EQS. ".PEF" .OR. - - FTP .EQS. ".DSF" THEN GOSUB DEF ! DEF/PEF/DSF -$ IF FTP .EQS. ".INC" THEN GOSUB DEF !INC -$ IF FTP .EQS. ".PSC" THEN GOSUB PSC !PSC -$ IF FTP .EQS. ".PIN" THEN GOSUB PIN !PIN -$ IF FTP .EQS. ".AVX" THEN GOSUB ALB !SPECIAL OLB -$ IF FTP .EQS. ".XVX" THEN GOSUB XEX !SPECIAL EXE -$ IF FTP .EQS. ".EXE" THEN GOSUB EXF !EXE -$ ENDIF -$ GOSUB OTH !ALL OTHERS -$ GOTO ERR1 -#else - set msgt="" ; set b1="Done: " # message text/ok - if ("$cd_a" == "0") then # ask question? - echo -n "Delete ${lobh}.$lobe ? (Y, N) [N]: " - set loo="$<" - switch ($loo) - case [yY]*: # do delete - breaksw - default: # no delete - goto NDERR - endsw - endif - set msgt="$msgt deleted" # indicate deleted - if ("$cd_c" == "-") goto NDG2 # no compile - if ($lobe == fsc || $lobe == fun) then - goto NDF # FSC - else if ($lobe == for || $lobe == f$ext) then - goto NDF # Fortran - else if ($lobe == cee || $lobe == c$ext || $lobe == cun \ - || $lobe == csc) then - goto NDC # C - else if ($lobe == m$ext) then - goto NDM # Macro - else if ($lobe == ssc) then - goto NDSS # SSC - else if ($lobe == hlp) then - goto NDH # Help - else if ($lobe == dsc) then - goto NDD # DSC - else if ($lobe == def || $lobe == pef || $lobe == dsf) then - goto NDDF # def,pef,dsf - else if ($lobe == inc) then - goto NDDF # (dwarf) inc - else if ($lobe == psc) then - goto NDPS # PSC - else if ($lobe == pin) then - goto NDP # PIN - else if ($lobe == a$ext) then - goto NDALB # special olb - else if ($lobe == x$ext) then - goto NDXEX # special exe - endif -NDG2: # others -#endif -# -# Others -# -#ifdef wn_vax__ -$ OTH: IF F$SEARCH("''FNM'''FTP'") .NES. "" THEN DELETE 'FNM''FTP';* -$ IF CD_L .EQS. "0" !LIBRARY -$ THEN -$ IF F$EXTRACT(1,1,FTP) .EQS. "A" .OR. - - F$EXTRACT(1,1,FTP) .EQS. "X" -$ THEN -$ SET NOON -$ ASSIGN/USER NL: SYS$OUTPUT -$ ASSIGN/USER NL: SYS$ERROR -$ LIBRARY/TEXT/DEL='FNM''FTP' 'WNG_TLB''L_D'_AX.TLB !DELETE IN LIBRARY -$ SET ON -$ MSGT=MSGT+" [''F$PARSE(L_D,,,"NAME","SYNTAX_ONLY")'_AX.TLB]" -$ ELSE -$ SET NOON -$ ASSIGN/USER NL: SYS$OUTPUT -$ ASSIGN/USER NL: SYS$ERROR -$ LIBRARY/TEXT/DEL='FNM''FTP' 'WNG_TLB''L_D'.TLB !DELETE IN LIBRARY -$ SET ON -$ MSGT=MSGT+" [''F$PARSE(L_D,,,"NAME","SYNTAX_ONLY")'.TLB]" -$ ENDIF -$ ENDIF -$ RETURN -#else -NDOTH: - if (-e ${lobh}.$lobe) then - 'rm' ${lobh}.$lobe # delete - endif - if ($cd_l == 0) then # library - if ("$WNG_TYPE" == "hp") then - set l02=`echo ${lobh}.$lobe | ${fold}14` # limit name - else - set l02=`echo ${lobh}.$lobe | ${fold}15` - endif - if ("$lobe" =~ [ax]??) then - if ($?taxdel) then - if (`echo $taxdel | wc -c` > 800) then - echo "Update ${l_d}_ax.tlb" | tee -a $c_upd - ar dl $WNG_TLB/${l_d}_ax.tlb $taxdel - setenv taxdel "$l02" # save for ar - else - setenv taxdel "$taxdel $l02" # save for ar - endif - else - setenv taxdel "$l02" # save for ar - endif - set l02=$WNG_TLB - set l00=$l02:h ; set l01=$l02:t - set l00=$l00:t/$l01 - set msgt="$msgt [$l00/${l_d}_ax.tlb]" - else - if ($?tlbdel) then - if (`echo $tlbdel | wc -c` > 800) then - echo "Update ${l_d}.tlb" | tee -a $c_upd - ar dl $WNG_TLB/${l_d}.tlb $tlbdel - setenv tlbdel "$l02" # save for ar - else - setenv tlbdel "$tlbdel $l02" # save for ar - endif - else - setenv tlbdel "$l02" # save for ar - endif - set l02=$WNG_TLB - set l00=$l02:h ; set l01=$l02:t - set l00=$l00:t/$l01 - set msgt="$msgt [$l00/${l_d}.tlb]" - endif - endif - goto NDEX # ready -#endif -# -# Ready -# -#ifdef wn_vax__ -$ ERR: B1="Not: " -$ ERR1: TELL B1+FNM+FTP+MSGT -$ UTELL B1+FNM+FTP+MSGT -$ EXIT: EXIT -#else -NDERR: - set b1="Not: " -NDEX: - echo "$b1 ${lobh}.$lobe $msgt" | tee -a $c_upd - goto RETURN -#endif -# -# Fortran -# -#ifdef wn_vax__ -$ FOR: -$ IF F$SEARCH("''FNM'.OBJ") .NES. "" THEN DELETE 'FNM'.OBJ;* -$ IF CD_L .NES. "-" -$ THEN -$ SET NOON -$ ASSIGN/USER NL: SYS$OUTPUT -$ ASSIGN/USER NL: SYS$ERROR -$ LIBRARY/DEL='FNM' 'WNG_OLB''L_D' -$ SET ON -$ MSGT=MSGT+" [''F$PARSE(L_D,,,"NAME","SYNTAX_ONLY")'.OLB]" -$ ENDIF -$ RETURN -#else -NDF: - set lot=f # Fortran extension -NDF1: - if (-e $WNG_LINK/${lobh}.$lot) then - 'rm' $WNG_LINK/${lobh}.$lot # delete link - endif - 'rm' ${lobh}.o >& /dev/null # remove object - 'rm' $WNG_OLB/${lobh}.o >& /dev/null - if ("$cd_l" != "-") then - set l02=$WNG_OLB - set l00=$l02:h ; set l01=$l02:t - set l00=$l00:t/$l01 - if ($?olbdel) then - if (`echo $olbdel | wc -c`> 800) then - echo "Update ${l_d}.olb" | tee -a $c_upd - ar dl $WNG_OLB/${l_d}.olb $olbdel - setenv olbdel "${lobh}.o" # save for ar - else - setenv olbdel "$olbdel ${lobh}.o" # save for ar - endif - else - setenv olbdel "${lobh}.o" # save for ar - endif - set msgt="$msgt [$l00/${l_d}.olb]" - endif - goto NDOTH # ready -#endif -# -# FSC -# -#ifdef wn_vax__ -$ FSC: IF F$SEARCH("''FNM'.FOR") .NES. "" THEN DELETE 'FNM'.FOR;* -$ RETURN -#endif -# -# Macro -# -#ifdef wn_vax__ -$ MAC: -$ GOTO FOR -#else -NDM: - set lot=s # Macro extension - goto NDF1 # finish -#endif -# -# C -# -#ifdef wn_vax__ -#else -NDC: - set lot=c # C extension - goto NDF1 # finish -#endif -# -# SSC -# -#ifdef wn_vax__ -$ SSC: -$ ASSIGN/USER NL: SYS$OUTPUT -$ ASSIGN/USER NL: SYS$ERROR -$ DIR/VERSION=1/NOHEAD/NOTRAIL/COL=1/OUT='FNM''PID'.TMP - - 'FNM'.COM,'FNM'.SUN -$ GOTO DSC1 -#else -NDSS: - set findb=(${lobh}.sun ${lobh}.com) # do SUN - goto NDOTH -#endif -# -# Help -# -#ifdef wn_vax__ -$ HLP: -$ IF CD_L .EQS. "0" .AND. F$SEARCH("''WNG_TLB'''FNM'.HLB") .NES. "" THEN - - DELETE 'WNG_TLB''FNM'.HLB;* -$ MSGT=MSGT+" [''FNM'.HLB]" -$ IF CD_U .NES. "-" .AND. F$TRNLNM("LIBDWARF") .NES. "" .AND. - - F$TRNLNM("EXEDWARF") .NES. "" !UPDATE -$ THEN -$ @WNG:NXUP "A15" "''U_D'" "''P1'" "''FNM'" "" -$ MSGT=MSGT+" updated(''U_D')" -$ ENDIF -$ RETURN -#else -NDH: - goto NDOTH # not yet written### -#endif -# -# DSC -# -#ifdef wn_vax__ -$ DSC: -$ ASSIGN/USER NL: SYS$OUTPUT -$ ASSIGN/USER NL: SYS$ERROR -$ DIR/VERSION=1/NOHEAD/NOTRAIL/COL=1/OUT='FNM''PID'.TMP - - 'FNM'.DEF,'FNM'_BD.FOR,'FNM'.INC,'FNM'_%.* -$ DSC1: -$ L00="" !ADD YNZ -$ L01=0 -$ LP17: IF F$EXTRACT(L01,1,CODES) .EQS. "Y" -$ THEN -$ L00=L00+"0" -$ ELSE -$ IF F$EXTRACT(L01,1,CODES) .EQS. "Z" -$ THEN -$ L00=L00+"-" -$ ELSE -$ L00=L00+CD_'F$EXTRACT(L01,1,CODES)' -$ ENDIF -$ ENDIF -$ L01=L01+1 -$ IF L01 .LT. F$LENGTH(CODES) THEN GOTO LP17 -$ @WNG:NXEC X2 'PNAM' 'PCOD' 'DEP' "''L00'" "''FG_CX'" - - 'FNM''PID'.TMP !DO REST -$ IF F$SEARCH("''FNM'''PID'.TMP") .NES. "" THEN - - DELETE 'FNM''PID'.TMP;* -$ RETURN -#else -NDD: - set findb="" # for repeat - if (-e ${lobh}.def) set findb=($findb ${lobh}.def) - if (-e ${lobh}_bd.for) set findb=($findb ${lobh}_bd.for) - if (-e ${lobh}.inc) set findb=($findb ${lobh}.inc) - if (-e ${lobh}_o.def) set findb=($findb `ls ${lobh}_?.*`) - goto NDOTH # ready -#endif -# -# PSC -# -#ifdef wn_vax__ -$ PSC: -$ ASSIGN/USER NL: SYS$OUTPUT -$ ASSIGN/USER NL: SYS$ERROR -$ DIR/VERSION=1/NOHEAD/NOTRAIL/COL=1/OUT='FNM''PID'.TMP - - 'FNM'.PIN -$ GOTO DSC1 -#else -NDPS: - set findb=(${lobh}.pin) - goto NDOTH -#endif -# -# PIN -# -#ifdef wn_vax__ -$ PIN: L0="A13" !UPDATE CODE -$ L1="PPD" !TYPE -$ IF F$SEARCH("''FNM'.''L1'") .NES. "" THEN DELETE 'FNM'.'L1';* -$ IF F$SEARCH("''WNG_OLB'''FNM'.''L1'") .NES. "" THEN - - DELETE 'WNG_OLB''FNM'.'L1';* -$ IF CD_U .NES. "-" .AND. F$TRNLNM("EXEDWARF") .NES. "" !UPDATE -$ THEN -$ @WNG:NXUP "''L0'" "''U_D'" "''P1'" "''FNM'" "" -$ MSGT=MSGT+" updated(''U_D')" -$ ENDIF -$ RETURN -#else -NDP: - set l00="a13" - set l01="ppd" -NDP1: - if (-e $WNG_OLB/${lobh}.$l01) then - 'rm' $WNG_OLB/${lobh}.$l01 - endif - if ("$cd_u" != "-" && $?EXEDWARF_UNIX) then # update - csh -f $WNG/nxup.sun $l00 "$u_d" "${lobh}.$l01" "$lobh:t" - set msgt="$msgt updated($u_d)" - endif - goto NDOTH # finish -#endif -# -# Special EXE -# -#ifdef wn_vax__ -$ XEX: -$ IF F$SEARCH("''FNM'.''FTP'") .NES. "" THEN DELETE 'FNM'.'FTP';* -$ IF F$SEARCH("WNG:''FNM'.EXE") .NES. "" THEN - - DELETE WNG:'FNM'.EXE;* -$ RETURN -#else -NDXEX: - if (-e $WNG_OLBEXE/wng/${lobh}.exe) then - 'rm' $WNG_OLBEXE/wng/${lobh}.exe - endif - goto NDOTH # finish -#endif -# -# Special OLB -# -#ifdef wn_vax__ -$ ALB: -$ IF F$SEARCH("''FNM'.''FTP'") .NES. "" THEN DELETE 'FNM'.'FTP';* -$ IF F$SEARCH("''WNG_OLB'''FNM'.OLB") .NES. "" THEN - - DELETE 'WNG_OLB''FNM'.OLB;* -$ RETURN -#else -NDALB: - if (-e $WNG_OLB/${lobh}.olb) then - 'rm' $WNG_OLB/${lobh}.olb - endif - goto NDOTH # finish -#endif -# -# def -# -#ifdef wn_vax__ -$ DEF: -$ IF CD_U .NES. "-" !UPDATE -$ THEN -$ LOB="WNG_DIR:''CWDT'''FNM'''FTP'" !FILE NAME -$ LOA="" !DO NOT -$ IF FTP .EQS. ".INC" .AND. CWDT .EQS. "[DWARF]" THEN - - LOA="''FNM'" !WHAT -$ IF FTP .EQS. ".INC" .AND. CWDT .NES. "[DWARF]" THEN - - LOA="''FNM'_''FTP'"-"." -$ IF FTP .EQS. ".DEF" .OR. FTP .EQS. ".PEF" .OR. FTP .EQS. ".DSF" THEN - - LOA="''FNM'_''FTP'"-"." -$ IF LOA .NES. "" -$ THEN -$ IF F$TRNLNM("''LOA'") .NES. "" THEN DEASSIGN 'LOA' -$ IF F$SEARCH("WNG:NXLDEF.COM") .NES. "" -$ THEN -$ OPEN/ERROR=ERR/READ NXL'PID''DEP' WNG:NXLDEF.COM !INPUT -$ OPEN/ERROR=ERR/WRITE NXL1'PID''DEP' NXL'PID''DEP'.TMP !OUTPUT -$ LP19: READ/ERROR=ERR/END=LP18 NXL'PID''DEP' L0 !READ LINE -$ IF F$LOCATE(LOA,L0) .EQS. F$LENGTH(L0) THEN - - WRITE/ERROR=ERR NXL1'PID''DEP' L0 !COPY -$ GOTO LP19 -$ LP18: CLOSE/ERROR=ERR NXL'PID''DEP' -$ CLOSE/ERROR=ERR NXL1'PID''DEP' -$ SORT NXL'PID''DEP'.TMP WNG:NXLDEF.COM -$ DELETE NXL'PID''DEP'.TMP;* -$ PURGE WNG:NXLDEF.COM -$ ENDIF -$ MSGT=MSGT+" updated(''U_D')" -$ ENDIF -$ ENDIF -$ RETURN -#else -NDDF: - set lot=`echo ${lobh}.$lobe | tr $Lowc $Upc` # make UC - if ("$cd_u" != "-") then # update - set lot=`echo ${lobh}_$lobe | tr $Lowc $Upc` # make UC - set lotr=`echo ${lobh} | tr $Lowc $Upc` # make UC - set lob="../$cwd:t/${lobh}.$lobe" # file name - foreach i ($c_dir) - unset loa - if ($lobe == inc && $cwd:t == dwarf) then - set loa="../$i/$lotr" - else if ($lobe == inc) then - set loa="../$i/${lobh}_$lobe" - else if ($lobe == def || $lobe == pef || $lobe == dsf) then - set loa="../$i/$lot" - endif - if ($?loa) then # to do - 'rm' $loa >& /dev/null - if ($cwd:t == $i) then - if (-e $WNG/nxldef.sun) then - 'cp' $WNG/nxldef.sun nxl$pid$dep.tmp - set loc=" rm -f $loa:t >& /dev/null; ln -s $lob $loa:t" - set loc='"'"$loc # $c_date"'"' -## set lod="$0 !~ /'"$loa:t"'/ {print $0}" -## awk "$lod" nxl$pid$dep.tmp >! nxln$pid$dep.tmp - grep -v "$loa:t" nxl$pid$dep.tmp >! nxln$pid$dep.tmp - - sort -bf +0.1 nxln$pid$dep.tmp > $WNG/nxldef.sun - chmod +rx $WNG/nxldef.sun - 'rm' nxl*$pid$dep.tmp >& /dev/null - endif - endif - endif - end - set msgt="$msgt updated($u_d)" - endif - goto NDOTH # finish -#endif -# -# EXE files -# -#ifdef wn_vax__ -$ EXF: -$ IF F$SEARCH("''WNG_EXE'''FNM'''FTP'") .NES. "" THEN - - DELETE 'WNG_EXE''FNM''FTP';* -$ IF CD_U .NES. "-" .AND. F$TRNLNM("EXEDWARF") .NES. "" !UPDATE -$ THEN -$ @WNG:NXUP "A4" "''U_D'" "''P1'" "''FNM'" "" -$ MSGT=MSGT+" updated(''U_D')" -$ ENDIF -$ RETURN -#endif -# -# Exit -# -#ifdef wn_vax__ -#else -RETURN: -#endif - diff --git a/src/wng/ndel.sun b/src/wng/ndel.sun deleted file mode 100755 index eb6504a8063e677e53c3ed4850b5fe01d142251f..0000000000000000000000000000000000000000 --- a/src/wng/ndel.sun +++ /dev/null @@ -1,288 +0,0 @@ -# ndel.ssc -# WNB 920208 -# -# Revisions: -# WNB 920922 Add l switch to ar -# Add .fun type -# WNB 921002 Overhaul -# WNB 921012 Add question -# WNB 921016 Wrong nxup called -# WNB 921113 Postpone ar -# WNB 921122 Delete .uin -# WNB 921130 Change tr for HP -# WNB 921202 Include .pef -# WNB 921204 Limit tlbdel for HP -# WNB 921208 Limit update; log data -# WNB 921209 Include include files; -a0 switch -# WNB 921211 Add PSC -# WNB 921215 Typo -# WNB 921215 Add FSC, CSC, CUN -# WNB 921218 Add SSC -# HJV 921221 Delete -f in chmod -# WNB 921222 Typo SSC; streamline psc ssc -# WNB 921230 Add HP length; make SSC -# JPH 930225 Typo. - Use grep -v to remove line from nxldef -# WNB 930325 Cater for different fold -# WNB 930330 Add .a.. and .x.. -# WNB 930405 Suppress some error messages (VAX) -# WNB 930803 Add .dsf -# WNB 940210 Typo FSC handling (vx__ iso vax__) -# -# Delete routines in nxec system. Use as: -# -# source $WNG/ndel.sun (UNIX) -# @WNG:NDEL <file> (VAX) -# -# The command file uses a lot of local nxec variables, and -# environment variables: WNG, WNG_TLB, WNG_OLB, WNG_TYPE -# command files: nxup -# -# Delete a file. -# - set msgt="" ; set b1="Done: " # message text/ok - if ("$cd_a" == "0") then # ask question? - echo -n "Delete ${lobh}.$lobe ? (Y, N) [N]: " - set loo="$<" - switch ($loo) - case [yY]*: # do delete - breaksw - default: # no delete - goto NDERR - endsw - endif - set msgt="$msgt deleted" # indicate deleted - if ("$cd_c" == "-") goto NDG2 # no compile - if ($lobe == fsc || $lobe == fun) then - goto NDF # FSC - else if ($lobe == for || $lobe == f$ext) then - goto NDF # Fortran - else if ($lobe == cee || $lobe == c$ext || $lobe == cun \ - || $lobe == csc) then - goto NDC # C - else if ($lobe == m$ext) then - goto NDM # Macro - else if ($lobe == ssc) then - goto NDSS # SSC - else if ($lobe == hlp) then - goto NDH # Help - else if ($lobe == dsc) then - goto NDD # DSC - else if ($lobe == def || $lobe == pef || $lobe == dsf) then - goto NDDF # def,pef,dsf - else if ($lobe == inc) then - goto NDDF # (dwarf) inc - else if ($lobe == psc) then - goto NDPS # PSC - else if ($lobe == pin) then - goto NDP # PIN - else if ($lobe == a$ext) then - goto NDALB # special olb - else if ($lobe == x$ext) then - goto NDXEX # special exe - endif -NDG2: # others -# -# Others -# -NDOTH: - if (-e ${lobh}.$lobe) then - 'rm' ${lobh}.$lobe # delete - endif - if ($cd_l == 0) then # library - if ("$WNG_TYPE" == "hp") then - set l02=`echo ${lobh}.$lobe | ${fold}14` # limit name - else - set l02=`echo ${lobh}.$lobe | ${fold}15` - endif - if ("$lobe" =~ [ax]??) then - if ($?taxdel) then - if (`echo $taxdel | wc -c` > 800) then - echo "Update ${l_d}_ax.tlb" | tee -a $c_upd - ar dl $WNG_TLB/${l_d}_ax.tlb $taxdel - setenv taxdel "$l02" # save for ar - else - setenv taxdel "$taxdel $l02" # save for ar - endif - else - setenv taxdel "$l02" # save for ar - endif - set l02=$WNG_TLB - set l00=$l02:h ; set l01=$l02:t - set l00=$l00:t/$l01 - set msgt="$msgt [$l00/${l_d}_ax.tlb]" - else - if ($?tlbdel) then - if (`echo $tlbdel | wc -c` > 800) then - echo "Update ${l_d}.tlb" | tee -a $c_upd - ar dl $WNG_TLB/${l_d}.tlb $tlbdel - setenv tlbdel "$l02" # save for ar - else - setenv tlbdel "$tlbdel $l02" # save for ar - endif - else - setenv tlbdel "$l02" # save for ar - endif - set l02=$WNG_TLB - set l00=$l02:h ; set l01=$l02:t - set l00=$l00:t/$l01 - set msgt="$msgt [$l00/${l_d}.tlb]" - endif - endif - goto NDEX # ready -# -# Ready -# -NDERR: - set b1="Not: " -NDEX: - echo "$b1 ${lobh}.$lobe $msgt" | tee -a $c_upd - goto RETURN -# -# Fortran -# -NDF: - set lot=f # Fortran extension -NDF1: - if (-e $WNG_LINK/${lobh}.$lot) then - 'rm' $WNG_LINK/${lobh}.$lot # delete link - endif - 'rm' ${lobh}.o >& /dev/null # remove object - 'rm' $WNG_OLB/${lobh}.o >& /dev/null - if ("$cd_l" != "-") then - set l02=$WNG_OLB - set l00=$l02:h ; set l01=$l02:t - set l00=$l00:t/$l01 - if ($?olbdel) then - if (`echo $olbdel | wc -c`> 800) then - echo "Update ${l_d}.olb" | tee -a $c_upd - ar dl $WNG_OLB/${l_d}.olb $olbdel - setenv olbdel "${lobh}.o" # save for ar - else - setenv olbdel "$olbdel ${lobh}.o" # save for ar - endif - else - setenv olbdel "${lobh}.o" # save for ar - endif - set msgt="$msgt [$l00/${l_d}.olb]" - endif - goto NDOTH # ready -# -# FSC -# -# -# Macro -# -NDM: - set lot=s # Macro extension - goto NDF1 # finish -# -# C -# -NDC: - set lot=c # C extension - goto NDF1 # finish -# -# SSC -# -NDSS: - set findb=(${lobh}.sun ${lobh}.com) # do SUN - goto NDOTH -# -# Help -# -NDH: - goto NDOTH # not yet written### -# -# DSC -# -NDD: - set findb="" # for repeat - if (-e ${lobh}.def) set findb=($findb ${lobh}.def) - if (-e ${lobh}_bd.for) set findb=($findb ${lobh}_bd.for) - if (-e ${lobh}.inc) set findb=($findb ${lobh}.inc) - if (-e ${lobh}_o.def) set findb=($findb `ls ${lobh}_?.*`) - goto NDOTH # ready -# -# PSC -# -NDPS: - set findb=(${lobh}.pin) - goto NDOTH -# -# PIN -# -NDP: - set l00="a13" - set l01="ppd" -NDP1: - if (-e $WNG_OLB/${lobh}.$l01) then - 'rm' $WNG_OLB/${lobh}.$l01 - endif - if ("$cd_u" != "-" && $?EXEDWARF_UNIX) then # update - csh -f $WNG/nxup.sun $l00 "$u_d" "${lobh}.$l01" "$lobh:t" - set msgt="$msgt updated($u_d)" - endif - goto NDOTH # finish -# -# Special EXE -# -NDXEX: - if (-e $WNG_OLBEXE/wng/${lobh}.exe) then - 'rm' $WNG_OLBEXE/wng/${lobh}.exe - endif - goto NDOTH # finish -# -# Special OLB -# -NDALB: - if (-e $WNG_OLB/${lobh}.olb) then - 'rm' $WNG_OLB/${lobh}.olb - endif - goto NDOTH # finish -# -# def -# -NDDF: - set lot=`echo ${lobh}.$lobe | tr $Lowc $Upc` # make UC - if ("$cd_u" != "-") then # update - set lot=`echo ${lobh}_$lobe | tr $Lowc $Upc` # make UC - set lotr=`echo ${lobh} | tr $Lowc $Upc` # make UC - set lob="../$cwd:t/${lobh}.$lobe" # file name - foreach i ($c_dir) - unset loa - if ($lobe == inc && $cwd:t == dwarf) then - set loa="../$i/$lotr" - else if ($lobe == inc) then - set loa="../$i/${lobh}_$lobe" - else if ($lobe == def || $lobe == pef || $lobe == dsf) then - set loa="../$i/$lot" - endif - if ($?loa) then # to do - 'rm' $loa >& /dev/null - if ($cwd:t == $i) then - if (-e $WNG/nxldef.sun) then - 'cp' $WNG/nxldef.sun nxl$pid$dep.tmp - set loc=" rm -f $loa:t >& /dev/null; ln -s $lob $loa:t" - set loc='"'"$loc # $c_date"'"' -## set lod="$0 !~ /'"$loa:t"'/ {print $0}" -## awk "$lod" nxl$pid$dep.tmp >! nxln$pid$dep.tmp - grep -v "$loa:t" nxl$pid$dep.tmp >! nxln$pid$dep.tmp - - sort -bf +0.1 nxln$pid$dep.tmp > $WNG/nxldef.sun - chmod +rx $WNG/nxldef.sun - 'rm' nxl*$pid$dep.tmp >& /dev/null - endif - endif - endif - end - set msgt="$msgt updated($u_d)" - endif - goto NDOTH # finish -# -# EXE files -# -# -# Exit -# -RETURN: - diff --git a/src/wng/nget.com b/src/wng/nget.com deleted file mode 100755 index 2a3c574854c39f48f0222be9530d88048d3a3adb..0000000000000000000000000000000000000000 --- a/src/wng/nget.com +++ /dev/null @@ -1,55 +0,0 @@ -$!# nget.ssc -$!# WNB 920908 -$!# -$!# Revisions: -$!# WNB 921002 Overhaul -$!# WNB 921019 Suppress ar messages -$!# WNB 921130 Cater for long names -$!# WNB 921208 Add log; -a0 switch -$!# HjV 921229 Make SSC; HP got only 14 char. in library -$!# WNB 921230 Correct HP test -$!# WNB 930325 Cater for different fold -$!# WNB 930330 Add .A.. and .X.. -$!# -$!# Get file from text library. Use as: -$!# -$!# source $WNG/nget.sun (Unix) -$!# @WNG:NGET <file> (VAX) -$!# -$!# The command file uses many local nxec variables, and -$!# environment variables: WNG, WNG_TLB, WNG_TYPE -$!# command files: -$!# -$ ON ERROR THEN GOTO ERR -$ L0=F$SEARCH("''FNM'''FTP'") !FOR REFERENCE -$ IF CD_A .NES. "0" .AND. L0 .NES. "" THEN GOTO EXIT !DO NOT DO -$ SET MESSAGE /NOIDEN/NOFACIL/NOSEVER/NOTEXT -$ SET NOON -$ ASSIGN/USER NL: SYS$OUTPUT -$ IF F$EXTRACT(1,1,FTP) .EQS. "A" .OR. - - F$EXTRACT(1,1,FTP) .EQS. "X" -$ THEN -$ LIBRARY/TEXT/EXTRACT='FNM''FTP'/OUT='FNM''FTP' 'WNG_TLB''L_D'_AX.TLB -$ ELSE -$ LIBRARY/TEXT/EXTRACT='FNM''FTP'/OUT='FNM''FTP' 'WNG_TLB''L_D'.TLB -$ ENDIF -$ SET ON -$ SET MESSAGE /IDEN/FACIL/SEVER/TEXT -$ L1=F$SEARCH("''FNM'''FTP'") !SEE IF DONE -$ IF L1 .EQS. "" .OR. L0 .EQS. L1 THEN GOTO ERR !NOT DONE -$ IF F$EXTRACT(1,1,FTP) .EQS. "A" .OR. - - F$EXTRACT(1,1,FTP) .EQS. "X" -$ THEN -$ MSGT=MSGT+" got [''F$PARSE(L_D,,,"NAME","SYNTAX_ONLY")'_AX.TLB]" -$ ELSE -$ MSGT=MSGT+" got [''F$PARSE(L_D,,,"NAME","SYNTAX_ONLY")'.TLB]" -$ ENDIF -$ GOTO ERR1 -$!# -$!# Ready -$!# -$ ! -$ ERR: B1="Not: " -$ ERR1: TELL B1+FNM+FTP+MSGT -$ UTELL B1+FNM+FTP+MSGT -$ EXIT: EXIT diff --git a/src/wng/nget.ssc b/src/wng/nget.ssc deleted file mode 100644 index c6318c68744ea3010db14c62195fed877e0cbd26..0000000000000000000000000000000000000000 --- a/src/wng/nget.ssc +++ /dev/null @@ -1,106 +0,0 @@ -# nget.ssc -# WNB 920908 -# -# Revisions: -# WNB 921002 Overhaul -# WNB 921019 Suppress ar messages -# WNB 921130 Cater for long names -# WNB 921208 Add log; -a0 switch -# HjV 921229 Make SSC; HP got only 14 char. in library -# WNB 921230 Correct HP test -# WNB 930325 Cater for different fold -# WNB 930330 Add .A.. and .X.. -# -# Get file from text library. Use as: -# -# source $WNG/nget.sun (Unix) -# @WNG:NGET <file> (VAX) -# -# The command file uses many local nxec variables, and -# environment variables: WNG, WNG_TLB, WNG_TYPE -# command files: -# -#ifdef wn_vax__ -$ ON ERROR THEN GOTO ERR -$ L0=F$SEARCH("''FNM'''FTP'") !FOR REFERENCE -$ IF CD_A .NES. "0" .AND. L0 .NES. "" THEN GOTO EXIT !DO NOT DO -$ SET MESSAGE /NOIDEN/NOFACIL/NOSEVER/NOTEXT -$ SET NOON -$ ASSIGN/USER NL: SYS$OUTPUT -$ IF F$EXTRACT(1,1,FTP) .EQS. "A" .OR. - - F$EXTRACT(1,1,FTP) .EQS. "X" -$ THEN -$ LIBRARY/TEXT/EXTRACT='FNM''FTP'/OUT='FNM''FTP' 'WNG_TLB''L_D'_AX.TLB -$ ELSE -$ LIBRARY/TEXT/EXTRACT='FNM''FTP'/OUT='FNM''FTP' 'WNG_TLB''L_D'.TLB -$ ENDIF -$ SET ON -$ SET MESSAGE /IDEN/FACIL/SEVER/TEXT -$ L1=F$SEARCH("''FNM'''FTP'") !SEE IF DONE -$ IF L1 .EQS. "" .OR. L0 .EQS. L1 THEN GOTO ERR !NOT DONE -$ IF F$EXTRACT(1,1,FTP) .EQS. "A" .OR. - - F$EXTRACT(1,1,FTP) .EQS. "X" -$ THEN -$ MSGT=MSGT+" got [''F$PARSE(L_D,,,"NAME","SYNTAX_ONLY")'_AX.TLB]" -$ ELSE -$ MSGT=MSGT+" got [''F$PARSE(L_D,,,"NAME","SYNTAX_ONLY")'.TLB]" -$ ENDIF -$ GOTO ERR1 -#else - set msgt="" ; set b1="Done: " # message text/ok - if (-e ${lobh}.$lobe) then # already there - if ("$cd_a" != "0") goto RETURN # no re-ask - 'rm' ${lobh}.$lobe # make sure new one - endif - set l00=(`echo ${lobh}.$lobe | wc -c`) # length name - if ("$lobe" =~ [ax]??) then - ar x $WNG_TLB/${l_d}_ax.tlb ${lobh}.$lobe >& /dev/null # get file - else - ar x $WNG_TLB/${l_d}.tlb ${lobh}.$lobe >& /dev/null # get file - endif - if (! -e ${lobh}.$lobe) then # not found; too long? - if ("$WNG_TYPE" == "hp") then # make sure length - set l01a=15 - set l01b=14 - else - set l01a=16 - set l01b=15 - endif - if ($l00 > $l01a) then # name > 14; try short - set l02=(`echo ${lobh}.$lobe | ${fold}$l01b`) # break name - if ("$lobe" =~ [ax]??) then - ar x $WNG_TLB/${l_d}_ax.tlb $l02[1] >& /dev/null # get file - else - ar x $WNG_TLB/${l_d}.tlb $l02[1] >& /dev/null # get file - endif - if (! -e $l02[1]) goto NGERR # not there - 'mv' $l02[1] ${lobh}.$lobe >& /dev/null # make correct name - endif - endif - if (! -e ${lobh}.$lobe) goto NGERR # not found - set l02=$WNG_TLB - set l00=$l02:h ; set l01=$l02:t - set l00=$l00:t/$l01 - if ("$lobe" =~ [ax]??) then - set msgt="$msgt got [$l00/${l_d}_ax.tlb]" - else - set msgt="$msgt got [$l00/${l_d}.tlb]" - endif - goto NGEX # ready -#endif -# -# Ready -# -#ifdef wn_vax__ -$ ! -$ ERR: B1="Not: " -$ ERR1: TELL B1+FNM+FTP+MSGT -$ UTELL B1+FNM+FTP+MSGT -$ EXIT: EXIT -#else -NGERR: - set b1="Not: " -NGEX: - echo "$b1 ${lobh}.$lobe $msgt" | tee -a $c_upd -RETURN: -#endif diff --git a/src/wng/nget.sun b/src/wng/nget.sun deleted file mode 100755 index 7d8f561b7a25c4696cf46e79a9f4ad1028e02cc6..0000000000000000000000000000000000000000 --- a/src/wng/nget.sun +++ /dev/null @@ -1,70 +0,0 @@ -# nget.ssc -# WNB 920908 -# -# Revisions: -# WNB 921002 Overhaul -# WNB 921019 Suppress ar messages -# WNB 921130 Cater for long names -# WNB 921208 Add log; -a0 switch -# HjV 921229 Make SSC; HP got only 14 char. in library -# WNB 921230 Correct HP test -# WNB 930325 Cater for different fold -# WNB 930330 Add .A.. and .X.. -# -# Get file from text library. Use as: -# -# source $WNG/nget.sun (Unix) -# @WNG:NGET <file> (VAX) -# -# The command file uses many local nxec variables, and -# environment variables: WNG, WNG_TLB, WNG_TYPE -# command files: -# - set msgt="" ; set b1="Done: " # message text/ok - if (-e ${lobh}.$lobe) then # already there - if ("$cd_a" != "0") goto RETURN # no re-ask - 'rm' ${lobh}.$lobe # make sure new one - endif - set l00=(`echo ${lobh}.$lobe | wc -c`) # length name - if ("$lobe" =~ [ax]??) then - ar x $WNG_TLB/${l_d}_ax.tlb ${lobh}.$lobe >& /dev/null # get file - else - ar x $WNG_TLB/${l_d}.tlb ${lobh}.$lobe >& /dev/null # get file - endif - if (! -e ${lobh}.$lobe) then # not found; too long? - if ("$WNG_TYPE" == "hp") then # make sure length - set l01a=15 - set l01b=14 - else - set l01a=16 - set l01b=15 - endif - if ($l00 > $l01a) then # name > 14; try short - set l02=(`echo ${lobh}.$lobe | ${fold}$l01b`) # break name - if ("$lobe" =~ [ax]??) then - ar x $WNG_TLB/${l_d}_ax.tlb $l02[1] >& /dev/null # get file - else - ar x $WNG_TLB/${l_d}.tlb $l02[1] >& /dev/null # get file - endif - if (! -e $l02[1]) goto NGERR # not there - 'mv' $l02[1] ${lobh}.$lobe >& /dev/null # make correct name - endif - endif - if (! -e ${lobh}.$lobe) goto NGERR # not found - set l02=$WNG_TLB - set l00=$l02:h ; set l01=$l02:t - set l00=$l00:t/$l01 - if ("$lobe" =~ [ax]??) then - set msgt="$msgt got [$l00/${l_d}_ax.tlb]" - else - set msgt="$msgt got [$l00/${l_d}.tlb]" - endif - goto NGEX # ready -# -# Ready -# -NGERR: - set b1="Not: " -NGEX: - echo "$b1 ${lobh}.$lobe $msgt" | tee -a $c_upd -RETURN: diff --git a/src/wng/nhelp.com b/src/wng/nhelp.com deleted file mode 100755 index de0d95a1d4b7c845b5e9e74ad38b4c2f62c1cab7..0000000000000000000000000000000000000000 --- a/src/wng/nhelp.com +++ /dev/null @@ -1,294 +0,0 @@ -$!# nhelp.ssc -$!# WNB 920908 -$!# -$!# Revisions: -$!# WNB 920922 Add .fun -$!# WNB 921001 Overhaul -$!# WNB 921014 Add -a nnet -$!# WNB 921117 Add regular expressions -$!# WNB 921122 Delete .uin -$!# WNB 921208 Add update note; -a switch -$!# WNB 921211 Add QP -$!# WNB 921216 Add ## -$!# WNB 921218 Add FSC etc -$!# WNB 921230 Make SSC -$!# WNB 930303 No more DWARF share -$!# WNB 930330 Add .A.. and .X.. -$!# WNB 930803 Add .dsf -$!# -$!# Help text for nxec commands. Used from nxec as: -$!# csh -f nhelp.sun tp typ ext pcod pnam chtp (Unix) -$!# @WNG:NHELP tp typ (VAX) -$!# where: -$!# tp= 1 help on command 2 on codes 3 on filenames -$!# typ= nxec given type -$!# ext= current machine extension (e.g. dw) -$!# pcod= program code (e.g. nc) -$!# pnam= program name (e.g. ncomp) -$!# chtp= list of extension to be bypassed -$!# -$!# Also uses the environment variables WNG and *Q_D -$!# -$!# Intro -$!# -$ TYP=P2 ! TYPE -$ GOTO H'P1' ! DISTRIBUTE -$!# -$!# Command level -$!# -$ H1: TELL "" -$ TELL "Unknown NXEC type (''TYP')" -$ TELL " " -$ TELL "The @WNG:NXEC command can compile, link and maintain all sorts of" -$ TELL "files, and, optionally, update the DWARF system." -$ TELL "The general use is:" -$ TELL " @WNG:NXEC type [-codes ...] [name[,...] ...]" -$ TELL "The type can be:" -$ TELL " NC[ompile] to compile" -$ TELL " NL[ink] to link" -$ TELL " ND[elete] to delete" -$ TELL " NG[et] to get from TLB" -$ TELL " NN[et] to get across net" -$ TELL " NX[ref] to produce crossreference between Fortran files" -$ TELL "In general there will be symbols defined" -$ L0="''F$TRNLNM("WNG")'WNGCSHRC_''WNG_SITE'.COM" -$ TELL "(in ''F$PARSE(L0,,,,"NO_CONCEAL")') to" -$ TELL "call the different modes directly as:" -$ TELL " NXEC, NCOMP, NLINK, NDEL, NGET, NNET, NXREF." -$ TELL "More Help is available by specifying a type and no further" -$ TELL "arguments, or by specifying a ? somewhere in the argument list." -$ TELL "E.g.: $ NCOMP or $ NXEC NCOMP" -$ TELL "A file UPDyymmdd.LOG will describe the results" -$ TELL "Retry NXEC command with a type, or in short form." -$ TELL "" -$ GOTO EXEX -$!# -$!# Codes level -$!# -$ H2: TELL "" -$ TELL "The @NXEC <type> command can have codes and (file)names as" -$ TELL "arguments. A code argument starts with a - or +. Help on filename" -$ TELL "arguments is available by not specifying a filename." -$ TELL "Codes are a single letter, optionally preceded by an N or a + to" -$ TELL "indicate negation, or followed by a single digit to subspecify" -$ TELL "information. Some codes accept an argument in <> brackets, e.g." -$ TELL "L<MYLIB>." -$ TELL "Q[ualifier] codes are special codes. They are followed by a" -$ TELL "letter to indicate the qualifier type, and an angle-bracketed" -$ TELL "string with the qualifier, e.g. QB</AFTER=TODAY> ." -$ TELL "Codes will be read left-to-write (e.g. BNB = NB, NBB = B)." -$ TELL "The codes specified will be preceded by codes specified in" -$ TELL "the possibly defined logical name ''PCOD'_COD." -$ TELL "The known codes for ''TYP' are (default given first):" -$ TELL " ? this help text" -$ TELL " NB B execute as Batch job, without a log" -$ TELL " B1 execute as Batch job, with a printed log" -$ TELL " B2 execute as a spawned command, with log in SPAWN.LOG" -$ GOSUB H2'PCOD' -$ TELL "" -$ GOTO EXEX -$!# -$!# NCOMP codes -$!# -$ H2NC: TELL " NA A1 alter Dwarf routines (INCLUDE '(abc)' to 'ABC' and" -$ TELL " PROGRAM to SUBROUTINE)" -$ TELL " A2 alter Fortran routines (INCLUDE 'xxx:abc.def' to" -$ TELL " INCLUDE 'ABC.DEF') and" -$ TELL " alter Fortran routines (INCLUDE 'abc.def' to" -$ TELL " INCLUDE 'ABC_DEF') and C routines" -$ TELL " (include abc.inc to include abc_inc)" -$ TELL " A4 alter INTEGER*4/REAL*4 into INTEGER/REAL, REAL*8 into" -$ TELL " DOUBLE PRECISION, LOGICAL*1 into BYTE" -$ TELL " May combine switches (A6 = A2 + A4)" -$ TELL " C NC compile .FOR, .FVX, .FSC, .MVX, .DSC, .PSC," -$ TELL " .HLP, .DEF, .INC, .AVX, .XVX" -$ TELL " D ND use /DEBUG in compiling" -$ TELL " L NL save .OBJ in WNLIB.OLB (if C), and save text of all" -$ TELL " L1 files (except some, see filename help) in WNLIB.TLB." -$ TELL " L1: only uses .olb, not .tlb" -$ TELL " By specifying L<name> the default WNLIB name can be" -$ TELL " overwritten." -$ TELL " O NO optimize Fortran compilation" -$ TELL " NP P print the compilation listing" -$ TELL " NU U update in DWARF sytem if .PIN or .HLP" -$ TELL " update in WN system if .DEF, .PEF, .DSF or .INC" -$ TELL " NX X produce XREF listing in Macro and Fortran compilation" -$ TELL " Z NZ act on .GRP extension" -$ TELL "" -$ TELL " QB<.> batch execution qualifier (e.g. QB</AFTER=TOMORROW>)" -$ TELL " QF<.> Fortran qualifier (e.g. QF</NOI4>). Default:" -$ TELL " ''FQ_D'" -$ TELL " QI<.> Macro header files" -$ TELL " QJ<.> Fortran header files (e.g. QJ<MYA.INC+MYB.INC>)" -$ TELL " QM<.> Macro qualifiers" -$ TELL " QP<.> Pure extensions (with .): only files with these" -$ TELL " extensions will be done. Default: ''PQ_D'" -$ RETURN -$!# -$!# NNET codes -$!# -$ H2NN: TELL " NA A ask node information i.s.o. using default" -$ TELL " Z NZ act on .GRP extension" -$ TELL "" -$ TELL " QB<.> batch execution qualifier (e.g. QB</AFTER=TOMORROW>)" -$ TELL " QP<.> Pure extensions (with .): only files with these" -$ TELL " extensions will be done. Default: ''PQ_D'" -$ TELL "" -$ TELL "NNET uses the following symbols to find the foreign network:" -$ TELL " WNG_NODE the node (e.g. rzmvx4 or robin.atnf.csiro.au)" -$ TELL " WNG_NODEDIR the root directory (e.g. USER5:[WNB] or /usr/wnb)" -$ TELL " WNG_NODEUSER the user (e.g. wbrouw) -$ TELL "" -$ RETURN -$!# -$!# NDEL codes -$!# -$ H2ND: TELL " A NA ask confirmation for each deletion" -$ TELL " C NC compiled data (.OBJ, .PPD etc) are deleted" -$ TELL " L NL delete .OBJ in WNLIB.OLB (if C), and delete text of" -$ TELL " L1 files (except some, see filename help) in WNLIB.TLB." -$ TELL " L1: only uses .olb, not .tlb" -$ TELL " By specifying L<name> the default WNLIB name can be" -$ TELL " overwritten." -$ TELL " NU U delete in DWARF sytem if .PIN or .HLP" -$ TELL " delete in WN system if .DEF, .PEF, .DSF or .INC" -$ TELL " Z NZ acts on .GRP extension" -$ TELL "" -$ TELL " QB<.> batch execution qualifier (e.g. QB</AFTER=TOMORROW>)" -$ TELL " QP<.> Pure extensions (with .): only files with these" -$ TELL " extensions will be done. Default: ''PQ_D'" -$ TELL "" -$ TELL " Note: only files present in (specified) directory can be deleted" -$ TELL " if wildcards or no extension present." -$ RETURN -$!# -$!# NGET codes -$!# -$ H2NG: TELL " NA A always get new file from .TLB, even if present" -$ TELL " L NL use WNLIB.TLB to extract files." -$ TELL " By specifying L<name> the default WNLIB name can be" -$ TELL " overwritten." -$ TELL " Z NZ acts on .GRP extension" -$ TELL "" -$ TELL " QB<.> batch execution qualifier (e.g. QB</AFTER=TOMORROW>)" -$ TELL " QP<.> Pure extensions (with .): only files with these" -$ TELL " extensions will be done. Default: ''PQ_D'" -$ RETURN -$!# -$!# NLINK codes -$!# -$ H2NL: TELL " NA A1 alter startup routine to exclude logging (Dwarf)" -$ TELL " ND D use /DEBUG in linking" -$ TELL " L NL use as L<name> to overwrite the default object" -$ TELL " library name WNLIB with another name." -$ TELL " NP P print the link map" -$ TELL " S NS use DWARF library in linking" -$ TELL " NU U update in DWARF sytem." -$ TELL " NX X produce XREF listing in link map" -$ TELL " Z NZ acts on .GRP extension" -$ TELL "" -$ TELL " QB<.> batch execution qualifier (e.g. QB</AFTER=TOMORROW>)" -$ TELL " QL<.> link qualifiers" -$ TELL " QO<.> link options (e.g. QO<MYLIB/LIB,HISLIB/LIB>)" -$ RETURN -$!# -$!# Filename level -$!# -$ H3: TELL "" -$ TELL "Filenames can be specified in separate arguments, or separated" -$ TELL "by commas in a single argument. Filenames can contain wildcards." -$ TELL "If no extension is given .* is assumed, except for indirect" -$ TELL "files where .GRP is assumed. A filename preceded by" -$ TELL "an @ will be assumed to contain filenames, as will be files with" -$ TELL "a .GRP extension (unless NZ code specified)." -$ TELL "The current default device and directory will be assumed if" -$ TELL "none are specified." -$ TELL ".GRP and @ files will contain a filename per line, optionally" -$ TELL "followed by a comment preceded with a !, or will be a comment" -$ TELL "comment line starting with a !. The filenames must have" -$ TELL "extensions, and cannot contain wildcards, but may have device" -$ TELL "and directory informations. Optionally the filename may be" -$ TELL "followed by standard switches, indicating" -$ TELL "codes to be used for this line only, e.g. compilation or" -$ TELL "linking data. E.g. A.FOR -NO will be compiled with" -$ TELL "no optimizing." -$ TELL "If the line starts with a # the line will be a UNIX shell" -$ TELL "command. If the line starts with a $," -$ TELL "the line will be given to DCL to be executed (e.g. to" -$ TELL "assign logical names)." -$ TELL "If the line starts with $$ or ## the next 3 characters are" -$ TELL "checked if they are pp$ (pp#) (pp any two characters). If the" -$ TELL "pp characters are identical to the program name that invoked" -$ TELL "the current .grp (e.g. NC), the command will be executed." -$ TELL "The action of the command will depend on the type of the file." -$ TELL "For ''TYP' the action will be:" -$ TELL " .GRP will be read as an indirect file (if not NZ code)" -$ GOSUB H3'PCOD' -$ TELL "" -$ GOTO EXEX -$!# -$!# NCOMP files -$!# -$ H3NC: TELL " .FOR, .FVX, .FSC will be compiled as Fortran programs (if C code)" -$ TELL " .MVX will be compiled as Macro program (if C)" -$ TELL " .DSC will be handled by WNGTAB (if C)" -$ TELL " .HLP will be put in .HLB with same name (if C)" -$ TELL " .PIN, .PSC will be compiled (if C)" -$ TELL " .DEF, .INC will be compiled (if C)" -$ TELL " All of the above will be put in" -$ TELL " .TLB (unless NL or L1 code)" -$ TELL " .AVX will be changed into an .OLB (if C)" -$ TELL " .XVX will be changed into an .EXE (if C)" -$ TELL " .A%%, .X%% will be put in _AX.TLB (unless NL or L1 code)" -$ TELL " ''F$EXTRACT(0,40,CHTP)'" -$ TELL " ''F$EXTRACT(40,-1,CHTP)' will be skipped" -$ TELL " All other files with 3 character extensions will be put in .TLB" -$ TELL " (unless NL or L1 code specified)." -$ TELL " All other files will be skipped." -$ RETURN -$!# -$!# NNET files -$!# -$ H3NN: TELL " ''F$EXTRACT(0,40,CHTP)'" -$ TELL " ''F$EXTRACT(40,-1,CHTP)' will be skipped" -$ TELL " All other files with 3 character extensions will be got" -$ TELL " All other files will be skipped." -$ RETURN -$!# -$!# NDEL files -$!# -$ H3ND: TELL " .FOR, .FVX, .FSC will be deleted as Fortran programs (if C code)" -$ TELL " .MVX will be deleted as Macro program (if C)" -$ TELL " .DSC will be handled by WNGTAB (if C)" -$ TELL " .HLP will be put in .HLB with same name (if C)" -$ TELL " .EXE will be deleted as rtask image" -$ TELL " .PIN, .PSC will be deleted as such (if C)" -$ TELL " .DEF, .INC will be deleted (if C)" -$ TELL " All of the above (except .EXE) will be deleted" -$ TELL " from .TLB (unless NL or L1 code)" -$ TELL " .A%%, .X%% will be deleted, also from _AX.TLB (unless codes)" -$ TELL " ''F$EXTRACT(0,40,CHTP)'" -$ TELL " ''F$EXTRACT(40,-1,CHTP)' will be skipped" -$ TELL " All other files with 3 character extensions will be deleted" -$ TELL " from .TLB (unless NL or L1 code specified)." -$ TELL " All other files will be skipped." -$ RETURN -$!# -$!# NGET files -$!# -$ H3NG: TELL " ''F$EXTRACT(0,40,CHTP)'" -$ TELL " ''F$EXTRACT(40,-1,CHTP)' will be skipped" -$ TELL " All other files with 3 character extensions will be got" -$ TELL " from .TLB (unless NL or L1 code specified)." -$ TELL " All other files will be skipped." -$ RETURN -$!# -$!# NLINK files -$!# -$ H3NL: TELL " .EXE will produce program" -$ TELL " if no extension program will be produced" -$ RETURN -$!# -$!# Ready -$!# -$ EXEX: EXIT diff --git a/src/wng/nhelp.ssc b/src/wng/nhelp.ssc deleted file mode 100644 index 5e9981bc8b370e0bb4accf29945b7e29235343aa..0000000000000000000000000000000000000000 --- a/src/wng/nhelp.ssc +++ /dev/null @@ -1,591 +0,0 @@ -# nhelp.ssc -# WNB 920908 -# -# Revisions: -# WNB 920922 Add .fun -# WNB 921001 Overhaul -# WNB 921014 Add -a nnet -# WNB 921117 Add regular expressions -# WNB 921122 Delete .uin -# WNB 921208 Add update note; -a switch -# WNB 921211 Add QP -# WNB 921216 Add ## -# WNB 921218 Add FSC etc -# WNB 921230 Make SSC -# WNB 930303 No more DWARF share -# WNB 930330 Add .A.. and .X.. -# WNB 930803 Add .dsf -# -# Help text for nxec commands. Used from nxec as: -# csh -f nhelp.sun tp typ ext pcod pnam chtp (Unix) -# @WNG:NHELP tp typ (VAX) -# where: -# tp= 1 help on command 2 on codes 3 on filenames -# typ= nxec given type -# ext= current machine extension (e.g. dw) -# pcod= program code (e.g. nc) -# pnam= program name (e.g. ncomp) -# chtp= list of extension to be bypassed -# -# Also uses the environment variables WNG and *Q_D -# -# Intro -# -#ifdef wn_vax__ -$ TYP=P2 ! TYPE -$ GOTO H'P1' ! DISTRIBUTE -#else - set tp=$1 ; set typ=$2 ; set ext=$3 - set pcod=$4 ; set pnam=$5 ; set chtp=($6) - goto HLPA$tp # distribute on type -#endif -# -# Command level -# -#ifdef wn_vax__ -$ H1: TELL "" -$ TELL "Unknown NXEC type (''TYP')" -$ TELL " " -$ TELL "The @WNG:NXEC command can compile, link and maintain all sorts of" -$ TELL "files, and, optionally, update the DWARF system." -$ TELL "The general use is:" -$ TELL " @WNG:NXEC type [-codes ...] [name[,...] ...]" -$ TELL "The type can be:" -$ TELL " NC[ompile] to compile" -$ TELL " NL[ink] to link" -$ TELL " ND[elete] to delete" -$ TELL " NG[et] to get from TLB" -$ TELL " NN[et] to get across net" -$ TELL " NX[ref] to produce crossreference between Fortran files" -$ TELL "In general there will be symbols defined" -$ L0="''F$TRNLNM("WNG")'WNGCSHRC_''WNG_SITE'.COM" -$ TELL "(in ''F$PARSE(L0,,,,"NO_CONCEAL")') to" -$ TELL "call the different modes directly as:" -$ TELL " NXEC, NCOMP, NLINK, NDEL, NGET, NNET, NXREF." -$ TELL "More Help is available by specifying a type and no further" -$ TELL "arguments, or by specifying a ? somewhere in the argument list." -$ TELL "E.g.: $ NCOMP or $ NXEC NCOMP" -$ TELL "A file UPDyymmdd.LOG will describe the results" -$ TELL "Retry NXEC command with a type, or in short form." -$ TELL "" -$ GOTO EXEX -#else -HLPA1: - echo "" - echo "Unknown NXEC type ($typ)" - echo "" - echo "The $WNG/nxec command can compile, link and maintain all sorts" - echo "of files, and, optionally, update the DWARF system." - echo "The general use is:" - echo " $WNG/nxec type [-codes ...] [name[,...] ...] [-codes ...]" - echo "The type can be:" - echo " NC[ompile] to compile" - echo " NL[ink] to link" - echo " ND[elete] to delete" - echo " NG[et] to get from TLB" - echo " NN[et] to get across net" - echo " NX[ref] to produce crossreference between Fortran files" - echo "In general there will be symbols defined" - echo "(in $WNG/wngcshrc_${WNG_SITE}.sun) to" - echo "call the different modes directly as:" - echo " NXEC, NCOMP, NLINK, NDEL, NGET, NXREF, NNET (UC or lc)." - echo "More Help is available by specifying a type and no further" - echo "arguments." - echo "E.g.: > ncomp or > nxec ncomp" - echo "Output is steered by environment variables." - echo "Most of them are defined in $WNG/wngcshrc_${WNG_SITE}.sun." - echo "They can be overwritten by the user. The following can" - echo "also be defined:" - echo " WNG_EXE, WNG_OLB, WNG_TLB, WNG_ERR, WNG_LIS," - echo " WNG_LINK, WNG_LDFILES" - echo "A file UPDyymmdd.LOG will describe your actions" - echo "Retry nxec command with a type, or in short form." - echo "" - goto exex -#endif -# -# Codes level -# -#ifdef wn_vax__ -$ H2: TELL "" -$ TELL "The @NXEC <type> command can have codes and (file)names as" -$ TELL "arguments. A code argument starts with a - or +. Help on filename" -$ TELL "arguments is available by not specifying a filename." -$ TELL "Codes are a single letter, optionally preceded by an N or a + to" -$ TELL "indicate negation, or followed by a single digit to subspecify" -$ TELL "information. Some codes accept an argument in <> brackets, e.g." -$ TELL "L<MYLIB>." -$ TELL "Q[ualifier] codes are special codes. They are followed by a" -$ TELL "letter to indicate the qualifier type, and an angle-bracketed" -$ TELL "string with the qualifier, e.g. QB</AFTER=TODAY> ." -$ TELL "Codes will be read left-to-write (e.g. BNB = NB, NBB = B)." -$ TELL "The codes specified will be preceded by codes specified in" -$ TELL "the possibly defined logical name ''PCOD'_COD." -$ TELL "The known codes for ''TYP' are (default given first):" -$ TELL " ? this help text" -$ TELL " NB B execute as Batch job, without a log" -$ TELL " B1 execute as Batch job, with a printed log" -$ TELL " B2 execute as a spawned command, with log in SPAWN.LOG" -$ GOSUB H2'PCOD' -$ TELL "" -$ GOTO EXEX -#else -HLPA2: - echo "" - echo "The NXEC <type> command can have codes and (file)names as" - echo "arguments. A code argument starts with a - or +. Help on filename" - echo "arguments is available by not specifying a filename." - echo "Codes are a single letter, optionally preceded by an N or a + to" - echo "indicate negation, or followed by a single digit to subspecify" - echo "information. Some codes accept an argument in <> brackets, e.g." - echo "L<MYLIB>." - echo "Q[ualifier] codes are special codes. They are followed by a" - echo "letter to indicate the qualifier type, and an angle-bracketed" - echo "string with the qualifier, e.g. QB</AFTER=TODAY> ." - echo "Codes will be read left-to-write (e.g. BNB = NB, NBB = B)." - echo "The codes specified will be preceded by codes specified in" - echo "the possibly defined environment variable ${pcod}_COD ." - echo "The known codes for $pnam are (default given first):" - echo " ? this help text" - echo " NB B execute as background job, without a log" - echo " B1 execute as background job, with a log in ./nx*.log" - goto H1$pcod -#endif -# -# NCOMP codes -# -#ifdef wn_vax__ -$ H2NC: TELL " NA A1 alter Dwarf routines (INCLUDE '(abc)' to 'ABC' and" -$ TELL " PROGRAM to SUBROUTINE)" -$ TELL " A2 alter Fortran routines (INCLUDE 'xxx:abc.def' to" -$ TELL " INCLUDE 'ABC.DEF') and" -$ TELL " alter Fortran routines (INCLUDE 'abc.def' to" -$ TELL " INCLUDE 'ABC_DEF') and C routines" -$ TELL " (include abc.inc to include abc_inc)" -$ TELL " A4 alter INTEGER*4/REAL*4 into INTEGER/REAL, REAL*8 into" -$ TELL " DOUBLE PRECISION, LOGICAL*1 into BYTE" -$ TELL " May combine switches (A6 = A2 + A4)" -$ TELL " C NC compile .FOR, .FVX, .FSC, .MVX, .DSC, .PSC," -$ TELL " .HLP, .DEF, .INC, .AVX, .XVX" -$ TELL " D ND use /DEBUG in compiling" -$ TELL " L NL save .OBJ in WNLIB.OLB (if C), and save text of all" -$ TELL " L1 files (except some, see filename help) in WNLIB.TLB." -$ TELL " L1: only uses .olb, not .tlb" -$ TELL " By specifying L<name> the default WNLIB name can be" -$ TELL " overwritten." -$ TELL " O NO optimize Fortran compilation" -$ TELL " NP P print the compilation listing" -$ TELL " NU U update in DWARF sytem if .PIN or .HLP" -$ TELL " update in WN system if .DEF, .PEF, .DSF or .INC" -$ TELL " NX X produce XREF listing in Macro and Fortran compilation" -$ TELL " Z NZ act on .GRP extension" -$ TELL "" -$ TELL " QB<.> batch execution qualifier (e.g. QB</AFTER=TOMORROW>)" -$ TELL " QF<.> Fortran qualifier (e.g. QF</NOI4>). Default:" -$ TELL " ''FQ_D'" -$ TELL " QI<.> Macro header files" -$ TELL " QJ<.> Fortran header files (e.g. QJ<MYA.INC+MYB.INC>)" -$ TELL " QM<.> Macro qualifiers" -$ TELL " QP<.> Pure extensions (with .): only files with these" -$ TELL " extensions will be done. Default: ''PQ_D'" -$ RETURN -#else -H1nc: - echo " NA A1 alter Dwarf routines (INCLUDE '(abc)' to 'ABC' and" - echo " PROGRAM to SUBROUTINE)" - echo " A2 alter Fortran routines (INCLUDE 'xxx:abc.def' to" - echo " INCLUDE 'ABC.DEF') and" - echo " alter Fortran routines (INCLUDE 'abc.def' to" - echo " INCLUDE 'ABC_DEF') and C routines" - echo " (include abc.inc to abc_inc)" - echo " A4 alter INTEGER*4/REAL*4/REAL*8/LOGICAL*1 into:" - echo " INTEGER/REAL/DOUBLE PRECISION/BYTE" - echo " May combine switches (A6 = A2 + A4)" - echo " C NC compile .FOR, .F$ext, .FUN, .M$ext, .CEE, C$ext," - echo " .CUN, .FSC, .CSC, .SSC, .PSC," - echo " .DSC, .PIN, .HLP, .DEF, .INC, .A$ext, .X$ext" - echo " D ND use DEBUG (-g) in compiling" - echo " L NL save .o in wnlib.olb (if C), and save text of all" - echo " L1 files (except some, see filename help) in wnlib.tlb." - echo " L1: only uses .olb, not .tlb" - echo " By specifying L<name> the default wnlib name can be" - echo " overwritten." - echo " O NO optimize compilation" - echo " NP P print the compilation listing" - echo " NU U update in DWARF sytem if .PIN" - echo " update in WN system if .DEF, .PEF, .DSF or .INC" - echo " X NX produce XREF listing in Fortran compilation" - echo " Z NZ act on .GRP extension" - echo "" - echo " QB<.> background execution qualifier. Default: $bQ_D" - echo " QC<.> C qualifier. Default: $cQ_D" - echo " QF<.> Fortran qualifier. Default: $fQ_D" - echo " QM<.> Macro (assembler) qualifiers. Default: $mQ_D" - echo " QP<.> Pure extensions (with .). Only files with these" - echo " extensions will be done. Default: $pQ_D" - echo "" - goto HLP1 -#endif -# -# NNET codes -# -#ifdef wn_vax__ -$ H2NN: TELL " NA A ask node information i.s.o. using default" -$ TELL " Z NZ act on .GRP extension" -$ TELL "" -$ TELL " QB<.> batch execution qualifier (e.g. QB</AFTER=TOMORROW>)" -$ TELL " QP<.> Pure extensions (with .): only files with these" -$ TELL " extensions will be done. Default: ''PQ_D'" -$ TELL "" -$ TELL "NNET uses the following symbols to find the foreign network:" -$ TELL " WNG_NODE the node (e.g. rzmvx4 or robin.atnf.csiro.au)" -$ TELL " WNG_NODEDIR the root directory (e.g. USER5:[WNB] or /usr/wnb)" -$ TELL " WNG_NODEUSER the user (e.g. wbrouw) -$ TELL "" -$ RETURN -#else -H1nn: - echo " NA A ask node information, i.s.o. using defaults" - echo " Z NZ act on .GRP extension" - echo "" - echo " QB<.> background execution qualifier. Default: $bQ_D" - echo " QP<.> Pure extensions (with .). Only files with these" - echo " extensions will be done. Default: $pQ_D" - echo "" - goto HLP1 -#endif -# -# NDEL codes -# -#ifdef wn_vax__ -$ H2ND: TELL " A NA ask confirmation for each deletion" -$ TELL " C NC compiled data (.OBJ, .PPD etc) are deleted" -$ TELL " L NL delete .OBJ in WNLIB.OLB (if C), and delete text of" -$ TELL " L1 files (except some, see filename help) in WNLIB.TLB." -$ TELL " L1: only uses .olb, not .tlb" -$ TELL " By specifying L<name> the default WNLIB name can be" -$ TELL " overwritten." -$ TELL " NU U delete in DWARF sytem if .PIN or .HLP" -$ TELL " delete in WN system if .DEF, .PEF, .DSF or .INC" -$ TELL " Z NZ acts on .GRP extension" -$ TELL "" -$ TELL " QB<.> batch execution qualifier (e.g. QB</AFTER=TOMORROW>)" -$ TELL " QP<.> Pure extensions (with .): only files with these" -$ TELL " extensions will be done. Default: ''PQ_D'" -$ TELL "" -$ TELL " Note: only files present in (specified) directory can be deleted" -$ TELL " if wildcards or no extension present." -$ RETURN -#else -H1nd: - echo " A NA ask confirmation for each deletion" - echo " C NC compiled data (.o, .ppd etc) are deleted" - echo " L NL delete .o in wnlib.olb (if C), and delete text of" - echo " L1 files (except some, see filename help) in wnlib.tlb." - echo " L1: only uses .olb, not .tlb" - echo " By specifying L<name> the default wnlib name can be" - echo " NU U delete in DWARF sytem if .PIN" - echo " delete in WN system if .DEF, .PEF, .DSF or .INC" - echo " Z NZ act on .GRP extension" - echo "" - echo " QB<.> background execution qualifier. Default: $bQ_D" - echo " QP<.> Pure extensions (with .). Only files with these" - echo " extensions will be done. Default: $pQ_D" - echo "" - echo " Note: only files present in (specified) directory can be deleted" - echo " if wildcards or no extension present." - echo "" - goto HLP1 -#endif -# -# NGET codes -# -#ifdef wn_vax__ -$ H2NG: TELL " NA A always get new file from .TLB, even if present" -$ TELL " L NL use WNLIB.TLB to extract files." -$ TELL " By specifying L<name> the default WNLIB name can be" -$ TELL " overwritten." -$ TELL " Z NZ acts on .GRP extension" -$ TELL "" -$ TELL " QB<.> batch execution qualifier (e.g. QB</AFTER=TOMORROW>)" -$ TELL " QP<.> Pure extensions (with .): only files with these" -$ TELL " extensions will be done. Default: ''PQ_D'" -$ RETURN -#else -H1ng: - echo " NA A always get new file from .tlb, even if present" - echo " L NL use wnlib.tlb to extract files." - echo " By specifying L<name> the default wnlib name can be" - echo " overwritten." - echo " Z NZ act on .GRP extension" - echo "" - echo " QB<.> batch execution qualifier. Default: $bQ_D" - echo " QP<.> Pure extensions (with .). Only files with these" - echo " extensions will be done. Default: $pQ_D" - echo "" - goto HLP1 -#endif -# -# NLINK codes -# -#ifdef wn_vax__ -$ H2NL: TELL " NA A1 alter startup routine to exclude logging (Dwarf)" -$ TELL " ND D use /DEBUG in linking" -$ TELL " L NL use as L<name> to overwrite the default object" -$ TELL " library name WNLIB with another name." -$ TELL " NP P print the link map" -$ TELL " S NS use DWARF library in linking" -$ TELL " NU U update in DWARF sytem." -$ TELL " NX X produce XREF listing in link map" -$ TELL " Z NZ acts on .GRP extension" -$ TELL "" -$ TELL " QB<.> batch execution qualifier (e.g. QB</AFTER=TOMORROW>)" -$ TELL " QL<.> link qualifiers" -$ TELL " QO<.> link options (e.g. QO<MYLIB/LIB,HISLIB/LIB>)" -$ RETURN -#else -H1nl: - echo " NA A1 alter startup routine to exclude logging (Dwarf)" - echo " D ND use DEBUG (-g) in linking" - echo " L NL use as L<name> to overwrite the default object" - echo " library wnlib with other name." - echo " NP P print the link map" - echo " S NS use DWARF library in linking" - echo " NU U update in DWARF sytem" - echo " NX X produce XREF listing in link map" - echo " Z NZ act on .GRP extension" - echo "" - echo " QB<.> batch execution qualifier. Default: $bQ_D" - echo " QL<.> link qualifiers. Default: $lQ_D" - echo " QO<.> link options. Default: $oQ_D" - echo "" - goto HLP1 -HLP1: - echo "General Help by just typing > nxec" - echo "" - goto exex # ask codes -#endif -# -# Filename level -# -#ifdef wn_vax__ -$ H3: TELL "" -$ TELL "Filenames can be specified in separate arguments, or separated" -$ TELL "by commas in a single argument. Filenames can contain wildcards." -$ TELL "If no extension is given .* is assumed, except for indirect" -$ TELL "files where .GRP is assumed. A filename preceded by" -$ TELL "an @ will be assumed to contain filenames, as will be files with" -$ TELL "a .GRP extension (unless NZ code specified)." -$ TELL "The current default device and directory will be assumed if" -$ TELL "none are specified." -$ TELL ".GRP and @ files will contain a filename per line, optionally" -$ TELL "followed by a comment preceded with a !, or will be a comment" -$ TELL "comment line starting with a !. The filenames must have" -$ TELL "extensions, and cannot contain wildcards, but may have device" -$ TELL "and directory informations. Optionally the filename may be" -$ TELL "followed by standard switches, indicating" -$ TELL "codes to be used for this line only, e.g. compilation or" -$ TELL "linking data. E.g. A.FOR -NO will be compiled with" -$ TELL "no optimizing." -$ TELL "If the line starts with a # the line will be a UNIX shell" -$ TELL "command. If the line starts with a $," -$ TELL "the line will be given to DCL to be executed (e.g. to" -$ TELL "assign logical names)." -$ TELL "If the line starts with $$ or ## the next 3 characters are" -$ TELL "checked if they are pp$ (pp#) (pp any two characters). If the" -$ TELL "pp characters are identical to the program name that invoked" -$ TELL "the current .grp (e.g. NC), the command will be executed." -$ TELL "The action of the command will depend on the type of the file." -$ TELL "For ''TYP' the action will be:" -$ TELL " .GRP will be read as an indirect file (if not NZ code)" -$ GOSUB H3'PCOD' -$ TELL "" -$ GOTO EXEX -#else -HLPA3: - echo "" - echo "Filenames can be specified in separate arguments, or separated" - echo "by commas in a single argument. Filenames can contain wildcards." - echo "If no extension is given .* is assumed, except for indirect" - echo "files where .GRP is assumed. A filename preceded by" - echo "an @ will be assumed to be indirect and contain filenames," - echo "as will be files with" - echo "a .GRP extension (unless NZ code specified)." - echo "The current default device and directory will be assumed if" - echo "none are specified." - echo "Filenames can be given (except for nlink) as regular expressions" - echo "(they should in general be enclosed in ''). In that case" - echo "the regular expression will be matched against files in" - echo "in the .tlb text library." - echo ".GRP and @ files will contain a filename per line, optionally" - echo "followed by a comment preceded with a \!, or will be a comment" - echo "line starting with a \!. The filenames must have" - echo "extensions, and cannot contain wildcards, but may have device" - echo "and directory information." - echo "Optionally the filename may be followed by standard switches," - echo "indicating codes to be used for this line only, e.g. compilation or" - echo "linking data. E.g. A.FOR -no will be compiled with" - echo "no optimizing." - echo "If the line starts with a # the line will be" - echo "a UNIX shell command." - echo "If the line starts with a $ ," - echo "the line will be given to DCL to be executed (e.g. to" - echo "assign logical names)." - echo 'If the line starts with $$ or ## the next 3 characters are' - echo 'checked if they are pp$ (pp#) (pp any two characters). If the' - echo "pp characters are identical to the program name that invoked" - echo "the current .grp (e.g. NC), the command will be executed." - echo "The action of the command will depend on the type of the file." - echo "For $pnam the action will be:" - echo " .GRP will be read as an indirect file (if not NZ code)" - goto H2$pcod -#endif -# -# NCOMP files -# -#ifdef wn_vax__ -$ H3NC: TELL " .FOR, .FVX, .FSC will be compiled as Fortran programs (if C code)" -$ TELL " .MVX will be compiled as Macro program (if C)" -$ TELL " .DSC will be handled by WNGTAB (if C)" -$ TELL " .HLP will be put in .HLB with same name (if C)" -$ TELL " .PIN, .PSC will be compiled (if C)" -$ TELL " .DEF, .INC will be compiled (if C)" -$ TELL " All of the above will be put in" -$ TELL " .TLB (unless NL or L1 code)" -$ TELL " .AVX will be changed into an .OLB (if C)" -$ TELL " .XVX will be changed into an .EXE (if C)" -$ TELL " .A%%, .X%% will be put in _AX.TLB (unless NL or L1 code)" -$ TELL " ''F$EXTRACT(0,40,CHTP)'" -$ TELL " ''F$EXTRACT(40,-1,CHTP)' will be skipped" -$ TELL " All other files with 3 character extensions will be put in .TLB" -$ TELL " (unless NL or L1 code specified)." -$ TELL " All other files will be skipped." -$ RETURN -#else -H2nc: - echo " .FOR, .F$ext, .FUN, .FSC" - echo " will be compiled as Fortran programs (if C code)" - echo " .CEE, .C$ext, .CUN, .CSC" - echo " will be compiled as C programs (if C)" - echo " .M$ext will be compiled as Macro program (if C)" - echo " .DSC will be handled by WNGTAB (if C)" - echo " .HLP will be put in .HLB with same name (if C)" - echo " .PIN, .PSC will be compiled (if C)" - echo " .SSC will be compiled (if C)" - echo " .DEF, .INC will be compiled (if C)" - echo " All of the above will be put in" - echo " .tlb (unless NL or L1 code)" - echo " .A$ext will be converted to an .olb (if C)" - echo " .X$ext will be converted to an .exe (if C)" - echo " .A??, .X?? will be put in _ax.tlb (unless NL or L1 code)" - echo " $chtp[1-8]" - echo " $chtp[9*] will be skipped" - echo " All other files with 3 character extensions will be put in .tlb" - echo " (unless NL or L1 code specified)." - echo " All other files will be skipped." - goto H21 -#endif -# -# NNET files -# -#ifdef wn_vax__ -$ H3NN: TELL " ''F$EXTRACT(0,40,CHTP)'" -$ TELL " ''F$EXTRACT(40,-1,CHTP)' will be skipped" -$ TELL " All other files with 3 character extensions will be got" -$ TELL " All other files will be skipped." -$ RETURN -#else -H2nn: - echo " $chtp[1-8]" - echo " $chtp[9*] will be skipped" - echo " All other files with 3 character extensions will be got" - echo " All other files will be skipped." - goto H21 -#endif -# -# NDEL files -# -#ifdef wn_vax__ -$ H3ND: TELL " .FOR, .FVX, .FSC will be deleted as Fortran programs (if C code)" -$ TELL " .MVX will be deleted as Macro program (if C)" -$ TELL " .DSC will be handled by WNGTAB (if C)" -$ TELL " .HLP will be put in .HLB with same name (if C)" -$ TELL " .EXE will be deleted as rtask image" -$ TELL " .PIN, .PSC will be deleted as such (if C)" -$ TELL " .DEF, .INC will be deleted (if C)" -$ TELL " All of the above (except .EXE) will be deleted" -$ TELL " from .TLB (unless NL or L1 code)" -$ TELL " .A%%, .X%% will be deleted, also from _AX.TLB (unless codes)" -$ TELL " ''F$EXTRACT(0,40,CHTP)'" -$ TELL " ''F$EXTRACT(40,-1,CHTP)' will be skipped" -$ TELL " All other files with 3 character extensions will be deleted" -$ TELL " from .TLB (unless NL or L1 code specified)." -$ TELL " All other files will be skipped." -$ RETURN -#else -H2nd: - echo " .FOR, .F$ext, .FUN, .FSC" - echo " will be deleted as Fortran programs (if C code)" - echo " .CEE, .C$ext, .CUN, .CSC" - echo " will be deleted as C programs (if C code)" - echo " .M$ext will be deleted as Macro program (if C)" - echo " .DSC will be handled by WNGTAB (if C)" - echo " .HLP will be put in .HLB with same name (if C)" - echo " .EXE will be deleted as a task image" - echo " .PIN, .PSC will be deleted (if C)" - echo " .SSC will be deleted (if C)" - echo " .DEF, .INC will be deleted (if C)" - echo " All of the above (except .exe) will be deleted" - echo " from .tlb (unless NL or L1 code)" - echo " .A??, .X?? will be deleted, also from _ax.tlb (unless codes)" - echo " $chtp[1-8]" - echo " $chtp[9*] will be skipped" - echo " All other files with 3 character extensions will be deleted" - echo " from .tlb (unless NL or L1 code specified)." - echo " All other files will be skipped." - goto H21 -#endif -# -# NGET files -# -#ifdef wn_vax__ -$ H3NG: TELL " ''F$EXTRACT(0,40,CHTP)'" -$ TELL " ''F$EXTRACT(40,-1,CHTP)' will be skipped" -$ TELL " All other files with 3 character extensions will be got" -$ TELL " from .TLB (unless NL or L1 code specified)." -$ TELL " All other files will be skipped." -$ RETURN -#else -H2ng: - echo " $chtp[1-8]" - echo " $chtp[9*] will be skipped" - echo " All other files with 3 character extensions will be got" - echo " from .tlb (unless NL or L1 code specified)." - echo " All other files will be skipped." - goto H21 -#endif -# -# NLINK files -# -#ifdef wn_vax__ -$ H3NL: TELL " .EXE will produce program" -$ TELL " if no extension program will be produced" -$ RETURN -#else -H2nl: - echo " .EXE will produce program" - echo " if no extension program will be produced" - goto H21 -H21: - echo "" - goto exex -#endif -# -# Ready -# -#ifdef wn_vax__ -$ EXEX: EXIT -#else -exex: - exit -#endif diff --git a/src/wng/nhelp.sun b/src/wng/nhelp.sun deleted file mode 100755 index 0654c1ef8be3a306d65b42ba733b2685616d0150..0000000000000000000000000000000000000000 --- a/src/wng/nhelp.sun +++ /dev/null @@ -1,327 +0,0 @@ -# nhelp.ssc -# WNB 920908 -# -# Revisions: -# WNB 920922 Add .fun -# WNB 921001 Overhaul -# WNB 921014 Add -a nnet -# WNB 921117 Add regular expressions -# WNB 921122 Delete .uin -# WNB 921208 Add update note; -a switch -# WNB 921211 Add QP -# WNB 921216 Add ## -# WNB 921218 Add FSC etc -# WNB 921230 Make SSC -# WNB 930303 No more DWARF share -# WNB 930330 Add .A.. and .X.. -# WNB 930803 Add .dsf -# -# Help text for nxec commands. Used from nxec as: -# csh -f nhelp.sun tp typ ext pcod pnam chtp (Unix) -# @WNG:NHELP tp typ (VAX) -# where: -# tp= 1 help on command 2 on codes 3 on filenames -# typ= nxec given type -# ext= current machine extension (e.g. dw) -# pcod= program code (e.g. nc) -# pnam= program name (e.g. ncomp) -# chtp= list of extension to be bypassed -# -# Also uses the environment variables WNG and *Q_D -# -# Intro -# - set tp=$1 ; set typ=$2 ; set ext=$3 - set pcod=$4 ; set pnam=$5 ; set chtp=($6) - goto HLPA$tp # distribute on type -# -# Command level -# -HLPA1: - echo "" - echo "Unknown NXEC type ($typ)" - echo "" - echo "The $WNG/nxec command can compile, link and maintain all sorts" - echo "of files, and, optionally, update the DWARF system." - echo "The general use is:" - echo " $WNG/nxec type [-codes ...] [name[,...] ...] [-codes ...]" - echo "The type can be:" - echo " NC[ompile] to compile" - echo " NL[ink] to link" - echo " ND[elete] to delete" - echo " NG[et] to get from TLB" - echo " NN[et] to get across net" - echo " NX[ref] to produce crossreference between Fortran files" - echo "In general there will be symbols defined" - echo "(in $WNG/wngcshrc_${WNG_SITE}.sun) to" - echo "call the different modes directly as:" - echo " NXEC, NCOMP, NLINK, NDEL, NGET, NXREF, NNET (UC or lc)." - echo "More Help is available by specifying a type and no further" - echo "arguments." - echo "E.g.: > ncomp or > nxec ncomp" - echo "Output is steered by environment variables." - echo "Most of them are defined in $WNG/wngcshrc_${WNG_SITE}.sun." - echo "They can be overwritten by the user. The following can" - echo "also be defined:" - echo " WNG_EXE, WNG_OLB, WNG_TLB, WNG_ERR, WNG_LIS," - echo " WNG_LINK, WNG_LDFILES" - echo "A file UPDyymmdd.LOG will describe your actions" - echo "Retry nxec command with a type, or in short form." - echo "" - goto exex -# -# Codes level -# -HLPA2: - echo "" - echo "The NXEC <type> command can have codes and (file)names as" - echo "arguments. A code argument starts with a - or +. Help on filename" - echo "arguments is available by not specifying a filename." - echo "Codes are a single letter, optionally preceded by an N or a + to" - echo "indicate negation, or followed by a single digit to subspecify" - echo "information. Some codes accept an argument in <> brackets, e.g." - echo "L<MYLIB>." - echo "Q[ualifier] codes are special codes. They are followed by a" - echo "letter to indicate the qualifier type, and an angle-bracketed" - echo "string with the qualifier, e.g. QB</AFTER=TODAY> ." - echo "Codes will be read left-to-write (e.g. BNB = NB, NBB = B)." - echo "The codes specified will be preceded by codes specified in" - echo "the possibly defined environment variable ${pcod}_COD ." - echo "The known codes for $pnam are (default given first):" - echo " ? this help text" - echo " NB B execute as background job, without a log" - echo " B1 execute as background job, with a log in ./nx*.log" - goto H1$pcod -# -# NCOMP codes -# -H1nc: - echo " NA A1 alter Dwarf routines (INCLUDE '(abc)' to 'ABC' and" - echo " PROGRAM to SUBROUTINE)" - echo " A2 alter Fortran routines (INCLUDE 'xxx:abc.def' to" - echo " INCLUDE 'ABC.DEF') and" - echo " alter Fortran routines (INCLUDE 'abc.def' to" - echo " INCLUDE 'ABC_DEF') and C routines" - echo " (include abc.inc to abc_inc)" - echo " A4 alter INTEGER*4/REAL*4/REAL*8/LOGICAL*1 into:" - echo " INTEGER/REAL/DOUBLE PRECISION/BYTE" - echo " May combine switches (A6 = A2 + A4)" - echo " C NC compile .FOR, .F$ext, .FUN, .M$ext, .CEE, C$ext," - echo " .CUN, .FSC, .CSC, .SSC, .PSC," - echo " .DSC, .PIN, .HLP, .DEF, .INC, .A$ext, .X$ext" - echo " D ND use DEBUG (-g) in compiling" - echo " L NL save .o in wnlib.olb (if C), and save text of all" - echo " L1 files (except some, see filename help) in wnlib.tlb." - echo " L1: only uses .olb, not .tlb" - echo " By specifying L<name> the default wnlib name can be" - echo " overwritten." - echo " O NO optimize compilation" - echo " NP P print the compilation listing" - echo " NU U update in DWARF sytem if .PIN" - echo " update in WN system if .DEF, .PEF, .DSF or .INC" - echo " X NX produce XREF listing in Fortran compilation" - echo " Z NZ act on .GRP extension" - echo "" - echo " QB<.> background execution qualifier. Default: $bQ_D" - echo " QC<.> C qualifier. Default: $cQ_D" - echo " QF<.> Fortran qualifier. Default: $fQ_D" - echo " QM<.> Macro (assembler) qualifiers. Default: $mQ_D" - echo " QP<.> Pure extensions (with .). Only files with these" - echo " extensions will be done. Default: $pQ_D" - echo "" - goto HLP1 -# -# NNET codes -# -H1nn: - echo " NA A ask node information, i.s.o. using defaults" - echo " Z NZ act on .GRP extension" - echo "" - echo " QB<.> background execution qualifier. Default: $bQ_D" - echo " QP<.> Pure extensions (with .). Only files with these" - echo " extensions will be done. Default: $pQ_D" - echo "" - goto HLP1 -# -# NDEL codes -# -H1nd: - echo " A NA ask confirmation for each deletion" - echo " C NC compiled data (.o, .ppd etc) are deleted" - echo " L NL delete .o in wnlib.olb (if C), and delete text of" - echo " L1 files (except some, see filename help) in wnlib.tlb." - echo " L1: only uses .olb, not .tlb" - echo " By specifying L<name> the default wnlib name can be" - echo " NU U delete in DWARF sytem if .PIN" - echo " delete in WN system if .DEF, .PEF, .DSF or .INC" - echo " Z NZ act on .GRP extension" - echo "" - echo " QB<.> background execution qualifier. Default: $bQ_D" - echo " QP<.> Pure extensions (with .). Only files with these" - echo " extensions will be done. Default: $pQ_D" - echo "" - echo " Note: only files present in (specified) directory can be deleted" - echo " if wildcards or no extension present." - echo "" - goto HLP1 -# -# NGET codes -# -H1ng: - echo " NA A always get new file from .tlb, even if present" - echo " L NL use wnlib.tlb to extract files." - echo " By specifying L<name> the default wnlib name can be" - echo " overwritten." - echo " Z NZ act on .GRP extension" - echo "" - echo " QB<.> batch execution qualifier. Default: $bQ_D" - echo " QP<.> Pure extensions (with .). Only files with these" - echo " extensions will be done. Default: $pQ_D" - echo "" - goto HLP1 -# -# NLINK codes -# -H1nl: - echo " NA A1 alter startup routine to exclude logging (Dwarf)" - echo " D ND use DEBUG (-g) in linking" - echo " L NL use as L<name> to overwrite the default object" - echo " library wnlib with other name." - echo " NP P print the link map" - echo " S NS use DWARF library in linking" - echo " NU U update in DWARF sytem" - echo " NX X produce XREF listing in link map" - echo " Z NZ act on .GRP extension" - echo "" - echo " QB<.> batch execution qualifier. Default: $bQ_D" - echo " QL<.> link qualifiers. Default: $lQ_D" - echo " QO<.> link options. Default: $oQ_D" - echo "" - goto HLP1 -HLP1: - echo "General Help by just typing > nxec" - echo "" - goto exex # ask codes -# -# Filename level -# -HLPA3: - echo "" - echo "Filenames can be specified in separate arguments, or separated" - echo "by commas in a single argument. Filenames can contain wildcards." - echo "If no extension is given .* is assumed, except for indirect" - echo "files where .GRP is assumed. A filename preceded by" - echo "an @ will be assumed to be indirect and contain filenames," - echo "as will be files with" - echo "a .GRP extension (unless NZ code specified)." - echo "The current default device and directory will be assumed if" - echo "none are specified." - echo "Filenames can be given (except for nlink) as regular expressions" - echo "(they should in general be enclosed in ''). In that case" - echo "the regular expression will be matched against files in" - echo "in the .tlb text library." - echo ".GRP and @ files will contain a filename per line, optionally" - echo "followed by a comment preceded with a \!, or will be a comment" - echo "line starting with a \!. The filenames must have" - echo "extensions, and cannot contain wildcards, but may have device" - echo "and directory information." - echo "Optionally the filename may be followed by standard switches," - echo "indicating codes to be used for this line only, e.g. compilation or" - echo "linking data. E.g. A.FOR -no will be compiled with" - echo "no optimizing." - echo "If the line starts with a # the line will be" - echo "a UNIX shell command." - echo "If the line starts with a $ ," - echo "the line will be given to DCL to be executed (e.g. to" - echo "assign logical names)." - echo 'If the line starts with $$ or ## the next 3 characters are' - echo 'checked if they are pp$ (pp#) (pp any two characters). If the' - echo "pp characters are identical to the program name that invoked" - echo "the current .grp (e.g. NC), the command will be executed." - echo "The action of the command will depend on the type of the file." - echo "For $pnam the action will be:" - echo " .GRP will be read as an indirect file (if not NZ code)" - goto H2$pcod -# -# NCOMP files -# -H2nc: - echo " .FOR, .F$ext, .FUN, .FSC" - echo " will be compiled as Fortran programs (if C code)" - echo " .CEE, .C$ext, .CUN, .CSC" - echo " will be compiled as C programs (if C)" - echo " .M$ext will be compiled as Macro program (if C)" - echo " .DSC will be handled by WNGTAB (if C)" - echo " .HLP will be put in .HLB with same name (if C)" - echo " .PIN, .PSC will be compiled (if C)" - echo " .SSC will be compiled (if C)" - echo " .DEF, .INC will be compiled (if C)" - echo " All of the above will be put in" - echo " .tlb (unless NL or L1 code)" - echo " .A$ext will be converted to an .olb (if C)" - echo " .X$ext will be converted to an .exe (if C)" - echo " .A??, .X?? will be put in _ax.tlb (unless NL or L1 code)" - echo " $chtp[1-8]" - echo " $chtp[9*] will be skipped" - echo " All other files with 3 character extensions will be put in .tlb" - echo " (unless NL or L1 code specified)." - echo " All other files will be skipped." - goto H21 -# -# NNET files -# -H2nn: - echo " $chtp[1-8]" - echo " $chtp[9*] will be skipped" - echo " All other files with 3 character extensions will be got" - echo " All other files will be skipped." - goto H21 -# -# NDEL files -# -H2nd: - echo " .FOR, .F$ext, .FUN, .FSC" - echo " will be deleted as Fortran programs (if C code)" - echo " .CEE, .C$ext, .CUN, .CSC" - echo " will be deleted as C programs (if C code)" - echo " .M$ext will be deleted as Macro program (if C)" - echo " .DSC will be handled by WNGTAB (if C)" - echo " .HLP will be put in .HLB with same name (if C)" - echo " .EXE will be deleted as a task image" - echo " .PIN, .PSC will be deleted (if C)" - echo " .SSC will be deleted (if C)" - echo " .DEF, .INC will be deleted (if C)" - echo " All of the above (except .exe) will be deleted" - echo " from .tlb (unless NL or L1 code)" - echo " .A??, .X?? will be deleted, also from _ax.tlb (unless codes)" - echo " $chtp[1-8]" - echo " $chtp[9*] will be skipped" - echo " All other files with 3 character extensions will be deleted" - echo " from .tlb (unless NL or L1 code specified)." - echo " All other files will be skipped." - goto H21 -# -# NGET files -# -H2ng: - echo " $chtp[1-8]" - echo " $chtp[9*] will be skipped" - echo " All other files with 3 character extensions will be got" - echo " from .tlb (unless NL or L1 code specified)." - echo " All other files will be skipped." - goto H21 -# -# NLINK files -# -H2nl: - echo " .EXE will produce program" - echo " if no extension program will be produced" - goto H21 -H21: - echo "" - goto exex -# -# Ready -# -exex: - exit diff --git a/src/wng/nlink.com b/src/wng/nlink.com deleted file mode 100755 index 270d704b8bb04583bbf49f86b0fc4ce5d6b9bbf3..0000000000000000000000000000000000000000 --- a/src/wng/nlink.com +++ /dev/null @@ -1,176 +0,0 @@ -$!# nlink.ssc -$!# WNB 920127 -$!# -$!# Revisions: -$!# WNB 921002 Overhaul -$!# WNB 921006 New date calculation -$!# JPH 921009 Pre-delete .map end .exe -$!# JPH 921015 Correct date calculation, include time -$!# directory check, short rm sequence -$!# WNB 921016 Typo in date, wrong nxup called, wrong wngfex called -$!# HjV 921016 Combine changes 921015 and 921016 -$!# HjV 921019 Remove directory check -$!# WNB 921113 Put WNTAB.EXE in correct place -$!# WNB 921130 Change tr for HP -$!# HjV 921203 Use IGETARG iso. GETARG for HP -$!# WNB 921208 Get date from nxec; check update possible; log data -$!# WNB 921209 -a1 switch -$!# WNB 921216 Correct wntab directory if -u -$!# WNB 921222 Add test undefined -$!# WNB 921230 Make SSC -$!# WNB 930106 Add unresolved test -$!# HjV 930226 For VAX: remove shared stuff -$!# put lnk_def also before lnk_use -$!# UNIX: remove reference to old dwarflib -$!# WNB 930517 Use possible objects -$!# WNB 930802 Change into WNTINC use -$!# WNB 931130 Add WNG library to Dwarf -$!# HJV 940202 Add extra call to DWARF LIB for VAX -$!# AXC 040127 Removed IGETARG exception for hp again -$!# -$!# Link programs in nxec system. Use as: -$!# -$!# source $WNG/nlink.sun (Unix) -$!# @WNG:NLINK <file> (VAX) -$!# -$!# The command file uses many local nxec variables, and -$!# environment variables: WNG, LIBDWARF, WNG_OLB, WNG_EXE -$!# command files: nxec, nxup, wngfex -$!# -$!# Link file -$!# -$ DEP=F$ENVIRONMENT("DEPTH") -$ IF FTP .NES. ".EXE" THEN EXIT !ONLY .EXE -$ ON ERROR THEN GOTO ERR -$ L0="''C_DATE'/''C_TIME'" !VERSION YYMMDD/HHMMSS -$ CLOSE/ERROR=GEN1 F'PID''DEP' !MAKE PROGRAM -$ GEN1: OPEN/WRITE/ERROR=ERR F'PID''DEP' F'PID''DEP'.FVX -$ WRITE/ERROR=ERR F'PID''DEP' " PROGRAM ''FNM'_EXE" -$ WRITE/ERROR=ERR F'PID''DEP' " CHARACTER*80 CLSTR" !COMMAND LINE -$ WRITE/ERROR=ERR F'PID''DEP' " CALL LIB$GET_FOREIGN(CLSTR)" !GET LINE -$ IF CD_A .NES. "1" !STANDARD -$ THEN -$ WRITE/ERROR=ERR F'PID''DEP' " CALL WNGIN('"+"''FNM'"+"','"+ - - "''L0'"+"',''DATTP')" !CALL INIT -$ ELSE -$ WRITE/ERROR=ERR F'PID''DEP' " CALL WNGIN1('"+"''FNM'"+"','"+ - - "''L0'"+"',''DATTP')" !CALL INIT -$ ENDIF -$ WRITE/ERROR=ERR F'PID''DEP' " CALL ''FNM'(CLSTR)" !CALL PROGRAM -$ WRITE/ERROR=ERR F'PID''DEP' " CALL WNGEX" !FINISH OFF -$ WRITE/ERROR=ERR F'PID''DEP' " END" -$ CLOSE/ERROR=ERR F'PID''DEP' -$ SET NOON -$ ASSIGN/USER NL: SYS$OUTPUT !FORGET DONE MESSAGE -$ FORTRAN/LIST='WNG_LIS'F'PID''DEP'/OBJECT=F'PID''DEP''LFORT' - - F'PID''DEP'.FVX !COMPILE -$ SET ON -$ IF F$SEARCH("F''PID'''DEP'.OBJ") .EQS. "" THEN GOTO ERR !NOT COMPILED -$ GOSUB LNK !LINK -$ GOTO ERR2 -$!# -$!# Ready -$!# -$ ERR: B1="Not: " -$ ERR2: TELL B1+FNM+MSGT -$ UTELL B1+FNM+MSGT -$ EXIT: CLOSE/ERROR=ERR1 F'PID''DEP' !MAKE SURE -$ ERR1: CLOSE/ERROR=ERR3 O'PID''DEP' -$ ERR3: IF F$SEARCH("F''PID'''DEP'.FVX") .NES. "" THEN - - DELETE F'PID''DEP'.FVX;* -$ IF F$SEARCH("F''PID'''DEP'.OBJ") .NES. "" THEN - - DELETE F'PID''DEP'.OBJ;* -$ IF F$SEARCH("O''PID'''DEP'.OPT") .NES. "" THEN - - DELETE O'PID''DEP'.OPT;* -$ IF F$SEARCH("''WNG_LIS'F''PID'''DEP'.LIS") .NES. "" THEN - - DELETE 'WNG_LIS'F'PID''DEP'.LIS;* -$ EXIT -$!# -$!# Local subroutine -$!# -$ LNK: CLOSE/ERROR=LNK1 O'PID''DEP' !MAKE OPTIONS -$ LNK1: OPEN/WRITE/ERROR=ERR O'PID''DEP' O'PID''DEP'.OPT -$ L2="" !LIBRARIES -$ L0=1 !SEARCH LIST -$ LNK0: L3=F$SEARCH("*.OBJ;0",L0) !FIND OBJECTS -$ IF (L3 .NES. "") -$ THEN -$ IF F$LOCATE("F''PID'''DEP'",L3) .EQ. F$LENGTH(L3) -$ THEN -$ IF L2 .NES. "" THEN - -$ WRITE/ERROR=ERR O'PID''DEP' L2+",-" -$ L2=L3 !NEXT -$ ENDIF -$ GOTO LNK0 !MORE? -$ ENDIF -$ IF CD_L .NES. "-" -$ THEN -$ IF L2 .NES. "" THEN - -$ WRITE/ERROR=ERR O'PID''DEP' L2+",-" -$ L2="''L_D'/LIB" !STANDARD LIB -$ ENDIF -$ IF LNK_DEF .NES. "" -$ THEN -$ IF L2 .NES. "" THEN - -$ WRITE/ERROR=ERR O'PID''DEP' L2+",-" -$ L2=LNK_DEF !STANDARD LIBS -$ ENDIF -$ IF LNK_USE .NES. "" -$ THEN -$ IF L2 .NES. "" THEN - -$ WRITE/ERROR=ERR O'PID''DEP' L2+",-" -$ L2=LNK_USE -$ ENDIF -$ IF OQ_D .NES. "" -$ THEN -$ IF L2 .NES. "" THEN - -$ WRITE/ERROR=ERR O'PID''DEP' L2+",-" -$ L2=OQ_D !USER LIBS -$ ENDIF -$ IF CD_S .NES. "-" !DWARF WANTED -$ THEN -$ IF L2 .NES. "" THEN - -$ WRITE/ERROR=ERR O'PID''DEP' L2+",-" -$ L2="LIBDWARF:WNLIB/LIB" !DWARF LIB -$ ENDIF -$ IF LNK_DEF .NES. "" -$ THEN -$ IF L2 .NES. "" THEN - -$ WRITE/ERROR=ERR O'PID''DEP' L2+",-" -$ L2=LNK_DEF !STANDARD LIBS -$ ENDIF -$ IF CD_S .NES. "-" !DWARF WANTED -$ THEN -$ IF L2 .NES. "" THEN - -$ WRITE/ERROR=ERR O'PID''DEP' L2+",-" -$ L2="LIBDWARF:WNLIB/LIB" !DWARF LIB -$ ENDIF -$ IF L2 .NES. "" THEN - -$ WRITE/ERROR=ERR O'PID''DEP' L2 !LAST LINE -$ CLOSE/ERROR=ERR O'PID''DEP' -$ ON WARNING THEN GOTO ERR -$ MSGT=MSGT+ "linked" -$ LINK/EXEC='WNG_EXE''FNM'.EXE/MAP='WNG_EXE''FNM'.MAP'LQ_D' - - F'PID''DEP'.OBJ, - - O'PID''DEP'.OPT/OPTION -$ IF F$SEARCH("''WNG_EXE'''FNM'.EXE") .EQS. "" .OR. - - F$SEARCH("''WNG_EXE'''FNM'.MAP") .EQS. "" THEN GOTO ERR -$ ON ERROR THEN GOTO ERR -$ PURGE/NOLOG 'WNG_EXE''FNM'.EXE,'WNG_EXE''FNM'.MAP -$ IF FNM .EQS. "WNTINC" !SAVE IN CORRECT PLACE -$ THEN -$ COPY 'WNG_EXE''FNM'.EXE WNG: -$ PURGE WNG:'FNM'.EXE -$ ELSE -$ IF CD_U .NES. "-" .AND. F$TRNLNM("EXEDWARF") .NES. "" !UPDATE -$ THEN -$ @WNG:NXUP "4" "''U_D'" "''WNG_EXE'''FNM'.EXE" "''FNM'" "" -$ MSGT=MSGT+" updated(''U_D')" -$ ENDIF -$ ENDIF -$ IF CD_P .NES. "-" !PRINT -$ THEN -$ @WNG:WNGFEX "SP" 'WNG_EXE''FNM'.MAP 'FNM'.EXE -$ MSGT=MSGT+" printed" -$ ENDIF -$ RETURN diff --git a/src/wng/nlink.ssc b/src/wng/nlink.ssc deleted file mode 100644 index 421b453df23a67f980d9bd696daa7249a9031843..0000000000000000000000000000000000000000 --- a/src/wng/nlink.ssc +++ /dev/null @@ -1,253 +0,0 @@ -# nlink.ssc -# WNB 920127 -# -# Revisions: -# WNB 921002 Overhaul -# WNB 921006 New date calculation -# JPH 921009 Pre-delete .map end .exe -# JPH 921015 Correct date calculation, include time -# directory check, short rm sequence -# WNB 921016 Typo in date, wrong nxup called, wrong wngfex called -# HjV 921016 Combine changes 921015 and 921016 -# HjV 921019 Remove directory check -# WNB 921113 Put WNTAB.EXE in correct place -# WNB 921130 Change tr for HP -# HjV 921203 Use IGETARG iso. GETARG for HP -# WNB 921208 Get date from nxec; check update possible; log data -# WNB 921209 -a1 switch -# WNB 921216 Correct wntab directory if -u -# WNB 921222 Add test undefined -# WNB 921230 Make SSC -# WNB 930106 Add unresolved test -# HjV 930226 For VAX: remove shared stuff -# put lnk_def also before lnk_use -# UNIX: remove reference to old dwarflib -# WNB 930517 Use possible objects -# WNB 930802 Change into WNTINC use -# WNB 931130 Add WNG library to Dwarf -# HJV 940202 Add extra call to DWARF LIB for VAX -# AXC 040127 Removed IGETARG exception for hp again -# -# Link programs in nxec system. Use as: -# -# source $WNG/nlink.sun (Unix) -# @WNG:NLINK <file> (VAX) -# -# The command file uses many local nxec variables, and -# environment variables: WNG, LIBDWARF, WNG_OLB, WNG_EXE -# command files: nxec, nxup, wngfex -# -# Link file -# -#ifdef wn_vax__ -$ DEP=F$ENVIRONMENT("DEPTH") -$ IF FTP .NES. ".EXE" THEN EXIT !ONLY .EXE -$ ON ERROR THEN GOTO ERR -$ L0="''C_DATE'/''C_TIME'" !VERSION YYMMDD/HHMMSS -$ CLOSE/ERROR=GEN1 F'PID''DEP' !MAKE PROGRAM -$ GEN1: OPEN/WRITE/ERROR=ERR F'PID''DEP' F'PID''DEP'.FVX -$ WRITE/ERROR=ERR F'PID''DEP' " PROGRAM ''FNM'_EXE" -$ WRITE/ERROR=ERR F'PID''DEP' " CHARACTER*80 CLSTR" !COMMAND LINE -$ WRITE/ERROR=ERR F'PID''DEP' " CALL LIB$GET_FOREIGN(CLSTR)" !GET LINE -$ IF CD_A .NES. "1" !STANDARD -$ THEN -$ WRITE/ERROR=ERR F'PID''DEP' " CALL WNGIN('"+"''FNM'"+"','"+ - - "''L0'"+"',''DATTP')" !CALL INIT -$ ELSE -$ WRITE/ERROR=ERR F'PID''DEP' " CALL WNGIN1('"+"''FNM'"+"','"+ - - "''L0'"+"',''DATTP')" !CALL INIT -$ ENDIF -$ WRITE/ERROR=ERR F'PID''DEP' " CALL ''FNM'(CLSTR)" !CALL PROGRAM -$ WRITE/ERROR=ERR F'PID''DEP' " CALL WNGEX" !FINISH OFF -$ WRITE/ERROR=ERR F'PID''DEP' " END" -$ CLOSE/ERROR=ERR F'PID''DEP' -$ SET NOON -$ ASSIGN/USER NL: SYS$OUTPUT !FORGET DONE MESSAGE -$ FORTRAN/LIST='WNG_LIS'F'PID''DEP'/OBJECT=F'PID''DEP''LFORT' - - F'PID''DEP'.FVX !COMPILE -$ SET ON -$ IF F$SEARCH("F''PID'''DEP'.OBJ") .EQS. "" THEN GOTO ERR !NOT COMPILED -$ GOSUB LNK !LINK -$ GOTO ERR2 -#else - set msgt="" ; set b1="Done: " # message text/ok - if ($lobe == "" || $lobe == exe) set lobe=exe # correct extension - if ($lobe != exe ) goto RETURN # wrong extension - set lobc=`echo $lobh | tr $Lowc $Upc` # program name UC - set loo="'"$c_date/$c_time"'" # vers. yymmdd/hhmmss - set looa="'"$lobc"'" - if ("$cd_a" != "1") then # type of logging - set lood=IN - else - set lood=IN1 - endif - cat << EOF >$pid${dep}.f # create program - PROGRAM ${lobc}_EXE - CHARACTER*80 CLSTR !COMMAND LINE ARGUMENT - IF (IARGC().GT.0) THEN - CALL GETARG(1,CLSTR) - ELSE - CLSTR=' ' - END IF - CALL WNG${lood}($looa,$loo,$dattp) !CALL INIT - CALL $lobc(CLSTR) !CALL PROGRAM - CALL WNGEX !FINISH OFF - END -EOF - 'rm' $WNG_EXE/${lobh}.exe $WNG_EXE/${lobh}.map >& /dev/null - set loo=`ls $WNG_OLB/*.o |& grep "\.o"` # get local objects - if ("$cd_s" == "-") then # no dwarf - $fortran $lfort $pid${dep}.f -o $WNG_EXE/${lobh}.exe \ - $loo \ - $WNG_OLB/${l_d}.olb $lnk_def $lnk_use $lnk_def \ - >&! $WNG_EXE/${lobh}.map - else # dwarf - if (-e $LIBDWARF/wnlib.olb) then - set llib=wnlib - else - goto NLERR - endif - $fortran $lfort $pid${dep}.f -o $WNG_EXE/${lobh}.exe \ - $loo \ - $WNG_OLB/${l_d}.olb $lnk_def $lnk_use $lnk_def \ - $LIBDWARF/${llib}.olb $WNG_OLBEXE/wng/wnlib.olb \ - -ltermcap >&! $WNG_EXE/${lobh}.map - endif - set statx=$status - 'rm' $pid$dep.f $pid$dep.o >& /dev/null - if ($statx) goto NLERR # no success - if (! -e $WNG_EXE/${lobh}.exe) goto NLERR - if (! -e $WNG_EXE/${lobh}.map) goto NLERR - set loo=`grep ndefine $WNG_EXE/${lobh}.map` - if ("$loo" != "") goto NLERR - set loo=`grep nresolv $WNG_EXE/${lobh}.map` - if ("$loo" != "") goto NLERR - set msgt="$msgt linked" - if ("$lobh" == "wntinc") then # put in correct WNG - 'mv' $WNG_EXE/${lobh}.exe $WNG_OLBEXE/wng >& /dev/null - else if ("$cd_u" != "-" && $?EXEDWARF_UNIX) then # update - csh -f $WNG/nxup.sun 4 "$u_d" "$WNG_EXE/${lobh}.$lobe" "$lobh:t" - set msgt="$msgt updated($u_d)" - endif - if ("$cd_p" != "-") then # print - $WNG/wngfex.sun sp $WNG_EXE/${lobh}.map ${lobh}.$lobe - set msgt="$msgt printed" - endif - goto NLEX #ready -#endif -# -# Ready -# -#ifdef wn_vax__ -$ ERR: B1="Not: " -$ ERR2: TELL B1+FNM+MSGT -$ UTELL B1+FNM+MSGT -$ EXIT: CLOSE/ERROR=ERR1 F'PID''DEP' !MAKE SURE -$ ERR1: CLOSE/ERROR=ERR3 O'PID''DEP' -$ ERR3: IF F$SEARCH("F''PID'''DEP'.FVX") .NES. "" THEN - - DELETE F'PID''DEP'.FVX;* -$ IF F$SEARCH("F''PID'''DEP'.OBJ") .NES. "" THEN - - DELETE F'PID''DEP'.OBJ;* -$ IF F$SEARCH("O''PID'''DEP'.OPT") .NES. "" THEN - - DELETE O'PID''DEP'.OPT;* -$ IF F$SEARCH("''WNG_LIS'F''PID'''DEP'.LIS") .NES. "" THEN - - DELETE 'WNG_LIS'F'PID''DEP'.LIS;* -$ EXIT -#else -NLERR: - set b1="Not: " -NLEX: - echo "$b1 ${lobh}.$lobe $msgt" | tee -a $c_upd -RETURN: -#endif -# -# Local subroutine -# -#ifdef wn_vax__ -$ LNK: CLOSE/ERROR=LNK1 O'PID''DEP' !MAKE OPTIONS -$ LNK1: OPEN/WRITE/ERROR=ERR O'PID''DEP' O'PID''DEP'.OPT -$ L2="" !LIBRARIES -$ L0=1 !SEARCH LIST -$ LNK0: L3=F$SEARCH("*.OBJ;0",L0) !FIND OBJECTS -$ IF (L3 .NES. "") -$ THEN -$ IF F$LOCATE("F''PID'''DEP'",L3) .EQ. F$LENGTH(L3) -$ THEN -$ IF L2 .NES. "" THEN - -$ WRITE/ERROR=ERR O'PID''DEP' L2+",-" -$ L2=L3 !NEXT -$ ENDIF -$ GOTO LNK0 !MORE? -$ ENDIF -$ IF CD_L .NES. "-" -$ THEN -$ IF L2 .NES. "" THEN - -$ WRITE/ERROR=ERR O'PID''DEP' L2+",-" -$ L2="''L_D'/LIB" !STANDARD LIB -$ ENDIF -$ IF LNK_DEF .NES. "" -$ THEN -$ IF L2 .NES. "" THEN - -$ WRITE/ERROR=ERR O'PID''DEP' L2+",-" -$ L2=LNK_DEF !STANDARD LIBS -$ ENDIF -$ IF LNK_USE .NES. "" -$ THEN -$ IF L2 .NES. "" THEN - -$ WRITE/ERROR=ERR O'PID''DEP' L2+",-" -$ L2=LNK_USE -$ ENDIF -$ IF OQ_D .NES. "" -$ THEN -$ IF L2 .NES. "" THEN - -$ WRITE/ERROR=ERR O'PID''DEP' L2+",-" -$ L2=OQ_D !USER LIBS -$ ENDIF -$ IF CD_S .NES. "-" !DWARF WANTED -$ THEN -$ IF L2 .NES. "" THEN - -$ WRITE/ERROR=ERR O'PID''DEP' L2+",-" -$ L2="LIBDWARF:WNLIB/LIB" !DWARF LIB -$ ENDIF -$ IF LNK_DEF .NES. "" -$ THEN -$ IF L2 .NES. "" THEN - -$ WRITE/ERROR=ERR O'PID''DEP' L2+",-" -$ L2=LNK_DEF !STANDARD LIBS -$ ENDIF -$ IF CD_S .NES. "-" !DWARF WANTED -$ THEN -$ IF L2 .NES. "" THEN - -$ WRITE/ERROR=ERR O'PID''DEP' L2+",-" -$ L2="LIBDWARF:WNLIB/LIB" !DWARF LIB -$ ENDIF -$ IF L2 .NES. "" THEN - -$ WRITE/ERROR=ERR O'PID''DEP' L2 !LAST LINE -$ CLOSE/ERROR=ERR O'PID''DEP' -$ ON WARNING THEN GOTO ERR -$ MSGT=MSGT+ "linked" -$ LINK/EXEC='WNG_EXE''FNM'.EXE/MAP='WNG_EXE''FNM'.MAP'LQ_D' - - F'PID''DEP'.OBJ, - - O'PID''DEP'.OPT/OPTION -$ IF F$SEARCH("''WNG_EXE'''FNM'.EXE") .EQS. "" .OR. - - F$SEARCH("''WNG_EXE'''FNM'.MAP") .EQS. "" THEN GOTO ERR -$ ON ERROR THEN GOTO ERR -$ PURGE/NOLOG 'WNG_EXE''FNM'.EXE,'WNG_EXE''FNM'.MAP -$ IF FNM .EQS. "WNTINC" !SAVE IN CORRECT PLACE -$ THEN -$ COPY 'WNG_EXE''FNM'.EXE WNG: -$ PURGE WNG:'FNM'.EXE -$ ELSE -$ IF CD_U .NES. "-" .AND. F$TRNLNM("EXEDWARF") .NES. "" !UPDATE -$ THEN -$ @WNG:NXUP "4" "''U_D'" "''WNG_EXE'''FNM'.EXE" "''FNM'" "" -$ MSGT=MSGT+" updated(''U_D')" -$ ENDIF -$ ENDIF -$ IF CD_P .NES. "-" !PRINT -$ THEN -$ @WNG:WNGFEX "SP" 'WNG_EXE''FNM'.MAP 'FNM'.EXE -$ MSGT=MSGT+" printed" -$ ENDIF -$ RETURN -#endif diff --git a/src/wng/nlink.sun b/src/wng/nlink.sun deleted file mode 100755 index 68425d5daffb073ad9be62c3d90de21852a712ec..0000000000000000000000000000000000000000 --- a/src/wng/nlink.sun +++ /dev/null @@ -1,116 +0,0 @@ -# nlink.ssc -# WNB 920127 -# -# Revisions: -# WNB 921002 Overhaul -# WNB 921006 New date calculation -# JPH 921009 Pre-delete .map end .exe -# JPH 921015 Correct date calculation, include time -# directory check, short rm sequence -# WNB 921016 Typo in date, wrong nxup called, wrong wngfex called -# HjV 921016 Combine changes 921015 and 921016 -# HjV 921019 Remove directory check -# WNB 921113 Put WNTAB.EXE in correct place -# WNB 921130 Change tr for HP -# HjV 921203 Use IGETARG iso. GETARG for HP -# WNB 921208 Get date from nxec; check update possible; log data -# WNB 921209 -a1 switch -# WNB 921216 Correct wntab directory if -u -# WNB 921222 Add test undefined -# WNB 921230 Make SSC -# WNB 930106 Add unresolved test -# HjV 930226 For VAX: remove shared stuff -# put lnk_def also before lnk_use -# UNIX: remove reference to old dwarflib -# WNB 930517 Use possible objects -# WNB 930802 Change into WNTINC use -# WNB 931130 Add WNG library to Dwarf -# HJV 940202 Add extra call to DWARF LIB for VAX -# AXC 040127 Removed IGETARG exception for hp again -# -# Link programs in nxec system. Use as: -# -# source $WNG/nlink.sun (Unix) -# @WNG:NLINK <file> (VAX) -# -# The command file uses many local nxec variables, and -# environment variables: WNG, LIBDWARF, WNG_OLB, WNG_EXE -# command files: nxec, nxup, wngfex -# -# Link file -# - set msgt="" ; set b1="Done: " # message text/ok - if ($lobe == "" || $lobe == exe) set lobe=exe # correct extension - if ($lobe != exe ) goto RETURN # wrong extension - set lobc=`echo $lobh | tr $Lowc $Upc` # program name UC - set loo="'"$c_date/$c_time"'" # vers. yymmdd/hhmmss - set looa="'"$lobc"'" - if ("$cd_a" != "1") then # type of logging - set lood=IN - else - set lood=IN1 - endif - cat << EOF >$pid${dep}.f # create program - PROGRAM ${lobc}_EXE - CHARACTER*80 CLSTR !COMMAND LINE ARGUMENT - IF (IARGC().GT.0) THEN - CALL GETARG(1,CLSTR) - ELSE - CLSTR=' ' - END IF - CALL WNG${lood}($looa,$loo,$dattp) !CALL INIT - CALL $lobc(CLSTR) !CALL PROGRAM - CALL WNGEX !FINISH OFF - END -EOF - 'rm' $WNG_EXE/${lobh}.exe $WNG_EXE/${lobh}.map >& /dev/null - set loo=`ls $WNG_OLB/*.o |& grep "\.o"` # get local objects - if ("$cd_s" == "-") then # no dwarf - $fortran $lfort $pid${dep}.f -o $WNG_EXE/${lobh}.exe \ - $loo \ - $WNG_OLB/${l_d}.olb $lnk_def $lnk_use $lnk_def \ - >&! $WNG_EXE/${lobh}.map - else # dwarf - if (-e $LIBDWARF/wnlib.olb) then - set llib=wnlib - else - goto NLERR - endif - $fortran $lfort $pid${dep}.f -o $WNG_EXE/${lobh}.exe \ - $loo \ - $WNG_OLB/${l_d}.olb $lnk_def $lnk_use $lnk_def \ - $LIBDWARF/${llib}.olb $WNG_OLBEXE/wng/wnlib.olb \ - -ltermcap >&! $WNG_EXE/${lobh}.map - endif - set statx=$status - 'rm' $pid$dep.f $pid$dep.o >& /dev/null - if ($statx) goto NLERR # no success - if (! -e $WNG_EXE/${lobh}.exe) goto NLERR - if (! -e $WNG_EXE/${lobh}.map) goto NLERR - set loo=`grep ndefine $WNG_EXE/${lobh}.map` - if ("$loo" != "") goto NLERR - set loo=`grep nresolv $WNG_EXE/${lobh}.map` - if ("$loo" != "") goto NLERR - set msgt="$msgt linked" - if ("$lobh" == "wntinc") then # put in correct WNG - 'mv' $WNG_EXE/${lobh}.exe $WNG_OLBEXE/wng >& /dev/null - else if ("$cd_u" != "-" && $?EXEDWARF_UNIX) then # update - csh -f $WNG/nxup.sun 4 "$u_d" "$WNG_EXE/${lobh}.$lobe" "$lobh:t" - set msgt="$msgt updated($u_d)" - endif - if ("$cd_p" != "-") then # print - $WNG/wngfex.sun sp $WNG_EXE/${lobh}.map ${lobh}.$lobe - set msgt="$msgt printed" - endif - goto NLEX #ready -# -# Ready -# -NLERR: - set b1="Not: " -NLEX: - echo "$b1 ${lobh}.$lobe $msgt" | tee -a $c_upd -RETURN: -# -# Local subroutine -# diff --git a/src/wng/nnet.com b/src/wng/nnet.com deleted file mode 100755 index b5c92862b7966be7ca0368a19f93dadeece807cf..0000000000000000000000000000000000000000 --- a/src/wng/nnet.com +++ /dev/null @@ -1,109 +0,0 @@ -$!# nnet.ssc -$!# WNB 920908 -$!# -$!# Revisions: -$!# WNB 920922 Use noglob -$!# Redirect ftp output -$!# WNB 921002 Overhaul -$!# WNB 921012 Add node to text -$!# WNB 921014 Typo -$!# WNB 921208 Add log -$!# WNB 921222 Change chmod -$!# WNB 921230 Make SSC -$!# WNB 930330 Add .A.. and .X.. -$!# HjV 930630 Add site KOSMA (Multinet) -$!# -$!# Get files across net. Use as: -$!# -$!# source $WNG/nnet.sun (Unix) -$!# @WNG:NNET <file> (VAX) -$!# -$!# The command file uses many local nxec variables, and -$!# environment variables: WNG, WNG_NODE, WNG_NODEUSER, WNG_NODEDIR -$!# command files: -$!# -$!# -$!# Get a file across net -$!# -$ ON ERROR THEN GOTO ERR -$ DOFTP="FTP" !FOR SAFETY -$ L0=F$SEARCH("''FNM'''FTP'") !FOR REFERENCE -$ ON ERROR THEN GOTO ERR -$ OPEN/WRITE/ERROR=ERR FILE FN'PID''DEP'.TMP -$ L1=F$ELEMENT(0," ",WNG_NODEUSER) !USER -$ L2=F$ELEMENT(1," ",WNG_NODEUSER) !PASSWORD -$ L3=CWDT-"["-"]" !CURRENT DIRECTORY -$ IF F$LOCATE(":",WNG_NODEDIR) .EQ. F$LENGTH(WNG_NODEDIR) -$ THEN !UNIX -$ L3=WNG_NODEDIR+"/"+F$EDIT(L3,"LOWERCASE") !FOREIGN DIRECTORY -$ ELSE !VMS -$ L3=WNG_NODEDIR-"]"+"."+L3+"]" !FOREIGN DIRECTORY -$ ENDIF -$ L4=F$EDIT("''FNM'''FTP'","LOWERCASE") !FOR UNIX -$ IF WNG_SITE .EQS. "NFRA" -$ THEN -$ WRITE/ERROR=ERR FILE "$ DOFTP=""FTP""" -$ WRITE/ERROR=ERR FILE "$ DOFTP" -$ WRITE/ERROR=ERR FILE "CONNECT ''WNG_NODE'" -$ WRITE/ERROR=ERR FILE "LOGIN ""''L1'""" -$ WRITE/ERROR=ERR FILE "''L2'" -$ WRITE/ERROR=ERR FILE "SET DEF ""''L3'""" -$ IF F$EXTRACT(1,1,FTP) .EQS. "A" .OR. - - F$EXTRACT(1,1,FTP) .EQS. "X" -$ THEN -$ WRITE/ERROR=ERR FILE "SET TYPE IMAGE" -$ ENDIF -$ WRITE/ERROR=ERR FILE "GET ""''L4'""" -$ WRITE/ERROR=ERR FILE "EXIT" -$ WRITE/ERROR=ERR FILE "$ EXIT" -$ ELSE -$ IF WNG_SITE .EQS. "ATNF" .OR. WNG_SITE .EQS. "KOSMA" -$ THEN -$ WRITE/ERROR=ERR FILE "cd ""''L3'""" -$ IF F$EXTRACT(1,1,FTP) .EQS. "A" .OR. - - F$EXTRACT(1,1,FTP) .EQS. "X" -$ THEN -$ WRITE/ERROR=ERR FILE "binary" -$ ENDIF -$ WRITE/ERROR=ERR FILE "get ""''L4'"" ''FNM'''FTP'" -$ WRITE/ERROR=ERR FILE "quit" -$ ELSE !RUG -$ WRITE/ERROR=ERR FILE "$ DOFTP=""FTP""" -$ WRITE/ERROR=ERR FILE "$ DOFTP -n ''WNG_NODE'" -$ WRITE/ERROR=ERR FILE "login ""''L1'"" ""''L2'""" -$ WRITE/ERROR=ERR FILE "cd ""''L3'""" -$ IF F$EXTRACT(1,1,FTP) .EQS. "A" .OR. - - F$EXTRACT(1,1,FTP) .EQS. "X" -$ THEN -$ WRITE/ERROR=ERR FILE "binary" -$ ENDIF -$ WRITE/ERROR=ERR FILE "get ""''L4'"" ''FNM'''FTP'" -$ WRITE/ERROR=ERR FILE "quit" -$ WRITE/ERROR=ERR FILE "$ EXIT" -$ ENDIF -$ ENDIF -$ CLOSE/ERROR=ERR FILE -$ SET NOON -$ ASSIGN/USER NL: SYS$OUTPUT -$ IF WNG_SITE .EQS "NFRA" .OR. WNG_SITE .EQS. "RUG" -$ THEN -$ @FN'PID''DEP'.TMP -$ ELSE -$ DOFTP/USER="''L1'"/PASSW="''L2'"/TAKE=FN'PID''DEP'.TMP - - 'WNG_NODE' -$ ENDIF -$ IF .NOT. $STATUS THEN GOTO ERR -$ SET ON -$ L1=F$SEARCH("''FNM'''FTP'") !SEE IF DONE -$ IF L1 .EQS. "" .OR. L0 .EQS. L1 THEN GOTO ERR !NOT DONE -$ MSGT=MSGT+" obtained [''WNG_NODE']" -$ GOTO ERR1 -$!# -$!# Ready -$!# -$ ERR: B1="Not: " -$ ERR1: TELL B1+FNM+FTP+MSGT -$ UTELL B1+FNM+FTP+MSGT -$ IF F$SEARCH("FN''PID'''DEP'.TMP") .NES. "" THEN - - DELETE FN'PID''DEP'.TMP;* !MAKE SURE -$ EXIT diff --git a/src/wng/nnet.ssc b/src/wng/nnet.ssc deleted file mode 100644 index 544083fffd0a69a924c9dccadc386c5e8b09bf35..0000000000000000000000000000000000000000 --- a/src/wng/nnet.ssc +++ /dev/null @@ -1,161 +0,0 @@ -# nnet.ssc -# WNB 920908 -# -# Revisions: -# WNB 920922 Use noglob -# Redirect ftp output -# WNB 921002 Overhaul -# WNB 921012 Add node to text -# WNB 921014 Typo -# WNB 921208 Add log -# WNB 921222 Change chmod -# WNB 921230 Make SSC -# WNB 930330 Add .A.. and .X.. -# HjV 930630 Add site KOSMA (Multinet) -# -# Get files across net. Use as: -# -# source $WNG/nnet.sun (Unix) -# @WNG:NNET <file> (VAX) -# -# The command file uses many local nxec variables, and -# environment variables: WNG, WNG_NODE, WNG_NODEUSER, WNG_NODEDIR -# command files: -# -# -# Get a file across net -# -#ifdef wn_vax__ -$ ON ERROR THEN GOTO ERR -$ DOFTP="FTP" !FOR SAFETY -$ L0=F$SEARCH("''FNM'''FTP'") !FOR REFERENCE -$ ON ERROR THEN GOTO ERR -$ OPEN/WRITE/ERROR=ERR FILE FN'PID''DEP'.TMP -$ L1=F$ELEMENT(0," ",WNG_NODEUSER) !USER -$ L2=F$ELEMENT(1," ",WNG_NODEUSER) !PASSWORD -$ L3=CWDT-"["-"]" !CURRENT DIRECTORY -$ IF F$LOCATE(":",WNG_NODEDIR) .EQ. F$LENGTH(WNG_NODEDIR) -$ THEN !UNIX -$ L3=WNG_NODEDIR+"/"+F$EDIT(L3,"LOWERCASE") !FOREIGN DIRECTORY -$ ELSE !VMS -$ L3=WNG_NODEDIR-"]"+"."+L3+"]" !FOREIGN DIRECTORY -$ ENDIF -$ L4=F$EDIT("''FNM'''FTP'","LOWERCASE") !FOR UNIX -$ IF WNG_SITE .EQS. "NFRA" -$ THEN -$ WRITE/ERROR=ERR FILE "$ DOFTP=""FTP""" -$ WRITE/ERROR=ERR FILE "$ DOFTP" -$ WRITE/ERROR=ERR FILE "CONNECT ''WNG_NODE'" -$ WRITE/ERROR=ERR FILE "LOGIN ""''L1'""" -$ WRITE/ERROR=ERR FILE "''L2'" -$ WRITE/ERROR=ERR FILE "SET DEF ""''L3'""" -$ IF F$EXTRACT(1,1,FTP) .EQS. "A" .OR. - - F$EXTRACT(1,1,FTP) .EQS. "X" -$ THEN -$ WRITE/ERROR=ERR FILE "SET TYPE IMAGE" -$ ENDIF -$ WRITE/ERROR=ERR FILE "GET ""''L4'""" -$ WRITE/ERROR=ERR FILE "EXIT" -$ WRITE/ERROR=ERR FILE "$ EXIT" -$ ELSE -$ IF WNG_SITE .EQS. "ATNF" .OR. WNG_SITE .EQS. "KOSMA" -$ THEN -$ WRITE/ERROR=ERR FILE "cd ""''L3'""" -$ IF F$EXTRACT(1,1,FTP) .EQS. "A" .OR. - - F$EXTRACT(1,1,FTP) .EQS. "X" -$ THEN -$ WRITE/ERROR=ERR FILE "binary" -$ ENDIF -$ WRITE/ERROR=ERR FILE "get ""''L4'"" ''FNM'''FTP'" -$ WRITE/ERROR=ERR FILE "quit" -$ ELSE !RUG -$ WRITE/ERROR=ERR FILE "$ DOFTP=""FTP""" -$ WRITE/ERROR=ERR FILE "$ DOFTP -n ''WNG_NODE'" -$ WRITE/ERROR=ERR FILE "login ""''L1'"" ""''L2'""" -$ WRITE/ERROR=ERR FILE "cd ""''L3'""" -$ IF F$EXTRACT(1,1,FTP) .EQS. "A" .OR. - - F$EXTRACT(1,1,FTP) .EQS. "X" -$ THEN -$ WRITE/ERROR=ERR FILE "binary" -$ ENDIF -$ WRITE/ERROR=ERR FILE "get ""''L4'"" ''FNM'''FTP'" -$ WRITE/ERROR=ERR FILE "quit" -$ WRITE/ERROR=ERR FILE "$ EXIT" -$ ENDIF -$ ENDIF -$ CLOSE/ERROR=ERR FILE -$ SET NOON -$ ASSIGN/USER NL: SYS$OUTPUT -$ IF WNG_SITE .EQS "NFRA" .OR. WNG_SITE .EQS. "RUG" -$ THEN -$ @FN'PID''DEP'.TMP -$ ELSE -$ DOFTP/USER="''L1'"/PASSW="''L2'"/TAKE=FN'PID''DEP'.TMP - - 'WNG_NODE' -$ ENDIF -$ IF .NOT. $STATUS THEN GOTO ERR -$ SET ON -$ L1=F$SEARCH("''FNM'''FTP'") !SEE IF DONE -$ IF L1 .EQS. "" .OR. L0 .EQS. L1 THEN GOTO ERR !NOT DONE -$ MSGT=MSGT+" obtained [''WNG_NODE']" -$ GOTO ERR1 -#else - set msgt="" ; set b1="Done: " # message text/ok - set l00=$cwd:t # current directory - if (-e ${lobh}.$lobe) then - 'mv' ${lobh}.$lobe ${lobh}.${lobe}.old - set l03=1 - else - set l03=0 - endif - set noglob; set l01=`echo "$WNG_NODEDIR" | grep ":"`; unset noglob - if ("$l01" == "") then # Unix node - set l02="$l00" - else # VMS site - set l02="[.$l00]" - endif - if ("$lobe" =~ [ax]??) then - set l04="binary" - else - set l04="ascii" - endif - ftp -n << qqq >& /dev/null - open $WNG_NODE - user $WNG_NODEUSER - cd "$WNG_NODEDIR" - cd $l02 - $l04 - get ${lobh}.$lobe ${lobh}.$lobe - close - quit -qqq - set statx=$status - if (! -e ${lobh}.$lobe) then - if ($l03 == 1) then - 'mv' ${lobh}.${lobe}.old ${lobh}.${lobe} - endif - goto NNERR - endif - if ($lobe == sun || $lobe == s$ext) then # make correct mode - chmod +xr ${lobh}.$lobe - endif - set msgt="$msgt obtained [$WNG_NODE]" - goto NNEX # ready -#endif -# -# Ready -# -#ifdef wn_vax__ -$ ERR: B1="Not: " -$ ERR1: TELL B1+FNM+FTP+MSGT -$ UTELL B1+FNM+FTP+MSGT -$ IF F$SEARCH("FN''PID'''DEP'.TMP") .NES. "" THEN - - DELETE FN'PID''DEP'.TMP;* !MAKE SURE -$ EXIT -#else -NNERR: - set b1="Not: " -NNEX: - echo "$b1 ${lobh}.$lobe $msgt" | tee -a $c_upd -RETURN: -#endif diff --git a/src/wng/nnet.sun b/src/wng/nnet.sun deleted file mode 100755 index 625896caaa077c07ccca519575d37dcbb60bd651..0000000000000000000000000000000000000000 --- a/src/wng/nnet.sun +++ /dev/null @@ -1,76 +0,0 @@ -# nnet.ssc -# WNB 920908 -# -# Revisions: -# WNB 920922 Use noglob -# Redirect ftp output -# WNB 921002 Overhaul -# WNB 921012 Add node to text -# WNB 921014 Typo -# WNB 921208 Add log -# WNB 921222 Change chmod -# WNB 921230 Make SSC -# WNB 930330 Add .A.. and .X.. -# HjV 930630 Add site KOSMA (Multinet) -# -# Get files across net. Use as: -# -# source $WNG/nnet.sun (Unix) -# @WNG:NNET <file> (VAX) -# -# The command file uses many local nxec variables, and -# environment variables: WNG, WNG_NODE, WNG_NODEUSER, WNG_NODEDIR -# command files: -# -# -# Get a file across net -# - set msgt="" ; set b1="Done: " # message text/ok - set l00=$cwd:t # current directory - if (-e ${lobh}.$lobe) then - 'mv' ${lobh}.$lobe ${lobh}.${lobe}.old - set l03=1 - else - set l03=0 - endif - set noglob; set l01=`echo "$WNG_NODEDIR" | grep ":"`; unset noglob - if ("$l01" == "") then # Unix node - set l02="$l00" - else # VMS site - set l02="[.$l00]" - endif - if ("$lobe" =~ [ax]??) then - set l04="binary" - else - set l04="ascii" - endif - ftp -n << qqq >& /dev/null - open $WNG_NODE - user $WNG_NODEUSER - cd "$WNG_NODEDIR" - cd $l02 - $l04 - get ${lobh}.$lobe ${lobh}.$lobe - close - quit -qqq - set statx=$status - if (! -e ${lobh}.$lobe) then - if ($l03 == 1) then - 'mv' ${lobh}.${lobe}.old ${lobh}.${lobe} - endif - goto NNERR - endif - if ($lobe == sun || $lobe == s$ext) then # make correct mode - chmod +xr ${lobh}.$lobe - endif - set msgt="$msgt obtained [$WNG_NODE]" - goto NNEX # ready -# -# Ready -# -NNERR: - set b1="Not: " -NNEX: - echo "$b1 ${lobh}.$lobe $msgt" | tee -a $c_upd -RETURN: diff --git a/src/wng/nredo.com b/src/wng/nredo.com deleted file mode 100755 index ebe3182fbc4ea70ccbbfaabca77fe61595e64a90..0000000000000000000000000000000000000000 --- a/src/wng/nredo.com +++ /dev/null @@ -1,165 +0,0 @@ -$!# nredo.ssc -$!# WNB 921231 -$!# -$!# Revisions: -$!# WNB 930303 NSTAR_DIR added -$!# WNB 930305 Make sure aliases -$!# WNB 930514 Correct aliases -$!# WNB 940124 Leave _TLB -$!# -$!# Rebuild Newstar from current files/text library -$!# -$!# Uses environment variables: -$!# WNG where to find wng-type sources -$!# WNG_TYPE machine (sw, dw, hp, al, cv etc) -$!# WNG_OLBEXE root of wng-type .olb, .ppd, .exe -$!# WNG_SITE site (nfra, atnf, rug ...) -$!# EXEDWARF_UNIX where to find/set DWARF .exe, .ppd -$!# LIBDWARF where to find DWARF .olb -$!# NSTAR_DIR N directories -$!# and also possible: -$!# WNG_EXE, WNG_OLB, WNG_TLB, WNG_ERR, WNG_LIS, WNG_LINK -$!# -$!# Use as: -$!# $WNG/nredo.sun c|l|cl [switches] ["dir1 dir2 ..."] (Unix) -$!# @WNG:NREDO c|l|cl [switches] [dir1,dir2,...] (VAX) -$!# c/l compile/link -$!# switches e.g. -l1 (always at least - if dir given); -u is default -$!# directories e.g. nscan (default all N-directories) -$!# -$!# Intro -$!# -$ SET NOON !DISCARD ERRORS -$ ON CONTROL_Y THEN GOTO EXEX !FINISH NEATLY -$ VER=F$VERIFY() !FOR ^Y -$ PID=F$EXTRACT(4,4,F$GETJPI("","PID")) !FOR TMP FILES -$ DEP=1 !FOR INDIRECT -$ LDAT=F$EXTRACT(2,2,F$CVTIM(,,"YEAR"))+F$CVTIM(,,"MONTH")+ - - F$CVTIM(,,"DAY") !VERSION -$ TELL="WRITE SYS$OUTPUT" !FOR EASE OF USE -$ ! -$ ASSIGN="ASSIGN" !MAKE SURE PROPER USE -$ BACKUP="BACKUP" -$ COPY="COPY" -$ DELETE="DELETE" -$ DIR="DIRECTORY" -$ PURGE="PURGE" -$ SET="SET" -$ SHOW="SHOW" -$ TELL " " -$ TELL "Rebuilding Newstar." -$ TELL " " -$ TELL "A log will be made in the standard UPD''LDAT'.LOG" -$ TELL " " -$!# -$!# Check environment -$!# -$ IF F$TRNLNM("WNG") .EQS. "" .OR. F$TRNLNM("WNG_OLBEXE") .EQS. "" - - .OR. F$TRNLNM("WNG_DIR") .EQS. "" - - .OR. "''WNG_TYPE'" .EQS. "" .OR. "''WNG_SITE'" .EQS. "" - - .OR. "''NSTAR_DIR'" .EQS. "" - -$ THEN -$ TELL " Error: Must have logicals WNG, WNG_OLBEXE, WNG_DIR and globals" -$ TELL " WNG_TYPE, WNG_SITE, NSTAR_DIR defined" -$ TELL " You probably have not included the proper" -$ TELL " files in LOGIN.COM" -$ GOTO EXEX -$ ENDIF -$ IF F$TRNLNM("EXEDWARF") .EQS. "" .OR. - - F$TRNLNM("LIBDWARF") .EQS. "" .OR. - - F$TRNLNM("RUNDWARF") .EQS. "" -$ THEN -$ TELL " Error: Cannot do everything with EXEDWARF and/or" -$ TELL " LIBDWARF and/or RUNDWARF not defined" -$ TELL " You probably have not included the proper" -$ TELL " files in LOGIN.COM" -$ GOTO EXEX -$ ENDIF -$ IF "''NXEC'" .EQS. "" -$ THEN -$ TELL " Error: You have no symbol for NXEC etc." -$ TELL " You probably have not included the proper" -$ TELL " files in LOGIN.COM" -$ GOTO EXEX -$ ENDIF -$ IF "''WNG_EXE'" .EQS. "" THEN - - WNG_EXE=F$TRNLNM("WNG_OLBEXE") -$ IF "''WNG_OLB'" .EQS. "" THEN - - WNG_OLB=F$TRNLNM("WNG_OLBEXE") -$ WNG_TLB="" ! MAKE SURE -$ WNG_ERR="" -$ WNG_LIS="" -$ WNG_LINK="" -$ BLDDIR="''NSTAR_DIR'" ! Newstar directories -$ IF P3 .NES. "" THEN BLDDIR="''P3'" -$ L0=0 ! MAKE DIRECTORIES -$ LP1: L1=F$ELEMENT(L0,",",BLDDIR) -$ IF L1 .NES. "," -$ THEN -$ IF F$PARSE("''WNG_EXE':[''L1']") .EQS. "" THEN - ! MAKE DIRECTORIES - CREATE/DIR 'WNG_EXE'['L1'] -$ IF F$PARSE("''WNG_OLB':[''L1']") .EQS. "" THEN - - CREATE/DIR 'WNG_OLB':['L1'] -$ L0=L0+1 -$ GOTO LP1 -$ ENDIF -$!# -$!# Start -$!# -$ TELL "Running NREDO.COM at ''WNG_SITE'(''WNG_TYPE')" -$ TELL " " -$!# -$!# Compiling -$!# -$ GCMP: -$ IF F$LOCATE("c",P1) .EQS. F$LENGTH(P1) .AND. - - F$LOCATE("C",P1) .EQS. F$LENGTH(P1) THEN GOTO LINK !NO COMP -$ SET DEF WNG_DIR:[WNG.-] ! BASE DIRECTORY -$ TELL "Compiling ..." -$ L0=0 ! MAKE DIRECTORIES -$ LP2: L1=F$ELEMENT(L0,",",BLDDIR) -$ IF L1 .NES. "," -$ THEN -$ SET DEF WNG_DIR:['L1'] -$ TELL "... ''L1'" -$ ASSIGN/NOLOG NL: SYS$OUTPUT -$ NCOMP -U 'P2' %%%.GRP ! Compile groups -$ DEASSIGN SYS$OUTPUT -$ L0=L0+1 -$ GOTO LP2 -$ ENDIF -$!# -$!# Link all -$!# -$ LINK: -$ IF F$LOCATE("l",P1) .EQS. F$LENGTH(P1) .AND. - - F$LOCATE("L",P1) .EQS. F$LENGTH(P1) THEN GOTO END !NO LINK -$ SET DEF WNG_DIR:[WNG.-] ! BASE DIRECTORY -$ TELL "Linking Newstar system ..." -$ L0=0 ! MAKE DIRECTORIES -$ LP6: L1=F$ELEMENT(L0,",",BLDDIR) -$ IF L1 .NES. "," -$ THEN -$ SET DEF WNG_DIR:['L1'] -$ TELL "... ''L1'" -$ ASSIGN/NOLOG NL: SYS$OUTPUT -$ NLINK -U 'P2' %%%.GRP ! LINK -$ DEASSIGN SYS$OUTPUT -$ L0=L0+1 -$ GOTO LP6 -$ ENDIF -$!# -$!# Ready -$!# -$ END: -$ TELL " " -$ TELL "Newstar rebuilt." -$ TELL " " -$!# -$!# EXIT -$!# -$ EXEX: SET ON -$ EXX1: -$ SET DEF WNG_DIR:[WNG.-] !BACK TO NORMAL -$ L0=F$VERIFY(VER) !RESET VERIFY -$ EXIT diff --git a/src/wng/nredo.ssc b/src/wng/nredo.ssc deleted file mode 100644 index 7374d0136c229e6f20d60bebcd8de393282118a0..0000000000000000000000000000000000000000 --- a/src/wng/nredo.ssc +++ /dev/null @@ -1,258 +0,0 @@ -# nredo.ssc -# WNB 921231 -# -# Revisions: -# WNB 930303 NSTAR_DIR added -# WNB 930305 Make sure aliases -# WNB 930514 Correct aliases -# WNB 940124 Leave _TLB -# -# Rebuild Newstar from current files/text library -# -# Uses environment variables: -# WNG where to find wng-type sources -# WNG_TYPE machine (sw, dw, hp, al, cv etc) -# WNG_OLBEXE root of wng-type .olb, .ppd, .exe -# WNG_SITE site (nfra, atnf, rug ...) -# EXEDWARF_UNIX where to find/set DWARF .exe, .ppd -# LIBDWARF where to find DWARF .olb -# NSTAR_DIR N directories -# and also possible: -# WNG_EXE, WNG_OLB, WNG_TLB, WNG_ERR, WNG_LIS, WNG_LINK -# -# Use as: -# $WNG/nredo.sun c|l|cl [switches] ["dir1 dir2 ..."] (Unix) -# @WNG:NREDO c|l|cl [switches] [dir1,dir2,...] (VAX) -# c/l compile/link -# switches e.g. -l1 (always at least - if dir given); -u is default -# directories e.g. nscan (default all N-directories) -# -# Intro -# -#ifdef wn_vax__ -$ SET NOON !DISCARD ERRORS -$ ON CONTROL_Y THEN GOTO EXEX !FINISH NEATLY -$ VER=F$VERIFY() !FOR ^Y -$ PID=F$EXTRACT(4,4,F$GETJPI("","PID")) !FOR TMP FILES -$ DEP=1 !FOR INDIRECT -$ LDAT=F$EXTRACT(2,2,F$CVTIM(,,"YEAR"))+F$CVTIM(,,"MONTH")+ - - F$CVTIM(,,"DAY") !VERSION -$ TELL="WRITE SYS$OUTPUT" !FOR EASE OF USE -$ ! -$ ASSIGN="ASSIGN" !MAKE SURE PROPER USE -$ BACKUP="BACKUP" -$ COPY="COPY" -$ DELETE="DELETE" -$ DIR="DIRECTORY" -$ PURGE="PURGE" -$ SET="SET" -$ SHOW="SHOW" -$ TELL " " -$ TELL "Rebuilding Newstar." -$ TELL " " -$ TELL "A log will be made in the standard UPD''LDAT'.LOG" -$ TELL " " -#else - onintr exex # finish neatly - if ($?echo) unset echo # no verify - if ($?verbose) unset verbose # no verbose - set pid=$$ ; @ dep=1 # for tmp files - echo " " - echo "Rebuilding Newstar." - echo " " - echo "A log will be made in the standard UPDyymmdd.LOG" - echo " " -#endif -# -# Check environment -# -#ifdef wn_vax__ -$ IF F$TRNLNM("WNG") .EQS. "" .OR. F$TRNLNM("WNG_OLBEXE") .EQS. "" - - .OR. F$TRNLNM("WNG_DIR") .EQS. "" - - .OR. "''WNG_TYPE'" .EQS. "" .OR. "''WNG_SITE'" .EQS. "" - - .OR. "''NSTAR_DIR'" .EQS. "" - -$ THEN -$ TELL " Error: Must have logicals WNG, WNG_OLBEXE, WNG_DIR and globals" -$ TELL " WNG_TYPE, WNG_SITE, NSTAR_DIR defined" -$ TELL " You probably have not included the proper" -$ TELL " files in LOGIN.COM" -$ GOTO EXEX -$ ENDIF -$ IF F$TRNLNM("EXEDWARF") .EQS. "" .OR. - - F$TRNLNM("LIBDWARF") .EQS. "" .OR. - - F$TRNLNM("RUNDWARF") .EQS. "" -$ THEN -$ TELL " Error: Cannot do everything with EXEDWARF and/or" -$ TELL " LIBDWARF and/or RUNDWARF not defined" -$ TELL " You probably have not included the proper" -$ TELL " files in LOGIN.COM" -$ GOTO EXEX -$ ENDIF -$ IF "''NXEC'" .EQS. "" -$ THEN -$ TELL " Error: You have no symbol for NXEC etc." -$ TELL " You probably have not included the proper" -$ TELL " files in LOGIN.COM" -$ GOTO EXEX -$ ENDIF -$ IF "''WNG_EXE'" .EQS. "" THEN - - WNG_EXE=F$TRNLNM("WNG_OLBEXE") -$ IF "''WNG_OLB'" .EQS. "" THEN - - WNG_OLB=F$TRNLNM("WNG_OLBEXE") -$ WNG_TLB="" ! MAKE SURE -$ WNG_ERR="" -$ WNG_LIS="" -$ WNG_LINK="" -$ BLDDIR="''NSTAR_DIR'" ! Newstar directories -$ IF P3 .NES. "" THEN BLDDIR="''P3'" -$ L0=0 ! MAKE DIRECTORIES -$ LP1: L1=F$ELEMENT(L0,",",BLDDIR) -$ IF L1 .NES. "," -$ THEN -$ IF F$PARSE("''WNG_EXE':[''L1']") .EQS. "" THEN - ! MAKE DIRECTORIES - CREATE/DIR 'WNG_EXE'['L1'] -$ IF F$PARSE("''WNG_OLB':[''L1']") .EQS. "" THEN - - CREATE/DIR 'WNG_OLB':['L1'] -$ L0=L0+1 -$ GOTO LP1 -$ ENDIF -#else - if (! $?WNG || ! $?WNG_TYPE || ! $?WNG_OLBEXE ||\ - ! $?WNG_SITE || ! $?NSTAR_DIR) then - echo " Error: Must have environment variables" - echo " WNG, WNG_TYPE, WNG_OLBEXE, WNG_SITE, NSTAR_DIR defined" - echo " You probably have not included the proper" - echo " files in .cshrc (see README)" - goto exex - endif - if (! $?EXEDWARF_UNIX || ! $?LIBDWARF) then - echo " Error: Cannot do everything with EXEDWARF_UNIX and/or" - echo " LIBDWARF not defined" - echo " You probably have not included the proper" - echo " files in .cshrc (see README)" - goto exex - endif - source $WNG/wngcshrc.sun # get aliases - if ("`alias nxec`" == "") then - echo " Error: You have no alias for nxec etc." - echo " You probably have not included the proper" - echo " files in .cshrc (see README)" - goto exex - endif -# -# Creating environment -# - cd $WNG - if (! $?WNG_EXE) setenv WNG_EXE $WNG_OLBEXE # make names - if (! $?WNG_OLB) setenv WNG_OLB $WNG_OLBEXE - set blddir=($NSTAR_DIR) # Newstar directories - if ("$3" != "") set blddir=($3) - foreach i ($blddir) - if (! -d $WNG_EXE/$i) mkdir $WNG_EXE/$i # make directories - if (! -d $WNG_OLB/$i) mkdir $WNG_OLB/$i - endif -## if ($?WNG_TLB) unsetenv WNG_TLB # make sure - if ($?WNG_ERR) unsetenv WNG_ERR - if ($?WNG_LIS) unsetenv WNG_LIS - if ($?WNG_LINK) unsetenv WNG_LINK -#endif -# -# Start -# -#ifdef wn_vax__ -$ TELL "Running NREDO.COM at ''WNG_SITE'(''WNG_TYPE')" -$ TELL " " -#else - echo "Running NREDO.SUN for $WNG_SITE($WNG_TYPE)" - echo "on `hostname` at `date`" -#endif -# -# Compiling -# -#ifdef wn_vax__ -$ GCMP: -$ IF F$LOCATE("c",P1) .EQS. F$LENGTH(P1) .AND. - - F$LOCATE("C",P1) .EQS. F$LENGTH(P1) THEN GOTO LINK !NO COMP -$ SET DEF WNG_DIR:[WNG.-] ! BASE DIRECTORY -$ TELL "Compiling ..." -$ L0=0 ! MAKE DIRECTORIES -$ LP2: L1=F$ELEMENT(L0,",",BLDDIR) -$ IF L1 .NES. "," -$ THEN -$ SET DEF WNG_DIR:['L1'] -$ TELL "... ''L1'" -$ ASSIGN/NOLOG NL: SYS$OUTPUT -$ NCOMP -U 'P2' %%%.GRP ! Compile groups -$ DEASSIGN SYS$OUTPUT -$ L0=L0+1 -$ GOTO LP2 -$ ENDIF -#else -GCMP: - if ("$1" !~ *c* && "$1" !~ *C*) goto LINK # no compile - cd $WNG # base directory - echo "Compiling ..." - foreach i ($blddir) # get .def - cd ../$i # correct directory - echo "... $i" - ncomp -u $2 ???.grp >& /dev/null # compile all groups - end -#endif -# -# Link all -# -#ifdef wn_vax__ -$ LINK: -$ IF F$LOCATE("l",P1) .EQS. F$LENGTH(P1) .AND. - - F$LOCATE("L",P1) .EQS. F$LENGTH(P1) THEN GOTO END !NO LINK -$ SET DEF WNG_DIR:[WNG.-] ! BASE DIRECTORY -$ TELL "Linking Newstar system ..." -$ L0=0 ! MAKE DIRECTORIES -$ LP6: L1=F$ELEMENT(L0,",",BLDDIR) -$ IF L1 .NES. "," -$ THEN -$ SET DEF WNG_DIR:['L1'] -$ TELL "... ''L1'" -$ ASSIGN/NOLOG NL: SYS$OUTPUT -$ NLINK -U 'P2' %%%.GRP ! LINK -$ DEASSIGN SYS$OUTPUT -$ L0=L0+1 -$ GOTO LP6 -$ ENDIF -#else -LINK: - if ("$1" !~ *l* && "$1" !~ *L*) goto END # no link - cd $WNG # base directory - echo "Linking Newstar system ..." - foreach i ($blddir) # link - cd ../$i # correct directory - echo "... $i" - nlink -u $2 ???.grp >& /dev/null # link all - end -#endif -# -# Ready -# -#ifdef wn_vax__ -$ END: -$ TELL " " -$ TELL "Newstar rebuilt." -$ TELL " " -#else -END: - echo "Newstar rebuilt." - echo " " -#endif -# -# EXIT -# -#ifdef wn_vax__ -$ EXEX: SET ON -$ EXX1: -$ SET DEF WNG_DIR:[WNG.-] !BACK TO NORMAL -$ L0=F$VERIFY(VER) !RESET VERIFY -$ EXIT -#else -exex: - exit -#endif diff --git a/src/wng/nredo.sun b/src/wng/nredo.sun deleted file mode 100755 index 8557416df6a88bc6a91b0e4e8aeb99e57ba4af37..0000000000000000000000000000000000000000 --- a/src/wng/nredo.sun +++ /dev/null @@ -1,121 +0,0 @@ -# nredo.ssc -# WNB 921231 -# -# Revisions: -# WNB 930303 NSTAR_DIR added -# WNB 930305 Make sure aliases -# WNB 930514 Correct aliases -# WNB 940124 Leave _TLB -# -# Rebuild Newstar from current files/text library -# -# Uses environment variables: -# WNG where to find wng-type sources -# WNG_TYPE machine (sw, dw, hp, al, cv etc) -# WNG_OLBEXE root of wng-type .olb, .ppd, .exe -# WNG_SITE site (nfra, atnf, rug ...) -# EXEDWARF_UNIX where to find/set DWARF .exe, .ppd -# LIBDWARF where to find DWARF .olb -# NSTAR_DIR N directories -# and also possible: -# WNG_EXE, WNG_OLB, WNG_TLB, WNG_ERR, WNG_LIS, WNG_LINK -# -# Use as: -# $WNG/nredo.sun c|l|cl [switches] ["dir1 dir2 ..."] (Unix) -# @WNG:NREDO c|l|cl [switches] [dir1,dir2,...] (VAX) -# c/l compile/link -# switches e.g. -l1 (always at least - if dir given); -u is default -# directories e.g. nscan (default all N-directories) -# -# Intro -# - onintr exex # finish neatly - if ($?echo) unset echo # no verify - if ($?verbose) unset verbose # no verbose - set pid=$$ ; @ dep=1 # for tmp files - echo " " - echo "Rebuilding Newstar." - echo " " - echo "A log will be made in the standard UPDyymmdd.LOG" - echo " " -# -# Check environment -# - if (! $?WNG || ! $?WNG_TYPE || ! $?WNG_OLBEXE ||\ - ! $?WNG_SITE || ! $?NSTAR_DIR) then - echo " Error: Must have environment variables" - echo " WNG, WNG_TYPE, WNG_OLBEXE, WNG_SITE, NSTAR_DIR defined" - echo " You probably have not included the proper" - echo " files in .cshrc (see README)" - goto exex - endif - if (! $?EXEDWARF_UNIX || ! $?LIBDWARF) then - echo " Error: Cannot do everything with EXEDWARF_UNIX and/or" - echo " LIBDWARF not defined" - echo " You probably have not included the proper" - echo " files in .cshrc (see README)" - goto exex - endif - source $WNG/wngcshrc.sun # get aliases - if ("`alias nxec`" == "") then - echo " Error: You have no alias for nxec etc." - echo " You probably have not included the proper" - echo " files in .cshrc (see README)" - goto exex - endif -# -# Creating environment -# - cd $WNG - if (! $?WNG_EXE) setenv WNG_EXE $WNG_OLBEXE # make names - if (! $?WNG_OLB) setenv WNG_OLB $WNG_OLBEXE - set blddir=($NSTAR_DIR) # Newstar directories - if ("$3" != "") set blddir=($3) - foreach i ($blddir) - if (! -d $WNG_EXE/$i) mkdir $WNG_EXE/$i # make directories - if (! -d $WNG_OLB/$i) mkdir $WNG_OLB/$i - endif -## if ($?WNG_TLB) unsetenv WNG_TLB # make sure - if ($?WNG_ERR) unsetenv WNG_ERR - if ($?WNG_LIS) unsetenv WNG_LIS - if ($?WNG_LINK) unsetenv WNG_LINK -# -# Start -# - echo "Running NREDO.SUN for $WNG_SITE($WNG_TYPE)" - echo "on `hostname` at `date`" -# -# Compiling -# -GCMP: - if ("$1" !~ *c* && "$1" !~ *C*) goto LINK # no compile - cd $WNG # base directory - echo "Compiling ..." - foreach i ($blddir) # get .def - cd ../$i # correct directory - echo "... $i" - ncomp -u $2 ???.grp >& /dev/null # compile all groups - end -# -# Link all -# -LINK: - if ("$1" !~ *l* && "$1" !~ *L*) goto END # no link - cd $WNG # base directory - echo "Linking Newstar system ..." - foreach i ($blddir) # link - cd ../$i # correct directory - echo "... $i" - nlink -u $2 ???.grp >& /dev/null # link all - end -# -# Ready -# -END: - echo "Newstar rebuilt." - echo " " -# -# EXIT -# -exex: - exit diff --git a/src/wng/ntarz.com b/src/wng/ntarz.com deleted file mode 100755 index b7408dacd8f4152f81d83a382ec1fcf93bad3332..0000000000000000000000000000000000000000 --- a/src/wng/ntarz.com +++ /dev/null @@ -1,226 +0,0 @@ -$!# ntarz.ssc -$!# WNB 921117 -$!# -$!# Revisions: -$!# WNB 921218 Add SSC -$!# WNB 921222 Add COM -$!# WNB 921224 Make SSC -$!# WNB 930303 NSTAR_DIR added -$!# WNB 930305 Make sure aliases -$!# WNB 930514 Correct aliases -$!# HjV 930914 Typo -$!# WNB 940124 Leave _TLB -$!# -$!# Build Newstar export files -$!# -$!# Uses environment variables: -$!# WNG where to find wng-type sources -$!# WNG_TYPE machine (sw, dw, hp, al, cv etc) -$!# WNG_OLBEXE root of wng-type .olb, .ppd, .exe -$!# WNG_SITE site (nfra, atnf, rug ...) -$!# EXEDWARF_UNIX where to find/set DWARF .exe, .ppd -$!# LIBDWARF where to find DWARF .olb -$!# and also possible: -$!# WNG_EXE, WNG_OLB, WNG_TLB, WNG_ERR, WNG_LIS, WNG_LINK -$!# -$!# Intro -$!# -$ SET NOON !DISCARD ERRORS -$ ON CONTROL_Y THEN GOTO EXEX !FINISH NEATLY -$ VER=F$VERIFY() !FOR ^Y -$ PID=F$EXTRACT(4,4,F$GETJPI("","PID")) !FOR TMP FILES -$ DEP=1 !FOR INDIRECT -$ LDAT=F$EXTRAC(2,2,F$CVTIM(,,"YEAR"))+F$CVTIM(,,"MONTH")+ - - F$CVTIM(,,"DAY") !VERSION -$ TELL="WRITE SYS$OUTPUT" !FOR EASE OF USE -$ TLOG="WRITE LOG''PID'''DEP'" -$ ! -$ ASSIGN="ASSIGN" !MAKE SURE PROPER USE -$ BACKUP="BACKUP" -$ COPY="COPY" -$ DELETE="DELETE" -$ DIR="DIRECTORY" -$ PURGE="PURGE" -$ SET="SET" -$ SHOW="SHOW" -$ TELL " " -$ TELL "Building Newstar backup files." -$ TELL " " -$ TELL "A log will be made in WNG_DIR:[WNG.-]NT''PID'''DEP'.LOG" -$ TELL "There should be about 50 Mbytes available," -$ TELL "and it will probably take up to an hour." -$ TELL " " -$!# -$!# Check environment -$!# -$ IF F$TRNLNM("WNG") .EQS. "" .OR. F$TRNLNM("WNG_OLBEXE") .EQS. "" - - .OR. F$TRNLNM("WNG_DIR") .EQS. "" - - .OR. "''WNG_TYPE'" .EQS. "" .OR. "''WNG_SITE'" .EQS. "" - - .OR. "''NSTAR_DIR'" .EQS. "" - -$ THEN -$ TELL " Error: Must have logicals WNG, WNG_OLBEXE, WNG_DIR and globals" -$ TELL " WNG_TYPE, WNG_SITE, NSTAR_DIR defined" -$ TELL " You probably have not included the proper" -$ TELL " files in LOGIN.COM" -$ GOTO EXEX -$ ENDIF -$ IF F$TRNLNM("EXEDWARF") .EQS. "" .OR. - - F$TRNLNM("LIBDWARF") .EQS. "" .OR. - - F$TRNLNM("RUNDWARF") .EQS. "" -$ THEN -$ TELL " Error: Cannot do everything with EXEDWARF and/or" -$ TELL " LIBDWARF and/or RUNDWARF not defined" -$ TELL " You probably have not included the proper" -$ TELL " files in LOGIN.COM" -$ GOTO EXEX -$ ENDIF -$ IF "''NXEC'" .EQS. "" -$ THEN -$ TELL " Error: You have no symbol for NXEC etc." -$ TELL " You probably have not included the proper" -$ TELL " files in LOGIN.COM" -$ GOTO EXEX -$ ENDIF -$ IF "''WNG_EXE'" .EQS. "" THEN - - WNG_EXE=F$TRNLNM("WNG_OLBEXE") -$ IF "''WNG_OLB'" .EQS. "" THEN - - WNG_OLB=F$TRNLNM("WNG_OLBEXE") -$ WNG_TLB="" ! MAKE SURE -$ WNG_ERR="" -$ WNG_LIS="" -$ WNG_LINK="" -$ BLDDIR="''NSTAR_DIR'" ! Newstar directories -$ L0=0 ! MAKE DIRECTORIES -$ LP1: L1=F$ELEMENT(L0,",",BLDDIR) -$ IF L1 .NES. "," -$ THEN -$ IF F$PARSE("''WNG_EXE':[''L1']") .EQS. "" THEN - ! MAKE DIRECTORIES - CREATE/DIR 'WNG_EXE'['L1'] -$ IF F$PARSE("''WNG_OLB':[''L1']") .EQS. "" THEN - - CREATE/DIR 'WNG_OLB':['L1'] -$ L0=L0+1 -$ GOTO LP1 -$ ENDIF -$!# -$!# Get questions -$!# -$ OPEN/WRITE/ERROR=EXEX LOG'PID''DEP' WNG_DIR:[WNG.-]NT'PID''DEP'.LOG ! START LOG -$ TLOG "NU''PID'''DEP'.LOG" -$ TELL "Running NTARZ.COM at ''WNG_SITE'(''WNG_TYPE')" -$ TLOG "Running NTARZ.COM at ''WNG_SITE'(''WNG_TYPE')" -$ TELL "on ''F$GETSYI("NODENAME")' at ''F$TIME()'" -$ TLOG "on ''F$GETSYI("NODENAME")' at ''F$TIME()'" -$ TELL " " -$ TLOG " " -$ DOSRC="Y" -$ READ/TIME=90/END=EXEX/ERROR=EXEX - - /PROMPT="Do you want the source files? (Y|N) [''DOSRC']: " - - SYS$COMMAND L0 -$ TLOG "Do you want the source files? (Y|N) [''DOSRC']: ''L0'" -$ IF "''L0'" .EQS. "n" .OR. "''L0'" .EQS. "N" THEN DOSRC="N" -$ DOOLB="N" -$ READ/TIME=90/END=EXEX/ERROR=EXEX - - /PROMPT="Do you want the object libraries? (Y|N) [''DOOLB']: " - - SYS$COMMAND L0 -$ TLOG "Do you want the object libraries? (Y|N) [''DOOLB']: ''L0'" -$ IF "''L0'" .EQS. "y" .OR. "''L0'" .EQS. "Y" THEN DOOLB="Y" -$ DOEXE="N" -$ READ/TIME=90/END=EXEX/ERROR=EXEX - - /PROMPT="Do you want the executables? (Y|N) [''DOEXE']: " - - SYS$COMMAND L0 -$ TLOG "Do you want the executables? (Y|N) [''DOEXE']: ''L0'" -$ IF "''L0'" .EQS. "y" .OR. "''L0'" .EQS. "Y" THEN DOEXE="Y" -$!# -$!# Do sources -$!# -$ DSRC: -$ SET DEF WNG_DIR:[WNG.-] ! BASE DIRECTORY -$ IF DOSRC -$ THEN -$ TELL "Creating Newstar_src_VMS.''LDAT'" -$ TLOG "Creating Newstar_src_VMS.''LDAT'" -$ LFIL="" -$ L0=0 ! MAKE LIST -$ LP2: L1=F$ELEMENT(L0,",",BLDDIR) -$ IF L1 .NES. "," -$ THEN -$ IF LFIL .NES. "" THEN LFIL=LFIL+"," -$ IF "''L1'" .EQS. "WNG" -$ THEN -$ COPY ['L1']*.TXT * -$ LFIL=LFIL+"[]*.TXT," -$ ENDIF -$ LFIL=LFIL+"[''L1']*.COM;0,*.SUN;0,*.TLB;0,*.HLB;0,*.TXT;0" -$ L0=L0+1 -$ GOTO LP2 -$ ENDIF -$ BACKUP/LIST=LOG'PID''DEP'.LOG 'LFIL' - - WNG_DIR:[WNG.-]NEWSTAR_SRC_VMS.'LDAT'/SAVE -$ ENDIF -$!# -$!# Write Object libraries -$!# -$ DOLB: -$ SET DEF WNG_OLBEXE:[WNG.-] ! BASE DIRECTORY -$ IF DOOLB -$ THEN -$ TELL "Creating Newstar_olb_VMS.''LDAT'" -$ TLOG "Creating Newstar_olb_VMS.''LDAT'" -$ LFIL="" -$ L0=0 ! MAKE LIST -$ LP3: L1=F$ELEMENT(L0,",",BLDDIR) -$ IF L1 .NES. "," -$ THEN -$ IF LFIL .NES. "" THEN LFIL=LFIL+"," -$ LFIL=LFIL+"[''L1']*.OLB;0" -$ IF L1 .EQS. "WNG" THEN LFIL=LFIL+",*.EXE;0" -$ L0=L0+1 -$ GOTO LP3 -$ ENDIF -$ BACKUP/LIST=LOG'PID''DEP' 'LFIL' - - WNG_DIR:[WNG.-]NEWSTAR_OLB_VMS.'LDAT'/SAVE -$ ENDIF -$!# -$!# Write executables -$!# -$ DEXE: -$ SET DEF RUNDWARF ! BASE DIRECTORY -$ IF DOEXE -$ THEN -$ TELL "Creating Newstar_exe_VMS.''LDAT'" -$ TLOG "Creating Newstar_exe_VMS.''LDAT'" -$ LFIL="*.EXE;0,[.EXE]*.EXE;0,*.PPD;0" -$ BACKUP/LIST=LOG'PID''DEP'.LOG 'LFIL' - - WNG_DIR:[WNG.-]NEWSTAR_EXE_VMS.'LDAT'/SAVE -$ ENDIF -$!# -$!# Cleanup -$!# -$ CLUP: -$!# -$!# Ready -$!# -$ END: -$ TELL " " -$ TLOG " " -$ TELL "The backup files can after restore in the directories:" -$ TLOG "The backup files can after restore in the directories:" -$ TELL "WNG_DIR[WNG.-] for src; WNG_OLBEXE[WNG.-] for olb;" -$ TLOG "WNG_DIR[WNG.-] for src; WNG_OLBEXE[WNG.-] for olb;" -$ TELL "and RUNDWARF for exe" -$ TLOG "and RUNDWARF for exe" -$ TELL "be used by @WNG:NBUILD to build Newstar" -$ TLOG "be used by @WNG:NBUILD to build Newstar" -$ TELL "Check log for errors" -$ TLOG "Check log for errors" -$ TELL " " -$ TLOG " " -$!# -$!# EXIT -$!# -$ EXEX: SET ON -$ CLOSE/ERROR=EXX1 LOG'PID''DEP !MAKE SURE -$ EXX1: -$ SET DEF WNG_DIR:[WNG.-] !BACK TO NORMAL -$ L0=F$VERIFY(VER) !RESET VERIFY -$ EXIT diff --git a/src/wng/ntarz.ssc b/src/wng/ntarz.ssc deleted file mode 100644 index 15195379e88cedcbe476f94fca0ae9e904a9d45c..0000000000000000000000000000000000000000 --- a/src/wng/ntarz.ssc +++ /dev/null @@ -1,400 +0,0 @@ -# ntarz.ssc -# WNB 921117 -# -# Revisions: -# WNB 921218 Add SSC -# WNB 921222 Add COM -# WNB 921224 Make SSC -# WNB 930303 NSTAR_DIR added -# WNB 930305 Make sure aliases -# WNB 930514 Correct aliases -# HjV 930914 Typo -# WNB 940124 Leave _TLB -# -# Build Newstar export files -# -# Uses environment variables: -# WNG where to find wng-type sources -# WNG_TYPE machine (sw, dw, hp, al, cv etc) -# WNG_OLBEXE root of wng-type .olb, .ppd, .exe -# WNG_SITE site (nfra, atnf, rug ...) -# EXEDWARF_UNIX where to find/set DWARF .exe, .ppd -# LIBDWARF where to find DWARF .olb -# and also possible: -# WNG_EXE, WNG_OLB, WNG_TLB, WNG_ERR, WNG_LIS, WNG_LINK -# -# Intro -# -#ifdef wn_vax__ -$ SET NOON !DISCARD ERRORS -$ ON CONTROL_Y THEN GOTO EXEX !FINISH NEATLY -$ VER=F$VERIFY() !FOR ^Y -$ PID=F$EXTRACT(4,4,F$GETJPI("","PID")) !FOR TMP FILES -$ DEP=1 !FOR INDIRECT -$ LDAT=F$EXTRAC(2,2,F$CVTIM(,,"YEAR"))+F$CVTIM(,,"MONTH")+ - - F$CVTIM(,,"DAY") !VERSION -$ TELL="WRITE SYS$OUTPUT" !FOR EASE OF USE -$ TLOG="WRITE LOG''PID'''DEP'" -$ ! -$ ASSIGN="ASSIGN" !MAKE SURE PROPER USE -$ BACKUP="BACKUP" -$ COPY="COPY" -$ DELETE="DELETE" -$ DIR="DIRECTORY" -$ PURGE="PURGE" -$ SET="SET" -$ SHOW="SHOW" -$ TELL " " -$ TELL "Building Newstar backup files." -$ TELL " " -$ TELL "A log will be made in WNG_DIR:[WNG.-]NT''PID'''DEP'.LOG" -$ TELL "There should be about 50 Mbytes available," -$ TELL "and it will probably take up to an hour." -$ TELL " " -#else - onintr exex # finish neatly - if ($?echo) unset echo # no verify - if ($?verbose) unset verbose # no verbose - set pid=$$ ; @ dep=1 # for tmp files - set date=(`date`) # get version - if ("$date[3]" =~ [1-9]) set date[3] = "0$date[3]" # day - set loo=( Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec) - foreach mm ( 01 02 03 04 05 06 07 08 09 10 11 12) - if ("$date[2]" == "$loo[$mm]") break # month - end - @ yy = $date[$#date] - 1900 # year - set ldat="$yy$mm$date[3]" #version yymmdd - echo " " - echo "Building Newstar tar files." - echo " " - echo 'A log will be made in $WNG'"/../nt$pid$dep.log" - echo "There should be about 50 Mbytes available," - echo "and it will probably take up to an hour." - echo " " -#endif -# -# Check environment -# -#ifdef wn_vax__ -$ IF F$TRNLNM("WNG") .EQS. "" .OR. F$TRNLNM("WNG_OLBEXE") .EQS. "" - - .OR. F$TRNLNM("WNG_DIR") .EQS. "" - - .OR. "''WNG_TYPE'" .EQS. "" .OR. "''WNG_SITE'" .EQS. "" - - .OR. "''NSTAR_DIR'" .EQS. "" - -$ THEN -$ TELL " Error: Must have logicals WNG, WNG_OLBEXE, WNG_DIR and globals" -$ TELL " WNG_TYPE, WNG_SITE, NSTAR_DIR defined" -$ TELL " You probably have not included the proper" -$ TELL " files in LOGIN.COM" -$ GOTO EXEX -$ ENDIF -$ IF F$TRNLNM("EXEDWARF") .EQS. "" .OR. - - F$TRNLNM("LIBDWARF") .EQS. "" .OR. - - F$TRNLNM("RUNDWARF") .EQS. "" -$ THEN -$ TELL " Error: Cannot do everything with EXEDWARF and/or" -$ TELL " LIBDWARF and/or RUNDWARF not defined" -$ TELL " You probably have not included the proper" -$ TELL " files in LOGIN.COM" -$ GOTO EXEX -$ ENDIF -$ IF "''NXEC'" .EQS. "" -$ THEN -$ TELL " Error: You have no symbol for NXEC etc." -$ TELL " You probably have not included the proper" -$ TELL " files in LOGIN.COM" -$ GOTO EXEX -$ ENDIF -$ IF "''WNG_EXE'" .EQS. "" THEN - - WNG_EXE=F$TRNLNM("WNG_OLBEXE") -$ IF "''WNG_OLB'" .EQS. "" THEN - - WNG_OLB=F$TRNLNM("WNG_OLBEXE") -$ WNG_TLB="" ! MAKE SURE -$ WNG_ERR="" -$ WNG_LIS="" -$ WNG_LINK="" -$ BLDDIR="''NSTAR_DIR'" ! Newstar directories -$ L0=0 ! MAKE DIRECTORIES -$ LP1: L1=F$ELEMENT(L0,",",BLDDIR) -$ IF L1 .NES. "," -$ THEN -$ IF F$PARSE("''WNG_EXE':[''L1']") .EQS. "" THEN - ! MAKE DIRECTORIES - CREATE/DIR 'WNG_EXE'['L1'] -$ IF F$PARSE("''WNG_OLB':[''L1']") .EQS. "" THEN - - CREATE/DIR 'WNG_OLB':['L1'] -$ L0=L0+1 -$ GOTO LP1 -$ ENDIF -#else - if (! $?WNG || ! $?WNG_TYPE || ! $?WNG_OLBEXE ||\ - ! $?WNG_SITE || ! $?NSTAR_DIR) then - echo " Error: Must have environment variables" - echo " WNG, WNG_TYPE, WNG_OLBEXE, WNG_SITE, NSTAR_DIR defined" - echo " You probably have not included the proper" - echo " files in .cshrc" - goto exex - endif - if (! $?EXEDWARF_UNIX || ! $?LIBDWARF) then - echo " Error: Cannot do everything with EXEDWARF_UNIX and/or" - echo " LIBDWARF not defined" - echo " You probably have not included the proper" - echo " files in .cshrc" - goto exex - endif - source $WNG/wngcshrc.sun # get aliases - if ("`alias nxec`" == "") then - echo " Error: You have no alias for nxec etc." - echo " You probably have not included the proper" - echo " files in .cshrc" - goto exex - endif -# -# Creating environment -# - cd $WNG - if (! $?WNG_EXE) setenv WNG_EXE $WNG_OLBEXE # make names - if (! $?WNG_OLB) setenv WNG_OLB $WNG_OLBEXE - set blddir=($NSTAR_DIR) # Newstar directories - foreach i ($blddir) - if (! -d $WNG_EXE/$i) mkdir $WNG_EXE/$i # make directories - if (! -d $WNG_OLB/$i) mkdir $WNG_OLB/$i - endif -## if ($?WNG_TLB) unsetenv WNG_TLB # make sure - if ($?WNG_ERR) unsetenv WNG_ERR - if ($?WNG_LIS) unsetenv WNG_LIS - if ($?WNG_LINK) unsetenv WNG_LINK -#endif -# -# Get questions -# -#ifdef wn_vax__ -$ OPEN/WRITE/ERROR=EXEX LOG'PID''DEP' WNG_DIR:[WNG.-]NT'PID''DEP'.LOG ! START LOG -$ TLOG "NU''PID'''DEP'.LOG" -$ TELL "Running NTARZ.COM at ''WNG_SITE'(''WNG_TYPE')" -$ TLOG "Running NTARZ.COM at ''WNG_SITE'(''WNG_TYPE')" -$ TELL "on ''F$GETSYI("NODENAME")' at ''F$TIME()'" -$ TLOG "on ''F$GETSYI("NODENAME")' at ''F$TIME()'" -$ TELL " " -$ TLOG " " -$ DOSRC="Y" -$ READ/TIME=90/END=EXEX/ERROR=EXEX - - /PROMPT="Do you want the source files? (Y|N) [''DOSRC']: " - - SYS$COMMAND L0 -$ TLOG "Do you want the source files? (Y|N) [''DOSRC']: ''L0'" -$ IF "''L0'" .EQS. "n" .OR. "''L0'" .EQS. "N" THEN DOSRC="N" -$ DOOLB="N" -$ READ/TIME=90/END=EXEX/ERROR=EXEX - - /PROMPT="Do you want the object libraries? (Y|N) [''DOOLB']: " - - SYS$COMMAND L0 -$ TLOG "Do you want the object libraries? (Y|N) [''DOOLB']: ''L0'" -$ IF "''L0'" .EQS. "y" .OR. "''L0'" .EQS. "Y" THEN DOOLB="Y" -$ DOEXE="N" -$ READ/TIME=90/END=EXEX/ERROR=EXEX - - /PROMPT="Do you want the executables? (Y|N) [''DOEXE']: " - - SYS$COMMAND L0 -$ TLOG "Do you want the executables? (Y|N) [''DOEXE']: ''L0'" -$ IF "''L0'" .EQS. "y" .OR. "''L0'" .EQS. "Y" THEN DOEXE="Y" -#else - echo "nt$pid$dep.log" >>! $WNG/../nt$pid$dep.log # start log - echo "Running NTARZ.SUN at $WNG_SITE($WNG_TYPE)" \ - | tee -a $WNG/../nt$pid$dep.log - echo "on `hostname` at `date`" | tee -a $WNG/../nt$pid$dep.log - echo " " | tee -a $WNG/../nt$pid$dep.log - set dosrc - echo -n "Do you want the source files? (y|n) [y]: " \ - | tee -a $WNG/../nt$pid$dep.log - set l0=($<) - echo "$l0" >>! $WNG/../nt$pid$dep.log - if ("$l0" =~ [nN]*) unset dosrc # skip sources - echo -n "Do you want the object libraries? (y|n) [n]: " \ - | tee -a $WNG/../nt$pid$dep.log - set l0=($<) - echo "$l0" >>! $WNG/../nt$pid$dep.log - if ("$l0" =~ [yY]*) set doolb # do olb - echo -n "Do you want the executables? (y|n) [n]: " \ - | tee -a $WNG/../nt$pid$dep.log - set l0=($<) - echo "$l0" >>! $WNG/../nt$pid$dep.log - if ("$l0" =~ [yY]*) set doexe # do exe -#endif -# -# Do sources -# -#ifdef wn_vax__ -$ DSRC: -$ SET DEF WNG_DIR:[WNG.-] ! BASE DIRECTORY -$ IF DOSRC -$ THEN -$ TELL "Creating Newstar_src_VMS.''LDAT'" -$ TLOG "Creating Newstar_src_VMS.''LDAT'" -$ LFIL="" -$ L0=0 ! MAKE LIST -$ LP2: L1=F$ELEMENT(L0,",",BLDDIR) -$ IF L1 .NES. "," -$ THEN -$ IF LFIL .NES. "" THEN LFIL=LFIL+"," -$ IF "''L1'" .EQS. "WNG" -$ THEN -$ COPY ['L1']*.TXT * -$ LFIL=LFIL+"[]*.TXT," -$ ENDIF -$ LFIL=LFIL+"[''L1']*.COM;0,*.SUN;0,*.TLB;0,*.HLB;0,*.TXT;0" -$ L0=L0+1 -$ GOTO LP2 -$ ENDIF -$ BACKUP/LIST=LOG'PID''DEP'.LOG 'LFIL' - - WNG_DIR:[WNG.-]NEWSTAR_SRC_VMS.'LDAT'/SAVE -$ ENDIF -#else -DSRC: - cd $WNG/.. # base directory - if ($?dosrc) then - echo "Creating Newstar_src_unix_$ldat" \ - | tee -a $WNG/../nt$pid$dep.log - foreach i ($blddir) # get sources - if ("$i" == "wng") then - 'mv' ./$i/readme.txt README >& /dev/null - 'mv' ./$i/quest.txt QUEST >& /dev/null - tar cvf Newstar_src_unix_$ldat README QUEST \ - >>&! $WNG/../nt$pid$dep.log - endif - tar rvf Newstar_src_unix_$ldat ./$i/*.sun ./$i/*.tlb \ - ./$i/*.com ./$i/*.txt ./$i/*.hlp \ - >>&! $WNG/../nt$pid$dep.log - end - 'rm' Newstar_src_unix_$ldat.Z >& /dev/null # make sure - compress Newstar_src_unix_$ldat >>&! $WNG/../nt$pid$dep.log - endif -#endif -# -# Write Object libraries -# -#ifdef wn_vax__ -$ DOLB: -$ SET DEF WNG_OLBEXE:[WNG.-] ! BASE DIRECTORY -$ IF DOOLB -$ THEN -$ TELL "Creating Newstar_olb_VMS.''LDAT'" -$ TLOG "Creating Newstar_olb_VMS.''LDAT'" -$ LFIL="" -$ L0=0 ! MAKE LIST -$ LP3: L1=F$ELEMENT(L0,",",BLDDIR) -$ IF L1 .NES. "," -$ THEN -$ IF LFIL .NES. "" THEN LFIL=LFIL+"," -$ LFIL=LFIL+"[''L1']*.OLB;0" -$ IF L1 .EQS. "WNG" THEN LFIL=LFIL+",*.EXE;0" -$ L0=L0+1 -$ GOTO LP3 -$ ENDIF -$ BACKUP/LIST=LOG'PID''DEP' 'LFIL' - - WNG_DIR:[WNG.-]NEWSTAR_OLB_VMS.'LDAT'/SAVE -$ ENDIF -#else -DOLB: - cd $WNG_OLB # base directory - if ($?doolb) then - echo "Creating Newstar_olb_${WNG_TYPE}_$ldat" \ - | tee -a $WNG/../nt$pid$dep.log - foreach i ($blddir) # get sources - if ("$i" == "wng") then - tar cvf $WNG/../Newstar_olb_${WNG_TYPE}_$ldat ./$i/*.olb ./$i/*.exe \ - >>&! $WNG/../nt$pid$dep.log - else - tar rvf $WNG/../Newstar_olb_${WNG_TYPE}_$ldat ./$i/*.olb \ - >>&! $WNG/../nt$pid$dep.log - endif - end - 'rm' $WNG/../Newstar_olb_${WNG_TYPE}_$ldat.Z >& /dev/null # make sure - compress $WNG/../Newstar_olb_${WNG_TYPE}_$ldat \ - >>&! $WNG/../nt$pid$dep.log - endif -#endif -# -# Write executables -# -#ifdef wn_vax__ -$ DEXE: -$ SET DEF RUNDWARF ! BASE DIRECTORY -$ IF DOEXE -$ THEN -$ TELL "Creating Newstar_exe_VMS.''LDAT'" -$ TLOG "Creating Newstar_exe_VMS.''LDAT'" -$ LFIL="*.EXE;0,[.EXE]*.EXE;0,*.PPD;0" -$ BACKUP/LIST=LOG'PID''DEP'.LOG 'LFIL' - - WNG_DIR:[WNG.-]NEWSTAR_EXE_VMS.'LDAT'/SAVE -$ ENDIF -#else -DEXE: - cd $EXEDWARF_UNIX # base directory - if ($?doexe) then - echo "Creating Newstar_exe_${WNG_TYPE}_$ldat" \ - | tee -a $WNG/../nt$pid$dep.log - tar cvf $WNG/../Newstar_exe_${WNG_TYPE}_$ldat ./*.exe ./*.ppd \ - >>&! $WNG/../nt$pid$dep.log - 'rm' $WNG/../Newstar_exe_${WNG_TYPE}_$ldat.Z >& /dev/null # make sure - compress $WNG/../Newstar_exe_${WNG_TYPE}_$ldat \ - >>&! $WNG/../nt$pid$dep.log - endif -#endif -# -# Cleanup -# -#ifdef wn_vax__ -$ CLUP: -#else -CLUP: -#endif -# -# Ready -# -#ifdef wn_vax__ -$ END: -$ TELL " " -$ TLOG " " -$ TELL "The backup files can after restore in the directories:" -$ TLOG "The backup files can after restore in the directories:" -$ TELL "WNG_DIR[WNG.-] for src; WNG_OLBEXE[WNG.-] for olb;" -$ TLOG "WNG_DIR[WNG.-] for src; WNG_OLBEXE[WNG.-] for olb;" -$ TELL "and RUNDWARF for exe" -$ TLOG "and RUNDWARF for exe" -$ TELL "be used by @WNG:NBUILD to build Newstar" -$ TLOG "be used by @WNG:NBUILD to build Newstar" -$ TELL "Check log for errors" -$ TLOG "Check log for errors" -$ TELL " " -$ TLOG " " -#else -END: - echo " " \ - | tee -a $WNG/../nt$pid$dep.log - echo "Copy the produced .Z files by ftp (binary) to" \ - | tee -a $WNG/../nt$pid$dep.log - echo "rzmvx4.astron.nl user5:[wnb.wng]" \ - | tee -a $WNG/../nt$pid$dep.log - echo "The produced Z files can be after uncompress and" \ - | tee -a $WNG/../nt$pid$dep.log - echo "tar -xvf in the directories" \ - | tee -a $WNG/../nt$pid$dep.log - echo '$WNG/.. for src, $WNG_OLBEXE for olb and $EXEDWARF_UNIX for exe' \ - | tee -a $WNG/../nt$pid$dep.log - echo "be used in building the Newstar system by running" \ - | tee -a $WNG/../nt$pid$dep.log - echo '$WNG/nbuild.sun' \ - | tee -a $WNG/../nt$pid$dep.log - echo " " \ - | tee -a $WNG/../nt$pid$dep.log -#endif -# -# EXIT -# -#ifdef wn_vax__ -$ EXEX: SET ON -$ CLOSE/ERROR=EXX1 LOG'PID''DEP !MAKE SURE -$ EXX1: -$ SET DEF WNG_DIR:[WNG.-] !BACK TO NORMAL -$ L0=F$VERIFY(VER) !RESET VERIFY -$ EXIT -#else -exex: - exit -#endif diff --git a/src/wng/ntarz.sun b/src/wng/ntarz.sun deleted file mode 100755 index a6ce28fd478ed479f71a393ce031adb95ccb0cad..0000000000000000000000000000000000000000 --- a/src/wng/ntarz.sun +++ /dev/null @@ -1,198 +0,0 @@ -# ntarz.ssc -# WNB 921117 -# -# Revisions: -# WNB 921218 Add SSC -# WNB 921222 Add COM -# WNB 921224 Make SSC -# WNB 930303 NSTAR_DIR added -# WNB 930305 Make sure aliases -# WNB 930514 Correct aliases -# HjV 930914 Typo -# WNB 940124 Leave _TLB -# -# Build Newstar export files -# -# Uses environment variables: -# WNG where to find wng-type sources -# WNG_TYPE machine (sw, dw, hp, al, cv etc) -# WNG_OLBEXE root of wng-type .olb, .ppd, .exe -# WNG_SITE site (nfra, atnf, rug ...) -# EXEDWARF_UNIX where to find/set DWARF .exe, .ppd -# LIBDWARF where to find DWARF .olb -# and also possible: -# WNG_EXE, WNG_OLB, WNG_TLB, WNG_ERR, WNG_LIS, WNG_LINK -# -# Intro -# - onintr exex # finish neatly - if ($?echo) unset echo # no verify - if ($?verbose) unset verbose # no verbose - set pid=$$ ; @ dep=1 # for tmp files - set date=(`date`) # get version - if ("$date[3]" =~ [1-9]) set date[3] = "0$date[3]" # day - set loo=( Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec) - foreach mm ( 01 02 03 04 05 06 07 08 09 10 11 12) - if ("$date[2]" == "$loo[$mm]") break # month - end - @ yy = $date[$#date] - 1900 # year - set ldat="$yy$mm$date[3]" #version yymmdd - echo " " - echo "Building Newstar tar files." - echo " " - echo 'A log will be made in $WNG'"/../nt$pid$dep.log" - echo "There should be about 50 Mbytes available," - echo "and it will probably take up to an hour." - echo " " -# -# Check environment -# - if (! $?WNG || ! $?WNG_TYPE || ! $?WNG_OLBEXE ||\ - ! $?WNG_SITE || ! $?NSTAR_DIR) then - echo " Error: Must have environment variables" - echo " WNG, WNG_TYPE, WNG_OLBEXE, WNG_SITE, NSTAR_DIR defined" - echo " You probably have not included the proper" - echo " files in .cshrc" - goto exex - endif - if (! $?EXEDWARF_UNIX || ! $?LIBDWARF) then - echo " Error: Cannot do everything with EXEDWARF_UNIX and/or" - echo " LIBDWARF not defined" - echo " You probably have not included the proper" - echo " files in .cshrc" - goto exex - endif - source $WNG/wngcshrc.sun # get aliases - if ("`alias nxec`" == "") then - echo " Error: You have no alias for nxec etc." - echo " You probably have not included the proper" - echo " files in .cshrc" - goto exex - endif -# -# Creating environment -# - cd $WNG - if (! $?WNG_EXE) setenv WNG_EXE $WNG_OLBEXE # make names - if (! $?WNG_OLB) setenv WNG_OLB $WNG_OLBEXE - set blddir=($NSTAR_DIR) # Newstar directories - foreach i ($blddir) - if (! -d $WNG_EXE/$i) mkdir $WNG_EXE/$i # make directories - if (! -d $WNG_OLB/$i) mkdir $WNG_OLB/$i - endif -## if ($?WNG_TLB) unsetenv WNG_TLB # make sure - if ($?WNG_ERR) unsetenv WNG_ERR - if ($?WNG_LIS) unsetenv WNG_LIS - if ($?WNG_LINK) unsetenv WNG_LINK -# -# Get questions -# - echo "nt$pid$dep.log" >>! $WNG/../nt$pid$dep.log # start log - echo "Running NTARZ.SUN at $WNG_SITE($WNG_TYPE)" \ - | tee -a $WNG/../nt$pid$dep.log - echo "on `hostname` at `date`" | tee -a $WNG/../nt$pid$dep.log - echo " " | tee -a $WNG/../nt$pid$dep.log - set dosrc - echo -n "Do you want the source files? (y|n) [y]: " \ - | tee -a $WNG/../nt$pid$dep.log - set l0=($<) - echo "$l0" >>! $WNG/../nt$pid$dep.log - if ("$l0" =~ [nN]*) unset dosrc # skip sources - echo -n "Do you want the object libraries? (y|n) [n]: " \ - | tee -a $WNG/../nt$pid$dep.log - set l0=($<) - echo "$l0" >>! $WNG/../nt$pid$dep.log - if ("$l0" =~ [yY]*) set doolb # do olb - echo -n "Do you want the executables? (y|n) [n]: " \ - | tee -a $WNG/../nt$pid$dep.log - set l0=($<) - echo "$l0" >>! $WNG/../nt$pid$dep.log - if ("$l0" =~ [yY]*) set doexe # do exe -# -# Do sources -# -DSRC: - cd $WNG/.. # base directory - if ($?dosrc) then - echo "Creating Newstar_src_unix_$ldat" \ - | tee -a $WNG/../nt$pid$dep.log - foreach i ($blddir) # get sources - if ("$i" == "wng") then - 'mv' ./$i/readme.txt README >& /dev/null - 'mv' ./$i/quest.txt QUEST >& /dev/null - tar cvf Newstar_src_unix_$ldat README QUEST \ - >>&! $WNG/../nt$pid$dep.log - endif - tar rvf Newstar_src_unix_$ldat ./$i/*.sun ./$i/*.tlb \ - ./$i/*.com ./$i/*.txt ./$i/*.hlp \ - >>&! $WNG/../nt$pid$dep.log - end - 'rm' Newstar_src_unix_$ldat.Z >& /dev/null # make sure - compress Newstar_src_unix_$ldat >>&! $WNG/../nt$pid$dep.log - endif -# -# Write Object libraries -# -DOLB: - cd $WNG_OLB # base directory - if ($?doolb) then - echo "Creating Newstar_olb_${WNG_TYPE}_$ldat" \ - | tee -a $WNG/../nt$pid$dep.log - foreach i ($blddir) # get sources - if ("$i" == "wng") then - tar cvf $WNG/../Newstar_olb_${WNG_TYPE}_$ldat ./$i/*.olb ./$i/*.exe \ - >>&! $WNG/../nt$pid$dep.log - else - tar rvf $WNG/../Newstar_olb_${WNG_TYPE}_$ldat ./$i/*.olb \ - >>&! $WNG/../nt$pid$dep.log - endif - end - 'rm' $WNG/../Newstar_olb_${WNG_TYPE}_$ldat.Z >& /dev/null # make sure - compress $WNG/../Newstar_olb_${WNG_TYPE}_$ldat \ - >>&! $WNG/../nt$pid$dep.log - endif -# -# Write executables -# -DEXE: - cd $EXEDWARF_UNIX # base directory - if ($?doexe) then - echo "Creating Newstar_exe_${WNG_TYPE}_$ldat" \ - | tee -a $WNG/../nt$pid$dep.log - tar cvf $WNG/../Newstar_exe_${WNG_TYPE}_$ldat ./*.exe ./*.ppd \ - >>&! $WNG/../nt$pid$dep.log - 'rm' $WNG/../Newstar_exe_${WNG_TYPE}_$ldat.Z >& /dev/null # make sure - compress $WNG/../Newstar_exe_${WNG_TYPE}_$ldat \ - >>&! $WNG/../nt$pid$dep.log - endif -# -# Cleanup -# -CLUP: -# -# Ready -# -END: - echo " " \ - | tee -a $WNG/../nt$pid$dep.log - echo "Copy the produced .Z files by ftp (binary) to" \ - | tee -a $WNG/../nt$pid$dep.log - echo "rzmvx4.astron.nl user5:[wnb.wng]" \ - | tee -a $WNG/../nt$pid$dep.log - echo "The produced Z files can be after uncompress and" \ - | tee -a $WNG/../nt$pid$dep.log - echo "tar -xvf in the directories" \ - | tee -a $WNG/../nt$pid$dep.log - echo '$WNG/.. for src, $WNG_OLBEXE for olb and $EXEDWARF_UNIX for exe' \ - | tee -a $WNG/../nt$pid$dep.log - echo "be used in building the Newstar system by running" \ - | tee -a $WNG/../nt$pid$dep.log - echo '$WNG/nbuild.sun' \ - | tee -a $WNG/../nt$pid$dep.log - echo " " \ - | tee -a $WNG/../nt$pid$dep.log -# -# EXIT -# -exex: - exit diff --git a/src/wng/nupd.com b/src/wng/nupd.com deleted file mode 100755 index bfa18f4bf4e6b4eb3bef568e6c2fd7162c4a5d71..0000000000000000000000000000000000000000 --- a/src/wng/nupd.com +++ /dev/null @@ -1,273 +0,0 @@ -$!# nupd.ssc -$!# WNB 921117 -$!# -$!# Revisions: -$!# WNB 921224 Make SSC -$!# WNB 930303 Add NSTAR_DIR -$!# WNB 930305 Make sure aliases -$!# WNB 930514 Correct alias read -$!# WNB 930725 Typo (continuation - in VAX) -$!# WNB 930731 Typo (' missed - VAX) -$!# WNB 930803 Add local mode -$!# WNB 930818 Typo -$!# WNB 930901 Remove logging from Unix: .dsc give segmentation -$!# faults: too many files open? -$!# WNB 930921 Typo -$!# WNB 931124 Remove logging for password -$!# WNB 940124 Leave _TLB -$!# -$!# Update Newstar system across network -$!# -$!# Uses environment variables: -$!# WNG where to find wng-type sources -$!# WNG_TYPE machine (sw, dw, hp, al, cv etc) -$!# WNG_OLBEXE root of wng-type .olb, .ppd, .exe -$!# WNG_SITE site (nfra, atnf, rug ...) -$!# EXEDWARF_UNIX where to find/set DWARF .exe, .ppd -$!# LIBDWARF where to find DWARF .olb -$!# NSTAR_DIR N directories -$!# and also possible: -$!# WNG_NODE, WNG_NODEDIR, WNG_NODEUSER -$!# WNG_EXE, WNG_OLB, WNG_TLB, WNG_ERR, WNG_LIS, WNG_LINK -$!# -$!# Intro -$!# -$ SET NOON !DISCARD ERRORS -$ ON CONTROL_Y THEN GOTO EXEX !FINISH NEATLY -$ VER=F$VERIFY() !FOR ^Y -$ PID=F$EXTRACT(4,4,F$GETJPI("","PID")) !FOR TMP FILES -$ DEP=1 !FOR INDIRECT -$ LOCAL=0 !FOR LOCAL USE -$ TELL="WRITE SYS$OUTPUT" !FOR EASE OF USE -$ TLOG="WRITE LOG''PID'''DEP'" -$ ! -$ ASSIGN="ASSIGN" !MAKE SURE PROPER USE -$ COPY="COPY" -$ DELETE="DELETE" -$ DIR="DIRECTORY" -$ PURGE="PURGE" -$ SET="SET" -$ SHOW="SHOW" -$ TELL " " -$ TELL "Updating Newstar system." -$ TELL " " -$ TELL "A log will be made in WNG_DIR:[WNG.-]NU''PID'''DEP'.LOG" -$ TELL "There should be about 20 Mbytes available," -$ TELL "and it will probably take up to an hour." -$ TELL " " -$!# -$!# Check environment -$!# -$ IF F$TRNLNM("WNG") .EQS. "" .OR. F$TRNLNM("WNG_OLBEXE") .EQS. "" - - .OR. F$TRNLNM("WNG_DIR") .EQS. "" - - .OR. "''WNG_TYPE'" .EQS. "" .OR. "''WNG_SITE'" .EQS. "" - - .OR. "''NSTAR_DIR'" .EQS. "" -$ THEN -$ TELL " Error: Must have logicals WNG, WNG_OLBEXE, WNG_DIR and globals" -$ TELL " WNG_TYPE, WNG_SITE, NSTAR_DIR defined" -$ TELL " You probably have not included the proper" -$ TELL " files in LOGIN.COM" -$ GOTO EXEX -$ ENDIF -$ IF F$TRNLNM("EXEDWARF") .EQS. "" .OR. - - F$TRNLNM("LIBDWARF") .EQS. "" .OR. - - F$TRNLNM("RUNDWARF") .EQS. "" -$ THEN -$ TELL " Error: Cannot do everything with EXEDWARF and/or" -$ TELL " LIBDWARF and/or RUNDWARF not defined" -$ TELL " You probably have not included the proper" -$ TELL " files in LOGIN.COM" -$ GOTO EXEX -$ ENDIF -$ IF "''NXEC'" .EQS. "" -$ THEN -$ TELL " Error: You have no symbol for NXEC etc." -$ TELL " You probably have not included the proper" -$ TELL " files in LOGIN.COM" -$ GOTO EXEX -$ ENDIF -$ IF "''WNG_EXE'" .EQS. "" THEN - - WNG_EXE=F$TRNLNM("WNG_OLBEXE") -$ IF "''WNG_OLB'" .EQS. "" THEN - - WNG_OLB=F$TRNLNM("WNG_OLBEXE") -$ WNG_TLB="" ! MAKE SURE -$ WNG_ERR="" -$ WNG_LIS="" -$ WNG_LINK="" -$ BLDDIR="''NSTAR_DIR'" ! Newstar directories -$ L0=0 ! MAKE DIRECTORIES -$ LP1: L1=F$ELEMENT(L0,",",BLDDIR) -$ IF L1 .NES. "," -$ THEN -$ IF F$PARSE("''WNG_EXE':[''L1']") .EQS. "" THEN - ! MAKE DIRECTORIES - CREATE/DIR 'WNG_EXE':['L1'] -$ IF F$PARSE("''WNG_OLB':[''L1']") .EQS. "" THEN - - CREATE/DIR 'WNG_OLB':['L1'] -$ L0=L0+1 -$ GOTO LP1 -$ ENDIF -$ WNG_NODE="rzmvx4.astron.nl" ! NODE INFO -$ WNG_NODEDIR="user5:[wnb]" -$ WNG_NODEUSER="printvax printvax_90a" -$!# -$!# Get questions -$!# -$ OPEN/WRITE/ERROR=EXEX LOG'PID''DEP' WNG_DIR:[WNG.-]NU'PID''DEP'.LOG ! START LOG -$ TLOG "NU''PID'''DEP'.LOG" -$ TELL "Running NUPD.COM at ''WNG_SITE'(''WNG_TYPE')" -$ TLOG "Running NUPD.COM at ''WNG_SITE'(''WNG_TYPE')" -$ TELL "on ''F$GETSYI("NODENAME")' at ''F$TIME()'" -$ TLOG "on ''F$GETSYI("NODENAME")' at ''F$TIME()'" -$ TELL " " -$ TLOG " " -$ READ/TIME=90/END=EXEX/ERROR=EXEX - - /PROMPT="Remote update node (*=local)[''WNG_NODE']: " - - SYS$COMMAND L0 -$ TLOG "Remote update node (*=local)[''WNG_NODE']: ''L0'" -$ IF "''L0'" .EQS. "*" -$ THEN -$ LOCAL=1 -$ GOTO VERS -$ ENDIF -$ IF "''L0'" .NES. "" THEN WNG_NODE="''L0'" -$ L1="''F$ELEMENT(0," ",WNG_NODEUSER)'" -$ L2="''F$ELEMENT(1," ",WNG_NODEUSER)'" -$ READ/TIME=90/END=EXEX/ERROR=EXEX - - /PROMPT="Remote update user [''L1']: " SYS$COMMAND L0 -$ TLOG "Remote update user [''L1']: ''L0'" -$ SET TERM/NOECHO -$ IF "''L0'" .NES. "" THEN L1="''L0'" -$ READ/TIME=90/END=EXEX/ERROR=EXEX - - /PROMPT="Remote password [''L2']: " SYS$COMMAND L0 -$ SET TERM/ECHO -$ TELL " " -$ TLOG "Remote password [''L2']: " -$ IF "''L0'" .NES. "" THEN L2="''L0'" -$ WNG_NODEUSER="''L1' ''L2'" -$ READ/TIME=90/END=EXEX/ERROR=EXEX - - /PROMPT="Remote directory [''WNG_NODEDIR']: " SYS$COMMAND L0 -$ TLOG "Remote directory [''WNG_NODEDIR']: ''L0'" -$ IF "''L0'" .NES. "" THEN WNG_NODEDIR="''L0'" -$ VERS: -$ READ/TIME=90/END=EXEX/ERROR=EXEX - - /PROMPT="Remote update version (YYMMDD) []: " SYS$COMMAND L0 -$ TLOG "Remote update version (YYMMDD) []: ''L0'" -$ IF "''L0'" .EQS. "" THEN GOTO EXEX ! STOP -$ DOVERS="''L0'" -$!# -$!# Get update info -$!# -$ GINFO: -$ SET DEF WNG ! BASE DIRECTORY -$ IF LOCAL.EQ.1 THEN GOTO COMP -$ TELL "Getting update information ..." -$ TLOG "Getting update information ..." -$ ASSIGN/NOLOG LOG'PID''DEP' SYS$OUTPUT -$ ASSIGN/NOLOG LOG'PID''DEP' SYS$ERROR -$ L0=0 ! MAKE DIRECTORIES -$ LP2: L1=F$ELEMENT(L0,",",BLDDIR) -$ IF L1 .NES. "," -$ THEN -$ SET DEF WNG_DIR:['L1'] -$ NNET -NZ 'L1''DOVERS'.GRP -$ L0=L0+1 -$ GOTO LP2 -$ ENDIF -$ DEASSIGN SYS$OUTPUT -$ DEASSIGN SYS$ERROR -$!# -$!# Get updated files -$!# -$ GFIL: -$ SET DEF WNG ! BASE DIRECTORY -$ TELL "Getting update files ..." -$ TLOG "Getting update files ..." -$ ASSIGN/NOLOG LOG'PID''DEP' SYS$OUTPUT -$ ASSIGN/NOLOG LOG'PID''DEP' SYS$ERROR -$ L0=0 ! MAKE DIRECTORIES -$ LP3: L1=F$ELEMENT(L0,",",BLDDIR) -$ IF L1 .NES. "," -$ THEN -$ SET DEF WNG_DIR:['L1'] -$ IF F$SEARCH("''L1'''DOVERS'.GRP") .NES. " -$ THEN -$ NNET 'L1''DOVERS'.GRP -$ ENDIF -$ L0=L0+1 -$ GOTO LP3 -$ ENDIF -$ DEASSIGN SYS$OUTPUT -$ DEASSIGN SYS$ERROR -$!# -$!# Compile files -$!# -$ COMP: -$ SET DEF WNG ! BASE DIRECTORY -$ TELL "Compiling updated files ..." -$ TLOG "Compiling updated files ..." -$ ASSIGN/NOLOG LOG'PID''DEP' SYS$OUTPUT -$ ASSIGN/NOLOG LOG'PID''DEP' SYS$ERROR -$ L0=0 -$ LP4: L1=F$ELEMENT(L0,",",BLDDIR) -$ IF L1 .NES. "," -$ THEN -$ SET DEF WNG_DIR:['L1'] -$ IF F$SEARCH("''L1'''DOVERS'.GRP") .NES. "" -$ THEN -$ NCOMP -U 'L1''DOVERS'.GRP -$ ENDIF -$ L0=L0+1 -$ GOTO LP4 -$ ENDIF -$ DEASSIGN SYS$OUTPUT -$ DEASSIGN SYS$ERROR -$!# -$!# Link -$!# -$ LINK: -$ SET DEF WNG ! BASE DIRECTORY -$ TELL "Linking updated programs ..." -$ TLOG "Linking updated programs ..." -$ ASSIGN/NOLOG LOG'PID''DEP' SYS$OUTPUT -$ ASSIGN/NOLOG LOG'PID''DEP' SYS$ERROR -$ L0=0 -$ LP5: L1=F$ELEMENT(L0,",",BLDDIR) -$ IF L1 .NES. "," -$ THEN -$ SET DEF WNG_DIR:['L1'] -$ IF F$SEARCH("''L1'''DOVERS'.GRP") .NES. "" -$ THEN -$ NLINK -U 'L1''DOVERS'.GRP -$ ENDIF -$ L0=L0+1 -$ GOTO LP5 -$ ENDIF -$ DEASSIGN SYS$OUTPUT -$ DEASSIGN SYS$ERROR -$!# -$!# Cleanup -$!# -$ CLUP: -$!# -$!# Ready -$!# -$ END: -$ TELL " " -$ TLOG " " -$ TELL "Newstar updated for version ''DOVERS'" -$ TLOG "Newstar updated for version ''DOVERS'" -$ TELL "Check log for errors" -$ TLOG "Check log for errors" -$ TELL " " -$ TLOG " " -$!# -$!# EXIT -$!# -$ EXEX: SET ON -$ SET TERM/ECHO -$ DEASSIGN SYS$OUTPUT -$ CLOSE/ERROR=EXX1 LOG'PID''DEP' !MAKE SURE -$ EXX1: -$ SET DEF WNG_DIR:[WNG] !BACK TO NORMAL -$ L0=F$VERIFY(VER) !RESET VERIFY -$ EXIT diff --git a/src/wng/nupd.ssc b/src/wng/nupd.ssc deleted file mode 100644 index 17cd4ac30e659fccc12668e46717b63e8f2547f6..0000000000000000000000000000000000000000 --- a/src/wng/nupd.ssc +++ /dev/null @@ -1,447 +0,0 @@ -# nupd.ssc -# WNB 921117 -# -# Revisions: -# WNB 921224 Make SSC -# WNB 930303 Add NSTAR_DIR -# WNB 930305 Make sure aliases -# WNB 930514 Correct alias read -# WNB 930725 Typo (continuation - in VAX) -# WNB 930731 Typo (' missed - VAX) -# WNB 930803 Add local mode -# WNB 930818 Typo -# WNB 930901 Remove logging from Unix: .dsc give segmentation -# faults: too many files open? -# WNB 930921 Typo -# WNB 931124 Remove logging for password -# WNB 940124 Leave _TLB -# -# Update Newstar system across network -# -# Uses environment variables: -# WNG where to find wng-type sources -# WNG_TYPE machine (sw, dw, hp, al, cv etc) -# WNG_OLBEXE root of wng-type .olb, .ppd, .exe -# WNG_SITE site (nfra, atnf, rug ...) -# EXEDWARF_UNIX where to find/set DWARF .exe, .ppd -# LIBDWARF where to find DWARF .olb -# NSTAR_DIR N directories -# and also possible: -# WNG_NODE, WNG_NODEDIR, WNG_NODEUSER -# WNG_EXE, WNG_OLB, WNG_TLB, WNG_ERR, WNG_LIS, WNG_LINK -# -# Intro -# -#ifdef wn_vax__ -$ SET NOON !DISCARD ERRORS -$ ON CONTROL_Y THEN GOTO EXEX !FINISH NEATLY -$ VER=F$VERIFY() !FOR ^Y -$ PID=F$EXTRACT(4,4,F$GETJPI("","PID")) !FOR TMP FILES -$ DEP=1 !FOR INDIRECT -$ LOCAL=0 !FOR LOCAL USE -$ TELL="WRITE SYS$OUTPUT" !FOR EASE OF USE -$ TLOG="WRITE LOG''PID'''DEP'" -$ ! -$ ASSIGN="ASSIGN" !MAKE SURE PROPER USE -$ COPY="COPY" -$ DELETE="DELETE" -$ DIR="DIRECTORY" -$ PURGE="PURGE" -$ SET="SET" -$ SHOW="SHOW" -$ TELL " " -$ TELL "Updating Newstar system." -$ TELL " " -$ TELL "A log will be made in WNG_DIR:[WNG.-]NU''PID'''DEP'.LOG" -$ TELL "There should be about 20 Mbytes available," -$ TELL "and it will probably take up to an hour." -$ TELL " " -#else - onintr exex # finish neatly - if ($?echo) unset echo # no verify - if ($?verbose) unset verbose # no verbose - set pid=$$ ; @ dep=1 # for tmp files - set local=0 # for local use - echo " " - echo "Updating Newstar system." - echo " " -# echo 'A log will be made in $WNG'"/../nu$pid$dep.log" - echo "There should be about 20 Mbytes available," - echo "and it will probably take up to an hour." - echo " " -#endif -# -# Check environment -# -#ifdef wn_vax__ -$ IF F$TRNLNM("WNG") .EQS. "" .OR. F$TRNLNM("WNG_OLBEXE") .EQS. "" - - .OR. F$TRNLNM("WNG_DIR") .EQS. "" - - .OR. "''WNG_TYPE'" .EQS. "" .OR. "''WNG_SITE'" .EQS. "" - - .OR. "''NSTAR_DIR'" .EQS. "" -$ THEN -$ TELL " Error: Must have logicals WNG, WNG_OLBEXE, WNG_DIR and globals" -$ TELL " WNG_TYPE, WNG_SITE, NSTAR_DIR defined" -$ TELL " You probably have not included the proper" -$ TELL " files in LOGIN.COM" -$ GOTO EXEX -$ ENDIF -$ IF F$TRNLNM("EXEDWARF") .EQS. "" .OR. - - F$TRNLNM("LIBDWARF") .EQS. "" .OR. - - F$TRNLNM("RUNDWARF") .EQS. "" -$ THEN -$ TELL " Error: Cannot do everything with EXEDWARF and/or" -$ TELL " LIBDWARF and/or RUNDWARF not defined" -$ TELL " You probably have not included the proper" -$ TELL " files in LOGIN.COM" -$ GOTO EXEX -$ ENDIF -$ IF "''NXEC'" .EQS. "" -$ THEN -$ TELL " Error: You have no symbol for NXEC etc." -$ TELL " You probably have not included the proper" -$ TELL " files in LOGIN.COM" -$ GOTO EXEX -$ ENDIF -$ IF "''WNG_EXE'" .EQS. "" THEN - - WNG_EXE=F$TRNLNM("WNG_OLBEXE") -$ IF "''WNG_OLB'" .EQS. "" THEN - - WNG_OLB=F$TRNLNM("WNG_OLBEXE") -$ WNG_TLB="" ! MAKE SURE -$ WNG_ERR="" -$ WNG_LIS="" -$ WNG_LINK="" -$ BLDDIR="''NSTAR_DIR'" ! Newstar directories -$ L0=0 ! MAKE DIRECTORIES -$ LP1: L1=F$ELEMENT(L0,",",BLDDIR) -$ IF L1 .NES. "," -$ THEN -$ IF F$PARSE("''WNG_EXE':[''L1']") .EQS. "" THEN - ! MAKE DIRECTORIES - CREATE/DIR 'WNG_EXE':['L1'] -$ IF F$PARSE("''WNG_OLB':[''L1']") .EQS. "" THEN - - CREATE/DIR 'WNG_OLB':['L1'] -$ L0=L0+1 -$ GOTO LP1 -$ ENDIF -$ WNG_NODE="rzmvx4.astron.nl" ! NODE INFO -$ WNG_NODEDIR="user5:[wnb]" -$ WNG_NODEUSER="printvax printvax_90a" -#else - if (! $?WNG || ! $?WNG_TYPE || ! $?WNG_OLBEXE ||\ - ! $?WNG_SITE || ! $?NSTAR_DIR) then - echo " Error: Must have environment variables" - echo " WNG, WNG_TYPE, WNG_OLBEXE , WNG_SITE, NSTAR_DIR defined" - echo " You probably have not included the proper" - echo " files in .cshrc" - goto exex - endif - if (! $?EXEDWARF_UNIX || ! $?LIBDWARF) then - echo " Error: Cannot do everything with EXEDWARF_UNIX and/or" - echo " LIBDWARF not defined" - echo " You probably have not included the proper" - echo " files in .cshrc" - goto exex - endif - source $WNG/wngcshrc.sun # get aliases - if ("`alias nxec`" == "") then - echo " Error: You have no alias for nxec etc." - echo " You probably have not included the proper" - echo " files in .cshrc" - goto exex - endif -# -# Creating environment -# - cd $WNG - if (! $?WNG_EXE) setenv WNG_EXE $WNG_OLBEXE # make names - if (! $?WNG_OLB) setenv WNG_OLB $WNG_OLBEXE - set blddir=($NSTAR_DIR) # Newstar directories - foreach i ($blddir) - if (! -d $WNG_EXE/$i) mkdir $WNG_EXE/$i # make directories - if (! -d $WNG_OLB/$i) mkdir $WNG_OLB/$i - end -## if ($?WNG_TLB) unsetenv WNG_TLB # make sure - if ($?WNG_ERR) unsetenv WNG_ERR - if ($?WNG_LIS) unsetenv WNG_LIS - if ($?WNG_LINK) unsetenv WNG_LINK - setenv WNG_NODE "rzmvx4.astron.nl" # node info - setenv WNG_NODEDIR "user5:[wnb]" - setenv WNG_NODEUSER "printvax printvax_90a" -#endif -# -# Get questions -# -#ifdef wn_vax__ -$ OPEN/WRITE/ERROR=EXEX LOG'PID''DEP' WNG_DIR:[WNG.-]NU'PID''DEP'.LOG ! START LOG -$ TLOG "NU''PID'''DEP'.LOG" -$ TELL "Running NUPD.COM at ''WNG_SITE'(''WNG_TYPE')" -$ TLOG "Running NUPD.COM at ''WNG_SITE'(''WNG_TYPE')" -$ TELL "on ''F$GETSYI("NODENAME")' at ''F$TIME()'" -$ TLOG "on ''F$GETSYI("NODENAME")' at ''F$TIME()'" -$ TELL " " -$ TLOG " " -$ READ/TIME=90/END=EXEX/ERROR=EXEX - - /PROMPT="Remote update node (*=local)[''WNG_NODE']: " - - SYS$COMMAND L0 -$ TLOG "Remote update node (*=local)[''WNG_NODE']: ''L0'" -$ IF "''L0'" .EQS. "*" -$ THEN -$ LOCAL=1 -$ GOTO VERS -$ ENDIF -$ IF "''L0'" .NES. "" THEN WNG_NODE="''L0'" -$ L1="''F$ELEMENT(0," ",WNG_NODEUSER)'" -$ L2="''F$ELEMENT(1," ",WNG_NODEUSER)'" -$ READ/TIME=90/END=EXEX/ERROR=EXEX - - /PROMPT="Remote update user [''L1']: " SYS$COMMAND L0 -$ TLOG "Remote update user [''L1']: ''L0'" -$ SET TERM/NOECHO -$ IF "''L0'" .NES. "" THEN L1="''L0'" -$ READ/TIME=90/END=EXEX/ERROR=EXEX - - /PROMPT="Remote password [''L2']: " SYS$COMMAND L0 -$ SET TERM/ECHO -$ TELL " " -$ TLOG "Remote password [''L2']: " -$ IF "''L0'" .NES. "" THEN L2="''L0'" -$ WNG_NODEUSER="''L1' ''L2'" -$ READ/TIME=90/END=EXEX/ERROR=EXEX - - /PROMPT="Remote directory [''WNG_NODEDIR']: " SYS$COMMAND L0 -$ TLOG "Remote directory [''WNG_NODEDIR']: ''L0'" -$ IF "''L0'" .NES. "" THEN WNG_NODEDIR="''L0'" -$ VERS: -$ READ/TIME=90/END=EXEX/ERROR=EXEX - - /PROMPT="Remote update version (YYMMDD) []: " SYS$COMMAND L0 -$ TLOG "Remote update version (YYMMDD) []: ''L0'" -$ IF "''L0'" .EQS. "" THEN GOTO EXEX ! STOP -$ DOVERS="''L0'" -#else -# echo "nu$pid$dep.log" >>! $WNG/../nu$pid$dep.log # start log - echo "Running NUPD.SUN at $WNG_SITE($WNG_TYPE)" \ -# | tee -a $WNG/../nu$pid$dep.log - echo "on `hostname` at `date`" #| tee -a $WNG/../nu$pid$dep.log - echo " " #| tee -a $WNG/../nu$pid$dep.log - echo -n "Remote update node (*=local)[$WNG_NODE]: " \ -# | tee -a $WNG/../nu$pid$dep.log - set l0=($<) - if ("$l0" == "*") then - set local=1 - goto VERS - endif - if ("$l0" != "") setenv WNG_NODE "$l0" -# echo "$WNG_NODE" >>! $WNG/../nu$pid$dep.log - set l1=($WNG_NODEUSER) - echo -n "Remote update user [$l1[1]]: " \ -# | tee -a $WNG/../nu$pid$dep.log - set l0=($<) - if ("$l0" != "") then - setenv WNG_NODEUSER "$l0" - else - setenv WNG_NODEUSER "$l1[1]" - endif -# echo "$WNG_NODEUSER" >>! $WNG/../nu$pid$dep.log - echo -n "Remote password [$l1[2]]: " \ -# | tee -a $WNG/../nu$pid$dep.log - stty -echo; set l0="$<"; stty echo; echo " " - if ("$l0" != "") set l1[2]="$l0" - setenv WNG_NODEUSER "$WNG_NODEUSER $l1[2]" - echo " " #| tee -a $WNG/../nu$pid$dep.log - echo -n "Remote directory [$WNG_NODEDIR]: " \ -# | tee -a $WNG/../nu$pid$dep.log - set l0=($<) - if ("$l0" != "") setenv WNG_NODEDIR "$l0" -# echo "$WNG_NODEDIR" >>! $WNG/../nu$pid$dep.log -VERS: - echo -n "Remote update version? (yymmdd) []: " \ -# | tee -a $WNG/../nu$pid$dep.log - set dovers=($<) - if ("$dovers" == "") goto exex # assume end -# echo "$dovers" >>! $WNG/../nu$pid$dep.log -#endif -# -# Get update info -# -#ifdef wn_vax__ -$ GINFO: -$ SET DEF WNG ! BASE DIRECTORY -$ IF LOCAL.EQ.1 THEN GOTO COMP -$ TELL "Getting update information ..." -$ TLOG "Getting update information ..." -$ ASSIGN/NOLOG LOG'PID''DEP' SYS$OUTPUT -$ ASSIGN/NOLOG LOG'PID''DEP' SYS$ERROR -$ L0=0 ! MAKE DIRECTORIES -$ LP2: L1=F$ELEMENT(L0,",",BLDDIR) -$ IF L1 .NES. "," -$ THEN -$ SET DEF WNG_DIR:['L1'] -$ NNET -NZ 'L1''DOVERS'.GRP -$ L0=L0+1 -$ GOTO LP2 -$ ENDIF -$ DEASSIGN SYS$OUTPUT -$ DEASSIGN SYS$ERROR -#else -GINFO: - cd $WNG # base directory - if ($local == 1) goto COMP - echo "Getting update information ..." \ -# | tee -a $WNG/../nu$pid$dep.log - foreach i ($blddir) - cd ../$i - nnet -nz $i$dovers.grp #>>&! $WNG/../nu$pid$dep.log - end -#endif -# -# Get updated files -# -#ifdef wn_vax__ -$ GFIL: -$ SET DEF WNG ! BASE DIRECTORY -$ TELL "Getting update files ..." -$ TLOG "Getting update files ..." -$ ASSIGN/NOLOG LOG'PID''DEP' SYS$OUTPUT -$ ASSIGN/NOLOG LOG'PID''DEP' SYS$ERROR -$ L0=0 ! MAKE DIRECTORIES -$ LP3: L1=F$ELEMENT(L0,",",BLDDIR) -$ IF L1 .NES. "," -$ THEN -$ SET DEF WNG_DIR:['L1'] -$ IF F$SEARCH("''L1'''DOVERS'.GRP") .NES. " -$ THEN -$ NNET 'L1''DOVERS'.GRP -$ ENDIF -$ L0=L0+1 -$ GOTO LP3 -$ ENDIF -$ DEASSIGN SYS$OUTPUT -$ DEASSIGN SYS$ERROR -#else -GFIL: - cd $WNG # base directory - echo "Getting updated files ..." \ -# | tee -a $WNG/../nu$pid$dep.log - foreach i ($blddir) - cd ../$i - if (-e $i$dovers.grp) then - nnet $i$dovers.grp #>>&! $WNG/../nu$pid$dep.log - endif - end -#endif -# -# Compile files -# -#ifdef wn_vax__ -$ COMP: -$ SET DEF WNG ! BASE DIRECTORY -$ TELL "Compiling updated files ..." -$ TLOG "Compiling updated files ..." -$ ASSIGN/NOLOG LOG'PID''DEP' SYS$OUTPUT -$ ASSIGN/NOLOG LOG'PID''DEP' SYS$ERROR -$ L0=0 -$ LP4: L1=F$ELEMENT(L0,",",BLDDIR) -$ IF L1 .NES. "," -$ THEN -$ SET DEF WNG_DIR:['L1'] -$ IF F$SEARCH("''L1'''DOVERS'.GRP") .NES. "" -$ THEN -$ NCOMP -U 'L1''DOVERS'.GRP -$ ENDIF -$ L0=L0+1 -$ GOTO LP4 -$ ENDIF -$ DEASSIGN SYS$OUTPUT -$ DEASSIGN SYS$ERROR -#else -COMP: - cd $WNG # base directory - echo "Compiling updated files ..." \ -# | tee -a $WNG/../nu$pid$dep.log - foreach i ($blddir) - cd ../$i - if (-e $i$dovers.grp) then - ncomp -u $i$dovers.grp #>>&! $WNG/../nu$pid$dep.log - endif - end -#endif -# -# Link -# -#ifdef wn_vax__ -$ LINK: -$ SET DEF WNG ! BASE DIRECTORY -$ TELL "Linking updated programs ..." -$ TLOG "Linking updated programs ..." -$ ASSIGN/NOLOG LOG'PID''DEP' SYS$OUTPUT -$ ASSIGN/NOLOG LOG'PID''DEP' SYS$ERROR -$ L0=0 -$ LP5: L1=F$ELEMENT(L0,",",BLDDIR) -$ IF L1 .NES. "," -$ THEN -$ SET DEF WNG_DIR:['L1'] -$ IF F$SEARCH("''L1'''DOVERS'.GRP") .NES. "" -$ THEN -$ NLINK -U 'L1''DOVERS'.GRP -$ ENDIF -$ L0=L0+1 -$ GOTO LP5 -$ ENDIF -$ DEASSIGN SYS$OUTPUT -$ DEASSIGN SYS$ERROR -#else -LINK: - cd $WNG # base directory - echo "Linking updated programs ..." \ -# | tee -a $WNG/../nu$pid$dep.log - foreach i ($blddir) - cd ../$i - if (-e $i$dovers.grp) then - nlink -u $i$dovers.grp #>>&! $WNG/../nu$pid$dep.log - endif - end -#endif -# -# Cleanup -# -#ifdef wn_vax__ -$ CLUP: -#else -CLUP: -#endif -# -# Ready -# -#ifdef wn_vax__ -$ END: -$ TELL " " -$ TLOG " " -$ TELL "Newstar updated for version ''DOVERS'" -$ TLOG "Newstar updated for version ''DOVERS'" -$ TELL "Check log for errors" -$ TLOG "Check log for errors" -$ TELL " " -$ TLOG " " -#else -END: - echo " " \ -# | tee -a $WNG/../nu$pid$dep.log - echo "Newstar updated for version $dovers" \ -# | tee -a $WNG/../nu$pid$dep.log -# echo "Check log for errors" \ -# | tee -a $WNG/../nu$pid$dep.log - echo " " \ -# | tee -a $WNG/../nu$pid$dep.log -#endif -# -# EXIT -# -#ifdef wn_vax__ -$ EXEX: SET ON -$ SET TERM/ECHO -$ DEASSIGN SYS$OUTPUT -$ CLOSE/ERROR=EXX1 LOG'PID''DEP' !MAKE SURE -$ EXX1: -$ SET DEF WNG_DIR:[WNG] !BACK TO NORMAL -$ L0=F$VERIFY(VER) !RESET VERIFY -$ EXIT -#else -exex: - exit -#endif diff --git a/src/wng/nupd.sun b/src/wng/nupd.sun deleted file mode 100755 index 42c8e791d5f53a633b1168a511cd2e3e492ca020..0000000000000000000000000000000000000000 --- a/src/wng/nupd.sun +++ /dev/null @@ -1,205 +0,0 @@ -# nupd.ssc -# WNB 921117 -# -# Revisions: -# WNB 921224 Make SSC -# WNB 930303 Add NSTAR_DIR -# WNB 930305 Make sure aliases -# WNB 930514 Correct alias read -# WNB 930725 Typo (continuation - in VAX) -# WNB 930731 Typo (' missed - VAX) -# WNB 930803 Add local mode -# WNB 930818 Typo -# WNB 930901 Remove logging from Unix: .dsc give segmentation -# faults: too many files open? -# WNB 930921 Typo -# WNB 931124 Remove logging for password -# WNB 940124 Leave _TLB -# -# Update Newstar system across network -# -# Uses environment variables: -# WNG where to find wng-type sources -# WNG_TYPE machine (sw, dw, hp, al, cv etc) -# WNG_OLBEXE root of wng-type .olb, .ppd, .exe -# WNG_SITE site (nfra, atnf, rug ...) -# EXEDWARF_UNIX where to find/set DWARF .exe, .ppd -# LIBDWARF where to find DWARF .olb -# NSTAR_DIR N directories -# and also possible: -# WNG_NODE, WNG_NODEDIR, WNG_NODEUSER -# WNG_EXE, WNG_OLB, WNG_TLB, WNG_ERR, WNG_LIS, WNG_LINK -# -# Intro -# - onintr exex # finish neatly - if ($?echo) unset echo # no verify - if ($?verbose) unset verbose # no verbose - set pid=$$ ; @ dep=1 # for tmp files - set local=0 # for local use - echo " " - echo "Updating Newstar system." - echo " " -# echo 'A log will be made in $WNG'"/../nu$pid$dep.log" - echo "There should be about 20 Mbytes available," - echo "and it will probably take up to an hour." - echo " " -# -# Check environment -# - if (! $?WNG || ! $?WNG_TYPE || ! $?WNG_OLBEXE ||\ - ! $?WNG_SITE || ! $?NSTAR_DIR) then - echo " Error: Must have environment variables" - echo " WNG, WNG_TYPE, WNG_OLBEXE , WNG_SITE, NSTAR_DIR defined" - echo " You probably have not included the proper" - echo " files in .cshrc" - goto exex - endif - if (! $?EXEDWARF_UNIX || ! $?LIBDWARF) then - echo " Error: Cannot do everything with EXEDWARF_UNIX and/or" - echo " LIBDWARF not defined" - echo " You probably have not included the proper" - echo " files in .cshrc" - goto exex - endif - source $WNG/wngcshrc.sun # get aliases - if ("`alias nxec`" == "") then - echo " Error: You have no alias for nxec etc." - echo " You probably have not included the proper" - echo " files in .cshrc" - goto exex - endif -# -# Creating environment -# - cd $WNG - if (! $?WNG_EXE) setenv WNG_EXE $WNG_OLBEXE # make names - if (! $?WNG_OLB) setenv WNG_OLB $WNG_OLBEXE - set blddir=($NSTAR_DIR) # Newstar directories - foreach i ($blddir) - if (! -d $WNG_EXE/$i) mkdir $WNG_EXE/$i # make directories - if (! -d $WNG_OLB/$i) mkdir $WNG_OLB/$i - end -## if ($?WNG_TLB) unsetenv WNG_TLB # make sure - if ($?WNG_ERR) unsetenv WNG_ERR - if ($?WNG_LIS) unsetenv WNG_LIS - if ($?WNG_LINK) unsetenv WNG_LINK - setenv WNG_NODE "rzmvx4.astron.nl" # node info - setenv WNG_NODEDIR "user5:[wnb]" - setenv WNG_NODEUSER "printvax printvax_90a" -# -# Get questions -# -# echo "nu$pid$dep.log" >>! $WNG/../nu$pid$dep.log # start log - echo "Running NUPD.SUN at $WNG_SITE($WNG_TYPE)" \ -# | tee -a $WNG/../nu$pid$dep.log - echo "on `hostname` at `date`" #| tee -a $WNG/../nu$pid$dep.log - echo " " #| tee -a $WNG/../nu$pid$dep.log - echo -n "Remote update node (*=local)[$WNG_NODE]: " \ -# | tee -a $WNG/../nu$pid$dep.log - set l0=($<) - if ("$l0" == "*") then - set local=1 - goto VERS - endif - if ("$l0" != "") setenv WNG_NODE "$l0" -# echo "$WNG_NODE" >>! $WNG/../nu$pid$dep.log - set l1=($WNG_NODEUSER) - echo -n "Remote update user [$l1[1]]: " \ -# | tee -a $WNG/../nu$pid$dep.log - set l0=($<) - if ("$l0" != "") then - setenv WNG_NODEUSER "$l0" - else - setenv WNG_NODEUSER "$l1[1]" - endif -# echo "$WNG_NODEUSER" >>! $WNG/../nu$pid$dep.log - echo -n "Remote password [$l1[2]]: " \ -# | tee -a $WNG/../nu$pid$dep.log - stty -echo; set l0="$<"; stty echo; echo " " - if ("$l0" != "") set l1[2]="$l0" - setenv WNG_NODEUSER "$WNG_NODEUSER $l1[2]" - echo " " #| tee -a $WNG/../nu$pid$dep.log - echo -n "Remote directory [$WNG_NODEDIR]: " \ -# | tee -a $WNG/../nu$pid$dep.log - set l0=($<) - if ("$l0" != "") setenv WNG_NODEDIR "$l0" -# echo "$WNG_NODEDIR" >>! $WNG/../nu$pid$dep.log -VERS: - echo -n "Remote update version? (yymmdd) []: " \ -# | tee -a $WNG/../nu$pid$dep.log - set dovers=($<) - if ("$dovers" == "") goto exex # assume end -# echo "$dovers" >>! $WNG/../nu$pid$dep.log -# -# Get update info -# -GINFO: - cd $WNG # base directory - if ($local == 1) goto COMP - echo "Getting update information ..." \ -# | tee -a $WNG/../nu$pid$dep.log - foreach i ($blddir) - cd ../$i - nnet -nz $i$dovers.grp #>>&! $WNG/../nu$pid$dep.log - end -# -# Get updated files -# -GFIL: - cd $WNG # base directory - echo "Getting updated files ..." \ -# | tee -a $WNG/../nu$pid$dep.log - foreach i ($blddir) - cd ../$i - if (-e $i$dovers.grp) then - nnet $i$dovers.grp #>>&! $WNG/../nu$pid$dep.log - endif - end -# -# Compile files -# -COMP: - cd $WNG # base directory - echo "Compiling updated files ..." \ -# | tee -a $WNG/../nu$pid$dep.log - foreach i ($blddir) - cd ../$i - if (-e $i$dovers.grp) then - ncomp -u $i$dovers.grp #>>&! $WNG/../nu$pid$dep.log - endif - end -# -# Link -# -LINK: - cd $WNG # base directory - echo "Linking updated programs ..." \ -# | tee -a $WNG/../nu$pid$dep.log - foreach i ($blddir) - cd ../$i - if (-e $i$dovers.grp) then - nlink -u $i$dovers.grp #>>&! $WNG/../nu$pid$dep.log - endif - end -# -# Cleanup -# -CLUP: -# -# Ready -# -END: - echo " " \ -# | tee -a $WNG/../nu$pid$dep.log - echo "Newstar updated for version $dovers" \ -# | tee -a $WNG/../nu$pid$dep.log -# echo "Check log for errors" \ -# | tee -a $WNG/../nu$pid$dep.log - echo " " \ -# | tee -a $WNG/../nu$pid$dep.log -# -# EXIT -# -exex: - exit diff --git a/src/wng/nxanal.sun b/src/wng/nxanal.sun deleted file mode 100755 index 754207200abc163d098880015d4290fd5d114777..0000000000000000000000000000000000000000 --- a/src/wng/nxanal.sun +++ /dev/null @@ -1,109 +0,0 @@ -# nxanal.sun -# WNB 920908 -# -# Revisions: -# WNB 920930 Full overhaul for speed, some additions -# WNB 921130 Alliant scanning; HP tr -# WNB 930325 Cater for different fold -# -# Analyze codestring containing repetitions of one or more of: -# [-][N|+]*[d][<string>] -# Use as: -# source $WNG/nxanal.sun -# -# It assumes the code string to be in a0; selectable codes (N) in scodes; -# selectable qualifiers in squal; additive qualifiers in squala; -# extendable codes in scodex. -# It assumes for all qualifiers the variables *q_d are set. -# It returns new values for *q_d and encountered cd_* and *_d -# where * is a single character -# -# Analyze codes -# - set a0=(`echo $a0 | ${fold}1`) # expand input string -GC1A: - set l1=1 # no n seen -GC14: - if ($#a0 < 1) goto RETURN # check all - set lz=$a0[1] # isolate - if ("$lz" == "<") then - set return=GC1A ; goto GA0 # skip <> - endif - shift a0 # delete code - if ("$lz" == "-") goto GC1A # skip - - if ("$lz" =~ [nN] || "$lz" == "+") then # negate - set l1=0 ; goto GC14 # n/+ seen; next part - endif - if ("$lz" =~ [qQ] && $l1) then # qualifier - if ($#a0 < 1) goto RETURN # ready - if ("$a0[1]" =~ [A-Z]) then - set lz=`echo $a0[1] | tr $Upc $Lowc` # qualifier - else - set lz=$a0[1] - endif - shift a0 # delete qualifier - if ("$lz" !~ [$squal]) goto GC1A # unknown qual. - set return=GC10A ; goto GA0 # get qual. argument -GC10A: - if ("$lz" !~ [$squala]) then # not additive - if ($a1 != "") set ${lz}q_d=$a1 # and value - else # additive - if ($a1 != "") then # and value - set l3=\$${lz}q_d - set ${lz}q_d=(`eval echo $l3` $a1) - endif - endif - goto GC1A # next code - endif - if ("$lz" =~ [A-Z]) then - set lz=`echo $lz | tr $Upc $Lowc` # code - endif - if ("$lz" !~ [$scodes]) goto GC1A # unknown code - set cd_$lz="-" # empty code - if ($l1) then - set cd_$lz=0 # standard code - else - set cd_$lz="-" # empty code - goto GC1A # next - endif - if ($#a0 < 1) goto RETURN # ready - set l0=$a0[1] # digit - if("$l0" =~ [0-9]) then - set cd_$lz=$l0 ; shift a0 # set/delete digit - endif - if ("$lz" !~ [$scodex]) goto GC1A # not extended code - set return=GC13A ; goto GA0 # get extended code -GC13A: - if ($a1 != "") set ${lz}_d=$a1 # new setting - goto GC1A # next code -# -# Routines -# -# Get <string> -# -GA0: - set a1="" # empty result - if ($#a0 < 1) goto $return # no value - if ("$a0[1]" == " ") goto GA0 # skip space - if ("$a0[1]" != "<") goto $return # no value - @ loo=0 ; set l01=0 # count <>/"" - while ($#a0 > 0) - set l02=$a0[1] ; shift a0 # char. - if ($l01 != 0) then # string - if ("$l02" == """") set l01=0 # reset string - else if ("$l02" == "<") then # < - @ loo=$loo + 1 # count < - if ($loo == 1) continue # no save - else if ("$l02" == ">") then # > - @ loo=$loo - 1 # count > - if ($loo == 0) goto $return # ready - else if ("$l02" == """") then # " - set l01=1 # indicate " - endif - set a1=$a1$l02 # add character - end - set a1="" ; goto $return # error -# -# Ready -# -RETURN: diff --git a/src/wng/nxclup.com b/src/wng/nxclup.com deleted file mode 100755 index e86a59af3ad978a27c794ee8527b5f01d1544d63..0000000000000000000000000000000000000000 --- a/src/wng/nxclup.com +++ /dev/null @@ -1,196 +0,0 @@ -$!# nxclup.ssc -$!# WNB 921209 -$!# -$!# Revisions: -$!# WNB 921224 Make SSC -$!# WNB 930303 NSTAR_DIR added -$!# WNB 930305 Make sure aliases -$!# WNB 930630 Typo in VAX check symbols -$!# WNB 940124 Leave _TLB -$!# -$!# Cleanup Newstar directories -$!# -$!# Uses environment variables: -$!# WNG where to find wng-type sources -$!# WNG_TYPE machine (sw, dw, hp, al, cv etc) -$!# WNG_OLBEXE root of wng-type .olb, .ppd, .exe -$!# WNG_SITE site (nfra, atnf, rug ...) -$!# EXEDWARF_UNIX where to find/set DWARF .exe, .ppd -$!# LIBDWARF where to find DWARF .olb -$!# NSTAR_DIR N directories -$!# and also possible: -$!# WNG_EXE, WNG_OLB, WNG_TLB, WNG_ERR, WNG_LIS, WNG_LINK -$!# -$!# Intro -$!# -$ SET NOON !DISCARD ERRORS -$ ON CONTROL_Y THEN GOTO EXEX !FINISH NEATLY -$ VER=F$VERIFY() !FOR ^Y -$ PID=F$EXTRACT(4,4,F$GETJPI("","PID")) !FOR TMP FILES -$ DEP=1 !FOR INDIRECT -$ LDAT=F$EXTRAC(2,2,F$CVTIM(,,"YEAR"))+F$CVTIM(,,"MONTH")+ - - F$CVTIM(,,"DAY") !VERSION -$ TELL="WRITE SYS$OUTPUT" !FOR EASE OF USE -$ ! -$ ASSIGN="ASSIGN" !MAKE SURE PROPER USE -$ BACKUP="BACKUP" -$ COPY="COPY" -$ DELETE="DELETE" -$ DIR="DIRECTORY" -$ PURGE="PURGE" -$ SET="SET" -$ SHOW="SHOW" -$!# -$!# Check environment -$!# -$ IF F$TRNLNM("WNG") .EQS. "" .OR. F$TRNLNM("WNG_OLBEXE") .EQS. "" - - .OR. F$TRNLNM("WNG_DIR") .EQS. "" - - .OR. "''WNG_TYPE'" .EQS. "" .OR. "''WNG_SITE'" .EQS. "" - - .OR. "''NSTAR_DIR'" .EQS. "" -$ THEN -$ TELL " Error: Must have logicals WNG, WNG_OLBEXE, WNG_DIR and globals" -$ TELL " WNG_TYPE, WNG_SITE, NSTAR_DIR defined" -$ TELL " You probably have not included the proper" -$ TELL " files in LOGIN.COM" -$ GOTO EXEX -$ ENDIF -$ IF F$TRNLNM("EXEDWARF") .EQS. "" .OR. - - F$TRNLNM("LIBDWARF") .EQS. "" .OR. - - F$TRNLNM("RUNDWARF") .EQS. "" -$ THEN -$ TELL " Error: Cannot do everything with EXEDWARF and/or" -$ TELL " LIBDWARF and/or RUNDWARF not defined" -$ TELL " You probably have not included the proper" -$ TELL " files in LOGIN.COM" -$ GOTO EXEX -$ ENDIF -$ IF "''NXEC'" .EQS. "" -$ THEN -$ TELL " Error: You have no symbol for NXEC etc." -$ TELL " You probably have not included the proper" -$ TELL " files in LOGIN.COM" -$ GOTO EXEX -$ ENDIF -$ IF "''WNG_EXE'" .EQS. "" THEN - - WNG_EXE=F$TRNLNM("WNG_OLBEXE") -$ IF "''WNG_OLB'" .EQS. "" THEN - - WNG_OLB=F$TRNLNM("WNG_OLBEXE") -$ WNG_TLB="" ! MAKE SURE -$ WNG_ERR="" -$ WNG_LIS="" -$ WNG_LINK="" -$ BLDDIR="''NSTAR_DIR'" ! Newstar directories -$ L0=0 ! MAKE DIRECTORIES -$ LP1: L1=F$ELEMENT(L0,",",BLDDIR) -$ IF L1 .NES. "," -$ THEN -$ IF F$PARSE("''WNG_EXE':[''L1']") .EQS. "" THEN - ! MAKE DIRECTORIES - CREATE/DIR 'WNG_EXE'['L1'] -$ IF F$PARSE("''WNG_OLB':[''L1']") .EQS. "" THEN - - CREATE/DIR 'WNG_OLB':['L1'] -$ L0=L0+1 -$ GOTO LP1 -$ ENDIF -$!# -$!# Get questions -$!# -$ DOTMP="Y" -$ READ/TIME=90/END=EXEX/ERROR=EXEX - - /PROMPT="Delete tmp, old, new, err? (Y|N) [Y]: " - - SYS$COMMAND L0 -$ IF "''L0'" .EQS. "n" .OR. "''L0'" .EQS. "N" THEN DOTMP="N" -$ DOLOG="Y" -$ READ/TIME=90/END=EXEX/ERROR=EXEX - - /PROMPT="Delete log, lis, map? (Y|N) [Y]: " - - SYS$COMMAND L0 -$ IF "''L0'" .EQS. "n" .OR. "''L0'" .EQS. "N" THEN DOLOG="N" -$ DOSRC="N" -$ READ/TIME=90/END=EXEX/ERROR=EXEX - - /PROMPT="Delete source files? (Y|N) [N]: " - - SYS$COMMAND L0 -$ IF "''L0'" .EQS. "y" .OR. "''L0'" .EQS. "Y" THEN DOSRC="Y" -$!# -$!# Cleanup -$!# -$ CLUP: -$ SET DEF WNG_DIR:[WNG.-] ! BASE DIRECTORY -$ TELL "Purging ..." -$ PURGE WNG_DIR:[*]*.* -$ IF DOTMP -$ THEN -$ TELL "Deleting tmp files ..." -$ ASSIGN/NOLOG LOG'PID''DEP' SYS$OUTPUT -$ ASSIGN/NOLOG LOG'PID''DEP' SYS$ERROR -$ L0=0 ! MAKE DIRECTORIES -$ LP7: L1=F$ELEMENT(L0,",",BLDDIR) -$ IF L1 .NES. "," -$ THEN -$ SET DEF WNG_DIR:['L1'] -$ IF F$SEARCH("*.ERR") .NES. "" THEN DELETE *.ERR;* -$ IF F$SEARCH("*.OLD") .NES. "" THEN DELETE *.OLD;* -$ IF F$SEARCH("*.*OLD") .NES. "" THEN DELETE *.*OLD;* -$ IF F$SEARCH("*.NEW") .NES. "" THEN DELETE *.NEW;* -$ IF F$SEARCH("*.TMP") .NES. "" THEN DELETE *.TMP;* -$ IF F$SEARCH("*.*TMP") .NES. "" THEN DELETE *.*TMP;* -$ IF F$SEARCH("*.OBJ") .NES. "" THEN DELETE *.OBJ;* -$ IF F$SEARCH("*.JOU") .NES. "" THEN DELETE *.JOU;* -$ L0=L0+1 -$ GOTO LP7 -$ ENDIF -$ DEASSIGN SYS$OUTPUT -$ DEASSIGN SYS$ERROR -$ ENDIF -$ SET DEF WNG_DIR:[WNG.-] ! BASE DIRECTORY -$ IF DOLOG -$ THEN -$ TELL "Deleting lis files ..." -$ ASSIGN/NOLOG LOG'PID''DEP' SYS$OUTPUT -$ ASSIGN/NOLOG LOG'PID''DEP' SYS$ERROR -$ L0=0 ! MAKE DIRECTORIES -$ LP8: L1=F$ELEMENT(L0,",",BLDDIR) -$ IF L1 .NES. "," -$ THEN -$ SET DEF WNG_DIR:['L1'] -$ IF F$SEARCH("*.LIS") .NES. "" THEN DELETE *.LIS;* -$ IF F$SEARCH("*.LOG") .NES. "" THEN DELETE *.LOG;* -$ IF F$SEARCH("*.MAP") .NES. "" THEN DELETE *.LOG;* -$ IF F$SEARCH("''WNG_EXE':[''L1']*.MAP") .NES. "" THEN - - DELETE WNG_EXE:['L1']*.MAP;* -$ L0=L0+1 -$ GOTO LP8 -$ ENDIF -$ DEASSIGN SYS$OUTPUT -$ DEASSIGN SYS$ERROR -$ ENDIF -$ SET DEF WNG_DIR:[WNG.-] ! BASE DIRECTORY -$ IF DOSRC -$ THEN -$ TELL "Deleting source files ..." -$ ASSIGN/NOLOG LOG'PID''DEP' SYS$OUTPUT -$ ASSIGN/NOLOG LOG'PID''DEP' SYS$ERROR -$ L0=0 ! MAKE DIRECTORIES -$ LP9: L1=F$ELEMENT(L0,",",BLDDIR) -$ IF L1 .NES. "," -$ THEN -$ SET DEF WNG_DIR:['L1'] -$ IF F$SEARCH("*.F%%") .NES. "" THEN DELETE *.F%%;* -$ IF F$SEARCH("*.C%%") .NES. "" THEN DELETE/EXCLUDE=(*.COM) *.C%%;* -$ IF F$SEARCH("*.M%%") .NES. "" THEN DELETE *.M%%;* -$ IF F$SEARCH("*.PIN") .NES. "" THEN DELETE *.PIN;* -$ L0=L0+1 -$ GOTO LP9 -$ ENDIF -$ DEASSIGN SYS$OUTPUT -$ DEASSIGN SYS$ERROR -$ ENDIF -$!# -$!# Ready -$!# -$ END: -$!# -$!# EXIT -$!# -$ EXEX: SET ON -$ SET DEF WNG_DIR:[WNG.-] !BACK TO NORMAL -$ L0=F$VERIFY(VER) !RESET VERIFY -$ EXIT diff --git a/src/wng/nxclup.ssc b/src/wng/nxclup.ssc deleted file mode 100644 index e6d20c829514511c32d40e4df5b4bbdd5e94bbe2..0000000000000000000000000000000000000000 --- a/src/wng/nxclup.ssc +++ /dev/null @@ -1,312 +0,0 @@ -# nxclup.ssc -# WNB 921209 -# -# Revisions: -# WNB 921224 Make SSC -# WNB 930303 NSTAR_DIR added -# WNB 930305 Make sure aliases -# WNB 930630 Typo in VAX check symbols -# WNB 940124 Leave _TLB -# -# Cleanup Newstar directories -# -# Uses environment variables: -# WNG where to find wng-type sources -# WNG_TYPE machine (sw, dw, hp, al, cv etc) -# WNG_OLBEXE root of wng-type .olb, .ppd, .exe -# WNG_SITE site (nfra, atnf, rug ...) -# EXEDWARF_UNIX where to find/set DWARF .exe, .ppd -# LIBDWARF where to find DWARF .olb -# NSTAR_DIR N directories -# and also possible: -# WNG_EXE, WNG_OLB, WNG_TLB, WNG_ERR, WNG_LIS, WNG_LINK -# -# Intro -# -#ifdef wn_vax__ -$ SET NOON !DISCARD ERRORS -$ ON CONTROL_Y THEN GOTO EXEX !FINISH NEATLY -$ VER=F$VERIFY() !FOR ^Y -$ PID=F$EXTRACT(4,4,F$GETJPI("","PID")) !FOR TMP FILES -$ DEP=1 !FOR INDIRECT -$ LDAT=F$EXTRAC(2,2,F$CVTIM(,,"YEAR"))+F$CVTIM(,,"MONTH")+ - - F$CVTIM(,,"DAY") !VERSION -$ TELL="WRITE SYS$OUTPUT" !FOR EASE OF USE -$ ! -$ ASSIGN="ASSIGN" !MAKE SURE PROPER USE -$ BACKUP="BACKUP" -$ COPY="COPY" -$ DELETE="DELETE" -$ DIR="DIRECTORY" -$ PURGE="PURGE" -$ SET="SET" -$ SHOW="SHOW" -#else - onintr exex # finish neatly - if ($?echo) unset echo # no verify - if ($?verbose) unset verbose # no verbose - set pid=$$ ; @ dep=1 # for tmp files -#endif -# -# Check environment -# -#ifdef wn_vax__ -$ IF F$TRNLNM("WNG") .EQS. "" .OR. F$TRNLNM("WNG_OLBEXE") .EQS. "" - - .OR. F$TRNLNM("WNG_DIR") .EQS. "" - - .OR. "''WNG_TYPE'" .EQS. "" .OR. "''WNG_SITE'" .EQS. "" - - .OR. "''NSTAR_DIR'" .EQS. "" -$ THEN -$ TELL " Error: Must have logicals WNG, WNG_OLBEXE, WNG_DIR and globals" -$ TELL " WNG_TYPE, WNG_SITE, NSTAR_DIR defined" -$ TELL " You probably have not included the proper" -$ TELL " files in LOGIN.COM" -$ GOTO EXEX -$ ENDIF -$ IF F$TRNLNM("EXEDWARF") .EQS. "" .OR. - - F$TRNLNM("LIBDWARF") .EQS. "" .OR. - - F$TRNLNM("RUNDWARF") .EQS. "" -$ THEN -$ TELL " Error: Cannot do everything with EXEDWARF and/or" -$ TELL " LIBDWARF and/or RUNDWARF not defined" -$ TELL " You probably have not included the proper" -$ TELL " files in LOGIN.COM" -$ GOTO EXEX -$ ENDIF -$ IF "''NXEC'" .EQS. "" -$ THEN -$ TELL " Error: You have no symbol for NXEC etc." -$ TELL " You probably have not included the proper" -$ TELL " files in LOGIN.COM" -$ GOTO EXEX -$ ENDIF -$ IF "''WNG_EXE'" .EQS. "" THEN - - WNG_EXE=F$TRNLNM("WNG_OLBEXE") -$ IF "''WNG_OLB'" .EQS. "" THEN - - WNG_OLB=F$TRNLNM("WNG_OLBEXE") -$ WNG_TLB="" ! MAKE SURE -$ WNG_ERR="" -$ WNG_LIS="" -$ WNG_LINK="" -$ BLDDIR="''NSTAR_DIR'" ! Newstar directories -$ L0=0 ! MAKE DIRECTORIES -$ LP1: L1=F$ELEMENT(L0,",",BLDDIR) -$ IF L1 .NES. "," -$ THEN -$ IF F$PARSE("''WNG_EXE':[''L1']") .EQS. "" THEN - ! MAKE DIRECTORIES - CREATE/DIR 'WNG_EXE'['L1'] -$ IF F$PARSE("''WNG_OLB':[''L1']") .EQS. "" THEN - - CREATE/DIR 'WNG_OLB':['L1'] -$ L0=L0+1 -$ GOTO LP1 -$ ENDIF -#else - if (! $?WNG || ! $?WNG_TYPE || ! $?WNG_OLBEXE ||\ - ! $?WNG_SITE || ! $?NSTAR_DIR) then - echo " Error: Must have environment variables" - echo " WNG, WNG_TYPE, WNG_OLBEXE, WNG_SITE, NSTAR_DIR defined" - echo " You probably have not included the proper" - echo " files in .cshrc" - goto exex - endif - if (! $?EXEDWARF_UNIX || ! $?LIBDWARF) then - echo " Error: Cannot do everything with EXEDWARF_UNIX and/or" - echo " LIBDWARF not defined" - echo " You probably have not included the proper" - echo " files in .cshrc" - goto exex - endif - source $WNG/wngcshrc.sun # get aliases - if ("`alias nxec`" == "") then - echo " Error: You have no alias for nxec etc." - echo " You probably have not included the proper" - echo " files in .cshrc" - goto exex - endif -# -# Creating environment -# - cd $WNG - if (! $?WNG_EXE) setenv WNG_EXE $WNG_OLBEXE # make names - if (! $?WNG_OLB) setenv WNG_OLB $WNG_OLBEXE - set blddir=($NSTAR_DIR) # Newstar directories - foreach i ($blddir) - if (! -d $WNG_EXE/$i) mkdir $WNG_EXE/$i # make directories - if (! -d $WNG_OLB/$i) mkdir $WNG_OLB/$i - endif -## if ($?WNG_TLB) unsetenv WNG_TLB # make sure - if ($?WNG_ERR) unsetenv WNG_ERR - if ($?WNG_LIS) unsetenv WNG_LIS - if ($?WNG_LINK) unsetenv WNG_LINK -#endif -# -# Get questions -# -#ifdef wn_vax__ -$ DOTMP="Y" -$ READ/TIME=90/END=EXEX/ERROR=EXEX - - /PROMPT="Delete tmp, old, new, err? (Y|N) [Y]: " - - SYS$COMMAND L0 -$ IF "''L0'" .EQS. "n" .OR. "''L0'" .EQS. "N" THEN DOTMP="N" -$ DOLOG="Y" -$ READ/TIME=90/END=EXEX/ERROR=EXEX - - /PROMPT="Delete log, lis, map? (Y|N) [Y]: " - - SYS$COMMAND L0 -$ IF "''L0'" .EQS. "n" .OR. "''L0'" .EQS. "N" THEN DOLOG="N" -$ DOSRC="N" -$ READ/TIME=90/END=EXEX/ERROR=EXEX - - /PROMPT="Delete source files? (Y|N) [N]: " - - SYS$COMMAND L0 -$ IF "''L0'" .EQS. "y" .OR. "''L0'" .EQS. "Y" THEN DOSRC="Y" -#else - echo -n "Delete tmp, old, new, err? (y|n) [y]: " - set l0=($<) - set dotmp - if ("$l0" =~ [nN]) unset dotmp - echo -n "Delete log, lis, map? (y|n) [y]: " - set l0=($<) - set dolog - if ("$l0" =~ [nN]) unset dolog - echo -n "Delete source files? (y|n) [n]: " - set l0=($<) - unset dosrc - if ("$l0" =~ [yY]) set dosrc -#endif -# -# Cleanup -# -#ifdef wn_vax__ -$ CLUP: -$ SET DEF WNG_DIR:[WNG.-] ! BASE DIRECTORY -$ TELL "Purging ..." -$ PURGE WNG_DIR:[*]*.* -$ IF DOTMP -$ THEN -$ TELL "Deleting tmp files ..." -$ ASSIGN/NOLOG LOG'PID''DEP' SYS$OUTPUT -$ ASSIGN/NOLOG LOG'PID''DEP' SYS$ERROR -$ L0=0 ! MAKE DIRECTORIES -$ LP7: L1=F$ELEMENT(L0,",",BLDDIR) -$ IF L1 .NES. "," -$ THEN -$ SET DEF WNG_DIR:['L1'] -$ IF F$SEARCH("*.ERR") .NES. "" THEN DELETE *.ERR;* -$ IF F$SEARCH("*.OLD") .NES. "" THEN DELETE *.OLD;* -$ IF F$SEARCH("*.*OLD") .NES. "" THEN DELETE *.*OLD;* -$ IF F$SEARCH("*.NEW") .NES. "" THEN DELETE *.NEW;* -$ IF F$SEARCH("*.TMP") .NES. "" THEN DELETE *.TMP;* -$ IF F$SEARCH("*.*TMP") .NES. "" THEN DELETE *.*TMP;* -$ IF F$SEARCH("*.OBJ") .NES. "" THEN DELETE *.OBJ;* -$ IF F$SEARCH("*.JOU") .NES. "" THEN DELETE *.JOU;* -$ L0=L0+1 -$ GOTO LP7 -$ ENDIF -$ DEASSIGN SYS$OUTPUT -$ DEASSIGN SYS$ERROR -$ ENDIF -$ SET DEF WNG_DIR:[WNG.-] ! BASE DIRECTORY -$ IF DOLOG -$ THEN -$ TELL "Deleting lis files ..." -$ ASSIGN/NOLOG LOG'PID''DEP' SYS$OUTPUT -$ ASSIGN/NOLOG LOG'PID''DEP' SYS$ERROR -$ L0=0 ! MAKE DIRECTORIES -$ LP8: L1=F$ELEMENT(L0,",",BLDDIR) -$ IF L1 .NES. "," -$ THEN -$ SET DEF WNG_DIR:['L1'] -$ IF F$SEARCH("*.LIS") .NES. "" THEN DELETE *.LIS;* -$ IF F$SEARCH("*.LOG") .NES. "" THEN DELETE *.LOG;* -$ IF F$SEARCH("*.MAP") .NES. "" THEN DELETE *.LOG;* -$ IF F$SEARCH("''WNG_EXE':[''L1']*.MAP") .NES. "" THEN - - DELETE WNG_EXE:['L1']*.MAP;* -$ L0=L0+1 -$ GOTO LP8 -$ ENDIF -$ DEASSIGN SYS$OUTPUT -$ DEASSIGN SYS$ERROR -$ ENDIF -$ SET DEF WNG_DIR:[WNG.-] ! BASE DIRECTORY -$ IF DOSRC -$ THEN -$ TELL "Deleting source files ..." -$ ASSIGN/NOLOG LOG'PID''DEP' SYS$OUTPUT -$ ASSIGN/NOLOG LOG'PID''DEP' SYS$ERROR -$ L0=0 ! MAKE DIRECTORIES -$ LP9: L1=F$ELEMENT(L0,",",BLDDIR) -$ IF L1 .NES. "," -$ THEN -$ SET DEF WNG_DIR:['L1'] -$ IF F$SEARCH("*.F%%") .NES. "" THEN DELETE *.F%%;* -$ IF F$SEARCH("*.C%%") .NES. "" THEN DELETE/EXCLUDE=(*.COM) *.C%%;* -$ IF F$SEARCH("*.M%%") .NES. "" THEN DELETE *.M%%;* -$ IF F$SEARCH("*.PIN") .NES. "" THEN DELETE *.PIN;* -$ L0=L0+1 -$ GOTO LP9 -$ ENDIF -$ DEASSIGN SYS$OUTPUT -$ DEASSIGN SYS$ERROR -$ ENDIF -#else -CLUP: - cd $WNG - if ($?dotmp) then - echo "Removing tmp ..." - foreach i ($blddir) - cd ../$i - 'rm' *.old >& /dev/null - 'rm' *.err >& /dev/null - 'rm' *.new >& /dev/null - 'rm' *.tmp >& /dev/null - 'rm' *.OLD >& /dev/null - 'rm' *.ERR >& /dev/null - 'rm' *.NEW >& /dev/null - 'rm' *.TMP >& /dev/null - 'rm' *~ >& /dev/null - 'rm' *.o >& /dev/null - 'rm' "#*#" >& /dev/null - end - endif - if ($?dolog) then - echo "Removing log ..." - foreach i ($blddir) - cd ../$i - 'rm' *.log >& /dev/null - 'rm' *.lis >& /dev/null - 'rm' *.map >& /dev/null - 'rm' *.LOG >& /dev/null - 'rm' *.LIS >& /dev/null - 'rm' *.MAP >& /dev/null - 'rm' $WNG_EXE/$i/*.MAP >& /dev/null - end - endif - if ($?dosrc) then - echo "Removing source files ..." - foreach i ($blddir) - cd ../$i - 'rm' *.f?? >& /dev/null - 'rm' *.m?? >& /dev/null - 'rm' *.pin >& /dev/null - 'rm' *.c[a-np-z]? >& /dev/null - end - endif -#endif -# -# Ready -# -#ifdef wn_vax__ -$ END: -#else -END: -#endif -# -# EXIT -# -#ifdef wn_vax__ -$ EXEX: SET ON -$ SET DEF WNG_DIR:[WNG.-] !BACK TO NORMAL -$ L0=F$VERIFY(VER) !RESET VERIFY -$ EXIT -#else -exex: - exit -#endif diff --git a/src/wng/nxclup.sun b/src/wng/nxclup.sun deleted file mode 100755 index 71589e25755d202bd595e5a12f0d57f8bdaeb6a0..0000000000000000000000000000000000000000 --- a/src/wng/nxclup.sun +++ /dev/null @@ -1,138 +0,0 @@ -# nxclup.ssc -# WNB 921209 -# -# Revisions: -# WNB 921224 Make SSC -# WNB 930303 NSTAR_DIR added -# WNB 930305 Make sure aliases -# WNB 930630 Typo in VAX check symbols -# WNB 940124 Leave _TLB -# -# Cleanup Newstar directories -# -# Uses environment variables: -# WNG where to find wng-type sources -# WNG_TYPE machine (sw, dw, hp, al, cv etc) -# WNG_OLBEXE root of wng-type .olb, .ppd, .exe -# WNG_SITE site (nfra, atnf, rug ...) -# EXEDWARF_UNIX where to find/set DWARF .exe, .ppd -# LIBDWARF where to find DWARF .olb -# NSTAR_DIR N directories -# and also possible: -# WNG_EXE, WNG_OLB, WNG_TLB, WNG_ERR, WNG_LIS, WNG_LINK -# -# Intro -# - onintr exex # finish neatly - if ($?echo) unset echo # no verify - if ($?verbose) unset verbose # no verbose - set pid=$$ ; @ dep=1 # for tmp files -# -# Check environment -# - if (! $?WNG || ! $?WNG_TYPE || ! $?WNG_OLBEXE ||\ - ! $?WNG_SITE || ! $?NSTAR_DIR) then - echo " Error: Must have environment variables" - echo " WNG, WNG_TYPE, WNG_OLBEXE, WNG_SITE, NSTAR_DIR defined" - echo " You probably have not included the proper" - echo " files in .cshrc" - goto exex - endif - if (! $?EXEDWARF_UNIX || ! $?LIBDWARF) then - echo " Error: Cannot do everything with EXEDWARF_UNIX and/or" - echo " LIBDWARF not defined" - echo " You probably have not included the proper" - echo " files in .cshrc" - goto exex - endif - source $WNG/wngcshrc.sun # get aliases - if ("`alias nxec`" == "") then - echo " Error: You have no alias for nxec etc." - echo " You probably have not included the proper" - echo " files in .cshrc" - goto exex - endif -# -# Creating environment -# - cd $WNG - if (! $?WNG_EXE) setenv WNG_EXE $WNG_OLBEXE # make names - if (! $?WNG_OLB) setenv WNG_OLB $WNG_OLBEXE - set blddir=($NSTAR_DIR) # Newstar directories - foreach i ($blddir) - if (! -d $WNG_EXE/$i) mkdir $WNG_EXE/$i # make directories - if (! -d $WNG_OLB/$i) mkdir $WNG_OLB/$i - endif -## if ($?WNG_TLB) unsetenv WNG_TLB # make sure - if ($?WNG_ERR) unsetenv WNG_ERR - if ($?WNG_LIS) unsetenv WNG_LIS - if ($?WNG_LINK) unsetenv WNG_LINK -# -# Get questions -# - echo -n "Delete tmp, old, new, err? (y|n) [y]: " - set l0=($<) - set dotmp - if ("$l0" =~ [nN]) unset dotmp - echo -n "Delete log, lis, map? (y|n) [y]: " - set l0=($<) - set dolog - if ("$l0" =~ [nN]) unset dolog - echo -n "Delete source files? (y|n) [n]: " - set l0=($<) - unset dosrc - if ("$l0" =~ [yY]) set dosrc -# -# Cleanup -# -CLUP: - cd $WNG - if ($?dotmp) then - echo "Removing tmp ..." - foreach i ($blddir) - cd ../$i - 'rm' *.old >& /dev/null - 'rm' *.err >& /dev/null - 'rm' *.new >& /dev/null - 'rm' *.tmp >& /dev/null - 'rm' *.OLD >& /dev/null - 'rm' *.ERR >& /dev/null - 'rm' *.NEW >& /dev/null - 'rm' *.TMP >& /dev/null - 'rm' *~ >& /dev/null - 'rm' *.o >& /dev/null - 'rm' "#*#" >& /dev/null - end - endif - if ($?dolog) then - echo "Removing log ..." - foreach i ($blddir) - cd ../$i - 'rm' *.log >& /dev/null - 'rm' *.lis >& /dev/null - 'rm' *.map >& /dev/null - 'rm' *.LOG >& /dev/null - 'rm' *.LIS >& /dev/null - 'rm' *.MAP >& /dev/null - 'rm' $WNG_EXE/$i/*.MAP >& /dev/null - end - endif - if ($?dosrc) then - echo "Removing source files ..." - foreach i ($blddir) - cd ../$i - 'rm' *.f?? >& /dev/null - 'rm' *.m?? >& /dev/null - 'rm' *.pin >& /dev/null - 'rm' *.c[a-np-z]? >& /dev/null - end - endif -# -# Ready -# -END: -# -# EXIT -# -exex: - exit diff --git a/src/wng/nxec.com b/src/wng/nxec.com deleted file mode 100755 index 9867655907daae451adf829163897b17ad7535ec..0000000000000000000000000000000000000000 --- a/src/wng/nxec.com +++ /dev/null @@ -1,916 +0,0 @@ -$!# nxec.ssc -$!# WNB 920908 -$!# -$!# Revisions: -$!# WNB 920930 Additions, overhaul, speed up -$!# WNB 921014 Add -a nnet -$!# WNB 921015 Change setting of WNG_OLB WNG_EXE -$!# WNB 921019 Auto nget for ncomp included -$!# WNB 921104 Typo (" missing); default u_d; fnam check -$!# WNB 921113 Do postponed ar -$!# WNB 921116 Add G qualifier and allow multi-level .grp -$!# WNB 921117 Add regular expressions -$!# WNB 921130 Stop multiple ar; correct set echo; tr for HP -$!# WNB 921208 Add date, list of directories; new update log -$!# WNB 921209 Add logical link test; -a0 switch -$!# WNB 921211 Add P qualifier -$!# WNB 921216 Add ## -$!# WNB 921230 Make SSC -$!# WNB 930108 Add X11 -$!# JPH 930225 -qv<x> option to start echo/verify with execution -$!# include $WNG_LINK in c-dir -$!# comments -$!# WNB 930301 Add aliases for # type; add +es for HP; add NSTAR_DIR -$!# WNB 930325 Cater for different fold -$!# WNB 930330 Add _ax.tlb; giplib.olb; pgplot.olb -$!# WNB 930405 Add SPAWN for better control (VAX) -$!# HjV 930416 Add path for include files for HP -$!# WNB 930427 More general include path HP -$!# WNB 930429 Add -lm for SUN; delete pgplot -$!# HjV 930503 Add -lm for HP; remove -lm for SUN -$!# WNB 930504 Problem linking NGCALC -$!# CMV 930906 Switches for SUN in RUG -$!# WNB 930921 Assume never WNG_OLB/WNG_EXE in VMS -$!# WNB 930922 WNG_OLB/WNG_EXE recursive calls -$!# WNB 931213 Proper X11 path -$!# WNB 931217 Add NCOPY to NSTAR_DIR -$!# WNB 940124 Add _stlb, _s1tlb -$!# -$!# Compile, link, maintain routines. Use as: -$!# Unix: $WNG/nxec.sun <type> [-<code>] ... [<name>,...] ... [-<code>] ... -$!# VAX: @WNG:NXEC ... -$!# -$!# Type can be: NCOMP Compile -$!# NLINK Link -$!# NGET Get from text library -$!# NXREF Make Fortran crossreference -$!# NDEL Delete -$!# NNET Get across net -$!# See Help (a ? in a parameter) for details. -$!# -$!# Uses environment variables: -$!# WNG where to find wng-type sources -$!# WNG_TYPE machine (sw, dw, hp, al, cv etc) -$!# WNG_OLBEXE root of wng-type .olb, .ppd, .exe -$!# WNG_SITE site (nfra, atnf, rug ...) -$!# EXEDWARF_UNIX where to find/set DWARF .exe, .ppd -$!# LIBDWARF where to find DWARF .olb -$!# and also possible: -$!# WNG_NODE node name (number) of central node -$!# WNG_NODEUSER user (or user and pw) at central node -$!# WNG_NODEDIR WNG-root dir at central node -$!# (DV:[...] or /.../......) -$!# NSTAR_DIR Newstar directories -$!# The following env. variables are optional, to be used to define -$!# a specific target file system (foreign host or shadow tree). Defaults are -$!# shown in parentheses, subdir is the name of the source's subdirectory -$!# under $WNG/.. . -$!# WNG_EXE (WNG_OLBEXE) parent of .exe target -$!# WNG_OLB (WNG_OLBEXE) parent of .olb target -$!# WNG_TLB current directory .tlb target -$!# WNG_ERR, WNG_LIS current directory .lis, .err target -$!# WNG_LINK current directory target for .f soft links (must -$!# be subdir of WNG_EXE, WNG_OLB -$!# or WNG/..) -$!# -$!# Intro -$!# -$ SET NOON !DISCARD ERRORS -$ ON CONTROL_Y THEN GOTO EXEX !FINISH NEATLY -$ INTAT="X0" !INTERACTIVE -$ VER=F$VERIFY() !FOR ^Y -$ TELL="WRITE SYS$OUTPUT" !FOR EASE OF USE -$ PID=F$EXTRACT(4,4,F$GETJPI("","PID")) !FOR TMP FILES -$ DEP=1 !FOR INDIRECT -$ IF P1 .EQS. "X1" .OR. P1 .EQS. "X2" !NON-INTERACTIVE -$ THEN -$ INTAT="''P1'" !SET VARIABLES -$ PNAM=P2 -$ PCOD=P3 -$ DEP=P4+1 -$ ENDIF -$ C_DATE=F$EXTRACT(2,2,F$CVTIM(,,"YEAR"))+F$CVTIM(,,"MONTH")+ - - F$CVTIM(,,"DAY") !DATE YYMMDD -$ C_TIME=F$CVTIM(,,"HOUR")+F$CVTIM(,,"MINUTE")+ - - F$CVTIM(,,"SECOND") !TIME HHMMSS -$ C_UPD="UPD''C_DATE'.LOG" !LOG NAME -$ IF F$SEARCH(C_UPD) .EQS. "" !CREATE LOG -$ THEN -$ L1="None" -$ L0=1 -$ LP23: -$ L3=F$SEARCH("UPD%%%%%%.LOG",L0) -$ IF L3 .NES. "" -$ THEN -$ L1=L3 -$ GOTO LP23 -$ ENDIF -$ OPEN/WRITE/ERROR=EXEX UP'PID''DEP' 'C_UPD' -$ WRITE/ERROR=EXEX UP'PID''DEP' "! ''C_UPD' (Previous: ''L1')" -$ CLOSE/ERROR=EXEX UP'PID''DEP' -$ ENDIF -$ UTELL="WRITE UP''PID'''DEP'" -$ OPEN/APPEND/SHARE/ERROR=EXEX UP'PID''DEP' 'C_UPD' !OPEN LOG -$ ! !CURRENT DIRECTORY -$ CWD=F$PARSE(F$ENVIRONMENT("DEFAULT"),,,"DEVICE","NO_CONCEAL")+ - - F$PARSE(F$ENVIRONMENT("DEFAULT"),,,"DIRECTORY","NO_CONCEAL") -$ L0=0 !GET TAIL DIRECTORY -$ LP1: L0=L0+1 -$ L1=F$ELEMENT(L0,"[",CWD) -$ IF L1 .NES. "[" -$ THEN -$ L2="["+L1 -$ GOTO LP1 -$ ENDIF -$ CWDT=L2 -$ L0=0 -$ LP2: L0=L0+1 -$ L1=F$ELEMENT(L0,".",L2) -$ IF L1 .NES. "." -$ THEN -$ CWDT="["+L1 -$ GOTO LP2 -$ ENDIF -$ ! -$ ASSIGN="ASSIGN" !MAKE SURE PROPER USE -$ CONVERT="CONVERT" -$ COPY="COPY" -$ CREATE="CREATE" -$ DELETE="DELETE" -$ DIR="DIRECTORY" -$ FORTRAN="FORTRAN" -$ LIBRARY="LIBRARY" -$ LINK="LINK" -$ MACRO="MACRO" -$ PURGE="PURGE" -$ SET="SET" -$ SHOW="SHOW" -$ SPAWN="SPAWN" -$ SUBMIT="SUBMIT" -$!# -$!# Check environment -$!# -$ IF INTAT .EQS. "X0" !INTERACTIVE -$ THEN -$ IF F$TRNLNM("WNG") .EQS. "" .OR. F$TRNLNM("WNG_OLBEXE") .EQS. "" - - .OR. "''WNG_TYPE'" .EQS. "" .OR. "''WNG_SITE'" .EQS. "" -$ THEN -$ TELL " Error: Must have logicals WNG, WNG_OLBEXE and globals" -$ TELL " WNG_TYPE, WNG_SITE defined" -$ UTELL " Error: Must have logicals WNG, WNG_OLBEXE and globals" -$ UTELL " WNG_TYPE, WNG_SITE defined" -$ GOTO EXEX -$ ENDIF -$ IF F$TRNLNM("EXEDWARF") .EQS. "" .OR. - - F$TRNLNM("LIBDWARF") .EQS. "" .OR. - - F$TRNLNM("RUNDWARF") .EQS. "" -$ THEN -$ TELL " Warning: Cannot do everything with EXEDWARF and/or" -$ TELL " LIBDWARF and/or RUNDWARF not defined" -$ UTELL " Warning: Cannot do everything with EXEDWARF and/or" -$ UTELL " LIBDWARF and/or RUNDWARF not defined" -$ ENDIF -$ IF "''WNG_NODE'" .EQS. "" THEN WNG_NODE="" !DEFINE -$ IF "''WNG_NODEDIR'" .EQS. "" THEN WNG_NODEDIR="" -$ IF "''WNG_NODEUSER'" .EQS. "" THEN WNG_NODEUSER="" -$ WNG_EXE=F$PARSE(F$TRNLNM("WNG_OLBEXE"),,,"DEVICE","NO_CONCEAL")+ - - F$PARSE(F$TRNLNM("WNG_OLBEXE"),"''CWDT'",, - - "DIRECTORY","NO_CONCEAL") -$ WNG_OLB=F$PARSE(F$TRNLNM("WNG_OLBEXE"),,,"DEVICE","NO_CONCEAL")+ - - F$PARSE(F$TRNLNM("WNG_OLBEXE"),"''CWDT'",, - - "DIRECTORY","NO_CONCEAL") -$ IF "''WNG_TLB'" .EQS. "" THEN - - WNG_TLB="''CWD'" -$ IF "''WNG_ERR'" .EQS. "" THEN - - WNG_ERR="''CWD'" -$ IF "''WNG_LIS'" .EQS. "" THEN - - WNG_LIS="''CWD'" -$ IF "''WNG_LINK'" .EQS. "" THEN - - WNG_LINK="''CWD'" -$ IF "''NSTAR_DIR'" .EQS. "" THEN - - NSTAR_DIR="WNG,DWARF,NSCAN,NCOPY,NMAP,NPLOT" -$ IF F$PARSE("''WNG_EXE'") .EQS. "" THEN - ! MAKE DIRECTORIES - CREATE/DIR 'WNG_EXE' -$ IF F$PARSE("''WNG_OLB'") .EQS. "" THEN - - CREATE/DIR 'WNG_OLB' -$ IF F$PARSE("''WNG_TLB'") .EQS. "" THEN - - CREATE/DIR 'WNG_TLB' -$ IF F$PARSE("''WNG_ERR'") .EQS. "" THEN - - CREATE/DIR 'WNG_ERR' -$ IF F$PARSE("''WNG_LIS'") .EQS. "" THEN - - CREATE/DIR 'WNG_LIS' -$ IF F$PARSE("''WNG_LINK'") .EQS. "" THEN - - CREATE/DIR 'WNG_LINK' -$ IF F$TRNLNM("WNG_TLD") .EQS. "" .AND. - ! NO LOGICAL DEFINITIONS - F$SEARCH("WNG:NXLDEF.COM") .NES. "" THEN - - @WNG:NXLDEF.COM ! GET LOGICAL LINKS -$ ENDIF -$ C_DIR="''NSTAR_DIR'" !N DIRECTORIES -$ IF F$PARSE("[-.NCOPY]") .NES. "" .AND. - - F$LOCATE("NCOPY",NSTAR_DIR) .EQ. F$LENGTH(NSTAR_DIR) THEN - - C_DIR=C_DIR+",NCOPY" -$!# -$!# External environment -$!# -$ EXT="''WNG_TYPE'" ! MACHINE TYPE -$ LNK_DEF="WNG_OLBEXE:[NSCAN]WNLIB.OLB/LIB"+ - - ",WNG_OLBEXE:[NMAP]WNLIB.OLB/LIB"+ - - ",WNG_OLBEXE:[NPLOT]WNLIB.OLB/LIB" -$ IF F$SEARCH("WNG_OLBEXE:[WNG]GIPLIB.OLB") .NES. "" THEN - - LNK_DEF=LNK_DEF+",WNG_OLBEXE:[WNG]GIPLIB.OLB" -$ LNK_DEF=LNK_DEF+ - - ",WNG_OLBEXE:[WNG]WNLIB.OLB/LIB" !DEFAULT LIBRARIES -$ LNK_USE="" -$ IF F$TRNLNM("WNG_LDFILES") .NES. "" THEN - - LNK_USE="''F$TRNLNM("WNG_LDFILES")'" -$ FORTRAN="FORTRAN" !FORTRAN COMPILER -$ XFORT="" -$ LFORT="/F77/EXTEND/I4/SHOW=(NODICT,NOINCL,MAP,NOPREP,NOSIN)"+ - - "/DEBUG/OPTIM" !LINK FORTRAN -$ CEE="" !C COMPILER -$ XCEE="" -$ ASSEM="MACRO" !ASSEMBLER -$ XASSEM="" -$!# -$!# nxec environment -$!# -$ CHTP=".DIR,.ERR,.EXE,.HLB,.JOU,.LIS,.LOG,.LST,.MAP,.MLB,"+ - - ".NEW,.NPD,.OBJ,.OLB,.OLD,.PPD,.TLB,.TMP,"+ - - ".UDF,.ULB," !FILES TO SKIP -$ CODES="ABCDLOPSUXYZ" !KNOWN CODES -$ CODEX="LU" !EXTENDED CODES -$ QUAL ="BCFGIJLMOPV" !KNOWN QUALIFIERS -$ QUALA="BCFIJLMOP" !ADDITIVE QUALIFIERS -$ NCC_D="CDLOZ" !DEFAULT CODES -$ NDC_D="ACLZ" -$ NGC_D="LZ" -$ NLC_D="SLZ" -$ NNC_D="Z" -$ IF INTAT .EQS. "X0" !INTERACTIVE -$ THEN -$ L_D="WNLIB" !DEFAULT LIBRARY -$ U_D=" " !DEFAULT DWARF UPDATE -$ L0=0 !DEFINE ALL CODES -$ LP3: CD_'F$EXTRACT(L0,1,CODES)'="-" -$ L0=L0+1 -$ IF L0 .LT. F$LENGTH(CODES) THEN GOTO LP3 -$ L0=0 !DEFINE ALL QUALIFIERS -$ LP4: 'F$EXTRACT(L0,1,QUAL)'Q_D="" -$ L0=L0+1 -$ IF L0 .LT. F$LENGTH(QUAL) THEN GOTO LP4 -$ ELSE !BATCH -$ FG_CD=P5 -$ L0=0 !COPY CODES -$ LP5: CD_'F$EXTRACT(L0,1,CODES)'=F$EXTRACT(L0,1,FG_CD) -$ L0=L0+1 -$ IF L0 .LT. F$LENGTH(CODES) THEN GOTO LP5 -$ FG_CX="''P6'" -$ L0=0 !EXTENDED CODES -$ LP6: 'F$EXTRACT(L0,1,CODEX)'_D=F$ELEMENT(L0," ","''FG_CX'") -$ IF 'F$EXTRACT(L0,1,CODEX)'_D .EQS. "-" THEN - - 'F$EXTRACT(L0,1,CODEX)'_D="" !EMPTY -$ L0=L0+1 -$ IF L0 .LT. F$LENGTH(CODEX) THEN GOTO LP6 -$ ENDIF -$!# -$!# Machine environment -$!# -$ DATTP=1 -$ BQ_D="/NOLOG/NOPRINT/NOKEEP" !BATCH DEFAULT -$ FQ_D="/F77/EXTEND/I4/SHOW=(NODICT,NOINCL,MAP,NOPREP,NOSIN)" !FORTRAN -$ CQ_D="/LIST/SHOW=(STAT,TRANS,SYM)/NOWARN" -$ IF INTAT .NES. "X0" !RESET QUAL. FOR BATCH -$ THEN -$ L0=0 -$ LP7: 'F$EXTRACT(L0,1,QUAL)'Q_D='F$EXTRACT(L0,1,QUAL)'Q_DX -$ L0=L0+1 -$ IF L0 .LT. F$LENGTH(QUAL) THEN GOTO LP7 -$ ENDIF -$!# -$!# Get execution type -$!# -$ IF INTAT .EQS. "X0" !INTERACTIVE -$ THEN -$ PNAM="" !UNKNOWN -$ L1=F$LENGTH(P1) !LENGTH GIVEN -$ IF L1 .LT. 2 THEN P1="Empty" !ERROR IN TYPE -$ L0=F$EDIT("''P1'","UPCASE") !GIVEN TYPE -$ IF L0 .EQS. F$EXTRACT(0,L1,"NCOMPILE") THEN PNAM="NCOMP" !COMPILE -$ IF L0 .EQS. F$EXTRACT(0,L1,"NLINK") THEN PNAM="NLINK" !LINK -$ IF L0 .EQS. F$EXTRACT(0,L1,"NDELETE") THEN PNAM="NDEL" !DELETE -$ IF L0 .EQS. F$EXTRACT(0,L1,"NGET") THEN PNAM="NGET" !GET FROM LIBRARY -$ IF L0 .EQS. F$EXTRACT(0,L1,"NNET") THEN PNAM="NNET" !GET FROM NET -$ IF L0 .EQS. F$EXTRACT(0,L1,"NXREF") THEN PNAM="NXREF" !XREF -$ IF PNAM .EQS. "" !ERROR -$ THEN -$ @WNG:NHELP 1 "''P1'" "''EXT'" !HELP TEXT -$ GOTO EXEX -$ ENDIF -$ PCOD=F$EXTRACT(0,2,PNAM) !PROGRAM CODE -$!# -$!# See if Help -$!# -$ HLP: IF P2+P3+P4+P5+P6+P7+P8 .EQS. "" !NO CODES -$ THEN -$ L0="-"+CODES+"Q("+QUAL+")" -$ READ/TIME=90/END=EXEX/ERROR=EXEX - - /PROMPT="Codes (''L0') [?]: " SYS$COMMAND P2 !GET CODES -$ IF P2 .EQS. "" .OR. P2-"?" .NES. P2 -$ THEN -$ P2="" -$ @WNG:NHELP 2 'PNAM' !HELP -$ GOTO HLP !RETRY -$ ENDIF -$ P2="-"+P2 !MAKE SURE - -$ ENDIF -$ ENDIF -$!# -$!# Read line -$!# -$ IF INTAT .EQS. "X2" THEN - !OPEN FILE - OPEN/READ/ERROR=EXEX FX2'PID''DEP' 'P7' -$ RLIN: IF INTAT .EQS. "X2" !READ LINE -$ THEN -$ READ/ERROR=EXEX/END=EXEX FX2'PID''DEP' L1 !GET LINE -$ IF F$EXTRACT(0,1,L1) .EQS. "#" THEN GOTO RLIN !UNIX COMMAND -$ IF F$EXTRACT(0,1,L1) .EQS. "$" -$ THEN -$ IF F$EXTRACT(0,2,L1) .EQS. "$$" !CHECK IF CORRECT -$ THEN -$ IF F$EDIT(F$EXTRACT(0,5,L1),"UPCASE") .EQS. "$$''PCOD'$" -$ THEN -$ SPAWN/NOLOG 'F$EXTRACT(5,-1,L1)' !DO COMMAND -$ ENDIF -$ ELSE -$ SPAWN/NOLOG 'F$EXTRACT(1,-1,L1)' !DO DCL COMMAND -$ ENDIF -$ GOTO RLIN -$ ENDIF -$ L1=F$EDIT(L1,"UPCASE,UNCOMMENT") !GET FILE NAME -$ L1=F$EDIT(L1,"TRIM") -$ IF L1 .EQS. "" THEN GOTO RLIN !EMPTY LINE -$ L0=1 !SPLIT IN FIELDS -$ LP8: L0=L0+1 -$ P'L0'=F$ELEMENT(L0-2," ",L1) !GET CODES ETC -$ IF P'L0' .EQS. " " THEN P'L0'="" -$ IF L0 .LT. 8 THEN GOTO LP8 -$ ENDIF -$ IF INTAT .EQS. "X1" !MAKE ARGUMENTS -$ THEN -$ P2="''P7'" !SET FILENAMES -$ P3="''P8'" !AND CODES -$ L0=3 !SPLIT IN FIELDS -$ LP9: L0=L0+1 -$ P'L0'="" -$ IF L0 .LT. 8 THEN GOTO LP9 -$ ENDIF -$!# -$!# Get codes and filenames -$!# -$ A0="" !NO CODES -$ FNAM="" !NO NAMES -$ L0=1 !ARG. COUNT -$ LP10: L0=L0+1 -$ IF P'L0' .NES. "" !NOT EMPTY -$ THEN -$ IF F$EXTRACT(0,1,P'L0') .EQS. "-" .OR. - !CODE - F$EXTRACT(0,1,P'L0') .EQS. "+" .OR. - - F$EXTRACT(0,1,P'L0') .EQS. "<" -$ THEN -$ A0=A0+P'L0' !SET CODE -$ ELSE -$ IF FNAM .NES. "" THEN FNAM=FNAM+"," !SET FILE NAME -$ FNAM=FNAM+P'L0' -$ ENDIF -$ ENDIF -$ IF L0 .LT. 8 THEN GOTO LP10 !MORE -$ IF INTAT .EQS. "X2" THEN FNAM=F$ELEMENT(0,",",FNAM) !LIMIT TO ONE NAME -$ IF INTAT .EQS. "X0" !INTERACTIVE -$ THEN -$ A0="-"+'PCOD'C_D+"-"+F$TRNLNM("''PCOD'_COD")+"-"+A0 !ADD DEFAULTS -$ UTELL "-----" -$ UTELL "---- ''PNAM' ''A0' ''FNAM'" !LOG WHAT -$ UTELL "-----" -$ GOSUB NXANAL !ANALYZE CODES -$ ENDIF -$ IF INTAT .EQS. "X1" .AND. "''A0'" .NES. "" THEN - !ANALYZE EXTRA - GOSUB NXANAL -$!# -$!# Interpret codes -$!# -$ IF VQ_D .NES. "" .AND. - - F$LOCATE("X",VQ_D) .EQ. F$LENGTH(VQ_D) .AND. - - F$LOCATE("x",VQ_D) .EQ. F$LENGTH(VQ_D) -$ THEN -$ VER=F$VERIFY(1) !SET VERIFY -$ ELSE -$ VER=F$VERIFY(0) !NO VERIFY -$ ENDIF -$!# -$!# Network info -$!# -$ IF INTAT .EQS. "X0" !INTERACTIVE -$ THEN -$ IF PNAM .EQS. "NNET" -$ THEN -$ IF CD_A .EQS. "0" .OR. "''WNG_NODE'" .EQS. "" !DO ASK -$ THEN -$ L0="" -$ LP20: IF "''L0'" .EQS. "" -$ THEN -$ READ/TIME=90/END=EXEX/ERROR=EXEX - - /PROMPT="Node [''WNG_NODE']: " SYS$COMMAND L0 -$ IF "''L0'" .EQS. "" THEN L0="''WNG_NODE'" -$ WNG_NODE="''L0'" -$ GOTO LP20 -$ ENDIF -$ ENDIF -$ IF CD_A .EQS. "0" .OR. "''WNG_NODEDIR'" .EQS. "" !DO ASK -$ THEN -$ L0="" -$ LP21: IF "''L0'" .EQS. "" -$ THEN -$ READ/TIME=90/END=EXEX/ERROR=EXEX - - /PROMPT="Remote base directory [''WNG_NODEDIR']: " - - SYS$COMMAND L0 -$ IF "''L0'" .EQS. "" THEN L0="''WNG_NODEDIR'" -$ WNG_NODEDIR="''L0'" -$ GOTO LP21 -$ ENDIF -$ ENDIF -$ IF CD_A .EQS. "0" .OR. "''WNG_NODEUSER'" .EQS. "" !DO ASK -$ THEN -$ L0="" -$ LP22: IF "''L0'" .EQS. "" -$ THEN -$ READ/TIME=90/END=EXEX/ERROR=EXEX - - /PROMPT="Remote user [''WNG_NODEUSER']: " - - SYS$COMMAND L0 -$ IF "''L0'" .EQS. "" THEN L0="''WNG_NODEUSER'" -$ WNG_NODEUSER="''L0'" -$ GOTO LP22 -$ ENDIF -$ ENDIF -$!# -$!# Network password -$!# -$ IF F$ELEMENT(1," ","''WNG_NODEUSER'") .EQS. " " -$ THEN !NO PASSWORD GIVEN -$ SET TERM/NOECHO -$ READ/TIME=90/END=EXEX/ERROR=EXEX - - /PROMPT="Password: " SYS$COMMAND L0 !GET PASSWORD -$ SET TERM/ECHO -$ TELL " " -$ WNG_NODEUSER="''WNG_NODEUSER' ''L0'" !SET PASSWORD -$ ENDIF -$ ENDIF -$!# -$!# Compiler info -$!# -$ IF CD_B .EQS. "1" THEN BQ_D=BQ_D+"/LOG=''PNAM'.LOG/PRINT" !BATCH LOG -$ IF CD_D .NES. "-" THEN FQ_D=FQ_D+"/DEBUG/WARN=NOGEN" !DEBUG FORTRAN -$ IF CD_D .NES. "-" THEN CQ_D=CQ_D+"/DEBUG" !DEBUG C -$ IF CD_D .NES. "-" THEN MQ_D=MQ_D+"/DEBUG" !DEBUG MACRO -$ IF CD_D .NES. "-" THEN LQ_D=LQ_D+"/DEBUG" !LINK DEBUG -$ IF CD_X .NES. "-" THEN FQ_D=FQ_D+"/CROSS" !FORTRAN XREF -$ IF CD_X .NES. "-" THEN CQ_D=CQ_D+"/CROSS" !C XREF -$ IF CD_X .NES. "-" THEN MQ_D=MQ_D+"/CROSS" !MACRO XREF -$ IF CD_X .NES. "-" THEN LQ_D=LQ_D+"/CROSS/FULL" !LINK XREF -$ IF CD_O .NES. "-" THEN FQ_D=FQ_D+"/OPTIM" !FORTRAN OPTIMIZE -$ IF CD_O .EQS. "-" THEN FQ_D=FQ_D+"/NOOPTIM" !FORTRAN NOOPTIMIZE -$ IF CD_O .NES. "-" THEN CQ_D=CQ_D+"/OPTIM" !C OPTIMIZE -$ IF CD_O .EQS. "-" THEN CQ_D=CQ_D+"/NOOPTIM" !C NOOPTIMIZE -$ ENDIF -$!# -$!# Format qualifiers -$!# -$!# -$!# Create libraries -$!# -$ IF CD_L .NES. "-" !NEED LIBRARY -$ THEN -$ IF F$SEARCH("''WNG_OLB'''L_D'.OLB") .EQS. "" THEN - - LIBRARY/CREATE 'WNG_OLB''L_D'.OLB !CREATE .OLB -$ IF F$SEARCH("''WNG_TLB'''L_D'.TLB") .EQS. "" THEN - - LIBRARY/CREATE/TEXT 'WNG_TLB''L_D'.TLB !CREATE .TLB -$ IF F$SEARCH("''WNG_TLB'''L_D'_AX.TLB") .EQS. "" THEN - - LIBRARY/CREATE/TEXT 'WNG_TLB''L_D'_AX.TLB !CREATE .TLB -$ IF F$SEARCH("''WNG_OLB'''L_D'.OLB") .EQS. "" .OR. - - F$SEARCH("''WNG_TLB'''L_D'.TLB") .EQS. "" .OR. - - F$SEARCH("''WNG_TLB'''L_D'_AX.TLB") .EQS. "" -$ THEN -$ TELL "" -$ TELL "Illegal Library name. Probably illegal L<name> specified" -$ UTELL "Illegal Library name. Probably illegal L<name> specified" -$ TELL "" -$ GOTO EXEX -$ ENDIF -$ ENDIF -$!# -$!# DWARF data -$!# -$ IF INTAT .EQS. "X0" !INTERACTIVE -$ THEN -$ IF CD_S .NES. "-" .AND. PCOD .EQS. "NL" -$ THEN !NEED DWARF -$ IF F$TRNLNM("EXEDWARF") .EQS. "" .OR. - - F$TRNLNM("LIBDWARF") .EQS. "" !CANNOT DWARF -$ THEN -$ CD_S="-" !NO SHARED DWARF -$ ENDIF -$ ENDIF -$!# -$!# Get files if none -$!# -$ FIL: IF FNAM .EQS. "" !NO FILENAMES -$ THEN -$ READ/TIME=90/END=EXEX/ERROR=EXEX - - /PROMPT="Filename[,...] [?]: " SYS$COMMAND FNAM !GET NAMES -$ IF FNAM .EQS. "" -$ THEN -$ @WNG:NHELP 3 'PNAM' !SHOW HELP -$ GOTO FIL -$ ENDIF -$ ENDIF -$ ENDIF -$!# -$!# Do batch if asked -$!# -$ IF INTAT .EQS. "X0" !PREPARE BATCH -$ THEN -$ FG_CD="" !PREPARE CODES -$ FG_CX="" -$ L0=0 !DEFINE ALL CODES -$ LP11: FG_CD=FG_CD+CD_'F$EXTRACT(L0,1,CODES)' -$ L0=L0+1 -$ IF L0 .LT. F$LENGTH(CODES) THEN GOTO LP11 -$ L0=0 !EXTENDED CODES -$ LP12: L1='F$EXTRACT(L0,1,CODEX)'_D -$ IF L1 .EQS. "" THEN L1="-" -$ IF FG_CX .NES. "" THEN FG_CX=FG_CX+" " -$ FG_CX=FG_CX+L1 -$ L0=L0+1 -$ IF L0 .LT. F$LENGTH(CODEX) THEN GOTO LP12 -$ L0=0 !EXPORT QUALIFIERS -$ LP13: 'F$EXTRACT(L0,1,QUAL)'Q_DX='F$EXTRACT(L0,1,QUAL)'Q_D -$ L0=L0+1 -$ IF L0 .LT. F$LENGTH(QUAL) THEN GOTO LP13 -$ IF CD_B .NES. "-" !BATCH ASKED -$ THEN -$ IF CD_B .EQS. "2" !SPAWN -$ THEN -$ SPAWN/NOWAIT/OUTPUT=SPAWN.LOG - - @WNG:NXEC X1 'PNAM' 'PCOD' 'DEP' "''FG_CD'" "''FG_CX'" - - "''FNAM'" !SPAWN -$ IF .NOT.$SEVERITY -$ THEN -$ TELL "" -$ TELL "Cannot spawn the ''PNAM' task" -$ UTELL "Cannot spawn the ''PNAM' task" -$ TELL "" -$ ENDIF -$ ELSE -$ L0="" -$ CLOSE/ERROR=GB21 F'PID''DEP' !BATCH -$ GB21: OPEN/WRITE/ERROR=GB22 F'PID''DEP' 'PNAM''PID''DEP'.TMP -$ WRITE/ERROR=GB22 F'PID''DEP' "$ !'F$VERIFY(''F$VERIFY()')'" -$ WRITE/ERROR=GB22 F'PID''DEP' - - "$ SET DEFAULT ''F$ENVIRONMENT("DEFAULT")'" !SET -$ L00=0 !SAVE QUALIFIERS -$ LP16: L01='F$EXTRACT(L00,1,QUAL)'Q_DX !QUAL. -$ WRITE/ERROR=GB22 F'PID''DEP'' - - "$ ''F$EXTRACT(L00,1,QUAL)'Q_DX="+ - - """''L01'""" -$ L00=L00+1 -$ IF L00 .LT. F$LENGTH(QUAL) THEN GOTO LP16 -$ WRITE/ERROR=GB22 F'PID''DEP' "$ @WNG:NXEC X1 ''PNAM' "+ - - "''PCOD' ''DEP' ""''FG_CD'"" ""''FG_CX'"" "+ - - """''FNAM'""" !DO -$ CLOSE/ERROR=GB22 F'PID''DEP' -$ L0="''PNAM'''PID'''DEP'.TMP" -$ L0=F$SEARCH("''L0'") -$ IF L0 .NES. "" THEN SUBMIT'BQ_D' 'L0'/DELETE !SUBMIT -$ L1=$SEVERITY -$ IF L1 .AND. L0 .NES. "" THEN GOTO EXEX !SUBMITTED -$ GB22: IF L0 .NES. "" THEN DELETE 'L0' !DELETE -$ TELL "" -$ TELL "Cannot submit the ''PNAM' task" -$ UTELL "Cannot submit the ''PNAM' task" -$ TELL "" -$ ENDIF -$ GOTO EXEX -$ ENDIF -$ ENDIF -$ IF INTAT .EQS. "X2" .AND. "''A0'" .NES. "" !LOCAL SWITCHES -$ THEN -$ @WNG:NXEC X1 'PNAM' 'PCOD' 'DEP' "''FG_CD'" "''FG_CX'" - - "''FNAM'" "''A0'" !DO -$ FNAM="" !SET DONE -$ ENDIF -$!# -$!# Execute -$!# -$ IF VQ_D .NES. "" .AND. - - (F$LOCATE("X",VQ_D) .LT. F$LENGTH(VQ_D) .OR. - - F$LOCATE("x",VQ_D) .LT. F$LENGTH(VQ_D)) -$ THEN -$ VER=F$VERIFY(1) !SET VERIFY -$ ELSE -$ VER=F$VERIFY(0) !NO VERIFY -$ ENDIF -$ IF INTAT .NES. "X0" .AND. CD_Y .EQS. "-" !BATCH EXECUTION -$ THEN -$ B_AA="-" !PREPARE OUTPUT -$ B_AB="-" -$ B_AC="-" -$ L0=0 !SET QUALIFIERS -$ LP14: B_AA=B_AA+"Q"+F$EXTRACT(L0,1,QUAL)+"<"+ - - 'F$EXTRACT(L0,1,QUAL)'Q_D+">" -$ L0=L0+1 -$ IF L0 .LT. F$LENGTH(QUAL) THEN GOTO LP14 -$ L0=0 !SET CODES -$ LP15: L1=F$EXTRACT(L0,1,CODES) -$ IF CD_'L1' .NES. "-" !CODE SET -$ THEN -$ B_AB=B_AB+L1+CD_'L1' !SET CODE -$ IF CODEX-L1 .NES. CODEX !EXTENDED -$ THEN -$ B_AC=B_AC+L1+CD_'L1'+"<"+'L1'_D+">" -$ ENDIF -$ ENDIF -$ L0=L0+1 -$ IF L0 .LT. F$LENGTH(CODES) THEN GOTO LP15 -$ TELL " " -$ TELL "Command: ''PNAM' ''B_AB'" -$ TELL " ''B_AC'" -$ TELL " ''B_AA'" -$ TELL " ''FNAM'" -$ TELL " " -$ ENDIF -$!# -$!# Do all files -$!# -$ L0=-1 !COUNT FILES -$ EXE1: L0=L0+1 !NEXT FILE -$ L1="" !NOT INDIRECT -$ LOB=F$ELEMENT(L0,",",FNAM) !GET NAME -$ IF LOB .EQS. "" THEN GOTO EXE1 !EMPTY, NEXT -$ IF LOB .EQS. "," !READY -$ THEN -$ IF INTAT .EQS. "X2" THEN GOTO RLIN !READ NEXT LINE -$ GOTO EXEX !REAL READY -$ ENDIF -$ IF F$EXTRACT(0,1,LOB) .EQS. "@" !INDIRECT -$ THEN -$ LOB=LOB-"@" !DELETE @ -$ L1="@" !SET INDIRECT -$ LOB=F$PARSE(LOB,".GRP;0",,,"SYNTAX_ONLY") !GET FULL FILE NAME -$ ELSE -$ IF PCOD .EQS. "NL" -$ THEN -$ LOB=F$PARSE(LOB,".EXE;0",,,"SYNTAX_ONLY") !GET FULL FILE NAME -$ ELSE -$ LOB=F$PARSE(LOB,".*;0",,,"SYNTAX_ONLY") !GET FULL FILE NAME -$ ENDIF -$ ENDIF -$ IF LOB .EQS. "" THEN GOTO EXE1 !FORMAT ERROR -$ L5="" !CHECK SINGLE FILE -$ L6="N" !CHECK SEEN -$ EXE4: L3=F$SEARCH(LOB,L0) !FIND FILE -$ EXE5: IF L3 .EQS. "" .OR. - - F$PARSE(L3,,,"NAME","SYNTAX_ONLY")+ - - F$PARSE(L3,,,"TYPE","SYNTAX_ONLY") .EQS. - - F$PARSE(L5,,,"NAME","SYNTAX_ONLY")+ - - F$PARSE(L5,,,"TYPE","SYNTAX_ONLY") .OR. - - (PCOD .EQS. "NG" .AND. LOB-"*"-"%" .NES. LOB) !NOT FOUND -$ THEN -$ IF L6 .OR. L1 .NES. "" THEN GOTO EXE1 !BUT ONE DONE -$ IF PCOD .EQS. "ND" .OR. PCOD .EQS. "NN" .OR. PCOD .EQS. "NC" -$ THEN -$ IF LOB-"*"-"%" .NES. LOB THEN GOTO EXE1 !NONE DEFINED -$ L3=LOB !TRY ANYWAY -$ ENDIF -$ IF PCOD .EQS. "NG" !NGET -$ THEN -$ IF LOB-"*"-"%" .NES. LOB !GET LIST FIRST -$ THEN -$ L00=F$PARSE(LOB,,,"NAME","SYNTAX_ONLY")+ - - F$PARSE(LOB,,,"TYPE","SYNTAX_ONLY") -$ SET MESSAGE /NOIDEN/NOFACIL/NOSEVER/NOTEXT -$ ASSIGN/USER NL: SYS$OUTPUT -$ LIBRARY/TEXT/LIST=L'PID''DEP'.TMP/ONLY=('L00') 'WNG_TLB''L_D' !LIST -$ L00=$SEVERITY !FOR CHECK -$ SET MESSAGE /IDEN/FACIL/SEVER/TEXT -$ IF .NOT.L00 .OR. F$SEARCH("L''PID'''DEP'.TMP") .EQS. "" !ERROR -$ THEN -$ IF F$SEARCH("L''PID'''DEP'.TMP") .NES. "" THEN - -$ DELETE L'PID''DEP'.TMP;* -$ ELSE -$ @WNG:NXEC X2 'PNAM' 'PCOD' 'DEP' "''L00'" "''FG_CX'" - - "L''PID'''DEP'.TMP" !DO AS LIST -$ ENDIF -$ GOTO EXE1 !CONTINUE -$ ELSE -$ L3=LOB !DO ONE -$ ENDIF -$ ENDIF -$ IF PCOD .EQS. "NL" !NLINK -$ THEN -$ IF F$PARSE(LOB,,,"TYPE","SYNTAX_ONLY") .EQS. ".EXE" .OR. - - F$PARSE(LOB,,,"TYPE","SYNTAX_ONLY") .EQS. "." -$ THEN -$ L3=F$PARSE(LOB,,,"NAME","SYNTAX_ONLY")+".EXE" !LINK AT LEAST ONE -$ ELSE -$ GOTO EXE1 !NONE -$ ENDIF -$ ENDIF -$ GOSUB NX1 !DO A FILE -$ IF F$SEARCH("L''PID'''DEP'.TMP") .NES. "" THEN - - DELETE/NOLOG L'PID''DEP'.TMP;* !DELETE FOR NGET -$ GOTO EXE1 !NEXT FILE SPEC. -$ ENDIF -$ L5=L3 !CHECK -$ L4=L1 -$ IF L1 .EQS. "" .AND. F$PARSE(L3,,,"TYPE","SYNTAX_ONLY") .EQS. ".GRP" - - .AND. CD_Z .NES. "" THEN L4="@" !INDIR -$ IF PCOD .EQS. "NL" .AND. L4 .EQS. "" .AND. - - F$PARSE(L3,,,"TYPE","SYNTAX_ONLY") .NES. ".EXE" - - THEN GOTO EXE4 !SKIP FOR NLINK -$ IF PCOD .EQS. "NG" .AND. L4 .EQS. "" .AND. - - LOB-"*"-"%" .NES. LOB !GET LIST FIRST -$ THEN -$ L3="" !FORCE LIST -$ GOTO EXE5 !DO LIST -$ ENDIF -$ L3="''L4'''L3'" !MAKE FULL NAME -$ GOSUB NX1 !DO: TYPE, FILE -$ L6="Y" !AT LEAST ONE DONE -$ GOTO EXE4 !NEXT FILE -$!# -$!# Routines -$!# -$ ! -$ ! Analyze codes -$ ! -$ NXANAL: -$ GC1A: L1="Y" !NO N SEEN -$ GC14: IF A0 .EQS. "" THEN RETURN !READY -$ L2=F$EXTRACT(0,1,A0) !CODE -$ IF L2 .EQS. "<" THEN GOSUB GA0 !SKIP <> -$ IF L2 .EQS. "<" THEN GOTO GC10 !CONTINUE -$ A0=A0-L2 !DELETE CODE -$ IF L2 .EQS. "-" THEN GOTO GC1A !SKIP - -$ L2=F$EDIT(L2,"UPCASE") -$ IF L2 .EQS. "N" .OR. L2 .EQS. "+" -$ THEN !NEGATE -$ L1="N" -$ GOTO GC14 -$ ENDIF -$ IF L2 .EQS. "Q" .AND. L1 !QUALIFIER -$ THEN -$ L2=F$EXTRACT(0,1,A0) !QUALIFIER -$ A0=A0-L2 -$ L2=F$EDIT(L2,"UPCASE") -$ IF QUAL-L2 .EQS. QUAL THEN GOTO GC1A !UNKNOWN QUALIFIER -$ GOSUB GA0 !GET QUAL. ARGUMENT -$ IF QUALA-L2 .EQS. QUALA .AND. A1.NES. "" -$ THEN -$ 'L2'Q_D="''A1'" !NOT ADDITIVE -$ ELSE -$ 'L2'Q_D='L2'Q_D+A1 !ADD QUALIFIER DATA -$ ENDIF -$ GOTO GC1A !CONTINUE -$ ENDIF -$ IF CODES-L2 .EQS. CODES THEN GOTO GC1A !UNKNOWN CODE -$ IF L1 -$ THEN -$ CD_'L2'="0" !SET STANDARD CODE -$ ELSE -$ CD_'L2'="-" !SET NO -$ GOTO GC1A -$ ENDIF -$ L0=F$EXTRACT(0,1,A0) !POSSIBLE DIGIT -$ IF "0123456789"-L0 .NES. "0123456789" -$ THEN !DIGIT -$ CD_'L2'=L0 !SET DIGIT -$ A0=A0-L0 !DELETE DIGIT FROM CODE -$ ENDIF -$ IF CODEX-L2 .EQS. CODEX THEN GOTO GC1A !NOT EXTENDED CODE -$ GOSUB GA0 !GET EXTENDED ARG. -$ IF A1 .NES. "" THEN 'L2'_D=A1 !NEW SETTING -$ GOTO GC1A !CONTINUE -$ ! -$ ! Get <string> -$ ! -$ GA0: A1="" !EMPTY RESULT -$ IF F$LENGTH("''A0'") .LT. 1 THEN RETURN !NO VALUE -$ IF F$EXTRACT(0,1,A0) .EQS. " " THEN GOTO GA0 !SKIP INIT. SPACE -$ IF F$EXTRACT(0,1,A0) .NES. "<" THEN RETURN !NO VALUE -$ L00=0 !COUNT <> -$ L01=0 !COUNT " -$ GA06: IF A0.EQS. "" !ERROR -$ THEN -$ A1="" -$ RETURN -$ ENDIF -$ L02=F$EXTRACT(0,1,A0) !CHAR. -$ A0=A0-L02 !SKIP CHAR -$ IF L01 .NE. 0 !STRING -$ THEN -$ IF "''L02'" .EQS. """" THEN L01=0 !RESET STRING -$ ELSE -$ IF "''L02'" .EQS. "<" !< -$ THEN -$ L00=L00+1 !COUNT < -$ IF L00 .EQ. 1 THEN GOTO GA06 !NO SAVE -$ ELSE -$ IF "''L02'" .EQS. ">" -$ THEN -$ L00=L00-1 !COUNT > -$ IF L00 .EQ 0 THEN RETURN !READY -$ ELSE -$ IF "''L02'" .EQS. """" THEN L01=1 !INDICATE " -$ ENDIF -$ ENDIF -$ ENDIF -$ A1=A1+L02 !SAVE CHAR -$ GOTO GA06 !CONTINUE -$ ! -$ ! NX1 Do a file. -$ ! -$ NX1: IF F$EXTRACT(0,1,L3) .EQS. "@" .AND. CD_Z .NES. "-" !IND. -$ THEN -$ IF L3-"@" .EQS. GQ_DX THEN L3=L3-"@" !STOP INFINITE LOOP -$ ENDIF -$ IF F$EXTRACT(0,1,L3) .EQS. "@" .AND. CD_Z .NES. "-" !IND. -$ THEN -$ L3=L3-"@" !FILE NAME -$ IF F$SEARCH(L3) .EQS. "" !NOT THERE -$ THEN -$ IF PCOD .NES. "NC" THEN RETURN !CANNOT DO -$ FNM=F$PARSE(L3,,,"NAME","SYNTAX_ONLY") !NAME -$ FTP=F$PARSE(L3,,,"TYPE","SYNTAX_ONLY") !TYPE -$ B0=15-F$LENGTH(FNM)-F$LENGTH(FTP) !MESSAGE POINTER -$ IF B0.LT.1 THEN B0=1 -$ MSGT=F$EXTRACT(0,B0," ") !TEXT -$ B1="Done: " !ASSUME OK -$ @WNG:NGET "''L3'" !TRY TO GET -$ IF F$SEARCH(L3) .EQS. "" THEN RETURN !NOT FOUND -$ ENDIF -$ L00="" !ADD Y -$ L01=0 -$ LP17: IF F$EXTRACT(L01,1,CODES) .EQS. "Y" -$ THEN -$ L00=L00+"0" -$ ELSE -$ L00=L00+CD_'F$EXTRACT(L01,1,CODES)' -$ ENDIF -$ L01=L01+1 -$ IF L01 .LT. F$LENGTH(CODES) THEN GOTO LP17 -$ GQ_DX="''L3'" !SAVE CURRENT NAME -$ @WNG:NXEC X2 'PNAM' 'PCOD' 'DEP' "''L00'" "''FG_CX'" - - "''L3'" !DO .GRP -$ ELSE -$ L3=L3-"@" !SURE FILE NAME -$ FNM=F$PARSE(L3,,,"NAME","SYNTAX_ONLY") !NAME -$ FTP=F$PARSE(L3,,,"TYPE","SYNTAX_ONLY") !TYPE -$ IF PCOD .NES. "NL" !NO CHECK FOR NLINK -$ THEN -$ IF F$LENGTH(FTP).NE.4 THEN RETURN !SKIP IF NOT 3 CHAR EXT. -$ IF F$LOCATE(FTP+",",CHTP) .LT. F$LENGTH(CHTP) THEN RETURN !FORGET -$ IF PQ_D .NES. "" !PURE GIVEN -$ THEN -$ PQ_D=F$EDIT(PQ_D,"UPCASE") -$ IF F$LOCATE(FTP-".",PQ_D) .EQ. F$LENGTH(PQ_D) THEN RETURN !NOT -$ ENDIF -$ B0=15-F$LENGTH(FNM)-F$LENGTH(FTP) !MESSAGE POINTER -$ ELSE -$ B0=10-F$LENGTH(FNM)-F$LENGTH(FTP) !MESSAGE POINTER -$ ENDIF -$ IF B0.LT.1 THEN B0=1 -$ IF PCOD .EQS. "NC" !MAYBE NGET FIRST -$ THEN -$ MSGT=F$EXTRACT(0,B0," ") !TEXT -$ B1="Done: " !ASSUME OK -$ IF F$SEARCH(L3) .EQS. "" THEN - !NGET FIRST - @WNG:NGET "''L3'" -$ B0=15-F$LENGTH(FNM)-F$LENGTH(FTP) !MESSAGE POINTER -$ ENDIF -$ IF B0.LT.1 THEN B0=1 -$ MSGT=F$EXTRACT(0,B0," ") !TEXT -$ B1="Done: " !ASSUME OK -$ @WNG:'PNAM' "''L3'" !DO -$ ENDIF -$ RETURN !OK -$!# -$!# EXIT -$!# -$ EXEX: SET ON -$ IF INTAT .EQS. "X0" THEN SET TERM/ECHO !MAKE SURE -$ CLOSE/ERROR=EXX1 F'PID''DEP' !MAKE SURE -$ EXX1: CLOSE/ERROR=EXX2 FX2'PID''DEP' !MAKE SURE -$ EXX2: CLOSE/ERROR=EXX3 UP'PID''DEP' -$ EXX3: IF F$SEARCH("L''PID'''DEP'.TMP") .NES. "" THEN - - DELETE L'PID''DEP'.TMP;* -$ L0=F$VERIFY(VER) !RESET VERIFY -$ EXIT diff --git a/src/wng/nxec.ssc b/src/wng/nxec.ssc deleted file mode 100644 index 9edce5152c0e236aae6392c03936b7dd42bd8c03..0000000000000000000000000000000000000000 --- a/src/wng/nxec.ssc +++ /dev/null @@ -1,1655 +0,0 @@ -# nxec.ssc -# WNB 920908 -# -# Revisions: -# WNB 920930 Additions, overhaul, speed up -# WNB 921014 Add -a nnet -# WNB 921015 Change setting of WNG_OLB WNG_EXE -# WNB 921019 Auto nget for ncomp included -# WNB 921104 Typo (" missing); default u_d; fnam check -# WNB 921113 Do postponed ar -# WNB 921116 Add G qualifier and allow multi-level .grp -# WNB 921117 Add regular expressions -# WNB 921130 Stop multiple ar; correct set echo; tr for HP -# WNB 921208 Add date, list of directories; new update log -# WNB 921209 Add logical link test; -a0 switch -# WNB 921211 Add P qualifier -# WNB 921216 Add ## -# WNB 921230 Make SSC -# WNB 930108 Add X11 -# JPH 930225 -qv<x> option to start echo/verify with execution -# include $WNG_LINK in c-dir -# comments -# WNB 930301 Add aliases for # type; add +es for HP; add NSTAR_DIR -# WNB 930325 Cater for different fold -# WNB 930330 Add _ax.tlb; giplib.olb; pgplot.olb -# WNB 930405 Add SPAWN for better control (VAX) -# HjV 930416 Add path for include files for HP -# WNB 930427 More general include path HP -# WNB 930429 Add -lm for SUN; delete pgplot -# HjV 930503 Add -lm for HP; remove -lm for SUN -# WNB 930504 Problem linking NGCALC -# CMV 930906 Switches for SUN in RUG -# WNB 930921 Assume never WNG_OLB/WNG_EXE in VMS -# WNB 930922 WNG_OLB/WNG_EXE recursive calls -# WNB 931213 Proper X11 path -# WNB 931217 Add NCOPY to NSTAR_DIR -# WNB 940124 Add _stlb, _s1tlb -# -# Compile, link, maintain routines. Use as: -# Unix: $WNG/nxec.sun <type> [-<code>] ... [<name>,...] ... [-<code>] ... -# VAX: @WNG:NXEC ... -# -# Type can be: NCOMP Compile -# NLINK Link -# NGET Get from text library -# NXREF Make Fortran crossreference -# NDEL Delete -# NNET Get across net -# See Help (a ? in a parameter) for details. -# -# Uses environment variables: -# WNG where to find wng-type sources -# WNG_TYPE machine (sw, dw, hp, al, cv etc) -# WNG_OLBEXE root of wng-type .olb, .ppd, .exe -# WNG_SITE site (nfra, atnf, rug ...) -# EXEDWARF_UNIX where to find/set DWARF .exe, .ppd -# LIBDWARF where to find DWARF .olb -# and also possible: -# WNG_NODE node name (number) of central node -# WNG_NODEUSER user (or user and pw) at central node -# WNG_NODEDIR WNG-root dir at central node -# (DV:[...] or /.../......) -# NSTAR_DIR Newstar directories -# The following env. variables are optional, to be used to define -# a specific target file system (foreign host or shadow tree). Defaults are -# shown in parentheses, subdir is the name of the source's subdirectory -# under $WNG/.. . -# WNG_EXE (WNG_OLBEXE) parent of .exe target -# WNG_OLB (WNG_OLBEXE) parent of .olb target -# WNG_TLB current directory .tlb target -# WNG_ERR, WNG_LIS current directory .lis, .err target -# WNG_LINK current directory target for .f soft links (must -# be subdir of WNG_EXE, WNG_OLB -# or WNG/..) -# -# Intro -# -#ifdef wn_vax__ -$ SET NOON !DISCARD ERRORS -$ ON CONTROL_Y THEN GOTO EXEX !FINISH NEATLY -$ INTAT="X0" !INTERACTIVE -$ VER=F$VERIFY() !FOR ^Y -$ TELL="WRITE SYS$OUTPUT" !FOR EASE OF USE -$ PID=F$EXTRACT(4,4,F$GETJPI("","PID")) !FOR TMP FILES -$ DEP=1 !FOR INDIRECT -$ IF P1 .EQS. "X1" .OR. P1 .EQS. "X2" !NON-INTERACTIVE -$ THEN -$ INTAT="''P1'" !SET VARIABLES -$ PNAM=P2 -$ PCOD=P3 -$ DEP=P4+1 -$ ENDIF -$ C_DATE=F$EXTRACT(2,2,F$CVTIM(,,"YEAR"))+F$CVTIM(,,"MONTH")+ - - F$CVTIM(,,"DAY") !DATE YYMMDD -$ C_TIME=F$CVTIM(,,"HOUR")+F$CVTIM(,,"MINUTE")+ - - F$CVTIM(,,"SECOND") !TIME HHMMSS -$ C_UPD="UPD''C_DATE'.LOG" !LOG NAME -$ IF F$SEARCH(C_UPD) .EQS. "" !CREATE LOG -$ THEN -$ L1="None" -$ L0=1 -$ LP23: -$ L3=F$SEARCH("UPD%%%%%%.LOG",L0) -$ IF L3 .NES. "" -$ THEN -$ L1=L3 -$ GOTO LP23 -$ ENDIF -$ OPEN/WRITE/ERROR=EXEX UP'PID''DEP' 'C_UPD' -$ WRITE/ERROR=EXEX UP'PID''DEP' "! ''C_UPD' (Previous: ''L1')" -$ CLOSE/ERROR=EXEX UP'PID''DEP' -$ ENDIF -$ UTELL="WRITE UP''PID'''DEP'" -$ OPEN/APPEND/SHARE/ERROR=EXEX UP'PID''DEP' 'C_UPD' !OPEN LOG -$ ! !CURRENT DIRECTORY -$ CWD=F$PARSE(F$ENVIRONMENT("DEFAULT"),,,"DEVICE","NO_CONCEAL")+ - - F$PARSE(F$ENVIRONMENT("DEFAULT"),,,"DIRECTORY","NO_CONCEAL") -$ L0=0 !GET TAIL DIRECTORY -$ LP1: L0=L0+1 -$ L1=F$ELEMENT(L0,"[",CWD) -$ IF L1 .NES. "[" -$ THEN -$ L2="["+L1 -$ GOTO LP1 -$ ENDIF -$ CWDT=L2 -$ L0=0 -$ LP2: L0=L0+1 -$ L1=F$ELEMENT(L0,".",L2) -$ IF L1 .NES. "." -$ THEN -$ CWDT="["+L1 -$ GOTO LP2 -$ ENDIF -$ ! -$ ASSIGN="ASSIGN" !MAKE SURE PROPER USE -$ CONVERT="CONVERT" -$ COPY="COPY" -$ CREATE="CREATE" -$ DELETE="DELETE" -$ DIR="DIRECTORY" -$ FORTRAN="FORTRAN" -$ LIBRARY="LIBRARY" -$ LINK="LINK" -$ MACRO="MACRO" -$ PURGE="PURGE" -$ SET="SET" -$ SHOW="SHOW" -$ SPAWN="SPAWN" -$ SUBMIT="SUBMIT" -#else - onintr exex # finish neatly - set intat=x0 # assume interactive - if ($?echo) unset echo # no verify - if ($?verbose) unset verbose # no verbose - set pid=$$ ; @ dep=1 # for tmp files - set Upc="ABCDEFGHIJKLMNOPQRSTUVWXYZ" # for translation - set Lowc="abcdefghijklmnopqrstuvwxyz" - set l1=(`echo a | fold -w1`) # check which fold - set l2=(`echo a | fold -w 1`) - if ( "$l1" == "a") then - set fold="fold -w" - else if ("$l2" == "a") then - set fold="fold -w " - else - set fold="fold -" - endif - if ($#argv > 5) then # maybe batch - if ("$1" =~ x[12]) then # batch - set intat=$1 ; shift # indicate batch - set pnam=$1; shift # set variables - set pcod=$1; shift - @ dep=$1 + 1; shift - endif - endif - set loo=(`date`) # get date/time - if ("$loo[3]" =~ [1-9]) set loo[3] = "0$loo[3]" # day - set loa=( Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec) - foreach mm ( 01 02 03 04 05 06 07 08 09 10 11 12) - if ("$loo[2]" == "$loa[$mm]") break # month - end - @ yy = $loo[$#loo] - 1900 # year - set c_date="$yy$mm$loo[3]" # date yymmdd - set c_time=`echo $loo[4] | tr -d ":"` # time hhmmss - set c_upd="UPD${c_date}.LOG" # log name - if (! -e $c_upd) then # create log - touch $c_upd - set loo=(`ls UPD*.LOG`) - while ($#loo > 2) - shift loo - end - if ($#loo < 2) set loo=("None") - echo "! $c_upd (Previous: $loo[1])" >>! $c_upd - endif -#endif -# -# Check environment -# -#ifdef wn_vax__ -$ IF INTAT .EQS. "X0" !INTERACTIVE -$ THEN -$ IF F$TRNLNM("WNG") .EQS. "" .OR. F$TRNLNM("WNG_OLBEXE") .EQS. "" - - .OR. "''WNG_TYPE'" .EQS. "" .OR. "''WNG_SITE'" .EQS. "" -$ THEN -$ TELL " Error: Must have logicals WNG, WNG_OLBEXE and globals" -$ TELL " WNG_TYPE, WNG_SITE defined" -$ UTELL " Error: Must have logicals WNG, WNG_OLBEXE and globals" -$ UTELL " WNG_TYPE, WNG_SITE defined" -$ GOTO EXEX -$ ENDIF -$ IF F$TRNLNM("EXEDWARF") .EQS. "" .OR. - - F$TRNLNM("LIBDWARF") .EQS. "" .OR. - - F$TRNLNM("RUNDWARF") .EQS. "" -$ THEN -$ TELL " Warning: Cannot do everything with EXEDWARF and/or" -$ TELL " LIBDWARF and/or RUNDWARF not defined" -$ UTELL " Warning: Cannot do everything with EXEDWARF and/or" -$ UTELL " LIBDWARF and/or RUNDWARF not defined" -$ ENDIF -$ IF "''WNG_NODE'" .EQS. "" THEN WNG_NODE="" !DEFINE -$ IF "''WNG_NODEDIR'" .EQS. "" THEN WNG_NODEDIR="" -$ IF "''WNG_NODEUSER'" .EQS. "" THEN WNG_NODEUSER="" -$ WNG_EXE=F$PARSE(F$TRNLNM("WNG_OLBEXE"),,,"DEVICE","NO_CONCEAL")+ - - F$PARSE(F$TRNLNM("WNG_OLBEXE"),"''CWDT'",, - - "DIRECTORY","NO_CONCEAL") -$ WNG_OLB=F$PARSE(F$TRNLNM("WNG_OLBEXE"),,,"DEVICE","NO_CONCEAL")+ - - F$PARSE(F$TRNLNM("WNG_OLBEXE"),"''CWDT'",, - - "DIRECTORY","NO_CONCEAL") -$ IF "''WNG_TLB'" .EQS. "" THEN - - WNG_TLB="''CWD'" -$ IF "''WNG_ERR'" .EQS. "" THEN - - WNG_ERR="''CWD'" -$ IF "''WNG_LIS'" .EQS. "" THEN - - WNG_LIS="''CWD'" -$ IF "''WNG_LINK'" .EQS. "" THEN - - WNG_LINK="''CWD'" -$ IF "''NSTAR_DIR'" .EQS. "" THEN - - NSTAR_DIR="WNG,DWARF,NSCAN,NCOPY,NMAP,NPLOT" -$ IF F$PARSE("''WNG_EXE'") .EQS. "" THEN - ! MAKE DIRECTORIES - CREATE/DIR 'WNG_EXE' -$ IF F$PARSE("''WNG_OLB'") .EQS. "" THEN - - CREATE/DIR 'WNG_OLB' -$ IF F$PARSE("''WNG_TLB'") .EQS. "" THEN - - CREATE/DIR 'WNG_TLB' -$ IF F$PARSE("''WNG_ERR'") .EQS. "" THEN - - CREATE/DIR 'WNG_ERR' -$ IF F$PARSE("''WNG_LIS'") .EQS. "" THEN - - CREATE/DIR 'WNG_LIS' -$ IF F$PARSE("''WNG_LINK'") .EQS. "" THEN - - CREATE/DIR 'WNG_LINK' -$ IF F$TRNLNM("WNG_TLD") .EQS. "" .AND. - ! NO LOGICAL DEFINITIONS - F$SEARCH("WNG:NXLDEF.COM") .NES. "" THEN - - @WNG:NXLDEF.COM ! GET LOGICAL LINKS -$ ENDIF -$ C_DIR="''NSTAR_DIR'" !N DIRECTORIES -$ IF F$PARSE("[-.NCOPY]") .NES. "" .AND. - - F$LOCATE("NCOPY",NSTAR_DIR) .EQ. F$LENGTH(NSTAR_DIR) THEN - - C_DIR=C_DIR+",NCOPY" -#else - if ($USER == jph) then # set shadow system - set c_shadow - endif -# - if ("$intat" == "x0") then - if (! $?WNG || ! $?WNG_TYPE || ! $?WNG_OLBEXE ||\ - ! $?WNG_SITE) then - echo " Error: Must have environment variables" \ - | tee -a $c_upd - echo " WNG, WNG_TYPE, WNG_OLBEXE , WNG_SITE defined" \ - | tee -a $c_upd - goto exex - endif - if (! $?EXEDWARF_UNIX || ! $?LIBDWARF) then - echo " Warning: Cannot do everything with EXEDWARF_UNIX and/or" \ - | tee -a $c_upd - echo " LIBDWARF not defined" \ - | tee -a $c_upd - endif - if (! $?WNG_NODE) setenv WNG_NODE "" # node info - if (! $?WNG_NODEDIR) setenv WNG_NODEDIR "" - if (! $?WNG_NODEUSER) setenv WNG_NODEUSER "" - if ($?WNG_EXE) then # save original - set wng_sexe=$WNG_EXE - else - setenv WNG_EXE $WNG_OLBEXE # make names - endif - setenv WNG_EXE $WNG_EXE/$cwd:t - if ($?WNG_OLB) then # save original - set wng_solb=$WNG_OLB - else - setenv WNG_OLB $WNG_OLBEXE - endif - setenv WNG_OLB $WNG_OLB/$cwd:t - if ($?WNG_TLB) then # save original - set wng_stlb=$WNG_TLB - else - setenv WNG_TLB $cwd/.. - endif - setenv WNG_TLB $WNG_TLB/$cwd:t - if (! $?WNG_ERR) setenv WNG_ERR $cwd - if (! $?WNG_LIS) setenv WNG_LIS $cwd - if (! $?WNG_LINK) setenv WNG_LINK $cwd - if (! $?NSTAR_DIR) setenv NSTAR_DIR "wng dwarf nscan ncopy nmap nplot" - if (! -e $WNG_EXE) mkdir $WNG_EXE # make directories - if (! -e $WNG_OLB) mkdir $WNG_OLB - if (! -e $WNG_TLB) mkdir $WNG_TLB - if (! -e $WNG_ERR) mkdir $WNG_ERR - if (! -e $WNG_LIS) mkdir $WNG_LIS - if (! -e $WNG_LINK) mkdir $WNG_LINK - if (! -e WNG_DEF && -e $WNG/nxldef.sun) then # get links - source $WNG/nxldef.sun - endif - endif - set c_dir=($NSTAR_DIR) # N directories - if (-d $WNG/../ncopy && "$c_dir" !~ *ncopy*) set c_dir = ($c_dir ncopy) - set tmp=$WNG_LINK # $WNG_LINK:t not allwd - if ("$c_dir" !~ *"$tmp:t"*) set c_dir=($c_dir $tmp:t) # add WNG_LINK -#endif -# -# External environment -# -#ifdef wn_vax__ -$ EXT="''WNG_TYPE'" ! MACHINE TYPE -$ LNK_DEF="WNG_OLBEXE:[NSCAN]WNLIB.OLB/LIB"+ - - ",WNG_OLBEXE:[NMAP]WNLIB.OLB/LIB"+ - - ",WNG_OLBEXE:[NPLOT]WNLIB.OLB/LIB" -$ IF F$SEARCH("WNG_OLBEXE:[WNG]GIPLIB.OLB") .NES. "" THEN - - LNK_DEF=LNK_DEF+",WNG_OLBEXE:[WNG]GIPLIB.OLB" -$ LNK_DEF=LNK_DEF+ - - ",WNG_OLBEXE:[WNG]WNLIB.OLB/LIB" !DEFAULT LIBRARIES -$ LNK_USE="" -$ IF F$TRNLNM("WNG_LDFILES") .NES. "" THEN - - LNK_USE="''F$TRNLNM("WNG_LDFILES")'" -$ FORTRAN="FORTRAN" !FORTRAN COMPILER -$ XFORT="" -$ LFORT="/F77/EXTEND/I4/SHOW=(NODICT,NOINCL,MAP,NOPREP,NOSIN)"+ - - "/DEBUG/OPTIM" !LINK FORTRAN -$ CEE="" !C COMPILER -$ XCEE="" -$ ASSEM="MACRO" !ASSEMBLER -$ XASSEM="" -#else - set ext=$WNG_TYPE # Machine type - set lnk_def=($WNG_OLBEXE/nscan/wnlib.olb \ - $WNG_OLBEXE/nmap/wnlib.olb \ - $WNG_OLBEXE/nplot/wnlib.olb) - if (-e $WNG_OLBEXE/wng/giplib.olb) then - set lnk_def=($lnk_def $WNG_OLBEXE/wng/giplib.olb) - if ("$ext" == "hp") then - set lnk_def=($lnk_def -lm) - endif - endif - set lnk_def=($lnk_def $WNG_OLBEXE/wng/wnlib.olb \ - -L/usr/local/X11/lib -lX11) # default libraries - if ($?WNG_LDFILES) then - set lnk_use=($WNG_LDFILES) # user libraries - else - set lnk_use="" - endif - set fortran=f77 ; set xfort="" ; set lfort="" # Fortran compiler - set cee=cc ; set xcee="" # C compiler - set assem=as ; set xassem="" # Assembler -#endif -# -# nxec environment -# -#ifdef wn_vax__ -$ CHTP=".DIR,.ERR,.EXE,.HLB,.JOU,.LIS,.LOG,.LST,.MAP,.MLB,"+ - - ".NEW,.NPD,.OBJ,.OLB,.OLD,.PPD,.TLB,.TMP,"+ - - ".UDF,.ULB," !FILES TO SKIP -$ CODES="ABCDLOPSUXYZ" !KNOWN CODES -$ CODEX="LU" !EXTENDED CODES -$ QUAL ="BCFGIJLMOPV" !KNOWN QUALIFIERS -$ QUALA="BCFIJLMOP" !ADDITIVE QUALIFIERS -$ NCC_D="CDLOZ" !DEFAULT CODES -$ NDC_D="ACLZ" -$ NGC_D="LZ" -$ NLC_D="SLZ" -$ NNC_D="Z" -$ IF INTAT .EQS. "X0" !INTERACTIVE -$ THEN -$ L_D="WNLIB" !DEFAULT LIBRARY -$ U_D=" " !DEFAULT DWARF UPDATE -$ L0=0 !DEFINE ALL CODES -$ LP3: CD_'F$EXTRACT(L0,1,CODES)'="-" -$ L0=L0+1 -$ IF L0 .LT. F$LENGTH(CODES) THEN GOTO LP3 -$ L0=0 !DEFINE ALL QUALIFIERS -$ LP4: 'F$EXTRACT(L0,1,QUAL)'Q_D="" -$ L0=L0+1 -$ IF L0 .LT. F$LENGTH(QUAL) THEN GOTO LP4 -$ ELSE !BATCH -$ FG_CD=P5 -$ L0=0 !COPY CODES -$ LP5: CD_'F$EXTRACT(L0,1,CODES)'=F$EXTRACT(L0,1,FG_CD) -$ L0=L0+1 -$ IF L0 .LT. F$LENGTH(CODES) THEN GOTO LP5 -$ FG_CX="''P6'" -$ L0=0 !EXTENDED CODES -$ LP6: 'F$EXTRACT(L0,1,CODEX)'_D=F$ELEMENT(L0," ","''FG_CX'") -$ IF 'F$EXTRACT(L0,1,CODEX)'_D .EQS. "-" THEN - - 'F$EXTRACT(L0,1,CODEX)'_D="" !EMPTY -$ L0=L0+1 -$ IF L0 .LT. F$LENGTH(CODEX) THEN GOTO LP6 -$ ENDIF -#else - set chtp=(.dir .err .exe .hlb .jou .lis .log .lst .map .mlb \ - .new .npd .obj .olb .old .ppd .tlb .tmp \ - .udf .ulb) # files to skip - set codes=(a b c d l o p s u x y z) # known codes - set scodes=abcdlopsuxyz # compressed - set codex=(l u) ; set scodex=lu # extended codes - set qual=(b c f g l m o p v) ; set squal=bcfglmopv # qualifiers - set quala=(b c f l m o p) ; set squala=bcflmop # additive qualifiers - set ncc_d=cdloxz ; set nnc_d=z # default codes - set ndc_d=aclz ; set ngc_d=lz ; set nlc_d=sz - set fnam="" # no names - if ("$intat" == "x0") then # interactive - set l_d=wnlib ; set u_d=" " # lib. name; dwarf dir. - foreach i ($codes) # define all codes - set cd_$i="-" - end - foreach i ($qual) # define all qualifiers - set ${i}q_d="" - end - else # batch - set loo=($1) ; shift ; set fg_cd=($loo) # codes - foreach i ($codes) - set cd_$i=$loo[1] ; shift loo # copy codes - end - set loo=($1) ; shift ; set fg_cx=($loo) # extended codes - foreach i ($codex) - if ("$loo[1]" == "-") then # empty - set ${i}_d=" " - else - set ${i}_d="$loo[1]" - endif - shift loo - end - endif -#endif -# -# Machine environment -# -#ifdef wn_vax__ -$ DATTP=1 -$ BQ_D="/NOLOG/NOPRINT/NOKEEP" !BATCH DEFAULT -$ FQ_D="/F77/EXTEND/I4/SHOW=(NODICT,NOINCL,MAP,NOPREP,NOSIN)" !FORTRAN -$ CQ_D="/LIST/SHOW=(STAT,TRANS,SYM)/NOWARN" -$ IF INTAT .NES. "X0" !RESET QUAL. FOR BATCH -$ THEN -$ L0=0 -$ LP7: 'F$EXTRACT(L0,1,QUAL)'Q_D='F$EXTRACT(L0,1,QUAL)'Q_DX -$ L0=L0+1 -$ IF L0 .LT. F$LENGTH(QUAL) THEN GOTO LP7 -$ ENDIF -#else - switch ($ext) # Machine - case al: # Alliant - set dattp=3 ; set fortran=fortran ; set lfort="-g -M" - set fq_d=(-c -e -w ) ; set cq_d=(-c -ce -w) - breaksw - case dw: # DEC workstation - set dattp=6 ; set xfort="-assume back" - set lfort="-g -assume back -Wl,-M" - set fq_d=(-c -V -w) ; set cq_d=(-c -w) - breaksw - case sw: # SUN workstation - set dattp=7 ; set xfort="-xl -Nl50" - set lfort="-g -xl -Qoption ld -M" - if ($WNG_SITE == rug) set lfort=( $lfort -Bstatic ) - set fq_d=(-c -w) ; set cq_d=(-c -ce -w) - if ($WNG_SITE == rug) set fq_d=( $fq_d -Nn1500 ) - breaksw - case cv: # Convex - set dattp=5 ; set fortran=fc ; set xfort="-LST" - set lfort="-g -sa -vfc -O3 -na -nw -M" - set fq_d=(-c -na -nw -vfc -sa) ; set cq_d=(-c -na -nw) - breaksw - case hp: # HP workstation - set dattp=8 ; set xfort="-Nl50" ; set lfort="-g +e +es +ppu" - set fq_d=(-c -w +e +es +ppu) - set cq_d=(-c -w) - if (-d /usr/include/X11R5) then - set cq_d=($cq_d -I/usr/include/X11R5) - else - set cq_d=($cq_d -I/usr/include/X11R4) - endif - breaksw - default: - echo " Error: Unknown machine type $ext" \ - | tee -a $c_upd - goto exex - endsw - if ("$intat" != "x0") then # reset qualifiers - foreach i ($qual) # qualifiers - set loa=(`eval echo \$${i}Q_D`) # name - set ${i}q_d="$loa" - end - endif -#endif -# -# Get execution type -# -#ifdef wn_vax__ -$ IF INTAT .EQS. "X0" !INTERACTIVE -$ THEN -$ PNAM="" !UNKNOWN -$ L1=F$LENGTH(P1) !LENGTH GIVEN -$ IF L1 .LT. 2 THEN P1="Empty" !ERROR IN TYPE -$ L0=F$EDIT("''P1'","UPCASE") !GIVEN TYPE -$ IF L0 .EQS. F$EXTRACT(0,L1,"NCOMPILE") THEN PNAM="NCOMP" !COMPILE -$ IF L0 .EQS. F$EXTRACT(0,L1,"NLINK") THEN PNAM="NLINK" !LINK -$ IF L0 .EQS. F$EXTRACT(0,L1,"NDELETE") THEN PNAM="NDEL" !DELETE -$ IF L0 .EQS. F$EXTRACT(0,L1,"NGET") THEN PNAM="NGET" !GET FROM LIBRARY -$ IF L0 .EQS. F$EXTRACT(0,L1,"NNET") THEN PNAM="NNET" !GET FROM NET -$ IF L0 .EQS. F$EXTRACT(0,L1,"NXREF") THEN PNAM="NXREF" !XREF -$ IF PNAM .EQS. "" !ERROR -$ THEN -$ @WNG:NHELP 1 "''P1'" "''EXT'" !HELP TEXT -$ GOTO EXEX -$ ENDIF -$ PCOD=F$EXTRACT(0,2,PNAM) !PROGRAM CODE -#else - if ("$intat" == "x0") then # interactive - if ($#argv < 1) set argv="Empty" # type given - switch ($1) - case [nN][cC]*: - set pnam=ncomp ; set pcod=nc - breaksw - case [nN][lL]*: - set pnam=nlink ; set pcod=nl - breaksw - case [nN][dD]*: - set pnam=ndel ; set pcod=nd - breaksw - case [nN][gG]*: - set pnam=nget ; set pcod=ng - breaksw - case [nN][xX]*: - set pnam=nxref ; set pcod=nx - breaksw - case [nN][nN]*: - set pnam=nnet ; set pcod=nn - breaksw - default: - csh -f $WNG/nhelp.sun 1 $1 $ext " " " " " " # basic help - goto exex - endsw -#endif -# -# See if Help -# -#ifdef wn_vax__ -$ HLP: IF P2+P3+P4+P5+P6+P7+P8 .EQS. "" !NO CODES -$ THEN -$ L0="-"+CODES+"Q("+QUAL+")" -$ READ/TIME=90/END=EXEX/ERROR=EXEX - - /PROMPT="Codes (''L0') [?]: " SYS$COMMAND P2 !GET CODES -$ IF P2 .EQS. "" .OR. P2-"?" .NES. P2 -$ THEN -$ P2="" -$ @WNG:NHELP 2 'PNAM' !HELP -$ GOTO HLP !RETRY -$ ENDIF -$ P2="-"+P2 !MAKE SURE - -$ ENDIF -$ ENDIF -#else - while ($#argv < 2) # ask codes - set l2="-${scodes}q($squal)" - echo -n "Codes ($l2) [?]: " - set argv=($1 $<) # get codes - if ($#argv < 2 || "$*" =~ *\?*) then # help codes - foreach i ($qual) # export qualifiers - set loa=(`eval echo \$${i}q_d`) - setenv ${i}Q_D "$loa" - end - csh -f $WNG/nhelp.sun 2 $pnam $ext $pcod $pnam "$chtp" - endif - end - shift # delete code - endif -#endif -# -# Read line -# -#ifdef wn_vax__ -$ IF INTAT .EQS. "X2" THEN - !OPEN FILE - OPEN/READ/ERROR=EXEX FX2'PID''DEP' 'P7' -$ RLIN: IF INTAT .EQS. "X2" !READ LINE -$ THEN -$ READ/ERROR=EXEX/END=EXEX FX2'PID''DEP' L1 !GET LINE -$ IF F$EXTRACT(0,1,L1) .EQS. "#" THEN GOTO RLIN !UNIX COMMAND -$ IF F$EXTRACT(0,1,L1) .EQS. "$" -$ THEN -$ IF F$EXTRACT(0,2,L1) .EQS. "$$" !CHECK IF CORRECT -$ THEN -$ IF F$EDIT(F$EXTRACT(0,5,L1),"UPCASE") .EQS. "$$''PCOD'$" -$ THEN -$ SPAWN/NOLOG 'F$EXTRACT(5,-1,L1)' !DO COMMAND -$ ENDIF -$ ELSE -$ SPAWN/NOLOG 'F$EXTRACT(1,-1,L1)' !DO DCL COMMAND -$ ENDIF -$ GOTO RLIN -$ ENDIF -$ L1=F$EDIT(L1,"UPCASE,UNCOMMENT") !GET FILE NAME -$ L1=F$EDIT(L1,"TRIM") -$ IF L1 .EQS. "" THEN GOTO RLIN !EMPTY LINE -$ L0=1 !SPLIT IN FIELDS -$ LP8: L0=L0+1 -$ P'L0'=F$ELEMENT(L0-2," ",L1) !GET CODES ETC -$ IF P'L0' .EQS. " " THEN P'L0'="" -$ IF L0 .LT. 8 THEN GOTO LP8 -$ ENDIF -$ IF INTAT .EQS. "X1" !MAKE ARGUMENTS -$ THEN -$ P2="''P7'" !SET FILENAMES -$ P3="''P8'" !AND CODES -$ L0=3 !SPLIT IN FIELDS -$ LP9: L0=L0+1 -$ P'L0'="" -$ IF L0 .LT. 8 THEN GOTO LP9 -$ ENDIF -#else -RLIN: - if ("$intat" == "x2") then # read file - set argv=($<) # get line - if ("$*" == "") goto RLIN # empty line - if ("$*" =~ endend*) goto exex # ready - if ("$*" =~ \$*) goto RLIN # VMS - if ("$*" =~ \#*) then # Unix command - source $WNG/wngcshrc.sun # make aliases known - set loa="0" # do not execute - if ("$*" =~ \#\#*) then # limit application? - set loo=(`echo "$*" | tr $Upc $Lowc | awk '{print substr($0,1,5)}'`) - if ("$loo" == \#\#$pcod\#) then # selected - set loo=(`echo "$*" | awk '{print substr($0,6)}'`) - set loa="1" - endif - else - set loo=(`echo "$*" | awk '{print substr($0,2)}'`) - set loa="1" - endif - if ("$loa" == "1") then # execute line - set wng_s1exe=$WNG_EXE # save current - if ($?wng_sexe) then # reset original - setenv WNG_EXE $wng_sexe - else - unsetenv WNG_EXE - endif - set wng_s1olb=$WNG_OLB # save current - if ($?wng_solb) then # reset original - setenv WNG_OLB $wng_solb - else - unsetenv WNG_OLB - endif - set wng_s1tlb=$WNG_TLB # save current - if ($?wng_stlb) then # reset original - setenv WNG_TLB $wng_stlb - else - unsetenv WNG_TLB - endif - eval $loo # do line - setenv WNG_EXE $wng_s1exe # restore current - setenv WNG_OLB $wng_s1olb - setenv WNG_TLB $wng_s1tlb - endif - goto RLIN # next line - endif - set argv=($*) # split in fields - endif -#endif -# -# Get codes and filenames -# -#ifdef wn_vax__ -$ A0="" !NO CODES -$ FNAM="" !NO NAMES -$ L0=1 !ARG. COUNT -$ LP10: L0=L0+1 -$ IF P'L0' .NES. "" !NOT EMPTY -$ THEN -$ IF F$EXTRACT(0,1,P'L0') .EQS. "-" .OR. - !CODE - F$EXTRACT(0,1,P'L0') .EQS. "+" .OR. - - F$EXTRACT(0,1,P'L0') .EQS. "<" -$ THEN -$ A0=A0+P'L0' !SET CODE -$ ELSE -$ IF FNAM .NES. "" THEN FNAM=FNAM+"," !SET FILE NAME -$ FNAM=FNAM+P'L0' -$ ENDIF -$ ENDIF -$ IF L0 .LT. 8 THEN GOTO LP10 !MORE -$ IF INTAT .EQS. "X2" THEN FNAM=F$ELEMENT(0,",",FNAM) !LIMIT TO ONE NAME -$ IF INTAT .EQS. "X0" !INTERACTIVE -$ THEN -$ A0="-"+'PCOD'C_D+"-"+F$TRNLNM("''PCOD'_COD")+"-"+A0 !ADD DEFAULTS -$ UTELL "-----" -$ UTELL "---- ''PNAM' ''A0' ''FNAM'" !LOG WHAT -$ UTELL "-----" -$ GOSUB NXANAL !ANALYZE CODES -$ ENDIF -$ IF INTAT .EQS. "X1" .AND. "''A0'" .NES. "" THEN - !ANALYZE EXTRA - GOSUB NXANAL -#else - set a0="" # no codes; del. type - while ($#argv > 0) - if ("$1" == "-" || "$1" == "+") then # empty code - else if ("$1" =~ -* || "$1" =~ [+\<]*) then # code - set a0=("$a0""$1") # add - else # file name - set noglob; set fnam=($fnam $1); unset noglob - endif - shift # next argument - end - if ("$intat" == "x0") then # add defaults - set l0=\$\?${pcod}_COD # default name - if (`eval echo "$l0"`) then # user defaults - set l0=\$${pcod}_COD - set a0=(`eval echo $l0`"-$a0") - endif - set l0=\$${pcod}c_d # default name - set a0=(`eval echo $l0`"-$a0") # program default - echo "-----" >>! $c_upd - echo "---- $pnam -$a0 $fnam" >>! $c_upd # log call - echo "-----" >>! $c_upd - source $WNG/nxanal.sun # analyze codes - else if ("$intat" == "x1" && "$a0" != "") then # codes given - source $WNG/nxanal.sun # analyze codes - endif -#endif -# -# Interpret codes -# -#ifdef wn_vax__ -$ IF VQ_D .NES. "" .AND. - - F$LOCATE("X",VQ_D) .EQ. F$LENGTH(VQ_D) .AND. - - F$LOCATE("x",VQ_D) .EQ. F$LENGTH(VQ_D) -$ THEN -$ VER=F$VERIFY(1) !SET VERIFY -$ ELSE -$ VER=F$VERIFY(0) !NO VERIFY -$ ENDIF -#else - if ($?echo) unset echo # no verify - if ($?verbose) unset verbose # no verbose - if ($vq_d != "") then - if ($vq_d =~ *e* && $vq_d !~ *x*) set echo # echo asked - if ($vq_d =~ *v* && $vq_d !~ *x*) set verbose # verbose asked - endif -#endif -# -# Network info -# -#ifdef wn_vax__ -$ IF INTAT .EQS. "X0" !INTERACTIVE -$ THEN -$ IF PNAM .EQS. "NNET" -$ THEN -$ IF CD_A .EQS. "0" .OR. "''WNG_NODE'" .EQS. "" !DO ASK -$ THEN -$ L0="" -$ LP20: IF "''L0'" .EQS. "" -$ THEN -$ READ/TIME=90/END=EXEX/ERROR=EXEX - - /PROMPT="Node [''WNG_NODE']: " SYS$COMMAND L0 -$ IF "''L0'" .EQS. "" THEN L0="''WNG_NODE'" -$ WNG_NODE="''L0'" -$ GOTO LP20 -$ ENDIF -$ ENDIF -$ IF CD_A .EQS. "0" .OR. "''WNG_NODEDIR'" .EQS. "" !DO ASK -$ THEN -$ L0="" -$ LP21: IF "''L0'" .EQS. "" -$ THEN -$ READ/TIME=90/END=EXEX/ERROR=EXEX - - /PROMPT="Remote base directory [''WNG_NODEDIR']: " - - SYS$COMMAND L0 -$ IF "''L0'" .EQS. "" THEN L0="''WNG_NODEDIR'" -$ WNG_NODEDIR="''L0'" -$ GOTO LP21 -$ ENDIF -$ ENDIF -$ IF CD_A .EQS. "0" .OR. "''WNG_NODEUSER'" .EQS. "" !DO ASK -$ THEN -$ L0="" -$ LP22: IF "''L0'" .EQS. "" -$ THEN -$ READ/TIME=90/END=EXEX/ERROR=EXEX - - /PROMPT="Remote user [''WNG_NODEUSER']: " - - SYS$COMMAND L0 -$ IF "''L0'" .EQS. "" THEN L0="''WNG_NODEUSER'" -$ WNG_NODEUSER="''L0'" -$ GOTO LP22 -$ ENDIF -$ ENDIF -#else - if ("$intat" == "x0") then # skip for batch - if ($pcod == nn) then # maybe ask - if ("$cd_a" == "0" || "$WNG_NODE" == "") then # must ask - set loo="" - while ("$loo" == "") - echo -n "Node [$WNG_NODE]: " - set loo=("$<") - if ("$loo" == "") set loo=("$WNG_NODE") #default - setenv WNG_NODE "$loo" - end - endif - if ("$cd_a" == "0" || "$WNG_NODEDIR" == "") then # must ask - set loo="" - while ("$loo" == "") - echo -n "Remote base directory [$WNG_NODEDIR]: " - set loo=("$<") - if ("$loo" == "") set loo=("$WNG_NODEDIR") #default - setenv WNG_NODEDIR "$loo" - end - endif - if ("$cd_a" == "0" || "$WNG_NODEUSER" == "") then # must ask - set loo="" - while ("$loo" == "") - echo -n "Remote user [$WNG_NODEUSER]: " - set loo=("$<") - if ("$loo" == "") set loo=("$WNG_NODEUSER") #default - setenv WNG_NODEUSER "$loo" - end - endif -#endif -# -# Network password -# -#ifdef wn_vax__ -$ IF F$ELEMENT(1," ","''WNG_NODEUSER'") .EQS. " " -$ THEN !NO PASSWORD GIVEN -$ SET TERM/NOECHO -$ READ/TIME=90/END=EXEX/ERROR=EXEX - - /PROMPT="Password: " SYS$COMMAND L0 !GET PASSWORD -$ SET TERM/ECHO -$ TELL " " -$ WNG_NODEUSER="''WNG_NODEUSER' ''L0'" !SET PASSWORD -$ ENDIF -$ ENDIF -#else - set loo=($WNG_NODEUSER) # split - if ($#loo < 2) then # ask pw - echo -n "Password: " - stty -echo ; set loa="$<" ; stty echo ; echo " " # get it - setenv WNG_NODEUSER "$loo $loa" - endif - endif -#endif -# -# Compiler info -# -#ifdef wn_vax__ -$ IF CD_B .EQS. "1" THEN BQ_D=BQ_D+"/LOG=''PNAM'.LOG/PRINT" !BATCH LOG -$ IF CD_D .NES. "-" THEN FQ_D=FQ_D+"/DEBUG/WARN=NOGEN" !DEBUG FORTRAN -$ IF CD_D .NES. "-" THEN CQ_D=CQ_D+"/DEBUG" !DEBUG C -$ IF CD_D .NES. "-" THEN MQ_D=MQ_D+"/DEBUG" !DEBUG MACRO -$ IF CD_D .NES. "-" THEN LQ_D=LQ_D+"/DEBUG" !LINK DEBUG -$ IF CD_X .NES. "-" THEN FQ_D=FQ_D+"/CROSS" !FORTRAN XREF -$ IF CD_X .NES. "-" THEN CQ_D=CQ_D+"/CROSS" !C XREF -$ IF CD_X .NES. "-" THEN MQ_D=MQ_D+"/CROSS" !MACRO XREF -$ IF CD_X .NES. "-" THEN LQ_D=LQ_D+"/CROSS/FULL" !LINK XREF -$ IF CD_O .NES. "-" THEN FQ_D=FQ_D+"/OPTIM" !FORTRAN OPTIMIZE -$ IF CD_O .EQS. "-" THEN FQ_D=FQ_D+"/NOOPTIM" !FORTRAN NOOPTIMIZE -$ IF CD_O .NES. "-" THEN CQ_D=CQ_D+"/OPTIM" !C OPTIMIZE -$ IF CD_O .EQS. "-" THEN CQ_D=CQ_D+"/NOOPTIM" !C NOOPTIMIZE -$ ENDIF -#else - switch ($ext) # Machine - case al: # Alliant - if ("$cd_d" != "-") then - set fq_d=($fq_d -g) ; set cq_d=($cq_d -g) # debug - endif - if ("$cd_x" != "-") then - set fq_d=($fq_d -xref) # Fortran Xref - endif - if ("$cd_o" != "-") then - set fq_d=($fq_d -O -OM -alt) ; set cq_d=($cq_d -O) # optimize - endif - breaksw - case dw: # DEC workstation - if ("$cd_d" != "-") then - set fq_d=($fq_d -g) ; set cq_d=($cq_d -g) # debug - endif - if ("$cd_x" != "-") then - set fq_d=($fq_d -xref) # Fortran Xref - endif - if ("$cd_o" != "-") then - set fq_d=($fq_d -O1) ; set cq_d=($cq_d -O1) # optimize - endif - breaksw - case sw: # SUN workstation - if ("$cd_d" != "-") then - set fq_d=($fq_d -g) ; set cq_d=($cq_d -g) # debug - endif - if ("$cd_x" != "-") then - endif - if ("$cd_o" != "-" && "$cd_d" == "-") then - set fq_d=($fq_d -O3) ; set cq_d=($cq_d -O) # optimize - endif - breaksw - case cv: # Convex - if ("$cd_d" != "-") then - set fq_d=($fq_d -g) ; set cq_d=($cq_d -g) # debug - endif - if ("$cd_x" != "-") then - set fq_d=($fq_d -xr) # Fortran Xref - endif - if ("$cd_o" != "-" && "$cd_d" == "-") then - set fq_d=($fq_d -O3) ; set cq_d=($cq_d -O) # optimize - endif - breaksw - case hp: # HP workstation - if ("$cd_d" != "-") then - set fq_d=($fq_d -g) ; set cq_d=($cq_d -g) # debug - endif - if ("$cd_x" != "-") then - endif - if ("$cd_o" != "-" && "$cd_d" == "-") then - set fq_d=($fq_d -O) ; set cq_d=($cq_d -O) # optimize - endif - breaksw - default: - echo " Error: Unknown machine type $ext" \ - | tee -a $c_upd - goto exex - endsw -#endif -# -# Format qualifiers -# -#ifdef wn_vax__ -#else - foreach i ($qual) - set loa=(`eval echo \$${i}q_d`) # qualifier name - set lob=(`echo $loa | ${fold}1`) # qual value - set loc="" # build new qual - while ($#lob > 0) - if ("$lob[1]" == "-" || "$lob[1]" == "+") then # add space - set loc="$loc $lob[1]" - else - set loc="$loc$lob[1]" - endif - shift lob # next character - end - set ${i}q_d="$loc" # new qualifier - end -#endif -# -# Create libraries -# -#ifdef wn_vax__ -$ IF CD_L .NES. "-" !NEED LIBRARY -$ THEN -$ IF F$SEARCH("''WNG_OLB'''L_D'.OLB") .EQS. "" THEN - - LIBRARY/CREATE 'WNG_OLB''L_D'.OLB !CREATE .OLB -$ IF F$SEARCH("''WNG_TLB'''L_D'.TLB") .EQS. "" THEN - - LIBRARY/CREATE/TEXT 'WNG_TLB''L_D'.TLB !CREATE .TLB -$ IF F$SEARCH("''WNG_TLB'''L_D'_AX.TLB") .EQS. "" THEN - - LIBRARY/CREATE/TEXT 'WNG_TLB''L_D'_AX.TLB !CREATE .TLB -$ IF F$SEARCH("''WNG_OLB'''L_D'.OLB") .EQS. "" .OR. - - F$SEARCH("''WNG_TLB'''L_D'.TLB") .EQS. "" .OR. - - F$SEARCH("''WNG_TLB'''L_D'_AX.TLB") .EQS. "" -$ THEN -$ TELL "" -$ TELL "Illegal Library name. Probably illegal L<name> specified" -$ UTELL "Illegal Library name. Probably illegal L<name> specified" -$ TELL "" -$ GOTO EXEX -$ ENDIF -$ ENDIF -#else - if ("$cd_l" != "-") then # library needed - set l_d=`echo $l_d:r | tr $Upc $Lowc` # library root - if (! -e $WNG_OLB/${l_d}.olb) ar cr $WNG_OLB/${l_d}.olb # create olb - if (! -e $WNG_TLB/${l_d}.tlb) ar cr $WNG_TLB/${l_d}.tlb # create tlb - if (! -e $WNG_TLB/${l_d}_ax.tlb) ar cr $WNG_TLB/${l_d}_ax.tlb - if (! -e $WNG_OLB/${l_d}.olb || ! -e $WNG_TLB/${l_d}.tlb || \ - ! -e $WNG_TLB/${l_d}_ax.tlb) then - echo " Error: Illegal Library name." \ - | tee -a $c_upd - echo " Probably illegal L<name> specified" \ - | tee -a $c_upd - goto exex - endif - endif -#endif -# -# DWARF data -# -#ifdef wn_vax__ -$ IF INTAT .EQS. "X0" !INTERACTIVE -$ THEN -$ IF CD_S .NES. "-" .AND. PCOD .EQS. "NL" -$ THEN !NEED DWARF -$ IF F$TRNLNM("EXEDWARF") .EQS. "" .OR. - - F$TRNLNM("LIBDWARF") .EQS. "" !CANNOT DWARF -$ THEN -$ CD_S="-" !NO SHARED DWARF -$ ENDIF -$ ENDIF -#else - if ("$cd_s" != "-" && $pcod == "nl") then - if (! $?EXEDWARF_UNIX || ! $?LIBDWARF) then # cannot DWARF - set cd_s="-" # no shared - endif - endif -#endif -# -# Get files if none -# -#ifdef wn_vax__ -$ FIL: IF FNAM .EQS. "" !NO FILENAMES -$ THEN -$ READ/TIME=90/END=EXEX/ERROR=EXEX - - /PROMPT="Filename[,...] [?]: " SYS$COMMAND FNAM !GET NAMES -$ IF FNAM .EQS. "" -$ THEN -$ @WNG:NHELP 3 'PNAM' !SHOW HELP -$ GOTO FIL -$ ENDIF -$ ENDIF -$ ENDIF -#else - while ("$fnam" == "") # no filenames - echo -n "Filename[ ...] [?]: " # get filename - set fnam=($<) - if ("$fnam" == "") then - csh -f $WNG/nhelp.sun 3 $pnam $ext $pcod $pnam "$chtp" # file help - endif - end - endif -#endif -# -# Do batch if asked -# -#ifdef wn_vax__ -$ IF INTAT .EQS. "X0" !PREPARE BATCH -$ THEN -$ FG_CD="" !PREPARE CODES -$ FG_CX="" -$ L0=0 !DEFINE ALL CODES -$ LP11: FG_CD=FG_CD+CD_'F$EXTRACT(L0,1,CODES)' -$ L0=L0+1 -$ IF L0 .LT. F$LENGTH(CODES) THEN GOTO LP11 -$ L0=0 !EXTENDED CODES -$ LP12: L1='F$EXTRACT(L0,1,CODEX)'_D -$ IF L1 .EQS. "" THEN L1="-" -$ IF FG_CX .NES. "" THEN FG_CX=FG_CX+" " -$ FG_CX=FG_CX+L1 -$ L0=L0+1 -$ IF L0 .LT. F$LENGTH(CODEX) THEN GOTO LP12 -$ L0=0 !EXPORT QUALIFIERS -$ LP13: 'F$EXTRACT(L0,1,QUAL)'Q_DX='F$EXTRACT(L0,1,QUAL)'Q_D -$ L0=L0+1 -$ IF L0 .LT. F$LENGTH(QUAL) THEN GOTO LP13 -$ IF CD_B .NES. "-" !BATCH ASKED -$ THEN -$ IF CD_B .EQS. "2" !SPAWN -$ THEN -$ SPAWN/NOWAIT/OUTPUT=SPAWN.LOG - - @WNG:NXEC X1 'PNAM' 'PCOD' 'DEP' "''FG_CD'" "''FG_CX'" - - "''FNAM'" !SPAWN -$ IF .NOT.$SEVERITY -$ THEN -$ TELL "" -$ TELL "Cannot spawn the ''PNAM' task" -$ UTELL "Cannot spawn the ''PNAM' task" -$ TELL "" -$ ENDIF -$ ELSE -$ L0="" -$ CLOSE/ERROR=GB21 F'PID''DEP' !BATCH -$ GB21: OPEN/WRITE/ERROR=GB22 F'PID''DEP' 'PNAM''PID''DEP'.TMP -$ WRITE/ERROR=GB22 F'PID''DEP' "$ !'F$VERIFY(''F$VERIFY()')'" -$ WRITE/ERROR=GB22 F'PID''DEP' - - "$ SET DEFAULT ''F$ENVIRONMENT("DEFAULT")'" !SET -$ L00=0 !SAVE QUALIFIERS -$ LP16: L01='F$EXTRACT(L00,1,QUAL)'Q_DX !QUAL. -$ WRITE/ERROR=GB22 F'PID''DEP'' - - "$ ''F$EXTRACT(L00,1,QUAL)'Q_DX="+ - - """''L01'""" -$ L00=L00+1 -$ IF L00 .LT. F$LENGTH(QUAL) THEN GOTO LP16 -$ WRITE/ERROR=GB22 F'PID''DEP' "$ @WNG:NXEC X1 ''PNAM' "+ - - "''PCOD' ''DEP' ""''FG_CD'"" ""''FG_CX'"" "+ - - """''FNAM'""" !DO -$ CLOSE/ERROR=GB22 F'PID''DEP' -$ L0="''PNAM'''PID'''DEP'.TMP" -$ L0=F$SEARCH("''L0'") -$ IF L0 .NES. "" THEN SUBMIT'BQ_D' 'L0'/DELETE !SUBMIT -$ L1=$SEVERITY -$ IF L1 .AND. L0 .NES. "" THEN GOTO EXEX !SUBMITTED -$ GB22: IF L0 .NES. "" THEN DELETE 'L0' !DELETE -$ TELL "" -$ TELL "Cannot submit the ''PNAM' task" -$ UTELL "Cannot submit the ''PNAM' task" -$ TELL "" -$ ENDIF -$ GOTO EXEX -$ ENDIF -$ ENDIF -$ IF INTAT .EQS. "X2" .AND. "''A0'" .NES. "" !LOCAL SWITCHES -$ THEN -$ @WNG:NXEC X1 'PNAM' 'PCOD' 'DEP' "''FG_CD'" "''FG_CX'" - - "''FNAM'" "''A0'" !DO -$ FNAM="" !SET DONE -$ ENDIF -#else - if ("$intat" == "x0") then # prepare batch - set fg_cd="" ; set fg_cx="" # prepare codes - foreach i ($codes) - set fg_cd=($fg_cd `eval echo \$cd_$i`) - end - foreach i ($codex) # extended codes - set l0=(`eval echo \$${i}_d`) - if ("$l0" == "") set l0="-" - set fg_cx=($fg_cx $l0) - end - foreach i ($qual) # export qualifiers - set loa=(`eval echo \$${i}q_d`) - setenv ${i}Q_D "$loa" - end - if ("$cd_b" != "-") then # do batch - if ($cd_b == 0) then # no log - csh -f $WNG/nxec.sun x1 $pnam $pcod $dep "$fg_cd" "$fg_cx" \ - "$fnam" >>&! /dev/null & - else # log - csh -f $WNG/nxec.sun x1 $pnam $pcod $dep "$fg_cd" "$fg_cx" \ - "$fnam" >>&! nx${pid}.log & - endif - goto exex1 # ready - endif - endif - if ("$intat" == "x2" && "$a0" != "") then # local switches - csh -f $WNG/nxec.sun x1 $pnam $pcod $dep "$fg_cd" "$fg_cx" \ - $fnam $a0 - set fnam="" # set done - if ($?olbset) unsetenv olbset # set done - if ($?olbdel) unsetenv olbdel - if ($?tlbset) unsetenv tlbset - if ($?tlbdel) unsetenv tlbdel - if ($?taxset) unsetenv taxset - if ($?taxdel) unsetenv taxdel - endif -#endif -# -# Execute -# -#ifdef wn_vax__ -$ IF VQ_D .NES. "" .AND. - - (F$LOCATE("X",VQ_D) .LT. F$LENGTH(VQ_D) .OR. - - F$LOCATE("x",VQ_D) .LT. F$LENGTH(VQ_D)) -$ THEN -$ VER=F$VERIFY(1) !SET VERIFY -$ ELSE -$ VER=F$VERIFY(0) !NO VERIFY -$ ENDIF -$ IF INTAT .NES. "X0" .AND. CD_Y .EQS. "-" !BATCH EXECUTION -$ THEN -$ B_AA="-" !PREPARE OUTPUT -$ B_AB="-" -$ B_AC="-" -$ L0=0 !SET QUALIFIERS -$ LP14: B_AA=B_AA+"Q"+F$EXTRACT(L0,1,QUAL)+"<"+ - - 'F$EXTRACT(L0,1,QUAL)'Q_D+">" -$ L0=L0+1 -$ IF L0 .LT. F$LENGTH(QUAL) THEN GOTO LP14 -$ L0=0 !SET CODES -$ LP15: L1=F$EXTRACT(L0,1,CODES) -$ IF CD_'L1' .NES. "-" !CODE SET -$ THEN -$ B_AB=B_AB+L1+CD_'L1' !SET CODE -$ IF CODEX-L1 .NES. CODEX !EXTENDED -$ THEN -$ B_AC=B_AC+L1+CD_'L1'+"<"+'L1'_D+">" -$ ENDIF -$ ENDIF -$ L0=L0+1 -$ IF L0 .LT. F$LENGTH(CODES) THEN GOTO LP15 -$ TELL " " -$ TELL "Command: ''PNAM' ''B_AB'" -$ TELL " ''B_AC'" -$ TELL " ''B_AA'" -$ TELL " ''FNAM'" -$ TELL " " -$ ENDIF -#else - if ($vq_d != "") then - if ($vq_d =~ *e* && $vq_d =~ *x*) set echo # echo asked - if ($vq_d =~ *v* && $vq_d =~ *x*) set verbose # verbose asked - endif - if ("$intat" != "x0" && "$cd_y" == "-") then # execute batch - set b_aa="-" ; set b_ab="-" ; set b_ac="-" - foreach i ($qual) # set all qualifiers - set l0=(`eval echo \$${i}q_d`) - if ("$l0" != "") then # set qual - set b_aa="${b_aa}q$i<$l0>" - endif - end - foreach i ($codes) # set all codes - set l0=(`eval echo \$cd_$i`) - if ("$l0" != "-") then # set normal code - set b_ab="${b_ab}$i$l0" - if ("$i" =~ [$scodex]) then # set extended code - set l1=(`eval echo \$${i}_d`) - set b_ac="${b_ac}${i}$l0<$l1>" - endif - endif - end - echo "" ; echo "Command: $pnam $b_ab" - echo " $b_ac" ; echo " $b_aa" - echo " $fnam" ; echo "" - endif -#endif -# -# Do all files -# -#ifdef wn_vax__ -$ L0=-1 !COUNT FILES -$ EXE1: L0=L0+1 !NEXT FILE -$ L1="" !NOT INDIRECT -$ LOB=F$ELEMENT(L0,",",FNAM) !GET NAME -$ IF LOB .EQS. "" THEN GOTO EXE1 !EMPTY, NEXT -$ IF LOB .EQS. "," !READY -$ THEN -$ IF INTAT .EQS. "X2" THEN GOTO RLIN !READ NEXT LINE -$ GOTO EXEX !REAL READY -$ ENDIF -$ IF F$EXTRACT(0,1,LOB) .EQS. "@" !INDIRECT -$ THEN -$ LOB=LOB-"@" !DELETE @ -$ L1="@" !SET INDIRECT -$ LOB=F$PARSE(LOB,".GRP;0",,,"SYNTAX_ONLY") !GET FULL FILE NAME -$ ELSE -$ IF PCOD .EQS. "NL" -$ THEN -$ LOB=F$PARSE(LOB,".EXE;0",,,"SYNTAX_ONLY") !GET FULL FILE NAME -$ ELSE -$ LOB=F$PARSE(LOB,".*;0",,,"SYNTAX_ONLY") !GET FULL FILE NAME -$ ENDIF -$ ENDIF -$ IF LOB .EQS. "" THEN GOTO EXE1 !FORMAT ERROR -$ L5="" !CHECK SINGLE FILE -$ L6="N" !CHECK SEEN -$ EXE4: L3=F$SEARCH(LOB,L0) !FIND FILE -$ EXE5: IF L3 .EQS. "" .OR. - - F$PARSE(L3,,,"NAME","SYNTAX_ONLY")+ - - F$PARSE(L3,,,"TYPE","SYNTAX_ONLY") .EQS. - - F$PARSE(L5,,,"NAME","SYNTAX_ONLY")+ - - F$PARSE(L5,,,"TYPE","SYNTAX_ONLY") .OR. - - (PCOD .EQS. "NG" .AND. LOB-"*"-"%" .NES. LOB) !NOT FOUND -$ THEN -$ IF L6 .OR. L1 .NES. "" THEN GOTO EXE1 !BUT ONE DONE -$ IF PCOD .EQS. "ND" .OR. PCOD .EQS. "NN" .OR. PCOD .EQS. "NC" -$ THEN -$ IF LOB-"*"-"%" .NES. LOB THEN GOTO EXE1 !NONE DEFINED -$ L3=LOB !TRY ANYWAY -$ ENDIF -$ IF PCOD .EQS. "NG" !NGET -$ THEN -$ IF LOB-"*"-"%" .NES. LOB !GET LIST FIRST -$ THEN -$ L00=F$PARSE(LOB,,,"NAME","SYNTAX_ONLY")+ - - F$PARSE(LOB,,,"TYPE","SYNTAX_ONLY") -$ SET MESSAGE /NOIDEN/NOFACIL/NOSEVER/NOTEXT -$ ASSIGN/USER NL: SYS$OUTPUT -$ LIBRARY/TEXT/LIST=L'PID''DEP'.TMP/ONLY=('L00') 'WNG_TLB''L_D' !LIST -$ L00=$SEVERITY !FOR CHECK -$ SET MESSAGE /IDEN/FACIL/SEVER/TEXT -$ IF .NOT.L00 .OR. F$SEARCH("L''PID'''DEP'.TMP") .EQS. "" !ERROR -$ THEN -$ IF F$SEARCH("L''PID'''DEP'.TMP") .NES. "" THEN - -$ DELETE L'PID''DEP'.TMP;* -$ ELSE -$ @WNG:NXEC X2 'PNAM' 'PCOD' 'DEP' "''L00'" "''FG_CX'" - - "L''PID'''DEP'.TMP" !DO AS LIST -$ ENDIF -$ GOTO EXE1 !CONTINUE -$ ELSE -$ L3=LOB !DO ONE -$ ENDIF -$ ENDIF -$ IF PCOD .EQS. "NL" !NLINK -$ THEN -$ IF F$PARSE(LOB,,,"TYPE","SYNTAX_ONLY") .EQS. ".EXE" .OR. - - F$PARSE(LOB,,,"TYPE","SYNTAX_ONLY") .EQS. "." -$ THEN -$ L3=F$PARSE(LOB,,,"NAME","SYNTAX_ONLY")+".EXE" !LINK AT LEAST ONE -$ ELSE -$ GOTO EXE1 !NONE -$ ENDIF -$ ENDIF -$ GOSUB NX1 !DO A FILE -$ IF F$SEARCH("L''PID'''DEP'.TMP") .NES. "" THEN - - DELETE/NOLOG L'PID''DEP'.TMP;* !DELETE FOR NGET -$ GOTO EXE1 !NEXT FILE SPEC. -$ ENDIF -$ L5=L3 !CHECK -$ L4=L1 -$ IF L1 .EQS. "" .AND. F$PARSE(L3,,,"TYPE","SYNTAX_ONLY") .EQS. ".GRP" - - .AND. CD_Z .NES. "" THEN L4="@" !INDIR -$ IF PCOD .EQS. "NL" .AND. L4 .EQS. "" .AND. - - F$PARSE(L3,,,"TYPE","SYNTAX_ONLY") .NES. ".EXE" - - THEN GOTO EXE4 !SKIP FOR NLINK -$ IF PCOD .EQS. "NG" .AND. L4 .EQS. "" .AND. - - LOB-"*"-"%" .NES. LOB !GET LIST FIRST -$ THEN -$ L3="" !FORCE LIST -$ GOTO EXE5 !DO LIST -$ ENDIF -$ L3="''L4'''L3'" !MAKE FULL NAME -$ GOSUB NX1 !DO: TYPE, FILE -$ L6="Y" !AT LEAST ONE DONE -$ GOTO EXE4 !NEXT FILE -#else - while ("$fnam" != "") # not ready - set lob="`set noglob; echo $fnam[1] | tr $Upc $Lowc; unset noglob`" # lc - shift fnam # file name - set l00="`set noglob; echo $lob | grep [^a-z\.0-9_/]; unset noglob`" - # see if regular exp. - if ("$pcod" != "nl" && "$l00" != "") then # regular expression - set l00=(`ar t $WNG_TLB/${l_d}.tlb | grep "$lob"`) # get file names - if ("$l00" != "") then # files found - set loo=($fg_cd) ; @ lop=1 # add y - foreach i ($codes) - if ("$i" == "y") set loo[$lop]="0" - @ lop += 1 - end - csh -f $WNG/nxec.sun x1 $pnam $pcod $dep "$loo" "$fg_cx" \ - "$l00" # do files - if ($?olbset) unsetenv olbset # set done - if ($?olbdel) unsetenv olbdel - if ($?tlbset) unsetenv tlbset - if ($?tlbdel) unsetenv tlbdel - if ($?taxset) unsetenv taxset - if ($?taxdel) unsetenv taxdel - endif - continue # next file - endif - set l1="" # not indirect - if ("$lob" =~ "@*") then # indirect - set lob=`echo $lob | tr -d "@"` ; set l1="@" # delete @; set indir. - endif - set lobh=$lob:r ; set lobe=$lob:e # file name/ext - if ($lobe == "" && "$cd_y" == "-" && $pcod != nl) then # no extension - set l00=(`ls ${lobh}.*`) # see if files - if ("$l00" != "") then # files found - if ("$l1" == "@") then # indirect - @ i = 0 # add @ to names - while ($i < $#l00 ) - @ i += 1 - set l00[$i]="@$l00[$i]" - end - endif - set loo=($fg_cd) ; @ lop=1 # add y - foreach i ($codes) - if ("$i" == "y") set loo[$lop]="0" - @ lop += 1 - end - csh -f $WNG/nxec.sun x1 $pnam $pcod $dep "$loo" "$fg_cx" \ - "$l00" # do files - if ($?olbset) unsetenv olbset # set done - if ($?olbdel) unsetenv olbdel - if ($?tlbset) unsetenv tlbset - if ($?tlbdel) unsetenv tlbdel - if ($?taxset) unsetenv taxset - if ($?taxdel) unsetenv taxdel - endif - continue # next file - endif - if ("$lobe" == "grp" && "$cd_z" != "-" && $l1 == "") \ - set l1 = "@" # indirect -# -# Do a file. -# - if ("$l1" == "@" && "$cd_z" != "-") then # indirect possible - if ("$gQ_D" == "$lobh:t.$lobe") set l1 = "" # stop indirect loop - endif - if ("$l1" == "@" && "$cd_z" != "-") then # indirect - if (! -e ${lobh}.$lobe) then # file not known - if ("$pcod" != "nc") continue # forget if not ncomp - if ("$lobh:t" != "$lobh") continue # forget if other dir - source $WNG/nget.sun # get it first - if (! -e ${lobh}.$lobe) continue # not found - endif - set loo=($fg_cd) ; @ lop=1 # add y - foreach i ($codes) - if ("$i" == "y") set loo[$lop]="0" - @ lop += 1 - end - setenv gQ_D "$lobh:t.$lobe" # save current name - awk -F! '{print $1} END {print "endend"}' ${lobh}.$lobe | \ - csh -f $WNG/nxec.sun x2 $pnam $pcod $dep "$loo" "$fg_cx" - if ($?olbset) unsetenv olbset # set done - if ($?olbdel) unsetenv olbdel - if ($?tlbset) unsetenv tlbset - if ($?tlbdel) unsetenv tlbdel - if ($?taxset) unsetenv taxset - if ($?taxdel) unsetenv taxdel - else # normal - if ("$pcod" != "nl") then # check skip - if ($lobe !~ ??? ) continue # not 3 char. extension - set l01=(`echo $chtp | grep "$lobe "`) # see if exclude - if ("$l01" != "") continue # excluded - if ("$pq_d" != "") then # maybe pure only - set pq_d=`echo $pq_d | tr $Upc $Lowc` - set l01=(`echo $pq_d | grep ".$lobe"`) - if ("$l01" == "") continue # not in pure list - endif - endif - if ("$pcod" == "nc") then # ncomp - if (! -e ${lobh}.$lobe) then # try nget first - if ("$lobh:t" == "$lobh") then # do if same dir - source $WNG/nget.sun - endif - endif - endif - set findb="" # for repeat - source $WNG/${pnam}.sun # do a file - if ("$findb" != "") then # do .dsc output - set scd_p=$cd_p ; set cd_p="-" # no print - while ($#findb > 0) # more to do - set lob=$findb[1] ; shift findb # next name - if ($lob != "") then - set lobh=$lob:r ; set lobe=$lob:e # name/ext - source $WNG/${pnam}.sun # do a file - endif - end - set cd_p=$scd_p # restore print - endif - endif - end # more -# -# More to read -# - if ("$intat" == "x2") goto RLIN # next line -#endif -# -# Routines -# -#ifdef wn_vax__ -$ ! -$ ! Analyze codes -$ ! -$ NXANAL: -$ GC1A: L1="Y" !NO N SEEN -$ GC14: IF A0 .EQS. "" THEN RETURN !READY -$ L2=F$EXTRACT(0,1,A0) !CODE -$ IF L2 .EQS. "<" THEN GOSUB GA0 !SKIP <> -$ IF L2 .EQS. "<" THEN GOTO GC10 !CONTINUE -$ A0=A0-L2 !DELETE CODE -$ IF L2 .EQS. "-" THEN GOTO GC1A !SKIP - -$ L2=F$EDIT(L2,"UPCASE") -$ IF L2 .EQS. "N" .OR. L2 .EQS. "+" -$ THEN !NEGATE -$ L1="N" -$ GOTO GC14 -$ ENDIF -$ IF L2 .EQS. "Q" .AND. L1 !QUALIFIER -$ THEN -$ L2=F$EXTRACT(0,1,A0) !QUALIFIER -$ A0=A0-L2 -$ L2=F$EDIT(L2,"UPCASE") -$ IF QUAL-L2 .EQS. QUAL THEN GOTO GC1A !UNKNOWN QUALIFIER -$ GOSUB GA0 !GET QUAL. ARGUMENT -$ IF QUALA-L2 .EQS. QUALA .AND. A1.NES. "" -$ THEN -$ 'L2'Q_D="''A1'" !NOT ADDITIVE -$ ELSE -$ 'L2'Q_D='L2'Q_D+A1 !ADD QUALIFIER DATA -$ ENDIF -$ GOTO GC1A !CONTINUE -$ ENDIF -$ IF CODES-L2 .EQS. CODES THEN GOTO GC1A !UNKNOWN CODE -$ IF L1 -$ THEN -$ CD_'L2'="0" !SET STANDARD CODE -$ ELSE -$ CD_'L2'="-" !SET NO -$ GOTO GC1A -$ ENDIF -$ L0=F$EXTRACT(0,1,A0) !POSSIBLE DIGIT -$ IF "0123456789"-L0 .NES. "0123456789" -$ THEN !DIGIT -$ CD_'L2'=L0 !SET DIGIT -$ A0=A0-L0 !DELETE DIGIT FROM CODE -$ ENDIF -$ IF CODEX-L2 .EQS. CODEX THEN GOTO GC1A !NOT EXTENDED CODE -$ GOSUB GA0 !GET EXTENDED ARG. -$ IF A1 .NES. "" THEN 'L2'_D=A1 !NEW SETTING -$ GOTO GC1A !CONTINUE -$ ! -$ ! Get <string> -$ ! -$ GA0: A1="" !EMPTY RESULT -$ IF F$LENGTH("''A0'") .LT. 1 THEN RETURN !NO VALUE -$ IF F$EXTRACT(0,1,A0) .EQS. " " THEN GOTO GA0 !SKIP INIT. SPACE -$ IF F$EXTRACT(0,1,A0) .NES. "<" THEN RETURN !NO VALUE -$ L00=0 !COUNT <> -$ L01=0 !COUNT " -$ GA06: IF A0.EQS. "" !ERROR -$ THEN -$ A1="" -$ RETURN -$ ENDIF -$ L02=F$EXTRACT(0,1,A0) !CHAR. -$ A0=A0-L02 !SKIP CHAR -$ IF L01 .NE. 0 !STRING -$ THEN -$ IF "''L02'" .EQS. """" THEN L01=0 !RESET STRING -$ ELSE -$ IF "''L02'" .EQS. "<" !< -$ THEN -$ L00=L00+1 !COUNT < -$ IF L00 .EQ. 1 THEN GOTO GA06 !NO SAVE -$ ELSE -$ IF "''L02'" .EQS. ">" -$ THEN -$ L00=L00-1 !COUNT > -$ IF L00 .EQ 0 THEN RETURN !READY -$ ELSE -$ IF "''L02'" .EQS. """" THEN L01=1 !INDICATE " -$ ENDIF -$ ENDIF -$ ENDIF -$ A1=A1+L02 !SAVE CHAR -$ GOTO GA06 !CONTINUE -$ ! -$ ! NX1 Do a file. -$ ! -$ NX1: IF F$EXTRACT(0,1,L3) .EQS. "@" .AND. CD_Z .NES. "-" !IND. -$ THEN -$ IF L3-"@" .EQS. GQ_DX THEN L3=L3-"@" !STOP INFINITE LOOP -$ ENDIF -$ IF F$EXTRACT(0,1,L3) .EQS. "@" .AND. CD_Z .NES. "-" !IND. -$ THEN -$ L3=L3-"@" !FILE NAME -$ IF F$SEARCH(L3) .EQS. "" !NOT THERE -$ THEN -$ IF PCOD .NES. "NC" THEN RETURN !CANNOT DO -$ FNM=F$PARSE(L3,,,"NAME","SYNTAX_ONLY") !NAME -$ FTP=F$PARSE(L3,,,"TYPE","SYNTAX_ONLY") !TYPE -$ B0=15-F$LENGTH(FNM)-F$LENGTH(FTP) !MESSAGE POINTER -$ IF B0.LT.1 THEN B0=1 -$ MSGT=F$EXTRACT(0,B0," ") !TEXT -$ B1="Done: " !ASSUME OK -$ @WNG:NGET "''L3'" !TRY TO GET -$ IF F$SEARCH(L3) .EQS. "" THEN RETURN !NOT FOUND -$ ENDIF -$ L00="" !ADD Y -$ L01=0 -$ LP17: IF F$EXTRACT(L01,1,CODES) .EQS. "Y" -$ THEN -$ L00=L00+"0" -$ ELSE -$ L00=L00+CD_'F$EXTRACT(L01,1,CODES)' -$ ENDIF -$ L01=L01+1 -$ IF L01 .LT. F$LENGTH(CODES) THEN GOTO LP17 -$ GQ_DX="''L3'" !SAVE CURRENT NAME -$ @WNG:NXEC X2 'PNAM' 'PCOD' 'DEP' "''L00'" "''FG_CX'" - - "''L3'" !DO .GRP -$ ELSE -$ L3=L3-"@" !SURE FILE NAME -$ FNM=F$PARSE(L3,,,"NAME","SYNTAX_ONLY") !NAME -$ FTP=F$PARSE(L3,,,"TYPE","SYNTAX_ONLY") !TYPE -$ IF PCOD .NES. "NL" !NO CHECK FOR NLINK -$ THEN -$ IF F$LENGTH(FTP).NE.4 THEN RETURN !SKIP IF NOT 3 CHAR EXT. -$ IF F$LOCATE(FTP+",",CHTP) .LT. F$LENGTH(CHTP) THEN RETURN !FORGET -$ IF PQ_D .NES. "" !PURE GIVEN -$ THEN -$ PQ_D=F$EDIT(PQ_D,"UPCASE") -$ IF F$LOCATE(FTP-".",PQ_D) .EQ. F$LENGTH(PQ_D) THEN RETURN !NOT -$ ENDIF -$ B0=15-F$LENGTH(FNM)-F$LENGTH(FTP) !MESSAGE POINTER -$ ELSE -$ B0=10-F$LENGTH(FNM)-F$LENGTH(FTP) !MESSAGE POINTER -$ ENDIF -$ IF B0.LT.1 THEN B0=1 -$ IF PCOD .EQS. "NC" !MAYBE NGET FIRST -$ THEN -$ MSGT=F$EXTRACT(0,B0," ") !TEXT -$ B1="Done: " !ASSUME OK -$ IF F$SEARCH(L3) .EQS. "" THEN - !NGET FIRST - @WNG:NGET "''L3'" -$ B0=15-F$LENGTH(FNM)-F$LENGTH(FTP) !MESSAGE POINTER -$ ENDIF -$ IF B0.LT.1 THEN B0=1 -$ MSGT=F$EXTRACT(0,B0," ") !TEXT -$ B1="Done: " !ASSUME OK -$ @WNG:'PNAM' "''L3'" !DO -$ ENDIF -$ RETURN !OK -#endif -# -# EXIT -# -#ifdef wn_vax__ -$ EXEX: SET ON -$ IF INTAT .EQS. "X0" THEN SET TERM/ECHO !MAKE SURE -$ CLOSE/ERROR=EXX1 F'PID''DEP' !MAKE SURE -$ EXX1: CLOSE/ERROR=EXX2 FX2'PID''DEP' !MAKE SURE -$ EXX2: CLOSE/ERROR=EXX3 UP'PID''DEP' -$ EXX3: IF F$SEARCH("L''PID'''DEP'.TMP") .NES. "" THEN - - DELETE L'PID''DEP'.TMP;* -$ L0=F$VERIFY(VER) !RESET VERIFY -$ EXIT -#else -exex: - if ($?tlbset || $?olbset || $?tlbdel || $?olbdel || \ - $?taxset || $?taxdel) then # do ar - if ($?tlbset) then - echo "Update ${l_d}.tlb" \ - | tee -a $c_upd - ar crl $WNG_TLB/${l_d}.tlb $tlbset - endif - if ($?taxset) then - echo "Update ${l_d}_ax.tlb" \ - | tee -a $c_upd - ar crl $WNG_TLB/${l_d}_ax.tlb $taxset - endif - if ($?olbset) then - echo "Update ${l_d}.olb" \ - | tee -a $c_upd - ar crl $WNG_OLB/${l_d}.olb $olbset - 'rm' $olbset >& /dev/null - endif - if ($?tlbdel) then - echo "Update ${l_d}.tlb" \ - | tee -a $c_upd - ar dl $WNG_TLB/${l_d}.tlb $tlbdel - endif - if ($?taxdel) then - echo "Update ${l_d}_ax.tlb" \ - | tee -a $c_upd - ar dl $WNG_TLB/${l_d}_ax.tlb $taxdel - endif - if ($?olbdel) then - echo "Update ${l_d}.olb" \ - | tee -a $c_upd - ar dl $WNG_OLB/${l_d}.olb $olbdel - endif - if ($?olbset || $?olbdel) then - ranlib $WNG_OLB/${l_d}.olb # rearrange olb - endif - endif -exex1: - exit -#endif diff --git a/src/wng/nxec.sun b/src/wng/nxec.sun deleted file mode 100755 index 242b8cf01a801093786fee5f7f84f1b59414878c..0000000000000000000000000000000000000000 --- a/src/wng/nxec.sun +++ /dev/null @@ -1,814 +0,0 @@ -# nxec.ssc -# WNB 920908 -# -# Revisions: -# WNB 920930 Additions, overhaul, speed up -# WNB 921014 Add -a nnet -# WNB 921015 Change setting of WNG_OLB WNG_EXE -# WNB 921019 Auto nget for ncomp included -# WNB 921104 Typo (" missing); default u_d; fnam check -# WNB 921113 Do postponed ar -# WNB 921116 Add G qualifier and allow multi-level .grp -# WNB 921117 Add regular expressions -# WNB 921130 Stop multiple ar; correct set echo; tr for HP -# WNB 921208 Add date, list of directories; new update log -# WNB 921209 Add logical link test; -a0 switch -# WNB 921211 Add P qualifier -# WNB 921216 Add ## -# WNB 921230 Make SSC -# WNB 930108 Add X11 -# JPH 930225 -qv<x> option to start echo/verify with execution -# include $WNG_LINK in c-dir -# comments -# WNB 930301 Add aliases for # type; add +es for HP; add NSTAR_DIR -# WNB 930325 Cater for different fold -# WNB 930330 Add _ax.tlb; giplib.olb; pgplot.olb -# WNB 930405 Add SPAWN for better control (VAX) -# HjV 930416 Add path for include files for HP -# WNB 930427 More general include path HP -# WNB 930429 Add -lm for SUN; delete pgplot -# HjV 930503 Add -lm for HP; remove -lm for SUN -# WNB 930504 Problem linking NGCALC -# CMV 930906 Switches for SUN in RUG -# WNB 930921 Assume never WNG_OLB/WNG_EXE in VMS -# WNB 930922 WNG_OLB/WNG_EXE recursive calls -# WNB 931213 Proper X11 path -# WNB 931217 Add NCOPY to NSTAR_DIR -# WNB 940124 Add _stlb, _s1tlb -# -# Compile, link, maintain routines. Use as: -# Unix: $WNG/nxec.sun <type> [-<code>] ... [<name>,...] ... [-<code>] ... -# VAX: @WNG:NXEC ... -# -# Type can be: NCOMP Compile -# NLINK Link -# NGET Get from text library -# NXREF Make Fortran crossreference -# NDEL Delete -# NNET Get across net -# See Help (a ? in a parameter) for details. -# -# Uses environment variables: -# WNG where to find wng-type sources -# WNG_TYPE machine (sw, dw, hp, al, cv etc) -# WNG_OLBEXE root of wng-type .olb, .ppd, .exe -# WNG_SITE site (nfra, atnf, rug ...) -# EXEDWARF_UNIX where to find/set DWARF .exe, .ppd -# LIBDWARF where to find DWARF .olb -# and also possible: -# WNG_NODE node name (number) of central node -# WNG_NODEUSER user (or user and pw) at central node -# WNG_NODEDIR WNG-root dir at central node -# (DV:[...] or /.../......) -# NSTAR_DIR Newstar directories -# The following env. variables are optional, to be used to define -# a specific target file system (foreign host or shadow tree). Defaults are -# shown in parentheses, subdir is the name of the source's subdirectory -# under $WNG/.. . -# WNG_EXE (WNG_OLBEXE) parent of .exe target -# WNG_OLB (WNG_OLBEXE) parent of .olb target -# WNG_TLB current directory .tlb target -# WNG_ERR, WNG_LIS current directory .lis, .err target -# WNG_LINK current directory target for .f soft links (must -# be subdir of WNG_EXE, WNG_OLB -# or WNG/..) -# -# Intro -# - onintr exex # finish neatly - set intat=x0 # assume interactive - if ($?echo) unset echo # no verify - if ($?verbose) unset verbose # no verbose - set pid=$$ ; @ dep=1 # for tmp files - set Upc="ABCDEFGHIJKLMNOPQRSTUVWXYZ" # for translation - set Lowc="abcdefghijklmnopqrstuvwxyz" - set l1=(`echo a | fold -w1`) # check which fold - set l2=(`echo a | fold -w 1`) - if ( "$l1" == "a") then - set fold="fold -w" - else if ("$l2" == "a") then - set fold="fold -w " - else - set fold="fold -" - endif - if ($#argv > 5) then # maybe batch - if ("$1" =~ x[12]) then # batch - set intat=$1 ; shift # indicate batch - set pnam=$1; shift # set variables - set pcod=$1; shift - @ dep=$1 + 1; shift - endif - endif - set loo=(`date`) # get date/time - if ("$loo[3]" =~ [1-9]) set loo[3] = "0$loo[3]" # day - set loa=( Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec) - foreach mm ( 01 02 03 04 05 06 07 08 09 10 11 12) - if ("$loo[2]" == "$loa[$mm]") break # month - end - @ yy = $loo[$#loo] - 1900 # year - set c_date="$yy$mm$loo[3]" # date yymmdd - set c_time=`echo $loo[4] | tr -d ":"` # time hhmmss - set c_upd="UPD${c_date}.LOG" # log name - if (! -e $c_upd) then # create log - touch $c_upd - set loo=(`ls UPD*.LOG`) - while ($#loo > 2) - shift loo - end - if ($#loo < 2) set loo=("None") - echo "! $c_upd (Previous: $loo[1])" >>! $c_upd - endif -# -# Check environment -# - if ($USER == jph) then # set shadow system - set c_shadow - endif -# - if ("$intat" == "x0") then - if (! $?WNG || ! $?WNG_TYPE || ! $?WNG_OLBEXE ||\ - ! $?WNG_SITE) then - echo " Error: Must have environment variables" \ - | tee -a $c_upd - echo " WNG, WNG_TYPE, WNG_OLBEXE , WNG_SITE defined" \ - | tee -a $c_upd - goto exex - endif - if (! $?EXEDWARF_UNIX || ! $?LIBDWARF) then - echo " Warning: Cannot do everything with EXEDWARF_UNIX and/or" \ - | tee -a $c_upd - echo " LIBDWARF not defined" \ - | tee -a $c_upd - endif - if (! $?WNG_NODE) setenv WNG_NODE "" # node info - if (! $?WNG_NODEDIR) setenv WNG_NODEDIR "" - if (! $?WNG_NODEUSER) setenv WNG_NODEUSER "" - if ($?WNG_EXE) then # save original - set wng_sexe=$WNG_EXE - else - setenv WNG_EXE $WNG_OLBEXE # make names - endif - setenv WNG_EXE $WNG_EXE/$cwd:t - if ($?WNG_OLB) then # save original - set wng_solb=$WNG_OLB - else - setenv WNG_OLB $WNG_OLBEXE - endif - setenv WNG_OLB $WNG_OLB/$cwd:t - if ($?WNG_TLB) then # save original - set wng_stlb=$WNG_TLB - else - setenv WNG_TLB $cwd/.. - endif - setenv WNG_TLB $WNG_TLB/$cwd:t - if (! $?WNG_ERR) setenv WNG_ERR $cwd - if (! $?WNG_LIS) setenv WNG_LIS $cwd - if (! $?WNG_LINK) setenv WNG_LINK $cwd - if (! $?NSTAR_DIR) setenv NSTAR_DIR "wng dwarf nscan ncopy nmap nplot" - if (! -e $WNG_EXE) mkdir $WNG_EXE # make directories - if (! -e $WNG_OLB) mkdir $WNG_OLB - if (! -e $WNG_TLB) mkdir $WNG_TLB - if (! -e $WNG_ERR) mkdir $WNG_ERR - if (! -e $WNG_LIS) mkdir $WNG_LIS - if (! -e $WNG_LINK) mkdir $WNG_LINK - if (! -e WNG_DEF && -e $WNG/nxldef.sun) then # get links - source $WNG/nxldef.sun - endif - endif - set c_dir=($NSTAR_DIR) # N directories - if (-d $WNG/../ncopy && "$c_dir" !~ *ncopy*) set c_dir = ($c_dir ncopy) - set tmp=$WNG_LINK # $WNG_LINK:t not allwd - if ("$c_dir" !~ *"$tmp:t"*) set c_dir=($c_dir $tmp:t) # add WNG_LINK -# -# External environment -# - set ext=$WNG_TYPE # Machine type - set lnk_def=($WNG_OLBEXE/nscan/wnlib.olb \ - $WNG_OLBEXE/nmap/wnlib.olb \ - $WNG_OLBEXE/nplot/wnlib.olb) - if (-e $WNG_OLBEXE/wng/giplib.olb) then - set lnk_def=($lnk_def $WNG_OLBEXE/wng/giplib.olb) - if ("$ext" == "hp") then - set lnk_def=($lnk_def -lm) - endif - endif - set lnk_def=($lnk_def $WNG_OLBEXE/wng/wnlib.olb \ - -L/usr/local/X11/lib -lX11) # default libraries - if ($?WNG_LDFILES) then - set lnk_use=($WNG_LDFILES) # user libraries - else - set lnk_use="" - endif - set fortran=f77 ; set xfort="" ; set lfort="" # Fortran compiler - set cee=cc ; set xcee="" # C compiler - set assem=as ; set xassem="" # Assembler -# -# nxec environment -# - set chtp=(.dir .err .exe .hlb .jou .lis .log .lst .map .mlb \ - .new .npd .obj .olb .old .ppd .tlb .tmp \ - .udf .ulb) # files to skip - set codes=(a b c d l o p s u x y z) # known codes - set scodes=abcdlopsuxyz # compressed - set codex=(l u) ; set scodex=lu # extended codes - set qual=(b c f g l m o p v) ; set squal=bcfglmopv # qualifiers - set quala=(b c f l m o p) ; set squala=bcflmop # additive qualifiers - set ncc_d=cdloxz ; set nnc_d=z # default codes - set ndc_d=aclz ; set ngc_d=lz ; set nlc_d=sz - set fnam="" # no names - if ("$intat" == "x0") then # interactive - set l_d=wnlib ; set u_d=" " # lib. name; dwarf dir. - foreach i ($codes) # define all codes - set cd_$i="-" - end - foreach i ($qual) # define all qualifiers - set ${i}q_d="" - end - else # batch - set loo=($1) ; shift ; set fg_cd=($loo) # codes - foreach i ($codes) - set cd_$i=$loo[1] ; shift loo # copy codes - end - set loo=($1) ; shift ; set fg_cx=($loo) # extended codes - foreach i ($codex) - if ("$loo[1]" == "-") then # empty - set ${i}_d=" " - else - set ${i}_d="$loo[1]" - endif - shift loo - end - endif -# -# Machine environment -# - switch ($ext) # Machine - case al: # Alliant - set dattp=3 ; set fortran=fortran ; set lfort="-g -M" - set fq_d=(-c -e -w ) ; set cq_d=(-c -ce -w) - breaksw - case dw: # DEC workstation - set dattp=6 ; set xfort="-assume back" - set lfort="-g -assume back -Wl,-M" - set fq_d=(-c -V -w) ; set cq_d=(-c -w) - breaksw - case sw: # SUN workstation - set dattp=7 ; set xfort="-xl -Nl50" - set lfort="-g -xl -Qoption ld -M" - if ($WNG_SITE == rug) set lfort=( $lfort -Bstatic ) - set fq_d=(-c -w) ; set cq_d=(-c -ce -w) - if ($WNG_SITE == rug) set fq_d=( $fq_d -Nn1500 ) - breaksw - case cv: # Convex - set dattp=5 ; set fortran=fc ; set xfort="-LST" - set lfort="-g -sa -vfc -O3 -na -nw -M" - set fq_d=(-c -na -nw -vfc -sa) ; set cq_d=(-c -na -nw) - breaksw - case hp: # HP workstation - set dattp=8 ; set xfort="-Nl50" ; set lfort="-g +e +es +ppu" - set fq_d=(-c -w +e +es +ppu) - set cq_d=(-c -w) - if (-d /usr/include/X11R5) then - set cq_d=($cq_d -I/usr/include/X11R5) - else - set cq_d=($cq_d -I/usr/include/X11R4) - endif - breaksw - default: - echo " Error: Unknown machine type $ext" \ - | tee -a $c_upd - goto exex - endsw - if ("$intat" != "x0") then # reset qualifiers - foreach i ($qual) # qualifiers - set loa=(`eval echo \$${i}Q_D`) # name - set ${i}q_d="$loa" - end - endif -# -# Get execution type -# - if ("$intat" == "x0") then # interactive - if ($#argv < 1) set argv="Empty" # type given - switch ($1) - case [nN][cC]*: - set pnam=ncomp ; set pcod=nc - breaksw - case [nN][lL]*: - set pnam=nlink ; set pcod=nl - breaksw - case [nN][dD]*: - set pnam=ndel ; set pcod=nd - breaksw - case [nN][gG]*: - set pnam=nget ; set pcod=ng - breaksw - case [nN][xX]*: - set pnam=nxref ; set pcod=nx - breaksw - case [nN][nN]*: - set pnam=nnet ; set pcod=nn - breaksw - default: - csh -f $WNG/nhelp.sun 1 $1 $ext " " " " " " # basic help - goto exex - endsw -# -# See if Help -# - while ($#argv < 2) # ask codes - set l2="-${scodes}q($squal)" - echo -n "Codes ($l2) [?]: " - set argv=($1 $<) # get codes - if ($#argv < 2 || "$*" =~ *\?*) then # help codes - foreach i ($qual) # export qualifiers - set loa=(`eval echo \$${i}q_d`) - setenv ${i}Q_D "$loa" - end - csh -f $WNG/nhelp.sun 2 $pnam $ext $pcod $pnam "$chtp" - endif - end - shift # delete code - endif -# -# Read line -# -RLIN: - if ("$intat" == "x2") then # read file - set argv=($<) # get line - if ("$*" == "") goto RLIN # empty line - if ("$*" =~ endend*) goto exex # ready - if ("$*" =~ \$*) goto RLIN # VMS - if ("$*" =~ \#*) then # Unix command - source $WNG/wngcshrc.sun # make aliases known - set loa="0" # do not execute - if ("$*" =~ \#\#*) then # limit application? - set loo=(`echo "$*" | tr $Upc $Lowc | awk '{print substr($0,1,5)}'`) - if ("$loo" == \#\#$pcod\#) then # selected - set loo=(`echo "$*" | awk '{print substr($0,6)}'`) - set loa="1" - endif - else - set loo=(`echo "$*" | awk '{print substr($0,2)}'`) - set loa="1" - endif - if ("$loa" == "1") then # execute line - set wng_s1exe=$WNG_EXE # save current - if ($?wng_sexe) then # reset original - setenv WNG_EXE $wng_sexe - else - unsetenv WNG_EXE - endif - set wng_s1olb=$WNG_OLB # save current - if ($?wng_solb) then # reset original - setenv WNG_OLB $wng_solb - else - unsetenv WNG_OLB - endif - set wng_s1tlb=$WNG_TLB # save current - if ($?wng_stlb) then # reset original - setenv WNG_TLB $wng_stlb - else - unsetenv WNG_TLB - endif - eval $loo # do line - setenv WNG_EXE $wng_s1exe # restore current - setenv WNG_OLB $wng_s1olb - setenv WNG_TLB $wng_s1tlb - endif - goto RLIN # next line - endif - set argv=($*) # split in fields - endif -# -# Get codes and filenames -# - set a0="" # no codes; del. type - while ($#argv > 0) - if ("$1" == "-" || "$1" == "+") then # empty code - else if ("$1" =~ -* || "$1" =~ [+\<]*) then # code - set a0=("$a0""$1") # add - else # file name - set noglob; set fnam=($fnam $1); unset noglob - endif - shift # next argument - end - if ("$intat" == "x0") then # add defaults - set l0=\$\?${pcod}_COD # default name - if (`eval echo "$l0"`) then # user defaults - set l0=\$${pcod}_COD - set a0=(`eval echo $l0`"-$a0") - endif - set l0=\$${pcod}c_d # default name - set a0=(`eval echo $l0`"-$a0") # program default - echo "-----" >>! $c_upd - echo "---- $pnam -$a0 $fnam" >>! $c_upd # log call - echo "-----" >>! $c_upd - source $WNG/nxanal.sun # analyze codes - else if ("$intat" == "x1" && "$a0" != "") then # codes given - source $WNG/nxanal.sun # analyze codes - endif -# -# Interpret codes -# - if ($?echo) unset echo # no verify - if ($?verbose) unset verbose # no verbose - if ($vq_d != "") then - if ($vq_d =~ *e* && $vq_d !~ *x*) set echo # echo asked - if ($vq_d =~ *v* && $vq_d !~ *x*) set verbose # verbose asked - endif -# -# Network info -# - if ("$intat" == "x0") then # skip for batch - if ($pcod == nn) then # maybe ask - if ("$cd_a" == "0" || "$WNG_NODE" == "") then # must ask - set loo="" - while ("$loo" == "") - echo -n "Node [$WNG_NODE]: " - set loo=("$<") - if ("$loo" == "") set loo=("$WNG_NODE") #default - setenv WNG_NODE "$loo" - end - endif - if ("$cd_a" == "0" || "$WNG_NODEDIR" == "") then # must ask - set loo="" - while ("$loo" == "") - echo -n "Remote base directory [$WNG_NODEDIR]: " - set loo=("$<") - if ("$loo" == "") set loo=("$WNG_NODEDIR") #default - setenv WNG_NODEDIR "$loo" - end - endif - if ("$cd_a" == "0" || "$WNG_NODEUSER" == "") then # must ask - set loo="" - while ("$loo" == "") - echo -n "Remote user [$WNG_NODEUSER]: " - set loo=("$<") - if ("$loo" == "") set loo=("$WNG_NODEUSER") #default - setenv WNG_NODEUSER "$loo" - end - endif -# -# Network password -# - set loo=($WNG_NODEUSER) # split - if ($#loo < 2) then # ask pw - echo -n "Password: " - stty -echo ; set loa="$<" ; stty echo ; echo " " # get it - setenv WNG_NODEUSER "$loo $loa" - endif - endif -# -# Compiler info -# - switch ($ext) # Machine - case al: # Alliant - if ("$cd_d" != "-") then - set fq_d=($fq_d -g) ; set cq_d=($cq_d -g) # debug - endif - if ("$cd_x" != "-") then - set fq_d=($fq_d -xref) # Fortran Xref - endif - if ("$cd_o" != "-") then - set fq_d=($fq_d -O -OM -alt) ; set cq_d=($cq_d -O) # optimize - endif - breaksw - case dw: # DEC workstation - if ("$cd_d" != "-") then - set fq_d=($fq_d -g) ; set cq_d=($cq_d -g) # debug - endif - if ("$cd_x" != "-") then - set fq_d=($fq_d -xref) # Fortran Xref - endif - if ("$cd_o" != "-") then - set fq_d=($fq_d -O1) ; set cq_d=($cq_d -O1) # optimize - endif - breaksw - case sw: # SUN workstation - if ("$cd_d" != "-") then - set fq_d=($fq_d -g) ; set cq_d=($cq_d -g) # debug - endif - if ("$cd_x" != "-") then - endif - if ("$cd_o" != "-" && "$cd_d" == "-") then - set fq_d=($fq_d -O3) ; set cq_d=($cq_d -O) # optimize - endif - breaksw - case cv: # Convex - if ("$cd_d" != "-") then - set fq_d=($fq_d -g) ; set cq_d=($cq_d -g) # debug - endif - if ("$cd_x" != "-") then - set fq_d=($fq_d -xr) # Fortran Xref - endif - if ("$cd_o" != "-" && "$cd_d" == "-") then - set fq_d=($fq_d -O3) ; set cq_d=($cq_d -O) # optimize - endif - breaksw - case hp: # HP workstation - if ("$cd_d" != "-") then - set fq_d=($fq_d -g) ; set cq_d=($cq_d -g) # debug - endif - if ("$cd_x" != "-") then - endif - if ("$cd_o" != "-" && "$cd_d" == "-") then - set fq_d=($fq_d -O) ; set cq_d=($cq_d -O) # optimize - endif - breaksw - default: - echo " Error: Unknown machine type $ext" \ - | tee -a $c_upd - goto exex - endsw -# -# Format qualifiers -# - foreach i ($qual) - set loa=(`eval echo \$${i}q_d`) # qualifier name - set lob=(`echo $loa | ${fold}1`) # qual value - set loc="" # build new qual - while ($#lob > 0) - if ("$lob[1]" == "-" || "$lob[1]" == "+") then # add space - set loc="$loc $lob[1]" - else - set loc="$loc$lob[1]" - endif - shift lob # next character - end - set ${i}q_d="$loc" # new qualifier - end -# -# Create libraries -# - if ("$cd_l" != "-") then # library needed - set l_d=`echo $l_d:r | tr $Upc $Lowc` # library root - if (! -e $WNG_OLB/${l_d}.olb) ar cr $WNG_OLB/${l_d}.olb # create olb - if (! -e $WNG_TLB/${l_d}.tlb) ar cr $WNG_TLB/${l_d}.tlb # create tlb - if (! -e $WNG_TLB/${l_d}_ax.tlb) ar cr $WNG_TLB/${l_d}_ax.tlb - if (! -e $WNG_OLB/${l_d}.olb || ! -e $WNG_TLB/${l_d}.tlb || \ - ! -e $WNG_TLB/${l_d}_ax.tlb) then - echo " Error: Illegal Library name." \ - | tee -a $c_upd - echo " Probably illegal L<name> specified" \ - | tee -a $c_upd - goto exex - endif - endif -# -# DWARF data -# - if ("$cd_s" != "-" && $pcod == "nl") then - if (! $?EXEDWARF_UNIX || ! $?LIBDWARF) then # cannot DWARF - set cd_s="-" # no shared - endif - endif -# -# Get files if none -# - while ("$fnam" == "") # no filenames - echo -n "Filename[ ...] [?]: " # get filename - set fnam=($<) - if ("$fnam" == "") then - csh -f $WNG/nhelp.sun 3 $pnam $ext $pcod $pnam "$chtp" # file help - endif - end - endif -# -# Do batch if asked -# - if ("$intat" == "x0") then # prepare batch - set fg_cd="" ; set fg_cx="" # prepare codes - foreach i ($codes) - set fg_cd=($fg_cd `eval echo \$cd_$i`) - end - foreach i ($codex) # extended codes - set l0=(`eval echo \$${i}_d`) - if ("$l0" == "") set l0="-" - set fg_cx=($fg_cx $l0) - end - foreach i ($qual) # export qualifiers - set loa=(`eval echo \$${i}q_d`) - setenv ${i}Q_D "$loa" - end - if ("$cd_b" != "-") then # do batch - if ($cd_b == 0) then # no log - csh -f $WNG/nxec.sun x1 $pnam $pcod $dep "$fg_cd" "$fg_cx" \ - "$fnam" >>&! /dev/null & - else # log - csh -f $WNG/nxec.sun x1 $pnam $pcod $dep "$fg_cd" "$fg_cx" \ - "$fnam" >>&! nx${pid}.log & - endif - goto exex1 # ready - endif - endif - if ("$intat" == "x2" && "$a0" != "") then # local switches - csh -f $WNG/nxec.sun x1 $pnam $pcod $dep "$fg_cd" "$fg_cx" \ - $fnam $a0 - set fnam="" # set done - if ($?olbset) unsetenv olbset # set done - if ($?olbdel) unsetenv olbdel - if ($?tlbset) unsetenv tlbset - if ($?tlbdel) unsetenv tlbdel - if ($?taxset) unsetenv taxset - if ($?taxdel) unsetenv taxdel - endif -# -# Execute -# - if ($vq_d != "") then - if ($vq_d =~ *e* && $vq_d =~ *x*) set echo # echo asked - if ($vq_d =~ *v* && $vq_d =~ *x*) set verbose # verbose asked - endif - if ("$intat" != "x0" && "$cd_y" == "-") then # execute batch - set b_aa="-" ; set b_ab="-" ; set b_ac="-" - foreach i ($qual) # set all qualifiers - set l0=(`eval echo \$${i}q_d`) - if ("$l0" != "") then # set qual - set b_aa="${b_aa}q$i<$l0>" - endif - end - foreach i ($codes) # set all codes - set l0=(`eval echo \$cd_$i`) - if ("$l0" != "-") then # set normal code - set b_ab="${b_ab}$i$l0" - if ("$i" =~ [$scodex]) then # set extended code - set l1=(`eval echo \$${i}_d`) - set b_ac="${b_ac}${i}$l0<$l1>" - endif - endif - end - echo "" ; echo "Command: $pnam $b_ab" - echo " $b_ac" ; echo " $b_aa" - echo " $fnam" ; echo "" - endif -# -# Do all files -# - while ("$fnam" != "") # not ready - set lob="`set noglob; echo $fnam[1] | tr $Upc $Lowc; unset noglob`" # lc - shift fnam # file name - set l00="`set noglob; echo $lob | grep [^a-z\.0-9_/]; unset noglob`" - # see if regular exp. - if ("$pcod" != "nl" && "$l00" != "") then # regular expression - set l00=(`ar t $WNG_TLB/${l_d}.tlb | grep "$lob"`) # get file names - if ("$l00" != "") then # files found - set loo=($fg_cd) ; @ lop=1 # add y - foreach i ($codes) - if ("$i" == "y") set loo[$lop]="0" - @ lop += 1 - end - csh -f $WNG/nxec.sun x1 $pnam $pcod $dep "$loo" "$fg_cx" \ - "$l00" # do files - if ($?olbset) unsetenv olbset # set done - if ($?olbdel) unsetenv olbdel - if ($?tlbset) unsetenv tlbset - if ($?tlbdel) unsetenv tlbdel - if ($?taxset) unsetenv taxset - if ($?taxdel) unsetenv taxdel - endif - continue # next file - endif - set l1="" # not indirect - if ("$lob" =~ "@*") then # indirect - set lob=`echo $lob | tr -d "@"` ; set l1="@" # delete @; set indir. - endif - set lobh=$lob:r ; set lobe=$lob:e # file name/ext - if ($lobe == "" && "$cd_y" == "-" && $pcod != nl) then # no extension - set l00=(`ls ${lobh}.*`) # see if files - if ("$l00" != "") then # files found - if ("$l1" == "@") then # indirect - @ i = 0 # add @ to names - while ($i < $#l00 ) - @ i += 1 - set l00[$i]="@$l00[$i]" - end - endif - set loo=($fg_cd) ; @ lop=1 # add y - foreach i ($codes) - if ("$i" == "y") set loo[$lop]="0" - @ lop += 1 - end - csh -f $WNG/nxec.sun x1 $pnam $pcod $dep "$loo" "$fg_cx" \ - "$l00" # do files - if ($?olbset) unsetenv olbset # set done - if ($?olbdel) unsetenv olbdel - if ($?tlbset) unsetenv tlbset - if ($?tlbdel) unsetenv tlbdel - if ($?taxset) unsetenv taxset - if ($?taxdel) unsetenv taxdel - endif - continue # next file - endif - if ("$lobe" == "grp" && "$cd_z" != "-" && $l1 == "") \ - set l1 = "@" # indirect -# -# Do a file. -# - if ("$l1" == "@" && "$cd_z" != "-") then # indirect possible - if ("$gQ_D" == "$lobh:t.$lobe") set l1 = "" # stop indirect loop - endif - if ("$l1" == "@" && "$cd_z" != "-") then # indirect - if (! -e ${lobh}.$lobe) then # file not known - if ("$pcod" != "nc") continue # forget if not ncomp - if ("$lobh:t" != "$lobh") continue # forget if other dir - source $WNG/nget.sun # get it first - if (! -e ${lobh}.$lobe) continue # not found - endif - set loo=($fg_cd) ; @ lop=1 # add y - foreach i ($codes) - if ("$i" == "y") set loo[$lop]="0" - @ lop += 1 - end - setenv gQ_D "$lobh:t.$lobe" # save current name - awk -F! '{print $1} END {print "endend"}' ${lobh}.$lobe | \ - csh -f $WNG/nxec.sun x2 $pnam $pcod $dep "$loo" "$fg_cx" - if ($?olbset) unsetenv olbset # set done - if ($?olbdel) unsetenv olbdel - if ($?tlbset) unsetenv tlbset - if ($?tlbdel) unsetenv tlbdel - if ($?taxset) unsetenv taxset - if ($?taxdel) unsetenv taxdel - else # normal - if ("$pcod" != "nl") then # check skip - if ($lobe !~ ??? ) continue # not 3 char. extension - set l01=(`echo $chtp | grep "$lobe "`) # see if exclude - if ("$l01" != "") continue # excluded - if ("$pq_d" != "") then # maybe pure only - set pq_d=`echo $pq_d | tr $Upc $Lowc` - set l01=(`echo $pq_d | grep ".$lobe"`) - if ("$l01" == "") continue # not in pure list - endif - endif - if ("$pcod" == "nc") then # ncomp - if (! -e ${lobh}.$lobe) then # try nget first - if ("$lobh:t" == "$lobh") then # do if same dir - source $WNG/nget.sun - endif - endif - endif - set findb="" # for repeat - source $WNG/${pnam}.sun # do a file - if ("$findb" != "") then # do .dsc output - set scd_p=$cd_p ; set cd_p="-" # no print - while ($#findb > 0) # more to do - set lob=$findb[1] ; shift findb # next name - if ($lob != "") then - set lobh=$lob:r ; set lobe=$lob:e # name/ext - source $WNG/${pnam}.sun # do a file - endif - end - set cd_p=$scd_p # restore print - endif - endif - end # more -# -# More to read -# - if ("$intat" == "x2") goto RLIN # next line -# -# Routines -# -# -# EXIT -# -exex: - if ($?tlbset || $?olbset || $?tlbdel || $?olbdel || \ - $?taxset || $?taxdel) then # do ar - if ($?tlbset) then - echo "Update ${l_d}.tlb" \ - | tee -a $c_upd - ar crl $WNG_TLB/${l_d}.tlb $tlbset - endif - if ($?taxset) then - echo "Update ${l_d}_ax.tlb" \ - | tee -a $c_upd - ar crl $WNG_TLB/${l_d}_ax.tlb $taxset - endif - if ($?olbset) then - echo "Update ${l_d}.olb" \ - | tee -a $c_upd - ar crl $WNG_OLB/${l_d}.olb $olbset - 'rm' $olbset >& /dev/null - endif - if ($?tlbdel) then - echo "Update ${l_d}.tlb" \ - | tee -a $c_upd - ar dl $WNG_TLB/${l_d}.tlb $tlbdel - endif - if ($?taxdel) then - echo "Update ${l_d}_ax.tlb" \ - | tee -a $c_upd - ar dl $WNG_TLB/${l_d}_ax.tlb $taxdel - endif - if ($?olbdel) then - echo "Update ${l_d}.olb" \ - | tee -a $c_upd - ar dl $WNG_OLB/${l_d}.olb $olbdel - endif - if ($?olbset || $?olbdel) then - ranlib $WNG_OLB/${l_d}.olb # rearrange olb - endif - endif -exex1: - exit diff --git a/src/wng/nxfor.com b/src/wng/nxfor.com deleted file mode 100755 index 4faa37b244ae998eb44613f7dc55c0ea0bfefe40..0000000000000000000000000000000000000000 --- a/src/wng/nxfor.com +++ /dev/null @@ -1,17 +0,0 @@ -$!# nxfor.ssc -$!# WNB 921214 -$!# -$!# Revisions: -$!# WNB 921215 Add ifndef -$!# WNB 921218 Add wn_site__ -$!# WNB 921230 Creation message; make SSC -$!# WNB 930108 Correct unix part for site dependencies -$!# WNB 930302 Add /bin/csh -$!# WNB 930330 Add wn_gipsy__ and wn_pgplot__ -$!# WNB 930428 Correct Unix gipsy test -$!# Delete pgplot reference -$!# Make Unix awk -$!# WNB 930429 Make VAX awk -$!# WNB 930615 Proper delete .TMP -$!# -$!# Convert the standard input to standard output diff --git a/src/wng/nxfor.ssc b/src/wng/nxfor.ssc deleted file mode 100644 index 74e8cb2b6c80e9d447501d210b2a2edd418eeba9..0000000000000000000000000000000000000000 --- a/src/wng/nxfor.ssc +++ /dev/null @@ -1,358 +0,0 @@ -# nxfor.ssc -# WNB 921214 -# -# Revisions: -# WNB 921215 Add ifndef -# WNB 921218 Add wn_site__ -# WNB 921230 Creation message; make SSC -# WNB 930108 Correct unix part for site dependencies -# WNB 930302 Add /bin/csh -# WNB 930330 Add wn_gipsy__ and wn_pgplot__ -# WNB 930428 Correct Unix gipsy test -# Delete pgplot reference -# Make Unix awk -# WNB 930429 Make VAX awk -# WNB 930615 Proper delete .TMP -# -# Convert the standard input to standard output -# by expanding #ifdef/#ifndef/#else/#endif -# with def arguments: wn_mm__ (mm = machine, eg dw) or -# wn_s..s__ (s..s = site e.g. nfra) or -# wn_gipsy__ -# End given by single line "endend"; -# error messages given in efnm. -# Use as: -# csh -f $WNG/nxfor.sun efnm [vax|unix] (Unix) -# @WNG:NXFOR fsc for error [vax|unix] (VAX) -# -# Uses environment variables: -# WNG_TYPE, WNG_SITE machine type, site -# -# Intro -# -#ifdef wn_vax__ -$ ON ERROR THEN GOTO EXEX -$ PID=F$EXTRACT(4,4,F$GETJPI("","PID")) !FOR FILES -$ DEP=F$ENVIRONMENT("DEPTH") -$ IF F$SEARCH("WNG:GAWK.EXE") .EQS. "" !NO AWK PRESENT -$ THEN -$ NAWK="Y" !NO AWK -$ LCNT=0 !LINE COUNT -$ CNT=0 !LEVEL -$ WROUT="Y" !WRITE -$ PWR=WROUT !PREVIOUS WRITE -$ TOUT="" !MEMORY -$ TELSE="" -$ ELSE -$ NAWK="$WNG:GAWK" !AWK PRESENT -$ ENDIF -$ IF P4 .EQS. "" THEN P4="VX" -$ P4=F$EDIT(P4,"UPCASE") -$ LP4=F$LENGTH(P4) -$ LSITE=F$LENGTH(WNG_SITE) !LENGTH SITE NAME -$ XGIP="NOGIPSY" -$ IF F$SEARCH("WNG_OLBEXE:[WNG]GIPLIB.OLB") .NES. "" THEN - - XGIP="gipsy" -$ CLOSE/ERROR=LA1 NXFI'PID''DEP' !MAKE SURE -$ LA1: CLOSE/ERROR=LA2 NXFE'PID''DEP' -$ LA2: -$ IF P4 .EQS. "VAX" -$ THEN -$ S1="$ ! Created from ''P1' on ''F$TIME()' "+ - - "at ''F$GETSYI("NODENAME")'" -$ S2="$ !" -$ S3="$ !" -$ ELSE -$ IF P4 .EQS. "UNIX" -$ THEN -$ S1="#!/bin/csh" -$ S2="# Created from ''P1' on ''F$TIME()' "+ - - "at ''F$GETSYI("NODENAME")'" -$ S3="#" -$ ELSE -$ S1="C+ Created from ''P1' on ''F$TIME()' "+ - - "at ''F$GETSYI("NODENAME")'" -$ S2="C" -$ S3="C-" -$ ENDIF -$ ENDIF -#else - onintr exex # finish neatly - if ($?echo) unset echo # no verify - if ($?verbose) unset verbose # no verbose - set pid=$$ # for temp - set c_date=(`date`) - if ("$2" == "") then # for SSC - set lsite=$WNG_TYPE - else - set lsite=$2 - endif - set xgip="nogipsy" - if (-e $WNG_OLBEXE/wng/giplib.olb) set xgip="gipsy" - set lfile=$1:r - set lfile=$lfile:t - if ("$lsite" == "vax") then - set s1="$ ! Created from ${lfile}.ssc on $c_date at `hostname`" - set s2="$ ! " - set s3="$ ! " - else if ("$lsite" == "unix") then - set s1="#\!/bin/csh" - set s2="# Created from ${lfile}.ssc on $c_date at `hostname`" - set s3="#" - else - set s1="C+ Created from ${lfile}.fsc on $c_date at `hostname`" - set s2="C" - set s3="C-" - endif -#endif -# -# Open files -# -#ifdef wn_vax__ -$ IF NAWK -$ THEN -$ OPEN/ERROR=ERR/READ NXFI'PID''DEP' 'P1' -$ WRITE 'P2' "''S1'" !INTRO TEXT -$ WRITE 'P2' "''S2'" -$ WRITE 'P2' "''S3'" -$ ENDIF -#endif -# -# Read input -# -#ifdef wn_vax__ -$ IF NAWK !NO AWK -$ THEN -$ LP1: -$ READ/ERROR=ERR/END=LP2 NXFI'PID''DEP' L0 !READ LINE -$ LCNT=LCNT+1 -$ L2=F$EDIT(L0,"COLLAPSE,UNCOMMENT,UPCASE") !FOR CHECK -$ IF F$EXTRACT(0,6,L2) .EQS. "#IFDEF" !DO IF -$ THEN -$ CNT=CNT+1 !COUNT IF -$ TOUT="''TOUT'"+",''PWR'" !SAVE PREVIOUS -$ TELSE="''TELSE'"+",N" -$ PWR=WROUT -$ IF F$EXTRACT(6,5+LP4,L2) .EQS. "WN_''P4'__" .OR. - - F$EXTRACT(6,5+LSITE,L2) .EQS. "WN_''WNG_SITE'__" .OR. - - F$EXTRACT(6,5+5,L2) .EQS. "WN_''XGIP'__" !THIS ONE -$ THEN -$ WROUT=PWR !DO AS IS -$ ELSE -$ WROUT="N" -$ ENDIF -$ ELSE -$ IF F$EXTRACT(0,7,L2) .EQS. "#IFNDEF" !DO IF -$ THEN -$ CNT=CNT+1 !COUNT IF -$ TOUT="''TOUT'"+",''PWR'" !SAVE PREVIOUS -$ TELSE="''TELSE'"+",N" -$ PWR=WROUT -$ IF F$EXTRACT(7,5+LP4,L2) .EQS. "WN_''P4'__" .OR. - - F$EXTRACT(7,5+LSITE,L2) .EQS. "WN_''WNG_SITE'__" .OR. - - F$EXTRACT(7,5+5,L2) .EQS. "WN_''XGIP'__" !THIS ONE -$ THEN -$ WROUT="N" !DO AS IS -$ ELSE -$ WROUT=PWR -$ ENDIF -$ ELSE -$ IF F$EXTRACT(0,5,L2) .EQS. "#ELSE" -$ THEN -$ IF CNT .LT. 1 .OR. F$ELEMENT(CNT,",",TELSE) !CANNOT BE -$ THEN -$ CNT=-2 -$ GOTO LP2 -$ ENDIF -$ TELSE=F$EXTRACT(0,F$LENGTH(TELSE)-2,TELSE)+",Y" !ELSE SEEN -$ IF PWR !SHOULD CHANGE -$ THEN -$ IF WROUT -$ THEN -$ WROUT="N" -$ ELSE -$ WROUT="Y" -$ ENDIF -$ ENDIF -$ ELSE -$ IF F$EXTRACT(0,6,L2) .EQS. "#ENDIF" -$ THEN -$ IF CNT .GT. 0 -$ THEN -$ WROUT=PWR !RESTORE -$ TELSE=F$EXTRACT(0,F$LENGTH(TELSE)-2,TELSE) -$ PWR=F$ELEMENT(CNT,",",TOUT) -$ TOUT=F$EXTRACT(0,F$LENGTH(TOUT)-2,TOUT) -$ CNT=CNT-1 -$ ELSE -$ CNT=-1 -$ GOTO LP2 !ERROR -$ ENDIF -$ ELSE -$ IF WROUT -$ THEN -$ IF F$EXTRACT(0,1,L2) .EQS. "#" .AND. - - (P4 .EQS. "VAX" .OR. P4 .EQS. "UNIX") -$ THEN !SKIP COMMENTS -$ IF P4 .EQS. "VAX" -$ THEN -$ WRITE 'P2' "$!"+L0 -$ ELSE -$ WRITE 'P2' L0 -$ ENDIF -$ ELSE -$ WRITE 'P2' L0 !COPY -$ ENDIF -$ ENDIF -$ ENDIF -$ ENDIF -$ ENDIF -$ ENDIF -$ GOTO LP1 !MORE LINES -$ ELSE !AWK -$ IF F$SEARCH("AWK''PID'''DEP'.TMP") .NES. "" THEN - - DELETE AWK'PID''DEP'.TMP;* -$ OPEN/ERROR=ERR/WRITE NXFI'PID''DEP' AWK'PID''DEP'.TMP !CREATE AWK FILE -$ WRITE NXFI'PID''DEP' - - "BEGIN {print ""''S1'""; print ""''S2'""; print ""''S3'"";" -$ WRITE NXFI'PID''DEP' - - "cnt = 0; wr = 1; pwr = wr}" -$ WRITE NXFI'PID''DEP' - - "/^endend$/ {exit}" -$ WRITE NXFI'PID''DEP' - - "/^[ ]*#[ ]*ifdef[ ][ ]*/ {" -$ WRITE NXFI'PID''DEP' - - "cnt += 1; tout[cnt] = pwr; telse[cnt] = 0; pwr = wr;" -$ WRITE NXFI'PID''DEP' - - "if ($0 ~ /^.*ifdef[ ]*wn_"+ - - "''F$EDIT(WNG_SITE,"LOWERCASE")'__/ || \" -$ WRITE NXFI'PID''DEP' - - "$0 ~ /^.*ifdef[ ]*wn_"+ - - "''F$EDIT(P4,"LOWERCASE")'__/ || \" -$ WRITE NXFI'PID''DEP' - - "$0 ~ /^.*ifdef[ ]*wn_''XGIP'__/)" -$ WRITE NXFI'PID''DEP' - - "{wr = pwr} else {wr = -1}; next}" -$ WRITE NXFI'PID''DEP' - - "/^[ ]*#[ ]*else/ {" -$ WRITE NXFI'PID''DEP' - - "if (cnt < 1 || telse[cnt] == 1) {cnt = -1; exit};" -$ WRITE NXFI'PID''DEP' - - "telse[cnt] = 1;" -$ WRITE NXFI'PID''DEP' - - "if (pwr == 1) {wr = -wr}; next}" -$ WRITE NXFI'PID''DEP' - - "/^[ ]*#[ ]*ifndef[ ][ ]*/ {" -$ WRITE NXFI'PID''DEP' - - "cnt += 1; tout[cnt] = pwr; telse[cnt] = 0; pwr = wr;" -$ WRITE NXFI'PID''DEP' - - "if ($0 ~ /^.*ifndef[ ]*wn_"+ - - "''F$EDIT(WNG_SITE,"LOWERCASE")'__/ || \" -$ WRITE NXFI'PID''DEP' - - "$0 ~ /^.*ifndef[ ]*wn_"+ - - "''F$EDIT(P4,"LOWERCASE")'__/ || \" -$ WRITE NXFI'PID''DEP' - - "$0 ~ /^.*ifndef[ ]*wn_''XGIP'__/)" -$ WRITE NXFI'PID''DEP' - - "{wr = -1} else {wr = pwr}; next}" -$ WRITE NXFI'PID''DEP' - - "/^[ ]*#[ ]*endif/ {" -$ WRITE NXFI'PID''DEP' - - "if (cnt < 1) {cnt = -2; exit};" -$ WRITE NXFI'PID''DEP' - - "wr = pwr; pwr = tout[cnt]; cnt -= 1; next}" -$ WRITE NXFI'PID''DEP' - - "wr > 0 { if (""''P4'"" != ""VAX"") {print} else {" -$ WRITE NXFI'PID''DEP' - - "if ($0 !~ /^#/) {print} else {" -$ WRITE NXFI'PID''DEP' - - "print ""$!"",substr($0,2,1000)}}}" -$ WRITE NXFI'PID''DEP' - - "END {if (cnt != 0) {" -$ WRITE NXFI'PID''DEP' - - "print ""Illegal ifdef/else/endif nesting at line "",NR >>""''P3'""}}" -$ CLOSE/ERROR=ERR NXFI'PID''DEP' -$ NAWK/INPUT=AWK'PID''DEP'.TMP/OUTPUT='P2' 'P1' !DO CONVERSION -$ ENDIF -#else - cat >! awk${lfile}${pid}.tmp << EOF # create awk file -BEGIN {print "$s1"; print "$s2"; print "$s3"; - cnt = 0; wr = 1; pwr = wr} -/^endend\$/ {exit} -/^[ ]*#[ ]*ifdef[ ][ ]*/ { - cnt += 1; tout[cnt] = pwr; telse[cnt] = 0; pwr = wr; - if (\$0 ~ /^.*ifdef[ ]*wn_${WNG_SITE}__/ || \ - \$0 ~ /^.*ifdef[ ]*wn_${lsite}__/ || \ - \$0 ~ /^.*ifdef[ ]*wn_${xgip}__/) - {wr = pwr} else {wr = -1}; next} -/^[ ]*#[ ]*else/ { - if (cnt < 1 || telse[cnt] == 1) {cnt = -1; exit}; telse[cnt] = 1; - if (pwr == 1) {wr = -wr}; next} -/^[ ]*#[ ]*ifndef[ ][ ]*/ { - cnt += 1; tout[cnt] = pwr; telse[cnt] = 0; pwr = wr; - if (\$0 ~ /^.*ifndef[ ]*wn_${WNG_SITE}__/ || \ - \$0 ~ /^.*ifndef[ ]*wn_${lsite}__/ || \ - \$0 ~ /^.*ifndef[ ]*wn_${xgip}__/) - {wr = -1} else {wr = pwr}; next} -/^[ ]*#[ ]*endif/ { - if (cnt < 1) {cnt = -2; exit}; - wr = pwr; pwr = tout[cnt]; cnt -= 1; next} -wr > 0 { if ("$lsite" != "vax") {print} else { - if (\$0 !~ /^\#/) {print} else { - print "\$!",substr(\$0,2,1000)}}} -END {if (cnt != 0) { - print "Illegal ifdef/else/endif nesting at line ",NR >>"$1"}} -EOF -# - awk -f awk${lfile}${pid}.tmp # do conversion -#endif -# -# EXIT -# -#ifdef wn_vax__ -$ LP2: -$ IF NAWK -$ THEN -$ CLOSE/ERROR=EXEX NXFI'PID''DEP' !CLOSE INPUT -$ IF CNT .NE. 0 -$ THEN -$ IF F$SEARCH("''P3'") .EQS. "" -$ THEN -$ OPEN/ERROR=ERR/WRITE NXFE'PID''DEP' 'P3' !SET ERROR -$ ELSE -$ OPEN/ERROR=ERR/APPEND NXFE'PID''DEP' 'P3' !SET ERROR -$ ENDIF -$ WRITE NXFE'PID''DEP' - - "Illegal ifdef/else/endif nesting at line ''LCNT'" -$ ENDIF -$ ENDIF -$ GOTO EXEX -$ ! -$ ! Error -$ ! -$ ERR: -$ IF F$SEARCH("''P3'") .EQS. "" -$ THEN -$ OPEN/ERROR=ERR/WRITE NXFE'PID''DEP' 'P3' !SET ERROR -$ ELSE -$ OPEN/ERROR=ERR/APPEND NXFE'PID''DEP' 'P3' !SET ERROR -$ ENDIF -$ WRITE NXFE'PID''DEP' "Unexpected I/O error after line ''LCNT'" -$ GOTO EXEX -$ ! -$ ! EXIT -$ ! -$ EXEX: -$ CLOSE/ERROR=EX1 NXFI'PID''DEP' !MAKE SURE -$ EX1: CLOSE/ERROR=EX2 NXFE'PID''DEP' -$ EX2: -$ IF F$SEARCH("AWK''PID'''DEP'.TMP") .NES. "" THEN - - DELETE AWK'PID''DEP'.TMP;* -$ EXIT -#else -exex: - if (-e awk${lfile}${pid}.tmp) then - 'rm' awk${lfile}${pid}.tmp >& /dev/null - endif - exit -#endif diff --git a/src/wng/nxfor.sun b/src/wng/nxfor.sun deleted file mode 100755 index ef7e7454f2f65623bf8a31041cecb599318249a1..0000000000000000000000000000000000000000 --- a/src/wng/nxfor.sun +++ /dev/null @@ -1,17 +0,0 @@ -# nxfor.ssc -# WNB 921214 -# -# Revisions: -# WNB 921215 Add ifndef -# WNB 921218 Add wn_site__ -# WNB 921230 Creation message; make SSC -# WNB 930108 Correct unix part for site dependencies -# WNB 930302 Add /bin/csh -# WNB 930330 Add wn_gipsy__ and wn_pgplot__ -# WNB 930428 Correct Unix gipsy test -# Delete pgplot reference -# Make Unix awk -# WNB 930429 Make VAX awk -# WNB 930615 Proper delete .TMP -# -# Convert the standard input to standard output diff --git a/src/wng/nxldef.com b/src/wng/nxldef.com deleted file mode 100644 index d4f33181505b8949df56ae8ac1f4204cbbf4b4ed..0000000000000000000000000000000000000000 --- a/src/wng/nxldef.com +++ /dev/null @@ -1,219 +0,0 @@ -$ !01 NXLDEF.COM -$ !02 WNB 921209 -$ !03 -$ !04 Revisions: -$ !05 Automatic by NCOMP -$ !06 -$ !07 Logical names for all include files -$ !08 -$ ASSIGN/NOLOG QQ WNG_TLD !Test -$ ASSIGN/NOLOG "WNG_DIR:[DWARF]BLDPPD_2.INC" BLDPPD_2 ! 930301 -$ ASSIGN/NOLOG "WNG_DIR:[DWARF]CLI_1.INC" CLI_1 ! 930301 -$ ASSIGN/NOLOG "WNG_DIR:[DWARF]CONSTANTS_1.INC" CONSTANTS_1 ! 930301 -$ ASSIGN/NOLOG "WNG_DIR:[DWARF]CPLMSG.INC" CPLMSG ! 930301 -$ ASSIGN/NOLOG "WNG_DIR:[DWARF]CPL_2.INC" CPL_2 ! 930701 -$ ASSIGN/NOLOG "WNG_DIR:[DWARF]DBDMSG.INC" DBDMSG ! 930301 -$ ASSIGN/NOLOG "WNG_DIR:[DWARF]DWARF_4.INC" DWARF_4 ! 930301 -$ ASSIGN/NOLOG "WNG_DIR:[DWARF]DWCMSG.INC" DWCMSG ! 930301 -$ ASSIGN/NOLOG "WNG_DIR:[DWARF]FLAGS_1.INC" FLAGS_1 ! 930301 -$ ASSIGN/NOLOG "WNG_DIR:[DWARF]GENMSG.INC" GENMSG ! 930301 -$ ASSIGN/NOLOG "WNG_DIR:[DWARF]MESSENGER_3.INC" MESSENGER_3 ! 930301 -$ ASSIGN/NOLOG "WNG_DIR:[DWARF]PARM_6.INC" PARM_6 ! 930301 -$ ASSIGN/NOLOG "WNG_DIR:[DWARF]PPDMSG.INC" PPDMSG ! 930301 -$ ASSIGN/NOLOG "WNG_DIR:[DWARF]PPDREC_4.INC" PPDREC_4 ! 930525 -$ ASSIGN/NOLOG "WNG_DIR:[DWARF]PPDSTAT_2.INC" PPDSTAT_2 ! 930301 -$ ASSIGN/NOLOG "WNG_DIR:[DWARF]PRINT_2.INC" PRINT_2 ! 930301 -$ ASSIGN/NOLOG "WNG_DIR:[DWARF]PRTMSG.INC" PRTMSG ! 930301 -$ ASSIGN/NOLOG "WNG_DIR:[DWARF]UDFMSG.INC" UDFMSG ! 930301 -$ ASSIGN/NOLOG "WNG_DIR:[DWARF]WXH.DEF" WXH_DEF ! 921214 -$ ASSIGN/NOLOG "WNG_DIR:[NMAP]MPH_E.DEF" MPH_E_DEF ! 930806 -$ ASSIGN/NOLOG "WNG_DIR:[NMAP]MPH_E.INC" MPH_E_INC ! 930806 -$ ASSIGN/NOLOG "WNG_DIR:[NMAP]MPH_O.DEF" MPH_O_DEF ! 930806 -$ ASSIGN/NOLOG "WNG_DIR:[NMAP]MPH_O.INC" MPH_O_INC ! 930806 -$ ASSIGN/NOLOG "WNG_DIR:[NMAP]MPH_T.DEF" MPH_T_DEF ! 930806 -$ ASSIGN/NOLOG "WNG_DIR:[NMAP]MPH_T.INC" MPH_T_INC ! 930806 -$ ASSIGN/NOLOG "WNG_DIR:[NMAP]NCL.DEF" NCL_DEF ! 930806 -$ ASSIGN/NOLOG "WNG_DIR:[NMAP]NCL.INC" NCL_INC ! 930806 -$ ASSIGN/NOLOG "WNG_DIR:[NMAP]NMA.DEF" NMA_DEF ! 930806 -$ ASSIGN/NOLOG "WNG_DIR:[NMAP]NMA.INC" NMA_INC ! 930806 -$ ASSIGN/NOLOG "WNG_DIR:[NMAP]NMAP.PEF" NMAP_PEF ! 930701 -$ ASSIGN/NOLOG "WNG_DIR:[NPLOT]NGC.DEF" NGC_DEF ! 930806 -$ ASSIGN/NOLOG "WNG_DIR:[NPLOT]NGC.INC" NGC_INC ! 930806 -$ ASSIGN/NOLOG "WNG_DIR:[NPLOT]NGF_E.DEF" NGF_E_DEF ! 930701 -$ ASSIGN/NOLOG "WNG_DIR:[NPLOT]NGF_O.DEF" NGF_O_DEF ! 930701 -$ ASSIGN/NOLOG "WNG_DIR:[NPLOT]NGF_T.DEF" NGF_T_DEF ! 930701 -$ ASSIGN/NOLOG "WNG_DIR:[NPLOT]NGI.DEF" NGI_DEF ! 930806 -$ ASSIGN/NOLOG "WNG_DIR:[NPLOT]NGI.INC" NGI_INC ! 930806 -$ ASSIGN/NOLOG "WNG_DIR:[NPLOT]NPL.DEF" NPL_DEF ! 930806 -$ ASSIGN/NOLOG "WNG_DIR:[NPLOT]NPL.INC" NPL_INC ! 930806 -$ ASSIGN/NOLOG "WNG_DIR:[NSCAN]CBITS.DEF" CBITS_DEF ! 930806 -$ ASSIGN/NOLOG "WNG_DIR:[NSCAN]CBITS.INC" CBITS_INC ! 930806 -$ ASSIGN/NOLOG "WNG_DIR:[NSCAN]FDW_E.DEF" FDW_E_DEF ! 921214 -$ ASSIGN/NOLOG "WNG_DIR:[NSCAN]FDW_O.DEF" FDW_O_DEF ! 921214 -$ ASSIGN/NOLOG "WNG_DIR:[NSCAN]FDW_T.DEF" FDW_T_DEF ! 921214 -$ ASSIGN/NOLOG "WNG_DIR:[NSCAN]FDX_E.DEF" FDX_E_DEF ! 921214 -$ ASSIGN/NOLOG "WNG_DIR:[NSCAN]FDX_O.DEF" FDX_O_DEF ! 921214 -$ ASSIGN/NOLOG "WNG_DIR:[NSCAN]FDX_T.DEF" FDX_T_DEF ! 921214 -$ ASSIGN/NOLOG "WNG_DIR:[NSCAN]FLF_E.DEF" FLF_E_DEF ! 930701 -$ ASSIGN/NOLOG "WNG_DIR:[NSCAN]FLF_O.DEF" FLF_O_DEF ! 930701 -$ ASSIGN/NOLOG "WNG_DIR:[NSCAN]FLF_T.DEF" FLF_T_DEF ! 930701 -$ ASSIGN/NOLOG "WNG_DIR:[NSCAN]FLH_E.DEF" FLH_E_DEF ! 930701 -$ ASSIGN/NOLOG "WNG_DIR:[NSCAN]FLH_O.DEF" FLH_O_DEF ! 930701 -$ ASSIGN/NOLOG "WNG_DIR:[NSCAN]FLH_T.DEF" FLH_T_DEF ! 930701 -$ ASSIGN/NOLOG "WNG_DIR:[NSCAN]IHW_E.DEF" IHW_E_DEF ! 921214 -$ ASSIGN/NOLOG "WNG_DIR:[NSCAN]IHW_O.DEF" IHW_O_DEF ! 921214 -$ ASSIGN/NOLOG "WNG_DIR:[NSCAN]IHW_T.DEF" IHW_T_DEF ! 921214 -$ ASSIGN/NOLOG "WNG_DIR:[NSCAN]MDH_E.DEF" MDH_E_DEF ! 930820 -$ ASSIGN/NOLOG "WNG_DIR:[NSCAN]MDH_E.INC" MDH_E_INC ! 930820 -$ ASSIGN/NOLOG "WNG_DIR:[NSCAN]MDH_O.DEF" MDH_O_DEF ! 930820 -$ ASSIGN/NOLOG "WNG_DIR:[NSCAN]MDH_O.INC" MDH_O_INC ! 930820 -$ ASSIGN/NOLOG "WNG_DIR:[NSCAN]MDH_T.DEF" MDH_T_DEF ! 930820 -$ ASSIGN/NOLOG "WNG_DIR:[NSCAN]MDH_T.INC" MDH_T_INC ! 930820 -$ ASSIGN/NOLOG "WNG_DIR:[NSCAN]MDL_E.DEF" MDL_E_DEF ! 921214 -$ ASSIGN/NOLOG "WNG_DIR:[NSCAN]MDL_O.DEF" MDL_O_DEF ! 921214 -$ ASSIGN/NOLOG "WNG_DIR:[NSCAN]MDL_T.DEF" MDL_T_DEF ! 921214 -$ ASSIGN/NOLOG "WNG_DIR:[NSCAN]NAT.DEF" NAT_DEF ! 930806 -$ ASSIGN/NOLOG "WNG_DIR:[NSCAN]NAT.INC" NAT_INC ! 930806 -$ ASSIGN/NOLOG "WNG_DIR:[NSCAN]NCA.DEF" NCA_DEF ! 930806 -$ ASSIGN/NOLOG "WNG_DIR:[NSCAN]NCA.INC" NCA_INC ! 930806 -$ ASSIGN/NOLOG "WNG_DIR:[NSCAN]NCOMM.PEF" NCOMM_PEF ! 930701 -$ ASSIGN/NOLOG "WNG_DIR:[NSCAN]NFL.DEF" NFL_DEF ! 930806 -$ ASSIGN/NOLOG "WNG_DIR:[NSCAN]NFL.INC" NFL_INC ! 930806 -$ ASSIGN/NOLOG "WNG_DIR:[NSCAN]NGEN.PEF" NGEN_PEF ! 930701 -$ ASSIGN/NOLOG "WNG_DIR:[NSCAN]NMO.DEF" NMO_DEF ! 930806 -$ ASSIGN/NOLOG "WNG_DIR:[NSCAN]NMO.INC" NMO_INC ! 930806 -$ ASSIGN/NOLOG "WNG_DIR:[NSCAN]NMODEL.PEF" NMODEL_PEF ! 930701 -$ ASSIGN/NOLOG "WNG_DIR:[NSCAN]NSC.DEF" NSC_DEF ! 930806 -$ ASSIGN/NOLOG "WNG_DIR:[NSCAN]NSC.INC" NSC_INC ! 930806 -$ ASSIGN/NOLOG "WNG_DIR:[NSCAN]NSETS.PEF" NSETS_PEF ! 930714 -$ ASSIGN/NOLOG "WNG_DIR:[NSCAN]NSTAR.DSF" NSTAR_DSF ! 930806 -$ ASSIGN/NOLOG "WNG_DIR:[NSCAN]OHW_E.DEF" OHW_E_DEF ! 930806 -$ ASSIGN/NOLOG "WNG_DIR:[NSCAN]OHW_E.INC" OHW_E_INC ! 930806 -$ ASSIGN/NOLOG "WNG_DIR:[NSCAN]OHW_O.DEF" OHW_O_DEF ! 930806 -$ ASSIGN/NOLOG "WNG_DIR:[NSCAN]OHW_O.INC" OHW_O_INC ! 930806 -$ ASSIGN/NOLOG "WNG_DIR:[NSCAN]OHW_T.DEF" OHW_T_DEF ! 930806 -$ ASSIGN/NOLOG "WNG_DIR:[NSCAN]OHW_T.INC" OHW_T_INC ! 930806 -$ ASSIGN/NOLOG "WNG_DIR:[NSCAN]RPF.DEF" RPF_DEF ! 930806 -$ ASSIGN/NOLOG "WNG_DIR:[NSCAN]RPF.INC" RPF_INC ! 930806 -$ ASSIGN/NOLOG "WNG_DIR:[NSCAN]SCH_E.DEF" SCH_E_DEF ! 930806 -$ ASSIGN/NOLOG "WNG_DIR:[NSCAN]SCH_E.INC" SCH_E_INC ! 930806 -$ ASSIGN/NOLOG "WNG_DIR:[NSCAN]SCH_O.DEF" SCH_O_DEF ! 930806 -$ ASSIGN/NOLOG "WNG_DIR:[NSCAN]SCH_O.INC" SCH_O_INC ! 930806 -$ ASSIGN/NOLOG "WNG_DIR:[NSCAN]SCH_T.DEF" SCH_T_DEF ! 930806 -$ ASSIGN/NOLOG "WNG_DIR:[NSCAN]SCH_T.INC" SCH_T_INC ! 930806 -$ ASSIGN/NOLOG "WNG_DIR:[NSCAN]SCN.DEF" SCN_DEF ! 930806 -$ ASSIGN/NOLOG "WNG_DIR:[NSCAN]SCN.INC" SCN_INC ! 930806 -$ ASSIGN/NOLOG "WNG_DIR:[NSCAN]SCN_E.DEF" SCN_E_DEF ! 930701 -$ ASSIGN/NOLOG "WNG_DIR:[NSCAN]SCN_O.DEF" SCN_O_DEF ! 930701 -$ ASSIGN/NOLOG "WNG_DIR:[NSCAN]SCN_T.DEF" SCN_T_DEF ! 930701 -$ ASSIGN/NOLOG "WNG_DIR:[NSCAN]SCW_E.DEF" SCW_E_DEF ! 930806 -$ ASSIGN/NOLOG "WNG_DIR:[NSCAN]SCW_E.INC" SCW_E_INC ! 930806 -$ ASSIGN/NOLOG "WNG_DIR:[NSCAN]SCW_O.DEF" SCW_O_DEF ! 930806 -$ ASSIGN/NOLOG "WNG_DIR:[NSCAN]SCW_O.INC" SCW_O_INC ! 930806 -$ ASSIGN/NOLOG "WNG_DIR:[NSCAN]SCW_T.DEF" SCW_T_DEF ! 930806 -$ ASSIGN/NOLOG "WNG_DIR:[NSCAN]SCW_T.INC" SCW_T_INC ! 930806 -$ ASSIGN/NOLOG "WNG_DIR:[NSCAN]SHW_E.DEF" SHW_E_DEF ! 930806 -$ ASSIGN/NOLOG "WNG_DIR:[NSCAN]SHW_E.INC" SHW_E_INC ! 930806 -$ ASSIGN/NOLOG "WNG_DIR:[NSCAN]SHW_O.DEF" SHW_O_DEF ! 930806 -$ ASSIGN/NOLOG "WNG_DIR:[NSCAN]SHW_O.INC" SHW_O_INC ! 930806 -$ ASSIGN/NOLOG "WNG_DIR:[NSCAN]SHW_T.DEF" SHW_T_DEF ! 930806 -$ ASSIGN/NOLOG "WNG_DIR:[NSCAN]SHW_T.INC" SHW_T_INC ! 930806 -$ ASSIGN/NOLOG "WNG_DIR:[NSCAN]STH_E.DEF" STH_E_DEF ! 930820 -$ ASSIGN/NOLOG "WNG_DIR:[NSCAN]STH_E.INC" STH_E_INC ! 930820 -$ ASSIGN/NOLOG "WNG_DIR:[NSCAN]STH_O.DEF" STH_O_DEF ! 930820 -$ ASSIGN/NOLOG "WNG_DIR:[NSCAN]STH_O.INC" STH_O_INC ! 930820 -$ ASSIGN/NOLOG "WNG_DIR:[NSCAN]STH_T.DEF" STH_T_DEF ! 930820 -$ ASSIGN/NOLOG "WNG_DIR:[NSCAN]STH_T.INC" STH_T_INC ! 930820 -$ ASSIGN/NOLOG "WNG_DIR:[WNG]FBC_E.DEF" FBC_E_DEF ! 930818 -$ ASSIGN/NOLOG "WNG_DIR:[WNG]FBC_E.INC" FBC_E_INC ! 930818 -$ ASSIGN/NOLOG "WNG_DIR:[WNG]FBC_O.DEF" FBC_O_DEF ! 930818 -$ ASSIGN/NOLOG "WNG_DIR:[WNG]FBC_O.INC" FBC_O_INC ! 930818 -$ ASSIGN/NOLOG "WNG_DIR:[WNG]FBC_T.DEF" FBC_T_DEF ! 930818 -$ ASSIGN/NOLOG "WNG_DIR:[WNG]FBC_T.INC" FBC_T_INC ! 930818 -$ ASSIGN/NOLOG "WNG_DIR:[WNG]FCA_E.DEF" FCA_E_DEF ! 930818 -$ ASSIGN/NOLOG "WNG_DIR:[WNG]FCA_E.INC" FCA_E_INC ! 930818 -$ ASSIGN/NOLOG "WNG_DIR:[WNG]FCA_O.DEF" FCA_O_DEF ! 930818 -$ ASSIGN/NOLOG "WNG_DIR:[WNG]FCA_O.INC" FCA_O_INC ! 930818 -$ ASSIGN/NOLOG "WNG_DIR:[WNG]FCA_T.DEF" FCA_T_DEF ! 930818 -$ ASSIGN/NOLOG "WNG_DIR:[WNG]FCA_T.INC" FCA_T_INC ! 930818 -$ ASSIGN/NOLOG "WNG_DIR:[WNG]FCQ.DEF" FCQ_DEF ! 930818 -$ ASSIGN/NOLOG "WNG_DIR:[WNG]FCQ.INC" FCQ_INC ! 930818 -$ ASSIGN/NOLOG "WNG_DIR:[WNG]FEL_E.DEF" FEL_E_DEF ! 930818 -$ ASSIGN/NOLOG "WNG_DIR:[WNG]FEL_E.INC" FEL_E_INC ! 930818 -$ ASSIGN/NOLOG "WNG_DIR:[WNG]FEL_O.DEF" FEL_O_DEF ! 930818 -$ ASSIGN/NOLOG "WNG_DIR:[WNG]FEL_O.INC" FEL_O_INC ! 930818 -$ ASSIGN/NOLOG "WNG_DIR:[WNG]FEL_T.DEF" FEL_T_DEF ! 930818 -$ ASSIGN/NOLOG "WNG_DIR:[WNG]FEL_T.INC" FEL_T_INC ! 930818 -$ ASSIGN/NOLOG "WNG_DIR:[WNG]GFH_E.DEF" GFH_E_DEF ! 930806 -$ ASSIGN/NOLOG "WNG_DIR:[WNG]GFH_E.INC" GFH_E_INC ! 930806 -$ ASSIGN/NOLOG "WNG_DIR:[WNG]GFH_O.DEF" GFH_O_DEF ! 930806 -$ ASSIGN/NOLOG "WNG_DIR:[WNG]GFH_O.INC" GFH_O_INC ! 930806 -$ ASSIGN/NOLOG "WNG_DIR:[WNG]GFH_T.DEF" GFH_T_DEF ! 930806 -$ ASSIGN/NOLOG "WNG_DIR:[WNG]GFH_T.INC" GFH_T_INC ! 930806 -$ ASSIGN/NOLOG "WNG_DIR:[WNG]MCA_E.DEF" MCA_E_DEF ! 930818 -$ ASSIGN/NOLOG "WNG_DIR:[WNG]MCA_E.INC" MCA_E_INC ! 930818 -$ ASSIGN/NOLOG "WNG_DIR:[WNG]MCA_O.DEF" MCA_O_DEF ! 930818 -$ ASSIGN/NOLOG "WNG_DIR:[WNG]MCA_O.INC" MCA_O_INC ! 930818 -$ ASSIGN/NOLOG "WNG_DIR:[WNG]MCA_T.DEF" MCA_T_DEF ! 930818 -$ ASSIGN/NOLOG "WNG_DIR:[WNG]MCA_T.INC" MCA_T_INC ! 930818 -$ ASSIGN/NOLOG "WNG_DIR:[WNG]SGH_E.DEF" SGH_E_DEF ! 930806 -$ ASSIGN/NOLOG "WNG_DIR:[WNG]SGH_E.INC" SGH_E_INC ! 930806 -$ ASSIGN/NOLOG "WNG_DIR:[WNG]SGH_O.DEF" SGH_O_DEF ! 930806 -$ ASSIGN/NOLOG "WNG_DIR:[WNG]SGH_O.INC" SGH_O_INC ! 930806 -$ ASSIGN/NOLOG "WNG_DIR:[WNG]SGH_T.DEF" SGH_T_DEF ! 930806 -$ ASSIGN/NOLOG "WNG_DIR:[WNG]SGH_T.INC" SGH_T_INC ! 930806 -$ ASSIGN/NOLOG "WNG_DIR:[WNG]WNC.DEF" WNC_DEF ! 930806 -$ ASSIGN/NOLOG "WNG_DIR:[WNG]WNC.INC" WNC_INC ! 930806 -$ ASSIGN/NOLOG "WNG_DIR:[WNG]WNC_X.DEF" WNC_X_DEF ! 930806 -$ ASSIGN/NOLOG "WNG_DIR:[WNG]WND.DEF" WND_DEF ! 930806 -$ ASSIGN/NOLOG "WNG_DIR:[WNG]WND.INC" WND_INC ! 930806 -$ ASSIGN/NOLOG "WNG_DIR:[WNG]WNG.DEF" WNG_DEF ! 930809 -$ ASSIGN/NOLOG "WNG_DIR:[WNG]WNG.INC" WNG_INC ! 930809 -$ ASSIGN/NOLOG "WNG_DIR:[WNG]WNT.DEF" WNT_DEF ! 930806 -$ ASSIGN/NOLOG "WNG_DIR:[WNG]WNT.INC" WNT_INC ! 930806 -$ ASSIGN/NOLOG "WNG_DIR:[WNG]WNT_E.DEF" WNT_E_DEF ! 930806 -$ ASSIGN/NOLOG "WNG_DIR:[WNG]WNT_E.INC" WNT_E_INC ! 930806 -$ ASSIGN/NOLOG "WNG_DIR:[WNG]WNT_O.DEF" WNT_O_DEF ! 930806 -$ ASSIGN/NOLOG "WNG_DIR:[WNG]WNT_O.INC" WNT_O_INC ! 930806 -$ ASSIGN/NOLOG "WNG_DIR:[WNG]WNT_T.DEF" WNT_T_DEF ! 930806 -$ ASSIGN/NOLOG "WNG_DIR:[WNG]WNT_T.INC" WNT_T_INC ! 930806 -$ ASSIGN/NOLOG "WNG_DIR:[WNG]WQD_E.DEF" WQD_E_DEF ! 921214 -$ ASSIGN/NOLOG "WNG_DIR:[WNG]WQD_O.DEF" WQD_O_DEF ! 921214 -$ ASSIGN/NOLOG "WNG_DIR:[WNG]WQD_T.DEF" WQD_T_DEF ! 921214 -$ ASSIGN/NOLOG "WNG_DIR:[WNG]WQF_E.DEF" WQF_E_DEF ! 921214 -$ ASSIGN/NOLOG "WNG_DIR:[WNG]WQF_O.DEF" WQF_O_DEF ! 921214 -$ ASSIGN/NOLOG "WNG_DIR:[WNG]WQF_T.DEF" WQF_T_DEF ! 921214 -$ ASSIGN/NOLOG "WNG_DIR:[WNG]WQG.DEF" WQG_DEF ! 921214 -$ ASSIGN/NOLOG "WNG_DIR:[WNG]WQG.INC" WQG_INC ! 921214 -$ ASSIGN/NOLOG "WNG_DIR:[WNG]WQI_E.DEF" WQI_E_DEF ! 921214 -$ ASSIGN/NOLOG "WNG_DIR:[WNG]WQI_O.DEF" WQI_O_DEF ! 921214 -$ ASSIGN/NOLOG "WNG_DIR:[WNG]WQI_T.DEF" WQI_T_DEF ! 921214 -$ ASSIGN/NOLOG "WNG_DIR:[WNG]WQ_EAL.DEF" WQ_EAL_DEF ! 921214 -$ ASSIGN/NOLOG "WNG_DIR:[WNG]WQ_EAL.INC" WQ_EAL_INC ! 921214 -$ ASSIGN/NOLOG "WNG_DIR:[WNG]WQ_EAP.DEF" WQ_EAP_DEF ! 921214 -$ ASSIGN/NOLOG "WNG_DIR:[WNG]WQ_EAP.INC" WQ_EAP_INC ! 921214 -$ ASSIGN/NOLOG "WNG_DIR:[WNG]WQ_EPP.DEF" WQ_EPP_DEF ! 921214 -$ ASSIGN/NOLOG "WNG_DIR:[WNG]WQ_EPP.INC" WQ_EPP_INC ! 921214 -$ ASSIGN/NOLOG "WNG_DIR:[WNG]WQ_EPS.DEF" WQ_EPS_DEF ! 921214 -$ ASSIGN/NOLOG "WNG_DIR:[WNG]WQ_EPS.INC" WQ_EPS_INC ! 921214 -$ ASSIGN/NOLOG "WNG_DIR:[WNG]WQ_FNA.DEF" WQ_FNA_DEF ! 921214 -$ ASSIGN/NOLOG "WNG_DIR:[WNG]WQ_FNA.INC" WQ_FNA_INC ! 921214 -$ ASSIGN/NOLOG "WNG_DIR:[WNG]WQ_FNB.DEF" WQ_FNB_DEF ! 921214 -$ ASSIGN/NOLOG "WNG_DIR:[WNG]WQ_FNB.INC" WQ_FNB_INC ! 921214 -$ ASSIGN/NOLOG "WNG_DIR:[WNG]WQ_PAL.DEF" WQ_PAL_DEF ! 921214 -$ ASSIGN/NOLOG "WNG_DIR:[WNG]WQ_PAL.INC" WQ_PAL_INC ! 921214 -$ ASSIGN/NOLOG "WNG_DIR:[WNG]WQ_PAP.DEF" WQ_PAP_DEF ! 921214 -$ ASSIGN/NOLOG "WNG_DIR:[WNG]WQ_PAP.INC" WQ_PAP_INC ! 921214 -$ ASSIGN/NOLOG "WNG_DIR:[WNG]WQ_PSL.DEF" WQ_PSL_DEF ! 921214 -$ ASSIGN/NOLOG "WNG_DIR:[WNG]WQ_PSL.INC" WQ_PSL_INC ! 921214 -$ ASSIGN/NOLOG "WNG_DIR:[WNG]WQ_PSP.DEF" WQ_PSP_DEF ! 921214 -$ ASSIGN/NOLOG "WNG_DIR:[WNG]WQ_PSP.INC" WQ_PSP_INC ! 921214 -$ ASSIGN/NOLOG "WNG_DIR:[WNG]WQ_QMP.DEF" WQ_QMP_DEF ! 921214 -$ ASSIGN/NOLOG "WNG_DIR:[WNG]WQ_QMP.INC" WQ_QMP_INC ! 921214 -$ ASSIGN/NOLOG "WNG_DIR:[WNG]WQ_QMS.DEF" WQ_QMS_DEF ! 921214 -$ ASSIGN/NOLOG "WNG_DIR:[WNG]WQ_QMS.INC" WQ_QMS_INC ! 921214 -$ ASSIGN/NOLOG "WNG_DIR:[WNG]WQ_REG.DEF" WQ_REG_DEF ! 921214 -$ ASSIGN/NOLOG "WNG_DIR:[WNG]WQ_REG.INC" WQ_REG_INC ! 921214 -$ ASSIGN/NOLOG "WNG_DIR:[WNG]WQ_XAW.DEF" WQ_XAW_DEF ! 930108 -$ ASSIGN/NOLOG "WNG_DIR:[WNG]WQ_XAW.INC" WQ_XAW_INC ! 930108 -$ ASSIGN/NOLOG "WNG_DIR:[WNG]WXH.INC" WXH_INC ! 921214 diff --git a/src/wng/nxldef.sun b/src/wng/nxldef.sun deleted file mode 100755 index 93683472112897fa41bc78426f014dc1f013dd7a..0000000000000000000000000000000000000000 --- a/src/wng/nxldef.sun +++ /dev/null @@ -1,220 +0,0 @@ -#01 nxldef.sun -#02 WNB 921209 -#03 -#04 Revisions: -#05 Automatic by NCOMP -#06 -#07 Logical links for all include files -#08 - rm -f BLDPPD_2 >& /dev/null; ln -s $WNG/../dwarf/bldppd_2.inc BLDPPD_2 # 930302 - rm -f BMD_DEF >& /dev/null; ln -s $WNG/../nscan/bmd.def BMD_DEF # 930830 - rm -f bmd_inc >& /dev/null; ln -s $WNG/../nscan/bmd.inc bmd_inc # 930830 - rm -f CBITS_DEF >& /dev/null; ln -s $WNG/../nscan/cbits.def CBITS_DEF # 930830 - rm -f cbits_inc >& /dev/null; ln -s $WNG/../nscan/cbits.inc cbits_inc # 930830 - rm -f CLI_1 >& /dev/null; ln -s $WNG/../dwarf/cli_1.inc CLI_1 # 930302 - rm -f CONSTANTS_1 >& /dev/null; ln -s $WNG/../dwarf/constants_1.inc CONSTANTS_1 # 930302 - rm -f CPLMSG >& /dev/null; ln -s $WNG/../dwarf/cplmsg.inc CPLMSG # 930302 - rm -f CPL_2 >& /dev/null; ln -s $WNG/../dwarf/cpl_2.inc CPL_2 # 930628 - rm -f DBDMSG >& /dev/null; ln -s $WNG/../dwarf/dbdmsg.inc DBDMSG # 930302 - rm -f DWARF_4 >& /dev/null; ln -s $WNG/../dwarf/dwarf_4.inc DWARF_4 # 930302 - rm -f DWCMSG >& /dev/null; ln -s $WNG/../dwarf/dwcmsg.inc DWCMSG # 930302 - rm -f FBC_E_DEF >& /dev/null; ln -s $WNG/../wng/fbc_e.def FBC_E_DEF # 930826 - rm -f fbc_e_inc >& /dev/null; ln -s $WNG/../wng/fbc_e.inc fbc_e_inc # 930826 - rm -f FBC_O_DEF >& /dev/null; ln -s $WNG/../wng/fbc_o.def FBC_O_DEF # 930826 - rm -f fbc_o_inc >& /dev/null; ln -s $WNG/../wng/fbc_o.inc fbc_o_inc # 930826 - rm -f FBC_T_DEF >& /dev/null; ln -s $WNG/../wng/fbc_t.def FBC_T_DEF # 930826 - rm -f fbc_t_inc >& /dev/null; ln -s $WNG/../wng/fbc_t.inc fbc_t_inc # 930826 - rm -f FCA_E_DEF >& /dev/null; ln -s $WNG/../wng/fca_e.def FCA_E_DEF # 930826 - rm -f fca_e_inc >& /dev/null; ln -s $WNG/../wng/fca_e.inc fca_e_inc # 930826 - rm -f FCA_O_DEF >& /dev/null; ln -s $WNG/../wng/fca_o.def FCA_O_DEF # 930826 - rm -f fca_o_inc >& /dev/null; ln -s $WNG/../wng/fca_o.inc fca_o_inc # 930826 - rm -f FCA_T_DEF >& /dev/null; ln -s $WNG/../wng/fca_t.def FCA_T_DEF # 930826 - rm -f fca_t_inc >& /dev/null; ln -s $WNG/../wng/fca_t.inc fca_t_inc # 930826 - rm -f FCQ_DEF >& /dev/null; ln -s $WNG/../wng/fcq.def FCQ_DEF # 930906 - rm -f fcq_inc >& /dev/null; ln -s $WNG/../wng/fcq.inc fcq_inc # 930906 - rm -f FDW_E_DEF >& /dev/null; ln -s $WNG/../nscan/fdw_e.def FDW_E_DEF # 930105 - rm -f FDW_O_DEF >& /dev/null; ln -s $WNG/../nscan/fdw_o.def FDW_O_DEF # 930105 - rm -f FDW_T_DEF >& /dev/null; ln -s $WNG/../nscan/fdw_t.def FDW_T_DEF # 930105 - rm -f FDX_E_DEF >& /dev/null; ln -s $WNG/../nscan/fdx_e.def FDX_E_DEF # 930105 - rm -f FDX_O_DEF >& /dev/null; ln -s $WNG/../nscan/fdx_o.def FDX_O_DEF # 930105 - rm -f FDX_T_DEF >& /dev/null; ln -s $WNG/../nscan/fdx_t.def FDX_T_DEF # 930105 - rm -f FEL_E_DEF >& /dev/null; ln -s $WNG/../wng/fel_e.def FEL_E_DEF # 930826 - rm -f fel_e_inc >& /dev/null; ln -s $WNG/../wng/fel_e.inc fel_e_inc # 930826 - rm -f FEL_O_DEF >& /dev/null; ln -s $WNG/../wng/fel_o.def FEL_O_DEF # 930826 - rm -f fel_o_inc >& /dev/null; ln -s $WNG/../wng/fel_o.inc fel_o_inc # 930826 - rm -f FEL_T_DEF >& /dev/null; ln -s $WNG/../wng/fel_t.def FEL_T_DEF # 930826 - rm -f fel_t_inc >& /dev/null; ln -s $WNG/../wng/fel_t.inc fel_t_inc # 930826 - rm -f FLAGS_1 >& /dev/null; ln -s $WNG/../dwarf/flags_1.inc FLAGS_1 # 930302 - rm -f FLF_E_DEF >& /dev/null; ln -s $WNG/../nscan/flf_e.def FLF_E_DEF # 930628 - rm -f FLF_O_DEF >& /dev/null; ln -s $WNG/../nscan/flf_o.def FLF_O_DEF # 930628 - rm -f FLF_T_DEF >& /dev/null; ln -s $WNG/../nscan/flf_t.def FLF_T_DEF # 930628 - rm -f GENMSG >& /dev/null; ln -s $WNG/../dwarf/genmsg.inc GENMSG # 930302 - rm -f GFH_E_DEF >& /dev/null; ln -s $WNG/../wng/gfh_e.def GFH_E_DEF # 930914 - rm -f gfh_e_inc >& /dev/null; ln -s $WNG/../wng/gfh_e.inc gfh_e_inc # 930914 - rm -f GFH_O_DEF >& /dev/null; ln -s $WNG/../wng/gfh_o.def GFH_O_DEF # 930914 - rm -f gfh_o_inc >& /dev/null; ln -s $WNG/../wng/gfh_o.inc gfh_o_inc # 930914 - rm -f GFH_T_DEF >& /dev/null; ln -s $WNG/../wng/gfh_t.def GFH_T_DEF # 930914 - rm -f gfh_t_inc >& /dev/null; ln -s $WNG/../wng/gfh_t.inc gfh_t_inc # 930914 - rm -f IHW_E_DEF >& /dev/null; ln -s $WNG/../nscan/ihw_e.def IHW_E_DEF # 930105 - rm -f IHW_O_DEF >& /dev/null; ln -s $WNG/../nscan/ihw_o.def IHW_O_DEF # 930105 - rm -f IHW_T_DEF >& /dev/null; ln -s $WNG/../nscan/ihw_t.def IHW_T_DEF # 930105 - rm -f MCA_E_DEF >& /dev/null; ln -s $WNG/../wng/mca_e.def MCA_E_DEF # 930826 - rm -f mca_e_inc >& /dev/null; ln -s $WNG/../wng/mca_e.inc mca_e_inc # 930826 - rm -f MCA_O_DEF >& /dev/null; ln -s $WNG/../wng/mca_o.def MCA_O_DEF # 930826 - rm -f mca_o_inc >& /dev/null; ln -s $WNG/../wng/mca_o.inc mca_o_inc # 930826 - rm -f MCA_T_DEF >& /dev/null; ln -s $WNG/../wng/mca_t.def MCA_T_DEF # 930826 - rm -f mca_t_inc >& /dev/null; ln -s $WNG/../wng/mca_t.inc mca_t_inc # 930826 - rm -f MDH_E_DEF >& /dev/null; ln -s $WNG/../nscan/mdh_e.def MDH_E_DEF # 930826 - rm -f mdh_e_inc >& /dev/null; ln -s $WNG/../nscan/mdh_e.inc mdh_e_inc # 930826 - rm -f MDH_O_DEF >& /dev/null; ln -s $WNG/../nscan/mdh_o.def MDH_O_DEF # 930826 - rm -f mdh_o_inc >& /dev/null; ln -s $WNG/../nscan/mdh_o.inc mdh_o_inc # 930826 - rm -f MDH_T_DEF >& /dev/null; ln -s $WNG/../nscan/mdh_t.def MDH_T_DEF # 930826 - rm -f mdh_t_inc >& /dev/null; ln -s $WNG/../nscan/mdh_t.inc mdh_t_inc # 930826 - rm -f MDL_E_DEF >& /dev/null; ln -s $WNG/../nscan/mdl_e.def MDL_E_DEF # 930914 - rm -f mdl_e_inc >& /dev/null; ln -s $WNG/../nscan/mdl_e.inc mdl_e_inc # 930914 - rm -f MDL_O_DEF >& /dev/null; ln -s $WNG/../nscan/mdl_o.def MDL_O_DEF # 930914 - rm -f mdl_o_inc >& /dev/null; ln -s $WNG/../nscan/mdl_o.inc mdl_o_inc # 930914 - rm -f MDL_T_DEF >& /dev/null; ln -s $WNG/../nscan/mdl_t.def MDL_T_DEF # 930914 - rm -f mdl_t_inc >& /dev/null; ln -s $WNG/../nscan/mdl_t.inc mdl_t_inc # 930914 - rm -f MESSENGER_3 >& /dev/null; ln -s $WNG/../dwarf/messenger_3.inc MESSENGER_3 # 930302 - rm -f MPH_E_DEF >& /dev/null; ln -s $WNG/../nmap/mph_e.def MPH_E_DEF # 930826 - rm -f mph_e_inc >& /dev/null; ln -s $WNG/../nmap/mph_e.inc mph_e_inc # 930826 - rm -f MPH_O_DEF >& /dev/null; ln -s $WNG/../nmap/mph_o.def MPH_O_DEF # 930826 - rm -f mph_o_inc >& /dev/null; ln -s $WNG/../nmap/mph_o.inc mph_o_inc # 930826 - rm -f MPH_T_DEF >& /dev/null; ln -s $WNG/../nmap/mph_t.def MPH_T_DEF # 930826 - rm -f mph_t_inc >& /dev/null; ln -s $WNG/../nmap/mph_t.inc mph_t_inc # 930826 - rm -f NAT_DEF >& /dev/null; ln -s $WNG/../nscan/nat.def NAT_DEF # 930826 - rm -f nat_inc >& /dev/null; ln -s $WNG/../nscan/nat.inc nat_inc # 930826 - rm -f NCA_DEF >& /dev/null; ln -s $WNG/../nscan/nca.def NCA_DEF # 930914 - rm -f nca_inc >& /dev/null; ln -s $WNG/../nscan/nca.inc nca_inc # 930914 - rm -f NCL_DEF >& /dev/null; ln -s $WNG/../nmap/ncl.def NCL_DEF # 930826 - rm -f ncl_inc >& /dev/null; ln -s $WNG/../nmap/ncl.inc ncl_inc # 930826 - rm -f NCOMM_PEF >& /dev/null; ln -s $WNG/../nscan/ncomm.pef NCOMM_PEF # 930826 - rm -f NFL_DEF >& /dev/null; ln -s $WNG/../nscan/nfl.def NFL_DEF # 930826 - rm -f nfl_inc >& /dev/null; ln -s $WNG/../nscan/nfl.inc nfl_inc # 930826 - rm -f NGC_DEF >& /dev/null; ln -s $WNG/../nplot/ngc.def NGC_DEF # 930826 - rm -f ngc_inc >& /dev/null; ln -s $WNG/../nplot/ngc.inc ngc_inc # 930826 - rm -f NGEN_PEF >& /dev/null; ln -s $WNG/../nscan/ngen.pef NGEN_PEF # 930628 - rm -f NGF_E_DEF >& /dev/null; ln -s $WNG/../nplot/ngf_e.def NGF_E_DEF # 930630 - rm -f NGF_O_DEF >& /dev/null; ln -s $WNG/../nplot/ngf_o.def NGF_O_DEF # 930630 - rm -f NGF_T_DEF >& /dev/null; ln -s $WNG/../nplot/ngf_t.def NGF_T_DEF # 930630 - rm -f NGI_DEF >& /dev/null; ln -s $WNG/../nplot/ngi.def NGI_DEF # 930826 - rm -f ngi_inc >& /dev/null; ln -s $WNG/../nplot/ngi.inc ngi_inc # 930826 - rm -f NMAP_PEF >& /dev/null; ln -s $WNG/../nmap/nmap.pef NMAP_PEF # 930628 - rm -f NMA_DEF >& /dev/null; ln -s $WNG/../nmap/nma.def NMA_DEF # 930830 - rm -f nma_inc >& /dev/null; ln -s $WNG/../nmap/nma.inc nma_inc # 930830 - rm -f NMODEL_PEF >& /dev/null; ln -s $WNG/../nscan/nmodel.pef NMODEL_PEF # 930830 - rm -f NMO_DEF >& /dev/null; ln -s $WNG/../nscan/nmo.def NMO_DEF # 930914 - rm -f nmo_inc >& /dev/null; ln -s $WNG/../nscan/nmo.inc nmo_inc # 930914 - rm -f NPL_DEF >& /dev/null; ln -s $WNG/../nplot/npl.def NPL_DEF # 930826 - rm -f npl_inc >& /dev/null; ln -s $WNG/../nplot/npl.inc npl_inc # 930826 - rm -f NSC_DEF >& /dev/null; ln -s $WNG/../nscan/nsc.def NSC_DEF # 930826 - rm -f nsc_inc >& /dev/null; ln -s $WNG/../nscan/nsc.inc nsc_inc # 930826 - rm -f NSETS_PEF >& /dev/null; ln -s $WNG/../nscan/nsets.pef NSETS_PEF # 930714 - rm -f NSTAR_DSF >& /dev/null; ln -s $WNG/../nscan/nstar.dsf NSTAR_DSF # 930826 - rm -f OHW_E_DEF >& /dev/null; ln -s $WNG/../nscan/ohw_e.def OHW_E_DEF # 930826 - rm -f ohw_e_inc >& /dev/null; ln -s $WNG/../nscan/ohw_e.inc ohw_e_inc # 930826 - rm -f OHW_O_DEF >& /dev/null; ln -s $WNG/../nscan/ohw_o.def OHW_O_DEF # 930826 - rm -f ohw_o_inc >& /dev/null; ln -s $WNG/../nscan/ohw_o.inc ohw_o_inc # 930826 - rm -f OHW_T_DEF >& /dev/null; ln -s $WNG/../nscan/ohw_t.def OHW_T_DEF # 930826 - rm -f ohw_t_inc >& /dev/null; ln -s $WNG/../nscan/ohw_t.inc ohw_t_inc # 930826 - rm -f PARM_6 >& /dev/null; ln -s $WNG/../dwarf/parm_6.inc PARM_6 # 930302 - rm -f PPDMSG >& /dev/null; ln -s $WNG/../dwarf/ppdmsg.inc PPDMSG # 930302 - rm -f PPDREC_4 >& /dev/null; ln -s $WNG/../dwarf/ppdrec_4.inc PPDREC_4 # 930525 - rm -f PPDSTAT_2 >& /dev/null; ln -s $WNG/../dwarf/ppdstat_2.inc PPDSTAT_2 # 930302 - rm -f PRINT_2 >& /dev/null; ln -s $WNG/../dwarf/print_2.inc PRINT_2 # 930302 - rm -f PRTMSG >& /dev/null; ln -s $WNG/../dwarf/prtmsg.inc PRTMSG # 930302 - rm -f RPF_DEF >& /dev/null; ln -s $WNG/../nscan/rpf.def RPF_DEF # 930826 - rm -f rpf_inc >& /dev/null; ln -s $WNG/../nscan/rpf.inc rpf_inc # 930826 - rm -f SCH_E_DEF >& /dev/null; ln -s $WNG/../nscan/sch_e.def SCH_E_DEF # 930826 - rm -f sch_e_inc >& /dev/null; ln -s $WNG/../nscan/sch_e.inc sch_e_inc # 930826 - rm -f SCH_O_DEF >& /dev/null; ln -s $WNG/../nscan/sch_o.def SCH_O_DEF # 930826 - rm -f sch_o_inc >& /dev/null; ln -s $WNG/../nscan/sch_o.inc sch_o_inc # 930826 - rm -f SCH_T_DEF >& /dev/null; ln -s $WNG/../nscan/sch_t.def SCH_T_DEF # 930826 - rm -f sch_t_inc >& /dev/null; ln -s $WNG/../nscan/sch_t.inc sch_t_inc # 930826 - rm -f SCN_DEF >& /dev/null; ln -s $WNG/../nscan/scn.def SCN_DEF # 930826 - rm -f SCN_E_DEF >& /dev/null; ln -s $WNG/../nscan/scn_e.def SCN_E_DEF # 930628 - rm -f scn_inc >& /dev/null; ln -s $WNG/../nscan/scn.inc scn_inc # 930826 - rm -f SCN_O_DEF >& /dev/null; ln -s $WNG/../nscan/scn_o.def SCN_O_DEF # 930628 - rm -f SCN_T_DEF >& /dev/null; ln -s $WNG/../nscan/scn_t.def SCN_T_DEF # 930628 - rm -f SCW_E_DEF >& /dev/null; ln -s $WNG/../nscan/scw_e.def SCW_E_DEF # 930826 - rm -f scw_e_inc >& /dev/null; ln -s $WNG/../nscan/scw_e.inc scw_e_inc # 930826 - rm -f SCW_O_DEF >& /dev/null; ln -s $WNG/../nscan/scw_o.def SCW_O_DEF # 930826 - rm -f scw_o_inc >& /dev/null; ln -s $WNG/../nscan/scw_o.inc scw_o_inc # 930826 - rm -f SCW_T_DEF >& /dev/null; ln -s $WNG/../nscan/scw_t.def SCW_T_DEF # 930826 - rm -f scw_t_inc >& /dev/null; ln -s $WNG/../nscan/scw_t.inc scw_t_inc # 930826 - rm -f SGH_E_DEF >& /dev/null; ln -s $WNG/../wng/sgh_e.def SGH_E_DEF # 930826 - rm -f sgh_e_inc >& /dev/null; ln -s $WNG/../wng/sgh_e.inc sgh_e_inc # 930826 - rm -f SGH_O_DEF >& /dev/null; ln -s $WNG/../wng/sgh_o.def SGH_O_DEF # 930826 - rm -f sgh_o_inc >& /dev/null; ln -s $WNG/../wng/sgh_o.inc sgh_o_inc # 930826 - rm -f SGH_T_DEF >& /dev/null; ln -s $WNG/../wng/sgh_t.def SGH_T_DEF # 930826 - rm -f sgh_t_inc >& /dev/null; ln -s $WNG/../wng/sgh_t.inc sgh_t_inc # 930826 - rm -f SHW_E_DEF >& /dev/null; ln -s $WNG/../nscan/shw_e.def SHW_E_DEF # 930826 - rm -f shw_e_inc >& /dev/null; ln -s $WNG/../nscan/shw_e.inc shw_e_inc # 930826 - rm -f SHW_O_DEF >& /dev/null; ln -s $WNG/../nscan/shw_o.def SHW_O_DEF # 930826 - rm -f shw_o_inc >& /dev/null; ln -s $WNG/../nscan/shw_o.inc shw_o_inc # 930826 - rm -f SHW_T_DEF >& /dev/null; ln -s $WNG/../nscan/shw_t.def SHW_T_DEF # 930826 - rm -f shw_t_inc >& /dev/null; ln -s $WNG/../nscan/shw_t.inc shw_t_inc # 930826 - rm -f STH_E_DEF >& /dev/null; ln -s $WNG/../nscan/sth_e.def STH_E_DEF # 930826 - rm -f sth_e_inc >& /dev/null; ln -s $WNG/../nscan/sth_e.inc sth_e_inc # 930826 - rm -f STH_O_DEF >& /dev/null; ln -s $WNG/../nscan/sth_o.def STH_O_DEF # 930826 - rm -f sth_o_inc >& /dev/null; ln -s $WNG/../nscan/sth_o.inc sth_o_inc # 930826 - rm -f STH_T_DEF >& /dev/null; ln -s $WNG/../nscan/sth_t.def STH_T_DEF # 930826 - rm -f sth_t_inc >& /dev/null; ln -s $WNG/../nscan/sth_t.inc sth_t_inc # 930826 - rm -f UDFMSG >& /dev/null; ln -s $WNG/../dwarf/udfmsg.inc UDFMSG # 930302 - rm -f WNC_DEF >& /dev/null; ln -s $WNG/../wng/wnc.def WNC_DEF # 930826 - rm -f wnc_inc >& /dev/null; ln -s $WNG/../wng/wnc.inc wnc_inc # 930826 - rm -f WNC_X_DEF >& /dev/null; ln -s $WNG/../wng/wnc_x.def WNC_X_DEF # 921214 - rm -f WND_DEF >& /dev/null; ln -s $WNG/../wng/wnd.def WND_DEF # 930826 - rm -f wnd_inc >& /dev/null; ln -s $WNG/../wng/wnd.inc wnd_inc # 930826 - rm -f WNG_DEF >& /dev/null; ln -s $WNG/../wng/wng.def WNG_DEF # 930914 - rm -f wng_inc >& /dev/null; ln -s $WNG/../wng/wng.inc wng_inc # 930914 - rm -f WNT_DEF >& /dev/null; ln -s $WNG/../wng/wnt.def WNT_DEF # 930908 - rm -f WNT_E_DEF >& /dev/null; ln -s $WNG/../wng/wnt_e.def WNT_E_DEF # 930908 - rm -f wnt_e_inc >& /dev/null; ln -s $WNG/../wng/wnt_e.inc wnt_e_inc # 930908 - rm -f wnt_inc >& /dev/null; ln -s $WNG/../wng/wnt.inc wnt_inc # 930908 - rm -f WNT_O_DEF >& /dev/null; ln -s $WNG/../wng/wnt_o.def WNT_O_DEF # 930908 - rm -f wnt_o_inc >& /dev/null; ln -s $WNG/../wng/wnt_o.inc wnt_o_inc # 930908 - rm -f WNT_T_DEF >& /dev/null; ln -s $WNG/../wng/wnt_t.def WNT_T_DEF # 930908 - rm -f wnt_t_inc >& /dev/null; ln -s $WNG/../wng/wnt_t.inc wnt_t_inc # 930908 - rm -f WQD_E_DEF >& /dev/null; ln -s $WNG/../wng/wqd_e.def WQD_E_DEF # 921231 - rm -f WQD_O_DEF >& /dev/null; ln -s $WNG/../wng/wqd_o.def WQD_O_DEF # 921231 - rm -f WQD_T_DEF >& /dev/null; ln -s $WNG/../wng/wqd_t.def WQD_T_DEF # 921231 - rm -f WQF_E_DEF >& /dev/null; ln -s $WNG/../wng/wqf_e.def WQF_E_DEF # 921231 - rm -f WQF_O_DEF >& /dev/null; ln -s $WNG/../wng/wqf_o.def WQF_O_DEF # 921231 - rm -f WQF_T_DEF >& /dev/null; ln -s $WNG/../wng/wqf_t.def WQF_T_DEF # 921231 - rm -f WQG_DEF >& /dev/null; ln -s $WNG/../wng/wqg.def WQG_DEF # 921231 - rm -f wqg_inc >& /dev/null; ln -s $WNG/../wng/wqg.inc wqg_inc # 921231 - rm -f WQI_E_DEF >& /dev/null; ln -s $WNG/../wng/wqi_e.def WQI_E_DEF # 921231 - rm -f WQI_O_DEF >& /dev/null; ln -s $WNG/../wng/wqi_o.def WQI_O_DEF # 921231 - rm -f WQI_T_DEF >& /dev/null; ln -s $WNG/../wng/wqi_t.def WQI_T_DEF # 921231 - rm -f WQ_EAL_DEF >& /dev/null; ln -s $WNG/../wng/wq_eal.def WQ_EAL_DEF # 921231 - rm -f wq_eal_inc >& /dev/null; ln -s $WNG/../wng/wq_eal.inc wq_eal_inc # 921231 - rm -f WQ_EAP_DEF >& /dev/null; ln -s $WNG/../wng/wq_eap.def WQ_EAP_DEF # 921231 - rm -f wq_eap_inc >& /dev/null; ln -s $WNG/../wng/wq_eap.inc wq_eap_inc # 921231 - rm -f WQ_EPP_DEF >& /dev/null; ln -s $WNG/../wng/wq_epp.def WQ_EPP_DEF # 921231 - rm -f wq_epp_inc >& /dev/null; ln -s $WNG/../wng/wq_epp.inc wq_epp_inc # 921231 - rm -f WQ_EPS_DEF >& /dev/null; ln -s $WNG/../wng/wq_eps.def WQ_EPS_DEF # 921231 - rm -f wq_eps_inc >& /dev/null; ln -s $WNG/../wng/wq_eps.inc wq_eps_inc # 921231 - rm -f WQ_FNA_DEF >& /dev/null; ln -s $WNG/../wng/wq_fna.def WQ_FNA_DEF # 921231 - rm -f wq_fna_inc >& /dev/null; ln -s $WNG/../wng/wq_fna.inc wq_fna_inc # 921231 - rm -f WQ_FNB_DEF >& /dev/null; ln -s $WNG/../wng/wq_fnb.def WQ_FNB_DEF # 921231 - rm -f wq_fnb_inc >& /dev/null; ln -s $WNG/../wng/wq_fnb.inc wq_fnb_inc # 921231 - rm -f WQ_PAL_DEF >& /dev/null; ln -s $WNG/../wng/wq_pal.def WQ_PAL_DEF # 921231 - rm -f wq_pal_inc >& /dev/null; ln -s $WNG/../wng/wq_pal.inc wq_pal_inc # 921231 - rm -f WQ_PAP_DEF >& /dev/null; ln -s $WNG/../wng/wq_pap.def WQ_PAP_DEF # 921231 - rm -f wq_pap_inc >& /dev/null; ln -s $WNG/../wng/wq_pap.inc wq_pap_inc # 921231 - rm -f WQ_PSL_DEF >& /dev/null; ln -s $WNG/../wng/wq_psl.def WQ_PSL_DEF # 921231 - rm -f wq_psl_inc >& /dev/null; ln -s $WNG/../wng/wq_psl.inc wq_psl_inc # 921231 - rm -f WQ_PSP_DEF >& /dev/null; ln -s $WNG/../wng/wq_psp.def WQ_PSP_DEF # 921231 - rm -f wq_psp_inc >& /dev/null; ln -s $WNG/../wng/wq_psp.inc wq_psp_inc # 921231 - rm -f WQ_QMP_DEF >& /dev/null; ln -s $WNG/../wng/wq_qmp.def WQ_QMP_DEF # 921231 - rm -f wq_qmp_inc >& /dev/null; ln -s $WNG/../wng/wq_qmp.inc wq_qmp_inc # 921231 - rm -f WQ_QMS_DEF >& /dev/null; ln -s $WNG/../wng/wq_qms.def WQ_QMS_DEF # 921231 - rm -f wq_qms_inc >& /dev/null; ln -s $WNG/../wng/wq_qms.inc wq_qms_inc # 921231 - rm -f WQ_REG_DEF >& /dev/null; ln -s $WNG/../wng/wq_reg.def WQ_REG_DEF # 921231 - rm -f wq_reg_inc >& /dev/null; ln -s $WNG/../wng/wq_reg.inc wq_reg_inc # 921231 - rm -f WQ_XAW_DEF >& /dev/null; ln -s $WNG/../wng/wq_xaw.def WQ_XAW_DEF # 930108 - rm -f wq_xaw_inc >& /dev/null; ln -s $WNG/../wng/wq_xaw.inc wq_xaw_inc # 930108 - rm -f WXH_DEF >& /dev/null; ln -s $WNG/../wng/wxh.def WXH_DEF # 921231 - rm -f wxh_inc >& /dev/null; ln -s $WNG/../wng/wxh.inc wxh_inc # 921231 diff --git a/src/wng/nxmain.com b/src/wng/nxmain.com deleted file mode 100755 index 71c601a440c622fc719d1710c7bbed25b0cb93e4..0000000000000000000000000000000000000000 --- a/src/wng/nxmain.com +++ /dev/null @@ -1,395 +0,0 @@ -$!# nxmain.ssc -$!# WNB 921117 -$!# -$!# Revisions: -$!# WNB 921210 Change compilation of .def etc; delete c?? -$!# WNB 921222 Add SSC and nonomatch for HP -$!# WNB 921224 Make SSC -$!# WNB 930303 NSTAR_DIR added -$!# WNB 930305 Make sure of aliases -$!# WNB 930305 Make from nbuild.ssc, nredo, ntarz, nupd, nxclup -$!# WNB 930803 Add .dsf -$!# WNB 940124 Leave _TLB -$!# -$!# Maintenance routines for Newstar. -$!# -$!# Uses environment variables: -$!# WNG where to find wng-type sources -$!# WNG_TYPE machine (sw, dw, hp, al, cv etc) -$!# WNG_OLBEXE root of wng-type .olb, .ppd, .exe -$!# WNG_SITE site (nfra, atnf, rug ...) -$!# EXEDWARF_UNIX where to find/set DWARF .exe, .ppd -$!# LIBDWARF where to find DWARF .olb -$!# NSTAR_DIR N directories -$!# and also possible: -$!# WNG_EXE, WNG_OLB, WNG_TLB, WNG_ERR, WNG_LIS, WNG_LINK -$!# -$!# Intro -$!# -$ SET NOON !DISCARD ERRORS -$ ON CONTROL_Y THEN GOTO EXEX !FINISH NEATLY -$ VER=F$VERIFY() !FOR ^Y -$ PID=F$EXTRACT(4,4,F$GETJPI("","PID")) !FOR TMP FILES -$ DEP=1 !FOR INDIRECT -$ LDAT=F$EXTRAC(2,2,F$CVTIM(,,"YEAR"))+F$CVTIM(,,"MONTH")+ - - F$CVTIM(,,"DAY") !VERSION -$ TELL="WRITE SYS$OUTPUT" !FOR EASE OF USE -$ TLOG="WRITE LOG''PID'''DEP'" -$ ! -$ ASSIGN="ASSIGN" !MAKE SURE PROPER USE -$ BACKUP="BACKUP" -$ COPY="COPY" -$ DELETE="DELETE" -$ DIR="DIRECTORY" -$ PURGE="PURGE" -$ SET="SET" -$ SHOW="SHOW" -$ TELL " " -$ TELL "Building Newstar." -$ TELL " " -$ TELL "A log will be made in WNG_DIR:[WNG.-]NB''PID'''DEP'.LOG" -$ TELL "There should be about 100 Mbytes available," -$ TELL "and it will probably take a few hours." -$ TELL " " -$!# -$!# Check environment -$!# -$ IF F$TRNLNM("WNG") .EQS. "" .OR. F$TRNLNM("WNG_OLBEXE") .EQS. "" - - .OR. F$TRNLNM("WNG_DIR") .EQS. "" - - .OR. "''WNG_TYPE'" .EQS. "" .OR. "''WNG_SITE'" .EQS. "" - - .OR. "''NSTAR_DIR'" .EQS. "" - -$ THEN -$ TELL " Error: Must have logicals WNG, WNG_OLBEXE, WNG_DIR and globals" -$ TELL " WNG_TYPE, WNG_SITE, NSTAR_DIR defined" -$ TELL " You probably have not included the proper" -$ TELL " files in LOGIN.COM" -$ GOTO EXEX -$ ENDIF -$ IF F$TRNLNM("EXEDWARF") .EQS. "" .OR. - - F$TRNLNM("LIBDWARF") .EQS. "" .OR. - - F$TRNLNM("RUNDWARF") .EQS. "" -$ THEN -$ TELL " Error: Cannot do everything with EXEDWARF and/or" -$ TELL " LIBDWARF and/or RUNDWARF not defined" -$ TELL " You probably have not included the proper" -$ TELL " files in LOGIN.COM" -$ GOTO EXEX -$ ENDIF -$ IF "''NXEC'" .EQS. "" -$ THEN -$ TELL " Error: You have no symbol for NXEC etc." -$ TELL " You probably have not included the proper" -$ TELL " files in LOGIN.COM" -$ GOTO EXEX -$ ENDIF -$ IF "''WNG_EXE'" .EQS. "" THEN - - WNG_EXE=F$TRNLNM("WNG_OLBEXE") -$ IF "''WNG_OLB'" .EQS. "" THEN - - WNG_OLB=F$TRNLNM("WNG_OLBEXE") -$ WNG_TLB="" ! MAKE SURE -$ WNG_ERR="" -$ WNG_LIS="" -$ WNG_LINK="" -$ BLDDIR="''NSTAR_DIR'" ! Newstar directories -$ L0=0 ! MAKE DIRECTORIES -$ LP1: L1=F$ELEMENT(L0,",",BLDDIR) -$ IF L1 .NES. "," -$ THEN -$ IF F$PARSE("''WNG_EXE':[''L1']") .EQS. "" THEN - ! MAKE DIRECTORIES - CREATE/DIR 'WNG_EXE'['L1'] -$ IF F$PARSE("''WNG_OLB':[''L1']") .EQS. "" THEN - - CREATE/DIR 'WNG_OLB':['L1'] -$ L0=L0+1 -$ GOTO LP1 -$ ENDIF -$!# -$!# Get questions -$!# -$ OPEN/WRITE/ERROR=EXEX LOG'PID''DEP' WNG_DIR:[WNG.-]NB'PID''DEP'.LOG ! START LOG -$ TLOG "NU''PID'''DEP'.LOG" -$ TELL "Running NBUILD.COM at ''WNG_SITE'(''WNG_TYPE')" -$ TLOG "Running NBUILD.COM at ''WNG_SITE'(''WNG_TYPE')" -$ TELL "on ''F$GETSYI("NODENAME")' at ''F$TIME()'" -$ TLOG "on ''F$GETSYI("NODENAME")' at ''F$TIME()'" -$ TELL " " -$ TLOG " " -$ DOGDEF="Y" -$ IF F$SEARCH("WNG_DIR:[WNG]WNG.DEF") .NES. "" -$ THEN -$ READ/TIME=90/END=EXEX/ERROR=EXEX - - /PROMPT=".def files seem to exist. Get them anyway? (Y|N) [Y]: " - - SYS$COMMAND L0 -$ TLOG ".def files seem to exist. Get them anyway? (Y|N) [Y]: ''L0'" -$ IF "''L0'" .EQS. "n" .OR. "''L0'" .EQS. "N" THEN DOGDEF="N" -$ ENDIF -$ DOMDEF="Y" -$ IF F$TRNLNM("WNG_DEF") .NES. "" .AND. .NOT. DOGDEF -$ THEN -$ READ/TIME=90/END=EXEX/ERROR=EXEX - - /PROMPT=".def files seem compiled. Compile them anyway? (Y|N) [Y]: " - - SYS$COMMAND L0 -$ TLOG ".def files seem compiled. Compile them anyway? (Y|N) [Y]: ''L0'" -$ IF "''L0'" .EQS. "n" .OR. "''L0'" .EQS. "N" THEN DOMDEF="N" -$ ENDIF -$ DOGGRP="Y" -$ IF F$SEARCH("WNG_DIR:[WNG]WNG.GRP") .NES. "" -$ THEN -$ READ/TIME=90/END=EXEX/ERROR=EXEX - - /PROMPT=".grp files seem to exist. Get them anyway? (Y|N) [Y]: " - - SYS$COMMAND L0 -$ TLOG ".grp files seem to exist. Get them anyway? (Y|N) [Y]: ''L0'" -$ IF "''L0'" .EQS. "n" .OR. "''L0'" .EQS. "N" THEN DOGGRP="N" -$ ENDIF -$ DOCOMP="N" -$ IF F$SEARCH("WNG_OLBEXE:[WNG]WNLIB.OLB") .NES. "" -$ THEN -$ READ/TIME=90/END=EXEX/ERROR=EXEX - - /PROMPT="Some compilation at least done. Compile all? (Y|N) [N]: " - - SYS$COMMAND L0 -$ TLOG "Some compilation at least done. Compile all? (Y|N) [N]: ''L0'" -$ IF "''L0'" .EQS. "y" .OR. "''L0'" .EQS. "Y" THEN DOCOMP="Y" -$ ELSE -$ DOCOMP="Y" -$ ENDIF -$ DOLINK="Y" -$ READ/TIME=90/END=EXEX/ERROR=EXEX - - /PROMPT="Link all programs? (Y|N) [Y]: " - - SYS$COMMAND L0 -$ TLOG "Link all programs? (Y|N) [Y]: ''L0'" -$ IF "''L0'" .EQS. "n" .OR. "''L0'" .EQS. "N" THEN DOLINK="N" -$ TELL "You could clean up all unwanted files." -$ TELL "(0)For operation the following files should remain:" -$ TELL " EXEDWARF:*.exe and *.ppd; RUNDWARF:*.exe; WNG_DIR:[*]*.COM" -$ TELL "(1)For easy updating the following files should also remain:" -$ TELL " WNG_OLBEXE:[*]*.olb WNG_DIR:[*]*.tlb and *.def and *.inc" -$ TELL " and *.grp;" -$ TELL "(2)To check programs all source files could remain" -$ TELL "(3)To check all listing files can remain" -$ TELL "I can remove for you including and above a specified level:" -$ TELL "(probably better to run with 4 first time, and rerun" -$ TELL " nbuild later with all questions n and the proper level)" -$ READ/TIME=90/END=EXEX/ERROR=EXEX - - /PROMPT="Clean disk level (1|2|3|4) [3]: " - - SYS$COMMAND L0 -$ IF L0 .LT. 1 .OR. L0 .GT.4 THEN L0=3 -$ TLOG "Clean disk level (1|2|3|4) [3]: ''L0'" -$ DOCLUP=L0 -$!# -$!# Get and make .def .sun -$!# -$ GDEF: -$ SET DEF WNG_DIR:[WNG.-] ! BASE DIRECTORY -$ IF DOGDEF -$ THEN -$ TELL "Getting .def ..." -$ TLOG "Getting .def ..." -$ ASSIGN/NOLOG LOG'PID''DEP' SYS$OUTPUT -$ ASSIGN/NOLOG LOG'PID''DEP' SYS$ERROR -$ L0=0 ! MAKE DIRECTORIES -$ LP2: L1=F$ELEMENT(L0,",",BLDDIR) -$ IF L1 .NES. "," -$ THEN -$ SET DEF WNG_DIR:['L1'] -$ NGET -A *.DEF *.INC *.PEF,*.DSF,*.SSC,*.COM ! GET .DEF -$ L0=L0+1 -$ GOTO LP2 -$ ENDIF -$ DEASSIGN SYS$OUTPUT -$ DEASSIGN SYS$ERROR -$ ENDIF -$ MDEF: -$ SET DEF WNG_DIR:[WNG.-] ! BASE DIRECTORY -$ IF DOMDEF -$ THEN -$ TELL "Compiling .def ..." -$ TLOG "Compiling .def ..." -$ ASSIGN/NOLOG LOG'PID''DEP' SYS$OUTPUT -$ ASSIGN/NOLOG LOG'PID''DEP' SYS$ERROR -$ L0=0 ! MAKE DIRECTORIES -$ LP3: L1=F$ELEMENT(L0,",",BLDDIR) -$ IF L1 .NES. "," -$ THEN -$ SET DEF WNG_DIR:['L1'] -$ NCOMP -U *.DEF *.INC *.PEF,*.DSF,*.SSC,*.COM ! COMPILE .DEF -$ L0=L0+1 -$ GOTO LP3 -$ ENDIF -$ DEASSIGN SYS$OUTPUT -$ DEASSIGN SYS$ERROR -$ ENDIF -$!# -$!# Get groups -$!# -$ GGRP: -$ SET DEF WNG_DIR:[WNG.-] ! BASE DIRECTORY -$ IF DOGGRP -$ THEN -$ TELL "Getting .grp ..." -$ TLOG "Getting .grp ..." -$ ASSIGN/NOLOG LOG'PID''DEP' SYS$OUTPUT -$ ASSIGN/NOLOG LOG'PID''DEP' SYS$ERROR -$ L0=0 ! MAKE DIRECTORIES -$ LP4: L1=F$ELEMENT(L0,",",BLDDIR) -$ IF L1 .NES. "," -$ THEN -$ SET DEF WNG_DIR:['L1'] -$ NGET -NZA *.GRP ! GET .GRP -$ L0=L0+1 -$ GOTO LP4 -$ ENDIF -$ DEASSIGN SYS$OUTPUT -$ DEASSIGN SYS$ERROR -$ ENDIF -$!# -$!# Compile all -$!# -$ COMP: -$ SET DEF WNG_DIR:[WNG.-] ! BASE DIRECTORY -$ IF DOCOMP -$ THEN -$ TELL "Compiling Newstar system ..." -$ TLOG "Compiling Newstar system ..." -$ ASSIGN/NOLOG LOG'PID''DEP' SYS$OUTPUT -$ ASSIGN/NOLOG LOG'PID''DEP' SYS$ERROR -$ L0=0 ! MAKE DIRECTORIES -$ LP5: L1=F$ELEMENT(L0,",",BLDDIR) -$ IF L1 .NES. "," -$ THEN -$ SET DEF WNG_DIR:['L1'] -$ NCOMP *.GRP ! COMPILE -$ L0=L0+1 -$ GOTO LP5 -$ ENDIF -$ DEASSIGN SYS$OUTPUT -$ DEASSIGN SYS$ERROR -$ ENDIF -$!# -$!# Link all -$!# -$ LINK: -$ SET DEF WNG_DIR:[WNG.-] ! BASE DIRECTORY -$ IF DOLINK -$ THEN -$ TELL "Linking Newstar system ..." -$ TLOG "Linking Newstar system ..." -$ ASSIGN/NOLOG LOG'PID''DEP' SYS$OUTPUT -$ ASSIGN/NOLOG LOG'PID''DEP' SYS$ERROR -$ L0=0 ! MAKE DIRECTORIES -$ LP6: L1=F$ELEMENT(L0,",",BLDDIR) -$ IF L1 .NES. "," -$ THEN -$ SET DEF WNG_DIR:['L1'] -$ NLINK -U *.GRP ! LINK -$ NCOMP -U *.PIN -$ NCOMP -U *.DSC -$ NCOMP -U *.SSC -$ L0=L0+1 -$ GOTO LP6 -$ ENDIF -$ DEASSIGN SYS$OUTPUT -$ DEASSIGN SYS$ERROR -$ ENDIF -$!# -$!# Cleanup -$!# -$ CLUP: -$ SET DEF WNG_DIR:[WNG.-] ! BASE DIRECTORY -$ IF DOCLUP .LT. 4 -$ THEN -$ TELL "Deleting listing files ..." -$ TLOG "Deleting listing files ..." -$ ASSIGN/NOLOG LOG'PID''DEP' SYS$OUTPUT -$ ASSIGN/NOLOG LOG'PID''DEP' SYS$ERROR -$ L0=0 ! MAKE DIRECTORIES -$ LP7: L1=F$ELEMENT(L0,",",BLDDIR) -$ IF L1 .NES. "," -$ THEN -$ SET DEF WNG_DIR:['L1'] -$ IF F$SEARCH("*.LIS") .NES. "" THEN DELETE *.LIS;* -$ IF F$SEARCH("*.ERR") .NES. "" THEN DELETE *.ERR;* -$ IF F$SEARCH("*.OLD") .NES. "" THEN DELETE *.OLD;* -$ IF F$SEARCH("*.NEW") .NES. "" THEN DELETE *.NEW;* -$ IF F$SEARCH("*.LOG") .NES. "" THEN DELETE *.LOG;* -$ IF F$SEARCH("*.TMP") .NES. "" THEN DELETE *.TMP;* -$ IF F$SEARCH("*.OBJ") .NES. "" THEN DELETE *.OBJ;* -$ IF F$SEARCH("*.JOU") .NES. "" THEN DELETE *.JOU;* -$ IF F$SEARCH("''WNG_EXE':[''L1']*.MAP") .NES. "" THEN - - DELETE WNG_EXE:['L1']*.MAP;* -$ L0=L0+1 -$ GOTO LP7 -$ ENDIF -$ DEASSIGN SYS$OUTPUT -$ DEASSIGN SYS$ERROR -$ ENDIF -$ IF DOCLUP .LT. 3 -$ THEN -$ TELL "Deleting source files ..." -$ TLOG "Deleting source files ..." -$ ASSIGN/NOLOG LOG'PID''DEP' SYS$OUTPUT -$ ASSIGN/NOLOG LOG'PID''DEP' SYS$ERROR -$ L0=0 ! MAKE DIRECTORIES -$ LP8: L1=F$ELEMENT(L0,",",BLDDIR) -$ IF L1 .NES. "," -$ THEN -$ SET DEF WNG_DIR:['L1'] -$ IF F$SEARCH("*.F%%") .NES. "" THEN DELETE *.F%%;* -$ IF F$SEARCH("*.C%%") .NES. "" THEN DELETE/EXCLUDE=(*.COM) *.C%%;* -$ IF F$SEARCH("*.M%%") .NES. "" THEN DELETE *.M%%;* -$ IF F$SEARCH("*.PIN") .NES. "" THEN DELETE *.PIN;* -$ L0=L0+1 -$ GOTO LP8 -$ ENDIF -$ DEASSIGN SYS$OUTPUT -$ DEASSIGN SYS$ERROR -$ ENDIF -$ IF DOCLUP .LT. 3 -$ THEN -$ TELL "Deleting object/include files ..." -$ TLOG "Deleting object/include files ..." -$ ASSIGN/NOLOG LOG'PID''DEP' SYS$OUTPUT -$ ASSIGN/NOLOG LOG'PID''DEP' SYS$ERROR -$ L0=0 ! MAKE DIRECTORIES -$ LP9: L1=F$ELEMENT(L0,",",BLDDIR) -$ IF L1 .NES. "," -$ THEN -$ SET DEF WNG_DIR:['L1'] -$ IF F$SEARCH("*.DEF") .NES. "" THEN DELETE *.DEF;* -$ IF F$SEARCH("*.INC") .NES. "" THEN DELETE *.INC;* -$ IF F$SEARCH("*.DSC") .NES. "" THEN DELETE *.DSC;* -$ IF F$SEARCH("*.SSC") .NES. "" THEN DELETE *.SSC;* -$ IF F$SEARCH("''WNG_OLB':[''L1']*.OLB") .NES. "" THEN - - DELETE WNG_OLB:['L1']*.OLB;* -$ L0=L0+1 -$ GOTO LP9 -$ ENDIF -$ DEASSIGN SYS$OUTPUT -$ DEASSIGN SYS$ERROR -$ ENDIF -$!# -$!# Ready -$!# -$ END: -$ TELL " " -$ TLOG " " -$ TELL "Newstar built. Try if everything works by typing:" -$ TELL " indwarf (unless in LOGIN.COM)" -$ TELL " dws ngen/nomenu" -$ TELL " log=y" -$ TELL " (empty line)" -$ TELL "and:" -$ TELL " pvax WNG_DIR:[WNG.-]NB''PID'''DEP'.LOG" -$ TELL "If problem exist, rerun @WNG:NBUILD with all questions y" -$ TELL "To make a minimum backup to be able to rebuild the system," -$ TELL "run @WNG:NTARZ" -$ TELL "Good luck" -$ TELL " " -$ TLOG " " -$!# -$!# EXIT -$!# -$ EXEX: SET ON -$ CLOSE/ERROR=EXX1 LOG'PID''DEP !MAKE SURE -$ EXX1: -$ SET DEF WNG_DIR:[WNG.-] !BACK TO NORMAL -$ L0=F$VERIFY(VER) !RESET VERIFY -$ EXIT diff --git a/src/wng/nxmain.ssc b/src/wng/nxmain.ssc deleted file mode 100644 index 586cc87546a7ce3596a8f02b20597b2d3de5b3a2..0000000000000000000000000000000000000000 --- a/src/wng/nxmain.ssc +++ /dev/null @@ -1,674 +0,0 @@ -# nxmain.ssc -# WNB 921117 -# -# Revisions: -# WNB 921210 Change compilation of .def etc; delete c?? -# WNB 921222 Add SSC and nonomatch for HP -# WNB 921224 Make SSC -# WNB 930303 NSTAR_DIR added -# WNB 930305 Make sure of aliases -# WNB 930305 Make from nbuild.ssc, nredo, ntarz, nupd, nxclup -# WNB 930803 Add .dsf -# WNB 940124 Leave _TLB -# -# Maintenance routines for Newstar. -# -# Uses environment variables: -# WNG where to find wng-type sources -# WNG_TYPE machine (sw, dw, hp, al, cv etc) -# WNG_OLBEXE root of wng-type .olb, .ppd, .exe -# WNG_SITE site (nfra, atnf, rug ...) -# EXEDWARF_UNIX where to find/set DWARF .exe, .ppd -# LIBDWARF where to find DWARF .olb -# NSTAR_DIR N directories -# and also possible: -# WNG_EXE, WNG_OLB, WNG_TLB, WNG_ERR, WNG_LIS, WNG_LINK -# -# Intro -# -#ifdef wn_vax__ -$ SET NOON !DISCARD ERRORS -$ ON CONTROL_Y THEN GOTO EXEX !FINISH NEATLY -$ VER=F$VERIFY() !FOR ^Y -$ PID=F$EXTRACT(4,4,F$GETJPI("","PID")) !FOR TMP FILES -$ DEP=1 !FOR INDIRECT -$ LDAT=F$EXTRAC(2,2,F$CVTIM(,,"YEAR"))+F$CVTIM(,,"MONTH")+ - - F$CVTIM(,,"DAY") !VERSION -$ TELL="WRITE SYS$OUTPUT" !FOR EASE OF USE -$ TLOG="WRITE LOG''PID'''DEP'" -$ ! -$ ASSIGN="ASSIGN" !MAKE SURE PROPER USE -$ BACKUP="BACKUP" -$ COPY="COPY" -$ DELETE="DELETE" -$ DIR="DIRECTORY" -$ PURGE="PURGE" -$ SET="SET" -$ SHOW="SHOW" -$ TELL " " -$ TELL "Building Newstar." -$ TELL " " -$ TELL "A log will be made in WNG_DIR:[WNG.-]NB''PID'''DEP'.LOG" -$ TELL "There should be about 100 Mbytes available," -$ TELL "and it will probably take a few hours." -$ TELL " " -#else - onintr exex # finish neatly - if ($?echo) unset echo # no verify - if ($?verbose) unset verbose # no verbose - set pid=$$ ; @ dep=1 # for tmp files - echo " " - echo "Building Newstar." - echo " " - echo 'A log will be made in $WNG'"/../nb$pid$dep.log" - echo "There should be about 100 Mbytes available," - echo "and it will probably take a few hours." - echo " " -#endif -# -# Check environment -# -#ifdef wn_vax__ -$ IF F$TRNLNM("WNG") .EQS. "" .OR. F$TRNLNM("WNG_OLBEXE") .EQS. "" - - .OR. F$TRNLNM("WNG_DIR") .EQS. "" - - .OR. "''WNG_TYPE'" .EQS. "" .OR. "''WNG_SITE'" .EQS. "" - - .OR. "''NSTAR_DIR'" .EQS. "" - -$ THEN -$ TELL " Error: Must have logicals WNG, WNG_OLBEXE, WNG_DIR and globals" -$ TELL " WNG_TYPE, WNG_SITE, NSTAR_DIR defined" -$ TELL " You probably have not included the proper" -$ TELL " files in LOGIN.COM" -$ GOTO EXEX -$ ENDIF -$ IF F$TRNLNM("EXEDWARF") .EQS. "" .OR. - - F$TRNLNM("LIBDWARF") .EQS. "" .OR. - - F$TRNLNM("RUNDWARF") .EQS. "" -$ THEN -$ TELL " Error: Cannot do everything with EXEDWARF and/or" -$ TELL " LIBDWARF and/or RUNDWARF not defined" -$ TELL " You probably have not included the proper" -$ TELL " files in LOGIN.COM" -$ GOTO EXEX -$ ENDIF -$ IF "''NXEC'" .EQS. "" -$ THEN -$ TELL " Error: You have no symbol for NXEC etc." -$ TELL " You probably have not included the proper" -$ TELL " files in LOGIN.COM" -$ GOTO EXEX -$ ENDIF -$ IF "''WNG_EXE'" .EQS. "" THEN - - WNG_EXE=F$TRNLNM("WNG_OLBEXE") -$ IF "''WNG_OLB'" .EQS. "" THEN - - WNG_OLB=F$TRNLNM("WNG_OLBEXE") -$ WNG_TLB="" ! MAKE SURE -$ WNG_ERR="" -$ WNG_LIS="" -$ WNG_LINK="" -$ BLDDIR="''NSTAR_DIR'" ! Newstar directories -$ L0=0 ! MAKE DIRECTORIES -$ LP1: L1=F$ELEMENT(L0,",",BLDDIR) -$ IF L1 .NES. "," -$ THEN -$ IF F$PARSE("''WNG_EXE':[''L1']") .EQS. "" THEN - ! MAKE DIRECTORIES - CREATE/DIR 'WNG_EXE'['L1'] -$ IF F$PARSE("''WNG_OLB':[''L1']") .EQS. "" THEN - - CREATE/DIR 'WNG_OLB':['L1'] -$ L0=L0+1 -$ GOTO LP1 -$ ENDIF -#else - if (! $?WNG || ! $?WNG_TYPE || ! $?WNG_OLBEXE ||\ - ! $?WNG_SITE || ! $?NSTAR_DIR) then - echo " Error: Must have environment variables" - echo " WNG, WNG_TYPE, WNG_OLBEXE, WNG_SITE, NSTAR_DIR defined" - echo " You probably have not included the proper" - echo " files in .cshrc (see README)" - goto exex - endif - if (! $?EXEDWARF_UNIX || ! $?LIBDWARF) then - echo " Error: Cannot do everything with EXEDWARF_UNIX and/or" - echo " LIBDWARF not defined" - echo " You probably have not included the proper" - echo " files in .cshrc (see README)" - goto exex - endif - $WNG/wngcshrc.sun # get aliases - if ("`alias nxec`" == "") then - echo " Error: You have no alias for nxec etc." - echo " You probably have not included the proper" - echo " files in .cshrc (see README)" - goto exex - endif -# -# Creating environment -# - cd $WNG - if (! $?WNG_EXE) setenv WNG_EXE $WNG_OLBEXE # make names - if (! $?WNG_OLB) setenv WNG_OLB $WNG_OLBEXE - set blddir=($NSTAR_DIR) # Newstar directories - foreach i ($blddir) - if (! -d $WNG_EXE/$i) mkdir $WNG_EXE/$i # make directories - if (! -d $WNG_OLB/$i) mkdir $WNG_OLB/$i - endif -## if ($?WNG_TLB) unsetenv WNG_TLB # make sure - if ($?WNG_ERR) unsetenv WNG_ERR - if ($?WNG_LIS) unsetenv WNG_LIS - if ($?WNG_LINK) unsetenv WNG_LINK -#endif -# -# Get questions -# -#ifdef wn_vax__ -$ OPEN/WRITE/ERROR=EXEX LOG'PID''DEP' WNG_DIR:[WNG.-]NB'PID''DEP'.LOG ! START LOG -$ TLOG "NU''PID'''DEP'.LOG" -$ TELL "Running NBUILD.COM at ''WNG_SITE'(''WNG_TYPE')" -$ TLOG "Running NBUILD.COM at ''WNG_SITE'(''WNG_TYPE')" -$ TELL "on ''F$GETSYI("NODENAME")' at ''F$TIME()'" -$ TLOG "on ''F$GETSYI("NODENAME")' at ''F$TIME()'" -$ TELL " " -$ TLOG " " -$ DOGDEF="Y" -$ IF F$SEARCH("WNG_DIR:[WNG]WNG.DEF") .NES. "" -$ THEN -$ READ/TIME=90/END=EXEX/ERROR=EXEX - - /PROMPT=".def files seem to exist. Get them anyway? (Y|N) [Y]: " - - SYS$COMMAND L0 -$ TLOG ".def files seem to exist. Get them anyway? (Y|N) [Y]: ''L0'" -$ IF "''L0'" .EQS. "n" .OR. "''L0'" .EQS. "N" THEN DOGDEF="N" -$ ENDIF -$ DOMDEF="Y" -$ IF F$TRNLNM("WNG_DEF") .NES. "" .AND. .NOT. DOGDEF -$ THEN -$ READ/TIME=90/END=EXEX/ERROR=EXEX - - /PROMPT=".def files seem compiled. Compile them anyway? (Y|N) [Y]: " - - SYS$COMMAND L0 -$ TLOG ".def files seem compiled. Compile them anyway? (Y|N) [Y]: ''L0'" -$ IF "''L0'" .EQS. "n" .OR. "''L0'" .EQS. "N" THEN DOMDEF="N" -$ ENDIF -$ DOGGRP="Y" -$ IF F$SEARCH("WNG_DIR:[WNG]WNG.GRP") .NES. "" -$ THEN -$ READ/TIME=90/END=EXEX/ERROR=EXEX - - /PROMPT=".grp files seem to exist. Get them anyway? (Y|N) [Y]: " - - SYS$COMMAND L0 -$ TLOG ".grp files seem to exist. Get them anyway? (Y|N) [Y]: ''L0'" -$ IF "''L0'" .EQS. "n" .OR. "''L0'" .EQS. "N" THEN DOGGRP="N" -$ ENDIF -$ DOCOMP="N" -$ IF F$SEARCH("WNG_OLBEXE:[WNG]WNLIB.OLB") .NES. "" -$ THEN -$ READ/TIME=90/END=EXEX/ERROR=EXEX - - /PROMPT="Some compilation at least done. Compile all? (Y|N) [N]: " - - SYS$COMMAND L0 -$ TLOG "Some compilation at least done. Compile all? (Y|N) [N]: ''L0'" -$ IF "''L0'" .EQS. "y" .OR. "''L0'" .EQS. "Y" THEN DOCOMP="Y" -$ ELSE -$ DOCOMP="Y" -$ ENDIF -$ DOLINK="Y" -$ READ/TIME=90/END=EXEX/ERROR=EXEX - - /PROMPT="Link all programs? (Y|N) [Y]: " - - SYS$COMMAND L0 -$ TLOG "Link all programs? (Y|N) [Y]: ''L0'" -$ IF "''L0'" .EQS. "n" .OR. "''L0'" .EQS. "N" THEN DOLINK="N" -$ TELL "You could clean up all unwanted files." -$ TELL "(0)For operation the following files should remain:" -$ TELL " EXEDWARF:*.exe and *.ppd; RUNDWARF:*.exe; WNG_DIR:[*]*.COM" -$ TELL "(1)For easy updating the following files should also remain:" -$ TELL " WNG_OLBEXE:[*]*.olb WNG_DIR:[*]*.tlb and *.def and *.inc" -$ TELL " and *.grp;" -$ TELL "(2)To check programs all source files could remain" -$ TELL "(3)To check all listing files can remain" -$ TELL "I can remove for you including and above a specified level:" -$ TELL "(probably better to run with 4 first time, and rerun" -$ TELL " nbuild later with all questions n and the proper level)" -$ READ/TIME=90/END=EXEX/ERROR=EXEX - - /PROMPT="Clean disk level (1|2|3|4) [3]: " - - SYS$COMMAND L0 -$ IF L0 .LT. 1 .OR. L0 .GT.4 THEN L0=3 -$ TLOG "Clean disk level (1|2|3|4) [3]: ''L0'" -$ DOCLUP=L0 -#else - echo "nb$pid$dep.log" >>! $WNG/../nb$pid$dep.log # start log - echo "Running NBUILD.SUN for $WNG_SITE($WNG_TYPE)" \ - | tee -a $WNG/../nb$pid$dep.log - echo "on `hostname` at `date`" | tee -a $WNG/../nb$pid$dep.log - echo " " | tee -a $WNG/../nb$pid$dep.log - set dogdef - if (-e wng.def) then - echo -n ".def files seem to exist. Get them anyway? (y|n) [y]: " \ - | tee -a $WNG/../nb$pid$dep.log - set l0=($<) - echo "$l0" >>! $WNG/../nb$pid$dep.log - if ("$l0" =~ [nN]*) unset dogdef # skip get - endif - set domdef - if (-e WNG_DEF) then - echo -n ".def files seem compiled. Compile them anyway? (y|n) [y]: " \ - | tee -a $WNG/../nb$pid$dep.log - set l0=($<) - echo "$l0" >>! $WNG/../nb$pid$dep.log - if ("$l0" =~ [nN]*) unset domdef # skip compile - endif - set doggrp - if (-e wng.grp) then - echo -n ".grp files seem to exist. Get them anyway? (y|n) [y]: " \ - | tee -a $WNG/../nb$pid$dep.log - set l0=($<) - echo "$l0" >>! $WNG/../nb$pid$dep.log - if ("$l0" =~ [nN]*) unset doggrp # skip compile - endif - set l0=("`ar t $WNG_OLBEXE/wng/wnlib.olb wngang.o`") - if ("$l0" == "wngang.o") then - echo -n "Some compilation at least done. Compile all? (y|n) [n]: " \ - | tee -a $WNG/../nb$pid$dep.log - set l0=($<) - echo "$l0" >>! $WNG/../nb$pid$dep.log - if ("$l0" =~ [yY]*) set docomp # do compile - else - set docomp - endif - set dolink - echo -n "Link all programs? (y|n) [y]: " \ - | tee -a $WNG/../nb$pid$dep.log - set l0=($<) - echo "$l0" >>! $WNG/../nb$pid$dep.log - if ("$l0" =~ [nN]*) unset dolink # skip link - echo "You could clean up all unwanted files." \ - | tee -a $WNG/../nb$pid$dep.log - echo "(0)For operation the following files should remain:" \ - | tee -a $WNG/../nb$pid$dep.log - echo ' $EXEDWARF_UNIX/*.exe and *.ppd; $WNG/../*/*.sun' \ - | tee -a $WNG/../nb$pid$dep.log - echo "(1)For easy updating the following files should also remain:" \ - | tee -a $WNG/../nb$pid$dep.log - echo ' $WNG_OLB/*/*.olb $WNG/../*/*.tlb and *.def and *.inc' \ - | tee -a $WNG/../nb$pid$dep.log - echo ' and *DEF and *.grp;' \ - | tee -a $WNG/../nb$pid$dep.log - echo ' upper case in $WNG/../dwarf (except *.LOG)' \ - | tee -a $WNG/../nb$pid$dep.log - echo "(2)To check programs all source files could remain" \ - | tee -a $WNG/../nb$pid$dep.log - echo "(3)To check all listing files can remain" \ - | tee -a $WNG/../nb$pid$dep.log - echo "I can remove for you including and above a specified level:" \ - | tee -a $WNG/../nb$pid$dep.log - echo "(probably better to run with 4 first time, and rerun" \ - | tee -a $WNG/../nb$pid$dep.log - echo " nbuild later with all questions n and the proper level)" \ - | tee -a $WNG/../nb$pid$dep.log - echo -n "Clean disk level (1|2|3|4) [3]: " \ - | tee -a $WNG/../nb$pid$dep.log - set l0=($<) - if ("$l0" !~ [1234]) set l0=3 - echo "$l0" >>! $WNG/../nb$pid$dep.log - set doclup=$l0 -#endif -# -# Get and make .def .sun -# -#ifdef wn_vax__ -$ GDEF: -$ SET DEF WNG_DIR:[WNG.-] ! BASE DIRECTORY -$ IF DOGDEF -$ THEN -$ TELL "Getting .def ..." -$ TLOG "Getting .def ..." -$ ASSIGN/NOLOG LOG'PID''DEP' SYS$OUTPUT -$ ASSIGN/NOLOG LOG'PID''DEP' SYS$ERROR -$ L0=0 ! MAKE DIRECTORIES -$ LP2: L1=F$ELEMENT(L0,",",BLDDIR) -$ IF L1 .NES. "," -$ THEN -$ SET DEF WNG_DIR:['L1'] -$ NGET -A *.DEF *.INC *.PEF,*.DSF,*.SSC,*.COM ! GET .DEF -$ L0=L0+1 -$ GOTO LP2 -$ ENDIF -$ DEASSIGN SYS$OUTPUT -$ DEASSIGN SYS$ERROR -$ ENDIF -$ MDEF: -$ SET DEF WNG_DIR:[WNG.-] ! BASE DIRECTORY -$ IF DOMDEF -$ THEN -$ TELL "Compiling .def ..." -$ TLOG "Compiling .def ..." -$ ASSIGN/NOLOG LOG'PID''DEP' SYS$OUTPUT -$ ASSIGN/NOLOG LOG'PID''DEP' SYS$ERROR -$ L0=0 ! MAKE DIRECTORIES -$ LP3: L1=F$ELEMENT(L0,",",BLDDIR) -$ IF L1 .NES. "," -$ THEN -$ SET DEF WNG_DIR:['L1'] -$ NCOMP -U *.DEF *.INC *.PEF,*.DSF,*.SSC,*.COM ! COMPILE .DEF -$ L0=L0+1 -$ GOTO LP3 -$ ENDIF -$ DEASSIGN SYS$OUTPUT -$ DEASSIGN SYS$ERROR -$ ENDIF -#else -GDEF: - cd $WNG # base directory - if ($?dogdef) then - echo "Getting .def ..." | tee -a $WNG/../nb$pid$dep.log - foreach i ($blddir) # get .def - cd ../$i # correct directory - nget -a '.*def' '.*pef' '.*dsf' '.*inc' '.*ssc' '.*sun' \ - >>&! $WNG/../nb$pid$dep.log - end - endif -MDEF: - cd $WNG # base directory - if ($?domdef) then - echo "Compiling .def ..." | tee -a $WNG/../nb$pid$dep.log - foreach i ($blddir) # compile .def - cd ../$i # correct directory - ncomp -u *.def *.inc *.pef *.dsf *.ssc *.sun \ - >>&! $WNG/../nb$pid$dep.log - end - endif -#endif -# -# Get groups -# -#ifdef wn_vax__ -$ GGRP: -$ SET DEF WNG_DIR:[WNG.-] ! BASE DIRECTORY -$ IF DOGGRP -$ THEN -$ TELL "Getting .grp ..." -$ TLOG "Getting .grp ..." -$ ASSIGN/NOLOG LOG'PID''DEP' SYS$OUTPUT -$ ASSIGN/NOLOG LOG'PID''DEP' SYS$ERROR -$ L0=0 ! MAKE DIRECTORIES -$ LP4: L1=F$ELEMENT(L0,",",BLDDIR) -$ IF L1 .NES. "," -$ THEN -$ SET DEF WNG_DIR:['L1'] -$ NGET -NZA *.GRP ! GET .GRP -$ L0=L0+1 -$ GOTO LP4 -$ ENDIF -$ DEASSIGN SYS$OUTPUT -$ DEASSIGN SYS$ERROR -$ ENDIF -#else -GGRP: - cd $WNG # base directory - if ($?doggrp) then - echo "Getting .grp ..." | tee -a $WNG/../nb$pid$dep.log - foreach i ($blddir) # get .grp - cd ../$i # correct directory - nget -nza '.*grp' >>&! $WNG/../nb$pid$dep.log # get .grp - end - endif -#endif -# -# Compile all -# -#ifdef wn_vax__ -$ COMP: -$ SET DEF WNG_DIR:[WNG.-] ! BASE DIRECTORY -$ IF DOCOMP -$ THEN -$ TELL "Compiling Newstar system ..." -$ TLOG "Compiling Newstar system ..." -$ ASSIGN/NOLOG LOG'PID''DEP' SYS$OUTPUT -$ ASSIGN/NOLOG LOG'PID''DEP' SYS$ERROR -$ L0=0 ! MAKE DIRECTORIES -$ LP5: L1=F$ELEMENT(L0,",",BLDDIR) -$ IF L1 .NES. "," -$ THEN -$ SET DEF WNG_DIR:['L1'] -$ NCOMP *.GRP ! COMPILE -$ L0=L0+1 -$ GOTO LP5 -$ ENDIF -$ DEASSIGN SYS$OUTPUT -$ DEASSIGN SYS$ERROR -$ ENDIF -#else -COMP: - cd $WNG # base directory - if ($?docomp) then - echo "Compiling Newstar system ..." | tee -a $WNG/../nb$pid$dep.log - foreach i ($blddir) # compile - cd ../$i # correct directory - ncomp *.grp >>&! $WNG/../nb$pid$dep.log # compile - end - endif -#endif -# -# Link all -# -#ifdef wn_vax__ -$ LINK: -$ SET DEF WNG_DIR:[WNG.-] ! BASE DIRECTORY -$ IF DOLINK -$ THEN -$ TELL "Linking Newstar system ..." -$ TLOG "Linking Newstar system ..." -$ ASSIGN/NOLOG LOG'PID''DEP' SYS$OUTPUT -$ ASSIGN/NOLOG LOG'PID''DEP' SYS$ERROR -$ L0=0 ! MAKE DIRECTORIES -$ LP6: L1=F$ELEMENT(L0,",",BLDDIR) -$ IF L1 .NES. "," -$ THEN -$ SET DEF WNG_DIR:['L1'] -$ NLINK -U *.GRP ! LINK -$ NCOMP -U *.PIN -$ NCOMP -U *.DSC -$ NCOMP -U *.SSC -$ L0=L0+1 -$ GOTO LP6 -$ ENDIF -$ DEASSIGN SYS$OUTPUT -$ DEASSIGN SYS$ERROR -$ ENDIF -#else -LINK: - cd $WNG # base directory - if ($?dolink) then - echo "Linking Newstar system ..." | tee -a $WNG/../nb$pid$dep.log - foreach i ($blddir) # link - cd ../$i # correct directory - nlink -u *.grp >>&! $WNG/../nb$pid$dep.log # link all programs - end - foreach i ($blddir) # compile .pin - cd ../$i # correct directory - ncomp -u *.pin >>&! $WNG/../nb$pid$dep.log # make ppd - end - foreach i ($blddir) # compile .*sc - cd ../$i # correct directory - ncomp -u *.dsc >>&! $WNG/../nb$pid$dep.log # compile .dsc - ncomp -u *.ssc >>&! $WNG/../nb$pid$dep.log # compile .ssc - end - endif -#endif -# -# Cleanup -# -#ifdef wn_vax__ -$ CLUP: -$ SET DEF WNG_DIR:[WNG.-] ! BASE DIRECTORY -$ IF DOCLUP .LT. 4 -$ THEN -$ TELL "Deleting listing files ..." -$ TLOG "Deleting listing files ..." -$ ASSIGN/NOLOG LOG'PID''DEP' SYS$OUTPUT -$ ASSIGN/NOLOG LOG'PID''DEP' SYS$ERROR -$ L0=0 ! MAKE DIRECTORIES -$ LP7: L1=F$ELEMENT(L0,",",BLDDIR) -$ IF L1 .NES. "," -$ THEN -$ SET DEF WNG_DIR:['L1'] -$ IF F$SEARCH("*.LIS") .NES. "" THEN DELETE *.LIS;* -$ IF F$SEARCH("*.ERR") .NES. "" THEN DELETE *.ERR;* -$ IF F$SEARCH("*.OLD") .NES. "" THEN DELETE *.OLD;* -$ IF F$SEARCH("*.NEW") .NES. "" THEN DELETE *.NEW;* -$ IF F$SEARCH("*.LOG") .NES. "" THEN DELETE *.LOG;* -$ IF F$SEARCH("*.TMP") .NES. "" THEN DELETE *.TMP;* -$ IF F$SEARCH("*.OBJ") .NES. "" THEN DELETE *.OBJ;* -$ IF F$SEARCH("*.JOU") .NES. "" THEN DELETE *.JOU;* -$ IF F$SEARCH("''WNG_EXE':[''L1']*.MAP") .NES. "" THEN - - DELETE WNG_EXE:['L1']*.MAP;* -$ L0=L0+1 -$ GOTO LP7 -$ ENDIF -$ DEASSIGN SYS$OUTPUT -$ DEASSIGN SYS$ERROR -$ ENDIF -$ IF DOCLUP .LT. 3 -$ THEN -$ TELL "Deleting source files ..." -$ TLOG "Deleting source files ..." -$ ASSIGN/NOLOG LOG'PID''DEP' SYS$OUTPUT -$ ASSIGN/NOLOG LOG'PID''DEP' SYS$ERROR -$ L0=0 ! MAKE DIRECTORIES -$ LP8: L1=F$ELEMENT(L0,",",BLDDIR) -$ IF L1 .NES. "," -$ THEN -$ SET DEF WNG_DIR:['L1'] -$ IF F$SEARCH("*.F%%") .NES. "" THEN DELETE *.F%%;* -$ IF F$SEARCH("*.C%%") .NES. "" THEN DELETE/EXCLUDE=(*.COM) *.C%%;* -$ IF F$SEARCH("*.M%%") .NES. "" THEN DELETE *.M%%;* -$ IF F$SEARCH("*.PIN") .NES. "" THEN DELETE *.PIN;* -$ L0=L0+1 -$ GOTO LP8 -$ ENDIF -$ DEASSIGN SYS$OUTPUT -$ DEASSIGN SYS$ERROR -$ ENDIF -$ IF DOCLUP .LT. 3 -$ THEN -$ TELL "Deleting object/include files ..." -$ TLOG "Deleting object/include files ..." -$ ASSIGN/NOLOG LOG'PID''DEP' SYS$OUTPUT -$ ASSIGN/NOLOG LOG'PID''DEP' SYS$ERROR -$ L0=0 ! MAKE DIRECTORIES -$ LP9: L1=F$ELEMENT(L0,",",BLDDIR) -$ IF L1 .NES. "," -$ THEN -$ SET DEF WNG_DIR:['L1'] -$ IF F$SEARCH("*.DEF") .NES. "" THEN DELETE *.DEF;* -$ IF F$SEARCH("*.INC") .NES. "" THEN DELETE *.INC;* -$ IF F$SEARCH("*.DSC") .NES. "" THEN DELETE *.DSC;* -$ IF F$SEARCH("*.SSC") .NES. "" THEN DELETE *.SSC;* -$ IF F$SEARCH("''WNG_OLB':[''L1']*.OLB") .NES. "" THEN - - DELETE WNG_OLB:['L1']*.OLB;* -$ L0=L0+1 -$ GOTO LP9 -$ ENDIF -$ DEASSIGN SYS$OUTPUT -$ DEASSIGN SYS$ERROR -$ ENDIF -#else -CLUP: - cd $WNG - if ($doclup < 4) then - echo "Removing listing files ..." | tee -a $WNG/../nb$pid$dep.log - foreach i ($blddir) # remove listings - cd ../$i - set nonomatch - 'rm' *.lis >& /dev/null - 'rm' *.err >& /dev/null - 'rm' *.old >& /dev/null - 'rm' *.new >& /dev/null - 'rm' *.log >& /dev/null - 'rm' *.LOG >& /dev/null - 'rm' *.tmp >& /dev/null - 'rm' *~ >& /dev/null - 'rm' *.o >& /dev/null - 'rm' $WNG_EXE/$i/*.map >& /dev/null - unset nonomatch - end - endif - if ($doclup < 3) then - echo "Removing source files ..." | tee -a $WNG/../nb$pid$dep.log - foreach i ($blddir) - cd ../$i - set nonomatch - 'rm' *.f?? >& /dev/null - 'rm' *.c[a-np-z]? >& /dev/null - 'rm' *.m?? >& /dev/null - 'rm' *.pin >& /dev/null - unset nonomatch - end - endif - if ($doclup < 2) then - echo "Removing object/include files ..." \ - | tee -a $WNG/../nb$pid$dep.log - foreach i ($blddir) - cd ../$i - 'rm' $WNG_OLB/$i/*.olb >& /dev/null - set nonomatch - 'rm' *.def >& /dev/null - 'rm' *.inc >& /dev/null - 'rm' *.dsc >& /dev/null - 'rm' *DEF >& /dev/null - 'rm' *.ssc >& /dev/null - 'rm' [A-Z0-9]* >& /dev/null - unset nonomatch - end - endif -#endif -# -# Ready -# -#ifdef wn_vax__ -$ END: -$ TELL " " -$ TLOG " " -$ TELL "Newstar built. Try if everything works by typing:" -$ TELL " indwarf (unless in LOGIN.COM)" -$ TELL " dws ngen/nomenu" -$ TELL " log=y" -$ TELL " (empty line)" -$ TELL "and:" -$ TELL " pvax WNG_DIR:[WNG.-]NB''PID'''DEP'.LOG" -$ TELL "If problem exist, rerun @WNG:NBUILD with all questions y" -$ TELL "To make a minimum backup to be able to rebuild the system," -$ TELL "run @WNG:NTARZ" -$ TELL "Good luck" -$ TELL " " -$ TLOG " " -#else -END: - echo " " | tee -a $WNG/../nb$pid$dep.log - echo "Newstar built. Try if everything works by typing:" \ - | tee -a $WNG/../nb$pid$dep.log - echo " indwarf (unless in .cshrc)" \ - | tee -a $WNG/../nb$pid$dep.log - echo " dws ngen/nomenu" | tee -a $WNG/../nb$pid$dep.log - echo " log=y" | tee -a $WNG/../nb$pid$dep.log - echo " (empty line)" \ - | tee -a $WNG/../nb$pid$dep.log - echo "and:" | tee -a $WNG/../nb$pid$dep.log - echo ' pvax $WNG'"/../nb$pid$dep.log" \ - | tee -a $WNG/../nb$pid$dep.log - echo 'If problem exist, rerun $WNG'"/nbuild.sun with all questions y" \ - | tee -a $WNG/../nb$pid$dep.log - echo "To make a minimum backup to be able to rebuild the system," \ - | tee -a $WNG/../nb$pid$dep.log - echo 'run $WNG'"/ntarz.sun" | tee -a $WNG/../nb$pid$dep.log - echo "Good luck" | tee -a $WNG/../nb$pid$dep.log - echo " " | tee -a $WNG/../nb$pid$dep.log -#endif -# -# EXIT -# -#ifdef wn_vax__ -$ EXEX: SET ON -$ CLOSE/ERROR=EXX1 LOG'PID''DEP !MAKE SURE -$ EXX1: -$ SET DEF WNG_DIR:[WNG.-] !BACK TO NORMAL -$ L0=F$VERIFY(VER) !RESET VERIFY -$ EXIT -#else -exex: - exit -#endif diff --git a/src/wng/nxmain.sun b/src/wng/nxmain.sun deleted file mode 100755 index 66bb4f4342029d23326905139b5d8b957e686ec0..0000000000000000000000000000000000000000 --- a/src/wng/nxmain.sun +++ /dev/null @@ -1,304 +0,0 @@ -# nxmain.ssc -# WNB 921117 -# -# Revisions: -# WNB 921210 Change compilation of .def etc; delete c?? -# WNB 921222 Add SSC and nonomatch for HP -# WNB 921224 Make SSC -# WNB 930303 NSTAR_DIR added -# WNB 930305 Make sure of aliases -# WNB 930305 Make from nbuild.ssc, nredo, ntarz, nupd, nxclup -# WNB 930803 Add .dsf -# WNB 940124 Leave _TLB -# -# Maintenance routines for Newstar. -# -# Uses environment variables: -# WNG where to find wng-type sources -# WNG_TYPE machine (sw, dw, hp, al, cv etc) -# WNG_OLBEXE root of wng-type .olb, .ppd, .exe -# WNG_SITE site (nfra, atnf, rug ...) -# EXEDWARF_UNIX where to find/set DWARF .exe, .ppd -# LIBDWARF where to find DWARF .olb -# NSTAR_DIR N directories -# and also possible: -# WNG_EXE, WNG_OLB, WNG_TLB, WNG_ERR, WNG_LIS, WNG_LINK -# -# Intro -# - onintr exex # finish neatly - if ($?echo) unset echo # no verify - if ($?verbose) unset verbose # no verbose - set pid=$$ ; @ dep=1 # for tmp files - echo " " - echo "Building Newstar." - echo " " - echo 'A log will be made in $WNG'"/../nb$pid$dep.log" - echo "There should be about 100 Mbytes available," - echo "and it will probably take a few hours." - echo " " -# -# Check environment -# - if (! $?WNG || ! $?WNG_TYPE || ! $?WNG_OLBEXE ||\ - ! $?WNG_SITE || ! $?NSTAR_DIR) then - echo " Error: Must have environment variables" - echo " WNG, WNG_TYPE, WNG_OLBEXE, WNG_SITE, NSTAR_DIR defined" - echo " You probably have not included the proper" - echo " files in .cshrc (see README)" - goto exex - endif - if (! $?EXEDWARF_UNIX || ! $?LIBDWARF) then - echo " Error: Cannot do everything with EXEDWARF_UNIX and/or" - echo " LIBDWARF not defined" - echo " You probably have not included the proper" - echo " files in .cshrc (see README)" - goto exex - endif - $WNG/wngcshrc.sun # get aliases - if ("`alias nxec`" == "") then - echo " Error: You have no alias for nxec etc." - echo " You probably have not included the proper" - echo " files in .cshrc (see README)" - goto exex - endif -# -# Creating environment -# - cd $WNG - if (! $?WNG_EXE) setenv WNG_EXE $WNG_OLBEXE # make names - if (! $?WNG_OLB) setenv WNG_OLB $WNG_OLBEXE - set blddir=($NSTAR_DIR) # Newstar directories - foreach i ($blddir) - if (! -d $WNG_EXE/$i) mkdir $WNG_EXE/$i # make directories - if (! -d $WNG_OLB/$i) mkdir $WNG_OLB/$i - endif -## if ($?WNG_TLB) unsetenv WNG_TLB # make sure - if ($?WNG_ERR) unsetenv WNG_ERR - if ($?WNG_LIS) unsetenv WNG_LIS - if ($?WNG_LINK) unsetenv WNG_LINK -# -# Get questions -# - echo "nb$pid$dep.log" >>! $WNG/../nb$pid$dep.log # start log - echo "Running NBUILD.SUN for $WNG_SITE($WNG_TYPE)" \ - | tee -a $WNG/../nb$pid$dep.log - echo "on `hostname` at `date`" | tee -a $WNG/../nb$pid$dep.log - echo " " | tee -a $WNG/../nb$pid$dep.log - set dogdef - if (-e wng.def) then - echo -n ".def files seem to exist. Get them anyway? (y|n) [y]: " \ - | tee -a $WNG/../nb$pid$dep.log - set l0=($<) - echo "$l0" >>! $WNG/../nb$pid$dep.log - if ("$l0" =~ [nN]*) unset dogdef # skip get - endif - set domdef - if (-e WNG_DEF) then - echo -n ".def files seem compiled. Compile them anyway? (y|n) [y]: " \ - | tee -a $WNG/../nb$pid$dep.log - set l0=($<) - echo "$l0" >>! $WNG/../nb$pid$dep.log - if ("$l0" =~ [nN]*) unset domdef # skip compile - endif - set doggrp - if (-e wng.grp) then - echo -n ".grp files seem to exist. Get them anyway? (y|n) [y]: " \ - | tee -a $WNG/../nb$pid$dep.log - set l0=($<) - echo "$l0" >>! $WNG/../nb$pid$dep.log - if ("$l0" =~ [nN]*) unset doggrp # skip compile - endif - set l0=("`ar t $WNG_OLBEXE/wng/wnlib.olb wngang.o`") - if ("$l0" == "wngang.o") then - echo -n "Some compilation at least done. Compile all? (y|n) [n]: " \ - | tee -a $WNG/../nb$pid$dep.log - set l0=($<) - echo "$l0" >>! $WNG/../nb$pid$dep.log - if ("$l0" =~ [yY]*) set docomp # do compile - else - set docomp - endif - set dolink - echo -n "Link all programs? (y|n) [y]: " \ - | tee -a $WNG/../nb$pid$dep.log - set l0=($<) - echo "$l0" >>! $WNG/../nb$pid$dep.log - if ("$l0" =~ [nN]*) unset dolink # skip link - echo "You could clean up all unwanted files." \ - | tee -a $WNG/../nb$pid$dep.log - echo "(0)For operation the following files should remain:" \ - | tee -a $WNG/../nb$pid$dep.log - echo ' $EXEDWARF_UNIX/*.exe and *.ppd; $WNG/../*/*.sun' \ - | tee -a $WNG/../nb$pid$dep.log - echo "(1)For easy updating the following files should also remain:" \ - | tee -a $WNG/../nb$pid$dep.log - echo ' $WNG_OLB/*/*.olb $WNG/../*/*.tlb and *.def and *.inc' \ - | tee -a $WNG/../nb$pid$dep.log - echo ' and *DEF and *.grp;' \ - | tee -a $WNG/../nb$pid$dep.log - echo ' upper case in $WNG/../dwarf (except *.LOG)' \ - | tee -a $WNG/../nb$pid$dep.log - echo "(2)To check programs all source files could remain" \ - | tee -a $WNG/../nb$pid$dep.log - echo "(3)To check all listing files can remain" \ - | tee -a $WNG/../nb$pid$dep.log - echo "I can remove for you including and above a specified level:" \ - | tee -a $WNG/../nb$pid$dep.log - echo "(probably better to run with 4 first time, and rerun" \ - | tee -a $WNG/../nb$pid$dep.log - echo " nbuild later with all questions n and the proper level)" \ - | tee -a $WNG/../nb$pid$dep.log - echo -n "Clean disk level (1|2|3|4) [3]: " \ - | tee -a $WNG/../nb$pid$dep.log - set l0=($<) - if ("$l0" !~ [1234]) set l0=3 - echo "$l0" >>! $WNG/../nb$pid$dep.log - set doclup=$l0 -# -# Get and make .def .sun -# -GDEF: - cd $WNG # base directory - if ($?dogdef) then - echo "Getting .def ..." | tee -a $WNG/../nb$pid$dep.log - foreach i ($blddir) # get .def - cd ../$i # correct directory - nget -a '.*def' '.*pef' '.*dsf' '.*inc' '.*ssc' '.*sun' \ - >>&! $WNG/../nb$pid$dep.log - end - endif -MDEF: - cd $WNG # base directory - if ($?domdef) then - echo "Compiling .def ..." | tee -a $WNG/../nb$pid$dep.log - foreach i ($blddir) # compile .def - cd ../$i # correct directory - ncomp -u *.def *.inc *.pef *.dsf *.ssc *.sun \ - >>&! $WNG/../nb$pid$dep.log - end - endif -# -# Get groups -# -GGRP: - cd $WNG # base directory - if ($?doggrp) then - echo "Getting .grp ..." | tee -a $WNG/../nb$pid$dep.log - foreach i ($blddir) # get .grp - cd ../$i # correct directory - nget -nza '.*grp' >>&! $WNG/../nb$pid$dep.log # get .grp - end - endif -# -# Compile all -# -COMP: - cd $WNG # base directory - if ($?docomp) then - echo "Compiling Newstar system ..." | tee -a $WNG/../nb$pid$dep.log - foreach i ($blddir) # compile - cd ../$i # correct directory - ncomp *.grp >>&! $WNG/../nb$pid$dep.log # compile - end - endif -# -# Link all -# -LINK: - cd $WNG # base directory - if ($?dolink) then - echo "Linking Newstar system ..." | tee -a $WNG/../nb$pid$dep.log - foreach i ($blddir) # link - cd ../$i # correct directory - nlink -u *.grp >>&! $WNG/../nb$pid$dep.log # link all programs - end - foreach i ($blddir) # compile .pin - cd ../$i # correct directory - ncomp -u *.pin >>&! $WNG/../nb$pid$dep.log # make ppd - end - foreach i ($blddir) # compile .*sc - cd ../$i # correct directory - ncomp -u *.dsc >>&! $WNG/../nb$pid$dep.log # compile .dsc - ncomp -u *.ssc >>&! $WNG/../nb$pid$dep.log # compile .ssc - end - endif -# -# Cleanup -# -CLUP: - cd $WNG - if ($doclup < 4) then - echo "Removing listing files ..." | tee -a $WNG/../nb$pid$dep.log - foreach i ($blddir) # remove listings - cd ../$i - set nonomatch - 'rm' *.lis >& /dev/null - 'rm' *.err >& /dev/null - 'rm' *.old >& /dev/null - 'rm' *.new >& /dev/null - 'rm' *.log >& /dev/null - 'rm' *.LOG >& /dev/null - 'rm' *.tmp >& /dev/null - 'rm' *~ >& /dev/null - 'rm' *.o >& /dev/null - 'rm' $WNG_EXE/$i/*.map >& /dev/null - unset nonomatch - end - endif - if ($doclup < 3) then - echo "Removing source files ..." | tee -a $WNG/../nb$pid$dep.log - foreach i ($blddir) - cd ../$i - set nonomatch - 'rm' *.f?? >& /dev/null - 'rm' *.c[a-np-z]? >& /dev/null - 'rm' *.m?? >& /dev/null - 'rm' *.pin >& /dev/null - unset nonomatch - end - endif - if ($doclup < 2) then - echo "Removing object/include files ..." \ - | tee -a $WNG/../nb$pid$dep.log - foreach i ($blddir) - cd ../$i - 'rm' $WNG_OLB/$i/*.olb >& /dev/null - set nonomatch - 'rm' *.def >& /dev/null - 'rm' *.inc >& /dev/null - 'rm' *.dsc >& /dev/null - 'rm' *DEF >& /dev/null - 'rm' *.ssc >& /dev/null - 'rm' [A-Z0-9]* >& /dev/null - unset nonomatch - end - endif -# -# Ready -# -END: - echo " " | tee -a $WNG/../nb$pid$dep.log - echo "Newstar built. Try if everything works by typing:" \ - | tee -a $WNG/../nb$pid$dep.log - echo " indwarf (unless in .cshrc)" \ - | tee -a $WNG/../nb$pid$dep.log - echo " dws ngen/nomenu" | tee -a $WNG/../nb$pid$dep.log - echo " log=y" | tee -a $WNG/../nb$pid$dep.log - echo " (empty line)" \ - | tee -a $WNG/../nb$pid$dep.log - echo "and:" | tee -a $WNG/../nb$pid$dep.log - echo ' pvax $WNG'"/../nb$pid$dep.log" \ - | tee -a $WNG/../nb$pid$dep.log - echo 'If problem exist, rerun $WNG'"/nbuild.sun with all questions y" \ - | tee -a $WNG/../nb$pid$dep.log - echo "To make a minimum backup to be able to rebuild the system," \ - | tee -a $WNG/../nb$pid$dep.log - echo 'run $WNG'"/ntarz.sun" | tee -a $WNG/../nb$pid$dep.log - echo "Good luck" | tee -a $WNG/../nb$pid$dep.log - echo " " | tee -a $WNG/../nb$pid$dep.log -# -# EXIT -# -exex: - exit diff --git a/src/wng/nxpin.com b/src/wng/nxpin.com deleted file mode 100755 index 97fd4436b01ffafaabc0382b8ecf69892053503a..0000000000000000000000000000000000000000 --- a/src/wng/nxpin.com +++ /dev/null @@ -1,136 +0,0 @@ -$!# nxpin.ssc -$!# WNB 921210 -$!# -$!# Revisions: -$!# WNB 921230 Creation message -$!# WNB 921230 Make SSC -$!# WNB 930105 HP error embedded newline -$!# WNB 930429 Make awk for Unix and VMS -$!# HjV 930518 Typo -$!# WNB 930615 Delete .TMP propoerly -$!# -$!# Convert a .psc (on standard in) to a pin file (on standard out) -$!# by expanding includes. End given by single line "endend"; -$!# error messages given in efnm. -$!# Use as: -$!# csh -f $WNG/nxpin.sun efnm (Unix) -$!# @WNG:NXPIN psc pin error (VAX) -$!# -$!# Uses environment variables: -$!# WNG where to find wng-type sources -$!# -$!# Intro -$!# -$ ON ERROR THEN GOTO EXEX -$ PID=F$EXTRACT(4,4,F$GETJPI("","PID")) !FOR FILES -$ DEP=F$ENVIRONMENT("DEPTH") -$ IF F$SEARCH("WNG:GAWK.EXE") .EQS. "" !NO AWK PRESENT -$ THEN -$ NAWK="Y" !NO AWK -$ ELSE -$ NAWK="$WNG:GAWK" !AWK PRESENT -$ ENDIF -$ CLOSE/ERROR=LA1 NXPI'PID''DEP' !MAKE SURE -$ LA1: CLOSE/ERROR=LA2 NXPE'PID''DEP' -$ LA2: -$ S1="!+ Created from ''P1' on ''F$TIME()' "+ - - "at ''F$GETSYI("NODENAME")'" -$ S2="!-" -$!# -$!# Open files -$!# -$ IF NAWK -$ THEN -$ OPEN/ERROR=ERR/READ NXPI'PID''DEP' 'P1' -$ WRITE 'P2' "''S1'" -$ WRITE 'P2' "''S2'" -$ ENDIF -$!# -$!# Read input -$!# -$ IF NAWK !NO AWK -$ THEN -$ LP1: -$ READ/ERROR=ERR/END=LP2 NXPI'PID''DEP' L0 !READ LINE -$ L2=F$EDIT(L0,"COLLAPSE,UNCOMMENT,UPCASE") !FOR CHECK -$ IF F$EXTRACT(0,8,L2) .EQS. "INCLUDE=" !DO INCLUDE -$ THEN -$ L1=F$EXTRACT(8,-1,L2) !FILE NAME -$ IF F$SEARCH("''L1'") .EQS. "" !NO FILE -$ THEN -$ IF F$SEARCH("''P3'") .EQS. "" -$ THEN -$ OPEN/ERROR=ERR/WRITE NXPE'PID''DEP' 'P3' !SET ERROR -$ ELSE -$ OPEN/ERROR=ERR/APPEND NXPE'PID''DEP' 'P3' !SET ERROR -$ ENDIF -$ WRITE NXPE'PID''DEP' "Cannot find include file ''L1'" -$ CLOSE/ERROR=ERR NXPE'PID''DEP' -$ GOTO EXEX -$ ENDIF -$ WRITE 'P2' "!!" -$ WRITE 'P2' "!! Include ''L1'" -$ WRITE 'P2' "!!" -$ @WNG:NXPIN 'L1' 'P2' 'P3' -$ WRITE 'P2' "!!" -$ WRITE 'P2' "!! End include ''L1'" -$ WRITE 'P2' "!!" -$ ELSE -$ WRITE 'P2' L0 !COPY -$ ENDIF -$ GOTO LP1 !MORE LINE -$ ELSE !AWK PRESENT -$ IF F$SEARCH("NAWK''PID'''DEP'.TMP") .NES. "" THEN - - DELETE NAWK'PID''DEP'.TMP;* -$ OPEN/ERROR=ERR/WRITE NXPI'PID''DEP' NAWK'PID''DEP'.TMP !CREATE AWK FILE -$ WRITE NXPI'PID''DEP' - - "function tinc() {" -$ WRITE NXPI'PID''DEP' - - "if ($0 ~ /^[ ]*[Ii][Nn][Cc][Ll][Uu][Dd][Ee][ ]*=/) {" -$ WRITE NXPI'PID''DEP' - - "split($2,nam,"" ""); cnt += 1; ofl[cnt] = cfl; cfl = nam[1];" -$ WRITE NXPI'PID''DEP' - - "print ""!!""; print ""!! Include "",cfl; print ""!!"";" -$ WRITE NXPI'PID''DEP' - - "err = getline <cfl; if (err != 1) {" -$ WRITE NXPI'PID''DEP' - - "print ""Cannot open "",cfl >>""''P3'""; exit}" -$ WRITE NXPI'PID''DEP' - - "do {tinc()} while (getline <cfl == 1) ;" -$ WRITE NXPI'PID''DEP' - - "print ""!!""; print ""!! End include "",cfl; print ""!!"";" -$ WRITE NXPI'PID''DEP' - - "close(cfl); cfl = ofl[cnt]; cnt -= 1} else {" -$ WRITE NXPI'PID''DEP' - - "if ($0 != ""endend"") {print}}}" -$ WRITE NXPI'PID''DEP' - - "BEGIN {FS = ""[=!]""; cnt = 0; cfl = FILENAME;" -$ WRITE NXPI'PID''DEP' - - "print ""''S1'""; print ""''S2'"";}" -$ WRITE NXPI'PID''DEP' - - "{tinc()}" -$ CLOSE NXPI'PID''DEP' -$ NAWK/INPUT=NAWK'PID''DEP'.TMP/OUTPUT='P2' 'P1' !DO INCLUSION -$ ENDIF -$ ! -$ LP2: CLOSE/ERROR=EXEX NXPI'PID''DEP' !CLOSE INPUT -$ GOTO EXEX -$!# -$!# EXIT -$!# -$ ERR: -$ IF F$SEARCH("''P3'") .EQS. "" -$ THEN -$ OPEN/ERROR=ERR/WRITE NXPE'PID''DEP' 'P3' !SET ERROR -$ ELSE -$ OPEN/ERROR=ERR/APPEND NXPE'PID''DEP' 'P3' !SET ERROR -$ ENDIF -$ WRITE NXPE'PID''DEP' "Unexpected I/O error" -$ GOTO EXEX -$ EXEX: -$ CLOSE/ERROR=EX1 NXPI'PID''DEP' !MAKE SURE -$ EX1: CLOSE/ERROR=EX2 NXPE'PID''DEP' -$ EX2: -$ IF F$SEARCH("NAWK''PID'''DEP'.TMP") .NES. "" THEN - - DELETE NAWK'PID''DEP'.TMP;* -$ EXIT diff --git a/src/wng/nxpin.ssc b/src/wng/nxpin.ssc deleted file mode 100644 index d62ce441e8c09f76d923cf7f9d1c57c6db9f2218..0000000000000000000000000000000000000000 --- a/src/wng/nxpin.ssc +++ /dev/null @@ -1,214 +0,0 @@ -# nxpin.ssc -# WNB 921210 -# -# Revisions: -# WNB 921230 Creation message -# WNB 921230 Make SSC -# WNB 930105 HP error embedded newline -# WNB 930429 Make awk for Unix and VMS -# HjV 930518 Typo -# WNB 930615 Delete .TMP propoerly -# -# Convert a .psc (on standard in) to a pin file (on standard out) -# by expanding includes. End given by single line "endend"; -# error messages given in efnm. -# Use as: -# csh -f $WNG/nxpin.sun efnm (Unix) -# @WNG:NXPIN psc pin error (VAX) -# -# Uses environment variables: -# WNG where to find wng-type sources -# -# Intro -# -#ifdef wn_vax__ -$ ON ERROR THEN GOTO EXEX -$ PID=F$EXTRACT(4,4,F$GETJPI("","PID")) !FOR FILES -$ DEP=F$ENVIRONMENT("DEPTH") -$ IF F$SEARCH("WNG:GAWK.EXE") .EQS. "" !NO AWK PRESENT -$ THEN -$ NAWK="Y" !NO AWK -$ ELSE -$ NAWK="$WNG:GAWK" !AWK PRESENT -$ ENDIF -$ CLOSE/ERROR=LA1 NXPI'PID''DEP' !MAKE SURE -$ LA1: CLOSE/ERROR=LA2 NXPE'PID''DEP' -$ LA2: -$ S1="!+ Created from ''P1' on ''F$TIME()' "+ - - "at ''F$GETSYI("NODENAME")'" -$ S2="!-" -#else - onintr exex # finish neatly - if ($?echo) unset echo # no verify - if ($?verbose) unset verbose # no verbose - if ($?nawk) unset nawk # no nawk - if (-x /usr/bin/nawk) set nawk="/usr/bin/nawk" - set c_date=(`date`) # date - set pid=$$ - set lfile=$1:r # input file name - set lfile=$lfile:t - set tval="[Ii][Nn][Cc][Ll][Uu][Dd][Ee]=*" # for check - set tval1="*[Ii][Nn][Cc][Ll][Uu][Dd][Ee]*" - set txtb1='BEGIN {print "\!\!"; print "\!\! Include ' # text - set txtb2='"; print "\!\!"}' - set txte1='END {print "\!\!"; print "\!\! End include ' - set txte2='"; print "\!\!"; print "endend"}' - set s1=\!"+ Created from ${lfile}.psc on $c_date at `hostname`" - set s2=\!"-" - if (! $?nawk) then - echo "$s1" # intro - echo "$s2" - endif -#endif -# -# Open files -# -#ifdef wn_vax__ -$ IF NAWK -$ THEN -$ OPEN/ERROR=ERR/READ NXPI'PID''DEP' 'P1' -$ WRITE 'P2' "''S1'" -$ WRITE 'P2' "''S2'" -$ ENDIF -#endif -# -# Read input -# -#ifdef wn_vax__ -$ IF NAWK !NO AWK -$ THEN -$ LP1: -$ READ/ERROR=ERR/END=LP2 NXPI'PID''DEP' L0 !READ LINE -$ L2=F$EDIT(L0,"COLLAPSE,UNCOMMENT,UPCASE") !FOR CHECK -$ IF F$EXTRACT(0,8,L2) .EQS. "INCLUDE=" !DO INCLUDE -$ THEN -$ L1=F$EXTRACT(8,-1,L2) !FILE NAME -$ IF F$SEARCH("''L1'") .EQS. "" !NO FILE -$ THEN -$ IF F$SEARCH("''P3'") .EQS. "" -$ THEN -$ OPEN/ERROR=ERR/WRITE NXPE'PID''DEP' 'P3' !SET ERROR -$ ELSE -$ OPEN/ERROR=ERR/APPEND NXPE'PID''DEP' 'P3' !SET ERROR -$ ENDIF -$ WRITE NXPE'PID''DEP' "Cannot find include file ''L1'" -$ CLOSE/ERROR=ERR NXPE'PID''DEP' -$ GOTO EXEX -$ ENDIF -$ WRITE 'P2' "!!" -$ WRITE 'P2' "!! Include ''L1'" -$ WRITE 'P2' "!!" -$ @WNG:NXPIN 'L1' 'P2' 'P3' -$ WRITE 'P2' "!!" -$ WRITE 'P2' "!! End include ''L1'" -$ WRITE 'P2' "!!" -$ ELSE -$ WRITE 'P2' L0 !COPY -$ ENDIF -$ GOTO LP1 !MORE LINE -$ ELSE !AWK PRESENT -$ IF F$SEARCH("NAWK''PID'''DEP'.TMP") .NES. "" THEN - - DELETE NAWK'PID''DEP'.TMP;* -$ OPEN/ERROR=ERR/WRITE NXPI'PID''DEP' NAWK'PID''DEP'.TMP !CREATE AWK FILE -$ WRITE NXPI'PID''DEP' - - "function tinc() {" -$ WRITE NXPI'PID''DEP' - - "if ($0 ~ /^[ ]*[Ii][Nn][Cc][Ll][Uu][Dd][Ee][ ]*=/) {" -$ WRITE NXPI'PID''DEP' - - "split($2,nam,"" ""); cnt += 1; ofl[cnt] = cfl; cfl = nam[1];" -$ WRITE NXPI'PID''DEP' - - "print ""!!""; print ""!! Include "",cfl; print ""!!"";" -$ WRITE NXPI'PID''DEP' - - "err = getline <cfl; if (err != 1) {" -$ WRITE NXPI'PID''DEP' - - "print ""Cannot open "",cfl >>""''P3'""; exit}" -$ WRITE NXPI'PID''DEP' - - "do {tinc()} while (getline <cfl == 1) ;" -$ WRITE NXPI'PID''DEP' - - "print ""!!""; print ""!! End include "",cfl; print ""!!"";" -$ WRITE NXPI'PID''DEP' - - "close(cfl); cfl = ofl[cnt]; cnt -= 1} else {" -$ WRITE NXPI'PID''DEP' - - "if ($0 != ""endend"") {print}}}" -$ WRITE NXPI'PID''DEP' - - "BEGIN {FS = ""[=!]""; cnt = 0; cfl = FILENAME;" -$ WRITE NXPI'PID''DEP' - - "print ""''S1'""; print ""''S2'"";}" -$ WRITE NXPI'PID''DEP' - - "{tinc()}" -$ CLOSE NXPI'PID''DEP' -$ NAWK/INPUT=NAWK'PID''DEP'.TMP/OUTPUT='P2' 'P1' !DO INCLUSION -$ ENDIF -$ ! -$ LP2: CLOSE/ERROR=EXEX NXPI'PID''DEP' !CLOSE INPUT -$ GOTO EXEX -#else - if (! $?nawk) then # normal -LP1: - set l0="$<" # read line - if ("$l0" == "endend") goto exex # ready - if ("$l0" =~ $tval1) then # could be include - set l2=`echo "$l0" | tr -d " "` - if ("$l2" =~ $tval) then # include - set l1=`echo "$l0" | awk -F= '{print $2}' | awk -F! '{print $1}'` - if (-e $l1) then - set txtb="$txtb1$l1$txtb2" - set txte="$txte1$l1$txte2" - awk "$txtb"' {print $0} '"$txte" $l1 \ - | csh -f $WNG/nxpin.sun $1 - else - echo "Cannot open include file $l1" >>! $1 - goto exex - endif - goto LP1 # continue - endif - endif - echo "$l0" # copy line - goto LP1 # more lines - else # do nawk - cat >! nawk${lfile}${pid}.tmp << EOF # create nawk file -function tinc() { - if (\$0 ~ /^[ ]*[Ii][Nn][Cc][Ll][Uu][Dd][Ee][ ]*=/) { - split(\$2,nam," "); cnt += 1; ofl[cnt] = cfl; cfl = nam[1]; - print "!!"; print "!! Include ",cfl; print "!!"; - err = getline <cfl; if (err != 1) { - print "Cannot open ",cfl >>"$1"; exit} - do {tinc()} while (getline <cfl == 1) ; - print "!!"; print "!! End include ",cfl; print "!!"; - close(cfl); cfl = ofl[cnt]; cnt -= 1} else { - if (\$0 != "endend") {print}}} -BEGIN {FS = "[=!]"; cnt = 0; cfl = FILENAME; - print "$s1"; print "$s2";} -{tinc()} -EOF - nawk -f nawk${lfile}${pid}.tmp # do inclusion - endif - goto exex # ready -#endif -# -# EXIT -# -#ifdef wn_vax__ -$ ERR: -$ IF F$SEARCH("''P3'") .EQS. "" -$ THEN -$ OPEN/ERROR=ERR/WRITE NXPE'PID''DEP' 'P3' !SET ERROR -$ ELSE -$ OPEN/ERROR=ERR/APPEND NXPE'PID''DEP' 'P3' !SET ERROR -$ ENDIF -$ WRITE NXPE'PID''DEP' "Unexpected I/O error" -$ GOTO EXEX -$ EXEX: -$ CLOSE/ERROR=EX1 NXPI'PID''DEP' !MAKE SURE -$ EX1: CLOSE/ERROR=EX2 NXPE'PID''DEP' -$ EX2: -$ IF F$SEARCH("NAWK''PID'''DEP'.TMP") .NES. "" THEN - - DELETE NAWK'PID''DEP'.TMP;* -$ EXIT -#else -exex: - if (-e nawk${lfile}${pid}.tmp) then - 'rm' nawk${lfile}${pid}.tmp >& /dev/null - endif - exit -#endif diff --git a/src/wng/nxpin.sun b/src/wng/nxpin.sun deleted file mode 100755 index f96f2121e926102dbb19f3e33caa83ca9549d468..0000000000000000000000000000000000000000 --- a/src/wng/nxpin.sun +++ /dev/null @@ -1,99 +0,0 @@ -# nxpin.ssc -# WNB 921210 -# -# Revisions: -# WNB 921230 Creation message -# WNB 921230 Make SSC -# WNB 930105 HP error embedded newline -# WNB 930429 Make awk for Unix and VMS -# HjV 930518 Typo -# WNB 930615 Delete .TMP propoerly -# -# Convert a .psc (on standard in) to a pin file (on standard out) -# by expanding includes. End given by single line "endend"; -# error messages given in efnm. -# Use as: -# csh -f $WNG/nxpin.sun efnm (Unix) -# @WNG:NXPIN psc pin error (VAX) -# -# Uses environment variables: -# WNG where to find wng-type sources -# -# Intro -# - onintr exex # finish neatly - if ($?echo) unset echo # no verify - if ($?verbose) unset verbose # no verbose - if ($?nawk) unset nawk # no nawk - if (-x /usr/bin/nawk) set nawk="/usr/bin/nawk" - set c_date=(`date`) # date - set pid=$$ - set lfile=$1:r # input file name - set lfile=$lfile:t - set tval="[Ii][Nn][Cc][Ll][Uu][Dd][Ee]=*" # for check - set tval1="*[Ii][Nn][Cc][Ll][Uu][Dd][Ee]*" - set txtb1='BEGIN {print "\!\!"; print "\!\! Include ' # text - set txtb2='"; print "\!\!"}' - set txte1='END {print "\!\!"; print "\!\! End include ' - set txte2='"; print "\!\!"; print "endend"}' - set s1=\!"+ Created from ${lfile}.psc on $c_date at `hostname`" - set s2=\!"-" - if (! $?nawk) then - echo "$s1" # intro - echo "$s2" - endif -# -# Open files -# -# -# Read input -# - if (! $?nawk) then # normal -LP1: - set l0="$<" # read line - if ("$l0" == "endend") goto exex # ready - if ("$l0" =~ $tval1) then # could be include - set l2=`echo "$l0" | tr -d " "` - if ("$l2" =~ $tval) then # include - set l1=`echo "$l0" | awk -F= '{print $2}' | awk -F! '{print $1}'` - if (-e $l1) then - set txtb="$txtb1$l1$txtb2" - set txte="$txte1$l1$txte2" - awk "$txtb"' {print $0} '"$txte" $l1 \ - | csh -f $WNG/nxpin.sun $1 - else - echo "Cannot open include file $l1" >>! $1 - goto exex - endif - goto LP1 # continue - endif - endif - echo "$l0" # copy line - goto LP1 # more lines - else # do nawk - cat >! nawk${lfile}${pid}.tmp << EOF # create nawk file -function tinc() { - if (\$0 ~ /^[ ]*[Ii][Nn][Cc][Ll][Uu][Dd][Ee][ ]*=/) { - split(\$2,nam," "); cnt += 1; ofl[cnt] = cfl; cfl = nam[1]; - print "!!"; print "!! Include ",cfl; print "!!"; - err = getline <cfl; if (err != 1) { - print "Cannot open ",cfl >>"$1"; exit} - do {tinc()} while (getline <cfl == 1) ; - print "!!"; print "!! End include ",cfl; print "!!"; - close(cfl); cfl = ofl[cnt]; cnt -= 1} else { - if (\$0 != "endend") {print}}} -BEGIN {FS = "[=!]"; cnt = 0; cfl = FILENAME; - print "$s1"; print "$s2";} -{tinc()} -EOF - nawk -f nawk${lfile}${pid}.tmp # do inclusion - endif - goto exex # ready -# -# EXIT -# -exex: - if (-e nawk${lfile}${pid}.tmp) then - 'rm' nawk${lfile}${pid}.tmp >& /dev/null - endif - exit diff --git a/src/wng/nxup.com b/src/wng/nxup.com deleted file mode 100755 index 597a30e728d3d63a49b78b3ec0fccdd05a678e0c..0000000000000000000000000000000000000000 --- a/src/wng/nxup.com +++ /dev/null @@ -1,87 +0,0 @@ -$!# nxup.ssc -$!# WNB 920909 -$!# -$!# Revisions: -$!# WNB 921016 end if typo; directory typo -$!# WNB 921113 Preserve space -$!# WNB 921122 Delete .udf -$!# WNB 921208 Check EXEDWARF -$!# WNB 921215 Change to mv -$!# WNB 921224 Make SSC -$!# WNB 930108 Change order strip, mv -$!# HjV 930623 Change cp into mv for saving active executable -$!# -$!# Update in DWARF system. Use as: -$!# $WNG/nxup.sun <type> <dwarflib> <full name> <file name> <logtext> -$!# type=1 (copy full name file) -$!# =2 (put file name in OLB) -$!# =3 put file name.ppd in exedwarf -$!# =4 put file name.exe in exedwarf -$!# =5 (put full name in HLB) -$!# =6 (put file name.udf in exedwarf) -$!# =a* delete i.s.o. put -$!# -$!# Uses environment variable EXEDWARF_UNIX -$!# -$!# Note: Only .exe, .ppd supported -$!# -$ IF F$TRNLNM("EXEDWARF") .EQS. "" THEN GOTO EXIT !CANNOT DO -$ FNM=F$PARSE(P3,,,"NAME","SYNTAX_ONLY") !FILE NAME -$ FTP=F$PARSE(P3,,,"TYPE","SYNTAX_ONLY") !FILE TYPE -$ FMD=F$PARSE(P3,,,"DIRECTORY","SYNTAX_ONLY") !FIRST DIRECTORY -$ FMD=FMD-"["-F$EXTRACT(F$LOCATE(".",FMD),F$LENGTH(FMD),FMD)-"]" -$ FNV=F$EXTRACT(0,F$LOCATE(";",P3),P3) !FULL NAME, NO VERSION -$ IF P1-"A" .NES. P1 THEN GOTO DEL !DELETE -$ ! -$ ! Copy PPD -$ ! -$ PPD: IF P1-"3" .EQS. P1 THEN GOTO EXE !NO PPD -$ COPY 'P3' EXEDWARF:'P4'.PPD -$ PURGE EXEDWARF:'P4'.PPD/KEEP=2 -$ IF F$SEARCH("''P3'") .NES. "" THEN DELETE/NOLOG 'P3';* !SAVE SPACE -$ ! -$ ! Copy EXE -$ ! -$ EXE: IF P1-"4" .EQS. P1 THEN GOTO HLB !NO EXE -$ COPY 'P3' EXEDWARF:'P4'.EXE -$ PURGE EXEDWARF:'P4'.EXE/KEEP=2 -$ IF F$SEARCH("''P3'") .NES. "" THEN DELETE/NOLOG 'P3';* !SAVE SPACE -$ ! -$ ! Copy to .HLB -$ ! -$ HLB: IF P1-"5" .EQS. P1 THEN GOTO EXIT !NO HLB -$ IF F$TRNLNM("LIBDWARF") .EQS. "" THEN GOTO EXIT -$ IF F$SEARCH("LIBDWARF:''P4'.HLB") .EQS. "" THEN - - LIBRARY/CREATE/HELP LIBDWARF:'P4'.HLB !CREATE .HLB LIBRARY -$ LIBRARY/HELP LIBDWARF:'P4'.HLB 'P3' !SET IN HLB -$ ! -$ ! Ready -$ ! -$ EXIT: -$ EXT1: -$ EXIT -$ ! -$ ! Delete -$ ! -$ DEL: -$ ! -$ ! Copy PPD -$ ! -$ DPD: ON ERROR THEN EXIT -$ IF P1-"3" .EQS. P1 THEN GOTO DXE !NO PPD -$ IF F$SEARCH("EXEDWARF:''P4'.PPD") .NES. "" THEN - - DELETE/NOLOG EXEDWARF:'P4'.PPD;* -$ ! -$ ! Copy EXE -$ ! -$ DXE: IF P1-"4" .EQS. P1 THEN GOTO HDB !NO EXE -$ IF F$SEARCH("EXEDWARF:''P4'.EXE") .NES. "" THEN - - DELETE/NOLOG EXEDWARF:'P4'.EXE;* -$ ! -$ ! Copy to .HLB -$ ! -$ HDB: IF P1-"5" .EQS. P1 THEN GOTO EXIT !NO HLB -$ IF F$TRNLNM("LIBDWARF") .EQS. "" THEN GOTO EXIT -$ IF F$SEARCH("LIBDWARF:''P2'.HLB") .NES. "" THEN - - DELETE/NOLOG LIBDWARF:'P2'.HLB;* -$ GOTO EXIT diff --git a/src/wng/nxup.ssc b/src/wng/nxup.ssc deleted file mode 100644 index 641e58353740e2865dfae1524dd50eef9e448c3c..0000000000000000000000000000000000000000 --- a/src/wng/nxup.ssc +++ /dev/null @@ -1,126 +0,0 @@ -# nxup.ssc -# WNB 920909 -# -# Revisions: -# WNB 921016 end if typo; directory typo -# WNB 921113 Preserve space -# WNB 921122 Delete .udf -# WNB 921208 Check EXEDWARF -# WNB 921215 Change to mv -# WNB 921224 Make SSC -# WNB 930108 Change order strip, mv -# HjV 930623 Change cp into mv for saving active executable -# -# Update in DWARF system. Use as: -# $WNG/nxup.sun <type> <dwarflib> <full name> <file name> <logtext> -# type=1 (copy full name file) -# =2 (put file name in OLB) -# =3 put file name.ppd in exedwarf -# =4 put file name.exe in exedwarf -# =5 (put full name in HLB) -# =6 (put file name.udf in exedwarf) -# =a* delete i.s.o. put -# -# Uses environment variable EXEDWARF_UNIX -# -# Note: Only .exe, .ppd supported -# -#ifdef wn_vax__ -$ IF F$TRNLNM("EXEDWARF") .EQS. "" THEN GOTO EXIT !CANNOT DO -$ FNM=F$PARSE(P3,,,"NAME","SYNTAX_ONLY") !FILE NAME -$ FTP=F$PARSE(P3,,,"TYPE","SYNTAX_ONLY") !FILE TYPE -$ FMD=F$PARSE(P3,,,"DIRECTORY","SYNTAX_ONLY") !FIRST DIRECTORY -$ FMD=FMD-"["-F$EXTRACT(F$LOCATE(".",FMD),F$LENGTH(FMD),FMD)-"]" -$ FNV=F$EXTRACT(0,F$LOCATE(";",P3),P3) !FULL NAME, NO VERSION -$ IF P1-"A" .NES. P1 THEN GOTO DEL !DELETE -$ ! -$ ! Copy PPD -$ ! -$ PPD: IF P1-"3" .EQS. P1 THEN GOTO EXE !NO PPD -$ COPY 'P3' EXEDWARF:'P4'.PPD -$ PURGE EXEDWARF:'P4'.PPD/KEEP=2 -$ IF F$SEARCH("''P3'") .NES. "" THEN DELETE/NOLOG 'P3';* !SAVE SPACE -$ ! -$ ! Copy EXE -$ ! -$ EXE: IF P1-"4" .EQS. P1 THEN GOTO HLB !NO EXE -$ COPY 'P3' EXEDWARF:'P4'.EXE -$ PURGE EXEDWARF:'P4'.EXE/KEEP=2 -$ IF F$SEARCH("''P3'") .NES. "" THEN DELETE/NOLOG 'P3';* !SAVE SPACE -$ ! -$ ! Copy to .HLB -$ ! -$ HLB: IF P1-"5" .EQS. P1 THEN GOTO EXIT !NO HLB -$ IF F$TRNLNM("LIBDWARF") .EQS. "" THEN GOTO EXIT -$ IF F$SEARCH("LIBDWARF:''P4'.HLB") .EQS. "" THEN - - LIBRARY/CREATE/HELP LIBDWARF:'P4'.HLB !CREATE .HLB LIBRARY -$ LIBRARY/HELP LIBDWARF:'P4'.HLB 'P3' !SET IN HLB -$ ! -$ ! Ready -$ ! -$ EXIT: -$ EXT1: -$ EXIT -$ ! -$ ! Delete -$ ! -$ DEL: -$ ! -$ ! Copy PPD -$ ! -$ DPD: ON ERROR THEN EXIT -$ IF P1-"3" .EQS. P1 THEN GOTO DXE !NO PPD -$ IF F$SEARCH("EXEDWARF:''P4'.PPD") .NES. "" THEN - - DELETE/NOLOG EXEDWARF:'P4'.PPD;* -$ ! -$ ! Copy EXE -$ ! -$ DXE: IF P1-"4" .EQS. P1 THEN GOTO HDB !NO EXE -$ IF F$SEARCH("EXEDWARF:''P4'.EXE") .NES. "" THEN - - DELETE/NOLOG EXEDWARF:'P4'.EXE;* -$ ! -$ ! Copy to .HLB -$ ! -$ HDB: IF P1-"5" .EQS. P1 THEN GOTO EXIT !NO HLB -$ IF F$TRNLNM("LIBDWARF") .EQS. "" THEN GOTO EXIT -$ IF F$SEARCH("LIBDWARF:''P2'.HLB") .NES. "" THEN - - DELETE/NOLOG LIBDWARF:'P2'.HLB;* -$ GOTO EXIT -#else - if (! $?EXEDWARF_UNIX) goto EXIT # cannot do - if ($argv[1] =~ *a*) then # delete - if ($argv[1] =~ *4*) then # type 4 - if (-e $EXEDWARF_UNIX/$argv[3]:t) then - 'rm' $EXEDWARF_UNIX/$argv[3]:t # delete .exe - endif - endif - if ($argv[1] =~ *3*) then # type 3 - if (-e $EXEDWARF_UNIX/$argv[3]:t) then - 'rm' $EXEDWARF_UNIX/$argv[3]:t # delete .ppd - endif - endif - else # put - if ($argv[1] =~ *4*) then # type 4 - strip $argv[3] # strip debug info - if (-e $EXEDWARF_UNIX/$argv[3]:t.old) then # rid oldest - 'rm' $EXEDWARF_UNIX/$argv[3]:t.old - endif - if ("$argv[3]:h" != "$EXEDWARF_UNIX") then # can do - if (-e $EXEDWARF_UNIX/$argv[3]:t) then # remove old - 'rm' $EXEDWARF_UNIX/$argv[3]:t - endif - if (-e $EXEDWARF_UNIX/$argv[3]:t) then # was busy - 'mv' $EXEDWARF_UNIX/$argv[3]:t $EXEDWARF_UNIX/$argv[3]:t.old - endif - 'mv' $argv[3] $EXEDWARF_UNIX # save .exe - endif - endif - if ($argv[1] =~ *3*) then # type 3 - if ("$argv[3]:h" != "$EXEDWARF_UNIX") then # can do - 'mv' $argv[3] $EXEDWARF_UNIX # save .ppd - endif - endif - endif -EXIT: - exit -#endif diff --git a/src/wng/nxup.sun b/src/wng/nxup.sun deleted file mode 100755 index 4bac5e6b5e0ea808630d95bb647027f928c8ffb0..0000000000000000000000000000000000000000 --- a/src/wng/nxup.sun +++ /dev/null @@ -1,63 +0,0 @@ -# nxup.ssc -# WNB 920909 -# -# Revisions: -# WNB 921016 end if typo; directory typo -# WNB 921113 Preserve space -# WNB 921122 Delete .udf -# WNB 921208 Check EXEDWARF -# WNB 921215 Change to mv -# WNB 921224 Make SSC -# WNB 930108 Change order strip, mv -# HjV 930623 Change cp into mv for saving active executable -# -# Update in DWARF system. Use as: -# $WNG/nxup.sun <type> <dwarflib> <full name> <file name> <logtext> -# type=1 (copy full name file) -# =2 (put file name in OLB) -# =3 put file name.ppd in exedwarf -# =4 put file name.exe in exedwarf -# =5 (put full name in HLB) -# =6 (put file name.udf in exedwarf) -# =a* delete i.s.o. put -# -# Uses environment variable EXEDWARF_UNIX -# -# Note: Only .exe, .ppd supported -# - if (! $?EXEDWARF_UNIX) goto EXIT # cannot do - if ($argv[1] =~ *a*) then # delete - if ($argv[1] =~ *4*) then # type 4 - if (-e $EXEDWARF_UNIX/$argv[3]:t) then - 'rm' $EXEDWARF_UNIX/$argv[3]:t # delete .exe - endif - endif - if ($argv[1] =~ *3*) then # type 3 - if (-e $EXEDWARF_UNIX/$argv[3]:t) then - 'rm' $EXEDWARF_UNIX/$argv[3]:t # delete .ppd - endif - endif - else # put - if ($argv[1] =~ *4*) then # type 4 - strip $argv[3] # strip debug info - if (-e $EXEDWARF_UNIX/$argv[3]:t.old) then # rid oldest - 'rm' $EXEDWARF_UNIX/$argv[3]:t.old - endif - if ("$argv[3]:h" != "$EXEDWARF_UNIX") then # can do - if (-e $EXEDWARF_UNIX/$argv[3]:t) then # remove old - 'rm' $EXEDWARF_UNIX/$argv[3]:t - endif - if (-e $EXEDWARF_UNIX/$argv[3]:t) then # was busy - 'mv' $EXEDWARF_UNIX/$argv[3]:t $EXEDWARF_UNIX/$argv[3]:t.old - endif - 'mv' $argv[3] $EXEDWARF_UNIX # save .exe - endif - endif - if ($argv[1] =~ *3*) then # type 3 - if ("$argv[3]:h" != "$EXEDWARF_UNIX") then # can do - 'mv' $argv[3] $EXEDWARF_UNIX # save .ppd - endif - endif - endif -EXIT: - exit diff --git a/src/wng/sgh.dsc b/src/wng/sgh.dsc deleted file mode 100644 index 9a6b1ef2bf3867d88913b22952360274508193f4..0000000000000000000000000000000000000000 --- a/src/wng/sgh.dsc +++ /dev/null @@ -1,38 +0,0 @@ -!+ SGH.DSC -! WNB 900304 -! -! Revisions: -! -%REVISION=WNB=931215="Add some edit formats" -%REVISION=WNB=930803="Incorporate SGH_EQV.DEF" -%REVISION=WNB=900304="Original version SGH" -! -! Define Sub-Group header -! -%COMMENT="SGH.DSC defines the sub-group header block" -%COMMENT=" " -! -%VERSION=1 !VERSION -%SYSTEM=1 -%USER=WNB -%%DATE -%%NAME -!- -.PARAMETER -.BEGIN=SGH - LINK J(0:1) <XJ,1,,P:SGH> !LINK SETS (MUST BE FIRST) - GROUPN J <,1> !# OF THIS SUB-GROUP - NAME=GROUPN J <,1> - LINKG J(0:1) <XJ,1,,P:SGH> !LINK HEAD NEXT LEVEL - LHD=LINKG J(0:1) <XJ,1,,P:SGH> - LINKGN J <,1> !# IN SUB-LEVEL - LLEN=LINKGN J <,1> - HEADH J <XJ,1,,P:SGH> - PLHD=HEADH J <XJ,1,,P:SGH> !PARENT LISTHEAD PTR - FGROUP J(0:7) <,1> !FULL NAME OF SUBGROUP - FNAME=FGROUP J(0:7) <,1> - DATAP J <XJ,1> !POINTER TO BELONGING SET HEADER - STHP=DATAP J <XJ,1> !PTR TO SECTOR HEADER - - -(16) !RESERVED -.END -!- diff --git a/src/wng/ssh.dsc b/src/wng/ssh.dsc deleted file mode 100644 index a35fb00107d999cf22c5ff31d7b71a952f537334..0000000000000000000000000000000000000000 --- a/src/wng/ssh.dsc +++ /dev/null @@ -1,60 +0,0 @@ -!+ SSH.DSC -! WNB 931015 -! -! Revisions: -! -%REVISION=WNB=931015="Original version" -! -! Define SET description offsets, and a standard set start header -! -%COMMENT="SSH.DSC defines the offsets in SET list defintions" -%COMMENT="and the standard first 16 bytes of any set header" -%COMMENT=" " -! -%VERSION=1 !VERSION -%SYSTEM=1 -%USER=WNB -%%DATE -%%NAME -! -! Define SET array definitiona -! -.PARAMETER - SOF__N J /8/ !# of elements per row - !Use as: (0:SOF__N-1) -! -! Define the offsets in row 0 of the SET search descriptor -! - SOF_0 AF*:(0) /NLINE,LEVEL,CLINE,CSET,CLH/ !The search history line: - !NLINE: # of lines following - !LEVEL: Current level (0,..) - !CLINE: Current search line - !CSET: Current disk set ptr - !CLH: Current link header ptr -! -! Define the position for special indicator on search line -! - SOF AF*:(1) /SPEC/ !SPEC: indicator position # -! -! Define loop parameters -! - SOF_L AF*:(1) /DEF,START,END,INC/ !DEFine as loop - !START value - !END value - !INCrement value -! -! Define special values and masks -! - SOF_M_ALL J /-1/ !* indicator - SOF_M_SPEC J /-2/ !# indicator - SOF_M_HI J /-65536/ !'FFFF0000'X - SOF_M_LO J /65535/ !'0000FFFF'X - SOF_M_LOOP J /536870912/ !'20000000'X loop indicator - SOF_M_SLOOP J /1073741824/ !'40000000'X loop def. line -! -! Define first part of any set header -! -.BEGIN=SSH -%INCLUDE=SSH_DSF -.END -!- diff --git a/src/wng/ssh.dsf b/src/wng/ssh.dsf deleted file mode 100644 index b53ed76b4101824fee1e90728fb5e84bb5b41e0e..0000000000000000000000000000000000000000 --- a/src/wng/ssh.dsf +++ /dev/null @@ -1,17 +0,0 @@ -!+ SSH.DSF -! WNB 931015 -! -! Revisions: -! WNB 931015 Original version -! -! Define standard set header first part -! -! SSH.DSF defines the standard beginning of any standard -! set header (like STH, MPH, NGF) -! Use as: %INCLUDE=SSH_DEF -!- - LINK J(0:1) <XJ,1> !LINK SETS (MUST BE FIRST) - LEN I <,1> !LENGTH HEADER - VER I <,1> !VERSION HEADER - SETN J <,1> !# OF SET -!- diff --git a/src/wng/test.for b/src/wng/test.for deleted file mode 100644 index 6d7be6361a1c45eabe4d3fb95a45209e846d49f1..0000000000000000000000000000000000000000 --- a/src/wng/test.for +++ /dev/null @@ -1,4 +0,0 @@ - program test -C - WRITE(*,'(A,''abc'')') char(9) - end diff --git a/src/wng/twnc.for b/src/wng/twnc.for deleted file mode 100644 index f974d1611b0cf4bda78e75248d6c7e336f17ddb8..0000000000000000000000000000000000000000 --- a/src/wng/twnc.for +++ /dev/null @@ -1,54 +0,0 @@ -C+ TWNC.FOR -C WNB 890308 -C -C Revisions: -C - SUBROUTINE TWNC -C -C Test WNCTXT -C -C Result: -C -C -C Include files: -C - INCLUDE 'WNG_DEF' -C -C Parameters: -C -C -C Arguments: -C -C -C Function references: -C -C -C Data declarations: -C - INTEGER*2 II2,AI2(4) - DATA II2/12/ - DATA AI2/-10,100,1000,-10000/ - INTEGER II4,AI4(4) - DATA II4/12/ - DATA AI4/-10,100,1000,-10000/ - REAL IR4,AR4(4) - DATA IR4/12.12/ - DATA AR4/-10,100,1000.0987,-10000/ - CHARACTER*20 C1,C2 - DATA C1/'ASCII test 1'/ - DATA C2/'ASCII test 2'/ -C- - CALL WNCFHD(F_P,1,'!50CTest of WNC') - CALL WNCTXT(F_TP,'Laten we het proberen') - CALL WNCTXT(F_TP,'I2: !UW !4UW !3$3UW',II2,AI2,AI2) - CALL WNCTXT(F_TP,'C*: !UL: !AS !UL: !AS !UL:',1,C1,2,C2,3) - CALL WNCTXT(F_TP,'I4: !SL !4SL !3$3SL',II4,AI4,AI4) - CALL WNCTXT(F_TP,'I4: !UL !4UL !3$3UL',II4,AI4,AI4) - CALL WNCTXT(F_TP,'I4: !XL !4XL !3$3XL',II4,AI4,AI4) - CALL WNCTXT(F_TP,'I4: !ZL !4ZL !3$3ZL',II4,AI4,AI4) - CALL WNCTXT(F_TP,'R4: !E !4E !6$4E',IR4,AR4,AR4) - CALL WNCTXT(F_TP,'Date, time: !%d, !%t, !%dn, !%tn') - CALL WNCTXT(F_TP,' !%DF, !%TF') -C -C - END diff --git a/src/wng/twnf.for b/src/wng/twnf.for deleted file mode 100644 index 15cc89ae8e100ab5866029968afc91aac9b23a9f..0000000000000000000000000000000000000000 --- a/src/wng/twnf.for +++ /dev/null @@ -1,80 +0,0 @@ -C+ TWNF.FOR -C WNB 890725 -C -C Revisions: -C CMV 940117 Some more testing -C - SUBROUTINE TWNF -C -C Test WNF routines -C -C Result: -C -C -C Include files: -C - INCLUDE 'WNG_DEF' - EXTERNAL WNFMOU,WNFDMO -C -C Parameters: -C -C -C Arguments: -C -C -C Function references: -C - INTEGER WNFEOF !GET EOF -C -C Data declarations: -C - INTEGER MCA,FCA - INTEGER BUF(4) - CHARACTER*16 BUFC - INTEGER RBUF(4) - CHARACTER*16 RBUFC -C -C Equivalences: -C - EQUIVALENCE (BUF,BUFC) - EQUIVALENCE (RBUF,RBUFC) -C -C Commons: -C -C- - DATA BUFC/'ABCDEFGHIJKLMNOP'/ - DATA RBUFC/' '/ - - CALL WNFOP(FCA,'A.TMP','W') - CALL WNFWR(FCA,16,BUF,0) -C TYPE *,'Written: ',BUFC - WRITE (*,'("Written: ",A)') BUFC -C TYPE *,'EOF after write: ',WNFEOF(FCA) - WRITE (*,'("EOF after write: ",I6)') WNFEOF(FCA) - CALL WNFCL(FCA) -C TYPE *,'Open for reading' - WRITE (*,'("Open for reading")') - CALL WNFOP(FCA,'A.TMP','R') -C TYPE *,'EOF after open: ',WNFEOF(FCA) - WRITE (*,'("EOF after open: ",I6)') WNFEOF(FCA) - CALL WNFRD(FCA,16,RBUF,0) -C TYPE *,'Read back: ',RBUFC - WRITE (*,'("Read back: ",A)') RBUFC -C TYPE *,'EOF after read: ',WNFEOF(FCA) - WRITE (*,'("EOF after read: ",I6)') WNFEOF(FCA) - CALL WNFCL(FCA) -C TYPE *,'Open for Update' - WRITE (*,'("Open for Update")') - CALL WNFOP(FCA,'A.TMP','U') -C TYPE *,'EOF after open: ',WNFEOF(FCA) - WRITE (*,'("EOF after open: ",I6)') WNFEOF(FCA) - CALL WNFWR(FCA,16,BUF,0) -C TYPE *,'Read back: ',RBUFC - WRITE (*,'("Read back: ",A)') RBUFC -C TYPE *,'EOF after read: ',WNFEOF(FCA) - WRITE (*,'("EOF after read: ",I6)') WNFEOF(FCA) -C - RETURN -C -C - END diff --git a/src/wng/twng.for b/src/wng/twng.for deleted file mode 100644 index ab536b67669e8ff0bb958763d398c5adadf2bac0..0000000000000000000000000000000000000000 --- a/src/wng/twng.for +++ /dev/null @@ -1,5 +0,0 @@ - SUBROUTINE TWNG - INCLUDE 'WNG_DEF' - CALL WNGDPD(D0) - RETURN - END diff --git a/src/wng/twnm.for b/src/wng/twnm.for deleted file mode 100644 index 51b8c880af65ed5900fc4d7741e75870092b5db4..0000000000000000000000000000000000000000 --- a/src/wng/twnm.for +++ /dev/null @@ -1,380 +0,0 @@ -C+ TWNM.FOR -C WNB 930504 -C -C Revisions: -C WNB 950530 Remove Y test references -C - SUBROUTINE TWNM -C -C Test WNM routines -C -C Result: -C -C -C Include files: -C - INCLUDE 'WNG_DEF' - INCLUDE 'STH_O_DEF' - INCLUDE 'LSQ_O_DEF' -C -C Parameters: -C -C -C Arguments: -C -C -C Function references: -C -C -C Data declarations: -C - INTEGER MAR,N,N1,M,NR - PARAMETER (N=3) - PARAMETER (N1=14) - PARAMETER (M=6) - COMPLEX CMP1 - COMPLEX CD1 - COMPLEX CCE(0:N-1,0:M-1),COB(0:M-1),CSOL(0:2*N1-1),CX(0:N-1) - REAL CV(0:4*N-1,0:4*N-1) - REAL SOL(0:4*N1-1),ME(0:3*N-1) - EQUIVALENCE (SOL,CSOL) - REAL WT(0:M-1),MU - REAL CEQ(0:4*N1*N1-1,0:0) - REAL DAT(0:N1-1,0:N1-1) - REAL AMP(0:N1-1,0:N1-1) - REAL PH(0:N1-1,0:N1-1) - COMPLEX AP(0:N1-1,0:N1-1) - REAL TPOS(0:N1-1) - INTEGER TE1,TW1,TE2,TW2 - REAL W1,W2,W22 - COMPLEX CCF(0:3*N1-1) - DATA DAT/ - 1 0,1169,1181,1090,1207,1165,1178,1072,1165,1123,1215,1139,1108,1097, - 1 4,0,1176,1115,1078,1238,1141,1115,1075,1157,1107,1135,1182,1158, - 1 3,-2,0,1176,1172,1178,1277,1147,1188,1124,1193,1140,1181,1196, - 1 10,1,3,0,1139,1159,1103,1174,1112,1138,1139,1116,1143,1124, - 1 10,5,4,0,0,1178,1151,1058,1199,1118,1201,1098,1064,1111, - 1 8,5,7,0,0,0,1235,1150,1133,1246,1168,1179,1203,1195, - 1 1,5,9,5,1,1,0,1150,1155,1122,1212,1106,1096,1199, - 1 15,7,8,6,6,3,1,0,1128,1115,1117,1108,1142,1122, - 1 16,10,10,4,5,6,0,1,0,1151,1167,1134,1115,1117, - 1 12,9,11,4,2,4,3,-2,-2,0,1114,1133,1205,1133, - 1 13,6,12,6,4,2,4,-1,0,-3,0,1177,1100,1095, - 1 19,8,15,7,8,4,5,4,3,2,6,0,1147,1096, - 1 25,18,21,14,17,13,13,12,12,12,11,10,0,1175, - 1 22,21,20,18,13,17,10,14,10,13,11,7,2,0/ - INTEGER*2 IFRT(0:STHIFR-1) - INTEGER IFRA(0:1,0:STHIFR) - REAL BASEL(0:STHIFR-1) - INTEGER IRED(0:STHIFR-1) - INTEGER NIFR - DATA NIFR/91/ - REAL ANG(0:2,0:STHIFR-1) - DATA ANG/STHIFR*0.,STHIFR*0.,STHIFR*0./ -C - DATA CCE/(1,0),(1,0),(1,0),(1,0),(0,-1),(2,0), - 1 (1,0),(-2,0),(0,2), - 1 (1,0),(1,0),(1,0),(1,0),(0,-1),(2,0), - 1 (1,0),(-2,0),(0,2)/ - DATA COB/(6,4),(3,8),(-15,9),(6,4),(3,8),(-15,9)/ - DATA WT/1,5,2,7,3,4/ - DATA CX/(1,1),(3,-2),(2,5)/ -C- -C -C PREPARE REAL DATA INFO -C - DO I=0,N1-1 - DO J=I,N1-1 - IF (DAT(J,I).GT.0) THEN - AMP(J,I)=LOG(DAT(J,I)) - ELSE - AMP(J,I)=0 - END IF - AMP(I,J)=AMP(J,I) - PH(J,I)=PI2*DAT(I,J)/360. - PH(I,J)=PH(J,I) - AP(J,I)=CMPLX(AMP(J,I),PH(J,I)) - AP(I,J)=AP(J,I) - DAT(J,I)=(DAT(J,I)/1200)**2 - DAT(I,J)=DAT(J,I) - END DO - END DO - DO I=0,9 - TPOS(I)=I*144 - END DO - TPOS(10)=1332 - TPOS(11)=1404 - TPOS(12)=2628 - TPOS(13)=2700 - I0=0 - DO I=0,N1-1 - DO J=I+1,N1-1 - IFRA(0,I0)=J - IFRA(1,I0)=I - IFRT(I0)=256*J+I - BASEL(I0)=TPOS(IFRA(0,I0))-TPOS(IFRA(1,I0)) - I0=I0+1 - END DO - END DO - DO I=0,91-2 - DO J=0,91-2-I - IF (BASEL(J).GT.BASEL(J+1)) THEN - I0=BASEL(J) - BASEL(J)=BASEL(J+1) - BASEL(J+1)=I0 - I0=IFRT(J) - IFRT(J)=IFRT(J+1) - IFRT(J+1)=I0 - END IF - END DO - END DO - CALL NCARRT(NIFR,BASEL,1.,IRED,ANG) -C -C COMPLEX TEST -C -C -C NEW -C - CALL WNCTXT(F_T,'---------- NEW COMPLEX ----------') - CALL WNMLGA(MAR,LSQ_T_COMPLEX,N) - DO I=0,M-1 - CALL WNMLMN(MAR,LSQ_C_COMPLEX,CCE(0,I),WT(I),COB(I)) - END DO - CALL WNCTXT(F_T,'!70$12Q\Known : !16$#D4',6, - 1 A_D(A_J(MAR+LSQ_KNOWN_J))) - CALL WNCTXT(F_T,'!70$12Q\Pre-tri : !16$#D4',21, - 1 A_D(A_J(MAR+LSQ_NORM_J))) - CALL WNMLTN(MAR) - CALL WNCTXT(F_T,'!70$12Q\Post-tri: !16$#D4',21, - 1 A_D(A_J(MAR+LSQ_NORM_J))) - NR=N - CALL WNCTXT(F_T,'N= !UJ Rank= !UJ', - 1 N,NR) - CALL WNMLSN(MAR,CSOL,MU,ME) - CALL WNCTXT(F_T,'!70$12Q\Solution: !16$#EC4',N,CSOL) - CALL WNCTXT(F_T,'!70$12Q\ME: !16$#E4',1,MU) - CALL WNCTXT(F_T,'!70$12Q\SD: !16$#E4',1,ME) - CALL WNCTXT(F_T,'!70$12Q\Should be: !16$#EC4',N,CX) - CALL WNMLCV(MAR,CV) - CALL WNCTXT(F_T,'!70$13Q\Covariance: !16$#E4',4*N*N,CV) - DO I=0,2*N-1 - SOL(I)=0 - DO I1=0,2*N-1 - SOL(I)=SOL(I)+CV(I*(2*N)+I1,0)* - 1 A_D(A_J(MAR+LSQ_KNOWN_J)+I1) - END DO - END DO - CALL WNCTXT(F_T,'!70$13Q\Test sol: !16$#E4',(2*N),SOL) - CALL WNMLFA(MAR) -C -C USE WNMLTR -C - CALL WNCTXT(F_T,'---------- NEW COMPLEX+RANK ----------') - CALL WNMLGA(MAR,LSQ_T_COMPLEX,N,1) - DO I=0,M-1 - CALL WNMLMN(MAR,LSQ_C_COMPLEX,CCE(0,I),WT(I),COB(I)) - END DO - CALL WNMLTR(MAR,NR) - CALL WNCTXT(F_T,'N= !UJ Rank= !UJ', - 1 N,NR) - CALL WNMLSN(MAR,CSOL,MU,ME) - CALL WNCTXT(F_T,'!70$12Q\Solution: !16$#EC4',N,CSOL) - CALL WNCTXT(F_T,'!70$12Q\ME: !16$#E4',1,MU) - CALL WNCTXT(F_T,'!70$12Q\SD: !16$#E4',1,ME) - CALL WNCTXT(F_T,'!70$12Q\Should be: !16$#EC4',N,CX) - CALL WNMLFA(MAR) -C -C MISSING RANK -C - CALL WNCTXT(F_T,'---------- NEW COMPLEX-RANK ----------') - DO I=N-1,M-1,N - COB(I)=COB(I-1) - DO I1=0,N-1 - CCE(I1,I)=CCE(I1,I-1) - END DO - END DO - CALL WNCTXT(F_T,'!70$13Q\Equations: !16$#EC4',N*M,CCE) - CALL WNMLGA(MAR,LSQ_T_COMPLEX,N,1) - DO I=0,M-1 - CALL WNMLMN(MAR,LSQ_C_COMPLEX,CCE(0,I),WT(I),COB(I)) - END DO - CALL WNMLTR(MAR,NR) - CALL WNCTXT(F_T,'N= !UJ Rank= !UJ', - 1 N,NR) - CALL WNMLSN(MAR,CSOL,MU,ME) - CALL WNCTXT(F_T,'!70$13Q\Solution: !16$#EC4',N,CSOL) - CALL WNCTXT(F_T,'!70$12Q\ME: !16$#E4',1,MU) - CALL WNCTXT(F_T,'!70$12Q\SD: !16$#E4',1,ME) - CALL WNCTXT(F_T,'!70$13Q\Should be: !16$#EC4',N,CX) - DO I=0,M-1 - CD1=0 - DO I1=0,N-1 - CD1=CD1+CSOL(I1)*CCE(I1,I) - END DO - CALL WNCTXT(F_T,'LIN= !16$EC4 LCHECK= !16$EC4', - 1 COB(I),CD1) - END DO - CALL WNMLGC(MAR,I2,CEQ) - CALL WNCTXT(F_T,'!70$13Q\Constraint: !16$#EC4',N*I2,CEQ) - CD1=0 - DO I3=0,I2-1 - DO I=0,N-1 - CD1=CD1+REAL(CSOL(I))*CEQ(2*I,0)+ - 1 IMAG(CSOL(I))*CEQ(2*I+1,0) - END DO - CALL WNCTXT(F_T,'!70$13Q\Gives: !16$EC4',CD1) - END DO -C -C INVERT -C - CALL WNMLCV(MAR,CV) - CALL WNCTXT(F_T,'!70$13Q\Covariance: !16$#E4',4*N*N,CV) - DO I=0,2*N-1 - SOL(I)=0 - DO I1=0,2*N-1 - SOL(I)=SOL(I)+CV(I*(2*N)+I1,0)* - 1 A_D(A_J(MAR+LSQ_KNOWN_J)+I1) - END DO - END DO - CALL WNCTXT(F_T,'!70$13Q\Knowns: !16$#D4',2*N, - 1 A_D(A_J(MAR+LSQ_KNOWN_J))) - CALL WNCTXT(F_T,'!70$13Q\Test sol: !16$#E4',(2*N),SOL) - CALL WNMLFA(MAR) -C -C ADD CONSTRAINTS -C - CALL WNCTXT(F_T,'---------- COMPLEX+CONSTRAINTS ----------') - CALL WNMLGA(MAR,LSQ_T_COMPLEX+LSQ_T_CONSTRAINT,N,1,I2) - DO I=0,M-1 - CALL WNMLMN(MAR,LSQ_C_COMPLEX,CCE(0,I),WT(I),COB(I)) - END DO - CALL WNMLMC(MAR,LSQ_C_REAL,CEQ) !FILL CONSTRAINT - CALL WNCTXT(F_T,'!70$12Q\Pre-tri : !16$#D4',36, - 1 A_D(A_J(MAR+LSQ_NORM_J))) - CALL WNMLTN(MAR,NR) - CALL WNCTXT(F_T,'!70$12Q\Post-tri : !16$#D4',36, - 1 A_D(A_J(MAR+LSQ_NORM_J))) - CALL WNCTXT(F_T,'N= !UJ Rank= !UJ', - 1 N,NR) - CALL WNMLSN(MAR,CSOL,MU,ME) - CALL WNCTXT(F_T,'!70$13Q\Solution: !16$#EC4',N,CSOL) - CALL WNCTXT(F_T,'!70$12Q\ME: !16$#E4',1,MU) - CALL WNCTXT(F_T,'!70$12Q\SD: !16$#E4',1,ME) - CALL WNCTXT(F_T,'!70$13Q\Should be: !16$#EC4',N,CX) - DO I=0,M-1 - CD1=0 - DO I1=0,N-1 - CD1=CD1+CSOL(I1)*CCE(I1,I) - END DO - CALL WNCTXT(F_T,'LIN= !16$EC4 LCHECK= !16$EC4', - 1 COB(I),CD1) - END DO - CD1=0 - DO I3=0,I2-1 - DO I=0,N-1 - CD1=CD1+REAL(CSOL(I))*CEQ(2*I,0)+ - 1 IMAG(CSOL(I))*CEQ(2*I+1,0) - END DO - CALL WNCTXT(F_T,'!70$13Q\Gives: !16$EC4',CD1) - END DO - CALL WNMLCV(MAR,CV) - CALL WNCTXT(F_T,'!70$13Q\Covariance: !16$#E4',(2*N)*(2*N),CV) - DO I=0,2*N-1 - SOL(I)=0 - DO I1=0,2*N-1 - SOL(I)=SOL(I)+CV(I*(2*N)+I1,0)* - 1 A_D(A_J(MAR+LSQ_KNOWN_J)+I1) - END DO - END DO - CALL WNCTXT(F_T,'!70$13Q\Test sol: !16$#E4',(2*N),SOL) - CALL WNMLSN(MAR,CSOL,MU,ME) - CALL WNCTXT(F_T,'!70$13Q\Sol again: !16$#EC4',N,CSOL) - CALL WNCTXT(F_T,'!70$12Q\ME: !16$#E4',1,MU) - CALL WNCTXT(F_T,'!70$12Q\SD: !16$#E4',1,ME) - CALL WNMLFA(MAR) -C -C REAL DATA -C - CALL WNCTXT(F_T,'---------- NEW REAL DATA COMPLEX ----------') - CALL WNMLGA(MAR,LSQ_T_COMPLEX,N1,1) - I1=0 - DO I=0,NIFR-1 - IF (IRED(I).GT.0) THEN - IF (IRED(I).NE.I1) THEN - I1=IRED(I) - I4=I - TE1=IFRT(I)/256 - TW1=MOD(IFRT(I),256) - W2=DAT(TE1,TW1) - ELSE - TE2=IFRT(I)/256 - TW2=MOD(IFRT(I),256) - W22=DAT(TE2,TW2) - DO I2=0,N1-1 - CCF(I2)=0 - END DO - CCF(TW1)=CCF(TW1)+CMPLX(1,1) !SET COEFFICIENTS - CCF(TE1)=CCF(TE1)+CMPLX(1,-1) - CCF(TW2)=CCF(TW2)+CMPLX(-1,-1) - CCF(TE2)=CCF(TE2)+CMPLX(-1,+1) - CALL WNMLMN(MAR,LSQ_C_REAL,CCF,W2*W22/(W2+W22), - 1 CMPLX(AMP(TE1,TW1)-AMP(TW2,TE2), - 1 PH(TE1,TW1)-PH(TW2,TE2))) - END IF - END IF - END DO - CALL WNMLTR(MAR,NR) - CALL WNMLSN(MAR,SOL,MU,ME) - CALL WNCTXT(F_T,'!70$13Q\Solution: !16$#E4',2*N1,SOL) - CALL WNCTXT(F_T,'!70$13Q\MU: !16$E4',MU) - CALL WNCTXT(F_T,'!70$13Q\ME: !16$E4',ME) - CALL WNMLGC(MAR,I2,CEQ) - CALL WNCTXT(F_T,'!70$13Q\N,NR,MU: !UJ, !UJ, !E',N1,I2,MU) - CALL WNCTXT(F_T,'!70$13Q\Constraints:!16$#E4',2*I2*N1,CEQ) - CALL WNMLFA(MAR) -C -C NON-LINEAR -C - CALL WNCTXT(F_T,'---------- NEW REAL DATA NONLIN ----------') - CALL WNMLGA(MAR,LSQ_T_COMPLEX,N1,1) - DO I3=0,2 - I1=0 - DO I=0,NIFR-1 - IF (IRED(I).GT.0) THEN - IF (IRED(I).NE.I1) THEN - I1=IRED(I) - I4=I - TE1=IFRT(I)/256 - TW1=MOD(IFRT(I),256) - W2=DAT(TE1,TW1) - ELSE - TE2=IFRT(I)/256 - TW2=MOD(IFRT(I),256) - W22=DAT(TE2,TW2) - DO I2=0,N1-1 - CCF(I2)=0 - END DO - CCF(TW1)=CCF(TW1)+CMPLX(1,1) !SET COEFFICIENTS - CCF(TE1)=CCF(TE1)+CMPLX(1,-1) - CCF(TW2)=CCF(TW2)+CMPLX(-1,-1) - CCF(TE2)=CCF(TE2)+CMPLX(-1,+1) - CMP1=EXP(CMPLX(AMP(TE1,TW1),PH(TE1,TW1))- - 1 CMPLX(AMP(TE2,TW2),PH(TE2,TW2))) - CMP1=CMP1*EXP(-CSOL(TW1)-CONJG(CSOL(TE1))+CSOL(TW2)+ - 1 CONJG(CSOL(TE2))) - CALL WNMLMN(MAR,LSQ_C_REAL,CCF,W22*W22/(W2+W22), - 1 CMP1-CMPLX(1,0)) - END IF - END IF - END DO - CALL WNMLNN(MAR,NR,CSOL,MU,ME) - CALL WNCTXT(F_T,'!70$13Q\Solution: !16$#E4',2*N1,SOL) - CALL WNCTXT(F_T,'!70$13Q\MU: !16$E4',MU) - CALL WNCTXT(F_T,'!70$13Q\FIT: !16$E4',ME) - END DO - CALL WNMLFA(MAR) -C - RETURN -C -C - END diff --git a/src/wng/twnp.for b/src/wng/twnp.for deleted file mode 100644 index 99d1755c70373d1c295cb3405cf9914f15e54bef..0000000000000000000000000000000000000000 --- a/src/wng/twnp.for +++ /dev/null @@ -1,196 +0,0 @@ -C+ TWNP.FOR -C WNB 890418 -C -C Revisions: -C HjV 920708 Add INCLUDE 'WNG_DEF' -C - SUBROUTINE TWNP(DEV) -C -C Main routine to test plotting. -C DEV_C*: Command line input, ie device -C -C Include files: -C - INCLUDE 'WNG_DEF' -C -C Parameters: -C -C -C Arguments: -C - CHARACTER*(*) DEV !DEVICE TO DO -C -C Function references: -C -C -C Data declarations: -C -C -C REAL PI -C DATA PI/3.1415927/ - INTEGER WQID,WQID1 - REAL P(8) - DATA P/.25,.33,.5,.67,.9,.9,.1,.5/ - REAL Q(4) - DATA Q/0,0,2.,2./ - REAL Q1(4) - DATA Q1/0.1,0,.4,.4/ - REAL Q2(4) - DATA Q2/0,0,.25,1./ - REAL Q3(4) - DATA Q3/0.28,.35,1.,.65/ - REAL R(2,0:200) - REAL T(2,7) - DATA T/.1,.1,0.02,.2,0.02,.3,0.02,.4,0.02,.5,0.02,.6,0.02,.7/ - REAL T1(2) - DATA T1/-1.,1./ - REAL TQ(0:1,0:1,3) - DATA TQ/.1,.1,.9,.9,.1,.5,.9,.5,.5,.1,.5,.9/ - REAL X1(153) - REAL XP(0:1) - DATA XP/.25,.25/ - REAL XDP(0:1,0:1) - DATA XDP/.01,0.,0,.01/ - REAL RANGE(0:1) - DATA RANGE/-20.,20./ - REAL PRANGE(0:1) - DATA PRANGE/0.1,1./ - REAL RRANGE(0:1) - DATA RRANGE/-.5,1./ -C - CALL WNCAUC(DEV) !MAKE UPPER CASE - CALL WQOPEN !OPEN AND DEVICE - CALL WQDVOP(WQID,DEV) - CALL WQDVAC(WQID) -C -CC CALL WQSWIN(1,Q) !CLIPPING, WINDOWING -CC CALL WQSVIE(1,Q1) -C CALL WQSDVW(WQID,Q2) -C CALL WQSNTR(1,Q1,Q1) -CC CALL WQSLNT(1) -CC CALL WQSCLP(.TRUE.) -C -C CALL WQSNTR(1,Q3,Q3) !TRANSFORM -C -C CALL WQMSG(WQID,'Kopje') !MESSAGE - CALL WQ_DATE(WQID,'Kop je') -C -CC GOTO 10 -CC GOTO 30 -CC GOTO 40 -CC GOTO 50 -C -C CALL WQSTXH(.1) !TEXT - CALL WQSTXH(.025) - CALL WQSTXU(T1) - CALL WQSTXS(.25) - CALL WQTEXT(P,'A') - CALL WQTEXT(T(1,1),'abcdefghijklmn') - CALL WQTEXT(T(1,2),'opqrstuvwxyz') - CALL WQTEXT(T(1,3),'ABCDEFGHIJKLMN') - CALL WQTEXT(T(1,4),'OPQRSTUVWXYZ') - CALL WQTEXT(T(1,5),'!@#$%^&*()_-+={[}]') - CALL WQTEXT(T(1,6),'`~0123456789:;''"|') - CALL WQTEXT(T(1,7),'?/.,<> C C') -C -C CALL WQSLNT(1) !CLIPPING -C CALL WQSCLP(.TRUE.) -C -CC CALL WQPOLM(4,P,2) !MARKS - CALL WQPOLM_IX(4,P,2) -C -C CALL WQSPLR(WQID,1,1,4.) !THICK LINES -C !CIRCLES - DO I=0,200 - R(1,I)=.5+.25*SIN(.0628319*I/2.) - R(2,I)=.5+.25*COS(.0628319*I/2.) - END DO - CALL WQSPLI(3) - CALL WQPOLL(201,R) - DO I0=1,4 - R0=0.025*I0 - DO I=0,200 - R(1,I)=.5+R0+(.25-R0)*SIN(.0628319*I/2.) - R(2,I)=.5+(.25-R0)*COS(.0628319*I/2.) - END DO - CALL WQPOLL_IX(201,R,I0) - END DO -C - CALL WQPOLL_IX(2,TQ(0,0,1),4) !DASHES - CALL WQPOLL_IX(2,TQ(0,0,2),4) - CALL WQPOLL_IX(2,TQ(0,0,3),4) -CC GOTO 20 -C - 10 CONTINUE - CALL WQ_CONI(J0,26,XP,XDP,1,0.) !INIT CONT - DO I=-25,0 - R1=I - DO I1=-25,25 - R0=I1 - R0=SQRT(ABS(R0)**2.+ABS(R1)**2.)*PI/5.+1E-5 - X1(I1+26)=((SIN(R0)/R0)**2) - X1(I1+77)=R0*COS(R0)-SIN(R0) - X1(I1+128)=SIN(R0) - END DO - CALL WQ_CONT(J0,X1(52)) - END DO - CALL WQ_CONX(J0) !EXIT CONT -CC GOTO 20 -C - 30 CONTINUE - XP(0)=XP(0)+25*XDP(0,0) - CALL WQ_SHADI(J0,26,XP,XDP,0,RANGE,0.) !INIT SHADING - DO I=-25,0 - R1=I - DO I1=-25,25 - R0=I1 - R0=SQRT(ABS(R0)**2.+ABS(R1)**2.)*PI/5.+1E-5 - X1(I1+26)=((SIN(R0)/R0)**2) - X1(I1+77)=R0*COS(R0)-SIN(R0) - X1(I1+128)=SIN(R0) - END DO - CALL WQ_SHADE(J0,X1(77)) - END DO - CALL WQ_SHADX(J0) !EXIT SHADE -CC GOTO 20 -C - 40 CONTINUE - XP(1)=XP(1)+25*XDP(1,1) - CALL WQ_POLI(J0,26,XP,XDP,0.25,PRANGE,0.) !INIT POL. - DO I=0,25 - R1=I - DO I1=-25,25 - R0=I1 - R0=SQRT(ABS(R0)**2.+ABS(R1)**2.)*PI/5.+1E-5 - X1(I1+26)=((SIN(R0)/R0)**2) - X1(I1+77)=R0*COS(R0)-SIN(R0) - X1(I1+128)=I1*PI/100.+I*PI/100. - END DO - CALL WQ_POLT(J0,X1(1),X1(128)) - END DO - CALL WQ_POLX(J0) !EXIT POL -CC GOTO 20 -C - 50 CONTINUE - XP(0)=XP(0)-25*XDP(0,0) - CALL WQ_RULI(J0,26,XP,XDP,0.25,RRANGE,0.,0) !INIT RULED - DO I=0,25 - R1=I - DO I1=-25,25 - R0=I1 - R0=SQRT(ABS(R0)**2.+ABS(R1)**2.)*PI/5.+1E-5 - X1(I1+26)=((SIN(R0)/R0)**2) - X1(I1+77)=R0*COS(R0)-SIN(R0) - X1(I1+128)=I1*PI/100.+I*PI/100. - END DO - CALL WQ_RULE(J0,X1(1)) - END DO - CALL WQ_RULX(J0) !EXIT RULED -CC GOTO 20 -C - 20 CONTINUE - CALL WQDVDA(WQID) !CLOSE - CALL WQDVCL(WQID) - CALL WQCLOS -C - END diff --git a/src/wng/wnc.def b/src/wng/wnc.def deleted file mode 100644 index 241e64db7078f5043b7169ae7ba5ed8dba822d62..0000000000000000000000000000000000000000 --- a/src/wng/wnc.def +++ /dev/null @@ -1,85 +0,0 @@ -C+ Created from wnc.dsc on 970828 at 16:56:52 at daw18 -C WNC.DEF -C WNB 970828 -C -C Revisions: -C -C WNB 930803 Make use of WNTINC -C WNB 890716 Original version -C -C -C Given statements: -C -C -C Result: -C -C WNC.DEF is an INCLUDE file for the WNC I/O routines. -C Initialisation is done in WNC_BD.FOR, generated automatically. -C -C -C Parameters: -C - INTEGER CMPH ! MAX. # OF HEADERS - PARAMETER (CMPH=16) - INTEGER CDPL ! DEFAULT PAGE LENGTH - PARAMETER (CDPL=60) - INTEGER CDLL ! DEFAULT LINE LENGTH - PARAMETER (CDLL=132) - INTEGER CMLL ! MAX. LINE LENGTH - PARAMETER (CMLL=132) -C -C Data declarations: -C -C -C WNC common data: -C - INTEGER CEXH(1:6) ! EXIT HANDLER BLOCK - INTEGER CLUN(-1:16) ! LUN - INTEGER CPC(-1:16) ! PAGE COUNT - INTEGER CLC(-1:16) ! LINE COUNT - INTEGER CPL(-1:16) ! PAGE LENGTH - INTEGER CLL(-1:16) ! LINE LENGTH - INTEGER*2 CHPH(-1:16) ! MAX. HEADER LINE SET - INTEGER CDIS(-1:16) ! DISPOSITION (NOT USED) - CHARACTER*80 CFN(-1:16) ! FILE NAME USED - CHARACTER*80 CFFN(-1:16) ! FINAL FILE NAME - CHARACTER*132 CPH(1:16,-1:16) ! HEADER LINES - CHARACTER*1 CSPH(1:16,-1:16) ! HEADER LINE SET -C -C WNC common block: -C - COMMON /WNC_COM/ CEXH,CLUN,CPC,CLC, - 1 CPL,CLL,CHPH,CDIS, - 1 CFN,CFFN,CPH,CSPH -C -C External initialisation: -C - EXTERNAL WNC_BD -C -C Given statements: -C -C- - - - - - - - - - - - - - - - - - - - - - - - - diff --git a/src/wng/wnc.dsc b/src/wng/wnc.dsc deleted file mode 100644 index 68069f240fe6e93463d7f5d51adc1f7684c1436b..0000000000000000000000000000000000000000 --- a/src/wng/wnc.dsc +++ /dev/null @@ -1,47 +0,0 @@ -!+ WNC.DSC -! WNB 890716 -! -! Revisions: -! -%REVISION=WNB=930803="Make use of WNTINC" -%REVISION=WNB=890716="Original version" -! -! Layout of overall include file (WNC.DEF) -! -%COMMENT="WNC.DEF is an INCLUDE file for the WNC I/O routines." -%COMMENT=" Initialisation is done in WNC_BD.FOR, generated automatically." -! -%LOCAL=CMLL=132 !HEADER LINE LENGTH -%LOCAL=CMPH=16 !MAX. # OF HEADER LINES -%LOCAL=NFILN=16 !# OF FILES (SHOULD EQUAL %NFILE IN WNG.DSC) -%LOCAL=FYES=1 !DISPOSITION, SHOULD EQUAL WNG.DSC VALUE -%VERSION=1 -%SYSTEM=1 -%USER=WNB -%%DATE -%%NAME -!- -.DEFINE - .PARAMETER - CMPH J /CMPH/ !MAX. # OF HEADERS - CDPL J /60/ !DEFAULT PAGE LENGTH - CDLL J /CMLL/ !DEFAULT LINE LENGTH - CMLL J /CMLL/ !MAX. LINE LENGTH - .DATA -! -! Local variables: -! - .COMMON - CEXH J(6) /(6)0/ !EXIT HANDLER BLOCK - CLUN J(-1:NFILN) /(NFILN+2)0/ !LUN - CPC J(-1:NFILN) /(NFILN+2)0/ !PAGE COUNT - CLC J(-1:NFILN) /(NFILN+2)0/ !LINE COUNT - CPL J(-1:NFILN) /0,(NFILN+1)CDPL/ !PAGE LENGTH - CLL J(-1:NFILN) /80,(NFILN+1)CDLL/ !LINE LENGTH - CHPH I(-1:NFILN) /(NFILN+2)0/ !MAX. HEADER LINE SET - CDIS J(-1:NFILN) /(NFILN+2)FYES/ !DISPOSITION (NOT USED) - CFN C80(-1:NFILN) /(NFILN+2)" "/ !FILE NAME USED - CFFN C80(-1:NFILN) /(NFILN+2)" "/ !FINAL FILE NAME - CPH CCMLL(CMPH,-1:NFILN) !HEADER LINES - CSPH C1(CMPH,-1:NFILN) !HEADER LINE SET -.END diff --git a/src/wng/wnc.grp b/src/wng/wnc.grp deleted file mode 100644 index 8eca21df81b043b7043e316a62f6746ccbd4aab4..0000000000000000000000000000000000000000 --- a/src/wng/wnc.grp +++ /dev/null @@ -1,133 +0,0 @@ -!+ WNC.GRP -! WNB 880725 -! -! Revisions: -! WNB 911105 Add .FDW -! WNB 911118 Split ATA for DW -! WNB 920120 DW: finalise -! WNB 920128 Add SW -! WNB 920303 Split WNCCVS for SUN compiler error -! HjV 920525 Add HP -! WNB 921215 Hide .INC -! WNB 921216 CUN: WNCFHD, WNCTXT -! HjV 930107 Put WNCFHD en WNCTXT .FAL after .CUN -! WNB 930325 Forgot WNCCKS -! WNB 930526 Add WNCAFX -! HjV 930528 Add WNCTRP -! HjV 930603 Add WNCSYS, change WNCFCL from .FOR to .FSC -! WNB 930825 Add WNCALX, ALY -! HjV 931202 Add WNCALO (was entry) -! HjV 940217 Add/change missing entry-points/functions -! AXC 010628 linux port -! -! General character processing routines for WNB programs -! -! Group definition: -! -WNC.GRP -! -! PIN files -! -! -! Structure files -! -! -! General command files -! -! -! Fortran definition files: -! -WNC.DSC ! General include file -! -! Programs: -! -TWNC.FOR ! Test WNC program -! -WNCAJ.FOR !WNCAJ Get integer value from string - !WNCAJA Get value from string, using arg.list -WNCALN.FOR !WNCALN Significant non-white stringlength (>0) - !WNCAL0 Significant length of string (>=0) - !WNCALZ Length of ASCIZ field - !WNCALX Significant non-blank length (>0) - !WNCALY Same, but >=0 -WNCACD.FOR !WNCACD Convert string to D - !WNCACE Convert string to E - !WNCACJ Convert string to J - !WNCACI Convert string to I - !WNCACB Convert string to B -WNCACU.FOR !WNCACU Convert string to unsigned integer -WNCACX.FOR !WNCACX Convert string to X - !WNCACY Convert string to Y -WNCATA.FOR !WNCATA Test for alpha - WNCAT0.FOR !WNCASA Skip if alpha - !WNCATD Test for digit - !WNCASD Skip if digit - !WNCATN Test for name type char - !WNCASN Skip if name type char - !WNCATB Test for blanks - !WNCASB Skip if blanks - !WNCATS Test for separator - !WNCASS Skip if separator - !WNCATC Test for given character - !WNCASC Skip given character - !WNCATM Test for given characters - !WNCASM Skip if one of given characters - !WNCAFN Get a name from string - !WNCAFU Check minimax fit - !WNCAFF Get a full field from string - !WNCAFX Get a full field from string - !WNCAFS Get separator field from string - !WNCAFT Get special separator field from string - !WNCAFP Get special separator field from string -WNCAUC.FOR !WNCAUC Convert string to UC - !WNCALC Convert string to lc -WNCAUP.FOR !WNCAUP Convert 1 char. to UC -WNCALO.FOR !WNCALO Convert 1 char. to lc -WNCCAE.FOR !WNCCAE Convert REAL to angle string - !WNCCAD Convert DOUBLE PRECISION to angle string -WNCCST.FOR !WNCCST Show computing statistics - !WNCCSX Show statistics with text -WNCCVS.FOR ! Convert value to string - WNCCVS_X.FOR !WNCCES REAL - !WNCCDS DOUBLE PRECISION - !WNCCJS INTEGER - !WNCCIS INTEGER*2 - !WNCCKS K INTEGER (== J FOR NOW) - !WNCCBS BYTE - !WNCCAS STRING -WNCCXS.FOR !WNCCXS Convert COMPLEX to string - !WNCCYS Convert DOUBLE COMPLEX to string -WNCEXH.FOR !WNCEXH Exit handler -WNCFAD.FOR !WNCFAD Adjust/truncate field -WNCFCL.FSC !WNCFCL Close print files -WNCFHD.FVX !WNCFHD Set/reset header lines - WNCFHD.CUN !WNCFD1 Dummy (AL only) - WNCFHD.FAL - WNCFHD_X.FOR -WNCFOP.FSC !WNCFOP Open output char. files -WNCFSV.FOR !WNCFSV Set file characteristics - !WNCFSN Set file name - !WNCFGV Get file characteristics - !WNCFGN Get file name -WNCOUT.FOR !WNCOUT Output WNCTXT line -WNCSAD.FOR !WNCSAD Add string to other one -WNCSYS.FSC !WNCSYS Spawn a subprocess -WNCTIM.FOR !WNCTIM HH:MM:SS as string - !WNCTIF HH:MM:SS.SS - !WNCTIN HHMMSS - !WNCDAT DD-MMM-YY - !WNCDAF DD-MMM-YYYY - !WNCDAN YYMMDD -WNCTRP.FSC !WNCTRC Output fatal-error message - !WNCTRJ - !WNCTRX -WNCTXT.FVX !WNCTXT Print/type info - WNCTXT.CUN !WNCTXS Make string from info - WNCTXT.FAL !WNCTXI Convert string to info - WNCTXT_X.FOR !WNCTD1,2,3 Dummy (AL only) - WNCTXI_X.FOR !WNCTXS_X Write to string -! -! Executables -! -TWNC.EXE ! Test WNC routines -!- diff --git a/src/wng/wnc.inc b/src/wng/wnc.inc deleted file mode 100644 index 913d6a95e2efe4acc5becc9b0e1a27902c303b91..0000000000000000000000000000000000000000 --- a/src/wng/wnc.inc +++ /dev/null @@ -1,57 +0,0 @@ -/*+ Created from wnc.dsc on 970828 at 16:56:52 at daw18 -.. WNC.INC -.. WNB 970828 -.. -.. Revisions: -.. -.. WNB 930803 Make use of WNTINC -.. WNB 890716 Original version -.. */ -/* -.. Given statements: -.. */ -/* -.. Result: -.. -.. WNC.DEF is an INCLUDE file for the WNC I/O routines. -.. Initialisation is done in WNC_BD.FOR, generated automatically. -.. */ -/* -.. Parameters: -.. */ -#define CMPH 16 /* MAX. # OF HEADERS */ -#define CDPL 60 /* DEFAULT PAGE LENGTH */ -#define CDLL 132 /* DEFAULT LINE LENGTH */ -#define CMLL 132 /* MAX. LINE LENGTH */ -/* -.. Data declarations: -.. */ -/* -.. WNC common data: -.. */ -struct wnc_com { - int cexh[6]; /* EXIT HANDLER BLOCK */ - int clun[18]; /* LUN */ - int cpc[18]; /* PAGE COUNT */ - int clc[18]; /* LINE COUNT */ - int cpl[18]; /* PAGE LENGTH */ - int cll[18]; /* LINE LENGTH */ - short chph[18]; /* MAX. HEADER LINE SET */ - int cdis[18]; /* DISPOSITION (NOT USED) */ - char cfn[18][80]; /* FILE NAME USED */ - char cffn[18][80]; /* FINAL FILE NAME */ - char cph[18][16][132]; /* HEADER LINES */ - char csph[18][16][1]; /* HEADER LINE SET */ -}; -/* -.. WNC common block: -.. */ -extern struct wnc_com wnc_com_ ; -/* -.. External initialisation: -.. */ - extern wnc_bd_() ; -/* -.. Given statements: -.. */ -/*- */ diff --git a/src/wng/wnc_bd.for b/src/wng/wnc_bd.for deleted file mode 100644 index 80fdc4eae34a89a0476ca50652024735954d6510..0000000000000000000000000000000000000000 --- a/src/wng/wnc_bd.for +++ /dev/null @@ -1,64 +0,0 @@ -C+ Created from wnc.dsc on 970828 at 16:56:53 at daw18 -C WNC_BD.FOR -C WNB 970828 -C -C Revisions: -C -C WNB 930803 Make use of WNTINC -C WNB 890716 Original version -C - BLOCK DATA WNC_BD -C -C Result: -C -C Initialisation of wnc.def -C -C WNC.DEF is an INCLUDE file for the WNC I/O routines. -C Initialisation is done in WNC_BD.FOR, generated automatically. -C -C -C Parameters: -C - INTEGER CMPH ! MAX. # OF HEADERS - PARAMETER (CMPH=16) - INTEGER CDPL ! DEFAULT PAGE LENGTH - PARAMETER (CDPL=60) - INTEGER CDLL ! DEFAULT LINE LENGTH - PARAMETER (CDLL=132) - INTEGER CMLL ! MAX. LINE LENGTH - PARAMETER (CMLL=132) -C -C WNC common data: -C - INTEGER CEXH(1:6) ! EXIT HANDLER BLOCK - DATA CEXH /6*0/ - INTEGER CLUN(-1:16) ! LUN - DATA CLUN /18*0/ - INTEGER CPC(-1:16) ! PAGE COUNT - DATA CPC /18*0/ - INTEGER CLC(-1:16) ! LINE COUNT - DATA CLC /18*0/ - INTEGER CPL(-1:16) ! PAGE LENGTH - DATA CPL /0,17*CDPL/ - INTEGER CLL(-1:16) ! LINE LENGTH - DATA CLL /80,17*CDLL/ - INTEGER*2 CHPH(-1:16) ! MAX. HEADER LINE SET - DATA CHPH /18*0/ - INTEGER CDIS(-1:16) ! DISPOSITION (NOT USED) - DATA CDIS /18*1/ - CHARACTER*80 CFN(-1:16) ! FILE NAME USED - DATA CFN /18*' '/ - CHARACTER*80 CFFN(-1:16) ! FINAL FILE NAME - DATA CFFN /18*' '/ - CHARACTER*132 CPH(1:16,-1:16) ! HEADER LINES - CHARACTER*1 CSPH(1:16,-1:16) ! HEADER LINE SET -C -C WNC common block: -C - COMMON /WNC_COM/ CEXH,CLUN,CPC,CLC, - 1 CPL,CLL,CHPH,CDIS, - 1 CFN,CFFN,CPH,CSPH -C -C - END -C- diff --git a/src/wng/wncacd.for b/src/wng/wncacd.for deleted file mode 100644 index 568de11585daf6df207d82bdf971e001667dc498..0000000000000000000000000000000000000000 --- a/src/wng/wncacd.for +++ /dev/null @@ -1,242 +0,0 @@ -C+ WNCACD.FOR -C WNB 910211 -C -C Revisions: -C WNB 930713 Correct error for numbers starting with . -C - LOGICAL FUNCTION WNCACD(TXT,PT,BAS,DVAL) -C -C Convert a text to a value -C -C Result: -C -C WNCACD_L = WNCACD( TXT_C*:I, PT_J:IO, BAS_J:I, DVAL_D:O) -C Convert the string TXT -C starting at PT to a value VAL. Interprete -C the string as a value of base -C BAS (1, 2, ...., 16). -C PT will be updated to beyond last character -C read. -C Possible numbers: -C [sign][i][.i] [e|E|d|D|x|X[sign]i] -C [sign][i].[i].[i[.i]] -C [sign][i]:[i[:[i[.[i]]]]] -C WNCACD will be .false. if no digit present. -C Then: VAL=0, VC=1 -C WNCACE_L = WNCACE( TXT_C*:I, PT_J:IO, BAS_J:I, EVAL_E:O) -C WNCACJ_L = WNCACJ( TXT_C*:I, PT_J:IO, BAS_J:I, JVAL_J:O) -C WNCACI_L = WNCACI( TXT_C*:I, PT_J:IO, BAS_J:I, IVAL_I:O) -C WNCACB_L = WNCACB( TXT_C*:I, PT_J:IO, BAS_J:I, BVAL_B:O) -C -C Include files: -C - INCLUDE 'WNG_DEF' -C -C Parameters: -C -C -C Entry points: -C - LOGICAL WNCACE,WNCACJ,WNCACI,WNCACB -C -C Arguments: -C - CHARACTER*(*) TXT !INPUT STRING - INTEGER PT !STRING POINTER - INTEGER BAS !VALUE BASE - DOUBLE PRECISION DVAL !OUTPUT VALUE - REAL EVAL - INTEGER JVAL - INTEGER*2 IVAL - BYTE BVAL -C -C Function references: -C - LOGICAL WNCASC,WNCASM !SKIP CHARACTER - LOGICAL WNCATM !TEST CHARACTER - CHARACTER*1 WNCAUP !MAKE UC - LOGICAL WNCACU !GET UNSIGNED INTEGER - DOUBLE PRECISION WNGDND !MAKE NORM. ANGLE -C -C Data declarations: -C - INTEGER TP !VALUE TYPE - INTEGER LT !LENGTH OF STRING - DOUBLE PRECISION VAL !VALUE - CHARACTER*4 MODF !BASE MODIFIERS - DATA MODF/'BODX'/ - INTEGER MODI(4) - DATA MODI/2,8,10,16/ - DOUBLE PRECISION MODD(16) - DATA MODD/1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16/ -C -C Equivalences: -C -C -C Commons: -C -C- -C -C INIT -C - WNCACD=.FALSE. !ASSUME NO DIGIT - TP=1 !D - GOTO 100 -C -C WNCACE -C - ENTRY WNCACE(TXT,PT,BAS,EVAL) -C - WNCACE=.FALSE. - TP=2 !E - GOTO 100 -C -C WNCACJ -C - ENTRY WNCACJ(TXT,PT,BAS,JVAL) -C - WNCACJ=.FALSE. - TP=3 !J - GOTO 100 -C -C WNCACI -C - ENTRY WNCACI(TXT,PT,BAS,IVAL) -C - WNCACI=.FALSE. - TP=4 !I - GOTO 100 -C -C WNCACB -C - ENTRY WNCACB(TXT,PT,BAS,BVAL) -C - WNCACB=.FALSE. - TP=5 !B - GOTO 100 -C -C INIT -C - 100 CONTINUE - J=MIN(16,MAX(1,BAS)) !LIMIT MODE - VAL=0 !OUTPUT VALUE - J0=1 !SIGN - LT=LEN(TXT) !STRING LENGTH - CALL WNCASB(TXT,PT) !SKIP SPACES -C -C GET MODE -C - IF (WNCASC(TXT,PT,'%')) THEN !BASE MODIFIER - IF (PT.LE.LT) THEN - I1=INDEX(MODF,WNCAUP(TXT(PT:PT))) - IF (I1.GT.0) THEN !MODIFY - J=MODI(I1) - PT=PT+1 - ELSE - GOTO 10 !READY - END IF - ELSE - GOTO 10 - END IF - END IF -C -C GET SIGN -C - 20 CONTINUE - CALL WNCASB(TXT,PT) !SKIP SPACES - IF (WNCASC(TXT,PT,'+')) GOTO 20 !+ - IF (WNCASC(TXT,PT,'-')) THEN !- - J0=-J0 - GOTO 20 - END IF -C -C INTEGER PART -C - IF (.NOT.WNCACU(TXT,PT,J,VAL,D1)) THEN !NO DIGITS - IF (.NOT.WNCATM(TXT,PT,'.,:')) GOTO 10 !AND NO .,: - END IF - WNCACD=.TRUE. !DIGIT SEEN -C -C :: -C - IF (WNCASC(TXT,PT,':')) THEN !H:M:S - J1=15 !INDICATE H - L1=WNCACU(TXT,PT,J,D0,D1) !GET M - VAL=VAL+D0/60 - IF (WNCASC(TXT,PT,':')) THEN - 30 CONTINUE - L1=WNCACU(TXT,PT,J,D0,D1) !GET S - VAL=VAL+D0/3600 - IF (WNCASC(TXT,PT,'.')) THEN - L1=WNCACU(TXT,PT,J,D0,D1) !FRACTION OF SECONDS - VAL=VAL+D0/D1/3600 - END IF - END IF - VAL=WNGDND(VAL*J1) !MAKE NORMALISED DEGREES -C -C FRACTION/.. -C - ELSE IF (WNCASC(TXT,PT,'.')) THEN !FRACTION - L1=WNCACU(TXT,PT,J,D0,D1) !GET IT - IF (WNCASC(TXT,PT,'.')) THEN !D.M.S - J1=1 !INDICATE DEGREES - VAL=VAL+D0/60 - GOTO 30 - END IF - VAL=VAL+D0/D1 !ADD FRACTION -C -C EXPONENT -C - IF (WNCASM(TXT,PT,'EDXedx')) THEN !EXPONENT - 41 CONTINUE - J1=1 !SIGN - 40 CONTINUE - IF (WNCASC(TXT,PT,'+')) GOTO 40 !+ - IF (WNCASC(TXT,PT,'-')) THEN !- - J1=-J1 - GOTO 40 - END IF - L1=WNCACU(TXT,PT,J,D0,D1) !EXPONENT - IF (D0*LOG(MODD(J)).LT.LOG(1D37)) THEN !LIMIT - I2=NINT(D0) - D0=MODD(J)**I2 - IF (J1.LT.0) D0=1/D0 !SIGN - ELSE - IF (J1.LT.0) THEN - D0=0 !ZERO - ELSE - D0=1D37 !MAX - END IF - END IF - VAL=VAL*D0 !APPLY EXPONENT - END IF -C -C EXPONENT -C - ELSE IF (WNCASM(TXT,PT,'EDXedx')) THEN !EXPONENT - GOTO 41 - END IF -C -C OUTPUT -C - 10 CONTINUE - VAL=VAL*J0 !SIGN - IF (TP.EQ.1) THEN !D - DVAL=VAL - ELSE IF (TP.EQ.2) THEN !E - EVAL=VAL - ELSE - VAL=ANINT(VAL) !MAKE INTEGER - IF (TP.EQ.3) THEN !J - JVAL=NINT(MOD(VAL,2D0**L_J)) - ELSE IF (TP.EQ.4) THEN !I - IVAL=NINT(MOD(VAL,2D0**L_I)) - ELSE IF (TP.EQ.5) THEN !B - BVAL=NINT(MOD(VAL,2D0**L_B)) - END IF - END IF -C - RETURN -C -C - END diff --git a/src/wng/wncacu.for b/src/wng/wncacu.for deleted file mode 100644 index b96cc6c80a92f9e170fb783b2579a1dd2a86e24b..0000000000000000000000000000000000000000 --- a/src/wng/wncacu.for +++ /dev/null @@ -1,84 +0,0 @@ -C+ WNCACU.FOR -C WNB 91021 -C -C Revisions: -C - LOGICAL FUNCTION WNCACU(TXT,PT,BAS,VAL,VC) -C -C Convert a text to unsigned integer value -C -C Result: -C -C WNCACU_L = WNCACU( TXT_C*:I, PT_J:IO, BAS_J:I, VAL_D:O, VC_D:O) -C Convert the string TXT -C starting at PT to a value VAL. Interprete -C the string as un unsigned integer of base -C BAS (1, 2, ...., 16). VC will return the -C BAS**(# of digits in value). -C PT will be updated to beyond last character -C read. -C WNCACU will be .false. if no digit present. -C Then: VAL=0, VC=1 -C -C Include files: -C - INCLUDE 'WNG_DEF' -C -C Parameters: -C -C -C Arguments: -C - CHARACTER*(*) TXT !INPUT STRING - INTEGER PT !STRING POINTER - INTEGER BAS !VALUE BASE - DOUBLE PRECISION VAL !OUTPUT VALUE - DOUBLE PRECISION VC !OUTPUT SCALE -C -C Function references: -C - CHARACTER*1 WNCAUP !MAKE UC -C -C Data declarations: -C - INTEGER LT !LENGTH OF STRING - CHARACTER*16 SMOD !DIGITS - DATA SMOD/'0123456789ABCDEF'/ - DOUBLE PRECISION MMOD(16) !BASE - DATA MMOD/1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16/ -C -C Equivalences: -C -C -C Commons: -C -C- -C -C INIT -C - WNCACU=.FALSE. !ASSUME NO DIGIT - J=MIN(16,MAX(1,BAS)) !LIMIT MODE - VAL=0 !OUTPUT VALUE - VC=1. !OUTPUT SCALE - LT=LEN(TXT) !STRING LENGTH - CALL WNCASB(TXT,PT) !SKIP SPACES -C -C GET VALUE -C - DO WHILE (PT.LE.LT) !MORE CHAR - I1=INDEX(SMOD(:J),WNCAUP(TXT(PT:PT)))-1 !DIGIT - IF (I1.GE.0) THEN !DIGIT - VAL=VAL*MMOD(J)+I1 !VALUE - VC=VC*MMOD(J) !SCALE - PT=PT+1 !POINTER - WNCACU=.TRUE. !DIGIT SEEN - ELSE - GOTO 10 !READY - END IF - END DO -C - 10 CONTINUE - RETURN -C -C - END diff --git a/src/wng/wncacx.for b/src/wng/wncacx.for deleted file mode 100644 index 96e1b05e9b0aea9f0967446c33fdd625ac45396c..0000000000000000000000000000000000000000 --- a/src/wng/wncacx.for +++ /dev/null @@ -1,113 +0,0 @@ -C+ WNCACX.FOR -C WNB 910211 -C -C Revisions: -C - LOGICAL FUNCTION WNCACX(TXT,PT,BAS,XVAL) -C -C Convert a text to a complex value -C -C Result: -C -C WNCACX_L = WNCACXD( TXT_C*:I, PT_J:IO, BAS_J:I, XVAL_D:O) -C Convert the string TXT starting at -C PT to a complex value VAL. Interprete -C the string as a value of base -C BAS (1, 2, ...., 16). -C PT will be updated to beyond last character -C read. -C Possible numbers: -C [number][+|-numberI] -C WNCACX will be .false. if no digit present. -C Then: VAL=0 -C WNCACY_L = WNCACY( TXT_C*:I, PT_J:IO, BAS_J:I, YVAL_E:O) -C -C Include files: -C - INCLUDE 'WNG_DEF' -C -C Parameters: -C -C -C Entry points: -C - LOGICAL WNCACY -C -C Arguments: -C - CHARACTER*(*) TXT !INPUT STRING - INTEGER PT !STRING POINTER - INTEGER BAS !VALUE BASE - COMPLEX XVAL !OUTPUT VALUE - DOUBLE COMPLEX YVAL -C -C Function references: -C - LOGICAL WNCASM !SKIP CHARACTER - LOGICAL WNCACD !GET REAL VALUE -C -C Data declarations: -C - INTEGER TP !VALUE TYPE - DOUBLE COMPLEX VAL !VALUE -C -C Equivalences: -C -C -C Commons: -C -C- -C -C INIT -C - WNCACX=.FALSE. !ASSUME NO DIGIT - TP=1 !X - GOTO 100 -C -C WNCACY -C - ENTRY WNCACY(TXT,PT,BAS,YVAL) -C - WNCACY=.FALSE. - TP=2 !Y - GOTO 100 -C -C INIT -C - 100 CONTINUE - VAL=0 !OUTPUT VALUE -C -C GET VALUE -C - IF (.NOT.WNCACD(TXT,PT,BAS,D0)) GOTO 10 !NO DIGITS - WNCACX=.TRUE. !DIGIT SEEN - IF (WNCASM(TXT,PT,'iI')) THEN !NO REAL PART - VAL=CMPLX(0D0,D0) - ELSE - VAL=CMPLX(D0,0D0) !REAL PART - CALL WNCASB(TXT,PT) !SKIP SPACES - J1=PT !SAVE POINTER - IF (.NOT.WNCACD(TXT,PT,BAS,D0)) THEN - PT=J1 - ELSE - IF (WNCASM(TXT,PT,'iI')) THEN !IMAG. PART - VAL=VAL+CMPLX(0D0,D0) - ELSE - PT=J1 - END IF - END IF - END IF -C -C OUTPUT -C - 10 CONTINUE - IF (TP.EQ.1) THEN !X - XVAL=VAL - ELSE IF (TP.EQ.2) THEN !Y - YVAL=VAL - END IF -C - RETURN -C -C - END diff --git a/src/wng/wncaj.for b/src/wng/wncaj.for deleted file mode 100644 index 9dc0fa072c5e4c350de21d0e70cadc629e40a82f..0000000000000000000000000000000000000000 --- a/src/wng/wncaj.for +++ /dev/null @@ -1,121 +0,0 @@ -C+ WNCAJ.FOR -C WNB 890105 -C -C Revisions: -C - INTEGER FUNCTION WNCAJ(TXT,LTXT,PTXT) -C -C Get value from string -C -C Result: -C -C J = WNCAJ ( TXT_C*:I, LTXT_J:I, PTXT_J:IO) -C Read an integer value from string TXT with -C length LTXT, starting at PTXT+1, and updating -C PTXT. -C J = WNCAJA ( TXT_C*:I, LTXT_J:I, PTXT_J:IO, ARGL_J(0:*):I, -C LARG_J:I, PARG_J:IO) -C As WNCAJ, but value taken from argument list -C given by ARGL with ARGL arguments, using -C PARG if TXT contains #(J from ARGL) or -C ##(I from ARGL); updating PARG if so. -C -C Include files: -C - INCLUDE 'WNG_DEF' -C -C Parameters: -C -C -C Arguments: -C - CHARACTER*(*) TXT !INPUT STRING - INTEGER LTXT !LENGTH STRING TO USE - INTEGER PTXT !STRING POINTER - INTEGER ARGL(0:*) !ARGUMENT LIST - INTEGER LARG !# OF ARGUMENTS IN LIST - INTEGER PARG !ARGUMENT POINTER -C -C Function references: -C - INTEGER WNGARJ !GET J FROM ARGUM. LIST - INTEGER*2 WNGARI !GET I2 FROM ARGUM.LIST -C -C Entry points: -C - INTEGER WNCAJA !GET VALUE USING ARGUMENT LIST -C -C Data declarations: -C - CHARACTER*10 CDIG !DIGITS - DATA CDIG/'0123456789'/ -C -C Equivalences: -C -C -C Commons: -C -C- - GOTO 10 -C -C WNCAJA -C - ENTRY WNCAJA(TXT,LTXT,PTXT,ARGL,LARG,PARG) -C - IF (PTXT+1.LE.LTXT) THEN !TEST FOR # - IF (TXT(PTXT+1:PTXT+1).EQ.'#') THEN - PTXT=PTXT+1 - IF (PTXT+1.LE.LTXT) THEN !TEST FOR ## - IF (TXT(PTXT+1:PTXT+1).EQ.'#') THEN - PTXT=PTXT+1 - PARG=PARG+1 - WNCAJA=WNGARI(PARG,ARGL) !GET VALUE -C - RETURN - END IF - END IF - PARG=PARG+1 - WNCAJA=WNGARJ(PARG,ARGL) !GET VALUE -C - RETURN - END IF - END IF -C -C WNCAJ -C - 10 CONTINUE - J=0 !RESULT - J1=1 !SIGN - I=PTXT !TEXT POINTER - DO WHILE (I+1.LE.LTXT) !CHECK SIGN - IF (TXT(I+1:I+1).EQ.'-') THEN - J1=-J1 - ELSE IF (TXT(I+1:I+1).NE.'+') THEN - GOTO 20 - END IF - I=I+1 !SKIP SIGN - END DO - 20 CONTINUE - IF (I+1.LE.LTXT) THEN - IF (INDEX(CDIG,TXT(I+1:I+1)).EQ.0) GOTO 30 !READY - ELSE - GOTO 30 !READY - END IF - PTXT=I !NEW STRING POINTER - DO WHILE (PTXT+1.LE.LTXT) !DIGITS - J2=INDEX(CDIG,TXT(PTXT+1:PTXT+1)) !DIGIT? - IF (J2.EQ.0) THEN !NO - GOTO 30 !READY - ELSE - J=J*10+J2-1 !ADD DIGIT - PTXT=PTXT+1 !NEXT DIGIT - END IF - END DO -C - 30 CONTINUE - WNCAJ=J*J1 !RESULT -C - RETURN -C -C - END diff --git a/src/wng/wncaln.for b/src/wng/wncaln.for deleted file mode 100644 index de960636f1f249f7aded0710c7410b10d9830db4..0000000000000000000000000000000000000000 --- a/src/wng/wncaln.for +++ /dev/null @@ -1,131 +0,0 @@ -C+ WNCALN.FOR -C WNB 880725 -C -C Revisions: -C WNB 911118 DW cannot handle CHAR(0) in INDEX -C WNB 930728 Overhaul to include TAB's etc -C CMV 930824 Include CR/LF in count (needed for wnqeps/wnqqms) -C WNB 930825 Add WNCALX,WNCALY (for wnqeps/wnqqms) -C - INTEGER FUNCTION WNCALN(FRST) -C -C Get length of string with information -C -C Result: -C -C WNCALN_J = WNCALN( FRST_C*:I) Length of string FRST (>0) excluding -C all trailing non-white -C WNCAL0_J = WNCAL0( FRST_C*:I) Length of string FRST (>=0) -C WNCALZ_J = WNCALZ( FROM_B(*):I) Length of ASCIZ field -C WNCALX_J = WNCALX( FRST_C*:I) Length of string FRST including line -C formatting items (CR etc) (>0) -C WNCALY_J = WNCALY( FRST_C*:I) Same, but >=0 -C -C Include files: -C - INCLUDE 'WNG_DEF' -C -C Parameters: -C -C -C Arguments: -C - BYTE FROM(*) !INPUT FIELD - CHARACTER*(*) FRST !INPUT STRING -C -C Entry points: -C - INTEGER WNCAL0,WNCALZ,WNCALX,WNCALY -C -C Function references: -C -C -C Data declarations: -C -C- -C -C WNCALN -C - I=LEN(FRST) !TOTAL LENGTH - DO WHILE (I.GT.0) !SEARCH END - IF (ICHAR(FRST(I:I)).LE.ICHAR(' ')) THEN !REMOVE ALL NON-WHITE - I=I-1 !LENGTH - ELSE - GOTO 10 !READY - END IF - END DO - 10 CONTINUE - WNCALN=MAX(I,1) !MAKE >= 1 -C - RETURN -C -C WNCAL0 -C - ENTRY WNCAL0(FRST) -C - I=LEN(FRST) !TOTAL LENGTH - DO WHILE (I.GT.0) !SEARCH END - IF (ICHAR(FRST(I:I)).LE.ICHAR(' ')) THEN - I=I-1 !LENGTH - ELSE - GOTO 20 !READY - END IF - END DO - 20 CONTINUE - WNCAL0=I !RETURN LENGTH -C - RETURN -C -C WNCALZ -C - ENTRY WNCALZ(FROM) -C - I=1 - DO WHILE (FROM(I).NE.0) !FIND END - I=I+1 - END DO - WNCALZ=I-1 !SET LENGTH -C - RETURN -C -C WNCALX -C - ENTRY WNCALX(FRST) -C - I=LEN(FRST) !TOTAL LENGTH - DO WHILE (I.GT.0) !SEARCH END - IF (ICHAR(FRST(I:I)).LT.9 .OR. - 1 (ICHAR(FRST(I:I)).LE.ICHAR(' ') .AND. - 1 ICHAR(FRST(I:I)).GT.13)) THEN !KEEP HT,LF,VT,FF,CR - I=I-1 !LENGTH - ELSE - GOTO 30 !READY - END IF - END DO - 30 CONTINUE - WNCALX=MAX(I,1) !MAKE >= 1 -C - RETURN -C -C WNCALY -C - ENTRY WNCALY(FRST) -C - I=LEN(FRST) !TOTAL LENGTH - DO WHILE (I.GT.0) !SEARCH END - IF (ICHAR(FRST(I:I)).LT.9 .OR. - 1 (ICHAR(FRST(I:I)).LE.ICHAR(' ') .AND. - 1 ICHAR(FRST(I:I)).GT.13)) THEN !KEEP HT,LF,VT,FF,CR - I=I-1 !LENGTH - ELSE - GOTO 40 !READY - END IF - END DO - 40 CONTINUE - WNCALY=I !LENGTH (>=0) -C - RETURN -C -C - END - diff --git a/src/wng/wncalo.for b/src/wng/wncalo.for deleted file mode 100644 index 0bf2d050134a8d8b0e73244899ca32ae23176f71..0000000000000000000000000000000000000000 --- a/src/wng/wncalo.for +++ /dev/null @@ -1,55 +0,0 @@ -C+ WNCALO.FOR -C HjV 931202 Splitted because of HP-UX 09.01 problem -C with character entry -C -C Revisions: -C - CHARACTER*(*) FUNCTION WNCALO(TXT) -C -C Convert character to lower case -C -C Result: -C -C C1 = WNCALO ( TXT_C*:I) Convert first character in TXT to lowercase -C -C Include files: -C - INCLUDE 'WNG_DEF' -C -C Parameters: -C -C -C Arguments: -C - CHARACTER*(*) TXT !INPUT STRING -C -C Entry points: -C -C -C Function references: -C -C -C Data declarations: -C - CHARACTER*26 LC !LC TABLE - CHARACTER*26 UC !UC TABLE - DATA LC/'abcdefghijklmnopqrstuvwxyz'/ - DATA UC/'ABCDEFGHIJKLMNOPQRSTUVWXYZ'/ -C -C Equivalences: -C -C -C Commons: -C -C- - J=INDEX(UC,TXT(1:1)) - IF (J.NE.0) THEN - WNCALO=LC(J:J) - ELSE - WNCALO=TXT(1:1) - END IF -C - RETURN -C -C - END diff --git a/src/wng/wncat0.for b/src/wng/wncat0.for deleted file mode 100644 index edf8b0e6b2245033f99c6abb49180f839b6ecf20..0000000000000000000000000000000000000000 --- a/src/wng/wncat0.for +++ /dev/null @@ -1,394 +0,0 @@ -C+ WNCAT0.FOR -C WNB 890427 -C -C Revisions: -C WNB 911118 DW DATA statement problems -C WNB 911118 DW split from ATA -C HjV 920520 HP does not allow extended source lines -C WNB 930526 Add AFX -C - LOGICAL FUNCTION WNCAFN(STR,PT,NAM) -C -C Get type of character -C -C Result: -C -C WNCAFU_J = WNCAFU( STR_C*:I, NL_C*(*):I) Check if the name given in STR -C can be uniquely found in the -C list NL (minimax) (Last member -C in list blank), and return order -C number or zero. -C WNCAFN_L = WNCAFN( STR_C*:I, PT_J:IO, NAM_C*:O) Get a field name in -C NAM, starting at PT and updating -C PT till end of field. True if -C NAM field not empty. NAM will -C be in upper case. -C WNCAFF_L = WNCAFF( STR_C*:I, PT_J:IO, NAM_C*:O) Get remaining data in -C string, excluding !comment. -C Convert to UC unless in "". -C WNCAFX_L = WNCAFX( STR_C*:I, PT_J:IO, NAM_C*:O) Get remaining data in -C string, excluding !comment. -C Convert to UC unless in "". -C Preserve "" -C WNCAFS_L = WNCAFS( STR_C*:I, PT_J:IO, NAM_C*:O) Get field in -C string, excluding !comment. -C Convert to UC unless in "". -C Field ends at separator or blank -C WNCAFT_L = WNCAFT( STR_C*:I, PT_J:IO, NAM_C*:O, CH_C*:I) Get field in -C string, excluding !comment. -C Convert to UC unless in "". -C Field ends at a separator in -C CH or blank -C WNCAFP_L = WNCAFP( STR_C*:I, PT_J:IO, NAM_C*:O, CH_C*:I) Get field in -C string, excluding !comment. -C Convert to UC unless in "". -C Field ends at a separator in -C CH or blank. Preserve ". -C -C Include files: -C - INCLUDE 'WNG_DEF' -C -C Parameters: -C -C -C Arguments: -C - CHARACTER*(*) STR !INPUT STRING - INTEGER PT !STRING POINTER - CHARACTER *(*) CH !CHECK CHARACTER - CHARACTER *(*) NAM !NAME FIELD - CHARACTER *(*) NL(*) !NAME LIST TO CHECK -C -C Entry points: -C - LOGICAL WNCAFF,WNCAFX,WNCAFS,WNCAFT,WNCAFP !GET FIELD - INTEGER WNCAFU !MINIMAX TEST -C -C Function references: -C - CHARACTER*1 WNCAUP !UC CONVERSION - INTEGER WNCALN !STRING LENGTH -C -C Data declarations: -C - CHARACTER*52 ALPH - CHARACTER*10 DIG - CHARACTER*2 XALPH - CHARACTER*1 SEP - DATA ALPH(01:26)/'ABCDEFGHIJKLMNOPQRSTUVWXYZ'/ - DATA ALPH(27:52)/'abcdefghijklmnopqrstuvwxyz'/ - DATA DIG/'0123456789'/ - DATA XALPH/'_$'/ - DATA SEP/','/ -C- -C -C WNCAFN -C - WNCAFN=.FALSE. !ASSUME ERROR - NAM=' ' !FIELD NAME - I=1 !LENGTH NAME - IF (PT.LE.LEN(STR)) THEN !CAN DO - IF (INDEX(ALPH//XALPH,STR(PT:PT)).GT.0) THEN - WNCAFN=.TRUE. - NAM=WNCAUP(STR(PT:PT)) - I=I+1 - PT=PT+1 - DO WHILE (PT.LE.LEN(STR)) - IF (INDEX(ALPH//XALPH//DIG,STR(PT:PT)).GT.0) THEN - IF (I.LE.LEN(NAM)) THEN !ADD TO NAME - NAM=NAM(1:I-1)//WNCAUP(STR(PT:PT)) - I=I+1 - END IF - PT=PT+1 - ELSE - GOTO 30 - END IF - END DO - 30 CONTINUE - END IF - END IF -C - RETURN -C -C WNCAFU -C - ENTRY WNCAFU(STR,NL) -C - WNCAFU=0 !ASSUME ERROR - I=MIN(WNCALN(STR),LEN(NL(1))) !CHECK LENGTH - I1=1 !COUNT IN NAMELIST - L0=.TRUE. !NO DUPLICATE - DO WHILE (NL(I1).NE.' ') - IF (STR(1:I).EQ.NL(I1)(1:I)) THEN !MATCH FOUND - IF (STR.EQ.NL(I1)) THEN !FULL MATCH - WNCAFU=I1 !SET - GOTO 40 !READY - END IF - I2=I1+1 - DO WHILE (NL(I2).NE.' ') !CHECK DUPLICATES - IF (STR(1:I).EQ.NL(I2)(1:I)) THEN !POSSIBLE DUPLICATE - IF (STR.EQ.NL(I2)) THEN !FULL MATCH - WNCAFU=I2 - GOTO 40 - END IF - L0=.FALSE. !DUPLICATE SEEN - END IF - I2=I2+1 - END DO - IF (L0) WNCAFU=I1 !NO DUPLICATE SEEN - GOTO 40 !READY - END IF - I1=I1+1 !NEXT IN NAMELIST - END DO - 40 CONTINUE -C - RETURN -C -C WNCAFF -C - ENTRY WNCAFF(STR,PT,NAM) -C - WNCAFF=.FALSE. !ASSUME ERROR - NAM=' ' !FIELD NAME - I=1 !LENGTH NAME - IF (PT.LE.LEN(STR) .AND. STR(PT:PT).NE. '!') THEN !CAN DO - WNCAFF=.TRUE. !FOUND SOME - J=0 !NO "/' SEEN - DO WHILE (PT.LE.LEN(STR)) - IF (J.EQ.0) THEN !NORMAL - IF (STR(PT:PT).EQ.'!') GOTO 50 !READY - IF (STR(PT:PT).EQ.'"') THEN - J=1 !SET " SEEN - ELSE !SET CHAR - IF (I.EQ.1) THEN - NAM=WNCAUP(STR(PT:PT)) - ELSE - NAM=NAM(1:I-1)//WNCAUP(STR(PT:PT)) - END IF - I=I+1 !NAME LENGTH - END IF - PT=PT+1 !SKIP CHAR - ELSE - IF (STR(PT:PT).EQ.'"') THEN !" - IF (PT.LT.LEN(STR)) THEN !MAYBE "" - IF (STR(PT+1:PT+1).EQ.'"') THEN - PT=PT+1 !ACT AS IF NORMAL - GOTO 51 - END IF - END IF - J=0 !RESET " SEEN - ELSE !NORMAL - 51 CONTINUE - IF (I.EQ.1) THEN - NAM=STR(PT:PT) - ELSE - NAM=NAM(1:I-1)//STR(PT:PT) - END IF - I=I+1 !NAME LENGTH - END IF - PT=PT+1 !SKIP CHAR - END IF - END DO - END IF - 50 CONTINUE -C - RETURN -C -C WNCAFX -C - ENTRY WNCAFX(STR,PT,NAM) -C - WNCAFX=.FALSE. !ASSUME ERROR - NAM=' ' !FIELD NAME - I=1 !LENGTH NAME - IF (PT.LE.LEN(STR) .AND. STR(PT:PT).NE. '!') THEN !CAN DO - WNCAFX=.TRUE. !FOUND SOME - J=0 !NO "/' SEEN - DO WHILE (PT.LE.LEN(STR)) - IF (J.EQ.0) THEN !NORMAL - IF (STR(PT:PT).EQ.'!') GOTO 52 !READY - IF (STR(PT:PT).EQ.'"') J=1 !SET " SEEN - IF (I.EQ.1) THEN !SET CHAR - NAM=WNCAUP(STR(PT:PT)) - ELSE - NAM=NAM(1:I-1)//WNCAUP(STR(PT:PT)) - END IF - I=I+1 !NAME LENGTH - PT=PT+1 !SKIP CHAR - ELSE - IF (STR(PT:PT).EQ.'"') THEN !" - NAM=NAM(1:I-1)//WNCAUP(STR(PT:PT)) - I=I+1 !NAME LENGTH - IF (PT.LT.LEN(STR)) THEN !MAYBE "" - IF (STR(PT+1:PT+1).EQ.'"') THEN - PT=PT+1 !ACT AS IF NORMAL - GOTO 53 - END IF - END IF - J=0 !RESET " SEEN - ELSE !NORMAL - 53 CONTINUE - IF (I.EQ.1) THEN - NAM=STR(PT:PT) - ELSE - NAM=NAM(1:I-1)//STR(PT:PT) - END IF - I=I+1 !NAME LENGTH - END IF - PT=PT+1 !SKIP CHAR - END IF - END DO - END IF - 52 CONTINUE -C - RETURN -C -C WNCAFS -C - ENTRY WNCAFS(STR,PT,NAM) -C - WNCAFS=.FALSE. !ASSUME ERROR - NAM=' ' !FIELD NAME - I=1 !LENGTH NAME - IF (PT.LE.LEN(STR) .AND. STR(PT:PT).NE.'!' .AND. - 1 ICHAR(STR(PT:PT)).GT.ICHAR(' ') .AND. - 2 INDEX(SEP,STR(PT:PT)).EQ.0) THEN !CAN DO - WNCAFS=.TRUE. !FOUND SOME - J=0 !NO " SEEN - DO WHILE (PT.LE.LEN(STR)) - IF (J.EQ.0) THEN !NORMAL - IF (STR(PT:PT).EQ.'!' .OR. INDEX(SEP,STR(PT:PT)).NE.0 .OR. - 1 ICHAR(STR(PT:PT)).LE.ICHAR(' ')) GOTO 60 !READY - IF (STR(PT:PT).EQ.'"') THEN - J=1 !SET " SEEN - ELSE !SET CHAR - IF (I.EQ.1) THEN - NAM=WNCAUP(STR(PT:PT)) - ELSE - NAM=NAM(1:I-1)//WNCAUP(STR(PT:PT)) - END IF - I=I+1 !NAME LENGTH - END IF - PT=PT+1 !SKIP CHAR - ELSE - IF (STR(PT:PT).EQ.'"') THEN !" - IF (PT.LT.LEN(STR)) THEN !MAYBE "" - IF (STR(PT+1:PT+1).EQ.'"') THEN - PT=PT+1 !ACT AS IF NORMAL - GOTO 61 - END IF - END IF - J=0 !RESET " SEEN - ELSE !NORMAL - 61 CONTINUE - IF (I.EQ.1) THEN - NAM=STR(PT:PT) - ELSE - NAM=NAM(1:I-1)//STR(PT:PT) - END IF - I=I+1 !NAME LENGTH - END IF - PT=PT+1 !SKIP CHAR - END IF - END DO - END IF - 60 CONTINUE -C - RETURN -C -C WNCAFT -C - ENTRY WNCAFT(STR,PT,NAM,CH) -C - WNCAFT=.FALSE. !ASSUME ERROR - NAM=' ' !FIELD NAME - I=1 !LENGTH NAME - IF (PT.LE.LEN(STR) .AND. STR(PT:PT).NE.'!' .AND. - 1 ICHAR(STR(PT:PT)).GT.ICHAR(' ') .AND. - 2 INDEX(CH,STR(PT:PT)).EQ.0) THEN !CAN DO - WNCAFT=.TRUE. !FOUND SOME - J=0 !NO " SEEN - DO WHILE (PT.LE.LEN(STR)) - IF (J.EQ.0) THEN !NORMAL - IF (STR(PT:PT).EQ.'!' .OR. INDEX(CH,STR(PT:PT)).NE.0 .OR. - 1 ICHAR(STR(PT:PT)).LE.ICHAR(' ')) GOTO 70 !READY - IF (STR(PT:PT).EQ.'"') THEN - J=1 !SET " SEEN - ELSE !SET CHAR - IF (I.EQ.1) THEN - NAM=WNCAUP(STR(PT:PT)) - ELSE - NAM=NAM(1:I-1)//WNCAUP(STR(PT:PT)) - END IF - I=I+1 !NAME LENGTH - END IF - PT=PT+1 !SKIP CHAR - ELSE - IF (STR(PT:PT).EQ.'"') THEN !" - IF (PT.LT.LEN(STR)) THEN !MAYBE "" - IF (STR(PT+1:PT+1).EQ.'"') THEN - PT=PT+1 !ACT AS IF NORMAL - GOTO 71 - END IF - END IF - J=0 !RESET " SEEN - ELSE !NORMAL - 71 CONTINUE - IF (I.EQ.1) THEN - NAM=STR(PT:PT) - ELSE - NAM=NAM(1:I-1)//STR(PT:PT) - END IF - I=I+1 !NAME LENGTH - END IF - PT=PT+1 !SKIP CHAR - END IF - END DO - END IF - 70 CONTINUE -C - RETURN -C -C WNCAFP -C - ENTRY WNCAFP(STR,PT,NAM,CH) -C - WNCAFP=.FALSE. !ASSUME ERROR - NAM=' ' !FIELD NAME - I=1 !LENGTH NAME - IF (PT.LE.LEN(STR) .AND. STR(PT:PT).NE.'!' .AND. - 1 ICHAR(STR(PT:PT)).GT.ICHAR(' ') .AND. - 2 INDEX(CH,STR(PT:PT)).EQ.0) THEN !CAN DO - WNCAFP=.TRUE. !FOUND SOME - J=0 !NO " SEEN - DO WHILE (PT.LE.LEN(STR)) - IF (J.EQ.0) THEN !NORMAL - IF (STR(PT:PT).EQ.'!' .OR. INDEX(CH,STR(PT:PT)).NE.0 .OR. - 1 ICHAR(STR(PT:PT)).LE.ICHAR(' ')) GOTO 80 !READY - IF (STR(PT:PT).EQ.'"') J=1 !SET " SEEN - IF (I.EQ.1) THEN - NAM=WNCAUP(STR(PT:PT)) - ELSE - NAM=NAM(1:I-1)//WNCAUP(STR(PT:PT)) - END IF - I=I+1 !NAME LENGTH - PT=PT+1 !SKIP CHAR - ELSE - IF (STR(PT:PT).EQ.'"') J=0 !RESET " SEEN - IF (I.EQ.1) THEN - NAM=STR(PT:PT) - ELSE - NAM=NAM(1:I-1)//STR(PT:PT) - END IF - I=I+1 !NAME LENGTH - PT=PT+1 !SKIP CHAR - END IF - END DO - END IF - 80 CONTINUE -C - RETURN -C -C - END diff --git a/src/wng/wncata.for b/src/wng/wncata.for deleted file mode 100644 index ef761573d08ccb70287ebaa5bf7870c0f606fe55..0000000000000000000000000000000000000000 --- a/src/wng/wncata.for +++ /dev/null @@ -1,252 +0,0 @@ -C+ WNCATA.FOR -C WNB 890427 -C -C Revisions: -C WNB 911118 DW DATA statement problems -C WNB 911118 DW split into ATA and AT0 -C HjV 920520 HP does not allow extended source lines -C - LOGICAL FUNCTION WNCATA(STR,PT) -C -C Get type of character -C -C Result: -C -C WNCATA_L = WNCATA( STR_C*:I, PT_J:I) Test if character STR(PT:PT) -C alpha (a-zA-Z) -C WNCASA_L = WNCASA( STR_C*:I, PT_J:IO) Same, but PT+1 if true -C WNCATD_L = WNCATD( STR_C*:I, PT_J:I) Test for digit (0-9) -C WNCASD_L = WNCASD( STR_C*:I, PT_J:IO) Same but PT+1 if true -C WNCATN_L = WNCATN( STR_C*:I, PT_J:I) Test name char. (a-zA-Z_$) -C WNCASN_L = WNCASN( STR_C*:I, PT_J:IO) Same but PT+1 if true -C WNCATS_L = WNCATS( STR_C*:I, PT_J:I) Test separator (, followed blank) -C WNCASS_L = WNCASS( STR_C*:I, PT_J:IO) Same but PT+n if true -C WNCATB_L = WNCATB( STR_C*:I, PT_J:I) Test blanks -C WNCASB_L = WNCASB( STR_C*:I, PT_J:IO) Same but PT+n if true -C WNCATC_L = WNCATC( STR_C*:I, PT_J:I, CH_C*:I) Test for character CH(1:1) -C WNCASC_L = WNCASC( STR_C*:I, PT_J:IO,CH_C*:I) Same but PT+1 if true -C WNCATM_L = WNCATM( STR_C*:I, PT_J:I, CH_C*:I) Test for characters CH -C WNCASM_L = WNCASM( STR_C*:I, PT_J:IO,CH_C*:I) Same but PT+1 if true -C -C Include files: -C - INCLUDE 'WNG_DEF' -C -C Parameters: -C -C -C Arguments: -C - CHARACTER*(*) STR !INPUT STRING - INTEGER PT !STRING POINTER - CHARACTER *(*) CH !CHECK CHARACTER -C -C Entry points: -C - LOGICAL WNCASA,WNCATD,WNCASD,WNCATN,WNCASN !CHARACTER TESTS - LOGICAL WNCATB,WNCASB,WNCATC,WNCASC,WNCATS,WNCASS !CHARACTER TESTS - LOGICAL WNCATM,WNCASM -C -C Function references: -C -C -C Data declarations: -C - CHARACTER*52 ALPH - CHARACTER*10 DIG - CHARACTER*2 XALPH - CHARACTER*1 SEP - DATA ALPH(01:26)/'ABCDEFGHIJKLMNOPQRSTUVWXYZ'/ - DATA ALPH(27:52)/'abcdefghijklmnopqrstuvwxyz'/ - DATA DIG/'0123456789'/ - DATA XALPH/'_$'/ - DATA SEP/','/ -C- -C -C WNCATA -C - WNCATA=.FALSE. !ASSUME ERROR - IF (PT.LE.LEN(STR)) THEN !CAN DO - WNCATA=INDEX(ALPH,STR(PT:PT)).GT.0 - END IF -C - RETURN -C -C WNCASA -C - ENTRY WNCASA(STR,PT) -C - WNCASA=.FALSE. !ASSUME ERROR - IF (PT.LE.LEN(STR)) THEN !CAN DO - I=INDEX(ALPH,STR(PT:PT)) - IF (I.GT.0) THEN - PT=PT+1 !SKIP CHARACTER - WNCASA=.TRUE. - END IF - END IF -C - RETURN -C -C WNCATD -C - ENTRY WNCATD(STR,PT) -C - WNCATD=.FALSE. !ASSUME ERROR - IF (PT.LE.LEN(STR)) THEN !CAN DO - WNCATD=INDEX(DIG,STR(PT:PT)).GT.0 - END IF -C - RETURN -C -C WNCASD -C - ENTRY WNCASD(STR,PT) -C - WNCASD=.FALSE. !ASSUME ERROR - IF (PT.LE.LEN(STR)) THEN !CAN DO - I=INDEX(DIG,STR(PT:PT)) - IF (I.GT.0) THEN - PT=PT+1 !SKIP CHARACTER - WNCASD=.TRUE. - END IF - END IF -C - RETURN -C -C WNCATN -C - ENTRY WNCATN(STR,PT) -C - WNCATN=.FALSE. !ASSUME ERROR - IF (PT.LE.LEN(STR)) THEN !CAN DO - WNCATN=INDEX(ALPH//XALPH,STR(PT:PT)).GT.0 - END IF -C - RETURN -C -C WNCASN -C - ENTRY WNCASN(STR,PT) -C - WNCASN=.FALSE. !ASSUME ERROR - IF (PT.LE.LEN(STR)) THEN !CAN DO - I=INDEX(ALPH//XALPH,STR(PT:PT)) - IF (I.GT.0) THEN - PT=PT+1 !SKIP CHARACTER - WNCASN=.TRUE. - END IF - END IF -C - RETURN -C -C WNCATB -C - ENTRY WNCATB(STR,PT) -C - WNCATB=.FALSE. !ASSUME ERROR - IF (PT.LE.LEN(STR)) THEN !CAN DO - WNCATB=ICHAR(STR(PT:PT)).LE.ICHAR(' ') - END IF -C - RETURN -C -C WNCASB -C - ENTRY WNCASB(STR,PT) -C - WNCASB=.FALSE. !ASSUME ERROR - DO WHILE (PT.LE.LEN(STR)) - IF (ICHAR(STR(PT:PT)).LE.ICHAR(' ')) THEN - WNCASB=.TRUE. - PT=PT+1 - ELSE - GOTO 10 !READY - END IF - END DO - 10 CONTINUE -C - RETURN -C -C WNCATS -C - ENTRY WNCATS(STR,PT) -C - WNCATS=.FALSE. !ASSUME ERROR - IF (PT.LE.LEN(STR)) THEN !CAN DO - WNCATS=INDEX(SEP,STR(PT:PT)).GT.0 - END IF -C - RETURN -C -C WNCASS -C - ENTRY WNCASS(STR,PT) -C - WNCASS=.FALSE. !ASSUME ERROR - IF (PT.LE.LEN(STR)) THEN !CAN DO - I=INDEX(SEP,STR(PT:PT)) - IF (I.GT.0) THEN - PT=PT+1 !SKIP CHARACTER - WNCASS=.TRUE. - END IF - END IF - DO WHILE (PT.LE.LEN(STR)) !SKIP BLANKS - IF (ICHAR(STR(PT:PT)).GT.ICHAR(' ')) GOTO 20 - PT=PT+1 - END DO - 20 CONTINUE -C - RETURN -C -C WNCATC -C - ENTRY WNCATC(STR,PT,CH) -C - WNCATC=.FALSE. !ASSUME ERROR - IF (PT.LE.LEN(STR)) THEN !CAN DO - WNCATC=STR(PT:PT).EQ.CH(1:1) - END IF -C - RETURN -C -C WNCASC -C - ENTRY WNCASC(STR,PT,CH) -C - WNCASC=.FALSE. !ASSUME ERROR - IF (PT.LE.LEN(STR)) THEN !CAN DO - IF (STR(PT:PT).EQ.CH(1:1)) THEN - PT=PT+1 !SKIP CHARACTER - WNCASC=.TRUE. - END IF - END IF -C - RETURN -C -C WNCATM -C - ENTRY WNCATM(STR,PT,CH) -C - WNCATM=.FALSE. !ASSUME ERROR - IF (PT.LE.LEN(STR)) THEN !CAN DO - WNCATM=INDEX(CH,STR(PT:PT)).GT.0 - END IF -C - RETURN -C -C WNCASM -C - ENTRY WNCASM(STR,PT,CH) -C - WNCASM=.FALSE. !ASSUME ERROR - IF (PT.LE.LEN(STR)) THEN !CAN DO - IF (INDEX(CH,STR(PT:PT)).GT.0) THEN - PT=PT+1 !SKIP CHARACTER - WNCASM=.TRUE. - END IF - END IF -C - RETURN -C -C - END diff --git a/src/wng/wncauc.for b/src/wng/wncauc.for deleted file mode 100644 index fcf5439b75a12c8e07201c9ed3ee575da47acf48..0000000000000000000000000000000000000000 --- a/src/wng/wncauc.for +++ /dev/null @@ -1,56 +0,0 @@ -C+ WNCAUC.FOR -C WNB 890105 -C -C Revisions: -C WNB 911115 DW DATA for CHARACTER problem -C - SUBROUTINE WNCAUC(TXT) -C -C Convert string to single case -C -C Result: -C -C CALL WNCAUC ( TXT_C*:IO) Convert TXT to Uppercase -C CALL WNCALC ( TXT_C*:IO) Convert TXT to lowercase -C -C Include files: -C - INCLUDE 'WNG_DEF' -C -C Parameters: -C -C -C Arguments: -C - CHARACTER*(*) TXT !INPUT STRING -C -C Function references: -C -C -C Data declarations: -C - CHARACTER*26 LC !LC TABLE - CHARACTER*26 UC !UC TABLE - DATA LC/'abcdefghijklmnopqrstuvwxyz'/ - DATA UC/'ABCDEFGHIJKLMNOPQRSTUVWXYZ'/ -C- - DO I=1,LEN(TXT) - J=INDEX(LC,TXT(I:I)) - IF (J.NE.0) TXT(I:I)=UC(J:J) - END DO -C - RETURN -C -C To lowercase -C - ENTRY WNCALC(TXT) -C - DO I=1,LEN(TXT) - J=INDEX(UC,TXT(I:I)) - IF (J.NE.0) TXT(I:I)=LC(J:J) - END DO -C - RETURN -C -C - END diff --git a/src/wng/wncaup.for b/src/wng/wncaup.for deleted file mode 100644 index b0c68de2841c0ea9b6d47cc0fe81ae38f58003ed..0000000000000000000000000000000000000000 --- a/src/wng/wncaup.for +++ /dev/null @@ -1,57 +0,0 @@ -C+ WNCAUP.FOR -C WNB 890105 -C -C Revisions: -C WNB 911115 DW: DATA for CHARACTER problem -C HjV 931202 Splitted because of HP-UX 09.01 problem -C with character entry -C - CHARACTER*(*) FUNCTION WNCAUP(TXT) -C -C Convert character to upper case -C -C Result: -C -C C1 = WNCAUP ( TXT_C*:I) Convert first character in TXT to Uppercase -C -C Include files: -C - INCLUDE 'WNG_DEF' -C -C Parameters: -C -C -C Arguments: -C - CHARACTER*(*) TXT !INPUT STRING -C -C Entry points: -C -C -C Function references: -C -C -C Data declarations: -C - CHARACTER*26 LC !LC TABLE - CHARACTER*26 UC !UC TABLE - DATA LC/'abcdefghijklmnopqrstuvwxyz'/ - DATA UC/'ABCDEFGHIJKLMNOPQRSTUVWXYZ'/ -C -C Equivalences: -C -C -C Commons: -C -C- - J=INDEX(LC,TXT(1:1)) - IF (J.NE.0) THEN - WNCAUP=UC(J:J) - ELSE - WNCAUP=TXT(1:1) - END IF -C - RETURN -C -C - END diff --git a/src/wng/wnccae.for b/src/wng/wnccae.for deleted file mode 100644 index 80547628113687c374071c36801c7932ff37642d..0000000000000000000000000000000000000000 --- a/src/wng/wnccae.for +++ /dev/null @@ -1,162 +0,0 @@ -C+ WNCCAE.FOR -C WNB 890111 -C -C Revisions: -C WNB 930325 Cater for unaligned data -C - SUBROUTINE WNCCAE(COUT,CLEN,ICOD1,ICOD2,VALE,COD1,COD2) -C -C Convert a value to a string -C -C Result: -C -C CALL WNCCAE ( COUT_C*:O, CLEN_J:O, ICOD1_J:I, ICOD2_J:I, -C VALE_E:I, COD1_J:I, COD2_J:I) -C Convert the REAL value VALE to a string -C in COUT, setting CLEN to the significant -C length of COUT. The COD's indicate the -C conversion type: -C ICOD1 =1: input in fractions of circles -C =2: input in radians -C =3: input in degrees -C =other: input in radians -C ICOD2 =2: output in degrees (-180<<+180) -C =3: output in d.m.s -C =4: output in h:m:s -C =5: output in degrees (0<<360) -C =other: output in degrees (-180<<+180) -C For output in degrees: -C If COD2 < 0: in G-type format, with: -C COD1 <=0: enough signif. digits -C COD1 >0: COD1 signif. digits -C COD2 >=0: F-type format with COD2 digits -C behind dec. point, and COD1 -C total width -C For output in h:m:s or d.m.s: -C COD1 <=0: rounded h:m:s or d.m.s -C < 3: rounded h or d -C < 5: rounded h:m or d.m -C < 7: rounded h:m:s or d.m.s -C >=7: COD1-6 dec. places in s -C CALL WNCCAD ( COUT_C*:O, CLEN_J:O, ICOD1_J:I, ICOD2_J:I, -C VALD_D:I, COD1_J:I, COD2_J:I) -C As CAE but for DOUBLE PRECISION -C -C Include files: -C - INCLUDE 'WNG_DEF' -C -C Parameters: -C -C -C Arguments: -C - CHARACTER*(*) COUT !OUTPUT STRING - INTEGER CLEN !OUTPUT LENGTH - INTEGER ICOD1,ICOD2 !CONVERSION TYPES - DOUBLE PRECISION VALD !INPUT VALUE - REAL VALE - INTEGER COD1,COD2 !CONVERSION CODES -C -C Function references: -C - INTEGER WNCALN !GET STRING LENGTH - DOUBLE PRECISION WNGDPD,WNGDND !NORMALIZE ANGLES -C -C Data declarations: -C - CHARACTER*40 F1030 !FORMAT STRING - CHARACTER*1 STR !SEPARATOR CHARACTER -C- -C -C WNCCAE -C - CALL WNGMV(LB_E,VALE,R0) !UNALIGNED POSSIBLE - D0=R0 !INPUT VALUE - GOTO 10 -C -C WNCCAD -C - ENTRY WNCCAD(COUT,CLEN,ICOD1,ICOD2,VALD,COD1,COD2) -C - CALL WNGMV(LB_D,VALD,D0) !UNALIGNED POSSIBLE - GOTO 10 -C - 10 CONTINUE - COUT=' ' !RESULT - IF (ICOD1.EQ.1) THEN !FRACTIONS - D0=D0*360D0 - ELSE IF (ICOD1.NE.3) THEN !RADIANS - D0=D0*360D0/DPI2 - END IF - IF (ICOD2.LT.3 .OR. ICOD2.GT.5) THEN !+-DDD.DDDDD - CALL WNCCDS(COUT,CLEN,WNGDND(D0),COD1,COD2) !OUTPUT - ELSE IF (ICOD2.EQ.5) THEN !DDD.DDDDD - CALL WNCCDS(COUT,CLEN,WNGDPD(D0),COD1,COD2) !OUTPUT - ELSE - IF (ICOD2.EQ.4) THEN !HMS - D0=WNGDPD(D0)/15D0 !MAKE HOURS - I=1 - STR=':' - ELSE !DMS - D0=WNGDND(D0) !MAKE DEGREES - IF (ABS(D0).GT.90D0) THEN !MAKE -90<=ANGLE<=+90 - IF (D0.GE.0) THEN - D0=D0-180D0 - ELSE - D0=D0+180D0 - END IF - END IF - I=2 - STR='.' - IF (D0.LT.0) THEN - COUT(1:1)='-' - D0=ABS(D0) - END IF - END IF - IF (COD1.LT.3 .AND. COD1.GT.0) THEN !ONLY HH - WRITE (UNIT=COUT(I:I+1),FMT=1000,ERR=11) INT(D0+.5D0) - 11 CONTINUE - ELSE IF (COD1.LT.5 .AND. COD1.GT.0) THEN !HH.MM - D0=D0+1.D0/120.D0 !ROUND - I1=INT(D0) - I2=INT((D0-I1)*60.D0) - WRITE (UNIT=COUT(I:I+4),FMT=1010,ERR=12) I1,STR,I2 - 12 CONTINUE - ELSE IF (COD1.LT.7) THEN !DD.MM.SS - D0=D0+1./7200. !ROUND - I1=INT(D0) - D0=60.D0*(D0-I1) - I2=INT(D0) - I3=INT(60.D0*(D0-I2)) - WRITE (UNIT=COUT(I:I+7),FMT=1020,ERR=13) - 1 I1,STR,I2,STR,I3 - 13 CONTINUE - ELSE - D0=D0+(10.D0**(6-COD1))/7200.D0 !ROUND - I1=INT(D0) - D0=60.D0*(D0-I1) - I2=INT(D0) - J=MIN(COD1-6,6) - J1=INT(60.D0*(10.D0**J)*(D0-I2)) - WRITE (UNIT=F1030,FMT=1030,ERR=14) J,J - WRITE (UNIT=COUT(I:I+8+J),FMT=F1030,ERR=14) - 1 I1,STR,I2,STR,INT(J1/(10**J)), - 2 MOD(J1,10**J) - 14 CONTINUE - END IF - CLEN=WNCALN(COUT) !OUTPUT LENGTH - END IF -C - RETURN -C -C FORMATS -C - 1000 FORMAT(I2.2) - 1010 FORMAT(I2.2,A1,I2.2) - 1020 FORMAT(I2.2,A1,I2.2,A1,I2.2) - 1030 FORMAT('(I2.2,A1,I2.2,A1,I2.2,''.'',I',I2.2,'.',I2.2,')') -C -C - END - diff --git a/src/wng/wnccst.for b/src/wng/wnccst.for deleted file mode 100644 index 4c607b591949409a921519d9343b36dbe62ca335..0000000000000000000000000000000000000000 --- a/src/wng/wnccst.for +++ /dev/null @@ -1,62 +0,0 @@ -C+ WNCCST.FOR -C WNB 910320 -C -C Revisions: -C - SUBROUTINE WNCCST(TP) -C -C Show computer statistics -C -C Result: -C -C CALL WNCCST( TP_J:I) -C Show computing statistics on TP. -C CALL WNCCSX( TP_J:I, TXT_C*:I) -C Show statistics with text. -C -C Include files: -C - INCLUDE 'WNG_DEF' -C -C Parameters: -C -C -C Arguments: -C - INTEGER TP !OUTPUT TYPE - CHARACTER*(*) TXT !OUTPUT TEXT -C -C Function references: -C -C -C Data declarations: -C - REAL RAR(0:3) !TIMES - INTEGER IAR(0:3) !COUNTS -C- - CALL WNGCST(RAR,IAR) !GET COMPUTING STATISTICS - CALL WNCTXT(TP,'At !%T Elapsed: !EHD8 CPU: !EHD8 '// - 1 'I/O: !UJ Faults: !UJ', - 1 RAR(0)/240.,RAR(1)/240.,IAR(0),IAR(1)) -C - RETURN -C -C WNCCSX -C - ENTRY WNCCSX(TP,TXT) -C - CALL WNGCST(RAR,IAR) !GET COMPUTING STATISTICS - IF (TXT.EQ.' ') THEN - CALL WNCTXT(TP,'At !%T Elapsed: !EHD8 CPU: !EHD8 '// - 1 'I/O: !UJ Faults: !UJ', - 1 RAR(0)/240.,RAR(1)/240.,IAR(0),IAR(1)) - ELSE - CALL WNCTXT(TP,'!AS at !%T (Wall: !EHD8 CPU: !EHD8 '// - 1 'I/O: !UJ P/F: !UJ)', - 1 TXT,RAR(0)/240.,RAR(1)/240.,IAR(0),IAR(1)) - END IF -C - RETURN -C -C - END diff --git a/src/wng/wnccvs.for b/src/wng/wnccvs.for deleted file mode 100644 index 26ce0512acc8cd6f3a546549ac37caffd2d0a086..0000000000000000000000000000000000000000 --- a/src/wng/wnccvs.for +++ /dev/null @@ -1,162 +0,0 @@ -C+ WNCCVS.FOR -C WNB 890111 -C -C Revisions: -C WNB 911115 DATA for CHARACTER problem -C WNB 920303 SUN rearrangement for segmentation fault compiler -C see also _X -C WNB 930325 Cater for unaligned data -C WNB 931216 Make **** appear less frequent -C CMV 940203 Prevent HP from stripping 0 to blank -C - SUBROUTINE WNCCDS(COUT,CLEN,VALD,COD1,COD2) -C -C Convert a value to a string -C -C Result: -C -C CALL WNCCDS ( COUT_C*:O, CLEN_J:O, VALD_D:I, COD1_J:I, COD2_J:I) -C Convert the DOUBLE PRECISION value VALD to a -C string in COUT, setting CLEN to the significant -C length of COUT. The COD's indicate the -C conversion type: -C If COD2 < 0: in G-type format, with: -C COD1 <=0: enough signif. digits -C COD1 >0: COD1 signif. digits -C COD2 >=0: F-type format with COD2 digits -C behind dec. point, and COD1 -C total width -C CALL WNCCES ( COUT_C*:O, CLEN_J:O, VALE_E:I, COD1_J:I, COD2_J:I) -C As CDS for REAL value -C CALL WNCCJS ( COUT_C*:O, CLEN_J:O, VALJ_J:I, COD1_J:I) -C Convert INTEGER value VALJ to a string -C in COUT, setting CLEN to the significant -C length of COUT. COD1 indicates the conversion -C type: -C COD1= 1 signed decimal -C 2 unsigned decimal -C 3 octal -C 4 hexadecimal -C 5 zero filled decimal -C 6 logical (YES or NO) -C CALL WNCCIS ( COUT_C*:O, CLEN_J:O, VALI_I:I, COD1_J:I) -C As CJS for INTEGER*2 value -C CALL WNCCKS ( COUT_C*:O, CLEN_J:O, VALK_K:I, COD1_J:I) -C As CJS for INTEGER*2 value -C CALL WNCCBS ( COUT_C*:O, CLEN_J:O, VALB_B:I, COD1_J:I) -C As CJS for INTEGER*1 value -C CALL WNCCAS ( COUT_C*:O, CLEN_J:O, VALC_B(*):I, COD1_J:I) -C As CJS for character string in VALC, of length -C COD1. -C -C Include files: -C - INCLUDE 'WNG_DEF' -C -C Parameters: -C -C -C Arguments: -C - CHARACTER*(*) COUT !OUTPUT STRING - INTEGER CLEN !OUTPUT LENGTH - DOUBLE PRECISION VALD !INPUT VALUE - REAL VALE - INTEGER COD1,COD2 !CONVERSION CODES -C -C Function references: -C - INTEGER WNCALN !LENGTH STRING -C -C Data declarations: -C - CHARACTER*16 F1000 !FORMAT STRING -C- - J2=17 !INDICATE DOUBLE PRECISION - CALL WNGMV(LB_D,VALD,D0) !UNALIGNED POSSIBLE - GOTO 10 -C -C WNCCES -C - ENTRY WNCCES(COUT,CLEN,VALE,COD1,COD2) -C - J2=7 !INDICATE REAL - CALL WNGMV(LB_E,VALE,R0) !UNALIGNED POSSIBLE - D0=R0 - GOTO 10 -C - 10 CONTINUE - COUT=' ' !RESULT - L0=.FALSE. !DO NOT TRIM - IF (COD2.LT.0) THEN !G-FORMAT - IF (COD1.GT.0) THEN - J2=COD1 !SIGNIFICANT # OF DIGITS - ELSE - L0=.TRUE. !TRIM - END IF - D1=ABS(D0) !CHECK RANGE - IF (D1.EQ.0D0) THEN !0 VALUE, USE F-FORMAT - WRITE (UNIT=F1000,FMT=1000,ERR=20) 7+J2,J2 !MAKE F-FORMAT ITEM - ELSE IF (D1.LT.0.001 .OR. D1.GE.10.**(J2+3)) THEN !USE E-FORMAT - WRITE (UNIT=F1000,FMT=1010,ERR=20) 7+J2,J2 !MAKE E-FORMAT ITEM - ELSE !IN F-FORMAT - I1=MAX(0,J2-1-INT(LOG10(D1))) - WRITE (UNIT=F1000,FMT=1000,ERR=20) 7+J2,I1 !MAKE F-FORMAT ITEM - END IF - ELSE - IF (COD1.LT.COD2+3) THEN - J2=COD2+3 !MIN. F-FORMAT WIDTH - L0=.TRUE. !AND TRIM - ELSE - J2=COD1 - END IF - D1=ABS(D0) - IF (D1.LT.10.**(J2-COD2-2)) THEN !CAN FIT - WRITE (UNIT=F1000,FMT=1000,ERR=20) J2,COD2 !MAKE F-FORMAT ITEM - ELSE IF (J2.GT.7) THEN !TRY E - WRITE (UNIT=F1000,FMT=1010,ERR=20) J2,J2-7 !MAKE E-FORMAT ITEM - ELSE !F AGAIN - WRITE (UNIT=F1000,FMT=1000,ERR=20) J2,COD2 !MAKE F-FORMAT ITEM - END IF - END IF - WRITE (UNIT=COUT,FMT=F1000,ERR=20) D0 !CONVERT VALUE -C -C FINISH -C - 20 CONTINUE - IF (COUT.NE.' ') THEN - DO WHILE (COUT(:1).EQ.' ') !DELETE LEADING SPACES - COUT=COUT(2:) - END DO - END IF - IF (L0) THEN !MINIMIZE LENGTH - I=INDEX(COUT,'E') - IF (I.EQ.0) I=WNCALN(COUT)+1 !END - I1=INDEX(COUT,'.') - IF (I1.GT.0) THEN - DO J=I1+1,I-1 - IF (COUT(J:J).NE.'0') I1=J - END DO - COUT(I1+1:)=COUT(I:) - END IF - END IF - I=INDEX(COUT,'.') !DELETE TRAILING . - IF (I.GT.0) THEN - IF (COUT(I:).EQ.'.') THEN - IF (I.EQ.1) THEN - COUT='0' !If just . should be 0 - ELSE - COUT(I:)=' ' - END IF - END IF - END IF - CLEN=WNCALN(COUT) !SET OUTPUT LENGTH -C - RETURN -C -C Formats -C - 1000 FORMAT('(F',I3.3,'.',I3.3,')') !CONVERT F_FORMAT - 1010 FORMAT('(E',I3.3,'.',I3.3,')') !CONVERT G AS E -C - END diff --git a/src/wng/wnccvs_x.for b/src/wng/wnccvs_x.for deleted file mode 100644 index ea543a5b2c6bffd35d08d57b5dca0498e1622154..0000000000000000000000000000000000000000 --- a/src/wng/wnccvs_x.for +++ /dev/null @@ -1,182 +0,0 @@ -C+ WNCCVS_X.FOR -C WNB 890111 -C -C Revisions: -C WNB 911115 DATA for CHARACTER problem -C WNB 920303 SUN rearrangement for segmentation fault compiler -C HjV 920529 Non-logical expression in IF/DO WHILE statement not -C allowed on HP -C WNB 930325 Cater for unaligned data -C CMV 930903 Change formats for Sun/RUG -C - SUBROUTINE WNCCAS(COUT,CLEN,VALC,COD1) -C -C Convert a value to a string -C -C Result: -C -C CALL WNCCDS ( COUT_C*:O, CLEN_J:O, VALD_D:I, COD1_J:I, COD2_J:I) -C Convert the DOUBLE PRECISION value VALD to a -C string in COUT, setting CLEN to the significant -C length of COUT. The COD's indicate the -C conversion type: -C If COD2 < 0: in G-type format, with: -C COD1 <=0: enough signif. digits -C COD1 >0: COD1 signif. digits -C COD2 >=0: F-type format with COD2 digits -C behind dec. point, and COD1 -C total width -C CALL WNCCES ( COUT_C*:O, CLEN_J:O, VALE_E:I, COD1_J:I, COD2_J:I) -C As CDS for REAL value -C CALL WNCCJS ( COUT_C*:O, CLEN_J:O, VALJ_J:I, COD1_J:I) -C Convert INTEGER value VALJ to a string -C in COUT, setting CLEN to the significant -C length of COUT. COD1 indicates the conversion -C type: -C COD1= 1 signed decimal -C 2 unsigned decimal -C 3 octal -C 4 hexadecimal -C 5 zero filled decimal -C 6 logical (YES or NO) -C CALL WNCCIS ( COUT_C*:O, CLEN_J:O, VALI_I:I, COD1_J:I) -C As CJS for INTEGER*2 value -C CALL WNCCKS ( COUT_C*:O, CLEN_J:O, VALK_K:I, COD1_J:I) -C As CJS for INTEGER*2 value -C CALL WNCCBS ( COUT_C*:O, CLEN_J:O, VALB_B:I, COD1_J:I) -C As CJS for INTEGER*1 value -C CALL WNCCAS ( COUT_C*:O, CLEN_J:O, VALC_B(*):I, COD1_J:I) -C As CJS for character string in VALC, of length -C COD1. -C -C Include files: -C - INCLUDE 'WNG_DEF' -C -C Parameters: -C -C -C Arguments: -C - CHARACTER*(*) COUT !OUTPUT STRING - INTEGER CLEN !OUTPUT LENGTH - INTEGER VALJ - INTEGER VALK - INTEGER*2 VALI - BYTE VALB - BYTE VALC(*) - INTEGER COD1 !CONVERSION CODES -C -C Function references: -C - INTEGER WNCALN !LENGTH STRING -C -C Data declarations: -C - CHARACTER*10 FX(3) !HEXA FORMATS - CHARACTER*10 FO(3) !OCTAL FORMATS - DATA FX/'(Z2.2)','(Z4.4)','(Z8.8)'/ - DATA FO/'(O3.3)','(O6.6)','(O11.11)'/ - INTEGER*2 II0 -C- - CALL WNGMTS(COD1,VALC,COUT) !MOVE CHAR. STRING -C -C LENGTH -C - IF (COUT.NE.' ') THEN - DO WHILE (COUT(1:1).EQ.' ') - COUT(1:)=COUT(2:) - END DO - END IF - CLEN=WNCALN(COUT) -C - RETURN -C -C WNCCJS -C - ENTRY WNCCJS(COUT,CLEN,VALJ,COD1) -C - J1=3 !LENGTH TYPE - CALL WNGMV(LB_J,VALJ,J2) !UNALIGNED POSSIBLE - J3=-1 !FOR UNSIGNED - GOTO 30 -C -C WNCCIS -C - ENTRY WNCCIS(COUT,CLEN,VALI,COD1) -C - J1=2 !LENGTH TYPE - CALL WNGMV(LB_I,VALI,II0) !UNALIGNED POSSIBLE - J2=II0 !VALUE - J3=(2**L_I)-1 !FOR UNSIGNED - GOTO 30 -C -C WNCCBS -C - ENTRY WNCCBS(COUT,CLEN,VALB,COD1) -C - J1=1 !LENGTH TYPE - J2=VALB !VALUE - J3=(2**L_B)-1 !FOR UNSIGNED - GOTO 30 -C -C WNCCKS -C - ENTRY WNCCKS(COUT,CLEN,VALK,COD1) -C - J1=3 !LENGTH TYPE - CALL WNGMV(LB_K,VALK,J2) !UNALIGNED POSSIBLE - J3=-1 !FOR UNSIGNED - GOTO 30 -C -C DO -C - 30 CONTINUE - COUT=' ' !FILL BLANK - IF (COD1.LE.1 .OR. COD1.GT.6) THEN !SIGNED DECIMAL - WRITE (UNIT=COUT,FMT=1100,ERR=40) J2 - ELSE IF (COD1.EQ.5) THEN !ZERO FILLED DECIMAL - WRITE (UNIT=COUT,FMT=1110,ERR=40) J2 - ELSE IF (COD1.EQ.2) THEN !UNSIGNED DECIMAL - J2=IAND(J2,J3) !GET RID OF SIGN - IF (J2.GE.0) THEN - WRITE(UNIT=COUT,FMT=1100,ERR=40) J2 - ELSE - J=IAND('7fffffff'X,ISHFT(J2,-1)) !FIRST PART*5 - J3 = 2*MOD(J2,5)+IAND(J2,'00000001'X) !LAST DIGIT - WRITE(UNIT=COUT,FMT=1120,ERR=40) J/5,J3 - END IF - ELSE IF (COD1.EQ.4) THEN !HEXA - J2=IAND(J2,J3) !SELECT PART - WRITE(UNIT=COUT,FMT=FX(J1),ERR=40) J2 - ELSE IF (COD1.EQ.3) THEN !OCTAL - WRITE(UNIT=COUT,FMT=FO(J1),ERR=40) J2 - ELSE IF (COD1.EQ.6) THEN !LOGICAL - IF (IAND(J2,1).NE.0) THEN - COUT='YES' - ELSE - COUT='NO' - END IF - END IF -C -C LENGTH -C - 40 CONTINUE - IF (COUT.NE.' ') THEN - DO WHILE (COUT(1:1).EQ.' ') - COUT(1:)=COUT(2:) - END DO - END IF - CLEN=WNCALN(COUT) -C - RETURN -C -C Formats -C -C - 1100 FORMAT(I16) !CONVERT INTEGER - 1110 FORMAT(I16.10) !CONVERT ZERO FILLED - 1120 FORMAT(I16,I1.1) !SEPARATE FINAL HEXA DIGIT -C -C - END diff --git a/src/wng/wnccxs.for b/src/wng/wnccxs.for deleted file mode 100644 index 49b4173b9358b758c278a2526a0fea2322851a4e..0000000000000000000000000000000000000000 --- a/src/wng/wnccxs.for +++ /dev/null @@ -1,76 +0,0 @@ -C+ WNCCXS.FOR -C WNB 890111 -C -C Revisions: -C WNB 930325 Unaligned possible -C JPH 960625 Make sqrt(-1) 'i' i.s.o. 'I' -C - SUBROUTINE WNCCXS(COUT,CLEN,VALE,COD1,COD2) -C -C Convert a complex value to a string -C -C Result: -C -C CALL WNCCXS ( COUT_C*:O, CLEN_J:O, VALE_R4(2):I, COD1_J:I, COD2_J:I) -C Convert the COMPLEX value VALE to a string -C in COUT, setting CLEN to the significant -C length of COUT. The COD's indicate the -C conversion type (see WNCCVS) -C CALL WNCCYS ( COUT_C*:O, CLEN_J:O, VALD_R8(2):I, COD1_J:I, COD2_J:I) -C As CXS for DOUBLE COMPLEX value -C -C Include files: -C - INCLUDE 'WNG_DEF' -C -C Parameters: -C -C -C Arguments: -C - CHARACTER*(*) COUT !OUTPUT STRING - INTEGER CLEN !OUTPUT LENGTH - DOUBLE PRECISION VALD(2) !INPUT VALUE - REAL VALE(2) - INTEGER COD1,COD2 !CONVERSION CODES -C -C Function references: -C - INTEGER WNCALN !LENGTH STRING -C -C Data declarations: -C - REAL EVAL(2) !VALUE - DOUBLE PRECISION DVAL(2) !VALUE -C- -C -C WNCCXS -C - CALL WNGMV(LB_X,VALE,EVAL) !UNALIGNED POSSIBLE - DVAL(1)=EVAL(1) !COMPLEX - DVAL(2)=EVAL(2) - GOTO 10 -C -C WNCCYS -C - ENTRY WNCCYS(COUT,CLEN,VALD,COD1,COD2) -C - CALL WNGMV(LB_Y,VALD,DVAL) !UNALIGNED POSSIBLE - GOTO 10 -C - 10 CONTINUE - CALL WNCCDS(COUT,CLEN,DVAL,COD1,COD2) !REAL PART - CLEN=CLEN+1 - IF (DVAL(2).GE.0) THEN - COUT(CLEN:CLEN)='+' - ELSE - COUT(CLEN:CLEN)='-' - END IF - CALL WNCCDS(COUT(CLEN+1:),J,ABS(DVAL(2)),COD1,COD2) !IMAG. PART - CLEN=WNCALN(COUT)+1 !OUTPUT LENGTH - COUT(CLEN:CLEN)='i' -C - RETURN -C -C - END diff --git a/src/wng/wncexh.for b/src/wng/wncexh.for deleted file mode 100644 index af588ff87698bf46e9de46ccd2b752d35256e36a..0000000000000000000000000000000000000000 --- a/src/wng/wncexh.for +++ /dev/null @@ -1,42 +0,0 @@ -C+ WNCEXH.FOR -C WNB 890202 -C -C Revisions: -C - SUBROUTINE WNCEXH -C -C Exit handler for WNC routines -C -C Result: -C -C CALL WNCEXH Close and dispose all printfiles -C -C Include files: -C - INCLUDE 'WNG_DEF' -C -C Parameters: -C -C -C Arguments: -C -C -C Function references: -C -C -C Data declarations: -C -C -C Equivalences: -C -C -C Commons: -C -C- - CALL WNCFCL(F_ALL) !CLOSE ALL FILES -C - RETURN -C -C - END - diff --git a/src/wng/wncfad.for b/src/wng/wncfad.for deleted file mode 100644 index e507de821cee5874292556b3ca160f8bfcc26c75..0000000000000000000000000000000000000000 --- a/src/wng/wncfad.for +++ /dev/null @@ -1,78 +0,0 @@ -C+ WNCFAD.FOR -C WNB 880725 -C -C Revisions: -C GvD 920506 Do right adjust backwards (went wrong on SUN) -C - SUBROUTINE WNCFAD(FRST,WID,FRL,FRW) -C -C Adjust string in a field -C -C Result: -C -C CALL WNCFAD(FRST_C*:IO,WID_J:I,FRL_J:I,FRW_J:IO) -C Adjust the string FRST(1:FRW) in a field -C given by width WID. -C If WID=0: trim string to FRST(1:) and set FRW -C If WID>0: right adjust to FRST(1:WID) set FRW -C If WID<0: left adjust using |WID|. -C -C Include files: -C - INCLUDE 'WNG_DEF' -C -C Parameters: -C -C -C Arguments: -C - CHARACTER*(*) FRST !INPUT STRING - INTEGER WID !ADJUSTMENT WIDTH - INTEGER FRL !LENGTH FRST - INTEGER FRW !INPUT POINTER -C -C Function references: -C - INTEGER WNCAL0 !GET STRING LENGTH -C -C Data declarations: -C -C -C Equivalences: -C -C -C Commons: -C -C- - IF (FRW.GT.0) THEN - DO WHILE(FRST(1:1).EQ.' ' .AND. FRST(:FRW).NE.' ') !TRIM FIRST - FRST(1:FRW)=FRST(2:FRW) !TRIM - END DO - FRW=WNCAL0(FRST(1:FRW)) - ELSE - FRW=0 - END IF - IF (FRW.GT.0) THEN - IF (WID.GT.0) THEN !RIGHT ADJUST - I1=MIN(WID,FRL) !END STRING - I=I1-FRW !SPACES TO ADD - IF (I.GT.0) THEN - DO I2=I1,I+1,-1 - FRST(I2:I2)=FRST(I2-I:I2-I) - END DO - FRST(1:I)=' ' - ELSE IF (I.LT.0) THEN !TRUNCATE - FRST(1:I1)=FRST(FRW-I1+1:FRW) - END IF - FRW=I1 !NEW LENGTH - ELSE IF (WID.LT.0) THEN !LEFT ADJUST - I1=MIN(-WID,FRL) !END STRING - FRST(1:I1)=FRST(1:FRW) !ADJUST OR TRUNCATE - FRW=I1 !NEW LENGTH - END IF - END IF -C - RETURN -C -C - END diff --git a/src/wng/wncfcl.fsc b/src/wng/wncfcl.fsc deleted file mode 100644 index 79fea1182e35aa255f9965de10e09fb40ac4f30b..0000000000000000000000000000000000000000 --- a/src/wng/wncfcl.fsc +++ /dev/null @@ -1,124 +0,0 @@ -C+ WNCFCL.FOR -C WNB 890202 -C -C Revisions: -C WNB 921222 Change YES operation -C JPH 930602 .for --> .fsc: System-dependent move and concatenation -C to avoid WNGFEX overhead -C CMV 930927 If logfile does not have extension .LOG: rename in -C stead of link-and-purge -C CMV 940125 Add call to tflush to keep redirected output on HP -C - SUBROUTINE WNCFCL(COD) -C -C Close print file -C -C Result: -C -C CALL WNCFCL ( COD_J:I) Close print files specified by COD. -C -C Include files: -C - INCLUDE 'WNG_DEF' - INCLUDE 'WNC_DEF' -C -C Parameters: -C -C -C Arguments: -C - INTEGER COD !OPEN CODE -C -C Function references: -C - INTEGER WNCALN -C -C Data declarations: -C -C -C Equivalences: -C -C -C Commons: -C -C- - J=COD !COPY CODE - I=-1 !FILE COUNT - DO WHILE (IAND(J,F_ALL).NE.0) !ALL FILES - IF (I.EQ.-1) THEN !SELECT CODE - J1=F_T - ELSE IF (I.EQ.0) THEN - J1=F_P - ELSE IF (I.GT.F_FILN) THEN - J=0 - J1=F_0 - ELSE - J1=ISHFT(F_0,I-1) - END IF - IF (IAND(J,J1).NE.0) THEN !TO DO -#ifdef wn_un__ - IF (I.EQ.-1) CALL TFLUSH() !Flush output -#endif - IF (CLUN(I).NE.0) THEN !AND OPEN - IF (I.EQ.-1) THEN !SCREEN - ELSE IF (I.EQ.0) THEN !LOG - IF (LOGCD.EQ.F_NO) THEN !NO LOG - CLOSE (UNIT=CLUN(I),ERR=10,STATUS='DELETE') - ELSE - CLOSE (UNIT=CLUN(I),ERR=10,STATUS='KEEP') - IF (LOGCD.EQ.F_SP) THEN !SPOOL - CALL WNGSSP('WNGFEX SP',CFN(I),CFFN(I),' ') - ELSE IF (LOGCD.EQ.F_CAT) THEN !CONCATENATE -#ifdef wn_un__ - CALL WNCSYS('touch '//CFFN(I)//'; cat',CFN(I),CFFN(I),' ') -#else - CALL WNGSSP('WNGFEX CC',CFN(I),CFFN(I),' ') -#endif -C -C If not .LOG: just rename, else link and purge -C - ELSE IF (CFFN(I)(WNCALN(CFFN(I))-3:).NE. - 1 '.LOG') THEN -#ifdef wn_un__ - CALL WNCSYS('mv',CFN(I),CFFN(I),' ') -#else - CALL WNGSSP('WNGFEX RE',CFN(I),CFFN(I),' ') -#endif - ELSE !LINK AND PURGE - CALL WNGSSP('WNGFEX LR',CFN(I),CFFN(I),' ') - END IF - END IF - ELSE !FILE - IF (CDIS(I).EQ.F_NO) THEN !NO LOG - CLOSE (UNIT=CLUN(I),ERR=10,STATUS='DELETE') - ELSE - CLOSE (UNIT=CLUN(I),ERR=10,STATUS='KEEP') - IF (CDIS(I).EQ.F_SP) THEN !SPOOL - CALL WNGSSP('WNGFEX SP',CFN(I),CFFN(I),' ') - ELSE IF (CDIS(I).EQ.F_CAT) THEN !CONCATENATE -#ifdef wn_un__ - CALL WNCSYS('touch '//CFFN(I)//'; cat',CFN(I),CFFN(I),' ') - ELSE !RENAME - CALL WNCSYS('mv',CFN(I),CFFN(I),' ') -#else - CALL WNGSSP('WNGFEX CC',CFN(I),CFFN(I),' ') - ELSE !RENAME - CALL WNGSSP('WNGFEX RE',CFN(I),CFFN(I),' ') -#endif - END IF - END IF - END IF - 10 CONTINUE - IF (I.NE.-1) CALL WNGLUF(CLUN(I)) !FREE LUN - CLUN(I)=0 !SET CLOSE - END IF - END IF -C - J=IAND(J,NOT(J1)) !DELETE BIT - I=I+1 !COUNT - END DO -C - RETURN -C -C - END diff --git a/src/wng/wncfhd.cun b/src/wng/wncfhd.cun deleted file mode 100644 index 40eca803bf9f391901f52a6e432ea7af94ed7a66..0000000000000000000000000000000000000000 --- a/src/wng/wncfhd.cun +++ /dev/null @@ -1,149 +0,0 @@ -/* wncfhd.cun -. WNB 920120 -. -. Revisions: -. WNB 921216 Make CUN -. WNB 930527 Correct error in string codes in header line -. CMV 940111 Changed for alpha - CMV 031205 Changed for stdarg -... */ -/* -. Include files: -... */ -/*#include <varargs.h>*/ -#include <stdarg.h> - -#define MXNARG 250 -#define CMLL 132L -/* -. Set/reset header line with formatting (FAO with extensions) information. -. (see WNCFHD_X for details) -... */ -#ifdef wn_al__ - void wncfd1_(va_alist) -#else - void wncfhd_(int* c_i,int* n_i,char* t_i,...) -#endif -/* -. Result: -. -. CALL WNCFHD( CODE_J:I, N_J:I, TXT_C*:I, ARG....) -. Print and/or type and/or output to file -. (depending on F_* bits set in CODE) the -. TXT, using the arguments ARG specified as -. interpreted by codes in TXT; and set TXT at -. header line N (if >0), or reset header line -. (N<0). Header line will also always contain -. program name/version, date/time and page -. number. -... */ -/* -. Arguments: -... */ -/* va_dcl */ /* address list to get */ -{ -/* -. Parameters: -... */ -/* -. Function references: -... */ - void wncfhd_x_(); /* routine to call */ - void wnctxs_x_(); -/* -. Data declarations: -... */ - va_list ap; /* list argument ptr */ -#ifdef wn_da__ - int args[2*MXNARG+4]; /* argument list */ - int argl[2*MXNARG+4]; -#else - char *args[2*MXNARG+4]; /* argument list */ - char *argl[2*MXNARG+4]; /* argument list */ -#endif - int i = 0; /* argument count */ - int i1 = 0; /* string counts */ - char *p; /* pointer to argument */ - char lstr[CMLL]; /* header line */ - int *code,*n; /* Save first two args */ - char *txt; /* and third one */ - -/*- */ -/* -. Get argument list -... */ - va_start(ap,t_i); - args[MXNARG] = 0; /* number arguments */ - args[MXNARG-1] = 0; /* count for strings */ - args[MXNARG-2] = 0; /* number strings */ - while (i < MXNARG) - { i++; - if (i==1) { - p = (char*)c_i; - } else if (i==2) { - p = (char*)n_i; - } else if (i==3) { - p = (char*)t_i; - } else { - p = va_arg(ap, char *); - } -#ifdef wn_da__ - args[MXNARG + i] = (int )p; -#else - args[MXNARG + i] = p; -#endif - if (i==1) code=(int *)p; - if (i==2) n =(int *)p; - if (i==3) txt =p; - - if (p > 0 && p < 65536) break; /* found string length */ - args[MXNARG] = i; /* found argument */ - } -/* -. Get string lengths -... */ - args[MXNARG-3] = args[MXNARG + i]; /* possible length */ - while (i1 < MXNARG && i1 < (int)args[MXNARG]) { - if (p <= 0 || p >= 65536) break; /* no more string */ - i1++; - args[MXNARG - 2] = i1; /* count strings */ - p = va_arg(ap, char *); /* next length */ -#ifdef wn_da__ - args[MXNARG -3 - i1] = (int )p; -#else - args[MXNARG -3 - i1] = p; -#endif - } - va_end(ap); -/* -. Copy shortened argument list -... */ - argl[MXNARG] = args[MXNARG] -1; /* delete one */ - for (i = 1; i <= (int)argl[MXNARG]; i++) /* arguments */ - argl[MXNARG + i] = args[MXNARG + 1 + i]; - argl[MXNARG - 1] = args[MXNARG - 1]; /* count strings seen */ - for (i = 1; i <= (int)args[MXNARG - 2]; i++) /* lengths */ - argl[MXNARG - 3 - i] = args[MXNARG - 2 - i]; - argl[MXNARG-2] = args[MXNARG]+1; /* add one */ -/* -. Call routine -... */ -#ifdef wn_hp__ - wnctxs_x_( lstr, -#else - wnctxs_x_( &lstr, -#endif - txt, &argl[MXNARG], - CMLL, args[MXNARG - 3]); /* make text */ - wncfhd_x_( code, n, lstr, CMLL); - return; -} -/* -. -... */ - - - - - - diff --git a/src/wng/wncfhd.fal b/src/wng/wncfhd.fal deleted file mode 100644 index bac68cf81483398f9c9c4f398c8a57e1ed5e8055..0000000000000000000000000000000000000000 --- a/src/wng/wncfhd.fal +++ /dev/null @@ -1,80 +0,0 @@ -C+ WNCFHD.FAL -C WNB 890713 -C -C Revisions: -C WNB 910307 FX compiler bug -C - SUBROUTINE WNCFHD(CODE,N) -C -C Set/reset header line with formatting (FAO with extensions) information. -C (see WNCFHD_X for details) -C -C Result: -C -C CALL WNCFHD( CODE_J:I, N_J:I, TXT_C*:I [, ARG.......]) -C Print (bit1=1 of CODE) and/or type (bit0=1) -C and/or output to file (bit8-31=1) -C the string, using the arguments specified -C by ARG.... , as interpreted by codes in TXT, -C and set TXT at header line N (if >0), or reset -C header line (N<0). Header line 1 will also -C always contain program name/version, date/time -C and page number. -C -C Include files: -C - INCLUDE 'WNG_DEF' - INCLUDE 'WNC_DEF' -C -C Parameters: -C - INTEGER MXNARG !MAX. # OF ARG ALLOWED - PARAMETER (MXNARG=250) -C -C Arguments: -C - INTEGER CODE !PRINT/TYPE CODE - INTEGER N !HEADER LINE # -C -C Function references: -C - INTEGER WNGARG !GET CALL LIST ADDRESS - INTEGER WNGARA !GET ADDRESS OF ARGUMENT -C -C Data declarations: -C - INTEGER ARGL(-MXNARG-2:MXNARG+2) !ARG. LIST - INTEGER ARGL1(-3:3) !INTERMEDIATE ARG. LIST - CHARACTER*(CMLL) TXTS !HEADER LINE - EXTERNAL WNCTXS_X !ROUTINE TO DO -C -C Equivalences: -C -C -C Commons: -C -C- -C -C WNCFHD -C - J=WNGARG() - CALL WNGARL(%VAL(J),ARGL(0)) !MAKE ARGUMENT LIST - ARGL(0)=ARGL(0)-1 !DELETE CODE ARG. - DO I=1,ARGL(0) !SHIFT ARGUMENTS - ARGL(I)=ARGL(I+1) - END DO - ARGL1(1)=WNGARA(TXTS) !SET ADDRESS TXTS - ARGL1(2)=ARGL(2) !ADDRESS TXT - ARGL1(3)=WNGARA(ARGL(0)) !ARGUMENT LIST - ARGL1(0)=3 !# OF ARGUMENTS - J=LEN(TXTS) !LENGTH TXTS - ARGL1(-3)=WNGARA(J) - ARGL1(-2)=ARGL(-ARGL(0)+1) !LENGTH TXT - ARGL1(-1)=0 - CALL WNGARX(WNCTXS_X,ARGL1(0)) !MAKE FULL STRING - CALL WNCFHD_X(CODE,N,TXTS) !DO HEADER -C - RETURN -C -C - END diff --git a/src/wng/wncfhd.fvx b/src/wng/wncfhd.fvx deleted file mode 100644 index 33b9c6170a84dcd4b1ae3a8b480fb118a76c42f8..0000000000000000000000000000000000000000 --- a/src/wng/wncfhd.fvx +++ /dev/null @@ -1,68 +0,0 @@ -C+ WNCFHD.FVX -C WNB 890417 -C -C Revisions: -C - SUBROUTINE WNCFHD(CODE,N,TXT) -C -C Set/reset header line with formatting (FAO with extensions) information. -C (see WNCFHD_X for details) -C -C Result: -C -C CALL WNCFHD( CODE_J:I, N_J:I, TXT_C*:I, ARG.......) -C Print (bit1=1 of CODE) and/or type (bit0=1) -C and/or output to file (bit8-31=1) -C the string, using the arguments specified -C by ARG.... , as interpreted by codes in TXT, -C and set TXT at header line N (if >0), or reset -C header line (N<0). Header line 1 will also -C always contain program name/version, date/time -C and page number. -C -C Include files: -C - INCLUDE 'WNG_DEF' - INCLUDE 'WNC_DEF' -C -C Parameters: -C - INTEGER MXNARG !MAX. # OF ARG ALLOWED - PARAMETER (MXNARG=250) -C -C Arguments: -C - INTEGER CODE !PRINT/TYPE CODE - INTEGER N !HEADER LINE # - CHARACTER*(*) TXT !TEXT TO BE CONVERTED, OUTPUT -C -C Function references: -C - INTEGER WNGARG !GET CALL LIST ADDRESS -C -C Data declarations: -C - INTEGER ARGL(0:MXNARG+2) !ARG. LIST - CHARACTER*(CMLL) TXTS !HEADER LINE -C -C Equivalences: -C -C -C Commons: -C -C- -C -C WNCFHD -C - CALL WNGARL(%VAL(WNGARG()),ARGL(0)) !MAKE ARGUMENT LIST - ARGL(0)=ARGL(0)-1 !DELETE CODE ARG. - DO I=1,ARGL(0) - ARGL(I)=ARGL(I+1) - END DO - CALL WNCTXS_X(TXTS,TXT,ARGL(0)) !GET COMPLETE TEXT LINE - CALL WNCFHD_X(CODE,N,TXTS) !DO -C - RETURN -C -C - END diff --git a/src/wng/wncfhd_x.for b/src/wng/wncfhd_x.for deleted file mode 100644 index b54ca45d1991588d6afd5501abde14d4aff5058f..0000000000000000000000000000000000000000 --- a/src/wng/wncfhd_x.for +++ /dev/null @@ -1,81 +0,0 @@ -C+ WNCFHD_X.FOR -C WNB 890417 -C -C Revisions: -C - SUBROUTINE WNCFHD_X(COD,N,TXT) -C -C Set/reset header lines -C -C Result: -C -C CALL WNCFHD_X ( COD_J:I, N_J:I, TXT_C*:I) -C Set (N>0) or reset (<0) header line N, -C for files specified by COD, using TXT. -C -C Include files: -C - INCLUDE 'WNG_DEF' - INCLUDE 'WNC_DEF' -C -C Parameters: -C -C -C Arguments: -C - INTEGER COD !FILE CODE - INTEGER N !LINE NUMBER - CHARACTER*(*) TXT !HEADER LINE TEXT -C -C Function references: -C -C -C Data declarations: -C -C -C Equivalences: -C -C -C Commons: -C -C- - IF (N.EQ.0 .OR. ABS(N).GT.CMPH) RETURN !UNKNOWN HEADER LINE - J=COD !COPY CODE - I=-1 !FILE COUNT - DO WHILE (IAND(J,F_ALL).NE.0) !ALL FILES - IF (I.EQ.-1) THEN !SELECT CODE - J1=F_T - ELSE IF (I.EQ.0) THEN - J1=F_P - ELSE - J1=ISHFT(F_0,I-1) - END IF - IF (IAND(J,J1).NE.0) THEN !TO DO - IF (N.GT.0) THEN !SET HEADER LINE - CPH(N,I)=TXT !SET LINE - CSPH(N,I)='1' !SET SET - CHPH(I)=MAX(N,CHPH(I)) !HIGHEST LINE SET - ELSE !RESET - CPH(-N,I)=' ' !EMPTY LINE - CSPH(-N,I)='0' !SET NOT SET - IF (-N.EQ.CHPH(I)) THEN !FIND NEW HIGHEST - DO I1=-N,1,-1 - IF (CSPH(I1,I).EQ.'0') THEN - CHPH(I)=I1-1 !NEXT HIGHEST - ELSE - GOTO 10 - END IF - END DO - 10 CONTINUE - END IF - END IF - END IF -C - J=IAND(J,NOT(J1)) !DELETE BIT - I=I+1 !COUNT - END DO -C - RETURN -C -C - END diff --git a/src/wng/wncfop.fsc b/src/wng/wncfop.fsc deleted file mode 100644 index 01776cf08750f8c24f8d0e187a0f4567313b4976..0000000000000000000000000000000000000000 --- a/src/wng/wncfop.fsc +++ /dev/null @@ -1,141 +0,0 @@ -C+ WNCFOP.FOR -C WNB 890111 -C -C Revisions: -C WNB 920120 Make unformatted output for DW -C GvD 920513 Initialize J2 before opening file -C CMV 940117 Allow user to get a "free COD" -C ACX 010628 linux port -C - SUBROUTINE WNCFOP(COD,NAM) -C -C Open print file -C -C Result: -C -C CALL WNCFOP ( COD_J:I, NAM_C*:I) -C Open print file specified by COD with name -C NAM. If NAM=empty string, generate name. -C If COD<0, the list F_0 ... F_15 will be -C scanned until a free printfile is found; -C the code will be returned in COD. -C -C -C Include files: -C - INCLUDE 'WNG_DEF' - INCLUDE 'WNC_DEF' -C -C Parameters: -C -C -C Arguments: -C - INTEGER COD !OPEN CODE - CHARACTER*(*) NAM !FILE NAME -C -C Function references: -C - CHARACTER*80 WNFFNM !UNIQUE FILE NAME - INTEGER WNCALN !STRING LENGTH -C -C Data declarations: -C - EXTERNAL WNCEXH !EXIT HANDLER ROUTINE -C -C Equivalences: -C -C -C Commons: -C -C- -C -C Find free printfile -C - IF (COD.LT.0) THEN - I=1 - DO WHILE (I.LE.15.AND.CLUN(I).NE.0) - I=I+1 - END DO - IF (CLUN(I).EQ.0) THEN - COD=ISHFT(F_0,I-1) - ELSE - CALL WNCTXT(F_TP,'No free printfile...') - END IF - END IF -C -C Scan all codes in COD and open the file(s) -C - J=COD !COPY CODE - I=-1 !FILE COUNT - DO WHILE (IAND(J,F_ALL).NE.0) !ALL FILES - IF (I.EQ.-1) THEN !SELECT CODE - J1=F_T - ELSE IF (I.EQ.0) THEN - J1=F_P - ELSE - J1=ISHFT(F_0,I-1) - END IF - IF (IAND(J,J1).NE.0) THEN !TO DO - IF (CLUN(I).EQ.0) THEN !AND NOT OPEN - CLC(I)=0 !INIT LINE COUNT - CPC(I)=0 !PAGE COUNT - CLL(I)=CDLL !LINE LENGTH - IF (I.EQ.-1) THEN - CLL(I)=80 !FOR SCREEN - ELSE IF (I.EQ.0) THEN - CLL(I)=CLL(I)-1 !FOR LOG - END IF - CPL(I)=CDPL !PAGE LENGTH - IF (I.EQ.-1 .OR. (I.LE.F_FILN/2 .AND. I.GT.0)) - 1 CPL(I)=0 !FOR SCREEN/NO PAGING - CDIS(I)=F_YES !DEFAULT DISPOSITION - CHPH(I)=0 !HIGHEST HEADER SET - DO I1=1,CMPH !PAGE HEADERS - CPH(I1,I)=' ' - CSPH(I1,I)='0' !NOT SET - END DO - IF (I.EQ.-1) THEN !LUN - CLUN(I)=-1 - ELSE - CALL WNGLUN(CLUN(I)) !GET LUN - END IF - IF (I.EQ.-1) THEN !SCREEN - ELSE IF (I.EQ.0) THEN !LOG - CFN(I)=WNFFNM(PRGNAM(1:3),'LOG') !SET LOG NAME - ELSE - CFN(I)=WNFFNM(PRGNAM(1:3),'TMP') !SET FILE NAME - END IF - CFFN(I)=NAM !FINAL NAME - IF (NAM.EQ.' ') THEN - IF (I.EQ.-1) THEN !SCREEN - ELSE IF (I.EQ.0) THEN !LOG - CFFN(I)=PRGNAM(1:WNCALN(PRGNAM))//'.LOG' - ELSE !FILE - CFFN(I)=CFN(I) - END IF - END IF - J2=0 !INITIALIZE STATUS - IF (CLUN(I).NE.0 .AND. I.NE.-1) THEN !CAN OPEN -C -C This forces uniqueness of the file: on Unix, the open with 'NEW' -C will fail if the file does already exist (may use 'UNKNOWN' instead) - OPEN(UNIT=CLUN(I),FILE=CFN(I),STATUS='NEW', - 1 FORM='FORMATTED',IOSTAT=J2) - END IF - IF (J2.NE.0) THEN !ERROR - CALL WNGLUF(CLUN(I)) !FREE LUN - ELSE - IF (CEXH(1).EQ.0) CALL WNGSXH(CEXH,WNCEXH) !DECLARE EXIT HANDLER - END IF - END IF - END IF -C - J=IAND(J,NOT(J1)) !DELETE BIT - I=I+1 !COUNT - END DO -C - RETURN -C -C - END diff --git a/src/wng/wncfsv.for b/src/wng/wncfsv.for deleted file mode 100644 index 48a19edc0ce3a3ee33b80557f4780d9d9d0b91b9..0000000000000000000000000000000000000000 --- a/src/wng/wncfsv.for +++ /dev/null @@ -1,144 +0,0 @@ -C+ WNCFSV.FOR -C WNB 890417 -C -C Revisions: -C HjV 940217 Change WNCFGC in WNCFGV -C - SUBROUTINE WNCFSV(COD,TP,VAL) -C -C Set/get file values -C -C Result: -C -C CALL WNCFSV ( COD_J:I, TP_J:I, VAL_J:I) -C Set for the file(s) given by COD the -C parameter TP to the value VAL. TP can be: -C F_LL line length -C F_PL page length (0= no paging) -C F_LC line count -C F_PC page count -C F_DIS disposition: -C F_NO delete file -C F_YES keep file -C F_SP spool file -C F_CAT concatenate to file -C CALL WNCFGV ( COD_J:I, TP_J:I, VAL_J:O) -C Get for the file given by COD the parameter -C TP(see above) in VAL. If more than one file -C specified, the last value will be given -C CALL WNCFSN ( COD_J:I, NAM_C*:I) -C Set the final filename for the specified files -C in COD to the given name. -C CALL WNCFGN ( COD_J:I, NAM_C*:O) -C Get the file name (for last specified file) -C -C Include files: -C - INCLUDE 'WNG_DEF' - INCLUDE 'WNC_DEF' -C -C Parameters: -C -C -C Arguments: -C - INTEGER COD !FILE CODE - INTEGER TP !VALUE TYPE - INTEGER VAL !VALUE TO SET/GET - CHARACTER*(*) NAM !NAME TO GET/SET -C -C Function references: -C -C -C Data declarations: -C -C -C Equivalences: -C -C -C Commons: -C -C- -C -C WNCFSV -C - L0=.TRUE. !SET - L1=.TRUE. !VALUE - GOTO 10 -C -C WNCFGV -C - ENTRY WNCFGV(COD,TP,VAL) -C - L0=.FALSE. !GET - L1=.TRUE. !VALUE - GOTO 10 -C -C WNCFSN -C - ENTRY WNCFSN(COD,NAM) -C - L0=.TRUE. !SET - L1=.FALSE. !NAME - GOTO 10 -C -C WNCFGN -C - ENTRY WNCFGN(COD,NAM) -C - L0=.FALSE. !GET - L1=.FALSE. !NAME - GOTO 10 -C - 10 CONTINUE - J=COD !COPY CODE - I=-1 !FILE COUNT - DO WHILE (IAND(J,F_ALL).NE.0) !ALL FILES - IF (I.EQ.-1) THEN !SELECT CODE - J1=F_T - ELSE IF (I.EQ.0) THEN - J1=F_P - ELSE - J1=ISHFT(F_0,I-1) - END IF - IF (IAND(J,J1).NE.0) THEN !TO DO - IF (L1) THEN !VALUE - IF (L0) THEN !SET - IF (TP.EQ.F_PL) CPL(I)=VAL - IF (TP.EQ.F_PC) CPC(I)=VAL - IF (TP.EQ.F_LL) CLL(I)=VAL - IF (TP.EQ.F_LC) CLC(I)=VAL - IF (TP.EQ.F_DIS) THEN - IF (I.EQ.0) LOGCD=VAL !LOG - CDIS(I)=VAL - END IF - ELSE !GET - IF (TP.EQ.F_PL) VAL=CPL(I) - IF (TP.EQ.F_PC) VAL=CPC(I) - IF (TP.EQ.F_LL) VAL=CLL(I) - IF (TP.EQ.F_LC) VAL=CLC(I) - IF (TP.EQ.F_DIS) THEN - IF (I.EQ.0) THEN !LOG - VAL=LOGCD - ELSE - VAL=CDIS(I) - END IF - END IF - END IF - ELSE !NAME - IF (L0) THEN !SET - CFFN(I)=NAM - ELSE !GET - NAM=CFFN(I) - END IF - END IF - END IF -C - J=IAND(J,NOT(J1)) !DELETE BIT - I=I+1 !COUNT - END DO -C - RETURN -C -C - END diff --git a/src/wng/wncout.for b/src/wng/wncout.for deleted file mode 100644 index d1f16345e006757625c0700126feea6e43ff2a7b..0000000000000000000000000000000000000000 --- a/src/wng/wncout.for +++ /dev/null @@ -1,182 +0,0 @@ -C+ WNCOUT.FOR -C WNB 890203 -C -C Revisions: -C WNB 900822 Limit line length -C WNB 911115 DW: Concatenation problem -C WNB 911230 DW: typo -C HjV 930205 HP: type *,xxx wraps at 70 characters -C WNB 931025 Add User/Host to header line -C JPH 951031 Call GEN_FLUSH for terminal output (i.e. make stdout -C output unbuffered) -C HjV 960618 Call TFLUSH iso. GEN_FLUSH -C -C - SUBROUTINE WNCOUT(COD,OUT,PBEG,PEND) -C -C Output a WRCTXT line -C -C Result: -C -C CALL WNCOUT ( COD_J:I, OUT_C*:I, PBEG_J:I, PEND_J:I) -C Output a line from WRCTXT to files -C specified in COD. The line to be -C written is OUT(PBEG:PEND). -C -C Include files: -C - INCLUDE 'WNG_DEF' - INCLUDE 'WNC_DEF' -C -C Parameters: -C - CHARACTER*1 FF !FF -C PARAMETER (FF=CHAR(12)) !Not accepted anymore -C -C Arguments: -C - INTEGER COD !FILE CODE - CHARACTER*(*) OUT !OUTPUT STRING - INTEGER PBEG !BEGIN POINTER - INTEGER PEND !END POINTER -C -C Function references: -C - INTEGER WNCALN !STRING LENGTH -C -C Data declarations: -C - CHARACTER*1 PREF !PREFIX - CHARACTER*8 USER !LOCAL USER - CHARACTER*8 HOST !LOCAL HOST -C- - FF = CHAR(12) - IF (IAND(COD,F_P1).NE.0) THEN !SET PREFIX - PREF='>' - ELSE - PREF=' ' - END IF - J2=PBEG !START IN STRING - IF (OUT(J2:J2).EQ.FF) THEN !ONLY FORMFEED - J=COD !COPY CODE - I=-1 !FILE COUNT - DO WHILE (IAND(J,F_ALL).NE.0) !ALL FILES - IF (I.EQ.-1) THEN !SELECT CODE - J1=F_T - ELSE IF (I.EQ.0) THEN - J1=F_P - ELSE - J1=ISHFT(F_0,I-1) - END IF - IF (IAND(J,J1).NE.0) CLC(I)=0 !SET NEW PAGE - J=IAND(J,NOT(J1)) !DELETE BIT - I=I+1 !COUNT - END DO -C - RETURN !READY - ENDIF -C -C OUTPUT LINE -C - J=COD !COPY CODE - I=-1 !FILE COUNT - DO WHILE (IAND(J,F_ALL).NE.0) !ALL FILES - IF (I.EQ.-1) THEN !SELECT CODE - J1=F_T - ELSE IF (I.EQ.0) THEN - J1=F_P - ELSE - J1=ISHFT(F_0,I-1) - END IF - IF (IAND(J,J1).NE.0) THEN !SELECTED FILE - IF (CLUN(I).EQ.0) CALL WNCFOP(J1,' ') !OPEN IF NECESSARY -C -C HEADINGS -C - IF (CLC(I).EQ.0 .AND. CPL(I).GT.CHPH(I)) THEN !NEW PAGE - IF (I.EQ.0 .OR. (I.GT.0 .AND. CHPH(I).GT.0)) THEN !HEADERS - CPC(I)=CPC(I)+1 !PAGE COUNT - IF (CLL(I).GE.16) THEN !CAN SET START - CPH(1,I)(1:16)=PRGNAM(1:WNCALN(PRGNAM))//'/'// - 1 PRGVER !SET VERSION - END IF - CALL WNGSGU(USER) !USER - CALL WNGSGH(HOST) !HOST - I3=WNCALN(USER) !STRING LENGTHS - I4=WNCALN(HOST) - IF (CLL(I).GE.29+3+I3+I4) THEN !CAN SET USER/HOST - CPH(1,I)(CLL(I)-29-2-I4-I3:CLL(I)-29-2-I4-I3)='/' !SEPARATORS - CPH(1,I)(CLL(I)-29-1-I4:CLL(I)-29-1-I4)='/' - CPH(1,I)(CLL(I)-29:CLL(I)-29)='/' - CPH(1,I)(CLL(I)-29-1-I4-I3:CLL(I)-29-2-I4)=USER !SET USER - CPH(1,I)(CLL(I)-29-I4:CLL(I)-29-1)=HOST !SET HOST - END IF - IF (CLL(I).GE.29) THEN !CAN SET DATE/TIME - CALL WNGSYT(CPH(1,I)(CLL(I)-28:CLL(I)-9)) !SET DATE/TIME - END IF - IF (CLL(I).GE.9) THEN !CAN SET PAGE - WRITE (UNIT=CPH(1,I)(CLL(I)-8:CLL(I)),FMT=1000,ERR=10) - 1 CPC(I) !PAGE NUMBER - 10 CONTINUE - END IF - IF (I.EQ.0) THEN !LOG - WRITE (UNIT=CLUN(I),FMT=1010,ERR=11) FF - WRITE (UNIT=CLUN(I),FMT=1010,ERR=11) - 1 ' '//CPH(1,I)(1:CLL(I)) !FIRST HEADING LINE - ELSE - WRITE (UNIT=CLUN(I),FMT=1010,ERR=11) FF - WRITE (UNIT=CLUN(I),FMT=1010,ERR=11) - 1 CPH(1,I)(1:CLL(I)) !FIRST HEADING LINE FILE - END IF - CLC(I)=CLC(I)+1 !COUNT LINE - ELSE IF (I.GT.-1) THEN !NEW PAGE - WRITE (UNIT=CLUN(I),FMT=1010,ERR=11) FF - END IF - 11 CONTINUE - IF (I.EQ.0) THEN !LOG - I1=MAX(3,CHPH(I)) - ELSE !FILE - I1=CHPH(I) !SET LINES TO DO - END IF - DO I2=2,I1 !REMAINING HEADER LINES - IF (I.EQ.0) THEN !LOG - WRITE (UNIT=CLUN(I),FMT=1010,ERR=12) - 1 ' '//CPH(I2,I)(1:CLL(I)) !HEADING LINE LOG - ELSE - WRITE (UNIT=CLUN(I),FMT=1010,ERR=12) - 1 CPH(I2,I)(1:CLL(I)) !HEADING LINE FILE - END IF - CLC(I)=CLC(I)+1 !COUNT LINE - 12 CONTINUE - END DO - END IF -C -C PRINT LINE -C - IF (I.EQ.-1) THEN !SCREEN - I2=PBEG+MIN(PEND-PBEG,CLL(I)-1) -C TYPE 1010,' ',OUT(PBEG:I2) !TYPE not allowed anymore - WRITE(*,'(A,A)') " ",OUT(PBEG:I2) - CALL TFLUSH() - ELSE IF (I.EQ.0) THEN !LOG - I2=PBEG+MIN(PEND-PBEG,CLL(I)-2) - WRITE (UNIT=CLUN(I),FMT=1010,ERR=13) PREF,OUT(PBEG:I2) - ELSE - I2=PBEG+MIN(PEND-PBEG,CLL(I)-1) - WRITE (UNIT=CLUN(I),FMT=1010,ERR=13) OUT(PBEG:I2) - END IF - CLC(I)=CLC(I)+1 !COUNT LINE - 13 CONTINUE - IF (CLC(I).GE.CPL(I) .AND. CPL(I).NE.0) CLC(I)=0 !NEW PAGE - END IF !END SELECTED FILE - J=IAND(J,NOT(J1)) !DELETE BIT - I=I+1 !COUNT - END DO -C - RETURN -C - 1000 FORMAT(' Page',I4) - 1010 FORMAT(A,A) -C -C - END diff --git a/src/wng/wncsad.for b/src/wng/wncsad.for deleted file mode 100644 index c60caee0cd53d8de7e51783a60afa876bd57bdd1..0000000000000000000000000000000000000000 --- a/src/wng/wncsad.for +++ /dev/null @@ -1,58 +0,0 @@ -C+ WNCSAD.FOR -C WNB 880725 -C -C Revisions: -C - SUBROUTINE WNCSAD(FRST,FRS,FRE,TOST,TOL,TOP) -C -C Add string to other string -C -C Result: -C -C CALL WNCSAD( FRST_C*:I, FRS_J:I, FRE_J:I, TOST_C*:O, -C TOL_J:I, TOP_J:IO) -C Add string FRST(FRS:FRE) to TOST with -C a length TOL at TOP+1, and update TOP. -C -C Include files: -C - INCLUDE 'WNG_DEF' -C -C Parameters: -C -C -C Arguments: -C - CHARACTER*(*) FRST !INPUT STRING - INTEGER FRS !START STRING TO COPY - INTEGER FRE !END FIELD TO COPY - CHARACTER*(*) TOST !OUTPUT STRING - INTEGER TOL !LENGTH OUTPUT STRING - INTEGER TOP !OUTPUT POINTER -C -C Function references: -C -C -C Data declarations: -C -C -C Equivalences: -C -C -C Commons: -C -C- - I=LEN(FRST) - IF (FRS.LE.I .AND. FRE.GE.FRS) THEN !CAN DO SOMETHING - I1=MIN(LEN(TOST),TOL) !LENGTH OUTPUT - IF (TOP.LT.I1) THEN !CAN OUTPUT SOME - I2=MIN(MIN(I-FRS,FRE-FRS),I1-TOP-1) !LENGTH - TOST(TOP+1:TOP+I2+1)=FRST(FRS:FRS+I2) !SET - TOP=TOP+I2+1 !NEW POINTER - END IF - END IF -C - RETURN -C -C - END diff --git a/src/wng/wncsys.fsc b/src/wng/wncsys.fsc deleted file mode 100644 index 5e7eb4cd07324a9c9d632acbe970052e0e047a45..0000000000000000000000000000000000000000 --- a/src/wng/wncsys.fsc +++ /dev/null @@ -1,56 +0,0 @@ -C+ WNCSYS.FSC -C JPH 930602 -C -C Revisions: -C HjV 931206 Add test for HP (add char(0)) -C CMV 940628 Use do_system i.s.o. system call -C - SUBROUTINE WNCSYS(COM,ARG1,ARG2,ARG3) -C -C Spawn a sub-process. Differs from WNGSSP in that it does not add anything -C to the command as submitted and can thus be universally used. -C -C Result: -C -C CALL WNCSYS ( COM_C*:I, ARG1_C*:I, ARG2_C*:I, ARG3_C*:I) -C Execute COM with ARG1..3 as arguments -C -C Include files: -C - INCLUDE 'WNG_DEF' -C -C Parameters: -C -C -C Arguments: -C - CHARACTER*(*) COM !COMMAND TO EXECUTE - CHARACTER*(*) ARG1,ARG2,ARG3 !ARGUMENTS TO COMMAND -C -C Function references: -C - INTEGER WNCALN !STRING LENGTH -C -C Data declarations: -C -#ifndef wn_vx__ - CHARACTER*512 TXT -#endif -C- -#ifdef wn_vx__ - CALL LIB$SPAWN(COM(1:WNCALN(COM))//' '// - 1 ARG1(1:WNCALN(ARG1))//' '// - 2 ARG2(1:WNCALN(ARG2))//' '// - 3 ARG3(1:WNCALN(ARG3)),,'NL:') !SPAWN -#else - TXT=COM(1:WNCALN(COM))//' '// - 1 ARG1(1:WNCALN(ARG1))//' '// - 2 ARG2(1:WNCALN(ARG2))//' '// - 3 ARG3(1:WNCALN(ARG3)) !SPAWN TEXT - CALL DO_SYSTEM(TXT(1:WNCALN(TXT))//CHAR(0)) !SPAWN -#endif -C - RETURN -C -C - END diff --git a/src/wng/wnctim.for b/src/wng/wnctim.for deleted file mode 100644 index 598006b4a5c242bf38f88646cdd65f0f852f1e1a..0000000000000000000000000000000000000000 --- a/src/wng/wnctim.for +++ /dev/null @@ -1,115 +0,0 @@ -C+ WNCTIM.FOR -C WNB 890201 -C -C Revisions: -C WNB 911115 DATA for CHARACTER problem -C - SUBROUTINE WNCTIM(COUT,CLEN) -C -C Convert a value to a string -C -C Result: -C -C CALL WNCTIM ( COUT_C*:O, CLEN_J:O) -C Set current time as HH:MM:SS in COUT, -C setting CLEN to the significant -C length of COUT. -C CALL WNCTIF ( COUT_C*:O, CLEN_J:O) -C As TIM, but HH:MM:SS.SS. -C CALL WNCTIN ( COUT_C*:O, CLEN_J:O) -C As TIM, but HHMMSS. -C CALL WNCDAT ( COUT_C*:O, CLEN_J:O) -C As TIM, but DD-Mmm-YY. -C CALL WNCDAF ( COUT_C*:O, CLEN_J:O) -C As TIM, but DD-Mmm-YYYY. -C CALL WNCDAN ( COUT_C*:O, CLEN_J:O) -C As TIM, but YYMMDD. -C -C Include files: -C - INCLUDE 'WNG_DEF' -C -C Parameters: -C -C -C Arguments: -C - CHARACTER*(*) COUT !OUTPUT STRING - INTEGER CLEN !OUTPUT LENGTH -C -C Function references: -C -C -C Data declarations: -C - CHARACTER*23 FIELD !INTERNAL VALUE - CHARACTER*36 MON - CHARACTER*24 MONN - DATA MON/'JanFebMarAprMayJunJulAugSepOctNovDec'/ - DATA MONN/'010203040506070809101112'/ -C -C Equivalences: -C -C -C Commons: -C -C- - CALL WNGSYT(FIELD) !GET SYSTEM TIME - COUT=FIELD(13:20) - CLEN=8 -C - RETURN -C -C WNCTIF -C - ENTRY WNCTIF(COUT,CLEN) -C - CALL WNGSYT(FIELD) !GET SYSTEM TIME - COUT=FIELD(13:23) - CLEN=11 -C - RETURN -C -C WNCTIN -C - ENTRY WNCTIN(COUT,CLEN) -C - CALL WNGSYT(FIELD) !GET SYSTEM TIME - COUT=FIELD(13:14)//FIELD(16:17)//FIELD(19:20) - CLEN=6 -C - RETURN -C -C WNCDAT -C - ENTRY WNCDAT(COUT,CLEN) -C - CALL WNGSYT(FIELD) !GET SYSTEM TIME - COUT=FIELD(1:7)//FIELD(10:11) - CLEN=9 -C - RETURN -C -C WNCDAF -C - ENTRY WNCDAF(COUT,CLEN) -C - CALL WNGSYT(FIELD) !GET SYSTEM TIME - COUT=FIELD(1:11) - CLEN=11 -C - RETURN -C -C WNCDAN -C - ENTRY WNCDAN(COUT,CLEN) -C - CALL WNGSYT(FIELD) !GET SYSTEM TIME - I1=INDEX(MON,FIELD(4:6))/3 !MONTH - COUT=FIELD(10:11)//MONN(2*I1+1:2*I1+2)//FIELD(1:2) - CLEN=6 -C - RETURN -C -C - END diff --git a/src/wng/wnctrp.fsc b/src/wng/wnctrp.fsc deleted file mode 100644 index 91389009b6c3b3d53135df4e36ff58415caeecfe..0000000000000000000000000000000000000000 --- a/src/wng/wnctrp.fsc +++ /dev/null @@ -1,70 +0,0 @@ -C+ WNCTRP.FOR -C JPH 930331 -C -C Revisions: -C - SUBROUTINE WNCTRC (SRC, TEXT, TEXT1) -C -C Output fatal-error message and post signal SIGTRAP to calling process to -C trigger dbx. (For this to work, program must be fired up through dbx -r .) -C -C WNCTRC (SRC_C:I, TEXT_C:I, TEXT1_C:I) -C WNCTRJ (SRC_C:I, TEXT_C:I, J_J:I) -C WNCTRX (SRC_C:I, TEXT_C:I, J_J:I) -C -C Result: -C -C -C Include files: - INCLUDE 'WNG_DEF' -#ifdef wn_vx__ - INCLUDE '($SSDEF)' -#endif -C -C -C Parameters: - INTEGER SIGTRAP - PARAMETER (SIGTRAP=5) -C -C Arguments: - CHARACTER*(*) SRC !source file and line number - CHARACTER*(*) TEXT !descriptive text - CHARACTER*(*) TEXT1 !parameter text -C -C -C Function references: -C - INTEGER GETPID !get own PID -C -C Data declarations: -C -C- - CALL WNCTXT(F_T,'FATAL ERROR !AS !AS !AS', SRC, TEXT, TEXT1) - GOTO 10 -C -C - ENTRY WNCTRJ (SRC, TEXT, J) -C - CALL WNCTXT(F_T,'FATAL ERROR !AS !AS !SJ', SRC, TEXT, J) - GOTO 10 -C -C - ENTRY WNCTRX (SRC, TEXT, J) -C - CALL WNCTXT(F_T,'FATAL ERROR !AS !AS !XJ', SRC, TEXT, J) - GOTO 10 -C -C -10 CONTINUE -#ifdef wn_vx__ - CALL LIB$SIGNAL (%VAL(SS$_DEBUG)) -#else - #ifdef wn_cx__ - CALL WNCTXT (F_T,'Generating a trap by a zero division') - J=1/WNFEOF(0) - #else - CALL KILL (GETPID(), SIGTRAP) - #endif -#endif - RETURN - END diff --git a/src/wng/wnctxi_x.for b/src/wng/wnctxi_x.for deleted file mode 100644 index 03c086f1e8c28caac09b1353b1a9574012e5dedc..0000000000000000000000000000000000000000 --- a/src/wng/wnctxi_x.for +++ /dev/null @@ -1,556 +0,0 @@ -C+ WNCTXI_X.FOR -C WNB 910211 -C -C Revisions: -C WNB 911115 DW: DATA CHARACTER problems; \ problems -C WNB 930520 Remove %VAL -C - SUBROUTINE WNCTXI_X(OST,TXT,ARGL) -C -C Read string with formatting (FAO with extensions) information. -C -C Result: -C -C CALL WNCTXI_X( OST_C*:O, TXT_C*:I, ARGL_J(-*:*):I) -C Read string OST and convert it following the -C format information in TXT to arguments ARG... -C -C The WNCTXI call is in WNCTXT.FOR -C -C The OST string will be interpreted following the format rules in -C TXT, and the result will be put into the arguments ARG. -C A format item has the form: -C ![w$][r]cd[v][.s][\] where each field specifies: -C ! start of format item -C w width of input field. If no width present, -C fields are assumed to be separated with a , -C or blanks. -C r repeat factor. Each cd is repeated r times -C assuming the possibly corresponding argument -C to be an array. Fields generated with r>1 -C will be separated by ", ". r will always -C be taken as max(r,1). Default: 0, i.e. -C one value outputted. -C r should be an unsigned integer. -C v optional cd modifier. Default: 0. -C v should be an unsigned integer -C s optional cd specifier. Default: 0. -C s should be an unsigned integer -C \ optional format end indicator. Produces no -C output, but necessary if next character in -C TXT could be interpreted as part of current -C format item. -C # the values w, r, v and s can be specified -C as # i.s.o. an integer. The corresponding -C value is then taken from the next argument -C in the ARGL, interpreting it as an INTEGER -C value. -C ## As #, but interpretation will be an INTEGER*2. -C NOTE: Order of arguments taken in list: -C w,r,v,s,cd. If argument not present -C for cd, it is an error, and conversion -C stops. In the other cases 0 assumed. -C cd the operational code. It can be one of the -C following format codes: -C ! output ! -C *c output character c -C - backskip argument in ARGL -C + forward skip argument in ARGL -C / insert new line (<CR><LF> TXS) -C _ insert TAB (stops at 9,17...) -C ^ insert new page -C %D set date as dd-mmm-yy -C %T set time as hh:mm:ss -C %DF set date as dd-mmm-yyyy -C %TF set time as hh:mm:ss.ss -C %DN set date as yymmdd -C %TN set time as hhmmss -C AC AD AF AZ AS ASCII string: counted (AC), -C A descriptor (AD), descriptor -C with conversion to . of -C non-printables (AF), address -C of descriptor (AS), ASCIZ (AZ). -C AS is the standard Fortran -C string, AC=nnnncccc... with -C n length string following, -C AD,AD+1=cccc...,n(J), AF same, -C AZ=ccccc....0. -C ALv ASCII string of length v at -C specified address -C SB SI SJ SK convert next arg of byte, word -C SW S SL or longword type to signed -C decimal -C UB UI UJ UK convert next arg to unsigned -C UW U UL decimal -C -C OB OI OJ OK convert next arg to octal -C OW O OL -C -C XB XI XJ XK convert next arg to hexadecimal -C XW X XL -C -C ZB ZI ZJ ZK convert next argument to zero -C ZW Z ZL filled decimal number -C -C LB LI LJ LK convert next arg to YES or NO -C LW L LL low order bit=0: no, =1:yes -C -C E[v] interprete next argument as -C REAL, and convert it to G-like -C format with v significant -C digits. If v=0 enough digits -C given to indicate real value. -C E[[v].s] interprete next argument as -C REAL, and convert it to F-like -C format with s digits after -C decimal ., and v total digits. -C D[v] D[[v].s] convert next double precision -C arg. -C EC[v] EC[[v].s] convert next COMPLEX arg. -C DC[v] DC[[v].s] convert next DOUBLE COMPLEX arg. -C EAc[[v][.s]] convert an angle of type c -C to degrees (-180<angle<180) -C and do as E. -C c can be F (fraction of circles) -C R (radians), D (degrees) or -C empty (radians). -C EPc[[v][.s]] as EA but 0<=angle<360. -C EDc[v] convert an angle to d.m.s.tt..., -C and round to d (v<3), m (v<5), -C s (v<7) or tenths. (Def: v=6) -C EHc[v] convert an angle to h:m:s.tt..., -C rounding as ED -C DAc[[v][.s]] double precision angles -C DPc[[v][.s]] -C DDc[v] -C DHc[v] -C F... identical to all E formats -C [r]C Position at column r. (Def: r=1) -C [w$][r]Q[v] Format: Limit repeats to line -C width w, and offset next line at -C r. If v=1: no , separation. -C -C -C -C Include files: -C - INCLUDE 'WNG_DEF' -C -C Parameters: -C - INTEGER OUTLEN !SOME LENGHTS - PARAMETER (OUTLEN=512) - CHARACTER*1 FF !FF -C PARAMETER (FF=CHAR(12)) !Not allowed anymore - CHARACTER*1 CR !CR -C PARAMETER (CR=CHAR(13)) !Not allowed anymore - CHARACTER*1 LF !LF -C PARAMETER (LF=CHAR(10)) !Not allowed anymore - CHARACTER*1 BACKS !\ -C PARAMETER (BACKS=CHAR(92)) !Not allowed anymore -C -C Arguments: -C - CHARACTER*(*) TXT !TEXT TO BE CONVERTED, OUTPUT - CHARACTER*(*) OST !OUTPUT STRING FOR WNCTXS - INTEGER ARGL(0:*) !ARGUMENTS LIST -C -C Function references: -C - INTEGER WNCAL0 !ACTUAL LENGTH STRING - INTEGER WNCALZ !ACTUAL LENGTH ASCIZ STRING - INTEGER WNCAJA !GET INTEGER FROM STRING - CHARACTER*1 WNCAUP !CONVERT TO UC - INTEGER WNGASA !ADDRESS OF STRING - INTEGER WNGASL !LENGTH OF STRING -C -C Data declarations: -C - CHARACTER*(OUTLEN) CHLP !INTERNAL CONVERSION - CHARACTER*(OUTLEN) OUT !OUTPUT STRING - LOGICAL OPS !SWITCH WRCTXT TYPE - INTEGER LARG,PARG !LENGTH/POINTER ARGUMENT LIST - INTEGER LTXT,PTXT !LENGTH/POINTER TXT - INTEGER LOST,POST !LENGTH/POINTER OST STRING - INTEGER WVAL !FIELD WIDTH - INTEGER RVAL !REPEAT VALUE - INTEGER VVAL !MODIFIER VALUE - INTEGER SVAL !SUBJECT VALUE - LOGICAL DOT !. SEEN - INTEGER MIND !MAIN TYPE INDEX - INTEGER SIND,SIND2 !SECONDARY INDICES - INTEGER LSPEC(4) !Q FORMAT - CHARACTER*20 GCOD !MAIN CODE LIST - CHARACTER*6 ASCOD !A CODE LIST - CHARACTER*6 SSCOD !S,U,O,X,Z,L CODE LIST - CHARACTER*5 ESCOD !E,F,D CODE LIST - CHARACTER*3 DSCOD !ANGLE CODE LIST - CHARACTER*2 CRLF !CR AND LF - DATA GCOD/'!*-+/_^%CASUOXZLEFDQ'/ -C 12345678901234567890 - DATA ASCOD/'CDFSZL'/ -C 123456 - DATA SSCOD/'BWLIJK'/ -C 123456 - DATA ESCOD/'CADHP'/ -C 12345 - DATA DSCOD/'FRD'/ -C 123 -C- -C -C WNCTXI_X -C - FF = CHAR(12) - CR = CHAR(13) - LF = CHAR(10) - CRLF = CR//LF - BACKS = CHAR(92) - - OPS=.TRUE. !INPUT STRING - LOST=LEN(OST) !LENGTH - I=WNGASL(1,ARGL(0)) !INDICATE STRING FOR CONVEX - POST=1 !POINTER - GOTO 10 -C -C Initialize -C - 10 CONTINUE - I=WNGASL(2,ARGL(0)) !INDICATE STRING FOR CONVEX - LARG=ARGL(0) !# OF ARGUMENTS - PARG=2 !POINTER IN ARGL - LTXT=WNCAL0(TXT) !LENGTH TEXT - PTXT=0 !POINTER - LSPEC(1)=0 !Q WIDTH - LSPEC(2)=1 !Q OFFSET - LSPEC(3)=0 !Q , SEPARATION - LSPEC(4)=0 -C -C Scan text -C - 20 CONTINUE -C -C If end -C - 23 IF (PTXT.GE.LTXT) THEN !NO MORE -C - RETURN !READY - END IF -C -C Find format -C - J=INDEX(TXT(PTXT+1:LTXT),'!') !FIND FORMAT - IF (J.EQ.0) THEN !NO MORE FORMAT - 21 CONTINUE - PTXT=LTXT - GOTO 23 !FINISH - END IF -C -C Analyze code -C - PTXT=PTXT+J !! PTR - J1=PTXT-1 !SAVE POSITION ! - J2=PARG !SAVE ARG POSITION - WVAL=WNCAJA(TXT,LTXT,PTXT,ARGL(0),LARG,PARG) !GET WIDTH - IF (PTXT.LT.LTXT) THEN !CAN BE OK - IF (TXT(PTXT+1:PTXT+1).EQ.'$') THEN !REAL WIDTH - PTXT=PTXT+1 !SKIP $ - RVAL=WNCAJA(TXT,LTXT,PTXT,ARGL(0),LARG,PARG) !GET REPEAT - ELSE - RVAL=WVAL !SET REPEAT VALUE - WVAL=0 - END IF - ELSE - 22 PTXT=J1 !RESTORE FOR FORMAT ERROR - PARG=J2 - GOTO 21 - END IF - RVAL=MIN(OUTLEN,MAX(1,RVAL)) !CORRECT REPEAT FACTOR - WVAL=MAX(-OUTLEN,MIN(OUTLEN,WVAL)) !CORRECT WIDTH - IF (PTXT.GE.LTXT) GOTO 22 !FORMAT ERROR - MIND=INDEX(GCOD,WNCAUP(TXT(PTXT+1:PTXT+1))) !GET CODE - IF (MIND.EQ.0) GOTO 22 !UNKNOWN CODE - PTXT=PTXT+1 !SKIP CODE - IF (MIND.EQ.1 .OR. !! - 1 MIND.EQ.3 .OR. !- - 2 MIND.EQ.4 .OR. !+ - 3 MIND.EQ.5 .OR. !/ - 4 MIND.EQ.6 .OR. !_ - 5 MIND.EQ.7 .OR. !^ - 6 MIND.EQ.20 .OR. !Q - 7 MIND.EQ.9) THEN !C READY - ELSE IF (MIND.EQ.2) THEN !* - IF (PTXT.GE.LTXT) GOTO 22 !FORMAT ERROR - PTXT=PTXT+1 - SIND=ICHAR(TXT(PTXT:PTXT)) !SAVE CHARACTER - ELSE IF (MIND.EQ.8) THEN !% - IF (PTXT.GE.LTXT) GOTO 22 !FORMAT ERROR - PTXT=PTXT+1 - IF (WNCAUP(TXT(PTXT:PTXT)).EQ.'D') THEN !%D - SIND=0 - ELSE IF (WNCAUP(TXT(PTXT:PTXT)).EQ.'T') THEN !%T - SIND=3 - ELSE - GOTO 22 !FORMAT ERROR - END IF - IF (PTXT.LT.LTXT) THEN - IF (WNCAUP(TXT(PTXT+1:PTXT+1)).EQ.'F') THEN - SIND=SIND+1 - PTXT=PTXT+1 - ELSE IF (WNCAUP(TXT(PTXT+1:PTXT+1)).EQ.'N') THEN - SIND=SIND+2 - PTXT=PTXT+1 - END IF - END IF - ELSE IF (MIND.EQ.10) THEN !A - SIND=0 - IF (PTXT.LT.LTXT) THEN - SIND=INDEX(ASCOD,WNCAUP(TXT(PTXT+1:PTXT+1))) - IF (SIND.NE.0) PTXT=PTXT+1 - END IF - ELSE IF (MIND.EQ.11 .OR. !S - 1 MIND.EQ.12 .OR. !U - 2 MIND.EQ.13 .OR. !O - 3 MIND.EQ.14 .OR. !X - 4 MIND.EQ.15 .OR. !Z - 5 MIND.EQ.16) THEN !L - SIND=0 - IF (PTXT.LT.LTXT) THEN - SIND=INDEX(SSCOD,WNCAUP(TXT(PTXT+1:PTXT+1))) - IF (SIND.NE.0) PTXT=PTXT+1 - END IF - ELSE IF (MIND.EQ.17 .OR. !E - 1 MIND.EQ.18 .OR. !F - 2 MIND.EQ.19) THEN !D - SIND=0 - IF (PTXT.LT.LTXT) THEN - SIND=INDEX(ESCOD,WNCAUP(TXT(PTXT+1:PTXT+1))) - IF (SIND.NE.0) PTXT=PTXT+1 - IF (SIND.GT.1) THEN - SIND2=0 - IF (PTXT.LT.LTXT) THEN - SIND2=INDEX(DSCOD,WNCAUP(TXT(PTXT+1:PTXT+1))) - IF (SIND2.NE.0) PTXT=PTXT+1 - END IF - END IF - END IF - ELSE - GOTO 22 !PROGRAMMING ERROR - END IF - VVAL=WNCAJA(TXT,LTXT,PTXT,ARGL(0),LARG,PARG) !GET MODIFIER - DOT=.FALSE. - IF (PTXT.LT.LTXT) THEN - IF (TXT(PTXT+1:PTXT+1).EQ.'.') THEN - DOT=.TRUE. !SET . SEEN - PTXT=PTXT+1 - END IF - END IF - SVAL=WNCAJA(TXT,LTXT,PTXT,ARGL(0),LARG,PARG) !GET SECONDARY MODIFIER - VVAL=MAX(0,MIN(OUTLEN,VVAL)) !LIMIT VALUES - SVAL=MAX(0,MIN(OUTLEN,SVAL)) - IF (PTXT.LT.LTXT) THEN - IF (TXT(PTXT+1:PTXT+1).EQ.BACKS) PTXT=PTXT+1 !SKIP TERMINATOR - END IF - IF (MIND.GE.10 .AND. MIND.NE.20) THEN !USE ARGUMENT - IF (PARG.GE.LARG) GOTO 22 !FORMAT ERROR - PARG=PARG+1 !POINT TO CORRECT ARGUMENT - IF (ARGL(PARG).EQ.0) GOTO 22 !FORMAT ERROR - IF (MIND.EQ.10 .AND. (SIND.EQ.2 .OR. SIND.EQ.3)) THEN !NEED 2 ARGS - IF (PARG.GE.LARG) GOTO 22 !FORMAT ERROR - PARG=PARG+1 !POINT TO CORRECT ARGUMENT - IF (ARGL(PARG).EQ.0) GOTO 22 !FORMAT ERROR - END IF - END IF -C -C Do actual input -C - GOTO (110,120,130,140,150,160,170,180,190, - 1 200,210,210,210,210,210,210,270,270,290,300) MIND - GOTO 22 !PROGRAM ERROR -C ! - 110 J=RVAL - DO I=1,J !SKIP ! - CALL WNCASC(OST,POST,'!') - END DO - 111 CONTINUE - GOTO 23 !GET NEXT FORMAT -C * - 120 J=RVAL - DO I=1,J !SKIP CHARACTERS - CALL WNCASB(OST,POST,CHAR(SIND)) - END DO - GOTO 111 -C - - 130 IF (PARG.LE.2) GOTO 22 !FORMAT ERROR - PARG=PARG-1 !RESET ARGUMENT - GOTO 23 !NEXT FORMAT -C + - 140 IF (PARG.GE.LARG) GOTO 22 !FORMAT ERROR - PARG=PARG+1 !RESET ARGUMENT - GOTO 23 !NEXT FORMAT -C / - 150 CONTINUE - DO I=1,RVAL - CALL WNCASM(OST,POST,CRLF) !SKIP CR/LF - CALL WNCASM(OST,POST,CRLF) - END DO - GOTO 20 !NEW LINE -C _ - 160 CONTINUE - CALL WNCASB(OST,POST) !SKIP SPACES - GOTO 23 -C ^ - 170 CONTINUE - DO I=1,RVAL - CALL WNCASC(OST,POST,FF) !SKIP FF - END DO - GOTO 20 !NEW LINE -C % - 180 CONTINUE - DO I=1,RVAL - IF (WVAL.NE.0) THEN !SKIP DATE - POST=POST+WVAL - ELSE - CALL WNCAFS(OST,POST,CHLP) - END IF - END DO - GOTO 23 !NEXT FORMAT -C C - 190 CONTINUE - POST=MAX(1,RVAL) !SET COLUMN - GOTO 23 !NEXT FORMAT -C A - 200 IF (SIND.EQ.0 .OR. SIND.EQ.4) THEN !AS - I1=WNGASA(PARG,ARGL(0)) !STRING ADDRESS - I2=WNGASL(PARG,ARGL(0)) !STRING LENGTH - ELSE IF (SIND.EQ.1) THEN !AC - I1=ARGL(PARG)+4 !STRING ADDRESS - CALL WNGMV(4,A_B(ARGL(PARG)-A_OB),I2) !STRING LENGTH - ELSE IF (SIND.EQ.2 .OR. SIND.EQ.3) THEN !AD, AF - I1=ARGL(PARG-1) !STRING ADDRESS - CALL WNGMV(4,A_B(ARGL(PARG)-A_OB),I2) !STRING LENGTH - ELSE IF (SIND.EQ.5) THEN !AZ - I1=ARGL(PARG) !STRING ADDRESS - I2=WNCALZ(A_B(ARGL(PARG)-A_OB)) !STRING LENGTH - ELSE IF (SIND.EQ.6) THEN !AL - I1=ARGL(PARG) !STRING ADDRESS - I2=VVAL !STRING LENGTH - ELSE - GOTO 22 !PROGRAM ERROR - END IF - DO I=1,RVAL !REPEAT - IF (WVAL.EQ.0) THEN !GET STRING - CALL WNCAFS(OST,POST,CHLP) - ELSE - CHLP=OST(POST:POST+WVAL-1) - END IF - CALL WNGMFS(I2,CHLP,A_B(I1-A_OB)) !SET STRING - IF (SIND.EQ.0 .OR. SIND.EQ.4) THEN !AS - I1=I1+I2 !STRING ADDRESS - ELSE IF (SIND.EQ.1) THEN !AC - I1=I1+I2+4 !STRING ADDRESS - CALL WNGMV(4,A_B(I1-4-A_OB),I2) !STRING LENGTH - ELSE IF (SIND.EQ.2 .OR. SIND.EQ.3) THEN !AD, AF - I1=I1+I2 !STRING ADDRESS - ELSE IF (SIND.EQ.5) THEN !AZ - I1=I1+I2+1 !STRING ADDRESS - I2=WNCALZ(A_B(I1-A_OB)) !STRING LENGTH - ELSE IF (SIND.EQ.6) THEN !AL - I1=I1+I2 !STRING ADDRESS - END IF - END DO - GOTO 23 !NEXT FORMAT -C SUOXZL - 210 I1=ARGL(PARG) !DATA POINTER - IF (SIND.EQ.0 .OR. SIND.EQ.5) THEN !J - I2=L_J/L_B !DATA LENGTH - ELSE IF (SIND.EQ.2 .OR. SIND.EQ.4) THEN !I - I2=L_I/L_B - ELSE IF (SIND.EQ.3 .OR. SIND.EQ.6) THEN !K - I2=L_K/L_B - ELSE !B - I2=L_B/L_B - END IF - IF (MIND.EQ.11 .OR. MIND.EQ.12 .OR. MIND.EQ.15) THEN !SUZ - I3=10 - ELSE IF (MIND.EQ.13) THEN !O - I3=8 - ELSE !X - I3=16 - END IF - DO I=1,RVAL !REPEAT - I4=POST - IF (I2.EQ.4) THEN !K - CALL WNCACJ(OST,POST,I3,A_B(I1-A_OB)) - ELSE IF (I2.EQ.2) THEN !I - CALL WNCACI(OST,POST,I3,A_B(I1-A_OB)) - ELSE IF (I2.EQ.1) THEN !B - CALL WNCACB(OST,POST,I3,A_B(I1-A_OB)) - ELSE !J - CALL WNCACJ(OST,POST,I3,A_B(I1-A_OB)) - END IF - CALL WNCASS(OST,POST) !SKIP SEPARATOR - IF (WVAL.NE.0) POST=I4+ABS(WVAL) - I1=I1+I2 !NEXT POINTER - END DO - GOTO 23 !NEXT FORMAT -C EF - 270 I1=ARGL(PARG) !DATA ADDRESS - IF (DOT) THEN !SET FORMAT - I2=SVAL - ELSE - I2=-1 - END IF - DO I=1,RVAL !REPEAT - IF (SIND.EQ.0) THEN !NORMAL - CALL WNCACE(OST,POST,10,A_B(I1-A_OB)) - ELSE IF (SIND.EQ.1) THEN !COMPLEX - CALL WNCACX(OST,POST,10,A_B(I1-A_OB)) - I1=I1+4 !NEXT POINTER - ELSE !ANGLE - IF (SIND2.EQ.0) SIND2=2 - CALL WNCACE(OST,POST,10,R0) - IF (SIND2.EQ.1) THEN !FRACTION - R0=R0/360 - ELSE IF (SIND2.EQ.2) THEN !RADIANS - R0=R0/PI2 - END IF - CALL WNGMV(4,R0,A_B(I1-A_OB)) - END IF - I1=I1+4 !NEXT POINTER - END DO - GOTO 23 !NEXT FORMAT -C D - 290 I1=ARGL(PARG) !DATA ADDRESS - IF (DOT) THEN !SET FORMAT - I2=SVAL - ELSE - I2=-1 - END IF - DO I=1,RVAL !REPEAT - IF (SIND.EQ.0) THEN !NORMAL - CALL WNCACD(OST,POST,10,A_B(I1-A_OB)) - ELSE IF (SIND.EQ.1) THEN !COMPLEX - CALL WNCACY(OST,POST,10,A_B(I1-A_OB)) - I1=I1+8 !NEXT POINTER - ELSE !ANGLE - IF (SIND2.EQ.0) SIND2=2 - CALL WNCACD(OST,POST,10,D0) - IF (SIND2.EQ.1) THEN !FRACTION - D0=D0/360 - ELSE IF (SIND2.EQ.2) THEN !RADIANS - D0=D0/DPI2 - END IF - CALL WNGMV(8,D0,A_B(I1-A_OB)) - END IF - I1=I1+8 !NEXT POINTER - END DO - GOTO 23 !NEXT FORMAT -C Q - 300 LSPEC(1)=WVAL !LINE WIDTH - LSPEC(2)=RVAL !LINE OFFSET - LSPEC(3)=VVAL !, SEPARATION ON/OFF - LSPEC(4)=SVAL !SPARE - GOTO 23 !NEXT FORMAT -C -C - END diff --git a/src/wng/wnctxt.cun b/src/wng/wnctxt.cun deleted file mode 100644 index 1aeb9070c71a56e86998772af1152094c9b7f953..0000000000000000000000000000000000000000 --- a/src/wng/wnctxt.cun +++ /dev/null @@ -1,283 +0,0 @@ -/* wnctxt.cun -. WNB 920113 -. -. Revisions: -. WNB 921216 Make CUN -. CMV 940111 Changed for alpha - CMV 031205 Changed for stdarg -... */ -/* -. Include files: -... */ -/*#include <varargs.h>*/ -#include <stdarg.h> -#define MXNARG 250 -/* -. Print/type/read string with formatting (FAO with extensions) information. -. (see WNCTXT_X for details) -... */ -#ifdef wn_al__ - void wnctd1_(va_alist) -#else - void wnctxt_(int* code_in,...) -#endif -/* -. Result: -. -. CALL WNCTXT( CODE_J:I, TXT_C*:I, ARG....) -. Print and/or type and/or output to file -. (depending on F_* bits set in CODE) the -. TXT, using the arguments ARG specified as -. interpreted by codes in TXT. -. CALL WNCTXS( OST_C*:O, TXT_C*:I, ARG...) -. Write interpreted TXT to string OST -. CALL WNCTXI( OST_C*:I, TXT_C*:I, ARG...) -. Read text OST interpreted by TXT to ARG -... */ -/* -. Arguments: -... */ -/* va_dcl */ /* address list to get */ -{ -/* -. Parameters: -... */ -/* -. Function references: -... */ - void wnctxt_x_(); /* routine to call */ -/* -. Data declarations: -... */ - va_list ap; /* list argument ptr */ -#ifdef wn_da__ - int args[2*MXNARG+4]; /* argument list */ -#else - char *args[2*MXNARG+4]; /* argument list */ -#endif - int i = 0; /* argument count */ - int i1 = 0; /* string counts */ - char *p; /* pointer to argument */ - int *code; /* first argument */ - char *txt; /* second argument */ -/*- */ -/* -. Get argument list -... */ - va_start(ap,code_in); - args[MXNARG] = 0; /* number arguments */ - args[MXNARG-1] = 0; /* count for strings */ - args[MXNARG-2] = 0; /* number strings */ - while (i < MXNARG) - { i++; - if (i==1) { - p = (char *)code_in; - } else { - p = va_arg(ap, char *); - } -#ifdef wn_da__ - args[MXNARG + i] = (int )p; -#else - args[MXNARG + i] = p; -#endif - if (i==1) code=(int *)p; - if (i==2) txt=p; - - if (p > 0 && p < 65536) break; /* found string length */ - args[MXNARG] = i; /* found argument */ - } -/* -. Get string lengths -... */ - args[MXNARG-3] = args[MXNARG + i]; /* possible length */ - while (i1 < MXNARG && i1 < (int)args[MXNARG]) { - if (p <= 0 || p >= 65536) break; /* no more string */ - i1++; - args[MXNARG - 2] = i1; /* count strings */ - p = va_arg(ap, char *); /* next length */ -#ifdef wn_da__ - args[MXNARG -3 - i1] = (int )p; -#else - args[MXNARG -3 - i1] = p; -#endif - } - va_end(ap); -/* -. Call routine -... */ - wnctxt_x_(code, txt, &args[MXNARG], args[MXNARG -3]); - return; -} -/* -. WNCTXS -. -... */ -#ifdef wn_al__ - void wnctd2_(va_alist) -#else - void wnctxs_(char* o_in,...) -#endif -/* -. Arguments: -... */ -/* va_dcl */ /* address list to get */ -{ -/* -. Parameters: -... */ -/* -. Function references: -... */ - void wnctxs_x_(); /* routine to call */ -/* -. Data declarations: -... */ - va_list ap; /* list argument ptr */ -#ifdef wn_da__ - int args[2*MXNARG+4]; /* argument list */ -#else - char *args[2*MXNARG+4]; /* argument list */ -#endif - int i = 0; /* argument count */ - int i1 = 0; /* string counts */ - char *p; /* pointer to argument */ - char *out,*txt; /* Save first two args */ -/*- */ -/* -. Get argument list -... */ - va_start(ap,o_in); - args[MXNARG] = 0; /* number arguments */ - args[MXNARG-1] = 0; /* count for strings */ - args[MXNARG-2] = 0; /* number strings */ - while (i < MXNARG) - { i++; - if (i==1) { - p=o_in; - } else { - p = va_arg(ap, char *); - } -#ifdef wn_da__ - args[MXNARG + i] = (int )p; -#else - args[MXNARG + i] = p; -#endif - if (i==1) out=p; - if (i==2) txt=p; - - if (p > 0 && p < 65536) break; /* found string length */ - args[MXNARG] = i; /* found argument */ - } -/* -. Get string lengths -... */ - args[MXNARG-3] = args[MXNARG + i]; /* possible length */ - while (i1 < MXNARG && i1 < (int)args[MXNARG]) { - if (p <= 0 || p >= 65536) break; /* no more string */ - i1++; - args[MXNARG - 2] = i1; /* count strings */ - p = va_arg(ap, char *); /* next length */ -#ifdef wn_da__ - args[MXNARG -3 - i1] = (int )p; -#else - args[MXNARG -3 - i1] = p; -#endif - } - va_end(ap); -/* -. Call routine -... */ - wnctxs_x_( out, txt, &args[MXNARG], - args[MXNARG - 3], args[MXNARG - 4]); - return; -} -/* -. WNCTXI -. -... */ -#ifdef wn_al__ - void wnctd3_(va_alist) -#else - void wnctxi_(char* o_in,...) -#endif -/* -. Arguments: -... */ -/* va_dcl*/ /* address list to get */ -{ -/* -. Parameters: -... */ -/* -. Function references: -... */ - void wnctxi_x_(); /* routine to call */ -/* -. Data declarations: -... */ - va_list ap; /* list argument ptr */ -#ifdef wn_da__ - int args[2*MXNARG+4]; /* argument list */ -#else - char *args[2*MXNARG+4]; /* argument list */ -#endif - int i = 0; /* argument count */ - int i1 = 0; /* string counts */ - char *p; /* pointer to argument */ - char *out,*txt; /* Save first two args */ -/*- */ -/* -. Get argument list -... */ - va_start(ap,o_in); - args[MXNARG] = 0; /* number arguments */ - args[MXNARG-1] = 0; /* count for strings */ - args[MXNARG-2] = 0; /* number strings */ - while (i < MXNARG) - { i++; - if (i==1) { - p=o_in; - } else { - p = va_arg(ap, char *); - } -#ifdef wn_da__ - args[MXNARG + i] = (int )p; -#else - args[MXNARG + i] = p; -#endif - if (i==1) out=p; - if (i==2) txt=p; - - if (p > 0 && p < 65536) break; /* found string length */ - args[MXNARG] = i; /* found argument */ - } -/* -. Get string lengths -... */ - args[MXNARG-3] = args[MXNARG + i]; /* possible length */ - while (i1 < MXNARG && i1 < (int)args[MXNARG]) { - if (p <= 0 || p >= 65536) break; /* no more string */ - i1++; - args[MXNARG - 2] = i1; /* count strings */ - p = va_arg(ap, char *); /* next length */ -#ifdef wn_da__ - args[MXNARG -3 - i1] = (int )p; -#else - args[MXNARG -3 - i1] = p; -#endif - } - va_end(ap); -/* -. Call routine -... */ - wnctxi_x_( out, txt, &args[MXNARG], - args[MXNARG -3], args[MXNARG - 4]); - return; -} -/* -. -... */ - - - - diff --git a/src/wng/wnctxt.fal b/src/wng/wnctxt.fal deleted file mode 100644 index afd793d379287558437a25aaa98ebf0b3473d3b2..0000000000000000000000000000000000000000 --- a/src/wng/wnctxt.fal +++ /dev/null @@ -1,106 +0,0 @@ -C+ WNCTXT.FAL -C WNB 890308 -C -C Revisions: -C - SUBROUTINE WNCTXT(CODE,TXT) -C -C Print/type/read string with formatting (FAO with extensions) information. -C (see WNCTXT_X for details) -C -C Result: -C -C CALL WNCTXT( CODE_J:I, TXT_C*:I, ARG.......) -C Print (bit1=1 of CODE) and/or type (bit0=1) -C and/or output to file (bit8-31=1) -C the string, using the arguments specified -C by ARG.... , as interpreted by codes in TXT. -C CALL WNCTXS( OST_C*:O, TXT_C*:I, ARG.......) -C Write interpreted TXT to OST -C CALL WNCTXI( OST_C*:O, TXT_C*:I, ARG.......) -C Read text OST interpreted to ARG... -C -C Include files: -C - INCLUDE 'WNG_DEF' -C -C Parameters: -C - INTEGER MXNARG !MAX. # OF ARG ALLOWED - PARAMETER (MXNARG=250) -C -C Arguments: -C - INTEGER CODE !PRINT/TYPE CODE - CHARACTER*(*) TXT !TEXT TO BE CONVERTED, OUTPUT - CHARACTER*(*) OST !OUTPUT STRING FOR WNCTXS -C -C Function references: -C - INTEGER WNGARA !GET ARGUMENT ADDRESS - INTEGER WNGARG !GET CALL LIST ADDRESS -C -C Data declarations: -C - INTEGER ARGL(-MXNARG-2:MXNARG+2) !ARG. LIST - INTEGER ARGL1(-3:3) !INTERMEDIATE ARG. LIST - EXTERNAL WNCTXT_X,WNCTXS_X,WNCTXI_X !ROUTINE TO DO -C -C Equivalences: -C -C -C Commons: -C -C- -C -C WNCTXT -C - J=WNGARG() - CALL WNGARL(%VAL(J),ARGL(0)) !MAKE ARGUMENT LIST - ARGL1(1)=ARGL(1) !COPY CODE - ARGL1(2)=ARGL(2) !TXT - ARGL1(0)=3 !# ARG. - ARGL1(3)=WNGARA(ARGL(0)) !ARG LIST - ARGL1(-3)=0 - ARGL1(-2)=ARGL(-ARGL(0)+1) !TXT LENGTH - ARGL1(-1)=0 - CALL WNGARX(WNCTXT_X,ARGL1(0)) !DO -C - RETURN -C -C WNCTXS -C - ENTRY WNCTXS(OST,TXT) -C - J=WNGARG() - CALL WNGARL(%VAL(J),ARGL(0)) !MAKE ARGUMENT LIST - ARGL1(1)=ARGL(1) !COPY OST ADDRESS - ARGL1(2)=ARGL(2) !TXT - ARGL1(0)=3 !# ARG. - ARGL1(3)=WNGARA(ARGL(0)) !ARG LIST - ARGL1(-3)=ARGL(-ARGL(0)) !LENGTH OST - ARGL1(-2)=ARGL(-ARGL(0)+1) !TXT LENGTH - ARGL1(-1)=0 - CALL WNGARX(WNCTXS_X,ARGL1(0)) !DO -C - RETURN -C -C WNCTXI -C - ENTRY WNCTXI(OST,TXT) -C - J=WNGARG() - CALL WNGARL(%VAL(J),ARGL(0)) !MAKE ARGUMENT LIST - ARGL1(1)=ARGL(1) !COPY OST ADDRESS - ARGL1(2)=ARGL(2) !TXT - ARGL1(0)=3 !# ARG. - ARGL1(3)=WNGARA(ARGL(0)) !ARG LIST - ARGL1(-3)=ARGL(-ARGL(0)) !LENGTH OST - ARGL1(-2)=ARGL(-ARGL(0)+1) !TXT LENGTH - ARGL1(-1)=0 - CALL WNGARX(WNCTXI_X,ARGL1(0)) !DO -C - RETURN -C -C - END diff --git a/src/wng/wnctxt.fvx b/src/wng/wnctxt.fvx deleted file mode 100644 index 95810fe0abe85c3eaf5ccabb4f6c4b2799df1f08..0000000000000000000000000000000000000000 --- a/src/wng/wnctxt.fvx +++ /dev/null @@ -1,68 +0,0 @@ -C+ WNCTXT.FVX -C WNB 890308 -C -C Revisions: -C - SUBROUTINE WNCTXT(CODE,TXT) -C -C Print/type string with formatting (FAO with extensions) information. -C (see WNCTXT_X for details) -C -C Result: -C -C CALL WNCTXT( CODE_J:I, TXT_C*:I, ARG.......) -C Print (bit1=1 of CODE) and/or type (bit0=1) -C and/or output to file (bit8-31=1) -C the string, using the arguments specified -C by ARG.... , as interpreted by codes in TXT. -C CALL WNCTXS( OST_C*:O, TXT_C*:I, ARG.......) -C Write interpreted TXT to OST -C -C Include files: -C - INCLUDE 'WNG_DEF' -C -C Parameters: -C - INTEGER MXNARG !MAX. # OF ARG ALLOWED - PARAMETER (MXNARG=250) -C -C Arguments: -C - INTEGER CODE !PRINT/TYPE CODE - CHARACTER*(*) TXT !TEXT TO BE CONVERTED, OUTPUT - CHARACTER*(*) OST !OUTPUT STRING FOR WNCTXS -C -C Function references: -C - INTEGER WNGARG !GET CALL LIST ADDRESS -C -C Data declarations: -C - INTEGER ARGL(0:MXNARG+2) !ARG. LIST -C -C Equivalences: -C -C -C Commons: -C -C- -C -C WNCTXT -C - CALL WNGARL(%VAL(WNGARG()),ARGL(0)) !MAKE ARGUMENT LIST - CALL WNCTXT_X(CODE,TXT,ARGL(0)) !DO -C - RETURN -C -C WNCTXS -C - ENTRY WNCTXS(OST,TXT) -C - CALL WNGARL(%VAL(WNGARG()),ARGL(0)) !MAKE ARGUMENT LIST - CALL WNCTXS_X(OST,TXT,ARGL(0)) !DO -C - RETURN -C -C - END diff --git a/src/wng/wnctxt_x.for b/src/wng/wnctxt_x.for deleted file mode 100644 index 3c53499af09316d53de5ac39ec86fe8c56262c73..0000000000000000000000000000000000000000 --- a/src/wng/wnctxt_x.for +++ /dev/null @@ -1,700 +0,0 @@ -C+ WNCTXT_X.FOR -C WNB 880725 -C -C Revisions: -C WNB 911115 DW: CHARACTER DATA problem; \ problem -C HjV 920520 HP does not allow extended source lines -C WNB 930520 Remove %VAL -C CMV 940315 Actually implement !AF format -C CMV 940516 Change AF test from CHAR to ICHAR (bug on sw) -C JPH 960531 Expand description of ", " array-element separator and -C !Q1 specifier -C JPH 960612 Expand description of EHc specifier -C -C - SUBROUTINE WNCTXT_X(CODE,TXT,ARGL) -C -C Print/type string with formatting (FAO with extensions) information. -C -C Result: -C -C CALL WNCTXT_X( CODE_J:I, TXT_C*:I, ARGL_J(-*:*):I) -C Print (bit1=1 of CODE) and/or type (bit0=1) -C and/or output to file (bit8-31=1) -C the string, using the arguments specified -C in the ARGL argument list, as interpreted -C by the TXT string (see later for codes). -C CALL WNCTXS_X( OST_C*:O, TXT_C*:I, ARGL_J(-*:*):I) Write to string OST -C -C The WNCTXT and WNCTXS calls are in WNCTXT.FOR -C -C The TXT string will be copied to the specified output(s) without -C modification, unless formatting information is present. A format -C item has the form: -C ![w$][r]cd[v][.s][\] where each field specifies: -C ! start of format item -C w width of output field. An output string will -C be right (w>=0) or left (w<0) justified in -C field with width |w|. Default: 0, i.e. -C depending on output generated by cd. -C w should be an optionally signed integer. -C r repeat factor. Each cd is repeated r times -C assuming the possibly corresponding argument -C to be an array. r should be an unsigned integer. -C Default: r=0, i.e. one value is output. -C Multiple fields generated with r>1 will be -C separated by ", ". This separator may be -C suppressed by a !Q1 specifier, see below. -C v optional cd modifier. Default: 0. -C v should be an unsigned integer -C s optional cd specifier. Default: 0. -C s should be an unsigned integer -C \ optional format end indicator. Produces no -C output, but necessary if next character in -C TXT could be interpreted as part of current -C format item. -C MAY ALSO BE A / -C # the values w, r, v and s can be specified -C as # i.s.o. an integer. The corresponding -C value is then taken from the next argument -C in the ARGL, interpreting it as an INTEGER -C value. -C ## As #, but interpretation will be an INTEGER*2. -C NOTE: Order of arguments taken in list: -C w,r,v,s,cd. If argument not present -C for cd, it is an error, and conversion -C stops. In the other cases 0 assumed. -C cd the operational code. It can be one of the -C following format codes: -C ! output ! -C *c output character c -C - backskip argument in ARGL -C + forward skip argument in ARGL -C / insert new line (<CR><LF> TXS) -C _ insert TAB (stops at 9,17...) -C ^ insert new page -C %D set date as dd-mmm-yy -C %T set time as hh:mm:ss -C %DF set date as dd-mmm-yyyy -C %TF set time as hh:mm:ss.ss -C %DN set date as yymmdd -C %TN set time as hhmmss -C AC AD AF AZ AS ASCII string: counted (AC), -C A descriptor (AD), descriptor -C with conversion to . of -C non-printables and spaces (AF), -C address of descriptor (AS), -C ASCIZ (AZ). -C AS is the standard Fortran -C string, AC=nnnncccc... with -C n length string following, -C AD,AD+1=cccc...,n(J), AF same, -C AZ=ccccc....0. -C ALv ASCII string of length v at -C specified address -C SB SI SJ SK convert next arg of byte, word -C SW S SL or longword type to signed -C decimal -C UB UI UJ UK convert next arg to unsigned -C UW U UL decimal -C -C OB OI OJ OK convert next arg to octal -C OW O OL -C -C XB XI XJ XK convert next arg to hexadecimal -C XW X XL -C -C ZB ZI ZJ ZK convert next argument to zero -C ZW Z ZL filled decimal number -C -C LB LI LJ LK convert next arg to YES or NO -C LW L LL low order bit=0: no, =1:yes -C -C E[v] interprete next argument as -C REAL, and convert it to G-like -C format with v significant -C digits. If v=0 enough digits -C given to indicate real value. -C E[[v].s] interprete next argument as -C REAL, and convert it to F-like -C format with s digits after -C decimal ., and v total digits. -C D[v] D[[v].s] convert next double precision -C arg. -C EC[v] EC[[v].s] convert next COMPLEX arg. -C DC[v] DC[[v].s] convert next DOUBLE COMPLEX arg. -C EAc[[v][.s]] convert an angle of type c -C to degrees (-180<angle<180) -C and do as E. -C c can be F (fraction of circles) -C R (radians), D (degrees) or -C empty (radians). -C EPc[[v][.s]] as EA but 0<=angle<360. -C EDc[v] convert an angle to d.m.s.tt..., -C and round to d (v<3), m (v<5), -C s (v<7) or tenths. (Def: v=6) -C EHc[v] convert an angle to h:m:s.tt..., -C rounding as ED. v is the number -C of digits, not counting the -C colons and dots; thus v-6 is the -C number of fraction digits tt... -C -C DAc[[v][.s]] double precision angles -C DPc[[v][.s]] -C DDc[v] -C DHc[v] -C F... identical to all E formats -C [r]C Position at column r. (Def: r=1) -C [w$][r]Q[v] Format: Limit repeats to line -C width w, and offset next line at -C r. -C If v=1: the ", " separator -C between array elements is -C suppressed -C -C Note: TAB, CR, LF, FF etc are not acted upon if -C embedded in TXT. -C -C -C Include files: -C - INCLUDE 'WNG_DEF' -C -C Parameters: -C - INTEGER OUTLEN !MAX. OUTPUT LINE LENGTH - PARAMETER (OUTLEN=512) - CHARACTER*1 FF !FF -C PARAMETER (FF=ICHAR(12)) !Not allowed anymore - CHARACTER*1 CR !CR -C PARAMETER (CR=CHAR(13)) !Not allowed anymore - CHARACTER*1 LF !LF -C PARAMETER (LF=CHAR(10)) !Not allowed anymore - CHARACTER*1 BACKS !\ -C PARAMETER (BACKS=CHAR(92)) !Not allowed anymore -C -C Arguments: -C - INTEGER CODE !PRINT/TYPE CODE - CHARACTER*(*) TXT !TEXT TO BE CONVERTED, OUTPUT - CHARACTER*(*) OST !OUTPUT STRING FOR WNCTXS - INTEGER ARGL(0:*) !ARGUMENTS LIST -C -C Function references: -C - INTEGER WNCAL0 !ACTUAL LENGTH STRING - INTEGER WNCALZ !ACTUAL LENGTH ASCIZ STRING - INTEGER WNCAJA !GET INTEGER FROM STRING - CHARACTER*1 WNCAUP !CONVERT TO UC - INTEGER WNGASA !ADDRESS OF STRING - INTEGER WNGASL !LENGTH OF STRING -C -C Data declarations: -C - CHARACTER*(OUTLEN) CHLP !INTERNAL CONVERSION - CHARACTER*(OUTLEN) OUT !OUTPUT STRING - LOGICAL OPS !SWITCH WRCTXT TYPE - INTEGER LARG,PARG !LENGTH/POINTER ARGUMENT LIST - INTEGER LTXT,PTXT !LENGTH/POINTER TXT - INTEGER LOUT,POUT !LENGTH/POINTER OUTPUT LINE - INTEGER LOST,POST !LENGTH/POINTER OST STRING - INTEGER WVAL !FIELD WIDTH - INTEGER RVAL !REPEAT VALUE - INTEGER VVAL !MODIFIER VALUE - INTEGER SVAL !SUBJECT VALUE - LOGICAL DOT !. SEEN - INTEGER MIND !MAIN TYPE INDEX - INTEGER SIND,SIND2 !SECONDARY INDICES - INTEGER LSPEC(4) !Q FORMAT - CHARACTER*21 GCOD !MAIN CODE LIST - CHARACTER*6 ASCOD !A CODE LIST - CHARACTER*6 SSCOD !S,U,O,X,Z,L CODE LIST - CHARACTER*5 ESCOD !E,F,D CODE LIST - CHARACTER*3 DSCOD !ANGLE CODE LIST - CHARACTER*2 CRLF !CR AND LF - DATA GCOD/'!*-+/_^%CASUOXZLEFDQ@'/ -C 123456789012345678901 - DATA ASCOD/'CDFSZL'/ -C 123456 - DATA SSCOD/'BWLIJK'/ -C 123456 - DATA ESCOD/'CADHP'/ -C 12345 - DATA DSCOD/'FRD'/ -C 123 -C -C Equivalences: -C -C -C Commons: -C -C- -C -C WNCTXT_X -C - OPS=.FALSE. !NOT OUTPUT STRING - IF (IAND(F_ALL,CODE).EQ.0) RETURN !NO OUTPUT WANTED - GOTO 10 -C -C WNCTXS_X -C - ENTRY WNCTXS_X(OST,TXT,ARGL) -C - OPS=.TRUE. !OUTPUT STRING - LOST=LEN(OST) !LENGTH - I=WNGASL(1,ARGL(0)) !INDICATE STRING FOR CONVEX - POST=0 !POINTER - OST=' ' !EMPTY STRING - GOTO 10 -C -C Initialize -C - 10 CONTINUE -C - FF = CHAR(12) - CR = CHAR(13) - CRLF(1:1) = CR - LF = CHAR(10) - CRLF(2:2) = LF - BACKS = CHAR(92) -C - I=WNGASL(2,ARGL(0)) !INDICATE STRING FOR CONVEX - LARG=ARGL(0) !# OF ARGUMENTS - PARG=2 !POINTER IN ARGL - LTXT=WNCAL0(TXT) !LENGTH TEXT - PTXT=0 !POINTER - LSPEC(1)=0 !Q WIDTH - LSPEC(2)=1 !Q OFFSET - LSPEC(3)=0 !Q , SEPARATION - LSPEC(4)=0 -C -C Scan text -C - 20 LOUT=OUTLEN !LENGTH OUTPUT LINE - POUT=0 !POINTER - OUT=' ' !EMPTY LINE -C -C If end -C - 23 IF (PTXT.GE.LTXT) THEN !NO MORE - IF (OPS) THEN !OUTPUT STRING - CALL WNCSAD(OUT,1,POUT,OST,LOST,POST) - ELSE !WRITE LINE - CALL WNCOUT(CODE,OUT,1,POUT) - END IF -C - RETURN !READY - END IF -C -C Find format -C - J=INDEX(TXT(PTXT+1:LTXT),'!') !FIND FORMAT - IF (J.EQ.0) THEN !NO MORE FORMAT - 21 CALL WNCSAD(TXT,PTXT+1,LTXT,OUT,LOUT,POUT) !WRITE LAST PART - PTXT=LTXT - GOTO 23 !FINISH - END IF -C -C Analyze code -C - CALL WNCSAD(TXT,PTXT+1,PTXT+J-1,OUT,LOUT,POUT) !SET TILL ! - PTXT=PTXT+J !! PTR - J1=PTXT-1 !SAVE POSITION ! - J2=PARG !SAVE ARG POSITION - WVAL=WNCAJA(TXT,LTXT,PTXT,ARGL(0),LARG,PARG) !GET WIDTH - IF (PTXT.LT.LTXT) THEN !CAN BE OK - IF (TXT(PTXT+1:PTXT+1).EQ.'$') THEN !REAL WIDTH - PTXT=PTXT+1 !SKIP $ - RVAL=WNCAJA(TXT,LTXT,PTXT,ARGL(0),LARG,PARG) !GET REPEAT - ELSE - RVAL=WVAL !SET REPEAT VALUE - WVAL=0 - END IF - ELSE - 22 PTXT=J1 !RESTORE FOR FORMAT ERROR - PARG=J2 - GOTO 21 - END IF - RVAL=MIN(OUTLEN,MAX(1,RVAL)) !CORRECT REPEAT FACTOR - WVAL=MAX(-OUTLEN,MIN(OUTLEN,WVAL)) !CORRECT WIDTH - IF (PTXT.GE.LTXT) GOTO 22 !FORMAT ERROR - MIND=INDEX(GCOD,WNCAUP(TXT(PTXT+1:PTXT+1))) !GET CODE - IF (MIND.EQ.0) GOTO 22 !UNKNOWN CODE - PTXT=PTXT+1 !SKIP CODE - IF (MIND.EQ.1 .OR. !! - 1 MIND.EQ.3 .OR. !- - 2 MIND.EQ.4 .OR. !+ - 3 MIND.EQ.5 .OR. !/ - 4 MIND.EQ.6 .OR. !_ - 5 MIND.EQ.7 .OR. !^ - 6 MIND.EQ.20 .OR. !Q - 8 MIND.EQ.21 .OR. !@ - 7 MIND.EQ.9) THEN !C READY - ELSE IF (MIND.EQ.2) THEN !* - IF (PTXT.GE.LTXT) GOTO 22 !FORMAT ERROR - PTXT=PTXT+1 - SIND=ICHAR(TXT(PTXT:PTXT)) !SAVE CHARACTER - ELSE IF (MIND.EQ.8) THEN !% - IF (PTXT.GE.LTXT) GOTO 22 !FORMAT ERROR - PTXT=PTXT+1 - IF (WNCAUP(TXT(PTXT:PTXT)).EQ.'D') THEN !%D - SIND=0 - ELSE IF (WNCAUP(TXT(PTXT:PTXT)).EQ.'T') THEN !%T - SIND=3 - ELSE - GOTO 22 !FORMAT ERROR - END IF - IF (PTXT.LT.LTXT) THEN - IF (WNCAUP(TXT(PTXT+1:PTXT+1)).EQ.'F') THEN - SIND=SIND+1 - PTXT=PTXT+1 - ELSE IF (WNCAUP(TXT(PTXT+1:PTXT+1)).EQ.'N') THEN - SIND=SIND+2 - PTXT=PTXT+1 - END IF - END IF - ELSE IF (MIND.EQ.10) THEN !A - SIND=0 - IF (PTXT.LT.LTXT) THEN - SIND=INDEX(ASCOD,WNCAUP(TXT(PTXT+1:PTXT+1))) - IF (SIND.NE.0) PTXT=PTXT+1 - END IF - ELSE IF (MIND.EQ.11 .OR. !S - 1 MIND.EQ.12 .OR. !U - 2 MIND.EQ.13 .OR. !O - 3 MIND.EQ.14 .OR. !X - 4 MIND.EQ.15 .OR. !Z - 5 MIND.EQ.16) THEN !L - SIND=0 - IF (PTXT.LT.LTXT) THEN - SIND=INDEX(SSCOD,WNCAUP(TXT(PTXT+1:PTXT+1))) - IF (SIND.NE.0) PTXT=PTXT+1 - END IF - ELSE IF (MIND.EQ.17 .OR. !E - 1 MIND.EQ.18 .OR. !F - 2 MIND.EQ.19) THEN !D - SIND=0 - IF (PTXT.LT.LTXT) THEN - SIND=INDEX(ESCOD,WNCAUP(TXT(PTXT+1:PTXT+1))) - IF (SIND.NE.0) PTXT=PTXT+1 - IF (SIND.GT.1) THEN - SIND2=0 - IF (PTXT.LT.LTXT) THEN - SIND2=INDEX(DSCOD,WNCAUP(TXT(PTXT+1:PTXT+1))) - IF (SIND2.NE.0) PTXT=PTXT+1 - END IF - END IF - END IF - ELSE - GOTO 22 !PROGRAMMING ERROR - END IF - VVAL=WNCAJA(TXT,LTXT,PTXT,ARGL(0),LARG,PARG) !GET MODIFIER - DOT=.FALSE. - IF (PTXT.LT.LTXT) THEN - IF (TXT(PTXT+1:PTXT+1).EQ.'.') THEN - DOT=.TRUE. !SET . SEEN - PTXT=PTXT+1 - END IF - END IF - SVAL=WNCAJA(TXT,LTXT,PTXT,ARGL(0),LARG,PARG) !GET SECONDARY MODIFIER - VVAL=MAX(0,MIN(OUTLEN,VVAL)) !LIMIT VALUES - SVAL=MAX(0,MIN(OUTLEN,SVAL)) - IF (PTXT.LT.LTXT) THEN - IF (TXT(PTXT+1:PTXT+1).EQ.BACKS.OR. - 1 TXT(PTXT+1:PTXT+1).EQ.'$') PTXT=PTXT+1 !SKIP TERMINATOR - END IF - IF (MIND.GE.10 .AND. MIND.NE.20. - 1 .AND. MIND.NE.21) THEN !USE ARGUMENT - IF (PARG.GE.LARG) GOTO 22 !FORMAT ERROR - PARG=PARG+1 !POINT TO CORRECT ARGUMENT - IF (ARGL(PARG).EQ.0) GOTO 22 !FORMAT ERROR - IF (MIND.EQ.10 .AND. (SIND.EQ.2 .OR. SIND.EQ.3)) THEN !NEED 2 ARGS - IF (PARG.GE.LARG) GOTO 22 !FORMAT ERROR - PARG=PARG+1 !POINT TO CORRECT ARGUMENT - IF (ARGL(PARG).EQ.0) GOTO 22 !FORMAT ERROR - END IF - END IF -C -C Do actual output -C - GOTO (110,120,130,140,150,160,170,180,190, - 1 200,210,210,210,210,210,210, - 1 270,270,290,300,125) MIND - GOTO 22 !PROGRAM ERROR -C ! - 110 J=RVAL - DO I=1,J !SET ! - CHLP(I:I)='!' - END DO - 111 CALL WNCFAD(CHLP,WVAL,OUTLEN,J) !ADJUST FIELD - CALL WNCSAD(CHLP,1,J,OUT,LOUT,POUT) !SET FIELD - GOTO 23 !GET NEXT FORMAT -C * - 120 J=RVAL - DO I=1,J !SET CHARACTERS - CHLP(I:I)=CHAR(SIND) - END DO - GOTO 111 -C @ - 125 J=RVAL - DO I=1,J - CHLP(I:I)=CHAR(9) - END DO - CALL WNCSAD(CHLP,1,J,OUT,LOUT,POUT) !SET FIELD - GOTO 23 -C - - 130 IF (PARG.LE.2) GOTO 22 !FORMAT ERROR - PARG=PARG-1 !RESET ARGUMENT - GOTO 23 !NEXT FORMAT -C + - 140 IF (PARG.GE.LARG) GOTO 22 !FORMAT ERROR - PARG=PARG+1 !RESET ARGUMENT - GOTO 23 !NEXT FORMAT -C / - 150 IF (OPS) THEN !STRING OUTPUT - CALL WNCSAD(OUT,1,POUT,OST,LOST,POST) - DO I=1,RVAL - CALL WNCSAD(CRLF,1,2,OST,LOST,POST) !SET CR/LF - END DO - ELSE - CALL WNCOUT(CODE,OUT,1,POUT) !WRITE LINE - DO I=1,RVAL-1 !WRITE EMPTY LINES - CALL WNCOUT(CODE,OUT,1,0) - END DO - END IF - GOTO 20 !NEW LINE -C _ - 160 POUT=MIN(LOUT,8*((POUT/8)+RVAL)) !SET TAB - GOTO 23 -C ^ - 170 IF (OPS) THEN !STRING OUTPUT - CALL WNCSAD(OUT,1,POUT,OST,LOST,POST) - DO I=1,RVAL - CALL WNCSAD(FF,1,1,OST,LOST,POST) !SET FF - END DO - ELSE - CALL WNCOUT(CODE,OUT,1,POUT) - DO I=1,RVAL !OUTPUT FF - CALL WNCOUT(CODE,FF,1,1) - END DO - END IF - GOTO 20 !NEW LINE -C % - 180 IF (SIND.EQ.0) THEN !SET DATE - CALL WNCDAT(CHLP,J) - ELSE IF (SIND.EQ.1) THEN - CALL WNCDAF(CHLP,J) - ELSE IF (SIND.EQ.2) THEN - CALL WNCDAN(CHLP,J) - ELSE IF (SIND.EQ.3) THEN - CALL WNCTIM(CHLP,J) - ELSE IF (SIND.EQ.4) THEN - CALL WNCTIF(CHLP,J) - ELSE IF (SIND.EQ.5) THEN - CALL WNCTIN(CHLP,J) - ELSE - GOTO 22 !PROGRAM ERROR - END IF - CALL WNCFAD(CHLP,WVAL,OUTLEN,J) !ADJUST FIELD - CALL WNCSAD(CHLP,1,J,OUT,LOUT,POUT) !OUTPUT FIELD - DO I=1,RVAL-1 - IF (LSPEC(3).EQ.0) CALL WNCSAD(', ',1,2,OUT,LOUT,POUT) !REPEAT - IF (LSPEC(1).GT.0 .AND. J+POUT.GT.LSPEC(1)) THEN !TOO LONG - IF (OPS) THEN !STRING OUTPUT - CALL WNCSAD(OUT,1,POUT,OST,LOST,POST) - ELSE - CALL WNCOUT(CODE,OUT,1,POUT) !WRITE LINE - END IF - LOUT=OUTLEN !LENGTH OUTPUT LINE - OUT=' ' !EMPTY LINE - POUT=MIN(LOUT,LSPEC(2)-1) !SET COLUMN POINTER - END IF - CALL WNCSAD(CHLP,1,J,OUT,LOUT,POUT) - END DO - GOTO 23 !NEXT FORMAT -C C - 190 J=POUT - POUT=MIN(LOUT,RVAL-1) !SET COLUMN - IF (POUT.LT.LOUT .AND. POUT.LT.J) OUT(POUT+1:LOUT)=' ' - GOTO 23 !NEXT FORMAT -C A - 200 IF (SIND.EQ.0 .OR. SIND.EQ.4) THEN !AS - I1=WNGASA(PARG,ARGL(0)) !STRING ADDRESS - I2=WNGASL(PARG,ARGL(0)) !STRING LENGTH - ELSE IF (SIND.EQ.1) THEN !AC - I1=ARGL(PARG)+4 !STRING ADDRESS - CALL WNGMV(4,A_B(ARGL(PARG)-A_OB),I2) !STRING LENGTH - ELSE IF (SIND.EQ.2 .OR. SIND.EQ.3) THEN !AD, AF - I1=ARGL(PARG-1) !STRING ADDRESS - CALL WNGMV(4,A_B(ARGL(PARG)-A_OB),I2) !STRING LENGTH - ELSE IF (SIND.EQ.5) THEN !AZ - I1=ARGL(PARG) !STRING ADDRESS - I2=WNCALZ(A_B(ARGL(PARG)-A_OB)) !STRING LENGTH - ELSE IF (SIND.EQ.6) THEN !AL - I1=ARGL(PARG) !STRING ADDRESS - I2=VVAL !STRING LENGTH - ELSE - GOTO 22 !PROGRAM ERROR - END IF - CALL WNCCAS(CHLP,J,A_B(I1-A_OB),I2) !MAKE STRING - IF (SIND.EQ.3) THEN !AF - DO I4=1,I2 !CHECK ALL CHARACTERS - IF (ICHAR(CHLP(I4:I4)).LE.32.OR. - 1 ICHAR(CHLP(I4:I4)).GE.128) CHLP(I4:I4)='.' !REPLACE - END DO - J=I2 - END IF - CALL WNCFAD(CHLP,WVAL,OUTLEN,J) !FIELD ADJUST - CALL WNCSAD(CHLP,1,J,OUT,LOUT,POUT) !SET FIELD - DO I=1,RVAL-1 !REPEAT - IF (SIND.EQ.0 .OR. SIND.EQ.4) THEN !AS - I1=I1+I2 !STRING ADDRESS - ELSE IF (SIND.EQ.1) THEN !AC - I1=I1+I2+4 !STRING ADDRESS - CALL WNGMV(4,A_B(I1-4-A_OB),I2) !STRING LENGTH - ELSE IF (SIND.EQ.2 .OR. SIND.EQ.3) THEN !AD, AF - I1=I1+I2 !STRING ADDRESS - ELSE IF (SIND.EQ.5) THEN !AZ - I1=I1+I2+1 !STRING ADDRESS - I2=WNCALZ(A_B(I1-A_OB)) !STRING LENGTH - ELSE IF (SIND.EQ.6) THEN !AL - I1=I1+I2 !STRING ADDRESS - END IF - CALL WNCCAS(CHLP,J,A_B(I1-A_OB),I2) !MAKE STRING - IF (SIND.EQ.3) THEN !AF - DO I4=1,I2 !CHECK ALL CHARACTERS - IF (ICHAR(CHLP(I4:I4)).LE.32.OR. - 1 ICHAR(CHLP(I4:I4)).GE.128) CHLP(I4:I4)='.' !REPLACE - END DO - J=I2 - END IF - CALL WNCFAD(CHLP,WVAL,OUTLEN,J) !FIELD ADJUST - IF (LSPEC(3).EQ.0) CALL WNCSAD(', ',1,2,OUT,LOUT,POUT) !SET SEPARATOR - IF (LSPEC(1).GT.0 .AND. J+POUT.GT.LSPEC(1)) THEN !TOO LONG - IF (OPS) THEN !STRING OUTPUT - CALL WNCSAD(OUT,1,POUT,OST,LOST,POST) - ELSE - CALL WNCOUT(CODE,OUT,1,POUT) !WRITE LINE - END IF - LOUT=OUTLEN !LENGTH OUTPUT LINE - OUT=' ' !EMPTY LINE - POUT=MIN(LOUT,LSPEC(2)-1) !SET COLUMN POINTER - END IF - CALL WNCSAD(CHLP,1,J,OUT,LOUT,POUT) !SET FIELD - END DO - GOTO 23 !NEXT FORMAT -C SUOXZL - 210 I1=ARGL(PARG) !DATA POINTER - IF (SIND.EQ.0 .OR. SIND.EQ.5) THEN !J - I2=L_J/L_B !DATA LENGTH - ELSE IF (SIND.EQ.2 .OR. SIND.EQ.4) THEN !I - I2=L_I/L_B - ELSE IF (SIND.EQ.3 .OR. SIND.EQ.6) THEN !K - I2=L_K/L_B - ELSE !B - I2=L_B/L_B - END IF - DO I=1,RVAL !REPEAT - IF (I2.EQ.4) THEN !K - CALL WNCCKS(CHLP,J,A_B(I1-A_OB),MIND-10) - ELSE IF (I2.EQ.2) THEN !I - CALL WNCCIS(CHLP,J,A_B(I1-A_OB),MIND-10) - ELSE IF (I2.EQ.1) THEN !B - CALL WNCCBS(CHLP,J,A_B(I1-A_OB),MIND-10) - ELSE !J - CALL WNCCJS(CHLP,J,A_B(I1-A_OB),MIND-10) - END IF - I1=I1+I2 !NEXT POINTER - CALL WNCFAD(CHLP,WVAL,OUTLEN,J) !ADJUST FIELD - IF (I.GT.1 .AND. LSPEC(3).EQ.0) - 1 CALL WNCSAD(', ',1,2,OUT,LOUT,POUT) - IF (LSPEC(1).GT.0 .AND. I.GT.1 .AND. J+POUT.GT.LSPEC(1)) THEN !LONG - IF (OPS) THEN !STRING OUTPUT - CALL WNCSAD(OUT,1,POUT,OST,LOST,POST) - ELSE - CALL WNCOUT(CODE,OUT,1,POUT) !WRITE LINE - END IF - LOUT=OUTLEN !LENGTH OUTPUT LINE - OUT=' ' !EMPTY LINE - POUT=MIN(LOUT,LSPEC(2)-1) !SET COLUMN POINTER - END IF - CALL WNCSAD(CHLP,1,J,OUT,LOUT,POUT) !SET FIELD - END DO - GOTO 23 !NEXT FORMAT -C EF - 270 I1=ARGL(PARG) !DATA ADDRESS - IF (DOT) THEN !SET FORMAT - I2=SVAL - ELSE - I2=-1 - END IF - DO I=1,RVAL !REPEAT - IF (SIND.EQ.0) THEN !NORMAL - CALL WNCCES(CHLP,J,A_B(I1-A_OB),VVAL,I2) - ELSE IF (SIND.EQ.1) THEN !COMPLEX - CALL WNCCXS(CHLP,J,A_B(I1-A_OB),VVAL,I2) - I1=I1+4 !NEXT POINTER - ELSE !ANGLE - IF (SIND2.EQ.0) SIND2=2 - CALL WNCCAE(CHLP,J,SIND2,SIND,A_B(I1-A_OB),VVAL,I2) - END IF - I1=I1+4 !NEXT POINTER - CALL WNCFAD(CHLP,WVAL,OUTLEN,J) !ADJUST FIELD - IF (I.GT.1 .AND. LSPEC(3).EQ.0) - 1 CALL WNCSAD(', ',1,2,OUT,LOUT,POUT) - IF (LSPEC(1).GT.0 .AND. I.GT.1 .AND. J+POUT.GT.LSPEC(1)) THEN !LONG - IF (OPS) THEN !STRING OUTPUT - CALL WNCSAD(OUT,1,POUT,OST,LOST,POST) - ELSE - CALL WNCOUT(CODE,OUT,1,POUT) !WRITE LINE - END IF - LOUT=OUTLEN !LENGTH OUTPUT LINE - OUT=' ' !EMPTY LINE - POUT=MIN(LOUT,LSPEC(2)-1) !SET COLUMN POINTER - END IF - CALL WNCSAD(CHLP,1,J,OUT,LOUT,POUT) !SET FIELD - END DO - GOTO 23 !NEXT FORMAT -C D - 290 I1=ARGL(PARG) !DATA ADDRESS - IF (DOT) THEN !SET FORMAT - I2=SVAL - ELSE - I2=-1 - END IF - DO I=1,RVAL !REPEAT - IF (SIND.EQ.0) THEN !NORMAL - CALL WNCCDS(CHLP,J,A_B(I1-A_OB),VVAL,I2) - ELSE IF (SIND.EQ.1) THEN !COMPLEX - CALL WNCCYS(CHLP,J,A_B(I1-A_OB),VVAL,I2) - I1=I1+8 !NEXT POINTER - ELSE !ANGLE - IF (SIND2.EQ.0) SIND2=2 - CALL WNCCAD(CHLP,J,SIND2,SIND,A_B(I1-A_OB),VVAL,I2) - END IF - I1=I1+8 !NEXT POINTER - CALL WNCFAD(CHLP,WVAL,OUTLEN,J) !ADJUST FIELD - IF (I.GT.1 .AND. LSPEC(3).EQ.0) - 1 CALL WNCSAD(', ',1,2,OUT,LOUT,POUT) - IF (LSPEC(1).GT.0 .AND. I.GT.1 .AND. J+POUT.GT.LSPEC(1)) THEN !LONG - IF (OPS) THEN !STRING OUTPUT - CALL WNCSAD(OUT,1,POUT,OST,LOST,POST) - ELSE - CALL WNCOUT(CODE,OUT,1,POUT) !WRITE LINE - END IF - LOUT=OUTLEN !LENGTH OUTPUT LINE - OUT=' ' !EMPTY LINE - POUT=MIN(LOUT,LSPEC(2)-1) !SET COLUMN POINTER - END IF - CALL WNCSAD(CHLP,1,J,OUT,LOUT,POUT) !SET FIELD - END DO - GOTO 23 !NEXT FORMAT -C Q - 300 LSPEC(1)=WVAL !LINE WIDTH - LSPEC(2)=RVAL !LINE OFFSET - LSPEC(3)=VVAL !, SEPARATION ON/OFF - LSPEC(4)=SVAL !SPARE - GOTO 23 !NEXT FORMAT -C -C - END diff --git a/src/wng/wnd.def b/src/wng/wnd.def deleted file mode 100644 index 500ee329fc8d69ee6e77780b5bcbba5a5ea9f4cf..0000000000000000000000000000000000000000 --- a/src/wng/wnd.def +++ /dev/null @@ -1,57 +0,0 @@ -C+ Created from wnd.dsc on 970828 at 16:57:18 at daw18 -C WND.DEF -C WNB 970828 -C -C Revisions: -C -C CMV 940224 Add MODELB -C WNB 940215 Add XMEM -C WNB 930803 Remove .INCLUDE -C WNB 920607 Add XUFLAG -C WNB 910913 Add for DATAB, INFIX, RUN, loops -C WNB 910909 Add RUNCD -C WNB 900130 Original version -C -C -C Given statements: -C -C -C Result: -C -C WND.DEF is an INCLUDE file for the DWARF interface routines -C -C -C -C Parameters: -C - INTEGER MXNLOP ! MAX. # OF LOOP INDICES - PARAMETER (MXNLOP=8) -C -C Data declarations: -C -C -C WND common data: -C - CHARACTER*80 DATAB ! CURRENT DATABASE - CHARACTER*80 PREFIX ! CURRENT PREFIX - LOGICAL RUNCD ! RUN (.TRUE.) INDICATOR - INTEGER XCAP ! CORR. TO APPLY - INTEGER XCDAP ! CORR. TO DE-APPLY - INTEGER XPOFF(0:7,0:1,0:8) ! LOOP OFFSETS GIVEN - INTEGER XLSAV(0:7,0:8) ! SAVED OFFSETS PER INDEX - INTEGER XLCNT(0:8) ! INDEX COUNT - INTEGER XLPTR ! CURRENT INDEX LEVEL - INTEGER XUFLAG ! CURRENT UFLAG OPTIONS - INTEGER XMEM ! MEMORY CHUNK SIZE - CHARACTER*80 MODELB ! DIRECTORY FOR MODELS -C -C WND common block: -C - COMMON /WND_COM/ DATAB,PREFIX,RUNCD, - 1 XCAP,XCDAP,XPOFF, - 1 XLSAV,XLCNT,XLPTR, - 1 XUFLAG,XMEM,MODELB -C -C Given statements: -C -C- diff --git a/src/wng/wnd.dsc b/src/wng/wnd.dsc deleted file mode 100644 index 417aa9333b859c89e074c9e841bb0a2605eda2cd..0000000000000000000000000000000000000000 --- a/src/wng/wnd.dsc +++ /dev/null @@ -1,49 +0,0 @@ -!+ WND.DSC -! WNB 900130 -! -! Revisions: -! -%REVISION=CMV=940224="Add MODELB" -%REVISION=WNB=940215="Add XMEM" -%REVISION=WNB=930803="Remove .INCLUDE" -%REVISION=WNB=920607="Add XUFLAG" -%REVISION=WNB=910913="Add for DATAB, INFIX, RUN, loops" -%REVISION=WNB=910909="Add RUNCD" -%REVISION=WNB=900130="Original version" -! -! Layout of DWARF interface include file (WND.DEF) -! -%COMMENT="WND.DEF is an INCLUDE file for the DWARF interface routines" -%COMMENT=" " -! -%VERSION=1 -%SYSTEM=1 -%USER=WNB -%%DATE -%%NAME -! -%ALIGN -! -%LOCAL=MXNLOP=8 !MAX. # OF LOOP INDICES -!- -.DEFINE - .PARAMETER - MXNLOP J /MXNLOP/ !MAX. # OF LOOP INDICES - .DATA -! -! Local variables: -! - .COMMON - DATAB C80 !CURRENT DATABASE - PREFIX C80 !CURRENT PREFIX - RUNCD L !RUN (.TRUE.) INDICATOR - XCAP J !CORR. TO APPLY - XCDAP J !CORR. TO DE-APPLY - XPOFF J(0:7,0:1,0:MXNLOP) !LOOP OFFSETS GIVEN - XLSAV J(0:7,0:MXNLOP) !SAVED OFFSETS PER INDEX - XLCNT J(0:MXNLOP) !INDEX COUNT - XLPTR J !CURRENT INDEX LEVEL - XUFLAG J !CURRENT UFLAG OPTIONS - XMEM J !MEMORY CHUNK SIZE - MODELB C80 !DIRECTORY FOR MODELS -.END diff --git a/src/wng/wnd.grp b/src/wng/wnd.grp deleted file mode 100644 index e4da11d390214469b59dba2a857f9374f4894fb1..0000000000000000000000000000000000000000 --- a/src/wng/wnd.grp +++ /dev/null @@ -1,111 +0,0 @@ -!+ WND.GRP -! WNB 890427 -! -! Revisions: -! WNB 910826 Add WNDSTQ -! WNB 910828 Add WNDPAP, WNDRUN -! WNB 910909 Add WNDSTI -! WNB 910913 Add WNDDAP, WNDXLP -! WNB 910916 Add WNDTCI, WNDTCK -! WNB 910930 Add WNDLON, WNDLOY -! WNB 911105 Add .FDW -! WNB 920122 Change FDW to CDW, add PAR_X -! WNB 920128 Add .%SW -! HjV 920525 Add HP -! WNB 921203 Add WNDXL1 -! WNB 921215 Hide .INC -! WNB 921216 FUN: WNDPAR_X CUN: WNDPAR -! HjV 930107 Put WNDPAR.FAL after WNDPAR.CUN -! HjV 930309 Add WNDSTA_X.FOR -! WNB 930510 Add WNDDIS -! HjV 930528 Add sgh_eqv.def and gfh_eqv.def -! WNB 930607 Add WNDDUF -! WNB 930607 Add WNDNOC -! WNB 930610 Add WNDDA1,2,3 -! HjV 930817 Remove sgh_eqv.def and gfh_eqv.def -! HjV 930914 Add entry WNDDA0 -! WNB 931015 Add SSH.DSF, SSH.DSC; separate WNDSTR, WNDSTS -! WNB 940215 Add WNDDAM -! WNB 940215 Add omitted WNDDAP_SET and WNDDUF_SET -! HjV 940217 Add/change missing entry-points/functions -! HjV 940726 Add missing entry-point WNDPAG -! HjV 940928 Add WNDPOH, WNDPOHC -! CMV 940930 Removed wndpar_x.fun -! JPH 941005 add WNDSTD -! AXC 010628 linux port -! -! DWARF interface routines -! -! Group definition: -! -WND.GRP -! -! PIN files -! -! -! Structure files -! -GFH.DSC ! General file header -SGH.DSC ! Sub-group header -SSH.DSF ! Define first part set header -SSH.DSC ! Define set related offsets and masks -! -! General command files -! -! -! Fortran definition files: -! -WND.DSC ! Common area WND.DEF -! -! Programs: -! -WNDDAB.FOR !WNDDAB Get database and other NGEN parameters - !WNDDA0 Ger database, infix and run code - !WNDDA1 Return apply bits - !WNDDA2 Return de-apply bits - !WNDDA3 Return UFLAG bits -WNDDAP.FOR !WNDDAP Get current apply/de-apply - !WNDDUF Get current UFLAG value - !WNDDAM Get current memory chunk size - !WNDDAP_SET set current apply/de-apply - !WNDDUF_SET set current UFLAG value -WNDDIS.FSC !WNDDIS Get X-display to use -WNDFIL.FOR !WNDFIL Convert nodename to file name -WNDINI.FOR !WNDINI Initialise DWARF -WNDLNF.FOR !WNDLNF Find/create a sub-group link -WNDLNG.FOR !WNDLNG Link a sub-group -WNDLNK.FOR !WNDLNK Link something in file -WNDLOG.FOR !WNDLOG Set user log option - !WNDLON Set user log option with NO default - !WNDLOY Set user log option with YES default -WNDNOD.FOR !WNDNOD Obtain node from user - !WNDNOC Change access of node after WNDNOD -WNDPAP.FOR !WNDPAP Set Dwarf user parameter - !WNDPAG Set Dwarf global symbol -WNDPAR.FVX !WNDPAR Get Dwarf user parameter - WNDPAR.CUN !WNDPD1 Dummy (AL only) - WNDPAR.FAL -WNDPOH.FOR !WNDPOH Set local prompt, options and help texts - !WNDPOHC Clear the local values -WNDRUN.FOR !WNDRUN Test if program to run -WNDSTA.FOR !WNDSTA Ask sets from user - !WNDSTQ Asks sets with prompt - !WNDSTM Return string representation of sets -WNDSTA_X.FOR !WNDSTA_X Extra layer of keywords below SETS -WNDSTG.FOR !WNDSTG Get next set specified - !WNDSTH Get next set, no version check - !WNDSTL Get next set with loop info - !WNDSTD Same, then delete index link to set -WNDSTI.FOR !WNDSTI Find an index for a set -WNDSTR.FOR !WNDSTR Reset set list status - !WNDSTS Save set list status -WNDTCI.FOR !WNDTCI Initiate disk table check - !WNDTCK Check and copy disk tables -WNDXLP.FOR !WNDXLP Get loop parameters from user - !WNDXL1 Set parameters for 1 loop - !WNDXLI Initiate loops - !WNDXLN Next loop value -! -! Executables -! -!- diff --git a/src/wng/wnd.inc b/src/wng/wnd.inc deleted file mode 100644 index 4264a23e46f79480bf1dae2af17be32536a173f9..0000000000000000000000000000000000000000 --- a/src/wng/wnd.inc +++ /dev/null @@ -1,55 +0,0 @@ -/*+ Created from wnd.dsc on 970828 at 16:57:18 at daw18 -.. WND.INC -.. WNB 970828 -.. -.. Revisions: -.. -.. CMV 940224 Add MODELB -.. WNB 940215 Add XMEM -.. WNB 930803 Remove .INCLUDE -.. WNB 920607 Add XUFLAG -.. WNB 910913 Add for DATAB, INFIX, RUN, loops -.. WNB 910909 Add RUNCD -.. WNB 900130 Original version -.. */ -/* -.. Given statements: -.. */ -/* -.. Result: -.. -.. WND.DEF is an INCLUDE file for the DWARF interface routines -.. -.. */ -/* -.. Parameters: -.. */ -#define MXNLOP 8 /* MAX. # OF LOOP INDICES */ -/* -.. Data declarations: -.. */ -/* -.. WND common data: -.. */ -struct wnd_com { - char datab[80]; /* CURRENT DATABASE */ - char prefix[80]; /* CURRENT PREFIX */ - unsigned int runcd; /* RUN (.TRUE.) INDICATOR */ - int xcap; /* CORR. TO APPLY */ - int xcdap; /* CORR. TO DE-APPLY */ - int xpoff[9][2][8]; /* LOOP OFFSETS GIVEN */ - int xlsav[9][8]; /* SAVED OFFSETS PER INDEX */ - int xlcnt[9]; /* INDEX COUNT */ - int xlptr; /* CURRENT INDEX LEVEL */ - int xuflag; /* CURRENT UFLAG OPTIONS */ - int xmem; /* MEMORY CHUNK SIZE */ - char modelb[80]; /* DIRECTORY FOR MODELS */ -}; -/* -.. WND common block: -.. */ -extern struct wnd_com wnd_com_ ; -/* -.. Given statements: -.. */ -/*- */ diff --git a/src/wng/wnddab.for b/src/wng/wnddab.for deleted file mode 100644 index ec524f784d401c4151550b154f5ced9995b5138a..0000000000000000000000000000000000000000 --- a/src/wng/wnddab.for +++ /dev/null @@ -1,428 +0,0 @@ -C+ WNDDAB.FOR -C WNB 900130 -C -C Revisions: -C WNB 910909 Add reading of DATAB, INFIX and RUN -C WNB 910913 Add reading of DE_APPLY, APPLY -C WNB 920303 SUN problems () -C HjV 920520 HP does not allow extended source lines -C WNB 921124 Make sure lc Database -C WNB 930602 Add IREF, CLK -C WNB 930607 Add UFLAG -C WNB 930610 Add WNDDA1,2,3 -C JPH 930615 CBITS_O_DEF -C WNB 930803 Make CBITS_DEF -C JPH 930826 WNDDA0 -C CMV 930909 Make NOISE equivalent to NOIS, correct WNDDA0 -C JEN 931130 WNDDA3: Use input YUFLAG for default string. -C CMV 931215 If default FL_MAN, do not show OLD in string. -C WNB 940215 Add reading of MEMORY -C CMV 940224 Add reading of MODELB -C WNB 940305 Add reading of X_ keywords -C CMV 940224 Also check environment for MODELB and DATAB -C - LOGICAL FUNCTION WNDDAB() -C -C Get Database, Infix and Run indicator and corrections -C -C Result: -C -C WNDDAB_L = WNDDAB() -C Get start database, infix and run code, flags to -C discard and corrections to apply; memory usage -C WNDDA0_L = WNDDA0() -C Get start database, infix and run code and memory only -C WNDDA1_L = WNDDA1( KW_C*:I, BITS_J:O) -C Get apply BITS from user with keyword KW -C WNDDA2_L = WNDDA2( KW_C*:I, BITS_J:O) -C Get de-apply BITS from user with keyword KW -C WNDDA3_L = WNDDA3( KW_C*:I, BITS_J:IO) -C Get flag BITS from user with keyword KW -C -C Include files: -C - INCLUDE 'WNG_DEF' - INCLUDE 'WND_DEF' - INCLUDE 'CBITS_DEF' -C -C PIN references: -C -C X_DATAB -C DATAB -C X_MODELB -C MODELB -C X_INFIX -C INFIX -C X_RUN -C RUN -C X_APPLY -C APPLY -C X_DE_APPLY -C DE_APPLY -C X_UFLAG -C UFLAG -C KW -C X_MEMORY -C MEMORY -C -C Entry points: -C - LOGICAL WNDDA0,WNDDA1,WNDDA2,WNDDA3 -C -C Parameters: -C - INTEGER TXTL !LENGTH INPUT DATA - PARAMETER (TXTL=16) - INTEGER MAXDEF !# OF INPUTS - PARAMETER (MAXDEF=16) - INTEGER MXNAPP !KNOWN APPLIED - PARAMETER (MXNAPP=11) - INTEGER MXNDAP !KNOWN DE-APPLIED - PARAMETER (MXNDAP=10) - INTEGER MXNUFL !KNOWN UFLAG KEYS - PARAMETER (MXNUFL=9) -C -C Arguments: -C - CHARACTER*(*) KW !USER KEYWORD - INTEGER BITS !BITS MADE -C -C Function references: -C - LOGICAL WNDPAR !GET USER PARAMETER - LOGICAL WNDPAP !SET USER PARAMETER -C -C Data declarations: -C - INTEGER TP !TYPE OF CALL - INTEGER YCAP,YCDAP,YUFLAG !LOCAL DATA BITS - CHARACTER*(TXTL) TXT(MAXDEF) !INPUT DATA - CHARACTER*80 DFLTXT !DEFAULT STRING - - CHARACTER*4 TAPP(MXNAPP) !APPLIED - DATA TAPP/'RED','ALG','OTH','EXT','REF','IREF', - 1 'CLK','POL','FAR','IFR','MIFR'/ - INTEGER SAPP(MXNAPP) - DATA SAPP/CAP_RED, CAP_ALG, CAP_OTH, CAP_XTNC, CAP_REFR, CAP_IREF, - 1 CAP_CLK, CAP_POL, CAP_FAR, CAP_AIFR, CAP_MIFR/ - - CHARACTER*4 TDAP(MXNDAP) !DE-APPLIED - DATA TDAP /'OTH','EXT','REF','IREF','CLK', - 1 'FAR','MOD','IFR','MIFR','SHFT'/ - INTEGER SDAP(MXNDAP) - DATA SDAP /CAP_OTH, CAP_XTNC, CAP_REFR, CAP_IREF, CAP_CLK, - 1 CAP_FAR, CAP_MOD, CAP_AIFR, CAP_MIFR, CAP_SHFT/ - - CHARACTER*4 TUFL(MXNUFL) !UFLAG - DATA TUFL /'OLD','MAN','CLIP','NOIS','SHAD','ADD', - 1 'U1','U2','U3'/ - INTEGER SUFL(MXNUFL) - DATA SUFL/FL_OLD, FL_MAN, FL_CLIP, FL_NOIS, FL_SHAD, FL_ADD, - 1 FL_1, FL_2, FL_3/ - - LOGICAL*1 BB1 -C- -C -C WNDDAB -C - TP=0 !GET ALL - GOTO 10 -C -C WNDDA0 -C - ENTRY WNDDA0() -C - TP=4 - GOTO 10 -C -C WNDDA1 -C - ENTRY WNDDA1(KW,BITS) -C - TP=1 - GOTO 10 -C -C WNDDA2 -C - ENTRY WNDDA2(KW,BITS) -C - TP=2 - GOTO 10 -C -C WNDDA3 -C - ENTRY WNDDA3(KW,BITS) -C - TP=3 - YUFLAG = BITS !USE INPUT AS DEFAULT - GOTO 10 -C -C INIT -C - 10 CONTINUE - IF (TP.EQ.0 .OR. TP.EQ.4) THEN !DAB or DA0 - DATAB=' ' !ASSUME EMPTY FOR NOW - MODELB=' ' !DIRECTORY FOR MODELS - PREFIX=' ' !USER PREFIX - RUNCD=.TRUE. !RUN PROGRAM - END IF - WNDDAB=.TRUE. !ASSUME OK - YCAP=-1 !APPLY ALL - YCDAP=0 !DE-APPLY NONE - IF (TP.NE.3) YUFLAG = 0 !...... -C -C DATABASE -C - IF (TP.EQ.0 .OR. TP.EQ.4) THEN - JS=WNDPAR('X_DATAB',DATAB,LEN(DATAB),J0) - IF (JS) THEN !RESET SWITCH VALUE - JS=WNDPAP('X_DATAB','# /NOASK') - ELSE - JS=WNDPAR('DATAB',DATAB,LEN(DATAB),J0,'""') - END IF - IF (.NOT.JS) THEN - DATAB=' ' !ASSUME NOT GIVEN - ELSE - IF (J0.LE.0) THEN !ASSUME NOT GIVEN - DATAB=' ' - END IF - END IF - IF (DATAB.EQ.' '.OR.DATAB.EQ.'*') THEN - CALL WNGSEG('DATAB',DATAB) - END IF - CALL WNCALC(DATAB) !MAKE SURE LC - END IF -C -C MODEL DIRECTORY -C - IF (TP.EQ.0 .OR. TP.EQ.4) THEN - JS=WNDPAR('X_MODELB',MODELB,LEN(MODELB),J0) - IF (JS) THEN !RESET SWITCH VALUE - JS=WNDPAP('X_MODELB','# /NOASK') - ELSE - JS=WNDPAR('MODELB',MODELB,LEN(MODELB),J0,'""') - END IF - IF (.NOT.JS) THEN - MODELB=' ' !ASSUME NOT GIVEN - ELSE - IF (J0.LE.0) THEN !ASSUME NOT GIVEN - MODELB=' ' - END IF - END IF - IF (MODELB.EQ.' '.OR.MODELB.EQ.'*') THEN - CALL WNGSEG('MODELB',MODELB) - END IF - CALL WNCALC(MODELB) !MAKE SURE LC - END IF -C -C INFIX -C - IF (TP.EQ.0 .OR. TP.EQ.4) THEN - JS=WNDPAR('X_INFIX',PREFIX,LEN(PREFIX),J0) - IF (JS) THEN !RESET SWITCH VALUE - JS=WNDPAP('X_INFIX','# /NOASK') - ELSE - JS=WNDPAR('INFIX',PREFIX,LEN(PREFIX),J0,'""') - END IF - IF (.NOT.JS) THEN - PREFIX=' ' !ASSUME NOT GIVEN - ELSE - IF (J0.LE.0) THEN !ASSUME NOT GIVEN - PREFIX=' ' - END IF - END IF - END IF -C -C MEMORY -C - IF (TP.EQ.0 .OR. TP.EQ.4) THEN - JS=WNDPAR('X_MEMORY',XMEM,LB_J,J0) - IF (JS) THEN !RESET SWITCH VALUE - JS=WNDPAP('X_MEMORY','# /NOASK') - ELSE - JS=WNDPAR('MEMORY',XMEM,LB_J,J0) - END IF - IF (.NOT.JS) THEN - XMEM=100000 !ASSUME NOT GIVEN - ELSE - IF (J0.LE.0) THEN !ASSUME NOT GIVEN - XMEM=100000 - END IF - END IF - END IF -C -C RUN CODE -C - IF (TP.EQ.0 .OR. TP.EQ.4) THEN - JS=WNDPAR('X_RUN',BB1,LB_B,J0) - IF (JS) THEN !RESET SWITCH VALUE - JS=WNDPAP('X_RUN','# /NOASK') - ELSE - JS=WNDPAR('RUN',BB1,LB_B,J0,'YES') - IF (JS .AND. J0.GT.0 .AND. .NOT.BB1) !RESET RUNNING - 1 JS=WNDPAP('RUN','YES') - END IF - IF (.NOT.JS) THEN - RUNCD=.TRUE. !ASSUME RUN - ELSE - RUNCD=.TRUE. !ASSUME RUN - IF (J0.GT.0) THEN - IF (.NOT.BB1) THEN !NO RUN - RUNCD=.FALSE. - END IF - END IF - END IF - END IF -C -C GET APPLY -C - IF (TP.EQ.0 .OR. TP.EQ.1) THEN - IF (TP.EQ.0) THEN - JS=WNDPAR('X_APPLY',TXT,MAXDEF*TXTL,J0) - IF (JS) THEN !RESET SWITCH VALUE - JS=WNDPAP('X_APPLY','# /NOASK') - ELSE - JS=WNDPAR('APPLY',TXT,MAXDEF*TXTL,J0,'*') - END IF - ELSE - JS=WNDPAR(KW,TXT,MAXDEF*TXTL,J0,'*') - END IF - IF (.NOT.JS) THEN !GET INFO - YCAP=-1 !ASSUME ALL - ELSE - IF (J0.EQ.0) THEN - YCAP=0 !ASSUME NONE - ELSE IF (J0.LT.0) THEN !ALL - YCAP=-1 - ELSE - YCAP=0 - DO I=1,J0 !ALL INPUTS - IF (TXT(I).EQ.'NONE') THEN - YCAP=0 - ELSE IF (TXT(I).EQ.'ALL') THEN - YCAP=-1 - ELSE - DO I1=1,MXNAPP - IF (TXT(I).EQ.TAPP(I1)) THEN !FOUND - YCAP=IOR(YCAP,SAPP(I1)) !SET - ELSE IF (TXT(I).EQ.'NO'//TAPP(I1)) THEN - YCAP=IAND(YCAP,IEOR(SAPP(I1),CAP_ALLMSK)) - END IF - END DO - END IF - END DO - END IF - END IF - END IF -C -C GET DE-APPLY -C - IF (TP.EQ.0 .OR.TP.EQ.2) THEN - IF (TP.EQ.0) THEN - JS=WNDPAR('X_DE_APPLY',TXT,MAXDEF*TXTL,J0) - IF (JS) THEN !RESET SWITCH VALUE - JS=WNDPAP('X_DE_APPLY','# /NOASK') - ELSE - JS=WNDPAR('DE_APPLY',TXT,MAXDEF*TXTL,J0,'NONE') - END IF - ELSE - JS=WNDPAR(KW,TXT,MAXDEF*TXTL,J0,'NONE') - END IF - IF (.NOT.JS) THEN !GET INFO - YCDAP=0 !ASSUME NONE - ELSE - IF (J0.EQ.0) THEN - YCDAP=0 !ASSUME NONE - ELSE IF (J0.LT.0) THEN !ALL - YCDAP=-1 - ELSE - YCDAP=0 - DO I=1,J0 !ALL INPUTS - IF (TXT(I).EQ.'NONE') THEN - YCDAP=0 - ELSE IF (TXT(I).EQ.'ALL') THEN - YCDAP=-1 - ELSE - DO I1=1,MXNDAP - IF (TXT(I).EQ.TDAP(I1)) THEN !FOUND - YCDAP=IOR(YCDAP,SDAP(I1)) !SET - ELSE IF (TXT(I).EQ.'NO'//TDAP(I1)) THEN - YCDAP=IAND(YCDAP,IEOR(SDAP(I1),CAP_ALLMSK)) - END IF - END DO - END IF - END DO - END IF - END IF - END IF -C -C GET UFLAG -C - IF (TP.EQ.0 .OR. TP.EQ.3) THEN - IF (TP.EQ.0) THEN - JS=WNDPAR('X_UFLAG',TXT,MAXDEF*TXTL,J0) - IF (JS) THEN !RESET SWITCH VALUE - JS=WNDPAP('X_UFLAG','# /NOASK') - ELSE - JS=WNDPAR('UFLAG',TXT,MAXDEF*TXTL,J0,'NONE') - END IF - ELSE - DFLTXT = 'NONE' !DEFAULT - I = 1 - DO I1=1,MXNUFL - IF (SUFL(I1).NE.FL_OLD.AND. !Ignore OLD (=MAN) - 1 IAND(YUFLAG,SUFL(I1)).NE.0) THEN !DEFAULT FLAG TYPE - DFLTXT(I:) = TUFL(I1)(:4)//',' !ADD TO DEFAULT STRING - I = I+5 !INCREMENT POINTER - END IF - END DO - IF (I.GT.1) DFLTXT(I-1:) = ' ' !REMOVE CLOSING COMMA - IF (YUFLAG.EQ.FL_ALL) DFLTXT = 'ALL' - IF (YUFLAG.EQ.0) DFLTXT = 'NONE' !DEFAULT - JS=WNDPAR(KW,TXT,MAXDEF*TXTL,J0,DFLTXT) - END IF - IF (.NOT.JS) THEN !GET INFO - YUFLAG=0 !ASSUME NONE - ELSE - IF (J0.EQ.0) THEN - YUFLAG=0 !ASSUME NONE - ELSE IF (J0.LT.0) THEN !ALL - YUFLAG=FL_ALL - ELSE - YUFLAG=0 - DO I=1,J0 !ALL INPUTS - IF (TXT(I).EQ.'NONE') THEN - YUFLAG=0 - ELSE IF (TXT(I).EQ.'ALL') THEN - YUFLAG=FL_ALL - ELSE - IF (TXT(I).EQ.'NOISE') TXT(I)='NOIS' - DO I1=1,MXNUFL - IF (TXT(I).EQ.TUFL(I1)) THEN !FOUND - YUFLAG=IOR(YUFLAG,SUFL(I1)) !SET - END IF - END DO - END IF - END DO - END IF - END IF - END IF -C -C READY -C - IF (TP.EQ.0) THEN !SET GLOBAL - XCAP=YCAP - XCDAP=YCDAP - XUFLAG=YUFLAG - ELSE IF (TP.EQ.1) THEN !RETURN APPLY - BITS=YCAP - ELSE IF (TP.EQ.2) THEN !RETURN DE-APPLY - BITS=YCDAP - ELSE IF (TP.EQ.3) THEN !RETURN UFLAG - BITS=YUFLAG - END IF -C - RETURN !READY -C -C - END diff --git a/src/wng/wnddap.for b/src/wng/wnddap.for deleted file mode 100644 index ff1d9dfefc7016373f16d19ebcf61e3d31b0e462..0000000000000000000000000000000000000000 --- a/src/wng/wnddap.for +++ /dev/null @@ -1,90 +0,0 @@ -C+ WNDDAP.FOR -C WNB 900913 -C -C Revisions: -C WNB 930602 Add IREF, CLK -C WNB 930607 Add WNDDUF -C JPH 930615 Remove comments on flag bits -C JEN 931209 Add entry-points WNDDUF_SET and WNDDAP_SET -C WNB 940215 Add WNDDAM -C - SUBROUTINE WNDDAP(CAP,CDAP) -C -C Get/set current apply/de-apply corrections or UFLAG bits -C -C Result: -C -C CALL WNDDAP( CAP_J:O, CDAP_J:O) -C Return the current apply (CAP) and de-apply (CDAP) -C corrections. -C CALL WNDDUF( CAP_J:O) -C Return the current unflag (CAP) flags -C CALL WNDDAM( CAP_J:O) -C Return the current memory chunk size -C CALL WNDDAP_SET( CAP_J:I, CDAP_J:I) -C Override the current apply (CAP) and de-apply (CDAP) -C corrections. -C CALL WNDDUF_SET( CAP_J:I) -C Override the current unflag (CAP) flags -C -C Include files: -C - INCLUDE 'WNG_DEF' - INCLUDE 'WND_DEF' -C -C Parameters: -C -C -C Arguments: -C - INTEGER CAP !CORRECTIONS TO APPLY - INTEGER CDAP !CORRECTYIONS TO DE-APPLY -C -C Function references: -C -C -C Data declarations: -C -C- -C -C WNDDAP -C - CAP=XCAP !GET - CDAP=XCDAP -C - RETURN !READY -C -C WNDDUF -C - ENTRY WNDDUF(CAP) -C - CAP=XUFLAG !GET -C - RETURN -C -C WNDDAM -C - ENTRY WNDDAM(CAP) -C - CAP=XMEM !GET -C - RETURN -C -C WNDDAP_SET -C - ENTRY WNDDAP_SET(CAP,CDAP) -C - XCAP=CAP !SET - XCDAP=CDAP -C - RETURN !READY -C -C WNDDUF_SET -C - ENTRY WNDDUF_SET(CAP) -C - XUFLAG=CAP !SET -C - RETURN -C - END diff --git a/src/wng/wnddis.fsc b/src/wng/wnddis.fsc deleted file mode 100644 index da8a98b498dffadeb8a892c4c8eb7ed05c9e7e1e..0000000000000000000000000000000000000000 --- a/src/wng/wnddis.fsc +++ /dev/null @@ -1,195 +0,0 @@ -C+ WNDDIS.FOR -C WNB 930510 -C -C Revisions: -C CMV 931004 First test if local GIPSY setup -C CMV 931022 Add END clause -C CMV 931112 For GIDS, change DISP to DEFAULT_DISPLAY -C AXC 010628 Linux port (READONLY) -C CMV 030123 Allow other displays than *:0.0 -C - LOGICAL FUNCTION WNDDIS(NGT,DISP) -C -C Ask X-display to be used -C -C Result: -C -C WNDDIS_L = WNDDIS( NGT_L:I) -C Ask the user for the X-window display to use, -C and put in DISP. -C If NGT .true. the GIDS interface will be -C produced as well. -C -C Pin references: -C -C DISPLAY -C -C Include files: -C - INCLUDE 'WNG_DEF' -C -C Parameters: -C -C -C Arguments: -C - LOGICAL NGT !NGIDS SWITCH - CHARACTER*(*) DISP !DISPLAY -C -C Function references: -C - LOGICAL WNDPAR !GET USER PARAMETER - INTEGER WNCALN !STRING LENGTH -C -C Data declarations: -C - CHARACTER*24 HOST !CURRENT HOST - CHARACTER*256 LDISP !LOCAL DISP - CHARACTER*256 LGIPSY !GIP_LOC DIRECTORY - CHARACTER*256 LFILE !GIPSY TVDEVICES FILE - CHARACTER*128 LINE !INPUT LINE - CHARACTER*128 NAME !Dummy name - CHARACTER*128 VAL !Dummy Char val - INTEGER LUN !INPUT/OUTPUT LUN - INTEGER LL !LENGTH OF DISP - LOGICAL FOUND !FOUND ENTRY IN TVDEVICES -C- -C -C GET DISPLAY -C - WNDDIS=.TRUE. !ASSUME OK - LUN=0 !NO LUN YET -C - CALL WNGSEG('DISPLAY',LDISP) !GET POSSIBLE DISPLAY ENVIRONM. - CALL WNGSGH(HOST) !GET CURRENT HOST - IF (LDISP.EQ.' ') LDISP=HOST !MAKE DEFAULT - IF (.NOT.WNDPAR('DISPLAY',DISP,LEN(DISP),J0,LDISP)) THEN - GOTO 900 !ERROR - ELSE IF (J0.LE.0) THEN - DISP=LDISP !ASSUME DEFAULT - ELSE - CALL WNCALC(DISP) !MAKE LC - END IF -C** I=INDEX(DISP,':') !GET RID OF DISPLAY NUMBER -C** IF (I.GT.0) DISP(I:)=' ' !ASSUME :0.0 -C** IF (DISP.EQ.' ') DISP=HOST - IF (DISP.EQ.':0.0'.OR.DISP.EQ.':1.0') THEN - DISP=HOST//DISP - END IF -C -C MAKE STRING FOR tvdevices -C - LL=WNCALN(DISP) - I=INDEX(DISP,':') - LDISP=DISP(1:I-1)//'\:'//DISP(I+1:LL) - LL=WNCALN(LDISP) -C -C MAKE GIDS ENVIRONMENT -C - IF (NGT) THEN -C -C TEST IF THIS MACHINE IS DEFINED IN LOCAL GIPSY SETUP -C - FOUND=.FALSE. - CALL WNGLUN(LUN) !GET LUN TO USE - IF (LUN.EQ.0) GOTO 903 !NO FREE LUN -C -C CHECK gids_setup/tvdevices -C - IF (.NOT.FOUND) THEN - NAME='gids_setup' - CALL WNGSEG(NAME,LGIPSY) - IF (LGIPSY.NE.' ') THEN - LFILE=LGIPSY(1:WNCALN(LGIPSY))//'/tvdevices' - OPEN (UNIT=LUN,FILE=LFILE,STATUS='OLD', -#ifdef wn_li__ - 1 ERR=901) !OPEN INPUT -#else - 1 READONLY,ERR=901) !OPEN INPUT -#endif - DO WHILE (.NOT.FOUND) - READ(LUN,'(A)',ERR=901,END=901) LINE - FOUND=(LINE(1:LL).EQ.LDISP) - END DO - 901 CONTINUE - CLOSE(LUN) - END IF - END IF -C -C CHECK gip_loc/tvdevices -C - IF (.NOT.FOUND) THEN - NAME='gip_loc' - CALL WNGSEG(NAME,LGIPSY) - IF (LGIPSY.NE.' ') THEN - LFILE=LGIPSY(1:WNCALN(LGIPSY))//'/tvdevices' - OPEN (UNIT=LUN,FILE=LFILE,STATUS='OLD', -#ifdef wn_li__ - 1 ERR=902) !OPEN INPUT -#else - 1 READONLY,ERR=902) !OPEN INPUT -#endif - DO WHILE (.NOT.FOUND) - READ(LUN,'(A)',ERR=902,END=902) LINE - FOUND=(LINE(1:LL).EQ.LDISP) - END DO - 902 CONTINUE - CLOSE(LUN) - END IF - END IF -C -C IF NOT DEFINED, MAKE TEMPORARY tvdevices -C - IF (.NOT.FOUND) THEN - OPEN(UNIT=LUN,FILE='tvdevices',STATUS='UNKNOWN',ERR=903) - WRITE(LUN,905) HOST(1:WNCALN(HOST)),LDISP(1:LL) - 905 FORMAT('# ',A,/,A,':0:$n_exe/gids.exe:153600',/,'# end') - CLOSE(LUN) - NAME='gids_setup' - VAL='.' - CALL WNGSES(NAME,VAL) !LOCATE DEVICE FILE - END IF -C -C GIDS uses an interface file. To preserve consistency when the GIDS -C process runs on another machine, we have to define a full path. -C The name is passed though the environment variable in DISP. -C - DISP='DEFAULT_DISPLAY' - CALL WNGSEG(DISP,LGIPSY) - IF (LGIPSY.EQ.' ') THEN - CALL WNGSEG('HOME',LGIPSY) - IF (LGIPSY.NE.' ') THEN - LGIPSY=LGIPSY(:WNCALN(LGIPSY))//'/.gids_sockets.1' - ELSE - LGIPSY='gids_sockets.1' - END IF - CALL WNGSES(DISP(:WNCALN(DISP)),LGIPSY(:WNCALN(LGIPSY))) - END IF -C - ELSE -C** DISP=DISP(:WNCALN(DISP))//':0.0' !FINAL DISPLAY NAME - END IF - GOTO 800 -C -C ERROR -C - 903 CONTINUE - CALL WNCTXT(F_TP,'Cannot open tvdevices file') - 900 CONTINUE - WNDDIS=.FALSE. !ERROR - DISP=' ' -C -C FINISH -C - 800 CONTINUE - IF (LUN.NE.0) CALL WNGLUF(LUN) !FREE LUN -C - RETURN -C -C - END - - - - - diff --git a/src/wng/wndfil.for b/src/wng/wndfil.for deleted file mode 100644 index 3ddbc17d5debf7f212bdfb16e067dc27b4cefcc9..0000000000000000000000000000000000000000 --- a/src/wng/wndfil.for +++ /dev/null @@ -1,215 +0,0 @@ -C+ WNDFIL.FOR -C WNB 900130 -C -C Revisions: -C WNB 910909 Add save of Infix and Datab -C CMV 940223 DATAB not used if set to "*" -C CMV 940422 If NODIN ends in PFX, assume user typed PFX himself -C CMV 940808 Option to select names from list of matching names -C CMV 940822 Message if DATAB/INFIX change (previously in DWARF) -C - LOGICAL FUNCTION WNDFIL(NODIN,PFX,NODOUT,FILOUT) -C -C Convert given node name to file name and full node name -C -C Result: -C -C WNDFIL_J = WNDFIL( NODIN_C*:I, PFX_C*:I, NODOUT_C*:O, -C FILOUT_C*:O ) -C Convert node NODIN into file name FILOUT, using -C postfix PFX. NODOUT gives the translated input -C node name. -C -C Include files: -C - INCLUDE 'WNG_DEF' - INCLUDE 'WND_DEF' -C -C PIN: -C -C DATAB -C INFIX -C -C Parameters: -C -C -C Arguments: -C - CHARACTER*(*) NODIN !INPUT NODE NAME - CHARACTER*(*) PFX !NAME TRAILER - CHARACTER*(*) NODOUT !NODE NAME RETURNED - CHARACTER*(*) FILOUT !OUTPUT FILE NAME -C -C Function references: -C - INTEGER WNCALN !STRING LENGTH - INTEGER WNCAJ !GET VALUE FROM STRING - LOGICAL WNGSDL !LIST MATCHING NODES - LOGICAL WNDPAP !SAVE USER PARAMETER -C -C Data declarations: -C - CHARACTER*160 STRIN,STRIN1 !COPY INPUT - LOGICAL NODATAB !DO NOT UPDATE DATAB - LOGICAL DO_NEXT !USED IN FILE SEARCHING - LOGICAL DO_DATAB !FLAG DATAB CHANGED -C- -C -C GET/SET DATABASE -C - WNDFIL=.TRUE. !ASSUME OK - STRIN=NODIN - NODATAB=(DATAB.EQ.'*') !Use datab? -C -C HANDLE PURE FILENAMES -C - IF (INDEX(STRIN,'@').NE.0) THEN !PURE FILE NAME - FILOUT=STRIN(INDEX(STRIN,'@')+1:) - NODOUT='UNKNOWN' !NO NODE GIVEN - RETURN - END IF -C -C GET Nth FILE FROM LIST -C - IF (STRIN(1:1).EQ.'#'.AND. - 1 STRIN(2:2).GE.'0'.AND.STRIN(2:2).LE.'9') THEN - I1=1 !OFFSET FOR WNCAJ - I3=WNCAJ(STRIN,WNCALN(STRIN),I1) !GET VALUE - I1=1 !INIT SEARCH - I2=0 !COUNT MATCHES - DO_NEXT=.TRUE. !FIND FILES - DO WHILE (DO_NEXT) - IF (WNGSDL(STRIN,DATAB,PFX,I1)) THEN !FIND NEXT - I2=I2+1 !COUNT THIS ONE - DO_NEXT=(I2.NE.I3) - ELSE - DO_NEXT=.FALSE. !NO MORE FILES - END IF - END DO - IF (I2.EQ.I3) THEN !FOUND Nth - CALL WNCTXT(F_T,'Selected node !AS',STRIN) - ELSE !NOT FOUND - CALL WNCTXT(F_T,'Could not find node #!UJ',I3) - WNDFIL=.FALSE. !ERROR RETURN - RETURN - END IF - END IF -C -C EXTRACT DATABASE NAME -C - DO_DATAB=.FALSE. !ASSUME NOT CHANGED - IF (INDEX(STRIN,']').NE.0) THEN !DATABASE GIVEN - DATAB=STRIN(1:INDEX(STRIN,']')) !SAVE DATABASE - STRIN1=STRIN(INDEX(STRIN,']')+1:) - STRIN=STRIN1 - DO_DATAB=.TRUE. - ELSE IF (INDEX(STRIN,':').NE.0) THEN - DATAB=STRIN(1:INDEX(STRIN,':')) !SAVE DATABASE - STRIN1=STRIN(INDEX(STRIN,':')+1:) - STRIN=STRIN1 - DO_DATAB=.TRUE. - ELSE IF (INDEX(STRIN,'/') .NE.0) THEN - J=INDEX(STRIN,'/') - DO WHILE (INDEX(STRIN(J+1:),'/').NE.0) !SEARCH END - J=J+INDEX(STRIN(J+1:),'/') - END DO - DATAB=STRIN(1:J) !SAVE DATABASE - STRIN1=STRIN(J+1:) - STRIN=STRIN1 - DO_DATAB=.TRUE. - END IF -C - IF (DO_DATAB) THEN - CALL WNCALC(DATAB) !MAKE SURE LC - IF (.NOT.NODATAB) THEN - JS=WNDPAP('NGEN$DATAB',DATAB) !SAVE DATA BASE GENERAL - CALL WNCTXT(F_T, - 1 'Your default directory (DATAB) is now !AS', - 1 DATAB(:WNCALN(DATAB))) - END IF - END IF -C -C FILL PREFIX -C - 10 CONTINUE - J=INDEX(STRIN,'#') - IF (J.NE.0) THEN - IF (PREFIX.NE.' ') THEN - STRIN1=STRIN(1:J-1)//PREFIX(1:WNCALN(PREFIX))//STRIN(J+1:) !COPY - ELSE - STRIN1=STRIN(1:J-1)//STRIN(J+1:) !COPY - END IF - STRIN=STRIN1 - GOTO 10 !RETRY - END IF -C -C FIND PREFIX -C - J=INDEX(STRIN,'(') - IF (J.NE.0) THEN - J1=INDEX(STRIN(J+1:),')') - IF (J1.EQ.0) THEN !NO CLOSING ) - FILOUT=' ' - NODOUT=' ' - WNDFIL=.FALSE. - RETURN - END IF - PREFIX=STRIN(J+1:J+J1-1) !SAVE PREFIX - JS=WNDPAP('NGEN$INFIX',PREFIX) !SAVE PREFIX GENERAL - CALL WNCTXT(F_T, - 1 'INFIX is now !AS (replaces # in nodenames)', - 1 PREFIX(:WNCALN(PREFIX))) -C - IF (J.EQ.1) THEN !DELETE () - STRIN1=STRIN(J+1:J+J1-1)//STRIN(J+J1+1:) - ELSE - STRIN1=STRIN(1:J-1)//STRIN(J+1:J+J1-1)//STRIN(J+J1+1:) - END IF - STRIN=STRIN1 - END IF -C -C STRIP PFX IF ACCIDENTALLY GIVEN BY USER -C - J0=WNCALN(STRIN) - J=WNCALN(PFX) - IF (J0.GT.J+1) THEN - IF (STRIN(J0-J:J0).EQ.'.'//PFX(1:3)) STRIN=STRIN(:J0-J-1) - END IF -C -C SET CONVERTED NODE NAME -C - NODOUT=STRIN - J0=WNCALN(STRIN)+1 !APPEND . - STRIN(J0:J0)='.' -C -C CONVERT TO FILE NAME -C - 20 CONTINUE - J=INDEX(STRIN,'.') !POSITION . - IF (J.NE.0) THEN !MAKE _ - STRIN(J:J)='_' - GOTO 20 - END IF - J1=1 - 21 CONTINUE - J2=INDEX(STRIN(J1+1:),'_') !SET . - IF (J1+J2.GT.36 .OR. J2.EQ.0) THEN - STRIN(J1:J1)='.' - ELSE - J1=J1+J2 - GOTO 21 - END IF - STRIN(J0+1:)=PFX !ADD POSTFIX - CALL WNCAUC(STRIN) !MAKE SURE UC - IF (DATAB.EQ.' '.OR.DATAB.EQ.'*') THEN !RETURN FILE NAME - FILOUT=STRIN - ELSE - FILOUT=DATAB(1:WNCALN(DATAB))//STRIN - END IF -C - IF (NODATAB) DATAB='*' !Reset datab -C - RETURN !READY -C -C - END diff --git a/src/wng/wndini.for b/src/wng/wndini.for deleted file mode 100644 index 842ce2a7e30e4c9b5fc0ab379c6a0308ffea3499..0000000000000000000000000000000000000000 --- a/src/wng/wndini.for +++ /dev/null @@ -1,47 +0,0 @@ -c+ WNDINI.FOR -C WNB 900130 -C -C Revisions: -C HjV 930205 Prog_start needs two arguments -C JPH 940912 WNDPOH -C -C - LOGICAL FUNCTION WNDINI(PNM) -C -C Initialise DWARF -C -C Result: -C -C WNDINI_J = WNDINI( PNM_C*:I) -C Initialise DWARF for program PNM -C -C Include files: -C - INCLUDE 'WNG_DEF' -C -C Parameters: -C -C -C Arguments: -C - CHARACTER*(*) PNM !PROGRAM NAME -C -C Function references: -C - INTEGER PROG_START !START DWARF -C -C Data declarations: -C -C- - E_C=PROG_START(PNM,0) !INIT. DWARF - CALL WNDPOHC ! init. dynamic defaults - IF (IAND(E_C,1).EQ.1) THEN !CHECK ERROR - WNDINI=.TRUE. - ELSE - WNDINI=.FALSE. - END IF -C - RETURN !READY -C -C - END diff --git a/src/wng/wndlnf.for b/src/wng/wndlnf.for deleted file mode 100644 index b4a1eba68300f614ec04ae95b1367ce9781897a9..0000000000000000000000000000000000000000 --- a/src/wng/wndlnf.for +++ /dev/null @@ -1,102 +0,0 @@ -C+ WNDLNF.FOR -C WNB 900306 -C -C Revisions: -C JPH 920118 Detailed comments; informative variable names -C JPH 930527 Detailed comments; informative variable names -C WNB 930803 Remove gfh_eqv, sgh_eqv -C JPH 941005 Signal existing/new SGH through E_C -C -C - LOGICAL FUNCTION WNDLNF(PLHDP,NEWID,IDOFF,FCA,SGHP,SGHN) -C -C Find/create a set-group in a file -C -C Result: -C -C WNDLNF_L = WNDLNF -C (PLHDP_J:I, NEWID_J:I, IDOFF_J:I, FCA_J:I, SGHP_J:O, SGHN_J:O) -C -C Find/create an SGH area with identifier NEWID on disk in a -C linked list with parent listhead PLHDP in file FCA. -C If IDOFF>0 an identification is set. -C The file address of the SGH created is returned in SGHP -C its ID in SGHN -C Upon successful exit, E_C is set to show whether an existing SGH -C was found (E_C=0) or a new one had to be created (E_C=1) -C -C -C Include files: -C - INCLUDE 'WNG_DEF' - INCLUDE 'GFH_O_DEF' !GENERAL FILE HEADER - INCLUDE 'SGH_O_DEF' !SUB-GROUP HEADER -C -C Parameters: -C -C -C Arguments: -C - INTEGER PLHDP !DISK POINTER LINK PLHDP - INTEGER NEWID !SUB-GROUP TO FIND - INTEGER IDOFF !OFFSET TO AN ID - INTEGER FCA !FILE CONTROL AREA - INTEGER SGHP !POINTER TO SUB-GROUP CREATED - INTEGER SGHN !SUB-GROUP # CREATED -C -C Function references: -C - LOGICAL WNFRD !READ FILE - LOGICAL WNDLNG !LINK IN SUB-GROUP LIST -C -C Data declarations: -C - INTEGER SGHJ(0:SGHHDL/4-1) !SUB-GROUP HEADER - INTEGER SGH1J(0:SGHHDL/4-1) !SUB-GROUP HEADER -C- - WNDLNF=.TRUE. !ASSUME OK -C - IF (.NOT.WNFRD(FCA,SGHHDL,SGHJ(0), - 1 PLHDP-SGH_LHD_1+SGH_LINK_1)) - 1 GOTO 900 !read parent SGH -C -C LLEN in this SGH contains the ID of the next child SGH to be created, so -C if NEWID is >= it, it does not yet exist - IF (NEWID.GE.SGHJ(SGH_LLEN_J)) THEN -C -C Create the missing SGHs - DO I=SGHJ(SGH_LLEN_J),NEWID - IF (.NOT.WNDLNG(PLHDP,0,IDOFF,FCA, - 1 SGHP,SGHN)) GOTO 900 - END DO - E_C=1 ! signal "new SGH created" - RETURN - ELSE -C -C Follow the queue to the requested SGH. (NOTE: This could be done more directly -C through a DO I=0, NEWID-1 if we assume that the sequence of ID numbers is -C intact. The more cumbersome implementation below provides a partial check -C on this.) - SGHP=SGHJ(SGH_LHD_J) !Listhead ptr to 1st element - DO I=0,SGHJ(SGH_LLEN_J)-1 - IF (.NOT.WNFRD(FCA,SGHHDL, - 1 SGH1J(0),SGHP)) GOTO 900 - IF (SGH1J(SGH_NAME_J).EQ.NEWID) - 1 THEN !FOUND - SGHN=NEWID - E_C=0 ! signal "existing SGH found" - RETURN - END IF - SGHP=SGH1J(SGH_LINK_J) !TRY NEXT - END DO - GOTO 900 !NOT FOUND, file corrupted - END IF -C -C ERROR -C - 900 CONTINUE - WNDLNF=.FALSE. !ERROR - RETURN -C -C - END diff --git a/src/wng/wndlng.for b/src/wng/wndlng.for deleted file mode 100644 index 1081532ec61d6744c591fda527cd583379bc59ca..0000000000000000000000000000000000000000 --- a/src/wng/wndlng.for +++ /dev/null @@ -1,117 +0,0 @@ -C+ WNDLNG.FOR -C WNB 900306 -C -C Revisions: -C JPH 920118 Detailed comments, more informative variable names -C JPH 930527 Detailed comments, more informative variable names -C WNB 930803 Remove _eqv -C -C - LOGICAL FUNCTION WNDLNG(PLHDP,DATAP,IDOFF,FCA,SGHP,SGHN) -C -C Create and link a new subgroup header -C -C Result: -C -C WNDLNG_L = -C WNDLNG( PLHDP_J:I, DATAP_J:I, IDOFF_J:I, FCA_J:I, SGHP_J:O, SGHN_J:O) -C Create an SGH on disk for data at DATAP and link it -C at the tail of the queue headed by PLHDP in file FCA. -C If IDOFF>0 an identification is set. -C The file address of the new SGH is returned in SGHP, -C its ID in SGHN. -C -C Include files: -C - INCLUDE 'WNG_DEF' - INCLUDE 'GFH_O_DEF' !GENERAL FILE HEADER - INCLUDE 'SGH_O_DEF' !SUB-GROUP HEADER -C -C Parameters: - INTEGER F,B,N !FIELDS - PARAMETER (F=0, B=1, N=2) !forw/backw link, list length -C -C Arguments: -C - INTEGER PLHDP !File address of listhead - INTEGER DATAP !File address of data - !(0 if none) - INTEGER IDOFF !Offset to ID field in new SGH - INTEGER FCA !FILE CONTROL AREA - INTEGER SGHP !POINTER TO SUB-GROUP CREATED - INTEGER SGHN !SUB-GROUP # CREATED -C -C Function references: -C - LOGICAL WNFRD !READ FILE - LOGICAL WNFWR !WRITE FILE - INTEGER WNFEOF !FILE POSITION - LOGICAL WNDLNK !LINK IN LIST -C -C Data declarations: - INTEGER LISTHD(F:N) !Listhead buffer - INTEGER NEW(F:B) !New area's LINK field - INTEGER TAIL(F:B) !Queue tail's LINK field - INTEGER SGHJ(0:SGHHDL/4-1) !SGH buffer - INTEGER PSGHJ(0:SGHHDL/4-1)! - INTEGER SGHJP !pointer to SGH -C- - WNDLNG=.TRUE. !ASSUME OK - CALL WNGMVZ(SGHHDL,SGHJ(0)) !EMPTY HEADER - SGHJP=WNFEOF(FCA) !WHERE TO WRITE -C -C Create SGH area - SGHJ(SGH_LHD_J)=SGHJP+SGH_LHD_1 !Listhead LHD of as yet empty - SGHJ(SGH_LHD_J+1)=SGHJ(SGH_LHD_J) !queue: points to itself - SGHJ(SGH_PLHD_J)=PLHDP !Back pointer to parent listhead - SGHJ(SGH_STHP_J)=DATAP !DATA POINTER - IF (.NOT.WNFWR(FCA,SGHHDL,SGHJ(0),SGHJP)) - 1 GOTO 900 !WRITE HEADER -C -C Link it into the queue headed by PLHDP, set ID in GROUPN field, -C then read it back in (SGHJP is the disk address) - IF (.NOT.WNDLNK(PLHDP,SGHJP,SGH_NAME_1,FCA)) - 1 GOTO 900 - IF (.NOT.WNFRD(FCA,SGHHDL,SGHJ(0),SGHJP)) - 1 GOTO 900 -C -C If listhead coincides with LHD field of GFH it is at level 0: - IF (PLHDP.EQ.GFH_LINKG_1) THEN -C -C Clear full name - DO I=0,7 - SGHJ(SGH_FNAME_J+I)=-1 - END DO - ELSE -C -C Read the parent SGH and copy its full name - IF (.NOT.WNFRD(FCA,SGHHDL,PSGHJ(0), - 1 PLHDP-SGH_LHD_1+SGH_LINK_1)) GOTO 900 - DO I=0,7 - SGHJ(SGH_FNAME_J+I)=PSGHJ(SGH_FNAME_J+I) - END DO - END IF -C -C Extend the full name with the ID of the present SGH - DO I=0,7 !EXTEND NAME - IF (SGHJ(SGH_FNAME_J+I).EQ.-1) THEN - SGHJ(SGH_FNAME_J+I)=SGHJ(SGH_NAME_J) - GOTO 10 - END IF - END DO - 10 CONTINUE -C - IF (.NOT.WNFWR(FCA,SGHHDL,SGHJ(0),SGHJP)) - 1 GOTO 900 !REWRITE SGH - SGHP=SGHJP !RETURN its file address - SGHN=SGHJ(SGH_NAME_J) !and its ID - RETURN !READY -C -C ERROR -C - 900 CONTINUE - WNDLNG=.FALSE. !ERROR - RETURN -C -C - END diff --git a/src/wng/wndlnk.for b/src/wng/wndlnk.for deleted file mode 100644 index ef543f8c12fa19177bb113c458c4ea46168ca553..0000000000000000000000000000000000000000 --- a/src/wng/wndlnk.for +++ /dev/null @@ -1,96 +0,0 @@ -C+ WNDLNK.FOR -C WNB 900306 -C -C Revisions: -C JPH 920222 Detailed comments, informative variable names -C WNB 930303 Correct PARAMETER -C JPH 930420 Legibilisation revisited -C JPH 920527 Detailed comments, informative variable names -C -C - LOGICAL FUNCTION WNDLNK(LHDP,NEWP,IDOFF,FCA) -C -C Link an entity in a file -C -C Result: -C -C WNDLNK_L = WNDLNK( LHDP_J:I, NEWP_J:I, IDOFF_J:I, FCA_J:I) -C Link a new area on disk at address NEWP at the tail -C of a linked list with listhead LHDP in file FCA. If -C IDOFF>0 an identification is set at offset IDOFF in -C the new area. -C -C Include files: -C - INCLUDE 'WNG_DEF' -C -C Parameters: - INTEGER F,B,N !FIELDS - PARAMETER (F=0, B=1, N=2) !forward/backward link fields -C -C Arguments: -C - INTEGER LHDP !DISK POINTER LINK HEAD - INTEGER NEWP !DISK POINTER AREA - INTEGER IDOFF !OFFSET TO AN ID - INTEGER FCA !FILE CONTROL AREA -C -C Function references: -C - LOGICAL WNFRD !READ FILE - LOGICAL WNFWR !WRITE FILE -C -C Data declarations: - INTEGER LHD(F:N) !copy of listhead - INTEGER NEW(F:B) !copy of NEWP's LINK field - INTEGER TAIL(F:B) !copy of LINK field - !of last element in queue -C- - WNDLNK=.TRUE. !ASSUME OK -C -C Read 12 bytes at offset LHDP into LHD: -C The parent SGH's LINKG+LINKGN fields, i.e. the listhead plus length of the -C queue - IF (.NOT.WNFRD(FCA,12,LHD,LHDP)) - 1 GOTO 900 -C -C Read 8 bytes af offset LHD(B) (which is the back link) into TAIL. This is -C the LINK field of the last area in the queue - IF (.NOT.WNFRD(FCA,8,TAIL,LHD(B))) - 1 GOTO 900 !READ OLD LINK -C -C Link NEWP into queue; NEW is the new LINK field for NEWP -C - NEW(F)=TAIL(F) !successor of TAIL becomes - !successor of NEWP - TAIL(F)=NEWP !NEWP becomes successor of TAIL - NEW(B)=LHD(B) !TAIL becomes - !predecessor of NEW - LHD(B)=NEWP !NEW becomes tail - IF (IDOFF.GT.0) LHD(N)=LHD(N)+1 !increment parent's LINKGN -C -C Copy NEW into NEWP's LINK field - IF (.NOT.WNFWR(FCA,8,NEW,NEWP)) GOTO 900 -C -C Write NEWP into the forward LINK field of NEW's predecessor - IF (.NOT.WNFWR(FCA,4,TAIL,NEW(B))) GOTO 900 -C -C Update back link and count fields in listhead - IF (.NOT.WNFWR(FCA,8,LHD(B),LHDP+4)) - 1 GOTO 900 -C -C Copy old count value into NEWP's ID field - IF (IDOFF.GT.0) THEN !SET ID - IF (.NOT.WNFWR(FCA,4,LHD(N)-1, - 1 NEWP+IDOFF)) GOTO 900 - END IF - RETURN -C -C ERROR -C - 900 CONTINUE - WNDLNK=.FALSE. !ERROR - RETURN -C -C - END diff --git a/src/wng/wndlog.for b/src/wng/wndlog.for deleted file mode 100644 index aa9f99e4947f2d2c09c774b764627d082e0cb999..0000000000000000000000000000000000000000 --- a/src/wng/wndlog.for +++ /dev/null @@ -1,106 +0,0 @@ -C+ WNDLOG.FOR -C WNB 900130 -C -C Revisions: -C WNB 910930 Add WNDLON, WNDLOY -C WNB 940305 Add X_LOG -C - SUBROUTINE WNDLOG(LCD) -C -C Get/set correct log code -C -C Result: -C -C CALL WNDLOG( LCD_J:O ) -C Initialise log code LCD, assuming PIN default -C CALL WNDLON( LCD_J:O ) -C Initialise log code LCD, assuming NO default -C CALL WNDLOY( LCD_J:O ) -C Initialise log code LCD, assuming YES default -C -C PIN references: -C -C X_LOG -C LOG -C -C Include files: -C - INCLUDE 'WNG_DEF' - INCLUDE 'WNC_DEF' -C -C Parameters: -C -C -C Arguments: -C - INTEGER LCD !LOG CODE -C -C Function references: -C - LOGICAL WNDPAR !GET LOG CODE - LOGICAL WNDPAP !SET X_LOG CODE -C -C Data declarations: -C - EXTERNAL WNCEXH !EXIT HANDLER - INTEGER DEFVAL !DEFAULT VALUE - CHARACTER*8 TXT -C- - CALL WNGSXF(CEXH(1)) !CLEAR EXIT HANDLER !!DWARF - CALL WNGSXH(CEXH(1),WNCEXH) !RESET IT - DEFVAL=F_SP - JS=WNDPAR('X_LOG',TXT,LEN(TXT),J0) !SEE IF SWITCH - IF (JS) THEN - JS=WNDPAP('X_LOG','# /NOASK') - ELSE - JS=WNDPAR('LOG',TXT,LEN(TXT),J0) !ASK LOG - END IF - GOTO 10 -C -C WNDLON -C - ENTRY WNDLON(LCD) -C - CALL WNGSXF(CEXH(1)) !CLEAR EXIT HANDLER !!DWARF - CALL WNGSXH(CEXH(1),WNCEXH) !RESET IT - DEFVAL=F_NO - JS=WNDPAR('X_LOG',TXT,LEN(TXT),J0) !SEE IF SWITCH - IF (JS) THEN - JS=WNDPAP('X_LOG','# /NOASK') - ELSE - JS=WNDPAR('LOG',TXT,LEN(TXT),J0,'NO') !ASK LOG - END IF - GOTO 10 -C -C WNDLOY -C - ENTRY WNDLOY(LCD) -C - CALL WNGSXF(CEXH(1)) !CLEAR EXIT HANDLER !!DWARF - CALL WNGSXH(CEXH(1),WNCEXH) !RESET IT - DEFVAL=F_YES - JS=WNDPAR('X_LOG',TXT,LEN(TXT),J0) !SEE IF SWITCH - IF (JS) THEN - JS=WNDPAP('X_LOG','# /NOASK') - ELSE - JS=WNDPAR('LOG',TXT,LEN(TXT),J0,'YES') !ASK LOG - END IF - GOTO 10 -C - 10 CONTINUE - IF (.NOT.JS) THEN - LCD=DEFVAL !SET SPOOL FOR NOW - ELSE IF (TXT.EQ.'YES') THEN !SET LOG CODE - LCD=F_YES - ELSE IF (TXT.EQ.'NO') THEN - LCD=F_NO - ELSE IF (TXT.EQ.'CATEN') THEN - LCD=F_CAT - ELSE - LCD=F_SP - END IF -C - RETURN !READY -C -C - END diff --git a/src/wng/wndnod.for b/src/wng/wndnod.for deleted file mode 100644 index 1dbe57e41def89b50049295c642f812dcec90dee..0000000000000000000000000000000000000000 --- a/src/wng/wndnod.for +++ /dev/null @@ -1,369 +0,0 @@ -C+ WNDNOD.FOR -C WNB 900130 -C -C Revisions: -C WNB 910909 Delete WND.DEF reference -C WNB 930413 Give message if creating 'update' node -C Maybe solve HP logical problem -C HjV 930513 Replace in CLOSE-statement DISP= by STATUS= -C WNB 930607 Add WNDNOC -C CMV 930922 Also try lowercase name if opened for 'R', 'U' -C CMV 940223 Ignore DATAB if equal to '*' -C CMV 940224 Search model files in MODELB as well -C CMV 940422 Give warning for datatype -C CMV 940504 Option to list matching names by answer ** -C CMV 940808 Number matching files in list -C CMV 940822 Decent message if open fails -C CMV 940823 Show DATAB first time a node is asked -C JPH 940829 Indent DATAB display as for WNCXP* -C JPH 940907 Call WNDPOHC at all RETURNs -C CMV 000928 Add scanning of MODELB directory for **, show MODELB first -C CMV 001107 Disabled scanning of MODELB directory for ** (show with *+) -C -C - LOGICAL FUNCTION WNDNOD(KW,USP,PFX,TP,NODOUT,FILOUT) -C -C Obtain node name from user -C -C Result: -C -C WNDNOD_J = WNDNOD( KW_C*:I, USP_C*:I, PFX_C*:I, TP_C1:I, -C NODOUT_C*:O, FILOUT_C*:O) -C Obtain a node NODOUT for the PFX node type. Use -C USP as default value, and the keyword KW for the -C user prompt. The type TP can be: R (read), W (write) or -C U (update: old if present, else create new). -C Default: U -C WNDNOC_J = WNDNOC( KW_C*:I, USP_C*:I, PFX_C*:I, TP_C1:I, -C NODOUT_C*:O, FILOUT_C*:O) -C Change the TP of FILOUT only. KW, USP not -C used. Useage in program e.g. to change from 'R' to 'U': -C WNFCL(FCA) -C WNDNOC(.....,'U',' ',FILE_NAME) -C WNFOP(FCA,FILE_NAME,...) -C -C PIN: -C -C 'KW' !Given by caller -C DELETE_NODE !To overwrite node -C -C Include files: -C - INCLUDE 'WNG_DEF' - INCLUDE 'WND_DEF' - INCLUDE 'GFH_O_DEF' !GENERAL FILE HEADER -C -C Parameters: -C -C -C Arguments: -C - CHARACTER*(*) KW !PIN KEYWORD - CHARACTER*(*) USP !USER DEFAULT - CHARACTER*(*) PFX !FILE TYPE (NORMALLY 3 LONG) - CHARACTER*(*) TP !R/W/U TYPE - CHARACTER*(*) NODOUT !NODE NAME (80 NORMALLY) - CHARACTER*(*) FILOUT !OUTPUT FILE NAME (160) -C -C Entry points: -C - LOGICAL WNDNOC -C -C Function references: -C - INTEGER WNCALN !STRING LENGTH - LOGICAL WNDPAR !GET USER DATA - LOGICAL WNDFIL !CONVERT NODE TO FILE - CHARACTER*1 WNCAUP !CONVERT TO UC - LOGICAL WNFOP !OPEN FILE - LOGICAL WNFWR,WNFRD !READ/WRITE FILE - LOGICAL WNGSDL !LIST MATCHING NODES -C -C Data declarations: -C - INTEGER CVT !DATA TYPE - BYTE GFH(0:GFHHDL-1) !FILE HEADER - INTEGER GFH_J(0:GFHHDL/4-1) - EQUIVALENCE(GFH,GFH_J) - CHARACTER*23 DTTM !DATE/TIME - CHARACTER*(GFH_ID_N) SID !ID HEADER - LOGICAL NOC !NOC TYPE - LOGICAL*1 LG1 - LOGICAL LJ, LG4 - INTEGER LN,LD,LF !LENGTH OF STRINGS -C - LOGICAL FIRST !FIRST TIME NODE ASKED - DATA FIRST/.TRUE./ - SAVE FIRST -C- -C -C INIT -C - NOC=.FALSE. !NOT NOC -C -C RESTART -C - 10 CONTINUE - A_J(0)=1 ! hold local prompt etc. - WNDNOD=.TRUE. !ASSUME OK - IF (NOC) THEN !CANNOT REPEAT - WNDNOD=.FALSE. - E_C=0 - CALL WNDPOHC - RETURN - END IF -C -C GET USER NODE INPUT -C - IF (FIRST) THEN !SHOW DATAB FIRST TIME - CALL WNCTXT(F_T, - 1 '!4C\Your default directory (DATAB) is !AS', - 1 DATAB(:WNCALN(DATAB))) - CALL WNCTXT(F_T, - 1 '!4C\Your default model directory (MODELB) is !AS', - 1 MODELB(:WNCALN(MODELB))) - FIRST=.FALSE. - END IF -C - IF (USP.NE.' ') THEN - JS=WNDPAR(KW,NODOUT,LEN(NODOUT),J0,USP(1:WNCALN(USP))) !GET NODE - ELSE - JS=WNDPAR(KW,NODOUT,LEN(NODOUT),J0,'""') !GET NODE - END IF - IF (.NOT.JS) THEN !ERROR - IF (E_C.EQ.DWC_ENDOFLOOP) THEN !^Z - WNDNOD=.FALSE. !READY - NODOUT=' ' - FILOUT=' ' - CALL WNDPOHC - RETURN - ELSE - GOTO 10 !RETRY - END IF - END IF - IF (J0.EQ.0) THEN !"" - NODOUT=' ' - FILOUT=' ' - E_C=DWC_NULLVALUE - CALL WNDPOHC - RETURN - END IF - IF (J0.EQ.-1) THEN !* - NODOUT=' ' - FILOUT=' ' - E_C=DWC_WILDCARD - CALL WNDPOHC - RETURN - END IF -C -C MAKE FILE NAME -C - IF (.NOT.WNDFIL(NODOUT,PFX,NODOUT,FILOUT)) THEN !GET FILE NAME - 20 CONTINUE - CALL WNCTXT(F_TP,'Format error in database/node specification') - GOTO 10 - END IF -C -C GENERATE LIST OF MATCHING NAMES IN DATAB IF ** ANSWERED FOR FILE -C - IF (PFX(1:3).EQ.'MDL'.AND.NODOUT(1:2).EQ.'*+') THEN - CALL WNCTXT(F_T,'List of !AS nodes in directory !AS:', - 1 PFX,MODELB) - I1=1 !INIT SEARCH - DO WHILE (WNGSDL(FILOUT,MODELB,PFX,I1)) !FIND NEXT - CALL WNCTXT(F_T,' !AS',FILOUT) !SHOW - END DO - CALL WNCTXT(F_T,' ') - GOTO 10 !ASK AGAIN - ELSE IF (NODOUT(1:1).EQ.'*') THEN - CALL WNCTXT(F_T,'List of !AS nodes in directory !AS:', - 1 PFX,DATAB) - I1=1 !INIT SEARCH - I2=1 !COUNT MATCHES - DO WHILE (WNGSDL(FILOUT,DATAB,PFX,I1)) !FIND NEXT - CALL WNCTXT(F_T,'#!UJ = !AS',I2,FILOUT) !SHOW - I2=I2+1 - END DO - IF (PFX.EQ.'MDL') CALL WNCTXT(F_T, - 1 'Type *+ to list directory !AS',MODELB) - CALL WNCTXT(F_T,' ') - GOTO 10 !ASK AGAIN - END IF -C - GOTO 30 !FOUND FILE -C -C Entry WNDNOC -C - ENTRY WNDNOC(KW,USP,PFX,TP,NODOUT,FILOUT) -C - WNDNOC=.TRUE. !ASSUME OK - NOC=.TRUE. !NOC TYPE -C - 30 CONTINUE - LN=WNCALN(NODOUT) - LF=WNCALN(FILOUT) - LD=WNCALN(DATAB) -C -C READ -C - IF (WNCAUP(TP(1:1)).EQ.'R') THEN !OLD FILE - I1=WNCALN(DATAB) - IF (DATAB.EQ.' '.OR.DATAB.EQ.'*') I1=0 !NO DATAB - I2=WNCALN(MODELB) - IF (MODELB.EQ.' '.OR.MODELB.EQ.'*') I2=0 !NO MODELB -C -C CALL WNCTXT(F_P,'Trying !AS',FILOUT) - INQUIRE(FILE=FILOUT,ERR=20,EXIST=LJ) !FILE EXISTS? - IF (.NOT.LJ.AND.PFX.EQ.'MDL'.AND.I2.GT.0) THEN !TRY MDL FILE - FILOUT=MODELB(1:I2)//FILOUT(I1+1:) !IN MODELB -C CALL WNCTXT(F_P,'Trying !AS',FILOUT) - INQUIRE(FILE=FILOUT,ERR=20,EXIST=LJ) !FILE EXISTS? - IF (.NOT.LJ) FILOUT=DATAB(1:I1)//FILOUT(I2+1:) !RESTORE DATAB - END IF - IF (.NOT.LJ) THEN !TRY LOWERCASE NAME - CALL WNCALC(FILOUT) !LOWERCASE ALL - IF (I1.GT.0) FILOUT=DATAB(1:I1)//FILOUT(I1+1:) !RESTORE DATAB -C CALL WNCTXT(F_P,'Trying !AS',FILOUT) - INQUIRE(FILE=FILOUT,ERR=20,EXIST=LJ) !FILE EXISTS? - IF (.NOT.LJ.AND.PFX.EQ.'MDL'.AND.I2.GT.0) THEN !TRY MDL FILE - FILOUT=MODELB(1:I2)//FILOUT(I1+1:) ! IN MODELB -C CALL WNCTXT(F_P,'Trying !AS',FILOUT) - INQUIRE(FILE=FILOUT,ERR=20,EXIST=LJ) !FILE EXISTS? - END IF - ENDIF - LF=WNCALN(FILOUT) !MAY HAVE CHANGED - IF (.NOT.LJ) THEN !READY - CALL WNCTXT(F_TP,'Node !AS does not exist in !AS', - 1 NODOUT(:LN),DATAB(:LD)) - GOTO 10 - END IF - IF (.NOT.WNFOP(J,FILOUT,'R')) THEN !CHECK - CALL WNCTXT(F_TP,'Cannot open file !AS',FILOUT(:LF)) - GOTO 10 - END IF - IF (.NOT.WNFRD(J,GFHHDL,GFH(0),0)) THEN !READ HEADER - CALL WNCTXT(F_TP, - 1 'Cannot read file header for !AS',FILOUT(:LF)) - CALL WNFCL(J) - GOTO 10 - END IF - CALL WNGMTS(GFH_ID_N,GFH(GFH_ID_C),SID) !GET ID - IF (SID.NE.'.'//PFX(1:3)) THEN - CALL WNCTXT(F_TP,'Specified node is not of !AS type',PFX) - CALL WNFCL(J) - GOTO 10 - END IF - CVT=GFH(GFH_DATTP_B) - CALL WNTTCH(CVT,PRGDAT,L0) !TEST TRANSLATE - IF (L0) CALL WNCTXT(F_TP, - 1 'Node has different datatype, please convert with CVX') - CALL WNFCL(J) - CALL WNDPOHC - RETURN !CORRECT NODE -C -C WRITE -C - ELSE IF (WNCAUP(TP(1:1)).EQ.'W' .AND. .NOT.NOC) THEN !NEW FILE - 32 CONTINUE - INQUIRE(FILE=FILOUT,ERR=20,EXIST=LJ) !FILE EXISTS? - IF (.NOT.LJ ) THEN !NO - IF (.NOT.WNFOP(J,FILOUT,'W')) THEN !CREATE - CALL WNCTXT(F_TP,'Error creating file !AS',FILOUT(:LF)) - GOTO 10 - END IF - CALL WNGMVZ(GFHHDL,GFH(0)) !CLEAR HEADER - CALL WNGMFS(GFH_ID_N,'.'//PFX(:3),GFH(GFH_ID_C)) !SET ID - GFH_J(GFH_LEN_J)=GFHHDL !LENGTH - GFH_J(GFH_VER_J)=GFHHDV !VERSION - CALL WNGSYT(DTTM) !GET DATE/TIME - CALL WNGMFS(GFH_CDAT_N,DTTM,GFH(GFH_CDAT_C)) !CREATION DATE - CALL WNGMFS(GFH_CTIM_N,DTTM(13:),GFH(GFH_CTIM_C)) !CREATION TIME - CALL WNGMFS(GFH_RDAT_N,DTTM,GFH(GFH_RDAT_C)) !REVISION DATE - CALL WNGMFS(GFH_RTIM_N,DTTM(13:),GFH(GFH_RTIM_C)) !REVISION TIME - CALL WNGMFS(GFH_NAME_N,NODOUT,GFH(GFH_NAME_C)) !NODE NAME - GFH(GFH_DATTP_B)=PRGDAT !SET DATA TYPE - GFH_J(GFH_LINK_J)=GFH_LINK_1 !INIT. LINK - GFH_J(GFH_LINK_J+1)=GFH_LINK_1 - GFH_J(GFH_LINKG_J)=GFH_LINKG_1 !INIT. LINKG - GFH_J(GFH_LINKG_J+1)=GFH_LINKG_1 - IF (.NOT.WNFWR(J,GFHHDL,GFH(0),0)) THEN !WRITE HEADER - CALL WNCTXT(F_TP,'Cannot write to node !AS',NODOUT(:LN)) - CALL WNFCL(J) - GOTO 10 - END IF - CALL WNFCL(J) !CLOSE NODE - CALL WNDPOHC - RETURN - END IF - CALL WNCTXT(F_TP, - 1 'File !AS already exists. Overwrite?',FILOUT(:LF)) - 31 CONTINUE - IF (.NOT.WNDPAR('DELETE_NODE',LG1,1,J0,'N')) GOTO 31 - LG4=LG1 - IF (J0.EQ.1 .AND. LG4) THEN !YES - CALL WNGLUN(J1) !GET LUN - OPEN (UNIT=J1,FILE=FILOUT,STATUS='OLD',ERR=33) !DELETE FILE - CLOSE(UNIT=J1,STATUS='DELETE',ERR=33) - CALL WNGLUF(J1) !FREE LUN - CALL WNCTXT(F_TP,'File !AS deleted',FILOUT(:LF)) - GOTO 32 !RETRY - 33 CONTINUE - CALL WNGLUF(J1) - CALL WNCTXT(F_TP,'Cannot delete !AS',FILOUT(:LF)) - END IF - GOTO 10 -C -C UPDATE -C - ELSE !UPDATE - INQUIRE(FILE=FILOUT,ERR=20,EXIST=LJ) !FILE EXISTS? - IF (.NOT.LJ .AND. .NOT.NOC) THEN !NO, CREATE - CALL WNCTXT(F_TP,'Creating node !AS in !AS', - 1 NODOUT(:LN),DATAB(:LD)) - GOTO 32 !CREATE - END IF - IF (.NOT.WNFOP(J,FILOUT,'U')) THEN !CHECK - CALL WNCTXT(F_TP,'Cannot open file !AS for update', - 1 FILOUT(:LF)) - GOTO 10 - END IF - IF (.NOT.WNFRD(J,GFHHDL,GFH(0),0)) THEN !READ HEADER - CALL WNCTXT(F_TP, - 1 'Cannot read file header for !AS',FILOUT(:LF)) - CALL WNFCL(J) - GOTO 10 - END IF - CALL WNGMTS(GFH_ID_N,GFH(GFH_ID_C),SID) !GET ID - IF (SID.NE.'.'//PFX(1:3)) THEN - CALL WNCTXT(F_TP,'Specified node is not of !AS type',PFX) - CALL WNFCL(J) - GOTO 10 - END IF - CVT=GFH(GFH_DATTP_B) - CALL WNTTCH(CVT,PRGDAT,L0) !TEST TRANSLATE - IF (L0) THEN - CALL WNCTXT(F_TP, - 1 'The specified node is not of the correct datatype') - CALL WNCTXT(F_TP,'Please convert it with CVX first') - CALL WNFCL(J) - GOTO 10 - END IF - CALL WNGSYT(DTTM) !GET DATE/TIME - CALL WNGMFS(GFH_RDAT_N,DTTM,GFH(GFH_RDAT_C)) !REVISION DATE - CALL WNGMFS(GFH_RTIM_N,DTTM(13:),GFH(GFH_RTIM_C)) !REVISION TIME - GFH_J(GFH_RCNT_J)=GFH_J(GFH_RCNT_J)+1 !UPDATE REVISION COUNT - IF (.NOT.WNFWR(J,GFHHDL,GFH(0),0)) THEN !WRITE HEADER - CALL WNCTXT(F_TP,'Cannot write to node !AS',NODOUT(:LN)) - CALL WNFCL(J) - GOTO 10 - END IF - CALL WNFCL(J) - CALL WNDPOHC - RETURN !CORRECT NODE - END IF -C - CALL WNDPOHC - RETURN !READY -C -C - END diff --git a/src/wng/wndpap.for b/src/wng/wndpap.for deleted file mode 100644 index c4a1897e64b94356b6976220dcc5dc902508fd55..0000000000000000000000000000000000000000 --- a/src/wng/wndpap.for +++ /dev/null @@ -1,86 +0,0 @@ -c+ WNDPAP.FOR -C WNB 910828 -C -C Revisions: -C GvD 920501 Use J5 iso. JS -C CMV 940117 Changed PUT_PARM call to PUT_PARM_C -C CMV 940427 Add entry WNDPAG to define global symbol -C - LOGICAL FUNCTION WNDPAP(KW,VAL) -C -C Set user parameter -C -C Result: -C -C WNDPAP_L = WNDPAP( KW_C*:I, VAL_C*:I) -C Set DWARF user parameter KW with VAL. -C WNDPAG_L = WNDPAG( KW_C*:I, VAL_C*:I) -C Set DWARFglobal symbol KW with VAL. -C -C -C Include files: -C - INCLUDE 'WNG_DEF' -C -C Parameters: -C -C -C Entry points: -C - LOGICAL WNDPAG !DEFINE GLOBAL SYMBOL -C -C Arguments: -C - CHARACTER*(*) KW !KEYWORD - CHARACTER*(*) VAL -C -C Function references: -C - INTEGER PUT_PARM_C !SET PARAMETER - INTEGER PUT_PARM_G !SET GLOBAL SYMBOL -C -C Data declarations: -C - CHARACTER*80 PRGSTR !PROGRAM AND STREAM - CHARACTER*32 KEYW -C- - J5=INDEX(KW,'$') - IF (J5.LE.0) THEN - PRGSTR=' ' - KEYW=KW - ELSE - IF (J5.EQ.1) THEN - PRGSTR=' ' - ELSE - PRGSTR=KW(1:J5-1) - END IF - J5=J5+1 - J=INDEX(KW(J5:),'$') - IF (J.LE.0) THEN - KEYW=KW(J5:) - ELSE IF (J.EQ.1) THEN - KEYW=KW(J5+1:) - ELSE - PRGSTR(J5-1:)='$'//KW(J5:J5+J-1) - KEYW=KW(J5+J:) - END IF - END IF - E_C=PUT_PARM_C(KEYW,VAL,PRGSTR) - GOTO 100 -C - ENTRY WNDPAG(KW,VAL) -C - E_C=PUT_PARM_G(KW,VAL) -C - 100 CONTINUE - CALL WNCTXT(F_P+F_P1,'!AS := !AS',KW,VAL) !SHOW - IF (IAND(E_C,1).EQ.1) THEN !CHECK ERROR - WNDPAP=.TRUE. - ELSE - WNDPAP=.FALSE. - END IF -C - RETURN !READY -C -C - END diff --git a/src/wng/wndpar.cun b/src/wng/wndpar.cun deleted file mode 100644 index 4fe7002ac8c86497bca5dae6daf4d69b2a1bb909..0000000000000000000000000000000000000000 --- a/src/wng/wndpar.cun +++ /dev/null @@ -1,207 +0,0 @@ -/* wndpar.cun -. WNB 920122 -. -. Revisions: -. WNB 921216 Make cun -. CMV 940111 Changed for alpha, call get_parm_n and _c -. directly without 4 for/c interfaces -. JPH 940921 Abort program on PPD_KEYNOTFND status - JPH 950116 Call wndpohc_ - JPH 960622 Save/restore control-C status xhcc[0:1] - HjV 970723 Remove control-C stuff (commented out) - CMV 031205 Changed for stdarg -... */ -/* -. Include files: -... */ -#include <stddef.h> -/*#include <varargs.h>*/ -#include <stdarg.h> -/* -. Get user parameter -... */ -#ifdef wn_al__ - long wndpd1_(va_alist) -#else - int wndpar_(char* kw_in,...) -#endif -/* -. Result: -. -. WNDPAR_L = WNDPAR( KW_C*:I, VALUE, SIZE, NR ,'default',defarr,ndef) -. Get DWARF user parameter. -. Default arguments may be omitted -... */ -/* -. Arguments: -... */ -/* va_dcl */ /* address list to get */ -{ -#include "wng_inc" -#include "wxh_inc" -#define ppd_keynotfnd 0x080280da /* see PPDMSG_DEF */ -/* -. Parameters: -... */ -/* -. Function references: -... */ - int get_parm_n_(); /* routines to call */ - int get_parm_c_(); - void wndpohc_(); -/* -. Data declarations: -... */ - static int undefj=-2147483648; /* Default: undef_j */ - static char undefb=-128; /* Default: undef_b */ - static char *blank=" "; /* Default: blank */ - - va_list ap; /* list argument ptr */ - int iarg = 0; /* argument count */ - int istr = 0; /* string counts */ - char *p=NULL; /* pointer to argument */ - - char *kw=NULL; /* name of keyword */ - char *value=NULL; /* pointer to value */ - int *size=NULL; /* size of value */ - int *nr=&undefj; /* number returned */ - char *defstr=blank; /* default string */ - char *defval=&undefb; /* default array */ - int *ndef=&undefj; /* number of elements */ - - int flags=0; /* flags */ - char string[256]; /* return value */ - int out; /* output files */ - - int lkw=0; /* length of keyword */ - int la1=-1; /* length of value */ - int la2=-1; /* length of defstr */ - int la3=0; /* length of defval */ - int ldef=1; /* length of defstr */ - int lstr=256; /* length of string */ -/* int lxhcc[2]; */ /* save xhcc */ - - static char *fmt_err="Error in argument list of WNDPAR"; - static char *fmt_out="!AS = !AS"; - static char *abort= - "EXITING ON FATAL PROGRAMMING ERROR - report to NEWSTAR manager"; -/*- */ -/* -. Get argument list -... */ - va_start(ap,kw_in); - kw=kw_in; - iarg=1; - - while (iarg <= 7) { - p = va_arg(ap, char *); - if (p > 0 && p < 65536) break; /* found string length */ - if (iarg==0) kw=p; /* found keyword */ - else if (iarg==1) value=p; /* found value */ - else if (iarg==2) size=(int *)p; /* found size */ - else if (iarg==3) nr=(int *)p; /* found return nr */ - else if (iarg==4) defstr=p; /* found default string */ - else if (iarg==5) defval=p; /* found default array */ - else if (iarg==6) ndef=(int *)p; /* found default array */ - iarg++; - } - -/* -. Get string lengths -... */ - while (istr < iarg && p > 0 && p < 65536) { - if (istr==0) lkw=(int )p; /* length keyword */ - else if (istr==1) la1=(int )p; /* length value/defstr */ - else if (istr==2) la2=(int )p; /* length defstr/defval */ - else if (istr==3) la3=(int )p; /* length defval */ - istr++; - p = va_arg(ap, char *); - } - va_end(ap); -/* - If string undefined, point it to blank -*/ - if ( -#ifdef wn_da__ - defstr==0x100000000 || -#endif - defstr==NULL || defstr<0) defstr=blank; -/* - Catch errors: we need at least 3, at most 7 arguments, - at least the keyword should be char * (defstr can be passed as A_B(-A_OB), - at most keyword, value, defstr and defval are char *, but we do not test - on too many char *. -*/ - if (iarg==8 || iarg<3 || lkw==0) { - out=F_TP; - wnctxt_(&out,fmt_err,strlen(fmt_err)); - return(0); - } - -/* - Switch off interrupts -*/ -/* Remove Control-c stuff - lxhcc[0]=wxh_com_.xhcc[0]; - lxhcc[1]=wxh_com_.xhcc[1]; - wxh_com_.xhcc[0]=1; - wxh_com_.xhcc[1]=0; -*/ - wxh_com_.xhcc[0]=1; -/* - Call get_parm_n first, this works unless datatype is C - If it fails, we try get_parm_c (since defstr may have been - passed as an undefined (A_B(-A_OB)) we set la3 to la2 if it is empty. - Print whatever we found... -*/ - if (defstr==blank) ldef=1; else ldef=la1; - wng_com_.e_c = - get_parm_n_(kw,value,size,nr,defstr,defval,ndef,&flags,string, - lkw, ldef, lstr); - if (wng_com_.e_c==0) { - if (defstr==blank) ldef=1; else ldef=la2; - if (la3==0) la3=la2; - wng_com_.e_c = - get_parm_c_(kw,value,size,nr,defstr,defval,ndef,&flags,string, - lkw, la1, ldef, la3, lstr); - } -/* - If the keyword is not found, this is a programming error and we abort the - program immediately -*/ - if (wng_com_.e_c ==ppd_keynotfnd) { - out=F_TP; - wnctxt_(&out,abort,strlen(abort)); - wngex_(); - } - - out=F_P+F_P1; - wnctxt_(&out,fmt_out,kw,string,strlen(fmt_out),lkw,lstr); -/* - Switch interrupts back on, exit if ^C seen -*/ -/* Remove Control-c stuff - wxh_com_.xhcc[0]=lxhcc[0]; - if (wxh_com_.xhcc[1]!=0) { - wxh_com_.xhcc[1]=0; - wngex_(); - }else{ - wxh_com_.xhcc[1]=lxhcc[1]; - } -*/ - wxh_com_.xhcc[0]=0; - if (wxh_com_.xhcc[1]!=0) { - wxh_com_.xhcc[1]=0; - wngex_(); - } - - -/* - Clear dynamic prompt and Return -*/ - if (! wng_com_.a_y.a_j[0]) wndpohc_(); - return( (wng_com_.e_c&1) ); -} -/* -. -... */ diff --git a/src/wng/wndpar.fal b/src/wng/wndpar.fal deleted file mode 100644 index 523f6c909238440d9cd91a203a7c4ebff3dc57c6..0000000000000000000000000000000000000000 --- a/src/wng/wndpar.fal +++ /dev/null @@ -1,76 +0,0 @@ -C+ WNDPAR.FAL -C WNB 900130 -C -C Revisions: -C WNB 910828 Add ^C -C WNB 910916 Add NELEM clear -C - LOGICAL FUNCTION WNDPAR(KW) -C -C Get user parameter -C -C Result: -C -C WNDPAR_J = WNDPAR( KW_C*:I, A2,....,A8) -C Get DWARF user parameter. A2,...,A8 maybe omitted -C -C Include files: -C - INCLUDE 'WNG_DEF' - INCLUDE 'WXH_DEF' -C -C Parameters: -C -C -C Arguments: -C - CHARACTER*(*) KW !KEYWORD -C -C Function references: -C - EXTERNAL GET_PARM !GET PARAMETER - INTEGER WNGARG !ADDRESS ARG. LIST - INTEGER WNGARX !EXECUTE FUNCTION - INTEGER WNGARA !GET VARIABLE ADDRESS - INTEGER WNGASA,WNGASL !STRING ADDRESS, LENGTH -C -C Data declarations: -C - INTEGER ARL(-11:11),ARL1(-11:11) !ARGUMENT LISTS - CHARACTER*256 STR !INPUT LINE - DATA STR/' '/ !MAKE SURE PRINTABLE -C- - J=WNGARG() !GET ADDR. ARG. LIST - CALL WNGARL(%VAL(J),ARL(0)) !GET ARGUMENT LIST - CALL WNGARF(9,ARL(0)) !MAKE CORRECT FOR 9 ARGUMENTS - DO I=1,ARL(0) !MAKE NEW LIST - ARL1(I)=ARL(I) - ARL1(-I)=ARL(-I) - END DO - ARL1(0)=9 !# OF ARG. - ARL1(9)=WNGARA(STR) !SET RETURN STRING - ARL(11)=LEN(STR) !SET LENGTH STRING - ARL1(-1)=WNGARA(ARL(11)) - IF (ARL1(4).NE.0) THEN !IF NELEM EXIST MAKE ZERO - A_J((ARL1(4)-A_OB)/LB_J)=0 - END IF - XHCC(0)=1 !INHIBIT ^C - E_C=WNGARX(GET_PARM,ARL1(0)) !DO ROUTINE - J=WNGASA(1,ARL(0)) !KW ADDRESS - CALL WNCTXT(F_P+F_P1,'!AD = !AS', - 1 %VAL(J),WNGASL(1,ARL(0)),STR) !SHOW - IF (IAND(E_C,1).EQ.1) THEN !CHECK ERROR - WNDPAR=.TRUE. - ELSE - WNDPAR=.FALSE. - END IF - XHCC(0)=0 !DO NOT INHIBIT ^C - IF (XHCC(1).NE.0) THEN !^C SEEN - XHCC(1)=0 - CALL WNGEX !EXIT - END IF -C - RETURN !READY -C -C - END diff --git a/src/wng/wndpar.fvx b/src/wng/wndpar.fvx deleted file mode 100644 index ba40e6e1888dc211229ac8629aae58eb02968649..0000000000000000000000000000000000000000 --- a/src/wng/wndpar.fvx +++ /dev/null @@ -1,68 +0,0 @@ -c+ WNDPAR.FVX -C WNB 900130 -C -C Revisions: -C WNB 910828 Add ^C -C - LOGICAL FUNCTION WNDPAR(KW) -C -C Get user parameter -C -C Result: -C -C WNDPAR_J = WNDPAR( KW_C*:I, A2,....,A8) -C Get DWARF user parameter. A2,...,A8 maybe omitted -C -C Include files: -C - INCLUDE 'WNG_DEF' - INCLUDE 'WXH_DEF' -C -C Parameters: -C -C -C Arguments: -C - CHARACTER*(*) KW !KEYWORD -C -C Function references: -C - EXTERNAL GET_PARM !GET PARAMETER - INTEGER WNGARG !ADDRESS ARG. LIST - INTEGER WNGARX !EXECUTE FUNCTION - INTEGER WNGARA !GET VARIABLE ADDRESS -C -C Data declarations: -C - INTEGER ARL(-11:11),ARL1(-11:11) !ARGUMENT LISTS - CHARACTER*256 STR !INPUT LINE - DATA STR/' '/ !MAKE SURE PRINTABLE -C- - J=WNGARG() !GET ADDR. ARG. LIST - CALL WNGARL(%VAL(J),ARL(0)) !GET ARGUMENT LIST - DO I=1,ARL(0) !MAKE NEW LIST - ARL1(I)=ARL(I) - END DO - DO I=ARL(0)+1,8 - ARL1(I)=0 - END DO - ARL1(0)=9 !# OF ARGUMENTS - ARL1(9)=WNGARA(STR) !SET RETURN STRING - XHCC(0)=1 !INHIBIT ^C - E_C=WNGARX(GET_PARM,ARL1(0)) !DO ROUTINE - CALL WNCTXT(F_P+F_P1,'!AS = !AS',KW,STR) !SHOW - IF (IAND(E_C,1).EQ.1) THEN !CHECK ERROR - WNDPAR=.TRUE. - ELSE - WNDPAR=.FALSE. - END IF - XHCC(0)=0 !DO NOT INHIBIT ^C - IF (XHCC(1).NE.0) THEN !^C SEEN - XHCC(1)=0 - CALL WNGEX !EXIT - END IF -C - RETURN !READY -C -C - END diff --git a/src/wng/wndpoh.for b/src/wng/wndpoh.for deleted file mode 100644 index f2483461d54bff05f4977302c5051240c38ecd56..0000000000000000000000000000000000000000 --- a/src/wng/wndpoh.for +++ /dev/null @@ -1,69 +0,0 @@ -C+ WNDPOH.FOR -C JPH 940907 -C -C Revisions: -C -C - SUBROUTINE WNDPOH (PROMPT,OPTIONS,HELP) -C( -C Set local prompt, options and help texts -C -C Result: -C -C CALL WNDPOH(PROMPT_C:I, OPTIONS_C:I, HELP_C:I) -C Sets local prompt, options and help texts in the DWARF parameter -C interface. The former two override the .PPD-file strings, the -C latter is prefixed. Blank arguments are skipped, i.e. the -C existing local string is left untouched. The settings remain -C until cleared (WNDPOHC) or altered. -C CALL WNDPOHC -C Clear the local values. This routine is intended for use by -C WNDPAR and by those routines that call WNDPAR but for which the -C calling programs calls WNDPOH (e.g. WNDSTA, WNDNOD, NSCPLS, ...) -C -C The operating context of this module is described in a Newstar document -C wndpoh.txt -C -C -C Include files: -C - INCLUDE 'WNG_DEF' -C -C Parameters: -C -C -C Arguments: -C - CHARACTER*(*) PROMPT - CHARACTER*(*) OPTIONS - CHARACTER*(*) HELP -C -C Entry points: -C -C -C Function references: -C - INTEGER PPD_PRSTR_LSET, PPD_OPSTR_LSET, PPD_HSTR_LSET -C -C Data declarations: -C -C -C- -C - IF (PROMPT.NE.' ') I=PPD_PRSTR_LSET(PROMPT) - IF (OPTIONS.NE.' ') I=PPD_OPSTR_LSET(OPTIONS) - IF (HELP.NE.' ') I=PPD_HSTR_LSET(HELP) -C - RETURN -C -C - ENTRY WNDPOHC - - I=PPD_PRSTR_LSET(' ') - I=PPD_OPSTR_LSET(' ') - I=PPD_HSTR_LSET(' ') - A_J(0)=0 ! clear 'hold prompt etc.' -C - RETURN -C - END diff --git a/src/wng/wndrun.for b/src/wng/wndrun.for deleted file mode 100644 index c83d7132e8fded66b8df0108e9d4f5980d19ffc5..0000000000000000000000000000000000000000 --- a/src/wng/wndrun.for +++ /dev/null @@ -1,38 +0,0 @@ -c+ WNDRUN.FOR -C WNB 910828 -C -C Revisions: -C WNB 920303 SUN problems () -C - LOGICAL FUNCTION WNDRUN() -C -C Test RUN keyword -C -C Result: -C -C WNDRUN_L = WNDRUN -C Test if the program should be run or not. -C -C Include files: -C - INCLUDE 'WNG_DEF' - INCLUDE 'WND_DEF' -C -C Parameters: -C -C -C Arguments: -C -C -C Function references: -C -C -C Data declarations: -C -C- - WNDRUN=RUNCD !SET RUN CODE -C - RETURN !READY -C -C - END diff --git a/src/wng/wndsta.for b/src/wng/wndsta.for deleted file mode 100644 index 49a1e53585e09505c97dfd91dce12606ea9ea38e..0000000000000000000000000000000000000000 --- a/src/wng/wndsta.for +++ /dev/null @@ -1,469 +0,0 @@ -C+ WNDSTA.FOR -C WNB 910327 -C -C Revisions: -C WNB 910809 Allow .. -C WNB 910826 Add STQ -C WNB 910923 Delete trailing . -C HjV 930309 Add call to WNDSTA_X -C JPH 930513 Comments. For WNDSTQ SETS is :IO -C JPH 930602 Comments -C WNB 931015 Use SSH -C CMV 931220 Option for LAYOUT and OVERVIEW -C CMV 931220 Correction for * answer -C WNB 931222 Correct FCAIN test -C CMV 940103 Add test on LOOPS, split decoding in WNDSTM -C JPH 940901 Add MXS=0 option. Comments -C JPH 940906 Error if no sector found -C JPH 940907 Call WNDPOHC at all RETURNs, inhibit WNDPOHC calls from -C WNDPAR through A_J flag -C CMV 940929 Do not check on sectors found if called by WNDXLP -C JPH 940929 Add comment to explain this -C JPH 941214 Call WNDPOHC before executing Layout or Overview -C -C - LOGICAL FUNCTION WNDSTA(KW,MXS,SETS,FCAIN) -C -C Ask SET values -C -C Result: -C -C WNDSTA_L = WNDSTA( KW_C*:I, MXS_J:I, SETS_J(0:*,0:*):IO, FCAIN_J:I) -C Ask the user with keyword KW for the sets to do. -C MXS indicate the maximum number of -C specifications. The specifications will be -C put in SETS. If FCAIN correct disk descriptor -C to describe an opened file, and the layout -C and overview options can be used (currently -C for SCN and WMP only). -C Call with MXS=1 if only one set allowed. -C Call with MXS=0 if this one set may represent -C only one sector, -C -C WNDSTQ_L = WNDSTQ( KW_C*:I, MXS_J:I, SETS_J(0:*,0:*):IO, FCAIN_J:I) -C As STA, but will prompt with present value of -C SETS i.s.o. "" -C -C WNDSTM_L = WNDSTM( SETS_J(0:*,0:*):I, STR_C(*):O) -C Return string representation of sets in SETS -C -C NOTES: -C WNDSTA is also used to perform the prompt for WNDXLP. This is possible -C because a LOOPS specification looks formally like a sets specification. It -C should not be interpreted as such, however, so the checks on existence of -C sets are suppressed. -C -C The second dimension of SETS must be (0:1) at least, to hold the number -C of valid spec lines in row 0 and one spec in row 1. If loop specs are to be -C expected, one additional line must be reserved for every single one. -C The 'loops' in this routine represent set specifications of the form -C <i>-<j>:<k> and have nothing to do with the LOOPS specification associated -C with the SETS being specified here. -C -C****************************************************************************** -C Organisation of array SETS[0:7,0:*] (inferred by JPH from the code) -C****************************************************************************** -C -C header line SETS[0:7,0] -C ======================= -C SETS[0,0] = nr of valid lines; first valid line is SETS[0:7,1] -C -C valid lines SETS[0:7, ] -C ======================= -C simple specification: -C SETS[0:4, ] group, observation etc.; bit 29 clear -C -C primary line of loop specification: -C SETS[i, ] bit 29 set; bits 0-28 point to the line number in SETS -C where the loop parameters are stored -C -C specials: -C SETS[1, ] = -2: # set number; value in SETS[0, ]; SETS[2-7, ] ignored -C SETS[i, ] = -1: * wildcard: all sets -C -C loop parameters: -C SETS[0, ] reserved -C SETS[1, ] bit 30 set; bits 0-29 are back ptr to primary line -C SETS[2, ] start value -C SETS[3, ] end value, -1 = "*" (= all remaining) -C SETS[4, ] increment -C -C -C -C Include files: -C - INCLUDE 'WNG_DEF' - INCLUDE 'SSH_O_DEF' !SET INFO -C -C Parameters: -C - INTEGER MXLSET !LOCAL SETS - PARAMETER (MXLSET=64) -C -C Entry points: -C - LOGICAL WNDSTQ - LOGICAL WNDSTM -C -C Arguments: -C - CHARACTER*(*) KW !KEYWORD TO USE - INTEGER MXS !MAX. # OF SETS - INTEGER SETS(0:SOF__N-1,0:*) !SETS TO DO - INTEGER FCAIN !FCA of input file - CHARACTER*(*) STROUT !Output string for WNDSTM -C -C Function references: -C - LOGICAL WNDPAR !GET USER DATA - LOGICAL WNDSTA_X !EXTRA KEYWORD LAYER - INTEGER WNCAJ !GET INTEGER VALUE - INTEGER WNCAL0 !STRING LENGTH - LOGICAL WNCATD !TEST DIGIT - LOGICAL WNCASC,WNCATC !TEST/SKIP CHARACTER - INTEGER WNFTFC !TEST PROPER FCA - LOGICAL WNDSTH ! get sector header -C -C Data declarations: -C - CHARACTER*32 CSET(MXLSET) !LOCAL SETS SPECIFIED - CHARACTER*128 TXT !PROMPT TEXT - LOGICAL ASK !ASK QUESTION OR JUST DECODE - INTEGER LOCMXS ! actual max nr of sets - INTEGER SNAM(0:7) ! sector/image/cut name - CHARACTER*6 TYPE ! -C- - WNDSTA=.TRUE. !ASSUME OK - ASK=.TRUE. !ASK QUESTION - TXT='""' !NO PROMPT - J=3 - GOTO 10 - - ENTRY WNDSTM(SETS,STROUT) -C - WNDSTM=.TRUE. !ASSUME OK - ASK=.FALSE. !JUST DECODE - STROUT='???' !Cannot decode - GOTO 11 -C - ENTRY WNDSTQ(KW,MXS,SETS,FCAIN) -C - WNDSTQ=.TRUE. !ASSUME OK - ASK=.TRUE. !ASK QUESTION - -C******************************************************************************* -C Decode the existing values of SETS -C******************************************************************************* -C - 11 CONTINUE - A_J(0)=1 ! hold local prompt etc. - IF (SETS(SOF_0_NLINE,0).LE.0) THEN !NO PROMPT - TXT='""' - J=3 !first free char. in TXT - ELSE - TXT=' ' !START EASY - J=1 !first free char. in TXT - DO I=1,SETS(SOF_0_NLINE,0) !loop all valid lines in SETS - IF (I.GT.1) THEN !add "," - TXT(J:J)=',' - J=J+1 - END IF - IF (SETS(SOF_SPEC,I).EQ.SOF_M_SPEC) THEN !absolute set nr, add "#" - TXT(J:J)='#' - J=J+1 - IF (SETS(0,I).EQ.SOF_M_ALL) THEN !wildcard set nr, add "*" - TXT(J:)='*' - ELSE IF (IAND(SETS(0,I), - 1 SOF_M_LOOP).NE.0) THEN !LOOP specification - J0=IAND(SETS(0,I),SOF_M_LO) !line nr WHERE DEFINED - IF (SETS(SOF_L_END,J0).NE.SOF_M_ALL) THEN !complete, - CALL WNCTXS(TXT(J:), ! add <start>-<end>:<increment> - 1 '!UJ\-!UJ\:!UJ', - 1 SETS(SOF_L_START,J0),SETS(SOF_L_END,J0), - 1 SETS(SOF_L_INC,J0)) - ELSE !open-ended, - CALL WNCTXS(TXT(J:), ! add <start>-*:<increment> - 1 '!UJ\-*:!UJ', - 1 SETS(SOF_L_START,J0),SETS(SOF_L_INC,J0)) - END IF - ELSE - CALL WNCTXS(TXT(J:), - 1 '!UJ',SETS(0,I)) !single VALUE - END IF - J=WNCAL0(TXT)+1 !NEW LENGTH - ELSE !"." specification - DO I1=0,SOF__N-1 !ALL LEVELS - IF (SETS(I1,I).EQ.SOF_M_ALL) THEN !wildcard, add "*" - TXT(J:)='*' - ELSE IF (IAND(SETS(I1,I), - 1 SOF_M_LOOP).NE.0) THEN !LOOP, see above - J0=IAND(SETS(I1,I),SOF_M_LO) - IF (SETS(SOF_L_END,J0).NE.SOF_M_ALL) THEN - CALL WNCTXS(TXT(J:),'!UJ\-!UJ\:!UJ', - 1 SETS(SOF_L_START,J0),SETS(SOF_L_END,J0), - 1 SETS(SOF_L_INC,J0)) - ELSE - CALL WNCTXS(TXT(J:),'!UJ\-*:!UJ', - 1 SETS(SOF_L_START,J0),SETS(SOF_L_INC,J0)) - END IF - ELSE !value, see above - CALL WNCTXS(TXT(J:),'!UJ',SETS(I1,I)) - END IF - J=WNCAL0(TXT)+1 - TXT(J:J)='.' !add "." - J=J+1 - DO I2=I1+1,SOF__N-1 !check remaining levels - IF (SETS(I2,I).NE.SOF_M_ALL) GOTO 30 ! any non-wildcard left - END DO - GOTO 31 !no, this specification done - 30 CONTINUE - END DO - 31 CONTINUE - J=J-1 !DELETE TRAILING "." - END IF - IF (J.GT.LEN(TXT)-28) GOTO 32 !STOP INTERPRETING - END DO - 32 CONTINUE - END IF -C -C For entry WNDSTM we just return the decoded string -C - IF (.NOT.ASK) THEN - J=MAX(1,J-1) !Strip trailing dot - STROUT=TXT(1:J) - CALL WNDPOHC - RETURN - END IF - GOTO 10 - -C******************************************************************************* -C prompt for SETS -C******************************************************************************* - 10 CONTINUE - IF (KW(1:3).EQ.'SCN') TYPE='sector' - IF (KW(1:3).EQ.'WMP') TYPE='image' - IF (KW(1:3).EQ.'NGF') TYPE='cut' - LOCMXS=MXS ! max nr of sets - IF (MXS.EQ.0) LOCMXS=1 ! if 0: 1 set AND 1 sector - J=MAX(1,J-1) !SET LENGTH - IF (.NOT.WNDPAR(KW,CSET, - 1 MXLSET*LEN(CSET(1)),SETS(SOF_0_NLINE,0), - 1 TXT(1:J))) THEN - IF (E_C.EQ.DWC_ENDOFLOOP) THEN !NONE - GOTO 900 !NOT SPECIFIED - ELSE - GOTO 10 !RETRY - END IF - END IF -C -C SETS(0,0) is the number of specifications the user has given -C - IF (SETS(SOF_0_NLINE,0).EQ.0) GOTO 800 !READY, go set init. values -C -C The user may reply 'L' or 'O' in which case (for SCN and WMP) a layout -C or overview of the input file is given on the screen. -C - IF (SETS(SOF_0_NLINE,0).GT.0.AND. - 1 (INDEX(CSET(1),'L').GT.0.OR. - 1 INDEX(CSET(1),'O').GT.0) ) THEN !O or L and not * - CALL WNDPOHC - IF (WNFTFC(FCAIN).NE.1) THEN - CALL WNCTXT(F_T,'No input file is available.') - ELSE IF (INDEX(KW,'SCN_SET') .GT.0 .OR. - 1 INDEX(KW,'SCN_LOOPS').GT.0) THEN - CALL NSCPFL(F_T,FCAIN,' ',(INDEX(CSET(1),'O').GT.0)) - ELSE IF (INDEX(KW,'WMP_SET') .GT.0 .OR. - 1 INDEX(KW,'WMP_LOOPS').GT.0) THEN - CALL NMAPFL(F_T,FCAIN,' ',(INDEX(CSET(1),'O').GT.0)) - ELSE IF (INDEX(KW,'NGF_SET') .GT.0 .OR. - 1 INDEX(KW,'NGF_LOOPS').GT.0) THEN - CALL NGCPFL(F_T,FCAIN,' ',(INDEX(CSET(1),'O').GT.0)) - ELSE - CALL WNCTXT(F_T, - 1 'No layout/overview can be given for this filetype') - END IF - GOTO 10 -C -C The user may reply '@' or '>', in which case we continue to prompt for the -C individual components of the sets specification -C - ELSE IF (SETS(SOF_0_NLINE,0).GT.0.AND. - 1 ((INDEX(CSET(1),'@').GT.0).OR. - 1 (INDEX(CSET(1),'>').GT.0))) THEN - JS=WNDSTA_X(KW,TXT,CSET(1), - 1 SETS(SOF_0_NLINE,0)) !go prompt for each level - IF (.NOT.JS) GOTO 10 !error: TRY WNDPAR AGAIN - TXT=CSET(1) !SUCCESS: copy result to prompt - J=WNCAL0(TXT)+1 ! default string - GOTO 10 !go get user's confirmation - END IF -C -C Start interpreting -C - IF (SETS(SOF_0_NLINE,0).LT.0) THEN !* - SETS(SOF_0_NLINE,0)=1 !1 LINE - DO I=0,SOF__N-1 - SETS(I,1)=SOF_M_ALL !all wildcards - END DO - GOTO 700 !done - END IF - IF (SETS(SOF_0_NLINE,0).GT.LOCMXS) THEN !TOO MANY, reprompt - CALL WNCTXT(F_TP,'Too many sets defined') - GOTO 10 - END IF - J0=SETS(SOF_0_NLINE,0) !reserve a line in SETS - ! for each spec in CSETS - DO I=1,SETS(SOF_0_NLINE,0) !loop over specs - J=1 !pointer in CSET(I) text - CALL WNCASB(CSET(I),J) !SKIP BLANKs if any - IF (WNCASC(CSET(I),J,'#')) THEN !# - SETS(SOF_SPEC,I)=SOF_M_SPEC !INDICATE # - SETS(0,I)=SOF_M_ALL !assume * - IF (WNCASC(CSET(I),J,'*')) THEN !#* - SETS(0,I)=SOF_M_ALL - ELSE IF (WNCATD(CSET(I),J)) THEN !if digit, decode - J=J-1 - SETS(0,I)=WNCAJ(CSET(I), - 1 LEN(CSET(I)),J) !decode VALUE - J=J+1 - IF (WNCATC(CSET(I),J,'-') .OR. !if at "-" or ":", - 1 WNCATC(CSET(I),J,':')) THEN ! loop spec. - IF (J0.GE.LOCMXS) THEN !if no room left, - CALL WNCTXT(F_TP, - 1 'Too many loop definitions') - GOTO 10 ! reprompt - END IF - J0=J0+1 !LOOP DEFINITION LINE - SETS(0,J0)=0 !LOCAL USE - SETS(SOF_L_DEF,J0)=SOF_M_SLOOP+I !back ptr to primary line - SETS(SOF_L_START,J0)=SETS(0,I) !START VALUE - SETS(SOF_L_END,J0)=SOF_M_ALL !ASSUME no end value - SETS(SOF_L_INC,J0)=1 !assume INCREM. OF 1 - SETS(0,I)=SOF_M_LOOP+J0 !primary line points to loop - ! spec - IF (WNCASC(CSET(I),J,'-')) THEN !if "-" look for end value - IF (WNCASC(CSET(I),J,'*')) - 1 THEN ! "-*" was assumed - ELSE IF (WNCATD(CSET(I),J)) - 1 THEN !if DIGIT: end value, decode - J=J-1 - SETS(SOF_L_END,J0)=WNCAJ(CSET(I), - 1 LEN(CSET(I)),J) - J=J+1 - END IF - END IF - IF (WNCASC(CSET(I),J,':')) THEN !if ":" look for increment - IF (WNCASC(CSET(I),J,'*')) - 1 THEN !"*" means 1 as assumed - ELSE IF (WNCATD(CSET(I),J)) - 1 THEN !if DIGIT: increment, decode - J=J-1 - SETS(SOF_L_INC,J0)=MAX(1,WNCAJ(CSET(I), - 1 LEN(CSET(I)),J)) - J=J+1 - END IF - END IF - END IF - END IF - IF (CSET(I)(J:).NE.' ') THEN !error if any non-blank left - 20 CONTINUE - CALL WNCTXT(F_TP,'Format error in !AS',CSET(I)) - GOTO 10 - END IF - ELSE !"." spec - DO I1=0,SOF__N-1 !ALL LEVELS - SETS(I1,I)=SOF_M_ALL !decode as above - IF (WNCASC(CSET(I),J,'*')) THEN - ELSE IF (CSET(I)(J:).EQ.' ') THEN - ELSE IF (WNCATD(CSET(I),J)) THEN - J=J-1 - SETS(I1,I)=WNCAJ(CSET(I),LEN(CSET(I)),J) - J=J+1 - IF (WNCATC(CSET(I),J,'-') .OR. - 1 WNCATC(CSET(I),J,':')) THEN - IF (J0.GE.LOCMXS) THEN - CALL WNCTXT(F_TP,'Too many loop definitions') - GOTO 10 - END IF - J0=J0+1 - SETS(0,J0)=0 - SETS(SOF_L_DEF,J0)=SOF_M_SLOOP+I - SETS(SOF_L_START,J0)=SETS(I1,I) - SETS(SOF_L_END,J0)=SOF_M_ALL - SETS(SOF_L_INC,J0)=1 - SETS(I1,I)=SOF_M_LOOP+J0 - IF (WNCASC(CSET(I),J,'-')) THEN - IF (WNCASC(CSET(I),J,'*')) THEN - ELSE IF (WNCATD(CSET(I),J)) THEN - J=J-1 - SETS(SOF_L_END,J0)=WNCAJ(CSET(I),LEN(CSET(I)),J) - J=J+1 - END IF - END IF - IF (WNCASC(CSET(I),J,':')) THEN - IF (WNCASC(CSET(I),J,'*')) THEN - ELSE IF (WNCATD(CSET(I),J)) THEN - J=J-1 - SETS(SOF_L_INC,J0)= - 1 MAX(1,WNCAJ(CSET(I),LEN(CSET(I)),J)) - J=J+1 - END IF - END IF - END IF - END IF - IF (WNCASC(CSET(I),J,'.')) THEN !. OK - ELSE IF (CSET(I)(J:).EQ.' ') THEN !OK - ELSE !ERROR - GOTO 20 !go report and reprompt - END IF - END DO - END IF - END DO -C -C Check for any sector at all -C - 700 CONTINUE - IF (INDEX(KW,'LOOPS').EQ.0) THEN - DO I=1,SOF__N-1 !INIT SEARCH - SETS(I,0)=0 - END DO - IF (.NOT.WNDSTH(FCAIN,SETS,I1,I2,SNAM)) THEN - CALL WNCTXT(F_T, - 1 'Error: None of the requested !AS\s exist',TYPE) - GOTO 10 - ENDIF - END IF -C -C Check for one sector only -C - IF (MXS.EQ.0) THEN - IF (WNDSTH(FCAIN,SETS,I1,I2,SNAM)) THEN - CALL WNCTXT(F_T, - 1 'Error: You may specify only a single !AS here',TYPE) - GOTO 10 - ENDIF - ENDIF -C -C Ready -C -800 CONTINUE - DO I=1,SOF__N-1 !INIT SEARCH - SETS(I,0)=0 - END DO -C - CALL WNDPOHC ! clear local prompt etc. - RETURN !READY -C -C ERROR -C - 900 CONTINUE - DO I=0,SOF__N-1 - SETS(I,0)=0 !SET NONE - END DO - WNDSTA=.FALSE. !ERROR -C - CALL WNDPOHC ! clear local prompt etc. - RETURN -C -C - END diff --git a/src/wng/wndsta_x.for b/src/wng/wndsta_x.for deleted file mode 100644 index 52a6ed9d4079d728618c23a52ea60318b5c0456d..0000000000000000000000000000000000000000 --- a/src/wng/wndsta_x.for +++ /dev/null @@ -1,288 +0,0 @@ -C+ WNDSTA_X.FOR -C JEN 930222. -C -C Revisions: -C HjV 930427 Typo -C WNB 930630 Add NGF sub-fields, remove some unused variables -C WNB 931015 Use SSH -C CMV 931210 Change test for LOOPS to ???_LOOPS -C - LOGICAL FUNCTION WNDSTA_X (KW,TXT,CSET,SETS) -C -C Extra layer of keywords below SETS, which prompts the (beginning) -C user for each of the 5/6 Set indices separately. -C WNDSTA_X is called from WNDSTA.FOR when the user indicates the -C wish for this extra layer by typing a certain character (>). -C The keyword name (KW) indicates the relevant kind of Sets, -C i.e. SCN_SETS, WMP_SETS etc. -C The input default string (TXT) may be analysed to give relevant -c default values for the extra keywords in this layer. -C -C Result: -C -C WNDSTA_X_L = WNDSTA ( KW_C*:I, TXT_C*:I, CSET_C*:O, SETS_J:O ) -C -C The output arguments (CSET, SETS) are the first elements CSET(1) and -C SETS(0,0) of arrays used in WNDSTA.FOR. They contain the answers given -C by the user, in the same format as they would have been after the call -C to WNDPAR in the calling routine WNDSTA.FOR. -C -C PIN references: -C -C SCN_GROUPS, _OBSS, _FIELDS, _CHANNELS, _SECTORS -C WMP_GROUPS, _FIELDS, _CHANNELS, _POLARS, _TYPES, _MAPS -C -C Include files: -C - INCLUDE 'WNG_DEF' - INCLUDE 'SSH_O_DEF' !SET OFFSETS -C -C Parameters: -C - INTEGER MAXINX ! Max nr of indices (local) - PARAMETER (MAXINX=17) -C - INTEGER SCN_GROUPS,SCN_OBSS,SCN_FIELDS - INTEGER SCN_CHANNELS,SCN_SECTORS - PARAMETER (SCN_GROUPS=1,SCN_OBSS=2,SCN_FIELDS=3) - PARAMETER (SCN_CHANNELS=4,SCN_SECTORS=5) -C - INTEGER WMP_GROUPS,WMP_FIELDS,WMP_CHANNELS - INTEGER WMP_POLARS,WMP_TYPES,WMP_MAPS - PARAMETER (WMP_GROUPS=6,WMP_FIELDS=7,WMP_CHANNELS=8) - PARAMETER (WMP_POLARS=9,WMP_TYPES=10,WMP_MAPS=11) -C - INTEGER NGF_GROUPS,NGF_FIELDS,NGF_CHANNELS - INTEGER NGF_POLARS,NGF_IFRS,NGF_CUTS - PARAMETER (NGF_GROUPS=12,NGF_FIELDS=13,NGF_CHANNELS=14) - PARAMETER (NGF_POLARS=15,NGF_IFRS=16,NGF_CUTS=17) -C -C Arguments: -C - CHARACTER*(*) KW ! Original keyword (e.g. SCN_SETS) - CHARACTER*(*) TXT ! Original default string (WNDSTA) - CHARACTER*(*) CSET ! User spec string (e.g. 0.0.*.2.0) - INTEGER SETS ! returns the nr of Set specs (1 or 0) -C -C Function references: -C - LOGICAL WNDPAR ! Get input from the user - LOGICAL WNCASD ! Incr ptr if digit (0-9) - LOGICAL WNCASC ! Incr ptr if given char - LOGICAL WNCATC ! Test for given char - LOGICAL WNCASB ! Incr ptr if blank -C -C Data declarations: -C - CHARACTER*32 KWL(MAXINX) ! Keywords of the Set group - DATA KWL/ 'SCN_GROUPS','SCN_OBSS','SCN_FIELDS', - 1 'SCN_CHANNELS','SCN_SECTORS', - 1 'WMP_GROUPS','WMP_FIELDS','WMP_CHANNELS', - 1 'WMP_POLARS','WMP_TYPES','WMP_MAPS', - 1 'NGF_GROUPS','NGF_FIELDS','NGF_CHANNELS', - 1 'NGF_POLARS','NGF_IFRS','NGF_CUTS'/ - CHARACTER*16 DFLTXT(MAXINX) ! Default value (WNDPAR) - INTEGER NSPEC ! Input counter (WNDPAR) - CHARACTER*32 STRIN ! User input string (WNDPAR) - INTEGER N,INX1,INX2 ! Misc -C -C- -Cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc -C -C Determine from keyword name (KW) which group of keywords is required: -C - IF (INDEX(KW,'WMP_SET').GT.0) THEN - INX1 = WMP_GROUPS - INX2 = WMP_MAPS - CALL WNCTXT (F_T,'Specify indices for g.f.c.p.t.m separately:') - CALL WNCTXT (F_T,' g = group(s) : output run selection (0,1,...)') - CALL WNCTXT (F_T,' f = field(s) : mosaicking (WSRT numbering)') - CALL WNCTXT (F_T,' c = channel(s): frequency (WSRT numbering)') - CALL WNCTXT (F_T,' p = polar(s) : polarisations (0,1,2,3)') - CALL WNCTXT (F_T,' t = type(s) : types (0=map, 1,2,3,4,5,6') - CALL WNCTXT (F_T,' m = map(s) : sequence nr(s)') -C - ELSE IF (INDEX(KW,'SCN_SET').GT.0) THEN - INX1 = SCN_GROUPS ! first keyword - INX2 = SCN_SECTORS ! last keyword - CALL WNCTXT (F_T,'Specify indices for g.o.f.c.s separately:') - CALL WNCTXT (F_T,' g = group(s) : e.g. object or calibrator') - CALL WNCTXT (F_T,' o = obs(s) : e.g. multiple 12h observ.') - CALL WNCTXT (F_T,' f = field(s) : pointing centres, mosaicking') - CALL WNCTXT (F_T,' c = channel(s): frequency (0=continuum)') - CALL WNCTXT (F_T,' s = sector(s) : contiguous HA-range(s)') -C - ELSE IF (INDEX(KW,'MDL_SET').GT.0) THEN - CALL WNCTXT (F_T, - * 'MDL-Set sub-keyword layer not yet implemented') - GOTO 900 ! force retry in WNDSTA -C - ELSE IF (INDEX(KW,'NGF_SET').GT.0) THEN - INX1 = NGF_GROUPS - INX2 = NGF_CUTS - CALL WNCTXT (F_T,'Specify indices for g.f.c.p.i.c separately:') - CALL WNCTXT (F_T,' g = group(s) : usually only one (0)') - CALL WNCTXT (F_T,' f = field(s) : mosaicking (WSRT numbering)') - CALL WNCTXT (F_T,' c = channel(s): frequency (WSRT numbering)') - CALL WNCTXT (F_T,' p = polar(s) : polarisations (0,1,2,3)') - CALL WNCTXT (F_T,' i = ifr/tel(s): ifrs/tels (0,1,2,....)') - CALL WNCTXT (F_T,' c = cut(s) : sequence nr(s)') -C - ELSE IF (KW(:5) .EQ.'LOOPS' .OR. KW(5:10).EQ.'LOOPS') THEN - CALL WNCTXT (F_T,'LOOPS sub-keyword layer not implemented') - GOTO 900 ! force retry in WNDSTA -C - ELSE - CALL WNCTXT (F_T,'Keyword name not recognised: !AS ',KW) - GOTO 900 ! force retry in WNDSTA - END IF -C -C Default values: -C If a default string (TXT) was given to WNDPAR in the calling routine WNDSTA, -C this string will be split into defaults for the 5/6 extra keywords: -C - DO I=INX1,INX2 - DFLTXT(I)='0' ! Safe default default values - END DO -C - IF (TXT.EQ.'""' .OR. TXT.EQ.' ') THEN ! SETS(0,0).LE.0 (see WNDSTA) - ELSE ! Input Set default string given - CALL WNCTXT (F_T,'Default Set spec is: !AS ',TXT) - J1=1 ! pointer in TXT - JS=WNCASB(TXT,J1) ! Strip blanks, incr ptr J1 - JS=WNCASC(TXT,J1,'"') ! Strip quote("), if present (?) -C - IF (WNCASC(TXT,J1,'#')) THEN ! Abolute Unit nr (#n) - IF (WNCASC(TXT,J1,'*')) THEN ! All Units (Sectors/Maps) - DO I=INX1,INX2 - DFLTXT(I)='*' ! All Indices - END DO - END IF -C - ELSE - DO I=INX1,INX2 - DFLTXT(I)='*' ! All Indices - END DO - I=INX1 - 77 CONTINUE - J2=J1 - DO WHILE (WNCASC(TXT,J2,'-').OR. - * WNCASC(TXT,J2,':').OR. - * WNCASC(TXT,J2,'*').OR. - * WNCASD(TXT,J2)) - END DO -C - IF (J2.GT.J1) THEN ! if more than zero chars, - DFLTXT(I) = TXT(J1:J2-1) ! then copy the default string - END IF -C - IF (WNCATC(TXT,J2,'.')) THEN - J1=J2+1 ! skip the separating dot (.) - I=I+1 ! next index nr - IF (I.LE.INX2) GOTO 77 ! next index - END IF - END IF - END IF -C -Cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc -C Ask input from the user: -C - 100 CONTINUE - CSET = ' ' ! will be filled with spec - J=0 ! char pointer in CSET -C - DO I=INX1,INX2 - 110 CONTINUE - JS = WNDPAR(KWL(I),STRIN,LEN(STRIN),NSPEC,DFLTXT(I)) -C - IF (.NOT.JS) THEN - IF (E_C.EQ.DWC_ENDOFLOOP) THEN ! interrupt (^Z, ^D, #) - GOTO 900 ! Force retry in WNDSTA - ELSE - CALL WNCTXT (F_T,'Invalid input: !AS ',STRIN) - GOTO 110 ! Try again - END IF - ELSE IF (NSPEC.LT.0.OR.E_C.EQ.DWC_WILDCARD) THEN ! input is * - STRIN = '*' ! Should already be there? - ELSE IF (NSPEC.EQ.0.OR.E_C.EQ.DWC_NULLVALUE) THEN ! input is "" - STRIN = DFLTXT(I) ! use default (?) - END IF -C - J1=1 ! Start character in STRIN - DO WHILE (WNCASB(STRIN,J1).OR. - * WNCASC(STRIN,J1,'"').OR. - * WNCASC(STRIN,J1,'.')) - END DO -C - J2=J1 ! Stop character in STRIN - DO WHILE (WNCASC(STRIN,J2,'-').OR. - * WNCASC(STRIN,J2,':').OR. - * WNCASC(STRIN,J2,'*').OR. - * WNCASD(STRIN,J2)) - END DO -C - IF (J2.GT.J1) THEN - IF (J.LT.LEN(CSET)) THEN - CSET(J+1:) = STRIN(J1:J2-1) ! Add input strin to CSET - J=J+J2-J1 - END IF - ELSE - CALL WNCTXT (F_T,'Invalid input: !AS ',STRIN) - GOTO 110 ! Try again - END IF -C - IF (I.LT.INX2) THEN ! After all but last index - IF (J.LT.LEN(CSET)) THEN - CSET(J+1:) = '.' ! insert separation dot (.) - J=J+1 - END IF - END IF - END DO -C - GOTO 800 ! Finished successfully -C -Ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc -C Finished successfully: -C - 800 CONTINUE - CALL WNCTXT (F_T,'You have specified the Set: !AS ',CSET) - CALL WNCTXT (F_T, - * ' It will now be used as default in the original question.') - CALL WNCTXT (F_T, - * ' Type <CR> if you are satisfied, or try again.') - WNDSTA_X = .TRUE. ! Successful Set spec - SETS = 1 ! One Set specified by user -C - RETURN -C -Ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc -C Finished un-successfully: -C - 900 CONTINUE - WNDSTA_X = .FALSE. ! forces retry in WNDSTA - SETS = 0 ! No Sets specified - CSET = ' ' -C - RETURN -C -C - END -C -Cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc -C The call to WNDSTA_X is inserted in WNDSTA.FOR in the following way: -C Add the following declarations: -C -C LOGICAL WNDSTA_X ! extra keyword layer -C -C Insert the following after line 431 -C (IF (SETS(SOF_0_NLINE,0).EQ.0) GOTO 800): -C -C IF ((INDEX(CSET,'@').GT.0).OR.(INDEX(CSET,'>').GT.0)) THEN -C JS=WNDSTA_X(KW,TXT,CSET(1), -C SETS(SOF_0_NLINE,0)) ! extra keyword layer -C IF (.NOT.JS) GOTO 10 ! Problem: try WNDPAR again -C TXT=CSET(1) ! Success: new default string -C J=WNCAL0(TXT)+1 ! Significant length -C GOTO 10 ! call WNDPAR with new default -C END IF -Ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc diff --git a/src/wng/wndstg.for b/src/wng/wndstg.for deleted file mode 100644 index 04644f54b2e9db991f09ab926e6ed360c04ea880..0000000000000000000000000000000000000000 --- a/src/wng/wndstg.for +++ /dev/null @@ -1,293 +0,0 @@ -C+ WNDSTG.FOR -C WNB 910327 -C -C Revisions: -C WNB 910826 Add loop definitions to # -C WNB 910909 Minor changes -C JPH 930513 Comments -C WNB 931015 Split off STR, STS; use SSH_DEF -C WNB 931115 Improve speed for average find by factor 2 -C JPH 940826 Make 'new version' message generic -C JPH 941005 WNGSTD -C -C - LOGICAL FUNCTION WNDSTG(FCA,SETS,HDV,SSHP,SNAM) -C -C Get next set -C Note: "Set" refers to the generic "set" concept in Newstar, which may be a -C SCN-file sector, a .WMP-file map or whatever. The only assumption made is -C that the offsets are as defined in the PARAMETER statements below. -C -C Result: -C -C WNDSTG_L = WNDSTG( FCA_J:I, SETS_J(0:*,0:*):IO, HDV_J:I, -C SSHP_J:O, SNAM_J(0:*):O) -C Get next set in file FCA, using the -C specification in SETS (see WNDSTA). -C WNDSTG will be .false. if no more sets. -C HDV is the number of the current program -C version header. SSHP the -C diskpointer. SNAM is the full name of the -C group, coded. A check is made for the right -C version. -C -C WNDSTH_L = WNDSTH( FCA_J:I, SETS_J(0:*,0:*):IO, HDV_J:I, -C SSHP_J:O, SNAM_J(0:*):O) -C Same, but no check for version -C -C WNDSTL_L = WNDSTL( FCA_J:I, SETS_J(0:*,0:*):IO, HDV_J:I, -C SSHP_J:O, SNAM_J(0:*):O, -C OFFSET_J(0:*):I) -C As WNDSTG, but the check in the set list SETS -C is done with offsets OFFSET. -C -C WNDSTD_L = WNDSTS( FCA_J:I, SETS_J(0:*,0:*):IO, HDV_J:I, -C SSHP_J:O, SNAM_J(0:*):O, -C OFFSET_J(0:*):I) -C As WNDSTL, but remove the link between the last -C SGH block and the data header so the data become -C 'invisible' -C -C Include files: -C - INCLUDE 'WNG_DEF' - INCLUDE 'SSH_O_DEF' !SET RELATED - INCLUDE 'GFH_O_DEF' !FILE HEADER - INCLUDE 'SGH_O_DEF' !SUB-GROUP HEADER -C -C Parameters: -C -C -C Entry points: -C - LOGICAL WNDSTH ! NO VERSION CHECK - LOGICAL WNDSTL ! OFFSET FOR LOOPS - LOGICAL WNDSTD ! delete link -C -C Arguments: -C - INTEGER FCA !FILE TO SEARCH - INTEGER SETS(0:SOF__N-1,0:*) !SETS TO DO - INTEGER HDV !HEADER VERSION TO ACCEPT - INTEGER SSHP !POINTER TO SET HEADER - INTEGER SNAM(0:SOF__N-1) !FULL SET NAME - INTEGER OFFSET(0:SOF__N-1) !CHECK OFFSET FOR LOOPS -C -C Function references: -C - LOGICAL WNFRD, WNFWR ! READ/write DISK -C -C Data declarations: -C - LOGICAL DODEL ! 'delete' switch - LOGICAL DOCH !DO CHECK SWITCH - INTEGER CHSET(0:SOF__N-1) !OFFSET FOR LOOP CHECK - BYTE SGH(0:SGH__L-1) !SUB-GROUP HEADER - INTEGER SGHJ(0:SGH__L/LB_J-1) - EQUIVALENCE (SGH,SGHJ) - BYTE SSH(0:SSH__L-1) !LOCAL PART SET HEADER - INTEGER*2 SSHI(0:SSH__L/LB_I-1) - EQUIVALENCE (SSH,SSHI) -C- - WNDSTG=.TRUE. !ASSUME OK - DOCH=.TRUE. !CHECK VERSION - DODEL=.FALSE. - GOTO 11 -C -C WNDSTH -C - ENTRY WNDSTH(FCA,SETS,HDV,SSHP,SNAM) -C - WNDSTH=.TRUE. - DOCH=.FALSE. !NO CHECK VERSION - DODEL=.FALSE. - GOTO 11 -C -C CLEAR OFFSET -C - 11 CONTINUE - - DO I=0,SOF__N-1 !NO OFFSETS - CHSET(I)=0 - END DO - GOTO 10 -C -C WNDSTL -C - ENTRY WNDSTL(FCA,SETS,HDV,SSHP,SNAM,OFFSET) -C - WNDSTL=.TRUE. - DOCH=.TRUE. !CHECK VERSION - DODEL=.FALSE. - GOTO 9 -C -C WNDSTD -C - ENTRY WNDSTD(FCA,SETS,HDV,SSHP,SNAM,OFFSET) -C - WNDSTD=.TRUE. - DOCH=.FALSE. !CHECK VERSION - DODEL=.TRUE. - GOTO 9 -C - 9 CONTINUE - DO I=0,SOF__N-1 !SET OFFSETS - CHSET(I)=OFFSET(I) - END DO - GOTO 10 - -C NEXT CHECK LINE -C - 10 CONTINUE - IF (SETS(SOF_0_LEVEL,0).EQ.0) THEN !NEW LINE - SETS(SOF_0_CLINE,0)=SETS(SOF_0_CLINE,0)+1 !NEXT LINE - IF (SETS(SOF_0_CLINE,0).GT.SETS(SOF_0_NLINE,0)) GOTO 900 !NO MORE LINES - IF (IAND(SETS(SOF_L_DEF,SETS(SOF_0_CLINE,0)),SOF_M_HI).EQ. - 1 SOF_M_SLOOP) GOTO 10 !SKIP LOOP DEFINITION - SETS(SOF_0_LEVEL,0)=1 !LEVEL 1 - IF (SETS(SOF_SPEC,SETS(SOF_0_CLINE,0)).EQ.SOF_M_SPEC) THEN !# - SETS(SOF_0_CSET,0)=GFH_LINK_1 !CURRENT SET - SETS(SOF_0_CLH,0)=GFH_LINK_1 !CURRENT LINK HEAD - ELSE !GROUPS - SETS(SOF_0_CSET,0)=GFH_LINKG_1 !CURRENT GROUP - SETS(SOF_0_CLH,0)=GFH_LINKG_1 !CURRENT LINK HEAD - END IF - END IF -C -C READ CURRENT GROUP -C - 21 CONTINUE - IF (.NOT.WNFRD(FCA,SGH__L,SGH(0), - 1 SETS(SOF_0_CSET,0))) GOTO 900 !READ CURRENT - 20 CONTINUE - IF (SGHJ(SGH_LINK_J).EQ.SETS(SOF_0_CLH,0)) THEN !END OF LIST - 22 CONTINUE - SETS(SOF_0_LEVEL,0)=SETS(SOF_0_LEVEL,0)-1 !DECREASE LEVEL - IF (SETS(SOF_0_LEVEL,0).EQ.0) GOTO 10 !LOWEST, NEXT LINE - SETS(SOF_0_CSET,0)= - 1 SGHJ(SGH_HEADH_J)-SGH_LINKG_1+SGH_LINK_1 !LOWER HEADER ADDR - IF (.NOT.WNFRD(FCA,SGH__L,SGH(0), - 1 SETS(SOF_0_CSET,0))) GOTO 900 !READ CURRENT - SETS(SOF_0_CLH,0)=SGHJ(SGH_HEADH_J) !NEW LOWER HEAD - GOTO 20 !RETRY - END IF - SETS(SOF_0_CSET,0)=SGHJ(SGH_LINK_J) !NEXT ENTRY - IF (.NOT.WNFRD(FCA,SGH__L,SGH(0), - 1 SETS(SOF_0_CSET,0))) GOTO 900 !READ CURRENT - IF (SETS(SOF_SPEC,SETS(SOF_0_CLINE,0)).EQ.SOF_M_SPEC) THEN !# - IF (SETS(SETS(SOF_0_LEVEL,0)-1, - 1 SETS(SOF_0_CLINE,0)).NE. - 1 SOF_M_ALL) THEN !CHECK * OR VALUE - IF (IAND(SETS(SETS(SOF_0_LEVEL,0)-1, - 1 SETS(SOF_0_CLINE,0)),SOF_M_HI).EQ. - 1 SOF_M_LOOP) THEN !LOOP PRESENT - I=IAND(SETS(SETS(SOF_0_LEVEL,0)-1, - 1 SETS(SOF_0_CLINE,0)),SOF_M_LO) !LOOP DEF. LINE - IF (SGHJ(SSH_SETN_J).LT. - 1 SETS(SOF_L_START,I)+CHSET(SETS(SOF_0_LEVEL,0)-1)) - 1 GOTO 20 !BEFORE LOOP START - IF (MOD(SGHJ(SSH_SETN_J)- - 1 (SETS(SOF_L_START,I)+ - 1 CHSET(SETS(SOF_0_LEVEL,0)-1)), - 1 SETS(SOF_L_INC,I)).NE.0) GOTO 20 !NOT IN LOOP - IF (SETS(SOF_L_END,I).NE.SOF_M_ALL) THEN !NOT * END - IF (SGHJ(SSH_SETN_J).GT. - 1 SETS(SOF_L_END,I)+CHSET(SETS(SOF_0_LEVEL,0)-1)) - 1 GOTO 22 !BEYOND END - END IF - ELSE !VALUE - I0=SETS(SETS(SOF_0_LEVEL,0)-1, - 1 SETS(SOF_0_CLINE,0))+ - 1 CHSET(SETS(SOF_0_LEVEL,0)-1) !CURRENT LINE SET - IF (SGHJ(SSH_SETN_J).LT.I0) THEN !BEFORE LINE SET - GOTO 20 - ELSE IF (SGHJ(SSH_SETN_J).GT.I0) THEN !BEYOND LINE SET - GOTO 22 - END IF - END IF - END IF - SSHP=SETS(SOF_0_CSET,0) !SET HEADER - ELSE - IF (SETS(SETS(SOF_0_LEVEL,0)-1,SETS(SOF_0_CLINE,0)).NE. - 1 SOF_M_ALL) THEN !NOT * - IF (IAND(SETS(SETS(SOF_0_LEVEL,0)-1, - 1 SETS(SOF_0_CLINE,0)),SOF_M_HI).EQ. - 1 SOF_M_LOOP) THEN !LOOP PRESENT - I=IAND(SETS(SETS(SOF_0_LEVEL,0)-1, - 1 SETS(SOF_0_CLINE,0)),SOF_M_LO) !LOOP DEF. LINE - IF (SGHJ(SGH_GROUPN_J).LT.SETS(SOF_L_START,I)+ - 1 CHSET(SETS(SOF_0_LEVEL,0)-1)) - 1 GOTO 20 !BEFORE LOOP START - IF (MOD(SGHJ(SGH_GROUPN_J)-(SETS(SOF_L_START,I)+ - 1 CHSET(SETS(SOF_0_LEVEL,0)-1)), - 1 SETS(SOF_L_INC,I)).NE.0) GOTO 20 !NOT IN LOOP - IF (SETS(SOF_L_END,I).NE.SOF_M_ALL) THEN !NOT * END - IF (SGHJ(SGH_GROUPN_J).GT. - 1 SETS(SOF_L_END,I)+CHSET(SETS(SOF_0_LEVEL,0)-1)) - 1 GOTO 22 !BEYOND END - END IF - ELSE - I0=SETS(SETS(SOF_0_LEVEL,0)-1, - 1 SETS(SOF_0_CLINE,0))+ - 1 CHSET(SETS(SOF_0_LEVEL,0)-1) !LINE SET - IF (SGHJ(SGH_GROUPN_J).LT.I0) THEN !BEFORE LINE SET - GOTO 20 !NOT SELECTED - ELSE IF (SGHJ(SGH_GROUPN_J).GT.I0) THEN !BEYOND LINE SET - GOTO 22 - END IF - END IF - END IF - SSHP=SGHJ(SGH_DATAP_J) !DATA POINTER - IF (SSHP.EQ.0) THEN !NEXT LEVEL - IF (SGHJ(SGH_LINKG_J).EQ. - 1 SETS(SOF_0_CSET,0)+SGH_LINKG_1) GOTO 20 !NO NEXT L. - SETS(SOF_0_LEVEL,0)=SETS(SOF_0_LEVEL,0)+1 !NEXT LEVEL - IF (SETS(SOF_0_LEVEL,0).GT.SOF__N) GOTO 900 !TOO MANY LEVELS - SETS(SOF_0_CLH,0)=SETS(SOF_0_CSET,0)+SGH_LINKG_1 !NEW HEADER PTR - SETS(SOF_0_CSET,0)=SETS(SOF_0_CLH,0) !NEXT CURRENT - GOTO 21 !CONTINUE - END IF - END IF -C - IF (DODEL) THEN - SGHJ(SGH_DATAP_J)=0 - IF (.NOT.WNFWR(FCA,SGH__L,SGH(0), - 1 SETS(SOF_0_CSET,0))) GOTO 900 !WRITE last SGH - ENDIF -C -C gET SET HEADER -C - IF (.NOT.WNFRD(FCA,SSH__L,SSH(0),SSHP)) GOTO 900 !READ SET HEADER - IF (DOCH) THEN !CHECK VERSION - IF (SSHI(SSH_VER_I).LT.HDV) THEN !WRONG VERSION - CALL WNCTXT(F_TP, - 1'!/Old version: First update your input file with the NVS option!/') - GOTO 900 - END IF - END IF -C -C SET SET NAME -C - IF (SETS(SOF_SPEC,SETS(SOF_0_CLINE,0)).EQ.SOF_M_SPEC) THEN !# - SNAM(0)=SGHJ(SSH_SETN_J) !SET NUMBER - SNAM(SOF_SPEC)=SOF_M_SPEC !INDICATE # - ELSE - DO I=0,SOF__N-1 !COPY NAME - SNAM(I)=SGHJ(SGH_FGROUP_J+I) - END DO - END IF -C - RETURN -C -C ERROR -C - 900 CONTINUE - DO I=1,SOF__N-1 - SETS(I,0)=0 !RESET SEARCH - END DO - WNDSTG=.FALSE. !NO MORE -C - RETURN -C -C - END diff --git a/src/wng/wndsti.for b/src/wng/wndsti.for deleted file mode 100644 index f72e1b71264292301ec86fd4d94614ed9c45ecd0..0000000000000000000000000000000000000000 --- a/src/wng/wndsti.for +++ /dev/null @@ -1,74 +0,0 @@ -C+ WNDSTI.FOR -C WNB 910909 -C -C Revisions: -C JPH 930513 comments -C WNB 931015 Use SSH -C - SUBROUTINE WNDSTI(FCA,SNAM) -C -C Find an index for a set -C Note: "Set" rwefers to the generic "set" concept in Newstar, which may be a -C SCN-file sector, a .WMP-file map or whatever. The only assumption made is -C that the offsets are as defined in the PARAMETER statements below. -C -C Result: -C -C CALL WNDSTI( FCA_J:I, SNAM_J(0:*):O) -C If SNAM is not an index (hence a # specifier) -C replace SNAM with an index. - -C -C Include files: -C - INCLUDE 'WNG_DEF' - INCLUDE 'SSH_O_DEF' !SET RELATED -C -C Parameters: -C -C -C Arguments: -C - INTEGER FCA !FILE TO SEARCH - INTEGER SNAM(0:SOF__N-1) !FULL SET NAME -C -C Function references: -C - LOGICAL WNDSTH !GET AN INDEX - LOGICAL WNFRD !READ DISK -C -C Data declarations: -C - INTEGER SETS(0:SOF__N-1,0:1) !SEARCH PATTERN - INTEGER SNAM1(0:SOF__N-1) !NAME FOUND - BYTE SSH(0:SSH__L-1) !PART SET HEADER - INTEGER SSHJ(0:SSH__L/LB_J-1) - EQUIVALENCE (SSH,SSHJ) -C- -C -C INIT -C - IF (SNAM(SOF_SPEC).NE.SOF_M_SPEC) GOTO 900 !NOT A # SPECIFIER - DO I=0,SOF__N-1 - SETS(I,0)=0 !SEARCH PATTERN - SETS(I,1)=SOF_M_ALL !SET ALL - END DO - SETS(SOF_0_NLINE,0)=1 -C -C FIND -C - DO WHILE (WNDSTH(FCA,SETS,0,J,SNAM1)) !SEARCH - IF (.NOT.WNFRD(FCA,SSH__L,SSH,J)) GOTO 900 !STOP - IF (SNAM(0).EQ.SSHJ(SSH_SETN_J)) THEN !FOUND - DO I=0,SOF__N-1 !SET INDEX - SNAM(I)=SNAM1(I) - END DO - GOTO 900 !READY - END IF - END DO -C - 900 CONTINUE - RETURN -C -C - END diff --git a/src/wng/wndstr.for b/src/wng/wndstr.for deleted file mode 100644 index 9d930c432eb3a051156194e664fece742f731761..0000000000000000000000000000000000000000 --- a/src/wng/wndstr.for +++ /dev/null @@ -1,69 +0,0 @@ -C+ WNDSTR.FOR -C WNB 931015 -C -C Revisions: -C WNB 910826 Add loop definitions to # -C WNB 910909 Minor changes -C JPH 930513 Comments -C WNB 931015 Split off STR, STS; use SSH_DEF -C - LOGICAL FUNCTION WNDSTR(FCA,SETS) -C -C Reset or save the current set search path -C -C Result: -C -C WNDSTR_L = WNDSTR( FCA_J:I, SETS_J(0:*,0:*):IO) -C Reset the set list SETS to initial conditions -C Note: FCA not used -C WNDSTS_L = WNDSTS( FCA_J:I, SETS_J(0:*,0:*):I, SSETS_J(0:*):O) -C Save status of SETS list into SSETS list. -C Note: FCA not used -C -C Include files: -C - INCLUDE 'WNG_DEF' - INCLUDE 'SSH_O_DEF' !SET RELATED -C -C Parameters: -C -C -C Entry points: -C - LOGICAL WNDSTS !SAVE SET STATUS -C -C Arguments: -C - INTEGER FCA !FILE TO SEARCH - INTEGER SETS(0:SOF__N-1,0:*) !SETS TO DO - INTEGER SSETS(0:SOF__N-1) !SAVE SET LIST -C -C Function references: -C -C -C Data declarations: -C -C- -C -C WNDSTR -C - WNDSTR=.TRUE. - DO I=1,SOF__N-1 - SETS(I,0)=0 !RESET SEARCH - END DO -C - RETURN -C -C WNDSTS -C - ENTRY WNDSTS(FCA,SETS,SSETS) -C - WNDSTS=.TRUE. - DO I=0,SOF__N-1 - SSETS(I)=SETS(I,0) !SAVE SET STATUS - END DO -C - RETURN -C -C - END diff --git a/src/wng/wndtci.for b/src/wng/wndtci.for deleted file mode 100644 index 322eb1a72a02c2c0c249da6157c82cbf028da0bc..0000000000000000000000000000000000000000 --- a/src/wng/wndtci.for +++ /dev/null @@ -1,92 +0,0 @@ -C+ WNDTCI.FOR -C WNB 910916 -C -C Revisions: -C - SUBROUTINE WNDTCI(TAB,TABLEN) -C -C Disk table check -C -C Result: -C -C CALL WNDTCI( TAB_J(0:2,0:TABLEN):IO, TABLEN_J:I) -C Initiate the table TAB for searching -C CALL WNDTCK( TAB_J(0:2,0:TABLEN):IO, TABLEN_J:I, -C IFCA_J:I, OFCA_J:I, TPTR_J:IO, TLEN_J:IO) -C Check if the input disk table of length TLEN at -C TPTR exists already on the output. If not -C copy, and always replace the TPTR by the -C output pointer. -C -C Include files: -C - INCLUDE 'WNG_DEF' -C -C Parameters: -C -C -C Arguments: -C - INTEGER TAB(0:2,0:*) !CHECK TABLE - INTEGER TABLEN !TABEL LENGTH - INTEGER IFCA !INPUT FILE - INTEGER OFCA !OUTPUT FILE - INTEGER TPTR !INPUT POINTER - INTEGER TLEN !INPUT LENGTH -C -C Function references: -C - LOGICAL WNGGVM !GET MEMORY - INTEGER WNFEOF !GET FILE POINTER - LOGICAL WNFRD !READ FILE - LOGICAL WNFWR !WRITE FILE -C -C Data declarations: -C -C- - TAB(0,0)=0 !SET EMPTY TABLE -C - RETURN -C -C WNDTCK -C - ENTRY WNDTCK(TAB,TABLEN,IFCA,OFCA,TPTR,TLEN) -C - IF (IFCA.NE.OFCA) THEN !OUTPUT NOT INPUT - DO I=1,TAB(0,0) !CHECK PRESENCE - IF (TAB(0,I).EQ.TPTR .AND. TAB(1,I).EQ.TLEN) THEN !FOUND - TPTR=TAB(2,I) !RETURN OUTPUT PTR - GOTO 900 !READY - END IF - END DO -C - IF (TAB(0,0).GE.TABLEN) THEN !CAN NOT FIT MORE - DO I=1,TABLEN-1 !MOVE - DO I1=0,3 - TAB(I1,I)=TAB(I1,I+1) - END DO - END DO - TAB(0,0)=TABLEN-1 !SET EMPTY - END IF - TAB(0,0)=TAB(0,0)+1 !COUNT - TAB(0,TAB(0,0))=TPTR !SAVE INPUT - TAB(1,TAB(0,0))=TLEN - TAB(2,TAB(0,0))=WNFEOF(OFCA) !OUTPUT PTR - TPTR=TAB(2,TAB(0,0)) !RETURN IT - IF (.NOT.WNGGVM(TLEN,J)) GOTO 10 !GET BUFFER - IF (.NOT.WNFRD(IFCA,TAB(1,TAB(0,0)),A_B(J-A_OB), - 1 TAB(0,TAB(0,0)))) THEN !READ - 10 CONTINUE - CALL WNCTXT(F_TP,'Error reading disktable') - CALL WNGEX !STOP - END IF - IF (.NOT.WNFWR(OFCA,TAB(1,TAB(0,0)),A_B(J-A_OB), - 1 TAB(2,TAB(0,0)))) GOTO 10 !COPY - CALL WNGFVM(TLEN,J) !FREE BUFFER - END IF -C - 900 CONTINUE - RETURN -C -C - END diff --git a/src/wng/wndxlp.for b/src/wng/wndxlp.for deleted file mode 100644 index a3b28c4634eb2751b3e8ad244d2417659edddd8a..0000000000000000000000000000000000000000 --- a/src/wng/wndxlp.for +++ /dev/null @@ -1,186 +0,0 @@ -C+ WNDXLP.FOR -C WNB 910913 -C -C Revisions: -C WNB 911003 Correct multiple loops -C WNB 920303 SUN problems () -C WNB 920403 Correct n+1 problem multiple loops -C WNB 921203 Add WNDXL1 -C CMV 931210 Keyword passed as an argument -C CMV 931220 FCA of input file passed as an argument -C JPH 940831 Comments -C - LOGICAL FUNCTION WNDXLP(KW,FCAIN) -C -C General set loop control -C -C Result: -C -C WNDXLP_L = WNDXLP(KW_C*(*):I, FCAIN_J:I) -C Obtain the loop control parameters, and -C initialise loop. User is prompted with -C keyword KW, FCAIN is passed to WNDSTA -C and should hold the FCA of the input -C file or be <= 0 -C WNDXL1_L = WNDXL1() Set parameters for one loop; initialise -C WNDXLI_L = WNDXLI( LPOFF_J(0:7):O) -C Initialise the loop offset LPOFF -C WNDXLN_L = WNDXLN( LPOFF_J(0:7):O) -C Get next loop offset or .FALSE. -C -C This module controls a single nest of loops, whose parameters are -C prompted for by WNDXLP and stored in local data structures defined by WND_DEF. -C Loop definition is independent of both the associated SETS specification -C (which defines the starting point of the loops) and the file in which the -C sets are to be read/written. It is the caller's responsibility to implement -C the proper combination of SETS, LOOPS and files. -C It is possible to loop over input and output sets simultaneously. -C (Example: NCAPOC) -C The only function of the FCAIN parameter is to enable WNDSTA to show the -C input file's layout. -C -C -C Include files: -C - INCLUDE 'WNG_DEF' - INCLUDE 'WND_DEF' -C -C PIN references: -C -C LOOPS -C -C Entry points: -C - LOGICAL WNDXL1 !SET 1 LOOP - LOGICAL WNDXLI !INIT. LOOPS - LOGICAL WNDXLN !NEXT LOOP OFFSET -C -C Parameters: -C -C -C Arguments: -C - CHARACTER*(*) KW !KEYWORD TO PROMPT FOR - INTEGER FCAIN !FCA of input file - INTEGER LPOFF(0:7) !PROGRAM LOOP OFFSETS -C -C Function references: -C - LOGICAL WNDSTA !GET SETS -C -C Data declarations: -C -C- -C -C INIT -C - WNDXLP=.TRUE. !ASSUME OK -C -C GET LOOP LIST -C - 10 CONTINUE - IF (.NOT.WNDSTA(KW,2*MXNLOP,XPOFF(0,1,0),FCAIN)) THEN - IF (E_C.EQ.DWC_ENDOFLOOP) THEN !LEAVE WITH ERROR - WNDXLP=.FALSE. - XPOFF(0,1,0)=0 !ASSUME 1 LOOP - ELSE - GOTO 10 !RETRY - END IF - END IF - GOTO 11 -C -C WNDXL1 -C - ENTRY WNDXL1() -C - WNDXL1=.TRUE. !ASSUME OK - XPOFF(0,1,0)=0 !ASSUME 1 LOOP - GOTO 11 -C -C INTERPRET LIST -C - 11 CONTINUE - XPOFF(0,1,0)=XPOFF(0,1,0)/2 !PAIRS SPECIFIED - IF (XPOFF(0,1,0).LE.0) THEN !ASSUME 1 - XPOFF(0,1,0)=1 !ASSUME 1 LOOP - XPOFF(0,0,1)=1 !WITH COUNT 1 - END IF - DO I=1,XPOFF(0,1,0) !ALL ENTRIES - IF (IAND(XPOFF(0,0,I),'ffff0000'X).NE.0) - 1 XPOFF(0,0,I)=1 !ASSUME 1 COUNT - XPOFF(0,0,I)=MAX(1,XPOFF(0,0,I)) !MIN. 1 COUNT - DO I1=0,7 - IF (IAND(XPOFF(I1,1,I),'ffff0000'X).NE.0) !LOOP OR * - 1 XPOFF(I1,1,I)=0 !NO INCREMENT - END DO - END DO - 40 CONTINUE - XPOFF(0,0,0)=0 !MAJOR LOOP COUNT - XLPTR=0 !CURRENT INDEX - XLCNT(0)=0 !COUNT INDEX 0 -C - GOTO 900 !READY -C -C WNDXLI -C - ENTRY WNDXLI(LPOFF) !SET INITIAL OFFSET -C - WNDXLI=.TRUE. !ASSUME OK -C - 20 CONTINUE - DO I=0,7 !SET LPOFF START - LPOFF(I)=0 - END DO - GOTO 40 !ASSURE CORRECT START -C - GOTO 900 -C -C WNDXLN -C - ENTRY WNDXLN(LPOFF) !GET NEXT OFFSET -C - WNDXLN=.TRUE. !ASSUME OK -C -C NEXT INDEX -C - 30 CONTINUE - DO WHILE (XLPTR.LT.XPOFF(0,1,0)) !MORE INDICES - DO I=0,7 !SAVE OFFSET - XLSAV(I,XLPTR)=LPOFF(I) - END DO - XLPTR=XLPTR+1 !NEXT INDEX - XLCNT(XLPTR)=0 !START COUNT INDEX - END DO -C -C UPDATE INDEX -C - DO WHILE (XLPTR.GT.0) !MORE - IF (XLCNT(XLPTR).LT.XPOFF(0,0,XLPTR)) THEN !CAN DO MORE - IF (XLCNT(XLPTR).GT.0) THEN !UPDATE - DO I=0,7 - LPOFF(I)=LPOFF(I)+XPOFF(I,1,XLPTR) - END DO - END IF - IF (XLPTR.GE.XPOFF(0,1,0)) THEN !LAST INDEX - XLCNT(XLPTR)=XLCNT(XLPTR)+1 !UPDATE INDEX - ELSE - GOTO 30 !GET ALL INDICES - END IF - GOTO 900 !RETURN UPDATED INDEX - END IF - XLPTR=XLPTR-1 !TRY PREVIOUS INDEX - DO I=0,7 !RESTORE PREVIOUS - LPOFF(I)=XLSAV(I,XLPTR) - END DO - XLCNT(XLPTR)=XLCNT(XLPTR)+1 !UPDATE INDEX - END DO - WNDXLN=.FALSE. !READY - GOTO 20 !RESET TO START -C -C READY -C - 900 CONTINUE - RETURN -C -C - END diff --git a/src/wng/wnf.grp b/src/wng/wnf.grp deleted file mode 100644 index 0ec13cca1abcc6661b506595845172a1392f799a..0000000000000000000000000000000000000000 --- a/src/wng/wnf.grp +++ /dev/null @@ -1,104 +0,0 @@ -!+ WNF.GRP -! WNB 890202 -! -! Revisions: -! WNB 921215 Hide .INC -! WNB 930803 Save necessary _m.mvx; change wnf*.cee to .cun -! WNB 930811 Make .mvx into .fvx -! HjV 931202 Add WNFTH1 and WNFTH2 (was enrty) -! HjV 940217 Add/change missing entry-points/functions -! CMV 941017 Add WNFSCI and WNFSCI_X -! HjV 941107 Add WNGMED, change WNFEOF description -! -! General tape/disk file input/output package -! -! Group definition: -! -WNF.GRP -! -! PIN files -! -! -! Structure files -! -FCQ.DSC ! FCA queue header -MCA.DSC ! MCA description -FCA.DSC ! FCA description -FBC.DSC ! FBC description -FEL.DSC ! FEL description -! -! General command files -! -! -! Fortran definition files: -! -! -! Programs: -! -TWNF.FOR ! Test program -! -WNFEXH.FOR !WNFEXH Do exit handler -WNFCL.FOR !WNFCL Close file - WNFCL_X.FVX !WNFCL_X Actual closing - WNFCL_X.CUN !WNFCL_X0 Prepare for truncate - !WNFCL_X1 Prepare for delete -WNFDMO.FOR !WNFDMO Dismount tape - WNFDMO_X.FVX - WNFDMO_X.CUN -WNFEOF.FOR !WNFEOF Give current file EOF - !WNFTLB Give current tape label - !WNFTLN Give current tape length in inches, - ! bytes, Kbytes, Mbytes or Gbytes -WNFFNM.FOR !WNFFNM Get unique file name -WNFINI.FOR !WNFINI Initialise exit handler -WNFIO.FOR !WNFRD Read data - WNFIO_X.FVX !WNFRDS Read sequential data - WNFIO_X.CUN !WNFRDA Read ahead - !WNFWR Write data - !WNFWRS Write sequential data - !WNFWRA Write after - !WNFPUR Purge buffers - !WNFIO_X Actual read/write - !WNFPUR_X Purge all buffers - !WNF_RWAHEAD Read/write ahead - !WNF_EOF Convert disk address to EOF - !WNF_INWRITEW Initialise a write and wait - !WNF_INWRITE Initialise a write - !WNF_INREAD Initialise a read - !WNF_EXTEND Extend file - !WNF_SETAQ Set in address queue - !WNF_IAST General I/O AST - !WNF_WASTW Rewrite AST - !WNF_WAST Standard write AST - !WNF_WASTX Write extend AST - !WNF_RAST Standard read AST - !WNF_RASTW Rewrite read AST - !WNFIO_X0 Reset extend bit - !WNFIO_X1 Get new size - !WNFIO_X2 Set extend size -WNFMOU.FOR !WNFMOU Mount tape - WNFMOU_X.FVX - WNFMOU_X.CUN -WNFOP.FOR !WNFOP Open disk/tape - WNFOP_X.FVX !WNFOPF Open with full capabilities - WNFOP_X.CUN !WNFOP_X Actual opening - !WNFOP_X0 Set ATR and FIB -WNFSCI.FSC !WNFSCI Pass database request to QED - WNFSCI_X.CUN !WNFSCI_X low level routine -WNFTFC.FOR !WNFTFC Test correct FCA/MCA - !WNFLFC Link FCA - !WNFUFC Unlink FCA -WNFTRW.FVX !WNFTRW Rewind tape - WNFTRW.CUN !WNFTRD Read 80 character tape block - !WNFTWR Write 80 character tape block - !WNFTTM Write tape mark - !WNFTSF Skip tape files - !WNFTSB Skip tape blocks -WNFTVL.FOR !WNFTVL Give current tape VOL1 -WNFTH1.FOR !WNFTH1 Give current tape HDR1 -WNFTH2.FOR !WNFTH2 Give current tape HDR2 -! -! Executables -! -TWNF.EXE ! Test program -!- diff --git a/src/wng/wnfcl.for b/src/wng/wnfcl.for deleted file mode 100644 index 733507d3adc91bf229a86fa5b1dc403bd9a573b3..0000000000000000000000000000000000000000 --- a/src/wng/wnfcl.for +++ /dev/null @@ -1,95 +0,0 @@ -C+ WNFCL.FOR -C WNB 890725 -C -C Revisions: -C WNB 930811 Get rid of L_ -C - LOGICAL FUNCTION WNFCL(FCA) -C -C Close file for read/write/update access -C -C Result: -C WNFCL_L = WNFCL( FCA:J:IO) -C Close file pointed to by dynamic control area in FCA. -C -C PIN references: -C -C -C Include files: -C - INCLUDE 'WNG_DEF' - INCLUDE 'MCA_O_DEF' !MCA - INCLUDE 'FCA_O_DEF' !FCA - INCLUDE 'FBC_O_DEF' !FBC - INCLUDE 'FEL_O_DEF' !FEL -C -C Parameters: -C -C -C Arguments: -C - INTEGER FCA !DYNAMIC FILE AREA -C -C Function references: -C - INTEGER WNFCL_X !ACTUAL CLOSING - INTEGER WNFTFC !TEST FCA PRESENT -C -C Data declarations: -C -C -C Equivalences: -C -C -C Commons: -C -C- -C -C TEST FCA -C - WNFCL=.FALSE. !ASSUME ERROR - CALL WNFINI !START SYSTEM - I0=WNFTFC(FCA) !TYPE OF BLOCK - IF (I0.EQ.0) RETURN !ILLEGAL FCA - J=FCA - J1=(J-A_OB)/LB_J !DUMMY ARRAY OFFSET - IF (I0.LT.0) THEN !TAPE - J=A_J(J1+MCA_FCA_J) !PROPER FCA - IF (J.EQ.0) RETURN !NO FILE OPEN ON MCA - J1=(J-A_OB)/LB_J !DUMMY ARRAY OFFSET - END IF - J2=FCA !POSSIBLE MCA ADDRESS - J3=(J2-A_OB)/LB_J !DUMMY ARRAY MCA -C -C DO CLOSE -C - CALL WNFPUR(FCA) !PURGE BUFFERS - E_C=WNFCL_X(A_B(J-A_OB),A_B(J2-A_OB)) !DO CLOSE -C -C QUEUES -C - I=FEL__NFEL*FELHDL !LENGTH ELEMENTS - CALL WNGFVM(I,A_J(J1+FCA_FEP_J)) !FREE ELEMENT AREA - I2=0 !COUNT BUFFERS - I3=A_J(J1+FCA_BQA_J) !FIRST - DO WHILE (I3.NE.J+FCA_BQA_1) !ALL BUFFERS - I2=I2+1 !COUNT - I4=(I3-A_OB)/LB_J !ARRAY INDEX - CALL WNGFVM(A_J(J1+FCA_BLEN_J),A_J(I4+FBC_ADDR_J)) !FREE MEMORY - I3=A_J(I4+FBC_BQA_J) !NEXT - END DO - I=I2*FBCHDL !LENGTH BUF CONTROL - CALL WNGFVM(I,A_J(J1+FCA_BCP_J)) !FREE CONTROL AREA - IF (IAND(E_C,1).EQ.1) WNFCL=.TRUE. - IF (I0.GE.0) THEN !DISK - CALL WNFUFC(FCA) !UNLINK LIST - FCA=0 !SET NOT OPEN - ELSE !TAPE - A_J(J3+MCA_FCA_J)=0 !SET NOT OPEN - END IF - CALL WNGFVM(FCAHDL,J) !FREE FCA -C - RETURN -C -C - END diff --git a/src/wng/wnfcl_x.cun b/src/wng/wnfcl_x.cun deleted file mode 100644 index 169ddb9c37bbd90c76f4fbee6c7bc12f18c758d1..0000000000000000000000000000000000000000 --- a/src/wng/wnfcl_x.cun +++ /dev/null @@ -1,141 +0,0 @@ -/*+ wnfcl_x.cun -. WNB 900107 -. -. Revisions: -. WNB 920114 Tape positioning -. GvD 920513 Exit immediately when chan=0 -. WNB 921210 Delete tmp files -. JPH 930414 FCA_M_WRT --> FCA_M_WRTAPE -. WNB 930803 Change to _o_inc and to .cun -. CMV 940204 Split off write() for remote tapedrive -. CMV 940822 Restore original protection for write-lock -. CMV 940926 Do not write end of tape marks if no data written -. AXC 040326 Placed sys/file outside { to help Fedora builds -. -... */ -#include "fca_o_inc" -#include "mca_o_inc" -#include <sys/file.h> -/* -... */ - wnfcl_x_(fcap,mcap) -/* -. Close disk/tape file for general stream/direct I/O -. -. Result: -. -. wnfcl_x_j = wnfcl_x( FCA_J:I, MCA_J:I) -. -. See WNFCL.FOR for details -. -. PIN references: -... */ -/* -. Arguments: -... */ - struct fca *fcap; /* FCA ptr */ - struct mca *mcap; /* MCA ptr */ -{ -/* -. Include files: -... */ -#include "wng_inc" -#include <errno.h> -#include <ctype.h> -extern int errno ; -/* -. Parameters: -... */ -/* -. Equivalences: -... */ -/* -. Commons: -... */ -/*- */ -/* -. Function references: -... */ - int wnftsf_(); /* skip tape files */ - int wnfttm_(); /* write tm */ - int wnftwb_(); /* write buffer */ -/* -. Data declarations: -... */ -/* int j; in wng_inc - int j1; - int js; -*/ - static char *no_change="No changes written to tape"; - -/* Exit when file not open -... */ - if (fcap->chan == 0) return(1); /* not open */ -/* Write tape labels -. -. If fcap->map <= 0, we used to write some dummy label followed -. by the end-of-data blocks. This way, a tape would be effectively -. erased if a user regrets using this tape between opening and -. winding up to the end of the tape. So now, we only write the -. closing stuff if data was acutally written to the tape. -. */ - if (fcap->bits & FCA_M_MAG) /* tape */ - { if (fcap->bits & FCA_M_WRTAPE) /* tape write */ - { - if (fcap->maw > 0) /* and written to */ - { - if (fcap->map <= 0) /* write a block */ - { wnftwb_(mcap,mcap->hd1,80); - fcap->map += 80; - fcap->mab += 1; - } - js= wnfttm_(mcap); /* write tape mark EOD */ - mcap->magf += 1; /* indicate */ - if (!(mcap->bits & MCA_M_UNL)) /* labeled */ - { - bcopy("EOF1",mcap->hd1,4); /* fill EOF1,2 */ - bcopy("EOF2",mcap->hd2,4); - /*** fill more */ - js= wnftwb_(mcap,mcap->hd1,80); /* write EOF1,2 */ - js= wnftwb_(mcap,mcap->hd2,80); - js= wnfttm_(mcap); /* write tapemark */ - mcap->magf += 1; - } - js= wnfttm_(mcap); /* write EOV tm */ - mcap->magf += 1; - js= wnftsf_(mcap,-1); /* backup */ - mcap->magf += -1; - - } else { - js=F_TP; - wnctxt_(&js,no_change,strlen(no_change)); - } - - } - js= wnftsf_(mcap,-1); /* backup */ - mcap->magf += -1; - js= wnftsf_(mcap,1); /* proper position */ - mcap->magf += 1; - } -/* Close file -... */ - if (!(fcap->bits & FCA_M_MAG)) /* disk */ - { if (fcap->bits & FCA_M_TMP) /* delete */ - { ftruncate(fcap->chan,0); /* truncation */ - js= close(fcap->chan); /* close file */ - js= unlink(fcap->fnam); /* delete file */ - } - else - { - if (fcap->bits & FCA_M_WRITE) - fchmod(fcap->chan,fcap->atrj.atrj[0]); /* restore mode */ - js= close(fcap->chan); /* close file */ - } - } -/* Ready -... */ - return(1); -} -/* -. -... */ diff --git a/src/wng/wnfcl_x.fvx b/src/wng/wnfcl_x.fvx deleted file mode 100644 index feb50c1a096a6c1d349c7353fe07be145b40b32d..0000000000000000000000000000000000000000 --- a/src/wng/wnfcl_x.fvx +++ /dev/null @@ -1,178 +0,0 @@ -C+ WNFCL_X.FVX -C WNB 930804 -C -C Revisions: -C - INTEGER FUNCTION WNFCL_X(FCAJ,MCAJ) -C -C Close file -C -C -C Result: -C -C WNFCL_X_J = WNFCL_X( FCAJ_J(0:*):I, MCAJ_J(0:*):I) Close file -C -C Include files: -C - INCLUDE 'WNG_DEF' - INCLUDE '($SSDEF)' !ERROR CODES - INCLUDE '($IODEF)' !I/O CODES - INCLUDE 'FCA_O_DEF' !FCA - INCLUDE 'MCA_O_DEF' !MCA -C -C Parameters: -C -C -C Arguments: -C - INTEGER FCAJ(0:*) !FCA BLOCK - INTEGER MCAJ(0:*) !MCA BLOCK -C -C Function references: -C - INTEGER SYS$DASSGN - INTEGER SYS$QIOW - INTEGER WNFTWR !WRITE TAPE BLOCK - INTEGER WNFTTM !WRITE TM - INTEGER WNFTSF !SKIP TAPE FILE -C -C Data declarations: -C - INTEGER ECOD !LOCAL ERROR CODE - BYTE DBLK(0:79) !DUMMY BLOCK - CHARACTER*6 STR1 - INTEGER XXB(0:1) !FOR FILE FIND -C- -C -C INIT -C - ECOD=SS$_NORMAL !ASSUME OK -C -C WRITE TAPE EOF -C - IF (IAND(FCAJ(FCA_BITS_J),FCA_M_MAG).NE.0) THEN !TAPE - IF (IAND(FCAJ(FCA_BITS_J),FCA_M_WRTAPE).NE.0) THEN !TAPE WRITE - IF (FCAJ(FCA_MAP_J).LE.0) THEN !NOTHING WRITTEN - CALL WNGMVZ(80,DBLK) - JS=WNFTWR(MCAJ,DBLK) !WRITE DUMMY BLOCK - FCAJ(FCA_MAP_J)=FCAJ(FCA_MAP_J)+80 !COUNT DATA - FCAJ(FCA_MAB_J)=FCAJ(FCA_MAB_J)+1 !COUNT BLOCKS - IF (ECOD) ECOD=JS !PRESERVE ERROR - END IF !NOTHING WRITTEN - JS=WNFTTM(MCAJ) !WRITE EOD TM - MCAJ(MCA_MAGF_J)=MCAJ(MCA_MAGF_J)+1 !COUNT FILES - IF (ECOD) ECOD=JS !PRESERVE ERROR - IF (IAND(MCAJ(MCA_BITS_J),MCA_M_UNL).EQ.0) THEN !LABELED - MCAJ(MCA_HD1_1/LB_J)='EOF1' !EOF1 - MCAJ(MCA_HD2_1/LB_J)='EOF2' !EOF2 - CALL WNCTXS(STR1,'!6$ZJ',FCAJ(FCA_MAB_J)) !# OF BLOCKS - CALL WNGMFS(6,STR1,A_B(%LOC(MCAJ)-A_OB+MCA_HD1_1+54)) - JS=WNFTWR(MCAJ,MCAJ(MCA_HD1_1/LB_J)) !WRITE EOF1 - IF (ECOD) ECOD=JS !PRESERVE ERROR - JS=WNFTWR(MCAJ,MCAJ(MCA_HD2_1/LB_J)) !WRITE EOF2 - IF (ECOD) ECOD=JS !PRESERVE ERROR - JS=WNFTTM(MCAJ) !WRITE TM - MCAJ(MCA_MAGF_J)=MCAJ(MCA_MAGF_J)+1 !COUNT FILES - IF (ECOD) ECOD=JS !PRESERVE ERROR - END IF !LABELED TAPE - JS=WNFTTM(MCAJ) !WRITE EOV TM - MCAJ(MCA_MAGF_J)=MCAJ(MCA_MAGF_J)+1 !COUNT FILES - IF (ECOD) ECOD=JS !PRESERVE ERROR - JS=WNFTSF(MCAJ,-2) !BACKUP TAPE - MCAJ(MCA_MAGF_J)=MCAJ(MCA_MAGF_J)-2 !COUNT FILES - IF (ECOD) ECOD=JS !PRESERVE ERROR - END IF !TAPE WRITE - JS=WNFTSF(MCAJ,1) !FORWARD TAPE - MCAJ(MCA_MAGF_J)=MCAJ(MCA_MAGF_J)+1 !COUNT FILES - IF (ECOD) ECOD=JS !PRESERVE ERROR - END IF !TAPE -C -C DE-ACCESS -C - IF (IAND(FCAJ(FCA_BITS_J),FCA_M_ACC).NE.0) THEN !ACCESSED - FCAJ(FCA_BITS_J)=IAND(FCAJ(FCA_BITS_J), - 1 NOT(FCA_M_ACC)) !SET DEACCESSED - CALL WNFCL_X0(FCAJ,FCAJ,FCAJ(FCA_FIBJ_J)) !SET TRUNCATE - JS=SYS$QIOW(,%VAL(FCAJ(FCA_CHAN_J)),%VAL(IO$_DEACCESS), - 1 FCAJ(FCA_IOSB_J),,, - 1 FCAJ(FCA_FIBDES_J),,,, - 1 FCAJ(FCA_ATRJ_J),) !DEACCESS - IF (ECOD) ECOD=JS !PRESERVE SUBMIT ERROR - IF (ECOD) ECOD=FCAJ(FCA_IOSB_J) !PRESERVE I/O ERROR -C -C DELETE TMP FILE -C - IF (IAND(FCAJ(FCA_BITS_J),FCA_M_TMP).NE.0) THEN !DELETE FILE - CALL WNFCL_X1(FCAJ,FCAJ,FCAJ(FCA_FIBJ_J)) !SET FIB - XXB(0)=80 !PREPARE BLOCK - XXB(1)=%LOC(DBLK) - JS=SYS$QIOW(,%VAL(FCAJ(FCA_CHAN_J)), - 1 %VAL(IOR(IO$_DELETE,IO$M_DELETE)), - 1 FCAJ(FCA_IOSB_J),,, - 1 FCAJ(FCA_FIBDES_J),, - 1 I1,XXB,,) !DELETE FILE - IF (ECOD) ECOD=JS !PRESERVE SUBMIT ERROR - IF (ECOD) ECOD=FCAJ(FCA_IOSB_J) !PRESERVE I/O ERROR - END IF !TMP FILE - END IF !ACCESSED -C -C DE-ASSIGN CHANNEL -C - IF (IAND(FCAJ(FCA_BITS_J),FCA_M_ASS).NE.0) THEN !ASSIGNED - FCAJ(FCA_BITS_J)=IAND(FCAJ(FCA_BITS_J), - 1 NOT(FCA_M_ASS)) !SET DEASSIGNED - JS=SYS$DASSGN(%VAL(FCAJ(FCA_CHAN_J))) !DE-ASSIGN - END IF -C -C FREE EF'S -C - CALL LIB$FREE_EF(FCAJ(FCA_EF_J)) - CALL LIB$FREE_EF(FCAJ(FCA_EFA_J)) -C -C READY -C - WNFCL_X=IAND('0000FFFF'X,ECOD) !RETURN ERROR -C - RETURN -C -C - END -C -C MANIPULATE FIB -C -C PREPARE FOR TRUNCATE -C - SUBROUTINE WNFCL_X0(FCAJ,FCAB,FIB) -C - INCLUDE 'WNG_DEF' - INCLUDE '($FIBDEF)' - INCLUDE 'FCA_O_DEF' -C - INTEGER LIB$EXTZV -C - INTEGER FCAJ(0:*) - BYTE FCAB(0:*) - RECORD /FIBDEF/ FIB -C - I=FCAJ(FCA_EOF_J)+1023 !SET FIRST BLOCK TRUNCATE - FIB.FIB$L_EXVBN=LIB$EXTZV(9,23,I) - FIB.FIB$L_EXSZ=0 - CALL WNF_EOF(FCAJ) !SET EOF CORRECT FORMAT - FIB.FIB$W_EXCTL= - 1 IOR(FIB.FIB$W_EXCTL,FIB$M_TRUNC) !SET TRUNCATE -C - RETURN -C -C PREPARE FOR DELETE -C - ENTRY WNFCL_X1(FCAJ,FCAB,FIB) -C - CALL WNGMV(6,FCAB(FCA_DID_1), - 1 FIB.FIB$W_DID) !SET DIR. ID - FIB.FIB$W_NMCTL= - 1 IOR(FIB.FIB$W_NMCTL,FIB$M_FINDFID) !FIND FILE ID -C - RETURN -C -C - END diff --git a/src/wng/wnfdmo.for b/src/wng/wnfdmo.for deleted file mode 100644 index f5b3300a9c4efdb4f0d41c263611d6472a70e0ee..0000000000000000000000000000000000000000 --- a/src/wng/wnfdmo.for +++ /dev/null @@ -1,56 +0,0 @@ -C+ WNFDMO.FOR -C WNB 890724 -C -C Revisions: -C WNB 930520 Remove %VAL -C - LOGICAL FUNCTION WNFDMO(MCA) -C -C Dismount a tape volume -C -C Result: -C -C WNFDMO_L = WNFDMO( MCA_J:IO) -C Dismount a tape from MCA. -C -C Include files: -C - INCLUDE 'WNG_DEF' - INCLUDE 'MCA_O_DEF' !MCA OFFSETS -C -C Parameters: -C -C -C Arguments: -C - INTEGER MCA !MCA ID -C -C Function references: -C - INTEGER WNFTFC !TEST FCA/MCA PRESENCE - LOGICAL WNFDMO_X !DISMOUNT TAPE -C -C Data declarations: -C -C- - WNFDMO=.FALSE. !ASSUME ERROR - IF (WNFTFC(MCA).NE.0) THEN !STILL FILE OPEN/MOUNTED - CALL WNFCL(MCA) !CLOSE FILE - END IF - IF (WNFTFC(MCA).NE.-1) RETURN !NOT MCA - J=MCA !MCA POINTER - J1=(J-A_OB)/(L_J/L_B) !DUMMY ARRAY OFFSET - JS=WNFDMO_X(A_B(J-A_OB)) !DO DISMOUNT - E_C = 0 - IF (JS) THEN - E_C = 1 - WNFDMO=.TRUE. !OK - ENDIF - CALL WNFUFC(MCA) !DELINK MCA - CALL WNGFVM(A_J(J1+MCA_SIZE_J),J) !FREE MCA - MCA=0 !RETURN MCA FREE -C - RETURN -C -C - END diff --git a/src/wng/wnfdmo_x.cun b/src/wng/wnfdmo_x.cun deleted file mode 100644 index 4e4274a8bc7ff463ce4c4518289e40523f720f6a..0000000000000000000000000000000000000000 --- a/src/wng/wnfdmo_x.cun +++ /dev/null @@ -1,62 +0,0 @@ -/*+ wnfdmo_x.cun -. WNB 890724 -. -. Revisions: -. WNB 930803 Change to _o_inc and .cun -. CMV 940204 Split off close() for remote tapedrive -... */ -#include "mca_o_inc" -/* -... */ - wnfdmo_x_(mcap) -/* -. Dismount tape for general stream/direct access I/O -. -. Result: -. -. wnfdmo_x_j = wnfdmo_x( MCAP_DES:I) -. -. See WRFDMO.FOR for details -. -. PIN references: -... */ -/* -. Arguments: -... */ - struct mca *mcap; /* MCA ptr */ -{ -/* -. Include files: -... */ -/* -. Parameters: -... */ -/* -. Equivalences: -... */ -/* -. Commons: -... */ -/*- */ -/* -. Function references: -... */ - int wnftrw_(); /* rewind */ - int wnftcl_(); /* rewind */ -/* -. Data declarations: -... */ - int js; -/* Close tape -. */ - js= wnftrw_(mcap); /* rewind tape */ - if ( mcap->bits & MCA_M_ASS) /* assigned */ - { wnftcl_(mcap); /* close tape */ - } -/* Ready -. */ - return(1); /* ok */ -} -/* -. -... */ diff --git a/src/wng/wnfdmo_x.fvx b/src/wng/wnfdmo_x.fvx deleted file mode 100644 index a4dd3b72dde1458cb8514df2ede9fd9ab4a2fc6a..0000000000000000000000000000000000000000 --- a/src/wng/wnfdmo_x.fvx +++ /dev/null @@ -1,76 +0,0 @@ -C+ WNFDMO_X.FVX -C WNB 930804 -C -C Revisions: -C - INTEGER FUNCTION WNFDMO_X(MCAJ) -C -C Dismount tape -C -C -C Result: -C -C WNFDMO_X_J = WNFDMO_X( MCAJ_J(*):I) Dismount tape -C -C Include files: -C - INCLUDE 'WNG_DEF' - INCLUDE '($IODEF)' !I/O CODES - INCLUDE '($DMTDEF)' !DISMOUNT CODES - INCLUDE '($SSDEF)' !ERROR CODES - INCLUDE 'MCA_O_DEF' !MCA -C -C Parameters: -C -C -C Arguments: -C - INTEGER MCAJ(0:*) !MCA BLOCK -C -C Entry points: -C -C -C Function references: -C - INTEGER SYS$DASSGN - INTEGER SYS$DISMOU - INTEGER SYS$DALLOC -C -C Data declarations: -C -C- -C -C INIT -C - WNFDMO_X=SS$_NORMAL !ASSUME OK -C -C DISMOUNT -C - CALL WNFTRW(MCAJ) !REWIND - IF (IAND(MCAJ(MCA_BITS_J),MCA_M_ASS).NE.0) THEN !ASSIGNED - JS=SYS$DASSGN(%VAL(MCAJ(MCA_CHAN_J))) !DEASSIGN - IF (.NOT.JS) THEN !ERROR - IF (WNFDMO_X) WNFDMO_X=JS !NOT YET ERROR - END IF - END IF - IF (IAND(MCAJ(MCA_BITS_J),MCA_M_MOU).NE.0) THEN !MOUNTED - JS=SYS$DISMOU(MCAJ(MCA_UNDES_J),%VAL(DMT$M_NOUNLOAD)) !DISMOUNT - IF (.NOT.JS) THEN !ERROR - IF (WNFDMO_X) WNFDMO_X=JS !NOT YET ERROR - END IF - END IF - IF (IAND(MCAJ(MCA_BITS_J),MCA_M_ALL).NE.0) THEN !ALLOCATED - JS=SYS$DALLOC(MCAJ(MCA_UNDES_J),) !DEALLOCATE - IF (.NOT.JS) THEN !ERROR - IF (WNFDMO_X) WNFDMO_X=JS !NOT YET ERROR - END IF - END IF -C -C READY -C - WNFDMO_X=IAND('0000FFFF'X,WNFDMO_X) !RETURN ERROR -C - RETURN -C -C - END diff --git a/src/wng/wnfeof.for b/src/wng/wnfeof.for deleted file mode 100644 index ee29da7c57ec6b09940d87ada4fd19c1c8791583..0000000000000000000000000000000000000000 --- a/src/wng/wnfeof.for +++ /dev/null @@ -1,138 +0,0 @@ -C+ WNFEOF.FOR -C WNB 900107 -C -C Revisions: -C WNB 920108 Correct tape label returned -C WNB 930811 Get rid of L_ -C HjV 941107 Add code to WNFTLN (0 to 4) -C CMV 950102 No interrecord gap for disk: units -C - INTEGER FUNCTION WNFEOF(FCA) -C -C Get current EOF position -C -C Result: -C WNFEOF_J = WNFEOF( FCA_J:I) -C Get current EOF position of file open in FCA or 0. -C WNFTLB_J = WNFTLB( FCA_J:I) -C Get current tape label open for FCA or 0. -C WNFTLN_R = WNFTLN( FCA_J:I, CODE_J:I) -C Get length of current tape label in CODE or 0. -C 0 = inches -C 1 = bytes -C 2 = Kbytes -C 3 = Mbytes -C 4 = Gbytes -C -C PIN references: -C -C -C Include files: -C - INCLUDE 'WNG_DEF' - INCLUDE 'MCA_O_DEF' !MCA - INCLUDE 'FCA_O_DEF' !FCA -C -C Parameters: -C -C -C Arguments: -C - INTEGER FCA !DYNAMIC FILE AREA - INTEGER CODE !LENGTH CODE -C -C Entry points: -C - INTEGER WNFTLB !CURRENT TAPE LABEL - REAL WNFTLN !CURRENT TAPE LABEL LENGTH -C -C Function references: -C - INTEGER WNFTFC !TEST FCA PRESENT -C -C Data declarations: -C -C -C Equivalences: -C -C -C Commons: -C -C- -C -C WNFEOF -C - WNFEOF=0 !ASSUME ERROR - I0=WNFTFC(FCA) !TYPE OF BLOCK - IF (I0.EQ.0) RETURN !CANNOT DO - J=FCA - IF (I0.LT.0) THEN !TAPE - J1=(J-A_OB)/LB_J !DUMMY ARRAY OFFSET - J=A_J(J1+MCA_FCA_J) !PROPER FCA - IF (J.EQ.0) RETURN !NO TAPE FILE OPEN - END IF - J1=(J-A_OB)/LB_J !DUMMY ARRAY OFFSET - WNFEOF=A_J(J1+FCA_EOF_J) !GET EOF -C - RETURN -C -C WNFTLB -C - ENTRY WNFTLB(FCA) -C - WNFTLB=0 !ASSUME ERROR - I0=WNFTFC(FCA) !TYPE OF BLOCK - IF (I0.GE.0) RETURN !CANNOT DO - J=FCA - J1=(J-A_OB)/LB_J !DUMMY ARRAY OFFSET - IF (A_J(J1+MCA_FCA_J).EQ.0) RETURN !NO TAPE FILE OPEN - WNFTLB=A_J(J1+MCA_MAGF_J) !GET LABEL - IF (IAND(A_J(J1+MCA_BITS_J),MCA_M_UNL).EQ.0) WNFTLB=WNFTLB/3 !LABELED - WNFTLB=WNFTLB+1 !PROPER LABEL -C - RETURN -C -C WNFTLN -C - ENTRY WNFTLN(FCA,CODE) -C - WNFTLN=0.E0 !ASSUME ERROR - I0=WNFTFC(FCA) !TYPE OF BLOCK - IF (I0.GE.0) RETURN !CANNOT DO - J=FCA - J1=(J-A_OB)/LB_J !DUMMY ARRAY OFFSET - J2=A_J(J1+MCA_FCA_J) !PROPER FCA - IF (J2.EQ.0) RETURN !NO TAPE FILE OPEN - J3=(J2-A_OB)/LB_J !DUMMY ARRAY OFFSET - I1=A_J(J3+FCA_MAP_J) !BYTES WRITTEN - I2=A_J(J3+FCA_MAB_J) !BLOCKS WRITTEN - I3=1 !TAPE MARKS - IF (IAND(A_J(J1+MCA_BITS_J),MCA_M_UNL).EQ.0) THEN !LABELED TAPE - I1=I1+320 !HEADERS - I2=I2+4 !BLOCKS - I3=I3+2 !TAPE MARKS - END IF - IF (A_J(J1+MCA_UNDES_J).NE.0) THEN !NOT TRUE TAPE UNIT - R1=0 !NO EXTRA SPACE - ELSE - R1=MCA__IRG/100.E0 !INTERRECORD GAP - R1=(I2*R1)+(I3*(MCA__TML/100.E0)) !EXTRA SPACE - END IF - IF (CODE.EQ.0) THEN - R0=A_J(J1+MCA_DENS_J)*1.E0 !BPI - WNFTLN=(I1/R0)+R1 !IN INCHES - ELSE - WNFTLN=I1+R1*A_J(J1+MCA_DENS_J) !IN BYTES - IF (CODE.EQ.2) THEN - WNFTLN=WNFTLN/1024.E0 !IN KBYTES - ELSE IF (CODE.EQ.3) THEN - WNFTLN=WNFTLN/(1024.E0**2) !IN MBYTES - ELSE IF (CODE.EQ.4) THEN - WNFTLN=WNFTLN/(1024.E0**3) !IN GBYTES - END IF - END IF -C - RETURN -C -C - END diff --git a/src/wng/wnfexh.for b/src/wng/wnfexh.for deleted file mode 100644 index cb9545fbc2eee9923d6edbe2cd363ee614ad87b6..0000000000000000000000000000000000000000 --- a/src/wng/wnfexh.for +++ /dev/null @@ -1,47 +0,0 @@ -C+ WNFEXH.FOR -C WNB 890724 -C -C Revisions: -C - SUBROUTINE WNFEXH -C -C Do exit handler for file system -C -C Result: -C -C CALL WNFEXH Close/dismount all files -C -C PIN references: -C -C -C Include files: -C - INCLUDE 'WNG_DEF' - INCLUDE 'FCQ_DEF' !FCA QUEUE -C -C Parameters: -C -C -C Arguments: -C -C -C Function references: -C -C -C Data declarations: -C -C -C Equivalences: -C -C -C Commons: -C -C- - DO WHILE (FCAQUE.NE.0) !SCAN LIST - CALL WNFDMO(FCAQUE) !CLOSE AND DISMOUNT - END DO -C - RETURN -C -C - END diff --git a/src/wng/wnffnm.for b/src/wng/wnffnm.for deleted file mode 100644 index e62c0fab80dfbcc91061e039bcd2011f1ac02f63..0000000000000000000000000000000000000000 --- a/src/wng/wnffnm.for +++ /dev/null @@ -1,67 +0,0 @@ -C+ WNFFNM.FOR -C WNB 890202 -C -C Revisions: -C WNB 911118 DW DATA statement problems -C WNB 920902 SUN station compiler bug -C - CHARACTER*(*) FUNCTION WNFFNM(PRE,POST) -C -C Get a unique file name -C -C Result: -C -C WNFFNM_C* = WNFFNM ( PRE_C*:I, POST_C*:I) -C Generate a unique file name starting with -C first 3 char. of PRE, and ending in -C .<first 3 char. of POST>. -C The minimum length of WNFFNM is 16, the -C normal length 20. -C Format: PREyymmddhhmmssC.POS with C a letter. -C -C Include files: -C - INCLUDE 'WNG_DEF' -C -C Parameters: -C -C -C Arguments: -C - CHARACTER*(*) PRE !NAME PREFIX - CHARACTER*(*) POST !NAME EXTENSION -C -C Function references: -C - INTEGER WNCALN !STRING LENGTH -C -C Data declarations: -C - CHARACTER*23 FIELD !SYSTEM DATE/TIME - CHARACTER*36 MON !MONTHS - CHARACTER*24 MONN - DATA MON/'JanFebMarAprMayJunJulAugSepOctNovDec'/ - DATA MONN/'010203040506070809101112'/ - CHARACTER*20 LFLD !LOCAL RESULT -C- - CALL WNGSYT(FIELD) !GET DATE/TIME - J=INDEX(MON,FIELD(4:6))/3 !MONTH NUMBER - LFLD='ZZZ' !DUMMY PREFIX - LFLD(1:MIN(WNCALN(PRE),3))=PRE - LFLD=LFLD(1:3)//FIELD(10:11)//MONN(2*J+1:2*J+2)// - 1 FIELD(1:2)//FIELD(13:14)//FIELD(16:17)// - 2 FIELD(19:20)//'@.'// - 3 POST(1:MIN(WNCALN(POST),3)) !GET A NAME - DO WHILE (LFLD(16:16).NE.'Z') - LFLD(16:16)=CHAR(ICHAR(LFLD(16:16))+1) !TRY NEXT - INQUIRE (FILE=LFLD,EXIST=L0,ERR=10) - IF (.NOT.L0) GOTO 20 !READY - 10 CONTINUE - END DO - 20 CONTINUE - WNFFNM=LFLD !RESULT -C - RETURN -C -C - END diff --git a/src/wng/wnfini.for b/src/wng/wnfini.for deleted file mode 100644 index 9eb1c81d7b0f0d39d1949abbfb81ea6b9aacba6a..0000000000000000000000000000000000000000 --- a/src/wng/wnfini.for +++ /dev/null @@ -1,46 +0,0 @@ -C+ WNFINI.FOR -C WNB 890724 -C -C Revisions: -C - SUBROUTINE WNFINI -C -C Initialise File system -C -C Result: -C -C CALL WNFINI Make sure FCA queue and exit handler set -C -C PIN references: -C -C -C Include files: -C - INCLUDE 'WNG_DEF' - INCLUDE 'FCQ_DEF' !FCA QUEUE -C -C Parameters: -C -C -C Arguments: -C -C -C Function references: -C - EXTERNAL WNFEXH !EXIT HANDLER ROUTINE -C -C Data declarations: -C -C -C Equivalences: -C -C -C Commons: -C -C- - IF (FCAEXH(1).EQ.0) CALL WNGSXH(FCAEXH(1),WNFEXH) !INIT EXIT HANDLER -C - RETURN -C -C - END diff --git a/src/wng/wnfio.for b/src/wng/wnfio.for deleted file mode 100644 index cf7ad847f2e13e98f1f724b1cbf18d74829f145c..0000000000000000000000000000000000000000 --- a/src/wng/wnfio.for +++ /dev/null @@ -1,218 +0,0 @@ -C+ WNFIO.FSC -C WNB 890725 -C -C Revisions: -C JPH 930402 C#ERROR, .FSC file. L_J/L_B --> LB_J -C JPH 930405 check write access -C CMV 930708 make proper check on write access -C WNB 930811 Get rid of A_OJ; %VAL -C -C - LOGICAL FUNCTION WNFRD(FCA,LEN,BUF,DISK) -C -C Read/write data from/to disk/tape -C -C Result: -C WNFRD_L = WNFRD( FCA_J:I, LEN_J:I, BUF_B(*), DISK_J:I) -C Read data from file given by FCA starting at disk -C address DISK of length LEN into buffer BUF -C WNFRDS_L = WNFRDS( FCA_J:I, LEN_J:I, BUF_B(*)) -C Read data from file given by FCA starting after last -C read address of length LEN into buffer BUF -C WNFRDA_L = WNFRDA( FCA_J:I, LEN_J:I, ADISK_J:I) -C Read data ahead from file given by FCA starting at disk -C address ADISK of length LEN. -C WNFWR, WNFWRS, WNFWRA identical for write -C -C WNFPUR_L = WNFPUR( FCA_J:I) -C Purge all buffers to disk/tape -C -C PIN references: -C -C -C Include files: -C - INCLUDE 'WNG_DEF' - INCLUDE 'MCA_O_DEF' !MCA - INCLUDE 'FCA_O_DEF' !FCA - INCLUDE 'FBC_O_DEF' !FBC - INCLUDE 'FEL_O_DEF' !FEL -C -C Parameters: -C -C -C Arguments: -C - INTEGER FCA !DYNAMIC FILE AREA POINTER - INTEGER LEN !BUFFER LENGTH - BYTE BUF(*) !DATA BUFFER - INTEGER DISK,ADISK !DISK ADDRESS -C -C Entry points: -C - LOGICAL WNFRDS,WNFRDA - LOGICAL WNFWR,WNFWRS,WNFWRA - LOGICAL WNFPUR -C -C Function references: -C - INTEGER WNFIO_X,WNFPUR_X !ACTUAL I/O - INTEGER WNFTFC !TEST FCA PRESENT - INTEGER WNGARA !GET ADDRESS -C -C Data declarations: -C - INTEGER LLEN,LBUFAD,LDISK,LCOD !LOCAL DATA - INTEGER LFEL(0:FELHDL/4-1) !ELEMENT -C -C Equivalences: -C -C -C Commons: -C -C- - LLEN=LEN !BUFFER LENGTH - LBUFAD=WNGARA(BUF) !BUFFER ADDRESS - LDISK=DISK !DISK POINTER - LCOD=1 !READ - GOTO 11 -C -C WNFRDS -C - ENTRY WNFRDS(FCA,LEN,BUF) -C - LLEN=LEN !BUFFER LENGTH - LBUFAD=WNGARA(BUF) !BUFFER ADDRESS - LDISK=-1 !DISK POINTER - LCOD=1 !READ - GOTO 11 -C -C WNFRDA -C - ENTRY WNFRDA(FCA,LEN,ADISK) -C - LLEN=LEN !BUFFER LENGTH - LBUFAD=0 !BUFFER ADDRESS - LDISK=ADISK !DISK POINTER - LCOD=1 !READ - GOTO 11 -C -C WNFWR -C - ENTRY WNFWR(FCA,LEN,BUF,DISK) -C - LLEN=LEN !BUFFER LENGTH - LBUFAD=WNGARA(BUF) !BUFFER ADDRESS - LDISK=DISK !DISK POINTER - LCOD=0 !WRITE - GOTO 10 -C -C WNFWRS -C - ENTRY WNFWRS(FCA,LEN,BUF) -C - LLEN=LEN !BUFFER LENGTH - LBUFAD=WNGARA(BUF) !BUFFER ADDRESS - LDISK=-1 !DISK POINTER - LCOD=0 !WRITE - GOTO 10 -C -C WNFWRA -C - ENTRY WNFWRA(FCA,LEN,ADISK) -C - LLEN=LEN !BUFFER LENGTH - LBUFAD=0 !BUFFER ADDRESS - LDISK=ADISK !DISK POINTER - LCOD=0 !WRITE - GOTO 10 -C -C test write access -C -10 CONTINUE -C -C If tape: find FPA and check, else check FPA directly -C - I0=WNFTFC(FCA) !TYPE OF BLOCK - J1=FCA - IF (I0.LT.0) THEN !TAPE - J=(J1-A_OB)/(LB_J) !DUMMY ARRAY OFFSET - J1=A_J(J+MCA_FCA_J) !PROPER FCA - IF (J1.EQ.0) THEN !NO FILE OPEN ON MCA -C#ERROR 'no file open on MCA' - RETURN - ENDIF - END IF - J= A_J((J1-A_OB)/LB_J+FCA_BITS_J) - IF (IAND (J, FCA_M_WRITE) .EQ.0 ) THEN -C#ERRORX 'write to read-only fca', FCA - WNFRD=.FALSE. - RETURN - ENDIF - -C -C DO READ/WRITE -C - 11 CONTINUE -C -C TEST FCA -C - WNFRD=.FALSE. !ASSUME ERROR - I0=WNFTFC(FCA) !TYPE OF BLOCK - IF (I0.EQ.0) THEN !ILLEGAL FCA -C#ERROR 'illegal FCA' - RETURN - ENDIF - J=FCA - IF (I0.LT.0) THEN !TAPE - J1=(J-A_OB)/(LB_J) !DUMMY ARRAY OFFSET - J=A_J(J1+MCA_FCA_J) !PROPER FCA - IF (J.EQ.0) THEN !NO FILE OPEN ON MCA -C#ERROR 'no file open on MCA' - RETURN - ENDIF - END IF -C -C SET DATA -C - LFEL(FEL_BITS_J)=LCOD !SET READ/WRITE - LFEL(FEL_BUFAD_J)=LBUFAD !BUFFER - LFEL(FEL_BUFLEN_J)=LLEN !LENGTH - LFEL(FEL_DKAD_J)=LDISK !DISK ADDRES - E_C=WNFIO_X(A_B(J-A_OB),LFEL) !DO I/O - IF (IAND(E_C,1).EQ.1) THEN - WNFRD=.TRUE. - ELSE -C#ERRORJ 'error from WNFIO_X', E_C - ENDIF -C - RETURN -C -C WNFPUR -C - ENTRY WNFPUR(FCA) -C - WNFPUR=.FALSE. !ASSUME ERROR - I0=WNFTFC(FCA) !TYPE OF BLOCK - IF (I0.EQ.0) THEN !ILLEGAL FCA -C#ERROR 'illegal FCA' - RETURN - ENDIF - J=FCA - IF (I0.LT.0) THEN !TAPE - J1=(J-A_OB)/(LB_J) !DUMMY ARRAY OFFSET - J=A_J(J1+MCA_FCA_J) !PROPER FCA - IF (J.EQ.0) THEN !NO FILE OPEN ON MCA -C#ERROR 'no file open on MCA' - RETURN - ENDIF - END IF - E_C=WNFPUR_X(A_B(J-A_OB)) !PURGE - IF (IAND(E_C,1).EQ.1) THEN - WNFPUR=.TRUE. - ELSE -C#ERRORJ 'error from WNFPUR_X', E_C - ENDIF -C -C - END diff --git a/src/wng/wnfio_x.cun b/src/wng/wnfio_x.cun deleted file mode 100644 index 5b560b942f8acf48586b3039ce8a381b89beb4fa..0000000000000000000000000000000000000000 --- a/src/wng/wnfio_x.cun +++ /dev/null @@ -1,653 +0,0 @@ -/*+ wnfio_x.cun -. WNB 900107 -. -. Revisions: -. JPH 930414 FCA_M_WRT --> FCA_M_WRTAPE -. WNB 930803 Change to _o_inc and .cun -. CMV 931011 Changed declaration wnf_rwahead to int (was long) -. CMV 940202 Local implementation of rem/insque for HP -. CMV 940204 Split off write() and read() for remote tapedrive -. CMV 941904 Return hard EOF if no data on tapefile -. CMV 940926 Changed comments -. CMV 941028 Never do lseek on tapes -... */ -#include <sys/types.h> - -#include "fca_o_inc" -#include "mca_o_inc" -#include "fel_o_inc" -#include "fbc_o_inc" -#define SS__ILLIOFUNC 0x000000f4 -#define SS__NORMAL 0x00000001 -#define SS__ENDOFFILE 0x00000870 -#define SS__IVADDR 0x00000134 - -/* - On DEC-Alpha we need to address things via the A_B(P - A_OB) construct, - since 8 byte addresses have been clipped to 4 bytes. - - Also, we have to do the linked list handling ourselves. - - Since this is interim anyhow, we just define LB_J here and work around - the address problem. -*/ - -#ifdef wn_da__ - -#define ADR(p) ( (char *)&(p) + ( (p) - (int)&(p) ) ) - -#define remque(p) loc_remque(p) -#define insque(p,q) loc_insque(p,q) - -static int loc_remque(p) - -int *p; - -{ - *( (int *)ADR( *(p+1) ) ) = ( *p ); /* Previous points to next */ - *( (int *)ADR( *p ) + 1 ) = ( *(p+1) ); /* Next points to previous */ -} - -static int loc_insque(p,q) - -int *p,*q; - -{ - *(p) = (*q); /* p points to (next from q) */ - *(p+1) = (int)(q); /* p points back to q */ - *(q) = (int)(p); /* q points forward to p */ - *((int *)ADR(*p)+1) = (int)(p); /* (next from q) points back to p */ -} - -#else - -#define ADR(p) ( p ) - -#ifdef wn_hp__ -#define remque(p) loc_remque(p) -#define insque(p,q) loc_insque(p,q) - -static int loc_remque(p) - -int *p; - -{ - *( (int *)ADR( *(p+1) ) ) = ( *p ); /* Previous points to next */ - *( (int *)ADR( *p ) + 1 ) = ( *(p+1) ); /* Next points to previous */ -} - -static int loc_insque(p,q) - -int *p,*q; - -{ - *(p) = (*q); /* p points to (next from q) */ - *(p+1) = (int)(q); /* p points back to q */ - *(q) = (int)(p); /* q points forward to p */ - *((int *)ADR(*p)+1) = (int)(p); /* (next from q) points back to p */ -} -#endif - -#endif - -/* -... */ - int wnfio_x_(fcap,felp) -/* -. Do disk/tape I/O -. -. Result: -. -. wnfio_x_j = wnfio_x( FCA_J:I, FEL_J:I) -. wnfpur_x_j= wnfpur_x( FCA_J:I) -. wnf_rwahead_j= wnf_rwahead( FCA_J:I, FEL_J:I) -. -. See WNFIO.FOR for details -. -. PIN references: -... */ -/* -. Arguments: -... */ - struct fca *fcap; /* FCA ptr */ - struct fel *felp; /* FEL ptr */ -{ -/* -. Include files: -... */ -#include <sys/file.h> -#include <errno.h> -#include <ctype.h> -extern int errno ; -/* -. Parameters: -... */ -/* -. Equivalences: -... */ -/* -. Commons: -... */ -/*- */ -/* -. Function references: -... */ - int wnf_rwahead(); /* read/write ahead */ - /* Was: long, changed CMV 931011 */ -/* -. Data declarations: -... */ - struct fbc *cfbcp; /* buffer queue elem. */ - struct fel cfel; /* local element */ - struct mca *cmcap; /* mca pointer */ - char *p1; /* for calculation */ - int j; - int j1; - int j2; - int js; -/* Check read/write -. */ - if (fcap->bits & FCA_M_MAG) /* tape */ - { if (((felp->bits & 1) && (fcap->bits & FCA_M_WRTAPE)) || - (!(felp->bits & 1) && !(fcap->bits & FCA_M_WRTAPE))) - return(SS__ILLIOFUNC); /* no tape read/write */ - } -/* Check disk address -. */ - j= felp->dkad; /* disk address */ - if (j == -1) /* contiguous */ - { if (felp->bits & 1) /* read */ - j= fcap->rad; - else /* write */ - j= fcap->eof; - } -/* Distribute type -. */ - if (felp->bufad == 0) /* read/write ahead */ - return(wnf_rwahead(fcap,felp)); - fcap->err = SS__NORMAL; /* assume ok */ - fcap->dad = j; /* start disk address */ - fcap->bad = felp->bufad; /* buffer address */ - fcap->aclen = 0; /* nothing read/written */ - fcap->len = felp->buflen; /* length to do */ -/* Read -. */ -lc: if (felp->bits & 1) /* read */ - { if ((fcap->eof > 0) && - (fcap->dad + fcap->len > fcap->eof)) /* too much */ - { fcap->len = fcap->eof - fcap->dad; /* correct length */ - fcap->aclen |= 0x80000000; /* embedded EOF */ - } - if (fcap->len <= 0) goto rfini; /* ready */ - cfbcp= (struct fbc *)ADR(fcap->bqa[0]); /* buffer head */ - while (cfbcp != &(fcap->bqa[0])) /* search buffer list */ - { if (fcap->dad < cfbcp->disk) goto la; /* not in core */ - if (fcap->dad < cfbcp->disknd) /* partly in core */ - { j1= cfbcp->disknd - fcap->dad; /* to do */ - if (fcap->len < j1) j1= fcap->len; - j2= fcap->dad - cfbcp->disk; /* start in buffer */ - bcopy(ADR(cfbcp->addr)+j2, ADR(fcap->bad), j1); /* move data */ - if (!(fcap->bits & FCA_M_MAG)) /* leave order for tape */ - { remque(&(cfbcp->bqt[0])); /* reorder time */ - insque(&(cfbcp->bqt[0]), &(fcap->bqt[0])); - } - fcap->dad += j1; /* next disk address */ - fcap->rad = fcap->dad; /* last read address */ - fcap->bad += j1; /* next buffer address */ - fcap->aclen += j1; /* actually read */ - fcap->len -= j1; /* still to read */ - if (fcap->len <= 0) goto rfini; /* no more */ - if (fcap->bits & FCA_M_MAG) /* tape */ - { cmcap= (struct mca *)ADR(fcap->mca); - if (cmcap->bits & MCA_M_BLK) - goto rfini; /* ready for block mode */ - } - } - cfbcp= (struct fbc *)ADR(cfbcp->bqa[0]); /* try next element */ - } -/* Read in data -. */ -la: cfel.dkad= fcap->dad; /* fill elemenent */ - cfel.bufad=0; - cfel.buflen= fcap->len; - if (fcap->bits & FCA_M_MAG) /* tape */ - { cfel.buflen = 1; /* one tape block limit */ - } - else - { j1= 2*fcap->blen; /* limit infinite loop */ - if (j1 < cfel.buflen) cfel.buflen = j1; - } - cfel.bits=1; /* read */ - wnf_rwahead(fcap,&cfel); /* read ahead */ - if (fcap->err & 1) goto lc; /* retry */ -/* Finish read -. */ -rfini: j1= fcap->err; - if (j1 & 1) /* no error */ - if (fcap->aclen & 0x80000000) /* embedded EOF */ - j1= SS__ENDOFFILE; - fcap->aclen &= ~0x80000000; /* clear embedded EOF */ - return(j1); /* ready */ - } -/* Write -. */ - else - { if (fcap->len <= 0) goto wfini; /* ready */ - cfbcp= (struct fbc *)ADR(fcap->bqa[0]); /* buffer head */ - while (cfbcp != &(fcap->bqa[0])) /* search buffer list */ - { if (fcap->dad < cfbcp->disk) goto lb; /* not in core */ - if (fcap->dad < cfbcp->disknd) /* partly in core */ - { j1= cfbcp->disknd - fcap->dad; /* to do */ - if (fcap->len < j1) j1= fcap->len; - j2= fcap->dad - cfbcp->disk; /* start in buffer */ - bcopy(ADR(fcap->bad), ADR(cfbcp->addr) + j2, j1); /* move data */ - cfbcp->bits |= FBC_M_WRITE; /* indicate rewrite */ - if (!(fcap->bits & FCA_M_MAG)) /* leave order for tape */ - { remque(&(cfbcp->bqt[0])); /* reorder time */ - insque(&(cfbcp->bqt[0]), &(fcap->bqt[0])); - } - fcap->dad += j1; /* next disk address */ - fcap->bad += j1; /* next buffer address */ - fcap->aclen += j1; /* actually written */ - fcap->len -= j1; /* still to write */ - if (fcap->dad > fcap->eof) /* new EOF */ - fcap->eof= fcap->dad; - if (fcap->len <= 0) goto wfini; /* no more */ - } - cfbcp= (struct fbc *)ADR(cfbcp->bqa[0]); /* try next element*/ - } -/* Write out data -. */ -lb: cfel.dkad= fcap->dad; /* fill element */ - cfel.bufad=0; - cfel.buflen= fcap->len; - if (fcap->bits & FCA_M_MAG) /* tape */ - { cfel.buflen = 1; /* one tape block limit */ - } - else - { j1= 2*fcap->blen; /* limit infinite loop */ - if (j1 < cfel.buflen) cfel.buflen = j1; - } - cfel.bits=0; /* write */ - wnf_rwahead(fcap,&cfel); /* write ahead */ - if (fcap->err & 1) goto lc; /* retry */ -/* Finish write -. */ -wfini: j1= fcap->err; - return(j1); /* ready */ - } -} -/* -......................................................................... -. Read ahead -........................................................................ -. */ -/* -. */ - int wnf_rwahead(fcap,felp) -/* -. Do disk/tape I/O -. -. Result: -. -. See WNFIO.FOR for details -. -. PIN references: -... */ -/* -. Arguments: -... */ - struct fca *fcap; /* FCA ptr */ - struct fel *felp; /* FEL ptr */ -{ -/* -. Include files: -... */ -#include <sys/file.h> -#include <errno.h> -#include <ctype.h> -extern int errno ; -/* -. Parameters: -... */ -/* -. Equivalences: -... */ -/* -. Commons: -... */ -/*- */ -/* -. Function references: -... */ - int wnftsf_(); /* skip tape marks */ - int wnftrb_(); /* read data */ - int wnftwb_(); /* write data */ -/* -. Data declarations: -... */ - struct fbc *cfbcp; /* buffer queue elem. */ - struct fbc *tfbcp; /* buffer queue elem. */ - struct fel cfel; /* local element */ - struct mca *cmcap; /* mca pointer */ - char *p1; /* for calculation */ - int j; - int j1; - int j2; - int js; - off_t pos; -/* Make element -. */ - cfel.dkad= felp->dkad; /* disk address */ - cfel.bufad=0; /* no read/write */ - cfel.bits= felp->bits; /* read/write */ - cfel.buflen= felp->buflen; /* length to do */ - fcap->err = SS__NORMAL; /* no error */ -/* Read -. */ - if (fcap->bits & FCA_M_MAG) - cmcap= (struct mca *)ADR(fcap->mca); /* Get MCA for tapes */ - -lk: if (cfel.bits & 1) /* read */ - { if ((fcap->eof > 0) && - (cfel.dkad + cfel.buflen > fcap->eof)) /* too much */ - { cfel.buflen= fcap->eof - cfel.dkad; /* correct length */ - } - if (cfel.buflen <= 0) goto rfini; /* ready */ - cfbcp= (struct fbc *)ADR(fcap->bqa[0]); /* buffer head */ - while (cfbcp != &(fcap->bqa[0])) /* search buffer list */ - { if (cfel.dkad < cfbcp->disk) goto la; /* not in core */ - if (cfel.dkad < cfbcp->disknd) /* partly in core */ - { j1= cfbcp->disknd - cfel.dkad; /* to do */ - cfel.dkad += j1; /* next disk address */ - cfel.buflen -= j1; /* still to read */ - if (cfel.buflen <= 0) goto rfini; /* no more */ - if (fcap->bits & FCA_M_MAG) /* tape */ - { if (cmcap->bits & MCA_M_BLK) - goto rfini; /* ready for block mode */ - } - } - cfbcp= (struct fbc *)ADR(cfbcp->bqa[0]); /* try next element*/ - } -/* Read in data -. */ -la: cfbcp= (struct fbc *)ADR(fcap->bqt[1]); /* oldest entry */ - remque(cfbcp); /* make newest */ - insque(cfbcp,&(fcap->bqt[0])); - p1=cfbcp; /* make correct address */ - p1=p1-8; /****** GAAT DIT GOED ??? ******/ - cfbcp=p1; - if (cfbcp->bits & FBC_M_WRITE) /* rewrite */ - { cfbcp->bits &= ~FBC_M_WRITE; /* reset rewrite */ - if (!(fcap->bits & FCA_M_MAG)) /* disk */ - { pos=lseek(fcap->chan,(off_t)cfbcp->disk,0); /* position file */ - if (pos == -1) /* error */ - { fcap->err= 2*errno; - goto rfini; - } - }; - j1= fcap->blen; /* length to write */ - if (cfbcp->disknd > fcap->eof) /* not full buffer */ - j1= fcap->eof - cfbcp->disk; - if (fcap->bits & FCA_M_MAG) - js= wnftwb_(cmcap,ADR(cfbcp->addr),j1); - else js= write(fcap->chan,ADR(cfbcp->addr),j1); /* rewrite */ - if (js == -1) /* error */ - { fcap->err= 2*errno; - goto rfini; - } - } - if (!(fcap->bits & FCA_M_MAG)) /* disk */ - { cfbcp->disk= (cfel.dkad / fcap->blen) * fcap->blen; /* whole*/ - } - else /* tape */ - { if ( cfel.dkad >= fcap->map) /* can read forward */ - { cfbcp->disk= fcap->map; /* read contiguous */ - } - else /* no read back */ - { fcap->err= SS__IVADDR; - goto rfini; - } - } - cfbcp->disknd= cfbcp->disk + fcap->blen; /* disk end */ - remque(cfbcp); /* remove from add. que.*/ - tfbcp= (struct fbc *)ADR(fcap->bqa[0]); /* buffer head */ - while (tfbcp != &(fcap->bqa[0])) /* set correct pos. */ - { if (cfbcp->disk < tfbcp->disk) - goto le; /* here */ - tfbcp= (struct fbc *)ADR(tfbcp->bqa[0]); /* next */ - } -le: insque(cfbcp,(int *)ADR(tfbcp->bqa[1])); /* insert correct place */ - if (!(fcap->bits & FCA_M_MAG)) /* disk */ - { pos=lseek(fcap->chan,(off_t)cfbcp->disk,0); /* position file */ - if (pos == -1) /* error */ - { fcap->err= 2*errno; - goto rfini; - } - }; - if (fcap->bits & FCA_M_MAG) - js= wnftrb_(cmcap,ADR(cfbcp->addr),fcap->blen); - else js= read(fcap->chan,ADR(cfbcp->addr),fcap->blen); /* read buf */ - if (js == -1) /* error */ - { fcap->err= 2*errno; - goto rfini; - } - if (fcap->bits & FCA_M_MAG) /* tape */ - { fcap->map += js; /* set current tape pos */ - fcap->mab += 1; - cfbcp->disknd= cfbcp->disk + js; /* buffer end */ - if (js == 0 && fcap->map == 0) /* no data on file */ - { fcap->err = SS__ENDOFFILE; /* hard end of file */ - goto rfini; - } - if (js == 0) /* EOF seen */ - { fcap->eof = fcap->map; /* set EOF pos. */ - wnftsf_(cmcap,-1); /* skip back */ - fcap->mab -= 1; - } - } - goto lk; /* more */ -/* Finish read -. */ -rfini: j1= fcap->err; - return(j1); /* ready */ - } -/* Write -. */ - else - { cfbcp= (struct fbc *)ADR(fcap->bqa[0]); /* buffer head */ - while (cfbcp != &(fcap->bqa[0])) /* search buffer list */ - { if (cfel.dkad < cfbcp->disk) - { if (fcap->bits & FCA_M_MAG) /* tape cannot random */ - { fcap->err= SS__IVADDR; - goto wfini; - } - goto lb; /* not in core */ - } - if (cfel.dkad < cfbcp->disknd) /* partly in core */ - { j1= cfbcp->disknd - cfel.dkad; /* to do */ - cfel.dkad += j1; /* next disk address */ - cfel.buflen -= j1; /* still to write */ - if (cfel.buflen <= 0) goto wfini; /* no more */ - } - cfbcp= (struct fbc *)ADR(cfbcp->bqa[0]); /* try next element*/ - } -/* Write out data -. */ -lb: cfbcp= (struct fbc *)ADR(fcap->bqt[1]); /* oldest entry */ - remque(cfbcp); /* make newest */ - insque(cfbcp,&(fcap->bqt[0])); - p1=cfbcp; /* make correct address */ - p1=p1-8; /***** Gaat dit goed *****/ - cfbcp=p1; - if (cfbcp->bits & FBC_M_WRITE) /* rewrite */ - { cfbcp->bits &= ~FBC_M_WRITE; /* reset rewrite */ - if (!(fcap->bits & FCA_M_MAG)) /* disk */ - { pos=lseek(fcap->chan,(off_t)cfbcp->disk,0); /* goto disk address */ - if (pos == -1) /* error */ - { fcap->err= 2*errno; - goto wfini; - } - }; - j1= fcap->blen; /* length to write */ - if (cfbcp->disknd > fcap->eof) /* not full buffer */ - j1= fcap->eof - cfbcp->disk; - if (fcap->bits & FCA_M_MAG) - js= wnftwb_(cmcap,ADR(cfbcp->addr),j1); - else js= write(fcap->chan,ADR(cfbcp->addr),j1); /* rewrite */ - if (js == -1) /* error */ - { fcap->err= 2*errno; - goto wfini; - } - if (fcap->bits & FCA_M_MAG) /* tape position */ - { fcap->map += js; - fcap->mab += 1; - } - } - j1= cfel.dkad; - if (fcap->bits & FCA_M_MAG) /* tape */ - { j1= fcap->maw; /* contiguous */ - fcap->maw += fcap->blen; - cfbcp->bits |= FBC_M_WRITE; /* always rewrite */ - } - cfbcp->disk= (j1 / fcap->blen) * fcap->blen; /* whole bufs */ - cfbcp->disknd= cfbcp->disk + fcap->blen; /* disk end */ - remque(cfbcp); /* remove from add. que.*/ - tfbcp= (struct fbc *)ADR(fcap->bqa[0]); /* buffer head */ - while (tfbcp != &(fcap->bqa[0])) /* set correct pos. */ - { if (cfbcp->disk < tfbcp->disk) - goto lf; /* here */ - tfbcp= (struct fbc *)ADR(tfbcp->bqa[0]); /* next */ - } -lf: insque(cfbcp,(int *)ADR(tfbcp->bqa[1])); /* insert correct place */ - if ((cfbcp->disk >= fcap->eof) || - (fcap->bits & FCA_M_MAG)) /* no read */ - { bzero(ADR(cfbcp->addr),fcap->blen); /* zero buf */ - goto lk; /* retry */ - } - if ((cfel.dkad == cfbcp->disk) && - (cfel.buflen >= fcap->blen)) /* full buffer */ - { bzero(ADR(cfbcp->addr),fcap->blen); /* zero buf */ - goto lk; /* retry */ - } - if (!(fcap->bits & FCA_M_MAG)) /* disk */ - { pos=lseek(fcap->chan,(off_t)cfbcp->disk,0); /* position file */ - if (pos == -1) /* error */ - { fcap->err= 2*errno; - goto wfini; - } - }; - if (fcap->bits & FCA_M_MAG) - js= wnftrb_(cmcap,ADR(cfbcp->addr),fcap->blen); - else js= read(fcap->chan,ADR(cfbcp->addr),fcap->blen); /* read buf */ - if (js == -1) /* error */ - { fcap->err= 2*errno; - goto wfini; - } - if (cfel.dkad > fcap->eof) /* new EOF */ - fcap->eof = cfel.dkad; - goto lk; /* more */ -/* Finish write -. */ -wfini: j1= fcap->err; - return(j1); /* ready */ - } -} -/* -......................................................................... -. Purge buffers -......................................................................... -. */ -/* -... */ - int wnfpur_x_(fcap) -/* -. Purge buffers -. -. Result: -. -. See WNFIO.FOR for details -. -. PIN references: -... */ -/* -. Arguments: -... */ - struct fca *fcap; /* FCA ptr */ -{ -/* -. Include files: -... */ -#include <sys/file.h> -#include <errno.h> -#include <ctype.h> -extern int errno ; -/* -. Parameters: -... */ -/* -. Equivalences: -... */ -/* -. Commons: -... */ -/*- */ -/* -. Function references: -... */ - int wnftwb_(); /* write data */ -/* -. Data declarations: -... */ - struct fbc *cfbcp; /* buffer queue elem. */ - struct mca *cmcap; /* mca pointer */ - char *p1; /* for calculation */ - int j; - int j1; - int j2; - int js; - off_t pos; -/* Purge -. */ - fcap->err= SS__NORMAL; /* no error */ - cfbcp= (struct fbc *)ADR(fcap->bqa[0]); /* buffer head */ - while (cfbcp != &(fcap->bqa[0])) /* search buffer list */ - { if (cfbcp->bits & FBC_M_WRITE) /* rewrite */ - { if (!(fcap->bits & FCA_M_MAG)) /* disk */ - { pos=lseek(fcap->chan,(off_t)cfbcp->disk,0); /* goto disk address */ - if (pos == -1) /* error */ - { fcap->err= 2*errno; - goto la; - } - }; - j1= fcap->blen; /* length to write */ - if (cfbcp->disknd > fcap->eof) /* not full buffer */ - j1= fcap->eof - cfbcp->disk; - if (fcap->bits & FCA_M_MAG) { - cmcap= (struct mca *)ADR(fcap->mca); - js= wnftwb_(cmcap,ADR(cfbcp->addr),j1); - } else { - js= write(fcap->chan,ADR(cfbcp->addr),j1); /* rewrite */ - } - if (js == -1) /* error */ - { fcap->err= 2*errno; - goto la; - } - if (fcap->bits & FCA_M_MAG) /* tape position */ - { fcap->map += js; - fcap->mab += 1; - } - } -la: cfbcp->disk = 0; /* set empty */ - cfbcp->disknd= 0; - cfbcp->bits = 0; - cfbcp= (struct fbc *)ADR(cfbcp->bqa[0]); /* try next element */ - } -/* Ready -. */ - j1= fcap->err; - return(j1); /* ready */ -} -/* -. -... */ diff --git a/src/wng/wnfio_x.fvx b/src/wng/wnfio_x.fvx deleted file mode 100644 index 8514788150494c3155c0880f15f2712cadf16324..0000000000000000000000000000000000000000 --- a/src/wng/wnfio_x.fvx +++ /dev/null @@ -1,875 +0,0 @@ -C+ WNFIO_X.FVX -C WNB 930804 -C -C Revisions: -C WNB 930824 Change EOF/HIBLK test to cater for -1; embedded EOF -C HjV 930824 Change EOF/HIBLK test (use .GE.0 iso. .GT.0) -C Change arguments for ISHFT-function -C WNB 930825 Change another HIBLK test; wrong label -C CMV 930827 Cater for unsigned integer values in WNF_EOF -C HjV 930830 Change variables in loop for READ -C WNB 931006 Typo -C - INTEGER FUNCTION WNFIO_X(FCAJ,FELJ) -C -C Do basic disk/tape I/O -C -C -C Result: -C -C WNFIO_X_J = WNFIO_X( FCAJ_J(0:*):I, FELJ_J(*):I) -C Start a read/write as described in element -C WNFPUR_X_J= WNFPUR_X(FCAJ_J(0:*):I) -C Purge all buffers -C CALL WNF_EOF( FCAJ_J(0:*):I) Convert EOF to VMS style -C -C Include files: -C - INCLUDE 'WNG_DEF' - INCLUDE '($SSDEF)' !ERROR CODES - INCLUDE 'FCA_O_DEF' !FCA - INCLUDE 'MCA_O_DEF' !MCA - INCLUDE 'FEL_O.DEF' !FEL - INCLUDE 'FBC_O_DEF' !FBC -C -C Entry points: -C - INTEGER WNFPUR_X -C -C Parameters: -C -C -C Arguments: -C - INTEGER FCAJ(0:*) !FCA BLOCK - INTEGER FELJ(0:*) !I/O REQUEST ELEMENT -C -C Function references: -C - INTEGER SYS$WAITFR - LOGICAL WNGSQI,WNGSQR !INSERT/REMOVE QUEUE - INTEGER WNF_RWAHEAD !READ/WRITE AHEAD - INTEGER WNF_INWRITEW !WRITE SOME -C -C Data declarations: -C - INTEGER ECOD !LOCAL ERROR CODE - INTEGER LFELJ(0:FEL__L-1) !FEL -C- -C -C INIT -C - ECOD=SS$_NORMAL !ASSUME OK -C -C CHECK READ/WRITE -C - IF (IAND(FCAJ(FCA_BITS_J),FCA_M_MAG).NE.0) THEN !TAPE - IF (FELJ(FEL_BITS_J)) THEN !READ - IF (IAND(FCAJ(FCA_BITS_J),FCA_M_WRTAPE).NE.0) THEN !NOT ALLOWED - ECOD=SS$_ILLIOFUNC - GOTO 900 - END IF - ELSE !WRITE - IF (IAND(FCAJ(FCA_BITS_J),FCA_M_WRTAPE).EQ.0) THEN !NOT ALLOWED - ECOD=SS$_ILLIOFUNC - GOTO 900 - END IF - END IF - END IF -C -C CHECK DISK ADDRESS -C - J=FELJ(FEL_DKAD_J) !DISK ADDRESS - IF (J.EQ.-1) THEN !SEQUENTIAL - IF (FELJ(FEL_BITS_J)) THEN !READ - J=FCAJ(FCA_RAD_J) - ELSE !WRITE - J=FCAJ(FCA_EOF_J) - END IF - END IF -C -C DISTRIBUTE TYPE -C - IF (FELJ(FEL_BUFAD_J).EQ.0) THEN !READ/WRITE AHEAD/AFTER - ECOD=WNF_RWAHEAD(FCAJ,J,FELJ) - GOTO 900 - END IF - IF (IAND(FCAJ(FCA_BITS_J),FCA_M_ACT).NE.0) THEN !SOME ACTIVE - ECOD=SYS$WAITFR(%VAL(FCAJ(FCA_EF_J))) !AWAIT IO - IF (.NOT.ECOD) THEN - FCAJ(FCA_ERR_J)=ECOD - GOTO 800 - END IF - END IF - FCAJ(FCA_ERR_J)=SS$_NORMAL !NO ERROR - FCAJ(FCA_DAD_J)=J !START DISK ADDRESS - FCAJ(FCA_BAD_J)=FELJ(FEL_BUFAD_J) !BUFFER ADDRESS - FCAJ(FCA_ACLEN_J)=0 !LENGTH READ/WRITTEN - FCAJ(FCA_LEN_J)=FELJ(FEL_BUFLEN_J) !LENGTH TO READ/WRITE -C -C READ/WRITE -C - IF (FELJ(FEL_BITS_J)) THEN !READ - 10 CONTINUE - J2=FCAJ(FCA_DAD_J)+FCAJ(FCA_LEN_J) !LAST ADDRESS - IF (FCAJ(FCA_EOF_J).GE.0 .AND. - 1 J2.GT.FCAJ(FCA_EOF_J)) THEN !BEYOND EOF - FCAJ(FCA_ACLEN_J)=IOR(FCAJ(FCA_ACLEN_J),'80000000'X) !EMBEDDED EOF - FCAJ(FCA_LEN_J)=FCAJ(FCA_EOF_J)-FCAJ(FCA_DAD_J) !PROPER LENGTH - END IF - IF (FCAJ(FCA_LEN_J).LE.0) GOTO 800 !READY - J0=(%LOC(FCAJ)+FCA_BQA_1-A_OB)/LB_J !BUF HEAD PTR - J=(A_J(J0)-A_OB)/LB_J !FIRST BUF - DO WHILE (J.NE.J0) !SCAN BUFFERS - IF (FCAJ(FCA_DAD_J).LT. - 1 A_J(J+FBC_DISK_J-FBC_BQA_J)) THEN !NOT IN CORE - GOTO 13 - ELSE IF (FCAJ(FCA_DAD_J).LT. - 1 A_J(J+FBC_DISKND_J-FBC_BQA_J)) THEN !THIS BUF - J=J-FBC_BQA_J !CORRECT POINTER - J2=MIN(A_J(J+FBC_DISKND_J)- - 1 FCAJ(FCA_DAD_J),FCAJ(FCA_LEN_J)) !LENGTH TO DO - J3=FCAJ(FCA_DAD_J)-A_J(J+FBC_DISK_J) !OFFSET START BUF - CALL WNGMV(J2,%VAL(A_J(J+FBC_ADDR_J)+J3), - 1 %VAL(FCAJ(FCA_BAD_J))) !MOVE DATA - IF (IAND(FCAJ(FCA_BITS_J),FCA_M_MAG).EQ.0) THEN !DISK - JS=WNGSQR(%VAL(A_J(J+FBC_BQT_J)),J3) !SET TIME ORDER - JS=WNGSQI(%VAL(J3),%VAL(FCAJ(FCA_BQT_J))) - END IF - FCAJ(FCA_DAD_J)=FCAJ(FCA_DAD_J)+J2 !NEXT DISK ADDRESS - FCAJ(FCA_RAD_J)=FCAJ(FCA_DAD_J) !LAST ADDRESS READ - FCAJ(FCA_BAD_J)=FCAJ(FCA_BAD_J)+J2 !NEXT BUF ADDRESS - FCAJ(FCA_ACLEN_J)=FCAJ(FCA_ACLEN_J)+J2 !LENGTH READ - FCAJ(FCA_LEN_J)=FCAJ(FCA_LEN_J)-J2 !LENGTH STILL TO DO - IF (FCAJ(FCA_LEN_J).LE.0) GOTO 800 !READY - IF (IAND(FCAJ(FCA_BITS_J),FCA_M_MAG).NE.0) THEN !TAPE - J2=FCAJ(FCA_MCA_J) !MCA - IF (IAND(A_J((J2-A_OB)/LB_J+MCA_BITS_J),MCA_M_BLK).NE.0) - 1 GOTO 800 !BLOCK MODE; READY - END IF - END IF !MAYBE IN CORE - J=(A_J(J)-A_OB)/LB_J !NEXT BCB - END DO !END BUFFERS -C -C READ IN DATA -C - 13 CONTINUE - LFELJ(FEL_DKAD_J)=FCAJ(FCA_DAD_J) !MAKE AN ELEMENT - LFELJ(FEL_BUFAD_J)=0 !READ AHEAD - IF (IAND(FCAJ(FCA_BITS_J),FCA_M_MAG).NE.0) THEN !TAPE - LFELJ(FEL_BUFLEN_J)=1 !LIMIT TAPE TO 1 BLOCK - ELSE !DISK - LFELJ(FEL_BUFLEN_J)=MIN(FCAJ(FCA_LEN_J), - 1 FCAJ(FCA_BLEN_J)*2) !LIMIT INFINITE LOOP - END IF - LFELJ(FEL_BITS_J)=1 !READ - ECOD=WNF_RWAHEAD(FCAJ,LFELJ(FEL_DKAD_J),LFELJ) !READ AHEAD - IF (ECOD) THEN !STARTED - IF (IAND(FCAJ(FCA_BITS_J),FCA_M_ACT).NE.0) THEN !ACTIVE - ECOD=SYS$WAITFR(%VAL(FCAJ(FCA_EF_J))) !WAIT - IF (.NOT.ECOD) FCAJ(FCA_ERR_J)=ECOD !SAVE ERROR - END IF - ELSE - FCAJ(FCA_ERR_J)=ECOD !SAVE ERROR - END IF - IF (.NOT.FCAJ(FCA_ERR_J)) GOTO 800 !READY - GOTO 10 !MORE -C -C WRITE -C - ELSE !WRITE - 21 CONTINUE - J2=FCAJ(FCA_DAD_J)+FCAJ(FCA_LEN_J) !LAST ADDRESS - IF (FCAJ(FCA_HIBLK_J).GE.0 .AND. - 1 J2.GT.FCAJ(FCA_HIBLK_J)) GOTO 20 !CANNOT FIT IN ALLOCATION - IF (FCAJ(FCA_LEN_J).LE.0) GOTO 810 !NONE TO DO - 22 CONTINUE - J0=(%LOC(FCAJ)+FCA_BQA_1-A_OB)/LB_J !BUF HEAD PTR - J=(A_J(J0)-A_OB)/LB_J !FIRST BUF - DO WHILE (J.NE.J0) !ALL BUFFERS - IF (FCAJ(FCA_DAD_J).LT.A_J(J+FBC_DISK_J-FBC_BQA_J)) THEN - GOTO 20 !NOT IN CORE - ELSE IF (FCAJ(FCA_DAD_J).LT. - 1 A_J(J+FBC_DISKND_J-FBC_BQA_J)) THEN !PARTLY IN CORE - J=J-FBC_BQA_J !CORRECT POINTER - J2=MIN(A_J(J+FBC_DISKND_J)- - 1 FCAJ(FCA_DAD_J),FCAJ(FCA_LEN_J)) !LENGTH TO DO - J3=FCAJ(FCA_DAD_J)-A_J(J+FBC_DISK_J) !OFFSET TO BUF START - CALL WNGMV(J2,%VAL(FCAJ(FCA_BAD_J)), - 1 %VAL(A_J(J+FBC_ADDR_J)+J3)) !MOVE DATA - A_J(J+FBC_BITS_J)=IOR(A_J(J+FBC_BITS_J), - 1 FBC_M_WRITE) !SET REWRITE - IF (IAND(FCAJ(FCA_BITS_J),FCA_M_MAG).EQ.0) THEN !DISK - JS=WNGSQR(%VAL(A_J(J+FBC_BQT_J)),J3) !SET TIME ORDER - JS=WNGSQI(%VAL(J3),%VAL(FCAJ(FCA_BQT_J))) - END IF - FCAJ(FCA_DAD_J)=FCAJ(FCA_DAD_J)+J2 !NEXT DISK ADDRESS - FCAJ(FCA_BAD_J)=FCAJ(FCA_BAD_J)+J2 !NEXT BUF ADDRESS - FCAJ(FCA_ACLEN_J)=FCAJ(FCA_ACLEN_J)+J2 !LENGTH WRITTEN - FCAJ(FCA_LEN_J)=FCAJ(FCA_LEN_J)-J2 !LENGTH STILL TO DO - IF (FCAJ(FCA_LEN_J).LE.0) GOTO 810 !READY - END IF !PARTLY - J=(A_J(J)-A_OB)/LB_J !NEXT BUFFER - END DO -C -C READ IN NEXT BUFFER -C - 20 CONTINUE - LFELJ(FEL_DKAD_J)=FCAJ(FCA_DAD_J) !DISK ADDRESS - LFELJ(FEL_BUFAD_J)=0 !WRITE AFTER - IF (IAND(FCAJ(FCA_BITS_J),FCA_M_MAG).NE.0) THEN !TAPE - LFELJ(FEL_BUFLEN_J)=1 !LIMIT TO ONE BLOCK - ELSE !DISK - LFELJ(FEL_BUFLEN_J)=MIN(FCAJ(FCA_LEN_J), - 1 FCAJ(FCA_BLEN_J)*2) !LIMIT INFINITE LOOP - END IF - LFELJ(FEL_BITS_J)=0 !INDICATE WRITE - ECOD=WNF_RWAHEAD(FCAJ,LFELJ(FEL_DKAD_J),LFELJ) !WRITE AFTER - IF (ECOD) THEN !STARTED - IF (IAND(FCA_M_ACT,FCAJ(FCA_BITS_J)).NE.0) THEN !ACTIVE - ECOD=SYS$WAITFR(%VAL(FCAJ(FCA_EF_J))) !AWAIT IO - IF (.NOT.ECOD) FCAJ(FCA_ERR_J)=ECOD !SAVE ERROR - END IF - ELSE - FCAJ(FCA_ERR_J)=ECOD !SAVE ERROR - END IF - IF (.NOT.FCAJ(FCA_ERR_J)) GOTO 810 !STOP IF ERROR - GOTO 22 !DO MORE - END IF !READ/WRITE -C -C READY READ -C - 800 CONTINUE - ECOD=FCAJ(FCA_ERR_J) !ERROR - IF (ECOD) THEN !NOT YET ERROR - IF (IAND(FCAJ(FCA_ACLEN_J),'80000000'X).NE.0) - 1 ECOD=SS$_ENDOFFILE !EMBEDDED EOF - END IF - FCAJ(FCA_ACLEN_J)=IAND(FCAJ(FCA_ACLEN_J),'7FFFFFFF'X) !PROPER LENGTH - GOTO 900 -C -C READY WRITE -C - 810 CONTINUE - ECOD=FCAJ(FCA_ERR_J) !ERROR - IF (FCAJ(FCA_ACLEN_J).NE.0) THEN !SOMETHING WRITTEN - FCAJ(FCA_EOF_J)=MAX(FCAJ(FCA_EOF_J),FCAJ(FCA_DAD_J)) !NEW EOF - END IF - GOTO 900 -C -C ERROR -C - 900 CONTINUE - WNFIO_X=IAND('0000FFFF'X,ECOD) !RETURN ERROR -C - RETURN -C -C WNFPUR_X(FCAJ) Purge all buffers -C - ENTRY WNFPUR_X(FCAJ) -C - IF (IAND(FCAJ(FCA_BITS_J),FCA_M_ACT).NE.0) THEN !ACTIVE IO - JS=SYS$WAITFR(%VAL(FCAJ(FCA_EF_J))) !AWAIT IO - IF (NOT(JS)) THEN - FCAJ(FCA_ERR_J)=JS - GOTO 810 !FINISH - END IF - END IF - FCAJ(FCA_ERR_J)=SS$_NORMAL !NO ERROR - FCAJ(FCA_ACLEN_J)=0 !NOTHING WRITTEN -C -C PURGE -C - 200 CONTINUE - J1=(%LOC(FCAJ)+FCA_BQA_1-A_OB)/LB_J !BUF HEAD PTR - J=(A_J(J1)-A_OB)/LB_J !FIRST BUF - DO WHILE (J.NE.J1) !ALL BUFFERS - J=J-FBC_BQA_J !CORRECT POINTER - IF (IAND(A_J(J+FBC_BITS_J),FBC_M_WRITE).NE.0) THEN !REWRITE - A_J(J+FBC_BITS_J)=IAND( - 1 A_J(J+FBC_BITS_J),NOT(FBC_M_WRITE)) !RESET - JS=WNF_INWRITEW(FCAJ,A_J(J)) !WRITE - IF (.NOT.JS) THEN !ERROR - FCAJ(FCA_ERR_J)=JS - GOTO 810 - END IF - IF (IAND(FCAJ(FCA_BITS_J),FCA_M_MAG).NE.0) THEN !TAPE - I1=IAND('0000FFFF'X,ISHFT(FCAJ(FCA_IOSB_J),-16)) !BYTES WRITTEN - FCAJ(FCA_MAP_J)=FCAJ(FCA_MAP_J)+I1 !TAPE POSITION - FCAJ(FCA_MAB_J)=FCAJ(FCA_MAB_J)+1 !TAPE BLOCK - END IF - IF (.NOT.FCAJ(FCA_IOSB_J)) - 1 FCAJ(FCA_ERR_J)=FCAJ(FCA_IOSB_J) !SAVE ERROR - ELSE - A_J(J+FBC_DISK_J)=0 !SET EMPTY - A_J(J+FBC_DISKND_J)=0 - A_J(J+FBC_BITS_J)=0 - END IF - J=(A_J(J)-A_OB)/LB_J !NEXT BCB - END DO - GOTO 810 !FINISH -C -C - END - -C+ -C WNF_RWAHEAD(FCAJ,DKAD,FELJ) Read/write ahead -C - INTEGER FUNCTION WNF_RWAHEAD(FCAJ,DKAD,FELJ) -C - INCLUDE 'WNG_DEF' - INCLUDE 'FCA_O_DEF' - INCLUDE 'FEL_O_DEF' -C - INTEGER FCAJ(0:*) !FCA - INTEGER DKAD !DISK ADDRESS - INTEGER FELJ(0:*) !ELEMENT TO DO -C - INTEGER SYS$CLREF - INTEGER SYS$WAITFR - INTEGER SYS$DCLAST - LOGICAL WNGSQR,WNGSQI - EXTERNAL WNF_IAST -C- - 10 CONTINUE - WNF_RWAHEAD=SYS$CLREF(%VAL(FCAJ(FCA_EFA_J))) !CLEAR ELEMENT AVAILABLE - IF (.NOT.WNF_RWAHEAD) RETURN !CANNOT DO - IF (.NOT.WNGSQR(%VAL(FCAJ(FCA_FEE_J)),J)) THEN !GET ELEMENT - WNF_RWAHEAD=SYS$WAITFR(%VAL(FCAJ(FCA_EFA_J))) !AWAIT ONE - IF (.NOT.WNF_RWAHEAD) RETURN !ERROR - GOTO 10 !RETRY - END IF - J=(J-A_OB)/LB_J !ELEMENT POINTER - A_J(J+FEL_DKAD_J)=DKAD !START DISK ADDRESS - A_J(J+FEL_BUFAD_J)=0 !BUFFER ADDRESS - A_J(J+FEL_BUFLEN_J)=FELJ(FEL_BUFLEN_J) !LENGTH TO READ/WRITE - A_J(J+FEL_BITS_J)=FELJ(FEL_BITS_J) !READ/WRITE - JS=WNGSQI(A_J(J),%VAL(FCAJ(FCA_FEA_J+1))) !SET IN ACTIVE QUEUE - IF (IAND(FCAJ(FCA_BITS_J),FCA_M_ACT).EQ.0) THEN !NOT YET ACTIVE - FCAJ(FCA_BITS_J)=IOR(FCAJ(FCA_BITS_J),FCA_M_ACT) !SET ACTIVE - WNF_RWAHEAD=SYS$CLREF(%VAL(FCAJ(FCA_EF_J))) !CLEAR EF - IF (WNF_RWAHEAD) THEN !OK - WNF_RWAHEAD=SYS$DCLAST(WNF_IAST,FCAJ,) !START IO - IF (WNF_RWAHEAD) RETURN !BACK TO USER - END IF - JS=WNGSQR(%VAL(FCAJ(FCA_FEA_J+1)),J) !REMOVE FROM ACTIVE - JS=WNGSQI(%VAL(J),%VAL(FCAJ(FCA_FEE_J+1))) !RE-INSERT IN EMPTY - FCAJ(FCA_BITS_J)=IAND(FCAJ(FCA_BITS_J),NOT(FCA_M_ACT)) !SET NOT STARTED - END IF -C - RETURN -C -C - END - -C+ -C The following are internal routines to WNFIO_X -C -C WNF_EOF(FCA) Convert disk address to EOF -C - SUBROUTINE WNF_EOF(FCAJ) -C - INCLUDE 'WNG_DEF' - INCLUDE 'FCA_O_DEF' -C - INTEGER LIB$EXTZV -C - INTEGER FCAJ(0:*) !FCA -C- - I1=FCAJ(FCA_EOF_J)+512 !MAKE VIRTUAL BLOCKS - I2=LIB$EXTZV(9,16,I1) !EOF BLOCK - IF (I2.GT.32767) I2=IOR(I2,'FFFF0000'X) !OVERFLOW PROBLEM - A_I((%LOC(FCAJ)-A_OB+FCA_RECATR_1+FAT_EFBLKL_1)/LB_I)=I2 - I2=LIB$EXTZV(25,7,I1) - IF (I2.GT.32767) I2=IOR(I2,'FFFF0000'X) !OVERFLOW PROBLEM - A_I((%LOC(FCAJ)-A_OB+FCA_RECATR_1+FAT_EFBLKH_1)/LB_I)=I2 - CALL LIB$INSV(I1,0,9, !EOF BYTE - 1 A_I((%LOC(FCAJ)-A_OB+FCA_RECATR_1+FAT_FFBYTE_1)/LB_I)) -C - RETURN -C -C - END -C+ -C WNF_INWRITEW(FCAJ,FBCJ) Initialise a write and wait -C - INTEGER FUNCTION WNF_INWRITEW(FCAJ,FBCJ) -C - INCLUDE 'WNG_DEF' - INCLUDE '($IODEF)' - INCLUDE 'FCA_O_DEF' - INCLUDE 'FBC_O_DEF' -C - INTEGER FCAJ(0:*) !FCA - INTEGER FBCJ(0:*) !FBC -C - INTEGER SYS$QIOW - INTEGER LIB$EXTZV -C- - I=IO$_WRITEVBLK !INDICATE WRITE - I1=LIB$EXTZV(9,23,FBCJ(FBC_DISK_J))+1 !VIRTUAL BLOCK # - I3=MIN(FCAJ(FCA_BLEN_J),FCAJ(FCA_HIBLK_J)- - 1 FBCJ(FBC_DISK_J)) !LENGTH TO DO - WNF_INWRITEW=SYS$QIOW(,%VAL(FCAJ(FCA_CHAN_J)),%VAL(I), - 1 FCAJ(FCA_IOSB_J),,, - 1 %VAL(FBCJ(FBC_ADDR_J)),%VAL(I3),%VAL(I1),,,) -C - RETURN -C -C - END -C+ -C WNF_INWRITE(FCAJ,FBCJ,AST) Initialise a write -C WNF_INREAD(FCAJ,FBCJ,AST) Initialise a read -C WNF_EXTEND(FCAJ,FBCJ,AST) Extend file -C - INTEGER FUNCTION WNF_INWRITE(FCAJ,FBCJ,AST) -C - INCLUDE 'WNG_DEF' - INCLUDE '($IODEF)' - INCLUDE 'FCA_O_DEF' - INCLUDE 'FBC_O_DEF' -C - INTEGER FCAJ(0:*) !FCA - INTEGER FBCJ(0:*) !FBC - INTEGER AST !AST CODE -C - INTEGER WNF_INREAD,WNF_EXTEND -C - INTEGER SYS$QIO - INTEGER LIB$EXTZV - EXTERNAL WNF_WASTW,WNF_WAST,WNF_WASTX - EXTERNAL WNF_RAST,WNF_RASTW -C- -C -C INWRITE -C - I=IO$_WRITEVBLK !INDICATE WRITE - GOTO 10 -C -C INREAD -C - ENTRY WNF_INREAD(FCAJ,FBCJ,AST) -C - I=IO$_READVBLK - 10 CONTINUE - I1=LIB$EXTZV(9,23,FBCJ(FBC_DISK_J))+1 !VIRTUAL BLOCK # - IF (FCAJ(FCA_HIBLK_J).GE.0 .AND. - 1 FBCJ(FBC_DISKND_J).GT.FCAJ(FCA_HIBLK_J)) THEN !NOT IN EXTEND - I3=FCAJ(FCA_HIBLK_J)-FBCJ(FBC_DISK_J) !LENGTH TO DO - ELSE !BEYOND EXTEND - I3=FCAJ(FCA_BLEN_J) !STANDARD LENGTH - END IF - GOTO 20 -C -C EXTEND -C - ENTRY WNF_EXTEND(FCAJ,FBCJ,AST) -C - 20 CONTINUE - IF (AST.EQ.1) THEN - WNF_INWRITE=SYS$QIO(,%VAL(FCAJ(FCA_CHAN_J)),%VAL(I), - 1 FCAJ(FCA_IOSB_J),WNF_WASTW,FCAJ, - 1 %VAL(FBCJ(FBC_ADDR_J)),%VAL(I3),%VAL(I1),,,) - ELSE IF (AST.EQ.2) THEN - WNF_INWRITE=SYS$QIO(,%VAL(FCAJ(FCA_CHAN_J)),%VAL(I), - 1 FCAJ(FCA_IOSB_J),WNF_WAST,FCAJ, - 1 %VAL(FBCJ(FBC_ADDR_J)),%VAL(I3),%VAL(I1),,,) - ELSE IF (AST.EQ.3) THEN - WNF_INWRITE=SYS$QIO(,%VAL(FCAJ(FCA_CHAN_J)),%VAL(IO$_MODIFY), - 1 FCAJ(FCA_IOSB_J),WNF_WASTX,FCAJ, - 1 FCAJ(FCA_FIBDES_J),FCAJ(FCA_ATRJ_J),,,,) - ELSE IF (AST.EQ.4) THEN - WNF_INWRITE=SYS$QIO(,%VAL(FCAJ(FCA_CHAN_J)),%VAL(I), - 1 FCAJ(FCA_IOSB_J),WNF_RAST,FCAJ, - 1 %VAL(FBCJ(FBC_ADDR_J)),%VAL(I3),%VAL(I1),,,) - ELSE - WNF_INWRITE=SYS$QIO(,%VAL(FCAJ(FCA_CHAN_J)),%VAL(I), - 1 FCAJ(FCA_IOSB_J),WNF_RASTW,FCAJ, - 1 %VAL(FBCJ(FBC_ADDR_J)),%VAL(I3),%VAL(I1),,,) - END IF -C - RETURN -C -C - END -C+ -C WNF_SETAQ(FCAJ,FBCJ) Set in address queue -C - SUBROUTINE WNF_SETAQ(FCAJ,FBCJ) -C - INCLUDE 'WNG_DEF' - INCLUDE 'FCA_O_DEF' - INCLUDE 'FBC_O_DEF' -C - LOGICAL WNGSQI,WNGSQR -C - INTEGER FCAJ(0:*) !FCA - INTEGER FBCJ(0:*) !FBC -C -C- - JS=WNGSQR(FBCJ(FBC_BQA_J),I1) !FIND WHERE TO PUT - I2=(%LOC(FCAJ)+FCA_BQA_1-A_OB)/LB_J !IN ADDRESS QUEUE - I3=(A_J(I2)-A_OB)/LB_J !FIRST BUF - DO WHILE (I3.NE.I2) !NOT END - IF (FBCJ(FBC_DISK_J).LT. - 1 A_J(I3+FBC_DISK_J-FBC_BQA_J)) GOTO 10 !HERE - I3=(A_J(I3)-A_OB)/LB_J !TRY NEXT - END DO - 10 CONTINUE - JS=WNGSQI(%VAL(I1),%VAL(A_J(I3+1))) !INSERT -C - RETURN -C -C - END - -C+ -C The following are all the AST routines -C -C WNF_IAST(FCAJ) General I/O AST -C WNF_WASTW(FCAJ) Rewrite AST -C WNF_WAST(FCAJ) Standard write AST -C WNF_WASTX(FCAJ) Write extend AST -C WNF_RAST(FCAJ) Standard read AST -C WNF_RASTW(FCAJ) Rewrite read AST -C - SUBROUTINE WNF_IAST(FCAJ) -C - INCLUDE 'WNG_DEF' - INCLUDE '($SSDEF)' - INCLUDE '($IODEF)' - INCLUDE 'FCA_O_DEF' - INCLUDE 'FEL_O_DEF' - INCLUDE 'FBC_O_DEF' - INCLUDE 'MCA_O_DEF' -C - INTEGER FCAJ(0:*) !FCA -C - INTEGER SYS$SETEF - INTEGER WNFTSF - INTEGER WNF_INWRITE - INTEGER WNF_INREAD - INTEGER WNF_EXTEND - LOGICAL WNGSQI,WNGSQR -C -C- - FCAJ(FCA_ERR_J)=SS$_NORMAL !ASSUME OK - GOTO 310 -C - ENTRY WNF_WASTW(FCAJ) -C - IF (IAND(FCAJ(FCA_BITS_J),FCA_M_MAG).NE.0) THEN !TAPE - I1=A_I((%LOC(FCAJ)-A_OB+FCA_IOSB_1+LB_I)/LB_I) !BYTES WRITTEN - FCAJ(FCA_MAP_J)=FCAJ(FCA_MAP_J)+I1 !TAPE POSITION - FCAJ(FCA_MAB_J)=FCAJ(FCA_MAB_J)+1 !TAPE BLOCK - END IF - IF (.NOT.FCAJ(FCA_IOSB_J)) THEN !ERROR - FCAJ(FCA_ERR_J)=FCAJ(FCA_IOSB_J) !SAVE ERROR - GOTO 300 !FINISH - END IF - GOTO 440 !FILL BUFFER -C - ENTRY WNF_WAST(FCAJ) -C - IF (FCAJ(FCA_IOSB_J)) GOTO 430 !CONTINUE - FCAJ(FCA_ERR_J)=FCAJ(FCA_IOSB_J) !SAVE ERROR - J=(FCAJ(FCA_FEL_J)-A_OB)/LB_J !CURRENT ELEMENT - FCAJ(FCA_EOF_J)=MAX(FCAJ(FCA_EOF_J), - 1 A_J(J+FEL_DKAD_J)) !SET NEW EOF - GOTO 300 !FINISH -C - ENTRY WNF_WASTX(FCAJ) -C - CALL WNFIO_X0(FCAJ,FCAJ(FCA_FIBJ_J)) !RESET BIT - IF (.NOT.FCAJ(FCA_IOSB_J)) THEN !ERROR - FCAJ(FCA_ERR_J)=FCAJ(FCA_IOSB_J) !SAVE ERROR - GOTO 300 !FINISH - END IF - CALL WNFIO_X1(FCAJ,FCAJ(FCA_FIBJ_J),I) !GET NEW SIZE - FCAJ(FCA_HIBLK_J)=(I-1)*512 !AS ADDRESS - GOTO 420 !RETRY -C - ENTRY WNF_RAST(FCAJ) -C - IF (IAND(FCAJ(FCA_BITS_J),FCA_M_MAG).NE.0) THEN !TAPE - I1=A_I((%LOC(FCAJ)-A_OB+FCA_IOSB_1+LB_I)/LB_I) !BYTES READ - FCAJ(FCA_MAP_J)=FCAJ(FCA_MAP_J)+I1 !TAPE POSITION - FCAJ(FCA_MAB_J)=FCAJ(FCA_MAB_J)+1 !TAPE BLOCK - J=(FCAJ(FCA_BQT_J)-FBC_BQT_1-A_OB)/LB_J !CURRENT BUF POINTER - A_J(J+FBC_DISKND_J)=A_J(J+FBC_DISK_J)+I1 !END POS. BUFFER - IF (I1.LE.100 .OR. !!ASSUME EOF - 1 IAND(FCAJ(FCA_IOSB_J),'0000FFFF'X).EQ. - 1 SS$_ENDOFFILE) THEN - FCAJ(FCA_EOF_J)=FCAJ(FCA_MAP_J) !SAVE EOF - JS=WNFTSF(%VAL(FCAJ(FCA_MCA_J)),-1) !SKIP BACK FILE - FCAJ(FCA_MAB_J)=FCAJ(FCA_MAB_J)-1 !RESET BLOCK COUNT - END IF - END IF - IF (IAND(FCAJ(FCA_IOSB_J),'0000FFFF'X).EQ. - 1 SS$_ENDOFFILE) GOTO 320 !ACCEPT EOF - IF (FCAJ(FCA_IOSB_J)) GOTO 320 !OK STATUS - FCAJ(FCA_ERR_J)=FCAJ(FCA_IOSB_J) !SAVE ERROR - GOTO 300 !NEXT ELEMENT -C - ENTRY WNF_RASTW(FCAJ) -C - IF (FCAJ(FCA_IOSB_J)) GOTO 340 !FILL BUFFER - FCAJ(FCA_ERR_J)=FCAJ(FCA_IOSB_J) !SAVE ERROR - GOTO 300 !NEXT ELEMENT -C -C RESET ELEMENT EMPTY QUEUE -C - 300 CONTINUE !IANXT - J=(FCAJ(FCA_FEL_J)-A_OB)/LB_J !CURRENT ELEMENT - JS=WNGSQI(A_J(J),%VAL(FCAJ(FCA_FEE_J+1))) !SET IN EMPTY QUEUE - IF (JS) THEN !FIRST - JS=SYS$SETEF(%VAL(FCAJ(FCA_EFA_J))) !NOTIFY EMPTY AVAILABLE - END IF -C -C GET NEXT ELEMENT -C - 310 CONTINUE !IANEW - IF (.NOT.WNGSQR(%VAL(FCAJ(FCA_FEA_J)),J)) THEN !GET ELEMENT TO DO - FCAJ(FCA_BITS_J)=IAND(FCAJ(FCA_BITS_J),NOT(FCA_M_ACT)) !SET READY - JS=SYS$SETEF(%VAL(FCAJ(FCA_EF_J))) !NOTIFY WORLD -C - RETURN !ALL READY - END IF - J=(J-A_OB)/LB_J !CURRENT ELEMENT -C -C ACT ON ELEMENT -C - FCAJ(FCA_FEL_J)=%LOC(A_J(J)) !SET CURRENT - IF (.NOT.FCAJ(FCA_ERR_J)) GOTO 300 !ALREADY ERROR ENCOUNTERED - IF (A_J(J+FEL_BUFLEN_J).LE.0) GOTO 300 !READY - IF (A_J(J+FEL_BITS_J)) GOTO 320 !READ - GOTO 420 !WRITE -C -C READ AHEAD -C - 320 CONTINUE !IAREAD - J=(FCAJ(FCA_FEL_J)-A_OB)/LB_J !CURRENT ELEMENT - I=A_J(J+FEL_DKAD_J)+A_J(J+FEL_BUFLEN_J) !END DISK ADDRESS - IF (FCAJ(FCA_EOF_J).GE.0 .AND. - 1 I.GT.FCAJ(FCA_EOF_J)) THEN !NOT ALL PRESENT - A_J(J+FEL_BUFLEN_J)=FCAJ(FCA_EOF_J)-A_J(J+FEL_DKAD_J) !MAX. LENGTH - IF (A_J(J+FEL_BUFLEN_J).LE.0) GOTO 300 !NO MORE, NEXT ELEMENT - END IF -C -C START BUFFER MOVE -C - 330 CONTINUE - J=(FCAJ(FCA_FEL_J)-A_OB)/LB_J !CURRENT ELEMENT - J0=(%LOC(FCAJ)+FCA_BQA_1-A_OB)/LB_J !BUF HEAD PTR - J1=(A_J(J0)-A_OB)/LB_J !FIRST BUF - DO WHILE (J1.NE.J0) !CHECK BUFFERS - IF (A_J(J+FEL_DKAD_J).LT. - 1 A_J(J1+FBC_DISK_J-FBC_BQA_J)) GOTO 332 !NOT IN CORE - IF (A_J(J+FEL_DKAD_J).LT. - 1 A_J(J1+FBC_DISKND_J-FBC_BQA_J)) THEN !PARTLY - J1=J1-FBC_BQA_J !CORRECT POINTER - I=A_J(J1+FBC_DISKND_J)-A_J(J+FEL_DKAD_J) !MAX. POSSIBLE - A_J(J+FEL_DKAD_J)=A_J(J+FEL_DKAD_J)+I !UPDATE - A_J(J+FEL_BUFLEN_J)=A_J(J+FEL_BUFLEN_J)-I - IF (A_J(J+FEL_BUFLEN_J).LE.0) GOTO 300 !READY; DO NEXT - IF (IAND(FCAJ(FCA_BITS_J),FCA_M_MAG).NE.0) THEN !TAPE - J2=FCAJ(FCA_MCA_J) !TAPE MCA - IF (IAND(A_J((J2-A_OB)/LB_J+MCA_BITS_J),MCA_M_BLK).NE.0) - 1 GOTO 300 !BLOCK MODE, READY - END IF - J1=J1+FBC_BQA_J !CORRECT POINTER - END IF - J1=(A_J(J1)-A_OB)/LB_J !NEXT FBC - END DO -C -C GET NEW BUFFER -C - 332 CONTINUE - JS=WNGSQR(%VAL(FCAJ(FCA_BQT_J+1)),J) !REMOVE OLDEST ENTRY - JS=WNGSQI(%VAL(J),FCAJ(FCA_BQT_J)) !SET AT BEGIN - J=(J-FBC_BQT_1-A_OB)/LB_J !CORRECT POINTER - IF (IAND(A_J(J+FBC_BITS_J),FBC_M_WRITE).EQ.0) GOTO 340 !NO REWRITE - A_J(J+FBC_BITS_J)=IAND(A_J(J+FBC_BITS_J),NOT(FBC_M_WRITE)) !RESET - JS=WNF_INWRITE(FCAJ,A_J(J),5) !START WRITE - IF (.NOT.JS) THEN - FCAJ(FCA_ERR_J)=JS !SAVE ERROR - GOTO 300 - END IF -C - RETURN !WAIT -C -C FILL NEW BUFFER -C - 340 CONTINUE !IARFBUF - J=(FCAJ(FCA_FEL_J)-A_OB)/LB_J !CURRENT ELEMENT - J1=(FCAJ(FCA_BQT_J)-FBC_BQT_1-A_OB)/LB_J !TO BE READ - I1=A_J(J+FEL_DKAD_J) !START ADDRESS BUFFER - IF (IAND(FCAJ(FCA_BITS_J),FCA_M_MAG).EQ.0) THEN !DISK - I1=I1/FCAJ(FCA_BLEN_J) !WHOLE # OF BUFFERS - A_J(J1+FBC_DISK_J)=I1*FCAJ(FCA_BLEN_J) - 341 CONTINUE - A_J(J1+FBC_DISKND_J)=FCAJ(FCA_BLEN_J)+A_J(J1+FBC_DISK_J) !BUF END - CALL WNF_SETAQ(FCAJ,A_J(J1)) !SET IN ADDRESS QUEUE - JS=WNF_INREAD(FCAJ,A_J(J1),4) !START READ - IF (.NOT.JS) THEN - 342 CONTINUE - FCAJ(FCA_ERR_J)=JS - GOTO 300 - END IF - ELSE !TAPE - IF (I1.LT.FCAJ(FCA_MAP_J)) THEN !CANNOT READ BACKWARDS - JS=SS$_IVADDR - GOTO 342 - END IF - A_J(J1+FBC_DISK_J)=FCAJ(FCA_MAP_J) !BUFFER TAPE ADDRESS - GOTO 341 - END IF -C - RETURN !WAIT -C -C WRITE AHEAD -C - 420 CONTINUE !IAWRITE - J=(FCAJ(FCA_FEL_J)-A_OB)/LB_J !CURRENT ELEMENT - IF (FCAJ(FCA_HIBLK_J).GE.0 .AND. - 1 A_J(J+FEL_DKAD_J)+A_J(J+FEL_BUFLEN_J).GT. - 1 FCAJ(FCA_HIBLK_J)) GOTO 410 !CANNOT FIT IN ALLOCATION:EXTEND - GOTO 430 !START ACTUAL WRITE -C -C EXTEND FILE -C - 410 CONTINUE - CALL WNFIO_X2(FCAJ,FCAJ(FCA_FIBJ_J)) !SET NUMBER WANTED - CALL WNF_EOF(FCAJ) !SET CORRECT EOF - JS=WNF_EXTEND(FCAJ,0,3) !EXTEND - IF (.NOT.JS) THEN !SUBMIT ERROR - CALL WNFIO_X0(FCAJ,FCAJ(FCA_FIBJ_J)) !RESET EXTEND - FCAJ(FCA_ERR_J)=JS !TRANSMIT ERROR - GOTO 300 !FINISH - END IF -C - RETURN !AWAIT EXTEND -C -C WRITE BUFFER MOVE -C - 430 CONTINUE !IAWBUF - J=(FCAJ(FCA_FEL_J)-A_OB)/LB_J !CURRENT ELEMENT - J0=(%LOC(FCAJ)+FCA_BQA_1-A_OB)/LB_J !BUF HEAD - J1=(A_J(J0)-A_OB)/LB_J !FIRST BUF - DO WHILE (J1.NE.J0) !CHECK BUFFERS - IF (A_J(J+FEL_DKAD_J).LT. - 1 A_J(J1+FBC_DISK_J-FBC_BQA_J)) GOTO 432 !NOT IN CORE - IF (A_J(J+FEL_DKAD_J).LT. - 1 A_J(J1+FBC_DISKND_J-FBC_BQA_J)) THEN !PARTLY - J1=J1-FBC_BQA_J !CORRECT POINTER - I=A_J(J1+FBC_DISKND_J)-A_J(J+FEL_DKAD_J) !MAX. POSSIBLE - A_J(J+FEL_DKAD_J)=A_J(J+FEL_DKAD_J)+I !UPDATE - A_J(J+FEL_BUFLEN_J)=A_J(J+FEL_BUFLEN_J)-I - IF (A_J(J+FEL_BUFLEN_J).LE.0) GOTO 300 !READY; DO NEXT - J1=J1+FBC_BQA_J !CORRECT POINTER - END IF - J1=(A_J(J1)-A_OB)/LB_J !NEXT FBC - END DO - GOTO 434 -C -C GET NEW BUF -C - 432 CONTINUE - IF (IAND(FCAJ(FCA_BITS_J),FCA_M_MAG).NE.0) THEN !TAPE - JS=SS$_IVADDR !CANNOT BE RANDOM - GOTO 433 - END IF - 434 CONTINUE - JS=WNGSQR(%VAL(FCAJ(FCA_BQT_J+1)),J) !REMOVE OLDEST ENTRY - JS=WNGSQI(%VAL(J),FCAJ(FCA_BQT_J)) !SET AT BEGIN - J=(J-FBC_BQT_1-A_OB)/LB_J !CORRECT POINTER - IF (IAND(A_J(J+FBC_BITS_J),FBC_M_WRITE).EQ.0) GOTO 440 !NO REWRITE - A_J(J+FBC_BITS_J)=IAND(A_J(J+FBC_BITS_J),NOT(FBC_M_WRITE)) !RESET - JS=WNF_INWRITE(FCAJ,A_J(J),1) !START WRITE - IF (.NOT.JS) THEN - 433 CONTINUE - FCAJ(FCA_ERR_J)=JS !SAVE ERROR - GOTO 300 - END IF -C - RETURN !WAIT -C -C FILL WRITE BUFFER -C - 440 CONTINUE !IAWFBUF - J=(FCAJ(FCA_FEL_J)-A_OB)/LB_J !CURRENT ELEMENT - J1=(FCAJ(FCA_BQT_J)-FBC_BQT_1-A_OB)/LB_J !TO BE READ - I1=A_J(J+FEL_DKAD_J) !START ADDRESS BUFFER - IF (IAND(FCAJ(FCA_BITS_J),FCA_M_MAG).EQ.0) THEN !DISK - 443 CONTINUE - I1=I1/FCAJ(FCA_BLEN_J) !WHOLE # OF BUFFERS - A_J(J1+FBC_DISK_J)=I1*FCAJ(FCA_BLEN_J) - A_J(J1+FBC_DISKND_J)=FCAJ(FCA_BLEN_J)+A_J(J1+FBC_DISK_J) !BUF END - CALL WNF_SETAQ(FCAJ,A_J(J1)) !SET IN ADDRESS QUEUE - IF (A_J(J1+FBC_DISK_J).GE.FCAJ(FCA_EOF_J)) THEN !NOT YET WRITTEN - 442 CONTINUE - CALL WNGMVZ(FCAJ(FCA_BLEN_J),%VAL(A_J(J1+FBC_ADDR_J))) !EMPTY BUF - GOTO 430 !DO WRITE - END IF - IF (IAND(FCAJ(FCA_BITS_J),FCA_M_MAG).NE.0) - 1 GOTO 442 !NEVER READ TAPE - IF (A_J(J+FEL_DKAD_J).EQ.A_J(J1+FBC_DISK_J)) THEN !MAYBE FULL BUF - IF (A_J(J+FEL_BUFLEN_J).GE.FCAJ(FCA_BLEN_J)) GOTO 442 !FULL BUF - END IF - JS=WNF_INREAD(FCAJ,A_J(J1),2) !START READ - IF (.NOT.JS) THEN - CONTINUE - FCAJ(FCA_ERR_J)=JS - GOTO 300 - END IF - ELSE !TAPE - I1=FCAJ(FCA_MAW_J) !TAPE ADDRESS - FCAJ(FCA_MAW_J)=FCAJ(FCA_MAW_J)+FCAJ(FCA_BLEN_J) !MAKE SURE CONTIGUOUS - A_J(J1+FBC_BITS_J)=IOR(A_J(J1+FBC_BITS_J),FBC_M_WRITE) !ALWAYS WRITE - GOTO 443 - END IF -C - RETURN !WAIT -C -C - END - -C+ -C FIB handling -C -C WNFIO_X0(FCAJ,FIB) Reset extend bit -C - SUBROUTINE WNFIO_X0(FCAJ,FIB) -C - INCLUDE 'WNG_DEF' - INCLUDE '($FIBDEF)' - INCLUDE 'FCA_O_DEF' -C - INTEGER FCAJ(0:*) - RECORD /FIBDEF/ FIB - INTEGER JVAL -C - FIB.FIB$W_EXCTL=IAND(FIB.FIB$W_EXCTL,NOT(FIB$M_EXTEND)) -C - RETURN -C -C WNFIO_X1(FCAJ,FIB,JVAL) Get new size -C - ENTRY WNFIO_X1(FCAJ,FIB,JVAL) -C - JVAL=FIB.FIB$L_EXVBN+FIB.FIB$L_EXSZ !NEW SIZE -C - RETURN -C -C WNFIO_X2(FCAJ,FIB) Set extend size -C - ENTRY WNFIO_X2(FCAJ,FIB) -C - FIB.FIB$W_EXCTL=IOR(FIB.FIB$W_EXCTL,FIB$M_EXTEND) !ASK EXTEND - FIB.FIB$L_EXVBN=0 !NUMBER EXTENDED -C - RETURN -C -C - END diff --git a/src/wng/wnfmou.for b/src/wng/wnfmou.for deleted file mode 100644 index d6e1cbbfb180be9fccadc2bb0ecc056efc084d02..0000000000000000000000000000000000000000 --- a/src/wng/wnfmou.for +++ /dev/null @@ -1,116 +0,0 @@ -C+ WNFMOU.FOR -C WNB 890714 -C -C Revisions: -C HjV 930519 Add //CHAR(0) in call to WNFMOU_X -C WNB 930520 Remove %VAL -C HjV 930519 Remove //CHAR(0) in call to WNFMOU_X -C Now in WNFMOU_X.CEE itself -C WNB 930811 Remove L_ -C CMV 940808 Add entry WNFMLI to list tapeunits -C - LOGICAL FUNCTION WNFMOU(MCA,UNIT,ACC) -C -C Mount a tape volume -C -C Result: -C -C WNFMOU_L = WNFMOU( MCA_J:IO, UNIT_C*:I, ACC_C*:I) -C Mount a tape on the unit number UNIT, -C corresponding to logical device MAG<unit>. MCA -C is the magnetictape-control-area. ACC can be a -C combination of R (default) or W, and U -C to force unlabeled handling, and B to -C force block handling, rather than address mode -C for Reading. -C Note: Only first char. of UNIT is used. -C -C WNFMLI_L = WNFMLI() List definitions of all tapeunits -C -C -C Include files: -C - INCLUDE 'WNG_DEF' - INCLUDE 'MCA_O_DEF' !MCA OFFSETS -C -C Parameters: -C -C -C Arguments: -C - INTEGER MCA !MCA ID - CHARACTER*(*) UNIT !UNIT TO MOUNT - CHARACTER*(*) ACC !ACCESS DATA -C -C Entry points: -C - LOGICAL WNFMLI !LIST UNITS -C -C Function references: -C - LOGICAL WNGGVM !GET VIRTUAL MEMORY - INTEGER WNFTFC !TEST FCA/MCA PRESENCE - INTEGER WNFMOU_X !MOUNT TAPE - INTEGER WNFMLI_X !GET NAME - INTEGER WNCALN !GET LENGTH OF STRING -C -C Data declarations: -C - CHARACTER*4 LUNIT !FULL UNIT NAME - CHARACTER*80 TXT !DEFINITION OF UNIT - CHARACTER*10 UNO !UNIT NUMBERS - DATA UNO/'0123456789'/ -C- - WNFMOU=.FALSE. !ASSUME ERROR - CALL WNFINI !START SYSTEM - IF (WNFTFC(MCA).NE.0) THEN !STILL FILE OPEN/MOUNTED - CALL WNFCL(MCA) !CLOSE FILE - CALL WNFDMO(MCA) !DISMOUNT FILE - END IF - LUNIT='MAG'//UNIT(1:1) !SET UNIT - IF (.NOT.WNGGVM(MCAHDL,J)) RETURN !GET MCA - CALL WNGMVZ(MCAHDL,A_B(J-A_OB)) !ZERO MCA - J1=(J-A_OB)/LB_J !DUMMY ARRAY OFFSET - A_J(J1+MCA_TID_J)=1 !INDICATE MCA - A_J(J1+MCA_SIZE_J)=MCAHDL !SET SIZE - DO I=1,LEN(ACC) !SET ACCESS - IF (ACC(I:I).EQ.'W' .OR. ACC(I:I).EQ.'w') THEN !OUTPUT - A_J(J1+MCA_BITS_J)=IOR(A_J(J1+MCA_BITS_J),MCA_M_OUT) - ELSE IF (ACC(I:I).EQ.'U' .OR. ACC(I:I).EQ.'u') THEN !UNLABELLED - A_J(J1+MCA_BITS_J)=IOR(A_J(J1+MCA_BITS_J),MCA_M_UNL) - ELSE IF (ACC(I:I).EQ.'B' .OR. ACC(I:I).EQ.'b') THEN !BLOCK MODE - A_J(J1+MCA_BITS_J)=IOR(A_J(J1+MCA_BITS_J),MCA_M_BLK) - END IF - END DO - E_C=WNFMOU_X(A_B(J-A_OB),LUNIT) !DO MOUNT - IF (IAND(E_C,1).EQ.1) THEN !QUEUE MCA - WNFMOU=.TRUE. !OK - MCA=J !RETURN MCA ADDRESS - CALL WNFLFC(MCA) !SET IN LINK LIST - ELSE - CALL WNFDMO_X(A_B(J-A_OB)) !DISMOUNT IF NECESSARY - CALL WNGFVM(MCAHDL,J) !FREE MCA - MCA=0 !MAKE SURE INDICATED - END IF -C - RETURN -C - ENTRY WNFMLI -C - WNFMLI=.TRUE. !ALWAYS SUCCESS -C - CALL WNCTXT(F_T,'!/Available tape units:') - DO I1=1,10 - LUNIT='MAG'//UNO(I1:I1) - E_C=WNFMLI_X(LUNIT,TXT,80) !GET NAME - IF (IAND(E_C,1).EQ.1) THEN - I2=WNCALN(TXT) - CALL WNCTXT(F_T,'!AS - !AS',UNO(I1:I1),TXT(:I2)) !SHOW IF FOUND - END IF - END DO - CALL WNCTXT(F_T, - 1 'D - Disk tape (files <name>.000001 etc.).!/') -C - RETURN -C - END diff --git a/src/wng/wnfmou_x.cun b/src/wng/wnfmou_x.cun deleted file mode 100644 index c1d885f4385d5ef94a55a2d67056b63fb9a9e827..0000000000000000000000000000000000000000 --- a/src/wng/wnfmou_x.cun +++ /dev/null @@ -1,170 +0,0 @@ -/*+ wnfmou_x.cun -. WNB 890724 -. -. Revisions: -. WNB 921021 Change device to environment -. WNB 921022 Change tape density check -. HjV 930521 Use first 4 characters of FNAM -. HjV 930527 Typo -. WNB 930803 Change to .cun and _o_inc -. CMV 940111 Changed ld, flag from long to int for alpha -. CMV 940204 Split off open() and read() for remote tapedrive -. CMV 940808 Add wnfmli_x to return name of unit -. CMV 940829 Correct argument for wnfmli_x -. CMV 941017 No readonly for writing tapes... -. CMV 941020 Save channel in wnftop_, do not overwrite volumelabel -. AXC 040326 Placed sys/file outside { to help Fedora builds -... */ -#include "mca_o_inc" -#include <sys/file.h> -/* -... */ - wnfmou_x_(mcap,fnam) -/* -. Mount tape for general stream/direct access I/O -. -. Result: -. -. wnfmou_x_j = wnfmou_x( MCA_J:I, FNAM_C4:I) -. -. See WRFMOU.FOR for details -. -. PIN references: -... */ -/* -. Arguments: -... */ - struct mca *mcap; /* MCA ptr */ - char *fnam; /* tape name */ -{ -/* -. Include files: -... */ -#include <stdlib.h> -#include <fcntl.h> -#include <errno.h> -#include <ctype.h> -extern int errno ; -/* -. Parameters: -... */ -/*- */ -/* -. Function references: -... */ - char *getenv(); /* get MAG environment */ - int wnftop_(); /* Open tapeunit */ - int wnftrb_(); /* Read data from tape */ -/* -. Data declarations: -... */ - int ld; /* open descriptor */ - int do_write = 0; /* open for output */ - int flg = 0; /* open flags */ - char *unit; /* tape name */ - int j; - int js; - char tmpname[5]; /* copy of FNAM */ - char tmpvol[81]; /* buffer for reading */ -/* Open tape -. */ - strncpy(tmpname,fnam,4); - tmpname[4]='\0'; - unit=getenv(tmpname); /* get tape name */ - if (unit == 0) /* unknown name */ - return(2*ENOENT); - do_write=(mcap->bits & MCA_M_OUT); /* write */ - bzero(mcap->vol, 80); /* clear Volume label */ - flg=0; /*O_RDONLY;*/ - if (do_write) flg |= O_RDWR; - else flg |= O_RDONLY; - ld=wnftop_(mcap,unit,do_write,flg); /* open */ - if (ld <= 0) - { js= 2*errno; /* cannot open */ - return(js); - } - mcap->bits |= (MCA_M_ALL | MCA_M_ASS | MCA_M_MOU); /* set open */ - js= wnftrw_(mcap); /* rewind tape */ -la: if (js == -1) /* cannot do */ - { js= 2*errno; - return(js); - } - if (!(mcap->bits & MCA_M_UNL)) /* look for label */ - { js= wnftrb_(mcap,tmpvol,80); /* read VOL */ - if (!(js == 80 & strncmp("VOL1",tmpvol,4) == 0)) - { mcap->bits |= MCA_M_UNL; /* set no label */ - } else { - memcpy(mcap->vol,tmpvol,80); /* Save label */ - } - } - js= wnftrw_(mcap); /* make sure at bot */ - j=(fnam[3]-'0')%3; /* get density */ - if (j == 0) - mcap->dens=1600; - else if (j == 1) - mcap->dens=6250; - else - mcap->dens=800; -/* Ready -. */ - return(1); /* ok */ -} -/* -. -... */ - wnfmli_x_(fnam,txt,ltxt) -/* -. Translate name of tapeunit -. -. Result: -. -. wnfmli_x_j = wnfmli_x( FNAM_C4:I, TXT_C*(*):O, LTXT_J:O ) -. -. -... */ -/* -. Arguments: -... */ - char *fnam; /* tape name */ - char *txt; /* translation */ - int *ltxt; /* length of string */ -{ -/* -. Include files: -... */ -/* -. Parameters: -... */ -/*- */ -/* -. Function references: -... */ - char *getenv(); /* get MAG environment */ -/* -. Data declarations: -... */ - char *unit; /* tape name */ - char tmpname[5]; /* copy of FNAM */ -/* Open tape -. */ - strncpy(tmpname,fnam,4); - tmpname[4]='\0'; - unit=getenv(tmpname); /* get tape name */ - if (unit == 0) /* unknown name */ - return(2*ENOENT); - strncpy(txt,unit,*ltxt); /* copy in output */ - txt[(*ltxt)-1]='\0'; /* proper termination */ - return(1); /* success */ -} - - - - - - - - - - - - diff --git a/src/wng/wnfmou_x.fvx b/src/wng/wnfmou_x.fvx deleted file mode 100644 index 1f1dbddb8cf7d5aef4e75c94b110ccae69f45adc..0000000000000000000000000000000000000000 --- a/src/wng/wnfmou_x.fvx +++ /dev/null @@ -1,203 +0,0 @@ -C+ WNFMOU_X.FVX -C WNB 930804 -C -C Revisions: -C CMV 940808 Add entry WNFMLI_X, does not work properly yet -C -C - INTEGER FUNCTION WNFMOU_X(MCAJ,UNIT) -C -C Mount tape -C -C -C Result: -C -C WNFMOU_X_J = WNFMOU_X( MCAJ_J(0:*):I, UNIT_C*:I) Mount tape -C -C WNFMLI_X_J = WNFMLI_X( UNIT_C*:I, TXT_C*:O, LTXT_J:O) Get name -C -C Include files: -C - INCLUDE 'WNG_DEF' - INCLUDE '($DVIDEF)' !GETDVI INFO - INCLUDE '($LNMDEF)' !LOGICAL NAME TRANSLATION - INCLUDE '($MNTDEF)' !MOUNT INFO - INCLUDE '($MTDEF)' !MAGNETIC TAPE DATA - INCLUDE '($IODEF)' !I/O CODES - INCLUDE '($SSDEF)' !ERROR CODES - INCLUDE '($DEVDEF)' !DEVICE INFO - INCLUDE 'MCA_O_DEF' !MCA -C -C Parameters: -C -C -C Entry-points: -C - INTEGER WNFMLI_X !LIST NAME -C -C Arguments: -C - INTEGER MCAJ(0:*) !MCA BLOCK - CHARACTER*(*) UNIT !UNIT NAME - CHARACTER*(*) UNITL ! idem WNFMLI_X - CHARACTER*(*) TXT !DESCRIPTION - INTEGER LTXT !LENGTH OF TXT -C -C Function references: -C - INTEGER SYS$TRNLNM - INTEGER SYS$ALLOC - INTEGER SYS$ASSIGN - INTEGER SYS$MOUNT - INTEGER LIB$GET_EF - INTEGER LIB$EXTZV - INTEGER SYS$GETDVIW - INTEGER WNFTRW !REWIND TAPE - INTEGER WNFTRD !READ TAPE -C -C Data declarations: -C - INTEGER TRNLST(0:3) !NAME TRANSLATION - INTEGER*2 TRNLSI(0:7) - EQUIVALENCE (TRNLST,TRNLSI) - DATA TRNLSI/0,LNM$_STRING,0,0,0,0,0,0/ - INTEGER TRNATR !TRANSLATION ATTRIBUTES - DATA TRNATR/LNM$M_CASE_BLIND/ - CHARACTER*12 TABDES !TABLE NAME - DATA TABDES/'LNM$FILE_DEV'/ - INTEGER MNTLST(0:9) !MOUNT - INTEGER*2 MNTLSI(0:19) - EQUIVALENCE (MNTLST,MNTLSI) - DATA MNTLSI/0,MNT$_DEVNAM,0,0,0,0,4,MNT$_FLAGS,0,0,0,0, - 1 4,MNT$_DENSITY,0,0,0,0,0,0/ - INTEGER MNTFLG !FLAGS - INTEGER DVILST(0:6) !DEVICE INFO - INTEGER*2 DVILSI(0:13) - EQUIVALENCE (DVILST,DVILSI) - DATA DVILSI/4,DVI$_DEVCHAR,0,0,0,0,4,DVI$_DEVDEPEND, - 1 0,0,0,0,0,0/ - INTEGER DVICHA !DEVICE CHARACTERISTICS - INTEGER DVIDEP !DEVICE DEPENDED -C- -C -C ALLOCATE UNIT -C - MCAJ(MCA_UNDES_J)=32 !MAKE UNIT DESCRIPTOR - MCAJ(MCA_UNDES_J+1)=%LOC(MCAJ)+MCA_UNIT_1 -C -C TRANSLATE LOGICAL NAME -C - TRNLSI(0)=MCAJ(MCA_UNDES_J) !STRING LENGTH - TRNLST(1)=MCAJ(MCA_UNDES_J+1) !STRING ADDRESS - TRNLST(2)=%LOC(MCAJ)+MCA_UNDES_1 !STRING DESCRIPTOR - JS=SYS$TRNLNM(TRNATR,TABDES,UNIT,,TRNLST) !TRANSLATE NAME - IF (.NOT.JS) THEN !SET ORIGINAL NAME - MCAJ(MCA_UNDES_J)=32 !RESET LENGTH - CALL WNGMFS(32,UNIT,MCAJ(MCA_UNIT_1/LB_J)) !RESET STRING - END IF -C -C ALLOCATE -C - JS=SYS$ALLOC(MCAJ(MCA_UNDES_J),,,,) !ALLOCATE - IF (IAND(JS,'0000FFFF'X).NE.SS$_DEVALRALLOC) THEN !NOT YET ALLOCATED - IF (JS) MCAJ(MCA_BITS_J)=IOR(MCAJ(MCA_BITS_J),MCA_M_ALL) !SET ALLOC. - END IF -C -C ASSIGN -C - WNFMOU_X=SYS$ASSIGN(MCAJ(MCA_UNDES_J),MCAJ(MCA_CHAN_J),,,) !ASSIGN - IF (.NOT.WNFMOU_X) GOTO 800 !ERROR - MCAJ(MCA_BITS_J)=IOR(MCAJ(MCA_BITS_J),MCA_M_ASS) !SET ASSIGNED - -C -C MOUNT -C - MCAJ(MCA_DENS_J)=1600 !DEFAULT DENSITY - MNTLST(4)=%LOC(MNTFLG) !FLAG ADDRESS - MNTLST(7)=%LOC(MCAJ)+MCA_DENS_1 !DENSITY ADDRESS - MNTLSI(0)=MCAJ(MCA_UNDES_J) !LENGTH UNIT NAME - MNTLST(1)=%LOC(MCAJ)+MCA_UNIT_1 !UNIT NAME - MNTFLG=IOR(MNT$M_FOREIGN,MNT$M_NOASSIST) !FLAGS - IF (IAND(MCAJ(MCA_BITS_J),MCA_M_OUT).EQ.0) - 1 MNTFLG=IOR(MNTFLG,MNT$M_NOWRITE) !INPUT - WNFMOU_X=SYS$MOUNT(MNTLST) !MOUNT - IF (WNFMOU_X) THEN !OK - MCAJ(MCA_BITS_J)=IOR(MCA_M_MOU,MCAJ(MCA_BITS_J)) !SET MOUNTED - ELSE - IF (IAND(WNFMOU_X,'0000FFFF'X).NE.SS$_DEVMOUNT) GOTO 800 !ERROR - END IF - WNFMOU_X=WNFTRW(MCAJ) !REWIND TAPE - IF (.NOT.WNFMOU_X) GOTO 800 - IF (IAND(MCAJ(MCA_BITS_J),MCA_M_UNL).EQ.0) THEN !MAYBE LABELED - WNFMOU_X=WNFTRD(MCAJ,MCAJ(MCA_VOL_1/LB_J)) !READ VOLUME LABEL - IF (WNFMOU_X) THEN - IF (MCAJ(MCA_VOL_1/LB_J).NE.'VOL1') - 1 MCAJ(MCA_BITS_J)=IOR(MCAJ(MCA_BITS_J),MCA_M_UNL) !FORCE NOLABEL - ELSE - MCAJ(MCA_BITS_J)=IOR(MCAJ(MCA_BITS_J),MCA_M_UNL) !FORCE NOLABEL - END IF - END IF - IF (IAND(MCAJ(MCA_BITS_J),MCA_M_UNL).NE.0) !UNLABELED - 1 CALL WNGMFS(80,' ',MCAJ(MCA_VOL_1/LB_J)) !CLEAR VOLUME LABEL - JS=WNFTRW(MCAJ) !MAKE SURE REWIND -C -C GET DEVICE INFO -C - DVILST(1)=%LOC(DVICHA) - DVILST(4)=%LOC(DVIDEP) - WNFMOU_X=SYS$GETDVIW(,%VAL(MCAJ(MCA_CHAN_J)),,DVILST, - 1 MCAJ(MCA_IOSB_J),,,) !GET DEVICE INFO - IF (.NOT.WNFMOU_X) GOTO 800 - IF (.NOT.MCAJ(MCA_IOSB_J)) THEN - WNFMOU_X=MCAJ(MCA_IOSB_J) !I/O ERROR - GOTO 800 - END IF - I=LIB$EXTZV(MT$V_DENSITY,MT$S_DENSITY,DVIDEP) !REAL DENSITY - IF (I.EQ.MT$K_PE_1600) THEN - MCAJ(MCA_DENS_J)=1600 !DENSITY - ELSE IF (I.EQ.MT$K_GCR_6250) THEN - MCAJ(MCA_DENS_J)=6259 - ELSE - MCAJ(MCA_DENS_J)=800 - END IF - WNFMOU_X=0 !ASSUME ERROR - IF (IAND(DEV$M_MNT,DVICHA).EQ.0) GOTO 800 !NOT MOUNTED - IF (IAND(DEV$M_FOR,DVICHA).EQ.0) GOTO 800 !NOT FOREIGN - IF (IAND(MT$M_HWL,DVIDEP).NE.0) THEN !WRITE LOCKED - IF (IAND(MCA_M_OUT,MCAJ(MCA_BITS_J)).NE.0) THEN !OUTPUT WANTED - MCAJ(MCA_BITS_J)= - 1 IAND(NOT(MCA_M_OUT),MCAJ(MCA_BITS_J)) !SET NO OUTPUT POSSIBLE - WNFMOU_X=SS$_WRITLCK - GOTO 800 - END IF - END IF - WNFMOU_X=SS$_NORMAL !ALL OK -C -C READY -C - 800 CONTINUE - WNFMOU_X=IAND('0000FFFF'X,WNFMOU_X) !RETURN ERROR -C - RETURN -C - ENTRY WNFMLI_X(UNITL,TXT,LTXT) -C - WNFMLI=0 !ALWAYS NOT FOUND - RETURN -C -C TRANSLATE LOGICAL NAME -C - TRNLSI(0)=LEN(TXT) !STRING LENGTH - TRNLST(1)=%LOC(TXT) !STRING ADDRESS - TRNLST(2)=%LOC(TXT) !STRING DESCRIPTOR - JS=SYS$TRNLNM(TRNATR,TABDES,UNITL,,TRNLST) !TRANSLATE NAME - IF (.NOT.JS) THEN !SET ORIGINAL NAME - WNFMLI_X=0 !NOT FOUND - ELSE - WNFMLI_X=1 !OK - END IF -C - RETURN -C -C - END diff --git a/src/wng/wnfop.for b/src/wng/wnfop.for deleted file mode 100644 index 6d34b78c17a23a31518a2e86ea8452c5700372a4..0000000000000000000000000000000000000000 --- a/src/wng/wnfop.for +++ /dev/null @@ -1,343 +0,0 @@ -C+ WNFOP.FOR -C WNB 890725 -C -C Revisions: -C WNB 920110 Error in formatting -C JPH 930414 FCA_M_WRT --> FCA_M_WRTAPE -C WNB 930811 Change L_ to LB_ -C HjV 930902 Second argument in call to WNFCL_X is missing -C CMV 940114 Save pointers in FCA_FEP and FCA_BCP -C JPH 940922 If 'U' open fails, try 'R' with a warning -C JPH 940923 Emit message only if new file (notr tested, code left in -C commented with '!!' -C JPH 941208 Undo 940922/23: Not the right solution -C -C - LOGICAL FUNCTION WNFOP(FCA,FNAM,FACC) -C -C Open file for read/write/update access -C -C Result: -C WNFOP_L = WNFOP( FCA_J:IO, FNAM_C*:I, FACC_C*:I) -C Open file FNAM for FACC access type, and return -C the address of a dynamic control area in FCA. -C Recognized access types are 'R' (read), 'W' (write), -C 'U' (update) , 'S' (sequential) and 'T' (temporary). -C S can be specified with R, W and U for sequential -C read, write with automatic read-ahead, write-behind. -C If no R, W or U is specified, R is assumed. -C T can be specified with W to indicate a temporary file -C that will be automatically deleted at close time. -C For more specifications, or for tape, use WNFOPF. -C WNFOPF_L = WNFOPF( FCA_J:IO, FNAM_C*:I, FACC_C*:I, -C NBUF_J:I, LBUF_J:I, LREC_J:I, INAL_J:I) -C The additional parameters can be specified as empty -C (0 value), in which case defaults will apply. -C NBUF specifies the number of buffers, -C LBUF the buffer length, -C LREC the record length, -C INAL specifies the initial file allocation, or -C the tape label number. -C Also FACC can contain :<text> for tape output (no <>!), -C the text will be written in HDR. If the file name -C is empty for tape, the file name will be Llllll, -C where lllll is the label number. -C On tape output the bufferlength will be an integral -C multiple of the recordsize. -C Defaults: -C NBUF 3 -C LBUF 4096(disk), 2480(tape out), 32760(tape in) -C LREC 128(disk), 80 or 128 or LBUF if not multiple. -C INAL system default(disk), begin tape (tape in), -C end tape (tape out) -C -C -C PIN references: -C -C -C Include files: -C - INCLUDE 'WNG_DEF' - INCLUDE 'MCA_O_DEF' !MCA - INCLUDE 'FCA_O_DEF' - INCLUDE 'FCQ_DEF' !FCA - INCLUDE 'FBC_O_DEF' !FBC - INCLUDE 'FEL_O_DEF' !FEL -C -C Parameters: -C -C -C Arguments: -C - INTEGER FCA !RETURNED DYNAMIC FILE AREA - CHARACTER*(*) FNAM !FILE NAME - CHARACTER*(*) FACC !FILE ACCESS TYPE - INTEGER NBUF !NUMBER OF BUFFERS TO ALLOCATE - INTEGER LBUF !LENGTH OF EACH BUFFER (BYTES) - INTEGER LREC !RECORD LENGTH - INTEGER INAL !INITIAL FILE ALLOC. (BLOCKS) - !OR TAPE LABEL # -C -C Entry points: -C - LOGICAL WNFOPF !FULL FLEDGED OPENING -C -C Function references: -C - INTEGER WNFOP_X !ACTUAL OPENING - LOGICAL WNGGVM !GET VIRTUAL MEMORY - INTEGER WNFTFC !TEST FCA PRESENT - INTEGER WNCALN - INTEGER WNGARA !LENGTH STRING -C -C Data declarations: -C - INTEGER LNBUF !LOCAL ARGUMENTS - INTEGER LLBUF - INTEGER LLREC - INTEGER LINAL - CHARACTER*21 HDRDAT,HDRDA1 !HDR2 DATA - INTEGER NDAT(12) !FOR DATE - DATA NDAT/0,31,59,90,120,151,181,212,243,273,304,334/ - CHARACTER*6 CDAT !DATE - CHARACTER*81 FNAMF !FIXED LENGTH FILE NAME - CHARACTER*80 FNMFCA ! buffer for filename from FCA - CHARACTER*10 STR - LOGICAL MSG ! 'give message' flag - INTEGER J6, J7 -C -C Equivalences: -C -C -C Commons: -C -C- -C -C SET ARGUMENTS -C - LNBUF=0 !# OF BUFFERS - LLBUF=0 !BUFFER LENGTH - LLREC=0 !RECORD LENGTH - LINAL=0 !EXTENT/TAPE LABEL - GOTO 10 -C -C WNFOPF -C - ENTRY WNFOPF(FCA,FNAM,FACC,NBUF,LBUF,LREC,INAL) -C - LNBUF=NBUF !# OF BUFFERS - LLBUF=LBUF !BUFFER LENGTH - LLREC=LREC !RECORD LENGTH - LINAL=INAL !EXTENT/TAPE LABEL - 10 CONTINUE -C -C TEST FCA -C - WNFOP=.FALSE. !ASSUME ERROR - CALL WNFINI !START SYSTEM - I0=WNFTFC(FCA) !TYPE OF BLOCK - IF (I0.NE.0) CALL WNFCL(FCA) !STILL FILE OPEN - IF (.NOT.WNGGVM(FCAHDL,J)) RETURN !GET FCA - CALL WNGMVZ(FCAHDL,A_B(J-A_OB)) !ZERO FCA - J1=(J-A_OB)/LB_J !DUMMY ARRAY OFFSET - A_J(J1+FCA_SIZE_J)=FCAHDL !SET SIZE - J2=FCA !POSSIBLE MCA ADDRESS - J3=(J2-A_OB)/LB_J !DUMMY ARRAY MCA - IF (I0.LT.0) THEN !MCA - A_J(J3+MCA_FCA_J)=J !LINK FCA - MCA - A_J(J1+FCA_MCA_J)=FCA - A_J(J1+FCA_BITS_J)=IOR(A_J(J1+FCA_BITS_J),FCA_M_MAG) !SET MAGTAPE - A_J(J1+FCA_CHAN_J)=A_J(J3+MCA_CHAN_J) !SET CHANNEL - A_J(J1+FCA_HIBLK_J)=-1 !UNLIMITED EXTEND - A_J(J1+FCA_EOF_J)=-1 !READ EOF - END IF -C -C ACCESS TYPE -C - A_J(J1+FCA_ERR_J)=1 !ASSUME NO ERROR - HDRDAT=' ' !NO HDR2 DATA - DO I=1,LEN(FACC) !SET ACCESS - IF (FACC(I:I).EQ.'W' .OR. FACC(I:I).EQ.'w') THEN !WRITE - A_J(J1+FCA_BITS_J)=IOR(A_J(J1+FCA_BITS_J),FCA_M_WRITE) - IF (I0.LT.0) THEN !TAPE - A_J(J1+FCA_BITS_J)= - 1 IOR(A_J(J1+FCA_BITS_J),FCA_M_WRTAPE) !TAPE WRITE - A_J(J1+FCA_EOF_J)=0 !TAPE OUT EOF - END IF - ELSE IF (FACC(I:I).EQ.'R' .OR. FACC(I:I).EQ.'r') THEN !READ - A_J(J1+FCA_BITS_J)=IOR(A_J(J1+FCA_BITS_J),FCA_M_OLD) - ELSE IF (FACC(I:I).EQ.'U' .OR. FACC(I:I).EQ.'u') THEN !UPDATE - A_J(J1+FCA_BITS_J)=IOR(A_J(J1+FCA_BITS_J), - 1 FCA_M_WRITE+FCA_M_OLD) - IF (I0.LT.0) THEN !TAPE - A_J(J1+FCA_BITS_J)= - 1 IOR(A_J(J1+FCA_BITS_J),FCA_M_WRTAPE) !TAPE WRITE - A_J(J1+FCA_EOF_J)=0 !TAPE OUT EOF - END IF - ELSE IF (FACC(I:I).EQ.'T' .OR. FACC(I:I).EQ.'t') THEN !TEMP - A_J(J1+FCA_BITS_J)=IOR(A_J(J1+FCA_BITS_J),FCA_M_TMP) - ELSE IF (FACC(I:I).EQ.'S' .OR. FACC(I:I).EQ.'s') THEN !SEQUENTIAL - A_J(J1+FCA_BITS_J)=IOR(A_J(J1+FCA_BITS_J),FCA_M_SEQ) - ELSE IF (FACC(I:I).EQ.':') THEN !HDR DATA - HDRDAT=FACC(I+1:) - GOTO 20 - END IF - END DO - 20 CONTINUE -C -C DEFAULTS -C - LNBUF=MIN(20,MAX(3,LNBUF)) !# OF BUFFERS - IF (LLBUF.LE.0) THEN !BUFFER LENGTH - IF (I0.LT.0) THEN !TAPE - IF (IAND(A_J(J1+FCA_BITS_J),FCA_M_WRTAPE).NE.0) THEN !TAPE WRITE - LLBUF=2840 - ELSE !TAPE READ - LLBUF=32760 - END IF - ELSE !DISK - LLBUF=4096 - END IF - END IF - LLBUF=MIN(32760,MAX(512,LLBUF)) - LLREC=MAX(0,LLREC) !RECORD LENGTH - IF (LLREC.EQ.0) THEN - IF (I0.LT.0) THEN !TAPE - IF (MOD(LLBUF,80).EQ.0) THEN - LLREC=80 - ELSE IF (MOD(LLBUF,128).EQ.0) THEN - LLREC=128 - ELSE - LLREC=LLBUF - END IF - ELSE !DISK - LLREC=128 - END IF - END IF - LLREC=MAX(32,MIN(32760,LLREC)) - LINAL=MAX(0,LINAL) !EXTENT/TAPE LABEL -C -C QUEUES -C - A_J(J1+FCA_FEA_J)=J+FCA_FEA_1 !ACTIVE ELEMENTS - A_J(J1+FCA_FEA_J+1)=J+FCA_FEA_1 - A_J(J1+FCA_FEE_J)=J+FCA_FEE_1 !EMPTY ELEMENTS - A_J(J1+FCA_FEE_J+1)=J+FCA_FEE_1 - A_J(J1+FCA_BQA_J)=J+FCA_BQA_1 !ADDRESS QUEUE - A_J(J1+FCA_BQA_J+1)=J+FCA_BQA_1 - A_J(J1+FCA_BQT_J)=J+FCA_BQT_1 !TIME QUEUE - A_J(J1+FCA_BQT_J+1)=J+FCA_BQT_1 - I=FEL__NFEL*FELHDL !LENGTH ELEMENTS - IF (.NOT.WNGGVM(I,I1)) GOTO 30 !NO MEMORY - A_J(J1+FCA_FEP_J)=I1 !SAVE POINTER - CALL WNGMVZ(I,A_B(I1-A_OB)) !EMPTY ELEMENTS - DO I=1,FEL__NFEL !ALL ELEMENTS EMPTY - I2=(I1-A_OB)/LB_J !ARRAY OFFSET - A_J(I2)=A_J(J1+FCA_FEE_J) !FORWARD LINK - A_J(I2+1)=J+FCA_FEE_1 !BACKWARD LINK - I3=A_J(J1+FCA_FEE_J)+LB_J - I3=(I3-A_OB)/LB_J - A_J(I3)=I1 - A_J(J1+FCA_FEE_J)=I1 - I1=I1+FELHDL !NEXT ENTRY - END DO - I=LNBUF*FBCHDL !LENGTH BUF CONTROL - IF (.NOT.WNGGVM(I,I1)) GOTO 30 !NO MEMORY - A_J(J1+FCA_BCP_J)=I1 !SAVE POINTER - CALL WNGMVZ(I,A_B(I1-A_OB)) !EMPTY ELEMENTS - DO I=1,LNBUF !ALL BUFFERS - I2=(I1-A_OB)/LB_J !ARRAY OFFSET ADDRESS - A_J(I2)=A_J(J1+FCA_BQA_J) !FORWARD LINK - A_J(I2+1)=J+FCA_BQA_1 !BACKWARD LINK - I3=A_J(J1+FCA_BQA_J)+LB_J - I3=(I3-A_OB)/LB_J - A_J(I3)=I1 - A_J(J1+FCA_BQA_J)=I1 - I2=I2+2 !ARRAY OFFSET TIME - I1=I1+2*LB_J !ADDRESS - A_J(I2)=A_J(J1+FCA_BQT_J) !FORWARD LINK - A_J(I2+1)=J+FCA_BQT_1 !BACKWARD LINK - I3=A_J(J1+FCA_BQT_J)+LB_J - I3=(I3-A_OB)/LB_J - A_J(I3)=I1 - A_J(J1+FCA_BQT_J)=I1 - I2=I2-2 - IF (.NOT.WNGGVM(LLBUF,I3)) GOTO 30 - A_J(I2+FBC_ADDR_J)=I3 !SET BUF ADDRESS - I1=I1+FBCHDL-2*LB_J !NEXT ENTRY - END DO - A_J(J1+FCA_BLEN_J)=LLBUF !BUFFER LENGTH - A_J(J1+FCA_FNAML_J)=FCA__FNL !FILE NAME LENGTH - CALL WNGMFS(FCA__FNL,' ',A_B(J-A_OB+FCA_FNAM_1)) !EMPTY FILE NAME -C -C TAPE HEADERS -C - IF (I0.LT.0) THEN - CALL WNGMVZ(80,A_B(J2-A_OB+MCA_HD1_1)) !CLEAR TAPE HEADERS - CALL WNGMVZ(80,A_B(J2-A_OB+MCA_HD2_1)) - IF (IAND(A_J(J1+FCA_BITS_J),FCA_M_WRTAPE).NE.0 .AND. - 1 IAND(A_J(J3+MCA_BITS_J),MCA_M_UNL) .EQ. 0) THEN !WRITE HD1,2 - CALL WNGMFS(80,'HDR1'// !HDR1(4) - 1 ' '// !FILE NAME (17*(*)) - 2 '000000'// !VOL. LABEL (6*) - 3 '0001'//'0000'// !SECTION (4), LABEL(4**) - 4 '000100'//' 99366'// !GENERATION(6), DATE(6*) - 5 ' 99365'//' '// !EXP.DATE(6), ACCESS(1) - 6 '000000'// !BLOCK CNT(6) - 7 'DWLWNB '// !SYSTEM CODE(13) - 8 ' ',A_B(J2-A_OB+MCA_HD1_1)) !RESERVED(7) - IF (FNAM.NE.' ') CALL WNGMFS(17,FNAM, !FILE NAME - 1 A_B(J2-A_OB+MCA_HD1_1+4)) - CALL WNGMV(6,A_B(J2-A_OB+MCA_VOL_1+4), !VOL. LABEL - 1 A_B(J2-A_OB+MCA_HD1_1+21)) - CALL IDATE(I2,I3,I1) !DATE - I3=I1*1000+NDAT(I2)+I3 !TAPE DATE - IF (I2.GT.2 .AND. MOD(I1,4).EQ.0) I3=I3+1 !LEAP YEAR - CALL WNCTXS(CDAT,'!6$UJ',I3) - CALL WNGMFS(6,CDAT,A_B(J2-A_OB+MCA_HD1_1+41)) !SET DATE - CALL WNGMFS(80,'HDR2'// !HDR2(4) - 1 'F'//'00000'// !FORMAT(1), BLK SIZE(5*) - 2 '00000'// !REC. LENGTH(5*) - 3 ' '// !SYSTEM INFO(21*) - 4 ' '//' B '// !FORM CTL(1), SYSTEM(13) - 5 '00'// !BUF OFFSET(2) - 6 ' ', !RESERVED(28) - 7 A_B(J2-A_OB+MCA_HD2_1)) - CALL WNCTXS(STR,'!5$UJ!5$UJ',LLBUF,LLREC) !SIZES - CALL WNGMFS(5,STR,A_B(J2-A_OB+MCA_HD2_1+5)) !BLOCK SIZE - CALL WNGMFS(5,STR(6:),A_B(J2-A_OB+MCA_HD2_1+10)) !RECORD LENGTH - IF (HDRDAT.EQ.' ') THEN !USER DATA - HDRDA1='30WESTERBORK-DWL-01' - ELSE - HDRDA1='30'//HDRDAT - END IF - CALL WNGMFS(21,HDRDA1,A_B(J2-A_OB+MCA_HD2_1+15)) !SET USER DATA - END IF - END IF -C -C DO OPEN -C - FNAMF=FNAM !MAKE SURE 80 LONG - FNAMF(81:81)=' ' !FOR C - I=WNCALN(FNAMF) - FNAMF(I+1:I+1)=CHAR(0) -C - E_C=WNFOP_X(A_B(J-A_OB),A_B(J2-A_OB),FNAMF(1:I),LLREC,LINAL) !DO OPEN - IF (IAND(E_C,1).EQ.1) THEN !QUEUE MCA - WNFOP=.TRUE. !OK - IF (I0.GE.0) THEN - FCA=J !RETURN FCA ADDRESS - CALL WNFLFC(FCA) !SET IN LINK LIST - END IF - ELSE - 30 CONTINUE - CALL WNFCL_X(A_B(J-A_OB),A_B(J2-A_OB)) !CLOSE IF NECESSARY - CALL WNGFVM(FCAHDL,J) !FREE FCA - IF (I0.GE.0) FCA=0 !MAKE SURE INDICATED - END IF -C - RETURN -C -C - END - diff --git a/src/wng/wnfop_x.cun b/src/wng/wnfop_x.cun deleted file mode 100644 index aff9c6cecb81cd39a3c42d25944ea410fc486e9c..0000000000000000000000000000000000000000 --- a/src/wng/wnfop_x.cun +++ /dev/null @@ -1,200 +0,0 @@ -/*+ wnfop_x.cun -. WNB 900107 -. -. Revisions: -. WNB 920114 Tape positioning EOT -. JPH 930414 FCA_M_WRT --> FCA_M_WRTAPE -. WNB 930803 Change to .cun and _o_inc -. CMV 940111 Changed for alpha -. CMV 940204 Split off open() and read() for remote tapedrive -. CMV 940419 Make finding end-of-tape more solid -. CMV 940822 Write protect file to avoid multiple accesses -. HjV 941107 Calculate correct label for labeled tapes -. JPH 950127 File mask 744 --> 644 (i.e. files mot executable) -... */ -#include "fca_o_inc" -#include "mca_o_inc" -#include <sys/types.h> -#include <sys/stat.h> - -/* -... */ - wnfop_x_(fcap,mcap,fnam,rlen,tlab) -/* -. Open disk/tape file for general stream/direct I/O -. -. Result: -. -. wnfop_x_j = wnfop_x ( FCA_J:I, MCA_J:I, FNAM_C80:I, RLEN_J:I, -C TLAB_J:I) -. -. See WNFOP.FOR for details -. -. PIN references: -... */ -/* -. Arguments: -... */ - struct fca *fcap; /* FCA ptr */ - struct mca *mcap; /* MCA ptr */ - char *fnam; /* filename */ -#ifdef wn_da__ - int *rlen; /* record length */ - int *tlab; /* tape label */ -#else - long *rlen; /* record length */ - long *tlab; /* tape label */ -#endif -{ -/* -. Include files: -... */ -#include <fcntl.h> -#include <sys/file.h> -#include <sys/types.h> -#include <errno.h> -#include <ctype.h> -extern int errno ; -/* -. Parameters: -... */ -/* -. Equivalences: -... */ -/* -. Commons: -... */ -/*- */ -/* -. Function references: -... */ - int wnftsf_(); /* skip tape files */ - int wnftrw_(); /* rewind tape */ - int wnftsb_(); /* skip tape block */ - int wnfttm_(); /* write tm */ - int wnftrb_(); /* read buffer */ - int wnftwb_(); /* write buffer */ -/* -. Data declarations: -... */ - int ld; /* open descriptor */ - int flg = 0; /* open flags */ - int j; - int j1; - int js; - struct stat sbuf; /* for finding mode */ -/* Open file -. */ - if (!(fcap->bits & FCA_M_MAG)) /* disk */ - { flg=0; - if (fcap->bits & FCA_M_WRITE) - flg |= O_RDWR; /* read/write */ - else - flg |= O_RDONLY; /* read only */ - if (!(fcap->bits & FCA_M_OLD)) /* new file */ - flg |= (O_CREAT | O_TRUNC); - ld=open (fnam,flg,0644); /* open file */ - if (ld <= 0) - return (2*errno); /* cannot open */ - fcap->chan = ld; /* save channel */ - fcap->bits |= (FCA_M_ACC | FCA_M_ASS); /* set accessed */ - fcap->eof = (int)lseek(fcap->chan,(off_t)0,2); - /* set start EOF */ - bcopy(fnam,fcap->fnam,80); /* save file name */ - - if (fcap->bits & FCA_M_WRITE) { - fstat(ld,&sbuf); /* find mode */ - fcap->atrj.atrj[0] = - (sbuf.st_mode & 0777); /* save mode */ - fchmod(ld,0444); /* write lock */ - } - } -/* Position tape -... */ - if (fcap->bits & FCA_M_MAG) /* tape */ - { j = *tlab; /* label to do */ - if (j <= 0) /* undefined label */ - { -/* - We try to find the last label on tape. Some tapeunit continue to - give errors once you have read behind the EOD, so we rewind after - detection of the EOD. This seems to reset the error condition -*/ - if (fcap->bits & FCA_M_WRTAPE) /* tape write */ - { while (wnftsf_(mcap,1) == 1) /* skip file */ - { mcap->magf += 1; - } - if (mcap->bits & MCA_M_UNL) /* unlabeled */ - j= mcap->magf; - else /* labeled */ - j= (mcap->magf / 3) + 1; - js = wnftrw_(mcap); /* rewind */ - if (js != 1) return(js); /* error */ - mcap->magf = 0; /* update pointer */ - } - else - j=1; /* assume start of tape */ - } - if (j == 1) /* start of tape */ - { js= wnftrw_(mcap); /* rewind */ - if (js != 1) - return(js); /* error */ - mcap->magf = 0; /* set at start */ - if (!(mcap->bits & MCA_M_UNL)) /* labeled */ - { js=wnftsb_(mcap,1); /* skip VOL1 */ - if (js != 1) - return(js); /* error */ - } - } - else /* position */ - { j1=j-1; /* proper position */ - if (!(mcap->bits & MCA_M_UNL)) /* labeled */ - j1=3*j1; - j1= j1 - mcap->magf - 1; /* to skip */ - if (j1 != 0) - { js = wnftsf_(mcap,j1); /* skip */ - if (js != 1) /* error */ - return(js); - mcap->magf += j1; /* update pointer */ - } - js= wnftsf_(mcap,1); /* final skip */ - if (js != 1) /* error */ - return(js); - mcap->magf += 1; /* update pointer */ - } - if (!(mcap->bits & MCA_M_UNL)) /* labels */ - { if (!(fcap->bits & FCA_M_WRTAPE)) /* read */ - { js = wnftrb_(mcap,mcap->hd1,80); /* read HD1 */ - if (!(js == 80 & strncmp("HDR1",mcap->hd1,4) == 0)) - return(0); /* error */ - js = wnftrb_(mcap,mcap->hd2,80); /* read HD2 */ - if (!(js == 80 & strncmp("HDR2",mcap->hd2,4) == 0)) - return(0); /* error */ - js = wnftsf_(mcap,1); /* skip tm */ - if (js != 1) - return(0); /* error */ - mcap->magf += 1; /* set position */ - } - else /* write */ - { bcopy(&mcap->vol[4],&mcap->hd1[21],6); /* set volume label*/ - /*** to fill name */ - js= wnftwb_(mcap,mcap->hd1,80); /* write header */ - if (js != 80) - return(0); - js= wnftwb_(mcap,mcap->hd2,80); /* write header */ - if (js != 80) - return(0); - js = wnfttm_(mcap); /* write tm */ - if (js != 1) - return(0); - mcap->magf += 1; /* set position */ - } - } - } -/* Ready -... */ - return(1); /* ready */ -} -/* -. -... */ diff --git a/src/wng/wnfop_x.fvx b/src/wng/wnfop_x.fvx deleted file mode 100644 index 103f4c0223902c7224acf995df31a4e99d97c8cf..0000000000000000000000000000000000000000 --- a/src/wng/wnfop_x.fvx +++ /dev/null @@ -1,310 +0,0 @@ -C+ WNFOP_X.FVX -C WNB 930804 -C -C Revisions: -C - INTEGER FUNCTION WNFOP_X(FCAJ,MCAJ,FNAM,RLEN,TAPLAB) -C -C Open file -C -C -C Result: -C -C WNFOP_X_J = WNFOP_X( FCAJ_J(0:*):I, MCAJ_J(0:*):I, FNAM_C*:I, RLEN_J:I, -C TABLAB_J:I) Open file -C -C Include files: -C - INCLUDE 'WNG_DEF' - INCLUDE '($FIBDEF)' !FIB BLOCK - INCLUDE '($FABDEF)' !FAB BLOCK - INCLUDE '($NAMDEF)' !NAM BLOCK - INCLUDE '($RABDEF)' !RAB BLOCK - INCLUDE '($SSDEF)' !ERROR CODES - INCLUDE '($IODEF)' !I/O CODES - INCLUDE 'FCA_O_DEF' !FCA - INCLUDE 'MCA_O_DEF' !MCA -C -C Parameters: -C - CHARACTER*(7) DFNAM !DEFAULT FILE NAME - PARAMETER (DFNAM='TMP.DAT') -C -C Arguments: -C - INTEGER FCAJ(0:*) !POINTER TO FCA BLOCK - INTEGER MCAJ(0:*) !MCA BLOCK - CHARACTER*(*) FNAM !FILE NAME - INTEGER RLEN !RECORD LENGTH TO USE - INTEGER TAPLAB !TAPE LABEL/INIT ALLOCATION -C -C Function references: -C - INTEGER SYS$QIOW - INTEGER SYS$CLOSE - INTEGER SYS$OPEN - INTEGER SYS$CREATE - INTEGER SYS$ASSIGN - INTEGER SYS$CONNECT - INTEGER LIB$EXTZV - INTEGER LIB$GET_EF - INTEGER WNFTWR !WRITE TAPE BLOCK - INTEGER WNFTRD !READ TAPE BLOCK - INTEGER WNFTTM !WRITE TM - INTEGER WNFTRW !REWIND TAPE - INTEGER WNFTSF !SKIP TAPE FILE - INTEGER WNFTSB !SKIP TAPE BLOCK -C -C Data declarations: -C - INTEGER ECOD !LOCAL ERROR CODE - CHARACTER*6 STR1 - INTEGER DVIDSC(0:1) !DEVICE ID DESCRIPTOR - RECORD /FABDEF/ FABLOC !LOCAL FAB - RECORD /RABDEF/ RABLOC !LOCAL RAB - RECORD /NAMDEF/ NAMLOC !LOCAL NAM -C- -C -C INIT -C - ECOD=SS$_NORMAL !ASSUME OK - IF (FIB$K_LENGTH.GT.FIB__L) THEN !CANNOT DO - ECOD=0 !ERROR - CALL WNCTXT(F_T,'VMS FIB length changed: change FCA.DSC') - GOTO 900 - END IF -C -C GET AND FILL FAB, RAB, NAM BLOCKS -C - IF (IAND(FCA_M_MAG,FCAJ(FCA_BITS_J)).EQ.0) THEN !DISK - CALL WNGMVZ(FAB$K_BLN,FABLOC) !MAKE SURE ALL EMPTY - CALL WNGMVZ(RAB$K_BLN,RABLOC) - CALL WNGMVZ(NAM$K_BLN,NAMLOC) - FABLOC.FAB$B_BID=FAB$C_BID !SET ID AND LENGTH - FABLOC.FAB$B_BLN=FAB$K_BLN - RABLOC.RAB$B_BID=RAB$C_BID - RABLOC.RAB$B_BLN=RAB$K_BLN - NAMLOC.NAM$B_BID=NAM$C_BID - NAMLOC.NAM$B_BLN=NAM$K_BLN - FABLOC.FAB$L_DNA=%LOC(DFNAM) !DEFAULT NAME - FABLOC.FAB$B_DNS=LEN(DFNAM) !AND LENGTH - FABLOC.FAB$B_FAC=FAB$M_BRO+FAB$M_GET+ - 1 FAB$M_PUT !FACILITIES - FABLOC.FAB$L_FOP=FAB$M_CBT+FAB$M_TEF+ - 1 FAB$M_WCK !FILE PROCESSING OPTIONS - FABLOC.FAB$B_ORG=FAB$C_SEQ !SEQUENTIAL - FABLOC.FAB$B_RFM=FAB$C_FIX !FIXED RECORDS - FABLOC.FAB$B_SHR=FAB$M_NIL !NO SHARE - FABLOC.FAB$L_NAM=%LOC(NAMLOC) !NAMBLK ADDRESS - FABLOC.FAB$L_ALQ=TAPLAB - FABLOC.FAB$B_FNS=LEN(FNAM) !FILE NAME LENGTH - FABLOC.FAB$L_FNA=%LOC(FNAM) !FILE NAME PTR - FABLOC.FAB$W_MRS=RLEN !MAX. RECORD SIZE - RABLOC.RAB$B_RAC=RAB$C_SEQ !ACCESS TYPE - RABLOC.RAB$L_FAB=%LOC(FABLOC) !FAB POINTER - RABLOC.RAB$W_RSZ=RLEN !RECORD SIZE - NAMLOC.NAM$B_RSS=FCA__FNL !NAME SIZE - NAMLOC.NAM$L_RSA=%LOC(FCAJ)+FCA_FNAM_1 !NAME ADDRESS -C -C CREATE/OPEN FILE -C - IF (IAND(FCA_M_OLD,FCAJ(FCA_BITS_J)).EQ.0) THEN !NEW - ECOD=SYS$CREATE(FABLOC) !CREATE FILE - ELSE !OLD - ECOD=SYS$OPEN(FABLOC) - END IF - IF (.NOT.ECOD) GOTO 900 !CANNOT OPEN/CREATE - IF (NAMLOC.NAM$B_RSS.NE.0) !FILE NAME WANTED - 1 FCAJ(FCA_FNAML_J)=NAMLOC.NAM$B_RSS - ECOD=SYS$CONNECT(RABLOC) !CONNECT FILE - IF (.NOT.ECOD) THEN !CANNOT CONNECT - JS=SYS$CLOSE(FABLOC) - GOTO 900 - END IF - ECOD=SYS$CLOSE(FABLOC) !CLOSE FILE FOR NOW - IF (.NOT.ECOD) GOTO 900 !SOME ERROR - END IF -C -C FILL FCA -C - ECOD=LIB$GET_EF(FCAJ(FCA_EF_J)) !GET EVENT FLAGS - IF (.NOT.ECOD) GOTO 900 - ECOD=LIB$GET_EF(FCAJ(FCA_EFA_J)) - IF (.NOT.ECOD) GOTO 900 - IF (IAND(FCA_M_MAG,FCAJ(FCA_BITS_J)).EQ.0) THEN !DISK - DVIDSC(0)=ICHAR(NAMLOC.NAM$T_DVI(1:1)) !LENGTH DVI - DVIDSC(1)=%LOC(NAMLOC.NAM$T_DVI)+1 !DVI STRING ADDRESS - CALL WNFOP_X0(FCAJ,FCAJ(FCA_FIBJ_J), - 1 FCAJ(FCA_ATRJ_J),NAMLOC) !FILL FIB AND ATR -C -C ASSIGN CHANNEL -C - ECOD=SYS$ASSIGN(DVIDSC, - 1 FCAJ(FCA_CHAN_J),,,) !ASSIGN CHANNEL - IF (.NOT.ECOD) GOTO 900 - FCAJ(FCA_BITS_J)=IOR(FCA_M_ASS, - 1 FCAJ(FCA_BITS_J)) !SET ASSIGNED - ECOD=SYS$QIOW(,%VAL(FCAJ(FCA_CHAN_J)), - 1 %VAL(IOR(IO$_ACCESS,IO$M_ACCESS)), - 1 FCAJ(FCA_IOSB_J),,, - 1 FCAJ(FCA_FIBDES_J),,,, - 1 FCAJ(FCA_ATRJ_J),) !ACCESS FILE - IF (.NOT.ECOD) GOTO 900 - ECOD=FCAJ(FCA_IOSB_J) !EXECUTION ERROR - IF (.NOT.ECOD) GOTO 900 - CALL LIB$INSV(A_B(%LOC(FCAJ)-A_OB+FCA_RECATR_1+FAT_HIBLKL_1), - 1 9,16,FCAJ(FCA_HIBLK_J)) !EXTEND - CALL LIB$INSV(A_B(%LOC(FCAJ)-A_OB+FCA_RECATR_1+FAT_HIBLKH_1), - 1 25,7,FCAJ(FCA_HIBLK_J)) - FCAJ(FCA_EOF_J)=LIB$EXTZV(0,9, - 1 A_B(%LOC(FCAJ)-A_OB+FCA_RECATR_1+FAT_FFBYTE_1)) !EOF BYTE - CALL LIB$INSV(A_B(%LOC(FCAJ)-A_OB+FCA_RECATR_1+FAT_EFBLKL_1), - 1 9,16,FCAJ(FCA_EOF_J)) - CALL LIB$INSV(A_B(%LOC(FCAJ)-A_OB+FCA_RECATR_1+FAT_EFBLKH_1), - 1 25,7,FCAJ(FCA_EOF_J)) - FCAJ(FCA_EOF_J)=FCAJ(FCA_EOF_J)-512 !CORRECT DISK ADDRESS - FCAJ(FCA_BITS_J)=IOR(FCAJ(FCA_BITS_J),FCA_M_ACC) !SET ACCESSED -C -C POSITION TAPE -C - ELSE !TAPE - IF (TAPLAB.LE.0) THEN !NO LABEL SPECIFIED - IF (IAND(FCAJ(FCA_BITS_J),FCA_M_WRTAPE).NE.0) THEN !GOTO EOT - 10 CONTINUE - ECOD=WNFTSF(MCAJ,300) !SKIP SOME - IF (.NOT.ECOD) THEN !ERROR - IF (ECOD.NE.SS$_ENDOFVOLUME) GOTO 900 - END IF - MCAJ(MCA_MAGF_J)= - 1 MCAJ(MCA_MAGF_J)+ - 1 A_I((%LOC(FCAJ)-A_OB)/LB_I+FCA_IOSBI_I+1) !NEW POS. - IF (ECOD.NE.SS$_ENDOFVOLUME) GOTO 10 !SKIP MORE - J=MCAJ(MCA_MAGF_J) !TAPE POSITION - IF (IAND(MCAJ(MCA_BITS_J),MCA_M_UNL).EQ.0) THEN !LABELED - J=J/3 - END IF - J=J+1 - ELSE !READ TAPE - J=1 !GOTO BOT - END IF !WRITE/READ TAPE - ELSE - J=TAPLAB !LABEL TO ACT UPON - END IF !NO LABEL - IF (J.GT.1) THEN !CAN DO - J=J-1 - IF (IAND(MCAJ(MCA_BITS_J),MCA_M_UNL).EQ.0) J=J*3 !LABELED - J=J-MCAJ(MCA_MAGF_J) !FILES TO SKIP - J=J-1 !-1 - IF (J.NE.0) THEN !NOT THERE - ECOD=WNFTSF(MCAJ,J) !GO THERE - IF (.NOT.ECOD) THEN - IF (A_I((%LOC(FCAJ)-A_OB)/LB_I+FCA_IOSBI_I+1).NE.J) GOTO 900 - END IF - END IF - MCAJ(MCA_MAGF_J)=MCAJ(MCA_MAGF_J)+J !SAVE POSITION - J=1 !1 MORE - ECOD=WNFTSF(MCAJ,J) !GO THERE - IF (.NOT.ECOD) THEN - IF (A_I((%LOC(FCAJ)-A_OB)/LB_I+FCA_IOSBI_I+1).NE.J) GOTO 900 - END IF - MCAJ(MCA_MAGF_J)=MCAJ(MCA_MAGF_J)+J !SAVE POSITION - ELSE IF (J.LT.1) THEN !ERROR - ECOD=0 - GOTO 900 - ELSE !GOTO BOT - ECOD=WNFTRW(MCAJ) !REWIND - MCAJ(MCA_MAGF_J)=0 !RESET POSITION - IF (IAND(MCAJ(MCA_BITS_J),MCA_M_UNL).EQ.0) THEN !LABELED - ECOD=WNFTSB(MCAJ,1) !SKIP VOLUME LABEL - IF (.NOT.ECOD) GOTO 900 - END IF - END IF - IF (IAND(MCAJ(MCA_BITS_J),MCA_M_UNL).EQ.0) THEN !LABELED - IF (IAND(FCAJ(FCA_BITS_J),FCA_M_WRTAPE).EQ.0) THEN !READ - ECOD=WNFTRD(MCAJ,MCAJ(MCA_HD1_1/LB_J)) !READ HDR1 - IF (.NOT.ECOD) GOTO 900 - ECOD=0 !ASSUME ERROR - IF (MCAJ(MCA_HD1_1/LB_J).NE.'HDR1') GOTO 900 - ECOD=WNFTRD(MCAJ,MCAJ(MCA_HD2_1/LB_J)) !READ HDR2 - IF (.NOT.ECOD) THEN - IF (ECOD.NE.SS$_ENDOFFILE) GOTO 900 !ACCEPT TM I.S.O HDR2 - ELSE - ECOD=0 !ASSUME ERROR - IF (MCAJ(MCA_HD2_1/LB_J).NE.'HDR2') GOTO 900 - ECOD=WNFTSF(MCAJ,1) !SKIP TAPE MARK - IF (.NOT.ECOD) GOTO 900 - END IF - MCAJ(MCA_MAGF_J)=MCAJ(MCA_MAGF_J)+1 !SAVE POSITION -C -C WRITE TAPE HEADERS -C - ELSE !WRITE - CALL WNGMV(6,A_B(%LOC(MCAJ)-A_OB+MCA_VOL_1+4), - 1 A_B(%LOC(MCAJ)-A_OB+MCA_HD1_1+21)) !VOLUME LABEL - CALL WNCTXS(STR1,'!ZJ',MCAJ(MCA_MAGF_J)/3+1) !TAPE POS. - IF (A_B(%LOC(MCAJ)-A_OB+MCA_HD1_1+4).NE.' ') THEN !NO FILE NAME - A_I((%LOC(MCAJ)-A_OB+MCA_HD1_1+4)/LB_I)='L0' !SET FILE NAME - CALL WNGMV(4,A_B(%LOC(MCAJ)-A_OB+MCA_HD1_1+31), - 1 A_B(%LOC(MCAJ)-A_OB+MCA_HD1_1+6)) - END IF - ECOD=WNFTWR(MCAJ,MCAJ(MCA_HD1_1/LB_J)) !WRITE HDR1 - IF (.NOT.ECOD) GOTO 900 - ECOD=WNFTWR(MCAJ,MCAJ(MCA_HD2_1/LB_J)) !WRITE HDR2 - IF (.NOT.ECOD) GOTO 900 - ECOD=WNFTTM(MCAJ) !WRITE TM - IF (.NOT.ECOD) GOTO 900 - MCAJ(MCA_MAGF_J)=MCAJ(MCA_MAGF_J)+1 !SAVE POSITION - END IF !READ/WRITE - END IF !LABELED - END IF !DISK/TAPE -C -C READY -C - ECOD=SS$_NORMAL !OK -C -C ERROR -C - 900 CONTINUE - WNFOP_X=IAND('0000FFFF'X,ECOD) !RETURN ERROR -C - RETURN -C -C - END -C+ -C WNFOP_X0(FCAJ,FIB,ATR,NAM) !Set ATR and FIB -C - SUBROUTINE WNFOP_X0(FCAJ,FIB,ATR,NAM) -C - INCLUDE 'WNG_DEF' - INCLUDE '($ATRDEF)' - INCLUDE '($NAMDEF)' - INCLUDE '($FIBDEF)' - INCLUDE 'FCA_O_DEF' -C - INTEGER FCAJ(0:*) - RECORD /FIBDEF/ FIB - RECORD /ATRDEF/ ATR - RECORD /NAMDEF/ NAM -C - CALL WNGMV(6,NAM.NAM$W_FID, - 1 FIB.FIB$W_FID) !SAVE FILE ID - CALL WNGMV(6,NAM.NAM$W_DID, - 1 A_B(%LOC(FCAJ)-A_OB+FCA_DID_1)) !SAVE DIR. ID - FCAJ(FCA_FIBDES_J)=FIB$K_LENGTH !SET FIB DESCRIPTOR - FCAJ(FCA_FIBDES_J+1)=%LOC(FCAJ)+FCA_FIB_1 - FIB.FIB$W_EXCTL=IOR(FIB$M_ALCONB,FIB$M_ALDEF) !EXTEND BITS - FIB.FIB$L_EXSZ=0 !# OF BLOCKS TO EXTEND BY - FIB.FIB$L_ACCTL=IOR(FIB$M_NOWRITE,FIB$M_WRITECK) !READ - IF (IAND(FCAJ(FCA_BITS_J),FCA_M_WRITE).NE.0) THEN !NOT READ ONLY - FIB.FIB$L_ACCTL=IOR(FIB.FIB$L_ACCTL, - 1 FIB$M_WRITE) !SET WRITE - END IF - ATR.ATR$W_SIZE=ATR$S_RECATTR !SET ATTRIB. CONTROL - ATR.ATR$W_TYPE=ATR$C_RECATTR !TYPE - ATR.ATR$L_ADDR=%LOC(FCAJ)+FCA_RECATR_1 !ADDR -C - RETURN -C -C - END diff --git a/src/wng/wnfsci.fsc b/src/wng/wnfsci.fsc deleted file mode 100644 index c2ba729076ff194062048cc561664d2f1c5bd687..0000000000000000000000000000000000000000 --- a/src/wng/wnfsci.fsc +++ /dev/null @@ -1,112 +0,0 @@ -C+ WNFSCI.FOR -C CMV 941012 -C -C Revisions: -C CMV 941012 Created -C CMV 941031 Pass back return string -C HjV 941107 WNFSCO: Return correct status when already open -C - INTEGER FUNCTION WNFSCI(COMMAND) -C -C Interface to Scissor qed deamon -C -C This routine will call lower level routines only for Unix systems at NFRA -C -C Result: -C -C WNFSCI_J = WNFSCI( COMMAND_C*:I ) Send command -C WNFSCO_J = WNFSCO( ) Open connection -C WNFSCC_J = WNFSCC( ) Close connection -C WNFSCS_J = WNFSCS( RETBUF_C*:O ) Get last string from server -C -C -C If (MOD(WNFSCI,100).EQ.0) the command was succesfull -C -C -C Include files: -C - INCLUDE 'WNG_DEF' -C -C Parameters: -C -C -C Arguments: -C - CHARACTER*(*) COMMAND !Command to send - CHARACTER*(*) RETBUF !String from server -C -C Entry points: -C - INTEGER WNFSCO !Open connection - INTEGER WNFSCC !Close connection - INTEGER WNFSCS !Get return string -C -C Function references: -C - INTEGER WNFSCI_X - INTEGER WNCALN -C -C Data declarations -C - LOGICAL CONNECTED !We have a connection - DATA CONNECTED/.FALSE./ - CHARACTER RETSAV*128 !Return string from server - DATA RETSAV/'Unknown'/ - SAVE CONNECTED,RETSAV -C -C- - WNFSCI=301 !Return error status -#ifdef wn_un__ -#ifdef wn_nfra__ - IF (.NOT.CONNECTED) THEN !Connect now - WNFSCI=wnfsci_x('OPEN',RETSAV) - IF (WNFSCI.NE.100) RETURN !Failed - CONNECTED=.TRUE. - ENDIF -C - WNFSCI=wnfsci_x(COMMAND(:WNCALN(COMMAND)),RETSAV) - !Call low level routine -C -#endif -#endif - RETURN -C - ENTRY WNFSCO -C - WNFSCO=301 !Return error status -#ifdef wn_un__ -#ifdef wn_nfra__ - IF (.NOT.CONNECTED) THEN !Connect now - WNFSCO=wnfsci_x('OPEN',RETSAV) - IF (WNFSCO.NE.100) RETURN !Failed - CONNECTED=.TRUE. - ELSE !Already connected - WNFSCO=100 !Assume allright - ENDIF -#endif -#endif -C - RETURN -C - ENTRY WNFSCC -C - WNFSCC=100 !Assume allright -#ifdef wn_un__ -#ifdef wn_nfra__ - IF (CONNECTED) THEN !Disconnect - WNFSCC=wnfsci_x('CLOSE',RETSAV) - CONNECTED=.FALSE. - ENDIF -#endif -#endif -C - RETURN -C - ENTRY WNFSCS(RETBUF) -C - WNFSCS=100 !Assume allright - RETBUF=RETSAV !Copy returned string -C - RETURN -C - END diff --git a/src/wng/wnfsci_x.cun b/src/wng/wnfsci_x.cun deleted file mode 100644 index b92ece1d971aac8dd56036d6a2be15a128bd1712..0000000000000000000000000000000000000000 --- a/src/wng/wnfsci_x.cun +++ /dev/null @@ -1,320 +0,0 @@ -/*+ wnfsci_x.cun -. CMV 941012 -. -. Revisions: -. CMV 941012 Created -. CMV 941031 Pass return string back -. CMV 941103 Test QEDDEBUG in wnfsci_x_ -. HJV 970103 If no SCIPWD use HELLO=anonymous:<user> iso. HELLO=<user> -. -. Provide an interface to the Scissor qed deamon -. Top level program should call this routine through WNFSCI -. -. Environment used: -. QED1 The url to the daemon (like //www.astron.nl:8083) -. SCIPWD The password of this user on the QED -. QEDDEBUG Print all server output? -. -. Result: -. WNFSCI_J = WNFSCI_X(COMMAND_C(*):I,RETBUF_C(*):O) -. -. Where command is either a command to be sent or OPEN or CLOSE. -. -... */ - -#include <stdio.h> - -static int ld=0; /* The socket connected to qed */ - -/* - The following routines are static, since they should be used only - through the wnfsci_x routine. -*/ -static int open_socket(); /* Setup connection */ -static int close_socket(); /* Close down connection */ -static int send_command(); /* Send command over connection */ - - -int wnfsci_x_(command,retbuf,len,len2) - -char *command,*retbuf; -int len,len2; - -{ - char buf[2048]; - int qeddebug; - - qeddebug=(getenv("QEDDEBUG")!=NULL); - - if (!strncmp(command,"OPEN",4)) { - - if (ld>0) close_socket(ld); - if (getenv("QED1")==NULL) return(301); /* No device, connect failed */ - ld=open_socket(getenv("QED1")); - if (ld<=0) return(301); /* No connection, failed */ - - if (getenv("SCIPWD")==NULL) { - sprintf(buf,"HELLO=anonymous:%s",getenv("USER")); - } else { - sprintf(buf,"HELLO=%s:%s",getenv("USER"),getenv("SCIPWD")); - } - return(send_command(ld,buf,retbuf,len2,qeddebug)); - - } else if (!strncmp(command,"CLOSE",5)) { - if (ld>0) close_socket(ld); /* Close and flag closed */ - ld=0; - return(100); /* Always win */ - - } else { - if (len>2047) len=2047; /* Limit to reasonable size */ - while (command[len-1]==' ') len--; /* Strip trailing spaces */ - strncpy(buf,command,len); /* Copy into buffer */ - buf[len]='\0'; /* to allow termination */ - /* Send command */ - return(send_command(ld,buf,retbuf,len2,qeddebug)); - - } -} - - -/************** CLIENT SUBROUTINES ARE BELOW *************************/ - -#include <sys/types.h> -#include <sys/socket.h> -#include <netinet/in.h> -#include <netdb.h> -#include <signal.h> -#include <errno.h> -extern int errno; - -#define LF 10 -#define CR 13 - -static unsigned int timeout=1200; /* Default timeout value */ - -static int put(); -static int get(); -static int getaline(); -static void getline_timed_out(); - -/* - Open_socket finds host and port from the url and establishes a connection -*/ - -static int open_socket(url) - -char *url; - -{ - struct hostent *gethostbyname(); - char *malloc(); - - char *p,*buf; - int port,sock,st; - struct hostent *remote; - struct sockaddr_in srv; - - sock=socket(AF_INET,SOCK_STREAM,IPPROTO_TCP); - if (sock == -1) { - fprintf(stderr,"Cannot create socket\n"); - return(sock); - } - - buf=malloc(strlen(url)); - if (buf==NULL) { - fprintf(stderr,"Cannot allocate buffer\n"); - return(-1); - } - strcpy(buf,url+2); - - for (p=buf; *p!='\0' && *p!=':'; p++); - if (*p=='\0') { - fprintf(stderr,"No port number in url string, default to 8083\n"); - port=8083; - } else { - *p='\0'; - port=atoi(p+1); - } - - remote=gethostbyname(buf); - if (remote==NULL) { - fprintf(stderr,"Cannot get host by name\n"); - st= -1; - } else { - srv.sin_family=AF_INET; - srv.sin_addr.s_addr=htonl(INADDR_ANY); - srv.sin_port=htons(port); - srv.sin_addr= *((struct in_addr *) remote->h_addr); - - st=connect(sock,&srv,sizeof(srv)); - if (st== -1) fprintf(stderr,"Cannot connect to server\n"); - else st=sock; - } - - free(buf); - return(st); -} - - - -/* - Close_socket closes the connection -*/ - -static int close_socket(socket) - -int socket; - -{ - if (socket>3) close(socket); - return(1); -} - - -/* - Send_command transfers the command string and waits for a respons - The respons is printed on stdout - The status code at the beginning of the response is returned - and retrieve an 8 characters return code. -*/ - -static int send_command(socket,command,retbuf,len,qeddebug) - -int socket,len,qeddebug; -char *command,*retbuf; - -{ - char str[2048]; - int js; - - errno=EINTR; /* Default: error */ - -/* - Check if valid socket -*/ - if (socket<3) { - fprintf(stderr,"Invalid socket\n"); - return(-1); - } - -/* - Send the string to the socket -*/ - -/* - js=write(socket,command,strlen(command)); -*/ - strncpy(str,command,2040); str[2040]='\0'; - if (str[strlen(str)-1]!='\n') strcat(str,"\n"); - js=put(socket,str,strlen(str)); - - if (js!=strlen(str)) { - fprintf(stderr,"Cannot send command on socket\n"); - return(js); - } -/* - Wait for reply -*/ - while (js>=0) { - *str='\0'; - js=getaline(str,2000,socket); - if (js<0) { - fprintf(stderr,"Cannot read qed response from socket\n"); - return(-1); - } else if (js>0) { - if (qeddebug) printf("%s\n",str); - if (str[3]!='-') js= -1; /* No more lines expected */ - } else { - fprintf(stderr,"qed: null response (ignored)\n"); /* Just CR/LF, try again */ - } - } - -/* - Return status and last line -*/ - strncpy(retbuf,str+4,len); - retbuf[len-1]='\0'; - - errno=0; - js=atoi(str); - if (js<0) js= -1; /* Should set errno as well... */ - - return( js ); -} - - -/* - The trick to catch the EINTR has been shamelessly taken from - the Gipsy routine mtiodev.c (KGB, Kapteyn Lab, Univ. of Groningen) -*/ - -static int put(socket,buf,size) - -int socket,size; -char *buf; - -{ - int left,done; - - for (left=size; left; left-=done,buf+=done) { - while ( (done=write(socket,buf,left)) == -1 && errno == EINTR); - if (done== -1) return(done); - } - return(size); -} - -static int get(socket,buf,size) - -int socket,size; -char *buf; - -{ - int left,done; - - for (left=size; left; left-=done,buf+=done) { - while ( (done=read(socket,buf,left)) == -1 && errno == EINTR); - if (done== -1) return(done); - } - return(size); -} - - -static int getaline(str,n,ld) - -char *str; -int n,ld; - -{ - int i=0, ret; - - signal(SIGALRM,getline_timed_out); - alarm(timeout); - - while (1) { - if ( (ret = read(ld,&str[i],1)) <= 0) { - /* Mmmmm, Solaris. */ - if ( (ret == -1) && (errno == EINTR)) continue; - perror("qed getaline"); - str[i] = '\0'; - return(i); - } - - /* if (str[i] == CR) read(ld,&str[i],1); */ - - if ( (str[i] == LF) || (i == (n-1))) { - alarm(0); - signal(SIGALRM,SIG_IGN); - str[i] = '\0'; - if (i==(n-1)) fprintf(stderr,"qed getaline: response too long\n"); - return(i); - } - if (str[i] != CR) ++i; - } -} - -static void getline_timed_out() - -{ - fprintf(stderr,"timed out waiting for response"); - exit(1); -} diff --git a/src/wng/wnftfc.for b/src/wng/wnftfc.for deleted file mode 100644 index aaccf794a4c532bdb275e84bc39030f32a2c40a4..0000000000000000000000000000000000000000 --- a/src/wng/wnftfc.for +++ /dev/null @@ -1,113 +0,0 @@ -C+ WNFTFC.FOR -C WNB 890724 -C -C Revisions: -C WNB 930811 Get rid of L_ -C - INTEGER FUNCTION WNFTFC(FCA) -C -C Test correct FCA -C -C Result: -C -C WNFTFC_J = WNFTFC( FCA_J:IO) Make sure FCA exists. Return values are: -C 0: FCA does not exist -C 1: FCA is disk FCA -C -1: FCA is tape MCA -C WNFLFC_J = WNFLFC( FCA_J:I) Link FCA in queue -C WNFUFC_J = WNFUFC( FCA_J:I) Unlink FCA from queue -C -C PIN references: -C -C -C Include files: -C - INCLUDE 'WNG_DEF' - INCLUDE 'FCQ_DEF' !FCA QUEUE -C -C Parameters: -C -C -C Arguments: -C - INTEGER FCA !FCA POINTER -C -C Entry points: -C - INTEGER WNFLFC !LINK FCA - INTEGER WNFUFC !UNLINK FCA -C -C Function references: -C - INTEGER WNGARA !GET ADDRESS -C -C Data declarations: -C -C -C Equivalences: -C -C -C Commons: -C -C- - WNFTFC=0 !ASSUME ERROR - IF (FCA.EQ.0) RETURN !NOT THERE - J=FCAQUE !FIRST IN LIST - DO WHILE (J.NE.0) !SCAN LIST - J1=(J-A_OB)/LB_J !DUMMY ARRAY INDEX - IF (J.EQ.FCA) THEN - IF (A_J(J1+1).EQ.0) THEN !FCA - WNFTFC=1 !INDICATE - ELSE - WNFTFC=-1 !INDICATE MCA - END IF - RETURN !READY - END IF - J=A_J(J1) !NEXT POINTER - END DO - FCA=0 !NOT FOUND -C - RETURN -C -C WNFLFC -C - ENTRY WNFLFC(FCA) !LINK FCA/MCA -C - WNFLFC=0 !ASSUME ERROR - IF (FCA.EQ.0) RETURN !NOT THERE - J1=(FCA-A_OB)/LB_J !DUMMY ARRAY INDEX - A_J(J1)=FCAQUE !LINK - FCAQUE=FCA - IF (A_J(J1+1).EQ.0) THEN !FCA - WNFLFC=1 !INDICATE - ELSE - WNFLFC=-1 !INDICATE MCA - END IF -C - RETURN -C -C WNFUFC -C - ENTRY WNFUFC(FCA) !UNLINK FCA/MCA -C - WNFUFC=0 !INDICATE UNLINKED - IF (FCA.EQ.0) RETURN !NOT THERE - J=FCAQUE !FIRST IN LIST - J2=WNGARA(FCAQUE) !WHERE TO PUT - DO WHILE (J.NE.0) !SCAN LIST - J1=(J-A_OB)/LB_J !DUMMY ARRAY INDEX - J3=(J2-A_OB)/LB_J - IF (J.EQ.FCA) THEN !FOUND - A_J(J3)=A_J(J1) !UNLINK FROM CHAIN - GOTO 10 !READY - END IF - J2=J !PREVIOUS POINTER - J=A_J(J1) !NEXT POINTER - END DO - 10 CONTINUE - FCA=0 !SET UNLINKED -C - RETURN -C -C - END diff --git a/src/wng/wnfth1.for b/src/wng/wnfth1.for deleted file mode 100644 index b7fa7714df7ee89abc44bb709c395f0c4e72ace0..0000000000000000000000000000000000000000 --- a/src/wng/wnfth1.for +++ /dev/null @@ -1,57 +0,0 @@ -C+ WNFTVL.FOR -C HjV 931202 Splitted because of HP-UX 09.01 problem -C with character entry -C -C Revisions: -C - CHARACTER*(*) FUNCTION WNFTH1(FCA) -C -C Get tape header info -C -C Result: -C WNFTH1_C80 = WNFTH1( FCA_J:I) -C Get current tape HDR1 -C -C PIN references: -C -C -C Include files: -C - INCLUDE 'WNG_DEF' - INCLUDE 'MCA_O_DEF' !MCA - INCLUDE 'FCA_O_DEF' !FCA -C -C Parameters: -C -C -C Arguments: -C - INTEGER FCA !DYNAMIC FILE AREA -C -C Entry points: -C -C -C Function references: -C - INTEGER WNFTFC !TEST FCA PRESENT -C -C Data declarations: -C -C -C Equivalences: -C -C -C Commons: -C -C- - WNFTH1=' ' !ASSUME ERROR - I0=WNFTFC(FCA) !TYPE OF BLOCK - IF (I0.GE.0) RETURN !CANNOT DO - J=FCA - J1=(J-A_OB) !DUMMY ARRAY OFFSET - CALL WNGMTS(80,A_B(J1+MCA_HD1_1),WNFTH1) !SET DATA -C - RETURN -C -C - END diff --git a/src/wng/wnfth2.for b/src/wng/wnfth2.for deleted file mode 100644 index 207a7ebec46658a71f122317b9eb98b516b32896..0000000000000000000000000000000000000000 --- a/src/wng/wnfth2.for +++ /dev/null @@ -1,57 +0,0 @@ -C+ WNFTVL.FOR -C HjV 931202 Splitted because of HP-UX 09.01 problem -C with character entry -C -C Revisions: -C - CHARACTER*(*) FUNCTION WNFTH2(FCA) -C -C Get tape header info -C -C Result: -C WNFTH2_C80 = WNFTH2( FCA_J:I) -C Get current tape HDR2 -C -C PIN references: -C -C -C Include files: -C - INCLUDE 'WNG_DEF' - INCLUDE 'MCA_O_DEF' !MCA - INCLUDE 'FCA_O_DEF' !FCA -C -C Parameters: -C -C -C Arguments: -C - INTEGER FCA !DYNAMIC FILE AREA -C -C Entry points: -C -C -C Function references: -C - INTEGER WNFTFC !TEST FCA PRESENT -C -C Data declarations: -C -C -C Equivalences: -C -C -C Commons: -C -C- - WNFTH2=' ' !ASSUME ERROR - I0=WNFTFC(FCA) !TYPE OF BLOCK - IF (I0.GE.0) RETURN !CANNOT DO - J=FCA - J1=(J-A_OB) !DUMMY ARRAY OFFSET - CALL WNGMTS(80,A_B(J1+MCA_HD2_1),WNFTH2) !SET DATA -C - RETURN -C -C - END diff --git a/src/wng/wnftrw.cun b/src/wng/wnftrw.cun deleted file mode 100644 index a102de6951ff5d1464ec7d6cb24991ef2f47cc40..0000000000000000000000000000000000000000 --- a/src/wng/wnftrw.cun +++ /dev/null @@ -1,767 +0,0 @@ -/*+ wnftrw.cun -. WNB 890724 -. -. Revisions: -. WNB 920122 Include type.h for DW -. WNB 930803 Change to _o_inc and to .cun -. CMV 940204 Remote tapeunits -. CMV 940216 Add Hello call to identify client -. CMV 941017 Add "method" like rmtd: or disk: -. WNB 090303 Put declaration before use of disk_open etc -. -... */ -#include "mca_o_inc" -#include <stdio.h> -#include <fcntl.h> -#include <sys/types.h> -#include <sys/mtio.h> -#include <sys/ioctl.h> - -#include <errno.h> -extern int errno; - -/* -. Implemented methods: -. -. tape: Ordinary mag-tape device -. rmtd: Remote mag-tape, to be handled through rmtd -. disk: Directory with files using Gipsy naming convention -. (file??????.mt with ?????? the filenumber starting at 1) -. No tape.descriptor file is maintained. -. -. -... */ - -#define MTH_TAPE 0 -#define MTH_RMTD 1 -#define MTH_DISK 2 - -#define DISK_READ 0 -#define DISK_TEST 1 -#define DISK_WRITE 2 - -#define DEBUG(x) /* x; */ - -static char tmpbuf[1024]; /* General character buffer */ - -/* -. -... */ - -/************************************************************************ - The following routine opens a (disk: type) file on disk - ************************************************************************/ - -static int disk_open(mcap,open_mode) - -struct mca *mcap; -int open_mode; - -{ - int js,flg,ii,js2; - - if (mcap->chan > 0) return(1); /* Already open */ - - if (mcap->iosb[1] <= 0) return(0); /* Beyond EOD, error */ - - sprintf(tmpbuf,"%s/file%6.6d.mt",(char *)mcap->undes[1],mcap->iosb[1]); - - if (open_mode == DISK_TEST) { - js=open(tmpbuf,O_RDONLY,0744); - if (js<0) { - sprintf(tmpbuf,"%s/f%6.6d.mt",(char *)mcap->undes[1],mcap->iosb[1]); - js=open(tmpbuf,O_RDONLY,0744); - if (js<0) { - sprintf(tmpbuf,"%s/F%6.6d.MT",(char *)mcap->undes[1],mcap->iosb[1]); - js=open (tmpbuf,O_RDONLY); - if (js<0) { - sprintf(tmpbuf,"%s/F%6.6d.MT;1",(char *)mcap->undes[1],mcap->iosb[1]); - js=open (tmpbuf,O_RDONLY); - } - } - } - if (js>0) close(js); - - } else { - flg=mcap->iosb[0]; - if (flg&O_RDWR && - open_mode==DISK_WRITE) { /* File should be created */ - flg |= O_CREAT; /* So set proper flag */ - chmod(tmpbuf,0666); /* And overwrite existing */ - - } - - js=open (tmpbuf,flg,0444); - if (js<0) { - sprintf(tmpbuf,"%s/f%6.6d.mt",(char *)mcap->undes[1],mcap->iosb[1]); - js=open(tmpbuf,flg,0744); - if (js<0) { - sprintf(tmpbuf,"%s/F%6.6d.MT",(char *)mcap->undes[1],mcap->iosb[1]); - js=open (tmpbuf,O_RDONLY); - if (js<0) { - sprintf(tmpbuf,"%s/F%6.6d.MT;1",(char *)mcap->undes[1],mcap->iosb[1]); - js=open (tmpbuf,O_RDONLY); - } - } - } - mcap->chan=js; - - if (js>0 && flg&O_CREAT) { - fchmod(js,0444); /* If created, make readonly */ - ii=mcap->iosb[1]+1; /* And delete higher labels */ - for (js2=1; js2>0; ii++) { - sprintf(tmpbuf,"%s/file%6.6d.mt",(char *)mcap->undes[1],ii); - js2=open(tmpbuf,O_RDONLY,0744); - if (js2<0) { - sprintf(tmpbuf,"%s/f%6.6d.mt",(char *)mcap->undes[1],mcap->iosb[1]); - js2=open(tmpbuf,flg,0744); - if (js2<0) { - sprintf(tmpbuf,"%s/F%6.6d.MT",(char *)mcap->undes[1],mcap->iosb[1]); - js2=open (tmpbuf,O_RDONLY); - if (js2<0) { - sprintf(tmpbuf,"%s/F%6.6d.MT;1",(char *)mcap->undes[1],mcap->iosb[1]); - js2=open (tmpbuf,O_RDONLY); - } - } - } - if (js2>0) { - fchmod(js2,0666); - close(js2); - unlink(tmpbuf); - } - } - } - } - - return(js); -} - - -/************************************************************************ - The following routines implement the client routines for rmtd transfer - ************************************************************************/ - -#include <sys/types.h> -#include <sys/socket.h> -#include <netinet/in.h> -#include <netdb.h> - -static int open_socket(unit) - -char *unit; - -{ - struct hostent *gethostbyname(); - char *malloc(); - - char *p,*buf; - int port,sock,st; - struct hostent *remote; - struct sockaddr_in srv; - - sock=socket(AF_INET,SOCK_STREAM,0); - if (sock == -1) { - fprintf(stderr,"Cannot create socket\n"); - return(sock); - } - - buf=malloc(strlen(unit)); - if (buf==NULL) { - fprintf(stderr,"Cannot allocate buffer\n"); - return(-1); - } - strcpy(buf,unit+2); - - for (p=buf; *p!='\0' && *p!=':'; p++); - if (*p=='\0') { - fprintf(stderr,"No port number in unit string, default to 8083\n"); - port=8083; - } else { - *p='\0'; - port=atoi(p+1); - } - - remote=gethostbyname(buf); - if (remote==NULL) { - fprintf(stderr,"Cannot get host by name\n"); - st= -1; - } else { - srv.sin_family=AF_INET; - srv.sin_addr.s_addr=INADDR_ANY; - srv.sin_port=htons(port); - srv.sin_addr= *((struct in_addr *) remote->h_addr); -/* - memmove( &srv.sin_addr, remote->h_addr, remote->h_length); -*/ - st=connect(sock,&srv,sizeof(srv)); - if (st== -1) fprintf(stderr,"Cannot connect to server\n"); - else st=sock; - } - - free(buf); - return(st); -} - -static int close_socket() - -{ - return(1); -} - -/* - The trick to catch the EINTR has been shamelessly taken from - the Gipsy routine mtiodev.c (KGB, Kapteyn Lab, Univ. of Groningen) -*/ - -static int put(socket,buf,size) - -int socket,size; -char *buf; - -{ - int left,done; - - for (left=size; left; left-=done,buf+=done) { - while ( (done=write(socket,buf,left)) == -1 && errno == EINTR); - if (done== -1) return(done); - } - return(size); -} - -static int get(socket,buf,size) - -int socket,size; -char *buf; - -{ - int left,done; - - for (left=size; left; left-=done,buf+=done) { - while ( (done=read(socket,buf,left)) == -1 && errno == EINTR); - if (done== -1) return(done); - } - return(size); -} - -static int send_command(socket,command,arg) - -int socket,arg; -char *command; - -{ - char str[81]; - int js; - - errno=EINTR; /* Default: error */ -/* - Check if valid socket -*/ - if (socket<3) { - fprintf(stderr,"Invalid socket\n"); - return(-1); - } -/* - Create the command string -*/ - if (strlen(command)>40) command[40]='\0'; - sprintf(str,"%-40.40s %+7.7d %30c",command,arg,'>'); -/* - Send the string to the socket -*/ - js=put(socket,str,80); - if (js!=80) { - fprintf(stderr,"Cannot send command on socket\n"); - return(js); - } -/* - Wait for reply -*/ - *str='\0'; - js=get(socket,str,8); - str[js]='\0'; /* terminate the string */ - if (js<=0) { - fprintf(stderr,"Cannot read response from socket\n"); - return(js); - } -/* - Return status -*/ - errno=0; - js=atoi(str); - if (js<0) js= -1; /* Should set errno as well... */ - return( js ); -} - -/* -... */ - int wnftrw_(mcap) -/* -. General tape handling -. -. Result: -. -. WNFTRW_J = WNFTRW( MCA_J:I) Rewind tape -. WNFTTM_J = WNFTTM( MCA_J:I) Write tape mark -. WNFTSB_J = WNFTSB( MCA_J:I, N_J:I) Skip N tape blocks -. WNFTSF_J = WNFTSF( MCA_J:I, N_J:I) Skip N tape files -. -. WNFTOP_J = WNFTOP( MCA_J:I, UNIT_C:I, FLAG_J:I) Open tapeunit -. WNFTCL_J = WNFTCL( MCA_J:I) Close tapeunit -. -. WNFTWB_J = WNFTWB( MCA_J:I, BUF_C:I, SIZE) Write buffer -. WNFTRB_J = WNFTRB( MCA_J:I, BUF_C:I, SIZE) Read buffer -. WNFTRD_J = WNFTRD( MCA_J:I, ADDR_C80:O) Read 80 character block -. WNFTWR_J = WNFTWR( MCA_J:I, ADDR_C80:O) Write 80 character block -. -. -. PIN references: -... */ -/* -. Arguments: -... */ - struct mca *mcap; /* MCA ptr */ -{ -/* -. Include files: -... */ -/* -. Parameters: -... */ -/* -. Equivalences: -... */ -/* -. Commons: -... */ -/*- */ -/* -. Function references: -... */ -/* -. Data declarations: -... */ - struct mtop mto; /* mag tape operations */ - int js; -/* Rewind tape -. */ - DEBUG(printf("Rewind\n");) - if (mcap->undes[0]==MTH_RMTD) { - js=send_command(mcap->chan,"rewind",1); - - } else if (mcap->undes[0]==MTH_DISK) { - if (mcap->chan>0) close(mcap->chan); /* Close current file */ - mcap->chan = -1; - mcap->iosb[1]=1; /* Next file is first */ - js=1; /* Always success */ - - } else { - mto.mt_count= 1; - mto.mt_op= MTREW; /* rewind */ - js=ioctl(mcap->chan,MTIOCTOP,&mto); /* do */ - } - - if (js == -1) - return(2*errno); - else - return(1); -} -/* -. Skip tape blocks -... */ - int wnftsb_(mcap,n) -/* Arguments: -. */ - struct mca *mcap; - int n; -{ -/* Data declarations: -. */ - struct mtop mto; /* mt operations */ - int js; -/* -. */ -/* -. */ - DEBUG(printf("Skip block\n");) - if (mcap->undes[0]==MTH_RMTD) { - js=send_command(mcap->chan,"block",n); - -/****** - We do not know the blocksize, however: this routine is only used to - skip the header block, which is 80 bytes - ******/ - } else if (mcap->undes[0]==MTH_DISK) { - - js=disk_open(mcap,DISK_WRITE); /* Open next file */ - if (js>0) - js=lseek(mcap->chan,(off_t)80,1); /* Offset from current */ - - } else { - mto.mt_count= abs(n); - if (n <0) - mto.mt_op= MTBSR; /* backspace */ - else if (n >0) - mto.mt_op= MTFSR; /* forward space */ - else - return(1); - js=ioctl(mcap->chan,MTIOCTOP,&mto); /* do */ - } - if (js == -1) - return(2*errno); - else - return(1); -} -/* -. Skip tape files -... */ - int wnftsf_(mcap,n) -/* Arguments: -. */ - struct mca *mcap; - int n; -{ -/* Data declarations: -. */ - struct mtop mto; /* mt operations */ - int js; -/* -. */ - DEBUG(printf("Skip file %d\n",n);) - if (mcap->undes[0]==MTH_RMTD) { - js=send_command(mcap->chan,"skip",n); - - } else if (mcap->undes[0]==MTH_DISK) { - if (mcap->chan>0) close(mcap->chan); /* Close current file */ - mcap->chan = -1; - js=1; /* Assume success */ - if (n<0) { - if (mcap->iosb[1]<0) mcap->iosb[1] *= -1; - mcap->iosb[1] +=n; /* Set next file */ - if (mcap->iosb[1]<0) mcap->iosb[1]=0; - } else if (n>0) { - if (mcap->iosb[1]==0) { /* BOT, skip always */ - mcap->iosb[1]++; /* Set next file */ - n--; /* Count this skip */ - } - while (js>0 && n>0) { - if (mcap->iosb[1]>0) { /* Not beyond EOD */ - js=disk_open (mcap,DISK_TEST); /* Try if current exists*/ - if (js>0) { /* Was there */ - mcap->iosb[1]++; /* Set next file */ - n--; /* Count this skip */ - } else { /* End of Data */ - mcap->iosb[1]++; /* Simulate final mark */ - mcap->iosb[1] *= -1; /* Flag it */ - n--; /* Count this skip */ - js=1; - } - } else { - js= -1; - } - } - } - - } else { - mto.mt_count= abs(n); - if (n <0) - mto.mt_op= MTBSF; /* backspace */ - else if (n >0) - mto.mt_op= MTFSF; /* forward space */ - else - return(1); - js=ioctl(mcap->chan,MTIOCTOP,&mto); /* do */ - } - if (js == -1) - return(2*errno); - else - return(1); -} -/* -. Write tape mark -... */ - int wnfttm_(mcap) -/* Arguments: -. */ - struct mca *mcap; -{ -/* Data declarations: -. */ - struct mtop mto; /* mt operations */ - int js; -/* -. */ - DEBUG(printf("Tapemark\n");) - if (mcap->undes[0]==MTH_RMTD) { - js=send_command(mcap->chan,"mark",0); - - } else if (mcap->undes[0]==MTH_DISK) { - if (mcap->chan>0) close(mcap->chan); /* Close current file */ - mcap->chan = -1; - mcap->iosb[1] +=1; /* Select next one */ - - } else { - mto.mt_count= 1; - mto.mt_op= MTWEOF; /* write tm */ - js=ioctl(mcap->chan,MTIOCTOP,&mto); /* do */ - } - if (js == -1) - return(2*errno); - else - return(1); -} -/* -. Read header block -... */ - int wnftrd_(mcap,ad) -/* Arguments: -. */ - struct mca *mcap; - char *ad; -{ -/* Data declarations: -. */ - int js; -/* -. */ - DEBUG(printf("Read header\n");) - if (mcap->undes[0]==MTH_RMTD) { /* Remote unit */ - js=send_command(mcap->chan,"read",80); - if (js>0) js=get(mcap->chan,ad,js); - } else if (mcap->undes[0]==MTH_DISK) { - js=disk_open(mcap,DISK_READ); - if (js>0) js=read(mcap->chan,ad,80); - } else { - js=read(mcap->chan,ad,80); - } - if (js != 80) - bzero(ad,80); /* clear header */ - if (js == -1) - return(2*errno); - else - return(1); -} -/* -. Write header block -... */ - int wnftwr_(mcap,ad) -/* Arguments: -. */ - struct mca *mcap; - char *ad; -{ -/* Data declarations: -. */ - int js; -/* -. */ - DEBUG(printf("Write header\n");) - if (mcap->undes[0]==MTH_RMTD) { /* Remote unit */ - js=send_command(mcap->chan,"write",80); - if (js>0) js=put(mcap->chan,ad,80); - } else if (mcap->undes[0]==MTH_DISK) { - js=disk_open(mcap,DISK_WRITE); - if (js>0) js=write(mcap->chan,ad,80); - } else { - js= write(mcap->chan,ad,80); - } - if (js != 80) - bzero(ad,80); /* clear header */ - if (js == -1) - return(2*errno); - else - return(1); -} -/* -. Write buffer -... */ - int wnftwb_(mcap,buf,size) -/* Arguments: -. */ - struct mca *mcap; - char *buf; - int size; -{ -/* Data declarations: -. */ - int js; -/* -. */ - DEBUG(printf("Write data %d\n",size);) - if (mcap->undes[0]==MTH_RMTD) { /* Remote unit */ - js=send_command(mcap->chan,"write",size); - if (js>0) js=put(mcap->chan,buf,js); - if (js>0) js=send_command(mcap->chan,"status",0); - } else if (mcap->undes[0]==MTH_DISK) { - js=disk_open(mcap,DISK_WRITE); - if (js>0) js=write(mcap->chan,buf,size); - } else { - js=write(mcap->chan,buf,size); - } - return(js); -} -/* -. Read buffer -... */ - int wnftrb_(mcap,buf,size) -/* Arguments: -. */ - struct mca *mcap; - char *buf; - int size; -{ -/* Data declarations: -. */ - int js; -/* -. */ - DEBUG(printf("Read data %d\n",size);) - if (mcap->undes[0]==MTH_RMTD) { /* Remote unit */ - js=send_command(mcap->chan,"read",size); - if (js>0) js=get(mcap->chan,buf,js); - } else if (mcap->undes[0]==MTH_DISK) { - if (disk_open(mcap,DISK_READ)) { - js=read(mcap->chan,buf,size); - if (js==0) { /* Emulate skip tape-mark */ - close(mcap->chan); - mcap->chan = -1; - mcap->iosb[1]++; - } - } else if (mcap->iosb[1]>=0) { /* No file == no data */ - js=0; - mcap->chan = -1; - mcap->iosb[1]++; - mcap->iosb[1] *= -1; /* Mark End of Data */ - } else { /* Already at EOD */ - js= -1; /* Error reading beyond */ - } - } else { - js=read(mcap->chan,buf,size); - } - return(js); -} -/* -. Open tapeunit -... */ - int wnftop_(mcap,unit,do_write,flg) -/* Arguments: -. */ - struct mca *mcap; - char *unit; - int do_write,flg; -{ -/* Data declarations: -. */ - int js,ii,ld; - char *dev; -/* -. -. First decode the method. To become downward compatible, we assume: -. No method and starts with single slash: tape: -. No method and starts with double slash: rmtd: -. */ - for (ii=0; unit[ii]!=':' && unit[ii]!='/' && unit[ii]!='\0'; ii++); - - if ( !strncmp(unit,"rmtd:",ii+1) || - (unit[ii]!=':' && unit[0]=='/' && unit[1]=='/')) { - mcap->undes[0]=MTH_RMTD; - } else if (!strncmp(unit,"tape:",ii+1) || - (unit[ii]!=':' && unit[0]=='/')) { - mcap->undes[0]=MTH_TAPE; - } else if ( !strncmp(unit,"disk:",ii+1) ) { - mcap->undes[0]=MTH_DISK; - } else { - return(-1); - } - - if (unit[ii]==':') dev=unit+ii+1; else dev=unit; - -/* -. Now open the device according to the specified method -. */ - - if (mcap->undes[0]==MTH_RMTD) { /* Remote unit */ - - ld=open_socket(dev); - if (ld>0) { - - ii=70; - getlogin_(tmpbuf,&ii); /* Get username and host */ - for (js=0; js<70 && tmpbuf[js]!='\0'; js++); - if (js<70) { - tmpbuf[js++]='@'; - ii=70-js; - gethost_(tmpbuf+js,&ii); - } - tmpbuf[70]='\0'; - js=send_command(ld,"Hello",strlen(tmpbuf)); - if (js>0) js=put(ld,tmpbuf,strlen(tmpbuf)); - - for (dev=dev+2; *dev!='\0' && *dev!='/'; dev++); - if (dev=='/') dev++; - if (js>0) js=send_command(ld,"Open",strlen(dev)); - if (js>0) js=put(ld,dev,strlen(dev)); - if (js>0) js=send_command(ld,"status",0); - if (js == -1) { - close_socket(ld); - ld= -1; - } - mcap->chan= ld; /* save IO channel */ - } - - } else if (mcap->undes[0]==MTH_DISK) { - - mcap->undes[1]=(int *)dev; /* Save name of directory */ - mcap->iosb[0]=flg; - mcap->iosb[1]=1; - mcap->chan= -1; /* No file open yet */ - /* Try to find volume */ - sprintf(tmpbuf,"%s/volume.mt",(char *)mcap->undes[1]); - ld=open (tmpbuf,O_RDONLY); - if (ld<0) { - sprintf(tmpbuf,"%s/VOLUME.MT",(char *)mcap->undes[1]); - ld=open (tmpbuf,O_RDONLY); - if (ld<0) { - sprintf(tmpbuf,"%s/VOLUME.MT;1",(char *)mcap->undes[1]); - ld=open (tmpbuf,O_RDONLY); - } - } - - if (ld>=0) { - strncpy(mcap->vol,"VOL1",80); /* Initialise */ - read(ld,mcap->vol+4,80); /* Read label */ - close(ld); - } - - ld=1; /* Succes so far */ - - } else { - ld=open (dev,flg,0744); - mcap->chan= ld; /* save IO channel */ - - } - return(ld); -} -/* -. Close tapeunit -... */ - int wnftcl_(mcap) -/* Arguments: -. */ - struct mca *mcap; -{ -/* Data declarations: -. */ -/* -. */ - if (mcap->undes[0]==MTH_RMTD) { /* Remote unit */ - send_command(mcap->chan,"close",NULL,0); - close_socket(mcap->chan); - } else if (mcap->undes[0]==MTH_DISK) { - if (mcap->chan>0) close(mcap->chan); - mcap->chan = -1; - } else { - close(mcap->chan); - } - return(1); -} - diff --git a/src/wng/wnftrw.fvx b/src/wng/wnftrw.fvx deleted file mode 100644 index b54663153fa3bec0fda8310882299a278ad61c3c..0000000000000000000000000000000000000000 --- a/src/wng/wnftrw.fvx +++ /dev/null @@ -1,127 +0,0 @@ -C+ WNFTRW.FVX -C WNB 930804 -C -C Revisions: -C HjV 930824 Change arguments for ISHFT-function -C - INTEGER FUNCTION WNFTRW(MCAJ) -C -C Basic tape I/O -C -C -C Result: -C -C WNFTRW_J = WNFTRW( MCAJ_J(*):I) Rewind tape -C WNFTRD_J = WNFTRD( MCAJ_J(*):I, ADDR_B(80):O) Read 80 character block -C WNFTWR_J = WNFTWR( MCAJ_J(*):I, ADDR_B(80):I) Write 80 character block -C WNFTTM_J = WNFTTM( MCAJ_J(*):I) Write tape mark -C WNFTSB_J = WNFTSB( MCAJ_J(*):I, N_J:I) Skip N tape blocks -C WNFTSF_J = WNFTSF( MCAJ_J(*):I, N_J:I) Skip N tape files -C -C Include files: -C - INCLUDE 'WNG_DEF' - INCLUDE '($IODEF)' !I/O CODES - INCLUDE 'MCA_O_DEF' !MCA -C -C Parameters: -C -C -C Arguments: -C - INTEGER MCAJ(0:*) !MCA BLOCK - INTEGER N !# OF BLOCKS/FILES - BYTE ADDR(0:*) !TAPE HEADER BLOCK -C -C Entry points: -C - INTEGER WNFTRD,WNFTWR,WNFTTM - INTEGER WNFTSB,WNFTSF -C -C Function references: -C - INTEGER SYS$QIOW -C -C Data declarations: -C - INTEGER TCOD !TAPE CODE -C- -C -C WNFTRW -C - TCOD=IO$_REWIND !REWIND CODE - GOTO 10 -C -C DO ACTION -C - 10 CONTINUE - WNFTRW=SYS$QIOW(,%VAL(MCAJ(MCA_CHAN_J)),%VAL(TCOD), - 1 MCAJ(MCA_IOSB_J),,,,,,,,) !DO ACTION - 11 CONTINUE - IF (WNFTRW) WNFTRW=MCAJ(MCA_IOSB_J) !RETURN ERROR - WNFTRW=IAND('0000FFFF'X,WNFTRW) -C - RETURN -C -C WNFTSF -C - ENTRY WNFTSF(MCAJ,N) -C - TCOD=IO$_SKIPFILE !SKIP FILE CODE - GOTO 20 -C -C ACTION -C - 20 CONTINUE - WNFTSF=SYS$QIOW(,%VAL(MCAJ(MCA_CHAN_J)),%VAL(TCOD), - 1 MCAJ(MCA_IOSB_J),,,%VAL(N),,,,,) !DO ACTION - GOTO 11 -C -C WNFTSB -C - ENTRY WNFTSB(MCAJ,N) -C - TCOD=IO$_SKIPRECORD !ACTION TO DO - GOTO 20 -C -C WNFTTM -C - ENTRY WNFTTM(MCAJ) -C - TCOD=IO$_WRITEOF - GOTO 10 -C -C WNFTRD -C - ENTRY WNFTRD(MCAJ,ADDR) -C - TCOD=IO$_READVBLK - GOTO 30 -C -C ACTION -C - 30 CONTINUE - WNFTRD=SYS$QIOW(,%VAL(MCAJ(MCA_CHAN_J)),%VAL(TCOD), - 1 MCAJ(MCA_IOSB_J),,, - 1 ADDR,%VAL(80),,,,) !DO ACTION - IF (WNFTRD) THEN !SUBMIT OK - WNFTRD=MCAJ(MCA_IOSB_J) !RETURN ERROR - IF (WNFTRD) THEN !READ/WRITE OK - IF (ISHFT(MCAJ(MCA_IOSB_J),-16).NE.80) THEN !WRONG LENGTH - WNFTRD=0 !INDICATE ERROR - END IF - END IF - END IF - WNFTRD=IAND('0000FFFF'X,WNFTRD) -C - RETURN -C -C WNFTWR -C - ENTRY WNFTWR(MCAJ,ADDR) -C - TCOD=IO$_WRITEVBLK !INDICATE WRITE - GOTO 30 !DO IT -C -C - END diff --git a/src/wng/wnftvl.for b/src/wng/wnftvl.for deleted file mode 100644 index ca5f47796999651aeb7e369910ddbed69f02b602..0000000000000000000000000000000000000000 --- a/src/wng/wnftvl.for +++ /dev/null @@ -1,58 +0,0 @@ -C+ WNFTVL.FOR -C WNB 900107 -C -C Revisions: -C HjV 931202 Splitted because of HP-UX 09.01 problem -C with character entry -C - CHARACTER*(*) FUNCTION WNFTVL(FCA) -C -C Get tape header info -C -C Result: -C WNFTVL_C80 = WNFTVL( FCA_J:I) -C Get current tape volume header -C -C PIN references: -C -C -C Include files: -C - INCLUDE 'WNG_DEF' - INCLUDE 'MCA_O_DEF' !MCA - INCLUDE 'FCA_O_DEF' !FCA -C -C Parameters: -C -C -C Arguments: -C - INTEGER FCA !DYNAMIC FILE AREA -C -C Entry points: -C -C -C Function references: -C - INTEGER WNFTFC !TEST FCA PRESENT -C -C Data declarations: -C -C -C Equivalences: -C -C -C Commons: -C -C- - WNFTVL=' ' !ASSUME ERROR - I0=WNFTFC(FCA) !TYPE OF BLOCK - IF (I0.GE.0) RETURN !CANNOT DO - J=FCA - J1=(J-A_OB) !DUMMY ARRAY OFFSET - CALL WNGMTS(80,A_B(J1+MCA_VOL_1),WNFTVL) !SET DATA -C - RETURN -C -C - END diff --git a/src/wng/wng.def b/src/wng/wng.def deleted file mode 100644 index 4a7cbe211553e0fc45358623abd0513dc7be9989..0000000000000000000000000000000000000000 --- a/src/wng/wng.def +++ /dev/null @@ -1,340 +0,0 @@ -C+ Created from wng.dsc on 970828 at 16:58:00 at daw18 -C WNG.DEF -C WNB 970828 -C -C Revisions: -C -C HJV 940217 Change data type T (remove blank line) -C WNB 931130 Add BKJY, DBKJY -C JPH 930825 Comment -C WNB 930803 Use new WNTINC options -C WNB 930727 Add T_S, LB_S, T_ALL -C WNB 930527 Add A data type -C WNB 921222 Add WSRT/ATNF longitude and latitude -C HJV 920626 Add comment for prgdat (8 = HP station) -C HJV 920501 Type of JS changed to L from J -C WNB 890427 Original version -C -C -C Given statements: -C - IMPLICIT NONE -C -C Result: -C -C WNG.DSC is a general include file. WNG_DEF (wng_inc) should be -C included as the first executable statement after the -C routine definition. In WNGLOGIN.COM an assignment to -C WNG_DEF is present, so use it as: -C INCLUDE 'WNG_DEF' -C Initialisation is done in WNGIN (via NLINK) -C -C -C Parameters: -C - DOUBLE PRECISION DPI ! PI - PARAMETER (DPI=3.1415926535897932385) - REAL PI - PARAMETER (PI=DPI) - DOUBLE PRECISION DEE ! E - PARAMETER (DEE=2.7182818284590452353) - REAL EE - PARAMETER (EE=DEE) - DOUBLE PRECISION DPI2 ! 2*PI - PARAMETER (DPI2=6.2831853071795864769) - REAL PI2 - PARAMETER (PI2=DPI2) - DOUBLE PRECISION DRAD ! PI/360 - PARAMETER (DRAD=0.0174532925199432958) - REAL RAD - PARAMETER (RAD=DRAD) - DOUBLE PRECISION DDEG ! 360/PI - PARAMETER (DDEG=57.2957795130823208768) - REAL DEG - PARAMETER (DEG=DDEG) - DOUBLE PRECISION DCRTSC ! CIRCLES TO SECONDS - PARAMETER (DCRTSC=240.*360.) - REAL RCRTSC - PARAMETER (RCRTSC=DCRTSC) - DOUBLE PRECISION DCL ! C IN M/S - PARAMETER (DCL=2.997925D8) - REAL CL - PARAMETER (CL=DCL) - DOUBLE PRECISION DBKJY ! K IN JY.M^2/K - PARAMETER (DBKJY=1380.54) - REAL BKJY - PARAMETER (BKJY=DBKJY) - REAL LATW ! LAT WSRT (DEG) - PARAMETER (LATW=52.9169) - REAL LONGW ! LONG WSRT (DEG) - PARAMETER (LONGW=6.604167) - REAL SLATW ! SIN(LAT) WSRT - PARAMETER (SLATW=0.797762) - REAL CLATW ! COS(LAT) WSRT - PARAMETER (CLATW=0.602973) - REAL LATA ! LAT ATNF (DEG) - PARAMETER (LATA=-30.31445) - REAL LONGA ! LONG ATNF (DEG) - PARAMETER (LONGA=149.566928) - REAL SLATA ! SIN(LAT) ATNF - PARAMETER (SLATA=-0.504745) - REAL CLATA ! COS(LAT) ATNF - PARAMETER (CLATA=0.863268) - REAL E2T8 ! 2**8 - PARAMETER (E2T8=2.**8) - REAL E2T16 ! 2**16 - PARAMETER (E2T16=2.**16) - REAL E2T32 ! 2**32 - PARAMETER (E2T32=2.**32) - DOUBLE PRECISION D2T16 ! 2**16 - PARAMETER (D2T16=2D0**16) - DOUBLE PRECISION D2T32 ! 2**32 - PARAMETER (D2T32=2D0**32) - INTEGER F_FILN ! # OF FILES - PARAMETER (F_FILN=16) - INTEGER F_T - ! Type BIT - ! Print BIT - ! Prefix BIT: puts a ">" - PARAMETER (F_T=1) - INTEGER F_P - PARAMETER (F_P=2) - INTEGER F_P1 - PARAMETER (F_P1=128) - INTEGER F_0 - PARAMETER (F_0=256) - INTEGER F_1 - PARAMETER (F_1=512) - INTEGER F_2 - PARAMETER (F_2=1024) - INTEGER F_3 - PARAMETER (F_3=2048) - INTEGER F_4 - PARAMETER (F_4=4096) - INTEGER F_5 - PARAMETER (F_5=8192) - INTEGER F_6 - PARAMETER (F_6=16384) - INTEGER F_7 - PARAMETER (F_7=32768) - INTEGER F_8 - PARAMETER (F_8=65536) - INTEGER F_9 - PARAMETER (F_9=131072) - INTEGER F_10 - PARAMETER (F_10=262144) - INTEGER F_11 - PARAMETER (F_11=524288) - INTEGER F_12 - PARAMETER (F_12=1048576) - INTEGER F_13 - PARAMETER (F_13=2097152) - INTEGER F_14 - PARAMETER (F_14=4194304) - INTEGER F_15 - PARAMETER (F_15=8388608) - INTEGER F__N - PARAMETER (F__N=25) - INTEGER F__L - PARAMETER (F__L=1) - INTEGER F__H - PARAMETER (F__H=8388608) - INTEGER F__I - PARAMETER (F__I=2) - INTEGER F_TP ! TYPE/PRINT BITS - PARAMETER (F_TP=3) - INTEGER F_ALL ! ALL FILE BITS - PARAMETER (F_ALL=-F_0+F_15+F_15+F_TP) - INTEGER F_NO ! NO DISPOSITION - PARAMETER (F_NO=0) - INTEGER F_YES ! KEEP FILE - PARAMETER (F_YES=1) - INTEGER F_SP ! SPOOL FILE - PARAMETER (F_SP=2) - INTEGER F_CAT ! CONCATENATE FILE - PARAMETER (F_CAT=3) - INTEGER F_LC ! LINE COUNT CODE - PARAMETER (F_LC=1) - INTEGER F_PC ! PAGE COUNT CODE - PARAMETER (F_PC=2) - INTEGER F_LL ! LINE LENGTH CODE - PARAMETER (F_LL=3) - INTEGER F_PL ! PAGE LENGTH CODE - PARAMETER (F_PL=4) - INTEGER F_DIS ! DISPOSITION CODE - PARAMETER (F_DIS=5) - INTEGER*2 IUND ! UNDEFINED WSRT VALUE - PARAMETER (IUND=-32768) - INTEGER DWC_ENDOFLOOP ! ^Z PARAMETER REPLY - PARAMETER (DWC_ENDOFLOOP=134448144) - INTEGER DWC_NULLVALUE ! "" PARAMETER REPLY - PARAMETER (DWC_NULLVALUE=134448161) - INTEGER DWC_WILDCARD ! * PARAMETER REPLY - PARAMETER (DWC_WILDCARD=134448169) - INTEGER L_B ! LENGTH IN BITS OF - ! DATA TYPES - PARAMETER (L_B=8) - INTEGER L_C - PARAMETER (L_C=8) - INTEGER L_L - PARAMETER (L_L=32) - INTEGER L_I - PARAMETER (L_I=16) - INTEGER L_J - PARAMETER (L_J=32) - INTEGER L_K - PARAMETER (L_K=32) - INTEGER L_E - PARAMETER (L_E=32) - INTEGER L_D - PARAMETER (L_D=64) - INTEGER L_X - PARAMETER (L_X=64) - INTEGER L_Y - PARAMETER (L_Y=128) - INTEGER L_A - PARAMETER (L_A=16) - INTEGER L_S - PARAMETER (L_S=8) - INTEGER L__N - PARAMETER (L__N=13) - INTEGER LB_B ! LENGTH IN BYTES OF - ! DATA TYPES - PARAMETER (LB_B=1) - INTEGER LB_C - PARAMETER (LB_C=1) - INTEGER LB_L - PARAMETER (LB_L=4) - INTEGER LB_I - PARAMETER (LB_I=2) - INTEGER LB_J - PARAMETER (LB_J=4) - INTEGER LB_K - PARAMETER (LB_K=4) - INTEGER LB_E - PARAMETER (LB_E=4) - INTEGER LB_D - PARAMETER (LB_D=8) - INTEGER LB_X - PARAMETER (LB_X=8) - INTEGER LB_Y - PARAMETER (LB_Y=16) - INTEGER LB_A - PARAMETER (LB_A=2) - INTEGER LB_S - PARAMETER (LB_S=1) - INTEGER LB__N - PARAMETER (LB__N=13) - INTEGER T_B ! TYPE CODES OF - PARAMETER (T_B=1) - INTEGER T_C - PARAMETER (T_C=2) - INTEGER T_L - PARAMETER (T_L=3) - INTEGER T_I - PARAMETER (T_I=4) - INTEGER T_J - PARAMETER (T_J=5) - INTEGER T_K - PARAMETER (T_K=6) - INTEGER T_E - PARAMETER (T_E=7) - INTEGER T_D - PARAMETER (T_D=8) - INTEGER T_X - PARAMETER (T_X=9) - INTEGER T_Y - PARAMETER (T_Y=10) - INTEGER T_A - PARAMETER (T_A=11) - INTEGER T_S - PARAMETER (T_S=12) - INTEGER T__N - PARAMETER (T__N=13) - INTEGER T__L - PARAMETER (T__L=1) - INTEGER T__H - PARAMETER (T__H=12) - INTEGER T__I - PARAMETER (T__I=1) - CHARACTER*12 T_ALL ! KNOWN DATA TYPES - PARAMETER (T_ALL='BCLIJKEDXYAS') -C -C Data declarations: -C - INTEGER J ! POINTERS - INTEGER J0 - INTEGER J1 - INTEGER J2 - INTEGER J3 - INTEGER J4 - INTEGER J5 - INTEGER I ! LOOPS - INTEGER I0 - INTEGER I1 - INTEGER I2 - INTEGER I3 - INTEGER I4 - INTEGER I5 - LOGICAL JS ! ERROR - REAL R0 ! SOME HELP - REAL R1 - DOUBLE PRECISION D0 - DOUBLE PRECISION D1 - LOGICAL L0 - LOGICAL L1 - BYTE B0 - BYTE B1 -C -C WNG common data: -C - DOUBLE COMPLEX A_Y(0:0) ! DUMMY ARRAYS - BYTE A_B(0:0) - EQUIVALENCE (A_B,A_Y) - INTEGER*2 A_I(0:0) - EQUIVALENCE (A_I,A_Y) - INTEGER A_J(0:0) - EQUIVALENCE (A_J,A_Y) - INTEGER*4 A_K(0:0) - EQUIVALENCE (A_K,A_Y) - LOGICAL A_L(0:0) - EQUIVALENCE (A_L,A_Y) - REAL A_E(0:0) - EQUIVALENCE (A_E,A_Y) - DOUBLE PRECISION A_D(0:0) - EQUIVALENCE (A_D,A_Y) - COMPLEX A_X(0:0) - EQUIVALENCE (A_X,A_Y) - INTEGER E_C ! MOST RECENT ERROR CODE - INTEGER A_OB ! ARRAY OFFSETS - INTEGER A_OI - INTEGER A_OJ - INTEGER A_OK - INTEGER A_OL - INTEGER A_OE - INTEGER A_OD - INTEGER A_OX - INTEGER A_OY - INTEGER LOGCD ! LOG CODE - INTEGER PRGDAT ! DATA TYPE - ! 1= VAX, D_FORMAT - ! 2= VAX, G_FORMAT - ! 3= ALLIANT - ! 4= CONVEX - ! 5= IEEE - ! 6= DEC station - ! 7= SUN station - ! 8= HP station - CHARACTER*9 PRGNAM ! PROGRAM NAME - CHARACTER*6 PRGVER ! PROGRAM VERSION -C -C WNG common block: -C - COMMON /WNG_COM/ A_Y,E_C,A_OB,A_OI, - 1 A_OJ,A_OK,A_OL,A_OE, - 1 A_OD,A_OX,A_OY,LOGCD, - 1 PRGDAT,PRGNAM,PRGVER -C -C Given statements: -C -C- diff --git a/src/wng/wng.dsc b/src/wng/wng.dsc deleted file mode 100644 index 0cecd667f0bfd1b982a9ac5bfa4048f32a2e4b7c..0000000000000000000000000000000000000000 --- a/src/wng/wng.dsc +++ /dev/null @@ -1,175 +0,0 @@ -!+ WNG.DSC -! WNB 890427 -! -! Revisions: -! -%REVISION=HjV=940217="Change data type T (remove blank line)" -%REVISION=WNB=931130="Add BKJY, DBKJY" -%REVISION=JPH=930825="Comment" -%REVISION=WNB=930803="Use new WNTINC options" -%REVISION=WNB=930727="Add T_S, LB_S, T_ALL" -%REVISION=WNB=930527="Add A data type" -%REVISION=WNB=921222="Add WSRT/ATNF longitude and latitude" -%REVISION=HJV=920626="Add comment for prgdat (8 = HP station)" -%REVISION=HJV=920501="Type of JS changed to L from J" -%REVISION=WNB=890427="Original version" -! -! Layout of overall include file (WNG_DEF) -! -%COMMENT=" WNG.DSC is a general include file. WNG_DEF (wng_inc) should be" -%COMMENT=" included as the first executable statement after the" -%COMMENT=" routine definition. In WNGLOGIN.COM an assignment to" -%COMMENT=" WNG_DEF is present, so use it as:" -%COMMENT=" INCLUDE 'WNG_DEF'" -%COMMENT=" Initialisation is done in WNGIN (via NLINK)" -! -%LOCAL=NFILE=16 !# OF ASCII FILES, CHANGE ALSO IN WNC.DSC -%LOCAL=FYES=1 !DISPOSITION, CHANGE ALSO IN WNC.DSC -%VERSION=1 -%SYSTEM=1 -%USER=WNB -%%DATE -%%NAME -! -%FORTRAN=IMPLICIT NONE -!- -.DEFINE - .PARAMETER -! -! Mathematical -! - DPI D /3.1415926535897932385/ !PI - PI E /DPI/ - DEE D /2.7182818284590452353/ !E - EE E /DEE/ - DPI2 D /6.2831853071795864769/ !2*PI - PI2 E /DPI2/ - DRAD D /0.0174532925199432958/ !PI/360 - RAD E /DRAD/ - DDEG D /57.2957795130823208768/ !360/PI - DEG E /DDEG/ - DCRTSC D /240.*360./ !CIRCLES TO SECONDS - RCRTSC E /DCRTSC/ - DCL D /2.997925D8/ !C IN M/S - CL E /DCL/ - DBKJY D /1380.54/ !K IN JY.M^2/K - BKJY E /DBKJY/ - LATW E /52.9169/ !LAT WSRT (DEG) - LONGW E /6.604167/ !LONG WSRT (DEG) - SLATW E /0.797762/ !SIN(LAT) WSRT - CLATW E /0.602973/ !COS(LAT) WSRT - LATA E /-30.31445/ !LAT ATNF (DEG) - LONGA E /149.566928/ !LONG ATNF (DEG) - SLATA E /-0.504745/ !SIN(LAT) ATNF - CLATA E /0.863268/ !COS(LAT) ATNF - E2T8 E /2.**8/ !2**8 - E2T16 E /2.**16/ !2**16 - E2T32 E /2.**32/ !2**32 - D2T16 D /2D0**16/ !2**16 - D2T32 D /2D0**32/ !2**32 -! -! ASCII files: -! - F_FILN J /NFILE/ !# OF FILES - F M: /T,P,,,,,,P1,0,1,2,3,4,5,6,7,8, \ - 9,10,11,12,13,14,15/ !Type BIT - !Print BIT - !Prefix BIT: puts a ">" -! in column 1 (which by default is blank) -! of output text - - !FILE 0-15 BITS - F_TP J /F_T+F_P/ !TYPE/PRINT BITS - F_ALL J /-F_0+F_15+F_15+F_TP/ !ALL FILE BITS -! - F_NO J /0/ !NO DISPOSITION - F_YES J /FYES/ !KEEP FILE - F_SP J /2/ !SPOOL FILE - F_CAT J /3/ !CONCATENATE FILE -! - F_LC J /1/ !LINE COUNT CODE - F_PC J /2/ !PAGE COUNT CODE - F_LL J /3/ !LINE LENGTH CODE - F_PL J /4/ !PAGE LENGTH CODE - F_DIS J /5/ !DISPOSITION CODE -! -! Special: -! - IUND I /-32768/ !UNDEFINED WSRT VALUE -! -! Explicitly used DWARF error codes -! - DWC_ENDOFLOOP J /134448144/ !^Z PARAMETER REPLY - DWC_NULLVALUE J /134448161/ !"" PARAMETER REPLY - DWC_WILDCARD J /134448169/ !* PARAMETER REPLY -! -! Data types: -! - L N:(8,8,32,16,32,32,32,64,64,128,16,8) \ !LENGTH IN BITS OF - /B,C,L,I,J,K,E,D,X,Y,A,S/ ! DATA TYPES - LB N:(1,1,4,2,4,4,4,8,8,16,2,1) \ !LENGTH IN BYTES OF - /B,C,L,I,J,K,E,D,X,Y,A,S/ ! DATA TYPES - T A: /B,C,L,I,J,K,E,D,X,Y,A,S/ !TYPE CODES OF -! DATA TYPES - T_ALL C12 /BCLIJKEDXYAS/ !KNOWN DATA TYPES -! - .DATA -! -! Local variables: -! - J J !POINTERS - J0 J - J1 J - J2 J - J3 J - J4 J - J5 J - I J !LOOPS - I0 J - I1 J - I2 J - I3 J - I4 J - I5 J - JS L !ERROR - R0 E !SOME HELP - R1 E - D0 D - D1 D - L0 L - L1 L - B0 B - B1 B - .COMMON - A_Y Y(0:0) !DUMMY ARRAYS - A_B=A_Y B(0:0) - A_I=A_Y I(0:0) - A_J=A_Y J(0:0) - A_K=A_Y K(0:0) - A_L=A_Y L(0:0) - A_E=A_Y E(0:0) - A_D=A_Y D(0:0) - A_X=A_Y X(0:0) - E_C J !MOST RECENT ERROR CODE - A_OB J !ARRAY OFFSETS - A_OI J - A_OJ J - A_OK J - A_OL J - A_OE J - A_OD J - A_OX J - A_OY J - LOGCD J !LOG CODE - PRGDAT J !DATA TYPE - ! 1= VAX, D_FORMAT - ! 2= VAX, G_FORMAT - ! 3= ALLIANT - ! 4= CONVEX - ! 5= IEEE - ! 6= DEC station - ! 7= SUN station - ! 8= HP station - PRGNAM C9 !PROGRAM NAME - PRGVER C6 !PROGRAM VERSION -.END diff --git a/src/wng/wng.grp b/src/wng/wng.grp deleted file mode 100644 index 1bc18c7c48348fdbd23301f7b6c231b8674259cc..0000000000000000000000000000000000000000 --- a/src/wng/wng.grp +++ /dev/null @@ -1,224 +0,0 @@ -!+ WNG.GRP -! WNB 880725 -! -! Revisions: -! WNB 910820 Add WNGSXH_BD -! WNB 910826 Add WNGEX0, WXH -! WNB 910909 Add WNGIN1 -! WNB 911105 Add .SDW, .FDW -! WNB 920127 Add .SSW, WNGLDEF, LOGIN/OUT masks, DO_* -! WNB 920128 Add all SW -! HJV 920407 Add WNGSWQ -! HJV 920525 Add HP -! HJV 920708 Add WNGSIG.CHP, WNGQUE.CHP, WNGQSR.CHP, -! WNGTIM.CHP, WNGEXI.CHP, WNGSYS.CHP -! WNB 920914 Change *login, *cshrc, nxec files -! WNB 921006 Change *login, *cshrc, nxec files for VMS -! WNB 921117 Add NBUILD, NTARZ, NUPD, README, QUEST -! WNB 921204 Add RAIUB -! WNB 921209 Add NXLDEF, NXCLUP; delete WNGLDEF -! WNB 921211 Add NXPIN -! WNB 921215 Add NXFOR -! WNB 921215 FSC: WNGASA, WNGLUN, WNGSYT, WNGSXH -! CUN: WNGCST -! WNB 921216 FSC: WNGSSP -! FUN: WNGSRT, WNGARL CUN: WNGARG -! WNB 921222 SSC: WNGFEX -! WNB 921224 SSC: NTARZ NBUILD NUPD NXCLUP NXUP WNXCSHRC WNGCSHRC* -! HjV 921229 FSC: WNGSXH (not correct done on 921216) -! WNB 921230 SSC: NGET, NDEL, NNET, NHELP, NXFOR, NXPIN, NLINK, -! NCOMP, NXEC -! WNB 921231 Remove DO_WNG and WNGDEF.GRP; add NREDO -! HjV 930107 Put WNGARG.MAL after WNGARG.CUN -! HjV 930120 Add WNGCSHRC_WSRT.SSC -! HjV 930222 Remove WNGQUE.CHP, Add WNGCSHRC_WSRT.SUN -! WNB 930330 Add GAWK.xvx GIPLIB.adw, asw, acv -! WNB 930331 Replace all System Dummy Interfaces with WNGSDI.CUN -! (wngsig, wngexi, wngqsr, wngtim, wngsys.chp) -! Add WNGSEG, WNGSEU, WNGSES -! WNB 930414 Add WNGSGH; add GIDS.X.. -! HjV 930419 Add UNIX-size for external executables and object-libs -! WNB 930429 Change size giplib.asw -! HjV 930503 Change size gids.xhp -! HjV 930513 Change size gids.xhp and giplib.asw -! WNB 930526 Add WNGSGU and GETLOGIN_ -! HjV 930630 Add WNGCSHRC_KOSMA.SSC, -! change WNGCSHRC_WSRT.SUN into WNGCSHRC_WSRT.SSC -! HjV 930817 Add NXMAIN.SSC -! WNB 930818 Add WNGSQI, SQR; change WNGARG into FVX -! HjV 930914 Add ARECB -! WNB 931029 Add WNGSWS, WNGSWM -! CMV 940218 Removed 8.x??, .a?? and nnews etc for fourth time -! CMV 940218 Changed wnggvm.cee to .cun -! HjV 940516 Remove file which don't exist in WNG directory anymore -! HjV 941107 Add WNGMED -! HjV 950210 Add WNGU2S -! HjV 950216 Add WNGCC -! HjV 960422 Add WNGSST -! HjV 960625 Remove WNGSST (is now NPLSST in nplot-directory) -! WNGGVM.CEE renamed to WNGGVM.CUN -! HjV 970613 Add WNGSLP -! -! General routines for WNB programs -! -! Group definition: -! -WNG.GRP -! -! General command files -! -LOGIN_MASK.SUN ! UNIX .login mask - CSHRC_MASK.SUN - LOGIN_MASK.COM -LOGOUT_MASK.SUN ! UNIX .logout mask - LOGOUT_MASK.COM -WNGLOGIN.SUN ! Assignments - WNXLOGIN.COM - WNGCSHRC_NFRA.SSC - WNGCSHRC_ATNF.SSC - WNGCSHRC_RUG.SSC - WNGCSHRC_RAIUB.SSC - WNGCSHRC_WSRT.SSC - WNGCSHRC_KOSMA.SSC - WNGCSHRC_ARECB.SSC - WNGCSHRC.SSC - WNXCSHRC.SSC -NXEC.SSC ! Compile, link, maintain WN files - NCOMP.SSC ! Compile - NDEL.SSC ! Delete - NLINK.SSC ! Link - NGET.SSC ! Get from text library - NNET.SSC ! Get across net - NHELP.SSC ! Help text - NXANAL.SUN ! Analyse codes - NXPIN.SSC ! Make PIN from PSC - NXFOR.SSC ! Make FOR, SUN/COM from FSC, SSC - NXUP.SSC ! Update in DWARF system -NXLDEF.COM ! Logical assigns include files - NXLDEF.SUN -NXMAIN.SSC ! Build new system - NBUILD.SSC ! Build new system from export - NTARZ.SSC ! Build export files - NUPD.SSC ! Update Newstar across net - NREDO.SSC ! Rebuild Newstar from files/libraries - NXCLUP.SSC ! Cleanup system -WNGFEX.SSC ! File handling -DWEXE.COM ! Startup routine for Newstar on VAX -EDTINI.COM ! For EDT -! -! Initialisation command files -! -! -! Fortran definition files: -! -WNG.DSC ! General INCLUDE file -WXH.DSC ! Exit handler include file -! -! Programs: -! -TWNG.FOR ! Test structure -WNGANG.FOR ! Normalise and convert angles - ! Positive means: 0<=angle<360 - ! Negative means: -180<angle<=+180 - ! (or in radians or fractions) - !WNGDPD Double(D) or Real(E) - ! ENR Positive(P) or Negative(N) - ! F Degrees(D), Radians(R) or Fractions(F) - !WNGDDF Conversion of Double(D) or Real(E) - ! ER Degrees(D) or Radians(R) to positive - ! Fractions(F) - !WNGDFD Conversion of Double(D) or Real(E) - ! E R Fractions(F) to positive Degrees(D) or - ! Radians(R) -WNGARG.FVX !WNGARG Address of call list (VX, AL) - WNGARG.CUN !WNGART Test argument presence (VX, AL) - WNGARG.MAL !WNGARN Number of arguments (VX, AL) - WNGARG_X.MVX !WNGARQ Internal call transfer (VX, AL) - !WNGARA Get address variable - !WNGAD1 Dummy (AL) -WNGARI.FOR !WNGARI Get I from argument list - !WNGARJ Get J from argument list - !WNGARK Get K from argument list -WNGARL.FVX !WNGARL Make argument list (VX, AL) - WNGARL.FUN !WNGARX Transfer call using arg. list - !WNGARF Force # of arguments (VX, AL) -WNGASA.FSC !WNGASA Get string address from arg. list - !WNGASL Get string length from arg. list -WNGCC.FOR !WNGCCD Inhibit control-C interrupts - !WNGCCE Enable control-C interrupts - !WNGCCC Return .TRUE. if control-C seen, else .FALSE. -WNGCST.FVX !WNGCST Get computing statistics - WNGCST.CUN !WNGCS0 Re-init computing statistics -WNGEX.FOR !WNGEX Finish program - !WNGEX0 Unix ^C exit handler -WNGGVA.FOR !WNGGVA Get aligned virtual memory - !WNGFVA Free aligned virtual memory -WNGGVL.FOR !WNGGB Get B from address - !WNGGI Get I from address - !WNGGJ Get J from address - !WNGGK Get K from address - !WNGGE Get E from address - !WNGGD Get D from address -WNGGVM.FVX !WNGGVM Get virtual memory - WNGGVM.CUN !WNGFVM Free virtual memory -WNGIN.FOR !WNGIN Initialise program - !WNGIN1 For "other" users -WNGLUN.FSC !WNGLUN Get a Fortran logical unit number - !WNGLUF Free a Fortran logcal unit number -WNGMED.FSC !WNGMED Add label to MEDIAD (volume to VOLUMES) -WNGMV.FOR !WNGMV Move a field - !WNGMVZ Fill field with zeroes - !WNGMVB Fill field with spaces - !WNGMVF Fill field with fill character - !WNGMVS Move field with byte swap - !WNGMFS Move from string to field - !WNGMTS Move from field to string - !WNGMF0 Move from ASCIZ to string - !WNGMT0 Move from string to ASCIZ -WNGSDI.CUN ! System Dummy Interface to C - !FTN_EXIT exit (HP only) - !FTN_SYSTEM system (HP only) - !SIGNAL_ signal (HP only) - !QSORT_ qsort (HP only) - !CTIME_ ctime (HP only) - !TIME_ time (HP only) - !GETENV_ getenv (HP only) - !SETENV_ setenv - !UNSETENV_ unsetenv - !GETHOST_ gethost - !GETLOGIN_ getlogin - !TFLUSH_ flush standard output - !FIND_NODE_ get directory list -WNGSDL.FSC !WNGSDL Get directory list -WNGSEG.FSC !WNGSEG Get environment/logname value -WNGSES.FSC !WNGSES Set environment/logname value -WNGSEU.FSC !WNGSEU Delete environment/logname -WNGSGH.FSC !WNGSGH Get hostname -WNGSGU.FSC !WNGSGU Get username -WNGSLP.CUN !WNGSLP Sleep some time -WNGSQI.FVX !WNGSQI Insert in absolute queue - !WNGSQR Remove from absolute queue -WNGSRT.FVX !WNGSRT Sort a memory buffer - WNGSRT.FUN -WNGSSP.FSC !WNGSSP Spawn a sub-process -WNGSWB.FOR !WNGSWB Swap bytes in I word - !WNGSWI Swap I words in J longword - !WNGSWJ Reverse byte order in J longword - !WNGSWQ Reverse byte order in D longword -WNGSWS.FVX !WNGSWS Wait seconds - WNGSWS.CUN !WNGSWM Wait milliseconds -WNGSXH.FSC !WNGSXH Declare an exit handler - !WNGSXF Cancel exit handler - !WNGSXX Do exit handlers - !WNGSCC Set ^C handler -WNGSYT.FSC !WNGSYT Get sytem date and time - !TIME Get date/time -WNGU2S.FOR !WNGU2S Convert ST <--> UT - !WNGJVS Sidereal time <--> Universal time in 1950 system - !WNGJUL Julian day/time moment <--> Civil day/time - !WNGSTL LSD nr and time in day fraction <--> LMST moment -! -! Executables -! -TWNG.EXE -!- diff --git a/src/wng/wng.inc b/src/wng/wng.inc deleted file mode 100644 index c8f8f15fe3090c113785f9745239df87d2df4df1..0000000000000000000000000000000000000000 --- a/src/wng/wng.inc +++ /dev/null @@ -1,221 +0,0 @@ -/*+ Created from wng.dsc on 970828 at 16:58:00 at daw18 -.. WNG.INC -.. WNB 970828 -.. -.. Revisions: -.. -.. HJV 940217 Change data type T (remove blank line) -.. WNB 931130 Add BKJY, DBKJY -.. JPH 930825 Comment -.. WNB 930803 Use new WNTINC options -.. WNB 930727 Add T_S, LB_S, T_ALL -.. WNB 930527 Add A data type -.. WNB 921222 Add WSRT/ATNF longitude and latitude -.. HJV 920626 Add comment for prgdat (8 = HP station) -.. HJV 920501 Type of JS changed to L from J -.. WNB 890427 Original version -.. */ -/* -.. Given statements: -.. */ -/* -.. Result: -.. -.. WNG.DSC is a general include file. WNG_DEF (wng_inc) should be -.. included as the first executable statement after the -.. routine definition. In WNGLOGIN.COM an assignment to -.. WNG_DEF is present, so use it as: -.. INCLUDE 'WNG_DEF' -.. Initialisation is done in WNGIN (via NLINK) -.. */ -/* -.. Parameters: -.. */ -#define DPI 3.1415926535897932385 /* PI */ -#define PI DPI -#define DEE 2.7182818284590452353 /* E */ -#define EE DEE -#define DPI2 6.2831853071795864769 /* 2*PI */ -#define PI2 DPI2 -#define DRAD 0.0174532925199432958 /* PI/360 */ -#define RAD DRAD -#define DDEG 57.2957795130823208768 /* 360/PI */ -#define DEG DDEG -#define DCRTSC 240.*360. /* CIRCLES TO SECONDS */ -#define RCRTSC DCRTSC -#define DCL 2.997925D8 /* C IN M/S */ -#define CL DCL -#define DBKJY 1380.54 /* K IN JY.M^2/K */ -#define BKJY DBKJY -#define LATW 52.9169 /* LAT WSRT (DEG) */ -#define LONGW 6.604167 /* LONG WSRT (DEG) */ -#define SLATW 0.797762 /* SIN(LAT) WSRT */ -#define CLATW 0.602973 /* COS(LAT) WSRT */ -#define LATA -30.31445 /* LAT ATNF (DEG) */ -#define LONGA 149.566928 /* LONG ATNF (DEG) */ -#define SLATA -0.504745 /* SIN(LAT) ATNF */ -#define CLATA 0.863268 /* COS(LAT) ATNF */ -#define E2T8 2.**8 /* 2**8 */ -#define E2T16 2.**16 /* 2**16 */ -#define E2T32 2.**32 /* 2**32 */ -#define D2T16 2D0**16 /* 2**16 */ -#define D2T32 2D0**32 /* 2**32 */ -#define F_FILN 16 /* # OF FILES */ -#define F_T 1 - /* Type BIT */ - /* Print BIT */ - /* Prefix BIT: puts a ">" */ -#define F_P 2 -#define F_P1 128 -#define F_0 256 -#define F_1 512 -#define F_2 1024 -#define F_3 2048 -#define F_4 4096 -#define F_5 8192 -#define F_6 16384 -#define F_7 32768 -#define F_8 65536 -#define F_9 131072 -#define F_10 262144 -#define F_11 524288 -#define F_12 1048576 -#define F_13 2097152 -#define F_14 4194304 -#define F_15 8388608 -#define F__N 25 -#define F__L 1 -#define F__H 8388608 -#define F__I 2 -#define F_TP 3 /* TYPE/PRINT BITS */ -#define F_ALL -F_0+F_15+F_15+F_TP /* ALL FILE BITS */ -#define F_NO 0 /* NO DISPOSITION */ -#define F_YES 1 /* KEEP FILE */ -#define F_SP 2 /* SPOOL FILE */ -#define F_CAT 3 /* CONCATENATE FILE */ -#define F_LC 1 /* LINE COUNT CODE */ -#define F_PC 2 /* PAGE COUNT CODE */ -#define F_LL 3 /* LINE LENGTH CODE */ -#define F_PL 4 /* PAGE LENGTH CODE */ -#define F_DIS 5 /* DISPOSITION CODE */ -#define IUND -32768 /* UNDEFINED WSRT VALUE */ -#define DWC_ENDOFLOOP 134448144 /* ^Z PARAMETER REPLY */ -#define DWC_NULLVALUE 134448161 /* "" PARAMETER REPLY */ -#define DWC_WILDCARD 134448169 /* * PARAMETER REPLY */ -#define L_B 8 /* LENGTH IN BITS OF */ - /* DATA TYPES */ -#define L_C 8 -#define L_L 32 -#define L_I 16 -#define L_J 32 -#define L_K 32 -#define L_E 32 -#define L_D 64 -#define L_X 64 -#define L_Y 128 -#define L_A 16 -#define L_S 8 -#define L__N 13 -#define LB_B 1 /* LENGTH IN BYTES OF */ - /* DATA TYPES */ -#define LB_C 1 -#define LB_L 4 -#define LB_I 2 -#define LB_J 4 -#define LB_K 4 -#define LB_E 4 -#define LB_D 8 -#define LB_X 8 -#define LB_Y 16 -#define LB_A 2 -#define LB_S 1 -#define LB__N 13 -#define T_B 1 /* TYPE CODES OF */ -#define T_C 2 -#define T_L 3 -#define T_I 4 -#define T_J 5 -#define T_K 6 -#define T_E 7 -#define T_D 8 -#define T_X 9 -#define T_Y 10 -#define T_A 11 -#define T_S 12 -#define T__N 13 -#define T__L 1 -#define T__H 12 -#define T__I 1 -#define T_ALL BCLIJKEDXYAS /* KNOWN DATA TYPES */ -/* -.. Data declarations: -.. */ - int j; /* POINTERS */ - int j0; - int j1; - int j2; - int j3; - int j4; - int j5; - int i; /* LOOPS */ - int i0; - int i1; - int i2; - int i3; - int i4; - int i5; - unsigned int js; /* ERROR */ - float r0; /* SOME HELP */ - float r1; - double d0; - double d1; - unsigned int l0; - unsigned int l1; - char b0; - char b1; -/* -.. WNG common data: -.. */ -struct wng_com { - union { - double a_y[1][2]; /* DUMMY ARRAYS */ - char a_b[1]; - short a_i[1]; - int a_j[1]; - long int a_k[1]; - unsigned int a_l[1]; - float a_e[1]; - double a_d[1]; - float a_x[1][2]; - } a_y; - int e_c; /* MOST RECENT ERROR CODE */ - int a_ob; /* ARRAY OFFSETS */ - int a_oi; - int a_oj; - int a_ok; - int a_ol; - int a_oe; - int a_od; - int a_ox; - int a_oy; - int logcd; /* LOG CODE */ - int prgdat; /* DATA TYPE */ - /* 1= VAX, D_FORMAT */ - /* 2= VAX, G_FORMAT */ - /* 3= ALLIANT */ - /* 4= CONVEX */ - /* 5= IEEE */ - /* 6= DEC station */ - /* 7= SUN station */ - /* 8= HP station */ - char prgnam[9]; /* PROGRAM NAME */ - char prgver[6]; /* PROGRAM VERSION */ -}; -/* -.. WNG common block: -.. */ -extern struct wng_com wng_com_ ; -/* -.. Given statements: -.. */ -/*- */ diff --git a/src/wng/wngang.for b/src/wng/wngang.for deleted file mode 100644 index dad35890a69e5029d034dce795936ff0a1777ea8..0000000000000000000000000000000000000000 --- a/src/wng/wngang.for +++ /dev/null @@ -1,265 +0,0 @@ -C+ WNGANG.FOR -C WNB 890111 -C -C Revisions: -C WNB 900828 Typo -C CMV 940123 Split in DOUBLE and REAL function for alpha -C - DOUBLE PRECISION FUNCTION WNGDPD(VALD) -C -C Convert and normalize angles -C -C Result: -C -C E/D = WNGDPD (VAL_E/D:I) -C ENR -C F -C Normalise angles: -C D/E DOUBLE PRECISION or REAL input/output -C P/N normalise Positive (0-360 deg) or -C Negative (-180-+180) -C D/R/F input/output Degrees, Radians or -C Fraction of circles -C E/D = WNGDDF (VAL_E/D:I) -C ER -C Convert to fraction of circles: -C D/E DOUBLE PRECISION or REAL input/output -C D/R Degrees or Radians input -C E/D = WNGDFD (VAL_E/D:I) -C E R -C Convert from fraction of circles: -C D/E DOUBLE PRECISION or REAL input/output -C D/R Degrees or Radians output -C -C Include files: -C - INCLUDE 'WNG_DEF' -C -C Parameters: -C -C -C Arguments: -C - DOUBLE PRECISION VALD !INPUT VALUE -C -C Entry points: -C - DOUBLE PRECISION WNGDND,WNGDPR,WNGDNR,WNGDPF,WNGDNF - DOUBLE PRECISION WNGDDF,WNGDRF,WNGDFD,WNGDFR -C -C Function references: -C -C -C Data declarations: -C -C -C Equivalences: -C -C -C Commons: -C -C- -C -C DPD -C - WNGDPD=MOD(VALD,360D0) - IF (WNGDPD.LT.0) WNGDPD=WNGDPD+360D0 -C - RETURN -C -C DPR -C - ENTRY WNGDPR(VALD) -C - WNGDPR=MOD(VALD,DPI2) - IF (WNGDPR.LT.0) WNGDPR=WNGDPR+DPI2 -C - RETURN -C -C DPF -C - ENTRY WNGDPF(VALD) -C - WNGDPF=MOD(VALD,1D0) - IF (WNGDPF.LT.0) WNGDPF=WNGDPF+1D0 -C - RETURN -C -C DND -C - ENTRY WNGDND(VALD) -C - WNGDND=MOD(VALD,360D0) - IF (WNGDND.LT.0) WNGDND=WNGDND+360D0 - IF (WNGDND.GT.180D0) WNGDND=WNGDND-360D0 -C - RETURN -C -C DNR -C - ENTRY WNGDNR(VALD) -C - WNGDNR=MOD(VALD,DPI2) - IF (WNGDNR.LT.0) WNGDNR=WNGDNR+DPI2 - IF (WNGDNR.GT.DPI) WNGDNR=WNGDNR-DPI2 -C - RETURN -C -C DNF -C - ENTRY WNGDNF(VALD) -C - WNGDNF=MOD(VALD,1D0) - IF (WNGDNF.LT.0) WNGDNF=WNGDNF+1D0 - IF (WNGDNF.GT.0.5D0) WNGDNF=WNGDNF-1D0 -C - RETURN -C -C DDF -C - ENTRY WNGDDF(VALD) -C - WNGDDF=VALD/360D0 - WNGDDF=MOD(WNGDDF,1D0) - IF (WNGDDF.LT.0) WNGDDF=WNGDDF+1D0 -C - RETURN -C -C DRF -C - ENTRY WNGDRF(VALD) -C - WNGDRF=VALD/DPI2 - WNGDRF=MOD(WNGDRF,1D0) - IF (WNGDRF.LT.0) WNGDRF=WNGDRF+1D0 -C - RETURN -C -C DFD -C - ENTRY WNGDFD(VALD) -C - WNGDFD=VALD*360D0 - WNGDFD=MOD(WNGDFD,360D0) - IF (WNGDFD.LT.0) WNGDFD=WNGDFD+360D0 -C - RETURN -C -C DFR -C - ENTRY WNGDFR(VALD) -C - WNGDFR=VALD*DPI2 - WNGDFR=MOD(WNGDFR,DPI2) - IF (WNGDFR.LT.0) WNGDFR=WNGDFR+DPI2 -C - RETURN - END -C -C EPD -C - REAL FUNCTION WNGEPD(VALE) -C - INCLUDE 'WNG_DEF' -C - REAL VALE -C - REAL WNGEND,WNGEPR,WNGENR,WNGEPF,WNGENF - REAL WNGEDF,WNGERF,WNGEFD,WNGEFR -C -C - WNGEPD=MOD(VALE,360E0) - IF (WNGEPD.LT.0) WNGEPD=WNGEPD+360E0 -C - RETURN -C -C EPR -C - ENTRY WNGEPR(VALE) -C - WNGEPR=MOD(VALE,PI2) - IF (WNGEPR.LT.0) WNGEPR=WNGEPR+PI2 -C - RETURN -C -C EPF -C - ENTRY WNGEPF(VALE) -C - WNGEPF=MOD(VALE,1E0) - IF (WNGEPF.LT.0) WNGEPF=WNGEPF+1E0 -C - RETURN -C -C END -C - ENTRY WNGEND(VALE) -C - WNGEND=MOD(VALE,360E0) - IF (WNGEND.LT.0) WNGEND=WNGEND+360E0 - IF (WNGEND.GT.180E0) WNGEND=WNGEND-360E0 -C - RETURN -C -C ENR -C - ENTRY WNGENR(VALE) -C - WNGENR=MOD(VALE,PI2) - IF (WNGENR.LT.0) WNGENR=WNGENR+PI2 - IF (WNGENR.GT.PI) WNGENR=WNGENR-PI2 -C - RETURN -C -C ENF -C - ENTRY WNGENF(VALE) -C - WNGENF=MOD(VALE,1E0) - IF (WNGENF.LT.0) WNGENF=WNGENF+1E0 - IF (WNGENF.GT.0.5E0) WNGENF=WNGENF-1E0 -C - RETURN -C -C EDF -C - ENTRY WNGEDF(VALE) -C - WNGEDF=VALE/360E0 - WNGEDF=MOD(WNGEDF,1E0) - IF (WNGEDF.LT.0) WNGEDF=WNGEDF+1E0 -C - RETURN -C -C ERF -C - ENTRY WNGERF(VALE) -C - WNGERF=VALE/PI2 - WNGERF=MOD(WNGERF,1E0) - IF (WNGERF.LT.0) WNGERF=WNGERF+1E0 -C - RETURN -C -C EFD -C - ENTRY WNGEFD(VALE) -C - WNGEFD=VALE*360E0 - WNGEFD=MOD(WNGEFD,360E0) - IF (WNGEFD.LT.0) WNGEFD=WNGEFD+360E0 -C - RETURN -C -C EDR -C - ENTRY WNGEFR(VALE) -C - WNGEFR=VALE*PI2 - WNGEFR=MOD(WNGEFR,PI2) - IF (WNGEFR.LT.0) WNGEFR=WNGEFR+PI2 -C - RETURN -C -C - END diff --git a/src/wng/wngarg.cun b/src/wng/wngarg.cun deleted file mode 100644 index 9c39bdba7829d408abaf8d27a5f40917996ca4be..0000000000000000000000000000000000000000 --- a/src/wng/wngarg.cun +++ /dev/null @@ -1,49 +0,0 @@ -/* wngarg.cun -. WNB 920113 -. -. Revisions: -. WNB 921216 Make CUN -. CMV 940111 Adapted for alpha -... */ -#ifdef wn_al__ - long wngad1_(adr) -#else - long wngara_(adr) -#endif -/* -. Return address of variable -. -. Result: -. -. wngara_L = wngara_( ADR_J:I) -. Get address of ADR -... */ -/* -. Arguments: -... */ - long adr; /* address to get */ -{ -/* -. Include files: -... */ -/* -. Parameters: -... */ -/* -. Function references: -... */ -/* -. Data declarations: -... */ -/*- */ -/* Get address -. */ -#ifdef wn_da__ - return((int)adr); -#else - return(adr); -#endif -} -/* -. -... */ diff --git a/src/wng/wngarg.fvx b/src/wng/wngarg.fvx deleted file mode 100644 index a6175526c150f5d99ab0250fc7931c0717ee8743..0000000000000000000000000000000000000000 --- a/src/wng/wngarg.fvx +++ /dev/null @@ -1,99 +0,0 @@ -C+ WNGARG.FVX -C WNB 930817 -C -C Revisions: -C - INTEGER FUNCTION WNGARG() -C -C Adrress handling -C -C Result: -C -C WNGARG_J = WNGARG() Address of argument list (point at -C # of arguments) of containing routine -C WNGART_L = WNGART( N_J:I) .TRUE. if argument N present -C in enclosing routine -C WNGARN_J = WNGARN() # of arguments in enclosing routine -C WNGARQ_X = WNGARQ( ROUT_ENTRY:I, ALIST_J(0:*):I) -C Call routine ROUT with argument list -C ALIST -C WNGARA_J = WNGARA( N_J:I) Return address of N -C -C Include files: -C - INCLUDE 'WNG_DEF' -C -C Parameters: -C -C -C Arguments: -C - INTEGER N !ARGUMENT NUMBER - EXTERNAL ROUT !ROUTINE TO CALL - INTEGER ALIST(0:*) !ARGUMENT LIST -C -C Entry points: -C - LOGICAL WNGART - INTEGER WNGARN,WNGARQ,WNGARA -C -C Function references: -C - INTEGER LIB$CALLG - INTEGER WNGARG_X !ADDRESS ARGUMENT LIST ENCLOSING ROUTINE -C -C Data declarations: -C -C- -C -C WNGARG -C - WNGARG=WNGARG_X() !ARGUMENT LIST ADDRESS -C - RETURN -C -C WNGART -C - ENTRY WNGART(N) -C - WNGART=.FALSE. !ASSUME NOT PRESENT - J=WNGARG_X() !PREVIOUS AP - IF (J.EQ.0) RETURN !NONE - J=(J-A_OB)/LB_J !PREVIOUS AP PTR - IF (N.LE.0 .OR. N.GT.255) RETURN !NO SUCH ARGUMENT - IF (N.GT.IAND(A_J(J),'000000FF'X)) RETURN !NO SUCH ARGUMENT - IF (A_J(J+N).EQ.0) RETURN !EMPTY ARGUMENT - WNGART=.TRUE. !PRESENT -C - RETURN -C -C WNGARN -C - ENTRY WNGARN() -C - WNGARN=0 !RESULT - J=WNGARG_X() !PREVIOUS AP - IF (J.EQ.0) RETURN !ERROR - J=(J-A_OB)/LB_J !PREVIOUS AP PTR - WNGARN=IAND(A_J(J),'000000FF'X) !# OF ARGUMENTS -C - RETURN -C -C WNGARQ -C - ENTRY WNGARQ(ROUT,ALIST) -C - WNGARQ=LIB$CALLG(ALIST,ROUT) !CALL ROUTINE -C - RETURN -C -C WNGARA -C - ENTRY WNGARA(N) -C - WNGARA=%LOC(N) -C - RETURN -C -C - END diff --git a/src/wng/wngarg.mal b/src/wng/wngarg.mal deleted file mode 100644 index 6184108d37801becc5c85babd26f03698d7959f5..0000000000000000000000000000000000000000 --- a/src/wng/wngarg.mal +++ /dev/null @@ -1,117 +0,0 @@ -|+ WNGARG.MAL -| WNB 890308 -| -| Revisions: -| -| .TITLE WNGARG ARGUMENT MANIPULATION -| .IDENT /WNB.01/ -| -| Argument list manipulation -| -| Result: -| -| J = WNGARG() Address of argument list (point at -| # of arguments) of containing routine -| L = WNGART( N_J:I) Test if argument N was present in -| argument list of containing routine. -| J = WNGARN() Returns the number of arguments in the -| containing routine's argument list. -| CALL WNGARQ( ENTRY_ENT:O, ARGL(0:*)_J:I) Transfer to routine ENTRY -| with ARGL argument list -| or: VAL=WNGARQ(...) with VAL depending on ROUT -| J = WNGARA( VAR_J:I) get address of VAR -| -| Symbol definition: -| -| -| Program section: -| - .text -| -| Global references: -| - .globl _wngarg_,_wngart_,_wngarn_,_wngarq_ - .globl _wngara_ -| -| Commons: -| -|- -| -| WNGARG -| -_wngarg_: - linkw a6,#-8 |stack frame - movl a0,a6@(-4) |save argument pointer - movl a6@,a1 |old frame pointer - movl a1@(-4),a1 |embracing arg pointer - tstl a1 - beq A1 |not present - movl a1,d0 |return address -A2: unlk a6 |restore frame - rts |ready -A1: movl #V1,d0 |return dummy address - bra A2 -| -| WNGART -| -_wngart_: - linkw a6,#-8 |stack frame - clrl d0 |assume error - movl a0,a6@(-4) |save argument pointer - beq B1 |no argument specified - movl a6@,a1 |old frame pointer - movl a1@(-4),a1 |embracing argument pointer - tstl a1 - beq B1 |no embracing arguments - movl a0@@,d1 |N to test - ble B1 |illegal - cmpw a1@(-2),d1 |present? - bgt B1 |no - tstl a1@(-4:W)[d1:W:L] |address zero? - beq B1 |yes, omitted - subql #1,d0 |set .true. -B1: unlk a6 |restore frame - rts |return -| -| WNGARN -| -_wngarn_: - linkw a6,#-8 |stack frame - clrl d0 |assume error - movl a0,a6@(-4) |save argument pointer - movl a6@,a1 |old frame pointer - movl a1@(-4),a1 |embracing argument pointer - tstl a1 - beq C1 |no embracing arguments - movw a1@(-2),d0 |# of arg -C1: unlk a6 |restore frame - rts |return -| -| WNGARQ -| -_wngarq_: - linkw a6,#-8 |stack frame - movl a0,a6@(-4) |save arg pointer - movl a0@,a2 |routine address - movl a0@(4),a0 |argument list address - jsr a2@ |do routine - unlk a6 |restore frame - rts |return -| -| WNGARA -| -_wngara_: - movl a0@,d0 |variable address - rts |return -| -| Data section: -| - .even -| - .data -| -V2: .long 0 -V1: .long 0 -| - .even -| diff --git a/src/wng/wngarg_x.mvx b/src/wng/wngarg_x.mvx deleted file mode 100644 index fb2f1b0771955cf1c2ac1e0ef3d394085e7cf2e3..0000000000000000000000000000000000000000 --- a/src/wng/wngarg_x.mvx +++ /dev/null @@ -1,41 +0,0 @@ -;+ WNGARG_X.MVX -; WNB 890308 -; -; Revisions: -; WNB 930818 Split in WNGARG_X.MVX and WNGARG.FVX -; - .TITLE WNGARG_X ARGUMENT MANIPULATION - .IDENT /WNB.01/ -; -; Argument list manipulation -; -; Result: -; -; J = WNGARG_X() Address of argument list (point at -; # of arguments) of containing routine -; -; Program section: -; - .PSECT WNCODE,PIC,USR,CON,REL,LCL,SHR,EXE,RD,NOWRT,NOVEC,LONG -; -; Symbol definition: -; - $SFDEF ;CALL FRAME OFFSETS -; -; Global references: -; -;- - .PAGE - .SUBTITLE ADDRESS OF ARGUMENT LIST -; -.ENTRY WNGARG_X,0 -; - MOVL SF$L_SAVE_FP(FP),R0 ;PREVIOUS FP - BEQL 1$ ;NONE - MOVL SF$L_SAVE_AP(R0),R0 ;PRE-PREVIOUS AP -; -1$: RET -; -; -; - .END diff --git a/src/wng/wngari.for b/src/wng/wngari.for deleted file mode 100644 index 14913d8809db6335c61e53c6763c07615ff6f0bf..0000000000000000000000000000000000000000 --- a/src/wng/wngari.for +++ /dev/null @@ -1,88 +0,0 @@ -C+ WNGARI.FOR -C WNB 890308 -C -C Revisions: -c wnb 930520 Remove %VAL -C - INTEGER*2 FUNCTION WNGARI(PARG,ARGL) -C -C Get value from argument list -C -C Result: -C -C I = WNGARI ( PARG_J:I, ARGL_J(0:*):I) Get I value from PARG argument -C in ARGL list, or zero if none available -C J = WNGARJ ( PARG_J:I, ARGL_J(0:*):I) Get J value from PARG argument -C in ARGL list, or zero if none available -C K = WNGARK ( PARG_J:I, ARGL_J(0:*):I) Get K value from PARG argument -C in ARGL list, or zero if none available -C -C Include files: -C - INCLUDE 'WNG_DEF' -C -C Parameters: -C -C -C Arguments: -C - INTEGER PARG !ARGUMENT NUMBER - INTEGER ARGL(0:*) !ARGUMENT LIST -C -C Entry points: -C - INTEGER WNGARJ - INTEGER*4 WNGARK -C -C Function references: -C - INTEGER*2 WNGGI !CONVERT TO I - INTEGER WNGGJ !CONVERT TO J - INTEGER*4 WNGGK !CONVERT TO K -C -C Data declarations: -C -C -C Equivalences: -C -C -C Commons: -C -C- - WNGARI=0 !ASSUME NOT PRESENT - IF (PARG.GT.0 .AND. PARG.LE.ARGL(0)) THEN !COULD BE PRESENT - IF (ARGL(PARG).NE.0) THEN !ADDRESS PRESENT - WNGARI=WNGGI(A_B(ARGL(PARG)-A_OB)) !SET VALUE - END IF - END IF -C - RETURN -C -C WNGARJ -C - ENTRY WNGARJ(PARG,ARGL) -C - WNGARJ=0 !ASSUME NOT PRESENT - IF (PARG.GT.0 .AND. PARG.LE.ARGL(0)) THEN !COULD BE PRESENT - IF (ARGL(PARG).NE.0) THEN !ADDRESS PRESENT - WNGARJ=WNGGJ(A_B(ARGL(PARG)-A_OB)) !SET VALUE - END IF - END IF -C - RETURN -C -C WNGARK -C - ENTRY WNGARK(PARG,ARGL) -C - WNGARK=0 !ASSUME NOT PRESENT - IF (PARG.GT.0 .AND. PARG.LE.ARGL(0)) THEN !COULD BE PRESENT - IF (ARGL(PARG).NE.0) THEN !ADDRESS PRESENT - WNGARK=WNGGK(A_B(ARGL(PARG)-A_OB)) !SET VALUE - END IF - END IF -C - RETURN -C -C - END diff --git a/src/wng/wngarl.fun b/src/wng/wngarl.fun deleted file mode 100644 index 96221d14cd170cc4fde49c79a066ab5a5d444381..0000000000000000000000000000000000000000 --- a/src/wng/wngarl.fun +++ /dev/null @@ -1,136 +0,0 @@ -C+ WNGARL.FUN -C WNB 890308 -C -C Revisions: -C WNB 921216 Make FUN -C -#ifdef wn_al__ - INTEGER FUNCTION WNGARL(ADDR,ARGL) -#else - INTEGER FUNCTION WNGARX(ROUT,ARGL) -#endif -C -C Get and reset argument list -C -C Result: -C -#ifdef wn_al__ -C J = WNGARL ( ADDR_J(0:*):I, ARGL_J(0:*):O) Copy the call list -C pointed to by ADDR to a proper ARGL. -C The result (if wanted) is # of arguments -#endif -C VAL =WNGARX ( ROUT_ENT:O, ARGL_J(0:*):IO) Transfer to ROUT with proper -C call list made from ARGL. VAL, if any, -C depends on ROUT type -#ifdef wn_al__ -C J = WNGARF ( NA_J:I, ARGL_J(0:*):IO) Make ARGL arg. list for NA -C arguments, using existing ARGL -C Note: ARGL must have negative members. -C The ARGL produced will be: -C -N descriptor addr arg 1 -C ... ... -C -1 descriptor addr arg N -C 0 N (# of arguments) -#else -C The ARGL will contain: -C -M-2 length Mth string -C ... ... -C -3 length 1st string -C -2 M (= # of string lenghts) -C -1 0 (count for string lengths) -#endif -C 0 N (# of real arguments) -C 1 address argument 1 -C ... ... -C N address argument N -C -C Include files: -C - INCLUDE 'WNG_DEF' -C -C Parameters: -C -C -C Arguments: -C -#ifdef wn_al__ - INTEGER ADDR(0:*) !CALL LIST (-* MEMBERS ALSO) - INTEGER NA !# OF ARG. -#endif - EXTERNAL ROUT !ROUTINE TO CALL -#ifndef wn_al__ - INTEGER ROUT -#endif - INTEGER ARGL(0:*) !ARGUMENT LIST (-* MEMBERS ALSO) -#ifdef wn_al__ -C -C Entry points: -C - INTEGER WNGARX - INTEGER WNGARF -#endif -C -C Function references: -C -#ifdef wn_al__ - INTEGER WNGARQ !CALL TRANSFER -#endif -C -C Data declarations: -C -C- -#ifdef wn_al__ - ARGL(0)=IAND(ADDR(-1),'ff'X) !MAKE PROPER COUNT - DO I=1,ARGL(0) - ARGL(I)=ADDR(I-1) !SET ARG. LIST - ARGL(-I)=0 -C IF (IAND(ADDR(-1),'10000'X).NE.0) !DESCRIPTORS PRESENT -C 1 ARGL(-I)=ADDR(-I-1) - ARGL(-I)=ADDR(-I-1) !ALLIANT IF ERROR - END DO - WNGARL=ARGL(0) !RETURN # OF ARG. -C - RETURN -C -C WNGARX -C - ENTRY WNGARX(ROUT,ARGL) -C - ARGL(0)=IOR(ARGL(0),'10000'X) !DESCRIPTORS PRESENT - WNGARX=WNGARQ(ROUT,ARGL(1)) !DO ROUTINE - ARGL(0)=IAND(ARGL(0),'ff'X) !RESET -C - RETURN -C -C WNGARF -C - ENTRY WNGARF(NA,ARGL) -C - IF (NA.LT.0) THEN !CANNOT DO - ELSE IF (NA.LE.ARGL(0)) THEN - DO I=1,NA !SHIFT DESCRIPTORS - ARGL(-I)=ARGL(-ARGL(0)+NA-I) - END DO - ARGL(0)=NA - ELSE - I1=ARGL(0)+1 - DO I=I1,NA - ARGL(I)=0 !SET EMPTY ARGUMENTS - END DO - DO I=-ARGL(0),-1 !SHIFT DESCRIPTORS - ARGL(I-NA+ARGL(0))=ARGL(I) - END DO - DO I=1,NA-ARGL(0) !FILL DESCRIPTORS - ARGL(-I)=0 - END DO - ARGL(0)=NA - END IF - WNGARF=ARGL(0) !RETURN # OF ARGUMENTS -#else - WNGARX=ROUT(ARGL(0)) !DO ROUTINE -#endif -C - RETURN -C -C - END diff --git a/src/wng/wngarl.fvx b/src/wng/wngarl.fvx deleted file mode 100644 index 402faf640c96467c03c328e59a0def253331a62a..0000000000000000000000000000000000000000 --- a/src/wng/wngarl.fvx +++ /dev/null @@ -1,92 +0,0 @@ -C+ WNGARL.FVX -C WNB 890308 -C -C Revisions: -C - INTEGER FUNCTION WNGARL(ADDR,ARGL) -C -C Get and reset argument list -C -C Result: -C -C J = WNGARL ( ADDR_J(0:*):I, ARGL_J(0:*):O) Copy the call list -C pointed to by ADDR to a proper ARGL. -C The result (if wanted) is # of arguments -C VAL =WNGARX ( ROUT_ENT:O, ARGL_J(0:*):IO) Transfer to ROUT with proper -C call list made from ARGL. VAL, if any, -C depends on ROUT type -C J = WNGARF ( NA_J:I, ARGL_J(0:*):IO) Make ARGL arg. list for NA -C arguments, using existing ARGL -C The ARGL produced will be: -C 0 N (# of arguments) -C 1 address arg 1 -C ... ... -C N address arg N -C -C Include files: -C - INCLUDE 'WNG_DEF' -C -C Parameters: -C -C -C Arguments: -C - INTEGER ADDR(0:*) !CALL LIST - INTEGER ARGL(0:*) !ARGUMENT LIST - EXTERNAL ROUT !ROUTINE TO CALL - INTEGER NA !# OF ARG. -C -C Entry points: -C - INTEGER WNGARX - INTEGER WNGARF -C -C Function references: -C - INTEGER WNGARQ !CALL TRANSFER -C -C Data declarations: -C -C -C Equivalences: -C -C -C Commons: -C -C- - ARGL(0)=IAND(ADDR(0),'FF'X) !MAKE PROPER COUNT - DO I=1,ARGL(0) - ARGL(I)=ADDR(I) !SET ARG. LIST - END DO - WNGARL=ARGL(0) !RETURN # OF ARG. -C - RETURN -C -C WNGARX -C - ENTRY WNGARX(ROUT,ARGL) -C - WNGARX=WNGARQ(ROUT,ARGL) !DO ROUTINE -C - RETURN -C -C WNGARF -C - ENTRY WNGARF(NA,ARGL) -C - IF (NA.LT.0) THEN !CANNOT DO - ELSE IF (NA.LE.ARGL(0)) THEN - ARGL(0)=NA - ELSE - DO I=ARGL(0)+1,NA - ARGL(I)=0 !SET EMPTY ARGUMENTS - END DO - ARGL(0)=NA - END IF - WNGARF=ARGL(0) !RETURN # OF ARGUMENTS -C - RETURN -C -C - END diff --git a/src/wng/wngasa.fsc b/src/wng/wngasa.fsc deleted file mode 100644 index f92de23d3ed11ae85065b46f261b069835ab92fa..0000000000000000000000000000000000000000 --- a/src/wng/wngasa.fsc +++ /dev/null @@ -1,90 +0,0 @@ -C+ WNGASA.FVX -C WNB 890308 -C -C Revisions: -C WNB 921215 Make FSC for VX, AL, HP, DW, SW, CV -C - INTEGER FUNCTION WNGASA(PARG,ARGL) -C -C Get string address/length from argument list -C -C Result: -C -C J = WNGASA ( PARG_J:I, ARGL_J(0:*):I) Get string address from PARG -C argument in ARGL list, or zero if none -C available -C J = WNGASL ( PARG_J:I, ARGL_J(0:*):I) Get string length from PARG -C argument in ARGL list, or zero if none -C available -C -C Include files: -C - INCLUDE 'WNG_DEF' -C -C Parameters: -C -C -C Arguments: -C - INTEGER PARG !ARGUMENT NUMBER - INTEGER ARGL(0:*) !ARGUMENT LIST -C -C Entry points: -C - INTEGER WNGASL -C -C Function references: -C -#ifdef wn_vx__ - INTEGER*2 WNGGI !CONVERT VALUE - INTEGER WNGGJ -#endif -#ifdef wn_al__ - INTEGER WNGGJ -#endif -C -C Data declarations: -C -C- - WNGASA=0 !ASSUME NOT PRESENT - IF (PARG.GT.0 .AND. PARG.LE.ARGL(0)) THEN !COULD BE PRESENT - IF (ARGL(PARG).NE.0) THEN !DESCRIPTOR PRESENT -#ifdef wn_vx__ - WNGASA=WNGGJ(%VAL(ARGL(PARG)+4)) !STRING ADDRESS -#else - WNGASA=ARGL(PARG) !STRING ADDRESS -#endif - END IF - END IF -C - RETURN -C -C WNGASL -C - ENTRY WNGASL(PARG,ARGL) -C - WNGASL=0 !ASSUME NOT PRESENT - IF (PARG.GT.0 .AND. PARG.LE.ARGL(0)) THEN !COULD BE PRESENT -#ifdef wn_vx__ - IF (ARGL(PARG).NE.0) THEN !DESCRIPTOR PRESENT - WNGASL=WNGGI(%VAL(ARGL(PARG))) !SET STRING LENGTH - END IF -#else - #ifdef wn_al__ - J=PARG-ARGL(0)-1 !LENGTH POINTER - IF (ARGL(J).NE.0) THEN !LENGTH PRESENT - WNGASL=WNGGJ(%VAL(ARGL(J))) !SET STRING LENGTH - END IF - #else - IF (ARGL(-1).LT.ARGL(-2)) THEN !STRING LENGTH PRESENT - ARGL(-1)=ARGL(-1)+1 !COUNT STRING LENGTH SEEN - WNGASL=ARGL(-ARGL(-1)-2) !SET STRING LENGTH - END IF - #endif -#endif - END IF -C - RETURN -C -C - END diff --git a/src/wng/wngcc.for b/src/wng/wngcc.for deleted file mode 100644 index c8486d852b737379ca7a6fdcd8053c0b31159de8..0000000000000000000000000000000000000000 --- a/src/wng/wngcc.for +++ /dev/null @@ -1,80 +0,0 @@ -C+ WNGCC.FOR -C JPH 941005 -C -C Revisions: -C JPH 960621 WNGCCN -C -C - SUBROUTINE WNGCCD() -C -C Routine to control control-C handling: -C -C Entry Sets XHCC to Return/value/action -C [0] [1] -C -C WNGCCD 1 0 Inhibit -C WNGCCC * 0 True if control-C seen (XHCC[1] was >0) -C WNGCCE 0 0 Exit if XHCC[1] was >0, else reenable -C WNGCCN * * Control-C count: XHCC[1] -C WNGCCS(N_J:I) * N Simulate N control-Cs -C -C -C Include files: -C - INCLUDE 'WNG_DEF' - INCLUDE 'WXH_DEF' -C -C Parameters -C - INTEGER N ! count -C -C- -C -CC print*,'D' - XHCC(0)=1 - XHCC(1)=0 ! inhibit - RETURN -C -C - ENTRY WNGCCE -CC print*, 'E', xhcc - XHCC(0)=0 ! enable - IF (XHCC(1).NE.0) CALL WNGEX - XHCC(1)=0 - RETURN -C -C - ENTRY WNGCCS(N) -CC print*, 'S', xhcc, '+', N - XHCC(1)=XHCC(1)+N - END -C -C - LOGICAL FUNCTION WNGCCC() -C -C Include files: -C - INCLUDE 'WNG_DEF' - INCLUDE 'WXH_DEF' -C -CC print *, 'C', xhcc - WNGCCC=XHCC(1).NE.0 ! seen? - XHCC(1)=0 ! clear -C - RETURN - END -C -C - INTEGER FUNCTION WNGCCN() -C -C Include files: -C - INCLUDE 'WNG_DEF' - INCLUDE 'WXH_DEF' -C -C - WNGCCN=XHCC(1) ! nr seen -CC print*, 'N', xhcc -C - RETURN - END diff --git a/src/wng/wngcshrc.com b/src/wng/wngcshrc.com deleted file mode 100755 index 969805c395f57a30237a4f154bf52cf3e1b92be4..0000000000000000000000000000000000000000 --- a/src/wng/wngcshrc.com +++ /dev/null @@ -1,36 +0,0 @@ -$!# wngcshrc.ssc -$!# WNB 920911 -$!# -$!# Revisions: -$!# WNB 920917 Typo WNGFEX -$!# WNB 921012 Solve symbol conflict and typo -$!# HJV 921001 Change N-series to Newstar -$!# WNB 921006 Typo NGET -$!# WNB 921224 Make SSC -$!# WNB 930301 Move path to wnglogin.sun -$!# WNB 930303 Add NSTAR_DIR -$!# HjV 930414 Typo NSTAR_DIR -$!# WNB 931217 Add NCOPY to NSTAR_DIR -$!# -$!# Environment for all WN programs -$!# Call by inserting in .cshrc as source wngcshrc.sun -$!# -$ WNGTYP=="C''WNG_TYPE'" -$ NXEC=="@WNG:NXEC" -$ NC*OMP=="@WNG:NXEC NC" -$ NDEL=="@WNG:NXEC ND" -$ NG*ET=="@WNG:NXEC NG" -$ NL*INK=="@WNG:NXEC NL" -$ NNET=="@WNG:NXEC NN" -$ NX*REF=="@WNG:NXEC NX" -$ NN*EWS=="HELP/PAGE/LIBRARY=WNG:NNEWS NNEWS" -$ ! -$ WNGFEX=="@WNG:WNGFEX" !PROGRAM FILE HANDLING -$ NCOPY=="@NSC:NCOPY" !FOR DATA COPY -$ DWE*XECUTE=="@WNG:DWEXE" !SPECIAL DWARF EXECUTE -$ ASSIGN/NOLOG WNG:WNG.DEF WNG_DEF !FOR COMPILATIONS -$ NSTAR_DIR=="WNG,DWARF,NSCAN,NCOPY,NMAP,NPLOT" !N DIRECTORIES -$ ! -$ WRITE SYS$OUTPUT "Type nnews for Newstar news" -$ ! -$ EXIT diff --git a/src/wng/wngcshrc.ssc b/src/wng/wngcshrc.ssc deleted file mode 100644 index b49447c3dd647756e5d1de6c1d1775c83a30231d..0000000000000000000000000000000000000000 --- a/src/wng/wngcshrc.ssc +++ /dev/null @@ -1,62 +0,0 @@ -# wngcshrc.ssc -# WNB 920911 -# -# Revisions: -# WNB 920917 Typo WNGFEX -# WNB 921012 Solve symbol conflict and typo -# HJV 921001 Change N-series to Newstar -# WNB 921006 Typo NGET -# WNB 921224 Make SSC -# WNB 930301 Move path to wnglogin.sun -# WNB 930303 Add NSTAR_DIR -# HjV 930414 Typo NSTAR_DIR -# WNB 931217 Add NCOPY to NSTAR_DIR -# -# Environment for all WN programs -# Call by inserting in .cshrc as source wngcshrc.sun -# -#ifdef wn_vax__ -$ WNGTYP=="C''WNG_TYPE'" -$ NXEC=="@WNG:NXEC" -$ NC*OMP=="@WNG:NXEC NC" -$ NDEL=="@WNG:NXEC ND" -$ NG*ET=="@WNG:NXEC NG" -$ NL*INK=="@WNG:NXEC NL" -$ NNET=="@WNG:NXEC NN" -$ NX*REF=="@WNG:NXEC NX" -$ NN*EWS=="HELP/PAGE/LIBRARY=WNG:NNEWS NNEWS" -$ ! -$ WNGFEX=="@WNG:WNGFEX" !PROGRAM FILE HANDLING -$ NCOPY=="@NSC:NCOPY" !FOR DATA COPY -$ DWE*XECUTE=="@WNG:DWEXE" !SPECIAL DWARF EXECUTE -$ ASSIGN/NOLOG WNG:WNG.DEF WNG_DEF !FOR COMPILATIONS -$ NSTAR_DIR=="WNG,DWARF,NSCAN,NCOPY,NMAP,NPLOT" !N DIRECTORIES -$ ! -$ WRITE SYS$OUTPUT "Type nnews for Newstar news" -$ ! -$ EXIT -#else - if ("$?WNGTYP" == "0" && "$?WNG_TYPE" != "0") then - setenv WNGTYP "s$WNG_TYPE" - endif - if ("$?NSTAR_DIR" == "0") then - setenv NSTAR_DIR "wng dwarf nscan ncopy nmap nplot" - endif - alias nxec "csh -f $WNG/nxec.sun" - alias ncomp "csh -f $WNG/nxec.sun ncomp " - alias nlink "csh -f $WNG/nxec.sun nlink " - alias nnet "csh -f $WNG/nxec.sun nnet " - alias nget "csh -f $WNG/nxec.sun nget " - alias ndel "csh -f $WNG/nxec.sun ndel " - alias nxref "csh -f $WNG/nxec.sun nxref " - alias NXEC "csh -f $WNG/nxec.sun" - alias NCOMP "csh -f $WNG/nxec.sun ncomp " - alias NLINK "csh -f $WNG/nxec.sun nlink " - alias NNET "csh -f $WNG/nxec.sun nnet " - alias NGET "csh -f $WNG/nxec.sun nget " - alias NDEL "csh -f $WNG/nxec.sun ndel " - alias NXREF "csh -f $WNG/nxec.sun nxref " - alias nnews "more $WNG/nnews.hlp" - alias WNGFEX "$WNG/wngfex.sun" - alias ncopy "$WNG/../nscan/ncopy.sun" -#endif diff --git a/src/wng/wngcshrc.sun b/src/wng/wngcshrc.sun deleted file mode 100755 index c2b7b64c4f522662c1c705627e078a1f9b5d2f85..0000000000000000000000000000000000000000 --- a/src/wng/wngcshrc.sun +++ /dev/null @@ -1,40 +0,0 @@ -# wngcshrc.ssc -# WNB 920911 -# -# Revisions: -# WNB 920917 Typo WNGFEX -# WNB 921012 Solve symbol conflict and typo -# HJV 921001 Change N-series to Newstar -# WNB 921006 Typo NGET -# WNB 921224 Make SSC -# WNB 930301 Move path to wnglogin.sun -# WNB 930303 Add NSTAR_DIR -# HjV 930414 Typo NSTAR_DIR -# WNB 931217 Add NCOPY to NSTAR_DIR -# -# Environment for all WN programs -# Call by inserting in .cshrc as source wngcshrc.sun -# - if ("$?WNGTYP" == "0" && "$?WNG_TYPE" != "0") then - setenv WNGTYP "s$WNG_TYPE" - endif - if ("$?NSTAR_DIR" == "0") then - setenv NSTAR_DIR "wng dwarf nscan ncopy nmap nplot" - endif - alias nxec "csh -f $WNG/nxec.sun" - alias ncomp "csh -f $WNG/nxec.sun ncomp " - alias nlink "csh -f $WNG/nxec.sun nlink " - alias nnet "csh -f $WNG/nxec.sun nnet " - alias nget "csh -f $WNG/nxec.sun nget " - alias ndel "csh -f $WNG/nxec.sun ndel " - alias nxref "csh -f $WNG/nxec.sun nxref " - alias NXEC "csh -f $WNG/nxec.sun" - alias NCOMP "csh -f $WNG/nxec.sun ncomp " - alias NLINK "csh -f $WNG/nxec.sun nlink " - alias NNET "csh -f $WNG/nxec.sun nnet " - alias NGET "csh -f $WNG/nxec.sun nget " - alias NDEL "csh -f $WNG/nxec.sun ndel " - alias NXREF "csh -f $WNG/nxec.sun nxref " - alias nnews "more $WNG/nnews.hlp" - alias WNGFEX "$WNG/wngfex.sun" - alias ncopy "$WNG/../nscan/ncopy.sun" diff --git a/src/wng/wngcshrc_arecb.com b/src/wng/wngcshrc_arecb.com deleted file mode 100755 index a9c025161fb7a5983cd839f2659b64816decb211..0000000000000000000000000000000000000000 --- a/src/wng/wngcshrc_arecb.com +++ /dev/null @@ -1,30 +0,0 @@ -$!# wngcshrc_arecb.ssc -$!# HjV 930914 -$!# -$!# Revisions: -$!# -$!# Environment for all WN programs -$!# Call by inserting in .cshrc as source wngcshrc_arecb.sun -$!# -$!# Institute: ARECIBO Observatory -$!# Address: P.O. Box 995, Arecibo -$!# Puerto Rico 00613, USA -$!# Contact person: Tapasi Ghosh -$!# Email address: tghosh@naic.edu -$!# FTP-node(s): 192.65.176.4 -$!# Phone: (1)-809-878-2612 -$!# -$ WNG_SITE=="ARECB" -$ WNG_TYPE=="VX" -$ ASSIGN/NOLOG/TRANS=CONCEAL USER5:[WNB.] WNG_DIR: -$ ASSIGN/NOLOG WNG_DIR:[WNG] WNG !GENERAL -$ ASSIGN/NOLOG WNG_DIR:[NSCAN] NSC -$ ASSIGN/NOLOG WNG_DIR:[NMAP] NMA -$ ASSIGN/NOLOG WNG_DIR:[NPLOT] NPL -$ ASSIGN/NOLOG WNG_DIR WNG_OLBEXE: -$ WNG_NODE=="RZMVX4" -$ WNG_NODEUSER=="PRINTVAX PRINTVAX_90A" -$ WNG_NODEDIR=="USER5:[WNB]" -$ @WNG:WNGCSHRC.COM -$ ! -$ EXIT diff --git a/src/wng/wngcshrc_arecb.ssc b/src/wng/wngcshrc_arecb.ssc deleted file mode 100644 index 7ae48f0f8808bb93f919f63b1ab3d5d9a45fbd9b..0000000000000000000000000000000000000000 --- a/src/wng/wngcshrc_arecb.ssc +++ /dev/null @@ -1,50 +0,0 @@ -# wngcshrc_arecb.ssc -# HjV 930914 -# -# Revisions: -# -# Environment for all WN programs -# Call by inserting in .cshrc as source wngcshrc_arecb.sun -# -# Institute: ARECIBO Observatory -# Address: P.O. Box 995, Arecibo -# Puerto Rico 00613, USA -# Contact person: Tapasi Ghosh -# Email address: tghosh@naic.edu -# FTP-node(s): 192.65.176.4 -# Phone: (1)-809-878-2612 -# -#ifdef wn_vax__ -$ WNG_SITE=="ARECB" -$ WNG_TYPE=="VX" -$ ASSIGN/NOLOG/TRANS=CONCEAL USER5:[WNB.] WNG_DIR: -$ ASSIGN/NOLOG WNG_DIR:[WNG] WNG !GENERAL -$ ASSIGN/NOLOG WNG_DIR:[NSCAN] NSC -$ ASSIGN/NOLOG WNG_DIR:[NMAP] NMA -$ ASSIGN/NOLOG WNG_DIR:[NPLOT] NPL -$ ASSIGN/NOLOG WNG_DIR WNG_OLBEXE: -$ WNG_NODE=="RZMVX4" -$ WNG_NODEUSER=="PRINTVAX PRINTVAX_90A" -$ WNG_NODEDIR=="USER5:[WNB]" -$ @WNG:WNGCSHRC.COM -$ ! -$ EXIT -#else - setenv WNG_SITE arecb - setenv WNG /usr/local/newstar/wng - setenv WNG_NODE 192.87.1.105 - setenv WNG_NODEUSER "printvax printvax_90a" - setenv WNG_NODEDIR "user5:[wnb]" - if (! $?HOSTTYPE) then - setenv HOSTTYPE `arch` - endif - if ($HOSTTYPE =~ sun*) then - setenv WNG_TYPE sw - setenv MAG9 "/dev/nrst0" - setenv MAG8 "/dev/nrst1" - setenv LD_LIBRARY_PATH "/usr/openwin/lib:/usr/lib" - endif - setenv WNG_OLBEXE /usr/local/newstar/lib - setenv WNG_EXE /usr/local/newstar/exe - source $WNG/wngcshrc.sun -#endif diff --git a/src/wng/wngcshrc_arecb.sun b/src/wng/wngcshrc_arecb.sun deleted file mode 100755 index 291779efbe5fbc0771a3bf3077ca69723ae54be6..0000000000000000000000000000000000000000 --- a/src/wng/wngcshrc_arecb.sun +++ /dev/null @@ -1,33 +0,0 @@ -# wngcshrc_arecb.ssc -# HjV 930914 -# -# Revisions: -# -# Environment for all WN programs -# Call by inserting in .cshrc as source wngcshrc_arecb.sun -# -# Institute: ARECIBO Observatory -# Address: P.O. Box 995, Arecibo -# Puerto Rico 00613, USA -# Contact person: Tapasi Ghosh -# Email address: tghosh@naic.edu -# FTP-node(s): 192.65.176.4 -# Phone: (1)-809-878-2612 -# - setenv WNG_SITE arecb - setenv WNG /usr/local/newstar/wng - setenv WNG_NODE 192.87.1.105 - setenv WNG_NODEUSER "printvax printvax_90a" - setenv WNG_NODEDIR "user5:[wnb]" - if (! $?HOSTTYPE) then - setenv HOSTTYPE `arch` - endif - if ($HOSTTYPE =~ sun*) then - setenv WNG_TYPE sw - setenv MAG9 "/dev/nrst0" - setenv MAG8 "/dev/nrst1" - setenv LD_LIBRARY_PATH "/usr/openwin/lib:/usr/lib" - endif - setenv WNG_OLBEXE /usr/local/newstar/lib - setenv WNG_EXE /usr/local/newstar/exe - source $WNG/wngcshrc.sun diff --git a/src/wng/wngcshrc_atnf.com b/src/wng/wngcshrc_atnf.com deleted file mode 100755 index a0b4b6bf047bba07ad37b1c20e3a9f1b5d8c84b8..0000000000000000000000000000000000000000 --- a/src/wng/wngcshrc_atnf.com +++ /dev/null @@ -1,34 +0,0 @@ -$!# wngcshrc_atnf.ssc -$!# WNB 920911 -$!# -$!# Revisions: -$!# WNB 921015 Add WNG_EXE -$!# WNB 921022 Add MAG tapes -$!# WNB 921224 Make SSC -$!# WNB 930303 Test machine type -$!# WNB 940124 Change directories; add _OLB _TLB -$!# WNB 940216 Change OLB directories -$!# -$!# Environment for all WN programs -$!# Call by inserting in .cshrc as source wngcshrc_nfra.sun -$!# -$ WNG_SITE=="ATNF" -$ WNG_TYPE=="VX" -$ ASSIGN/NOLOG/TRANS=CONCEAL UTIL0:[BOOK.WBROUW.WNB.] WNG_DIR: -$ ASSIGN/NOLOG WNG_DIR:[WNG] WNG !GENERAL -$ ASSIGN/NOLOG WNG_DIR:[NSCAN] NSC -$ ASSIGN/NOLOG WNG_DIR:[NMAP] NMA -$ ASSIGN/NOLOG WNG_DIR:[NPLOT] NPL -$ ASSIGN/NOLOG WNG_DIR WNG_OLBEXE: -$ WNG_NODE=="norma" -$ WNG_NODEUSER=="wbrouw" -$ WNG_NODEDIR=="/code_norma/nstar" -$ IF F$TRNLNM("MAG0") .EQS. "" THEN - - ASSIGN/NOLOG/TRANS=CONCEAL ROBIN$MSA0: MAG0 -$ IF F$TRNLNM("MAG1") .EQS. "" THEN - - ASSIGN/NOLOG/TRANS=CONCEAL ROBIN$MUB0: MAG1 -$ IF F$TRNLNM("MAG9") .EQS. "" THEN - - ASSIGN/NOLOG/TRANS=CONCEAL ROBIN$MUC0: MAG9 -$ @WNG:WNGCSHRC.COM -$ ! -$ EXIT diff --git a/src/wng/wngcshrc_atnf.ssc b/src/wng/wngcshrc_atnf.ssc deleted file mode 100644 index eaf03c0694011dd31ecf1f691eafbfebf6e4c234..0000000000000000000000000000000000000000 --- a/src/wng/wngcshrc_atnf.ssc +++ /dev/null @@ -1,73 +0,0 @@ -# wngcshrc_atnf.ssc -# WNB 920911 -# -# Revisions: -# WNB 921015 Add WNG_EXE -# WNB 921022 Add MAG tapes -# WNB 921224 Make SSC -# WNB 930303 Test machine type -# WNB 940124 Change directories; add _OLB _TLB -# WNB 940216 Change OLB directories -# -# Environment for all WN programs -# Call by inserting in .cshrc as source wngcshrc_nfra.sun -# -#ifdef wn_vax__ -$ WNG_SITE=="ATNF" -$ WNG_TYPE=="VX" -$ ASSIGN/NOLOG/TRANS=CONCEAL UTIL0:[BOOK.WBROUW.WNB.] WNG_DIR: -$ ASSIGN/NOLOG WNG_DIR:[WNG] WNG !GENERAL -$ ASSIGN/NOLOG WNG_DIR:[NSCAN] NSC -$ ASSIGN/NOLOG WNG_DIR:[NMAP] NMA -$ ASSIGN/NOLOG WNG_DIR:[NPLOT] NPL -$ ASSIGN/NOLOG WNG_DIR WNG_OLBEXE: -$ WNG_NODE=="norma" -$ WNG_NODEUSER=="wbrouw" -$ WNG_NODEDIR=="/code_norma/nstar" -$ IF F$TRNLNM("MAG0") .EQS. "" THEN - - ASSIGN/NOLOG/TRANS=CONCEAL ROBIN$MSA0: MAG0 -$ IF F$TRNLNM("MAG1") .EQS. "" THEN - - ASSIGN/NOLOG/TRANS=CONCEAL ROBIN$MUB0: MAG1 -$ IF F$TRNLNM("MAG9") .EQS. "" THEN - - ASSIGN/NOLOG/TRANS=CONCEAL ROBIN$MUC0: MAG9 -$ @WNG:WNGCSHRC.COM -$ ! -$ EXIT -#else - setenv WNG_SITE atnf - if (! $?host) set host=`hostname` - if ($host == ateles) then - setenv WNG_TYPE cv - setenv MAG0 "/dev/rmt8" - setenv MAG1 "/dev/rmt16" - setenv MAG2 "/dev/rmt0" - setenv MAG3 "/dev/rmt9" - setenv MAG4 "/dev/rmt17" - setenv MAG5 "/dev/rmt1" - else if ($host == norma) then - setenv WNG_TYPE dw - else if ($?MACHINE_ARC) then - if ("$MACHINE_ARC" == "dec") then - setenv WNG_TYPE dw - else - setenv WNG_TYPE sw - if ($host == carina) then - setenv MAG9 "/dev/nrst0" - endif - endif - else - setenv WNG_TYPE sw - if ($host == carina) then - setenv MAG9 "/dev/nrst0" - endif - endif - setenv WNG /code_norma/nstar/wng - setenv WNG_OLBEXE /code_norma/nstar/olb/s$WNG_TYPE - setenv WNG_OLB /code_norma/nstar/olb/s$WNG_TYPE - setenv WNG_TLB /comp/wbrouw/wnb - setenv WNG_EXE /newstar/s$WNG_TYPE - setenv WNG_NODE ROBIN - setenv WNG_NODEUSER "wbrouw" - setenv WNG_NODEDIR "user5:[wnb]" - source $WNG/wngcshrc.sun -#endif diff --git a/src/wng/wngcshrc_atnf.sun b/src/wng/wngcshrc_atnf.sun deleted file mode 100755 index 2257fcd1caf64cce79f3a00d6fc7e9ed72816228..0000000000000000000000000000000000000000 --- a/src/wng/wngcshrc_atnf.sun +++ /dev/null @@ -1,50 +0,0 @@ -# wngcshrc_atnf.ssc -# WNB 920911 -# -# Revisions: -# WNB 921015 Add WNG_EXE -# WNB 921022 Add MAG tapes -# WNB 921224 Make SSC -# WNB 930303 Test machine type -# WNB 940124 Change directories; add _OLB _TLB -# WNB 940216 Change OLB directories -# -# Environment for all WN programs -# Call by inserting in .cshrc as source wngcshrc_nfra.sun -# - setenv WNG_SITE atnf - if (! $?host) set host=`hostname` - if ($host == ateles) then - setenv WNG_TYPE cv - setenv MAG0 "/dev/rmt8" - setenv MAG1 "/dev/rmt16" - setenv MAG2 "/dev/rmt0" - setenv MAG3 "/dev/rmt9" - setenv MAG4 "/dev/rmt17" - setenv MAG5 "/dev/rmt1" - else if ($host == norma) then - setenv WNG_TYPE dw - else if ($?MACHINE_ARC) then - if ("$MACHINE_ARC" == "dec") then - setenv WNG_TYPE dw - else - setenv WNG_TYPE sw - if ($host == carina) then - setenv MAG9 "/dev/nrst0" - endif - endif - else - setenv WNG_TYPE sw - if ($host == carina) then - setenv MAG9 "/dev/nrst0" - endif - endif - setenv WNG /code_norma/nstar/wng - setenv WNG_OLBEXE /code_norma/nstar/olb/s$WNG_TYPE - setenv WNG_OLB /code_norma/nstar/olb/s$WNG_TYPE - setenv WNG_TLB /comp/wbrouw/wnb - setenv WNG_EXE /newstar/s$WNG_TYPE - setenv WNG_NODE ROBIN - setenv WNG_NODEUSER "wbrouw" - setenv WNG_NODEDIR "user5:[wnb]" - source $WNG/wngcshrc.sun diff --git a/src/wng/wngcshrc_kosma.com b/src/wng/wngcshrc_kosma.com deleted file mode 100755 index ecafd21bcf4ced7d436349a731072c25ae75fd3b..0000000000000000000000000000000000000000 --- a/src/wng/wngcshrc_kosma.com +++ /dev/null @@ -1,29 +0,0 @@ -$!# wngcshrc_kosma.ssc -$!# HjV 930630 -$!# -$!# Revisions: -$!# HjV 930720 Typo's -$!# -$!# Environment for all WN programs -$!# Call by inserting in .cshrc as source wngcshrc_kosma.sun -$!# -$ WNG_SITE=="KOSMA" -$ WNG_TYPE=="VX" -$ ASSIGN/NOLOG/TRANS=CONCEAL APOLLO_UTILDSK:[NEWSTAR.] WNG_DIR: -$ ASSIGN/NOLOG WNG_DIR:[WNG] WNG !GENERAL -$ ASSIGN/NOLOG WNG_DIR:[NSCAN] NSC -$ ASSIGN/NOLOG WNG_DIR:[NMAP] NMA -$ ASSIGN/NOLOG WNG_DIR:[NPLOT] NPL -$ ASSIGN/NOLOG WNG_DIR WNG_OLBEXE: -$ WNG_NODE=="192.87.1.105" -$ WNG_NODEUSER=="PRINTVAX PRINTVAX_90A" -$ WNG_NODEDIR=="USER5:[WNB]" -$ IF F$TRNLNM("MAG0") .EQS. "" THEN - - ASSIGN/NOLOG/TRANS=CONCEAL MTAPE MAG0 -$ IF F$TRNLNM("MAG1") .EQS. "" THEN - - ASSIGN/NOLOG/TRANS=CONCEAL GTAPE MAG1 -$ IF F$TRNLNM("MAG8") .EQS. "" THEN - - ASSIGN/NOLOG/TRANS=CONCEAL DAT MAG8 -$ @WNG:WNGCSHRC.COM -$ ! -$ EXIT diff --git a/src/wng/wngcshrc_kosma.ssc b/src/wng/wngcshrc_kosma.ssc deleted file mode 100644 index 676e566e18f073e29c59933cdd6c88f6c1e0d277..0000000000000000000000000000000000000000 --- a/src/wng/wngcshrc_kosma.ssc +++ /dev/null @@ -1,49 +0,0 @@ -# wngcshrc_kosma.ssc -# HjV 930630 -# -# Revisions: -# HjV 930720 Typo's -# -# Environment for all WN programs -# Call by inserting in .cshrc as source wngcshrc_kosma.sun -# -#ifdef wn_vax__ -$ WNG_SITE=="KOSMA" -$ WNG_TYPE=="VX" -$ ASSIGN/NOLOG/TRANS=CONCEAL APOLLO_UTILDSK:[NEWSTAR.] WNG_DIR: -$ ASSIGN/NOLOG WNG_DIR:[WNG] WNG !GENERAL -$ ASSIGN/NOLOG WNG_DIR:[NSCAN] NSC -$ ASSIGN/NOLOG WNG_DIR:[NMAP] NMA -$ ASSIGN/NOLOG WNG_DIR:[NPLOT] NPL -$ ASSIGN/NOLOG WNG_DIR WNG_OLBEXE: -$ WNG_NODE=="192.87.1.105" -$ WNG_NODEUSER=="PRINTVAX PRINTVAX_90A" -$ WNG_NODEDIR=="USER5:[WNB]" -$ IF F$TRNLNM("MAG0") .EQS. "" THEN - - ASSIGN/NOLOG/TRANS=CONCEAL MTAPE MAG0 -$ IF F$TRNLNM("MAG1") .EQS. "" THEN - - ASSIGN/NOLOG/TRANS=CONCEAL GTAPE MAG1 -$ IF F$TRNLNM("MAG8") .EQS. "" THEN - - ASSIGN/NOLOG/TRANS=CONCEAL DAT MAG8 -$ @WNG:WNGCSHRC.COM -$ ! -$ EXIT -#else - setenv WNG_SITE kosma - if (! $?host) set host=`hostname` - if ($host =~ apollo*) then - setenv WNG_TYPE hp - setenv MAG8 "/dev/rmt/0m" - setenv WNG_LDFILES "/usr/lib/X11R4/libX11.a" - else - setenv WNG_TYPE hp - setenv MAG8 "/dev/rmt/0m" - setenv WNG_LDFILES "/usr/lib/X11R4/libX11.a" - endif - setenv WNG /utildsk/newstar/wng - setenv WNG_OLBEXE $WNG/.. - setenv WNG_NODE 192.87.1.105 - setenv WNG_NODEUSER "printvax printvax_90a" - setenv WNG_NODEDIR "user5:[wnb]" - source $WNG/wngcshrc.sun -#endif diff --git a/src/wng/wngcshrc_kosma.sun b/src/wng/wngcshrc_kosma.sun deleted file mode 100755 index 2414db74c7a8d03c6f3e960bbcad72b6db844f58..0000000000000000000000000000000000000000 --- a/src/wng/wngcshrc_kosma.sun +++ /dev/null @@ -1,26 +0,0 @@ -# wngcshrc_kosma.ssc -# HjV 930630 -# -# Revisions: -# HjV 930720 Typo's -# -# Environment for all WN programs -# Call by inserting in .cshrc as source wngcshrc_kosma.sun -# - setenv WNG_SITE kosma - if (! $?host) set host=`hostname` - if ($host =~ apollo*) then - setenv WNG_TYPE hp - setenv MAG8 "/dev/rmt/0m" - setenv WNG_LDFILES "/usr/lib/X11R4/libX11.a" - else - setenv WNG_TYPE hp - setenv MAG8 "/dev/rmt/0m" - setenv WNG_LDFILES "/usr/lib/X11R4/libX11.a" - endif - setenv WNG /utildsk/newstar/wng - setenv WNG_OLBEXE $WNG/.. - setenv WNG_NODE 192.87.1.105 - setenv WNG_NODEUSER "printvax printvax_90a" - setenv WNG_NODEDIR "user5:[wnb]" - source $WNG/wngcshrc.sun diff --git a/src/wng/wngcshrc_nfra.com b/src/wng/wngcshrc_nfra.com deleted file mode 100755 index dd9f253eb3cd414adbbdccb5b29fc65bd8af790a..0000000000000000000000000000000000000000 --- a/src/wng/wngcshrc_nfra.com +++ /dev/null @@ -1,46 +0,0 @@ -$!# wngcshrc_nfra.ssc -$!# WNB 920911 -$!# -$!# Revisions: -$!# WNB 921022 Add magtapes -$!# HJV 921201 Hostname Alliant in uppercase -$!# WNB 921224 Make SSC -$!# HjV 930226 Add HP workstations -$!# HjV 930420 Change WNG_LDFILES, add gids_setup -$!# HjV 930503 Remove WNG_LDFILES and gids_setup -$!# HjV 930607 Do not use ~ anymore, use full pathname -$!# HjV 930621 Change test HOSTTYPE for HP and SUN -$!# CMV 930721 Add LD_LIBRARY_PATH for SUN -$!# CMV 930805 Some temporary changes: documentation programs -$!# -$!# Environment for all WN programs -$!# Call by inserting in .cshrc as source wngcshrc_nfra.sun -$!# -$ WNG_SITE=="NFRA" -$ WNG_TYPE=="VX" -$ ASSIGN/NOLOG/TRANS=CONCEAL USER5:[WNB.] WNG_DIR: -$ ASSIGN/NOLOG WNG_DIR:[WNG] WNG !GENERAL -$ ASSIGN/NOLOG WNG_DIR:[NSCAN] NSC -$ ASSIGN/NOLOG WNG_DIR:[NMAP] NMA -$ ASSIGN/NOLOG WNG_DIR:[NPLOT] NPL -$ ASSIGN/NOLOG WNG_DIR WNG_OLBEXE: -$ WNG_NODE=="RZMVX4" -$ WNG_NODEUSER=="PRINTVAX PRINTVAX_90A" -$ WNG_NODEDIR=="USER5:[WNB]" -$ IF F$TRNLNM("MAG0") .EQS. "" THEN - - ASSIGN/NOLOG/TRANS=CONCEAL RZMVX4$MUB0: MAG0 -$ IF F$TRNLNM("MAG1") .EQS. "" THEN - - ASSIGN/NOLOG/TRANS=CONCEAL RZMVX4$MUC0: MAG1 -$ IF F$TRNLNM("MAG4") .EQS. "" THEN - - ASSIGN/NOLOG/TRANS=CONCEAL RZMVX4$MUA0: MAG4 -$ IF F$TRNLNM("MAG5") .EQS. "" THEN - - ASSIGN/NOLOG/TRANS=CONCEAL RZMVX4$MUA1: MAG5 -$ IF F$TRNLNM("MAG9") .EQS. "" THEN - - ASSIGN/NOLOG/TRANS=CONCEAL RZMVX5$MUA0: MAG9 -$ IF F$TRNLNM("MAG8") .EQS. "" THEN - - ASSIGN/NOLOG/TRANS=CONCEAL RZMVX5$MKA500: MAG8 -$ IF F$TRNLNM("MAG7") .EQS. "" THEN - - ASSIGN/NOLOG/TRANS=CONCEAL RZMSUR$MUA0: MAG7 -$ @WNG:WNGCSHRC.COM -$ ! -$ EXIT diff --git a/src/wng/wngcshrc_nfra.ssc b/src/wng/wngcshrc_nfra.ssc deleted file mode 100644 index c5aa9a426320558991e5eeb5af30f29eac716f48..0000000000000000000000000000000000000000 --- a/src/wng/wngcshrc_nfra.ssc +++ /dev/null @@ -1,101 +0,0 @@ -# wngcshrc_nfra.ssc -# WNB 920911 -# -# Revisions: -# WNB 921022 Add magtapes -# HJV 921201 Hostname Alliant in uppercase -# WNB 921224 Make SSC -# HjV 930226 Add HP workstations -# HjV 930420 Change WNG_LDFILES, add gids_setup -# HjV 930503 Remove WNG_LDFILES and gids_setup -# HjV 930607 Do not use ~ anymore, use full pathname -# HjV 930621 Change test HOSTTYPE for HP and SUN -# CMV 930721 Add LD_LIBRARY_PATH for SUN -# CMV 930805 Some temporary changes: documentation programs -# -# Environment for all WN programs -# Call by inserting in .cshrc as source wngcshrc_nfra.sun -# -#ifdef wn_vax__ -$ WNG_SITE=="NFRA" -$ WNG_TYPE=="VX" -$ ASSIGN/NOLOG/TRANS=CONCEAL USER5:[WNB.] WNG_DIR: -$ ASSIGN/NOLOG WNG_DIR:[WNG] WNG !GENERAL -$ ASSIGN/NOLOG WNG_DIR:[NSCAN] NSC -$ ASSIGN/NOLOG WNG_DIR:[NMAP] NMA -$ ASSIGN/NOLOG WNG_DIR:[NPLOT] NPL -$ ASSIGN/NOLOG WNG_DIR WNG_OLBEXE: -$ WNG_NODE=="RZMVX4" -$ WNG_NODEUSER=="PRINTVAX PRINTVAX_90A" -$ WNG_NODEDIR=="USER5:[WNB]" -$ IF F$TRNLNM("MAG0") .EQS. "" THEN - - ASSIGN/NOLOG/TRANS=CONCEAL RZMVX4$MUB0: MAG0 -$ IF F$TRNLNM("MAG1") .EQS. "" THEN - - ASSIGN/NOLOG/TRANS=CONCEAL RZMVX4$MUC0: MAG1 -$ IF F$TRNLNM("MAG4") .EQS. "" THEN - - ASSIGN/NOLOG/TRANS=CONCEAL RZMVX4$MUA0: MAG4 -$ IF F$TRNLNM("MAG5") .EQS. "" THEN - - ASSIGN/NOLOG/TRANS=CONCEAL RZMVX4$MUA1: MAG5 -$ IF F$TRNLNM("MAG9") .EQS. "" THEN - - ASSIGN/NOLOG/TRANS=CONCEAL RZMVX5$MUA0: MAG9 -$ IF F$TRNLNM("MAG8") .EQS. "" THEN - - ASSIGN/NOLOG/TRANS=CONCEAL RZMVX5$MKA500: MAG8 -$ IF F$TRNLNM("MAG7") .EQS. "" THEN - - ASSIGN/NOLOG/TRANS=CONCEAL RZMSUR$MUA0: MAG7 -$ @WNG:WNGCSHRC.COM -$ ! -$ EXIT -#else - setenv WNG_SITE nfra - setenv WNG /home/rzmws0/wnb/wng - setenv WNG_NODE RZMVX4 - setenv WNG_NODEUSER "printvax printvax_90a" - setenv WNG_NODEDIR "user5:[wnb]" - if (! $?host) set host=`hostname` - if ($host =~ RZMA*) then - setenv WNG_TYPE al - setenv WNG_OLBEXE $WNG/.. - setenv MAG0 "/dev/rxt00m" - setenv MAG1 "/dev/rxt00h" - setenv MAG2 "/dev/rxt00l" - setenv MAG8 "/dev/sdt3" - else if ($host =~ rzmd*) then - setenv WNG_TYPE dw - setenv WNG_OLBEXE /newstar/s$WNG_TYPE/lib - setenv WNG_EXE /newstar/s$WNG_TYPE/exe - setenv MAG9 "/dev/rmt0h" - setenv MAG8 "/dev/rmt1h" - else - if (! $?HOSTTYPE) then - setenv HOSTTYPE `arch` - endif - if ($HOSTTYPE =~ sun*) then - setenv WNG_TYPE sw - setenv MAG9 "/dev/rst0" - setenv MAG8 "/dev/rst1" - setenv LD_LIBRARY_PATH "/usr/openwin/lib:/usr/lib" - setenv n_exe /newstar/devoscm/exe/sw - else if ($HOSTTYPE =~ hp*) then - setenv WNG_TYPE hp - setenv MAG8 "/dev/rmt/0m" - setenv n_exe /newstar/devoscm/exe/hp - endif - setenv WNG_OLBEXE /newstar/s$WNG_TYPE/lib - setenv WNG_EXE /newstar/s$WNG_TYPE/exe - setenv n_src /newstar/devoscm/src -# -# CMV 05/07/93 Taken from new maintenance routines -# - alias ndoc /newstar/devoscm/src/sys/document.csh - alias nhyper ndoc hyper - alias nscript ndoc script -# -# To facilate the script utility, we may set a different prompt -# - if ($?n_script) then - set prompt="script> " - alias \# 'echo \!* >/dev/null' - endif - endif - source $WNG/wngcshrc.sun -#endif diff --git a/src/wng/wngcshrc_nfra.sun b/src/wng/wngcshrc_nfra.sun deleted file mode 100755 index f8a9ac327967b4971ed174687fac4770175200c6..0000000000000000000000000000000000000000 --- a/src/wng/wngcshrc_nfra.sun +++ /dev/null @@ -1,70 +0,0 @@ -# wngcshrc_nfra.ssc -# WNB 920911 -# -# Revisions: -# WNB 921022 Add magtapes -# HJV 921201 Hostname Alliant in uppercase -# WNB 921224 Make SSC -# HjV 930226 Add HP workstations -# HjV 930420 Change WNG_LDFILES, add gids_setup -# HjV 930503 Remove WNG_LDFILES and gids_setup -# HjV 930607 Do not use ~ anymore, use full pathname -# HjV 930621 Change test HOSTTYPE for HP and SUN -# CMV 930721 Add LD_LIBRARY_PATH for SUN -# CMV 930805 Some temporary changes: documentation programs -# -# Environment for all WN programs -# Call by inserting in .cshrc as source wngcshrc_nfra.sun -# - setenv WNG_SITE nfra - setenv WNG /home/rzmws0/wnb/wng - setenv WNG_NODE RZMVX4 - setenv WNG_NODEUSER "printvax printvax_90a" - setenv WNG_NODEDIR "user5:[wnb]" - if (! $?host) set host=`hostname` - if ($host =~ RZMA*) then - setenv WNG_TYPE al - setenv WNG_OLBEXE $WNG/.. - setenv MAG0 "/dev/rxt00m" - setenv MAG1 "/dev/rxt00h" - setenv MAG2 "/dev/rxt00l" - setenv MAG8 "/dev/sdt3" - else if ($host =~ rzmd*) then - setenv WNG_TYPE dw - setenv WNG_OLBEXE /newstar/s$WNG_TYPE/lib - setenv WNG_EXE /newstar/s$WNG_TYPE/exe - setenv MAG9 "/dev/rmt0h" - setenv MAG8 "/dev/rmt1h" - else - if (! $?HOSTTYPE) then - setenv HOSTTYPE `arch` - endif - if ($HOSTTYPE =~ sun*) then - setenv WNG_TYPE sw - setenv MAG9 "/dev/rst0" - setenv MAG8 "/dev/rst1" - setenv LD_LIBRARY_PATH "/usr/openwin/lib:/usr/lib" - setenv n_exe /newstar/devoscm/exe/sw - else if ($HOSTTYPE =~ hp*) then - setenv WNG_TYPE hp - setenv MAG8 "/dev/rmt/0m" - setenv n_exe /newstar/devoscm/exe/hp - endif - setenv WNG_OLBEXE /newstar/s$WNG_TYPE/lib - setenv WNG_EXE /newstar/s$WNG_TYPE/exe - setenv n_src /newstar/devoscm/src -# -# CMV 05/07/93 Taken from new maintenance routines -# - alias ndoc /newstar/devoscm/src/sys/document.csh - alias nhyper ndoc hyper - alias nscript ndoc script -# -# To facilate the script utility, we may set a different prompt -# - if ($?n_script) then - set prompt="script> " - alias \# 'echo \!* >/dev/null' - endif - endif - source $WNG/wngcshrc.sun diff --git a/src/wng/wngcshrc_raiub.com b/src/wng/wngcshrc_raiub.com deleted file mode 100755 index f32b958f6cf8a11d29440261ad493a39cd0806ab..0000000000000000000000000000000000000000 --- a/src/wng/wngcshrc_raiub.com +++ /dev/null @@ -1,25 +0,0 @@ -$!# wngcshrc_raiub.ssc -$!# HjV 921106 -$!# -$!# Revisions: -$!# WNB 921224 Make SSC -$!# HjV 930420 Change WNG_LDFILES, add gids_setup -$!# HjV 930503 Remove WNG_LDFILES and gids_setup -$!# -$!# Environment for all WN programs -$!# Call by inserting in .cshrc as source wngcshrc_raiub.sun -$!# -$ WNG_SITE=="RAIUB" -$ WNG_TYPE=="VX" -$ ASSIGN/NOLOG/TRANS=CONCEAL USER0:[WNB] WNG_DIR: !NONSENS !! -$ ASSIGN/NOLOG WNG_DIR:[WNG] WNG !GENERAL -$ ASSIGN/NOLOG WNG_DIR:[NSCAN] NSC -$ ASSIGN/NOLOG WNG_DIR:[NMAP] NMA -$ ASSIGN/NOLOG WNG_DIR:[NPLOT] NPL -$ ASSIGN/NOLOG WNG_DIR WNG_OLBEXE: -$ WNG_NODE=="RZMVX4.NFRA.NL" -$ WNG_NODEUSER=="PRINTVAX PRINTVAX_90A" -$ WNG_NODEDIR=="USER5:[WNB]" -$ @WNG:WNGCSHRC.COM -$ ! -$ EXIT diff --git a/src/wng/wngcshrc_raiub.ssc b/src/wng/wngcshrc_raiub.ssc deleted file mode 100644 index 088cf9cf70ae8f88f39b35c4b6480cb1e64bc3f1..0000000000000000000000000000000000000000 --- a/src/wng/wngcshrc_raiub.ssc +++ /dev/null @@ -1,45 +0,0 @@ -# wngcshrc_raiub.ssc -# HjV 921106 -# -# Revisions: -# WNB 921224 Make SSC -# HjV 930420 Change WNG_LDFILES, add gids_setup -# HjV 930503 Remove WNG_LDFILES and gids_setup -# -# Environment for all WN programs -# Call by inserting in .cshrc as source wngcshrc_raiub.sun -# -#ifdef wn_vax__ -$ WNG_SITE=="RAIUB" -$ WNG_TYPE=="VX" -$ ASSIGN/NOLOG/TRANS=CONCEAL USER0:[WNB] WNG_DIR: !NONSENS !! -$ ASSIGN/NOLOG WNG_DIR:[WNG] WNG !GENERAL -$ ASSIGN/NOLOG WNG_DIR:[NSCAN] NSC -$ ASSIGN/NOLOG WNG_DIR:[NMAP] NMA -$ ASSIGN/NOLOG WNG_DIR:[NPLOT] NPL -$ ASSIGN/NOLOG WNG_DIR WNG_OLBEXE: -$ WNG_NODE=="RZMVX4.NFRA.NL" -$ WNG_NODEUSER=="PRINTVAX PRINTVAX_90A" -$ WNG_NODEDIR=="USER5:[WNB]" -$ @WNG:WNGCSHRC.COM -$ ! -$ EXIT -#else - setenv WNG_SITE raiub - if (! $?host) set host=`hostname` - if ($host =~ sun*) then - setenv WNG_TYPE sw - setenv MAG9 "/dev/rst0" - setenv MAG8 "/dev/rst1" - else - setenv WNG_TYPE sw - setenv MAG9 "/dev/rst0" - setenv MAG8 "/dev/rst1" - endif - setenv WNG /aux29/dwingeloo/newstar/wng - setenv WNG_OLBEXE $WNG/.. - setenv WNG_NODE 192.87.1.105 - setenv WNG_NODEUSER "printvax printvax_90a" - setenv WNG_NODEDIR "user5:[wnb]" - source $WNG/wngcshrc.sun -#endif diff --git a/src/wng/wngcshrc_raiub.sun b/src/wng/wngcshrc_raiub.sun deleted file mode 100755 index 2d22cbf7278143f287a58e62e1d30f5b7c3fbfbf..0000000000000000000000000000000000000000 --- a/src/wng/wngcshrc_raiub.sun +++ /dev/null @@ -1,28 +0,0 @@ -# wngcshrc_raiub.ssc -# HjV 921106 -# -# Revisions: -# WNB 921224 Make SSC -# HjV 930420 Change WNG_LDFILES, add gids_setup -# HjV 930503 Remove WNG_LDFILES and gids_setup -# -# Environment for all WN programs -# Call by inserting in .cshrc as source wngcshrc_raiub.sun -# - setenv WNG_SITE raiub - if (! $?host) set host=`hostname` - if ($host =~ sun*) then - setenv WNG_TYPE sw - setenv MAG9 "/dev/rst0" - setenv MAG8 "/dev/rst1" - else - setenv WNG_TYPE sw - setenv MAG9 "/dev/rst0" - setenv MAG8 "/dev/rst1" - endif - setenv WNG /aux29/dwingeloo/newstar/wng - setenv WNG_OLBEXE $WNG/.. - setenv WNG_NODE 192.87.1.105 - setenv WNG_NODEUSER "printvax printvax_90a" - setenv WNG_NODEDIR "user5:[wnb]" - source $WNG/wngcshrc.sun diff --git a/src/wng/wngcshrc_rug.com b/src/wng/wngcshrc_rug.com deleted file mode 100755 index b490c1d012d9768ea699191ce5913b1d6bd36918..0000000000000000000000000000000000000000 --- a/src/wng/wngcshrc_rug.com +++ /dev/null @@ -1,29 +0,0 @@ -$!# wngcshrc_rug.ssc -$!# WNB 920911 -$!# -$!# Revisions: -$!# HjV 921124 Change for new situation in Groningen -$!# WNB 921224 Make SSC -$!# HjV 930226 Change WNG_LDFILES -$!# HjV 930420 Change WNG_LDFILES, add gids_setup -$!# HjV 930503 Remove WNG_LDFILES and gids_setup -$!# HjV 930607 Change name of disk (dj3 iso. dj2) -$!# HjV 930920 Add new DAT-devices -$!# -$!# Environment for all WN programs -$!# Call by inserting in .cshrc as source $WNG/wngcshrc_rug.sun -$!# -$ WNG_SITE=="RUG" -$ WNG_TYPE=="VX" -$ ASSIGN/NOLOG/TRANS=CONCEAL DU$GWS:[GWSX.WNB.] WNG_DIR: -$ ASSIGN/NOLOG WNG_DIR:[WNG] WNG !GENERAL -$ ASSIGN/NOLOG WNG_DIR:[NSCAN] NSC -$ ASSIGN/NOLOG WNG_DIR:[NMAP] NMA -$ ASSIGN/NOLOG WNG_DIR:[NPLOT] NPL -$ ASSIGN/NOLOG WNG_DIR WNG_OLBEXE: -$ WNG_NODE=="RZMVX4.NFRA.NL" -$ WNG_NODEUSER=="PRINTVAX PRINTVAX_90A" -$ WNG_NODEDIR=="USER5:[WNB]" -$ @WNG:WNGCSHRC.COM -$ ! -$ EXIT diff --git a/src/wng/wngcshrc_rug.ssc b/src/wng/wngcshrc_rug.ssc deleted file mode 100644 index 01e797e1d8aff0e91a78ab0224e2b046f03f6a77..0000000000000000000000000000000000000000 --- a/src/wng/wngcshrc_rug.ssc +++ /dev/null @@ -1,57 +0,0 @@ -# wngcshrc_rug.ssc -# WNB 920911 -# -# Revisions: -# HjV 921124 Change for new situation in Groningen -# WNB 921224 Make SSC -# HjV 930226 Change WNG_LDFILES -# HjV 930420 Change WNG_LDFILES, add gids_setup -# HjV 930503 Remove WNG_LDFILES and gids_setup -# HjV 930607 Change name of disk (dj3 iso. dj2) -# HjV 930920 Add new DAT-devices -# -# Environment for all WN programs -# Call by inserting in .cshrc as source $WNG/wngcshrc_rug.sun -# -#ifdef wn_vax__ -$ WNG_SITE=="RUG" -$ WNG_TYPE=="VX" -$ ASSIGN/NOLOG/TRANS=CONCEAL DU$GWS:[GWSX.WNB.] WNG_DIR: -$ ASSIGN/NOLOG WNG_DIR:[WNG] WNG !GENERAL -$ ASSIGN/NOLOG WNG_DIR:[NSCAN] NSC -$ ASSIGN/NOLOG WNG_DIR:[NMAP] NMA -$ ASSIGN/NOLOG WNG_DIR:[NPLOT] NPL -$ ASSIGN/NOLOG WNG_DIR WNG_OLBEXE: -$ WNG_NODE=="RZMVX4.NFRA.NL" -$ WNG_NODEUSER=="PRINTVAX PRINTVAX_90A" -$ WNG_NODEDIR=="USER5:[WNB]" -$ @WNG:WNGCSHRC.COM -$ ! -$ EXIT -#else - setenv WNG_SITE rug - if ($HOSTTYPE =~ al*) then - setenv WNG_TYPE al - else if ($HOSTTYPE =~ hp*) then - setenv WNG_TYPE hp - if ($HOST == shapley) then - setenv MAG8 "/dev/rmt/0mn" - endif - setenv MAG0 "/dev/nrxtv00m" - setenv MAG1 "/dev/nrxtv00h" - else - setenv WNG_TYPE sw - if ($HOST == halley) then - setenv MAG8 "/dev/nrst5" - else if ($HOST == hubble) then - setenv MAG8 "/dev/nrst5" - endif - endif - setenv WNG /dj3/users/newstar/wng - setenv WNG_OLBEXE $WNG/../lib/s$WNG_TYPE - setenv WNG_EXE $WNG/../exe/s$WNG_TYPE - setenv WNG_NODE 192.87.1.105 - setenv WNG_NODEUSER "printvax printvax_90a" - setenv WNG_NODEDIR "user5:[wnb]" - source $WNG/wngcshrc.sun -#endif diff --git a/src/wng/wngcshrc_rug.sun b/src/wng/wngcshrc_rug.sun deleted file mode 100755 index 1b36ad677f62a686c4b25a9f460ebb1708a6c830..0000000000000000000000000000000000000000 --- a/src/wng/wngcshrc_rug.sun +++ /dev/null @@ -1,40 +0,0 @@ -# wngcshrc_rug.ssc -# WNB 920911 -# -# Revisions: -# HjV 921124 Change for new situation in Groningen -# WNB 921224 Make SSC -# HjV 930226 Change WNG_LDFILES -# HjV 930420 Change WNG_LDFILES, add gids_setup -# HjV 930503 Remove WNG_LDFILES and gids_setup -# HjV 930607 Change name of disk (dj3 iso. dj2) -# HjV 930920 Add new DAT-devices -# -# Environment for all WN programs -# Call by inserting in .cshrc as source $WNG/wngcshrc_rug.sun -# - setenv WNG_SITE rug - if ($HOSTTYPE =~ al*) then - setenv WNG_TYPE al - else if ($HOSTTYPE =~ hp*) then - setenv WNG_TYPE hp - if ($HOST == shapley) then - setenv MAG8 "/dev/rmt/0mn" - endif - setenv MAG0 "/dev/nrxtv00m" - setenv MAG1 "/dev/nrxtv00h" - else - setenv WNG_TYPE sw - if ($HOST == halley) then - setenv MAG8 "/dev/nrst5" - else if ($HOST == hubble) then - setenv MAG8 "/dev/nrst5" - endif - endif - setenv WNG /dj3/users/newstar/wng - setenv WNG_OLBEXE $WNG/../lib/s$WNG_TYPE - setenv WNG_EXE $WNG/../exe/s$WNG_TYPE - setenv WNG_NODE 192.87.1.105 - setenv WNG_NODEUSER "printvax printvax_90a" - setenv WNG_NODEDIR "user5:[wnb]" - source $WNG/wngcshrc.sun diff --git a/src/wng/wngcshrc_wsrt.com b/src/wng/wngcshrc_wsrt.com deleted file mode 100755 index ecf02d997f30185633f87dcad16f33383aba74f8..0000000000000000000000000000000000000000 --- a/src/wng/wngcshrc_wsrt.com +++ /dev/null @@ -1,25 +0,0 @@ -$!# wngcshrc_wsrt.ssc -$!# HjV 930120 -$!# -$!# Revisions: -$!# HjV 930420 Change WNG_LDFILES, add gids_setup -$!# HjV 930503 Remove WNG_LDFILES and gids_setup -$!# HjV 930527 Change WNG_NODE and MAG8 -$!# -$!# Environment for all WN programs -$!# Call by inserting in .cshrc as source wngcshrc_wsrt.sun -$!# -$ WNG_SITE=="WSRT" -$ WNG_TYPE=="VX" -$ ASSIGN/NOLOG/TRANS=CONCEAL USER5:[WNB.] WNG_DIR: -$ ASSIGN/NOLOG WNG_DIR:[WNG] WNG !GENERAL -$ ASSIGN/NOLOG WNG_DIR:[NSCAN] NSC -$ ASSIGN/NOLOG WNG_DIR:[NMAP] NMA -$ ASSIGN/NOLOG WNG_DIR:[NPLOT] NPL -$ ASSIGN/NOLOG WNG_DIR WNG_OLBEXE: -$ WNG_NODE=="192.87.1.105" -$ WNG_NODEUSER=="PRINTVAX PRINTVAX_90A" -$ WNG_NODEDIR=="USER5:[WNB]" -$ @WNG:WNGCSHRC.COM -$ ! -$ EXIT diff --git a/src/wng/wngcshrc_wsrt.ssc b/src/wng/wngcshrc_wsrt.ssc deleted file mode 100644 index 91dcc52bdf441dfcf2c78c0af36a85d499be3ec0..0000000000000000000000000000000000000000 --- a/src/wng/wngcshrc_wsrt.ssc +++ /dev/null @@ -1,44 +0,0 @@ -# wngcshrc_wsrt.ssc -# HjV 930120 -# -# Revisions: -# HjV 930420 Change WNG_LDFILES, add gids_setup -# HjV 930503 Remove WNG_LDFILES and gids_setup -# HjV 930527 Change WNG_NODE and MAG8 -# -# Environment for all WN programs -# Call by inserting in .cshrc as source wngcshrc_wsrt.sun -# -#ifdef wn_vax__ -$ WNG_SITE=="WSRT" -$ WNG_TYPE=="VX" -$ ASSIGN/NOLOG/TRANS=CONCEAL USER5:[WNB.] WNG_DIR: -$ ASSIGN/NOLOG WNG_DIR:[WNG] WNG !GENERAL -$ ASSIGN/NOLOG WNG_DIR:[NSCAN] NSC -$ ASSIGN/NOLOG WNG_DIR:[NMAP] NMA -$ ASSIGN/NOLOG WNG_DIR:[NPLOT] NPL -$ ASSIGN/NOLOG WNG_DIR WNG_OLBEXE: -$ WNG_NODE=="192.87.1.105" -$ WNG_NODEUSER=="PRINTVAX PRINTVAX_90A" -$ WNG_NODEDIR=="USER5:[WNB]" -$ @WNG:WNGCSHRC.COM -$ ! -$ EXIT -#else -#!/bin/csh - setenv WNG_SITE wsrt - setenv WNG /users/srt/nst/wng - setenv WNG_OLBEXE $WNG/.. - setenv WNG_NODE 192.87.1.105 - setenv WNG_NODEUSER "printvax printvax_90a" - setenv WNG_NODEDIR "user5:[wnb]" - if (! $?host) set host=`hostname` - if ($host =~ wsrt*) then - setenv WNG_TYPE hp - setenv MAG8 "/dev/rmt/0m" - else - setenv WNG_TYPE hp - setenv MAG8 "/dev/rmt/0m" - endif - source $WNG/wngcshrc.sun -#endif diff --git a/src/wng/wngcshrc_wsrt.sun b/src/wng/wngcshrc_wsrt.sun deleted file mode 100755 index cbe130e674b614363a6bcca39e3f3f00ac68da26..0000000000000000000000000000000000000000 --- a/src/wng/wngcshrc_wsrt.sun +++ /dev/null @@ -1,27 +0,0 @@ -# wngcshrc_wsrt.ssc -# HjV 930120 -# -# Revisions: -# HjV 930420 Change WNG_LDFILES, add gids_setup -# HjV 930503 Remove WNG_LDFILES and gids_setup -# HjV 930527 Change WNG_NODE and MAG8 -# -# Environment for all WN programs -# Call by inserting in .cshrc as source wngcshrc_wsrt.sun -# -#!/bin/csh - setenv WNG_SITE wsrt - setenv WNG /users/srt/nst/wng - setenv WNG_OLBEXE $WNG/.. - setenv WNG_NODE 192.87.1.105 - setenv WNG_NODEUSER "printvax printvax_90a" - setenv WNG_NODEDIR "user5:[wnb]" - if (! $?host) set host=`hostname` - if ($host =~ wsrt*) then - setenv WNG_TYPE hp - setenv MAG8 "/dev/rmt/0m" - else - setenv WNG_TYPE hp - setenv MAG8 "/dev/rmt/0m" - endif - source $WNG/wngcshrc.sun diff --git a/src/wng/wngcst.cun b/src/wng/wngcst.cun deleted file mode 100644 index f10ccdb41fb5eeb362080e8a072439559f26a5f5..0000000000000000000000000000000000000000 --- a/src/wng/wngcst.cun +++ /dev/null @@ -1,128 +0,0 @@ -/*+ wngcst.cun -. WNB 910320 -. -. Revisions: -. WNB 921215 Make CUN for hp and others -. CMV 940929 Proper include file for ucb -. HjV 960618 Proper include files for Solaris -... */ -#include <sys/time.h> -#ifdef wn_hp__ -# include <sys/times.h> -#else -#ifdef wn_ucb__ -# include </usr/ucbinclude/sys/resource.h> -#else -#ifdef wn_so__ -# include </usr/ucbinclude/sys/rusage.h> -# include </usr/ucbinclude/sys/resource.h> -#else -# include <sys/resource.h> -#endif -#endif -#endif -/* History -... */ - int ival = 0; -#ifdef wn_hp__ - struct tms rush; -#else - struct rusage rush; -#endif - struct timeval tvlh; -/* -... */ - int wngcst_(rar,iar) -/* -. Get computing statistics -. -. Result: -. -. wngcst = wngcst ( RAR_E(0:3):O, IAR_E(0:3):O) -. returns computing statistics (see -. WNGCST.FVX for details) -... */ -/* -. Arguments: -... */ - float rar[]; /* returned times */ - int iar[]; /* returned counts */ -{ -/* -. Include files: -... */ -/* -. Parameters: -... */ -/*- */ -/* -. Function references: -... */ - extern int gettimeofday(); -#ifndef wn_hp__ - extern int getrusage(); -#endif -/* -. Data declarations: -... */ -#ifdef wn_hp__ - struct tms ruse; /* usage info */ -#else - struct rusage ruse; /* usage info */ -#endif - struct timeval tvl; /* time info */ - int i; -/* Init -. */ - if (ival == 0) /* first time */ - { gettimeofday(&tvlh,0); -#ifdef wn_hp__ - times(&rush); -#else - getrusage(RUSAGE_SELF,&rush); -#endif - ival = 1; /* not first */ - for (i = 0; i <= 3; i++) - { rar[i] = 0; /* set zeroes */ - iar[i] = 0; - } - return(0); - } -/* Get usage -. */ - for (i = 0; i <= 3; i++) - { rar[i] = 0; /* set zeroes */ - iar[i] = 0; - } - gettimeofday(&tvl,0); /* get time of day */ -#ifdef wn_hp__ - times(&ruse); /* get values */ -#else - getrusage(RUSAGE_SELF,&ruse); /* get values */ -#endif - rar[0] = (tvl.tv_sec - tvlh.tv_sec) + - (tvl.tv_usec - tvlh.tv_usec) / 1e6; /* elapsed time */ -#ifdef wn_hp__ - rar[1] = (ruse.tms_utime + ruse.tms_stime - - rush.tms_utime - rush.tms_stime) / CLK_TCK; -/* -. I/O count and page fault temporay on zero */ - iar[0] = 0; /* I/O count */ - iar[1] = 0; /* page faults */ -#else - rar[1] = (ruse.ru_utime.tv_sec + ruse.ru_stime.tv_sec - - rush.ru_utime.tv_sec - rush.ru_stime.tv_sec) + - (ruse.ru_utime.tv_usec + ruse.ru_stime.tv_usec - - rush.ru_utime.tv_usec - rush.ru_stime.tv_usec) / 1e6; - iar[0] = ruse.ru_inblock + ruse.ru_oublock - - rush.ru_inblock - rush.ru_oublock; /* I/O count */ - iar[1] = ruse.ru_minflt + ruse.ru_majflt - - rush.ru_minflt - rush.ru_majflt; /* page faults */ -#endif -/* Ready -. */ - return(0); /* ready */ -} -/* -. -... */ diff --git a/src/wng/wngcst.fvx b/src/wng/wngcst.fvx deleted file mode 100644 index f2f48e3c5e94ff57ece6f464ac0820a62c62df01..0000000000000000000000000000000000000000 --- a/src/wng/wngcst.fvx +++ /dev/null @@ -1,95 +0,0 @@ -C+ WNGCST.FVX -C WNB 910320 -C -C Revisions: -C - SUBROUTINE WNGCST(RAR,IAR) -C -C Get computer statistics -C -C Result: -C -C CALL WNGCST( RAR_E(0:3):O, IAR_J(0:3):O) -C Returns in RAR four times in seconds, -C and in IAR four counts: -C RAR(0)= elapsed time -C RAR(1)= CPU time -C RAR(2)= undefined -C RAR(3)= undefined -C IAR(0)= direct I/O count -C IAR(1)= pagefault count -C IAR(2)= undefined -C IAR(3)= undefined -C CALL WNGCS0 Re-init after use -C -C Include files: -C - INCLUDE 'WNG_DEF' - INCLUDE '($LIBDTDEF)' -C -C Parameters: -C -C -C Arguments: -C - REAL RAR(0:3) !RETURNED TIMES - INTEGER IAR(0:3) !RETURNED COUNTS -C -C Function references: -C - INTEGER LIB$INIT_TIMER !INIT. TIMER - INTEGER LIB$STAT_TIMER !GET STATISTICS -C -C Data declarations: -C - INTEGER TM(0:2) !TIME VALUES -C -C Commons: -C - INTEGER IVAL !INITIALISATION TEST - DATA IVAL/0/ - COMMON /WNGCST_COM/ IVAL -C- -C -C INIT -C - IF (IVAL.EQ.0) THEN !FIRST CALL - IF (LIB$INIT_TIMER()) THEN !DO INIT - IVAL=1 !NON-FIRST - END IF - DO I=0,3 !SET ALL ZERO - RAR(I)=0 - IAR(I)=0 - END DO -C - RETURN - END IF -C -C GET TIMES AND COUNTS -C - DO I=0,3 !SET ALL ZERO - RAR(I)=0 - IAR(I)=0 - END DO - IF (IVAL.NE.0) THEN !CAN DO - IF (LIB$STAT_TIMER(1,TM)) THEN !ELAPSED TIME - CALL LIB$CVTF_FROM_INTERNAL_TIME(LIB$K_DELTA_SECONDS_F, - 1 RAR(0),TM) !MAKE SECONDS - END IF - IF (LIB$STAT_TIMER(2,TM)) RAR(1)=TM(0)/100. !CPU TIME IN SEC. - IF (LIB$STAT_TIMER(4,TM)) IAR(0)=TM(0) !DIRECT I/O COUNT - IF (LIB$STAT_TIMER(5,TM)) IAR(1)=TM(0) !PAGEFAULT COUNT - END IF -C - RETURN -C -C RE-INIT -C - ENTRY WNGCS0 -C - IVAL=0 !RE-INIT -C - RETURN -C -C - END diff --git a/src/wng/wngex.for b/src/wng/wngex.for deleted file mode 100644 index edbd3de6537277e2f4fcfec247caa03683c99c4a..0000000000000000000000000000000000000000 --- a/src/wng/wngex.for +++ /dev/null @@ -1,58 +0,0 @@ -C+ WNGEX.FOR -C WNB 890308 -C -C Revisions: -C WNB 910828 Add WNGEX0 for ^C handler -C JPH 960622 Count control-C interrupts; re-establish handler -C - SUBROUTINE WNGEX -C -C Finish off everything -C -C Result: -C -C CALL WNGEX Finish and close everything -C CALL WNGEX0( A_J:I, B_J:I) Finish off after ^C -C -C Include files: -C - INCLUDE 'WNG_DEF' - INCLUDE 'WXH_DEF' -C -C Parameters: -C -C -C Arguments: -C - INTEGER A,B !DUMMY FOR WNGEX0 -C -C Function references: -C -C -C Data declarations: -C -C- - GOTO 10 -C -C WNGEX0 -C - ENTRY WNGEX0(A,B) -C -cc print*,'X0',xhcc - IF (XHCC(0).NE.0) THEN ! control-C inhibited - XHCC(1)=XHCC(1)+1 ! SET 'SEEN' - CALL WNGSC0 ! re-establish control-C handler - RETURN ! return from interrupt - END IF - GOTO 10 -C - 10 CONTINUE -cc print*,'exit' - CALL WNGSXX !DO EXIT HANDLERS - IF (IAND(1,E_C).EQ.1) E_C=1 - CALL EXIT(E_C) !RETURN WITH ERROR CODE -C - RETURN -C -C - END diff --git a/src/wng/wngfex.com b/src/wng/wngfex.com deleted file mode 100755 index bd977593773a894d68cc01f6e45cec2b5c66dc97..0000000000000000000000000000000000000000 --- a/src/wng/wngfex.com +++ /dev/null @@ -1,84 +0,0 @@ -$!# WNGFEX.SSC -$!# WNB 920911 -$!# -$!# Revisions: -$!# HjV 920914 Add type LA (print text on laser-printer) -$!# WNB 920917 New spooling command atnf -$!# WNB 920917 Delete setenv WNG_SITE and other typos ({}!!) -$!# HjV 920922 Get correct filename and replace loch by locr -$!# WNB 921006 Change to non-binary for PostScript -$!# WNB 921006 Error in RUG TXA4:: and 5:: -$!# WNB 921013 Change ATNF for PostScript error -$!# WNB 921021 Add A3 plotter -$!# WNB 921126 More lines for atnf printer -$!# WNB 921130 Change tr for HP -$!# HjV 921203 Add site RAIUB -$!# HjV 921215 Change for RUG -$!# WNB 921222 Add LN, RL, LR -$!# WNB 921222 Make it into WNGFEX.SSC; remove A3 etc from non-nfra -$!# HjV 930115 Finalize A3 plotter for UNIX -$!# print direct on PS-printer on NFRA for UNIX-machines -$!# HjV 930226 Add site WSRT, add HP for NFRA -$!# HjV 930414 Take correct PS-printer on NFRA-VAX -$!# Change command to print on NFRA-HP -$!# HjV 930630 Add site KOSMA, change VAX-NFRA queue CMPQ into CMPS -$!# HjV 930715 Remove a part of QMS -$!# HjV 930914 Add site ARECB -$!# -$!# General file handling -$!# Use as: WNGFEX "type" nam1 nam2 action -$!# Type can be: -$!# SP spool file nam1 as nam2 -$!# RE rename file nam1 into nam2 -$!# CC concatenate file nam1 onto nam2 -$!# LN make logical link nam2 to nam1 -$!# RL delete all .log, .tmp, .PLT or size == 0 -$!# older than action (or 5) days -$!# LR combine LN and RL -$!# QM spool nam1 as nam2 to QMS plotter -$!# PS spool nam1 as nam2 to PS plotter -$!# A3 spool nam1 as nam2 to A3-PS plotter -$!# LA spool nam1 as nam2 to LAser printer -$!# Action is series of letters: -$!# D delete file after spooling and concatenation -$!# or an unsigned value for RL/LR -$!# -$ VER=F$VERIFY(0) -$ APPEND="APPEND" !MAKE SURE -$ COPY="COPY" -$ DELETE="DELETE" -$ RENAME="RENAME" -$ P1=F$EDIT(P1,"UPCASE") -$ P4=F$EDIT(P4,"UPCASE") -$ IF P3 .EQS. "" THEN P3="''P2'" -$ A=F$SEARCH(P2) !SEE IF PRESENT -$ IF A .EQS. "" THEN GOTO EXIT -$ IF F$EXTRACT(0,2,P1) .EQS. "SP" THEN GOTO SPL -$ IF F$EXTRACT(0,2,P1) .EQS. "RE" THEN GOTO REN -$ IF F$EXTRACT(0,2,P1) .EQS. "CC" THEN GOTO CAT -$ IF F$EXTRACT(0,2,P1) .EQS. "LN" THEN GOTO LNK -$ IF F$EXTRACT(0,2,P1) .EQS. "RL" THEN GOTO REM -$ IF F$EXTRACT(0,2,P1) .EQS. "LR" THEN GOTO LRM -$ IF F$EXTRACT(0,2,P1) .EQS. "QM" THEN GOTO QMS -$ IF F$EXTRACT(0,2,P1) .EQS. "PS" THEN GOTO PSP -$ IF F$EXTRACT(0,2,P1) .EQS. "A3" THEN GOTO PA3 -$ IF F$EXTRACT(0,2,P1) .EQS. "LA" THEN GOTO LAS -$ EXIT: ON ERROR THEN EXIT -$ VER=F$VERIFY(VER) -$ EXIT -$!# -$!# Spool -$!# -$ SPL: B=F$EDIT(F$GETJPI("","USERNAME"),"TRIM") !USER NAME -$ C=F$PARSE(P3,,,"NAME","SYNTAX_ONLY") !FILE NAME -$ D=F$PARSE(P3,,,"TYPE","SYNTAX_ONLY") !FILE TYPE -$ ON ERROR THEN GOTO EXIT -$ COPY 'A' 'B'_'C''D' -$ IF P4-"D" .NES. P4 -$ THEN -$ PRINT/DELETE 'B'_'C''D' -$ ELSE -$ PRINT 'B'_'C''D' -$ ENDIF -$ IF P4-"D" .NES. P4 THEN DELETE 'A' -$ GOTO EXIT diff --git a/src/wng/wngfex.ssc b/src/wng/wngfex.ssc deleted file mode 100644 index b742cffddd28ef3c0b98f6409be84091f49bcf00..0000000000000000000000000000000000000000 --- a/src/wng/wngfex.ssc +++ /dev/null @@ -1,458 +0,0 @@ -# WNGFEX.SSC -# WNB 920911 -# -# Revisions: -# HjV 920914 Add type LA (print text on laser-printer) -# WNB 920917 New spooling command atnf -# WNB 920917 Delete setenv WNG_SITE and other typos ({}!!) -# HjV 920922 Get correct filename and replace loch by locr -# WNB 921006 Change to non-binary for PostScript -# WNB 921006 Error in RUG TXA4:: and 5:: -# WNB 921013 Change ATNF for PostScript error -# WNB 921021 Add A3 plotter -# WNB 921126 More lines for atnf printer -# WNB 921130 Change tr for HP -# HjV 921203 Add site RAIUB -# HjV 921215 Change for RUG -# WNB 921222 Add LN, RL, LR -# WNB 921222 Make it into WNGFEX.SSC; remove A3 etc from non-nfra -# HjV 930115 Finalize A3 plotter for UNIX -# print direct on PS-printer on NFRA for UNIX-machines -# HjV 930226 Add site WSRT, add HP for NFRA -# HjV 930414 Take correct PS-printer on NFRA-VAX -# Change command to print on NFRA-HP -# HjV 930630 Add site KOSMA, change VAX-NFRA queue CMPQ into CMPS -# HjV 930715 Remove a part of QMS -# HjV 930914 Add site ARECB -# -# General file handling -# Use as: WNGFEX "type" nam1 nam2 action -# Type can be: -# SP spool file nam1 as nam2 -# RE rename file nam1 into nam2 -# CC concatenate file nam1 onto nam2 -# LN make logical link nam2 to nam1 -# RL delete all .log, .tmp, .PLT or size == 0 -# older than action (or 5) days -# LR combine LN and RL -# QM spool nam1 as nam2 to QMS plotter -# PS spool nam1 as nam2 to PS plotter -# A3 spool nam1 as nam2 to A3-PS plotter -# LA spool nam1 as nam2 to LAser printer -# Action is series of letters: -# D delete file after spooling and concatenation -# or an unsigned value for RL/LR -# -#ifdef wn_vax__ -$ VER=F$VERIFY(0) -$ APPEND="APPEND" !MAKE SURE -$ COPY="COPY" -$ DELETE="DELETE" -$ RENAME="RENAME" -$ P1=F$EDIT(P1,"UPCASE") -$ P4=F$EDIT(P4,"UPCASE") -$ IF P3 .EQS. "" THEN P3="''P2'" -$ A=F$SEARCH(P2) !SEE IF PRESENT -$ IF A .EQS. "" THEN GOTO EXIT -$ IF F$EXTRACT(0,2,P1) .EQS. "SP" THEN GOTO SPL -$ IF F$EXTRACT(0,2,P1) .EQS. "RE" THEN GOTO REN -$ IF F$EXTRACT(0,2,P1) .EQS. "CC" THEN GOTO CAT -$ IF F$EXTRACT(0,2,P1) .EQS. "LN" THEN GOTO LNK -$ IF F$EXTRACT(0,2,P1) .EQS. "RL" THEN GOTO REM -$ IF F$EXTRACT(0,2,P1) .EQS. "LR" THEN GOTO LRM -$ IF F$EXTRACT(0,2,P1) .EQS. "QM" THEN GOTO QMS -$ IF F$EXTRACT(0,2,P1) .EQS. "PS" THEN GOTO PSP -$ IF F$EXTRACT(0,2,P1) .EQS. "A3" THEN GOTO PA3 -$ IF F$EXTRACT(0,2,P1) .EQS. "LA" THEN GOTO LAS -$ EXIT: ON ERROR THEN EXIT -$ VER=F$VERIFY(VER) -$ EXIT -#else - set Upc="ABCDEFGHIJKLMNOPQRSTUVWXYZ" # for translation - set Lowc="abcdefghijklmnopqrstuvwxyz" - set loa="" - if ($#argv > 1) set loa=`echo $argv[1] | tr $Upc $Lowc` # type - set lod="" - if ($#argv > 3) set lod=`echo $argv[4] | tr $Upc $Lowc` # action - if ($#argv < 2) goto EXIT # no file names - set lob=$argv[2] # input name - if ($#argv < 3) then # no output name - set loc=$lob # same - else - set loc=$argv[3] # output name - endif - set loct=$loc:t - set locr=$loct:r # output name - set loce=$loc:e # output extension - if (-e ${USER}_${locr}.$loce) then - 'rm' ${USER}_${locr}.$loce - endif - if ($loa =~ sp*) goto SPL # spool - if ($loa =~ re*) goto REN # rename - if ($loa =~ cc*) goto CAT # concatenate - if ($loa =~ ln*) goto LNK # link - if ($loa =~ rl*) goto REM # remove tmp, log - if ($loa =~ lr*) goto LRM # link and remove - if ($loa =~ qm*) goto QMS # spool QMS - if ($loa =~ ps*) goto PSP # spool PS - if ($loa =~ a3*) goto PA3 # spool A3 - if ($loa =~ la*) goto LAS # spool LA -EXIT: - if (-e ${USER}_${locr}.$loce) then - 'rm' ${USER}_${locr}.$loce - endif - exit # unknown -#endif -# -# Spool -# -#ifdef wn_vax__ -$ SPL: B=F$EDIT(F$GETJPI("","USERNAME"),"TRIM") !USER NAME -$ C=F$PARSE(P3,,,"NAME","SYNTAX_ONLY") !FILE NAME -$ D=F$PARSE(P3,,,"TYPE","SYNTAX_ONLY") !FILE TYPE -$ ON ERROR THEN GOTO EXIT -# ifdef wn_nfra__ -$ COPY 'A' RZMVX5::LPA0:'B'_'C''D' !PRINT -# else -# ifdef wn_atnf__ -$ COPY 'A' 'B'_'C''D' -$ LW132 'B'_'C''D' -$ DELETE 'B'_'C''D';* -# else -# ifdef wn_kosma__ -$ COPY 'A' 'B'_'C''D' -$ IF P4-"D" .NES. P4 -$ THEN -$ PRINT/QUEUE=MATRIX_LA100/DELETE 'B'_'C''D' -$ ELSE -$ PRINT/QUEUE=MATRIX_LA100 'B'_'C''D' -$ ENDIF -# else -$ COPY 'A' 'B'_'C''D' -$ IF P4-"D" .NES. P4 -$ THEN -$ PRINT/DELETE 'B'_'C''D' -$ ELSE -$ PRINT 'B'_'C''D' -$ ENDIF -# endif -# endif -# endif -$ IF P4-"D" .NES. P4 THEN DELETE 'A' -$ GOTO EXIT -#else -SPL: - if (! -e $lob) goto EXIT # file unknown -# ifdef wn_atnf__ - awk 'NR > 1 || length($0) > 1 {print}' $lob >! \ - ${USER}_${locr}.$loce # delete ^L - @ statx = { lwl -s8 ${USER}_${locr}.$loce } # print -# else - ln -s $lob ${USER}_${locr}.$loce -# ifdef wn_rug__ - @ statx = { lp -dland ${USER}_${locr}.$loce } -# else -# ifdef wn_raiub__ - @ statx = { lpr ${USER}_${locr}.$loce } -# else -# ifdef wn_wsrt__ - @ statx = { lp ${USER}_${locr}.$loce } -# else -# ifdef wn_kosma__ - @ statx = { lp -dla100 ${USER}_${locr}.$loce } -# else -# ifdef wn_arecb__ - @ statx = {enscript -p ${USER}_${locr}.$loce } -# else # nfra - @ statx = { ftp -n << qqq } - open rzmvx5 - user printvax printvax_90a - put $lob lpa0:${USER}_${locr}.$loce # print - close - quit -qqq -# endif -# endif -# endif -# endif -# endif -# endif - if (! $statx) then # ok - if ($lod =~ *d*) 'rm' $lob # delete - endif - goto EXIT # ready -#endif -# -# Rename -# -#ifdef wn_vax__ -$ REN: ON ERROR THEN GOTO EXIT -$ RENAME 'A' 'P3' -$ GOTO EXIT -#else -REN: - if (! -e $lob) goto EXIT # file unknown - 'mv' $lob $loc # rename - goto EXIT # ready -#endif -# -# Catenate -# -#ifdef wn_vax__ -$ CAT: B=F$SEARCH(P3) !SEE IF OUTPUT PRESENT -$ ON ERROR THEN GOTO EXIT -$ IF B .NES. "" THEN APPEND 'A' 'B' -$ IF B .EQS. "" THEN COPY 'A' 'P3' -$ IF P4-"D" .NES. P4 THEN DELETE 'A' -$ GOTO EXIT -#else -CAT: - if (! -e $lob) goto EXIT # file unknown - if (-e $loc) then # append to known - @ statx = { cat $lob >> $loc } - else # copy to unknown - @ statx = { cat $lob > $loc } - endif - if (! $statx) then # ok - if ($lod =~ *d*) 'rm' $lob # delete - endif - goto EXIT # ready -#endif -# -# Link -# -#ifdef wn_vax__ -$ LNK: ON ERROR THEN GOTO EXIT -$ RENAME 'A' 'P3' -$ GOTO EXIT -#else -LNK: - 'rm' $loc >& /dev/null # remove old link - ln -s $lob $loc # make link - goto EXIT -#endif -# -# Link and remove -# -#ifdef wn_vax__ -$ LRM: ON ERROR THEN GOTO EXIT -$ RENAME 'A' 'P3' -#else -LRM: - 'rm' $loc >& /dev/null # remove old link - ln -s $lob $loc # make link -#endif -# -# Remove log, tmp, PLT, size 0 -# -#ifdef wn_vax__ -$ REM: ON ERROR THEN GOTO EXIT -$ IF "0123456789"-F$EXTRACT(0,1,P4) .EQS. "0123456789" THEN P4=5 !5 DAYS -$ DELETE/NOLOG/MODIF/BEFORE="TODAY-''P4'-00:00:00" - - *.TMP;*,*.LOG;*,*.PLT;* -$ GOTO EXIT -#else -REM: - if ("$lod" == "" || "0123456789" !~ *$lod*) set lod=5 - set loo='( -name *.[tT][mM][pP] -o -name *.[lL][oO][gG]' - set loo="$loo -o -name *.PLT -o -size 0 )" - set lop="-atime +$lod -exec rm -f {} ;" - set noglob; find . $loo $lop >& /dev/null; unset noglob - goto EXIT -#endif -# -# Spool QMS plot -# -#ifdef wn_vax__ -$ QMS: ON ERROR THEN GOTO EXIT -$ GOTO EXIT -#else -QMS: - if (! -e $lob) goto EXIT # file unknown - ln -s $lob ${USER}_${locr}.$loce - @ statx = 0 # ok - if (! $statx) then # ok - if ($lod =~ *d*) 'rm' $lob # delete - endif - goto EXIT # ready -#endif -# -# Spool PS plot -# -#ifdef wn_vax__ -$ PSP: ON ERROR THEN GOTO EXIT -# ifdef wn_nfra__ -$ IF P4-"D" .NES. P4 -$ THEN -$ PRINT/QUEUE=CMPS/DELETE 'A' -$ ELSE -$ PRINT/QUEUE=CMPS 'A' -$ ENDIF -# else -# ifdef wn_atnf__ -$ LASER 'A' -# else -# ifdef wn_kosma__ -$ IF P4-"D" .NES. P4 -$ THEN -$ PRINT/QUEUE=POSTSCRIPT/DELETE 'A' -$ ELSE -$ PRINT/QUEUE=POSTSCRIPT 'A' -$ ENDIF -# endif -# endif -# endif -$ GOTO EXIT -#else -PSP: - if (! -e $lob) goto EXIT # file unknown - ln -s $lob ${USER}_${locr}.$loce -# ifdef wn_atnf__ - @ statx = { laser ${USER}_${locr}.$loce } - set statx=1 # make sure file kept -# else -# ifdef wn_raiub__ - @ statx = { lpr -Pklein ${USER}_${locr}.$loce } - set statx=1 # make sure file kept -# else -# ifdef wn_rug__ - @ statx = { lp -dps ${USER}_${locr}.$loce } - set statx=1 # make sure file kept -# else -# ifdef wn_wsrt__ - @ statx = { lp ${USER}_${locr}.$loce } - set statx=1 # make sure file kept -# else -# ifdef wn_kosma__ - @ statx = { lp -dpostscript ${USER}_${locr}.$loce } - set statx=1 # make sure file kept -# else -# ifdef wn_arecb__ - @ statx = { lpr 4 ${USER}_${locr}.$loce } - set statx = 1 # make sure file kept -# else - if ("$WNG_TYPE" == "sw" ) then - @ statx = { lpr -Ppsprint ${USER}_${locr}.$loce } - set statx=1 # make sure file kept - else if ("$WNG_TYPE" == "hp") then - @ statx = { lpr -dpsprint ${USER}_${locr}.$loce } - set statx=1 # make sure file kept - else if ("$WNG_TYPE" == "al") then - @ statx = { lpr -Ppmq ${USER}_${locr}.$loce } - set statx=1 # make sure file kept - else - set statx=1 # make sure file kept - endif -# endif -# endif -# endif -# endif -# endif -# endif - if (! $statx) then # ok - if ($lod =~ *d*) 'rm' $lob # delete - endif - goto EXIT # ready -#endif -# -# Spool A3 plot -# -#ifdef wn_vax__ -$ PA3: ON ERROR THEN GOTO EXIT -# ifdef wn_atnf__ -# else -# ifdef wn_nfra__ -$ IF P4-"D" .NES. P4 -$ THEN -$ PRINT/QUEUE=CMPS/DELETE 'A' -$ ELSE -$ PRINT/QUEUE=CMPS 'A' -$ ENDIF -# endif -# endif -$ GOTO EXIT -#else -PA3: - if (! -e $lob) goto EXIT # file unknown - ln -s $lob ${USER}_${locr}.$loce - @ statx = 0 # ok -# ifdef wn_nfra__ - if ("$WNG_TYPE" == "sw" ) then - @ statx = { lpr -Ppsprint ${USER}_${locr}.$loce } - set statx=1 # make sure file kept - else if ("$WNG_TYPE" == "hp") then - @ statx = { lpr -dpsprint ${USER}_${locr}.$loce } - set statx=1 # make sure file kept - else if ("$WNG_TYPE" == "al") then - @ statx = { lpr -Ppmq ${USER}_${locr}.$loce } - set statx=1 # make sure file kept - else - set statx=1 # make sure file kept - endif -# else -# ifdef wn_atnf__ -# endif -# endif - if (! $statx) then # ok - if ($lod =~ *d*) 'rm' $lob # delete - endif - goto EXIT # ready -#endif -# -# Spool LA plot -# -#ifdef wn_vax__ -$ LAS: ON ERROR THEN GOTO EXIT -# ifdef wn_nfra__ -$ COPY 'A' RZMVX4::TXA4:'A' -$ IF P4-"D" .NES. P4 THEN DELETE 'A' -# else -# ifdef wn_atnf__ -$ IF P4-"D" .NES. P4 -$ THEN -$ PRINT/DELETE 'A' -$ ELSE -$ PRINT 'A' -$ ENDIF -# else -# ifdef wn_kosma__ -$ IF P4-"D" .NES. P4 -$ THEN -$ PRINT/QUEUE=LASERJET/DELETE 'A' -$ ELSE -$ PRINT/QUEUE=LASERJET 'A' -$ ENDIF -# endif -# endif -# endif -$ GOTO EXIT -#else -LAS: - if (! -e $lob) goto EXIT # file unknown - ln -s $lob ${USER}_${locr}.$loce - @ statx = 0 # 0 -# ifdef wn_rug__ - @ statx = { lp -dport ${USER}_${locr}.$loce } - set statx=1 # make sure file kept -# else -# ifdef wn_kosma__ - @ statx = { lp -dlaserjet ${USER}_${locr}.$loce } - set statx=1 # make sure file kept -# else -# ifdef wn_nfra__ - @ statx = { ftp -n << qqq } - open rzmvx4 - user printvax printvax_90a - put $lob TXA4:${USER}_${locr}.$loce # print - close - quit -qqq -# endif -# endif -# endif - if (! $statx) then # ok - if ($lod =~ *d*) 'rm' $lob # delete - endif - goto EXIT # ready -#endif -# diff --git a/src/wng/wngfex.sun b/src/wng/wngfex.sun deleted file mode 100755 index 79e8f593d60f2430cbd2c4b933d82d0462e972d5..0000000000000000000000000000000000000000 --- a/src/wng/wngfex.sun +++ /dev/null @@ -1,200 +0,0 @@ -# WNGFEX.SSC -# WNB 920911 -# -# Revisions: -# HjV 920914 Add type LA (print text on laser-printer) -# WNB 920917 New spooling command atnf -# WNB 920917 Delete setenv WNG_SITE and other typos ({}!!) -# HjV 920922 Get correct filename and replace loch by locr -# WNB 921006 Change to non-binary for PostScript -# WNB 921006 Error in RUG TXA4:: and 5:: -# WNB 921013 Change ATNF for PostScript error -# WNB 921021 Add A3 plotter -# WNB 921126 More lines for atnf printer -# WNB 921130 Change tr for HP -# HjV 921203 Add site RAIUB -# HjV 921215 Change for RUG -# WNB 921222 Add LN, RL, LR -# WNB 921222 Make it into WNGFEX.SSC; remove A3 etc from non-nfra -# HjV 930115 Finalize A3 plotter for UNIX -# print direct on PS-printer on NFRA for UNIX-machines -# HjV 930226 Add site WSRT, add HP for NFRA -# HjV 930414 Take correct PS-printer on NFRA-VAX -# Change command to print on NFRA-HP -# HjV 930630 Add site KOSMA, change VAX-NFRA queue CMPQ into CMPS -# HjV 930715 Remove a part of QMS -# HjV 930914 Add site ARECB -# -# General file handling -# Use as: WNGFEX "type" nam1 nam2 action -# Type can be: -# SP spool file nam1 as nam2 -# RE rename file nam1 into nam2 -# CC concatenate file nam1 onto nam2 -# LN make logical link nam2 to nam1 -# RL delete all .log, .tmp, .PLT or size == 0 -# older than action (or 5) days -# LR combine LN and RL -# QM spool nam1 as nam2 to QMS plotter -# PS spool nam1 as nam2 to PS plotter -# A3 spool nam1 as nam2 to A3-PS plotter -# LA spool nam1 as nam2 to LAser printer -# Action is series of letters: -# D delete file after spooling and concatenation -# or an unsigned value for RL/LR -# - set Upc="ABCDEFGHIJKLMNOPQRSTUVWXYZ" # for translation - set Lowc="abcdefghijklmnopqrstuvwxyz" - set loa="" - if ($#argv > 1) set loa=`echo $argv[1] | tr $Upc $Lowc` # type - set lod="" - if ($#argv > 3) set lod=`echo $argv[4] | tr $Upc $Lowc` # action - if ($#argv < 2) goto EXIT # no file names - set lob=$argv[2] # input name - if ($#argv < 3) then # no output name - set loc=$lob # same - else - set loc=$argv[3] # output name - endif - set loct=$loc:t - set locr=$loct:r # output name - set loce=$loc:e # output extension - if (-e ${USER}_${locr}.$loce) then - 'rm' ${USER}_${locr}.$loce - endif - if ($loa =~ sp*) goto SPL # spool - if ($loa =~ re*) goto REN # rename - if ($loa =~ cc*) goto CAT # concatenate - if ($loa =~ ln*) goto LNK # link - if ($loa =~ rl*) goto REM # remove tmp, log - if ($loa =~ lr*) goto LRM # link and remove - if ($loa =~ qm*) goto QMS # spool QMS - if ($loa =~ ps*) goto PSP # spool PS - if ($loa =~ a3*) goto PA3 # spool A3 - if ($loa =~ la*) goto LAS # spool LA -EXIT: - if (-e ${USER}_${locr}.$loce) then - 'rm' ${USER}_${locr}.$loce - endif - exit # unknown -# -# Spool -# -SPL: - if (! -e $lob) goto EXIT # file unknown - ln -s $lob ${USER}_${locr}.$loce - @ statx = { ftp -n << qqq } - open rzmvx5 - user printvax printvax_90a - put $lob lpa0:${USER}_${locr}.$loce # print - close - quit -qqq -# endif -# endif - if (! $statx) then # ok - if ($lod =~ *d*) 'rm' $lob # delete - endif - goto EXIT # ready -# -# Rename -# -REN: - if (! -e $lob) goto EXIT # file unknown - 'mv' $lob $loc # rename - goto EXIT # ready -# -# Catenate -# -CAT: - if (! -e $lob) goto EXIT # file unknown - if (-e $loc) then # append to known - @ statx = { cat $lob >> $loc } - else # copy to unknown - @ statx = { cat $lob > $loc } - endif - if (! $statx) then # ok - if ($lod =~ *d*) 'rm' $lob # delete - endif - goto EXIT # ready -# -# Link -# -LNK: - 'rm' $loc >& /dev/null # remove old link - ln -s $lob $loc # make link - goto EXIT -# -# Link and remove -# -LRM: - 'rm' $loc >& /dev/null # remove old link - ln -s $lob $loc # make link -# -# Remove log, tmp, PLT, size 0 -# -REM: - if ("$lod" == "" || "0123456789" !~ *$lod*) set lod=5 - set loo='( -name *.[tT][mM][pP] -o -name *.[lL][oO][gG]' - set loo="$loo -o -name *.PLT -o -size 0 )" - set lop="-atime +$lod -exec rm -f {} ;" - set noglob; find . $loo $lop >& /dev/null; unset noglob - goto EXIT -# -# Spool QMS plot -# -QMS: - if (! -e $lob) goto EXIT # file unknown - ln -s $lob ${USER}_${locr}.$loce - @ statx = 0 # ok - if (! $statx) then # ok - if ($lod =~ *d*) 'rm' $lob # delete - endif - goto EXIT # ready -# -# Spool PS plot -# -PSP: - if (! -e $lob) goto EXIT # file unknown - ln -s $lob ${USER}_${locr}.$loce - if ("$WNG_TYPE" == "sw" ) then - @ statx = { lpr -Ppsprint ${USER}_${locr}.$loce } - set statx=1 # make sure file kept - else if ("$WNG_TYPE" == "hp") then - @ statx = { lpr -dpsprint ${USER}_${locr}.$loce } - set statx=1 # make sure file kept - else if ("$WNG_TYPE" == "al") then - @ statx = { lpr -Ppmq ${USER}_${locr}.$loce } - set statx=1 # make sure file kept - else - set statx=1 # make sure file kept - endif -# endif -# endif - if (! $statx) then # ok - if ($lod =~ *d*) 'rm' $lob # delete - endif - goto EXIT # ready -# -# Spool A3 plot -# -PA3: - if (! -e $lob) goto EXIT # file unknown - ln -s $lob ${USER}_${locr}.$loce - @ statx = 0 # ok - if (! $statx) then # ok - if ($lod =~ *d*) 'rm' $lob # delete - endif - goto EXIT # ready -# -# Spool LA plot -# -LAS: - if (! -e $lob) goto EXIT # file unknown - ln -s $lob ${USER}_${locr}.$loce - @ statx = 0 # 0 - if (! $statx) then # ok - if ($lod =~ *d*) 'rm' $lob # delete - endif - goto EXIT # ready -# diff --git a/src/wng/wnggva.for b/src/wng/wnggva.for deleted file mode 100644 index 254973b610640a83611e0d72b70ceb9fb74f400c..0000000000000000000000000000000000000000 --- a/src/wng/wnggva.for +++ /dev/null @@ -1,79 +0,0 @@ -C+ WNGGVA.FOR -C WNB 910327 -C -C Revisions: -C - LOGICAL FUNCTION WNGGVA(LEN,ADDR) -C -C Get/free aligned virtual memory -C -C Result: -C -C WNGGVA_L = WNGGVA( LEN_J:I, ADDR_J:O) -C Get virtual memory area of length LEN. -C Address returned (if ok) in ADDR. -C The area is aligned in such a way that: -C A_*( (ADDR-A_OB)/LB_* ) points to identical -C addresses. -C WNGFVA_L = WNGFVA( LEN_J:I, ADDR_J:IO) -C Free virtual area at address ADDR with -C length LEN. -C -C Include files: -C - INCLUDE 'WNG_DEF' -C -C Parameters: -C -C -C Arguments: -C - INTEGER LEN !LENGTH TO GET/FREE - INTEGER ADDR !ADDRESS OF AREA RETURNED -C -C Entry points: -C - LOGICAL WNGFVA -C -C Function references: -C - LOGICAL WNGGVM !GET AN AREA - LOGICAL WNGFVM !FREE AN AREA -C -C Data declarations: -C -C- -C -C GET AREA -C - I=LEN+2*LB_J+32 !LENGTH OF FULL BLOCK - WNGGVA=WNGGVM(I,J) !GET AREA - IF (WNGGVA) THEN !GOT IT - ADDR=IAND('ffffffe0'X,J+2*LB_J+31-A_OB)+A_OB !ALIGN - J1=(ADDR-A_OB)/LB_J !POINTER TO AREA - A_J(J1-1)=J !SAVE ADDRESS - A_J(J1-2)=I !SAVE LENGTH - ELSE !ERROR - ADDR=0 !MAKE SURE - END IF -C - RETURN -C -C FREE AREA -C - ENTRY WNGFVA(LEN,ADDR) -C - IF (ADDR.EQ.0) THEN !ERROR - WNGFVA=.FALSE. - ELSE - J1=(ADDR-A_OB)/LB_J !POINTER TO AREA - J=A_J(J1-1) !SAVE ADDRESS - I=A_J(J1-2) !SAVE LENGTH - WNGFVA=WNGFVM(I,J) !FREE AREA - END IF - ADDR=0 !AND SET FREE -C - RETURN -C -C - END diff --git a/src/wng/wnggvl.for b/src/wng/wnggvl.for deleted file mode 100644 index 9cf759418706e06bfb0cba41702a66c8f4092cf3..0000000000000000000000000000000000000000 --- a/src/wng/wnggvl.for +++ /dev/null @@ -1,109 +0,0 @@ -C+ WNGGVL.FOR -C WNB 890308 -C -C Revisions: -C - INTEGER FUNCTION WNGGVL(VJ) -C -C Get value from address -C -C Result: -C -C B = WNGGB ( VB_B:I) Get B -C I = WNGGI ( VI_I:I) Get I -C J = WNGGJ ( VJ_J:I) Get J -C K = WNGGK ( VK_K:I) Get K -C E = WNGGE ( VE_E:I) Get E -C D = WNGGD ( VD_D:I) Get D -C -C Include files: -C - INCLUDE 'WNG_DEF' -C -C Parameters: -C -C -C Arguments: -C - BYTE VB !VALUES TO CONVERT - INTEGER*2 VI - INTEGER VJ - INTEGER*4 VK - REAL VE - DOUBLE PRECISION VD -C -C Entry points: -C - BYTE WNGGB - INTEGER*2 WNGGI - INTEGER WNGGJ - INTEGER*4 WNGGK - REAL WNGGE - DOUBLE PRECISION WNGGD -C -C Function references: -C -C -C Data declarations: -C -C -C Equivalences: -C -C -C Commons: -C -C- - WNGGVL=VJ -C - RETURN -C -C B -C - ENTRY WNGGB(VB) -C - WNGGB=VB -C - RETURN -C -C I -C - ENTRY WNGGI(VI) -C - WNGGI=VI -C - RETURN -C -C J -C - ENTRY WNGGJ(VJ) -C - WNGGJ=VJ -C - RETURN -C -C K -C - ENTRY WNGGK(VK) -C - WNGGK=VK -C - RETURN -C -C E -C - ENTRY WNGGE(VE) -C - WNGGE=VE -C - RETURN -C -C D -C - ENTRY WNGGD(VD) -C - WNGGD=VD -C - RETURN -C -C - END diff --git a/src/wng/wnggvm.cun b/src/wng/wnggvm.cun deleted file mode 100644 index b4321d85a13ddfd6b537fe7966d3464f615f3fd0..0000000000000000000000000000000000000000 --- a/src/wng/wnggvm.cun +++ /dev/null @@ -1,97 +0,0 @@ -/*+ wnggvm.cun -. WNB 890724 -. -. Revisions: -. CMV 940111 Changed for Alpha -. CMV 940117 Changed name to cun -. WNB 940209 Changed for check use on dw,cv etc -... */ - int wnggvm_(len,addr) -/* -. Get/release virtual memory -. -. Result: -. -. wnggvm_L = wnggvm_( LEN_J:I, ADDR_J:O) -. Get virtual memory of LEN bytes, and -. set address in ADDR. -. See WNGGVA for aligned area's. -. wngfvm_L = wngfvm_( LEN_J:I, ADDR_J:IO) -. Release virtual memory of length LEN at -. address ADDR. -. void wngpvm_( ADDR_J:O) Print pointer value -... */ -/* -. Arguments: -... */ -#ifdef wn_da__ - int *len; /* length to get/free */ - int *addr; -#else - long *len; /* length to get/free */ - long *addr; -#endif -{ -/* -. Include files: -... */ -/* -. Parameters: -... */ -/* -. Function references: -... */ - char *malloc(); -/* -. Data declarations: -... */ -/*- */ -/* Get memory -. */ -#ifdef wn_da__ - *addr=(int )malloc(*len); /* get word aligned */ -#else - char* p=malloc(*len); /* get word aligned */ - *addr=p; -/* printf("malloc: %p %p\n",p,*addr); */ -#endif - if (*addr == 0) - return(0); - else - return(1); -} -/* Free memory -. */ - long wngfvm_(len,addr) -#ifdef wn_da__ - int *len; /* length to get/free */ - int *addr; -#else - long *len; /* length to get/free */ - char *(*addr); -#endif - -{ -#ifdef wn_da__ - void free(); - free( (char *)addr + ( (*addr) - (int)addr ) ); - return(1); -#else -#ifdef wn_sw__ - int free(); -#else - void free(); -#endif - free(*addr); - return(1); -#endif -} -/* -. -... */ -void wngpvm_(long* addr) -{ - printf("memory: %p\n",addr); -} - - diff --git a/src/wng/wnggvm.fvx b/src/wng/wnggvm.fvx deleted file mode 100644 index f0cf4687db549e6eff298708b91e4e0b7a0f449c..0000000000000000000000000000000000000000 --- a/src/wng/wnggvm.fvx +++ /dev/null @@ -1,68 +0,0 @@ -C+ WNGGVM.FVX -C WNB 890724 -C -C Revisions: -C - LOGICAL FUNCTION WNGGVM(LEN,ADDR) -C -C Get/free virtual memory -C -C Result: -C -C WNGGVM_L = WNGGVM( LEN_J:I, ADDR_J:O) -C Get virtual memory area of length LEN. -C Address returned (if ok) in ADDR -C Area wil in general be not aligned. -C See WNGGVA.FOR for aligned area. -C WNGFVM_L = WNGFVM( LEN_J:I, ADDR_J:IO) -C Free virtual area at address ADDR with -C length LEN. -C -C Include files: -C - INCLUDE 'WNG_DEF' -C -C Parameters: -C -C -C Arguments: -C - INTEGER LEN !LENGTH TO GET/FREE - INTEGER ADDR !ADDRESS OF AREA -C -C Entry points: -C - LOGICAL WNGFVM -C -C Function references: -C - INTEGER LIB$GET_VM,LIB$FREE_VM !GET/FREE AREA -C -C Data declarations: -C -C- -C -C GET AREA -C - E_C=LIB$GET_VM(LEN,ADDR) !GET AREA - IF (.NOT.E_C) THEN !ERROR - WNGGVM=.FALSE. - ADDR=0 !MAKE SURE - ELSE - WNGGVM=.TRUE. - END IF -C - RETURN -C -C FREE AREA -C - ENTRY WNGFVM(LEN,ADDR) -C - E_C=LIB$FREE_VM(LEN,ADDR) !FREE AREA - ADDR=0 !AND SET FREE - WNGFVM=.TRUE. -C - RETURN -C -C - END diff --git a/src/wng/wngin.for b/src/wng/wngin.for deleted file mode 100644 index 5ba2ecde0d00364908f011a4bf9c8d6853bd907d..0000000000000000000000000000000000000000 --- a/src/wng/wngin.for +++ /dev/null @@ -1,81 +0,0 @@ -C+ WNGIN.FOR -C WNB 890308 -C -C Revisions: -C WNB 910828 Add ^C handler -C WNB 910909 Add WNGIN1 -C - SUBROUTINE WNGIN(PRG,VS,PDAT) -C -C Initialise program -C -C Result: -C -C CALL WNGIN ( PRG_C*:I, VS_C*:I, PDAT_J:I) -C Initialise program. Set PRG program name, -C VS version and PDAT datatype; open LOG file. -C CALL WNGIN1 Only initialise dummy arrays -C -C Include files: -C - INCLUDE 'WNG_DEF' -C -C Parameters: -C -C -C Arguments: -C - CHARACTER*(*) PRG !PROGRAM NAME - CHARACTER*(*) VS !PROGRAM VERSION - INTEGER PDAT !PROGRAM DATA TYPE -C -C Function references: -C - INTEGER WNGARA !VARIABLE ADDRESS -C -C Data declarations: -C - LOGICAL IN1 -C- - IN1=.FALSE. !NOT IN1 - GOTO 10 -C -C IN1 -C - ENTRY WNGIN1 -C - IN1=.TRUE. - GOTO 10 -C -C INIT WNG_COM -C - 10 CONTINUE - IF (.NOT.IN1) THEN - PRGNAM=PRG !SAVE PROGRAM NAME - PRGVER=VS !SAVE VERSION - PRGDAT=PDAT !SAVE DATA/MACHINE TYPE - LOGCD=F_YES !SET LOG, NOSPOOL - ELSE - PRGNAM='UNKNOWN' - PRGVER='910101' - PRGDAT=1 !ASSUME VAX DATA - END IF - E_C=1 !NO ERROR - A_OB=WNGARA(A_B) !ARRAY OFFSETS - A_OI=A_OB/LB_I - A_OJ=A_OB/LB_J - A_OK=A_OB/LB_K - A_OL=A_OB/LB_L - A_OE=A_OB/LB_E - A_OD=A_OB/LB_D - A_OX=A_OB/LB_X - A_OY=A_OB/LB_Y - IF (.NOT.IN1) THEN - CALL WNGSCC !SET ^C HANDLER - CALL WNCFOP(F_P,' ') !OPEN LOG FILE - END IF -C - RETURN -C -C - END diff --git a/src/wng/wnglogin.sun b/src/wng/wnglogin.sun deleted file mode 100755 index 599d4341b49c4bde32fbc8c8dc337aa3db5232e0..0000000000000000000000000000000000000000 --- a/src/wng/wnglogin.sun +++ /dev/null @@ -1,22 +0,0 @@ - if (! $?HOSTNAME) setenv HOSTNAME `hostname` - if (! -e $WNG/WNGFEX && -e $WNG/wngfex.sun) \ - ln -s $WNG/wngfex.sun $WNG/WNGFEX - if ("$?WNG" != "0") then - if ("$?_newpath" != "0") then - set _newpath=($_newpath $WNG) - else - set path=($path $WNG) - endif - endif - echo "Type nnews for Newstar news" -# wnglogin.sun -# WNB 920911 -# -# Revisions: -# HJV 921001 Change N-series to Newstar -# WNB 930128 Add HOSTNAME -# WNB 930301 Moved path from wngcshrc -# -# General login for all WN programs -# Call by inserting in .login as source $WNG/wnglogin.sun -# diff --git a/src/wng/wnglun.fsc b/src/wng/wnglun.fsc deleted file mode 100644 index 37cb565da51b8e7e56b4aba15add2503669a0872..0000000000000000000000000000000000000000 --- a/src/wng/wnglun.fsc +++ /dev/null @@ -1,112 +0,0 @@ -C+ WNGLUN.FSC -C WNB 890202 -C -C Revisions: -C WNB 921215 Make FSC for vx al hp dw sw cv -C - SUBROUTINE WNGLUN(LUN) -C -C Get/free LUN -C -C Result: -C -C CALL WNGLUN ( LUN_J:O) Get in LUN a free Fortran logical unit, -C or zero if none available. -C CALL WNGLUF ( LUN_J:IO) Free LUN as log. unit, and make it zero. -C -C Include files: -C - INCLUDE 'WNG_DEF' -C -C Parameters: -C -#ifndef wn_vx__ - INTEGER MXNLUN !MAX. # OF LUNS - PARAMETER (MXNLUN=64) - INTEGER OFFLUN !LOWEST LUN - PARAMETER (OFFLUN=20) -#endif -C -C Arguments: -C - INTEGER LUN !LUN TO SET OR TO FREE -C -C Entry points: -C -C -C Function references: -C -#ifdef wn_vx__ - INTEGER LIB$GET_LUN !GET LUN -#endif -C -C Data declarations: -C -#ifndef wn_vx__ - INTEGER LUNLST(MXNLUN) !LUN LIST - EXTERNAL LUN_BD !INITIALISE -C -C Commons: -C - COMMON /LUN_COM/ LUNLST -#endif -C- -C -C GET LUN -C -#ifdef wn_vx__ - E_C=LIB$GET_LUN(LUN) !GET LUN - IF (.NOT.E_C) LUN=0 !ERROR -#else - LUN=0 !ASSUME ERROR - DO I=1,MXNLUN !FIND FREE LUN - IF (LUNLST(I).EQ.0) THEN !FOUND - LUN=I+OFFLUN !SET LUN - LUNLST(I)=I !SET FILLED - GOTO 10 !READY - END IF - END DO - 10 CONTINUE -#endif -C - RETURN -C -C FREE LUN -C - ENTRY WNGLUF(LUN) -C -#ifdef wn_vx__ - CALL LIB$FREE_LUN(LUN) !FREE LUN -#else - IF (LUN.GT.OFFLUN .AND. LUN.LT.OFFLUN+MXNLUN) THEN - I=LUN-OFFLUN - IF (LUNLST(I).EQ.I) LUNLST(I)=0 !SET FREE - END IF -#endif - LUN=0 !SET NOT PRESENT -C - RETURN -C -C - END -#ifndef wn_vx__ -C -C INITIALISE LUN LIST -C - BLOCK DATA LUN_BD -C -C Parameters: -C - INTEGER MXNLUN !MAX. # OF LUNS - PARAMETER (MXNLUN=64) -C - INTEGER LUNLST(MXNLUN) !LUN LIST - DATA LUNLST/MXNLUN*0/ -C -C Commons: -C - COMMON /LUN_COM/ LUNLST -C -C - END -#endif diff --git a/src/wng/wngmed.fsc b/src/wng/wngmed.fsc deleted file mode 100644 index efe0d33f8ca4050a8e79ef6f5807d4c8f8483cae..0000000000000000000000000000000000000000 --- a/src/wng/wngmed.fsc +++ /dev/null @@ -1,131 +0,0 @@ -C+ WNGMED.FSC -C HjV 941107 Created -C -C Revisions: -C CMV 941111 Do not pass size if zero, option to override owner -C CMV 940120 Defensive rounding of size in Mbyte -C CMV 940125 More digits for size -C CMV 950127 Changed to logical function, test on NotFound -C HjV 961112 Close connection first -C - LOGICAL FUNCTION WNGMED(VOLUME,LABEL,SIZE,SEQNR) -C -C Add LABEL to VOLUME. If VOLUME does not exist, add VOLUME -C -C This routine will call lower level routines only for Unix systems at NFRA -C -C Result: -C -C J0=WNGMED( VOLUME_C*:I, LABEL_J:I, SIZE_R:I, SEQNR_J:I) -C -C -C Include files: -C - INCLUDE 'WNG_DEF' -C -C Parameters: -C -C -C Arguments: -C - CHARACTER*6 VOLUME !Volume to add label to - INTEGER LABEL !Label to add - REAL SIZE !Size of label in Mbytes - INTEGER SEQNR !Sequencenr. of label -C -C Entry points: -C -C -C Function references: -C - LOGICAL WNDPAR !Get DWARF parameter - INTEGER WNFSCI !Talk to Scissor qed deqmon - INTEGER WNFSCO !Open connection - INTEGER WNFSCC !Close connection -C -C Data declarations -C - CHARACTER*4 TYPE !Medium type - CHARACTER*8 OWNER !Username - CHARACTER*1024 COMMAND !Command to send -C -C- - WNGMED=.FALSE. !Assume failure -#ifdef wn_un__ -#ifdef wn_nfra__ -C -C Close connection first to prevent time-outs -C Begin November 1996 we suddently had problems and got -C messages like: broken pipe -C - J0=WNFSCC() !Close connection -C -C Open connection -C - J0=WNFSCO() !Open connection - IF (MOD(J0,100).NE.0) THEN - CALL WNCTXT(F_TP,'Could not connect to Scissor') - RETURN !Failed - END IF -C -C Send command to MEDIAD -C - CALL WNGSEG('SCIOWNER',OWNER) - IF (OWNER.EQ.' ') CALL WNGSGU(OWNER) !Get username - 100 CONTINUE - IF (SIZE.LE.0) THEN - CALL WNCTXS (COMMAND, - 1 'PUT=MEDIAD LABEL=!UJ VOLUME=!AS '// - 1 'SEQNUMBER=!UJ CREATOR=!AS', - 1 LABEL,VOLUME,SEQNR,OWNER) - ELSE - SIZE=SIZE+0.00005 - CALL WNCTXS (COMMAND, - 1 'PUT=MEDIAD LABEL=!UJ VOLUME=!AS '// - 1 'SIZE=!F10.4 SEQNUMBER=!UJ CREATOR=!AS', - 1 LABEL,VOLUME,SIZE,SEQNR,OWNER) - END IF - J0=WNFSCI(COMMAND) !Send command -C -C If "Not Found": Send command to VOLUMES and retry -C - IF (J0.EQ.205) THEN - 200 CONTINUE - IF (.NOT.WNDPAR('VOLUME_TYPE',TYPE,LEN(TYPE),J0,'DOD')) THEN - GOTO 200 !Repeat - ELSE IF (J0.LE.0) THEN - GOTO 200 !Must specify - END IF - CALL WNCTXS (COMMAND, - 1 'PUT=VOLUMES VOLUME=!AS TYPE=!AS OWNER=!AS', - 1 VOLUME,TYPE,OWNER) !Try to add new VOLUME - J0=WNFSCI(COMMAND) !Send command - IF (MOD(J0,100).NE.0) THEN !Failed - CALL WNCTXT(F_TP,'Error !UJ updating VOLUMES',J0) - ELSE - CALL WNCTXT(F_TP,'Added volume !AS on VOLUMES',VOLUME) - GOTO 100 !Now try label again - END IF -C -C If other failure, just notify -C - ELSE IF (MOD(J0,100).NE.0) THEN - CALL WNCTXT(F_TP,'Error !UJ updating MEDIAD',J0) -C -C If no error, return success -C - ELSE - CALL WNCTXT(F_TP,'Added label !UJ to volume !AS on MEDIAD', - 1 LABEL,VOLUME) - WNGMED=.TRUE. - END IF -C -C Close connection to prevent time-outs -C - J0=WNFSCC() !Close connection -C -#endif -#endif - RETURN -C - END diff --git a/src/wng/wngmv.for b/src/wng/wngmv.for deleted file mode 100644 index b416844e318ec9e36cf63c741a4b8db24a80af67..0000000000000000000000000000000000000000 --- a/src/wng/wngmv.for +++ /dev/null @@ -1,163 +0,0 @@ -C+ WNGMV.FOR -C WNB 880725 -C -C Revisions: -C - SUBROUTINE WNGMV(LGT,FROM,TO) -C -C Move data from field to field -C -C Result: -C -C CALL WNGMV( LGT_J:I, FROM_B(LGT):I, TO_B(LGT):O) -C Move LGT bytes from FROM to TO -C CALL WNGMVZ( LGT_J:I, TOZ_B(LGT):O) -C Move LGT zero bytes to TO -C CALL WNGMVB( LGT_J:I, TOZ_B(LGT):O) -C Move LGT spaces to TO -C CALL WNGMVF( LGT_J:I, FRST_C1:I, TO_B(LGT):O) -C Move LGT times FROM character to TO -C CALL WNGMVS( LGT_J:I, FROM_B(LGT):I, TO_B(LGT):O) -C Move LGT bytes from FROM to TO, swapping byte -C order. TO can be same as FROM. -C CALL WNGMFS( LGT_J:I, FRST_C*:I, TO_B(LGT):O) -C Move LGT characters from string FRST to TO. -C To will be filled with spaces if longer. -C CALL WNGMTS( LGT_J:I, FROM_B(LGT), TOST_C*:O) -C Move LGT bytes from FROM to string TOST. -C TOST will be filled with spaces if longer. -C CALL WNGMF0( LGT_J:I, FROM_B(LGT):I, TOST_C*:O) -C Move LGT characters from ASCIZ string -C CALL WNGMT0( LGT_J:I, FRST_C*:I, TO_B(LGT):O) -C Move LGT characters to ASCIZ string -C -C Include files: -C - INCLUDE 'WNG_DEF' -C -C Parameters: -C -C -C Arguments: -C - INTEGER LGT !LENGTH LIST - BYTE FROM(*) !INPUT LIST - BYTE TO(*) !OUTPUT LIST - BYTE TOZ(*) - CHARACTER*(*) FRST !INPUT STRING - CHARACTER*(*) TOST !OUTPUT STRING -C -C Function references: -C -C -C Data declarations: -C -C -C Equivalences: -C -C -C Commons: -C -C- -C -C WNGMV -C - DO I=1,LGT - TO(I)=FROM(I) - END DO -C - RETURN -C -C WNGMVZ -C - ENTRY WNGMVZ(LGT,TOZ) -C - DO I=1,LGT - TOZ(I)=0 - END DO -C - RETURN -C -C WNGMVB -C - ENTRY WNGMVB(LGT,TOZ) -C - DO I=1,LGT - TOZ(I)=ICHAR(' ') - END DO -C - RETURN -C -C WNGMVF -C - ENTRY WNGMVF(LGT,FRST,TO) -C - DO I=1,LGT - TO(I)=ICHAR(FRST(1:1)) - END DO -C - RETURN -C -C WNGMVS -C - ENTRY WNGMVS(LGT,FROM,TO) -C - DO I=2,LGT,2 - I1=FROM(I) - TO(I)=FROM(I-1) - TO(I-1)=I1 - END DO -C - RETURN -C -C WNGMFS -C - ENTRY WNGMFS(LGT,FRST,TO) -C - DO I=1,MIN(LGT,LEN(FRST)) - TO(I)=ICHAR(FRST(I:I)) - END DO - DO I=MIN(LGT,LEN(FRST))+1,LGT - TO(I)=ICHAR(' ') - END DO -C - RETURN -C -C WNGMTS -C - ENTRY WNGMTS(LGT,FROM,TOST) -C - TOST=' ' - DO I=1,MIN(LGT,LEN(TOST)) - TOST(I:I)=CHAR(FROM(I)) - END DO -C - RETURN -C -C WNGMF0 -C - ENTRY WNGMF0(LGT,FROM,TOST) -C - TOST=' ' - I1=MIN(LGT,LEN(TOST)) - I=1 - DO WHILE (FROM(I) .NE.0 .AND. I .LE.I1) - TOST(I:I)=CHAR(FROM(I)) !SET CHAR - I=I+1 - END DO -C - RETURN -C -C WNGMT0 -C - ENTRY WNGMT0(LGT,FRST,TO) -C - DO I=1,MIN(LGT,LEN(FRST)) - TO(I)=ICHAR(FRST(I:I)) - END DO - IF (LGT.GT.0) TO(MIN(LGT,LEN(FRST)+1))=0 !SET END -C - RETURN -C -C - END diff --git a/src/wng/wngsdi.cun b/src/wng/wngsdi.cun deleted file mode 100644 index 3a0face4090837ca1ecb5e175786e17443183232..0000000000000000000000000000000000000000 --- a/src/wng/wngsdi.cun +++ /dev/null @@ -1,690 +0,0 @@ -/* wngsdi.cun -. HjV 920702 -. -. Revisions: -. WNB 930331 Collect all system dummy interface C routines in -. this module (wngexi.chp wngsig.chp wngqsr.chp -. wngtim.chp wngsys.chp). -. Add setenv, getenv, unsetenv -. WNB 930413 Add gethost -. WNB 930416 Typos in HP getenv -. WNB 930427 Layout; make setenv/unsetenv for HP -. WNB 930429 SUN must use putenv i.s.o (un)setenv -. HjV 930503 eqs undefined (for SUN), so add it -. WNB 930526 Add getlogin -. CMV 940125 Add tflush -. CMV 940504 Add find_node -. CMV 940513 Find_node also recognises lower case -. CMV 940628 Add qsort for Alpha, remove some comments -. CMV 940628 Correct match_filtyp -. CMV 940628 Add DO_SYSTEM for all machines -. CMV 940629 Trap getlogin error -. CMV 940926 Changes for solaris -. HjV 960613 Typo (Include was missing > ) -. HjV 970408 For Solaris use special 'struct dirent' -... */ -#include <string.h> /* for strcpy */ - -#ifdef wn_hp__ - char eqs[] = "="; /* for setenv */ -#endif -#ifdef wn_sw__ - char eqs[] = "="; /* for setenv */ -#endif -/*........................................................................ -. FTN_EXIT -........................................................................*/ -#ifdef wn_hp__ - void FTN_EXIT (stat) -/* -. Provide FTN_EXIT for HP to exit image with specified status -. -. Result: -. -. CALL FTN_EXIT( STAT_J:I) -. Exit image -... */ -/* -. Arguments: -... */ - int *stat; /* exit status of image */ -{ -/* Exit image -. */ - exit (*stat); -} -/* -. -... */ -#endif -/*........................................................................ -. signal_ -........................................................................*/ -#ifdef wn_hp__ - long signal_(signum,proc,flag) -/* -. Set signal trap routine for HP -. This implementation is only a subset of the standard SUN (and other Unix) -. Fortran routine signal. It does not use the flag-argument. -. It only sets the trap-routine proc. -. -. Result: -. -. SIGNAL_J = signal_J( SIGNUM_J:I, PROC_J:I, FLAG_J:I)) -. Set signal trap routine -... */ -/* -. Arguments: -... */ - long *signum; /* signal number */ - long *proc; /* address of trap routine */ - long *flag; /* NOT USED */ -{ -/* -. Function references: - long signal(); -... */ -/* Set trap routine -. */ - return signal(*signum,proc); -} -/* -. -... */ -#endif -/*........................................................................ -. FTN_SYSTEM -........................................................................*/ -#ifdef wn_hp__ - int FTN_SYSTEM (comm) -/* -. To provide FTN_SYSTEM for HP to execute shell command -. -. Result: -. -. FTN_SYSTEM_J = FTN_SYSTEM( COMM_C*:I) Execute command COMM -. -... */ -/* -. Arguments: -... */ - char *comm; /* command to be executed */ -{ -/* Start subroutine -. */ - return system(comm); -} -/* -. -... */ -#endif -/*........................................................................ -. ctime_ -........................................................................*/ -#ifdef wn_hp__ - ctime_ (strtim,leng,time) -/* -. Convert time and date to string -. -. Result: -. -. CALL CTIME( STRTIM_C:O, LENG_J:I, TIME_J:I) -. -... */ -/* -. Arguments: -... */ - char strtim[]; /* time and date in string */ - int leng; /* max. length of STRTIM */ - int *time; /* time/date */ -{ -/* -. Function references: -... */ - char *ctime(); -/* -. Data declarations: -... */ - char *cp; -/*- */ -/* Convert date and time to string -. Copy to string argument and append with blanks -. */ - cp = ctime (time); - if (leng>24) { - memcpy (strtim, cp, 24); - memset (&strtim[24], ' ', leng-24); /* fill with blanks */ - } else { - memcpy (strtim, cp, leng); - } -} -/* -. -... */ -#endif -#ifdef wn_hp__ -/*........................................................................ -. time_ -........................................................................*/ -/* -. -. Revisions: -... */ - int time_ () -/* -. Get time -. -. Result: -. -. wngtim = time_() -. -... */ -/* -. Arguments: -... */ -{ -/* -. Function references: -... */ - int time(); -/*- */ -/* Get time -. */ - return time(0); -} -/* -. -... */ -#endif -/*........................................................................ -. qsort_ -........................................................................*/ -#ifdef wn_hp__ - void qsort_(base,nel,width,compar) -/* -. Start quicker-sort algorithm routine. -. This implementation is only a subset of the standard Unix Fortran -. routine qsort. -. -. Result: -. -. call qsort_( BASE_C:I, NEL_J:I, WIDTH_J:I, COMPAR_J:I) -. Start quicker-sort routine. -... */ -/* -. Arguments: -... */ - char *base; /* pointer to base of table */ - int *nel; /* Nr. of elements in table */ - int *width; /* size, in bytes, of each - element in the table */ - int (*compar)(); /* comparision function */ -{ -/* Set trap routine -. */ - qsort(base,*nel,*width,compar); -} -/* -. -... */ -#endif -#ifdef wn_da__ - void qsort_(base,nel,width,compar) -/* -. Arguments: -... */ - char *base; /* pointer to base of table */ - int *nel; /* Nr. of elements in table */ - int *width; /* size, in bytes, of each - element in the table */ - int (*compar)(); /* comparision function */ -{ -/* Set trap routine -. */ - qsort(base,*nel,*width,compar); -} -/* -. -... */ -#endif -#ifdef wn_li__ - void qsort_(base,nel,width,compar) -/* -. Arguments: -... */ - char *base; /* pointer to base of table */ - int *nel; /* Nr. of elements in table */ - int *width; /* size, in bytes, of each - element in the table */ - int (*compar)(); /* comparision function */ -{ -/* Set trap routine -. */ - qsort(base,*nel,*width,compar); -} -/* -. -... */ -#endif -/*........................................................................ -. getenv_ -........................................................................*/ -#ifdef wn_hp__ - void getenv_(name,val,lenv) -/* -. To provide Get environment for HP -. -. Result: -. -. CALL GETENV(NAME_C*:I, VAL_C*:O, LENV_J:I) Get env. NAME in VAL -. -... */ -/* -. Arguments: -... */ - char *name; /* environment name */ - char *val; /* returned value */ - int *lenv; /* length value string */ -{ -/* -. Function references: -... */ - char *getenv(); -/* -. Data declarations: -... */ - char *cp; - int len; -/*- */ - cp = getenv(name); - if (cp != 0) { - len = strlen(cp); /* length result */ - if (*lenv <= len) memcpy (val, cp, *lenv); - else { - memcpy (val, cp, len); - memset (&val[len], ' ', *lenv - len); /* fill with blanks */ - } - } else { - memset (val, ' ', *lenv); - } -} -/* -. -... */ -#endif -/*........................................................................ -. setenv_ -........................................................................*/ - void setenv_(name,val) -/* -. To provide Set environment for Unix -. -. Result: -. -. CALL SETENV(NAME_C*:I, VAL_C*:O) Set env. NAME to VAL -. -... */ -/* -. Arguments: -... */ - char *name; /* environment name */ - char *val; /* value to set */ -{ -/* -. Function references: -... */ -#ifdef wn_hp__ - char *malloc(); - int putenv(); -#else -# ifdef wn_sw__ - char *malloc(); - int putenv(); -# else - int setenv(); -# endif -#endif -/* -. Data declarations: -... */ - int i; -#ifdef wn_hp__ - char *estr; - char *rstr; -#endif -#ifdef wn_sw__ - char *estr; - char *rstr; -#endif -/*- */ -#ifndef wn_hp__ -# ifdef wn_sw__ - i = strlen(name) + strlen(val) + 4; /* length environment */ - estr = malloc((unsigned) i); /* get environment area */ - rstr = strcpy(estr, name); /* set name */ - rstr = strcat(estr, eqs); /* set = */ - rstr = strcat(estr, val); /* set value */ - i = putenv(estr); /* set environment */ -# else - i = setenv(name, val, 1); /* set env. value */ -# endif -#else - i = strlen(name) + strlen(val) + 4; /* length environment */ - estr = malloc((unsigned) i); /* get environment area */ - rstr = strcpy(estr, name); /* set name */ - rstr = strcat(estr, eqs); /* set = */ - rstr = strcat(estr, val); /* set value */ - i = putenv(estr); /* set environment */ -#endif -} -/* -. -... */ -/*........................................................................ -. unsetenv_ -........................................................................*/ - void unsetenv_(name) -/* -. To provide Unset environment for Unix -. -. Result: -. -. CALL UNSETENV(NAME_C*:I) Unset env. NAME -. -... */ -/* -. Arguments: -... */ - char *name; /* environment name */ -{ -/* -. Function references: -... */ -#ifdef wn_hp__ - char *malloc(); - int putenv(); -#else -# ifdef wn_sw__ - char *malloc(); - int putenv(); -# else - void unsetenv(); -# endif -#endif -/* -. Data declarations: -... */ -#ifdef wn_hp__ - int i; - char *estr; - char *rstr; -#endif -#ifdef wn_sw__ - int i; - char *estr; - char *rstr; -#endif -/*- */ -#ifndef wn_hp__ -# ifdef wn_sw__ - i = strlen(name) + 4; /* length environment */ - estr = malloc((unsigned) i); /* get environment area */ - rstr = strcpy(estr, name); /* set name */ - rstr = strcat(estr, eqs); /* set = */ - i = putenv(estr); /* set environment */ -# else - unsetenv(name); /* unset env. value */ -# endif -#else - i = strlen(name) + 4; /* length environment */ - estr = malloc((unsigned) i); /* get environment area */ - rstr = strcpy(estr, name); /* set name */ - rstr = strcat(estr, eqs); /* set = */ - i = putenv(estr); /* set environment */ -#endif -} -/* -. -... */ -/*........................................................................ -. gethost_ -........................................................................*/ - void gethost_(val,lval) -/* -. To provide gethostname for Unix -. -. Result: -. -. CALL GETHOST(VAL_C*:O, LVAL_J:I) Set HOSTNAME in VAL -. -... */ -/* -. Arguments: -... */ - char *val; /* host name */ - int *lval; /* length to set */ -{ -/* -. Function references: -... */ - void gethostname(); -/* -. Data declarations: -... */ -/*- */ - int i; - for (i=0; i<*lval; i++) val[i]=0; - gethostname(val, *lval); /* set host name */ -} -/* -. -... */ -#include <stdio.h> - -/*........................................................................ -. getlogin_ -........................................................................*/ - void getlogin_(val,lval) -/* -. To provide getlogin for Unix -. -. Result: -. -. CALL GETLOGIN(VAL_C*:O, LVAL_J:I) Set USERNAME in VAL -. -... */ -/* -. Arguments: -... */ - char *val; /* user name */ - int *lval; /* length to set */ -{ -/* -. Function references: -... */ - char *getlogin(); -/* -. Data declarations: -... */ - char *cp; - char *rstr; -/*- */ - cp = getlogin(); /* get user name */ - if (cp == NULL) cp="Unknown"; /* trap error */ - rstr = strcpy (val, cp); /* return user name */ -} -/* -. -... */ - -/*........................................................................ -. tflush_ -........................................................................*/ - void tflush_() -/* -. Flush the standard output (needed on some hp's when redirecting, -. otherwise exit will close the file without flushing -. -. Result: -. -. CALL TFLUSH() -. -... */ -/* -. Arguments: -... */ -{ -/*- */ - fflush(stdout); -} -/*........................................................................ -. do_system_ -........................................................................*/ - int do_system_(comm) -/* -. Spawn a sub-shell and execute a command. Use this interface since -. the Fortran library call will always go through .cshrc -. -. Result: -. -. STATUS_J = DO_SYSTEM(COMM_C*:I) -. -... */ -/* -. Arguments: -... */ - char *comm; /* Command to be executed */ -{ -/*- */ - return(system(comm)); -} -/* -. -... */ - -/*........................................................................ -. find_node_ -........................................................................*/ -#include <sys/types.h> -int alphasort(); -#ifdef wn_ucb__ -#include </usr/ucbinclude/sys/dir.h> -#else -#ifdef wn_so__ -struct dirent { - off_t d_off; /* offset of next disk dir entry */ - unsigned short d_reclen; /* length of this record */ - unsigned short d_namlen; /* length of string in d_name */ - char d_name[255+1]; /* name (up to MAXNAMLEN + 1) */ -}; -#else -#include <dirent.h> -#endif -#endif - -/* - - Auxilary function to match a given directory entry with a certain - filetype. - -*/ - -#define MAXFILTYP 10 - -static struct dirent **namelist=NULL; -static char filtyp_u[MAXFILTYP+1],filtyp_l[MAXFILTYP+1]; -static int filtyp_n=0; -static int nmatch=0,imatch=0; - - -static int match_filtyp(d1) - -struct dirent *d1; - -{ - int len=strlen(d1->d_name); - if (len <= filtyp_n) { /* Too short, sure no match */ - return(0); - } else { - return( !strncmp(d1->d_name+(len-filtyp_n),filtyp_u,filtyp_n) || - !strncmp(d1->d_name+(len-filtyp_n),filtyp_l,filtyp_n) ); - } -} - - - - int find_node_(name,dirnam_i,filtyp,flag,lname,ldirnam,lfiltyp) -/* -. -. Return the name of the next directory entry of type filtyp. -. If flag is 1, the directory list will be initiated, flag will -. be set to 0 in the first call. Returns 1 if valid name returned. -. -. Use: -. -. FLAG=1 -. DO WHILE (FIND_NODE(NAME,'.','WMP',FLAG).NE.0) -. CALL WNCTXT(F_T,'!AS',NAME) -. END DO -. -... */ -/* -. Arguments: -... */ - char *name,*dirnam_i,*filtyp; - int *flag,lname,ldirnam,lfiltyp; -{ -/* -. Include files: -... */ -/* -. Parameters: -... */ -/* -. Function references: -... */ -/* -. Data declarations: -... */ - int len=ldirnam; - char *dirnam; -/*- */ - - if (*flag) { /* Initialise */ - - dirnam=malloc((len+1)*sizeof(char)); - strncpy(dirnam,dirnam_i,len); - while (len>0 && - (dirnam[len-1]==' ' || - dirnam[len-1]=='\0')) len--; /* Strip trailing blanks*/ - dirnam[len]='\0'; /* Properly terminate */ - - filtyp_n=lfiltyp; /* Save length */ - if (filtyp_n>MAXFILTYP) filtyp_n=MAXFILTYP; /* Truncate */ - strncpy(filtyp_u,filtyp+lfiltyp-filtyp_n,filtyp_n); /* Copy type */ - filtyp_u[filtyp_n]='\0'; /* Properly terminate */ - strcpy(filtyp_l,filtyp_u); - for (imatch=0; imatch<filtyp_n; imatch++) - filtyp_l[imatch]=tolower(filtyp_l[imatch]); /* Lowercase */ - - *flag=0; /* Set done */ - imatch=0; /* No name returned yet */ - nmatch=scandir(dirnam,&namelist,match_filtyp,alphasort); - /* Get list */ - free(dirnam); - if (nmatch<=0) return(0); /* Return if empty */ - } - - if (imatch<nmatch) { - strncpy(name,namelist[imatch]->d_name,lname);/* Return next name */ - imatch++; /* Increase counter */ - if (imatch==nmatch) free(namelist); /* All done, free array */ - return(1); /* Valid name */ - } else { - return(0); /* No more names */ - } -} - -/* -. -... */ diff --git a/src/wng/wngsdl.fsc b/src/wng/wngsdl.fsc deleted file mode 100644 index 7e5cb356505da21a746965c10e69cc338a15b8a7..0000000000000000000000000000000000000000 --- a/src/wng/wngsdl.fsc +++ /dev/null @@ -1,59 +0,0 @@ -C+ WNGSDL.FSC -C CMV 940504 -C -C Revisions: -C CMV 940504 Created -C - LOGICAL FUNCTION WNGSDL(NAME,DATAB,PFX,FLAG) -C -C Get directory list of matching nodenames -C -C Result: -C -C FLAG=1 -C DO WHILE (WNGSDL(NAME_C*(*):O,DATAB_C*(*):I,PFX_C*(*):I,FLAG_J:IO)) -C ... -C END DO -C -C Include files: -C - INCLUDE 'WNG_DEF' -C -C Parameters: -C -C -C Arguments: -C - CHARACTER*(*) NAME !RETURNED NAME - CHARACTER*(*) DATAB !CURRENT DATABASE - CHARACTER*(*) PFX !FILETYPE TO MATCH - INTEGER FLAG !FIRST CALL IN SEQUENCE? -C -C Function references: -C -#ifdef wn_vx__ -#else - INTEGER WNCAL0 !GET STRING LENGTH - INTEGER FIND_NODE !GET NEXT NAME -#endif -C -C Data declarations: -C -C- - -#ifdef wn_vx__ - WNGSDL=.FALSE. !NOT IMPLEMENTED -#else - I=WNCAL0(DATAB) - IF (I.LE.0.OR.DATAB(1:1).EQ.'*') THEN - J=FIND_NODE(NAME,'./',PFX,FLAG) - ELSE - J=FIND_NODE(NAME,DATAB,PFX,FLAG) - END IF - WNGSDL=(J.GT.0) -#endif -C - RETURN -C -C - END diff --git a/src/wng/wngseg.fsc b/src/wng/wngseg.fsc deleted file mode 100644 index 9fef61228f6a5bcfc50913dfa562bc47653a20d6..0000000000000000000000000000000000000000 --- a/src/wng/wngseg.fsc +++ /dev/null @@ -1,47 +0,0 @@ -C+ WNGSEG.FSC -C WNB 930331 -C -C Revisions: -C - SUBROUTINE WNGSEG(NAME,VAL) -C -C Get environment variable -C -C Result: -C -C CALL WNGSEG( NAME_C*:I, VAL_C*:O) -C Get the value of the environment/logical -C NAME in VAL. All blanks if non-existent -C -C Include files: -C - INCLUDE 'WNG_DEF' -C -C Parameters: -C -C -C Arguments: -C - CHARACTER*(*) NAME !NAME OF ENV. VARIABLE - CHARACTER*(*) VAL !VALUE OF ENV. VARIABLE -C -C Function references: -C -#ifdef wn_vx__ - LOGICAL LIB$SYS_TRNLOG !GET LOGICAL NAME VALUE -#endif -C -C Data declarations: -C -C- -#ifdef wn_vx__ - JS=LIB$SYS_TRNLOG(NAME,I,VAL) !GET VALUE - IF (.NOT.JS .OR. I.LE.0) VAL=' ' !NO VALUE -#else - CALL GETENV(NAME,VAL) !GET VALUE -#endif -C - RETURN -C -C - END diff --git a/src/wng/wngses.fsc b/src/wng/wngses.fsc deleted file mode 100644 index 227cff13f6ea5c988bfc0baad700a2c912caf19f..0000000000000000000000000000000000000000 --- a/src/wng/wngses.fsc +++ /dev/null @@ -1,60 +0,0 @@ -C+ WNGSES.FSC -C WNB 930331 -C -C Revisions: -C - SUBROUTINE WNGSES(NAME,VAL) -C -C Set environment variable -C -C Result: -C -C CALL WNGSES( NAME_C*:I, VAL_C*:O) -C Set the value of the environment/logical -C NAME to VAL. -C -C Include files: -C - INCLUDE 'WNG_DEF' -C -C Parameters: -C -C -C Arguments: -C - CHARACTER*(*) NAME !NAME OF ENV. VARIABLE - CHARACTER*(*) VAL !VALUE OF ENV. VARIABLE -C -C Function references: -C -#ifdef wn_vx__ - LOGICAL LIB$SET_LOGICAL !SET LOGICAL NAME VALUE -#endif -C -C Data declarations: -C -C- - - i = INDEX(NAME," ") ! search first space - j = INDEX(VAL," ") ! search first space - NAME(i:i) = CHAR(0) ! place char 0 - VAL(j:j) = CHAR(0) ! place char 0 - -#ifdef wn_vx__ - JS=LIB$SET_LOGICAL(NAME,VAL) !SET VALUE -#else - CALL SETENV(NAME,VAL) !SET VALUE -#endif -C - RETURN -C -C - END - - - - - - - - diff --git a/src/wng/wngseu.fsc b/src/wng/wngseu.fsc deleted file mode 100644 index b7e824abe45805c2a074e3b3c0ff37e730a7b0e9..0000000000000000000000000000000000000000 --- a/src/wng/wngseu.fsc +++ /dev/null @@ -1,48 +0,0 @@ -C+ WNGSEU.FSC -C WNB 930331 -C -C Revisions: -C - SUBROUTINE WNGSEU(NAME) -C -C Unset environment variable -C -C Result: -C -C CALL WNGSEU( NAME_C*:I) -C Unset the environment/logical NAME. -C -C Include files: -C - INCLUDE 'WNG_DEF' -C -C Parameters: -C -C -C Arguments: -C - CHARACTER*(*) NAME !NAME OF ENV. VARIABLE -C -C Function references: -C - - i = INDEX(NAME," ") ! search first space - NAME(i:i) = CHAR(0) ! place char 0 - -#ifdef wn_vx__ - LOGICAL LIB$DELETE_LOGICAL !DELETE LOGICAL NAME -#endif -C -C Data declarations: -C -C- -#ifdef wn_vx__ - JS=LIB$DELETE_LOGICAL(NAME) !DELETE NAME -#else - CALL UNSETENV(NAME) !DELETE NAME -#endif -C - RETURN -C -C - END diff --git a/src/wng/wngsgh.fsc b/src/wng/wngsgh.fsc deleted file mode 100644 index c74c38f4350847284041e50166fba6edab55bfeb..0000000000000000000000000000000000000000 --- a/src/wng/wngsgh.fsc +++ /dev/null @@ -1,61 +0,0 @@ -C+ WNGSGH.FSC -C WNB 930413 -C -C Revisions: -C WNB 930526 Correct description -C Hjv 940303 Call WNGSEG when empty HOST (UNIX) -C - SUBROUTINE WNGSGH(VAL) -C -C Get current hostname -C -C Result: -C -C CALL WNGSGH( VAL_C*:O) -C Get the name of the current host in VAL. -C -C Include files: -C - INCLUDE 'WNG_DEF' -C -C Parameters: -C -#ifdef wn_vx__ - INTEGER SYI$_NODENAME !NODENAME SYSTEM CODE - PARAMETER (SYI$_NODENAME='10d9'X) -#endif -C -C Arguments: -C - CHARACTER*(*) VAL !VALUE OF HOST NAME -C -C Function references: -C -#ifdef wn_vx__ - LOGICAL LIB$GETSYI !GET SYSTEM INFO -#else - INTEGER WNCALN !GET STRING LENGTH -#endif -C -C Data declarations: -C -#ifndef wn_vx__ - CHARACTER*64 HOST !HOST NAME -#endif -C- -#ifdef wn_vx__ - JS=LIB$GETSYI(SYI$_NODENAME,,VAL) !GET NODE NAME - IF (.NOT.JS) VAL=' ' !NO VALUE -#else - CALL GETHOST(HOST,LEN(HOST)) - VAL=HOST(1:WNCALN(HOST)) !MAKE NON-ASCIZ - IF (VAL.EQ.' ') THEN !NO HOST NAME - CALL WNGSEG('HOST',VAL) - IF (VAL.EQ.' ') VAL='UNKNOWN' !STILL NO HOST NAME - END IF -#endif -C - RETURN -C -C - END diff --git a/src/wng/wngsgu.fsc b/src/wng/wngsgu.fsc deleted file mode 100644 index a0f4adf64b9cddba94ce15c21cde0b482901f6d3..0000000000000000000000000000000000000000 --- a/src/wng/wngsgu.fsc +++ /dev/null @@ -1,63 +0,0 @@ -C+ WNGSGU.FSC -C WNB 930526 -C -C Revisions: -C Hjv 940307 Call WNGSEG when empty USER (UNIX) -C - SUBROUTINE WNGSGU(VAL) -C -C Get login name -C -C Result: -C -C CALL WNGSGU( VAL_C*:O) -C Get the name of the current user in VAL. -C -C Include files: -C - INCLUDE 'WNG_DEF' -C -C Parameters: -C -#ifdef wn_vx__ - INTEGER JPI$_USERNAME !USERNAME SYSTEM CODE - PARAMETER (JPI$_USERNAME='0202'X) -#endif -C -C Arguments: -C - CHARACTER*(*) VAL !VALUE OF USER NAME -C -C Function references: -C -#ifdef wn_vx__ - LOGICAL LIB$GETJPI !GET SYSTEM INFO -#else - INTEGER WNCALN !GET STRING LENGTH -#endif -C -C Data declarations: -C - CHARACTER*32 USER !USER NAME -C- -#ifdef wn_vx__ - JS=LIB$GETJPI(JPI$_USERNAME,,,,USER) !GET USER NAME - IF (.NOT.JS) THEN - VAL=' ' !NO VALUE - ELSE - VAL=USER(1:12) !RETURN NAME - END IF -#else - CALL GETLOGIN(USER,LEN(USER)) - VAL=USER(1:WNCALN(USER)) !MAKE NON-ASCIZ - IF ((VAL.EQ.' ').OR.(VAL.EQ.CHAR(0))) THEN !NO USER NAME - CALL WNGSEG('USER',VAL) - IF ((VAL.EQ.' ').OR.(VAL.EQ.CHAR(0))) VAL='UNKNOWN' !STILL NO USER NAME - END IF -#endif - CALL WNCAUC(VAL) !MAKE UC -C - RETURN -C -C - END diff --git a/src/wng/wngslp.cun b/src/wng/wngslp.cun deleted file mode 100644 index 66290515d426af8d1e03f90cc13468b2e4c79356..0000000000000000000000000000000000000000 --- a/src/wng/wngslp.cun +++ /dev/null @@ -1,20 +0,0 @@ -/*+ wngslp.cun -. JPH 960622 -. -. Revisions: -JPH 9611.. int --> long -JPH 961210 convert long argument to unsigned - ... */ -#include <sys/time.h> -/* -. History -... */ -unsigned wngslp_(sec) - long* sec; -{ - unsigned s; - s=*sec; - sleep(s); - return; -} - diff --git a/src/wng/wngsqi.fvx b/src/wng/wngsqi.fvx deleted file mode 100644 index 50e782723cbf34b25dd574443b9efc4b9afc6b55..0000000000000000000000000000000000000000 --- a/src/wng/wngsqi.fvx +++ /dev/null @@ -1,66 +0,0 @@ -C+ WNGSQI.FVX -C WNB 930818 -C -C Revisions: -C - LOGICAL FUNCTION WNGSQI(ENTRY,HEAD) -C -C Manipulate absolute queues -C -C Result: -C -C WNGSQI_L = WNGSQI( ENTRY_J(*):IO, HEAD_J(2):IO) -C Insert entry at head: .TRUE. if first inserted -C WNGSQR_L = WNGSQR( ENTRY_J(*):IO, ADDR_J:O) -C Remove entry at FROM, and give its ADDRess -C .TRUE. if entry existed -C Note: WNGSQI and WNGSQR are not interlocked against -C AST and other interrupts -C -C Include files: -C - INCLUDE 'WNG_DEF' -C -C Parameters: -C -C -C Arguments: -C - INTEGER ENTRY(0:*) !ENTRY - INTEGER HEAD(0:*) !ENTRY WHERE TO INSERT - INTEGER ADDR !ADDRESS OF ENTRY REMOVED -C -C Entry points: -C - LOGICAL WNGSQR -C -C Function references: -C -C -C Data declarations: -C -C- -C -C WNGSQI -C - ENTRY(0)=HEAD(0) !FORWARD LINK ENTRY - ENTRY(1)=%LOC(HEAD) !BACKWARD LINK ENTRY - A_J((HEAD(0)-A_OB)/LB_J+1)=%LOC(ENTRY) !BACKWARD LINK SUCCESSOR - HEAD(0)=%LOC(ENTRY) !FORWARD LINK PREDECESSOR - WNGSQI=ENTRY(0).EQ.ENTRY(1) !SET IF FIRST -C - RETURN -C -C WNGSQR -C - ENTRY WNGSQR(ENTRY,ADDR) -C - A_J((ENTRY(1)-A_OB)/LB_J)=ENTRY(0) !FORWARD LINK PREDECESSOR - A_J((ENTRY(0)-A_OB)/LB_J+1)=ENTRY(1) !BACKWARD LINK PREDECESSOR - ADDR=%LOC(ENTRY) - WNGSQR=ADDR.NE.ENTRY(1) !EXISTED -C - RETURN -C -C - END diff --git a/src/wng/wngsrt.fun b/src/wng/wngsrt.fun deleted file mode 100644 index 9431e0533e52bc303323963868754832001f33fa..0000000000000000000000000000000000000000 --- a/src/wng/wngsrt.fun +++ /dev/null @@ -1,48 +0,0 @@ -C+ WNGSRT.FUN -C WNB 900327 -C -C Revisions: -C WNB 921216 Make FUN -C - LOGICAL FUNCTION WNGSRT(AREA,NREC,RECL,ROUT) -C -C Sort a buffer in memory -C -C Result: -C -C WNGSRT_L = WNGSRT ( AREA_B(*):IO, NREC_J:I, RECL_J:I, ROUT_EXT:I) -C Sort the AREA with NREC records of length -C RECL using the routine ROUT. ROUT is -C a function with at least 2 arguments, -C the records to be compared. It returns -C a J value: 0: equal value -C -1: 1st before 2nd -C +1: 2nd before first -C -C Include files: -C - INCLUDE 'WNG_DEF' -C -C Parameters: -C -C -C Arguments: -C - BYTE AREA(*) !AREA TO SORT - INTEGER NREC !# OF RECORDS TO SORT - INTEGER RECL !LENGTH ONE RECORD - EXTERNAL ROUT !COMPARISON ROUTINE -C -C Function references: -C -C -C Data declarations: -C -C- - WNGSRT=.TRUE. !ASSUME OK - CALL QSORT(AREA,NREC,RECL,ROUT) !DO SORT -C - RETURN -C -C - END diff --git a/src/wng/wngsrt.fvx b/src/wng/wngsrt.fvx deleted file mode 100644 index 449d43be25162ec24854e950c3a79bf989cad641..0000000000000000000000000000000000000000 --- a/src/wng/wngsrt.fvx +++ /dev/null @@ -1,81 +0,0 @@ -C+ WNGSRT.FVX -C WNB 900327 -C -C Revisions: -C - LOGICAL FUNCTION WNGSRT(AREA,NREC,RECL,ROUT) -C -C Sort a buffer in memory -C -C Result: -C -C WNGSRT_L = WNGSRT ( AREA_B(*):IO, NREC_J:I, RECL_J:I, ROUT_EXT:I) -C Sort the AREA with NREC records of length -C RECL using the routine ROUT. ROUT is -C a function with at least 2 arguments, -C the records to be compared. It returns -C a J value: 0: equal value -C -1: 1st before 2nd -C +1: 2nd before first -C -C Include files: -C - INCLUDE 'WNG_DEF' -C -C Parameters: -C -C -C Arguments: -C - BYTE AREA(*) !AREA TO SORT - INTEGER NREC !# OF RECORDS TO SORT - INTEGER RECL !LENGTH ONE RECORD - EXTERNAL ROUT !COMPARISON ROUTINE -C -C Entry points: -C -C -C Function references: -C - INTEGER SOR$BEGIN_SORT !START SORT - INTEGER SOR$RELEASE_REC !MOVE RECORD - INTEGER SOR$RETURN_REC !GET A DORTED RECORD - INTEGER SOR$SORT_MERGE !SORT - INTEGER WNGARA !GET ADDRESS VARIABLE -C -C Data declarations: -C - INTEGER RECD(2) !RECORD DESCRIPTOR -C- - WNGSRT=.TRUE. !ASSUME OK - IF (.NOT.SOR$BEGIN_SORT(,RECL,,(NREC*RECL+511)/512, - 1 ROUT)) GOTO 900 !START SORT - RECD(1)=RECL !MAKE DESCRIPTOR - RECD(2)=WNGARA(AREA) !ADDRESS RECORD - DO I=0,NREC-1 !MOVE RECORDS - IF (.NOT.SOR$RELEASE_REC(RECD)) GOTO 901 !SET A RECORD - RECD(2)=RECD(2)+RECL !POINT TO NEXT RECORD - END DO - IF (.NOT.SOR$SORT_MERGE()) GOTO 901 !DO SORT - RECD(1)=RECL !MAKE DESCRIPTOR - RECD(2)=WNGARA(AREA) !ADDRESS RECORD - DO I=0,NREC-1 !MOVE RECORDS BACK - IF (.NOT.SOR$RETURN_REC(RECD)) GOTO 901 !GET A RECORD - RECD(2)=RECD(2)+RECL !POINT TO NEXT RECORD - END DO - CALL SOR$END_SORT !CLEAN UP -C - RETURN -C -C ERROR -C - 901 CONTINUE - CALL SOR$END_SORT !CLEAN UP - 900 CONTINUE - WNGSRT=.FALSE. -C - RETURN -C -C -C - END diff --git a/src/wng/wngssp.fsc b/src/wng/wngssp.fsc deleted file mode 100644 index 2eb77bea8ca9bac9fb8edae073ff9d3bd60a9bbd..0000000000000000000000000000000000000000 --- a/src/wng/wngssp.fsc +++ /dev/null @@ -1,63 +0,0 @@ -C+ WNGSSP.FSC -C WNB 890202 -C -C Revisions: -C WNB 921216 Make FSC -C CMV 930707 Changed $WNG to $n_src/sys -C CMV 940628 Use do_system i.s.o. system call -C - SUBROUTINE WNGSSP(COM,ARG1,ARG2,ARG3) -C -C Spawn a sub-process -C -C Result: -C -C CALL WNGSSP ( COM_C*:I, ARG1_C*:I, ARG2_C*:I, ARG3_C*:I) -C Execute COM with ARG1..3 as arguments -C -C Include files: -C - INCLUDE 'WNG_DEF' -C -C Parameters: -C -C -C Arguments: -C - CHARACTER*(*) COM !COMMAND TO EXECUTE - CHARACTER*(*) ARG1,ARG2,ARG3 !ARGUMENTS TO COMMAND -C -C Function references: -C - INTEGER WNCALN !STRING LENGTH -C -C Data declarations: -C -#ifndef wn_vx__ - CHARACTER*512 TXT -#endif -C- -#ifdef wn_vx__ - CALL LIB$SPAWN(COM(1:WNCALN(COM))//' '// - 1 ARG1(1:WNCALN(ARG1))//' '// - 2 ARG2(1:WNCALN(ARG2))//' '// - 3 ARG3(1:WNCALN(ARG3)),,'NL:') !SPAWN -#else - IF (COM(1:7).EQ.'WNGFEX ') THEN - TXT='csh -f $n_src/sys/wngfex.csh'//COM(7:WNCALN(COM))// - 1 ' '//ARG1(1:WNCALN(ARG1))// - 2 ' '//ARG2(1:WNCALN(ARG2))// - 3 ' '//ARG3(1:WNCALN(ARG3)) !SPAWN TEXT - ELSE - TXT='csh -f '//COM(1:WNCALN(COM))// - 1 ' '//ARG1(1:WNCALN(ARG1))// - 2 ' '//ARG2(1:WNCALN(ARG2))// - 3 ' '//ARG3(1:WNCALN(ARG3)) !SPAWN TEXT - ENDIF - CALL DO_SYSTEM(TXT(1:WNCALN(TXT))//CHAR(0)) !SPAWN -#endif -C - RETURN -C -C - END diff --git a/src/wng/wngswb.for b/src/wng/wngswb.for deleted file mode 100644 index 5409dda21b978976edb50ac812c34dc3c979ca0d..0000000000000000000000000000000000000000 --- a/src/wng/wngswb.for +++ /dev/null @@ -1,107 +0,0 @@ -c+ WNGSWB.FOR -C WNB 900315 -C -C Revisions: -C GvD 920402 Added entry WNGSWQ -C - SUBROUTINE WNGSWB(N,BUF) -C -C Swap bytes -C -C Result: -C -C CALL WNGSWB( N_J:I, BUF_B(0:*):IO) -C Will swap byte pairs in BUF of length N bytes -C CALL WNGSWI( N_J:I, BUF_B(0:*):IO) -C Will swap Integer*2 pairs in BUF of length N bytes -C CALL WNGSWJ( N_J:I, BUF_B(0:*):IO) -C Will reverse byte order in Integer*4 values in BUF -C of length N bytes -C CALL WNGSWQ( N_J:I, BUF_B(0:*):IO) -C Will reverse byte order in Real*8 values in BUF -C of length N bytes -C -C Include files: -C - INCLUDE 'WNG_DEF' -C -C Parameters: -C -C -C Arguments: -C - INTEGER N !BUFFER LENGTH IN BYTES - BYTE BUF(0:*) !BUFFER TO TRANSLATE -C -C Function references: -C -C -C Data declarations: -C - BYTE BB,BC(0:7) -C- -C -C SWB -C - DO I=0,2*(N/2)-1,2 - BB=BUF(I) - BUF(I)=BUF(I+1) - BUF(I+1)=BB - END DO -C - RETURN -C -C SWI -C - ENTRY WNGSWI(N,BUF) -C - DO I=0,4*(N/4)-1,4 - DO I1=0,3 - BC(I1)=BUF(I+I1) - END DO - BUF(I+0)=BC(2) - BUF(I+1)=BC(3) - BUF(I+2)=BC(0) - BUF(I+3)=BC(1) - END DO -C - RETURN -C -C SWJ -C - ENTRY WNGSWJ(N,BUF) -C - DO I=0,4*(N/4)-1,4 - DO I1=0,3 - BC(I1)=BUF(I+I1) - END DO - BUF(I+0)=BC(3) - BUF(I+1)=BC(2) - BUF(I+2)=BC(1) - BUF(I+3)=BC(0) - END DO -C - RETURN -C -C SWQ -C - ENTRY WNGSWQ(N,BUF) -C - DO I=0,8*(N/8)-1,8 - DO I1=0,7 - BC(I1)=BUF(I+I1) - END DO - BUF(I+0)=BC(7) - BUF(I+1)=BC(6) - BUF(I+2)=BC(5) - BUF(I+3)=BC(4) - BUF(I+4)=BC(3) - BUF(I+5)=BC(2) - BUF(I+6)=BC(1) - BUF(I+7)=BC(0) - END DO -C - RETURN -C -C - END diff --git a/src/wng/wngsws.cun b/src/wng/wngsws.cun deleted file mode 100644 index 3b57d457c388f2fe5c17ddf1002b62c289883e0d..0000000000000000000000000000000000000000 --- a/src/wng/wngsws.cun +++ /dev/null @@ -1,95 +0,0 @@ -/*+ wngsws.cun -. WNB 931029 -. -. Revisions: -. HjV 931029 Change -> to . (Problems on HP) -... */ -#include <sys/time.h> -/* -. History -... */ - static struct itimerval tvalue, ovalue; /* time info */ -/* -... */ - int wngsws_(sec) -/* -. Wait a while -. -. Result: -. -. wngsws ( SEC_E:I) wait SEC seconds -. wngswm ( MSEC_J:I) wait MSEC milliseconds -... */ -/* -. Arguments: -... */ - float *sec; /* time to wait */ -{ -/* -. Include files: -... */ -/* -. Parameters: -... */ -/*- */ -/* -. Function references: -... */ -/* -. Data declarations: -... */ -/* -. Init time -... */ - tvalue.it_value.tv_sec = *sec; - tvalue.it_value.tv_usec = - (int)((*sec - tvalue.it_value.tv_sec) * 1000000) % 1000000; - tvalue.it_interval.tv_sec = 0; - tvalue.it_interval.tv_usec = 0; -/* -. Wait -... */ - setitimer(0, &tvalue, &ovalue); - pause(); - return; -} -/* -. wngswm -... */ - int wngswm_(msec) -/* -. Arguments: -... */ - long *msec; /* time to wait */ -{ -/* -. Include files: -... */ -/* -. Parameters: -... */ -/*- */ -/* -. Function references: -... */ -/* -. Data declarations: -... */ -/* -. Init time -... */ - tvalue.it_value.tv_sec = *msec / 1000; - tvalue.it_value.tv_usec = - (*msec - 1000 * tvalue.it_value.tv_sec) % 1000000; - tvalue.it_interval.tv_sec = 0; - tvalue.it_interval.tv_usec = 0; -/* -. Wait -... */ - setitimer(0, &tvalue, &ovalue); - pause(); - return; -} -/* -. -... */ diff --git a/src/wng/wngsws.fvx b/src/wng/wngsws.fvx deleted file mode 100644 index d6ae48112c9787712ffab511c938da65bd5d9df7..0000000000000000000000000000000000000000 --- a/src/wng/wngsws.fvx +++ /dev/null @@ -1,50 +0,0 @@ -C+ WNGSWS.FVX -C WNB 931029 -C -C Revisions: -C - SUBROUTINE WNGSWS(SEC) -C -C Wait a period -C -C Result: -C -C CALL WNGSWS ( SEC_E:I) Wait SEC seconds -C CALL WNGSWM ( MSEC_J:I) Wait MSEC milliseconds -C -C Include files: -C - INCLUDE 'WNG_DEF' -C -C Parameters: -C -C -C Arguments: -C - REAL SEC !SECONDS TO WAIT - INTEGER MSEC !MSEC TO WAIT -C -C Function references: -C - INTEGER LIB$WAIT !WAIT -C -C Data declarations: -C -C- -C -C WNGSWS -C - JS=LIB$WAIT(SEC) !WAIT -C - RETURN -C -C WNGSWM -C - ENTRY WNGSWM(MSEC) -C - JS=LIB$WAIT(MSEC/1000.) -C - RETURN -C -C - END diff --git a/src/wng/wngsxh.fsc b/src/wng/wngsxh.fsc deleted file mode 100644 index 7af34c016a0ec20cf2129a98943ff33c52fa9d61..0000000000000000000000000000000000000000 --- a/src/wng/wngsxh.fsc +++ /dev/null @@ -1,161 +0,0 @@ -C+ WNGSXH.FSC -C WNB 890202 -C -C Revisions: -C WNB 910828 Add ^C handler -C WNB 921215 Make FSC -C JPH 960621 Entry WNGSC0 -C -C - SUBROUTINE WNGSXH(AREA,ROUT) -C -C Set/free exit handler -C -C Result: -C -C CALL WNGSXH ( AREA_J(6):IO, ROUT_EXT:I) -C Specify ROUT as an exit handler. AREA is -C a six INTEGER*4 block. The first is used -C to indicate if handler set (0=not), the -C other 5 are control area. -C CALL WNGSXF ( AREA_J(6):IO) -C Delete exit handler, if set, and set free. -C CALL WNGSXX Do exit handlers (dummy for VAX) -C CALL WNGSCC Set ^C handler (dummy if VAX) -C CALL WNGSC0 Same but leave inhibit status and count -C -C Include files: -C - INCLUDE 'WNG_DEF' - INCLUDE 'WXH_DEF' -#ifdef wn_al__ - INCLUDE '/usr/include/fortran/signal.h' -#endif -C -C Parameters: -C -#ifndef wn_vx__ - #ifdef wn_al__ - #else - INTEGER SIGINT !INTERRUPT SIGNAL - PARAMETER (SIGINT=2) - #endif -#endif -C -C Arguments: -C - INTEGER AREA(6) !CONTROL AREA - EXTERNAL ROUT -C -C Entry points: -C -C -C Function references: -C -#ifdef wn_vx__ - INTEGER SYS$DCLEXH !DECLARE AN EXIT HANDLER -#else - INTEGER WNGARA !ARG. ADDRESS - EXTERNAL WNGEX0 !^C HANDLER -#endif -C -C Data declarations: -C -#ifndef wn_vx__ - INTEGER ALIST(-1:1) !DUMMY ARGUMENT LIST - DATA ALIST/0,1,0/ -#endif -C- - IF (AREA(1).EQ.0) THEN !STILL TO SET -#ifdef wn_vx__ - AREA(3)=%LOC(ROUT) !ROUTINE TO CALL - AREA(4)=1 !NUMBER OF ARG. - AREA(5)=%LOC(AREA(6)) !STATUS WORD ADDRESS - IF (SYS$DCLEXH(AREA(2))) AREA(1)=1 !SET DECLARED -#else - AREA(3)=WNGARA(ROUT) !ROUTINE TO CALL - AREA(4)=1 !NUMBER OF ARG. - AREA(5)=WNGARA(AREA(6)) !STATUS WORD ADDRESS - AREA(2)=XHED !LINK - XHED=WNGARA(AREA(2)) - AREA(1)=1 !SET DECLARED -#endif - END IF -C - RETURN -C -C FREE EXIT HANDLER -C - ENTRY WNGSXF(AREA) -C -#ifdef wn_vx__ - IF (AREA(1).NE.0) CALL SYS$CANEXH(AREA(2)) -#else - IF (AREA(1).NE.0) THEN - J=WNGARA(AREA(2)) !LINKED ADDRESS - J1=XHED !FIND IT - J2=WNGARA(XHED) !PREVIOUS - 10 CONTINUE - IF (J1.EQ.0) THEN !EOL, NOT FOUND - ELSE IF (J.EQ.J1) THEN !FOUND - CALL WNGMV(LB_J,AREA(2),A_B(J2-A_OB)) !DELETE FROM LIST - ELSE - J2=J1 !FOLLOW LIST - CALL WNGMV(LB_J,A_B(J2-A_OB),J1) - GOTO 10 - END IF - END IF -#endif - AREA(1)=0 -C - RETURN -C -C DO EXIT HANDLERS -C - ENTRY WNGSXX -C -#ifndef wn_vx__ - J=XHED !FIRST TO DO - DO WHILE (J.NE.0) !MORE - CALL WNGMV(LB_J,A_B(J-A_OB+LB_J),J1) !ROUTINE ADDRESS - CALL WNGARX(A_B(J1-A_OB),ALIST(0)) !DO ROUTINE - CALL WNGMV(LB_J,A_B(J-A_OB),J) !NEXT POINTER - END DO -C - IF (IAND(E_C,1).EQ.1) E_C=1 - CALL EXIT(E_C) !EXIT -#endif - RETURN !DUMMY -C -C SET ^C HANDLER -C - ENTRY WNGSCC -C -cc print*, 'SCC' -#ifndef wn_vx__ - XHCC(0)=0 !DO NOT INHIBIT - XHCC(1)=0 !SET NOT SEEN - GOTO 20 -C - ENTRY WNGSC0 -C -cc print*, 'SC0' - 20 CONTINUE - #ifdef wn_al__ - CALL SIGVEC(SIGINT,SIG_CALL,WNGEX0,I,I1) - #else - CALL SIGNAL(SIGINT,WNGEX0) - #endif -#endif - RETURN !DUMMY -C -C -C - END - - - - - - - diff --git a/src/wng/wngsyt.fsc b/src/wng/wngsyt.fsc deleted file mode 100644 index fca97c9d4e183fc4a9c887c3016131246f17f267..0000000000000000000000000000000000000000 --- a/src/wng/wngsyt.fsc +++ /dev/null @@ -1,90 +0,0 @@ -C+ WNGSYT.FSC -C WNB 890201 -C -C Revisions: -C WNB 921216 Make FSC for vx al hp dw sw cv -C CMV 940927 Add check on timezone -C - SUBROUTINE WNGSYT(COUT) -C -C Get system date and time -C -C Result: -C -C CALL WNGSYT ( COUT_C*:O) Set current date and time in COUT -C as DD-Mmm-YYYY HH:MM:SS.SS (23 long) -C -C Include files: -C - INCLUDE 'WNG_DEF' -C -C Parameters: -C -C -C Arguments: -C - CHARACTER*(*) COUT !OUTPUT STRING -C -C Function references: -C - CHARACTER*1 WNCAUP,WNCALO !CASE CONVERSION -#ifdef wn_al__ - CHARACTER*24 CTIME !CONVERT TIME TO ASCII - INTEGER TIME !GET SYSTEM TIME -#endif -#ifdef wn_hp__ - CHARACTER*24 CTIME !CONVERT TIME TO ASCII - INTEGER TIME !GET SYSTEM TIME -#endif -#ifdef wn_cv__ - CHARACTER*24 FDATE !CONVERT TIME TO ASCII -#endif -C -C Data declarations: -C -#ifndef wn_vx__ - CHARACTER*30 STIME !SYSTEM TIME -#endif -C- -#ifdef wn_vx__ - CALL SYS$ASCTIM(,COUT,,) !GET CURRENT DATE AND TIME -#else - #ifdef wn_al__ - STIME=CTIME(TIME()) !GET DATE/TIME - #else - #ifdef wn_cv__ - STIME=FDATE() !GET DATE/TIME - #else - #ifdef wn_hp__ - STIME=CTIME(TIME()) - #else - CALL FDATE(STIME) !GET DATE/TIME - #endif - #endif - #endif -C -C 123456789012345678901234567890 -C Tue Sep 27 11:16:06 MET 1994 -C Tue Sep 27 11:16:06 1994 -C - COUT=STIME(9:10)//'-' !DD - COUT(4:7)=STIME(5:7)//'-' !MMM - I1=21 - DO WHILE (I1.LT.30.AND. !SKIP TIMEZONE - 1 (STIME(I1:I1).LT.'1'.OR.STIME(I1:I1).GT.'9')) - I1=I1+1 - END DO - COUT(8:11)=STIME(I1:I1+3) !YYYY - COUT(13:20)=STIME(12:19) !HH:MM:SS - COUT(21:23)='.00' !.CC -#endif - IF (COUT(1:1).EQ.' ') COUT(1:1)='0' - IF (COUT(13:13).EQ.' ') COUT(13:13)='0' - COUT(4:4)=WNCAUP(COUT(4:4)) !MAKE Mmm - COUT(5:5)=WNCALO(COUT(5:5)) - COUT(6:6)=WNCALO(COUT(6:6)) -C - RETURN -C -C - END diff --git a/src/wng/wngu2s.for b/src/wng/wngu2s.for deleted file mode 100644 index 8250ec954f5abcb234fffdb360bbd6b69bb1d9ba..0000000000000000000000000000000000000000 --- a/src/wng/wngu2s.for +++ /dev/null @@ -1,258 +0,0 @@ -c+ WNGU2S.FOR -C HjV 950124 Made from routines used at Westerbork -C -C Revisions: -C - SUBROUTINE WNGU2S (DIR, YEAR, UTDAY, UT, STDAY, ST) -C -C Convert UT<-->ST -C -C Result: -C -C CALL WNGU2S( DIR_J:I, YEAR_J:I, UTDAY_J:IO, UT_D:IO, STDAY_J:IO, ST_D:IO) -C Convert ST <--> UT -C CALL WNGJVS( DIR_J:I, JD_D:IO, LMST_D:IO) -C Calculate Sidereal time <--> Universal time in 1950 system -C CALL WNGJUL( DIR_J:I, YEAR_J:IO, UTDAY_J:IO, UT_D:IO, JD_D:IO) -C Julian day/time moment <--> Civil day/time -C CALL WNGSTL( DIR:J:I, LMST_D:IO, LSD_J:IO, ST_D:IO) -C Calculate LSD nr and time in day fraction <--> LMST moment -C -C Include files: -C -C -C Parameters: -C -C -C Arguments: -C - INTEGER DIR !DIRECTION TO CONVERT - INTEGER YEAR !CIVIL YEAR - INTEGER UTDAY !UNIVERSAL DAY OF YEAR - REAL*8 UT !UT - TIME IN FRACTIONS - INTEGER STDAY !SIDEREAL DAY FROM 1900 - REAL*8 ST !ST - TIME IN FRACTIONS -C -C Function references: -C -C -C Data declarations: -C - REAL*8 LMST !LOCAL MEAN SIDEREAL MOMENT - INTEGER LSD !LOCAL SIDEREAL DAY - REAL*8 JD !JULIAN DAY MOMENT -C -C- -C -C WNGU2S -C -C History : Original version UTOST.F (BK 31-03-93) -C 08-02-95 BK Correction of the relative STDAY of year -C Subtitle : "UT VERSUS ST" -C -C In : dir - direction: dir >= 0 : UT to ST -C dir < 0 : ST to UT -C In : year - civil year -C Update: utday - universal day of year -C Update: ut - UT - time in fractions -C Update: stday - Siderial day from 1900 -C Update: st - ST - time in fractions -C - IF (DIR. LT. 0) THEN ! convert st to ut - LSD = YEAR*366+(YEAR-1)/4+1725757+STDAY - CALL WNGSTL(-1, LMST, LSD, ST) - CALL WNGJVS(-1, JD, LMST) - CALL WNGJUL(-1, YEAR, UTDAY, UT, JD) - ELSE ! convert ut to st - CALL WNGJUL( 1, YEAR,UTDAY, UT, JD) ! convert to julian day - CALL WNGJVS( 1, JD, LMST) ! convert jd to lmst - CALL WNGSTL( 1, LMST, LSD, ST) ! convert lmst to lsd+lst - STDAY = LSD - (YEAR*366+(YEAR-1)/4+1725757) - ENDIF -C - RETURN - END -C -C -C WNGJVS -C - SUBROUTINE WNGJVS (DIR, JD, LMST) -C -C History : Original version JDVST.F -C Subtitle : "JD VERSUS LMST " -C -C Calculate Sidereal time from Universal time in 1950 system. -C Calculate Universal time from Sidereal time in 1950 system. -C -C Parameters are ; -C DIR - Direction in I4. -C Positive : UT to ST. -C Negative : ST to UT. -C JD - Julian day moment in R8. -C LMST - Local mean sidereal moment in R8. -C -C Used is the method described in SRZM note 143. -C -C S = 2421632.7952643056 + 1.002737909265*(J - 2415020) + -C 0.8063*10**-15*(J - 2415020)**2. -C -C J = 2415019.2069071108 + 0.997269566414*(S - 2421632) - -C 0.7994*10**-15*(S - 2421632)**2. -C -C NOTE : The coefficients of the J = formula have been improved -C in this routine, in order to get a better reversal of -C the S = formula !!!!!!!!! -C -C For the clarity these formulas are changed into ; -C -C LMST = 0.7769193890 + LWSRT + 1.002737909265*(JD - JD0) + -C 0.8063*10**-15*(JD - JD0)**2 + SD0. -C JD =-0.7747479726 - LWSRT + 0.997269566414*(LMST - SD0) - -C 0.7994*10**-15*(LMST - SD0)**2 + JD0. -C -C LMST - Local mean sidereal day and time for the WSRT. -C LWSRT - WSRT longitude (6.60417 Degr or 0.0183449166) -C JD0 - Offset from JD to 1900, 0 JAN 12.00 UT, equal to 2415020. -C SD0 - Offset from LMST to 1900 equal to 2421632. -C -C -C Arguments: -C - INTEGER DIR !DIRECTION TO CONVERT - REAL*8 JD !JULIAN DAY MOMENT - REAL*8 LMST !LOCAL MEAN SIDEREAL MOMENT -C -C Data declarations: -C - REAL*8 X,JD0,SD0 - REAL*8 AJ,BJ,CJ,AS,BS,CS,LWSRT -C - DATA LWSRT / 0.0183449166D0 / - DATA AJ / -0.77474797263057D0 / - DATA BJ / 0.99726956641441D0 / - DATA CJ / -0.7997133713334D-15/ - DATA AS / 0.7769193890D0 / - DATA BS / 1.002737909265D0 / - DATA CS / 0.8063D-15 / - DATA SD0 / 2421632D0 / - DATA JD0 / 2415020D0 / -C - IF (DIR.GE.0) THEN - X = JD - JD0 - LMST = (CS*X + BS)*X + AS + LWSRT - LMST = LMST + SD0 - ELSE - X = LMST - SD0 - JD = (CJ*X + BJ)*X + AJ - LWSRT - JD = JD + JD0 - ENDIF -C - RETURN - END -C -C -C WNGJUL -C - SUBROUTINE WNGJUL (DIR, YEAR, UTDAY, UT, JD) -C -C History : Original version JULDA.F -C Subtitle : "YEAR,DAY,TIME VS JULIAN DAY " -C -C Calculate the Julian day moment from the civil year YEAR, -C the day of the year DAY, and the universal time UT in -C fraction of the day. -C Calculate the civil year YEAR, the day of the year DAY, -C and the universal time UT in fraction of the day from the -C Julian day moment. -C The routine is correct after 1 januari 1901 (Because the year 1900 -C is not a leap year), and will be correct until the year 2400. -C Parameters are ; -C D - Direction in I4. -C Positive : YEAR,DAY,UT to JD. -C Negative : JD to YEAR,DAY,UT. -C YEAR - Civil year in I4. I.e. 1989. -C UTDAY - UT day of the year in I4. 1, 2, ....,365, OR 366. -C UT - UT time in day fraction in R8. 0 <= UT < 1. -C JD - Julian day moment in R8. -C -C Arguments: -C - INTEGER DIR !DIRECTION TO CONVERT - INTEGER YEAR !CIVIL YEAR - INTEGER UTDAY !UNIVERSAL DAY OF YEAR - REAL*8 UT !UT - TIME IN FRACTIONS - REAL*8 JD !JULIAN DAY MOMENT -C -C Data declarations: -C - INTEGER YY,LD - INTEGER ND,JD1900 - REAL*8 D0 -C - DATA JD1900 /2415020/ ! JULIAN DAY ON 1900 0 JAN 12.00 UT -C - IF (DIR.GE.0) THEN - YY = YEAR - 1900 ! NR OF YEARS SINCE 1900 - ND = YY * 365 ! NR OF DAYS SINCE 1900 - ND = ND + (YY-1)/4 ! NR OF LEAP DAYS TO ADD - ND = ND + UTDAY ! ADD DAY OF THE YEAR - ND = ND + JD1900 ! MAKE INTEGER JULIAN DAY - JD = DBLE(ND) + UT - 0.5D0 ! ADD TIME MINUS 0.5 - ELSE - D0 = JD + 0.5D0 ! ADD CORRECTION - ND = IDINT(D0) ! MAKE INTEGER DAYS - UT = D0 - DBLE(ND) ! MAKE UT TIME IN FRACTION - ND = ND - JD1900 ! NR OF DAYS SINCE 1900 - LD = ND / 1461 ! NR OF LEAP DAYS - YY = 1900 + LD*4 ! YEAR TO START LEAP YEAR - UTDAY = ND - LD * 1461 + 1 ! DAYS SINCE START LEAP YEAR - IF (UTDAY .EQ. 366) GOTO 900 ! LAST DAY OF THE LEAP YEAR - IF (UTDAY .GT. 366) THEN ! NOT A LEAP YEAR - YY = YY + 1 ! INCREMENT YEAR - UTDAY = UTDAY - 366 ! SUBTRACT DAYS IN LEAP YEAR - ENDIF - YEAR = YY + (UTDAY-1)/365 ! FIND CORRECT YEAR - UTDAY = MOD(UTDAY-1, 365) + 1 ! FIND DAY - ENDIF -C - 900 RETURN - END -C -C -C WNGSTL -C - SUBROUTINE WNGSTL (DIR, LMST, LSD, LST) -C -C History : Original version JULDA.F -C SUBTITLE : "LMST VERSUS LSD,LST " -C -C Calculate LSD nr and time in day fraction from LMST. -C Calculate LMST moment from day and fraction. -C -C Parameters are ; -C DIR - Direction in I4 -C Positive : LMST to LSD,LST. -C Negative : LSD,LST to LMST. -C LMST - Local mean sidereal time moment in R8. -C LSD - Local sidereal day nr in I4. -C LST - Local sidereal time in day fraction in R8. -C -C Arguments: -C - INTEGER DIR !DIRECTION TO CONVERT - REAL*8 LMST !LOCAL MEAN SIDEREAL MOMENT - INTEGER LSD !LOCAL SIDEREAL DAY - REAL*8 LST !LOCAL SIDEREAL TIME IN DAY FRACTIONS -C -C Data declarations: -C - IF (DIR.GE.0) THEN - LSD = IDINT(LMST) - LST = LMST - DBLE(LSD) - IF (LST.LT.0D0) LST = LST + 1D0 - ELSE - LMST = DBLE(LSD) + LST - ENDIF -C - RETURN - END diff --git a/src/wng/wnm.grp b/src/wng/wnm.grp deleted file mode 100644 index 1f3a20498b57e590aea117eec4093227b3a3f23a..0000000000000000000000000000000000000000 --- a/src/wng/wnm.grp +++ /dev/null @@ -1,138 +0,0 @@ -!+ WNM.GRP -! WNB 900312 -! -! Revisions: -! WNB 911026 Add WNMCCV double precision routines -! WNB 911105 Add .FDW -! WNB 911125 Add random -! WNB 920103 Add HIB, HM7 -! WNB 920128 Add SW -! WNB 920131 Add HB6, HS6 -! HjV 920525 Add HP -! HjV 920617 Add WNMRND.CHP -! WNB 921216 FUN: WNMFTC CUN: WNMRND -! WNB 930504 Remove WNMYGR, add XMC, XMU, XMK -! WNB 930818 Remove WNMFTC.MVX; change WNMFTC.FUN into .FOR -! WNB 950224 Add TWNM -! WNB 950330 Add LSQ.DSC, WNML*.FOR -! HjV 950510 Remove WNMLME.FOR and WNMLTR.FOR -! WNB 950615 Describe entry points LMF,LMT,LIF,LNR -! -! General mathematical routines -! -! Group definition: -! -WNM.GRP -! -! PIN files -! -! -! Structure files -! -! -! General command files -! -! -! Fortran definition files: -! -LSQ.DSC ! Least squares (WNML..) area -! -! Programs: -! -TWNM.FOR ! Test program -WNMAAP.FOR !WNMAAP Convert cos/sin to ampl/phase - !WNMARL Convert cos/sin to cos - !WNMAIM Convert cos/sin to sin - !WNMAAM Convert cos/sin to ampl - !WNMAPH Convert cos/sin to phase - !WNMACS Convert ampl/phase to cos/sin -WNMCCV.FOR ! Coordinate conversions - !WNMCLM l,m to ra,dec - !WNMCRD ra,dec to l,m - !WNMCRM ra,m to dec,l - !WNMCDL dec,l to ra,m - !WNMDLM l,m to ra,dec (D-type) - !WNMDRD ra,dec to l,m (D-type) - !WNMDRM ra,m to dec,l (D-type) - !WNMDDL dec,l to ra,m (D-type) -WNMEJC.FOR !WNMEJC J=CEIL(E) - !WNMEEC E=CEIL(E) - !WNMDJC J=CEIL(D) - !WNMDDC D=CEIL(D) - !WNMEJF J=FLOOR(E) - !WNMEEF E=FLOOR(E) - !WNMDJF J=FLOOR(D) - !WNMDDF D=FLOOR(D) -WNMFCS.FOR !WNMFCS Swap complex halves of FFT output - !WNMFRC Convert real buffer to complex - !WNMFCR Convert complex buffer to real - !WNMFSN Standard normalisation of real buffer - !WNMFIN Inverted normalisation of real buffer -WNMFMX.FOR !WNMFMX Normalise and find max/min in buffer -WNMFTC.FOR !WNMFTC Complex FFT -WNMHIB.FOR ! Beam histograms - !WNMHB0 Init. histogram - !WNMHB9 Finish histogram - !WNMHB1 Fill histogram - !WNMHB2 Print histogram - !WNMHB6 Return histo data and accumulate - !WNMHB7 Return histo data -WNMHIS.FOR ! Histograms - !WNMHS0 Init. histogram - !WNMHS8 Init. histogram - !WNMHS9 Finish histogram - !WNMHS1 Fill histogram - !WNMHS2 Print absolute histogram - !WNMHS3 Print logarithmic histogram - !WNMHS4 Calculate noise and offset - !WNMHS6 Return histo data and accumulate - !WNMHS7 Return histo data -WNMIGN.FOR !WNMIGN Get normal equations area - !WNMYGN ..for complex - !WNMIFN Free normal equations area - !WNMIZN Zero normal equations area - !WNMIZK Zero normal equations area known part - !WNMIZU Zero normal equations area unknown part - !WNMINZ Make non-zero diagonal - !WNMIGR Get constraint equations -WNMIMC.FOR !WNMIMC Make normal from condition equations - !WNMYMC ..for complex - !WNMXMC ..for separable complex - !WNMIMK Only known part - !WNMYMK ..for complex - !WNMXMK ..for separable complex - !WNMIMU Only unknown part - !WNMYMU ..for complex - !WNMXMU ..for separable complex -WNMISN.FOR !WNMISN Solve normal equations - !WNMYSN ..for complex -WNMITN.FOR !WNMITN Decompose normal equations -WNMITR.FOR !WNMITR Decompose and determine rank -WNMLGA.FOR !WNMLGA Get least squares area - !WNMLFA Free least squares area -WNMLGC.FOR !WNMLGC Get constraint equations -WNMLGR.FOR !WNMLGR Get array pointer to a normal array row - !WNMLGE Get array pointer to an element - !WNMLGK Get pointer to known column - !WNMLMF Move data from an area - !WNMLMT Move data to an area -WNMLIA.FOR !WNMLIA Initialise least squares area - !WNMLID Initialise normal diagonal if near zero - !WNMLIF Multiply diagonal with factor -WNMLIN.FOR !WNMLIN Invert normal matrix - !WNMLME Get errors in unknowns - !WNMLCV Get covariance matrix -WNMLMN.FOR !WNMLMN Make normal equations from conditions - !WNMLMC Make constraint equations -WNMLSN.FOR !WNMLSN Solve normal equations -WNMLTN.FOR !WNMLTN Cholesky decomposition normal array - !WNMLNT Non-linear Cholesky decomposition - !WNMLTR Determine rank and do Choleski (SVD) - !WNMLNR Non-linear SVD -WNMRND.MVX !WNMRIN Init. random generator - WNMRND.CUN !WNMRNJ Integer random value -! -! Executables -! -TWNM.EXE -!- diff --git a/src/wng/wnmaap.for b/src/wng/wnmaap.for deleted file mode 100644 index dd882d418edf7b96ed1cb60a168f4f484b309fd5..0000000000000000000000000000000000000000 --- a/src/wng/wnmaap.for +++ /dev/null @@ -1,115 +0,0 @@ -C+ WNMAAP.FOR -C WNB 910325 -C -C Revisions: -C - SUBROUTINE WNMAAP(N,INC,OUTC) -C -C Convert amplitude/phase to real/imaginary and vice versa -C -C Result: -C -C CALL WNMAAP (N_J, INC_X(0:*), OUTC_X(0:*)) Cos/sin to ampl/phase -C CALL WNMARL (N_J, INC_X(0:*), OUTR_E(0:*)) Cos/sin to cos -C CALL WNMAIM (N_J, INC_X(0:*), OUTR_E(0:*)) Cos/sin to sin -C CALL WNMAAM (N_J, INC_X(0:*), OUTR_E(0:*)) Cos/sin to ampl -C CALL WNMAPH (N_J, INC_X(0:*), OUTR_E(0:*)) Cos/sin to phase -C CALL WNMACS (N_J, INC_X(0:*), OUTC_X(0:*)) Ampl/phase to cos/sin -C -C Note: Phase in fractions -C -C -C Include files: -C - INCLUDE 'WNG_DEF' -C -C Parameters: -C -C -C Arguments: -C - INTEGER N !# OF POINTS - COMPLEX INC(0:*) !INPUT ARRAY - COMPLEX OUTC(0:*) !OUTPUT ARRAY - REAL OUTR(0:*) !OUTPUT ARRAY -C -C Function references: -C -C -C Data declarations: -C -C- -C -C COS/SIN TO AMPL/PHASE -C - DO I=0,N-1 - R0=ABS(INC(I)) !AMPL - IF (R0.EQ.0) THEN !OUTPUT - OUTC(I)=CMPLX(0.,0.) - ELSE - OUTC(I)=CMPLX(R0,ATAN2(AIMAG(INC(I)),REAL(INC(I)))/PI2) - END IF - END DO -C - RETURN -C -C COS/SIN TO COS -C - ENTRY WNMARL(N,INC,OUTR) -C - DO I=0,N-1 - OUTR(I)=REAL(INC(I)) - END DO -C - RETURN -C -C COS/SIN TO SIN -C - ENTRY WNMAIM(N,INC,OUTR) -C - DO I=0,N-1 - OUTR(I)=AIMAG(INC(I)) - END DO -C - RETURN -C -C COS/SIN TO AMPL -C - ENTRY WNMAAM(N,INC,OUTR) -C - DO I=0,N-1 - OUTR(I)=ABS(INC(I)) - END DO -C - RETURN -C -C COS/SIN TO PHASE -C - ENTRY WNMAPH(N,INC,OUTR) -C - DO I=0,N-1 - R0=AIMAG(INC(I)) - R1=REAL(INC(I)) - IF (R0.EQ.0 .AND. R1.EQ.0) THEN - OUTR(I)=0 - ELSE - OUTR(I)=ATAN2(R0,R1)/PI2 - END IF - END DO -C - RETURN -C -C AMPL/PHASE TO COS/SIN -C - ENTRY WNMACS(N,INC,OUTC) -C - DO I=0,N-1 - R0=REAL(INC(I)) - R1=AIMAG(INC(I))*PI2 - OUTC(I)=CMPLX(R0*COS(R1),R0*SIN(R1)) - END DO -C - RETURN -C -C - END diff --git a/src/wng/wnmccv.for b/src/wng/wnmccv.for deleted file mode 100644 index 8c54b1f86c4d2e629df1f11f68bd05343ee5de3b..0000000000000000000000000000000000000000 --- a/src/wng/wnmccv.for +++ /dev/null @@ -1,270 +0,0 @@ -C+ WNMCCV.FOR -C WNB 900827 -C -C Revisions: -C WNB 911014 Typo in LMRD, RMDL -C WNB 911025 Add double precision -C JPH 940930 Comments only -C WNB 970522 Return indication for non-existant DLRM -C - SUBROUTINE WNMCLM(RA0,DEC0,L,M,RA,DEC) -C -C Convert l, m into ra,dec -C -C Result: -C -C CALL WNMCLM ( RA0_D:I, DEC0_D:I, L_E:I, M_E:I, RA_D:O, DEC_D:O) -C WNMDLM LD_D MD_D -C L,M to RA,DEC -C -C CALL WNMCRD ( RA0_D:I, DEC0_D:I, L_E:O, M_E:O, RA_D:I, DEC_D:I) -C WNMDRD LD_D MD_D -C RA,DEC to L,M -C -C CALL WNMCRM ( RA0_D:I, DEC0_D:I, L_E:O, M_E:I, RA_D:I, DEC_D:O) -C WNMDRM LD_D MD_D -C RA,M to DEC,L -C -C CALL WNMCDL ( RA0_D:I, DEC0_D:I, L_E:I, M_E:O, RA_D:O, DEC_D:I) -C WNMDDL LD_D MD_D -C DEC,L to RA,M -C RA=M=-100. if -C not possible -C CALL WNMCD2 ( RA0_D:I, DEC0_D:I, L_E:I, M_E:O, RA_D:O, DEC_D:I) -C Get 2nd m belonging -C to CDL solution -C -C All RA, DEC in fractions of circles, -C l, m in radians -C -C -C Include files: -C - INCLUDE 'WNG_DEF' -C -C Parameters: -C -C -C Arguments: -C - REAL*8 RA0 !CENTRE RA - REAL*8 DEC0 !CENTRE DEC - REAL L !L - REAL*8 LD - REAL M !M - REAL*8 MD - REAL*8 RA !RA - REAL*8 DEC !DEC -C -C Function references: -C - REAL*8 WNGDPR !NORMALIZE ANGLE (RAD) -C -C Data declarations: -C - REAL*8 SIND0,COSD0 !SIN,COS(DEC0) - REAL*8 SINRA,COSRA !SIN,COS(RA-RA0) - REAL*8 SIND,COSD !SIN,COS(DEC) - REAL*8 DL,DM - -C -C Equivalences: -C -C -C Commons: -C -C- -C -C LMRD -C - SIND0=SIN(DEC0*DPI2) - COSD0=COS(DEC0*DPI2) - DL=L - DM=M - D0=DM*DM*SIND0*SIND0+DL*DL-2*DM*COSD0*SIND0 !CORRECTION - SIND=SQRT(ABS(SIND0*SIND0-D0)) - COSD=SQRT(ABS(COSD0*COSD0+D0)) - SIND=SIGN(SIND,SIND0) - DEC=ATAN2(SIND,COSD)/DPI2 - IF (L.NE.0) THEN - RA=WNGDPR(ATAN2(-DL,COSD0-DM*SIND0)+RA0*DPI2)/DPI2 - ELSE - RA=WNGDPR(ATAN2(1.D-10,COSD0-DM*SIND0)+RA0*DPI2)/DPI2 - END IF -C - RETURN -C -C RDLM -C - ENTRY WNMCRD(RA0,DEC0,L,M,RA,DEC) -C - L=-SIN((RA-RA0)*DPI2)*COS(DEC*DPI2) - SIND0=SIN(DEC0*DPI2) - IF (SIND0.NE.0) THEN - M=-(COS((RA-RA0)*DPI2)*COS(DEC*DPI2)-COS(DEC0*DPI2))/ - 1 SIN(DEC0*DPI2) - ELSE - M=0 - END IF -C - RETURN -C -C RMDL -C - ENTRY WNMCRM(RA0,DEC0,L,M,RA,DEC) -C - COSD0=COS(DEC0*DPI2) - SIND0=SIN(DEC0*DPI2) - COSRA=COS((RA-RA0)*DPI2) - SINRA=SIN((RA-RA0)*DPI2) - DM=M - IF (COSRA.NE.0) THEN - DL=(DM*SIND0-COSD0)*SINRA/COSRA - ELSE - DL=0 - END IF - D0=DM*DM*SIND0*SIND0+DL*DL-2*DM*COSD0*SIND0 !CORRECTION - SIND=SQRT(ABS(SIND0*SIND0-D0)) - COSD=SQRT(ABS(COSD0*COSD0+D0)) - SIND=SIGN(SIND,SIND0) - DEC=ATAN2(SIND,COSD)/DPI2 - L=DL -C - RETURN -C -C DLRM -C - ENTRY WNMCDL(RA0,DEC0,L,M,RA,DEC) -C - SIND0=SIN(DEC0*DPI2) - COSD0=COS(DEC0*DPI2) - COSD=COS(DEC*DPI2) - DL=L - IF (COSD.NE.0) THEN - SINRA=-DL/COSD - ELSE - SINRA=0 - END IF - IF (SINRA.GT.1.0) THEN - M=-100. - RA=-100. - ELSE - COSRA=SQRT(ABS(1D0-SINRA*SINRA)) - IF (SINRA.NE.0) THEN - RA=WNGDPR(ATAN2(SINRA,COSRA)+RA0*DPI2)/DPI2 - ELSE - RA=WNGDPR(ATAN2(1.D-10,COSRA)+RA0*DPI2)/DPI2 - END IF - IF (SIND0.NE.0) THEN - M=-(COSRA*COSD-COSD0)/SIND0 - ELSE - M=0 - END IF - END IF -C - RETURN -C -C LMRD2 -C - ENTRY WNMCD2(RA0,DEC0,L,M,RA,DEC) -C - SIND0=SIN(DEC0*DPI2) - COSD=COS(DEC*DPI2) - COSRA=COS((RA-RA0)*DPI2) - M=M+2*COSRA*COSD/SIND0 -C - RETURN -C -C LMRD -C - ENTRY WNMDLM(RA0,DEC0,LD,MD,RA,DEC) -C - SIND0=SIN(DEC0*DPI2) - COSD0=COS(DEC0*DPI2) - DL=LD - DM=MD - D0=DM*DM*SIND0*SIND0+DL*DL-2*DM*COSD0*SIND0 !CORRECTION - SIND=SQRT(ABS(SIND0*SIND0-D0)) - COSD=SQRT(ABS(COSD0*COSD0+D0)) - SIND=SIGN(SIND,SIND0) - DEC=ATAN2(SIND,COSD)/DPI2 - IF (LD.NE.0) THEN - RA=WNGDPR(ATAN2(-DL,COSD0-DM*SIND0)+RA0*DPI2)/DPI2 - ELSE - RA=WNGDPR(ATAN2(1.D-10,COSD0-DM*SIND0)+RA0*DPI2)/DPI2 - END IF -C - RETURN -C -C RDLM -C - ENTRY WNMDRD(RA0,DEC0,LD,MD,RA,DEC) -C - LD=-SIN((RA-RA0)*DPI2)*COS(DEC*DPI2) - SIND0=SIN(DEC0*DPI2) - IF (SIND0.NE.0) THEN - MD=-(COS((RA-RA0)*DPI2)*COS(DEC*DPI2)-COS(DEC0*DPI2))/ - 1 SIN(DEC0*DPI2) - ELSE - MD=0 - END IF -C - RETURN -C -C RMDL -C - ENTRY WNMDRM(RA0,DEC0,LD,MD,RA,DEC) -C - COSD0=COS(DEC0*DPI2) - SIND0=SIN(DEC0*DPI2) - COSRA=COS((RA-RA0)*DPI2) - SINRA=SIN((RA-RA0)*DPI2) - DM=MD - IF (COSRA.NE.0) THEN - DL=(DM*SIND0-COSD0)*SINRA/COSRA - ELSE - DL=0 - END IF - D0=DM*DM*SIND0*SIND0+DL*DL-2*DM*COSD0*SIND0 !CORRECTION - SIND=SQRT(ABS(SIND0*SIND0-D0)) - COSD=SQRT(ABS(COSD0*COSD0+D0)) - SIND=SIGN(SIND,SIND0) - DEC=ATAN2(SIND,COSD)/DPI2 - LD=DL -C - RETURN -C -C DLRM -C - ENTRY WNMDDL(RA0,DEC0,LD,MD,RA,DEC) -C - SIND0=SIN(DEC0*DPI2) - COSD0=COS(DEC0*DPI2) - COSD=COS(DEC*DPI2) - DL=LD - IF (COSD.NE.0) THEN - SINRA=-DL/COSD - ELSE - SINRA=0 - END IF - IF (SINRA.GT.1.0) THEN - M=-100. - RA=-100. - ELSE - COSRA=SQRT(ABS(1D0-SINRA*SINRA)) - IF (SINRA.NE.0) THEN - RA=WNGDPR(ATAN2(SINRA,COSRA)+RA0*DPI2)/DPI2 - ELSE - RA=WNGDPR(ATAN2(1.D-10,COSRA)+RA0*DPI2)/DPI2 - END IF - IF (SIND0.NE.0) THEN - MD=-(COSRA*COSD-COSD0)/SIND0 - ELSE - MD=0 - END IF - END IF -C - RETURN -C -C - END diff --git a/src/wng/wnmejc.for b/src/wng/wnmejc.for deleted file mode 100644 index e6d17f6fcf8160e7b5222ddd157bdad07381aa2e..0000000000000000000000000000000000000000 --- a/src/wng/wnmejc.for +++ /dev/null @@ -1,134 +0,0 @@ -C+ WNMEJC.FOR -C WNB 910305 -C -C Revisions: -C - INTEGER FUNCTION WNMEJC(EVAL) -C -C Get CEIL or FLOOR -C -C Result: -C -C WNMEJC_J = WNMEJC( EVAL_E:I) Get CEIL(EVAL) -C WNMEEC_E = WNMEEC( EVAL_E:I) Get CEIL(EVAL) -C WNMDJC_J = WNMDJC( DVAL_E:I) Get CEIL(DVAL) -C WNMDDC_D = WNMDDC( DVAL_E:I) Get CEIL(DVAL) -C -C WNMEJF_J = WNMEJF( EVAL_E:I) Get FLOOR(EVAL) -C WNMEEF_E = WNMEEF( EVAL_E:I) Get FLOOR(EVAL) -C WNMDJF_J = WNMDJF( DVAL_E:I) Get FLOOR(DVAL) -C WNMDDF_D = WNMDDF( DVAL_E:I) Get FLOOR(DVAL) -C -C Include files: -C - INCLUDE 'WNG_DEF' -C -C Parameters: -C -C -C Arguments: -C - REAL EVAL !INPUT VALUE - DOUBLE PRECISION DVAL -C -C Entry points: -C - INTEGER WNMDJC,WNMEJF,WNMDJF - REAL WNMEEC,WNMEEF - DOUBLE PRECISION WNMDDC,WNMDDF -C -C Function references: -C -C -C Data declarations: -C -C- -C -C WNMEJC -C - WNMEJC=INT(EVAL) - IF (MOD(EVAL,1E0).NE.0) THEN - IF (EVAL.GT.0) WNMEJC=WNMEJC+1 - END IF -C - RETURN -C -C WNMEEC -C - ENTRY WNMEEC(EVAL) -C - WNMEEC=AINT(EVAL) - IF (MOD(EVAL,1E0).NE.0) THEN - IF (EVAL.GT.0) WNMEEC=WNMEEC+1 - END IF -C - RETURN -C -C WNMDJC -C - ENTRY WNMDJC(DVAL) -C - WNMDJC=INT(DVAL) - IF (MOD(DVAL,1D0).NE.0) THEN - IF (DVAL.GT.0) WNMDJC=WNMDJC+1 - END IF -C - RETURN -C -C WNMDDC -C - ENTRY WNMDDC(DVAL) -C - WNMDDC=AINT(DVAL) - IF (MOD(DVAL,1D0).NE.0) THEN - IF (DVAL.GT.0) WNMDDC=WNMDDC+1 - END IF -C - RETURN -C -C WNMEJF -C - ENTRY WNMEJF(EVAL) -C - WNMEJF=INT(EVAL) - IF (MOD(EVAL,1E0).NE.0) THEN - IF (EVAL.LT.0) WNMEJF=WNMEJF-1 - END IF -C - RETURN -C -C WNMEEF -C - ENTRY WNMEEF(EVAL) -C - WNMEEF=AINT(EVAL) - IF (MOD(EVAL,1E0).NE.0) THEN - IF (EVAL.LT.0) WNMEEF=WNMEEF-1 - END IF -C - RETURN -C -C WNMDJF -C - ENTRY WNMDJF(DVAL) -C - WNMDJF=INT(DVAL) - IF (MOD(DVAL,1D0).NE.0) THEN - IF (DVAL.LT.0) WNMDJF=WNMDJF-1 - END IF -C - RETURN -C -C WNMDDF -C - ENTRY WNMDDF(DVAL) -C - WNMDDF=AINT(DVAL) - IF (MOD(DVAL,1D0).NE.0) THEN - IF (DVAL.LT.0) WNMDDF=WNMDDF-1 - END IF -C - RETURN -C -C - END diff --git a/src/wng/wnmfcs.for b/src/wng/wnmfcs.for deleted file mode 100644 index 0c044ff49ba7e9beeb76b40a1aae7b076ae14acd..0000000000000000000000000000000000000000 --- a/src/wng/wnmfcs.for +++ /dev/null @@ -1,105 +0,0 @@ -C+ WNMFCS.FOR -C WNB 910318 -C -C Revisions: -C - SUBROUTINE WNMFCS(N,A) -C -C FFT help routines -C -C Result: -C -C CALL WNMFCS( N_J:I, A_X(0:N-1):IO) -C Swaps the two halves of A. -C CALL WNMFRC( N_J:I, A_X(0:N-1):IO) -C Takes the input as REAL(0:N-1), and converts -C it into COMPLEX(0:N-1) -C CALL WNMFCR( N_J:I, A_X(0:N-1):IO) -C Takes the input as COMPLEX(0:N-1), and -C converts it into REAL(0:N-1) -C CALL WNMFSN( N_J:I, B_E(0:N-1):IO, TAB_E(0:N-1):I, VAL_E:I) -C Multiply B(0:N-1) with TAB(0:N-1)*VAL -C CALL WNMFIN( N_J:I, B_E(0:N-1):IO, TAB_E(0:N-1):I, VAL_E:I) -C Multiply B(0:N-1) with TAB(N-1:0)*VAL -C -C Include files: -C - INCLUDE 'WNG_DEF' -C -C Parameters: -C -C -C Arguments: -C - INTEGER N - COMPLEX A(0:*) - REAL B(0:*) - REAL TAB(0:*) - REAL VAL -C -C Function references: -C -C -C Data declarations: -C - COMPLEX C8 -C- -C -C WNMFCS -C - J=N/2 !N/2 - DO I=0,J-1 !SWAP - C8=A(I) - A(I)=A(J+I) - A(J+I)=C8 - END DO -C - RETURN -C -C WNMFRC -C - ENTRY WNMFRC(N,A) -C - DO I=N-2,0,-2 !CONVERT - J=I/2 - A(I+1)=CMPLX(AIMAG(A(J)),0.) - A(I)=CMPLX(REAL(A(J)),0.) - END DO -C - RETURN -C -C WNMFCR -C - ENTRY WNMFCR(N,A) -C - DO I=0,N-2,2 !CONVERT - J=I/2 - A(J)=CMPLX(REAL(A(I)),REAL(A(I+1))) - END DO -C - RETURN -C -C WNMFSN -C - ENTRY WNMFSN(N,B,TAB,VAL) -C - DO I=0,N-1 - B(I)=B(I)*TAB(I)*VAL - END DO -C - RETURN -C -C WNMFIN -C - ENTRY WNMFIN(N,B,TAB,VAL) -C - J=N - DO I=0,N-1 - J=J-1 - B(I)=B(I)*TAB(J)*VAL - END DO -C - RETURN -C -C - END diff --git a/src/wng/wnmfmx.for b/src/wng/wnmfmx.for deleted file mode 100644 index 885cc8531ad0f11fe2f9374668aeee02c3dc3105..0000000000000000000000000000000000000000 --- a/src/wng/wnmfmx.for +++ /dev/null @@ -1,60 +0,0 @@ -C+ WNMFMX.FOR -C WNB 910318 -C -C Revisions: -C - SUBROUTINE WNMFMX(N,B,FAC,MAXV,PMAX,MINV,PMIN) -C -C Normalize a buffer and return max/min -C -C Result: -C -C CALL WNMFMX( N_J:I, B_E(0:N-1):IO, FAC_D:I, MAXV_E:IO, PMAX_J:O, -C MINV_E:IO, PMIN_J:O) -C Multiply B(0:N-1) with FAC and find MAXV at -C PMAX and MINV at PMIN -C -C Include files: -C - INCLUDE 'WNG_DEF' -C -C Parameters: -C -C -C Arguments: -C - INTEGER N - REAL B(0:*) - DOUBLE PRECISION FAC - REAL MAXV - INTEGER PMAX - REAL MINV - INTEGER PMIN -C -C Function references: -C -C -C Data declarations: -C -C- - R0=FAC - DO I=0,N-1 !NORMALIZE - B(I)=R0*B(I) - END DO - I=0 !FIND MAX/MIN - DO WHILE (I.LT.N) - IF (B(I).GT.MAXV) THEN - PMAX=I - MAXV=B(PMAX) - END IF - IF (B(I).LT.MINV) THEN - PMIN=I - MINV=B(PMIN) - END IF - I=I+1 - END DO -C - RETURN -C -C - END diff --git a/src/wng/wnmftc.for b/src/wng/wnmftc.for deleted file mode 100644 index 875344e033aaf6676fb29bac6d67e50c92e6eb6f..0000000000000000000000000000000000000000 --- a/src/wng/wnmftc.for +++ /dev/null @@ -1,87 +0,0 @@ -C+ WNMFTC.FOR -C WNB 910318 -C -C Revisions: -C WNB 921216 Make FUN -C WNB 930818 Make FOR -C - SUBROUTINE WNMFTC(N,A,W) -C -C Do Complex FFT -C -C Result: -C -C CALL WNMFTC( N_J:I, A_X(0:N-1):IO, W_X(0:N/2-1):I) -C Calculates the fast Fourier transform of -C N (power of 2) complex points. A is the -C input/output array of points, starting at -C coordinate 0. W are the complex weights. -C -C Include files: -C - INCLUDE 'WNG_DEF' -C -C Parameters: -C -C -C Arguments: -C - INTEGER N - COMPLEX A(0:*) - COMPLEX W(0:*) -C -C Function references: -C -C -C Data declarations: -C - INTEGER P - COMPLEX C8,C10 -C- -C -C BIT REVERSAL -C - J0=0 !J - J4=N-2 !N-2 - J3=N/2 !N/2 - J2=0 - DO WHILE (J2.LE.J4) !I=0(1)N-2 - IF (J2.LT.J0) THEN !I>=J - C8=A(J0) !INTERCHANGE A(I),A(J) - A(J0)=A(J2) - A(J2)=C8 - END IF - J5=J3 !K - DO WHILE (J5.LE.J0) !K>J - J0=J0-J5 !J=J-K - J5=J5/2 !K=K/2 - END DO - J0=J0+J5 !J=J+K - J2=J2+1 - END DO -C -C INVERT -C - P=N/2 !P=N/2 - J0=1 !M=1 - J1=P-1 !N/2-1 - DO WHILE (P.NE.0) - DO J2=0,J1,J0 !K=0(M)N/2-1 - J3=2*J2 !KA=K - J4=J3+J0 !KM=KA+M - DO J5=0,J1,P !L=0(P)N/2-1 - C10=W(J5)*A(J4) !T=W(L)*A(KM) - A(J4)=A(J3)-C10 !A(KM)=A(K)-T - A(J3)=A(J3)+C10 !A(KA)=A(KA)+T - J3=J3+1 !KA=KA+1 - J4=J4+1 !KM=KM+1 - END DO - END DO - J0=2*J0 !M=2*M - P=P/2 !P=P/2 - END DO -C - RETURN -C -C - END diff --git a/src/wng/wnmhib.for b/src/wng/wnmhib.for deleted file mode 100644 index c6114b98ad7d0812c37171bddc18cf5ed458a9d0..0000000000000000000000000000000000000000 --- a/src/wng/wnmhib.for +++ /dev/null @@ -1,222 +0,0 @@ -C+ WNMHIB.FOR -C WNB 911230 -C -C Revisions: -C WNB 920103 Add HB7 -C WNB 920131 Add HB6 -C JPH 940224 Comments -C -C - SUBROUTINE WNMHB0(HISBAD,TP,OTP) -C -C Histogram handling for beams -C -C Result: -C -C CALL WNMHB0( HISBAD_J:O, TP_J:I, OTP_J:I) -C Get histogram buffer, and return the control -C area address in HISBAD for an area with length -C OTP. -C TP can be: -C +1: histogram for absolute values -C -1: histogram for values -C CALL WNMHB9( HISBAD_J:I) -C Release histogram buffer -C CALL WNMHB1( HISBAD_J:I, N_J:I, BUF_E(0:N-1), NL_J:I) -C Set BUF values in histogram for line NL -C CALL WNMHB2( HISBAD_J:I, N_J:I) -C Type/print histogram data on N -C CALL WNMHB6( HISBAD_J:I, N_J:O, PBUF_J:O) -C Return size of histo N, and a pointer to -C the accumulated histo buffer -C CALL WNMHB7( HISBAD_J:I, N_J:O, PBUF_J:O) -C Return size of histo N, and a pointer to -C the histo buffer -C -C HISBAD layout (NOTE that it is not the same as for WNMHIS): -C A_J(HISBAD+0) type (J, 1,-1) -C A_J(HISBAD+1) current length for histo -C A_J(HISBAD+2) -C A_J(HISBAD+3) index in A_J for histogram (J) -C -C -C Include files: -C - INCLUDE 'WNG_DEF' -C -C Parameters: -C - INTEGER MAXLIN !NUMBER OF PRINT LINES - PARAMETER (MAXLIN=35) !I.E. 10**7 * 5 -C -C Arguments: -C - INTEGER TP !HISTOGRAM TYPE (1) - INTEGER HISBAD !index of histogram header in A_J, A_E - INTEGER OTP !OUTPUT TYPE FOR PRINT, LENGTH AREA - INTEGER N !LENGTH INPUT BUFFER - INTEGER PBUF !HISTO BUFFER POINTER - INTEGER NL !LINE NUMBER INPUT BUFFER - REAL BUF(0:*) !INPUT BUFFER -C -C Function references: -C - LOGICAL WNGGVM !GET VIRTUAL MEMORY - INTEGER WNMEJF !FLOOR(X) -C -C Data declarations: -C - CHARACTER*130 TXT(0:MAXLIN) !PRINT LINES - INTEGER SCAL !DATA SCALE -C- -C -C HB0: Allocate and initialise histogram buffer -C - HISBAD=0 !ASSUME ERROR - IF (ABS(TP).EQ.1) THEN !CORRECT TYPE - IF (WNGGVM(LB_J*4,J)) THEN !AREA - J=(J-A_OB)/LB_J !AREA POINTER - A_J(J)=TP !TYPE - IF (WNGGVM(LB_E*(OTP+1),J1)) THEN !BUFFER - A_J(J+1)=OTP !MAX. LENGTH IN HISTO - A_J(J+3)=(J1-A_OB)/LB_E !BUFFER POINTER - CALL WNGMVZ(LB_E*(OTP+1),A_B(J1-A_OB)) !EMPTY BUF - HISBAD=J !return index to caller - END IF - END IF - END IF -C - RETURN -C -C RELEASE HISTOGRAM BUFFER (HB9) -C - ENTRY WNMHB9(HISBAD) -C - IF (HISBAD.NE.0) THEN - CALL WNGFVM(LB_E*(A_J(HISBAD+1)+1), - 1 A_J(HISBAD+3)*LB_J+A_OB) !free BUFFER - CALL WNGFVM(LB_J*4,HISBAD*LB_J+A_OB) ! and header - END IF - HISBAD=0 !clear header pointer -C - RETURN -C -C SET VALUES (HB1) -C - ENTRY WNMHB1(HISBAD,N,BUF,NL) -C - IF (HISBAD.NE.0) THEN !CAN DO - J0=A_J(HISBAD+3) !BUFFER POINTER - DO I1=0,N-1 !DO ALL POINTS - I2=MIN(ABS(I1-N/2),ABS(NL)) !DATA POINTER - IF (I2.LE.A_J(HISBAD+1)) - 1 A_E(J0+I2)=MAX(A_E(J0+I2),ABS(BUF(I1))) !SET DATA VALUE - END DO - END IF -C - RETURN -C -C PRINT HISTOGRAM (HB2) -C - ENTRY WNMHB2(HISBAD,N) -C -C INIT -C - IF (IAND(N,F_P).NE.0) CALL WNCTXT(F_P,'!^') !FORMFEED - CALL WNCTXT(N,'!2/!48CBeam histogram!2/') -C -C SCALE DATA -C - SCAL=1 !SCALE - IF (HISBAD.NE.0) THEN - I=A_J(HISBAD+1) !LENGTH LINE - DO WHILE(I.GT.LEN(TXT(0))-4) - SCAL=SCAL*2 - I=I/2 - END DO - ELSE - RETURN - END IF -C -C INIT TEXT -C - DO I=MAXLIN,0,-1 !INIT TEXT BUFFER - IF (I.EQ.0) THEN - DO I1=1,MIN(LEN(TXT(0)),A_J(HISBAD+1)/SCAL+4) - IF (MOD(I1-4,10).EQ.0) THEN - TXT(I)(I1:I1)='|' - ELSE - TXT(I)(I1:I1)='-' - END IF - END DO - ELSE - TXT(I)=' ' - END IF - IF (MOD(I,5).EQ.0) THEN - CALL WNCTXS(TXT(I)(1:3),'!2$UJ%',I) - END IF - TXT(I)(4:4)='|' - END DO -C -C SET DATA -C - J0=A_J(HISBAD+3) !BUFFER - R0=A_E(J0+A_J(HISBAD+1)) !HIGH DATA - DO I1=A_J(HISBAD+1),0,-1 !GET DATA - I2=I1/SCAL+4 !POS. IN LINE - IF (I2.LE.LEN(TXT(0))) THEN - I3=MIN(MAXLIN,NINT(A_E(J0+I1)*100.)) !LINE # - TXT(I3)(I2:I2)='+' - R0=MAX(R0,A_E(J0+I1)) !ACCUMULATE - I3=MIN(MAXLIN,NINT(R0*100.)) !LINE # - TXT(I3)(I2:I2)='*' - END IF - END DO -C -C PRINT LINES -C - DO I=MAXLIN,0,-1 !PRINT LINES - CALL WNCTXT(N,TXT(I)) - END DO -C -C BOTTOM LINES -C - TXT(0)=' ' !BOTTOM LINE - DO I=0,MIN(LEN(TXT(0))-4,A_J(HISBAD+1)/SCAL)/10 - CALL WNCTXS(TXT(0)(10*I+1:10*I+4),'!4$UJ',10*I*SCAL) - END DO - CALL WNCTXT(N,TXT(0)) -C -C ANNOTATION -C - CALL WNCTXT(N,' ') - IF (HISBAD.NE.0) THEN - CALL WNCTXT(N,'+=Individual!/\*=Accumulated (or both)') - END IF - CALL WNCTXT(N,'!1/') -C - RETURN -C -C HB6 -C - ENTRY WNMHB6(HISBAD,N,PBUF) -C - N=A_J(HISBAD+1) !LENGTH BUFFER - PBUF=A_J(HISBAD+3) !BUFFER - DO I=N-1,0,-1 !MAKE ACCUMULATED - A_E(PBUF+I)=MAX(A_E(PBUF+I),A_E(PBUF+I+1)) - END DO -C - RETURN -C -C HB7 -C - ENTRY WNMHB7(HISBAD,N,PBUF) -C - N=A_J(HISBAD+1) !LENGTH BUFFER - PBUF=A_J(HISBAD+3) !BUFFER -C - RETURN -C -C - END diff --git a/src/wng/wnmhis.for b/src/wng/wnmhis.for deleted file mode 100644 index 0e19c5572cf42ef8a9eb04b1ccbcdad50006c246..0000000000000000000000000000000000000000 --- a/src/wng/wnmhis.for +++ /dev/null @@ -1,568 +0,0 @@ -C+ WNMHIS.FOR -C WNB 910325 -C -C Revisions: -C WNB 911008 Clearing typo -C WNB 920103 Add HS7 -C WNB 920131 Typo in HS7 name, add HS6 -C WNB 920825 Typo in HS4 offset -C WNB 920825 ZN iso NZ call in HS4 -C JPH 940224 Comments -C - SUBROUTINE WNMHS0(HISBAD,TP) -C -C Histogram handling -C -C Result: -C -C CALL WNMHS0( HISBAD_J:O, TP_J:I) -C Get histogram buffer, and return the control -C area address in HISBAD. -C Current max. set to 1/65536. -C TP can be: -C +1: histogram for absolute values -C -1: histogram for values -C CALL WNMHS8( HISBAD_J:I, TP_J:I, HMAX_E:I) -C As HS0, but set the current maximum value to -C the maximum of 1/65536. and HMAX. -C CALL WNMHS9( HISBAD_J:I) -C Release histogram buffer -C CALL WNMHS1( HISBAD_J:I, N_J:I, BUF_E(0:N-1)) -C Set BUF values in histogram. -C CALL WNMHS2( HISBF_J(0:*):I, N_J:I, OTP_J:I) -C Type/print histogram data for N histograms -C on OTP -C CALL WNMHS3( HISBF_J(0:*):I, N_J:I, OTP_J:I) -C Type/print histogram data for N histograms -C on OTP in logarithmic form, including -C accumulation -C CALL WNMHS4( HISBAD_J:I, NOIS_E(0:*):O, OTP_J:I) -C Determine, output and return noise in NOIS(0) -C for type 1, and noise and offset in (0) and (1) -C for type -1. -C CALL WNMHS6( HISBAD_J:I, N_J:O, OTP_J:O, MPMXP_E:O, MPMAX_E:O) -C Make accumulated, return histo size N, buffer -C pointer OTP, maximum present MPMXP and -C max. value to fit MPMAX. -C CALL WNMHS7( HISBAD_J:I, N_J:O, OTP_J:O, MPMXP_E:O, MPMAX_E:O) -C Return histo size N, buffer -C pointer OTP, maximum present MPMXP and -C max. value to fit MPMAX. -C -C HISBAD layout: -C A_J(HISBAD+0) type (J, 1,-1) -C A_E(HISBAD+1) current max. for histo (E, >0) -C A_E(HISBAD+2) current largest value for histo (E, >=0) -C A_J(HISBAD+3) index in A_J for histogram (J) -C -C -C Include files: -C - INCLUDE 'WNG_DEF' -C -C Parameters: -C - INTEGER MHSIZ,MHSZ2 !# OF ENTRIES IN HISTO'S - PARAMETER (MHSIZ=1000) !MUST BE POWER OF 10, AND >=100 - PARAMETER (MHSZ2=MHSIZ/2) - INTEGER SCAL !SCALE FOR LINE PRINT - PARAMETER (SCAL=MHSIZ/100) - INTEGER MAXLIN !NUMBER OF PRINT LINES - PARAMETER (MAXLIN=35) !I.E. 10**7 * 5 - INTEGER NMAX !NUMBER OF SIMULTANEOUS - PARAMETER (NMAX=8) -C -C Arguments: -C - INTEGER TP !HISTOGRAM TYPE (1,-1) - INTEGER HISBAD !index of histogram header in A_J, A_E - INTEGER HISBF(0:*) !AREAS - REAL HMAX !MAXIMUM VALUE TO INIT. - INTEGER OTP !OUTPUT TYPE FOR PRINT - INTEGER N !LENGTH INPUT BUFFER - REAL BUF(0:*) !INPUT BUFFER - REAL NOIS(0:*) !CALCULATED NOISE - REAL MPMXP !MAX. PRESENT - REAL MPMAX !MAX. VALUE TO FIT -C -C Function references: -C - LOGICAL WNGGVM !GET VIRTUAL MEMORY - INTEGER WNMEJF !FLOOR(X) - LOGICAL WNMITN !SOLVE EQUATIONS -C -C Data declarations: -C - CHARACTER*120 TXT(0:MAXLIN) !PRINT LINES - REAL NSCAL(0:NMAX-1) !DATA SCALES - CHARACTER*(NMAX) NTXT !CODES - DATA NTXT/'+*ox#@%&'/ - INTEGER MAR !LSQ AREA - REAL CD(2) !LSQ FACTORS - REAL SOL(2),ME(2),MU !LSQ SOLUTION - REAL R2,R3 -C- -C -C INIT AREA (HS0) -C - R0=1./65536. !MAX. VALUE - GOTO 10 -C -C INIT AREA (HS8) -C - ENTRY WNMHS8(HISBAD,TP,HMAX) -C - R0=MAX(ABS(HMAX),1./65536.) - GOTO 10 -C -C GET BUFFERS AND AREA -C - 10 CONTINUE - HISBAD=0 !ASSUME ERROR - IF (ABS(TP).EQ.1) THEN !CORRECT TYPE - IF (WNGGVM(LB_J*4,J)) THEN !AREA - J=(J-A_OB)/LB_J !AREA POINTER - A_J(J)=TP !TYPE - IF (WNGGVM(LB_J*(MHSIZ+1),J1)) THEN !BUFFER - A_E(J+1)=R0 !MAX. IN HISTO - A_E(J+2)=0E0 !MAX. VALUE SEEN - A_J(J+3)=(J1-A_OB)/LB_J !BUFFER POINTER - CALL WNGMVZ(LB_J*(MHSIZ+1),A_B(J1-A_OB)) !EMPTY BUF - HISBAD=J !SAVE AREA - END IF - END IF - END IF -C - RETURN -C -C RELEASE HISTOGRAM BUFFER (HS9) -C - ENTRY WNMHS9(HISBAD) -C - IF (HISBAD.NE.0) THEN - CALL WNGFVM(LB_J*(MHSIZ+1),A_J(HISBAD+3)*LB_J+A_OB) !BUFFER - CALL WNGFVM(LB_J*4,HISBAD*LB_J+A_OB) !FREE AREA - END IF - HISBAD=0 !RESET AREA -C - RETURN -C -C SET VALUES (HS1) -C - ENTRY WNMHS1(HISBAD,N,BUF) -C - IF (HISBAD.NE.0) THEN !CAN DO - IF (A_J(HISBAD).EQ.1) THEN !ABSOLUTE - J0=A_J(HISBAD+3) !BUFFER POINTER - DO I1=0,N-1 !DO ALL POINTS - R0=ABS(BUF(I1)) !DATA POINT - DO WHILE (R0.GT.A_E(HISBAD+1)) !SCALE HISTOGRAM IF NECESSARY - A_E(HISBAD+1)=2*A_E(HISBAD+1) !DOUBLE CONTENTS - DO I2=0,MHSIZ/2-1 - I3=2*I2 - A_J(J0+I2)=A_J(J0+I3)+A_J(J0+I3+1) !ADD - END DO - A_J(J0+MHSIZ/2)=A_J(J0+MHSIZ) - CALL WNGMVZ(LB_J*MHSIZ/2,A_J(J0+MHSIZ/2+1)) !EMPTY LAST PART - END DO - A_E(HISBAD+2)=MAX(R0,A_E(HISBAD+2)) !SET MAXIMUM PRESENT - I2=INT((R0/A_E(HISBAD+1))*MHSIZ) !HISTOGRAM POINTER - A_J(J0+I2)=A_J(J0+I2)+1 !SET HISTOGRAM COUNT - END DO - ELSE IF (A_J(HISBAD).EQ.-1) THEN !VALUE TYPE - J0=A_J(HISBAD+3)+MHSZ2 !BUFFER POINTER - DO I1=0,N-1 !DO ALL POINTS - R0=ABS(BUF(I1)) !DATA POINT - DO WHILE (R0.GT.A_E(HISBAD+1)) !SCALE HISTOGRAM IF NECESSARY - A_E(HISBAD+1)=2*A_E(HISBAD+1) !DOUBLE CONTENTS - DO I2=0,MHSZ2/2-1 !COMBINE - I3=2*I2 - A_J(J0+I2)=A_J(J0+I3)+A_J(J0+I3+1) !ADD - END DO - A_J(J0+MHSZ2/2)=A_J(J0+MHSZ2) - CALL WNGMVZ(LB_J*MHSZ2/2,A_J(J0+MHSZ2/2+1)) !EMPTY LAST PART - DO I2=-1,-(MHSZ2/2)+1,-1 - I3=2*I2 - A_J(J0+I2)=A_J(J0+I3)+A_J(J0+I3+1) !ADD - END DO - A_J(J0-MHSZ2/2)=A_J(J0-MHSZ2) - CALL WNGMVZ(LB_J*MHSZ2/2,A_J(J0-MHSZ2)) !EMPTY LAST PART - END DO - A_E(HISBAD+2)=MAX(R0,A_E(HISBAD+2)) !SET MAXIMUM PRESENT - I2=WNMEJF((BUF(I1)/A_E(HISBAD+1))*MHSZ2) !HISTOGRAM POINTER - A_J(J0+I2)=A_J(J0+I2)+1 !SET HISTOGRAM COUNT - END DO - END IF - END IF -C - RETURN -C -C PRINT HISTOGRAM (HS2) -C - ENTRY WNMHS2(HISBF,N,OTP) -C -C INIT -C - IF (IAND(OTP,F_P).NE.0) CALL WNCTXT(F_P,'!^') !FORMFEED - CALL WNCTXT(OTP,'!2/!48CHistogram!2/') -C -C SCALE DATA -C - DO I=0,MIN(NMAX,N)-1 !ALL AREAS - NSCAL(I)=1 !SCALE PER AREA - IF (HISBF(I).NE.0) THEN - J0=A_J(HISBF(I)+3) !BUFFER - DO I1=MHSIZ,0,-SCAL !GET DATA - J1=0 !COUNT - DO I3=0,MIN(SCAL-1,MHSIZ-I1) !ADD GROUP - J1=J1+A_J(J0+I1+I3) - END DO - NSCAL(I)=MAX(NSCAL(I),FLOAT(J1)) !GET MAX. - END DO - NSCAL(I)=NSCAL(I)/MAXLIN !STEP IN N - I1=0 !FACTORS OF 10 - DO WHILE (NSCAL(I).GE.10.) - I1=I1+1 - NSCAL(I)=NSCAL(I)/10. - END DO - IF (NSCAL(I).LE.1.) THEN !PROPER SCALE - NSCAL(I)=1. - ELSE IF (NSCAL(I).LE.2.) THEN - NSCAL(I)=2. - ELSE IF (NSCAL(I).LE.5.) THEN - NSCAL(I)=5. - ELSE - NSCAL(I)=10. - END IF - NSCAL(I)=NSCAL(I)*(10.**I1) - END IF - END DO -C -C INIT TEXT -C - DO I=MAXLIN,0,-1 !INIT TEXT BUFFER - IF (I.EQ.0) THEN - DO I1=1,MIN(LEN(TXT(0)),MHSIZ/SCAL+6) - IF (MOD(I1-6,10).EQ.0) THEN - TXT(I)(I1:I1)='|' - ELSE - TXT(I)(I1:I1)='-' - END IF - END DO - ELSE - TXT(I)=' ' - END IF - IF (MOD(I,5).EQ.0) THEN - CALL WNCTXS(TXT(I)(1:5),'!5$UJ',I) - END IF - TXT(I)(6:6)='|' - END DO -C -C SET DATA -C - DO I=0,MIN(NMAX,N)-1 !ALL AREAS - IF (HISBF(I).NE.0) THEN - J0=A_J(HISBF(I)+3) !BUFFER - DO I1=MHSIZ,0,-SCAL !GET DATA - J1=0 !COUNT - DO I3=0,MIN(SCAL-1,MHSIZ-I1) !ADD GROUP - J1=J1+A_J(J0+I1+I3) - END DO - IF (J1.GT.0) THEN - I3=MIN(MAXLIN,NINT(J1/NSCAL(I))) !LINE # - I2=I1/SCAL+6 !POS IN LINE - IF (I2.LE.LEN(TXT(0))) TXT(I3)(I2:I2)=NTXT(I+1:I+1) - END IF - END DO - END IF - END DO -C -C PRINT LINES -C - DO I=MAXLIN,0,-1 !PRINT LINES - CALL WNCTXT(OTP,TXT(I)) - END DO -C -C BOTTOM LINES -C - TXT(0)=' 0%' !BOTTOM LINE - DO I=1,MIN(LEN(TXT(0))-4,MHSIZ/SCAL)/10 - CALL WNCTXS(TXT(0)(10*I+3:10*I+7),'!4$UJ\%',10*I) - END DO - CALL WNCTXT(OTP,TXT(0)) -C -C ANNOTATION -C - CALL WNCTXT(OTP,' ') - DO I=0,MIN(NMAX,N)-1 !ALL AREAS - IF (HISBF(I).NE.0) THEN - IF (A_J(HISBF(I)).EQ.1) THEN - CALL WNCTXT(OTP,'!AS\!10C\100%= !10$E13.3 W.U.'// - 1 '!40CMax. value= !10$E13.3 W.U.'// - 1 '!75CN scale= !6$UJ', - 1 NTXT(I+1:I+1),A_E(HISBF(I)+1), - 1 A_E(HISBF(I)+2),NINT(NSCAL(I))) - ELSE - CALL WNCTXT(OTP,'!AS\=Individual!76C\100%= !E13.3 W.U.'// - 1 '!/!70CMax. value= !E13.3 W.U.', - 1 NTXT(2*I+1:2*I+1),A_E(HISBF(I)+1), - 1 A_E(HISBF(I)+2)) - END IF - END IF - END DO - CALL WNCTXT(OTP,'!1/') -C - RETURN -C -C PRINT HISTOGRAM LOGARITHMIC (HS3) -C - ENTRY WNMHS3(HISBF,N,OTP) -C -C INIT -C - IF (IAND(OTP,F_P).NE.0) CALL WNCTXT(F_P,'!^') !FORMFEED - CALL WNCTXT(OTP,'!2/!48CHistogram!2/') -C - DO I=MAXLIN,0,-1 !INIT TEXT BUFFER - IF (I.EQ.0) THEN - DO I1=1,MIN(LEN(TXT(0)),MHSIZ/SCAL+4) - IF (MOD(I1-4,10).EQ.0) THEN - TXT(I)(I1:I1)='|' - ELSE - TXT(I)(I1:I1)='-' - END IF - END DO - ELSE - TXT(I)=' ' - END IF - IF (MOD(I,5).EQ.0) THEN - CALL WNCTXS(TXT(I)(1:3),'1E!UJ',I/5) - END IF - TXT(I)(4:4)='|' - END DO -C -C SET DATA -C - DO I=0,MIN(NMAX/2,N)-1 !ALL AREAS - IF (HISBF(I).NE.0) THEN - J0=A_J(HISBF(I)+3) !BUFFER - J2=0 !TOTAL COUNT - DO I1=MHSIZ,0,-SCAL !GET DATA - J1=0 !COUNT - DO I3=0,MIN(SCAL-1,MHSIZ-I1) !ADD GROUP - J1=J1+A_J(J0+I1+I3) - END DO - J2=J2+J1 !TOTAL COUNT - IF (J1.GT.0) THEN - I3=MIN(MAXLIN,NINT(LOG10(FLOAT(J1))*5)) !LINE # - I2=I1/SCAL+4 !POS IN LINE - IF (I2.LE.LEN(TXT(0))) TXT(I3)(I2:I2)=NTXT(2*I+1:2*I+1) - END IF - IF (J2.GT.0 .AND. A_J(HISBF(I)).EQ.1) THEN - I3=MIN(MAXLIN,NINT(LOG10(FLOAT(J2))*5)) !LINE # - I2=(MHSIZ-I1)/SCAL+4 !POS IN LINE - IF (I2.LE.LEN(TXT(0))) TXT(I3)(I2:I2)=NTXT(2*I+2:2*I+2) - END IF - END DO - END IF - END DO -C -C PRINT LINES -C - DO I=MAXLIN,0,-1 !PRINT LINES - CALL WNCTXT(OTP,TXT(I)) - END DO -C -C BOTTOM LINES -C - TXT(0)='+ =0%' !BOTTOM LINE - DO I=1,MIN(LEN(TXT(0))-4,MHSIZ/SCAL)/10 - CALL WNCTXS(TXT(0)(10*I+1:10*I+5),'!4$UJ\%',10*I) - END DO - CALL WNCTXT(OTP,TXT(0)) - TXT(0)='*100%' !BOTTOM LINE - DO I=1,MIN(LEN(TXT(0))-4,MHSIZ/SCAL)/10 - CALL WNCTXS(TXT(0)(10*I+1:10*I+5),'!4$UJ\%',10*(10-I)) - END DO - CALL WNCTXT(OTP,TXT(0)) -C -C ANNOTATION -C - CALL WNCTXT(OTP,' ') - DO I=0,MIN(NMAX/2,N)-1 !ALL AREAS - IF (HISBF(I).NE.0) THEN - IF (A_J(HISBF(I)).EQ.1) THEN - CALL WNCTXT(OTP,'!AS\=Individual!76C\100%= !E13.3 W.U.'// - 1 '!/!AS\=Accumulated!70CMax. value= !E13.3 W.U.', - 1 NTXT(2*I+1:2*I+1),A_E(HISBF(I)+1), - 1 NTXT(2*I+2:2*I+2),A_E(HISBF(I)+2)) - ELSE - CALL WNCTXT(OTP,'!AS\=Individual!76C\100%= !E13.3 W.U.'// - 1 '!/!70CMax. value= !E13.3 W.U.', - 1 NTXT(2*I+1:2*I+1),A_E(HISBF(I)+1), - 1 A_E(HISBF(I)+2)) - END IF - END IF - END DO - CALL WNCTXT(OTP,'!1/') -C - RETURN -C -C CALCULATE NOISE -C - ENTRY WNMHS4(HISBAD,NOIS,OTP) -C -C INIT -C - IF (HISBAD.EQ.0) RETURN !CANNOT DO -C -C NOISE ONLY -C - IF (A_J(HISBAD).EQ.1) THEN - J0=A_J(HISBAD+3) !BUFFER POINTER - NOIS(0)=0 !SET NO SOLUTION - CALL WNMIGN(MAR,2,1) !GET LSQ AREA - CD(1)=1E0 !LSQ CONSTANT - DO I=0,NINT((A_E(HISBAD+2)/A_E(HISBAD+1))*(MHSIZ/8)) !USE 12% OF DATA - IF (A_J(J0+I).GT.0) THEN !CAN DO - IF (I.EQ.0) THEN !COORDINATE - R0=0. - ELSE - R0=I+.5 - END IF - CD(2)=-(R0**2) !LSQ CONSTANT - R1=MHSIZ/8.-I !WEIGHT - CALL WNMIMC(MAR,CD,R1,LOG(FLOAT(A_J(J0+I)))) !MAKE EQUATIONS - END IF - END DO - IF (.NOT.WNMITN(MAR)) GOTO 20 !CANNOT SOLVE - CALL WNMISN(MAR,SOL,MU,ME) - IF (SOL(2).LE.0) GOTO 20 !WRONG SOLUTION -C - CALL WNMIZN(MAR) !RE-ZERO AREA - CD(1)=1E0 !LSQ CONSTANT - DO I=0,MIN(NINT((A_E(HISBAD+2)/A_E(HISBAD+1))*(MHSIZ/8)), - 1 INT(SQRT(1./SOL(2)))) - IF (A_J(J0+I).GT.0) THEN !CAN DO - IF (I.EQ.0) THEN !COORDINATE - R0=0. - ELSE - R0=I+.5 - END IF - CD(2)=-(R0**2) !LSQ CONSTANT - R1=MHSIZ/8.-I !WEIGHT - CALL WNMIMC(MAR,CD,R1,LOG(FLOAT(A_J(J0+I)))) !MAKE EQUATIONS - END IF - END DO - IF (.NOT.WNMITN(MAR)) GOTO 20 !CANNOT SOLVE - CALL WNMISN(MAR,SOL,MU,ME) - IF (SOL(2).LE.0) GOTO 20 !WRONG SOLUTION - NOIS(0)=SQRT(0.5/SOL(2))*A_E(HISBAD+1)/MHSIZ !NOISE - CALL WNCTXT(OTP,'!/Noise= !E13.4 W.U.!/',NOIS(0)) -C -C NOISE AND OFFSET -C - ELSE - J0=A_J(HISBAD+3)+MHSZ2 !BUFFER POINTER - NOIS(0)=0 !SET NO SOLUTION - NOIS(1)=0 - CALL WNMIGN(MAR,2,1) !GET LSQ AREA - CD(1)=1E0 !LSQ CONSTANT - DO I=-NINT((A_E(HISBAD+2)/A_E(HISBAD+1))*(MHSZ2/8)), - 1 NINT((A_E(HISBAD+2)/A_E(HISBAD+1))*(MHSZ2/8)) !USE 12% - IF (A_J(J0+I).GT.0) THEN !CAN DO - R0=I+.5 - CD(2)=-(R0**2) !LSQ CONSTANT - R1=MHSZ2/8.-ABS(I) !WEIGHT - CALL WNMIMC(MAR,CD,R1,LOG(FLOAT(A_J(J0+I)))) !MAKE EQUATIONS - END IF - END DO - IF (.NOT.WNMITN(MAR)) GOTO 20 !CANNOT SOLVE - CALL WNMISN(MAR,SOL,MU,ME) - IF (SOL(2).LE.0) GOTO 20 !WRONG SOLUTION -C - R2=0 !START OFFSET - R3=SOL(2) !SOLUTION LIMIT - DO I2=1,4 !ITERATE - CALL WNMIZN(MAR) !RE-ZERO AREA - CD(1)=1E0 !LSQ CONSTANT - DO I=-MIN(NINT((A_E(HISBAD+2)/A_E(HISBAD+1))*(MHSZ2/8)), - 1 INT(SQRT(1./R3))), - 1 MIN(NINT((A_E(HISBAD+2)/A_E(HISBAD+1))*(MHSZ2/8)), - 1 INT(SQRT(1./R3))) - IF (A_J(J0+I).GT.0) THEN !CAN DO - R0=I+.5 - CD(2)=-((R0-R2)**2) !LSQ CONSTANT - R1=MHSZ2/8.-ABS(I) !WEIGHT - CALL WNMIMC(MAR,CD,R1,LOG(FLOAT(A_J(J0+I)))) !MAKE EQUATIONS - END IF - END DO - IF (.NOT.WNMITN(MAR)) GOTO 20 !CANNOT SOLVE - CALL WNMISN(MAR,SOL,MU,ME) - IF (SOL(2).LE.0) GOTO 20 !WRONG SOLUTION - NOIS(0)=SQRT(0.5/SOL(2))*A_E(HISBAD+1)/MHSZ2 !NOISE -C - CALL WNMIZN(MAR) !RE-ZERO AREA - CD(2)=0E0 !LSQ CONSTANT - DO I=-MIN(NINT((A_E(HISBAD+2)/A_E(HISBAD+1))*(MHSZ2/8)), - 1 INT(SQRT(1./R3))), - 1 MIN(NINT((A_E(HISBAD+2)/A_E(HISBAD+1))*(MHSZ2/8)), - 1 INT(SQRT(1./R3))) - IF (A_J(J0+I).GT.0) THEN !CAN DO - R0=I+.5 - CD(1)=2*SOL(2)*(R0-R2) - R1=MHSZ2/8.-ABS(I) !WEIGHT - CALL WNMIMC(MAR,CD,R1,LOG(FLOAT(A_J(J0+I)))- - 1 SOL(1)+SOL(2)*((R0-R2)**2)) !MAKE EQUATIONS - END IF - END DO - CALL WNMINZ(MAR) !NON-ZERO DIAGONAL - IF (.NOT.WNMITN(MAR)) GOTO 20 !CANNOT SOLVE - CALL WNMISN(MAR,SOL,MU,ME) - R2=R2+SOL(1) !NEXT ITERATION - NOIS(1)=R2*A_E(HISBAD+1)/MHSZ2 !OFFSET - ME(2)=ME(1)*A_E(HISBAD+1)/MHSZ2 !M.E. - END DO !NEXT ITERATION - CALL WNCTXT(OTP,'!/Noise= !E13.4 W.U.'// - 1 ', Offset= !E13.4 (!E13.4) W.U.!/', - 1 NOIS(0),NOIS(1),ME(2)) - END IF -C - GOTO 21 -C -C ERROR -C - 20 CONTINUE - CALL WNCTXT(OTP,'Cannot solve for noise') - 21 CONTINUE - CALL WNMIFN(MAR) !FREE AREA -C - RETURN -C -C HS6 -C - ENTRY WNMHS6(HISBAD,N,OTP,MPMXP,MPMAX) -C - N=MHSIZ !RETURN SIZE - OTP=A_J(HISBAD+3) !BUFFER POINTER - MPMXP=A_E(HISBAD+2) !MAX. PRESENT - MPMAX=A_E(HISBAD+1) !VALUE FULL SIZE - DO I=N-1,0,-1 !MAKE ACCUMULATED - A_J(OTP+I)=A_J(OTP+I)+A_J(OTP+I+1) - END DO -C - RETURN -C -C HS7 -C - ENTRY WNMHS7(HISBAD,N,OTP,MPMXP,MPMAX) -C - N=MHSIZ !RETURN SIZE - OTP=A_J(HISBAD+3) !BUFFER POINTER - MPMXP=A_E(HISBAD+2) !MAX. PRESENT - MPMAX=A_E(HISBAD+1) !VALUE FULL SIZE -C - RETURN -C -C - END diff --git a/src/wng/wnmign.for b/src/wng/wnmign.for deleted file mode 100644 index c07a8eec6b03caebe961e4babce1b533a9e78174..0000000000000000000000000000000000000000 --- a/src/wng/wnmign.for +++ /dev/null @@ -1,246 +0,0 @@ -C+ WNMIGN.FOR -C WNB 900312 -C -C Revisions: -C WNB 930503 Change N complex into 2N real -C Remove WNMYGR -C WNB 930506 Higher precision solution -C - LOGICAL FUNCTION WNMIGN(MAR,N,M) -C -C Get/free/zero normal equations area -C -C Result: -C -C WNMIGN_L = WNMIGN( MAR_J:O, N_J:I, M_J:I) -C Get an area for normal equations with N -C unknowns, and M knowns. Return a pointer in -C MAR, and zero the equations. -C WNMYGN_L = WNMYGN( MAR_J:O, N_J:I, M_J:I) -C As WNMIGN but for complex solutions. -C WNMIFN_L = WNMIFN( MAR_J:IO) -C Free the equations area -C WNMIZN_L = WNMIZN( MAR_J:I) -C Zero equations area -C WNMIZK_L = WNMIZK( MAR_J:I) -C Zero equations area known part -C WNMIZU_L = WNMIZU( MAR_J:I) -C Zero equations area unknown part -C WNMINZ_L = WNMINZ( MAR_J:I) -C Make non-zero diagonal -C WNMIGR_L = WNMIGR( MAR_J:I, NR_J:O, CEQ_E(0:N-1,0:NR-1,0:M-1):O) -C Get the constraint equations CEQ and the -C rank deficiency NR -C -C MAR layout: -C MAR is index to A_J to address area. At offsets: -C 0: =0 for real, =1 for complex (then N = 2N) -C 1: N -C 2: M -C 3: Rank -C 4: Index to A_J for pivot table (N) -C 5: Index to A_D for normal equations (N*(N+1)/2) -C 6: Index to A_D for known part (N*M) -C 7: Index to A_D for error part (3*M) -C 8: Index to A_D for high precision solution -C 9: Total length in bytes -C -C -C Include files: -C - INCLUDE 'WNG_DEF' -C -C Parameters: -C - INTEGER LNHD !# OF ELEMENTS IN HEADER - PARAMETER( LNHD=10) -C -C Arguments: -C - INTEGER MAR !AREA POINTER - INTEGER N !# OF UNKNOWNS - INTEGER M !# OF KNOWNS - INTEGER NR !RETURNED RANK - REAL CEQ(0:*) !CONSTRAINT EQUATIONS -C -C Entry points: -C - LOGICAL WNMYGN - LOGICAL WNMIFN - LOGICAL WNMIZN,WNMIZK,WNMIZU - LOGICAL WNMINZ - LOGICAL WNMIGR -C -C Function references: -C - LOGICAL WNGGVA !GET VIRTUAL MEMORY ALIGNED - LOGICAL WNGFVA !FREE VIRTUAL MEMORY -C -C Data declarations: -C -C- -C -C WNMIGN -C - WNMIGN=.TRUE. !ASSUME OK - J=0 !REAL - J1=N - GOTO 10 !FILL -C -C WNMYGN -C - ENTRY WNMYGN(MAR,N,M) -C - WNMYGN=.TRUE. !ASSUME OK - J=1 !COMPLEX - J1=2*N !# OF UNKNOWNS - 10 CONTINUE - J2=(LNHD+J1)*LB_J+((J1*(J1+1))/2+M*J1+3*M+J1+1)*LB_D !LENGTH AREA - WNMIGN=WNGGVA(J2,MAR) !GET AREA - IF (.NOT.WNMIGN) THEN - MAR=0 - WNMIGN=.FALSE. - RETURN - END IF - MAR=(MAR-A_OB)/LB_J !ARRAY OFFSET -C -C FILL DEFAULTS -C - A_J(MAR)=J !REAL/COMPLEX - A_J(MAR+1)=J1 !# UNKNOWNS - A_J(MAR+2)=M !# KNOWNS - A_J(MAR+3)=J1 !RANK - A_J(MAR+4)=MAR+LNHD !PIVOT AREA - A_J(MAR+5)=((A_J(MAR+4)+J1)*LB_J+LB_D-1)/LB_D !NORMAL EQUATIONS - A_J(MAR+6)=A_J(MAR+5)+(J1*(J1+1))/2 !KNOWN AREA - A_J(MAR+7)=A_J(MAR+6)+J1*M !ERROR PART - A_J(MAR+8)=A_J(MAR+7)+3*M !SOLUTION AID AREA - A_J(MAR+9)=J2 !AREA LENGTH - GOTO 20 !CLEAR -C -C WNMIZN -C - ENTRY WNMIZN(MAR) -C - WNMIZN=.TRUE. - 20 CONTINUE - J=A_J(MAR) !REAL/COMPLEX - I1=A_J(MAR+1) !N - I2=A_J(MAR+2) !M - A_J(MAR+3)=I1 !ASSUME RANK=N - I3=A_J(MAR+4) !PIVOT INDEX - DO I=0,I1-1 !INIT PIVOT - A_J(I3+I)=I - END DO - I3=A_J(MAR+5) !NORMAL EQUATIONS - I4=(I1*(I1+1))/2-1 !LENGTH - DO I=I3,I3+I4 - A_D(I)=0D0 - END DO - GOTO 30 !DO KNOWN PART -C -C WNMIZK -C - ENTRY WNMIZK(MAR) -C - WNMIZK=.TRUE. - J=A_J(MAR) !REAL/COMPLEX - I1=A_J(MAR+1) !N - I2=A_J(MAR+2) !M - 30 CONTINUE - I3=A_J(MAR+6) !KNOWN PART - I4=I2*I1-1 !LENGTH - DO I=I3,I3+I4 - A_D(I)=0D0 - END DO - I3=A_J(MAR+7) !ERROR PART - I4=3*I2-1 !LENGTH - DO I=I3,I3+I4 - A_D(I)=0D0 - END DO -C - RETURN -C -C WNMIZU -C - ENTRY WNMIZU(MAR) -C - WNMIZU=.TRUE. - J=A_J(MAR) !REAL/COMPLEX - I1=A_J(MAR+1) !N - I2=A_J(MAR+2) !M - A_J(MAR+3)=I1 !ASSUME RANK=N - I3=A_J(MAR+4) !PIVOT INDEX - DO I=0,I1-1 !INIT PIVOT - A_J(I3+I)=I - END DO - I3=A_J(MAR+5) !NORMAL EQUATIONS - I4=(I1*(I1+1))/2-1 !LENGTH - DO I=I3,I3+I4 - A_D(I)=0D0 - END DO -C - RETURN -C -C WNMIFN -C - ENTRY WNMIFN(MAR) -C - J2=A_J(MAR+9) !TOTAL LENGTH - MAR=MAR*LB_J+A_OB !AREA ADDRESS - WNMIFN=WNGFVA(J2,MAR) !FREE AREA - MAR=0 !READY -C - RETURN -C -C WNMINZ -C - ENTRY WNMINZ(MAR,N) -C - WNMINZ=.TRUE. !ALWAYS OK - J=A_J(MAR) !REAL/COMPLEX - I1=A_J(MAR+1) !N - I3=A_J(MAR+5) !NORMAL EQUATIONS - DO I=0,I1-1 - I2=I3+((2*I1-I+1)*I)/2 - IF (A_D(I2).LE.0D0) A_D(I2)=1D0 - END DO -C - RETURN -C -C WNMIGR -C - ENTRY WNMIGR(MAR,NR,CEQ) -C - WNMIGR=.TRUE. !ASSUME OK - J=A_J(MAR) !REAL/COMPLEX - J1=A_J(MAR+1) !N - J2=A_J(MAR+2) !M - J3=A_J(MAR+3) !RANK - J4=A_J(MAR+5) !NORMAL EQUATIONS - J5=A_J(MAR+4) !PIVOTS - DO I2=0,J2-1 !ALL KNOWNS - DO I=J3,J1-1 !ALL EQUATIONS - I4=(I-J3)*J1+I2*J1*J1 !POINTER OUTPUT - R0=1 !NORMALISATION - DO I1=0,J3-1 - I3=J4+((2*J1-I1-1)*I1)/2 !POINTER INPUT - CEQ(I4+A_J(J5+I1))=A_D(I3+I) !COPY CONSTRAINT - R1=ABS(CEQ(I4+A_J(J5+I1))) - IF (R1.GT.1E-6) R0=MIN(R0,R1) !NORMALISATION - END DO - DO I1=J3,J1-1 !FINAL VALUES - CEQ(I4+A_J(J5+I1))=0 - END DO - CEQ(I4+A_J(J5+I))=1 !UNIT EXTEND - DO I1=0,I !NORMALISE - CEQ(I4+A_J(J5+I1))=CEQ(I4+A_J(J5+I1))/R0 - END DO - END DO - END DO - NR=J3-J1 !RETURN RANK -C - RETURN -C -C - END diff --git a/src/wng/wnmimc.for b/src/wng/wnmimc.for deleted file mode 100644 index 68f96673833f28ce0e4f71e646c1cd0f039f18ad..0000000000000000000000000000000000000000 --- a/src/wng/wnmimc.for +++ /dev/null @@ -1,291 +0,0 @@ -C+ WNMIMC.FOR -C WNB 900312 -C -C Revisions: -C WNB 930503 Convert N complex to 2N real -C WNB 930506 Add XMC, XMU, XMK -C - SUBROUTINE WNMIMC(MAR,CE,WT,OB) -C -C Make normal equations from condition equations -C -C Result: -C -C CALL WNMIMC( MAR_J:I, CE_E(0:N-1):I, WT_E:I, OB_E(0:M-1):I) -C Make normal equations in MAR area. -C CE are the coefficients of the condition -C equations, WT is the weight of the observation, -C and OB are the observed values. -C CALL WNMYMC( MAR_J:I, CCE_X(0:N-1):I, WT_E:I, COB_X(0:M-1):I) -C Complex -C CALL WNMXMC( MAR_J:I, CCE_X(0:N-1):I, WT_E:I, COB_X(0:M-1):I) -C Complex, but separate equations real/complex -C CALL WNMIMU( MAR_J:I, CE_E(0:N-1):I, WT_E:I, OB_E(0:M-1):I) -C Make normal equations in MAR area, -C only the unknown part. -C CE are the coefficients of the condition -C equations, WT is the weight of the observation, -C and OB are the observed values. -C CALL WNMYMU( MAR_J:I, CCE_X(0:N-1):I, WT_E:I, COB_X(0:M-1):I) -C Complex -C CALL WNMXMU( MAR_J:I, CCE_X(0:N-1):I, WT_E:I, COB_X(0:M-1):I) -C Complex, but separate equations real/complex -C CALL WNMIMK( MAR_J:I, CE_E(0:N-1):I, WT_E:I, OB_E(0:M-1):I) -C Make normal equations in MAR area, -C but only known part. -C CE are the coefficients of the condition -C equations, WT is the weight of the observation, -C and OB are the observed values. -C CALL WNMYMK( MAR_J:I, CCE_X(0:N-1):I, WT_E:I, COB_X(0:M-1):I) -C Complex -C CALL WNMXMK( MAR_J:I, CCE_X(0:N-1):I, WT_E:I, COB_X(0:M-1):I) -C Complex, but separate equations real/complex -C -C Include files: -C - INCLUDE 'WNG_DEF' -C -C Parameters: -C -C -C Arguments: -C - INTEGER MAR !AREA POINTER - REAL CE(0:*) !CONDITION EQUATIONS - REAL WT !OBSERVING WEIGHT - REAL OB(0:*) !OBSERVED VALUES - COMPLEX COB(0:*) -C -C Entry points: -C -C -C Function references: -C -C -C Data declarations: -C - INTEGER N,M !UNKNOWNS, KNOWNS - LOGICAL DODAT !DO DATA AS WELL -C- -C -C EQUATIONS AND DATA -C - DODAT=.TRUE. - GOTO 10 -C -C ONLY EQUATIONS -C - ENTRY WNMIMU(MAR,CE,WT,OB) -C - DODAT=.FALSE. -C - 10 CONTINUE - N=A_J(MAR+1) !# OF UNKNOWNS - M=A_J(MAR+2) !# OF KNOWNS - I3=A_J(MAR+5) !INDEX NORMAL EQUATIONS - DO I=0,N-1 - IF (CE(I).NE.0) THEN - I2=I3+((2*N-I-1)*I)/2 - DO I1=I,N-1 - IF (CE(I1).NE.0) THEN - A_D(I2+I1)=A_D(I2+I1)+CE(I)*CE(I1)*WT !EQUATIONS - END IF - END DO - END IF - END DO -C - IF (.NOT.DODAT) RETURN !READY - GOTO 11 -C -C DATA -C - ENTRY WNMIMK(MAR,CE,WT,OB) -C - N=A_J(MAR+1) !# OF UNKNOWNS - M=A_J(MAR+2) !# OF KNOWNS - 11 CONTINUE - I3=A_J(MAR+6) !KNOWN VECTOR - DO I=0,M-1 - I2=I3+I*N - DO I1=0,N-1 - IF (CE(I1).NE.0) THEN - A_D(I2+I1)=A_D(I2+I1)+CE(I1)*OB(I)*WT !DATA VECTOR - END IF - END DO - I4=A_J(MAR+7)+I*3 - A_D(I4)=A_D(I4)+1 !CNT EQUATIONS - A_D(I4+1)=A_D(I4+1)+WT !SUM WEIGHT - A_D(I4+2)=A_D(I4+2)+WT*OB(I)*OB(I) !SUM RMS - END DO -C - RETURN -C -C COMPLEX -C -C -C WNMYMC -C - ENTRY WNMYMC(MAR,CE,WT,COB) -C -C EQUATIONS AND DATA -C - DODAT=.TRUE. - GOTO 100 -C -C ONLY EQUATIONS -C - ENTRY WNMYMU(MAR,CE,WT,COB) -C - DODAT=.FALSE. -C - 100 CONTINUE - N=A_J(MAR+1) !# OF UNKNOWNS - M=A_J(MAR+2) !# OF KNOWNS - I3=A_J(MAR+5) !INDEX NORMAL EQUATIONS - DO I=0,N-1 - I2=I3+((2*N-I-1)*I)/2 - IF (MOD(I,2).EQ.0) THEN !REAL PART - DO I1=I,N-1 - IF (MOD(I1,2).EQ.0) THEN !REAL PART - R0=CE(I)*CE(I1) - R1=CE(I+1)*CE(I1+1) - ELSE !IMAG. PART - R0=-CE(I)*CE(I1) - R1=CE(I+1)*CE(I1-1) - END IF - IF (R0.NE.0) THEN - A_D(I2+I1)=A_D(I2+I1)+R0*WT !EQUATIONS - END IF - IF (R1.NE.0) THEN - A_D(I2+I1)=A_D(I2+I1)+R1*WT !EQUATIONS - END IF - END DO - ELSE !IMAG. PART - DO I1=I,N-1 - IF (MOD(I1,2).EQ.0) THEN !REAL PART - R0=-CE(I)*CE(I1) - R1=CE(I-1)*CE(I1+1) - ELSE !IMAG. PART - R0=CE(I)*CE(I1) - R1=CE(I-1)*CE(I1-1) - END IF - IF (R0.NE.0) THEN - A_D(I2+I1)=A_D(I2+I1)+R0*WT !EQUATIONS - END IF - IF (R1.NE.0) THEN - A_D(I2+I1)=A_D(I2+I1)+R1*WT !EQUATIONS - END IF - END DO - END IF - END DO -C - IF (.NOT.DODAT) RETURN !READY - GOTO 110 -C -C DATA -C - ENTRY WNMYMK(MAR,CE,WT,COB) -C - N=A_J(MAR+1) !# OF UNKNOWNS - M=A_J(MAR+2) !# OF KNOWNS - 110 CONTINUE - I3=A_J(MAR+6) !KNOWN VECTOR - DO I=0,M-1 - I2=I3+I*N - DO I1=0,N-1 - IF (MOD(I1,2).EQ.0) THEN !REAL PART - R0=CE(I1) - R1=CE(I1+1) - ELSE !IMAG. PART - R0=-CE(I1) - R1=CE(I1-1) - END IF - IF (R0.NE.0) THEN - A_D(I2+I1)=A_D(I2+I1)+R0*REAL(COB(I))*WT - END IF - IF (R1.NE.0) THEN - A_D(I2+I1)=A_D(I2+I1)+R1*AIMAG(COB(I))*WT - END IF - END DO - I4=A_J(MAR+7)+I*3 - A_D(I4)=A_D(I4)+2 !CNT EQUATIONS - A_D(I4+1)=A_D(I4+1)+2*WT !SUM WEIGHT - A_D(I4+2)=A_D(I4+2)+WT*COB(I)*CONJG(COB(I)) !SUM RMS - END DO -C - RETURN -C -C SEPARABLE COMPLEX -C -C -C WNMXMC -C - ENTRY WNMXMC(MAR,CE,WT,COB) -C -C EQUATIONS AND DATA -C - DODAT=.TRUE. - GOTO 200 -C -C ONLY EQUATIONS -C - ENTRY WNMXMU(MAR,CE,WT,COB) -C - DODAT=.FALSE. -C - 200 CONTINUE - N=A_J(MAR+1) !# OF UNKNOWNS - M=A_J(MAR+2) !# OF KNOWNS - I3=A_J(MAR+5) !INDEX NORMAL EQUATIONS - DO I=0,N-1 - I2=I3+((2*N-I-1)*I)/2 - IF (MOD(I,2).EQ.0) THEN !REAL PART - DO I1=I,N-2,2 - R0=CE(I)*CE(I1) - IF (R0.NE.0) THEN - A_D(I2+I1)=A_D(I2+I1)+R0*WT !EQUATIONS - END IF - END DO - ELSE !IMAG. PART - DO I1=I,N-1,2 - R0=CE(I)*CE(I1) - IF (R0.NE.0) THEN - A_D(I2+I1)=A_D(I2+I1)+R0*WT !EQUATIONS - END IF - END DO - END IF - END DO -C - IF (.NOT.DODAT) RETURN !READY - GOTO 210 -C -C DATA -C - ENTRY WNMXMK(MAR,CE,WT,COB) -C - N=A_J(MAR+1) !# OF UNKNOWNS - M=A_J(MAR+2) !# OF KNOWNS - 210 CONTINUE - I3=A_J(MAR+6) !KNOWN VECTOR - DO I=0,M-1 - I2=I3+I*N - DO I1=0,N-1 - R0=CE(I1) - IF (R0.NE.0) THEN - IF (MOD(I1,2).EQ.0) THEN !REAL PART - A_D(I2+I1)=A_D(I2+I1)+R0*REAL(COB(I))*WT - ELSE !IMAG. PART - A_D(I2+I1)=A_D(I2+I1)+R0*AIMAG(COB(I))*WT - END IF - END IF - END DO - I4=A_J(MAR+7)+I*3 - A_D(I4)=A_D(I4)+2 !CNT EQUATIONS - A_D(I4+1)=A_D(I4+1)+2*WT !SUM WEIGHT - A_D(I4+2)=A_D(I4+2)+WT*COB(I)*CONJG(COB(I)) !SUM RMS - END DO -C - RETURN -C -C - END diff --git a/src/wng/wnmisn.for b/src/wng/wnmisn.for deleted file mode 100644 index 25645cbc0f64f4488d325f6aa44dd7f3c9ad0919..0000000000000000000000000000000000000000 --- a/src/wng/wnmisn.for +++ /dev/null @@ -1,173 +0,0 @@ -C+ WNMISN.FOR -C WNB 900312 -C -C Revisions: -C WNB 930503 Make N complex into 2N real -C WNB 930506 Higher precision solution -C - SUBROUTINE WNMISN(MAR,SOL,MU,ME) -C -C Solve triangular normal equations with rank defects -C -C Result: -C -C CALL WNMISN( MAR_J:O, SOL_E(0:*,0:*):O, MU_E(0:*):O, -C ME_E(0:*,0:*):O) -C Solve triangular normal equations. MAR gives -C the matrix. -C The solution will be given in SOL, with the -C adjustment error MU and the solution mean -C errors in ME. -C CALL WNMYSN( MAR_J:O, CSOL_X(0:*,0:*):O, MU_E(0:*):O, -C CME_X(0:*,0:*):O) -C As WNMISN but for complex solutions. -C -C Include files: -C - INCLUDE 'WNG_DEF' -C -C Parameters: -C -C -C Arguments: -C - INTEGER MAR !AREA POINTER - REAL SOL(0:*) !SOLUTION - REAL MU(0:*) !ADJUSTMENT ERROR - REAL ME(0:*) !SOLUTION ERRORS -C -C Entry points: -C -C -C Function references: -C -C -C Data declarations: -C - INTEGER N !# OF UNKNOWNS - INTEGER M !# OF KNOWNS - INTEGER NR !RANK - DOUBLE PRECISION DMU,MU1 !FOR M.E. - INTEGER I0B,I0R -C- -C -C WNMISN -C - J=A_J(MAR) !COMPLEX IND. - IF (J.NE.0) RETURN !WRONG TYPE - GOTO 10 -C -C WNMYSN -C - ENTRY WNMYSN(MAR,SOL,MU,ME) -C - J=A_J(MAR) !COMPLEX IND. - IF (J.EQ.0) RETURN !WRONG TYPE - GOTO 10 -C -C INTRO -C - 10 CONTINUE - N=A_J(MAR+1) !# UNKNOWNS - M=A_J(MAR+2) !# KNOWNS - NR=A_J(MAR+3) !RANK - J0=A_J(MAR+5) !NORMAL EQUATIONS - J1=A_J(MAR+6) !KNOWN VECTOR - J2=A_J(MAR+7) !ERROR VECTOR - J3=A_J(MAR+4) !PIVOT TABLE - J4=A_J(MAR+8) !SOLUTION AREA - DO I=0,M-1 !FOR ALL DATA VECTORS - I0B=J1+I*N !POINTER KNOWN VECTOR - DO I1=0,NR-1 !ALL UNKNOWNS - A_D(J4+A_J(J3+I1))=A_D(I0B+A_J(J3+I1)) - DO I2=0,I1-1 - I3=J0+((2*N-I2-1)*I2)/2 - A_D(J4+A_J(J3+I1))=A_D(J4+A_J(J3+I1))- - 1 A_D(I3+I1)*A_D(J4+A_J(J3+I2))/A_D(I3+I2) !STEP 1 - END DO - END DO - DO I1=NR-1,0,-1 - I3=J0+((2*N-I1-1)*I1)/2 - DO I2=I1+1,NR-1 - A_D(J4+A_J(J3+I1))=A_D(J4+A_J(J3+I1))- - 1 A_D(I3+I2)*A_D(J4+A_J(J3+I2)) !SOLUTION - END DO - A_D(J4+A_J(J3+I1))=A_D(J4+A_J(J3+I1))/A_D(I3+I1) - END DO - I0R=J2+3*I !POINTER ERROR VECTOR - DMU=A_D(I0R+2) ![LL] - DO I1=0,NR-1 - DMU=DMU-A_D(J4+A_J(J3+I1))*A_D(I0B+A_J(J3+I1)) !MAKE RMS - END DO - MU1=SQRT(MAX(0D0,DMU/MAX(1D0,A_D(I0R)-N))) - IF (A_D(I0R+1).GT.0D0) DMU=DMU/A_D(I0R+1) !PER WEIGHT - MU(I)=SQRT(MAX(0D0,DMU)) !RETURN ERROR PER WEIGHT - DO I1=0,NR-1 - I3=J0+((2*N-I1-1)*I1)/2 - ME(A_J(J3+I1)+I*N)=MU1/SQRT(A_D(I3+I1)) - END DO -C -C MISSING RANK -C - DO I1=NR,N-1 !MAKE B2=-G1'*.X1' - A_D(I0B+A_J(J3+I1))=0 - DO I2=0,NR-1 - I3=J0+((2*N-I2-1)*I2)/2 - A_D(I0B+A_J(J3+I1))=A_D(I0B+A_J(J3+I1))- - 1 A_D(J4+A_J(J3+I2))*A_D(I3+I1) - END DO - END DO -C -C SOLVE X2 -C - DO I1=NR,N-1 !ALL UNKNOWNS - A_D(J4+A_J(J3+I1))=A_D(I0B+A_J(J3+I1)) - DO I2=NR,I1-1 - I3=J0+((2*N-I2-1)*I2)/2 - A_D(J4+A_J(J3+I1))=A_D(J4+A_J(J3+I1))- - 1 A_D(I3+I1)*A_D(J4+A_J(J3+I2))/A_D(I3+I2) !STEP 1 - END DO - END DO - DO I1=N-1,NR,-1 - I3=J0+((2*N-I1-1)*I1)/2 - DO I2=I1+1,N-1 - A_D(J4+A_J(J3+I1))=A_D(J4+A_J(J3+I1))- - 1 A_D(I3+I2)*A_D(J4+A_J(J3+I2)) !SOLUTION - END DO - A_D(J4+A_J(J3+I1))=A_D(J4+A_J(J3+I1))/A_D(I3+I1) - ME(A_J(J3+I1)+I*N)=MU1/SQRT(A_D(I3+I1)) - END DO -C -C FINAL X1 -C - DO I1=0,NR-1 - I3=J0+((2*N-I1-1)*I1)/2 - DO I2=NR,N-1 - A_D(J4+A_J(J3+I1))=A_D(J4+A_J(J3+I1))+ - 1 A_D(J4+A_J(J3+I2))*A_D(I3+I2) - END DO - END DO -C -C ERRORS -C - I0R=J2+3*I !POINTER ERROR VECTOR - DMU=A_D(I0R+2) ![LL] - DO I1=0,N-1 - DMU=DMU-A_D(J4+A_J(J3+I1))*A_D(I0B+A_J(J3+I1)) !MAKE RMS - END DO - MU1=SQRT(MAX(0D0,DMU/MAX(1D0,A_D(I0R)-N))) - IF (A_D(I0R+1).GT.0D0) DMU=DMU/A_D(I0R+1) !PER WEIGHT - MU(I)=SQRT(MAX(0D0,DMU)) !RETURN ERROR PER WEIGHT - DO I1=0,N-1 - I3=J0+((2*N-I1-1)*I1)/2 - ME(A_J(J3+I1)+I*N)=MU1/SQRT(A_D(I3+I1)) - END DO - DO I1=0,N-1 !RETURN SOLUTION - SOL(I1+I*N)=A_D(J4+I1) - END DO - END DO -C - RETURN -C -C - END diff --git a/src/wng/wnmitn.for b/src/wng/wnmitn.for deleted file mode 100644 index 729047805419f9372e2613e89c0c626114a51068..0000000000000000000000000000000000000000 --- a/src/wng/wnmitn.for +++ /dev/null @@ -1,60 +0,0 @@ -C+ WNMITN.FOR -C WNB 900312 -C -C Revisions: -C WNB 930503 Make N complex into 2N real -C - LOGICAL FUNCTION WNMITN(MAR) -C -C Triangularize normal equations -C -C Result: -C -C WNMITN_L = WNMITN( MAR_J:I) -C Triangularize normal equations -C -C Include files: -C - INCLUDE 'WNG_DEF' -C -C Parameters: -C -C -C Arguments: -C - INTEGER MAR !AREA POINTER -C -C Entry points: -C -C -C Function references: -C -C -C Data declarations: -C - INTEGER N -C- - N=A_J(MAR+1) - J1=A_J(MAR+5) !INDEX NORMAL EQUATIONS -C -C REAL -C - WNMITN=.TRUE. !ASSUME OK - DO I=0,N-1 !DECOMPOSE - I3=J1+((2*N-I-1)*I)/2 - DO I1=I,N-1 - DO I2=0,I-1 - I4=J1+((2*N-I2-1)*I2)/2 - A_D(I3+I1)=A_D(I3+I1)-A_D(I4+I)*A_D(I4+I1)/A_D(I4+I2) - END DO - END DO - IF (A_D(I3+I).LE.0) THEN - WNMITN=.FALSE. !CANNOT DO - RETURN - END IF - END DO -C - RETURN -C -C - END diff --git a/src/wng/wnmitr.for b/src/wng/wnmitr.for deleted file mode 100644 index 289353161695fd847790fa256e61ec04af89e2bb..0000000000000000000000000000000000000000 --- a/src/wng/wnmitr.for +++ /dev/null @@ -1,146 +0,0 @@ -C+ WNMITR.FOR -C WNB 900312 -C -C Revisions: -C WNB 930503 Make N complex into 2N real -C - LOGICAL FUNCTION WNMITR(MAR,CHKVL,NR) -C -C Triangularize normal equations with rank/constraint determination -C -C Result: -C -C WNMITR_L = WNMITR( MAR_J:O, CHKVL_R:I, NR_J:O) -C Triangularize normal equations and determine -C the rank NR and the constraint equations. -C CHKVL determines the dependancy level. -C -C Include files: -C - INCLUDE 'WNG_DEF' -C -C Parameters: -C -C -C Arguments: -C - INTEGER MAR !AREA POINTER - REAL CHKVL !CHECK LIMIT - INTEGER NR !RANK OF NORMAL EQUATIONS -C -C Entry points: -C -C -C Function references: -C -C -C Data declarations: -C - INTEGER N -C- - N=A_J(MAR+1) - J1=A_J(MAR+5) !INDEX NORMAL EQUATIONS -C -C REAL -C - WNMITR=.TRUE. !ASSUME OK - DO I=0,N-1 !DECOMPOSE - IF (I.LT.A_J(MAR+3)) THEN !STILL RANK LEFT - I3=J1+((2*N-I-1)*I)/2 - 10 CONTINUE - D0=A_D(I3+I) !GET COLLINEARITY - DO I2=0,I-1 - I4=J1+((2*N-I2-1)*I2)/2 - D0=D0-A_D(I4+I)*A_D(I4+I)/A_D(I4+I2) - END DO - IF (D0*D0/A_D(I3+I).LE.CHKVL*CHKVL) THEN !DEPENDANCY - IF (I.LT.A_J(MAR+3)-1) THEN !RANK LEFT - J0=A_J(MAR+3)-1 !RANK POINTER - DO I2=0,I-1 !SHIFT PIVOT - I4=J1+((2*N-I2-1)*I2)/2 - D1=A_D(I4+I) - A_D(I4+I)=A_D(I4+J0) - A_D(I4+J0)=D1 - END DO - D1=A_D(I3+I) - I4=J1+((2*N-J0-1)*J0)/2 - A_D(I3+I)=A_D(I4+J0) - A_D(I4+J0)=D1 - DO I2=I+1,J0-1 - I4=J1+((2*N-I2-1)*I2)/2 - D1=A_D(I3+I2) - A_D(I3+I2)=A_D(I4+J0) - A_D(I4+J0)=D1 - END DO - I4=J1+((2*N-J0-1)*J0)/2 - DO I2=J0+1,N-1 !SHIFT PIVOT - D1=A_D(I3+I2) - A_D(I3+I2)=A_D(I4+I2) - A_D(I4+I2)=D1 - END DO - A_J(MAR+3)=A_J(MAR+3)-1 !DECREASE RANK - J2=A_J(MAR+4) !PIVOT TABLE - I1=A_J(J2+I) !SWITCH PIVOTS - A_J(J2+I)=A_J(J2+J0) - A_J(J2+J0)=I1 - GOTO 10 !RETRY - ELSE - A_J(MAR+3)=I !SET RANK - END IF - END IF - A_D(I3+I)=D0 !DIAGONAL - DO I1=I+1,N-1 !LU DECOMPOSITION - DO I2=0,I-1 - I4=J1+((2*N-I2-1)*I2)/2 - A_D(I3+I1)=A_D(I3+I1)-A_D(I4+I)*A_D(I4+I1)/A_D(I4+I2) - END DO - END DO - END IF - END DO -C -C CONSTRAINTS -C - J0=A_J(MAR+3) !RANK - DO I1=J0,N-1 - DO I=J0-1,0,-1 - I3=J1+((2*N-I-1)*I)/2 - DO I2=I+1,J0-1 - I4=J1+((2*N-I2-1)*I2)/2 - A_D(I3+I1)=A_D(I3+I1)+A_D(I3+I2)*A_D(I4+I1) - END DO - A_D(I3+I1)=-A_D(I3+I1)/A_D(I3+I) - END DO - END DO -C -C RANK BASIS (A=I+G1'*.G1') -C - DO I=J0,N-1 - I3=J1+((2*N-I-1)*I)/2 - DO I1=I,N-1 - A_D(I3+I1)=0 - DO I2=0,J0-1 - I4=J1+((2*N-I2-1)*I2)/2 - A_D(I3+I1)=A_D(I3+I1)+A_D(I4+I)*A_D(I4+I1) - END DO - END DO - A_D(I3+I)=1+A_D(I3+I) - END DO -C -C TRIANGULAR A -C - DO I=J0,N-1 - I3=J1+((2*N-I-1)*I)/2 - DO I1=I,N-1 - DO I2=J0,I-1 - I4=J1+((2*N-I2-1)*I2)/2 - A_D(I3+I1)=A_D(I3+I1)-A_D(I4+I)*A_D(I4+I1)/A_D(I4+I2) - END DO - END DO - END DO -C - NR=A_J(MAR+3) !RANK -C - RETURN -C -C - END diff --git a/src/wng/wnmlga.for b/src/wng/wnmlga.for deleted file mode 100644 index de72e95444f77bd080eaeb846620a4b05e363529..0000000000000000000000000000000000000000 --- a/src/wng/wnmlga.for +++ /dev/null @@ -1,139 +0,0 @@ -C+ WNMLGA.FOR -C WNB 950330 -C -C Revisions: -C - LOGICAL FUNCTION WNMLGA(MAR,TYPE,NUN,M,NCON,PREC) -C -C Get least squares area -C -C Result: -C -C WNMLGA_L = WNMLGA( MAR_J:O, TYPE_J:I, NUN_J:I, M_J:I, NCON_J:I, -C PREC_E:I) -C Get an area (MAR) for least squares -C solution with NUN unknowns. -C Type is complex (LSQ_T_COMPLEX) or -C real (default or LSQ_T_REAL). Type can have -C LSQ_T_MULTIPLE (for multiple M known (measured) -C values; LSQ_T_CONSTRAINT to indicate -C NCON constraint equations; and/or -C LSQ_T_PREC to indicate a precision PREC for -C checking equation dependencies (default 1E-6). -C MAR, and zero the equations. -C WNMLFA_L = WNMLFA( MAR_J:I) Free least squares area MAR -C -C Include files: -C - INCLUDE 'WNG_DEF' - INCLUDE 'LSQ_O_DEF' -C -C Parameters: -C -C -C Arguments: -C - INTEGER MAR !AREA POINTER - INTEGER TYPE !AREA TYPE - INTEGER NUN !# OF UNKNOWNS - INTEGER M !# OF KNOWNS - INTEGER NCON !# OF CONSTRAINT EQUATIONS - REAL PREC !TEST PRECISION -C -C Entry points: -C - LOGICAL WNMLFA -C -C Function references: -C - LOGICAL WNGGVA !GET VIRTUAL MEMORY ALIGNED - LOGICAL WNGFVA !FREE VIRTUAL MEMORY -C -C Data declarations: -C -C- -C -C WNMLGA -C - WNMLGA=.TRUE. !ASSUME OK - IF (IAND(TYPE,LSQ_T_COMPLEX).NE.0) THEN !COMPLEX - J1=2*NUN - ELSE - J1=NUN - END IF - IF (IAND(TYPE,LSQ_T_MULTIPLE).NE.0) THEN !MULTIPLE KNOWNS - J2=M - ELSE - J2=1 - END IF - IF (IAND(TYPE,LSQ_T_CONSTRAINT).NE.0) THEN !CONSTRAINTS WILL BE - !GIVEN - J3=NCON+J1 - ELSE - J3=J1 - END IF - IF (IAND(TYPE,LSQ_T_PREC).NE.0) THEN !PRECISION GIVEN - R0=PREC - ELSE - R0=DPREC - END IF - J0=(LSQ__L+ !HEADER LENGTH: HEADER - 1 J3*LB_J+ !PIVOT TABLE - 1 ((J3*(J3+1))/2)*LB_D+ !NORMAL EQUATIONS - 1 J2*J3*LB_D+ !KNOWNS AREA - 1 LERR__N*J2*LB_D+ !ERROR AREA - 1 J3*LB_D+ !SOLUTION AREA - 1 1*LB_D) !ALIGNMENT - WNMLGA=WNGGVA(J0,MAR) !GET AREA - IF (.NOT.WNMLGA) THEN - MAR=0 - RETURN - END IF - MAR=(MAR-A_OB)/LB_J !ARRAY OFFSET -C -C FILL DEFAULTS -C - A_J(MAR+LSQ_SIZE_J)=J0 !SIZE AREA - A_J(MAR+LSQ_BITS_J)=TYPE !REAL/COMPLEX - A_J(MAR+LSQ_DBL_J)=(MAR*LB_J)/LB_D !A_D INDEX - A_J(MAR+LSQ_NUN_J)=J1 !# UNKNOWNS - A_J(MAR+LSQ_M_J)=J2 !# KNOWNS - A_J(MAR+LSQ_N_J)=J3 !# UNKNOWNS + # CONSTRAINTS - A_J(MAR+LSQ_NAR_J)=0 !SAVE AREA NON-LINEAR - A_J(MAR+LSQ_PIV_J)=MAR+LSQ__L/LB_J !PIVOT AREA - A_J(MAR+LSQ_NORM_J)=((A_J(MAR+LSQ_PIV_J)+J3)*LB_J+LB_D-1)/LB_D !NORMAL - !EQUATIONS - A_J(MAR+LSQ_KNOWN_J)=A_J(MAR+LSQ_NORM_J)+(J3*(J3+1))/2 !KNOWN AREA - A_J(MAR+LSQ_ERROR_J)=A_J(MAR+LSQ_KNOWN_J)+J2*J3 !ERROR PART - A_J(MAR+LSQ_SOL_J)=A_J(MAR+LSQ_ERROR_J)+LERR__N*J2 !SOLUTION AID AREA -C -C CLEAR AREA -C - IF (IAND(TYPE,LSQ_T_NOINIT).EQ.0) - 1 CALL WNMLIA(MAR,LSQ_I_ALL+LSQ_I_PREC,R0) !INIT ALL -C - RETURN -C -C WNMLFA -C - ENTRY WNMLFA(MAR) -C - IF (MAR.NE.0) THEN - IF (A_J(MAR+LSQ_NAR_J).NE.0) THEN !SAVE AREA NON-LINEAR - J0=A_J(MAR+LSQ_SIZE_J) !AREA SIZE - J1=A_J(MAR+LSQ_NAR_J)*LB_J+A_OB !AREA ADDRESS - WNMLFA=WNGFVA(J0,J1) - A_J(MAR+LSQ_NAR_J)=0 !SET FREE - END IF - J0=A_J(MAR+LSQ_SIZE_J) !AREA SIZE - MAR=MAR*LB_J+A_OB !AREA ADDRESS - WNMLFA=WNGFVA(J0,MAR) !FREE AREA - MAR=0 !READY - ELSE - WNMLFA=.TRUE. - END IF -C - RETURN -C -C - END diff --git a/src/wng/wnmlgc.for b/src/wng/wnmlgc.for deleted file mode 100644 index 0058f9c74b59150b4941cb77e9b7be30a5daf5ce..0000000000000000000000000000000000000000 --- a/src/wng/wnmlgc.for +++ /dev/null @@ -1,69 +0,0 @@ -C+ WNMLGC.FOR -C WNB 950330 -C -C Revisions: -C - SUBROUTINE WNMLGC(MAR,NR,CEQ) -C -C Get constraint equations -C -C Result: -C -C CALL WNMLGC( MAR_J:I, NR_J:O, CEQ_E(0:N-1,0:NR-1):O) -C Get the constraint equations CEQ and the -C rank deficiency NR -C Note: For complex solutions the rank deficiency -C can be a maximum of 2N, and the returned -C equations will be: -C CEQ_E(0:2N-1,0:NR-1):O -C -C -C Include files: -C - INCLUDE 'WNG_DEF' - INCLUDE 'LSQ_O_DEF' -C -C Parameters: -C -C -C Arguments: -C - INTEGER MAR !AREA POINTER - INTEGER NR !RETURNED RANK DEFICIENCY - REAL CEQ(0:*) !CONSTRAINT EQUATIONS -C -C Function references: -C - INTEGER WNMLGR !GET ROW POINTER -C -C Data declarations: -C - INTEGER NUN !# UNKNOWNS - INTEGER PIVV !PIVOT VECTOR -C- - NUN=A_J(MAR+LSQ_NUN_J) !N UNKNOWN - NR=A_J(MAR+LSQ_R_J) !RANK - PIVV=A_J(MAR+LSQ_PIV_J) !PIVOTS - DO I=NR,NUN-1 !ALL EQUATIONS - I4=(I-NR)*NUN !POINTER OUTPUT - R0=1 !NORMALISATION - DO I1=0,NR-1 - I3=WNMLGR(MAR,I1) !POINTER INPUT - CEQ(I4+A_J(PIVV+I1))=A_D(I3+I) !COPY CONSTRAINT - R1=ABS(CEQ(I4+A_J(PIVV+I1))) - IF (R1.GT.1E-6) R0=MIN(R0,R1) !NORMALISATION - END DO - DO I1=NR,NUN-1 !FINAL VALUES - CEQ(I4+A_J(PIVV+I1))=0 - END DO - CEQ(I4+A_J(PIVV+I))=1 !UNIT EXTEND - DO I1=0,I !NORMALISE - CEQ(I4+A_J(PIVV+I1))=CEQ(I4+A_J(PIVV+I1))/R0 - END DO - END DO - NR=NUN-NR !RETURN RANK DEFICIENCY -C - RETURN -C -C - END diff --git a/src/wng/wnmlgr.for b/src/wng/wnmlgr.for deleted file mode 100644 index 8f590c7bcbbba28b52d7ee8381b169b9c1fb9034..0000000000000000000000000000000000000000 --- a/src/wng/wnmlgr.for +++ /dev/null @@ -1,124 +0,0 @@ -C+ WNMLGR.FOR -C WNB 950330 -C -C Revisions: -C WNB 950615 Typo -C - INTEGER FUNCTION WNMLGR(MAR,ROW) -C -C Some help routines for LSQ package -C -C Result: -C -C WNMLGR_J = WNMLGR( MAR_J:I, ROW_J:I) -C Give A_D pointer for ROW in normal -C equation array -C WNMLGE_J = WNMLGE( MAR_J:I, ROW_J:I, COL_J:I) -C Give A_D pointer for ROW and COLumn in normal -C equation array -C WNMLGK_J = WNMLGK( MAR_J:I, ROW_J:I) -C Give A_D pointer to known column ROW -C WNMLMF_L = WNMLMF( MAR_J:I, MAR2_J:I) -C Move some info from MAR to MAR2, using -C MAR for sizes (only for m=1) -C WNMLMT_L = WNMLMT( MAR_J:I, MAR2_J:I) -C Move some info from MAR2 to MAR, using -C MAR for sizes (only for m=1) -C -C Include files: -C - INCLUDE 'WNG_DEF' - INCLUDE 'LSQ_O_DEF' -C -C Parameters: -C -C -C Arguments: -C - INTEGER MAR !AREA POINTER - INTEGER ROW !ARRAY ROW - INTEGER COL !ARRAY COLUMN - INTEGER MAR2 !AREA POINTER -C -C Entry points: -C - INTEGER WNMLGE,WNMLGK - LOGICAL WNMLMT,WNMLMF -C -C Function references: -C -C -C Data declarations: -C -C- -C -C WNMLGR -C - WNMLGR=A_J(MAR+LSQ_NORM_J)+((2*A_J(MAR+LSQ_N_J)-ROW-1)*ROW)/2 -C - RETURN -C -C WNMLGE -C - ENTRY WNMLGE(MAR,ROW,COL) -c - WNMLGE=A_J(MAR+LSQ_NORM_J)+((2*A_J(MAR+LSQ_N_J)-ROW-1)*ROW)/2+COL -C - RETURN -C -C WNMLGK -C - ENTRY WNMLGK(MAR,ROW) -C - WNMLGK=A_J(MAR+LSQ_KNOWN_J)+ROW*A_J(MAR+LSQ_N_J) -C - RETURN -C -C WNMLMT -C - ENTRY WNMLMT(MAR,MAR2) -C - WNMLMT=.TRUE. - DO I=0,A_J(MAR+LSQ_N_J)-1 !COPY UNKNOWN - I1=A_J(MAR+LSQ_NORM_J)+((2*A_J(MAR+LSQ_N_J)-I-1)*I)/2 - I0=A_J(MAR2+LSQ_NORM_J)+((2*A_J(MAR+LSQ_N_J)-I-1)*I)/2 - DO I2=I,A_J(MAR+LSQ_N_J)-1 - A_D(I1+I2)=A_D(I0+I2) - END DO - I1=A_J(MAR+LSQ_KNOWN_J) - I0=A_J(MAR2+LSQ_KNOWN_J) - A_D(I1+I)=A_D(I0+I) !COPY KNOWN - END DO - I1=A_J(MAR+LSQ_ERROR_J) !COPY ERROR - I0=A_J(MAR2+LSQ_ERROR_J) - DO I2=0,LERR__N-1 - A_D(I1+I2)=A_D(I0+I2) - END DO -C - RETURN -C -C WNMLMF -C - ENTRY WNMLMF(MAR,MAR2) -C - WNMLMF=.TRUE. - DO I=0,A_J(MAR+LSQ_N_J)-1 !COPY UNKNOWN - I0=A_J(MAR+LSQ_NORM_J)+((2*A_J(MAR+LSQ_N_J)-I-1)*I)/2 - I1=A_J(MAR2+LSQ_NORM_J)+((2*A_J(MAR+LSQ_N_J)-I-1)*I)/2 - DO I2=I,A_J(MAR+LSQ_N_J)-1 - A_D(I1+I2)=A_D(I0+I2) - END DO - I0=A_J(MAR+LSQ_KNOWN_J) - I1=A_J(MAR2+LSQ_KNOWN_J) - A_D(I1+I)=A_D(I0+I) !COPY KNOWN - END DO - I0=A_J(MAR+LSQ_ERROR_J) !COPY ERROR - I1=A_J(MAR2+LSQ_ERROR_J) - DO I2=0,LERR__N-1 - A_D(I1+I2)=A_D(I0+I2) - END DO -C - RETURN -C -C - END diff --git a/src/wng/wnmlia.for b/src/wng/wnmlia.for deleted file mode 100644 index 5ff3a89e72840c1af9be6a3c7313292999855ed2..0000000000000000000000000000000000000000 --- a/src/wng/wnmlia.for +++ /dev/null @@ -1,129 +0,0 @@ -C+ WNMLIA.FOR -C WNB 950330 -C -C Revisions: -C - SUBROUTINE WNMLIA(MAR,TYPE,PREC) -C -C Initialise least squares area -C -C Result: -C -C CALL WNMLIA( MAR_J:I, TYPE_J:I, PREC_E:I) -C Iniialise the least squares area MAR, according -C to the TYPE: -C LSQ_I_ALL (or default) : init full area -C LSQ_I_NORM : init unknown part of normal -C equations -C LSQ_I_KNOWN: init known part of equations -C LSQ_I_NONLIN: init non-linear part -C LSQ_I_SOL: init all but non-linear part -C LSQ_I_PREC: fill precision factor with PREC -C CALL WNMLID( MAR_J:I) Init diagonal elements to 1 if near zero -C CALL WNMLIF( MAR_J:I, FAC_D:I) -C Multiply diagonal elements with FAC -C -C -C Include files: -C - INCLUDE 'WNG_DEF' - INCLUDE 'LSQ_O_DEF' -C -C Parameters: -C -C -C Arguments: -C - INTEGER MAR !AREA POINTER - INTEGER TYPE !TYPE OF INIT - REAL PREC !PRECISION FACTOR - DOUBLE PRECISION FAC !MULTIPLICATION FACTOR -C -C Function references: -C - INTEGER WNMLGE !GET ARRAY ELEMENT POINTER -C -C Data declarations: -C -C- - IF (IAND(TYPE,LSQ_I_ALL+LSQ_I_PREC).EQ.0) THEN - J0=LSQ_I_ALL !ASSUME ALL - ELSE - J0=TYPE - END IF - J1=A_J(MAR+LSQ_DBL_J) !A_D POINTER - I1=A_J(MAR+LSQ_N_J) !N - I2=A_J(MAR+LSQ_M_J) !M -C -C NON-LINEAR PART -C - IF (IAND(J0,LSQ_I_NONLIN).NE.0) THEN !NON-LINEAR PART - A_D(J1+LSQ_NONLIN_D)=NLFAC !START NON-LINEAR FACTOR - A_J(MAR+LSQ_BITS_J)=IAND(A_J(MAR+LSQ_BITS_J),NOT(LSQ_U_NONLIN)) - END IF -C -C UNKNOWN PART -C - IF (IAND(J0,LSQ_I_NORM).NE.0) THEN - A_J(MAR+LSQ_R_J)=I1 !ASSUME RANK=N - I3=A_J(MAR+LSQ_PIV_J) !PIVOT INDEX - DO I=0,I1-1 !INIT PIVOT - A_J(I3+I)=I - END DO - I3=A_J(MAR+LSQ_NORM_J) !NORMAL EQUATIONS - I4=(I1*(I1+1))/2-1 !LENGTH - DO I=I3,I3+I4 - A_D(I)=0D0 - END DO - A_J(MAR+LSQ_BITS_J)=IAND(A_J(MAR+LSQ_BITS_J), - 1 NOT(LSQ_U_INVERTED+LSQ_U_TRIANGLE)) - END IF -C -C KNOWN PART -C - IF (IAND(J0,LSQ_I_KNOWN).NE.0) THEN - I3=A_J(MAR+LSQ_KNOWN_J) !KNOWN PART - I4=I2*I1-1 !LENGTH - DO I=I3,I3+I4 - A_D(I)=0D0 - END DO - I3=A_J(MAR+LSQ_ERROR_J) !ERROR PART - I4=LERR__N*I2-1 !LENGTH - DO I=I3,I3+I4 - A_D(I)=0D0 - END DO - END IF -C -C PRECISION FACTOR -C - IF (IAND(J0,LSQ_I_PREC).NE.0) THEN - A_D(J1+LSQ_FACTOR_D)=ABS(PREC) - END IF -C - RETURN -C -C WNMLID -C - ENTRY WNMLID(MAR) -C - D0=A_D(A_J(MAR+LSQ_DBL_J)+LSQ_FACTOR_D) !PRECISION - DO I=0,A_J(MAR+LSQ_NUN_J)-1 - I2=WNMLGE(MAR,I,I) - IF (ABS(A_D(I2)).LE.D0) A_D(I2)=1D0 - END DO -C - RETURN -C -C WNMLIF -C - ENTRY WNMLIF(MAR,FAC) -C - DO I=0,A_J(MAR+LSQ_NUN_J)-1 - I2=WNMLGE(MAR,I,I) - A_D(I2)=A_D(I2)*FAC - END DO -C - RETURN -C -C - END diff --git a/src/wng/wnmlin.for b/src/wng/wnmlin.for deleted file mode 100644 index feb6465984eabbd41da35418b4a8513ade36b3d3..0000000000000000000000000000000000000000 --- a/src/wng/wnmlin.for +++ /dev/null @@ -1,372 +0,0 @@ -C+ WNMLIN.FOR -C WNB 950330 -C -C Revisions: -C WNB 950611 Return error (LME), not variance; typo -C - LOGICAL FUNCTION WNMLIN(MAR,MU) -C -C Invert normal equations, get uncertainties in unknowns -C -C Result: -C -C WNMLIN_L = WNMLIN( MAR_J:O) -C Invert normal equations. MAR gives -C the matrix. -C WNMLME_L = WNMLME( MAR_J:O, MU_E(0:N-1,0:M-1):O) -C Invert normal equations. MAR gives -C the matrix. -C MU will return the uncertainties in the -C unknowns. -C WNMLCV_L = WNMLCV( MAR_J:O, MU_E(0:N-1,0:N-1):O) -C Invert normal equations. MAR gives -C the matrix. -C MU will return the inverted matrix (covariant -C matrix). -C -C Include files: -C - INCLUDE 'WNG_DEF' - INCLUDE 'LSQ_O_DEF' -C -C Parameters: -C -C -C Arguments: -C - INTEGER MAR !AREA POINTER - REAL MU(0:*) !UNKNOWN ERROR/COVARIANT MATRIX -C -C Entry points: -C - LOGICAL WNMLCV,WNMLME -C -C Function references: -C - INTEGER WNMLGR !GET ROW POINTER ARRAY - INTEGER WNMLGK !GET KNOWN COLUMN POINTER - LOGICAL WNGGVA !GET MEMORY -C -C Data declarations: -C - INTEGER NUN !# OF UNKNOWNS - INTEGER M !# OF KNOWNS - INTEGER N !# TO SOLVE - INTEGER NR !RANK - INTEGER PIVV !PIVOT VECTOR POINTER - INTEGER SOLV !SOLUTION VECTOR POINTER - LOGICAL CV,OUT !INDICATE COVARIANCE - INTEGER ALEN !LOCAL AREA LENGTH - INTEGER LAR !LOCAL AREA POINTER -C- -C WNMLIN -C - OUT=.FALSE. - GOTO 10 -C -C WNMLCV -C - ENTRY WNMLCV(MAR,MU) -C - CV=.TRUE. - OUT=.TRUE. - GOTO 10 -C -C WNMLME -C - ENTRY WNMLME(MAR,MU) -C - CV=.FALSE. - OUT=.TRUE. - GOTO 10 -C -C INTRO -C - 10 CONTINUE - WNMLIN=.TRUE. !ASSUME OK - N=A_J(MAR+LSQ_N_J) !# TO SOLVE - M=A_J(MAR+LSQ_M_J) !# KNOWNS - NUN=A_J(MAR+LSQ_NUN_J) !# UNKNOWNS - NR=A_J(MAR+LSQ_R_J) !RANK - PIVV=A_J(MAR+LSQ_PIV_J) !PIVOT TABLE - SOLV=A_J(MAR+LSQ_SOL_J) !SOLUTION AREA -C -C INVERT -C - IF (IAND(A_J(MAR+LSQ_BITS_J),LSQ_U_INVERTED).EQ.0) THEN - ALEN=N*N*LB_D !GET WORKSPACE - IF (.NOT.WNGGVA(ALEN,LAR)) THEN - WNMLIN=.FALSE. - GOTO 810 - END IF - LAR=(LAR-A_OB)/LB_D !A_D POINTER OUT - IF (N.NE.NUN) THEN !LU NECESSARY -C -C LU DECOMPOSITION -C -C GET MATRIX -C - DO I=0,N-1 !FILL MATRIX - J0=WNMLGR(MAR,I) !INPUT ROW - J1=LAR+N*I !OUTPUT ROW - A_D(J1+I)=A_D(J0+I) !DIAGONAL - DO I1=I+1,N-1 !REST - A_D(J1+I1)=A_D(J0+I1) - A_D(LAR+I+N*I1)=A_D(J0+I1) - END DO - END DO -C -C GET SCALING -C - DO I=0,N-1 !COLUMN LOOP - D0=0 - DO I1=0,N-1 - J1=LAR+N*I1 - IF (ABS(A_D(J1+I)).GT.D0) D0=ABS(A_D(J1+I)) - END DO - IF (D0.EQ.0) THEN !CANNOT SOLVE - WNMLIN=.FALSE. - GOTO 800 - END IF - A_D(SOLV+I)=1./D0 !SAVE SCALING - END DO -C -C DO CROUT -C - DO I1=0,N-1 !ALL COLUMNS - J0=LAR+N*I1 - DO I=0,I1-1 - DO I2=0,I-1 - J1=LAR+N*I2 - A_D(J0+I)=A_D(J0+I)-A_D(J1+I)*A_D(J0+I2) - END DO - END DO - D0=0 - DO I=I1,N-1 !CHECK PIVOT - DO I2=0,I1-1 - J1=LAR+N*I2 - A_D(J0+I)=A_D(J0+I)-A_D(J1+I)*A_D(J0+I2) - END DO - IF (A_D(SOLV+I)*ABS(A_D(J0+I)).GE.D0) THEN !FIND BEST PIVOT - I4=I - D0=A_D(SOLV+I)*ABS(A_D(J0+I)) - END IF - END DO - IF (I1.NE.I4) THEN !INTERCHANGE ROWS - DO I2=0,N-1 - J1=LAR+N*I2 - D0=A_D(J1+I4) - A_D(J1+I4)=A_D(J1+I1) - A_D(J1+I1)=D0 - END DO - A_D(SOLV+I4)=A_D(SOLV+I1) !CHANGE SCALE FACTOR - END IF - A_J(PIVV+I1)=I4 !SAVE PIVOT - IF (I1.NE.N-1) THEN !CORRECT FOR PIVOT - DO I=I1+1,N-1 - A_D(J0+I)=A_D(J0+I)/A_D(J0+I1) - END DO - END IF - END DO -C -C DO INVERT -C - DO I3=0,N-1 !ALL COLUMNS - DO I=0,N-1 !INVERSION TEST - A_D(SOLV+I)=0 - END DO - A_D(SOLV+I3)=1. - DO I=0,N-1 !FORWARD - D0=A_D(SOLV+A_J(PIVV+I)) - A_D(SOLV+A_J(PIVV+I))=A_D(SOLV+I) !PIVOTS - A_D(SOLV+I)=D0 - DO I1=0,I-1 - J0=LAR+N*I1 - A_D(SOLV+I)=A_D(SOLV+I)-A_D(J0+I)*A_D(SOLV+I1) - END DO - END DO - DO I=N-1,0,-1 !BACKWARD - J0=LAR+N*I - DO I1=I+1,N-1 - J1=LAR+N*I1 - A_D(SOLV+I)=A_D(SOLV+I)-A_D(J1+I)*A_D(SOLV+I1) - END DO - A_D(SOLV+I)=A_D(SOLV+I)/A_D(J0+I) - END DO - J0=WNMLGR(MAR,I3) !ROW RESULT - DO I=I3,N-1 !SAVE INVERTED - A_D(J0+I)=A_D(SOLV+I) - END DO - END DO - GOTO 800 - END IF -C -C INVERT CHOLESKY -C - DO I=0,NR-1 - DO I1=0,NR-1 !ALL UNKNOWNS - IF (I.EQ.A_J(PIVV+I1)) THEN - A_D(SOLV+I1)=1 - ELSE - A_D(SOLV+I1)=0 - END IF - DO I2=0,I1-1 - I3=WNMLGR(MAR,I2) !ROW POINTER - A_D(SOLV+I1)=A_D(SOLV+I1)- - 1 A_D(I3+I1)*A_D(SOLV+I2)/A_D(I3+I2) !STEP 1 - END DO - END DO - DO I1=NR-1,0,-1 - I3=WNMLGR(MAR,I1) !ROW POINTER - DO I2=I1+1,NR-1 - A_D(SOLV+I1)=A_D(SOLV+I1)- - 1 A_D(I3+I2)*A_D(SOLV+I2) !SOLUTION - END DO - A_D(SOLV+I1)=A_D(SOLV+I1)/A_D(I3+I1) - END DO -C -C MISSING RANK -C - DO I1=NR,NUN-1 !MAKE B2=-G1'*.X1' - A_D(SOLV+I1)=0 - DO I2=0,NR-1 - I3=WNMLGR(MAR,I2) !ROW POINTER - A_D(SOLV+I1)=A_D(SOLV+I1)- - 1 A_D(SOLV+I2)*A_D(I3+I1) - END DO - END DO -C -C SOLVE X2 -C - DO I1=NR,NUN-1 !ALL UNKNOWNS - DO I2=NR,I1-1 - I3=WNMLGR(MAR,I2) !ROW POINTER - A_D(SOLV+I1)=A_D(SOLV+I1)- - 1 A_D(I3+I1)*A_D(SOLV+I2)/A_D(I3+I2) !STEP 1 - END DO - END DO - DO I1=NUN-1,NR,-1 - I3=WNMLGR(MAR,I1) !ROW POINTER - DO I2=I1+1,NUN-1 - A_D(SOLV+I1)=A_D(SOLV+I1)- - 1 A_D(I3+I2)*A_D(SOLV+I2) !SOLUTION - END DO - A_D(SOLV+I1)=A_D(SOLV+I1)/A_D(I3+I1) - END DO -C -C FINAL X1 -C - IF (NR.LT.N) THEN - DO I1=0,NR-1 - I3=WNMLGR(MAR,I1) !ROW POINTER - DO I2=NR,NUN-1 - A_D(SOLV+I1)=A_D(SOLV+I1)+ - 1 A_D(SOLV+I2)*A_D(I3+I2) - END DO - END DO - END IF -C -C SOLUTION -C - DO I1=0,NUN-1 !SAVE SOLUTION - A_D(LAR+A_J(PIVV+I1)+I*N)=A_D(SOLV+I1) - END DO - END DO -C -C AND AGAIN -C - DO I=0,NUN-1 - DO I1=0,NR-1 !GET CV - A_D(SOLV+I1)=A_D(LAR+I+I1*N) - END DO - DO I1=NR,NUN-1 !MAKE B2=-G1'*.X1' - A_D(SOLV+I1)=0 - DO I2=0,NR-1 - I3=WNMLGR(MAR,I2) !ROW POINTER - A_D(SOLV+I1)=A_D(SOLV+I1)- - 1 A_D(SOLV+I2)*A_D(I3+I1) - END DO - END DO -C -C SOLVE X2 -C - DO I1=NR,NUN-1 !ALL UNKNOWNS - DO I2=NR,I1-1 - I3=WNMLGR(MAR,I2) !ROW POINTER - A_D(SOLV+I1)=A_D(SOLV+I1)- - 1 A_D(I3+I1)*A_D(SOLV+I2)/A_D(I3+I2) !STEP 1 - END DO - END DO - DO I1=NUN-1,NR,-1 - I3=WNMLGR(MAR,I1) !ROW POINTER - DO I2=I1+1,NUN-1 - A_D(SOLV+I1)=A_D(SOLV+I1)- - 1 A_D(I3+I2)*A_D(SOLV+I2) !SOLUTION - END DO - A_D(SOLV+I1)=A_D(SOLV+I1)/A_D(I3+I1) - END DO -C -C FINAL X1 -C - IF (NR.LT.N) THEN - DO I1=0,NR-1 - I3=WNMLGR(MAR,I1) !ROW POINTER - DO I2=NR,NUN-1 - A_D(SOLV+I1)=A_D(SOLV+I1)+ - 1 A_D(SOLV+I2)*A_D(I3+I2) - END DO - END DO - END IF -C -C SOLUTION -C - DO I1=0,NUN-1 !SAVE SOLUTION - A_D(LAR+I+A_J(PIVV+I1)*N)=A_D(SOLV+I1) - END DO - END DO - DO I=0,NUN-1 !SAVE SOLUTION - J0=WNMLGR(MAR,I) !OUTPUT ROW - J1=LAR+I*NUN !INPUT ROW - DO I1=I,NUN-1 - A_D(J0+I1)=A_D(J1+I1) - END DO - END DO - END IF -C -C READY -C - 800 CONTINUE - IF (IAND(A_J(MAR+LSQ_BITS_J),LSQ_U_INVERTED).EQ.0) THEN - LAR=LAR*LB_D+A_OB !FREE AREA - CALL WNGFVA(ALEN,LAR) - END IF - 810 CONTINUE - IF (WNMLIN) - 1 A_J(MAR+LSQ_BITS_J)=IOR(A_J(MAR+LSQ_BITS_J),LSQ_U_INVERTED) !SET -C -C OUTPUT -C - IF (OUT .AND. WNMLIN) THEN - DO I=0,NUN-1 !ALL COLUMNS - J0=WNMLGR(MAR,I) - IF (CV) THEN - DO I1=0,I-1 !RETURN SOLUTION - J1=WNMLGR(MAR,I1) - MU(I1+I*NUN)=A_D(J1+I) - END DO - DO I1=I,NUN-1 - MU(I1+I*NUN)=A_D(J0+I1) - END DO - ELSE - DO I1=0,M-1 - J1=A_J(MAR+LSQ_ERROR_J)+LERR__N*I1 !ERROR AREA - MU(I+I1*NUN)=SQRT(ABS(A_D(J0+I)))*A_D(J1+LERR_CHI2_D) - END DO - END IF - END DO - END IF -C - RETURN -C -C - END diff --git a/src/wng/wnmlmn.for b/src/wng/wnmlmn.for deleted file mode 100644 index c205b891eb2eae46dd342a77612554af8b673438..0000000000000000000000000000000000000000 --- a/src/wng/wnmlmn.for +++ /dev/null @@ -1,356 +0,0 @@ -C+ WNMLMN.FOR -C WNB 950330 -C -C Revisions: -C WNB 950621 Typo in DCOMPLEX/CCOMPLEX; combine CCOMPLEX/DCOMPLEX -C - SUBROUTINE WNMLMN(MAR,TYPE,CE,WT,OB) -C -C Make normal equations from condition equations -C -C Result: -C -C CALL WNMLMN( MAR_J:I, TYPE_J:I, CE_E(0:N-1):I, WT_E:I, OB_E(0:M-1):I) -C Make normal equations in MAR area. -C CE are the coefficients of the condition -C equations, WT is the weight of the observation, -C and OB are the observed values. -C For complex solutions the CE and OB are complex -C values, except for LSQ_C_REAL CE is real. -C The TYPE indicates the type of CE: -C LSQ_C_REAL: N real (default) for LSQ_T_REAL -C and 2N real for LSQ_T_COMPLEX -C LSQ_C_COMPLEX: N complex (default) for -C LSQ_T_COMPLEX -C LSQ_C_CCOMPLEX: 2N complex for LSQ_T_COMPLEX -C (i.e. separate for real and imag part -C of solution) -C LSQ_C_NONORM: do not do normal equations -C LSQ_C_NOKNOWN: do not do known part -C CALL WNMLMC( MAR_J:I, TYPE_J:I, CE_E(0:N-1,0:NC-1):I) -C Set constraint equations CE -C (CE_E(0:2*N-1,0:NC/2-1) for complex) in area -C -C Include files: -C - INCLUDE 'WNG_DEF' - INCLUDE 'LSQ_O_DEF' -C -C Parameters: -C -C -C Arguments: -C - INTEGER MAR !AREA POINTER - INTEGER TYPE !TYPE - REAL CE(0:*) !CONDITION EQUATIONS - REAL WT !OBSERVING WEIGHT - REAL OB(0:*) !OBSERVED VALUES -C -C Function references: -C - INTEGER WNMLGR !GET ROW POINTER - INTEGER WNMLGK !GET KNOWN COLUMN -C -C Data declarations: -C - INTEGER N,M !UNKNOWNS, KNOWNS - DOUBLE COMPLEX DCI,DCJ !COMPLEX AID -C- -C -C -C WNMLMN -C - N=A_J(MAR+LSQ_NUN_J) !# OF UNKNOWNS - M=A_J(MAR+LSQ_M_J) !# OF KNOWNS -C -C PREPARE FOR CCOMPLEX -C - IF (IAND(A_J(MAR+LSQ_BITS_J),LSQ_T_COMPLEX).NE.0) THEN !COMPLEX - IF (IAND(TYPE,LSQ_C_CCOMPLEX).NE.0) THEN !COMPLEX CONJUGATE - DO I=0,N-1,2 !MAKE DCOMPLEX DATA - DO I1=0,1 - R0=CE(2*I+I1)+CE(2*I+2+I1) - CE(2*I+2+I1)=CE(2*I+I1)-CE(2*I+2+I1) - CE(2*I+I1)=R0 - END DO - END DO - END IF - END IF -C -C NORMAL EQUATIONS -C - IF (IAND(TYPE,LSQ_C_NONORM).EQ.0) THEN !MAKE NORMAL EQUATIONS -C -C COMPLEX -C - IF (IAND(A_J(MAR+LSQ_BITS_J),LSQ_T_COMPLEX).NE.0) THEN !COMPLEX -C -C RCOMPLEX -C - IF (IAND(TYPE,LSQ_C_REAL).NE.0) THEN !REAL SEPARABLE - DO I=0,N-1,2 - I2=WNMLGR(MAR,I) - R0=CE(I)*WT - R1=CE(I+1)*WT - IF (R0.NE.0) THEN - DO I1=I,N-1,2 !REAL PART - IF (CE(I1).NE.0) THEN - A_D(I2+I1)=A_D(I2+I1)+CE(I1)*R0 !EQUATIONS - END IF - END DO - END IF - I2=WNMLGR(MAR,I+1) !NEXT LINE - IF (R1.NE.0) THEN - DO I1=I+1,N-1,2 !IMAG PART - IF (CE(I1).NE.0) THEN - A_D(I2+I1)=A_D(I2+I1)+CE(I1)*R1 !EQUATIONS - END IF - END DO - END IF - END DO -C -C D/CCOMPLEX -C - ELSE IF (IAND(TYPE,LSQ_C_DCOMPLEX+LSQ_C_CCOMPLEX).NE.0) - 1 THEN !SEPARABLE COMPLEX - DO I=0,N-1,2 - DCI=CMPLX(CE(2*I),CE(2*I+1))*WT - IF (DCI.NE.0) THEN - I2=WNMLGR(MAR,I) !ROW POINTER - DO I1=I,N-1,2 - DCJ=CMPLX(CE(2*I1),-CE(2*I1+1)) - A_D(I2+I1)=A_D(I2+I1)+ - 1 DBLE(DCI*DCJ) - DCJ=CMPLX(CE(2*I1+2),-CE(2*I1+3)) - A_D(I2+I1+1)=A_D(I2+I1+1)+ - 1 DIMAG(DCI*DCJ) - END DO - END IF - END DO - DO I=1,N-1,2 - DCI=CMPLX(CE(2*I),CE(2*I+1))*WT - IF (DCI.NE.0) THEN - I2=WNMLGR(MAR,I) !ROW POINTER - DO I1=I,N-2,2 - DCJ=CMPLX(CE(2*I1),-CE(2*I1+1)) - A_D(I2+I1)=A_D(I2+I1)+ - 1 DBLE(DCI*DCJ) - DCJ=CMPLX(CE(2*I1+2),-CE(2*I1+3)) - A_D(I2+I1+1)=A_D(I2+I1+1)- - 1 DIMAG(DCI*DCJ) - END DO - DO I1=N-1,N-1 - DCJ=CMPLX(CE(2*I1),-CE(2*I1+1)) - A_D(I2+I1)=A_D(I2+I1)+ - 1 DBLE(DCI*DCJ) - END DO - END IF - END DO -C -C COMPLEX -C - ELSE !NORMAL COMPLEX - DO I=0,N-1,2 - DCI=CMPLX(CE(I),CE(I+1))*WT - IF (DCI.NE.0) THEN - I2=WNMLGR(MAR,I) !ROW POINTER - DO I1=I,N-1,2 - DCJ=CMPLX(CE(I1),-CE(I1+1)) - A_D(I2+I1)=A_D(I2+I1)+ - 1 DBLE(DCI*DCJ) !REAL EQUATIONS - A_D(I2+I1+1)=A_D(I2+I1+1)+ - 1 DIMAG(DCI*DCJ) !IMAG. EQUATIONS - END DO - I4=WNMLGR(MAR,I+1) !NEXT LINE ROW POINTER - DO I1=I+1,N-1,2 !DUPLICATE - A_D(I4+I1)=A_D(I2+I1-1) - END DO - DO I1=I+2,N-1,2 - A_D(I4+I1)=-A_D(I2+I1+1) - END DO - END IF - END DO - END IF -C -C REAL -C - ELSE !REAL - DO I=0,N-1 - IF (CE(I).NE.0) THEN - I2=WNMLGR(MAR,I) !ROW POINTER - DO I1=I,N-1 - IF (CE(I1).NE.0) THEN - A_D(I2+I1)=A_D(I2+I1)+CE(I)*CE(I1)*WT !EQUATIONS - END IF - END DO - END IF - END DO - END IF - END IF -C -C KNOWN PART -C - IF (IAND(TYPE,LSQ_C_NOKNOWN).EQ.0) THEN !MAKE KNOWN EQUATIONS -C -C COMPLEX -C - IF (IAND(A_J(MAR+LSQ_BITS_J),LSQ_T_COMPLEX).NE.0) THEN !COMPLEX -C -C RCOMPLEX -C - IF (IAND(TYPE,LSQ_C_REAL).NE.0) THEN !REAL SEPARABLE - DO I=0,M-1 - I2=WNMLGK(MAR,I) !KNOWN COLUMN - DO I1=0,N-1,2 - R0=CE(I1)*WT - IF (R0.NE.0) THEN - A_D(I2+I1)=A_D(I2+I1)+R0*OB(2*I) !REAL PART - END IF - R0=CE(I1+1)*WT - IF (R0.NE.0) THEN - A_D(I2+I1+1)=A_D(I2+I1+1)+R0*OB(2*I+1) !IMAG. PART - END IF - END DO - END DO -C -C D/CCOMPLEX -C - ELSE IF (IAND(TYPE,LSQ_C_DCOMPLEX+LSQ_C_CCOMPLEX).NE.0) - 1 THEN !SEPARABLE COMPLEX - DO I=0,M-1 - I2=WNMLGK(MAR,I) !KNOWN COLUMN - DCI=CMPLX(OB(2*I),OB(2*I+1))*WT - DO I1=0,N-1,2 - DCJ=CMPLX(CE(2*I1),-CE(2*I1+1)) - A_D(I2+I1)=A_D(I2+I1)+ - 1 DBLE(DCJ*DCI) - DCJ=CMPLX(CE(2*I1+2),-CE(2*I1+3)) - A_D(I2+I1+1)=A_D(I2+I1+1)+ - 1 DIMAG(DCJ*DCI) - END DO - END DO -C -C COMPLEX -C - ELSE !NORMAL COMPLEX - DO I=0,M-1 - I2=WNMLGK(MAR,I) !KNOWN COLUMN - DCI=CMPLX(OB(2*I),OB(2*I+1))*WT - DO I1=0,N-1,2 - DCJ=CMPLX(CE(I1),-CE(I1+1)) - A_D(I2+I1)=A_D(I2+I1)+ - 1 DBLE(DCI*DCJ) - A_D(I2+I1+1)=A_D(I2+I1+1)+ - 1 DIMAG(DCI*DCJ) - END DO - END DO - END IF -C -C COMPLEX ERRORS -C - DO I=0,M-1 - I2=WNMLGK(MAR,I) !KNOWN COLUMN - DCI=CMPLX(OB(2*I),OB(2*I+1)) - I4=A_J(MAR+LSQ_ERROR_J)+I*LERR__N - A_D(I4+LERR_N_D)=A_D(I4+LERR_N_D)+2 !CNT EQUATIONS - A_D(I4+LERR_W_D)=A_D(I4+LERR_W_D)+2*WT !SUM WEIGHT - A_D(I4+LERR_LL_D)=A_D(I4+LERR_LL_D)+ - 1 WT*DBLE(DCI*CONJG(DCI)) !SUM RMS - END DO -C -C REAL -C - ELSE !REAL - DO I=0,M-1 - I2=WNMLGK(MAR,I) !KNOWN COLUMN - DO I1=0,N-1 - IF (CE(I1).NE.0) THEN - A_D(I2+I1)=A_D(I2+I1)+CE(I1)*OB(I)*WT !DATA VECTOR - END IF - END DO - I4=A_J(MAR+LSQ_ERROR_J)+I*LERR__N - A_D(I4+LERR_N_D)=A_D(I4+LERR_N_D)+1 !CNT EQUATIONS - A_D(I4+LERR_W_D)=A_D(I4+LERR_W_D)+WT !SUM WEIGHT - A_D(I4+LERR_LL_D)=A_D(I4+LERR_LL_D)+ - 1 WT*OB(I)*OB(I) !SUM RMS - END DO - END IF - END IF -C - RETURN -C -C WNMLMC -C - ENTRY WNMLMC(MAR,TYPE,CE) -C -C COMPLEX -C - IF (IAND(A_J(MAR+LSQ_BITS_J),LSQ_T_COMPLEX).NE.0 .AND. - 1 IAND(TYPE,LSQ_C_REAL).EQ.0) THEN - DO I=0,(A_J(MAR+LSQ_N_J)-A_J(MAR+LSQ_NUN_J))/2-1 !ALL - !CONSTRAINTS - IF (IAND(TYPE,LSQ_C_DCOMPLEX+LSQ_C_CCOMPLEX).NE.0) THEN - I3=2*I*A_J(MAR+LSQ_NUN_J) !POINTER CE ROW - DO I1=0,A_J(MAR+LSQ_NUN_J)-1,2 !ALL UNKNOWNS - I2=WNMLGR(MAR,I1) !ROW POINTER -C -C DCOMPLEX -C - IF (IAND(TYPE,LSQ_C_DCOMPLEX).NE.0) THEN - A_D(I2+I+A_J(MAR+LSQ_NUN_J))=CE(I3+I1) - A_D(I2+I+A_J(MAR+LSQ_NUN_J)+1)=CE(I3+I1+1) -C -C CCOMPLEX -C - ELSE IF (IAND(TYPE,LSQ_C_CCOMPLEX).NE.0) THEN - A_D(I2+I+A_J(MAR+LSQ_NUN_J))=CE(I3+I1)+CE(I3+I1+2) - A_D(I2+I+A_J(MAR+LSQ_NUN_J)+1)=CE(I3+I1+1)+CE(I3+I1+3) - END IF - I2=WNMLGR(MAR,I1+1) !ROW POINTER -C -C DCOMPLEX -C - IF (IAND(TYPE,LSQ_C_DCOMPLEX).NE.0) THEN - A_D(I2+I+A_J(MAR+LSQ_NUN_J))=-CE(I3+I1+3) - A_D(I2+I+A_J(MAR+LSQ_NUN_J)+1)=CE(I3+I1+2) -C -C CCOMPLEX -C - ELSE IF (IAND(TYPE,LSQ_C_CCOMPLEX).NE.0) THEN - A_D(I2+I+A_J(MAR+LSQ_NUN_J))=-CE(I3+I1+1)+CE(I3+I1+3) - A_D(I2+I+A_J(MAR+LSQ_NUN_J)+1)=CE(I3+I1)-CE(I3+I1+2) - END IF - END DO - ELSE -C -C COMPLEX -C - I3=I*A_J(MAR+LSQ_NUN_J) !POINTER CE ROW - DO I1=0,A_J(MAR+LSQ_NUN_J)-1,2 !ALL UNKNOWNS - I2=WNMLGR(MAR,I1) !ROW POINTER - A_D(I2+I+A_J(MAR+LSQ_NUN_J))=CE(I3+I1) - A_D(I2+I+A_J(MAR+LSQ_NUN_J)+1)=CE(I3+I1+1) - I2=WNMLGR(MAR,I1+1) !ROW POINTER - A_D(I2+I+A_J(MAR+LSQ_NUN_J))=-CE(I3+I1+1) - A_D(I2+I+A_J(MAR+LSQ_NUN_J)+1)=CE(I3+I1) - END DO - END IF - END DO - ELSE -C -C REAL -C - DO I=A_J(MAR+LSQ_NUN_J),A_J(MAR+LSQ_N_J)-1 !ALL CONSTRAINTS - I3=(I-A_J(MAR+LSQ_NUN_J))*A_J(MAR+LSQ_NUN_J) !POINTER CE ROW - DO I1=0,A_J(MAR+LSQ_NUN_J)-1 !ALL UNKNOWNS - I2=WNMLGR(MAR,I1) !ROW POINTER - A_D(I2+I)=CE(I3+I1) - END DO - END DO - END IF -C - RETURN -C -C - END diff --git a/src/wng/wnmlsn.for b/src/wng/wnmlsn.for deleted file mode 100644 index 14221025289773a2e0bb3585c5c960e44063c2d2..0000000000000000000000000000000000000000 --- a/src/wng/wnmlsn.for +++ /dev/null @@ -1,185 +0,0 @@ -C+ WNMLSN.FOR -C WNB 950330 -C -C Revisions: -C - SUBROUTINE WNMLSN(MAR,SOL,MU,SD) -C -C Solve triangular normal equations with rank defects -C -C Result: -C -C CALL WNMLSN( MAR_J:O, SOL_E(0:N-1,0:M-1):O, MU_E(0:M-1):O, -C SD_E(0:M-1):O) -C Solve triangular normal equations. MAR gives -C the matrix. -C The solution will be given in SOL, with the -C adjustment error MU, and the standard -C deviation in SD. I.e. MU is per weight, -C SD per observation. -C -C Include files: -C - INCLUDE 'WNG_DEF' - INCLUDE 'LSQ_O_DEF' -C -C Parameters: -C -C -C Arguments: -C - INTEGER MAR !AREA POINTER - REAL SOL(0:*) !SOLUTION - REAL MU(0:*) !ADJUSTMENT ERROR - REAL SD(0:*) !STANDARD DEVIATION -C -C Entry points: -C -C -C Function references: -C - INTEGER WNMLGR !GET ROW POINTER ARRAY - INTEGER WNMLGK !GET KNOWN COLUMN -C -C Data declarations: -C - INTEGER NUN !# OF UNKNOWNS - INTEGER M !# OF KNOWNS - INTEGER N !# TO SOLVE - INTEGER NR !RANK - INTEGER KNV !KNOWN VECTOR POINTER - INTEGER ERV !ERROR VECTOR POINTER - INTEGER PIVV !PIVOT VECTOR POINTER - INTEGER SOLV !SOLUTION VECTOR POINTER - DOUBLE PRECISION DMU !FOR M.E. -C- -C -C INTRO -C - N=A_J(MAR+LSQ_N_J) !# TO SOLVE - M=A_J(MAR+LSQ_M_J) !# KNOWNS - NUN=A_J(MAR+LSQ_NUN_J) !# UNKNOWNS - NR=A_J(MAR+LSQ_R_J) !RANK - ERV=A_J(MAR+LSQ_ERROR_J)-LERR__N !ERROR VECTOR - PIVV=A_J(MAR+LSQ_PIV_J) !PIVOT TABLE - SOLV=A_J(MAR+LSQ_SOL_J) !SOLUTION AREA -C -C SOLVE -C - DO I=0,M-1 !FOR ALL DATA VECTORS - ERV=ERV+LERR__N !POINTER ERROR VECTOR - KNV=WNMLGK(MAR,I) !POINTER KNOWN VECTOR -C -C INVERTED PRESENT -C - IF (IAND(A_J(MAR+LSQ_BITS_J),LSQ_U_INVERTED).NE.0) THEN - DO I1=0,NR-1 !ALL UNKNOWNS - J0=WNMLGR(MAR,I1) - A_D(SOLV+I1)=0 - DO I2=0,I1-1 - J1=WNMLGR(MAR,I2) - A_D(SOLV+I1)=A_D(SOLV+I1)+A_D(J1+I1)*A_D(KNV+I2) - END DO - DO I2=I1,NR-1 - A_D(SOLV+I1)=A_D(SOLV+I1)+A_D(J0+I2)*A_D(KNV+I2) - END DO - END DO - DMU=0 - DO I1=0,NR-1 - DMU=DMU+A_D(SOLV+I1)*A_D(KNV+I1) !MAKE RMS - END DO - DMU=A_D(ERV+LERR_LL_D)-DMU !CHI**2 - SD(I)=SQRT(MAX(0D0,DMU/MAX(1D0,A_D(ERV+LERR_N_D)-NUN))) !PER OBS. - A_D(ERV+LERR_CHI2_D)=SD(I) !SAVE - IF (A_D(ERV+LERR_W_D).GT.0D0) DMU=DMU/A_D(ERV+LERR_W_D) !PER - !WEIGHT - DMU=DMU*A_D(ERV+LERR_N_D) - MU(I)=SQRT(MAX(0D0,DMU/MAX(1D0,A_D(ERV+LERR_N_D)-NUN))) !PER WEIGHT - DO I1=0,N-1 !RETURN SOLUTION - SOL(I1+I*N)=A_D(SOLV+I1) - END DO -C -C SOLVE -C - ELSE - DO I1=0,NR-1 !ALL UNKNOWNS - A_D(SOLV+I1)=A_D(KNV+A_J(PIVV+I1)) - DO I2=0,I1-1 - I3=WNMLGR(MAR,I2) !ROW POINTER - A_D(SOLV+I1)=A_D(SOLV+I1)- - 1 A_D(I3+I1)*A_D(SOLV+I2)/A_D(I3+I2) !STEP 1 - END DO - END DO - DO I1=NR-1,0,-1 - I3=WNMLGR(MAR,I1) !ROW POINTER - DO I2=I1+1,NR-1 - A_D(SOLV+I1)=A_D(SOLV+I1)- - 1 A_D(I3+I2)*A_D(SOLV+I2) !SOLUTION - END DO - A_D(SOLV+I1)=A_D(SOLV+I1)/A_D(I3+I1) - END DO - DMU=0 - DO I1=0,NR-1 - DMU=DMU+A_D(SOLV+I1)*A_D(KNV+A_J(PIVV+I1)) !MAKE RMS - END DO - DMU=A_D(ERV+LERR_LL_D)-DMU !CHI**2 - SD(I)=SQRT(MAX(0D0,DMU/MAX(1D0,A_D(ERV+LERR_N_D)-NUN))) !PER OBS. - A_D(ERV+LERR_CHI2_D)=SD(I) !SAVE - IF (A_D(ERV+LERR_W_D).GT.0D0) DMU=DMU/A_D(ERV+LERR_W_D) !PER - !WEIGHT - DMU=DMU*A_D(ERV+LERR_N_D) - MU(I)=SQRT(MAX(0D0,DMU/MAX(1D0,A_D(ERV+LERR_N_D)-NUN))) !PER WEIGHT -C -C MISSING RANK -C - DO I1=NR,N-1 !MAKE B2=-G1'*.X1' - A_D(SOLV+I1)=0 - DO I2=0,NR-1 - I3=WNMLGR(MAR,I2) !ROW POINTER - A_D(SOLV+I1)=A_D(SOLV+I1)- - 1 A_D(SOLV+I2)*A_D(I3+I1) - END DO - END DO -C -C SOLVE X2 -C - DO I1=NR,N-1 !ALL UNKNOWNS - DO I2=NR,I1-1 - I3=WNMLGR(MAR,I2) !ROW POINTER - A_D(SOLV+I1)=A_D(SOLV+I1)- - 1 A_D(I3+I1)*A_D(SOLV+I2)/A_D(I3+I2) !STEP 1 - END DO - END DO - DO I1=N-1,NR,-1 - I3=WNMLGR(MAR,I1) !ROW POINTER - DO I2=I1+1,N-1 - A_D(SOLV+I1)=A_D(SOLV+I1)- - 1 A_D(I3+I2)*A_D(SOLV+I2) !SOLUTION - END DO - A_D(SOLV+I1)=A_D(SOLV+I1)/A_D(I3+I1) - END DO -C -C FINAL X1 -C - IF (NR.LT.N) THEN - DO I1=0,NR-1 - I3=WNMLGR(MAR,I1) !ROW POINTER - DO I2=NR,N-1 - A_D(SOLV+I1)=A_D(SOLV+I1)+ - 1 A_D(SOLV+I2)*A_D(I3+I2) - END DO - END DO - END IF -C -C SOLUTION -C - DO I1=0,N-1 !RETURN SOLUTION - SOL(A_J(PIVV+I1)+I*N)=A_D(SOLV+I1) - END DO - END IF - END DO -C - RETURN -C -C - END diff --git a/src/wng/wnmltn.for b/src/wng/wnmltn.for deleted file mode 100644 index 355b92444d7bc3aedecc001c02497ab2f6f59e2a..0000000000000000000000000000000000000000 --- a/src/wng/wnmltn.for +++ /dev/null @@ -1,286 +0,0 @@ -C+ WNMLTN.FOR -C WNB 950330 -C -C Revisions: -C WNB 950615 Typo -C - LOGICAL FUNCTION WNMLTN(MAR) -C -C Triangularize normal equations -C -C Result: -C -C WNMLTN_L = WNMLTN( MAR_J:I) -C Triangularize normal equations: FALSE if -C non-invertable normal array -C WNMLTR_L = WNMLTR( MAR_J:O, NR_J:O) -C Triangularize normal equations and determine -C the rank NR and the constraint equations. -C Note: in the case of complex equations, -C the rank NR can be up to 2N -C WNMLNN_L = WNMLNN( MAR_J:I, 0, SOL_E(0:*):IO, MU_E:O, FIT_E:O) -C Do non-linear loop . SOL will -C be updated. MU returns the error per weight -C (as in WNMLSN); and FIT a loop indication. -C If FIT>0 should always loop further; if -C abs(FIT)<0.001 you cannot do better. -C WNMLNR_L = WNMLNR( MAR_J:O, NR_J:O, SOL_E(0:*):IO, MU_E:O, FIT_E:O) -C As WNMLNN, but for dependent equations -C Note that both non-linears can only have M=1 -C -C Include files: -C - INCLUDE 'WNG_DEF' - INCLUDE 'LSQ_O_DEF' -C -C Parameters: -C -C -C Arguments: -C - INTEGER MAR !AREA POINTER - INTEGER NR !RANK OF NORMAL - !EQUATIONS - REAL SOL(0:*) !INPUT/OUTPUT SOLUTION - REAL MU !ERROR PER WEIGHT - REAL FIT !GOODNESS OF FIT -C -C Entry points: -C - LOGICAL WNMLTR - LOGICAL WNMLNN,WNMLNR -C -C Function references: -C - INTEGER WNMLGR !GET ROW POINTER - INTEGER WNMLGK !GET KNOWN COLUMN POINTER - LOGICAL WNMLGA !GET AREA - LOGICAL WNMLIN !INVERT MATRIX - LOGICAL WNGGVA !GET MEMORY - LOGICAL WNMLMT,WNMLMF !COPY PART OF LSQ AREA -C -C Data declarations: -C - INTEGER N - LOGICAL RANK !DETERMINE RANK - DOUBLE PRECISION FAC !NON-LIN FACTOR - DOUBLE PRECISION PREC !PRECISION TEST - INTEGER CAR !COPY AREA -C- -C -C WNMLTN -C - RANK=.FALSE. !NO RANK - A_J(MAR+LSQ_BITS_J)=IAND(A_J(MAR+LSQ_BITS_J),NOT(LSQ_U_NONLIN)) !LINEAR - WNMLTN=.TRUE. - GOTO 10 -C -C WNMLNN (NON-LINEAR) -C - ENTRY WNMLNN(MAR,NR,SOL,MU,FIT) -C - RANK=.FALSE. !NO RANK - GOTO 11 -C -C WNMLTR -C - ENTRY WNMLTR(MAR,NR) -C - RANK=.TRUE. !RANK - A_J(MAR+LSQ_BITS_J)=IAND(A_J(MAR+LSQ_BITS_J),NOT(LSQ_U_NONLIN)) !LINEAR - WNMLTN=.TRUE. - GOTO 10 -C -C WNMLNR (NON-LINEAR) -C - ENTRY WNMLNR(MAR,NR,SOL,MU,FIT) -C - RANK=.TRUE. !RANK - GOTO 11 -C -C INTRO -C - 11 CONTINUE - WNMLTN=.TRUE. - IF (A_J(MAR+LSQ_NAR_J).EQ.0) THEN !GET SAVE AREA - IF (A_J(MAR+LSQ_M_J).NE.1) THEN !ONLY ALLOWED - !FOR M=1 - WNMLTN=.FALSE. - GOTO 800 - END IF - WNMLTN=WNMLGA(A_J(MAR+LSQ_NAR_J),LSQ_T_NOINIT, - 1 A_J(MAR+LSQ_N_J)) !GET AREA - IF (.NOT.WNMLTN) GOTO 800 !ERROR - END IF - CAR=A_J(MAR+LSQ_NAR_J) !COPY AREA - IF (IAND(A_J(MAR+LSQ_BITS_J),LSQ_U_NONLIN).EQ.0) THEN !FIRST TIME - WNMLTN=WNMLMF(MAR,CAR) !SAVE AREA INFO - FIT=1. !LOOP MORE - ELSE - D0=ABS(A_D(A_J(MAR+LSQ_ERROR_J)+LERR_LL_D)+ - 1 A_D(A_J(CAR+LSQ_ERROR_J)+LERR_LL_D))/2. - IF (D0.GT.0) THEN - FIT=(A_D(A_J(MAR+LSQ_ERROR_J)+LERR_LL_D)- - 1 A_D(A_J(CAR+LSQ_ERROR_J)+LERR_LL_D))/D0 - ELSE - FIT=-1E-8 !DUMMY FIT - END IF - IF (FIT.LT.0) THEN !BETTER ESTIMATE - A_D(A_J(MAR+LSQ_DBL_J)+LSQ_NONLIN_D)= - 1 A_D(A_J(MAR+LSQ_DBL_J)+LSQ_NONLIN_D)*0.1 !NEW FACTOR - WNMLTN=WNMLMF(MAR,CAR) !SAVE AREA INFO - ELSE !NO FIT - A_D(A_J(MAR+LSQ_DBL_J)+LSQ_NONLIN_D)= - 1 A_D(A_J(MAR+LSQ_DBL_J)+LSQ_NONLIN_D)*10. !NEW FACTOR - I0=A_J(CAR+LSQ_SOL_J)*LB_D/LB_E - DO I=0,A_J(MAR+LSQ_NUN_J)-1 - SOL(I)=SOL(I)-A_E(I0+I) !OLD SOLUTION - END DO - WNMLTN=WNMLMT(MAR,CAR) !RESTORE AREA INFO - END IF - END IF - A_J(MAR+LSQ_BITS_J)=IOR(A_J(MAR+LSQ_BITS_J),LSQ_U_NONLIN) !SET NON-LIN - FAC=1D0+A_D(A_J(MAR+LSQ_DBL_J)+LSQ_NONLIN_D) !FACTOR - CALL WNMLIF(MAR,FAC) !MAKE DIAGONAL -C -C LINEAR -C - 10 CONTINUE - CALL WNMLID(MAR) !NON-ZERO DIAGONAL - PREC=A_D(A_J(MAR+LSQ_DBL_J)+LSQ_FACTOR_D) !TEST FACTOR - N=A_J(MAR+LSQ_N_J) !# TO SOLVE -C -C WITH CONSTRAINTS -C - IF (A_J(MAR+LSQ_NUN_J).NE.A_J(MAR+LSQ_N_J)) THEN - WNMLTN=WNMLIN(MAR) !DO LU INVERSION - GOTO 800 !READY - END IF -C -C DECOMPOSE -C - DO I=0,N-1 !DECOMPOSE - IF (I.LT.A_J(MAR+LSQ_R_J)) THEN !STILL RANK LEFT - I3=WNMLGR(MAR,I) !ROW POINTER - 20 CONTINUE - D0=A_D(I3+I) !GET COLLINEARITY - DO I2=0,I-1 - I4=WNMLGR(MAR,I2) !ROW POINTER - D0=D0-A_D(I4+I)*A_D(I4+I)/A_D(I4+I2) - END DO - IF (D0*D0/A_D(I3+I).LE.PREC) THEN !DEPENDANCY - IF (.NOT.RANK) THEN !SHOULD BE OK - WNMLTN=.FALSE. - GOTO 800 - END IF - IF (I.LT.A_J(MAR+LSQ_R_J)-1) THEN !RANK LEFT - J0=A_J(MAR+LSQ_R_J)-1 !RANK POINTER - DO I2=0,I-1 !SHIFT PIVOT - I4=WNMLGR(MAR,I2) !ROW POINTER - D1=A_D(I4+I) - A_D(I4+I)=A_D(I4+J0) - A_D(I4+J0)=D1 - END DO - D1=A_D(I3+I) - I4=WNMLGR(MAR,J0) !ROW POINTER - A_D(I3+I)=A_D(I4+J0) - A_D(I4+J0)=D1 - DO I2=I+1,J0-1 - I4=WNMLGR(MAR,I2) !ROW POINTER - D1=A_D(I3+I2) - A_D(I3+I2)=A_D(I4+J0) - A_D(I4+J0)=D1 - END DO - I4=WNMLGR(MAR,J0) !ROW POINTER - DO I2=J0+1,N-1 !SHIFT PIVOT - D1=A_D(I3+I2) - A_D(I3+I2)=A_D(I4+I2) - A_D(I4+I2)=D1 - END DO - A_J(MAR+LSQ_R_J)=A_J(MAR+LSQ_R_J)-1 !DECREASE RANK - J2=A_J(MAR+LSQ_PIV_J) !PIVOT TABLE - I1=A_J(J2+I) !SWITCH PIVOTS - A_J(J2+I)=A_J(J2+J0) - A_J(J2+J0)=I1 - GOTO 20 !RETRY - ELSE - A_J(MAR+LSQ_R_J)=I !SET RANK - END IF - END IF - A_D(I3+I)=D0 !DIAGONAL - DO I1=I+1,N-1 !LU DECOMPOSITION - DO I2=0,I-1 - I4=WNMLGR(MAR,I2) !ROW POINTER - A_D(I3+I1)=A_D(I3+I1)-A_D(I4+I)*A_D(I4+I1)/A_D(I4+I2) - END DO - END DO - END IF - END DO -C -C CONSTRAINTS -C - J0=A_J(MAR+LSQ_R_J) !RANK - DO I1=J0,N-1 - DO I=J0-1,0,-1 - I3=WNMLGR(MAR,I) !ROW POINTER - DO I2=I+1,J0-1 - I4=WNMLGR(MAR,I2) !ROW POINTER - A_D(I3+I1)=A_D(I3+I1)+A_D(I3+I2)*A_D(I4+I1) - END DO - A_D(I3+I1)=-A_D(I3+I1)/A_D(I3+I) - END DO - END DO -C -C RANK BASIS (A=I+G1'*.G1') -C - DO I=J0,N-1 - I3=WNMLGR(MAR,I) !ROW POINTER - DO I1=I,N-1 - A_D(I3+I1)=0 - DO I2=0,J0-1 - I4=WNMLGR(MAR,I2) !ROW POINTER - A_D(I3+I1)=A_D(I3+I1)+A_D(I4+I)*A_D(I4+I1) - END DO - END DO - A_D(I3+I)=1+A_D(I3+I) - END DO -C -C TRIANGULAR A -C - DO I=J0,N-1 - I3=WNMLGR(MAR,I) !ROW POINTER - DO I1=I,N-1 - DO I2=J0,I-1 - I4=WNMLGR(MAR,I2) !ROW POINTER - A_D(I3+I1)=A_D(I3+I1)-A_D(I4+I)*A_D(I4+I1)/A_D(I4+I2) - END DO - END DO - END DO -C - IF (RANK) NR=A_J(MAR+LSQ_R_J) !RANK -C -C READY -C - 800 CONTINUE - IF (.NOT.WNMLTN) THEN !ERROR - A_J(MAR+LSQ_BITS_J)=IAND(A_J(MAR+LSQ_BITS_J), - 1 NOT(LSQ_U_TRIANGLE+LSQ_U_NONLIN)) - ELSE - A_J(MAR+LSQ_BITS_J)=IOR(A_J(MAR+LSQ_BITS_J),LSQ_U_TRIANGLE) -C -C SOLVE NON-LINEAR -C - IF (IAND(A_J(MAR+LSQ_BITS_J),LSQ_U_NONLIN).NE.0) THEN - I0=A_J(CAR+LSQ_SOL_J)*LB_D/LB_E - CALL WNMLSN(MAR,A_E(I0),MU,R0) - DO I=0,A_J(MAR+LSQ_NUN_J)-1 - SOL(I)=SOL(I)+A_E(I0+I) !NEW SOLUTION - END DO - CALL WNMLIA(MAR,LSQ_I_SOL) !RESET AREA - END IF - END IF -C - RETURN -C -C - END diff --git a/src/wng/wnmrnd.cun b/src/wng/wnmrnd.cun deleted file mode 100644 index 99261f56e355c6dd65900b694f09bfcc95afa6c0..0000000000000000000000000000000000000000 --- a/src/wng/wnmrnd.cun +++ /dev/null @@ -1,65 +0,0 @@ -/*+ wnmrnd.cun -. WNB 911125 -. -. Revisions: -. WNB 921216 Make CUN -... */ - long wnmrin_(seed) -/* -. Random numbers (for WNP) -. -. Result: -. -. wnmrin_( SEED_J:I) Initiatial seed -. wnmrnj_J = wnmrnj_() Random value -... */ -/* -. Arguments: -... */ - unsigned int *seed; /* seed */ -{ -/* -. Include files: -... */ -/* -. Parameters: -... */ -/* -. Function references: -... */ -#ifdef wn_hp__ - void srand(); -#else - void srandom(); -#endif -/* -. Data declarations: -... */ -/*- */ -/* Set seed -. */ -#ifdef wn_hp__ - srand(*seed); -#else - srandom(*seed); -#endif - return; -} -/* Random value -. */ - long wnmrnj_() -{ -/* -. Function references: -... */ -#ifdef wn_hp__ - long rand(); - return(rand()); -#else - long random(); - return(random()); -#endif -} -/* -. -... */ diff --git a/src/wng/wnmrnd.mvx b/src/wng/wnmrnd.mvx deleted file mode 100644 index fa2befb28cf16631f3e32de0468686fb7e7d6a1b..0000000000000000000000000000000000000000 --- a/src/wng/wnmrnd.mvx +++ /dev/null @@ -1,58 +0,0 @@ -;+ WNMRND.MVX -; WNB 911125 -; -; Revisions: -; - .TITLE WNMRND RANDOM NUMBER GENERATOR - .IDENT /WNB.01/ -; -; Random number generator (mainly for WNP) -; -; Result: -; -; CALL WNMRIN( SEED_J:I) Initiate generator -; J = WNMRNJ() Random value -; -; Program section: -; - .PSECT WNCODE,PIC,USR,CON,REL,LCL,SHR,EXE,RD,NOWRT,NOVEC,LONG -; -; Symbol definition: -; -; -; Global references: -; -; -; Commons: -; -;- - .PAGE - .SUBTITLE RANDOM INITIATOR -; -.ENTRY WNMRIN,0 -; - MOVL #3,SEED ;SET SEED - RET -; - .PAGE - .SUBTITLE RETURN RANDOM VALUE -; -.ENTRY WNMRNJ,0 -; -;; MULL3 SEED,#69069,R0 - MULL3 SEED,#843314861,R0 - ADDL #453816693,R0 -;; INCL R0 - MOVL R0,SEED - RET -; - .PAGE - .SUBTITLE DATA -; - .PSECT WNDATA,PIC,USR,CON,REL,LCL,SHR,NOEXE,RD,WRT,NOVEC,LONG -; -SEED: .LONG 3 -; -; -; - .END diff --git a/src/wng/wnp.grp b/src/wng/wnp.grp deleted file mode 100644 index 2384a10aaa0d5a6fc28ca01d28baadc30f85d821..0000000000000000000000000000000000000000 --- a/src/wng/wnp.grp +++ /dev/null @@ -1,197 +0,0 @@ -!+ WNP.GRP -! WNB 910623 -! -! Revisions: -! WNB 920130 Add WNPEX2 -! WNB 921021 Add A3 plotter (WQ_EAL.DSC, WQ_EAP, WQ_PAL, WQ_PAP) -! WNQEPS.FOR entry points -! WNB 930108 Add XAW -! HjV 930309 Add X11 (WQ_XWI.DSC, WNQXWI.FOR) -! WNB 930402 Add PGPLOT routines; delete XAW -! HjV 930607 Change WNQXWI.FOR into WNQXWI.FSC -! HjV 950711 Change names of PS/EPS DSC-files -! Add DSC-files and entry-points for A0/A1/A2-plotter -! AXC 010628 linux port -! General plot routines -! -! Group definition: -! -WNP.GRP -! -! Structure files -! -WQD.DSC !Plot device lay-out -WQF.DSC !Font lay-out -WQI.DSC !2-dimensional plot layout -! -! Plot devices -! -WQ_EL0.DSC !EPS A0 landscape -WQ_EP0.DSC !EPS A0 portrait -WQ_EL1.DSC !EPS A1 landscape -WQ_EP1.DSC !EPS A1 portrait -WQ_EL2.DSC !EPS A2 landscape -WQ_EP2.DSC !EPS A2 portrait -WQ_EL3.DSC !EPS A3 landscape -WQ_EP3.DSC !EPS A3 portrait -WQ_EL4.DSC !EPS A4 landscape -WQ_EP4.DSC !EPS A4 portrait -WQ_PL0.DSC !PS A0 landscape -WQ_PP0.DSC !PS A0 portrait -WQ_PL1.DSC !PS A1 landscape -WQ_PP1.DSC !PS A1 portrait -WQ_PL2.DSC !PS A2 landscape -WQ_PP2.DSC !PS A2 portrait -WQ_PL3.DSC !PS A3 landscape -WQ_PP3.DSC !PS A3 portrait -WQ_PL4.DSC !PS A4 landscape -WQ_PP4.DSC !PS A4 portrait -WQ_QMP.DSC !QMS portrait -WQ_QMS.DSC !QMS landscape -WQ_REG.DSC !Regis -WQ_XWI.DSC !X11 (with PGPLOT) -! -! Fonts -! -WQ_FNA.DSC !Font 1 -WQ_FNB.DSC !Font 2 -WPG_XLOGO64.INC !X11 logo -! -! General command files -! -! -! Fortran definition files: -! -WQG.DSC !General area for WNP (WQ) system -! -! Programs: -! -TWNP.FOR ! Test program -WPG_GREXEC.FOR !GREXEC PGPLOT driver interface -WPG_XWDRIV.CUN !XWDRIV PGPLOT X11 driver -WNPCAL.FOR ! Calcomp routines - !FACTOR GRID NEWPEN NUMBER PLOT - !PLOTS SCALE SYMBOL TONE WHERE -WNPCAX.FOR ! Calcomp routines - !AXIS LINE -WNPCID.FOR !WNPCID Check device id presence -WNPCLR.FOR !WQCLR Clear screen -WNPDAC.FOR !WQDVAC Activate device - !WQDVDA De-activate device -WNPDEX.FOR !WNPDEX Execute device routine -WNPDOP.FOR !WQDVOP Open device - !WQDVCL Close device -WNPDXR.FOR !WNPDXR Execute actual device routine -WNPEXH.FOR !WNPEXH Do exit handler -WNPEX0.FOR ! Extra routines - !WQ_DATE Plot time stamped header message - !WQ_LINE Single line piece - !WQ_LINE_IX with index given - !WQ_MARK Single mark - !WQ_MARK_IX with index given - !WQ_MLINE Marked polyline - !WQ_MLINE_IX with indices given - !WQ_RECT Draw rectangle - !WQ_RECT_IX with index - !WQ_SNTR Set window and viewport -WNPEX1.FOR !WQ_BOX Area fill -WNPEX2.FOR !WQ_MPAGE Multiple page open - !WQ_MCLOSE Multiple page close - !WQ_MDATE Multiple page message - !WQ_MPLR Multiple page polyline representation -WNPIND.FOR !WNPIND Initialise device to system -WNPMSG.FOR !WQMSG Plot header message -WNPOPC.FOR !WQOPEN Open WNP (WQ) system - !WQCLOS Close WNP system -WNPPLM.FOR !WQPOLM Polymark - !WQPOLM_IX Polymark with index -WNPPLN.FOR !WQPOLL Polyline - !WQPOLL_IX Polyline with index - !WQPOLL_LIST Special -WNPRTN.FOR ! General routines - !WNP_NTR1 Normalized transform - !WNP_NTRG - !WNP_DNTR1 Device transform - !WNP_DNTRG - !WNP_MAKL Make list - !WNP_PLCLP Clip lines - !WNP_PMCLP Clip points - !WNP_SHCLP Clip areas -WNPRTN_X.FOR !WNP_NTR0 Normalized transform - !WNP_DNTR0 Device transform -WNPRTN_Y.FOR !WNP_ALLOC Allocate clip areas -WNPSET.FOR !WQSPLI Set polyline index - !WQSPMI Set polymark index - !WQSFAI Set fill area index - !WQSTXI Set text index - !WQSTXH Set text height - !WQSTXU Set text direction - !WQSTXX Set text expansion - !WQSTXP Set text path - !WQSTXS Set text spacing - !WQSPID Set pick id - !WQSCLP Set clip indicator - !WQSPSZ Set pattern size - !WQSPRP Set pattern reference point - !WQSPLR Set polyline representation - !WQSPLR_IC ... with colour - !WQSPMR Set polymark representation - !WQSPMR_IC ... with colour - !WQSTXR Set text representation - !WQSTXR_IC ... with colour -WNPSEV.FOR ! Set windows etc - !WQSLNT Select norm. transform - !WQSWIN Set window - !WQSVIE Set view - !WQSDVW Set device window - !WQSDVV Set device viewport -WNPTWO.FOR ! 2-dimensional plotting - !WQ_CONI Init contouring - !WQ_CONJ Init contouring - !WQ_CONT Draw contours - !WQ_CONX Finish contouring - !WQ_SHADI Init shading - !WQ_SHADJ Init shading - !WQ_SHADE Shade - !WQ_SHADX Finish shading - !WQ_POLI Init pol. vectors - !WQ_POLT Pol. vectors - !WQ_POLX Finish pol. vectors - !WQ_RULI Init ruled surface - !WQ_RULE Ruled surface - !WQ_RULX Finish ruled surface -WNPTXT.FOR !WQTEXT Show text - !WQTEXT_IX Show text with index and height - !WQTEXT_IY Show text with all arguments -! -! Device routines -! -WNQEL4.FSC !WNQEL4 Encapsulated PS A4 landscape - !WNQEP4 Encapsulated PS A4 portrait - !WNQPL4 PostScript A4 landscape - !WNQPP4 PostScript A4 portrait - !WNQEL3 Encapsulated PS A3 landscape - !WNQEP3 Encapsulated PS A3 portrait - !WNQPL3 PostScript A3 landscape - !WNQPP3 PostScript A3 portrait - !WNQEL2 Encapsulated PS A2 landscape - !WNQEP2 Encapsulated PS A2 portrait - !WNQPL2 PostScript A2 landscape - !WNQPP2 PostScript A2 portrait - !WNQEL1 Encapsulated PS A1 landscape - !WNQEP1 Encapsulated PS A1 portrait - !WNQPL1 PostScript A1 landscape - !WNQPP1 PostScript A1 portrait - !WNQEL0 Encapsulated PS A0 landscape - !WNQEP0 Encapsulated PS A0 portrait - !WNQPL0 PostScript A0 landscape - !WNQPP0 PostScript A0 portrait -WNQQMS.FOR !WNQQMS QMS landscape - !WNQQMP QMS portrait -WNQREG.FOR !WNQREG Regis -WNQXWI.FSC !WNQXWI X11 (with PGPLOT-calls) -! -! Executables -! -TWNP.EXE -!- diff --git a/src/wng/wnpcal.for b/src/wng/wnpcal.for deleted file mode 100644 index 97a94ba0c8f4dea303fabe8561ec80aa9bd85727..0000000000000000000000000000000000000000 --- a/src/wng/wnpcal.for +++ /dev/null @@ -1,479 +0,0 @@ -C+ WNPCAL.FOR -C WNB 911223 -C -C Revisions: -C -C Calcomp routines for WQ package -C - SUBROUTINE PLOTS(RR1,RR2,II3) -C -C Result: -C -C -C Include files: -C - INCLUDE 'WNG_DEF' -C -C Entry points: -C -C -C Parameters: -C -C -C Arguments: -C - REAL RR1,RR2,RR3,RR4,RR5 - INTEGER II1,II3,II4,II5,II6,II7 - CHARACTER*(*) SS1 - REAL AR1(*),AR2(*),AR4(*),AR6(*) - INTEGER IA(*) -C -C Function references: -C - LOGICAL WQDVOP !DEVICE OPEN ROUTINE -C -C Data declarations: -C - INTEGER WQID !WQ AREA - CHARACTER*1 CR,LF - BYTE IIK(2) - EQUIVALENCE (IIK,CR) - EQUIVALENCE (IIK(2),LF) - DATA IIK/13,10/ - REAL P(2,3) - REAL PW(2,2) - DATA PW/0.,0.,8000.,11000./ - REAL PV(2,2) - DATA PV/0.,0.,.727272,1./ - REAL UP(2) - REAL UR1,UR2,UR3,UR4,UR5 - REAL X1,X2,X3,X4,X5 - INTEGER J6 - REAL RANGE(2) - DATA RANGE/0.,16./ - REAL XT(2,4),XU(2,5) - REAL SIZV,SIZH - DATA SIZV,SIZH/11000.,8000./ - CHARACTER*5 STR1,STR2 - INTEGER NEWP - REAL PENC - CHARACTER*32 STR - CHARACTER*112 SYMTAB !SPECIAL SYMBOLS - INTEGER*2 SYMGR(2,14,0:15) !CENTRED SYMBOLS - DATA SYMGR / 0,2,-2,0,0,-4,4,0,0,4,-2,0,0,-2,14*0, - 1 0,2,-1,0,-1,-1,0,-2,1,-1,2,0,1,1,0,2,-1,1,-1,0,0,-2,6*0, - 1 0,2,-2,-3,4,0,-2,3,0,-2,18*0, - 1 -2,0,4,0,-2,0,0,2,0,-4,0,2,16*0, - 1 -2,-2,4,4,-2,-2,-2,2,4,-4,-2,2,16*0, - 1 0,2,-2,-2,2,-2,2,2,-2,2,0,-2,16*0, - 1 0,-2,0,4,-2,-2,4,0,-2,2,0,-2,16*0, - 1 -2,-2,4,4,-4,0,4,-4,-2,2,18*0, - 1 -1,0,2,0,-1,0,-2,-2,4,0,-4,0,4,4,-4,0,4,0,-2,-2,8*0, - 1 -2,2,2,-2,2,2,-2,-2,0,-2,0,2,16*0, - 1 2,2,-1,-1,-2,0,-1,1,1,-1,0,-2,-1,-1,1,1,2,0,1,-1,-1,1, - 1 0,2,-1,-1,2*0, - 1 -2,-2,4,4,-2,-2,-2,2,4,-4,-2,2,-2,0,4,0,-2,0,0,2,0,-4, - 1 0,2,4*0,-2,-2,4,0,-4,4,4,0,-2,-2,18*0, - 1 0,2,0,-4,0,2,22*0, - 1 0,2,-2,-3,4,0,-2,3,0,-1,-2,0,2,-3,2,3,-2,0,0,-1,8*0, - 1 -2,0,4,0,-2,0,22*0/ - BYTE TONPAT(8,0:15) !PATTERNS - DATA TONPAT/8*0,0,68,0,0,0,68,0,0,0,0,0,24,24,0,0,0, - 1 0,102,102,0,0,102,102,0,17,34,68,136,17,34,68,136, - 1 136,68,34,17,136,68,34,17, - 1 153,102,102,153,153,102,102,153, - 1 131,7,14,28,56,112,224,193, - 1 193,224,112,56,28,14,7,131, - 1 196,231,126,76,76,126,231,196,255,0,0,0,255,0,0,0, - 1 8*17,255,17,17,17,255,17,17,17,3*255,5*0, - 1 8*224,3*255,5*224/ - REAL FAC,X,Y,XOFF,YOFF -C -C Common: -C - COMMON /WQCALCOM/ FAC,X,Y,XOFF,YOFF,NEWP,PENC,SYMTAB,WQID - DATA FAC,X,Y,XOFF,YOFF/1000.,0.,0.,0.,0./ -C -C Inline functions: -C - REAL XPOS,YPOS - XPOS()=(MAX(MIN(XOFF+X,SIZH),0.)) - YPOS()=(MAX(MIN(YOFF+Y,SIZV),0.)) -C- -C -C PLOTS -C - WQID=0 !SET NOTHING OPEN - CALL WQOPEN !OPEN PACKAGE - IF (.NOT.WQDVOP(WQID,'QMS')) RETURN !OPEN PLOTTER - CALL WQDVAC(WQID) !ACTIVATE - CALL WQSWIN(1,PW) !SET SCALE - CALL WQSVIE(1,PV) - CALL WQSDVW(WQID,PV) - CALL WQSLNT(1) - X=0 !SET COORD. - Y=0 - XOFF=0 - YOFF=0 - FAC=1000. - NEWP=1 - PENC=1. - CALL WQSPLR(WQID,1,1,PENC) - SYMTAB=' !"#$%&''()*+,-./0123456789:;<=>?'// - 1 '@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\]^_`abcdefghijklmno'// - 2 'pqrstuvwxyz{|}~ ' !SPECIAL SYMBOLS -C - RETURN -C -C PLOT -C - ENTRY PLOT(RR1,RR2,II3) -C - IF (II3.EQ.-999) THEN - CALL WQCLR(WQID) - X=0 - Y=0 - XOFF=0 - YOFF=0 - NEWP=1 - PENC=1. - CALL WQSPLR(WQID,1,1,PENC) - ELSE IF (II3.EQ.999) THEN - CALL WQCLOS - ELSE IF (II3.EQ.3) THEN - X=RR1*FAC - Y=RR2*FAC - ELSE IF (II3.EQ.-3) THEN - XOFF=XOFF+RR1*FAC - YOFF=YOFF+RR2*FAC - X=0 - Y=0 - ELSE IF (II3.EQ.2) THEN - P(1,1)=XPOS() - P(2,1)=YPOS() - X=RR1*FAC - Y=RR2*FAC - P(1,2)=XPOS() - P(2,2)=YPOS() - CALL WQPOLL(2,P) - ELSE IF (II3.EQ.-2) THEN - P(1,1)=XPOS() - P(2,1)=YPOS() - XOFF=XOFF+RR1*FAC - YOFF=YOFF+RR2*FAC - X=0 - Y=0 - P(1,2)=XPOS() - P(2,2)=YPOS() - CALL WQPOLL(2,P) - END IF -C - RETURN -C -C FACTOR -C - ENTRY FACTOR(RR1) -C - FAC=RR1*1000. -C - RETURN -C -C NEWPEN -C - ENTRY NEWPEN(II1) -C - NEWP=MAX(MIN(II1,8),1) - PENC=II1 -C - RETURN -C -C WHERE -C - ENTRY WHERE(RR1,RR2,RR3) -C - RR3=FAC/1000. - RR1=X/FAC - RR2=Y/FAC -C - RETURN -C -C NUMBER -C - ENTRY NUMBER(RR1,RR2,RR3,RR4,RR5,II6) -C - IF (II6.LT.0) THEN - WRITE (UNIT=STR,ERR=100,FMT=1100) NINT(RR4/(10**(-II6-1))) - 1100 FORMAT(I6) - ELSE - WRITE (UNIT=STR1,ERR=100,FMT=1111) II6 - 1111 FORMAT('F10.',I2.2) - WRITE (UNIT=STR,ERR=100,FMT=STR1) RR4 - END IF - IF (RR1.EQ.999. .OR. RR2.EQ.999.) THEN !USE CURRENT POS. - ELSE - X=FAC*RR1 - Y=FAC*RR2 - END IF - UR5=PI*RR5/180. - J4=1 - DO I=1,LEN(STR) - IF (STR(I:I).NE.' ') GOTO 101 - J4=J4+1 - END DO - 101 CONTINUE - J3=0 - DO I=J4,LEN(STR) - IF (STR(I:I).EQ.' ') GOTO 102 - J3=J3+1 - END DO - 102 CONTINUE - J4=MIN(J4,LEN(STR)) - J=MAX(1,J3) - X1=RR3*FAC !CHAR. SIZE - 103 CONTINUE - CALL WQSTXH(X1) - UP(1)=-SIN(UR5) - UP(2)=COS(UR5) - CALL WQSTXU(UP) !CHARACTER DIMENSION - P(1,1)=XPOS() - P(2,1)=YPOS() - CALL WQTEXT(P,STR(J4:J4+J-1)) - X=X+J*X1*UP(2) - Y=Y-J*X1*UP(1) -C - 100 CONTINUE - RETURN -C -C SYMBOL -C - ENTRY SYMBOL(RR1,RR2,RR3,SS1,RR5,II6) -C - IF (RR3.LT.0.) THEN !SPECIAL MODE SET - ELSE IF (II6.GE.0) THEN - J=MAX(1,MIN(II6,LEN(SS1))) - IF (RR1.EQ.999. .OR. RR2.EQ.999.) THEN !USE CURRENT POS. - ELSE - X=FAC*RR1 - Y=FAC*RR2 - END IF - X1=RR3*FAC !CHAR. SIZE - UR5=PI*UR5/180. - STR=SS1 - J4=1 - GOTO 103 - ELSE !SINGLE SYMBOL - IF (II6.LE.-2) THEN !PLOT LINE - IF (RR1.EQ.999. .OR. RR2.EQ.999.) THEN !LEAVE POS. - ELSE - P(1,1)=XPOS() - P(2,1)=YPOS() - X=RR1*FAC - Y=RR2*FAC - P(1,2)=XPOS() - P(2,2)=YPOS() - CALL WQPOLL(2,P) - END IF - ELSE !GET POS. - IF (RR1.EQ.999. .OR. RR2.EQ.999.) THEN !CURRENT POS. - ELSE - X=RR1*FAC - Y=RR2*FAC - END IF - END IF - J1=ICHAR(SS1(1:1)) !CHARACTER NUMBER - IF (J1.GE.16) THEN !NORMAL CHARACTER - IF (J1.GE.LEN(SYMTAB)) J1=16 !SPACE - STR=SYMTAB(J1+1:J1+1) !GET CORRECT CHARACTER - J4=1 !START STRING - J=1 !LENGTH STRING - X1=RR3*FAC !CHARACTER SIZE - RR5=RR5*PI/180. - GOTO 103 !PLOT - ELSE !SPECIAL GRAPHICS - X1=RR3*FAC/4 !SIZE QUART - P(1,2)=XPOS() - P(2,2)=YPOS() - J=0 !START ARRAY - DO WHILE (SYMGR(1,J,J1).NE.0 .AND. SYMGR(2,J,J1).NE.0) - X=X+SYMGR(1,J,J1)*X1 !PLOT COORD - Y=Y+SYMGR(2,J,J1)*X1 - P(1,1)=P(1,2) - P(2,1)=P(2,2) - P(1,2)=XPOS() - P(2,2)=YPOS() - CALL WQPOLL(2,P) - END DO - END IF - END IF -C - RETURN -C -C TONE -C - ENTRY TONE(AR1,AR2,IA,II4) -C - IF (II4.GT.0) THEN - DO I=1,4 - XT(1,I)=MAX(MIN(XOFF+AR1(I)*FAC,SIZH),0.) - XT(2,I)=MAX(MIN(YOFF+AR2(I)*FAC,SIZV),0.) - END DO - UR1=MIN(XT(1,1),XT(1,2),XT(1,3),XT(1,4)) - UR2=MAX(XT(1,1),XT(1,2),XT(1,3),XT(1,4)) - UR3=MIN(XT(2,1),XT(2,2),XT(2,3),XT(2,4)) - UR4=MAX(XT(2,1),XT(2,2),XT(2,3),XT(2,4)) - J=UR1 - J1=UR3 - J2=UR2-UR1 - J3=UR4-UR3 - P(1,1)=J - P(2,1)=J1 - P(1,2)=J2 - P(2,2)=0 - P(1,3)=0 - P(2,3)=J3 - CALL WQ_BOX(1,P(1,1),P(1,2),(MOD(II4,10)+0.5)/10.,2) !FILL BOX - END IF -C - RETURN -C -C GRID -C - ENTRY GRID(RR1,RR2,II3,AR4,II5,AR6,II7) -C - IF (ABS(II3).LE.1000) THEN !GET LENGTH OF LINES - UR3=II3*AR4(1) - J4=FAC*AR4(1) - ELSE - UR3=0 - DO I=1,ABS(II3)-1000 - UR3=UR3+AR4(I) - END DO - END IF - IF (ABS(II5).LE.1000) THEN - UR4=II5*AR6(1) - J5=FAC*AR6(1) - ELSE - UR4=0 - DO I=1,ABS(II5)-1000 - UR4=UR4+AR6(I) - END DO - END IF - J=MAX(MIN(XOFF+FAC*RR1,SIZH),0.) - J1=MAX(MIN(YOFF+FAC*RR2,SIZV),0.) - J2=FAC*UR3 - J3=FAC*UR4 - IF (II3.GE.0) THEN - CALL WQSPLR(WQID,1,IAND(II7,3)+1,PENC) - IF (II3.LE.1000) THEN - DO I=0,II3 - P(1,1)=I*J4+J - P(2,1)=J1 - P(1,2)=P(1,1) - P(2,2)=J3+P(2,1) - CALL WQPOLL(2,P) - END DO - ELSE - P(1,1)=J - P(2,1)=J1 - P(1,2)=P(1,1) - P(2,2)=J3+P(2,1) - CALL WQPOLL(2,P) - UR3=0 - DO I=1,II3-1000 - UR3=UR3+AR4(I) - J6=FAC*UR3 - P(1,1)=J6+J - P(2,1)=J1 - P(1,2)=P(1,1) - P(2,2)=J3+P(2,1) - CALL WQPOLL(2,P) - END DO - END IF - CALL WQSPLR(WQID,1,1,PENC) - END IF - IF (II5.GE.0) THEN - CALL WQSPLR(WQID,1,IAND(II7,3)+1,PENC) - IF (II5.LE.1000) THEN - DO I=0,II5 - P(1,1)=J - P(2,1)=I*J5+J1 - P(1,2)=J2+P(1,1) - P(2,2)=P(2,1) - CALL WQPOLL(2,P) - END DO - ELSE - P(1,1)=J - P(2,1)=J1 - P(1,2)=J2+P(1,1) - P(2,2)=P(2,1) - CALL WQPOLL(2,P) - UR4=0 - DO I=1,II5-1000 - UR4=UR4+AR6(I) - J6=FAC*UR4 - P(1,1)=J - P(2,1)=J6+J1 - P(1,2)=J2+P(1,1) - P(2,2)=P(2,1) - CALL WQPOLL(2,P) - END DO - END IF - CALL WQSPLR(WQID,1,1,PENC) - END IF -C - RETURN -C -C SCALE -C - ENTRY SCALE(AR1,RR2,II3,II4) -C - J=ABS(II4) !DIRECTION - X1=-1E30 !MAX - X2=1E30 !MIN - DO I=1,II3,J !SCAN DATA FOR MAX/MIN - X1=MAX(AR1(I),X1) - X2=MIN(AR1(I),X2) - END DO - X3=(X1-X2)/RR2 !SCALE - IF (X3.GT.0) THEN - X4=LOG10(X3) - X5=X4-INT(X4) !FRACT. SCALE - X4=INT(X4) !INTEGER SCALE - IF (X5.LT.0) THEN - X5=X5+1 - X4=X4-1 - END IF - X5=10**X5 - IF (X5.LE.1.) THEN !GET RANGE - X5=1. - ELSE IF (X5.LE.2.) THEN - X5=2. - ELSE IF (X5.LE.4.) THEN - X5=4. - ELSE IF (X5.LE.5.) THEN - X5=5. - ELSE IF (X5.LE.8.) THEN - X5=8. - ELSE - X5=10. - END IF - X5=X5*(10**X4) !FULL SCALE - ELSE - X5=1. - END IF - IF (II4.LT.0) THEN - AR1(II3*J+J+1)=-X5 !DELTAV - X4=INT(X1/X5) !MAX - IF (X1/X5-X4.GT.0) X4=X4+1 - AR1(II3*J+1)=X4*X5 !FIRSTV - ELSE - AR1(II3*J+J+1)=X5 - X4=INT(X2/X5) !MIN - IF (X2/X5-X4.LT.0) X4=X4-1 - AR1(II3*J+1)=X4*X5 !FIRSTV - END IF -C - RETURN -C -C - END diff --git a/src/wng/wnpcax.for b/src/wng/wnpcax.for deleted file mode 100644 index e539b8b4ad8126cb848eb6518a703f9b09afd15d..0000000000000000000000000000000000000000 --- a/src/wng/wnpcax.for +++ /dev/null @@ -1,116 +0,0 @@ -C+ WNPCAX.FOR -C WNB 911223 -C -C Revisions: -C GvD 920501 Use J5 iso. JS -C -C Calcomp routines for WQ package -C - SUBROUTINE AXIS(RR1,RR2,SS1,II4,RR5,RR6,RR7,RR8) -C -C Result: -C -C -C Include files: -C - INCLUDE 'WNG_DEF' -C -C Entry points: -C -C -C Parameters: -C -C -C Arguments: -C - REAL RR1,RR2,RR5,RR6,RR7,RR8 - INTEGER II3,II4,II5,II6 - CHARACTER*(*) SS1 - REAL AR1(*),AR2(*) -C -C Function references: -C -C -C Data declarations: -C - REAL RC,RS - REAL RFX,RFY,RSX,RSY,RSC,RAN - INTEGER JSC -C- -C -C AXIS -C - J5=SIGN(1,II4) !DIRECTION ANNOTATION - RC=COS(RR6*RAD) !ROTATION - RS=SIN(RR6*RAD) - CALL PLOT(RR1,RR2,3) !DRAW AXIS - CALL PLOT(RR1+RR5*RC,RR2+RR5*RS,2) -C - DO I=0,NINT(RR5) - CALL PLOT(RR1+I*RC,RR2+I*RS,3) !TICKS - CALL PLOT(RR1+I*RC+J5*.04*RS,RR2+I*RS+J5*.04*RC,2) - END DO -C - RAN=MIN((RR5-ABS(II4)*0.12)/2.,0.) !ANNOTATION OFFSET - CALL SYMBOL(RR1+RAN*RC+J5*.24*RS,RR2+RAN*RS+J5*0.24*RC, - 1 0.12,SS1(1:MIN(LEN(SS1),ABS(II4))),RR6,ABS(II4)) !ANNOT. -C - RSC=1. !GET SCALE - DO WHILE (ABS(RR8/RSC).GT.100.) - RSC=RSC*10. - END DO - DO WHILE (ABS(RR8/RSC).LT..01) - RSC=RSC/10. - END DO - JSC=NINT(LOG10(RSC)) - IF (JSC.NE.0) THEN - CALL SYMBOL(RR1+(RAN+(ABS(II4)+1)*.12)*RC+J5*.24*RS, - 1 RR2+(RAN+(ABS(II4)+1)*.12)*RS+J5*.24*RC, - 2 0.12,'*10',RR6,3) - CALL NUMBER(RR1+(RAN+(ABS(II4)+4)*.12)*RC+J5*.24*RS, - 1 RR2+(RAN+(ABS(II4)+4)*.12)*RS+(J5*.24+.06)*RC, - 2 0.06,REAL(JSC),RR6,-1) - END IF -C - CALL NUMBER(RR1+J5*.12*RS,RR2+J5*.12*RC,RR7/RSC,.1,RR6,2) - DO I=1,RR5 - CALL NUMBER(RR1+J5*.12*RS+(I-.2)*RC,RR2+J5*.12*RC+(I-.2)*RS, - 1 (RR7+I*RR8)/RSC,.1,RR6,2) - END DO -C - RETURN -C -C LINE -C - ENTRY LINE(AR1,AR2,II3,II4,II5,II6) -C - RFX=AR1(II3*II4+1) !SCALES - RFY=AR2(II3*II4+1) - RSX=AR1(II3*II4+II4+1) - RSY=AR2(II3*II4+II4+1) - DO I=1,II3,II4 - IF (I.EQ.1) THEN - IF (II5.EQ.0) THEN - CALL PLOT((AR1(I)-RFX)/RSX,(AR2(I)-RFY)/RSY,3) - ELSE - CALL SYMBOL((AR1(I)-RFX)/RSX,(AR2(I)-RFY)/RSY, - 1 .08,CHAR(II6),0,-1) - END IF - ELSE - IF (II5.LT.0) THEN - CALL PLOT((AR1(I)-RFX)/RSX,(AR2(I)-RFY)/RSY,3) - ELSE - CALL PLOT((AR1(I)-RFX)/RSX,(AR2(I)-RFY)/RSY,2) - END IF - IF (II5.NE.0) THEN - IF (MOD(I-1,II5).EQ.0) - 1 CALL SYMBOL((AR1(I)-RFX)/RSX,(AR2(I)-RFY)/RSY, - 2 .08,CHAR(II6),0,-1) - END IF - END IF - END DO -C - RETURN -C -C - END diff --git a/src/wng/wnpcid.for b/src/wng/wnpcid.for deleted file mode 100644 index 164c1e0d41c18d70f17bfce0874147927974a752..0000000000000000000000000000000000000000 --- a/src/wng/wnpcid.for +++ /dev/null @@ -1,53 +0,0 @@ -C+ WNPCID.FOR -C WNB 910624 -C -C Revisions: -C - LOGICAL FUNCTION WNPCID(ID) -C -C Check if device present -C -C Result: -C -C WNPCID_L= WNPCID( ID_J:I) -C Check if device pointed to by ID is present. -C -C Include files: -C - INCLUDE 'WNG_DEF' - INCLUDE 'WQG_DEF' !GENERAL AREA - INCLUDE 'WQD_O_DEF' !DEVICE AREA -C -C Parameters: -C -C -C Entry points: -C -C -C Arguments: -C - INTEGER ID !DEVICE ID -C -C Function references: -C -C -C Data declarations: -C -C- -C -C CHECK ID -C - WNPCID=.TRUE. !ASSUME PRESENT - IF (ID.NE.0) THEN !MAYBE OPEN - J=WQG_QOP !START DEVICE QUEUE - DO WHILE (J.NE.0) !CHECK QUEUE - IF (ID.EQ.J) RETURN !PRESENT - J=A_J((J-A_OB)/LB_J) !NEXT IN LIST - END DO - END IF - WNPCID=.FALSE. !NOT FOUND -C - RETURN -C -C - END diff --git a/src/wng/wnpclr.for b/src/wng/wnpclr.for deleted file mode 100644 index 72b3611152b3bf5307f5d09a9d969f1c72dea38a..0000000000000000000000000000000000000000 --- a/src/wng/wnpclr.for +++ /dev/null @@ -1,67 +0,0 @@ -C+ WNPCLR.FOR -C WNB 911213 -C -C Revisions: -C - SUBROUTINE WQCLR(ID) -C -C Clear screen -C -C Result: -C -C CALL WQCLR ( ID_J:I) -C Clear screen for device for device ID -C -C Include files: -C - INCLUDE 'WNG_DEF' - INCLUDE 'WQG_DEF' !GENERAL AREA - INCLUDE 'WQD_O_DEF' !DEVICE AREA -C -C Parameters: -C -C -C Entry points: -C -C -C Arguments: -C - INTEGER ID !PLOT ID -C -C Function references: -C - LOGICAL WNPCID !CHECK ID -C -C Data declarations: -C -C- -C -C INIT -C - IF (WQG_STATE.LT.2) THEN - E_C=7 !WRONG STATE - RETURN - END IF -C -C CHECK ID -C - IF (.NOT.WNPCID(ID)) THEN !WRONG DEVICE - E_C=20 - RETURN - END IF -C -C CHECK TYPE -C - IF (IAND(1,A_J((ID-A_OB)/LB_J+WQD_TYP_J)).EQ.0) THEN !NOT OUTPUT - E_C=34 - RETURN - END IF -C -C CLEAR SCREEN -C - CALL WNPDEX(5,ID,0) !WRITE MESSAGE -C - RETURN -C -C - END diff --git a/src/wng/wnpdac.for b/src/wng/wnpdac.for deleted file mode 100644 index d038af539de456c13236621face1755ef99f9a58..0000000000000000000000000000000000000000 --- a/src/wng/wnpdac.for +++ /dev/null @@ -1,105 +0,0 @@ -C+ WNPDAC.FOR -C WNB 910624 -C -C Revisions: -C - LOGICAL FUNCTION WQDVAC(ID) -C -C Activate device -C -C Result: -C -C WQDVAC_L = WQDVAC( ID_J:I) -C Activate a plot device given by ID -C WQDVDA_L = WQDVDA( ID_J:I) -C De-activate the plot device given by ID. -C -C Include files: -C - INCLUDE 'WNG_DEF' - INCLUDE 'WQG_DEF' !GENERAL AREA - INCLUDE 'WQD_O_DEF' !DEVICE AREA -C -C Parameters: -C -C -C Entry points: -C - LOGICAL WQDVDA !DEACTIVATE DEVICE -C -C Arguments: -C - INTEGER ID !PLOT ID -C -C Function references: -C - LOGICAL WNPCID !CHECK ID -C -C Data declarations: -C -C- -C -C INIT -C - WQDVAC=.TRUE. !ASSUME OK - IF (WQG_STATE.EQ.4) THEN !ILLEGAL STATE - 11 CONTINUE - E_C=3 - 10 CONTINUE - WQDVAC=.FALSE. - RETURN - END IF -C -C CHECK ID -C - IF (.NOT.WNPCID(ID)) THEN !NOT OPEN - 12 CONTINUE - E_C=20 - GOTO 10 - END IF -C -C CHECK OUTPUT -C - IF (IAND(1,A_J((ID-A_OB)/LB_J+WQD_TYP_J)).EQ.0) THEN !NOT OUTPUT - E_C=34 - GOTO 10 - END IF -C -C SET ACTIVE -C - IF (A_J((ID-A_OB)/LB_J+WQD_ACT_J).EQ.0) THEN !NOT ACTIVE - A_J((ID-A_OB)/LB_J+WQD_ACT_J)=1 !SET ACTIVE - WQG_NACT=WQG_NACT+1 !COUNT ACTIVE - END IF - IF (WQG_STATE.LT.3) WQG_STATE=3 !SET AT LEAST ONE ACTIVE -C - RETURN -C -C WQDVDA -C - ENTRY WQDVDA(ID) -C -C INIT -C - WQDVDA=.TRUE. !ASSUME OK - IF (WQG_STATE.EQ.4) GOTO 11 !ILLEGAL STATE -C -C CHECK ID -C - IF (.NOT.WNPCID(ID)) GOTO 12 !NOT OPEN -C -C DEACTIVATE DEVICE -C - IF (A_J((ID-A_OB)/LB_J+WQD_ACT_J).NE.0) THEN !ACTIVE - A_J((ID-A_OB)/LB_J+WQD_ACT_J)=0 !DE-ACTIVATE - WQG_NACT=WQG_NACT-1 !COUNT - IF (WQG_NACT.LE.0) THEN - WQG_STATE=2 !CORRECT STATE - WQG_NACT=0 - END IF - END IF -C - RETURN -C -C - END diff --git a/src/wng/wnpdex.for b/src/wng/wnpdex.for deleted file mode 100644 index 2ec4a3cc0510ff9c961209b75df42b46d0783fd6..0000000000000000000000000000000000000000 --- a/src/wng/wnpdex.for +++ /dev/null @@ -1,45 +0,0 @@ -C+ WNPDEX.FOR -C WNB 910624 -C -C Revisions: -C - SUBROUTINE WNPDEX(TYP,ID,VP) -C -C Execute plot device driver -C -C Result: -C -C CALL WNPDEX( TYP_J:I, ID_J:I, VP_J(*):I) -C Execute the device routine for device ID -C for type of action TYP with device parameters -C in VP -C -C Include files: -C - INCLUDE 'WNG_DEF' - INCLUDE 'WQD_O_DEF' !DEVICE AREA -C -C Parameters: -C -C -C Entry points: -C -C -C Arguments: -C - INTEGER TYP !EXECUTION TYPE - INTEGER ID !DEVICE ID - INTEGER VP(*) !ROUTINE PARAMETERS -C -C Function references: -C -C -C Data declarations: -C -C- - CALL WNPDXR(A_B(A_J((ID-A_OB)/LB_J+WQD_DVRT_J)-A_OB),TYP,ID,VP) !DO -C - RETURN -C -C - END diff --git a/src/wng/wnpdop.for b/src/wng/wnpdop.for deleted file mode 100644 index fad5a6efb7d246c67b9035a5aebce60828432265..0000000000000000000000000000000000000000 --- a/src/wng/wnpdop.for +++ /dev/null @@ -1,141 +0,0 @@ -C+ WNPDOP.FOR -C WNB 910624 -C -C Revisions: -C WNB 920116 Typo in close -C - LOGICAL FUNCTION WQDVOP(ID,NAM) -C -C Open device -C -C Result: -C -C WQDVOP_L = WQDVOP( ID_J:IO, NAM_C*:I) -C Open a plot device given by NAM, and return -C the ID for the device -C WQDVCL_L = WQDVCL( ID_J:IO) -C Close the plot device given by ID. First -C de-activate if necessary. -C -C Include files: -C - INCLUDE 'WNG_DEF' - INCLUDE 'WQG_DEF' !GENERAL AREA - INCLUDE 'WQD_O_DEF' !DEVICE AREA -C -C Parameters: -C -C -C Entry points: -C - LOGICAL WQDVCL !CLOSE DEVICE -C -C Arguments: -C - INTEGER ID !PLOT ID - CHARACTER*(*) NAM !DEVICE NAME -C -C Function references: -C - LOGICAL WNGGVM !GET MEMORY - INTEGER WNGARA !GET ADDRESS - LOGICAL WQOPEN !OPEN SYSTEM - LOGICAL WNPCID !CHECK ID -C -C Data declarations: -C - CHARACTER*(WQD_DEV_N) CNAM !DEVICE NAME CHECK -C- -C -C INIT -C - WQDVOP=.TRUE. !ASSUME OK - IF (WQG_STATE.LE.0) WQDVOP=WQOPEN() !MAKE SURE SYSTEM OPEN - IF (.NOT.WQDVOP) RETURN !NO OPEN SYSTEM -C -C CHECK ID -C - IF (WNPCID(ID)) THEN !ALREADY OPEN - E_C=24 - 20 CONTINUE - WQDVOP=.FALSE. - RETURN - END IF - ID=0 !SET NOT OPEN -C -C FIND DEVICE -C - J=WQG_DVLST !START LIST - DO WHILE (J.NE.0) - J=J-A_OB !OFFSET - CALL WNGMTS(WQD_DEV_N,A_B(J+WQD_DEV_1),CNAM) !GET DEVICE NAME - IF (NAM.EQ.CNAM) GOTO 10 !FOUND - J=A_J(J/LB_J+WQD_QUE_J) !NEXT DEVICE - END DO - E_C=22 !UNKNOWN DEVICE - GOTO 20 -C -C GET AND FILL AREA -C - 10 CONTINUE - J0=A_J(J/LB_J+WQD_LEN_J) !LENGTH AREA - IF (.NOT.WNGGVM(J0,J1)) THEN !GET AREA - E_C=26 - GOTO 20 - END IF - CALL WNGMV(J0,A_B(J),A_B(J1-A_OB)) !FILL AREA -C -C OPEN DEVICE -C - CALL WNPDEX(0,J1,0) !OPEN DEVICE -C -C LINK OPEN DEVICE -C - A_J((J1-A_OB)/LB_J+WQD_QUE_J)=WQG_QOP !LINK DEVICE - WQG_QOP=J1 - IF (WQG_STATE.LT.2) WQG_STATE=2 !SET AT LEAST ONE OPEN - ID=J1 !RETURN AREA ID -C - RETURN -C -C WQDVCL -C - ENTRY WQDVCL(ID) -C -C INIT -C - WQDVCL=.TRUE. !ASSUME OK - IF (WQG_STATE.LE.0) WQDVCL=WQOPEN() !MAKE SURE SYSTEM OPEN - IF (.NOT.WQDVCL) RETURN !NO OPEN SYSTEM -C -C CHECK ID -C - IF (.NOT.WNPCID(ID)) THEN !NOT OPEN - E_C=25 - WQDVCL=.FALSE. - RETURN - END IF -C -C CLOSE DEVICE -C - IF (A_J((ID-A_OB)/LB_J+WQD_ACT_J).NE.0) CALL WQDVDA(ID) !DEACTIVATE - CALL WNPDEX(1,ID,0) !CLOSE DEVICE -C -C DE-LINK -C - J=WQG_QOP !START LIST - J1=WNGARA(WQG_QOP) !ADDRESS START - DO WHILE (J.NE.ID) - J1=J - J=A_J((J-A_OB)/LB_J+WQD_QUE_J) !NEXT DEVICE - END DO - A_J((J1-A_OB)/LB_J)=A_J((J-A_OB)/LB_J+WQD_QUE_J) !UNLINK - J0=A_J((J-A_OB)/LB_J+WQD_LEN_J) !LENGTH - CALL WNGFVM(J0,ID) !FREE MEMORY - ID=0 !SET CLOSED - IF (WQG_QOP.EQ.0) WQG_STATE=1 !NO OPEN LEFT -C - RETURN -C -C - END diff --git a/src/wng/wnpdxr.for b/src/wng/wnpdxr.for deleted file mode 100644 index 17532c6ad50177a2de364baf5f05a10177342fe7..0000000000000000000000000000000000000000 --- a/src/wng/wnpdxr.for +++ /dev/null @@ -1,45 +0,0 @@ -C+ WNPDXR.FOR -C WNB 911121 -C -C Revisions: -C - SUBROUTINE WNPDXR(ROUT,TYP,ID,VP) -C -C Execute plot device driver -C -C Result: -C -C CALL WNPDXR( ROUT:I, TYP_J:I, ID_J:I, VP_J(*):I) -C Execute the device routine ROUT for device ID -C for type of action TYP with device parameters -C in VP -C -C Include files: -C - INCLUDE 'WNG_DEF' -C -C Parameters: -C -C -C Entry points: -C -C -C Arguments: -C - EXTERNAL ROUT !ROUTINE - INTEGER TYP !EXECUTION TYPE - INTEGER ID !DEVICE ID - INTEGER VP(*) !ROUTINE PARAMETERS -C -C Function references: -C -C -C Data declarations: -C -C- - CALL ROUT(TYP,ID,VP) !DO ROUTINE -C - RETURN -C -C - END diff --git a/src/wng/wnpex0.for b/src/wng/wnpex0.for deleted file mode 100644 index f21ebbc6b054bfb493bbc92393643b8bd1e976a1..0000000000000000000000000000000000000000 --- a/src/wng/wnpex0.for +++ /dev/null @@ -1,159 +0,0 @@ -C+ WNPEX0.FOR -C WNB 911127 -C -C Revisions: -C -C Extra routines WNP package -C - SUBROUTINE WQ_DATE(ID,MSG) -C -C Result: -C -C CALL WQ_DATE( ID_J:I, MSG_C*:I) -C Write time stamped message -C CALL WQ_LINE( POS_E(0:1,0:1):I) -C Draw simple line segment -C CALL WQ_LINE_IX( POS_E(0:1,0:1):I, IX_J:I) -C Draw simple line segment with index -C CALL WQ_MARK( POS_E(0:1,0:0):I) -C Draw single mark -C CALL WQ_MARK_IX( POS_E(0:1,0:0):I, IX_J:I) -C Draw single mark with index -C CALL WQ_MLINE( N_J:I, POS1_E(0:1,N):I) -C Draw marked line -C CALL WQ_MLINE_IX( N_J:I, POS1_E(0:1,N):I, LIX_J:I, MIX_J:I) -C Draw marked line with index -C CALL WQ_RECT( POS_E(0:1,0:1):I) -C Draw a rectangle from llhc to urhc -C CALL WQ_RECT_IX( POS_E(0:1,0:1):I, IX_J:I) -C Draw a rectangle from llhc to urhc with index -C CALL WQ_SNTR(N_J:I, WIN_E(0:3):I, VIE_E(0:3):I) -C Set WINdow and VIEwport for transfrom N -C -C Include files: -C - INCLUDE 'WNG_DEF' - INCLUDE 'WQG_DEF' !GENERAL AREA - INCLUDE 'WQD_O_DEF' !DEVICE AREA -C -C Parameters: -C -C -C Arguments: -C - INTEGER ID !DEVICE - CHARACTER*(*) MSG !STRING - REAL POS(0:1,0:*) !POSITION - REAL POS1(0:1,0:*) !POSITION - INTEGER IX,LIX,MIX !INDEX - INTEGER N !COUNT - REAL WIN(0:3) !WINDOW - REAL VIE(0:3) !VIEWPORT -C -C Function references: -C -C -C Data declarations: -C - CHARACTER*24 TIM !SYSTEM TIME - CHARACTER*80 MSG2 !BUFFER TO SATISFY g77 - REAL LPOS(0:1,0:4) !RECTANGLE POSITION -C- -C -C DATE -C - CALL WNGSYT(TIM) !GET TIME - MSG2=MSG - CALL WQMSG(ID,TIM(1:17)//' '//MSG2) !WRITE MESSAGE -C - RETURN -C -C LINE -C - ENTRY WQ_LINE(POS) -C - GOTO 20 -C -C LINE_IX -C - ENTRY WQ_LINE_IX(POS,IX) -C - CALL WQSPLI(IX) - 20 CONTINUE - CALL WQPOLL(2,POS) -C - RETURN -C -C MARK -C - ENTRY WQ_MARK(POS) -C - GOTO 30 -C -C MARK_IX -C - ENTRY WQ_MARK_IX(POS,IX) -C - CALL WQSPMI(IX) - 30 CONTINUE - CALL WQPOLM(2,POS) -C - RETURN -C -C MLINE -C - ENTRY WQ_MLINE(N,POS1) -C - GOTO 40 -C -C MLINE_IX -C - ENTRY WQ_MLINE_IX(N,POS1,LIX,MIX) -C - CALL WQSPLI(LIX) - CALL WQSPMI(MIX) - 40 CONTINUE - CALL WQPOLL(N,POS1) - CALL WQPOLM(N,POS1) -C - RETURN -C -C RECT -C - ENTRY WQ_RECT(POS) -C - GOTO 10 -C - RETURN -C -C RECT_IX -C - ENTRY WQ_RECT_IX(POS,IX) -C - CALL WQSPLI(IX) - 10 CONTINUE - LPOS(0,0)=POS(0,0) - LPOS(1,0)=POS(1,0) - LPOS(0,1)=POS(0,1) - LPOS(1,1)=POS(1,0) - LPOS(0,2)=POS(0,1) - LPOS(1,2)=POS(1,1) - LPOS(0,3)=POS(0,0) - LPOS(1,3)=POS(1,1) - LPOS(0,4)=POS(0,0) - LPOS(1,4)=POS(1,0) - CALL WQPOLL(5,LPOS) -C - RETURN -C -C SNTR -C - ENTRY WQ_SNTR(N,WIN,VIE) -C - CALL WQSWIN(N,WIN) - CALL WQSVIE(N,VIE) -C - RETURN -C -C - END diff --git a/src/wng/wnpex1.for b/src/wng/wnpex1.for deleted file mode 100644 index ba355ce9de8c35f0ad7da86caab9f344a36e1dec..0000000000000000000000000000000000000000 --- a/src/wng/wnpex1.for +++ /dev/null @@ -1,171 +0,0 @@ -C+ WNPEX1.FOR -C WNB 911213 -C -C Revisions: -C GvD 920501 Use J5 iso. JS -C WNB 930414 Correct device clipping -C -C Extra routines WNP package -C - LOGICAL FUNCTION WQ_BOX(N,POS,DPOS,INT,FAIX) -C -C Result: -C -C CALL WQ_BOX( N_J:I, POS_E(0:1):I, DPOS_E(0:3):I, INT_E(0:*):I, -C FAIX_J:I) -C Fill areas. N intensities INT given starting at -C POS (centre). Intensities between 0 and 1 -C One area has point and line step DPOS. -C FAIX is index (0:random, 1:regular, 2:pattern) -C -C Include files: -C - INCLUDE 'WNG_DEF' - INCLUDE 'WQG_DEF' !GENERAL AREA - INCLUDE 'WQD_O_DEF' !DEVICE AREA -C -C Parameters: -C -C -C Arguments: -C - INTEGER N !# OF INTENSITIES - REAL POS(0:1) !FIRST POSITION - REAL DPOS(0:3) !DX, DY POINT, LINE - REAL INT(0:*) !INTENSITIES - INTEGER FAIX !FILL TYPE -C -C Function references: -C - LOGICAL WNP_ALLOC !ALLOCATE WORK AREA - INTEGER WNGARA !ADDRESS -C -C Data declarations: -C - INTEGER VP(5) !PLOT DATA - REAL LDPOS(0:9,0:1) !LOCAL DX, DY POINTS - REAL LBOX(0:3) !TOTAL BOX -C- -C -C INIT -C - WQ_BOX=.TRUE. !ASSUME OK - IF (WQG_STATE.LT.3) THEN - E_C=5 !WRONG STATE - 11 CONTINUE - WQ_BOX=.FALSE. - RETURN - END IF - IF (N.LT.1) THEN - E_C=100 !ERROR - GOTO 11 - END IF - DO I=0,1 - LDPOS(I+0,0)=0 !FOR OFFSET POSITION - LDPOS(I+2,0)=DPOS(I) !DX, DY POSITION - LDPOS(I+4,0)=DPOS(I)+DPOS(I+2) !DX, DY BOX - LDPOS(I+6,0)=POS(I) !START POSITION - LDPOS(I+8,0)=POS(I)+0.5*DPOS(I) !CENTRE POSITION - END DO - J=4*N+4 !MULTIPLE LIST LENGTH - IF (.NOT.WNP_ALLOC(J)) THEN !GET AREAS - E_C=100 - GOTO 11 - END IF -C -C GET INTENSITIES -C - J1=(WQG_OUT3-A_OB)/LB_E - DO I=0,N-1 - A_E(J1+I)=INT(I) !INT - END DO -C -C CHECK BOXES -C - DO I=0,1 - IF (LDPOS(4+I,0).LT.0) THEN !D < 0 - LDPOS(4+I,0)=ABS(LDPOS(4+I,0)) !MAKE > 0 - LDPOS(6+I,0)=LDPOS(6+I,0)-LDPOS(4+I,0) - END IF - END DO -C -C GET POSITIONS -C - J0=(WQG_OUT2-A_OB)/LB_E !WORK POINTERS - DO I=0,N-1 !MAKE CENTRE POSITIONS - DO I1=0,1 - A_E(J0+2*I+I1)=LDPOS(I1+8,0)+I*LDPOS(I1+2,0) !X,Y - END DO - END DO -C -C TRANSFORM -C - CALL WNP_MAKL(N,A_B(WQG_OUT2-A_OB), - 1 A_B(WQG_OUT1-A_OB)) !MAKE MULTIPLE LIST - IF (IAND(1,WQG_CLIP).NE.0) THEN - CALL WNP_NTRG(A_B(WQG_OUT1-A_OB), - 1 A_B(WQG_OUT2-A_OB)) !NORM. TRANSFORM - CALL WNP_SHCLP(A_B(WQG_OUT2-A_OB), - 1 A_B(WQG_OUT3-A_OB), - 1 WQG_NTR(0,2,WQG_CTR)) !CLIP VIEW - ELSE - CALL WNP_NTRG(A_B(WQG_OUT1-A_OB), - 1 A_B(WQG_OUT2-A_OB)) !NORM. TRANSFORM - END IF - CALL WNP_NTR0(4,LDPOS(0,0),J5,LDPOS(0,1)) !TRANSFORM BOX -C -C ON ALL ACTIVE DEVICES -C - J=WQG_QOP !START LIST - DO WHILE (J.NE.0) - J0=(J-A_OB)/LB_J !PTR - IF (A_J(J0+WQD_ACT_J).NE.0 .AND. - 1 IAND(A_J(J0+WQD_TYP_J),1).NE.0 .AND. - 1 IAND(A_J(J0+WQD_TYP_J),4).EQ.0) THEN !OUTPUT DEVICE - J2=(WQG_OUT3-A_OB)/LB_E !SAVE CLIPPED INT. - J3=(WQG_OUT1-A_OB)/LB_E - DO I=0,N-1 - A_E(J3+I)=A_E(J2+I) !INT - END DO - CALL WNP_SHCLP(A_B(WQG_OUT2-A_OB), - 1 A_B(WQG_OUT1-A_OB), - 1 A_E(J0+WQD_NTR_E+4)) !CLIP - CALL WNP_DNTR0(4,LDPOS(0,1),J5,LDPOS(0,0),J) !TRANSFORM BOX - DO I=0,1 - LDPOS(I+2,0)=LDPOS(I+2,0)-LDPOS(I,0) !DIFFERENCE POS. - LDPOS(I+4,0)=LDPOS(I+4,0)-LDPOS(I,0) - END DO - J1=FAIX !CURRENT INDEX - IF (J1.GT.2) J1=0 !DEFAULT - J1=MAX(0,J1) !MAKE INDEX -C -C DRAW BOXES -C - DO I=0,1 - LBOX(I+0)=LDPOS(6+I,0) !LLHC BOX - LBOX(I+2)=LBOX(I+0)+N*LDPOS(I+2,0)+LDPOS(I+4,0) !URHC - IF (LBOX(I+0).GT.LBOX(I+2)) THEN !MAKE CORRECT SIZE - I1=LBOX(I+0) - LBOX(I+0)=LBOX(I+2) - LBOX(I+2)=I1 - END IF - END DO - VP(1)=J1 !INDEX - VP(2)=WQG_OUT1 !INTENSITY LIST - VP(4)=N-1 !# OF POINTS - VP(3)=WNGARA(LBOX) !TOTAL BOX - VP(5)=WNGARA(LDPOS(2,0)) !DX, DY , BOX, POS - CALL WNPDEX(6,J,VP) !DRAW - END IF - 20 CONTINUE - J=A_J((J-A_OB)/LB_J) !NEXT DEVICE - END DO -C -C READY -C - 900 CONTINUE -C - RETURN -C -C - END diff --git a/src/wng/wnpex2.for b/src/wng/wnpex2.for deleted file mode 100644 index 5b293e286615db93a67b3cd9cf9462d195550e83..0000000000000000000000000000000000000000 --- a/src/wng/wnpex2.for +++ /dev/null @@ -1,250 +0,0 @@ -C+ WNPEX2.FOR -C WNB 920130 -C -C Revisions: -C -C Extra routines WNP package -C - LOGICAL FUNCTION WQ_MPAGE(DQID,NHV,PLDEV,MXNHV,USIZ,UXY) -C -C Result: -C -C L = WQ_MPAGE( DQID_J(*):O, NHV_J(0:1):O, PLDEV_C*:I, MXNHV_J(0:1):I, -C USIZ_E:I, UXY_E(0:1,0:1):I) -C Open multiple pages on PLDEV. Maximally -C MXNHV horizontally and vertically. Return the -C device id's in DQID and the pages NHV opened. -C USIZ is the square size in user coordinates for -C one page, UXY the user total box. -C L = WQ_MCLOSE( DQID_J(*):IO, NHV_J(0:1):I) -C Close multiple pages -C L = WQ_MDATE( DQID_J(*):I, NHV_J(0:1):I, PLDEV_C*:I) -C Give dated message PLDEV on all pages -C L = WQ_MPLR( DQID_J(*):I, NHV_J(0:1):I, PLJ1_J:I, PLJ2_J:I, -C PLE1_E:I, PLJ3_J:I) -C Set polyline representation give by PL's -C -C Include files: -C - INCLUDE 'WNG_DEF' - INCLUDE 'WQG_DEF' !GENERAL AREA - INCLUDE 'WQD_O_DEF' !DEVICE AREA -C -C Parameters: -C - REAL OFR !OVERLAP FRACTION - PARAMETER (OFR=0.05) -C -C Entry points: -C - LOGICAL WQ_MCLOSE - LOGICAL WQ_MDATE - LOGICAL WQ_MPLR -C -C Arguments: -C - INTEGER DQID(0:*) !DEVICE ID - INTEGER NHV(0:1) !PAGES DONE - CHARACTER*(*) PLDEV !DEVICE - INTEGER MXNHV(0:1) !MAX. PAGES ALLOWED - REAL USIZ !SIZE USER PAGE IF SQUARE - REAL UXY(0:1,0:1) !USER TOTAL SIZE - INTEGER PLJ1,PLJ2,PLJ3 !POLYLINE - REAL PLE1 !POLYLINE -C -C Function references: -C - LOGICAL WQDVOP !OPEN DEVICE - INTEGER WNMEJC !CEIL - INTEGER WNCALN !STRING LENGTH -C -C Data declarations: -C - REAL XYS(0:1) !PAGE SIZE - REAL WINDOW(0:1,0:1) !PAGE WINDOW - REAL VIEW(0:1,0:1) !PAGE SMALL VIEWPORT - DATA VIEW/0.,0.9,0.1,1./ - REAL OXY !OVERLAP XY - REAL XYP(0:1,0:1) !CROSS POSITIONS - REAL XYX(0:1,0:1) !LINE POSITIONS - CHARACTER*256 TXT !ANNOTATION -C- -C -C INIT -C - WQ_MPAGE=.TRUE. !ASSUME OK - CALL WQOPEN !OPEN PLOT SYSTEM -C -C OPEN FIRST -C - IF (.NOT.WQDVOP(DQID(0),PLDEV)) THEN !OPEN PLOTTER - 10 CONTINUE - WQ_MPAGE=.FALSE. - RETURN - END IF - CALL WQDVAC(DQID(0)) !ACTIVATE - NHV(0)=1 !ASSUME 1 PAGE - NHV(1)=1 - J0=(DQID(0)-A_OB)/LB_J !POINTER ID - J1=(DQID(0)-A_OB)/LB_E - OXY=OFR*USIZ !OVERLAP AREA -C -C CALCULATE PAGES -C - IF (A_E(J1+WQD_XHI_E).EQ.A_E(J1+WQD_YHI_E)) THEN !SQUARE - XYS(0)=USIZ !SET SIZE - XYS(1)=USIZ - ELSE IF (A_E(J1+WQD_XHI_E).GT.A_E(J1+WQD_YHI_E)) THEN !LANDSCAPE - XYS(0)=USIZ*A_E(J1+WQD_XHI_E)/A_E(J1+WQD_YHI_E) - XYS(1)=USIZ - ELSE !PORTRAIT - XYS(0)=USIZ - XYS(1)=USIZ*A_E(J1+WQD_YHI_E)/A_E(J1+WQD_XHI_E) - END IF - IF (UXY(0,1)-UXY(0,0).GT. - 1 XYS(0)+(MXNHV(0)-1)*(XYS(0)-OXY)) THEN !CANNOT FIT - R0=(UXY(0,1)-UXY(0,0)+(MXNHV(0)-1)*OXY)/MXNHV(0)/XYS(0) !FACTOR - XYS(0)=R0*XYS(0) !SCALE - XYS(1)=R0*XYS(1) - END IF - IF (UXY(1,1)-UXY(1,0).GT. - 1 XYS(1)+(MXNHV(1)-1)*(XYS(1)-OXY)) THEN !CANNOT FIT - R0=(UXY(1,1)-UXY(1,0)+(MXNHV(1)-1)*OXY)/MXNHV(1)/XYS(1) !FACTOR - XYS(0)=R0*XYS(0) !SCALE - XYS(1)=R0*XYS(1) - END IF - IF (IAND(A_J(J0+WQD_TYP_J),128).EQ.0) THEN !NOT SCREEN DEVICE - NHV(0)=WNMEJC((UXY(0,1)-UXY(0,0)-XYS(0))/(XYS(0)-OXY)) !HOR. PAGES - NHV(0)=MIN(MXNHV(0),MAX(1,NHV(0)+1)) - NHV(1)=WNMEJC((UXY(1,1)-UXY(1,0)-XYS(1))/(XYS(1)-OXY)) !VERT. PAGES - NHV(1)=MIN(MXNHV(1),MAX(1,NHV(1)+1)) - END IF -C -C OPEN PAGES -C - DO I=1,NHV(0)*NHV(1)-1 - IF (.NOT.WQDVOP(DQID(I),PLDEV)) GOTO 10 !OPEN - CALL WQDVAC(DQID(I)) !ACTIVATE - END DO -C -C SET WINDOW -C - WINDOW(0,0)=UXY(0,0) !SQUARE WINDOW TOP LEFT - WINDOW(1,0)=UXY(1,1)-USIZ - WINDOW(0,1)=UXY(0,0)+USIZ - WINDOW(1,1)=UXY(1,1) - CALL WQSWIN(1,WINDOW) !SET WINDOW - CALL WQSVIE(1,VIEW) !SET VIEW - CALL WQSLNT(1) !SELECT TRANSFORM -C -C SET DEVICE WINDOWS -C - WINDOW(0,0)=0. !X LEFT UNDER - WINDOW(0,1)=0.1*XYS(0)/USIZ !X RIGHT TOP - DO I=0,NHV(0)-1 !HOR. PAGES - WINDOW(1,0)=1.-0.1*XYS(1)/USIZ !Y LEFT UNDER - WINDOW(1,1)=1. !Y RIGHT TOP - DO I1=0,NHV(1)-1 !VERT. PAGES - CALL WQSDVW(DQID(I1*NHV(0)+I),WINDOW) !SET DEVICE WINDOW - WINDOW(1,1)=WINDOW(1,0)+0.1*OFR !Y TOP - WINDOW(1,0)=WINDOW(1,1)-0.1*XYS(1)/USIZ !Y UNDER - END DO - WINDOW(0,0)=WINDOW(0,1)-0.1*OFR !X LEFT - WINDOW(0,1)=WINDOW(0,0)+0.1*XYS(0)/USIZ !X RIGHT - END DO -C -C OVERLAP CROSSES -C - DO I=0,NHV(0)*NHV(1)-1 - CALL WQSPLR(DQID(I),1,1,1.,0) !STANDARD LINES - END DO - CALL WQSPLI(1) !AND SELECT - XYP(1,0)=UXY(1,1)-XYS(1)+0.25*OXY !Y FIRST ++ - XYP(1,1)=XYP(1,0) - DO I=1,NHV(1)-1 !VERTICAL + - XYP(0,0)=UXY(0,0)+0.1*XYS(0) !X FIRST ++ - XYP(0,1)=UXY(0,0)+0.9*XYS(0) - DO I1=0,NHV(0)-1 !FOR ALL HOR. PAGES - DO I2=0,1 - XYX(0,0)=XYP(0,I2)-0.25*OXY - XYX(1,0)=XYP(1,I2) - XYX(0,1)=XYP(0,I2)+0.25*OXY - XYX(1,1)=XYP(1,I2) - CALL WQPOLL(2,XYX) - XYX(0,0)=XYP(0,I2) - XYX(1,0)=XYP(1,I2)-0.25*OXY - XYX(0,1)=XYP(0,I2) - XYX(1,1)=XYP(1,I2)+0.25*OXY - CALL WQPOLL(2,XYX) - XYP(0,I2)=XYP(0,I2)+XYS(0)-OXY - END DO - END DO - DO I2=0,1 - XYP(1,I2)=XYP(1,I2)-XYS(1)+OXY - END DO - END DO - XYP(0,0)=UXY(0,0)+XYS(0)-0.25*OXY !X FIRST ++ - XYP(0,1)=XYP(0,0) - DO I=1,NHV(0)-1 !HORIZONTAL + - XYP(1,0)=UXY(1,1)-0.1*XYS(1) !Y FIRST ++ - XYP(1,1)=UXY(1,1)-0.9*XYS(1) - DO I1=0,NHV(1)-1 !FOR ALL VERT. PAGES - DO I2=0,1 - XYX(0,0)=XYP(0,I2)-0.25*OXY - XYX(1,0)=XYP(1,I2) - XYX(0,1)=XYP(0,I2)+0.25*OXY - XYX(1,1)=XYP(1,I2) - CALL WQPOLL(2,XYX) - XYX(0,0)=XYP(0,I2) - XYX(1,0)=XYP(1,I2)-0.25*OXY - XYX(0,1)=XYP(0,I2) - XYX(1,1)=XYP(1,I2)+0.25*OXY - CALL WQPOLL(2,XYX) - XYP(1,I2)=XYP(1,I2)-XYS(1)+OXY - END DO - END DO - DO I2=0,1 - XYP(0,I2)=XYP(0,I2)+XYS(0)-OXY - END DO - END DO -C - RETURN -C -C MCLOSE -C - ENTRY WQ_MCLOSE(DQID,NHV) -C - WQ_MCLOSE=.TRUE. !ASSUME OK - DO I=0,NHV(0)*NHV(1)-1 - CALL WQDVDA(DQID(I)) !DEACTIVATE - CALL WQDVCL(DQID(I)) !CLOSE - END DO -C - RETURN -C -C MDATE -C - ENTRY WQ_MDATE(DQID,NHV,PLDEV) -C - WQ_MDATE=.TRUE. - DO I=0,NHV(0)-1 !HORIZONTAL - DO I1=0,NHV(1)-1 !VERTICAL - CALL WNCTXS(TXT,'!AS !UJ\.!UJ/!UJ\.!UJ', - 1 PLDEV,I,I1,NHV(0)-1,NHV(1)-1) !INCLUDE PAGE - J=WNCALN(TXT) - CALL WQ_DATE(DQID(I1*NHV(0)+I),TXT(1:J)) - END DO - END DO -C - RETURN -C -C MPLR -C - ENTRY WQ_MPLR(DQID,NHV,PLJ1,PLJ2,PLE1,PLJ3) -C - DO I=0,NHV(0)*NHV(1)-1 - CALL WQSPLR(DQID(I),PLJ1,PLJ2,PLE1,PLJ3) - END DO -C -C - END diff --git a/src/wng/wnpexh.for b/src/wng/wnpexh.for deleted file mode 100644 index b0f6b848a40c34f4b8479553ab2a8b7d499f55ff..0000000000000000000000000000000000000000 --- a/src/wng/wnpexh.for +++ /dev/null @@ -1,35 +0,0 @@ -C+ WNPEXH.FOR -C WNB 911126 -C -C Revisions: -C - SUBROUTINE WNPEXH -C -C Exit handler for WNP routines -C -C Result: -C -C CALL WNPEXH Close and dispose all plot files -C -C Include files: -C - INCLUDE 'WNG_DEF' -C -C Parameters: -C -C -C Arguments: -C -C -C Function references: -C -C -C Data declarations: -C -C- - CALL WQCLOS !CLOSE ALL FILES -C - RETURN -C -C - END diff --git a/src/wng/wnpind.for b/src/wng/wnpind.for deleted file mode 100644 index 80d16f383ea135599fe214ab7e020593b8f5a7d3..0000000000000000000000000000000000000000 --- a/src/wng/wnpind.for +++ /dev/null @@ -1,75 +0,0 @@ -C+ WNPIND.FOR -C WNB 910624 -C -C Revisions: -C - SUBROUTINE WNPIND(WQDJ,ROUT) -C -C Initialise a device -C -C Result: -C -C CALL WNPIND( WQDJ_J(0:*):I, ROUT:I) -C Initialise device in area WQDJ, using the -C device routine ROUT. -C Set the device in system device queue -C -C Include files: -C - INCLUDE 'WNG_DEF' - INCLUDE 'WQG_DEF' !GENERAL AREA - INCLUDE 'WQD_O_DEF' !DEVICE AREA -C -C Parameters: -C -C -C Entry points: -C -C -C Arguments: -C - INTEGER WQDJ(0:*) !DEVICE AREA - EXTERNAL ROUT !DEVICE ROUTINE -C -C Function references: -C - INTEGER WNGARA !GET ADDRESS -C -C Data declarations: -C -C- -C -C FILL LENGTH AND INDEX TABLE POINTERS -C - WQDJ(WQD_LEN_J)=WQD_SVP_1+LB_J !FIXED PART - WQDJ(WQD_OPLI_J)=WQDJ(WQD_LEN_J) !POINTERS - WQDJ(WQD_LEN_J)=WQDJ(WQD_LEN_J)+3*LB_E*(WQDJ(WQD_NPLIX_J)+1) - WQDJ(WQD_OPMI_J)=WQDJ(WQD_LEN_J) - WQDJ(WQD_LEN_J)=WQDJ(WQD_LEN_J)+3*LB_E*(WQDJ(WQD_NPMIX_J)+1) - WQDJ(WQD_OTXI_J)=WQDJ(WQD_LEN_J) - WQDJ(WQD_LEN_J)=WQDJ(WQD_LEN_J)+3*LB_E*(WQDJ(WQD_NTXIX_J)+1) - WQDJ(WQD_OFAI_J)=WQDJ(WQD_LEN_J) - WQDJ(WQD_LEN_J)=WQDJ(WQD_LEN_J)+3*LB_E*(WQDJ(WQD_NFAIX_J)+1) - WQDJ(WQD_OCLI_J)=WQDJ(WQD_LEN_J) - WQDJ(WQD_LEN_J)=WQDJ(WQD_LEN_J)+3*LB_E*(WQDJ(WQD_NCLIX_J)+1) - WQDJ(WQD_LEN_J)=WQDJ(WQD_LEN_J)+LB_J !END WORD -C -C SET DEVICE ROUTINE -C - WQDJ(WQD_DVRT_J)=WNGARA(ROUT) -C -C ZERO USER DATA -C - DO I=0,NUSED - WQDJ(WQD_USE_J+I)=0 - END DO -C -C LINK IN DEVICE LIST -C - WQDJ(WQD_QUE_J)=WQG_DVLST !OLD LINK - WQG_DVLST=WNGARA(WQDJ) !NEW LINK -C - RETURN -C -C - END diff --git a/src/wng/wnpmsg.for b/src/wng/wnpmsg.for deleted file mode 100644 index 5d2f7571a0c4106455b1704795e1f697c0effd3e..0000000000000000000000000000000000000000 --- a/src/wng/wnpmsg.for +++ /dev/null @@ -1,80 +0,0 @@ -C+ WNPMSG.FOR -C WNB 911121 -C -C Revisions: -C - SUBROUTINE WQMSG(ID,MSG) -C -C Show header message -C -C Result: -C -C CALL WQMSG ( ID_J:I, MSG_C*:I) -C Show header message MSG for device ID -C -C Include files: -C - INCLUDE 'WNG_DEF' - INCLUDE 'WQG_DEF' !GENERAL AREA - INCLUDE 'WQD_O_DEF' !DEVICE AREA -C -C Parameters: -C -C -C Entry points: -C -C -C Arguments: -C - INTEGER ID !PLOT ID - CHARACTER*(*) MSG !MESSAGE -C -C Function references: -C - INTEGER WNGARA !GET ADDRESS - LOGICAL WNPCID !CHECK ID -C -C Data declarations: -C - INTEGER VP(2) !PARAMETERS - CHARACTER*512 LMSG !LOCAL TEXT - BYTE LMSGB(512) - EQUIVALENCE (LMSG,LMSGB) -C- -C -C INIT -C - IF (WQG_STATE.LT.2) THEN - E_C=7 !WRONG STATE - RETURN - END IF -C -C CHECK ID -C - IF (.NOT.WNPCID(ID)) THEN !WRONG DEVICE - E_C=20 - RETURN - END IF -C -C CHECK TYPE -C - IF (IAND(1,A_J((ID-A_OB)/LB_J+WQD_TYP_J)).EQ.0) THEN !NOT OUTPUT - E_C=34 - RETURN - END IF - IF (IAND(2,A_J((ID-A_OB)/LB_J+WQD_TYP_J)).NE.0) THEN !DISS - E_C=35 - RETURN - END IF -C -C WRITE MESSAGE -C - LMSG=MSG !COPY MESSAGE - VP(1)=WNGARA(LMSGB) - VP(2)=MIN(LEN(MSG),LEN(LMSG)) - CALL WNPDEX(2,ID,VP) !WRITE MESSAGE -C - RETURN -C -C - END diff --git a/src/wng/wnpopc.for b/src/wng/wnpopc.for deleted file mode 100644 index 4534ad7d5a54fc3de35934bf9ae918b03e785478..0000000000000000000000000000000000000000 --- a/src/wng/wnpopc.for +++ /dev/null @@ -1,330 +0,0 @@ -C+ WNPOPC.FOR -C WNB 910624 -C -C Revisions: -C WNB 920303 SUN problem () -C WNB 921021 Add A3 plotter -C HJV 921222 Add X-windows system -C CMV 940518 Remove call to WNGIN1 -C HjV 950704 Change names of PS/EPS DEF-files -C Add DEF-files and device list for A0/A1/A2-plotter -C - LOGICAL FUNCTION WQOPEN() -C -C Open/close WNP plot system -C -C Result: -C -C WQOPEN_L = WQOPEN() -C Open the WNP (WQ) plot system. If no explicit -C call given, the DVOP will do it implicitly. -C WQCLOS_L = WQCLOS() -C Close the WNP system. It will also close any -C open device. -C -C Include files: -C - INCLUDE 'WNG_DEF' - INCLUDE 'WQG_DEF' !GENERAL AREA - INCLUDE 'WQD_O_DEF' !DEVICE AREA - INCLUDE 'WQ_QMS_DEF' !QMS LANDSCAPE - INCLUDE 'WQ_QMP_DEF' !QMS PORTRAIT - INCLUDE 'WQ_REG_DEF' !REGIS - INCLUDE 'WQ_EL4_DEF' !EL4 - INCLUDE 'WQ_EP4_DEF' !EP4 - INCLUDE 'WQ_PL4_DEF' !PL4 - INCLUDE 'WQ_PP4_DEF' !PP4 - INCLUDE 'WQ_EL3_DEF' !EL3 - INCLUDE 'WQ_EP3_DEF' !EP3 - INCLUDE 'WQ_PL3_DEF' !PL3 - INCLUDE 'WQ_PP3_DEF' !PP3 - INCLUDE 'WQ_EL2_DEF' !EL2 - INCLUDE 'WQ_EP2_DEF' !EP2 - INCLUDE 'WQ_PL2_DEF' !PL2 - INCLUDE 'WQ_PP2_DEF' !PP2 - INCLUDE 'WQ_EL1_DEF' !EL1 - INCLUDE 'WQ_EP1_DEF' !EP1 - INCLUDE 'WQ_PL1_DEF' !PL1 - INCLUDE 'WQ_PP1_DEF' !PP1 - INCLUDE 'WQ_EL0_DEF' !EL0 - INCLUDE 'WQ_EP0_DEF' !EP0 - INCLUDE 'WQ_PL0_DEF' !PL0 - INCLUDE 'WQ_PP0_DEF' !PP0 - INCLUDE 'WQ_XWI_DEF' !X-WINDOWS - INCLUDE 'WQF_O_DEF' !FONT DESCRIPTOR - INCLUDE 'WQ_FNA_DEF' !FONT 1 - INCLUDE 'WQ_FNB_DEF' !FONT 2 -C -C Parameters: -C -C -C Entry points: -C - LOGICAL WQCLOS !CLOSE DEVICE -C -C Arguments: -C -C -C Function references: -C - EXTERNAL WNQQMS !QMS LANDSCAPE - EXTERNAL WNQQMP !QMS PORTRAIT - EXTERNAL WNQREG !REGIS - EXTERNAL WNQEL4 !EL4 - EXTERNAL WNQEP4 !EP4 - EXTERNAL WNQPL4 !PL4 - EXTERNAL WNQPP4 !PP4 - EXTERNAL WNQEL3 !EL3 - EXTERNAL WNQEP3 !EP3 - EXTERNAL WNQPL3 !PL3 - EXTERNAL WNQPP3 !PP3 - EXTERNAL WNQEL2 !EL2 - EXTERNAL WNQEP2 !EP2 - EXTERNAL WNQPL2 !PL2 - EXTERNAL WNQPP2 !PP2 - EXTERNAL WNQEL1 !EL1 - EXTERNAL WNQEP1 !EP1 - EXTERNAL WNQPL1 !PL1 - EXTERNAL WNQPP1 !PP1 - EXTERNAL WNQEL0 !EL0 - EXTERNAL WNQEP0 !EP0 - EXTERNAL WNQPL0 !PL0 - EXTERNAL WNQPP0 !PP0 - EXTERNAL WNQXWI !X-WINDOWS - EXTERNAL WNPEXH !EXIT HANDLER -C - INTEGER WNGARA !GET ADDRESS -C -C Data declarations: -C -C- - WQOPEN=.TRUE. !ASSUME OK - IF (WQG_STATE.GT.0) RETURN !ALREADY OPEN SYSTEM -C -C MAKE SURE DUMMY ARRAYS ADDRESSABLE -C -C** CALL WNGIN1 -C -C INIT RANDOM -C - CALL WNMRIN(69069) !INITIATE RANDOM -C -C OPEN SYSTEM -C - J=WNGARA(WQL_EOL)-WNGARA(WQL_SOL) !LENGTH AREA - IF (WNGARA(WQG_EOL)-WNGARA(WQG_SOL).NE.J) THEN !ERROR IN DEFINED WQG - 10 CONTINUE - E_C=1 !CANNOT OPEN - WQOPEN=.FALSE. - RETURN - END IF - CALL WNGMV(J,WQL_SOL,WQG_SOL) !INIT. AREA -C -C FILL DEVICE LIST -C - IF (WQG_DVLST.EQ.0) THEN !STILL TO FILL -C -C QMS -C - J=WNGARA(QMS_SVP)-WNGARA(QMS_QUE) !LENGTH FIXED PART - IF (J.NE.WQD_SVP_1) GOTO 10 !DEFINITION ERROR DEVICE - CALL WNPIND(QMS_QUE,WNQQMS) !LINK DEVICE -C -C QMP -C - J=WNGARA(QMP_SVP)-WNGARA(QMP_QUE) !LENGTH FIXED PART - IF (J.NE.WQD_SVP_1) GOTO 10 !DEFINITION ERROR DEVICE - CALL WNPIND(QMP_QUE,WNQQMP) !LINK DEVICE -C -C REGIS -C - J=WNGARA(REG_SVP)-WNGARA(REG_QUE) !LENGTH FIXED PART - IF (J.NE.WQD_SVP_1) GOTO 10 !DEFINITION ERROR DEVICE - CALL WNPIND(REG_QUE,WNQREG) !LINK DEVICE -C -C EL4 -C - J=WNGARA(EL4_SVP)-WNGARA(EL4_QUE) !LENGTH FIXED PART - IF (J.NE.WQD_SVP_1) GOTO 10 !DEFINITION ERROR DEVICE - CALL WNPIND(EL4_QUE,WNQEL4) !LINK DEVICE -C -C EP4 -C - J=WNGARA(EP4_SVP)-WNGARA(EP4_QUE) !LENGTH FIXED PART - IF (J.NE.WQD_SVP_1) GOTO 10 !DEFINITION ERROR DEVICE - CALL WNPIND(EP4_QUE,WNQEP4) !LINK DEVICE -C -C PL4 -C - J=WNGARA(PL4_SVP)-WNGARA(PL4_QUE) !LENGTH FIXED PART - IF (J.NE.WQD_SVP_1) GOTO 10 !DEFINITION ERROR DEVICE - CALL WNPIND(PL4_QUE,WNQPL4) !LINK DEVICE -C -C PP4 -C - J=WNGARA(PP4_SVP)-WNGARA(PP4_QUE) !LENGTH FIXED PART - IF (J.NE.WQD_SVP_1) GOTO 10 !DEFINITION ERROR DEVICE - CALL WNPIND(PP4_QUE,WNQPP4) !LINK DEVICE -C -C EL3 -C - J=WNGARA(EL3_SVP)-WNGARA(EL3_QUE) !LENGTH FIXED PART - IF (J.NE.WQD_SVP_1) GOTO 10 !DEFINITION ERROR DEVICE - CALL WNPIND(EL3_QUE,WNQEL3) !LINK DEVICE -C -C EP3 -C - J=WNGARA(EP3_SVP)-WNGARA(EP3_QUE) !LENGTH FIXED PART - IF (J.NE.WQD_SVP_1) GOTO 10 !DEFINITION ERROR DEVICE - CALL WNPIND(EP3_QUE,WNQEP3) !LINK DEVICE -C -C PL3 -C - J=WNGARA(PL3_SVP)-WNGARA(PL3_QUE) !LENGTH FIXED PART - IF (J.NE.WQD_SVP_1) GOTO 10 !DEFINITION ERROR DEVICE - CALL WNPIND(PL3_QUE,WNQPL3) !LINK DEVICE -C -C PP3 -C - J=WNGARA(PP3_SVP)-WNGARA(PP3_QUE) !LENGTH FIXED PART - IF (J.NE.WQD_SVP_1) GOTO 10 !DEFINITION ERROR DEVICE - CALL WNPIND(PP3_QUE,WNQPP3) !LINK DEVICE -C -C EL2 -C - J=WNGARA(EL2_SVP)-WNGARA(EL2_QUE) !LENGTH FIXED PART - IF (J.NE.WQD_SVP_1) GOTO 10 !DEFINITION ERROR DEVICE - CALL WNPIND(EL2_QUE,WNQEL2) !LINK DEVICE -C -C EP2 -C - J=WNGARA(EP2_SVP)-WNGARA(EP2_QUE) !LENGTH FIXED PART - IF (J.NE.WQD_SVP_1) GOTO 10 !DEFINITION ERROR DEVICE - CALL WNPIND(EP2_QUE,WNQEP2) !LINK DEVICE -C -C PL2 -C - J=WNGARA(PL2_SVP)-WNGARA(PL2_QUE) !LENGTH FIXED PART - IF (J.NE.WQD_SVP_1) GOTO 10 !DEFINITION ERROR DEVICE - CALL WNPIND(PL2_QUE,WNQPL2) !LINK DEVICE -C -C PP2 -C - J=WNGARA(PP2_SVP)-WNGARA(PP2_QUE) !LENGTH FIXED PART - IF (J.NE.WQD_SVP_1) GOTO 10 !DEFINITION ERROR DEVICE - CALL WNPIND(PP2_QUE,WNQPP2) !LINK DEVICE -C -C EL1 -C - J=WNGARA(EL1_SVP)-WNGARA(EL1_QUE) !LENGTH FIXED PART - IF (J.NE.WQD_SVP_1) GOTO 10 !DEFINITION ERROR DEVICE - CALL WNPIND(EL1_QUE,WNQEL1) !LINK DEVICE -C -C EP1 -C - J=WNGARA(EP1_SVP)-WNGARA(EP1_QUE) !LENGTH FIXED PART - IF (J.NE.WQD_SVP_1) GOTO 10 !DEFINITION ERROR DEVICE - CALL WNPIND(EP1_QUE,WNQEP1) !LINK DEVICE -C -C PL1 -C - J=WNGARA(PL1_SVP)-WNGARA(PL1_QUE) !LENGTH FIXED PART - IF (J.NE.WQD_SVP_1) GOTO 10 !DEFINITION ERROR DEVICE - CALL WNPIND(PL1_QUE,WNQPL1) !LINK DEVICE -C -C PP1 -C - J=WNGARA(PP1_SVP)-WNGARA(PP1_QUE) !LENGTH FIXED PART - IF (J.NE.WQD_SVP_1) GOTO 10 !DEFINITION ERROR DEVICE - CALL WNPIND(PP1_QUE,WNQPP1) !LINK DEVICE -C -C EL0 -C - J=WNGARA(EL0_SVP)-WNGARA(EL0_QUE) !LENGTH FIXED PART - IF (J.NE.WQD_SVP_1) GOTO 10 !DEFINITION ERROR DEVICE - CALL WNPIND(EL0_QUE,WNQEL0) !LINK DEVICE -C -C EP0 -C - J=WNGARA(EP0_SVP)-WNGARA(EP0_QUE) !LENGTH FIXED PART - IF (J.NE.WQD_SVP_1) GOTO 10 !DEFINITION ERROR DEVICE - CALL WNPIND(EP0_QUE,WNQEP0) !LINK DEVICE -C -C PL0 -C - J=WNGARA(PL0_SVP)-WNGARA(PL0_QUE) !LENGTH FIXED PART - IF (J.NE.WQD_SVP_1) GOTO 10 !DEFINITION ERROR DEVICE - CALL WNPIND(PL0_QUE,WNQPL0) !LINK DEVICE -C -C PP0 -C - J=WNGARA(PP0_SVP)-WNGARA(PP0_QUE) !LENGTH FIXED PART - IF (J.NE.WQD_SVP_1) GOTO 10 !DEFINITION ERROR DEVICE - CALL WNPIND(PP0_QUE,WNQPP0) !LINK DEVICE -C -C XWI -C - J=WNGARA(XWI_SVP)-WNGARA(XWI_QUE) !LENGTH FIXED PART - IF (J.NE.WQD_SVP_1) GOTO 10 !DEFINITION ERROR DEVICE - CALL WNPIND(XWI_QUE,WNQXWI) !LINK DEVICE -C - END IF -C -C SET FONTS -C - IF (WQG_NFONT.EQ.0) THEN !STILL TO FILL -C -C FONT 1 AND 2 -C - J1=(WNGARA(FNA_FTP)-A_OB)/LB_J !PTR FONT 1 LIST - J2=(WNGARA(FNB_FTP)-A_OB)/LB_J !PTR FONT 2 LIST - J0=(WNGARA(FNA_L20)-A_OB)/LB_I !PTR FONT 1 CHAR. LIST - DO I=FNA_LCH-FNA_LCH,FNA_HCH-FNA_LCH !SET ALL CHAR. PTRS - A_J(J1+I)=J0 !PTR FONT 1 - A_J(J2+I)=J0 - DO WHILE(A_I(J0).NE.0) !SEARCH END DESCRIPTOR - J0=J0+1 - END DO - J0=J0+1 !SKIP END - END DO - WQG_FONT(1)=(WNGARA(FNA_HGT)-A_OB)/LB_J !FONT 1 PTR - WQG_FONT(2)=(WNGARA(FNB_HGT)-A_OB)/LB_J !FONT 2 PTR -C -C SET FILLED FONTS -C - WQG_NFONT=2 - END IF -C -C SET OPEN -C - IF (WQG_EXH(1).EQ.0) CALL WNGSXH(WQG_EXH,WNPEXH) !SET EXIT HANDLER - WQG_STATE=1 -C - RETURN -C -C WQCLOS -C - ENTRY WQCLOS -C - WQCLOS=.TRUE. !ASSUME OK -C -C CLOSE EVERYTHING -C - IF (WQG_STATE.GT.0) THEN !SOMETHING OPEN - DO WHILE (WQG_QOP.NE.0) !MORE OPEN - J=WQG_QOP - CALL WQDVCL(J) !CLOSE DEVICE - END DO - IF (WQG_LOUT.GT.0) THEN !REMOVE AREAS - CALL WNGFVM(WQG_LOUT*LB_J,WQG_OUT1) - CALL WNGFVM(WQG_LOUT*LB_J,WQG_OUT2) - CALL WNGFVM(WQG_LOUT*LB_J,WQG_OUT3) - END IF - WQG_LOUT=0 - END IF - WQG_STATE=0 !CORRECT STATE -C - RETURN -C -C - END diff --git a/src/wng/wnpplm.for b/src/wng/wnpplm.for deleted file mode 100644 index 9553739424364699efd5a824117c329a84b988a4..0000000000000000000000000000000000000000 --- a/src/wng/wnpplm.for +++ /dev/null @@ -1,162 +0,0 @@ -C+ WNPPLM.FOR -C WNB 911125 -C -C Revisions: -C -C Polymark routine -C - LOGICAL FUNCTION WQPOLM(N,POS) -C -C Result: -C -C WQPOLM_L = WQPOLM( N_J:I, POS_E(2,N):I) -C WQPOLM_IX_L = WQPOLM_IX( N_J:I, POS_E(2,N):I, IX_J:I) -C Draw polymarks from given list; and set -C polymark index IX. -C -C Include files: -C - INCLUDE 'WNG_DEF' - INCLUDE 'WQG_DEF' !GENERAL AREA - INCLUDE 'WQD_O_DEF' !DEVICE AREA -C -C Parameters: -C -C -C Arguments: -C - INTEGER N !NUMBER OF POINTS - REAL POS(2,*) !X,Y POSITIONS - INTEGER IX !LINE INDEX -C -C Entry points: -C - LOGICAL WQPOLM_IX !SET ALSO INDEX -C -C Function references: -C - LOGICAL WQSPMI !SET POLYLINE INDEX - LOGICAL WNP_ALLOC !GET AREAS -C -C Data declarations: -C - INTEGER VP(2) !ARGUMENT LIST - REAL MDAT(18,5) !MARKS - DATA MDAT/18*0.,-.5,0.,+.5,0.,0.,-.5,0.,+.5,10*0., - 1 -.5,0.,+.5,0.,-.5,-.5,+.5,+.5,-.5,+.5,+.5,-.5,6*0., - 2 -.5,-.25,-.5,+.25,-.25,+.5,+.25,+.5,+.5,+.25, - 3 +.5,-.25,+.25,-.5,-.25,-.5,-.5,-.25, - 2 -.5,-.5,+.5,+.5,-.5,+.5,+.5,-.5,10*0./ - INTEGER JDAT(4,5) - DATA JDAT/2,0,0,0,2,2,0,0,2,2,2,0,9,0,0,0,2,2,0,0/ !MARK SEGMENTS -C- - WQPOLM=.TRUE. !ASSUME OK - IF (WQG_STATE.LT.3) THEN - E_C=5 !WRONG STATE - 11 CONTINUE - WQPOLM=.FALSE. - RETURN - END IF - GOTO 10 -C -C POLM_IX -C - ENTRY WQPOLM_IX(N,POS,IX) -C - WQPOLM_IX=.TRUE. !ASSUME OK - IF (WQG_STATE.LT.3) THEN - E_C=5 !WRONG STATE - GOTO 11 - END IF - IF (.NOT.WQSPMI(IX)) GOTO 11 !SET INDEX - GOTO 10 -C -C INIT -C - 10 CONTINUE - IF (N.LT.1) THEN - E_C=100 !ERROR - GOTO 11 - END IF - J=300*N+32 !MULTIPLE LIST LENGTH - IF (.NOT.WNP_ALLOC(J)) THEN !GET AREAS - E_C=100 - GOTO 11 - END IF - CALL WNP_MAKL(N,POS,A_B(WQG_OUT1-A_OB)) !MAKE MULTIPLE LIST - IF (IAND(1,WQG_CLIP).NE.0) THEN - CALL WNP_NTRG(A_B(WQG_OUT1-A_OB), - 1 A_B(WQG_OUT3-A_OB)) !NORM. TRANSFORM - CALL WNP_PMCLP(A_B(WQG_OUT3-A_OB), - 1 A_B(WQG_OUT2-A_OB), - 1 WQG_NTR(0,2,WQG_CTR)) !CLIP VIEW - IF (A_J((WQG_OUT2-A_OB)/LB_J).LE.0) GOTO 900 !NONE LEFT - ELSE - CALL WNP_NTRG(A_B(WQG_OUT1-A_OB), - 1 A_B(WQG_OUT2-A_OB)) !NORM. TRANSFORM - END IF -C -C ON ALL ACTIVE DEVICES -C - J=WQG_QOP !START LIST - DO WHILE (J.NE.0) - J0=(J-A_OB)/LB_J !PTR - IF (A_J(J0+WQD_ACT_J).NE.0 .AND. - 1 IAND(A_J(J0+WQD_TYP_J),1).NE.0 .AND. - 1 IAND(A_J(J0+WQD_TYP_J),4).EQ.0) THEN !OUTPUT DEVICE - CALL WNP_PMCLP(A_B(WQG_OUT2-A_OB), - 1 A_B(WQG_OUT3-A_OB), - 1 A_E(J0+WQD_NTR_E+4)) !CLIP - IF (A_J((WQG_OUT3-A_OB)/LB_J).LE.0) GOTO 20 !NONE LEFT - CALL WNP_DNTR1(A_B(WQG_OUT3-A_OB), - 1 A_B(WQG_OUT1-A_OB),J) !DEVICE TRANSF. - J1=WQG_CPOLMIX-1 !CURRENT INDEX - IF (J1.GT.A_J(J0+WQD_NPMIX_J)) J1=0 !DEFAULT - J1=MAX(0,J1) !MAKE INDEX -C -C DRAW MARKS -C - R0=A_E(J0+WQD_NMPMS_E) !NOMINAL SIZE - IF (A_E(J0+WQD_PMIX_E+3*J1+1).NE.0) THEN !ACTUAL SIZE - R0=R0*A_E(J0+WQD_PMIX_E+3*J1+1) - R0=MAX(2.,R0) - END IF - I=1 !IN POINTER - I1=0 !OUT POINTER - I2=NINT(A_E(J0+WQD_PMIX_E+3*J1+0)) !TYPE - DO I0=1,A_J((WQG_OUT1-A_OB)/LB_J) !ALL POINTS - I3=1 !POINTER TABLE - J2=1 - DO WHILE (JDAT(I3,I2).NE.0) !FILL - A_J((WQG_OUT3-A_OB)/LB_J+I1)=JDAT(I3,I2) !# OF LINE SEGMENTS - I1=I1+1 !OUT PTR - DO I4=1,JDAT(I3,I2) !ALL SEGMENTS - A_E((WQG_OUT3-A_OB)/LB_E+I1)= - 1 A_E((WQG_OUT1-A_OB)/LB_E+I)+R0*MDAT(J2,I2) !X - A_E((WQG_OUT3-A_OB)/LB_E+I1+1)= - 1 A_E((WQG_OUT1-A_OB)/LB_E+I+1)+R0*MDAT(J2+1,I2) !Y - J2=J2+2 - I1=I1+2 - END DO - I3=I3+1 !NEXT PIECE - END DO - I=I+2 !NEXT INPUT - END DO - A_J((WQG_OUT3-A_OB)/LB_J+I1)=0 !EOL - CALL WNP_PLCLP(A_B(WQG_OUT3-A_OB), - 1 A_B(WQG_OUT1-A_OB), - 1 A_E(J0+WQD_NTR_E+8)) !CLIP - VP(1)=0 !INDEX - VP(2)=WQG_OUT1 !LIST ADDRESS - CALL WNPDEX(3,J,VP) !DRAW - END IF - 20 CONTINUE - J=A_J((J-A_OB)/LB_J) !NEXT DEVICE - END DO -C - 900 CONTINUE -C - RETURN -C -C - END diff --git a/src/wng/wnppln.for b/src/wng/wnppln.for deleted file mode 100644 index a0c2ea61985d0065e1ca3ab69dd42f99a72b7e05..0000000000000000000000000000000000000000 --- a/src/wng/wnppln.for +++ /dev/null @@ -1,157 +0,0 @@ -C+ WNPPLN.FOR -C WNB 910624 -C -C Revisions: -C -C Polyline routine -C - LOGICAL FUNCTION WQPOLL(N,POS) -C -C Result: -C -C WQPOLL_L = WQPOLL( N_J:I, POS_E(2,N):I) -C WQPOLL_IX_L = WQPOLL_IX( N_J:I, POS_E(2,N):I, IX_J:I) -C WQPOLL_LIST_L = WQPOLL_LIST( PLIST_J(*):I) -C Draw polylines from given list; and set -C polyline index IX. -C -C Include files: -C - INCLUDE 'WNG_DEF' - INCLUDE 'WQG_DEF' !GENERAL AREA - INCLUDE 'WQD_O_DEF' !DEVICE AREA -C -C Parameters: -C -C -C Arguments: -C - INTEGER N !NUMBER OF POINTS - REAL POS(2,*) !X,Y POSITIONS - INTEGER IX !LINE INDEX - INTEGER PLIST(*) !SPECIAL POLYLINE LIST -C -C Entry points: -C - LOGICAL WQPOLL_IX !SET ALSO INDEX - LOGICAL WQPOLL_LIST !SPECIAL POLY LINE -C -C Function references: -C - LOGICAL WQSPLI !SET POLYLINE INDEX - LOGICAL WNP_ALLOC !GET AREAS -C -C Data declarations: -C - INTEGER VP(2) !ARGUMENT LIST -C- - WQPOLL=.TRUE. !ASSUME OK - IF (WQG_STATE.LT.3) THEN - E_C=5 !WRONG STATE - 11 CONTINUE - WQPOLL=.FALSE. - RETURN - END IF - GOTO 10 -C -C POLL_IX -C - ENTRY WQPOLL_IX(N,POS,IX) -C - WQPOLL_IX=.TRUE. !ASSUME OK - IF (WQG_STATE.LT.3) THEN - E_C=5 !WRONG STATE - GOTO 11 - END IF - IF (.NOT.WQSPLI(IX)) GOTO 11 !SET INDEX - GOTO 10 -C -C INIT -C - 10 CONTINUE - IF (N.LT.2) THEN - E_C=100 !ERROR - GOTO 11 - END IF - J=15*N+2 !MULTIPLE LIST LENGTH - IF (.NOT.WNP_ALLOC(J)) THEN !GET AREAS - E_C=100 - GOTO 11 - END IF - CALL WNP_MAKL(N,POS,A_B(WQG_OUT1-A_OB)) !MAKE MULTIPLE LIST - IF (IAND(1,WQG_CLIP).NE.0) THEN - CALL WNP_NTRG(A_B(WQG_OUT1-A_OB), - 1 A_B(WQG_OUT3-A_OB)) !NORM. TRANSFORM - CALL WNP_PLCLP(A_B(WQG_OUT3-A_OB), - 1 A_B(WQG_OUT2-A_OB), - 1 WQG_NTR(0,2,WQG_CTR)) !CLIP VIEW - IF (A_J((WQG_OUT2-A_OB)/LB_J).LE.0) GOTO 900 !NONE LEFT - ELSE - CALL WNP_NTRG(A_B(WQG_OUT1-A_OB), - 1 A_B(WQG_OUT2-A_OB)) !NORM. TRANSFORM - END IF - GOTO 100 -C -C WQPOLL_LIST -C - ENTRY WQPOLL_LIST(PLIST) -C - WQPOLL_LIST=.TRUE. !ASSUME OK - J1=PLIST(1) - J0=1 - J=0 - DO WHILE (J1.NE.0) - J=J+J1 - J0=J0+2*J1+1 - J1=PLIST(J0) - END DO - J=15*J+2 !MULTIPLE LIST LENGTH - IF (.NOT.WNP_ALLOC(J)) THEN !GET AREAS - E_C=100 - GOTO 11 - END IF - IF (IAND(1,WQG_CLIP).NE.0) THEN - CALL WNP_NTRG(PLIST, - 1 A_B(WQG_OUT3-A_OB)) !NORM. TRANSFORM - CALL WNP_PLCLP(A_B(WQG_OUT3-A_OB), - 1 A_B(WQG_OUT2-A_OB), - 1 WQG_NTR(0,2,WQG_CTR)) !CLIP VIEW - IF (A_J((WQG_OUT2-A_OB)/LB_J).LE.0) GOTO 900 !NONE LEFT - ELSE - CALL WNP_NTRG(PLIST, - 1 A_B(WQG_OUT2-A_OB)) !NORM. TRANSFORM - END IF -C -C ON ALL ACTIVE DEVICES -C - 100 CONTINUE - J=WQG_QOP !START LIST - DO WHILE (J.NE.0) - J0=(J-A_OB)/LB_J !PTR - IF (A_J(J0+WQD_ACT_J).NE.0 .AND. - 1 IAND(A_J(J0+WQD_TYP_J),1).NE.0 .AND. - 1 IAND(A_J(J0+WQD_TYP_J),4).EQ.0) THEN !OUTPUT DEVICE - CALL WNP_PLCLP(A_B(WQG_OUT2-A_OB), - 1 A_B(WQG_OUT3-A_OB), - 1 A_E(J0+WQD_NTR_E+4)) !CLIP - IF (A_J((WQG_OUT3-A_OB)/LB_J).LE.0) GOTO 20 !NONE LEFT - CALL WNP_DNTRG(A_B(WQG_OUT3-A_OB), - 1 A_B(WQG_OUT1-A_OB),J) !DEVICE TRANSF. - J1=WQG_CPOLLIX-1 !CURRENT INDEX - IF (J1.GT.A_J(J0+WQD_NPLIX_J)) J1=0 !DEFAULT - J1=MAX(0,J1) !MAKE INDEX - VP(1)=J1 !INDEX - VP(2)=WQG_OUT1 !LIST ADDRESS - CALL WNPDEX(3,J,VP) !DRAW - END IF - 20 CONTINUE - J=A_J((J-A_OB)/LB_J) !NEXT DEVICE - END DO -C - 900 CONTINUE -C - RETURN -C -C - END - diff --git a/src/wng/wnprtn.for b/src/wng/wnprtn.for deleted file mode 100644 index f5f9f9398c06b9853ac7759d39a80c5280e81afd..0000000000000000000000000000000000000000 --- a/src/wng/wnprtn.for +++ /dev/null @@ -1,264 +0,0 @@ -C+ WNPRTN.FOR -C WNB 910624 -C -C Revisions: -C -C General routines WNP package -C - SUBROUTINE WNP_NTR1(IN1,OUT1) -C -C Result: -C -C CALL WNP_NTR1( IN1_E(*):I, OUT1_E(*):O) -C Do normalized transform of list IN1 starting -C with N in list -C CALL WNP_NTRG( IN1J_J(*):I, OUT1_E(*):O) -C Do normalized transform of multiple list IN1 -C starting with N in list -C -C CALL WNP_DNTR1( IN1_E(*):I, OUT1_E(*):O, ID1_J:I) -C Do device transform of list IN1 starting -C with N in list -C CALL WNP_DNTRG( IN1J_J(*):I, OUT1_E(*):O, ID1_J:I) -C Do device transform of multiple list IN1 -C starting with N in list -C -C CALL WNP_MAKL( N_J:I, INJ_J(*):I, OUTJ_J(*):O) -C Make a list of N points in OUTJ -C CALL WNP_PLCLP( IN1_E(*):I, OUT1_E(*):O, WIN_E(0:3)) -C Clip lines in IN1 list using window WIN -C CALL WNP_PMCLP( IN1_E(*):I, OUT1_E(*):O, WIN_E(0:3)) -C Clip points in IN1 list using window WIN -C CALL WNP_SHCLP( IN1_E(*):I, OUT1_E(*):O, WIN_E(0:3)) -C Clip points in IN1 list using window WIN, -C by setting DEL in OUT1 -C -C Include files: -C - INCLUDE 'WNG_DEF' - INCLUDE 'WQG_DEF' !GENERAL AREA - INCLUDE 'WQD_O_DEF' !DEVICE AREA -C -C Parameters: -C -C -C Arguments: -C - INTEGER N !NUMBER OF POINTS - REAL IN1(*) !INPUT LIST - INTEGER IN1J(*) - INTEGER INJ(*) - REAL OUT1(*) !OUTPUT LIST - INTEGER OUTJ(*) - INTEGER ID1 !ID - REAL WIN(0:3) !CLIP WINDOW -C -C Function references: -C - INTEGER WNGGJ !GET J VALUE -C -C Data declarations: -C - LOGICAL IDE !SWITCH - INTEGER K1 -C- -C -C NORMALIZED TRANSFORM NTR1 -C - CALL WNP_NTR0(IN1(1),IN1(2),OUT1(1),OUT1(2)) !DO TRANSFORM -C - RETURN -C -C DEVICE TRANSFORM DNTR1 -C - ENTRY WNP_DNTR1(IN1,OUT1,ID1) -C - CALL WNP_DNTR0(IN1(1),IN1(2),OUT1(1),OUT1(2),ID1) !DO TRANSFORM -C - RETURN -C -C NORMALIZED TRANSFORM NTRG -C - ENTRY WNP_NTRG(IN1J,OUT1) -C - J=1 !START MULTIPLE LIST - 50 CONTINUE - J1=IN1J(J) !# OF POINTS OF RUN - CALL WNP_NTR0(IN1J(J),IN1J(J+1),OUT1(J),OUT1(J+1)) !DO TRANSFORM - J=J+1+2*J1 !POINTER NEXT LIST - IF (J1.GT.0) GOTO 50 -C - RETURN -C -C DEVICE TRANSFORM DNTRG -C - ENTRY WNP_DNTRG(IN1J,OUT1,ID1) -C - J=1 !START MULTIPLE LIST - 60 CONTINUE - J1=IN1J(J) !# OF POINTS OF RUN - CALL WNP_DNTR0(IN1J(J),IN1J(J+1),OUT1(J),OUT1(J+1),ID1) !DO TRANSFORM - J=J+1+2*J1 !POINTER NEXT LIST - IF (J1.GT.0) GOTO 60 -C - RETURN -C -C MAKE LIST -C - ENTRY WNP_MAKL(N,INJ,OUTJ) -C - OUTJ(1)=N !SET LENGTH LIST - DO I=1,N !MAKE A LIST - OUTJ(2*I)=INJ(2*I-1) - OUTJ(2*I+1)=INJ(2*I) - END DO - OUTJ(2*N+2)=0 !EOL -C - RETURN -C -C CLIP POLYMARK LIST -C - ENTRY WNP_PMCLP(IN1,OUT1,WIN) -C - J0=2 !INPUT PTR - J=2 !OUTPUT PTR - J1=0 !OUTPUT CNT - DO I=1,WNGGJ(IN1(1)) !ALL POINTS - R0=IN1(J0) !X - R1=IN1(J0+1) !Y - J0=J0+2 !INPUT PTR - IF (R0.LT.WIN(0) .OR. R1.LT.WIN(1) .OR. R0.GT.WIN(2) .OR. - 1 R1.GT.WIN(3)) THEN - ELSE - OUT1(J)=R0 !SET OUTPUT - OUT1(J+1)=R1 - J=J+2 !OUTPUT PTR - J1=J1+1 !COUNT OUTPUT - END IF - END DO - CALL WNGMV(LB_J,J1,OUT1(1)) !OUTPUT CNT -C - RETURN -C -C CLIP SHADING LIST -C - ENTRY WNP_SHCLP(IN1,OUT1,WIN) -C - J0=2 !INPUT PTR - J=1 !OUTPUT PTR - DO I=1,WNGGJ(IN1(1)) !ALL POINTS - R0=IN1(J0) !X - R1=IN1(J0+1) !Y - J0=J0+2 !INPUT PTR - IF (R0.LT.WIN(0) .OR. R1.LT.WIN(1) .OR. R0.GT.WIN(2) .OR. - 1 R1.GT.WIN(3)) THEN !CLIP - OUT1(J)=-1 !SET DELETED - END IF - J=J+1 !OUTPUT POINTER - END DO -C - RETURN -C -C CLIP POLYLINE -C - ENTRY WNP_PLCLP(IN1,OUT1,WIN) -C - J0=1 !INPUT PTR - J1=1 !OUTPUT PTR -C -C ALL PIECES -C - J2=J1 !PTR FOR OUT CNT - CALL WNGMV(LB_J,0,OUT1(J2)) !SET EMPTY OUTPUT - J1=J1+1 !OUT PTR - 30 K1=WNGGJ(IN1(J0)) !IN CNT - J0=J0+1 !IN PTR - IF (K1.LE.0) GOTO 20 !ALL READY - 10 IDE=.FALSE. !START OF PIECE - K1=K1-1 !IN CNT - IF (K1.LT.1) THEN - J0=J0+2 !SKIP INPUT - GOTO 30 !NEXT PIECE - END IF - J=0 !OUTPUT CNT - OUT1(J1)=IN1(J0) !X1 - OUT1(J1+1)=IN1(J0+1) !Y1 - J0=J0+2 !IN PTR - IF (OUT1(J1).LT.WIN(0)) THEN !X1<XL - IF (IN1(J0).LT.WIN(0)) GOTO 10 !FORGET - OUT1(J1+1)=OUT1(J1+1)+(WIN(0)-OUT1(J1))*(IN1(J0+1)-OUT1(J1+1))/ - 1 (IN1(J0)-OUT1(J1)) !NEW Y1 - OUT1(J1)=WIN(0) !NEW X1 - END IF - IF (OUT1(J1+1).LT.WIN(1)) THEN !Y1<YL - IF (IN1(J0+1).LT.WIN(1)) GOTO 10 !FORGET - OUT1(J1)=OUT1(J1)+(WIN(1)-OUT1(J1+1))*(IN1(J0)-OUT1(J1))/ - 1 (IN1(J0+1)-OUT1(J1+1)) !NEW X1 - OUT1(J1+1)=WIN(1) !NEW Y1 - END IF - IF (OUT1(J1).GT.WIN(2)) THEN !X1>XH - IF (IN1(J0).GT.WIN(2)) GOTO 10 !FORGET - OUT1(J1+1)=OUT1(J1+1)+(WIN(2)-OUT1(J1))*(IN1(J0+1)-OUT1(J1+1))/ - 1 (IN1(J0)-OUT1(J1)) !NEW Y1 - OUT1(J1)=WIN(2) !NEW X1 - IF (OUT1(J1+1).LT.WIN(1)) GOTO 10 !FORGET Y1<YL - END IF - IF (OUT1(J1+1).GT.WIN(3)) THEN !Y1>YH - IF (IN1(J0+1).GT.WIN(3)) GOTO 10 !FORGET - OUT1(J1)=OUT1(J1)+(WIN(3)-OUT1(J1+1))*(IN1(J0)-OUT1(J1))/ - 1 (IN1(J0+1)-OUT1(J1+1)) !NEW X1 - OUT1(J1+1)=WIN(3) !NEW Y1 - IF (OUT1(J1).LT.WIN(0)) GOTO 10 !FORGET X1<XL - IF (OUT1(J1).GT.WIN(2)) GOTO 10 !FORGET X1>XH - END IF -C - 40 J1=J1+2 !OUT PTR - OUT1(J1)=IN1(J0) !X2 - OUT1(J1+1)=IN1(J0+1) !Y2 - IF (OUT1(J1).LT.WIN(0)) THEN !X2<XL - IDE=.TRUE. !FINISH PART - OUT1(J1+1)=OUT1(J1+1)+(WIN(0)-OUT1(J1))*(OUT1(J1-1)-OUT1(J1+1))/ - 1 (OUT1(J1-2)-OUT1(J1)) !NEW Y2 - OUT1(J1)=WIN(0) !NEW X2 - END IF - IF (OUT1(J1+1).LT.WIN(1)) THEN !Y2<YL - IDE=.TRUE. - OUT1(J1)=OUT1(J1)+(WIN(1)-OUT1(J1+1))*(OUT1(J1-2)-OUT1(J1))/ - 1 (OUT1(J1-1)-OUT1(J1+1)) !NEW X2 - OUT1(J1+1)=WIN(1) !NEW Y2 - END IF - IF (OUT1(J1).GT.WIN(2)) THEN !X2>XH - IDE=.TRUE. - OUT1(J1+1)=OUT1(J1+1)+(WIN(2)-OUT1(J1))*(OUT1(J1-1)-OUT1(J1+1))/ - 1 (OUT1(J1-2)-OUT1(J1)) !NEW Y2 - OUT1(J1)=WIN(2) !NEW X2 - END IF - IF (OUT1(J1+1).GT.WIN(3)) THEN !Y2>YH - IDE=.TRUE. - OUT1(J1)=OUT1(J1)+(WIN(3)-OUT1(J1+1))*(OUT1(J1-2)-OUT1(J1))/ - 1 (OUT1(J1-1)-OUT1(J1+1)) !NEW X2 - OUT1(J1+1)=WIN(3) !NEW Y2 - END IF -C - J=J+1 !OUT CNT - IF (.NOT.IDE) THEN !NEW PIECE - J0=J0+2 !SKIP INPUT - K1=K1-1 !CNT INPUT - IF (K1.GT.0) GOTO 40 !MORE INPUT - END IF - J=J+1 !CNT OUT - CALL WNGMV(LB_J,J,OUT1(J2)) !SET OUT CNT - J1=J1+2 !OUT PTR - J=0 !OUT CNT - J2=J1 !WHERE TO PUT - CALL WNGMV(LB_J,0,OUT1(J2)) - J1=J1+1 !OUT PTR - IF (K1.GT.0) GOTO 10 !CONTINUE SAME PIECE - GOTO 30 !NEXT PIECE - 20 CONTINUE - CALL WNGMV(LB_J,0,OUT1(J2)) !EOL -C - RETURN -C -C - END diff --git a/src/wng/wnprtn_x.for b/src/wng/wnprtn_x.for deleted file mode 100644 index 63d0562898c850806c723b9806b2e215dc43c72d..0000000000000000000000000000000000000000 --- a/src/wng/wnprtn_x.for +++ /dev/null @@ -1,70 +0,0 @@ -C+ WNPRTN_X.FOR -C WNB 910624 -C -C Revisions: -C -C General routines WNP package -C - SUBROUTINE WNP_NTR0(NIN,IN,NOUT,OUT) -C -C Result: -C -C CALL WNP_NTR0( NIN_J:I , IN_E(0:1,*):I, NOUT_J:O, OUT_E(0:1,*):O) -C Do normalized transform of list of N points -C in IN to OUT -C CALL WNP_DNTR0( NIN_J:I , IN_E(0:1,*):I, NOUT_J:O, OUT_E(0:1,*):O, -C ID_J:I) -C Do device transform of list of N points -C in IN to OUT -C -C Include files: -C - INCLUDE 'WNG_DEF' - INCLUDE 'WQG_DEF' !GENERAL AREA - INCLUDE 'WQD_O_DEF' !DEVICE AREA -C -C Parameters: -C -C -C Arguments: -C - INTEGER NIN !NUMBER OF POINTS - REAL IN(0:1,*) !INPUT LIST - INTEGER NOUT !NUMBER OF POINTS - REAL OUT(0:1,*) !OUTPUT LIST - INTEGER ID !ID -C -C Function references: -C -C -C Data declarations: -C -C- -C -C NORMALIZED TRANSFORM NTR0 -C - DO I=1,NIN !TRANSFORM POINTS - OUT(0,I)=WQG_NTR(0,0,WQG_CTR)*IN(0,I)+ !X - 1 WQG_NTR(1,0,WQG_CTR) - OUT(1,I)=WQG_NTR(2,0,WQG_CTR)*IN(1,I)+ !Y - 1 WQG_NTR(3,0,WQG_CTR) - END DO - NOUT=NIN -C - RETURN -C -C DEVICE TRANSFORM DNTR0 -C - ENTRY WNP_DNTR0(NIN,IN,NOUT,OUT,ID) -C - J=(ID-A_OB)/LB_E+WQD_NTR_E !TRANSFORM POINTER - DO I=1,NIN !TRANSFORM POINTS - OUT(0,I)=A_E(J+0)*IN(0,I)+A_E(J+1) - OUT(1,I)=A_E(J+2)*IN(1,I)+A_E(J+3) - END DO - NOUT=NIN -C - RETURN -C -C - END diff --git a/src/wng/wnprtn_y.for b/src/wng/wnprtn_y.for deleted file mode 100644 index 371d04186b92b8349b37f061eea94d7544c272c8..0000000000000000000000000000000000000000 --- a/src/wng/wnprtn_y.for +++ /dev/null @@ -1,55 +0,0 @@ -C+ WNPRTN_Y.FOR -C WNB 911121 -C -C Revisions: -C -C General routines WNP package -C - LOGICAL FUNCTION WNP_ALLOC(NIN) -C -C Result: -C -C WNP_ALLOC_J = WNP_ALLOC( NIN_J:I) -C Allocate OUT* areas if necessary -C -C Include files: -C - INCLUDE 'WNG_DEF' - INCLUDE 'WQG_DEF' !GENERAL AREA -C -C Parameters: -C -C -C Arguments: -C - INTEGER NIN !NUMBER OF WORDS -C -C Function references: -C - LOGICAL WNGGVM !GET MEMORY -C -C Data declarations: -C -C- - WNP_ALLOC=.TRUE. !ASSUME OK - IF (NIN.LE.WQG_LOUT) RETURN !ENOUGH AVAILABLE - IF (WQG_LOUT.GT.0) THEN !DEALLOCATE - CALL WNGFVM(WQG_LOUT*LB_J,WQG_OUT1) - CALL WNGFVM(WQG_LOUT*LB_J,WQG_OUT2) - CALL WNGFVM(WQG_LOUT*LB_J,WQG_OUT3) - END IF - WNP_ALLOC=.FALSE. !ASSUME ERROR - WQG_LOUT=0 - IF (WNGGVM(NIN*LB_J,WQG_OUT1)) THEN !ALLOCATE - IF (WNGGVM(NIN*LB_J,WQG_OUT2)) THEN - IF (WNGGVM(NIN*LB_J,WQG_OUT3)) THEN - WNP_ALLOC=.TRUE. !OK - WQG_LOUT=NIN - END IF - END IF - END IF -C - RETURN -C -C - END diff --git a/src/wng/wnpset.for b/src/wng/wnpset.for deleted file mode 100644 index fac6edd7dc9a43448dc6ddef750d6e2abfb06713..0000000000000000000000000000000000000000 --- a/src/wng/wnpset.for +++ /dev/null @@ -1,515 +0,0 @@ -C+ WNPSET.FOR -C WNB 911121 -C -C Revisions: -C -C Set parameter routines -C - LOGICAL FUNCTION WQSPLI(IX) -C -C Result: -C -C WQSPLI( IX_J:I) Set polyline index -C WQSPMI( IX_J:I) Set polymark index -C WQSFAI( IX_J:I) Set fill area index -C WQSTXI( IX_J:I) Set text index -C WQSTXH( FR_E:I) Set text height -C WQSTXU( UP_E(2):I) Set text direction -C WQSTXX( FR_E:I) Set text expansion -C WQSTXP( IX_J:I) Set text path -C WQSTXS( FR_E:I) Set text spacing -C WQSPID( IX_J:I) Set pick id -C WQSCLP( CLP_L:I) Set clip indicator -C WQSPSZ( UP_E(2):I) Set pattern size -C WQSPRP( UP_E(2):I) Set pattern reference point -C WQSPLR( ID_J:I, NIX_J:I, TP_J:I, SC_E:I) Polyline represent. -C WQSPLR_IC( ID_J:I, NIX_J:I, TP_J:I, SC_E:I, COL_J:I) Polyline colour -C WQSPMR( ID_J:I, NIX_J:I, TP_J:I, SC_E:I) Polymark represent. -C WQSPMR_IC( ID_J:I, NIX_J:I, TP_J:I, SC_E:I, COL_J:I) Polymark colour -C WQSTXR( ID_J:I, NIX_J:I, TP_J:I, PR_J:I) Text represent. -C WQSTXR_IC( ID_J:I, NIX_J:I, TP_J:I, PR_J, COL_J:I_J:I) Text colour -C -C Include files: -C - INCLUDE 'WNG_DEF' - INCLUDE 'WQG_DEF' !GENERAL AREA - INCLUDE 'WQD_O_DEF' !DEVICE AREA -C -C Entry points: -C - LOGICAL WQSPMI !SET POLYMARK INDEX - LOGICAL WQSFAI !SET FILL AREA INDEX - LOGICAL WQSTXI !SET TEXT INDEX - LOGICAL WQSTXH !SET TEXT HEIGHT - LOGICAL WQSTXU !SET TEXT DIRECTION - LOGICAL WQSTXX !SET TEXT EXPANSION - LOGICAL WQSTXP !SET TEXT PATH - LOGICAL WQSTXS !SET TEXT SPACING - LOGICAL WQSPID !SET PICK ID - LOGICAL WQSCLP !SET CLIP INDICATOR - LOGICAL WQSPSZ !SET PATTERN SIZE - LOGICAL WQSPRP !SET PATTERN REFERENCE POINT - LOGICAL WQSPLR !SET POLYLINE REPRESENTATION - LOGICAL WQSPLR_IC !... WITH COLOUR - LOGICAL WQSPMR !SET POLYMARK REPRESENTATION - LOGICAL WQSPMR_IC !... WITH COLOUR - LOGICAL WQSTXR !SET TEXT REPRESENTATION - LOGICAL WQSTXR_IC !... WITH COLOUR -C -C Parameters: -C -C -C Arguments: -C - INTEGER IX !POLYLINE INDEX - REAL FR !FACTOR - REAL UP(2) !TEXT DIRECTION - LOGICAL CLP !CLIP INDICATOR - INTEGER ID !DEVICE ID - INTEGER NIX !INDEX - INTEGER TP !LINE TYPE - REAL SC !LINE SCALE - INTEGER PR !PATTERN - INTEGER COL !COLOUR -C -C Function references: -C - LOGICAL WNPCID !CHECK DEVICE ID - LOGICAL WQOPEN !OPEN SYSTEM -C -C Data declarations: -C - LOGICAL LCOL !INCLUDE COLOUR -C- -C -C SPLI -C - WQSPLI=.TRUE. !ASSUME OK - IF (WQG_STATE.LE.0) WQSPLI=WQOPEN() !OPEN SYSTEM - IF (WQSPLI) THEN - IF (IX.LE.0) THEN - E_C=80 - WQSPLI=.FALSE. - ELSE - WQG_CPOLLIX=IX !SET INDEX - END IF - END IF -C - RETURN -C -C SPMI -C - ENTRY WQSPMI(IX) -C - WQSPMI=.TRUE. !ASSUME OK - IF (WQG_STATE.LE.0) WQSPMI=WQOPEN() !OPEN SYSTEM - IF (WQSPMI) THEN - IF (IX.LE.0) THEN - E_C=80 - WQSPMI=.FALSE. - ELSE - WQG_CPOLMIX=IX !SET INDEX - END IF - END IF -C - RETURN -C -C SFAI -C - ENTRY WQSFAI(IX) -C - WQSFAI=.TRUE. !ASSUME OK - IF (WQG_STATE.LE.0) WQSFAI=WQOPEN() !OPEN SYSTEM - IF (WQSFAI) THEN - IF (IX.LE.0) THEN - E_C=91 - WQSFAI=.FALSE. - ELSE - WQG_CFILAIX=IX !SET INDEX - END IF - END IF -C - RETURN -C -C STXI -C - ENTRY WQSTXI(IX) -C - WQSTXI=.TRUE. !ASSUME OK - IF (WQG_STATE.LE.0) WQSTXI=WQOPEN() !OPEN SYSTEM - IF (WQSTXI) THEN - IF (IX.LE.0) THEN - E_C=86 - WQSTXI=.FALSE. - ELSE - WQG_CTXTIX=IX !SET INDEX - END IF - END IF -C - RETURN -C -C STXH -C - ENTRY WQSTXH(FR) -C - WQSTXH=.TRUE. !ASSUME OK - IF (WQG_STATE.LE.0) WQSTXH=WQOPEN() !OPEN SYSTEM - IF (WQSTXH) THEN - IF (FR.LE.0) THEN - E_C=60 - WQSTXH=.FALSE. - ELSE - WQG_CTXHT=FR !SET HEIGHT - END IF - END IF -C - RETURN -C -C STXU -C - ENTRY WQSTXU(UP) -C - WQSTXU=.TRUE. !ASSUME OK - IF (WQG_STATE.LE.0) WQSTXU=WQOPEN() !OPEN SYSTEM - IF (WQSTXU) THEN - IF (UP(1).EQ.0 .AND. UP(2).EQ.0) THEN - E_C=61 - WQSTXU=.FALSE. - ELSE - WQG_CTXUP(0)=UP(1) !SET DIRECTION - WQG_CTXUP(1)=UP(2) - R0=ATAN2(UP(1),UP(2)) - WQG_CTXCS(0)=SIN(R0) - WQG_CTXCS(1)=COS(R0) - END IF - END IF -C - RETURN -C -C STXX -C - ENTRY WQSTXX(FR) -C - WQSTXX=.TRUE. !ASSUME OK - IF (WQG_STATE.LE.0) WQSTXX=WQOPEN() !OPEN SYSTEM - IF (WQSTXX) THEN - IF (FR.LE.0) THEN - E_C=62 - WQSTXX=.FALSE. - ELSE - WQG_CTXXP=FR !SET EXPANSION - END IF - END IF -C - RETURN -C -C STXP -C - ENTRY WQSTXP(IX) -C - WQSTXP=.TRUE. !ASSUME OK - IF (WQG_STATE.LE.0) WQSTXP=WQOPEN() !OPEN SYSTEM - IF (WQSTXP) THEN - WQG_CTXPA=IAND(3,IX) !SET PATH - END IF -C - RETURN -C -C STXS -C - ENTRY WQSTXS(FR) -C - WQSTXS=.TRUE. !ASSUME OK - IF (WQG_STATE.LE.0) WQSTXS=WQOPEN() !OPEN SYSTEM - IF (WQSTXS) THEN - WQG_CTXSP=FR !SET SPACING - END IF -C - RETURN -C -C SPID -C - ENTRY WQSPID(IX) -C - WQSPID=.TRUE. !ASSUME OK - IF (WQG_STATE.LE.0) WQSPID=WQOPEN() !OPEN SYSTEM - IF (WQSPID) THEN - WQG_CPID=IX !SET INDEX - END IF -C - RETURN -C -C SCLP -C - ENTRY WQSCLP(CLP) -C - WQSCLP=.TRUE. !ASSUME OK - IF (WQG_STATE.LE.0) WQSCLP=WQOPEN() !OPEN SYSTEM - IF (WQSCLP) THEN - IF (CLP) THEN - WQG_CLIP=1 - ELSE - WQG_CLIP=0 - END IF - END IF -C - RETURN -C -C SPSZ -C - ENTRY WQSPSZ(UP) -C - WQSPSZ=.TRUE. !ASSUME OK - IF (WQG_STATE.LE.0) WQSPSZ=WQOPEN() !OPEN SYSTEM - IF (WQSPSZ) THEN - IF (UP(1).LE.0 .OR. UP(2).LE.0) THEN - E_C=63 - WQSPSZ=.FALSE. - ELSE - WQG_CPTSZ(0)=UP(1) !SET PATTERN SIZE - WQG_CPTSZ(1)=UP(2) - END IF - END IF -C - RETURN -C -C SPRP -C - ENTRY WQSPRP(UP) -C - WQSPRP=.TRUE. !ASSUME OK - IF (WQG_STATE.LE.0) WQSPRP=WQOPEN() !OPEN SYSTEM - IF (WQSPRP) THEN - WQG_CPTRP(0)=UP(1) !SET PATTERN REF. PT. - WQG_CPTRP(1)=UP(2) - END IF -C - RETURN -C -C SPLR -C - ENTRY WQSPLR(ID,NIX,TP,SC) -C - LCOL=.FALSE. - GOTO 10 -C -C SPLR_IC -C - ENTRY WQSPLR_IC(ID,NIX,TP,SC,COL) -C - LCOL=.TRUE. - GOTO 10 -C - 10 CONTINUE - WQSPLR=.TRUE. !ASSUME OK - IF (WQG_STATE.LT.2) THEN - E_C=7 !ILLEGAL STATE - WQSPLR=.FALSE. - END IF - IF (WQSPLR) THEN - IF (.NOT.WNPCID(ID)) THEN - E_C=20 !WRONG ID - WQSPLR=.FALSE. - END IF - END IF - J0=(ID-A_OB)/LB_J !POINTER - IF (WQSPLR) THEN - IF (IAND(4,A_J(J0+WQD_TYP_J)).NE.0) THEN !DISS - E_C=35 - WQSPLR=.FALSE. - END IF - END IF - IF (WQSPLR) THEN - IF (IAND(8,A_J(J0+WQD_TYP_J)).NE.0 .AND. - 1 IAND(2,A_J(J0+WQD_TYP_J)).EQ.0) THEN !META INPUT - E_C=32 - WQSPLR=.FALSE. - END IF - END IF - IF (WQSPLR) THEN - IF (IAND(1,A_J(J0+WQD_TYP_J)).EQ.0) THEN !INPUT - E_C=34 - WQSPLR=.FALSE. - END IF - END IF - IF (WQSPLR) THEN - IF (NIX.LE.0 .OR. NIX.GT.A_J(J0+WQD_NPLIX_J)+1) THEN - E_C=80 !ILLEGAL INDEX - WQSPLR=.FALSE. - END IF - END IF - J=NIX-1 !TABLE POINTER - IF (WQSPLR) THEN - IF (TP.LE.0 .OR. TP.GT.A_J(J0+WQD_NPLT_J)) THEN - E_C=82 !ILLEGAL TYPE - WQSPLR=.FALSE. - ELSE - A_E(J0+WQD_PLIX_E+3*J+0)=TP !LINE TYPE - END IF - END IF - IF (WQSPLR) THEN - A_E(J0+WQD_PLIX_E+3*J+1)=SC !LINE SCALE - END IF - IF (WQSPLR .AND. LCOL) THEN - IF (COL.LT.0 .OR. COL.GT.A_J(J0+WQD_NCLIX_J)+1) THEN - E_C=96 !ILLEGAL COLOUR - WQSPLR=.FALSE. - ELSE - A_E(J0+WQD_PLIX_E+3*J+2)=COL !LINE COLOUR - END IF - END IF -C - RETURN -C -C SPMR -C - ENTRY WQSPMR(ID,NIX,TP,SC) -C - LCOL=.FALSE. - GOTO 11 -C -C SPMR_IC -C - ENTRY WQSPMR_IC(ID,NIX,TP,SC,COL) -C - LCOL=.TRUE. - GOTO 11 -C - 11 CONTINUE - WQSPMR=.TRUE. !ASSUME OK - IF (WQG_STATE.LT.2) THEN - E_C=7 !ILLEGAL STATE - WQSPMR=.FALSE. - END IF - IF (WQSPMR) THEN - IF (.NOT.WNPCID(ID)) THEN - E_C=20 !WRONG ID - WQSPMR=.FALSE. - END IF - END IF - J0=(ID-A_OB)/LB_J !POINTER - IF (WQSPMR) THEN - IF (IAND(4,A_J(J0+WQD_TYP_J)).NE.0) THEN !DISS - E_C=35 - WQSPMR=.FALSE. - END IF - END IF - IF (WQSPMR) THEN - IF (IAND(8,A_J(J0+WQD_TYP_J)).NE.0 .AND. - 1 IAND(2,A_J(J0+WQD_TYP_J)).EQ.0) THEN !META INPUT - E_C=32 - WQSPMR=.FALSE. - END IF - END IF - IF (WQSPMR) THEN - IF (IAND(1,A_J(J0+WQD_TYP_J)).EQ.0) THEN !INPUT - E_C=34 - WQSPMR=.FALSE. - END IF - END IF - IF (WQSPMR) THEN - IF (NIX.LE.0 .OR. NIX.GT.A_J(J0+WQD_NPMIX_J)+1) THEN - E_C=83 !ILLEGAL INDEX - WQSPMR=.FALSE. - END IF - END IF - J=NIX-1 !TABLE POINTER - IF (WQSPMR) THEN - IF (TP.LE.0 .OR. TP.GT.A_J(J0+WQD_NPMT_J)) THEN - E_C=85 !ILLEGAL TYPE - WQSPMR=.FALSE. - ELSE - A_E(J0+WQD_PMIX_E+3*J+0)=TP !LINE TYPE - END IF - END IF - IF (WQSPMR) THEN - A_E(J0+WQD_PMIX_E+3*J+1)=SC !LINE SCALE - END IF - IF (WQSPMR .AND. LCOL) THEN - IF (COL.LT.0 .OR. COL.GT.A_J(J0+WQD_NCLIX_J)+1) THEN - E_C=96 !ILLEGAL COLOUR - WQSPMR=.FALSE. - ELSE - A_E(J0+WQD_PMIX_E+3*J+2)=COL !LINE COLOUR - END IF - END IF -C - RETURN -C -C STXR -C - ENTRY WQSTXR(ID,NIX,TP,PR) -C - LCOL=.FALSE. - GOTO 12 -C -C STXR_IC -C - ENTRY WQSTXR_IC(ID,NIX,TP,PR,COL) -C - LCOL=.TRUE. - GOTO 12 -C - 12 CONTINUE - WQSTXR=.TRUE. !ASSUME OK - IF (WQG_STATE.LT.2) THEN - E_C=7 !ILLEGAL STATE - WQSTXR=.FALSE. - END IF - IF (WQSTXR) THEN - IF (.NOT.WNPCID(ID)) THEN - E_C=20 !WRONG ID - WQSTXR=.FALSE. - END IF - END IF - J0=(ID-A_OB)/LB_J !POINTER - IF (WQSTXR) THEN - IF (IAND(4,A_J(J0+WQD_TYP_J)).NE.0) THEN !DISS - E_C=35 - WQSTXR=.FALSE. - END IF - END IF - IF (WQSTXR) THEN - IF (IAND(8,A_J(J0+WQD_TYP_J)).NE.0 .AND. - 1 IAND(2,A_J(J0+WQD_TYP_J)).EQ.0) THEN !META INPUT - E_C=32 - WQSTXR=.FALSE. - END IF - END IF - IF (WQSTXR) THEN - IF (IAND(1,A_J(J0+WQD_TYP_J)).EQ.0) THEN !INPUT - E_C=34 - WQSTXR=.FALSE. - END IF - END IF - IF (WQSTXR) THEN - IF (NIX.LE.0 .OR. NIX.GT.A_J(J0+WQD_NTXIX_J)+1) THEN - E_C=86 !ILLEGAL INDEX - WQSTXR=.FALSE. - END IF - END IF - J=NIX-1 !TABLE POINTER - IF (WQSTXR) THEN - IF (TP.LE.0 .OR. TP.GT.WQG_NFONT) THEN - E_C=89 !ILLEGAL FONT - WQSTXR=.FALSE. - ELSE - A_E(J0+WQD_TXIX_E+3*J+0)=TP !FONT - END IF - END IF - IF (WQSTXR) THEN - A_E(J0+WQD_TXIX_E+3*J+1)=IAND(PR,3) !PRECISION - END IF - IF (WQSTXR) THEN - IF (COL.LT.0 .OR. COL.GT.A_J(J0+WQD_NCLIX_J)+1) THEN - E_C=96 !ILLEGAL COLOUR - WQSTXR=.FALSE. - ELSE - A_E(J0+WQD_TXIX_E+3*J+2)=COL !LINE COLOUR - END IF - END IF -C - RETURN -C -C - END diff --git a/src/wng/wnpsev.for b/src/wng/wnpsev.for deleted file mode 100644 index f692f9f690340f1865882edfb94f1d519c342262..0000000000000000000000000000000000000000 --- a/src/wng/wnpsev.for +++ /dev/null @@ -1,257 +0,0 @@ -C+ WNPSEV.FOR -C WNB 911127 -C -C Revisions: -C -C Set windows etc. routines -C - LOGICAL FUNCTION WQSLNT(ID) -C -C Result: -C -C WQSLNT( ID_J:I) Select norm. transform -C WQSWIN( ID_J:I, WIN_E(4)) Set window -C WQSVIE( ID_J:I, WIN_E(4)) Set viewport -C WQSDVW( ID_J:I, WIN_E(4)) Set device window -C WQSDVV( ID_J:I, WIN_E(4)) Set device viewport -C -C Include files: -C - INCLUDE 'WNG_DEF' - INCLUDE 'WQG_DEF' !GENERAL AREA - INCLUDE 'WQD_O_DEF' !DEVICE AREA -C -C Entry points: -C - LOGICAL WQSWIN !SET WINDOW - LOGICAL WQSVIE !SET VIEWPORT - LOGICAL WQSDVW !SET DEVICE WINDOW - LOGICAL WQSDVV !SET DEVICE VIEWPORT -C -C Parameters: -C -C -C Arguments: -C - INTEGER ID !DEVICE ID - REAL WIN(4) !WINDOW/VIEWPORT -C -C Function references: -C - LOGICAL WNPCID !CHECK DEVICE ID - LOGICAL WQOPEN !OPEN SYSTEM -C -C Data declarations: -C - REAL LNTR(0:3,0:2) !DEVICE WINDOW/VIEW - REAL R2,R3 -C- -C -C SLNT -C - WQSLNT=.TRUE. !ASSUME OK - IF (WQG_STATE.LE.0) WQSLNT=WQOPEN() !OPEN SYSTEM - IF (WQSLNT) THEN - IF (ID.GT.WQG__NMXTR) THEN - E_C=40 - WQSLNT=.FALSE. - ELSE - WQG_CTR=MAX(0,ID) !SET INDEX - END IF - END IF -C - RETURN -C -C SWIN -C - ENTRY WQSWIN(ID,WIN) -C - WQSWIN=.TRUE. !ASSUME OK - IF (WQG_STATE.LE.0) WQSWIN=WQOPEN() !OPEN SYSTEM - IF (WQSWIN) THEN - IF (ID.LE.0 .OR. ID.GT.WQG__NMXTR) THEN - E_C=40 - WQSWIN=.FALSE. - ELSE IF (WIN(1).GE.WIN(3) .OR. WIN(2).GE.WIN(4)) THEN - E_C=41 - WQSWIN=.FALSE. - ELSE - WQG_NTR(0,1,ID)=WIN(1) - WQG_NTR(1,1,ID)=WIN(2) - WQG_NTR(2,1,ID)=WIN(3) - WQG_NTR(3,1,ID)=WIN(4) - 100 CONTINUE - R0=WQG_NTR(1,1,ID)-WQG_NTR(3,1,ID) !W0-W1 - R1=WQG_NTR(1,2,ID)-WQG_NTR(3,2,ID) !V0-V1 - WQG_NTR(2,0,ID)=R1/R0 !A - R2=R0*WQG_NTR(3,2,ID) !V1*(W0-W1) - R3=R1*WQG_NTR(3,1,ID) !W1*(V0-V1) - WQG_NTR(3,0,ID)=(R2-R3)/R0 !B - R0=WQG_NTR(0,1,ID)-WQG_NTR(2,1,ID) !W0-W1 - R1=WQG_NTR(0,2,ID)-WQG_NTR(2,2,ID) !V0-V1 - WQG_NTR(0,0,ID)=R1/R0 !A - R2=R0*WQG_NTR(2,2,ID) !V1*(W0-W1) - R3=R1*WQG_NTR(2,1,ID) !W1*(V0-V1) - WQG_NTR(1,0,ID)=(R2-R3)/R0 !B - END IF - END IF -C - RETURN -C -C SVIE -C - ENTRY WQSVIE(ID,WIN) -C - WQSVIE=.TRUE. !ASSUME OK - IF (WQG_STATE.LE.0) WQSVIE=WQOPEN() !OPEN SYSTEM - IF (WQSVIE) THEN - IF (ID.LE.0 .OR. ID.GT.WQG__NMXTR) THEN - E_C=40 - WQSVIE=.FALSE. - ELSE IF (WIN(1).GE.WIN(3) .OR. WIN(2).GE.WIN(4)) THEN - E_C=41 - WQSVIE=.FALSE. - ELSE IF (WIN(1).LT.0 .OR. WIN(2).LT.0 .OR. WIN(3).GT.1 .OR. - 1 WIN(4).GT.1) THEN - E_C=43 - WQSVIE=.FALSE. - ELSE - WQG_NTR(0,2,ID)=WIN(1) - WQG_NTR(1,2,ID)=WIN(2) - WQG_NTR(2,2,ID)=WIN(3) - WQG_NTR(3,2,ID)=WIN(4) - GOTO 100 - END IF - END IF -C - RETURN -C -C SDVW -C - ENTRY WQSDVW(ID,WIN) -C - WQSDVW=.TRUE. !ASSUME OK - IF (WQG_STATE.LT.2) THEN - E_C=7 !ILLEGAL STATE - WQSDVW=.FALSE. - END IF - IF (WQSDVW) THEN - IF (.NOT.WNPCID(ID)) THEN - E_C=20 !WRONG ID - WQSDVW=.FALSE. - END IF - END IF - J0=(ID-A_OB)/LB_J !POINTER - IF (WQSDVW) THEN - IF (IAND(4,A_J(J0+WQD_TYP_J)).NE.0) THEN !DISS - E_C=35 - WQSDVW=.FALSE. - END IF - END IF - IF (WQSDVW) THEN - IF (IAND(8,A_J(J0+WQD_TYP_J)).NE.0 .AND. - 1 IAND(2,A_J(J0+WQD_TYP_J)).NE.0) THEN !META INPUT - E_C=32 - WQSDVW=.FALSE. - END IF - END IF - IF (WQSDVW) THEN - IF (WIN(1).GE.WIN(3) .OR. WIN(2).GE.WIN(4)) THEN - E_C=41 - WQSDVW=.FALSE. - ELSE IF (WIN(1).LT.0 .OR. WIN(2).LT.0 .OR. WIN(3).GT.1 .OR. - 1 WIN(4).GT.1) THEN - E_C=44 - WQSDVW=.FALSE. - ELSE - A_E(J0+WQD_NTR_E+1*4+0)=WIN(1) !SET WINDOW - A_E(J0+WQD_NTR_E+1*4+1)=WIN(2) - A_E(J0+WQD_NTR_E+1*4+2)=WIN(3) - A_E(J0+WQD_NTR_E+1*4+3)=WIN(4) - 200 CONTINUE - A_E(J0+WQD_NTR_E+2+2*4)=A_E(J0+WQD_NTR_E+2+2*4)- - 1 A_E(J0+WQD_NTR_E+0+2*4) !SHIFT TO CORNER - A_E(J0+WQD_NTR_E+3+2*4)=A_E(J0+WQD_NTR_E+3+2*4)- - 1 A_E(J0+WQD_NTR_E+1+2*4) - A_E(J0+WQD_NTR_E+0+2*4)=0 - A_E(J0+WQD_NTR_E+1+2*4)=0 - DO J=0,2 !SAVE - DO J1=0,3 - LNTR(J1,J)=A_E(J0+WQD_NTR_E+J1+J*4) - END DO - END DO - R0=(LNTR(2,1)-LNTR(0,1))/LNTR(2,2) !ASPECT - R1=(LNTR(3,1)-LNTR(1,1))/LNTR(3,2) - IF (R0.GT.R1) THEN - LNTR(3,2)=LNTR(3,2)*R1/R0 !ASPECT RATIO - ELSE IF (R0.LT.R1) THEN - LNTR(2,2)=LNTR(2,2)*R0/R1 - END IF - R0=LNTR(1,1)-LNTR(3,1) !W0-W1 - R1=LNTR(1,2)-LNTR(3,2) !V0-V1 - A_E(J0+WQD_NTR_E+2+0*4)=R1/R0 !A - R2=R0*LNTR(3,2) !V1*(W0-W1) - R3=R1*LNTR(3,1) !W1*(V0-V1) - A_E(J0+WQD_NTR_E+3+0*4)=(R2-R3)/R0 !B - R0=LNTR(0,1)-LNTR(2,1) !W0-W1 - R1=LNTR(0,2)-LNTR(2,2) !V0-V1 - A_E(J0+WQD_NTR_E+0+0*4)=R1/R0 !A - R2=R0*LNTR(2,2) !V1*(W0-W1) - R3=R1*LNTR(2,1) !W1*(V0-V1) - A_E(J0+WQD_NTR_E+1+0*4)=(R2-R3)/R0 !B - END IF - END IF -C - RETURN -C -C SDVV -C - ENTRY WQSDVV(ID,WIN) -C - WQSDVV=.TRUE. !ASSUME OK - IF (WQG_STATE.LT.2) THEN - E_C=7 !ILLEGAL STATE - WQSDVV=.FALSE. - END IF - IF (WQSDVV) THEN - IF (.NOT.WNPCID(ID)) THEN - E_C=20 !WRONG ID - WQSDVV=.FALSE. - END IF - END IF - J0=(ID-A_OB)/LB_J !POINTER - IF (WQSDVV) THEN - IF (IAND(4,A_J(J0+WQD_TYP_J)).NE.0) THEN !DISS - E_C=35 - WQSDVV=.FALSE. - END IF - END IF - IF (WQSDVV) THEN - IF (IAND(8,A_J(J0+WQD_TYP_J)).NE.0 .AND. - 1 IAND(2,A_J(J0+WQD_TYP_J)).NE.0) THEN !META INPUT - E_C=32 - WQSDVV=.FALSE. - END IF - END IF - IF (WQSDVV) THEN - IF (WIN(1).GE.WIN(3) .OR. WIN(2).GE.WIN(4)) THEN - E_C=41 - WQSDVV=.FALSE. - ELSE IF (WIN(1).LT.0 .OR. WIN(2).LT.0 .OR. - 1 WIN(3).GT.A_E(J0+WQD_XHI_E) .OR. - 1 WIN(4).GT.A_E(J0+WQD_YHI_E)) THEN - E_C=45 - WQSDVV=.FALSE. - ELSE - A_E(J0+WQD_NTR_E+2*4+0)=WIN(1) - A_E(J0+WQD_NTR_E+2*4+1)=WIN(2) - A_E(J0+WQD_NTR_E+2*4+2)=WIN(3) - A_E(J0+WQD_NTR_E+2*4+3)=WIN(4) - GOTO 200 - END IF - END IF -C - RETURN -C -C - END diff --git a/src/wng/wnptwo.for b/src/wng/wnptwo.for deleted file mode 100644 index 55185178378f99bae9ff10a05ac3a16f8f1d7977..0000000000000000000000000000000000000000 --- a/src/wng/wnptwo.for +++ /dev/null @@ -1,895 +0,0 @@ -C+ WNPTWO.FOR -C WNB 911211 -C -C Revisions: -C HjV 930513 Increase piece buffer -C WNB 930517 Decrease piece buffer -C CMV 941214 Pol.vectors were double sized -C -C Two-dimensional plot routines -C - LOGICAL FUNCTION WQ_CONX(CID) -C -C Result: -C -C WQ_CONI( CID_J:O, N_J:I, POS_E(0:1):I, DPOS_E(0:1,0:1):I, -C NC_J:I, CONT_E(0:*):I) -C Initialise contouring for area with ident CID. -C Area has lines with N points, the first point -C at POS, the next point at +DPOS(*,0). The -C next line is at +DPOS(*,1). There are NC -C contours given in CONT. -C WQ_CONJ( CID_J:O, N_J:I, POS_E(0:1):I, DPOS_E(0:1,0:1):I, -C NC_J:I, CONT_E(0:*):I, DEL_E:I, LIX_J:I) -C Same, but also specify a value DEL indicating -C values to be discarded (or 0 if not), and a -C line type LIX. -C WQ_CONT( CID_J:I, LIST_E(0:*)) -C Give all N intensities in LIST on a line in -C in area CID -C WQ_CONX( CID_J:I) Finish contouring. -C -C WQ_SHADI( CID_J:O, N_J:I, POS_E(0:1):I, DPOS_E(0:1,0:1):I, -C TYP_J:I, RANGE_E(0:1), DEL_E:I) -C Initialise halftone for area with ident CID. -C Area has lines with N points, the first point -C at POS, the next point at +DPOS(*,0). The -C next line is at +DPOS(*,1). Shading TYP to be -C used for the given RANGE. DEL indicates (or 0) -C points to delete. -C WQ_SHADJ( CID_J:O, N_J:I, POS_E(0:1):I, DPOS_E(0:1,0:1):I, -C NC_J:I, CONT_E(0:*):I, DEL_E:I, LIX_J:I) -C Initialise halftone for area with ident CID. -C Area has lines with N points, the first point -C at POS, the next point at +DPOS(*,0). The -C next line is at +DPOS(*,1). Shading LIX to be -C used. NC and CONT specify a list of contour -C values to separate shadings. -C WQ_SHADE( CID_J:I, LIST_E(0:*)) -C Give all N intensities in LIST on a line in -C in area CID. -C WQ_SHADX( CID_J:I) Finish halftone -C WQ_POLI( CID_J:O, N_J:I, POS_E(0:1):I, DPOS_E(0:1,0:1):I, -C SCAL_E:I, RANGE_E(0:1), DEL_E:I) -C Initialise polarisation vectors for area with -C ident CID. Area has lines withN points, the first -C point at POS, the next at +DPOS(*,0). The -C next line is at +DPOS(*,1). -C RANGE let only plot if value > low, and limit -C length to high. SCAL gives scale in x, y coord. -C of amplitude. -C WQ_POLT( CID_J:I, LIST_E(0:*), LISTA_E(0:*)) -C Draw vectors for line with intensities LIST and -C angles (radians) in LISTA -C WQ_POLX( CID_J:I) Finish polarisation -C WQ_RULI( CID_J:O, N_J:I, POS_E(0:1):I, DPOS_E(0:1,0:1):I, -C SCAL_E:I, RANGE_E(0:1), DEL_E:I, TYP_J:I) -C Initialise ruled surface for area with -C ident CID. Area has lines with N points, the first -C point at POS, the next at +DPOS(*,0). The -C next line is at +DPOS(*,1). -C RANGE cut-off of plot. -C SCAL gives scale in x, y coord. -C of amplitude. -C TYP (0: hide, 1: full, 2: dot) -C WQ_RULE( CID_J:I, LIST_E(0:*)) -C Draw ruled surface for data in LIST. -C WQ_RULX( CID_J:I) Finish polarisation -C -C Include files: -C - INCLUDE 'WNG_DEF' - INCLUDE 'WQG_DEF' !GENERAL AREA - INCLUDE 'WQI_O_DEF' !CONTROL AREA -C -C Entry points: -C - LOGICAL WQ_CONI, WQ_CONJ, WQ_CONT !CONTOURING - LOGICAL WQ_SHADX, WQ_SHADI, WQ_SHADJ, WQ_SHADE !SHADING - LOGICAL WQ_POLX, WQ_POLI, WQ_POLT !POL. VECTORS - LOGICAL WQ_RULX, WQ_RULI, WQ_RULE !RULED SURFACE -C -C Parameters: -C -C -C Arguments: -C - INTEGER CID !AREA INDEX - INTEGER N !# OF POINTS/LINE - REAL POS(0:1) !START POSITION FIRST POINT, LINE - REAL DPOS(0:3) !INCREMENT NEXT POINT, NEXT LINE - INTEGER NC !# OF CONTOURS - REAL CONT(0:*) !CONTOUR VALUES - REAL DEL !DELETE VALUE - INTEGER LIX !LINE INDEX - INTEGER TYP !SHADING TYPE - REAL SCAL !SCALE - REAL RANGE(0:1) !SHADING RANGE - REAL LIST(0:*) !DATA LINE - REAL LISTA(0:1) !POL. ANGLES -C -C Function references: -C - LOGICAL WNGGVM !GET MEMORY -C -C Data declarations: -C - REAL LDEL !DELETE VALUE - INTEGER LLIX !LINE INDEX - INTEGER LNC !# OF CONTOURS - INTEGER PCE,PCJ !CONTOUR POINTERS - INTEGER PDE,PDXE !DATA POINTER - INTEGER P1E,P1J !CROSSPOINT BUFFER - INTEGER P2E !PIECE BUFFER - REAL POSO(0:3) !OLD POS. - REAL POSN(0:3) !NEW POS. - REAL POSC(0:1) !CENTRE POS. - REAL IC !INTENSITY - INTEGER CIND !CONTOURS FOUND - REAL IV(0:1) !INTENSITY FOR CROSS - REAL PS(0:3) !POSITIONS CROSS PTS - INTEGER CTP(0:7) !CONTOUR TYPE SWITCH - DATA CTP/9,3,6,12,1,2,4,8/ - REAL W1(0:1) !CONTOUR INTENSITIES - REAL R2,R3 -C- -C -C CONX -C - GOTO 100 -C -C SHADX -C - ENTRY WQ_SHADX(CID) -C - GOTO 100 -C -C POLX -C - ENTRY WQ_POLX(CID) -C - GOTO 100 -C -C RULX -C - ENTRY WQ_RULX(CID) -C - GOTO 100 -C -C EXIT PLOTTING -C - 100 CONTINUE - J=A_J(CID+WQI_LEN_J) !LENGTH AREA - CALL WNGFVM(J,CID*LB_E+A_OB) !FREE AREA - CID=0 !SET FREE - WQ_CONX=.TRUE. !OK -C - RETURN -C -C CONI -C - ENTRY WQ_CONI(CID,N,POS,DPOS,NC,CONT) -C - LDEL=0 !NO DELETE - LLIX=0 !NO LINE INDEX - GOTO 200 -C -C CONJ -C - ENTRY WQ_CONJ(CID,N,POS,DPOS,NC,CONT,DEL,LIX) -C - LDEL=DEL !DELETE VALUE - LLIX=LIX !LINE INDEX - GOTO 200 -C -C CONTOURING INIT -C - 200 CONTINUE - WQ_CONI=.FALSE. !ASSUME ERROR - CID=0 - J=WQIHDL+LB_E*(2*NC+N) !AREA LENGTH - J=J+2*6*(LB_E+LB_J)*NC !CROSSPOINT BUFFER - J=J+(1+2*(2*3+1))*LB_E*NC !PIECE BUFFER - IF (.NOT.WNGGVM(J,J0)) RETURN !GET AREA - CALL WNGMVZ(WQIHDL,A_B(J0-A_OB)) !CLEAR AREA - WQ_CONI=.TRUE. !OK - CID=(J0-A_OB)/LB_E !AREA POINTER - A_J(CID+WQI_LEN_J)=J !AREA LENGTH -C -C FILL -C - A_J(CID+WQI_NC_J)=NC !# OF CONTOURS - A_J(CID+WQI_CAE_J)=CID+WQIHDL/LB_E !CONTOUR LIST POINTER - A_J(CID+WQI_CAJ_J)=A_J(CID+WQI_CAE_J)+NC !CONTOUR LINK POINTER - A_J(CID+WQI_N_J)=N !LINE LENGTH - A_J(CID+WQI_PAD_J)=A_J(CID+WQI_CAJ_J)+NC !LINE BUFFER - A_J(CID+WQI_NE1_J)=2*6*NC !CROSSPOINT BUF. LENGTH - A_J(CID+WQI_BAE1_J)=A_J(CID+WQI_PAD_J)+N !CROSSPOINT BUFFER - A_J(CID+WQI_NJ1_J)=2*6*NC !CROSSPOINT BUF. LENGTH - A_J(CID+WQI_BAJ1_J)=A_J(CID+WQI_BAE1_J)+2*6*NC !CROSSPOINT BUFFER - A_J(CID+WQI_NE2_J)=(1+2*(2*3+1))*NC !PIECE BUF. LENGTH - A_J(CID+WQI_BAE2_J)=A_J(CID+WQI_BAJ1_J)+2*6*NC !PIECE BUFFER - DO I=0,3 - A_E(CID+WQI_DPOS_E+I)=DPOS(I) !INCREMENT POSITION - END DO - DO I=0,1 - A_E(CID+WQI_POS_E+I)=POS(I)-DPOS(2+I) !FIRST POSITION - END DO - A_E(CID+WQI_DEL_E)=LDEL !DELETE VALUE - A_J(CID+WQI_LIX_J)=LLIX !LINE INDEX - DO I=0,1 !CENTRE POSITION - A_E(CID+WQI_POSC_E+I)=POS(I)- - 1 0.5*(DPOS(I)+DPOS(2+I)) - END DO - PCE=A_J(CID+WQI_CAE_J) !CONTOUR LIST POINTER - PCJ=A_J(CID+WQI_CAJ_J) !CONTOUR LINK POINTER - DO I=0,NC-1 !SET CONTOURS - A_E(PCE+I)=CONT(I) - A_J(PCJ+I)=0 !LINK - END DO - DO I=0,NC-2 !SORT CONTOURS - DO I1=0,NC-2-I - IF (A_E(PCE+I1).GT.A_E(PCE+I1+1)) THEN !REVERSE - R0=A_E(PCE+I1) - A_E(PCE+I1)=A_E(PCE+I1+1) - A_E(PCE+I1+1)=R0 - END IF - END DO - END DO -C - RETURN -C -C SHADI -C - ENTRY WQ_SHADI(CID,N,POS,DPOS,TYP,RANGE,DEL) -C - LLIX=TYP !TYPE - LNC=0 !# OF CONTOURS - GOTO 300 -C -C SHADJ -C - ENTRY WQ_SHADJ(CID,N,POS,DPOS,NC,CONT,DEL,LIX) -C - LLIX=LIX !TYPE - LNC=NC !# OF CONTOURS - GOTO 300 -C -C SHADING INIT -C - 300 CONTINUE - WQ_SHADI=.FALSE. !ASSUME ERROR - CID=0 - J=WQIHDL+LB_E*(2*LNC+2*N) !AREA LENGTH - IF (.NOT.WNGGVM(J,J0)) RETURN !GET AREA - CALL WNGMVZ(WQIHDL,A_B(J0-A_OB)) !CLEAR AREA - WQ_SHADI=.TRUE. !OK - CID=(J0-A_OB)/LB_E !AREA POINTER - A_J(CID+WQI_LEN_J)=J !AREA LENGTH -C -C FILL -C - A_J(CID+WQI_NC_J)=LNC !# OF CONTOURS - A_J(CID+WQI_CAE_J)=CID+WQIHDL/LB_E !CONTOUR LIST POINTER - A_J(CID+WQI_CAJ_J)=A_J(CID+WQI_CAE_J)+LNC !CONTOUR LINK POINTER - A_J(CID+WQI_N_J)=N !LINE LENGTH - A_J(CID+WQI_PAD_J)=A_J(CID+WQI_CAJ_J)+LNC !LINE BUFFER - A_J(CID+WQI_PADX_J)=A_J(CID+WQI_CAJ_J)+N !CENTRE INT. BUFFER - DO I=0,3 - A_E(CID+WQI_DPOS_E+I)=DPOS(I) !INCREMENT POSITION - END DO - DO I=0,1 - A_E(CID+WQI_POS_E+I)=POS(I)-DPOS(2+I) !POSITION - END DO - A_E(CID+WQI_DEL_E)=DEL !DELETE VALUE - A_J(CID+WQI_LIX_J)=LLIX !TYPE - IF (LNC.EQ.0) THEN !SET RANGE - A_E(CID+WQI_MXMN_E)=RANGE(1)-RANGE(0) - IF (A_E(CID+WQI_MXMN_E).EQ.0) A_E(CID+WQI_MXMN_E)=1. - A_E(CID+WQI_MXMN_E)=1./A_E(CID+WQI_MXMN_E) !A - A_E(CID+WQI_MXMN_E+1)=-RANGE(0)*A_E(CID+WQI_MXMN_E) - END IF - PCE=A_J(CID+WQI_CAE_J) !CONTOUR LIST POINTER - PCJ=A_J(CID+WQI_CAJ_J) !CONTOUR LINK POINTER - DO I=0,LNC-1 !SET CONTOURS - A_E(PCE+I)=CONT(I) - A_J(PCJ+I)=0 !LINK - END DO - DO I=0,LNC-2 !SORT CONTOURS - DO I1=0,LNC-2-I - IF (A_E(PCE+I1).GT.A_E(PCE+I1+1)) THEN !REVERSE - R0=A_E(PCE+I1) - A_E(PCE+I1)=A_E(PCE+I1+1) - A_E(PCE+I1+1)=R0 - END IF - END DO - END DO -C - RETURN -C -C POLI -C - ENTRY WQ_POLI(CID,N,POS,DPOS,SCAL,RANGE,DEL) -C -C POL. INIT -C - WQ_POLI=.FALSE. !ASSUME ERROR - CID=0 - J=WQIHDL !AREA LENGTH - IF (.NOT.WNGGVM(J,J0)) RETURN !GET AREA - CALL WNGMVZ(WQIHDL,A_B(J0-A_OB)) !CLEAR AREA - WQ_POLI=.TRUE. !OK - CID=(J0-A_OB)/LB_E !AREA POINTER - A_J(CID+WQI_LEN_J)=J !AREA LENGTH -C -C FILL -C - DO I=0,1 - A_E(CID+WQI_MXMN_E+I)=RANGE(I) !RANGE - END DO - A_E(CID+WQI_USE_E+0)=SCAL !SCALE - A_J(CID+WQI_N_J)=N !LINE LENGTH - DO I=0,3 - A_E(CID+WQI_DPOS_E+I)=DPOS(I) !INCREMENT POSITION - END DO - DO I=0,1 - A_E(CID+WQI_POS_E+I)=POS(I) !POSITION - END DO - A_E(CID+WQI_DEL_E)=DEL !DELETE VALUE -C - RETURN -C -C RULI -C - ENTRY WQ_RULI(CID,N,POS,DPOS,SCAL,RANGE,DEL,LIX) -C -C RULED INIT -C - WQ_RULI=.FALSE. !ASSUME ERROR - CID=0 - J=WQIHDL+LB_E*(4*(N+2)) !AREA LENGTH - IF (.NOT.WNGGVM(J,J0)) RETURN !GET AREA - CALL WNGMVZ(WQIHDL,A_B(J0-A_OB)) !CLEAR AREA - WQ_RULI=.TRUE. !OK - CID=(J0-A_OB)/LB_E !AREA POINTER - A_J(CID+WQI_LEN_J)=J !AREA LENGTH -C -C FILL -C - DO I=0,1 - A_E(CID+WQI_MXMN_E+I)=RANGE(I) !RANGE - END DO - A_E(CID+WQI_USE_E+0)=SCAL !SCALE - A_J(CID+WQI_N_J)=N !LINE LENGTH - A_J(CID+WQI_PAD_J)=CID+WQIHDL/LB_E !LINE BUFFER - A_J(CID+WQI_PADX_J)=A_J(CID+WQI_PAD_J)+N+2 !LINE BUFFER - A_J(CID+WQI_NE1_J)=N+2 !HIDDEN LINES - A_J(CID+WQI_BAE1_J)=A_J(CID+WQI_PADX_J)+N+2 - A_J(CID+WQI_NE2_J)=N+2 !HIDDEN LINES Y - A_J(CID+WQI_BAE2_J)=A_J(CID+WQI_BAE1_J)+N+2 - DO I=0,3 - A_E(CID+WQI_DPOS_E+I)=DPOS(I) !INCREMENT POSITION - END DO - A_E(CID+WQI_USE_E+1)=SQRT(DPOS(0)**2+DPOS(1)**2) !MAKE INT. INCREMENT - DO I=0,1 - A_E(CID+WQI_POS_E+I)=POS(I)-DPOS(2+I) !FIRST POSITION - END DO - A_E(CID+WQI_DEL_E)=LDEL !DELETE VALUE - A_J(CID+WQI_LIX_J)=LLIX !TYPE -C - RETURN -C -C CONT -C - ENTRY WQ_CONT(CID,LIST) -C - WQ_CONT=.TRUE. -C -C START -C - PCE=A_J(CID+WQI_CAE_J) !CONTOUR POINTER - PCJ=A_J(CID+WQI_CAJ_J) !CONTOUR LINK POINTER - PDE=A_J(CID+WQI_PAD_J) !DATA POINTER - P1E=A_J(CID+WQI_BAE1_J) !CROSSPOINT BUFFER - P1J=A_J(CID+WQI_BAJ1_J) !CROSSPOINT BUFFER - P2E=A_J(CID+WQI_BAE2_J) !PIECE BUFFER - IF (A_J(CID+WQI_IND_J).EQ.0) GOTO 330 !NO DATA YET -C -C SET LINE TYPE -C - IF (A_J(CID+WQI_LIX_J).NE.0) THEN - CALL WQSPLI(A_J(CID+WQI_LIX_J)) !SET CORRECT LINE TYPE - END IF -C -C GET COUNTOUR CROSS POINTS -C - DO I1=0,1 - POSO(2+I1)=A_E(CID+WQI_POS_E+I1) !INIT OLD LINE - POSN(2+I1)=POSO(2+I1)+A_E(CID+WQI_DPOS_E+2+I1) !INIT NEW LINE - POSC(I1)=A_E(CID+WQI_POSC_E+I1) !INIT CENTRE LINE - END DO -C -C ALL SQUARES -C - DO I=0,A_J(CID+WQI_N_J)-2 !ALL SQUARES - J1=0 !INIT WORK AREA - DO I1=0,1 - POSO(I1)=POSO(2+I1) !NEW OLD LINE POS - POSO(2+I1)=POSO(2+I1)+A_E(CID+WQI_DPOS_E+I1) - POSN(I1)=POSN(2+I1) !NEW NEW LINE POS - POSN(2+I1)=POSN(2+I1)+A_E(CID+WQI_DPOS_E+I1) - POSC(I1)=POSC(I1)+A_E(CID+WQI_DPOS_E+I1) !NEW CENTRE POS - END DO - IF (A_E(CID+WQI_DEL_E).EQ.0 .OR. - 1 (LIST(I).NE.A_E(CID+WQI_DEL_E) .AND. - 1 LIST(I+1).NE.A_E(CID+WQI_DEL_E) .AND. - 1 A_E(PDE+I).NE.A_E(CID+WQI_DEL_E) .AND. - 1 A_E(PDE+I+1).NE.A_E(CID+WQI_DEL_E))) THEN - IC=(A_E(PDE+I)+A_E(PDE+I+1)+LIST(I)+LIST(I+1))/4 !CENTRE INTENSITY - DO I1=0,A_J(CID+WQI_NC_J)-1 !CLEAR LINKS - A_J(PCJ+I1)=0 - END DO - CIND=0 !NO CROSS POINTS -C -C CHECK ALL SIDES -C - DO I1=0,7 !ALL SIDES - I2=CTP(I1) !CONTOUR TYPE - IF (I2.EQ.9) THEN - IV(0)=IC !INT 1 AND INT 2 - IV(1)=A_E(PDE+I) - PS(0)=POSC(0) !POS. 1 AND 2 - PS(1)=POSC(1) - PS(2)=POSO(0) - PS(3)=POSO(1) - ELSE IF (I2.EQ.3) THEN - IV(1)=LIST(I) - PS(2)=POSN(0) - PS(3)=POSN(1) - ELSE IF (I2.EQ.6) THEN - IV(1)=LIST(I+1) - PS(2)=POSN(2) - PS(3)=POSN(3) - ELSE IF (I2.EQ.12) THEN - IV(1)=A_E(PDE+I+1) - PS(2)=POSO(2) - PS(3)=POSO(3) - ELSE IF (I2.EQ.1) THEN - IF (CIND.EQ.0) GOTO 310 !NO CROSS FOUND - IV(0)=LIST(I) - IV(1)=A_E(PDE+I) - PS(0)=POSN(0) - PS(1)=POSN(1) - PS(2)=POSO(0) - PS(3)=POSO(1) - ELSE IF (I2.EQ.2) THEN - IV(1)=LIST(I+1) - PS(2)=POSN(2) - PS(3)=POSN(3) - ELSE IF (I2.EQ.4) THEN - IV(0)=A_E(PDE+I+1) - PS(0)=POSO(2) - PS(1)=POSO(3) - ELSE IF (I2.EQ.8) THEN - IV(1)=A_E(PDE+I) - PS(2)=POSO(0) - PS(3)=POSO(1) - END IF -C -C FIND CONTOUR -C - IF (IV(0).EQ.IV(1)) THEN !READY WITH CHECK - ELSE IF (IV(0).LT.IV(1)) THEN - W1(0)=(PS(2)-PS(0))/(IV(1)-IV(0)) - W1(1)=(PS(3)-PS(1))/(IV(1)-IV(0)) - DO I3=0,A_J(CID+WQI_NC_J)-1 !FIND CONTOUR - IF (IV(0).GT.A_E(PCE+I3)) THEN !NEXT CONTOUR - ELSE IF (IV(1).LE.A_E(PCE+I3)) THEN !NO CROSS POINT - GOTO 311 - ELSE - R0=A_E(PCE+I3)-IV(0) - A_E(P1E+2*J1+0)=W1(0)*R0+PS(0) !X - A_E(P1E+2*J1+1)=W1(1)*R0+PS(1) !Y - A_J(P1J+2*J1+1)=CTP(I1) !TYPE - A_J(P1J+2*J1+0)=A_J(PCJ+I3) !LINK - J1=J1+1 - A_J(PCJ+I3)=J1 - CIND=1 !FOUND - END IF - END DO - 311 CONTINUE - ELSE - W1(0)=(PS(2)-PS(0))/(IV(1)-IV(0)) - W1(1)=(PS(3)-PS(1))/(IV(1)-IV(0)) - DO I3=0,A_J(CID+WQI_NC_J)-1 - IF (IV(1).GT.A_E(PCE+I3)) THEN !NEXT CONTOUR - ELSE IF (IV(0).LE.A_E(PCE+I3)) THEN !NO CROSS POINT - GOTO 312 - ELSE - R0=A_E(PCE+I3)-IV(0) - A_E(P1E+2*J1+0)=W1(0)*R0+PS(0) !X - A_E(P1E+2*J1+1)=W1(1)*R0+PS(1) !Y - A_J(P1J+2*J1+1)=CTP(I1) !TYPE - A_J(P1J+2*J1+0)=A_J(PCJ+I3) !LINK - J1=J1+1 - A_J(PCJ+I3)=J1 - CIND=1 !FOUND - END IF - END DO - 312 CONTINUE - END IF !END SINGLE CROSS POINT - END DO !END ALL CROSS POINTS -C -C PLOT CONTOUR PIECE -C - J1=0 !OUTPUT PTR - J2=0 - DO I1=0,A_J(CID+WQI_NC_J)-1 !ALL CONTOURS - J2=J1 !CNT TO SET - A_J(P2E+J2)=0 !INIT CNT - J=A_J(PCJ+I1) !START LINK - DO WHILE (J.NE.0) - J=J-1 !CORRECT - IF (A_J(P1J+2*J+1).EQ.0) THEN !ALREADY USED - J=A_J(P1J+2*J+0) !NEXT LINK - ELSE - J1=J1+1 - A_E(P2E+J1)=A_E(P1E+2*J+0) !X - J1=J1+1 - A_E(P2E+J1)=A_E(P1E+2*J+1) !Y - J3=A_J(P1J+2*J+1) !TEST TYPE - A_J(P2E+J2)=1 !CNT PIECE - 320 CONTINUE - J0=A_J(P1J+2*J) !LINK - DO WHILE (J0.NE.0) !LOOK AT REMAINING - J0=J0-1 - IF (IAND(J3,A_J(P1J+2*J0+1)).EQ.0) THEN !WRONG TYPE - J0=A_J(P1J+2*J0) !LINK - ELSE - J3=A_J(P1J+2*J0+1) !CONTINUE SRCH - A_J(P1J+2*J0+1)=0 !SET USED - J1=J1+1 - A_E(P2E+J1)=A_E(P1E+2*J0+0) !X - J1=J1+1 - A_E(P2E+J1)=A_E(P1E+2*J0+1) !Y - A_J(P2E+J2)=A_J(P2E+J2)+1 !CNT PIECE - GOTO 320 !MORE TO SEARCH - END IF - END DO - J=A_J(P1J+2*J) !NEXT LINK - END IF - IF (A_J(P2E+J2).NE.0) THEN !PIECE PRESENT - J2=J2+2*A_J(P2E+J2)+1 !UPDATE PIECE POINTER - J1=J2 - A_J(P2E+J2)=0 !NEXT PIECE - ELSE - J1=J2 - END IF - END DO !END CONTOUR LINK - END DO !END ALL CONTOURS - A_J(P2E+J2)=0 !END PIECE LIST - CALL WQPOLL_LIST(A_J(P2E)) !PLOT - END IF !END SQUARE - 310 CONTINUE - END DO !END ALL SQUARES -C -C DATA SAVE -C - 330 CONTINUE - DO I=0,A_J(CID+WQI_N_J)-1 - A_E(PDE+I)=LIST(I) !SET DATA - END DO - A_J(CID+WQI_IND_J)=1 !DATA SEEN - DO I=0,1 - A_E(CID+WQI_POS_E+I)=A_E(CID+WQI_POS_E+I)+ - 1 A_E(CID+WQI_DPOS_E+2+I) !UPDATE POS - A_E(CID+WQI_POSC_E+I)=A_E(CID+WQI_POSC_E+I)+ - 1 A_E(CID+WQI_DPOS_E+2+I) !UPDATE CENTRE POS. - END DO -C - RETURN -C -C SHADE -C - ENTRY WQ_SHADE(CID,LIST) -C - WQ_SHADE=.TRUE. -C -C START -C - PCE=A_J(CID+WQI_CAE_J) !CONTOUR POINTER - PCJ=A_J(CID+WQI_CAJ_J) !CONTOUR LINK POINTER - PDE=A_J(CID+WQI_PAD_J) !DATA POINTER - PDXE=A_J(CID+WQI_PADX_J) !CENTRE INT. BUFFER - IF (A_J(CID+WQI_IND_J).EQ.0) GOTO 430 !NO DATA YET -C -C SET INTENSITIES -C - DO I=0,A_J(CID+WQI_N_J)-2 - IF (A_E(CID+WQI_DEL_E).EQ.0 .OR. - 1 (LIST(I).NE.A_E(CID+WQI_DEL_E) .AND. - 1 LIST(I+1).NE.A_E(CID+WQI_DEL_E) .AND. - 1 A_E(PDE+I).NE.A_E(CID+WQI_DEL_E) .AND. - 1 A_E(PDE+I+1).NE.A_E(CID+WQI_DEL_E))) THEN - IC=(A_E(PDE+I)+A_E(PDE+I+1)+LIST(I)+LIST(I+1))/4 !CENTRE INTENSITY - IF (A_J(CID+WQI_NC_J).EQ.0) THEN !CONVERT - IC=A_E(CID+WQI_MXMN_E+0)*IC+A_E(CID+WQI_MXMN_E+1) - ELSE - DO I1=0,A_J(CID+WQI_NC_J)-1 !FIND CONTOUR - IF (IC.LT.A_E(PCE+I1)) THEN !FOUND - IC=I1 !SET CONTOUR NUMBER - GOTO 410 - END IF - END DO - IC=A_J(CID+WQI_NC_J) !MAX. CONTOUR - 410 CONTINUE - IC=IC/A_J(CID+WQI_NC_J) !NORMALISE VALUE - END IF - ELSE - IC=-1. !DELETE VALUE - END IF - A_E(PDXE+I)=IC !SAVE CENTRE INTENSITY - END DO - CALL WQ_BOX(A_J(CID+WQI_N_J),A_E(CID+WQI_POS_E), - 1 A_E(CID+WQI_DPOS_E),A_E(PDXE), - 1 A_J(CID+WQI_LIX_J)) !PLOT - GOTO 430 -C -C DATA SAVE -C - 430 CONTINUE - DO I=0,A_J(CID+WQI_N_J)-1 - A_E(PDE+I)=LIST(I) !SET DATA - END DO - A_J(CID+WQI_IND_J)=1 !DATA SEEN - DO I=0,1 - A_E(CID+WQI_POS_E+I)=A_E(CID+WQI_POS_E+I)+ - 1 A_E(CID+WQI_DPOS_E+2+I) !UPDATE POS - END DO -C - RETURN -C -C POLT -C - ENTRY WQ_POLT(CID,LIST,LISTA) -C - WQ_POLT=.TRUE. -C -C START -C -C DRAW LINES -C - DO I=0,A_J(CID+WQI_N_J)-1 !ALL POINTS - IF (A_E(CID+WQI_DEL_E).EQ.0 .OR. - 1 (LIST(I).NE.A_E(CID+WQI_DEL_E))) THEN !NOT DELETED - IF (ABS(LIST(I)).GT.A_E(CID+WQI_MXMN_E+0)) THEN !TO DO - IF (ABS(LIST(I)).GE.A_E(CID+WQI_MXMN_E+1)) THEN !LIMIT VALUE - IC=A_E(CID+WQI_MXMN_E+1) - ELSE - IC=LIST(I) - END IF -C -C Each vector is centered on the corresponding point, and the total -C length of the vector should be the scaled amplitude. So each half -C of the vector has to be twice as small. -C - IC=0.5*IC*A_E(CID+WQI_USE_E+0) !SCALE LENGTH - POSO(0)=A_E(CID+WQI_POS_E+0)+I*A_E(CID+WQI_DPOS_E+0)- - 1 IC*SIN(LISTA(I)) !X HIGH - POSO(2)=A_E(CID+WQI_POS_E+0)+I*A_E(CID+WQI_DPOS_E+0)+ - 1 IC*SIN(LISTA(I)) !X LOW - POSO(1)=A_E(CID+WQI_POS_E+1)+I*A_E(CID+WQI_DPOS_E+1)+ - 1 IC*COS(LISTA(I)) !Y HIGH - POSO(3)=A_E(CID+WQI_POS_E+1)+I*A_E(CID+WQI_DPOS_E+1)- - 1 IC*COS(LISTA(I)) !Y LOW - CALL WQPOLL(2,POSO) !DRAW - END IF - END IF - END DO -C -C DATA SAVE -C - DO I=0,1 - A_E(CID+WQI_POS_E+I)=A_E(CID+WQI_POS_E+I)+ - 1 A_E(CID+WQI_DPOS_E+2+I) !UPDATE POS - END DO -C - RETURN -C -C RULE -C - ENTRY WQ_RULE(CID,LIST) -C - WQ_RULE=.TRUE. -C -C START -C - PDE=A_J(CID+WQI_PAD_J) !OLD DATA POINTER - PDXE=A_J(CID+WQI_PADX_J) !NEW DATA POINTER - PCE=A_J(CID+WQI_BAE1_J) !HIDDEN LIST POINTER - P1E=A_J(CID+WQI_BAE2_J) !HIDDEN LIST Y - A_J(CID+WQI_USJ_J)=1 !HIDDEN BUFFER LENGTH - A_E(PCE+0)=A_E(CID+WQI_MXMN_E+0) !INIT HIDDEN VALUE - A_E(PCE+1)=A_E(CID+WQI_MXMN_E+0) - A_E(P1E+0)=0. !Y HIDDEN VALUES - A_E(P1E+1)=1. - DO I=0,A_J(CID+WQI_N_J)-1 - IF (A_E(CID+WQI_DEL_E).NE.0 .AND. - 1 LIST(I).EQ.A_E(CID+WQI_DEL_E)) THEN !DELETED - IC=LIST(I) - ELSE - IC=MIN(A_E(CID+WQI_MXMN_E+1), - 1 MAX(A_E(CID+WQI_MXMN_E+0),LIST(I)))* - 1 A_E(CID+WQI_USE_E+0)+ !INT. - 1 I*A_E(CID+WQI_USE_E+1) !+ OFFSET - END IF - A_E(PDXE+I)=IC !SET DATA - END DO - IF (A_J(CID+WQI_IND_J).EQ.0) GOTO 530 !NO DATA YET -C -C DRAW INTENSITIES -C - CALL WQSPLI(1) !FULL DRAWN - R0=A_E(CID+WQI_DPOS_E+0)/A_E(CID+WQI_USE_E+1) !SCALE X - R1=A_E(CID+WQI_DPOS_E+1)/A_E(CID+WQI_USE_E+1) !SCALE Y - DO I=0,A_J(CID+WQI_N_J)-1 !ALL POINTS - IF (A_E(CID+WQI_DEL_E).EQ.0 .OR. - 1 (A_E(PDXE+I).NE.A_E(CID+WQI_DEL_E) .AND. - 1 A_E(PDXE+I+1).NE.A_E(CID+WQI_DEL_E) .AND. - 1 A_E(PDE+I).NE.A_E(CID+WQI_DEL_E) .AND. - 1 A_E(PDE+I+1).NE.A_E(CID+WQI_DEL_E))) THEN !TO DRAW - IF (A_J(CID+WQI_LIX_J).EQ.1) THEN !FULL - POSO(0)=A_E(CID+WQI_POS_E+0)+ - 1 A_E(PDE+I)*R0 !POS - POSO(2)=A_E(CID+WQI_POS_E+0)+A_E(CID+WQI_DPOS_E+2)+ - 1 A_E(PDXE+I)*R0 - POSO(1)=A_E(CID+WQI_POS_E+1)+ - 1 A_E(PDE+I)*R1 - POSO(3)=A_E(CID+WQI_POS_E+1)+A_E(CID+WQI_DPOS_E+3)+ - 1 A_E(PDXE+I)*R1 - CALL WQPOLL(2,POSO) !DRAW - ELSE !HIDE - I1=0 !START HIDE LIST - POSO(0)=A_E(PDE+I) !OLD INT - POSO(1)=0. !OLD Y - POSN(0)=POSO(0) !PREVIOUS INT. - IF (POSO(0).GE.A_E(PCE+I1)) THEN !START NOT HIDDEN - 520 CONTINUE - I2=I1 !START THIS CHECK - DO WHILE(I1.LT.A_J(CID+WQI_USJ_J)) !CHECK HIDE LIST - I1=I1+1 !NEXT TEST - POSO(3)=A_E(P1E+I1) !NEXT Y - POSO(2)=A_E(PDE+I)+POSO(3)* - 1 (A_E(PDXE+I)-A_E(PDE+I)) !NEW INT - IF (POSO(2).GE.A_E(PCE+I1)) THEN !END NOT HIDDEN - A_E(PCE+I1-1)=POSN(0) !NEW TEST VALUE - POSN(0)=POSO(2) !PREVIOUS INT - ELSE - IF (A_E(P1E+I1).EQ.A_E(P1E+I1-1)) THEN !SIMPLE - POSO(3)=A_E(P1E+I1) !Y CROSS - ELSE - R3=(A_E(PCE+I1)-A_E(PCE+I1-1))/ - 1 (A_E(P1E+I1)-A_E(P1E+I1-1)) !(I1-I0)/(Y1-Y0) (B) - R2=A_E(PCE+I1-1)-A_E(P1E+I1-1)*R3 !I0-Y0*R3 (A) - R3=R3-A_E(PDXE+I)+A_E(PDE+I) !B-D - IF (R3.NE.0) THEN - POSO(3)=(A_E(PDE+I)-R2)/R3 !NEW Y = (C-A)/(B-D) - ELSE - POSO(3)=1. - END IF - END IF - POSO(2)=A_E(PDE+I)+POSO(3)* - 1 (A_E(PDXE+I)-A_E(PDE+I)) !CROSS INT - A_E(PCE+I1-1)=POSN(0) !NEW TEST VALUE - DO I3=A_J(CID+WQI_USJ_J),I1,-1 !MAKE PLACE NEW CROSS - A_E(P1E+I3+1)=A_E(P1E+I3) !MOVE Y - A_E(PCE+I3+1)=A_E(PCE+I3) !MOVE CHECK INT - END DO - A_J(CID+WQI_USJ_J)=A_J(CID+WQI_USJ_J)+1 !COUNT IT - A_E(PCE+I1)=POSO(2) !NEW ADDED INT - A_E(P1E+I1)=POSO(3) !NEW CROSS Y - GOTO 511 !CONTINUE HIDDEN - END IF - END DO - 511 CONTINUE - POSN(0)=A_E(CID+WQI_POS_E+0)+POSO(0)*R0+ - 1 POSO(1)*A_E(CID+WQI_DPOS_E+2) !DRAW - POSN(2)=A_E(CID+WQI_POS_E+0)+POSO(2)*R0+ - 1 POSO(3)*A_E(CID+WQI_DPOS_E+2) - POSN(1)=A_E(CID+WQI_POS_E+1)+POSO(0)*R1+ - 1 POSO(1)*A_E(CID+WQI_DPOS_E+3) - POSN(3)=A_E(CID+WQI_POS_E+1)+POSO(2)*R1+ - 1 POSO(3)*A_E(CID+WQI_DPOS_E+3) - CALL WQPOLL(2,POSN) !DRAW PIECE - A_E(PCE+I1)=POSO(2) !NEW CHECK INT - IF (I1-I2.GT.1) THEN !DELETE CROSS POINTS - DO I3=I1,A_J(CID+WQI_USJ_J) - A_E(P1E+I2+1+I3-I1)=A_E(P1E+I3) - A_E(PCE+I2+1+I3-I1)=A_E(PCE+I3) - END DO - A_J(CID+WQI_USJ_J)=A_J(CID+WQI_USJ_J)-(I1-I2-1) !NEW LENGTH - I1=I2+1 !NEW CHECK POSITION - END IF - IF (I1.LT.A_J(CID+WQI_USJ_J)) THEN !CONTINUE HIDDEN - POSO(0)=A_E(PCE+I1) !OLD INT - POSO(1)=A_E(P1E+I1) !OLD Y - POSN(0)=POSO(0) !PREVIOUS INT. - GOTO 510 - END IF - ELSE !START HIDDEN - 510 CONTINUE - I2=I1 !START THIS CHECK - DO WHILE(I1.LT.A_J(CID+WQI_USJ_J)) !CHECK HIDE LIST - I1=I1+1 !NEXT TEST - POSO(3)=A_E(P1E+I1) !NEXT Y - POSO(2)=A_E(PDE+I)+POSO(3)* - 1 (A_E(PDXE+I)-A_E(PDE+I)) !NEW INT - IF (POSO(2).LT.A_E(PCE+I1)) THEN !END HIDDEN - ELSE !END NOT HIDDEN - IF (A_E(P1E+I1).EQ.A_E(P1E+I1-1)) THEN !SIMPLE - POSO(3)=A_E(P1E+I1) !Y CROSS - ELSE - R3=(A_E(PCE+I1)-A_E(PCE+I1-1))/ - 1 (A_E(P1E+I1)-A_E(P1E+I1-1)) !(I1-I0)/(Y1-Y0) (B) - R2=A_E(PCE+I1-1)-A_E(P1E+I1-1)*R3 !I0-Y0*R3 (A) - R3=R3-A_E(PDXE+I)+A_E(PDE+I) !B-D - IF (R3.NE.0) THEN - POSO(3)=(A_E(PDE+I)-R2)/R3 !NEW Y = (C-A)/(B-D) - ELSE - POSO(3)=1. - END IF - END IF - POSO(2)=A_E(PDE+I)+POSO(3)* - 1 (A_E(PDXE+I)-A_E(PDE+I)) !CROSS INT - DO I3=A_J(CID+WQI_USJ_J),I1,-1 !MAKE PLACE NEW CROSS - A_E(P1E+I3+1)=A_E(P1E+I3) !MOVE Y - A_E(PCE+I3+1)=A_E(PCE+I3) !MOVE CHECK INT - END DO - A_J(CID+WQI_USJ_J)=A_J(CID+WQI_USJ_J)+1 !COUNT IT - A_E(PCE+I1)=POSO(2) !NEW ADDED INT - A_E(P1E+I1)=POSO(3) !NEW CROSS Y - GOTO 521 !CONTINUE NOT HIDDEN - END IF - END DO - 521 CONTINUE - IF (A_J(CID+WQI_LIX_J).EQ.2) THEN !WANT TO DOT - CALL WQSPLI(3) !SELECT DOT - POSN(0)=A_E(CID+WQI_POS_E+0)+POSO(0)*R0+ - 1 POSO(1)*A_E(CID+WQI_DPOS_E+2) !DRAW - POSN(2)=A_E(CID+WQI_POS_E+0)+POSO(2)*R0+ - 1 POSO(3)*A_E(CID+WQI_DPOS_E+2) - POSN(1)=A_E(CID+WQI_POS_E+1)+POSO(0)*R1+ - 1 POSO(1)*A_E(CID+WQI_DPOS_E+3) - POSN(3)=A_E(CID+WQI_POS_E+1)+POSO(2)*R1+ - 1 POSO(3)*A_E(CID+WQI_DPOS_E+3) - CALL WQPOLL(2,POSN) !DRAW PIECE - CALL WQSPLI(1) !SELECT FULL - END IF - IF (I1.LT.A_J(CID+WQI_USJ_J)) THEN !CONTINUE NOT HIDDEN - POSO(0)=A_E(PCE+I1) !OLD INT - POSO(1)=A_E(P1E+I1) !OLD Y - POSN(0)=POSO(0) !PREVIOUS INT. - GOTO 520 - END IF - END IF - END IF - END IF - END DO - GOTO 530 -C -C DATA SAVE -C - 530 CONTINUE - DO I=0,A_J(CID+WQI_N_J)-1 - A_E(PDE+I)=A_E(PDXE+I) !SAVE DATA - END DO - A_J(CID+WQI_IND_J)=1 !DATA SEEN - DO I=0,1 - A_E(CID+WQI_POS_E+I)=A_E(CID+WQI_POS_E+I)+ - 1 A_E(CID+WQI_DPOS_E+2+I) !UPDATE POS - END DO -C - RETURN -C -C - END diff --git a/src/wng/wnptxt.for b/src/wng/wnptxt.for deleted file mode 100644 index c63f897c0be4daa0d21be85c457b2821a225c4bd..0000000000000000000000000000000000000000 --- a/src/wng/wnptxt.for +++ /dev/null @@ -1,248 +0,0 @@ -C+ WNPTXT.FOR -C WNB 911126 -C -C Revisions: -C GvD 920501 Use J5 iso. JS -C -C Plot text routine -C - LOGICAL FUNCTION WQTEXT(POS,TEXT) -C -C Result: -C -C WQTEXT_L = WQTEXT( POS_E(2):I, TEXT_C*:I) -C Plot TEXT at POS -C WQTEXT_IX_L = WQTEXT_IX( POS_E(2):I, TEXT_C*:I), IX_J:I, HGT_E:I) -C Plot TEXT at POS with IndeX and HeiGhT -C WQTEXT_IY_L = WQTEXT_IY( POS_E(2):I, TEXT_C*:I), IX_J:I, HGT_E:I, -C UP_E(2):I, EXPD_E:I, PATH_J:I, SPC_E:I) -C As _IX but specify also UP, PATH and -C SPaCing and EXPanD -C -C Include files: -C - INCLUDE 'WNG_DEF' - INCLUDE 'WQG_DEF' !GENERAL AREA - INCLUDE 'WQD_O_DEF' !DEVICE AREA - INCLUDE 'WQF_O_DEF' !FONT OFFSETS -C -C Parameters: -C - INTEGER NMXSTR !MAX. STRING DESCRIPTOR LENGTH - PARAMETER (NMXSTR=100) -C -C Arguments: -C - REAL POS(2) !POSITION - CHARACTER*(*) TEXT !TEXT - INTEGER IX !INDEX - REAL HGT !HEIGHT - REAL UP(2) !DIRECTION - REAL EXPD !EXPANSION - INTEGER PATH !LEFT/RIGHT - REAL SPC !CHARACTER SPACING -C -C Entry points: -C - LOGICAL WQTEXT_IX,WQTEXT_IY -C -C Function references: -C - LOGICAL WNP_ALLOC !ALLOCATE AREAS - LOGICAL WQSTXI !SET TEXT INDEX - LOGICAL WQSTXH !SET TEXT HEIGHT - LOGICAL WQSTXU !SET TEXT DIRECTION - LOGICAL WQSTXX !SET TEXT EXPANSION - LOGICAL WQSTXP !SET TEXT PATH - LOGICAL WQSTXS !SET TEXT SPACING -C -C Data declarations: -C - REAL POST(0:9) !POSITION - REAL HNTR(0:9) !AFTER NORM. TRANSFORM - REAL HTR(0:9) !AFTER DEVICE TRANSFORM - REAL TMAT(0:3) !TRANSFORM MATRIX - REAL SPOS(0:1) !START POS. - REAL RPOS(0:1) !REAL POS. - INTEGER OUTL(NMXSTR) !POLYLINE LIST ONE CHAR. - INTEGER DPOLIX(0:2) !DUMMY POLYLINE INDEX - REAL DPOLIXF(0:2) - EQUIVALENCE (DPOLIX,DPOLIXF) - REAL CLAR(0:3) !CLIP VIEWPORT - INTEGER VP(4) !DRAW VALUES - INTEGER K1,K2,K3,K4 - DATA DPOLIXF/1.,0,0/ -C- - WQTEXT=.TRUE. !ASSUME OK - IF (WQG_STATE.LT.3) THEN - E_C=5 !WRONG STATE - 11 CONTINUE - WQTEXT=.FALSE. - RETURN - END IF - GOTO 10 -C -C WQTEXT_IX -C - ENTRY WQTEXT_IX(POS,TEXT,IX,HGT) -C - WQTEXT_IX=.TRUE. !ASSUME OK - IF (WQG_STATE.LT.3) THEN - E_C=5 !WRONG STATE - GOTO 11 - END IF - IF (.NOT.WQSTXI(IX)) GOTO 11 !SET INDEX - IF (.NOT.WQSTXH(HGT)) GOTO 11 !SET HEIGHT - GOTO 10 -C -C WQTEXT_IY -C - ENTRY WQTEXT_IY(POS,TEXT,IX,HGT,UP,EXPD,PATH,SPC) -C - WQTEXT_IY=.TRUE. !ASSUME OK - IF (WQG_STATE.LT.3) THEN - E_C=5 !WRONG STATE - GOTO 11 - END IF - IF (.NOT.WQSTXI(IX)) GOTO 11 !SET INDEX - IF (.NOT.WQSTXH(HGT)) GOTO 11 !SET HEIGHT - IF (.NOT.WQSTXU(UP)) GOTO 11 !SET DIRECTION - IF (.NOT.WQSTXX(EXPD)) GOTO 11 !SET EXPANSION - IF (.NOT.WQSTXP(PATH)) GOTO 11 !SET PATH - IF (.NOT.WQSTXS(SPC)) GOTO 11 !SET SPACING - GOTO 10 -C -C DRAW -C - 10 CONTINUE - POST(0)=0 !SET ORIGINAL POS. - POST(1)=0 - POST(2)=WQG_CTXHT*WQG_CTXCS(0) !HEIGHT - POST(3)=WQG_CTXHT*WQG_CTXCS(1) - POST(4)=0 !WIDTH - POST(5)=0 - POST(6)=WQG_CTXHT*WQG_CTXCS(1)*WQG_CTXXP !EXPANSION - POST(7)=WQG_CTXHT*WQG_CTXCS(0)*WQG_CTXXP - POST(8)=POS(1) !START POS - POST(9)=POS(2) - CALL WNP_NTR0(5,POST,J5,HNTR) !NORM. TRANSFORM - J=15*NMXSTR+2 !POLYLINE LENGTH - IF (.NOT.WNP_ALLOC(J)) THEN !GET AREAS - E_C=100 - GOTO 11 - END IF -C -C ON ALL ACTIVE DEVICES -C - J=WQG_QOP !START LIST - DO WHILE (J.NE.0) - J0=(J-A_OB)/LB_J !PTR - IF (A_J(J0+WQD_ACT_J).NE.0 .AND. - 1 IAND(A_J(J0+WQD_TYP_J),1).NE.0 .AND. - 1 IAND(A_J(J0+WQD_TYP_J),4).EQ.0) THEN !OUTPUT DEVICE - IF (IAND(1,WQG_CLIP).NE.0) THEN !OVERALL CLIP - CALL WNP_DNTR0(2,WQG_NTR(0,2,WQG_CTR), - 1 J5,CLAR,J) !VIEW - END IF - CALL WNP_DNTR0(5,HNTR,J5,HTR,J) !DEVICE TRANSFORM - HTR(2)=HTR(2)-HTR(0) !START VECTORS AT 0,0 - HTR(3)=HTR(3)-HTR(1) - HTR(6)=HTR(6)-HTR(4) - HTR(7)=HTR(7)-HTR(5) - J1=WQG_CTXTIX !TEXT INDEX - IF (J1.GT.A_J(J0+WQD_NTXIX_J)) J1=1 !DEFAULT - J1=MAX(1,J1)-1 !INDEX - J2=NINT(A_E(J0+WQD_TXIX_E+3*J1+0)) !FONT # - IF (J2.GT.WQG_NFONT) J2=1 !ASSUME 1 - J2=MAX(1,J2) - J2=WQG_FONT(J2) !FONT DEFINITION PTR - TMAT(1)=HTR(2)/A_E(J2+WQF_BHG_E) !MAKE TRANSFO MATRIX - TMAT(3)=HTR(3)/A_E(J2+WQF_BHG_E) - TMAT(0)=HTR(6)/A_E(J2+WQF_BHG_E) - TMAT(2)=-(HTR(7)/A_E(J2+WQF_BHG_E)) - SPOS(0)=HTR(8) !START POS. - SPOS(1)=HTR(9) - DPOLIXF(1)=0. !SINGLE THICKNESS - IF (IAND(A_J(J2+WQF_TIL_J),1).NE.0) !THICK CHARACTERS - 1 DPOLIXF(1)=MIN(SQRT(TMAT(0)*TMAT(0)+ - 2 TMAT(2)*TMAT(2)), - 3 SQRT(TMAT(1)*TMAT(1)+TMAT(3)*TMAT(3))) - 4 !HEIGHT SCALE - DPOLIXF(1)=DPOLIXF(1)/A_E(J0+WQD_NMPLS_E) !NOMINAL THICKNESS CORR. - SPOS(0)=SPOS(0)-TMAT(0)*A_E(J2+WQF_STR_E+0+2*WQG_CTXPA)- - 1 TMAT(1)*A_E(J2+WQF_STR_E+1+2*WQG_CTXPA) !LOWER LEFT - SPOS(1)=SPOS(1)-TMAT(2)*A_E(J2+WQF_STR_E+0+2*WQG_CTXPA)- - 1 TMAT(3)*A_E(J2+WQF_STR_E+1+2*WQG_CTXPA) - DO J3=1,LEN(TEXT) !ALL CHARACTERS - K1=IAND(ICHAR(TEXT(J3:J3)),A_J(J2+WQF_BDL_J))- - 1 A_J(J2+WQF_LCH_J) !# - IF (K1.LT.0 .OR. K1.GT.A_J(J2+WQF_HCH_J)) THEN - K1=A_J(J2+WQF_RCH_J)-A_J(J2+WQF_LCH_J) !REPLACE CHAR DESCRIPT. - END IF - K1=A_J(J2+WQF_FTP_J+K1) !PTR TO DESCRIPTION - K3=1 !POLYLINE # PTR - 20 CONTINUE - K2=0 !POLYLINE CNT - K4=K3+1 !OUTPUT PTR - 30 CONTINUE - IF (A_I(K1).EQ.0) THEN - OUTL(K3)=K2 - K3=K3+2*K2+1 - OUTL(K3)=0 !EOL - IF (IAND(1,WQG_CLIP).NE.0) THEN - CALL WNP_PLCLP(OUTL,A_B(WQG_OUT1-A_OB),CLAR) !CLIP WINDOW - CALL WNP_PLCLP(A_B(WQG_OUT1-A_OB), - 1 A_B(WQG_OUT2-A_OB), - 1 A_E(J0+WQD_NTR_E+2*4+0)) !CLIP DC VIEW - ELSE - CALL WNP_PLCLP(OUTL, - 1 A_B(WQG_OUT2-A_OB), - 1 A_E(J0+WQD_NTR_E+2*4+0)) !CLIP DC VIEW - END IF - IF (A_J((WQG_OUT2-A_OB)/LB_J).NE.0) THEN - VP(1)=0 !INDEX - VP(2)=WQG_OUT2 !BUFFER - VP(3)=DPOLIX(0) !LINE TYPE - VP(4)=DPOLIX(1) !THICKNESS - CALL WNPDEX(4,J,VP) !DRAW - END IF - R0=A_E(J2+WQF_WID_E)+A_E(J2+WQF_WID_E)*WQG_CTXSP !CHAR. SPACE - R1=A_E(J2+WQF_HGT_E)+A_E(J2+WQF_HGT_E)*WQG_CTXSP - IF (WQG_CTXPA.EQ.1) THEN - R0=-R0 - R1=0 - ELSE IF (WQG_CTXPA.EQ.2) THEN - R0=0 - ELSE IF (WQG_CTXPA.EQ.3) THEN - R1=-R1 - R0=0 - ELSE - R1=0 - END IF - SPOS(0)=SPOS(0)+R0*TMAT(0)+R1*TMAT(1) !NEXT POS - SPOS(1)=SPOS(1)+R0*TMAT(2)+R1*TMAT(3) - ELSE IF (A_I(K1).EQ.-1) THEN - OUTL(K3)=K2 !SAVE CNT PIECE - K3=K3+2*K2+1 !NEXT CNT PTR - K1=K1+1 !INPUT PTR - GOTO 20 - ELSE - R0=A_B(2*K1) !X - R1=A_B(2*K1+1) !Y - K1=K1+1 !CNT - RPOS(0)=SPOS(0)+R0*TMAT(0)+R1*TMAT(1) !TRANS. - RPOS(1)=SPOS(1)+R0*TMAT(2)+R1*TMAT(3) - CALL WNGMV(2*LB_E,RPOS,OUTL(K4)) !SET - K4=K4+2 - K2=K2+1 !COUNT POINT - GOTO 30 - END IF - END DO - END IF - J=A_J((J-A_OB)/LB_J) !NEXT DEVICE - END DO -C - RETURN -C -C - END diff --git a/src/wng/wnqel4.fsc b/src/wng/wnqel4.fsc deleted file mode 100644 index 0708c450492c9a6ac39b8081b01cd00e6fbd23a2..0000000000000000000000000000000000000000 --- a/src/wng/wnqel4.fsc +++ /dev/null @@ -1,573 +0,0 @@ -C+ WNQEL4.FOR -C WNB 911218 -C -C Revisions: -C WNB 920113 Error in message length -C WNB 920129 Add file types -C WNB 920129 Change output writing -C WNB 921021 Add A3 entry points; delete LMG1* (not used) -C WNB 921029 Correct A3 scale -C HjV 921029 Correct A3 scale (=A4 scale * sqrt(2)) -C WNB 921124 Line thickness -C HjV 930108 Add PageSize for A3-plots -C HjV 930521 Line from x,y to same x,y not plotted -C CMV 930824 Problem with message, A3 inside /Saveobject -C WNB 930825 Change to WNCALX -C HjV 940323 When Y-point polyline <0 , make it 0 -C HjV 950710 Change names of PS/EPS routines -C Add routines for A0/A1/A2-plotter -C JPH 970827 Replace long-dashed line type 4 bydensely-dotted -C AXC 010628 linux port (CARRIAGECONTROL && Parameter) -C - SUBROUTINE WNQEL4(TYP,ID,VP) -C -C Do device dependent actions for EPS -C -C Result: -C -C CALL WNQEL4( TYP_J:I, ID_J:I, VP_J(*):I) EPS A4 landscape -C CALL WNQEP4( TYP_J:I, ID_J:I, VP_J(*):I) EPS A4 portrait -C CALL WNQPL4( TYP_J:I, ID_J:I, VP_J(*):I) PS A4 landscape -C CALL WNQPP4( TYP_J:I, ID_J:I, VP_J(*):I) PS A4 portrait -C CALL WNQEL3( TYP_J:I, ID_J:I, VP_J(*):I) EPS A3 landscape -C CALL WNQEP3( TYP_J:I, ID_J:I, VP_J(*):I) EPS A3 portrait -C CALL WNQPL3( TYP_J:I, ID_J:I, VP_J(*):I) PS A3 landscape -C CALL WNQPP3( TYP_J:I, ID_J:I, VP_J(*):I) PS A3 portrait -C CALL WNQEL2( TYP_J:I, ID_J:I, VP_J(*):I) EPS A2 landscape -C CALL WNQEP2( TYP_J:I, ID_J:I, VP_J(*):I) EPS A2 portrait -C CALL WNQPL2( TYP_J:I, ID_J:I, VP_J(*):I) PS A2 landscape -C CALL WNQPP2( TYP_J:I, ID_J:I, VP_J(*):I) PS A2 portrait -C CALL WNQEL1( TYP_J:I, ID_J:I, VP_J(*):I) EPS A1 landscape -C CALL WNQEP1( TYP_J:I, ID_J:I, VP_J(*):I) EPS A1 portrait -C CALL WNQPL1( TYP_J:I, ID_J:I, VP_J(*):I) PS A1 landscape -C CALL WNQPP1( TYP_J:I, ID_J:I, VP_J(*):I) PS A1 portrait -C CALL WNQEL0( TYP_J:I, ID_J:I, VP_J(*):I) EPS A0 landscape -C CALL WNQEP0( TYP_J:I, ID_J:I, VP_J(*):I) EPS A0 portrait -C CALL WNQPL0( TYP_J:I, ID_J:I, VP_J(*):I) PS A0 landscape -C CALL WNQPP0( TYP_J:I, ID_J:I, VP_J(*):I) PS A0 portrait -C Do action specified by TYP, using the -C area ID, and pointers/values in VP. TYP can be: -C 0: open device -C VP: - -C 1: close device -C VP: - -C 2: (header) message -C VP: 1: ptr msg; 2: length msg -C 3: polyline -C VP: 1: poly index; 2: ptr list -C 4: polyline -C VP: 2: ptr list; 3: line type -C 4: line thickness -C 5: clear screen -C VP: - -C 6: shading -C VP: 1: type; 2: int. list -C 3: ptr llhc, urhc total -C 4: N int. -C 5: dx,dy , box dx,dy, pos. -C -C Include files: -C - INCLUDE 'WNG_DEF' - INCLUDE 'WQD_O_DEF' !DEVICE AREA -C -C Parameters: -C - CHARACTER*1 CR -C PARAMETER (CR=CHAR(13)) - CHARACTER*1 LF -C PARAMETER (LF=CHAR(10)) - CHARACTER*2 CRLF -C PARAMETER (CRLF=CR//LF) - INTEGER DEFPL !DEFAULT POLYLINE IX - PARAMETER (DEFPL='0030') - INTEGER LOPL !MAX(INIT STRING, END STR, LMG0L+LMG1L+MGL) - PARAMETER (LOPL=300) -C -C Arguments: -C - INTEGER TYP !TYPE TO DO - INTEGER ID !PTR TO AREA - INTEGER VP(*) !DATA LIST -C -C Function references: -C - INTEGER WNCALX !STRING LENGTH - REAL WNGGE !GET E VALUE - LOGICAL WNGGVM !GET MEMORY - CHARACTER*20 WNFFNM !FILE NAME - INTEGER WNMRNJ !RANDOM J -C -C Data declarations: -C - CHARACTER*3 FTYP !FILE TYPE - LOGICAL LEPS !EPS OR PS - LOGICAL LZER !ZERO SCREEN INDICATOR - INTEGER FMTIDX !PAPER-FORMAT INDEX - REAL FMTSCL(0:4) !SCALE FACTOR - DATA FMTSCL /0.956,0.676,0.478,0.338,0.239/ - INTEGER PB,PJ,PE !POINTERS - INTEGER PATN,PATS !PATTERN SELECT, START - INTEGER PATD,PATU !PATTERN DOWN, UP - INTEGER FIRST_I1,FIRST_I2 !SAVED X,Y - INTEGER XB(0:1,0:1) !SHADING BOX - REAL XYC(0:1) !X, Y START - CHARACTER*(LOPL) LOPC - BYTE LOPB(LOPL) - EQUIVALENCE (LOPC,LOPB) - CHARACTER*20 FNM !FILE NAME - INTEGER PLW !PLOT LINE TYPE - BYTE PLW1(4) - EQUIVALENCE (PLW,PLW1) - CHARACTER*64 THLC !LINE THICKNESS - BYTE THL(2,0:31) - EQUIVALENCE (THLC,THL) - DATA THLC(1:40)/'0101020304050607080910111213141516171819'/ - DATA THLC(41:64)/'202122232425262728293031'/ - BYTE IXTL(4) - DATA IXTL/1,2,3,4/ - CHARACTER*7 LIXTL(4) !LINE TYPE INFO - DATA LIXTL/'[]','[16 16]','[03 13]','[03 05]'/ ! JPH 970827 -cc DATA LIXTL/'[]','[16 16]','[03 13]','[24 08]'/ - INTEGER IPLST(0:2,2:4) !PATTERN LENGTH, DOWN, UP - DATA IPLST /32,16,16, !DASH - 1 16,3,13, ! sparse DOT - 1 8,3,5/ ! dense DOT ! JPH 970827 -cc 1 32,24,8/ ! LONG DASH -C- -C -C EL4 -C - FMTIDX=4 !SET FORMAT A4 - FTYP='EL4' - GOTO 10 -C -C EP4 -C - ENTRY WNQEP4(TYP,ID,VP) -C - FMTIDX=4 !SET FORMAT A4 - FTYP='EP4' - GOTO 10 -C -C PL4 -C - ENTRY WNQPL4(TYP,ID,VP) -C - FMTIDX=4 !SET FORMAT A4 - FTYP='PL4' - GOTO 10 -C -C PP4 -C - ENTRY WNQPP4(TYP,ID,VP) -C - FMTIDX=4 !SET FORMAT A4 - FTYP='PP4' - GOTO 10 -C -C EL3 -C - ENTRY WNQEL3(TYP,ID,VP) -C - FMTIDX=3 !SET FORMAT A3 - FTYP='EL3' - GOTO 10 -C -C EP3 -C - ENTRY WNQEP3(TYP,ID,VP) -C - FMTIDX=3 !SET FORMAT A3 - FTYP='EP3' - GOTO 10 -C -C PL3 -C - ENTRY WNQPL3(TYP,ID,VP) -C - FMTIDX=3 !SET FORMAT A3 - FTYP='PL3' - GOTO 10 -C -C PP3 -C - ENTRY WNQPP3(TYP,ID,VP) -C - FMTIDX=3 !SET FORMAT A3 - FTYP='PP3' - GOTO 10 -C -C EL2 -C - ENTRY WNQEL2(TYP,ID,VP) -C - FMTIDX=2 !SET FORMAT A2 - FTYP='EL2' - GOTO 10 -C -C EP2 -C - ENTRY WNQEP2(TYP,ID,VP) -C - FMTIDX=2 !SET FORMAT A2 - FTYP='EP2' - GOTO 10 -C -C PL2 -C - ENTRY WNQPL2(TYP,ID,VP) -C - FMTIDX=2 !SET FORMAT A2 - FTYP='PL2' - GOTO 10 -C -C PP2 -C - ENTRY WNQPP2(TYP,ID,VP) -C - FMTIDX=2 !SET FORMAT A2 - FTYP='PP2' - GOTO 10 -C -C EL1 -C - ENTRY WNQEL1(TYP,ID,VP) -C - FMTIDX=1 !SET FORMAT A1 - FTYP='EL1' - GOTO 10 -C -C EP1 -C - ENTRY WNQEP1(TYP,ID,VP) -C - FMTIDX=1 !SET FORMAT A1 - FTYP='EP1' - GOTO 10 -C -C PL1 -C - ENTRY WNQPL1(TYP,ID,VP) -C - FMTIDX=1 !SET FORMAT A1 - FTYP='PL1' - GOTO 10 -C -C PP1 -C - ENTRY WNQPP1(TYP,ID,VP) -C - FMTIDX=1 !SET FORMAT A1 - FTYP='PP1' - GOTO 10 -C -C EL0 -C - ENTRY WNQEL0(TYP,ID,VP) -C - FMTIDX=0 !SET FORMAT A0 - FTYP='EL0' - GOTO 10 -C -C EP0 -C - ENTRY WNQEP0(TYP,ID,VP) -C - FMTIDX=0 !SET FORMAT A0 - FTYP='EP0' - GOTO 10 -C -C PL0 -C - ENTRY WNQPL0(TYP,ID,VP) -C - FMTIDX=0 !SET FORMAT A0 - FTYP='PL0' - GOTO 10 -C -C PP0 -C - ENTRY WNQPP0(TYP,ID,VP) -C - FMTIDX=0 !SET FORMAT A0 - FTYP='PP0' - GOTO 10 -C -C INIT -C - 10 CONTINUE - CR=CHAR(13) - LF=CHAR(10) - CRLF=CR//LF - IF (FTYP(1:1).EQ.'E') THEN - LEPS=.TRUE. !SET EPS - ELSE - LEPS=.FALSE. !SET PS - END IF - LZER=.FALSE. !NOT ZERO SCREEN - PB=ID-A_OB !BYTE POINTER - PJ=(ID-A_OB)/LB_J !J PTR - PE=(ID-A_OB)/LB_E !E PTR -C -C DISTRIBUTE -C - IF (TYP.EQ.0) THEN !OPEN - GOTO 1000 - ELSE IF (TYP.EQ.1) THEN !CLOSE - GOTO 1100 - ELSE IF (TYP.EQ.2) THEN !MESSAGE - GOTO 1200 - ELSE IF (TYP.EQ.3) THEN !POLY LINE - PLW1(1)=IXTL(NINT(A_E(PE+WQD_PLIX_E+3*VP(1)))) !LINE TYPE - J=MIN(A_E(PE+WQD_MXPLS_E),A_E(PE+WQD_NMPLS_E)* - 1 A_E(PE+WQD_PLIX_E+3*VP(1)+1)) !THICKNESS - GOTO 1300 - ELSE IF (TYP.EQ.4) THEN !POLY LINE - PLW1(1)=IXTL(NINT(WNGGE(VP(3)))) !LINE TYPE - J=MIN(A_E(PE+WQD_MXPLS_E),A_E(PE+WQD_NMPLS_E)* - 1 WNGGE(VP(4))) !THICKNESS - GOTO 1300 - ELSE IF (TYP.EQ.5) THEN !CLEAR SCREEN - LZER=.TRUE. !INDICATE ZERO - GOTO 1100 !CLOSE AND REOPEN - ELSE IF (TYP.EQ.6) THEN !SHADING - GOTO 1600 - END IF -C - 900 CONTINUE -C - RETURN !UNKNOWN -C -C OPEN -C - 1000 CONTINUE - FNM=WNFFNM(FTYP,'PLT') !OUTPUT FILE NAME - CALL WNGLUN(A_J(PJ+WQD_USE_J+2)) !GET LUN -#ifdef wn_li__ - OPEN(UNIT=A_J(PJ+WQD_USE_J+2),FILE=FNM,STATUS='NEW', - 1 FORM='FORMATTED',IOSTAT=J2) !OPEN OUTPUT -#else - OPEN(UNIT=A_J(PJ+WQD_USE_J+2),FILE=FNM,STATUS='NEW', - 1 CARRIAGECONTROL='LIST', - 1 FORM='FORMATTED',IOSTAT=J2) !OPEN OUTPUT -#endif - CALL WNGMFS(WQD_FILE_N,FNM,A_B(PB+WQD_FILE_1)) !SAVE FILE NAME - WRITE (UNIT=A_J(PJ+WQD_USE_J+2),FMT=8000,ERR=900) - 1 '%!PS-Adobe-1.0' - WRITE (UNIT=A_J(PJ+WQD_USE_J+2),FMT=8000,ERR=900) - 1 '% File produced by WNP system' - WRITE (UNIT=A_J(PJ+WQD_USE_J+2),FMT=9012,ERR=900) - 1 INT(A_E(PE+WQD_XHI_E)*FMTSCL(FMTIDX)), - 1 INT(A_E(PE+WQD_YHI_E)*FMTSCL(FMTIDX)) - 9012 FORMAT('%%BoundingBox: 0 0 ',I4.4,' ',I4.4) - WRITE (UNIT=A_J(PJ+WQD_USE_J+2),FMT=8000,ERR=900) - 1 '%%Pages: 1' - WRITE (UNIT=A_J(PJ+WQD_USE_J+2),FMT=8000,ERR=900) - 1 '%%Title: NPLOT' - WRITE (UNIT=A_J(PJ+WQD_USE_J+2),FMT=8000,ERR=900) - 1 '%%Page: 0 1' - IF (.NOT.LEPS) THEN - WRITE (UNIT=A_J(PJ+WQD_USE_J+2),FMT=8000,ERR=900) - 1 '/Saveobj save def' - END IF - IF (FMTIDX.EQ.3) THEN !A3 - WRITE (UNIT=A_J(PJ+WQD_USE_J+2),FMT=8000,ERR=900) - 1 '<</PageSize[842 1188]>>setpagedevice' - ELSE IF (FMTIDX.EQ.2) THEN !A2 - WRITE (UNIT=A_J(PJ+WQD_USE_J+2),FMT=8000,ERR=900) - 1 '<</PageSize[1188 1684]>>setpagedevice' - ELSE IF (FMTIDX.EQ.1) THEN !A1 - WRITE (UNIT=A_J(PJ+WQD_USE_J+2),FMT=8000,ERR=900) - 1 '<</PageSize[1684 2383]>>setpagedevice' - ENDIF - WRITE (UNIT=A_J(PJ+WQD_USE_J+2),FMT=8000,ERR=900) - 1 '/m {moveto} def'// - 1 CRLF//'/l {lineto} def'// - 1 CRLF//'/s {stroke} def'// - 1 CRLF//'/n {newpath} def' - WRITE (UNIT=A_J(PJ+WQD_USE_J+2),FMT=8000,ERR=900) - 1 '/f {fill} def'// - 1 CRLF//'/c {closepath} def'// - 1 CRLF//'/sw {setlinewidth} def'// - 1 CRLF//'/sd {setdash} def' - WRITE (UNIT=A_J(PJ+WQD_USE_J+2),FMT=8000,ERR=900) - 1 '/sg {setgray} def'// - 1 CRLF//'2 setlinejoin'// - 1 CRLF//'20 20 translate' - WRITE (UNIT=A_J(PJ+WQD_USE_J+2),FMT=9013,ERR=900) - 1 FMTSCL(FMTIDX),FMTSCL(FMTIDX) - 9013 FORMAT(F4.3,1x,F4.3,' scale') - IF (A_E(PE+WQD_YHI_E).LT.A_E(PE+WQD_XHI_E)) THEN !LANDSCAPE - WRITE (UNIT=A_J(PJ+WQD_USE_J+2),FMT=9014,ERR=900) - 1 INT(A_E(PE+WQD_YHI_E)) - 9014 FORMAT(I4.4,' 100 translate 90 rotate') - END IF - 24 CONTINUE - WRITE (UNIT=A_J(PJ+WQD_USE_J+2),FMT=8000,ERR=900) - 1 '3.0 setlinewidth' !INIT STRING - A_J(PJ+WQD_USE_J+0)=DEFPL !POLYLINE INDEX -C - RETURN -C -C CLOSE -C - 1100 CONTINUE - WRITE (UNIT=A_J(PJ+WQD_USE_J+2),FMT=8000,ERR=900) - 1 'showpage' - IF (LEPS) THEN !EPS - LOPC='%%Trailer' - ELSE - LOPC='Saveobj restore' - END IF - J=WNCALX(LOPC) - WRITE (UNIT=A_J(PJ+WQD_USE_J+2),FMT=8000,ERR=900) - 1 LOPC(1:J) !WRITE END - CLOSE (UNIT=A_J(PJ+WQD_USE_J+2),STATUS='KEEP',IOSTAT=J2) !CLOSE FILE - CALL WNGMTS(WQD_FILE_N,A_B(PB+WQD_FILE_1),FNM) !GET FILE NAME - IF (.NOT.LEPS) THEN - IF (FMTIDX.EQ.3) THEN !A3 - CALL WNGSSP('WNGFEX A3',FNM,FNM,'D') !SPOOL AND DELETE - ELSE IF (FMTIDX.EQ.4) THEN !A4 - CALL WNGSSP('WNGFEX PS',FNM,FNM,'D') !SPOOL AND DELETE - ELSE !A0/A1/A2 - CALL WNGSSP('WNGFEX A0',FNM,FNM,'D') !SPOOL AND DELETE - END IF - END IF - IF (LZER) GOTO 1000 !REOPEN -C - RETURN -C -C MESSAGE -C - 1200 CONTINUE - WRITE(UNIT=A_J(PJ+WQD_USE_J+2),FMT=9040,ERR=1201) - 1 CRLF,CRLF,CRLF,0,INT(A_E(PE+WQD_YHI_E)-20),CRLF - 9040 FORMAT( '/Helvetica findfont',A2, - 1 '40 scalefont',A2, - 1 'setfont',A2, - 1 I4.4,' ',I4.4,' m',A2) - 1201 CONTINUE - LOPC='(' - J0=MIN(VP(2),A_J(PJ+WQD_MGL_J)) !MESSAGE LENGTH - CALL WNGMTS(J0,A_B(VP(1)-A_OB),LOPC(2:)) !MESSAGE - LOPC(J0+2:)=') show' !END MESSAGE - J=WNCALX(LOPC) !LENGTH MESSAGE - WRITE (UNIT=A_J(PJ+WQD_USE_J+2),FMT=8000,ERR=900) - 1 LOPC(1:J) !WRITE MSG - A_J(PJ+WQD_USE_J+0)=DEFPL !POLYLINE INDEX -C - RETURN -C -C POLYLINE -C - 1300 CONTINUE - PLW1(2)=THL(1,J) - PLW1(3)=THL(2,J) - PLW1(4)=0 - IF (PLW.NE.A_J(PJ+WQD_USE_J+0)) THEN !CHANGED - A_J(PJ+WQD_USE_J+0)=PLW !SAVE NEW - LOPC(1:18)=CHAR(PLW1(2))//CHAR(PLW1(3))// - 1 ' sw '//LIXTL(PLW1(1))//' 0 sd' - WRITE (UNIT=A_J(PJ+WQD_USE_J+2),FMT=8000,ERR=900) - 1 LOPC(1:18) !WRITE TYPE - END IF - WRITE (UNIT=A_J(PJ+WQD_USE_J+2),FMT=8000,ERR=900) - 1 'n' !WRITE PATH -C -C DRAW LINES -C - J2=1 !OUTPUT POINTER - J=(VP(2)-A_OB)/LB_J !J/E INPUT PTR - 20 CONTINUE !DO PIECE - J1=A_J(J) !# OF POINTS - J=J+1 !INPUT POINTER - IF (J1.GT.0) THEN !MORE - IF (PLW1(1).NE.1) THEN !NOT FULL DRAWN - PATS=MOD(IAND(WNMRNJ()/8,31),IPLST(0,PLW1(1))) !PATTERN START - LOPC(1:19)=CHAR(PLW1(2))//CHAR(PLW1(3))// - 1 ' sw '//LIXTL(PLW1(1))//' 00 sd' - WRITE(UNIT=LOPC(15:16),FMT=9015,ERR=1302) PATS - 9015 FORMAT(I2.2) - 1302 CONTINUE - WRITE (UNIT=A_J(PJ+WQD_USE_J+2),FMT=8000,ERR=900) - 1 LOPC(1:19) !WRITE TYPE - END IF - FIRST_I1=A_E(J) !START X - FIRST_I2=A_E(J+1) !START Y - LOPC(10:11)=' m' !POSITION FIRST - DO WHILE (J1.GT.0) !ALL SEGMENTS - I1=A_E(J) !X - I2=A_E(J+1) !Y - J=J+2 !NEXT POINT - IF ((J1.EQ.1).AND. - 1 (I1.EQ.FIRST_I1).AND.(I2.EQ.FIRST_I2)) THEN - IF (I2.GT.0) I2=I2-1 - ENDIF - WRITE (UNIT=LOPC(1:9),FMT=9000,ERR=21) I1,I2 - 9000 FORMAT(I4.4,' ',I4.4) - 21 CONTINUE - WRITE (UNIT=A_J(PJ+WQD_USE_J+2),FMT=8000,ERR=900) - 1 LOPC(1:11) !DRAW - LOPC(11:11)='l' !DRAW - J1=J1-1 !COUNT - END DO - GOTO 20 !NEXT PIECE - END IF - WRITE (UNIT=A_J(PJ+WQD_USE_J+2),FMT=8000,ERR=900) - 1 's' !WRITE DRAWING -C - RETURN -C -C SHADING -C - 1600 CONTINUE - J=(VP(3)-A_OB)/LB_E !TOTAL BOX POINTER - J4=(VP(5)-A_OB)/LB_E !SINGLE BOX POINTER - XB(0,0)=MAX(0.,A_E(J+0)) !BOX LIMITS - XB(1,0)=MAX(0.,A_E(J+1)) - XB(0,1)=MIN(A_E(PE+WQD_XHI_E),A_E(J+2)) - XB(1,1)=MIN(A_E(PE+WQD_YHI_E),A_E(J+3)) -C -C ALL SQUARES -C - J0=(VP(2)-A_OB)/LB_E !INT POINTER - DO I=0,VP(4)-1 !ALL SQUARES - IF (A_E(J0+I).GE.0.) THEN !NOT DELETED - DO I1=0,1 !GET X,Y START - XYC(I1)=A_E(J4+4+I1)+I*A_E(J4+I1) - END DO - R0=MIN(1.,A_E(J0+I)) !INT. - IF (VP(1).EQ.1) THEN !REGULAR - R0=1.-(INT(R0*20.)/20.) - ELSE IF (VP(1).EQ.2) THEN !PATTERN - R0=1.-(INT(R0*10.)/10.) - ELSE - R0=1.-R0 !CONTIN. - END IF - WRITE (UNIT=LOPC(1:62),FMT=9020,ERR=1601) - 1 INT(XYC(0)),INT(XYC(1)), - 1 INT(XYC(0)+A_E(J4+2)),INT(XYC(1)), - 1 INT(XYC(0)+A_E(J4+2)),INT(XYC(1)+A_E(J4+3)), - 1 INT(XYC(0)),INT(XYC(1)+A_E(J4+3)),R0, - 1 ' sg f' - 9020 FORMAT('n',2I5,' m',2I5,' l',2I5,' l',2I5, - 1 ' l c',F6.2,A) - 1601 CONTINUE - WRITE (UNIT=A_J(PJ+WQD_USE_J+2),FMT=8000,ERR=900) - 1 LOPC(1:62) !DRAWING - END IF - END DO -C -C READY -C - 910 CONTINUE - WRITE (UNIT=A_J(PJ+WQD_USE_J+2),FMT=8000,ERR=900) - 1 '0 sg' !RESET GRAY LEVEL -C - RETURN -C - 8000 FORMAT(A) -C -C - END diff --git a/src/wng/wnqqms.for b/src/wng/wnqqms.for deleted file mode 100644 index b67442bf15cfe5dfbce20bb2d523609912090a59..0000000000000000000000000000000000000000 --- a/src/wng/wnqqms.for +++ /dev/null @@ -1,432 +0,0 @@ -C+ WNQQMS.FOR -C WNB 910624 -C -C Revisions: -C WNB 920113 Error message length -C WNB 920129 Add file type -C HjV 920728 Change relative top margin command for QMS portrait -C WNB 920811 Make lowest halftone level white -C WNB 930825 Change to WNCALX -C - SUBROUTINE WNQQMS(TYP,ID,VP) -C -C Do device dependent actions for QMS landscape/portrait -C -C Result: -C -C CALL WNQQMS( TYP_J:I, ID_J:I, VP_J(*):I) QMS landscape -C CALL WNQQMP( TYP_J:I, ID_J:I, VP_J(*):I) QMS portrait -C Do action specified by TYP, using the -C area ID, and pointers/values in VP. TYP can be: -C 0: open device -C VP: - -C 1: close device -C VP: - -C 2: (header) message -C VP: 1: ptr msg; 2: length msg -C 3: polyline -C VP: 1: poly index; 2: ptr list -C 4: polyline -C VP: 2: ptr list; 3: line type -C 4: line thickness -C 5: clear screen -C VP: - -C 6: shading -C VP: 1: type; 2: int. list -C 3: ptr llhc, urhc total -C 4: N int. -C 5: dx,dy , box dx,dy, pos. -C -C Include files: -C - INCLUDE 'WNG_DEF' - INCLUDE 'WQD_O_DEF' !DEVICE AREA -C -C Parameters: -C - CHARACTER*1 CR -C PARAMETER (CR=CHAR(13)) - CHARACTER*1 LF -C PARAMETER (LF=CHAR(10)) - CHARACTER*2 CRLF -C PARAMETER (CRLF=CR//LF) - INTEGER DEFPL !DEFAULT POLYLINE IX - PARAMETER (DEFPL='0030') - INTEGER LMG0L !MESSAGE START - PARAMETER (LMG0L=26) - CHARACTER*(LMG0L) LMG0C - PARAMETER (LMG0C='^IGE^JM0000^-^M00270024^DL') - INTEGER LMG1L !MESSAGE END - PARAMETER (LMG1L=21) - CHARACTER*(LMG1L) LMG1C - PARAMETER (LMG1C='^-^IP0101^IGV^PW03^V0') - INTEGER LOPL !MAX(INIT STRING, END STR, LMG0L+LMG1L+MGL) - PARAMETER (LOPL=200) -C -C Arguments: -C - INTEGER TYP !TYPE TO DO - INTEGER ID !PTR TO AREA - INTEGER VP(*) !DATA LIST -C -C Function references: -C - INTEGER WNCALX !STRING LENGTH - REAL WNGGE !GET E VALUE - LOGICAL WNGGVM !GET MEMORY - CHARACTER*20 WNFFNM !FILE NAME - LOGICAL WNFOP !OPEN FILE - LOGICAL WNFWR !WRITE FILE - INTEGER WNFEOF !END OF FILE - INTEGER WNMRNJ !RANDOM J -C -C Data declarations: -C - CHARACTER*3 FTYP !FILE TYPE - LOGICAL LZER !ZERO SCREEN INDICATOR - INTEGER PB,PJ,PE !POINTERS - INTEGER PATN,PATS !PATTERN SELECT, START - INTEGER PATD,PATU !PATTERN DOWN, UP - INTEGER PX,PY !SAVED X,Y - INTEGER XB(0:1,0:1) !SHADING BOX - INTEGER LL(0:3) !BITMAP SIZE - REAL XYC(0:1) !X, Y START - INTEGER BMP,OBMP !BITMAP - CHARACTER*(LOPL) LOPC !OPEN TEXT - BYTE LOPB(LOPL) - EQUIVALENCE (LOPC,LOPB) - CHARACTER*20 FNM !FILE NAME - INTEGER PLW !PLOT LINE TYPE - BYTE PLW1(4) - EQUIVALENCE (PLW,PLW1) - CHARACTER*64 THLC !LINE THICKNESS - BYTE THL(2,0:31) - EQUIVALENCE (THLC,THL) - DATA THLC(1:40)/'0101030305050707090911111313151517171919'/ - DATA THLC(41:64)/'212123232525272729293131'/ - BYTE IXTL(4) !LINE TYPE INFO - DATA IXTL/'0','1','2','3'/ - INTEGER IPLST(0:2,3) !PATTERN LENGTH, DOWN, UP - DATA IPLST /32,16,16, !DASH - 1 16,3,13, !DOT - 1 32,24,8/ !LONG DASH - INTEGER*2 OREV(0:255) !SHADING REVERSE BIT AND HEXA - CHARACTER*512 OREVC - EQUIVALENCE (OREV,OREVC) - DATA OREVC(001:032) /'008040C020A060E0109050D030B070F0'/ - DATA OREVC(033:064) /'088848C828A868E8189858D838B878F8'/ - DATA OREVC(065:096) /'048444C424A464E4149454D434B474F4'/ - DATA OREVC(097:128) /'0C8C4CCC2CAC6CEC1C9C5CDC3CBC7CFC'/ - DATA OREVC(129:160) /'028242C222A262E2129252D232B272F2'/ - DATA OREVC(161:192) /'0A8A4ACA2AAA6AEA1A9A5ADA3ABA7AFA'/ - DATA OREVC(193:224) /'068646C626A666E6169656D636B676F6'/ - DATA OREVC(225:256) /'0E8E4ECE2EAE6EEE1E9E5EDE3EBE7EFE'/ - DATA OREVC(257:288) /'018141C121A161E1119151D131B171F1'/ - DATA OREVC(289:320) /'098949C929A969E9199959D939B979F9'/ - DATA OREVC(321:352) /'058545C525A565E5159555D535B575F5'/ - DATA OREVC(353:384) /'0D8D4DCD2DAD6DED1D9D5DDD3DBD7DFD'/ - DATA OREVC(385:416) /'038343C323A363E3139353D333B373F3'/ - DATA OREVC(417:448) /'0B8B4BCB2BAB6BEB1B9B5BDB3BBB7BFB'/ - DATA OREVC(449:480) /'078747C727A767E7179757D737B777F7'/ - DATA OREVC(481:512) /'0F8F4FCF2FAF6FEF1F9F5FDF3FBF7FFF'/ - INTEGER RTAB(0:4,0:4) !REGULAR SHADING - DATA RTAB/0,9,17,18,3,5,11,7,14,13,18,2,1,8,17, - 1 17,12,4,10,18,6,15,18,17,16/ - CHARACTER*36 CPAT(0:9) !PATTERNS - DATA CPAT(0) /'100100000000000000100100000000000000'/ - DATA CPAT(1) /'111000111000111000111000111000111000'/ - DATA CPAT(2) /'111111111111111111000000000000000000'/ - DATA CPAT(3) /'110001111000011100001110000111100011'/ - DATA CPAT(4) /'100011000111001110011100111000110001'/ - DATA CPAT(5) /'111000111000111000000111000111000111'/ - DATA CPAT(6) /'100100100100100100100100100100100100'/ - DATA CPAT(7) /'111111000000000000111111000000000000'/ - DATA CPAT(8) /'100000010000001000000100000010000001'/ - DATA CPAT(9) /'000001000010000100001000010000100000'/ -C- -C -C QMS -C - IF (TYP.EQ.0) THEN - LOPC='ReSeTrEsEtReSeT'//CRLF//'^PY^-'//CRLF// - 1 '^F^-^IOL^-^JM00000^T00000^-'//CRLF// - 1 '^ISTF00^-^IP0101^ISYNTAX00010^-'//CRLF// - 1 '^IGV^PW03^V0' !INIT STRING - END IF - FTYP='QMS' - GOTO 10 -C -C QMP -C - ENTRY WNQQMP(TYP,ID,VP) -C - IF (TYP.EQ.0) THEN - LOPC='ReSeTrEsEtReSeT'//CRLF//'^PY^-'//CRLF// - 1 '^F^-^IOP^-^JM00150^T00000^-'//CRLF// - 1 '^ISTF00^-IP0101^ISYNTAX00010^-'//CRLF// - 1 '^IGV^PW03^V0' !INIT STRING - END IF - FTYP='QMP' - GOTO 10 -C -C INIT -C - 10 CONTINUE - CR=CHAR(13) - LF=CHAR(10) - CRLF=CR//LF - LZER=.FALSE. !NOT ZERO SCREEN - PB=ID-A_OB !BYTE POINTER - PJ=(ID-A_OB)/LB_J !J PTR - PE=(ID-A_OB)/LB_E !E PTR -C -C DISTRIBUTE -C - IF (TYP.EQ.0) THEN !OPEN - GOTO 1000 - ELSE IF (TYP.EQ.1) THEN !CLOSE - GOTO 1100 - ELSE IF (TYP.EQ.2) THEN !MESSAGE - GOTO 1200 - ELSE IF (TYP.EQ.3) THEN !POLY LINE - PLW1(1)=IXTL(NINT(A_E(PE+WQD_PLIX_E+3*VP(1)))) !LINE TYPE - J=MIN(A_E(PE+WQD_MXPLS_E),A_E(PE+WQD_NMPLS_E)* - 1 A_E(PE+WQD_PLIX_E+3*VP(1)+1)) !THICKNESS - GOTO 1300 - ELSE IF (TYP.EQ.4) THEN !POLY LINE - PLW1(1)=IXTL(NINT(WNGGE(VP(3)))) !LINE TYPE - J=MIN(A_E(PE+WQD_MXPLS_E),A_E(PE+WQD_NMPLS_E)* - 1 WNGGE(VP(4))) !THICKNESS - GOTO 1300 - ELSE IF (TYP.EQ.5) THEN !CLEAR SCREEN - LZER=.TRUE. !INDICATE ZERO - GOTO 1100 !CLOSE AND REOPEN - ELSE IF (TYP.EQ.6) THEN !SHADING - GOTO 1600 - END IF -C - 900 CONTINUE -C - RETURN !UNKNOWN -C -C OPEN -C - 1000 CONTINUE - J=WNCALX(LOPC) !LENGTH - FNM=WNFFNM(FTYP,'PLT') !OUTPUT FILE NAME - IF (.NOT.WNFOP(A_J(PJ+WQD_USE_J+2),FNM,'W')) GOTO 900 !OPEN OUTPUT - CALL WNGMFS(WQD_FILE_N,FNM,A_B(PB+WQD_FILE_1)) !SAVE FILE NAME - IF (.NOT.WNFWR(A_J(PJ+WQD_USE_J+2),J,LOPB,0)) GOTO 900 !WRITE INIT. - A_J(PJ+WQD_USE_J+0)=DEFPL !POLYLINE INDEX -C - RETURN -C -C CLOSE -C - 1100 CONTINUE - LOPC='^G^-'//CRLF// - 1 '^IGE^IP0000^ISYNTAX00000^-^,^O^-'//CRLF// - 1 '^IMV0000011690^-^PN^-'//CRLF !CLOSE STRING - J=WNCALX(LOPC)+16 - IF (.NOT.WNFWR(A_J(PJ+WQD_USE_J+2),J,LOPB,-1)) GOTO 900 !WRITE END - LOPC=' ' !FILL BLOCK - J=128-MOD(WNFEOF(A_J(PJ+WQD_USE_J+2)),128) !POSITION - IF (.NOT.WNFWR(A_J(PJ+WQD_USE_J+2),J,LOPB,-1)) GOTO 900 !FILL END - CALL WNFCL(A_J(PJ+WQD_USE_J+2)) !CLOSE FILE - CALL WNGMTS(WQD_FILE_N,A_B(PB+WQD_FILE_1),FNM) !GET FILE NAME - CALL WNGSSP('WNGFEX QM',FNM,FNM,'D') !SPOOL AND DELETE - IF (LZER) GOTO 1000 !REOPEN -C - RETURN -C -C MESSAGE -C - 1200 CONTINUE - LOPC=LMG0C !START MESSAGE - J0=MIN(VP(2),A_J(PJ+WQD_MGL_J)) !MESSAGE LENGTH - CALL WNGMTS(J0,A_B(VP(1)-A_OB),LOPC(LMG0L+1:)) !MESSAGE - LOPC(LMG0L+J0+1:)=LMG1C !END MESSAGE - J=LMG0L+J0+LMG1L !LENGTH MESSAGE - IF (.NOT.WNFWR(A_J(PJ+WQD_USE_J+2),J,LOPB,-1)) GOTO 900 !WRITE MSG - A_J(PJ+WQD_USE_J+0)=DEFPL !POLYLINE INDEX -C - RETURN -C -C POLYLINE -C - 1300 CONTINUE - PLW1(2)=THL(1,J) - PLW1(3)=THL(2,J) - PLW1(4)=ICHAR('0') - IF (PLW.NE.A_J(PJ+WQD_USE_J+0)) THEN !CHANGED - A_J(PJ+WQD_USE_J+0)=PLW !SAVE NEW - LOPC(1:8)='^PW'//CHAR(PLW1(2))//CHAR(PLW1(3))//'^V'// - 1 CHAR(PLW1(1)) !WRITE - IF (.NOT.WNFWR(A_J(PJ+WQD_USE_J+2),8,LOPB,-1)) GOTO 900 !WRITE LINE TYPE - END IF -C -C DRAW LINES -C - J2=1 !OUTPUT POINTER - J=(VP(2)-A_OB)/LB_J !J/E INPUT PTR - 20 CONTINUE !DO PIECE - J1=A_J(J) !# OF POINTS - J=J+1 !INPUT POINTER - IF (J1.GT.0) THEN !MORE - IF (PLW1(1).NE.ICHAR('0')) THEN !NOT FULL DRAWN - LOPC(1:6)='^PV'//CHAR(PLW1(1))//'04' !LINE TYPE - PATN=PLW1(1)-48 !TYPE - PATS=MOD(IAND(WNMRNJ()/64,31),IPLST(0,PATN)) !PATTERN START - LOPC(23:24)='^G' !END PATTERN - END IF - LOPC(25:26)='^U' !POSITION FIRST - DO WHILE (J1.GT.0) !ALL SEGMENTS - I1=A_E(J) !X - I2=A_E(PE+WQD_YHI_E)-A_E(J+1) !Y - J=J+2 !NEXT POINT - WRITE (UNIT=LOPC(27:35),FMT=9000,ERR=21) I1,I2 - 9000 FORMAT(I4.4,':',I4.4) - 21 CONTINUE - IF (PLW1(1).NE.ICHAR('0') .AND. - 1 LOPC(25:26).EQ.'^D') THEN !NOT FULL DRAWN - IF (PATS.GE.IPLST(1,PATN)) THEN - PATD=0 !DOWN - PATU=IPLST(2,PATN)-(PATS-IPLST(1,PATN)) !UP - ELSE - PATD=IPLST(1,PATN)-PATS - PATU=IPLST(2,PATN) - END IF - R0=SQRT(REAL(I1-PX)**2+REAL(I2-PY)**2) !LENGTH TO DRAW - IF (PATD.EQ.0) THEN !START WITH UP - LOPC(25:26)='^U' - IF (INT(R0).GT.PATU) THEN !DO ALL UP - J1=J1+1 !DO NOT COUNT - J=J-2 - I1=(PATU+1)/R0*(I1-PX)+PX !TO X - I2=(PATU+1)/R0*(I2-PY)+PY !TO Y - WRITE (UNIT=LOPC(27:35),FMT=9000,ERR=21) I1,I2 - END IF - IF (.NOT.WNFWR(A_J(PJ+WQD_USE_J+2),11,LOPB(25),-1)) - 1 GOTO 900 !DRAW - PATS=MOD(PATS+PATU,IPLST(0,PATN)) - ELSE - WRITE (UNIT=LOPC(7:22),FMT=9010,ERR=22) !PATTERN - 1 PATD,PATU,IPLST(1,PATN)-PATD,0 -9010 FORMAT(I4.4,I4.4,I4.4,I4.4) - 22 CONTINUE - IF (.NOT.WNFWR(A_J(PJ+WQD_USE_J+2),35,LOPB,-1)) GOTO 900 !DRAW - PATS=MOD(PATS+INT(R0),IPLST(0,PATN)) !NEXT PATTERN - END IF - ELSE - IF (.NOT.WNFWR(A_J(PJ+WQD_USE_J+2),11,LOPB(25),-1)) GOTO 900 !DRAW - END IF - LOPC(25:26)='^D' !DRAW - PX=I1 !SAVE X,Y - PY=I2 - J1=J1-1 !COUNT - END DO - GOTO 20 !NEXT PIECE - END IF -C - RETURN -C -C SHADING -C - 1600 CONTINUE - J=(VP(3)-A_OB)/LB_E !TOTAL BOX POINTER - J4=(VP(5)-A_OB)/LB_E !SINGLE BOX POINTER - XB(0,0)=MAX(0.,A_E(J+0)) !BOX LIMITS - XB(1,0)=MAX(0.,A_E(J+1)) - XB(0,1)=MIN(A_E(PE+WQD_XHI_E),A_E(J+2)) - XB(1,1)=MIN(A_E(PE+WQD_YHI_E),A_E(J+3)) - LL(0)=((XB(0,1)-XB(0,0)+L_J-1)/L_J)*L_J !BITS PER LINE - LL(2)=LL(0)/L_J !WORDS PER LINE - LL(1)=XB(1,1)-XB(1,0) !# OF LINES - LL(3)=LL(2)*LL(1)*LB_J !BITMAP LENGTH BYTES - IF (.NOT.WNGGVM(LL(3),BMP)) GOTO 900 !GET BITMAP - IF (.NOT.WNGGVM(2*LB_J*LL(2),OBMP)) GOTO 900 !GET BITMAP OUTPUT LINE - CALL WNGMVZ(LL(3),A_B(BMP-A_OB)) !CLEAR BITMAP -C -C ALL SQUARES -C - J0=(VP(2)-A_OB)/LB_E !INT POINTER - DO I=0,VP(4)-1 !ALL SQUARES - IF (A_E(J0+I).GE.0.) THEN !NOT DELETED - DO I1=0,1 !GET X,Y START - XYC(I1)=A_E(J4+4+I1)+I*A_E(J4+I1) - END DO - DO I1=INT(XYC(1)),INT(XYC(1)+A_E(J4+3))-1 !ALL LINES - IF (I1.GE.XB(1,0) .AND. I1.LT.XB(1,1)) THEN !IN MAP - I3=(BMP-A_OB)/LB_J+(I1-XB(1,0))*LL(2) !WORD POINTER LINE - DO I2=INT(XYC(0)),INT(XYC(0)+A_E(J4+2))-1 !ALL POINTS - IF (I2.GE.XB(0,0) .AND. I2.LT.XB(0,1)) THEN !IN MAP - R0=MIN(1.,A_E(J0+I)) !INT. - J2=I3+(I2-XB(0,0))/L_J !WORD POINTER - J3=ISHFT(1,MOD(I2-XB(0,0),L_J)) !BIT - IF (VP(1).EQ.1) THEN !REGULAR - IF (INT(R0*20.).GT.RTAB(MOD(I2,5),MOD(I1,5))) THEN !SET - A_J(J2)=IOR(A_J(J2),J3) - END IF - ELSE IF (VP(1).EQ.2) THEN !PATTERN - PATN=MIN(9,INT(10.*R0)) !PATTERN NUMBER - PATS=MOD(I1,6)*6+MOD(I2,6)+1 !PATTERN POINTER - IF (CPAT(PATN)(PATS:PATS).NE.'0') THEN !SET - A_J(J2)=IOR(A_J(J2),J3) - END IF - ELSE !RANDOM - R1=IAND(WNMRNJ()/64,255)/256. !RANDOM TEST - IF (R0.LT.0.75) THEN - IF (R1.LT.0.5*R0) THEN !SET - A_J(J2)=IOR(A_J(J2),J3) - END IF - ELSE - IF (R1.LT.2.5*R0-1.5) THEN !SET - A_J(J2)=IOR(A_J(J2),J3) - END IF - END IF - END IF - END IF - END DO - END IF - END DO - END IF - END DO -C -C OUTPUT START -C - WRITE (UNIT=LOPC,FMT=9001,ERR=31) !POSITION - 1 INT(A_E(PE+WQD_YHI_E))-XB(1,1)+1, - 1 XB(0,0),LL(0) -9001 FORMAT('^IGE^-^JM',I4.4,'^T',I4.4,'^IP0101^O^P',I4.4) - 31 CONTINUE - IF (.NOT.WNFWR(A_J(PJ+WQD_USE_J+2),WNCALX(LOPC),LOPB,-1)) GOTO 910 -C -C OUTPUT LINES -C - DO I=LL(1)-1,0,-1 !ALL LINES - J1=(OBMP-A_OB)/LB_I !OUTPUT POINTER - J2=BMP-A_OB+I*LL(2)*LB_J !INPUT POINTER - DO I1=0,LL(2)*LB_J-1 !ALL POINTS - I2=A_B(J2+I1) - I2=IAND(255,I2) !INPUT - A_I(J1+I1)=OREV(I2) !OUTPUT - END DO - IF (.NOT.WNFWR(A_J(PJ+WQD_USE_J+2),2*LB_J*LL(2), - 1 A_I(J1),-1)) GOTO 910 !OUTPUT LINE - END DO -C -C END PLOT -C - LOPC='^G^-^F^IGV^PW03^V0^-'//CRLF !END PLOT - IF (.NOT.WNFWR(A_J(PJ+WQD_USE_J+2),22,LOPB,-1)) GOTO 910 -C -C READY -C - 910 CONTINUE - CALL WNGFVM(LL(3),BMP) !REMOVE BITMAP - CALL WNGFVM(2*LB_J*LL(2),OBMP) -C - RETURN -C -C - END diff --git a/src/wng/wnqreg.for b/src/wng/wnqreg.for deleted file mode 100644 index ae6c7f883c18dfcb75bfacee493fb73cb8185a74..0000000000000000000000000000000000000000 --- a/src/wng/wnqreg.for +++ /dev/null @@ -1,343 +0,0 @@ -C+ WNQREG.FOR -C WNB 911217 -C -C Revisions: -C WNB 920811 Make lowest halftone pure white -C - SUBROUTINE WNQREG(TYP,ID,VP) -C -C Do device dependent actions for REGis terminals -C -C Result: -C -C CALL WNQREG( TYP_J:I, ID_J:I, VP_J(*):I) Regis terminal -C CALL WNQREF( TYP_J:I, ID_J:I, VP_J(*):I) Regis file -C Do action specified by TYP, using the -C area ID, and pointers/values in VP. TYP can be: -C 0: open device -C VP: - -C 1: close device -C VP: - -C 2: (header) message -C VP: 1: ptr msg; 2: length msg -C 3: polyline -C VP: 1: poly index; 2: ptr list -C 4: polyline -C VP: 2: ptr list; 3: line type -C 4: line thickness -C 5: clear screen -C VP: - -C 6: shading -C VP: 1: type; 2: int. list -C 3: ptr llhc, urhc total -C 4: N int. -C 5: dx,dy , box dx,dy, pos. -C -C Include files: -C - INCLUDE 'WNG_DEF' - INCLUDE 'WQD_O_DEF' !DEVICE AREA -C -C Parameters: -C - CHARACTER*1 CR -C PARAMETER (CR=CHAR(13)) - CHARACTER*1 LF -C PARAMETER (LF=CHAR(10)) - CHARACTER*2 CRLF -C PARAMETER (CRLF=CR//LF) - CHARACTER*1 ESC -C PARAMETER (ESC=CHAR(27)) - INTEGER DEFPL !DEFAULT POLYLINE IX - PARAMETER (DEFPL='0030') - INTEGER LOPL !MAX(INIT STRING, END STR, LMG0L+LMG1L+MGL) - PARAMETER (LOPL=200) -C -C Arguments: -C - INTEGER TYP !TYPE TO DO - INTEGER ID !PTR TO AREA - INTEGER VP(*) !DATA LIST -C -C Function references: -C - INTEGER WNCALN !STRING LENGTH - REAL WNGGE !GET E VALUE - LOGICAL WNGGVM !GET MEMORY - CHARACTER*20 WNFFNM !FILE NAME - LOGICAL WNFOP !OPEN FILE - LOGICAL WNFWR !WRITE FILE - INTEGER WNMRNJ !RANDOM J -C -C Data declarations: -C - INTEGER PB,PJ,PE !POINTERS - INTEGER PATN,PATS !PATTERN SELECT, START - INTEGER XB(0:1,0:1) !SHADING BOX - REAL XYC(0:1) !X, Y START - CHARACTER*(LOPL) LOPC !OPEN TEXT - BYTE LOPB(LOPL) - EQUIVALENCE (LOPC,LOPB) - CHARACTER*20 FNM !FILE NAME - INTEGER PLW !PLOT LINE TYPE - BYTE PLW1(4) - EQUIVALENCE (PLW,PLW1) - CHARACTER*64 THLC !LINE THICKNESS - BYTE THL(2,0:31) - EQUIVALENCE (THLC,THL) - DATA THLC(1:40)/'0101030305050707090911111313151517171919'/ - DATA THLC(41:64)/'212123232525272729293131'/ - BYTE IXTL(4) !LINE TYPE INFO - DATA IXTL/1,2,3,4/ - CHARACTER*5 LIXTL(4) !SET LINE TYPES - DATA LIXTL/'W(P1)','W(P2)','W(P3)','W(P4)'/ - INTEGER IPLST(0:2,3) !PATTERN LENGTH, DOWN, UP - DATA IPLST /32,16,16, !DASH - 1 16,3,13, !DOT - 1 32,24,8/ !LONG DASH - INTEGER*2 OREV(0:255) !SHADING REVERSE BIT AND HEXA - CHARACTER*512 OREVC - EQUIVALENCE (OREV,OREVC) - DATA OREVC(001:032) /'008040C020A060E0109050D030B070F0'/ - DATA OREVC(033:064) /'088848C828A868E8189858D838B878F8'/ - DATA OREVC(065:096) /'048444C424A464E4149454D434B474F4'/ - DATA OREVC(097:128) /'0C8C4CCC2CAC6CEC1C9C5CDC3CBC7CFC'/ - DATA OREVC(129:160) /'028242C222A262E2129252D232B272F2'/ - DATA OREVC(161:192) /'0A8A4ACA2AAA6AEA1A9A5ADA3ABA7AFA'/ - DATA OREVC(193:224) /'068646C626A666E6169656D636B676F6'/ - DATA OREVC(225:256) /'0E8E4ECE2EAE6EEE1E9E5EDE3EBE7EFE'/ - DATA OREVC(257:288) /'018141C121A161E1119151D131B171F1'/ - DATA OREVC(289:320) /'098949C929A969E9199959D939B979F9'/ - DATA OREVC(321:352) /'058545C525A565E5159555D535B575F5'/ - DATA OREVC(353:384) /'0D8D4DCD2DAD6DED1D9D5DDD3DBD7DFD'/ - DATA OREVC(385:416) /'038343C323A363E3139353D333B373F3'/ - DATA OREVC(417:448) /'0B8B4BCB2BAB6BEB1B9B5BDB3BBB7BFB'/ - DATA OREVC(449:480) /'078747C727A767E7179757D737B777F7'/ - DATA OREVC(481:512) /'0F8F4FCF2FAF6FEF1F9F5FDF3FBF7FFF'/ - INTEGER RTAB(0:4,0:4) !REGULAR SHADING - DATA RTAB/0,9,17,18,3,5,11,7,14,13,18,2,1,8,17, - 1 17,12,4,10,18,6,15,18,17,16/ - CHARACTER*36 CPAT(0:9) !PATTERNS - DATA CPAT(0) /'100100000000000000100100000000000000'/ - DATA CPAT(1) /'111000111000111000111000111000111000'/ - DATA CPAT(2) /'111111111111111111000000000000000000'/ - DATA CPAT(3) /'110001111000011100001110000111100011'/ - DATA CPAT(4) /'100011000111001110011100111000110001'/ - DATA CPAT(5) /'111000111000111000000111000111000111'/ - DATA CPAT(6) /'100100100100100100100100100100100100'/ - DATA CPAT(7) /'111111000000000000111111000000000000'/ - DATA CPAT(8) /'100000010000001000000100000010000001'/ - DATA CPAT(9) /'000001000010000100001000010000100000'/ -C- -C -C REG -C - GOTO 10 -C -C REF -C - ENTRY WNQREF(TYP,ID,VP) -C - GOTO 10 -C -C INIT -C - 10 CONTINUE - CR=CHAR(13) - LF=CHAR(10) - CRLF=CR//LF - ESC=CHAR(27) - PB=ID-A_OB !BYTE POINTER - PJ=(ID-A_OB)/LB_J !J PTR - PE=(ID-A_OB)/LB_E !E PTR -C -C DISTRIBUTE -C - IF (TYP.EQ.0) THEN !OPEN - GOTO 1000 - ELSE IF (TYP.EQ.1) THEN !CLOSE - GOTO 1100 - ELSE IF (TYP.EQ.2) THEN !MESSAGE - GOTO 1200 - ELSE IF (TYP.EQ.3) THEN !POLY LINE - PLW1(1)=IXTL(NINT(A_E(PE+WQD_PLIX_E+3*VP(1)))) !LINE TYPE - J=MIN(A_E(PE+WQD_MXPLS_E),A_E(PE+WQD_NMPLS_E)* - 1 A_E(PE+WQD_PLIX_E+3*VP(1)+1)) !THICKNESS - GOTO 1300 - ELSE IF (TYP.EQ.4) THEN !POLY LINE - PLW1(1)=IXTL(NINT(WNGGE(VP(3)))) !LINE TYPE - J=MIN(A_E(PE+WQD_MXPLS_E),A_E(PE+WQD_NMPLS_E)* - 1 WNGGE(VP(4))) !THICKNESS - GOTO 1300 - ELSE IF (TYP.EQ.5) THEN !CLEAR SCREEN - GOTO 1500 - ELSE IF (TYP.EQ.6) THEN !SHADING - GOTO 1600 - END IF -C - 900 CONTINUE -C - RETURN !UNKNOWN -C -C OPEN -C - 1000 CONTINUE - LOPC=' '//CR//ESC//'[!p'//ESC//'PpS(I0,E,A[0,499][799,0])P[0,0]' - J=WNCALN(LOPC) !LENGTH -CC FNM=WNFFNM('QMS','PLT') !OUTPUT FILE NAME -CC IF (.NOT.WNFOP(A_J(PJ+WQD_USE_J+2),FNM,'W')) GOTO 900 !OPEN OUTPUT -CC CALL WNGMFS(WQD_FILE_N,FNM,A_B(PB+WQD_FILE_1)) !SAVE FILE NAME -CC IF (.NOT.WNFWR(A_J(PJ+WQD_USE_J+2),J,LOPB,0)) GOTO 900 !WRITE INIT. - WRITE(*,2000) LOPC(1:J) !WRITE INIT - 2000 FORMAT ('+',A) - A_J(PJ+WQD_USE_J+0)=DEFPL !POLYLINE INDEX -C - RETURN -C -C CLOSE -C - 1100 CONTINUE - LOPC=CR//LF//'P[580,499]T(A0,S1)T(W(N1))'''// !END MESSAGE - 1 ' Hit RETURN to continue '''// - 1 'P[0,80]'//ESC//CHAR(92)//ESC//'[2A'//CR - J=WNCALN(LOPC) -CC IF (.NOT.WNFWR(A_J(PJ+WQD_USE_J+2),J,LOPB,-1)) GOTO 900 !WRITE END -CC CALL WNFCL(A_J(PJ+WQD_USE_J+2)) !CLOSE FILE -CC CALL WNGMTS(WQD_FILE_N,A_B(PB+WQD_FILE_1),FNM) !GET FILE NAME - WRITE(*,2000) LOPC(1:J) !WRITE END - READ(*,9030) LOPC !WAIT -9030 FORMAT (A) -C - RETURN -C -C MESSAGE -C - 1200 CONTINUE - LOPC=CR//LF//'P[0,499]T(A0),(S1)''' !START MESSAGE - I=WNCALN(LOPC) !LENGTH FILLED - DO I1=0,VP(2)-1 !CHECK ' AND SET MESSAGE - IF (A_B(VP(1)-A_OB+I1).EQ.ICHAR('''')) THEN - I=I+1 - LOPC(I:I+1)='''''' - I=I+1 - ELSE - I=I+1 - LOPC(I:I)=CHAR(A_B(VP(1)-A_OB+I1)) - END IF - END DO - I=I+1 - LOPC(I:I)='''' - WRITE(*,2000) LOPC(1:I) !SET MESSAGE - A_J(PJ+WQD_USE_J+0)=DEFPL !POLYLINE INDEX -C - RETURN -C -C POLYLINE -C - 1300 CONTINUE - PLW1(2)=THL(1,J) - PLW1(3)=THL(2,J) - PLW1(4)=0 - IF (PLW.NE.A_J(PJ+WQD_USE_J+0)) THEN !CHANGED - A_J(PJ+WQD_USE_J+0)=PLW !SAVE NEW - WRITE(*,2000) LIXTL(PLW1(1)) !SET LINE TYPE - END IF -C -C DRAW LINES -C - J2=1 !OUTPUT POINTER - J=(VP(2)-A_OB)/LB_J !J/E INPUT PTR - 20 CONTINUE !DO PIECE - J1=A_J(J) !# OF POINTS - J=J+1 !INPUT POINTER - IF (J1.GT.0) THEN !MORE - LOPC(1:1)='P' !POSITION FIRST - LOPC(11:13)='V[]' - DO WHILE (J1.GT.0) !ALL SEGMENTS - I1=A_E(J) !X - I2=A_E(J+1) !Y - J=J+2 !NEXT POINT - WRITE (UNIT=LOPC(2:10),FMT=9000,ERR=21) I1,I2 - 9000 FORMAT('[',I3.3,',',I3.3,']') - 21 CONTINUE - IF (LOPC(1:1).EQ.'P') THEN !DRAW - WRITE(*,2000) LOPC(1:13) - ELSE - WRITE(*,2000) LOPC(2:10) - END IF - LOPC(1:1)='V' !DRAW - J1=J1-1 !COUNT - END DO - GOTO 20 !NEXT PIECE - END IF -C - RETURN -C -C CLEAR SCREEN -C - 1500 CONTINUE - LOPC='S(I0,E,A[0,499][799,0])P[0,0]' - J=WNCALN(LOPC) - WRITE(*,2000) LOPC(1:J) -C - RETURN -C -C SHADING -C - 1600 CONTINUE - J=(VP(3)-A_OB)/LB_E !TOTAL BOX POINTER - J4=(VP(5)-A_OB)/LB_E !SINGLE BOX POINTER - XB(0,0)=MAX(0.,A_E(J+0)) !BOX LIMITS - XB(1,0)=MAX(0.,A_E(J+1)) - XB(0,1)=MIN(A_E(PE+WQD_XHI_E),A_E(J+2)) - XB(1,1)=MIN(A_E(PE+WQD_YHI_E),A_E(J+3)) - LOPC(1:1)='P' !POSITION - LOPC(11:13)='V[]' !SET POINT -C -C ALL SQUARES -C - J0=(VP(2)-A_OB)/LB_E !INT POINTER - DO I=0,VP(4)-1 !ALL SQUARES - IF (A_E(J0+I).GE.0.) THEN !NOT DELETED - DO I1=0,1 !GET X,Y START - XYC(I1)=A_E(J4+4+I1)+I*A_E(J4+I1) - END DO - DO I1=INT(XYC(1)),INT(XYC(1)+A_E(J4+3))-1 !ALL LINES - IF (I1.GE.XB(1,0) .AND. I1.LT.XB(1,1)) THEN !IN MAP - DO I2=INT(XYC(0)),INT(XYC(0)+A_E(J4+2))-1 !ALL POINTS - IF (I2.GE.XB(0,0) .AND. I2.LT.XB(0,1)) THEN !IN MAP - R0=MIN(1.,A_E(J0+I)) !INT. - IF (VP(1).EQ.1) THEN !REGULAR - IF (INT(R0*20.).GT.RTAB(MOD(I2,5),MOD(I1,5))) THEN !SET - WRITE (UNIT=LOPC(2:10),FMT=9000,ERR=21) I2,I1 - WRITE(*,2000) LOPC(1:13) - END IF - ELSE IF (VP(1).EQ.2) THEN !PATTERN - PATN=MIN(9,INT(10.*R0)) !PATTERN NUMBER - PATS=MOD(I1,6)*6+MOD(I2,6)+1 !PATTERN POINTER - IF (CPAT(PATN)(PATS:PATS).NE.'0') THEN !SET - WRITE (UNIT=LOPC(2:10),FMT=9000,ERR=21) I2,I1 - WRITE(*,2000) LOPC(1:13) - END IF - ELSE !RANDOM - R1=IAND(WNMRNJ()/8,255)/256. !RANDOM TEST - IF (R1.LT.R0) THEN !SET - WRITE (UNIT=LOPC(2:10),FMT=9000,ERR=21) I2,I1 - WRITE(*,2000) LOPC(1:13) - END IF - END IF - END IF - END DO - END IF - END DO - END IF - END DO -C -C READY -C - 910 CONTINUE -C - RETURN -C -C - END diff --git a/src/wng/wnqxwi.fsc b/src/wng/wnqxwi.fsc deleted file mode 100644 index d0c6b3ad890cf18d7c3b8b6e27f6ba189ec019dd..0000000000000000000000000000000000000000 --- a/src/wng/wnqxwi.fsc +++ /dev/null @@ -1,369 +0,0 @@ -C+ WNQXWI.FSC -C HJV 921222 -C -C Revisions: -C WNB 930324 Change PGVPORT (non-standard) to PGSVP -C WNB 930325 Make FSC; not implemented for DECwindows yet -C WNB 930329 Make correct gray scale -C WNB 930401 Limit PGPLOT calls -C WNB 930416 Change loop for SUN -C WNB 930510 Use WNDDIS -C CMV 931122 Flush in OPEN after changing black/white -C CMV 940822 Put output state of close in WQG_XSTAT -C - SUBROUTINE WNQXWI(TYP,ID,VP) -C -C Do device dependent actions for X-windows -C -C Result: -C -C CALL WNQXWI( TYP_J:I, ID_J:I, VP_J(*):I) X-windows -C Do action specified by TYP, using the -C area ID, and pointers/values in VP. TYP can be: -C 0: open device -C VP: - -C 1: close device -C VP: - -C 2: (header) message -C VP: 1: ptr msg; 2: length msg -C 3: polyline -C VP: 1: poly index; 2: ptr list -C 4: polyline -C VP: 2: ptr list; 3: line type -C 4: line thickness -C 5: clear screen -C VP: - -C 6: shading -C VP: 1: type; 2: int. list -C 3: ptr llhc, urhc total -C 4: N int. -C 5: dx,dy , box dx,dy, pos. -C -C Include files: -C - INCLUDE 'WNG_DEF' - INCLUDE 'WQG_DEF' !FOR WQG_XSTAT - INCLUDE 'WQD_O_DEF' !DEVICE AREA -C -C Parameters: -C - INTEGER LOPL !MAX STRING LENGTH - PARAMETER (LOPL=200) -C -C Arguments: -C - INTEGER TYP !TYPE TO DO - INTEGER ID !PTR TO AREA - INTEGER VP(*) !DATA LIST -C -C Function references: -C - REAL WNGGE !GET E VALUE - LOGICAL WNGGVM !GET MEMORY - INTEGER WNMRNJ !RANDOM J - INTEGER WNCALN !LENGTH STRING - LOGICAL WNDDIS !GET DISPLAY -C -C Data declarations: -C - REAL RBUF(10) !FOR GREXEC - DATA RBUF/10*0.0/ - REAL RBF1(4) !FOR DOTTED LINE - INTEGER NBUF - INTEGER MNIND,MXIND !ALLOWED COLOURS - INTEGER BMP !BITMAP POINTER - INTEGER I2MN,I2MX !POINTS ON LINE - REAL DX,DY !LINE LENGTH - BYTE DEFP1(4) !DEFAULT POLY INDEX - INTEGER DEFPL - EQUIVALENCE (DEFP1,DEFPL) - DATA DEFP1/1,1,1,0/ - INTEGER PB,PJ,PE !POINTERS - INTEGER XB(0:1,0:1) !SHADING BOX - REAL PX,PY !SAVED X,Y - REAL XYC(0:1) !X, Y START - CHARACTER*(LOPL) LOPC !OPEN TEXT - BYTE LOPB(LOPL) - EQUIVALENCE (LOPC,LOPB) - INTEGER PLW !PLOT LINE TYPE - BYTE PLW1(4) - EQUIVALENCE (PLW,PLW1) - INTEGER LPLW !FOR LOOP (SUN NO BYTE) - BYTE THL(0:31) - DATA THL/1,1,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20, - 1 21,22,23,24,25,26,27,28,29,30,31,32/ - BYTE IXTL(4) !LINE TYPE INFO - DATA IXTL/0,1,2,3/ - INTEGER PAT(0:2,1:3) !PATTERN: LENGTH, DOWN, UP - DATA PAT/8,4,4,4,0,4,8,6,2/ !DASH, DOT, LONG DASH -C- -C -C INIT -C - 10 CONTINUE - PB=ID-A_OB !BYTE POINTER - PJ=(ID-A_OB)/LB_J !J PTR - PE=(ID-A_OB)/LB_E !E PTR -C -C DISTRIBUTE -C -#ifndef wn_vx__ - IF (TYP.EQ.0) THEN !OPEN - GOTO 1000 - ELSE IF (TYP.EQ.1) THEN !CLOSE - GOTO 1100 - ELSE IF (TYP.EQ.2) THEN !MESSAGE - GOTO 1200 - ELSE IF (TYP.EQ.3) THEN !POLY LINE - PLW1(1)=IXTL(NINT(A_E(PE+WQD_PLIX_E+3*VP(1)))) !LINE TYPE - J=NINT(MIN(A_E(PE+WQD_MXPLS_E),A_E(PE+WQD_NMPLS_E)* - 1 A_E(PE+WQD_PLIX_E+3*VP(1)+1))) !THICKNESS - GOTO 1300 - ELSE IF (TYP.EQ.4) THEN !POLY LINE - PLW1(1)=IXTL(NINT(WNGGE(VP(3)))) !LINE TYPE - J=NINT(MIN(A_E(PE+WQD_MXPLS_E),A_E(PE+WQD_NMPLS_E)* - 1 WNGGE(VP(4)))) !THICKNESS - GOTO 1300 - ELSE IF (TYP.EQ.5) THEN !CLEAR SCREEN - CALL GREXEC(1,6,RBUF,NBUF,' ',1) !GET SIZES - RBUF(1)=RBUF(2) - RBUF(2)=RBUF(4) - NBUF=2 - CALL GREXEC(1,11,RBUF,NBUF,' ',1) !START PICTURE - GOTO 900 - ELSE IF (TYP.EQ.6) THEN !SHADING - GOTO 1600 - END IF -C - 900 CONTINUE -C - RETURN !UNKNOWN -C -C OPEN -C - 1000 CONTINUE - JS=WNDDIS(.FALSE.,LOPC) !GET DISPLAY - RBUF(2)=1 !SET OPEN - RBUF(3)=0 !CLEAR SCREEN - NBUF=3 - IF (LOPC.EQ.' ') LOPC=':0.0' !DEFAULT DEVICE - CALL GREXEC(1,9,RBUF,NBUF,LOPC,WNCALN(LOPC)) !OPEN DEVICE - IF (RBUF(2).EQ.0) CALL WNGEX !CANNOT OPEN; STOP - RBUF(1)=0 !SET 0 WHITE - RBUF(2)=1 - RBUF(3)=1 - RBUF(4)=1 - NBUF=4 - CALL GREXEC(1,21,RBUF,NBUF,' ',1) - RBUF(1)=1 !SET 1 BLACK - RBUF(2)=0 - RBUF(3)=0 - RBUF(4)=0 - NBUF=4 - CALL GREXEC(1,21,RBUF,NBUF,' ',1) - CALL GREXEC(1,6,RBUF,NBUF,' ',1) !GET SIZES - RBUF(1)=RBUF(2) - RBUF(2)=RBUF(4) - NBUF=2 - A_E(PE+WQD_XHI_E)=RBUF(1) !SAVE EXTERNAL SIZE - A_E(PE+WQD_YHI_E)=RBUF(2) - R0=MIN(RBUF(1),RBUF(2)) !SET TRANSFORM - A_E(PE+WQD_NTR_E+0)=R0 - A_E(PE+WQD_NTR_E+2)=R0 - A_E(PE+WQD_NTR_E+10)=RBUF(1) - A_E(PE+WQD_NTR_E+11)=RBUF(2) - CALL GREXEC(1,11,RBUF,NBUF,' ',1) !START PICTURE - CALL GREXEC(1,16,RBUF,NBUF,' ',1) !FLUSH - A_J(PJ+WQD_USE_J+0)=DEFPL !POLYLINE INDEX -C - RETURN -C -C CLOSE -C - 1100 CONTINUE - RBUF(1)=0 !NO SCREEN CLEAR - NBUF=1 - CALL GREXEC(1,14,RBUF,NBUF,' ',1) !END PICTURE - CALL GREXEC(1,10,RBUF,NBUF,WQG_XSTAT,I1) !CLOSE SCREEN -C - RETURN -C -C MESSAGE -C - 1200 CONTINUE - J0=MIN(VP(2),A_J(PJ+WQD_MGL_J)) !MESSAGE LENGTH - CALL WNGMTS(J0,A_B(VP(1)-A_OB),LOPC(1:)) !MESSAGE - CALL GREXEC(1,30,RBUF,NBUF,LOPC,J0) !WRITE MESSAGE - A_J(PJ+WQD_USE_J+0)=DEFPL !POLYLINE INDEX -C - RETURN -C -C POLYLINE -C - 1300 CONTINUE - PLW1(2)=THL(J) - PLW1(3)=THL(J) - PLW1(4)=0 - IF (PLW.NE.A_J(PJ+WQD_USE_J+0)) THEN !CHANGED - J2=PLW1(1) - IF ((J2.LT.0).OR.(J2.GT.3)) PLW1(1)=0 - IF ((J.LT.1).OR.(J.GT.31)) THEN - PLW1(2)=1 - PLW1(3)=1 - END IF - A_J(PJ+WQD_USE_J+0)=PLW !SAVE NEW - END IF -C -C DRAW LINES -C - J=(VP(2)-A_OB)/LB_J !J/E INPUT PTR - 20 CONTINUE !DO PIECE - J2=1 !OUTPUT POINTER - J1=A_J(J) !# OF POINTS - J=J+1 !INPUT POINTER - IF (J1.GT.0) THEN !MORE - RBUF(3)=A_E(J) !START - RBUF(4)=A_E(J+1) !Y - NBUF=4 - J1=J1-1 - J=J+2 - DO WHILE (J1.GT.0) !ALL SEGMENTS - RBUF(1)=RBUF(3) - RBUF(2)=RBUF(4) - RBUF(3)=A_E(J) - RBUF(4)=A_E(J+1) !Y - J=J+2 !NEXT POINT - PX=RBUF(3) !SAVE X,Y - PY=RBUF(4) - J1=J1-1 !COUNT - DO I=1,4 !START THICK LINES - RBUF(I)=RBUF(I)-(PLW1(2)/2) - END DO - LPLW=PLW1(2) !THICKNESS - DO I1=1,LPLW !# OF LINES - DO I=1,LPLW - IF (PLW1(1).LE.0) THEN !FULL DRAWN - CALL GREXEC(1,12,RBUF,NBUF,' ',1) !DRAW PIECE - ELSE - I2=IAND(WNMRNJ()/8,PAT(0,PLW1(1))-1) !PATTERN POSITION - DX=RBUF(3)-RBUF(1) !INCREMENT - DY=RBUF(4)-RBUF(2) - R0=SQRT(DX**2+DY**2) - IF (R0.NE.0) THEN !DRAW SOME - DX=DX/R0 - DY=DY/R0 - R0=R0+.01 - R1=0 - IF (PLW1(1).GT.0) THEN !ALL DOT - IF (I2.EQ.0) THEN - RBF1(1)=RBUF(1) !DRAW DOT - RBF1(2)=RBUF(2) - RBF1(3)=RBUF(1) - RBF1(4)=RBUF(2) - CALL GREXEC(1,12,RBF1,NBUF,' ',1) !DRAW DOT - END IF - R1=R1+SQRT(((4-I2)*DX)**2+((4-I2)*DY)**2) !NEXT POINT - DO WHILE (R1.LT.R0) - RBF1(1)=RBUF(1)+R1*DX - RBF1(2)=RBUF(2)+R1*DY - RBF1(3)=RBF1(1) - RBF1(4)=RBF1(2) - CALL GREXEC(1,12,RBF1,NBUF,' ',1) !DRAW DOT - R1=R1+SQRT(((4)*DX)**2+((4)*DY)**2) !NEXT POINT - END DO - END IF - END IF - END IF - RBUF(1)=RBUF(1)+1. - RBUF(3)=RBUF(3)+1. - END DO - RBUF(1)=RBUF(1)-LPLW - RBUF(3)=RBUF(3)-LPLW - RBUF(2)=RBUF(2)+1. - RBUF(4)=RBUF(4)+1. - END DO - RBUF(3)=PX !RESTORE END POINT - RBUF(4)=PY - END DO - J2=J2-1 - GOTO 20 !NEXT PIECE - END IF - CALL GREXEC(1,16,RBUF,NBUF,' ',1) !SHOW PIECE -C - RETURN -C -C SHADING -C - 1600 CONTINUE - J=(VP(3)-A_OB)/LB_E !TOTAL BOX POINTER - J4=(VP(5)-A_OB)/LB_E !SINGLE BOX POINTER - XB(0,0)=NINT(MAX(0.,A_E(J+0))) !BOX LIMITS - XB(1,0)=NINT(MAX(0.,A_E(J+1))) - XB(0,1)=NINT(MIN(A_E(PE+WQD_XHI_E),A_E(J+2))) - XB(1,1)=NINT(MIN(A_E(PE+WQD_YHI_E),A_E(J+3))) - CALL GREXEC(1,2,RBUF,NBUF,' ',1) !GET COLOUR RANGE - MNIND=NINT(RBUF(5)) !MIN. INDEX - MXIND=NINT(RBUF(6)) - MNIND=MAX(17,MXIND-127) !SELECT INDICES - NBUF=4 - DO I=MNIND,MXIND !SET SHADES - RBUF(1)=I - RBUF(2)=REAL(I-MNIND)/REAL(MXIND-MNIND) - RBUF(3)=RBUF(2) - RBUF(4)=RBUF(2) - NBUF=4 - CALL GREXEC(1,21,RBUF,NBUF,' ',1) - END DO - IF (.NOT.WNGGVM(NINT(A_E(PE+WQD_XHI_E)*LB_E+4*LB_E),BMP)) - 1 GOTO 900 !GET BITMAP LINE - I3=(BMP-A_OB)/LB_E !BUFFER POINTER -C -C ALL SQUARES -C - J0=(VP(2)-A_OB)/LB_E !INT POINTER - DO I=0,VP(4)-1 !ALL SQUARES - IF (A_E(J0+I).GE.0.) THEN !NOT DELETED - DO I1=0,1 !GET X,Y START - XYC(I1)=A_E(J4+4+I1)+I*A_E(J4+I1) - END DO - DO I1=NINT(XYC(1)),NINT(XYC(1)+A_E(J4+3))-1 !ALL LINES - IF (I1.GE.XB(1,0) .AND. I1.LT.XB(1,1)) THEN !IN MAP - I2MN=1E6 - I2MX=0 - DO I2=NINT(XYC(0)),NINT(XYC(0)+A_E(J4+2))-1 !ALL POINTS - IF (I2.GE.XB(0,0) .AND. I2.LT.XB(0,1)) THEN !IN MAP - R0=MIN(1.,A_E(J0+I)) !INT. - IF (VP(1).EQ.1) THEN !REGULAR - R0=1.-((R0*20.)/20.) - ELSE IF (VP(1).EQ.2) THEN !PATTERN - R0=1.-((R0*10.)/10.) - ELSE !RANDOM - R0=1.-R0 !CONTIN. - END IF - A_E(I3+2+I2)=MNIND+(MXIND-MNIND)*R0 !NORM. - I2MN=MIN(I2,I2MN) - I2MX=MAX(I2,I2MX) - END IF - END DO - IF (I2MN.LE.I2MX) THEN !SOME POINTS - A_E(I3+I2MN-2)=I2MN !X - A_E(I3+I2MN-1)=I1 !Y - NBUF=I2MX-I2MN+3 - CALL GREXEC(1,26,A_E(I3+I2MN-2),NBUF,' ',1) - END IF - END IF - END DO - END IF - END DO - CALL GREXEC(1,16,RBUF,NBUF,' ',1) !SHOW PIECE - CALL WNGFVM(NINT(A_E(PE+WQD_XHI_E)*LB_E+4*LB_E),BMP) -#endif -C -C READY -C - 910 CONTINUE -C - RETURN -C -C - END diff --git a/src/wng/wnt.def b/src/wng/wnt.def deleted file mode 100644 index 7298b4b7558e8ffec211bc72412912fc799b4ac4..0000000000000000000000000000000000000000 --- a/src/wng/wnt.def +++ /dev/null @@ -1,328 +0,0 @@ -C+ Created from wnt.dsc on 970828 at 17:01:48 at daw18 -C WNT.DEF -C WNB 970828 -C -C Revisions: -C -C WNB 931216 New edit default for D/E unformatted items -C WNB 930902 Make 32 array indices, 64 field length -C WNB 930801 Original version -C -C -C Result: -C -C WNT.DSC describes the include files (WNT_O.DEF[.inc], -C WNT.DEF [.inc]) for the WNTINC program. -C Most WNTI* routines need: -C INCLUDE 'WNT_O_DEF' and -C INCLUDE 'WNT_DEF' -C -C -C Data declarations: -C - CHARACTER*9 P__TXT(1:20) ! Known (%) parameters - DATA P__TXT /'NAME ','DATE ', - 1 'USER ','VERSION ','SYSTEM ', - 1 'LIST ','NOLIST ','INSERT ', - 1 'LOCAL ','GLOBAL ','INCLUDE ', - 1 'REVISION ','COMMENT ','FORTRAN ', - 1 'CC ','PRINT ','NOPRINT ', - 1 'ALIGN ','NOALIGN ',' '/ - CHARACTER*10 PN__TXT(1:12) ! Known (.) names - DATA PN__TXT /'DEFINE ','BEGIN ', - 1 'END ','PARAMETER ','DATA ', - 1 'COMMON ','OFFSET ','STRUCTURE ', - 1 'ALIGN ','MAP ','UNION ', - 1 ' '/ - CHARACTER*1 CD1(1:12) ! Letter codes for all - DATA CD1 /'B ','C ','L ','I ', ! T_ data types - 1 'J ','K ','E ','D ','X ', - 1 'Y ','A ','S '/ - INTEGER CD2(1:12) ! Length for all - DATA CD2 /1,1,4,2,4,4,4,8,8,16, ! T_ data types - 1 2,1/ - CHARACTER*17 CD(1:12) ! Code for all T_ - DATA CD /'BYTE ','CHARACTER ', ! data types - 1 'LOGICAL ','INTEGER*2 ', ! in Fortran - 1 'INTEGER ','INTEGER*4 ', - 1 'REAL ','DOUBLE PRECISION ', - 1 'COMPLEX ','DOUBLE COMPLEX ', - 1 'CHARACTER ','BYTE '/ - CHARACTER*13 UD(1:12) ! Code for all T_ - DATA UD /'char ','char ','unsigned int ', ! data types - 1 'short ','int ','long int ', ! in C - 1 'float ','double ','float ', - 1 'double ','char ','struct '/ - INTEGER TCD(1:12) ! Translation types - DATA TCD /9,1,3,2,3,3,4,5,14, ! for all T_ data types - 1 15,2,10/ - CHARACTER*10 ECD(1:12) ! Default edit types for - DATA ECD /'UB ','AL ','LL ','SI ', ! all T_ types - 1 'SJ ','SK ','E12.6 ','D12.8 ', - 1 'EC12.6 ','DC12.8 ','AL ', - 1 'UB '/ -C -C WNT common data: -C - INTEGER DEP ! Structure depth - LOGICAL LSTON ! List lines in log - LOGICAL PRTON ! Print comments - LOGICAL ALGON ! Align data - INTEGER CATP ! Current area type - INTEGER CALN ! Line were current area defined - INTEGER CBTP ! Current block type - INTEGER COFF ! Current offset - INTEGER CALEN ! Current structure align length - LOGICAL DEFSN ! .DEFINE seen - LOGICAL BEGSN ! .BEGIN (=.STRUCT) seen - LOGICAL PARSN ! .PARAMETER seen - LOGICAL CINSN ! .COMMIN initialisation seen - INTEGER UNID ! Counter for unique name - CHARACTER*160 OINFIL ! Original input file - CHARACTER*160 INFIL ! Current input file - CHARACTER*8 PARM(1:5) ! Program parameters - BYTE IBDES(0:23) ! Input lines - BYTE IBDES_B(0:23) - EQUIVALENCE (IBDES,IBDES_B) - LOGICAL IBDES_L(0:5) - EQUIVALENCE (IBDES,IBDES_L) - INTEGER*2 IBDES_I(0:11) - EQUIVALENCE (IBDES,IBDES_I) - INTEGER IBDES_J(0:5) - EQUIVALENCE (IBDES,IBDES_J) - INTEGER*4 IBDES_K(0:5) - EQUIVALENCE (IBDES,IBDES_K) - REAL IBDES_E(0:5) - EQUIVALENCE (IBDES,IBDES_E) - DOUBLE PRECISION IBDES_D(0:2) - EQUIVALENCE (IBDES,IBDES_D) - COMPLEX IBDES_X(0:2) - EQUIVALENCE (IBDES,IBDES_X) - CHARACTER*(24) IBDES_C - EQUIVALENCE (IBDES,IBDES_C) - BYTE CBDES(0:23) ! Comment on lines - BYTE CBDES_B(0:23) - EQUIVALENCE (CBDES,CBDES_B) - LOGICAL CBDES_L(0:5) - EQUIVALENCE (CBDES,CBDES_L) - INTEGER*2 CBDES_I(0:11) - EQUIVALENCE (CBDES,CBDES_I) - INTEGER CBDES_J(0:5) - EQUIVALENCE (CBDES,CBDES_J) - INTEGER*4 CBDES_K(0:5) - EQUIVALENCE (CBDES,CBDES_K) - REAL CBDES_E(0:5) - EQUIVALENCE (CBDES,CBDES_E) - DOUBLE PRECISION CBDES_D(0:2) - EQUIVALENCE (CBDES,CBDES_D) - COMPLEX CBDES_X(0:2) - EQUIVALENCE (CBDES,CBDES_X) - CHARACTER*(24) CBDES_C - EQUIVALENCE (CBDES,CBDES_C) - BYTE VBDES(0:23) ! Global/local values - BYTE VBDES_B(0:23) - EQUIVALENCE (VBDES,VBDES_B) - LOGICAL VBDES_L(0:5) - EQUIVALENCE (VBDES,VBDES_L) - INTEGER*2 VBDES_I(0:11) - EQUIVALENCE (VBDES,VBDES_I) - INTEGER VBDES_J(0:5) - EQUIVALENCE (VBDES,VBDES_J) - INTEGER*4 VBDES_K(0:5) - EQUIVALENCE (VBDES,VBDES_K) - REAL VBDES_E(0:5) - EQUIVALENCE (VBDES,VBDES_E) - DOUBLE PRECISION VBDES_D(0:2) - EQUIVALENCE (VBDES,VBDES_D) - COMPLEX VBDES_X(0:2) - EQUIVALENCE (VBDES,VBDES_X) - CHARACTER*(24) VBDES_C - EQUIVALENCE (VBDES,VBDES_C) - BYTE RBDES(0:23) ! %REVISION data - BYTE RBDES_B(0:23) - EQUIVALENCE (RBDES,RBDES_B) - LOGICAL RBDES_L(0:5) - EQUIVALENCE (RBDES,RBDES_L) - INTEGER*2 RBDES_I(0:11) - EQUIVALENCE (RBDES,RBDES_I) - INTEGER RBDES_J(0:5) - EQUIVALENCE (RBDES,RBDES_J) - INTEGER*4 RBDES_K(0:5) - EQUIVALENCE (RBDES,RBDES_K) - REAL RBDES_E(0:5) - EQUIVALENCE (RBDES,RBDES_E) - DOUBLE PRECISION RBDES_D(0:2) - EQUIVALENCE (RBDES,RBDES_D) - COMPLEX RBDES_X(0:2) - EQUIVALENCE (RBDES,RBDES_X) - CHARACTER*(24) RBDES_C - EQUIVALENCE (RBDES,RBDES_C) - BYTE CMDES(0:23) ! %COMMENT data - BYTE CMDES_B(0:23) - EQUIVALENCE (CMDES,CMDES_B) - LOGICAL CMDES_L(0:5) - EQUIVALENCE (CMDES,CMDES_L) - INTEGER*2 CMDES_I(0:11) - EQUIVALENCE (CMDES,CMDES_I) - INTEGER CMDES_J(0:5) - EQUIVALENCE (CMDES,CMDES_J) - INTEGER*4 CMDES_K(0:5) - EQUIVALENCE (CMDES,CMDES_K) - REAL CMDES_E(0:5) - EQUIVALENCE (CMDES,CMDES_E) - DOUBLE PRECISION CMDES_D(0:2) - EQUIVALENCE (CMDES,CMDES_D) - COMPLEX CMDES_X(0:2) - EQUIVALENCE (CMDES,CMDES_X) - CHARACTER*(24) CMDES_C - EQUIVALENCE (CMDES,CMDES_C) - BYTE FMDES(0:23) ! %FORTRAN data - BYTE FMDES_B(0:23) - EQUIVALENCE (FMDES,FMDES_B) - LOGICAL FMDES_L(0:5) - EQUIVALENCE (FMDES,FMDES_L) - INTEGER*2 FMDES_I(0:11) - EQUIVALENCE (FMDES,FMDES_I) - INTEGER FMDES_J(0:5) - EQUIVALENCE (FMDES,FMDES_J) - INTEGER*4 FMDES_K(0:5) - EQUIVALENCE (FMDES,FMDES_K) - REAL FMDES_E(0:5) - EQUIVALENCE (FMDES,FMDES_E) - DOUBLE PRECISION FMDES_D(0:2) - EQUIVALENCE (FMDES,FMDES_D) - COMPLEX FMDES_X(0:2) - EQUIVALENCE (FMDES,FMDES_X) - CHARACTER*(24) FMDES_C - EQUIVALENCE (FMDES,FMDES_C) - BYTE CCDES(0:23) ! %CC data - BYTE CCDES_B(0:23) - EQUIVALENCE (CCDES,CCDES_B) - LOGICAL CCDES_L(0:5) - EQUIVALENCE (CCDES,CCDES_L) - INTEGER*2 CCDES_I(0:11) - EQUIVALENCE (CCDES,CCDES_I) - INTEGER CCDES_J(0:5) - EQUIVALENCE (CCDES,CCDES_J) - INTEGER*4 CCDES_K(0:5) - EQUIVALENCE (CCDES,CCDES_K) - REAL CCDES_E(0:5) - EQUIVALENCE (CCDES,CCDES_E) - DOUBLE PRECISION CCDES_D(0:2) - EQUIVALENCE (CCDES,CCDES_D) - COMPLEX CCDES_X(0:2) - EQUIVALENCE (CCDES,CCDES_X) - CHARACTER*(24) CCDES_C - EQUIVALENCE (CCDES,CCDES_C) - BYTE FEDES(0:23) ! Embedded %FORTRAN data - BYTE FEDES_B(0:23) - EQUIVALENCE (FEDES,FEDES_B) - LOGICAL FEDES_L(0:5) - EQUIVALENCE (FEDES,FEDES_L) - INTEGER*2 FEDES_I(0:11) - EQUIVALENCE (FEDES,FEDES_I) - INTEGER FEDES_J(0:5) - EQUIVALENCE (FEDES,FEDES_J) - INTEGER*4 FEDES_K(0:5) - EQUIVALENCE (FEDES,FEDES_K) - REAL FEDES_E(0:5) - EQUIVALENCE (FEDES,FEDES_E) - DOUBLE PRECISION FEDES_D(0:2) - EQUIVALENCE (FEDES,FEDES_D) - COMPLEX FEDES_X(0:2) - EQUIVALENCE (FEDES,FEDES_X) - CHARACTER*(24) FEDES_C - EQUIVALENCE (FEDES,FEDES_C) - BYTE CEDES(0:23) ! Embedded %CC data - BYTE CEDES_B(0:23) - EQUIVALENCE (CEDES,CEDES_B) - LOGICAL CEDES_L(0:5) - EQUIVALENCE (CEDES,CEDES_L) - INTEGER*2 CEDES_I(0:11) - EQUIVALENCE (CEDES,CEDES_I) - INTEGER CEDES_J(0:5) - EQUIVALENCE (CEDES,CEDES_J) - INTEGER*4 CEDES_K(0:5) - EQUIVALENCE (CEDES,CEDES_K) - REAL CEDES_E(0:5) - EQUIVALENCE (CEDES,CEDES_E) - DOUBLE PRECISION CEDES_D(0:2) - EQUIVALENCE (CEDES,CEDES_D) - COMPLEX CEDES_X(0:2) - EQUIVALENCE (CEDES,CEDES_X) - CHARACTER*(24) CEDES_C - EQUIVALENCE (CEDES,CEDES_C) - BYTE XFDES(0:23) ! Formatted data - BYTE XFDES_B(0:23) - EQUIVALENCE (XFDES,XFDES_B) - LOGICAL XFDES_L(0:5) - EQUIVALENCE (XFDES,XFDES_L) - INTEGER*2 XFDES_I(0:11) - EQUIVALENCE (XFDES,XFDES_I) - INTEGER XFDES_J(0:5) - EQUIVALENCE (XFDES,XFDES_J) - INTEGER*4 XFDES_K(0:5) - EQUIVALENCE (XFDES,XFDES_K) - REAL XFDES_E(0:5) - EQUIVALENCE (XFDES,XFDES_E) - DOUBLE PRECISION XFDES_D(0:2) - EQUIVALENCE (XFDES,XFDES_D) - COMPLEX XFDES_X(0:2) - EQUIVALENCE (XFDES,XFDES_X) - CHARACTER*(24) XFDES_C - EQUIVALENCE (XFDES,XFDES_C) - BYTE DFDES(0:23) ! Initialisation data - BYTE DFDES_B(0:23) - EQUIVALENCE (DFDES,DFDES_B) - LOGICAL DFDES_L(0:5) - EQUIVALENCE (DFDES,DFDES_L) - INTEGER*2 DFDES_I(0:11) - EQUIVALENCE (DFDES,DFDES_I) - INTEGER DFDES_J(0:5) - EQUIVALENCE (DFDES,DFDES_J) - INTEGER*4 DFDES_K(0:5) - EQUIVALENCE (DFDES,DFDES_K) - REAL DFDES_E(0:5) - EQUIVALENCE (DFDES,DFDES_E) - DOUBLE PRECISION DFDES_D(0:2) - EQUIVALENCE (DFDES,DFDES_D) - COMPLEX DFDES_X(0:2) - EQUIVALENCE (DFDES,DFDES_X) - CHARACTER*(24) DFDES_C - EQUIVALENCE (DFDES,DFDES_C) - BYTE EFDES(0:23) ! Edit data - BYTE EFDES_B(0:23) - EQUIVALENCE (EFDES,EFDES_B) - LOGICAL EFDES_L(0:5) - EQUIVALENCE (EFDES,EFDES_L) - INTEGER*2 EFDES_I(0:11) - EQUIVALENCE (EFDES,EFDES_I) - INTEGER EFDES_J(0:5) - EQUIVALENCE (EFDES,EFDES_J) - INTEGER*4 EFDES_K(0:5) - EQUIVALENCE (EFDES,EFDES_K) - REAL EFDES_E(0:5) - EQUIVALENCE (EFDES,EFDES_E) - DOUBLE PRECISION EFDES_D(0:2) - EQUIVALENCE (EFDES,EFDES_D) - COMPLEX EFDES_X(0:2) - EQUIVALENCE (EFDES,EFDES_X) - CHARACTER*(24) EFDES_C - EQUIVALENCE (EFDES,EFDES_C) -C -C WNT common block: -C - COMMON /WNT_COM/ DEP,LSTON,PRTON, - 1 ALGON,CATP,CALN,CBTP, - 1 COFF,CALEN,DEFSN, - 1 BEGSN,PARSN,CINSN, - 1 UNID,OINFIL,INFIL, - 1 PARM,IBDES,CBDES, - 1 VBDES,RBDES,CMDES, - 1 FMDES,CCDES,FEDES, - 1 CEDES,XFDES,DFDES, - 1 EFDES -C -C Given statements: -C -C- diff --git a/src/wng/wnt.dsc b/src/wng/wnt.dsc deleted file mode 100644 index c6b9b7179192127b147408ba346a760820cffa08..0000000000000000000000000000000000000000 --- a/src/wng/wnt.dsc +++ /dev/null @@ -1,200 +0,0 @@ -!+ WNT.DSC -! WNB 930801 -! -! Revisions: -! -%REVISION=WNB=931216="New edit default for D/E unformatted items" -%REVISION=WNB=930902="Make 32 array indices, 64 field length" -%REVISION=WNB=930801="Original version" -! -! Description: -! -%COMMENT="WNT.DSC describes the include files (WNT_O.DEF[.inc]," -%COMMENT=" WNT.DEF [.inc]) for the WNTINC program." -%COMMENT=" Most WNTI* routines need:" -%COMMENT=" INCLUDE 'WNT_O_DEF' and" -%COMMENT=" INCLUDE 'WNT_DEF'" -! -! Standard data -! -%VERSION=1 !Version -%SYSTEM=1 !System version -%USER=WNB !Author -%%DATE !Date of compilation -%%NAME !Name of files -! -%ALIGN !Align structures and common blocks -! -! Program parameters -! -.PARAMETER -! -! Program variable sizes -! - MXDINC J /8/ !Max. include depth - MXSLIN J /132/ !Single line length - MXTLIN J /4096/ !Composite max. line length -%GLOBAL=MXLPAR=8 !Length % parameter values -%GLOBAL=MXLNAM=64 !Max. length name/value fields -%GLOBAL=MXNARR=32 !Max. # of array indices - COMPOS J /42/ !Comment position -! -! Type indicators -! - AT A: /DEFINE,BEGIN/ !Data area types - BT A: /PARAM,DATA,SDATA, \ !Data block types - COMMON,BEGIN,EBGIN,DEFINE, \ - EDFINE,MAP,EMP,DCMMON/ - FT A:(-1) /CONTIN,NULL,DATA,BEGIN, \ !Format block types - DEFINE,END,MAP,DCMMON/ - OP A: /LB,PL,MI,MU,DV,SP,SM/ !Operators: - !LBracket PLus - !MInus MUltiply - !DIvide SinglePlus - !SingleMinus -! -! Data structures -! -.STRUCTURE=WNTB !General buffer administration - .PARAMETER - INCCNT J /16/ !Start # of entities to allocate - .DATA - CCNT J !Current # allocated - CNT J !Current # filled - ELEN J !Length data element (bytes) - BPTR J !Pointer to start data (A_B) - JPTR J !Pointer to start data (A_J) - .ALIGN=8 -.END !WNTB -! -.STRUCTURE=WNTI !Input line definition - FTYP J !Format type - LCOM J !Length comment (or 0) - PCOM J !Pointer to comment block - PFOR J !Pointer to format block - .ALIGN=8 -.END !WNTI -! -.STRUCTURE=WNTV !Local/global value - NAM C16 !Variable name - TYP J !Type: - !+: local -: global - !1: integer 2: string - VAL J !Value - STR C64 !Value as string - .ALIGN=8 -.END !WNTV -! -.STRUCTURE=WNTF !Format data block - BTYP J !Block type (BT_) - ALEN J !Align length - DTP J !Data type (T_) - ULEN J !Length one unit (bytes) - SLEN J !String length - DIM J !# of dimensions - REFP J !Pointer to reference line - NINI J !# of initialisation values - INIP J !Pointer to first init. value - EDIP J !Edit information pointer - TLEN J !Total length (entities) entry - OFF J !Offset of this entry - ENT J !Pointer to input line entry - SREF J !Pointer to structure definition - IND J(0:1,0:MXNARR-1) !Low bound, length array index - NAM C(MXLNAM) !Name of variable - .ALIGN=8 -.END !WNTF -! -.STRUCTURE=WNTD !Data initialisation information - REP J !Repetition factor - STR C36 !Initialisation information - .ALIGN=8 -.END !WNTD -! -.STRUCTURE=WNTE !Edit data - EDIT J !Edit allowed (0) - PAT C12 !I/O format pattern - UNIT C12 !Units - SPEC C12 !Special information - .ALIGN=8 -.END !WNTD -! -! Variables -! -.DEFINE - .DATA -! -! Known names -! - P A: /NAME,DATE,USER,VERSION, \ !Known (%) parameters - SYSTEM,LIST,NOLIST,INSERT, \ - LOCAL,GLOBAL,INCLUDE,REVISION, \ - COMMENT,FORTRAN,CC,PRINT, \ - NOPRINT,ALIGN,NOALIGN/ -%LOCAL=P_SYS=5 !Position in P_ list - PN A: /DEFINE,BEGIN,END,PARAMETER, \ !Known (.) names - DATA,COMMON,OFFSET,STRUCTURE, \ - ALIGN,MAP,UNION/ -! -! Data type information -! - CD1 C1(T__N-1) /B,C,L,I,J,K,E,D,X,Y,A,S/ !Letter codes for all - ! T_ data types - CD2 J(T__N-1) /LB_B,LB_C,LB_L,LB_I, \ !Length for all - LB_J,LB_K,LB_E,LB_D, \ ! T_ data types - LB_X,LB_Y,LB_A,LB_S/ - CD C*(T__N-1) /BYTE,CHARACTER, \ !Code for all T_ - LOGICAL,"INTEGER*2", \ ! data types - INTEGER,"INTEGER*4", \ ! in Fortran - REAL,"DOUBLE PRECISION", \ - COMPLEX,"DOUBLE COMPLEX", \ - CHARACTER,BYTE/ - UD C*(T__N-1) /"char","char", \ !Code for all T_ - "unsigned int","short", \ ! data types - "int","long int", \ ! in C - "float","double", \ - "float","double", \ - "char","struct"/ - TCD J(T__N-1) /9,1,3,2,3,3,4,5,14,15,2,10/ !Translation types - ! for all T_ data types - ECD C10(T__N-1) /UB,AL,LL,SI,SJ,SK, \ !Default edit types for - E12.6,D12.8, \ ! all T_ types - EC12.6,DC12.8,AL,UB/ -! -! Common block -! - .COMMON - DEP J !Structure depth - LSTON L !List lines in log - PRTON L !Print comments - ALGON L !Align data - CATP J !Current area type - CALN J !Line were current area defined - CBTP J !Current block type - COFF J !Current offset - CALEN J !Current structure align length - DEFSN L !.DEFINE seen - BEGSN L !.BEGIN (=.STRUCT) seen - PARSN L !.PARAMETER seen - CINSN L !.COMMIN initialisation seen - UNID J !Counter for unique name - OINFIL C160 !Original input file - INFIL C160 !Current input file - PARM C(MXLPAR)(P_SYS) !Program parameters -! -! Buffer descriptors -! - IBDES S:WNTB !Input lines - CBDES S:WNTB !Comment on lines - VBDES S:WNTB !Global/local values - RBDES S:WNTB !%REVISION data - CMDES S:WNTB !%COMMENT data - FMDES S:WNTB !%FORTRAN data - CCDES S:WNTB !%CC data - FEDES S:WNTB !Embedded %FORTRAN data - CEDES S:WNTB !Embedded %CC data - XFDES S:WNTB !Formatted data - DFDES S:WNTB !Initialisation data - EFDES S:WNTB !Edit data -! -.END !DEFINE diff --git a/src/wng/wnt.grp b/src/wng/wnt.grp deleted file mode 100644 index 119a91b556c721e79753ae8eb0204da5d5e3c512..0000000000000000000000000000000000000000 --- a/src/wng/wnt.grp +++ /dev/null @@ -1,73 +0,0 @@ -!+ WNT.GRP -! WNB 890427 -! -! Revisions: -! WNB 921113 Add -NS to WNTAB.EXE -! WNB 930802 Add WNTINC, remove WNTAB -! CMV 940822 Add module WNTTCH to WNTTIL -! -! Conversion of .DSC files into usable files -! -! Group definition: -! -WNT.GRP -! -! Text files -! -WNTINC.TXT !Explanation of WNTINC program -! -! Structure files -! -WNT.DSC !For WNTINC -! -! General command files -! -! -! Fortran definition files: -! -! -! Programs: -! -WNTINC.FOR !WNTINC Main routine -! -WNTIAF.FOR !WNTIAF Analyse data format line -WNTIAN.FOR !WNTIAN Analyse .name line -WNTIAP.FOR !WNTIAP Analyse %name line -WNTIA0.FOR !WNTIA0 Analyse input array definition -WNTIA1.FOR !WNTIA1 Create fill format data -WNTIBP.FOR !WNTIBP Put data in a memory buffer - !WNTIBW (Re-)write data in a memory buffer - !WNTIBR Read data from memory buffer -WNTIOL.FOR !WNTIOL Output a log -WNTIOS.FOR !WNTIOS Output all produced files -WNTIO0.FOR !WNTIO0 Make array index string from format -WNTIO1.FOR !WNTIO1 Get full name for format data -WNTIO2.FOR !WNTIO2 Output a data line from format data - !WNTIO3 Output data line with initialisation - !WNTIO4 Output a comment line -WNTIO5.FOR !WNTIO5 Obtain comment attached to line -WNTIO6.FOR !WNTIO6 Output data line with comment - !WNTIO7 Output any remaining hanging comments -WNTIRL.FOR !WNTIRL Read an input line -WNTIV0.FOR !WNTIV0 Unroll stack for binary operators - !WNTIV1 Unroll stack for unary operators -WNTIV9.FOR !WNTIV9 Set unary operator on stack - !WNTIV8 Set binary operator on stack -WNTIVG.FOR !WNTIVG Get a value from a string field -WNTIVP.FOR !WNTIVP Put a value in a local variable -WNTIVS.FOR !WNTIVS Set an integer value in a variable -! -WNTTIL.FOR !WNTTIL Translate IBM to local format - !WNTTLI Translate local to IBM format - !WNTTLD Translate local to DEC format - !WNTTDL Translate DEC to local format - !WNTTLT Translate local to typed format - !WNTTTL Translate typed to local format - !WNTTTT Translate typed to typed format - !WNTTCH Check if translation should be made -WNTTSG.FOR !WNTTSG Translate sub-group name to string -! -! Executables -! -WNTINC.EXE -NS ! Conversion program -!- diff --git a/src/wng/wnt.inc b/src/wng/wnt.inc deleted file mode 100644 index d383bd8139a9e3293d01cc16caed1c529deb6cba..0000000000000000000000000000000000000000 --- a/src/wng/wnt.inc +++ /dev/null @@ -1,101 +0,0 @@ -/*+ Created from wnt.dsc on 970828 at 17:01:48 at daw18 -.. WNT.INC -.. WNB 970828 -.. -.. Revisions: -.. -.. WNB 931216 New edit default for D/E unformatted items -.. WNB 930902 Make 32 array indices, 64 field length -.. WNB 930801 Original version -.. */ -/* -.. Result: -.. -.. WNT.DSC describes the include files (WNT_O.DEF[.inc], -.. WNT.DEF [.inc]) for the WNTINC program. -.. Most WNTI* routines need: -.. INCLUDE 'WNT_O_DEF' and -.. INCLUDE 'WNT_DEF' -.. */ -/* -.. Data declarations: -.. */ - static char p__txt[20][9] = {"NAME ", /* Known (%) parameters */ - "DATE ","USER ","VERSION ", - "SYSTEM ","LIST ","NOLIST ", - "INSERT ","LOCAL ","GLOBAL ", - "INCLUDE ","REVISION ","COMMENT ", - "FORTRAN ","CC ","PRINT ", - "NOPRINT ","ALIGN ","NOALIGN ", - " "}; - static char pn__txt[12][10] = { /* Known (.) names */ - "DEFINE ","BEGIN ","END ", - "PARAMETER ","DATA ","COMMON ", - "OFFSET ","STRUCTURE ","ALIGN ", - "MAP ","UNION "," "}; - static char cd1[12][1] = {"B ", /* Letter codes for all */ - "C ","L ","I ","J ","K ", /* T_ data types */ - "E ","D ","X ","Y ","A ", - "S "}; - static int cd2[12] = {1,1,4,2,4, /* Length for all */ - 4,4,8,8,16,2,1}; /* T_ data types */ - static char cd[12][17] = {"BYTE ", /* Code for all T_ */ - "CHARACTER ","LOGICAL ", /* data types */ - "INTEGER*2 ","INTEGER ", /* in Fortran */ - "INTEGER*4 ","REAL ","DOUBLE PRECISION ", - "COMPLEX ","DOUBLE COMPLEX ", - "CHARACTER ","BYTE "}; - static char ud[12][13] = {"char ", /* Code for all T_ */ - "char ","unsigned int ", /* data types */ - "short ","int ","long int ", /* in C */ - "float ","double ","float ", - "double ","char ","struct "}; - static int tcd[12] = {9,1,3,2,3, /* Translation types */ - 3,4,5,14,15,2,10}; /* for all T_ data types */ - static char ecd[12][10] = {"UB ", /* Default edit types for */ - "AL ","LL ","SI ","SJ ", /* all T_ types */ - "SK ","E12.6 ","D12.8 ", - "EC12.6 ","DC12.8 ","AL ", - "UB "}; -/* -.. WNT common data: -.. */ -struct wnt_com { - int dep; /* Structure depth */ - unsigned int lston; /* List lines in log */ - unsigned int prton; /* Print comments */ - unsigned int algon; /* Align data */ - int catp; /* Current area type */ - int caln; /* Line were current area defined */ - int cbtp; /* Current block type */ - int coff; /* Current offset */ - int calen; /* Current structure align length */ - unsigned int defsn; /* .DEFINE seen */ - unsigned int begsn; /* .BEGIN (=.STRUCT) seen */ - unsigned int parsn; /* .PARAMETER seen */ - unsigned int cinsn; /* .COMMIN initialisation seen */ - int unid; /* Counter for unique name */ - char oinfil[160]; /* Original input file */ - char infil[160]; /* Current input file */ - char parm[5][8]; /* Program parameters */ - struct wntb ibdes; /* Input lines */ - struct wntb cbdes; /* Comment on lines */ - struct wntb vbdes; /* Global/local values */ - struct wntb rbdes; /* %REVISION data */ - struct wntb cmdes; /* %COMMENT data */ - struct wntb fmdes; /* %FORTRAN data */ - struct wntb ccdes; /* %CC data */ - struct wntb fedes; /* Embedded %FORTRAN data */ - struct wntb cedes; /* Embedded %CC data */ - struct wntb xfdes; /* Formatted data */ - struct wntb dfdes; /* Initialisation data */ - struct wntb efdes; /* Edit data */ -}; -/* -.. WNT common block: -.. */ -extern struct wnt_com wnt_com_ ; -/* -.. Given statements: -.. */ -/*- */ diff --git a/src/wng/wnt_boot.grp b/src/wng/wnt_boot.grp deleted file mode 100644 index 21f0b1f4ee1d7ab686c49fc929d1007655903984..0000000000000000000000000000000000000000 --- a/src/wng/wnt_boot.grp +++ /dev/null @@ -1,81 +0,0 @@ -!+ WNT_BOOT.GRP -! CMV 05/07/93 -! -! Revisions: -! CMV 930705 Created -! CMV 930922 Adapted for WNTINC -! CMV 940216 Add -NC switch to prevent dependency checks -! -! These files are needed to build wng.grp, wnc.grp, wnf.grp and wnt.grp -! Once wnt.grp has been built, the wntinc compiler is available to -! process the other .dsc files. -! -! -! Group definition: -! -wnt_boot.grp -! -! Include files -! -wnt.def -NC -wnt.inc -NC -wnt_e.def -NC -wnt_e.inc -NC -wnt_o.def -NC -wnt_o.inc -NC -wnt_t.def -NC -wnt_t.inc -NC -! -wnc.def -NC -wnc.inc -NC -! -wnd.def -NC -wnd.inc -NC -! -wng.def -NC -wng.inc -NC -! -wxh.def -NC -wxh.inc -NC -! -fbc_e.def -NC -fbc_o.def -NC -fbc_t.def -NC -fbc_e.inc -NC -fbc_o.inc -NC -fbc_t.inc -NC -! -fca_e.def -NC -fca_o.def -NC -fca_t.def -NC -fca_e.inc -NC -fca_o.inc -NC -fca_t.inc -NC -! -fcq.def -NC -fcq.def -NC -fcq.inc -NC -fcq.inc -NC -! -fel_e.def -NC -fel_o.def -NC -fel_t.def -NC -fel_e.inc -NC -fel_o.inc -NC -fel_t.inc -NC -! -mca_e.def -NC -mca_o.def -NC -mca_t.def -NC -mca_e.inc -NC -mca_o.inc -NC -mca_t.inc -NC -! -! Block data definitions -! -fcq_bd.for -NC -fcq_bd.for -NC -! -wnc_bd.for -NC -wxh_bd.for -NC -!- diff --git a/src/wng/wnt_e.def b/src/wng/wnt_e.def deleted file mode 100644 index e4e827e9dddbb97152b034989ba9918f5186ce52..0000000000000000000000000000000000000000 --- a/src/wng/wnt_e.def +++ /dev/null @@ -1,216 +0,0 @@ -C+ Created from wnt.dsc on 970828 at 17:01:51 at daw18 -C WNT_E.DEF -C WNB 970828 -C -C Revisions: -C -C WNB 931216 New edit default for D/E unformatted items -C WNB 930902 Make 32 array indices, 64 field length -C WNB 930801 Original version -C -C -C Result: -C -C WNT.DSC describes the include files (WNT_O.DEF[.inc], -C WNT.DEF [.inc]) for the WNTINC program. -C Most WNTI* routines need: -C INCLUDE 'WNT_O_DEF' and -C INCLUDE 'WNT_DEF' -C -C -C Specification of edit tables: -C -C The character (_EC) table contains: -C fieldname, pattern, units, special code -C The integer (_EJ) table contains: -C offset, #of values, edit (0=allowed), unit length -C -C -C WNTB edit definitions: -C - INTEGER WNTBEDL,WNTB__EL - PARAMETER ( WNTBEDL=5, ! Length table - 1 WNTB__EL=5) - CHARACTER*12 WNTB_EC(4,5) - INTEGER WNTB_EJ(4,5) - DATA WNTB_EC(1,1),WNTB_EC(2,1),WNTB_EC(3,1),WNTB_EC(4,1) - 1 /'CCNT','SJ',' ',' '/ - DATA WNTB_EJ(1,1),WNTB_EJ(2,1),WNTB_EJ(3,1),WNTB_EJ(4,1) - 1 /0,1,0,4/ - DATA WNTB_EC(1,2),WNTB_EC(2,2),WNTB_EC(3,2),WNTB_EC(4,2) - 1 /'CNT','SJ',' ',' '/ - DATA WNTB_EJ(1,2),WNTB_EJ(2,2),WNTB_EJ(3,2),WNTB_EJ(4,2) - 1 /4,1,0,4/ - DATA WNTB_EC(1,3),WNTB_EC(2,3),WNTB_EC(3,3),WNTB_EC(4,3) - 1 /'ELEN','SJ',' ',' '/ - DATA WNTB_EJ(1,3),WNTB_EJ(2,3),WNTB_EJ(3,3),WNTB_EJ(4,3) - 1 /8,1,0,4/ - DATA WNTB_EC(1,4),WNTB_EC(2,4),WNTB_EC(3,4),WNTB_EC(4,4) - 1 /'BPTR','SJ',' ',' '/ - DATA WNTB_EJ(1,4),WNTB_EJ(2,4),WNTB_EJ(3,4),WNTB_EJ(4,4) - 1 /12,1,0,4/ - DATA WNTB_EC(1,5),WNTB_EC(2,5),WNTB_EC(3,5),WNTB_EC(4,5) - 1 /'JPTR','SJ',' ',' '/ - DATA WNTB_EJ(1,5),WNTB_EJ(2,5),WNTB_EJ(3,5),WNTB_EJ(4,5) - 1 /16,1,0,4/ -C -C WNTI edit definitions: -C - INTEGER WNTIEDL,WNTI__EL - PARAMETER ( WNTIEDL=4, ! Length table - 1 WNTI__EL=4) - CHARACTER*12 WNTI_EC(4,4) - INTEGER WNTI_EJ(4,4) - DATA WNTI_EC(1,1),WNTI_EC(2,1),WNTI_EC(3,1),WNTI_EC(4,1) - 1 /'FTYP','SJ',' ',' '/ - DATA WNTI_EJ(1,1),WNTI_EJ(2,1),WNTI_EJ(3,1),WNTI_EJ(4,1) - 1 /0,1,0,4/ - DATA WNTI_EC(1,2),WNTI_EC(2,2),WNTI_EC(3,2),WNTI_EC(4,2) - 1 /'LCOM','SJ',' ',' '/ - DATA WNTI_EJ(1,2),WNTI_EJ(2,2),WNTI_EJ(3,2),WNTI_EJ(4,2) - 1 /4,1,0,4/ - DATA WNTI_EC(1,3),WNTI_EC(2,3),WNTI_EC(3,3),WNTI_EC(4,3) - 1 /'PCOM','SJ',' ',' '/ - DATA WNTI_EJ(1,3),WNTI_EJ(2,3),WNTI_EJ(3,3),WNTI_EJ(4,3) - 1 /8,1,0,4/ - DATA WNTI_EC(1,4),WNTI_EC(2,4),WNTI_EC(3,4),WNTI_EC(4,4) - 1 /'PFOR','SJ',' ',' '/ - DATA WNTI_EJ(1,4),WNTI_EJ(2,4),WNTI_EJ(3,4),WNTI_EJ(4,4) - 1 /12,1,0,4/ -C -C WNTV edit definitions: -C - INTEGER WNTVEDL,WNTV__EL - PARAMETER ( WNTVEDL=4, ! Length table - 1 WNTV__EL=4) - CHARACTER*12 WNTV_EC(4,4) - INTEGER WNTV_EJ(4,4) - DATA WNTV_EC(1,1),WNTV_EC(2,1),WNTV_EC(3,1),WNTV_EC(4,1) - 1 /'NAM','AL',' ',' '/ - DATA WNTV_EJ(1,1),WNTV_EJ(2,1),WNTV_EJ(3,1),WNTV_EJ(4,1) - 1 /0,1,0,16/ - DATA WNTV_EC(1,2),WNTV_EC(2,2),WNTV_EC(3,2),WNTV_EC(4,2) - 1 /'TYP','SJ',' ',' '/ - DATA WNTV_EJ(1,2),WNTV_EJ(2,2),WNTV_EJ(3,2),WNTV_EJ(4,2) - 1 /16,1,0,4/ - DATA WNTV_EC(1,3),WNTV_EC(2,3),WNTV_EC(3,3),WNTV_EC(4,3) - 1 /'VAL','SJ',' ',' '/ - DATA WNTV_EJ(1,3),WNTV_EJ(2,3),WNTV_EJ(3,3),WNTV_EJ(4,3) - 1 /20,1,0,4/ - DATA WNTV_EC(1,4),WNTV_EC(2,4),WNTV_EC(3,4),WNTV_EC(4,4) - 1 /'STR','AL',' ',' '/ - DATA WNTV_EJ(1,4),WNTV_EJ(2,4),WNTV_EJ(3,4),WNTV_EJ(4,4) - 1 /24,1,0,64/ -C -C WNTF edit definitions: -C - INTEGER WNTFEDL,WNTF__EL - PARAMETER ( WNTFEDL=16, ! Length table - 1 WNTF__EL=16) - CHARACTER*12 WNTF_EC(4,16) - INTEGER WNTF_EJ(4,16) - DATA WNTF_EC(1,1),WNTF_EC(2,1),WNTF_EC(3,1),WNTF_EC(4,1) - 1 /'BTYP','SJ',' ',' '/ - DATA WNTF_EJ(1,1),WNTF_EJ(2,1),WNTF_EJ(3,1),WNTF_EJ(4,1) - 1 /0,1,0,4/ - DATA WNTF_EC(1,2),WNTF_EC(2,2),WNTF_EC(3,2),WNTF_EC(4,2) - 1 /'ALEN','SJ',' ',' '/ - DATA WNTF_EJ(1,2),WNTF_EJ(2,2),WNTF_EJ(3,2),WNTF_EJ(4,2) - 1 /4,1,0,4/ - DATA WNTF_EC(1,3),WNTF_EC(2,3),WNTF_EC(3,3),WNTF_EC(4,3) - 1 /'DTP','SJ',' ',' '/ - DATA WNTF_EJ(1,3),WNTF_EJ(2,3),WNTF_EJ(3,3),WNTF_EJ(4,3) - 1 /8,1,0,4/ - DATA WNTF_EC(1,4),WNTF_EC(2,4),WNTF_EC(3,4),WNTF_EC(4,4) - 1 /'ULEN','SJ',' ',' '/ - DATA WNTF_EJ(1,4),WNTF_EJ(2,4),WNTF_EJ(3,4),WNTF_EJ(4,4) - 1 /12,1,0,4/ - DATA WNTF_EC(1,5),WNTF_EC(2,5),WNTF_EC(3,5),WNTF_EC(4,5) - 1 /'SLEN','SJ',' ',' '/ - DATA WNTF_EJ(1,5),WNTF_EJ(2,5),WNTF_EJ(3,5),WNTF_EJ(4,5) - 1 /16,1,0,4/ - DATA WNTF_EC(1,6),WNTF_EC(2,6),WNTF_EC(3,6),WNTF_EC(4,6) - 1 /'DIM','SJ',' ',' '/ - DATA WNTF_EJ(1,6),WNTF_EJ(2,6),WNTF_EJ(3,6),WNTF_EJ(4,6) - 1 /20,1,0,4/ - DATA WNTF_EC(1,7),WNTF_EC(2,7),WNTF_EC(3,7),WNTF_EC(4,7) - 1 /'REFP','SJ',' ',' '/ - DATA WNTF_EJ(1,7),WNTF_EJ(2,7),WNTF_EJ(3,7),WNTF_EJ(4,7) - 1 /24,1,0,4/ - DATA WNTF_EC(1,8),WNTF_EC(2,8),WNTF_EC(3,8),WNTF_EC(4,8) - 1 /'NINI','SJ',' ',' '/ - DATA WNTF_EJ(1,8),WNTF_EJ(2,8),WNTF_EJ(3,8),WNTF_EJ(4,8) - 1 /28,1,0,4/ - DATA WNTF_EC(1,9),WNTF_EC(2,9),WNTF_EC(3,9),WNTF_EC(4,9) - 1 /'INIP','SJ',' ',' '/ - DATA WNTF_EJ(1,9),WNTF_EJ(2,9),WNTF_EJ(3,9),WNTF_EJ(4,9) - 1 /32,1,0,4/ - DATA WNTF_EC(1,10),WNTF_EC(2,10),WNTF_EC(3,10),WNTF_EC(4,10) - 1 /'EDIP','SJ',' ',' '/ - DATA WNTF_EJ(1,10),WNTF_EJ(2,10),WNTF_EJ(3,10),WNTF_EJ(4,10) - 1 /36,1,0,4/ - DATA WNTF_EC(1,11),WNTF_EC(2,11),WNTF_EC(3,11),WNTF_EC(4,11) - 1 /'TLEN','SJ',' ',' '/ - DATA WNTF_EJ(1,11),WNTF_EJ(2,11),WNTF_EJ(3,11),WNTF_EJ(4,11) - 1 /40,1,0,4/ - DATA WNTF_EC(1,12),WNTF_EC(2,12),WNTF_EC(3,12),WNTF_EC(4,12) - 1 /'OFF','SJ',' ',' '/ - DATA WNTF_EJ(1,12),WNTF_EJ(2,12),WNTF_EJ(3,12),WNTF_EJ(4,12) - 1 /44,1,0,4/ - DATA WNTF_EC(1,13),WNTF_EC(2,13),WNTF_EC(3,13),WNTF_EC(4,13) - 1 /'ENT','SJ',' ',' '/ - DATA WNTF_EJ(1,13),WNTF_EJ(2,13),WNTF_EJ(3,13),WNTF_EJ(4,13) - 1 /48,1,0,4/ - DATA WNTF_EC(1,14),WNTF_EC(2,14),WNTF_EC(3,14),WNTF_EC(4,14) - 1 /'SREF','SJ',' ',' '/ - DATA WNTF_EJ(1,14),WNTF_EJ(2,14),WNTF_EJ(3,14),WNTF_EJ(4,14) - 1 /52,1,0,4/ - DATA WNTF_EC(1,15),WNTF_EC(2,15),WNTF_EC(3,15),WNTF_EC(4,15) - 1 /'IND','SJ',' ',' '/ - DATA WNTF_EJ(1,15),WNTF_EJ(2,15),WNTF_EJ(3,15),WNTF_EJ(4,15) - 1 /56,64,0,4/ - DATA WNTF_EC(1,16),WNTF_EC(2,16),WNTF_EC(3,16),WNTF_EC(4,16) - 1 /'NAM','AL',' ',' '/ - DATA WNTF_EJ(1,16),WNTF_EJ(2,16),WNTF_EJ(3,16),WNTF_EJ(4,16) - 1 /312,1,0,64/ -C -C WNTD edit definitions: -C - INTEGER WNTDEDL,WNTD__EL - PARAMETER ( WNTDEDL=2, ! Length table - 1 WNTD__EL=2) - CHARACTER*12 WNTD_EC(4,2) - INTEGER WNTD_EJ(4,2) - DATA WNTD_EC(1,1),WNTD_EC(2,1),WNTD_EC(3,1),WNTD_EC(4,1) - 1 /'REP','SJ',' ',' '/ - DATA WNTD_EJ(1,1),WNTD_EJ(2,1),WNTD_EJ(3,1),WNTD_EJ(4,1) - 1 /0,1,0,4/ - DATA WNTD_EC(1,2),WNTD_EC(2,2),WNTD_EC(3,2),WNTD_EC(4,2) - 1 /'STR','AL',' ',' '/ - DATA WNTD_EJ(1,2),WNTD_EJ(2,2),WNTD_EJ(3,2),WNTD_EJ(4,2) - 1 /4,1,0,36/ -C -C WNTE edit definitions: -C - INTEGER WNTEEDL,WNTE__EL - PARAMETER ( WNTEEDL=4, ! Length table - 1 WNTE__EL=4) - CHARACTER*12 WNTE_EC(4,4) - INTEGER WNTE_EJ(4,4) - DATA WNTE_EC(1,1),WNTE_EC(2,1),WNTE_EC(3,1),WNTE_EC(4,1) - 1 /'EDIT','SJ',' ',' '/ - DATA WNTE_EJ(1,1),WNTE_EJ(2,1),WNTE_EJ(3,1),WNTE_EJ(4,1) - 1 /0,1,0,4/ - DATA WNTE_EC(1,2),WNTE_EC(2,2),WNTE_EC(3,2),WNTE_EC(4,2) - 1 /'PAT','AL',' ',' '/ - DATA WNTE_EJ(1,2),WNTE_EJ(2,2),WNTE_EJ(3,2),WNTE_EJ(4,2) - 1 /4,1,0,12/ - DATA WNTE_EC(1,3),WNTE_EC(2,3),WNTE_EC(3,3),WNTE_EC(4,3) - 1 /'UNIT','AL',' ',' '/ - DATA WNTE_EJ(1,3),WNTE_EJ(2,3),WNTE_EJ(3,3),WNTE_EJ(4,3) - 1 /16,1,0,12/ - DATA WNTE_EC(1,4),WNTE_EC(2,4),WNTE_EC(3,4),WNTE_EC(4,4) - 1 /'SPEC','AL',' ',' '/ - DATA WNTE_EJ(1,4),WNTE_EJ(2,4),WNTE_EJ(3,4),WNTE_EJ(4,4) - 1 /28,1,0,12/ -C- diff --git a/src/wng/wnt_e.inc b/src/wng/wnt_e.inc deleted file mode 100644 index 435cdf53042e8ca92ebf5f9b3df6d4fd625fa3e1..0000000000000000000000000000000000000000 --- a/src/wng/wnt_e.inc +++ /dev/null @@ -1,140 +0,0 @@ -/*+ Created from wnt.dsc on 970828 at 17:01:51 at daw18 -.. WNT_E.INC -.. WNB 970828 -.. -.. Revisions: -.. -.. WNB 931216 New edit default for D/E unformatted items -.. WNB 930902 Make 32 array indices, 64 field length -.. WNB 930801 Original version -.. */ -/* -.. Result: -.. -.. WNT.DSC describes the include files (WNT_O.DEF[.inc], -.. WNT.DEF [.inc]) for the WNTINC program. -.. Most WNTI* routines need: -.. INCLUDE 'WNT_O_DEF' and -.. INCLUDE 'WNT_DEF' -.. */ -/* -.. Specification of edit tables: -.. -.. The character (_EC) table contains: -.. fieldname, pattern, units, special code -.. The integer (_EJ) table contains: -.. offset, #of values, edit (0=allowed), unit length -.. */ -/* -.. WNTB edit definitions: -.. */ -#define WNTBEDL 5 /* Length table */ -#define WNTB__EL 5 /* Length table */ - static char wntb_ec [5][4][12] = { - "CCNT","SJ"," "," ", - "CNT","SJ"," "," ", - "ELEN","SJ"," "," ", - "BPTR","SJ"," "," ", - "JPTR","SJ"," "," "}; - static int wntb_ej [5][4] = { - 0,1,0,4, - 4,1,0,4, - 8,1,0,4, - 12,1,0,4, - 16,1,0,4}; -/* -.. WNTI edit definitions: -.. */ -#define WNTIEDL 4 /* Length table */ -#define WNTI__EL 4 /* Length table */ - static char wnti_ec [4][4][12] = { - "FTYP","SJ"," "," ", - "LCOM","SJ"," "," ", - "PCOM","SJ"," "," ", - "PFOR","SJ"," "," "}; - static int wnti_ej [4][4] = { - 0,1,0,4, - 4,1,0,4, - 8,1,0,4, - 12,1,0,4}; -/* -.. WNTV edit definitions: -.. */ -#define WNTVEDL 4 /* Length table */ -#define WNTV__EL 4 /* Length table */ - static char wntv_ec [4][4][12] = { - "NAM","AL"," "," ", - "TYP","SJ"," "," ", - "VAL","SJ"," "," ", - "STR","AL"," "," "}; - static int wntv_ej [4][4] = { - 0,1,0,16, - 16,1,0,4, - 20,1,0,4, - 24,1,0,64}; -/* -.. WNTF edit definitions: -.. */ -#define WNTFEDL 16 /* Length table */ -#define WNTF__EL 16 /* Length table */ - static char wntf_ec [16][4][12] = { - "BTYP","SJ"," "," ", - "ALEN","SJ"," "," ", - "DTP","SJ"," "," ", - "ULEN","SJ"," "," ", - "SLEN","SJ"," "," ", - "DIM","SJ"," "," ", - "REFP","SJ"," "," ", - "NINI","SJ"," "," ", - "INIP","SJ"," "," ", - "EDIP","SJ"," "," ", - "TLEN","SJ"," "," ", - "OFF","SJ"," "," ", - "ENT","SJ"," "," ", - "SREF","SJ"," "," ", - "IND","SJ"," "," ", - "NAM","AL"," "," "}; - static int wntf_ej [16][4] = { - 0,1,0,4, - 4,1,0,4, - 8,1,0,4, - 12,1,0,4, - 16,1,0,4, - 20,1,0,4, - 24,1,0,4, - 28,1,0,4, - 32,1,0,4, - 36,1,0,4, - 40,1,0,4, - 44,1,0,4, - 48,1,0,4, - 52,1,0,4, - 56,64,0,4, - 312,1,0,64}; -/* -.. WNTD edit definitions: -.. */ -#define WNTDEDL 2 /* Length table */ -#define WNTD__EL 2 /* Length table */ - static char wntd_ec [2][4][12] = { - "REP","SJ"," "," ", - "STR","AL"," "," "}; - static int wntd_ej [2][4] = { - 0,1,0,4, - 4,1,0,36}; -/* -.. WNTE edit definitions: -.. */ -#define WNTEEDL 4 /* Length table */ -#define WNTE__EL 4 /* Length table */ - static char wnte_ec [4][4][12] = { - "EDIT","SJ"," "," ", - "PAT","AL"," "," ", - "UNIT","AL"," "," ", - "SPEC","AL"," "," "}; - static int wnte_ej [4][4] = { - 0,1,0,4, - 4,1,0,12, - 16,1,0,12, - 28,1,0,12}; -/*- */ diff --git a/src/wng/wnt_o.def b/src/wng/wnt_o.def deleted file mode 100644 index cd44213c74beaf538420bd648eeec593f61dc06e..0000000000000000000000000000000000000000 --- a/src/wng/wnt_o.def +++ /dev/null @@ -1,371 +0,0 @@ -C+ Created from wnt.dsc on 970828 at 17:01:49 at daw18 -C WNT_O.DEF -C WNB 970828 -C -C Revisions: -C -C WNB 931216 New edit default for D/E unformatted items -C WNB 930902 Make 32 array indices, 64 field length -C WNB 930801 Original version -C -C -C Given statements: -C -C -C Result: -C -C WNT.DSC describes the include files (WNT_O.DEF[.inc], -C WNT.DEF [.inc]) for the WNTINC program. -C Most WNTI* routines need: -C INCLUDE 'WNT_O_DEF' and -C INCLUDE 'WNT_DEF' -C -C -C Parameters: -C - INTEGER MXDINC ! Max. include depth - PARAMETER (MXDINC=8) - INTEGER MXSLIN ! Single line length - PARAMETER (MXSLIN=132) - INTEGER MXTLIN ! Composite max. line length - PARAMETER (MXTLIN=4096) - INTEGER MXLPAR ! Length % parameter values - PARAMETER (MXLPAR=8) - INTEGER MXLNAM ! Max. length name/value fields - PARAMETER (MXLNAM=64) - INTEGER MXNARR ! Max. # of array indices - PARAMETER (MXNARR=32) - INTEGER COMPOS ! Comment position - PARAMETER (COMPOS=42) - INTEGER AT_DEF ! Data area types - PARAMETER (AT_DEF=1) - INTEGER AT_BEG - PARAMETER (AT_BEG=2) - INTEGER AT__N - PARAMETER (AT__N=3) - INTEGER AT__L - PARAMETER (AT__L=1) - INTEGER AT__H - PARAMETER (AT__H=2) - INTEGER AT__I - PARAMETER (AT__I=1) - INTEGER BT_PAR ! Data block types - PARAMETER (BT_PAR=1) - INTEGER BT_DAT - PARAMETER (BT_DAT=2) - INTEGER BT_SDA - PARAMETER (BT_SDA=3) - INTEGER BT_COM - PARAMETER (BT_COM=4) - INTEGER BT_BEG - PARAMETER (BT_BEG=5) - INTEGER BT_EBG - PARAMETER (BT_EBG=6) - INTEGER BT_DEF - PARAMETER (BT_DEF=7) - INTEGER BT_EDF - PARAMETER (BT_EDF=8) - INTEGER BT_MAP - PARAMETER (BT_MAP=9) - INTEGER BT_EMP - PARAMETER (BT_EMP=10) - INTEGER BT_DCM - PARAMETER (BT_DCM=11) - INTEGER BT__N - PARAMETER (BT__N=12) - INTEGER BT__L - PARAMETER (BT__L=1) - INTEGER BT__H - PARAMETER (BT__H=11) - INTEGER BT__I - PARAMETER (BT__I=1) - INTEGER FT_CON ! Format block types - PARAMETER (FT_CON=-1) - INTEGER FT_NUL - PARAMETER (FT_NUL=0) - INTEGER FT_DAT - PARAMETER (FT_DAT=1) - INTEGER FT_BEG - PARAMETER (FT_BEG=2) - INTEGER FT_DEF - PARAMETER (FT_DEF=3) - INTEGER FT_END - PARAMETER (FT_END=4) - INTEGER FT_MAP - PARAMETER (FT_MAP=5) - INTEGER FT_DCM - PARAMETER (FT_DCM=6) - INTEGER FT__N - PARAMETER (FT__N=9) - INTEGER FT__L - PARAMETER (FT__L=-1) - INTEGER FT__H - PARAMETER (FT__H=6) - INTEGER FT__I - PARAMETER (FT__I=1) - INTEGER OP_LB ! Operators: - ! LBracket PLus - ! MInus MUltiply - ! DIvide SinglePlus - ! SingleMinus - PARAMETER (OP_LB=1) - INTEGER OP_PL - PARAMETER (OP_PL=2) - INTEGER OP_MI - PARAMETER (OP_MI=3) - INTEGER OP_MU - PARAMETER (OP_MU=4) - INTEGER OP_DV - PARAMETER (OP_DV=5) - INTEGER OP_SP - PARAMETER (OP_SP=6) - INTEGER OP_SM - PARAMETER (OP_SM=7) - INTEGER OP__N - PARAMETER (OP__N=8) - INTEGER OP__L - PARAMETER (OP__L=1) - INTEGER OP__H - PARAMETER (OP__H=7) - INTEGER OP__I - PARAMETER (OP__I=1) - INTEGER INCCNT ! Start # of entities to allocate - PARAMETER (INCCNT=16) - INTEGER P_NAM ! Known (%) parameters - PARAMETER (P_NAM=1) - INTEGER P_DAT - PARAMETER (P_DAT=2) - INTEGER P_USE - PARAMETER (P_USE=3) - INTEGER P_VER - PARAMETER (P_VER=4) - INTEGER P_SYS - PARAMETER (P_SYS=5) - INTEGER P_LIS - PARAMETER (P_LIS=6) - INTEGER P_NOL - PARAMETER (P_NOL=7) - INTEGER P_INS - PARAMETER (P_INS=8) - INTEGER P_LOC - PARAMETER (P_LOC=9) - INTEGER P_GLO - PARAMETER (P_GLO=10) - INTEGER P_INC - PARAMETER (P_INC=11) - INTEGER P_REV - PARAMETER (P_REV=12) - INTEGER P_COM - PARAMETER (P_COM=13) - INTEGER P_FOR - PARAMETER (P_FOR=14) - INTEGER P_CC - PARAMETER (P_CC=15) - INTEGER P_PRI - PARAMETER (P_PRI=16) - INTEGER P_NOP - PARAMETER (P_NOP=17) - INTEGER P_ALI - PARAMETER (P_ALI=18) - INTEGER P_NOA - PARAMETER (P_NOA=19) - INTEGER P__N - PARAMETER (P__N=20) - INTEGER P__L - PARAMETER (P__L=1) - INTEGER P__H - PARAMETER (P__H=19) - INTEGER P__I - PARAMETER (P__I=1) - INTEGER PN_DEF ! Known (.) names - PARAMETER (PN_DEF=1) - INTEGER PN_BEG - PARAMETER (PN_BEG=2) - INTEGER PN_END - PARAMETER (PN_END=3) - INTEGER PN_PAR - PARAMETER (PN_PAR=4) - INTEGER PN_DAT - PARAMETER (PN_DAT=5) - INTEGER PN_COM - PARAMETER (PN_COM=6) - INTEGER PN_OFF - PARAMETER (PN_OFF=7) - INTEGER PN_STR - PARAMETER (PN_STR=8) - INTEGER PN_ALI - PARAMETER (PN_ALI=9) - INTEGER PN_MAP - PARAMETER (PN_MAP=10) - INTEGER PN_UNI - PARAMETER (PN_UNI=11) - INTEGER PN__N - PARAMETER (PN__N=12) - INTEGER PN__L - PARAMETER (PN__L=1) - INTEGER PN__H - PARAMETER (PN__H=11) - INTEGER PN__I - PARAMETER (PN__I=1) -C -C WNTB structure definitions: -C - INTEGER WNTBHDL,WNTBHDV,WNTBHDS - PARAMETER ( WNTBHDL=24, ! Length - 1 WNTBHDV=1, ! Version - 1 WNTBHDS=1) ! System - INTEGER WNTB__L,WNTB__V,WNTB__S - PARAMETER ( WNTB__L=24, ! Length - 1 WNTB__V=1, ! Version - 1 WNTB__S=1) ! System -C -C WNTB Offsets: -C - ! General buffer administration - INTEGER WNTB_CCNT_1,WNTB_CCNT_J ! Current # allocated - PARAMETER (WNTB_CCNT_1=0,WNTB_CCNT_J=0) - INTEGER WNTB_CNT_1,WNTB_CNT_J ! Current # filled - PARAMETER (WNTB_CNT_1=4,WNTB_CNT_J=1) - INTEGER WNTB_ELEN_1,WNTB_ELEN_J ! Length data element (bytes) - PARAMETER (WNTB_ELEN_1=8,WNTB_ELEN_J=2) - INTEGER WNTB_BPTR_1,WNTB_BPTR_J ! Pointer to start data (A_B) - PARAMETER (WNTB_BPTR_1=12,WNTB_BPTR_J=3) - INTEGER WNTB_JPTR_1,WNTB_JPTR_J ! Pointer to start data (A_J) - PARAMETER (WNTB_JPTR_1=16,WNTB_JPTR_J=4) -C -C WNTI structure definitions: -C - INTEGER WNTIHDL,WNTIHDV,WNTIHDS - PARAMETER ( WNTIHDL=16, ! Length - 1 WNTIHDV=1, ! Version - 1 WNTIHDS=1) ! System - INTEGER WNTI__L,WNTI__V,WNTI__S - PARAMETER ( WNTI__L=16, ! Length - 1 WNTI__V=1, ! Version - 1 WNTI__S=1) ! System -C -C WNTI Offsets: -C - ! Input line definition - INTEGER WNTI_FTYP_1,WNTI_FTYP_J ! Format type - PARAMETER (WNTI_FTYP_1=0,WNTI_FTYP_J=0) - INTEGER WNTI_LCOM_1,WNTI_LCOM_J ! Length comment (or 0) - PARAMETER (WNTI_LCOM_1=4,WNTI_LCOM_J=1) - INTEGER WNTI_PCOM_1,WNTI_PCOM_J ! Pointer to comment block - PARAMETER (WNTI_PCOM_1=8,WNTI_PCOM_J=2) - INTEGER WNTI_PFOR_1,WNTI_PFOR_J ! Pointer to format block - PARAMETER (WNTI_PFOR_1=12,WNTI_PFOR_J=3) -C -C WNTV structure definitions: -C - INTEGER WNTVHDL,WNTVHDV,WNTVHDS - PARAMETER ( WNTVHDL=88, ! Length - 1 WNTVHDV=1, ! Version - 1 WNTVHDS=1) ! System - INTEGER WNTV__L,WNTV__V,WNTV__S - PARAMETER ( WNTV__L=88, ! Length - 1 WNTV__V=1, ! Version - 1 WNTV__S=1) ! System -C -C WNTV Offsets: -C - ! Local/global value - INTEGER WNTV_NAM_1,WNTV_NAM_C,WNTV_NAM_N ! Variable name - PARAMETER (WNTV_NAM_1=0,WNTV_NAM_C=0,WNTV_NAM_N=16) - INTEGER WNTV_TYP_1,WNTV_TYP_J ! Type: - PARAMETER (WNTV_TYP_1=16,WNTV_TYP_J=4) ! +: local -: global - ! 1: integer 2: string - INTEGER WNTV_VAL_1,WNTV_VAL_J ! Value - PARAMETER (WNTV_VAL_1=20,WNTV_VAL_J=5) - INTEGER WNTV_STR_1,WNTV_STR_C,WNTV_STR_N ! Value as string - PARAMETER (WNTV_STR_1=24,WNTV_STR_C=24,WNTV_STR_N=64) -C -C WNTF structure definitions: -C - INTEGER WNTFHDL,WNTFHDV,WNTFHDS - PARAMETER ( WNTFHDL=376, ! Length - 1 WNTFHDV=1, ! Version - 1 WNTFHDS=1) ! System - INTEGER WNTF__L,WNTF__V,WNTF__S - PARAMETER ( WNTF__L=376, ! Length - 1 WNTF__V=1, ! Version - 1 WNTF__S=1) ! System -C -C WNTF Offsets: -C - ! Format data block - INTEGER WNTF_BTYP_1,WNTF_BTYP_J ! Block type (BT_) - PARAMETER (WNTF_BTYP_1=0,WNTF_BTYP_J=0) - INTEGER WNTF_ALEN_1,WNTF_ALEN_J ! Align length - PARAMETER (WNTF_ALEN_1=4,WNTF_ALEN_J=1) - INTEGER WNTF_DTP_1,WNTF_DTP_J ! Data type (T_) - PARAMETER (WNTF_DTP_1=8,WNTF_DTP_J=2) - INTEGER WNTF_ULEN_1,WNTF_ULEN_J ! Length one unit (bytes) - PARAMETER (WNTF_ULEN_1=12,WNTF_ULEN_J=3) - INTEGER WNTF_SLEN_1,WNTF_SLEN_J ! String length - PARAMETER (WNTF_SLEN_1=16,WNTF_SLEN_J=4) - INTEGER WNTF_DIM_1,WNTF_DIM_J ! # of dimensions - PARAMETER (WNTF_DIM_1=20,WNTF_DIM_J=5) - INTEGER WNTF_REFP_1,WNTF_REFP_J ! Pointer to reference line - PARAMETER (WNTF_REFP_1=24,WNTF_REFP_J=6) - INTEGER WNTF_NINI_1,WNTF_NINI_J ! # of initialisation values - PARAMETER (WNTF_NINI_1=28,WNTF_NINI_J=7) - INTEGER WNTF_INIP_1,WNTF_INIP_J ! Pointer to first init. value - PARAMETER (WNTF_INIP_1=32,WNTF_INIP_J=8) - INTEGER WNTF_EDIP_1,WNTF_EDIP_J ! Edit information pointer - PARAMETER (WNTF_EDIP_1=36,WNTF_EDIP_J=9) - INTEGER WNTF_TLEN_1,WNTF_TLEN_J ! Total length (entities) entry - PARAMETER (WNTF_TLEN_1=40,WNTF_TLEN_J=10) - INTEGER WNTF_OFF_1,WNTF_OFF_J ! Offset of this entry - PARAMETER (WNTF_OFF_1=44,WNTF_OFF_J=11) - INTEGER WNTF_ENT_1,WNTF_ENT_J ! Pointer to input line entry - PARAMETER (WNTF_ENT_1=48,WNTF_ENT_J=12) - INTEGER WNTF_SREF_1,WNTF_SREF_J ! Pointer to structure definition - PARAMETER (WNTF_SREF_1=52,WNTF_SREF_J=13) - INTEGER WNTF_IND_1,WNTF_IND_J ! Low bound, length array index - PARAMETER (WNTF_IND_1=56,WNTF_IND_J=14) - INTEGER WNTF_NAM_1,WNTF_NAM_C,WNTF_NAM_N ! Name of variable - PARAMETER (WNTF_NAM_1=312,WNTF_NAM_C=312,WNTF_NAM_N=64) -C -C WNTD structure definitions: -C - INTEGER WNTDHDL,WNTDHDV,WNTDHDS - PARAMETER ( WNTDHDL=40, ! Length - 1 WNTDHDV=1, ! Version - 1 WNTDHDS=1) ! System - INTEGER WNTD__L,WNTD__V,WNTD__S - PARAMETER ( WNTD__L=40, ! Length - 1 WNTD__V=1, ! Version - 1 WNTD__S=1) ! System -C -C WNTD Offsets: -C - ! Data initialisation information - INTEGER WNTD_REP_1,WNTD_REP_J ! Repetition factor - PARAMETER (WNTD_REP_1=0,WNTD_REP_J=0) - INTEGER WNTD_STR_1,WNTD_STR_C,WNTD_STR_N ! Initialisation information - PARAMETER (WNTD_STR_1=4,WNTD_STR_C=4,WNTD_STR_N=36) -C -C WNTE structure definitions: -C - INTEGER WNTEHDL,WNTEHDV,WNTEHDS - PARAMETER ( WNTEHDL=40, ! Length - 1 WNTEHDV=1, ! Version - 1 WNTEHDS=1) ! System - INTEGER WNTE__L,WNTE__V,WNTE__S - PARAMETER ( WNTE__L=40, ! Length - 1 WNTE__V=1, ! Version - 1 WNTE__S=1) ! System -C -C WNTE Offsets: -C - ! Edit data - INTEGER WNTE_EDIT_1,WNTE_EDIT_J ! Edit allowed (0) - PARAMETER (WNTE_EDIT_1=0,WNTE_EDIT_J=0) - INTEGER WNTE_PAT_1,WNTE_PAT_C,WNTE_PAT_N ! I/O format pattern - PARAMETER (WNTE_PAT_1=4,WNTE_PAT_C=4,WNTE_PAT_N=12) - INTEGER WNTE_UNIT_1,WNTE_UNIT_C,WNTE_UNIT_N ! Units - PARAMETER (WNTE_UNIT_1=16,WNTE_UNIT_C=16,WNTE_UNIT_N=12) - INTEGER WNTE_SPEC_1,WNTE_SPEC_C,WNTE_SPEC_N ! Special information - PARAMETER (WNTE_SPEC_1=28,WNTE_SPEC_C=28,WNTE_SPEC_N=12) -C- diff --git a/src/wng/wnt_o.inc b/src/wng/wnt_o.inc deleted file mode 100644 index b2f088457fd84d9bb4cffa82a361b8ecc8a30efc..0000000000000000000000000000000000000000 --- a/src/wng/wnt_o.inc +++ /dev/null @@ -1,242 +0,0 @@ -/*+ Created from wnt.dsc on 970828 at 17:01:49 at daw18 -.. WNT_O.INC -.. WNB 970828 -.. -.. Revisions: -.. -.. WNB 931216 New edit default for D/E unformatted items -.. WNB 930902 Make 32 array indices, 64 field length -.. WNB 930801 Original version -.. */ -/* -.. Given statements: -.. */ -/* -.. Result: -.. -.. WNT.DSC describes the include files (WNT_O.DEF[.inc], -.. WNT.DEF [.inc]) for the WNTINC program. -.. Most WNTI* routines need: -.. INCLUDE 'WNT_O_DEF' and -.. INCLUDE 'WNT_DEF' -.. */ -/* -.. Parameters: -.. */ -#define MXDINC 8 /* Max. include depth */ -#define MXSLIN 132 /* Single line length */ -#define MXTLIN 4096 /* Composite max. line length */ -#define MXLPAR 8 /* Length % parameter values */ -#define MXLNAM 64 /* Max. length name/value fields */ -#define MXNARR 32 /* Max. # of array indices */ -#define COMPOS 42 /* Comment position */ -#define AT_DEF 1 /* Data area types */ -#define AT_BEG 2 -#define AT__N 3 -#define AT__L 1 -#define AT__H 2 -#define AT__I 1 -#define BT_PAR 1 /* Data block types */ -#define BT_DAT 2 -#define BT_SDA 3 -#define BT_COM 4 -#define BT_BEG 5 -#define BT_EBG 6 -#define BT_DEF 7 -#define BT_EDF 8 -#define BT_MAP 9 -#define BT_EMP 10 -#define BT_DCM 11 -#define BT__N 12 -#define BT__L 1 -#define BT__H 11 -#define BT__I 1 -#define FT_CON -1 /* Format block types */ -#define FT_NUL 0 -#define FT_DAT 1 -#define FT_BEG 2 -#define FT_DEF 3 -#define FT_END 4 -#define FT_MAP 5 -#define FT_DCM 6 -#define FT__N 9 -#define FT__L -1 -#define FT__H 6 -#define FT__I 1 -#define OP_LB 1 /* Operators: */ - /* LBracket PLus */ - /* MInus MUltiply */ - /* DIvide SinglePlus */ - /* SingleMinus */ -#define OP_PL 2 -#define OP_MI 3 -#define OP_MU 4 -#define OP_DV 5 -#define OP_SP 6 -#define OP_SM 7 -#define OP__N 8 -#define OP__L 1 -#define OP__H 7 -#define OP__I 1 -#define INCCNT 16 /* Start # of entities to allocate */ -#define P_NAM 1 /* Known (%) parameters */ -#define P_DAT 2 -#define P_USE 3 -#define P_VER 4 -#define P_SYS 5 -#define P_LIS 6 -#define P_NOL 7 -#define P_INS 8 -#define P_LOC 9 -#define P_GLO 10 -#define P_INC 11 -#define P_REV 12 -#define P_COM 13 -#define P_FOR 14 -#define P_CC 15 -#define P_PRI 16 -#define P_NOP 17 -#define P_ALI 18 -#define P_NOA 19 -#define P__N 20 -#define P__L 1 -#define P__H 19 -#define P__I 1 -#define PN_DEF 1 /* Known (.) names */ -#define PN_BEG 2 -#define PN_END 3 -#define PN_PAR 4 -#define PN_DAT 5 -#define PN_COM 6 -#define PN_OFF 7 -#define PN_STR 8 -#define PN_ALI 9 -#define PN_MAP 10 -#define PN_UNI 11 -#define PN__N 12 -#define PN__L 1 -#define PN__H 11 -#define PN__I 1 -/* -.. WNTB structure definitions: -.. */ -#define WNTBHDL 24 /* Length */ -#define WNTBHDV 1 /* Version */ -#define WNTBHDS 1 /* System */ -#define WNTB__L 24 /* Length */ -#define WNTB__V 1 /* Version */ -#define WNTB__S 1 /* System */ -/* -.. WNTB Offsets: -.. */ -struct wntb { /* General buffer administration */ - int ccnt; /* Current # allocated */ - int cnt; /* Current # filled */ - int elen; /* Length data element (bytes) */ - int bptr; /* Pointer to start data (A_B) */ - int jptr; /* Pointer to start data (A_J) */ - char wntb__0000[4]; -}; /* WNTB */ -/* -.. WNTI structure definitions: -.. */ -#define WNTIHDL 16 /* Length */ -#define WNTIHDV 1 /* Version */ -#define WNTIHDS 1 /* System */ -#define WNTI__L 16 /* Length */ -#define WNTI__V 1 /* Version */ -#define WNTI__S 1 /* System */ -/* -.. WNTI Offsets: -.. */ -struct wnti { /* Input line definition */ - int ftyp; /* Format type */ - int lcom; /* Length comment (or 0) */ - int pcom; /* Pointer to comment block */ - int pfor; /* Pointer to format block */ -}; /* WNTI */ -/* -.. WNTV structure definitions: -.. */ -#define WNTVHDL 88 /* Length */ -#define WNTVHDV 1 /* Version */ -#define WNTVHDS 1 /* System */ -#define WNTV__L 88 /* Length */ -#define WNTV__V 1 /* Version */ -#define WNTV__S 1 /* System */ -/* -.. WNTV Offsets: -.. */ -struct wntv { /* Local/global value */ - char nam[16]; /* Variable name */ - int typ; /* Type: */ - /* +: local -: global */ - /* 1: integer 2: string */ - int val; /* Value */ - char str[64]; /* Value as string */ -}; /* WNTV */ -/* -.. WNTF structure definitions: -.. */ -#define WNTFHDL 376 /* Length */ -#define WNTFHDV 1 /* Version */ -#define WNTFHDS 1 /* System */ -#define WNTF__L 376 /* Length */ -#define WNTF__V 1 /* Version */ -#define WNTF__S 1 /* System */ -/* -.. WNTF Offsets: -.. */ -struct wntf { /* Format data block */ - int btyp; /* Block type (BT_) */ - int alen; /* Align length */ - int dtp; /* Data type (T_) */ - int ulen; /* Length one unit (bytes) */ - int slen; /* String length */ - int dim; /* # of dimensions */ - int refp; /* Pointer to reference line */ - int nini; /* # of initialisation values */ - int inip; /* Pointer to first init. value */ - int edip; /* Edit information pointer */ - int tlen; /* Total length (entities) entry */ - int off; /* Offset of this entry */ - int ent; /* Pointer to input line entry */ - int sref; /* Pointer to structure definition */ - int ind[32][2]; /* Low bound, length array index */ - char nam[64]; /* Name of variable */ -}; /* WNTF */ -/* -.. WNTD structure definitions: -.. */ -#define WNTDHDL 40 /* Length */ -#define WNTDHDV 1 /* Version */ -#define WNTDHDS 1 /* System */ -#define WNTD__L 40 /* Length */ -#define WNTD__V 1 /* Version */ -#define WNTD__S 1 /* System */ -/* -.. WNTD Offsets: -.. */ -struct wntd { /* Data initialisation information */ - int rep; /* Repetition factor */ - char str[36]; /* Initialisation information */ -}; /* WNTD */ -/* -.. WNTE structure definitions: -.. */ -#define WNTEHDL 40 /* Length */ -#define WNTEHDV 1 /* Version */ -#define WNTEHDS 1 /* System */ -#define WNTE__L 40 /* Length */ -#define WNTE__V 1 /* Version */ -#define WNTE__S 1 /* System */ -/* -.. WNTE Offsets: -.. */ -struct wnte { /* Edit data */ - int edit; /* Edit allowed (0) */ - char pat[12]; /* I/O format pattern */ - char unit[12]; /* Units */ - char spec[12]; /* Special information */ -}; /* WNTD */ -/*- */ diff --git a/src/wng/wnt_t.def b/src/wng/wnt_t.def deleted file mode 100644 index a0f7d30fd80ad04dac9e57be805866525fea80f2..0000000000000000000000000000000000000000 --- a/src/wng/wnt_t.def +++ /dev/null @@ -1,81 +0,0 @@ -C+ Created from wnt.dsc on 970828 at 17:01:50 at daw18 -C WNT_T.DEF -C WNB 970828 -C -C Revisions: -C -C WNB 931216 New edit default for D/E unformatted items -C WNB 930902 Make 32 array indices, 64 field length -C WNB 930801 Original version -C -C -C Result: -C -C WNT.DSC describes the include files (WNT_O.DEF[.inc], -C WNT.DEF [.inc]) for the WNTINC program. -C Most WNTI* routines need: -C INCLUDE 'WNT_O_DEF' and -C INCLUDE 'WNT_DEF' -C -C -C Specification of translation tables: -C -C 0= end of table 1= character -C 2= 16 bits integer 3= 32 bits integer -C 4= 32 bits real 5= 64 bits real -C 6= repeat 7= end repeat -C 8= undefined 9= byte -C 10= external repeat 11= start union -C 12= start map 13= end union -C 14= 64 bits complex 15= 128 bits complex -C -C -C WNTB translation definitions: -C - INTEGER*2 WNTB_T(2,3) - EQUIVALENCE (WNTB_T,WNT__T(1,1)) - DATA WNTB_T(1,1),WNTB_T(2,1) /3,5/ - DATA WNTB_T(1,2),WNTB_T(2,2) /9,4/ - DATA WNTB_T(1,3),WNTB_T(2,3) /0,1/ -C -C WNTI translation definitions: -C - INTEGER*2 WNTI_T(2,2) - EQUIVALENCE (WNTI_T,WNT__T(1,4)) - DATA WNTI_T(1,1),WNTI_T(2,1) /3,4/ - DATA WNTI_T(1,2),WNTI_T(2,2) /0,1/ -C -C WNTV translation definitions: -C - INTEGER*2 WNTV_T(2,4) - EQUIVALENCE (WNTV_T,WNT__T(1,6)) - DATA WNTV_T(1,1),WNTV_T(2,1) /1,16/ - DATA WNTV_T(1,2),WNTV_T(2,2) /3,2/ - DATA WNTV_T(1,3),WNTV_T(2,3) /1,64/ - DATA WNTV_T(1,4),WNTV_T(2,4) /0,1/ -C -C WNTF translation definitions: -C - INTEGER*2 WNTF_T(2,3) - EQUIVALENCE (WNTF_T,WNT__T(1,10)) - DATA WNTF_T(1,1),WNTF_T(2,1) /3,78/ - DATA WNTF_T(1,2),WNTF_T(2,2) /1,64/ - DATA WNTF_T(1,3),WNTF_T(2,3) /0,1/ -C -C WNTD translation definitions: -C - INTEGER*2 WNTD_T(2,3) - EQUIVALENCE (WNTD_T,WNT__T(1,13)) - DATA WNTD_T(1,1),WNTD_T(2,1) /3,1/ - DATA WNTD_T(1,2),WNTD_T(2,2) /1,36/ - DATA WNTD_T(1,3),WNTD_T(2,3) /0,1/ -C -C WNTE translation definitions: -C - INTEGER*2 WNTE_T(2,3) - EQUIVALENCE (WNTE_T,WNT__T(1,16)) - DATA WNTE_T(1,1),WNTE_T(2,1) /3,1/ - DATA WNTE_T(1,2),WNTE_T(2,2) /1,36/ - DATA WNTE_T(1,3),WNTE_T(2,3) /0,1/ - INTEGER*2 WNT__T(2,18) -C- diff --git a/src/wng/wnt_t.inc b/src/wng/wnt_t.inc deleted file mode 100644 index 01e0f76e98ea47c8f230d7e78f038d684cc7962b..0000000000000000000000000000000000000000 --- a/src/wng/wnt_t.inc +++ /dev/null @@ -1,76 +0,0 @@ -/*+ Created from wnt.dsc on 970828 at 17:01:50 at daw18 -.. WNT_T.INC -.. WNB 970828 -.. -.. Revisions: -.. -.. WNB 931216 New edit default for D/E unformatted items -.. WNB 930902 Make 32 array indices, 64 field length -.. WNB 930801 Original version -.. */ -/* -.. Result: -.. -.. WNT.DSC describes the include files (WNT_O.DEF[.inc], -.. WNT.DEF [.inc]) for the WNTINC program. -.. Most WNTI* routines need: -.. INCLUDE 'WNT_O_DEF' and -.. INCLUDE 'WNT_DEF' -.. */ -/* -.. Specification of translation tables: -.. -.. 0= end of table 1= character -.. 2= 16 bits integer 3= 32 bits integer -.. 4= 32 bits real 5= 64 bits real -.. 6= repeat 7= end repeat -.. 8= undefined 9= byte -.. 10= external repeat 11= start union -.. 12= start map 13= end union -.. 14= 64 bits complex 15= 128 bits complex -.. */ - static struct { -/* -.. WNTB translation definitions: -.. */ - short wntb_t [3][2] ; -/* -.. WNTI translation definitions: -.. */ - short wnti_t [2][2] ; -/* -.. WNTV translation definitions: -.. */ - short wntv_t [4][2] ; -/* -.. WNTF translation definitions: -.. */ - short wntf_t [3][2] ; -/* -.. WNTD translation definitions: -.. */ - short wntd_t [3][2] ; -/* -.. WNTE translation definitions: -.. */ - short wnte_t [3][2] ; - } wnt__t = { - 3, 5, - 9, 4, - 0, 1, - 3, 4, - 0, 1, - 1, 16, - 3, 2, - 1, 64, - 0, 1, - 3, 78, - 1, 64, - 0, 1, - 3, 1, - 1, 36, - 0, 1, - 3, 1, - 1, 36, - 0, 1 }; -/*- */ diff --git a/src/wng/wntia0.for b/src/wng/wntia0.for deleted file mode 100644 index f54527279cc53b3a9c1b217fc890b2cba74da4d8..0000000000000000000000000000000000000000 --- a/src/wng/wntia0.for +++ /dev/null @@ -1,133 +0,0 @@ -C+ WNTIA0.FOR -C WNB 930501 -C -C Revisions: -C WNB 930803 Add special NUMER option -C - LOGICAL FUNCTION WNTIA0(NUMER,TLIN,PT,NDIM,NENT,INDIC) -C -C Help routine to analyse array definition in a format line -C -C Result: -C -C WNTIA0_L = WNTIAF( NUMER_L:I, TLIN_C*:I, PT_J:IO, NDIM_J:O, NENT_J:O, -C INDIC_J(0:1,0:*):O) -C Analyse a line given in TLIN at PT for -C array definition. -C NDIM returns number of dimensions found, -C NENT the total number of elements in array, -C INDIC the low bound/length per dimension. -C If the last dimension is specified with an -C implied length of *, NENT will be <0, and -C be the length of the first dimensions and -C the length for the index will be -1. -C If MUMER .true., no check for * and length -C will be done -C -C Include files: -C - INCLUDE 'WNG_DEF' - INCLUDE 'WNT_O_DEF' - INCLUDE 'WNT_DEF' -C -C Parameters: -C -C -C Arguments: -C - LOGICAL NUMER !DO NOT CHECK SIZES - CHARACTER*(*) TLIN !LINE TO DO - INTEGER PT !POINTER INTO LINE - INTEGER NDIM !DIMENSIONS FOUND - INTEGER NENT !# OF ELEMENTS IN ARRAY - INTEGER INDIC(0:1,0:*) !INDICES -C -C Function references: -C - LOGICAL WNCASC,WNCATC !TEST CHARACTER - LOGICAL WNTIVG !GET VALUE -C -C Data declarations: -C - CHARACTER*(MXLNAM) LNAM !LOCAL NAME -C- -C -C INIT -C - WNTIA0=.TRUE. !ASSUME OK - NDIM=0 !DIMENSIONS -C -C GET INDICES -C - CALL WNCASB(TLIN,PT) !SKIP SPACES - IF (WNCASC(TLIN,PT,'(')) THEN !ARRAY - 10 CONTINUE - NDIM=NDIM+1 !COUNT DIMENSION - IF (NDIM.GT.MXNARR) GOTO 900 !TOO MANY INDICES - CALL WNCASB(TLIN,PT) !SKIP SPACES - IF (WNCASC(TLIN,PT,'*')) THEN !IMPLIED LENGTH - IF (NUMER) GOTO 900 !NOT ALLOWED - I1=-1 !LENGTH - CALL WNCASB(TLIN,PT) !SKIP SPACES - IF (.NOT.WNCATC(TLIN,PT,')')) GOTO 900 !ERROR - JS=.TRUE. !INDICATE VALUE - ELSE - IF (.NOT.WNTIVG(TLIN,PT,JS,I1,LNAM)) THEN !LOW BOUND - I1=1 - JS=.TRUE. !INDICATE VALUE - END IF - END IF - IF (.NOT.JS) GOTO 900 !NOT VALUE - CALL WNCASB(TLIN,PT) !SKIP SPACES - IF (.NOT.NUMER) THEN !HIGH BOUND POSSIBLE - IF (WNCASC(TLIN,PT,':')) THEN !HIGH BOUND GIVEN - CALL WNCASB(TLIN,PT) !SKIP SPACES - IF (WNCASC(TLIN,PT,'*')) THEN !IMPLIED LENGTH - I2=-1 - CALL WNCASB(TLIN,PT) !SKIP SPACES - IF (.NOT.WNCATC(TLIN,PT,')')) GOTO 900 !ERROR - ELSE - IF (.NOT.WNTIVG(TLIN,PT,JS,I2,LNAM)) GOTO 900 !HIGH BOUND - IF (.NOT.JS) GOTO 900 !NOT VALUE - END IF - ELSE - I2=I1 !HIGH BOUND - I1=1 !LOW BOUND - END IF - IF (I2.NE.-1) THEN - I2=I2-I1+1 !LENGTH - IF (I2.LE.0) GOTO 900 !ILLEGAL LENGTH - END IF - ELSE - I2=I1 !LENGTH - I1=0 !DUMMY LOW BOUND - END IF - INDIC(0,NDIM-1)=I1 !LOW BOUND - INDIC(1,NDIM-1)=I2 !LENGTH - CALL WNCASB(TLIN,PT) !SKIP SPACES - IF (WNCASC(TLIN,PT,',')) GOTO 10 !MORE DIMENSIONS - IF (.NOT.WNCASC(TLIN,PT,')')) GOTO 900 !NOT END ) - END IF - NENT=1 !TOTAL ENTRIES - IF (.NOT.NUMER) THEN !GET INDICES - DO I=0,NDIM-1 !COUNT ARRAY LENGTH - IF (INDIC(1,I).NE.-1) NENT=NENT*INDIC(1,I) - END DO - END IF - GOTO 800 !READY -C -C ERROR -C - 900 CONTINUE - WNTIA0=.FALSE. - NDIM=0 !MAKE SURE - NENT=1 -C -C FINISH -C - 800 CONTINUE -C - RETURN -C -C - END diff --git a/src/wng/wntia1.for b/src/wng/wntia1.for deleted file mode 100644 index 93f2937c4083ad69f389823c68790a6b32f343f2..0000000000000000000000000000000000000000 --- a/src/wng/wntia1.for +++ /dev/null @@ -1,72 +0,0 @@ -C+ WNTIA1.FOR -C WNB 930501 -C -C Revisions: -C - SUBROUTINE WNTIA1(DLEN) -C -C Help routine to create a dummy fill format line -C -C Result: -C -C CALL WNTIA1( DLEN_J:I) -C Create a dummy data line for filling with -C length DLEN -C -C Include files: -C - INCLUDE 'WNG_DEF' - INCLUDE 'WNT_O_DEF' - INCLUDE 'WNT_DEF' -C -C Parameters: -C -C -C Arguments: -C - INTEGER DLEN !LENGTH TO FILL -C -C Function references: -C - INTEGER WNTIBP !WRITE ENTRY IN TABLE -C -C Data declarations: -C - BYTE FENTB(0:WNTFHDL-1) !ENTRY FILLED - CHARACTER*(WNTFHDL) FENTC - INTEGER FENTJ(0:WNTFHDL/LB_J-1) - EQUIVALENCE (FENTB,FENTC,FENTJ) -C- -C -C CHECK -C - IF (DLEN.LE.0) GOTO 800 !NOTHING TO DO -C -C MAKE FILLER -C - CALL WNGMVZ(WNTFHDL,FENTJ) !CLEAN - FENTJ(WNTF_BTYP_J)=CBTP !BLOCK TYPE - FENTJ(WNTF_ALEN_J)=LB_B !ALIGN LENGTH - FENTJ(WNTF_DTP_J)=T_B !DATA TYPE - FENTJ(WNTF_ULEN_J)=LB_B !UNIT LENGTH - FENTJ(WNTF_DIM_J)=1 !DIMENSION - FENTJ(WNTF_TLEN_J)=DLEN !LENGTH TO FILL - FENTJ(WNTF_OFF_J)=COFF !OFFSET - FENTJ(WNTF_IND_J+1)=DLEN !LENGTH ARRAY - CALL WNCTXS(FENTC(WNTF_NAM_1+1:WNTF_NAM_1+WNTF_NAM_N), - 1 '-__!4$ZJ',UNID) !DUMMY NAME - UNID=UNID+1 !COUNT DUMMY NAME -C -C WRITE FILLER -C - I=WNTIBP(XFDES,FENTB) !WRITE FILLER LINE - COFF=COFF+DLEN !NEW OFFSET -C -C FINISH -C - 800 CONTINUE -C - RETURN -C -C - END diff --git a/src/wng/wntiaf.for b/src/wng/wntiaf.for deleted file mode 100644 index 407b597e24db006d50d8e8c5fc434b61fcec3acf..0000000000000000000000000000000000000000 --- a/src/wng/wntiaf.for +++ /dev/null @@ -1,567 +0,0 @@ -C+ WNTIAF.FOR -C WNB 930501 -C -C Revisions: -C WNB 930803 Change WNTIA0 call -C WNB 930902 Add __L, __H, __I; AR: MR: NR: [A|M|N][R][F][*]: -C make all : parameters local variables -C - LOGICAL FUNCTION WNTIAF(TLIN,PT,NAM,NENT,IENTRY,FENTRY,CFLIN) -C -C Analyse a format line -C -C Result: -C -C WNTIAF_L = WNTIAF( TLIN_C*:I, PT_J:IO, NAM_C*:O, NENT_J:I, -C IENTRY_J(0:*):IO, FENTRY_J(0:*):IO) -C Analyse a line given in TLIN at PT for -C format statement NAM returns a name found, -C and data in IENTRY and FENTRY structure. -C NENT is the current line number, and CFLIN -C the current comment pointer -C -C Include files: -C - INCLUDE 'WNG_DEF' - INCLUDE 'WNT_O_DEF' - INCLUDE 'WNT_DEF' -C -C Parameters: -C -C -C Arguments: -C - CHARACTER*(*) TLIN !LINE TO DO - INTEGER PT !POINTER INTO LINE - CHARACTER*(*) NAM !% NAME FOUND - INTEGER NENT !CURRENT LINE NUMBER - INTEGER IENTRY(0:*) !LINE STRUCTURE - INTEGER FENTRY(0:*) !DATA FORMAT STRUCTURE - INTEGER CFLIN !COMMENT LINE POINTER -C -C Function references: -C - LOGICAL WNCASM,WNCATM !TEST MULTIPLE CHARACTER - LOGICAL WNCASC,WNCATC !TEST CHARACTER - LOGICAL WNCAFN !GET NAME - LOGICAL WNCAFT !GET FIELD - INTEGER WNCALN !STRING LENGTH - LOGICAL WNTIVG !GET VALUE - LOGICAL WNTIA0 !GET ARRAY INDICES - INTEGER WNTIBP !WRITE NEW AREA ENTRY - INTEGER WNTIBW !WRITE AREA ENTRY - INTEGER WNTIBR !READ AREA ENTRY - LOGICAL WNTIVS !SET VARAIABLE -C -C Data declarations: -C - LOGICAL EQSEEN != FORMAT SEEN - LOGICAL EBSEEN !EBG SEEN - INTEGER EQREF !REFERENCE OF = NAME - INTEGER EBREF !REFERENCE OF S: NAME - INTEGER NSEEN !NUMERATOR SEEN (0=NOT) - LOGICAL RSEEN !REVERSED NUMERATOR SEEN - LOGICAL FSEEN !FULL NUMERATOR NAME SEEN - LOGICAL STSEEN !* NUMERATOR SEEN - INTEGER NFAC(0:MXNARR-1) !FACTORS NUMERATE - CHARACTER*(MXLNAM) LNAM,LNAM1 !LOCAL NAME STRING - BYTE DFENTB(0:WNTDHDL-1) !DATA INIT ENTRY - INTEGER DFENTJ(0:WNTDHDL/LB_J-1) - CHARACTER*(WNTDHDL) DFENTC - EQUIVALENCE (DFENTB,DFENTJ,DFENTC) - BYTE EFENTB(0:WNTEHDL-1) !EDIT ENTRY - INTEGER EFENTJ(0:WNTEHDL/LB_J-1) - EQUIVALENCE (EFENTB,EFENTJ) - BYTE LFENTB(0:WNTFHDL-1) !LOCAL FORMAT ENTRY - INTEGER LFENTJ(0:WNTFHDL/LB_J-1) - CHARACTER*(WNTFHDL) LFENTC - EQUIVALENCE (LFENTB,LFENTJ,LFENTC) -C- -C -C INIT -C - WNTIAF=.TRUE. !ASSUME OK - NAM=' ' !FOR ERROR MESSAGES - FENTRY(WNTF_BTYP_J)=CBTP !SET BLOCK TYPE - IENTRY(WNTI_FTYP_J)=FT_DAT !SET FORMAT TYPE -C -C NAME -C - CALL WNCASB(TLIN,PT) !SKIP BLANK - IF (WNCASC(TLIN,PT,'-')) THEN !NO NAME - CALL WNCTXS(NAM,'-__!4$ZJ',UNID) - UNID=UNID+1 !COUNT DUMMY NAME - ELSE - IF (.NOT.WNCAFN(TLIN,PT,NAM)) GOTO 900 !IMPROPER NAME - END IF - CALL WNGMFS(WNTF_NAM_N,NAM,FENTRY(WNTF_NAM_1/LB_J)) !SET NAME -C -C = FORMAT -C - IF (WNCASC(TLIN,PT,'=')) THEN !EQUIVALENCE - IF ((CBTP.NE.BT_DAT .AND. CBTP.NE.BT_SDA .AND. - 1 CBTP.NE.BT_COM) .OR. NAM(1:1).EQ.'-') - 1 GOTO 900 !NOT ALLOWED - IF (.NOT.WNCAFN(TLIN,PT,LNAM)) GOTO 900 !EQUIV. NAME - DO I1=XFDES_J(WNTB_CNT_J)-1,0,-1 !CHECK OLD NAMES - I2=WNTIBR(XFDES,LFENTB,I1) !READ OLD FORMAT ENTRY - IF (LFENTJ(WNTF_BTYP_J).NE.CBTP) THEN !CANNOT FIND NAME - 11 CONTINUE - CALL WNCTXT(F_TP,'Illegal = format reference') - GOTO 900 - END IF - CALL WNGMTS(WNTF_NAM_N,LFENTB(WNTF_NAM_1),LNAM1) - IF (LNAM.EQ.LNAM1) THEN !FOUND NAME - EQSEEN=.TRUE. !SET CORRECT = FORMAT SEEN - EQREF=I1 !WHERE SEEN - GOTO 10 - END IF - END DO - GOTO 11 !COULD NOT FIND NAME - ELSE - EQSEEN=.FALSE. !NOT = FORMAT - END IF - 10 CONTINUE -C -C TYPE -C - CALL WNCASB(TLIN,PT) !SKIP BLANKS - I2=0 !ASSUME NON-CHAR - I3=1 !ALIGNMENT - NSEEN=0 !ASSUME NON-NUMERATE - RSEEN=.FALSE. !AND NOT R-NUMERATE - FSEEN=.FALSE. !AND NOT F-NUMERATE - STSEEN=.FALSE. !AND NOT *-NUMERATE - IF (WNCASM(TLIN,PT,'-Bb')) THEN !B - I0=T_B - I1=LB_B - ELSE IF (WNCASM(TLIN,PT,'Ii')) THEN !I - I0=T_I - I1=LB_I - I3=LB_I - IF (WNCASC(TLIN,PT,'1')) THEN !I1 - I0=T_B - I1=LB_B - I3=LB_B - ELSE IF (WNCASC(TLIN,PT,'2')) THEN !I2 - ELSE IF (WNCASC(TLIN,PT,'4')) THEN !I4 - I0=T_J - I1=LB_J - I3=LB_J - END IF - ELSE IF (WNCASM(TLIN,PT,'Jj')) THEN !J - I0=T_J - I1=LB_J - I3=LB_J - ELSE IF (WNCASM(TLIN,PT,'Kk')) THEN !K - I0=T_K - I1=LB_K - I3=LB_K - ELSE IF (WNCASM(TLIN,PT,'Ee')) THEN !E - I0=T_E - I1=LB_E - I3=LB_E - ELSE IF (WNCASM(TLIN,PT,'Dd')) THEN !D - I0=T_D - I1=LB_D - I3=LB_D - ELSE IF (WNCASM(TLIN,PT,'Xx')) THEN !X - I0=T_X - I1=LB_X - I3=LB_E - ELSE IF (WNCASM(TLIN,PT,'Yy')) THEN !Y - I0=T_Y - I1=LB_Y - I3=LB_D - ELSE IF (WNCASM(TLIN,PT,'Ll')) THEN !L - I0=T_L - I1=LB_L - I3=LB_L - ELSE IF (WNCASM(TLIN,PT,'Rr')) THEN !R - I0=T_E - I1=LB_E - I3=LB_E - IF (WNCASC(TLIN,PT,'4')) THEN !R4 - ELSE IF (WNCASC(TLIN,PT,'8')) THEN !R8 - I0=T_D - I1=LB_D - I3=LB_D - END IF - ELSE IF (WNCASM(TLIN,PT,'Cc')) THEN !C - I0=T_C - I1=LB_C - IF (WNCASC(TLIN,PT,'*')) THEN !IMPLIED LENGTH - I2=-1 - ELSE - IF (.NOT.WNTIVG(TLIN,PT,JS,I2,LNAM)) GOTO 900 !LENGTH - IF (.NOT.JS) GOTO 900 !NOT VALUE - END IF - ELSE IF (WNCASM(TLIN,PT,'Aa')) THEN !A - IF (WNCASM(TLIN,PT,'Rr')) THEN !AR: - CALL WNCASB(TLIN,PT) - IF (.NOT.WNCATM(TLIN,PT,'Ff*:')) GOTO 900 !ILLEGAL - RSEEN=.TRUE. !SET R-NUMERATE - END IF - IF (WNCASM(TLIN,PT,'Ff')) THEN !AF: - CALL WNCASB(TLIN,PT) - IF (.NOT.WNCATM(TLIN,PT,'*:')) GOTO 900 !ILLEGAL - FSEEN=.TRUE. !SET F-NUMERATE - END IF - IF (WNCASC(TLIN,PT,'*')) THEN !A*: - CALL WNCASB(TLIN,PT) - IF (.NOT.WNCATC(TLIN,PT,':')) GOTO 900 !ILLEGAL - STSEEN=.TRUE. - END IF - CALL WNCASB(TLIN,PT) - IF (.NOT.WNCASC(TLIN,PT,':')) THEN - I0=T_C - I1=LB_A - IF (WNCASC(TLIN,PT,'*')) THEN !IMPLIED LENGTH - I2=-1 - ELSE - IF (.NOT.WNTIVG(TLIN,PT,JS,I2,LNAM)) GOTO 900 !LENGTH - IF (.NOT.JS) GOTO 900 !NOT VALUE - END IF - ELSE !A: - IF (EQSEEN) GOTO 900 !NO = ALLOWED - NSEEN=1 !INDICATE A: - I0=T_C !ASSUME FOR NOW C - I1=LB_C - I2=-1 - END IF - ELSE IF (WNCASM(TLIN,PT,'Mm')) THEN !M: - IF (WNCASM(TLIN,PT,'Rr')) RSEEN=.TRUE. !MR: - IF (WNCASM(TLIN,PT,'Ff')) FSEEN=.TRUE. !MF: - IF (WNCASC(TLIN,PT,'*')) STSEEN=.TRUE. !M*: - CALL WNCASB(TLIN,PT) - IF (.NOT.WNCASC(TLIN,PT,':')) GOTO 900 !UNKNOWN - IF (EQSEEN) GOTO 900 !NO = ALLOWED - NSEEN=2 !INDICATE M: - I0=T_C !ASSUME FOR NOW C - I1=LB_C - I2=-1 - ELSE IF (WNCASM(TLIN,PT,'Nn')) THEN !N: - IF (WNCASM(TLIN,PT,'Rr')) RSEEN=.TRUE. !NR: - IF (WNCASM(TLIN,PT,'Ff')) FSEEN=.TRUE. !NF: - IF (WNCASC(TLIN,PT,'*')) STSEEN=.TRUE. !N*: - CALL WNCASB(TLIN,PT) - IF (.NOT.WNCASC(TLIN,PT,':')) GOTO 900 !UNKNOWN - IF (EQSEEN) GOTO 900 !NO = ALLOWED - NSEEN=3 !INDICATE N: - I0=T_C !ASSUME FOR NOW C - I1=LB_C - I2=-1 - ELSE IF (WNCASM(TLIN,PT,'Ss')) THEN !S - CALL WNCASB(TLIN,PT) - IF (.NOT.WNCASC(TLIN,PT,':')) GOTO 900 !NOT S: - CALL WNCASB(TLIN,PT) - IF (.NOT.WNCAFN(TLIN,PT,LNAM)) GOTO 900 !REFERENCE NAME - EBSEEN=.FALSE. !TO CHECK INFINITE LOOP - DO I1=XFDES_J(WNTB_CNT_J)-1,0,-1 !CHECK OLD NAMES - I4=WNTIBR(XFDES,LFENTB,I1) !READ OLD FORMAT ENTRY - IF (LFENTJ(WNTF_BTYP_J).EQ.BT_EBG) THEN - EBSEEN=.TRUE. !FOUND END STRUCTURE - ELSE IF (LFENTJ(WNTF_BTYP_J).EQ.BT_BEG .AND. EBSEEN) THEN !MAYBE - CALL WNGMTS(WNTF_NAM_N,LFENTB(WNTF_NAM_1),LNAM1) - IF (LNAM.EQ.LNAM1) THEN !FOUND NAME - EBREF=I1 !WHERE SEEN - GOTO 30 - END IF - END IF - END DO - 31 CONTINUE - CALL WNCTXT(F_TP,'Illegal S: name reference') - GOTO 900 - 30 CONTINUE !FOUND REFERENCE - I0=T_S !RECORD TYPE - I1=LFENTJ(WNTF_TLEN_J) !LENGTH - I3=LFENTJ(WNTF_ALEN_J) !ALIGN LENGTH - FENTRY(WNTF_SREF_J)=EBREF !SAVE REFERENCE PTR - ELSE !UNKNOWN - GOTO 900 - END IF - FENTRY(WNTF_DTP_J)=I0 !SAVE DATA TYPE - FENTRY(WNTF_ULEN_J)=I1 !UNIT LENGTH - FENTRY(WNTF_SLEN_J)=I2 !STRING LENGTH - FENTRY(WNTF_ALEN_J)=I3 !ALIGN LENGTH - CALEN=MAX(CALEN,I3) !STRUCTURE ALIGN LENGTH -C -C ARRAY TYPE -C - IF (.NOT.WNTIA0(NSEEN.NE.0,TLIN,PT,FENTRY(WNTF_DIM_J), - 1 FENTRY(WNTF_TLEN_J), - 1 FENTRY(WNTF_IND_J))) GOTO 900 !GET INDICES - IF (NSEEN.NE.0) THEN !NUMERATE TYPE - DO I=0,MXNARR-1 !FILL DEFAULTS - NFAC(I)=I+1 - END DO - IF (NSEEN.EQ.1) NFAC(1)=1 !IF A: - DO I=0,FENTRY(WNTF_DIM_J)-1 !FILL GIVEN - NFAC(I)=FENTRY(WNTF_IND_J+2*I+1) - END DO - END IF -C -C // INITIALISATION -C - CALL WNCASB(TLIN,PT) !SKIP BLANK - IF (WNCASC(TLIN,PT,'/')) THEN !INIT. - IF (CBTP.EQ.BT_SDA .OR. EQSEEN) GOTO 900 !NOT ALLOWED - I0=0 !# OF INIT - I2=1 !MAX. STRING LENGTH - 20 CONTINUE - CALL WNCASB(TLIN,PT) - I=1 !REPEAT FACTOR - IF (WNCATC(TLIN,PT,'(')) THEN !REPEAT PRESENT - IF (NSEEN.NE.0) GOTO 900 !NOT ALLOWED - IF (.NOT.WNTIVG(TLIN,PT,JS,I,LNAM)) GOTO 900 !GET IT - IF (.NOT.JS) GOTO 900 !NOT VALUE - IF (I.LE.0) GOTO 900 !ILLEGAL VALUE - END IF - J=PT !SAVE POINTER - IF (.NOT.WNTIVG(TLIN,PT,JS,I1,LNAM)) THEN !GET INIT VALUE - JS=WNCAFT(TLIN,PT,LNAM,',/') !PATTERN - ELSE - CALL WNCASB(TLIN,PT) - IF (.NOT.WNCATM(TLIN,PT,',/')) THEN !SET FIELD - PT=J !RESET POINTER - JS=WNCAFT(TLIN,PT,LNAM,',/') !PATTERN - END IF - END IF - I0=I0+I !COUNT - I2=MAX(WNCALN(LNAM),I2) !STRING LENGTH - DFENTJ(WNTD_REP_J)=I !SET REPEAT FACTOR - CALL WNGMFS(WNTD_STR_N,LNAM,DFENTB(WNTD_STR_1)) !SET PATTERN - I3=WNTIBP(DFDES,DFENTB) !SAVE DATA INIT DATA - IF (FENTRY(WNTF_NINI_J).EQ.0) FENTRY(WNTF_INIP_J)=I3 !WHERE - FENTRY(WNTF_NINI_J)=FENTRY(WNTF_NINI_J)+1 !COUNT - CALL WNCASB(TLIN,PT) - IF (WNCASC(TLIN,PT,',')) GOTO 20 !MORE - IF (.NOT.WNCASC(TLIN,PT,'/')) GOTO 900 !ERROR - IF (FENTRY(WNTF_DTP_J).EQ.T_C .AND. - 1 FENTRY(WNTF_SLEN_J).EQ.-1) THEN !IMPLIED LENGTH - FENTRY(WNTF_SLEN_J)=I2+1 !SET PROPER LENGTH - END IF - IF (FENTRY(WNTF_TLEN_J).LT.0) THEN !IMPLIED SIZE - I=ABS(I0/FENTRY(WNTF_TLEN_J)) !LAST INDEX LENGTH - FENTRY(WNTF_IND_J+2*FENTRY(WNTF_DIM_J)-1)=I !SET LAST INDEX - FENTRY(WNTF_TLEN_J)=ABS(FENTRY(WNTF_TLEN_J)*I) !SET TOTAL LENGTH - END IF - IF (NSEEN.EQ.0 .AND. I0.NE.FENTRY(WNTF_TLEN_J)) GOTO 900 !INIT. ERROR - IF (CBTP.EQ.BT_COM) CINSN=.TRUE. !SET COMMON INIT SEEN - END IF -C -C <> EDIT -C - CALL WNCASB(TLIN,PT) !SKIP BLANK - IF (WNCASC(TLIN,PT,'<')) THEN !EDIT - IF (CBTP.NE.BT_SDA) GOTO 900 !NOT ALLOWED - IF (NSEEN.NE.0) GOTO 900 !NOT ALLOWED - I1=0 !EDIT CODE - CALL WNGMVB(WNTEHDL,EFENTB) !ALL SPACES - EFENTJ(WNTE_EDIT_J)=0 !ALLOW EDIT - CALL WNCASB(TLIN,PT) - JS=WNCAFT(TLIN,PT,LNAM,',>') !PATTERN - CALL WNGMFS(WNTE_PAT_N,LNAM,EFENTB(WNTE_PAT_1)) !SAVE IT - CALL WNCASB(TLIN,PT) - IF (.NOT.WNCASC(TLIN,PT,'>')) THEN !CODE - IF (.NOT.WNCASC(TLIN,PT,',')) GOTO 900 - IF (.NOT.WNTIVG(TLIN,PT,JS,I1,LNAM)) THEN !GET EDIT CODE - I1=0 - ELSE - IF (.NOT.JS) GOTO 900 !NOT VALUE - END IF - EFENTJ(WNTE_EDIT_J)=I1 !SET CODE - CALL WNCASB(TLIN,PT) - IF (.NOT.WNCASC(TLIN,PT,'>')) THEN !UNITS - IF (.NOT.WNCASC(TLIN,PT,',')) GOTO 900 !ERROR - JS=WNCAFT(TLIN,PT,LNAM,',>') !GET UNITS - CALL WNGMFS(WNTE_UNIT_N,LNAM,EFENTB(WNTE_UNIT_1)) !SAVE IT - CALL WNCASB(TLIN,PT) - IF (.NOT.WNCASC(TLIN,PT,'>')) THEN !SPECIAL - IF (.NOT.WNCASC(TLIN,PT,',')) GOTO 900 - JS=WNCAFT(TLIN,PT,LNAM,',>') !GET SPECIAL - CALL WNGMFS(WNTE_SPEC_N,LNAM,EFENTB(WNTE_SPEC_1)) !SAVE IT - CALL WNCASB(TLIN,PT) - IF (.NOT.WNCASC(TLIN,PT,'>')) GOTO 900 !ERROR - END IF - END IF - END IF - FENTRY(WNTF_EDIP_J)=WNTIBP(EFDES,EFENTB) !SAVE EDIT INFO - END IF -C -C NUMERATE -C - IF (NSEEN.NE.0) THEN - DFENTC(WNTD_STR_1+1:WNTD_STR_1+WNTD_STR_N)=' ' !ADD LAST ENTRY - DFENTJ(WNTD_REP_J)=1 - I2=WNTIBP(DFDES,DFENTB) - IF (NSEEN.EQ.3 .AND. FENTRY(WNTF_NINI_J).GT.MXNARR) - 1 GOTO 900 !NOT ALLOWED - DO I=0,FENTRY(WNTF_NINI_J)-1 !MAKE ALL NAMES - CALL WNGMVZ(WNTFHDL,LFENTB) !CLEAR ENTRY - I2=WNTIBR(DFDES,DFENTB,FENTRY(WNTF_INIP_J)+I) !READ INIT - LFENTJ(WNTF_BTYP_J)=BT_PAR !PARAMETER - LFENTJ(WNTF_ALEN_J)=LB_J !ALIGNMENT - LFENTJ(WNTF_DTP_J)=T_J !DATA TYPE - LFENTJ(WNTF_ULEN_J)=LB_J !UNIT LENGTH - LFENTJ(WNTF_TLEN_J)=1 !LENGTH - IF (DFENTC(WNTD_STR_1+1: - 1 WNTD_STR_1+WNTD_STR_N).NE.' ') THEN !CAN DO - IF (FSEEN) THEN !FULL NAME - J0=WNTD_STR_N - ELSE !PART NAME - J0=MIN(3,WNTD_STR_N) - END IF - IF (RSEEN) THEN - CALL WNCTXS(LFENTC(WNTF_NAM_1+1:WNTF_NAM_1+WNTF_NAM_N), - 1 '!AD_!AS', - 1 DFENTB(WNTD_STR_1),J0,NAM) !NAME - ELSE - CALL WNCTXS(LFENTC(WNTF_NAM_1+1:WNTF_NAM_1+WNTF_NAM_N), - 1 '!AS_!AD',NAM, - 1 DFENTB(WNTD_STR_1),J0) !NAME - END IF - DFENTJ(WNTD_REP_J)=1 !SET VALUE - IF (NSEEN.EQ.1) THEN !A: - J=NFAC(0)+I*NFAC(1) - ELSE IF (NSEEN.EQ.2) THEN !M: - J=NFAC(0)*(NFAC(1)**I) - ELSE !N: - J=NFAC(I) - END IF - CALL WNCTXS(DFENTC(WNTD_STR_1+1:WNTD_STR_1+WNTD_STR_N), - 1 '!SJ',J) !VALUE - LFENTJ(WNTF_NINI_J)=1 !# VALUES - LFENTJ(WNTF_INIP_J)=WNTIBP(DFDES,DFENTB) !SET VALUE - IF (I.EQ.0) LFENTJ(WNTF_ENT_J)=CFLIN !SAVE COMMENT POINTER - I2=WNTIBP(XFDES,LFENTB) !SET FORMAT - IF (.NOT.WNTIVS(J, - 1 LFENTC(WNTF_NAM_1+1:WNTF_NAM_1+WNTF_NAM_N), - 1 .FALSE.)) GOTO 900 !SET AS LOCAL VARIABLE - END IF - END DO !ALL NAMES - FENTRY(WNTF_NINI_J)=FENTRY(WNTF_NINI_J)+1 !COUNT LAST ENTRY - CALL WNGMVZ(WNTFHDL,LFENTB) !CLEAR ENTRY - IF (.NOT.STSEEN) THEN !GIVE SPECIAL NAMES - LFENTJ(WNTF_BTYP_J)=BT_PAR !PARAMETER - LFENTJ(WNTF_ALEN_J)=LB_J !ALIGNMENT - LFENTJ(WNTF_DTP_J)=T_J !DATA TYPE - LFENTJ(WNTF_ULEN_J)=LB_J !UNIT LENGTH - LFENTJ(WNTF_TLEN_J)=1 !LENGTH - DFENTJ(WNTD_REP_J)=1 !SET VALUE - LFENTJ(WNTF_NINI_J)=1 !# VALUES - CALL WNCTXS(LFENTC(WNTF_NAM_1+1:WNTF_NAM_1+WNTF_NAM_N), - 1 '!AS__N',NAM) !NAME __N - CALL WNCTXS(DFENTC(WNTD_STR_1+1:WNTD_STR_1+WNTD_STR_N), - 1 '!UJ', - 1 FENTRY(WNTF_NINI_J)) !VALUE - LFENTJ(WNTF_INIP_J)=WNTIBP(DFDES,DFENTB) !SET VALUE - I2=WNTIBP(XFDES,LFENTB) !SET FORMAT - IF (.NOT.WNTIVS(FENTRY(WNTF_NINI_J), - 1 LFENTC(WNTF_NAM_1+1:WNTF_NAM_1+WNTF_NAM_N), - 1 .FALSE.)) GOTO 900 !SET __N AS LOCAL VARIABLE - IF (NSEEN.NE.3) THEN !A: OR M: - CALL WNCTXS(LFENTC(WNTF_NAM_1+1:WNTF_NAM_1+WNTF_NAM_N), - 1 '!AS__L',NAM) !NAME __L - CALL WNCTXS(DFENTC(WNTD_STR_1+1:WNTD_STR_1+WNTD_STR_N), - 1 '!SJ', - 1 NFAC(0)) !VALUE - LFENTJ(WNTF_INIP_J)=WNTIBP(DFDES,DFENTB) !SET VALUE - I2=WNTIBP(XFDES,LFENTB) !SET FORMAT - IF (.NOT.WNTIVS(NFAC(0), - 1 LFENTC(WNTF_NAM_1+1:WNTF_NAM_1+WNTF_NAM_N), - 1 .FALSE.)) GOTO 900 !SET __L AS LOCAL VARIABLE - CALL WNCTXS(LFENTC(WNTF_NAM_1+1:WNTF_NAM_1+WNTF_NAM_N), - 1 '!AS__H',NAM) !NAME __H - CALL WNCTXS(DFENTC(WNTD_STR_1+1:WNTD_STR_1+WNTD_STR_N), - 1 '!SJ', - 1 J) !VALUE - LFENTJ(WNTF_INIP_J)=WNTIBP(DFDES,DFENTB) !SET VALUE - I2=WNTIBP(XFDES,LFENTB) !SET FORMAT - IF (.NOT.WNTIVS(J, - 1 LFENTC(WNTF_NAM_1+1:WNTF_NAM_1+WNTF_NAM_N), - 1 .FALSE.)) GOTO 900 !SET __H AS LOCAL VARIABLE - CALL WNCTXS(LFENTC(WNTF_NAM_1+1:WNTF_NAM_1+WNTF_NAM_N), - 1 '!AS__I',NAM) !NAME __I - CALL WNCTXS(DFENTC(WNTD_STR_1+1:WNTD_STR_1+WNTD_STR_N), - 1 '!SJ', - 1 NFAC(1)) !VALUE - LFENTJ(WNTF_INIP_J)=WNTIBP(DFDES,DFENTB) !SET VALUE - I2=WNTIBP(XFDES,LFENTB) !SET FORMAT - IF (.NOT.WNTIVS(NFAC(1), - 1 LFENTC(WNTF_NAM_1+1:WNTF_NAM_1+WNTF_NAM_N), - 1 .FALSE.)) GOTO 900 !SET __I AS LOCAL VARIABLE - END IF !A: OR M: - END IF !NO * SEEN NUMERATE - IF (CATP.EQ.AT_DEF .AND. CBTP.NE.BT_PAR .AND. - 1 .NOT.STSEEN) THEN !NEED STRING - FENTRY(WNTF_DIM_J)=1 !SET STRING - FENTRY(WNTF_IND_J+0)=1 - FENTRY(WNTF_IND_J+1)=FENTRY(WNTF_NINI_J) - FENTRY(WNTF_TLEN_J)=FENTRY(WNTF_NINI_J) - CALL WNCTXS(LNAM1,'!AS__TXT',NAM) - CALL WNGMFS(WNTF_NAM_N,LNAM1,FENTRY(WNTF_NAM_1/LB_J)) !SET NAME - ELSE - CALL WNGMVZ(WNTFHDL,FENTRY) !CLEAR ENTRY - GOTO 800 !READY - END IF - END IF !NUMERATE -C -C FINAL -C - IF (FENTRY(WNTF_TLEN_J).LE.0) GOTO 900 !STILL IMPLIED SIZE - IF (FENTRY(WNTF_DTP_J).EQ.T_C .AND. - 1 FENTRY(WNTF_SLEN_J).LE.0) GOTO 900 !STILL IMPLIED LENGTH - CALL WNCASB(TLIN,PT) - IF (PT.LE.LEN(TLIN)) GOTO 900 !FORMAT ERROR - IF (CBTP.EQ.BT_PAR .AND. FENTRY(WNTF_TLEN_J).NE.1 .AND. - 1 FENTRY(WNTF_NINI_J).NE.1) GOTO 900 - IF (EQSEEN) THEN !CHECK LENGTH, SET OFFSET - I2=WNTIBR(XFDES,LFENTB,EQREF) !READ REF. ENTRY - IF (FENTRY(WNTF_ALEN_J).GT.LFENTJ(WNTF_ALEN_J) .AND. - 1 ALGON) GOTO 11 !WRONG ALIGN - I1=FENTRY(WNTF_TLEN_J)*FENTRY(WNTF_ULEN_J) !NEW LENGTH - IF (FENTRY(WNTF_DTP_J).EQ.T_C) I1=I1*FENTRY(WNTF_SLEN_J) - I2=LFENTJ(WNTF_TLEN_J)*LFENTJ(WNTF_ULEN_J) !OLD LENGTH - IF (LFENTJ(WNTF_DTP_J).EQ.T_C) I2=I2*LFENTJ(WNTF_SLEN_J) - IF (I1.GT.I2) GOTO 11 !WRONG LENGTH - FENTRY(WNTF_OFF_J)=LFENTJ(WNTF_OFF_J) !COPY OFFSET - FENTRY(WNTF_REFP_J)=EQREF !SET REFERENCE - LFENTJ(WNTF_REFP_J)=XFDES_J(WNTB_CNT_J) !SET WHERE LAST = FORMAT SEEN - I2=WNTIBW(XFDES,LFENTB,EQREF) !REWRITE OLD ENTRY - ELSE - IF (CBTP.NE.BT_PAR) THEN !OFFSET NEEDED - IF (.NOT.ALGON) THEN !UNALIGNED - FENTRY(WNTF_OFF_J)=COFF !SET CURRENT OFFSET - ELSE !ALIGNED - FENTRY(WNTF_OFF_J)= - 1 ((COFF+FENTRY(WNTF_ALEN_J)-1)/FENTRY(WNTF_ALEN_J))* - 1 FENTRY(WNTF_ALEN_J) - IF (CBTP.NE.BT_DAT) - 1 CALL WNTIA1(FENTRY(WNTF_OFF_J)-COFF) !CREATE DUMMY - END IF - IF (FENTRY(WNTF_DTP_J).EQ.T_C) THEN !STRING - COFF=FENTRY(WNTF_OFF_J)+ - 1 FENTRY(WNTF_TLEN_J)*FENTRY(WNTF_ULEN_J)* - 1 FENTRY(WNTF_SLEN_J) - ELSE - COFF=FENTRY(WNTF_OFF_J)+ - 1 FENTRY(WNTF_TLEN_J)*FENTRY(WNTF_ULEN_J) - END IF - END IF - END IF -C -C FINISH -C - 800 CONTINUE -C - RETURN -C -C ERROR -C - 900 CONTINUE - WNTIAF=.FALSE. - GOTO 800 -C -C - END diff --git a/src/wng/wntian.for b/src/wng/wntian.for deleted file mode 100644 index 4445fed66e476f4eaa24c50727710706fd973019..0000000000000000000000000000000000000000 --- a/src/wng/wntian.for +++ /dev/null @@ -1,290 +0,0 @@ -C+ WNTIAN.FOR -C WNB 930501 -C -C Revisions: -C - LOGICAL FUNCTION WNTIAN(TLIN,PT,NAM,NENT,IENTRY,FENTRY) -C -C Analyse a name (.) line -C -C Result: -C -C WNTIAN_L = WNTIAN( TLIN_C*:I, PT_J:IO, NAM_C*:O, NENT_J:I, -C IENTRY_J(0:*):IO, FENTRY_J(0:*):IO) -C Analyse a line given in TLIN at PT for -C . statement. NAM returns the . name found -C and data in IENTRY and FENTRY structure. -C NENT is the current line number -C -C Include files: -C - INCLUDE 'WNG_DEF' - INCLUDE 'WNT_O_DEF' - INCLUDE 'WNT_DEF' -C -C Parameters: -C -C -C Arguments: -C - CHARACTER*(*) TLIN !LINE TO DO - INTEGER PT !POINTER INTO LINE - CHARACTER*(*) NAM !% NAME FOUND - INTEGER NENT !CURRENT LINE NUMBER - INTEGER IENTRY(0:*) !LINE STRUCTURE - INTEGER FENTRY(0:*) !DATA FORMAT STRUCTURE -C -C Function references: -C - LOGICAL WNCASC,WNCATC !TEST CHARACTER GIVEN - LOGICAL WNCAFN !GET NAME - INTEGER WNCAFU !MINIMAX FIT - INTEGER WNTIBR !READ ENTRY - INTEGER WNTIBW !WRITE ENTRY - LOGICAL WNTIVG !GET VALUE - LOGICAL WNTIVP !SET VALUE -C -C Data declarations: -C - CHARACTER*(MXLNAM) LNAM,LNAM1,LNAM2,LNAM3 !LOCAL NAME - INTEGER LENTRY(0:WNTIHDL/LB_J-1) !LINE DESCRIPTOR - BYTE LFENTB(0:WNTFHDL-1) !FORMAT DESCRIPTOR - INTEGER LFENTJ(0:WNTFHDL/LB_J-1) - EQUIVALENCE (LFENTB,LFENTJ) -C- -C -C INIT -C - WNTIAN=.TRUE. !ASSUME OK - NAM=' ' !FOR ERROR MESSAGES -C -C . NAME -C - CALL WNCASB(TLIN,PT) !SKIP BLANK - IF (WNCATC(TLIN,PT,'=')) THEN !SAME AS .OFFSET - I=PN_OFF - ELSE - IF (.NOT.WNCAFN(TLIN,PT,NAM)) GOTO 900 !GET . NAME - I=WNCAFU(NAM,PN__TXT) !TEST NAME - END IF -C -C .COMMON END -C - IF (CBTP.EQ.BT_COM) THEN !COULD BE END COMMON - IF (I.EQ.PN_PAR .OR. I.EQ.PN_DAT .OR. I.EQ.PN_COM .OR. - 1 (I.EQ.PN_END .AND. CATP.EQ.AT_DEF)) THEN !END COMMON - DO I1=XFDES_J(WNTB_CNT_J)-1,0,-1 !FIND START COMMON - I2=WNTIBR(XFDES,LFENTB,I1) !READ ENTRY - IF (LFENTJ(WNTF_BTYP_J).EQ.BT_DCM) THEN !FOUND - LFENTJ(WNTF_TLEN_J)=COFF !SET LENGTH - I2=WNTIBW(XFDES,LFENTB,I1) !REWRITE ENTRY - GOTO 10 !OK - END IF - END DO - 10 CONTINUE - END IF - END IF -C -C .DEFINE -C - IF (I.EQ.PN_DEF) THEN - IF (DEFSN .OR. DEP.GT.0) GOTO 900 !NOT ALLOWED - CALL WNCASB(TLIN,PT) - IF (PT.LE.LEN(TLIN)) GOTO 900 !FORMAT ERROR - FENTRY(WNTF_BTYP_J)=BT_DEF !FORMAT TYPE - FENTRY(WNTF_DTP_J)=CATP !SAVE PREVIOUS AREA TYPE - FENTRY(WNTF_ALEN_J)=CALN !AND LINE NUMBER - FENTRY(WNTF_TLEN_J)=COFF !CURRENT OFFSET - FENTRY(WNTF_ULEN_J)=CBTP !CURRENT BLOCK TYPE - IENTRY(WNTI_FTYP_J)=FT_DEF !SET TYPE - CATP=AT_DEF !SET DEFINE TYPE - DEP=DEP+1 !NEW DEPTH - CALN=NENT !CURRENT LINE NUMBER - CBTP=BT_DAT !ASSUME DATA - COFF=0 !START NEW OFFSET - DEFSN=.TRUE. !SET .DEFINE SEEN -C -C .STRUCTURE/BEGIN -C - ELSE IF (I.EQ.PN_BEG .OR. I.EQ.PN_STR) THEN - IF (CATP.EQ.AT_BEG) GOTO 900 !NO NESTING ALLOWED - CALL WNCASB(TLIN,PT) !SKIP BLANKS - IF (WNCASC(TLIN,PT,'=')) THEN !NAME GIVEN - CALL WNCASB(TLIN,PT) !SKIP BLANK - IF (.NOT.WNCAFN(TLIN,PT,LNAM)) GOTO 900 !IMPROPER NAME - ELSE - LNAM=PARM(P_NAM) - END IF - DO I1=0,XFDES_J(WNTB_CNT_J)-1 !CHECK DUPLICATE NAME - I2=WNTIBR(XFDES,LFENTB,I1) !READ ENTRY - IF (LFENTJ(WNTF_BTYP_J).EQ.BT_BEG) THEN - CALL WNGMTS(WNTF_NAM_N,LFENTB(WNTF_NAM_1),LNAM1) - IF (LNAM.EQ.LNAM1) THEN - CALL WNCTXT(F_TP,'Duplicate structure name') - GOTO 900 - END IF - END IF - END DO - FENTRY(WNTF_BTYP_J)=BT_BEG !STRUCTURE FORMAT - FENTRY(WNTF_DTP_J)=CATP !SAVE PREVIOUS AREA TYPE - FENTRY(WNTF_ALEN_J)=CALN !AND LINE NUMBER - FENTRY(WNTF_TLEN_J)=COFF !CURRENT OFFSET - FENTRY(WNTF_ULEN_J)=CBTP !CURRENT BLOCK TYPE - CALL WNGMFS(WNTF_NAM_N,LNAM,FENTRY(WNTF_NAM_1/LB_J)) !SAVE NAME - IENTRY(WNTI_FTYP_J)=FT_BEG !SET TYPE - CATP=AT_BEG !SET BEGIN TYPE - DEP=DEP+1 !NEW DEPTH - CALN=NENT !CURRENT LINE NUMBER - CBTP=BT_SDA !ASSUME DATA - COFF=0 !NEW OFFSET START - CALEN=0 !NEW ALIGNMENT BLOCK - BEGSN=.TRUE. !SET .BEGIN SEEN -C -C .END -C - ELSE IF (I.EQ.PN_END) THEN - CALL WNCASB(TLIN,PT) - IF (PT.LE.LEN(TLIN)) GOTO 900 !FORMAT ERROR - DEP=DEP-1 - IF (DEP.LT.0) THEN - CALL WNCTXT(F_TP,'Fatal -- Illegal depth') - GOTO 900 - END IF - IF (CATP.EQ.AT_BEG) THEN - FENTRY(WNTF_BTYP_J)=BT_EBG !END FORMAT TYPE - ELSE IF (CATP.EQ.AT_DEF) THEN - FENTRY(WNTF_BTYP_J)=BT_EDF !END FORMAT TYPE - ELSE - CALL WNCTXT(F_TP,'Fatal -- Illegal END statement') - GOTO 900 - END IF - FENTRY(WNTF_DTP_J)=CATP !SAVE BEGIN AREA - FENTRY(WNTF_ALEN_J)=CALN - IENTRY(WNTI_FTYP_J)=FT_END !SET TYPE - I2=WNTIBR(IBDES,LENTRY,CALN) !READ PREVIOUS AREA DEFINITION - I2=WNTIBR(XFDES,LFENTB,LENTRY(WNTI_PFOR_J)) !READ FORMAT - CATP=LFENTJ(WNTF_DTP_J) !TYPE PREVIOUS DEFINITION - CBTP=LFENTJ(WNTF_ULEN_J) !TYPE PREVIOUS BLOCK - CALN=LFENTJ(WNTF_ALEN_J) !LINE PRE-PREVIOUS DEFINITION - I1=COFF !CURRENT OFFSET - COFF=LFENTJ(WNTF_TLEN_J) !OLD OFFSET - LFENTJ(WNTF_TLEN_J)=I1 !SAVE LENGTH STRUCTURE - IF (FENTRY(WNTF_DTP_J).EQ.AT_BEG) THEN !SAVE BLOCK ALIGNMENT - LFENTJ(WNTF_ALEN_J)=CALEN - CALL WNCTXS(LNAM2,'!AD__L', - 1 LFENTB(WNTF_NAM_1),WNTF_NAM_N) !MAKE VARIABLES - CALL WNCTXS(LNAM3,'!UJ',LFENTJ(WNTF_TLEN_J)) - J=1 - JS=WNTIVP(LNAM3,J,LNAM2,.FALSE.) - CALL WNCTXS(LNAM2,'!AD__V', - 1 LFENTB(WNTF_NAM_1),WNTF_NAM_N) !MAKE VARIABLES - J=1 - JS=WNTIVP(PARM(P_VER),J,LNAM2,.FALSE.) - CALL WNCTXS(LNAM2,'!AD__S', - 1 LFENTB(WNTF_NAM_1),WNTF_NAM_N) !MAKE VARIABLES - J=1 - JS=WNTIVP(PARM(P_SYS),J,LNAM2,.FALSE.) - END IF - I2=WNTIBW(XFDES,LFENTB,I2) !REWRITE STRUCTURE FORMAT -C -C .PARAMETER/DATA/COMMON -C - ELSE IF (I.EQ.PN_PAR) THEN - CBTP=BT_PAR - PARSN=.TRUE. !SET .PARAMETER SEEN - ELSE IF (I.EQ.PN_DAT) THEN - IF (DEP.LE.0) GOTO 900 - IF (CATP.EQ.AT_BEG) THEN - CBTP=BT_SDA - ELSE - CBTP=BT_DAT - END IF - ELSE IF (I.EQ.PN_COM) THEN - IF (DEP.LE.0 .OR. CATP.NE.AT_DEF) GOTO 900 !NOT ALLOWED - CALL WNCASB(TLIN,PT) !SKIP BLANKS - IF (WNCASC(TLIN,PT,'=')) THEN !NAME GIVEN - CALL WNCASB(TLIN,PT) !SKIP BLANK - IF (.NOT.WNCAFN(TLIN,PT,LNAM)) GOTO 900 !IMPROPER NAME - ELSE - LNAM=PARM(P_NAM) - END IF - DO I1=0,XFDES_J(WNTB_CNT_J)-1 !CHECK DUPLICATE NAME - I2=WNTIBR(XFDES,LFENTB,I1) !READ ENTRY - IF (LFENTJ(WNTF_BTYP_J).EQ.BT_DCM) THEN - CALL WNGMTS(WNTF_NAM_N,LFENTB(WNTF_NAM_1),LNAM1) - IF (LNAM.EQ.LNAM1) THEN - CALL WNCTXT(F_TP,'Duplicate common name') - GOTO 900 - END IF - END IF - END DO - FENTRY(WNTF_BTYP_J)=BT_DCM !DEFINE COMMON FORMAT - CALL WNGMFS(WNTF_NAM_N,LNAM,FENTRY(WNTF_NAM_1/LB_J)) !SAVE NAME - IENTRY(WNTI_FTYP_J)=FT_DCM !SET TYPE - COFF=0 !RESTART OFFSETS - CBTP=BT_COM -C -C .OFFSET -C - ELSE IF (I.EQ.PN_OFF) THEN - IF (DEP.LE.0 .OR. CBTP.EQ.BT_PAR .OR. - 1 CBTP.EQ.BT_DAT) GOTO 900 !NOT ALLOWED - CALL WNCASB(TLIN,PT) !SKIP BLANKS - IF (.NOT.WNCASC(TLIN,PT,'=')) GOTO 900 - IF (.NOT.WNTIVG(TLIN,PT,JS,I1,LNAM)) GOTO 900 !GET VALUE - IF (.NOT.JS) GOTO 900 !NOT VALUE - CALL WNCASB(TLIN,PT) !SKIP BLANKS - IF (PT.LE.LEN(TLIN)) GOTO 900 !FORMAT ERROR - IF (I1.LT.COFF) THEN !CANNOT DO - CALL WNCTXT(F_TP,'Illegal offset (before current position)') - GOTO 900 - END IF - CALL WNTIA1(I1-COFF) !MAKE DUMMY ENTRY -C -C .ALIGN -C - ELSE IF (I.EQ.PN_ALI) THEN - IF (DEP.LE.0 .OR. CBTP.EQ.BT_PAR .OR. - 1 CBTP.EQ.BT_DAT) GOTO 900 !NOT ALLOWED - CALL WNCASB(TLIN,PT) !SKIP BLANKS - IF (.NOT.WNCASC(TLIN,PT,'=')) GOTO 900 - IF (.NOT.WNTIVG(TLIN,PT,JS,I1,LNAM)) GOTO 900 !GET VALUE - IF (.NOT.JS) GOTO 900 !NOT VALUE - CALL WNCASB(TLIN,PT) !SKIP BLANKS - IF (PT.LE.LEN(TLIN)) GOTO 900 !FORMAT ERROR - IF (I1.LE.0) GOTO 900 !CANNOT ALIGN ON 0 - I1=((COFF+I1-1)/I1)*I1 !ALIGNED OFFSET - CALL WNTIA1(I1-COFF) !MAKE DUMMY ENTRY -C -C .MAP -C - ELSE IF (I.EQ.PN_MAP) THEN - CALL WNCTXT(F_TP,'.MAP not yet implemented') - GOTO 900 -C -C .UNION -C - ELSE IF (I.EQ.PN_UNI) THEN - CALL WNCTXT(F_TP,'.UNION not yet implemented') - GOTO 900 -C -C END . -C - ELSE - GOTO 900 !UNKNOWN - END IF -C -C FINISH -C - 800 CONTINUE -C - RETURN -C -C ERROR -C - 900 CONTINUE - WNTIAN=.FALSE. - GOTO 800 -C -C - END diff --git a/src/wng/wntiap.for b/src/wng/wntiap.for deleted file mode 100644 index dcffda4ae6563308ea556d2d3b9ed1888c1c6c86..0000000000000000000000000000000000000000 --- a/src/wng/wntiap.for +++ /dev/null @@ -1,211 +0,0 @@ -C+ WNTIAP.FOR -C WNB 930501 -C -C Revisions: -C - LOGICAL FUNCTION WNTIAP(TLIN,PT,NAM,CFLIN) -C -C Analyse a parameter (%) line -C -C Result: -C -C WNTIAP_L = WNTIAP( TLIN_C*:I, PT_J:IO, NAM_C*:O, CFLIN_J:I) -C Analyse a line given in TLIN at PT for -C % statement. NAM returns the % name found. -C CFLIN is the current comment line -C -C Include files: -C - INCLUDE 'WNG_DEF' - INCLUDE 'WNT_O_DEF' - INCLUDE 'WNT_DEF' -C -C Parameters: -C -C -C Arguments: -C - CHARACTER*(*) TLIN !LINE TO DO - INTEGER PT !POINTER INTO LINE - CHARACTER*(*) NAM !% NAME FOUND - INTEGER CFLIN !CURRENT COMMENT LINE -C -C Function references: -C - LOGICAL WNCASC !TEST CHARACTER GIVEN - LOGICAL WNCAFN !GET NAME - INTEGER WNCAFU !MINIMAX FIT - LOGICAL WNCAFS,WNCAFT,WNCAFF !GET FIELD - INTEGER WNCALN !STRING LENGTH - INTEGER WNTIBP !SAVE AREA - LOGICAL WNTIVP !PUT VALUE - LOGICAL WNTIVG !GET VALUE -C -C Data declarations: -C - CHARACTER*(MXLNAM) LNAM,LNAM1 !LOCAL NAME - CHARACTER*(MXSLIN) LLIN !LOCAL LINE - BYTE BLLIN(0:MXSLIN-1) - EQUIVALENCE (LLIN,BLLIN) - BYTE FENTB(0:WNTFHDL-1) !FORMAT ENTRY FILLED - INTEGER FENTJ(0:WNTFHDL/LB_J-1) - EQUIVALENCE (FENTB,FENTJ) - BYTE DFENTB(0:WNTDHDL-1) !DATA INIT. ENTRY FILLED - INTEGER DFENTJ(0:WNTDHDL/LB_J-1) - EQUIVALENCE (DFENTB,DFENTJ) -C- -C -C INIT -C - WNTIAP=.TRUE. !ASSUME OK - NAM=' ' !FOR ERROR MESSAGES -C -C %% -C - IF (WNCASC(TLIN,PT,'%')) THEN !%% - IF (.NOT.WNCAFN(TLIN,PT,NAM)) GOTO 900 !UNKNOWN - I=WNCAFU(NAM,P__TXT) !TEST NAME - IF (I.LE.P_SYS .AND. I.GT.0) THEN - CALL WNCTXT(F_P,'!16C%!AS=!AS', - 1 P__TXT(I),PARM(I)) !SHOW DEFAULT - ELSE - GOTO 900 !UNKNOWN - END IF - CALL WNCASB(TLIN,PT) - IF (PT.LE.LEN(TLIN)) GOTO 900 !FORMAT ERROR - ELSE -C -C %(NO)LIST -C - IF (.NOT.WNCAFN(TLIN,PT,NAM)) GOTO 900 !UNKNOWN - I=WNCAFU(NAM,P__TXT) !TEST NAME - CALL WNCASB(TLIN,PT) !SKIP BLANK - IF (.NOT.WNCASC(TLIN,PT,'=')) THEN !NO = - CALL WNCASB(TLIN,PT) - IF (PT.LE.LEN(TLIN)) GOTO 900 !FORMAT ERROR - IF (I.EQ.P_LIS) THEN - LSTON=.TRUE. - ELSE IF (I.EQ.P_NOL) THEN - LSTON=.FALSE. - ELSE IF (I.EQ.P_PRI) THEN - PRTON=.TRUE. - ELSE IF (I.EQ.P_NOP) THEN - PRTON=.FALSE. - ELSE IF (I.EQ.P_ALI) THEN - ALGON=.TRUE. - ELSE IF (I.EQ.P_NOA) THEN - ALGON=.FALSE. - ELSE - GOTO 900 !ERROR - END IF -C -C %LOCAL/GLOBAL -C - ELSE IF (I.EQ.P_LOC .OR. I.EQ.P_GLO) THEN - CALL WNCASB(TLIN,PT) !SKIP BLANK - IF (.NOT.WNCAFN(TLIN,PT,LNAM)) GOTO 900 !ILLEGAL NAME - CALL WNCASB(TLIN,PT) !SKIP BLANK - IF (.NOT.WNCASC(TLIN,PT,'=')) GOTO 900 !ILLEGAL FORMAT - IF (.NOT.WNTIVP(TLIN,PT,LNAM,I.EQ.P_GLO)) GOTO 900 !PUT NAME - IF (I.EQ.P_GLO) THEN !MAKE A PARAMETER ENTRY - I1=1 !POINTER - IF (.NOT.WNTIVG(LNAM,I1,JS,I2,LNAM1)) GOTO 900 !GET VALUE - CALL WNGMVZ(WNTFHDL,FENTJ) !CLEAN - FENTJ(WNTF_BTYP_J)=BT_PAR !BLOCK TYPE - IF (JS) THEN !INTEGER - FENTJ(WNTF_ALEN_J)=LB_J !ALIGN LENGTH - FENTJ(WNTF_DTP_J)=T_J !DATA TYPE - FENTJ(WNTF_ULEN_J)=LB_J !UNIT LENGTH - FENTJ(WNTF_SLEN_J)=0 !STRING LENGTH - ELSE !CHARACTER - FENTJ(WNTF_ALEN_J)=LB_C !ALIGN LENGTH - FENTJ(WNTF_DTP_J)=T_C !DATA TYPE - FENTJ(WNTF_ULEN_J)=LB_C !UNIT LENGTH - FENTJ(WNTF_SLEN_J)=WNCALN(LNAM1) !STRING LENGTH - END IF - FENTJ(WNTF_DIM_J)=0 !DIMENSION - FENTJ(WNTF_TLEN_J)=1 !LENGTH TO FILL - CALL WNGMFS(WNTF_NAM_N,LNAM,FENTB(WNTF_NAM_1)) !SET NAME - FENTJ(WNTF_NINI_J)=1 !# OF DATA INIT - DFENTJ(WNTD_REP_J)=1 !REPEAT FACTOR - CALL WNGMFS(WNTD_STR_N,LNAM1,DFENTB(WNTD_STR_1)) !SET DATA INIT - FENTJ(WNTF_INIP_J)=WNTIBP(DFDES,DFENTB) !SET POINTER - FENTJ(WNTF_ENT_J)=CFLIN !COMMENT POINTER - I=WNTIBP(XFDES,FENTB) !WRITE PARAMETER LINE - PARSN=.TRUE. !SET PARAMETER SEEN - END IF -C -C %NAME/DATE/USER/VERSION/SYSTEM -C - ELSE IF (I.GT.0 .AND. I.LE.P_SYS) THEN - CALL WNCASB(TLIN,PT) !SKIP BLANK - IF (.NOT.WNTIVG(TLIN,PT,JS,I2,PARM(I))) GOTO 900 !SET PARAMETER -C -C %INSERT/INCLUDE -C - ELSE IF (I.EQ.P_INS .OR. I.EQ.P_INC) THEN - CALL WNCASB(TLIN,PT) !SKIP BLANK - IF (.NOT.WNCAFS(TLIN,PT,INFIL)) GOTO 900 !GET FILE NAME -C -C %REVISION -C - ELSE IF (I.EQ.P_REV) THEN - CALL WNCASB(TLIN,PT) !SKIP BLANK - IF (.NOT.WNCAFT(TLIN,PT,LLIN,'=')) GOTO 900 !GET USER NAME - IF (.NOT.WNCASC(TLIN,PT,'=')) GOTO 900 !NO = - CALL WNCASB(TLIN,PT) !SKIP BLANK - IF (.NOT.WNCAFT(TLIN,PT,LLIN(MXLPAR+1:),'=')) GOTO 900 !DATE - IF (.NOT.WNCASC(TLIN,PT,'=')) GOTO 900 !NO = - IF (.NOT.WNCAFF(TLIN,PT,LLIN(2*MXLPAR+1:))) !TEXT - 1 LLIN(2*MXLPAR+1:)=' ' - I=WNTIBP(RBDES,BLLIN) !SAVE REVISION INFO -C -C %COMMENT -C - ELSE IF (I.EQ.P_COM) THEN - IF (.NOT.WNCAFF(TLIN,PT,LLIN)) LLIN=' ' !TEXT - I=WNTIBP(CMDES,BLLIN) !SAVE COMMENT INFO -C -C %FORTRAN -C - ELSE IF (I.EQ.P_FOR) THEN - CALL WNCASB(TLIN,PT) !SKIP BLANK - IF (.NOT.WNCAFF(TLIN,PT,LLIN)) LLIN=' ' !TEXT - IF (DEP.EQ.0) THEN - I=WNTIBP(FMDES,BLLIN) !SAVE FORTRAN INFO - ELSE - I=WNTIBP(FEDES,BLLIN) - END IF -C -C %CC -C - ELSE IF (I.EQ.P_CC) THEN - CALL WNCASB(TLIN,PT) !SKIP BLANK - IF (.NOT.WNCAFF(TLIN,PT,LLIN)) LLIN=' ' !TEXT - IF (DEP.EQ.0) THEN - I=WNTIBP(CCDES,BLLIN) !SAVE CC INFO - ELSE - I=WNTIBP(CEDES,BLLIN) - END IF -C -C END % -C - ELSE - GOTO 900 !UNKNOWN % NAME - END IF - END IF -C -C FINISH -C - 800 CONTINUE -C - RETURN -C -C ERROR -C - 900 CONTINUE - WNTIAP=.FALSE. - GOTO 800 -C -C - END diff --git a/src/wng/wntibp.for b/src/wng/wntibp.for deleted file mode 100644 index a695c43685de79f12c85449aaf748940e7dd9536..0000000000000000000000000000000000000000 --- a/src/wng/wntibp.for +++ /dev/null @@ -1,95 +0,0 @@ -C+ WNTIBP.FOR -C WNB 930501 -C -C Revisions: -C - INTEGER FUNCTION WNTIBP(BDES,DAT) -C -C Put data into variable length buffer -C -C Result: -C -C WNTIBP_J = WNTIBP( BDES_J(*):IO, DAT_B(*):I) -C Put data DAT into buffer described -C by BDES. WNTIBP returns the buffer -C line number of the data -C WNTIBW_J = WNTIBW( BDES_J(*):I, DAT_B(*):I, NENT_J:I) -C Write entry at NENT -C WNTIBR_J = WNTIBR( BDES_J(*):I, DAT_B(*):O, NENT_J:I) -C Read entry at NENT -C -C Include files: -C - INCLUDE 'WNG_DEF' - INCLUDE 'WNT_O_DEF' -C -C Parameters: -C -C -C Entry points: -C - INTEGER WNTIBW,WNTIBR -C -C Arguments: -C - INTEGER BDES(0:*) !BUFFER DESCRIPTOR - BYTE DAT(0:*) !DATA - INTEGER NENT !ENTRY NUMBER -C -C Function references: -C - LOGICAL WNGGVM !GET MEMORY -C -C Data declarations: -C -C- -C -C WNTIBP -C - IF (BDES(WNTB_CNT_J).GE.BDES(WNTB_CCNT_J)) THEN !CANNOT FIT MORE - I=MAX(2*BDES(WNTB_CCNT_J),INCCNT) !NEW LENGTH - IF (.NOT.WNGGVM(I*BDES(WNTB_ELEN_J),J0)) THEN !GET NEW BUFFER - CALL WNCTXT(F_TP,'Fatal -- No memory for buffers') - CALL WNGEX !STOP - END IF - J0=J0-A_OB !NEW BUFFER PTR - CALL WNGMV(BDES(WNTB_CCNT_J)*BDES(WNTB_ELEN_J), - 1 A_B(BDES(WNTB_BPTR_J)),A_B(J0)) !SAVE OLD BUFFER - IF (BDES(WNTB_CCNT_J).GT.0) !REMOVE OLD BUFFER - 1 CALL WNGFVM(BDES(WNTB_CCNT_J)*BDES(WNTB_ELEN_J), - 1 A_OB+BDES(WNTB_BPTR_J)) !FREE OLD BUFFER - BDES(WNTB_BPTR_J)=J0 !NEW POINTERS - BDES(WNTB_JPTR_J)=J0/LB_J - BDES(WNTB_CCNT_J)=I !NEW LENGTH - END IF - CALL WNGMV(BDES(WNTB_ELEN_J),DAT, - 1 A_B(BDES(WNTB_BPTR_J)+ - 1 BDES(WNTB_CNT_J)*BDES(WNTB_ELEN_J))) !SAVE DATA - WNTIBP=BDES(WNTB_CNT_J) !RETURN LINE POINTER - BDES(WNTB_CNT_J)=BDES(WNTB_CNT_J)+1 !COUNT ENTRY -C - RETURN -C -C WNTIBW -C - ENTRY WNTIBW(BDES,DAT,NENT) -C - CALL WNGMV(BDES(WNTB_ELEN_J),DAT, - 1 A_B(BDES(WNTB_BPTR_J)+ - 1 NENT*BDES(WNTB_ELEN_J))) !SAVE DATA - WNTIBW=NENT !RETURN LINE POINTER -C - RETURN -C -C WNTIBR -C - ENTRY WNTIBR(BDES,DAT,NENT) -C - CALL WNGMV(BDES(WNTB_ELEN_J),A_B(BDES(WNTB_BPTR_J)+ - 1 NENT*BDES(WNTB_ELEN_J)),DAT) !READ DATA - WNTIBR=NENT !RETURN LINE POINTER -C - RETURN -C -C - END diff --git a/src/wng/wntinc.for b/src/wng/wntinc.for deleted file mode 100644 index ac193974c9f06a2fb7ba9f23a03c722110b3d518..0000000000000000000000000000000000000000 --- a/src/wng/wntinc.for +++ /dev/null @@ -1,360 +0,0 @@ -C+ WNTINC.FOR -C WNB 930501 -C -C Revisions: -C - SUBROUTINE WNTINC(IFIL) -C -C Main routine to convert .DSC file into .DEF etc files. -C -C Result: -C -C CALL WNTINC( IFIL_C*:I) Convert .DSC file with name IFIL -C to .DEF, .INC etc. IFIL should have -C no extension, but may have directory. -C The file name part will be assumed -C to be lc. -C -C Include files: -C - INCLUDE 'WNG_DEF' - INCLUDE 'WNT_O_DEF' - INCLUDE 'WNT_DEF' -C -C Parameters: -C - INTEGER NLVAR !# OF INIT LOCAL VARIABLES - PARAMETER (NLVAR=T__N) -C -C Arguments: -C - CHARACTER*(*) IFIL !FILE TO DO -C -C Function references: -C - INTEGER WNCALN,WNCAL0 !STRING LENGTH - LOGICAL WNCATD !TEST DIGIT - LOGICAL WNCATN !TEST NAME LIKE - LOGICAL WNCASC !TEST CHARACTER GIVEN - CHARACTER*1 WNCALO !MAKE LC - LOGICAL WNTIRL !READ A LINE - INTEGER WNTIBP,WNTIBW !PUT LINE IN BUFFER - INTEGER WNTIBR !READ LINE FROM BUFFER - LOGICAL WNTIAP !ANALYSE % LINE - LOGICAL WNTIAN !ANALYSE . LINE - LOGICAL WNTIAF !ANALYSE FORMAT LINE - LOGICAL WNTIVS !SET LOCAL VARIABLE -C -C Data declarations: -C - INTEGER DINC !INCLUDE DEPTH - INTEGER PLUN(MXDINC) !OPEN LUNS - CHARACTER*(MXSLIN) ISTR,IDAT,ICOM !SINGLE LINE DATA/COMMENT - BYTE BICOM(0:MXSLIN-1) - EQUIVALENCE (BICOM,ICOM) - CHARACTER*(MXTLIN) TLIN !TOTAL DATA LINE - INTEGER LLIN !LENGTH FILLED OF TLIN - LOGICAL CONTL !CONTINUATION LINE - INTEGER CLIN !CURRENT LINE - INTEGER CFLIN !CURRENT FORMAT LINE - INTEGER IENTRY(0:WNTBHDL/LB_J-1) !CURRENT INPUT LINE DESCRIPTOR - INTEGER LENTRY(0:WNTBHDL/LB_J-1) !INPUT LINE DESCRIPTOR - INTEGER FENTRY(0:WNTFHDL/LB_J-1) !CURRENT DATA FORMAT ENTRY - INTEGER EENTRY(0:WNTEHDL/LB_J-1) !CURRENT EDIT ENTRY - CHARACTER*(MXLNAM) NAM !NAME FIELD - CHARACTER*8 LVNAM(NLVAR) !INITIAL LOCAL VARIABLES - DATA LVNAM/'LB_B','LB_C','LB_L','LB_I','LB_J','LB_K', - 1 'LB_E','LB_D','LB_X','LB_Y','LB_A','LB_S', - 1 'T__N'/ - INTEGER LVVAL(NLVAR) - DATA LVVAL/LB_B,LB_C,LB_L,LB_I,LB_J,LB_K, - 1 LB_E,LB_D,LB_X,LB_Y,LB_A,LB_S, - 1 T__N/ -C- -C -C PRELIMINARIES -C - CALL WNCFHD(F_P,1,'!40CConvert .DSC tables to usable files') !HEADING - UNID=0 !UNIQUE NAME ID - LSTON=.TRUE. !LIST IN LOG - PRTON=.TRUE. !PRINT COMMENTS - ALGON=.FALSE. !NO ALIGN - CATP=0 !CURRENT AREA TYPE - CALN=-1 !PREVIOUS AREA LINE - CBTP=0 !CURRENT BLOCK TYPE - COFF=0 !CURRENT OFFSET - CALEN=0 !CURRENT ALIGN LENGTH - DEFSN=.FALSE. !NO .DEFINE SEEN - BEGSN=.FALSE. !NO .BEGIN SEEN - PARSN=.FALSE. !NO .PARAMETER SEEN - CINSN=.FALSE. !NO COMMON INIT SEEN - DEP=0 !DEPTH OF BLOCKS - DINC=0 !INCLUDE DEPTH - CLIN=-1 !NO LINE READ - CFLIN=-1 !NO FORMAT LINE READ -C -C SET PARAMETERS -C - CALL WNCTXS(PARM(P_DAT),'!%DN') !INIT DATE - CALL WNGSGU(PARM(P_USE)) !INIT USER - PARM(P_VER)='1' !INIT VERSION - PARM(P_SYS)='1' !INIT SYSTEM - PARM(P_NAM)=' ' !NAME OF FILE -C -C SET DATA SAVE AREAS -C - CALL WNGMVZ(WNTBHDL,IBDES) !CLEAR INPUT LINE BUFFER - IBDES_J(WNTB_ELEN_J)=WNTIHDL - CALL WNGMVZ(WNTIHDL,IENTRY) !MAKE SURE EMPTY ENTRY - CALL WNGMVZ(WNTBHDL,CBDES) !CLEAR COMMENT LINE BUFFER - CBDES_J(WNTB_ELEN_J)=MXSLIN - CALL WNGMVZ(WNTBHDL,VBDES) !CLEAR VALUE BUFFER - VBDES_J(WNTB_ELEN_J)=WNTVHDL - CALL WNGMVZ(WNTBHDL,RBDES) !CLEAR %REVISION BUFFER - RBDES_J(WNTB_ELEN_J)=MXSLIN - CALL WNGMVZ(WNTBHDL,CMDES) !CLEAR %COMMENT BUFFER - CMDES_J(WNTB_ELEN_J)=MXSLIN - CALL WNGMVZ(WNTBHDL,FMDES) !CLEAR %FORTRAN BUFFER - FMDES_J(WNTB_ELEN_J)=MXSLIN - CALL WNGMVZ(WNTBHDL,CCDES) !CLEAR %CC BUFFER - CCDES_J(WNTB_ELEN_J)=MXSLIN - CALL WNGMVZ(WNTBHDL,FEDES) !CLEAR %FORTRAN END BUFFER - FEDES_J(WNTB_ELEN_J)=MXSLIN - CALL WNGMVZ(WNTBHDL,CEDES) !CLEAR %CC END BUFFER - CEDES_J(WNTB_ELEN_J)=MXSLIN - CALL WNGMVZ(WNTBHDL,XFDES) !CLEAR DATA FORMAT BUFFER - XFDES_J(WNTB_ELEN_J)=WNTFHDL - I2=WNTIBP(XFDES,FENTRY) !MAKE SURE NO ZERO PTR - CALL WNGMVZ(WNTBHDL,DFDES) !CLEAR DATA INIT BUFFER - DFDES_J(WNTB_ELEN_J)=WNTDHDL - CALL WNGMVZ(WNTBHDL,EFDES) !CLEAR DATA EDIT BUFFER - EFDES_J(WNTB_ELEN_J)=WNTEHDL - I2=WNTIBP(EFDES,EENTRY) !MAKE SURE NO ZERO PTR -C -C SET INITIAL LOCAL VARIABLES -C - DO I=1,NLVAR !SET LOCAL VARIABLES - IF (.NOT.WNTIVS(LVVAL(I),LVNAM(I),.FALSE.)) THEN - CALL WNCTXT(F_TP,'Fatal -- Cannot intialise local variables') - GOTO 990 - END IF - END DO -C -C GET FILENAME -C - I0=WNCAL0(IFIL) !END OF NAME - I1=I0 - DO WHILE (I1.GT.0) - IF (.NOT.WNCATD(IFIL,I1) .AND. - 1 .NOT.WNCATN(IFIL,I1)) GOTO 10 !FIND BEGIN OF NAME - I1=I1-1 - END DO - 10 CONTINUE - I1=I1+1 !SKIP SEPARATOR - DO I=I1,I0 !ACT ON NAME - IFIL(I:I)=WNCALO(IFIL(I:I)) !MAKE LC - END DO - IF (I1.GT.I0) GOTO 900 !NO NAME GIVEN - IFIL=IFIL(1:WNCALN(IFIL))//'.dsc' !MAKE FULL FILE NAME - PARM(P_NAM)=IFIL(I1:I0) !SET NAME - CALL WNCALC(PARM(P_NAM)) !MAKE LC - CALL WNCFSN(F_P,PARM(P_NAM)(:WNCALN(PARM(P_NAM)))//'.lis') !LOG NAME - CALL WNCAUC(PARM(P_NAM)) !MAKE UC - CALL WNCFHD(F_P,1,'!40CConvert !AS$.DSC table to usable files', - 1 PARM(P_NAM)) - OINFIL=PARM(P_NAM) !ORIGINAL INPUT FILE - CALL WNCALC(OINFIL) !MAKE LC - INFIL=IFIL !FILE TO USE -C -C OPEN FILE -C - 20 CONTINUE - IF (DINC.GE.MXDINC) THEN - CALL WNCTXT(F_TP,'Fatal -- Too many (!UJ) include files', - 1 MXDINC) - GOTO 990 - END IF - CALL WNGLUN(PLUN(DINC+1)) !GET LUN TO USE - IF (PLUN(DINC+1).LE.0) GOTO 910 !CANNOT OPEN - OPEN (UNIT=PLUN(DINC+1),FILE=INFIL,STATUS='OLD',ERR=910) !OPEN INPUT - DINC=DINC+1 !INCREMENT DEPTH -C -C SCAN FILE -C -C READ LINE -C - 300 CONTINUE - IF (CLIN.GE.0) THEN !AT LEAST ONE LINE - IF (IENTRY(WNTI_FTYP_J).GT.0) THEN !A FORMAT BELONGS - FENTRY(WNTF_ENT_J)=CFLIN !POINT TO START COMMENTS - IENTRY(WNTI_PFOR_J)=WNTIBP(XFDES,FENTRY) !SAVE FORMAT NUMBER - CLIN=WNTIBW(IBDES,IENTRY,CLIN) !REWRITE CURRENT LINE - END IF - END IF - 310 CONTINUE - TLIN=' ' !START WITH EMPTY LINE - LLIN=0 - IF (IENTRY(WNTI_FTYP_J).GE.0) CFLIN=CLIN+1 !NEXT START COMMENTS - CALL WNGMVZ(WNTIHDL,IENTRY) !CLEAR INPUT ENTRY - CALL WNGMVZ(WNTFHDL,FENTRY) !EMPTY FORMAT ENTRY - 100 CONTINUE - IF (.NOT.WNTIRL(PLUN(DINC),ISTR,IDAT,ICOM,CONTL)) THEN !EOF/ERROR - IF(.NOT.CONTL) GOTO 930 !ERROR - CLOSE (UNIT=PLUN(DINC),ERR=930) - IF (CLIN.GE.0 .AND. IENTRY(WNTI_FTYP_J).EQ.FT_CON) THEN - CALL WNCTXT(F_TP, - 1 'Fatal -- Missing continuation line at file end') - GOTO 990 - END IF - DINC=DINC-1 !LOWER DEPTH - IF (DINC.LE.0) GOTO 200 !END OF INPUT - GOTO 100 !READ MORE - END IF - IF (LSTON) THEN !LIST ON - CALL WNCTXT(F_P,'!#* !4$ZJ:!16C!AS', - 1 DINC,IBDES_J(WNTB_CNT_J)+1,ISTR) !SHOW LINE - END IF - I0=WNCAL0(IDAT) !LENGTH DATA - I1=WNCAL0(ICOM) !LENGTH COMMENT - IF (I0+LLIN.GT.MXTLIN) THEN !TOO LONG A LINE - CALL WNCTXT(F_TP,'Fatal -- Line too long') - GOTO 990 - END IF - IF (I1.GT.0) IENTRY(WNTI_PCOM_J)=WNTIBP(CBDES,BICOM) !SAVE COMMENT - IF (I0.GT.0) THEN !ADD TO TOTAL LINE - TLIN=TLIN(1:LLIN)//IDAT(1:I0) - LLIN=LLIN+I0 !NEW LENGTH - END IF - IENTRY(WNTI_LCOM_J)=I1 !SET COMMENT LENGTH - IF (CONTL) THEN !SET DATA TYPE - IENTRY(WNTI_FTYP_J)=FT_CON - ELSE - IENTRY(WNTI_FTYP_J)=0 !SET NO FORMAT - END IF - CLIN=WNTIBP(IBDES,IENTRY) !SAVE LINE ENTRY - IF (CONTL) GOTO 100 !CONTINUATION LINE -C -C ANALYSE LINE -C - 400 CONTINUE - J=1 !DATA LINE POINTER - CALL WNCASB(TLIN(1:LLIN),J) !SKIP BLANKS -C -C COMMENT ONLY -C - IF (J.GT.LLIN) THEN !EMPTY DATA - IF (ISTR(1:1).NE.'!' .AND. ISTR.NE.' ' - 1 .AND. CLIN.GT.0) THEN !ASSUME CONT. COMMENT - I=WNTIBR(IBDES,LENTRY,CLIN-1) !PREVIOUS LINE - IF (LENTRY(WNTI_FTYP_J).NE.FT_CON) THEN !NOT CONTINUATION ALREADY - I1=LENTRY(WNTI_FTYP_J) !PREVIOUS TYPE - LENTRY(WNTI_FTYP_J)=FT_CON !SET CONT. - I=WNTIBW(IBDES,LENTRY,I) !REWRITE PREVIOUS LINE ENTRY - IENTRY(WNTI_FTYP_J)=I1 !NEW DATA LENGTH - END IF - ELSE - FENTRY(WNTF_BTYP_J)=CBTP !SET CURRENT BLOCK TYPE - IENTRY(WNTI_FTYP_J)=FT_DAT !SET DATA FORMAT - FENTRY(WNTF_REFP_J)=CLIN !SET LINE REF. - END IF - GOTO 310 !NEXT LINE - END IF -C -C % NAME -C - IF (WNCASC(TLIN(1:LLIN),J,'%')) THEN !% TYPE - IF (.NOT.WNTIAP(TLIN(1:LLIN),J,NAM,CFLIN)) GOTO 920 !ANALYSE IT - IF (NAM.EQ.P__TXT(P_INS) .OR. - 1 NAM.EQ.P__TXT(P_INC)) GOTO 20 !NEXT FILE - GOTO 300 !NEXT LINE - END IF -C -C . NAME -C - IF (WNCASC(TLIN(1:LLIN),J,'.')) THEN !. TYPE - IF (.NOT.WNTIAN(TLIN(1:LLIN),J,NAM,CLIN, - 1 IENTRY,FENTRY)) GOTO 921 !ANALYSE IT - GOTO 300 !NEXT LINE - END IF -C -C FORMAT LINE -C - IF (DEP.GT.0 .OR. CBTP.EQ.BT_PAR) THEN !COULD BE DATA - IF (.NOT.WNTIAF(TLIN(1:LLIN),J,NAM,CLIN, - 1 IENTRY,FENTRY,CFLIN)) GOTO 922 !ANALYSE FORMAT LINE - GOTO 300 !NEXT LINE - END IF - CALL WNCTXT(F_TP,'Fatal -- Unknown input line type') - GOTO 990 -C -C END OF INPUT -C - 200 CONTINUE - IF (IBDES_J(WNTB_CNT_J).LE.0) THEN !NO INPUT - CALL WNCTXT(F_TP,'Fatal -- No input lines') - GOTO 990 - END IF -C -C READY -C - CALL WNTIOS !OUTPUT FILES - CALL WNTIOL !OUTPUT LOG - GOTO 800 -C -C ERRORS -C -C NO NAME -C - 900 CONTINUE - CALL WNCTXT(F_TP,'Fatal -- No or unknown file name given') - GOTO 990 -C -C NO OPEN -C - 910 CONTINUE - CALL WNCTXT(F_TP,'Fatal -- Cannot open file !AS', - 1 INFIL) - GOTO 990 -C -C % FORMAT -C - 920 CONTINUE - CALL WNCTXT(F_TP,'Fatal -- Illegal % name (!AS) or format', - 1 NAM) - GOTO 990 -C -C . FORMAT -C - 921 CONTINUE - CALL WNCTXT(F_TP,'Fatal -- Illegal . name (!AS) or format', - 1 NAM) - GOTO 990 -C -C FORMAT FORMAT -C - 922 CONTINUE - CALL WNCTXT(F_TP,'Fatal -- Illegal format line (!AS)', - 1 NAM) - GOTO 990 -C -C I/O ERROR -C - 930 CONTINUE - CALL WNCTXT(F_TP,'Fatal -- I/O error on file !AS', - 1 INFIL) - GOTO 990 -C - 990 CONTINUE - E_C=0 -C - RETURN -C -C FINISH -C - 800 CONTINUE - E_C=1 -C - RETURN -C -C - END diff --git a/src/wng/wntinc.txt b/src/wng/wntinc.txt deleted file mode 100644 index e3d976b5ff5acb9565de658ef6766c5619659368..0000000000000000000000000000000000000000 --- a/src/wng/wntinc.txt +++ /dev/null @@ -1,450 +0,0 @@ -wntinc.txt draft-5 930902/WNB - - - -1. Introduction - -WNTINC is a replacement for WNTAB. The major changes are based on -comments/remarks made by JPH and MdV, and on deficiencies found by myself. -It has been rewritten to make it more modular and to get rid of any -non-described numerical codes. -Main features: -- calculation on local variables -- multiple structure definitions -- structure definitions inside DEFINE -- structures in data statements -- implicit array lengths -- implicit string lengths -- alignment possibilities -- map/union options (not implemented in this version yet) -- deletion of some unused options -- complete C coverage -- continuation lines - -An example of the use can be found in wnt.dsc - - -2. Input structure - -The input file to WNTINC is a NAME.dsc file. The parameter to WNTINC is -NAME, possibly modified by a directory indication. Whatever the case of -NAME, it will be assumed to reference a lc NAME.dsc. -All input lines will be converted to UC, unless enclosed in "". The output -names will all be UC for Fortran and Unix parameters; lc for Unix variable -names. -Blanks in the following indicate 'white space' (i.e. in general spaces -and/or tabs) - -NAME.dsc will consist of a number of lines. Each line consists of a (possibly -empty) command part, followed by an optional comment part which should be -preceded with an !. A line can be continued by having the last non-blank -character in the command part to be a '\'. -An empty line will be considered to be a comment line; a comment not -starting at the beginning of the line will be considered to be a -continuation of the previous line (whether '\' present or not. (This -is to distinguish comments that should precede fields from comments that -should follow fields)). - -Each command can be: -- empty (i.e. comment line only) - can occur everywhere -- the first non-blank character a '%': commands that steer the behaviour - of the compiling process - can occur everywhere -- the first non-blank character a '.': commands that steer the data - interpretation process - can occur only in 'data-blocks'; except .DEFINE: can occur only - once outside a data-block; .STRUCTURE (.BEGIN) that can occur - inside and outside data-blocks and which define the start of - data-blocks; .PARAMETER that can occur everywhere -- data command (starts always with a '-' (dummy name)) or alphabetic character - - -3. Output files - -WNTINC produces the following output files (NAME is the input file name -name, or set by the %NAME) (all filenames in lc): - -a. If .STRUCTURE type data blocks present: - -- NAME_o.def Fortran include file containing parameters and/or comments - and/or 'structure-type' definitions -- NAME_o.inc C include file containing parameters and/or comments and/or - structure definitions -- NAME_t.def Fortran include file containing information for translating - data structures from one representation to another (using - WNTT* routines) -- NAME_t.inc C include file -- NAME_e.def Fortran include file containing information for formatted - printout and/or input of data structures -- NAME_e.inc C include file - -b. If a .DEFINE data block present, or if no .STRUCTURE and no .DEFINE type - present: - -- NAME.def Fortran include file containing comments, parameters (if no - _o present) and/or common blocks and/or data definitions -- NAME.inc C include file containing the same -- NAME_bd.for Common block data-initialisation (if necessary) - -d. Always: - -NAME.LIS describing: -- the input lines -- the offset in and structure of common blocks and data structures. - - -4. Comment lines - - -Commment outside data blocks will be considered to be comments for the .dsc -file only. -Comments inside data blocks will form part of the program output. Lines -starting with a ! will be output proceeding the data items following. Other -comments will always follow the data items they follow. - - -5. % commands - -%name commands steer the compiling process. Some action may be dependent on -wether it is inside or outside data blocks. The following commands are -recognized: - -%NAME=string name of output files to be used. - Default: input file name -%DATE=yymmdd date of producing output - Default: today -%USER=name name of user - Default: login name -%VERSION=num Current version - Default: 1 -%SYSTEM=num Current system - Default;1 - -%%NAME will show currently defined name -%%DATE .. date -%%USER .. user -%%VERSION .. version -%%SYSTEM .. system - -If more than one of the above commands are encountered, the last will be -used - - -%[NO]LIST list lines in log (e.g. to suppress include file listing) - Default: LIST -%[NO]PRINT list comments in output (not fully implemented) - Default: print -%[NO]ALIGN align data items on their lengths (complex data on - their constituant length; structure on the largest - element length included in the structure) - -The above act as switches - -%INSERT=string include specified file -%INCLUDE=string include specified file - As a rule the string will be of the form NAME_DSF, - referencing an include file name.dsf - -The above are identical - -%COMMENT=string include specified comment at begin of output file -%REVISION=nam=yymmdd=string include specified comment as a revision -%FORTRAN=string include the Fortran statement (e.g. IMPLICIT NONE). - If outside data block: at begin of output; if inside: - at end of output -%CC=string include the C statement - -The above act additive - -%LOCAL=name=expr specify a local variable name with a value expr. - The value of the name can be an integer value, or - a character string. If the expr can be evaluated to - an integer constant it will have an integer value, - else a character string value. - In most places were information has to be supplied it - can be supplied as: - - integer expression: containing known variable names, - integer constants (), +-*/, +- unary - - character expression: single known name with a - character value - - string (anything that cannot be interpreted as - one of the above) - Note: an expression starting with a ( will be - deemed to have been ended at the belonging ). This - is for some formatting reason. - Note: / is only recognised if not preceded and or - followed by blanks. This is to recognize the /../ - initialisation - Examples: - 2. is string "2." - 01 is value 1 (and string "1" if appropiate) - (1)*2 is string "(1)*2" - +(1)*2 is value 2 ("2" string) - -%GLOBAL=name=expr identical to the combination: - %LOCAL=name=expr - .PARAMETER - name tp /expr/ - where tp is either J or C(length expr) - - -6. . commands - -. commands define some aspects of the data commands present. Recognized: - - -.END ends blocks starting with .STRUCTURE, .DEFINE, or - .MAP -.DEFINE starts a 'define-block' - Can only occur once outside a data block (define- - or struct-block). The sub-type will initially be - data -.STRUCTURE[=sname] starts a structure block with name sname or NAME - can occur inside or outside a define-block. Many - structure blocks are allowed, but they may not be - nested (there references (see S:) may, of course, - be nested. - Each structure block should have a unique name - (i.e. only one unnamed allowed). The sub-type - will initially be data -.BEGIN[=sname] identical to .STRUCTURE (for historical reasons) - -The above define the type of current data block. It will define the output -files produced, and which sub-types are allowed. - - -.[OFFSET]=nexpr will define a current offset - Only for structure-blocks; assumed to be in data-sub - For define-blocks allowed in common-sub -.ALIGN=nexpr Align offset on specified lengths (note the program - knows the defined local variables LB_B etc) - Allowed in common-sub en structure data-sub -.MAP[=nexpr] will start equivalence structures -.UNION[=nexpr] will start the next structure to be equivalent - The nexpr will serve as an id that can be used in - the WNT translation tables to get the proper - translation of the data; and is used to generate - a name for C. Definition ends at .END - Can only be used in structure-blocks at data-sub - Note: Not implemented yet, but its action can be - made by the equivalence = (except for the translation - choice option) -.PARAMETER Interprets following data lines as parameters -.DATA Interprets following lines as data -.COMMON[=cname] Interprets following lines as to belong to common - cname_COM (or NAME_COM) - Only in define-block - -7. Data commands - -A data command describes a data-item. It consists of two mandatory fields -separated by blanks, and an optional (obligatory for parameters and implied -lengths) initialisation and an optional editing field (only allowed for -structure data-sub). -A full command is: - - name[=rnam] type [/init, ..../] [<edit>] - -Name can be "-" to indicate a dummy name (to be used for filling) or a name -starting with an alphabetic (including _$) character and having only -alphanumeric characters (including _$). -The name can be followed with an '=' followed by a reference name (not valid -for parameter data). The data will be put at the same offset as the data at -the reference name. Limitations: -- rnam should immediately precede name in the same sub-block, i.e. all names - referencing the same rnam should be continuous after rnam -- name should describe an entity not larger than the entity of rnam -- if in ALIGN mode, the alignment of name should be of the same or lesser - value than that of rnam - -Type describes the data entity. It consists of a type indicator, optionally -followed by an array definition. - -The indicator can be: - - B I1 byte - I I2 integer*2 - J I4 integer*4 - K long integer (for now identical to J) - E R4 real*4 - D R8 real*8 - X complex*8 - Y complex*16 - A double length ASCII - Cnexpr character*(nexpr) - C* character*(*) (length from initialisation - string; hence only allowed for parameters - and data in common-sub or define data-sub - S:name structure as defined by name - A:[([start][,inc])] enumeration(add). If in a data-type mode in - define-block, it will generate a character - string array with an implied length from - the initialisation data, containing the - strings provided and a final ' ' string. - This variable can then be used in e.g. - WNCAFU to do a minimax search for its - occurrence. In addition (and in all other - cases only) it will produce a series of - parameters consisting of pre_txt with - values starting at start and incrementing - with inc, where the txt is the first three - (or less if not existing) characters of the - strings, and pre__N will be defined to give - the number of values+1; pre__I the increment - and pre__L and pre__H the lowest and highest - values. The pre__* - will also be available as local variables. - Default start, inc: 1 - E.g.: - cb E: /structure,define,end/ - will produce: - CHARACTER*(10) CB__TXT(4) - DATA CB__TXT/'STRUCTURE','DEFINE','END',' '/ - INTEGER CB_STR,CB_DEF,CB_END,CB__N, - CB__I,CB__H,CB__L - PARAMETER(CB_STR=1,CB_DEF=2,CB_END=3, - CB__N=4,CB__I=1,CB__L=1,CB__H=3) - AR:[([start][,inc])] as A:, but the parameter names will be *_pre - M:[([start][,fac])] enumeration(mul). As A:, but multiplicative - rather than additive. - Default start, fac: 1, 2 - MR:[([start][,fac])] as M:, but *_pre parameters - N:[(val,...)] enumeration(named). As A:, but values are - specified (up to number of array indices - allowed, currently 16). - Default val: 1,2,3,... - Note: No __H,__L and __I produced - NR:[(val,...)] as N:, but *_pre parameters - - [A|M|N][R][F][*]:[...] as A: M: or N:, but Reversed name_ if R present, - full name (rather than 3 first characters) - if F present, no __ names and text if * present. - - - - -Array specification: - - (nexpr[:nexpr],....) The last index (i.e. the high-bound) can be -specified as '*' to indicate an implied length to be deduced from the -initialisation string (if this was allowed). All format types except -A:, M: and N: can have an array index. - - -Initialisation data: - - /init, .../ each init can be an expression, or (nexpr)init. In the -latter case the (nexpr) gives a repeat factor. -If the format was character and the string contains blanks, ',' '/' or -anything that can be but should not be interpreted as an expression (e.g. -'02' which may not be converted to '2'), or is case sensitive, it should be -enclosed in "". - - -Edit data: - - <format,code,units,special> - -Each field may be omitted, trailing ',' may be omitted. - format: WNCTXT (WNCTXI) type format (e.g. AEF12.6) - Default: deduced from item - code: 0: editing of field allowed, >0: not allowed - Default: 0 - units: string specifying units (e.g. "deg") - Default: " " - special: string to indicate something special defined by user - of edit data (e.g. if formatting types are not - sufficient, e.g. to type interferometer names) - Default: " " - The special field is used for S: fields, the default - will be "S:NAME". By definition the user can put - anything in it. The only definition I have now is: - "D:NAME" for a field containing a disk pointer to - to a structure NAME. The editing routine will be - extended to recognise these special codes. - -8. Program changes, omissions - -The following features are not fully implemented yet: - -- initialisation of structures (relatively easy, will do soon) -- MAP/UNION: the = feature caters for everything except the run-time choice - of translation table. This last feature is probably dangerous anyway. - If the need arises, easily to implement. -- C: I have only tested that the .inc files look ok, and are all accepted - by the C compilers. - -The following existing programs need changes: - -- ncomp/ndel.ssc: to change to WNTINC: done -- no _m.mvx output: use existing ones by preserving them. If the f??.dsc files - change, the .mvx has to change. However, the DECalpha has a different - assembler from the VAX, and changes are necessary anyway in the - existing Macro programs (i.e. the I/O routines). - I have done the preservation, and will look at changing the Macro - programs to Fortran. -- no .RECORD: it has been enhanced by the S: data item: scw.dsc and ohw.dsc - uses this: change done -- output now _o.inc rather than -c.inc to get uniform naming: wnf I/O - routines have to change: done - - -9. Detailed program output - - -The output of the program consist of: -- parameters -- structure definitions -- data definitions -- common defintions -- translation tables -- edit tables - -- Parameters - -Parameters are output in Fortran as PARAMETER, with name and type as given. -In C as #define NAME init-text -Note: Maybe they should be given as: - #define NAME (cast) init-text ?? comments please -For A:, M:, N: type the following INTEGER PARAMETERs are produced: - NAME__N # of items in list +1 (==first available - element). Also available as local variable - NAME__L First value (not for N:) - NAME__H Last value (not for N:) - NAME__I Increment(A:) or factor(M:) - NAME_txt For each non-empty init-txt (i.e. not ,, or ,/) - the first 3 char of the text (or less if - shorter text) are taken as txt. - -- Structure definitions - -Structure definitions are given in C as: - struct struct-name { type name [indices]; ,,,}; -All names in lc; indices in reversed order from Fortran. -In Fortran each given name is combined with the struct-name sname to -produce the following INTEGER PARAMETERs: - SNAME__L Byte length of structure - SNAME__V Version - SNAME__S System -In the edit output: - SNAME__EL Length of edit arrays -The above are also available as %LOCAL constants -For historic reasons also available: - snameHDL - snameHDV - snameHDS - snameEDL -For all structure elements: - SNAME_NAME_1 Byte offset from start of structure -In addition for CHARACTER data: - SNAME_NAME_N Length in characters -for STRUCTURE data: - SNAME_NAME_N Length in bytes -for all if the offset from the beginning is an integer multiple of the unit -size of the data type (e.g. LB_J=4 for INTEGER; structure length for structure): - SNAME_NAME_type Offset in unit-length units from start - of structure. Types are the types as given - in the definition (C,J,E,Y,S etc) - - - diff --git a/src/wng/wntio0.for b/src/wng/wntio0.for deleted file mode 100644 index 9457d01d5ce3b366416b19d1cd4b47e14b264689..0000000000000000000000000000000000000000 --- a/src/wng/wntio0.for +++ /dev/null @@ -1,80 +0,0 @@ -C+ WNTIO0.FOR -C WNB 930501 -C -C Revisions: -C - SUBROUTINE WNTIO0(TP,FENTJ,STR) -C -C Obtain array indices string -C -C Result: -C -C CALL WNTIO0( TP_J:I, FENTJ_S:I, STR_C*:O) -C Using TP (0=Fortran, else C) produce an array string -C using the data entry FENTJ in STR -C -C Include files: -C - INCLUDE 'WNG_DEF' - INCLUDE 'WNT_O_DEF' -C -C Parameters: -C -C -C Arguments: -C - INTEGER TP !FORTRAN(0)/C - INTEGER FENTJ(0:*) !DATA STRUCTURE - CHARACTER*(*) STR !OUTPUT STRING -C -C Function references: -C - INTEGER WNCALN !STRING LENGTH -C -C Data declarations: -C -C- -C -C INIT -C - STR=' ' !ARRAY STRING - IF (FENTJ(WNTF_DIM_J).GT.0) THEN !ARRAY -C -C FORTRAN -C - IF (TP.EQ.0) THEN - STR='(' !INDEX STRING - DO I3=0,FENTJ(WNTF_DIM_J)-1 !ALL DIMENSIONS - J=WNCALN(STR)+1 !PTR STRING - CALL WNCTXS(STR(J:),'!SJ:!SJ,', - 1 FENTJ(WNTF_IND_J+2*I3), - 1 FENTJ(WNTF_IND_J+2*I3)+ - 1 FENTJ(WNTF_IND_J+2*I3+1)-1) !INDICES - END DO - J=WNCALN(STR) !PTR STRING - STR(J:J)=')' -C -C C -C - ELSE !C - STR=' ' !INDEX STRING - DO I3=FENTJ(WNTF_DIM_J)-1,0,-1 !ALL DIMENSIONS - J=WNCALN(STR)+1 !PTR STRING - CALL WNCTXS(STR(J:),'[!SJ]', - 1 FENTJ(WNTF_IND_J+2*I3+1)) !INDEX LENGTH - END DO - IF (FENTJ(WNTF_DTP_J).EQ.T_X .OR. - 1 FENTJ(WNTF_DTP_J).EQ.T_Y) THEN !COMPLEX - J=WNCALN(STR)+1 !PTR STRING - STR(J:)='[2]' - END IF -C -C READY -C - END IF !FORTRAN/C - END IF !ARRAY -C - RETURN -C -C - END diff --git a/src/wng/wntio1.for b/src/wng/wntio1.for deleted file mode 100644 index 87d6028dfbf6ea0b261f69f71721814752206985..0000000000000000000000000000000000000000 --- a/src/wng/wntio1.for +++ /dev/null @@ -1,50 +0,0 @@ -C+ WNTIO1.FOR -C WNB 930501 -C -C Revisions: -C - SUBROUTINE WNTIO1(TP,FENTB,CNAM,UC,LC) -C -C Get name of data -C -C Result: -C -C CALL WNTIO1( TP_J:I, FENTB_S:I, CNAM_C*:I, UC_C*:O, LC_C:*:O) -C Get Upper and LowerCase name from data structure -C FENTB. (TP irrelevant) -C CNAM is used to generate a unique name -C -C Include files: -C - INCLUDE 'WNG_DEF' - INCLUDE 'WNT_O_DEF' -C -C Parameters: -C -C -C Arguments: -C - INTEGER TP !FORTRAN(0)/C - BYTE FENTB(0:*) !DATA STRUCTURE - CHARACTER*(*) CNAM !COMMON NAME - CHARACTER*(*) UC !UPPER CASE NAME - CHARACTER*(*) LC !LOWER CASE NAME -C -C Function references: -C -C -C Data declarations: -C -C- - CALL WNGMTS(WNTF_NAM_N,FENTB(WNTF_NAM_1),UC) !NAME - IF (UC(1:1).EQ.'-') THEN !NO NAME - CALL WNCTXS(LC,'!AS!AS',CNAM,UC(2:)) !MAKE NAME - UC=LC - END IF - LC=UC !LC - CALL WNCALC(LC) -C - RETURN -C -C - END diff --git a/src/wng/wntio2.for b/src/wng/wntio2.for deleted file mode 100644 index 5498ba6904b20dd9a7206ff7fd47e30b8cf67696..0000000000000000000000000000000000000000 --- a/src/wng/wntio2.for +++ /dev/null @@ -1,290 +0,0 @@ -C+ WNTIO2.FOR -C WNB 930501 -C -C Revisions: -C - SUBROUTINE WNTIO2(TP,F,FENTB,FENTJ,CNAM) -C -C Output data line -C -C Result: -C -C CALL WNTIO2( TP_J:I, F(0:1)_J:I, FENTB_S:I, FENTJ_S:I, CNAM_C*:I) -C Output a data line for Fortran(TP=0) or C (TP=1) on -C device F(TP) using data structure FENT and common -C block name CNAM -C CALL WNTIO3( TP_J:I, F(0:1)_J:I, FENTB_S:I, FENTJ_S:I, CNAM_C*:I) -C Output data line including initialisation data -C CALL WNTIO4( TP_J:I, F(0:1)_J:I, FENTB_S:I, FENTJ_S:I, CNAM_C*:I) -C Output comment only line -C -C Include files: -C - INCLUDE 'WNG_DEF' - INCLUDE 'WNT_O_DEF' - INCLUDE 'WNT_DEF' -C -C Parameters: -C -C -C Arguments: -C - INTEGER TP !FORTRAN/C - INTEGER F(0:1) !FORTRAN/C FILE - BYTE FENTB(0:*) !DATA STRUCTURE - INTEGER FENTJ(0:*) - CHARACTER*(*) CNAM !COMMON NAME -C -C Function references: -C - INTEGER WNCALN !STRING LENGTH - INTEGER WNTIBR !READ DATA ENTRY -C -C Data declarations: -C - LOGICAL IO3 !DO DATA INIT OUTPUT - INTEGER NCOM !COMMENT LINE COUNT - CHARACTER*80 LIN1 !LINE - CHARACTER*(MXLNAM) LNAM !ARRAY STRING - CHARACTER*(MXLNAM) LNAM1,LNAM2 !ENTITY NAME - CHARACTER*(MXLNAM) LCNAM !LC NAME - BYTE DENTB(0:WNTDHDL-1) !DATA INIT ENTRY - INTEGER DENTJ(0:WNTDHDL/LB_J-1) - EQUIVALENCE (DENTB,DENTJ) - BYTE LFENTB(0:WNTFHDL-1) !DATA ENTRY - INTEGER LFENTJ(0:WNTFHDL/LB_J-1) - EQUIVALENCE (LFENTB,LFENTJ) - BYTE LIENTB(0:WNTIHDL-1) !LINE ENTRY - INTEGER LIENTJ(0:WNTIHDL/LB_J-1) - EQUIVALENCE (LIENTB,LIENTJ) - BYTE LCENTB(0:MXSLIN-1) !COMMENT ENTRY - CHARACTER*(MXSLIN) LCENTC - EQUIVALENCE (LCENTB,LCENTC) -C- -C -C IO2 -C - IO3=.FALSE. !NO INIT - GOTO 10 -C -C IO3 -C - ENTRY WNTIO3(TP,F,FENTB,FENTJ,CNAM) -C - IO3=.TRUE. - GOTO 10 -C -C OUTPUT -C - 10 CONTINUE - IF (FENTJ(WNTF_DTP_J).EQ.0) GOTO 20 !COMMENT ONLY - CALL WNTIO0(TP,FENTJ,LNAM) !GET ARRAY INDICES - CALL WNTIO1(TP,FENTB,CNAM,LNAM1,LCNAM) !GET NAME - NCOM=0 !COMMENT COUNT - IF (FENTJ(WNTF_DTP_J).EQ.T_S) THEN !STRUCTURE - I2=WNTIBR(XFDES,LFENTB,FENTJ(WNTF_SREF_J)) !GET REF. RECORD - IF (TP.EQ.0) THEN !FORTRAN - IF (LNAM.EQ.' ') THEN - LNAM=')' !MAKE SURE ) - ELSE - LNAM(1:1)=',' - END IF - CALL WNCTXS(LCENTC,'!@!AS !AS(0:!UJ!AS', - 1 CD(FENTJ(WNTF_DTP_J)), - 1 LNAM1,LFENTJ(WNTF_TLEN_J)-1,LNAM) - CALL WNTIO6(F,TP,LCENTC,FENTJ,LIENTB,NCOM) !SHOW WITH COMMENT - DO I=1,T__N-1 !ALL EQUIVALENCES - IF (LFENTJ(WNTF_TLEN_J).GE.CD2(I) .AND. - 1 CD2(I).NE.0 .AND. - 1 CD1(I).NE.'S' .AND. CD1(I).NE.'C' .AND. - 1 CD1(I).NE.'A') THEN - IF (MOD(LFENTJ(WNTF_TLEN_J),CD2(I)).EQ.0) THEN - CALL WNCTXS(LCENTC,'!@ !AS !AS_!AS(0:!UJ!AS', - 1 CD(I), - 1 LNAM1,CD1(I),LFENTJ(WNTF_TLEN_J)/CD2(I)-1,LNAM) - CALL WNTIO6(F,TP,LCENTC,FENTJ,LIENTB,NCOM) !SHOW WITH COMMENT - CALL WNCTXS(LCENTC,'!@ EQUIVALENCE '// - 1 '(!AS,!AS_!AS)', - 1 LNAM1,LNAM1,CD1(I)) - CALL WNTIO6(F,TP,LCENTC,FENTJ,LIENTB,NCOM) !SHOW WITH COMMENT - END IF - END IF - END DO - IF (LNAM.EQ.')') THEN - LNAM=' ' - ELSE - LNAM(1:1)='(' - END IF - CALL WNCTXS(LCENTC,'!@ CHARACTER*(!UJ) !AS_!AS!AS', - 1 LFENTJ(WNTF_TLEN_J), - 1 LNAM1,'C',LNAM) - CALL WNTIO6(F,TP,LCENTC,FENTJ,LIENTB,NCOM) !SHOW WITH COMMENT - CALL WNCTXS(LCENTC,'!@ EQUIVALENCE '// - 1 '(!AS,!AS_!AS)', - 1 LNAM1,LNAM1,'C') - CALL WNTIO6(F,TP,LCENTC,FENTJ,LIENTB,NCOM) !SHOW WITH COMMENT - IF (IO3 .AND. FENTJ(WNTF_NINI_J).GT.0) THEN !DATA INIT - END IF !!DATA INIT - ELSE !C - CALL WNTIO1(TP,LFENTB,CNAM,LNAM1,LNAM2) !GET REFERENCE NAME - CALL WNCTXS(LCENTC,'!@!AS !AS !AS!AS;', - 1 UD(FENTJ(WNTF_DTP_J)), - 1 LNAM2,LCNAM,LNAM) - CALL WNTIO6(F,TP,LCENTC,FENTJ,LIENTB,NCOM) !SHOW WITH COMMENT - IF (IO3 .AND. FENTJ(WNTF_NINI_J).GT.0) THEN !DATA INIT - END IF !!DATA INIT - END IF !FORTRAN/C - CALL WNTIO7(F,TP,LCENTC,FENTJ,LIENTB,NCOM) !FINAL COMMENTS - ELSE IF (FENTJ(WNTF_DTP_J).NE.T_C) THEN !NUMERIC - IF (TP.EQ.0) THEN !FORTRAN - CALL WNCTXS(LCENTC,'!@!AS !AS!AS', - 1 CD(FENTJ(WNTF_DTP_J)), - 1 LNAM1,LNAM) - CALL WNTIO6(F,TP,LCENTC,FENTJ,LIENTB,NCOM) !SHOW WITH COMMENT - IF (IO3 .AND. FENTJ(WNTF_NINI_J).GT.0) THEN !DATA INIT - CALL WNCTXS(LIN1,'!@ DATA !AS /', - 1 LNAM1) - I4=WNCALN(LIN1) !LENGTH FILLED - DO I3=FENTJ(WNTF_INIP_J),FENTJ(WNTF_INIP_J)+ - 1 FENTJ(WNTF_NINI_J)-1 !DO ALL ENTRIES - I2=WNTIBR(DFDES,DENTB,I3) !GET DATA - IF (I4.GE.COMPOS-10) THEN !MORE LINES - CALL WNTIO6(F,TP,LIN1,FENTJ,LIENTB,NCOM) !SHOW WITH COMMENT - CALL WNCTXS(LIN1,'!@&!_,') - I4=WNCALN(LIN1)-1 - END IF - IF (DENTJ(WNTD_REP_J).GT.1) THEN !SET REPEAT - CALL WNCTXS(LIN1(I4+1:),'!UJ$*', - 1 DENTJ(WNTD_REP_J)) - I4=WNCALN(LIN1) - END IF - CALL WNCTXS(LIN1(I4+1:),'!AD,', - 1 DENTB(WNTD_STR_1),WNTD_STR_N) !VALUE - I4=WNCALN(LIN1) - END DO - LIN1(I4:I4)='/' !LAST LINE - CALL WNTIO6(F,TP,LIN1,FENTJ,LIENTB,NCOM) !SHOW WITH COMMENT - END IF - ELSE !C - IF (IO3 .AND. FENTJ(WNTF_NINI_J).GT.0) THEN !DATA INIT - CALL WNCTXS(LIN1,' static !AS !AS!AS = {', - 1 UD(FENTJ(WNTF_DTP_J)), - 1 LCNAM,LNAM) - I4=WNCALN(LIN1) !LENGTH FILLED - DO I3=FENTJ(WNTF_INIP_J),FENTJ(WNTF_INIP_J)+ - 1 FENTJ(WNTF_NINI_J)-1 !DO ALL ENTRIES - I2=WNTIBR(DFDES,DENTB,I3) !GET DATA - DO I2=1,DENTJ(WNTD_REP_J) !SET REPEAT - IF (I4.GE.COMPOS-10) THEN !MORE LINES - CALL WNTIO6(F,TP,LIN1,FENTJ,LIENTB,NCOM) !SHOW COMMENT - CALL WNCTXS(LIN1,'!@!_$,') - I4=WNCALN(LIN1)-1 - END IF - CALL WNCTXS(LIN1(I4+1:),'!AD,', - 1 DENTB(WNTD_STR_1),WNTD_STR_N) !VALUE - I4=WNCALN(LIN1) - END DO - END DO - LIN1(I4:)='};' !LAST LINE - CALL WNTIO6(F,TP,LIN1,FENTJ,LIENTB,NCOM) !SHOW WITH COMMENT - ELSE !NO INIT - CALL WNCTXS(LCENTC,'!@!AS !AS!AS$;', - 1 UD(FENTJ(WNTF_DTP_J)), - 1 LCNAM,LNAM) - CALL WNTIO6(F,TP,LCENTC,FENTJ,LIENTB,NCOM) !SHOW WITH COMMENT - END IF !DATA INIT - END IF !FORTRAN/C - CALL WNTIO7(F,TP,LCENTC,FENTJ,LIENTB,NCOM) !FINAL COMMENTS - ELSE !CHARACTER - IF (TP.EQ.0) THEN !FORTRAN - CALL WNCTXS(LCENTC,'!@!AS$*!UJ !AS!AS', - 1 CD(FENTJ(WNTF_DTP_J)), - 1 FENTJ(WNTF_SLEN_J),LNAM1,LNAM) - CALL WNTIO6(F,TP,LCENTC,FENTJ,LIENTB,NCOM) !SHOW WITH COMMENT - IF (IO3 .AND. FENTJ(WNTF_NINI_J).GT.0) THEN !DATA INIT - CALL WNCTXS(LIN1,'!@ DATA !AS /', - 1 LNAM1) - I4=WNCALN(LIN1) !LENGTH FILLED - DO I3=FENTJ(WNTF_INIP_J),FENTJ(WNTF_INIP_J)+ - 1 FENTJ(WNTF_NINI_J)-1 !DO ALL ENTRIES - I2=WNTIBR(DFDES,DENTB,I3) !GET DATA - IF (I4.GE.COMPOS-10) THEN !MORE LINES - CALL WNTIO6(F,TP,LIN1,FENTJ,LIENTB,NCOM) !SHOW WITH COMMENT - CALL WNCTXS(LIN1,'!@&!_,') - I4=WNCALN(LIN1)-1 - END IF - IF (DENTJ(WNTD_REP_J).GT.1) THEN !SET REPEAT - CALL WNCTXS(LIN1(I4+1:),'!UJ$*', - 1 DENTJ(WNTD_REP_J)) - I4=WNCALN(LIN1) - END IF - CALL WNCTXS(LIN1(I4+1:),'''!AD '',', - 1 DENTB(WNTD_STR_1),WNTD_STR_N) !VALUE - I4=WNCALN(LIN1) - END DO - LIN1(I4:I4)='/' !LAST LINE - CALL WNTIO6(F,TP,LIN1,FENTJ,LIENTB,NCOM) !SHOW WITH COMMENT - END IF - ELSE !C - IF (IO3 .AND. FENTJ(WNTF_NINI_J).GT.0) THEN !DATA INIT - CALL WNCTXS(LIN1,' static !AS !AS!AS$[!UJ] = {', - 1 UD(FENTJ(WNTF_DTP_J)), - 1 LCNAM,LNAM,FENTJ(WNTF_SLEN_J)) - I4=WNCALN(LIN1) !LENGTH FILLED - DO I3=FENTJ(WNTF_INIP_J),FENTJ(WNTF_INIP_J)+ - 1 FENTJ(WNTF_NINI_J)-1 !DO ALL ENTRIES - I2=WNTIBR(DFDES,DENTB,I3) !GET DATA - DO I2=1,DENTJ(WNTD_REP_J) !SET REPEAT - IF (I4.GE.COMPOS-10) THEN !MORE LINES - CALL WNTIO6(F,TP,LIN1,FENTJ,LIENTB,NCOM) !SHOW COMMENT - CALL WNCTXS(LIN1,'!@!_$,') - I4=WNCALN(LIN1)-1 - END IF - CALL WNCTXS(LIN1(I4+1:),'"!AD ",', - 1 DENTB(WNTD_STR_1),WNTD_STR_N) !VALUE - I4=WNCALN(LIN1) - END DO - END DO - LIN1(I4:)='};' !LAST LINE - CALL WNTIO6(F,TP,LIN1,FENTJ,LIENTB,NCOM) !SHOW WITH COMMENT - ELSE !NO INIT - CALL WNCTXS(LCENTC,'!@!AS !AS!AS$[!UJ];', - 1 UD(FENTJ(WNTF_DTP_J)), - 1 LCNAM,LNAM,FENTJ(WNTF_SLEN_J)) - CALL WNTIO6(F,TP,LCENTC,FENTJ,LIENTB,NCOM) !SHOW WITH COMMENT - END IF !DATA INIT - END IF - CALL WNTIO7(F,TP,LCENTC,FENTJ,LIENTB,NCOM) !FINAL COMMENTS - END IF !NUMERIC/CHARACTER -C -C READY -C - RETURN -C -C IO4 -C - ENTRY WNTIO4(TP,F,FENTB,FENTJ,CNAM) -C -C READ LINE ENTRY -C - 20 CONTINUE - I2=WNTIBR(IBDES,LIENTB,FENTJ(WNTF_REFP_J)) - IF (LIENTJ(WNTI_LCOM_J).EQ.0) THEN !BLANK LINE - IF (TP.EQ.0) THEN !FORTRAN - CALL WNCTXT(F(TP),'C') - ELSE !C - CALL WNCTXT(F(TP),'/*!78C */') - END IF - ELSE - I2=WNTIBR(CBDES,LCENTB,LIENTJ(WNTI_PCOM_J)) !READ COMMENT - IF (TP.EQ.0) THEN !FORTRAN - CALL WNCTXT(F(TP),'C !AD',LCENTB,LIENTJ(WNTI_LCOM_J)) - ELSE !C - CALL WNCTXT(F(TP),'/* !AD!78C */',LCENTB,LIENTJ(WNTI_LCOM_J)) - END IF - END IF -C - RETURN -C -C - END diff --git a/src/wng/wntio5.for b/src/wng/wntio5.for deleted file mode 100644 index 50748bc57e8eaa9db3465c9973749014d4206b7f..0000000000000000000000000000000000000000 --- a/src/wng/wntio5.for +++ /dev/null @@ -1,87 +0,0 @@ -C+ WNTIO5.FOR -C WNB 930501 -C -C Revisions: -C - LOGICAL FUNCTION WNTIO5(FENTJ,IENTJ,N,LCOMB,LCOMM) -C -C Give a comment line -C -C Result: -C -C WNTIO5_L = WNTIO5( FENTJ_J(0:*), IENTJ_J(0:*), N_J:IO, -C LCOMB_B(0:*), LCOMM_C*:O) -C Give next comment line (initially N=0, used -C as count) for current Format ENTry in -C LCOM. WNTIO5 is .false. if no comment -C present; N<0 if no more comment lines -C -C Include files: -C - INCLUDE 'WNG_DEF' - INCLUDE 'WNT_O_DEF' - INCLUDE 'WNT_DEF' -C -C Parameters: -C -C -C Arguments: -C - INTEGER FENTJ(0:*) !FORMAT ENTRY - INTEGER IENTJ(0:*) !INPUT LINE ENTRY - INTEGER N !COMMENT LINE COUNT - CHARACTER*(*) LCOMM !COMMENT - BYTE LCOMB(0:*) -C -C Function references: -C - INTEGER WNTIBR !READ ENTRY -C -C Data declarations: -C -C- - WNTIO5=.TRUE. !ASSUME OK - LCOMM=' ' !COMMENT - IF (N.LT.0) GOTO 900 !WERE ALREADY READY - IF (N.EQ.0) THEN !GET FIRST - IF (FENTJ(WNTF_ENT_J).GT.0) THEN !LINE ENTRY - I2=WNTIBR(IBDES,IENTJ,FENTJ(WNTF_ENT_J)) !READ LINE - IF (IENTJ(WNTI_LCOM_J).GT.0) THEN !COMMENT PRESENT - I2=WNTIBR(CBDES,LCOMB,IENTJ(WNTI_PCOM_J)) !READ IT - ELSE - WNTIO5=.FALSE. !NO COMMENT - END IF - N=N+1 !COUNT IT - ELSE !NONE AT ALL - N=-1 - GOTO 900 - END IF - ELSE - I=FENTJ(WNTF_ENT_J)+N !COMMENT ENTRY - IF (IENTJ(WNTI_FTYP_J).EQ.FT_CON) THEN !MORE COMMENTS - I2=WNTIBR(IBDES,IENTJ,I) !READ LINE - IF (IENTJ(WNTI_LCOM_J).GT.0) THEN !COMMENT PRESENT - I2=WNTIBR(CBDES,LCOMB,IENTJ(WNTI_PCOM_J)) !READ IT - ELSE - WNTIO5=.FALSE. !NO COMMENT - END IF - N=N+1 - ELSE - N=-1 !READY - GOTO 900 - END IF - END IF !ENTRY -C -C READY -C - RETURN -C -C ERRORS -C - 900 CONTINUE - WNTIO5=.FALSE. -C - RETURN -C -C - END diff --git a/src/wng/wntio6.for b/src/wng/wntio6.for deleted file mode 100644 index e92c5826b1b0f7ce67a4b4795f7a2e570be6d229..0000000000000000000000000000000000000000 --- a/src/wng/wntio6.for +++ /dev/null @@ -1,99 +0,0 @@ -C+ WNTIO6.FOR -C WNB 930501 -C -C Revisions: -C - SUBROUTINE WNTIO6(F,TP,LIN1,FENTJ,IENTJ,N) -C -C Output a comment line attached to code -C -C Result: -C -C CALL WNTIO6( F_J(0:1):I, TP_J:I, LIN1_C*:I, FENTJ_J(0:*), IENTJ_J(0:*), -C N_J:IO) -C Output next comment line (initially N=0, used -C as count) for current Format ENTry added to -C code text in LIN1; using TP (0=Fortran, 1=C) -C and file indicator F. -C CALL WNTIO7( F_J(0:1):I, TP_J:I, LIN1_C*:I, FENTJ_J(0:*), IENTJ_J(0:*), -C N_J:IO) -C Output any remaining format lines for -C current FENT (LIN1 not used) -C -C Include files: -C - INCLUDE 'WNG_DEF' - INCLUDE 'WNT_O_DEF' -C -C Parameters: -C -C -C Arguments: -C - INTEGER F(0:1) !FILE INDICATOR - INTEGER TP !FILE TYPE (FORTRAN/C) - CHARACTER*(*) LIN1 !LINE OF CODE - INTEGER FENTJ(0:*) !FORMAT ENTRY - INTEGER IENTJ(0:*) !INPUT LINE ENTRY - INTEGER N !COMMENT LINE COUNT -C -C Function references: -C - INTEGER WNCALN !STRING LENGTH - INTEGER WNTIBR !READ ENTRY - LOGICAL WNTIO5 !GET COMMENT DATA -C -C Data declarations: -C - BYTE LCENTB(0:MXSLIN-1) !COMMENT DATA - CHARACTER*(MXSLIN) LCENTC - EQUIVALENCE (LCENTB,LCENTC) -C- -C -C WNTIO6 -C - IF (WNTIO5(FENTJ,IENTJ,N,LCENTB,LCENTC)) THEN !COMMENT PRESENT - IF (WNCALN(LIN1).GE.COMPOS-1) THEN - IF (TP.EQ.0) THEN !FORTRAN - CALL WNCTXT(F(TP),'!AS !! !AS', - 1 LIN1,LCENTC) - ELSE !C - CALL WNCTXT(F(TP),'!AS /* !AS */', - 1 LIN1,LCENTC) - END IF - ELSE - IF (TP.EQ.0) THEN !FORTRAN - CALL WNCTXT(F(TP),'!AS!#C!! !AS', - 1 LIN1,COMPOS,LCENTC) - ELSE !C - IF (LIN1(1:1).EQ.CHAR(9)) THEN - CALL WNCTXT(F(TP),'!AS!#C/* !AS */', - 1 LIN1,COMPOS,LCENTC) - ELSE - CALL WNCTXT(F(TP),'!AS!#C/* !AS */', - 1 LIN1,COMPOS+7,LCENTC) - END IF - END IF - END IF - ELSE !NO COMMENT - CALL WNCTXT(F(TP),'!AS',LIN1) - END IF -C - RETURN -C -C WNTIO7 -C - ENTRY WNTIO7(F,TP,LIN1,FENTJ,IENTJ,N) -C - DO WHILE (WNTIO5(FENTJ,IENTJ,N,LCENTB,LCENTC)) !MORE COMMENT LINES - IF (TP.EQ.0) THEN !FORTRAN - CALL WNCTXT(F(TP),'!@!#C!! !AS',COMPOS,LCENTC) - ELSE !C - CALL WNCTXT(F(TP),'!@!#C/* !AS */',COMPOS,LCENTC) - END IF - END DO -C - RETURN -C -C - END diff --git a/src/wng/wntiol.for b/src/wng/wntiol.for deleted file mode 100644 index 8fa86351b6edc189812e9ebc12c9885f012536bd..0000000000000000000000000000000000000000 --- a/src/wng/wntiol.for +++ /dev/null @@ -1,221 +0,0 @@ -C+ WNTIOL.FOR -C WNB 930501 -C -C Revisions: -C - SUBROUTINE WNTIOL -C -C Output .DSC structures in log -C -C Result: -C -C CALL WNTIOL outputs the structure and common parts of the .DSC -C output in log, to give overview of offsets -C -C Include files: -C - INCLUDE 'WNG_DEF' - INCLUDE 'WNT_O_DEF' - INCLUDE 'WNT_DEF' -C -C Parameters: -C -C -C Arguments: -C -C -C Function references: -C - INTEGER WNCALN !STRING LENGTH - INTEGER WNTIBR !READ ENTRY - LOGICAL WNTIO5 !GET COMMENT LINE -C -C Data declarations: -C - INTEGER OF1,OF2 !PRINT OFFSETS - INTEGER NCOM !COMMENT COUNT - CHARACTER*(MXLNAM) LNAM,LNAM1,LNAM2,LNAM3 !LOCAL DATA - CHARACTER*(MXLNAM) LCNAM !LC NAME - CHARACTER*(MXLNAM) CNAM !COMMON NAME - CHARACTER*(MXSLIN) LCOMM !OUTPUT COMMENT - BYTE LCOMB(0:MXSLIN-1) - EQUIVALENCE (LCOMM,LCOMB) - BYTE FENTB(0:WNTFHDL-1) !FORMAT ENTRY - INTEGER FENTJ(0:WNTFHDL/LB_J-1) - EQUIVALENCE (FENTB,FENTJ) - BYTE LFENTB(0:WNTFHDL-1) !LOCAL FORMAT ENTRY - INTEGER LFENTJ(0:WNTFHDL/LB_J-1) - EQUIVALENCE (LFENTB,LFENTJ) - BYTE LIENTB(0:WNTIHDL-1) !LOCAL LINE ENTRY - INTEGER LIENTJ(0:WNTIHDL/LB_J-1) - EQUIVALENCE (LIENTB,LIENTJ) -C- -C -C INIT -C - OF1=3 !PRINT OFFSETS - OF2=19 - CALL WNCFHD(F_P,5,'!7COffset!20CName!40CType!65CLength'// - 1 '!75CDescription') - CALL WNCFHD(F_P,6,' ') -C -C OUTPUT COMMONS -C - IF (DEFSN) THEN !COULD BE COMMON - CNAM=' ' !NO COMMON - DO I1=0,XFDES_J(WNTB_CNT_J)-1 !ALL ENTRIES - I2=WNTIBR(XFDES,FENTB,I1) !READ ENTRY - IF (FENTJ(WNTF_BTYP_J).EQ.BT_DCM) THEN !NEW COMMON - CALL WNTIO1(0,FENTB,CNAM,CNAM,LCNAM) !GET NAME - CALL WNCFHD(F_P,3,'!16CContents of !AS_COM'// - 1 ' (Length= !UJ User= !AS,'// - 1 ' Date= !AS, Version= !AS, System= !AS)', - 1 CNAM,FENTJ(WNTF_TLEN_J),PARM(P_USE),PARM(P_DAT), - 1 PARM(P_VER),PARM(P_SYS)) - CALL WNCTXT(F_P,'!^') !NEW PAGE - ELSE IF (FENTJ(WNTF_BTYP_J).EQ.BT_COM .AND. - 1 FENTJ(WNTF_DTP_J).NE.0 .AND. - 1 FENTB(WNTF_NAM_1).NE.ICHAR('-')) THEN - CALL WNTIO0(0,FENTJ,LNAM) !ARRAY STRING - IF (FENTJ(WNTF_REFP_J).GT.0 .AND. - 1 FENTJ(WNTF_REFP_J).LT.I1) THEN != REFERENCE - I2=WNTIBR(XFDES,LFENTB,FENTJ(WNTF_REFP_J)) !READ REF. ENTRY - CALL WNCTXS(LNAM1,'=!AD', - 1 LFENTB(WNTF_NAM_1),WNTF_NAM_N) - ELSE - LNAM1=' ' - END IF - NCOM=0 !GET FIRST COMMENT - JS=WNTIO5(FENTJ,LIENTJ,NCOM,LCOMB,LCOMM) - IF (FENTJ(WNTF_DTP_J).EQ.T_S) THEN !STRUCTURE - I2=WNTIBR(XFDES,LFENTB,FENTJ(WNTF_SREF_J)) !READ REF. ENTRY - CALL WNCTXS(LNAM2,'!AS:!AD', - 1 CD1(FENTJ(WNTF_DTP_J)), - 1 LFENTB(WNTF_NAM_1),WNTF_NAM_N) - ELSE - LNAM2=CD1(FENTJ(WNTF_DTP_J)) - END IF - IF (FENTJ(WNTF_REFP_J).GT.0 .AND. - 1 FENTJ(WNTF_REFP_J).LT.I1) THEN != REFERENCE - LNAM3='=' - ELSE - LNAM3=' ' - END IF - IF (FENTJ(WNTF_DTP_J).NE.T_C) THEN !NUMERIC - CALL WNCTXT(F_P,'!3C!4$UJ !4$XJ!AS!19C!AD!AS!39C!AS!51C!AS'// - 1 '!65C!4$UJ!75C!AS', - 1 FENTJ(WNTF_OFF_J),FENTJ(WNTF_OFF_J),LNAM3, - 1 FENTB(WNTF_NAM_1),WNTF_NAM_N,LNAM1, - 1 LNAM2,LNAM, - 1 FENTJ(WNTF_TLEN_J)*FENTJ(WNTF_ULEN_J), - 1 LCOMM) - ELSE !CHARACTER - CALL WNCTXT(F_P,'!3C!4$UJ !4$XJ!AS!19C!AD!39C!AS!UJ!51C!AS'// - 1 '!65C!4$UJ!75C!AS', - 1 FENTJ(WNTF_OFF_J),FENTJ(WNTF_OFF_J),LNAM3, - 1 FENTB(WNTF_NAM_1),WNTF_NAM_N, - 1 CD1(FENTJ(WNTF_DTP_J)),FENTJ(WNTF_SLEN_J),LNAM, - 1 FENTJ(WNTF_TLEN_J)*FENTJ(WNTF_SLEN_J), - 1 LCOMM) - END IF - DO WHILE (NCOM.GE.0) !MORE COMMENTS? - IF (WNTIO5(FENTJ,LIENTJ,NCOM,LCOMB,LCOMM)) THEN - CALL WNCTXT(F_P,'!75C!AS',LCOMM) - END IF - END DO - END IF !ENTRY - END DO !ALL ENTRIES - END IF !DEF SEEN -C -C OUTPUT STRUCTURES -C - IF (BEGSN) THEN !STRUCTURES PRESENT - CNAM=' ' !NO NAME - CALL WNCFHD(F_P,3,'!16CContents of structures for !AS$.DSC'// - 1 ' (User= !AS,'// - 1 ' Date= !AS, Version= !AS, System= !AS)', - 1 PARM(P_NAM),PARM(P_USE),PARM(P_DAT), - 1 PARM(P_VER),PARM(P_SYS)) - CALL WNCTXT(F_P,'!^') !NEW PAGE - DO I1=0,XFDES_J(WNTB_CNT_J)-1 !ALL ENTRIES - I2=WNTIBR(XFDES,FENTB,I1) !READ ENTRY - IF (FENTJ(WNTF_BTYP_J).EQ.BT_BEG) THEN !NEW STRUCTURE - CALL WNTIO1(0,FENTB,CNAM,CNAM,LCNAM) !NAME - CALL WNCTXT(F_P,'!#C!4$UJ !4$XJ!#C$(!AS!64C!5$UJ', - 1 OF1,0,0,OF2,CNAM, - 1 FENTJ(WNTF_TLEN_J)) - OF1=OF1+2 !NEW PRINT OFFSETS - OF2=OF2+2 - ELSE IF (FENTJ(WNTF_BTYP_J).EQ.BT_EBG) THEN !END STRUCTURE - OF1=OF1-2 !NEW PRINT OFFSETS - OF2=OF2-2 - CALL WNCTXT(F_P,'!#C$)', - 1 OF2) - ELSE IF (FENTJ(WNTF_BTYP_J).EQ.BT_SDA .AND. - 1 FENTJ(WNTF_DTP_J).NE.0) THEN !DATA ENTRY - CALL WNGMTS(WNTF_NAM_N,FENTB(WNTF_NAM_1),LNAM1) !NAME - IF (LNAM1(1:1).EQ.'-') LNAM1='-' - CALL WNTIO0(0,FENTJ,LNAM) !ARRAY STRING - NCOM=0 !GET FIRST COMMENT - JS=WNTIO5(FENTJ,LIENTJ,NCOM,LCOMB,LCOMM) - IF (FENTJ(WNTF_DTP_J).EQ.T_S) THEN !STRUCTURE - I2=WNTIBR(XFDES,LFENTB,FENTJ(WNTF_SREF_J)) !READ REF. ENTRY - CALL WNCTXS(LNAM2,'!AS:!AD', - 1 CD1(FENTJ(WNTF_DTP_J)), - 1 LFENTB(WNTF_NAM_1),WNTF_NAM_N) - ELSE - LNAM2=CD1(FENTJ(WNTF_DTP_J)) - END IF - IF (FENTJ(WNTF_REFP_J).GT.0 .AND. - 1 FENTJ(WNTF_REFP_J).LT.I1) THEN != REFERENCE - LNAM3='=' - ELSE - LNAM3=' ' - END IF - IF (FENTJ(WNTF_DTP_J).NE.T_C) THEN !NUMERIC - CALL WNCTXT(F_P,'!#C!4$UJ !4$XJ!AS!#C!AS!39C!AS!51C!AS'// - 1 '!65C!4$UJ!75C!AS', - 1 OF1,FENTJ(WNTF_OFF_J),FENTJ(WNTF_OFF_J),LNAM3, - 1 OF2,LNAM1, - 1 LNAM2,LNAM, - 1 FENTJ(WNTF_TLEN_J)*FENTJ(WNTF_ULEN_J), - 1 LCOMM) - ELSE !CHARACTER - CALL WNCTXT(F_P,'!#C!4$UJ !4$XJ!AS!#C!AS!39C!AS!UJ!51C!AS'// - 1 '!65C!4$UJ!75C!AS', - 1 OF1,FENTJ(WNTF_OFF_J),FENTJ(WNTF_OFF_J),LNAM3, - 1 OF2,LNAM1, - 1 CD1(FENTJ(WNTF_DTP_J)),FENTJ(WNTF_SLEN_J),LNAM, - 1 FENTJ(WNTF_TLEN_J)*FENTJ(WNTF_ULEN_J)* - 1 FENTJ(WNTF_SLEN_J), - 1 LCOMM) - END IF - DO WHILE (NCOM.GE.0) !MORE COMMENTS? - IF (WNTIO5(FENTJ,LIENTJ,NCOM,LCOMB,LCOMM)) THEN - CALL WNCTXT(F_P,'!75C!AS',LCOMM) - END IF - END DO - END IF !ENTRY TYPE - END DO !ALL ENTRIES - CALL WNCTXT(F_P,'!2/Symbols used in the above description:') - CALL WNCTXT(F_P,'!/( = .STRUCTURE!25C) = .END'// - 1 '!50C$= = EQUIVALENCE!/') - END IF !BEG SEEN -C -C READY -C - 800 CONTINUE - CALL WNCFHD(F_P,-6,' ') !DELETE POSSIBLE HEAD - CALL WNCFHD(F_P,-5,' ') - CALL WNCFHD(F_P,-3,' ') -C - RETURN -C -C ERRORS -C - 900 CONTINUE -C - RETURN -C -C - END diff --git a/src/wng/wntios.for b/src/wng/wntios.for deleted file mode 100644 index 9d5458f195e884dcf230acebd91b937180f3c4dd..0000000000000000000000000000000000000000 --- a/src/wng/wntios.for +++ /dev/null @@ -1,1175 +0,0 @@ -C+ WNTIOS.FOR -C WNB 930501 -C -C Revisions: -C WNB 930818 Edit incorrect for <,1>; no edit length -C WNB 931123 Incorrect _T for multiple sub-structures -C WNB 940223 Convex COMMON block reference -C JPH 941010 EC length 10 --> 12 in output to F(I) -C - SUBROUTINE WNTIOS -C -C Output .DSC structure files -C -C Result: -C -C CALL WNTIOS outputs all the structure files (.DEF, .INC, _BD.FOR, -C _BD.CEE, _O.DEF/INC, _E.DEF/INC, _T.DEF/INC). -C -C Include files: -C - INCLUDE 'WNG_DEF' - INCLUDE 'WNT_O_DEF' - INCLUDE 'WNT_DEF' -C -C Parameters: -C - INTEGER NFILE !# OF OUTPUT TYPES - PARAMETER (NFILE=5) -C -C Arguments: -C -C -C Function references: -C - INTEGER WNCALN !STRING LENGTH - INTEGER WNTIBR !READ DATA AREA - INTEGER WNTIBW !WRITE DATA AREA -C -C Data declarations: -C - LOGICAL DOPAR !OUTPUT PARAMETERS - LOGICAL CSEEN !COMMON DATA SEEN - INTEGER USEEN != REFERENCE SEEN - LOGICAL TSEEN !TRANSLATION SEEN - INTEGER IF !FILE LOOP - INTEGER NCOM !COMMENT LINE COUNT - INTEGER TTCNT,TRCNT !TOTAL TRANSLATION COUNT - INTEGER FDEF(0:1) !DEFAULT FILE CODE - DATA FDEF/F_0,F_1/ - INTEGER F(0:1) !CURRENT FILE CODE - CHARACTER*(MXLNAM) FNAM(0:1) !OUTPUT FILE NAME - CHARACTER*(MXLNAM) LNAM,LNAM1,LNAM2 !LOCAL DATA - CHARACTER*(MXLNAM) LCNAM,LCNAM2 !LC NAME - CHARACTER*(MXLNAM) CNAM !COMMON NAME - CHARACTER*80 LIN1 !OUTPUT LINE - INTEGER TCOD(0:4) !TRANSLATION CHECK DATA - CHARACTER*8 FTXT(0:1,NFILE) !FILE EXTENSIONS - DATA FTXT/'.def','.inc','_bd.for',' ','_o.def','_o.inc', - 1 '_t.def','_t.inc','_e.def','_e.inc'/ - CHARACTER*2 CTXT(0:1,0:1,0:1) !COMMENT TEXT - DATA CTXT/'C',' ','/*','*/', - 1 'C',' ','..',' '/ - BYTE FENTB(0:WNTFHDL-1) !DATA ENTRY - INTEGER FENTJ(0:WNTFHDL/LB_J-1) - EQUIVALENCE (FENTB,FENTJ) - BYTE LFENTB(0:WNTFHDL-1) !DATA ENTRY - INTEGER LFENTJ(0:WNTFHDL/LB_J-1) - EQUIVALENCE (LFENTB,LFENTJ) - BYTE EENTB(0:WNTEHDL-1) !EDIT ENTRY - CHARACTER*(WNTEHDL) EENTC - INTEGER EENTJ(0:WNTEHDL/LB_J-1) - EQUIVALENCE (EENTB,EENTC,EENTJ) - BYTE DENTB(0:WNTDHDL-1) !DATA INIT ENTRY - INTEGER DENTJ(0:WNTDHDL/LB_J-1) - EQUIVALENCE (DENTB,DENTJ) - BYTE IENTB(0:WNTIHDL-1) !LINE ENTRY - INTEGER IENTJ(0:WNTIHDL-1) - EQUIVALENCE (IENTB,IENTJ) - BYTE FMENTB(0:MXSLIN-1) !FORTRAN/C LINE - CHARACTER*(MXSLIN) LCENTC !COMMENT LINE - EQUIVALENCE (FMENTB,LCENTC) -C- -C -C INIT -C - CALL WNCTXT(F_P,'!2/') !LOG SPACE -C -C OUTPUT -C - DO IF=1,NFILE !.DEF, _BD, _O, _T, _E - DOPAR=.FALSE. !NO PARAMETERS NOW - IF (IF.EQ.1) THEN - IF (.NOT.DEFSN) THEN - IF (.NOT.PARSN .OR. BEGSN) GOTO 100 !NO .DEF - DOPAR=.TRUE. - ELSE - IF (.NOT.BEGSN) DOPAR=.TRUE. - END IF - ELSE IF (IF.EQ.2) THEN - IF (.NOT.CINSN) GOTO 100 !NO _BD - DOPAR=.TRUE. !OUTPUT PARAMETERS - ELSE IF (IF.EQ.3) THEN - IF (.NOT.BEGSN) GOTO 100 !NO _O - DOPAR=.TRUE. - ELSE - IF (.NOT.BEGSN) GOTO 100 !NO _T, _E - END IF -C -C OPEN FILES -C - LNAM=PARM(P_NAM) !FILE NAME HEADER - CALL WNCALC(LNAM) !MAKE LC - DO I=0,1 !FOR/C - IF (FTXT(I,IF).NE.' ') THEN !MUST DO - F(I)=FDEF(I) !CORRECT FILE # - ELSE - F(I)=0 !NO FILE # - END IF - FNAM(I)=LNAM(1:WNCALN(LNAM))//FTXT(I,IF) !FORTRAN FILE NAME - CALL WNCFOP(F(I),FNAM(I)(1:WNCALN(FNAM(I)))) !OPEN OUTPUT - CALL WNCAUC(FNAM(I)) !MAKE UC - END DO -C -C HEADERS -C - CALL WNGSGH(LNAM) !HOST NAME - DO I=0,1 - CALL WNCTXT(F(I),'!AS+ Created from !AS$.dsc on !%DN '// - 1 'at !%T at !AS',CTXT(0,I,0), - 1 OINFIL,LNAM) - CALL WNCTXT(F(I),'!AS !AS',CTXT(0,I,1), !FILE NAME - 1 FNAM(I)) - CALL WNCTXT(F(I),'!AS !AS !AS',CTXT(0,I,1), !USER/DATE - 1 PARM(P_USE),PARM(P_DAT)) - CALL WNCTXT(F(I),'!AS',CTXT(0,I,1)) -C -C REVISIONS -C - CALL WNCTXT(F(I),'!AS Revisions:',CTXT(0,I,1)) - CALL WNCTXT(F(I),'!AS',CTXT(0,I,1)) - DO I1=0,RBDES_J(WNTB_CNT_J)-1 !REVISIONS - I2=RBDES_J(WNTB_BPTR_J)+I1*RBDES_J(WNTB_ELEN_J) !POINTER - CALL WNCTXT(F(I),'!AS!_!AD !AD!_!AD',CTXT(0,I,1), - 1 A_B(I2),MXLPAR,A_B(I2+MXLPAR),MXLPAR, - 1 A_B(I2+2*MXLPAR),RBDES_J(WNTB_ELEN_J)-2*MXLPAR) - END DO - CALL WNCTXT(F(I),'!AS!79C!AS',CTXT(0,I,1), - 1 CTXT(1,I,0)) - END DO !FORTRAN/C -C -C FORTRAN/CEE START -C - IF (IF.EQ.2) THEN !_BD - LNAM=PARM(P_NAM) - CALL WNCAUC(LNAM) - CALL WNCTXT(F(0),'!@BLOCK DATA !AS_BD',LNAM) - END IF - IF ((IF.EQ.1 .OR. IF.EQ.3) .AND. DOPAR) THEN !FORTRAN START - DO I=0,1 !FORTRAN/C - CALL WNCTXT(F(I),'!AS',CTXT(0,I,0)) - CALL WNCTXT(F(I),'!AS Given statements:',CTXT(0,I,1)) - CALL WNCTXT(F(I),'!AS!79C!AS',CTXT(0,I,1), - 1 CTXT(1,I,0)) - IF (I.EQ.0) THEN !FORTRAN - DO I1=0,FMDES_J(WNTB_CNT_J)-1 !ALL LINES - I2=WNTIBR(FMDES,FMENTB,I1) !READ LINE - CALL WNCTXT(F(I),'!@!AD', - 1 FMENTB,MXSLIN) - END DO - ELSE !C - DO I1=0,CCDES_J(WNTB_CNT_J)-1 !ALL LINES - I2=WNTIBR(CCDES,FMENTB,I1) !READ LINE - CALL WNCTXT(F(I),'!@!AD', - 1 FMENTB,MXSLIN) - END DO - END IF - END DO !FORTRAN/C - END IF -C -C COMMENTS -C - DO I=0,1 !FORTRAN/C - CALL WNCTXT(F(I),'!AS',CTXT(0,I,0)) - CALL WNCTXT(F(I),'!AS Result:',CTXT(0,I,1)) - CALL WNCTXT(F(I),'!AS',CTXT(0,I,1)) - IF (IF.EQ.2) THEN !_BD - CALL WNCTXT(F(I),'!AS!_Initialisation of !AS!AS',CTXT(0,I,1), - 1 OINFIL,FTXT(I,1)) - CALL WNCTXT(F(I),'!AS',CTXT(0,I,1)) - END IF - DO I1=0,CMDES_J(WNTB_CNT_J)-1 !COMMENTS - I2=CMDES_J(WNTB_BPTR_J)+I1*CMDES_J(WNTB_ELEN_J) !POINTER - CALL WNCTXT(F(I),'!AS !AD',CTXT(0,I,1), - 1 A_B(I2),CMDES_J(WNTB_ELEN_J)) - END DO - CALL WNCTXT(F(I),'!AS!79C!AS',CTXT(0,I,1), - 1 CTXT(1,I,0)) -C -C TRANSLATION HEADER -C - IF (IF.EQ.4) THEN - CALL WNCTXT(F(I),'!AS',CTXT(0,I,0)) - CALL WNCTXT(F(I),'!AS!_Specification of translation tables:', - 1 CTXT(0,I,1)) - CALL WNCTXT(F(I),'!AS',CTXT(0,I,1)) - CALL WNCTXT(F(I),'!AS!_$ 0= end of table!40C$ 1= character', - 1 CTXT(0,I,1)) - CALL WNCTXT(F(I), - 1 '!AS!_$ 2= 16 bits integer!40C$ 3= 32 bits integer', - 1 CTXT(0,I,1)) - CALL WNCTXT(F(I),'!AS!_$ 4= 32 bits real!40C$ 5= 64 bits real', - 1 CTXT(0,I,1)) - CALL WNCTXT(F(I),'!AS!_$ 6= repeat!40C$ 7= end repeat', - 1 CTXT(0,I,1)) - CALL WNCTXT(F(I),'!AS!_$ 8= undefined!40C$ 9= byte', - 1 CTXT(0,I,1)) - CALL WNCTXT(F(I),'!AS!_$10= external repeat!40C$11= start union', - 1 CTXT(0,I,1)) - CALL WNCTXT(F(I),'!AS!_$12= start map!40C$13= end union', - 1 CTXT(0,I,1)) - CALL WNCTXT(F(I), - 1 '!AS!_$14= 64 bits complex!40C$15= 128 bits complex', - 1 CTXT(0,I,1)) - CALL WNCTXT(F(I),'!AS!79C!AS',CTXT(0,I,1), - 1 CTXT(1,I,0)) - END IF -C -C EDIT HEADER -C - IF (IF.EQ.5) THEN - CALL WNCTXT(F(I),'!AS',CTXT(0,I,0)) - CALL WNCTXT(F(I),'!AS!_Specification of edit tables:', - 1 CTXT(0,I,1)) - CALL WNCTXT(F(I),'!AS',CTXT(0,I,1)) - CALL WNCTXT(F(I),'!AS The character (_EC) table contains:', - 1 CTXT(0,I,1)) - CALL WNCTXT(F(I),'!AS!_$fieldname, pattern, units, special code', - 1 CTXT(0,I,1)) - CALL WNCTXT(F(I),'!AS The integer (_EJ) table contains:', - 1 CTXT(0,I,1)) - CALL WNCTXT(F(I),'!AS!_$offset, # of values, '// - 1 'edit (0=allowed), unit length', - 1 CTXT(0,I,1)) - CALL WNCTXT(F(I),'!AS!79C!AS',CTXT(0,I,1), - 1 CTXT(1,I,0)) - END IF - END DO !FORTRAN/C -C -C PARAMETERS -C - IF (DOPAR) THEN !PARAMETERS - DO I=0,1 - CALL WNCTXT(F(I),'!AS',CTXT(0,I,0)) - CALL WNCTXT(F(I),'!AS Parameters:',CTXT(0,I,1)) - CALL WNCTXT(F(I),'!AS!79C!AS',CTXT(0,I,1), - 1 CTXT(1,I,0)) - DO I1=0,XFDES_J(WNTB_CNT_J)-1 - I2=WNTIBR(XFDES,FENTB,I1) !READ ENTRY - NCOM=0 !COMMENT LINES - IF (FENTJ(WNTF_BTYP_J).EQ.BT_PAR) THEN !PARAMETER - IF (FENTJ(WNTF_DTP_J).NE.0) THEN !NOT COMMENT - I2=DFDES_J(WNTB_BPTR_J)+ - 1 FENTJ(WNTF_INIP_J)*DFDES_J(WNTB_ELEN_J) !POINTER INIT - END IF - IF (FENTJ(WNTF_DTP_J).EQ.0) THEN - CALL WNTIO4(I,F,FENTB,FENTJ,CNAM) !COMMENT LINE - ELSE IF (FENTJ(WNTF_DTP_J).NE.T_C) THEN !NUMERIC - IF (I.EQ.0) THEN !FORTRAN - CALL WNTIO2(I,F,FENTB,FENTJ,CNAM) !DATA LINE - CALL WNCTXT(F(I),'!@ PARAMETER (!AD=!AD)', - 1 FENTB(WNTF_NAM_1),WNTF_NAM_N, - 1 A_B(I2+WNTD_STR_1),WNTD_STR_N) - ELSE !C - CALL WNCTXS(LCENTC,'#define !AD !AD', - 1 FENTB(WNTF_NAM_1),WNTF_NAM_N, - 1 A_B(I2+WNTD_STR_1),WNTD_STR_N) - CALL WNTIO6(F,I,LCENTC,FENTJ,IENTJ,NCOM) !SHOW COMMENT - CALL WNTIO7(F,I,LCENTC,FENTJ,IENTJ,NCOM) !FINAL COMMENTS - END IF - ELSE !ALPHA - IF (I.EQ.0) THEN !FORTRAN - CALL WNTIO2(I,F,FENTB,FENTJ,CNAM) !DATA LINE - CALL WNCTXT(F(I),'!@ PARAMETER (!AD=''!AD'')', - 1 FENTB(WNTF_NAM_1),WNTF_NAM_N, - 1 A_B(I2+WNTD_STR_1),WNTD_STR_N) - ELSE !C - CALL WNCTXS(LCENTC,'#define !AD !AD', - 1 FENTB(WNTF_NAM_1),WNTF_NAM_N, - 1 A_B(I2+WNTD_STR_1),WNTD_STR_N) - CALL WNTIO6(F,I,LCENTC,FENTJ,IENTJ,NCOM) !SHOW COMMENT - CALL WNTIO7(F,I,LCENTC,FENTJ,IENTJ,NCOM) !FINAL COMMENTS - END IF - END IF - END IF - END DO - END DO - END IF -C -C LENGTH, VERSION, SYSTEM, OFFSETS -C - IF (IF.EQ.3) THEN !_O - USEEN=-1 !NO UNION - CNAM=' ' !NO NAME - DO I1=0,XFDES_J(WNTB_CNT_J)-1 !ALL ENTRIES - I2=WNTIBR(XFDES,FENTB,I1) !READ ENTRY - IF (FENTJ(WNTF_BTYP_J).EQ.BT_BEG) THEN !NEW STRUCTURE - CALL WNTIO1(0,FENTB,CNAM,LNAM1,LCNAM) !NAME - CNAM=LNAM1 - DO I=0,1 !FORTRAN/CEE - NCOM=0 !COMMENT COUNT - CALL WNCTXT(F(I),'!AS',CTXT(0,I,0)) - CALL WNCTXT(F(I),'!AS !AS structure definitions:', - 1 CTXT(0,I,1),LNAM1) - CALL WNCTXT(F(I),'!AS!79C!AS',CTXT(0,I,1), - 1 CTXT(1,I,0)) - IF (I.EQ.0) THEN !FORTRAN - CALL WNCTXT(F(I),'!@INTEGER !AS$HDL,!AS$HDV,!AS$HDS', - 1 LNAM1,LNAM1,LNAM1) - CALL WNCTXT(F(I),'!@ PARAMETER (!_!AS$HDL=!UJ,'// - 1 '!#C!! Length!/!@&!2_!AS$HDV=!AS,'// - 1 '!#C!! Version!/!@&!2_!AS$HDS=!AS)'// - 1 '!#C!! System', - 1 LNAM1,FENTJ(WNTF_TLEN_J),COMPOS, - 1 LNAM1,PARM(P_VER),COMPOS, - 1 LNAM1,PARM(P_SYS),COMPOS) - CALL WNCTXT(F(I),'!@INTEGER !AS__L,!AS__V,!AS__S', - 1 LNAM1,LNAM1,LNAM1) - CALL WNCTXT(F(I),'!@ PARAMETER (!_!AS__L=!UJ,'// - 1 '!#C!! Length!/!@&!2_!AS__V=!AS,'// - 1 '!#C!! Version!/!@&!2_!AS__S=!AS)'// - 1 '!#C!! System', - 1 LNAM1,FENTJ(WNTF_TLEN_J),COMPOS, - 1 LNAM1,PARM(P_VER),COMPOS, - 1 LNAM1,PARM(P_SYS),COMPOS) - ELSE !C - CALL WNCTXT(F(I),'#define !AS$HDL !UJ'// - 1 '!#C/* Length */', - 1 LNAM1,FENTJ(WNTF_TLEN_J),COMPOS+7) - CALL WNCTXT(F(I),'#define !AS$HDV !AS'// - 1 '!#C/* Version */', - 1 LNAM1,PARM(P_VER),COMPOS+7) - CALL WNCTXT(F(I),'#define !AS$HDS !AS'// - 1 '!#C/* System */', - 1 LNAM1,PARM(P_SYS),COMPOS+7) - CALL WNCTXT(F(I),'#define !AS__L !UJ'// - 1 '!#C/* Length */', - 1 LNAM1,FENTJ(WNTF_TLEN_J),COMPOS+7) - CALL WNCTXT(F(I),'#define !AS__V !AS'// - 1 '!#C/* Version */', - 1 LNAM1,PARM(P_VER),COMPOS+7) - CALL WNCTXT(F(I),'#define !AS__S !AS'// - 1 '!#C/* System */', - 1 LNAM1,PARM(P_SYS),COMPOS+7) - END IF - CALL WNCTXT(F(I),'!AS',CTXT(0,I,0)) - CALL WNCTXT(F(I),'!AS !AS Offsets:', - 1 CTXT(0,I,1),LNAM1) - CALL WNCTXT(F(I),'!AS!79C!AS',CTXT(0,I,1), - 1 CTXT(1,I,0)) - IF (I.EQ.1) THEN - CALL WNCTXS(LCENTC,'struct !AS {',LCNAM) !STRUCTURE NAME - CALL WNTIO6(F,I,LCENTC,FENTJ,IENTJ,NCOM) !SHOW COMMENT - END IF - CALL WNTIO7(F,I,LCENTC,FENTJ,IENTJ,NCOM) !FINAL COMMENTS - END DO !FORTRAN/CEE - ELSE IF (FENTJ(WNTF_BTYP_J).EQ.BT_EBG) THEN !END DEFINITION - NCOM=0 !COMMENT COUNT - IF (USEEN.GE.0) THEN !END UNION - I2=WNTIBR(XFDES,LFENTB,USEEN) !READ REF. NAME - CALL WNTIO1(I,LFENTB,CNAM,LNAM2,LCNAM2) !GET NAME - CALL WNCTXT(F(1),' } !AS;',LCNAM2) !UNION NAME - USEEN=-1 !READY - END IF - CALL WNCTXS(LCENTC,'};') !END STRUCTURE - CALL WNTIO6(F,1,LCENTC,FENTJ,IENTJ,NCOM) !SHOW COMMENT - CALL WNTIO7(F,0,LCENTC,FENTJ,IENTJ,NCOM) !FINAL COMMENTS - CALL WNTIO7(F,1,LCENTC,FENTJ,IENTJ,NCOM) !FINAL COMMENTS - ELSE IF (FENTJ(WNTF_BTYP_J).EQ.BT_SDA) THEN !OFFSET - IF ((FENTJ(WNTF_REFP_J).LE.0 .OR. - 1 FENTJ(WNTF_REFP_J).GT.I1) .AND. - 1 FENTJ(WNTF_DTP_J).NE.0 .AND. - 1 USEEN.GE.0) THEN !END UNION - I2=WNTIBR(XFDES,LFENTB,USEEN) !READ REF. NAME - CALL WNTIO1(I,LFENTB,CNAM,LNAM2,LCNAM2) !GET NAME - CALL WNCTXT(F(1),' } !AS;',LCNAM2) !UNION NAME - USEEN=-1 !READY - END IF - IF (FENTJ(WNTF_REFP_J).GT.I1 .AND. - 1 FENTJ(WNTF_DTP_J).NE.0) THEN !START = REFERENCE - CALL WNCTXT(F(1),' union {') - USEEN=I1 !SAVE WHERE - END IF - DO I=0,1 !FORTRAN/C - IF (I.EQ.1 .OR. FENTB(WNTF_NAM_1).NE.ICHAR('-')) THEN !NAME - NCOM=0 !COMMENT COUNT - IF (FENTJ(WNTF_DTP_J).EQ.0) THEN !COMMENT - CALL WNTIO4(I,F,FENTB,FENTJ,CNAM) - ELSE IF (FENTJ(WNTF_DTP_J).EQ.T_S) THEN !STRUCTURE - I2=WNTIBR(XFDES,LFENTB,FENTJ(WNTF_SREF_J)) !REF. DATA - IF (I.EQ.0) THEN !FORTRAN - CALL WNCTXS(LCENTC,'!@INTEGER !AS_!AD_1,'// - 1 '!AS_!AD_N', - 1 LNAM1,FENTB(WNTF_NAM_1),WNTF_NAM_N, - 1 LNAM1,FENTB(WNTF_NAM_1),WNTF_NAM_N) - CALL WNTIO6(F,I,LCENTC,FENTJ,IENTJ,NCOM) !SHOW COMMENT - CALL WNCTXS(LCENTC,'!@ PARAMETER (!AS_!AD_1=!UJ,'// - 1 '!AS_!AD_N=!UJ)', - 1 LNAM1,FENTB(WNTF_NAM_1),WNTF_NAM_N, - 1 FENTJ(WNTF_OFF_J), - 1 LNAM1,FENTB(WNTF_NAM_1),WNTF_NAM_N, - 1 LFENTJ(WNTF_TLEN_J)) - CALL WNTIO6(F,I,LCENTC,FENTJ,IENTJ,NCOM) !SHOW COMMENT - IF (MOD(FENTJ(WNTF_OFF_J), - 1 LFENTJ(WNTF_TLEN_J)).EQ.0) THEN !CORRECT OFFSET - CALL WNCTXS(LCENTC,'!@INTEGER !AS_!AD_!AS', - 1 LNAM1,FENTB(WNTF_NAM_1),WNTF_NAM_N, - 1 CD1(FENTJ(WNTF_DTP_J))) - CALL WNTIO6(F,I,LCENTC,FENTJ,IENTJ,NCOM) !SHOW COMMENT - CALL WNCTXS(LCENTC,'!@ PARAMETER (!AS_!AD_!AS=!UJ)', - 1 LNAM1,FENTB(WNTF_NAM_1),WNTF_NAM_N, - 1 CD1(FENTJ(WNTF_DTP_J)), - 1 FENTJ(WNTF_OFF_J)/FENTJ(WNTF_ULEN_J)) - CALL WNTIO6(F,I,LCENTC,FENTJ,IENTJ,NCOM) !SHOW COMMENT - END IF - DO I3=1,T__N-1 !ALL OFFSETS - IF (CD1(I3).NE.'S' .AND. CD2(I3).NE.0) THEN - IF (MOD(FENTJ(WNTF_OFF_J),CD2(I3)).EQ.0) THEN - CALL WNCTXS(LCENTC,'!@ INTEGER !AS_!AD_!AS', - 1 LNAM1,FENTB(WNTF_NAM_1),WNTF_NAM_N, - 1 CD1(I3)) - CALL WNTIO6(F,I,LCENTC,FENTJ,IENTJ,NCOM) - CALL WNCTXS(LCENTC,'!@ PARAMETER '// - 1 '(!AS_!AD_!AS=!UJ)', - 1 LNAM1,FENTB(WNTF_NAM_1),WNTF_NAM_N, - 1 CD1(I3),FENTJ(WNTF_OFF_J)/CD2(I3)) - CALL WNTIO6(F,I,LCENTC,FENTJ,IENTJ,NCOM) - END IF - END IF - END DO - CALL WNTIO7(F,I,LCENTC,FENTJ,IENTJ,NCOM) !FINAL COMMENTS - ELSE !C - CALL WNTIO2(I,F,FENTB,FENTJ,CNAM) !SHOW LINE NO INIT - END IF !FORTRAN/C - ELSE IF (FENTJ(WNTF_DTP_J).NE.T_C) THEN !NUMERIC - IF (I.EQ.0) THEN !FORTRAN - IF (MOD(FENTJ(WNTF_OFF_J), - 1 FENTJ(WNTF_ULEN_J)).EQ.0) THEN !CORRECT OFFSET - CALL WNCTXS(LCENTC,'!@INTEGER !AS_!AD_1,'// - 1 '!AS_!AD_!AS', - 1 LNAM1, - 1 FENTB(WNTF_NAM_1),WNTF_NAM_N, - 1 LNAM1, - 1 FENTB(WNTF_NAM_1),WNTF_NAM_N, - 1 CD1(FENTJ(WNTF_DTP_J))) - CALL WNTIO6(F,I,LCENTC,FENTJ,IENTJ,NCOM) !SHOW COMMENT - CALL WNCTXS(LCENTC,'!@ PARAMETER (!AS_!AD_1=!UJ,'// - 1 '!AS_!AD_!AS=!UJ)', - 1 LNAM1, - 1 FENTB(WNTF_NAM_1),WNTF_NAM_N, - 1 FENTJ(WNTF_OFF_J), - 1 LNAM1, - 1 FENTB(WNTF_NAM_1),WNTF_NAM_N, - 1 CD1(FENTJ(WNTF_DTP_J)), - 1 FENTJ(WNTF_OFF_J)/FENTJ(WNTF_ULEN_J)) - CALL WNTIO6(F,I,LCENTC,FENTJ,IENTJ,NCOM) !SHOW COMMENT - ELSE !INCORRECT OFFSET - CALL WNCTXS(LCENTC,'!@INTEGER !AS_!AD_1', - 1 LNAM1, - 1 FENTB(WNTF_NAM_1),WNTF_NAM_N) - CALL WNTIO6(F,I,LCENTC,FENTJ,IENTJ,NCOM) !SHOW COMMENT - CALL WNCTXS(LCENTC,'!@ PARAMETER (!AS_!AD_1=!UJ)', - 1 LNAM1, - 1 FENTB(WNTF_NAM_1),WNTF_NAM_N, - 1 FENTJ(WNTF_OFF_J)) - CALL WNTIO6(F,I,LCENTC,FENTJ,IENTJ,NCOM) !SHOW COMMENT - END IF - CALL WNTIO7(F,I,LCENTC,FENTJ,IENTJ,NCOM) !FINAL COMMENTS - ELSE !C - CALL WNTIO2(I,F,FENTB,FENTJ,CNAM) !SHOW LINE NO INIT - END IF - ELSE !CHARACTER - IF (I.EQ.0) THEN !FORTRAN - CALL WNCTXS(LCENTC,'!@INTEGER !AS_!AD_1,'// - 1 '!AS_!AD_!AS,!AS_!AD_N', - 1 LNAM1, - 1 FENTB(WNTF_NAM_1),WNTF_NAM_N, - 1 LNAM1, - 1 FENTB(WNTF_NAM_1),WNTF_NAM_N, - 1 CD1(FENTJ(WNTF_DTP_J)), - 1 LNAM1, - 1 FENTB(WNTF_NAM_1),WNTF_NAM_N) - CALL WNTIO6(F,I,LCENTC,FENTJ,IENTJ,NCOM) !SHOW COMMENT - CALL WNCTXS(LCENTC,'!@ PARAMETER (!AS_!AD_1=!UJ,'// - 1 '!AS_!AD_!AS=!UJ,!AS_!AD_N=!UJ)', - 1 LNAM1, - 1 FENTB(WNTF_NAM_1),WNTF_NAM_N, - 1 FENTJ(WNTF_OFF_J), - 1 LNAM1, - 1 FENTB(WNTF_NAM_1),WNTF_NAM_N, - 1 CD1(FENTJ(WNTF_DTP_J)), - 1 FENTJ(WNTF_OFF_J)/FENTJ(WNTF_ULEN_J), - 1 LNAM1, - 1 FENTB(WNTF_NAM_1),WNTF_NAM_N, - 1 FENTJ(WNTF_SLEN_J)) - CALL WNTIO6(F,I,LCENTC,FENTJ,IENTJ,NCOM) !SHOW COMMENT - CALL WNTIO7(F,I,LCENTC,FENTJ,IENTJ,NCOM) !FINAL COMMENTS - ELSE !C - CALL WNTIO2(I,F,FENTB,FENTJ,CNAM) !SHOW LINE NO INIT - END IF - END IF !NUMERIC/CHARACTER - END IF !NAME GIVEN - END DO !FORTRAN/C - END IF !OFFSET - END DO !ALL ENTRIES - END IF !OFFSETS -C -C TRANSLATION DATA -C - IF (IF.EQ.4) THEN !_T - CNAM=' ' !NO COMMON - TTCNT=0 !TOTAL TRANSLATION COUNT - LNAM2=PARM(P_NAM) !FILE NAME - CALL WNCAUC(LNAM2) - CALL WNCTXT(F(1),' static struct {') - DO I1=0,XFDES_J(WNTB_CNT_J)-1 !ALL ENTRIES - I2=WNTIBR(XFDES,FENTB,I1) !READ ENTRY - IF (FENTJ(WNTF_BTYP_J).EQ.BT_BEG) THEN !NEW STRUCTURE - CALL WNTIO1(0,FENTB,CNAM,LNAM1,LCNAM) !GET NAME - DO I=0,1 !FORTRAN/CEE - CALL WNCTXT(F(I),'!AS',CTXT(0,I,0)) - CALL WNCTXT(F(I),'!AS !AS translation definitions:', - 1 CTXT(0,I,1),LNAM1) - CALL WNCTXT(F(I),'!AS!79C!AS',CTXT(0,I,1), - 1 CTXT(1,I,0)) - END DO !FORTRAN/CEE - TCOD(0)=-1 !CHECK CODE - TCOD(1)=0 !COUNT LINES - TCOD(2)=0 !ITEM COUNT - TCOD(3)=I1 !CURRENT POINTER - ELSE IF (FENTJ(WNTF_BTYP_J).EQ.BT_SDA .AND. - 1 FENTJ(WNTF_DTP_J).NE.0 .AND. - 1 .NOT.(FENTJ(WNTF_REFP_J).GT.0 .AND. - 1 FENTJ(WNTF_REFP_J).LT.I1)) THEN !OFFSET - IF ((FENTJ(WNTF_DTP_J).NE.TCOD(0) .OR. - 1 FENTJ(WNTF_DTP_J).EQ.T_S).AND. - 1 TCOD(2).GT.0) THEN !NEW LINE - TCOD(1)=TCOD(1)+1 !COUNT LINES - IF (TCOD(0).EQ.T_S) TCOD(1)=TCOD(1)+1 - TCOD(2)=0 !ITEM LENGTH - END IF - I3=FENTJ(WNTF_TLEN_J) !ITEM LENGTH - IF (FENTJ(WNTF_DTP_J).EQ.T_C) - 1 I3=I3*FENTJ(WNTF_SLEN_J) - TCOD(2)=TCOD(2)+I3 - DO WHILE (TCOD(2).GT.32760) - TCOD(2)=TCOD(2)-32760 - TCOD(1)=TCOD(1)+1 !COUNT LINES - IF (TCOD(0).EQ.T_S) TCOD(1)=TCOD(1)+1 - END DO - TCOD(0)=FENTJ(WNTF_DTP_J) - ELSE IF (FENTJ(WNTF_BTYP_J).EQ.BT_EBG .AND. - 1 TCOD(1)+TCOD(2).NE.0) THEN !HAVE SEEN TRANSLATION - IF (TCOD(2).NE.0) THEN - TCOD(1)=TCOD(1)+1 !COUNT LINES - IF (TCOD(0).EQ.T_S) TCOD(1)=TCOD(1)+1 - END IF - DO I=0,1 !FORTRAN/C - IF (I.EQ.0) THEN - CALL WNCTXT(F(I),'!@INTEGER*2 !AS_T(2,!UJ)', - 1 LNAM1,TCOD(1)+1) - CALL WNCTXT(F(I),'!@ EQUIVALENCE (!AS_T,!AS__T(1,!UJ))', - 1 LNAM1,LNAM2,TTCNT+1) - ELSE !C - CALL WNCTXT(F(I),' short !AS_t [!UJ][2] ;', - 1 LCNAM,TCOD(1)+1) - END IF - END DO !FORTRAN/C - I2=WNTIBR(XFDES,FENTB,TCOD(3)) !READ START ENTRY - FENTJ(WNTF_IND_J+MXNARR*2-1)=TTCNT !SAVE START IN HEADER - I2=WNTIBW(XFDES,FENTB,TCOD(3)) !REWRITE START ENTRY - TRCNT=TTCNT !SAVE CURRENT - TTCNT=TTCNT+TCOD(1)+1 !NEW TOTAL LENGTH - TCOD(0)=-1 !CHECK CODE - TCOD(1)=0 !COUNT LINES - TCOD(2)=0 !ITEM COUNT - DO I3=TCOD(3)+1,I1 !ALL ENTRIES - I2=WNTIBR(XFDES,FENTB,I3) !READ ENTRY - IF (FENTJ(WNTF_BTYP_J).EQ.BT_SDA .AND. - 1 FENTJ(WNTF_DTP_J).NE.0 .AND. - 1 .NOT.(FENTJ(WNTF_REFP_J).GT.0 .AND. - 1 FENTJ(WNTF_REFP_J).LT.I3)) THEN !OFFSET - IF ((TCOD(0).NE.FENTJ(WNTF_DTP_J) .OR. - 1 FENTJ(WNTF_DTP_J).EQ.T_S).AND. - 1 TCOD(2).GT.0) THEN !OUTPUT LINE - TCOD(1)=TCOD(1)+1 !COUNT LINE - DO I=0,0 !FORTRAN/C - CALL WNCTXT(F(I),'!@ DATA !AS_T(1,!UJ),'// - 1 '!AS_T(2,!UJ) /!UJ,!UJ/', - 1 LNAM1,TCOD(1),LNAM1,TCOD(1), - 1 TCD(TCOD(0)),TCOD(2)) - END DO !FORTRAN/C - IF (TCOD(0).EQ.T_S) THEN - TCOD(1)=TCOD(1)+1 !COUNT LINES - I2=WNTIBR(XFDES,LFENTB,TCOD(4)) !REFERENCE - J=2*(LFENTJ(WNTF_IND_J+2*MXNARR-1)- - 1 TRCNT-TCOD(1)+1) !OFFSET - DO I=0,0 !FORTRAN/C - CALL WNCTXT(F(I),'!@ DATA !AS_T(1,!UJ),'// - 1 '!AS_T(2,!UJ) /!SJ,!UJ/', - 1 LNAM1,TCOD(1),LNAM1,TCOD(1), - 1 J,1) - END DO !FORTRAN/C - END IF - TCOD(2)=0 !NEW ITEM - END IF - I4=FENTJ(WNTF_TLEN_J) !ITEM LENGTH - IF (FENTJ(WNTF_DTP_J).EQ.T_C) - 1 I4=I4*FENTJ(WNTF_SLEN_J) - IF (FENTJ(WNTF_DTP_J).EQ.T_S) - 1 TCOD(4)=FENTJ(WNTF_SREF_J) !SAVE REFERENCE - TCOD(2)=TCOD(2)+I4 - DO WHILE (TCOD(2).GT.32760) - TCOD(1)=TCOD(1)+1 !COUNT LINES - DO I=0,0 !FORTRAN/C - CALL WNCTXT(F(I),'!@ DATA !AS_T(1,!UJ),'// - 1 '!AS_T(2,!UJ) /!UJ,!UJ/', - 1 LNAM1,TCOD(1),LNAM1,TCOD(1), - 1 TCD(TCOD(0)),32760) - END DO !FORTRAN/C - IF (TCOD(0).EQ.T_S) THEN - TCOD(1)=TCOD(1)+1 !COUNT LINES - I2=WNTIBR(XFDES,LFENTB,TCOD(4)) !REFERENCE - J=2*(LFENTJ(WNTF_IND_J+2*MXNARR-1)- - 1 TRCNT-TCOD(1)+1) !OFFSET - DO I=0,0 !FORTRAN/C - CALL WNCTXT(F(I),'!@ DATA !AS_T(1,!UJ),'// - 1 '!AS_T(2,!UJ) /!SJ,!UJ/', - 1 LNAM1,TCOD(1),LNAM1,TCOD(1), - 1 J,1) - END DO !FORTRAN/C - END IF - TCOD(2)=TCOD(2)-32760 - END DO - TCOD(0)=FENTJ(WNTF_DTP_J) - ELSE IF (FENTJ(WNTF_BTYP_J).EQ.BT_EBG) THEN !READY - IF (TCOD(2).NE.0) THEN - TCOD(1)=TCOD(1)+1 !COUNT LINES - DO I=0,0 !FORTRAN/C - CALL WNCTXT(F(I),'!@ DATA !AS_T(1,!UJ),'// - 1 '!AS_T(2,!UJ) /!UJ,!UJ/', - 1 LNAM1,TCOD(1),LNAM1,TCOD(1), - 1 TCD(TCOD(0)),TCOD(2)) - END DO !FORTRAN/C - END IF - IF (TCOD(0).EQ.T_S) THEN - TCOD(1)=TCOD(1)+1 !COUNT LINES - I2=WNTIBR(XFDES,LFENTB,TCOD(4)) !REFERENCE - J=2*(LFENTJ(WNTF_IND_J+2*MXNARR-1)- - 1 TRCNT-TCOD(1)+1) !OFFSET - DO I=0,0 !FORTRAN/C - CALL WNCTXT(F(I),'!@ DATA !AS_T(1,!UJ),'// - 1 '!AS_T(2,!UJ) /!SJ,!UJ/', - 1 LNAM1,TCOD(1),LNAM1,TCOD(1), - 1 J,1) - END DO !FORTRAN/C - END IF - TCOD(1)=TCOD(1)+1 - DO I=0,0 !FORTRAN/C - CALL WNCTXT(F(I),'!@ DATA !AS_T(1,!UJ),'// - 1 '!AS_T(2,!UJ) /!UJ,!UJ/', - 1 LNAM1,TCOD(1),LNAM1,TCOD(1), - 1 0,1) - END DO !FORTRAN/C - END IF !OFFSET - END DO !ENTRIES - END IF !OFFSET - END DO !ALL ENTRIES - DO I=0,1 !FORTRAN/C - IF (I.EQ.0) THEN - CALL WNCTXT(F(I),'!@INTEGER*2 !AS__T(2,!UJ)', - 1 LNAM2,TTCNT) - ELSE !C - CALL WNCALC(LNAM2) - CALL WNCTXT(F(I),' } !AS__t = {', - 1 LNAM2) - END IF - END DO !FORTRAN/C - CNAM=' ' !NO COMMON - TTCNT=0 !TOTAL TRANSLATION COUNT - TSEEN=.FALSE. !NON YET - DO I1=0,XFDES_J(WNTB_CNT_J)-1 !ALL ENTRIES - I2=WNTIBR(XFDES,FENTB,I1) !READ ENTRY - IF (FENTJ(WNTF_BTYP_J).EQ.BT_BEG) THEN !NEW STRUCTURE - CALL WNTIO1(0,FENTB,CNAM,LNAM1,LCNAM) !GET NAME - TCOD(0)=-1 !CHECK CODE - TCOD(1)=0 !COUNT LINES - TCOD(2)=0 !ITEM COUNT - TCOD(3)=I1 !CURRENT POINTER - IF (TSEEN) THEN - CALL WNCTXT(F(1),'!2_!UJ, !UJ,', - 1 0,1) - END IF - ELSE IF (FENTJ(WNTF_BTYP_J).EQ.BT_SDA .AND. - 1 FENTJ(WNTF_DTP_J).NE.0 .AND. - 1 .NOT.(FENTJ(WNTF_REFP_J).GT.0 .AND. - 1 FENTJ(WNTF_REFP_J).LT.I1)) THEN !OFFSET - IF ((FENTJ(WNTF_DTP_J).NE.TCOD(0) .OR. - 1 FENTJ(WNTF_DTP_J).EQ.T_S).AND. - 1 TCOD(2).GT.0) THEN !NEW LINE - TCOD(1)=TCOD(1)+1 !COUNT LINES - IF (TCOD(0).EQ.T_S) TCOD(1)=TCOD(1)+1 - TCOD(2)=0 !ITEM LENGTH - END IF - I3=FENTJ(WNTF_TLEN_J) !ITEM LENGTH - IF (FENTJ(WNTF_DTP_J).EQ.T_C) - 1 I3=I3*FENTJ(WNTF_SLEN_J) - TCOD(2)=TCOD(2)+I3 - DO WHILE (TCOD(2).GT.32760) - TCOD(2)=TCOD(2)-32760 - TCOD(1)=TCOD(1)+1 !COUNT LINES - IF (TCOD(0).EQ.T_S) TCOD(1)=TCOD(1)+1 - END DO - TCOD(0)=FENTJ(WNTF_DTP_J) - ELSE IF (FENTJ(WNTF_BTYP_J).EQ.BT_EBG .AND. - 1 TCOD(1)+TCOD(2).NE.0) THEN !HAVE SEEN TRANSLATION - IF (TCOD(2).NE.0) TCOD(1)=TCOD(1)+1 !COUNT LINES - I2=WNTIBR(XFDES,FENTB,TCOD(3)) !READ START ENTRY - FENTJ(WNTF_IND_J+MXNARR*2-1)=TTCNT !SAVE START IN HEADER - I2=WNTIBW(XFDES,FENTB,TCOD(3)) !REWRITE START ENTRY - TRCNT=TTCNT !SAVE CURRENT - TTCNT=TTCNT+TCOD(1)+1 !NEW TOTAL LENGTH - TCOD(0)=-1 !CHECK CODE - TCOD(1)=0 !COUNT LINES - TCOD(2)=0 !ITEM COUNT - DO I3=TCOD(3)+1,I1 !ALL ENTRIES - I2=WNTIBR(XFDES,FENTB,I3) !READ ENTRY - IF (FENTJ(WNTF_BTYP_J).EQ.BT_SDA .AND. - 1 FENTJ(WNTF_DTP_J).NE.0 .AND. - 1 .NOT.(FENTJ(WNTF_REFP_J).GT.0 .AND. - 1 FENTJ(WNTF_REFP_J).LT.I3)) THEN !OFFSET - IF ((TCOD(0).NE.FENTJ(WNTF_DTP_J) .OR. - 1 FENTJ(WNTF_DTP_J).EQ.T_S).AND. - 1 TCOD(2).GT.0) THEN !OUTPUT LINE - TCOD(1)=TCOD(1)+1 !COUNT LINE - CALL WNCTXT(F(1),'!2_!UJ, !UJ,', - 1 TCD(TCOD(0)),TCOD(2)) - IF (TCOD(0).EQ.T_S) THEN - TCOD(1)=TCOD(1)+1 !COUNT LINES - I2=WNTIBR(XFDES,LFENTB,TCOD(4)) !REFERENCE - J=2*(LFENTJ(WNTF_IND_J+2*MXNARR-1)- - 1 TRCNT-TCOD(1)+1) !OFFSET - CALL WNCTXT(F(1),'!2_!SJ, !UJ,', - 1 J,1) - END IF - TCOD(2)=0 !NEW ITEM - END IF - I4=FENTJ(WNTF_TLEN_J) !ITEM LENGTH - IF (FENTJ(WNTF_DTP_J).EQ.T_C) - 1 I4=I4*FENTJ(WNTF_SLEN_J) - IF (FENTJ(WNTF_DTP_J).EQ.T_S) - 1 TCOD(4)=FENTJ(WNTF_SREF_J) !SAVE REFERENCE - TCOD(2)=TCOD(2)+I4 - DO WHILE (TCOD(2).GT.32760) - TCOD(1)=TCOD(1)+1 !COUNT LINES - CALL WNCTXT(F(1),'!2_!UJ, !UJ,', - 1 TCD(TCOD(0)),32760) - IF (TCOD(0).EQ.T_S) THEN - TCOD(1)=TCOD(1)+1 !COUNT LINES - I2=WNTIBR(XFDES,LFENTB,TCOD(4)) !REFERENCE - J=2*(LFENTJ(WNTF_IND_J+2*MXNARR-1)- - 1 TRCNT-TCOD(1)+1) !OFFSET - CALL WNCTXT(F(1),'!2_!SJ, !UJ,', - 1 J,1) - END IF - TCOD(2)=TCOD(2)-32760 - END DO - TCOD(0)=FENTJ(WNTF_DTP_J) - ELSE IF (FENTJ(WNTF_BTYP_J).EQ.BT_EBG) THEN !READY - IF (TCOD(2).NE.0) THEN - TCOD(1)=TCOD(1)+1 !COUNT LINES - CALL WNCTXT(F(1),'!2_!UJ, !UJ,', - 1 TCD(TCOD(0)),TCOD(2)) - END IF - IF (TCOD(0).EQ.T_S) THEN - TCOD(1)=TCOD(1)+1 !COUNT LINES - I2=WNTIBR(XFDES,LFENTB,TCOD(4)) !REFERENCE - J=2*(LFENTJ(WNTF_IND_J+2*MXNARR-1)- - 1 TRCNT-TCOD(1)+1) !OFFSET - CALL WNCTXT(F(1),'!2_!SJ, !UJ,', - 1 J,1) - END IF - TCOD(1)=TCOD(1)+1 - TSEEN=.TRUE. !END SEEN - END IF !OFFSET - END DO !ENTRIES - END IF !OFFSET - END DO !ALL ENTRIES - CALL WNCTXT(F(1),'!2_!UJ, !UJ };', - 1 0,1) - END IF !OFFSETS -C -C EDIT DATA -C - IF (IF.EQ.5) THEN !_E - CNAM=' ' !NO COMMON - DO I1=0,XFDES_J(WNTB_CNT_J)-1 !ALL ENTRIES - I2=WNTIBR(XFDES,FENTB,I1) !READ ENTRY - IF (FENTJ(WNTF_BTYP_J).EQ.BT_BEG) THEN !NEW STRUCTURE - CALL WNTIO1(0,FENTB,CNAM,LNAM1,LCNAM) !NAME - DO I=0,1 !FORTRAN/CEE - CALL WNCTXT(F(I),'!AS',CTXT(0,I,0)) - CALL WNCTXT(F(I),'!AS !AS edit definitions:', - 1 CTXT(0,I,1),LNAM1) - CALL WNCTXT(F(I),'!AS!79C!AS',CTXT(0,I,1), - 1 CTXT(1,I,0)) - END DO !FORTRAN/CEE - TCOD(1)=0 !COUNT LINES - TCOD(3)=I1 !CURRENT POINTER - ELSE IF (FENTJ(WNTF_BTYP_J).EQ.BT_SDA .AND. - 1 FENTJ(WNTF_DTP_J).NE.0 .AND. - 1 FENTB(WNTF_NAM_1).NE.ICHAR('-')) THEN !OFFSET - TCOD(1)=TCOD(1)+1 !COUNT LINES - ELSE IF (FENTJ(WNTF_BTYP_J).EQ.BT_EBG .AND. - 1 TCOD(1).NE.0) THEN !HAVE SEEN EDIT - DO I=0,2 !FORTRAN/C (2*) - IF (I.EQ.0) THEN - CALL WNCTXT(F(I),'!@INTEGER !AS$EDL,!AS__EL', - 1 LNAM1,LNAM1) - CALL WNCTXT(F(I),'!@ PARAMETER (!_!AS$EDL=!UJ,'// - 1 '!#C!! Length table!/!@&!2_!AS__EL=!UJ)', - 1 LNAM1,TCOD(1),COMPOS, - 1 LNAM1,TCOD(1)) - CALL WNCTXT(F(I),'!@CHARACTER*!UJ !AS_EC(4,!UJ)', - 1 12,LNAM1,TCOD(1)) - CALL WNCTXT(F(I),'!@INTEGER !AS_EJ(4,!UJ)', - 1 LNAM1,TCOD(1)) - ELSE IF (I.EQ.1) THEN !C CHAR. - CALL WNCTXT(F(I),'#define !AS$EDL !UJ'// - 1 '!#C/* Length table */', - 1 LNAM1,TCOD(1),COMPOS+7) - CALL WNCTXT(F(I),'#define !AS__EL !UJ'// - 1 '!#C/* Length table */', - 1 LNAM1,TCOD(1),COMPOS+7) - CALL WNCTXT(F(1),' static char !AS_ec [!UJ][4][!UJ] = {', - 1 LCNAM,TCOD(1),12) - ELSE !C INTEGER - CALL WNCTXT(F(1),' static int !AS_ej [!UJ][4] = {', - 1 LCNAM,TCOD(1)) - END IF !FORTRAN/C - J=TCOD(1) !SAVE LAST - TCOD(1)=0 !COUNT LINES - DO I3=TCOD(3)+1,I1 !ALL ENTRIES - I2=WNTIBR(XFDES,FENTB,I3) !READ ENTRY - IF (FENTJ(WNTF_BTYP_J).EQ.BT_SDA .AND. - 1 FENTJ(WNTF_DTP_J).NE.0 .AND. - 1 FENTB(WNTF_NAM_1).NE.ICHAR('-')) THEN !OFFSET - TCOD(1)=TCOD(1)+1 !COUNT LINE - IF (FENTJ(WNTF_EDIP_J).GT.0) THEN !EDIT GIVEN - I2=WNTIBR(EFDES,EENTB,FENTJ(WNTF_EDIP_J)) !READ EDIT - ELSE - EENTC(WNTE_UNIT_1+1:WNTE_UNIT_1+WNTE_UNIT_N)= - 1 ' ' !MAKE - EENTC(WNTE_SPEC_1+1:WNTE_SPEC_1+WNTE_SPEC_N)= - 1 ' ' - EENTJ(WNTE_EDIT_J)=0 - EENTC(WNTE_PAT_1+1:WNTE_PAT_1+WNTE_PAT_N)= - 1 ECD(FENTJ(WNTF_DTP_J)) - END IF - IF (EENTC(WNTE_PAT_1+1: - 1 WNTE_PAT_1+WNTE_PAT_N).EQ.' ') !NO PATTERN - 1 EENTC(WNTE_PAT_1+1:WNTE_PAT_1+WNTE_PAT_N)= - 1 ECD(FENTJ(WNTF_DTP_J)) - IF (FENTJ(WNTF_DTP_J).EQ.T_S) THEN !STRUCTURE - LNAM2=EENTC(WNTE_SPEC_1+1: - 1 WNTE_SPEC_1+WNTE_SPEC_N) !SPECIAL FIELD - IF (LNAM2.EQ.' ') THEN !NO SPECIAL - I2=WNTIBR(XFDES,LFENTB,FENTJ(WNTF_SREF_J)) !READ REF. - CALL WNTIO1(I,LFENTB,CNAM,LNAM2,LCNAM2) !GET NAME - EENTC(WNTE_SPEC_1+1:WNTE_SPEC_1+WNTE_SPEC_N)= - 1 'S:'//LNAM2 !SET SPECIAL EDIT - END IF - END IF - IF (FENTJ(WNTF_DTP_J).EQ.T_C) THEN !CHARACTER - I4=FENTJ(WNTF_SLEN_J) !LENGTH - ELSE - I4=FENTJ(WNTF_ULEN_J) - END IF - IF (J.EQ.TCOD(1)) THEN !LAST - LNAM='};' - ELSE - LNAM=',' - END IF - IF (I.EQ.0) THEN - CALL WNCTXT(F(I),'!@ DATA !AS_EC(1,!UJ),'// - 1 '!AS_EC(2,!UJ),!AS_EC(3,!UJ),'// - 1 '!AS_EC(4,!UJ)!/!@&!_'// - 1 '/''!AD'',''!AD'',''!AD '',''!AD ''/', - 1 LNAM1,TCOD(1),LNAM1,TCOD(1), - 1 LNAM1,TCOD(1),LNAM1,TCOD(1), - 1 FENTB(WNTF_NAM_1),WNTF_NAM_N, - 1 EENTB(WNTE_PAT_1),WNTE_PAT_N, - 1 EENTB(WNTE_UNIT_1),WNTE_UNIT_N, - 1 EENTB(WNTE_SPEC_1),WNTE_SPEC_N) - CALL WNCTXT(F(I),'!@ DATA !AS_EJ(1,!UJ),'// - 1 '!AS_EJ(2,!UJ),!AS_EJ(3,!UJ),'// - 1 '!AS_EJ(4,!UJ)!/!@&!_'// - 1 '/!UJ,!UJ,!UJ,!UJ/', - 1 LNAM1,TCOD(1),LNAM1,TCOD(1), - 1 LNAM1,TCOD(1),LNAM1,TCOD(1), - 1 FENTJ(WNTF_OFF_J), - 1 MAX(FENTJ(WNTF_TLEN_J),1), - 1 EENTJ(WNTE_EDIT_J),I4) - ELSE IF (I.EQ.1) THEN !C CHAR - CALL WNCTXT(F(1),'!2_'// - 1 '"!AD","!AD","!AD ","!AD "!AS', - 1 FENTB(WNTF_NAM_1),WNTF_NAM_N, - 1 EENTB(WNTE_PAT_1),WNTE_PAT_N, - 1 EENTB(WNTE_UNIT_1),WNTE_UNIT_N, - 1 EENTB(WNTE_SPEC_1),WNTE_SPEC_N, - 1 LNAM) - ELSE !C INT - CALL WNCTXT(F(1),'!2_'// - 1 '!UJ,!UJ,!UJ,!UJ!AS', - 1 FENTJ(WNTF_OFF_J), - 1 MAX(FENTJ(WNTF_TLEN_J),1), - 1 EENTJ(WNTE_EDIT_J),I4, - 1 LNAM) - END IF !FORTRAN/C - END IF !OFFSET - END DO !ENTRIES - END DO !FORTRAN/C - END IF !OFFSET - END DO !ALL ENTRIES - END IF !OFFSETS -C -C DATA -C - IF (IF.EQ.1) THEN !.DEF ASKED - USEEN=-1 !NO UNION - CNAM=' ' !NO COMMON - DO I=0,1 !FORTRAN/CEE - CALL WNCTXT(F(I),'!AS',CTXT(0,I,0)) - CALL WNCTXT(F(I),'!AS Data declarations:',CTXT(0,I,1)) - CALL WNCTXT(F(I),'!AS!79C!AS',CTXT(0,I,1), - 1 CTXT(1,I,0)) - DO I1=0,XFDES_J(WNTB_CNT_J)-1 !ALL ENTRIES - I2=WNTIBR(XFDES,FENTB,I1) !READ ENTRY - IF (FENTJ(WNTF_BTYP_J).EQ.BT_DAT .AND. - 1 FENTB(WNTF_NAM_1).NE.ICHAR('-')) THEN !DATA ENTRY - IF (I.EQ.1 .AND. (FENTJ(WNTF_REFP_J).LE.0 .OR. - 1 FENTJ(WNTF_REFP_J).GT.I1) .AND. - 1 FENTJ(WNTF_DTP_J).NE.0 .AND. - 1 USEEN.GE.0) THEN !END UNION - I2=WNTIBR(XFDES,LFENTB,USEEN) !READ REF. NAME - CALL WNTIO1(I,LFENTB,CNAM,LNAM1,LCNAM) !GET NAME - CALL WNCTXT(F(I),' } !AS;',LCNAM) !UNION NAME - USEEN=-1 !READY - END IF - IF (FENTJ(WNTF_REFP_J).GT.I1 .AND. - 1 FENTJ(WNTF_DTP_J).NE.0 .AND. - 1 I.EQ.1) THEN !START = REFERENCE - CALL WNCTXT(F(I),' union {') - USEEN=I1 !SAVE WHERE - END IF - CALL WNTIO3(I,F,FENTB,FENTJ,CNAM) !SHOW LINE - IF (FENTJ(WNTF_REFP_J).GT.0 .AND. - 1 FENTJ(WNTF_DTP_J).NE.0 .AND. - 1 FENTJ(WNTF_REFP_J).LT.I1 .AND. - 1 I.EQ.0) THEN !THIS IS = REFERENCE - I2=WNTIBR(XFDES,LFENTB,FENTJ(WNTF_REFP_J)) !READ REF. NAME - CALL WNCTXT(F(I),'!@ EQUIVALENCE (!AD,!AD)', - 1 FENTB(WNTF_NAM_1),WNTF_NAM_N, - 1 LFENTB(WNTF_NAM_1),WNTF_NAM_N) - END IF != REFERENCE - END IF !DATA ENTRY - END DO !ALL ENTRIES - IF (I.EQ.1 .AND. USEEN.GE.0) THEN !END UNION - I2=WNTIBR(XFDES,LFENTB,USEEN) !READ REF. NAME - CALL WNTIO1(I,LFENTB,CNAM,LNAM1,LCNAM) !GET NAME - CALL WNCTXT(F(I),' } !AS;',LCNAM) !UNION NAME - USEEN=-1 !READY - END IF - END DO !FORTRAN/CEE - END IF !.DEF ASKED -C -C COMMON DATA -C - IF (IF.EQ.1 .OR. IF.EQ.2) THEN !.DEF ASKED - CSEEN=.FALSE. !NO COMMON BLOCK - USEEN=-1 !NO UNION - CNAM=' ' !NO COMMON NAME - DO I1=0,XFDES_J(WNTB_CNT_J)-1 !ALL ENTRIES - I2=WNTIBR(XFDES,FENTB,I1) !READ ENTRY - IF (FENTJ(WNTF_BTYP_J).EQ.BT_DCM) THEN !NEW COMMON - IF (CSEEN) THEN !FINISH OLD - CALL WNCTXT(F(1),'};') - END IF - CALL WNTIO1(I,FENTB,CNAM,CNAM,LCNAM) !GET NAME - DO I=0,1 !FORTRAN/CEE - CALL WNCTXT(F(I),'!AS',CTXT(0,I,0)) - CALL WNCTXT(F(I),'!AS !AS common data:', - 1 CTXT(0,I,1),CNAM) - CALL WNCTXT(F(I),'!AS!79C!AS',CTXT(0,I,1), - 1 CTXT(1,I,0)) - END DO - CALL WNCTXT(F(1),'struct !AS_com {',LCNAM) - CSEEN=.TRUE. !SET ONE ACTIVE - ELSE IF (FENTJ(WNTF_BTYP_J).EQ.BT_COM) THEN !DATA ENTRY - IF ((FENTJ(WNTF_REFP_J).LE.0 .OR. - 1 FENTJ(WNTF_REFP_J).GT.I1) .AND. - 1 FENTJ(WNTF_DTP_J).NE.0 .AND. - 1 USEEN.GE.0) THEN !END UNION - I2=WNTIBR(XFDES,LFENTB,USEEN) !READ REF. NAME - CALL WNTIO1(I,LFENTB,CNAM,LNAM1,LCNAM) !GET NAME - CALL WNCTXT(F(1),' } !AS;',LCNAM) !UNION NAME - USEEN=-1 !READY - END IF - IF (FENTJ(WNTF_REFP_J).GT.I1 .AND. - 1 FENTJ(WNTF_DTP_J).NE.0) THEN !START = REFERENCE - CALL WNCTXT(F(1),' union {') - USEEN=I1 !SAVE WHERE - END IF - DO I=0,1 !FORTRAN/CEE - IF (IF.EQ.2) THEN - CALL WNTIO3(I,F,FENTB,FENTJ,CNAM) !SHOW LINE WITH INIT - ELSE - CALL WNTIO2(I,F,FENTB,FENTJ,CNAM) !SHOW LINE NO INIT - END IF - IF (FENTJ(WNTF_REFP_J).GT.0 .AND. - 1 FENTJ(WNTF_REFP_J).LT.I1 .AND. - 1 I.EQ.0) THEN !THIS IS = REFERENCE - I2=WNTIBR(XFDES,LFENTB,FENTJ(WNTF_REFP_J)) !READ REF. NAME - CALL WNCTXT(F(I),'!@ EQUIVALENCE (!AD,!AD)', - 1 FENTB(WNTF_NAM_1),WNTF_NAM_N, - 1 LFENTB(WNTF_NAM_1),WNTF_NAM_N) - END IF != REFERENCE - END DO !FORTRAN/CEE - END IF !DATA ENTRY - END DO !ALL ENTRIES - IF (USEEN.GE.0) THEN !END UNION - I2=WNTIBR(XFDES,LFENTB,USEEN) !READ REF. NAME - CALL WNTIO1(I,LFENTB,CNAM,LNAM1,LCNAM) !GET NAME - CALL WNCTXT(F(1),' } !AS;',LCNAM) !UNION NAME - USEEN=-1 !READY - END IF - IF (CSEEN) THEN !FINISH OLD - CALL WNCTXT(F(1),'};') - END IF - END IF !.DEF ASKED -C -C COMMON BLOCK -C - IF (IF.EQ.1 .OR. IF.EQ.2) THEN !.DEF ASKED - CSEEN=.FALSE. !NO COMMON ENTRIES - CNAM=' ' !NO COMMON - DO I1=0,XFDES_J(WNTB_CNT_J)-1 !ALL ENTRIES - I2=WNTIBR(XFDES,FENTB,I1) !READ ENTRY - IF (FENTJ(WNTF_BTYP_J).EQ.BT_DCM) THEN !NEW COMMON - IF (CSEEN) THEN !FINISH OLD - DO I=0,0 !FORTRAN/C - CALL WNCTXT(F(I),'!AS',LIN1) !LAST LINE PREVIOUS - END DO !FORTRAN/C - END IF - CALL WNTIO1(I,FENTB,CNAM,CNAM,LCNAM) !GET NAME - DO I=0,1 !FORTRAN/CEE - CALL WNCTXT(F(I),'!AS',CTXT(0,I,0)) - CALL WNCTXT(F(I),'!AS !AS common block:', - 1 CTXT(0,I,1),CNAM) - CALL WNCTXT(F(I),'!AS!79C!AS',CTXT(0,I,1), - 1 CTXT(1,I,0)) - END DO - CALL WNCTXT(F(1),'#ifdef wn_cv__!/$'// - 1 '#define !AS_com_ _!AS_com_!/$'// - 1 '#endif',LCNAM,LCNAM) - CALL WNCTXT(F(1),'extern struct !AS_com !AS_com_ ;', - 1 LCNAM,LCNAM) !C REFERENCE - CALL WNCTXS(LIN1,'!@COMMON /!AS_COM/ ', - 1 CNAM) !HEADER - I4=WNCALN(LIN1)+1 !LENGTH FILLED - CSEEN=.FALSE. !NO COMMON ENTRIES - ELSE IF (FENTJ(WNTF_BTYP_J).EQ.BT_COM .AND. - 1 FENTJ(WNTF_DTP_J).NE.0) THEN !DATA ENTRY - CALL WNTIO1(I,FENTB,CNAM,LNAM1,LCNAM) !GET NAME - DO I=0,0 !FORTRAN - IF (FENTJ(WNTF_REFP_J).GT.0 .AND. - 1 FENTJ(WNTF_REFP_J).LT.I1) THEN !SKIP EQUIVALENCE - ELSE - IF (I4.GE.COMPOS-10) THEN !NEW LINE - CALL WNCTXT(F(I),'!AS,',LIN1) !PRINT LINE - CALL WNCTXS(LIN1,'!@&!2_,') - I4=WNCALN(LIN1)-1 - ELSE IF (CSEEN) THEN - I4=I4+1 !ADD , - LIN1(I4:I4)=',' - END IF - CSEEN=.TRUE. !NAME SEEN - CALL WNCTXS(LIN1(I4+1:),'!AS', - 1 LNAM1) !ADD NAME - I4=WNCALN(LIN1) - END IF !EQUIVALENCE - END DO !FORTRAN/CEE - END IF !DATA ENTRY - END DO !ALL ENTRIES - IF (CSEEN) THEN !LAST COMMON LINE - DO I=0,0 !FORTRAN - CALL WNCTXT(F(I),'!AS',LIN1) - END DO !FORTRAN/CEE - END IF - END IF !.DEF ASKED -C -C NEXT FILE -C - 101 CONTINUE - IF (IF.EQ.1 .AND. CINSN) THEN !INDICATE EXTERNAL BD - DO I=0,1 !FORTRAN/C - CALL WNCTXT(F(I),'!AS',CTXT(0,I,0)) - CALL WNCTXT(F(I),'!AS External initialisation:', - 1 CTXT(0,I,1)) - CALL WNCTXT(F(I),'!AS!79C!AS',CTXT(0,I,1), - 1 CTXT(1,I,0)) - LNAM=PARM(P_NAM) - IF (I.EQ.0) THEN !FORTRAN - CALL WNCAUC(LNAM) - CALL WNCTXT(F(I),'!@EXTERNAL !AS_BD',LNAM) - ELSE !C - CALL WNCALC(LNAM) - CALL WNCTXT(F(I),' extern !AS_bd_() ;',LNAM) - END IF - END DO !FORTRAN/C - END IF - IF (IF.EQ.1 .OR. (IF.EQ.3 .AND. .NOT.DEFSN .AND. - 1 .NOT.(PARSN .AND. .NOT.BEGSN))) THEN !FORTRAN END - DO I=0,1 !FORTRAN/C - CALL WNCTXT(F(I),'!AS',CTXT(0,I,0)) - CALL WNCTXT(F(I),'!AS Given statements:',CTXT(0,I,1)) - CALL WNCTXT(F(I),'!AS!79C!AS',CTXT(0,I,1), - 1 CTXT(1,I,0)) - IF (I.EQ.0) THEN !FORTRAN - DO I1=0,FEDES_J(WNTB_CNT_J)-1 !ALL LINES - I2=WNTIBR(FEDES,FMENTB,I1) !READ LINE - CALL WNCTXT(F(I),'!@!AD', - 1 FMENTB,MXSLIN) - END DO - ELSE !C - DO I1=0,CEDES_J(WNTB_CNT_J)-1 !ALL LINES - I2=WNTIBR(CEDES,FMENTB,I1) !READ LINE - CALL WNCTXT(F(I),'!@!AD', - 1 FMENTB,MXSLIN) - END DO - END IF - END DO !FORTRAN/C - END IF - IF (IF.EQ.2) THEN !_BD - CALL WNCTXT(F(0),'!AS',CTXT(0,0,0)) - CALL WNCTXT(F(0),'!AS',CTXT(0,0,0)) - CALL WNCTXT(F(0),'!@END',CTXT(0,0,0)) - END IF - DO I=0,1 !TRAILER - CALL WNCTXT(F(I),'!AS-!79C!AS', - 1 CTXT(0,I,0),CTXT(1,I,0)) - CALL WNCFCL(F(I)) !CLOSE OUTPUT - IF (F(I).NE.0) - 1 CALL WNCTXT(F_P,'!AS!20C$generated',FNAM(I)) - END DO - 100 CONTINUE - END DO -C -C READY -C - 800 CONTINUE -C - RETURN -C -C - END diff --git a/src/wng/wntios.for.cmv b/src/wng/wntios.for.cmv deleted file mode 100644 index b5a5111afeb9e18f852b18d752f9707e4d6fc7da..0000000000000000000000000000000000000000 --- a/src/wng/wntios.for.cmv +++ /dev/null @@ -1,1177 +0,0 @@ -C+ WNTIOS.FOR -C WNB 930501 -C -C Revisions: -C WNB 930818 Edit incorrect for <,1>; no edit length -C WNB 931123 Incorrect _T for multiple sub-structures -C WNB 940223 Convex COMMON block reference -C JPH 941010 EC length 10 --> 12 in output to F(I) -C - SUBROUTINE WNTIOS -C -C Output .DSC structure files -C -C Result: -C -C CALL WNTIOS outputs all the structure files (.DEF, .INC, _BD.FOR, -C _BD.CEE, _O.DEF/INC, _E.DEF/INC, _T.DEF/INC). -C -C Include files: -C - INCLUDE 'WNG_DEF' - INCLUDE 'WNT_O_DEF' - INCLUDE 'WNT_DEF' -C -C Parameters: -C - INTEGER NFILE !#OF OUTPUT TYPES - PARAMETER (NFILE=5) -C -C Arguments: -C -C -C Function references: -C - INTEGER WNCALN !STRING LENGTH - INTEGER WNTIBR !READ DATA AREA - INTEGER WNTIBW !WRITE DATA AREA -C -C Data declarations: -C - LOGICAL DOPAR !OUTPUT PARAMETERS - LOGICAL CSEEN !COMMON DATA SEEN - INTEGER USEEN != REFERENCE SEEN - LOGICAL TSEEN !TRANSLATION SEEN - INTEGER IF !FILE LOOP - INTEGER NCOM !COMMENT LINE COUNT - INTEGER TTCNT,TRCNT !TOTAL TRANSLATION COUNT - INTEGER FDEF(0:1) !DEFAULT FILE CODE - DATA FDEF/F_0,F_1/ - INTEGER F(0:1) !CURRENT FILE CODE - CHARACTER*(MXLNAM) FNAM(0:1) !OUTPUT FILE NAME - CHARACTER*(MXLNAM) LNAM,LNAM1,LNAM2 !LOCAL DATA - CHARACTER*(MXLNAM) LCNAM,LCNAM2 !LC NAME - CHARACTER*(MXLNAM) CNAM !COMMON NAME - CHARACTER*80 LIN1 !OUTPUT LINE - CHARACTER*60 CSTR - INTEGER TCOD(0:4) !TRANSLATION CHECK DATA - CHARACTER*8 FTXT(0:1,NFILE) !FILE EXTENSIONS - DATA FTXT/'.def','.inc','_bd.for',' ','_o.def','_o.inc', - 1 '_t.def','_t.inc','_e.def','_e.inc'/ - CHARACTER*2 CTXT(0:1,0:1,0:1) !COMMENT TEXT - DATA CTXT/'C',' ','/*','*/', - 1 'C',' ','..',' '/ - BYTE FENTB(0:WNTFHDL-1) !DATA ENTRY - INTEGER FENTJ(0:WNTFHDL/LB_J-1) - EQUIVALENCE (FENTB,FENTJ) - BYTE LFENTB(0:WNTFHDL-1) !DATA ENTRY - INTEGER LFENTJ(0:WNTFHDL/LB_J-1) - EQUIVALENCE (LFENTB,LFENTJ) - BYTE EENTB(0:WNTEHDL-1) !EDIT ENTRY - CHARACTER*(WNTEHDL) EENTC - INTEGER EENTJ(0:WNTEHDL/LB_J-1) - EQUIVALENCE (EENTB,EENTC,EENTJ) - BYTE DENTB(0:WNTDHDL-1) !DATA INIT ENTRY - INTEGER DENTJ(0:WNTDHDL/LB_J-1) - EQUIVALENCE (DENTB,DENTJ) - BYTE IENTB(0:WNTIHDL-1) !LINE ENTRY - INTEGER IENTJ(0:WNTIHDL-1) - EQUIVALENCE (IENTB,IENTJ) - BYTE FMENTB(0:MXSLIN-1) !FORTRAN/C LINE - CHARACTER*(MXSLIN) LCENTC !COMMENT LINE - EQUIVALENCE (FMENTB,LCENTC) -C- -C -C INIT -C - CALL WNCTXT(F_P,'!2/') !LOG SPACE -C -C OUTPUT -C - DO IF=1,NFILE !.DEF, _BD, _O, _T, _E - DOPAR=.FALSE. !NO PARAMETERS NOW - IF (IF.EQ.1) THEN - IF (.NOT.DEFSN) THEN - IF (.NOT.(PARSN .AND. .NOT.BEGSN)) GOTO 100 !NO .DEF - DOPAR=.TRUE. - ELSE - IF (.NOT.BEGSN) DOPAR=.TRUE. - END IF - ELSE IF (IF.EQ.2) THEN - IF (.NOT.CINSN) GOTO 100 !NO _BD - DOPAR=.TRUE. !OUTPUT PARAMETERS - ELSE IF (IF.EQ.3) THEN - IF (.NOT.BEGSN) GOTO 100 !NO _O - DOPAR=.TRUE. - ELSE - IF (.NOT.BEGSN) GOTO 100 !NO _T, _E - END IF -C -C OPEN FILES -C - LNAM=PARM(P_NAM) !FILE NAME HEADER - CALL WNCALC(LNAM) !MAKE LC - DO I=0,1 !FOR/C - IF (FTXT(I,IF).NE.' ') THEN !MUST DO - F(I)=FDEF(I) !CORRECT FILE # - ELSE - F(I)=0 !NO FILE # - END IF - FNAM(I)=LNAM(1:WNCALN(LNAM))//FTXT(I,IF) !FORTRAN FILE NAME - CALL WNCFOP(F(I),FNAM(I)(1:WNCALN(FNAM(I)))) !OPEN OUTPUT - CALL WNCAUC(FNAM(I)) !MAKE UC - END DO -C -C HEADERS -C - CALL WNGSGH(LNAM) !HOST NAME - DO I=0,1 - CALL WNCTXT(F(I),'!AS+ Created from !AS\.dsc on !%DN '// - 1 'at !%T at !AS',CTXT(0,I,0), - 1 OINFIL,LNAM) - CALL WNCTXT(F(I),'!AS !AS',CTXT(0,I,1), !FILE NAME - 1 FNAM(I)) - CALL WNCTXT(F(I),'!AS !AS !AS',CTXT(0,I,1), !USER/DATE - 1 PARM(P_USE),PARM(P_DAT)) - CALL WNCTXT(F(I),'!AS',CTXT(0,I,1)) -C -C REVISIONS -C - CALL WNCTXT(F(I),'!AS Revisions:',CTXT(0,I,1)) - CALL WNCTXT(F(I),'!AS',CTXT(0,I,1)) - DO I1=0,RBDES_J(WNTB_CNT_J)-1 !REVISIONS - I2=RBDES_J(WNTB_BPTR_J)+I1*RBDES_J(WNTB_ELEN_J) !POINTER - CALL WNCTXT(F(I),'!AS!_!AD !AD!_!AD',CTXT(0,I,1), - 1 A_B(I2),MXLPAR,A_B(I2+MXLPAR),MXLPAR, - 1 A_B(I2+2*MXLPAR),RBDES_J(WNTB_ELEN_J)-2*MXLPAR) - END DO - CALL WNCTXT(F(I),'!AS!79C!AS',CTXT(0,I,1), - 1 CTXT(1,I,0)) - END DO !FORTRAN/C -C -C FORTRAN/CEE START -C - IF (IF.EQ.2) THEN !_BD - LNAM=PARM(P_NAM) - CALL WNCAUC(LNAM) - CALL WNCTXT(F(0),' BLOCK DATA !AS_BD',LNAM) - END IF - IF ((IF.EQ.1 .OR. IF.EQ.3) .AND. DOPAR) THEN !FORTRAN START - DO I=0,1 !FORTRAN/C - CALL WNCTXT(F(I),'!AS',CTXT(0,I,0)) - CALL WNCTXT(F(I),'!AS Given statements:',CTXT(0,I,1)) - CALL WNCTXT(F(I),'!AS!79C!AS',CTXT(0,I,1), - 1 CTXT(1,I,0)) - IF (I.EQ.0) THEN !FORTRAN - DO I1=0,FMDES_J(WNTB_CNT_J)-1 !ALL LINES - I2=WNTIBR(FMDES,FMENTB,I1) !READ LINE - CALL WNCTXT(F(I),' !AD', - 1 FMENTB,MXSLIN) - END DO - ELSE !C - DO I1=0,CCDES_J(WNTB_CNT_J)-1 !ALL LINES - I2=WNTIBR(CCDES,FMENTB,I1) !READ LINE - CALL WNCTXT(F(I),' !AD', - 1 FMENTB,MXSLIN) - END DO - END IF - END DO !FORTRAN/C - END IF -C -C COMMENTS -C - DO I=0,1 !FORTRAN/C - CALL WNCTXT(F(I),'!AS',CTXT(0,I,0)) - CALL WNCTXT(F(I),'!AS Result:',CTXT(0,I,1)) - CALL WNCTXT(F(I),'!AS',CTXT(0,I,1)) - IF (IF.EQ.2) THEN !_BD - CALL WNCTXT(F(I),'!AS!_Initialisation of !AS!AS',CTXT(0,I,1), - 1 OINFIL,FTXT(I,1)) - CALL WNCTXT(F(I),'!AS',CTXT(0,I,1)) - END IF - DO I1=0,CMDES_J(WNTB_CNT_J)-1 !COMMENTS - I2=CMDES_J(WNTB_BPTR_J)+I1*CMDES_J(WNTB_ELEN_J) !POINTER - CALL WNCTXT(F(I),'!AS !AD',CTXT(0,I,1), - 1 A_B(I2),CMDES_J(WNTB_ELEN_J)) - END DO - CALL WNCTXT(F(I),'!AS!79C!AS',CTXT(0,I,1), - 1 CTXT(1,I,0)) -C -C TRANSLATION HEADER -C - IF (IF.EQ.4) THEN - CSTR='!AS' - CALL WNCTXT(F(I),CSTR,CTXT(0,I,0)) - CSTR='!AS!_Specification of translation tables:' - CALL WNCTXT(F(I),CSTR,CTXT(0,I,1)) - CALL WNCTXT(F(I),'!AS',CTXT(0,I,1)) - CSTR='!AS!_\ 0= end of table!40C\ 1= character' - CALL WNCTXT(F(I),CSTR,CTXT(0,I,1)) - CSTR='!AS!_\ 2= 16 bits integer!40C\ 3= 32 bits integer' - CALL WNCTXT(F(I),CSTR,CTXT(0,I,1)) - CSTR='!AS!_\ 4= 32 bits real!40C\ 5= 64 bits real' - CALL WNCTXT(F(I),CSTR,CTXT(0,I,1)) - CSTR='!AS!_\ 6= repeat!40C\ 7= end repeat' - CALL WNCTXT(F(I),CSTR,CTXT(0,I,1)) - CSTR='!AS!_\ 8= undefined!40C\ 9= byte' - CALL WNCTXT(F(I),CSTR,CTXT(0,I,1)) - CSTR='!AS!_\10= external repeat!40C\11= start union' - CALL WNCTXT(F(I),CSTR,CTXT(0,I,1)) - CSTR='!AS!_\12= start map!40C\13= end union' - CALL WNCTXT(F(I),CSTR,CTXT(0,I,1)) - CSTR='!AS!_\14= 64 bits complex!40C\15= 128 bits complex' - CALL WNCTXT(F(I),CSTR,CTXT(0,I,1)) - CSTR='!AS!79C!AS' - CALL WNCTXT(F(I),CSTR,CTXT(0,I,1),CTXT(1,I,0)) - END IF -C -C EDIT HEADER -C - IF (IF.EQ.5) THEN - CALL WNCTXT(F(I),'!AS',CTXT(0,I,0)) - CALL WNCTXT(F(I),'!AS!_Specification of edit tables:', - 1 CTXT(0,I,1)) - CALL WNCTXT(F(I),'!AS',CTXT(0,I,1)) - CALL WNCTXT(F(I),'!AS The character (_EC) table contains:', - 1 CTXT(0,I,1)) - CSTR='!AS!_\fieldname, pattern, units, special code' - CALL WNCTXT(F(I),CSTR,CTXT(0,I,1)) - CALL WNCTXT(F(I),'!AS The integer (_EJ) table contains:', - 1 CTXT(0,I,1)) - CALL WNCTXT(F(I),'!AS!_\offset, #of values, '// - 1 'edit (0=allowed), unit length', - 1 CTXT(0,I,1)) - CALL WNCTXT(F(I),'!AS!79C!AS',CTXT(0,I,1), - 1 CTXT(1,I,0)) - END IF - END DO !FORTRAN/C -C -C PARAMETERS -C - IF (DOPAR) THEN !PARAMETERS - DO I=0,1 - CALL WNCTXT(F(I),'!AS',CTXT(0,I,0)) - CALL WNCTXT(F(I),'!AS Parameters:',CTXT(0,I,1)) - CALL WNCTXT(F(I),'!AS!79C!AS',CTXT(0,I,1), - 1 CTXT(1,I,0)) - DO I1=0,XFDES_J(WNTB_CNT_J)-1 - I2=WNTIBR(XFDES,FENTB,I1) !READ ENTRY - NCOM=0 !COMMENT LINES - IF (FENTJ(WNTF_BTYP_J).EQ.BT_PAR) THEN !PARAMETER - IF (FENTJ(WNTF_DTP_J).NE.0) THEN !NOT COMMENT - I2=DFDES_J(WNTB_BPTR_J)+ - 1 FENTJ(WNTF_INIP_J)*DFDES_J(WNTB_ELEN_J) !POINTER INIT - END IF - IF (FENTJ(WNTF_DTP_J).EQ.0) THEN - CALL WNTIO4(I,F,FENTB,FENTJ,CNAM) !COMMENT LINE - ELSE IF (FENTJ(WNTF_DTP_J).NE.T_C) THEN !NUMERIC - IF (I.EQ.0) THEN !FORTRAN - CALL WNTIO2(I,F,FENTB,FENTJ,CNAM) !DATA LINE - CALL WNCTXT(F(I),' PARAMETER ( !AD=!AD )', - 1 FENTB(WNTF_NAM_1),WNTF_NAM_N, - 1 A_B(I2+WNTD_STR_1),WNTD_STR_N) - ELSE !C - CALL WNCTXS(LCENTC,'#define !AD !AD', - 1 FENTB(WNTF_NAM_1),WNTF_NAM_N, - 1 A_B(I2+WNTD_STR_1),WNTD_STR_N) - CALL WNTIO6(F,I,LCENTC,FENTJ,IENTJ,NCOM) !SHOW COMMENT - CALL WNTIO7(F,I,LCENTC,FENTJ,IENTJ,NCOM) !FINAL COMMENTS - END IF - ELSE !ALPHA - IF (I.EQ.0) THEN !FORTRAN - CALL WNTIO2(I,F,FENTB,FENTJ,CNAM) !DATA LINE - CALL WNCTXT(F(I), - 1 ' PARAMETER ( !AD=''!AD'' )', - 1 FENTB(WNTF_NAM_1),WNTF_NAM_N, - 1 A_B(I2+WNTD_STR_1),WNTD_STR_N) - ELSE !C - CALL WNCTXS(LCENTC,'#define !AD !AD', - 1 FENTB(WNTF_NAM_1),WNTF_NAM_N, - 1 A_B(I2+WNTD_STR_1),WNTD_STR_N) - CALL WNTIO6(F,I,LCENTC,FENTJ,IENTJ,NCOM) !SHOW COMMENT - CALL WNTIO7(F,I,LCENTC,FENTJ,IENTJ,NCOM) !FINAL COMMENTS - END IF - END IF - END IF - END DO - END DO - END IF -C -C LENGTH, VERSION, SYSTEM, OFFSETS -C - IF (IF.EQ.3) THEN !_O - USEEN=-1 !NO UNION - CNAM=' ' !NO NAME - DO I1=0,XFDES_J(WNTB_CNT_J)-1 !ALL ENTRIES - I2=WNTIBR(XFDES,FENTB,I1) !READ ENTRY - IF (FENTJ(WNTF_BTYP_J).EQ.BT_BEG) THEN !NEW STRUCTURE - CALL WNTIO1(0,FENTB,CNAM,LNAM1,LCNAM) !NAME - CNAM=LNAM1 - DO I=0,1 !FORTRAN/CEE - NCOM=0 !COMMENT COUNT - CALL WNCTXT(F(I),'!AS',CTXT(0,I,0)) - CALL WNCTXT(F(I),'!AS !AS structure definitions:', - 1 CTXT(0,I,1),LNAM1) - CALL WNCTXT(F(I),'!AS!79C!AS',CTXT(0,I,1), - 1 CTXT(1,I,0)) - IF (I.EQ.0) THEN !FORTRAN - CALL WNCTXT(F(I), - 1 ' INTEGER !AS\HDL,!AS\HDV,!AS\HDS', - 1 LNAM1,LNAM1,LNAM1) - CALL WNCTXT(F(I),' PARAMETER (!_!AS\HDL=!UJ,'// - 1 '!#C!! Length!/ 1!2_!AS\HDV=!AS,'// - 1 '!#C!! Version!/ 1!2_!AS\HDS=!AS)'// - 1 '!#C!! System', - 1 LNAM1,FENTJ(WNTF_TLEN_J),COMPOS, - 1 LNAM1,PARM(P_VER),COMPOS, - 1 LNAM1,PARM(P_SYS),COMPOS) - CALL WNCTXT(F(I),' INTEGER !AS__L,!AS__V,!AS__S', - 1 LNAM1,LNAM1,LNAM1) - CALL WNCTXT(F(I),' PARAMETER (!_!AS__L=!UJ,'// - 1 '!#C!! Length!/ 1!2_!AS__V=!AS,'// - 1 '!#C!! Version!/ 1!2_!AS__S=!AS)'// - 1 '!#C!! System', - 1 LNAM1,FENTJ(WNTF_TLEN_J),COMPOS, - 1 LNAM1,PARM(P_VER),COMPOS, - 1 LNAM1,PARM(P_SYS),COMPOS) - ELSE !C - CALL WNCTXT(F(I),'#define !AS\HDL !UJ'// - 1 '!#C/* Length */', - 1 LNAM1,FENTJ(WNTF_TLEN_J),COMPOS+7) - CALL WNCTXT(F(I),'#define !AS\HDV !AS'// - 1 '!#C/* Version */', - 1 LNAM1,PARM(P_VER),COMPOS+7) - CALL WNCTXT(F(I),'#define !AS\HDS !AS'// - 1 '!#C/* System */', - 1 LNAM1,PARM(P_SYS),COMPOS+7) - CALL WNCTXT(F(I),'#define !AS__L !UJ'// - 1 '!#C/* Length */', - 1 LNAM1,FENTJ(WNTF_TLEN_J),COMPOS+7) - CALL WNCTXT(F(I),'#define !AS__V !AS'// - 1 '!#C/* Version */', - 1 LNAM1,PARM(P_VER),COMPOS+7) - CALL WNCTXT(F(I),'#define !AS__S !AS'// - 1 '!#C/* System */', - 1 LNAM1,PARM(P_SYS),COMPOS+7) - END IF - CALL WNCTXT(F(I),'!AS',CTXT(0,I,0)) - CALL WNCTXT(F(I),'!AS !AS Offsets:', - 1 CTXT(0,I,1),LNAM1) - CALL WNCTXT(F(I),'!AS!79C!AS',CTXT(0,I,1), - 1 CTXT(1,I,0)) - IF (I.EQ.1) THEN - CALL WNCTXS(LCENTC,'struct !AS {',LCNAM) !STRUCTURE NAME - CALL WNTIO6(F,I,LCENTC,FENTJ,IENTJ,NCOM) !SHOW COMMENT - END IF - CALL WNTIO7(F,I,LCENTC,FENTJ,IENTJ,NCOM) !FINAL COMMENTS - END DO !FORTRAN/CEE - ELSE IF (FENTJ(WNTF_BTYP_J).EQ.BT_EBG) THEN !END DEFINITION - NCOM=0 !COMMENT COUNT - IF (USEEN.GE.0) THEN !END UNION - I2=WNTIBR(XFDES,LFENTB,USEEN) !READ REF. NAME - CALL WNTIO1(I,LFENTB,CNAM,LNAM2,LCNAM2) !GET NAME - CALL WNCTXT(F(1),' } !AS;',LCNAM2) !UNION NAME - USEEN=-1 !READY - END IF - CALL WNCTXS(LCENTC,'};') !END STRUCTURE - CALL WNTIO6(F,1,LCENTC,FENTJ,IENTJ,NCOM) !SHOW COMMENT - CALL WNTIO7(F,0,LCENTC,FENTJ,IENTJ,NCOM) !FINAL COMMENTS - CALL WNTIO7(F,1,LCENTC,FENTJ,IENTJ,NCOM) !FINAL COMMENTS - ELSE IF (FENTJ(WNTF_BTYP_J).EQ.BT_SDA) THEN !OFFSET - IF ((FENTJ(WNTF_REFP_J).LE.0 .OR. - 1 FENTJ(WNTF_REFP_J).GT.I1) .AND. - 1 FENTJ(WNTF_DTP_J).NE.0 .AND. - 1 USEEN.GE.0) THEN !END UNION - I2=WNTIBR(XFDES,LFENTB,USEEN) !READ REF. NAME - CALL WNTIO1(I,LFENTB,CNAM,LNAM2,LCNAM2) !GET NAME - CALL WNCTXT(F(1),' } !AS;',LCNAM2) !UNION NAME - USEEN=-1 !READY - END IF - IF (FENTJ(WNTF_REFP_J).GT.I1 .AND. - 1 FENTJ(WNTF_DTP_J).NE.0) THEN !START = GREFERENCE - CALL WNCTXT(F(1),' union {') - USEEN=I1 !SAVE WHERE - END IF - DO I=0,1 !FORTRAN/C - IF (I.EQ.1 .OR. FENTB(WNTF_NAM_1).NE.ICHAR('-')) THEN !NAME - NCOM=0 !COMMENT COUNT - IF (FENTJ(WNTF_DTP_J).EQ.0) THEN !COMMENT - CALL WNTIO4(I,F,FENTB,FENTJ,CNAM) - ELSE IF (FENTJ(WNTF_DTP_J).EQ.T_S) THEN !STRUCTURE - I2=WNTIBR(XFDES,LFENTB,FENTJ(WNTF_SREF_J)) !REF. DATA - IF (I.EQ.0) THEN !FORTRAN - CALL WNCTXS(LCENTC,' INTEGER !AS_!AD_1,'// - 1 '!AS_!AD_N', - 1 LNAM1,FENTB(WNTF_NAM_1),WNTF_NAM_N, - 1 LNAM1,FENTB(WNTF_NAM_1),WNTF_NAM_N) - CALL WNTIO6(F,I,LCENTC,FENTJ,IENTJ,NCOM) !SHOW COMMENT - CALL WNCTXS(LCENTC,' PARAMETER (!AS_!AD_1=!UJ,'// - 1 '!AS_!AD_N=!UJ)', - 1 LNAM1,FENTB(WNTF_NAM_1),WNTF_NAM_N, - 1 FENTJ(WNTF_OFF_J), - 1 LNAM1,FENTB(WNTF_NAM_1),WNTF_NAM_N, - 1 LFENTJ(WNTF_TLEN_J)) - CALL WNTIO6(F,I,LCENTC,FENTJ,IENTJ,NCOM) !SHOW COMMENT - IF (MOD(FENTJ(WNTF_OFF_J), - 1 LFENTJ(WNTF_TLEN_J)).EQ.0) THEN !CORRECT OFFSET - CALL WNCTXS(LCENTC,' INTEGER !AS_!AD_!AS', - 1 LNAM1,FENTB(WNTF_NAM_1),WNTF_NAM_N, - 1 CD1(FENTJ(WNTF_DTP_J))) - CALL WNTIO6(F,I,LCENTC,FENTJ,IENTJ,NCOM) !SHOW COMMENT - CALL WNCTXS(LCENTC,' PARAMETER (!AS_!AD_!AS=!UJ)', - 1 LNAM1,FENTB(WNTF_NAM_1),WNTF_NAM_N, - 1 CD1(FENTJ(WNTF_DTP_J)), - 1 FENTJ(WNTF_OFF_J)/FENTJ(WNTF_ULEN_J)) - CALL WNTIO6(F,I,LCENTC,FENTJ,IENTJ,NCOM) !SHOW COMMENT - END IF - DO I3=1,T__N-1 !ALL OFFSETS - IF (CD1(I3).NE.'S' .AND. CD2(I3).NE.0) THEN - IF (MOD(FENTJ(WNTF_OFF_J),CD2(I3)).EQ.0) THEN - CALL WNCTXS(LCENTC,' INTEGER !AS_!AD_!AS', - 1 LNAM1,FENTB(WNTF_NAM_1),WNTF_NAM_N, - 1 CD1(I3)) - CALL WNTIO6(F,I,LCENTC,FENTJ,IENTJ,NCOM) - CALL WNCTXS(LCENTC,' PARAMETER '// - 1 '(!AS_!AD_!AS=!UJ)', - 1 LNAM1,FENTB(WNTF_NAM_1),WNTF_NAM_N, - 1 CD1(I3),FENTJ(WNTF_OFF_J)/CD2(I3)) - CALL WNTIO6(F,I,LCENTC,FENTJ,IENTJ,NCOM) - END IF - END IF - END DO - CALL WNTIO7(F,I,LCENTC,FENTJ,IENTJ,NCOM) !FINAL COMMENTS - ELSE !C - CALL WNTIO2(I,F,FENTB,FENTJ,CNAM) !SHOW LINE NO INIT - END IF !FORTRAN/C - ELSE IF (FENTJ(WNTF_DTP_J).NE.T_C) THEN !NUMERIC - IF (I.EQ.0) THEN !FORTRAN - IF (MOD(FENTJ(WNTF_OFF_J), - 1 FENTJ(WNTF_ULEN_J)).EQ.0) THEN !CORRECT OFFSET - CALL WNCTXS(LCENTC,' INTEGER !AS_!AD_1,'// - 1 '!AS_!AD_!AS', - 1 LNAM1, - 1 FENTB(WNTF_NAM_1),WNTF_NAM_N, - 1 LNAM1, - 1 FENTB(WNTF_NAM_1),WNTF_NAM_N, - 1 CD1(FENTJ(WNTF_DTP_J))) - CALL WNTIO6(F,I,LCENTC,FENTJ,IENTJ,NCOM) !SHOW COMMENT - CALL WNCTXS(LCENTC,' PARAMETER (!AS_!AD_1=!UJ,'// - 1 '!AS_!AD_!AS=!UJ)', - 1 LNAM1, - 1 FENTB(WNTF_NAM_1),WNTF_NAM_N, - 1 FENTJ(WNTF_OFF_J), - 1 LNAM1, - 1 FENTB(WNTF_NAM_1),WNTF_NAM_N, - 1 CD1(FENTJ(WNTF_DTP_J)), - 1 FENTJ(WNTF_OFF_J)/FENTJ(WNTF_ULEN_J)) - CALL WNTIO6(F,I,LCENTC,FENTJ,IENTJ,NCOM) !SHOW COMMENT - ELSE !INCORRECT OFFSET - CALL WNCTXS(LCENTC,' INTEGER !AS_!AD_1', - 1 LNAM1, - 1 FENTB(WNTF_NAM_1),WNTF_NAM_N) - CALL WNTIO6(F,I,LCENTC,FENTJ,IENTJ,NCOM) !SHOW COMMENT - CALL WNCTXS(LCENTC,' PARAMETER (!AS_!AD_1=!UJ)', - 1 LNAM1, - 1 FENTB(WNTF_NAM_1),WNTF_NAM_N, - 1 FENTJ(WNTF_OFF_J)) - CALL WNTIO6(F,I,LCENTC,FENTJ,IENTJ,NCOM) !SHOW COMMENT - END IF - CALL WNTIO7(F,I,LCENTC,FENTJ,IENTJ,NCOM) !FINAL COMMENTS - ELSE !C - CALL WNTIO2(I,F,FENTB,FENTJ,CNAM) !SHOW LINE NO INIT - END IF - ELSE !CHARACTER - IF (I.EQ.0) THEN !FORTRAN - CALL WNCTXS(LCENTC,' INTEGER !AS_!AD_1,'// - 1 '!AS_!AD_!AS,!AS_!AD_N', - 1 LNAM1, - 1 FENTB(WNTF_NAM_1),WNTF_NAM_N, - 1 LNAM1, - 1 FENTB(WNTF_NAM_1),WNTF_NAM_N, - 1 CD1(FENTJ(WNTF_DTP_J)), - 1 LNAM1, - 1 FENTB(WNTF_NAM_1),WNTF_NAM_N) - CALL WNTIO6(F,I,LCENTC,FENTJ,IENTJ,NCOM) !SHOW COMMENT - CALL WNCTXS(LCENTC,' PARAMETER (!AS_!AD_1=!UJ,'// - 1 '!AS_!AD_!AS=!UJ,!AS_!AD_N=!UJ)', - 1 LNAM1, - 1 FENTB(WNTF_NAM_1),WNTF_NAM_N, - 1 FENTJ(WNTF_OFF_J), - 1 LNAM1, - 1 FENTB(WNTF_NAM_1),WNTF_NAM_N, - 1 CD1(FENTJ(WNTF_DTP_J)), - 1 FENTJ(WNTF_OFF_J)/FENTJ(WNTF_ULEN_J), - 1 LNAM1, - 1 FENTB(WNTF_NAM_1),WNTF_NAM_N, - 1 FENTJ(WNTF_SLEN_J)) - CALL WNTIO6(F,I,LCENTC,FENTJ,IENTJ,NCOM) !SHOW COMMENT - CALL WNTIO7(F,I,LCENTC,FENTJ,IENTJ,NCOM) !FINAL COMMENTS - ELSE !C - CALL WNTIO2(I,F,FENTB,FENTJ,CNAM) !SHOW LINE NO INIT - END IF - END IF !NUMERIC/CHARACTER - END IF !NAME GIVEN - END DO !FORTRAN/C - END IF !OFFSET - END DO !ALL ENTRIES - END IF !OFFSETS -C -C TRANSLATION DATA -C - IF (IF.EQ.4) THEN !_T - CNAM=' ' !NO COMMON - TTCNT=0 !TOTAL TRANSLATION COUNT - LNAM2=PARM(P_NAM) !FILE NAME - CALL WNCAUC(LNAM2) - CALL WNCTXT(F(1),' static struct {') - DO I1=0,XFDES_J(WNTB_CNT_J)-1 !ALL ENTRIES - I2=WNTIBR(XFDES,FENTB,I1) !READ ENTRY - IF (FENTJ(WNTF_BTYP_J).EQ.BT_BEG) THEN !NEW STRUCTURE - CALL WNTIO1(0,FENTB,CNAM,LNAM1,LCNAM) !GET NAME - DO I=0,1 !FORTRAN/CEE - CALL WNCTXT(F(I),'!AS',CTXT(0,I,0)) - CALL WNCTXT(F(I),'!AS !AS translation definitions:', - 1 CTXT(0,I,1),LNAM1) - CALL WNCTXT(F(I),'!AS!79C!AS',CTXT(0,I,1), - 1 CTXT(1,I,0)) - END DO !FORTRAN/CEE - TCOD(0)=-1 !CHECK CODE - TCOD(1)=0 !COUNT LINES - TCOD(2)=0 !ITEM COUNT - TCOD(3)=I1 !CURRENT POINTER - ELSE IF (FENTJ(WNTF_BTYP_J).EQ.BT_SDA .AND. - 1 FENTJ(WNTF_DTP_J).NE.0 .AND. - 1 .NOT.(FENTJ(WNTF_REFP_J).GT.0 .AND. - 1 FENTJ(WNTF_REFP_J).LT.I1)) THEN !OFFSET - IF ((FENTJ(WNTF_DTP_J).NE.TCOD(0) .OR. - 1 FENTJ(WNTF_DTP_J).EQ.T_S).AND. - 1 TCOD(2).GT.0) THEN !NEW LINE - TCOD(1)=TCOD(1)+1 !COUNT LINES - IF (TCOD(0).EQ.T_S) TCOD(1)=TCOD(1)+1 - TCOD(2)=0 !ITEM LENGTH - END IF - I3=FENTJ(WNTF_TLEN_J) !ITEM LENGTH - IF (FENTJ(WNTF_DTP_J).EQ.T_C) - 1 I3=I3*FENTJ(WNTF_SLEN_J) - TCOD(2)=TCOD(2)+I3 - DO WHILE (TCOD(2).GT.32760) - TCOD(2)=TCOD(2)-32760 - TCOD(1)=TCOD(1)+1 !COUNT LINES - IF (TCOD(0).EQ.T_S) TCOD(1)=TCOD(1)+1 - END DO - TCOD(0)=FENTJ(WNTF_DTP_J) - ELSE IF (FENTJ(WNTF_BTYP_J).EQ.BT_EBG .AND. - 1 TCOD(1)+TCOD(2).NE.0) THEN !HAVE SEEN TRANSLATION - IF (TCOD(2).NE.0) THEN - TCOD(1)=TCOD(1)+1 !COUNT LINES - IF (TCOD(0).EQ.T_S) TCOD(1)=TCOD(1)+1 - END IF - DO I=0,1 !FORTRAN/C - IF (I.EQ.0) THEN - CALL WNCTXT(F(I),' INTEGER*2 !AS_T(2,!UJ)', - 1 LNAM1,TCOD(1)+1) - CALL WNCTXT(F(I),' EQUIVALENCE (!AS_T,!AS__T(1,!UJ))', - 1 LNAM1,LNAM2,TTCNT+1) - ELSE !C - CALL WNCTXT(F(I),' short !AS_t [!UJ][2] ;', - 1 LCNAM,TCOD(1)+1) - END IF - END DO !FORTRAN/C - I2=WNTIBR(XFDES,FENTB,TCOD(3)) !READ START ENTRY - FENTJ(WNTF_IND_J+MXNARR*2-1)=TTCNT !SAVE START IN HEADER - I2=WNTIBW(XFDES,FENTB,TCOD(3)) !REWRITE START ENTRY - TRCNT=TTCNT !SAVE CURRENT - TTCNT=TTCNT+TCOD(1)+1 !NEW TOTAL LENGTH - TCOD(0)=-1 !CHECK CODE - TCOD(1)=0 !COUNT LINES - TCOD(2)=0 !ITEM COUNT - DO I3=TCOD(3)+1,I1 !ALL ENTRIES - I2=WNTIBR(XFDES,FENTB,I3) !READ ENTRY - IF (FENTJ(WNTF_BTYP_J).EQ.BT_SDA .AND. - 1 FENTJ(WNTF_DTP_J).NE.0 .AND. - 1 .NOT.(FENTJ(WNTF_REFP_J).GT.0 .AND. - 1 FENTJ(WNTF_REFP_J).LT.I3)) THEN !OFFSET - IF ((TCOD(0).NE.FENTJ(WNTF_DTP_J) .OR. - 1 FENTJ(WNTF_DTP_J).EQ.T_S).AND. - 1 TCOD(2).GT.0) THEN !OUTPUT LINE - TCOD(1)=TCOD(1)+1 !COUNT LINE - DO I=0,0 !FORTRAN/C - CALL WNCTXT(F(I),' DATA !AS_T(1,!UJ),'// - 1 '!AS_T(2,!UJ) /!UJ,!UJ/', - 1 LNAM1,TCOD(1),LNAM1,TCOD(1), - 1 TCD(TCOD(0)),TCOD(2)) - END DO !FORTRAN/C - IF (TCOD(0).EQ.T_S) THEN - TCOD(1)=TCOD(1)+1 !COUNT LINES - I2=WNTIBR(XFDES,LFENTB,TCOD(4)) !REFERENCE - J=2*(LFENTJ(WNTF_IND_J+2*MXNARR-1)- - 1 TRCNT-TCOD(1)+1) !OFFSET - DO I=0,0 !FORTRAN/C - CALL WNCTXT(F(I),' DATA !AS_T(1,!UJ),'// - 1 '!AS_T(2,!UJ) /!SJ,!UJ/', - 1 LNAM1,TCOD(1),LNAM1,TCOD(1), - 1 J,1) - END DO !FORTRAN/C - END IF - TCOD(2)=0 !NEW ITEM - END IF - I4=FENTJ(WNTF_TLEN_J) !ITEM LENGTH - IF (FENTJ(WNTF_DTP_J).EQ.T_C) - 1 I4=I4*FENTJ(WNTF_SLEN_J) - IF (FENTJ(WNTF_DTP_J).EQ.T_S) - 1 TCOD(4)=FENTJ(WNTF_SREF_J) !SAVE REFERENCE - TCOD(2)=TCOD(2)+I4 - DO WHILE (TCOD(2).GT.32760) - TCOD(1)=TCOD(1)+1 !COUNT LINES - DO I=0,0 !FORTRAN/C - CALL WNCTXT(F(I),' DATA !AS_T(1,!UJ),'// - 1 '!AS_T(2,!UJ) /!UJ,!UJ/', - 1 LNAM1,TCOD(1),LNAM1,TCOD(1), - 1 TCD(TCOD(0)),32760) - END DO !FORTRAN/C - IF (TCOD(0).EQ.T_S) THEN - TCOD(1)=TCOD(1)+1 !COUNT LINES - I2=WNTIBR(XFDES,LFENTB,TCOD(4)) !REFERENCE - J=2*(LFENTJ(WNTF_IND_J+2*MXNARR-1)- - 1 TRCNT-TCOD(1)+1) !OFFSET - DO I=0,0 !FORTRAN/C - CALL WNCTXT(F(I),' DATA !AS_T(1,!UJ),'// - 1 '!AS_T(2,!UJ) /!SJ,!UJ/', - 1 LNAM1,TCOD(1),LNAM1,TCOD(1), - 1 J,1) - END DO !FORTRAN/C - END IF - TCOD(2)=TCOD(2)-32760 - END DO - TCOD(0)=FENTJ(WNTF_DTP_J) - ELSE IF (FENTJ(WNTF_BTYP_J).EQ.BT_EBG) THEN !READY - IF (TCOD(2).NE.0) THEN - TCOD(1)=TCOD(1)+1 !COUNT LINES - DO I=0,0 !FORTRAN/C - CALL WNCTXT(F(I),' DATA !AS_T(1,!UJ),'// - 1 '!AS_T(2,!UJ) /!UJ,!UJ/', - 1 LNAM1,TCOD(1),LNAM1,TCOD(1), - 1 TCD(TCOD(0)),TCOD(2)) - END DO !FORTRAN/C - END IF - IF (TCOD(0).EQ.T_S) THEN - TCOD(1)=TCOD(1)+1 !COUNT LINES - I2=WNTIBR(XFDES,LFENTB,TCOD(4)) !REFERENCE - J=2*(LFENTJ(WNTF_IND_J+2*MXNARR-1)- - 1 TRCNT-TCOD(1)+1) !OFFSET - DO I=0,0 !FORTRAN/C - CALL WNCTXT(F(I),' DATA !AS_T(1,!UJ),'// - 1 '!AS_T(2,!UJ) /!SJ,!UJ/', - 1 LNAM1,TCOD(1),LNAM1,TCOD(1), - 1 J,1) - END DO !FORTRAN/C - END IF - TCOD(1)=TCOD(1)+1 - DO I=0,0 !FORTRAN/C - CALL WNCTXT(F(I),' DATA !AS_T(1,!UJ),'// - 1 '!AS_T(2,!UJ) /!UJ,!UJ/', - 1 LNAM1,TCOD(1),LNAM1,TCOD(1), - 1 0,1) - END DO !FORTRAN/C - END IF !OFFSET - END DO !ENTRIES - END IF !OFFSET - END DO !ALL ENTRIES - DO I=0,1 !FORTRAN/C - IF (I.EQ.0) THEN - CALL WNCTXT(F(I),' INTEGER*2 !AS__T(2,!UJ)', - 1 LNAM2,TTCNT) - ELSE !C - CALL WNCALC(LNAM2) - CALL WNCTXT(F(I),' } !AS__t = {', - 1 LNAM2) - END IF - END DO !FORTRAN/C - CNAM=' ' !NO COMMON - TTCNT=0 !TOTAL TRANSLATION COUNT - TSEEN=.FALSE. !NON YET - DO I1=0,XFDES_J(WNTB_CNT_J)-1 !ALL ENTRIES - I2=WNTIBR(XFDES,FENTB,I1) !READ ENTRY - IF (FENTJ(WNTF_BTYP_J).EQ.BT_BEG) THEN !NEW STRUCTURE - CALL WNTIO1(0,FENTB,CNAM,LNAM1,LCNAM) !GET NAME - TCOD(0)=-1 !CHECK CODE - TCOD(1)=0 !COUNT LINES - TCOD(2)=0 !ITEM COUNT - TCOD(3)=I1 !CURRENT POINTER - IF (TSEEN) THEN - CALL WNCTXT(F(1),'!2_!UJ, !UJ,', - 1 0,1) - END IF - ELSE IF (FENTJ(WNTF_BTYP_J).EQ.BT_SDA .AND. - 1 FENTJ(WNTF_DTP_J).NE.0 .AND. - 1 .NOT.(FENTJ(WNTF_REFP_J).GT.0 .AND. - 1 FENTJ(WNTF_REFP_J).LT.I1)) THEN !OFFSET - IF ((FENTJ(WNTF_DTP_J).NE.TCOD(0) .OR. - 1 FENTJ(WNTF_DTP_J).EQ.T_S).AND. - 1 TCOD(2).GT.0) THEN !NEW LINE - TCOD(1)=TCOD(1)+1 !COUNT LINES - IF (TCOD(0).EQ.T_S) TCOD(1)=TCOD(1)+1 - TCOD(2)=0 !ITEM LENGTH - END IF - I3=FENTJ(WNTF_TLEN_J) !ITEM LENGTH - IF (FENTJ(WNTF_DTP_J).EQ.T_C) - 1 I3=I3*FENTJ(WNTF_SLEN_J) - TCOD(2)=TCOD(2)+I3 - DO WHILE (TCOD(2).GT.32760) - TCOD(2)=TCOD(2)-32760 - TCOD(1)=TCOD(1)+1 !COUNT LINES - IF (TCOD(0).EQ.T_S) TCOD(1)=TCOD(1)+1 - END DO - TCOD(0)=FENTJ(WNTF_DTP_J) - ELSE IF (FENTJ(WNTF_BTYP_J).EQ.BT_EBG .AND. - 1 TCOD(1)+TCOD(2).NE.0) THEN !HAVE SEEN TRANSLATION - IF (TCOD(2).NE.0) TCOD(1)=TCOD(1)+1 !COUNT LINES - I2=WNTIBR(XFDES,FENTB,TCOD(3)) !READ START ENTRY - FENTJ(WNTF_IND_J+MXNARR*2-1)=TTCNT !SAVE START IN HEADER - I2=WNTIBW(XFDES,FENTB,TCOD(3)) !REWRITE START ENTRY - TRCNT=TTCNT !SAVE CURRENT - TTCNT=TTCNT+TCOD(1)+1 !NEW TOTAL LENGTH - TCOD(0)=-1 !CHECK CODE - TCOD(1)=0 !COUNT LINES - TCOD(2)=0 !ITEM COUNT - DO I3=TCOD(3)+1,I1 !ALL ENTRIES - I2=WNTIBR(XFDES,FENTB,I3) !READ ENTRY - IF (FENTJ(WNTF_BTYP_J).EQ.BT_SDA .AND. - 1 FENTJ(WNTF_DTP_J).NE.0 .AND. - 1 .NOT.(FENTJ(WNTF_REFP_J).GT.0 .AND. - 1 FENTJ(WNTF_REFP_J).LT.I3)) THEN !OFFSET - IF ((TCOD(0).NE.FENTJ(WNTF_DTP_J) .OR. - 1 FENTJ(WNTF_DTP_J).EQ.T_S).AND. - 1 TCOD(2).GT.0) THEN !OUTPUT LINE - TCOD(1)=TCOD(1)+1 !COUNT LINE - CALL WNCTXT(F(1),'!2_!UJ, !UJ,', - 1 TCD(TCOD(0)),TCOD(2)) - IF (TCOD(0).EQ.T_S) THEN - TCOD(1)=TCOD(1)+1 !COUNT LINES - I2=WNTIBR(XFDES,LFENTB,TCOD(4)) !REFERENCE - J=2*(LFENTJ(WNTF_IND_J+2*MXNARR-1)- - 1 TRCNT-TCOD(1)+1) !OFFSET - CALL WNCTXT(F(1),'!2_!SJ, !UJ,', - 1 J,1) - END IF - TCOD(2)=0 !NEW ITEM - END IF - I4=FENTJ(WNTF_TLEN_J) !ITEM LENGTH - IF (FENTJ(WNTF_DTP_J).EQ.T_C) - 1 I4=I4*FENTJ(WNTF_SLEN_J) - IF (FENTJ(WNTF_DTP_J).EQ.T_S) - 1 TCOD(4)=FENTJ(WNTF_SREF_J) !SAVE REFERENCE - TCOD(2)=TCOD(2)+I4 - DO WHILE (TCOD(2).GT.32760) - TCOD(1)=TCOD(1)+1 !COUNT LINES - CALL WNCTXT(F(1),'!2_!UJ, !UJ,', - 1 TCD(TCOD(0)),32760) - IF (TCOD(0).EQ.T_S) THEN - TCOD(1)=TCOD(1)+1 !COUNT LINES - I2=WNTIBR(XFDES,LFENTB,TCOD(4)) !REFERENCE - J=2*(LFENTJ(WNTF_IND_J+2*MXNARR-1)- - 1 TRCNT-TCOD(1)+1) !OFFSET - CALL WNCTXT(F(1),'!2_!SJ, !UJ,', - 1 J,1) - END IF - TCOD(2)=TCOD(2)-32760 - END DO - TCOD(0)=FENTJ(WNTF_DTP_J) - ELSE IF (FENTJ(WNTF_BTYP_J).EQ.BT_EBG) THEN !READY - IF (TCOD(2).NE.0) THEN - TCOD(1)=TCOD(1)+1 !COUNT LINES - CALL WNCTXT(F(1),'!2_!UJ, !UJ,', - 1 TCD(TCOD(0)),TCOD(2)) - END IF - IF (TCOD(0).EQ.T_S) THEN - TCOD(1)=TCOD(1)+1 !COUNT LINES - I2=WNTIBR(XFDES,LFENTB,TCOD(4)) !REFERENCE - J=2*(LFENTJ(WNTF_IND_J+2*MXNARR-1)- - 1 TRCNT-TCOD(1)+1) !OFFSET - CALL WNCTXT(F(1),'!2_!SJ, !UJ,', - 1 J,1) - END IF - TCOD(1)=TCOD(1)+1 - TSEEN=.TRUE. !END SEEN - END IF !OFFSET - END DO !ENTRIES - END IF !OFFSET - END DO !ALL ENTRIES - CALL WNCTXT(F(1),'!2_!UJ, !UJ };', - 1 0,1) - END IF !OFFSETS -C -C EDIT DATA -C - IF (IF.EQ.5) THEN !_E - CNAM=' ' !NO COMMON - DO I1=0,XFDES_J(WNTB_CNT_J)-1 !ALL ENTRIES - I2=WNTIBR(XFDES,FENTB,I1) !READ ENTRY - IF (FENTJ(WNTF_BTYP_J).EQ.BT_BEG) THEN !NEW STRUCTURE - CALL WNTIO1(0,FENTB,CNAM,LNAM1,LCNAM) !NAME - DO I=0,1 !FORTRAN/CEE - CALL WNCTXT(F(I),'!AS',CTXT(0,I,0)) - CALL WNCTXT(F(I),'!AS !AS edit definitions:', - 1 CTXT(0,I,1),LNAM1) - CALL WNCTXT(F(I),'!AS!79C!AS',CTXT(0,I,1), - 1 CTXT(1,I,0)) - END DO !FORTRAN/CEE - TCOD(1)=0 !COUNT LINES - TCOD(3)=I1 !CURRENT POINTER - ELSE IF (FENTJ(WNTF_BTYP_J).EQ.BT_SDA .AND. - 1 FENTJ(WNTF_DTP_J).NE.0 .AND. - 1 FENTB(WNTF_NAM_1).NE.ICHAR('-')) THEN !OFFSET - TCOD(1)=TCOD(1)+1 !COUNT LINES - ELSE IF (FENTJ(WNTF_BTYP_J).EQ.BT_EBG .AND. - 1 TCOD(1).NE.0) THEN !HAVE SEEN EDIT - DO I=0,2 !FORTRAN/C (2*) - IF (I.EQ.0) THEN - CALL WNCTXT(F(I),' INTEGER !AS\EDL,!AS__EL', - 1 LNAM1,LNAM1) - CALL WNCTXT(F(I),' PARAMETER (!_!AS\EDL=!UJ,'// - 1 '!#C!! Length table!/ 1!2_!AS__EL=!UJ)', - 1 LNAM1,TCOD(1),COMPOS, - 1 LNAM1,TCOD(1)) - CALL WNCTXT(F(I),' CHARACTER*!UJ !AS_EC(4,!UJ)', - 1 12,LNAM1,TCOD(1)) - CALL WNCTXT(F(I),' INTEGER !AS_EJ(4,!UJ)', - 1 LNAM1,TCOD(1)) - ELSE IF (I.EQ.1) THEN !C CHAR. - CALL WNCTXT(F(I),'#define !AS\EDL !UJ'// - 1 '!#C/* Length table */', - 1 LNAM1,TCOD(1),COMPOS+7) - CALL WNCTXT(F(I),'#define !AS__EL !UJ'// - 1 '!#C/* Length table */', - 1 LNAM1,TCOD(1),COMPOS+7) - CALL WNCTXT(F(1),' static char !AS_ec [!UJ][4][!UJ] = {', - 1 LCNAM,TCOD(1),12) - ELSE !C INTEGER - CALL WNCTXT(F(1),' static int !AS_ej [!UJ][4] = {', - 1 LCNAM,TCOD(1)) - END IF !FORTRAN/C - J=TCOD(1) !SAVE LAST - TCOD(1)=0 !COUNT LINES - DO I3=TCOD(3)+1,I1 !ALL ENTRIES - I2=WNTIBR(XFDES,FENTB,I3) !READ ENTRY - IF (FENTJ(WNTF_BTYP_J).EQ.BT_SDA .AND. - 1 FENTJ(WNTF_DTP_J).NE.0 .AND. - 1 FENTB(WNTF_NAM_1).NE.ICHAR('-')) THEN !OFFSET - TCOD(1)=TCOD(1)+1 !COUNT LINE - IF (FENTJ(WNTF_EDIP_J).GT.0) THEN !EDIT GIVEN - I2=WNTIBR(EFDES,EENTB,FENTJ(WNTF_EDIP_J)) !READ EDIT - ELSE - EENTC(WNTE_UNIT_1+1:WNTE_UNIT_1+WNTE_UNIT_N)= - 1 ' ' !MAKE - EENTC(WNTE_SPEC_1+1:WNTE_SPEC_1+WNTE_SPEC_N)= - 1 ' ' - EENTJ(WNTE_EDIT_J)=0 - EENTC(WNTE_PAT_1+1:WNTE_PAT_1+WNTE_PAT_N)= - 1 ECD(FENTJ(WNTF_DTP_J)) - END IF - IF (EENTC(WNTE_PAT_1+1: - 1 WNTE_PAT_1+WNTE_PAT_N).EQ.' ') !NO PATTERN - 1 EENTC(WNTE_PAT_1+1:WNTE_PAT_1+WNTE_PAT_N)= - 1 ECD(FENTJ(WNTF_DTP_J)) - IF (FENTJ(WNTF_DTP_J).EQ.T_S) THEN !STRUCTURE - LNAM2=EENTC(WNTE_SPEC_1+1: - 1 WNTE_SPEC_1+WNTE_SPEC_N) !SPECIAL FIELD - IF (LNAM2.EQ.' ') THEN !NO SPECIAL - I2=WNTIBR(XFDES,LFENTB,FENTJ(WNTF_SREF_J)) !READ REF. - CALL WNTIO1(I,LFENTB,CNAM,LNAM2,LCNAM2) !GET NAME - EENTC(WNTE_SPEC_1+1:WNTE_SPEC_1+WNTE_SPEC_N)= - 1 'S:'//LNAM2 !SET SPECIAL EDIT - END IF - END IF - IF (FENTJ(WNTF_DTP_J).EQ.T_C) THEN !CHARACTER - I4=FENTJ(WNTF_SLEN_J) !LENGTH - ELSE - I4=FENTJ(WNTF_ULEN_J) - END IF - IF (J.EQ.TCOD(1)) THEN !LAST - LNAM='};' - ELSE - LNAM=',' - END IF - IF (I.EQ.0) THEN - CALL WNCTXT(F(I),' DATA !AS_EC(1,!UJ),'// - 1 '!AS_EC(2,!UJ),!AS_EC(3,!UJ),'// - 1 '!AS_EC(4,!UJ)!/ 1!_'// - 1 '/''!AD'',''!AD'',''!AD '',''!AD ''/', - 1 LNAM1,TCOD(1),LNAM1,TCOD(1), - 1 LNAM1,TCOD(1),LNAM1,TCOD(1), - 1 FENTB(WNTF_NAM_1),WNTF_NAM_N, - 1 EENTB(WNTE_PAT_1),WNTE_PAT_N, - 1 EENTB(WNTE_UNIT_1),WNTE_UNIT_N, - 1 EENTB(WNTE_SPEC_1),WNTE_SPEC_N) - CALL WNCTXT(F(I),' DATA !AS_EJ(1,!UJ),'// - 1 '!AS_EJ(2,!UJ),!AS_EJ(3,!UJ),'// - 1 '!AS_EJ(4,!UJ)!/ 1!_'// - 1 '/!UJ,!UJ,!UJ,!UJ/', - 1 LNAM1,TCOD(1),LNAM1,TCOD(1), - 1 LNAM1,TCOD(1),LNAM1,TCOD(1), - 1 FENTJ(WNTF_OFF_J), - 1 MAX(FENTJ(WNTF_TLEN_J),1), - 1 EENTJ(WNTE_EDIT_J),I4) - ELSE IF (I.EQ.1) THEN !C CHAR - CALL WNCTXT(F(1),'!2_'// - 1 '"!AD","!AD","!AD ","!AD "!AS', - 1 FENTB(WNTF_NAM_1),WNTF_NAM_N, - 1 EENTB(WNTE_PAT_1),WNTE_PAT_N, - 1 EENTB(WNTE_UNIT_1),WNTE_UNIT_N, - 1 EENTB(WNTE_SPEC_1),WNTE_SPEC_N, - 1 LNAM) - ELSE !C INT - CALL WNCTXT(F(1),'!2_'// - 1 '!UJ,!UJ,!UJ,!UJ!AS', - 1 FENTJ(WNTF_OFF_J), - 1 MAX(FENTJ(WNTF_TLEN_J),1), - 1 EENTJ(WNTE_EDIT_J),I4, - 1 LNAM) - END IF !FORTRAN/C - END IF !OFFSET - END DO !ENTRIES - END DO !FORTRAN/C - END IF !OFFSET - END DO !ALL ENTRIES - END IF !OFFSETS -C -C DATA -C - IF (IF.EQ.1) THEN !.DEF ASKED - USEEN=-1 !NO UNION - CNAM=' ' !NO COMMON - DO I=0,1 !FORTRAN/CEE - CALL WNCTXT(F(I),'!AS',CTXT(0,I,0)) - CALL WNCTXT(F(I),'!AS Data declarations:',CTXT(0,I,1)) - CALL WNCTXT(F(I),'!AS!79C!AS',CTXT(0,I,1), - 1 CTXT(1,I,0)) - DO I1=0,XFDES_J(WNTB_CNT_J)-1 !ALL ENTRIES - I2=WNTIBR(XFDES,FENTB,I1) !READ ENTRY - IF (FENTJ(WNTF_BTYP_J).EQ.BT_DAT .AND. - 1 FENTB(WNTF_NAM_1).NE.ICHAR('-')) THEN !DATA ENTRY - IF (I.EQ.1 .AND. (FENTJ(WNTF_REFP_J).LE.0 .OR. - 1 FENTJ(WNTF_REFP_J).GT.I1) .AND. - 1 FENTJ(WNTF_DTP_J).NE.0 .AND. - 1 USEEN.GE.0) THEN !END UNION - I2=WNTIBR(XFDES,LFENTB,USEEN) !READ REF. NAME - CALL WNTIO1(I,LFENTB,CNAM,LNAM1,LCNAM) !GET NAME - CALL WNCTXT(F(I),' } !AS;',LCNAM) !UNION NAME - USEEN=-1 !READY - END IF - IF (FENTJ(WNTF_REFP_J).GT.I1 .AND. - 1 FENTJ(WNTF_DTP_J).NE.0 .AND. - 1 I.EQ.1) THEN !START = REFERENCE - CALL WNCTXT(F(I),' union {') - USEEN=I1 !SAVE WHERE - END IF - CALL WNTIO3(I,F,FENTB,FENTJ,CNAM) !SHOW LINE - IF (FENTJ(WNTF_REFP_J).GT.0 .AND. - 1 FENTJ(WNTF_DTP_J).NE.0 .AND. - 1 FENTJ(WNTF_REFP_J).LT.I1 .AND. - 1 I.EQ.0) THEN !THIS IS = REFERENCE - I2=WNTIBR(XFDES,LFENTB,FENTJ(WNTF_REFP_J)) !READ REF. NAME - CALL WNCTXT(F(I),' EQUIVALENCE (!AD,!AD)', - 1 FENTB(WNTF_NAM_1),WNTF_NAM_N, - 1 LFENTB(WNTF_NAM_1),WNTF_NAM_N) - END IF != REFERENCE - END IF !DATA ENTRY - END DO !ALL ENTRIES - IF (I.EQ.1 .AND. USEEN.GE.0) THEN !END UNION - I2=WNTIBR(XFDES,LFENTB,USEEN) !READ REF. NAME - CALL WNTIO1(I,LFENTB,CNAM,LNAM1,LCNAM) !GET NAME - CALL WNCTXT(F(I),' } !AS;',LCNAM) !UNION NAME - USEEN=-1 !READY - END IF - END DO !FORTRAN/CEE - END IF !.DEF ASKED -C -C COMMON DATA -C - IF (IF.EQ.1 .OR. IF.EQ.2) THEN !.DEF ASKED - CSEEN=.FALSE. !NO COMMON BLOCK - USEEN=-1 !NO UNION - CNAM=' ' !NO COMMON NAME - DO I1=0,XFDES_J(WNTB_CNT_J)-1 !ALL ENTRIES - I2=WNTIBR(XFDES,FENTB,I1) !READ ENTRY - IF (FENTJ(WNTF_BTYP_J).EQ.BT_DCM) THEN !NEW COMMON - IF (CSEEN) THEN !FINISH OLD - CALL WNCTXT(F(1),'};') - END IF - CALL WNTIO1(I,FENTB,CNAM,CNAM,LCNAM) !GET NAME - DO I=0,1 !FORTRAN/CEE - CALL WNCTXT(F(I),'!AS',CTXT(0,I,0)) - CALL WNCTXT(F(I),'!AS !AS common data:', - 1 CTXT(0,I,1),CNAM) - CALL WNCTXT(F(I),'!AS!79C!AS',CTXT(0,I,1), - 1 CTXT(1,I,0)) - END DO - CALL WNCTXT(F(1),'struct !AS_com {',LCNAM) - CSEEN=.TRUE. !SET ONE ACTIVE - ELSE IF (FENTJ(WNTF_BTYP_J).EQ.BT_COM) THEN !DATA ENTRY - IF ((FENTJ(WNTF_REFP_J).LE.0 .OR. - 1 FENTJ(WNTF_REFP_J).GT.I1) .AND. - 1 FENTJ(WNTF_DTP_J).NE.0 .AND. - 1 USEEN.GE.0) THEN !END UNION - I2=WNTIBR(XFDES,LFENTB,USEEN) !READ REF. NAME - CALL WNTIO1(I,LFENTB,CNAM,LNAM1,LCNAM) !GET NAME - CALL WNCTXT(F(1),' } !AS;',LCNAM) !UNION NAME - USEEN=-1 !READY - END IF - IF (FENTJ(WNTF_REFP_J).GT.I1 .AND. - 1 FENTJ(WNTF_DTP_J).NE.0) THEN !START = REFERENCE - CALL WNCTXT(F(1),' union {') - USEEN=I1 !SAVE WHERE - END IF - DO I=0,1 !FORTRAN/CEE - IF (IF.EQ.2) THEN - CALL WNTIO3(I,F,FENTB,FENTJ,CNAM) !SHOW LINE WITH INIT - ELSE - CALL WNTIO2(I,F,FENTB,FENTJ,CNAM) !SHOW LINE NO INIT - END IF - IF (FENTJ(WNTF_REFP_J).GT.0 .AND. - 1 FENTJ(WNTF_REFP_J).LT.I1 .AND. - 1 I.EQ.0) THEN !THIS IS = REFERENCE - I2=WNTIBR(XFDES,LFENTB,FENTJ(WNTF_REFP_J)) !READ REF. NAME - CALL WNCTXT(F(I),' EQUIVALENCE (!AD,!AD)', - 1 FENTB(WNTF_NAM_1),WNTF_NAM_N, - 1 LFENTB(WNTF_NAM_1),WNTF_NAM_N) - END IF != REFERENCE - END DO !FORTRAN/CEE - END IF !DATA ENTRY - END DO !ALL ENTRIES - IF (USEEN.GE.0) THEN !END UNION - I2=WNTIBR(XFDES,LFENTB,USEEN) !READ REF. NAME - CALL WNTIO1(I,LFENTB,CNAM,LNAM1,LCNAM) !GET NAME - CALL WNCTXT(F(1),' } !AS;',LCNAM) !UNION NAME - USEEN=-1 !READY - END IF - IF (CSEEN) THEN !FINISH OLD - CALL WNCTXT(F(1),'};') - END IF - END IF !.DEF ASKED -C -C COMMON BLOCK -C - IF (IF.EQ.1 .OR. IF.EQ.2) THEN !.DEF ASKED - CSEEN=.FALSE. !NO COMMON ENTRIES - CNAM=' ' !NO COMMON - DO I1=0,XFDES_J(WNTB_CNT_J)-1 !ALL ENTRIES - I2=WNTIBR(XFDES,FENTB,I1) !READ ENTRY - IF (FENTJ(WNTF_BTYP_J).EQ.BT_DCM) THEN !NEW COMMON - IF (CSEEN) THEN !FINISH OLD - DO I=0,0 !FORTRAN/C - CALL WNCTXT(F(I),'!AS',LIN1) !LAST LINE PREVIOUS - END DO !FORTRAN/C - END IF - CALL WNTIO1(I,FENTB,CNAM,CNAM,LCNAM) !GET NAME - DO I=0,1 !FORTRAN/CEE - CALL WNCTXT(F(I),'!AS',CTXT(0,I,0)) - CALL WNCTXT(F(I),'!AS !AS common block:', - 1 CTXT(0,I,1),CNAM) - CALL WNCTXT(F(I),'!AS!79C!AS',CTXT(0,I,1), - 1 CTXT(1,I,0)) - END DO -c CALL WNCTXT(F(1),'#ifdef wn_cv__!/\'// -c: 1 '#define !AS_com_ _!AS_com_!/\'// -c 1 '#endif',LCNAM,LCNAM) - CALL WNCTXT(F(1),'extern struct !AS_com !AS_com_ ;', - 1 LCNAM,LCNAM) !C REFERENCE - CALL WNCTXS(LIN1,' COMMON /!AS_COM/ ', - 1 CNAM) !HEADER - I4=WNCALN(LIN1)+1 !LENGTH FILLED - CSEEN=.FALSE. !NO COMMON ENTRIES - ELSE IF (FENTJ(WNTF_BTYP_J).EQ.BT_COM .AND. - 1 FENTJ(WNTF_DTP_J).NE.0) THEN !DATA ENTRY - CALL WNTIO1(I,FENTB,CNAM,LNAM1,LCNAM) !GET NAME - DO I=0,0 !FORTRAN - IF (FENTJ(WNTF_REFP_J).GT.0 .AND. - 1 FENTJ(WNTF_REFP_J).LT.I1) THEN !SKIP EQUIVALENCE - ELSE - IF (I4.GE.COMPOS-10) THEN !NEW LINE - CALL WNCTXT(F(I),'!AS,',LIN1) !PRINT LINE - CALL WNCTXS(LIN1,' 1!2_,') - I4=WNCALN(LIN1)-1 - ELSE IF (CSEEN) THEN - I4=I4+1 !ADD , - LIN1(I4:I4)=',' - END IF - CSEEN=.TRUE. !NAME SEEN - CALL WNCTXS(LIN1(I4+1:),'!AS', - 1 LNAM1) !ADD NAME - I4=WNCALN(LIN1) - END IF !EQUIVALENCE - END DO !FORTRAN/CEE - END IF !DATA ENTRY - END DO !ALL ENTRIES - IF (CSEEN) THEN !LAST COMMON LINE - DO I=0,0 !FORTRAN - CALL WNCTXT(F(I),'!AS',LIN1) - END DO !FORTRAN/CEE - END IF - END IF !.DEF ASKED -C -C NEXT FILE -C - 101 CONTINUE - IF (IF.EQ.1 .AND. CINSN) THEN !INDICATE EXTERNAL BD - DO I=0,1 !FORTRAN/C - CALL WNCTXT(F(I),'!AS',CTXT(0,I,0)) - CALL WNCTXT(F(I),'!AS External initialisation:', - 1 CTXT(0,I,1)) - CALL WNCTXT(F(I),'!AS!79C!AS',CTXT(0,I,1), - 1 CTXT(1,I,0)) - LNAM=PARM(P_NAM) - IF (I.EQ.0) THEN !FORTRAN - CALL WNCAUC(LNAM) - CALL WNCTXT(F(I),' EXTERNAL !AS_BD',LNAM) - ELSE !C - CALL WNCALC(LNAM) - CALL WNCTXT(F(I),' extern !AS_bd_() ;',LNAM) - END IF - END DO !FORTRAN/C - END IF - IF (IF.EQ.1 .OR. (IF.EQ.3 .AND. .NOT.DEFSN .AND. - 1 .NOT.(PARSN .AND. .NOT.BEGSN))) THEN !FORTRAN END - DO I=0,1 !FORTRAN/C - CALL WNCTXT(F(I),'!AS',CTXT(0,I,0)) - CALL WNCTXT(F(I),'!AS Given statements:',CTXT(0,I,1)) - CALL WNCTXT(F(I),'!AS!79C!AS',CTXT(0,I,1), - 1 CTXT(1,I,0)) - IF (I.EQ.0) THEN !FORTRAN - DO I1=0,FEDES_J(WNTB_CNT_J)-1 !ALL LINES - I2=WNTIBR(FEDES,FMENTB,I1) !READ LINE - CALL WNCTXT(F(I),' !AD', - 1 FMENTB,MXSLIN) - END DO - ELSE !C - DO I1=0,CEDES_J(WNTB_CNT_J)-1 !ALL LINES - I2=WNTIBR(CEDES,FMENTB,I1) !READ LINE - CALL WNCTXT(F(I),' !AD', - 1 FMENTB,MXSLIN) - END DO - END IF - END DO !FORTRAN/C - END IF - IF (IF.EQ.2) THEN !_BD - CALL WNCTXT(F(0),'!AS',CTXT(0,0,0)) - CALL WNCTXT(F(0),'!AS',CTXT(0,0,0)) - CALL WNCTXT(F(0),' END',CTXT(0,0,0)) - END IF - DO I=0,1 !TRAILER - CALL WNCTXT(F(I),'!AS-!79C!AS', - 1 CTXT(0,I,0),CTXT(1,I,0)) - CALL WNCFCL(F(I)) !CLOSE OUTPUT - IF (F(I).NE.0) - 1 CALL WNCTXT(F_P,'!AS!20C\generated',FNAM(I)) - END DO - 100 CONTINUE - END DO -C -C READY -C - 800 CONTINUE -C - RETURN -C -C - END diff --git a/src/wng/wntirl.for b/src/wng/wntirl.for deleted file mode 100644 index f652688c0f644d0d52000a45e52ff8607a37e4d6..0000000000000000000000000000000000000000 --- a/src/wng/wntirl.for +++ /dev/null @@ -1,83 +0,0 @@ -C+ WNTIRL.FOR -C WNB 930501 -C -C Revisions: -C - LOGICAL FUNCTION WNTIRL(LUN,ISTR,IDAT,ICOM,CONTL) -C -C Read a single line from input -C -C Result: -C -C WNTIRL_L = WNTIRL( LUN_J:I, ISTR_C*:O, IDAT_C*:O, ICOM_C*:O, CONTL_L:O) -C Read a line (ISTR) from LUN, and separate it in -C data (IDAT) and comment (ICOM). CONTL indicates -C that a continuation line follows, or EOF detected. -C WNTIRL returns .false. if error or EOF. -C -C Include files: -C - INCLUDE 'WNG_DEF' -C -C Parameters: -C -C -C Arguments: -C - INTEGER LUN !FILE TO READ FROM - CHARACTER*(*) ISTR !LINE - CHARACTER*(*) IDAT !DATA ON LINE - CHARACTER*(*) ICOM !COMMENT ON LINE - LOGICAL CONTL !CONTINUATION INDICATOR -C -C Function references: -C - INTEGER WNCALN !LENGTH STRING - LOGICAL WNCASC,WNCATC !SKIP/TEST GIVEN CHARACTER -C -C Data declarations: -C -C- -C -C PRELIMINARY -C - WNTIRL=.TRUE. !ASSUME OK - ISTR=' ' !PREPARE - IDAT=' ' - ICOM=' ' - CONTL=.FALSE. !NO CONTINUATION LINE -C -C READ LINE -C - READ (UNIT=LUN,FMT=1000,END=900,ERR=910) ISTR - 1000 FORMAT(A) -C -C SPLIT IN COMMENT FIELD -C - I=1 !START BEGIN OF STRING - CALL WNCAFX(ISTR,I,IDAT) !GET DATA PART - IF (WNCASC(ISTR,I,'!')) THEN !COMMENT FOLLOWS - ICOM=ISTR(I:) !SET COMMENT - END IF -C -C LOOK FOR CONTINUATION -C - I=WNCALN(IDAT) !END DATA - IF (WNCATC(IDAT,I,CHAR(92))) THEN !CONTINUATION - IDAT(I:I)=' ' !DELETE CONTINUATION - CONTL=.TRUE. !INDICATE CONTINUATION - END IF -C - RETURN -C -C ERRORS -C - 900 CONTINUE !EOF - CONTL=.TRUE. !SHOW EOF - 910 CONTINUE !READ ERROR - WNTIRL=.FALSE. -C - RETURN -C -C - END diff --git a/src/wng/wntiv0.for b/src/wng/wntiv0.for deleted file mode 100644 index 0b4332d9fb36b7993863fed7498acbd2764c997b..0000000000000000000000000000000000000000 --- a/src/wng/wntiv0.for +++ /dev/null @@ -1,108 +0,0 @@ -C+ WNTIV0.FOR -C WNB 930501 -C -C Revisions: -C - LOGICAL FUNCTION WNTIV0(OP,NOP,STK,NSTK,LOP,HOP) -C -C Help routines for WNTIVG -C -C Result: -C -C WNTIV0_L = WNTIV0( OP_J(0:*):I, NOP_J:IO, STK_J(0:*):IO, -C NSTK_J:IO, LOP_J:I, HOP_J:I) -C Unroll operator (OP) and value (STK) stacks -C for operators between LOP and HOP (inclusive). -C Binary operators -C WNTIV1_l = WNTIV1( OP_J(0:*):I, NOP_J:IO, STK_J(0:*):IO, -C NSTK_J:I, LOP_J:I, HOP_J:I) -C Unary operators -C -C Include files: -C - INCLUDE 'WNG_DEF' - INCLUDE 'WNT_O_DEF' -C -C Parameters: -C -C -C Arguments: -C - INTEGER OP(0:*) !OPERATOR STACK - INTEGER NOP !# IN OP - INTEGER STK(0:*) !VALUE STACK - INTEGER NSTK !# IN STK - INTEGER LOP !LOWEST TO DO - INTEGER HOP !HIGHEST OPERATOR TO DO -C -C Entry points: -C - LOGICAL WNTIV1 -C -C Function references: -C -C -C Data declarations: -C -C- -C -C WNTIV0 -C - WNTIV0=.TRUE. !ASSUME OK - DO WHILE (NOP.GT.0) !MORE OPERATORS - IF (OP(NOP-1).GE.LOP .AND. OP(NOP-1).LE.HOP) THEN !DO - IF (NSTK.LE.1) GOTO 900 !CANNOT DO - NOP=NOP-1 !REMOVE OPERATOR - NSTK=NSTK-1 !REMOVE VALUE - IF (OP(NOP).EQ.OP_PL) THEN - STK(NSTK-1)=STK(NSTK-1)+STK(NSTK) - ELSE IF (OP(NOP).EQ.OP_MI) THEN - STK(NSTK-1)=STK(NSTK-1)-STK(NSTK) - ELSE IF (OP(NOP).EQ.OP_MU) THEN - STK(NSTK-1)=STK(NSTK-1)*STK(NSTK) - ELSE IF (OP(NOP).EQ.OP_DV) THEN - IF (STK(NSTK).EQ.0) GOTO 900 - STK(NSTK-1)=STK(NSTK-1)/STK(NSTK) - ELSE - GOTO 900 !UNKNOWN - END IF - ELSE - GOTO 800 !READY - END IF - END DO - GOTO 800 -C -C WNTIV1 -C - ENTRY WNTIV1(OP,NOP,STK,NSTK,LOP,HOP) -C - WNTIV1=.TRUE. !ASSUME OK - DO WHILE (NOP.GT.0) !MORE OPERATORS - IF (OP(NOP-1).GE.LOP .AND. OP(NOP-1).LE.HOP) THEN !DO - IF (NSTK.LE.0) GOTO 900 !CANNOT DO - NOP=NOP-1 !REMOVE OPERATOR - IF (OP(NOP).EQ.OP_SP) THEN !EFFECTIVE NOP - ELSE IF (OP(NOP).EQ.OP_SM) THEN - STK(NSTK-1)=-STK(NSTK-1) - ELSE - GOTO 900 !UNKNOWN - END IF - ELSE - GOTO 800 !READY - END IF - END DO - GOTO 800 -C -C ERROR -C - 900 CONTINUE - WNTIV0=.FALSE. !ERROR -C -C READY -C - 800 CONTINUE -C - RETURN -C -C - END diff --git a/src/wng/wntiv9.for b/src/wng/wntiv9.for deleted file mode 100644 index 82470ebd77081fa77b14efaa394090294363b8ff..0000000000000000000000000000000000000000 --- a/src/wng/wntiv9.for +++ /dev/null @@ -1,78 +0,0 @@ -C+ WNTIV9.FOR -C WNB 930501 -C -C Revisions: -C - SUBROUTINE WNTIV9(STR,PT,OP,NOP) -C -C Help routines for WNTIVG -C -C Result: -C -C CALL WNTIV9( STR_C*:I, PT_J:IO, OP_J(0:*):I, NOP_J:IO) -C Set correct unary operator on OP stack -C CALL WNTIV8( STR_C*:I, PT_J:IO, OP_J(0:*):I, NOP_J:IO) -C Set correct binary operator on OP stack -C -C Include files: -C - INCLUDE 'WNG_DEF' - INCLUDE 'WNT_O_DEF' -C -C Parameters: -C -C -C Arguments: -C - CHARACTER*(*) STR !INPUT STRING - INTEGER PT !PTR INTO STRING - INTEGER OP(0:*) !OPERATOR STACK - INTEGER NOP !# IN OP -C -C Function references: -C - LOGICAL WNCASC !TEST CHARACTER -C -C Data declarations: -C -C- -C -C WNTIV9 -C - IF (WNCASC(STR,PT,'(')) THEN !START WITH ( - OP(NOP)=OP_LB !INDICATE ( - ELSE IF (WNCASC(STR,PT,'+')) THEN - OP(NOP)=OP_SP - ELSE IF (WNCASC(STR,PT,'-')) THEN - OP(NOP)=OP_SM - ELSE - OP(NOP)=0 !UNKNOWN - END IF - GOTO 800 -C -C WNTIV8 -C - ENTRY WNTIV8(STR,PT,OP,NOP) -C - IF (WNCASC(STR,PT,'+')) THEN - OP(NOP)=OP_PL - ELSE IF (WNCASC(STR,PT,'-')) THEN - OP(NOP)=OP_MI - ELSE IF (WNCASC(STR,PT,'*')) THEN - OP(NOP)=OP_MU - ELSE IF (WNCASC(STR,PT,'/')) THEN - OP(NOP)=OP_DV - ELSE - OP(NOP)=0 !UNKNOWN - END IF - GOTO 800 -C -C READY -C - 800 CONTINUE - NOP=NOP+1 !COUNT OPERATOR SEEN -C - RETURN -C -C - END diff --git a/src/wng/wntivg.for b/src/wng/wntivg.for deleted file mode 100644 index 9aaeaaf1bd9714077749228a7268c75167d87d0d..0000000000000000000000000000000000000000 --- a/src/wng/wntivg.for +++ /dev/null @@ -1,209 +0,0 @@ -C+ WNTIVG.FOR -C WNB 930501 -C -C Revisions: -C - LOGICAL FUNCTION WNTIVG(STR,PT,VT,VAL,NAM) -C -C Get value from a field -C -C Result: -C -C WNTIVG_L = WNTIVG( STR_C*:I, PT_J:IO, VT_L:O, VAL_J:O, NAM_C*:O) -C Get a value from STR, using the local/global -C name table, and simple expressions. -C VAL, NAM returns the values. VT .true. if -C proper integer expression, else -C character expression -C WNTIVG .false. if error in expression. -C -C Include files: -C - INCLUDE 'WNG_DEF' - INCLUDE 'WNT_O_DEF' - INCLUDE 'WNT_DEF' -C -C Parameters: -C - INTEGER MXNOP !MAX. # OF OPERATORS/STACK VALUES - PARAMETER (MXNOP=64) -C -C Arguments: -C - CHARACTER*(*) STR !INPUT STRING - INTEGER PT !PTR INTO STRING - LOGICAL VT !TYPE OF RESULT (TRUE IF INTEGER) - INTEGER VAL !RETURNED VALE - CHARACTER*(*) NAM !RETURNED VALUE AS STRING -C -C Function references: -C - LOGICAL WNCAFN !GET NAME - LOGICAL WNCAFS !GET FIELD - LOGICAL WNCASC,WNCATC !SKIP/TEST CHARACTER - LOGICAL WNCATM !TEST MULTIPLE CHARACTERS - LOGICAL WNCATN !TEST NAME CHARACTER - LOGICAL WNCACU !GET INTEGER - LOGICAL WNTIV0,WNTIV1 !MANIPULATE STACK -C -C Data declarations: -C - INTEGER LBC !LEFT ( COUNT - INTEGER NSTK,NOP !# OF STACK VALUES, OPERATORS - INTEGER STK(0:MXNOP),OP(0:MXNOP) !VALUE, OPERATOR STACK - LOGICAL LDIV !END / SEEN - CHARACTER*(WNTV_NAM_N) LNAM !NAME - BYTE VALB(0:WNTVHDL-1) !VALUE - INTEGER VALJ(0:WNTVHDL/LB_J-1) - EQUIVALENCE (VALB,VALJ) -C- -C -C INIT -C - WNTIVG=.FALSE. !ASSUME ERROR - CALL WNCASB(STR,PT) !START AT BEGIN - J=PT !SAVE POINTER - VT=.TRUE. !ASSUME VALUE - NSTK=0 !NO STACK - NOP=0 !NO OPERATORS - OP(0)=0 !NOT ( START - LBC=0 !( COUNT -C -C EVALUATE EXPRESSION -C -C TERM -C - 10 CONTINUE - CALL WNCASB(STR,J) !SKIP BLANK - IF (WNCATM(STR,J,'(+-')) THEN !START WITH UNARY - IF (WNCATC(STR,J,'(')) LBC=LBC+1 !COUNT ( - CALL WNTIV9(STR,J,OP,NOP) !SET - GOTO 10 !NEXT TERM - END IF - IF (WNCATN(STR,J)) THEN !IS NAME OR STRING - J1=J !SAVE PTR IF UNKNOWN NAME - IF (.NOT.WNCAFN(STR,J,NAM)) GOTO 820 !SET FIELD - DO I=0,VBDES_J(WNTB_CNT_J)-1 !CHECK NAMES - CALL WNGMTS(WNTV_NAM_N, - 1 A_B(VBDES_J(WNTB_BPTR_J)+I*WNTVHDL+WNTV_NAM_1), - 1 LNAM) !READ NAME - IF (LNAM.EQ.NAM) THEN !FOUND NAME - CALL WNGMV(WNTVHDL, - 1 A_B(VBDES_J(WNTB_BPTR_J)+I*WNTVHDL),VALB) !GET VALUE - IF (VALJ(WNTV_TYP_J).GT.0) THEN !HAS VALUE - STK(NSTK)=VALJ(WNTV_VAL_J) !SET VALUE - NSTK=NSTK+1 - GOTO 20 !FIND OPERATOR - ELSE IF (VALJ(WNTV_TYP_J).EQ.0) THEN !NO VALUE, ERROR - GOTO 900 - ELSE !STRING VALUE - CALL WNGMTS(WNTV_STR_N,VALB(WNTV_STR_1),NAM) !RETURN VALUE - GOTO 821 !READY - END IF - END IF - END DO - J=J1 !RESTORE POINTER - GOTO 820 !READY - ELSE - IF (WNCACU(STR,J,10,D0,D1)) THEN !INTEGER VALUE - STK(NSTK)=NINT(MOD(D0,2D0**L_J)) !SET VALUE - NSTK=NSTK+1 - ELSE !TRY FIELD - IF (.NOT.WNCAFS(STR,J,NAM)) GOTO 900 !GET A FIELD - IF (NOP.EQ.0) THEN !STRING VALUE OK - VT=.FALSE. !INDICATE STRING - VAL=0 !NO VALUE - GOTO 810 !READY - END IF - GOTO 900 !ERROR - END IF - END IF -C -C OPERATOR -C - 20 CONTINUE - LDIV=.FALSE. !COULDE BE REAL / - J1=J !CHECK POINTER - CALL WNCASB(STR,J) !SKIP BLANK - IF (J.GT.J1) LDIV=.TRUE. !NOT REAL / - IF (.NOT.WNTIV1(OP,NOP,STK,NSTK,OP_SP,OP_SM)) GOTO 900 !DO UNARY +- - IF (WNCATC(STR,J,')') .AND. LBC.LE.0) GOTO 21 - IF (WNCASC(STR,J,')')) THEN !END SUB-TERM - LBC=LBC-1 !COUNT ( - IF (.NOT.WNTIV0(OP,NOP,STK,NSTK,OP_PL,OP_DV)) GOTO 900 !DO BINARY - IF (NOP.GT.0 .AND. OP(NOP-1).EQ.OP_LB) THEN - NOP=NOP-1 !REMOVE ( - IF (WNCATC(STR,PT,'(')) GOTO 800 !READY - ELSE - GOTO 900 !MISSING ( - END IF - GOTO 20 !NEXT OPERATOR - END IF - 21 CONTINUE - IF (WNCATC(STR,J,'*')) THEN !* - IF (.NOT.WNTIV0(OP,NOP,STK,NSTK,OP_MU,OP_DV)) GOTO 900 !DO BINARY - CALL WNTIV8(STR,J,OP,NOP) !SET BINARY - ELSE IF (WNCATC(STR,J,'/')) THEN !/ - IF (LBC.LE.0) THEN !CHECK IF NOT / - IF (.NOT.LDIV) THEN - J1=J - JS=WNCASC(STR,J,'/') - J2=J - CALL WNCASB(STR,J) - IF (J.GT.LEN(STR) .OR. J.GT.J2) LDIV=.TRUE. !NOT REAL / - J=J1 !RESTORE POINTER - END IF - ELSE - LDIV=.FALSE. !REAL / - END IF - IF (LDIV) THEN !NOT REAL / - IF (.NOT.WNTIV0(OP,NOP,STK,NSTK,OP_PL,OP_DV)) GOTO 900 !DO BINARY - GOTO 800 !READY - ELSE - IF (.NOT.WNTIV0(OP,NOP,STK,NSTK,OP_MU,OP_DV)) GOTO 900 !DO BINARY - CALL WNTIV8(STR,J,OP,NOP) !SET BINARY - END IF - ELSE IF (WNCATM(STR,J,'+-')) THEN !-+ - IF (.NOT.WNTIV0(OP,NOP,STK,NSTK,OP_PL,OP_DV)) GOTO 900 !DO BINARY - CALL WNTIV8(STR,J,OP,NOP) !SET BINARY - ELSE !END - IF (.NOT.WNTIV0(OP,NOP,STK,NSTK,OP_PL,OP_DV)) GOTO 900 !DO BINARY - GOTO 800 !READY - END IF - GOTO 10 !NEXT TERM -C -C ERROR -C - 900 CONTINUE - NAM=' ' !NO NAME - VAL=0 !NO VALUE - VT=.FALSE. !NO VALUE -C - RETURN -C -C READY -C - 820 CONTINUE - IF (.NOT.WNCAFS(STR,J,NAM)) GOTO 900 !GET A FIELD - 821 CONTINUE - IF (NOP.NE.0 .OR. NSTK.NE.0) GOTO 900 !STRING VALUE NOT ALLOWED - VT=.FALSE. !INDICATE STRING - VAL=0 !NO VALUE - GOTO 810 !READY -C - 800 CONTINUE - IF (NOP.EQ.0 .AND. NSTK.EQ.1) THEN - VAL=STK(0) !VALUE - CALL WNCTXS(NAM,'!SJ',VAL) - ELSE - GOTO 900 - END IF - - 810 CONTINUE - PT=J !RESET POINTER - WNTIVG=.TRUE. !OK -C - RETURN -C -C - END diff --git a/src/wng/wntivp.for b/src/wng/wntivp.for deleted file mode 100644 index 6ef8837875d989e91c68c20fedaa178731bb0001..0000000000000000000000000000000000000000 --- a/src/wng/wntivp.for +++ /dev/null @@ -1,93 +0,0 @@ -C+ WNTIVP.FOR -C WNB 930501 -C -C Revisions: -C - LOGICAL FUNCTION WNTIVP(STR,PT,NAM,GI) -C -C Put a value in a local variable -C -C Result: -C -C WNTIVP_L = WNTIVP( STR_C*:I, PT_J:IO, NAM_C*:I, GI_L:I) -C Put value from STR in NAM. GI is the global -C indicator -C -C Include files: -C - INCLUDE 'WNG_DEF' - INCLUDE 'WNT_O_DEF' - INCLUDE 'WNT_DEF' -C -C Parameters: -C -C -C Arguments: -C - CHARACTER*(*) STR !INPUT STRING - INTEGER PT !POINTER INTO STRING - CHARACTER*(*) NAM !NAME OF VALUE - LOGICAL GI !GLOBAL INDICATOR -C -C Function references: -C - LOGICAL WNTIVG !GET VALUE - INTEGER WNTIBP,WNTIBW !SAVE BUFFER LINE - LOGICAL WNCAFS !GET FIELD -C -C Data declarations: -C - CHARACTER*(WNTV_STR_N) LVAL !VALUE - BYTE VALB(0:WNTVHDL-1) !FULL VALUE - INTEGER VALJ(0:WNTVHDL/LB_J-1) - EQUIVALENCE (VALB,VALJ) -C- -C -C MAKE VALUE -C - WNTIVP=.TRUE. !ASSUME OK - IF (.NOT.WNTIVG(STR,PT,JS,I,LVAL)) GOTO 900 !GET VALUE TO PUT - CALL WNGMFS(WNTV_NAM_N,NAM,VALB(WNTV_NAM_1)) !SAVE NAME - IF (JS) THEN !INTEGER - IF (GI) THEN !GLOBAL - VALJ(WNTV_TYP_J)=+2 - ELSE !LOCAL - VALJ(WNTV_TYP_J)=+1 - END IF - ELSE !CHARACTER - IF (GI) THEN !GLOBAL - VALJ(WNTV_TYP_J)=-2 - ELSE !LOCAL - VALJ(WNTV_TYP_J)=-1 - END IF - END IF - VALJ(WNTV_VAL_J)=I !VALUE - CALL WNGMFS(WNTV_STR_N,LVAL,VALB(WNTV_STR_1)) -C -C SET IN LIST -C - DO I=0,VBDES_J(WNTB_CNT_J)-1 !CHECK EXISTING NAMES - CALL WNGMTS(WNTV_NAM_N, - 1 A_B(VBDES_J(WNTB_BPTR_J)+I*WNTVHDL+WNTV_NAM_1), - 1 LVAL) !READ NAME - IF (LVAL.EQ.NAM) THEN !EXISTING - I1=WNTIBW(VBDES,VALB,I) !OVERWRITE VALUE - GOTO 800 !READY - END IF - END DO - I1=WNTIBP(VBDES,VALB) !SET VALUE -C -C READY -C - 800 CONTINUE -C - RETURN -C -C ERROR -C - 900 WNTIVP=.FALSE. -C - RETURN -C -C - END diff --git a/src/wng/wntivs.for b/src/wng/wntivs.for deleted file mode 100644 index 25f19a3f063914ed382784fe3b4aed38b48aa7b7..0000000000000000000000000000000000000000 --- a/src/wng/wntivs.for +++ /dev/null @@ -1,73 +0,0 @@ -C+ WNTIVS.FOR -C WNB 930501 -C -C Revisions: -C - LOGICAL FUNCTION WNTIVS(VAL,NAM,GI) -C -C Set an integer value to variable -C -C Result: -C -C WNTIVS_L = WNTIVS( VAL_J:I, NAM_C*:I, GI_L:I) -C Put value from STR in NAM. GI is the global -C indicator -C -C Include files: -C - INCLUDE 'WNG_DEF' - INCLUDE 'WNT_O_DEF' - INCLUDE 'WNT_DEF' -C -C Parameters: -C -C -C Arguments: -C - INTEGER VAL !INTEGER VALUE - CHARACTER*(*) NAM !NAME OF VALUE - LOGICAL GI !GLOBAL INDICATOR -C -C Function references: -C - INTEGER WNTIBP,WNTIBW !SAVE BUFFER LINE -C -C Data declarations: -C - CHARACTER*(WNTV_STR_N) LVAL !VALUE - BYTE VALB(0:WNTVHDL-1) !FULL VALUE - INTEGER VALJ(0:WNTVHDL/LB_J-1) - EQUIVALENCE (VALB,VALJ) -C- - WNTIVS=.TRUE. !ASSUME OK - CALL WNGMFS(WNTV_NAM_N,NAM,VALB(WNTV_NAM_1)) !SAVE NAME - IF (GI) THEN !GLOBAL - VALJ(WNTV_TYP_J)=+2 - ELSE !LOCAL - VALJ(WNTV_TYP_J)=+1 - END IF - VALJ(WNTV_VAL_J)=VAL !VALUE - CALL WNCTXS(LVAL,'!SJ',VAL) !MAKE STRING - CALL WNGMFS(WNTV_STR_N,LVAL,VALB(WNTV_STR_1)) -C -C SET IN LIST -C - DO I=0,VBDES_J(WNTB_CNT_J)-1 !CHECK EXISTING NAMES - CALL WNGMTS(WNTV_NAM_N, - 1 A_B(VBDES_J(WNTB_BPTR_J)+I*WNTVHDL+WNTV_NAM_1), - 1 LVAL) !READ NAME - IF (LVAL.EQ.NAM) THEN !EXISTING - I1=WNTIBW(VBDES,VALB,I) !OVERWRITE VALUE - GOTO 800 !READY - END IF - END DO - I1=WNTIBP(VBDES,VALB) !SET VALUE -C -C READY -C - 800 CONTINUE -C - RETURN -C -C - END diff --git a/src/wng/wnttil.for b/src/wng/wnttil.for deleted file mode 100644 index 8caa718eda9eb42350e6176971e724c39d308d17..0000000000000000000000000000000000000000 --- a/src/wng/wnttil.for +++ /dev/null @@ -1,870 +0,0 @@ -C+ WNTTIL.FOR -C WNB 900315 -C -C Revisions: -C WNB 920122 Change swap type for DW -C WNB 920306 Change byte values > 127 for Convex -C GvD 920402 - VAX and IEEE floating is zero when exponent is zero -C - Swap input IEEE only if different local byte order -C - Do float byte swap on output opposite to input -C - IEEE overflow when exponent > 128/1024 (was 127/1023) -C - Do not exit immediately when equal data format, but -C different byte order -C HjV 920522 Add translation type 8 (HP station) -C WNB 930802 Check for open end-repeats -C CMV 940822 Add module WNTTCH to check if translation needed -C - SUBROUTINE WNTTIL(N,BUF,COD) -C -C Translate buffers from one machine code to another -C -C Result: -C -C CALL WNTTIL( N_J:I, BUF_B(0:*):IO, COD_I(0:1,0:*):I) -C Translate the data in BUF of length N bytes -C from IBM to Local format, using the COD -C table. The code table consists of pairs of values. -C The first is a code, the second the # of elements -C for that code. The codes are: -C 0=end -C 1=char(C) -C 2=I2(I) -C 3=I4(J) -C 4=R4(E) -C 5=R8(D) -C 6=repeat -C 7=end repeat -C 8=NOP -C 9=L1(B) -C 10=external repeat -C 11=start union -C 12=start map -C 13=end union -C 14=C8(X) -C 15=C16(Y) -C Translation types: -C -1=IBM360 with EBCDIC -C 0=NOP -C 1=VAX D-float -C 2=VAX G-float -C 3=Alliant -C 4=Convex -C 5=IEEE -C 6=DEC workstation -C 7=SUN workstation -C 8=HP workstation -C CALL WNTTLI( N_J:I, BUF_B(0:*):IO, COD_I(0:1,0:*):I) -C Translate buffers from Local machine to IBM EBCDIC -C CALL WNTTDL( N_J:I, BUF_B(0:*):IO, COD_I(0:1,0:*):I) -C Translate buffers from DEC machine to Local -C CALL WNTTLD( N_J:I, BUF_B(0:*):IO, COD_I(0:1,0:*):I) -C Translate buffers from Local machine to DEC -C CALL WNTTLT( N_J:I, BUF_B(0:*):IO, COD_I(0:1,0:*):I, TYP_J:I) -C Translate buffers from local machine to TYP -C CALL WNTTTL( N_J:I, BUF_B(0:*):IO, COD_I(0:1,0:*):I, TYP_J:I) -C Translate buffers from TYP to local machine -C CALL WNTTTT( N_J:I, BUF_B(0:*):IO, COD_I(0:1,0:*):I, TYP_J:I, OTYP_J:I) -C Translate buffers from TYP to OTYP -C CALL WNTTCH( TYP_J:I, OTYP_J:I, NEEDED_L:O ) -C -C Include files: -C - INCLUDE 'WNG_DEF' -C -C Parameters: -C - INTEGER MXRCNT !MAXIMUM REPEAT CNT - PARAMETER(MXRCNT=64) - INTEGER MXUCNT !MAXIMUM UNION CNT - PARAMETER(MXUCNT=64) - INTEGER MNTP,MXTP !MIN/MAX TYPE RECOGNISED - PARAMETER(MNTP=-1,MXTP=8) -C -C Arguments: -C - INTEGER N !BUFFER LENGTH IN BYTES - BYTE BUF(0:*) !BUFFER TO TRANSLATE - INTEGER*2 COD(0:1,0:*) !TRANSLATION TABLE - INTEGER TYP !MACHINE TYPE - INTEGER OTYP !MACHINE TYPE - INTEGER TYP_C !MACHINE TYPE - INTEGER OTYP_C !MACHINE TYPE - LOGICAL NEEDED !TRANSLATION NEEDED -C -C Function references: -C -C -C Data declarations: -C - INTEGER ICHK !UNION CHECK - INTEGER ITAB !CODE POINTER - INTEGER IPT !DATA POINTER - INTEGER RCNT !REPEAT CNT - INTEGER UCNT !UNION CNT - INTEGER ICOD !TRANSLATION CODE - INTEGER REP(3,MXRCNT) !REPEAT INFO - INTEGER UNI(3,MXUCNT) !UNION INFO - INTEGER ITP,OTP !LOCAL INPUT/OUTPUT TYPE - LOGICAL STP !SWAP I2/I4 TYPE - LOGICAL STPL !LOCAL SWAP TYPE - LOGICAL STPI !INPUT SWAP TYPE - LOGICAL STPO !OUTPUT SWAP TYPE - LOGICAL SWTYP(MNTP:MXTP) !SWAP TABLE FOR TYPES - DATA SWTYP/.FALSE.,.FALSE.,.TRUE.,.TRUE.,.FALSE., - 1 .FALSE.,.FALSE.,.TRUE.,.FALSE.,.FALSE./ - INTEGER XTR(MNTP:MXTP) !SAME TRANSLATION - DATA XTR/-1,0,1,2,5,5,5,5,5,5/ - BYTE LI24(8) !CONVERSION - INTEGER JI18,JI28,JI24 - EQUIVALENCE(LI24(1),JI24,JI18),(LI24(5),JI28) - BYTE EBC(0:255) !TRANSLATION TABLE EBCDIC TO ASCII - DATA EBC /0,1,2,3,0,9,0,127,0,0,0,11,12,13,14,15, - 1 16,17,18,0,0,0,8,0,24,25,0,0,28,29,30,31, - 1 0,0,28,0,0,10,23,27,0,0,0,0,0,5,6,7, - 1 0,0,24,0,0,30,0,4,0,0,0,19,20,21,0,26, - 1 32,0,0,0,0,0,0,0,0,0,0,46,60,40,43,124, - 1 38,0,0,0,0,0,0,0,0,0,33,36,42,41,59,94, - 1 45,47,0,0,0,0,0,0,0,0,124,44,37,95,62,63, - 1 0,0,0,0,0,0,0,0,0,96,58,35,64,39,61,34, - 1 0,97,98,99,100,101,102,103,104,105,0,0,0,0,0,0, - 1 0,106,107,108,109,110,111,112,113,114,0,0,0,0,0,0, - 1 0,126,115,116,117,118,119,120,121,122,0,0,0,0,0,0, - 1 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, - 1 123,65,66,67,68,69,70,71,72,73,0,0,0,0,0,0, - 1 125,74,75,76,77,78,79,80,81,82,0,0,0,0,0,0, - 1 92,0,83,84,85,86,87,88,89,90,0,0,0,0,0,0, - 1 48,49,50,51,52,53,54,55,56,57,124,0,0,0,0,0/ - BYTE FEBC(0:127) !FROM ASCII TO EBCDIC - DATA FEBC /0,1,2,3,55,45,46,47, - 1 22,5,37,11,12,13,14,15, - 1 16,17,18,59,60,61,50,38, - 1 24,25,63,39,28,29,30,31, - 1 64,90,127,123,91,108,80,125, - 1 77,93,92,78,107,96,75,97, - 1 -26,-25,-24,-23,-22,-21,-20,-19, - 1 -18,-17,122,94,76,126,110,111, - 1 124,-63,-62,-61,-60,-59,-58,-57, - 1 -56,-55,-47,-46,-45,-44,-43,-42, - 1 -41,-40,-39,-30,-29,-28,-27,-26, - 1 -25,-24,-23,-64,-32,-48,95,109, - 1 121,-127,-126,-125,-124,-123,-122,-121, - 1 -120,-119,-111,-110,-109,-108,-107,-106, - 1 -105,-104,-103,-94,-93,-92,-91,-90, - 1 -89,-88,-87,-86,-6,-48,-95,7/ - INTEGER JA,JB - LOGICAL CHECK_ONLY !FLAG WNTTCH -C- -C -C WNTTIL -C - ITP=-1 !IBM IN - OTP=PRGDAT !LOCAL OUT - GOTO 200 -C -C WNTTLI -C - ENTRY WNTTLI(N,BUF,COD) -C - ITP=PRGDAT !LOCAL IN - OTP=-1 !IBM OUT - GOTO 200 -C -C WNTTDL -C - ENTRY WNTTDL(N,BUF,COD) -C - ITP=1 !DEC IN - OTP=PRGDAT !LOCAL OUT - GOTO 200 -C -C WNTTLD -C - ENTRY WNTTLD(N,BUF,COD) -C - ITP=PRGDAT !LOCAL IN - OTP=1 !DEC OUT - GOTO 200 -C -C WNTTLT -C - ENTRY WNTTLT(N,BUF,COD,TYP) -C - ITP=PRGDAT !LOCAL IN - OTP=TYP !OUT - GOTO 200 -C -C WNTTTL -C - ENTRY WNTTTL(N,BUF,COD,TYP) -C - ITP=TYP !IN - OTP=PRGDAT !LOCAL OUT - GOTO 200 -C -C WNTTTT -C - ENTRY WNTTTT(N,BUF,COD,TYP,OTYP) -C - ITP=TYP !IN - OTP=OTYP !OUT - GOTO 200 -C -C WNTTCH -C - ENTRY WNTTCH(TYP_C,OTYP_C,NEEDED) -C - ITP=TYP_C !IN - OTP=OTYP_C !OUT - NEEDED=.FALSE. !ASSUME NOT NEEDED - CHECK_ONLY=.TRUE. !JUST CHECK - GOTO 201 -C -C PRELIMINARIES -C - 200 CONTINUE - CHECK_ONLY=.FALSE. !DO TRANSLATE - 201 CONTINUE - J=0 !ASSUME READY - RCNT=0 !RESET REPEAT LEVEL - IF (MIN(ITP,OTP).LT.MNTP .OR. MAX(ITP,OTP).GT.MXTP) GOTO 1000 !ERROR - STPI=SWTYP(ITP) !INPUT SWAP - STPO=SWTYP(OTP) !OUTPUT SWAP - STP=STPI.XOR.STPO !SET SWAP INPUT/OUTPUT - JI24=1 - STPL=LI24(1).EQ.1 !LOCAL SWAP - ITP=XTR(ITP) !EQUALISE ALL - OTP=XTR(OTP) - IF (ITP*OTP.EQ.0) GOTO 1000 !NOP, READY - IF (ITP.EQ.OTP .AND. .NOT.STP) GOTO 1000 !SAME, READY - IF (CHECK_ONLY) THEN !IF ONLY TEST - NEEDED=.TRUE. !FLAG TRANSLATION NEEDED - RETURN !AND RETURN - ENDIF -C -C START CONVERSION -C - 100 CONTINUE - ICHK='7fffffff'X !UNION CHECK - J=N !LENGTH TO DO - ITAB=0 !TRANSLATION PTR - IPT=0 !DATA PTR - RCNT=0 !REPEAT LEVEL - UCNT=0 !UNION LEVEL -C -C CONVERT -C - 10 CONTINUE - IF (J.LE.0) GOTO 1000 !READY - ICOD=COD(0,ITAB) !CODE - J1=COD(1,ITAB) !# OF VALUES THIS CODE - ITAB=ITAB+1 !CODE CNT - IF (UCNT.LT.1) GOTO 11 !NORMAL - IF (UNI(1,UCNT).NE.0) GOTO 11 !UNION IN EXECUTION - GOTO (1080,1080,1080,1080,1080,1080,1080,1080,1080,1080, - 1 1080,1110,1120,1130,1080,1080) ICOD+1 !SKIP MAP - GOTO 10 - 11 GOTO (1000,1010,1020,1030,1040,1050,1060,1070,1080,1090, - 1 1100,1110,1120,1130,1140,1150) ICOD+1 -C -C CODES -C -C -C NOP -C - 1080 GOTO 10 !UNKNOWN OR NOP -C -C END -C - 1000 CONTINUE - IF (RCNT.GT.0) THEN !STILL OPEN REPEAT - ITAB=ITAB-1 !POINT 1 BACK - GOTO 1070 !DO END REPEAT - END IF - IF (J.GT.0) CALL WNGMVZ(J,BUF(IPT)) !EMPTY REMAINDER -C - RETURN !READY -C -C B -C - 1090 CONTINUE !L1 - J2=MIN(J1,J) !# TO DO - 1011 IPT=IPT+J2 !BUF PTR - J=J-J2 !CNT - GOTO 10 !NEXT CODE -C -C C -C - 1010 J2=MIN(J1,J) !CHAR TO DO - IF (ITP.EQ.-1) THEN !IBM IN - DO I=1,J2 - J3=BUF(IPT) - J3=IAND(J3,255) - BUF(IPT)=EBC(J3) !TRANSLATE - IPT=IPT+1 !INPUT PTR - J=J-1 !COUNT - END DO - GOTO 10 !NEXT CODE - ELSE IF (OTP.EQ.-1) THEN !IBM OUT - DO I=1,J2 - J3=BUF(IPT) - J3=IAND(J3,127) - BUF(IPT)=FEBC(J3) !TRANSLATE - IPT=IPT+1 !INPUT PTR - J=J-1 !COUNT - END DO - GOTO 10 !NEXT CODE - END IF - GOTO 1011 !NEXT CODE -C -C I -C - 1020 J2=2*MIN(J1,J/2) !I2 - IF (STP) CALL WNGSWB(J2,BUF(IPT)) !SWAP BYTES - GOTO 1011 !NEXT -C -C J -C - 1030 J2=4*MIN(J1,J/4) !I4 - IF (STP) CALL WNGSWJ(J2,BUF(IPT)) !SWAP BYTES IN J VALUES - GOTO 1011 !NEXT -C -C REPEAT -C - 1060 RCNT=RCNT+1 !REPEAT - IF (RCNT.GT.MXRCNT) GOTO 1000 !TOO MANY, QUIT - REP(1,RCNT)=0 !INLINE - REP(2,RCNT)=J1 !REPEAT CNT - REP(3,RCNT)=ITAB !CODE PTR - GOTO 10 !NEXT -C -C EXTERNAL REPEAT -C - 1100 RCNT=RCNT+1 !EXTERNAL REPEAT - IF (RCNT.GT.MXRCNT) GOTO 1000 !TOO MANY, QUIT - J2=COD(0,ITAB) !OFFSET REFERENCED STRUCTURE - ITAB=ITAB+1 - REP(1,RCNT)=ITAB !CONTINUATION - REP(2,RCNT)=J1 !CNT - REP(3,RCNT)=ITAB-1+J2/2 !REFERENCED STRUCTURE - ITAB=REP(3,RCNT) !CODE TO DO - GOTO 10 !NEXT -C -C END REPEAT -C - 1070 REP(2,RCNT)=REP(2,RCNT)-1 !END REPEAT - IF (REP(2,RCNT).GT.0) THEN !MORE - ITAB=REP(3,RCNT) !GO BACK - GOTO 10 !NEXT - END IF - IF (REP(1,RCNT).NE.0) ITAB=REP(1,RCNT) !EXTERNAL REPEAT ENDED - RCNT=RCNT-1 !LOWER LEVEL - GOTO 10 !NEXT -C -C START UNION -C - 1110 UCNT=UCNT+1 !START UNION - IF (UCNT.GT.MXUCNT) GOTO 1000 !TOO MANY, QUIT - UNI(1,UCNT)=0 !NOT IN EXECUTION - UNI(2,UCNT)=ITAB !PIECE TO DO - UNI(3,UCNT)=ICHK !REFERENCE CODE OFFSET - GOTO 10 !NEXT -C -C START MAP -C - 1120 J2=UNI(1,UCNT) !START MAP - 1122 IF (J2.NE.0) THEN !IN EXECUTION - ITAB=J2 !CONTINUE - UCNT=UCNT-1 - GOTO 10 - END IF - J2=ICHK-J1 !NEW REFERENCE CODE OFFSET - IF (J2.LT.0) THEN - IF (UNI(3,UCNT).GE.0 .OR. J2.LT.UNI(3,UCNT)) - 1 GOTO 10 !OLD>0 OR NEW<OLD: LEAVE - 1121 UNI(3,UCNT)=J2 !NEW REFERENCE - UNI(2,UCNT)=ITAB !NEW CODE - ELSE IF (UNI(3,UCNT).LT.0 .OR. J2.LE.UNI(3,UCNT)) THEN - GOTO 1121 !OLD<0 OR NEW<OLD: NEW - END IF - GOTO 10 !NEXT -C -C END UNION -C - 1130 J2=UNI(1,UCNT) !END UNION - IF (J2.NE.0) GOTO 1122 !IN EXECUTION - UNI(1,UCNT)=ITAB !SAVE CONTINUATION - ITAB=UNI(2,UCNT) !CODE TO EXECUTE - GOTO 10 !NEXT -C -C X -C - 1140 CONTINUE !C8 - J1=2*J1 -C -C E -C - 1040 CONTINUE !R4 - J2=4*MIN(J1,J/4) -C -C ONLY A SWAP IS NEEDED IF INPUT AND OUTPUT TYPE ARE EQUAL -C - IF (ITP.EQ.OTP) THEN - CALL WNGSWJ(J2,BUF(IPT)) - GOTO 1011 !NEXT CODE - END IF - DO J3=IPT,IPT+J2-4,4 !CONVERT -C -C CONVERT INPUT BYTES TO LOCAL ORDER -C -C DEC IN -C - IF (ITP.EQ.1 .OR. ITP.EQ.2) THEN !DEC D OR G-FLOAT IN - IF (STPL) THEN !DEC MACHINE - LI24(1)=BUF(J3+2) !GET NUMBER - LI24(2)=BUF(J3+3) - LI24(3)=BUF(J3+0) - LI24(4)=BUF(J3+1) - ELSE - LI24(1)=BUF(J3+1) !GET NUMBER - LI24(2)=BUF(J3+0) - LI24(3)=BUF(J3+3) - LI24(4)=BUF(J3+2) - END IF -C -C OTHER IN -C - ELSE - IF (STPL.XOR.STPI) THEN !DIFFERENT LOCAL BYTE ORDER - LI24(1)=BUF(J3+3) !GET NUMBER - LI24(2)=BUF(J3+2) - LI24(3)=BUF(J3+1) - LI24(4)=BUF(J3+0) - ELSE - LI24(1)=BUF(J3+0) !GET NUMBER - LI24(2)=BUF(J3+1) - LI24(3)=BUF(J3+2) - LI24(4)=BUF(J3+3) - END IF - END IF -C -C GET SIGN, EXPONENT AND FRACTION -C -C IBM IN -C - IF (ITP.EQ.-1) THEN !IBM IN - JA=4*ISHFT(IAND(JI24,'7f000000'X),-24)-256 !UNBIASED POW. - JB=JI24 !SIGN - IF (IAND(JI24,'00ffffff'X).EQ.0) THEN !ZERO FRACTION -> ZERO NUMBER - JI24=0 - ELSE - DO WHILE(IAND(JI24,2**23).EQ.0) !NORMALIZE - JI24=ISHFT(IAND(JI24,'00ffffff'X),1) - JA=JA-1 - END DO - END IF - JI24=ISHFT(IAND(JI24,'00ffffff'X),8) !PROPER FRACTION -C -C DEC IN -C - ELSE IF (ITP.EQ.1 .OR. ITP.EQ.2) THEN !DEC D OR G-FLOAT IN - JB=JI24 !SIGN - JA=ISHFT(IAND(JI24,'7f800000'X),-23) !EXPONENT - IF (JA.EQ.0) THEN !ZERO EXPONENT -> ZERO NUMBER - JI24=0 - ELSE - JA=JA-128 !UNBIASED EXPONENT - JI24=IOR('80000000'X,ISHFT(IAND(JI24,'007fffff'X),8)) !FRACTION - END IF -C -C IEEE IN -C - ELSE !IEEE IN - JB=JI24 !SIGN - JA=ISHFT(IAND(JI24,'7f800000'X),-23) !EXPONENT - IF (JA.EQ.0) THEN !ZERO EXPONENT -> ZERO NUMBER - JI24=0 - ELSE - JA=JA-126 !UNBIASED EXPONENT - JI24=IOR('80000000'X,ISHFT(IAND(JI24,'007fffff'X),8)) !FRACTION - END IF - END IF -C -C CONVERT TO OUTPUT FORMAT -C -C IBM OUT -C - IF (OTP.EQ.-1) THEN !IBM OUT - DO WHILE (IAND(JA,3).NE.0) - JI24=IAND(ISHFT(JI24,-1),'7fffffff'X) !NORMALISE - JA=JA+1 - END DO - JA=JA/4 !CORRECT EXP - IF (JA.GT.63) THEN !OVERFLOW - JI24=-1 !LARGEST FRACTION - JA=63 - END IF - IF (JA.LE.-64 .OR. JI24.EQ.0) THEN !UNDERFLOW - JI24=0 - JA=-64 - JB=0 - END IF - JI24=IAND(JB,'80000000'X)+ !MAKE NUMBER - 1 IAND(ISHFT(JA+64,24),'7f000000'X)+ - 1 IAND(ISHFT(JI24,-8),'00ffffff'X) -C -C DEC OUT -C - ELSE IF (OTP.EQ.1 .OR. OTP.EQ.2) THEN !DEC D OR G-FLOAT OUT - IF (JA.GT.127) THEN !OVERFLOW - JI24=-1 !LARGEST FRACTION - JA=127 - END IF - IF (JA.LE.-128 .OR. JI24.EQ.0) THEN !UNDERFLOW - JI24=0 - JA=-128 - JB=0 - END IF - JI24=IAND(JB,'80000000'X)+ !MAKE NUMBER - 1 IAND(ISHFT(JA+128,23),'7f800000'X)+ - 1 IAND(ISHFT(JI24,-8),'007fffff'X) -C -C IEEE OUT -C - ELSE !IEEE OUT - IF (JA.GT.128) THEN !OVERFLOW - JI24=-1 !LARGEST FRACTION - JA=128 - END IF - IF (JA.LE.-126 .OR. JI24.EQ.0) THEN !UNDERFLOW - JI24=0 - JA=-126 - JB=0 - END IF - JI24=IAND(JB,'80000000'X)+ !MAKE NUMBER - 1 IAND(ISHFT(JA+126,23),'7f800000'X)+ - 1 IAND(ISHFT(JI24,-8),'007fffff'X) - END IF !OTP -C -C CONVERT OUTPUT BYTES FROM LOCAL ORDER -C -C DEC OUT -C - IF (OTP.EQ.1 .OR. OTP.EQ.2) THEN - IF (STPL) THEN !DEC MACHINE - BUF(J3+2)=LI24(1) !OUTPUT RESULT - BUF(J3+3)=LI24(2) - BUF(J3+0)=LI24(3) - BUF(J3+1)=LI24(4) - ELSE - BUF(J3+1)=LI24(1) !OUTPUT RESULT - BUF(J3+0)=LI24(2) - BUF(J3+3)=LI24(3) - BUF(J3+2)=LI24(4) - END IF -C -C OTHER OUT -C - ELSE - IF (STPL.XOR.STPO) THEN !DIFFERENT BYTE ORDER - BUF(J3+3)=LI24(1) !OUTPUT RESULT - BUF(J3+2)=LI24(2) - BUF(J3+1)=LI24(3) - BUF(J3+0)=LI24(4) - ELSE - BUF(J3+0)=LI24(1) !OUTPUT RESULT - BUF(J3+1)=LI24(2) - BUF(J3+2)=LI24(3) - BUF(J3+3)=LI24(4) - END IF - END IF - END DO !NEXT VALUE - GOTO 1011 !NEXT CODE -C -C Y -C - 1150 CONTINUE !C16 - J1=2*J1 -C -C D -C - 1050 CONTINUE !R8 - J2=8*MIN(J1,J/8) -C -C ONLY A SWAP IS NEEDED IF INPUT AND OUTPUT TYPE ARE EQUAL -C - IF (ITP.EQ.OTP) THEN - CALL WNGSWQ(J2,BUF(IPT)) - GOTO 1011 !NEXT CODE - END IF - DO J3=IPT,IPT+J2-8,8 !CONVERT -C -C -C CONVERT INPUT BYTES TO LOCAL ORDER -C -C DEC IN -C - IF (ITP.EQ.1 .OR. ITP.EQ.2) THEN !DEC D OR G-FLOAT IN - IF (STPL) THEN !DEC MACHINE - LI24(1)=BUF(J3+2) !GET NUMBER - LI24(2)=BUF(J3+3) - LI24(3)=BUF(J3+0) - LI24(4)=BUF(J3+1) - LI24(5)=BUF(J3+6) - LI24(6)=BUF(J3+7) - LI24(7)=BUF(J3+4) - LI24(8)=BUF(J3+5) - ELSE - LI24(1)=BUF(J3+1) !GET NUMBER - LI24(2)=BUF(J3+0) - LI24(3)=BUF(J3+3) - LI24(4)=BUF(J3+2) - LI24(5)=BUF(J3+5) - LI24(6)=BUF(J3+4) - LI24(7)=BUF(J3+7) - LI24(8)=BUF(J3+6) - END IF -C -C OTHER IN -C - ELSE - IF (STPL.XOR.STPI) THEN !DIFFERENT LOCAL BYTE ORDER - LI24(1)=BUF(J3+7) !GET NUMBER - LI24(2)=BUF(J3+6) - LI24(3)=BUF(J3+5) - LI24(4)=BUF(J3+4) - LI24(5)=BUF(J3+3) - LI24(6)=BUF(J3+2) - LI24(7)=BUF(J3+1) - LI24(8)=BUF(J3+0) - ELSE !SAME BYTE ORDER - LI24(1)=BUF(J3+0) !GET NUMBER - LI24(2)=BUF(J3+1) - LI24(3)=BUF(J3+2) - LI24(4)=BUF(J3+3) - LI24(5)=BUF(J3+4) - LI24(6)=BUF(J3+5) - LI24(7)=BUF(J3+6) - LI24(8)=BUF(J3+7) - END IF - IF (STPL) THEN !LOCAL DEC MACHINE - JB=JI18 !SWAP LONGWORDS - JI18=JI28 - JI28=JB - END IF - END IF -C -C GET SIGN, EXPONENT AND FRACTION -C -C IBM IN -C - IF (ITP.EQ.-1) THEN !IBM IN - JA=4*ISHFT(IAND(JI18,'7f000000'X),-24)-256 !UNBIASED POW. - JB=JI18 !SIGN - IF (IAND(JI18,'00ffffff'X).EQ.0) THEN !ZERO FRACTION -> ZERO NUMBER - JI18=0 - JI28=0 - ELSE - DO WHILE(IAND(JI18,2**23).EQ.0) !NORMALIZE - JI18=ISHFT(IAND(JI18,'00ffffff'X),1) - IF (JI28.LT.0) JI18=JI18+1 - JI28=ISHFT(JI28,1) - JA=JA-1 - END DO - END IF - JI18=ISHFT(IAND(JI18,'00ffffff'X),8)+ - 1 IAND(ISHFT(JI28,-24),'000000ff'X) !PROPER FRACTION - JI28=ISHFT(JI28,8) -C -C DEC-D IN -C - ELSE IF (ITP.EQ.1) THEN !DEC D-FLOAT IN - JB=JI18 !SIGN - JA=ISHFT(IAND(JI18,'7f800000'X),-23) !EXPONENT - IF (JA.EQ.0) THEN !ZERO EXPONENT -> ZERO NUMBER - JI18=0 - JI28=0 - ELSE - JA=JA-128 !UNBIASED EXPONENT - JI18=IOR('80000000'X,ISHFT(IAND(JI18,'007fffff'X),8))+ - 1 IAND(ISHFT(JI28,-24),'000000ff'X) !PROPER FRACTION - JI28=ISHFT(JI28,8) - END IF -C -C DEC-G IN -C - ELSE IF (ITP.EQ.2) THEN !DEC G-FLOAT IN - JB=JI18 !SIGN - JA=ISHFT(IAND(JI18,'7ff00000'X),-20) !EXPONENT - IF (JA.EQ.0) THEN !ZERO EXPONENT -> ZERO NUMBER - JI18=0 - JI28=0 - ELSE - JA=JA-1024 !UNBIASED EXPONENT - JI18=IOR('80000000'X,ISHFT(IAND(JI18,'000fffff'X),11))+ - 1 IAND(ISHFT(JI28,-21),'000007ff'X) !PROPER FRACTION - JI28=ISHFT(JI28,11) - END IF -C -C IEEE IN -C - ELSE !IEEE IN - JB=JI18 !SIGN - JA=ISHFT(IAND(JI18,'7ff00000'X),-20) !EXPONENT - IF (JA.EQ.0) THEN !ZERO EXPONENT -> ZERO NUMBER - JI18=0 - JI28=0 - ELSE - JA=JA-1022 !UNBIASED EXPONENT - JI18=IOR('80000000'X,ISHFT(IAND(JI18,'000fffff'X),11))+ - 1 IAND(ISHFT(JI28,-21),'000007ff'X) !PROPER FRACTION - JI28=ISHFT(JI28,11) - END IF - END IF -C -C CONVERT TO OUTPUT FORMAT -C -C IBM OUT -C - IF (OTP.EQ.-1) THEN !IBM OUT - DO WHILE (IAND(JA,3).NE.0) !NORMALIZE - JI28=IAND(ISHFT(JI28,-1),'7fffffff'X)+ - 1 IAND(ISHFT(JI18,31),'80000000'X) - JI18=IAND(ISHFT(JI18,-1),'7fffffff'X) !NORMALISE - JA=JA+1 - END DO - JA=JA/4 !CORRECT EXP - IF (JA.GT.63) THEN !OVERFLOW - JI18=-1 !LARGEST FRACTION - JI28=-1 - JA=63 - END IF - IF (JA.LE.-64 .OR. JI18.EQ.0) THEN !UNDERFLOW - JI18=0 - JI28=0 - JA=-64 - JB=0 - END IF - JI28=ISHFT(JI28,-8)+IAND(ISHFT(JI18,24),'ff000000'X) !MAKE NUMBER - JI18=IAND(JB,'80000000'X)+ - 1 IAND(ISHFT(JA+64,24),'7f000000'X)+ - 1 IAND(ISHFT(JI18,-8),'00ffffff'X) -C -C DEC-D OUT -C - ELSE IF (OTP.EQ.1) THEN !DEC D-FLOAT OUT - IF (JA.GT.127) THEN !OVERFLOW - JI18=-1 !LARGEST FRACTION - JI28=-1 - JA=127 - END IF - IF (JA.LE.-128 .OR. JI18.EQ.0) THEN !UNDERFLOW - JI18=0 - JI28=0 - JA=-128 - JB=0 - END IF - JI28=IAND(ISHFT(JI28,-8),'00ffffff'X)+ - 1 IAND(ISHFT(JI18,24),'ff000000'X) !MAKE NUMBER - JI18=IAND(JB,'80000000'X)+ - 1 IAND(ISHFT(JA+128,23),'7f800000'X)+ - 1 IAND(ISHFT(JI18,-8),'007fffff'X) -C -C DEC-G OUT -C - ELSE IF (OTP.EQ.2) THEN !DEC G-FLOAT OUT - IF (JA.GT.1023) THEN !OVERFLOW - JI18=-1 !LARGEST FRACTION - JI28=-1 - JA=1023 - END IF - IF (JA.LE.-1024 .OR. JI18.EQ.0) THEN !UNDERFLOW - JI18=0 - JI28=0 - JA=-1024 - JB=0 - END IF - JI28=IAND(ISHFT(JI28,-11),'001fffff'X)+ - 1 IAND(ISHFT(JI18,21),'ffe00000'X) !MAKE NUMBER - JI18=IAND(JB,'80000000'X)+ - 1 IAND(ISHFT(JA+1024,20),'7ff00000'X)+ - 1 IAND(ISHFT(JI18,-11),'000fffff'X) -C -C IEEE OUT -C - ELSE !IEEE OUT - IF (JA.GT.1024) THEN !OVERFLOW - JI18=-1 !LARGEST FRACTION - JI28=-1 - JA=1024 - END IF - IF (JA.LE.-1022 .OR. JI18.EQ.0) THEN !UNDERFLOW - JI18=0 - JI28=0 - JA=-1022 - JB=0 - END IF - JI28=IAND(ISHFT(JI28,-11),'001fffff'X)+ - 1 IAND(ISHFT(JI18,21),'ffe00000'X) !MAKE NUMBER - JI18=IAND(JB,'80000000'X)+ - 1 IAND(ISHFT(JA+1022,20),'7ff00000'X)+ - 1 IAND(ISHFT(JI18,-11),'000fffff'X) - END IF !OTP -C -C CONVERT OUTPUT BYTES FROM LOCAL ORDER -C -C DEC OUT -C - IF (OTP.EQ.1 .OR. OTP.EQ.2) THEN - IF (STPL) THEN !DEC MACHINE - BUF(J3+2)=LI24(1) !OUTPUT RESULT - BUF(J3+3)=LI24(2) - BUF(J3+0)=LI24(3) - BUF(J3+1)=LI24(4) - BUF(J3+6)=LI24(5) - BUF(J3+7)=LI24(6) - BUF(J3+4)=LI24(7) - BUF(J3+5)=LI24(8) - ELSE - BUF(J3+1)=LI24(1) !OUTPUT RESULT - BUF(J3+0)=LI24(2) - BUF(J3+3)=LI24(3) - BUF(J3+2)=LI24(4) - BUF(J3+5)=LI24(5) - BUF(J3+4)=LI24(6) - BUF(J3+7)=LI24(7) - BUF(J3+6)=LI24(8) - END IF -C -C OTHER OUT -C - ELSE - IF (STPL) THEN !LOCAL DEC MACHINE - JB=JI18 !SWAP LONGWORDS - JI18=JI28 - JI28=JB - END IF - IF (STPL.XOR.STPO) THEN !DIFFERENT BYTE ORDER - BUF(J3+7)=LI24(1) !OUTPUT RESULT - BUF(J3+6)=LI24(2) - BUF(J3+5)=LI24(3) - BUF(J3+4)=LI24(4) - BUF(J3+3)=LI24(5) - BUF(J3+2)=LI24(6) - BUF(J3+1)=LI24(7) - BUF(J3+0)=LI24(8) - ELSE !SAME BYTE ORDER - BUF(J3+0)=LI24(1) !OUTPUT RESULT - BUF(J3+1)=LI24(2) - BUF(J3+2)=LI24(3) - BUF(J3+3)=LI24(4) - BUF(J3+4)=LI24(5) - BUF(J3+5)=LI24(6) - BUF(J3+6)=LI24(7) - BUF(J3+7)=LI24(8) - END IF - END IF - END DO !NEXT VALUE - GOTO 1011 !NEXT CODE -C -C - END diff --git a/src/wng/wnttsg.for b/src/wng/wnttsg.for deleted file mode 100644 index d7ebcf9ddff1ce12de87d9a27b46ffde735d8268..0000000000000000000000000000000000000000 --- a/src/wng/wnttsg.for +++ /dev/null @@ -1,68 +0,0 @@ -C+ WNTTSG.FOR -C WNB 900320 -C -C Revisions: -C WNB 910730 Cater for # type set name -C GvD 920506 Use STR iso WNTTSG to fill string (bug on SUN) -C - CHARACTER*(*) FUNCTION WNTTSG(SGN,WID) -C -C Translate sub-group full name to string -C -C Result: -C -C WNTTSG_C* = WNTTSG( SGN_J(0:7):I, WID_J:I) -C Translate the sub-group as defined by SGN to a -C string a.b.c with each a,b,c at its default width -C (WID<=0) or at fixed width WID. -C -C Include files: -C - INCLUDE 'WNG_DEF' -C -C Parameters: -C -C -C Arguments: -C - INTEGER SGN(0:7) !SUB-GROUP NAME - INTEGER WID !WIDTH EACH FIELD (OR 0) -C -C Function references: -C - INTEGER WNCAL0 !STRING LENGTH -C -C Data declarations: -C - CHARACTER*32 STR -C -C- - STR=' ' !ASSUME EMPTY - IF (SGN(1).EQ.-2) THEN !# TYPE - IF (WID.LE.0) THEN !DEFAULT WIDTH - CALL WNCTXS(STR,'#!UJ',SGN(0)) - ELSE - CALL WNCTXS(STR,'#!#$ZJ',WID,SGN(0)) - END IF - ELSE !NORMAL SET TYPE - I=0 !FIELD COUNT - DO WHILE (I.LT.8 .AND. SGN(I).NE.-1) !ALL FIELDS - J=WNCAL0(STR)+1 !POINTER - IF (I.NE.0) THEN - STR(J:J)='.' !SEPARATOR - J=J+1 - END IF - IF (WID.LE.0) THEN !DEFAULT WIDTH - CALL WNCTXS(STR(J:),'!UJ',SGN(I)) - ELSE !SPECIFIED WIDTH - CALL WNCTXS(STR(J:),'!#$ZJ',WID,SGN(I)) - END IF - I=I+1 !NEXT FIELD - END DO - END IF -C - WNTTSG=STR - RETURN -C -C - END diff --git a/src/wng/wnxcshrc.com b/src/wng/wnxcshrc.com deleted file mode 100755 index 631689d8169517d1d139fe051c1b566be5e098f1..0000000000000000000000000000000000000000 --- a/src/wng/wnxcshrc.com +++ /dev/null @@ -1,54 +0,0 @@ -$!# wnxcshrc.ssc -$!# WNB 920911 -$!# -$!# Revisions: -$!# WNB 921015 Change use of OLBEXE -$!# WNB 921021 Add pa3 -$!# WNB 921215 Change edt alias -$!# WNB 921224 Make SSC -$!# WNB 930128 Change edt alias; directory change aliases -$!# WNB 930901 Add nod -$!# WNG 930921 Change _COD from symbol to logical (VMS) -$!# WNB 931123 Make back directories consistent (Unix) -$!# WNB 940216 Change nod; add ntd -$!# -$!# Additional general definitions WNG package -$!# -$ IF P1 .NES. "ND" -$ THEN -$ EDT=="EDI/EDT/COMMAND=WNGEDTINI.COM" -$ LO*GOUT=="LOGOUT/BRIEF" -$ SHD*EF=="SHOW DEFAULT" -$ DDIR*ECTORY=="DIRECT/DATE/SIZE/OWN/PROT/WIDTH=(OWN=8,FILENAME=18,SIZE=4)" -$ DDEL*ETE=="DELETE/CONF" -$ ND*IR=="@WNG:WNXCSHRC ND " -$ PA3=="WNGFEX A3 " -$ PEPS=="WNGFEX PS " -$ PLAS=="WNGFEX LA " -$ PQMS=="WNGFEX QM " -$ PVAX=="WNGFEX SP " -$ SET CONTROL=T -$ ELSE -$ IF P2 .NES. "" -$ THEN -$ SUBNAME=P2 -$ ELSE -$ INQUIRE SUBNAME Subname -$ ENDIF -$ IF SUBNAME .NES. "" -$ THEN -$ SET DEF WNG_OLBEXE:['SUBNAME'] -$ IF F$TRNLNM("NC_COD") .NES. "" THEN DEASSIGN NC_COD -$ IF F$TRNLNM("NL_COD") .NES. "" THEN DEASSIGN NL_COD -$ IF F$SEARCH("LOGIN.COM") .NES. "" -$ THEN -$ @LOGIN -$ ENDIF -$ ELSE -$ SET DEF WNG_OLBEXE:[-] -$ IF F$TRNLNM("NC_COD") .NES. "" THEN DEASSIGN NC_COD -$ IF F$TRNLNM("NL_COD") .NES. "" THEN DEASSIGN NL_COD -$ ENDIF -$ ENDIF -$ ! -$ EXIT diff --git a/src/wng/wnxcshrc.ssc b/src/wng/wnxcshrc.ssc deleted file mode 100644 index 6cf072e72dd5c73cd6aa175d519652e52914c691..0000000000000000000000000000000000000000 --- a/src/wng/wnxcshrc.ssc +++ /dev/null @@ -1,109 +0,0 @@ -# wnxcshrc.ssc -# WNB 920911 -# -# Revisions: -# WNB 921015 Change use of OLBEXE -# WNB 921021 Add pa3 -# WNB 921215 Change edt alias -# WNB 921224 Make SSC -# WNB 930128 Change edt alias; directory change aliases -# WNB 930901 Add nod -# WNG 930921 Change _COD from symbol to logical (VMS) -# WNB 931123 Make back directories consistent (Unix) -# WNB 940216 Change nod; add ntd -# -# Additional general definitions WNG package -# -#ifdef wn_vax__ -$ IF P1 .NES. "ND" -$ THEN -$ EDT=="EDI/EDT/COMMAND=WNGEDTINI.COM" -$ LO*GOUT=="LOGOUT/BRIEF" -$ SHD*EF=="SHOW DEFAULT" -$ DDIR*ECTORY=="DIRECT/DATE/SIZE/OWN/PROT/WIDTH=(OWN=8,FILENAME=18,SIZE=4)" -$ DDEL*ETE=="DELETE/CONF" -$ ND*IR=="@WNG:WNXCSHRC ND " -$ PA3=="WNGFEX A3 " -$ PEPS=="WNGFEX PS " -$ PLAS=="WNGFEX LA " -$ PQMS=="WNGFEX QM " -$ PVAX=="WNGFEX SP " -$ SET CONTROL=T -$ ELSE -$ IF P2 .NES. "" -$ THEN -$ SUBNAME=P2 -$ ELSE -$ INQUIRE SUBNAME Subname -$ ENDIF -$ IF SUBNAME .NES. "" -$ THEN -$ SET DEF WNG_OLBEXE:['SUBNAME'] -$ IF F$TRNLNM("NC_COD") .NES. "" THEN DEASSIGN NC_COD -$ IF F$TRNLNM("NL_COD") .NES. "" THEN DEASSIGN NL_COD -$ IF F$SEARCH("LOGIN.COM") .NES. "" -$ THEN -$ @LOGIN -$ ENDIF -$ ELSE -$ SET DEF WNG_OLBEXE:[-] -$ IF F$TRNLNM("NC_COD") .NES. "" THEN DEASSIGN NC_COD -$ IF F$TRNLNM("NL_COD") .NES. "" THEN DEASSIGN NL_COD -$ ENDIF -$ ENDIF -$ ! -$ EXIT -#else - alias prompt 'set prompt="[1m${HOSTNAME}: ${PWD}>[m "' - alias bd 'set tmp=$bwd; set bwd=$cwd; cd $tmp; unset tmp; setenv PWD $cwd; prompt' - alias bnd 'set tmp=$bnd; set bnd=$cwd:t; chdir $WNG/../$tmp;if ( -e login.sun) source login.sun; unset tmp; setenv PWD $cwd; prompt' - if ($?WNG_OLB) then - alias bnod 'set tmp=$bnod; set bnod=$cwd:t; chdir $WNG_OLB/$tmp; if ( -e login.sun) source login.sun; unset tmp; setenv PWD $cwd; prompt' - else - alias bnod 'set tmp=$bnod; set bnod=$cwd:t; chdir $WNG_OLBEXE/$tmp; if ( -e login.sun) source login.sun; unset tmp; setenv PWD $cwd; prompt' - endif - if ($?WNG_EXE) then - alias bnwd 'set tmp=$bnwd; set bnwd=$cwd:t; chdir $WNG_EXE/$tmp; if ( -e login.sun) source login.sun; unset tmp; setenv PWD $cwd; prompt' - else - alias bnwd 'set tmp=$bnwd; set bnwd=$cwd:t; chdir $WNG_OLBEXE/$tmp; if ( -e login.sun) source login.sun; unset tmp; setenv PWD $cwd; prompt' - endif - alias cd 'set bwd=$cwd; chdir \!*; setenv PWD $cwd; prompt' - alias cp "cp -i" - alias ddel "rm -i" - alias ddir "ls -AliF" - alias del "'rm' -f" - alias dir "ls -F" - alias edt '(setenv TERM vt100 ; emacs -nw $cwd/\!* )' - if ($?EXEDWARF_UNIX) then - alias exe "$EXEDWARF_UNIX/execute.exe \!* " - alias texe "$EXEDWARF_UNIX/\!^.exe " - endif - alias h "history | more" - alias help "man" - alias lo "logout" - alias mv "mv -i" - alias nd 'set bnd=$cwd:t; chdir $WNG/../\!*; if ( -e login.sun) source login.sun; setenv PWD $cwd; prompt' - if ($?WNG_OLB) then - alias nod 'set bnod=$cwd:t; chdir $WNG_OLB/\!*; if ( -e login.sun) source login.sun; setenv PWD $cwd; prompt' - else - alias nod 'set bnod=$cwd:t; chdir $WNG_OLBEXE/\!*; if ( -e login.sun) source login.sun; setenv PWD $cwd; prompt' - endif - if ($?WNG_TLB) then - alias ntd 'set bntd=$cwd:t; chdir $WNG_TLB/\!*; if ( -e login.sun) source login.sun; setenv PWD $cwd; prompt' - else - alias ntd 'set bntd=$cwd:t; chdir $WNG/../\!*; if ( -e login.sun) source login.sun; setenv PWD $cwd; prompt' - endif - if ($?WNG_EXE) then - alias nwd 'set bnwd=$cwd:t; chdir $WNG_EXE/\!*; if ( -e login.sun) source login.sun; setenv PWD $cwd; prompt' - else - alias nwd 'set bnwd=$cwd:t; chdir $WNG_OLBEXE/\!*; if ( -e login.sun) source login.sun; setenv PWD $cwd; prompt' - endif - alias pa3 "$WNG/WNGFEX a3 \!* " - alias peps "$WNG/WNGFEX ps \!* " - alias plas "$WNG/WNGFEX la \!* " - alias pqms "$WNG/WNGFEX qm \!* " - alias pvax "$WNG/WNGFEX sp \!* " - alias quota ' ls -AsR1 \!* | awk '"'"' NF == 2 && $1 != "total" {x = x+ $1} END {print x,"kbytes for \!*"}' "'" - alias rm "rm -i" - alias shd "pwd" -#endif diff --git a/src/wng/wnxcshrc.sun b/src/wng/wnxcshrc.sun deleted file mode 100755 index 3414c586a5c3670089df6f8e4c0f40d8c23ae97a..0000000000000000000000000000000000000000 --- a/src/wng/wnxcshrc.sun +++ /dev/null @@ -1,68 +0,0 @@ -# wnxcshrc.ssc -# WNB 920911 -# -# Revisions: -# WNB 921015 Change use of OLBEXE -# WNB 921021 Add pa3 -# WNB 921215 Change edt alias -# WNB 921224 Make SSC -# WNB 930128 Change edt alias; directory change aliases -# WNB 930901 Add nod -# WNG 930921 Change _COD from symbol to logical (VMS) -# WNB 931123 Make back directories consistent (Unix) -# WNB 940216 Change nod; add ntd -# -# Additional general definitions WNG package -# - alias prompt 'set prompt="[1m${HOSTNAME}: ${PWD}>[m "' - alias bd 'set tmp=$bwd; set bwd=$cwd; cd $tmp; unset tmp; setenv PWD $cwd; prompt' - alias bnd 'set tmp=$bnd; set bnd=$cwd:t; chdir $WNG/../$tmp;if ( -e login.sun) source login.sun; unset tmp; setenv PWD $cwd; prompt' - if ($?WNG_OLB) then - alias bnod 'set tmp=$bnod; set bnod=$cwd:t; chdir $WNG_OLB/$tmp; if ( -e login.sun) source login.sun; unset tmp; setenv PWD $cwd; prompt' - else - alias bnod 'set tmp=$bnod; set bnod=$cwd:t; chdir $WNG_OLBEXE/$tmp; if ( -e login.sun) source login.sun; unset tmp; setenv PWD $cwd; prompt' - endif - if ($?WNG_EXE) then - alias bnwd 'set tmp=$bnwd; set bnwd=$cwd:t; chdir $WNG_EXE/$tmp; if ( -e login.sun) source login.sun; unset tmp; setenv PWD $cwd; prompt' - else - alias bnwd 'set tmp=$bnwd; set bnwd=$cwd:t; chdir $WNG_OLBEXE/$tmp; if ( -e login.sun) source login.sun; unset tmp; setenv PWD $cwd; prompt' - endif - alias cd 'set bwd=$cwd; chdir \!*; setenv PWD $cwd; prompt' - alias cp "cp -i" - alias ddel "rm -i" - alias ddir "ls -AliF" - alias del "'rm' -f" - alias dir "ls -F" - alias edt '(setenv TERM vt100 ; emacs -nw $cwd/\!* )' - if ($?EXEDWARF_UNIX) then - alias exe "$EXEDWARF_UNIX/execute.exe \!* " - alias texe "$EXEDWARF_UNIX/\!^.exe " - endif - alias h "history | more" - alias help "man" - alias lo "logout" - alias mv "mv -i" - alias nd 'set bnd=$cwd:t; chdir $WNG/../\!*; if ( -e login.sun) source login.sun; setenv PWD $cwd; prompt' - if ($?WNG_OLB) then - alias nod 'set bnod=$cwd:t; chdir $WNG_OLB/\!*; if ( -e login.sun) source login.sun; setenv PWD $cwd; prompt' - else - alias nod 'set bnod=$cwd:t; chdir $WNG_OLBEXE/\!*; if ( -e login.sun) source login.sun; setenv PWD $cwd; prompt' - endif - if ($?WNG_TLB) then - alias ntd 'set bntd=$cwd:t; chdir $WNG_TLB/\!*; if ( -e login.sun) source login.sun; setenv PWD $cwd; prompt' - else - alias ntd 'set bntd=$cwd:t; chdir $WNG/../\!*; if ( -e login.sun) source login.sun; setenv PWD $cwd; prompt' - endif - if ($?WNG_EXE) then - alias nwd 'set bnwd=$cwd:t; chdir $WNG_EXE/\!*; if ( -e login.sun) source login.sun; setenv PWD $cwd; prompt' - else - alias nwd 'set bnwd=$cwd:t; chdir $WNG_OLBEXE/\!*; if ( -e login.sun) source login.sun; setenv PWD $cwd; prompt' - endif - alias pa3 "$WNG/WNGFEX a3 \!* " - alias peps "$WNG/WNGFEX ps \!* " - alias plas "$WNG/WNGFEX la \!* " - alias pqms "$WNG/WNGFEX qm \!* " - alias pvax "$WNG/WNGFEX sp \!* " - alias quota ' ls -AsR1 \!* | awk '"'"' NF == 2 && $1 != "total" {x = x+ $1} END {print x,"kbytes for \!*"}' "'" - alias rm "rm -i" - alias shd "pwd" diff --git a/src/wng/wnxlogin.com b/src/wng/wnxlogin.com deleted file mode 100644 index 909e2a302e6116bd926dd7286d29152ef08e5555..0000000000000000000000000000000000000000 --- a/src/wng/wnxlogin.com +++ /dev/null @@ -1,182 +0,0 @@ -$ ! WNXLOGIN.COM -$ ! WNB 920127 -$ ! -$ ! Revisions: -$ ! -$ ! General LOGIN.COM for use of WNB and WIM and BROUW and ... -$ ! P1 Name of main directory -$ ! P2 NDIR (for new subdirectory) or blank -$ ! P3 Subdirectory (if P2 NDIR) or blank -$ ! P4 VERIFY or blank -$ ! -$ ! SOME STANDARDS -$ ! -$ IF P4 .EQS. "" THEN LOCA=F$VERIFY(0) -$ IF P4 .NES. "" THEN LOCA=F$VERIFY(1) -$ IF P2 .EQS. "NDIR" THEN GOTO LX1 !NDIR -$ SET PROTECTION=(G:RWE,W:RE)/DEFAULT -$ IF F$ENVIRONMENT("INTERACTIVE") .EQS. "TRUE" THEN - - SET TERM TT /VT100/FULLDUP -$ IF P1 .EQS. "BROUW" THEN EXIT -$ ! -$ ! KEYS -$ ! -$ DEFINE/KEY/NOLOG F20 "MONITOR SYSTEM/INTER=1" /TERMINATE/NOECHO/ERASE -$ DEFINE/KEY/NOLOG F19 "MONITOR PROCESS/TOPCPU/INTER=1" /TERM/NOECH/ERASE -$ DEFINE/KEY/NOLOG F18 "RUN SYS$MANAGER:MONPROCES" /TERM/NOECH/ERASE -$ DEFINE/KEY/NOLOG F17 "NCP TELL RZMVX5 SHO MODU X25-P KNO DTE" /TERM/NOECH/ERASE -$ DEFINE/KEY/NOLOG HELP "HELP/NOINSTR/NOPAGE" /TERM/NOECH/ERASE -$ DEFINE/KEY/NOLOG DO "VALL" /TERM/NOECH/ERASE -$ DEFINE/KEY/NOLOG E1 "SHOW SYSTEM" /TERM/NOECH/ERASE -$ DEFINE/KEY/NOLOG E2 "SHOW QUEUE/DEVICE/ALL" /TERM/NOECHO/ERASE -$ DEFINE/KEY/NOLOG E3 "SHOW QUEUE/BATCH/ALL" /TERM/NOECHO/ERASE -$ DEFINE/KEY/NOLOG E4 "SHOW KEY/ALL" /TERM/NOECHO/ERASE -$ DEFINE/KEY/NOLOG E5 - - "@''F$LOGICAL("SYS$DISK")'[WIM.GEN]WATCHDOG.COM" /TERM/NOECHO/ERASE -$ DEFINE/KEY/NOLOG E6 "SHV" /TERM/NOECHO/ERASE -$ ! -$ ! STANDARD AREAS -$ ! -$ LX1: SET DEF SYS$LOGIN: -$ QWIM="USER5:" -$ QD=F$TRNLNM("SYS$DISK") -$ QT=QD+"[WIM.GEN]" -$ ! -$ ! GET SUBDIRECTORY -$ ! -$ IF P2 .EQS. "NDIR" .AND. P3 .NES. "" -$ THEN -$ SUBNAME=P3 -$ ELSE -$ INQUIRE SUBNAME Subname -$ ENDIF -$ IF SUBNAME .EQS. "" THEN GOTO LA1 -$ LA2: DEFUNUS=F$TRNLNM("SYS$DISK")+"["+P1+"."+SUBNAME+"]" -$ GOTO LA3 -$ LA1: DEFUNUS=F$TRNLNM("SYS$DISK")+"["+P1+"]" -$ LA3: IF P2 .NES. "" THEN GOTO LX2 !NDIR -$ ! -$ ! EDITOR -$ ! -$ EDT=="EDI/EDT/COMMAND=''QT'EDTINI.COM" -$ EVE=="EDI/TPU" -$ ! -$ ! LOGOUT -$ ! -$ BYE=="''LO'" -$ BBYE=="@''QT'BBYEALL" -$ LO*GOUT=="LOGOUT/BRIEF" -$ -$ ! -$ ! STANDARD PROGRAMS -$ ! -$ WC*OMPILE=="@"+F$TRNLNM("RUNDWARF")-"]"+".MNT]WCOMP %" -$ WL*INK=="@"+F$TRNLNM("RUNDWARF")-"]"+".MNT]WLINK %" -$ WD*EL=="@"+F$TRNLNM("RUNDWARF")-"]"+".MNT]WDEL %" -$ WX*REF=="@"+F$TRNLNM("RUNDWARF")-"]"+".MNT]WXREF %" -$ ADV*ENT=="RUN ''QWIM'[WIM.ADV]ADVENT" -$ CLC=="RUN ''QWIM'[WIM.CLC]CLC" -$ SDA=="$SDA" -$ TUP*DATE=="@''QT'UPDSUB [''P1'...]" -$ FDU*MP=="RUN [DWARF]PRTDSK" -$ NCP=="$NCP" -$ DTE=="$NCP TELL RZMVX5 SHO MODU X25-PROT KNOWN DTE" -$ ! -$ !SET HOST -$ ! -$ VX2=="SET HOST RZMVX2" -$ VX1=="SET HOST RZMVX1" -$ VALL=="SET HOST RZMALL" -$ VX3=="SET HOST RZMVX3" -$ VX4=="SET HOST RZMVX4" -$ VX5=="SET HOST RZMVX5" -$ VSUR=="SET HOST RZMSUR" -$ ! -$ ! SHOW -$ ! -$ LA: SHB*ATCH=="SHOW QUEUE/BATCH/ALL" -$ SHE*NTRY=="SHOW ENTRY" -$ SHP*RINTER=="SHOW QUEUE/DEVICE/ALL" -$ SHT*IME=="SHOW TIME" -$ SHK*EY=="SHOW KEY/ALL" -$ SHM*EMORY=="SHOW MEMORY" -$ SHS*YSTEM=="SHOW SYSTEM" -$ SHD*EFAULT=="SHOW DEFAULT" -$ SHQ*UOTA=="SHOW QUOTA" -$ SHC*TATUS=="SHOW STATUS" -$ SHN*ET=="SHOW NET" -$ SHU*SERS=="SHOW USERS/FULL" -$ SHV=="@''QWIM'[WIM.GEN]SHV" -$ USE*RS=="@SYST1:[SYSMGR]USERS" -$ ! -$ ! STOP -$ ! -$ STPP*RINTER=="STOP/ABORT" -$ ! -$ ! MONITOR -$ ! -$ MND*ECNET=="MONITOR DECNET/INTERVAL=1" -$ MNF*CP=="MONITOR FCP/INTERVAL=1" -$ MNI*O=="MONITOR IO/INTERVAL=1" -$ MNL*OCK=="MONITOR LOCK/INTERVAL=1" -$ MNM*ODES=="MONITOR MODES/INTERVAL=1" -$ MNPA*GE=="MONITOR PAGE/INTERVAL=1" -$ MNPO*OL=="MONITOR POOL/INTERVAL=1" -$ MNPR*OCES=="RUN SYS$MANAGER:MONPROCES" -$ MNSY*STEM=="MONITOR SYSTEM/INTERVAL=1" -$ MNTC*PU=="MONITOR PROC/TOPCPU/INTERVAL=1" -$ MNTB*IO=="MONITOR PROC/TOPBIO/INTERVAL=1" -$ MNTD*IO=="MONITOR PROC/TOPDIO/INTERVAL=1" -$ MNTF*AULT=="MONITOR PROC/TOPFAULT/INTERVAL=1" -$ MNST*ATES=="MONITOR STATES/INTERVAL=1" -$ ! -$ ! SETS -$ ! -$ LX2: STD*EF=="SET DEF ''DEFUNUS'" -$ IF P2 .NES. "" THEN GOTO LX3 !NDIR -$ STMA*IN=="SET DEF ''F$LOGICAL("SYS$DISK")'[''P1']" -$ STW*IM=="SET DEF ''QT'" -$ SWIM=="SET DEF ''QT'" -$ STS*YS=="SET DEF SYS$COMMON:[SYSEXE]" -$ STM*GR=="SET DEF SYS$COMMON:[SYSMGR]" -$ STH*ELP=="SET DEF SYS$COMMON:[SYSHLP]" -$ STE*RRORLOG=="SET DEF SYS$COMMON:[SYSERR]" -$ STL*IBRARY=="SET DEF SYS$COMMON:[SYSLIB]" -$ STPRV=="SET PROCESS/PRIV=ALL" -$ STPRI=="SET PROCESS/PRIOR=10" -$ ! -$ !ASSIGNS -$ ! -$ ASSIGN/NOLOG 'F$LOGICAL("SYS$SYSTEM")' ZS -$ ASSIGN/NOLOG SYS$COMMON:[SYSMGR] ZM -$ ASSIGN/NOLOG SYS$COMMON:[SYSHLP] ZH -$ ASSIGN/NOLOG 'QT' USERWIM -$ LX3: ASSIGN/NOLOG 'DEFUNUS' USERA -$ ASSIGN/NOLOG 'DEFUNUS' CDEF -$ IF F$TRNLNM("EMAIL_NAME") .EQS. "" THEN - - ASSIGN/NOLOG "Dr. W.N. Brouw" EMAIL_NAME -$ IF P2 .NES. "" THEN GOTO LX4 !NDIR -$ ! -$ ! DIRECTORY HANDLING -$ ! -$ ND*IRECT=="@''QT'LOGINALL ''P1' NDIR" -$ DDIR*ECTORY=="DIRECT/DATE/SIZE/OWN/PROT/WIDTH=(OWN=8,FILENAME=18,SIZE=4)" -$ DDEL*ETE=="DELETE/CONF" -$ ! -$ ! SET CORRECT DIRECTORY -$ ! -$ LX4: STDEF -$ SET CONTROL=T -$ ! -$ ! DO SUB LOGIN -$ ! -$ IF "''WC_LIB'" .NES. "" THEN DELETE/SYMBOL/GLOBAL WC_LIB -$ IF "''WL_LIB'" .NES. "" THEN DELETE/SYMBOL/GLOBAL WL_LIB -$ IF SUBNAME .EQS. "" THEN GOTO LH -$ IF F$SEARCH("''DEFUNUS'LOGIN.COM") .EQS. "" THEN GOTO LH -$ @'DEFUNUS'LOGIN -$ ! -$ ! SHOW START -$ ! -$ LH: SHOW DEF -$ EXIT !'F$VERIFY(LOCA)' diff --git a/src/wng/wpg_grexec.for b/src/wng/wpg_grexec.for deleted file mode 100644 index e83a3f27277c2843aabe01fe2585966e939fcfd9..0000000000000000000000000000000000000000 --- a/src/wng/wpg_grexec.for +++ /dev/null @@ -1,28 +0,0 @@ -C*GREXEC -- PGPLOT device handler dispatch routine -C+ - SUBROUTINE GREXEC(IDEV,IFUNC,RBUF,NBUF,CHR,LCHR) -C--- - INCLUDE 'WNG_DEF' -C--- - INTEGER IDEV, IFUNC, NBUF, LCHR - REAL RBUF(*) - CHARACTER*(*) CHR -C--- - INTEGER NDEV - PARAMETER (NDEV=1) -C--- - GOTO(1) IDEV - IF (IDEV.EQ.0) THEN - RBUF(1) = NDEV - NBUF = 1 - ELSE - CALL WNCTXT(F_TP,'Unknown device code in GREXEC: !SL',IDEV) - CALL WNGEX !QUIT - END IF - RETURN -C--- - 1 CALL XWDRIV(IFUNC,RBUF,NBUF,CHR,LCHR) - RETURN -C - END - diff --git a/src/wng/wpg_xlogo64.inc b/src/wng/wpg_xlogo64.inc deleted file mode 100644 index ad3b0dbbf352cd13f305934859f46871a66e1362..0000000000000000000000000000000000000000 --- a/src/wng/wpg_xlogo64.inc +++ /dev/null @@ -1,46 +0,0 @@ -#define xlogo64_width 64 -#define xlogo64_height 64 -static unsigned char xlogo64_bits[] = { - 0xff, 0xff, 0x00, 0x00, 0x00, 0x00, 0x00, 0xf8, 0xfe, 0xff, 0x01, 0x00, - 0x00, 0x00, 0x00, 0xf8, 0xfc, 0xff, 0x03, 0x00, 0x00, 0x00, 0x00, 0x7c, - 0xf8, 0xff, 0x07, 0x00, 0x00, 0x00, 0x00, 0x3e, 0xf8, 0xff, 0x07, 0x00, - 0x00, 0x00, 0x00, 0x1f, 0xf0, 0xff, 0x0f, 0x00, 0x00, 0x00, 0x80, 0x0f, - 0xe0, 0xff, 0x1f, 0x00, 0x00, 0x00, 0x80, 0x0f, 0xc0, 0xff, 0x3f, 0x00, - 0x00, 0x00, 0xc0, 0x07, 0xc0, 0xff, 0x3f, 0x00, 0x00, 0x00, 0xe0, 0x03, - 0x80, 0xff, 0x7f, 0x00, 0x00, 0x00, 0xf0, 0x01, 0x00, 0xff, 0xff, 0x00, - 0x00, 0x00, 0xf8, 0x00, 0x00, 0xfe, 0xff, 0x01, 0x00, 0x00, 0xf8, 0x00, - 0x00, 0xfe, 0xff, 0x01, 0x00, 0x00, 0x7c, 0x00, 0x00, 0xfc, 0xff, 0x03, - 0x00, 0x00, 0x3e, 0x00, 0x00, 0xf8, 0xff, 0x07, 0x00, 0x00, 0x1f, 0x00, - 0x00, 0xf0, 0xff, 0x0f, 0x00, 0x80, 0x0f, 0x00, 0x00, 0xf0, 0xff, 0x0f, - 0x00, 0xc0, 0x07, 0x00, 0x00, 0xe0, 0xff, 0x1f, 0x00, 0xc0, 0x07, 0x00, - 0x00, 0xc0, 0xff, 0x3f, 0x00, 0xe0, 0x03, 0x00, 0x00, 0x80, 0xff, 0x7f, - 0x00, 0xf0, 0x01, 0x00, 0x00, 0x80, 0xff, 0x7f, 0x00, 0xf8, 0x00, 0x00, - 0x00, 0x00, 0xff, 0xff, 0x00, 0x7c, 0x00, 0x00, 0x00, 0x00, 0xfe, 0xff, - 0x01, 0x7c, 0x00, 0x00, 0x00, 0x00, 0xfc, 0xff, 0x03, 0x3e, 0x00, 0x00, - 0x00, 0x00, 0xfc, 0xff, 0x03, 0x1f, 0x00, 0x00, 0x00, 0x00, 0xf8, 0xff, - 0x87, 0x0f, 0x00, 0x00, 0x00, 0x00, 0xf0, 0xff, 0xcf, 0x07, 0x00, 0x00, - 0x00, 0x00, 0xe0, 0xff, 0xcf, 0x07, 0x00, 0x00, 0x00, 0x00, 0xe0, 0xff, - 0xe7, 0x03, 0x00, 0x00, 0x00, 0x00, 0xc0, 0xff, 0xf3, 0x01, 0x00, 0x00, - 0x00, 0x00, 0x80, 0xff, 0xf9, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xff, - 0xfc, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x7f, 0xfe, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x7e, 0xfe, 0x01, 0x00, 0x00, 0x00, 0x00, 0x00, 0x3e, - 0xff, 0x03, 0x00, 0x00, 0x00, 0x00, 0x00, 0x9f, 0xff, 0x07, 0x00, 0x00, - 0x00, 0x00, 0x80, 0xcf, 0xff, 0x07, 0x00, 0x00, 0x00, 0x00, 0xc0, 0xe7, - 0xff, 0x0f, 0x00, 0x00, 0x00, 0x00, 0xc0, 0xe7, 0xff, 0x1f, 0x00, 0x00, - 0x00, 0x00, 0xe0, 0xc3, 0xff, 0x3f, 0x00, 0x00, 0x00, 0x00, 0xf0, 0xc1, - 0xff, 0x3f, 0x00, 0x00, 0x00, 0x00, 0xf8, 0x80, 0xff, 0x7f, 0x00, 0x00, - 0x00, 0x00, 0x7c, 0x00, 0xff, 0xff, 0x00, 0x00, 0x00, 0x00, 0x7c, 0x00, - 0xfe, 0xff, 0x01, 0x00, 0x00, 0x00, 0x3e, 0x00, 0xfe, 0xff, 0x01, 0x00, - 0x00, 0x00, 0x1f, 0x00, 0xfc, 0xff, 0x03, 0x00, 0x00, 0x80, 0x0f, 0x00, - 0xf8, 0xff, 0x07, 0x00, 0x00, 0xc0, 0x07, 0x00, 0xf0, 0xff, 0x0f, 0x00, - 0x00, 0xe0, 0x03, 0x00, 0xf0, 0xff, 0x0f, 0x00, 0x00, 0xe0, 0x03, 0x00, - 0xe0, 0xff, 0x1f, 0x00, 0x00, 0xf0, 0x01, 0x00, 0xc0, 0xff, 0x3f, 0x00, - 0x00, 0xf8, 0x00, 0x00, 0x80, 0xff, 0x7f, 0x00, 0x00, 0x7c, 0x00, 0x00, - 0x80, 0xff, 0x7f, 0x00, 0x00, 0x3e, 0x00, 0x00, 0x00, 0xff, 0xff, 0x00, - 0x00, 0x3e, 0x00, 0x00, 0x00, 0xfe, 0xff, 0x01, 0x00, 0x1f, 0x00, 0x00, - 0x00, 0xfc, 0xff, 0x03, 0x80, 0x0f, 0x00, 0x00, 0x00, 0xfc, 0xff, 0x03, - 0xc0, 0x07, 0x00, 0x00, 0x00, 0xf8, 0xff, 0x07, 0xe0, 0x03, 0x00, 0x00, - 0x00, 0xf0, 0xff, 0x0f, 0xe0, 0x03, 0x00, 0x00, 0x00, 0xe0, 0xff, 0x1f, - 0xf0, 0x01, 0x00, 0x00, 0x00, 0xe0, 0xff, 0x1f, 0xf8, 0x00, 0x00, 0x00, - 0x00, 0xc0, 0xff, 0x3f, 0x7c, 0x00, 0x00, 0x00, 0x00, 0x80, 0xff, 0x7f, - 0x3e, 0x00, 0x00, 0x00, 0x00, 0x00, 0xff, 0xff}; diff --git a/src/wng/wpg_xwdriv.cun b/src/wng/wpg_xwdriv.cun deleted file mode 100644 index 1b15236fe32d20d97222271298bd75050f058b68..0000000000000000000000000000000000000000 --- a/src/wng/wpg_xwdriv.cun +++ /dev/null @@ -1,1490 +0,0 @@ -/* wpg_xwdriv.cun -. WNB 930629 -. -. Adapted from PGPLOT xwdriv.c v 4.9g - all changes marked with /** -. Summary of changes: -. No backing store (network problems Xterminals Dwingeloo) -. No warning messages -. Added function 30 to write text -. Changed names of window etc -. Made local include xlogo64 -. Reverse default PGPLOT_XW_CLICKLEFT to .true. -. -. Revisions: -. CMV 931108 Only get keystroke if non-empty window -. CMV 931108 Keep window in the air until exit (use wng -. exit handler!) -. CMV 931116 Changed open call (make it a bit more safe) -. JPH 940824 'NPLOT Window' --> 'NEWSTAR Plot Window' -. CMV 940829 Restore changes from last week (position, -. clicking on exit, focus etc) -. JPH 960622 Add control-c as an alternative for mouse control -. JPH 960801 Fix failure to refresh window while waiting for -. HjV 970723 Remove control-C stuff (commented out) -. -. /***/ -/* XWDRIV -- Fortran callable PGPLOT driver for X Windows software */ - -#define SIGNAL 0 /* Choose implementation of backing */ /***/ -#ifdef wn_hp__ /* to make FORK possible /***/ -#define FORK 0 /***/ -#else /***/ -#define FORK 0 /* store. Choose one by setting it - to 1. The SIGNAL method seems to - work well under Berkeley based Unix - while the FORK method works under - both Berkeley and System V Unix. - If no backing store is required, - set both to 0 */ -#endif /***/ - - /* Get includes */ - -#include <X11/Xlib.h> -#include <X11/Xutil.h> -#include <X11/Xos.h> -#include <X11/keysym.h> -/**#include <X11/bitmaps/xlogo64> /***/ -#include "wpg_xlogo64_inc" /***/ -#include <X11/cursorfont.h> -#include <stdio.h> -#include <sys/time.h> -#include <signal.h> - -int wngccn_(); /* JPH 960622 */ -int pause(); - - /* Define some constants */ - -#define TRUE 1 -#define FALSE 0 -#define BELL 7 -#define COLORMULT 65534 -#define MAXCOLOR 145 -#define NCOLORS 16 -#define FontName "*-courier-medium-r-*--12-*" /***/ - - /* Useful macros */ - -#ifndef min -#define min(a,b) ((a)<(b)?(a):(b)) -#endif - -#ifndef max -#define max(a,b) ((a)>(b)?(a):(b)) -#endif - - /* Global variables */ - -static Display *display=NULL; -static Window window; -static GC gc,gcb; /***/ -static Pixmap pixmap; -static Cursor cursor; /***/ -static Pixmap icon_pixmap; /***/ - -static int exit_array[6]={0}; /***/ -static xwdriv_exit(); /***/ - -#if SIGNAL -static grxw03(); /* Expose event handler */ -#endif - - /* Begin xwdriv */ - -void xwdriv_ (ifunc, rbuf, nbuf, chr, lchr, len) -int *ifunc, *nbuf, *lchr; -int len; -float rbuf[]; -char *chr; - -/*PGPLOT driver for workstations running X Windows. - - Version 1.0 - 1989 Nov 06 - A. L. Fey - Initial try. - Version 1.1 - 1990 Feb 15 - A. L. Fey - Add 'line of pixels' - and 'area fill'. - Version 2.0 - 1990 Jun 07 - A. L. Fey - Merge functionality with S.C. - Allendorf's Fortran XEDRIVER.FOR. - Add code to implement a backing store. - Version 2.1 - 1990 Jun 28 - A. L. Fey - Fix-up display visual classification. - Version 2.2 - 1990 Jul 06 - A. L. Fey - Add additional code for alternate - implementation of a backing store. - This method 'forks' a process to run - in the background and thus requires - more overhead than the 'signal' method. - Version 2.3 - 1990 Oct 8 - Jim Trice (trice@asta.pa.uky.edu) - Fix opcode 1. - Version 2.4 - 1991 Mar 19 - Jim Morgan (morgan@astro.umd.edu) - Fix cursor problems; signals. - 1991 Apr 30 SNS/CIT Trivial modifications for sharable libraries - 1991 Oct 14 TJP/CIT Corrections to strings - 1992 Jan 23 TJP/CIT Remove prompt before closing - 1992 Jun 7 MJW Add a nicer cursor and handle thick lines using graphics - context. - 1992 Sep 25 JM Changed XPoints from fixed size array to dynamic. - Also added error checking for potential poly problems. - 1993 Apr 08 D. Meier: add PGPLOT_XW_WIDTH, PGPLOT_XW_CLICKLEFT. - 1993 May 28 JM Moved forward declaration of grxw03() to its - proper place outside of xwdriv_(). - - Supported device: This driver should work with all workstations - running the X Windows (Version 11) software under Unix. - - Device type code: /XWINDOW. - - Default device name: The PGPLOT device specification is of the - form host:server.screen, in which host refers to the machine - name; server, the server number on that machine; and screen, the - screen number on that server. For example, rira:0.0 instructs the - server you are running on to connect to server 0 on the host - called rira, and that the default screen on that server will be - screen 0. The default device name is the NULL string, which - implies that the driver will connect to the server listed in - the Unix environment DISPLAY variable. - - Default view surface dimensions: Depends on monitor. - - Resolution: Depends on monitor. - - Color capability: X describes color capabilities of a display with a - visual. This driver will work on systems with visual type of either - PseudoColor or StaticColor. For a PseudoColor visual the color map is - read/write and the colors will be those defined by PGPLOT. The number - of colors available to PGPLOT depends on the monitor and the number not - allocated by other clients. This driver will attempt to allocate as - many of these non-allocated colors as the X Windows server will - allow, up to a maximum of 145 colors. This maximum comes from the - maximum number of colors that PGPLOT will use internally and a desire - to avoid hogging the resources of the server. On a display with a - StaticColor visual the color map is read only. For this case, this - driver will use the closest hardware equivalents of the PGPLOT colors. - Again, the maximum number of colors available depends on the monitor - but is limited to 145, as before. Also, on a StaticColor display, the - 'line of pixels' option may produce unsatisfactory results since there - will only be a limited number of gray scale levels available in the - read only color map. This driver will also work on monochrome systems. - - Input capability: The cursor is controlled by the mouse. The user - positions the cursor, and then types any key on the controlling - keyboard or the mouse. The mouse buttons are defined to return the - following characters: - - Button Character - ------ --------- - 1 A - 2 D - >2 X - - Environment variables - - 1. PGPLOT_XW_WIDTH - - Specify the width of the PGPLOT Xwindow, with - 0 < width/display_width <= 1.0 using - - setenv PGPLOT_XW_WIDTH 0.5 - - etc., which sets the window size to 1/2 the screen instead of - the default 0.75. Values outside the 0-1.0 range default to 0.75. - - 2. PGPLOT_XW_CLICKLEFT - - Requests that the PGPLOT Xwindow be retained until the user - clicks the left-hand mouse button. The default is to NOT - wait for the user to click left. To enable this feature, type - - setenv PGPLOT_XW_CLICKLEFT 1 - - Any other value other than 1 causes the default (click - left not necessary) to obtain. - -*/ - -{ -/** extern char *xw_dev_name ; /***/ - char *xw_dev_name = "XWINDOW"; /***/ - - /* X structures */ - - static Colormap cmap; - static Font font; /***/ - static Visual *visual; - static Window parent; -/** static GC gcb; now static to whole file ***/ /***/ -/** static Pixmap icon_pixmap; now static to whole file ***/ /***/ -/** static Cursor cursor; now static to whole file ***/ /***/ - static XColor colorcell_defs[MAXCOLOR]; - static XColor c_black, c_red, c_yellow; - static XSizeHints size_hints; - static XEvent report; - static XGCValues values; - static XSetWindowAttributes setwinattr; - static XWMHints wmhints; - static XImage *xi; - static XPoint *points; - static KeySym keysym; - static XComposeStatus compose; - static XVisualInfo VisualInfo; - - /* Window variables */ - - static int cells; - static int screen; - static unsigned int width; - static unsigned int height; - static unsigned long value_mask; - static int depth; - static int x, y; - static unsigned int border_width = 4; - static unsigned int display_width, display_height; - static unsigned int display_widthMM, display_heightMM; - static unsigned int line_width=1; - static int cap_style = CapRound; - static int join_style = JoinRound; - static int fill_rule = WindingRule; - static int cursor_shape = XC_spider; - char *getenv(); - static char *user_width_str; - static char *wait_until_clickleft_str; - static float user_width; - static int wait_until_clickleft; -/** extern char *xw_window_name ; /***/ - char *xw_window_name = "NEWSTAR Plot Window"; /***/ -/** extern char *xw_icon_name ; /***/ - char *xw_icon_name = "NPLOT"; - static int cursor_cross = 34; /* XC_crosshair */ - - /* PGPLOT color table (RGB) */ - - static float ctable[NCOLORS][3] = - { {0.0,0.0,0.0}, {1.0,1.0,1.0}, {1.0,0.0,0.0}, {0.0,1.0,0.0}, - {0.0,0.0,1.0}, {0.0,1.0,1.0}, {1.0,0.0,1.0}, {1.0,1.0,0.0}, - {1.0,0.5,0.0}, {0.5,1.0,0.0}, {0.0,1.0,0.5}, {0.0,0.5,1.0}, - {0.5,0.0,1.0}, {1.0,0.0,0.5}, - {0.333,0.333,0.333}, - {0.667,0.667,0.667} }; - - /* Various variables */ - - static unsigned long plane_masks[MAXCOLOR]; - static unsigned long pixels[MAXCOLOR]; - static unsigned long black, white, color; - static char buffer[10]; - static unsigned char image[1][1280]; - static float resol[2]; - static int maxcol; - static int icount, npoints = 0; - static int ignorePoly; - static int imin, imax, jmin, jmax; - static int xmin, xmax, ymin, ymax; - static int i0, i1, j0, j1, ic; - static float factor; - static int mono, Static; - static int i; - - static int non_empty=0; /***/ -#if FORK - static int running = FALSE, pid; -#endif - -#if SIGNAL - /* Timer for Expose event handler */ - - static int running = FALSE; - static struct itimerval ovalue, tvalue = { - {0, 100000}, /* 0.1 second interval */ - {0, 100000} /* 0.1 second value */ - }; -#endif - -/* Turn OFF Expose event handler before we do anything */ - -#if SIGNAL - signal (SIGALRM, SIG_IGN); -#endif - -#if FORK - if (running) - kill (pid, SIGSTOP); -#endif - -/* Branch on opcode. */ - - switch (*ifunc) { - -/*--- IFUNC=1, Return device name ---------------------------------------*/ - - case 1 : - strncpy( chr, xw_dev_name, len ) ; /* 14Oct91*/ - *lchr = strlen( xw_dev_name ) ; - for ( i = *lchr ; i < len ; i++ ) - chr[i] = ' '; - break; - -/*--- IFUNC=2, Return physical min and max for plot device, and range - of color indices -----------------------------------------*/ - - case 2 : - - rbuf[0] = 0.0; - rbuf[1] = (float) (imax - imin); - rbuf[2] = 0.0; - rbuf[3] = (float) (jmax - jmin); - rbuf[4] = 0.0; - rbuf[5] = (float) maxcol; - *nbuf = 6; - - break; - -/*--- IFUNC=3, Return device resolution ---------------------------------*/ - - case 3 : - - rbuf[0] = resol[0]; - rbuf[1] = resol[1]; - rbuf[2] = 1.0; /* Device coordinates per pixel */ - *nbuf = 3; - - break; - -/*--- IFUNC=4, Return misc device info ----------------------------------*/ - - case 4 : - - chr[0] = 'I'; /* interactive device */ - chr[1] = 'C'; /* cursor is available */ - chr[2] = 'N'; /* no dashed lines */ - chr[3] = 'A'; /* area fill available */ - chr[4] = 'T'; /* thick lines */ - chr[5] = 'R'; /* rectangle fill available */ - chr[6] = 'P'; /* line of pixels available */ - chr[7] = 'V'; /* image lost on exit */ - chr[8] = 'N'; /* not used */ - chr[9] = 'N'; /* not used */ - *lchr = 10; - - break; - -/*--- IFUNC=5, Return default file name ---------------------------------*/ - - case 5 : - - strcpy (chr, ""); /* Default name is NULL */ - *lchr = 0; - - break; - -/*--- IFUNC=6, Return default physical size of plot ---------------------*/ - - case 6 : - - rbuf[0] = 0.0; - rbuf[1] = (float) (imax - imin); - rbuf[2] = 0.0; - rbuf[3] = (float) (jmax - jmin); - *nbuf = 4; - - break; - -/*--- IFUNC=7, Return misc defaults -------------------------------------*/ - - case 7 : - - rbuf[0] = 1.0; - *nbuf = 1; - - break; - -/*--- IFUNC=8, Select plot ----------------------------------------------*/ - - case 8 : - - break; - -/*--- IFUNC=9, Open workstation -----------------------------------------*/ - - case 9 : - - /* Connect to X server if not already connected */ /***/ - - if (display==NULL) { - - for (i = *lchr; i < strlen (chr); i++) - chr[i] = '\0'; /* pad chr with nulls */ /* 14Oct91*/ - - if ((display = XOpenDisplay (chr)) == NULL) { - (void) fprintf (stderr, - "XWDRIV: cannot connect to X server [%s]\n", - XDisplayName (chr)); - rbuf[1] = 0.0; - break; - } - - /* Get screen size from display structure macro */ - - screen = DefaultScreen (display); - - /* Size and position window */ - - display_width = DisplayWidth (display, screen); - display_height = DisplayHeight (display, screen); - display_widthMM = DisplayWidthMM (display, screen); - display_heightMM = DisplayHeightMM (display, screen); - - resol[0] = 25.4 * ((float) display_width / - (float) display_widthMM); - resol[1] = 25.4 * ((float) display_height / - (float) display_heightMM); - - factor = 8.5 / 11.0; - width = 3 * display_width / 4; - - user_width_str = getenv("PGPLOT_XW_WIDTH"); - - if (user_width_str != 0) { - - sscanf(user_width_str,"%f",&user_width); - - if ( (user_width > 0.0) && (user_width <= 1.0) ) { - width = user_width * display_width; - - } else { - -/** (void) fprintf (stderr, - "%cIllegal PGPLOT_XW_WIDTH: using 0.75 of display", BELL); - /***/ - } - } - - height = factor * width; - - x=y=0; - -/** x = (display_width - width) / 2; - y = (display_height - height) / 2; CMV 940829 **/ - - imin = (int) (0.25 * resol[0] + 0.5); - jmin = (int) (0.25 * resol[1] + 0.5); - imax = width - imin - 1; - jmax = height - jmin - 1; - - /* Classify the display and create a color map */ - - black = BlackPixel (display, screen); - white = WhitePixel (display, screen); - - depth = DisplayPlanes (display, screen); - visual = DefaultVisual (display, screen); - parent = RootWindow (display, screen); - - if (depth == 1) { - /* Revert to monochrome */ - mono = TRUE; - } - else { - switch (visual->class) { - - case PseudoColor : - /* Get the default color map */ - cmap = DefaultColormap (display, screen); - value_mask = 0; - mono = FALSE; - Static = FALSE; - break; - case StaticColor : - /* Get the default color map */ - cmap = DefaultColormap (display, screen); - value_mask = 0; - mono = FALSE; - Static = TRUE; - break; - default : - /* Default visual is not one we can use; - try to find one of type PseudoColor */ - if (!XMatchVisualInfo (display, screen, depth, - PseudoColor, &VisualInfo)) { - /* Revert to monochrome */ - mono = TRUE; - } - else { - /* Found visual of type PseudoColor */ - visual = VisualInfo.visual; - /* Create a color map */ - cmap = XCreateColormap (display, parent, visual, - AllocNone); - setwinattr.colormap = cmap; - value_mask = CWColormap; - mono = FALSE; - Static = FALSE; - } - break; - } - } - - /* Create a window */ - - if (!mono) - window = XCreateWindow (display, parent, - x, y, width, height, border_width, depth, - InputOutput, visual, value_mask, &setwinattr); - else - window = XCreateSimpleWindow (display, parent, - x, y, width, height, border_width, - white, black); - - /* Set window manager hints to assure keyboard input */ - - wmhints.flags = InputHint; - wmhints.input = TRUE; - XSetWMHints (display, window, &wmhints); - - /* Set the maximum number of colors and allocate color cells - if the color map is read/write */ - - maxcol = 1; /* Default for monochrome device */ - - if (!mono) { - - /* Determine the maximum number of colors available */ - cells = DisplayCells (display, screen); - maxcol = min (cells, MAXCOLOR); - - /* Grab as many color cells as we need (or can) */ - if (!Static) { - while (!XAllocColorCells (display, cmap, True, - plane_masks, 0, pixels, (unsigned) maxcol) && - maxcol > 2) { - maxcol--; - } - } - - maxcol -= 1; - - /* Revert to monochrome if two or fewer colors were found */ - if (maxcol <= 1) { - mono = TRUE; - maxcol = 1; - } - - } - - /* Load the color table */ - - if (!mono) { - - /* Store PGPLOT color definitions */ - for (i = 0; i <= min (NCOLORS - 1, maxcol); i++) { - colorcell_defs[i].pixel = pixels[i]; - colorcell_defs[i].red = (int)(ctable[i][0]*COLORMULT+0.5); - colorcell_defs[i].green = (int)(ctable[i][1]*COLORMULT+0.5); - colorcell_defs[i].blue = (int)(ctable[i][2]*COLORMULT+0.5); - colorcell_defs[i].flags = DoRed | DoGreen | DoBlue; - colorcell_defs[i].pad = 0; - - if (!Static) { - XStoreColor (display, cmap, &colorcell_defs[i]); - } - else { - XAllocColor (display, cmap, &colorcell_defs[i]); - pixels[i] = colorcell_defs[i].pixel; - } - } - - /* Redefine black and white */ - black = pixels[0]; - white = pixels[1]; - - /* Get color structures for cursor colors */ - c_black.pixel = pixels[0]; - c_red.pixel = pixels[2]; - c_yellow.pixel = pixels[7]; - XQueryColor (display, cmap, &c_black); - XQueryColor (display, cmap, &c_red); - XQueryColor (display, cmap, &c_yellow); - - } - - /* Set the window colors */ - - XSetWindowBackground (display, window, black); - XSetWindowBorder (display, window, white); - - /* Create pixmap of depth 1 (bitmap) for icon */ - - icon_pixmap = XCreateBitmapFromData (display, window, - xlogo64_bits, xlogo64_width, xlogo64_height); - - /* Initialize size hint property for window manager */ - - size_hints.flags = PPosition | PSize | PMinSize | PMaxSize; - size_hints.x = x; - size_hints.y = y; - size_hints.width = width; - size_hints.height = height; - size_hints.min_width = width; - size_hints.min_height = height; - size_hints.max_width = width; - size_hints.max_height = height; - - /* Set properties for window manager (always before mapping) */ - - XSetStandardProperties (display, window, xw_window_name, - xw_icon_name, icon_pixmap, NULL, 0, &size_hints); - - /* Create a pixmap for double buffering */ - - pixmap = XCreatePixmap (display, window, width, height, depth); - - /* Create default graphics contexts and make a few adjustments */ - - values.line_width = line_width; - values.cap_style = cap_style; - values.join_style = join_style; - values.fill_rule = fill_rule; - gc = XCreateGC (display, pixmap, - (GCLineWidth|GCCapStyle|GCJoinStyle|GCFillRule), &values); - gcb = XCreateGC (display, pixmap, - (GCLineWidth|GCCapStyle|GCJoinStyle|GCFillRule), &values); - - wngsxh_(exit_array,xwdriv_exit); /* Define exit handler */ /***/ - - /* Specify foreground colors in graphics contexts */ - - XSetForeground (display, gc, white); - XSetForeground (display, gcb, black); - font = XLoadFont(display, FontName); /***/ - XSetFont(display, gc, font); /***/ - XSetFont(display, gcb, font); /***/ - - /* Clear the pixmap - we do this for servers that do not - clear the pixmap when it is created */ - - XFillRectangle (display, pixmap, gcb, 0, 0, width, height); - - /* Select the event types wanted */ - - XSelectInput (display, window, StructureNotifyMask - | ExposureMask | KeyPressMask | ButtonPressMask - | EnterWindowMask | LeaveWindowMask); - - /* Define a cursor */ - - cursor = XCreateFontCursor (display, cursor_shape); - XDefineCursor (display, window, cursor); - if (!mono) - XRecolorCursor (display, cursor, &c_yellow, &c_black); - - - /* Display window */ - - XMapRaised (display, window); - - /* Wait for mapping notification */ - - XNextEvent (display, &report); - -#if SIGNAL - /* Setup timer for Expose event handler */ - - setitimer (0, &tvalue, &ovalue); - running = TRUE; -#endif - -#if FORK - /* Start Expose event handler */ - - if (!running) { - pid = fork (); - if (pid == 0) { - grxw04 (); - } - running = TRUE; - } -#endif - - /* Initialize the damaged region */ - - grxw02 (width, height, &xmin, &xmax, &ymin, &ymax); - - /* Successful-- return display */ - - rbuf[0] = 1.0; /* display; */ - rbuf[1] = 1.0; - *nbuf = 2; - - /* Determine user's method of exit */ - -/** wait_until_clickleft = 0; /***/ - wait_until_clickleft = 1; /***/ - - wait_until_clickleft_str = getenv("PGPLOT_XW_CLICKLEFT"); - - if (wait_until_clickleft_str != 0) { - - sscanf(wait_until_clickleft_str,"%d",&wait_until_clickleft); - - if ( wait_until_clickleft != 1) { - wait_until_clickleft = 0; - } - } - } else { /***/ - /** XMapRaised (display, window); - XNextEvent (display, &report); **/ /** CMV 940829 **/ - grxw02 (width, height, &xmin, &xmax, &ymin, &ymax); /***/ - rbuf[0] = 1.0; /* display; */ /***/ - rbuf[1] = 1.0; /***/ - *nbuf = 2; /***/ - } /* End of if (display==NULL) */ /***/ - - non_empty=0; /***/ - - break; - -/*--- IFUNC=10, Close workstation ---------------------------------------*/ - - case 10 : - -#if FORK - /* Kill Expose event handler before we do anything */ - - if (running) { - kill (pid, SIGKILL); - running = FALSE; - } -#endif -#if SIGNAL - running = FALSE; -#endif - - if (non_empty && wait_until_clickleft != 0) { - - XMapRaised (display, window); /**CMV 940829 **/ - XSetInputFocus (display, parent, /** window, JPH 960801 **/ - RevertToPointerRoot, CurrentTime); - fprintf(stderr, - "MB1 or A for Another plot, MB3 or X to eXit loop\n"); - -/* Discard any ButtonPress events encountered up till now */ - - while (XCheckTypedEvent (display, ButtonPress, &report)); - while (XCheckTypedEvent (display, KeyPress, &report)); - -/* Wait for control-C, meanwhile watching display events - JPH 960801 */ -/* This used to be - while (1) - XNextEvent (display,&report) - switch ... -There was a terminal message after XSetInputFocus above,and the focus was set to window i.s.o. parent; the ButtonPress and KeyPress code below was active -*/ -/* Remove Control-c stuff - while (! wngccn_() ){ - while (XCheckMaskEvent (display, (long)-1, &report) ){ - switch (report.type){ -*/ -/* Event loop */ - - while (1) { - XNextEvent (display, &report); - switch (report.type) { - case Expose : - XCopyArea (display, pixmap, window, gc, - report.xexpose.x, report.xexpose.y, - report.xexpose.width, report.xexpose.height, - report.xexpose.x, report.xexpose.y); - break; - case ButtonPress : - if (report.xbutton.button == Button1) - strcpy (chr, ">A"); - else if (report.xbutton.button == Button2) - strcpy (chr, ">D"); - else - strcpy (chr, ">X"); - *nbuf = 2; - *lchr = 1; - goto endclose; - case KeyPress : - XLookupString (&report, buffer, 10, &keysym, &compose); - if (keysym == XK_Return || - *buffer == 'A' || *buffer == 'a'){ - strcpy (chr, ">A"); - *nbuf = 2; - *lchr = 1; - goto endclose; - } else if ( - *buffer == 'D' || *buffer == 'd') { - strcpy (chr, ">D"); - *nbuf = 2; - *lchr = 1; - goto endclose; - } else if ( - *buffer == 'X' || *buffer == 'x') { - strcpy (chr, ">X"); - *nbuf = 2; - *lchr = 1; - goto endclose; - } - break; - case EnterNotify : - XSetInputFocus (display, window, - RevertToPointerRoot, CurrentTime); - break; - case LeaveNotify : - XSetInputFocus (display, PointerRoot, - RevertToPointerRoot, CurrentTime); - break; - default : - break; - } - } - sleep((unsigned)1); - } - -endclose : - XSetInputFocus (display, parent, - RevertToPointerRoot, CurrentTime); - - /* Free resources */ - -/*** In xwdriv_exit now - XUndefineCursor (display, window); - XFreeCursor (display, cursor); - XUnmapWindow (display, window); - XFreeGC (display, gc); - XFreeGC (display, gcb); - XDestroyWindow (display, window); - XFreePixmap (display, icon_pixmap); - XFreePixmap (display, pixmap); - XCloseDisplay (display); -***/ /***/ - - break; - -/*--- IFUNC=11, Begin picture -------------------------------------------*/ - - case 11 : - -#if SIGNAL - /* Non-standard window */ - - /* Translate input */ - i0 = (int) (rbuf[0] + 0.5) + 2 * imin + 1; - j0 = (int) (rbuf[1] + 0.5) + 2 * jmin + 1; - - /* See if it is different than what we already have */ - if (i0 != width || j0 != height) { - width = i0; - height = j0; - imax = width - imin - 1; - jmax = height - jmin - 1; - x = (display_width - width) / 2; - y = (display_height - height) / 2; - - /* Destroy old pixmap and create a new one */ - XFreePixmap (display, pixmap); - pixmap = XCreatePixmap (display, window, width, - height, depth); - - /* Reset size hint property for window manager */ - size_hints.flags = PPosition | PSize | PMinSize | PMaxSize; - size_hints.x = x; - size_hints.y = y; - size_hints.width = width; - size_hints.height = height; - size_hints.min_width = width; - size_hints.min_height = height; - size_hints.max_width = width; - size_hints.max_height = height; - - /* Set properties for window manager */ - XSetStandardProperties (display, window, xw_window_name, - xw_icon_name, icon_pixmap, NULL, 0, &size_hints); - - /* Resize the window */ - XResizeWindow (display, window, width, height); - - } -#endif - - /* Clear the pixmap */ - - XFillRectangle (display, pixmap, gcb, 0, 0, width, height); - - /* Clear the window */ - - XClearWindow (display, window); - - /* Reset the damaged region */ - - grxw02 (width, height, &xmin, &xmax, &ymin, &ymax); - - non_empty=0; /***/ - - break; - -/*--- IFUNC=12, Draw line -----------------------------------------------*/ - - case 12 : - - /* Translate input */ - - i0 = (int) (rbuf[0] + 0.5) + imin; - j0 = (jmax - jmin) - (int) (rbuf[1] + 0.5) + jmin; - i1 = (int) (rbuf[2] + 0.5) + imin; - j1 = (jmax - jmin) - (int) (rbuf[3] + 0.5) + jmin; - - /* Draw the line */ - - XDrawLine (display, pixmap, gc, i0, j0, i1, j1); - - /* Update the damaged region */ - - grxw01 (1, i0, j0, i1, j1, &xmin, &xmax, &ymin, &ymax); - - non_empty=1; /***/ - break; - -/*--- IFUNC=13, Draw dot ------------------------------------------------*/ - - case 13 : - - /* Translate input */ - - i0 = (int) (rbuf[0] + 0.5) + imin; - j0 = (jmax - jmin) - (int) (rbuf[1] + 0.5) + jmin; - - /* Draw the point */ - - XDrawPoint (display, pixmap, gc, i0, j0); - - /* Update the damaged region */ - - grxw01 (0, i0, j0, i0, j0, &xmin, &xmax, &ymin, &ymax); - - non_empty=1; /***/ - break; - -/*--- IFUNC=14, End picture ---------------------------------------------*/ - - case 14 : - - break; - -/*--- IFUNC=15, Select color index --------------------------------------*/ - - case 15 : - - /* Translate input */ - - ic = (int) (rbuf[0] + 0.5); - - /* Check input for proper range */ - - if (ic < 0 || ic > maxcol) { - ic = 1; - rbuf[0] = (float) ic; - } - - /* Change the color index - handle monochrome properly */ - - if (!mono) { - color = pixels[ic]; - XSetForeground (display, gc, color); - } - else if (ic == 1) - XSetForeground (display, gc, white); - else - XSetForeground (display, gc, black); - - break; - -/*--- IFUNC=16, Flush buffer. -------------------------------------------*/ - - case 16 : - - /* Copy pixmap to window and flush display */ - - if (xmax != -1) - XCopyArea (display, pixmap, window, gc, xmin, ymin, - xmax - xmin + 1, ymax - ymin + 1, xmin, ymin); - XFlush (display); - - /* Reset the damaged region */ - - grxw02 (width, height, &xmin, &xmax, &ymin, &ymax); - - break; - -/*--- IFUNC=17, Read cursor. --------------------------------------------*/ - - case 17 : - - /* Create graphics cursor */ - - cursor = XCreateFontCursor (display, cursor_cross); - XDefineCursor (display, window, cursor); - if (!mono) - XRecolorCursor (display, cursor, &c_red, &c_black); - - /* Translate input */ - - i0 = (int) (rbuf[0] + 0.5) + imin; - j0 = (jmax - jmin) - (int) (rbuf[1] + 0.5) + jmin; - - /* Move cursor */ - - XWarpPointer (display, None, window, 0, 0, - 0, 0, i0, j0); - - /* Discard any ButtonPress or KeyPress events encountered - up till now */ - - while (XCheckTypedEvent (display, ButtonPress, &report)) - ; - while (XCheckTypedEvent (display, KeyPress, &report)) - ; - - /* Event loop */ - - while (1) { - - XNextEvent (display, &report); - - /* Hint to enable keyboard input */ - XSetWMHints (display, window, &wmhints); - - switch (report.type) { - - case Expose : - XCopyArea (display, pixmap, window, gc, - report.xexpose.x, report.xexpose.y, - report.xexpose.width, report.xexpose.height, - report.xexpose.x, report.xexpose.y); - break; - case ButtonPress : - rbuf[0] = (float) (report.xbutton.x - imin); - rbuf[1] = (float) ((jmax - jmin) - - report.xbutton.y + jmin); - if (report.xbutton.button == Button1) - strcpy (chr, "A"); - else if (report.xbutton.button == Button2) - strcpy (chr, "D"); - else - strcpy (chr, "X"); - *nbuf = 2; - *lchr = 1; - goto endcursor; - case KeyPress : - rbuf[0] = (float) (report.xbutton.x - imin); - rbuf[1] = (float) ((jmax - jmin) - - report.xbutton.y + jmin); - XLookupString (&report, buffer, 10, &keysym, &compose); - if ((keysym >= XK_Shift_L) && (keysym <= XK_Hyper_R)) - break; /* do nothing because its a modifier key. */ - strcpy (chr, buffer); - *nbuf = 2; - *lchr = 1; - goto endcursor; - case EnterNotify : - XSetInputFocus (display, window, - RevertToPointerRoot, CurrentTime); - break; - case LeaveNotify : - XSetInputFocus (display, PointerRoot, - RevertToPointerRoot, CurrentTime); - break; - default : - break; - } - } - - endcursor : - - /* Return cursor to original state */ - - cursor = XCreateFontCursor (display, cursor_shape); - XDefineCursor (display, window, cursor); - if (!mono) - XRecolorCursor (display, cursor, &c_yellow, &c_black); - - break; - -/*--- IFUNC=18, Erase alpha screen. -------------------------------------*/ - /* (Not implemented: no alpha screen) */ - - case 18 : - - break; - -/*--- IFUNC=19, Set line style. -----------------------------------------*/ - /* (Not implemented: should not be called) */ - - case 19 : - - break; - -/*--- IFUNC=20, Polygon fill. -------------------------------------------*/ - - case 20 : - - /* Use icount as indication of first time or not */ - - if (npoints == 0) { - /* Translate input */ - npoints = (int) (rbuf[0] + 0.5); - icount = 0; - ignorePoly = FALSE; - points = (XPoint *)malloc((unsigned)2*npoints*sizeof(XPoint)); - if (points == (XPoint *)NULL) { -/** printf("No memory for polygon points!\n"); /***/ - *nbuf = -1; - ignorePoly = TRUE; - } - } - else { - - /* Second or other time; draw to next vertex; decrement icount */ - - /* If in ignore mode, increment counter and break. */ - if (ignorePoly == TRUE) { - if ((++icount) == npoints) npoints = 0; - break; - } - else { - /* Translate input */ - i0 = (int) (rbuf[0] + 0.5) + imin; - j0 = (jmax - jmin) - (int) (rbuf[1] + 0.5) + jmin; - - /* Load vertex into array */ - points[icount].x = i0; - points[icount].y = j0; - - /* Increment counter. */ - icount++; - - /* Update the damaged region */ - - grxw01 (0, i0, j0, i0, j0, &xmin, &xmax, &ymin, &ymax); - - /* Last call; give the polygon fill command */ - - if (icount == npoints) { - XFillPolygon (display, pixmap, gc, points, npoints, - Complex, CoordModeOrigin); - free(points); - npoints = 0; - } - } - } - - non_empty=1; /***/ - break; - -/*--- IFUNC=21, Set color representation. -------------------------------*/ - - case 21 : - - /* This is ignored for a monochrome device */ - - if (!mono) { - - /* Translate input */ - ic = (int) (rbuf[0] + 0.5); - - /* Load the color structure */ - if (ic >= 0 && ic <= maxcol) { - colorcell_defs[ic].pixel = pixels[ic]; - colorcell_defs[ic].red = (int)(rbuf[1]*COLORMULT+0.5); - colorcell_defs[ic].green = (int)(rbuf[2]*COLORMULT+0.5); - colorcell_defs[ic].blue = (int)(rbuf[3]*COLORMULT+0.5); - colorcell_defs[ic].flags = DoRed | DoGreen | DoBlue; - colorcell_defs[ic].pad = 0; - - if (!Static) { - XStoreColor (display, cmap, &colorcell_defs[ic]); - } - else { - XAllocColor (display, cmap, &colorcell_defs[ic]); - pixels[ic] = colorcell_defs[ic].pixel; - } - } - } - - break; - -/*--- IFUNC=22, Set line width. -----------------------------------------*/ - - case 22 : - /* line width set to rbuf[0] inches in units of 0.005 inches */ - line_width = (int) (rbuf[0]*0.005*resol[0]+0.5) ; - /* a line width of zero should use fast algorithm */ - XSetLineAttributes(display,gc,line_width,values.line_style, - cap_style,join_style) ; - break; - -/*--- IFUNC=23, Escape --------------------------------------------------*/ - /* (Not implemented: ignored) */ - - case 23 : - - break; - -/*--- IFUNC=24, Rectangle Fill. -----------------------------------------*/ - - case 24 : - - /* Translate input */ - - i0 = (int) (rbuf[0] + 0.5) + imin; - j0 = (jmax - jmin) - (int) (rbuf[3] + 0.5) + jmin; - i1 = (int) (rbuf[2] - rbuf[0] + 1.5); - j1 = (int) (rbuf[3] - rbuf[1] + 1.5); - - /* Draw the rectangle */ - - XFillRectangle (display, pixmap, gc, i0, j0, - (unsigned) i1, (unsigned) j1); - - /* Update the damaged region */ - - grxw01 (1, i0, j0, i0 + i1 - 1, j0 + j1 - 1, - &xmin, &xmax, &ymin, &ymax); - - break; - -/*--- IFUNC=25, ---------------------------------------------------------*/ - /* (Not implemented: ignored) */ - - case 25 : - - break; - -/*--- IFUNC=26, Line of pixels ------------------------------------------*/ - - case 26 : - - /* Translate input */ - - i0 = (int) (rbuf[0] + 0.5) + imin; - j0 = (jmax - jmin) - (int) (rbuf[1] + 0.5) + jmin; - - /* Load the image array */ - - for (i = 0; i <= *nbuf - 3; i++) - image[0][i] = pixels[(int) (rbuf[i + 2] + 0.5)]; - - /* Create the image */ - - xi = XCreateImage (display, visual, depth, ZPixmap, 0, - image, *nbuf - 2, 1, 8, 0); - - /* Draw the image */ - - XPutImage (display, pixmap, gc, xi, 0, 0, i0, j0, - *nbuf - 2, 1); - - /* Update the damaged region */ - - grxw01 (1, i0, j0, i0 + *nbuf - 3, j0, - &xmin, &xmax, &ymin, &ymax); - - non_empty=1; /***/ - break; - -/*--- IFUNC=30, Message text ----------------------------------------- /***/ - - case 30 : - - XDrawString (display, pixmap, gc, imin + 1, jmin + 6, - chr, *lchr); - grxw01 (1, imin + 1, jmin, imax, 6, - &xmin, &xmax, &ymin, &ymax); - - non_empty=1; /***/ - break; - -/*--- IFUNC=?, ----------------------------------------------------------*/ - - default : - - /* Notify the user of an input error */ - - (void) fprintf (stderr, - "Unimplemented function in X Windows device driver: %d\n", - *ifunc); - *nbuf = -1; - - break; - - } /* End of switch */ - -/* Turn ON Expose event handler, then return to calling program */ - -#if SIGNAL - if (running) - signal (SIGALRM, grxw03); -#endif - -#if FORK - if (running) - kill (pid, SIGCONT); -#endif - - return; - -} /* End of xwdriv */ - -/*GRXW01 -- PGPLOT XWindow driver, calculate 'damaged' region. - From S.C. Allendorf's XEDRIVER.FOR */ - -grxw01 (line, i0, j0, i1, j1, xmin, xmax, ymin, ymax) -int line, i0, j0, i1, j1; -int *xmin, *xmax, *ymin, *ymax; -{ - /* Update the damaged region. */ - if (i0 > *xmax) - *xmax = i0; - if (i0 < *xmin) - *xmin = i0; - if (j0 > *ymax) - *ymax = j0; - if (j0 < *ymin) - *ymin = j0; - /* See if we were passed a - rectangle and update the - damaged region accordingly. */ - if (line == 1) { - if (i1 > *xmax) - *xmax = i1; - if (i1 < *xmin) - *xmin = i1; - if (j1 > *ymax) - *ymax = j1; - if (j1 < *ymin) - *ymin = j1; - } -} - -/*GRXW02 -- PGPLOT XWindow driver, reset 'damaged' region. - From S.C. Allendorf's XEDRIVER.FOR */ - -grxw02 (width, height, xmin, xmax, ymin, ymax) -unsigned int width, height; -int *xmin, *xmax, *ymin, *ymax; -{ - /* Reset the boundaries of the - damaged region. */ - *xmax = -1; - *ymax = -1; - *xmin = width + 1; - *ymin = height + 1; -} - -#if SIGNAL -/*GRXW03 -- PGPLOT XWindow driver, Expose event handler (redrawing routine). - From S.C. Allendorf's XEDRIVER.FOR */ - -static grxw03 (sig, code, scp) -int sig, code; -struct sigcontext *scp; -{ - XEvent event; - int event_mask; - - /* Select events. */ - - event_mask = ExposureMask | EnterWindowMask | LeaveWindowMask; - - while (XCheckWindowEvent (display, window, event_mask, &event)) { - - /* If part of the window has been - exposed, redraw that part. We - ignore NoExpose events and - GraphicsExpose events. */ - - switch (event.type) { - - case Expose : - XCopyArea (display, pixmap, window, gc, - event.xexpose.x, event.xexpose.y, - event.xexpose.width, event.xexpose.height, - event.xexpose.x, event.xexpose.y); - break; - case EnterNotify : - XSetInputFocus (display, window, - RevertToPointerRoot, CurrentTime); - break; - case LeaveNotify : - XSetInputFocus (display, PointerRoot, - RevertToPointerRoot, CurrentTime); - break; - default : - break; - } - } -} -#endif - -#if FORK -/*GRXW04 -- PGPLOT XWindow driver, Expose event handler (redrawing routine). - From S.C. Allendorf's XEDRIVER.FOR */ - -grxw04 () -{ - XEvent event; - - while (1) { - - /* If part of the window has been - exposed, redraw that part. We - ignore NoExpose events and - GraphicsExpose events. */ - - - XNextEvent (display, &event); - switch (event.type) { - - case Expose : - XCopyArea (display, pixmap, window, gc, - event.xexpose.x, event.xexpose.y, - event.xexpose.width, event.xexpose.height, - event.xexpose.x, event.xexpose.y); - break; - case EnterNotify : - XSetInputFocus (display, window, - RevertToPointerRoot, CurrentTime); - break; - case LeaveNotify : - XSetInputFocus (display, PointerRoot, - RevertToPointerRoot, CurrentTime); - break; - default : - break; - } - } -} -#endif - - -/*** Exit handler called to remove the window ***/ /***/ - - -static int xwdriv_exit() - -{ - /* Free resources */ - - XUndefineCursor (display, window); - XFreeCursor (display, cursor); - XUnmapWindow (display, window); - XFreeGC (display, gc); - XFreeGC (display, gcb); - XDestroyWindow (display, window); - XFreePixmap (display, icon_pixmap); - XFreePixmap (display, pixmap); - XCloseDisplay (display); -} diff --git a/src/wng/wq_el0.dsc b/src/wng/wq_el0.dsc deleted file mode 100644 index 6aefc329ccda2ca0d124524c8fb32913c6e7b32d..0000000000000000000000000000000000000000 --- a/src/wng/wq_el0.dsc +++ /dev/null @@ -1,81 +0,0 @@ -!+ WQ_EL0.DSC -! HjV 950704 -! -! Revisions: -! -! -! Define EL0 landscape plotter. Layout should match WQD.DSC -! -! -! -%VERSION=1 !VERSION -%SYSTEM=1 -%USER=HjV -%%DATE -%%NAME -%REVISION=HjV=950704="Original version" -%COMMENT="WQ_EL0.DSC defines the EL0 plotter lay-out" -%COMMENT=" " -%LOCAL=NUSED=15 !Max. user data index -%LOCAL=NPLIX=3 !Max. polyline index -%LOCAL=NPMIX=4 !Max. polymarker index -%LOCAL=NTXIX=2 !Max. text index -%LOCAL=NFAIX=3 !Max. fill area index -%LOCAL=NCLIX=1 !Max. colour index -!- -.DEFINE -.PARAMETER -.DATA -.COMMON - EL0_QUE J /0/ !LINK OPEN DEVICES - EL0_LEN J !LENGTH OF AREA - EL0_BID C4 /DQID/ !ID OF AREA - EL0_ACT J /0/ !BIT0=1 ACTIVE - EL0_TYP J /1/ !BIT0=1 OUTPUT, 1 INPUT, 2 DISS, 3 META - EL0_DEFER J /0/ !DEFER TYPE - EL0_REGEN J /0/ !REGENERATION - EL0_NEWFR J /0/ !NEW FRAME - EL0_PEND J /0/ !PENDING - EL0_DEV C8 /EL0/ !DEVICE TYPE - EL0_FILE C80 /EL0.PLT/ !DEVICE FILE - EL0_XHI E /3167/ !HIGHEST X - EL0_YHI E /2339/ !HIGHEST Y - EL0_XM E /1.024/ !X SIZE METERS - EL0_YM E /0.872/ !Y SIZE METERS - EL0_MGL J /132/ !MAX. MESSAGE LENGTH - EL0_DVRT J !DEVICE ROUTINE ADDRESS - EL0_CHAN J /0/ !DEVICE CHANNEL - EL0_NTR E(0:3,0:2) /2339,0,2339,0,0,0,1,1,0,0,3167,2339/ !DEVICE TRANSFORM - EL0_NMPLS E /.5/ !NOMINAL LINE SIZE - EL0_MXPLS E /5/ !MAX. LINE SIZE - EL0_MNPLS E /0.2/ !MIN. LINE SIZE - EL0_NMPMS E /5/ !NOMINAL POLYMARKER SIZE - EL0_MXPMS E /0/ !MAX. POLYMARKER SIZE - EL0_MNPMS E /0/ !MIN. POLYMARKER SIZE - EL0_NPLT J /4/ !# OF LINE TYPES - EL0_NPMT J /5/ !# OF POLYMARKER TYPES - EL0_EFN J /0/ !EFN TO USE - EL0_BFL J /0/ !BUFFER LENGTH - EL0_BFA J /0/ !BUFFER ADDRESSES - EL0_USE J(0:NUSED) !USER DATA - EL0_NPLIX J /NPLIX/ !LENGTH POLYLINE TABLE - EL0_NPMIX J /NPMIX/ !LENGTH POLYMARKER TABLE - EL0_NTXIX J /NTXIX/ !LENGTH TEXT TABLE - EL0_NFAIX J /NFAIX/ !LENGTH FILL AREA TABLE - EL0_NCLIX J /NCLIX/ !LENGTH COLOUR TABLE - EL0_OPLI J !ADDRESS POLYLINE TABLE - EL0_OPMI J !ADDRESS POLYMARKER TABLE - EL0_OTXI J !ADDRESS TEXT TABLE - EL0_OFAI J !ADDRESS FILL AREA TABLE - EL0_OCLI J !ADDRESS COLOUR TABLE -! - EL0_SVP J !START VARIABLE PART - EL0_PLIXE E(0:2,0:NPLIX) /1,1,0,2,1,0,3,1,0,4,1,0/ !POLYLINE (4) - EL0_PMIXE E(0:2,0:NPMIX) /1,1,0,2,1,0,3,1,0,4,1,0,5,1,0/ !POLYMARKER (5) - EL0_TXIXE E(0:2,0:NTXIX) /1,2,0,1,3,0,1,4,0/ !TEXT (3) - EL0_FAIXE E(0:2,0:NFAIX) /3,1,0,4,1,0,5,1,0,6,1,0/ !FILL AREA (4) - EL0_CLIXE E(0:2,0:NCLIX) /1,0,0,1,1,0/ !COLOUR (2) -! - EL0_EOL J !END OF LIST -.END !END DEFINITION -!- diff --git a/src/wng/wq_el1.dsc b/src/wng/wq_el1.dsc deleted file mode 100644 index 099e1b4194750934161db1a472ae20b05cf092d9..0000000000000000000000000000000000000000 --- a/src/wng/wq_el1.dsc +++ /dev/null @@ -1,81 +0,0 @@ -!+ WQ_EL1.DSC -! HjV 950710 -! -! Revisions: -! -! -! Define EL1 landscape plotter. Layout should match WQD.DSC -! -! -! -%VERSION=1 !VERSION -%SYSTEM=1 -%USER=HjV -%%DATE -%%NAME -%REVISION=HjV=950710="Original version" -%COMMENT="WQ_EL1.DSC defines the EL1 plotter lay-out" -%COMMENT=" " -%LOCAL=NUSED=15 !Max. user data index -%LOCAL=NPLIX=3 !Max. polyline index -%LOCAL=NPMIX=4 !Max. polymarker index -%LOCAL=NTXIX=2 !Max. text index -%LOCAL=NFAIX=3 !Max. fill area index -%LOCAL=NCLIX=1 !Max. colour index -!- -.DEFINE -.PARAMETER -.DATA -.COMMON - EL1_QUE J /0/ !LINK OPEN DEVICES - EL1_LEN J !LENGTH OF AREA - EL1_BID C4 /DQID/ !ID OF AREA - EL1_ACT J /0/ !BIT0=1 ACTIVE - EL1_TYP J /1/ !BIT0=1 OUTPUT, 1 INPUT, 2 DISS, 3 META - EL1_DEFER J /0/ !DEFER TYPE - EL1_REGEN J /0/ !REGENERATION - EL1_NEWFR J /0/ !NEW FRAME - EL1_PEND J /0/ !PENDING - EL1_DEV C8 /EL1/ !DEVICE TYPE - EL1_FILE C80 /EL1.PLT/ !DEVICE FILE - EL1_XHI E /3167/ !HIGHEST X - EL1_YHI E /2339/ !HIGHEST Y - EL1_XM E /0.724/ !X SIZE METERS - EL1_YM E /0.616/ !Y SIZE METERS - EL1_MGL J /132/ !MAX. MESSAGE LENGTH - EL1_DVRT J !DEVICE ROUTINE ADDRESS - EL1_CHAN J /0/ !DEVICE CHANNEL - EL1_NTR E(0:3,0:2) /2339,0,2339,0,0,0,1,1,0,0,3167,2339/ !DEVICE TRANSFORM - EL1_NMPLS E /.8/ !NOMINAL LINE SIZE - EL1_MXPLS E /8/ !MAX. LINE SIZE - EL1_MNPLS E /0.3/ !MIN. LINE SIZE - EL1_NMPMS E /7/ !NOMINAL POLYMARKER SIZE - EL1_MXPMS E /0/ !MAX. POLYMARKER SIZE - EL1_MNPMS E /0/ !MIN. POLYMARKER SIZE - EL1_NPLT J /4/ !# OF LINE TYPES - EL1_NPMT J /5/ !# OF POLYMARKER TYPES - EL1_EFN J /0/ !EFN TO USE - EL1_BFL J /0/ !BUFFER LENGTH - EL1_BFA J /0/ !BUFFER ADDRESSES - EL1_USE J(0:NUSED) !USER DATA - EL1_NPLIX J /NPLIX/ !LENGTH POLYLINE TABLE - EL1_NPMIX J /NPMIX/ !LENGTH POLYMARKER TABLE - EL1_NTXIX J /NTXIX/ !LENGTH TEXT TABLE - EL1_NFAIX J /NFAIX/ !LENGTH FILL AREA TABLE - EL1_NCLIX J /NCLIX/ !LENGTH COLOUR TABLE - EL1_OPLI J !ADDRESS POLYLINE TABLE - EL1_OPMI J !ADDRESS POLYMARKER TABLE - EL1_OTXI J !ADDRESS TEXT TABLE - EL1_OFAI J !ADDRESS FILL AREA TABLE - EL1_OCLI J !ADDRESS COLOUR TABLE -! - EL1_SVP J !START VARIABLE PART - EL1_PLIXE E(0:2,0:NPLIX) /1,1,0,2,1,0,3,1,0,4,1,0/ !POLYLINE (4) - EL1_PMIXE E(0:2,0:NPMIX) /1,1,0,2,1,0,3,1,0,4,1,0,5,1,0/ !POLYMARKER (5) - EL1_TXIXE E(0:2,0:NTXIX) /1,2,0,1,3,0,1,4,0/ !TEXT (3) - EL1_FAIXE E(0:2,0:NFAIX) /3,1,0,4,1,0,5,1,0,6,1,0/ !FILL AREA (4) - EL1_CLIXE E(0:2,0:NCLIX) /1,0,0,1,1,0/ !COLOUR (2) -! - EL1_EOL J !END OF LIST -.END !END DEFINITION -!- diff --git a/src/wng/wq_el2.dsc b/src/wng/wq_el2.dsc deleted file mode 100644 index fcd694217241f433468cb1e57e81f37bb5928584..0000000000000000000000000000000000000000 --- a/src/wng/wq_el2.dsc +++ /dev/null @@ -1,81 +0,0 @@ -!+ WQ_EL2.DSC -! HjV 950710 -! -! Revisions: -! -! -! Define EL2 landscape plotter. Layout should match WQD.DSC -! -! -! -%VERSION=1 !VERSION -%SYSTEM=1 -%USER=HjV -%%DATE -%%NAME -%REVISION=HjV=950710="Original version" -%COMMENT="WQ_EL2.DSC defines the EL2 plotter lay-out" -%COMMENT=" " -%LOCAL=NUSED=15 !Max. user data index -%LOCAL=NPLIX=3 !Max. polyline index -%LOCAL=NPMIX=4 !Max. polymarker index -%LOCAL=NTXIX=2 !Max. text index -%LOCAL=NFAIX=3 !Max. fill area index -%LOCAL=NCLIX=1 !Max. colour index -!- -.DEFINE -.PARAMETER -.DATA -.COMMON - EL2_QUE J /0/ !LINK OPEN DEVICES - EL2_LEN J !LENGTH OF AREA - EL2_BID C4 /DQID/ !ID OF AREA - EL2_ACT J /0/ !BIT0=1 ACTIVE - EL2_TYP J /1/ !BIT0=1 OUTPUT, 1 INPUT, 2 DISS, 3 META - EL2_DEFER J /0/ !DEFER TYPE - EL2_REGEN J /0/ !REGENERATION - EL2_NEWFR J /0/ !NEW FRAME - EL2_PEND J /0/ !PENDING - EL2_DEV C8 /EL2/ !DEVICE TYPE - EL2_FILE C80 /EL2.PLT/ !DEVICE FILE - EL2_XHI E /3167/ !HIGHEST X - EL2_YHI E /2339/ !HIGHEST Y - EL2_XM E /0.512/ !X SIZE METERS - EL2_YM E /0.436/ !Y SIZE METERS - EL2_MGL J /132/ !MAX. MESSAGE LENGTH - EL2_DVRT J !DEVICE ROUTINE ADDRESS - EL2_CHAN J /0/ !DEVICE CHANNEL - EL2_NTR E(0:3,0:2) /2339,0,2339,0,0,0,1,1,0,0,3167,2339/ !DEVICE TRANSFORM - EL2_NMPLS E /1.2/ !NOMINAL LINE SIZE - EL2_MXPLS E /12/ !MAX. LINE SIZE - EL2_MNPLS E /0.4/ !MIN. LINE SIZE - EL2_NMPMS E /8/ !NOMINAL POLYMARKER SIZE - EL2_MXPMS E /0/ !MAX. POLYMARKER SIZE - EL2_MNPMS E /0/ !MIN. POLYMARKER SIZE - EL2_NPLT J /4/ !# OF LINE TYPES - EL2_NPMT J /5/ !# OF POLYMARKER TYPES - EL2_EFN J /0/ !EFN TO USE - EL2_BFL J /0/ !BUFFER LENGTH - EL2_BFA J /0/ !BUFFER ADDRESSES - EL2_USE J(0:NUSED) !USER DATA - EL2_NPLIX J /NPLIX/ !LENGTH POLYLINE TABLE - EL2_NPMIX J /NPMIX/ !LENGTH POLYMARKER TABLE - EL2_NTXIX J /NTXIX/ !LENGTH TEXT TABLE - EL2_NFAIX J /NFAIX/ !LENGTH FILL AREA TABLE - EL2_NCLIX J /NCLIX/ !LENGTH COLOUR TABLE - EL2_OPLI J !ADDRESS POLYLINE TABLE - EL2_OPMI J !ADDRESS POLYMARKER TABLE - EL2_OTXI J !ADDRESS TEXT TABLE - EL2_OFAI J !ADDRESS FILL AREA TABLE - EL2_OCLI J !ADDRESS COLOUR TABLE -! - EL2_SVP J !START VARIABLE PART - EL2_PLIXE E(0:2,0:NPLIX) /1,1,0,2,1,0,3,1,0,4,1,0/ !POLYLINE (4) - EL2_PMIXE E(0:2,0:NPMIX) /1,1,0,2,1,0,3,1,0,4,1,0,5,1,0/ !POLYMARKER (5) - EL2_TXIXE E(0:2,0:NTXIX) /1,2,0,1,3,0,1,4,0/ !TEXT (3) - EL2_FAIXE E(0:2,0:NFAIX) /3,1,0,4,1,0,5,1,0,6,1,0/ !FILL AREA (4) - EL2_CLIXE E(0:2,0:NCLIX) /1,0,0,1,1,0/ !COLOUR (2) -! - EL2_EOL J !END OF LIST -.END !END DEFINITION -!- diff --git a/src/wng/wq_el3.dsc b/src/wng/wq_el3.dsc deleted file mode 100644 index b27abfddcaf1659cc4e5538de502833d1da98d1c..0000000000000000000000000000000000000000 --- a/src/wng/wq_el3.dsc +++ /dev/null @@ -1,85 +0,0 @@ -!+ WQ_EL3.DSC -! WNB 921021 -! -! Revisions: -! WNB 921029 Change line sizes etc -! HJV 921029 Change XY size in meters to A4-size * sqrt(2) -! HjV 950704 Change filename from WQ_EAL into WQ_EL3 -! -! -! Define EL3 landscape plotter. Layout should match WQD.DSC -! -! -! -%VERSION=1 !VERSION -%SYSTEM=1 -%USER=WNB -%%DATE -%%NAME -%REVISION=HjV=950704="Change filename from WQ_EAL into WQ_EL3" -%REVISION=WNB=921021="Original version" -%COMMENT="WQ_EL3.DSC defines the EL3 plotter lay-out" -%COMMENT=" " -%LOCAL=NUSED=15 !Max. user data index -%LOCAL=NPLIX=3 !Max. polyline index -%LOCAL=NPMIX=4 !Max. polymarker index -%LOCAL=NTXIX=2 !Max. text index -%LOCAL=NFAIX=3 !Max. fill area index -%LOCAL=NCLIX=1 !Max. colour index -!- -.DEFINE -.PARAMETER -.DATA -.COMMON - EL3_QUE J /0/ !LINK OPEN DEVICES - EL3_LEN J !LENGTH OF AREA - EL3_BID C4 /DQID/ !ID OF AREA - EL3_ACT J /0/ !BIT0=1 ACTIVE - EL3_TYP J /1/ !BIT0=1 OUTPUT, 1 INPUT, 2 DISS, 3 META - EL3_DEFER J /0/ !DEFER TYPE - EL3_REGEN J /0/ !REGENERATION - EL3_NEWFR J /0/ !NEW FRAME - EL3_PEND J /0/ !PENDING - EL3_DEV C8 /EL3/ !DEVICE TYPE - EL3_FILE C80 /EL3.PLT/ !DEVICE FILE - EL3_XHI E /3167/ !HIGHEST X - EL3_YHI E /2339/ !HIGHEST Y - EL3_XM E /0.362/ !X SIZE METERS - EL3_YM E /0.308/ !Y SIZE METERS - EL3_MGL J /132/ !MAX. MESSAGE LENGTH - EL3_DVRT J !DEVICE ROUTINE ADDRESS - EL3_CHAN J /0/ !DEVICE CHANNEL - EL3_NTR E(0:3,0:2) /2339,0,2339,0,0,0,1,1,0,0,3167,2339/ !DEVICE TRANSFORM - EL3_NMPLS E /1.5/ !NOMINAL LINE SIZE - EL3_MXPLS E /15/ !MAX. LINE SIZE - EL3_MNPLS E /0.5/ !MIN. LINE SIZE - EL3_NMPMS E /10/ !NOMINAL POLYMARKER SIZE - EL3_MXPMS E /0/ !MAX. POLYMARKER SIZE - EL3_MNPMS E /0/ !MIN. POLYMARKER SIZE - EL3_NPLT J /4/ !# OF LINE TYPES - EL3_NPMT J /5/ !# OF POLYMARKER TYPES - EL3_EFN J /0/ !EFN TO USE - EL3_BFL J /0/ !BUFFER LENGTH - EL3_BFA J /0/ !BUFFER ADDRESSES - EL3_USE J(0:NUSED) !USER DATA - EL3_NPLIX J /NPLIX/ !LENGTH POLYLINE TABLE - EL3_NPMIX J /NPMIX/ !LENGTH POLYMARKER TABLE - EL3_NTXIX J /NTXIX/ !LENGTH TEXT TABLE - EL3_NFAIX J /NFAIX/ !LENGTH FILL AREA TABLE - EL3_NCLIX J /NCLIX/ !LENGTH COLOUR TABLE - EL3_OPLI J !ADDRESS POLYLINE TABLE - EL3_OPMI J !ADDRESS POLYMARKER TABLE - EL3_OTXI J !ADDRESS TEXT TABLE - EL3_OFAI J !ADDRESS FILL AREA TABLE - EL3_OCLI J !ADDRESS COLOUR TABLE -! - EL3_SVP J !START VARIABLE PART - EL3_PLIXE E(0:2,0:NPLIX) /1,1,0,2,1,0,3,1,0,4,1,0/ !POLYLINE (4) - EL3_PMIXE E(0:2,0:NPMIX) /1,1,0,2,1,0,3,1,0,4,1,0,5,1,0/ !POLYMARKER (5) - EL3_TXIXE E(0:2,0:NTXIX) /1,2,0,1,3,0,1,4,0/ !TEXT (3) - EL3_FAIXE E(0:2,0:NFAIX) /3,1,0,4,1,0,5,1,0,6,1,0/ !FILL AREA (4) - EL3_CLIXE E(0:2,0:NCLIX) /1,0,0,1,1,0/ !COLOUR (2) -! - EL3_EOL J !END OF LIST -.END !END DEFINITION -!- diff --git a/src/wng/wq_el4.dsc b/src/wng/wq_el4.dsc deleted file mode 100644 index 6a745362943294bf1aa02fef2560602a5c59c856..0000000000000000000000000000000000000000 --- a/src/wng/wq_el4.dsc +++ /dev/null @@ -1,84 +0,0 @@ -!+ WQ_EL4.DSC -! WNB 911218 -! -! Revisions: -! WNB 921111 Change line thickness -! HjV 950704 Change filename from WQ_EPS into WQ_EL4 -! -! -! Define EL4 landscape plotter. Layout should match WQD.DSC -! -! -! -%VERSION=1 !VERSION -%SYSTEM=1 -%USER=WNB -%%DATE -%%NAME -%REVISION=HjV=950704="Change filename from WQ_EPS into WQ_EL4" -%REVISION=WNB=911218="Original version" -%COMMENT="WQ_EL4.DSC defines the EL4 plotter lay-out" -%COMMENT=" " -%LOCAL=NUSED=15 !Max. user data index -%LOCAL=NPLIX=3 !Max. polyline index -%LOCAL=NPMIX=4 !Max. polymarker index -%LOCAL=NTXIX=2 !Max. text index -%LOCAL=NFAIX=3 !Max. fill area index -%LOCAL=NCLIX=1 !Max. colour index -!- -.DEFINE -.PARAMETER -.DATA -.COMMON - EL4_QUE J /0/ !LINK OPEN DEVICES - EL4_LEN J !LENGTH OF AREA - EL4_BID C4 /DQID/ !ID OF AREA - EL4_ACT J /0/ !BIT0=1 ACTIVE - EL4_TYP J /1/ !BIT0=1 OUTPUT, 1 INPUT, 2 DISS, 3 META - EL4_DEFER J /0/ !DEFER TYPE - EL4_REGEN J /0/ !REGENERATION - EL4_NEWFR J /0/ !NEW FRAME - EL4_PEND J /0/ !PENDING - EL4_DEV C8 /EL4/ !DEVICE TYPE - EL4_FILE C80 /EL4.PLT/ !DEVICE FILE - EL4_XHI E /3167/ !HIGHEST X - EL4_YHI E /2339/ !HIGHEST Y - EL4_XM E /0.256/ !X SIZE METERS - EL4_YM E /0.218/ !Y SIZE METERS - EL4_MGL J /132/ !MAX. MESSAGE LENGTH - EL4_DVRT J !DEVICE ROUTINE ADDRESS - EL4_CHAN J /0/ !DEVICE CHANNEL - EL4_NTR E(0:3,0:2) /2339,0,2339,0,0,0,1,1,0,0,3167,2339/ !DEVICE TRANSFORM - EL4_NMPLS E /2/ !NOMINAL LINE SIZE - EL4_MXPLS E /20/ !MAX. LINE SIZE - EL4_MNPLS E /0.7/ !MIN. LINE SIZE - EL4_NMPMS E /20/ !NOMINAL POLYMARKER SIZE - EL4_MXPMS E /0/ !MAX. POLYMARKER SIZE - EL4_MNPMS E /0/ !MIN. POLYMARKER SIZE - EL4_NPLT J /4/ !# OF LINE TYPES - EL4_NPMT J /5/ !# OF POLYMARKER TYPES - EL4_EFN J /0/ !EFN TO USE - EL4_BFL J /0/ !BUFFER LENGTH - EL4_BFA J /0/ !BUFFER ADDRESSES - EL4_USE J(0:NUSED) !USER DATA - EL4_NPLIX J /NPLIX/ !LENGTH POLYLINE TABLE - EL4_NPMIX J /NPMIX/ !LENGTH POLYMARKER TABLE - EL4_NTXIX J /NTXIX/ !LENGTH TEXT TABLE - EL4_NFAIX J /NFAIX/ !LENGTH FILL AREA TABLE - EL4_NCLIX J /NCLIX/ !LENGTH COLOUR TABLE - EL4_OPLI J !ADDRESS POLYLINE TABLE - EL4_OPMI J !ADDRESS POLYMARKER TABLE - EL4_OTXI J !ADDRESS TEXT TABLE - EL4_OFAI J !ADDRESS FILL AREA TABLE - EL4_OCLI J !ADDRESS COLOUR TABLE -! - EL4_SVP J !START VARIABLE PART - EL4_PLIXE E(0:2,0:NPLIX) /1,1,0,2,1,0,3,1,0,4,1,0/ !POLYLINE (4) - EL4_PMIXE E(0:2,0:NPMIX) /1,1,0,2,1,0,3,1,0,4,1,0,5,1,0/ !POLYMARKER (5) - EL4_TXIXE E(0:2,0:NTXIX) /1,2,0,1,3,0,1,4,0/ !TEXT (3) - EL4_FAIXE E(0:2,0:NFAIX) /3,1,0,4,1,0,5,1,0,6,1,0/ !FILL AREA (4) - EL4_CLIXE E(0:2,0:NCLIX) /1,0,0,1,1,0/ !COLOUR (2) -! - EL4_EOL J !END OF LIST -.END !END DEFINITION -!- diff --git a/src/wng/wq_ep0.dsc b/src/wng/wq_ep0.dsc deleted file mode 100644 index e88a18638144dc2d305bdade19f563e7aa0c1e6b..0000000000000000000000000000000000000000 --- a/src/wng/wq_ep0.dsc +++ /dev/null @@ -1,81 +0,0 @@ -!+ WQ_EP0.DSC -! HjV 950704 -! -! Revisions: -! -! -! Define EP0 portrait plotter. Layout should match WQD.DSC -! -! -! -%VERSION=1 !VERSION -%SYSTEM=1 -%USER=HjV -%%DATE -%%NAME -%REVISION=HjV=950704="Original version" -%COMMENT="WQ_EP0.DSC defines the EP0 plotter lay-out" -%COMMENT=" " -%LOCAL=NUSED=15 !Max. user data index -%LOCAL=NPLIX=3 !Max. polyline index -%LOCAL=NPMIX=4 !Max. polymarker index -%LOCAL=NTXIX=2 !Max. text index -%LOCAL=NFAIX=3 !Max. fill area index -%LOCAL=NCLIX=1 !Max. colour index -!- -.DEFINE -.PARAMETER -.DATA -.COMMON - EP0_QUE J /0/ !LINK OPEN DEVICES - EP0_LEN J !LENGTH OF AREA - EP0_BID C4 /DQID/ !ID OF AREA - EP0_ACT J /0/ !BIT0=1 ACTIVE - EP0_TYP J /1/ !BIT0=1 OUTPUT, 1 INPUT, 2 DISS, 3 META - EP0_DEFER J /0/ !DEFER TYPE - EP0_REGEN J /0/ !REGENERATION - EP0_NEWFR J /0/ !NEW FRAME - EP0_PEND J /0/ !PENDING - EP0_DEV C8 /EP0/ !DEVICE TYPE - EP0_FILE C80 /EP0.PLT/ !DEVICE FILE - EP0_XHI E /2339/ !HIGHEST X - EP0_YHI E /3167/ !HIGHEST Y - EP0_XM E /0.872/ !X SIZE METERS - EP0_YM E /1.024/ !Y SIZE METERS - EP0_MGL J /132/ !MAX. MESSAGE LENGTH - EP0_DVRT J !DEVICE ROUTINE ADDRESS - EP0_CHAN J /0/ !DEVICE CHANNEL - EP0_NTR E(0:3,0:2) /2339,0,2339,0,0,0,1,1,0,0,2339,3167/ !DEVICE TRANSFORM - EP0_NMPLS E /.5/ !NOMINAL LINE SIZE - EP0_MXPLS E /5/ !MAX. LINE SIZE - EP0_MNPLS E /0.2/ !MIN. LINE SIZE - EP0_NMPMS E /5/ !NOMINAL POLYMARKER SIZE - EP0_MXPMS E /0/ !MAX. POLYMARKER SIZE - EP0_MNPMS E /0/ !MIN. POLYMARKER SIZE - EP0_NPLT J /4/ !# OF LINE TYPES - EP0_NPMT J /5/ !# OF POLYMARKER TYPES - EP0_EFN J /0/ !EFN TO USE - EP0_BFL J /0/ !BUFFER LENGTH - EP0_BFA J /0/ !BUFFER ADDRESSES - EP0_USE J(0:NUSED) !USER DATA - EP0_NPLIX J /NPLIX/ !LENGTH POLYLINE TABLE - EP0_NPMIX J /NPMIX/ !LENGTH POLYMARKER TABLE - EP0_NTXIX J /NTXIX/ !LENGTH TEXT TABLE - EP0_NFAIX J /NFAIX/ !LENGTH FILL AREA TABLE - EP0_NCLIX J /NCLIX/ !LENGTH COLOUR TABLE - EP0_OPLI J !ADDRESS POLYLINE TABLE - EP0_OPMI J !ADDRESS POLYMARKER TABLE - EP0_OTXI J !ADDRESS TEXT TABLE - EP0_OFAI J !ADDRESS FILL AREA TABLE - EP0_OCLI J !ADDRESS COLOUR TABLE -! - EP0_SVP J !START VARIABLE PART - EP0_PLIXE E(0:2,0:NPLIX) /1,1,0,2,1,0,3,1,0,4,1,0/ !POLYLINE (4) - EP0_PMIXE E(0:2,0:NPMIX) /1,1,0,2,1,0,3,1,0,4,1,0,5,1,0/ !POLYMARKER (5) - EP0_TXIXE E(0:2,0:NTXIX) /1,2,0,1,3,0,1,4,0/ !TEXT (3) - EP0_FAIXE E(0:2,0:NFAIX) /3,1,0,4,1,0,5,1,0,6,1,0/ !FILL AREA (4) - EP0_CLIXE E(0:2,0:NCLIX) /1,0,0,1,1,0/ !COLOUR (2) -! - EP0_EOL J !END OF LIST -.END !END DEFINITION -!- diff --git a/src/wng/wq_ep1.dsc b/src/wng/wq_ep1.dsc deleted file mode 100644 index bd0d5d3c7cab07753e5625f28e61fb378ec90127..0000000000000000000000000000000000000000 --- a/src/wng/wq_ep1.dsc +++ /dev/null @@ -1,81 +0,0 @@ -!+ WQ_EP1.DSC -! HjV 950710 -! -! Revisions: -! -! -! Define EP1 portrait plotter. Layout should match WQD.DSC -! -! -! -%VERSION=1 !VERSION -%SYSTEM=1 -%USER=HjV -%%DATE -%%NAME -%REVISION=HjV=950710="Original version" -%COMMENT="WQ_EP1.DSC defines the EP1 plotter lay-out" -%COMMENT=" " -%LOCAL=NUSED=15 !Max. user data index -%LOCAL=NPLIX=3 !Max. polyline index -%LOCAL=NPMIX=4 !Max. polymarker index -%LOCAL=NTXIX=2 !Max. text index -%LOCAL=NFAIX=3 !Max. fill area index -%LOCAL=NCLIX=1 !Max. colour index -!- -.DEFINE -.PARAMETER -.DATA -.COMMON - EP1_QUE J /0/ !LINK OPEN DEVICES - EP1_LEN J !LENGTH OF AREA - EP1_BID C4 /DQID/ !ID OF AREA - EP1_ACT J /0/ !BIT0=1 ACTIVE - EP1_TYP J /1/ !BIT0=1 OUTPUT, 1 INPUT, 2 DISS, 3 META - EP1_DEFER J /0/ !DEFER TYPE - EP1_REGEN J /0/ !REGENERATION - EP1_NEWFR J /0/ !NEW FRAME - EP1_PEND J /0/ !PENDING - EP1_DEV C8 /EP1/ !DEVICE TYPE - EP1_FILE C80 /EP1.PLT/ !DEVICE FILE - EP1_XHI E /2339/ !HIGHEST X - EP1_YHI E /3167/ !HIGHEST Y - EP1_XM E /0.616/ !X SIZE METERS - EP1_YM E /0.724/ !Y SIZE METERS - EP1_MGL J /132/ !MAX. MESSAGE LENGTH - EP1_DVRT J !DEVICE ROUTINE ADDRESS - EP1_CHAN J /0/ !DEVICE CHANNEL - EP1_NTR E(0:3,0:2) /2339,0,2339,0,0,0,1,1,0,0,2339,3167/ !DEVICE TRANSFORM - EP1_NMPLS E /.8/ !NOMINAL LINE SIZE - EP1_MXPLS E /8/ !MAX. LINE SIZE - EP1_MNPLS E /0.3/ !MIN. LINE SIZE - EP1_NMPMS E /7/ !NOMINAL POLYMARKER SIZE - EP1_MXPMS E /0/ !MAX. POLYMARKER SIZE - EP1_MNPMS E /0/ !MIN. POLYMARKER SIZE - EP1_NPLT J /4/ !# OF LINE TYPES - EP1_NPMT J /5/ !# OF POLYMARKER TYPES - EP1_EFN J /0/ !EFN TO USE - EP1_BFL J /0/ !BUFFER LENGTH - EP1_BFA J /0/ !BUFFER ADDRESSES - EP1_USE J(0:NUSED) !USER DATA - EP1_NPLIX J /NPLIX/ !LENGTH POLYLINE TABLE - EP1_NPMIX J /NPMIX/ !LENGTH POLYMARKER TABLE - EP1_NTXIX J /NTXIX/ !LENGTH TEXT TABLE - EP1_NFAIX J /NFAIX/ !LENGTH FILL AREA TABLE - EP1_NCLIX J /NCLIX/ !LENGTH COLOUR TABLE - EP1_OPLI J !ADDRESS POLYLINE TABLE - EP1_OPMI J !ADDRESS POLYMARKER TABLE - EP1_OTXI J !ADDRESS TEXT TABLE - EP1_OFAI J !ADDRESS FILL AREA TABLE - EP1_OCLI J !ADDRESS COLOUR TABLE -! - EP1_SVP J !START VARIABLE PART - EP1_PLIXE E(0:2,0:NPLIX) /1,1,0,2,1,0,3,1,0,4,1,0/ !POLYLINE (4) - EP1_PMIXE E(0:2,0:NPMIX) /1,1,0,2,1,0,3,1,0,4,1,0,5,1,0/ !POLYMARKER (5) - EP1_TXIXE E(0:2,0:NTXIX) /1,2,0,1,3,0,1,4,0/ !TEXT (3) - EP1_FAIXE E(0:2,0:NFAIX) /3,1,0,4,1,0,5,1,0,6,1,0/ !FILL AREA (4) - EP1_CLIXE E(0:2,0:NCLIX) /1,0,0,1,1,0/ !COLOUR (2) -! - EP1_EOL J !END OF LIST -.END !END DEFINITION -!- diff --git a/src/wng/wq_ep2.dsc b/src/wng/wq_ep2.dsc deleted file mode 100644 index fff6fa4591354e9c54e50cb715db4b04d89e24fc..0000000000000000000000000000000000000000 --- a/src/wng/wq_ep2.dsc +++ /dev/null @@ -1,81 +0,0 @@ -!+ WQ_EP2.DSC -! HjV 950710 -! -! Revisions: -! -! -! Define EP2 portrait plotter. Layout should match WQD.DSC -! -! -! -%VERSION=1 !VERSION -%SYSTEM=1 -%USER=HjV -%%DATE -%%NAME -%REVISION=HjV=950710="Original version" -%COMMENT="WQ_EP2.DSC defines the EP2 plotter lay-out" -%COMMENT=" " -%LOCAL=NUSED=15 !Max. user data index -%LOCAL=NPLIX=3 !Max. polyline index -%LOCAL=NPMIX=4 !Max. polymarker index -%LOCAL=NTXIX=2 !Max. text index -%LOCAL=NFAIX=3 !Max. fill area index -%LOCAL=NCLIX=1 !Max. colour index -!- -.DEFINE -.PARAMETER -.DATA -.COMMON - EP2_QUE J /0/ !LINK OPEN DEVICES - EP2_LEN J !LENGTH OF AREA - EP2_BID C4 /DQID/ !ID OF AREA - EP2_ACT J /0/ !BIT0=1 ACTIVE - EP2_TYP J /1/ !BIT0=1 OUTPUT, 1 INPUT, 2 DISS, 3 META - EP2_DEFER J /0/ !DEFER TYPE - EP2_REGEN J /0/ !REGENERATION - EP2_NEWFR J /0/ !NEW FRAME - EP2_PEND J /0/ !PENDING - EP2_DEV C8 /EP2/ !DEVICE TYPE - EP2_FILE C80 /EP2.PLT/ !DEVICE FILE - EP2_XHI E /2339/ !HIGHEST X - EP2_YHI E /3167/ !HIGHEST Y - EP2_XM E /0.436/ !X SIZE METERS - EP2_YM E /0.512/ !Y SIZE METERS - EP2_MGL J /132/ !MAX. MESSAGE LENGTH - EP2_DVRT J !DEVICE ROUTINE ADDRESS - EP2_CHAN J /0/ !DEVICE CHANNEL - EP2_NTR E(0:3,0:2) /2339,0,2339,0,0,0,1,1,0,0,2339,3167/ !DEVICE TRANSFORM - EP2_NMPLS E /1.2/ !NOMINAL LINE SIZE - EP2_MXPLS E /12/ !MAX. LINE SIZE - EP2_MNPLS E /0.4/ !MIN. LINE SIZE - EP2_NMPMS E /8/ !NOMINAL POLYMARKER SIZE - EP2_MXPMS E /0/ !MAX. POLYMARKER SIZE - EP2_MNPMS E /0/ !MIN. POLYMARKER SIZE - EP2_NPLT J /4/ !# OF LINE TYPES - EP2_NPMT J /5/ !# OF POLYMARKER TYPES - EP2_EFN J /0/ !EFN TO USE - EP2_BFL J /0/ !BUFFER LENGTH - EP2_BFA J /0/ !BUFFER ADDRESSES - EP2_USE J(0:NUSED) !USER DATA - EP2_NPLIX J /NPLIX/ !LENGTH POLYLINE TABLE - EP2_NPMIX J /NPMIX/ !LENGTH POLYMARKER TABLE - EP2_NTXIX J /NTXIX/ !LENGTH TEXT TABLE - EP2_NFAIX J /NFAIX/ !LENGTH FILL AREA TABLE - EP2_NCLIX J /NCLIX/ !LENGTH COLOUR TABLE - EP2_OPLI J !ADDRESS POLYLINE TABLE - EP2_OPMI J !ADDRESS POLYMARKER TABLE - EP2_OTXI J !ADDRESS TEXT TABLE - EP2_OFAI J !ADDRESS FILL AREA TABLE - EP2_OCLI J !ADDRESS COLOUR TABLE -! - EP2_SVP J !START VARIABLE PART - EP2_PLIXE E(0:2,0:NPLIX) /1,1,0,2,1,0,3,1,0,4,1,0/ !POLYLINE (4) - EP2_PMIXE E(0:2,0:NPMIX) /1,1,0,2,1,0,3,1,0,4,1,0,5,1,0/ !POLYMARKER (5) - EP2_TXIXE E(0:2,0:NTXIX) /1,2,0,1,3,0,1,4,0/ !TEXT (3) - EP2_FAIXE E(0:2,0:NFAIX) /3,1,0,4,1,0,5,1,0,6,1,0/ !FILL AREA (4) - EP2_CLIXE E(0:2,0:NCLIX) /1,0,0,1,1,0/ !COLOUR (2) -! - EP2_EOL J !END OF LIST -.END !END DEFINITION -!- diff --git a/src/wng/wq_ep3.dsc b/src/wng/wq_ep3.dsc deleted file mode 100644 index 361f2c49079412bfe517621c1e954347dae219e5..0000000000000000000000000000000000000000 --- a/src/wng/wq_ep3.dsc +++ /dev/null @@ -1,85 +0,0 @@ -!+ WQ_EP3.DSC -! WNB 921021 -! -! Revisions: -! WNB 921029 Change line sizes etc -! HJV 921029 Change XY size in meters to A4-size * sqrt(2) -! HjV 950704 Change filename from WQ_EAP into WQ_EP3 -! -! -! Define EP3 portrait plotter. Layout should match WQD.DSC -! -! -! -%VERSION=1 !VERSION -%SYSTEM=1 -%USER=WNB -%%DATE -%%NAME -%REVISION=HjV=950704="Change filename from WQ_EAP into WQ_EP3" -%REVISION=WNB=921021="Original version" -%COMMENT="WQ_EP3.DSC defines the EP3 plotter lay-out" -%COMMENT=" " -%LOCAL=NUSED=15 !Max. user data index -%LOCAL=NPLIX=3 !Max. polyline index -%LOCAL=NPMIX=4 !Max. polymarker index -%LOCAL=NTXIX=2 !Max. text index -%LOCAL=NFAIX=3 !Max. fill area index -%LOCAL=NCLIX=1 !Max. colour index -!- -.DEFINE -.PARAMETER -.DATA -.COMMON - EP3_QUE J /0/ !LINK OPEN DEVICES - EP3_LEN J !LENGTH OF AREA - EP3_BID C4 /DQID/ !ID OF AREA - EP3_ACT J /0/ !BIT0=1 ACTIVE - EP3_TYP J /1/ !BIT0=1 OUTPUT, 1 INPUT, 2 DISS, 3 META - EP3_DEFER J /0/ !DEFER TYPE - EP3_REGEN J /0/ !REGENERATION - EP3_NEWFR J /0/ !NEW FRAME - EP3_PEND J /0/ !PENDING - EP3_DEV C8 /EP3/ !DEVICE TYPE - EP3_FILE C80 /EP3.PLT/ !DEVICE FILE - EP3_XHI E /2339/ !HIGHEST X - EP3_YHI E /3167/ !HIGHEST Y - EP3_XM E /0.308/ !X SIZE METERS - EP3_YM E /0.362/ !Y SIZE METERS - EP3_MGL J /132/ !MAX. MESSAGE LENGTH - EP3_DVRT J !DEVICE ROUTINE ADDRESS - EP3_CHAN J /0/ !DEVICE CHANNEL - EP3_NTR E(0:3,0:2) /2339,0,2339,0,0,0,1,1,0,0,2339,3167/ !DEVICE TRANSFORM - EP3_NMPLS E /1.5/ !NOMINAL LINE SIZE - EP3_MXPLS E /15/ !MAX. LINE SIZE - EP3_MNPLS E /0.5/ !MIN. LINE SIZE - EP3_NMPMS E /10/ !NOMINAL POLYMARKER SIZE - EP3_MXPMS E /0/ !MAX. POLYMARKER SIZE - EP3_MNPMS E /0/ !MIN. POLYMARKER SIZE - EP3_NPLT J /4/ !# OF LINE TYPES - EP3_NPMT J /5/ !# OF POLYMARKER TYPES - EP3_EFN J /0/ !EFN TO USE - EP3_BFL J /0/ !BUFFER LENGTH - EP3_BFA J /0/ !BUFFER ADDRESSES - EP3_USE J(0:NUSED) !USER DATA - EP3_NPLIX J /NPLIX/ !LENGTH POLYLINE TABLE - EP3_NPMIX J /NPMIX/ !LENGTH POLYMARKER TABLE - EP3_NTXIX J /NTXIX/ !LENGTH TEXT TABLE - EP3_NFAIX J /NFAIX/ !LENGTH FILL AREA TABLE - EP3_NCLIX J /NCLIX/ !LENGTH COLOUR TABLE - EP3_OPLI J !ADDRESS POLYLINE TABLE - EP3_OPMI J !ADDRESS POLYMARKER TABLE - EP3_OTXI J !ADDRESS TEXT TABLE - EP3_OFAI J !ADDRESS FILL AREA TABLE - EP3_OCLI J !ADDRESS COLOUR TABLE -! - EP3_SVP J !START VARIABLE PART - EP3_PLIXE E(0:2,0:NPLIX) /1,1,0,2,1,0,3,1,0,4,1,0/ !POLYLINE (4) - EP3_PMIXE E(0:2,0:NPMIX) /1,1,0,2,1,0,3,1,0,4,1,0,5,1,0/ !POLYMARKER (5) - EP3_TXIXE E(0:2,0:NTXIX) /1,2,0,1,3,0,1,4,0/ !TEXT (3) - EP3_FAIXE E(0:2,0:NFAIX) /3,1,0,4,1,0,5,1,0,6,1,0/ !FILL AREA (4) - EP3_CLIXE E(0:2,0:NCLIX) /1,0,0,1,1,0/ !COLOUR (2) -! - EP3_EOL J !END OF LIST -.END !END DEFINITION -!- diff --git a/src/wng/wq_ep4.dsc b/src/wng/wq_ep4.dsc deleted file mode 100644 index bc65620ba3cba4c8280206bc18c2f465f04ca205..0000000000000000000000000000000000000000 --- a/src/wng/wq_ep4.dsc +++ /dev/null @@ -1,84 +0,0 @@ -!+ WQ_EP4.DSC -! WNB 911218 -! -! Revisions: -! WNB 921111 Change line thickness -! HjV 950704 Change filename from WQ_EPP into WQ_EP4 -! -! -! Define EP4 portrait plotter. Layout should match WQD.DSC -! -! -! -%VERSION=1 !VERSION -%SYSTEM=1 -%USER=WNB -%%DATE -%%NAME -%REVISION=HjV=950704="Change filename from WQ_EPP into WQ_EP4" -%REVISION=WNB=911218="Original version" -%COMMENT="WQ_EP4.DSC defines the EP4 plotter lay-out" -%COMMENT=" " -%LOCAL=NUSED=15 !Max. user data index -%LOCAL=NPLIX=3 !Max. polyline index -%LOCAL=NPMIX=4 !Max. polymarker index -%LOCAL=NTXIX=2 !Max. text index -%LOCAL=NFAIX=3 !Max. fill area index -%LOCAL=NCLIX=1 !Max. colour index -!- -.DEFINE -.PARAMETER -.DATA -.COMMON - EP4_QUE J /0/ !LINK OPEN DEVICES - EP4_LEN J !LENGTH OF AREA - EP4_BID C4 /DQID/ !ID OF AREA - EP4_ACT J /0/ !BIT0=1 ACTIVE - EP4_TYP J /1/ !BIT0=1 OUTPUT, 1 INPUT, 2 DISS, 3 META - EP4_DEFER J /0/ !DEFER TYPE - EP4_REGEN J /0/ !REGENERATION - EP4_NEWFR J /0/ !NEW FRAME - EP4_PEND J /0/ !PENDING - EP4_DEV C8 /EP4/ !DEVICE TYPE - EP4_FILE C80 /EP4.PLT/ !DEVICE FILE - EP4_XHI E /2339/ !HIGHEST X - EP4_YHI E /3167/ !HIGHEST Y - EP4_XM E /0.218/ !X SIZE METERS - EP4_YM E /0.256/ !Y SIZE METERS - EP4_MGL J /132/ !MAX. MESSAGE LENGTH - EP4_DVRT J !DEVICE ROUTINE ADDRESS - EP4_CHAN J /0/ !DEVICE CHANNEL - EP4_NTR E(0:3,0:2) /2339,0,2339,0,0,0,1,1,0,0,2339,3167/ !DEVICE TRANSFORM - EP4_NMPLS E /2/ !NOMINAL LINE SIZE - EP4_MXPLS E /20/ !MAX. LINE SIZE - EP4_MNPLS E /0.7/ !MIN. LINE SIZE - EP4_NMPMS E /20/ !NOMINAL POLYMARKER SIZE - EP4_MXPMS E /0/ !MAX. POLYMARKER SIZE - EP4_MNPMS E /0/ !MIN. POLYMARKER SIZE - EP4_NPLT J /4/ !# OF LINE TYPES - EP4_NPMT J /5/ !# OF POLYMARKER TYPES - EP4_EFN J /0/ !EFN TO USE - EP4_BFL J /0/ !BUFFER LENGTH - EP4_BFA J /0/ !BUFFER ADDRESSES - EP4_USE J(0:NUSED) !USER DATA - EP4_NPLIX J /NPLIX/ !LENGTH POLYLINE TABLE - EP4_NPMIX J /NPMIX/ !LENGTH POLYMARKER TABLE - EP4_NTXIX J /NTXIX/ !LENGTH TEXT TABLE - EP4_NFAIX J /NFAIX/ !LENGTH FILL AREA TABLE - EP4_NCLIX J /NCLIX/ !LENGTH COLOUR TABLE - EP4_OPLI J !ADDRESS POLYLINE TABLE - EP4_OPMI J !ADDRESS POLYMARKER TABLE - EP4_OTXI J !ADDRESS TEXT TABLE - EP4_OFAI J !ADDRESS FILL AREA TABLE - EP4_OCLI J !ADDRESS COLOUR TABLE -! - EP4_SVP J !START VARIABLE PART - EP4_PLIXE E(0:2,0:NPLIX) /1,1,0,2,1,0,3,1,0,4,1,0/ !POLYLINE (4) - EP4_PMIXE E(0:2,0:NPMIX) /1,1,0,2,1,0,3,1,0,4,1,0,5,1,0/ !POLYMARKER (5) - EP4_TXIXE E(0:2,0:NTXIX) /1,2,0,1,3,0,1,4,0/ !TEXT (3) - EP4_FAIXE E(0:2,0:NFAIX) /3,1,0,4,1,0,5,1,0,6,1,0/ !FILL AREA (4) - EP4_CLIXE E(0:2,0:NCLIX) /1,0,0,1,1,0/ !COLOUR (2) -! - EP4_EOL J !END OF LIST -.END !END DEFINITION -!- diff --git a/src/wng/wq_fna.dsc b/src/wng/wq_fna.dsc deleted file mode 100644 index 5fa3a1678366858208935f79a7b50f66e1ecff44..0000000000000000000000000000000000000000 --- a/src/wng/wq_fna.dsc +++ /dev/null @@ -1,186 +0,0 @@ -!+ WQ_FNA.DSC -! WNB 911126 -! -! Revisions: -! -! -! Define Font 1. Layout should match WQF.DSC -! -! -! -%VERSION=1 !VERSION -%SYSTEM=1 -%USER=WNB -%%DATE -%%NAME -%REVISION=HJV=930902="Make use of WNTINC" -%REVISION=WNB=911126="Original version" -%COMMENT="WQ_FNA.DSC defines the Font 1 lay-out" -%COMMENT=" " -!- -.DEFINE -.PARAMETER -.DATA -.COMMON - FNA_HGT E /12/ !HEIGHT - FNA_WID E /8/ !WIDTH - FNA_PLN J /160/ !8* MAX. POLYLINE # - FNA_STR E(0:1,4) /0,3,8,3,3,0,3,12/ !START RIGHT, LEFT, UP, DOWN POINT - FNA_BDL J /127/ !DELETE BITS - FNA_LCH J /32/ !LOWEST CHARACTER - FNA_HCH J /127/ !HIGHEST CHARACTER - FNA_RCH J /32/ !REPLACE CHARACTER - FNA_BHG E /9/ !BODY HEIGHT - FNA_TIL J /1/ !THICKER IF LARGER - FNA_RSV J(3) !RESERVED -! -! CHARACTER POINTERS -! - FNA_FTP J(96) /(96)0/ !CHARACTER LIST POINTERS -! -! CHARACTERS -! - FNA_L20 B(02) /0,0/ - FNA_L21 B(12) /3,11,3,6,-1,-1,3,3,3,3,0,0/ - FNA_L22 B(12) /1,11,1,8,-1,-1,4,11,4,8,0,0/ - FNA_L23 B(16) /1,11,1,3,-1,-1,4,11,4,3,-1,-1,0,9,5,9/ - FNA_M23 B(8) /-1,-1,0,5,5,5,0,0/ - FNA_L24 B(16) /3,11,3,3,-1,-1,5,10,2,10,1,9,1,8,2,7/ - FNA_M24 B(12) /4,7,5,6,5,5,4,4,1,4,0,0/ - FNA_L25 B(16) /1,11,0,10,1,9,2,10,1,11,-1,-1,5,3,6,4/ - FNA_M25 B(14) /5,5,4,4,5,3,-1,-1,0,4,6,10,0,0/ - FNA_L26 B(16) /6,3,0,9,0,10,1,11,2,11,3,10,3,9,0,6/ - FNA_M26 B(12) /0,4,1,3,4,3,5,4,5,6,0,0/ - FNA_L27 B(14) /2,8,4,10,4,11,3,11,3,10,4,10,0,0/ - FNA_L28 B(10) /4,11,2,9,2,5,4,3,0,0/ - FNA_L29 B(10) /2,11,4,9,4,5,2,3,0,0/ - FNA_L2A B(16) /3,10,3,4,-1,-1,0,4,6,10,-1,-1,0,10,6,4/ - FNA_M2A B(02) /0,0/ - FNA_L2B B(12) /0,7,6,7,-1,-1,3,10,3,4,0,0/ - FNA_L2C B(14) /2,1,4,3,4,4,3,4,3,3,4,3,0,0/ - FNA_L2D B(06) /0,7,6,7,0,0/ - FNA_L2E B(12) /2,3,2,4,3,4,3,3,2,3,0,0/ - FNA_L2F B(06) /0,4,6,10,0,0/ - FNA_L30 B(16) /0,5,2,3,4,3,6,5,6,9,4,11,2,11,0,9/ - FNA_M30 B(04) /0,5,0,0/ - FNA_L31 B(12) /1,9,3,11,3,3,1,3,5,3,0,0/ - FNA_L32 B(16) /0,10,1,11,5,11,6,10,6,9,4,7,2,7,0,5/ - FNA_M32 B(06) /0,3,6,3,0,0/ - FNA_L33 B(16) /0,10,1,11,5,11,6,10,6,8,5,7,3,7,5,7/ - FNA_M33 B(12) /6,6,6,4,5,3,1,3,0,4,0,0/ - FNA_L34 B(12) /4,3,4,11,0,7,0,5,6,5,0,0/ - FNA_L35 B(16) /0,4,1,3,5,3,6,4,6,6,5,7,0,7,0,11/ - FNA_M35 B(04) /6,11,0,0/ - FNA_L36 B(16) /6,10,5,11,2,11,0,9,0,4,1,3,5,3,6,4/ - FNA_M36 B(10) /6,6,5,7,2,7,0,5,0,0/ - FNA_L37 B(12) /0,11,6,11,6,10,1,5,1,3,0,0/ - FNA_L38 B(16) /0,4,0,6,1,7,5,7,6,6,6,4,5,3,1,3/ - FNA_M38 B(16) /0,4,-1,-1,1,7,0,8,0,10,1,11,5,11,6,10/ - FNA_N38 B(06) /6,8,5,7,0,0/ - FNA_L39 B(16) /1,3,4,3,6,5,6,10,5,11,1,11,0,10,0,8/ - FNA_M39 B(06) /1,7,6,7,0,0/ - FNA_L3A B(16) /2,9,3,9,3,8,2,8,2,9,-1,-1,2,4,3,4/ - FNA_M3A B(08) /3,3,2,3,2,4,0,0/ - FNA_L3B B(16) /2,9,3,9,3,8,2,8,2,9,-1,-1,3,3,2,3/ - FNA_M3B B(10) /2,4,3,4,3,2,2,1,0,0/ - FNA_L3C B(08) /4,10,1,7,4,4,0,0/ - FNA_L3D B(12) /0,8,6,8,-1,-1,0,6,6,6,0,0/ - FNA_L3E B(08) /2,10,5,7,2,4,0,0/ - FNA_L3F B(16) /1,9,1,10,2,11,4,11,5,10,5,9,3,7,3,5/ - FNA_M3F B(08) /-1,-1,3,3,3,3,0,0/ - FNA_L40 B(16) /4,6,4,9,3,9,2,8,2,6,6,6,6,10,5,11/ - FNA_M40 B(14) /2,11,0,9,0,5,2,3,5,3,6,4,0,0/ - FNA_L41 B(16) /0,3,0,9,2,11,4,11,6,9,6,3,6,7,0,7/ - FNA_M41 B(02) /0,0/ - FNA_L42 B(16) /0,11,5,11,6,10,6,8,5,7,6,6,6,4,5,3/ - FNA_M42 B(12) /0,3,1,3,1,11,1,7,5,7,0,0/ - FNA_L43 B(16) /5,10,4,11,1,11,0,10,0,4,1,3,4,3,5,4/ - FNA_M43 B(02) /0,0/ - FNA_L44 B(16) /0,11,4,11,6,9,6,5,4,3,0,3,1,3,1,11/ - FNA_M44 B(02) /0,0/ - FNA_L45 B(16) /6,11,0,11,0,7,4,7,0,7,0,3,6,3,0,0/ - FNA_L46 B(14) /6,11,0,11,0,7,4,7,0,7,0,3,0,0/ - FNA_L47 B(16) /6,10,5,11,1,11,0,10,0,4,1,3,5,3,6,4/ - FNA_M47 B(08) /6,7,3,7,3,6,0,0/ - FNA_L48 B(14) /0,3,0,11,0,7,6,7,6,11,6,3,0,0/ - FNA_L49 B(14) /2,11,4,11,3,11,3,3,4,3,2,3,0,0/ - FNA_L4A B(16) /3,11,5,11,4,11,4,4,3,3,1,3,0,4,0,0/ - FNA_L4B B(14) /0,11,0,3,0,5,6,11,2,7,6,3,0,0/ - FNA_L4C B(08) /0,11,0,3,6,3,0,0/ - FNA_L4D B(12) /0,3,0,11,3,8,6,11,6,3,0,0/ - FNA_L4E B(12) /0,3,0,11,6,5,6,3,6,11,0,0/ - FNA_L4F B(16) /1,3,0,4,0,10,1,11,5,11,6,10,6,4,5,3/ - FNA_M4F B(04) /1,3,0,0/ - FNA_L50 B(16) /0,3,0,11,5,11,6,10,6,8,5,7,0,7,0,0/ - FNA_L51 B(16) /1,3,0,4,0,10,1,11,5,11,6,10,6,5,4,3/ - FNA_M51 B(10) /1,3,-1,-1,6,3,3,6,0,0/ - FNA_L52 B(16) /0,3,0,11,5,11,6,10,6,8,5,7,0,7,2,7/ - FNA_M52 B(04) /6,3,0,0/ - FNA_L53 B(16) /6,10,5,11,1,11,0,10,0,8,1,7,5,7,6,6/ - FNA_M53 B(10) /6,4,5,3,1,3,0,4,0,0/ - FNA_L54 B(10) /0,11,6,11,3,11,3,3,0,0/ - FNA_L55 B(14) /0,11,0,5,2,3,4,3,6,5,6,11,0,0/ - FNA_L56 B(08) /0,11,3,3,6,11,0,0/ - FNA_L57 B(16) /0,11,0,4,1,3,3,5,3,7,3,5,5,3,6,4/ - FNA_M57 B(04) /6,11,0,0/ - FNA_L58 B(16) /0,11,0,10,6,4,6,3,-1,-1,0,3,0,4,6,10/ - FNA_M58 B(04) /6,11,0,0/ - FNA_L59 B(16) /0,11,0,10,3,7,3,3,3,7,6,10,6,11,0,0/ - FNA_L5A B(14) /0,11,6,11,6,10,0,4,0,3,6,3,0,0/ - FNA_L5B B(10) /4,11,1,11,1,3,4,3,0,0/ - FNA_L5C B(06) /1,10,6,4,0,0/ - FNA_L5D B(10) /2,11,5,11,5,3,2,3,0,0/ - FNA_L5E B(08) /0,8,3,11,6,8,0,0/ - FNA_L5F B(06) /0,3,6,3,0,0/ - FNA_L60 B(14) /3,10,3,11,4,11,4,10,3,10,5,8,0,0/ - FNA_L61 B(16) /1,8,5,8,6,7,6,3,1,3,0,4,0,5,1,6/ - FNA_M61 B(04) /6,6,0,0/ - FNA_L62 B(16) /0,11,0,3,5,3,6,4,6,7,5,8,0,8,0,0/ - FNA_L63 B(16) /6,7,5,8,1,8,0,7,0,4,1,3,5,3,6,4/ - FNA_M63 B(02) /0,0/ - FNA_L64 B(16) /6,11,6,3,1,3,0,4,0,7,1,8,6,8,0,0/ - FNA_L65 B(16) /5,3,1,3,0,4,0,7,1,8,5,8,6,7,6,6/ - FNA_M65 B(06) /5,5,0,5,0,0/ - FNA_L66 B(16) /5,10,4,11,3,11,2,10,2,3,2,7,1,7,3,7/ - FNA_M66 B(02) /0,0/ - FNA_L67 B(16) /6,3,1,3,0,4,0,7,1,8,6,8,6,2,5,1/ - FNA_M67 B(04) /1,1,0,0/ - FNA_L68 B(14) /0,11,0,3,0,8,5,8,6,7,6,3,0,0/ - FNA_L69 B(16) /2,8,3,8,3,3,2,3,4,3,-1,-1,3,10,3,10/ - FNA_M69 B(02) /0,0/ - FNA_L6A B(16) /4,10,4,10,-1,-1,4,8,4,2,3,1,2,1,1,2/ - FNA_M6A B(02) /0,0/ - FNA_L6B B(14) /0,11,0,3,0,4,4,8,2,6,5,3,0,0/ - FNA_L6C B(12) /2,11,3,11,3,3,2,3,4,3,0,0/ - FNA_L6D B(16) /0,3,0,8,0,6,2,8,3,7,3,3,3,7,4,8/ - FNA_M6D B(08) /5,8,6,7,6,3,0,0/ - FNA_L6E B(16) /0,3,0,8,0,6,2,8,4,8,5,7,5,3,0,0/ - FNA_L6F B(16) /1,3,0,4,0,7,1,8,4,8,5,7,5,4,4,3/ - FNA_M6F B(04) /1,3,0,0/ - FNA_L70 B(16) /0,1,0,8,0,6,2,8,5,8,6,7,6,5,5,4/ - FNA_M70 B(06) /2,4,0,6,0,0/ - FNA_L71 B(16) /6,1,6,8,6,6,4,8,1,8,0,7,0,5,1,4/ - FNA_M71 B(06) /4,4,6,6,0,0/ - FNA_L72 B(14) /0,3,0,8,0,6,2,8,5,8,6,7,0,0/ - FNA_L73 B(16) /6,8,1,8,0,7,1,6,5,6,6,5,6,4,5,3/ - FNA_M73 B(04) /0,3,0,0/ - FNA_L74 B(16) /2,11,2,4,3,3,4,3,5,4,-1,-1,1,7,3,7/ - FNA_M74 B(02) /0,0/ - FNA_L75 B(16) /0,8,0,4,1,3,3,3,5,5,5,8,5,4,6,3/ - FNA_M75 B(02) /0,0/ - FNA_L76 B(12) /0,8,0,6,3,3,6,6,6,8,0,0/ - FNA_L77 B(16) /0,8,0,4,1,3,3,5,3,6,3,5,5,3,6,4/ - FNA_M77 B(04) /6,8,0,0/ - FNA_L78 B(12) /0,3,5,8,-1,-1,0,8,5,3,0,0/ - FNA_L79 B(16) /0,8,0,4,1,3,4,3,6,5,6,8,6,2,5,1/ - FNA_M79 B(06) /1,1,0,2,0,0/ - FNA_L7A B(14) /0,8,6,8,4,6,3,6,0,3,6,3,0,0/ - FNA_L7B B(16) /4,11,3,10,3,8,2,7,3,6,3,4,4,3,0,0/ - FNA_L7C B(12) /3,11,3,8,-1,-1,3,6,3,3,0,0/ - FNA_L7D B(16) /2,11,3,10,3,8,4,7,3,6,3,4,2,3,0,0/ - FNA_L7E B(14) /0,10,1,11,2,11,3,10,4,10,5,11,0,0/ - FNA_L7F B(16) /5,9,5,10,4,11,2,11,1,10,1,9,3,7,3,5/ - FNA_M7F B(08) /-1,-1,3,3,3,3,0,0/ - FNA_LEND B(2) /0,0/ -.END !END DEFINITION -!- diff --git a/src/wng/wq_fnb.dsc b/src/wng/wq_fnb.dsc deleted file mode 100644 index 4542b493e5a484b7d5ff0ba240f3c8aa3e1e70f4..0000000000000000000000000000000000000000 --- a/src/wng/wq_fnb.dsc +++ /dev/null @@ -1,46 +0,0 @@ -!+ WQ_FNB.DSC -! WNB 911126 -! -! Revisions: -! -! -! Define Font 1. Layout should match WQF.DSC -! -! -! -%VERSION=1 !VERSION -%SYSTEM=1 -%USER=WNB -%%DATE -%%NAME -%REVISION=HJV=930902="Make use of WNTINC" -%REVISION=WNB=911126="Original version" -%COMMENT="WQ_FNB.DSC defines the Font 1 lay-out" -%COMMENT=" " -!- -.DEFINE -.PARAMETER -.DATA -.COMMON - FNB_HGT E /12/ !HEIGHT - FNB_WID E /8/ !WIDTH - FNB_PLN J /160/ !8* MAX. POLYLINE # - FNB_STR E(0:1,4) /0,3,8,3,3,0,3,12/ !START RIGHT, LEFT, UP, DOWN POINT - FNB_BDL J /127/ !DELETE BITS - FNB_LCH J /32/ !LOWEST CHARACTER - FNB_HCH J /127/ !HIGHEST CHARACTER - FNB_RCH J /32/ !REPLACE CHARACTER - FNB_BHG E /9/ !BODY HEIGHT - FNB_TIL J /0/ !THICKER IF LARGER - FNB_RSV J(3) !RESERVED -! -! CHARACTER POINTERS -! - FNB_FTP J(96) /(96)0/ !CHARACTER LIST POINTERS -! -! CHARACTERS TO BE TAKEN FROM FN1 LIST -! - FNB_L20 B(02) /0,0/ - FNB_LEND B(2) /0,0/ -.END !END DEFINITION -!- diff --git a/src/wng/wq_pl0.dsc b/src/wng/wq_pl0.dsc deleted file mode 100644 index 507a0880b55e284835ab2a3dbc4cf2a7fbc977f8..0000000000000000000000000000000000000000 --- a/src/wng/wq_pl0.dsc +++ /dev/null @@ -1,81 +0,0 @@ -!+ WQ_PL0.DSC -! HjV 950704 -! -! Revisions: -! -! -! Define PL0 landscape plotter. Layout should match WQD.DSC -! -! -! -%VERSION=1 !VERSION -%SYSTEM=1 -%USER=HjV -%%DATE -%%NAME -%REVISION=HjV=950704="Original version" -%COMMENT="WQ_PL0.DSC defines the PL0 plotter lay-out" -%COMMENT=" " -%LOCAL=NUSED=15 !Max. user data index -%LOCAL=NPLIX=3 !Max. polyline index -%LOCAL=NPMIX=4 !Max. polymarker index -%LOCAL=NTXIX=2 !Max. text index -%LOCAL=NFAIX=3 !Max. fill area index -%LOCAL=NCLIX=1 !Max. colour index -!- -.DEFINE -.PARAMETER -.DATA -.COMMON - PL0_QUE J /0/ !LINK OPEN DEVICES - PL0_LEN J !LENGTH OF AREA - PL0_BID C4 /DQID/ !ID OF AREA - PL0_ACT J /0/ !BIT0=1 ACTIVE - PL0_TYP J /1/ !BIT0=1 OUTPUT, 1 INPUT, 2 DISS, 3 META - PL0_DEFER J /0/ !DEFER TYPE - PL0_REGEN J /0/ !REGENERATION - PL0_NEWFR J /0/ !NEW FRAME - PL0_PEND J /0/ !PENDING - PL0_DEV C8 /PL0/ !DEVICE TYPE - PL0_FILE C80 /PL0.PLT/ !DEVICE FILE - PL0_XHI E /3167/ !HIGHEST X - PL0_YHI E /2339/ !HIGHEST Y - PL0_XM E /1.024/ !X SIZE METERS - PL0_YM E /0.872/ !Y SIZE METERS - PL0_MGL J /132/ !MAX. MESSAGE LENGTH - PL0_DVRT J !DEVICE ROUTINE ADDRESS - PL0_CHAN J /0/ !DEVICE CHANNEL - PL0_NTR E(0:3,0:2) /2339,0,2339,0,0,0,1,1,0,0,3167,2339/ !DEVICE TRANSFORM - PL0_NMPLS E /.5/ !NOMINAL LINE SIZE - PL0_MXPLS E /5/ !MAX. LINE SIZE - PL0_MNPLS E /0.2/ !MIN. LINE SIZE - PL0_NMPMS E /5/ !NOMINAL POLYMARKER SIZE - PL0_MXPMS E /0/ !MAX. POLYMARKER SIZE - PL0_MNPMS E /0/ !MIN. POLYMARKER SIZE - PL0_NPLT J /4/ !# OF LINE TYPES - PL0_NPMT J /5/ !# OF POLYMARKER TYPES - PL0_EFN J /0/ !EFN TO USE - PL0_BFL J /0/ !BUFFER LENGTH - PL0_BFA J /0/ !BUFFER ADDRESSES - PL0_USE J(0:NUSED) !USER DATA - PL0_NPLIX J /NPLIX/ !LENGTH POLYLINE TABLE - PL0_NPMIX J /NPMIX/ !LENGTH POLYMARKER TABLE - PL0_NTXIX J /NTXIX/ !LENGTH TEXT TABLE - PL0_NFAIX J /NFAIX/ !LENGTH FILL AREA TABLE - PL0_NCLIX J /NCLIX/ !LENGTH COLOUR TABLE - PL0_OPLI J !ADDRESS POLYLINE TABLE - PL0_OPMI J !ADDRESS POLYMARKER TABLE - PL0_OTXI J !ADDRESS TEXT TABLE - PL0_OFAI J !ADDRESS FILL AREA TABLE - PL0_OCLI J !ADDRESS COLOUR TABLE -! - PL0_SVP J !START VARIABLE PART - PL0_PLIXE E(0:2,0:NPLIX) /1,1,0,2,1,0,3,1,0,4,1,0/ !POLYLINE (4) - PL0_PMIXE E(0:2,0:NPMIX) /1,1,0,2,1,0,3,1,0,4,1,0,5,1,0/ !POLYMARKER (5) - PL0_TXIXE E(0:2,0:NTXIX) /1,2,0,1,3,0,1,4,0/ !TEXT (3) - PL0_FAIXE E(0:2,0:NFAIX) /3,1,0,4,1,0,5,1,0,6,1,0/ !FILL AREA (4) - PL0_CLIXE E(0:2,0:NCLIX) /1,0,0,1,1,0/ !COLOUR (2) -! - PL0_EOL J !END OF LIST -.END !END DEFINITION -!- diff --git a/src/wng/wq_pl1.dsc b/src/wng/wq_pl1.dsc deleted file mode 100644 index 463ed78f92f55b56f5e3be5cf3049c0f05b4fcdc..0000000000000000000000000000000000000000 --- a/src/wng/wq_pl1.dsc +++ /dev/null @@ -1,81 +0,0 @@ -!+ WQ_PL1.DSC -! HjV 950710 -! -! Revisions: -! -! -! Define PL1 landscape plotter. Layout should match WQD.DSC -! -! -! -%VERSION=1 !VERSION -%SYSTEM=1 -%USER=HjV -%%DATE -%%NAME -%REVISION=HjV=950710="Original version" -%COMMENT="WQ_PL1.DSC defines the PL1 plotter lay-out" -%COMMENT=" " -%LOCAL=NUSED=15 !Max. user data index -%LOCAL=NPLIX=3 !Max. polyline index -%LOCAL=NPMIX=4 !Max. polymarker index -%LOCAL=NTXIX=2 !Max. text index -%LOCAL=NFAIX=3 !Max. fill area index -%LOCAL=NCLIX=1 !Max. colour index -!- -.DEFINE -.PARAMETER -.DATA -.COMMON - PL1_QUE J /0/ !LINK OPEN DEVICES - PL1_LEN J !LENGTH OF AREA - PL1_BID C4 /DQID/ !ID OF AREA - PL1_ACT J /0/ !BIT0=1 ACTIVE - PL1_TYP J /1/ !BIT0=1 OUTPUT, 1 INPUT, 2 DISS, 3 META - PL1_DEFER J /0/ !DEFER TYPE - PL1_REGEN J /0/ !REGENERATION - PL1_NEWFR J /0/ !NEW FRAME - PL1_PEND J /0/ !PENDING - PL1_DEV C8 /PL1/ !DEVICE TYPE - PL1_FILE C80 /PL1.PLT/ !DEVICE FILE - PL1_XHI E /3167/ !HIGHEST X - PL1_YHI E /2339/ !HIGHEST Y - PL1_XM E /0.724/ !X SIZE METERS - PL1_YM E /0.616/ !Y SIZE METERS - PL1_MGL J /132/ !MAX. MESSAGE LENGTH - PL1_DVRT J !DEVICE ROUTINE ADDRESS - PL1_CHAN J /0/ !DEVICE CHANNEL - PL1_NTR E(0:3,0:2) /2339,0,2339,0,0,0,1,1,0,0,3167,2339/ !DEVICE TRANSFORM - PL1_NMPLS E /.8/ !NOMINAL LINE SIZE - PL1_MXPLS E /8/ !MAX. LINE SIZE - PL1_MNPLS E /0.3/ !MIN. LINE SIZE - PL1_NMPMS E /7/ !NOMINAL POLYMARKER SIZE - PL1_MXPMS E /0/ !MAX. POLYMARKER SIZE - PL1_MNPMS E /0/ !MIN. POLYMARKER SIZE - PL1_NPLT J /4/ !# OF LINE TYPES - PL1_NPMT J /5/ !# OF POLYMARKER TYPES - PL1_EFN J /0/ !EFN TO USE - PL1_BFL J /0/ !BUFFER LENGTH - PL1_BFA J /0/ !BUFFER ADDRESSES - PL1_USE J(0:NUSED) !USER DATA - PL1_NPLIX J /NPLIX/ !LENGTH POLYLINE TABLE - PL1_NPMIX J /NPMIX/ !LENGTH POLYMARKER TABLE - PL1_NTXIX J /NTXIX/ !LENGTH TEXT TABLE - PL1_NFAIX J /NFAIX/ !LENGTH FILL AREA TABLE - PL1_NCLIX J /NCLIX/ !LENGTH COLOUR TABLE - PL1_OPLI J !ADDRESS POLYLINE TABLE - PL1_OPMI J !ADDRESS POLYMARKER TABLE - PL1_OTXI J !ADDRESS TEXT TABLE - PL1_OFAI J !ADDRESS FILL AREA TABLE - PL1_OCLI J !ADDRESS COLOUR TABLE -! - PL1_SVP J !START VARIABLE PART - PL1_PLIXE E(0:2,0:NPLIX) /1,1,0,2,1,0,3,1,0,4,1,0/ !POLYLINE (4) - PL1_PMIXE E(0:2,0:NPMIX) /1,1,0,2,1,0,3,1,0,4,1,0,5,1,0/ !POLYMARKER (5) - PL1_TXIXE E(0:2,0:NTXIX) /1,2,0,1,3,0,1,4,0/ !TEXT (3) - PL1_FAIXE E(0:2,0:NFAIX) /3,1,0,4,1,0,5,1,0,6,1,0/ !FILL AREA (4) - PL1_CLIXE E(0:2,0:NCLIX) /1,0,0,1,1,0/ !COLOUR (2) -! - PL1_EOL J !END OF LIST -.END !END DEFINITION -!- diff --git a/src/wng/wq_pl2.dsc b/src/wng/wq_pl2.dsc deleted file mode 100644 index 0d31ed435ba6111780ce0e334e062babc7af3d9c..0000000000000000000000000000000000000000 --- a/src/wng/wq_pl2.dsc +++ /dev/null @@ -1,81 +0,0 @@ -!+ WQ_PL2.DSC -! HjV 950710 -! -! Revisions: -! -! -! Define PL2 landscape plotter. Layout should match WQD.DSC -! -! -! -%VERSION=1 !VERSION -%SYSTEM=1 -%USER=HjV -%%DATE -%%NAME -%REVISION=HjV=950710="Original version" -%COMMENT="WQ_PL2.DSC defines the PL2 plotter lay-out" -%COMMENT=" " -%LOCAL=NUSED=15 !Max. user data index -%LOCAL=NPLIX=3 !Max. polyline index -%LOCAL=NPMIX=4 !Max. polymarker index -%LOCAL=NTXIX=2 !Max. text index -%LOCAL=NFAIX=3 !Max. fill area index -%LOCAL=NCLIX=1 !Max. colour index -!- -.DEFINE -.PARAMETER -.DATA -.COMMON - PL2_QUE J /0/ !LINK OPEN DEVICES - PL2_LEN J !LENGTH OF AREA - PL2_BID C4 /DQID/ !ID OF AREA - PL2_ACT J /0/ !BIT0=1 ACTIVE - PL2_TYP J /1/ !BIT0=1 OUTPUT, 1 INPUT, 2 DISS, 3 META - PL2_DEFER J /0/ !DEFER TYPE - PL2_REGEN J /0/ !REGENERATION - PL2_NEWFR J /0/ !NEW FRAME - PL2_PEND J /0/ !PENDING - PL2_DEV C8 /PL2/ !DEVICE TYPE - PL2_FILE C80 /PL2.PLT/ !DEVICE FILE - PL2_XHI E /3167/ !HIGHEST X - PL2_YHI E /2339/ !HIGHEST Y - PL2_XM E /0.512/ !X SIZE METERS - PL2_YM E /0.436/ !Y SIZE METERS - PL2_MGL J /132/ !MAX. MESSAGE LENGTH - PL2_DVRT J !DEVICE ROUTINE ADDRESS - PL2_CHAN J /0/ !DEVICE CHANNEL - PL2_NTR E(0:3,0:2) /2339,0,2339,0,0,0,1,1,0,0,3167,2339/ !DEVICE TRANSFORM - PL2_NMPLS E /1.2/ !NOMINAL LINE SIZE - PL2_MXPLS E /12/ !MAX. LINE SIZE - PL2_MNPLS E /0.4/ !MIN. LINE SIZE - PL2_NMPMS E /8/ !NOMINAL POLYMARKER SIZE - PL2_MXPMS E /0/ !MAX. POLYMARKER SIZE - PL2_MNPMS E /0/ !MIN. POLYMARKER SIZE - PL2_NPLT J /4/ !# OF LINE TYPES - PL2_NPMT J /5/ !# OF POLYMARKER TYPES - PL2_EFN J /0/ !EFN TO USE - PL2_BFL J /0/ !BUFFER LENGTH - PL2_BFA J /0/ !BUFFER ADDRESSES - PL2_USE J(0:NUSED) !USER DATA - PL2_NPLIX J /NPLIX/ !LENGTH POLYLINE TABLE - PL2_NPMIX J /NPMIX/ !LENGTH POLYMARKER TABLE - PL2_NTXIX J /NTXIX/ !LENGTH TEXT TABLE - PL2_NFAIX J /NFAIX/ !LENGTH FILL AREA TABLE - PL2_NCLIX J /NCLIX/ !LENGTH COLOUR TABLE - PL2_OPLI J !ADDRESS POLYLINE TABLE - PL2_OPMI J !ADDRESS POLYMARKER TABLE - PL2_OTXI J !ADDRESS TEXT TABLE - PL2_OFAI J !ADDRESS FILL AREA TABLE - PL2_OCLI J !ADDRESS COLOUR TABLE -! - PL2_SVP J !START VARIABLE PART - PL2_PLIXE E(0:2,0:NPLIX) /1,1,0,2,1,0,3,1,0,4,1,0/ !POLYLINE (4) - PL2_PMIXE E(0:2,0:NPMIX) /1,1,0,2,1,0,3,1,0,4,1,0,5,1,0/ !POLYMARKER (5) - PL2_TXIXE E(0:2,0:NTXIX) /1,2,0,1,3,0,1,4,0/ !TEXT (3) - PL2_FAIXE E(0:2,0:NFAIX) /3,1,0,4,1,0,5,1,0,6,1,0/ !FILL AREA (4) - PL2_CLIXE E(0:2,0:NCLIX) /1,0,0,1,1,0/ !COLOUR (2) -! - PL2_EOL J !END OF LIST -.END !END DEFINITION -!- diff --git a/src/wng/wq_pl3.dsc b/src/wng/wq_pl3.dsc deleted file mode 100644 index 318e9730d6a818b275b70bdde9dac8cd1c17a181..0000000000000000000000000000000000000000 --- a/src/wng/wq_pl3.dsc +++ /dev/null @@ -1,85 +0,0 @@ -!+ WQ_PL3.DSC -! WNB 921021 -! -! Revisions: -! WNB 921029 Change line etc sizes -! HJV 921029 Change XY size in meters to A4-size * sqrt(2) -! HjV 950704 Change filename from WQ_PAL into WQ_PL3 -! -! -! Define PL3 landscape plotter. Layout should match WQD.DSC -! -! -! -%VERSION=1 !VERSION -%SYSTEM=1 -%USER=WNB -%%DATE -%%NAME -%REVISION=HjV=950704="Change filename from WQ_PAL into WQ_PL3" -%REVISION=WNB=921021="Original version" -%COMMENT="WQ_PL3.DSC defines the PL3 plotter lay-out" -%COMMENT=" " -%LOCAL=NUSED=15 !Max. user data index -%LOCAL=NPLIX=3 !Max. polyline index -%LOCAL=NPMIX=4 !Max. polymarker index -%LOCAL=NTXIX=2 !Max. text index -%LOCAL=NFAIX=3 !Max. fill area index -%LOCAL=NCLIX=1 !Max. colour index -!- -.DEFINE -.PARAMETER -.DATA -.COMMON - PL3_QUE J /0/ !LINK OPEN DEVICES - PL3_LEN J !LENGTH OF AREA - PL3_BID C4 /DQID/ !ID OF AREA - PL3_ACT J /0/ !BIT0=1 ACTIVE - PL3_TYP J /1/ !BIT0=1 OUTPUT, 1 INPUT, 2 DISS, 3 META - PL3_DEFER J /0/ !DEFER TYPE - PL3_REGEN J /0/ !REGENERATION - PL3_NEWFR J /0/ !NEW FRAME - PL3_PEND J /0/ !PENDING - PL3_DEV C8 /PL3/ !DEVICE TYPE - PL3_FILE C80 /PL3.PLT/ !DEVICE FILE - PL3_XHI E /3167/ !HIGHEST X - PL3_YHI E /2339/ !HIGHEST Y - PL3_XM E /0.362/ !X SIZE METERS - PL3_YM E /0.308/ !Y SIZE METERS - PL3_MGL J /132/ !MAX. MESSAGE LENGTH - PL3_DVRT J !DEVICE ROUTINE ADDRESS - PL3_CHAN J /0/ !DEVICE CHANNEL - PL3_NTR E(0:3,0:2) /2339,0,2339,0,0,0,1,1,0,0,3167,2339/ !DEVICE TRANSFORM - PL3_NMPLS E /1.5/ !NOMINAL LINE SIZE - PL3_MXPLS E /15/ !MAX. LINE SIZE - PL3_MNPLS E /0.5/ !MIN. LINE SIZE - PL3_NMPMS E /10/ !NOMINAL POLYMARKER SIZE - PL3_MXPMS E /0/ !MAX. POLYMARKER SIZE - PL3_MNPMS E /0/ !MIN. POLYMARKER SIZE - PL3_NPLT J /4/ !# OF LINE TYPES - PL3_NPMT J /5/ !# OF POLYMARKER TYPES - PL3_EFN J /0/ !EFN TO USE - PL3_BFL J /0/ !BUFFER LENGTH - PL3_BFA J /0/ !BUFFER ADDRESSES - PL3_USE J(0:NUSED) !USER DATA - PL3_NPLIX J /NPLIX/ !LENGTH POLYLINE TABLE - PL3_NPMIX J /NPMIX/ !LENGTH POLYMARKER TABLE - PL3_NTXIX J /NTXIX/ !LENGTH TEXT TABLE - PL3_NFAIX J /NFAIX/ !LENGTH FILL AREA TABLE - PL3_NCLIX J /NCLIX/ !LENGTH COLOUR TABLE - PL3_OPLI J !ADDRESS POLYLINE TABLE - PL3_OPMI J !ADDRESS POLYMARKER TABLE - PL3_OTXI J !ADDRESS TEXT TABLE - PL3_OFAI J !ADDRESS FILL AREA TABLE - PL3_OCLI J !ADDRESS COLOUR TABLE -! - PL3_SVP J !START VARIABLE PART - PL3_PLIXE E(0:2,0:NPLIX) /1,1,0,2,1,0,3,1,0,4,1,0/ !POLYLINE (4) - PL3_PMIXE E(0:2,0:NPMIX) /1,1,0,2,1,0,3,1,0,4,1,0,5,1,0/ !POLYMARKER (5) - PL3_TXIXE E(0:2,0:NTXIX) /1,2,0,1,3,0,1,4,0/ !TEXT (3) - PL3_FAIXE E(0:2,0:NFAIX) /3,1,0,4,1,0,5,1,0,6,1,0/ !FILL AREA (4) - PL3_CLIXE E(0:2,0:NCLIX) /1,0,0,1,1,0/ !COLOUR (2) -! - PL3_EOL J !END OF LIST -.END !END DEFINITION -!- diff --git a/src/wng/wq_pl4.dsc b/src/wng/wq_pl4.dsc deleted file mode 100644 index f773486ba9df4ee9ab004f2e10a90df9abe717b0..0000000000000000000000000000000000000000 --- a/src/wng/wq_pl4.dsc +++ /dev/null @@ -1,84 +0,0 @@ -!+ WQ_PL4.DSC -! WNB 911218 -! -! Revisions: -! WNB 921111 Change line thickness -! HjV 950704 Change filename from WQ_PSL into WQ_PL4 -! -! -! Define PL4 landscape plotter. Layout should match WQD.DSC -! -! -! -%VERSION=1 !VERSION -%SYSTEM=1 -%USER=WNB -%%DATE -%%NAME -%REVISION=HjV=950704="Change filename from WQ_PSL into WQ_PL4" -%REVISION=WNB=911218="Original version" -%COMMENT="WQ_PL4.DSC defines the PL4 plotter lay-out" -%COMMENT=" " -%LOCAL=NUSED=15 !Max. user data index -%LOCAL=NPLIX=3 !Max. polyline index -%LOCAL=NPMIX=4 !Max. polymarker index -%LOCAL=NTXIX=2 !Max. text index -%LOCAL=NFAIX=3 !Max. fill area index -%LOCAL=NCLIX=1 !Max. colour index -!- -.DEFINE -.PARAMETER -.DATA -.COMMON - PL4_QUE J /0/ !LINK OPEN DEVICES - PL4_LEN J !LENGTH OF AREA - PL4_BID C4 /DQID/ !ID OF AREA - PL4_ACT J /0/ !BIT0=1 ACTIVE - PL4_TYP J /1/ !BIT0=1 OUTPUT, 1 INPUT, 2 DISS, 3 META - PL4_DEFER J /0/ !DEFER TYPE - PL4_REGEN J /0/ !REGENERATION - PL4_NEWFR J /0/ !NEW FRAME - PL4_PEND J /0/ !PENDING - PL4_DEV C8 /PL4/ !DEVICE TYPE - PL4_FILE C80 /PL4.PLT/ !DEVICE FILE - PL4_XHI E /3167/ !HIGHEST X - PL4_YHI E /2339/ !HIGHEST Y - PL4_XM E /0.256/ !X SIZE METERS - PL4_YM E /0.218/ !Y SIZE METERS - PL4_MGL J /132/ !MAX. MESSAGE LENGTH - PL4_DVRT J !DEVICE ROUTINE ADDRESS - PL4_CHAN J /0/ !DEVICE CHANNEL - PL4_NTR E(0:3,0:2) /2339,0,2339,0,0,0,1,1,0,0,3167,2339/ !DEVICE TRANSFORM - PL4_NMPLS E /2/ !NOMINAL LINE SIZE - PL4_MXPLS E /20/ !MAX. LINE SIZE - PL4_MNPLS E /0.7/ !MIN. LINE SIZE - PL4_NMPMS E /20/ !NOMINAL POLYMARKER SIZE - PL4_MXPMS E /0/ !MAX. POLYMARKER SIZE - PL4_MNPMS E /0/ !MIN. POLYMARKER SIZE - PL4_NPLT J /4/ !# OF LINE TYPES - PL4_NPMT J /5/ !# OF POLYMARKER TYPES - PL4_EFN J /0/ !EFN TO USE - PL4_BFL J /0/ !BUFFER LENGTH - PL4_BFA J /0/ !BUFFER ADDRESSES - PL4_USE J(0:NUSED) !USER DATA - PL4_NPLIX J /NPLIX/ !LENGTH POLYLINE TABLE - PL4_NPMIX J /NPMIX/ !LENGTH POLYMARKER TABLE - PL4_NTXIX J /NTXIX/ !LENGTH TEXT TABLE - PL4_NFAIX J /NFAIX/ !LENGTH FILL AREA TABLE - PL4_NCLIX J /NCLIX/ !LENGTH COLOUR TABLE - PL4_OPLI J !ADDRESS POLYLINE TABLE - PL4_OPMI J !ADDRESS POLYMARKER TABLE - PL4_OTXI J !ADDRESS TEXT TABLE - PL4_OFAI J !ADDRESS FILL AREA TABLE - PL4_OCLI J !ADDRESS COLOUR TABLE -! - PL4_SVP J !START VARIABLE PART - PL4_PLIXE E(0:2,0:NPLIX) /1,1,0,2,1,0,3,1,0,4,1,0/ !POLYLINE (4) - PL4_PMIXE E(0:2,0:NPMIX) /1,1,0,2,1,0,3,1,0,4,1,0,5,1,0/ !POLYMARKER (5) - PL4_TXIXE E(0:2,0:NTXIX) /1,2,0,1,3,0,1,4,0/ !TEXT (3) - PL4_FAIXE E(0:2,0:NFAIX) /3,1,0,4,1,0,5,1,0,6,1,0/ !FILL AREA (4) - PL4_CLIXE E(0:2,0:NCLIX) /1,0,0,1,1,0/ !COLOUR (2) -! - PL4_EOL J !END OF LIST -.END !END DEFINITION -!- diff --git a/src/wng/wq_pp0.dsc b/src/wng/wq_pp0.dsc deleted file mode 100644 index e3624e6daaa375dc0b0a51852ff42157fa68d13c..0000000000000000000000000000000000000000 --- a/src/wng/wq_pp0.dsc +++ /dev/null @@ -1,81 +0,0 @@ -!+ WQ_PP0.DSC -! HjV 950704 -! -! Revisions: -! -! -! Define PP0 portrait plotter. Layout should match WQD.DSC -! -! -! -%VERSION=1 !VERSION -%SYSTEM=1 -%USER=HjV -%%DATE -%%NAME -%REVISION=HjV=950704="Original version" -%COMMENT="WQ_PP0.DSC defines the PP0 plotter lay-out" -%COMMENT=" " -%LOCAL=NUSED=15 !Max. user data index -%LOCAL=NPLIX=3 !Max. polyline index -%LOCAL=NPMIX=4 !Max. polymarker index -%LOCAL=NTXIX=2 !Max. text index -%LOCAL=NFAIX=3 !Max. fill area index -%LOCAL=NCLIX=1 !Max. colour index -!- -.DEFINE -.PARAMETER -.DATA -.COMMON - PP0_QUE J /0/ !LINK OPEN DEVICES - PP0_LEN J !LENGTH OF AREA - PP0_BID C4 /DQID/ !ID OF AREA - PP0_ACT J /0/ !BIT0=1 ACTIVE - PP0_TYP J /1/ !BIT0=1 OUTPUT, 1 INPUT, 2 DISS, 3 META - PP0_DEFER J /0/ !DEFER TYPE - PP0_REGEN J /0/ !REGENERATION - PP0_NEWFR J /0/ !NEW FRAME - PP0_PEND J /0/ !PENDING - PP0_DEV C8 /PP0/ !DEVICE TYPE - PP0_FILE C80 /PP0.PLT/ !DEVICE FILE - PP0_XHI E /2339/ !HIGHEST X - PP0_YHI E /3167/ !HIGHEST Y - PP0_XM E /0.872/ !X SIZE METERS - PP0_YM E /1.024/ !Y SIZE METERS - PP0_MGL J /132/ !MAX. MESSAGE LENGTH - PP0_DVRT J !DEVICE ROUTINE ADDRESS - PP0_CHAN J /0/ !DEVICE CHANNEL - PP0_NTR E(0:3,0:2) /2339,0,2339,0,0,0,1,1,0,0,2339,3167/ !DEVICE TRANSFORM - PP0_NMPLS E /.5/ !NOMINAL LINE SIZE - PP0_MXPLS E /5/ !MAX. LINE SIZE - PP0_MNPLS E /0.2/ !MIN. LINE SIZE - PP0_NMPMS E /5/ !NOMINAL POLYMARKER SIZE - PP0_MXPMS E /0/ !MAX. POLYMARKER SIZE - PP0_MNPMS E /0/ !MIN. POLYMARKER SIZE - PP0_NPLT J /4/ !# OF LINE TYPES - PP0_NPMT J /5/ !# OF POLYMARKER TYPES - PP0_EFN J /0/ !EFN TO USE - PP0_BFL J /0/ !BUFFER LENGTH - PP0_BFA J /0/ !BUFFER ADDRESSES - PP0_USE J(0:NUSED) !USER DATA - PP0_NPLIX J /NPLIX/ !LENGTH POLYLINE TABLE - PP0_NPMIX J /NPMIX/ !LENGTH POLYMARKER TABLE - PP0_NTXIX J /NTXIX/ !LENGTH TEXT TABLE - PP0_NFAIX J /NFAIX/ !LENGTH FILL AREA TABLE - PP0_NCLIX J /NCLIX/ !LENGTH COLOUR TABLE - PP0_OPLI J !ADDRESS POLYLINE TABLE - PP0_OPMI J !ADDRESS POLYMARKER TABLE - PP0_OTXI J !ADDRESS TEXT TABLE - PP0_OFAI J !ADDRESS FILL AREA TABLE - PP0_OCLI J !ADDRESS COLOUR TABLE -! - PP0_SVP J !START VARIABLE PART - PP0_PLIXE E(0:2,0:NPLIX) /1,1,0,2,1,0,3,1,0,4,1,0/ !POLYLINE (4) - PP0_PMIXE E(0:2,0:NPMIX) /1,1,0,2,1,0,3,1,0,4,1,0,5,1,0/ !POLYMARKER (5) - PP0_TXIXE E(0:2,0:NTXIX) /1,2,0,1,3,0,1,4,0/ !TEXT (3) - PP0_FAIXE E(0:2,0:NFAIX) /3,1,0,4,1,0,5,1,0,6,1,0/ !FILL AREA (4) - PP0_CLIXE E(0:2,0:NCLIX) /1,0,0,1,1,0/ !COLOUR (2) -! - PP0_EOL J !END OF LIST -.END !END DEFINITION -!- diff --git a/src/wng/wq_pp1.dsc b/src/wng/wq_pp1.dsc deleted file mode 100644 index e68abb2deb0e193670dc8105b83ab3d7b67e9d9a..0000000000000000000000000000000000000000 --- a/src/wng/wq_pp1.dsc +++ /dev/null @@ -1,81 +0,0 @@ -!+ WQ_PP1.DSC -! HjV 950710 -! -! Revisions: -! -! -! Define PP1 portrait plotter. Layout should match WQD.DSC -! -! -! -%VERSION=1 !VERSION -%SYSTEM=1 -%USER=HjV -%%DATE -%%NAME -%REVISION=HjV=950710="Original version" -%COMMENT="WQ_PP1.DSC defines the PP1 plotter lay-out" -%COMMENT=" " -%LOCAL=NUSED=15 !Max. user data index -%LOCAL=NPLIX=3 !Max. polyline index -%LOCAL=NPMIX=4 !Max. polymarker index -%LOCAL=NTXIX=2 !Max. text index -%LOCAL=NFAIX=3 !Max. fill area index -%LOCAL=NCLIX=1 !Max. colour index -!- -.DEFINE -.PARAMETER -.DATA -.COMMON - PP1_QUE J /0/ !LINK OPEN DEVICES - PP1_LEN J !LENGTH OF AREA - PP1_BID C4 /DQID/ !ID OF AREA - PP1_ACT J /0/ !BIT0=1 ACTIVE - PP1_TYP J /1/ !BIT0=1 OUTPUT, 1 INPUT, 2 DISS, 3 META - PP1_DEFER J /0/ !DEFER TYPE - PP1_REGEN J /0/ !REGENERATION - PP1_NEWFR J /0/ !NEW FRAME - PP1_PEND J /0/ !PENDING - PP1_DEV C8 /PP1/ !DEVICE TYPE - PP1_FILE C80 /PP1.PLT/ !DEVICE FILE - PP1_XHI E /2339/ !HIGHEST X - PP1_YHI E /3167/ !HIGHEST Y - PP1_XM E /0.616/ !X SIZE METERS - PP1_YM E /0.724/ !Y SIZE METERS - PP1_MGL J /132/ !MAX. MESSAGE LENGTH - PP1_DVRT J !DEVICE ROUTINE ADDRESS - PP1_CHAN J /0/ !DEVICE CHANNEL - PP1_NTR E(0:3,0:2) /2339,0,2339,0,0,0,1,1,0,0,2339,3167/ !DEVICE TRANSFORM - PP1_NMPLS E /0.8/ !NOMINAL LINE SIZE - PP1_MXPLS E /8/ !MAX. LINE SIZE - PP1_MNPLS E /0.3/ !MIN. LINE SIZE - PP1_NMPMS E /7/ !NOMINAL POLYMARKER SIZE - PP1_MXPMS E /0/ !MAX. POLYMARKER SIZE - PP1_MNPMS E /0/ !MIN. POLYMARKER SIZE - PP1_NPLT J /4/ !# OF LINE TYPES - PP1_NPMT J /5/ !# OF POLYMARKER TYPES - PP1_EFN J /0/ !EFN TO USE - PP1_BFL J /0/ !BUFFER LENGTH - PP1_BFA J /0/ !BUFFER ADDRESSES - PP1_USE J(0:NUSED) !USER DATA - PP1_NPLIX J /NPLIX/ !LENGTH POLYLINE TABLE - PP1_NPMIX J /NPMIX/ !LENGTH POLYMARKER TABLE - PP1_NTXIX J /NTXIX/ !LENGTH TEXT TABLE - PP1_NFAIX J /NFAIX/ !LENGTH FILL AREA TABLE - PP1_NCLIX J /NCLIX/ !LENGTH COLOUR TABLE - PP1_OPLI J !ADDRESS POLYLINE TABLE - PP1_OPMI J !ADDRESS POLYMARKER TABLE - PP1_OTXI J !ADDRESS TEXT TABLE - PP1_OFAI J !ADDRESS FILL AREA TABLE - PP1_OCLI J !ADDRESS COLOUR TABLE -! - PP1_SVP J !START VARIABLE PART - PP1_PLIXE E(0:2,0:NPLIX) /1,1,0,2,1,0,3,1,0,4,1,0/ !POLYLINE (4) - PP1_PMIXE E(0:2,0:NPMIX) /1,1,0,2,1,0,3,1,0,4,1,0,5,1,0/ !POLYMARKER (5) - PP1_TXIXE E(0:2,0:NTXIX) /1,2,0,1,3,0,1,4,0/ !TEXT (3) - PP1_FAIXE E(0:2,0:NFAIX) /3,1,0,4,1,0,5,1,0,6,1,0/ !FILL AREA (4) - PP1_CLIXE E(0:2,0:NCLIX) /1,0,0,1,1,0/ !COLOUR (2) -! - PP1_EOL J !END OF LIST -.END !END DEFINITION -!- diff --git a/src/wng/wq_pp2.dsc b/src/wng/wq_pp2.dsc deleted file mode 100644 index 6eb8ba79b71f983fbfc3e33006d2f0f9c09ab821..0000000000000000000000000000000000000000 --- a/src/wng/wq_pp2.dsc +++ /dev/null @@ -1,81 +0,0 @@ -!+ WQ_PP2.DSC -! HjV 950710 -! -! Revisions: -! -! -! Define PP2 portrait plotter. Layout should match WQD.DSC -! -! -! -%VERSION=1 !VERSION -%SYSTEM=1 -%USER=HjV -%%DATE -%%NAME -%REVISION=HjV=950710="Original version" -%COMMENT="WQ_PP2.DSC defines the PP2 plotter lay-out" -%COMMENT=" " -%LOCAL=NUSED=15 !Max. user data index -%LOCAL=NPLIX=3 !Max. polyline index -%LOCAL=NPMIX=4 !Max. polymarker index -%LOCAL=NTXIX=2 !Max. text index -%LOCAL=NFAIX=3 !Max. fill area index -%LOCAL=NCLIX=1 !Max. colour index -!- -.DEFINE -.PARAMETER -.DATA -.COMMON - PP2_QUE J /0/ !LINK OPEN DEVICES - PP2_LEN J !LENGTH OF AREA - PP2_BID C4 /DQID/ !ID OF AREA - PP2_ACT J /0/ !BIT0=1 ACTIVE - PP2_TYP J /1/ !BIT0=1 OUTPUT, 1 INPUT, 2 DISS, 3 META - PP2_DEFER J /0/ !DEFER TYPE - PP2_REGEN J /0/ !REGENERATION - PP2_NEWFR J /0/ !NEW FRAME - PP2_PEND J /0/ !PENDING - PP2_DEV C8 /PP2/ !DEVICE TYPE - PP2_FILE C80 /PP2.PLT/ !DEVICE FILE - PP2_XHI E /2339/ !HIGHEST X - PP2_YHI E /3167/ !HIGHEST Y - PP2_XM E /0.436/ !X SIZE METERS - PP2_YM E /0.512/ !Y SIZE METERS - PP2_MGL J /132/ !MAX. MESSAGE LENGTH - PP2_DVRT J !DEVICE ROUTINE ADDRESS - PP2_CHAN J /0/ !DEVICE CHANNEL - PP2_NTR E(0:3,0:2) /2339,0,2339,0,0,0,1,1,0,0,2339,3167/ !DEVICE TRANSFORM - PP2_NMPLS E /1.2/ !NOMINAL LINE SIZE - PP2_MXPLS E /12/ !MAX. LINE SIZE - PP2_MNPLS E /0.4/ !MIN. LINE SIZE - PP2_NMPMS E /8/ !NOMINAL POLYMARKER SIZE - PP2_MXPMS E /0/ !MAX. POLYMARKER SIZE - PP2_MNPMS E /0/ !MIN. POLYMARKER SIZE - PP2_NPLT J /4/ !# OF LINE TYPES - PP2_NPMT J /5/ !# OF POLYMARKER TYPES - PP2_EFN J /0/ !EFN TO USE - PP2_BFL J /0/ !BUFFER LENGTH - PP2_BFA J /0/ !BUFFER ADDRESSES - PP2_USE J(0:NUSED) !USER DATA - PP2_NPLIX J /NPLIX/ !LENGTH POLYLINE TABLE - PP2_NPMIX J /NPMIX/ !LENGTH POLYMARKER TABLE - PP2_NTXIX J /NTXIX/ !LENGTH TEXT TABLE - PP2_NFAIX J /NFAIX/ !LENGTH FILL AREA TABLE - PP2_NCLIX J /NCLIX/ !LENGTH COLOUR TABLE - PP2_OPLI J !ADDRESS POLYLINE TABLE - PP2_OPMI J !ADDRESS POLYMARKER TABLE - PP2_OTXI J !ADDRESS TEXT TABLE - PP2_OFAI J !ADDRESS FILL AREA TABLE - PP2_OCLI J !ADDRESS COLOUR TABLE -! - PP2_SVP J !START VARIABLE PART - PP2_PLIXE E(0:2,0:NPLIX) /1,1,0,2,1,0,3,1,0,4,1,0/ !POLYLINE (4) - PP2_PMIXE E(0:2,0:NPMIX) /1,1,0,2,1,0,3,1,0,4,1,0,5,1,0/ !POLYMARKER (5) - PP2_TXIXE E(0:2,0:NTXIX) /1,2,0,1,3,0,1,4,0/ !TEXT (3) - PP2_FAIXE E(0:2,0:NFAIX) /3,1,0,4,1,0,5,1,0,6,1,0/ !FILL AREA (4) - PP2_CLIXE E(0:2,0:NCLIX) /1,0,0,1,1,0/ !COLOUR (2) -! - PP2_EOL J !END OF LIST -.END !END DEFINITION -!- diff --git a/src/wng/wq_pp3.dsc b/src/wng/wq_pp3.dsc deleted file mode 100644 index 0c4a179e3b9eb47b2f8be7f94c6e2bbddf6e4cee..0000000000000000000000000000000000000000 --- a/src/wng/wq_pp3.dsc +++ /dev/null @@ -1,85 +0,0 @@ -!+ WQ_PP3.DSC -! WNB 921021 -! -! Revisions: -! WNB 921029 Change line sizes etc -! HJV 921029 Change XY size in meters to A4-size * sqrt(2) -! HjV 950704 Change filename from WQ_PAP into WQ_PP3 -! -! -! Define PP3 portrait plotter. Layout should match WQD.DSC -! -! -! -%VERSION=1 !VERSION -%SYSTEM=1 -%USER=WNB -%%DATE -%%NAME -%REVISION=HjV=950704="Change filename from WQ_PAP into WQ_PP3" -%REVISION=WNB=921021="Original version" -%COMMENT="WQ_PP3.DSC defines the PP3 plotter lay-out" -%COMMENT=" " -%LOCAL=NUSED=15 !Max. user data index -%LOCAL=NPLIX=3 !Max. polyline index -%LOCAL=NPMIX=4 !Max. polymarker index -%LOCAL=NTXIX=2 !Max. text index -%LOCAL=NFAIX=3 !Max. fill area index -%LOCAL=NCLIX=1 !Max. colour index -!- -.DEFINE -.PARAMETER -.DATA -.COMMON - PP3_QUE J /0/ !LINK OPEN DEVICES - PP3_LEN J !LENGTH OF AREA - PP3_BID C4 /DQID/ !ID OF AREA - PP3_ACT J /0/ !BIT0=1 ACTIVE - PP3_TYP J /1/ !BIT0=1 OUTPUT, 1 INPUT, 2 DISS, 3 META - PP3_DEFER J /0/ !DEFER TYPE - PP3_REGEN J /0/ !REGENERATION - PP3_NEWFR J /0/ !NEW FRAME - PP3_PEND J /0/ !PENDING - PP3_DEV C8 /PP3/ !DEVICE TYPE - PP3_FILE C80 /PP3.PLT/ !DEVICE FILE - PP3_XHI E /2339/ !HIGHEST X - PP3_YHI E /3167/ !HIGHEST Y - PP3_XM E /0.308/ !X SIZE METERS - PP3_YM E /0.362/ !Y SIZE METERS - PP3_MGL J /132/ !MAX. MESSAGE LENGTH - PP3_DVRT J !DEVICE ROUTINE ADDRESS - PP3_CHAN J /0/ !DEVICE CHANNEL - PP3_NTR E(0:3,0:2) /2339,0,2339,0,0,0,1,1,0,0,2339,3167/ !DEVICE TRANSFORM - PP3_NMPLS E /1.5/ !NOMINAL LINE SIZE - PP3_MXPLS E /15/ !MAX. LINE SIZE - PP3_MNPLS E /0.5/ !MIN. LINE SIZE - PP3_NMPMS E /10/ !NOMINAL POLYMARKER SIZE - PP3_MXPMS E /0/ !MAX. POLYMARKER SIZE - PP3_MNPMS E /0/ !MIN. POLYMARKER SIZE - PP3_NPLT J /4/ !# OF LINE TYPES - PP3_NPMT J /5/ !# OF POLYMARKER TYPES - PP3_EFN J /0/ !EFN TO USE - PP3_BFL J /0/ !BUFFER LENGTH - PP3_BFA J /0/ !BUFFER ADDRESSES - PP3_USE J(0:NUSED) !USER DATA - PP3_NPLIX J /NPLIX/ !LENGTH POLYLINE TABLE - PP3_NPMIX J /NPMIX/ !LENGTH POLYMARKER TABLE - PP3_NTXIX J /NTXIX/ !LENGTH TEXT TABLE - PP3_NFAIX J /NFAIX/ !LENGTH FILL AREA TABLE - PP3_NCLIX J /NCLIX/ !LENGTH COLOUR TABLE - PP3_OPLI J !ADDRESS POLYLINE TABLE - PP3_OPMI J !ADDRESS POLYMARKER TABLE - PP3_OTXI J !ADDRESS TEXT TABLE - PP3_OFAI J !ADDRESS FILL AREA TABLE - PP3_OCLI J !ADDRESS COLOUR TABLE -! - PP3_SVP J !START VARIABLE PART - PP3_PLIXE E(0:2,0:NPLIX) /1,1,0,2,1,0,3,1,0,4,1,0/ !POLYLINE (4) - PP3_PMIXE E(0:2,0:NPMIX) /1,1,0,2,1,0,3,1,0,4,1,0,5,1,0/ !POLYMARKER (5) - PP3_TXIXE E(0:2,0:NTXIX) /1,2,0,1,3,0,1,4,0/ !TEXT (3) - PP3_FAIXE E(0:2,0:NFAIX) /3,1,0,4,1,0,5,1,0,6,1,0/ !FILL AREA (4) - PP3_CLIXE E(0:2,0:NCLIX) /1,0,0,1,1,0/ !COLOUR (2) -! - PP3_EOL J !END OF LIST -.END !END DEFINITION -!- diff --git a/src/wng/wq_pp4.dsc b/src/wng/wq_pp4.dsc deleted file mode 100644 index f5c35f5705728a5931f9783ec04f4a6f4adfdfd8..0000000000000000000000000000000000000000 --- a/src/wng/wq_pp4.dsc +++ /dev/null @@ -1,84 +0,0 @@ -!+ WQ_PP4.DSC -! WNB 911218 -! -! Revisions: -! WNB 921111 Change line thickness -! HjV 950704 Change filename from WQ_PSP into WQ_PP4 -! -! -! Define PP4 portrait plotter. Layout should match WQD.DSC -! -! -! -%VERSION=1 !VERSION -%SYSTEM=1 -%USER=WNB -%%DATE -%%NAME -%REVISION=HjV=950704="Change filename from WQ_PSP into WQ_PP4" -%REVISION=WNB=911218="Original version" -%COMMENT="WQ_PP4.DSC defines the PP4 plotter lay-out" -%COMMENT=" " -%LOCAL=NUSED=15 !Max. user data index -%LOCAL=NPLIX=3 !Max. polyline index -%LOCAL=NPMIX=4 !Max. polymarker index -%LOCAL=NTXIX=2 !Max. text index -%LOCAL=NFAIX=3 !Max. fill area index -%LOCAL=NCLIX=1 !Max. colour index -!- -.DEFINE -.PARAMETER -.DATA -.COMMON - PP4_QUE J /0/ !LINK OPEN DEVICES - PP4_LEN J !LENGTH OF AREA - PP4_BID C4 /DQID/ !ID OF AREA - PP4_ACT J /0/ !BIT0=1 ACTIVE - PP4_TYP J /1/ !BIT0=1 OUTPUT, 1 INPUT, 2 DISS, 3 META - PP4_DEFER J /0/ !DEFER TYPE - PP4_REGEN J /0/ !REGENERATION - PP4_NEWFR J /0/ !NEW FRAME - PP4_PEND J /0/ !PENDING - PP4_DEV C8 /PP4/ !DEVICE TYPE - PP4_FILE C80 /PP4.PLT/ !DEVICE FILE - PP4_XHI E /2339/ !HIGHEST X - PP4_YHI E /3167/ !HIGHEST Y - PP4_XM E /0.218/ !X SIZE METERS - PP4_YM E /0.256/ !Y SIZE METERS - PP4_MGL J /132/ !MAX. MESSAGE LENGTH - PP4_DVRT J !DEVICE ROUTINE ADDRESS - PP4_CHAN J /0/ !DEVICE CHANNEL - PP4_NTR E(0:3,0:2) /2339,0,2339,0,0,0,1,1,0,0,2339,3167/ !DEVICE TRANSFORM - PP4_NMPLS E /2/ !NOMINAL LINE SIZE - PP4_MXPLS E /20/ !MAX. LINE SIZE - PP4_MNPLS E /0.7/ !MIN. LINE SIZE - PP4_NMPMS E /20/ !NOMINAL POLYMARKER SIZE - PP4_MXPMS E /0/ !MAX. POLYMARKER SIZE - PP4_MNPMS E /0/ !MIN. POLYMARKER SIZE - PP4_NPLT J /4/ !# OF LINE TYPES - PP4_NPMT J /5/ !# OF POLYMARKER TYPES - PP4_EFN J /0/ !EFN TO USE - PP4_BFL J /0/ !BUFFER LENGTH - PP4_BFA J /0/ !BUFFER ADDRESSES - PP4_USE J(0:NUSED) !USER DATA - PP4_NPLIX J /NPLIX/ !LENGTH POLYLINE TABLE - PP4_NPMIX J /NPMIX/ !LENGTH POLYMARKER TABLE - PP4_NTXIX J /NTXIX/ !LENGTH TEXT TABLE - PP4_NFAIX J /NFAIX/ !LENGTH FILL AREA TABLE - PP4_NCLIX J /NCLIX/ !LENGTH COLOUR TABLE - PP4_OPLI J !ADDRESS POLYLINE TABLE - PP4_OPMI J !ADDRESS POLYMARKER TABLE - PP4_OTXI J !ADDRESS TEXT TABLE - PP4_OFAI J !ADDRESS FILL AREA TABLE - PP4_OCLI J !ADDRESS COLOUR TABLE -! - PP4_SVP J !START VARIABLE PART - PP4_PLIXE E(0:2,0:NPLIX) /1,1,0,2,1,0,3,1,0,4,1,0/ !POLYLINE (4) - PP4_PMIXE E(0:2,0:NPMIX) /1,1,0,2,1,0,3,1,0,4,1,0,5,1,0/ !POLYMARKER (5) - PP4_TXIXE E(0:2,0:NTXIX) /1,2,0,1,3,0,1,4,0/ !TEXT (3) - PP4_FAIXE E(0:2,0:NFAIX) /3,1,0,4,1,0,5,1,0,6,1,0/ !FILL AREA (4) - PP4_CLIXE E(0:2,0:NCLIX) /1,0,0,1,1,0/ !COLOUR (2) -! - PP4_EOL J !END OF LIST -.END !END DEFINITION -!- diff --git a/src/wng/wq_qmp.dsc b/src/wng/wq_qmp.dsc deleted file mode 100644 index bf9393900a5d1862cdc4a5921e0f5252eece6e65..0000000000000000000000000000000000000000 --- a/src/wng/wq_qmp.dsc +++ /dev/null @@ -1,81 +0,0 @@ -!+ WQ_QMP.DSC -! WNB 910224 -! -! Revisions: -! -! -! Define QMS portrait plotter. Layout should match WQD.DSC -! -! -! -%VERSION=1 !VERSION -%SYSTEM=1 -%USER=WNB -%%DATE -%%NAME -%REVISION=WNB=910624="Original version" -%COMMENT="WQ_QMP.DSC defines the QMS portrait plotter lay-out" -%COMMENT=" " -%LOCAL=NUSED=15 !Max. user data index -%LOCAL=NPLIX=3 !Max. polyline index -%LOCAL=NPMIX=4 !Max. polymarker index -%LOCAL=NTXIX=2 !Max. text index -%LOCAL=NFAIX=3 !Max. fill area index -%LOCAL=NCLIX=1 !Max. colour index -!- -.DEFINE -.PARAMETER -.DATA -.COMMON - QMP_QUE J /0/ !LINK OPEN DEVICES - QMP_LEN J !LENGTH OF AREA - QMP_BID C4 /DQID/ !ID OF AREA - QMP_ACT J /0/ !BIT0=1 ACTIVE - QMP_TYP J /1/ !BIT0=1 OUTPUT, 1 INPUT, 2 DISS, 3 META - QMP_DEFER J /0/ !DEFER TYPE - QMP_REGEN J /0/ !REGENERATION - QMP_NEWFR J /0/ !NEW FRAME - QMP_PEND J /0/ !PENDING - QMP_DEV C8 /QMSP/ !DEVICE TYPE - QMP_FILE C80 /QMS.PLT/ !DEVICE FILE - QMP_XHI E /2339/ !HIGHEST X - QMP_YHI E /3167/ !HIGHEST Y - QMP_XM E /0.218/ !X SIZE METERS - QMP_YM E /0.256/ !Y SIZE METERS - QMP_MGL J /80/ !MAX. MESSAGE LENGTH - QMP_DVRT J !DEVICE ROUTINE ADDRESS - QMP_CHAN J /0/ !DEVICE CHANNEL - QMP_NTR E(0:3,0:2) /2339,0,2339,0,0,0,1,1,0,0,2339,3167/ !DEVICE TRANSFORM - QMP_NMPLS E /3/ !NOMINAL LINE SIZE - QMP_MXPLS E /30/ !MAX. LINE SIZE - QMP_MNPLS E /1/ !MIN. LINE SIZE - QMP_NMPMS E /20/ !NOMINAL POLYMARKER SIZE - QMP_MXPMS E /0/ !MAX. POLYMARKER SIZE - QMP_MNPMS E /0/ !MIN. POLYMARKER SIZE - QMP_NPLT J /4/ !# OF LINE TYPES - QMP_NPMT J /5/ !# OF POLYMARKER TYPES - QMP_EFN J /0/ !EFN TO USE - QMP_BFL J /0/ !BUFFER LENGTH - QMP_BFA J /0/ !BUFFER ADDRESSES - QMP_USE J(0:NUSED) !USER DATA - QMP_NPLIX J /NPLIX/ !LENGTH POLYLINE TABLE - QMP_NPMIX J /NPMIX/ !LENGTH POLYMARKER TABLE - QMP_NTXIX J /NTXIX/ !LENGTH TEXT TABLE - QMP_NFAIX J /NFAIX/ !LENGTH FILL AREA TABLE - QMP_NCLIX J /NCLIX/ !LENGTH COLOUR TABLE - QMP_OPLI J !ADDRESS POLYLINE TABLE - QMP_OPMI J !ADDRESS POLYMARKER TABLE - QMP_OTXI J !ADDRESS TEXT TABLE - QMP_OFAI J !ADDRESS FILL AREA TABLE - QMP_OCLI J !ADDRESS COLOUR TABLE -! - QMP_SVP J !START VARIABLE PART - QMP_PLIXE E(0:2,0:NPLIX) /1,1,0,2,1,0,3,1,0,4,1,0/ !POLYLINE (4) - QMP_PMIXE E(0:2,0:NPMIX) /1,1,0,2,1,0,3,1,0,4,1,0,5,1,0/ !POLYMARKER (5) - QMP_TXIXE E(0:2,0:NTXIX) /1,2,0,1,3,0,1,4,0/ !TEXT (3) - QMP_FAIXE E(0:2,0:NFAIX) /3,1,0,4,1,0,5,1,0,6,1,0/ !FILL AREA (4) - QMP_CLIXE E(0:2,0:NCLIX) /1,0,0,1,1,0/ !COLOUR (2) -! - QMP_EOL J !END OF LIST -.END !END DEFINITION -!- diff --git a/src/wng/wq_qms.dsc b/src/wng/wq_qms.dsc deleted file mode 100644 index 2875635cdd8bc1ab9190499ae54537215fb9514b..0000000000000000000000000000000000000000 --- a/src/wng/wq_qms.dsc +++ /dev/null @@ -1,81 +0,0 @@ -!+ WQ_QMS.DSC -! WNB 910224 -! -! Revisions: -! -! -! Define QMS landscape plotter. Layout should match WQD.DSC -! -! -! -%VERSION=1 !VERSION -%SYSTEM=1 -%USER=WNB -%%DATE -%%NAME -%REVISION=WNB=910624="Original version" -%COMMENT="WQ_QMS.DSC defines the QMS plotter lay-out" -%COMMENT=" " -%LOCAL=NUSED=15 !Max. user data index -%LOCAL=NPLIX=3 !Max. polyline index -%LOCAL=NPMIX=4 !Max. polymarker index -%LOCAL=NTXIX=2 !Max. text index -%LOCAL=NFAIX=3 !Max. fill area index -%LOCAL=NCLIX=1 !Max. colour index -!- -.DEFINE -.PARAMETER -.DATA -.COMMON - QMS_QUE J /0/ !LINK OPEN DEVICES - QMS_LEN J !LENGTH OF AREA - QMS_BID C4 /DQID/ !ID OF AREA - QMS_ACT J /0/ !BIT0=1 ACTIVE - QMS_TYP J /1/ !BIT0=1 OUTPUT, 1 INPUT, 2 DISS, 3 META - QMS_DEFER J /0/ !DEFER TYPE - QMS_REGEN J /0/ !REGENERATION - QMS_NEWFR J /0/ !NEW FRAME - QMS_PEND J /0/ !PENDING - QMS_DEV C8 /QMS/ !DEVICE TYPE - QMS_FILE C80 /QMS.PLT/ !DEVICE FILE - QMS_XHI E /3167/ !HIGHEST X - QMS_YHI E /2339/ !HIGHEST Y - QMS_XM E /0.256/ !X SIZE METERS - QMS_YM E /0.218/ !Y SIZE METERS - QMS_MGL J /132/ !MAX. MESSAGE LENGTH - QMS_DVRT J !DEVICE ROUTINE ADDRESS - QMS_CHAN J /0/ !DEVICE CHANNEL - QMS_NTR E(0:3,0:2) /2339,0,2339,0,0,0,1,1,0,0,3167,2339/ !DEVICE TRANSFORM - QMS_NMPLS E /3/ !NOMINAL LINE SIZE - QMS_MXPLS E /30/ !MAX. LINE SIZE - QMS_MNPLS E /1/ !MIN. LINE SIZE - QMS_NMPMS E /20/ !NOMINAL POLYMARKER SIZE - QMS_MXPMS E /0/ !MAX. POLYMARKER SIZE - QMS_MNPMS E /0/ !MIN. POLYMARKER SIZE - QMS_NPLT J /4/ !# OF LINE TYPES - QMS_NPMT J /5/ !# OF POLYMARKER TYPES - QMS_EFN J /0/ !EFN TO USE - QMS_BFL J /0/ !BUFFER LENGTH - QMS_BFA J /0/ !BUFFER ADDRESSES - QMS_USE J(0:NUSED) !USER DATA - QMS_NPLIX J /NPLIX/ !LENGTH POLYLINE TABLE - QMS_NPMIX J /NPMIX/ !LENGTH POLYMARKER TABLE - QMS_NTXIX J /NTXIX/ !LENGTH TEXT TABLE - QMS_NFAIX J /NFAIX/ !LENGTH FILL AREA TABLE - QMS_NCLIX J /NCLIX/ !LENGTH COLOUR TABLE - QMS_OPLI J !ADDRESS POLYLINE TABLE - QMS_OPMI J !ADDRESS POLYMARKER TABLE - QMS_OTXI J !ADDRESS TEXT TABLE - QMS_OFAI J !ADDRESS FILL AREA TABLE - QMS_OCLI J !ADDRESS COLOUR TABLE -! - QMS_SVP J !START VARIABLE PART - QMS_PLIXE E(0:2,0:NPLIX) /1,1,0,2,1,0,3,1,0,4,1,0/ !POLYLINE (4) - QMS_PMIXE E(0:2,0:NPMIX) /1,1,0,2,1,0,3,1,0,4,1,0,5,1,0/ !POLYMARKER (5) - QMS_TXIXE E(0:2,0:NTXIX) /1,2,0,1,3,0,1,4,0/ !TEXT (3) - QMS_FAIXE E(0:2,0:NFAIX) /3,1,0,4,1,0,5,1,0,6,1,0/ !FILL AREA (4) - QMS_CLIXE E(0:2,0:NCLIX) /1,0,0,1,1,0/ !COLOUR (2) -! - QMS_EOL J !END OF LIST -.END !END DEFINITION -!- diff --git a/src/wng/wq_reg.dsc b/src/wng/wq_reg.dsc deleted file mode 100644 index e301e611613eb9c334d63ae77a54e17e9b535ef7..0000000000000000000000000000000000000000 --- a/src/wng/wq_reg.dsc +++ /dev/null @@ -1,82 +0,0 @@ -!+ WQ_REG.DSC -! WNB 910224 -! -! Revisions: -! -! -! Define Regis plotter. Layout should match WQD.DSC -! -! -! -%VERSION=1 !VERSION -%SYSTEM=1 -%USER=WNB -%%DATE -%%NAME -%REVISION=WNB=910624="Original version" -%COMMENT="WQ_REG.DSC defines the Regis plotter lay-out" -%COMMENT=" " -%LOCAL=NUSED=15 !Max. user data index -%LOCAL=NPLIX=3 !Max. polyline index -%LOCAL=NPMIX=4 !Max. polymarker index -%LOCAL=NTXIX=2 !Max. text index -%LOCAL=NFAIX=3 !Max. fill area index -%LOCAL=NCLIX=1 !Max. colour index -!- -.DEFINE -.PARAMETER -.DATA -.COMMON - REG_QUE J /0/ !LINK OPEN DEVICES - REG_LEN J !LENGTH OF AREA - REG_BID C4 /DQID/ !ID OF AREA - REG_ACT J /0/ !BIT0=1 ACTIVE - REG_TYP J /129/ !BIT0=1 OUTPUT, 1 INPUT, 2 DISS, 3 META - ! 7 SINGLE SCREEN - REG_DEFER J /0/ !DEFER TYPE - REG_REGEN J /0/ !REGENERATION - REG_NEWFR J /0/ !NEW FRAME - REG_PEND J /0/ !PENDING - REG_DEV C8 /REGIS/ !DEVICE TYPE - REG_FILE C80 /REGIS.PLT/ !DEVICE FILE - REG_XHI E /799/ !HIGHEST X - REG_YHI E /499/ !HIGHEST Y - REG_XM E /0.21/ !X SIZE METERS - REG_YM E /0.15/ !Y SIZE METERS - REG_MGL J /80/ !MAX. MESSAGE LENGTH - REG_DVRT J !DEVICE ROUTINE ADDRESS - REG_CHAN J /0/ !DEVICE CHANNEL - REG_NTR E(0:3,0:2) /499,0,499,0,0,0,1,1,0,0,799,499/ !DEVICE TRANSFORM - REG_NMPLS E /1/ !NOMINAL LINE SIZE - REG_MXPLS E /1/ !MAX. LINE SIZE - REG_MNPLS E /1/ !MIN. LINE SIZE - REG_NMPMS E /10/ !NOMINAL POLYMARKER SIZE - REG_MXPMS E /0/ !MAX. POLYMARKER SIZE - REG_MNPMS E /0/ !MIN. POLYMARKER SIZE - REG_NPLT J /4/ !# OF LINE TYPES - REG_NPMT J /5/ !# OF POLYMARKER TYPES - REG_EFN J /0/ !EFN TO USE - REG_BFL J /512/ !BUFFER LENGTH - REG_BFA J /0/ !BUFFER ADDRESSES - REG_USE J(0:NUSED) !USER DATA - REG_NPLIX J /NPLIX/ !LENGTH POLYLINE TABLE - REG_NPMIX J /NPMIX/ !LENGTH POLYMARKER TABLE - REG_NTXIX J /NTXIX/ !LENGTH TEXT TABLE - REG_NFAIX J /NFAIX/ !LENGTH FILL AREA TABLE - REG_NCLIX J /NCLIX/ !LENGTH COLOUR TABLE - REG_OPLI J !ADDRESS POLYLINE TABLE - REG_OPMI J !ADDRESS POLYMARKER TABLE - REG_OTXI J !ADDRESS TEXT TABLE - REG_OFAI J !ADDRESS FILL AREA TABLE - REG_OCLI J !ADDRESS COLOUR TABLE -! - REG_SVP J !START VARIABLE PART - REG_PLIXE E(0:2,0:NPLIX) /1,1,0,2,1,0,3,1,0,4,1,0/ !POLYLINE (4) - REG_PMIXE E(0:2,0:NPMIX) /1,1,0,2,1,0,3,1,0,4,1,0,5,1,0/ !POLYMARKER (5) - REG_TXIXE E(0:2,0:NTXIX) /1,2,0,1,3,0,1,4,0/ !TEXT (3) - REG_FAIXE E(0:2,0:NFAIX) /3,1,0,4,1,0,5,1,0,6,1,0/ !FILL AREA (4) - REG_CLIXE E(0:2,0:NCLIX) /1,0,0,1,1,0/ !COLOUR (2) -! - REG_EOL J !END OF LIST -.END !END DEFINITION -!- diff --git a/src/wng/wq_xwi.dsc b/src/wng/wq_xwi.dsc deleted file mode 100644 index c08326e08a76532322dad4495bd74f2c20e45c43..0000000000000000000000000000000000000000 --- a/src/wng/wq_xwi.dsc +++ /dev/null @@ -1,83 +0,0 @@ -!+ WQ_XWI.DSC -! HJV 921222 -! -! Revisions: -! -! -! Define X-windows. Layout should match WQD.DSC -! -! -! -%VERSION=1 !VERSION -%SYSTEM=1 -%USER=HJV -%%DATE -%%NAME -%REVISION=CMV=931201="Changed NPLIX to 3 (was 4)" -%REVISION=HJV=921222="Original version" -%COMMENT="WQ_XWI.DSC defines the X-windows lay-out" -%COMMENT=" " -%LOCAL=NUSED=15 !Max. user data index -%LOCAL=NPLIX=3 !Max. polyline index -%LOCAL=NPMIX=4 !Max. polymarker index -%LOCAL=NTXIX=2 !Max. text index -%LOCAL=NFAIX=3 !Max. fill area index -%LOCAL=NCLIX=1 !Max. colour index -!- -.DEFINE -.PARAMETER -.DATA -.COMMON - XWI_QUE J /0/ !LINK OPEN DEVICES - XWI_LEN J !LENGTH OF AREA - XWI_BID C4 /DQID/ !ID OF AREA - XWI_ACT J /0/ !BIT0=1 ACTIVE - XWI_TYP J /129/ !BIT0=1 OUTPUT, 1 INPUT, 2 DISS, 3 META - !7 SINGLE SCREEN - XWI_DEFER J /0/ !DEFER TYPE - XWI_REGEN J /0/ !REGENERATION - XWI_NEWFR J /0/ !NEW FRAME - XWI_PEND J /0/ !PENDING - XWI_DEV C8 /X11/ !DEVICE TYPE - XWI_FILE C80 /XWI.PLT/ !DEVICE FILE - XWI_XHI E /1400/ !HIGHEST X - XWI_YHI E /1200/ !HIGHEST Y - XWI_XM E /0.220/ !X SIZE METERS - XWI_YM E /0.170/ !Y SIZE METERS - XWI_MGL J /132/ !MAX. MESSAGE LENGTH - XWI_DVRT J !DEVICE ROUTINE ADDRESS - XWI_CHAN J /0/ !DEVICE CHANNEL - XWI_NTR E(0:3,0:2) /1200,0,1200,0,0,0,1,1,0,0,1400,1200/ !DEVICE TRANSFORM - XWI_NMPLS E /1/ !NOMINAL LINE SIZE - XWI_MXPLS E /15/ !MAX. LINE SIZE - XWI_MNPLS E /0.5/ !MIN. LINE SIZE - XWI_NMPMS E /10/ !NOMINAL POLYMARKER SIZE - XWI_MXPMS E /0/ !MAX. POLYMARKER SIZE - XWI_MNPMS E /0/ !MIN. POLYMARKER SIZE - XWI_NPLT J /4/ !# OF LINE TYPES - XWI_NPMT J /5/ !# OF POLYMARKER TYPES - XWI_EFN J /0/ !EFN TO USE - XWI_BFL J /0/ !BUFFER LENGTH - XWI_BFA J /0/ !BUFFER ADDRESSES - XWI_USE J(0:NUSED) !USER DATA - XWI_NPLIX J /NPLIX/ !LENGTH POLYLINE TABLE - XWI_NPMIX J /NPMIX/ !LENGTH POLYMARKER TABLE - XWI_NTXIX J /NTXIX/ !LENGTH TEXT TABLE - XWI_NFAIX J /NFAIX/ !LENGTH FILL AREA TABLE - XWI_NCLIX J /NCLIX/ !LENGTH COLOUR TABLE - XWI_OPLI J !ADDRESS POLYLINE TABLE - XWI_OPMI J !ADDRESS POLYMARKER TABLE - XWI_OTXI J !ADDRESS TEXT TABLE - XWI_OFAI J !ADDRESS FILL AREA TABLE - XWI_OCLI J !ADDRESS COLOUR TABLE -! - XWI_SVP J !START VARIABLE PART - XWI_PLIXE E(0:2,0:NPLIX) /1,1,0,2,1,0,3,1,0,4,1,0/ !POLYLINE (4) - XWI_PMIXE E(0:2,0:NPMIX) /1,1,0,2,1,0,3,1,0,4,1,0,5,1,0/ !POLYMARKER (5) - XWI_TXIXE E(0:2,0:NTXIX) /1,2,0,1,3,0,1,4,0/ !TEXT (3) - XWI_FAIXE E(0:2,0:NFAIX) /3,1,0,4,1,0,5,1,0,6,1,0/ !FILL AREA (4) - XWI_CLIXE E(0:2,0:NCLIX) /1,0,0,1,1,0/ !COLOUR (2) -! - XWI_EOL J !END OF LIST -.END !END DEFINITION -!- diff --git a/src/wng/wqd.dsc b/src/wng/wqd.dsc deleted file mode 100644 index 84dc8c3e8305e105ffa9fb642702adae0f9eb01a..0000000000000000000000000000000000000000 --- a/src/wng/wqd.dsc +++ /dev/null @@ -1,87 +0,0 @@ -!+ WQD.DSC -! WNB 910224 -! -! Revisions: -! WNB 920130 Add single screen bit -! -! -! Define WQ (WNP) device list lay-out -! -! -! -%VERSION=1 !VERSION -%SYSTEM=1 -%USER=WNB -%%DATE -%%NAME -%REVISION=WNB=910624="Original version" -%COMMENT="WQD.DSC defines the plot device (WQ) lay-out" -%COMMENT=" " -%LOCAL=NUSED=15 !Max. user data index -%LOCAL=NPLIX=3 !Max. polyline index -1 -%LOCAL=NPMIX=4 !Max. polymarker index -1 -%LOCAL=NTXIX=2 !Max. text index -1 -%LOCAL=NFAIX=3 !Max. fill area index -1 -%LOCAL=NCLIX=1 !Max. colour index -1 -!- -.PARAMETER - NUSED J /NUSED/ !MAX. USER DATA INDEX - NPLIX J /NPLIX/ !MAX. POLYLINE INDEX - NPMIX J /NPMIX/ !MAX. POLYMARKER INDEX - NTXIX J /NTXIX/ !MAX. TEXT INDEX - NFAIX J /NFAIX/ !MAX. FILL AREA INDEX - NCLIX J /NCLIX/ !MAX. COLOUR INDEX -.BEGIN=WQD - QUE J !LINK OPEN DEVICES - LEN J !LENGTH OF AREA - BID C4 !ID OF AREA - ACT J !BIT0=1 ACTIVE - TYP J !BIT0=1 OUTPUT, 1 INPUT, 2 DISS, 3 META - ! 7 SINGLE SCREEN - DEFER J !DEFER TYPE - REGEN J !REGENERATION - NEWFR J !NEW FRAME - PEND J !PENDING - DEV C8 !DEVICE TYPE - FILE C80 !DEVICE FILE - XHI E !HIGHEST X - YHI E !HIGHEST Y - XM E !X SIZE METERS - YM E !Y SIZE METERS - MGL J !MAX. MESSAGE LENGTH - DVRT J !DEVICE ROUTINE ADDRESS - CHAN J !DEVICE CHANNEL - NTR E(0:3,0:2) !DEVICE TRANSFORM - NMPLS E !NOMINAL LINE SIZE - MXPLS E !MAX. LINE SIZE - MNPLS E !MIN. LINE SIZE - NMPMS E !NOMINAL POLYMARKER SIZE - MXPMS E !MAX. POLYMARKER SIZE - MNPMS E !MIN. POLYMARKER SIZE - NPLT J !# OF LINE TYPES - NPMT J !# OF POLYMARKER TYPES - EFN J !EFN TO USE - BFL J !BUFFER LENGTH - BFA J !BUFFER ADDRESS - USE J(0:NUSED) !USER DATA - USEE=USE E(0:NUSED) - NPLIX J !LENGTH POLYLINE TABLE - NPMIX J !LENGTH POLYMARKER TABLE - NTXIX J !LENGTH TEXT TABLE - NFAIX J !LENGTH FILL AREA TABLE - NCLIX J !LENGTH COLOUR TABLE - OPLI J !ADDRESS POLYLINE TABLE - OPMI J !ADDRESS POLYMARKER TABLE - OTXI J !ADDRESS TEXT TABLE - OFAI J !ADDRESS FILL AREA TABLE - OCLI J !ADDRESS COLOUR TABLE - SVP J !START VARIABLE PART - PLIX E(0:2,0:NPLIX) !POLYLINE TABLE (4) - PMIX E(0:2,0:NPMIX) !POLYMARKER TABLE (5) - TXIX E(0:2,0:NTXIX) !TEXT TABLE (3) - FAIX E(0:2,0:NFAIX) !FILL AREA TABLE (4) - CLIX E(0:2,0:NCLIX) !COLOUR TABLE (2) -! - EOL J !END OF LIST -.END !END DEFINITION -!- diff --git a/src/wng/wqf.dsc b/src/wng/wqf.dsc deleted file mode 100644 index 2ef0043e9a7e8f765ae850cc79ee8f73bd9bab05..0000000000000000000000000000000000000000 --- a/src/wng/wqf.dsc +++ /dev/null @@ -1,36 +0,0 @@ -!+ WQF.DSC -! WNB 911126 -! -! Revisions: -! -! -! Define WQ (WNP) font list lay-out -! -! -! -%VERSION=1 !VERSION -%SYSTEM=1 -%USER=WNB -%%DATE -%%NAME -%REVISION=WNB=911126="Original version" -%COMMENT="WQF.DSC defines the font list (WQ) lay-out" -%COMMENT=" " -!- -.PARAMETER -.BEGIN=WQF - HGT E !HEIGHT - WID E !WIDTH - PLN J !8* MAX. POLYLINE # - STR E(0:1,4) !START RIGHT, LEFT, UP, DOWN POINT - BDL J !DELETE BITS - LCH J !LOWEST CHARACTER - HCH J !HIGHEST CHARACTER - RCH J !REPLACE CHARACTER - BHG E !BODY HEIGHT - TIL J !THICKER IF LARGER - RSV J(3) !RESERVED -! - FTP J !START CHARACTER LIST POINTER -.END !END DEFINITION -!- diff --git a/src/wng/wqg.dsc b/src/wng/wqg.dsc deleted file mode 100644 index 2d37e9557bc4f83999e046ef9ccec522633e720e..0000000000000000000000000000000000000000 --- a/src/wng/wqg.dsc +++ /dev/null @@ -1,121 +0,0 @@ -!+ WQG.DSC -! WNB 910623 -! -! Revisions: -! -! Layout of general WNP plot area -! -%VERSION=1 -%SYSTEM=1 -%USER=WNB -%%DATE -%%NAME -%REVISION=HJV=940822="Add WQG_XSTAT" -%REVISION=HJV=930902="Make use of WNTINC" -%REVISION=WNB=910623="Original version" -%COMMENT="WQG.DEF is a general include file, describing the general area" -%COMMENT=" for the WNP (WQ) plot package" -%LOCAL=NMXTR=3 !MAX. # OF TRANSFORMS -%LOCAL=NMXGDP=11 !MAX. GDP LEVEL -%LOCAL=LEVEL=0 !GKS LEVEL (#*256+(LETTER-A)) -%LOCAL=NMXFNT=16 !MAX. # OF FONTS TO LOAD -!- -.DEFINE - .PARAMETER - WQG__NMXTR J /NMXTR/ !MAX. # OF TRANSFORMS - WQG__NMXGDP J /NMXGDP/ !MAX. GDP LEVEL - WQG__LEVEL J /LEVEL/ !GKS LEVEL (#*256+(LETTER-A)) - WQG__NMXFNT J /NMXFNT/ !MAX. # OF FONTS - .DATA - .COMMON - WQG_STATE J /0/ !STATE OF DQ PROGRAM - !0=CLOSE - !1=OPEN - !2=AT LEAST ONE DEVICE OPEN - !3=AT LEAST ONE DEVICE ACTIVE - !4=SEGMENT OPEN - WQG_DVLST J /0/ !KNOWN DEVICES LIST - WQG_NFONT J /0/ !LOADED FONTS # - WQG_FONT J(NMXFNT) !FONT POINTERS - WQG_EXH J(6) /(6)0/ !EXIT HANDLER AREA - WQG_XSTAT C4 /NONE/ !MOST RECENT CLOSE STATUS -! - WQG_SOL J !PLACE HOLDER START - WQG_LEVEL J !GKS LEVEL -! - WQG_CPOLLIX J !CURRENT POLYLINE INDEX - WQG_CPOLMIX J !CURRENT POLYMARKER INDEX - WQG_CTXTIX J !CURRENT TEXT INDEX - WQG_CFILAIX J !CURRENT FILL AREA INDEX - WQG_CPID J !CURRENT PICK IDENTIFIER - WQG_CLIP J !CLIP INDICATOR - !BIT0=1 DO CLIP - WQG_CTXHT E !CURRENT CHAR. HEIGHT - WQG_CTXUP E(0:1) !CURRENT CHAR. UPVECTOR - WQG_CTXCS E(0:1) !UPVECTOR WITH LENGTH 1 - WQG_CTXXP E !CURRENT CHAR. EXPANSION FACTOR - WQG_CTXPA J !CURRENT CHAR. PATH - WQG_CTXSP E !CURRENT CHAR. SPACING - WQG_CPTSZ E(0:1) !CURRENT PATTERN SIZE - WQG_CPTRP E(0:1) !CURRENT PATTERN REF. POINT -! - WQG_QOM J !ACTIVE META OUTPUT PTR - WQG_QOP J !OPEN DEVICES - WQG_NACT J !# OF ACTIVE DEVICES -! - WQG_OUT1 J !POINTER TO CLIP AREAS - WQG_OUT2 J - WQG_OUT3 J - WQG_LOUT J !# OF J WORDS IN OUT'S -! - WQG_CTR J !CURRENT NORMALISED TRANSFORM - WQG_NMXTR J !MAX. # OF TRANSFORMS - WQG_MXGDP J !MAX. GDP # - WQG_NTR E(0:3,0:2,0:NMXTR) !TRANSFORM (TRANS, WIN, VIEW) -! - WQG_EOL J !PLACE HOLDER END -! -! Initial lay-out and values (between SOL and EOL should be same) -! - WQL_SOL J /0/ !PLACE HOLDER START -! - WQL_LEVEL J /LEVEL/ !GKS LEVEL -! - WQL_CPOLLIX J /1/ !CURRENT POLYLINE INDEX - WQL_CPOLMIX J /1/ !CURRENT POLYMARKER INDEX - WQL_CTXTIX J /1/ !CURRENT TEXT INDEX - WQL_CFILAIX J /1/ !CURRENT FILL AREA INDEX - WQL_CPID J /0/ !CURRENT PICK IDENTIFIER - WQL_CLIP J /0/ !CLIP INDICATOR - !BIT0=1 DO CLIP - WQL_CTXHT E /0.01/ !CURRENT CHAR. HEIGHT - WQL_CTXUP E(0:1) /0,1/ !CURRENT CHAR. UPVECTOR - WQL_CTXCS E(0:1) /0,1/ !UPVECTOR WITH LENGTH 1 - WQL_CTXXP E /1/ !CURRENT CHAR. EXPANSION FACTOR - WQL_CTXPA J /0/ !CURRENT CHAR. PATH - WQL_CTXSP E /0/ !CURRENT CHAR. SPACING - WQL_CPTSZ E(0:1) /1,1/ !CURRENT PATTERN SIZE - WQL_CPTRP E(0:1) /0,0/ !CURRENT PATTERN REF. POINT -! - WQL_QOM J /0/ !ACTIVE META OUTPUT PTR - WQL_QOP J /0/ !OPEN DEVICES - WQL_NACT J /0/ !# OF ACTIVE DEVICES -! - WQL_OUT1 J /0/ !POINTER TO CLIP AREAS - WQL_OUT2 J /0/ - WQL_OUT3 J /0/ - WQL_LOUT J /0/ !# OF J WORDS IN OUT'S -! - WQL_CTR J /0/ !CURRENT NORMALISED TRANSFORM - WQL_NMXTR J /NMXTR/ !MAX. # OF TRANSFORMS - WQL_MXGDP J /NMXGDP/ !MAX. GDP # -! NORM. TRANSFORM LIST (0:NMXTR) -! EACH TRANSFORM (0:3) FOR: -! TRANSFORM(0),WINDOW(1),VIEW(2) - WQL_NTR0 E(0:3,0:2) /1,0,1,0,0,0,1,1,0,0,1,1/ - WQL_NTR1 E(0:3,0:2) /1,0,1,0,0,0,1,1,0,0,1,1/ - WQL_NTR2 E(0:3,0:2) /1,0,1,0,0,0,1,1,0,0,1,1/ - WQL_NTR3 E(0:3,0:2) /1,0,1,0,0,0,1,1,0,0,1,1/ -! - WQL_EOL J /0/ !PLACE HOLDER END -.END diff --git a/src/wng/wqi.dsc b/src/wng/wqi.dsc deleted file mode 100644 index 2c37222f99b9e41a02291ed00090ac26b3ba06d8..0000000000000000000000000000000000000000 --- a/src/wng/wqi.dsc +++ /dev/null @@ -1,59 +0,0 @@ -!+ WQI.DSC -! WNB 911211 -! -! Revisions: -! -! -! Define WQ (WNP) 2-dimensional control area -! -! -! -%VERSION=1 !VERSION -%SYSTEM=1 -%USER=WNB -%%DATE -%%NAME -%REVISION=WNB=911211="Original version" -%COMMENT="WQI.DSC defines the 2-dimensional plot control area" -%COMMENT=" " -!- -.PARAMETER -.BEGIN=WQI - QUE J !LINK AREAS (NOT USED) - LEN J !LENGTH OF AREA - N J !NUMBER OF POINTS PER LINE - NC J !NUMBER OF CONTOURS - POS E(0:1) !POSITION START OF LINE - POSC E(0:1) !POSITION CENTRE SQUARE - DPOS E(0:1,0:1) !POSITION INCREMENT POINTS, LINES - MXMN E(0:1) !INTENSITY TRANSFORM - DEL E !DELETE VALUE (0R 0 IF NONE) - IND J !START (=0) INDICATOR - LIX J !LINE INDEX TO USE (OR 0) - CAE J !POINTER TO CONTOUR AREA (NC E) - CAJ J !LINK CONTOURS (NC J) - CAEX J !SAME (0 IF NOT DEFINED) - CAJX J - PAD J !POINTER TO DATA AREA (N E) - PADX J !SAME (0 IF NOT DEFINED) - USJ J(0:3) !USER DATA - USE E(0:3) !USER DATA - NE1 J !NUMBER OF E WORDS IN NEXT BUFFER - BAE1 J !POINTER TO BUFFER - NE2 J - BAE2 J - NE3 J - BAE3 J - NE4 J - BAE4 J - NJ1 J !NUMBER OF J WORDS IN NEXT BUFFER - BAJ1 J !POINTER TO BUFFER - NJ2 J - BAJ2 J - NJ3 J - BAJ3 J - NJ4 J - BAJ4 J - RSV -(8) !RESERVED -.END !END DEFINITION -!- diff --git a/src/wng/wxh.def b/src/wng/wxh.def deleted file mode 100644 index 6934e27bd1351c201e5d9734be7f8bc04127ac33..0000000000000000000000000000000000000000 --- a/src/wng/wxh.def +++ /dev/null @@ -1,42 +0,0 @@ -C+ Created from wxh.dsc on 970828 at 16:58:05 at daw18 -C WXH.DEF -C WNB 970828 -C -C Revisions: -C -C WNB 910828 Original version -C -C -C Given statements: -C -C -C Result: -C -C WXH.DEF is an INCLUDE file for exit and other handlers. -C -C -C -C Parameters: -C -C -C Data declarations: -C -C -C WXH common data: -C - INTEGER XHED ! HEAD OF EXIT HANDLER LIST - INTEGER XHCC(0:1) ! CONTROL C: 0: INHIBIT - ! 1: SEEN DURING INHIBIT - INTEGER XHRS(0:4) ! RESERVED -C -C WXH common block: -C - COMMON /WXH_COM/ XHED,XHCC,XHRS -C -C External initialisation: -C - EXTERNAL WXH_BD -C -C Given statements: -C -C- diff --git a/src/wng/wxh.dsc b/src/wng/wxh.dsc deleted file mode 100644 index 497aa21fd37a8b3a9146ebfe682edbc2425124ad..0000000000000000000000000000000000000000 --- a/src/wng/wxh.dsc +++ /dev/null @@ -1,25 +0,0 @@ -!+ WXH.DSC -! WNB 910828 -! -! Revisions: -! -! Layout of exit handler include file (WXH.DEF) -! -%VERSION=1 -%SYSTEM=1 -%USER=WNB -%%DATE -%%NAME -%REVISION=WNB=910828="Original version" -%COMMENT="WXH.DEF is an INCLUDE file for exit and other handlers." -%COMMENT=" " -!- -.DEFINE - .PARAMETER - .DATA - .COMMON - XHED J /0/ !HEAD OF EXIT HANDLER LIST - XHCC J(0:1) /0,0/ !CONTROL C: 0: INHIBIT - ! 1: SEEN DURING INHIBIT - XHRS J(0:4) /0,0,0,0,0/ !RESERVED -.END diff --git a/src/wng/wxh.inc b/src/wng/wxh.inc deleted file mode 100644 index a941f8d43949a8e674e0473b50b4b9eb87baa6e9..0000000000000000000000000000000000000000 --- a/src/wng/wxh.inc +++ /dev/null @@ -1,44 +0,0 @@ -/*+ Created from wxh.dsc on 970828 at 16:58:05 at daw18 -.. WXH.INC -.. WNB 970828 -.. -.. Revisions: -.. -.. WNB 910828 Original version -.. */ -/* -.. Given statements: -.. */ -/* -.. Result: -.. -.. WXH.DEF is an INCLUDE file for exit and other handlers. -.. -.. */ -/* -.. Parameters: -.. */ -/* -.. Data declarations: -.. */ -/* -.. WXH common data: -.. */ -struct wxh_com { - int xhed; /* HEAD OF EXIT HANDLER LIST */ - int xhcc[2]; /* CONTROL C: 0: INHIBIT */ - /* 1: SEEN DURING INHIBIT */ - int xhrs[5]; /* RESERVED */ -}; -/* -.. WXH common block: -.. */ -extern struct wxh_com wxh_com_ ; -/* -.. External initialisation: -.. */ - extern wxh_bd_() ; -/* -.. Given statements: -.. */ -/*- */ diff --git a/src/wng/wxh_bd.for b/src/wng/wxh_bd.for deleted file mode 100644 index 6e1d431851468b7614d3ba9f9c4c4a34e250ddc0..0000000000000000000000000000000000000000 --- a/src/wng/wxh_bd.for +++ /dev/null @@ -1,37 +0,0 @@ -C+ Created from wxh.dsc on 970828 at 16:58:05 at daw18 -C WXH_BD.FOR -C WNB 970828 -C -C Revisions: -C -C WNB 910828 Original version -C - BLOCK DATA WXH_BD -C -C Result: -C -C Initialisation of wxh.def -C -C WXH.DEF is an INCLUDE file for exit and other handlers. -C -C -C -C Parameters: -C -C -C WXH common data: -C - INTEGER XHED ! HEAD OF EXIT HANDLER LIST - DATA XHED /0/ - INTEGER XHCC(0:1) ! CONTROL C: 0: INHIBIT - DATA XHCC /0,0/ ! 1: SEEN DURING INHIBIT - INTEGER XHRS(0:4) ! RESERVED - DATA XHRS /0,0,0,0,0/ -C -C WXH common block: -C - COMMON /WXH_COM/ XHED,XHCC,XHRS -C -C - END -C-